/ ABINOS.PA	-8-	S.F. 10-JAN-1977
/ DELETE POINTER TO OUTPUT FILE IF CHAINING TO RALGOL
/ THIS VERSION ALLOWS OPT L (LOAD).
/ CORRECTS CHAINING FAULT AND DELETES 2ND INPUT FILE IF ANY !
/ DON'T CLEAR 17600!
/ OVERLAY FOR ALGOL COMPILER MARK 34(M) AND 40
IFDEF ERRORS <XLIST>

	ALBIN=0

OSSTRT=5600	/ START OF OS8 ROUTINES
IBUFFR=OSSTRT+400
OBUFFR=IBUFFR+400
HPAGE=IBUFFR+1000	/ PAGES FOR HANDLERS
NOPAGE=2	/ THIS DEFINES NO OF PAGES
		/ FOR HANDLERS
IFDEF ALBIN <
	OPTGM=400	/ ONLY CHECK G IF ALBIN
	OEXTN=0102	/ OUTPUT TO .AB
	IEXTN=0103	/ INPUT FROM .AC
	OPTLOC=20; FHLOC=70; INLOC=53;
	OUTLOC=63; ERROR=140; NULOUT=ERROR;
	OPS=5200;
	KBDCHK=OPTLOC+3	>	/ DUMMY FOR NOW
IFNDEF ALBIN <
	OPTGM=2400	/ CHECK BOTH IF OSACOM
	OEXTN=0103	/ OUTPUT TO .AC
	IEXTN=0114	/ INPUT FROM .AL
	OPTLOC=60; FHLOC=77; INLOC=1203;
	OUTLOC=1213;  ERROR=1457; OPS=1410 /OCTAL OUT
	NULOUT=1210	/ NULL OUTPUT
	WAIT=1467

	*1472
	0; NOP; JMP I WAIT2; NOP
KBDCHK,	0	>

IFDEF ERRORS <XLIST>
NOPUNCH
/ NOW FOR ERROR DEFINITIONS. ERRORS OF THE FORM
/ OS8 ERROR AT XXXX.	XXXX DEFINED BELOW
E1	/ INPUT FILE NOT OPEN
E2	/ FAIL TO READ INPUT
E3	/ OUTPUT FILE NOT OPEN
E4	/ OUTPUT FULL
E8	/ FAIL TO WRITE OUTPUT
E10	/ DISK(XX) OR JMS FHANDLE WITH ILLEGAL NO XX
E11	/ FAIL TO CLOSE FILE
E12	/ FAIL TO ENTER FILE
E13	/ FAIL TO ENTER HANDLER. DUE TO EITHER NO SPACE
	/	OR HANDLER NOT AVAILABLE
E14	/ CANNOT CHAIN AS ERROR OCCURED
E15	/ CANNOT CHAIN AS RALGOL OR ABSLDR NOT FOUND
E16	/ FAIL IN ACTUAL CHAIN

/ OR CAN GET HALTS
/ DUE TO BAD READ / WRITE OF BUFFER AREAS AT:
E5	/ WRITE
E6	/ READ
E7	/ READ
E17	/ WRITE

ENPUNCH
IFDEF ERRORS <XLIST>

	*0
PSAVE2,	STAVE2

	*OPTLOC
OPTION,	0040	/ OPTIONS SAVED HERE FOR LATER USE
		/ 4000 MEANS OPT T
		/ 2000 OPT M
		/ 1000 SET BY COMPILER IF EMBEDDED TEXT
		/  400 OPT G
		/   40 JUST TO SET TO NON ZERO TO SHOW OS8 SYS
WAIT2,	GORUN
USR,	7700
	0; CLA; JMP I .-2	/ DUMMY KBDCHK

	*FHLOC
PFH,	FHANDL

	*201
	JMP I PSAVE2

	*INLOC
PIN,	OSIN

	*OUTLOC
POUT,	OSOUT


	*OSSTRT
OSIN,	(7400	/MUST BE FIRST LOC TO SET UP AND (7400=377
	CLA; TAD IOPEN; SZA CLA
E1,	JMS ERR0
OSIN2,	ISZ ICCT; JMP GETON; JMS I IHNDL
	200
IBUF,	IBUFFR
NXIB,	0
	SMA CLA; SKP;E2, JMS ERR0; ISZ NXIB
	CLA CMA; TAD IBUF; DCA IBPTR; TAD MNCH
	DCA ICCT; TAD K10; DCA W3
GETON,	TAD W3; SPA; JMP C3
MNCH,	CLA; ISZ IBPTR; TAD I IBPTR
K377,	AND (7400; CLL RAL; TAD W3
FIX10,	RTL; RTL; DCA W3; TAD I IBPTR
	AND K377; TAD (-232; SZA CLA	/ IS IT CTRL/Z?
	JMP NOTCZ; JMS SETNXB; JMP CZ; IAC	/IAC IF DEVHANDL NOT THERE
	SZA; JMS FHANDL; JMP OSIN2
K10,	10
CZ,	ISZ IOPEN
NOTCZ,	TAD I IBPTR; AND K377
INEX,	JMP I OSIN
C3,	DCA I IBPTR; CLL CML; JMP FIX10

/ OS8 OUTPUT
OSOUT,	0
	AND K377
	DCA OPBLOK; TAD OOPEN; SZA CLA
E3,	JMS ERR0; TAD OCCT; SZA CLA
JMPINS, JMP JMPSW;
	TAD MNCH; DCA OCCT; CMA
	TAD OBUF; 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; ISZ OCCT; JMP OUTEX; JMS OPBLOK
	ISZ OFL; JMP OUTEX;E4, JMS ERR0
ATEF,	JMS OPBLOK; CMA; JMS FHANDL
OUTEX,	JMP I OSOUT


CH3,	TAD OPBLOK; RTL;RTL; AND (7400
	TAD I TMPTR; DCA I TMPTR; TAD OPBLOK
	RTR; RTR; RAR; AND (7400
	TAD I OBFPTR; JMP P3

OBFPTR, 0
IBPTR,	0

OCCT,	0
OOPEN,	-1
ICCT,	-1
IHNDL,	ERR0
IOPEN,	-1
W3,	0
TMPTR,	0
OFL,	0
FOBN,	0	/ MEMORY OF FIRST OUTPUT BLOCK

	PAGE
FHANDL, 0
	JMP STAVE; TAD MEM
	SPA; JMP CLOSE; SZA; JMP .+3
	TAD (7617; DCA PI	/REWIND
	CLL RAR; SNA CLA	/REWIND OR OPEN INPUT?
	JMS SETNXB	/YES - GO TRY
P10,	10; JMP CLOSE; JMP FEX	/IT WORKED WITHOUT OVERLAY
COUNT,
HNO,
ERR0,	0
	DCA 15; CLA CMA		/ CALL OVERLAY WITH AC=7
GORUN,	TAD P10; DCA MEM
CLOSE,	JMS I (7607	/ WRITE BUFFER AREA
	4400
	IBUFFR
	44	/ TO TEMP BLOCK 44-7
E5,	HLT
	JMS I (7607	/ READ OVERLAY
	0400
	IBUFFR
	40	/ FROM TEMP BLOCKS 40-43
E6,	HLT
	JMP I PSET
FRETRN, JMS I (7607	/ READ BACK BUFFERS
	400
PSET,	IBUFFR
	44
E7,	HLT
FEX,	JMP I FHANDL
MEM,	0

OPBLOK, 0
	JMS I OHNDL
	4200
OBUF,	OBUFFR
NXOB,	0
E8,	JMS ERR0; ISZ NXOB; ISZ CFL; JMP I OPBLOK
OHNDL,	ERR0

CFL,	0



SETNXB, 0
	CLA; TAD	PI; DCA PT1; TAD (INAM; DCA PT2
	CLA CMA CLL RAL; JMS MOV10; TAD INAM
	SNA; JMP I SETNXB; ISZ SETNXB
	JMS GETH; SNA; JMP I SETNXB; DCA IHNDL
	TAD INAM+1; DCA NXIB; TAD PT1; DCA PI
	CMA; DCA ICCT; DCA IOPEN; ISZ SETNXB; JMP I SETNXB
PI,	7617
PO,	7600

GETH,	0
	AND (17
	DCA HNO; TAD HNO; TAD (7647-1; DCA MOV10
	CDF 10; TAD I MOV10;	CDF 0
	JMP I GETH


MOV10,	0
	DCA COUNT; CDF 10; TAD I PT1; CDF 0
	ISZ PT1; DCA I PT2; ISZ PT2; ISZ COUNT
	JMP MOV10+2; JMP I MOV10
PT1,	7600
PT2,	ONAM
INAM,	0; 0
ONAM,	0; 0; 0; 0; 0

	PAGE

	*IBUFFR
	IFNDEF USR <USR=0>
DISKIT, JMS GETUSR	/ START BY LOADING USR
	TAD MEM
	SPA
	JMP CLOSIT
	TAD (-10; SMA SZA;E10,	JMS ERR1
	TAD (JMP I PGO+10
	DCA .+1
	HLT
ERRDSK=E10
PGO,	OPIN	/ TRYING TO REWIND-NO FILE. GO OPEN
	OPIN	/ DISK(1)=OPEN
	OPOUT
	OPBOTH	/ OPEN BOTH IN AND OUT AT START
	ERRDSK
	ERRDSK
	ERRDSK
	PREROR
	CHAIN

CALLCD, JMS MESAGE; TEXT /^OUT<IN/
	CIF 10
	JMS I USR
	5
	IEXTN	/ ASSUME .AL OR .AC FOR INPUT AS DEFINED
	TLS	/ ?
	JMS SAVOPT
OPBOTH,	TAD P7600; DCA PO	/ RESET SETNOB SETTING
	JMS GETONAM	/ TRY TO SAVE TIME LATER
REWIND, TAD (7617
	DCA PI	/ SET SETNXB TO EXAMINE INPUT FILES FROM START
	JMP OPIN
LOADIH,	JMS LOADHS	/ GO LOAD HANDLERS
OPIN,	CLA
	/ FORCE .AC OR .AB
	TAD (OEXTN; CDF 10; DCA I (7604; CDF 0	
	TAD (GORUN; DCA WAIT2 
	JMS SETNXB
	JMP CALLCD	/ NO GOOD TRY AGAIN
	JMP LOADIH
/ NOW TO CHECK THAT WE ONLY OPEN OUTPUT ON FIRST DISK(1) OR (3)
	TAD PO; TAD (-7600; SZA CLA; JMP EXITFH	
OPOUT,
LOADOH, JMS SETNOB
IFDEF ALBIN <JMP CALLCD>
IFNDEF ALBIN < JMP NULL>
	JMP LOADON
EXITFH, CDF CIF 0; JMS OUTUSR
	JMP I .+1	/ DONE - CAN EXIT
	FRETRN

LOADON, JMS GETLNAM; JMS LOADHS; JMP LOADOH

GETUSR, 0	/ LOAD USR IF NOT HERE
	TAD USR
K7700,	SMA CLA;	JMP I GETUSR	/ HERE ALREADY
	CIF 10
	JMS I USR
	10
	TAD (200; DCA USR; JMP I GETUSR

OUTUSR, 0	/ UNLOAD USR IF HERE
P7600,	7600; TAD USR; SPA CLA; JMP I OUTUSR	/ GONE ALREADY
	CIF 10
	JMS I USR
	11
	TAD K7700
	DCA USR; JMP I OUTUSR
CLOSIT,	CLA
	TAD CFL; JMS CLOSOF; JMP EXITFH
CLOSOF, 0
	DCA SIZE; TAD ONAM; SNA ; JMP I CLOSOF
	CIF 10
	JMS I USR
	4	/ CLOSE FILE OF LENGTH SIZE
	ONAM+1
SIZE,	0
E11,	JMS ERR1
	JMP I CLOSOF

TYPE,	0
	TSF; JMP .-1; TLS; CLA; JMS KBDCHK; JMP I TYPE

	PAGE
	EJECT
SETNOB, 0
K7600,	7600; JMS GETONAM
	TAD PT1; DCA PO
	TAD ONAM; SNA; JMP I SETNOB
	ISZ SETNOB; JMS GETH; SNA; JMP I SETNOB
	ISZ SETNOB; DCA OHNDL
	JMS DELONAM
	TAD (ONAM+1; DCA NAM; TAD ONAM
	CIF 10
	JMS I USR
	3	/ ENTER FILE
NAM,	ONAM+1
	0
E12,	JMS ERR1
	TAD (OSOUT
NULL2,	DCA POUT; TAD PO; TAD (-7605; SZA CLA
	JMP .+3; TAD NAM; DCA FOBN	/ SAVE VERY FIRST BLOCK
	TAD NAM; DCA NXOB
	TAD NAM+1; DCA OFL; DCA CFL
IFDEF ALBIN <JMS SAVFIL; >
	DCA OCCT; DCA OOPEN; JMP I SETNOB

LOOKUP,	0	/ LOOKUP FILE IN AR1
	CIF 10
	JMS I USR
	2
AR1,	0
	0
	ISZ LOOKUP	/ FILE NOT FOUND
	JMP I LOOKUP

DELONAM, 0	/ DELETE FILE IN ONAM IF IT EXISTS
	TAD (ONAM+1; DCA AR1; TAD ONAM; JMS LOOKUP
	JMS CLOSOF; JMP I DELONAM


LOADHS, 0	/ COME HERE TO LOAD HANDLERS
	CIF 10
	JMS I USR
	13	/ RESET TABLES
	0	/ PRESERVE TENTS
	TAD NPG; CMA; DCA CPG; DCA OFFSET
	TAD ONAM; JMS LIT; DCA OHNDL
	TAD INAM; JMS LIT; DCA IHNDL
	JMP I LOADHS
LIT3,	TAD (ERR0; JMP I LIT
LIT,	0
	SNA; JMP LIT3	/ IF NO REQUIREMENT EXIT WITH ERROR ADDR
	DCA OH; TAD OH; JMS GETH; SZA; JMP I LIT
	TAD BASE; TAD OFFSET; DCA REQ; SKP
LIT2,	ISZ REQ; TAD (200; TAD OFFSET
	DCA OFFSET; TAD OH; ISZ CPG; SKP
E13,	JMS ERR1; CIF 10
	JMS I USR
	1	/ FETCH HANDLER
REQ,	0	/ TO HERE
	JMP LIT2	/ NO JOY TRY AGAIN
	TAD REQ; JMP I LIT
OFFSET,	0
BASE,	HPAGE
OH,	0
CPG,	0
NPG,	NOPAGE
	PAGE
MESAGE, 0
	CLA CLL; TAD I MESAGE; RTR; RTR; RTR
	JMS OUT; TAD I MESAGE; JMS OUT
	ISZ MESAGE; JMP MESAGE+2

OUT,	0
	AND (77; SNA; JMP MESEX; TAD (-36
	SNA; JMP CRLF; TAD (-2
	SPA; TAD (100
	TAD (240; JMS TYPE; JMP I OUT
MESEX,	TSF; JMP .-1; ISZ MESAGE; JMP I MESAGE
CRLF,	TAD (215; JMS TYPE; TAD (212; JMP MESEX-2
GETLNAM, 0	/ RE-GET LAST NAME, ASSUMING PO MOVED ON
	CLA CLL; TAD (-7605; TAD PO; SNL
	CLA; TAD (7600; DCA PO; JMS GETONAM
	JMP I GETLNAM
GETONAM, 0
	TAD PO; DCA PT1; TAD (ONAM; DCA PT2
	TAD (-5; JMS MOV10; JMP I GETONAM

/ CHECK IF OPT D ON IF FILES NOT 000000.AB OR .AC
/ IF IT IS, DELETE FILE.AC
DELQ,	0
	CDF 10; DCA I (7600; DCA I (7605 / STOP RALGOL FINDING OUTPUT
	TAD I (7643; AND (400; CDF 0	/ OPT D?
	SZA CLA; JMS DELONAM; ISZ DELQ; JMP I DELQ

SAVOPT,	0
	CDF 10
IFDEF ALBIN <CLA CLL CML RAR; TAD (40; DCA OPTION
	/ SET OPTION WORD TO 4040. BIT 0 WILL BE
	/ CLEARED IF DEV NOT FILE STRUCTURED
	>
IFNDEF ALBIN <
	TAD I (7644; RAL; AND (40	/OPT T?
/ THIS ROTATE PUTS OPT M TO 2000 AND OPT T TO 4000
	SZA CLA; IAC; RTR; TAD (40; DCA OPTION
/ NOW TO FORCE OPT A IN CASE MACROA CALLED
	TAD I (7643; RAL; CLL CML RAR; DCA I (7643	>
/ OPT G AND L TREATED THE SAME HERE
	TAD I (7643; AND (41; SZA CLA; TAD (400
OP2,	TAD OPTION; AND (7740
	DCA OPTION; TAD I (7645; CDF 0	/ NUMBER OPTIONS
	RTL; AND (7760; SNA; JMP .+5
	ISZ OPTION; RAL; SNL; JMP .-3
	CLA; DCA ERROR; JMP I SAVOPT

IFDEF ALBIN <
SAVFIL,	0	/ CLEAR OPTION BIT 0 IF NON FILE
	TAD NAM; SNA; TAD NAM+1; SNA CLA
	CLL CML RAR; CMA; AND OPTION
	DCA OPTION; JMP I SAVFIL	>

	PAGE
	EJECT
ALRNAM, FILENAME RALGOL.SV
	FILENAME MACROA.SV
CHAIN,	DCA PO; JMS GETLNAM	/ GET FIRST OUTPUT
	TAD FOBN; CDF 10; DCA I (7620
IFDEF ALBIN < TAD I (7617; DCA OPTION-1 >
	TAD I (7600; DCA I (7617
	DCA I (7621; CDF 0
IFDEF ALBIN <
	TAD ONAM+1; TAD (-6060; SNA CLA; JMS DELONAM
	TAD OPTION-1; DCA ONAM 
	ISZ ONAM+4; JMS DELQ	/ CHECK DELETE OF .AC
	NOP; TAD OPTION; AND (400; SNA CLA
	JMP EXOS8	>
IFNDEF ALBIN <	TAD OPTION; AND (2400; SNA CLA	/ OPT G OR M?
	JMP GOS8; TAD OPTION; AND K3000	/ M OR MACH CODE?
	SNA CLA; JMS DELQ; TAD K4	>
	TAD (ALRNAM; DCA AR1; TAD I PNULOUT
K3000,	DCA 0
	TAD I 0; TAD ERROR	/ ERRORS?
	SZA CLA; E14, JMS ERR1	/YES!
	CLA IAC; JMS LOOKUP; SKP	/ OK ITS THERE
E15,	JMS ERR1
	TAD AR1; DCA BLOCK
	CIF 10
	JMS I USR
	6	/ GO CHAIN
BLOCK,	0
E16,	JMS ERR1	/ SHOULD NOT GET HERE!
GOS8,	JMS DELQ; K4, 4; JMP EXOS8
PNULOUT, NULOUT
NULL,	TAD I PNULOUT; DCA POUT
	TAD OPTION; AND (2400; SNA CLA; JMP EXITFH
	CDF 10; TAD I (7643; AND (7377; TAD (400
	DCA I (7643; TAD (7600; DCA 14
	CLA IAC; DCA I (7600
	TAD (6060; DCA I 14
	TAD (6060; DCA I 14
	TAD (6060; DCA I 14
	CDF 0; TAD (7600; DCA PO
	JMP LOADON
PREROR,	TAD ERR0; DCA ERR1; JMP ERR1+2
ERR1,	0
	DCA 15
	JMS MESAGE; TEXT /OS8 ERROR AT /
	JMS OUTUSR; CLA CMA; TAD ERR1; JMS OPS
EXOS8,	JMS KBDCHK; TSF; JMP .-2; JMP 7600

	PAGE
	EJECT
STAVE,	DCA MEM; TAD (7700; DCA USR; JMS I (7607
	4400	/ SAVE 4 PAGES
	IBUFFR
	40	/ WHERE THEY CAN BE RECALLED
E17,	HLT
	TAD GORUN+1	/ =DCA MEM ON THAT PAGE
	DCA FHANDL+1
	TAD (FEX; DCA EXITFH+3
CHANGE,	NOP	/ OR JMP FHANDL+2
	TAD (7600-1; DCA 14; TAD (-47; DCA CT
	CDF 10; DCA I 14; ISZ CT; JMP .-2
	CDF 0;	/ THAT SHOULD CLEAR IN-OUT TABLES
	DCA 201	/ ALSO CLEAR ANY RE-ENTRY
SAVEX,	JMP DISKIT

	/ SET EXTENSION .AC OR .AB AS DEFINED
STAVE2,	TAD (OEXTN; CDF 10; DCA I (7604
	CDF 0; JMS SAVOPT
	TAD SAVEX; DCA CHANGE; DCA 201; JMP 200
CT,	0
$$$$$$