Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/comp/o2sa.mac
There are 2 other files named o2sa.mac in the archive. Click here to see a list.
;<ENDERIN>O2SA.MAC.2,  6-Dec-76 15:11:34, Edit by ENDERIN
 	SEARCH	SIMMC2,SIMMCR,SIMMAC,SIMRPA
	SALL
	CTITLE	O2SA
COMMENT;

AUTHOR:		STEFAN ARNBORG

VERSION:	4 [7,15,22,23,116,140,225]

CONTENTS:	O2AD,O2OP,O2GI,O2RF,O2D1,O2ER,O2D1GW

;
	MACINIT
	TWOSEG
	RELOC	400K
	CGINIT
	EXTERN	CADS,CGG2,CGG3,CGG4,CGR2,CGR4,CGR3,O2CF,O2DF,O2GA,O2GF,O2GR,O2GW,O2IC2T
	EXTERN	CGAD,CGCA,CGCC,CGCO,CGIM,CGIM1,CGLO,CGLO1,CGMO,CGMO1,M2CO
	EXTERN	CGVA,O2GWD
	EXTERN	Y17BUF,YO2ZSD,YSWCHA,YSTATM,YO2LTP
	EXTERN	YELIN1,YELIN2,YQREL,YOLINE,YLINE,YRELCD,YO2LNB,YRELLT,YLSLIN,YRELST
	IFN	QDEBUG,<EXTERN	O2DB1,O2DB3,O2DB4,YO2DBZ,DBRTMU>
	EXTERN	O2IV,CGRD
	EXTERN	EXAT
	EXTERN	YBRBUF,YBRZSE
	EXTERN	YBHATR,YELATR
	EXTERN	YBHDF1,YBHIC1,YBHIC2,YO2ADI,YO2ADF,YOPCOD,YTAC,YZHBXC,YCGACT
	EXTERN	YFXTAB,YLXIAC,Y3OPEN,YSYSI,YDCSTO,YDCSTP,YO2DFW
	EXTERN	YERRCT,YJOB,YELDF1,YELIC1,YBHIC2,YELIC2,YCABKB,YO2FIX,YO2LAS,Y3LOWE
	EXTERN	YGAP,YQRELR,YQRELT
	INTERN	O2ATR,O2AD,O2OP,O2GI,O2RF,O2AB,O2EX
	INTERN	O2D1,O2ERO,O2ERL,O2ERE,O2ERI,O2ERU,O2ERR
	INTERN	O2D1GW
	INTERN	O2SM,O2LN1,O2LN2,O2LN3,O2LN3,O2LN4,O2LN5,O2LN6
QMINDL=	-2		; DISPLAY LEVEL(ZPCEBL) OF OUTERMOST, RELOCATED BLOCK
	DEFINE	IOER(F)=<
		L	X1,[ASCIZ/F/]
	>
	SUBTTL	O2D1
COMMENT;

PURPOSE:	READ DECLARATIONS FOR A SCOPE INTO DECLARATION STACK

ENTRY:		O2D1

;

;AUX ROUTINE TO GET ONE WORD FROM DF1 TO X4
O2D1GW:	SOSGE	YBHDF1+2	; DECREASE BYTE COUNT
	GOTO	[
		ASSERT<	SKIPN	YELDF1
			RFAIL READING PAST EOF IN DF1
		>
		IN	QCHDF1,
		GOTO	O2D1GW
		IOER	DF1
		EXEC	O2ERI]
	ILDB	X4,YBHDF1+1
	RETURN

; ROUTINE TO READ ONE RECORD (ZHE,ZHB OR ZQU) INTO THE DECLARATION STACK
; ENTRY ASSERTION 	STACK POINTER IN X3
;			FIRST WORD IN X4
;			TAG VALUE IN X0 (O2D1RI ONLY)
; EXIT ASSERTION	NEXT WORD IN X4
;			X3 UPDATED
;		
O2D1RI:	;	X0 CONTAINS TAG VALUE
	CAIN	ZQU%V
	GOTO	O2D1QI
	CAIN	ZHB%V
	GOTO	O2D1BI
	ASSERT<SKIPN
		RFAIL	ZMP RECORD IN DF1
	>
	DEFINE	R(L,S)=<
O2D1'L'I:	CAML	X3,YDCSTO
	EXEC	M2CO
	REPEAT	S,<
	PUSH	X3,X4
	EXEC	O2D1GW
	>
	LI	X3,(X3)
	RETURN
	>
R(E,ZHE%S)
R(Q,ZQU%S)
R(B,ZHB%S)


O2D1:	PROC
	SAVE<X3,X4,X5>
	SKIPN	X4,YO2DFW
	EXEC	O2D1GW	; GET FIRST WORD OF FILE ON FIRST CALL
	SOS	X3,YDCSTP
	LF	,ZDETYP(,X4)
	ASSERT<CAIE	ZMP%V
		CAIN	ZQU%V
		RFAIL	INVALID RECORD TYPE FIRST O2D1
	>
	EXEC	O2D1RI
	SETZ	X5,	; COUNT OF REMAINING ZHBS TO READ
	LOOP	LF	,ZDETYP(,X4)
		IF	CAIE	ZQU%V
			GOTO	FALSE
		THEN	; ZQU RECORD DETERMINES X5 UPDATE
			IF	LF	,ZQUKND(,X4)
				CAIN	QCLASS
				GOTO	TRUE
				CAIE	QPROCE
				GOTO	FALSE
				LF	,ZQUMOD(,X4)
				CAIE	QDECLARED
				GOTO	FALSE
				LF	,ZQUTYP(,X4)
				CAIN	QLABEL
				GOTO	FALSE
			THEN
				AOJ	X5,	; ZHB FOR THIS ZQU
			FI
			EXEC	O2D1QI	; STACK ZQU
		ELSE
			SOJL	X5,O2D1EX
			ASSERT<	CAIE	ZHB%V
				RFAIL	ZHE IN O2D1
			>
			EXEC	O2D1BI
		FI
	AS	GOTO	TRUE
	SA
O2D1EX:	ST	X4,YO2DFW
	AOJ	X3,
	SETZM	(X3)	; STOP READING BY CARL
	HRRM	X3,YDCSTP
	RETURN
	EPROC
	SUBTTL	O2ATR

COMMENT;

PURPOSE:	OUTPUT ATR.TMP

ENTRY:		O2ATR

;

O2ATR:	PROC
				edit(23)
	SAVE	<X0,X1,X2,X3>	;[23] SAVE X0

	IOER	ATR

	IF
		SKIPE	YELATR
		GOTO	FALSE	;IF NOT FIRST TIME THIS ROUTINE IS CALLED
	THEN	;PREPARE FOR WRITING ATR.TMP ON DISK
		;THIS FILE IS WRITTEN IN UNBUFFERED MODE
		OPEN	QCHATR,[16
				SIXBIT/DSK/
				0]
		EXEC	O2ERO	;IF ERROR
		LI	X2,'ATR'
		HLL	X2,YJOB
		ST	X2,YELATR
		MOVSI	X2,'TMP'
		ST	X2,YELATR+1
		SETZM	YELATR+2
		SETZM	YELATR+3
		ENTER	QCHATR,YELATR
		EXEC	O2ERE	;IF ERROR
					edit(162)
		SETZM	YELATR+3	;[162]
		SETON	YOPATR	;FLAG FILE OPEN
	FI

	L	X3,YBHATR
	SUB	X3,YBHATR+1
	L	X2,YBHATR
	HRRM	X2,YBHATR+1
	HLRZM	X2,YBHATR+2
	HRL	X2,X3
	LI	X3,0
	OUT	QCHATR,X2
	SKIPA
	EXEC	O2ERO	;IF ERROR

	RETURN
	EPROC
	SUBTTL	O2ER
COMMENT;

PURPOSE:	DIAGNOSE FATAL I/O ERRORS

ENTRIES:	O2ERO,O2ERL,O2ERE,O2ERI,O2ERU,O2ERR

ARGUMENTS:	X1 HAS THE ASCIZ NAME OF THE FILE (SET BY IOER MACRO)

;
DEFINE	O2E(L,C)=<
O2ER'L:	ASSERT<
		OUTSTR	[ASCIZ/'L' IO ERROR/]
	>
	LI	C+Q.TER
	GOTO	O2ERCM
	>
O2E(O,0)
O2E(L,1)
O2E(E,2)
O2E(I,3)
O2E(U,4)
O2E(R,5)
O2ERCM:	OP(ERRT	QT,)
	XCT
	BRANCH	O2AB
	SUBTTL	O2EX
		COMMENT/
PURPOSE:	CLOSE FILES
		EXIT FROM PASS 2

ENTRY:		O2EX	;NORMAL EXIT
		O2AB	;ABNORMAL EXIT

NORMAL EXIT:	RUN PASS 3

ERROR EXIT:	ABORT IF PASS 3 NOT FOUND

ERRORS GENERATED:	INTERNAL INPUT-OUTPUT ERRORS
/
O2EX:	EXEC	O2IC2T
; ENTER HERE WHEN IC2 IS NOT SAFE (FATAL ERRORS OR CONSEQUENCES OF PASS 1 ERRORS)
O2EX1:	L	YELIN1
	SKIPN	YELIN2
	ST	YELIN2
	ERRLI	; TO GET LAST LINE NO OF RECENT EDIAGNOSTICS

;DELETE IC1
	IF
		SKIPN	YELIC1
		GOTO	FALSE
	THEN	;FILE SHOULD BE DELETED
		IOER	IC1
	IFE	QDEBUG,<
		SETZM	YELIC1
		RENAME	QCHIC1,YELIC1
		ERRT	QT,Q.TER+5
		>
	IFN QDEBUG,<
		CLOSE	QCHIC1,
		STATZ	QCHIC1,740K
		EXEC	O2ERR
		>
		SETOFF	YOPIC1
		RELEASE	QCHIC1,
	FI

;DELETE DF1
	IF
		SKIPN	YELDF1
		GOTO	FALSE
	THEN	;FILE SHOULD BE DELETED
		IOER	DF1
	IFE	QDEBUG,<
		SETZM	YELDF1
		RENAME	QCHDF1,YELDF1
		ERRT	QT,Q.TER+5
		>
	IFN QDEBUG,<
		CLOSE	QCHDF1,
		STATZ	QCHDF1,740K
		EXEC	O2ERR
		>
		SETOFF	YOPDF1
		RELEASE	QCHDF1,
	FI

;CLOSE IC2
	IF
		SKIPN	YELIC2
		GOTO	FALSE
	THEN
		IOER	IC2
		CLOSE	QCHIC2,
		STATZ	QCHIC2,740K
		EXEC	O2ERR
		SETON	YPOIC2
	FI

	IF
		IFOFF	YSWCE
		GOTO	FALSE	;IF MAIN PROG
	THEN	;CREATE ATR.TMP
		L	YBRZSE
		LI	X1,Y17BUF
		SUB	X1,X0
		TRZ	X1,177
		SUBI	X0,1
		ST	X0,YBHATR
		HRLI	X0,4400
		ST	X0,YBHATR+1
		ST	X1,YBHATR+2
		SUBI	X1,1		;[15] SET YBHATR LEFT HALF TO
		HRLM	X1,YBHATR	; BUFFER LENGTH - 1
		SETZM	YELATR

		EXEC	EXAT	;DO THE JOB

		IF
			SKIPN	YELATR
			GOTO	FALSE
		THEN	;FILE ON DISK
			EXEC	O2ATR	;OUTPUT LAST BUFFER
			CLOSE	QCHATR,
			IOER	ATR
			STATZ	QCHATR,740K
			EXEC	O2ERR
			SETON	YPOATR

		ELSE	;FILE IN CORE

			L	X1,YBHATR+1
			SUB	X1,YBHATR
			HRRZM	X1,YBHATR+2
			AOS	X1,YBHATR
			HRLZM	X1,YBHATR+1
		FI
	FI

O2AB1:
IFG QDEBUG,<
	CLOSE	QCHDEB,
	SETOFF	YOPDEB
>
	edit(225)
TOPS10,<;[225]
	MOVSI	X3,1
	IFG	QTRACE,<EXTERN	YTRPAS
		IFON	YTRSW
		HRRI	X3,0
		>
	SWAPPA(SIMP3,S3,0,QP3PPN)
>
TOPS20,<BRANCH	I3##>;[225]
O2AB:	L	YELIN1
	CAML	YELIN2
	ST	YELIN2
	ERRLI	; IF ERRORS UNDIAGNOSED
	IF	IFON	YSWTRM
		GOTO	FALSE
	THEN	; NOT TERMINATION ERROR
		SETON	YSWP1
		IFE	QDEBUG,<
		SKIPN	YELIC2
		GOTO	O2EX1	;IF IC2 IN CORE
		SETZM	YELIC2
		IOER	IC2
		RENAME	QCHIC2,YELIC2
		ERRT	QT,Q.TER+5
		SETOFF	YOPIC2
		>
		GOTO	O2EX1
	FI
	GOTO	O2AB1
	SUBTTL	O2OP
COMMENT;

PURPOSE:	INITIALIZE BYTE POINTERS IN HEADERS AND OPEN FILES

ENTRY:		O2OP

ARGUMENTS:	NONE

;
O2OP:
;OPEN IC1
	IF	;IC1 WAS WRITTEN TO DISK
		SKIPN	YELIC1
		GOTO	FALSE
	THEN
		IOER	IC1
		LOOKUP	QCHIC1,YELIC1
		EXEC	O2ERL
		SETOFF	YPOIC1
		EXEC	O2OPGB	;SET UP BUFFER RING
		ST	X1,YBHIC1
		SETOM	YBHIC1+2
	FI

;OPEN DF1
	IF	;DF1 WAS WRITTEN TO DISK
		SKIPN	YELDF1
		GOTO	FALSE
	THEN
		IOER	DF1
		LOOKUP	QCHDF1,YELDF1
		EXEC	O2ERL
		SETOFF	YPODF1
		EXEC	O2OPGB	;SET UP BUFFER RING
		ST	X1,YBHDF1
		SETOM	YBHDF1+2
	FI

;OPEN IC2
	IOER	IC2
	OPEN	QCHIC2,[EXP	14
		SIXBIT/DSK/
		XWD	YBHIC2,YBHIC2]
	EXEC	O2ERO

	; MAKE ENTER INFO
	LI	'IC2'
	HLL	YJOB
	ST	YELIC2
	MOVSI	'TMP'
	ST	YELIC2+1
	SETZM	YELIC2+2
	SETZM	YELIC2+3
	ENTER	QCHIC2,YELIC2
	EXEC	O2ERE
	SETZM	YELIC2+3	;[162]
	SETON	YOPIC2
	EXEC	O2OPGB
	ST	X1,YBHIC2

	RETURN


O2OPGB:
;SET UP BUFFER RING OF 2 BUFFERS STARTING AT (YBRBUF)

	AOS	X1,YBRBUF
	HRLI	X1,201
	L	X2,X1
	ADDI	X2,QBUFS+1
	ST	X1,(X2)
	ST	X2,(X1)
	LI	X2,2*QBUFS+1
	ADDM	X2,YBRBUF
	HRLI	X1,400K
	RETURN
	SUBTTL	O2RF
COMMENT;

PURPOSE:	REDEFINE A PREVIOUSLY  DEFINED FIXUP OR COMPILE
		A JUMP TO THE NEW FIXUP

ENTRY:		O2RF

INPUT ARGUMENT:	NEW FIXUP INDEX IN X0
		OLD FIXUP DEFINITION IN YO2LAS, ITS INDEX+YFXTAB IN YO2FIX,
		IS CHANGED ONLY IF YO2FIX IS NEGATIVE
;

O2RF:	PROC
	SAVE	<X2,X3>
	IF	SKIPGE	X2,YO2FIX
		GOTO	FALSE
	THEN
		OP	(JRST)
		GENFIX
	ELSE
		L	X1,
		L	X3,X1
		ADD	X1,YFXTAB
		L	(X2)
		ST	(X1)
		HRRZ	X1,X2
		SUB	X1,YFXTAB
		EXEC	O2CF
		ASSERT<IF	IFOFF	SO2D1
				GOTO	FALSE
			THEN
				EXEC	O2DB1,<<[XWD	020000,0]>>
				LI	X2,(SIXBIT/RF:/)
				HRLI	X2,611000
				HRL	X3,YO2LAS
				EXEC	O2DB4,<X2,X3>
			FI
		>
			SETZM	YO2FIX
			SETZM	YO2LAS
			SETZM	YO2LAS+1
	FI
	RETURN
	EPROC
	SUBTTL	O2GVIN
COMMENT;

PURPOSE:	GET THE VIRTUAL INDEX OF A VIRTUAL QUANTITY

ENTRY:	O2GVIN

INPUT ARGUMENT:	ZQU POINTER IN X5

OUTPUT ARGUMENT:	VIRTUAL INDEX IN X0

;
O2GVIN:	PROC
	SAVE	<X2,X3,X4,X5>
	LF	X1,ZQULID(X5)
	LF	X2,ZQUZHE(X5)
	SETZM	X3
	LOOP	; OVER PREFIX ZHB:S IN X2
		LI	X4,ZHB%S(X2)	; FIRST ZQU IN LIST
		WHILE	RECTYPE(X4) IS ZQU
			GOTO	FALSE
		DO	LF	,ZQULID(X4)
			IF	CAME	X1
				GOTO	FALSE
								edit(140)
				IFNEQF	X4,ZQUMOD,QVIRTUAL	;[140]
				GOTO	FALSE			;[140]
				LF	,ZQUNSB(X4)
				JUMPN	FALSE	; MATCH, NOT SPEC
			THEN	L	X3,X4
			FI
			STEP	X4,ZQU
		OD
	AS	LF	X2,ZHBZHB(X2)	; PREFIX CHAIN
		JUMPE	X2,FALSE	;NO MORE PREFIX
		JUMPE	X3,TRUE	; REPEAT AS NO SPEC FOUND
	SA
	ASSERT<	SKIPN	X3
		RFAIL	VIRTUAL MATCHES ERROR
	>
	LF	,ZQUIND(X3)
	RETURN
	EPROC
	SUBTTL	O2AD
COMMENT;

PURPOSE:	PREPARE FOR AN ACCESS TO AN IDENTIFIER

ENTRY:		O2AD

INPUT ARGUMENT:	ZQU POINTER IN X1

OUTPUT ARGUMENT: AN INSTRUCTION WITH EFFECTIVE ADDRESS OF THE ID
		IS STORED IN YO2ADI (AC,INDEX AND ADDRESS FIELD)
		YO2ADF (-1:RELOCATABLE,0:  ABSOLUTE, 1: FIXUPED ADDRESS)
		THE ADDRESSS IS VARIABLE (DATA ADDRESS) OR PROTOTYPE ADDRESS

;
O2AD:	PROC
	SAVE	<X2,X3,X4,X5,X1>	;X1 MUST BE SAVED LAST

XKND=X2
XMOD=X3
XTYP=X4
	IFN	QDEBUG,<
		ST	X1,YO2DBZ
	>
	SETZM	YO2ADF
	ASSERT<SKIPE	YO2ADI
		RFAIL	CONSECUTIVE CALLS OF O2AD
	>
	LF	XKND,ZQUKND(X1)
	LF	XTYP,ZQUTYP(X1)
	LF	XMOD,ZQUMOD(X1)
	IF
		CAIE	XMOD,QDECLARED	;NOT declared
		GOTO	TRUE		;OR
		CAIN	XTYP,QLABEL	;( NOT label
		GOTO	FALSE		;  AND
		CAIN	XKND,QSIMPLE	;  (simple
		GOTO	TRUE		;   OR
		CAIE	XKND,QARRAY	;   array)
		GOTO	FALSE		;)
	THEN
		IF	;NOT virtual
			CAIN	XMOD,QVIRTUAL
			GOTO	FALSE
		THEN
			; LOAD FROM BLOCK INSTANCE
			LF	X2,ZQUZHE(X1)
			LF	,ZHEDLV(X2)
			L	X4,YZHBXC
			LF	X4,ZHEDLV(X4)
			IF	;On current display level
				CAME	X4
				GOTO	FALSE
			THEN	;Use XCB
				LI	X3,XCB
			ELSE
			IF	;Outermost level
				CAIE	QMINDLV
				GOTO	FALSE
			THEN	;Relocatable address, no index reg
				SOS	YO2ADF
				SETZM	X3
			ELSE
				IF	;No defined display level
					JUMPN	FALSE
				THEN	; BASICIO
					L	X3,YSYSI
					LF	X3,ZQUZQU(X3)	; INFILE ZQU
					LF	X3,ZQUZB(X3)
					LI	YSYSIN
					CAME	X3,X2
					 LI	YSYSOUT
					OP	(L	XIAC,(XSAC))
					ST	X3
					IF	;Not loaded already
						CAMN	X3,YLXIAC
						GOTO	FALSE
					THEN	; LOAD STANDARD FILE
						L	[LOWADR(XSAC)]
						GENABS
						L	X3
						GENABS
						ST	X3,YLXIAC
					FI
				ELSE
					IF	; NEW DISPLAY LOAD?
						CAMN	YLXIAC
						GOTO	FALSE
					THEN	; Emit code for load
						ST	YLXIAC
						OP	(L	XIAC,(XCB))
						GENABS	; CODE TO LOAD DISPLAY REGISTER
					FI
				FI
				LI	X3,XIAC	;Use XIAC to access var
			FI
			FI
			SETZM	YO2ADI
			DPB	X3,[INDEXFIELD	YO2ADI]
			L	@YTAC
			DPB	[ACFIELD	YO2ADI]
			L	X1,0(XPDP)
			LF	,ZQUIND(X1)
			HRRM	YO2ADI
		ELSE
				; VIRTUAL
			L	X5,X1
			IF	WHENNOT	XCUR,ZID
				GOTO	FALSE
			THEN	; DECLARED OR CONNECTED
				LF	X3,ZQUZHE(X1)
				IF	CAMN	X3,YZHBXC
					GOTO	FALSE
				THEN	; LOAD XIAC WITH CLASS INSTANCE
					LF	,ZHEDLV(X3)
					OP	(L	XIAC,(XCB))
					MOVN	X2,X0
					HRRM	X2,YLXIAC
					GENABS
					LI	X2,XIAC
				ELSE
					LI	X2,XCB
				FI
			ELSE	; REMOTE VIRTUAL PROCEDURE
				L	X2,@YTAC
				LI	X2,1(X2)
			FI
			HRRZ	X0,@YTAC
			IF	CAIN	X0,XWAC1
				GOTO	FALSE
			THEN	; TRANSFER PROTOTYPE TO	XWAC1
				OP	(EXCH	XWAC1,)
				GENABS
			FI
			L	[LF	XWAC1,ZBIZPR(X0)]
			DPB	X2,[INDEXFIELD]
			GENABS
			EXEC	O2GVIN	; GET VIRTUAL INDEX TO X0
			MOVN
			ADDI	,<OFFSET(ZCPVID)>
			OP	(XCT	(XWAC1))
			GENABS	; XCT GETS PROCEDURE PROTOTYPE OR SWITCH/LABEL ADDRESS TO XWAC1
			HRRZ	X0,@YTAC
			IF	CAIN	X0,XWAC1
				GOTO	FALSE
			THEN	; TRANSFER PROTOTYPE TO	XWAC1
				OP	(EXCH	XWAC1,)
				GENABS
			FI
			HRRZ	X0,@YTAC
			ADD	YCGACT
			ST	YO2ADI
		FI
	ELSE
		LF	,ZQUIND(X1)
		ST	YO2ADI
		L	@YTAC
		DPB	[ACFIELD	YO2ADI]
		AOS	YO2ADF
	FI
	RETURN
	EPROC
	PURGE	XKND,XTYP,XMOD
	SUBTTL	O2GI
COMMENT;

PURPOSE:	OUTPUT INSTR TO ACCESS AN ID AS PREVIOUSLY DEFINED BY O2AD CALL

ENTRY:		O2GI

INPUT ARGUMENTS: YOPCOD	INSTRUCTION CODE (LEFT ADJUSTED)
		YO2ADI	AC,INDEX AND ADDRESS FIELDS
		YO2ADF	1:	FIXUPED ADDRESS FIELD
			0:	ABSOLUTE ADDRESS FIELD
			-1:	RELOCATED ADDRESS FIELD

;
O2GI:	PROC
	IFN	QDEBUG,<EXEC	DBRTMU>
	SAVE	<X2>
	L	YO2ADI
	ASSERT<	SKIPN
		RFAIL	GENOP CALLED WITH NO GETAD
	>
	OR	YOPCOD
	SKIPN	X2,YO2ADF
	GENABS
	SKIPGE	X2
	GOTO	[ADD	YCABKB
		GENRLD
		GOTO	.+3]
	SKIPLE	X2
	GENFIX
	SETZM	YO2ADI
	IFN	QDEBUG,<IF	IFOFF	SO2D1
				GOTO	FALSE
			THEN	; DEBUG OUTPUT
				L	X2,YO2DBZ
				LF	X1,ZQULID(X2)
				LF	X2,ZQULNE(X2)
				MOVSI	320000
				HRR	X1
				HRLZ	X1,X2
				EXEC	O2DB3,<X0,X1>
			FI
		>
	RETURN
	EPROC
	SUBTTL	O2LN1
COMMENT/
PURPOSE:	OUTPUT A BLOCK START LINE NUMBER TABLE (ZLN) ENTRY AT ATART
	SAVE <X1>
		OF A PROCEDURE, CLASS , PREFIXED BLOCK OR UNREDUCED  SUBBLOCK

INPUT:		ZHB OR ZHE POINTER IN XZHE
/
O2LN1:	PROC
	IF	L	YRELLT
		CAIG	3	; ALWAYS OUTPUT FIRST ENTRY
		GOTO	FALSE
		IFON	YSWI
		GOTO	FALSE
	THEN
		POPJ	XPDP,0
	FI
	SAVE	<X2>
	LF	X1,ZHEFIX(XZHE)	;DEFINE FIX F+1 HERE IN LINE TABLE
	LI	X1,1(X1)
	LI	X2,QRELLT
	EXCH	X2,YQREL
	DEFIX
	EXCH	X2,YQREL
	LF	X0,ZHEFIX(XZHE)
	LF	X1,ZHETYP(XZHE)
	HRL	YO2LNB
	SF	X1,ZLNTYP(X0)
	L	X2,YRELLT
	ST	X2,YO2LNB
	SETONA	ZLNICD(X0)
	LI	X2,QRELLT
	EXCH	X2,YGAP
	GENFIX
	EXCH	X2,YGAP
	LI	-1
	HRLM	YSTATM
	IFOFF	YSWI
	EXEC	O2LN2	; FORCED LINE TABLE ENTRY FOR OUTERMOST BLOCK
	RETURN
	EPROC
	SUBTTL	O2LN2
COMMENT/
PURPOSE:	OUTPUT LINE NUMBER TABLE ENTRY WITH LINE NO AND CODE ADDRESS

INPUT:		LINE NUMBER IS MAX(YLINE,YOLINE), CODE ADDRESS IN YRELCD
		THE LEFT HALF OF YSTATM IS -1 IF
		WE ARE IN DECLARATIONS

/
O2LN2:	PROC
	IFNDEF QPOINT,<QPOINT=0>
	IFNDEF QMAXLN,<QMAXLN=177777>
	SKIPN	YRELLT	; FIRST ENTRY MUST NOT BE LINE NO
	POPJ	XPDP,0
	SAVE	<X2>
	L	X1,YLINE
	CAMGE	X1,YOLINE
	L	X1,YOLINE
	LDB	,QPOINT+YO2LTP
	SKIPG		; APPEND IF FIRST
	GOTO	APPEND
	HLRZ	X2,X0	; LINE TO X2
	TRZ	X2,200K	; DELETE DECLARE FLAG
	IF	CAMLE	X1,X2
		GOTO	FALSE
		CAIN	X2,QMAXLN
		GOTO	FALSE
	THEN	; NOT NEW LINE
		TLZN	200K
		GOTO	DELETE	; NOT IN DECLARATION
		SKIPGE	YSTATM
		GOTO	DELETE	; STILL IN DECLARATION
		L	X2,X0
		ANDI	X2,77777	; MASK OUT RELOCATION BYTE
		CAME	X2,YRELCD
		GOTO	APPEND	; NEW CODE OUTPUT SINCE LAST LINE
		DPB	,QPOINT+YO2LTP	; SWITCH OFF DECLARE FLAG
	ELSE	; NEW LINE
		L	X2,X0
		ANDI	X2,77777	; MASK RELOCATION BYTE
		CAME	X2,YRELCD
		GOTO	APPEND	; NEW CODE OUTPUT
		SKIPGE	YSTATM
		GOTO	DELETE	; IN DECLARE
		HRL	X1	; Delete declare flag and set new line
		DPB	,QPOINT+YO2LTP
	FI
DELETE:	RETURN
APPEND:	IFOFF	YSWI
	LI	X1,QMAXLN
	SETZ
	SKIPGE	YSTATM
	MOVSI	200K	; SET DECLARE FLAG
	ADD	YRELCD
	HRLZ	X1,X1	; NEW LINE NUMBER
	ADD	X1
	LI	X2,QRELLT
	EXCH	X2,YQRELT
	GENRLD
	EXCH	X2,YQRELT
	RETURN
	EPROC
O2LN21:	PROC
	RETURN
	EPROC
	SUBTTL	O2LN3
COMMENT/	OUTPUTS EXTERNAL DEFINITION ENTRY IN LINE TABLE
		X2 CONTAINS ZHB, X3 ZQU
/
O2LN3:	PROC
	IFON	YSWCE
	POPJ	XPDP,0
	SAVE <X1,X4>
				edit(7)
	LF	,ZHETYP(X2)	;[7]
	LF	X4,ZHBMFO(X2)	;[7]
	IF	;[7] Procedure
		CAIN	QCLASB
		GOTO	FALSE
	THEN	;Make no entry for QUICK procedure
		CAIN	X4,QEXMQI
		GOTO	L9
	FI	;[7]
	LF	X1,ZQUIND(X3)	;FIXUP FOR PROTOTYPE
	HRL	X1,YO2LNB
	L	YRELLT
	ST	YO2LNB
	IF	;CLASS
		LF	,ZHETYP(X2)
		CAIE	QCLASB
		GOTO	FALSE
	THEN	; EXTERNAL CLASS
		LI	QCEXT
	ELSE
	IF	;FORTRAN
		CAIGE	X4,QEXFOR	;[7]
		GOTO	FALSE
	THEN	LI	QFEXT
	ELSE
	IF	;MACRO procedure
		CAIN	X4,QEXMAC	;[7]
		GOTO	TRUE
		IFOFF	ZHBNCK(X2)
		GOTO	FALSE
	THEN	;MACRO
		LI	QMEXT
	ELSE	;SIMULA EXTERNAL PROC
		LI	QPEXT
	FI FI FI
	SF	,ZLNTYP(,X1)
	L	X1
	SETONA	ZLNICD(X0)
	STACK	YGAP
	LI	X1,QRELLT
	ST	X1,YGAP
	GENFIX
	UNSTK	YGAP
L9():!	RETURN
	EPROC
	SUBTTL	O2LN4
COMMENT/
PURPOSE:	OUTPUT END OF BLOCK ENTRY TO LINE NUMBER TABLE

ARGUMENTS:	ZHB OR ZHE IN XZHE
/
O2LN4:	PROC
	SAVE<X2>
	LF	X1,ZHEFIX(XZHE)
	LI	X2,1(X1)
	L	X1,YFXTAB
	ADD	X1,X2	; ADDRESS OF FIXUP ENTRY
	LF	X1,ZFXCOD(X1)	; CHECK IF BLOCK START ENTRY EXISTS
	CAIE	X1,QRELLT
	GOTO	L1
	HRRZS	YSTATM
	IFOFF	YSWI
	EXEC	O2LN2	; FORCED ENTRY FOR END OUTERMOST BLOCK WITH /-I
	L	X2
	HRL	YO2LNB
	LI	X1,QEBLOC
	SF	X1,ZLNTYP(X0)
	L	X1,YRELLT
	ST	X1,YO2LNB
	SETONA	ZLNICD(X0)
	LI	X2,QRELLT
	EXCH	X2,YGAP
	GENFIX
	EXCH	X2,YGAP
	L	X1,YOLINE
	CAIE	XCUR,%EPROG
	EXEC	O2LN21
L1():	RETURN
	EPROC
	SUBTTL	O2LN5
COMMENT/
PURPOSE:	OUTPUT A LINE NUMBER TABLE ENTRY FOR A REDUCED SUBBLOCK START

ARGUMENT:	SUBBLOCK ZHE IN XZHE
/
O2LN5:	PROC
	IFOFF	YSWI
	POPJ	XPDP,0
	SAVE	<X2>
	LI	X2,QRELLT
	ST	X2,YQREL
	LF	X1,ZHEFIX(XZHE)
	LI	X1,1(X1)
	DEFIX
	LF	,ZHEBNM(XZHE)
	HRL	YO2LNB
	LI	X1,QRBLOC
	SF	X1,ZLNTYP(X0)
	L	X1,YRELLT
	ST	X1,YO2LNB
	SETONA	ZLNICD(X0)
	EXCH	X2,YGAP
	GENABS
	ST	X2,YQREL
	EXCH	X2,YGAP
	L	X1,YOLINE
	EXEC	O2LN21
	RETURN
	EPROC
	SUBTTL	O2LN6
COMMENT/
PURPOSE:	OUTPUT LINE NUMBER TABLE ENTRY (TWO WORDS) FOR CONNECTION

ARGUMENT:	CONNECTION ZHB IN XZHE
/
O2LN6:	PROC
	IFOFF	YSWI
	POPJ	XPDP,0
	SAVE	<X2>
	LI	QRELLT
	ST	YGAP
	ST	YQREL
	LF	X1,ZHEFIX(XZHE)
	LI	X1,1(X1)
	DEFIX
	LF	X2,ZHBZHB(XZHE)	; PROTOTYPE OF INSPECTED CLASS
	LF	X2,ZHBZQU(X2)
	LF	X2,ZQUIND(X2)
	HRL	X2,YO2LNB
	LI	QINSPE
	SF	,ZLNTYP(,X2)
	SETONA	ZLNICD(X2)
	L	X2
	GENFIX
	L	YRELLT
	ST	YO2LNB
	SOS
	SF	,ZLNBLK(,X2)
	
	LF	,ZHEDLV(XZHE)
	HLL	X2
	GENABS
	LI	QRELCD
	ST	YGAP
	ST	YQREL
	L	X1,YOLINE
	EXEC	O2LN21
	RETURN
	EPROC
	SUBTTL	O2SM

COMMENT/
PURPOSE:	OUTPUT ZSD ENTRIES FOR THE ZQU RECORDS STARTING AT
		X2, CALLED FROM CAEB AND EBLK. (REDUCED BLOCK END)
ENTRY:	O2SM
INPUT ARGUMENTS:	ZQU POINTER (FIRST RECORD TO OUTPUT FROM BLOCK) IN X2
/

O2SM:	PROC
	SAVE	<X2>
	
	; SAVE AND SET RELOCATION COUNTERS

	L	YRELST
	MOVSM	YO2ZSD
	STACK	YQRELT
	STACK	YQRELR
	STACK	YGAP
	LI	QRELST
	ST	YGAP
	ST	YQRELT
	
	; OUTPUT ZSD:S
WHILE	SKIPN	X2
	GOTO	FALSE
DO
	WHILE	RECTYPE(X2) IS ZQU
		GOTO	FALSE
	DO	;OUTPUT ONE ZSD ENTRY
						edit(116)
		IF	LF	,ZQUMOD(X2)	;[116]
			CAIL	QHDN	;[116]
			GOTO	FALSE	;[116] Hidden specification
		THEN	;[116]
						edit(22)
			LF	X1,ZQUTMK(X2)	;[22] LOAD TYPE-MODE-KIND
			MOVSS	X1		;[22] STORE IN ZSDTMK(,X1)
			IF	IFON	ZQULO(X2)
				GOTO	FALSE
			THEN	; SHORT ID
				SETOFA	ZSDLNE(X1)
			ELSE
				SETONA	ZSDLNE(X1)
			FI
	
			;[22]	SET ZSDSPI FIELD FOR SYSIN AND SYSOUT
	
			IF
				IFOFF	ZQUSYS(X2)
				GOTO	FALSE
			THEN
				LF	X0,ZQUSNR(X2)
				IF
					CAIE	X0,SYSK7	;SYSIN
					GOTO	FALSE
				THEN
					SETF	QISYSIN,ZSDSPI(,X1)
				ELSE
				IF
					CAIE	X0,SYSK8	;SYSOUT
					GOTO	FALSE
				THEN
					SETF	QISYSOUT,ZSDSPI(,X1)
				FI
				FI
			FI
	
			LF	X0,ZQUIND(X2)	;[22] LOAD OFFSET IN RH (ZSDOFS)
			HLL	X0,X1		;[22] LH CREATED IN X1 LH
			GENABS	;FIRST WORD ZSD
			LI	QRELID
			ST	YQRELR
			LF	,ZQULID(X2)
			GENREL
			IF	IFOFF	ZQULO(X2)
			GOTO	FALSE
			THEN	; LONG ID
				LI	QRELI2
				ST	YQRELR
				LF	,ZQULID(X2)
				GENREL		; OPTIONAL 3RD WORD
			FI
			LF	,ZQUTYP(X2)
			IF	CAIE	QREF
				GOTO	FALSE
			THEN
				;OUTPUT ZSDZPR
				LF	X1,ZQUZQU(X2)
				LF	,ZQUIND(X1)
				GENFIX
			FI
		FI	;[116]
		ADDI	X2,ZQU%S
	OD
	HLRZ	X2,X2
OD
	; OUTPUT ZERO AFTER LAST SYMBOL
	SETZ
	GENABS
	; RESTORE AND RETURN
	UNSTK	YGAP
	UNSTK	YQRELR
	UNSTK	YQRELT
	RETURN
	EPROC
	END