/ PS/8 FORTRAN COMPILER OVERLAY	*** FPATCH.05 ***

/		OCTOBER 28, 1970

/COPYRIGHT 1970		DIGITAL EQUIPMENT CORP.
/			MAYNARD, MASS.

	FIELD 0
	JSBITS=7746
	MOFILE=7600
	MPARAM=7643
	LLUNCH=7001	/TAKE OUT WHEN MERGING WITH COMPILER
	DO=7174		/"
	ELIST=1162	/"
	EMSG1=1266	/"
	EMSG14=1514	/"
	FLST=242	/"
	FORST=5362	/"
	FPROP=144	/"
	GOOON=5455	/"
	KOUNT=113	/"
	LPTRIN=547	/"
	LPUNCH=5333	/"
	LTTYPE=7114	/"
	L75=75		/"
	OSTOP=4052	/"
	XFINI=5354	/"
	*200
START,	CIF 10
	JMS I (7700
	10	/ESCAPE
	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
	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	/RELOCATABLE OUTPUT FILE?
FTADNM,	TAD BDFALT	/YES - GIVE HIM ONE
	DCA I B7600	/NAMED "FORTRL.TM"
	ISZ FTADNM
	ISZ B7600
	ISZ B7773
	JMP FTADNM
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.

	*LLUNCH+10	/PATCH IN ERROR ROUTINE TO CURE INFINITE PRINTOUT
	CLA CLL CMA RAL
	TAD KOUNT
	JMP EPATCH
ECONT=.

	*LTTYPE+1	/REVERSE TTY WAIT MODE
	TLS
	TSF
	JMP .-1

	*DO+1	/CONTINUATION OF ERROR ROUTINE PATCH
EPATCH,	SMA	/IF IT'S NEGATIVE
	CMA	/DON'T COMPLEMENT IT
	JMP ECONT	/RETURN TO ROUTINE
	$