SALL


;AUTHOR:		 ELISABETH $LUND
;VERSION:		 4 [2,43,106,271]
;PURPOSE:		 HANDLE I/O TRANSMISSIONS
;CONTENTS:		
;SUBROUTINES:		 O2IS, O2IV,O2DF, O2AF, O2CF


	SEARCH SIMMC2,SIMMAC
	CTITLE O2
	DEFINE	IOER(F)=<
		L	X1,[ASCIZ/F/]
	>
	MACINIT


	EXTERN YDCSTP,YBHIC1,YBHDF1,YMAXID,YO2STS
	EXTERN	YELIC1
	EXTERN YBHIC2,YQREL,YTENT,YNOREL,YLXIAC,YFXCH,YFXTAB,YDCSTO
				edit(43)
	EXTERN	YO2CIQ		;[43] CURRENT IQ BUFFER POINTER
	EXTERN	YO2IQB		;LOCAL BUFFER INTERNAL REQUEST NO 1
	EXTERN	YO2IQI		;INDEX YO2IQB OR YO2ITB[43]
	EXTERN	YO2LAS		; SAVES TENTATIVE FIXUP DEFINITION
	EXTERN	YO2LIT		;NUMBER OF LITERALS FOLLOWING SYMBOL IN IC1
	EXTERN	YO2FIX		;0/1 NO OUTPUT/OUTPUT OF OLD REQUEST
	IFN	QDEBUG,<
	EXTERN	YO2NOR		;RELOC COUNTERS SIXBIT CODE FOR DEBUG EDIT
	>
	EXTERN	O2IC2P		;[43] OUTPUTS PARTLY FILLED CODE STREAM BUFFERS
	EXTERN	O2IC2Z		;[43] ZEROES THE REST OF THE IC2 BUFFER
	EXTERN	O2IC2		; OUTPUTS BUFFER TO IC2
	EXTERN	YO2ITB		;[43] LOCAL BUFFER INTERNAL REQUESTS NO 2
IFN	QDEBUG,<EXTERN	O2DB1, O2DB2, O2DB3, O2DB4>
	EXTERN	O2ERO,O2ERL,O2ERU,O2ERR,O2ERI
	EXTERN	M2CO
	INTERN  O2IS, O2IV, O2DF, O2AF, O2CF, O2DFOU, O2DFTE



	TWOSEG
	RELOC	400000
	SUBTTLE O2D1
;PURPOSE:		 READ A SECTION OF THE FILE DF1 INTO DECLARATION STACK
;ENTRY:			 O2D1
;NORMAL EXIT:		RETURN
;ERROR EXIT:		
IO.EOF=1B22




	X=0
	DEFINE SYMBTAB (A,B,C,DUM)
	<REPEAT  B-X-1,<Z>
	X==B
	IFB <C>,<0>
	IFNB <C>,<C>>



REPEAT	0,<O2D1:
	SAVE <X2,X3,X4,X5>
	LI	 X5,0 		;COUNT OF DECLARED ZQU
	L	X3,YDCSTP	;STACKPOINTER
	HRL	X3,X3
	SUB	X3,YDCSTO
	MOVSS	X3,X3
	EXEC	 O2DTYPE	;GET POINTER TO RECORD IN X4
	ASSERT<WHEN (X4,ZQU) 	;FIRST RECORD MUST NOT BE ZQU
	RFAIL ZQU NOT EXP IN O2D1
	>
IF	WHENNOT	(X4,ZHE)		;SKIP NEXT INSTR IF ZHE
	GOTO	FALSE
THEN	EXEC	O2DPUSH,<[ZHE%S]> 	;READ ZHERECORD INTO STACK
ELSE 	EXEC	O2DPUSH,<[ZHB%S]>	;READ RECORD ZHB INTO STACK
FI
O2DL:	EXEC	O2DTYPE		;GET POINTER TO RECORD IN X4
	WHENNOT	(X4,ZQU)		;SKIP NEXT INSTR IF ZQU
	GOTO	O2DL3
	EXEC	O2DPUSH,<[ZQU%S]>	;READ RECORD INTO STACK
IF	IFEQF	(X4,ZQUKND,QCLASS)	;SKIP NEXT INSTR IF NOT CLASS
	GOTO	FALSE
THEN  IFNEQF	(X4,ZQUKND,QPROCEDURE)
	GOTO	O2DL		;JUMP IF PROCEDURE
	IFEQF	(X4,ZQUTYP,QLABEL)
	GOTO	O2DL
FI	IFEQF	(X4,ZQUMOD,QDECLARED)	;IF NOT DECLARED SKIP  NEXT INSTR
	ADDI	X5,1		;UPDATE COUNTER
	GOTO	O2DL
O2DL3:	JUMPE	X5,O2DEND	
	SUBI	X5,1
	ASSERT <
	WHEN	(X4,ZHE)	;ZHERECORD NOT ALLOWED
	RFAIL ZHERECORD IN MIDDLE OF SEGMENT>
	EXEC	O2DPUSH,<[ZHB%S]>
	GOTO	O2DL
O2DEND:	ADDI	X3,1				;NO STACKPOINTER
	HRRM	X3,YDCSTP
	SETZM	(X3)	; THIS STOPS THE SCAN IN CARL
	RETURN
O2DPUSH:	PROC <A>	;ROUTINE TO READ RECORD FROM DF1
	HRRZ	X3,X3	; RESET PDL COUNTER
	CAML	X3,YDCSTO
	EXEC	M2CO
	L	X2,A		;INTO DECLARATION STACK
	LI X1,0
O2DL5:
LOOP	SOSGE	YBHDF1+2		;SKIP NEXT INSTR IF MORE WORD IN BUFFER
	GOTO	O2DIN1		
AS	ILDB	X0,YBHDF1+1	;GET WORD
	PUSH	X3,X0	;PUSHDOWN IN DECLSTACK
	SOJG	X2,TRUE	;JUMP IF MORE WORDS IN RECORD
SA	RETURN
	EPROC
O2DIN1:	IN	QCHDF1,
	GOTO	O2DL5		;CORRECT RETURN
	GETSTS	QCHDF1,YO2STS
O2DINERR:
	FATAL	6,ERROR ON INPUT FROM DF1
O2DTYPE:
	IF  SKIPE	YBHDF1+2
	  GOTO FALSE
	THEN
	  IN 	QCHDF1,
	  GOTO FALSE
	GETSTS	QCHDF1,YO2STS
	LI	IO.EOF
	TDNN	YO2STS
	GOTO	O2DINERR
	LI	X4,[0]
	RETURN
	FI
	ASSERT<SKIPL	@YBHDF1
		RFAIL	BUFFER SYNC ERROR O2D1
	>
  L X4,YBHDF1+1
	AOS	X4
	  RETURN	>


	SUBTTLE	O2IS



;PURPOSE:		 READ A SYMBOL FROM IC1 TO REG XCUR
;ENTRY:			 O2IS
;NORMAL EXIT:		 RETURN
;ERROREXIT:		

;OUTPUT ARGUMENT: REG XCUR CONTAINING CURRENT SYNBOL


O2IS:
	SOSGE	YBHIC1+2 	;Countdown of words in buffer
	EXEC	O2IC		;Next buffer when exhausted
	ILDB	XCUR,YBHIC1+1	;GET SYMBOL
	ASSERT <
	SKIPE	YO2LIT		;Should not be reading a literal
	 RFAIL 	(CALL ON O2IS WHEN O2IV EXPECTED)
	IF	;Identifier
		CAMG	XCUR,YMAXID
		CAIGE	XCUR,QLOWID
		GOTO	FALSE
	THEN
		RETURN
	FI
	IF
		CAIGE	XCUR,400000
		GOTO	FALSE
	THEN
		LI	X1,2
		ST	X1,YO2LIT
		RETURN
	FI
	CAILE	XCUR,SYMBL5
	 RFAIL	(INVALID SYMBOL IN IC1)
	L	X1,O2ST(XCUR)	;GET NUMBER OF LITERALS
	ST	X1,YO2LIT
>
	RETURN
	ASSERT	<
O2ST:	SYMB	(2,1,SYMBTAB)>		;GENERATE LIST



;O2IC GETS A NEW BUFFER FROM IC1, BUFFERHEADER IS UPDATED
;TO MAKE IT POSSIBLE TO READ ONLY HALFWORDS


	O2IC:
		ASSERT<	SKIPN	YELIC1
			RFAIL	READING PAST EOF IN IC1
			>
		IF	IN	QCHIC1,
			GOTO	TRUE
			GOTO	FALSE
	THEN
		SOS	YBHIC1+2
		RETURN
	ELSE
		GETSTS	QCHIC1,YO2STS
		IOER	IC1
		EXEC	O2ERI
	FI

	SUBTTLE	O2IV


;PURPOSE:		 READ A VALUE FROM IC1
;ENTRY:			  O2IV
;NORMAL EXIT:		 RETURN
;ERROR EXIT:		
;OUTPUT ARGUMENT:	 REG X0 CONTAINING VALUE FROM IC1

O2IV:
	SOSGE	YBHIC1+2		;IF MORE WORDS IN BUFFER SKIP NEXT INSTR
	EXEC	O2IC
	ILDB	X0,YBHIC1+1	;GET VALUE
	ASSERT <
	SOSGE	YO2LIT 		;SKIP NEXT INSTR IF LITERAL ALLOWED
	RFAIL (TOO MANY CALLS ON O2IV AFTER O2IS)>
	RETURN

	SUBTTL O2DF


;PURPOSE:		 DEFINE CODE ADDRESS OF A PROGRAM COORDINATE
;OUTPUT FIXUP TO IC2
;ENTRY:			 O2DF
;NORMAL EXIT:		 RETURN
;ERROR EXIT:		 
;INPUT ARG:		 X1 CONTAINING INDEX FIXUPTABLE ZFX
;			YQREL CONTAINS RELOCATION FOR FIXUP OR ZERO (GLOBAL REQUEST)

O2DF:

	PROC
	SAVE	<X1,X2,X5,X6,X3,X4>
	SETZM	YLXIAC
	ADD	X1,YFXTAB
	L	X3,X1
	L	X5,(X3)
	ASSERT<	; CHECK FIXUP STATUS
		LF	,ZFXTYP(X1)
		CAIN	QA
		RFAIL	UNUSED FIXUP DEFINED
		CAIN	QE1
		RFAIL	FIXUP ALREADY DEFINED
		CAIN	QF
		RFAIL	FXTYP QF IN O2DF
	>
	IF	SKIPN	X1,YQREL
		GOTO	FALSE
	THEN	L	X6,YNOREL(X1)
		HRL	X6,X1
	ELSE
		L	X6,X3
		SUB	X6,YFXTAB
	FI
	LI	QE1
	SF	,ZFXTYP(,X6)
	SKIPE	YTENT	; NO REDEFINITION IF ZERO
	 HRRO	X3,X3
	LOOP
		EXCH	X5,YO2LAS
		EXCH	X6,YO2LAS+1
		EXCH	X3,YO2FIX
		SETZM	YTENT
		IF	JUMPE	X3,FALSE
		THEN
			ST	X6,(X3)
			L	X1,X3
			L	X3,YO2IQI
			TLZ	X5,777000
			TLZ	X6,777000
			EXEC	O2DFOUT
		FI
	AS	SETZ	X3,
		SKIPLE	YO2FIX
		GOTO	TRUE
	SA
	RETURN
	EPROC

O2DFOUT:	PROC; STORE CONTENTS OF X5-X6 IN BUFFER YO2IQB OR YO2ITB, UPDATE YO2IQI
	SKIPN	X5
	RETURN		; DO NOT OUTPUT IF CHAIN IS ZERO

				edit(43)
	L	X4,YO2CIQ	;[43] CURRENT IQ BUFFER START TO X4

					edit(106)
	IF	CAIGE	X3,QBUFS-5	;[106] OUTPUT ONLY DOUBLE WORDS
		GOTO	FALSE
	THEN
	IF	HLRZ	X1,(X4)	;[43]
		CAIE	X1,10
		GOTO	FALSE
	THEN	;BLOCK TYPE 10 WITH COUNT IN SECOND WORD
		HRRZ	X1,(X4)	;[43]
		ST	X1,1(X4)	;[43]	; SET COUNT

			edit(43)
			;[43] START
		IF	;FIRST IQ BUFFER FULL?
			CAIE	X4,YO2IQB
			GOTO	FALSE
		THEN	;CHANGE CURRENT IQ BUFF TO SECOND (YO2ITB)
			LI	X4,YO2ITB
		ELSE	;OUTPUT PARTLY FILLED CODE STREAM BUFFERS
			;ZERO THE REST OF THE IC2 BUFFER
			;OUTPUT THE 2 IQ BUFFERS
			;SET CURRENT IQ BUF TO YO2IQB

			EXEC	O2IC2P
			EXEC	O2IC2Z
			LI	X1,YO2IQB
			EXEC	O2IC2
			LI	X1,YO2ITB
			EXEC	O2IC2
			LI	X4,YO2IQB
		FI
		ST	X4,YO2CIQ

			;[43] END
		LI	X3,2	; FIRST USED WORD FOR TYPE 10
	ELSE	; TYPE 2 BLOCK
		LI	X1,YO2IQB
		EXEC	O2IC2
		LI	X3,1	; FIRST USED WORD FOR TYPE 2 BLOCK
	FI
	HLLZS	(X4)	;[43]

	ST	X3,YO2IQI


	IFN	QDEBUG,<
		SETZ	X1,
	>
	FI
				edit(43)
	ADD	X3,X4		;[43]
	STD	X5,(X3)		;[43]
	LI	X3,2
	ADDM	X3,YO2IQI
	ADDM	X3,(X4)	;[43]


	IFN	QDEBUG,<

		;EDIT THE DEBUG OUTPUT IF SO2D1 IS SET

	IF
		IFOFF	SO2D1
		GOTO	FALSE
	THEN
		EXEC	O2DB1,<<[020000,,]>>	;NEW LINE
		SUB	X1,YFXTAB
		HRL	X1,X1
		EXEC	O2DB3,<<[610000,,'IQ ']>,X1>	;'IQ ', FIXUP INDEX
		LF	X1,ZFXCOD(,X5)
		HLR	X0,YO2NOR(X1)
		HLR	X1,X5
		HRLI	X1,116000		;116000,,X5(L)
		HRL	X0,X5			;X5(R),,'REL CODE'
		EXEC	O2DB4,<X1,X0>
			EXEC	O2DB1,<<[020000,,]>>	;NEW LINE
		EXEC	O2DB2,<<[600000,,]>>	;HTAB
		HLR	X1,X6
		HLR	X0,YO2NOR(X1)
		HRLI	X1,116000		;116000,,X6(L)
		HRL	X0,X6			;X6(R),,'REL CODE'
		EXEC	O2DB4,<X1,X0>
	FI
	>				;END OF  IFN QDEBUG,

	RETURN		;[43]

	EPROC
	SUBTTL	O2AF


;PURPOSE:		 UNCHAIN A FIXUP TYPE A
;ENTRY	:		 O2AF
;INPUT ARG:		 -
;NORMAL EXIT:		 RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS:	 X0 is fixup index

O2AF:	PROC
	SAVE	<X2,X3>

	L	X1,YFXCH		;START OF CHAIN OF AVAILABLE FIXUPS
	IF	;[271] No more free fixups available
		edit(271)
		JUMPG	X1,FALSE
	THEN	;Error
		FATAL	3,Too complicated program structure
	FI
	L	X2,(X1)
	SETZM	(X1)
ASSERT <
	SKIPN	YFXCH
	RFAIL	NO MORE FIXUPS AVAILABLE IN O2AF
	SKIPG	YFXCH
	RFAIL NO FIXUP TO UNCHAIN
	LDB	X3,[$ZFXTYP (X1)]
	CAIE	X3,QA
	RFAIL WRONG TYPE OF FIXUP IN ZFX TO UNCHAIN>
	LI	X3,QB
	DPB	X3,[$ZFXTYP (X1)]
	HRRM	X2,YFXCH
	L	X0,X1
	SUB	X0,YFXTAB
	RETURN
	EPROC
	SUBTTLE O2CF


;PURPOSE:		 MAKE A FIXUP AVAILABLE FOR REALLOCATION BY O2AF
;ENTRY:			 O2CF
;INPUT:			 REG X1 CONTAINING FIXUP INDEX TO ZFX
;NORMAL EXIT:		 RETURN


O2CF:
	ADD	X1,YFXTAB
	IFN	QDEBUG,<LI	QA
		SF	,ZFXTYP(X1)
	>
	L 	X0,YFXCH
	ST	X1,YFXCH
	HRRZM	X0,(X1)
	RETURN


	SUBTTL	O2DFTE	[2]

	edit(2)


	COMMENT;

	PURPOSE:	OUTPUT TENTATIVE FIXUP IF PREVIOUSLY DEFINED
			BUT NOT YET OUTPUT

	ENTRY:		O2DFTE

	INPUT ARG:	YO2FIX	 = -1 ,,FIXUP INDEX + YFXTAB
			YO2LAS	 = RCODE,,ADDRESS
			YO2LAS+1 = RCODE,,VALUE

	NORMAL EXIT:	RETURN

	CALL FORMAT:	EXEC	O2DFTE

	;


		;[2]  NEW ROUTINE
O2DFTE:	PROC
	IF
		SKIPL	X1,YO2FIX
		GOTO	FALSE
	THEN
		;A TENTATIVE FIXUP REMAINS IN YO2LAS AND YO2LAS+1
		STACK	X3
		L	X3,YO2IQI
		EXCH	X5,YO2LAS
		EXCH	X6,YO2LAS+1
		ST	X6,(X1)
		TLZ	X5,777000
		TLZ	X6,777000
		EXEC	O2DFOUT
		SETZB	X5,X6
		EXCH	X5,YO2LAS
		EXCH	X6,YO2LAS+1
		SETZM	YO2FIX
		UNSTK	X3
	FI
	RETURN
	EPROC
	SUBTTL	LITERALS
	LIT
	RELOC
	VAR
	
	END