/ OS/8 ROGALGOL RUNTIME OVERLAY MK 40. 23/12/76
/ OVERLAY FOR ALGOL RUN TIME SYS UNDER OS/8
/ THE OVERLAY ALLOWS ANY OS/8 ONE PAGE DEVICE HANDLER
/ FOR INPUT OR OUTPUT ON STREAM 3
/ IT USES SYSTEM SCRATCH BLOCKS 40 & 41 TO HOLD CODE OVERLAYS
/ THUS IF THE	RUN-TIME SYSTEM + PROGRAM ARE TO BE
/ SAVED AS A CORE-IMAGE FILE, THIS MUST BE DONE BEFORE STARTING UP,
/ AS THE FIRST CALL TO ROUTINE FHANDL ( 'DISK' IN ALGOL ) TRIPS
/ ONE-TIME CODE TO WRITE THE OVERLAYS ON TO BLOCKS 40 & 41, AND
/ THEN FIX UP THE RESIDENT CODE.

/ CAN BE CHAINED TO FROM ALGOL COMPILER
/ IF SO THE ENTRY IS AT 201 AND RUN TIME SYSTEM EXPECTS
/ TO FIND THE DEVICE NUMBER AND STARTING BLOCK IN THE
/ COMMAND DECODER INPUT LIST. IF EITHER IS ZERO A
/ NORMAL LOAD OCCURS, AS ALSO HAPPENS IF THE DEVICE WAS 
/ A WRITE ONLY ONE
/ CHAINING ALSO WRITES UP FILE OVERLAYS TO BLOCKS 40 & 41

/ SYMBOL DEFINITIONS & PAGE 0 VARIABLES

ALEND=4630	/END OF LOADER ADDRESS
WAIT=1207
IPSET=4037	/ADDRESS IN LOADER AT WHICH INPUT READY
OCTOUT=1005
INIT=614
SRCODE=6200
LRCODE=6400
IBUFFR=6600
OBUFFR=7200
FRAME1=6000

FIELD 0
*61
IOPEN,	-1
OOPEN,	-1
ICCT,	-1
OCCT,	0
CFL,	0
BOTTOM,	SRCODE	/BOTTOM ADDRESS OF OS/8 DEVICE HANDLERS
LOADCL,	0	/SET NON-ZERO WHEN LOADER IS CALLING

/ FIXUP SWITCH FOR RUN-TIME SYSTEM
RETFLD=10
FIELD 1

*31;	3	/DEVICE 3 ALWAYS IN OS/8
*4022;	215; 212; 0
	CDF; CLA CMA; DCA I XLOADC; CDF 10	/SET LOADING MARKER
	JMP IPSET-1	/BEFORE CALLING FHANDL
XLOADC,	LOADCL
*4601
JMP LDFLD
*ALEND
	JMS I (7700; 13	/REMOVE ALL DEVICE HANDLERS
	TSF; JMP .-1; CLA; CDF; DCA I X7746	/ALLOW START COMMAND
	DCA I (LOADCL; CDF 10	/CLEAR LOAD CALL MARKER
	CLA IAC; AND I X7643; SZA CLA; JMP I XWAIT /HANG IF /L
	TAD I X7643; AND X40; SZA CLA; JMP I XINIT /START ON /G
	TAD I X7642; SPA CLA; JMP I XINIT	/START AFTER ALTMODE
	JMP I XWAIT	/ELSE HANG ON TTY
/ HERE WE CHECK IF /0-/7 SET FOR FIELD TO USE.
/ IF SO WE ALSO CHECK IF=N HAS SET LAST LOCN TO USE IN
/ THAT FIELD. BUT MUST INCLUDE FIELD
/   E.G. FILE/3=37777 WILL LOAD TO FIELD 3 IF IT EXISTS
/	 AND SET LAST AVAILABLE LOCN TO 7777
LDFLD,	DCA LX; TAD I (7645; AND (1774; SNA
	JMP LDEX	/ CHECK IF FIELD OPTIONS
	CLL RTL; ISZ LX; RAL; SNL
	JMP .-3; CLA CMA; TAD LX	/ SET 3600 TO REQUIRED FIELD
	CLL RTL; RAL; TAD XCDF; DCA I (3600
/ AND NOW SET LAST LOCN, BUT CHECK IN SAME FIELD AS FIELD OPTION
	TAD I (7642; AND (3777; CMA; TAD LX; SZA CLA
	JMP LDEX; TAD I (7646; DCA I (3601
LDEX,	JMP I 4600
LX,	0
XCDF,	CDF
X7746,	7746
X7642,	7642
X7643,	7643
X40,	40
XWAIT,	WAIT
XINIT,	INIT
*4200
SRCODE	/LOADER NEVER PUT HANDLERS BELOW OS/8
*1001
CDF CIF
*1004
OSIN0
*2001
CDF CIF
*2004
OSOUT0
*2200
CDF CIF
*2204
FHANDL

	FIELD 0

	*200
	JMP LOAD	/NORMAL ENTRY
	CDF 10; TAD I (7620; CDF	/STARTING BLOCK
	SNA
	JMP LOAD
	DCA NXIB
	CDF 10; TAD I (7617; CDF	/DEVICE NUMBER
	AND (17
	SNA
	JMP LOAD
	TAD (7647-1
	DCA PD
	JMS SAC+1	/ TRIP 1-TIME CODE TO SAVE OVERLAYS
	CDF 10
	TAD I PD
	CDF 0
	SNA
	JMP LOAD2	/FETCH HANDLER IF NOT SYS:
LOAD1,	DCA AIHNDL
	CMA
	DCA ICCT
	DCA IOPEN	/ FIX SO INPUT LOOKS OPEN
	TLS; KCC
	CDF CIF 10
	JMP IPSET	/ALL SET UP FROM CHAIN
LOAD,	CDF CIF 10	/CHAIN DIDN'T WORK
	JMP 4000
LOAD2,	CDF 10; TAD I (7617; CDF 0
	AND (17
	CIF 10
	JMS I (7700
	1		/FETCH
L3,	OBUFFR+1	/LOADING HANDLER TO OUTPUT BUFFER
	JMP LOAD	/NO GOOD
	TAD PD
	TAD (7760-7647
	DCA PD
	CDF 10
	TAD I PD
	CDF 0
	RTL
	SPA CLA		/NEGATIVE IF WRITE ONLY DEVICE
	JMP LOAD
	TAD L3
	JMP LOAD1

PD,	0


	PAGE
*SRCODE
HFETCH,	0	/FETCH HANDLER WHOSE NUMBER IS IN AC
	/USR IS IN CORE. EXIT1 IS ERROR, EXIT2 OK
	/WITH HANDLER ENTRY ADDRESS IN AC
	DCA DEVNO; TAD DEVNO
	CIF 10; JMS I (200; 12 /ENQUIRE
HENTRY,	0; JMP I HFETCH	/CANT, BAD DEVICE
	TAD HENTRY; SNA; JMP FET
	ISZ HFETCH; JMP I HFETCH	/ALREADY THERE
FET,	TAD LOADCL; SNA CLA; JMP DOGRAB	/LOADER CALL?
	TAD (OBUFFR; JMP LOADH	/YES, HANDLER TO O/P BUFFER
DOGRAB,	JMS GRAB; JMP I HFETCH	/NO MORE ROOM
	DCA HAD1; TAD DEVNO
	CIF 10; JMS I (200; 1
HAD1,	0; JMP TRY2	/ONE PAGE NO GOOD
	TAD HAD1; ISZ HFETCH; JMP I HFETCH /ONE PAGE LOADED
TRY2,	JMS GRAB; JMP I HFETCH
LOADH,	IAC; DCA HAD2
	TAD DEVNO; CIF 10; JMS I (200; 1
HAD2,	0; JMP I HFETCH	/THIS TIME ITS FATAL
	TAD HAD2; ISZ HFETCH; JMP I HFETCH /TWO PAGES LOADED
DEVNO,	0
GRAB,	0
	TAD BOTTOM; TAD (-200; DCA BOTTOM	/NEW LOWEST ADDRESS
	TAD 175; CLL CIA; TAD BOTTOM	/CHECK ITS FREE SPACE
	SNL CLA; JMP I GRAB	/CLASHES WITH COMPILED CODE
	TAD BOTTOM; ISZ GRAB; JMP I GRAB

ERR0,
0;CLA;CDF CIF RETFLD;TAD ERR0;DCA I .+2;JMP I .+2;1200;1201

/ OS/8 INPUT ROUTINE
AERR0,	ERR0
IL7400,	7400
IM232,	-232
CMASK,	377
AIHNDL,	ERR0
IBPTR,	0
W3,	0

OSIN0,	0
	TAD IOPEN
	SZA CLA
	JMS I AERR0
	ISZ ICCT
	JMP GETON
	JMS I AIHNDL
	200
AIBUF,	IBUFFR
NXIB,	0
	SMA CLA
	SKP
	JMS I AERR0
	ISZ NXIB
	CLA CMA
	TAD AIBUF
	DCA IBPTR
	TAD MNCH
	DCA ICCT
	TAD CON10
	DCA W3
GETON,	TAD W3
	SPA
	JMP C3
MNCH,	CLA
	ISZ IBPTR
	TAD I IBPTR
	AND IL7400
	CLL RAL
	TAD W3
FIX10,	RTL
	RTL
	DCA W3
	TAD I IBPTR
	AND CMASK
	TAD IM232
	SZA CLA
	JMP NOTCZ
	IAC
	DCA IOPEN
NOTCZ,	TAD I IBPTR
	AND CMASK
	CDF CIF RETFLD
	JMP I OSIN0
C3,	DCA I IBPTR
	CLL CML
	JMP FIX10
CON10,	10


*LRCODE
/ OS/8 OUTPUT ROUTINE
OSOUT0, 0
	AND (377
	TAD (-232
	JMS OUTCH
	JMP OOEXIT
/ CALL IN CLOSE OVERLAY
	TAD OSOUT0
	DCA FHANDL
	JMP CLOSTF
OOEXIT,	CDF CIF RETFLD
	JMP I OSOUT0

/ OUTPUT CHAR TO FILE BUFFER
OUTCH,	0
	TAD (232
	DCA OPBLOK
	TAD OOPEN
	SZA CLA
	JMS ERR0
	TAD OCCT
	SZA CLA
JMPINS,	JMP JMPSW
	TAD MNCH
	DCA OCCT
	CMA
	TAD AOBUF
	DCA OBFPTR
	JMP .+4
JMPSW,	NOP
	JMP CH2
	JMP CH3
	TAD JMPINS
	DCA JMPSW
CH2,	TAD OBFPTR
	DCA TMPTR
	ISZ OBFPTR
	TAD OPBLOK
P3,	DCA I OBFPTR
	ISZ JMPSW
	TAD OPBLOK
	TAD (-232
	SNA CLA
	JMP ATEF
/ NOT END OF FILE
	ISZ OCCT
	JMP I OUTCH
	JMS OPBLOK
	ISZ OFL
	JMP I OUTCH	/ RETURN 1
	JMS ERR0
/ END OF FILE ; PUT SHORT BLOCK
ATEF,	JMS OPBLOK
	ISZ OUTCH	/ BUMP RETURN ADDRESS AT END-FILE
	JMP I OUTCH	/ & RETURN 2

/ OUTPUT BLOCK ROUTINE
OPBLOK,	0		/ ALSO USED TO HOLD CHAR
	JMS I AOHNDL
	4200
AOBUF,	OBUFFR
NXOB,	0
	JMS ERR0
	ISZ NXOB
	ISZ CFL
	JMP I OPBLOK

CH3,	TAD OPBLOK
	RTL
	RTL
	AND O7400
	TAD I TMPTR
	DCA I TMPTR
	TAD OPBLOK
	RTR
	RTR
	RAR
	AND O7400
	TAD I OBFPTR
	JMP P3
O7607,	7607
FIBN,	0
FOBN,	0
OFNT,	0;0;0;0;0
OFL,	0
AOHNDL,	ERR0
OBFPTR,	0
TMPTR,	0


/ FILE HANDLING ROUTINE
/ OPENS & CLOSES FILES, REWINDS INPUT FILES,
/ & TRANSFERS OUTPUT FILES TO BE INPUT FILES
/ CALLS IN OVERLAY CODE TO DO MOST OF ITS WORK
FHANDL,	0
	JMP I IBA	/ FIXED TO SZA BY ONE-TIME CODE
	JMP NOTRWD
/ REWIND INPUT FILE
	TAD IOPEN
	SPA CLA
	JMS ERR0
IOPN,	DCA IOPEN	/ ZERO 'INPUT OPEN' FLAG
	TAD FIBN	/ FIRST INPUT FILE BLOCK NO
	DCA NXIB	/ SETUP START BLOCK
	CMA
	DCA ICCT	/ INITIALISE OSIN0
FOUT,	CDF CIF RETFLD
	JMP I FHANDL	/ RETURN
/ SET UP CALL CODE
NOTRWD,	CIA
	CMA
	SZA
	JMP CLOSTF	/ CLOSE OR TRANSFER
/ CALL DOWN INPUT OPEN OVERLAY OVER
/     INPUT BUFFER
	JMS I O7607
	200
IBA,	FRAME1		/ FIXED TO IBUFFR, TO CALL OVERLAY
	40		/ WHICH RESIDES IN SCRATCH-BLOCK 40
	JMS ERR0	/ DISASTER!
	JMP I IBA	/ ENTER OVERLAY
/ CLOSE, OPEN OUTPUT, OR TRANSFER OPERATION
CLOSTF,	DCA OSOUT0	/ HOLD OPERATION
	TAD OSOUT0
	CLL RAR
	SNA CLA
	JMP NOTTF
/ TRANSFER ; PUT LAST BLOCK IF FILE STILL OPEN
	TAD OOPEN
	SNA CLA
	JMS OUTCH
O7400,	7400		/ NOP REALLY
NOTTF,	JMS I O7607
	200
OBA,	OBUFFR		/ CALL OOPEN OVERLAY
	41
	JMS ERR0	/ DISASTER MARK 2 !
	TAD OSOUT0
	JMP I OBA	/ ENTER OVERLAY

*FRAME1
/ ONE -TIME CODE TO SAVE OVERLAYS IN SCRATCH BLOCKS 40 & 41
	DCA SAC		/ SAVE ACC
	TAD (SRCODE; CDF 10; DCA I (4200; CDF
	/WE DONT NEED THIS CODE ANY MORE
	JMS I (7607
	4200
RIBA,	IBUFFR		/ SAVE INPUT OVERLAY
	40
	JMS ERR0
	JMS I (7607
	4200
	OBUFFR		/ SAVE OUTPUT OVERLAY
	41
	JMS ERR0
	TAD (7440	/ LOAD UP 'SZA'
	DCA FHANDL+1	/ FIX UP
	TAD RIBA
	DCA IBA		/ RESIDENT CODE
	TAD SAC
	JMP FHANDL+1	/ & RETURN
SAC,	0
	0		/ INITIALISATION CODE FOR CHAIN CALL
	TAD (JMP I SAC+1
	DCA SAC-1
	JMP FRAME1
*IBUFFR
/ OVERLAY FOR OPENING OS/8 INPUT FILES ; OVERLAYS INPUT BUFFER
/ INPUT MUST BE ALLOWED ALREADY, ELSE WE WOULDNT BE HERE
	CIF 10		/ ENTRY POINT
	JMS I (7700
	10		/ LOCK IN USR
IAGAIN,	JMS IMESS	/ CALL MESSAGE ROUTINE
	"I;"N;"P;"U;"T;" ;"F;"I;"L;"E;"N;"A;"M;"E;" ;"?;0
/ PRESERVE FRAGILE PART OF DEVICE HANDLER RESIDENCY TABLE
	JMS SDHRTI
	JMS IMOV10
/ CALL COMMAND DECODER IN SPECIAL MODE
	CIF 10
	JMS I (200
	5
	5200
	0		/ PRESERVE ANY TENTATIVE FILES
	TLS		/ & RESET TTY FLAG
/ RESTORE FRAGILE PART OF DEVICE HANDLER RESIDENCY TABLE
	JMS SDHRTI
	TAD I IPT2
	ISZ IPT2
	CDF 10
	DCA I IPT1
	ISZ IPT1
	CDF
	ISZ IMESS
	JMP .-7
/ MOVE INPUT FILENAME TO TABLE
	TAD (7605
	DCA IPT1
	TAD (ISAV
	DCA IPT2
	TAD (-5
	DCA IMESS
	JMS IMOV10
/ CHECK THAT FILENAME HAS BEEN INPUT
	TAD ISAV
	SNA CLA
	JMP IAGAIN	/ ASK AGAIN
/ TRANSFER TO NEXT PAGE
	JMP IP2

/ SETUP FOR DHRT TRANSFER
SDHRTI,	0
	TAD (7650
	DCA IPT1
	TAD (ISAV
	DCA IPT2
	TAD (-16
	DCA IMESS
	JMP I SDHRTI

/ MOVE CHUNK FROM FIELD 1 TO FIELD 0
IMOV10,	0
	CDF 10
	TAD I IPT1
	ISZ IPT1
	CDF
	DCA I IPT2
	ISZ IPT2
	ISZ IMESS
	JMP IMOV10+1
	JMP I IMOV10

/ INPUT MESSAGE ROUTINE
IMESS,	0
	TAD I IMESS
	ISZ IMESS
	SNA
	JMP I IMESS
	TLS
	TSF
	JMP .-1
	CLA
	JMP IMESS+1

/ SAVE AREA
ISAV,
0;0;0;0;0;0;0;0;0;0;0;0;0;0
/ VARIABLES
IPT1,	0
IPT2,	0


*IBUFFR+200
/ PAGE 2 OF OPEN INPUT OVERLAY
IP2,	TAD (ISAV+1
	DCA AIFNAM
	TAD I (ISAV; JMS HFETCH; JMS ERRIU /GET HANDLER
	DCA IPAGAD
/ LOOKUP INPUT FILE
	TAD I (ISAV
	CIF 10
	JMS I (200
	2
AIFNAM,	0		/ REPLACED BY START BLOCK
	0		/ REPLACED BY COUNT OF NO OF BLOCKS
	JMS ERRIU
/ DISMISS USR FROM CORE
IDMUSR,	CIF 10
	JMS I (200
	11
/ DECIDE WHERE TO GO NOW
	TAD ERRIU
	SMA CLA
	JMP INORM	/ NORMAL PATH
	TAD ERRIU
	DCA ERR0
	JMP ERR0+1	/ IF ERROR
/ ERROR OCURRED WHILE USR LOCKED IN ; DISMISS USR, THEN REPORT
ERRIU,	0
I7600,	7600		/ CLEAR ACC
	JMP IDMUSR
/ NORMAL PATH ; TRANSFER ALL NECESSARY INFO
INORM,	TAD IPAGAD
	DCA AIHNDL	/ SET HANDLER SA
	TAD AIFNAM
	DCA FIBN	/ SAVE 1ST BLOCK NO FOR INPUT
	JMP IOPN	/ & BACK INTO RESIDENT CODE

/ VARIABLES, ETC
IPAGAD,	0
*OBUFFR
/ OVERLAY FOR OPENING OS/8 OUTPUT FILES, CLOSING THEM,
/ & TRANSFERRING THEM TO BE NEW INPUT FILE
/ OVERLAYS OUTPUT BUFFER
	SZA		/ ENTRY POINT
	JMP NOTC	/ NOT CLOSE
	JMS CLOSEO	/ CLOSE OUTPUT FILE
	JMP FOUT	/ & EXIT
/ NOT CLOSE ; FIND OUT IF TRANSFER OR OPEN OUTPUT
NOTC,	TAD (-1
	SNA CLA
	JMP OPNOUT	/ OPEN OUTPUT FILE
/ TRANSFER OUTPUT FILE TO BE INPUT
	TAD OOPEN
	SPA
	JMS ERR0	/ ERROR ; FILE NEVER OPENED
	SNA CLA
	JMS CLOSEO	/ CLOSE FILE IF NECESSARY
	CMA
	DCA OOPEN	/ & INHIBIT FURTHER USE AS OUTPUT FILE
	TAD AOHNDL
	DCA AIHNDL
	TAD FOBN
	DCA FIBN
	JMP IOPN	/ BACK INTO RESIDENT CODE
/ OPEN NEW OUTPUT FILE
OPNOUT,	CIF 10
	JMS I (7700
	10		/ LOCK IN USR
OAGAIN,	JMS OMESS
	"O;"U;"T;"P;"U;"T;" ;"F;"I;"L;"E;"N;"A;"M;"E;" ;"?;0
/ PRESERVE FRAGILE PART OF DEVICE HANDLER RESIDENCY TABLE
	JMS SDHRTO
	JMS OMOV10
/ CALL COMMAND DECODER IN SPECIAL MODE
	CIF 10
	JMS I (200
	5
	5200
	0		/ PRESERVE ANY TENTATIVE FILES
	TLS
/ RESTORE FRAGILE PART OF DHRT
	JMS SDHRTO
	TAD I OPT2
	ISZ OPT2
	CDF 10
	DCA I OPT1
	ISZ OPT1
	CDF
	ISZ OMESS
	JMP .-7
/ MOVE OUTPUT FILENAME TO TABLE
	TAD (7605
	DCA OPT1
	TAD (OFNT
	DCA OPT2
	TAD (-5
	DCA OMESS
	JMS OMOV10
/ CHECK THAT FILENAME HAS BEEN INPUT
	TAD I (OFNT
	SNA CLA
	JMP OAGAIN	/ REPEAT REQUEST
/ TRANSFER TO NEXT PAGE
	JMP OP2

/ SETUP ROUTINE
SDHRTO,	0
	TAD (7650
	DCA OPT1
	TAD (OSAV
	DCA OPT2
	TAD (-16
	DCA OMESS
	JMP I SDHRTO

/ MOVE ROUTINE
OMOV10,	0
	CDF 10
	TAD I OPT1
	ISZ OPT1
	CDF
	DCA I OPT2
	ISZ OPT2
	ISZ OMESS
	JMP OMOV10+1
	JMP I OMOV10

/ OUTPUT MESSAGE ROUTINE
OMESS,	0
	TAD I OMESS
	ISZ OMESS
	SNA
	JMP I OMESS
	TLS
	TSF
	JMP .-1
	CLA
	JMP OMESS+1

/ VARIABLES
OPT1,	0
OPT2,	0


*OBUFFR+200
/ PAGE 2 OF OPEN OUTPUT OVERLAY
/ USE HANDLER STATE WORD TO DETERMINE WHICH FRAME TO ALLOCATE
OP2,	TAD I (OFNT; JMS HFETCH; JMS ERROU
	DCA AOHNDL
	TAD (3	/ SETUP ENTER OPERATION
	JMS USROP	/ TO USR, WHICH DISMISSETH ITSELF
	TAD AOFNAM
	DCA FOBN
	TAD AOFNAM
	DCA NXOB
	TAD OBLOK
	DCA OFL		/ COUNT OF BLOCKS4TO GO
	DCA CFL		/ COUNT OF BLOCKS GONE
	DCA OCCT
	DCA OOPEN
	JMP FOUT	/ BACK INTO RESIDENT CODE

/ CLOSE FILE ROUTINE
CLOSEO,	0
	TAD CFL
	DCA OBLOK
	CIF 10
	JMS I O7700
	10		/ LOCK IN USR
	TAD (4
	JMS USROP	/ CLOSE OPERATION
	CLL IAC
	DCA OOPEN
	JMP I CLOSEO

/ USR OPERATION ROUTINE ; USR IS KNOWN TO BE LOCKED IN
USROP,	0
	DCA OPCODE	/ SET OPERATION
	TAD (OFNT+1
	DCA AOFNAM	/ & FILENAME POINTER
	TAD I (OFNT
	CIF 10
	JMS I (200
OPCODE,	0
AOFNAM,	0		/ CHANGED TO START BLOCK IF ENTER
OBLOK,	0		/ CHANGED TO - NO OF BLOCKS IF ENTER
	JMS ERROU
/ NOW DISMISS USR
ODMUSR,	CIF 10
	JMS I (200
	11
/ NOW WHERE ??
	TAD ERROU
O7700,	SMA CLA
	JMP I USROP	/ RETURN IF ALL OK
	TAD ERROU
	TAD OPCODE
	DCA ERR0	/ VARIABLE ERROR, DEPENDING ON OPCODE
	JMP ERR0+1
/ ERROR WHILE USR LOCKED IN
ERROU,	0
O7600,	7600		/ CLA REALLY
	JMP ODMUSR
/ VARIABLES
/ SAVE AREA
OSAV,
0;0;0;0;0;0;0;0;0;0;0;0;0;0
$$$$