Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/srtsrc/srtcmp.mac
There are 10 other files named srtcmp.mac in the archive. Click here to see a list.
; UPD ID= 97 on 2/6/84 at 4:04 PM by FONG                               
TITLE	SRTCMP - COMPARISON CODE GENERATOR FOR SORT
SUBTTL	D.M.NIXON/DZN/BRF	19-Oct-82

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1975, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	SRTPRM
	XSEARCH			;SEARCH OTHER UNIVERSALS
IFN FTPRINT,<PRINTX [Entering SRTCMP.MAC]>

	.COPYRIGHT		;Put standard copyright statement in REL file
	SEGMENT	HPURE
SUBTTL	TABLE OF CONTENTS FOR SRTCMP


;                    Table of Contents for SRTCMP
;
;
;                             Section                             Page
;
;   1  SRTCMP - COMPARISON CODE GENERATOR FOR SORT ..............   1
;   2  TABLE OF CONTENTS FOR SRTCMP .............................   2
;   3  DEFINITIONS
;        3.1  Code Generation Macros ............................   3
;   4  EXTRACT CODE
;        4.1  Numeric Signed/Unsigned SIXBIT ....................   4
;        4.2  Numeric Signed/Unsigned ASCII .....................   6
;        4.3  Numeric Signed/Unsigned EBCDIC & COMP-3 ...........   8
;        4.4  Alphanumeric With Collating Sequence ..............  11
;        4.5  Floating Point ASCII ..............................  13
;   5  GENERATE CODE
;        5.1  Alphanumeric Logical SIXBIT .......................  15
;        5.2  Alphanumeric Logical SIXBIT
;             5.2.1  Dispatch Tables ............................  17
;        5.3  Alphanumeric Logical ASCII ........................  23
;        5.4  Alphanumeric Logical ASCII
;             5.4.1  Dispatch Tables ............................  24
;        5.5  Computational Signed/Unsigned SIXBIT ..............  29
;        5.6  Computational Signed/Unsigned ASCII ...............  30
;        5.7  Computational Signed/Unsigned EBCDIC ..............  31
;        5.8  Alphanumeric Logical EBCDIC .......................  32
;        5.9  Alphanumeric Logical EBCDIC
;             5.9.1  Dispatch Tables ............................  33
;        5.10  Computational Signed/Unsigned Binary .............  37
;   6  CODE GENERATION
;        6.1  All Converted Numeric Keys ........................  39
;   7  CODE GENERATION MACRO SUPPORT ROUTINES ...................  40
;   8  RUN-TIME ROUTINES AND TABLES .............................  50
;   9  ERROR MESSAGES ...........................................  76
SUBTTL	INTERNAL/EXTERNAL DEFINITIONS

;GENERATE STRUCTURE MACROS
;NOW GENERATE THEM MAX = 10 FOR NOW
	RADIX	10
$TEMPORARY (10,10)
	RADIX	8
k==0			;[N16] Relocation constant

;GLOBAL ROUTINES IN SRTCMP
;GENERATE THE COMPARISON ROUTINES
DEFINE XX (AA,B)<
IFIDN <B><N>,<INTERN	AA'GEN>
IFIDN <B><A>,<INTERN	AA'EXT,AA'KLX,AA'ADX>
IFIDN <B><C>,<INTERN	AA'EXT,AA'ADX,AA'GEN>
>
IXMODE
INTERN	ALP.69,ALP.79,ALP.97,CNVGEN,%JRST%

;EXTERNALS

;DEFINED IN SORT
EXTERN	CPU,XTRWRD
EXTERN	%ERMSG,%TOCTW,%TSTRG

;DEFINED IN SRTSTA
EXTERN	BPWORD,COLSW,MAXKEY,MINKEY,XTRBYT
EXTERN	DIE,E$$CWB,E$$TMD

;DEFINED IN SRTFLT
EXTERN	FLIRT
SUBTTL	DEFINITIONS -- Code Generation Macros

DEFINE	$HLRZ$<
	PUSHJ	P,%HLRZ%
>

DEFINE	$HRLZ$<
	PUSHJ	P,%HRLZ%
>

DEFINE	$HLRN$<
	PUSHJ	P,%HLRN%
>

DEFINE	$HRRZ$<
	PUSHJ	P,%HRRZ%
>

DEFINE	$MOVE$<
	PUSHJ	P,%MOVE%
>

DEFINE	$CAM$<
	PUSHJ	P,%CAM%
>

DEFINE	$JCAM$<
	PJRST	%CAM%
>

DEFINE	$JCAMN$<
	PJRST	%CAMN%
>

DEFINE	$AND$ (N)<
	HRRZI	T1,N
	PUSHJ	P,%AND%
>

DEFINE	$ANDI$ (N)<
 IFN N&<-1,,0>,<
	HRRZI	T1,(EXP N)	;;[C20]
 >
 IFE N&<-1,,0>,<
	HRRZI	T1,N
 >
	PUSHJ	P,%ANDI%
>

DEFINE	$LSH$ (N)<
	MOVEI	T1,N
	PUSHJ	P,%LSH%
>

DEFINE	$LSHN$ (N)<
	MOVEI	T1,N
	PUSHJ	P,%LSHN%
>

DEFINE	$TRZ$ (N)<
	HRRZI	T1,N
	PUSHJ	P,%TRZ%
>

DEFINE	$TLZ$ (N)<
 IFN N&<-1,,0>,<
	HRRZI	T1,(EXP N)	;;[C20]
 >
 IFE N&<-1,,0>,<
	HRRZI	T1,N
 >
	PUSHJ	P,%TLZ%
>
DEFINE	$JRST$<
	PUSHJ	P,%JRST%
>

DEFINE	$MOVM$<
	PUSHJ	P,%MOVM%
>

DEFINE	$SCAM$<
	PJRST	%SCAM%
>

DEFINE	$DCAM$<
	PJRST	%DCAM%
>

DEFINE	$DCAMM$<
	PJRST	%DCAMM%
>

DEFINE	$DMOV$<
	PUSHJ	P,%DMOV%
>

DEFINE	$LSHC$ (N)<
	MOVEI	T1,N
	PUSHJ	P,%LSHC%
>

DEFINE	$KCAM$<
	PJRST	%KCAM%
>

DEFINE	$LCAM$<
	PJRST	%LCAM%
>

DEFINE	DISPATCH (A,B)<
A'DSP:
 IRP B,<
B'EXT:	JSP	T1,A'TST
 >
>

DEFINE	CHAR (NUMERIC,ALPHA,FLAGS)<
 IFNB <FLAGS>,<
  <ALPHA>B17+NUMERIC&17+FLAGS+CF.S
 >
 IFB <FLAGS>,<
  IFNB <ALPHA>,<
   <ALPHA>B17+NUMERIC&17
  >
  IFB <ALPHA>,<
   <"\">B17+NUMERIC&17
  >
 >
>
SUBTTL	EXTRACT CODE -- Numeric Signed/Unsigned SIXBIT

	SEGMENT	HPURE		;[C20]

IFE FTFORTRAN,<
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
;	R HAS POINTER TO KEY INFO
;	U HAS CODE STORE POINTER

;	IF NOT KL10 GENERATES

	LOC	0
EK.SUB:!	BLOCK	1	;JSP	T4,SUBROUTINE
EK.LBP:!	BLOCK	1	;BYTE PTR TO LOAD KEY
EK.CNT:!	BLOCK	1	;COUNT
EK.SBP:!	BLOCK	1	;BYTE PTR TO STORE KEY
EK.LEN:!
	RELOC

;RETURN
;+2		ALWAYS

IFE FTKL10,<
DISPATCH	(SIX,<NSS,NUS>)

SXDTBL:	.DSSX,,.SSSX			;SIGNED SIXBIT
	.DUSX,,.SUSX			;UNSIGNED SIXBIT

SIXTST:	CAIG	P2,^D10			;DOUBLE PRECISION?
	SKIPA	T1,SXDTBL-SIXDSP-1(T1)	;[OK] NO, SINGLE PRECISION
	HLRZ	T1,SXDTBL-SIXDSP-1(T1)	;[OK] YES
	HRLI	T1,(JSP	T4,)		;ADD CALL
	MOVEM	T1,EK.SUB(U)
	MOVE	T1,P1			;[C20] POSITION OF FIRST BYTE
	IDIVI	T1,6			;T1=WORD DISP, T2=BYTE DISP
	ADD	T1,SXBTBL(T2)		;[OK] FORM INPUT BYTE PTR
	PJRST	XTRTRN			;COMMON RETURN
>;END IFE FTKL10


SXBTBL:	POINT	6,1(R)
	POINT	6,1(R),5
	POINT	6,1(R),11
	POINT	6,1(R),17
	POINT	6,1(R),23
	POINT	6,1(R),29
;	IF KL10 GENERATE

	LOC	0
BK.CNT:!	BLOCK	1	;MOVEI	T0,SIZE
BK.SRC:!	BLOCK	1	;SKIPA	T1,.+1
BK.LBP:!	BLOCK	1	;SOURCE BYTE PTR
BK.IDX:!	BLOCK	1	;SKIPA	P1,.+1
BK.FLG:!	BLOCK	1	;FLAGS	,,INDEX
BK.SUB:!	BLOCK	1	;PUSHJ	P,CVTDB.
BK.SWI:!	BLOCK	1	;MOVEM	T3,N(R)
BK.LEN:!
	RELOC

;RETURN
;+2		ALWAYS

NSSKLX:	SKIPA	T2,[FL.SGN+T.SIX]	;SIXBIT SIGNED
NUSKLX:	MOVEI	T2,T.SIX		;SIXBIT UNSIGNED
	CAILE	P2,^D10			;DP 
	TXO	T2,FL.DP		;YES
	MOVSI	T1,(SKIPA P1,)
	HRRI	T1,BK.FLG(U)
	DMOVEM	T1,BK.IDX(U)
	MOVE	T1,P1			;[C20]
	IDIVI	T1,6
	ADD	T1,SXBTBL(T2)		;[OK]
	PJRST	BXTRTN


IFN FTKL10,<
NSSEXT==NSSKLX
NUSEXT==NUSKLX
>

>;END IFE FTFORTRAN
SUBTTL	EXTRACT CODE -- Numeric Signed/Unsigned ASCII

;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
;	R HAS POINTER TO KEY INFO
;	U HAS CODE STORE POINTER

;	IF NOT KL10 GENERATES

	LOC	0
EK.SUB:!	BLOCK	1	;JSP	T4,SUBROUTINE
EK.LBP:!	BLOCK	1	;BYTE PTR TO LOAD KEY
EK.CNT:!	BLOCK	1	;COUNT
EK.SBP:!	BLOCK	1	;BYTE PTR TO STORE KEY
EK.LEN:!
	RELOC

IFE FTKL10,<

DISPATCH	(ASC,<NSA,NUA>)
ASDTBL:	.DSAX,,.SSAX			;SIGNED ASCII
	.DUAX,,.SUAX			;UNSIGNED ASCI

ASCTST:	CAIG	P2,^D10			;DOUBLE PRECISION?
	SKIPA	T1,ASDTBL-ASCDSP-1(T1)	;[OK] NO, SINGLE PRECISION
	HLRZ	T1,ASDTBL-ASCDSP-1(T1)	;[OK] YES
	HRLI	T1,(JSP	T4,)		;ADD CALL
	MOVEM	T1,EK.SUB(U)
	MOVE	T1,P1			;POSITION OF FIRST BYTE
	IDIVI	T1,5			;T1=WORD DISP, T2=BYTE DISP
	ADD	T1,ASBTBL(T2)		;[OK] FORM INPUT BYTE PTR
	PJRST	XTRTRN			;COMMON EXIT

>

ASBTBL:	POINT	7,1(R)
	POINT	7,1(R),6
	POINT	7,1(R),13
	POINT	7,1(R),20
	POINT	7,1(R),27
;	IF KL10 GENERATE

	LOC	0
BK.CNT:!	BLOCK	1	;MOVEI	T0,SIZE
BK.SRC:!	BLOCK	1	;SKIPA	T1,.+1
BK.LBP:!	BLOCK	1	;SOURCE BYTE PTR
BK.IDX:!	BLOCK	1	;SKIPA	P1,.+1
BK.FLG:!	BLOCK	1	;FLAGS	,,INDEX
BK.SUB:!	BLOCK	1	;PUSHJ	P,CVTDB.
BK.SWI:!	BLOCK	1	;MOVEM	T3,N(R)
BK.LEN:!
	RELOC

;RETURN
;+2		ALWAYS

NSAKLX:	SKIPA	T2,[FL.SGN+T.ASC]	;ASCII SIGNED
NUAKLX:	MOVEI	T2,T.ASC		;ASCII UNSIGNED
	CAILE	P2,^D10			;DP 
	TXO	T2,FL.DP		;YES
	MOVSI	T1,(SKIPA P1,)
	HRRI	T1,BK.FLG(U)
	DMOVEM	T1,BK.IDX(U)
	MOVE	T1,P1			;[C20]
	IDIVI	T1,5
	ADD	T1,ASBTBL(T2)		;[OK]
	PJRST	BXTRTN

IFN FTKL10,<
NSAEXT==NSAKLX
NUAEXT==NUAKLX
>
SUBTTL	EXTRACT CODE -- Numeric Signed/Unsigned EBCDIC & COMP-3

IFE FTFORTRAN,<
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
;	R HAS POINTER TO KEY INFO
;	U HAS CODE STORE POINTER

;	IF NOT KL10 GENERATES

	LOC	0
EK.SUB:!	BLOCK	1	;JSP	T4,SUBROUTINE
EK.LBP:!	BLOCK	1	;BYTE PTR TO LOAD KEY
EK.CNT:!	BLOCK	1	;COUNT
EK.SBP:!	BLOCK	1	;BYTE PTR TO STORE KEY
EK.LEN:!
	RELOC

IFE FTKL10,<
DISPATCH	(EBC,<NSE,NUE,C3S,C3U>)
>
IFN FTKL10,<
DISPATCH	(EBC,<C3S,C3U>)
>

EBDTBL:
IFE FTKL10,<
	.DSEX,,.SSEX			;SIGNED EBCDIC
	.DUEX,,.SUEX			;[144] UNSIGNED EBCDIC
>
	.DS3X,,.SS3X			;SIGNED COMP-3
	.DU3X,,.SU3X			;UNSIGNED COMP-3

EBCTST:	CAIG	P2,^D10			;DOUBLE PRECISION?
	SKIPA	T1,EBDTBL-EBCDSP-1(T1)	;[OK] LOAD SUBROUTINE
	HLRZ	T1,EBDTBL-EBCDSP-1(T1)	;[OK] GET DP ROUTINE
	HRLI	T1,(JSP	T4,)		;ADD CALL
	MOVEM	T1,EK.SUB(U)		;SUBROUTINE CALL
	MOVE	T1,P1			;POSITION OF FIRST BYTE
	IDIVI	T1,4			;T1=WORD DISP, T2=BYTE DISP
	ADD	T1,EBBTBL(T2)		;[OK] FORM INPUT BYTE PTR
	PJRST	XTRTRN			;COMMON RETURN

EBBTBL:	POINT	9,1(R)
	POINT	9,1(R),8
	POINT	9,1(R),17
	POINT	9,1(R),26
;	IF KL10 GENERATES

	LOC	0
BK.CNT:!	BLOCK	1	;MOVEI	T0,SIZE
BK.SRC:!	BLOCK	1	;SKIPA	T1,.+1
BK.LBP:!	BLOCK	1	;SOURCE BYTE PTR
BK.IDX:!	BLOCK	1	;SKIPA	P1,.+1
BK.FLG:!	BLOCK	1	;FLAGS	,,INDEX
BK.SUB:!	BLOCK	1	;PUSHJ	P,CVTDB.
BK.SWI:!	BLOCK	1	;MOVEM	T3,N(R)
BK.LEN:!
	RELOC

;RETURN
;+2		ALWAYS

NSEKLX:	SKIPA	T2,[FL.SGN+T.EBC]	;EBCDIC SIGNED
NUEKLX:	MOVEI	T2,T.EBC		;EBCDIC UNSIGNED
	CAILE	P2,^D10			;DP 
	TXO	T2,FL.DP		;YES
	MOVSI	T1,(SKIPA P1,)
	HRRI	T1,BK.FLG(U)
	DMOVEM	T1,BK.IDX(U)
	MOVE	T1,P1			;[C20]
	IDIVI	T1,4
	ADD	T1,EBBTBL(T2)		;[OK]
	PJRST	BXTRTN


C3SKLX==C3SEXT
C3UKLX==C3UEXT

IFN FTKL10,<
NSEEXT==NSEKLX
NUEEXT==NUEKLX
>

>;END IFE FTFORTRAN
;COMMON RETURN FOR NUMERIC SIGNED/UNSIGNED EXTRACT ROUTINES
BEGIN
  PROCEDURE (PUSHJ	P,XTRTRN)
	MOVEM	T1,EK.LBP(U)		;STORE
	MOVEM	P2,EK.CNT(U)		;NO. OF BYTES
	MOVE	T1,XTRWRD		;OUTPUT BYTE PTR
	MOVEM	T1,EK.SBP(U)
	ADDI	U,EK.LEN		;ACCOUNT FOR WORDS USED
	PJRST	CXTRTN			;COMMON RETURN
ENDB;

BEGIN
  PROCEDURE (PUSHJ	P,BXTRTN)
	MOVEM	T1,BK.LBP(U)		;STORE
	MOVSI	T1,(MOVEI T0,)
	HRR	T1,P2			;[C20]
	MOVEM	T1,BK.CNT(U)		;SIZE
	MOVSI	T1,(SKIPA T1,)
	HRRI	T1,BK.LBP(U)
	MOVEM	T1,BK.SRC(U)		;SKIPA	T1,.+1
	MOVE	T1,[PUSHJ P,CVTDB.]
	MOVEM	T1,BK.SUB(U)
	MOVE	T1,XTRWRD		;OUTPUT BYTE PTR
	HRLI	T1,(MOVEM T4,(R))
	CAILE	P2,^D10
	HRLI	T1,(DMOVEM T3,(R))	;DP
	MOVEM	T1,BK.SWI(U)		;STORE INSTRUCTION
	ADDI	U,BK.LEN		;ACCOUNT FOR WORDS USED
;	PJRST	CXTRTN			;COMMON RETURN
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,CXTRTN)
	MOVE	T1,XTRBYT		;CURRENT STORE ORIGIN
	MOVEM	T1,KY.INI(R)		;WHERE BYTE NOW STARTS
	MOVE	T1,BPWORD		;BYTES PER WORD
	AOS	XTRWRD
	ADDM	T1,XTRBYT		;ACCOUNT FOR FIRST WORD
	CAIG	P2,^D10			;DOUBLE PRECISION?
	JRST	$1			;NO
	AOS	XTRWRD
	ADDM	T1,XTRBYT		;YES, ACCOUNT FOR SECOND WORD
  $1%	MOVE	T1,P1			;GET ORIGIN OF KEY
	ADD	T1,P2			;ADD IN SIZE
	CAMLE	T1,MINKEY		;IS IT BIGGEST YET
	MOVEM	T1,MINKEY		;YES, SAVE IT
	RETURN
ENDB;
SUBTTL	EXTRACT CODE -- Alphanumeric With Collating Sequence

;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
;	R HAS POINTER TO KEY INFO
;	U HAS CODE STORE POINTER

;	IF NOT KL GENERATES

	LOC	0
CA.CNT:!	BLOCK	1	;MOVEI	T0,SIZE
CA.LBS:!	BLOCK	1	;SKIPA	T2,.+1
CA.SBP:!	BLOCK	1	;BYTE PTR TO LOAD KEY
CA.LBD:!	BLOCK	1	;SKIPA	T3,.+1
CA.DBP:!	BLOCK	1	;BYTE PTR TO STORE KEY
CA.LUP:!	BLOCK	1	;ILDB	T1,T2
		BLOCK	1	;ROT	T1,-1
		BLOCK	1	;[OK] ADDI	T1,@COLSW
		BLOCK	1	;SKIPGE	T1
		BLOCK	1	;[OK] SKIPA	T1,(T1)
		BLOCK	1	;[OK] HLRZ	T1,(T1)
		BLOCK	1	;IDPB	T1,T3
CA.SOJ:!	BLOCK	1	;SOJG	T0,CA.LUP	
CA.LEN:!
	RELOC

BEGIN
  PROCEDURE	(PUSHJ	P,<ALSEXT,ALAEXT,ALEEXT>)
IFE FTOPS20,<
	SKIPN	COLSW			;COLLATING SEQUENCE GIVEN?
	RETURN				;NO
	MOVE	T2,CPU
	CAIL	T2,KL.CPU		;IF KL10
	JRST	ALSKLX			;USE BIS
	MOVSI	T1,(MOVEI T0,)
	HRR	T1,P2			;BUILD MOVEI T0,SIZE
	MOVEM	T1,CA.CNT(U)
	MOVSI	T1,(SKIPA T2,)
	HRRI	T1,CA.SBP(U)
	MOVEM	T1,CA.LBS(U)		;SKIPA T2,[INPUT BYTE POINTER]
	ADD	T1,[Z T3-T2,CA.DBP-CA.SBP]
	MOVEM	T1,CA.LBD(U)		;SKIPA T3,[OUTPUT BYTE POINTER]
	MOVE	T1,P1			;[C20] POSITION OF FIRST BYTE
	MOVE	T4,BPWORD		;NO. OF BYTES PER WORD
	IDIV	T1,T4			;[C20] T1=WORD DISP, T2=BYTE DISP
	ADD	T1,@COLTBL-4(T4)	;[OK] FORM INPUT BYTE PTR
	MOVEM	T1,CA.SBP(U)		;STORE
	SETZ	T2,			;START AT THE LEFT MOST BYTE
	HLLZ	T1,@COLTBL-4(T4)	;[OK] INSERT THE BYTE POINTER
	HRR	T1,XTRWRD		;INSERT THE EXTRACTED POSITION
	MOVEM	T1,CA.DBP(U)	
	MOVSI	T1,[ILDB T1,T2
		ROT	T1,-1
		ADDI	T1,@COLSW		;[OK]
		SKIPGE	T1
		SKIPA	T1,(T1)			;[OK]
		HLRZ	T1,(T1)			;[OK]
		IDPB	T1,T3
		SOJG	T0,0]
	HRRI	T1,CA.LUP(U)
	BLT	T1,CA.LEN-1(U)		;COPY REST OF CODE
	MOVEI	T1,CA.LUP(U)		;[340] LOOP LOC.
	ADDM	T1,CA.SOJ(U)		;[340] FOR SOJG
	ADDI	U,CA.LEN		;ACCOUNT FOR WORDS USED
	MOVE	T1,XTRBYT		;CURRENT STORE ORIGIN
	MOVEM	T1,KY.INI(R)		;WHERE BYTE NOW STARTS
	MOVE	T1,P2			;NO. OF BYTES
	ADDI	T1,-1(T4)		;[OK] ROUND UP
	IDIV	T1,T4			;[C20] GET NO. OF WHOLE WORDS
	ADDM	T1,XTRWRD		;ACCOUNT FOR THEM
	IMUL	T1,T4			;[C20] GET NUMBER OF BYTES
	ADDM	T1,XTRBYT		;
	RETURN
>
ENDB;
;	IF KL GENERATES

	LOC	0
CK.CNT:!	BLOCK	1	;MOVEI	T0,SIZE
CK.LBS:!	BLOCK	1	;SKIPA	T1,.+1
CK.SBP:!	BLOCK	1	;BYTE PTR TO LOAD KEY
CK.CN3:!	BLOCK	1	;MOVEI	T3,SIZE
CK.LBD:!	BLOCK	1	;SKIPA	T4,.+1
CK.DBP:!	BLOCK	1	;BYTE PTR TO STORE KEY
CK.RST:!	BLOCK	1	;SETZ	T2,
		BLOCK	1	;TXO	T0,S.FLAG
		BLOCK	1	;[OK] EXTEND	T0,[@COLSW
				;	EXP 0]
		BLOCK	1	;  NOOP
CK.LEN:!
	RELOC

BEGIN
  PROCEDURE	(PUSHJ	P,<ALSKLX,ALAKLX,ALEKLX>)
	SKIPN	COLSW			;COLLATING SEQUENCE GIVEN?
	RETURN				;NO
	MOVSI	T1,(MOVEI T0,)
	HRR	T1,P2			;BUILD MOVEI T0,SIZE
	MOVEM	T1,CK.CNT(U)
	HRLI	T1,(MOVEI T3,)
	MOVEM	T1,CK.CN3(U)		;MOVEI T3,SIZE
	MOVSI	T1,(SKIPA T1,)
	HRRI	T1,CK.SBP(U)
	MOVEM	T1,CK.LBS(U)		;SKIPA T1,[INPUT BYTE POINTER]
	ADD	T1,[Z T4-T1,CK.DBP-CK.SBP]
	MOVEM	T1,CK.LBD(U)		;SKIPA T4,[OUTPUT BYTE POINTER]
	MOVE	T1,P1			;[C20] POSITION OF FIRST BYTE
	MOVE	T4,BPWORD		;NO. OF BYTES PER WORD
	IDIV	T1,T4			;[C20] T1=WORD DISP, T2=BYTE DISP
	ADD	T1,@COLTBL-4(T4)	;[OK] FORM INPUT BYTE PTR
	MOVEM	T1,CK.SBP(U)		;STORE
	SETZ	T2,			;START AT THE LEFT MOST BYTE
	HLLZ	T1,@COLTBL-4(T4)	;[OK] INSERT THE BYTE POINTER
	HRR	T1,XTRWRD		;INSERT THE EXTRACTED POSITION
	MOVEM	T1,CK.DBP(U)	
	MOVSI	T1,[SETZ T2,			;JUST IN CASE
		TXO	T0,S.FLAG		;TURN ON SIGNIFICANCE
		EXTEND	T0,MOVSTC		;TRANSLATE
		  NOOP]
	HRRI	T1,CK.RST(U)
	BLT	T1,CK.LEN-1(U)		;COPY REST OF CODE
	ADDI	U,CK.LEN		;ACCOUNT FOR WORDS USED
	MOVE	T1,XTRBYT		;CURRENT STORE ORIGIN
	MOVEM	T1,KY.INI(R)		;WHERE BYTE NOW STARTS
	MOVE	T1,P2			;NO. OF BYTES
	ADDI	T1,-1(T4)		;[OK] ROUND UP
	IDIV	T1,T4			;[C20] GET NO. OF WHOLE WORDS
	ADDM	T1,XTRWRD		;ACCOUNT FOR THEM
	IMUL	T1,T4			;[C20] GET NUMBER OF BYTES
	ADDM	T1,XTRBYT		;
	RETURN
ENDB;

IFN FTFORTRAN,<;FORTRAN ONLY READS ASCII FILES
EBBTBL==ASBTBL
SXBTBL==ASBTBL
>

COLTBL:	IFIW	EBBTBL(T2)		;[C20]
	IFIW	ASBTBL(T2)		;[C20]
	IFIW	SXBTBL(T2)		;[C20]

	SEGMENT	LPURE			;[C20]

MOVSTC:	MOVST	@COLSW			;[OK]
	EXP	0

	SEGMENT	HPURE			;[C20]
SUBTTL	EXTRACT CODE -- Floating Point ASCII

;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
;	R HAS POINTER TO KEY INFO
;	U HAS CODE STORE POINTER

;	GENERATES


	LOC	0		;[C13]
FK.L:!		BLOCK	1	;[C13] MOVEI	L,FK.LBP
FK.SUB:!	BLOCK	1	;[C13] PUSHJ	P,SUBROUTINE
FK.GO:!		BLOCK	1	;[C13] JRST	FK.LEN
FK.LBP:!	BLOCK	1	;[C13] BYTE PTR TO LOAD KEY
FK.CNT:!	BLOCK	1	;[C13] COUNT
FK.W:!		BLOCK	1	;[C13] FORTRAN WIDTH OR -1 FOR FREE FORMAT
FK.D:!		BLOCK	1	;[C13] FORTRAN DECIMAL PLACES
FK.S:!		BLOCK	1	;[C13] FLAGS,,FORTRAN SCALE FACTOR
				;[C13]   1B0=DOUBLE PRECISION
FK.SBP:!	BLOCK	1	;[C13] BYTE PTR TO STORE KEY
FK.LEN:!			;[C13]
	RELOC

GFSEXT:	GFSKLX:
	MOVX	T1,KY%FGF	;GET Gfloating FLAG
	IORM	T1,KY.FMT+2(R)	; ADD TO FORMAT BLOCK
	JRST	FPAEXT

GFUEXT:	GFUKLX:
	MOVX	T1,KY%FGF!KY%FUN	;GET Gfloating AND UNSIGNED FLAGS
	IORM	T1,KY.FMT+2(R)	; ADD TO FORMAT BLOCK
	JRST	FPAEXT

FPUEXT:	FPUKLX:			;[511] UNSIGNED
	MOVX	T1,KY%FUN	;[511] ADD THAT FLAG
	IORM	T1,KY.FMT+2(R)	;[511]  TO THE FORMAT BLOCK

BEGIN
  PROCEDURE	(PUSHJ	P,<FPAEXT,FPAKLX>)
	MOVSI	T1,(MOVEI L,)	;[C13] BUILD FK.L
	HRRI	T1,FK.LBP(U)	;[C13]  ..
	MOVEM	T1,FK.L(U)	;[C13]  ..
	MOVE	T1,[PUSHJ P,FLIRT] ;[C13] BUILD FK.SUB
	MOVEM	T1,FK.SUB(U)	;[C13]  ..
	MOVSI	T1,(JRST)	;[C13] BUILD FK.GO
	HRRI	T1,FK.LEN(U)	;[C13]  ..
	MOVEM	T1,FK.GO(U)	;[C13]  ..
	MOVE	T1,P1		;[C20] [C13] BUILD FK.LBP
	IDIVI	T1,5		;[C13]  ..
	ADD	T1,ASBTBL(T2)	;[OK] [C13]  ..
	MOVEM	T1,FK.LBP(U)	;[C13]
	MOVEM	P2,FK.CNT(U)	;[C13] TRANSFER FK.CNT
	DMOVE	T1,KY.FMT(R)	;[C13] TRANSFER FK.W AND FK.D
	DMOVEM	T1,FK.W(U)	;[C13]  ..
	MOVE	T1,KY.FMT+2(R)	;[C13] TRANSFER FK.S
	MOVEM	T1,FK.S(U)	;[C13]  ..
	MOVE	T1,XTRWRD	;[C13] BUILD FK.SBP
	MOVEM	T1,FK.SBP(U)	;[C13]  ..

	ADDI	U,FK.LEN	;ACCOUNT FOR WORDS USED
	MOVE	T1,XTRBYT	;CURRENT STORE ORIGIN
	MOVEM	T1,KY.INI(R)	;WHERE BYTE NOW STARTS
	MOVE	T2,BPWORD	;BYTES PER WORD
	ADDM	T2,XTRBYT	;
	AOS	XTRWRD		;ACCOUNT FOR FIRST KEY WORD
	SKIPL	KY.FMT+2(R)	;[C13] DOUBLE PRECISION?
	JRST	$1		;[C13] NO
  	ADDM	T2,XTRBYT	;[C13] YES, ACCOUNT FOR IT
	AOS	XTRWRD		;ACCOUNT FOR SECOND WORD
  $1%	MOVE	T1,P1		;[C13] GET ORIGIN OF KEY
	ADD	T1,BPWORD	;ACCOUNT FOR S.P.
	SKIPGE	KY.FMT+2(R)	;[C13] IS IT D.P.
	ADD	T1,BPWORD	;YES
	CAMLE	T1,MINKEY	;IS IT BIGGEST YET
	MOVEM	T1,MINKEY	;YES, SAVE IT
	RETURN
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,<ALSADX,ALAADX,ALEADX>)
	SKIPN	COLSW
	RETURN			;NO COLLATING SWITCH
	MOVE	T1,XTRWRD	;GET EXTRA SIZE
	MOVE	T2,CPU
	ADDM	T1,2(U)		;ADJUST INPUT BYTE POINTER
	ADDI	U,CK.LEN	;GET TO NEXT
	CAIGE	T2,KL.CPU	;IF KA OR KI
	ADDI	U,CA.LEN-CK.LEN	;ADJUST SOME MORE
CPOPJ:	RETURN
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,<NSSADX,NUSADX,NSAADX,NUAADX,NSEADX,NUEADX>)
	MOVE	T1,XTRWRD	;GET EXTRA SIZE
	MOVE	T2,CPU
  IF KL10
	CAIGE	T2,KL.CPU
	JRST	$T
  THEN
	ADDM	T1,BK.LBP(U)	;ADJUST BYTE POINTER
	ADDI	U,BK.LEN
	RETURN
  ELSE
	ADDM	T1,EK.LBP(U)	;ADJUST BYTE POINTER
	ADDI	U,EK.LEN
	RETURN
  FI;
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,<C3SADX,C3UADX>)
	MOVE	T1,XTRWRD	;GET EXTRA SIZE
	ADDM	T1,EK.LBP(U)	;[446] ADJUST BYTE POINTER
	ADDI	U,EK.LEN	;[446] ADVANCE TO NEXT
	RETURN
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,<FPAADX,FPUADX,GFSADX,GFUADX>)	;[511]
	MOVE	T1,XTRWRD	;GET EXTRA SIZE
	ADDM	T1,FK.LBP(U)	;[C13] ADJUST BYTE POINTER
	ADDI	U,FK.LEN
	RETURN
ENDB;
SUBTTL	GENERATE CODE -- Alphanumeric Logical SIXBIT

IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,ALSGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES

	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	ADD	P2,P1		;[C20] GET MAX. BYTE IN KEY
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
  IF KEY IS A REASONABLE SIZE
	CAILE	P3,MAXXSZ	;[N16] IF KEY IS TOO BIG
	JRST	$F		;[N16] USE EXTEND OR SOJG LOOP
  THEN TRY TO GENERATE OPTIMAL CODE
	PUSH	P,U
  WHILE KEY NOT DONE
	BEGIN
		PUSH	P,P1		;SAVE BYTE DISPLACEMENT
		IDIVI	P1,6		;P1 -- WORD DISP:P2 -- BYTE DISP
		ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
		MOVE	P4,P2		;[C20] COPY BYTE DISPLACEMENT WITHIN WORD
		SUBI	P2,6
		MOVN	P2,P2		;6 - BYTE DISPLACEMENT
		CAMLE	P2,P3		;[C20]
		MOVE	P2,P3		;[C20] MIN (LENGTH, BYTES IN THIS WORD)
		PUSHJ	P,@ALSDSP-1(P2)	;[OK] DISPATCH
		POP	P,P1		;RESTORE BYTE DISPLACENT
		ADD	P1,P2		;[C20] ADVANCE BYTE POSITION
		SUB	P3,P2		;[C20] ACCOUNT FOR BYTES JUST HANDLED
		JUMPN	P3,$B		;FINISHED WITH THIS KEY?
	ENDB;
	POP	P,T1
	MOVE	T2,CPU
	CAIL	T2,KL.CPU	;IF NOT A KL10  OR 
	CAIG	U,16(T1)	;[OK] LONGER THAN EXTEND CODE WOULD BE?
	RETURN			;NO
	MOVE	U,T1		;[OK] RESTORE U
  FI;
	MOVE	T1,KY.SIZ(R)		;[142] GET BACK ORIGIN
	IDIVI	T1,6			;[142] BYTES INTO FIRST WORD OF KEY
	MOVE	P1,KY.INI(R)		;[142] GET BYTE LENGTH OF KEY
	IDIVI	P1,6			;[142] 'WORDS' IN P1, 'BYTES LEFT' IN P2
	LDB	T1,ALSTB1(T2)		;[OK] [142] GET INDEX FOR LATER
	MOVE	T2,CPU		;[N16] ONLY EXTEND INST CAN HANDLE 36 BITS CORRECTLY
	CAIGE	T2,KL.CPU	;[N16] IS IT A KA OR KI
	CAIE	T1,3		;[N16] YES, IS IT 36 BITS?
	FASTSKIP		;[N16] NO, OK
	MOVEI	T1,2		;[N16] YES, CONVERT TO 18 BITS ONLY
	IDIV	P2,[EXP 1,2,3,6](T1)	;[OK] [142] GET BYTE BOUNDARY NUMBER
	ADD	P1,@[IFIW SXBTBL(P2)	;[C20] [142] 6  BIT BYTES
		     IFIW B12TBL(P2)	;[C20] [142] 12 BIT BYTES
		     IFIW B18TBL(P2)	;[C20] [142] 18 BIT BYTES
		     IFIW [POINT 36,1(R)]](T1);[C20] [142] 36 BIT BYTES (WORDS)
	MOVE	P3,KY.SIZ(R)		;[142] GET BYTE LEN OF KEY BACK
	IDIV	P3,[EXP 1,2,3,6](T1)	;[OK] [142] GET NUMBER OF BYTES FOR CMPSGE
	$KCAM$
ENDB;
;STILL IN IFE FTFORTRAN

ALSDSP:	IFIW	@SIX1(P4)		;[C20] SINGLE BYTE
	IFIW	@SIX2(P4)		;[C20] TWO BYTES
	IFIW	@SIX3(P4)		;[C20] THREE BYTES
	IFIW	@SIX4(P4)		;[C20] FOUR BYTES
	IFIW	@SIX5(P4)		;[C20] FIVE BYTES
	IFIW	 SIX60			;[C20] SIX BYTES

B12TBL:	POINT	12,1(R)
	POINT	12,1(R),11
	POINT	12,1(R),23

B18TBL:	POINT	18,1(R)
	POINT	18,1(R),17

ALSTB1:	POINT	6,ALSTB2(P2),5		;[OK]
	POINT	6,ALSTB2(P2),11		;[OK]
	POINT	6,ALSTB2(P2),17		;[OK]
	POINT	6,ALSTB2(P2),23		;[OK]
	POINT	6,ALSTB2(P2),29		;[OK]
	POINT	6,ALSTB2(P2),35		;[OK]

ALSTB2:	BYTE	(6) 3,0,1,2,1,0
	BYTE	(6) 0,0,0,0,0,0
	BYTE	(6) 1,0,1,0,1,0
	BYTE	(6) 2,0,0,2,0,0
	BYTE	(6) 1,0,1,0,1,0
	BYTE	(6) 0,0,0,0,0,0
SUBTTL	GENERATE CODE -- Alphanumeric Logical SIXBIT -- Dispatch Tables

;STILL IN IFE FTFORTRAN

SIX1:	IFIW SIX10			;[C20]
	IFIW SIX11			;[C20]
	IFIW SIX12			;[C20]
	IFIW SIX13			;[C20]
	IFIW SIX14			;[C20]
	IFIW SIX15			;[C20]

SIX2:	IFIW SIX20			;[C20]
	IFIW SIX21			;[C20]
	IFIW SIX22			;[C20]
	IFIW SIX23			;[C20]
	IFIW SIX24			;[C20]

SIX3:	IFIW SIX30			;[C20]
	IFIW SIX31			;[C20]
	IFIW SIX32			;[C20]
	IFIW SIX33			;[C20]

SIX4:	IFIW SIX40			;[C20]
	IFIW SIX41			;[C20]
	IFIW SIX42			;[C20]

SIX5:	IFIW SIX50			;[C20]
	IFIW SIX51			;[C20]

	SEGMENT	LPURE			;[C20]
	.HWFRMT
MSKS10==BYTE	(6)	77,00,00,00,00,00
MSKS13==BYTE	(6)	00,00,00,77,00,00
MSKS14==BYTE	(6)	00,00,00,00,77,00
MSKS15==BYTE	(6)	00,00,00,00,00,77
MSKS20==BYTE	(6)	77,77,00,00,00,00
MSKS22:	BYTE	(6)	00,00,77,77,00,00
MSKS23==BYTE	(6)	00,00,00,77,77,00
MSKS24==BYTE	(6)	00,00,00,00,77,77
MSKS31:	BYTE	(6)	00,77,77,77,00,00
MSKS32:	BYTE	(6)	00,00,77,77,77,00
MSKS33==BYTE	(6)	00,00,00,77,77,77
MSKS41:	BYTE	(6)	00,77,77,77,77,00
	.MFRMT
	SEGMENT	HPURE			;[C20]
;	CODE GENERATION FOR COMPARISON OF SIXBIT KEYS

;STILL IN IFE FTFORTRAN

;	SIXBIT  --  LENGTH 1 BYTE

SIX10:	$HLRZ$			;BYTE 0
	FASTSKIP
SIX13:	$HRRZ$			;BYTE 3
	$ANDI$	MSKS13
	$JCAM$			;[C20]

SIX11:	$HLRZ$			;BYTE 1
	FASTSKIP
SIX14:	$HRRZ$			;BYTE 4
	$ANDI$	MSKS14
	$JCAM$			;[C20]

SIX12:	$HLRZ$			;BYTE 2
	$ANDI$	MSKS15
	$JCAM$			;[C20]

SIX15:	CAIL	P3,1+6		;MORE THAN 1 FULL WORD LEFT?
	JRST	SIX1X2		;YES, GET NEXT 3 CHAR ALSO
	CAIG	P3,1+4		;TEST FOR SPECIAL END CASES
	JRST	@[IFIWS <.+1,SIX1X0,SIX1X1,SIX1X2,SIX1X3>]-1(P3)	;[C20]
	$HRRZ$			;BYTE 5
	$ANDI$	MSKS15
	$JCAM$			;[C20]

SIX1X0:	ADDI	P2,1		;ONE MORE BYTE
	$HRLZ$			;GET BYTE 5 OF FIRST WORD
	$HLRN$			;GET BYTE 0 OF NEXT WORD
	$AND$	MSKS22
	$JCAM$			;[C20]

SIX1X1:	ADDI	P2,2		;2 MORE BYTES
	$HRLZ$
	$HLRN$	
	$AND$	MSKS32		;[N18]
	$JCAM$			;[C20]

SIX1X2:	ADDI	P2,3		;3 MORE BYTES
	$HRLZ$
	$HLRN$	
	$TLZ$	MSKS20
	$JCAM$

SIX1X3:	ADDI	P2,4		;4 MORE BYTES
	$DMOV$
	$LSHC$	4*6
	$TLZ$	MSKS10
	$JCAM$
;STILL IN IFE FTFORTRAN

;	SIXBIT  --  LENGTH 2 BYTES

SIX20:	$HLRZ$			;BYTES 0-1
	FASTSKIP
SIX23:	$HRRZ$			;BYTES 3-4
	$ANDI$	MSKS23
	$JCAM$			;[C20]

SIX21:	$HLRZ$			;BYTES 1-2
	$ANDI$	MSKS24
	$JCAM$			;[C20]

SIX22:	$MOVE$			;BYTES 2-3
	$AND$	MSKS22
	$JCAM$

SIX24:	CAIL	P3,2+6		;MORE THAN 1 FULL WORD LEFT?
	JRST	SIX2X2		;YES, GET NEXT 3 CHARS ALSO
	CAIGE	P3,2+3		;TEST FOR SPECIAL END CASES
	JRST	@[IFIWS <.+1,SIX2X0,SIX2X1,SIX2X2>]-2(P3)	;[C20] DO THEM
	$HRRZ$			;BYTES 2-4
	$ANDI$	MSKS24
	$JCAM$			;[C20]

SIX2X0:	ADDI	P2,1
	$HRLZ$
	$HLRN$
	$AND$	MSKS31
	$JCAM$

SIX2X1:	ADDI	P2,2
	$HRLZ$
	$HLRN$
	$AND$	MSKS41
	$JCAM$

SIX2X2:	ADDI	P2,3
	$HRLZ$
	$HLRN$
	$TLZ$	MSKS10
	$JCAM$
;STILL IN IFE FTFORTRAN

;	SIXBIT  --  LENGTH 3 BYTES

SIX30:	$HLRZ$			;BYTES 0-2
	$JCAM$			;[C20]

SIX31:	$MOVE$			;BYTES 1-3
	$AND$	MSKS31
	$JCAM$

SIX32:	$MOVE$			;BYTES 2-4
	$AND$	MSKS32
	$JCAM$

SIX33:	CAIGE	P3,3+6		;TEST FOR SPECIAL END CASE
	JRST	@[IFIWS <.+1,SIX3X0,SIX3X1,.+1,.+1,.+1,SIX3X1>]-3(P3)	;[C20] YES
	$HRRZ$			;BYTES 3-5
	$JCAM$			;[C20]

SIX3X0:	ADDI	P2,1
	$HRLZ$
	$HLRN$
	$LSH$	-2*6
	$JCAM$

SIX3X1:	ADDI	P2,2
	$HRLZ$
	$HLRN$
	$LSH$	-6
	$JCAM$
;STILL IN IFE FTFORTRAN

;	SIXBIT -- LENGTH 4 BYTES

SIX40:	$MOVE$			;BYTES 0-3
	$LSH$	-^D12
	$JCAM$

SIX41:	$MOVE$			;BYTES 1-4
	$AND$	MSKS41
	$JCAM$

SIX42:	CAIN	P3,4+1		;TEST FOR SPECIAL END CASE
	JRST	SIX4X0		;YES
	$MOVE$			;BYTES 2-5
	$TLZ$	MSKS20
	$JCAM$

SIX4X0:	ADDI	P2,1
	$DMOV$
	$LSHC$	6
	$TLZ$	MSKS10
	$JCAM$
;STILL IN IFE FTFORTRAN

;	SIXBIT  --  LENGTH 5 BYTES

SIX50:	$MOVE$			;BYTES 0-4
	$LSH$	-6
	$JCAM$

SIX51:	$MOVE$			;BYTES 1-5
	$TLZ$	MSKS10
	$JCAM$
;	SIXBIT  --  LENGTH 6 BYTES

SIX60:	$LCAM$


>;END IFE FTFORTRAN
SUBTTL	GENERATE CODE -- Alphanumeric Logical ASCII

BEGIN
  PROCEDURE	(PUSHJ	P,ALAGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES

	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	ADD	P2,P1		;[C20] GET MAX. BYTE IN KEY
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
  IF KEY IS A REASONABLE SIZE
	CAILE	P3,MAXXSZ	;[N16] IF KEY IS TOO BIG
	JRST	$F		;[N16] USE EXTEND OR SOJG LOOP
  THEN TRY TO GENERATE OPTIMAL CODE
	PUSH	P,U
  WHILE KEY NOT DONE DO
	BEGIN
		PUSH	P,P1		;SAVE BYTE DISPLACEMENT
		IDIVI	P1,5		;P1 -- WORD DISP; P2 -- BYTE DISP
		ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
		MOVE	P4,P2		;[C20] COPY BYTE DISP
		SUBI	P2,5		;5 - BYTE DISPLACEMENT
		MOVN	P2,P2
		CAMLE	P2,P3		;[C20]		
		MOVE	P2,P3		;[C20] MIN (LENGTH, BYTES IN THIS WORD)
		PUSHJ	P,@ALADSP-1(P2)	;[OK] DISPATCH
		POP	P,P1		;RESTORE BYTE DISPLACEMENT
		ADD	P1,P2		;[C20] ADVANCE BYTE POSITION
		SUB	P3,P2		;[C20] ACCOUNT FOR BYTES JUST HANDLED
		JUMPN	P3,$B		;FINISH THIS KEY
	ENDB;
	POP	P,T1
	MOVE	T2,CPU
	CAIL	T2,KL.CPU	;IF NOT A KL10  OR 
	CAIG	U,16(T1)	;[OK] LONGER THAN EXTEND CODE WOULD BE?
	RETURN			;NO
	MOVE	U,T1		;[OK] RESTORE U
  FI;
	MOVE	P1,KY.INI(R)	;GET BACK ORIGIN
	MOVE	P3,KY.SIZ(R)	;AND LENGTH
	IDIVI	P1,5
 IF BOTH ORIGIN AND LENGTH DIVIDE BY 5
	JUMPN	P2,$T		;[153] NO
	MOVE	T1,P3
	IDIVI	T1,5
	JUMPN	T2,$T
 THEN WE CAN USE BYTE SIZE OF 35 BITS FOR 5 FOLD GAIN IN SPEED
	MOVE	P3,T1
	ADD	P1,[POINT 35,1(R)]
	$KCAM$
 ELSE   JUST USE 7 BIT BYTES
	ADD	P1,ASBTBL(P2)	;[OK] FORM BYTE PTR
	$KCAM$
 FI;
ENDB;
SUBTTL	GENERATE CODE -- Alphanumeric Logical ASCII -- Dispatch Tables
ALADSP:	IFIW	@ASC1(P4)	;[C20]  1 BYTE USED IN THE WORD
	IFIW	@ASC2(P4)	;[C20]  2 BYTES USED IN THE WORD
	IFIW	@ASC3(P4)	;[C20]  3 BYTES USED IN THE WORD
	IFIW	@ASC4(P4)	;[C20]  4 BYTES USED IN THE WORD
	IFIW	 ASC50		;[C20]  ALL 5 BYTES USED IN THE WORD

ASC1:	IFIW	ASC10		;[C20]
	IFIW	ASC11		;[C20]
	IFIW	ASC12		;[C20]
	IFIW	ASC13		;[C20]
	IFIW	ASC14		;[C20]

ASC2:	IFIW	ASC20		;[C20]
	IFIW	ASC21		;[C20]
	IFIW	ASC22		;[C20]
	IFIW	ASC23		;[C20]

ASC3:	IFIW	ASC30		;[C20]
	IFIW	ASC31		;[C20]
	IFIW	ASC32		;[C20]

ASC4:	IFIW	ASC40		;[C20]
	IFIW	ASC41		;[C20]

;ASCII MASKS
	SEGMENT	LPURE			;[C20]
	.HWFRMT
;MSKA10==BYTE	(7)	177,000,000,000,000
MSKA11==BYTE	(7)	000,177,000,000,000
MSKA12:	BYTE	(7)	000,000,177,000,000
MSKA13==BYTE	(7)	000,000,000,177,000
MSKA14==BYTE	(7)	000,000,000,000,177
;MSKA20==BYTE	(7)	177,177,000,000,000
MSKA21:	BYTE	(7)	000,177,177,000,000
MSKA22:	BYTE	(7)	000,000,177,177,000
MSKA23==BYTE	(7)	000,000,000,177,177
;MSKA30:	BYTE	(7)	177,177,177,000,000
MSKA31:	BYTE	(7)	000,177,177,177,000
MSKA32:	BYTE	(7)	000,000,177,177,177
;MSKA40:	BYTE	(7)	177,177,177,177,000
MSKA41:	BYTE	(7)	000,177,177,177,177
;MSKA50:	BYTE	(7)	177,177,177,177,177
	.MFRMT
	SEGMENT	HPURE			;[C20]
;	ASCII 	-- LENGTH 1 BYTE

ASC10:	$HLRZ$			;BYTE 0
	$LSH$	-^D11
	$JCAM$			;[C20]

ASC11:	$HLRZ$			;BYTE 1
	$ANDI$	MSKA11
	$JCAM$			;[C20]

ASC12:	$MOVE$			;BYTE 2
	$AND$	MSKA12
	$JCAM$

ASC13:	$HRRZ$			;BYTE 3
	$ANDI$	MSKA13
	$JCAM$			;[C20]

ASC14:	CAIG	P3,1+4		;TEST FOR SPECIAL END CSASES
	JRST	@[IFIWS <.+1,ASC1X0,ASC1X1,ASC1X2,ASC1X3>]-1(P3)	;[C20]
	$HRRZ$			;BYTE 4
	$ANDI$	MSKA14
	$JCAM$			;[C20]

ASC1X0:	ADDI	P2,1
	$HRLZ$
	$HLRN$
	$TLZ$	1777B9+1B17
	$LSH$	-^D11
	$JCAM$			;[C20]

ASC1X1:	ADDI	P2,2
	$HRLZ$
	$HLRN$
	$TLZ$	1777B9+1B17
	$LSH$	-4
	$JCAM$

ASC1X2:	ADDI	P2,3
	$DMOV$
	$ANDI$	MSKA14
	$LSHC$	3*7
	$JCAM$

ASC1X3:	ADDI	P2,4
	$DMOV$
	$ANDI$	MSKA14
	$LSH$	-1
	$LSHC$	4*7
	$JCAM$
;	ASCII	-- 2 BYTES

ASC20:	$HLRZ$			;BYTES 0-1
	$LSH$	-4
	$JCAM$			;[C20]

ASC21:	$MOVE$			;BYTES 1-2
	$AND$	MSKA21
	$JCAM$

ASC22:	$MOVE$			;BYTES 2-3
	$AND$	MSKA22
	$JCAM$

ASC23:	CAIG	P3,2+3		;TEST FOR SPECIAL END CASES
	JRST	@[IFIWS <.+1,ASC2X0,ASC2X1,ASC2X2>]-2(P3)	;[C20]
	$HRRZ$			;BYTES 3-4
	$ANDI$	MSKA23
	$JCAM$			;[C20]

ASC2X0:	ADDI	P2,1
	$HRLZ$
	$HLRN$
	$TLZ$	7B2+1B17
	$LSH$	-^D11
	$JCAM$

ASC2X1:	ADDI	P2,2
	$HRLZ$
	$HLRN$
	$TLZ$	7B2+1B17
	$LSH$	-4
	$JCAM$

ASC2X2:	ADDI	P2,3
	$DMOV$
	$LSH$	-1
	$LSHC$	3*7
	$TLZ$	1B0
	$JCAM$
;	ASCII	-- 3 BYTES

ASC30:	$MOVE$			;BYTES 0-2
	$LSH$	-^D15
	$JCAM$

ASC31:	$MOVE$			;BYTES 1-3
	$AND$	MSKA31
	$JCAM$

ASC32:	CAIG	P3,3+2		;TEST FOR SPECIAL END CASES
	JRST	@[IFIWS <.+1,ASC3X0,ASC3X1>]-3(P3)	;[C20]
	$MOVE$			;BYTES 2-4
	$AND$	MSKA32
	$JCAM$

ASC3X0:	ADDI	P2,1
	$DMOV$
	$AND$	MSKA32
	$LSHC$	7
	$JCAM$

ASC3X1:	ADDI	P2,2
	$DMOV$
	$LSH$	-1
	$LSHC$	2*7
	$TLZ$	1B0
	$JCAM$
;	ASCII	-- 4 BYTES

ASC40:	$MOVE$			;BYTES 0-3
	$LSH$	-8
	$JCAM$

ASC41:	CAIN	P3,4+1		;TEST FOR SPECIAL END CASE
	JRST	ASC4X0		;4 BYTES + 1 BYTE
	$MOVE$			;BYTES 1-4
	$AND$	MSKA41
	$JCAM$

ASC4X0:	ADDI	P2,1
	$DMOV$
	$LSH$	-1
	$LSHC$	7
	$TLZ$	1B0
	$JCAM$


;	ASCII	-- LENGTH 5 BYTES

ASC50:	$MOVE$
	$LSH$	-1
	$JCAM$
SUBTTL	GENERATE CODE -- Computational Signed/Unsigned SIXBIT

IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,CSSGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	MOVEI	P2,6(P1)	;[OK] ASSUME SINGLE PRECISION
	CAILE	P3,^D10		;IS IT?
	ADDI	P2,6		;NO, SIX MORE BYTES
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
	CAMLE	P2,MINKEY	;BIGGEST MINIMUM SIZE YET?
	MOVEM	P2,MINKEY	;YES
	IDIVI	P1,6		;P1 -- WORD DISP; P2 -- BYTE DISP
	JUMPN	P2,E$$CWB	;MUST START ON WORD BOUNDARY
	ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
	CAILE	P3,^D10		;SINGLE PRECISION?
	$DCAM$			;NO, DOUBLE PRECISION
	$SCAM$			;YES
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,CUSGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	MOVEI	P2,6(P1)	;[OK] ASSUME SINGLE PRECISION
	CAILE	P3,^D10		;IS IT?
	ADDI	P2,6		;NO, SIX MORE BYTES
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
	CAMLE	P2,MINKEY	;BIGGEST MINIMUM SIZE YET?
	MOVEM	P2,MINKEY	;YES
	IDIVI	P1,6		;P1 -- WORD DISP; P2 -- BYTE DISP
	JUMPN	P2,E$$CWB	;MUST START ON WORD BOUNDARY
	ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
	CAILE	P3,^D10		;SINGLE PRECISION?
	$DCAMM$			;NO, DOUBLE PRECISION
	$MOVM$			;YES
	$JCAM$
ENDB;
>;END IFE FTFORTRAN
SUBTTL	GENERATE CODE -- Computational Signed/Unsigned ASCII

BEGIN
  PROCEDURE	(PUSHJ	P,CSAGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	MOVEI	P2,5(P1)	;[OK] ASSUME SINGLE PRECISION
	CAILE	P3,^D10		;IS IT?
	ADDI	P2,5		;NO, FIVE MORE BYTES
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
	CAMLE	P2,MINKEY	;BIGGEST MINIMUM SIZE YET?
	MOVEM	P2,MINKEY	;YES
	IDIVI	P1,5		;P1 -- WORD DISP; P2 -- BYTE DISP
	JUMPN	P2,E$$CWB	;MUST START ON WORD BOUNDARY
	ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
	CAILE	P3,^D10		;SINGLE PRECISION?
	$DCAM$			;NO, DOUBLE PRECISION
	$SCAM$			;YES
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,CUAGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	MOVEI	P2,5(P1)	;[OK] ASSUME SINGLE PRECISION
	CAILE	P3,^D10		;IS IT?
	ADDI	P2,5		;NO, FIVE MORE BYTES
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
	CAMLE	P2,MINKEY	;BIGGEST MINIMUM SIZE YET?
	MOVEM	P2,MINKEY	;YES
	IDIVI	P1,5		;P1 -- WORD DISP; P2 -- BYTE DISP
	JUMPN	P2,E$$CWB	;MUST START ON WORD BOUNDARY
	ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
	CAILE	P3,^D10		;SINGLE PRECISION?
	$DCAMM$			;NO, DOUBLE PRECISION
	$MOVM$			;YES
	$JCAM$
ENDB;
SUBTTL	GENERATE CODE -- Computational Signed/Unsigned EBCDIC

IFE FTFORTRAN,<

BEGIN
  PROCEDURE	(PUSHJ	P,CSEGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
	MOVE	P3,P2		;[C220] COPY LENGTH OF KEY
	MOVEI	P2,4(P1)	;[OK] ASSUME SINGLE PRECISION
	CAILE	P3,^D10		;IS IT?
	ADDI	P2,4		;NO, FOUR MORE BYTES
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
	CAMLE	P2,MINKEY	;BIGGEST MINIMUM SIZE YET?
	MOVEM	P2,MINKEY	;YES
	IDIVI	P1,4		;P1 -- WORD DISP; P2 -- BYTE DISP
	JUMPN	P2,E$$CWB	;MUST START ON WORD BOUNDARY
	ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
	CAILE	P3,^D10		;SINGLE PRECISION?
	$DCAM$			;NO, DOUBLE PRECISION
	$SCAM$			;YES
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,CUEGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES
	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	MOVEI	P2,4(P1)	;[OK] ASSUME SINGLE PRECISION
	CAILE	P3,^D10		;IS IT?
	ADDI	P2,4		;NO, FOUR MORE BYTES
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
	CAMLE	P2,MINKEY	;BIGGEST MINIMUM SIZE YET?
	MOVEM	P2,MINKEY	;YES
	IDIVI	P1,4		;P1 -- WORD DISP; P2 -- BYTE DISP
	JUMPN	P2,E$$CWB	;MUST START ON WORD BOUNDARY
	ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
	CAILE	P3,^D10		;SINGLE PRECISION?
	$DCAMM$			;NO, DOUBLE PRECISION
	$MOVM$			;YES
	$JCAM$
ENDB;
SUBTTL	GENERATE CODE -- Alphanumeric Logical EBCDIC

;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(PUSHJ	P,ALEGEN)
;	P1 HAS FIRST COLUMN OF KEY (0-ORIGIN)
;	P2 HAS LENGTH OF KEY IN BYTES

	MOVE	P3,P2		;[C20] COPY LENGTH OF KEY
	ADD	P2,P1		;[C20] GET MAX. BYTE IN KEY
	CAMLE	P2,MAXKEY	;BIGGEST YET?
	MOVEM	P2,MAXKEY	;YES
  IF KEY IS A REASONABLE SIZE
	CAILE	P3,MAXXSZ	;[N16] IF KEY IS TOO BIG
	JRST	$F		;[N16] USE EXTEND OR SOJG LOOP
  THEN TRY TO GENERATE OPTIMAL CODE
	PUSH	P,U
  WHILE KEY NOT DONE
	BEGIN
		PUSH	P,P1		;SAVE BYTE DISPLACEMENT
		IDIVI	P1,4		;P1 -- WORD DISP:P2 -- BYTE DISP
		ADDI	P1,RC.KEY	;SKIP SIXBIT HEADER
		MOVE	P4,P2		;[C20] COPY BYTE DISPLACEMENT WITHIN WORD
		SUBI	P2,4
		MOVN	P2,P2		;4 - BYTE DISPLACEMENT
		CAMLE	P2,P3		;[C20]
		MOVE	P2,P3		;[C20] MIN (LENGTH, BYTES IN THIS WORD)
		PUSHJ	P,@ALEDSP-1(P2)	;[OK] DISPATCH
		POP	P,P1		;RESTORE BYTE DISPLACENT
		ADD	P1,P2		;[C20] ADVANCE BYTE POSITION
		SUB	P3,P2		;[C20] ACCOUNT FOR BYTES JUST HANDLED
		JUMPN	P3,$B		;FINISHED WITH THIS KEY?
	ENDB;
	POP	P,T1
	MOVE	T2,CPU
	CAIL	T2,KL.CPU	;IF NOT A KL10  OR 
	CAIG	U,16(T1)	;[OK] LONGER THAN EXTEND CODE WOULD BE?
	RETURN			;NO
	MOVE	U,T1		;[OK] RESTORE U
  FI;
	MOVE	T1,KY.SIZ(R)		;[145] GET BACK ORIGIN
	IDIVI	T1,4			;[145] BYTES INTO FIRST WORD OF KEY
	MOVE	P1,KY.INI(R)		;[145] GET BYTE LENGTH OF KEY
	IDIVI	P1,4			;[145] 'WORDS' IN P1, 'BYTES LEFT' IN P2
	LDB	T1,ALETB1(T2)		;[OK] [145] GET INDEX FOR LATER
	IDIV	P2,[EXP 1,2,4](T1)	;[OK] [145] GET BYTE BOUNDARY NUMBER
	ADD	P1,@[IFIW EBBTBL(P2)		;[OK] [145] 9  BIT BYTES
		     IFIW B18TBL(P2)		;[OK] [145] 18 BIT BYTES
		     IFIW [POINT 36,1(R)]](T1);[OK] [145] 36 BIT BYTES
	MOVE	P3,KY.SIZ(R)		;[145] GET BYTE LEN OF KEY BACK
	IDIV	P3,[EXP 1,2,4](T1)	;[C20]
	$KCAM$
ENDB;
SUBTTL	GENERATE CODE -- Alphanumeric Logical EBCDIC -- Dispatch Tables

;STILL IN IFE FTFORTRAN

ALEDSP:	IFIW	@EBC1(P4)		;[C20] SINGLE BYTE
	IFIW	@EBC2(P4)		;[C20] TWO BYTES
	IFIW	@EBC3(P4)		;[C20] THREE BYTES
	IFIW	 EBC40			;[C20] FOUR BYTES

ALETB1:	POINT	9,ALETB2(P2),8		;[OK]
	POINT	9,ALETB2(P2),17		;[OK]
	POINT	9,ALETB2(P2),26		;[OK]
	POINT	9,ALETB2(P2),35		;[OK]

ALETB2:	BYTE	(9) 2,0,1,0
	BYTE	(9) 0,0,0,0
	BYTE	(9) 1,0,1,0
	BYTE	(9) 0,0,0,0

EBC1:	IFIW	EBC10			;[C20]
	IFIW	EBC11			;[C20]
	IFIW	EBC12			;[C20]
	IFIW	EBC13			;[C20]

EBC2:	IFIW	EBC20			;[C20]
	IFIW	EBC21			;[C20]
	IFIW	EBC22			;[C20]

EBC3:	IFIW	EBC30			;[C20]
	IFIW	EBC31			;[C20]

	SEGMENT	LPURE			;[C20] [303]
	.HWFRMT
;MSKE10==BYTE	(9)	377,000,000,000
;MSKE11==BYTE	(9)	000,377,000,000
MSKE12==BYTE	(9)	000,000,377,000
MSKE13==BYTE	(9)	000,000,000,377
;MSKE20==BYTE	(9)	377,377,000,000
MSKE21:	BYTE	(9)	000,377,377,000	;[303]
;MSKE22==BYTE	(9)	000,000,377,377
;MSKE30:BYTE	(9)	377,377,377,000
;MSKE31:BYTE	(9)	000,377,377,377
;MSKE40:BYTE	(9)	377,377,377,377
	.MFRMT
	SEGMENT	HPURE			;[C20] [303]
;	CODE GENERATION FOR COMPARISON OF EBCDIC KEYS

;STILL IN IFE FTFORTRAN

;	EBCDIC  --  LENGTH 1 BYTE

EBC10:	$HLRZ$			;BYTE 0
	FASTSKIP
EBC12:	$HRRZ$			;BYTE 2
	$ANDI$	MSKE12
	$JCAM$			;[C20]

EBC11:	$HLRZ$			;BYTE 1
	$ANDI$	MSKE13
	$JCAM$			;[C20]

EBC13:	CAIG	P3,1+3		;TEST FOR SPECIAL END CASES
	JRST	@[IFIWS <.+1,EBC1X0,EBC1X1,EBC1X2>]-1(P3)	;[C20]
	$HRRZ$			;BYTE 3
	$ANDI$	MSKE13
	$JCAM$			;[C20]

EBC1X0:	ADDI	P2,1		;ONE MORE BYTE
	$HRLZ$			;GET BYTE 3 OF FIRST WORD
	$HLRN$			;GET BYTE 0 OF NEXT WORD
	$AND$	MSKE21		;[403] CLEAR BYTES 0 AND 3
	$JCAM$			;[403] COMPARE FULL WORDS

EBC1X1:	ADDI	P2,2		;2 MORE BYTES
	$HRLZ$
	$HLRN$	
	$TLZ$	777400
	$JCAM$

EBC1X2:	ADDI	P2,3		;3 MORE BYTES
	$DMOV$
	$LSHC$	^D27		;[403] SHIFT PIECES INTO FIRST WORD
	$JCAM$
;	EBCDIC  --  LENGTH 2 BYTES

;STILL IN IFE FTFORTRAN

EBC20:	$HLRZ$			;BYTES 0-1
	$JCAM$			;[C20]

EBC21:	$MOVE$			;BYTES 1-2
	$AND$	MSKE21		;[303] MAKE SURE BYTES 0 AND 3 ARE ZERO
	$JCAM$			;[303]   ..

EBC22:	CAIGE	P3,2+2		;TEST FOR SPECIAL END CASES
	JRST	@[IFIWS <.+1,EBC2X0,EBC2X1>]-2(P3)	;[C20] DO THEM
	$HRRZ$			;BYTES 2-3
	$JCAM$			;[C20]

EBC2X0:	ADDI	P2,1
	$HRLZ$
	$HLRN$
	$TRZ$	400777
	$JCAM$

EBC2X1:	ADDI	P2,2
	$HRLZ$
	$HLRN$
	$JCAM$
;	EBCDIC  --  LENGTH 3 BYTES

;STILL IN IFE FTFORTRAN

EBC30:	$MOVE$			;BYTES 0-2
	$TRZ$	400777
	$JCAM$

EBC31:	CAIGE	P3,3+1		;TEST FOR SPECIAL END CASE
	JRST	@[IFIWS <.+1,EBC3X0>]-3(P3)	;[C20] YES
	$MOVE$			;BYTES 1-3
	$TLZ$	777400
	$JCAM$

EBC3X0:	ADDI	P2,1
	$DMOV$
	$LSHC$	9
	$JCAM$

;	EBCDIC	--  LENGTH 4 BYTES

EBC40:	$SCAM$

	$JCAM$


>;END IFE FTFORTRAN
SUBTTL	GENERATE CODE -- Computational Signed/Unsigned Binary

BEGIN
  PROCEDURE	(PUSHJ	P,NSBGEN)
;	P1 HAS FIRST WORD OF KEY (0 ORIGIN)
;	P2 HAS LENGTH OF KEY IN WORDS
	CAILE	P2,2		; MAKE SURE LEGAL
	JRST	E$$TMD		; NOT
	MOVE	P3,P2		;[C20]  SAVE P2
	ADD	P2,P1		;[C20]  P1+P2=KEY LOC
	CAMLE	P2,MAXKEY
	MOVEM	P2,MAXKEY
	ADDI	P1,RC.KEY	; SKIP HEADER WORD
	CAIE	P3,1		; SINGLE PRECISION?
	$DCAM$			; NO
	$SCAM$			; YES
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,NUBGEN)
;	P1 HAS FIRST WORD OF KEY (0 ORIGIN)
;	P2 HAS LENGTH OF KEY IN WORDS
	CAILE	P2,2		; MAKE SURE LEGAL
	JRST	E$$TMD		; NOT
	MOVE	P3,P2		;[C20]  SAVE P2
	ADD	P2,P1		;[C20]  P1+P2=KEY LOC
	CAMLE	P2,MAXKEY
	MOVEM	P2,MAXKEY
	ADDI	P1,RC.KEY	; SKIP HEADER WORD
	CAIE	P3,1		; SINGLE PRECISION?
	$DCAMM$			; NO
	$MOVM$			; YES
	$JCAM$
ENDB;
BEGIN				;[330]
  PROCEDURE	(PUSHJ  P,CSBGEN);[330]
;	P1 HAS THE 1ST WORD OF KEY (0 ORIG)	 [330]
;	P2 HAS LENGTH OF KEY IN PRINTING CHARS   [330]
	CAILE	P2,^D18		;[330] LESS THAN 2 COMP WORDS?
	JRST	E$$TMD		;[330] NOT LEGAL
	MOVE	P3,P2		;[C20] [330] SAVE P2.  P3 UNTOUCHED
	MOVEI	P2,1(P1)	;[OK] [330] ASSUME SINGLE. SET UP BYTE
	CAILE	P3,^D10		;[330] SINGLE?
	ADDI	P2,1		;[330] NO. ADD ANOTHER BYTE
	CAMLE	P2,MAXKEY	;[330]
	MOVEM	P2,MAXKEY	;[330]
	ADDI	P1,RC.KEY	;[330] SKIP HEADER
	CAILE	P3,^D10		;[330] SINGLE PREC?
	$DCAM$			;[330] NO
	$SCAM$			;[330] YES
ENDB;


BEGIN				;[330]
  PROCEDURE	(PUSHJ   P,CUBGEN);[330]	
;	P1 HAS THE 1ST WORD OF KEY (0 ORIG)    [330]
;	P2 HAS LENGTH OF KEY IN PRINTING CHARS [330]
	CAILE	P2,^D18		;[330] LESS THAN 2 COMP WORDS?
	JRST	E$$TMD		;[330] NOT LEGAL
	MOVE	P3,P2		;[C20] [330] SAVE P2.  P3 UNTOUCHED
	MOVEI	P2,1(P1)	;[OK] [330] ASSUME SINGLE. SET UP BYTE
	CAILE	P3,^D10		;[330] SINGLE?
	ADDI	P2,1		;[330] NO. ANOTHER BYTE
	CAMLE	P2,MAXKEY	;[330]
	MOVEM	P2,MAXKEY	;[330]
	ADDI	P1,RC.KEY	;[330] SKIP HEADER
	CAILE	P3,^D10		;[330] SINGLE PREC?
	$DCAM$			;[330] NO
	$MOVM$			;[330] 
	$JCAM$			;[330] 
ENDB;
SUBTTL	CODE GENERATION -- All Converted Numeric Keys

BEGIN
  PROCEDURE	(PUSHJ	P,CNVGEN)
	MOVE	T1,P2		;SAVE KEY LENGTH OVER IDIV
	IDIV	P1,BPWORD	;[146] GET WORD COUNT OF CONVERTED KEYS
	ADDI	P1,RC.KEY	;BYPASS HEADER WORD
	CAIG	T1,^D10
	$SCAM$			;SINGLE PRECISION
	$DCAM$			;DOUBLE PRECISION
ENDB;
SUBTTL	CODE GENERATION MACRO SUPPORT ROUTINES

BEGIN
  PROCEDURE	(PUSHJ	P,%HLRZ%)
	;GENERATES
	;HLRZ	T1,N(R)
	;HLRZ	T3,N(J)

	;N IS IN P1 ON ENTRY

	HRR	T1,P1			;[C20]
	HRLI	T1,(HLRZ T1,(R))
	MOVEM	T1,(U)
	HRLI	T1,(HLRZ T3,(J))
	OPDEF %RETURN% [JRST	.]
	MOVEM	T1,1(U)
	ADDI	U,2
	RETURN
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%HRLZ%)
	;GENERATES
	;HRLZ	T1,N(R)
	;HRLZ	T3,N(J)

	;N IS IN P1 ON ENTRY

	HRR	T1,P1			;[C20]
	HRLI	T1,(HRLZ T1,(R))
	MOVEM	T1,(U)
	HRLI	T1,(HRLZ T3,(J))
	%RETURN%
ENDB;


BEGIN
  PROCEDURE	(PUSHJ	P,%HLRN%)
	;GENERATES
	;HLR	T1,N+1(R)
	;HLR	T3,N+1(J)

	;N IS IN P1 ON ENTRY

	HRRI	T1,1(P1)		;[C20]
	HRLI	T1,(HLR T1,(R))
	MOVEM	T1,(U)
	HRLI	T1,(HLR T3,(J))
	%RETURN%
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,%HRRZ%)
	;GENERATES
	;HRRZ	T1,N(R)
	;HRRZ	T3,N(J)

	;N IS IN P1 ON ENTRY

	HRR	T1,P1			;[C20]
	HRLI	T1,(HRRZ T1,(R))
	MOVEM	T1,(U)
	HRLI	T1,(HRRZ T3,(J))
	%RETURN%
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,%MOVE%)
	;GENERATES
	;MOVE	T1,N(R)
	;MOVE	T3,N(J)

	;ON ENTRY, N IS IN AC P1

	HRR	T1,P1			;[C20]
	HRLI	T1,(MOVE T1,(R))
	MOVEM	T1,(U)
	HRLI	T1,(MOVE T3,(J))
	%RETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%CAM%)
	;GENERATES
	;CAMGE	T1,T3
	;JRST	<LOW (ASC) > <HIGH (DESC) > (P4)
	;CAME	T1,T3
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)

	MOVE	T1,[CAMGE T1,T3]
	MOVEM	T1,(U)
	HRLI	T1,(CAME T1,0)
	OPDEF	%CARETURN%	[JRST	.]	;[C20]
	MOVEM	T1,2(U)			;[C20]
	MOVE	T1,[JRST 1(P4)]		;[C20]
	MOVEM	T1,1(U)			;[C20]
	MOVEM	T1,3(U)			;[C20]
	SKIPL	KY.ORD(R)		;[C20]
	AOSA	1(U)			;[C20] ASCENDING -- CHANGE HIGH TO LOW
	AOS	3(U)			;[C20] DESCENDING -- CHANGE HIGH TO LOW
	ADDI	U,4			;[C20]
	RETURN				;[C20]
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%CAMN%)
	;GENERATES
	;CAMGE	T2,T4
	;JRST	<LOW (ASC) > <HIGH (DESC) > (P4)
	;CAME	T2,T4
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)

	MOVE	T1,[CAMGE T2,T4]
	MOVEM	T1,(U)
	HRLI	T1,(CAME T2,0)
	%CARETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%ANDI%)
	;GENERATES
	;ANDI	T1,MASK
	;ANDI	T3,MASK

	;MASK IS IN RIGHT HALF OF T1 ON ENTRY

	HRLI	T1,(ANDI T1,0)
	MOVEM	T1,(U)
	HRLI	T1,(ANDI T3,0)
	%RETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%AND%)
	;GENERATES
	;AND T1,MSKADR
	;AND T3,MSKADR

	;ON ENTRY, MSKADR IS IN T1

	HRLI	T1,(AND T1,0)
	MOVEM	T1,(U)
	HRLI	T1,(AND T3,0)
	%RETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%LSH%)
	;GENERATES
	;LSH	T1,N
	;LSH	T3,N

	;ON ENTRY, N IS IN AC T1

	HRLI	T1,(LSH T1,0)
	MOVEM	T1,(U)
	HRLI	T1,(LSH T3,0)
	%RETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%LSHN%)
	;GENERATES
	;LSH	T2,N
	;LSH	T4,N

	;ON ENTRY, N IS IN AC T1

	HRLI	T1,(LSH T2,0)
	MOVEM	T1,(U)
	HRLI	T1,(LSH T4,0)
	%RETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%TLZ%)
	;GENERATES
	;TLZ	T1,MSK
	;TLZ	T3,MSK

	;ON ENTRY, T1 HAS MASK

	HRLI	T1,(TLZ T1,0)
	MOVEM	T1,(U)
	HRLI	T1,(TLZ T3,0)
	%RETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%TRZ%)
	;GENERATES
	;TRZ	T1,MSK
	;TRZ	T3,MSK

	;ON ENTRY, T1 HAS MASK

	HRLI	T1,(TRZ T1,0)
	MOVEM	T1,(U)
	HRLI	T1,(TRZ T3,0)
	%RETURN%
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%JRST%)
	;GENERATES
	;JRST	(P4)

	HRLZI	T1,(JRST (P4))
	MOVEM	T1,(U)
	AOJA	U,CPOPJ
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%MOVM%)
	;GENERATES
	;MOVM	T1,N(R)
	;MOVM	T3,N(J)

	;ON ENTRY, N IS IN AC P1

	HRR	T1,P1			;[C20]
	HRLI	T1,(MOVM T1,(R))
	MOVEM	T1,(U)
	HRLI	T1,(MOVM T3,(J))
	%RETURN%
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,%SCAM%)
	;GENERATES
	;MOVE	T1,N(R)
	;CAMGE	T1,N(J))
	;JRST	<LOW (ASC) > <HIGH (DESC)> (P4)
	;CAME	T1,N(J)
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)

	MOVSI	T1,(MOVE T1,(R))
	HRR	T1,P1			;[C20]
	MOVEM	T1,(U)
	HRLI	T1,(CAMGE T1,(J))
	MOVEM	T1,1(U)
	HRLI	T1,(CAME T1,(J))
	MOVEM	T1,3(U)
	MOVE	T1,[JRST 1(P4)]
	MOVEM	T1,2(U)
	MOVEM	T1,4(U)
	SKIPL	KY.ORD(R)	;[C20]
	AOSA	2(U)		;ASCENDING -- CHANGE HIGH TO LOW
	AOS	4(U)		;DESCENDING -- CHANGE HIGH YO LOW
	ADDI	U,5
	RETURN
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,%DCAM%)
	;KI10 GENERATES
	;DMOVE	T1,N(R)
	;CAMGE	T1,N(J))
	;JRST	<LOW (ASC) > <HIGH (DESC)> (P4)
	;CAME	T1,N(J)
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)
	;CAMGE	T2,N+1(J)
	;JRST	<LOW (ASC) > <HIGH (DESC)> (P4)
	;CAME	T2,N+1(J)
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)

	PUSH	P,P2		;[C20] SAVE P2 FOR TEMP USE
	MOVEI	P2,2		;[C20] SOJG COUNT TO LOOP TWICE
	HRLZI	T1,(DMOVE T1,(R))
	SKIPG	CPU		;HOWEVER IF ON KA10
	HRLZI	T1,(MOVE T1,(R))
	HRR	T1,P1		;[C20]
	MOVEM	T1,(U)
	HRLI	T1,(CAMGE T1,(J))
	MOVEM	T1,1(U)
	HRLI	T1,(CAME T1,(J))
  $1%	MOVEM	T1,3(U)
	MOVE	T1,[JRST 1(P4)]
	MOVEM	T1,2(U)
	MOVEM	T1,4(U)
	SKIPL	KY.ORD(R)	;[C20]
	AOSA	2(U)		;ASCENDING -- CHANGE HIGH TO LOW
	AOS	4(U)		;DESCENDING -- CHANGE HIGH TO LOW
	ADDI	U,5		;[C20]
	SOJLE	P2,$3		;[N23] [C20] DONE WITH BOTH WORDS
	HRRZI	T1,1(P1)	;[OK]
	SKIPE	CPU		;MORE IF KA10
	SOJA	U,$2		;NO, KI10 OR KL10
	HRLI	T1,(MOVE T2,(R))
	MOVEM	T1,0(U)		;[133] STORE MOVE CORRECTLY ON KA10
  $2%	HRLI	T1,(CAMGE T2,(J))
	MOVEM	T1,1(U)
	HRLI	T1,(CAME T2,(J))
	JRST	$1		;NOW FOR LOW WORD COMPARES

  $3%	POP	P,P2		;[C20] RESTORE P2
	RETURN			;[C20]
ENDB;
REPEAT 0,<
	;KL10 GENERATES
	;DMOVE	T1,N(R)
	;DSUB	T1,N(J))
	;JUMPE	T1,.+3
	;JUMPL	T1,<LOW (ASC) > <HIGH (DESC)> (P4)
	;JUMPG	T1,<HIGH (ASC) > <LOW (DESC) > (P4)
	;JUMPL	T2,<LOW (ASC > <HIGH (DESC)> (P4)
	;JUMPG	T2,<HIGH (ASC) > <LOW (DESC) > (P4)

	MOVSI	T1,(DMOVE T1,(R))
	MOVSI	T2,(DSUB T1,(J))
	HRR	T1,P1			;[C20]
	HRR	T2,P1			;[C20]
	DMOVEM	T1,0(U)
	MOVSI	T1,(JUMPE T1,)
	HRRI	T1,5(U)
	MOVEM	T1,2(U)
	MOVSI	T1,[JUMPL T1,1(P4)
		JUMPG	T1,1(P4)
		JUMPL	T2,1(P4)
		JUMPG	T2,1(P4)]
	HRRI	T1,3(U)
	BLT	T1,6(U)
	SKIPL	KY.ORD(R)	;[C20]
	AOSA	3(U)		;ASCENDING -- CHANGE HIGH TO LOW
	AOSA	4(U)		;DESCENDING -- CHANGE LOW TO HIGH
	AOSA	5(U)
	AOS	5(U)
	ADDI	U,7
	RETURN
>
BEGIN
  PROCEDURE	(PUSHJ	P,%DCAMM%)
	;GENERATES
	;DMOVE	T1,N(R)
	;SKIPGE	T1
	;DMOVN	T1,T1
	;DMOVE	T3,N(J)
	;SKIPGE	T3
	;DMOVN	T3,T3
	;CAMGE	T1,T3
	;JRST	<LOW (ASC) > <HIGH (DESC)> (P4)
	;CAME	T1,T3
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)
	;CAMGE	T2,T4
	;JRST	<LOW (ASC) > <HIGH (DESC)> (P4)
	;CAME	T2,T4
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)

	PUSH	P,P2		;[C20] SAVE P2 FOR TEMP USE
	MOVEI	P2,2		;[C20] SOJG COUNT TO LOOP TWICE
	HRRZ	T1,P1		;[C20]
  IF	KI10 OR KL10
	SKIPG	CPU		;KI10 OR KA10?
	AOJA	T1,$T		;KA10
  THEN
	HRLI	T1,(DMOVE T1,(R))
	MOVEM	T1,(U)
	HRLI	T1,(DMOVE T3,(R))
	MOVEM	T1,3(U)
IFN FTKI10,<
	DMOVE	T1,[SKIPGE T1
		DMOVN	T1,T1]
>
IFE FTKI10,<
	MOVE	T1,[SKIPGE T1]
	MOVE	T2,[DMOVN T1,T1]
>
	DMOVEM	T1,1(U)
	ADDI	T1,2		;SKIPGE T3
	MOVE	T2,[DMOVN T3,T3]
	JRST	$F
  ELSE	KA10
	HRLI	T1,(MOVE T2,(R))
	MOVEM	T1,(U)
	HRLI	T1,(MOVE T4,(R))
	MOVEM	T1,3(U)
	SUBI	T1,1
	HRLI	T1,(SKIPGE T1,)
	MOVE	T2,[DFN	T1,T2]
	DMOVEM	T1,1(U)
	HRLI	T1,(SKIPGE T3,)
	MOVE	T2,[DFN	T3,T4]
  FI;
	DMOVEM	T1,4(U)
	MOVE	T1,[CAMGE T1,T3]
	MOVEM	T1,6(U)
	HRLI	T1,(CAME T1,)
	ADDI	U,5
  $1%	MOVEM	T1,3(U)
	MOVE	T1,[JRST 1(P4)]
	MOVEM	T1,2(U)
	MOVEM	T1,4(U)
	SKIPL	KY.ORD(R)	;[C20]
	AOSA	2(U)		;ASCENDING -- CHANGE HIGH TO LOW
	AOS	4(U)		;DESCENDING -- CHANGE HIGH YO LOW
	ADDI	U,4		;[C20]
	SOJG	P2,$2		;[C20] DONE WITH BOTH WORDS
	MOVE	T1,[CAMGE T2,T4]
	MOVEM	T1,1(U)
	HRLI	T1,(CAME T2,)
	JRST	$1		;NOW FOR LOW WORD COMPARES

  $2%	POP	P,P2		;[C20] RESTORE P2
	AOJA    U,CPOPJ		;[C20] [307] LEAVE PTR AT FREE LOC
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,%DMOV%)
	;DMOVE	T1,N(R)
	;DMOVE	T3,N(J)

	;ON ENTRY, N IS IN AC P1

	HRR	T1,P1		;[C20]
	HRLI	T1,(DMOVE T1,(R))
	SKIPE	CPU		;BUT IF ONLY A KA10
	JRST	$1		;A KI10 OR KL10
	HRLI	T1,(MOVE T1,(R))
	MOVEM	T1,(U)
	ADDI	U,1
	ADD	T1,[Z 1,1]
  $1%	MOVEM	T1,(U)
	ADDI	U,1
	HRR	T1,P1		;[C20]
	HRLI	T1,(DMOVE T3,(J))
	SKIPE	CPU		;BUT IF ONLY A KA10
	JRST	$2		;A KI10 OR KL10
	HRLI	T1,(MOVE T3,(J))
	MOVEM	T1,(U)
	ADDI	U,1
	ADD	T1,[Z 1,1]
  $2%	MOVEM	T1,(U)
	AOJA	U,CPOPJ
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,%LSHC%)
	;LSHC	T1,N
	;LSHC	T3,N
	;ON ENTRY, N IS IN AC T1

	HRLI	T1,(LSHC T1,0)
	MOVEM	T1,(U)
	HRLI	T1,(LSHC T3,0)
	%RETURN%
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,%KCAM%)

	;ENTERS WITH	P1 = SOURCE BYTE POINTER
	;		P3 = SOURCE LENGTH

	;GENERATES

  IF KL-10
	MOVE	T1,CPU			;[N16] GET CPU TYPE
	CAIGE	T1,KL.CPU		;[N16] EXTENDS ONLY WORK ON KL
	JRST	$T			;[N16] KA OR KI
  THEN GENERATE EXTEND CODE
	MOVSI T1,[MOVSI	T4,12+k
		BLT	T4,T4
		EXTEND	11+k
		JRST	1(P4)
		LDB	T1,T1
		LDB	T3,T4
		CAME	T1,T3
		JRST	1(P4)
		JRST	17+k
		CMPSGE
		;T0 = SOURCE BYTE COUNT
		;T1 = SOURCE BYTE PTR
		;T2 = 0
		;T3 = DESTINATION BYTE COUNT
		;T4 = DESTINATION BYTE PTR
		]
	HRR	T1,U			;[C20]
	BLT	T1,11(U)		;COPY CODE
	MOVEM	P3,12(U)		;SOURCE LENGTH
	MOVEM	P1,13(U)		;SOURCE BYTE PTR
	SETZM	14(U)
	TLC	P1,R^!J
	MOVEM	P3,15(U)		;DESTINATION LENGTH
	MOVEM	P1,16(U)		;DESTINATION BYTE PTR
	HRRZ	T1,U			;[C20]
	ADDM	T1,0(U)			;[C20]
	ADDM	T1,2(U)			;[C20]
	ADDM	T1,10(U)		;[C20]
	SKIPL	KY.ORD(R)		;[C20]
	AOSA	3(U)			;ASCENDING
	AOS	7(U)			;DESCENDING
	ADDI	U,17			;[126] 
	RETURN

  ELSE USE A SOJG ILDB LOOP
	MOVSI	T1,[MOVEI T0,
		DMOVE	T1,11+k
		ILDB	T3,T1
		ILDB	T4,T2
		CAMN	T3,T4
		JRST	13+k
		CAMG	T3,T4
		JRST	1(P4)
		JRST	1(P4)
		;SOURCE #1 BYTE POINTER
		;SOURCE #2 BYTE POINTER
		;SOJG	T0,2+k
		]
	HRR	T1,U			;[N16]
	BLT	T1,10(U)		;[N16] COPY CODE
	HRRM	P3,0(U)			;[N16] SOURCE LENGTH
	MOVEM	P1,11(U)		;[N16] SOURCE #1 BYTE PTR
	TLC	P1,R^!J
	MOVEM	P1,12(U)		;[N16] SOURCE #2 BYTE PTR
	HRRZ	T1,U			;[N16] REPLACE k BY (U)
	ADDM	T1,1(U)			;[N16]
	ADDM	T1,5(U)			;[N16]
	ADD	T1,[SOJG T0,2]		;[N16] FORM INST
	MOVEM	T1,13(U)		;[N16]
	SKIPL	KY.ORD(R)		;[N16]
	AOSA	7(U)			;[N16] ASCENDING
	AOS	10(U)			;[N16] DESCENDING
	ADDI	U,14			;[N16] 
	RETURN
  FI;
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,%LCAM%)
	;GENERATES
	;MOVE	T1,N(R)
	;CAMN	T1,N(J)
	;JRST	.+7
	;MOVE	T2, N(J)
	;TLC	T1,400000
	;TLC	T2,400000
	;CAMG	T1,T2
	;JRST	<LOW (ASC) > <HIGH (DESC) > (P4)
	;JRST	<HIGH (ASC) > <LOW (DESC) > (P4)

	MOVSI	T1,(MOVE T1,(R))
	HRR	T1,P1			;[C20]
	MOVEM	T1,0(U)
	HRLI	T1,(CAMN T1,(J))
	MOVEM	T1,1(U)
	MOVSI	T1,(JRST )
	HRRI	T1,9(U)			;[322] TO END OF BLOCK   BRF
	MOVEM   T1,2(U)			;[322]	
	MOVSI	T1,(MOVE T2,(J))	;[322]	
	HRR	T1,P1			;[C20] [322]	
	MOVEM	T1,3(U)			;[322]	
	MOVSI	T1,(TLC T1,)		;[322]	
	HRRI	T1,400000		;[322]	
	MOVEM	T1,4(U)			;[322]	
	MOVSI	T1,(TLC T2,)		;[322]	
	HRRI	T1,400000		;[322]	
	MOVEM	T1,5(U)			;[322]	
	MOVE	T1,[CAMG T1,T2]		;[322]	
	MOVEM	T1,6(U)			;[322]	
	MOVE	T1,[JRST 1(P4)]		;[322]	
	MOVEM	T1,7(U)			;[322]	
	MOVEM	T1,8(U)			;[322]	
	SKIPL	KY.ORD(R)		;[C20] [322]	
	AOSA	7(U)			;[322]	
	AOS	8(U)			;[332] [322]	
	ADDI	U,^D9			;[322]  UPDATE U TO END OF CODE
	RETURN
ENDB;
SUBTTL	RUN-TIME ROUTINES AND TABLES

	SEGMENT	LPURE			;[C20]
;CVTDB ROUTINE
;COPIED FROM LIBOL
;REQUIRES TABLES FROM LIBOL (DEBSTB & EASTBL)

; CALLED FROM INLINE CODE AS FOLLOWS:
;	MOVEI	T0,SIZE.OF.INPUT.STRING
;	MOVE	T1,BYTE.PTR.TO.INPUT.STRING
;	MOVE	P1,[XWD FLAGS,BYTE.INDEX]
;	PUSHJ	P,CVTDB.
;

CVTDB.:	HRRZ	P2,P1		;[C20]
	EXTEND	T0,CVDB.T(P2)	;[C20]
	  JRST	CVABRT		;ABORT CHECK
	JUMPL	P1,SIGN1	;JUMP IF SIGNED

NEGIF1:	TXNN	T0,M.FLAG	;IF M FLAG ON..
	POPJ	P,
	JRST	NEGAT1		;NEGATE

SIGN1:	TXNN	P1,LED.SG	;LEADING SIGN?
	POPJ	P,		;NOPE
	TXNE	P1,LED.PL	;LEADING PLUS?
	JRST	NEGIF1		;YES, USE "M" FLAG
	TXNE	T0,M.FLAG	;NEGATE IF M NOT ON
	POPJ	P,
NEGAT1:	TXNE	P1,FL.DP
	JRST	NEG2		;TWO WORD RESULT
	MOVN	T4,T4
	POPJ	P,

NEG2:	DMOVN	T3,T3		;NEGATE 2-WORD RESULT
	TLO	T4,(1B0)	;PUT BACK SIGN BIT
	POPJ	P,
;HERE IF CONVERSION ABORTS

CVABRT:	LDB	T2,T1		;GET OFFENDING CHARACTER
	HRRZ	P2,P1		;[C20]
	LDB	T2,BPTNM(P2)	;[C20] GET NUMBER SYMBOL VALUE
	ANDI	T2,3

	JRST	@SPCTA1(T2)	;[OK] DISPATCH ON CHARACTER TYPE

SPCTA1:	IFIW	CVTDB.		;[C20] NULL - IGNORE
	IFIW	CVPLCK		;[C20] GRAPHIC PLUS
	IFIW	CVMICK		;[C20] GRAPHIC MINUS
	IFIW	CVBKTB		;[C20] TRAILING BLANKS OR TABS

;PLUS
CVPLCK:	TXNE	P1,LED.SG	;ANY LEADING SIGNS SEEN YET?
	JRST	LEDSG2		;YES, DONE
	SKIPN	T3		;NO--ANY DIGITS YET?
	SKIPE	T4
	POPJ	P,		;YES--DONE
	TXO	P1,LED.PL	;REMEMBER LEADING PLUS
	JRST	CVTDB.		;CONTINUE CONVERSION

;MINUS
CVMICK:	TXNE	P1,LED.SG	;ANY LEADING SIGNS SEEN YET?
	JRST	LEDSG2		;YES--DONE
	SKIPN	T3
	SKIPE	T4		;ANY DIGITS YET?
	JRST	TSTSG1		;YES, DONE
	TXO	P1,LED.MI	;REMEMBER LEADING MINUS
	JRST	CVTDB.		;CONTINUE CONVERSION

;BLANK OR TAB
CVBKTB:	TXNN	P1,LED.SG	;ANY LEADING SIGNS?
	JRST	NEGIF1		;NO--GO BY "M" FLAG

TSTSG1:	JUMPL	P1,NEGAT1	;NEGATE IF INPUT IS SIGNED
	POPJ	P,		;ELSE RESULT IS POSITIVE

LEDSG2:	TXNN	P1,LED.MI	;MINUS?
	POPJ	P,		;NO
	JRST	NEGAT1		;YES--NEGATE RESULT

; E0 TABLE FOR EXTEND CNVDB INSTRUCTION

CVDB.T:	CVTDBT	CVDB.6	;SIXBIT
	CVTDBT	CVDB.7	;ASCII
	CVTDBT	CVDB.9	;EBCDIC


;TABLE OF POINTERS INTO NUMERIC CONVERSION TABLES

BPTNM:	POINT 10,SNUM(T2),9	;[OK] SIXBIT
	POINT 10,ANUM(T2),9	;[OK] ASCII
	POINT 10,ENUM(T2),9	;[OK] EBCDIC
;THE DECIMAL TO BINARY CONVERSION TABLES EXTRACTED FROM DEBSTB IN LIBOL
CVDB.7:				;ASCII
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,000017
	600002,,600003
	600004,,600005
	600006,,600007
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
CVDB.6:				;SIXBIT
	000017,,700000
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,500001
	600004,,500002
	600006,,600007
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	700000,,600003
	600004,,600005
	600006,,600000
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	700001,,700002
	700003,,700004
	700005,,700006
	700007,,700010
	700011,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600000
	600004,,700000
	600006,,600007
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	700001,,700002
	700003,,700004
	700005,,700006
	700007,,700010
	700011,,700003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600000
	600004,,700000
	600006,,600007

IFN FTFORTRAN,<CVDB.9==CVDB.7	;KEEPS MACRO HAPPY>
IFE FTFORTRAN,<
CVDB.9:				;EBCDIC
	000014,,600001
	600002,,600003
	600004,,000017
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	000017,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	500001,,600007
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	500002,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	300000,,700001
	700002,,700003
	700004,,700005
	700006,,700007
	700010,,700011
	600002,,600003
	600004,,600005
	600006,,600007
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	700000,,700001
	700002,,700003
	700004,,700005
	700006,,700007
	700010,,700011
	600002,,600003
	600004,,600005
	600006,,600007
	000014,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
	600000,,600001
	600002,,600003
	600004,,600005
	600006,,600007
	600010,,600011
	600002,,600003
	600004,,600005
	600006,,600007
;EXTRACTED FROM EASTBL IN LIBOL

ENUM:				;EBCDIC NUMERIC CONVERSION TABLE
	600000,,000004
	000401,,300000
	001002,,300000
	001403,,300000
	002024,,300000
	601411,,040000
	003016,,300000
	003577,,300000
	004134,,300000
	004534,,300000
	001134,,300000
	001413,,300000
	002014,,300000
	002534,,300000
	003134,,300000
	003534,,300000
	400134,,300000
	000534,,300000
	001134,,300000
	001434,,300000
	002021,,300000
	002615,,300000
	003010,,300000
	003426,,300000
	004134,,300000
	004431,,300000
	001032,,300000
	001534,,300000
	002134,,300000
	002534,,300000
	003134,,300000
	003534,,300000
	400036,,300002
	000435,,300004
	001037,,300004
	001534,,300004
	002020,,300004
	002612,,300004
	003027,,300004
	003433,,300004
	004134,,300004
	004534,,300004
	001030,,300004
	001534,,300004
	002134,,300004
	002405,,300004
	003006,,300004
	003407,,300004
	400134,,300004
	000534,,300004
	001134,,300004
	001534,,300004
	002022,,300004
	002423,,300004
	003017,,300004
	003404,,300004
	004134,,300004
	004534,,300004
	001134,,300004
	001534,,300000
	002134,,300000
	002425,,300000
	003134,,300000
	003534,,300000
	601440,,100201
	000534,,300206
	001134,,300212
	001534,,300216
	002134,,300222
	002534,,300226
	003134,,300232
	003534,,300236
	004134,,300242
	004534,,300246
	001134,,300252
	001456,,300256
	002074,,300262
	002450,,300266
	200453,,240272
	003574,,300276
	400046,,300302
	000534,,300306
	001134,,300312
	001534,,300316
	002134,,300322
	002534,,300326
	003134,,300332
	003534,,300336
	004134,,300342
	004534,,300346
	001041,,300352
	001444,,300354
	002052,,300360
	002451,,300364
	003073,,300370
	003536,,300374
	201055,,240400
	000457,,300406
	001134,,300412
	001534,,300416
	002134,,300422
	002534,,300426
	003134,,300432
	003534,,300436
	004134,,300442
	004534,,300446
	001134,,300452
	001454,,300456
	002045,,300462
	002537,,300466
	003076,,300472
	003477,,300476
	400134,,300502
	000534,,300506
	001134,,300512
	001534,,300516
	002134,,300522
	002534,,300526
	003134,,300532
	003534,,300536
	004134,,300542
	004540,,300546
	001072,,300552
	001443,,300554
	002100,,300560
	002447,,300564
	003075,,300570
	003442,,300574
	000134,,300360
	000541,,314361
	001142,,314361
	001543,,314361
	002144,,314361
	002545,,314001
	003146,,314361
	003547,,314361
	004150,,314361
	004551,,302361
	001134,,314360
	001534,,314360
	002134,,314360
	002534,,314360
	003134,,314360
	003534,,314360
	000134,,314360
	000552,,314361
	001153,,314361
	001554,,314361
	002155,,314361
	002556,,314361
	003157,,314361
	003560,,314361
	004161,,314361
	004562,,314361
	001134,,314360
	001534,,314360
	002134,,314360
	002534,,314360
	003134,,314360
	003534,,314360
	400134,,204360
	000576,,210360
	001163,,214361
	001564,,214361
	002165,,214361
	002566,,214361
	003167,,214361
	003570,,214361
	004171,,214361
	004572,,214361
	001134,,314360
	001534,,312360
	002134,,314360
	002533,,312360
	003134,,314360
	003534,,314360
	700175,,206360
	300534,,206360
	301134,,206360
	301534,,206360
	302134,,206360
	302534,,206360
	303134,,206360
	303534,,206360
	304134,,206360
	304534,,206360
	001134,,310360
	001534,,314360
	002134,,314360
	002535,,314360
	003134,,314360
	003534,,310360
	000173,,214000
	000501,,210361
	001102,,210361
	001503,,210361
	002104,,210361
	002505,,210361
	003106,,210361
	003507,,210361
	004110,,210361
	004511,,210361
	001134,,310360
	001534,,310070
	002134,,310160
	002534,,310040
	003134,,310054
	003534,,310360
	300175,,210030
	300512,,210361
	301113,,210361
	301514,,214361
	302115,,214361
	302516,,214361
	303117,,214361
	303520,,214361
	304121,,214361
	304522,,214361
	001134,,314004
	001534,,310020
	002134,,314050
	002534,,310044
	003134,,314154
	003534,,314360
	400134,,214064
	000534,,210074
	001123,,210361
	001524,,210361
	002125,,210361
	002526,,210361
	003127,,210361
	003530,,210361
	004131,,210361
	004532,,210361
	001134,,310360
	001534,,310060
	002134,,310024
	002534,,310374
	003134,,310170
	003534,,310174
	000060,,150360
	000461,,150360
	001062,,150360
	001463,,154360
	002064,,154360
	002465,,154360
	003066,,154360
	003467,,154360
	004070,,154360
	004471,,154360
	001134,,314150
	001534,,310014
	002134,,314200
	002534,,310034
	003134,,314164
	003534,,314010
>;END IFN FTFORTRAN
IFN FTFORTRAN,<ENUM:!		;KEEPS MACRO HAPPY>

ANUM:				;ASCII NUMERIC CONVERSION TABLE
	600000,,074360
	000400,,274204
	001000,,474210
	001400,,674214
	002015,,674220
	002413,,274224
	003013,,474230
	003413,,674234
	004005,,474240
	601401,,200244
	001211,,374360
	001602,,774360
	002203,,174360
	002605,,374360
	003001,,474360
	003415,,474360
	000211,,174360
	000605,,174250
	001215,,174254
	001615,,374260
	002201,,174264
	002417,,274270
	003005,,674274
	003411,,474300
	004012,,474304
	004406,,274310
	001206,,574360
	001411,,674360
	002004,,674360
	002410,,274360
	003010,,074360
	003410,,474360
SNUM:				;SIXBIT NUMERIC CONVERSION TABLE
	601420,,000360
	300026,,401360
	001037,,602314
	001436,,603320
	002026,,604324
	002433,,005330
	003024,,006334
	003437,,207340
	004023,,210344
	004427,,211350
	001027,,012360
	200423,,413360
	002032,,614360
	201030,,015360
	003022,,616360
	003430,,217360
	000074,,020364
	000474,,221360
	001074,,422360
	001474,,623360
	002075,,024360
	002475,,225360
	003075,,426360
	003475,,627360
	004076,,030360
	004476,,231360
	300036,,432360
	001427,,433360
	002023,,034360
	002437,,435360
	003033,,436360
	000033,,637360
	000037,,040354
	000460,,241204
	001060,,442210
	001460,,643214
	002061,,044220
	002461,,245224
	003061,,446230
	003461,,647234
	004062,,050240
	004462,,251244
	300464,,252360
	301064,,453360
	301464,,654360
	302065,,055360
	302465,,256360
	303065,,457360
	303465,,660364
	304066,,061250
	304466,,262254
	001470,,463260
	002070,,664264
	002471,,065270
	003071,,266274
	003471,,467300
	004071,,670304
	004472,,071310
	001072,,272360
	000053,,273360
	002070,,074360
	300057,,275360
	003027,,676360
	003433,,277360
	000036,,274354
	000440,,241360
	001040,,442314
	001440,,643320
	002041,,044324
	002441,,245330
	003041,,446334
	003441,,647340
	004042,,050344
	004442,,251350
	300444,,252360
	301044,,453360
	301444,,654360
	302045,,055360
	302445,,256360
	303045,,457360
	303445,,660100
	304046,,061104
	304446,,262110
	001450,,463114
	002050,,664120
	002451,,065124
	003051,,266130
	003451,,467134
	004051,,670140
	004452,,071144
	001052,,272360
	000060,,073360
	002023,,674360
	300064,,075360
	003050,,274360
	003401,,674360
IFE FTFORTRAN,<
IFE FTKL10,<

BEGIN
  PROCEDURE	(JSP	T4,.SSSX)	;SINGLE PRECISION SIGNED SIXBIT
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
  $1%	ILDB	T1,T2		;PICKUP BYTE
	SKIPG	T1,SIXTBL(T1)	;[OK] CONVERT
	JRST	$5		;SPECIAL FLAG SET
  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
  $3%	SOJG	T3,$1		;LOOP

  $4%	TXNE	T4,CF.N+CF.O	;NEGATIVE?
	MOVN	T0,T0		;YES
	MOVEM	T0,0(P1)	;[C20] STORE
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..

  $5%	TXNE	T1,CF.Z		;NUL?
	JRST	$3		;YES, JUST IGNORE
	TXNE	T1,CF.L		;LEADING CHAR FLAG
	JRST	$6		;YES
	TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
	JRST	$7		;YES
	TXNN	T1,CF.P+CF.N	;SIGN?
	JRST	ERRILC		;MUST BE ILLEGAL
	TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
	IOR	T4,T1		;OR IN + OR -
	JRST	$3		;GET NEXT CHAR

  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
	JRST	$3		;NO, JUST IGNORE
	JRST	$4		;YES, TERMINATE

  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
	TXO	T4,CF.O		;NO, TURN IT ON
	JRST	$2		;IGNORE OVERPUNCH
ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.DSSX)	;DOUBLE PRECISION SIGNED SIXBIT
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SUBI	T3,^D10		;GET HIGH ORDER DIGITS FIRST
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,SIXTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	
	  $4%	JRST	$E		;DONE WITH FIRST PART
	
	  $5%	TXNE	T1,CF.Z		;NUL?
		JRST	$3		;YES, JUST IGNORE
		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$7		;YES
		TXNN	T1,CF.P+CF.N	;SIGN?
		JRST	ERRILC		;MUST BE ILLEGAL
		TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
		IOR	T4,T1		;OR IN + OR -
		JRST	$3		;GET NEXT CHAR
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	
	  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
		TXO	T4,CF.O		;NO, TURN IT ON
		JRST	$2		;IGNORE OVERPUNCH
	ENDB;
	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART, ASSUME POSITIVE
	SETZ	T0,		;START AGAIN
	MOVEI	T3,^D10		;WITH 10 DIGITS
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,SIXTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	  $4%	JRST	.DSSM		;STORE

	  $5%	TXNE	T1,CF.Z		;NUL?
		JRST	$3		;YES, JUST IGNORE
		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$7		;YES
		TXNN	T1,CF.P+CF.N	;SIGN?
		JRST	ERRILC		;MUST BE ILLEGAL
		TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
		IOR	T4,T1		;OR IN + OR -
		JRST	$3		;GET NEXT CHAR
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	
	  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
		TXO	T4,CF.O		;NO, TURN IT ON
		JRST	$2		;IGNORE OVERPUNCH
	ENDB;
ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.SUSX)	;SINGLE PRECISION UNSIGNED SIXBIT
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
  $1%	ILDB	T1,T2		;PICKUP BYTE
	SKIPG	T1,SIXTBL(T1)	;[OK] CONVERT
	JRST	$5		;SPECIAL FLAG SET
  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
  $3%	SOJG	T3,$1		;LOOP

  $4%	MOVEM	T0,0(P1)	;[C20] STORE
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..

  $5%	TXNE	T1,CF.L		;LEADING CHAR FLAG
	JRST	$6		;YES
	TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
	JRST	$2		;YES, JUST IGNORE -
	TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
	JRST	$3		;YES, JUST IGNORE
	JRST	ERRILC		;MUST BE ILLEGAL

  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
	JRST	$3		;NO, JUST IGNORE
	JRST	$4		;YES, TERMINATE

ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.DUSX)	;DOUBLE PRECISION UNSIGNED SIXBIT
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SUBI	T3,^D10		;GET HIGH ORDER DIGITS FIRST
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,SIXTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	
	  $4%	JRST	$E		;DONE WITH FIRST PART
	
	  $5%		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$2		;YES, JUST IGNORE -
		TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
		JRST	$3		;YES, JUST IGNORE
		JRST	ERRILC		;MUST BE ILLEGAL
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	ENDB;
	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART
	SETZ	T0,		;START AGAIN
	MOVEI	T3,^D10		;WITH 10 DIGITS
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,SIXTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	  $4%	JRST	.DUSM		;STORE
	
	  $5%		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$2		;YES, JUST IGNORE -
		TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
		JRST	$3		;YES, JUST IGNORE
		JRST	ERRILC		;MUST BE ILLEGAL
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	ENDB;
ENDB;
 >;END IFE FTKL10
>;END IFE FTFORTRAN
IFE FTKL10,<

BEGIN
  PROCEDURE	(JSP	T4,.SSAX)	;SINGLE PRECISION SIGNED ASCII
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
  $1%	ILDB	T1,T2		;PICKUP BYTE
	SKIPG	T1,ASCTBL(T1)	;[OK] CONVERT
	JRST	$5		;SPECIAL FLAG SET
  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
  $3%	SOJG	T3,$1		;LOOP

  $4%	TXNE	T4,CF.N+CF.O	;NEGATIVE?
	MOVN	T0,T0		;YES
	MOVEM	T0,0(P1)	;[C20] STORE
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..

  $5%	TXNE	T1,CF.Z		;NUL?
	JRST	$3		;YES, JUST IGNORE
	TXNE	T1,CF.L		;LEADING CHAR FLAG
	JRST	$6		;YES
	TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
	JRST	$7		;YES
	TXNN	T1,CF.P+CF.N	;SIGN?
	JRST	ERRILC		;MUST BE ILLEGAL
	TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
	IOR	T4,T1		;OR IN + OR -
	JRST	$3		;GET NEXT CHAR

  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
	JRST	$3		;NO, JUST IGNORE
	JRST	$4		;YES, TERMINATE

  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
	TXO	T4,CF.O		;NO, TURN IT ON
	JRST	$2		;IGNORE OVERPUNCH
ENDB;
BEGIN
  PROCEDURE	(JSP	T4,.DSAX)	;DOUBLE PRECISION SIGNED ASCII
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SUBI	T3,^D10		;GET HIGH ORDER DIGITS FIRST
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,ASCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	
	  $4%	JRST	$E		;DONE WITH FIRST PART
	
	  $5%	TXNE	T1,CF.Z		;NUL?
		JRST	$3		;YES, JUST IGNORE
		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$7		;YES
		TXNN	T1,CF.P+CF.N	;SIGN?
		JRST	ERRILC		;MUST BE ILLEGAL
		TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
		IOR	T4,T1		;OR IN + OR -
		JRST	$3		;GET NEXT CHAR
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	
	  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
		TXO	T4,CF.O		;NO, TURN IT ON
		JRST	$2		;IGNORE OVERPUNCH
	ENDB;
	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART, ASSUME POSITIVE
	SETZ	T0,		;START AGAIN
	MOVEI	T3,^D10		;WITH 10 DIGITS
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,ASCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	  $4%	JRST	.DSSM		;STORE
	
	  $5%	TXNE	T1,CF.Z		;NUL?
		JRST	$3		;YES, JUST IGNORE
		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$7		;YES
		TXNN	T1,CF.P+CF.N	;SIGN?
		JRST	ERRILC		;MUST BE ILLEGAL
		TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
		IOR	T4,T1		;OR IN + OR -
		JRST	$3		;GET NEXT CHAR
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	
	  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
		TXO	T4,CF.O		;NO, TURN IT ON
		JRST	$2		;IGNORE OVERPUNCH
	ENDB;
ENDB;
BEGIN
  PROCEDURE	(JSP	T4,.SUAX)	;SINGLE PRECISION UNSIGNED ASCII
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
  $1%	ILDB	T1,T2		;PICKUP BYTE
	SKIPG	T1,ASCTBL(T1)	;[OK] CONVERT
	JRST	$5		;SPECIAL FLAG SET
  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
  $3%	SOJG	T3,$1		;LOOP

  $4%	MOVEM	T0,0(P1)	;[C20] STORE
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..

  $5%	TXNE	T1,CF.L		;LEADING CHAR FLAG
	JRST	$6		;YES
	TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
	JRST	$2		;YES, JUST IGNORE -
	TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
	JRST	$3		;YES, JUST IGNORE
	JRST	ERRILC		;ILLEGAL

  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
	JRST	$3		;NO, JUST IGNORE
	JRST	$4		;YES, TERMINATE

ENDB;
BEGIN
  PROCEDURE	(JSP	T4,.DUAX)	;DOUBLE PRECISION UNSIGNED ASCII
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SUBI	T3,^D10		;GET HIGH ORDER DIGITS FIRST
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,ASCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	
	  $4%	JRST	$E		;DONE WITH FIRST PART
	
	  $5%		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$2		;YES, JUST IGNORE -
		TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
		JRST	$3		;YES, JUST IGNORE
		JRST	ERRILC		;MUST BE ILLEGAL
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	ENDB;
	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART
	SETZ	T0,		;START AGAIN
	MOVEI	T3,^D10		;WITH 10 DIGITS
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,ASCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	  $4%	JRST	.DUSM		;STORE
	
	  $5%		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$2		;YES, JUST IGNORE -
		TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
		JRST	$3		;YES, JUST IGNORE
		JRST	ERRILC		;MUST BE ILLEGAL
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	ENDB;
ENDB;
>;END IFE FTKL10
IFE FTFORTRAN,<
 IFE FTKL10,<
BEGIN
  PROCEDURE	(JSP	T4,.SSEX)	;SINGLE PRECISION SIGNED EBCDIC
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
  $1%	ILDB	T1,T2		;PICKUP BYTE
	SKIPG	T1,EBCTBL(T1)	;[OK] CONVERT
	JRST	$5		;SPECIAL FLAG SET
  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
  $3%	SOJG	T3,$1		;LOOP

  $4%	TXNE	T4,CF.N+CF.O	;NEGATIVE?
	MOVN	T0,T0		;YES
	MOVEM	T0,0(P1)	;[C20] STORE
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..

  $5%	TXNE	T1,CF.Z		;NUL?
	JRST	$3		;YES, JUST IGNORE
	TXNE	T1,CF.L		;LEADING CHAR FLAG
	JRST	$6		;YES
	TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
	JRST	$7		;YES
	TXNN	T1,CF.P+CF.N	;SIGN?
	JRST	ERRILC		;MUST BE ILLEGAL
	TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
	IOR	T4,T1		;OR IN + OR -
	JRST	$3		;GET NEXT CHAR

  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
	JRST	$3		;NO, JUST IGNORE
	JRST	$4		;YES, TERMINATE

  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
	TXO	T4,CF.O		;NO, TURN IT ON
	JRST	$2		;IGNORE OVERPUNCH
ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.DSEX)	;DOUBLE PRECISION SIGNED EBCDIC
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SUBI	T3,^D10		;GET HIGH ORDER DIGITS FIRST
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,EBCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	
	  $4%	JRST	$E		;DONE WITH FIRST PART
	
	  $5%	TXNE	T1,CF.Z		;NUL?
		JRST	$3		;YES, JUST IGNORE
		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$7		;YES
		TXNN	T1,CF.P+CF.N	;SIGN?
		JRST	ERRILC		;MUST BE ILLEGAL
		TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
		IOR	T4,T1		;OR IN + OR -
		JRST	$3		;GET NEXT CHAR
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	
	  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
		TXO	T4,CF.O		;NO, TURN IT ON
		JRST	$2		;IGNORE OVERPUNCH
	ENDB;
	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART, ASSUME POSITIVE
	SETZ	T0,		;START AGAIN
	MOVEI	T3,^D10		;WITH 10 DIGITS
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,EBCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	  $4%	JRST	.DSSM		;STORE
	
	  $5%	TXNE	T1,CF.Z		;NUL?
		JRST	$3		;YES, JUST IGNORE
		TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$7		;YES
		TXNN	T1,CF.P+CF.N	;SIGN?
		JRST	ERRILC		;MUST BE ILLEGAL
		TXZ	T4,CF.O		;IGNORE OVERPUNCHED -
		IOR	T4,T1		;OR IN + OR -
		JRST	$3		;GET NEXT CHAR
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	
	  $7%	TXNN	T4,CF.P+CF.N	;EXPLICIT SIGN SEEN?
		TXO	T4,CF.O		;NO, TURN IT ON
		JRST	$2		;IGNORE OVERPUNCH
	ENDB;
ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.SUEX)	;SINGLE PRECISION UNSIGNED EBCDIC
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
  $1%	ILDB	T1,T2		;PICKUP BYTE
	SKIPG	T1,EBCTBL(T1)	;[OK] CONVERT
	JRST	$5		;SPECIAL FLAG SET
  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
  $3%	SOJG	T3,$1		;LOOP

  $4%	MOVEM	T0,0(P1)	;[C20] STORE
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..

  $5%	TXNE	T1,CF.L		;LEADING CHAR FLAG
	JRST	$6		;YES
	TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
	JRST	$2		;YES, JUST IGNORE -
	TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
	JRST	$3		;YES, JUST IGNORE
	JRST	ERRILC		;ILLEGAL

  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
	JRST	$3		;NO, JUST IGNORE
	JRST	$4		;YES, TERMINATE

ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.DUEX)	;DOUBLE PRECISION UNSIGNED EBCDIC
	SETZ	T0,		;HOLDS ANS
	HRRZ	T4,T4		;LHS HOLDS FLAGS
	DMOVE	T2,0(T4)	;[OK] GET BYTE PTR AND COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SUBI	T3,^D10		;GET HIGH ORDER DIGITS FIRST
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,EBCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	
	  $4%	JRST	$E		;DONE WITH FIRST PART
	
	  $5%	TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$2		;YES, JUST IGNORE -
		TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
		JRST	$3		;YES, JUST IGNORE
		JRST	ERRILC		;MUST BE ILLEGAL
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	ENDB;
	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART
	SETZ	T0,		;START AGAIN
	MOVEI	T3,^D10		;WITH 10 DIGITS
	BEGIN
	  $1%	ILDB	T1,T2		;PICKUP BYTE
		SKIPG	T1,EBCTBL(T1)	;[OK] CONVERT
		JRST	$5		;SPECIAL FLAG SET
	  $2%	TXO	T4,CF.L		;SET SEEN A DIGIT
		IMULI	T0,^D10		;MAKE ROOM
		HRRZ	P2,T1		;[C20] ADD IN
		ADD	T0,P2		;[C20]   ..
	  $3%	SOJG	T3,$1		;LOOP
	  $4%	JRST	.DUSM		;STORE
	
	  $5%	TXNE	T1,CF.L		;LEADING CHAR FLAG
		JRST	$6		;YES
		TXNE	T1,CF.O		;OVERPUNCHED NEGATIVE?
		JRST	$2		;YES, JUST IGNORE -
		TXNE	T1,CF.Z+CF.P+CF.N	;NUL OR SIGN?
		JRST	$3		;YES, JUST IGNORE
		JRST	ERRILC		;MUST BE ILLEGAL
	
	  $6%	TXNN	T4,CF.L		;HAVE WE SEEN ANY DIGITS YET
		JRST	$3		;NO, JUST IGNORE
		JRST	$4		;YES, TERMINATE
	ENDB;
ENDB;

>;END IFE FTKL10
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.SS3X)	;COMP-3 SIGNED SINGLE PRECISION
	DMOVE	T2,(T4)		;[OK] GET BYTE POINTER AND BYTE COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SETZ	T0,		;HOLDING AC
  IF BYTE COUNT IS EVEN
	TRNN	T3,1
  THEN ONLY ONE BYTE IN FIRST DOUBLE BYTE
	JRST	[ILDB	T1,T2		;PICKUP DOUBLE BYTE
		ANDI	T1,17		;MASK OUT JUNK
		JRST	$2]		;AND BYPASS
  FI;
  $1%	ILDB	T1,T2		;PICKUP DOUBLE BYTE
	ROT	T1,-4		;GET FIRST BYTE
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	LSH	T1,-^D32	;RIGHT JUSTIFY
	SOJE	T3,$3		;ONLY SIGN LEFT?
  $2%	IMULI	T0,^D10		;MAKE ROOM FOR SECOND DIGIT
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	SOJG	T3,$1		;LOOP FOR MORE

  $3%	CAIE	T1,13		;TEST FOR MINUS SIGN
	CAIN	T1,15		;...
	MOVN	T0,T0		;YES, NEGATE VALUE
	MOVEM	T0,0(P1)	;[C20] STORE IT
	JRST	3(T4)		;[OK] RETURN
ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.SU3X)	;COMP-3 UNSIGNED SINGLE PRECISION
	DMOVE	T2,(T4)		;[OK] GET BYTE POINTER AND BYTE COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SETZ	T0,		;HOLDING AC
  IF BYTE COUNT IS EVEN
	TRNN	T3,1
  THEN ONLY ONE BYTE IN FIRST DOUBLE BYTE
	JRST	[ILDB	T1,T2		;PICKUP DOUBLE BYTE
		ANDI	T1,17		;MASK OUT JUNK
		JRST	$2]		;AND BYPASS
  FI;
  $1%	ILDB	T1,T2		;PICKUP DOUBLE BYTE
	ROT	T1,-4		;GET FIRST BYTE
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	LSH	T1,-^D32	;RIGHT JUSTIFY
	SOJE	T3,$3		;ONLY SIGN LEFT?
  $2%	IMULI	T0,^D10		;MAKE ROOM FOR SECOND DIGIT
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	SOJG	T3,$1		;LOOP FOR MORE

  $3%	MOVEM	T0,0(P1)	;[C20] STORE IT
	JRST	3(T4)		;[OK] RETURN
ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.DS3X)	;COMP-3 SIGNED DOUBLE PRECISION
	DMOVE	T2,(T4)		;[OK] GET BYTE POINTER AND BYTE COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SETZ	T0,		;HOLDING AC
  IF BYTE COUNT IS EVEN
	TRNN	T3,1
  THEN ONLY ONE BYTE IN FIRST DOUBLE BYTE
	JRST	[ILDB	T1,T2		;PICKUP DOUBLE BYTE
		ANDI	T1,17		;MASK OUT JUNK
		MOVEI	T3,9		;READ FIRST PART
		JRST	$2]		;AND BYPASS
  FI;
	MOVEI	T3,9		;READ FIRST PART
  $1%	ILDB	T1,T2		;PICKUP DOUBLE BYTE
	ROT	T1,-4		;GET FIRST BYTE
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	LSH	T1,-^D32	;RIGHT JUSTIFY
	SOJE	T3,$3		;ONLY SIGN LEFT?
  $2%	IMULI	T0,^D10		;MAKE ROOM FOR SECOND DIGIT
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	SOJG	T3,$1		;LOOP FOR MORE
	SETZ	T1,		;CLEAR STORED VALUE
  $3%	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART, ASSUME POSITIVE
	MOVE	T0,T1		;GET REMAINDER OR ZERO
	MOVE	T3,1(T4)	;[OK] GET COUNT
	SUBI	T3,9		;MINUS FIRST PART
  $4%	ILDB	T1,T2		;PICKUP DOUBLE BYTE
	ROT	T1,-4		;GET FIRST BYTE
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	LSH	T1,-^D32	;RIGHT JUSTIFY
	SOJE	T3,$5		;ONLY SIGN LEFT?
	IMULI	T0,^D10		;MAKE ROOM FOR SECOND DIGIT
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	SOJG	T3,$4		;LOOP FOR MORE
  $5%	CAIE	T1,13		;[C20] TEST FOR MINUS SIGN
	CAIN	T1,15		;...
	JRST	[MOVNS	0(P1)		;[C20] NEGATE FIRST PART
		MOVNM	T0,1(P1)	;[C20] STORE SECOND PART
		JRST	3(T4)]		;[OK] RETURN
	MOVEM	T0,1(P1)	;[C20] STORE SECOND PART
	JRST	3(T4)		;[OK] RETURN
ENDB;
;STILL IN IFE FTFORTRAN

BEGIN
  PROCEDURE	(JSP	T4,.DU3X)	;COMP-3 UNSIGNED DOUBLE PRECISION
	DMOVE	T2,(T4)		;[OK] GET BYTE POINTER AND BYTE COUNT
	HRRZ	P1,2(T4)	;[C20] GET STORAGE ADDRESS
	ADD	P1,R		;[C20]   ..
	SETZ	T0,		;HOLDING AC
  IF BYTE COUNT IS EVEN
	TRNN	T3,1
  THEN ONLY ONE BYTE IN FIRST DOUBLE BYTE
	JRST	[ILDB	T1,T2		;PICKUP DOUBLE BYTE
		ANDI	T1,17		;MASK OUT JUNK
		MOVEI	T3,9		;READ FIRST PART
		JRST	$2]		;AND BYPASS
  FI;
	MOVEI	T3,9		;READ FIRST PART
  $1%	ILDB	T1,T2		;PICKUP DOUBLE BYTE
	ROT	T1,-4		;GET FIRST BYTE
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	LSH	T1,-^D32	;RIGHT JUSTIFY
	SOJE	T3,$3		;ONLY SIGN LEFT?
  $2%	IMULI	T0,^D10		;MAKE ROOM FOR SECOND DIGIT
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	SOJG	T3,$1		;LOOP FOR MORE
	SETZ	T1,		;CLEAR STORED VALUE
  $3%	MOVEM	T0,0(P1)	;[C20] STORE FIRST PART
	MOVE	T0,T1		;GET REMAINDER OR ZERO
	HRRZ	T3,T4		;[C20] GET COUNT
	SUBI	T3,9-1		;[C20] MINUS FIRST PART
  $4%	ILDB	T1,T2		;PICKUP DOUBLE BYTE
	ROT	T1,-4		;GET FIRST BYTE
	IMULI	T0,^D10		;MAKE ROOM
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	LSH	T1,-^D32	;RIGHT JUSTIFY
	SOJE	T3,$5		;ONLY SIGN LEFT?
	IMULI	T0,^D10		;MAKE ROOM FOR SECOND DIGIT
	HRRZ	P2,T1		;[C20] ADD IN
	ADD	T0,P2		;[C20]   ..
	SOJG	T3,$4		;LOOP FOR MORE
  $5%	MOVEM	T0,1(P1)	;[C20] STORE SECOND PART
	JRST	3(T4)		;[OK] RETURN
ENDB;

>;END IFE FTFORTRAN
;DOUBLE PRECISION STORE ROUTINES

BEGIN
  PROCEDURE	(JSP	T4,.DSSM)
	MOVE	T2,T0		;COPY LOW ORDER WORD
	MOVE	T0,0(P1)	;[C20] RECOVER HIGH ORDER WORD
	MUL	T0,TENTBL(T3)	;[OK] MULT BY POWER OF TEN
	TXO	T2,1B0		;TO PREVENT OVERFLOWS
	ADD	T1,T2		;ADD LOW ORDER WORDS
	TXZN	T1,1B0		;CHECK FOR OVERFLOW
	ADDI	T0,1		;YES IT DID
  IF SIGN IS POSITIVE
	TXNE	T4,CF.N+CF.O
	JRST	$T
  THEN JUST STORE
  IFN FTKI10!FTKL10,<
	DMOVEM	T0,0(P1)	;[C20] JUST STORE
  >
  IFE FTKI10!FTKL10,<
	MOVEM	T0,0(P1)	;[C20] JUST STORE
	MOVEM	T1,1(P1)	;[C20]   ..
  >
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..
  ELSE NEGATE FIRST
  IFN FTKI10!FTKL10,<
	DMOVNM	T0,0(P1)	;[C20] THE EASY WAY
  >
  IFE FTKI10!FTKL10,<
	SETCAM	T0,0(P1)	;[C20] [132] SIMULATE A DMOVNM ON A KA
	MOVNS	T1		;[132]  ..
	TXZ	T1,1B0		;[132]  ..
	SKIPN	T1		;[132]  ..
	AOS	0(P1)		;[C20] [132] TWOS COMP ONLY IF LOW WORD IS 0
	MOVEM	T1,1(P1)	;[C20] [132] FINISH STORE
  >
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..
  FI;
ENDB;
BEGIN
  PROCEDURE	(JSP	T4,.DUSM)
	MOVE	T2,T0		;COPY LOW ORDER WORD
	MOVE	T0,0(P1)	;[C20] RECOVER HIGH ORDER WORD
	MUL	T0,TENTBL(T3)	;[OK] MULT BY POWER OF TEN
	TXO	T2,1B0		;TO PREVENT OVERFLOWS
	ADD	T1,T2		;ADD LOW ORDER WORDS
	TXZN	T1,1B0		;CHECK FOR OVERFLOW
	ADDI	T0,1		;YES IT DID
  IFN FTKI10!FTKL10,<
	DMOVEM	T0,0(P1)	;[C20] JUST STORE
  >
  IFE FTKI10!FTKL10,<
	MOVEM	T0,0(P1)	;[C20] JUST STORE
	MOVEM	T1,1(P1)	;[C20]   ..
  >
	HRRZS	T4		;[C20] RETURN
	JRST	3(T4)		;[C20]   ..
ENDB;

TENTBL:	^D10000000000
	^D1000000000
	^D100000000
	^D10000000
	^D1000000
	^D100000
	^D10000
	^D1000
	^D100
	^D10
	^D1
;ASCII/SIXBIT DIGIT TRANSLATION TABLE

IFE FTKL10,<

ASCTBL:	CHAR	(0,0,CF.Z)		;NULL	NULL
	CHAR	(0,1,CF.I)		;SOH
	CHAR	(0,2,CF.I)		;STX
	CHAR	(0,3,CF.I)		;ETX
	CHAR	(0,67,CF.I)		;EOT	EOT
	CHAR	(0,55,CF.I)		;ENQ
	CHAR	(0,56,CF.I)		;ACK
	CHAR	(0,57,CF.I)		;BELL
	CHAR	(0,26,CF.I)		;BS	BS
	CHAR	(0,5,CF.L)		;HT	HT
	CHAR	(0,45,CF.I)		;LF	LF
	CHAR	(0,13,CF.I)		;VT
	CHAR	(0,14,CF.I)		;FF
	CHAR	(0,25,CF.I)		;CR	NL
	CHAR	(0,6,CF.I)		;SO	LC
	CHAR	(0,66,CF.I)		;SI	UC
	CHAR	(0,44,CF.I)		;DLE	BYP
	CHAR	(0,24,CF.I)		;DC1	RES
	CHAR	(0,64,CF.I)		;DC2	PN
	CHAR	(0,65,CF.I)		;DC3	RS
	CHAR	(0,4,CF.I)		;DC4	PF
	CHAR	(0,75,CF.I)		;NAK
	CHAR	(0,27,CF.I)		;SYN	IL
	CHAR	(0,46,CF.I)		;ETB	EOB
	CHAR	(0,52,CF.I)		;CAN	SM
	CHAR	(0,31,CF.I)		;EM
	CHAR	(0,32,CF.I)		;SUB	CC
	CHAR	(0,47,CF.I)		;ESC	PRE
	CHAR	(0,23,CF.I)		;FS	TM
	CHAR	(0,41,CF.I)		;GS	SOS
	CHAR	(0,40,CF.I)		;RS	DS
	CHAR	(0,42,CF.I)		;US	FS

SIXTBL:	CHAR	(0,100,CF.L)		;SPACE
	CHAR	(0,132)			;!
	CHAR	(0,177,CF.I)		;"
	CHAR	(0,173,CF.I)		;#
	CHAR	(0,133,CF.I)		;$
	CHAR	(0,154,CF.I)		;%
	CHAR	(0,120,CF.I)		;&
	CHAR	(0,175,CF.I)		;'
	CHAR	(0,115,CF.I)		;(
	CHAR	(0,135,CF.I)		;)
	CHAR	(0,134,CF.I)		;*
	CHAR	(0,116,CF.P)		;+
	CHAR	(0,153,CF.I)		;,
	CHAR	(0,140,CF.N)		;-
	CHAR	(0,113,CF.I)		;.
	CHAR	(0,141,CF.I)		;/
	CHAR	(0,360)			;0
	CHAR	(1,361)			;1
	CHAR	(2,362)			;2
	CHAR	(3,363)			;3
	CHAR	(4,364)			;4
	CHAR	(5,365)			;5
	CHAR	(6,366)			;6
	CHAR	(7,367)			;7
	CHAR	(8,370)			;8
	CHAR	(9,371)			;9
	CHAR	(0,172,CF.O)		;:
	CHAR	(0,136,CF.I)		;;
	CHAR	(0,114,CF.I)		;<
	CHAR	(0,176,CF.I)		;=
	CHAR	(0,156,CF.I)		;>
	CHAR	(0,157)			;?
	CHAR	(0,174,CF.I)		;@
	CHAR	(1,301)			;A
	CHAR	(2,302)			;B
	CHAR	(3,303)			;C
	CHAR	(4,304)			;D
	CHAR	(5,305)			;E
	CHAR	(6,306)			;F
	CHAR	(7,307)			;G
	CHAR	(8,310)			;H
	CHAR	(9,311)			;I
	CHAR	(1,321,CF.O)		;J
	CHAR	(2,322,CF.O)		;K
	CHAR	(3,323,CF.O)		;L
	CHAR	(4,324,CF.O)		;M
	CHAR	(5,325,CF.O)		;N
	CHAR	(6,326,CF.O)		;O
	CHAR	(7,327,CF.O)		;P
	CHAR	(8,330,CF.O)		;Q
	CHAR	(9,331,CF.O)		;R
	CHAR	(0,342,CF.I)		;S
	CHAR	(0,343,CF.I)		;T
	CHAR	(0,344,CF.I)		;U
	CHAR	(0,345,CF.I)		;V
	CHAR	(0,346,CF.I)		;W
	CHAR	(0,347,CF.I)		;X
	CHAR	(0,350,CF.I)		;Y
	CHAR	(0,351,CF.I)		;Z
	CHAR	(0,340)			;[
	CHAR	(0,155,CF.I)		;\	_
	CHAR	(0,320,CF.O)		;]
	CHAR	(0,117,CF.I)		;_	\
	CHAR	(0,155,CF.I)		;^
	CHAR	(0,174,CF.I)		;	@
	CHAR	(1,201)			;a
	CHAR	(2,202)			;b
	CHAR	(3,203)			;c
	CHAR	(4,204)			;d
	CHAR	(5,205)			;e
	CHAR	(6,206)			;f
	CHAR	(7,207)			;g
	CHAR	(8,210)			;h
	CHAR	(9,211)			;i
	CHAR	(1,221,CF.O)		;j
	CHAR	(2,222,CF.O)		;k
	CHAR	(3,223,CF.O)		;l
	CHAR	(4,224,CF.O)		;m
	CHAR	(5,225,CF.O)		;n
	CHAR	(6,226,CF.O)		;o
	CHAR	(7,227,CF.O)		;p
	CHAR	(8,230,CF.O)		;q
	CHAR	(9,231,CF.O)		;r
	CHAR	(0,242,CF.I)		;s
	CHAR	(0,243,CF.I)		;t
	CHAR	(0,244,CF.I)		;u
	CHAR	(0,245,CF.I)		;v
	CHAR	(0,246,CF.I)		;w
	CHAR	(0,247,CF.I)		;x
	CHAR	(0,250,CF.I)		;y
	CHAR	(0,251,CF.I)		;z
	CHAR	(0,300)			;[
	CHAR	(0,117,CF.I)		;\
	CHAR	(0,260,CF.O)		;]
	CHAR	(0,155,CF.I)		;	_
	CHAR	(0,007,CF.I)		;DEL
IFE FTFORTRAN,<
;EBCDIC DIGIT TRANSLATION TABLE

EBCTBL:	CHAR	(0,0,CF.Z)		;NULL	NULL
	CHAR	(1,1)			;
	CHAR	(2,2)			;
	CHAR	(3,3)			;
	CHAR	(4,24)			;PF	DC4
	CHAR	(5,11)			;HT	HT
	CHAR	(6,16)			;LC	SO
	CHAR	(7,177)			;DEL
	CHAR	(10)			;
	CHAR	(11)			;
	CHAR	(12)			;
	CHAR	(13,13)			;
	CHAR	(14,14)			;
	CHAR	(15)			;
	CHAR	(16)			;
	CHAR	(17)			;
	CHAR	(20)			;
	CHAR	(21)			;
	CHAR	(22)			;
	CHAR	(23,34)			;TM	FS
	CHAR	(24,21)			;RES	DC1
	CHAR	(25,15)			;NL	CR
	CHAR	(26,10)			;BS	BS
	CHAR	(27,26)			;IL	SYN
	CHAR	(30)			;
	CHAR	(31,31)			;
	CHAR	(32,32)			;
	CHAR	(33)			;
	CHAR	(34)			;
	CHAR	(35)			;
	CHAR	(36)			;
	CHAR	(37)			;
	CHAR	(40,36)			;DS	RS
	CHAR	(41,35)			;SOS	GS
	CHAR	(42,37)			;FS	US
	CHAR	(43)			;
	CHAR	(44,20)			;BYP	DLE
	CHAR	(45,12)			;LF	LF
	CHAR	(46,27)			;EOB	ETB
	CHAR	(47,33)			;PRE	ESC
	CHAR	(50)			;
	CHAR	(51)			;
	CHAR	(52,30)			;SM	CAN
	CHAR	(53)			;
	CHAR	(54)			;
	CHAR	(55,5)			;
	CHAR	(56,6)			;
	CHAR	(57,7)			;
	CHAR	(60)			;
	CHAR	(61)			;
	CHAR	(62)			;
	CHAR	(63)			;
	CHAR	(64,22)			;PN	DC2
	CHAR	(65,23)			;RS	DC3
	CHAR	(66,17)			;US	SI
	CHAR	(67,4)			;EOT	EOT
	CHAR	(70)			;
	CHAR	(71)			;
	CHAR	(72)			;
	CHAR	(73)			;
	CHAR	(74)			;
	CHAR	(75,25)			;
	CHAR	(76)			;
	CHAR	(77)			;
	CHAR	(100,40)		;SPACE
	CHAR	(101)			;
	CHAR	(102)			;
	CHAR	(103)			;
	CHAR	(104)			;
	CHAR	(105)			;
	CHAR	(106)			;
	CHAR	(107)			;
	CHAR	(110)			;
	CHAR	(111)			;
	CHAR	(112)			;
	CHAR	(113,56)		;.
	CHAR	(114,74)		;<
	CHAR	(115,50)		;(
	CHAR	(116,53)		;*
	CHAR	(117,174)		;\
	CHAR	(120,46)		;&
	CHAR	(121)			;
	CHAR	(122)			;
	CHAR	(123)			;
	CHAR	(124)			;
	CHAR	(125)			;
	CHAR	(126)			;
	CHAR	(127)			;
	CHAR	(130)			;
	CHAR	(131)			;
	CHAR	(132,41)		;!
	CHAR	(133,44)		;$
	CHAR	(134,52)		;*
	CHAR	(135,135)		;)
	CHAR	(136,73)		;:
	CHAR	(137)			;
	CHAR	(140,55)		;-
	CHAR	(141,57)		;/
	CHAR	(142)			;
	CHAR	(143)			;
	CHAR	(144)			;
	CHAR	(145)			;
	CHAR	(146)			;
	CHAR	(147)			;
	CHAR	(150)			;
	CHAR	(151)			;
	CHAR	(152)			;
	CHAR	(153,54)		;,
	CHAR	(154,45)		;%
	CHAR	(155,137)		;_
	CHAR	(156,76)		;>
	CHAR	(157,77)		;?
	CHAR	(160)			;
	CHAR	(161)			;
	CHAR	(162)			;
	CHAR	(163)			;
	CHAR	(164)			;
	CHAR	(165)			;
	CHAR	(166)			;
	CHAR	(167)			;
	CHAR	(170)			;
	CHAR	(171)			;
	CHAR	(172,72)		;:
	CHAR	(173,43)		;#
	CHAR	(174,100)		;@
	CHAR	(175,47)		;'
	CHAR	(176,75)		;=
	CHAR	(177,42)		;"
	CHAR	(200)			;
	CHAR	(201,141)		;a
	CHAR	(202,142)		;b
	CHAR	(203,143)		;c
	CHAR	(204,144)		;d
	CHAR	(205,145)		;e
	CHAR	(206,146)		;f
	CHAR	(207,147)		;g
	CHAR	(210,150)		;h
	CHAR	(211,151)		;i
	CHAR	(212)			;
	CHAR	(213)			;
	CHAR	(214)			;
	CHAR	(215)			;
	CHAR	(216)			;
	CHAR	(217)			;
	CHAR	(220)			;
	CHAR	(221,152)		;j
	CHAR	(222,153)		;k
	CHAR	(223,154)		;l
	CHAR	(224,155)		;m
	CHAR	(225,156)		;n
	CHAR	(226,157)		;o
	CHAR	(227,160)		;p
	CHAR	(230,161)		;q
	CHAR	(231,162)		;r
	CHAR	(232)			;
	CHAR	(233)			;
	CHAR	(234)			;
	CHAR	(235)			;
	CHAR	(236)			;
	CHAR	(237)			;
	CHAR	(240)			;
	CHAR	(241)			;
	CHAR	(242,163)		;s
	CHAR	(243,164)		;t
	CHAR	(244,165)		;u
	CHAR	(245,166)		;v
	CHAR	(246,167)		;w
	CHAR	(247,170)		;x
	CHAR	(250,171)		;y
	CHAR	(251,172)		;z
	CHAR	(252)			;
	CHAR	(253)			;
	CHAR	(254)			;
	CHAR	(255)			;
	CHAR	(256)			;
	CHAR	(257)			;
	CHAR	(260,173,CF.O)		;[
	CHAR	(261,1,CF.O)		;
	CHAR	(262,2,CF.O)		;
	CHAR	(263,3,CF.O)		;
	CHAR	(264,4,CF.O)		;
	CHAR	(265,5,CF.O)		;
	CHAR	(266,6,CF.O)		;
	CHAR	(267,7,CF.O)		;
	CHAR	(270,10,CF.O)		;
	CHAR	(271,11,CF.O)		;
	CHAR	(272)			;
	CHAR	(273)			;
	CHAR	(274)			;
	CHAR	(275)			;
	CHAR	(276)			;
	CHAR	(277)			;
	CHAR	(300,175)		;
	CHAR	(301,101)		;A
	CHAR	(302,102)		;B
	CHAR	(303,103)		;C
	CHAR	(304,104)		;D
	CHAR	(305,105)		;E
	CHAR	(306,106)		;F
	CHAR	(307,107)		;G
	CHAR	(310,110)		;H
	CHAR	(311,111)		;I
	CHAR	(312)			;
	CHAR	(313)			;
	CHAR	(314)			;
	CHAR	(315)			;
	CHAR	(316)			;
	CHAR	(317)			;
	CHAR	(320,133,CF.O)		;[
	CHAR	(321,112,CF.O)		;J
	CHAR	(322,113,CF.O)		;K
	CHAR	(323,114,CF.O)		;L
	CHAR	(324,115,CF.O)		;M
	CHAR	(325,116,CF.O)		;N
	CHAR	(326,117,CF.O)		;O
	CHAR	(327,120,CF.O)		;P
	CHAR	(330,121,CF.O)		;Q
	CHAR	(331,122,CF.O)		;R
	CHAR	(332)			;
	CHAR	(333)			;
	CHAR	(334)			;
	CHAR	(335)			;
	CHAR	(336)			;
	CHAR	(337)			;
	CHAR	(340,135)		;]
	CHAR	(341)			;
	CHAR	(342,123)		;S
	CHAR	(343,124)		;T
	CHAR	(344,125)		;U
	CHAR	(345,126)		;V
	CHAR	(346,127)		;W
	CHAR	(347,130)		;X
	CHAR	(350,131)		;Y
	CHAR	(351,132)		;Z
	CHAR	(352)			;
	CHAR	(353)			;
	CHAR	(354)			;
	CHAR	(355)			;
	CHAR	(356)			;
	CHAR	(357)			;
	CHAR	(360,60)		;0
	CHAR	(361,61)		;1
	CHAR	(362,62)		;2
	CHAR	(363,63)		;3
	CHAR	(364,64)		;4
	CHAR	(365,65)		;5
	CHAR	(366,66)		;6
	CHAR	(367,67)		;7
	CHAR	(370,70)		;8
	CHAR	(371,71)		;9
	CHAR	(372)			;
	CHAR	(373)			;
	CHAR	(374)			;
	CHAR	(375)			;
	CHAR	(376)			;
	CHAR	(377)			;

 >;END IFE FTKL10
>;END IFE FTFORTRAN
;ALPHANUMERIC CONVERSION TABLES FOR ALTERNATE COLLATING SEQUENCE.
;EXTRACTED FROM ALBSTB IN LIBOL
;NOTE THE ASCII AND SIXBIT TO EBCDIC ROUTINES ARE NOT THE LIBOL ONES
;SINCE WE WANT 7 OR 6 BIT CHARACTERS NOT 9
;HOWEVER THE CHARACTERS ARE COLLATED CORRECTLY

ALP.69:				;SIXBIT TO EBCDIC
	400000,,000006
	400030,,400024
	400007,,400017
	400005,,400026
	400003,,400011
	400010,,400004
	400016,,400014
	400001,,400015
	000066,,400067
	400070,,400071
	400072,,400073
	400074,,400075
	400076,,400077
	000023,,400012
	400002,,400027
	400021,,000022
	000025,,400033
	400034,,400035
	400036,,400037
	400040,,400041
	400042,,400043
	400044,,400045
	400046,,400047
	400050,,400051
	400052,,400053
	400054,,400056
	400057,,400060
	400061,,400062
	400063,,400064
	400065,,000031
	400055,,000032
	400013,,400020

ALP.79:				;ASCII TO EBCDIC
	000000,,400001
	400002,,400003
	400037,,400031
	400032,,400033
	400015,,400005
	400025,,400010
	400011,,400014
	400006,,400036
	000024,,400013
	400034,,400035
	400004,,400040
	400016,,400026
	400030,,400017
	400020,,400027
	400012,,400022
	400021,,400023
	400041,,000050
	400073,,400067
	400051,,400061
	400047,,400071
	400044,,400053
	400052,,400045
	400060,,400056
	400042,,400057
	000166,,400167
	400170,,400171
	400172,,400173
	400174,,400175
	400176,,400177
	000066,,400054
	400043,,400072
	400063,,000064
	000070,,400132
	400133,,400134
	400135,,400136
	400137,,400140
	400141,,400142
	400144,,400145
	400146,,400147
	400150,,400151
	400152,,400153
	400154,,400156
	400157,,400160
	400161,,400162
	400163,,400164
	400165,,000127
	400155,,000130
	400055,,400062
	000065,,400074
	400075,,400076
	400077,,400100
	400101,,400102
	400103,,400104
	400105,,400106
	400107,,400110
	400111,,400112
	400113,,400114
	400115,,400117
	400120,,400121
	400122,,400123
	400124,,400125
	400126,,000131
	400046,,000143
	400117,,400007

ALP.97:			;EBCDIC TO ASCII
	300000,,700001
	700002,,700003
	700024,,700011
	700016,,700177
	700134,,700134
	700134,,700013
	700014,,700134
	700134,,700134
	300134,,700134
	700134,,700034
	700021,,700015
	700010,,700026
	700134,,700031
	700032,,700134
	700134,,700134
	700134,,700134
	300036,,700035
	700037,,700134
	700020,,700012
	700027,,700033
	700134,,700134
	700030,,700134
	700134,,700005
	700006,,700007
	300134,,700134
	700134,,700134
	700022,,700023
	700017,,700004
	700134,,700134
	700134,,700134
	700134,,700025
	700134,,700134
	400040,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700056
	700074,,700050
	700053,,700174
	300046,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700041,,700044
	700052,,700051
	700073,,700136
	700055,,700057
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700054
	700045,,700137
	700076,,700077
	300134,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700140
	700072,,700043
	700100,,700047
	700075,,700042
	300134,,400141
	400142,,400143
	400144,,400145
	400146,,400147
	400150,,400151
	700134,,700134
	700134,,700134
	700134,,700134
	300134,,400152
	400153,,400154
	400155,,400156
	400157,,400160
	400161,,400162
	700134,,700134
	700134,,700134
	700134,,700134
	300134,,700176
	400163,,400164
	400165,,400166
	400167,,400170
	400171,,400172
	700134,,700134
	700134,,700133
	700134,,700134
	300175,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700134
	700134,,700135
	700134,,700134
	300173,,400101
	400102,,400103
	400104,,400105
	400106,,400107
	400110,,400111
	700134,,700134
	700134,,700134
	700134,,700134
	300175,,400112
	400113,,400114
	400115,,400116
	400117,,400120
	400121,,400122
	700134,,700134
	700134,,700134
	700134,,700134
	300134,,700134
	400123,,400124
	400125,,400126
	400127,,400130
	400131,,400132
	700134,,700134
	700134,,700134
	700134,,700134
	300060,,700061
	700062,,700063
	700064,,700065
	700066,,700067
	700070,,700071
	700134,,700134
	700134,,700134
	700134,,700134
SUBTTL	ERROR MESSAGES

ERRILC:	LDB	T1,T2		;READ CHAR AGAIN
	PUSH	P,T1		;SAVE IT
	$ERROR	(?,ILC,<Illegal character >,+)
	POP	P,T1
	$MORE	(OCTAL,T1)
	$MORE	(TEXT,< in numeric field.>)
	$DIE

	END