X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fpass3.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fpass3.pa;h=62dac3555daa5b5d58fccf1fb7155e8349e388ee;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/fortran/all/pass3.pa b/sw/os8/v3d/sources/fortran/all/pass3.pa new file mode 100644 index 0000000..62dac35 --- /dev/null +++ b/sw/os8/v3d/sources/fortran/all/pass3.pa @@ -0,0 +1,816 @@ +/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 + / 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 +/ +/ + /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 + 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 + 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 + ENDX, 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 + / 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 + 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 + 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' + PAGEN, 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 + MOVE, 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 + $ +