Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
COMMENT HISTORY
AUTHOR,REASON
021 102100000004 ;
COMMENT
VERSION 17-1(4) 12-9-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(3) 12-2-73
VERSION 17-1(2) 10-24-73 BY JRL CHANGE FPEES TO GIVE ONLY 2 TWO-WORD FREES AND 10 ONE-WORDS
VERSION 17-1(1) 10-24-73 BY JRL FIX FPEES TO GIVE ONLY SMALL AMOUNT OF FREES FIRST TIME
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(10) 5-14-73
VERSION 16-2(9) 5-6-73 BY JRL ADD ONEWRD,TWOWRD
VERSION 16-2(8) 5-6-73
VERSION 16-2(7) 3-20-73
VERSION 16-2(6) 3-20-73
VERSION 16-2(5) 3-20-73
VERSION 16-2(4) 2-13-73
VERSION 16-2(3) 2-13-73 BY JRL ADD INCONT ROUTINE
VERSION 16-2(2) 2-13-73
VERSION 16-2(1) 9-21-72 BY JRL PUT IN VERSION NUMBER
;
SUBTTL BACKTRACKING, 1-2 WORD DYNAMIC STORAGE ALLOCATION
LSTON (WRDGET)
;; SET COMPILE TIME SWITCHES IN CASE SEPARATE ASSEMBLY (LIBRARY)
IFNDEF UPPER,<?UPPER __ 0>
IFNDEF LOWER,<?LOWER __ 0>
IFNDEF ALWAYS,<?ALWAYS __ 0>
IFNDEF SEGS,<?SEGS __ 0>
IFNDEF GLOBSW,<?GLOBSW__ 0>
IFNDEF RENSW,<?RENSW__0>
BEGIN BACKTR
INTERNAL FORGET,REMEMB,RESTOR,ALLRM,ALLFOR,ALLRS,.INCON
INTERNAL FP1DON,FP2DON,SDESCR,ONEWRD,TWOWRD,CONELM
IFE ALWAYS,< ENTRY FORGET,REMEMB,RESTOR,ALLRM,ALLFOR,ALLRS,.INCON,CORGZR
ENTRY FP1DON,FP2DON,SDESCR,CONELM
TITLE BACKTR
EXTERNAL GOGTAB,ARCOP,STACSV,STACRS,X11,X22,X33,CATLST,ARYEL,ARMAK
EXTERNAL ARRRCL,COPARR,CORGET,SAVE,RESTR,$PDLOV
INTERNAL FPEES,FSAV,FREST,CORGZR
>
REN <
TWOSEG 400000
RELOC 400000
USE HIGHS
USE
RELOC
USE HIGHS
>;REN
IFNDEF A,<
A__1
B__2
C__3
D __ 4
>
FLAG __ 5
FP __6
PNT _ 11
FPD __ 10
GLOB <
TABL __ 7
>;GLOB
NOGLOB <
TABL __ USER ; MAKE IT SAME AS USER
>;NOGLOB
FREELEN__1000 ;THIS IS HOW MUCH FREE SPACE WE GET
;MACRO TO GET LEAP CORE.
DEFINE LPCOR (SIZE,PLACE) <
IFDIF <SIZE><>,<MOVEI C,SIZE>
PUSHJ P,CORGZR
IFDIF <PLACE><>,<MOVEM B,PLACE(TABL)>
>
^CORGZR: ;THIS GETS AND ZEROES CORE.
GLOB <
CAIN TABL,GLUSER
SETOM USCOR2(USER) ;USE OTHER CORE.
>;GLOB
PUSHJ P,CORGET ;ASK FOR CORE (SIZE IN "C")
ERR <CAN'T GET LEAP CORE>
GLOB <
SETZM USCOR2(USER)
>;GLOB
PUSH P,B
HRLS B
ADDI B,1
SETZM -1(B)
ADDI C,-2(B)
BLT B,(C) ;ZERO THE WHOLE AREA.
POP P,B ;RETURN BASE OF NEW AREA IN B
POPJ P,
;GLOBAL MODEL INTERLOCK
GLOB <
DEFINE WRITSEC <
PUSHJ P,ENTWRT
>; MAKE SURE INSIDE OF WRITING SECTION
DEFINE RDSEC <
PUSHJ P,ENTRD
>; MAKE SURE INSIDE OF READING SECTION
DEFINE NOSEC <
PUSHJ P,NOSECR
>; EXIT WHATEVER KIND OF SECTION WE'RE IN IF ANY
>;GLOB
DSCR REMEMB
DESC __ 400000 ;INDICATES A DESCRIPTOR OF SOME SORT
ISARR __ 200000 ;ARRAY
ISSTR __ 100000 ;STRING
ISSET __ 40000 ;SET OR LIST
HERE(REMEMB)
PUSHJ P,STACSV ;SAVE OFF ACCUMULATORS
MOVE TABL,GOGTAB ;USER TABLE
POP P,LPSA ;RETURN ADDRESS
POP P,D ;REF TO CONTEXT
SKIPN FP,FP2(TABL) ;ANY TWO WORD FREES YET
PUSHJ P,FP2DON ;NO GO GET SOME
MOVEM FP,FP2(TABL)
LPREM:
POP P,A ;VAR TO BE SAVED
JUMPE A,RETALL ;IF THROUGH, RETURN
TLNE A,ISARR ;IF ARRAY GET DESCRIPTOR
HRR A,(A)
TRNN A,-1 ;IF NOTHING THERE, TROUBLE
ERR <REMEMBER: MISSING ARRAY DESCRIPTOR>,1
MOVEI B,(D) ;START LOOKING AT HEAD OF CONTEXT LIST
HRRZ C,(B)
JUMPE C,INSERT ;NIL CONTEXT LIST?
LPREM2:
HLRZ PNT,(C) ;CANDIDATE
CAIN PNT,(A) ;SAME AS OUR PARM.
JRST REMREP ;YES.
CAIL PNT,(A) ;FURTHER DOWN LIST?
JRST INSERT ;NO.
;AT THIS POINT WE HAVE DETERMINED THAT THE ADDRESS OF THE PARAMETER
;IS GREATER THAT THE ADDRESS OF THE STORED VALUE, BUT THE PARAMETER
;MAY STILL BE AN ELEMENT OF A STORED ARRAY
MOVE TEMP,(C) ;DESC BIT ON IF MIGHT BE ARRAY
TLNN A,ISARR ;IS PARAM AN ARRAY
TRNN TEMP,DESC ;STORED ONE A DESCRIPTOR
JRST REMCDR ;NOT ELEM OF STORED ARRAY.
MOVE TEMP,1(C) ;GET DESCRIPTOR
TLNN TEMP,ISARR ;STORED ARRAY?
JRST REMCDR ;NO.
HRRZ FPD,-1(TEMP) ;SIZE OF ARRAY.
SKIPG -2(TEMP) ;STRING ARRAY?
HRRZ FPD,-2(TEMP) ;GET SIZE OF STRING ARRAY
ADDI FPD,(PNT) ;ADDR LAST +1 ELEM OF ARRAY
CAIG FPD,(A) ;MUST BE GREATER THAT PARAM ADDR
JRST REMCDR ;ISN'T
;WE'RE REMEMBERING A SINGLE ELEMENT OF AN ALREADY SAVED ARRAY
MOVEI TEMP,(A) ;ADDR ARRAY ELEM TO BE SAVED
SUBI TEMP,(PNT) ;OFFSET OF ARRAY ELEM
ADD TEMP,1(C) ;ADDR SAVED ARRAY
TLNN A,ISSET ;SAVING A SET?
JRST ELNSET ;NO.
SKIPN FPD,(TEMP) ;ADDR LASTWORD,,FIRSTWORD
JRST RNOSET ;SET WAS NULL.
HLRZ PNT,(FPD) ;LASTWORD ADDR
HRR FP,FP1(TABL) ;HEAD OF ONE-WORD FREES
HRRM FP,(PNT) ;LINK IN RELEASED SET
HRRM FPD,FP1(TABL) ;NEW FREE-LIST
RNOSET:
SAVACS <(TEMP,LPSA,D)>
PUSH P,A ;SET TO BE COPIED
PUSH P,[0] ;NULL SET
GLOB<
TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
>;GLOB
PUSHJ P,CATLST ;LET CAT DO THE WORK
HLRE FLAG,(P) ;GET NEG LENGTH
MOVMS FLAG ;MAKE POS
HRLM FLAG,(P) ;STORE INTO SET DESCRIPTOR
POP P,FLAG ;SET DESCRIPTOR
RESTACS <(D,LPSA,TEMP)>
MOVEM FLAG,(TEMP) ;SAVE SET
JRST LPREM ;GET NEXT PARAM IF ANY
ELNSET:
TLNN A,ISSTR ;SAVING A STRING?
JRST REMESY ;NO.
HRROS A ;PREPARE FOR POP'S
POP A,(TEMP) ;2ND WORD STRING DESCRIPTOR
POP A,-1(TEMP) ;1ST WORD
JRST LPREM ;NEXT PARAM
REMESY:
MOVE FLAG,(A)
MOVEM FLAG,(TEMP)
JRST LPREM ;NEXT PARAM
REMCDR:
MOVEI B,(C) ;CDR CONTEXT LIST.
HRRZ C,(C)
TRZ C,DESC ;TURN OFF DESCRIPTOR BIT
JUMPN C,LPREM2 ;LOOP IF NOT AT END OF LIST
INSERT:
MOVE FP,FP2(TABL) ;TWO WORD FREE
MOVEI PNT,(FP) ;SAVE ADDR.
SKIPN FP,(FP) ;FOR NEXT TIME
PUSHJ P,FP2DON ;GET SOME MORE.
MOVEM FP,FP2(TABL) ;SAVE CDR FREE LIST
HRRM C,(PNT) ;CDR CONTEXT
DPB PNT,[POINT 17,(B),35] ;DON'T TOUCH PREVIOUS DESCP BIT
HRLM A,(PNT) ;THE REFERENCE
TLNN A,ISARR!ISSET!ISSTR ;A DESCRIPTOR TYPE OF THING?
JRST SCALAR ;NO.
MOVEI FLAG,DESC ;DESCRIPTOR BIT
ORM FLAG,(PNT) ;MARK AS DESCRIPTOR
TLNN A,ISARR ;AN ARRAY?
JRST NTARRY ;NO.
MOVEI B,(PNT)
;MAY WANT TO DELETE APPROPRIATE ARRAY ELEMENTS HERE
JUMPE C,REMVN2 ;IF NULL CDR
HRRZ FPD,-1(A) ;LENGTH OF ARRAY
SKIPG -2(A) ;STRING ARRAY?
HRRZ FPD,-2(A) ;LENGTH OF STRING ARRAY
ADDI FPD,(A) ;ADDR 1 PAST END OF ARRAY
PUSH P,A ;SAVE AC
PUSH P,FPD ;
LPREMV:
HLRZ FLAG,(C) ;CAND.
CAML FLAG,(P) ;WITHIN ARRAY?
JRST REMVND ;NO.
PUSHJ P,RELNOD ;RELEASE NODE
LDB C,[POINT =17,(B),=35]
JUMPN C,LPREMV
REMVND:
SUB P,X11 ;REMOVE HIGH ADDR OF ARRAY
POP P,A
REMVN2:
MOVE FLAG,A ;SAVE TYPE BITS LEFT HALF.
PUSH P,A ;PARAM TO ARCOP
PUSHJ P,ARCOP ;COPY THE ARRAY.
MOVE TABL,GOGTAB ;DON'T TRUST ARRAY ROUTINES
HRR FLAG,A ;READY TO SAVE ADDR.
MOVEM FLAG,1(B) ;SAVE ARRAY DESCRIPTOR
TLNN FLAG,ISSTR ;STRING ARRAY?
JRST NTSTR ;NO.
SKIPN FP,FP1(TABL) ;GET ONE WORD FREES.
PUSHJ P,FP1DON
MOVEI C,(FP) ;SAVE ADDR ONE WORD FREE
SKIPN FP,(FP) ;FOR NEXT TIME.
PUSHJ P,FP1DON ;IF OUT, GET MORE.
HRRM FP,FP1(TABL) ;SAVE CDR ONE-WORD FREE LIST
MOVE A,ARYLS(TABL) ;OLD STRING ARRAY LIST
HRRM A,(C) ;ADD NEW ELEMENT
HRLM FLAG,(C) ;ADDRESS STRING ARRAY
MOVEM C,ARYLS(TABL) ;SAVE STRING ARRAY LIST
JRST LPREM ;CONTINUE
NTSTR:
TLNN FLAG,ISSET ;SET ARRAY?
JRST LPREM ;NO.
SAVACS <(D,LPSA)>
SKIPN FP,FP1(TABL) ;ONE WORD FREES INITED?
PUSHJ P,FP1DON ;NO, GO DO IT.
HRRM FP,FP1(TABL)
PUSHJ P,COPARR ;COPY THE LIST ARRAY (ADDR IN A)
RESTACS <(LPSA,D)> ;RESTORE SAVED AC'S
JRST LPREM ;CONTINUE
NTARRY: ;NOT AN ARRAY
TLNE A,ISSTR ;A STRING?
JRST COPSTR ;MUST COPY STRING
TLNN A,ISSET ;HAD BETTER BE SET
ERR <DRYROT REMEMBER 2>
SAVACS <(LPSA,D,PNT)> ;SAVE AC'S WHICH WILL CHANGE
PUSH P,(A) ;SET TO BE COPIED
PUSH P,[0] ;NULL SET.
GLOB <
TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
>;GLOB
PUSHJ P,CATLST ;COPY SET
HLRE FLAG,(P) ;COUNT OF SET
MOVMS FLAG ;MAKE POS.
HRLM FLAG,(P) ;
HRR FP,FP1(TABL)
MOVEI FLAG,(FP)
SKIPN FP,(FP)
PUSHJ P,FP1DON
HRRM FP,FP1(TABL)
POP P,(FLAG)
HRLI FLAG,ISSET ;THIS IS A SET
RESTACS <(PNT,D,LPSA)> ;RESTORE AC'S
JRST COMMN
COPSTR: ;COPY STRING
PUSHJ P,SDESCR ;GET A STRING DESCRIPTOR
POP P,A ;NEW DESCRIPTOR
HLRO TEMP,(PNT) ;STRING TO BE COPIED
POP TEMP,(A) ;SECOND WORD
POP TEMP,-1(A) ;FIRST WORD
HRRZ FLAG,A
TLO FLAG,ISSTR ;MARK AS STRING DESCRIPTOR
JRST COMMN
SCALAR: ;SIMPLE SCALAR
MOVE FLAG,(A) ;VALUE
COMMN:
MOVEM FLAG,1(PNT) ;SAVE VALUE
JRST LPREM
REMREP: PUSH P,[LPREM] ;IN-LINE CALL
REP1:
COMMENT REPLACE THE OLD SAVED VALUE WITH THE CURRENT VALUE.
C - ADDR CONTEXT NODE
CALLED WITH PUSHJ
;HERE MAY HAVE TO INSERT SPECIAL STUFF FOR HANDLING FIRST ELEM OF ARRAY
MOVE PNT,(C) ;FIND OUT IF DESCRIPTOR
HLRZ A,(C) ;ADDRESS OF SAVED VAR.
TRNE PNT,DESC ;A DESCRIPTOR?
JRST ISDESC ;YES.
MOVE FLAG,(A) ;VALUE
MOVEM FLAG,1(C) ;SAVE IT.
POPJ P, ;RETURN
ISDESC:
MOVE PNT,1(C) ;GET DESCRIPTOR
TLNE PNT,ISARR ;AN ARRAY?
JRST REPARR ;YES.
TLNE PNT,ISSTR ;SCALAR STRING?
JRST REPSTR ;YES.
TLNN PNT,ISSET ;HAD BETTER BE SET.
ERR <DRYROT - REMEMBER 1>
MOVE PNT,(PNT)
TRNN PNT,-1 ;SEE IF NULL SET
JRST SETREL ;YES, DON'T TRY TO RELEASE
MOVE FP,FP1(TABL) ;PREPARE TO RELEASE SET
HLRZ PNT,(PNT) ;ADDR END OF SET
HRRM FP,(PNT) ;LINK SET ONTO FREE-LIST
MOVE PNT,1(C) ;GET SET HEAD
HRRM PNT,FP1(TABL) ;SAVE FREE-LIST
SETREL:
SAVACS <(LPSA,D,C)> ;SAVE IMPORTANT AC'S
PUSH P,(A) ;SET TO BE COPIED
PUSH P,[0] ;NULL SET
GLOB<
TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
>;GLOB
PUSHJ P,CATLST ;LET CATLST COPY SET
POP P,TEMP
RESTACS <(C,D,LPSA)> ;RESTORE AC'S
HLRE FLAG,TEMP ;LENGTH OF SET
MOVMS FLAG ;MAKE POSITIVE
HRLM FLAG,TEMP
MOVEM TEMP,@1(C) ;SAVED SET
REPCOM:
POPJ P, ;RETURN TO WHOEVER.
REPSTR:
HRROI TEMP,(A) ;ADDR OF NEW STRING
POP TEMP,(PNT) ;SECOND WORD
POP TEMP,-1(PNT) ;FIRST WORD
POPJ P,
REPARR: ;REPLACE AN ARRAY
TLNN PNT,ISSET ;A SET ARRAY?
JRST REPESY ;NO, JUST AS EASY TYPE
PUSH P,PNT ;ADDRESS OF SAVED ARRAY
PUSHJ P,ARRRCL ;RECLAIM LIST SPACE
REPESY: ;BLT IN NEW CONTENTS
TLNE PNT,ISSTR ;A STRING ARRAY
JRST [SUBI PNT,1 ;STRING ARRAY
SUBI A,1 ;ALSO NEW ARRAY
JRST .+1]
HRRZ FLAG,-1(PNT) ;SIZE OF ARRAY
ADDI FLAG,-1(PNT) ;LAST WORD TO BE SAVED
HRLI A,(PNT) ;ADDR FIRST WORD IN COPY OF ARRAY
MOVSS A ;PREPARE FOR BLT
BLT A,(FLAG) ;BLT ARRAY
TLNN PNT,ISSET ;SET ARRAY?
POPJ P, ;NO,RETURN.
SAVACS <(C,D,LPSA)>
PUSHJ P,COPARR ;COPY THE ELEMENTS ADDR ARRAY IN A
RESTACS <(LPSA,D,C)>
POPJ P, ;RETURN
RETALL: PUSH P,LPSA ;THE RETURN ADDRESS
JRST STACRS ;RESTORE AC'S
DSCR FORGET
HERE(FORGET) ;FORGET NAMED VARIABLES
PUSHJ P,STACSV ;SAVE OFF AC'S
MOVE TABL,GOGTAB ;USER TABLE
POP P,LPSA ;RETURN ADDRESS
POP P,D ;CONTEXT ADDRESS
LPFORG: POP P,A ;THE VARIABLE'S ADDRESS
JUMPE A,RETALL ;IF NONE, RETURN
TLNE A,ISARR ;IF ARRAY GET DESCRIPTOR
HRR A,(A)
;; \UR#22 JRL 4/28/78 following two instructions generated erroneous
;; error message.
; TLNN A,-1
; ERR <DRYROT AT FORGET- NO DESCRIPTOR>,1
SKIPN C,(D) ;HEAD OF CONTEXT LIST
NTTHER: ERR <FORGETTING UNREMBERED VARIABLE>,1,LPFORG
MOVEI B,(D) ;BACK POINTER
LPFOR2:
HLRZ PNT,(C) ;CANDIDATE
CAIN PNT,(A) ;RIGHT ONE?
JRST FNDNOD ;THE SAME.
CAIL PNT,(A) ;FURTHER DOWN LIST?
JRST NTTHER ;NO, SIGNAL ERROR
MOVEI B,(C) ;CDR LIST
HRRZ C,(C)
TRZ C,DESC
JUMPN C,LPFOR2 ;LOOP
JRST NTTHER ;WASN'T IN CONTEXT
FNDNOD: ;FOUND IN CONTEXT TO RELEASE
PUSH P,[LPFORG] ;IN LINE CALL
RELNOD: ;TO GENERALLY RELEASE NODE
;B CONTAINS BACKPOINTER,C THIS NODES ADDR.
MOVE PNT,(C) ;FIRST UNLINK NODE
DPB PNT,[POINT 17,(B),35]
TRNN PNT,DESC ;HARD CASE?
JRST FORESY ;NO
MOVE PNT,1(C) ;GET DESCRIPTOR
TLNE PNT,ISARR ;ANY KIND OF ARRAY?
JRST FORARR ;YES
TLNE PNT,ISSTR ;A SCALAR STRING?
JRST FORSTR ;YES
TLNN PNT,ISSET ;SHOULD BE THIS TYPE
ERR <DRYROT - FORGET 1>
SKIPN (PNT) ;NULL SET
JRST NULFOR ;YES
HRRZ FLAG,(PNT)
HLRZ FLAG,(FLAG)
MOVE FP,FP1(TABL) ;OLD FREE-LIST
HRRM FP,(FLAG) ;LINK ONTO RELEASED SET
HRRM PNT,FP1(TABL) ;SET RECLAIMED
JRST FORESY ;NOTHING TO IT.
NULFOR:
MOVE FP,FP1(TABL)
HRRM FP,(PNT)
HRRM PNT,FP1(TABL)
JRST FORESY
FORSTR:
SETZM -1(PNT) ;MAKE INTO NULL STRING
HLRZ FLAG,HASHP(TABL) ;STRING DESCRIPTOR LIST
HRRM FLAG,(PNT) ;LINK DESCRIPTOR ONTO FREE LIST
HRLM PNT,HASHP(TABL) ;ALL DONE
JRST FORESY
FORARR: ;AN ARRAY
TLNN PNT,ISSET!ISSTR ;SIMPLE ARRAY?
JRST FARESY ;YUPP!
TLNN PNT,ISSTR ;SET ARRAY
JRST FSTARY ;YES.
SETZM
;STRING ARRAY MUST BE REMOVED FROM ARYLS LIST
MOVEI TEMP,ARYLS(TABL) ;BACK POINTER
JRST ENDSRY ;JUMP TO TEST
LPSARY: HLRZ FLAG,(FPD) ;CANDIDATE
CAIN FLAG,(PNT) ;GOT IT?
JRST FNDARY ;YES
MOVEI TEMP,(FPD) ;FOR NEXT TIME
ENDSRY: SKIPE FPD,(TEMP) ;GET NEXT CANDIDATE.
JRST LPSARY ;LOOP
ERR <DRYROT FORGET 2>
FNDARY:
HRRZ FLAG,(FPD) ;LINK TO NEXT IN ARYLS
HRRM FLAG,(TEMP) ;DELETE NODE FROM LIST
HRR FP,FP1(TABL) ;PREPARE TO RELEASE FREE
HRRM FP,(FPD)
HRRM FPD,FP1(TABL) ;DONE
JRST FARESY
FSTARY:
;; \UR#16\ JRL 6/7/77 FOLLOWING USED TO BE
;; PUSH P,(PNT) ;ARRAY ADDRESS
PUSH P,PNT ; ARRAY ADDRESS
;; \UR#16\
PUSHJ P,ARRRCL ;RECLAIM LIST SPACE
FARESY:
SAVACS <(B,C,D,LPSA)>
PUSH P,PNT ;ARRAY TO BE RELEASED
PUSHJ P,ARYEL ;RELEASE IT
RESTACS <(LPSA,D,C,B)>
MOVE TABL,GOGTAB
FORESY:
MOVE FP,FP2(TABL) ;PREPARE TO RELEASE TWO WORD FREE
MOVEM FP,(C)
HRRM C,FP2(TABL)
POPJ P, ;RETURN TO WHOEVER
DSCR RESTOR RESTORE CONTENTS OF VARIABLES
HERE(RESTOR) ;ENTRY
PUSHJ P,STACSV
MOVE TABL,GOGTAB ;SET UP USER TABLE REG.
POP P,LPSA ;RETURN ADDR
POP P,D ;CONTEXT ADDR
LPRES:
POP P,A ;ADDR VAR TO BE RESTORED
JUMPE A,RETALL ;RETURN WHEN THROUGH
TLNE A,ISARR
HRR A,(A)
TRNN A,-1
ERR <DRYROT AT RESTOR>
HRRZ C,(D) ;ADDR FIRST NODE IN LIST
LPRES2:
JUMPE C,RESERR ;ERROR IF NIL LIST.
HLRZ PNT,(C) ;REFERENCE
CAIN PNT,(A) ;THE SAME?
JRST RESFND ;YES.
HRRZ FLAG,(C) ;DESC BIT&LINK
TRZN FLAG,DESC ;TURN OFF DESC,IF DESC STILL POSSIBILITY
JRST RESCDR
MOVE B,1(C) ;THE DESCRIPTOR
TLNN B,ISARR ;AN ARRAY?
JRST RESCDR ;NO.
MOVE FP,PNT ;ADDR ARRAY
TLNE B,ISSTR ;STRING ARRAY?
SUBI FP,1 ;SUB 1 FOR STRING ARRAY
HRRZ FP,-1(FP) ;LENGTH OF ARRAY
ADDI FP,(PNT) ;ADDR LAST ELEM IN ARRAY
CAIL FP,(A) ;IS VAR IN THIS ARRAY
CAILE PNT,(A) ;
JRST RESCDR ;NO
HRROI TEMP,(A) ;ADDR OF ELEM TO BE RESTORED
SUBI TEMP,(PNT) ;OFFSET
ADDI TEMP,(B) ;ADDR IN SAVED ARRAY.
TLNN B,ISSET!ISSTR ;HARD TYPE?
JRST RESES1 ;NO.
TLNN B,ISSET ;A SET
JRST ISSTR ;NO A STRING
SAVACS <(LPSA,D,A)> ;SAVE IMPORTANT AC'S
PUSH P,(TEMP) ;SET TO BE COPIED
PUSH P,[0] ;NIL SET
PUSHJ P,CATLST ;LET CAT DO THE WORK
RESTACS <(A,D,LPSA)> ;RESTORE AC'S
HLRE FLAG,(P) ;COUNT
MOVMS FLAG ;MAKE POSITIVE FOR PERM. SET.
HRLM FLAG,(P) ;PUT IT BACK
POP P,(A) ;SAVE THE SET
JRST LPRES ;NEXT ONE
RESCDR:
MOVEI B,(C)
HRRZ C,(C)
TRZ C,DESC
JRST LPRES2
RESERR:
ERR <RESTORE UNREMEMBERED VARIABLE>,1
JRST LPRES2
RE1STR: ;A STRING WITHIN A STRING ARRAY
POP TEMP,(A)
POP TEMP,-1(A)
JRST LPRES
RESES1:
MOVE FLAG,(TEMP)
MOVEM FLAG,(A)
JRST LPRES
RESFND: ;FOUND MATCH
PUSH P,[LPRES] ;IN-LINE CALL
RESNOD: ;RESTORE NODE ADDR IN C.
MOVE TEMP,(C) ;GET ENTIRE FIRST WORD.
HLRZ PNT,TEMP ;PLACE TO BE RESTORED TO.
MOVE FLAG,1(C) ;THE DESCRIPTOR, OR VALUE.
TRNN TEMP,DESC ;A DESCRIPTOR?
JRST RESESY ;NO.
TLZE FLAG,ISARR ;AN ARRAY?
JRST RESAR2 ;YES.
TLZN FLAG,ISSET ;A SET?
JRST RESSTR ;NO, A STRING.
SKIPN TEMP,(PNT) ;IS SET TO BE REPLACED NULL
JRST RESST2 ;YES
HLRZ B,(PNT) ;LAST NODE IN SET
MOVE FP,FP1(TABL) ;END OF FREE-LIST
HRRM FP,(B) ;CAT ONTO RELEASED SET
HRRM PNT,FP1(TABL) ;SAVE NEW FREE-LIST
RESST2:
SAVACS <(LPSA,D,C)>
PUSH P,(FLAG)
PUSH P,[0]
GLOB <
MOVEI FLAG,0 ;MAKE SURE GLB BIT OFF
>;GLOB
PUSHJ P,CATLST ;LET CAT DO THE WORK
HLRE FLAG,(P) ;RESULTANT SET
MOVMS FLAG ;MAKE INTO PERM SET.
HRLM FLAG,(P)
POP P,FLAG ;GET THE SET BACK
RESTACS <(C,D,LPSA)>
HLRZ PNT,(C)
MOVEM FLAG,(PNT) ;SAVE THE NEW SET.
POPJ P, ;RETURN
RESSTR: ;RESTORE A SCALAR STRING
HRROI FLAG,(FLAG) ;PREPARE FOR POP'S
POP FLAG,(PNT) ;SECOND WORD
POP FLAG,-1(PNT) ;FIRST WORD
POPJ P, ;RETURN
RESESY: ;SIMPLE SCALAR
MOVEM FLAG,(PNT) ;RESTORE VALUE
POPJ P, ;RETURN
RESAR2: ;RESTORE ENTIRE ARRAY
TLNN FLAG,ISSET ;A SET ARRAY?
JRST RESAR3 ;NO
PUSH P,PNT ;PREPARE TO RECLAIM LIST SPACE
PUSHJ P,ARRRCL ;RECLAIM IT
RESAR3:
TLNN FLAG,ISSTR ;A STRING ARRAY
JRST RESAR4 ;NO.
SUBI PNT,1
SUBI FLAG,1
RESAR4: ;GET READY TO BLT
HRRZ B,-1(PNT) ;NUMBER OF WORDS
ADDI B,-1(PNT) ;ADDR LAST WORD
HRLI PNT,(FLAG) ;BLT WORD
BLT PNT,(B) ;DO BLT
TLNN FLAG,ISSET ;SET ARRAY?
POPJ P, ;NO.
SAVACS <(LPSA,D,C)>
MOVEI A,(PNT) ;ADDR ARRAY TO BE COPIED
PUSHJ P,COPARR ;COPY LISTS WITHIN ARRAY
RESTACS <(C,D,LPSA)> ;RESTORE AC'S
POPJ P,
DSCR ALLRM,ALLFOR,ALLRS.
REMEMBER ALL IN CONTEXT;
FORGET ALL IN CONTEXT;
RESTORE ALL IN CONTEXT;
CONTEXT ADDR IN -1(P)
HERE(ALLRM) ;REMEMBER ALL
PUSHJ P,STACSV
MOVE TABL,GOGTAB ;USER TABLE
HRRZ C,@-1(P) ;FIRST IN CONTEXT LIST
LPALLR:
JUMPE C,ENDALL ;PROCESSED EVERYTHING IN CONTEXT?
PUSHJ P,REP1 ;ALTER THIS NODE.
HRRZ C,(C) ;CDR CONTEXT LIST.
TRZ C,DESC ;TURN OFF DESC BIT
JRST LPALLR ;LOOP
ENDALL:
PUSHJ P,STACRS
SUB P,X22 ;PREPARE TO RETURN
JRST @2(P) ;RETURN
HERE(ALLFOR) ;FORGET ALL
PUSHJ P,STACSV
MOVE TABL,GOGTAB ;USER TABLE
MOVEI B,@-1(P) ;ADDR CONTEXT LIST HEAD
LPALLF:
SKIPN C,(B) ;NEXT NODE IN CONTEXT LIST
JRST ENDALL ;NONE LEFT.
PUSHJ P,RELNOD ;RELEASE THIS NODE
JRST LPALLF ;LOOP
HERE(ALLRS) ;RESTORE ALL
PUSHJ P,STACSV
MOVE TABL,GOGTAB
MOVE C,@-1(P) ;FIRST NODE IN CONTEXT LIST
LPRESA:
JUMPE C,ENDALL ;NONE LEFT?
PUSHJ P,RESNOD ;RESTORE THIS NOD
HRRZ C,(C) ;CDR CONTEXT LST
TRZ C,DESC
JRST LPRESA
UOR <
DSCR CONCPY - To make a copy of a context list
PAR -1(P) ptr to first element of context list to be copied
RES AC A contains ptr to copy
SID don't believe any ac's
HERE(CONCPY) ; COPY A CONTEXT
INTERN CONCPY
; THROUGHOUT THIS ROUTINE
;
; A - PTR TO FIRST ELEMENT IN THE COPY
; B - PTR TO CURRENT ELEMENT IN COPY
; C - PTR TO CURRENT ELEMENT IN ORIGINAL
; D,TAC1,FLAG - SHORT TERM TEMPORARIES
; FP - normally pointer to next available 2-word cell
; sometimes a short-term temp.
;
; OCCASIONALLY ABOVE CONVENTIONS ARE VIOLATED DUE TO
; REQUIREMENTS OF SUBROUTINES CALLED BY THIS ROUTINE.
SKIPN C,-1(P) ; A NULL CONTEXT TO BE COPIED?
JRST [MOVEI A,0 ; YES.
SUB P,X22
JRST @2(P)]
MOVE TABL,GOGTAB ; SET UP USER TABLE
SKIPN FP,FP2(TABL) ; TWO-WORD FREE LIST SET UP?
PUSHJ P,FP2DON ; NO. GO SET IT UP.
MOVEI A,(FP) ; SAVE PTR TO FIRST ELEMENT OF NEW LIST
LPCCPY:
MOVEI B,(FP) ; PTR TO CURRENT CELL IN CONTEXT LIST
SKIPN FP,(FP) ; REMOVE CELL FROM FREE LIST
PUSHJ P,FP2DON ; IF FREE LIST EXHAUSTED. GET MORE
MOVE TAC1,(C) ; COPY VAR ADDR,DESC BIT FROM OLD NODE
MOVEM TAC1,(B) ; INTO NEW NODE
MOVE D,1(C) ; OLD VALUE
MOVEM D,1(B) ; INTO NEW NODE
TRNN TAC1,DESC ; A DESCRIPTOR THING?
JRST NXTELM ; NO. FINISHED WITH THIS NODE
HRRM FP,FP2(TABL) ; IN CASE WE NEED FREE STORAGE BELOW
TLNN D,ISARR ; ARRAY DESCRIPTOR?
JRST NOTARY ; NOPE
SAVACS <(A,B,C,D)> ; SAVE AC'S OVER ARRAY COPY
PUSH P,D ; THE ARRAY TO BE COPIED
HRRZS (P) ; ZERO OUT DESCRIPTOR BITS
PUSHJ P,ARCOP ; COPY RETURNED IN AC A
MOVE TABL,GOGTAB
HRR FLAG,A ; SAVE ADDR OF NEW ARRAY
RESTACS <(D,C,B,A)> ; RESTORE THE AC'S
HRRM FLAG,1(B) ; SAVE ARRAY ADDRESS IN CONTEXT NODE
TLNN D,ISSTR ; A STRING ARRAY?
JRST NTSTRA ; NO.
; A STRING ARRAY MUST BE LINKED INTO ARYLS LIST SO STRING GC CAN FIND
SKIPN FP,FP1(TABL) ; ONE-WORD FREE LIST INITED?
PUSHJ P,FP1DON ; NO. GO DO IT.
MOVEI D,(FP) ; ADDR OF NODE FOR ARYLS LIST
SKIPN FP,(FP) ; REMOVE FROM FREE LIST
PUSHJ P,FP1DON ; GET MORE FREE'S IF LIST EXHAUSTED
HRRM FP,FP1(TABL) ; SAVE THE 1-WORD FREE LIST PNTR.
MOVE FP,ARYLS(TABL) ; LINKED LIST OF STRING ARRAY DESCRIPTORS
HRRM FP,(D) ; CONS NEW NODE AT HEAD OF ARYLS LIST
HRLM FLAG,(D) ; ADDR OF STRING ARRAY
MOVEM D,ARYLS(TABL) ; SAVE OFF NEW ARYLS LIST
JRST AFTDES ; WE'RE THROUGH
NTSTRA:
TLNN D,ISSET ; A SET OR LIST ARRAY?
JRST AFTDES ; NO, SIMPLE ARRAY, WE'RE THROUGH
SAVACS <(A,B,C)> ; SAVE ACS OVER CALL TO COPARR
SKIPN FP,FP1(TABL) ; MAKE SURE 1-WORD FREE LIST INITED
PUSHJ P,FP1DON
HRRM FP,FP1(TABL)
MOVE A,FLAG ; PARM TO COPARR IN AC A
PUSHJ P,COPARR ; COPY THE LISTS
RESTACS <(C,B,A)> ; RESTORE ACS
JRST AFTDES ; WE'RE THROUGH WITH THIS ARRAY
NOTARY: ; NOT AN ARRAY
TLNN D,ISSTR ; A STRING?
JRST NOTSTR ; NO
PUSHJ P,SDESCR ; GET A FRESH STRING DESCRIPOR
POP P,TAC1 ; ADDR OF STRING DESCRIPTOR
; SDESCR SAVED ALL AC'S SO DON'T WORRY
HRRM TAC1,1(B)
HRROI D,(D)
POP D,(TAC1)
POP D,-1(TAC1) ; COPY THE STRING
JRST AFTDES ; THROUGH WITH THIS CONTEXT ELEMENT
NOTSTR: TLNN D,ISSET ;BUG TRAP
ERR <DRYROT: CONCPY MISSING DESCRIPTOR BITS>
; TO COPY A SET OR LIST LET CATLST DO THE WORK
SAVACS <(A,B,C)>
PUSH P,(D)
PUSH P,[0]
GLOB <
TRZ FLAG,GLBSRC ;TO BE SAFE
>; GLOB
PUSHJ P,CATLST
HLRE FLAG,(P)
MOVMS FLAG
HRLM FLAG,(P) ; MAKE LENGTH POSITIVE
MOVE TABL,GOGTAB
SKIPN FP,FP1(TABL)
PUSHJ P,FP1DON
MOVEI D,(FP)
SKIPN FP,(FP)
PUSHJ P,FP1DON
HRRM FP,FP1(TABL)
POP P,(D)
RESTACS <(C,B,A)>
HRRM D,1(B)
AFTDES:
MOVE TABL,GOGTAB
MOVE FP,FP2(TABL)
NXTELM:
HRRZ C,(C) ; CDR OF CONTEXT LIST BEING COPIED
TRZ C,DESC ; TURN OFF DESCRIPTOR BIT
JUMPE C,FINCPY ; NULL CDR?
DPB FP,[POINT 17,(B),35]
JRST LPCCPY
FINCPY:
HRRM FP,FP2(TABL)
SUB P,X22
JRST @2(P)
>;UOR
DSCR GFREES
GLOB <
^GFREES: ;ATTEMPT TO USE WASTED SPACE IN INFOTAB,DATAB
PUSHJ P,FSAV ;SAVE AC'S (PROBABLY NOT NECESSARY)
MOVE B,ITMTOP(USER) ;MAX LOCAL ITEM NUMBER
MOVEI C,GBRK ;BEGINNING OF GLOBALS
CAIL B,-20(C) ;WON'T EVEN TRY IF LESS THAN 20 SPACES
JRST FREST ;RESTORE AC'S AND RETURN
SUBI C,2(B) ;COUNT OF FREE SPACES
PUSH P,C ;SAVE FOR LATER
ADD B,INFOTAB(USER) ;
ADDI B,1 ;ONE MORE
MOVS FP,FP1(USER)
HRRM B,(FP) ;LINK ONTO END OF CURRENT ONE WORD FREES
ADDI B,1 ;GET READY TO LINK UP.
HRRZM B,-1(B) ;LINK UP.
SOJG C,.-2 ;LOOP UNTIL DONE
SETZM (B) ;LAST LINK IS NIL.
HRLM B,FP1(USER) ;ADDRESS LAST FREE CELL
POP P,C ;NUMBER OF FREE CELLS
LSH C,-1 ;DIVIDE BY 2
MOVE B,DATAB(USER)
ADD B,ITMTOP(USER) ;ADDRESS FIRST AVAIL TWO-WORD FREE -1.
ADDI B,1 ;ADDRESS FIRST TWO-WORD FREE
MOVE FP,FP2(USER)
HRRZM B,(FP) ;BEGINNING OF LIST OF AVAIL. SPACE
ADDI B,2 ;LINKING THEM UP.
HRRZM B,-2(B) ;LINK.
SOJG C,.-2 ;LOOP UNTIL DONE
SETZM (B) ;LAST LINK IS NIL
PUSHJ P,FREST ;RESTORE AC'S
POPJ P,
>;GLOB
^FPEES:
;GET VERY SMALL AMOUNTS OF BOTH KINDS OF FREE STORAGE.
PUSHJ P,FSAV ;SAVE OFF AC'S
LPCOR (14,) ;2 -TWO-WORD FREE'S PLUS 10 ONE-WORD FREE'S
HRRZM B,FP2(TABL)
MOVEI C,2(B)
HRRM C,(B) ;LINK THE 2 TWO-WORD FREE'S TOGETHER
MOVEI B,4(B) ;START OF ONE-WORD FREES
HRLI B,7(B) ;ADDR OF LAST ONE-WORD NODE
MOVEM B,FP1(TABL) ;SAVE XWD LAST,FIRST
MOVNI C,7 ;LINKING 10 NODES TOGETHER
ADDI B,1
HRRZM B,-1(B) ;LINK EM UP
AOJL C,.-2
SETZM (B) ;JUST TO BE SAFE
JRST FREST ;RESTORE AC'S AND RETURN
DSCR FP1DON FP2DON
THESE ARE THE ROUTINES FOR GETTING MORE FREE STORAGE FROM
THE MAIN CORE ALLOCATORS. FP1DON GETS 1 WORD FREES, FP2DON
GETS 2 WORD FREES. THEY ARE GENERALLY CALLED UNDER A SKIPN FP,(FP)
AND RETURN FP POINTING TO THE HEAD OF THE NEW FREE STORAGE LIST.
FP1DON DOES A SPECIAL THING -- THE LAST ELEMENT OF THE OLD FREE
STORAGE LIST IS LINKED TO THE FIRST ELEMENT OF THE NEW ONE -- THIS
IS SO THAT SETS (I.E. LINKED LISTS) CAN BE MADE IN ONE PIECE,
WITHOUT WORRYING ABOUT LINKING THE INDIVIDUAL CELLS TOGETHER.
ACS SAVED -- ALL
AC RESULT -- FP HAS NEW POINTER.
;
HERE(FP1DON)
PUSHJ P,FSAV
LPCOR (FREELEN,) ;GET THE CORE
HRRM B,FP1(TABL)
HRRZM B,SGACS+FP(USER)
HLRZ C,FP1(TABL) ;THIS WAS THE LAST WORD BEFORE.
SKIPE C ;NONE THERE
HRRM B,(C) ;LINK IT DOWN....
MOVNI A,FREELEN-1
ADDI B,1
HRRZM B,-1(B) ;LINK UP THE LIST
AOJL A,.-2
SETZM (B)
HRLM B,FP1(TABL) ;SAVE ADDR OF LAST FREE FOR LINKING
JRST FREST ;AND DONE.
HERE(FP2DON)
PUSHJ P,FSAV
LPCOR (FREELEN,FP2)
HRRZM B,SGACS+FP(USER)
MOVNI A,FREELEN/2-1
ADDI B,2
HRRZM B,-2(B)
AOJL A,.-2 ;LINK UP.
SETZM (B)
^FREST: MOVSI 14,SGACS(USER)
BLT 14,14
POPJ P,
^FSAV: MOVEM 14,SGACS+14(USER)
MOVEI 14,SGACS(USER)
BLT 14,SGACS+13(USER)
POPJ P,
DSCR SDESCR - GET A TWO WORD STRING DESCRIPTOR
A LIST OF TWO WORD STRING DESCRIPTORS (COLLECTABLE BY
GARBAGE COLLECTOR) IS HEADED IN LEFT-HALF HASHP(USER).
THIS ROUTINE WILL RETURN CAR OF THIS LIST ON TOP OF
STACK AND IF LIST IS NULL WILL ALLOCATE A NEW
STRING ARRAY, LINK THAT ARRAY INTO THE LIST OF STRING
ARRAYS (ARYLS(USER)) AND LINK TOGETHER THE INDIVIDUAL
ARRAY ELEMENTS TO FORM A NEW LIST OF STRING DESCRIPTORS.
ALL AC'S ARE RESTORED TO THEIR PREVIOUS VALUES BEFORE
EXIT FROM THE ROUTINE.
HERE(SDESCR) ;ENTRY-POINT
ADD P,[XWD 15,15] ;WILL SAVE AC'S ON STACK
SKIPL P ;STACK OVERFLOW?
JSP USER,$PDLOV ;YES.
PUSH P,USER ;SAVE USER ALSO.
HRRI USER,-15(P) ;ADDR. WHERE 0 TO BE SAVED
BLT USER,-1(P) ;SAVE AC'S 0 TO 14
MOVE USER,GOGTAB ;USER TABLE
HLRZ A,HASHP(USER) ;ANY FREE DESCRIPTORS.
JUMPN A,UNLINK ;IF YES, TAKE CAR.
SKIPE HASHP(USER) ;PNAMES ALSO
JRST NOINIT ;ALREADY INITED.
MOVEI C,0 ;COUNT OF PNAMES REQUIRED
MOVE A,SPLNK(USER) ;SPACE ALLOCATION BLOCK LIST
PNMCNT: JUMPE A,HAVCNT ;THROUGH WITH ALLOCATION BLOCKS
CAMGE C,$PNMNO(A) ;MORE THAN THIS PROG REQUIRES?
MOVE C,$PNMNO(A) ;NO.
HRRZ A,(A) ;CDR ALLOCATION LIST
JRST PNMCNT ;LOOP
HAVCNT: CAIG C,50 ;AT LEAST 50?
NOINIT: MOVEI C,50 ;STANDARD SIZE IS 50
PUSH P,[0] ;MAKE THE STRING ARRAY
PUSH P,C ;UPPER BOUND
PUSH P,[XWD -1,1] ;INDICATE STRING ARRAY
MOVE C,UUO1(USER) ;SINCE ARMAK WILL DESTROY
PUSHJ P,ARMAK ;MAKE THE ARRAY
MOVE USER,GOGTAB
MOVEM C,UUO1(USER) ;RESTORE UUO1
SKIPN FP,FP1(USER) ;ONE-WORD FREE'S INITED?
PUSHJ P,FP1DON ;NO.
MOVEI B,(FP) ;ADDR. ONE-WORD FREE
SKIPN FP,(FP) ;FOR NEXT TIME
PUSHJ P,FP1DON ;IF OUT, GET MORE.
HRRM FP,FP1(USER) ;SAVE FREE-LIST
HRLI D,(A) ;ADDRESS NEW STRING ARRAY
HRR D,ARYLS(USER) ;LINK IN OLD ARRAY LIST
MOVEM D,(B) ;INTO ONE-WORD FREE
HRRM B,ARYLS(USER) ;NEW STRING ARRAY LIST.
MOVN C,-4(A) ;LENGTH OF ARRAY
HRL A,A ;
ADDI A,2
INT2: HLRM A,(A) ;LINK THEM UP
ADD A,X22
AOJL C,INT2 ;LOOP.
HLR A,A ;FREE STRING DESCRIPTOR LIST
UNLINK: ;HEAD OF DESCRIPTOR LIST IN A
HRRZ B,(A) ;CDR DESCRIPTOR LIST
HRLM B,HASHP(USER) ;SAVE CDR
SETZM -1(A) ;MAKE INTO NIL STRING
EXCH A,-16(P) ;EXCHANGE WITH RETURN ADDR
PUSH P,A ;SAVE RETURN ADDR.
HRLZI USER,-16(P) ;ADDR WHERE AC 0 SAVED
BLT USER,USER ;RESTORE AC'S
SUB P,[XWD 17,17] ;RESTORE STACK
JRST @17(P) ;RETURN
DSCR .INCONT- IS VAR IN CONTEXT
HERE(.INCONT)
PUSHJ P,STACSV ;SAVE THE AC'S
MOVE USER,GOGTAB ;SET UP USER TABLE
POP P,UUO1(USER) ;SAVE RETURN ADDRESS
POP P,LPSA ;THE CONTEXT POINTER
JUMPE LPSA,NFALRET ;NOTHING IN NULL CONTEXT
MOVE PNT,(P) ;THE THING WE'RE LOOKING FOR
SETZM TEMP ;FIRST TIME THROUGH
NCNLP: HLRZ B,(LPSA) ;CONTEXT ELEMENT ADDR
CAIL B,(PNT) ;KEEP ON SEARCHING?
JRST CHKAD2 ;NO.
MOVEI TEMP,(LPSA) ;SAVE POINTER TO PREVIOUS ELEMENT
HRRZ LPSA,(LPSA) ;CDR CONTEXT LIST
TRZ LPSA,DESC
JUMPN LPSA,NCNLP ;LOOP IF NOT THROUGH
CHKAD1: ;CHECK TO SEE IF PREDECESSOR AN ARRAY
JUMPE TEMP,NFALRET ;NO PREDECESSOR
TLNE PNT,ISARR ;IF AN ARRAY NO HOPE
JRST NFALRET ;
MOVE B,(TEMP) ;IS PREDECESSOR AN ARRAY
MOVE C,1(TEMP) ;
TRNE B,DESC
TLNN C,ISARR
JRST NFALRET ;NOT AN ARRAY
HLRZ B,B ;ARRAY DESCRIPTOR ADDRESS
HRRZ C,-1(B) ;SIZE OF ARRAY
SKIPG -2(B) ;A STRING ARRAY?
HRRZ C,-2(B)
ADDI B,(C) ;ONE POS PAST ADDR LAST IN ARRAY
CAMLE B,(PNT)
JRST NTRURET
NFALRET: TDZA A,A
NTRURET: SETOM A
MOVEM A,STACS+1(USER) ;THE RETURN VALUE
MOVE PNT,UUO1(USER) ;THE RETURN ADDRESS
EXCH PNT,(P)
JRST STACRS
CHKAD2: CAIE B,(PNT) ;THE SAME
;; \UR#13\ AVOID INFINITE LOOP jrl - following used to be chkad2
JRST CHKAD1 ;NO CHECK PREDECESSOR
MOVE B,(LPSA)
MOVE C,1(LPSA) ;SEE IF THIS AN ARRAY
TRNE B,DESC
TLNN C,ISARR
SKIPA
JRST NTRURET ;YES AN ARRAY
MOVE PNT,(P)
TLNE PNT,ISARR
JRST NFALRET
JRST NTRURET
DSCR CONELM - C:VAR CONSTRUCT
PAR -2(P) CONTEXT C
-1(P) ADDR VAR
RES ADDRESS OF VAR IN CONTEXT RETURNED IN A
HERE(CONELM)
PUSHJ P,SAVE ;SAVE OFF AC'S
MOVE A,-1(P) ;THE VAR
TLNE A,ISARR ;BETTER NOT BE FULL ARRAY
ERR <DRYROT AT CONELM>
;; \UR#15\ JRL 6/7/77 TURN OFF LH BITS
MOVEI A,(A)
MOVE B,-2(P)
SETZ TEMP, ;FLAG FOR FIRST TIME THROUGH
LPCELM:
TRZ B,DESC ;TURN OFF DESCRIPTOR
JUMPE B,CONERR ;NOTTHERE?
HLRZ C,(B)
CAIN C,(A) ;WHAT WE WANT
JRST CONGOT
CAIL C,(A)
JRST PASTIT ;NO
MOVEI TEMP,(B) ;REMEMBER PREVIOUS
HRRZ B,(B) ;CDR DOWN CONTEXT
JRST LPCELM
CONGOT:
HRRI A,1(B) ;ASSUME THIS IS CELL
MOVE TEMP,1(B) ;
MOVE D,(B) ;SEE IF THIS IS FIRST ELEM OF SAVED ARRAY
TRNN D,DESC
JRST FINCON
TLNE TEMP,ISARR!ISSET!ISSTR ;FIRST ELEM OF AN ARRAY OR A SET?
HRRZ A,1(B)
JRST FINCON
PASTIT:
JUMPE TEMP,CONERR ;NOT THERE?
MOVE B,(TEMP) ;PREVIOUS ELM
MOVE C,1(TEMP) ;PREPARE TO TEST IF ARRAY
TRNE B,DESC ;IF ARRAY HAS DESC ON
TLNN C,ISARR ;
JRST CONERR
HLRZ B,B
;; \UR#15\ JRL 6/6/77 SHOULD USE A NOT PNT
; MOVEI PNT,(A) ;THE ADDRESS WE'RE LOOKING FOR
; SUBI PNT,(B) ;OFFSET
SUBI A,(B) ;OFFSET
SKIPG LPSA,-1(C) ;LENGTH OF SAVED ARRAY
MOVE LPSA,-2(C) ;LENGTH OF SAVED STRING ARRAY
; CAILE PNT,(LPSA) ;IN RANGE
CAILE A,(LPSA) ;IN RANGE
JRST CONERR ;NOPE
; ADDI A,(PNT)
ADDI A,(C) ;ADDRESS WITHIN SAVED ARRAY
;; \UR#15\ END OF FIXES
FINCON:
;; \UR#13\ FOLLOWING USED TO BE A MOVEM
HRROM A,RACS+1(USER)
MOVE LPSA,X33
JRST RESTR
CONERR: ERR <VAR NOT INCONTEXT>,1
JRST FINCON
DSCR ONEWRD- GET THE ADDRESS OF NEW ONE WORD FREE CELL
PAR- NONE
SID - A POINTS TO A NEW ONE WORD FREE CELL
HERE(ONEWRD) ;TO GET SINGLE ONE-WORD FREE
PUSH P,FP ;SAVE OFF AC'S WE CHANGE
PUSH P,USER
MOVE USER,GOGTAB ;SET UP USER TABLE
SKIPN FP,FP1(USER)
PUSHJ P,FP1DON
MOVEI A,FP
SKIPN FP,(FP)
PUSHJ P,FP1DON ;GET SOME FOR NEXT TIME
HRRM FP,FP1(USER)
SETZM (A) ;CLEAR IT FOR SAFETY
POP P,USER
POP P,FP
POPJ P,
DSCR TWOWRD - GET THE ADDRESS OF A NEW TWO WORD FREE CELL
PAR -NONE
SID - A POINTS TO A NEW ONE-WORD FREE CELL
HERE(TWOWRD)
PUSH P,FP
PUSH P,USER
MOVE USER,GOGTAB
SKIPN FP,FP2(USER)
PUSHJ P,FP2DON
MOVEI A,FP
SKIPN FP,(FP)
PUSHJ P,FP2DON
HRRM FP,FP2(USER)
SETZM (A) ;ZERO BOTH WORDS
SETZM 1(A)
POP P,USER
POP P,FP
POPJ P,
BEND BACKTR
XLIST ;EXPURGATE SYMBOLS
GLOB <
BEND LEAP
>
IFE ALWAYS, < END > ;END OF LIB ASSEMBLY