File: FPATCH.07 of Tape: OS8/OS8-V3/dec-s8-osysb-a-ua3
(Source file text)
/OS8 FORTRAN II COMPILER OVERLAY *** FPATCH.04 *** / / / / / / / / / / / / /COPYRIGHT (C) 1974 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 MANUAL. / /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. / / / / / / / / FIELD 0 JSBITS=7746 MOFILE=7600 MPARAM=7643 LLUNCH=7001 /TAKE OUT WHEN MERGING WITH COMPILER DO=7173 /" ELIST=1162 /" EMSG1=1270 /" EMSG14=1520 /" FLST=242 /" FORST=5362 /" FPROP=144 /" GOOON=5455 /" KOUNT=113 /" LPTRIN=545 /" LPUNCH=5333 /" LTTYPE=3372 /" L75=75 /" OSTOP=4052 /" XFINI=5354 /" *200 START, CLA CMA DCA FCHFLG CIF 10 JMS I (7700 10 /ESCAPE ISZ FCHFLG JMP .+5 CIF 10 JMS I (200 5 /COMMAND DECODE 0624 /.FT ASSUMED EXTENSION CLA IAC CIF 10 JMS I (200 4 /CLOSE OPERATOR USED AS DELETE OUSNAME /DELETE FORTRN.TM IF IT EXISTS 0 CLA /IT DIDN'T EXIST CLA IAC /ENTER A FILE ON "SYS" - MAXIMUM SIZE CIF 10 JMS I (200 3 /ENTER OUSREC, OUSNAME HOLSIZ, 0 JMP I (OUERR /WHATS GOING ON HERE? CLA IAC /DEVICE "SYS" CIF 10 JMS I (200 2 PTSABR, SABR FCHFLG, 0 /USELESS LENGTH WORD JMP I (BIGGIE TAD PTSABR DCA I (CLSABR TAD OUSREC DCA I (OUTREC TAD HOLSIZ DCA I (OURCNT TAD (1000 TAD I (JSBITS DCA I (JSBITS /SET "UNSTARTABLE" STATUS BIT JMS I (FNEWF /INITIALIZE FIRST INPUT FILE WHILE I/O MON IS IN CORE CDF 10 TAD OUSREC DCA I (7620 CLA IAC DCA I (7617 CLA CLL CML RTL AND I (MPARAM TAD I (MOFILE+5 SNA CLA DCA I (FLST TAD I (7600 SNA CLA TAD I (MPARAM AND (41 SNA CLA /DID HE SPECIFY A "L" OR "G" OPTION WITHOUT A JMP FCDF0-2 /RELOCATABLE OUTPUT FILE? FTADNM, TAD BDFALT /YES - GIVE HIM ONE DCA I B7600 /NAMED "FORTRL.TM" ISZ FTADNM ISZ B7600 ISZ B7773 JMP FTADNM CLA CMA /SET OPTIONS Y,Z AND 0-9; TELLS DCA I (7645 /SABR IT WAS CHAINED TO BY FORT FCDF0, CDF 0 JMP I (1003 /START COMPILATION BDFALT, 1 /DEVICE "SYS" TEXT /FORTRLTM/ B7600, 7600 B7773, 7773 /ADDITIONS TO FORTRAN ERROR MESSAGES *ELIST+1 NUMSG1 *EMSG1-2 -ERR61-1; EMSG15 -ERR62-1; EMSG16 -ERR63-1; EMSG17 -ERR64-1; EMSG20 0 ; EMSG14 /DUMMY PAGES TO CONSOLIDATE CORE IMAGE *1600 0 *2000 0 *2400 0 *3000 0 *5600 0 *5400 FNEWF, 0 CDF 10 TAD I FILPTR SNA JMP EOFERR /END OF INPUT REACHED BEFORE END STATEMENT DCA INWCNT TAD I FILPTR AND (7760 SZA TAD (17 CLL CML RTR RTR DCA INRCNT ISZ FILPTR TAD I FILPTR DCA INREC ISZ FILPTR TAD (5001 /FORTRAN ALLOWS TWO-PAGE HANDLERS DCA INHNDL TAD INWCNT CDF 0 CIF 10 JMS I (200 1 /ASSIGN AND FETCH HANDLER INHNDL, 5000 /LOCATIONS 5000-5377 ARE FREE JMP IOERR /SOMETHINGS SCREWY CLA CMA DCA INWCNT DCA INEOF JMS MOUCOR JMP I FNEWF FILPTR, 7617 GETCH, 0 KSF JMP .+5 KRS TAD (-203 SNA CLA JMP I (7600 ISZ JMPGET ISZ INWCNT JMPG, JMP JMPGET TAD INEOF SNA CLA JMP JUSTRD GETNXT, CIF 10 JMS I G7700 10 /ESCAPE JMS FNEWF JUSTRD, JMS I INHNDL /INHNDL CONTAINS LOCN OF DEVICE HANDLER 0200 /READ 2 HALF-RECORDS INTO FIELD 0 INBFPT, INBUF INREC, 0 JMP RERROR ISZ INREC ISZ INRCNT SKP ENDFIL, ISZ INEOF TAD (-601 DCA INWCNT TAD JMPG DCA JMPGET TAD INBFPT DCA INPTR JMP GETCH+1 JMPGET, JMP . JMP INCHR1 JMP INCHR2 INCHR3, TAD JMPG DCA JMPGET TAD I INPTR AND (7400 CLL RTR RTR TAD INTMP RTR RTR ISZ INPTR JMP GCHCOM INCHR2, TAD I INPTR AND (7400 DCA INTMP ISZ INPTR INCHR1, TAD I INPTR GCHCOM, AND (377 TAD (-232 SNA JMP GETNXT TAD (232 CIF 10 ISZ GETCH JMP I GETCH RERROR, SMA CLA G7700=RERROR JMP ENDFIL IOERR, JMS I (SFATAL CIF 10 ERR62, JMS I (LLUNCH INPTR, 0 INWCNT, 0 INTMP, 0 INRCNT, 0 INEOF, 0 EOFERR, JMS MOUCOR /KICK MONITOR OUT JMS I (SFATAL CIF 10 ERR61, JMS I (LLUNCH MOUCOR, 0 CDF 0 CIF 10 JMS I (200 11 JMP I MOUCOR *3200 P377, 377 P7400, 7400 /WARNING ***DO NOT MOVE THIS*** PUTCH, 0 DCA PUTMP RAL DCA PUTLNK PUTCHX, ISZ JMPPUT ISZ OUWDCT JMPP, JMP JMPPUT CLA CLL CML RTL TAD OURCNT SZL JMP OUERR+1 DCA OURCNT ISZ CLOSCT ISZ CLOSCT JMS I (7607 4400 OUBFPT, OUBUF OUTREC, 0 JMP I (IOERR ISZ OUTREC ISZ OUTREC TAD (-1401 DCA OUWDCT TAD OUBFPT DCA OUPTR TAD JMPP DCA JMPPUT JMP PUTCHX JMPPUT, JMP . JMP PUTCH1 JMP PUTCH2 PUTCH3, TAD PUTMP RTL RTL DCA PUTMP TAD JMPP DCA JMPPUT TAD PUTMP AND P7400 TAD I OUPOLD DCA I OUPOLD TAD PUTMP RTL RTL P201, AND P7400 TAD I OUPTR DCA I OUPTR ISZ OUPTR JMP PCHCOM PUTCH2, TAD OUPTR DCA OUPOLD ISZ OUPTR PUTCH1, TAD PUTMP P200, AND P377 DCA I OUPTR PCHCOM, CIF 10 TAD PUTLNK CLL RAR JMP I PUTCH EOFORT, SZA CLA /ANY ERRORS? JMP I SF7600 /YES, DO NOT ASSEMBLE DCA PCHCOM TAD (232 JMS PUTCH TAD OUWDCT TAD (1400 SZA CLA JMP .-5 /FILL BUFFER WITH ^Z TAD I (JSBITS RAR CLL CML RAL DCA I (JSBITS /NO NEED TO SAVE CORE ON THIS MONITOR CALL CIF 10 JMS I (7700 10 /ESCAPE CLA IAC /DEVICE "SYS" CIF 10 JMS I P200 4 /CLOSE OUSNAM CLOSCT, 0 /CLOSING LENGTH JMP OUERR-3 CIF 10 JMS I P200 6 /RUN CLSABR, 0 BIGGIE, JMS I (MOUCOR JMS SFATAL CIF 10 ERR63, JMS I (LLUNCH CLA CLL CMA RTL AND I (JSBITS DCA I (JSBITS /WHOOPS - GUESS WE SHOULD RESTORE CORE AFTER ALL OUERR, JMS I (MOUCOR JMS SFATAL CIF 10 ERR64, JMS I (LLUNCH INBUF=1600 OUBUF=3600 OURCNT, 0 OUPTR, OUBUF OUWDCT, -1401 PUTMP, 0 OUPOLD, 0 SFATAL, 0 PUTLNK=SFATAL SF7600, 7600 /CLEAR AC CDF 10 TAD SCDIF0 DCA I (177 TAD (5601 DCA I P200 TAD SF7600 DCA I P201 SCDIF0, CDF CIF 0 JMP I SFATAL *2200 /CANNOT GO PAST 2373 SABR, TEXT /SABR/ TEXT /SV/ OUSNAM, TEXT /FORTRNTM/ NUMSG1, TEXT /ILLEGAL CONTINUATION/ EMSG15, TEXT /NO END STATEMENT/ EMSG16, TEXT #I/O ERROR# EMSG17, TEXT /SABR.SV NOT FOUND/ EMSG20, TEXT /NO ROOM FOR OUTPUT/ FIELD 1 /THESE ARE THE PATCHES OVER THE COMPILER. *FORST /HEADER PRINTER NOP NOP NOP *FORST+5 /LEADER OUTPUT CLA CLL CMA RTL /3 CHARACTERS OF LEADER *LPTRIN+1 /HIGH-SPEED READER ROUTINE CIF 0 JMS I .+1 GETCH *OSTOP+1 JMS I FPROP /PUNCH 'CALL 0,EXIT' 6253 JMP I OSTOP *LPUNCH+1 /PUNCH ROUTINE CIF 0 JMS I .+2 CLA SKP PUTCH *XFINI-3 /TRAILER PRINTER CLA CLL CMA RTL /3 CHARACTERS OF TRAILER *XFINI-1 /ENDING SEQUENCE CDF CIF 0 TAD L75 /PICK UP ERROR FLAG JMP I .+1 EOFORT *GOOON+4 /TRAILER AFTER "END" STATEMENT CLA CLL CMA RTL /3 CHARS ETC. *LTTYPE+1 /REVERSE TTY WAIT MODE TLS TSF JMP .-1 $