Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/key.mac
There are 7 other files named key.mac in the archive. Click here to see a list.
; UPD ID= 218 on 1/21/82 at 5:32 PM by NIXON                            
TITLE	KEY FOR COBOTS V13
SUBTTL	CREATE A SORT KEY FROM A DISPLAY FIELD

	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:

;V10 *****

;	8-APR-75	/ACK	ADD ABILITY TO HANDLE  EBCDIC KEYS.

;*****


SALL
HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file

SEARCH	LBLPRM

ENTRY KEY.
EXTERNAL KILL.,RET.1

;CALLING SEQUENCE:
;	PUSHJ	17,KEY.
;	<BYTE POINTER TO DISPLAY FIELD>
;	XWD <SIZE OF FIELD>,<FIRST LOCATION FOR KEY>
;	XWD		0,COLLATING SEQENCE ADDRESS

;IF THE KEY IS DESCENDING, THE SIGN BIT OF THE XWD WILL BE 1.
;IF THE COLLATING SEQUENCE IS NON-STANDARD BIT 1 = 1.

;NOTE THIS CODE MAY RUN IN SECTION 1 IF SORT IS IN A NON-ZERO SECTION
;SO BE CAREFUL ABOUT INDEXING AND INDIRECTION
KEY.:	MOVEI	TA,2		;GET ADDRESS OF
	EXCH	TA,(PP)		;  PARAMETERS, AND
	ADDM	TA,(PP)		;  RESET RETURN ADDRESS
	DMOVE	IP,0(TA)	;GET POINTER AND KEY ADDRESS
	HLRZ	FS,OP		;GET FIELD SIZE

	TRZN	FS,1B19		;ALTERNATE COLLATING SEQUENCE?
	JRST	KEY.0		;NO
	MOVE	CS,@(PP)	;YES, GET ADDRESS
	HRLI	CS,400000+TA	;SET TA AS INDEX SO INDIRECTION WORKS
				; AND TURN INTO AN IFIW
	AOSA	(PP)		;RETURN BEYOND IT
KEY.0:	SETZ	CS,		;MAKE SURE ZERO

	LDB	TA,[POINT 6,IP,11] ;GET BYTE SIZE
	CAIG	TA,^D9
	CAIGE	TA,6
	JRST	BADBYT

	LSH	TA,6
	HRL	OP,TA		;BUILD OUTPUT BYTE POINTER
	LDB	TA,[POINT 6,IP,11]
	TLO	OP,@BYTKIK-6(TA)
	HLRZ	FL,OP		;STORE LHS OF BYTE POINTER
	TRZE	FS,DESC		;IS KEY DESCENDING?
	HRLI	FL,-1		;YES, SET LHS NEGATIVE
	JUMPE	FS,RET.1	;SIZE IS ZERO, GIVE UP

KEY.1:	TLO	OP,(1B0)	;MAKE IT A LOCAL ADDRESS
	SETZM	0(OP)		;CLEAR NEXT WORD
	HRL	OP,FL		;REBUILD THE BYTE POINTER

KEY.2:	ILDB	TA,IP		;GET A BYTE
	SKIPE	CS		;ALTERNATE COLLATING SEQUENCE?
	MOVE	TA,@CS		;YES, GET REPLACEMENT CHAR.
	IDPB	TA,OP		;STASH IT
	TLNE	OP,770000	;ANY ROOM LEFT IN WORD FOR ANOTHER?
	SOJG	FS,KEY.2	;YES--LOOP

	JUMPGE	FL,KEY.3	;IF DESCENDING
	TLO	OP,(1B0)	;MAKE LOCAL
	SETCMM	(OP)		;COMPLEMENT
KEY.3:	SOSLE	FS		;ANY LEFT?
	AOJA	OP,KEY.1	;YES, LOOP UNTIL DONE
	POPJ	PP,
;BAD BYTE SIZE

BADBYT:	OUTSTR	[ASCIZ "Bad sort-key byte pointer"]
	JRST	KILL.

;TABLE OF RESIDUES WITH WHICH EACH WORD IS STARTED

BYTKIK:	EXP	^D30B23	;6-BIT
	EXP	^D35B23	;7-BIT
	EXP	^D32B23	;8-BIT
	EXP	^D36B23	;9-BIT


TA=1	;TEMP
FL=11	;LHS = DESCENDING FLAG, RHS = INITIAL BYTE RESIDUE
FS=13	;FIELD SIZE
IP=14	;INPUT POINTER
OP=15	;OUTPUT POINTER
CS=16	;ALTERNATE COLLATING SEQUENCE
PP=17	;PUSH-DOWN POINTER

;FLAGS IN LHS OF WORD 2

DESC==(1B0)	;SEQUENCE IS DESCENDING
ACSF==(1B1)	;ALTERNATE COLLATING SEQUENCE

END