A large commit.

[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape2 / pass3.pa

/3 OS/8 FORTRAN  (PASS THREE)
/
/ VERSION 4A PT 16-MAY-77
/
/       OS/8 FORTRAN IV COMPILER-PASS 3
/
/       BY: HANK MAURER
/       UPDATED BY: R. LARY + M. HURLEY
/
/
/COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
VERSON=4
\f/ PAGE ZERO STUFF
        OUDEVH=7000             /PUT OUDEVH AND OUBUF IN DIFFERENT
        INDEVH=6400
        INBUF=6000
        OUBUF=5400              /SEGMENTS, STAN KNOWS WHY
        X10=10
        X11=11
        X12=12
        NCHARS=20
        CHAR=21
        TEMP=22
        FILDEV=6
        FILBLK=7
        DEV1CE=173              /THROUGH 177
        DEVH=23
        LINENO=24
        SEVCHR=25               /THROUGH 33


/       OS/8 V3C MAINTENANCE RELEASE FIXES:

/1.     EXTENDED RANGE OF PAGE NUMBERS TO 99
/2      INTERCHANGED CR/LF FOR HASSINGER
/3      CHANGED VERSION NO. TO 305
/5.     ADDED 'I' TO JMP (OFOO3
/
/
/       CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
/       .CHANGED VERSION NUMBER TO 4A
/       .PUT IN NEW DATE ALGORITHM
/
/
\f/START OF PASS 3
        *400                    /DON'T LOAD INTO 0-377
SPASS3, CDF     10
        TAD I   (7666           /GET DATE
        DCA     TEMP
        TAD I   LSTFIL          /COPY FILE NAME
        CDF
        DCA I   FILLST
        ISZ     LSTFIL
        ISZ     FILLST
        ISZ     OFSIZE
        JMP     SPASS3
        TAD     DEV1CE          /FETCH HANDLER FOR OUTPUT FILE
        CIF     10
        JMS I   (200            /USR IS IN CORE
        1
OH,     OUDEVH+1                /TWO PAGE HANDLER IS OK
        JMP I   (OFOO3
        CIF     10
        TAD     DEV1CE          /OPEN THE LISTING FILE
        JMS I   (200
        3
OB,     DEV1CE+1
OS,     0
        JMP I   (OFOO3
        TAD     OB              /SAVE BLOCK NUMBER
        DCA     OBLOCK
        TAD     OS
        DCA     OSIZE           /AND SIZE OF HOLE
        TAD     OH              /SAVE HANDLER ADDRESS
        DCA     DEVH
        TAD     (NUMS-1         /SET UP NUMBER POINTER
        DCA I   (NUM
        TAD     TEMP            /GET THE DATE--FOR YEAR ROUTINE
        SNA
        JMP I   (PAJE           /NO DATE
        AND     (7              /MASK OUT ALL BUT YEAR OFFSET BITS
        DCA     YRTEMP          /INCREMENT FROM THE BASE YEAR
        DCA     TEMP1           /HOLDS THE FIRST DIGIT OF THE YEAR
        TAD I   (7777           /GET THE DATE EXTENSION BITS
        AND     (600            /MASK TO GET THE EXTENSION BITS
        CLL RTR                 /ROTATE THEM INTO BIT
        RTR                     /POSITIONS 7 AND 8
        TAD     (106            /ADD IN 70---OLD BASE YEAR
        TAD     YRTEMP          /ADD IN THE YEAR OFFSET BITS
                                /TO FIND THE NEW BASE YEAR
CONVYR, CLL                     /FIND THE YEAR IN DECIMAL
        TAD     (-12            /KEEP SUBTRACTING 12
        SNL                     /ALMOST DONE
        JMP     SECDIG          /FIND THE SECOND DIGIT OF THE YEAR
        ISZ     TEMP1           /FIND THE FIRST DIGIT OF THE YEAR
        JMP     CONVYR          /TRY AGAIN
SECDIG, TAD     (72             /GET THE SECOND DIGIT OF THE YEAR
        RTL                     /AND MAKE IT SIXBIT
        RTL
        RTL
        DCA I   (YEAR+1         /PUT IT IN THE PRINT LINE
        TAD     TEMP1           /GET THE FIRST DIGIT
        TAD     (5560           /MAKE IT SIXBIT
        DCA I   (YEAR           /PRINT IT
        TAD     TEMP            /GET THE DATE--NOW FIND THE MONTH/DAY
        CLL RTR
        RAR
        AND     (777
        DCA     TEMP
SIMPLE, TAD     TEMP            /GET THE DAY
        AND     (37
        TAD     (DAYS-1         /THIS IS THE LAZY WAY
        DCA     NCHARS
        TAD I   NCHARS
        DCA I   (DAY
        TAD     TEMP            /GET THE MONTH
        CLL RTR
        RTR
        AND     (36
        TAD     (MONTHS-3
        DCA     X10
        TAD I   X10
        DCA I   (MONTH
        TAD I   X10
        DCA I   (MONTH+1
        JMP I   (PAJE           /WE GOT THE DATE
LSTFIL, 7605
FILLST, DEV1CE
OFSIZE, -5
YRTEMP, 0
TEMP1,  0
\f       PAGE
PAJE,   JMP I   (PRHDR          /PRINT THE FIRST HEADING
        CLL CML RTL             /INITIALIZE LINE NUMBER
        DCA     LINENO
        DCA     TABCNT          /**
RDLUPE, TAD     (SEVCHR-1       /SEVEN CHAR BUFFER
        DCA     X10
        TAD     (-6
        DCA     NCHARS
RDLOOP, JMS I   (ICHAR
        JMP     RDACHO          /ECHO & IGNORE SHORT LINES
        TAD     (-211           /IS IT A TAB ?
        SZA CLA
        JMP     NOTAB           /NO
        TAD     (-2
        DCA     TABCNT          /SET POINTER TO DO EXTRA SPACES LATER**
        TAD     (240
        DCA I   X10             /DO A TAB
        ISZ     NCHARS
        JMP     .-3
        JMP     WHAT            /GO LOOK AT THE LINE
NOTAB,  TAD     CHAR
        DCA I   X10             /SAVE THE CHAR
        ISZ     NCHARS
        JMP     RDLOOP
WHAT,   TAD     SEVCHR          /IS IT A COMMNET
        TAD     (-303
        SNA CLA
        JMP     NOISN           /YES, NO INTERNAL STMT NUMBER
        TAD     SEVCHR+5        /IS IT A CONTINUATION ?
        TAD     (-240
        SZA CLA
        JMP     NOISN           /YES, NO ISN
        TAD     LINENO          /NEITHER OF THESE
        JMS I   (ONUMBR         /PRINT ISN
        TAD     LINENO          /2.01/ PUT LINE NUM
        7421                    /2.01/ INTO MQ
        CLA                     /2.01/ CLA IF NO EAE
        ISZ     LINENO          /BUMP LINE NUMBER
NOISN,  TAD     (211            /TAB
        JMS I   (OCHAR
        TAD     (SEVCHR-1       /PRINT FIRST SEVEN
        DCA     X10
        TAD     (-6
        DCA     NCHARS
        TAD I   X10
        JMS I   (OCHAR
        ISZ     NCHARS
        JMP     .-3
        TAD     TABCNT          /SEE IF A TAB WAS 1ST
        SMA     CLA             /IF YES,NEED 2 MORE SPACES
        JMP     NOTTAB
        DCA     TABCNT          /WAS A TAB
        TAD     (240
        JMS I   (OCHAR
        TAD     (240
        JMS I   (OCHAR
NOTTAB, JMS I   (ICHAR          /PRINT REST OF LINE
        JMP     ENDLIN
        JMS I   (OCHAR
        JMP     .-3
ENDLIN, JMS I   (CRLF           /END LINE
        JMS I   (ERRCHK         /CHECK ERROR LIST
        JMP     RDLUPE          /DO NEXT LINE
TABCNT, 0

HEADER, TEXT    '        FORTRAN IV  4AAAA    '
        *.-1
DAY,    4040
MONTH,  4040;4040
YEAR,   TEXT    '                PAGE  '
        *.-1
PAGENO, TEXT    'ONE'
        ZBLOCK 7        /V3C ROOM FOR LARGE PAGE NUMBERS
RDACHO, TAD (211
        JMS I (OCHAR
        JMP I (RDECHO
        PAGE
\f       TEXT    "         "
LOS,    TEXT    "ONE      "
NUMS,/  2427;1740;4040
/       2410;2205;0540
/       0617;2522;4040
/       0611;2605;4040
/       2311;3040;4040
/       2305;2605;1640
/       0511;0710;2440
/       1611;1605;4040
/       2405;1640;4040
/       0514;0526;0516
/       2427;0514;2605
        TEXT    "TWO@@@@@"
        TEXT    "THREE@@@"
        TEXT    "FOUR@@@@"
        TEXT    "FIVE@@@@"
        TEXT    "SIX@@@@@"
        TEXT    "SEVEN@@@"
        TEXT    "EIGHT@@@"
        TEXT    "NINE@@@@"
        TEXT    "TEN@@@@@"
        TEXT    "ELEVEN@@"
        TEXT    "TWELVE@@"
        TEXT    "THIRTEEN"
        TEXT    "FOURTEEN"
        TEXT    "FIFTEEN@"
        TEXT    "SIXTEEN@"
        TEXT    "SEVENTEEN"
        TEXT    "EIGHTEEN"
        TEXT    "NINETEEN"
HIS,    TEXT    " TWENTY "
        *.-1
        TEXT    " THIRTY "
        *.-1
        TEXT    "  FORTY "
        *.-1
        TEXT    "  FIFTY "
        *.-1
        TEXT    "  SIXTY "
        *.-1
        TEXT    "SEVENTY "
        *.-1
        TEXT    " EIGHTY "
        *.-1
        TEXT    " NINETY "
        *.-1
        TEXT    "HUNDRED "
        *.-1
DAYS,  4061;4062;4063;4064;4065;4066;4067;4070;4071
        6160;6161;6162;6163;6164;6165;6166;6167;6170;6171
        6260;6261;6262;6263;6264;6265;6266;6267;6270;6271
        6360;6361
MONTHS, 5512;0116               /-JAN
        5506;0502               /-FEB
        5515;0122               /-MAR
        5501;2022               /-APR
        5515;0131               /-MAY
        5512;2516               /-JUN
        5512;2514               /-JUL
        5501;2507               /-AUG
        5523;0520               /-SEP
        5517;0324               /-OCT
        5516;1726               /-NOV
        5504;0503               /-DEC
        IFZERO .&100    <PAGE>
\fENDX,  TAD     (-601           /2.02/ CLEAR END OF BUFFER
        DCA     LINENO          /2.01/ FOR TV: REASONS
        TAD     X232            /2.01/ OUTPUT ^Z
        JMS I   (OCHAR          /2.01/
        ISZ     LINENO          /2.01/
        JMP     .-3             /2.01/
        CIF     10              /CLOSE THE OUTPUT FILE
        TAD     DEV1CE
        JMS I   (200
        4
        DEV1CE+1
FILSIZ, 0
        JMP     (OFOO3
        CDF     10              /LOOK AT OPTIONS
        TAD I   X7643
        CDF
M70,    SPA CLA
        JMP I   (7605           //A MEANS DON'T CHAIN TO RALF
        CIF CDF 10
        TAD     FILDEV          /SET UP RALF INPUT LIST
        DCA I   (7617           /FILE SIZE AND DEVICE CODE
        ISZ     (7617
        TAD     FILBLK          /FILE START
        DCA I   (7617
        ISZ     (7617           /ZERO END OF LIST
        DCA I   (7617
        TAD I   X7643           /IS IT /F (FULL LIST) ?
        AND     (100
        CIF     0
        SZA CLA                 /**
        JMP     LISTIT
        CIF     10
        TAD I   (7644
        AND     (20             /LET /T SWITCH THRU ALSO
        SNA CLA
        DCA I   (7605           /NO, INHIBIT RALF LISTING
LISTIT, CIF     10
        CLA IAC
        CDF
        JMS I   (200            /LOOKUP RALF.SV
        2
        RALFNM
X7643,  7643
        JMP     (OFOO3
        TAD     .-3
        DCA     .+4
        CIF     10              /CHAIN TO RALF
        JMS I   (200
        6
X232,   232
NCNT,   0
ONUMBR, 0
        DCA     TEMP            /OUTPUT ISN IN OCTAL
        TAD     (-4
        DCA     NCNT
OLOOP,  TAD     TEMP
        CLL RTL                 /ANYONE WHO CAN'T FOLLOW THIS
        RAL                     /SHOULDN'T BE A PROGRAMMER
        DCA     TEMP
        TAD     TEMP
        RAL
        AND     (7
        TAD     (260
        JMS I   (OCHAR
        ISZ     NCNT
        JMP     OLOOP
        JMP I   ONUMBR
CONVRT, 0                       /CONVERT TO ASCII AND PRINT
        AND     (77
        SZA
        TAD     (-40
        SPA
        TAD     (100
        TAD     (240
        JMS I   (OCHAR
        JMP I   CONVRT
LINECT, -1                      /EJECT FIRST TIME
CRLF,   PAJE+1
        TAD     (215            /CR LF
        JMS I   (OCHAR
        TAD     (212
        JMS I   (OCHAR
        ISZ     LINECT
        JMP I   CRLF
        TAD     (214
        JMS I   (OCHAR
PRHDR,  TAD     M70             /RESET COUNT
        DCA     LINECT
        TAD     (HEADER         /COPY HEADER OUT
        DCA     TEMP
OHDR,   TAD I   TEMP
        CLL RTR
        CLL RTR
        CLL RTR
        JMS     CONVRT
        TAD I   TEMP
        JMS     CONVRT
        TAD I   TEMP            /END YET ?
        ISZ     TEMP
        AND     (77
        SZA CLA
        JMP     OHDR
        TAD     (215            /V3C SKIP EXTRA LINE AFTER TITLE
        JMS I   (OCHAR
        TAD     (212            /V3C
        JMS I   (OCHAR          /FOR CENTRONICS
        JMP     PUTNUM          /GET NEW PAGE NUMBER
\f/ OS/8 FILE INPUT ROUTINES
        PAGE
ICHAR,  0                       /READ CHAR FROM INPUT FILE
        ISZ     INJMP           /BUMP THREE WAY UNPACK SWITCH
        ISZ     INCHCT
INJMPP, JMP     INJMP
        TAD     INEOF           /DID LAST READ YEILD END OF FILE ?
        SNA CLA
        JMP     INGBUF          /NO, DO ANOTHER READ
GETNEW, JMS     INNEWF          /OPEN A NEW INPUT FILE
        JMP I   (ENDX           /NO FILE TO OPEN
INGBUF, TAD     INCTR           /BUMP RECORD COUNTER
        CLL IAC
        SNL
        DCA     INCTR           /RESTORE IF IT HASN'T OVERFLOWED
        SZL
        ISZ     INEOF           /SET END OF FILE SWITCH
        JMS I   INHNDL          /DO THE READ
INCALL, 200
INBUFP, INBUF
INREC,  0
        JMP     INERR           /HANDLER ERROR
INBREC, ISZ     INREC           /BUMP RECORD NUMBER
        TAD     (-601           /SET CHAR COUNT
        DCA     INCHCT
        TAD     INJMPP          /RESET THREE WAY JUMP SWITCH
        DCA     INJMP
        TAD     INBUFP          /RESET BUFFER POINTER
        DCA     INPTR
        JMP     ICHAR+1         /GO AGAIN
INERR,  ISZ     INEOF           /EITHER EOF OR BADDIE
        SMA CLA
        JMP     INBREC          /END OF FILE, DO NEXT FILE
        JMP     OFOO3
INJMP,  HLT                     /3 WAY CHARACTER UUPACK SWITCH
        JMP     ICHAR1
        JMP     ICHAR2
ICHAR3, TAD     INJMPP          /RESET JUMP SWITCH
        DCA     INJMP
        TAD I   INPTR
        AND     (7400           /COMBINE THE HIGH ORDER BITS
        CLL RTR                 /OF THE TWO WORDS
        RTR
        TAD     INTMP           /TO FORM THE THIRD CHAR
        RTR
        RTR
        ISZ     INPTR           /BUMP WORD POINTER
        JMP     ICHAR1+1        /DO SOME COMMON STUFF
ICHAR2, TAD I   INPTR           /SAVE THE HIGH ORDER BITS
        AND     (7400
        DCA     INTMP           /FOR THE THIRD CHAR
        ISZ     INPTR           /GO TO THE SECOND WORD
ICHAR1, TAD I   INPTR           /GET THE LOW 8 BITS
        AND     (377            /AND I MEAN ONLY 8 !!
        DCA     CHAR
        TAD     CHAR
        TAD     (-232           /IS IT ^Z (END OF FILE)
        SNA
        JMP     GETNEW          /YES, LOOK FOR THE NEXT FILE
        TAD     (232-212
        SNA
        JMP     ICHAR+1         /IGNORE LINE FEEDS
        TAD     (212-215
        SNA
        JMP I   ICHAR           /RETURN ON CARRIAGE RETURN
        IAC
        SNA CLA
        JMP     ICHAR+1         /IGNORE FORM FEEDS
        TAD     CHAR
        ISZ     ICHAR
        JMP I   ICHAR           /RETURN TO THE CALLING WORLD
INTMP,  0
INFPTR, 7617                    /POINTER TO INPUT FILE LIST
INEOF,  1
INCHCT,
INNEWF, -1                      /FETCH HANDLER FOR NEXT FILE
        TAD     (INDEVH+1       /THIS IS WHERE IT GOES
        DCA     INHNDL
        CDF     10
        TAD I   INFPTR          /GET NEXT INPUT FILE INFO
        CDF
        SNA
        JMP I   INNEWF          /NO MORE FILES
        CIF     10
        JMS I   INCALL          /CALL MONITOR
        1                       /FETCH HANDLER
INHNDL, 0                       /ENTRY ADDR GOES HERE
        JMP     OFOO3
        CDF     10
        TAD I   INFPTR          /GET LENGTH
        AND     (7760
        SZA                     /A ZERO HERE MEANS >=256 BLOCKS
        TAD     (17             /PUT IN SOME MORE BITS
        CLL CML RTR
        RTR
        DCA     INCTR           /STORE LENGTH OF FILE
        ISZ     INFPTR
        TAD I   INFPTR          /GET STARTING RECORD NUMBER
        DCA     INREC
        ISZ     INFPTR
        DCA     INEOF           /CLEAR EOF FLAG
        ISZ     INNEWF
        CDF
        JMP I   INNEWF
INCTR,  0
INPTR,  0
/PUTNUM,        TAD     (PAGENO-1       /COPY THE NEW NUMBER
/       DCA     X10
/       TAD I   NUM
/       ISZ     NUM
/       DCA I   X10
/       TAD I   NUM
/       ISZ     NUM
/       DCA I   X10
/       TAD I   NUM
/       ISZ     NUM
/       DCA I   X10
/       JMP     CRLF+1
RDECHO,                 /KEEP LINES WITH L.T. 6 CHARS OUT OF ISN COLUMN
        TAD     (SEVCHR-1
        DCA     X12
RDECLP, TAD     X12
        CIA
        TAD     X10
        SNA CLA
        JMP     ENDLIN  /ONLY ECHO WHAT YOU READ
        TAD I   X12
        JMS I   (OCHAR
        JMP     RDECLP
\f       PAGE
OUDUMP, 0                       /BUMP THE DUFFER
        TAD     OSIZE           /ANY ROOM LEFT ?
        IAC
        SNA
        JMP     OFOO3
        DCA     OSIZE           /YES, ITS OK
        JMS I   DEVH            /WRITE
        4200                    /CONTROL WORD
        OUBUF                   /BUFFER POINTER
OBLOCK, 0                       /BLOCK NUMBER
        JMP     OFOO3
        ISZ     OBLOCK          /INCREMENT BLOCK NUMBER
        ISZ     FILSIZ          /AND FILE SIZE
        TAD     OBLOCK-1        /SET BUFFER POINTER
        DCA     OUPTR
        TAD     (-200           /SET DOUBLE WORD COUNT
        DCA     OUWDCT
        JMP I   OUDUMP
OCHAR,  0                       /OUTPUT A CHAR TO THE RALF INPUT FILE
        AND     (377
        DCA     OUTEMP          /SAVE CHAR
        KSF                     /^C TEST
        JMP     NOSTOP
        KRB
        AND     (177
        TAD     (-3
        SNA CLA
        JMP I   (7605           /YES
NOSTOP, ISZ     OUJUMP          /BUMP 3 WAY SWITCH
OUJUMP, JMP     .
        JMP     CHAR1
        JMP     CHAR2
        TAD     OUTEMP          /HIGH FOUR BITS GO INTO
        CLL RTL                 /THE HIGH ORDER BITS OF THE
        RTL                     /FIRST WORD OF THE TWO WORD PAIR
        AND     (7400           /SEE NOTE * BELOW
        TAD I   OUPOLD          /COMBINE WITH OTHER BITS
        DCA I   OUPOLD
        TAD     OUTEMP          /THE OTHER FOUR BITS OF THIS CHAR
        CLL RTR                 /GO INTO THE HIGH ORDER FOUR
        RTR                     /BITS OF THE SECOND WORD OF THE PAIR
        RAR
        AND     (7400
        TAD I   OUPTR
        DCA I   OUPTR
        TAD     OUJMP           /RESET 3 WAY BRANCH
        DCA     OUJUMP
        ISZ     OUPTR           /BUMP BUFFER POINTER
        ISZ     OUWDCT          /AND DOUBLE WORD COUNTER
        JMP I   OCHAR           /BUFFER NOT FULL
        JMS     OUDUMP          /DUMP IT
        JMP I   OCHAR
CHAR2,  TAD     OUPTR           /SAVE FIRST WORD POINTER
        DCA     OUPOLD
        ISZ     OUPTR           /GO TO SECOND WORD
CHAR1,  TAD     OUTEMP          /STORE CHAR 1 OR 2
        DCA I   OUPTR
        JMP I   OCHAR
OUTEMP, 0
OUPOLD, 0
OUPTR,  OUBUF
OUJMP,  JMP     OUJUMP
OUWDCT, -200
OSIZE,  0
ERRPTR, 5000
ERRCHK, 0
        CDF     10
        TAD I   ERRPTR          /ANY ERRORS FOR THIS LINE
        CDF
        CMA
        TAD     LINENO
        SZA CLA
        JMP I   ERRCHK          /NO
        CLL CMA RAL             /BACK UP POINTER
        TAD     ERRPTR
        DCA     ERRPTR
        TAD     ERRPTR
        IAC
        DCA     TEMP
        CDF     10
        TAD I   TEMP            /GET CODE
        CDF
        CIA
        DCA     TEMP            /SAVE NEGATIVE
        TAD     (ERRLST-1
        DCA     X10
FIND,   TAD I   X10             /LOOK FOR ERROR MESSAGE
        SZA
        TAD     TEMP
        SNA CLA
        JMP     .+3
        ISZ     X10
        JMP     FIND            /SKIP POINTER WORD
        CLA CMA
        TAD I   X10
        DCA     X10             /POINTER TO MESSAGE
PMLOOP, TAD I   X10             /GET TWO CHARS
        DCA     TEMP
        TAD     TEMP
        RTR
        RTR
        RTR
        JMS     CONVRT          /PRINT FIRST
        TAD     TEMP
        JMS     CONVRT          /PRINT SECOND
        TAD     TEMP
        AND     (77             /END OF MESSAGE ?
        SZA CLA
        JMP     PMLOOP          /NO, LOOP
        JMS I   (CRLF
        JMP     ERRCHK+1        /SEE IF ANY MORE FOR THIS LINE
RALFNM, FILENAME RALF.SV
\f       PAGE
X304,   304
X305,   305
X7605,  7605
OFOO3,  TAD     X304            /FATAL ERROR IN PASS 3
        JMS     TTY
        TAD     X305
        JMS     TTY
        JMP I   X7605
TTY,    0                       /PRINT ON TTY
        TLS
        TSF
        JMP     .-1
        CLA
        JMP I   TTY
/ERROR MESSAGES
ERRLST, 0724;GT
        1124;IT
        0504;ED
        2227;RW
        0317;CO
        0530;EX
        2123;QS
        2114;QL
        1106;IF
        0417;DO
        2316;SN
        2404;TD
        0204;BD
        2224;RT
        2204;RD
        2324;ST
        0314;CL
        1517;MO
        1017;HO
        1515;MM
        2323;SS
        1720;OP
        0123;AS
        0401;DA
        0410;DH
        1514;ML
        0405;DE
        0223;BS
        1424;LT
        1105;IE
        2010;PH
        1513;MK
        1724;OT
        2004;PD
        1524;MT
        0726;GV
        1411;LI
        0420;DP
        0414;DL
        0101;AA
        2306;SF
        0406;DF
        1111;II
        0;SYSERR
SYSERR, TEXT    'UNDEFINED ERROR'
II,     TEXT    'ILLEGAL USE OF IF'
GT,     TEXT    'BAD GOTO STATEMENT'
RW,     TEXT    'BAD READ OR WRITE STATEMENT'
CO,     TEXT    'ARGS IN COMMON OR VAR IN TWO COMMONS OR SYNTAX BAD'
IT,     TEXT    'BAD IO LIST ELEMENT'
EX,     TEXT    'BAD EXTERNAL STMT'
QS,     TEXT    'SYNTAX ERROR IN EQUIVALENCE'
QL,     TEXT    'VARIABLE IS EQUIVALENCED MORE THAN ONCE'
IF,     TEXT    'THIS KIND OF STATEMENT NOT LEGAL AFTER LOGICAL IF'
DO,     TEXT    'BAD SYNTAX IN DO OR IMPLIED DO'
SN,     TEXT    'NOT LEGAL AS SUBROUTINE NAME'
TD,     TEXT    'SYNTAX ERROR IN TYPE STATEMENT'
BD,     TEXT    'DIMENSIONS TOO BIG, OR SYNTAX ERROR IN DIMENSION LIST'
ED,     TEXT    'ILLEGAL AS DO ENDING STATEMENT'
RT,     TEXT    'ATTEMPT TO RE-TYPE A VARIABLE'
RD,     TEXT    'ATTEMPT TO RE-DIMENSION A VARIABLE'
ST,     TEXT    'INTERNAL COMPILER ABORT NUMBER ONE'
CL,     TEXT    'ERROR IN COMPLEX LITERAL'
MO,     TEXT    'OPERAND EXPECTED, NONE PRESENT'
HO,     TEXT    'HOLLERITH COUNT WRONG, OR MISSING QUOTES'
MM,     TEXT    'MISMATCHED PARENTHESIS'
SS,     TEXT    'SUBSCRIPT OR ARGUMENT LIST ERROR'
OP,     TEXT    'ILLEGAL OPERATOR'
AS,     TEXT    'ASSIGN ???'
DA,     TEXT    'DATA STATEMENT ?'
DH,     TEXT    'HOLLERITH COUNT OR QUOTE ERROR IN DATA STATEMENT'
ML,     TEXT    'THIS LINE NUMBER IS ALREADY DEFINED'
DE,     TEXT    "WRONG WAY TO END A DO LOOP"
BS,     TEXT    'ILLEGAL IN BLOCK DATA'
LT,     TEXT    'LINE TOO BIG'
IE,     TEXT    'INPUT FILE ERROR, TAKEN AS END STATEMENT'
PH,     TEXT    'THIS FUNCTION / SUBROUTINE STATEMENT IS UNACCEPTABLE'
MK,     TEXT    'YOU MISPELED A KEYWURD'
OT,     TEXT    'ILLEGAL OPERAND TYPE FOR THIS OPERATOR'
PD,     TEXT    'INTERNAL COMPILER ABORT NUMBER TWO'
MT,     TEXT    "ILLEGAL VARIABLE TYPE MIXING"
GV,     TEXT    'VARIABLE IN ASSIGNED OR COMPUTED GOTO MUST BE INTEGER OR REAL'
LI,     TEXT    'EXPRESSION IN LOGICAL IF IS NOT TYPED LOGICAL'
DP,     TEXT    'DO PARAMETERS MUST BE INTEGER OR REAL'
DL,     TEXT    "YOUR DATA AND VARIABLE LISTS ARE OF DIFFERENT LENGTHS"
AA,     TEXT    'SUBROUTINES MAY ONLY HAVE SIX ARGUMENTS THAT ARE DIMENSIONED'
SF,     TEXT    'BAD STATEMENT FUNCTION'
DF,     TEXT    'BAD DEFINE FILE'
\fPAGEN, 1

PUTNUM, ISZ PAGEN       /BUMP PAGE NUMBER
        TAD PAGEN
        TAD (-24        /LT 20?
        SMA CLA
        JMP OVER19      /YES
        TAD (-5         /NO
        JMS MOVE        /MOVE IN NUMBER
NUM,    0
        PAGENO-1
        TAD NUM
        TAD (5
        DCA NUM         /PT TO NEXT ONE
        JMP I (CRLF+1

TENS,   0
ONES,   0
KNT,    0

OVER19, DCA TENS        /CONVERT
        TAD PAGEN       /PAGE NUMBER TO ONES AND TENS
O1,     TAD (-12        /DIVIDE BY TEN
        SPA
        JMP .+3
        ISZ TENS
        JMP O1
        TAD (12
        DCA ONES
        TAD TENS
        CLL RTL
        TAD (HIS-10-1
        DCA HIP         /POINT TO HIGH PART
        TAD ONES
        CLL RTL
        TAD ONES
        TAD (LOS-5-1
        DCA LOP
        TAD (-4
        JMS MOVE
HIP,    0
        PAGENO-1
        TAD (-5
        JMS MOVE
LOP,    0
        PAGENO+4-1
        JMP I (CRLF+1
\fMOVE,  0
        DCA KNT
        TAD I MOVE
        DCA X11
        ISZ MOVE
        TAD I MOVE
        DCA X12
        ISZ MOVE
        TAD I X11
        DCA I X12
        ISZ KNT
        JMP .-3
        JMP I MOVE
        $
\f