Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/srtgen.mac
There are 29 other files named srtgen.mac in the archive. Click here to see a list.
; UPD ID= 1365 on 9/19/83 at 9:47 AM by HOFFMAN
TITLE SRTGEN FOR COBOL V13
SUBTTL SORT GENERATOR AL BLACKINGTON/CAM/DMN
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
SEARCH P
%%P==:%%P
TWOSEG
.COPYRIGHT ;Put standard 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
INTERN ANYWRN
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****************
;SMI 18-Oct-82 [1420] Fix bad generation of code for one case of EBCDIC key.
;JEH 4-Jan-82 [1327] Set up B operand for clearing 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
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: 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 ESOUTP
JRST BOTHO
AOS TE,EGIVNO## ;COUNT NUMBER OF OUTPUT FILES
CAIN TE,2 ;SECOND TIME THRU
PUSHJ PP,SGIV.X ;YES, SAVE ESGIV FROM FIRST
DMOVE TE,-1(EACA)
DMOVEM TE,ESGIV
MOVE TE,EGIVNO ;GET NO. OF OUTPUT FILES
CAIL TE,2 ;IF NOT FIRST
PUSHJ PP,SGIV.X ;SAVE CURRENT NOW
HRRZ TE,EOPLOC
JRST SING3
;**** NOTE **** Must flag at 8x level here
SGIV.X: HLRE TE,RESNXT
CAML TE,[-2] ;SPACE FOR TWO MORE ENTRIES?
PUSHJ PP,XPNRES ;NO
MOVE TE,RESNXT
PUSH TE,ESGIV
PUSH TE,ESGIV+1 ;SAVE
MOVEM TE,RESNXT
POPJ PP,
;"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
CAIN TE,(EACA) ;
JRST SKEY.1 ;no subscripts, ref mod - continue
MOVE TA,EOPLOC ;
MOVE TA,1(TA) ;get first operand word
TLNN TA,10 ;ref modded?
JRST SRTGN1 ;no, ignore field
HLRZ TA,0(TE) ;get modifier count
ASH TA,1 ;double it for word count
ADD TE,TA ;add to operand offset
CAIE TE,(EACA) ;now at end of EOP table?
JRST SRTGN1 ;no - ignore field
JRST SKEY.2 ;yes, continue
SKEY.1: LDB TE,[POINT 3,0(EACA),20]
CAIE TE,TB.DAT
JRST KNOTD
SKEY.2: 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
TLZ TD,GNROUN ;shut off bit if on
HLRZS TD ;modifier count
JUMPE TD,SKEY.4 ;
ASH TD,1 ;double it
MOVEI TA,2(TC) ;
SKEY.3: AOS TA ;put ref modifiers out with operand
PUSH TE,(TA) ;
SOJG TD,SKEY.3 ;
SKEY.4: 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
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
;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: MOVE CH,[XWD AS.XWD,2] ;[1004]
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 OR COMP-2
KEYF2:
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: PUSHJ PP,PUTASA##
MOVE CH,[DMOVM.##,,AS.MSC]
PUSHJ PP,PUT.XA
HRRZ CH,EKEYLC
PUSHJ PP,PUTASN
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: 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]
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
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
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.
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
PUSHJ PP,PUTASA ;[1004] IN OTHER SET
MOVSI CH,DMOVE. ;[1004] GET WORDS IN TO ACC 0 & 1
PUSHJ PP,PUT.B ;[1004] DMOVE 0,%PARAM+N
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
PUSHJ PP,PUTASA ;[1004] IN OTHER SET
MOVSI CH,DMOVM. ;[1004]
PUSHJ PP,PUT.B ;[1004] STORE BACK
AOS EINCRB ;[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: 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: PUSHJ PP,DMOVE2
MOVE CH,[TLZ.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,770000
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
MOVE CH,[LSH.+AC1+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D30
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: 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: 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: PUSHJ PP,PUTASA ;NEED OTHER SET
MOVSI CH,DMOVE.
PUSHJ PP,PUT.A
AOS EINCRA ;ADVANCE TO NEXT WORD
POPJ PP,
;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.ORG## ;[1025] GET FILE ORGANIZATION
JUMPE TE,DOUSE1 ;[1025] OK IF SEQ FILE
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 ;RETURN TA=FILTAB
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
SKIPE EMRGFL ;IF MERGE CHECK FOR SAME FILE TWICE
PUSHJ PP,DOUSEY ; AND IF SO GIVE ERROR
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,
DOUSEY: MOVE CH,EUSENO ;NEED SOME WHERE TO SAVE THE
MOVEM CH,ESUSE ; NO. OF FILE NAMES LEFT
DOUSY1: MOVEI CH,2 ;EACH ONE TAKES TWO WORDS
ADDB CH,CUREOP ;OK TO DESTROY CUREOP AT THIS TIME
MOVE TA,-1(CH) ;GET NEXT FILTAB POINTER
CAME TA,ESUSE+1 ;SAME AS CURRENT ONE
JRST DOUSY2 ;NO
MOVE TC,-2(CH) ;SETUP LN & CP
MOVEI DW,E.751 ;FATAL ERROR
PUSHJ PP,ANYERB
DOUSY2: SOSLE ESUSE ;ALL DONE?
JRST DOUSY1 ;NOT YET
POPJ PP, ;YES
;GENERATE CODE FOR "GIVING"
DOGIV: PUSH PP,EGIVNO ;MUST GENERATE RELEASE STUFF IN TWO PARTS
PUSH PP,CURRES ;SO SAVE START OF LIST
MOVE CH,EGIVNO
CAILE CH,1 ;MORE THAN 1 OUTPUT FILE?
DOGIV1: PUSHJ PP,DOGIVX ;YES, SETUP FIRST
MOVSI CH,OPEN.O
HRR CH,ESGIV+1
PUSHJ PP,RYTIO
SOSLE EGIVNO ;MORE TO DO?
JRST DOGIV1 ;YES, GET NEXT
MOVE CH,0(PP)
MOVEM CH,CURRES ;RESTORE START OF GIVING LIST
MOVE CH,-1(PP)
MOVEM CH,EGIVNO ;RESTORE EGIVNO
CAILE CH,1 ;MORE THAN 1 OUTPUT FILE?
PUSHJ PP,DOGIVX ;YES, SETUP FIRST
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
DOGIV3: MOVEI LN,EBASEA
PUSHJ PP,GETSDR
MOVEI LN,EBASEB
MOVEI TC,ESGIV
PUSHJ PP,GETFDR ;RETURN TA=FILTAB
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
SOSG EGIVNO ;MORE TO DO?
JRST DOGIV4 ;NO
PUSHJ PP,DOGIVX ;GET NEXT
JRST DOGIV3 ;DO IT
DOGIV4: MOVE CH,ESTAG4
HRLI CH,JRST.
PUSHJ PP,PUTASY
HRRZ TA,ESTAG4
PUSHJ PP,REFTAG ;COUNT REFERENCE
MOVE CH,ESTAG5
PUSHJ PP,PUTTAG
POP PP,CURRES
POP PP,EGIVNO
MOVE CH,EGIVNO
CAILE CH,1 ;MORE THAN 1 OUTPUT FILE?
DOGIV6: PUSHJ PP,DOGIVX ;YES, SETUP FIRST
MOVSI CH,CLOS
HRR CH,ESGIV+1
SOSG EGIVNO ;MORE TO DO?
JRST RYTIO ;NO
PUSHJ PP,RYTIO
JRST DOGIV6 ;YES, GET NEXT
DOGIVX: MOVEI CH,2
ADDB CH,CURRES ;ACCOUNT FOR THEM
MOVEM CH,CUREOP
MOVE TA,-1(CH)
MOVEM TA,ESGIV+1
MOVE TA,-2(CH)
MOVEM TA,ESGIV
POPJ PP,
;GENERATE CODE FOR OUTPUT PROCEDURES
DOOUTP: MOVSI TE,ESOUTP
MOVEI EACA,DBP%SO
SKIPE EMRGFL
MOVEI EACA,DBP%MO
JRST DOINP1
;GENERATE CODE FOR INPUT PROCEDURES
DOINP: MOVSI TE,ESINP
MOVEI EACA,DBP%SI
DOINP1: 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 ;GET FILE TABLE ADDRESS
PUSHJ PP,LNKSET ;SO THAT WE CAN FIND OUT
LDB TE,FI.SRA## ;IF SAME RECORD AREA, IF SO
JUMPN TE,PUT.PJ ;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]
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, THEN NO INTO CLAUSE
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)
PUSHJ PP,INTOCK## ;In ANS-8x INTO is only allowed if
;there is only 1 data-record or
;all data records plus INTO item are either
;group items or elementary alphanumeric items.
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
;RETURNS WITH TA POINTING TO FILTAB
GETFDR: MOVE TA,1(TC)
PUSHJ PP,LNKSET
LDB TD,FI.DRL## ;DATA RECORD LINK
HRLI TD,^D36
MOVEM TD,EBASEX(LN)
SETZM EINCRX(LN)
SETZM EDPLX(LN)
LDB TD,FI.IRM## ;CONVERT THE FILE TABLE'S
MOVE TD,MODES(TD) ; IN CORE DATA MODE TO ONE OF
MOVEM TD,EMODEX(LN) ; THE STANDARD COMPILER DATA MODES.
LDB TD,FI.MRS## ;MAX. RECORD SIZE
MOVEM TD,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.
MOVEI TE,2 ;COMP-2
WORD.S: TSWF FANUM ;[1004] IS THE FIELD NUMERIC?
JRST WORD.N ;YES
SKIPE ESCOLS ;EXCEPT IF COLLATING SEQUENCE
JRST WORD.A ;[1004] DO IT 5 TO A WORD
MOVE TE,ESIZEA ;[1004]
IDIVI TE,^D10 ;5 characters/word (dont use byte w/ sign)
LSH TE,1 ;10 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
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.
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.
EXP KEYF2 ;COMP-2
;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: MOVE EACA,EOPNXT
ANYERB: LDB CP,TCCP
LDB LN,TCLN
PUSHJ PP,FATAL
SWON FERROR;
POPJ PP,
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
ANYWRN: LDB CP,TCCP
LDB LN,TCLN
JRST WARN##
EXTERNAL WADV.,CLOS,READ,WRITE
EXTERNAL SAVEPP,OPLINE,W1CP,W1LN,TCCP,TCLN,BYTE.W
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