PDP-10 Archive: cobol-source/cmp.mac from BB-Z759A-SM

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/cmp.mac

There are 7 other files named cmp.mac in the archive. Click here to see a list.

; UPD ID= 1105 on 5/16/83 at 11:12 AM by NIXON                          
TITLE	CMP FOR COBOTS
SUBTTL	COMPARE TWO DISPLAY FIELDS

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

;REVISION HISTORY:

;	 3-APR-80	/DMN	COMBINE WITH CMPX.MAC
;624	 1-APR-80	/DMN	MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;	5/10/75		/DBT	ADD BIS
;	15-DEC-74	/ACK	CREATION.
;*****

	SEARCH	INTERM,LBLPRM	;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP

	EXTERN	EASTB.		;FORCE EASTBL TO BE LOADED.

	HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file

COMMENT	\

	THIS ROUTINE LEXICALLY COMPARES TWO DISPLAY FIELDS WHICH MAY OR
MAY NOT BE OF THE SAME DATA TYPE.

CALL:
	MOVEI	16,PARAMETER ADDRESS
	PUSHJ	17,COMP./CMP.76/CMP.96/CMP.97

PARAMETERS:
	WORD 1:
		BYTE POINTER FOR FIRST FIELD.
	WORD 2:
		BITS	0-5	BYTE POINTER RESIDUE FOR SECOND FIELD.
		BIT	6	IGNORED (1 IF THE FIELD IS EXPLICITLY SIGNED.)
		BITS	7-17	SIZE OF THE FIELDS.
		BITS	18-35	ADDRESS OF THE FIRST CHARACTER OF THE SECOND FIELD.

RETURNS:
	CALL+1	IF THE FIRST FIELD IS LESS THAN THE SECOND FIELD.
	CALL+2	IF THE FIRST FIELD IS GREATER THAN THE SECOND FIELD.
	CALL+3	IF THE FIRST FIELD IS EQUAL TO THE SECOND FIELD OR THE
		 LENGTH OF THE FIELDS ARE 0.

REGISTERS USED:
	CH, JAC, T2, IPTR, OPTR, CNT

\

;ENTRY POINTS

	ENTRY	COMP.		;TO COMPARE TWO FIELDS OF THE SAME TYPE.
	ENTRY	COMP.6		;[624] COMPARE TWO SIXBIT FIELDS IN EBCDIC.
	ENTRY	COMP.7		;[624] COMPARE TWO ASCII  FIELDS IN EBCDIC.
	ENTRY	COMP.9		;[624] COMPARE TWO EBCDIC FIELDS IN ASCII.
	ENTRY	CMP.76		;TO COMPARE AN ASCII FIELD TO A SIXBIT FIELD.
	ENTRY	CMP.96		;TO COMPARE AN EBCDIC FIELD TO A SIXBIT FIELD IN EBCDIC.
	ENTRY	CMP.97		;TO COMPARE AN EBCDIC FIELD TO AN ASCII FIELD IN EBCDIC.
	ENTRY	CMP.67		;[624] TO COMPARE A SIXBIT FIELD TO AN ASCII FIELD IN EBCDIC.
	ENTRY	CMP.69		;[624] TO COMPARE A SIXBIT FIELD TO AN EBCDIC FIELD IN ASCII.
	ENTRY	CMP.79		;[624] TO COMPARE AN ASCII FIELD TO AN EBCDIC FIELD IN ASCII.
	ENTRY	CMP2.		;TO COMPARE TWO FIELDS OF THE SAME DATA
				; TYPE IF THE AC'S HAVE BEEN SET UP ALREADY.

	EXTERN	SET2.		;ROUTINE TO PICK UP THE PARAMETERS.
	EXTERN	RET.1		;RETURNS TO CALL+1.
	EXTERN	RET.2		;RETURNS TO CALL+2.
	EXTERN	RET.3		;RETURNS TO CALL+3.

	EXTERN	PTIBS.		;POINTER TO THE INPUT BYTE SIZE.
	EXTERN	PTOBS.		;POINTER TO THE OUTPUT BYTE SIZE.
	EXTERN	PTR67.		;POINTER TO CONVERT SIXBIT TO ASCII.
	EXTERN	PTR69.		;POINTER TO CONVERT SIXBIT TO EBCDIC.
	EXTERN	PTR79.		;POINTER TO CONVERT ASCII  TO EBCDIC.
	EXTERN	PTR96.		;[624] POINTER TO CONVERT EBCDIC TO SIXBIT.
	EXTERN	PTR97.		;[624] POINTER TO CONVERT EBCDIC TO ASCII.

;LOCAL AC DEFINITIONS:

	ICH==TAC3
	PTR1==IPTR
	PTR2==OPTR


COMP.:	JSP	CH,BISCMP	; ENTER HERE TO COMPARE SIXBIT TO SIXBIT,
				; ASCII TO ASCII OR EBCDIC TO EBCDIC.

COMP.6:	JSP	CH,CMP		;[624] HERE FOR SIXBIT TO SIXBIT IN EBCDIC.
COMP.7:	JSP	CH,CMP		;[624] HERE FOR ASCII TO ASCII IN EBCDIC.
COMP.9:	JSP	CH,CMP		;[624] HERE FOR EBCDIC TO EBCDIC IN ASCII.

CMP.76:	JSP	CH,CMP		; HERE FOR ASCII  TO SIXBIT IN ASCII.
CMP.96:	JSP	CH,CMP		; HERE FOR EBCDIC TO SIXBIT IN EBCDIC.
CMP.97:	JSP	CH,CMP		; HERE FOR EBCDIC TO ASCII  IN EBCDIC.

CMP.67:	JSP	CH,CMP		;[624] HERE FOR SIXBIT TO ASCII  IN EBCDIC.
CMP.69:	JSP	CH,CMP		;[624] HERE FOR SIXBIT TO EBCDIC IN ASCII.
CMP.79:	JSP	CH,CMP		;[624] HERE FOR ASCII  TO EBCDIC IN ASCII.

CMP4:	LDB	ICH,PTIBS.

	LDB	ICH,PTIBS.	;[624]
	LDB	ICH,PTIBS.	;[624]
	LDB	ICH,PTIBS.	;[624]

	MOVEI	ICH,6
	MOVEI	ICH,6
	MOVEI	ICH,7

	MOVEI	ICH,7		;[624]
	MOVEI	ICH,9		;[624]
	MOVEI	ICH,9		;[624]

CMP5:	EXP	CMP2.

	EXP	CMP8		;[624]
	EXP	CMP8		;[624]
	EXP	CMP8		;[624]

	EXP	CMP1
	EXP	CMP1
	EXP	CMP1

	EXP	CMP7		;[624]
	EXP	CMP1		;[624]
	EXP	CMP1		;[624]

CMP6:	EXP	PTR69.		;[624]
	EXP	PTR79.		;[624]
	EXP	PTR97.		;[624]
	EXP	PTR67.
	EXP	PTR69.
	EXP	PTR79.
	EXP	0		;[624]
	EXP	PTR96.		;[624]
	EXP	PTR97.		;[624]

CMP:	HLLZ	JAC,0(PARM)	;SEE IF COLLATING SEQUENCE
	JUMPE	JAC,CMPC	;YES
	JSP	JAC,SET2.	;GO PICK UP THE PARAMETERS.
	  EXP	RET.3		;RETURN THROUGH HERE ON NULL INPUT.
	XCT	CMP4-COMP.-1(CH)	;GET THE OUTPUT BYTE SIZE.
	DPB	ICH,PTOBS.	;PUT IT IN THE OUTPUT POINTER.
	JRST	@CMP5-COMP.-1(CH)	;DISPATCH TO A CONVERSION ROUTINE.


BISCMP:	HLLZ	JAC,0(PARM)	;SEE IF COLLATING SEQUENCE = ALPHABET-NAME
	JUMPE	JAC,CMPC	;YES
	JSP	JAC,BSET2.##	;GO GET PARAMS
	  EXP	RET.3		;RETURN HERE ON NULL INPUT

	LDB	BIST0,BPTIBS##	;GET INPUT BYTE SIZE
	DPB	BIST0,BPTOBS##	;SET OUTPUT BYTE SIZE WITH IT
	EXTEND	B.FLAG,[CMPSN]	;COMPARE NOT EQUAL
	  JRST	RET.3		;EQUAL

	;CHECK FOR LESS THAN OR GREATER THAN

	LDB	BIST0,SRCPT	;GET OFFENDING CHARACTERS
	LDB	BIST1,DSTPT
	CAIL	BIST0,(BIST1)
	AOS	(PP)		;DST LESS THAN SRC
	POPJ	PP,		;SRC LESS THAN DST

;THE FOLLOWING TWO ROUTINES COULD BE COMBINED BUT SINCE MOST COMPARISONS
; ARE DONE ON STRINGS OF LIKE DATA TYPES, THE TIME SAVED IS WORTH THE COST.

;ROUTINE TO COMPARE FIELDS OF DIFFERING DATA TYPES:

CMP1:	MOVE	CPTR,@CMP6-COMP.-2(CH)	;PICK UP THE CONVERSION POINTER.
CMP1A:	ILDB	ICH,PTR1	;GET A CHAR FROM THE FIRST STRING.
	ILDB	CH,PTR2		;GET A CHAR FROM THE SECOND STRING.
	LDB	CH,CPTR		;CONVERT IT.
	CAIN	CH,(ICH)	;ARE THEY THE SAME?
	SOJG	CNT,CMP1A	;YES, LOOP IF THERE ARE MORE.
	JUMPN	CNT,CMP3	;JUMP IF THE STRINGS ARE NOT EQUAL.
	JRST	RET.3		;OTHERWISE RETURN TO CALL+3.

;ROUTINE TO COMPARE FIELDS OF THE SAME DATA TYPE.

CMP2.:	ILDB	ICH,PTR1	;GET A CHAR FROM THE FIRST STRING.
	ILDB	CH,PTR2		;GET A CHAR FROM THE SECOND STRING.
	CAIN	CH,(ICH)	;ARE THEY THE SAME?
	SOJG	CNT,CMP2.	;YES, LOOP IF THERE ARE MORE.
	JUMPE	CNT,RET.3	;RETURN TO CALL+3 IF THE STRINGS ARE EQUAL.

;COME HERE WHEN WE DETERMINE THAT THE STRINGS ARE NOT EQUAL.

CMP3:	CAIG	CH,(ICH)	;SECOND STRING LARGER?
	AOS	(PP)		;NO, RETURN TO CALL+2
	POPJ	PP,		;RETURN.

;HERE FOR COLLATING SEQUENCE ON

CMP5C:	EXP	CMP2C.
	EXP	0		;[624]
	EXP	0		;[624]
	EXP	0		;[624]
	EXP	CMP1C
	EXP	CMP1C
	EXP	CMP1C

CMPC:	ADDI	PARM,1			;BYPASS COLLATING SEQUENCE
	JSP	JAC,SET2.		;GO PICK UP THE PARAMETERS.
	  EXP	RET.3			;RETURN THROUGH HERE ON NULL INPUT.
	XCT	CMP4-COMP.-1(CH)	;GET THE OUTPUT BYTE SIZE.
	DPB	ICH,PTOBS.		;PUT IT IN THE OUTPUT POINTER.
	JRST	@CMP5C-COMP.-1(CH)	;DISPATCH TO A CONVERSION ROUTINE.

;[624] COMPARE SIXBIT TO ASCII IN EBCDIC COLLATING SEQUENCE

CMP7:	ILDB	CH,PTR1		;[624] GET A CHAR FROM THE FIRST STRING.
	LDB	ICH,PTR69.	;[624] CONVERT TO EBCDIC
	ILDB	CH,PTR2		;[624] GET A CHAR FROM THE SECOND STRING.
	LDB	CH,PTR79.	;[624] CONVERT TO EBCDIC
	CAIN	CH,(ICH)	;[624] ARE THEY THE SAME?
	SOJG	CNT,CMP7	;[624] YES, LOOP IF THERE ARE MORE.
	JUMPN	CNT,CMP3	;[624] JUMP IF THE STRINGS ARE NOT EQUAL.
	JRST	RET.3		;[624] OTHERWISE RETURN TO CALL+3.

;[624] HERE TO COMPARE TWO FIELDS OF THE SAME TYPE IN THE OTHER COLLATING SEQUENCE.

CMP8:	MOVE	CPTR,@CMP6-COMP.-2(CH)	;[624] PICK UP THE CONVERSION POINTER.
CMP8A:	ILDB	CH,PTR1		;[624] GET A CHAR FROM THE FIRST STRING.
	LDB	ICH,CPTR	;[624] CONVERT IT
	ILDB	CH,PTR2		;[624] GET A CHAR FROM THE SECOND STRING.
	LDB	CH,CPTR		;[624] CONVERT IT
	CAIN	CH,(ICH)	;[624] ARE THEY THE SAME?
	SOJG	CNT,CMP8A	;[624] YES, LOOP IF THERE ARE MORE.
	JUMPN	CNT,CMP3	;[624] JUMP IF THE STRINGS ARE NOT EQUAL.
	JRST	RET.3		;[624] OTHERWISE RETURN TO CALL+3.

;THE FOLLOWING TWO ROUTINES COULD BE COMBINED BUT SINCE MOST COMPARISONS
; ARE DONE ON STRINGS OF LIKE DATA TYPES, THE TIME SAVED IS WORTH THE COST.

;ROUTINE TO COMPARE FIELDS OF DIFFERING DATA TYPES:

CMP1C:	MOVE	CPTR,@CMP6-COMP.-2(CH)	;PICK UP THE CONVERSION POINTER.
	MOVE	JAC,-1(PARM)	;GET COLLATING SEQUENCE
CMP1CA:	ILDB	ICH,PTR1	;GET A CHAR FROM THE FIRST STRING.
	ILDB	CH,PTR2		;GET A CHAR FROM THE SECOND STRING.
	LDB	CH,CPTR		;CONVRT IT.
	ADDI	CH,(JAC)	;INDEX INTO TABLE
	MOVE	CH,(CH)		;GET NEW CHAR.
	ADDI	ICH,(JAC)
	CAMN	CH,(ICH)	;ARE THEY THE SAME?
	SOJG	CNT,CMP1CA	;YES, LOOP IF THERE ARE MORE.
	JUMPN	CNT,CMP3C	;JUMP IF THE STRINGS ARE NOT EQUAL.
	JRST	RET.3		;OTHERWISE RETURN TO CALL+3.

;ROUTINE TO COMPARE FIELDS OF THE SAME DATA TYPE.

CMP2C.:	MOVE	JAC,-1(PARM)	;GET COLLATING SEQUENCE
CMP2CA:	ILDB	ICH,PTR1	;GET A CHAR FROM THE FIRST STRING.
	ILDB	CH,PTR2		;GET A CHAR FROM THE SECOND STRING.
	ADDI	CH,(JAC)	;INDEX INTO TABLE
	MOVE	CH,(CH)		;GET NEW CHAR.
	ADDI	ICH,(JAC)
	CAMN	CH,(ICH)	;ARE THEY THE SAME?
	SOJG	CNT,CMP2CA	;YES, LOOP IF THERE ARE MORE.
	JUMPE	CNT,RET.3	;RETURN TO CALL+3 IF THE STRINGS ARE EQUAL.

;COME HERE WHEN WE DETERMINE THAT THE STRINGS ARE NOT EQUAL.

CMP3C:	CAMG	CH,(ICH)	;SECOND STRING LARGER?
	AOS	(PP)		;NO, RETURN TO CALL+2
	POPJ	PP,		;RETURN.

SUBTTL	SIX FLAVORS OF NON-NUMERIC COMPARISON

ENTRY CMP.E	;SKIP IF EQUAL
ENTRY CMP.G	;SKIP IF GREATER
ENTRY CMP.L	;SKIP IF LESS
ENTRY CMP.N	;SKIP IF NOT EQUAL
ENTRY CMP.GE	;SKIP IF GREATER OR EQUAL
ENTRY CMP.LE	;SKIP IF LESS OR EQUAL

;THESE ROUTINES USE THE GENERAL 'COMP.' ROUTINE TO DETERMINE
;RELATIVE VALUES OF TWO NON-NUMERIC FIELDS.
;THE 'COMP.' ROUTINE IS CALLED BY:
;	PUSHJ PP,COMP.
;	RETURN IF A < B
;	RETURN IF A > B
;	RETURN IF A = B

	PP=17	;PUSH-DOWN POINTER

CMP.E:	PUSHJ	PP,COMP.
	POPJ	PP,
	POPJ	PP,
	AOSA	(PP)

CMP.G:	PUSHJ	PP,COMP.
	POPJ	PP,
	AOS	(PP)
	POPJ	PP,

CMP.LE:	PUSHJ	PP,COMP.
	AOS	(PP)
	POPJ	PP,
	AOSA	(PP)

CMP.GE:	PUSHJ	PP,COMP.
	POPJ	PP,
	AOSA	(PP)
	AOS	(PP)
	POPJ	PP,

CMP.L:	PUSHJ	PP,COMP.
	AOS	(PP)
	POPJ	PP,
	POPJ	PP,

CMP.N:	PUSHJ	PP,COMP.
	AOSA	(PP)
	AOS	(PP)
	POPJ	PP,

SUBTTL	SOFTWARE SWITCHES

ENTRY	SWT.ON,SWT.OF,SSW.ON,SSW.OF

 IFN TOPS20,<	SEARCH	MONSYM>
 IFE TOPS20,<	SEARCH	UUOSYM>
	T1==1
	T2==2
	T3==3
	PA==16

SWT.OF:	PUSHJ	PP,SWT.ON	;GET RESULT
	  AOS	(PP)		;CONVERT FALSE TO TRUE
	POPJ	PP,		;TRUE RETURN TO FALSE

SWT.ON:
 IFN TOPS20,<
	MOVEI	T1,.LNSJB	;JOB-WIDE LOGICAL NAMES
	HRROI	T2,[ASCIZ /SWITCHES/]
	MOVE	T3,[POINT 7,FUN.A1##]	;STORE UP TO 3 WORDS
	LNMST%
	  POPJ	PP,		;NO LOGICAL NAME, ASSUME OFF
 >
 IFE TOPS20,<
	MOVE	T1,[.TCRRF,,['SWT',,0
			     IOWD 3,FUN.A1##]]
	TMPCOR	T1,
	  POPJ	PP,		;NO TMPCOR FILE
>
	MOVE	T1,PA		;GET SWITCH (N)
	IDIVI	T1,^D15		;SEE WHICH WORD IT IS
	MOVE	T1,FUN.A1(T1)	;GET LOGICAL NAME
	IDIVI	T2,3		;SEE WHICH BYTE ITS IN
	MOVE	T3,[BYTE (7) 4
		BYTE (7) 2
		BYTE (7) 1](T3)	;GET POSITION IN BYTE
	JUMPE	T2,.+3		;IN LEADING BYTE?
	LSH	T3,-7		;NO, SHIFT RIGHT
	SOJG	T2,.-1		;FOR EACH BYTE
	AND	T1,T3		;SEE IF BIT IS ON
	JUMPE	T1,RET.1	;OFF
	JRST	RET.2		;TRUE, GIVE SKIP RETURN

;SET THE SWITCH ON OR OFF

SSW.ON:	PUSHJ	PP,GETSW	;GET CURRENT SWITCH VALUE IN TO FUN.A1
	IORM	T3,FUN.A1(T1)	;SET BIT ON
	JRST	SETSW		;WRITE SWITCH BACK OUT

SSW.OF:	PUSHJ	PP,GETSW	;GET CURRENT SWITCH VALUE IN TO FUN.A1
	ANDCAM	T3,FUN.A1(T1)	;SET BIT OFF
SETSW:
 IFN TOPS20,<
	MOVEI	T1,.CLNJB	;CREATE A JOB-WIDE LOGICAL NAME
	HRROI	T2,[ASCIZ /SWITCHES/]
	MOVE	T3,[POINT 7,FUN.A1##]	;STORE UP TO 3 WORDS
	CRLNM%
	  ERJMP	.+1		;ERROR, TOO BAD
 >
 IFE TOPS20,<
	MOVE	T1,[.TCRWF,,['SWT',,0
			     IOWD 3,FUN.A1##]]
	TMPCOR	T1,
	  TRN			;ERROR, TOO BAD
>
	POPJ	PP,		;RETURN TO USER


GETSW:
 IFN TOPS20,<
	MOVEI	T1,.LNSJB	;JOB-WIDE LOGICAL NAMES
	HRROI	T2,[ASCIZ /SWITCHES/]
	MOVE	T3,[POINT 7,FUN.A1##]	;STORE UP TO 3 WORDS
	LNMST%
	  PUSHJ	PP,GETSWZ	;NO LOGICAL NAME, SET TO ZERO
 >
 IFE TOPS20,<
	MOVE	T1,[.TCRRF,,['SWT',,0
			     IOWD 3,FUN.A1##]]
	TMPCOR	T1,
	  PUSHJ	PP,GETSWZ	;NO LOGICAL NAME, SET TO ZERO
>
	MOVE	T1,PA		;GET SWITCH (N)
	IDIVI	T1,^D15		;SEE WHICH WORD IT IS
	IDIVI	T2,3		;SEE WHICH BYTE ITS IN
	MOVE	T3,[BYTE (7) 4
		BYTE (7) 2
		BYTE (7) 1](T3)	;GET POSITION IN BYTE
	JUMPE	T2,.+3		;IN LEADING BYTE?
	LSH	T3,-7		;NO, SHIFT RIGHT
	SOJG	T2,.-1		;FOR EACH BYTE
	POPJ	PP,

GETSWZ:	DMOVE	T1,[ASCIZ /0000000/]
	MOVEM	T1,FUN.A1
	DMOVEM	T1,FUN.A1+1
	POPJ	PP,

	END