PDP-10 Archive: cmp.mac from cobol12c

Trailing-Edge - PDP-10 Archives - cobol12c - cmp.mac

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

; UPD ID= 2745 on 4/4/80 at 12:59 PM by NIXON                           
TITLE	CMP FOR LIBOL V12C
SUBTTL	COMPARE TWO DISPLAY FIELDS

	SEARCH COPYRT
	SALL

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

;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
	EBCMP.==:EBCMP.
	BIS==:BIS

	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.
IFN ANS74,<
	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.
IFN EBCMP.,<
	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.
 IFN ANS74,<
	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.
IFN EBCMP.,<
	EXTERN	PTR69.		;POINTER TO CONVERT SIXBIT TO EBCDIC.
	EXTERN	PTR79.		;POINTER TO CONVERT ASCII  TO EBCDIC.
 IFN ANS74,<
	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.:
IFE	BIS,<JSP	CH,CMP	>
IFN	BIS,<JSP	CH,BISCMP	>
				; ENTER HERE TO COMPARE SIXBIT TO SIXBIT,
				; ASCII TO ASCII OR EBCDIC TO EBCDIC.
IFN ANS74,<
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.
IFN EBCMP.,<
CMP.96:	JSP	CH,CMP		; HERE FOR EBCDIC TO SIXBIT IN EBCDIC.
CMP.97:	JSP	CH,CMP		; HERE FOR EBCDIC TO ASCII  IN EBCDIC.
 IFN ANS74,<
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.
IFN ANS74,<
	LDB	ICH,PTIBS.	;[624]
	LDB	ICH,PTIBS.	;[624]
	LDB	ICH,PTIBS.	;[624]
>
	MOVEI	ICH,6
IFN EBCMP.,<
	MOVEI	ICH,6
	MOVEI	ICH,7
 IFN ANS74,<
	MOVEI	ICH,7		;[624]
	MOVEI	ICH,9		;[624]
	MOVEI	ICH,9		;[624]
>>


CMP5:	EXP	CMP2.
IFN ANS74,<
	EXP	CMP8		;[624]
	EXP	CMP8		;[624]
	EXP	CMP8		;[624]
>
	EXP	CMP1
IFN EBCMP.,<
	EXP	CMP1
	EXP	CMP1
 IFN ANS74,<
	EXP	CMP7		;[624]
	EXP	CMP1		;[624]
	EXP	CMP1		;[624]
>>


CMP6:
IFN ANS74,<
	EXP	PTR69.		;[624]
	EXP	PTR79.		;[624]
	EXP	PTR97.		;[624]
>
	EXP	PTR67.
IFN EBCMP.,<
	EXP	PTR69.
	EXP	PTR79.
 IFN ANS74,<
	EXP	0		;[624]
	EXP	PTR96.		;[624]
	EXP	PTR97.		;[624]
>>

CMP:
IFN ANS74,<
	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.


IFN BIS,<

BISCMP:
 IFN ANS74,<
	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

>;END OF BIS

;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
IFN ANS74,<

CMP5C:	EXP	CMP2C.
IFN ANS74,<
	EXP	0		;[624]
	EXP	0		;[624]
	EXP	0		;[624]
>
	EXP	CMP1C
IFN EBCMP.,<
	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.

>;END IFN ANS74

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

IFN ANS74,<

ENTRY	SWT.ON,SWT.OF

	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,<	SEARCH	MONSYM
	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,<	SEARCH	UUOSYM
	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
>
	END