Trailing-Edge
-
PDP-10 Archives
-
BB-D489E-SB
-
srtcmp.mac
There are 10 other files named srtcmp.mac in the archive. Click here to see a list.
SUBTTL SRTCMP - COMPARISON CODE GENERATOR FOR SORT
SUBTTL D.M.NIXON/DZN/BRF 5-Feb-81
;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, 1981 BY DIGITAL EQUIPMENT CORPORATION
IFN FTPRINT,<PRINTX [Entering SRTCMP.MAC]>
k==0 ;[N16] Relocation constant
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 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
END;
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,(.DMOVM T3,(R)) ;DP
MOVEM T1,BK.SWI(U) ;STORE INSTRUCTION
ADDI U,BK.LEN ;ACCOUNT FOR WORDS USED
; PJRST CXTRTN ;COMMON RETURN
END;
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
END;
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
>
END;
; 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
END;
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
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
.DMOVM 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
END;
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
RETURN
END;
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;
END;
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
END;
BEGIN
PROCEDURE (PUSHJ P,FPAADX)
MOVE T1,XTRWRD ;GET EXTRA SIZE
ADDM T1,FK.LBP(U) ;[C13] ADJUST BYTE POINTER
ADDI U,FK.LEN
RETURN
END;
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?
END;
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$
END;
;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
END;
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;
END;
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
END;
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$
END;
>;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
END;
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$
END;
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
END;
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$
END;
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?
END;
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,@[EBBTBL(P2) ;[OK] [145] 9 BIT BYTES
B18TBL(P2) ;[OK] [145] 18 BIT BYTES
[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$
END;
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
END;
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$
END;
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
END;
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]
END;
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
END;
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
END;
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%
END;
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%
END;
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%
END;
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%
END;
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]
END;
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%
END;
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%
END;
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%
END;
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%
END;
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%
END;
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%
END;
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%
END;
BEGIN
PROCEDURE (PUSHJ P,%JRST%)
;GENERATES
;JRST (P4)
HRLZI T1,(JRST (P4))
MOVEM T1,(U)
AOJA U,CPOPJ
END;
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%
END;
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
END;
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]
END;
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
END;
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
END;
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%
END;
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;
END;
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
END;
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
END;
;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
END;
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
END;
END;
;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
END;
;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
END;
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
END;
END;
>;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
END;
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
END;
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
END;
END;
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
END;
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
END;
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
END;
END;
>;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
END;
;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
END;
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
END;
END;
;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
END;
;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
END;
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
END;
END;
>;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
END;
;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
END;
;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
END;
;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
END;
>;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;
END;
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] ..
END;
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