Google
 

Trailing-Edge - PDP-10 Archives - ap-c800d-sb - srtgen.mac
There are 29 other files named srtgen.mac in the archive. Click here to see a list.
; UPD ID= 1940 on 6/19/79 at 11:51 AM by N:<NIXON>
TITLE	SRTGEN FOR COBOL V12A
SUBTTL	SORT GENERATOR		AL BLACKINGTON/CAM/DMN



;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, 1979 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P

TWOSEG
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

;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	@EOPCOD(TE)
;"SORT" OPERATOR

SORTGN:	TDZA	TE,TE		;SORT
MERGGN:	SETO	TE,		;MERGE
	MOVEM	TE,EMRGFL##
	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	TE,0(EACA)
	MOVEM	TE,ESORTF+1

;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
	CAIN	TA,%AN.AS	;IS IT JUST ASCII
	JRST	COLASC		;YES
	CAIN	TA,%AN.EB	;OR EBCDIC
	JRST	COLEBC		;YES
	ADD	TA,[OCT 200,0,300](TE)	;ADD IN OFFSET
	HRRZM	TA,ESCOLS##	;STORE COLLATING SEQUENCE
	JRST	SRTGN1

COLASC:	SKIPA	TA,[EXP 0,0,%AN.EB](TE)	;ASCII MODE
COLEBC:	MOVE	TA,[EXP %AN.EB,%AN.EB,0](TE)	;EBCDIC MODE
	MOVEM	TA,ESCOLS
	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

	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
IFN ANS74,<
	SKIPE	TE,ESCOLS	;GET SORT COLLATING SEQUENCE
	JRST	[TRZN	TE,%AN.AS	;ASCII?
		IORI	TE,AS.LIT##	;NO, MAKE LITERAL
		MOVEM	TE,ESCOLS	;STORE BACK
		JRST	GETKEY]		;AND CONTINUE
	SKIPN	COLSEQ##	;NO, IS THERE A PROGRAM COLLATING SEQUENCE
	JRST	GETKEY		;NO
	HRRZ	TE,EMODEA	;YES, GET MODE
	MOVE	TE,COLSQS##(TE)	;GET RIGHT LITERAL
	MOVEM	TE,ESCOLS	;STORE IT
>

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	;[DMN] 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:	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,<
	SKIPN	ESCOLS		;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
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
	MOVE	TD,ESIZEA
	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
	MOVE	TD,ESIZEA
	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
	CAIN	TE,10
	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
	PUSHJ	PP,PUTASA
	MOVE	CH,[LSH.+AC1+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY
	MOVEI	CH,-^D15
	JRST	K2CASN		;STORE 2 WORDS

D7KT85:	PUSHJ	PP,DMOVE2
	PUSHJ	PP,PUTASA
	MOVE	CH,[LSH.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY
	MOVEI	CH,-1
	PUSHJ	PP,PUTASN
	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
	MOVEM	TE,NBYTES
	SETOM	USENBT
	AOS	EINCRA
	MOVEI	TE,44
	HRLM	TE,ERESA	;3 BYTES AT START OF NEXT WORD
	PUSHJ	PP,MAKBP2
	PUSHJ	PP,PUTASA
	MOVE	CH,[IOR.+AC1,,2]
	JRST	K2CASY

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
	AOS	EINCRA
	MOVEI	TE,44
	HRLM	TE,ERESA	;1 BYTES AT START OF NEXT WORD
	PUSHJ	PP,MAKBP2
	PUSHJ	PP,PUTASA
	MOVE	CH,[IOR.+AC1,,2]
	JRST	K2CASY

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
	MOVEM	TE,NBYTES
	SETOM	USENBT
	AOS	EINCRA
	MOVEI	TE,44
	HRLM	TE,ERESA	;4 BYTES AT START OF NEXT WORD
	PUSHJ	PP,MAKBP2
	PUSHJ	PP,PUTASA
	MOVE	CH,[IOR.+AC1,,2]
	JRST	K2CASY

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
	MOVE	TD,ESIZEA
	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
	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
	AOS	EINCRA		;POINT TO 3RD WORD
	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
	MOVEI	TE,44
	HRLM	TE,ERESA	;LEFT JUSTIFIED
	PUSHJ	PP,MAKBP2
	PUSHJ	PP,PUTASA
	MOVE	CH,[IOR.+AC1,,2]
	JRST	K2CASY

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

	MOVSI	CH,READ
	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
	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)
	SKIPE	TD
	ADDI	TE,1
	JRST	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

	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
;**;[431],DOGIV+37.,DPL,23-JUN-76

	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
	SKIPA

;GENERATE CODE FOR INPUT PROCEDURES

DOINP:	MOVSI	TE,ESINP

	MOVE	EACA,EOPLOC
	HRRI	TE,1(EACA)
	BLT	TE,4(EACA)

	MOVEI	EACC,2
	ADD	EACA,[XWD 4,4]
	JRST	PERFGN
;"RELEASE" GENERATOR

RELSGN:	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	CAMN	EACA,EOPLOC	;ANY OPERANDS?
	JRST	BADEOP		;NO--ERROR
	MOVEM	EACA,EOPNXT	;OK--SAVE END-OF:EOPTAB

	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.>
	JRST	PUT.PJ		;  AND RETURN
;"RETURN" GENERATOR

RETNGN:	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	CAMN	EACA,EOPLOC
	JRST	BADEOP

	MOVEI	CH,RETRN.	;GENERATE <PUSHJ 17,RETRN.>
	PUSHJ	PP,PUT.PJ

	SETZM	EINTO
	MOVEM	EACA,EOPNXT
	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+2
	BLT	TE,EINTO+3(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
	JRST	SPIFGN

RETN9:	MOVEI	DW,E.318	;NO "AT END" -- TROUBLE
	MOVE	TC,OPLINE
	LDB	LN,TCLN
	LDB	CP,TCCP
	PUSHJ	PP,FATAL
	JRST	@EOPCOD(W2)	;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:	MOVE	TE,ESIZEA
	TSWF	FANUM		;IS THE FIELD NUMERIC?
	JRST	WORD.N		;YES
IFN ANS74,<
	SKIPE	ESCOLS		;EXCEPT IF COLLATING SEQUENCE
	JRST	WORD.5		;DO IT 5 TO A WORD
>
	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:	MOVE	TE,ESIZEA
	TSWF	FANUM		;IS THE FIELD NUMERIC?
	JRST	WORD.N		;YES

WORD.5:	ADDI	TE,4		;NO--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:	MOVE	TE,ESIZEA	;GET THE ITEM'S SIZE.
	TSWF	FANUM		;IF IT'S NUMERIC, GO  SEE IF
	JRST	WORD.N		; IT'S ONE OR TWO WORDS LONG.
	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,
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,EOPCOD,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

END