perm filename RGCEDS[S,AIL] blob sn#109745 filedate 1974-07-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 SOME MORE DATA CELLS FOR THE COMPILER
C00003 00003	 SOMEWHERE AROUND TOTAL/20
C00004 00004	 CHANGES IN STORA (TOTAL/20)
C00005 00005	 FIX TO REMOP
C00007 00006	 FIX TO CALARG
C00008 00007	 FIX TO ISUCAL
C00009 00008	 FIX TO TMPALO
C00011 00009	 FIX TO DOLVIN
C00012 00010	 FIX TO ALLO (GEN/41)
C00013 00011	 FIX TO ARRAY
C00014 00012	 FIX TO DONES
C00016 00013
C00017 ENDMK
C⊗;
;; SOME MORE DATA CELLS FOR THE COMPILER

↑RCTEMP: 0	; LIST OF CURRENTLY AVAILABLE RECORD TEMPS
↑RBSTK:	0	; QPDP FOR -CNT,,ADR WORDS

;; SOMEWHERE AROUND TOTAL/20

↑GETRCT:SKIPE	SIMPSW		;SIMPLE PROCEDURE??
	ERR	<ATTEMPT TO CREATE A RECORD TEMP INSIDE A SIMPLE PROCEDURE>,1
	HRRZ	LPSA,RCTEMP	;GET NEXT OFF RECORD TEMP CHAIN
	JUMPE	LPSA,GRCT.1	;NONE THERE
	HRRZ	TEMP,%RVARB(LPSA);
	MOVEM	TEMP,RCTEMP
	POPJ	P,
GRCT.1:	GETBLK
	AOS	TEMP,TEMPNO
	MOVEM	TEMP,$PNAME(LPSA)
	MOVSI	TEMP,ARTEMP!INUSE!CORTMP
	MOVEM	TEMP,$SBITS(LPSA)
	MOVEI	TEMP,PNTVAR
	MOVEM	TEMP,$TBITS(LPSA)
	POPJ	P,

;; CHANGES IN STORA (TOTAL/20)

;;AT STORA+3 (AFTER PUSH P,SBITS)
	PUSH	P,TBITS

;;AT ZER
	POP	P,TBITS

;; JUST ABOVE THE SKIPA AT TEML

RGC <
	TLNN	SBITS,INDXED		;IF NOT INDXED TEMP
	JRST	RCTCHK			;GO CHECK IF RECORD TEMP
	HRRZ	TEMP,$VAL2(PNT)		;A SUBFIELD INDXED TEMP??
	JUMPE	TEMP,NRML		;NO, JUST TREAT NORMALLY
	JRST	RCTMAK			;YES, DO THE OTHER SORT OF MOVEM
RCTCHK:	MOVE	TBITS,$TBITS(PNT)
	TRNN	TBITS,ITEM!ITMVAR	;THESE ARE ALWAYS NORMAL
	TRNN	TBITS,PNTVAR		;A RECORD TEMP
	JRST	NRML			;NOPE NORMAL
RCTMAK:	PUSHJ	P,GETRCT		;GET A PNTVAR CORTMP
	JRST	TMPCPY			;GO COPY FIXUPS,ETC
NRML:
>;RGC

; FIX TO REMOP
;;REPLACES WHOLE KLUGE AT DELAL

	TLNN	TEMP,CORTMP!INDXED	;INDXED CORTMP??
	JRST	RMP.0			;NOPE
	HRRZ	USER,$VAL2(LPSA)	;RECORD SUBFIELD??
	JUMPE	USER,RMP.1		;NOPE
	MOVSI	USER,CORTMP!INUSE!ARTEMP;MAKE INTO A RECORD CORTMP
	MOVEM	USER,$SBITS(LPSA)
	MOVEI	USER,PNTVAR
	MOVEM	USER,$TBITS(LPSA)	;LIKE SO
	JRST	RMP.RC			;PUT IT ONTO THE RIGHT RING
	
RMP.0:
	TLNN	TEMP,CORTMP		;WELL ??
	JRST	RMP.1			;NOPE
	MOVE	USER,$TBITS(LPSA)	;
	TRNE	USER,PNTVAR		;WAS IT A RECORD CORTMP
	TRNE	USER,ITEM!ITMVAR	;THESE ARE OK
	JRST	RMP.1			;NOPE
RMP.RC:	HRRZ	USER,LPSA		;
	EXCH	USER,RCTEMP		;
	HRRZM	USER,%RVARB(LPSA)	;REMEMBER IT AS AN AVAILABLE 
	POPJ	P,			;RECORD TEMP
					;(NOTICE THAT INUSE WAS LEFT ON)
RMP.1:
;; FIX TO CALARG

;AT STRET -- AFTER THE GET 

	PUSHJ	P,GETRCT		;GET US AN AVAILABLE RECORD CORTMP
	HRRZ	TEMP,$ACNO(SP)		;SP POINTS AT PROC CALL SEM. (UGH!!)
	MOVEM	TEMP,%RVARB(LPSA)	;LINK ONTO CHAIN
	HRRM	LPSA,$ACNO(SP)		;LIKE SO
	MOVE	D,$ACNO(PNT)		;EMIT A MAGICAL MOVEM
	EMIT	(<MOVEM>)		;AH SO!
					
;; FIX TO ISUCAL

;; RIGHT AT OKCAL

OKCAL:	PUSH	P,PNT	
	HRRZ	PNT,$ACNO(PNT)		;FETCH THE THINGS TO REMOP
	JUMPE	PNT,OKCA.1		;NONE LEFT
OKCA.0:	EMIT	<SETZM NOUSAC>		;ZERO IT OUT
	MOVE	LPSA,PNT		;
	HRRZ	PNT,%RVARB(PNT)		;GET NEXT
	PUSHJ	P,REMOPL		;
	JUMPN	PNT,OKCA.0		;LIKE SO
OKCA.1:	POP	P,LPSA			;FOR THE FREBLK
	HLRZ	PNT,%TLINK(LPSA)	;PROC CALL SEMANTICS
	

;; FIX TO TMPALO

;; RIGHT ABOVE TMPAL
	TLNN	FF,ALLOCT	;ONLY WORK HARD IF ACTUALLY ALLOCATING
	JRST	TMPAL
	MOVEI	PNT,0		;USE THIS TO HOLD THE CHAIN
RCTMLP:	MOVE	SBITS,$SBITS(LPSA)
	SETZM	%RVARB(LPSA)	;SINCE NON-ZERO IS A MARK
	TLNN	SBITS,CORTMP
	JRST	NXRCTM
	TLNN	SBITS,INDXED	;CHECK ALSO SUBFIELD INDXED CORTMP
	JRST	RCTM.1		;NOT ONE OF THOSE
	HRRZ	TBITS,$VAL2(LPSA);WELL ??
	JUMPE	TBITS,NXRCTM	;NOT ONE OF THOSE
	JRST	RCTM.2		;YES IT IS

RCTM.1:	MOVE	TBITS,$TBITS(LPSA)
	TRNE	TBITS,PNTVAR	;A RECORD VBL
	TRNE	TBITS,ITEM!ITMVAR ;BUT NOT AN ITEMISH THING
	JRST	NXRCTM		;NOPE
RCTM.2:	HRROM	PNT,%RVARB(LPSA);MARK IT
	MOVE	PNT,LPSA	;& REMEMBER CHAIN
NXRCTM:	HRRZ	LPSA,%TLINK(LPSA)
	JUMPN	LPSA,RCTMLP
	HRRZM	PNT,RCTEMP	;REMEMBER WHICH TEMPS WERE RECORD VALUES
	HRRZ	LPSA,TTEMP	;BACK IN BUSINESS

;; AT FIXOUT CALL
	HRRZM	B,$ADR(LPSA)	;REMEMBER FOR PDOUT

;; AT FBOUT CALL
	HRRZM	B,$ADR(LPSA)	;REMEMBER FOR PDOUT

;;RIGHT ABOVE TLNN FF,ALLOCT AT TMNXT
	SKIPN	%RVARB(LPSA)	;DONT KILL IF IT WAS A RECORD TEMP
				;(NEED IT FOR PD)
;; FIX TO DOLVIN

;; RIGHT BEFORE CALL TO LVIOUT

	HRLZI	A,RPCOD⊗=9(PNT)	
	LSH	A,5			;
	SKIPE	RECSW
	TLOA	A,RF
	TLOA	FF,RELOC		;NOT RECURSIVE MEANS RELOC
	TLZ	FF,RELOC		;RECSW MEANS DONT RELOC
	SKIPN	LPSA,RCTEMP		;THE RECORD TEMPS WE BUFFERED UP
	JRST	RCLV.1
RCLVLP:	HRR	A,$ADR(LPSA)		;THE CUPLRIT
	PUSHJ	P,CODOUT		;PUT IT OUT
	HRRZ	B,%TLINK(LPSA)		;REMEMBER THE NEXT 
	FREBLK				;KILL OFF THE BLOCK
	SKIPE	LPSA,B			;ITERATE
	JRST	RCLVLP
RCLV.1:	HRLZI	A,BLKCOD⊗=14
	TLZ	FF,RELOC
	PUSHJ	P,CODOUT

;; FIX TO ALLO (GEN/41)

;;RIGHT AFTER FIRST CODOUT AFTER NVL
	TLNE	TBITS,SBSCRP		;OWN RPTR ARRAYS HANDLED ELSEWHERE
	TLNN	TBITS,OWN!BILTIN	;OWN??
	JRST	NVL.1			;NOPE
	TRNE	TBITS,PNTVAR		;RECORD PNTR??
	TRNE	TBITS,ITEM!ITMVAR	;WELL
	JRST	NVL.1			;NOPE
	HRLO	A,$ADR(LPSA)		;-1,,ADDRESS
	PUSH	P,LPSA			;SAVE IT FROM HARM
	QPUSH	(RBSTK)			;REMEMBER IT FOR LATER
	POP	P,LPSA
NVL.1:
;; FIX TO ARRAY

;; RIGHT ABOVE BUG #MO# (ARRAY/8)

	MOVN	A,ARRSIZ		;NUMBER OF WORDS
	MOVS	A,A			;INTO LEFT HALF
	HRR	A,OWNWD			;FIRST DATA WORD
	QPUSH	(RBSTK)

;; FIX TO DONES

;; AT INI.DN (GEN /45)
	PUSH	P,INIPDP	;INITIALIZATIONS
	MOVEI	B,%INLNK	;
	PUSHJ	P,QSTKOU
	QFLUSH	(INIPDP)	;FLUSH THE QSTACK
	PUSH	P,RBSTK		;RECORD BLOCKS
	MOVEI	B,%RBLNK
	PUSHJ	P,QSTKOU
	QFLUSH	(RBSTK)

;; SOMEWHERE (SAY AT END OF GEN/48)

;ROUTINE TO PUT OUT A QSTACK FULL OF WORDS (ALL RELOC), FOLLOWED BY A ZERO
; AND PRECEDED BY A LINK WORD FOR SOME LOADER LINK
; PARAMS: QPDP IN (P), LINK NUMBER IN B
; SID: CLOBBERS B,A,LPSA,TEMP,FF(RELOC)

QSTKOU:	SKIPN	-1(P)		;QPDP EMPTY
	JRST	QS.XIT		;
	MOVEI	A,0		;NO, PUT OUT A WORD FOR THE LINK
	TLZ	FF,RELOC	;LIKE SO
	PUSHJ	P,CODOUT	;
	PUSHJ	P,LNKOUT	;LINK GOES OUT
	TLO	FF,RELOC	;FOR ALL THE ADDRESSES
	QBEGIN	(<-1(P)>)	;SETS UP ACB
QS.OU1:	QTAKE	(<-1(P)>)	;
	JRST	QS.OU2		;ALL DONE
	PUSHJ	P,CODOUT	;PUT OUT WORD
	JRST	QS.OU1		;ITERATE
QS.OU2:	MOVEI	A,0		;
	TLZ	FF,RELOC
	PUSHJ	P,CODOUT
QS.XIT:	SUB	P,X22
	JRST	@2(P)