Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/comp/o3.mac
There are 2 other files named o3.mac in the archive. Click here to see a list.
;<ENDERIN>O3.MAC.18, 10-Jan-77 14:07:06, Edit by ENDERIN
	SEARCH SIMMAC,SIMMC3	;[104]

	SALL
	CTITLE	O3

	SUBTTL	Pass 3 I/O


;AUTHOR:		ELISABETH $LUND
;VERSION:		4 [2,10,12,15,15R,20,24,104,144,162,172,222,225]
;PURPOSE:		HANDLE I/O TRANSMISSIONS PASS 3
;CONTENTS:
	INTERN	O3ATR,O3ATRC,O3RA,O3WATR,O3RS,O3WS,O3ERR,O3RI,O3RIB
	INTERN	O3RSC,O3RZ,O3WIB,O3SCLS,O3LS3


	MACINIT
	P3INIT	;[104]
	TWOSEG
	RELOC	400000



	QOHATR==7	;[12] Overhead for ATR file (before ATR info)
	QOHATE==6	;[12] Extra space after ATR info (for end block)

EXTERN	IDLA		;[12] ATR info starts here
EXTERN	E3DB		;CONVERSION DEC ASCII-BIN
EXTERN	E3LICF		;UPDATE PAGE NUMBER FOR FORM FEED
EXTERN	T3A		;[10] DELETE nnnATR.TMP
EXTERN	T3T3		;TERMINATION ROUTINE
EXTERN	.JBREL
EXTERN	Y3ERRL		;LOOKUP ARG SIMERR.ERR
EXTERN	YELATR		;LOOKUP ARG ATR
EXTERN	YELREL		;LOOKUP ARG REL [144]
EXTERN	YBHATR		;BUFFER HEADER ATR
EXTERN	YELEXT		;LOOKUP ARG .ATR
EXTERN	YBHEXT		;BUFFER HEADER .ATR
EXTERN	YELZSE		;LOOKUP ARGUMENT ZSE
EXTERN	YBHZSE		;BUFFERHEADER ZSE.TMP
EXTERN	YBHSRC		;BUFFERHEADER INFILE.SIM
EXTERN  YBHLS3		;BUFFERHEADER LS3.TMP
EXTERN	YELLS1		;LOOKUP ARGUMENT LS1.TMP
EXTERN	YBHLS1		;BUFFERHEADER LS1.TMP
EXTERN	YBHREL		;BUFFER HEADER REL FILE
EXTERN	YEXTS		;LOOKUP ARGS FOR STANDARD FILES
EXTERN	Y3BUFS		;USED WHEN READING ERROR TABLES INTO CORE
EXTERN	Y3INBU		;COMMAND LIST UNBUFFERED INPUT ERROR TABLES
EXTERN	Y3INER		;COMMAND LIST UNBUFFERED INPUT ZSE
EXTERN	Y3ATRE		;POINTER END OF ATR
EXTERN	YJOB		;JOB NUMBER
EXTERN	YE3LNO		;LINE NUMBER
EXTERN	YBHIC2		;BUFFERHEADER IC2
EXTERN	YE3D		;DICTIONARY FOR ERROR MESSAGES
EXTERN	YE3M		;TABLE FOR ERROR HANDLING
EXTERN	YE3MI		;TABLE FOR ERROR HANDLING
EXTERN	YDMEND		;INDEX END OF ZDM
EXTERN	Y3OPEN		;STATUSWORD CHANNELS
EXTERN	YSIMNAME	;[12] SIMULA class/proc name in Radix50 for global module
EXTERN	YATRFIL		;[12] ATR file name in RADIX50 corresp. to YSIMNAME
EXTERN	YATRFN,YATRPPN,YATRDEV,YATROFS	;[144]
IFN QDEC20,<;[225]
EXTERN	YATRJFN,YFILSP
>
EXTERN	ZSE		;SYMBOLTABLE
EXTERN	ZLEREC		;RECORD TO KEEP LS1 RECORD
EXTERN	E3DB		;CONVERSION DEC ASCII-BIN

	LS1INIT

DEFINE	IOER(FILE)<
	L	X1,[ASCIZ/FILE/]>
	SUBTTL	O3ATR


;PURPOSE:		READ ATR.TMP INTO CORE OR MOVE IT TO IDL IF ALREADY IN CORE
;ENTRY:			O3ATR
;INPUT ARGUMENTS:	-
;NORMAL EXIT:		RETURN
;ERROR EXIT:		BRANCH O3INER, BRANCH O3LOER
;OUTPUT ARGUMENTS:	Y3ATRE POINTER TO POS AFTER ATRLIST
;CALL FORMAT:		EXEC	O3ATR


O3ATR:
	PROC
	SAVE	<X2>
	IF	;ATR.TMP in core
		SKIPE	YELATR
		GOTO	FALSE
	THEN
		LD	X0,YBHATR+1
		ADDI	X1,QOHATE	;[12] allow for END block and two extra words
		EXEC	O3ATRC		;Ensure space for ATR info
		HRRI	X0,IDLA
		BLT	X0,IDLA(X1)
		L	X2,X1
	ELSE
		;ATR.TMP IS A DISK FILE
		;OPEN FILE,UNBUFFERED MODE
		IOER(ATR)
		OPEN	QCHATR,O3UO
		BRANCH	O3OPER
		SETZM	YELATR+3	;[162] Default path
		LOOKUP	QCHATR,YELATR
		BRANCH	O3LOER
		HLRE	X0,YELATR+3
		MOVN	X1,X0
		ADDI	X1,QOHATRE	;[12] allow for END block and two extra words
		L	X2,X1
		;GET MORE CORE IF NOT ENOUGH
		EXEC	O3ATRC
		LI	X0,IDLA-1	;Set up IOWD list in X0, X1 for dump mode input
		ADD	X0,YELATR+3
		LI	X1,0
		IN	QCHATR,X0
		SKIPA
		;ERROR RETURN
		BRANCH	[IOER(ATR)
			BRANCH	O3INER]
		EXEC	T3A	;[10] DELETE nnnATR.TMP
	FI
	ADDI	X2,IDLA		;[12]
	ST	X2,Y3ATRE
	RETURN
	EPROC
	SUBTTL	O3ATRC

;PURPOSE:		GET CORE IF NOT ENOUGH AFTER IDL
;ENTRY:			O3ATRC
;INPUT ARGUMENTS:	REG X1 CONTAINING SIZE OF CORE NEEDED AFTER IDL
;NORMAL EXIT:		RETURN
;ERROR EXIT:		BRANCH	T3T3
;OUTPUT ARGUMENTS:	-
;CALL FORMAT:		EXEC	O3ATRC


O3ATRC:	PROC
	SAVE	<X2>

	LI	X2,IDLA(X1)	;[12]
	IF
		CAMG	X2,.JBREL
		GOTO	FALSE
	THEN
		;NOT ENOUGH CORE,GET MORE
		IFG	QTRACE,<EXTERN	YTRPAS
			IFOFF	YTRSW>
		CORE	X2,
		GOTO	[;ERROR,CAN'T GET MORE CORE
			ERRT	QT,560
			BRANCH	T3T3]
	FI
	RETURN
	EPROC
	SUBTTL O3RS


;PURPOSE:		 READ LS1.TMP
;ENTRY:			 O3RS
;INPUT ARGUMENTS:
;NORMAL EXIT:		 RETURN
;ERROR EXIT:		 RETURN AND SKIP
;OUTPUT ARGUMENTS:	 REG X1 CONTAINING CONTROL WORD
;CALL FORMAT:	 	EXEC	O3RS
;			CORRECT RETURN
;			END OF FILE RETURN


O3RS:	
	IF	SOSGE 	YBHLS1+2
		GOTO	FALSE
	THEN	ILDB	X1,YBHLS1+1
		RETURN
	FI
	IF
		SKIPN	YELLS1
		GOTO	TRUE	;IF FILE IN CORE
		IN	QCHLS1,
		GOTO	O3RS
		STATO	QCHLS1,20K
		GOTO	[IOER	LS1
			BRANCH	O3INER]
	THEN	;EOF
		AOS	(XPDP)
		RETURN
	FI
	SUBTTL O3WS


;PURPOSE:	MOVE SOURCE CODE LINE TO LST file
;ENTRY:		O3WS
;INPUT ARGUMENTS:	X1 points to the line to copy
;NORMAL EXIT:	RETURN
;OUTPUT ARGUMENTS:	
;CALL FORMAT:	EXEC	O3WS,<NO>		;NO=NUMBER OF BYTES TO OUTPUT



O3WS:	PROC	<A>
	SAVE	<X2>
	L	X2,A
	HRLI	X1,440700			;INIT BYTEPOINTER
	LOOP
		SOSGE	YBHLS3+2
		EXEC	O3LS3
		ILDB	X0,X1		;GET BYTE TO OUTPUT
		IDPB	X0,YBHLS3+1
	AS
		SOJG	X2,TRUE
	SA
	RETURN
	EPROC
	SUBTTL	O3LS3


;PURPOSE:	OUTPUT BUFFER TO LS3
;RESTRICTIONS:	NO REGS MAY BE DESTROYED IN THIS ROUTINE

O3LS3:	PROC
	OUT	QCHLS3,
	SOSGE	YBHLS3+2
	GOTO	[IOER	LS3
		BRANCH	O3OUTE]
	RETURN
	EPROC
	SUBTTL	O3ERR

;PURPOSE:	 READ TABLES IN SIMERR.ERR INTO CORE
;ENTRY:			O3ERR
;INPUT ARGUMENTS:	SIMERR.ERR
;NORMAL EXIT:		RETURN
;ERROR EXIT:		GOTO O3LOER,GOTO O3OPER RESP GOTO O3INER
;OUTPUT ARGUMENTS:	YE3D,YE3DL,YE3M,YE3MI
;CALL FORMAT:		EXEC	O3ERR


	IFE QDEC20,<;[225]
	EXTERN	YP1DEV,YP1PPN	;[172]
	>

O3ERR:
	PROC
	SAVE	<X2,X3>	;[172]
	;CREATE COMMAND LIST IN LOWSEG
	LD	X0,[IOWD 200,Y3BUFS
		   0]
	STD	X0,Y3INBU
	LD	X0,[SIXBIT/SIMERRERR/]
	STD	X0,Y3ERRL
	SETZM	Y3ERRL+2
	L	X0,O3ERRP
	ST	X0,Y3ERRL+3
	IFE QDEC20,<;[225] Cannot handle this case on the DEC-20 presently
	;[172] Try same area as Pass1 first
	LI	X0,17	;Dump mode
	L	X1,YP1DEV
	SETZ	X2,
	OPEN	QCHERR,X0
	GOTO	L1	;On failure
	LD	X0,Y3ERRL
	SETZ	X2,
	L	X3,YP1PPN
	LOOKUP	QCHERR,X0
	SKIPA	;Error
	GOTO	L2
	>;[225]
L1():!	IOER(ERR)	;[21] MOVED HERE NOT TO BE DESTROYED BY LD X0,

	OPEN	QCHERR,[EXP 17			;OPEN FILE
			EXP QSYSDEV
			0]
	GOTO	O3OPER				;ERROR RETURN
	LOOKUP	QCHERR,Y3ERRL
	GOTO	O3LOER				;ERROR RETURN
	SETON	YOPERR
L2():!	;INPUT LENGTH OF LISTS ,YE3DL AND THE BEGINNING OF YE3D
	;COMMAND LIST (MUST BE IN LOWSEG)
	INPUT	QCHERR,Y3INBU
	STATZ	QCHERR,740000		;CHECK IF ERRORS
	GOTO	O3INER
	;UPDATE COMMAND LIST FOR INPUT
ASSERT	<LD	X0,Y3BUFS+1
		CAIG	X0,QE3D
		CAILE	X1,QE3M
		OUTSTR	[ASCIZ	/TOO LONG ERROR TABLE IN SIMERR/]
		L	X0,Y3BUFS+3
		CAILE	X0,300
		OUTSTR	[ASCIZ	/TOO MANY ERROR MESSAGES IN SIMERR/]>
	MOVN	X2,Y3BUFS+1
	ADDI	X2,200-4-^D16		;FIRST BUFFER CONTAINS 4 WORDS
					;OF LENGTHS , YE3DL AND THE BEGINNING OF YE3D
	MOVN	X0,Y3BUFS+2
	HRLI	X0,YE3M-1
	MOVN	X1,Y3BUFS+3
	HRLI	X1,YE3MI-1
	IF
		JUMPL	X2,FALSE
	THEN	;YE3DL AND YE3D DO NOT FILL A DISK BUFFER
		MOVSM	X0,Y3INER
		MOVSM	X1,Y3INER+1
		SETZM	Y3INER+2
	ELSE	
		HRLI	X2,YE3D+200-4-^D16-1
		MOVSM	X2,Y3INER
		MOVSM	X0,Y3INER+1
		MOVSM	X1,Y3INER+2
		SETZM	Y3INER+3
	FI
	;INPUT THE REST OF YE3D, YE3M, YE3MI
	INPUT	QCHERR,Y3INER
	STATZ	QCHERR,740000
	GOTO	O3INER
	SETOFF	YOPERR
	CLOSE	QCHERR,
	STATZ	QCHERR,740000			;CHECK IF FILE CORRECTLY CLOSED
	GOTO	O3CLER
	RELEASE	QCHERR,
	SETONA	Y3ERR
	RETURN
	EPROC
	SUBTTL	O3RA

IFE QDEC20,<;[225]


;PURPOSE:		READ .ATR
;ENTRY:			O3RA
;INPUT ARGUMENTS:	-
;NORMAL EXIT:		RETURN
;ERROR EXIT:		BRANCH	O3INER
;OUTPUT ARGUMENTS:	-
;CALL FORMAT:		EXEC	O3RA

O3RA:
	PROC
	IN	QCHEXT,
	SOSGE	YBHEXT+2
	SKIPA
	RETURN
	IOER(EXT)
	BRANCH	O3INER
	EPROC
>

IFN QDEC20,<O3RA=O1EXT##>	;[225]
	SUBTTL O3RI


;PURPOSE		READ ONE WORD FROM IC2.TMP AND/OR INPUT BUFFER FROM IC2
;ENTRY:			O3RI	TO READ ONE WORD
;			O3RIB	TO INPUT BUFFER FROM IC2

;INPUT ARGUMENTS:
;NORMAL EXIT:		RETURN
;ERROR EXIT:		AT END OF FILE :  RETURN AND SKIP
;OUTPUT ARGUMENTS:	REG X0 CONTAINING WORD FROM IC2.TMP IF ENTRY WAS O3RI
;CALL FORMAT:		EXEC	O3RI
;			CORRECT RETURN
;			RETURN AT END OF FILE


O3RI:
	WHILE
		SOSGE	YBHIC2+2
		GOTO	TRUE
		ILDB	X0,YBHIC2+1
		RETURN
	DO
		IN	QCHIC2,				;INPUT ANOTHER BUFFER
	OD
	;CHECK IF ERROR/END OF FILE
	GETSTS	QCHIC2,X0
	IF	TRNE	X0,1B22
		GOTO	FALSE
O3RIL1:
	THEN
		IOER(IC2)
		BRANCH	O3INER
	FI
	;END OF FILE

	AOS	(XPDP)
O3RIL:
	RETURN


O3RIB:	;INPUT A BUFFER FROM IC2
	IN	QCHIC2,
	RETURN
	GOTO	O3RIL1
	SUBTTL	O3RSC


;PURPOSE		READ WORDS FROM SOURCE CODE FILE,AND
;			REPLACE FAULTY LINE NUMBER IN SOURCE WITH CORRECT NUMBER
;			INSERT MISSING END OF LINE CHARACTERS
;			OUTPUT TO LIST FILE IF RELEVANT
;ENTRY:			O3RSC
;INPUT ARGUMENT:	-
;NORMAL EXIT:		RETURN
;ERROR EXIT:
;OUTPUT ARGUMENTS:	YE3LIN
;CALL FORMAT:		EXEC O3RSC


O3RSC:
	PROC
	SAVE	<X2,X3,X4>
	LF	X3,ZLEIND
	IF
		IFOFF	ZLESRC
		GOTO	FALSE				;NO LINE IN SOURCE CODE
	THEN
		;LINE NUMBER IN SOURCE
		;SKIP BYTES UNTIL NEXT FULL WORD BOUNDARY
	
		EXEC	O3RSC5
		;GET LINE NUMBER
		EXEC	O3RSC6
		IF
			;CHECK IF LINE NUMBER IS CORRECT
			IFOFF	ZLEOK
			GOTO	FALSE
		THEN
			;CORRECT LINE NUMBER
			IF
				IFOFFA	YE3LST
				GOTO	FALSE
			THEN
				;CORRECT LINE NUMBER AND LIST WANTED
				TRZ	X1,1
				SETZB	X0,X2
				;OUTPUT LINE NUMBER AND CONVERT IT TO BIN
				LOOP
					LSHC	X0,7
					SOSGE	YBHLS3+2
					EXEC	O3LS3
					IDPB	X0,YBHLS3+1
					IMULI	X2,^D10
					SUBI	X0,"0"
					ADDM	X0,X2
					LI	X0,0
				AS
					JUMPN	X1,TRUE
				SA
				ST	X2,YE3LNO	;SAVE LINENUMBER
			ELSE
				;CORRECT LINENUMBER,CHECK IF ANY ERRORS
				IF
					SKIPN	YDMEND
					GOTO	FALSE
				THEN
					;ERRORS SAVE LINE NUMBER
					L	X0,X1
					EXEC	E3DB
					ST	X1,YE3LNO
				FI
			FI
		FI
	FI

	HLRZ	X4,O3TYP(X3)
	IF	;No LST file output
		IFONA	YE3LST
		GOTO	FALSE
	THEN	;READ ONE SOURCE LINE
		EXEC	O3RSCT
		WHILE
			SOJLE	X4,FALSE
		DO
			EXEC	O3RSCT
		OD
	ELSE	;READ SOURCE CODE AND OUTPUT TO LIST FILE
	
		EXEC	O3RSC1
	
		;READ END OF LINE CHARACTERS AND OUTPUT TO LIST FILE
		WHILE
			SOJLE	X4,FALSE
		DO
			EXEC	O3RSC2
		OD
		IF
			CAIE	X1,QFF
			CAIN	X1,QVT
			GOTO	FALSE
		THEN
			SOSGE	YBHLS3+2
			EXEC	O3LS3
			IDPB	X1,YBHLS3+1
		ELSE
			;VT OR FF, VT IS REPLACED BY FF
			EXEC	E3LICF
		FI
		HRRZ	X4,O3TYP(X3)
		
		;OUTPUT MISSING LINE CHARACTERS
	
		IF	;ONLY  LF 	;[15R]
			JUMPN	X3,FALSE
			CAIN	X2,QCR
			GOTO	FALSE
		THEN
			LI	X4,QCR
		FI


		WHILE
			JUMPE	X4,FALSE
		DO
			SOSGE	YBHLS3+2
			EXEC	O3LS3
			IDPB	X4,YBHLS3+1
			LSH	X4,-7
		OD
	FI
	RETURN
	EPROC


;ROUTINE TO READ BYTES FROM SOURCE CODE
;AND OUTPUT TO LIST FILE

O3RSC2:
	LOOP
		SOSGE	YBHLS3+2
		EXEC	O3LS3

		L	X2,X1	;[15R] SAVE LAST CHAR BEFORE LINE CHAR

		IDPB	X1,YBHLS3+1
O3RSC1:
		SOSGE	YBHSRC+2
		EXEC	O3RSCS
		ILDB	X1,YBHSRC+1
	AS
		;RETURN FROM O3RSCS IF END OF FILE
		CAILE	X1,QFF	;[15]
		GOTO	TRUE
		CAIL	X1,QLF				;HT CAUSES NO NEW LINE
		RETURN
		JUMPN	X4,TRUE
		JUMPN	X1,TRUE
	SA
	;RETURN IF END OF FILE
	RETURN



O3RSC5:

	;ROUTINE TO READ BYTES FROM SOURCE CODE UNTIL NEXT FULL WORD BOUNDARY
	WHILE 
		L	X1,YBHSRC+1
		TLNN	X1,300000
		GOTO	FALSE
	DO
		SOSGE	YBHSRC+2
		EXEC	O3RSCS
		IBP	YBHSRC+1
	OD
	RETURN
O3RSC6:
	;GET LINE NUMBER FROM SOURCE TO REG X1
	LOOP
		SOSGE	YBHSRC+2
		EXEC	O3RSCS
		MOVNI	X0,4
		ADDM	X0,YBHSRC+2
		AOS	YBHSRC+1
		SKIPN	X1,@YBHSRC+1
	AS
		GOTO	TRUE
	SA
	RETURN



O3RSCS:
	;INPUT ANOTHER BUFFER OF SOURCE CODE
	IF
		IN	QCHSRC,
		GOTO	FALSE
	THEN
		GETSTS	QCHSRC,X0
		IF
			;END OF FILE ALLOWED ONLY WHEN SOURCE FILE ENDS
			;WITH EOF WITHOUT PRECEDING END OF LINE CHARACTERS
			TRNN	X0,740000
			TRNN	X0,20000
			GOTO	FALSE
		THEN
			JUMPN	X4,FALSE
			LI	X1,0
			AOS	(XPDP)
			RETURN
		FI
		IOER(SRC)
		BRANCH	O3INER
	FI
	SOSGE	YBHSRC+2
	GOTO	O3RSCS
	RETURN


	;ROUTINE TO READ ONE LINE OF SOURCE CODE,NO OUTPUT TO LS3

O3RSCT:
	LOOP
		SOSGE	YBHSRC+2
		EXEC	O3RSCS
		ILDB	X1,YBHSRC+1
	AS
		CAILE	X1,QFF	;[15]
		GOTO	TRUE
		CAIL	X1,QLF
		RETURN
		JUMPN	X4,O3RSCT
		JUMPN	X1,O3RSCT
		RETURN
	SA
	SUBTTL	O3SCLS


;PURPOSE:		READ SOURCE CODE AND OUTPUT TO LIST FILE
;			WITHOUT ANY REARRANGEMENT OF SOURCE CODE.
;			CALLED ONLY IF  ILLEGAL END OF PROG
;ENTRY:			O3SCLS
;INPUT ARGUMENTS:	-
;NORMALE EXIT:		RETURN
;ERROR EXIT:		-
;OUTPUT ARGUMENTS:	-
;CALL FORMAT:		EXEC	O3SCLS


O3SCLS:	LOOP
		WHILE	;More in current source code buffer
			SOSGE	YBHSRC+2
			GOTO	FALSE
		DO	;Read and copy to list file
			ILDB	X0,YBHSRC+1
			SOSGE	YBHLS3+2
			EXEC	O3LS3
			IDPB	X0,YBHLS3+1
		OD
		IN	QCHSRC,	;Get next buffer
	AS	;End of file not reached
		GOTO	TRUE
	SA
	GETSTS	QCHSRC,X0
	TRNE	X0,1B22
	RETURN	;IF END OF FILE
	IOER(SRC)
	BRANCH	O3INER
	SUBTTL	O3RZ

;PURPOSE:		READ SYMBOLTABLE ZSE.TMP INTO CORE
;ENTRY			O3RZ
;INPUT ARG:
;NORMAL EXIT:		RETURN
;ERROR EXIT:		GOTO	O3OPER AT ERROR IN OPEN
;			GOTO	O3LOER AT ERROR IN LOOKUP
;			GOTO	O3INER AT ERROR IN IN
;			GOTO	O3CLER AT ERROR IN CLOSE

;OUTPUT ARGUMENTS:
;CALL FORMAT:		EXEC	O3RZ


O3RZ:
	IF
		SKIPE	YELZSE
		GOTO	FALSE
	THEN	;ZSE IN CORE
		LD	X1,YBHZSE+1
		HRRI	X1,ZSE
		BLT	X1,ZSE(X2)
		RETURN
	FI
	IOER(ZSE)				;USED ONLY IF READ ERROR ON ZSE

	OPEN	QCHZSE,O3UO			;OPEN FILE
	GOTO	O3OPER				;ERROR RETURN
	L	X0,YJOB				;CURRENT JOB NUMBER
	HLLM	X0,YELZSE
	LOOKUP	QCHZSE,YELZSE
	GOTO	O3LOER
	SETOFF	YPOZSE
	L	X2,YELZSE+3
	HRRI	X2,ZSE-1
	LI	X3,0
	IN	QCHZSE,X2
	SKIPA
	BRANCH	O3INER
	IFE	QDEBUG,<;ONLY PRODUCTION VERSION
			LI	X2,0
			RENAME QCHZSE,X2
			NOP
			>
	SETOFF	YOPZSE
	CLOSE	QCHZSE,
	STATZ	QCHZSE,740000
	GOTO	O3CLER				;CHECK FOR ERRORS
	RELEASE	QCHZSE,
	RETURN
	SUBTTL	O3WATR


;PURPOSE:		Write ATR file, rename old to .QTR, in the following cases:
;			1. NEWATR is TRUE, i e there is no old ATR module with
;			   the correct information in the search list.
;			2. [144] The old module was found in a library, and a copy
;			   is made to the same area as the REL file in order
;			   to facilitate loading of a SIMULA program using the
;			   new module.
;ENTRY:			O3WATR
;INPUT ARGUMENTS:	SWITCHES NEWATR, INLIB AND OLDATR
;NORMAL EXIT:		RETURN
;ERROR EXIT:		BRANCH	T3T3
;OUTPUT ARGUMENTS:	-
;CALL FORMAT:		EXEC	O3WATR


O3WATR:
	PROC
	SAVE	<X2,X3,X4,X5>
	SETOM	X4
	IOER(EXT)
	IFN QDEC20,<;[225]
	SKIPE	YATRJFN	;Close and release  JFN
	EXEC	O1EXCL##
	>
	MOVS	YEXTS+11	;[225] REL FILE DEV SWAPPED
	IF	;[225] NUL:
		CAIE	'NUL'
		GOTO	FALSE
	THEN	;NO ATR FILE TO BE WRITTEN
		SETOFA	NEWATR
		SETOFA	INLIB
	FI
	IF	;New ATR file is to be generated
		IFONA	INLIB	;[144]
		GOTO	TRUE	;[144]
		IFOFFA	NEWATR
		GOTO	FALSE
	THEN
		IF	;There was an old ATR file with the same name
			IFOFFA	INLIB	;[20] but not in a library
			IFOFFA	OLDATR
			GOTO	FALSE
		THEN	;[144] Rename the old ATR file (extension QTR)
			EXEC	O3WARE
		FI	;[144]
		L	X1,[ASCIZ/EXT/]
		LI	X2,17		;[144] Dump mode
		SKIPN	X3,YEXTS+11	;REL file device
		MOVSI	X3,'DSK'
		STACK	X4		;[144]
		SETZ	X4,
		OPEN	QCHEXT,X2	;[144]
		GOTO	O3OPER
		UNSTK	X4		;[144]
		IFONA	NEWATR		;[144]
		HLLZS	YELEXT+1	;Clear date info
		MOVSI	X2,777		;[222] Data mode is kept
		IFONA	OLDATR		;[2,222] Copy old atr protection
		 TLO	X2,(777B8)	;[222]
		IFOFFA	NEWATR		;[222] Keep creation date for copy
		 TRO	X2,-1		;[222]
		IFONA	INLIB		;[222] Std protection if copied
		 TLZ	X2,(777B8)	;[222]  from library, however
		ANDM	X2,YELEXT+2	;Clear unwanted data
		L	YELREL		;[144] Name from REL file name
		ST	YELEXT		;[144]
		L	YELREL+3	;[144]
		ST	YELEXT+3	;[144]
		ENTER	QCHEXT,YELEXT
		BRANCH	O3ENER
		ST	YELEXT+3	;[144] Restore ppn
		;OUTPUT WHOLE BUFFER
	    ;[12] Start of changes
		L	X2,Y3ATRE
		SUBI	X2,IDLA+QOHATE	;Compute faked word count for type 0 block
		L	X2
		ADDI	X2,^D18
		IDIVI	X2,^D19
		IF	;No remainder
			JUMPN	X3,FALSE
		THEN	;Must adjust word count
			ADDI	X0,1
			LI	X3,1
		ELSE
			SETZ	X3,
		FI
		SUBI	X0,(X2)		;Subtract number of reloc words
		ST	X0,IDLA-1
		ADD	X3,Y3ATRE
		;--- END block ---;
		L	[5,,2]
		ST	0-QOHATE(X3)
		SETZB	1-QOHATE(X3)
		SETZM	2-QOHATE(X3)
		SETZM	3-QOHATE(X3)
		LI	X2,IDLA-1-QOHATR ; Start of ENTRY block -1
		;--- ENTRY block ---;
		L	[4,,1]
		ST	1(X2)
		SETZM	2(X2)
		L	YSIMNAME
		ST	3(X2)	;Radix50 SIMULA name
		;--- NAME block ----;
		L	[6,,1]
		ST	4(X2)
		SETZM	5(X2)
		L	YATRFIL
		ST	6(X2)	;Put file name in name block
		MOVN	X0,X3
		ADDI	X0,IDLA-QOHATR+2	;No extra words
	    ;[12] End of changes
		HRL	X2,X0
		LI	X3,0
		OUT	QCHEXT,X2
		SKIPA
		BRANCH	O3OUTE
		IFE QDEC20,<;[225]
	FI	>	;Put close outside if DEC-10
	CLOSE	QCHEXT,
	STATZ	QCHEXT,
	BRANCH	O3CLER
	RELEASE	QCHEXT,
		IFN QDEC20,<;[225]
	FI		;Close inside conditional if DEC-20
	SKIPE	X1,YATRJFN	;Release JFN
	RLJFN
	CAI		;Error, don't care
		>;[225]
	;SETON SWITCH IF OLD ATR FILE IS CORRECTLY DELETED
	SKIPN	X4
	SETONA	OLDATR
	RETURN
	EPROC
	SUBTTL	O3WARE

;[144] Delete any old QTR file. Rename old ATR file to QTR with standard prot.
;Rename only if the specifications of old and
; new ATR files are identical
;If not, but they are in fact on the same area, the old
; one will be overwritten if not protected.

	IFE QDEC20,<;[225] DEC-10 version
O3WARE:	PROC
	SAVE	X1
	EXEC	O3WAID	;[144] Check for identity
	GOTO	L9	;[224] Not identical
	SETOFA	OLDATR	;TO PREVENT ILLEGAL MSG IF PROT ERROR
	L	X2,YELEXT
	MOVSI	X3,'QTR'
	SETZ	X4,	;Standard protection
	L	X5,YELEXT+3	;Same ppn
	RENAME	QCHEXT,X2
	SKIPA	;Did not work
	GOTO	L9	;Ok
	;There may be an old .QTR around
	LI	X2,17	;Dump mode, why not?
	SKIPN	X3,YEXTS+11	;REL device
	MOVSI	X3,'DSK'
	SETZ	X4,
	OPEN	X2	;Use channel 0 to find old QTR file
	GOTO	L9	;No use trying more, accept consequences
	L	YELEXT
	MOVSI	X1,'QTR'
	LD	X2,YELEXT+2
	LOOKUP
	GOTO	L2
	SETZB	X3	;Zero filename and ppn
	RENAME		;Delete the old backup
	NOP	;Ignore errors here
L2():!	RELEASE
	L	X2,YELEXT
	MOVSI	X3,'QTR'
	SETZ	X4,	;Standard protection
	L	X5,YELEXT+3	;Same ppn
	RENAME	QCHEXT,X2
	NOP		;Ignore error
L9():!	RETURN
	EPROC
	>
	IFN QDEC20,<;[225]
O3WARE:	PROC
	SAVE	X1
	EXEC	O3WAID
	GOTO	L8
	SETOFA	OLDATR
	;Recover file spec string (without ATR)
	HRROI	X1,YFILSP
	HRRZ	X2,YATRJFN
	L	X3,[2B2+2B5+1B8+0B11+JS%PAF]
	JFNS
	;Append "QTR" as extension
	L	X2,[POINT 7,[ASCIZ/.QTR/]]
	LOOP
		ILDB	X2
		IDPB	X1
	AS
		JUMPN	TRUE
	SA
	HRROI	X2,YFILSP
	MOVSI	X1,(GJ%SHT)	;Short form
	GTJFN
	GOTO	L8	;Failed
	LI	X2,(X1)	;JFN
	HRRZ	X1,YATRJFN
	RNAMF		;Do the rename
	RLJFN		;Release JFN
L8():!	CAIA
L9():!	SETZ	X4,	;Signal correct rename
	RETURN
	EPROC
>
	SUBTTL	O3WAID

;[144] Check for identical spec for old and new ATR file
;      Skip return if ok

O3WAID:	PROC
	n==0	;Number of stacked words
	SKIPN	X2,YEXTS+11
	MOVSI	X2,'DSK'
	CAME	X2,YATRDEV
	GOTO	L9
	L	X3,YATRPPN
	IF	;Unequal PPN spec
		CAMN	X3,YEXTS+7
		GOTO	FALSE
	THEN	;They may still be on the same SFD path
		IFN QDEC20,<GOTO L9>;[225] No SFD possible
		IFE QDEC20,<;[225]
		JUMPE	X3,L9	;Not if just default path
		L	X2,YEXTS+7
		JUMPE	X2,L9
		TLNN	X3,-1	;Must be pointer
		TLNE	X2,-1	;So must the other
		GOTO	L9
		LOOP	;Comparing SFD paths
			L	2(X2)
			CAME	2(X3)
			GOTO	L9
		AS
			JUMPE	FALSE
			ADDI	X2,1
			AOJA	X3,TRUE
		SA
		>;[225]
	FI	;They are identical!
	AOS	-n(XPDP)
L9():!	RETURN
	EPROC
	SUBTTL O3WIB


;PURPOSE:		WRITE WORDS TO REL file
;ENTRY:			O3WIB TO WRITE MORE THAN ONE WORD
;INPUT ARGUMENTS:	REG X1 CONTAINING NUMBER OF WORDS TO WRITE,
;			REG X0 CONTAINING ADDR OF BUFFER TO OUTPUT
;NORMAL EXIT:		RETURN
;ERROR EXIT:
;OUTPUT ARGUMENTS:	-
;CALL FORMAT:		EXEC	O3WIB  


O3WIB:
	PROC

	HRLZ	X0,X0
	ADD	X1,YBHREL
	HRR	X0,YBHREL
	ADDI	X1,1
	HRRM	X1,YBHREL+1
	ADDI	X0,2
	BLT	X0,@X1				;OUTPUT LOCAL BUFFER TO OUTPUT BUFFER
	OUT	QCHREL,
	RETURN
	IOER(REL)
	BRANCH	O3OUTE
	EPROC
QO3TNO=560

	;PPN FOR SIMERR.ERR
O3ERRP:	EXP	QERPPN
O3UO:	;OPEN BLOCK UNBUFFERED MODE
	EXP	17
	SIXBIT	/DSK/
	0
O3TYP:
	;[15]
	XWD	1,0		;LF ;[15R]
	XWD	1,QCRLF		;VT
	XWD	1,QCRLF		;FF
	XWD	2,0		;LFVT
	XWD	2,0		;LFFF
	XWD	0,QCRLF		;ONLY EOF (0)

O3OPER:	ERRT	QT,Q.TER
	BRANCH	T3T3
O3INER:	ERRT	QT,Q.TER+3
	BRANCH	T3T3
O3OUTE:	ERRT	QT,Q.TER+4
	BRANCH	T3T3
O3LOER:	ERRT	QT,Q.TER+1
	BRANCH	T3T3
O3ENER:	ERRT	QT,Q.TER+2
	BRANCH	T3T3
O3CLER:	ERRT	QT,Q.TER+5
	BRANCH	T3T3
	LIT

	END