Add README.md

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape2 / SPATCH.PA

/OS8 SABR ASSEMBLER OVERLAY 		***SPATCH.07***
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1974,1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
\f/
/FIXES TO SPATCH FOR V18	J.K.	1975
/
/ .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER
/	BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED
/	TO FROM FORT
/ .ALLOW TWO PAGE OUTPUT HANDLER
/
/
/SABR ASSEMBLER, LIKE 8K FORTRAN UNDER OS/8, RUNS
/IN FIELD 1 WITH ITS TABLES IN FIELD 0.
/	OCTOBER 26,1971
/
/MODIFIED SO THAT SABR WILL, AT RUN TIME, DETERMINE IF THE USER
/SPECIFIED I/O DEVICES REQUIRE TWO PAGE HANDLERS, AND IF SO
/SABR WILL ALLOCATE SPACE FOR THEM.  ALSO IF ALL I/O IS DONE VIA THE
/SYSTEM DEVICE, SABR WILL NOT RESERVE ANY SPACE FOR I/O HANDLERS
/SPACE FOR TWO PAGE HANDLERS IS MADE BY SHRINKING THE INPUT
/BUFFERS-CURRENTLY 4 PAGES-TO 2 PAGES.  B.CLOGHER  10/71
/

	FIELD 0
	SDVHND=772
	MPARAM=7643
	DVHNDL=7647
	JSBITS=7746
	MOFILE=7600
	CORE1=6200	/UPPER CORE LIMIT OF OCCURRENCE TABLE(VARIES WITH I/O HANDLERS NEEDED!!)
	SABR=201	/SABR V17 FIRST LOC AFTER "JMS I IOINIT"
	PASS=110	/SABR V17
	SERROR=JMS I 177/SABR V17
	ERRE=2701	/SABR V17
	PRSYMP=41	/SABR V17
	TEM1=123	/SABR V17
	TEM2=124	/"
	M4=3704		/"
	CLOC1=6		/"
	CLOC2=3162	/"
	CLOC3=4356	/"
	CTYPE=23	/"
	CRLF=24
	CHR=61		/"
	SYMBOL=3	/"
	LLFS=5364	/"
	LINE=67		/"
	L64=4772	/"
	TYPE=54		/"
	PUNCH=42	/"
	INBUF=6200	/6200-7177 OR 6600-7177
	PRJ5=4051
	PRNOP=4136
	PRJ2=4170
	PRS2=4025
	PRS5=4101
\f	*30	/CCL PATCH; GOES HERE AS A HACK
CCLKLG,	TAD	[SKP
	DCA I	[CCLSKP
	CDF	10
	TAD I	[7645
	SMA CLA
	JMP I	[NOTFRT
	TAD I	[7645
	AND	P3777
	DCA I	[7645
	CDF
	JMP I	[SETCOR
P3777,	3777

	*200	/INITIALIZATION - GETS DESTROYED DURING SABR EXECUTION

START,	ISZ I [FSWITC	/SKIPS SINCE FSWITC=-1. ENTRY FROM "R SABR"
FSTART,	JMP CCLKLG	/ENTRY FROM 8K FORTRAN VIA "RUN SABR" MONITOR CALL
	CLA CMA		/USED AS TEM. BY SUBR. DNUM
	DCA I [FSWITC	/USED AS TEM. BY SUBR. DNUM
PTEM1,	CIF 10
	JMS I [7700	/CALL I/O MONITOR
	10		/AND ASK IT TO STICK AROUND
	CIF 10
	JMS I [200
	5		/COMMAND DECODE
	2302		/.SB ASSUMED EXTENSION
NOTFRT,	CDF 10
	TAD I [MPARAM
	AND [100
	CDF 0
	SNA CLA		/IS /F SWITCH ON?
	DCA I [FSWITC	/NO - ZERO OUT FSWITC
	TAD I [JSBITS
	TAD [1000
	DCA I [JSBITS
CCLSKP,	JMP .+5
SETCOR,	ISZ I [FDSW	/SET DELETE SWITCH
	CIF	10
	JMS I	[7700	/CALL I/O MONITOR--LOCK IT IN
	10
	CDF	10
	TAD I	[MOFILE	/CHECK FIRST TWO OUT DEV. SPECS.--NEED 2 PAGE HNDLR?
OUTL,	JMS	DNUM
	JMP	OSYS	/NO OUTPUT OR SYS DEV.
	JMP	TWOPAG	/NEED TWO-PAGE HANDLER
DONE,	TAD I	[MOFILE+5	/1 PAGE HNDLR-LOOK AT 2ND OUT DEV.
	ISZ	CNT	/DONE BOTH?
	JMP	OUTL	/NO-GO ON
	CLA		/YES-
	TAD	PTEM2	/ARE BOTH OUT DEVS. SYS: OR NOT THERE?
	SZA	CLA	/IF SO-ALLOT 0 PAGES FOR OUTPUT HANDLER
	TAD	[-200	/NO-ALLOT 1 PAGE FOR HANDLER
DONE1,	DCA	OPGES	/-SIZE OF OUT HANDLER NEEDED
INLP,	TAD I	TEM	/NOW LOOP THRU 9 POSSIBLE INPUT SPECS.
	JMS	DNUM
	JMP	ISYS	/INPUT NOT THERE OR SYS DEV.
	JMP	TWOPG	/TWO PAGE HANDLER NEEDED
ILP1,	ISZ	TEM	/ONE-MOVE PTR TO NEXT
	ISZ	TEM
	ISZ	CNT1	/DONE ALL 9?
	JMP	INLP	/NO
	TAD	TEM3	/YES-ARE ALL INPUTS FROM SYS OR NOT THERE?
	SZA	CLA	/IF SO-DON'T SAVE ROOM FOR INPUT HANDLER
	TAD	[-200	/NO-NEED ONE PAGE FOR HANDLER
IDONE,	DCA	IPGES	/STORE AS SIZE OF INPUT HANDLER
	TAD	IPGES
	TAD	OPGES
	TAD	[400	/NEED MORE THAN A TOTAL OF 2 PAGES FOR HANDLERS?
	CDF	00	/BACK TO DF 0
	SMA	CLA
	JMP	NOTWO	/NO-GO ON
	DCA I	[INREC1	/YES-ADJUST INPUT ROUTINE FOR ONLY 2 PAGE BUFFERS
	TAD	[200
	DCA I	[INBFPT-1
	DCA I	[INRD1
	DCA I	[INRD1+1
	TAD	[6600	/RESET ADDRESS OF INPUT BUFFER
	DCA I	[INBFPT
	TAD	[400
NOTWO,	TAD	[6200	/RESET UPPER CORE LIM. OF OCCURRANCE TABLE
	TAD	IPGES
	TAD	OPGES
	DCA	[CORE1
	TAD	OPGES
	TAD	[200
	SPA	CLA	/MORE THAN ONE PAGE OUT HNDLR NEEDED?
	IAC		/YES
	TAD	OPGES
	TAD I	[INBFPT	/ADJUST HANDLER FETCH FOR TWO PAGE HANDLER
	CDF	10	/BACK TO DATA FIELD 1
	DCA I	[OUHND
	CMA		/PROPAGATE CHANGES INTO MAIN PART OF SABR
	TAD	[CORE1
	DCA I [CLOC1
	TAD I [CLOC1
	DCA I [CLOC3
	TAD	[CORE1
	DCA I [CLOC2
	TAD	IPGES
	TAD	[200
	SPA	CLA	/MORE THAN ONE PAGE FOR INPUT HNDLR?
	IAC		/YES-ADJUST IN HNDLR FETCH ROUTINE
	TAD I	[CLOC2	/(CONTAINS START ADDRESS OF CORE FOR IN HNDLR.)
	CDF	00
	DCA I	[ADEVN	/STORE FOR HNDLR FETCH ROUTINE
	CDF	10
	JMP I	[LCHK
ISYS,	ISZ	TEM3
IPGES,	0
	JMP	ILP1	/INPUT SPEC. NOT THERE OR SYS DEV.
TWOPG,	TAD	[-200	/INPUT SPEC-NEEDS TWO PAGES
	JMP	IDONE-1	
TWOPAG,	TAD	[-200	/OUT HNDLR NEEDS TWO PAGES
	JMP	DONE1-1
OSYS,	ISZ	PTEM2	/OUT HNDLR NOT NEEDED OR SYS. DEVICE
OPGES,	0
	JMP	DONE
/
/ROUTINE TO CHECK DEVICE SPECS. LEFT BY COMMAND DECODER AND SEE
/IF WE NEED ANY TWO PAGE HANDLERS. ALSO CHECK IF ALL I/O IS FROM
/SYS DEVICE IN WHICH WE DON'T HAVE TO SAVE ROOM FOR ANY HANDLERS
/RETN. TO CALL + 1 IF DON'T NEED ROOM FOR ANY HANDLER
/RETN. TO CALL + 2 IF NEED 2 PAGES FOR HANDLER
/RETN. TO CALL + 3 IF NEED 1 PAGE FOR HANDLER
/
DNUM,	0
	AND	[17	/MASK DEV. #
	DCA	FSTART+1	/STORE
	TAD	FSTART+1
	CLL
	SNA		/ANYTHING THERE?
	JMP I	DNUM	/NO-TREAT LIKE SYS. DEV
	TAD	[DVHNDL-1	/CHECK IF THIS HANDLER CO-RESIDENT WITH SYS.(TD8/E--UNIT 1)
	DCA	FSTART+2
	TAD I	FSTART+2
	TAD	[200
	SZL	CLA	/IS ENTRY PT. ABOVE 7600??
	JMP I	DNUM	/YES-JUST LIKE SYS DEV.
	TAD	FSTART+1
	TAD	[SDVHND-1	/NO-PICK UP TABLE WD WHICH TELLS IF 2 PAGE HNDLR.
	DCA	FSTART+2
	TAD I	FSTART+2
	ISZ	DNUM	/BUMP RETN.
	SMA	CLA	/BIT 0=1? I.E. DOES IT NEED TWO PAGES?
	ISZ	DNUM	/NO-NORMAL RETN. TO CALL+3--NEED 1 PAGE
\f	JMP I	DNUM	/YES-RETN. TO CALL+2--NEED 2 PAGES
TEM3,	-11
CNT,	-2
CNT1,	-11
PTEM2,	-2
TEM,	MOFILE+17
\f*400
LCHK,	TAD I	[MPARAM+1
	AND	(4
	SNA CLA
	ISZ	STSABR
	TAD I [MPARAM+1
	AND [40
	SNA CLA		/IF /S IS ON
	TAD I [MOFILE+5
	SZA CLA		/OR IF THERE IS NO LISTING OUTPUT FILE
	JMP NSPEED
	TAD [PRS5&177+5200	/SPEED UP SYMBOL TABLE SORT
	DCA I [PRJ5
	DCA I [PRNOP
	DCA I [SYMXX	/AND PRINT "U" MESSAGE FOR UNDEFINEDS
	TAD [PRS2-1&177+5200
	DCA I [PRJ2
NSPEED,	CDF 10
	TAD I [MOFILE+4	/GET EXTENSION OF BINARY OUTPUT
	SNA		/IS IT THERE?
	TAD [2214	/NO - SET TO .RL
	DCA I [MOFILE+4
	TAD I [MOFILE+11
	SNA
	TAD [1423	/SIMILIARLY SET LISTING EXTENSION TO .LS
	DCA I [MOFILE+11
	DCA I [OUTINH
	TAD I [MOFILE
	SNA CLA		/BINARY OUTPUT?
	JMP NOBNOT	/NO
	CDF CIF 10
	JMS I [TSTNTR	/YES - OPEN IT
	CDF 10
	JMP YESBOT
NOBNOT,	TAD [MOFILE+1
	DCA I [PFILE
	ISZ I [OUTINH	/INHIBIT OUTPUT
YESBOT,	TAD I [MOFILE+5
	CDF 0
	SZA CLA
	DCA I [LSTFLG
	CDF 10
	TAD I [MPARAM
	AND [41		/"L" OR "G" FLAGS ON?
	CDF 0
	SNA CLA
	JMP NOLOAD
	JMS I [MINCOR
	CLA IAC		/DEVICE "SYS"
	CIF 10
	JMS I [200
	2	/LOOKUP
ALOAD,	LOADER
	0	/LENGTH GOES HERE AND IS IGNORED
	JMP NOLODR	/COULDN'T FIND IT
	TAD ALOAD
	DCA I [LDRBLK
	CDF 10
	TAD I [OUTREC
	CDF 0
	DCA I [REMEMB
NOLOAD,	JMS I [OPENFL	/OPEN FIRST INPUT FILE WHILE MONITOR STILL IN CORE
	CDF CIF 10
	JMP I .+1
STSABR,	SABR	/FIRST LOC IN SABR AFTER "INITIAL DIALOGUE"
NOLODR,	TAD [1200
	JMP I [ERROR
LOADER,	TEXT	/LOADERSV/
\f	*1100	/FILE OPENER - RESIDES IN PART OF THE OLD SABR INPUT BUFFER
O7760,	7760
OPENFL,	0
	CDF 10
	TAD I FILPTR
	SNA	/IS THERE ANOTHER INPUT FILE?
	JMP I (ERROR+1	/ERROR - NO END STATEMENT IN PROGRAM
	DCA OTEMP
	TAD OTEMP
	AND (17		/EXTRACT DEVICE NUMBER
	TAD (DVHNDL-1
	DCA OTEMP2
	TAD I OTEMP2
	DCA OTEMP2
	ISZ FILPTR
	TAD I FILPTR	/GET STARTING BLOCK #
	CDF 0
	DCA I (INREC	/STORE IT AWAY
	ISZ FILPTR
	TAD OTEMP
	AND (7760	/EXTRACT LENGTH
	SZA		/LENGTH OF 256 IMPLIES MAY BE LARGER
	TAD (17
	CLL CML RTR
	RTR		/GET LENGTH AS A NORMAL NEGATIVE NUMBER
	DCA I (INCNT	/STORE THAT AWAY TOO
	TAD OTEMP2
	SZA
	JMP GOTIT
	JMS I (MINCOR	/GET MONITOR
	TAD	ADEVN	/THIS LOC. SET UP BY INITIALIZATION ROUTINE
	DCA ADEVNO
	TAD OTEMP
	CIF 10
	JMS I O200
	1		/ASSIGN
ADEVNO,	5600		/FORCE HANDLER INTO PAGE 5600
	JMP I (DELERR	/GIVE S ERROR
	TAD ADEVNO
GOTIT,	DCA I (INDEV
	JMS I (MOUCOR	/GET MONITOR OUT
	CLA CMA
	DCA I (INCHCT	/FORCE BUFFER LOAD ON FIRST READ
	JMP I OPENFL
OTEMP,	0
OTEMP2,	0
FILPTR,	7617
O200,	200
ADEVN,	0	/SET UP BY INIT. ROUTINE-PAGE ADDR. OF IN HNDLR
\f	*1600
MINCOR,	0
	RDF
	TAD MINCIF
	DCA MINXIT
MINCIF,	CDF CIF 0
	CIF 10
	JMS I SYSTEM
	10	/ESCAPE
	TAD MIN200
	DCA SYSTEM
MINXIT,	0		/RESTORE CALLING FIELDS
	JMP I MINCOR
MOUCOR,	0
	CDF 0
	TAD SYSTEM
E7500,	SMA
	CIF 10
MN7700,	SMA CLA
	JMS I SYSTEM
	11	/GET OUT
	TAD MN7700
	DCA SYSTEM
	JMP I MOUCOR
SYSTEM,	200
MIN200,	200
ERROR,	TAD E7500	/MAKE SABR ERROR "B"
	DCA MINCOR
	JMS MOUCOR	/KICK MONITOR OUT
	CDF CIF 10
	DCA I EPASS	/SET PASS=0 SO ERROR WILL PRINT
	TAD EL64
	DCA I ETYPE
	TAD MINCOR
	JMP I .+1
	ERRE
EPASS,	PASS
EL64,	L64
ETYPE,	TYPE
\f	*7200
SPAUSE,	0		/"PAUSE" STATEMENT PATCH
	TAD FSWITC
	CLL RAL
	TAD I (FILPTR
	DCA I (FILPTR	/RESET FILE POINTER IF CALLED FROM FORTRAN
	JMS I (OPENFL	/OPEN NEXT FILE
	CDF CIF 10
	JMP I SPAUSE
FSWITC,	-1		/AS ADVERTISED

DELETE,	TAD I (MPARAM
	RTR		/PUT "K" SWITCH IN LINK
D7600,	7600
	CDF 0
	TAD I (JSBITS
	RAR
	CLL CML RAL
	DCA I (JSBITS	/MARK "DON'T CARE IF MONITOR AREA DESTROYED" BITS
	TAD FDSW
	SZL SNA CLA	/DELETE ONLY IF CALLED FROM FORTRAN WITH
	JMP NODLET	/"K" SWITCH(IN LINK) ZERO
	JMS I (MINCOR
	CLA IAC		/DEVICE "SYS"
	CIF 10
	JMS I (200
	4	/CLOSE - USED AS DELETE
	NAME	/NAME FOR CLOSE PROCESSOR
	0	/NO BLOCKS - WILL BE DELETED
	JMP DELERR	/ERROR
NODLET,	TAD LDRBLK
	SNA CLA		/WAS A LOADER BLOCK STORED
	JMP GETOUT
	CDF 10
	TAD I (L64
	CDF 0
	SZA CLA		/IF WE USED THE TELETYPE ROUTINE,
	JMP GETOUT	/THEN THERE WAS AN ERROR
	TAD REMEMB
	CDF 10
	DCA I (MOFILE+1
	CLL CML CLA RAR
	TAD I	(MPARAM+2
	DCA I (MPARAM+2
	CDF 0
	JMS I (MINCOR
	CIF 10
	JMS I (200
	6	/RUN
LDRBLK,	0
REMEMB,	0
FDSW,	0
GETOUT,	TAD I (SYSTEM
	CDF 10
D7700,	SMA CLA
	CMA
	DCA I D7700
	CDF 0
	JMP I .+1
	7605
DELERR,	TAD (1700	/GIVE A "S" ERROR
DELER2,	TAD (200
	CDF CIF 0
	JMP I (ERROR
NAME,	0617;2224;2216;2415

INREAD,	0
	AND D7700
	SNA CLA
	JMS I POPNFL
	JMS I INDEV
	400	/OR 200 IF NEED TWO PAGE HANDLERS-REDUCE BUFFER SIZE TO MAKE ROOM
INBFPT,	INBUF
INREC,	0
	JMP INERR
	ISZ INREAD
	ISZ INREC
INREC1,	ISZ INREC	/OR 0000 IF TWO PAGE HANDLERS-SINCE IN BUFFER IS 1/2 SIZE
	JMP I INREAD
INDEV,	0
INERR,	SPA CLA
	JMP DELER2
	JMP INREC+3
POPNFL,	OPENFL

CLSMBE,	0		/SUBR TO CLOSE OUTPUT FILE IF ONE EXISTS
	CDF CIF 10
	TAD I (OUTINH
	SNA CLA
	JMS I (OUCLOS
	CIF 0		/IN CASE WE DIDN'T CLOSE IT
	JMP I CLSMBE
\f	*7400	/END OF PASS CRAP AND INPUT ROUTINE
P40,	40
PASEND,	ISZ I (PASS	/BUMP PASS COUNTER
LSTFLG,	JMP SBSYMT	/ZERO IF LISTING FILE EXISTS
	JMS I (CLSMBE	/CLOSE BINARY FILE
	CDF CIF 10
	JMS I (TSTNTR	/ENTER LISTING FILE
	TAD I (FSWITC
	SZA CLA
	JMP .+4
	TAD (7617
	DCA I (FILPTR	/RESET FILE POINTER TO BEGINNING
	JMS I (OPENFL	/AND OPEN FIRST FILE
		/IF CALLED FROM FORTRAN WE DONT HAVE TO DO THIS
		/BECAUSE OF THE PECULIAR NATURE OF FORTRAN OUTPUT
	JMS I (MOUCOR	/KICK MONITOR OUT
	CDF CIF 10
	TAD I (MPARAM+1
P200,	AND P40		/MASK OUT "S" SWITCH
	DCA I (OUTINH	/INTO "OUTPUT INHIBIT" FLAG
	JMS I (SYMPRT	/PRINT SYMBOL TABLE UNDER CONTROL OF /S
	DCA I (OUTINH	/ZERO FLAG FOR LISTING
	TAD I (MPARAM+1	/SYMPRT RETURNS WITH DATA FIELD=10
	RTL
	CIF 10
	SNL CLA		/"N" FLAG IS IN THE LINK
	JMP I (ENDRSM	/HE WANTS A LISTING - GO GET IT
SBREND,	CIF 0
	JMS I (CLSMBE	/CLOSE OUTPUT FILE
	JMP I (DELETE	/DELETE FORTRN.TM AND CHAIN OR RETURN

SBSYMT,	TAD (TDUMMY
	CDF CIF 10
	DCA I (PUNCH	/INHIBIT ALL FUTURE OUTPUT
	JMS I (SYMPRT	/CHECK SYMTAB FOR UNDEFINEDS
	CDF 0
	ISZ I (JSBITS	/SET "DON'T CARE ABOUT USR CORE" FLAG
	JMP SBREND	/NOW GO CLOSE BINARY OUTPUT FILE AND RETURN

INCHAR,	0
	ISZ INJMP
	KSF
	JMP .+5
	KRS
	TAD (-203
	SNA CLA
	JMP I (7600	/EXIT TO MONITOR IF ^C TYPED
	ISZ INCHCT
INJMPP,	INJMPE
	TAD INCNT
INRD,	JMS I (INREAD
	DCA INCNT	/RETURN HERE ON EOF
INRD1,	ISZ INCNT	/SET TO 0000 IF 2 PAGE HANDLERS FORCE INPT. BUFF. TO 1/2 SIZE
	SKP		/	"	"	"
	TAD (600
	ISZ INCNT
IN7400,	7400
	TAD (-1401
	DCA INCHCT
	TAD INJMPP
	DCA INJMP
	TAD I	(INBFPT
	DCA INPTR
	JMP INCHAR+1
	INJMPE=JMP .
INJMP,	INJMPE
	JMP INCHA1
	JMP INCHA2
INCHA3,	TAD INJMPP
	DCA INJMP
	TAD I INPTR
	AND IN7400
	CLL RTR
	RTR
	TAD INTEMP
	RTR
	RTR
	ISZ INPTR
	JMP INCOM
INCHA2,	TAD I INPTR
	AND IN7400
	DCA INTEMP
	ISZ INPTR
INCHA1,	TAD I INPTR
INCOM,	AND (177
	SZA
	TAD (-177
	SNA
	JMP INCHAR+1
	TAD (145	/CHECK FOR ^Z
	SNA
	JMP INRD	/^Z ON INPUT MEANS GO TO NEXT FILE
	TAD (232
	CDF CIF 10
	DCA I (CHR
	JMP I INCHAR
INPTR,	0
INCHCT,	0
INTEMP,	0
INCNT,	0
	FIELD 1
\f	*6400	/OUTPUT ROUTINE INTERFACE - CANT GO PAST 6423
OUCHAR,	0
	DCA I POUTEM
	TAD OUTINH
	SZA CLA
OUCRET,	JMP I OUCHAR	/DOUBLES AS OFF-PAGE RETURN
	ISZ I POUJMP
	ISZ OUCHCT
	JMP I POUJMX
	JMS OUTDMP
	JMP OUCHAR+2
POUJMP,	OUJMP
POUJMX,	OUJMX
POUTEM,	OUTEMP
OUTINH,	0
F3ERR,	TAD O2100
F2ERR,	TAD O2100
F1ERR,	CDF CIF 0
	JMP I .+1
	ERROR
O2100,	2100
	*6457	/LOADS OVER OLD SABR INITIALIZATION ROUTINE
TSTNTR,	0		/CALLED FROM FIELD 0
	TAD PFILE
	TAD C4
	DCA PFILE
	TAD I PFILE
	ISZ PFILE
	DCA ODEVNO
	TAD	OUHND	/THIS LOC. IS SET UP AT INIT. TIME
	DCA OUHNDL
	CIF 0
	JMS I (MINCOR
	JMS I (200
	13		/RESET OUTPUT DEVICE
	TAD ODEVNO	/LOAD OUTPUT DEVICE
	JMS I (200
	1
OUHNDL,	7400
	JMP F2ERR
	TAD PFILE
	DCA ENAME	/POINTS TO FILE NAME
	DCA OULNGT	/ZERO CLOSING LENGTH
	TAD ODEVNO	/LOAD DEVICE NUMBER AND REQUESTED LENGTH
	JMS I (200
	3	/ENTER
ENAME,	0		/POINTER INTO COMMAND DECODER AREA GOES HERE
	OUCHCT=ENAME
ELENGT,	0		/"0 LENGTH" MEANS AS LARGE A SPACE AS POSSIBLE
	JMP F2ERR	/COULDN'T ENTER FILE - MAYBE BAD DIRECTORY
	TAD ENAME	/GET STARTING BLOCK #
	DCA OUTREC	/STORE IT AWAY
	JMS OUSPTR	/INITIALIZE OUTPUT ROUTINE
ENTRTN,	CDF CIF 0
	JMP I TSTNTR
OUSPTR,	0
	TAD POUBUF
	DCA I (OUPTR
	TAD (-601
	DCA OUCHCT
	TAD (OUJMPE
	DCA I POUJMP
	JMP I OUSPTR
OUTDMP,	0
	CIF 0
	JMS I OUHNDL
	4200
POUBUF,	1200	/REMAINDER OF OLD SABR INPUT BUFFER
OUTREC,	0
	JMP F3ERR
	ISZ OUTREC
	JMS OUSPTR
	ISZ OULNGT
	ISZ ELENGT
	JMP I OUTDMP
	JMP F2ERR
OUCLOS,	0
	TAD OUT232	/PUT A ^Z IN THE OUTPUT FILE
	JMS OUCHAR
	TAD OUCHCT
	CMA
	SZA CLA
	JMP .-4		/FILL REMAINDER OF BUFFER WITH ZEROS
	JMS OUTDMP
	CIF 0
	JMS I (MINCOR
	TAD ODEVNO
	JMS I (200
C4,	4	/CLOSE
PFILE,	7574
OULNGT,	0
	JMP F2ERR	/ERROR ON CLOSE
	DCA OULNGT
	CIF 0
	JMP I OUCLOS
OUT232,	232
ODEVNO,	0
OUHND,	0	/SET UP AT INIT. TIME TO ALLOW 2 PAGE HNDLR
			/IF NEEDED
	*6610	/OUTPUT ROUTINE - CANT GO PAST 6661
OUJMX,	CDF 0
	OUJMPE=JMP .
OUJMP,	OUJMPE
	JMP OUCHA1
	JMP OUCHA2
OUCHA3,	TAD OUTEMP
	RTL
	RTL
	DCA OUTEMP
	TAD OUJMPP
	DCA OUJMP
	TAD OUTEMP
	AND OU7400
	TAD I OUPOLD
	DCA I OUPOLD
	TAD OUTEMP
	RTL
	RTL
	AND OU7400
	TAD I OUPTR
	DCA I OUPTR
	ISZ OUPTR
	JMP OUCOM
OUCHA2,	TAD OUPTR
	DCA OUPOLD
	ISZ OUPTR
OUCHA1,	TAD OUTEMP
	AND OU377
	DCA I OUPTR
OUCOM,	CDF 10
	JMP I .+1
	OUCRET
OUPTR,	0
OUJMPP,	OUJMPE
OUPOLD,	0
OUTEMP,	0
OU7400,	7400
OU377,	377
\f		/PATCHES TO SABR TO HOOK INTO THESE WONDERFUL ROUTINES
	*4574		/OLD "INITR" ROUTINE AREA - 4 LOCATIONS LONG
SYMPRT,	0	/INTERMEDIATE ROUTINE TO PRINT SYMBOL TABLE
	JMS I PRSYMP	/CALL SABR'S ROUTINE
	CIF 0
	JMP I SYMPRT	/BUT RETURN TO FIELD 0

	*4641		/CODE IN THIS SECTION CAN'T GO PAST 4704
FETCH,	0	/REPLACES ROUTINE IN SABR OF SAME NAME
	CDF CIF 0
	JMS I .+2
	JMP I FETCH
	INCHAR

LDRCT,	7700	/FOR LEADER-TRAILER ROUTINE ON SAME PAGE

USYMFG,	0		/ROUTINE TO GIVE UNDEFINED SYMBOL MESSAGES WHEN
	JMS I CTYPE	/NO SYMBOL TABLE IS REQUESTED
SYMXX,	JMP I USYMFG	/ZEROED IF CHECKING FOR UNDEFINEDS
	TAD SYMBOL
	DCA I PLLFS	/SET UP SABR CELLS SO THAT ERROR ROUTINE WILL
	DCA LINE	/PRINT THE NAME OF THE UNDEFINED SYMBOL
	TAD U2300	/FUDGE FOR "U" ERROR MESSAGE - UNFORTUNATELY,
	JMP I .+1	/THIS MESSAGE IS INSTANTLY FATAL - SERVES HIM RIGHT
	F1ERR
PLLFS,	LLFS		/RANDOM LOCATION IN SABR
U2300,	2300

TDUMMY,	0		/DUMMY OUTPUT ROUTINE
	CLA
	JMP I TDUMMY	/AS DUMMY AS YOU CAN GET

	*6133		/PATCH TO SYMBOL TABLE PRINTER TO USE ABOVE
	JMS I 6177	/THIS REPLACES A "JMS I CTYPE"
	*6177
	USYMFG		/LUCKILY THERE WAS A LOCATION FREE

	*3665		/REWRITE OF OCTAL TYPEOUT ROUTINE TO
	DCA TEM1	/NOT KEEP INFORMATION IN THE LINK ACROSS
	TAD M4		/A CALL TO THE OUTPUT ROUTINE
	DCA TEM2
L62A,	TAD TEM1
	RTL
	RAL
	DCA TEM1
	TAD TEM1
	RAL
	*3702
	JMP L62A

	*4317	/"PAUSE" PROCESSOR
	CLA	/REPLACES CLA HLT
	CDF CIF 0

	*4332	/PATCHES TO INITIALIZATION ROUTINE
	NOP	/DON'T GIVE
	NOP	/TWO USELESS CARRIAGE RETURN - LINE FEED PAIRS

	*4341
	NOP	/DON'T JMS I 4372 'CAUSE WE HAVE CHANGED 4372!

	*4372	/MORE "PAUSE" FUDGE
	SPAUSE

	*4715	/ALTER COUNT ON LEADER-TRAILER
	TAD LDRCT

	*561	/"END" STMT PROCESSOR
	CIF 0
	JMP I PEND	/END OF PASS 1
	ENDRSM=.

	*565	/MORE ON "END"
	NOP	/ELIMINATE HALT AT END OF PASS 1

	*570	/STILL MORE ON "END"
	CDF CIF 0
	JMP I SEND	/END OF PASS 2

	*576	/THERE ARE (WERE) TWO WHOLE FREE LOCATIONS IN THIS PAGE!
SEND,	SBREND
PEND,	PASEND

	*2761	/FATAL ERROR HALT IN ERROR ROUTINE
	CDF CIF 0
	JMP I 166	/166 = LITERAL 7600

	*4003	/LISTING ROUTINE
	SKP CLA	/ALWAYS PUT LISTING ON "PUNCH"

	*PUNCH	/POINTER TO PUNCH ROUTINE
	OUCHAR	/POINTER TO MY PUNCH ROUTINE
/
	*200
	VERNUM
	JMS I	.-1
/
	*7000
VERNUM,	0
	JMS I	CRLF
	TAD I	POINT
	JMS I	CTYPE
	ISZ	POINT
	ISZ	COUNT
	JMP	.-4
	JMS I CRLF
	DCA I	TYPE
	JMP I	VERNUM
/
POINT,	TITLE
COUNT,	-5
TITLE,	TEXT	/SABR V18A /
	$
\f
\r\f