Google
 

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