--- /dev/null
+/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
projects / pdp8.git / blobdiff