Directory of image this file is from
This file as a plain text file

/OSALGR.PA -30-
/ 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 RELEVANT DEVICE NUMBER IN LOCN 400 AND
/ THE STARTING BLOCK IN LOCATION 401. 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

OCTOUT=1005
INIT=614
SRCODE=5703
LRCODE=6000
IBUFFR=7200
OBUFFR=6200
FRAME1=7000

FIELD 0
*61
HSTATE,	0
IOPEN,	-1
OOPEN,	-1
ICCT,	-1
OCCT,	0
CFL,	0

/ FIXUP SWITCH FOR RUN-TIME SYSTEM
RETFLD=10
FIELD 1
*4200
ERR0-1
*1001
CDF CIF
*1004
OSIN0
*2001
CDF CIF
*2004
OSOUT0
*2200
CDF CIF
*2204
FHANDL

	FIELD 0

	*200
	JMP LOAD
	TAD 401
	SNA
	JMP LOAD
	DCA NXIB
	TAD 400
	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
LOAD1,	DCA AIHNDL
	CMA
	DCA ICCT
	DCA IOPEN	/ FIX SO INPUT LOOKS OPEN
	TAD (5204	/=JMP 4004
	CDF 10
	DCA I (4141	/INSTEAD OF JMP WAIT-1
	TAD (4001
	DCA 10
	TAD (1212
	DCA I 10	/14002=TAD 4012
	TAD (5231
	DCA I 10	/14003=JMP 14031
	TAD (4610
	DCA I 10	/14004=JMS I 14010
	TAD (TSF
	DCA I 10	/14005=TSF
	TAD (5205
	DCA I 10	/14006=JMP .-1
	TAD (5611
	DCA I 10	/14007=JMP I 14011
	TAD (OCTOUT
	DCA I 10	/14010=OCTOUT
	TAD (INIT
	DCA I 10	/14011=INIT
	TAD (3
	DCA I 10	/14012=3
	DCA I (4040	/ ZERO OUT CALL TO OPEN INPUT
	CDF 0
LOAD,	CDF CIF 10
	JMP 4000
LOAD2,	TAD 400
	AND (17
	CIF 10
	JMS I (7700
	1		/FETCH
L3,	6601		/DEVICE HANDLER TO PAGES 6600 & 7000
	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-10
ERR0,
0;CLA;CDF CIF RETFLD;TAD ERR0;DCA I .+2;JMP I .+2;1200;1201

*SRCODE
/ OS/8 INPUT ROUTINE
AERR0,	ERR0
IL7400,	7400
IM232,	-232
CMASK,	377
FOBN,	0
AIHNDL,	ERR0
IBPTR,	0
W3,	0
OFNT,	0;0;0;0;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
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
	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
/ USE HANDLER STATE WORD TO DETERMINE WHICH FRAME TO ALLOCATE
	IAC
	AND HSTATE	/ SELECT 'OUTPUT HANDLER IN FRAME 1' BIT
	SZA CLA		/ IF CLEAR, FRAME 1 IS AVAILABLE
	TAD I7600	/ ELSE FRAME 2 IS USED
	TAD AHF1I
	DCA IPAGAD
/ NOW FETCH HANDLER, IF NOT ALREADY IN CORE
	TAD I (ISAV
	CIF 10
	JMS I (200
	1
IPAGAD,	0		/ CHANGED TO SA OF HANDLER
	JMS ERRIU
/ AND UPDATE HSTATE TO REFLECT NEW HOST FRAME
	TAD IPAGAD
	AND I7600	/ GET ADDRESS OF HANDLER FRAME
	CIA
	TAD AHF1I
	SNA CLA		/ SKIP IF NOT FRAME 1
	TAD (2
	DCA ERRIU	/ SAVE UPDATE
	CLL IAC
	AND HSTATE	/ KEEP OUTPUT BIT ONLY
	TAD ERRIU
	DCA HSTATE	/ RESTORE UPDATED STATE WORD
/ 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
AHF1I,	FRAME1
*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 (2
	AND HSTATE	/ SELECT 'INPUT HANDLER IN FRAME 1' BIT
	SZA CLA		/ IF CLEAR, FRAME 1 IS AVAILABLE
	TAD O7600	/ ELSE FRAME 2 IS USED
	TAD AHF1O
	DCA OPAGAD
/ FETCH HANDLER IF NOT ALREADY IN CORE
	TAD I (OFNT
	CIF 10
	JMS I (200	/ USR IS KNOWN TO BE IN CORE
	1
OPAGAD,	0		/ CHANGED TO SA OF HANDLER
	JMS ERROU
/ NOW UPDATE HSTATE
	TAD OPAGAD
	AND O7600
	CIA
	TAD AHF1O
	SNA CLA
	CLL IAC
	DCA ERROU
	TAD (2
	AND HSTATE
	TAD ERROU
	DCA HSTATE
/ TRANSFER SA OF HANDLER
	TAD OPAGAD
	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
AHF1O,	FRAME1
/ SAVE AREA
OSAV,
0;0;0;0;0;0;0;0;0;0;0;0;0;0
$$$$