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)