Trailing-Edge
-
PDP-10 Archives
-
cobol12c
-
key.mac
There are 7 other files named key.mac in the archive. Click here to see a list.
; UPD ID= 771 on 2/3/78 at 4:24 PM
TITLE KEY FOR LIBOL V12C
SUBTTL CREATE A SORT KEY FROM A DISPLAY FIELD AL BLACKINGTON/CAM
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:
;V12B ****
;
;JEH 05-Aug-82 1040 fix output byte pointer for sixbit keys
;
;V10 *****
; 8-APR-75 /ACK ADD ABILITY TO HANDLE EBCDIC KEYS.
;*****
SALL
HISEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
SEARCH LBLPRM
ENTRY KEY.
EXTERNAL KILL.
;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.
KEY.: MOVEI TA,2 ;GET ADDRESS OF
EXCH TA,(PP) ; PARAMETERS, AND
ADDM TA,(PP) ; RESET RETURN ADDRESS
MOVE IP,0(TA) ;GET POINTER
MOVE OP,1(TA) ;GET KEY ADDRESS
HLRZ FS,OP ;GET FIELD SIZE
IFN ANS74,<
TRZE FS,1B19 ;ALTERNATE COLLATING SEQUENCE?
SKIPA CS,@(PP) ;YES, GET ADDRESS
TDZA CS,CS ;NO, MAKE SURE RHS = 0
AOS (PP) ;RETURN BEYOND IT
TLO CS,TA ;SET TA AS INDEX SO INDIRECTION WORKS
TRZE FS,1B18 ;DESCENDING?
HRLI CS,(1B0) ;YES, SET LHS NEGATIVE
>
IFN ANS68,<
TRZN FS,1B18 ;IS KEY DESCENDING?
TDCA CS,CS ;NO--SET "CS" TO 0
SETOI CS, ;YES--SET "CS" TO ALL ONES
>
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
AOJA FS,KEY.3
KEY.1: SETZM 0(OP) ;CLEAR NEXT WORD
KEY.2: ILDB TA,IP ;GET A BYTE
IFN ANS74,<
TRNE CS,-1 ;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
IFN ANS68,<
XORM CS,(OP) ;COMPLEMENT IF DESCENDING
>
IFN ANS74,<
SKIPGE CS ;IF DESCENDING
SETCMM (14) ;COMPLEMENT
>
ADDI OP,1
TLZ OP,77B23
KEY.3: LDB TA,[POINT 6,IP,11]
TLO OP,@BYTKIK-6(TA)
SOJG FS,KEY.1 ;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 ^D36B23 ;6-BIT ;[1040] USE WHOLE WORD FOR SIXBIT
EXP ^D35B23 ;7-BIT
EXP ^D32B23 ;8-BIT
EXP ^D36B23 ;9-BIT
TA=11 ;TEMP
FS=13 ;FIELD SIZE
OP=14 ;OUTPUT POINTER
IP=15 ;INPUT POINTER
CS=16 ;NON-ZERO IF DESCENDING
PP=17 ;PUSH-DOWN POINTER
END