Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
srtgen.mac
There are 29 other files named srtgen.mac in the archive. Click here to see a list.
; UPD ID= 3537 on 5/8/81 at 4:17 PM by NIXON
TITLE SRTGEN FOR COBOL V12C
SUBTTL SORT GENERATOR AL BLACKINGTON/CAM/DMN
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.
SEARCH P
%%P==:%%P
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
SALL
RELOC 400000
ENTRY SORTGN ;SORT OPERATOR
ENTRY MERGGN ;MERGE OPERATOR
ENTRY RELSGN ;RELEASE OPERATOR
ENTRY RETNGN ;RETURN OPERATOR
ENTRY SKEYGN ;KEY OPERATOR
ENTRY SINGN ;INPUT-PROC OPERATOR
ENTRY SOUTGN ;OUTPUT-PROC OPERATOR
ENTRY SGIVGN ;GIVING OPERATOR
ENTRY SUSEGN ;USING OPERATOR
ENTRY SCOLGN ;COLLATING SEQUENCE OPERATOR
ENTRY SENDGN ;END-SORT OPERATOR
YECCH.==105
SCOL.==107
SKEY.==111
SIN.==112
SOUT.==113
SGIV.==114
SUSE.==115
SEND.==116
ASCKEY==1B<^D18+^D9> ;KEY IS ASCENDING
WSCFLG==(1B9) ;WITH SEQUENCE CHECK FLAG
WSCBIT==(1B0) ;DITTO TO PASS TO SORT
;EDITS
;NAME DATE COMMENTS
;V12B****************
;JEH 19-MAR-84 [1516] Don't zero sort record area if SAME RECORD AREA
; clause used
;SMI 18-OCT-82 [1420] FIX GENERATION OF CODE TO LOAD KEYS
;JEH 04-JAN-81 [1327] SET UP B OPERAND FOR CLEAR OF INPUT BUFFER
;
;V12A****************
;JSM 28-APR-81 [1126] MAKE RELEASE VERB CLEAR ITS INPUT BUFFER
; AFTER RELEASING RECORD TO SORT.
;JSM 26-NOV-80 [1100] COBOLE LOOPS IF BAD SYNTAX FOR "PIC" ON SORT KEY.
;DMN 23-OCT-80 [1061] WRONG CODE GENERATED FOR 8 BYTE ASCII KEY WITH 1 OR 2 BYTES IN FIRST WORD.
;DAW 27-JUN-80 [1027] PROPER HANDLING OF "INTO" ITEMS FOR NESTED RETURNS/READS
;DMN 11-JUN-80 [1025] ALLOW RANDOM AND ISAM FILES AS SORT INPUT FILES.
;DMN 1-APR-80 [1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;V12*****************
;CLRH 30-APR-79 [703] BAD CODE GENERATED FOR SIXBIT SORT WHERE KEY STARTS
; ONE CHARACTER INTO A WORD (NON-BIS CASE ONLY).
;MFY 22-MAR-79 [667] WRONG CODE FOR EBCDIC KEYS WITH 2 BYTES IN LAST WORD
;DMN 1-MAR-79 [647] WRONG CODE GENERATED FOR FILLER X(5), KEY X(8) IN SIXBIT
;DMN 22-JAN-79 [627] WRONG CODE GENERATED FOR EBCDIC 8 BYTE KEY WITH 1 OR 3 BYTES IN FIRST WORD
;DMN 29-DEC-78 [623] GIVE ERROR IF SORT KEY CONTAINS OCCURS CLAUSE
;DMN 29-DEC-78 [622] WRONG CODE GENERATED FOR FILLER X, KEY X(9) IN SIXBIT
;DMN 12-DEC-78 [615] PUT REMAINING FIXES FROM BWR FILE INTO OFFICIAL SOURCES
;DMN 4-OCT-78 [563] ILL. MEM. REF. FOR FILLER X(3) OR X(4), KEY X(8) IN ASCII.
;DMN 25-SEP-78 [560] WRONG CODE GENERATED FOR FILLER X(3), KEY X(7) IN SIXBIT.
;EHM 17-SEP-78 [555] FIX MISCELLANEOUS PROBLEMS WITH SORT & COBOL
;EHM 17-SEP-78 [554] GIVE ERROR MESSAGE IF KEY IN SORT STATEMENT
; IS FOR THE WRONG FILE
;EHM 3-AUG-78 [541] FIX CATASTROPHIE IN PHASE O IF NULL
; INPUT OR OUTPUT PROCEDURES.
;V10*****************
;JEC 8-DEC-76 [452] FIX KEY CODE FOR CORE EXPANSION
;DPL 23-JUN-76 [431] FIX GIVING CODE GEN
;ACK 28-MAY-75 COMP-3/EBCDIC
;********************
;THE FOLLOWING ROUTINES SHOULD BE ENTERED ONLY FROM "SORTGN":
SKEYGN: SINGN: SOUTGN: SGIVGN: SUSEGN: SENDGN: SCOLGN:
MOVEM PP,SAVEPP
CONFUZ: MOVEI DW,E.282
GOBACK: LDB CP,W1CP
LDB LN,W1LN
PUSHJ PP,FATAL
JRST GOBAK2
GOBAK1: MOVE EACA,EOPLOC
MOVEM EACA,EOPNXT
SETZB EACC,ETEMPC
PUSHJ PP,READEM
GOBAK2: HRRZ TE,W2
CAIG TE,SEND.
CAIGE TE,SKEY.
GOBAK3: SKIPA PP,SAVEPP
JRST GOBAK1
JRST GO2NXT
;"SORT" OPERATOR
SORTGN: TDZA TE,TE ;SORT
MERGGN: SETO TE, ;MERGE
MOVEM TE,EMRGFL##
MOVE EACA,EOPNXT
SWOFF FEOFF1;
MOVEM W1,OPLINE
MOVEM PP,SAVEPP
MOVE TE,RESLOC
MOVEM TE,RESNXT
MOVE TE,[XWD ESORTL,ESORTL+1]
SETZM ESORTL
BLT TE,ESORTH
MOVEI TE,WSCBIT
TLNE W1,WSCFLG ;NEED SEQUENCE CHECK?
MOVEM TE,EKEYSZ ;YES, SET FLAG IN SIZE WORD
HRRZ TE,EOPLOC
ADDI TE,2
CAIE TE,(EACA)
JRST BADSOP
MOVE TE,-1(EACA)
MOVEM TE,ESORTF
MOVE TA,0(EACA)
MOVEM TA,ESORTF+1
IFN ANS74,<
PUSHJ PP,LNKSET ;TURN LINK INTO ADDRESS
LDB TE,FI.MRS## ;GET RECORD SIZE
MOVEM TE,ESMAXR## ;SAVE FOR LATER CHECKS
>
;READ OPERANDS AND OPERATORS UNTIL "SEND" SEEN.
;DISPATCH TO ROUTINES AS NEEDED.
SRTGN1: MOVE EACA,EOPLOC
MOVEM EACA,EOPNXT
PUSHJ PP,READEM
HRRZ TE,W2
CAIG TE,SEND.
CAIGE TE,SKEY.
JRST SRTGN2
JRST @.+1-SKEY.(TE)
EXP SKEY.G
EXP SIN.G
EXP SOUT.G
EXP SGIV.G
EXP SUSE.G
EXP SEND.G
SRTGN2:
IFN ANS74,<
CAIN TE,SCOL.
JRST SCOL.G ;OK, ITS COLLATING SEQUENCE
>
CAIE TE,YECCH.
JRST CONFUZ
JRST GOBAK3
;"USING" OPERATOR
SUSE.G: SKIPE ESINP
JRST BOTHI
MOVEI TD,ESUSE
AOS TE,EUSENO## ;COUNT NUMBER OF INPUT FILES
CAIN TE,2 ;SECOND TIME THRU
PUSHJ PP,SUSE.X ;YES, SAVE ESUSE FROM FIRST
SUSEG1: MOVE TE,-1(EACA)
MOVEM TE,0(TD)
MOVE TE,0(EACA)
MOVEM TE,1(TD)
MOVE TE,EUSENO ;GET NO. OF INPUT FILES
CAIL TE,2 ;IF NOT FIRST
PUSHJ PP,SUSE.X ;SAVE CURRENT NOW
HRRZ TE,EOPLOC
JRST SING3
SUSE.X: HLRE TE,RESNXT
CAML TE,[-2] ;SPACE FOR TWO MORE ENTRIES?
PUSHJ PP,XPNRES ;NO
MOVE TE,RESNXT
PUSH TE,ESUSE
PUSH TE,ESUSE+1 ;SAVE
MOVEM TE,RESNXT
POPJ PP,
;"GIVING" OPERATOR
SGIV.G: SKIPE ESGIV
JRST DUPL
SKIPE ESOUTP
JRST BOTHO
MOVEI TD,ESGIV
JRST SUSEG1
;"INPUT PROCEDURE" OPERATOR
SIN.G: SKIPE ESINP
JRST DUPL
SKIPE ESUSE
JRST BOTHI
MOVEI TD,ESINP
SING1: MOVE TC,-1(EACA)
MOVEM TC,2(TD)
MOVE TC,0(EACA)
MOVEM TC,3(TD)
HRRZ TE,EOPLOC
ADDI TE,2
MOVE TC,-1(TE)
MOVEM TC,0(TD)
MOVE TC,0(TE)
MOVEM TC,1(TD)
CAIN TE,(EACA)
JRST SRTGN1
SING3: ADDI TE,2
CAIE TE,(EACA)
JRST BADSOP
JRST SRTGN1
;"OUTPUT PROCEDURE" OPERATOR
SOUT.G: SKIPE ESOUTP
JRST DUPL
SKIPE ESGIV
JRST BOTHO
MOVEI TD,ESOUTP
JRST SING1
;"KEY" OPERATOR
SKEY.G: HRRZ TE,EOPLOC
ADDI TE,2
CAIE TE,(EACA)
JRST SRTGN1
LDB TE,[POINT 3,0(EACA),20]
CAIE TE,TB.DAT
JRST KNOTD
HLRE TE,RESNXT
CAML TE,[-2]
PUSHJ PP,XPNRES
MOVE TE,RESNXT
MOVE TC,EOPLOC
PUSH TE,1(TC)
MOVE TD,2(TC)
TLNE W1,ASCKEY
TLOA TD,GNROUN
TLZ TD,GNROUN
PUSH TE,TD
MOVEM TE,RESNXT
AOS EKEYNO## ;COUNT NUMBER OF KEYS SAVED
MOVEI TC,1(TC)
MOVEI LN,EBASEA
PUSHJ PP,SETOPN
HRRZ TE,EMODEA
CAILE TE,C3MODE
TDCA TE,TE
XCT KEYSIZ(TE)
ADDM TE,EKEYSZ
JRST SRTGN1
;"COLLATING SEQUENCE" OPERATOR
IFN ANS74,<
SCOL.G: HRRZ TE,EOPLOC
ADDI TE,2
CAIE TE,(EACA)
JRST SRTGN1
MOVE TA,0(TE)
PUSHJ PP,LNKSET ;LINK TO IT
MOVE TA,1(TA) ;GET CODE BITS
TLNN TA,(1B6) ;ALPHABET-NAME?
JRST [MOVEI DW,E.713 ;NO, BUT IT MUST BE
JRST FATAL]
MOVE TE,EMODEA
HRRZ TA,TA ;ADDRESS ONLY
CAIE TA,%AN.AS ;[1004] IS IT JUST ASCII
CAIN TA,%AN.EB ;OR EBCDIC
CAIA ;[1004] YES, LEAVE AS IS FOR NOW
ADD TA,[OCT 200,0,300](TE) ;ADD IN OFFSET
HRRZM TA,ESCOLS## ;STORE COLLATING SEQUENCE
JRST SRTGN1
>
;"END OF SORT" OPERATOR
SEND.G: TSWF FERROR;
POPJ PP,
MOVEI CH,PSORT.
SKIPE EMRGFL
MOVEI CH,PMERG.## ;CHANGE IF MERGE
PUSHJ PP,PUT.PJ
IFN ANS74,<
;IF COLLATING SEQUENCE IS ASCII OR EBCDIC WE MUST RECOMPUTE THE KEY SIZE
;USING THE OTHER BYTE SIZE
HRRZ TE,EMODEA ;[1004] GET MODE
SKIPE TA,ESCOLS ;[1004] GET SORT COLLATING SEQUENCE
JRST SEQKEY ;[1004] JUMP IF ONE GIVEN
SKIPN TA,COLSEQ## ;[1004] NO, IS THERE A PROGRAM COLLATING SEQUENCE
JRST PUTSIZ ;[1004] NO
JUMPL TA,SEQKEY ;[1004] JUMP IF JUST ASCII OR EBCDIC
MOVE TE,COLSQS##(TE) ;[1004] GET RIGHT LITERAL
MOVEM TE,ESCOLS ;[1004] STORE IT
JRST PUTSIZ ;[1004]
SEQKEY: HRRZ TA,TA ;[1004] ADDRESS ONLY
CAIN TA,%AN.AS ;[1004] IS IT JUST ASCII
JRST COLASC ;[1004] YES
CAIN TA,%AN.EB ;[1004] OR EBCDIC
JRST COLEBC ;[1004] YES
IORI TA,AS.LIT## ;[1004] NO, MAKE LITERAL
HRRZM TA,ESCOLS ;[1004] STORE COLLATING SEQUENCE
JRST PUTSIZ ;[1004]
COLASC: SKIPA TA,[EXP 0,0,%AN.AS](TE) ;[1004] ASCII MODE
COLEBC: MOVE TA,[EXP %AN.EB,%AN.EB,0](TE) ;[1004] EBCDIC MODE
MOVEM TA,ESCOLS ;[1004]
;NOW WE HAVE TO RECOMPUTE THE KEY SIZE USING THE OTHER BYTE SIZE
;LOOK AT ALL KEYS IN STORED IN RESTAB
MOVE TC,RESLOC ;[1004]
CAMN TC,RESNXT ;[1004] ANY KEYS?
JRST PUTSIZ ;[1004] NO--FORGET IT
MOVEI TC,1(TC) ;[1004] YES--GET ADDRESS OF FIRST ONE
MOVEM TC,CUREOP ;[1004]
MOVEM TC,CURRES ;[1004] USE THIS IN CASE TABLES GET MOVED
PUSH PP,EKEYNO ;[1004] NUMBER OF KEYS TO CHECK
MOVEI TE,WSCBIT ;[1004] MUST PRESERVE THIS BIT
ANDM TE,EKEYSZ ;[1004] BUT CLEAR REST OF KEY SIZE
CHKKEY: MOVEI LN,EBASEA ;[1004]
PUSHJ PP,SETOPN ;[1004]
HRRZ TE,EMODEA ;[1004]
CAILE TE,C3MODE ;[1004]
TDCA TE,TE ;[1004]
XCT KEYSIZ(TE) ;[1004]
ADDM TE,EKEYSZ ;[1004]
MOVEI TC,2 ;[1004]
ADDB TC,CURRES ;[1004] NEXT KEY
MOVEM TC,CUREOP ;[1004]
SOSLE EKEYNO ;[1004] IF THERE IS ONE
JRST CHKKEY ;[1004] YES
POP PP,EKEYNO ;[1004] RESET NO. OF KEYS
PUTSIZ: ;[1004]
>
MOVE CH,[XWD AS.XWD,2]
PUSHJ PP,PUTASN
HRLZ CH,EKEYSZ ;IN CASE WITH SEQUENCE CHECK BIT
HRRI CH,AS.CNB ;IN WHICH CASE SIGN BIT WILL BE ON
PUSHJ PP,PUTASY
HRRZ CH,ESORTF+1
TRZ CH,7B20
IORI CH,4B20
PUSHJ PP,PUTASN
MOVS CH,EAS1PC
TLO CH,AS.PAR
HRRI CH,AS.MSC
PUSHJ PP,PUTASY
MOVE CH,[XWD AS.DOT+2,AS.MSC]
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA##
PUSHJ PP,GETTAG
MOVEM CH,ESTAG1
HRLI CH,XJRST.## ;SO THE OPTIMIZER DOES'NT REMOVE THE FOLLOWING CODE
PUSHJ PP,PUTASY
HRRZ TA,ESTAG1
PUSHJ PP,REFTAG ;COUNT REFERENCE
MOVE TE,EKEYSZ
TRZ TE,WSCBIT ;CLEAR WITH SEQUENCE CHECK BIT
EXCH TE,EAS1PC
ADDM TE,EAS1PC
IORI TE,AS.PAR
MOVEM TE,EKEYLC
MOVE CH,[XWD AS.REL+1,AS.MSC]
PUSHJ PP,PUTAS1
HRRZ CH,EAS1PC
IORI CH,AS.PAR
PUSHJ PP,PUTAS1
;GET READY TO LOOK AT ALL KEYS AND GENERATE "KEY BUILDER"
MOVE TC,RESLOC
CAMN TC,RESNXT ;ANY KEYS?
JRST ENDKEY ;NO--FORGET IT
MOVEI TC,1(TC) ;YES--GET ADDRESS OF FIRST ONE
MOVEM TC,CUREOP
MOVEM TC,CURRES## ;USE THIS IN CASE TABLES GET MOVED
;PUT OUT CODE TO GENERATE KEYS
GETKEY: MOVSM TC,OPERND
MOVEI LN,EBASEA
PUSHJ PP,SETOPN
MOVEI DW,E.613 ;[623] PREPARE FOR THE WORST
LDB TE,DA.OCC## ;[623] TEST FOR OCCURS CLAUSE
JUMPN TE,GETKR1 ;[623] ERROR IF FOUND
LDB TE,DA.DLL## ;[623] TEST FOR VARIABLE LENGTH
JUMPN TE,GETKR1 ;[623] ERROR IF FOUND
HRRZ TA,1(TC) ;[554] POINT TO DATAB LINK
GETK01: PUSHJ PP,LNKFA## ;[554] POINT TA TO 01 LEVEL
LDB TE,DA.DFS## ;[554] IS THERE A FILE
JUMPE TE,GETKER ;[554] NO, MUST BE AN ERROR
LDB TE,DA.FAL## ;[554] IS THIS THE ONE THAT POINTS TO FILE
JUMPE TE,[LDB TA,DA.BRO## ;[554] NO, TRY NEXT BROTHER
JUMPE TA,GETKER ;[554] NO BROTHER, MUST BE AN ERROR
JRST GETK01] ;[554]
LDB TE,DA.POP## ;[554] GET FATHER LINK
CAMN TE,ESORTF+1 ;[554] IS IT THE SORT-FILE
JRST GETKOK ;[554] YES
GETKER: HRRZI DW,E.610 ;[554] NO
GETKR1: PUSHJ PP,OPNFAT ;[623] [554] WARN USER
GETKOK: SETZM EAC ;[554]
HRRZ TE,EMODEA
CAIG TE,C3MODE
JUMPGE TE,@KEYTYP(TE)
MOVEI DW,E.276
PUSHJ PP,OPNFAT
SWON FERROR;
NXTKEY: SKIPE TC,EKREPF## ;WANT TO REPEAT CURRENT KEY?
JRST (TC) ;YES
MOVEI TC,2
ADDB TC,CURRES
MOVEM TC,CUREOP ;CONT. TO UPDATE IN CASE USED ELSEWHERE
SOSLE EKEYNO ;ANY MORE TO DO
JRST GETKEY
ENDKEY: MOVSI CH,POPJ.+17B30
PUSHJ PP,PUTASY
MOVE CH,ESTAG1
PUSHJ PP,PUTTAG
JRST KEYDUN
;PUT OUT CODE TO GENERATE KEYS (CONT'D).
;KEY IS EITHER A 1-WORD COMP OR FLOATING POINT.
KEYFP:
KEY1C: PUSHJ PP,MXAC.
KEY1CA: MOVE TC,CURRES ;[452] GET THE RESTAB ADDRESS IN CASE OF CORE EXPANSION
MOVE TE,1(TC)
MOVE CH,[XWD MOVEM.,AS.MSC]
TLNN TE,GNROUN ;ASCENDING?
HRLI CH,SETCA. ;NO, COMPLIMENT
PUSHJ PP,PUT.XA
HRRZ CH,EKEYLC
PUSHJ PP,PUTASN
AOS EKEYLC
JRST NXTKEY
;KEY IS A 2-WORD COMP
KEY2C: PUSHJ PP,MXAC.
KEY2CA: MOVE TC,CURRES ;[452] GET THE RESTAB ADDRESS IN CASE OF CORE EXPANSION
MOVE TE,1(TC)
TLNE TE,GNROUN
JRST KEY2CB
MOVE CH,[XWD SETCA.,AS.MSC]
PUSHJ PP,PUT.XA
HRRZ CH,EKEYLC
PUSHJ PP,PUTASN
MOVE CH,[XWD SETCA.,AS.MSC]
PUSHJ PP,PUT.XB
AOS CH,EKEYLC
PUSHJ PP,PUTASN
JRST KEY2CC
KEY2CB:
IFN BIS,<
PUSHJ PP,PUTASA##
MOVE CH,[DMOVM.##,,AS.MSC]
>
IFE BIS,<
MOVE CH,[XWD MOVEM.,AS.MSC]
>
PUSHJ PP,PUT.XA
HRRZ CH,EKEYLC
PUSHJ PP,PUTASN
IFE BIS,<
MOVE CH,[XWD MOVEM.,AS.MSC]
PUSHJ PP,PUT.XB
AOS CH,EKEYLC
PUSHJ PP,PUTASN
>
IFN BIS,<
AOS EKEYLC
>
KEY2CC: AOS EKEYLC
JRST NXTKEY
;PUT OUT CODE TO GENERATE KEYS (CONT'D).
;KEY IS DISPLAY
KEYD: TSWT FANUM;
JRST KEYDN
;KEY IS NUMERIC OR COMP-3.
KEYC3: SETOM ESAFLG## ;LEAVE RESULT IN ANY ACC
PUSHJ PP,MXAC.
SETZM ESAFLG
MOVE TE,ESIZEA
CAILE TE,^D10
JRST KEY2CA
JRST KEY1CA
;THE KEY IS NON-NUMERIC DISPLAY
KEYDN:
IFN ANS74,<
SKIPE TE,ESCOLS ;[1004] SEE IF COLL. SEQ. IS SPECIAL
CAIE TE,%AN.AS ;[1004] I.E. ASCII
CAIN TE,%AN.EB ;[1004] OR EBCDIC
JRST KEYCS ;[1004] YES
>
MOVEI CH,KEY.##
PUSHJ PP,PUT.PJ
PUSHJ PP,BYTE.A
MOVSI CH,AS.BYT
HRR CH,TB
PUSHJ PP,PUTASY
MOVE CH,TA
HLR CH,TB
PUSHJ PP,PUTASN
MOVE CH,[XWD AS.XWD,1]
IFN ANS74,<
SKIPE ESCOLS ;GET SORT/MERGE COLLATING SEQUENCE
ADDI CH,1 ;YES, NEED TO OUTPUT PTR ALSO
>
PUSHJ PP,PUTASN
HRLZ CH,ESIZEA
MOVE TE,CURRES ;[452] GET THE RESTAB ADDRESS INCASE OF CORE EXPANSION
MOVE TE,1(TE)
TLNN TE,GNROUN
TLO CH,1B18
IFN ANS74,<
SKIPE ESCOLS ;COLLATING SEQUENCE?
TLO CH,(1B1) ;YES, SIGNAL ADDRESS TO FOLLOW
>
HRRI CH,AS.CNB
PUSHJ PP,PUTASY
MOVEI CH,AS.MSC
HRL CH,EKEYLC
PUSHJ PP,PUTASN
IFN ANS74,<
SKIPG ESCOLS ;[1004] COLLATING SEQUENCE?
JRST KEYDNC ;NO
SETZ CH, ;LHS = 0
PUSHJ PP,PUTASY
HRLZ CH,ESCOLS ;GET LITERAL
HRRI CH,AS.MSC
PUSHJ PP,PUTASN ;OUTPUT PTR TO COLLATING SEQUENCE
KEYDNC:>
MOVE TE,EMODEA
XCT KEYSIZ(TE)
ADDM TE,EKEYLC
JRST NXTKEY
;HERE TO GENERATE CODE FOR ASCII AND EBCDIC COL. SEQ.
IFN ANS74,<
KEYCS: MOVE TE,[44,,AS.MSC] ;[1004] OFFSET
MOVEM TE,EBASEB ;[1004] START TO FAKE A "B" OPERAND
MOVE TE,EKEYLC ;[1004] GET CURRENT %PARAM VALUE
MOVEM TE,EINCRB## ;[1004] OFFSET INTO %PARAM
MOVE TE,ESIZEA ;[1004]
MOVEM TE,ESIZEB ;[1004] SAME SIZE
MOVE TE,EMODEA ;[1004]
MOVE TE,[EXP D9MODE,D9MODE,D7MODE](TE) ;[1004]
MOVEM TE,EMODEB ;[1004] BUT OTHER MODE
SETZM EDPLB## ;[1004] CLEAR REST OF THE DATA
SETZM EBYTEB## ;[1004] ...
SETZM ETABLB## ;[1004] ...
SETZM EFLAGB## ;[1004] ...
SWOFF FBSUB!FBNUM ;[1004] MAKE SURE THEY ARE CLEAR
MOVE TE,EMODEA ;[1004] IF THE MODE OF "B" IS ASCII
CAIE TE,D9MODE ;[1004] (I.E. MODE OF "A" IS EBCDIC)
JRST KEYCS0 ;[1004] NO IT ISN'T
XCT KEYSIZ(TE) ;[1004] GET SIZE IN WORDS
CAILE TE,4 ;[1004] ASCII AND 4 WORDS OR LESS?
JRST KEYCS0 ;[1004] NO
HLLZS EBASEB ;[1004] USE ACC 0
SETZM EINCRB ;[1004] NO OFFSET
PUSHJ PP,MXX. ;[1004] GET INTO THE ACCS
MOVEI TE,AS.MSC ;[1004]
HRRM TE,EBASEB ;[1004] PUT "B" BACK AS %PARAM
CAIA ;[1004]
KEYCS0: PUSHJ PP,MXX. ;[1004] MOVE "A" TO "B"
MOVE TE,EKEYLC ;[1004] RESET ORIGINAL OFFSET
MOVEM TE,EINCRB ;[1004] INCASE MXX. CHANGED IT
MOVE TE,EMODEA ;[1004]
XCT KEYSIZ(TE) ;[1004] GET THE SIZE OF THIS KEY
ADDM TE,EKEYLC ;[1004]
MOVE TC,CURRES ;[1004] GET THE RESTAB ADDRESS IN CASE OF CORE EXPANSION
MOVE TE,EMODEB ;[1004] GET MODE OF EXTRACTED KEY
CAIE TE,D9MODE ;[1004] EBCDIC MAYBE OK
JRST KEYCS2 ;[1004] BUT ASCII NEEDS SHIFTED RIGHT
MOVE TE,1(TC) ;[1004] SEE IF DESCENDING KEY
TLNN TE,GNROUN ;[1004] DESCENDING?
JRST KEYCS1 ;[1004] YES
MOVE TE,ESIZEA ;[1004] GET SIZE
IDIVI TE,4 ;[1004] GET WORD SIZE AND REMAINDER
ADDM TE,EINCRB ;[1004] POINT TO LAST WORD
JRST @.+1(TD) ;[1004]
NXTKEY ;[1004] NONE, GET NEXT KEY
KEYCSA ;[1004] 1 BYTE ONLY
KEYCSB ;[1004] 2 BYTES
KEYCSC ;[1004] 3 BYTES
KEYCSA: MOVE CH,[MOVSI.##,,AS.CNB] ;[1004]
PUSHJ PP,PUTASY ;[1004]
MOVEI CH,777000 ;[1004]
PUSHJ PP,PUTASN ;[1004] MOVSI 0,777000
MOVSI CH,ANDM.## ;[1004]
PUSHJ PP,PUT.B ;[1004] ANDM 0,%PARAM+N
JRST NXTKEY ;[1004]
KEYCSB: PUSHJ PP,PUTASA ;[1004]
MOVSI CH,HLLZS.## ;[1004] CLEAR RHS
PUSHJ PP,PUT.B ;[1004] HLLZS %PARAM+N
JRST NXTKEY ;[1004]
KEYCSC: MOVE CH,[HRRZI.##,,777] ;[1004] LIST IN OCTAL
PUSHJ PP,PUTASY ;[1004] HRRZI 0,777
PUSHJ PP,PUTASA ;[1004]
MOVSI CH,NDCAM.## ;[1004]
PUSHJ PP,PUT.B ;[1004] ANDCAM 0,%PARAM+N
JRST NXTKEY ;[1004]
KEYCS1: MOVE TE,ESIZEA ;[1004]
CAIGE TE,4 ;[1004] LESS THAN 1 FULL WORD?
JRST KEYCSE ;[1004] YES
KEYCSD: HRLI CH,SETCM.## ;[1004] COMPLIMENT THE EXTRACTED KEY
PUSHJ PP,PUT.B## ;[1004] SETCMM %PARAM+N
AOS TE,EINCRB ;[1004] INCREMENT "B"
ADDI TE,1 ;[1004] POINT TO NEXT %PARAM
CAMGE TE,EKEYLC ;[1004] DONE THEM ALL?
JRST KEYCSD ;[1004] NOT YET
KEYCSE: MOVE TE,ESIZEA ;[1004] GET SIZE
ANDI TE,3 ;[1004] GET REMAINDER
JRST @.+1(TE) ;[1004]
KEYCSJ ;[1004] NONE, FINISH OFF LAST WORD
KEYCSF ;[1004] 1 BYTE ONLY
KEYCSG ;[1004] 2 BYTES
KEYCSH ;[1004] 3 BYTES
KEYCSF: MOVE CH,[MOVSI.,,AS.CNB] ;[1004]
PUSHJ PP,PUTASY ;[1004]
MOVEI CH,777000 ;[1004]
PUSHJ PP,PUTASN ;[1004] MOVSI 0,777000
PUSHJ PP,PUTASA ;[1004]
MOVSI CH,AND..## ;[1004]
PUSHJ PP,PUT.B ;[1004] AND 0,%PARAM+N
JRST KEYCSI ;[1004]
KEYCSG: PUSHJ PP,PUTASA ;[1004]
MOVSI CH,HLLZ.## ;[1004] CLEAR RHS
PUSHJ PP,PUT.B ;[1004] HLLZ 0,%PARAM+N
JRST KEYCSI ;[1004]
KEYCSH: MOVSI CH,MOV ;[1004]
PUSHJ PP,PUT.B ;[1004] MOVE 0,%PARAM+N
PUSHJ PP,PUTASA ;[1004]
MOVE CH,[TRZ.,,777] ;[1004]
PUSHJ PP,PUTASY ;[1004] TRZ 0,777
KEYCSI: MOVSI CH,SETCA. ;[1004]
PUSHJ PP,PUT.B ;[1004] SETCAM 0,%PARAM+N
JRST NXTKEY ;[1004]
KEYCSJ: MOVSI CH,SETCM. ;[1004]
PUSHJ PP,PUT.B ;[1004] SETCMM 0,%PARAM+N
JRST NXTKEY ;[1004]
KEYCS2: PUSHJ PP,WORD.A ;[1004] GET SIZE
CAIG TE,4 ;[1004] WAS IT SPECIAL?
JRST KEYCS4 ;[1004] YES, ITS ALREADY IN THE ACCS
KEYCS3: CAIG TE,1 ;[1004] 2 OR MORE WORDS?
JRST KEYCS8 ;[1004] NO, JUST ONE LEFT
IFN BIS,<
PUSHJ PP,PUTASA ;[1004] IN OTHER SET
MOVSI CH,DMOVE. ;[1004] GET WORDS IN TO ACC 0 & 1
>
IFE BIS,<
MOVSI CH,MOV ;[1004] GET THE WORD INTO ACC 0
>
PUSHJ PP,PUT.B ;[1004] DMOVE 0,%PARAM+N
IFE BIS,<
AOS EINCRB ;[1004]
MOVSI CH,MOV+AC1 ;[1004] SECOND WORD
PUSHJ PP,PUT.B ;[1004]
SOS EINCRB ;[1004] PUT BACK OFFSET
>
PUSHJ PP,KEYCS5 ;[1004] COMMON CODE TO STORE 2 WORDS
JUMPLE TE,NXTKEY ;[1004] ALL DONE
JRST KEYCS3 ;[1004] NOT YET
KEYCS4: CAIG TE,1 ;[1004] 2 OR MORE WORDS?
JRST KEYCS9 ;[1004] NO, JUST ONE
PUSHJ PP,KEYCS5 ;[1004] COMMON CODE TO STORE 2 WORDS
JUMPLE TE,NXTKEY ;[1004] ALL DONE
JRST KEYCS4 ;[1004] NOT YET
KEYCS5: PUSHJ PP,PUTASA ;[1004] IN OTHER SET
MOVE CH,[LSH.,,AS.CNB] ;[1004]
PUSHJ PP,PUTASY ;[1004]
MOVEI CH,-1 ;[1004]
PUSHJ PP,PUTASN ;[1004] LSH 0,-1
PUSHJ PP,PUTASA ;[1004] IN OTHER SET
MOVE CH,[LSH.+AC1,,AS.CNB] ;[1004]
PUSHJ PP,PUTASY ;[1004]
MOVEI CH,-1 ;[1004]
PUSHJ PP,PUTASN ;[1004] LSH 1,-1
MOVE TE,1(TC) ;[1004] SEE IF DESCENDING KEY
TLNN TE,GNROUN ;[1004] IS IT?
JRST KEYCS6 ;[1004] YES
IFN BIS,<
PUSHJ PP,PUTASA ;[1004] IN OTHER SET
MOVSI CH,DMOVM. ;[1004]
>
IFE BIS,<
MOVSI CH,MOVEM. ;[1004] ASCENDING
>
PUSHJ PP,PUT.B ;[1004] STORE BACK
AOS EINCRB ;[1004]
IFE BIS,<
MOVSI CH,MOVEM.+AC1 ;[1004] SECOND WORD
PUSHJ PP,PUT.B ;[1004]
>
JRST KEYCS7 ;[1004]
KEYCS6: MOVSI CH,SETCA. ;[1004] NO, COMPLIMENT THE EXTRACTED KEY
PUSHJ PP,PUT.B ;[1004] STORE BACK
AOS EINCRB ;[1004]
MOVSI CH,SETCA.+AC1 ;[1004]
PUSHJ PP,PUT.B ;[1004] STORE THE SECOND WORD
KEYCS7: AOS EINCRB ;[1004] INCREMENT %PARAM
MOVE TE,EKEYLC ;[1004] GET END LOCATION
SUB TE,EINCRB ;[1004] WHERE WE ARE NOW
POPJ PP, ;[1004] RETURN WITH TE SETUP
KEYCS8: MOVSI CH,MOV ;[1004] GET LAST WORD INTO THE ACCS
PUSHJ PP,PUT.B ;[1004]
KEYCS9: PUSHJ PP,PUTASA ;[1004] IN OTHER SET
MOVE CH,[LSH.,,AS.CNB] ;[1004]
PUSHJ PP,PUTASY ;[1004]
MOVEI CH,-1 ;[1004]
PUSHJ PP,PUTASN ;[1004] LSH 0,-1
MOVE TE,1(TC) ;[1004] SEE IF DESCENDING KEY
MOVSI CH,MOVEM. ;[1004] ASSUME ASCENDING
TLNN TE,GNROUN ;[1004] IS IT?
HRLI CH,SETCA. ;[1004] NO, COMPLIMENT THE EXTRACTED KEY
PUSHJ PP,PUT.B ;[1004] STORE BACK
JRST NXTKEY ;[1004]
>
SUBTTL SIXBIT KEYS
KEYDS:
IFN ANS74,<
SKIPN ESCOLS ;COLLATING SEQUENCE?
>
TSWF FANUM ;OR NUMERIC
JRST KEYD ;YES
HLRZ TE,ERESA ;GET RESIDUE
IDIVI TE,6 ;GET BYTE POSITION IN FIRST WORD
SKIPG TD,ESIZEA ;[1100] GET SORT KEY SIZE, IF > ZERO
JRST KEYDUN ;[1100] ELSE ABORT ATTEMPT TO GENERATE KEY
CAILE TD,D6KMAX ;TOO BIG?
JRST D6KTX ;YES, TOO COMPLICATED FOR 1 PASS
JRST @D6KTAB-1(TD) ;DISPATCH
D6KTAB: @D6KT1-1(TE)
@D6KT2-1(TE)
@D6KT3-1(TE)
@D6KT4-1(TE)
@D6KT5-1(TE)
@D6KT6-1(TE)
@D6KT7-1(TE)
@D6KT8-1(TE)
@D6KT9-1(TE)
@D6KTA-1(TE)
@D6KTB-1(TE)
D6KMAX==.-D6KTAB
;1 BYTE - SIXBIT
D6KT1: EXP D6KT11,D6KT12,D6KT13,D6KT14,D6KT15,D6KT16
D6KT14: PUSHJ PP,PUTASA
SKIPA CH,[HLRZ.,,0]
D6KT11: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,77]
K1CASY: PUSHJ PP,PUTASY
JRST KEY1CA ;STORE THE RESULT
D6KT15: PUSHJ PP,PUTASA
SKIPA CH,[HLRZ.,,0]
D6KT12: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,7700]
JRST K1CASY ;STORE THE RESULT
D6KT16: PUSHJ PP,PUTASA
SKIPA CH,[HLRZ.,,0]
D6KT13: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,770000
K1CASN: PUSHJ PP,PUTASN
JRST KEY1CA ;STORE THE RESULT
;2 BYTES - SIXBIT
D6KT2: EXP D6KT21,D6KT22,D6KT23,D6KT24,D6KT25,D6KT26
D6KT21: PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,HRLZ. ;FOR HRLZ
PUSHJ PP,PUT.A ;
AOS EINCRA ;ADVANCE TO NEXT WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
MOVE TA,[77,,770000]
D6KT2M: PUSHJ PP,POOLIT ;MASK FOR 2 CHARACTERS
PUSHJ PP,PUTASA
MOVE CH,[AND..+ASINC,,AS.MSC]
PUSHJ PP,MAKPTC ;FINISH OFF THE LOAD
JRST KEY1CA ;AND DO THE STORE
D6KT24:
D6KT2C: MOVEI TE,2
D6KTMB: MOVEM TE,NBYTES
SETOM USENBT
PUSHJ PP,MAKBPT
JRST KEY1CA ;STORE THE RESULT
D6KT25: PUSHJ PP,PUTASA
SKIPA CH,[HLRZ.,,0]
D6KT22: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,7777]
JRST K1CASY ;STORE THE RESULT
D6KT26: PUSHJ PP,PUTASA
SKIPA CH,[HLRZ.,,0]
D6KT23: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,777700
JRST K1CASN ;STORE THE RESULT
;3 BYTES - SIXBIT
D6KT3: EXP D6KT31,D6KT32,D6KT33,D6KT34,D6KT35,D6KT36
D6KT31:D6KT32:
PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,HRLZ. ;FOR HRLZ
PUSHJ PP,PUT.A ;
AOS EINCRA ;ADVANCE TO NEXT WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
HLRZ TE,ERESA ;[555] GET RESIDUE AGAIN
CAIE TE,14 ;2 BYTES IN FIRST WORD?
SKIPA TA,[77,,777700] ;NO
MOVE TA,[7777,,770000] ;YES
JRST D6KT2M ;JOIN COMMON CODE
D6KT33: PUSHJ PP,PUTASA
MOVSI CH,HRRZ.
K1C.A: PUSHJ PP,PUT.A
JRST KEY1CA
D6KT34:D6KT35:
D6KT3C: MOVEI TE,3
JRST D6KTMB
D6KT36: PUSHJ PP,PUTASA
MOVSI CH,HLRZ.
JRST K1C.A
;4 BYTES - SIXBIT
D6KT4: EXP D6KT41,D6KT42,D6KT43,D6KT44,D6KT45,D6KT46
D6KT41:D6KT42:D6KT43:
PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,HRLZ. ;FOR HRLZ
PUSHJ PP,PUT.A ;
AOS EINCRA ;ADVANCE TO NEXT WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
HLRZ TE,ERESA ;GET RESIDUE AGAIN
CAIN TE,22 ;RIGHT HALF OF FIRST WORD?
JRST D6KT4R ;YES
CAIN TE,6 ;LEFT HALF OF SECOND WORD?
JRST D6KT4L ;YES
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
MOVE TA,[7777,,777700] ;YES
JRST D6KT2M
D6KT44: MOVSI CH,MOV
PUSHJ PP,PUT.A
D6KT4L: MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,777700
JRST K1CASN ;STORE THE RESULT
D6KT45:
D6KT4C: MOVEI TE,4
JRST D6KTMB
D6KT46: MOVSI CH,MOV
PUSHJ PP,PUT.A
D6KT4R: PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D12
JRST K1CASN ;STORE THE RESULT
;5 BYTES - SIXBIT
D6KT5: EXP D6KT51,D6KT52,D6KT53,D6KT54,D6KT55,D6KT56
D6KT51: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D24]
D6KT5L: PUSHJ PP,PUTASY
D6KT5T: MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,770000
JRST K1CASN ;STORE THE RESULT
D6KT52: PUSHJ PP,PUTASA
MOVSI CH,HRLZ.
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
JRST D6KT5T
D6KT53: PUSHJ PP,PUTASA
MOVSI CH,HRLZ.
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLR.
D6KT5N: PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-6
JRST K1CASN ;STORE THE RESULT
D6KT54: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,6]
JRST D6KT5L
D6KT55: MOVSI CH,MOV
PUSHJ PP,PUT.A
JRST D6KT5T
D6KT56: MOVSI CH,MOV
JRST D6KT5N
;6 BYTES - SIXBIT
D6KT6: EXP D6KT61,D6KT62,D6KT63,D6KT64,D6KT65,D6KT66
D6KT61:D6KT62:D6KT64:
PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
HLRZ TE,ERESA ;GET RESIDUE AGAIN
MOVE CH,[LSHC.,,^D35]
SUB CH,TE ;CALCULATE SHIFT
PUSHJ PP,PUTASY
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,400000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D35
K2CASN: PUSHJ PP,PUTASN
JRST KEY2CA ;AND STORE KEY
D6KT63: PUSHJ PP,PUTASA
MOVSI CH,HRLZ.
PUSHJ PP,PUT.A
AOS EINCRA ;NEXT WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.
D6KT6W: PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVSI CH,SETZ.+AC1 ;CLEAR AC1
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1 ;LSHC 0,-1
PUSHJ PP,PUTASN
D6KTL1: PUSHJ PP,PUTASA ;LSH AC1,-1
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1 ;LSH 1,-1
JRST K2CASN ;STORE 2 WORDS
D6KT65:
IFN BIS,<
PUSHJ PP,DMOVE2
>
IFE BIS,<
MOVSI CH,MOV
PUSHJ PP,PUT.A
>
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,770000
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
IFN BIS,<
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D30
>
IFE BIS,<
AOS EINCRA
MOVSI CH,HLRZ.+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.+AC1+ASINC,,AS.CNB] ;[703] GET SECOND PART
PUSHJ PP,PUTASY
MOVEI CH,770000
>
JRST K2CASN ;STORE 2 WORDS
D6KT66: MOVSI CH,MOV
JRST D6KT6W
;7 BYTES - SIXBIT
D6KT7: EXP D6KT71,D6KT72,D6KT73,D6KT74,D6KT75,D6KT76
D6KT71:D6KT72:D6KT74:D6KT75:
PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
HLRZ TE,ERESA
MOVE CH,[LSHC.,,^D35]
SUB CH,TE ;CALCULATE SHIFT
PUSHJ PP,PUTASY
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,400000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
D6KT7C: PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D29
JRST K2CASN ;STORE 2 WORDS
D6KT73: PUSHJ PP,PUTASA
MOVSI CH,HRRZ.
PUSHJ PP,PUT.A
AOS EINCRA
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D17]
PUSHJ PP,PUTASY ;[560] GENERATE INSTRUCTION
JRST D6KT7C
D6KT76: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1 ;JUST LSHC 0,-1
PUSHJ PP,PUTASN
JRST D6KT7C
;8 BYTES - SIXBIT
D6KT8: EXP D6KT81,D6KT82,D6KT83,D6KT84,D6KT85,D6KT86
D6KT81: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,77]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D29]
D6KT8A: PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVSI CH,HLR.+AC1 ;[647] GET LAST BYTE FROM LHS
AOS EINCRA
PUSHJ PP,PUT.A ;GET LAST BYTE
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D12
JRST K2CASN ;STORE 2 WORDS
D6KT82: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,7777]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D23]
PUSHJ PP,PUTASY
JRST D6KTL1 ;LSH AC1,-1
D6KT83: PUSHJ PP,PUTASA
MOVSI CH,HRRZ.
PUSHJ PP,PUT.A
AOS EINCRA
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D17]
PUSHJ PP,PUTASY
JRST D6KT8C
D6KT84: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D11]
PUSHJ PP,PUTASY
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,400000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
D6KT8C:
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D23
JRST K2CASN ;STORE 2 WORDS
D6KT85: MOVEI TE,5
MOVEM TE,NBYTES ;PICK UP FIRST 5 BYTES
SETOM USENBT
PUSHJ PP,MAKBPT
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLRZ.+AC1
K2C.A: PUSHJ PP,PUT.A
JRST KEY2CA
D6KT86: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1 ;JUST LSHC 0,-1
PUSHJ PP,PUTASN
JRST D6KT8C
;9 BYTES - SIXBIT
D6KT9: EXP D6KT91,D6KT92,D6KT93,D6KT94,D6KT95,D6KT96 ;[622]
D6KT91: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,77]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D29]
D6KT9A: PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
AOS EINCRA
MOVSI CH,HLR.+AC1
PUSHJ PP,PUT.A ;[615]
D6KT9B: PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-6
JRST K2CASN ;STORE 2 WORDS
D6KT92: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,7777]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D23]
JRST D6KT8A
D6KT93: PUSHJ PP,PUTASA
MOVSI CH,HRRZ.
PUSHJ PP,PUT.A
AOS EINCRA
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D17]
PUSHJ PP,PUTASY
JRST D6KTL1 ;LSH AC1,-1
D6KT94: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D11]
JRST D6KT9C
D6KT95: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,5]
D6KT9C: PUSHJ PP,PUTASY
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,400000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D17
JRST K2CASN ;STORE 2 WORDS
D6KT96: MOVSI CH,MOV
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLLZ.+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1 ;JUST LSHC 0,-1
PUSHJ PP,PUTASN
JRST D6KTL1 ;LSH AC1,-1
;10 BYTES - SIXBIT
D6KTA: EXP D6KTA1,D6KTA2,D6KTA3,D6KTA4,D6KTA5,D6KTA6
D6KTA1: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,77]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D29]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
AOS EINCRA
MOVSI CH,HLR.+AC1
JRST K2C.A
D6KTA2: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,7777]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D23]
JRST D6KT9A
D6KTA3: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D18]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
AOS EINCRA
MOVSI CH,HLR.+AC1
PUSHJ PP,PUT.A
D6KTAA: PUSHJ PP,PUTASA
MOVE CH,[LSHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1 ;CLEAR SIGN BIT
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D11
JRST K2CASN ;STORE 2 WORDS
D6KTA4: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D11]
PUSHJ PP,PUTASY
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,400000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
JRST D6KTL1 ;LSH AC1,-1
D6KTA5: PUSHJ PP,DMOVE2
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,770000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
JRST D6KT9B
D6KTA6: PUSHJ PP,DMOVE2
JRST D6KTAA
;11 BYTES - SIXBIT
D6KTB: EXP D6KTB1,D6KTB2,D6KTB3,D6KTB4,D6KTB5,D6KTB6
D6KTB1: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,77]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D29]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
AOS EINCRA
MOVEI TE,44
HRLM TE,ERESA ;LEFT HAND BYTES
MOVEI TE,4
MOVEM TE,NBYTES ;4 BYTES LEFT
SETOM USENBT
PUSHJ PP,MAKBP2 ;GET IN AC2
PUSHJ PP,PUTASA
MOVE CH,[IOR.+AC1,,2]
K2CASY: PUSHJ PP,PUTASY
JRST KEY2CA
D6KTB2: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,7777]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D23]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLR.+AC1
JRST K2C.A
D6KTB3: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D18]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
AOS EINCRA
MOVSI CH,HLR.+AC1
PUSHJ PP,PUT.A ;[541]
D6KTBA: PUSHJ PP,PUTASA
MOVE CH,[LSHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1 ;CLEAR SIGN BIT
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-5
JRST K2CASN ;STORE 2 WORDS
D6KTB4: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D11]
PUSHJ PP,PUTASY
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,400000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
AOS EINCRA ;LAST BYTE
MOVEI CH,44 ;[555] FIRST BYTE IN WORD+2
HRLM CH,ERESA ;[555] SO RESET BYTE OFFSET
PUSHJ PP,MAKBP2 ;IN AC2
PUSHJ PP,PUTASA
MOVSI CH,IORI.+AC1+2 ;IORI 1,(2)
JRST K2CASY
D6KTB5: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,5]
PUSHJ PP,PUTASY
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,400000
PUSHJ PP,PUTASN ;CLEAR SIGN BIT
JRST D6KTL1 ;LSH AC1,-1
D6KTB6: PUSHJ PP,DMOVE2
JRST D6KTBA
;LARGE NUMBER OF SIXBIT BYTES
D6KTX: SUBI TD,D6KMAX ;REDUCE BY AMOUNT OF FIRST TRY
MOVEM TD,ESIZEZ ;SAVE IT
HLLZ TE,ERESA ;SAVE RESIDUE
MOVEM TE,EREM0 ;INCASE IT GETS CHANGED
MOVE TE,EINCRA
MOVEM TE,EREM1 ;SAME AGAIN
MOVEI TE,D6KMAX ;SET IT TO 11
MOVEM TE,ESIZEA
MOVEI TE,D6KTXN ;WHERE TO RETURN TO
MOVEM TE,EKREPF ;LET NXTKEY KNOW
JRST KEYDS ;DO FIRST PART
D6KTXN: MOVNI TE,D6KMAX
MOVMM TE,ESIZEA ;SET SIZE FOR NEXT TRY
ADDB TE,ESIZEZ ;REDUCE
JUMPG TE,.+3 ;SOME LEFT
ADDM TE,ESIZEA ;NO
SETZM EKREPF ;DON'T REPEAT EITHER
AOS TE,EREM1 ;ACCOUNT FOR 6 BYTES
MOVEM TE,EINCRA ;RESET INCREMENT
HLRZ TE,EREM0 ;GET RESIDUE
SUBI TE,^D30 ;REDUCE BY 5 BYTES
JUMPG TE,D6KTXA ;STILL IN SAME WORD
ADDI TE,^D36 ;NO RESET BYTE POSITION
AOS EINCRA ;IN NEXT WORD
AOS EREM1 ;AND SAVED VALUE
D6KTXA: HRLM TE,ERESA ;RESET RESIDUE
HRLM TE,EREM0
JRST KEYDS
SUBTTL ASCII KEYS
KEYDA:
IFN ANS74,<
SKIPN ESCOLS ;COLLATING SEQUENCE?
>
TSWF FANUM ;OR NUMERIC
JRST KEYD ;YES
HLRZ TE,ERESA ;GET RESIDUE
IDIVI TE,7 ;GET NO. OF BYTES IN FIRST WORD
SKIPG TD,ESIZEA ;[1100] GET SORT KEY SIZE, IF > ZERO
JRST KEYDUN ;[1100] ELSE ABORT ATTEMPT TO GENERATE KEY
CAILE TD,D7KMAX ;TOO BIG?
JRST D7KTX ;YES, TOO COMPLICATED FOR 1 PASS
JRST @D7KTAB-1(TD) ;DISPATCH
D7KTAB: @D7KT1-1(TE)
@D7KT2-1(TE)
@D7KT3-1(TE)
@D7KT4-1(TE)
@D7KT5-1(TE)
@D7KT6-1(TE)
@D7KT7-1(TE)
@D7KT8-1(TE)
@D7KT9-1(TE)
@D7KTA-1(TE)
D7KMAX==.-D7KTAB
;1 BYTE - ASCII
D7KT1: EXP D7KT11,D7KT12,D7KT13,D7KT14,D7KT15
D7KT11: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,376]
JRST K1CASY ;STORE THE RESULT
D7KT12: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,77400]
JRST K1CASY ;STORE THE RESULT
D7KT13: PUSHJ PP,MAKBPT
JRST KEY1CA
D7KT14: PUSHJ PP,PUTASA
MOVSI CH,HLRZ.
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,3760]
JRST K1CASY ;STORE THE RESULT
D7KT15: PUSHJ PP,PUTASA
MOVSI CH,HLRZ. ;[555]
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,774000
JRST K1CASN ;STORE THE RESULT
;2 BYTES - ASCII
D7KT2: EXP D7KT21,D7KT22,D7KT23,D7KT24,D7KT25
D7KT21: PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,HRLZ. ;FOR HRLZ
PUSHJ PP,PUT.A ;
AOS EINCRA ;ADVANCE TO NEXT WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
MOVE TA,[376,,774000]
JRST D6KT2M ;COMMON CODE
D7KT22: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,77776]
JRST K1CASY ;STORE THE RESULT
D7KT23==D6KT2C
D7KT24==D6KT2C
D7KT25: PUSHJ PP,PUTASA
MOVSI CH,HLRZ.
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,777760
JRST K1CASN ;STORE THE RESULT
;3 BYTES - ASCII
D7KT3: EXP D7KT31,D7KT32,D7KT33,D7KT34,D7KT35
D7KT31:D7KT32:
PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,HRLZ. ;FOR HRLZ
PUSHJ PP,PUT.A ;
AOS EINCRA ;ADVANCE TO NEXT WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
HLRZ TE,ERESA ;[555] GET RESIDUE AGAIN
CAIE TE,17 ;2 BYTES IN FIRST WORD?
SKIPA TA,[376,,777760] ;NO
MOVE TA,[77776,,774000] ;[555] YES
JRST D6KT2M
D7KT33==D6KT3C
D7KT34==D6KT3C
D7KT35: MOVEI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSH.,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D15
JRST K1CASN ;STORE THE RESULT
;4 BYTES - ASCII
D7KT4: EXP D7KT41,D7KT42,D7KT43,D7KT44,D7KT45
D7KT41: PUSHJ PP,MAKBPT ;PICK UP FIRST BYTE
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D21]
JRST K1CASY ;STORE THE RESULT
D7KT42: PUSHJ PP,PUTASA
MOVSI CH,HRLZ.
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
MOVE TA,[77776,,777760]
JRST D6KT2M
D7KT43: MOVEI TE,3
MOVEM TE,NBYTES ;PICK UP 3 BYTES AT ONCE
SETOM USENBT
PUSHJ PP,MAKBPT ;FROM FIRST WORD
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,7]
JRST K1CASY ;STORE THE RESULT
D7KT44==D6KT4C
D7KT45: MOVEI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSH.,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-8
JRST K1CASN ;STORE THE RESULT
;5 BYTES - ASCII
D7KT5: EXP D7KT51,D7KT52,D7KT53,D7KT54,D7KT55
D7KT51:D7KT52:D7KT53:D7KT54:
MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
HLRZ TE,ERESA ;GET RESIDUE
IDIVI TE,7 ;SEE WHICH BYTE POSITION
MOVE CH,[LSHC.,,^D28
LSHC.,,^D21
LSHC.,,^D14
LSHC.,,7]-1(TE)
JRST K1CASY ;STORE THE RESULT
D7KT55: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
JRST K1CASN ;STORE THE RESULT
;6 BYTES - ASCII
D7KT6: EXP D7KT61,D7KT62,D7KT63,D7KT64,D7KT65
D7KT61:D7KT62:D7KT63:D7KT64:
MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
HLRZ TE,ERESA ;GET RESIDUE
IDIVI TE,7 ;SEE WHICH BYTE POSITION
MOVE CH,[LSHC.,,^D28
LSHC.,,^D21
LSHC.,,^D14
LSHC.,,7]-1(TE)
PUSHJ PP,PUTASY
D7KT6C: PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D29
JRST K2CASN ;STORE 2 WORDS
D7KT65: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
JRST D7KT6C
;7 BYTES - ASCII
D7KT7: EXP D7KT71,D7KT72,D7KT73,D7KT74,D7KT75
D7KT71: PUSHJ PP,MAKBPT ;GET FIRST BYTE
AOS EINCRA
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[TRZ.+AC1,,1]
PUSHJ PP,PUTASY ;CLEAR BIT 35
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D28]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
AOS EINCRA ;NEXT WORD
MOVSI CH,HLR.+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D11
JRST K2CASN ;STORE 2 WORDS
D7KT72:D7KT73:D7KT74:
MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
HLRZ TE,ERESA ;GET RESIDUE
IDIVI TE,7 ;SEE WHICH BYTE POSITION
MOVE CH,[LSHC.,,^D28
LSHC.,,^D21
LSHC.,,^D14
LSHC.,,7]-1(TE)
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D22
JRST K2CASN ;STORE 2 WORDS
D7KT75: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLRZ.+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,777760
JRST K2CASN ;STORE 2 WORDS
;8 BYTES - ASCII
D7KT8: EXP D7KT81,D7KT82,D7KT83,D7KT84,D7KT85
D7KT82: MOVEM TE,NBYTES
SETOM USENBT
D7KT81: PUSHJ PP,MAKBPT
AOS EINCRA
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[TRZ.+AC1,,1]
PUSHJ PP,PUTASY ;CLEAR BIT 35
PUSHJ PP,PUTASA
HLRZ TE,ERESA
CAIE TE,10 ;1 BYTE?
SKIPA CH,[LSHC.,,^D21]
MOVE CH,[LSHC.,,^D28]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
AOS EINCRA ;NEXT WORD
MOVSI CH,HLR.+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
HLRZ TE,ERESA
MOVEI CH,-4 ;[563] CHANGE MOVE TO MOVEI
CAIE TE,10 ;[1061] SKIP IF 2 BYTES IN LAST WORD (I.E. 1 IN FIRST WORD)
MOVEI CH,-^D11
JRST K2CASN ;STORE 2 WORDS
D7KT83:D7KT84:
MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
HLRZ TE,ERESA ;GET RESIDUE
CAIE TE,35 ;4 BYTES?
SKIPA CH,[LSHC.,,^D14]
MOVE CH,[LSHC.,,7]
PUSHJ PP,PUTASY
JRST D7KT8A ;COMMON CODE
D7KT85: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
D7KT8A: PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D15
JRST K2CASN ;STORE 2 WORDS
;9 BYTES - ASCII
D7KT9: EXP D7KT91,D7KT92,D7KT93,D7KT94,D7KT95
D7KT91: PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D28]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
MOVEI TE,3
JRST D7KTAC
D7KT92: MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D21]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
AOS EINCRA
MOVSI CH,HLR.+AC1
PUSHJ PP,PUT.A ;[555]
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-4
JRST K2CASN ;STORE 2 WORDS
D7KT93: MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D14]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
JRST D7KTAD ;COMMON CODE
D7KT94: MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,7]
PUSHJ PP,PUTASY
JRST D7KT9C
D7KT95: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
D7KT9C: PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-8
JRST K2CASN ;STORE 2 WORDS
;10 BYTES - ASCII
D7KTA: EXP D7KTA1,D7KTA2,D7KTA3,D7KTA4,D7KTA5
D7KTA1: PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D28]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
MOVEI TE,4 ;4 BYTES AT START OF NEXT WORD
JRST D7KTAC
D7KTA2: MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D21]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
MOVEI TE,3
JRST D7KTAC
D7KTA3: MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D14]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
MOVEI TE,2
D7KTAC: MOVEM TE,NBYTES
SETOM USENBT
D7KTAD: AOS EINCRA
MOVEI TE,44
HRLM TE,ERESA ;n BYTES AT START OF NEXT WORD
PUSHJ PP,MAKBP2
PUSHJ PP,PUTASA
MOVE CH,[IOR.+AC1,,2]
JRST K2CASY
D7KTA4: MOVEM TE,NBYTES
SETOM USENBT ;PICK UP FIRST WORD WITH 1 BYTE POINTER
PUSHJ PP,MAKBPT
AOS EINCRA ;ADVANCE TO NEXT WORD
MOVSI CH,MOV+AC1
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,7]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
JRST D7KTAD
D7KTA5: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSH.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-1
PUSHJ PP,PUTASN
JRST D6KTL1 ;LSH AC1,-1
;LARGE NUMBER OF ASCII BYTES
D7KTX: SUBI TD,D7KMAX
MOVEM TD,ESIZEZ ;SAVE IT
HLLZ TE,ERESA ;GET RESIDUE
MOVEM TE,EREM0 ;INCASE IT CHANGES
MOVE TE,EINCRA
MOVEM TE,EREM1
MOVEI TE,D7KMAX ;SET IT TO 10
MOVEM TE,ESIZEA
MOVEI TE,D7KTXN ;WHERE TO RETURN TO
MOVEM TE,EKREPF ;LET NXTKEY KNOW
JRST KEYDA ;DO FIRST PART
D7KTXN: MOVNI TE,D7KMAX
MOVMM TE,ESIZEA ;SET SIZE FOR NEXT TRY
ADDB TE,ESIZEZ ;REDUCE
JUMPG TE,.+3 ;SOME LEFT
ADDM TE,ESIZEA ;NO
SETZM EKREPF ;DON'T REPEAT EITHER
MOVE TE,EREM0
HLLM TE,ERESA ;RESET RESIDUE
MOVEI TE,2
ADDB TE,EREM1
MOVEM TE,EINCRA ;ADJUST INCREMENT
JRST KEYDA
SUBTTL EBCDIC KEYS
KEYDE:
IFN ANS74,<
SKIPN ESCOLS ;COLLATING SEQUENCE?
>
TSWF FANUM ;OR NUMERIC
JRST KEYD ;YES
HLRZ TE,ERESA ;GET RESIDUE
IDIVI TE,9 ;GET NO. OF BYTES IN FIRST WORD
SKIPG TD,ESIZEA ;[1100] GET SORT KEY SIZE, IF > ZERO
JRST KEYDUN ;[1100] ELSE ABORT ATTEMPT TO GENERATE KEY
CAILE TD,D9KMAX ;TOO BIG?
JRST D9KTX ;YES, TOO COMPLICATED FOR 1 PASS
JRST @D9KTAB-1(TD) ;DISPATCH
D9KTAB: @D9KT1-1(TE)
@D9KT2-1(TE)
@D9KT3-1(TE)
@D9KT4-1(TE)
@D9KT5-1(TE)
@D9KT6-1(TE)
@D9KT7-1(TE)
@D9KT8-1(TE)
D9KMAX==.-D9KTAB
;1 BYTE - EBCDIC
D9KT1: EXP D9KT11,D9KT12,D9KT13,D9KT14
D9KT13: PUSHJ PP,PUTASA
SKIPA CH,[HLRZ.,,0]
D9KT11: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.,,777]
JRST K1CASY ;STORE THE RESULT
D9KT14: PUSHJ PP,PUTASA
SKIPA CH,[HLRZ.,,0]
D9KT12: MOVSI CH,MOV
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[ANDI.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,777000
JRST K1CASN ;STORE THE RESULT
;2 BYTES - EBCDIC
D9KT2: EXP D9KT21,D9KT22,D9KT23,D9KT24
D9KT21: PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,HRLZ. ;FOR HRLZ
PUSHJ PP,PUT.A ;
AOS EINCRA ;ADVANCE TO NEXT WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
MOVE TA,[777,,777000]
JRST D6KT2M ;COMMON CODE
D9KT22: PUSHJ PP,PUTASA
MOVSI CH,HRRZ.
JRST K1C.A
D9KT23==D6KT2C
D9KT24: PUSHJ PP,PUTASA
MOVSI CH,HLRZ.
JRST K1C.A
;3 BYTES - EBCDIC
D9KT3: EXP D9KT31,D9KT32,D9KT33,D9KT34
D9KT31: PUSHJ PP,PUTASA
MOVSI CH,HRLZ.
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLR.
PUSHJ PP,PUT.A
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,777000
JRST K1CASN ;STORE THE RESULT
D9KT32: PUSHJ PP,PUTASA
MOVSI CH,HRLZ.
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLR.
D9KT3A: PUSHJ PP,PUT.A
PUSHJ PP,PUTASA
MOVE CH,[TRZ.,,777]
JRST K1CASY ;STORE THE RESULT
D9KT33: MOVSI CH,MOV
PUSHJ PP,PUT.A
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,777000
JRST K1CASN ;STORE THE RESULT
D9KT34: MOVSI CH,MOV
JRST D9KT3A
;4 BYTES - EBCDIC
D9KT4: EXP D9KT41,D9KT42,D9KT43,D9KT44
D9KT41:D9KT43:
PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
HLRZ TE,ERESA
CAIN TE,9 ;1 BYTES IN FIRST WORD?
SKIPA CH,[LSHC.,,^D27]
MOVE CH,[LSHC.,,9] ;NO, 3
JRST K1CASY ;STORE THE RESULT
D9KT42: PUSHJ PP,PUTASA
MOVSI CH,HRLZ.
PUSHJ PP,PUT.A
PUSHJ PP,PUTASA ;[1420]
MOVSI CH,HLR.
AOSA EINCRA
D9KT44: MOVSI CH,MOV
JRST K1C.A
;5 BYTES - EBCDIC
D9KT5: EXP D9KT51,D9KT52,D9KT53,D9KT54
D9KT51:D9KT52:
PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
HLRZ TE,ERESA
CAIN TE,9 ;1 BYTE IN FIRST WORD?
SKIPA CH,[LSHC.,,^D27] ;YES
SKIPA CH,[LSHC.,,^D18]
JRST K2CASY
PUSHJ PP,PUTASY
MOVE CH,[TLZ.+AC1,,777]
JRST K2CASY
D9KT53: MOVSI CH,MOV
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLLZ.+AC1
PUSHJ PP,PUT.A
D9KT5B: PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,9] ;[555]
JRST K2CASY
D9KT54: MOVSI CH,MOV
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,MAKBP1 ;GET SECOND WORD
JRST KEY2CA
;6 BYTES - EBCDIC
D9KT6: EXP D9KT61,D9KT62,D9KT63,D9KT64
D9KT61: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D27]
PUSHJ PP,PUTASY
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLR.+AC1
PUSHJ PP,PUT.A ;GET 3RD WORD
D9KT6C: PUSHJ PP,PUTASA
MOVE CH,[TRZ.+AC1,,777]
JRST K2CASY
D9KT62: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D18]
JRST K2CASY
D9KT63: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,9]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA ;[555]
MOVE CH,[HLLZ.+AC1,,1] ;[555] CLEAR RHS
JRST K2CASY
D9KT64: MOVSI CH,MOV
PUSHJ PP,PUT.A
AOS EINCRA
PUSHJ PP,PUTASA
MOVSI CH,HLLZ.+AC1
JRST K2C.A
;7 BYTES - EBCDIC
D9KT7: EXP D9KT71,D9KT72,D9KT73,D9KT74
D9KT71: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D27]
JRST D9KT7C
D9KT72: PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D18]
D9KT7C: PUSHJ PP,PUTASY
AOS EINCRA ;ADVANCE TO 3RD WORD
PUSHJ PP,PUTASA
MOVSI CH,HLR.+AC1 ;[667]
PUSHJ PP,PUT.A ;[555]
HLRZ TE,ERESA
CAIE TE,22 ;1 BYTE IN LAST WORD?
JRST KEY2CA ;NO, ALL DONE
JRST D9KT6C
D9KT73: PUSHJ PP,DMOVE2
JRST D9KT5B
D9KT74: PUSHJ PP,DMOVE2
JRST D9KT6C
;8 BYTES - EBCDIC
D9KT8: EXP D9KT81,D9KT82,D9KT83,D9KT84
D9KT81:D9KT83:
PUSHJ PP,DMOVE2
PUSHJ PP,PUTASA
HLRZ TE,ERESA ;GET IT BACK IN CASE DESTROYED
CAIN TE,9 ;[627] IF 1 BYTE IN FIRST WORD
SKIPA TE,[3] ;[627] THEN 3 BYTES IN LAST WORD
SKIPA TE,[1] ;[627] ELSE 3 BYTES IN FIRST WORD AND 1 IN LAST
SKIPA CH,[LSHC.,,^D27]
MOVE CH,[LSHC.,,9]
MOVEM TE,NBYTES ;SAVE NUMBER OF BYTES IN LAST WORD
PUSHJ PP,PUTASY
SETOM USENBT
JRST D7KTAD ;USE COMMON CODE
D9KT82: PUSHJ PP,DMOVE2
AOS EINCRA ;POINT TO 3RD WORD
PUSHJ PP,PUTASA
MOVE CH,[LSHC.,,^D18]
PUSHJ PP,PUTASY
PUSHJ PP,PUTASA
MOVSI CH,HLR.+AC1
JRST K2C.A
D9KT84: PUSHJ PP,DMOVE2
JRST KEY2CA
;LARGE NUMBER OF EBCDIC BYTES
D9KTX: SUBI TD,D9KMAX
MOVEM TD,ESIZEZ ;SAVE IT
HLLZ TE,ERESA
MOVEM TE,EREM0
MOVE TE,EINCRA
MOVEM TE,EREM1
MOVEI TE,D9KMAX ;SET IT TO 8
MOVEM TE,ESIZEA
MOVEI TE,D9KTXN ;WHERE TO RETURN TO
MOVEM TE,EKREPF ;LET NXTKEY KNOW
JRST KEYDE ;DO FIRST PART
D9KTXN: MOVNI TE,D9KMAX
MOVMM TE,ESIZEA ;SET SIZE FOR NEXT TRY
ADDB TE,ESIZEZ ;REDUCE
JUMPG TE,.+3 ;SOME LEFT
ADDM TE,ESIZEA ;NO
SETZM EKREPF ;DON'T REPEAT EITHER
MOVE TE,EREM0
HLLM TE,ERESA ;RESET BYTE POSITION
MOVEI TE,2
ADDB TE,EREM1 ;RESET SIZE
MOVEM TE,EINCRA
JRST KEYDE
SUBTTL COMMON SUBROUTINES
;ROUTINE TO MAKE BYTE POINTER
MAKBPT: MOVE TA,[BYTLIT,,2]
PUSHJ PP,STASHP
SETOM MAKBPB ;MAKE LDB POINTER
PUSHJ PP,MBYTPA ;GENERATE LITERAL
PUSHJ PP,POOL ;ONLY NEED 1
MOVE CH,[LDB.+ASINC,,AS.MSC]
MAKPTC: PUSHJ PP,PUTASY
SKIPN CH,PLITPC
MOVE CH,ELITPC
IORI CH,AS.LIT
PUSHJ PP,PUTASN
SKIPN PLITPC
AOS ELITPC
SETZM USENBT ;CLEAN UP
SETZM NBYTES
POPJ PP,
;SAME AS MAKBPT BUT FOR AC1
MAKBP1: MOVE TA,[BYTLIT,,2]
PUSHJ PP,STASHP
SETOM MAKBPB ;MAKE LDB POINTER
PUSHJ PP,MBYTPA ;GENERATE LITERAL
PUSHJ PP,POOL ;ONLY NEED 1
MOVE CH,[LDB.+AC1+ASINC,,AS.MSC]
JRST MAKPTC
;SAME AS MAKBPT BUT FOR AC2
MAKBP2: MOVE TA,[BYTLIT,,2]
PUSHJ PP,STASHP
SETOM MAKBPB ;MAKE LDB POINTER
PUSHJ PP,MBYTPA ;GENERATE LITERAL
PUSHJ PP,POOL ;ONLY NEED 1
MOVE CH,[LDB.+AC2+ASINC,,AS.MSC]
JRST MAKPTC
DMOVE2:
IFN BIS,<
PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,DMOVE.
>
IFE BIS,<
MOVSI CH,MOV
>
PUSHJ PP,PUT.A
AOS EINCRA ;ADVANCE TO NEXT WORD
IFN BIS,<
POPJ PP,
>
IFE BIS,<
MOVSI CH,MOV+AC1
JRST PUT.A
>
;THE "KEY BUILDER" HAS BEEN WRITTEN.
;GENERATE CODE FOR "USING" OR "INPUT PROC".
KEYDUN: SKIPE TA,ESINP
JRST KEYDN1
SKIPN TA,ESUSE
JRST NOCODI
MOVE CH,EUSENO
CAILE CH,1 ;MORE THAN 1 INPUT FILE?
PUSHJ PP,DOUSEX ;YES, SETUP FIRST
PUSHJ PP,DOUSE
JRST KEYDN2
KEYDN1: PUSHJ PP,DOINP
KEYDN2: MOVEI CH,MERGE.
PUSHJ PP,PUT.PJ
;GENERATE CODE FOR "GIVING" OR "OUTPUT PROC".
SKIPE TA,ESOUTP
JRST KEYDN3
SKIPN TA,ESGIV
JRST NOCODO
PUSHJ PP,DOGIV
JRST KEYDN4
KEYDN3: PUSHJ PP,DOOUTP
KEYDN4: MOVEI CH,ENDS.
JRST PUT.PJ
;GENERATE CODE FOR "USING"
DOUSE: MOVSI CH,OPEN.I
HRR CH,ESUSE+1
PUSHJ PP,RYTIO
PUSHJ PP,GETTAG
MOVEM CH,ESTAG2
PUSHJ PP,PUTTAG
HRR TA,ESUSE+1 ;[1025] LINK TO FILE TABLE
PUSHJ PP,LNKSET ;[1025]
LDB TE,FI.ACC## ;[1025] GET FILE ORGANIZATION
JUMPE TE,DOUSE1 ;[1025] OK IF SEQ FILE
IFN ANS68,<
CAIN TE,%ACC.I ;[1025] BUT IF INDEXED
JRST DOUSE2 ;[1025] ITS MUCH MORE COMPLICATED
LDB CH,FI.ACK## ;[1025] LOAD FILE LINK TO ACTUAL KEY
JUMPE CH,DOUSE1 ;[1025] IGNORE IF NO KEY
HRLI CH,SETZM.## ;[1025] ZERO KEY
PUSHJ PP,PUTASY ;[1025] TO SIGNAL READ NEXT IN COBOL-68
JRST DOUSE1 ;[1025] DONE IF RANDOM
DOUSE2: LDB TA,FI.SKY## ;[1025] USE SYMBOLIC KEY
JUMPE TA,DOUSE1 ;[1025] IGNORE IF NO KEY
SETZB TB,ETEMPR## ;[1025] FAKE UP AN OPERAND
MOVEM TA,ETEMPR+1 ;[1025] ...
MOVEI TC,ETEMPR ;[1025] AND POINT TO IT (TB + TA)
MOVEI LN,EBASEB ;[1025] SETUP EBASEB ETC.
PUSHJ PP,SETOPN ;[1025] FOR FOLLOWING STANDARD MOVE CODE
TSWF FERROR ;[1025] GUARD AGAINST ERRORS
JRST DOUSE1 ;[1025] BY GIVING UP
PUSHJ PP,MLVD.## ;[1025] PUT LOW-VALUES INTO KEY
>
IFN ANS74,<
SKIPA CH,[RDNXT.##,,0] ;[1025] USE READ NEXT IN COBOL-74
>
DOUSE1: MOVSI CH,READ ;[1025]
HRR CH,ESUSE+1
PUSHJ PP,RYTIO
MOVSI CH,SKIPA.
PUSHJ PP,PUTASY
PUSHJ PP,GETTAG
MOVEM CH,ESTAG3
HRLI CH,JRST.
PUSHJ PP,PUTASY
HRRZ TA,ESTAG3
PUSHJ PP,REFTAG ;COUNT REFERENCE
MOVEI LN,EBASEA
MOVEI TC,ESUSE
PUSHJ PP,GETFDR
IFN ANS74,<
MOVE TA,DT ;GET FILTAB ADDRESS
LDB TE,FI.MRS ;GET RECORD SIZE
CAME TE,ESMAXR ;SAME AS SD?
PUSHJ PP,USE742 ;NO, STANDARD SAYS IT SHOULD BE
>
MOVEI LN,EBASEB
PUSHJ PP,GETSDR
MOVE TE,ESIZEB
CAMGE TE,ESIZEA
MOVEM TE,ESIZEA
PUSHJ PP,MXX.
MOVE TE,ESIZEB
HRRZ TD,EMODEB
CAILE TD,DSMODE
JRST DOUSE4
IDIV TE,BYTE.W(TD)
JUMPE TD,DOUSE5
AOJA TE,DOUSE5
;GENERATE CODE FOR "USING" (CONT'D)
DOUSE4: MOVEI TE,1
CAIN TD,D2MODE
MOVEI TE,2
DOUSE5: MOVSI CH,MOVEI.+AC16
HRR CH,TE
PUSHJ PP,PUTASY
MOVEI CH,RELES.
PUSHJ PP,PUT.PJ
MOVE CH,ESTAG2
HRLI CH,JRST.
PUSHJ PP,PUTASY
HRRZ TA,ESTAG2
PUSHJ PP,REFTAG ;COUNT REFERENCE
MOVE CH,ESTAG3
PUSHJ PP,PUTTAG
MOVSI CH,CLOS
HRR CH,ESUSE+1
PUSHJ PP,RYTIO
MOVEI CH,MCLOS.##
SKIPE EMRGFL ;IF MERGE
PUSHJ PP,PUT.PJ ;CALL SORT-MERGE TO LET IT KNOW
SOSG EUSENO ;MORE TO DO?
POPJ PP, ;NO
PUSHJ PP,DOUSEX ;GET NEXT
JRST DOUSE ;DO IT
DOUSEX: MOVEI CH,2
ADDB CH,CURRES ;ACCOUNT FOR THEM
MOVEM CH,CUREOP
MOVE TA,-1(CH)
MOVEM TA,ESUSE+1
MOVE TA,-2(CH)
MOVEM TA,ESUSE
POPJ PP,
;GENERATE CODE FOR "GIVING"
DOGIV: MOVSI CH,OPEN.O
HRR CH,ESGIV+1
PUSHJ PP,RYTIO
PUSHJ PP,GETTAG
MOVEM CH,ESTAG4
PUSHJ PP,PUTTAG
MOVEI CH,RETRN.
PUSHJ PP,PUT.PJ
MOVSI CH,SKIPA.
PUSHJ PP,PUTASY
PUSHJ PP,GETTAG
MOVEM CH,ESTAG5
HRLI CH,JRST.
PUSHJ PP,PUTASY
HRRZ TA,ESTAG5
PUSHJ PP,REFTAG ;COUNT REFERENCE
MOVEI LN,EBASEA
PUSHJ PP,GETSDR
MOVEI LN,EBASEB
MOVEI TC,ESGIV
PUSHJ PP,GETFDR
IFN ANS74,<
MOVE TA,DT ;GET FILTAB ADDRESS
LDB TE,FI.MRS ;GET RECORD SIZE
CAME TE,ESMAXR ;SAME AS SD?
PUSHJ PP,GIV742 ;NO, STANDARD SAYS IT SHOULD BE
>
MOVE TE,ESIZEB
CAMGE TE,ESIZEA
MOVEM TE,ESIZEA
MOVEM TE,ERECSZ
PUSHJ PP,MXX.
;GENERATE CODE FOR "GIVING" (CONT'D).
MOVSI CH,WRITE ;ASSUME SIXBIT RECORDING MODE
MOVE TA,ESGIV+1 ;CONVERT FILE-TABLE LINK
PUSHJ PP,LNKSET ; TO ACTUAL ADDRESS
LDB TA,[POINT 2,5(TA),1] ;IS RECORDING MODE ASCII?
CAIN TA,2
MOVSI CH,WADV. ;YES--USE WADV.
HRR CH,ESGIV+1
PUSHJ PP,RYTIO
MOVE CH,[XWD AS.XWD,1]
PUSHJ PP,PUTASN
HRLZ CH,ERECSZ
LSH CH,6
TLO CH,20 ; [431] SET FOR "WRITE BEFORE"
HRRI CH,AS.CNB
PUSHJ PP,PUTAYY## ; [431] PUT DIRECTLY INTO ASY FILE
MOVEI CH,1
PUSHJ PP,PUTASN
MOVE CH,ESTAG4
HRLI CH,JRST.
PUSHJ PP,PUTASY
HRRZ TA,ESTAG4
PUSHJ PP,REFTAG ;COUNT REFERENCE
MOVE CH,ESTAG5
PUSHJ PP,PUTTAG
MOVSI CH,CLOS
HRR CH,ESGIV+1
JRST RYTIO
;GENERATE CODE FOR OUTPUT PROCEDURES
DOOUTP: MOVSI TE,ESOUTP
IFN ANS74,<
MOVEI EACA,DBP%SO
SKIPE EMRGFL
MOVEI EACA,DBP%MO
>
JRST DOINP1
;GENERATE CODE FOR INPUT PROCEDURES
DOINP: MOVSI TE,ESINP
IFN ANS74,<
MOVEI EACA,DBP%SI
>
DOINP1:
IFN ANS74,<
MOVEM EACA,PERFCD## ;SET THE PERFORM INDEX INCASE DEBUGGING
>
MOVE EACA,EOPLOC
HRRI TE,1(EACA)
BLT TE,4(EACA)
MOVEI EACC,2
ADD EACA,[XWD 4,4]
MOVEM EACA,EOPNXT
JRST PERFGN
;"RELEASE" GENERATOR
RELSGN: MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
MOVE EACA,EOPNXT ;GET END-OF:EOPTAB
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST BADEOP ;NO--ERROR
HRRZ TC,EOPLOC ;SET "TC" TO
ADDI TC,1 ; FIRST OPERAND
MOVEM TC,CUREOP
CAIN TC,-1(EACA) ;IS THERE ONLY ONE OPERAND?
JRST RELS4 ;YES
;GENERATE MOVE FOR "FROM"
MOVEM TC,OPERND ;SET FIRST OPERAND TO
MOVEI LN,EBASEB ; BE "B"
PUSHJ PP,SETOPN
PUSHJ PP,BMPEOP ;GET NEXT OPERAND
JRST BADEOP ;NO MORE--TROUBLE
HRRZ TC,CUREOP ;SET SECOND
HRLM TC,OPERND ; OPERAND
MOVEI LN,EBASEA ; TO BE
PUSHJ PP,SETOPN ; "A"
TSWF FERROR ;ANY ERRORS?
POPJ PP,
PUSHJ PP,MXX. ;DO THE MOVE
HRRZ TC,OPERND ;FIRST OPERAND IS NOW "A"
;"RELEASE" (CONT'D).
;ANY "FROM" OPTION HAS BEEN TAKEN CARE OF
RELS4: HRLZM TC,OPERND
HRRZM TC,CUREOP
PUSHJ PP,SETOPA
MOVE CH,[XWD MOVEI.+16B30,AS.CNB] ;WRITE FIRST PART OF
PUSHJ PP,PUTASY ; <MOVEI 16,RECSIZE>
HRRZ TC,EMODEA ;GET MODE OF RECORD
CAILE TC,DSMODE ;IS IT DISPLAY?
JRST RELS5 ;NO
MOVE TE,ESIZEA ;CONVERT
IDIV TE,BYTE.W(TC) ; SIZE
JUMPE TD,RELS6 ; TO
AOJA TE,RELS6 ; WORDS
RELS5: CAIE TC, C3MODE## ;IS IT COMP-3?
JRST RELS5I ;NO, GO ON.
MOVE TE, ESIZEA ;GET IT'S SIZE.
ADDI TE, 2 ;CONVERT IT TO 9 BIT BYTES.
LSH TE, -1
JRST RELS6 ;AND GO ON.
RELS5I: MOVEI TE,1 ;ASSUME IT IS NOT 2-WORD COMP
CAIN TC,D2MODE ;IS IT 2-WORD COMP?
MOVEI TE,2 ;YES
RELS6: MOVEI CH,(TE) ;PUT OUT REST OF <MOVEI 16,RECSIZE>
PUSHJ PP,PUTASN
MOVEI CH,RELES. ;GENERATE <PUSHJ 17,RELES.>
HLRZ TA,CURFIL ;[1516] GET FILE TABLE ADDRESS
PUSHJ PP,LNKSET ;[1516] SO THAT WE CAN FIND OUT
LDB TE,FI.SRA## ;[1516] IF SAME RECORD AREA, IF SO
JUMPN TE,PUT.PJ ;[1516] WE DON'T WANT TO CLEAR THE RECORD AREA.
PUSHJ PP,PUT.PJ ;[1126] SET IT UP AS A CALL INSTEAD
;[1126] NOW GENERATE CODE TO CLEAR THE INPUT BUFFER
MOVE TA,[EBASEA,,EBASEB] ;[1126] MOVE SENDING FIELD SPECS
;[1126] RECEIVING FIELD SPECS
BLT TA,EBASEB+EFLAGX## ;[1126]
;[1126] SET UP SENDING FIELD SPECS TO INDICATE LOW-VALUES
SETZM EBASEA ;[1126] CLEAR THE SENDING FIELD
MOVE TA,[EBASEA,,EBASEA+1] ;[1126] SPECS
HRRZI TA,FCMODE## ;[1126] AND INDICATE LOW-VALUES
MOVEM TA,EMODEA ;[1126]
HRRZI TA,5 ;[1126]
MOVEM TA,EFLAGA## ;[1126]
MOVE TC,CUREOP ;[1327] SET UP TC
PUSHJ PP,SETOPB## ;[1327] SET UP "B" OPERAND
;[1126] THEN GO TO GENERATE THE NECESSARY MOVES.
JRST MXX. ;[1126] MXX. WILL DO THE RETURN
;"RETURN" GENERATOR
RETNGN: MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
MOVE EACA,EOPNXT
CAMN EACA,EOPLOC
JRST BADEOP
MOVEI CH,RETRN. ;GENERATE <PUSHJ 17,RETRN.>
PUSHJ PP,PUT.PJ
SETZM EINTO
HRRZ TC,EOPLOC ;SET UP FOR FIRST OPERAND
ADDI TC,1
MOVEM TC,CUREOP
MOVSM TC,OPERND
CAIN TC,-1(EACA) ;IS THERE ONLY ONE OPERAND?
JRST RETN4 ;YES
HRRZ TA,1(TC) ;GET ADDR. OF FILTAB
MOVSM TA,CURFIL## ;SET UP CURFIL FOR LARGE ROUTINE
PUSHJ PP,LNKSET
HRRM TA,CURFIL ;FINISH FIXING CURFIL FOR LARGE
PUSHJ PP,LARGE ;GET LARGEST RECORD
HRRZ TE,EOPLOC ;MOVE
LDB TD,[POINT 4,4(TE),17]
LSH TD,1 ; EOPTAB
MOVSI TE,3(TE) ; TO
HRRI TE,EINTO+2 ; EINTO
ADDI TD,EINTO+3
BLT TE,(TD)
RETN4: MOVE EACA,EOPLOC
MOVEM EACA,EOPNXT
SETZB EACC,ETEMPC
PUSHJ PP,READEM
HRRZ TE,W2
CAIN TE,SPIF.
TLNN W1,ATEND
JRST RETN9
PUSHJ PP,CRHLD## ;CREATE HLDTAB ENTRY FOR "ENDIFG"
JRST SPIFGN ;GO GENERATE THE SPECIAL IF
RETN9: MOVEI DW,E.318 ;NO "AT END" -- TROUBLE
MOVE TC,OPLINE
LDB LN,TCLN
LDB CP,TCCP
PUSHJ PP,FATAL
JRST GO2NXT ;GO TO NEXT OPERATOR
;GET PARAMETERS FOR LARGEST SD-RECORD
GETSDR: MOVEI TC,ESORTF
;GET PARAMETERS FOR LARGEST FD-RECORD
GETFDR: MOVE TA,1(TC)
PUSHJ PP,LNKSET
MOVE DT,TA
LDB TA,FTRECD
HRLI TA,^D36
MOVEM TA,EBASEX(LN)
SETZM TA,EINCRX(LN)
SETZM TA,EDPLX(LN)
LDB TA, FTCMOD ;CONVERT THE FILE TABLE'S
MOVE TA, MODES(TA) ; IN CORE DATA MODE TO ONE OF
MOVEM TA, EMODEX(LN) ; THE STANDARD COMPILER DATA
;MODES.
LDB TA,FTRSIZ
MOVEM TA,ESIZEX(LN)
CAIE LN,EBASEA
JRST GETSD4
SWOFF FASIGN!FANUM!FASUB;
HRLM TC,OPERND
POPJ PP,
GETSD4: SWOFF FBSIGN!FBNUM!FBSUB;
HRRM TC,OPERND
POPJ PP,
MODES: EXP D6MODE## ;SIXBIT
Z ;BINARY (CAN'T HAPPEN)
EXP D7MODE## ;ASCII
EXP D9MODE## ;EBCDIC
Z ;STANDARD ASCII (CAN'T HAPPEN)
;WRITE OUT AN INSTRUCTION WITH A FILE-NAME FOR AN ADDRESS
RYTIO: TRZ CH,7B20
IORI CH,4B20
JRST PUTASY
;TABLE USED TO GET NUMBER OF WORDS USED BY A KEY
KEYSIZ: PUSHJ PP,WORD.S ;SIXBIT
PUSHJ PP,WORD.A ;ASCII
PUSHJ PP,WORD.E ;EBCDIC
MOVEI TE,1 ;1-WORD COMP
MOVEI TE,2 ;2-WORD COMP
MOVEI TE,1 ;FLOATING POINT
PUSHJ PP,WORD.N ;COMP-3.
WORD.S: TSWF FANUM ;[1004] IS THE FIELD NUMERIC?
JRST WORD.N ;YES
IFN ANS74,<
SKIPE ESCOLS ;EXCEPT IF COLLATING SEQUENCE
JRST WORD.A ;[1004] DO IT 5 TO A WORD
>
MOVE TE,ESIZEA ;[1004]
IDIVI TE,^D11
LSH TE,1 ;11 CHAR = 2 WORDS
JUMPE TD,CPOPJ## ;NO REMAINDER
CAILE TD,5 ;IF MORE THAN 5
ADDI TE,1 ;2 MORE WORDS
AOJA TE,CPOPJ ;ELSE JUST 1 MORE WORD
WORD.A: TSWF FANUM ;[1004] IS THE FIELD NUMERIC?
JRST WORD.N ;YES
IFN ANS74,<
MOVE TE,ESCOLS ;[1004] SEE IF EBCDIC COL. SEQ.
CAIN TE,%AN.EB ;[1004] IF IT IS THEN USE
JRST WORD.E ;[1004] 4 BYTES PER WORD
>
MOVE TE,ESIZEA ;[1004]
ADDI TE,4 ;[1004] COMPUTE FIELD SIZE IN WORDS
IDIVI TE,5
POPJ PP,
WORD.N: MOVE TE,ESIZEA
CAIG TE,^D10 ;IS NUMERIC ITEM 10 OR FEWER DIGITS?
TDCA TE,TE ;YES
MOVEI TE,1 ;NO
AOJA TE,CPOPJ
WORD.E: TSWF FANUM ;[1004] IF IT'S NUMERIC, GO SEE IF
JRST WORD.N ; IT'S ONE OR TWO WORDS LONG.
IFN ANS74,<
MOVE TE,ESCOLS ;[1004] SEE IF ASCII COL. SEQ.
CAIN TE,%AN.AS ;[1004] IF IT IS THEN USE
JRST WORD.A ;[1004] 5 BYTES PER WORD
>
MOVE TE,ESIZEA ;[1004] GET THE ITEM'S SIZE.
ADDI TE,3 ;FORCE ROUNDING UP.
IDIVI TE,4 ;4 NINE BIT BYTES PER WORD.
POPJ PP, ;RETURN.
;TABLE USED TO DISPATCH TO "KEY BUILDER", DEPENDING UPON USAGE
KEYTYP: EXP KEYDS ;SIXBIT
EXP KEYDA ;ASCII
EXP KEYDE ;EBCDIC.
EXP KEY1C ;1-WORD COMP
EXP KEY2C ;2-WORD COMP
EXP KEYFP ;FLOATING POINT
EXP KEYC3 ;COMP-3.
;ERROR ROUTINES
;WRONG NUMBER OF OPERANDS
BADSOP: MOVEI DW,E.214
JRST GOBACK
;KEY NOT DATA-NAME
KNOTD: MOVEI DW,E.101
MOVE TC,-1(EACA)
PUSHJ PP,ANYERA
JRST SRTGN1
;DUPLICATE CLAUSE
DUPL: MOVEI DW,E.216
OPRERA: MOVE TC,W1
PUSHJ PP,ANYERA
JRST SRTGN1
;BOTH "USING" AND "INPUT PROC"
BOTHI: MOVEI DW,E.292
JRST OPRERA
;BOTH "GIVING" AND "OUTPUT PROC"
BOTHO: MOVEI DW,E.294
JRST OPRERA
;NEITHER "USING" NOR "INPUT PROC"
NOCODI: MOVEI DW,E.293
MOVE TC,OPLINE
JRST ANYERA
;NEITHER "GIVING" NOR "OUTPUT PROC"
NOCODO: MOVEI DW,E.295
MOVE TC,OPLINE
ANYERA: LDB CP,TCCP
LDB LN,TCLN
PUSHJ PP,FATAL
MOVE EACA,EOPNXT
SWON FERROR;
POPJ PP,
IFN ANS74,<
GIV742: SKIPA TC,ESGIV ;POINT TO LN & CP OF GIVING FILE
USE742: MOVE TC,ESUSE ;POINT TO LN & CP OF USING FILE
MOVEI DW,E.742 ;STANDARD SAYS RECORD SIZE SHOULD BE SAME AS SD
LDB CP,TCCP
LDB LN,TCLN
JRST WARN##
>
EXTERNAL WADV.,CLOS,READ,WRITE
EXTERNAL SAVEPP,OPLINE,W1CP,W1LN,TCCP,TCLN,BYTE.W
EXTERNAL FTRECD,FTCMOD,FTRSIZ
EXTERNAL D2MODE,DSMODE
EXTERNAL EBASEA,EBASEB,ESIZEA,ESIZEB,EMODEA,EMODEB,CUREOP,OPERND
EXTERNAL RESLOC,RESNXT,EXTLOC,EOPLOC,EOPNXT
EXTERNAL TB.DAT,AS.XWD,AS.BYT,AS.PAR,AS.DOT,AS.MSC,AS.CNB,AS.REL
EXTERNAL D6MODE,D7MODE
EXTERNAL EBASEX,EMODEX,ERESX,EDPLX,ESIZEX,EINCRX,EREM0,EREM1
EXTERNAL ESORTL,ESORTH,EKEYSZ,ERECSZ,EKEYLC,ESTAG1,ESTAG2,ESTAG3,ESTAG4,ESTAG5
EXTERNAL ESUSE,ESGIV,ESORTF,ESOUTP,ESINP,EAS1PC,EAC
EXTERNAL SETCA.,EPJPP,JRST.,OPEN.I,OPEN.O,WADV.
EXTERNAL RELES.,RETRN.,MERGE.,PSORT.,ENDS.
EXTERNAL SKIPA.,MOVEI.,MOVEM.,POPJ.
EXTERNAL ATEND,SPIF.,ETEMPC,GO2NXT,EINTO
EXTERNAL FATAL,OPNFAT,GETTAG,PUTTAG,REFTAG,READEM,XPNRES,LNKSET,PERFGN,LARGE
EXTERNAL SETOPN,PUTASY,PUTASN,PUTAS1,BYTE.A,MXX.,MXAC.,PUT.XA,PUT.XB
EXTERNAL PUT.EX,PUT.PJ,PUT.A,SETOPA,BADEOP,SPIFGN,BMPEOP,EINCRA,ERESA,ESIZEZ
EXTERNAL STASHP,STASHQ,POOLIT,POOL,PLITPC,ELITPC,MAKBPB,NBYTES,USENBT,MBYTPA
EXTERNAL LDB.,DPB.,HLR.,HRR.,HRLZ.,HLRZ.,HRRZ.,HLLZ.,IOR.,IORI.
EXTERNAL AND..,ANDI.,MOV,SETZ.,DMOVE.,LSH.,LSHC.,TLZ.,TRZ.
EXTERNAL AS.LIT,OCTLIT,BYTLIT
EXTERNAL CRHLD ;[1027]
END