perm filename WRDGET[IMS,AIL] blob
sn#051748 filedate 1973-07-03 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00011 PAGES VERSION 16-2(1)
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00002 00002 HISTORY
00500 00003 00003 DSCR REMEMB,FORGET,RESTOR
00600 00013 00004 COPSTR: COPY STRING
00700 00018 00005 DSCR FORGET
00800 00023 00006 DSCR RESTOR RESTORE CONTENTS OF VARIABLES
00900 00026 00007 RESFND: FOUND MATCH
01000 00028 00008
01100 00029 00009 DSCR ALLRM,ALLFOR,ALLRS.
01200 00031 00010 DSCR GFREES
01300 00039 00011
01400 00040 ENDMK
01500 ⊗;
00100 COMMENT ⊗HISTORY
00200 AUTHOR,REASON
00300 021 202000000001 ⊗;
00400
00500
00600 COMMENT ⊗
00700 VERSION 16-2(1) 9-21-72 BY JRL PUT IN VERSION NUMBER
00800
00900 ⊗;
00100 DSCR REMEMB,FORGET,RESTOR
00200 ⊗
00300
00400
00500 DESC ←← 400000 ;INDICATES A DESCRIPTOR OF SOME SORT
00600 ISARR ←← 200000 ;ARRAY
00700 ISSTR ←← 100000 ;STRING
00800 ISSET ←← 40000 ;SET OR LIST
00900
01000
01100 HERE(REMEMB)
01200 PUSHJ P,STACSV ;SAVE OFF ACCUMULATORS
01300 MOVE TABL,GOGTAB ;USER TABLE
01400 POP P,LPSA ;RETURN ADDRESS
01500 POP P,D ;REF TO CONTEXT
01600 SKIPN FP,FP2(TABL) ;ANY TWO WORD FREES YET
01700 PUSHJ P,FP2DON ;NO GO GET SOME
01800 MOVEM FP,FP2(TABL)
01900 LPREM:
02000 POP P,A ;VAR TO BE SAVED
02100 JUMPE A,RETALL ;IF THROUGH, RETURN
02200 TLNE A,ISARR ;IF ARRAY GET DESCRIPTOR
02300 HRR A,(A)
02400 TRNN A,-1 ;IF NOTHING THERE, TROUBLE
02500 ERR <REMEMBER: MISSING ARRAY DESCRIPTOR>,1
02600 MOVEI B,(D) ;START LOOKING AT HEAD OF CONTEXT LIST
02700 HRRZ C,(B)
02800 JUMPE C,INSERT ;NIL CONTEXT LIST?
02900 LPREM2:
03000 HLRZ PNT,(C) ;CANDIDATE
03100 CAIN PNT,(A) ;SAME AS OUR PARM.
03200 JRST REMREP ;YES.
03300 CAIL PNT,(A) ;FURTHER DOWN LIST?
03400 JRST INSERT ;NO.
03500 ;AT THIS POINT WE HAVE DETERMINED THAT THE ADDRESS OF THE PARAMETER
03600 ;IS GREATER THAT THE ADDRESS OF THE STORED VALUE, BUT THE PARAMETER
03700 ;MAY STILL BE AN ELEMENT OF A STORED ARRAY
03800 MOVE TEMP,(C) ;DESC BIT ON IF MIGHT BE ARRAY
03900 TLNN A,ISARR ;IS PARAM AN ARRAY
04000 TRNN TEMP,DESC ;STORED ONE A DESCRIPTOR
04100 JRST REMCDR ;NOT ELEM OF STORED ARRAY.
04200 MOVE TEMP,1(C) ;GET DESCRIPTOR
04300 TLNN TEMP,ISARR ;STORED ARRAY?
04400 JRST REMCDR ;NO.
04500 HRRZ FPD,-1(TEMP) ;SIZE OF ARRAY.
04600 SKIPG -2(TEMP) ;STRING ARRAY?
04700 HRRZ FPD,-2(TEMP) ;GET SIZE OF STRING ARRAY
04800 ADDI FPD,(TEMP) ;ADDR LAST +1 ELEM OF ARRAY
04900 CAIG FPD,(A) ;MUST BE GREATER THAT PARAM ADDR
05000 JRST REMCDR ;ISN'T
05100 ;WE'RE REMEMBERING A SINGLE ELEMENT OF AN ALREADY SAVED ARRAY
05200 MOVEI TEMP,(A) ;ADDR ARRAY ELEM TO BE SAVED
05300 SUBI TEMP,(PNT) ;OFFSET OF ARRAY ELEM
05400 ADD TEMP,1(C) ;ADDR SAVED ARRAY
05500 TLNN A,ISSET ;SAVING A SET?
05600 JRST ELNSET ;NO.
05700 SKIPN FPD,(TEMP) ;ADDR LASTWORD,,FIRSTWORD
05800 JRST RNOSET ;SET WAS NULL.
05900 HLRZ PNT,(FPD) ;LASTWORD ADDR
06000 HRR FP,FP1(TABL) ;HEAD OF ONE-WORD FREES
06100 HRRM FP,(PNT) ;LINK IN RELEASED SET
06200 HRRM FPD,FP1(TABL) ;NEW FREE-LIST
06300 RNOSET:
06400 SAVACS <(TEMP,LPSA,D)>
06500 PUSH P,A ;SET TO BE COPIED
06600 PUSH P,[0] ;NULL SET
06700 GLOB<
06800 TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
06900 >;GLOB
07000 PUSHJ P,CATLST ;LET CAT DO THE WORK
07100 HLRE FLAG,(P) ;GET NEG LENGTH
07200 MOVMS FLAG ;MAKE POS
07300 HRLM FLAG,(P) ;STORE INTO SET DESCRIPTOR
07400 POP P,FLAG ;SET DESCRIPTOR
07500 RESTACS <(D,LPSA,TEMP)>
07600 MOVEM FLAG,(TEMP) ;SAVE SET
07700 JRST LPREM ;GET NEXT PARAM IF ANY
07800 ELNSET:
07900 TLNN A,ISSTR ;SAVING A STRING?
08000 JRST REMESY ;NO.
08100 HRROS A ;PREPARE FOR POP'S
08200 POP A,(TEMP) ;2ND WORD STRING DESCRIPTOR
08300 POP A,-1(TEMP) ;1ST WORD
08400 JRST LPREM ;NEXT PARAM
08500 REMESY:
08600 MOVE FLAG,(A)
08700 MOVEM FLAG,(TEMP)
08800 JRST LPREM ;NEXT PARAM
08900
09000 REMCDR:
09100 MOVEI B,(C) ;CDR CONTEXT LIST.
09200 HRRZ C,(C)
09300 TRZ C,DESC ;TURN OFF DESCRIPTOR BIT
09400 JUMPN C,LPREM2 ;LOOP IF NOT AT END OF LIST
09500 INSERT:
09600 MOVE FP,FP2(TABL) ;TWO WORD FREE
09700 MOVEI PNT,(FP) ;SAVE ADDR.
09800 SKIPN FP,(FP) ;FOR NEXT TIME
09900 PUSHJ P,FP2DON ;GET SOME MORE.
10000 MOVEM FP,FP2(TABL) ;SAVE CDR FREE LIST
10100 HRRM C,(PNT) ;CDR CONTEXT
10200 DPB PNT,[POINT 17,(B),35] ;DON'T TOUCH PREVIOUS DESCP BIT
10300 HRLM A,(PNT) ;THE REFERENCE
10400 TLNN A,ISARR!ISSET!ISSTR ;A DESCRIPTOR TYPE OF THING?
10500 JRST SCALAR ;NO.
10600 MOVEI FLAG,DESC ;DESCRIPTOR BIT
10700 ORM FLAG,(PNT) ;MARK AS DESCRIPTOR
10800 TLNN A,ISARR ;AN ARRAY?
10900 JRST NTARRY ;NO.
11000 MOVEI B,(PNT)
11100 ;MAY WANT TO DELETE APPROPRIATE ARRAY ELEMENTS HERE
11200 JUMPE C,REMVN2 ;IF NULL CDR
11300 HRRZ FPD,-1(A) ;LENGTH OF ARRAY
11400 SKIPG -2(A) ;STRING ARRAY?
11500 HRRZ FPD,-2(A) ;LENGTH OF STRING ARRAY
11600 ADDI FPD,(A) ;ADDR 1 PAST END OF ARRAY
11700 PUSH P,A ;SAVE AC
11800 PUSH P,FPD ;
11900 LPREMV:
12000 HLRZ FLAG,(C) ;CAND.
12100 CAML FLAG,(P) ;WITHIN ARRAY?
12200 JRST REMVND ;NO.
12300 PUSHJ P,RELNOD ;RELEASE NODE
12400 LDB C,[POINT =17,(B),=35]
12500 JUMPN C,LPREMV
12600 REMVND:
12700 SUB P,X11 ;REMOVE HIGH ADDR OF ARRAY
12800 POP P,A
12900 REMVN2:
13000 MOVE FLAG,A ;SAVE TYPE BITS LEFT HALF.
13100 PUSH P,A ;PARAM TO ARCOP
13200 PUSHJ P,ARCOP ;COPY THE ARRAY.
13300 MOVE TABL,GOGTAB ;DON'T TRUST ARRAY ROUTINES
13400 HRR FLAG,A ;READY TO SAVE ADDR.
13500 MOVEM FLAG,1(B) ;SAVE ARRAY DESCRIPTOR
13600 TLNN FLAG,ISSTR ;STRING ARRAY?
13700 JRST NTSTR ;NO.
13800 SKIPN FP,FP1(TABL) ;GET ONE WORD FREES.
13900 PUSHJ P,FP1DON
14000 MOVEI C,(FP) ;SAVE ADDR ONE WORD FREE
14100 SKIPN FP,(FP) ;FOR NEXT TIME.
14200 PUSHJ P,FP1DON ;IF OUT, GET MORE.
14300 HRRM FP,FP1(TABL) ;SAVE CDR ONE-WORD FREE LIST
14400 MOVE A,ARYLS(TABL) ;OLD STRING ARRAY LIST
14500 HRRM A,(C) ;ADD NEW ELEMENT
14600 HRLM FLAG,(C) ;ADDRESS STRING ARRAY
14700 MOVEM C,ARYLS(TABL) ;SAVE STRING ARRAY LIST
14800 JRST LPREM ;CONTINUE
14900 NTSTR:
15000 TLNN FLAG,ISSET ;SET ARRAY?
15100 JRST LPREM ;NO.
15200 SAVACS <(D,LPSA)>
15300 SKIPN FP,FP1(TABL) ;ONE WORD FREES INITED?
15400 PUSHJ P,FP1DON ;NO, GO DO IT.
15500 HRRM FP,FP1(TABL)
15600 PUSHJ P,COPARR ;COPY THE LIST ARRAY (ADDR IN A)
15700 RESTACS <(LPSA,D)> ;RESTORE SAVED AC'S
15800 JRST LPREM ;CONTINUE
15900 NTARRY: ;NOT AN ARRAY
16000 TLNE A,ISSTR ;A STRING?
16100 JRST COPSTR ;MUST COPY STRING
16200 TLNN A,ISSET ;HAD BETTER BE SET
16300 ERR <DRYROT REMEMBER 2>
16400 SAVACS <(LPSA,D,PNT)> ;SAVE AC'S WHICH WILL CHANGE
16500 PUSH P,(A) ;SET TO BE COPIED
16600 PUSH P,[0] ;NULL SET.
16700 GLOB <
16800 TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
16900 >;GLOB
17000 PUSHJ P,CATLST ;COPY SET
17100 HLRE FLAG,(P) ;COUNT OF SET
17200 MOVMS FLAG ;MAKE POS.
17300 TRO FLAG,ISSET ;MARK AS SET DESCRIPTOR
17400 HRLM FLAG,(P) ;
17500 POP P,FLAG
17600 RESTACS <(PNT,D,LPSA)> ;RESTORE AC'S
17700 JRST COMMN
00100 COPSTR: ;COPY STRING
00200 PUSHJ P,SDESCR ;GET A STRING DESCRIPTOR
00300 POP P,A ;NEW DESCRIPTOR
00400 HLRO TEMP,(PNT) ;STRING TO BE COPIED
00500 POP TEMP,(A) ;SECOND WORD
00600 POP TEMP,-1(A) ;FIRST WORD
00700 HRRZ FLAG,A
00800 TLO FLAG,ISSTR ;MARK AS STRING DESCRIPTOR
00900 JRST COMMN
01000 SCALAR: ;SIMPLE SCALAR
01100 MOVE FLAG,(A) ;VALUE
01200 COMMN:
01300 MOVEM FLAG,1(PNT) ;SAVE VALUE
01400 JRST LPREM
01500
01600
01700 REMREP: PUSH P,[LPREM] ;IN-LINE CALL
01800 REP1:
01900
02000 COMMENT ⊗ REPLACE THE OLD SAVED VALUE WITH THE CURRENT VALUE.
02100 C - ADDR CONTEXT NODE
02200 CALLED WITH PUSHJ ⊗
02300 ;HERE MAY HAVE TO INSERT SPECIAL STUFF FOR HANDLING FIRST ELEM OF ARRAY
02400 MOVE PNT,(C) ;FIND OUT IF DESCRIPTOR
02500 HLRZ A,(C) ;ADDRESS OF SAVED VAR.
02600 TRNE PNT,DESC ;A DESCRIPTOR?
02700 JRST ISDESC ;YES.
02800 MOVE FLAG,(A) ;VALUE
02900 MOVEM FLAG,1(C) ;SAVE IT.
03000 POPJ P, ;RETURN
03100 ISDESC:
03200 MOVE PNT,1(C) ;GET DESCRIPTOR
03300 TLNE PNT,ISARR ;AN ARRAY?
03400 JRST REPARR ;YES.
03500 TLNE PNT,ISSTR ;SCALAR STRING?
03600 JRST REPSTR ;YES.
03700 TLNN PNT,ISSET ;HAD BETTER BE SET.
03800 ERR <DRYROT - REMEMBER 1>
03900 TRNN PNT,-1 ;SEE IF NULL SET
04000 JRST SETREL ;YES, DON'T TRY TO RELEASE
04100 MOVE FP,FP1(TABL) ;PREPARE TO RELEASE SET
04200 HLRZ PNT,(PNT) ;ADDR END OF SET
04300 HRRM FP,(PNT) ;LINK SET ONTO FREE-LIST
04400 MOVE PNT,1(C) ;GET SET HEAD
04500 HRRM PNT,FP1(TABL) ;SAVE FREE-LIST
04600 SETREL:
04700 SAVACS <(LPSA,D,C)> ;SAVE IMPORTANT AC'S
04800 PUSH P,(A) ;SET TO BE COPIED
04900 PUSH P,[0] ;NULL SET
05000 GLOB<
05100 TLZ FLAG,GLBSRC ;TURN OFF GLBSRC BIT
05200 >;GLOB
05300 PUSHJ P,CATLST ;LET CATLST COPY SET
05400 POP P,TEMP
05500 RESTACS <(C,D,LPSA)> ;RESTORE AC'S
05600 HLRE FLAG,TEMP ;LENGTH OF SET
05700 MOVMS FLAG ;MAKE POSITIVE
05800 TRO FLAG,ISSET ;IS A SET DESCRIPTOR
05900 HRLM FLAG,TEMP
06000 MOVEM TEMP,1(C) ;SAVED SET
06100 REPCOM:
06200 POPJ P, ;RETURN TO WHOEVER.
06300
06400 REPSTR:
06500 HRROI TEMP,(A) ;ADDR OF NEW STRING
06600 POP TEMP,(PNT) ;SECOND WORD
06700 POP TEMP,-1(PNT) ;FIRST WORD
06800 POPJ P,
06900
07000 REPARR: ;REPLACE AN ARRAY
07100 TLNN PNT,ISSET ;A SET ARRAY?
07200 JRST REPESY ;NO, JUST AS EASY TYPE
07300 PUSH P,PNT ;ADDRESS OF SAVED ARRAY
07400 PUSHJ P,ARRRCL ;RECLAIM LIST SPACE
07500 REPESY: ;BLT IN NEW CONTENTS
07600 TLNE PNT,ISSTR ;A STRING ARRAY
07700 JRST [SUBI PNT,1 ;STRING ARRAY
07800 SUBI A,1 ;ALSO NEW ARRAY
07900 JRST .+1]
08000 HRRZ FLAG,-1(PNT) ;SIZE OF ARRAY
08100 ADDI FLAG,-1(PNT) ;LAST WORD TO BE SAVED
08200 HRLI A,(PNT) ;ADDR FIRST WORD IN COPY OF ARRAY
08300 MOVSS A ;PREPARE FOR BLT
08400 BLT A,(FLAG) ;BLT ARRAY
08500 TLNN PNT,ISSET ;SET ARRAY?
08600 POPJ P, ;NO,RETURN.
08700 SAVACS <(C,D,LPSA)>
08800 PUSHJ P,COPARR ;COPY THE ELEMENTS ADDR ARRAY IN A
08900 RESTACS <(LPSA,D,C)>
09000 POPJ P, ;RETURN
09100 RETALL: PUSH P,LPSA ;THE RETURN ADDRESS
09200 JRST STACRS ;RESTORE AC'S
09300
00100 DSCR FORGET ⊗
00200
00300 HERE(FORGET) ;FORGET NAMED VARIABLES
00400 PUSHJ P,STACSV ;SAVE OFF AC'S
00500 MOVE TABL,GOGTAB ;USER TABLE
00600 POP P,LPSA ;RETURN ADDRESS
00700 POP P,D ;CONTEXT ADDRESS
00800 LPFORG: POP P,A ;THE VARIABLE'S ADDRESS
00900 JUMPE A,RETALL ;IF NONE, RETURN
01000 TLNE A,ISARR ;IF ARRAY GET DESCRIPTOR
01100 HRR A,(A)
01200 TLNN A,-1
01300 ERR <DRYROT AT FORGET- NO DESCRIPTOR>,1
01400 SKIPN C,(D) ;HEAD OF CONTEXT LIST
01500 NTTHER: ERR <FORGETTING UNREMBERED VARIABLE>,1,LPFORG
01600 MOVEI B,(D) ;BACK POINTER
01700 LPFOR2:
01800 HLRZ PNT,(C) ;CANDIDATE
01900 CAIN PNT,(A) ;RIGHT ONE?
02000 JRST FNDNOD ;THE SAME.
02100 CAIL PNT,(A) ;FURTHER DOWN LIST?
02200 JRST NTTHER ;NO, SIGNAL ERROR
02300 MOVEI B,(C) ;CDR LIST
02400 HRRZ C,(C)
02500 TRZ C,DESC
02600 JUMPN C,LPFOR2 ;LOOP
02700 JRST NTTHER ;WASN'T IN CONTEXT
02800 FNDNOD: ;FOUND IN CONTEXT TO RELEASE
02900 PUSH P,[LPFORG] ;IN LINE CALL
03000 RELNOD: ;TO GENERALLY RELEASE NODE
03100 ;B CONTAINS BACKPOINTER,C THIS NODES ADDR.
03200 MOVE PNT,(C) ;FIRST UNLINK NODE
03300 DPB PNT,[POINT 17,(B),35]
03400 TRNN PNT,DESC ;HARD CASE?
03500 JRST FORESY ;NO
03600 MOVE PNT,1(C) ;GET DESCRIPTOR
03700 TLNE PNT,ISARR ;ANY KIND OF ARRAY?
03800 JRST FORARR ;YES
03900 TLNE PNT,ISSTR ;A SCALAR STRING?
04000 JRST FORSTR ;YES
04100 TLNN PNT,ISSET ;SHOULD BE THIS TYPE
04200 ERR <DRYROT - FORGET 1>
04300 TRNN PNT,-1 ;NULL SET
04400 JRST FORESY ;YES
04500 HLRZ FLAG,(PNT)
04600 MOVE FP,FP1(TABL) ;OLD FREE-LIST
04700 HRRM FP,(FLAG) ;LINK ONTO RELEASED SET
04800 HRRM PNT,FP1(TABL) ;SET RECLAIMED
04900 JRST FORESY ;NOTHING TO IT.
05000 FORSTR:
05100 SETZM -1(PNT) ;MAKE INTO NULL STRING
05200 HLRZ FLAG,HASHP(TABL) ;STRING DESCRIPTOR LIST
05300 HRRM FLAG,(PNT) ;LINK DESCRIPTOR ONTO FREE LIST
05400 HRLM PNT,HASHP(TABL) ;ALL DONE
05500 JRST FORESY
05600 FORARR: ;AN ARRAY
05700 TLNN PNT,ISSET!ISSTR ;SIMPLE ARRAY?
05800 JRST FARESY ;YUPP!
05900 TLNN PNT,ISSTR ;SET ARRAY
06000 JRST FSTARY ;YES.
06100 SETZM
06200 ;STRING ARRAY MUST BE REMOVED FROM ARYLS LIST
06300 MOVEI TEMP,ARYLS(TABL) ;BACK POINTER
06400 JRST ENDSRY ;JUMP TO TEST
06500 LPSARY: HLRZ FLAG,(FPD) ;CANDIDATE
06600 CAIN FLAG,(PNT) ;GOT IT?
06700 JRST FNDARY ;YES
06800 MOVEI TEMP,(FPD) ;FOR NEXT TIME
06900 ENDSRY: SKIPE FPD,(TEMP) ;GET NEXT CANDIDATE.
07000 JRST LPSARY ;LOOP
07100 ERR <DRYROT FORGET 2>
07200 FNDARY:
07300 HRRZ FLAG,(FPD) ;LINK TO NEXT IN ARYLS
07400 HRRM FLAG,(TEMP) ;DELETE NODE FROM LIST
07500 HRR FP,FP1(TABL) ;PREPARE TO RELEASE FREE
07600 HRRM FP,(FPD)
07700 HRRM FPD,FP1(TABL) ;DONE
07800 JRST FARESY
07900 FSTARY:
08000 PUSH P,(PNT) ;ARRAY ADDRESS
08100 PUSHJ P,ARRRCL ;RECLAIM LIST SPACE
08200 FARESY:
08300 SAVACS <(B,C,D,LPSA)>
08400 PUSH P,PNT ;ARRAY TO BE RELEASED
08500 PUSHJ P,ARYEL ;RELEASE IT
08600 RESTACS <(LPSA,D,C,B)>
08700 MOVE TABL,GOGTAB
08800 FORESY:
08900 MOVE FP,FP2(TABL) ;PREPARE TO RELEASE TWO WORD FREE
09000 MOVEM FP,(C)
09100 HRRM C,FP2(TABL)
09200 POPJ P, ;RETURN TO WHOEVER
00100 DSCR RESTOR RESTORE CONTENTS OF VARIABLES ⊗
00200 HERE(RESTOR) ;ENTRY
00300 PUSHJ P,STACSV
00400 MOVE TABL,GOGTAB ;SET UP USER TABLE REG.
00500 POP P,LPSA ;RETURN ADDR
00600 POP P,D ;CONTEXT ADDR
00700 LPRES:
00800 POP P,A ;ADDR VAR TO BE RESTORED
00900 JUMPE A,RETALL ;RETURN WHEN THROUGH
01000 TLNE A,ISARR
01100 HRR A,(A)
01200 TRNN A,-1
01300 ERR <DRYROT AT RESTOR>
01400 HRRZ C,(D) ;ADDR FIRST NODE IN LIST
01500 LPRES2:
01600 JUMPE C,RESERR ;ERROR IF NIL LIST.
01700 HLRZ PNT,(C) ;REFERENCE
01800 CAIN PNT,(A) ;THE SAME?
01900 JRST RESFND ;YES.
02000 HRRZ FLAG,(C) ;DESC BIT&LINK
02100 TRZN FLAG,DESC ;TURN OFF DESC,IF DESC STILL POSSIBILITY
02200 JRST RESCDR
02300 MOVE B,1(C) ;THE DESCRIPTOR
02400 TLNN B,ISARR ;AN ARRAY?
02500 JRST RESCDR ;NO.
02600 MOVE FP,PNT ;ADDR ARRAY
02700 TLNE B,ISSTR ;STRING ARRAY?
02800 SUBI FP,1 ;SUB 1 FOR STRING ARRAY
02900 HRRZ FP,-1(FP) ;LENGTH OF ARRAY
03000 ADDI FP,(PNT) ;ADDR LAST ELEM IN ARRAY
03100 CAIL FP,(A) ;IS VAR IN THIS ARRAY
03200 CAILE PNT,(A) ;
03300 JRST RESCDR ;NO
03400 HRROI TEMP,(A) ;ADDR OF ELEM TO BE RESTORED
03500 SUBI TEMP,(PNT) ;OFFSET
03600 ADDI TEMP,(B) ;ADDR IN SAVED ARRAY.
03700 TLNN B,ISSET!ISSTR ;HARD TYPE?
03800 JRST RESES1 ;NO.
03900 TLNN B,ISSET ;A SET
04000 JRST ISSTR ;NO A STRING
04100 SAVACS <(LPSA,D,A)> ;SAVE IMPORTANT AC'S
04200 PUSH P,(TEMP) ;SET TO BE COPIED
04300 PUSH P,[0] ;NIL SET
04400 PUSHJ P,CATLST ;LET CAT DO THE WORK
04500 RESTACS <(A,D,LPSA)> ;RESTORE AC'S
04600 HLRE FLAG,(P) ;COUNT
04700 MOVMS FLAG ;MAKE POSITIVE FOR PERM. SET.
04800 HRLM FLAG,(P) ;PUT IT BACK
04900 POP P,(A) ;SAVE THE SET
05000 JRST LPRES ;NEXT ONE
05100 RESCDR:
05200 MOVEI B,(C)
05300 HRRZ C,(C)
05400 TRZ C,DESC
05500 JRST LPRES2
05600 RESERR:
05700 ERR <RESTORE UNREMEMBERED VARIABLE>,1
05800 JRST LPRES2
05900 RE1STR: ;A STRING WITHIN A STRING ARRAY
06000 POP TEMP,(A)
06100 POP TEMP,-1(A)
06200 JRST LPRES
06300 RESES1:
06400 MOVE FLAG,(TEMP)
06500 MOVEM FLAG,(A)
06600 JRST LPRES
00100 RESFND: ;FOUND MATCH
00200 PUSH P,[LPRES] ;IN-LINE CALL
00300 RESNOD: ;RESTORE NODE ADDR IN C.
00400 MOVE TEMP,(C) ;GET ENTIRE FIRST WORD.
00500 HLRZ PNT,TEMP ;PLACE TO BE RESTORED TO.
00600 MOVE FLAG,1(C) ;THE DESCRIPTOR, OR VALUE.
00700 TRNN TEMP,DESC ;A DESCRIPTOR?
00800 JRST RESESY ;NO.
00900 TLZE FLAG,ISARR ;AN ARRAY?
01000 JRST RESAR2 ;YES.
01100 TLZN FLAG,ISSET ;A SET?
01200 JRST RESSTR ;NO, A STRING.
01300 SKIPN TEMP,(PNT) ;IS SET TO BE REPLACED NULL
01400 JRST RESST2 ;YES
01500 HLRZ B,(PNT) ;LAST NODE IN SET
01600 MOVE FP,FP1(TABL) ;END OF FREE-LIST
01700 HRRM FP,(B) ;CAT ONTO RELEASED SET
01800 HRRM PNT,FP1(TABL) ;SAVE NEW FREE-LIST
01900 RESST2:
02000 SAVACS <(LPSA,D,C)>
02100 PUSH P,FLAG
02200 PUSH P,[0]
02300 GLOB <
02400 MOVEI FLAG,0 ;MAKE SURE GLB BIT OFF
02500 >;GLOB
02600 PUSHJ P,CATLST ;LET CAT DO THE WORK
02700 HLRE FLAG,(P) ;RESULTANT SET
02800 MOVMS FLAG ;MAKE INTO PERM SET.
02900 HRLM FLAG,(P)
03000 POP P,FLAG ;GET THE SET BACK
03100 RESTACS <(C,D,LPSA)>
03200 HLRZ PNT,(C)
03300 MOVEM FLAG,(PNT) ;SAVE THE NEW SET.
03400 POPJ P, ;RETURN
03500 RESSTR: ;RESTORE A SCALAR STRING
03600 HRROI FLAG,(FLAG) ;PREPARE FOR POP'S
03700 POP FLAG,(PNT) ;SECOND WORD
03800 POP FLAG,-1(PNT) ;FIRST WORD
03900 POPJ P, ;RETURN
04000 RESESY: ;SIMPLE SCALAR
04100 MOVEM FLAG,(PNT) ;RESTORE VALUE
04200 POPJ P, ;RETURN
00100
00200 RESAR2: ;RESTORE ENTIRE ARRAY
00300 TLNN FLAG,ISSET ;A SET ARRAY?
00400 JRST RESAR3 ;NO
00500 PUSH P,PNT ;PREPARE TO RECLAIM LIST SPACE
00600 PUSHJ P,ARRRCL ;RECLAIM IT
00700 RESAR3:
00800 TLNN FLAG,ISSTR ;A STRING ARRAY
00900 JRST RESAR4 ;NO.
01000 SUBI PNT,1
01100 SUBI FLAG,1
01200 RESAR4: ;GET READY TO BLT
01300 HRRZ B,-1(PNT) ;NUMBER OF WORDS
01400 ADDI B,-1(PNT) ;ADDR LAST WORD
01500 HRLI PNT,(FLAG) ;BLT WORD
01600 BLT PNT,(B) ;DO BLT
01700 TLNN FLAG,ISSET ;SET ARRAY?
01800 POPJ P, ;NO.
01900 SAVACS <(LPSA,D,C)>
02000 MOVEI A,(PNT) ;ADDR ARRAY TO BE COPIED
02100 PUSHJ P,COPARR ;COPY LISTS WITHIN ARRAY
02200 RESTACS <(C,D,LPSA)> ;RESTORE AC'S
02300 POPJ P,
02400
00100 DSCR ALLRM,ALLFOR,ALLRS.
00200 REMEMBER ALL IN CONTEXT;
00300 FORGET ALL IN CONTEXT;
00400 RESTORE ALL IN CONTEXT;
00500
00600 CONTEXT ADDR IN -1(P) ⊗
00700
00800 HERE(ALLRM) ;REMEMBER ALL
00900 PUSHJ P,STACSV
01000 MOVE TABL,GOGTAB ;USER TABLE
01100 HRRZ C,@-1(P) ;FIRST IN CONTEXT LIST
01200 LPALLR:
01300 JUMPE C,ENDALL ;PROCESSED EVERYTHING IN CONTEXT?
01400 PUSHJ P,REP1 ;ALTER THIS NODE.
01500 HRRZ C,(C) ;CDR CONTEXT LIST.
01600 TRZ C,DESC ;TURN OFF DESC BIT
01700 JRST LPALLR ;LOOP
01800 ENDALL:
01900 PUSHJ P,STACRS
02000 SUB P,X22 ;PREPARE TO RETURN
02100 JRST @2(P) ;RETURN
02200
02300
02400
02500 HERE(ALLFOR) ;FORGET ALL
02600 PUSHJ P,STACSV
02700 MOVE TABL,GOGTAB ;USER TABLE
02800 MOVEI B,@-1(P) ;ADDR CONTEXT LIST HEAD
02900 LPALLF:
03000 SKIPN C,(B) ;NEXT NODE IN CONTEXT LIST
03100 JRST ENDALL ;NONE LEFT.
03200 PUSHJ P,RELNOD ;RELEASE THIS NODE
03300 JRST LPALLF ;LOOP
03400
03500
03600 HERE(ALLRS) ;RESTORE ALL
03700 PUSHJ P,STACSV
03800 MOVE TABL,GOGTAB
03900 MOVE C,@-1(P) ;FIRST NODE IN CONTEXT LIST
04000 LPRESA:
04100 JUMPE C,ENDALL ;NONE LEFT?
04200 PUSHJ P,RESNOD ;RESTORE THIS NOD
04300 HRRZ C,(C) ;CDR CONTEXT LST
04400 TRZ C,DESC
04500 JRST LPRESA
04600
00100 DSCR GFREES ⊗
00200 GLOB <
00300 GFREES: ;ATTEMPT TO USE WASTED SPACE IN INFOTAB,DATAB
00400 PUSHJ P,FSAV ;SAVE AC'S (PROBABLY NOT NECESSARY)
00500 MOVE B,ITMTOP(USER) ;MAX LOCAL ITEM NUMBER
00600 MOVEI C,GBRK ;BEGINNING OF GLOBALS
00700 CAIL B,-20(C) ;WON'T EVEN TRY IF LESS THAN 20 SPACES
00800 JRST FREST ;RESTORE AC'S AND RETURN
00900 SUBI C,2(B) ;COUNT OF FREE SPACES
01000 PUSH P,C ;SAVE FOR LATER
01100 ADD B,INFOTAB(USER) ;
01200 ADDI B,1 ;ONE MORE
01300 HRRM B,FP1(USER) ;BEGINNING OF LIST OF AVAILABLE SPACE
01400 ADDI B,1 ;GET READY TO LINK UP.
01500 HRRZM B,-1(B) ;LINK UP.
01600 SOJG C,.-2 ;LOOP UNTIL DONE
01700 SETZM (B) ;LAST LINK IS NIL.
01800 HRLM B,FP1(USER) ;ADDRESS LAST FREE CELL
01900 POP P,C ;NUMBER OF FREE CELLS
02000 LSH C,-1 ;DIVIDE BY 2
02100 MOVE B,DATAB(USER)
02200 ADD B,ITMTOP(USER) ;ADDRESS FIRST AVAIL TWO-WORD FREE -1.
02300 ADDI B,1 ;ADDRESS FIRST TWO-WORD FREE
02400 HRRZM B,FP2(USER) ;BEGINNING OF LIST OF AVAIL. SPACE
02500 ADDI B,2 ;LINKING THEM UP.
02600 HRRZM B,-2(B) ;LINK.
02700 SOJG C,.-2 ;LOOP UNTIL DONE
02800 SETZM (B) ;LAST LINK IS NIL
02900 PUSHJ P,FREST ;RESTORE AC'S
03000 HRROS UUO1(USER) ;DON'T NEED MORE FREES
03100 POPJ P,
03200 >;GLOB
03300
03400
03500 ;GET BOTH KINDS OF FREE STORAGE.
03600 FPEES: PUSHJ P,FP2DON ;GO GET FREE STORAGE.
03700
03800 DSCR FP1DON FP2DON
03900 THESE ARE THE ROUTINES FOR GETTING MORE FREE STORAGE FROM
04000 THE MAIN CORE ALLOCATORS. FP1DON GETS 1 WORD FREES, FP2DON
04100 GETS 2 WORD FREES. THEY ARE GENERALLY CALLED UNDER A SKIPN FP,(FP)
04200 AND RETURN FP POINTING TO THE HEAD OF THE NEW FREE STORAGE LIST.
04300
04400 FP1DON DOES A SPECIAL THING -- THE LAST ELEMENT OF THE OLD FREE
04500 STORAGE LIST IS LINKED TO THE FIRST ELEMENT OF THE NEW ONE -- THIS
04600 IS SO THAT SETS (I.E. LINKED LISTS) CAN BE MADE IN ONE PIECE,
04700 WITHOUT WORRYING ABOUT LINKING THE INDIVIDUAL CELLS TOGETHER.
04800
04900 ACS SAVED -- ALL
05000 AC RESULT -- FP HAS NEW POINTER.
05100 ⊗;
05200 HERE(FP1DON)
05300 PUSHJ P,FSAV
05400 LPCOR (FREELEN,) ;GET THE CORE
05500 HRRM B,FP1(TABL)
05600 HRRZM B,SGACS+FP(USER)
05700 HLRZ C,FP1(TABL) ;THIS WAS THE LAST WORD BEFORE.
05800 SKIPE C ;NONE THERE
05900 HRRM B,(C) ;LINK IT DOWN....
06000 MOVNI A,FREELEN-1
06100 ADDI B,1
06200 HRRZM B,-1(B) ;LINK UP THE LIST
06300 AOJL A,.-2
06400 SETZM (B)
06500 HRLM B,FP1(TABL) ;SAVE ADDR OF LAST FREE FOR LINKING
06600 JRST FREST ;AND DONE.
06700
06800 HERE(FP2DON)
06900 PUSHJ P,FSAV
07000 LPCOR (FREELEN,FP2)
07100 HRRZM B,SGACS+FP(USER)
07200 MOVNI A,FREELEN/2-1
07300 ADDI B,2
07400 HRRZM B,-2(B)
07500 AOJL A,.-2 ;LINK UP.
07600 SETZM (B)
07700 ; JRST FREST
07800 FREST: MOVSI 14,SGACS(USER)
07900 BLT 14,14
08000 POPJ P,
08100
08200 FSAV: MOVEM 14,SGACS+14(USER)
08300 MOVEI 14,SGACS(USER)
08400 BLT 14,SGACS+13(USER)
08500 POPJ P,
08600
08700
08800 DSCR SDESCR - GET A TWO WORD STRING DESCRIPTOR
08900 A LIST OF TWO WORD STRING DESCRIPTORS (COLLECTABLE BY
09000 GARBAGE COLLECTOR) IS HEADED IN LEFT-HALF HASHP(USER).
09100 THIS ROUTINE WILL RETURN CAR OF THIS LIST ON TOP OF
09200 STACK AND IF LIST IS NULL WILL ALLOCATE A NEW
09300 STRING ARRAY, LINK THAT ARRAY INTO THE LIST OF STRING
09400 ARRAYS (ARYLS(USER)) AND LINK TOGETHER THE INDIVIDUAL
09500 ARRAY ELEMENTS TO FORM A NEW LIST OF STRING DESCRIPTORS.
09600
09700 ALL AC'S ARE RESTORED TO THEIR PREVIOUS VALUES BEFORE
09800 EXIT FROM THE ROUTINE. ⊗
09900
10000 HERE(SDESCR) ;ENTRY-POINT
10100 ADD P,[XWD 15,15] ;WILL SAVE AC'S ON STACK
10200 SKIPL P ;STACK OVERFLOW?
10300 PDLOF ;YES.
10400 PUSH P,USER ;SAVE USER ALSO.
10500 HRRI USER,-15(P) ;ADDR. WHERE 0 TO BE SAVED
10600 BLT USER,-1(P) ;SAVE AC'S 0 TO 14
10700 MOVE USER,GOGTAB ;USER TABLE
10800 HLRZ A,HASHP(USER) ;ANY FREE DESCRIPTORS.
10900 JUMPN A,UNLINK ;IF YES, TAKE CAR.
11000 SKIPE HASHP(USER) ;PNAMES ALSO
11100 JRST NOINIT ;ALREADY INITED.
11200 MOVEI C,0 ;COUNT OF PNAMES REQUIRED
11300 MOVE A,SPLNK(USER) ;SPACE ALLOCATION BLOCK LIST
11400 PNMCNT: JUMPE A,HAVCNT ;THROUGH WITH ALLOCATION BLOCKS
11500 CAMGE C,$PNMNO(A) ;MORE THAN THIS PROG REQUIRES?
11600 MOVE C,$PNMNO(A) ;NO.
11700 HRRZ A,(A) ;CDR ALLOCATION LIST
11800 JRST PNMCNT ;LOOP
11900 HAVCNT: CAIG C,50 ;AT LEAST 50?
12000 NOINIT: MOVEI C,50 ;STANDARD SIZE IS 50
12100 PUSH P,[0] ;MAKE THE STRING ARRAY
12200 PUSH P,C ;UPPER BOUND
12300 PUSH P,[XWD -1,1] ;INDICATE STRING ARRAY
12400 MOVE C,UUO1(USER) ;SINCE ARMAK WILL DESTROY
12500 PUSHJ P,ARMAK ;MAKE THE ARRAY
12600 MOVE USER,GOGTAB
12700 MOVEM C,UUO1(USER) ;RESTORE UUO1
12800 SKIPN FP,FP1(USER) ;ONE-WORD FREE'S INITED?
12900 PUSHJ P,FP1DON ;NO.
13000 MOVEI B,(FP) ;ADDR. ONE-WORD FREE
13100 SKIPN FP,(FP) ;FOR NEXT TIME
13200 PUSHJ P,FP1DON ;IF OUT, GET MORE.
13300 HRRM FP,FP1(USER) ;SAVE FREE-LIST
13400 HRLI D,(A) ;ADDRESS NEW STRING ARRAY
13500 HRR D,ARYLS(USER) ;LINK IN OLD ARRAY LIST
13600 MOVEM D,(B) ;INTO ONE-WORD FREE
13700 HRRM B,ARYLS(USER) ;NEW STRING ARRAY LIST.
13800 MOVN C,-4(A) ;LENGTH OF ARRAY
13900 HRL A,A ;
14000 ADDI A,2
14100 INT2: HLRM A,(A) ;LINK THEM UP
14200 ADD A,X22
14300 AOJL C,INT2 ;LOOP.
14400 HLR A,A ;FREE STRING DESCRIPTOR LIST
14500 UNLINK: ;HEAD OF DESCRIPTOR LIST IN A
14600 HRRZ B,(A) ;CDR DESCRIPTOR LIST
14700 HRLM B,HASHP(USER) ;SAVE CDR
14800 SETZM -1(A) ;MAKE INTO NIL STRING
14900 EXCH A,-16(P) ;EXCHANGE WITH RETURN ADDR
15000 PUSH P,A ;SAVE RETURN ADDR.
15100 HRLZI USER,-16(P) ;ADDR WHERE AC 0 SAVED
15200 BLT USER,USER ;RESTORE AC'S
15300 SUB P,[XWD 17,17] ;RESTORE STACK
15400 JRST @17(P) ;RETURN
00100
00200 BEND LEAP
00300 XLIST ;EXPURGATE SYMBOLS
00400
00500
00600 IFN SEGS,<LIT
00700 VAR
00800 DEPHASE
00900 END UPWRT>
01000 END