1 TITLE AGC MUDDLE GARBAGE COLLECTOR
3 ;SYSTEM WIDE DEFINITIONS GO HERE
9 .GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG
10 .GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT
11 .GLOBAL PGROW,TPGROW,MAINPR,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR
12 .GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC
13 .GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC
14 .GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM,GCOFFS
15 .GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,MRKPDL
16 .GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI
17 .GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2
18 .GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN
19 .GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT
20 ; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR
22 .GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB
23 .GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR
25 .GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10
26 .GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK
27 .GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG,%PURMD
28 .GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET
30 .GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK
31 .GLOBAL BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,LOCMK,OFFSMK,INBLOT,MARK2A
33 NOPAGS==1 ; NUMBER OF WINDOWS
36 NTPMAX==20000 ; NORMAL MAX TP SIZE
37 NTPGOO==4000 ; NORMAL GOOD TP
38 ETPMAX==2000 ; TPMAX IN AN EMERGENCY (I.E. GC RECALL)
39 ETPGOO==2000 ; GOOD TP IN EMERGENCY
41 .ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC)
43 GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR
44 STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT
45 STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT
61 TYPNT=AB ;SPECIAL AC USAGE DURING GC
62 F=TP ;ALSO SPECIAL DURING GC
63 LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN
64 FPTR=TB ; POINT TO CURRENT FRONTIER OF INFERIOR
67 ; WINDOW AND FRONTIER PAGES
69 MAPCH==0 ; MAPPING CHANNEL
71 FPAG==2000 ; START OF PAGES FOR GC-READ AND GCDUMP
72 CONADJ==5 ; ADJUSTMENT OF DUMPERS CONSTANT TABLE
75 ; INTERNAL GCDUMP ROUTINE
76 .GLOBAL GODUMP,EGCDUM,EPURIF,ERRKIL,IPURIF
78 GODUMP: MOVE PVP,PVSTOR+1
79 MOVEM P,PSTO+1(PVP) ; SAVE P
82 PUSHJ P,INFSU1 ; SET UP INFERIORS
85 SETZM PURMNG ; INITIALIZE FLAG INDICATING IF PURIFIED PAGES
87 MOVEI 0,HIBOT ; SET UP NEW PURBOT TO CONVINCE THE GARBAGE COLLECTOR
88 ; TO COLLECT PURIFIED STRUCTURES
90 MOVEM 0,RPURBT ; SAVE THE OLD PURBOT
93 MOVEM 0,RGCSTP ; SAVE THE OLD GCSTOP
94 POP P,C ; SET UP PTR TO TYPE/VALUE PAIR
95 MOVE P,A ; GET NEW PDL PTR
96 SETOM DUMFLG ; FLAG INDICATING IN DUMPER
99 ADD FPTR,[7,,7] ; ADJUST FOR FIRST STATUS WORDS
101 MOVEI E,FPAG+6 ; SEND OUT PAIR
107 MOVE C,(C) ; SEND OUT UPDATED PTR
110 MOVEI 0,@BOTNEW ; CALCULATE START OF TYPE-TABLE
112 MOVE 0,RPURBT ; RESTORE PURBOT
114 MOVE 0,RGCSTP ; RESTORE GCSTOP
118 ; ROUTINE TO SCAN THE TYPE-VECTOR FOR MARKED TYPE SLOTS AND BUILD A TYPE-TABLE OUT OF
121 MOVE A,TYPSAV ; GET AOBJN POINTER TO TYPE-VECTOR
122 MOVEI B,0 ; INITIALIZE TYPE COUNT
123 TYPLP2: HLRE C,(A) ; GET MARKING
124 JUMPGE C,TYPLP1 ; IF NOT MARKED DON'T OUTPUT
125 MOVE C,(A) ; GET FIRST WORD
126 HRL C,B ; FIX UP SO TYPE-NUMBER REPLACES TYPE-CELL
132 PUSHJ P,MOVFNT ; EXTEND THE FRONTIER
134 MOVE C,1(A) ; OUTPUT SECOND WORD
137 TYPLP1: ADDI B,1 ; INCREMENT TYPE COUNT
138 ADD A,[2,,2] ; POINT TO NEXT SLOT
139 JUMPL A,TYPLP2 ; LOOP
141 ; ROUTINE TO BUILD UP ATOM TABLE USING LPVP CHAIN
144 MOVEI 0,@BOTNEW ; GET CURRENT BEGINNING OF TRANSFER
145 MOVEM 0,ABOTN ; SAVE IT
146 PUSHJ P,ALLOGC ; ALLOCATE ROOM FOR ATOMS
147 MOVSI D,400000 ; SET UP UNMARK BIT
148 SPOUT: JUMPE LPVP,DPGC4 ; END OF CHAIN
149 MOVEI F,(LPVP) ; GET COPY OF LPVP
150 HRRZ LPVP,-1(LPVP) ; LPVP POINTS TO NEXT ON CHAIN
151 ANDCAM D,(F) ; UNMARK IT
152 HLRZ C,(F) ; GET LENGTH
153 HRRZ E,(F) ; POINTER INTO INF
155 SUBI C,2 ; WE'RE NOT SENDING OUT THE VALUE PAIR
156 HRLM C,(F) ; ADJUSTED LENGTH
157 MOVE 0,C ; COPY C FOR TRBLKX
158 SUBI E,(C) ; ADJUST PTRS FOR SENDOUT
\r
160 PUSHJ P,TRBLKX ; OUT IT GOES
164 ; HERE TO SEND OUT DELIMITER INFORMATION
165 DPGC4: SKIPN INCORF ; SKIP IF TRANSFREING TO UVECTOR IN CORE
167 SKIPL FPTR ; SEE IF ROOM IN FRONTEIR
168 PUSHJ P,MOVFNT ; EXTEND FRONTEIR
173 MOVEI A,@BOTNEW ; LENGTH
180 MOVE C,ABOTN ; START OF ATOMS
181 SUBI C,FPAG+CONADJ ; ADJUSTMENT FOR STARTING ON PAGE ONE
182 PUSHJ P,ADWD ; OUT IT GOES
186 SKIPE INCORF ; SKIP IF TO CHANNEL
187 SUBI C,2 ; SUBTRACT FOR DOPE WORDS
190 ADDI C,2 ; RESTORE C TO REAL ABOTN
195 MOVEI E,FPAG+2 ; SEND OUT START OF TYPE TABLE
197 ADDI E,1 ; SEND OUT NUMPRI
200 ADDI E,1 ; SEND OUT NUMSAT
206 ; FINAL CLOSING OF INFERIORS
211 POP P,A ; LENGTH OF CODE
215 IRP AC,,[P,TP,TB,AB,FRM]
216 MOVE AC,AC!STO+1(PVP)
221 SETZM GCDFLG ; ZERO FLAG INDICATING IN DUMPER
222 SETZM GCFLG ; AND INDICTOR TO INTERRUPT HANDLER THAT AGC IS ON
224 MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT
235 SETZM GPURFL ; PURE FLAG
242 IRP AC,,[P,R,M,TP,TB,AB,FRM]
243 MOVE AC,AC!STO+1(PVP)
246 ERDUMP: PUSH TP,$TATOM
250 PUSH TP,EQUOTE STRUCTURE-CONTAINS-UNDUMPABLE-TYPE
254 PUSH TP,$TATOM ; PUSH ON PRIMTYPE
255 PUSH TP,@STBL(A) ; PUSH ON PRIMTYPE
259 ; ALTERNATE ATOM MARKER FOR DUMPER
261 DATOMK: SKIPE GPURFL ; SKIP IF NOT IN PURIFIER
263 CAILE A,0 ; SEE IF ALREADY MARKED
265 PUSH P,A ; SAVE PTR TO ATOM
266 HLRE B,A ; POINT TO DOPE WORD
267 SUB A,B ; TO FIRST DOPE WORD
268 MOVEI A,1(A) ; TO SECOND
269 PUSH P,A ; SAVE PTR TO DOPE WORD
270 HLRZ B,(A) ; GET LENGTH AND MARKING
271 TRZE B,400000 ; TURN OFF BIT AND SKIP IF UNMARKED
274 MOVE 0,ABOTN ; GET CURRENT TOP OF ATOM TABLE
275 ADDI 0,-2(B) ; PLACE OF DOPE WORD IN TABLE
276 HRRM 0,(A) ; PUT IN RELOCATION
277 MOVEM 0,ABOTN ; FIXUP TOP OF TABLE
278 HRRM LPVP,-1(A) ; FIXUP CHAIN
280 MOVE A,-1(P) ; GET POINTER TO ATOM BACK
281 HRRZ B,2(A) ; GET OBLIST POINTER
282 JUMPE B,NOOB ; IF ZERO ON NO OBLIST
283 CAMG B,VECBOT ; DON'T SKIP IF OFFSET FROM TVP
286 DATMK3: MOVE A,$TOBLS ; SET UP FOR GET
290 MOVE D,IMQUOTE OBLIST
294 PUSH P,TP ; SAVE FPTR
296 MOVE TP,TPSTO+1(TP) ; GET TP
298 POP P,TP ; RESTORE FPTR
299 MOVE C,-1(P) ; RECOVER PTR TO ATOM
300 ADDI C,1 ; SET UP TO MARK OBLIST ATOM
301 MOVSI D,400000 ; RESTORE MARK WORD
312 PUSHJ P,MARK1 ; MARK IT
313 MOVEM A,1(C) ; SMASH IN ITS ID
315 NOOB: POP P,A ; GET PTR TO DOPE WORD BACK
316 HRRZ A,(A) ; RETURN ID
317 SUB P,[1,,1] ; CLEAN OFF STACK
321 ; HERE FOR A ROOT ATOM
322 RTSET: SETOM 1(C) ; INDICATOR OF ROOT ATOM
326 ; INTERNAL PURIFY ROUTINE
329 IPURIF: PUSHJ P,PURCLN ; GET RID OF PURE MAPPED
331 IRP AC,,[P,R,M,TP,TB,AB,FRM]
332 MOVEM AC,AC!STO"+1(PVP)
336 ; HERE TO CREATE INFERIORS AND MARK THE ITEM
337 PURIT1: MOVE PVP,PVSTOR+1
338 MOVEM P,PSTO+1(PVP) ; SAVE P
339 SETOM GPURFL ; INDICATE PURIFICATION IS TAKING PLACE
341 MOVEM C,SAVRS1 ; SAV PTR TO PAIR
343 PUSHJ P,INFSUP ; GET INFERIORS
344 MOVE P,A ; GET NEW PDL PTR
345 PUSHJ P,%SAVRP ; SAVE RPMAP TABLE FOR TENEX
346 MOVE C,SAVRS1 ; SET UP FOR MARKING
347 MOVE A,(C) ; GET TYPE WORD
351 PURIT4: POP P,C ; RESTORE C
352 ADD C,[2,,2] ; TO NEXT ARG
354 MOVEM A,SAVRES ; SAVE UPDATED POINTER
356 ; FIX UP IMPURE PART OF ATOM CHAIN
358 PUSH P,[0] ; FLAG INDICATING NON PURE SCAN
360 SUB P,[1,,1] ; CLEAN OFF STACK
362 ; NOW TO GET PURE STORAGE
364 PURIT2: MOVEI A,@BOTNEW ; GET BOTNEW
365 SUBI A,2000-1777 ; START AT PAGE 1 AND ROUND
367 ASH A,-10. ; TO PAGES
370 PUSHJ P,PGFIND ; FIND THEM
371 JUMPL B,LOSLP2 ; LOST GO TO CAUSE AGC
372 HRRZ 0,BUFGC ;GET BUFFER PAGE
374 MOVEI A,(B) ; GET LOWER PORTION OF PAGES
376 SUBM A,C ; GET END PAGE
377 CAIL 0,(A) ; L? LOWER
378 CAILE 0,(C) ; G? HIGER
379 JRST NOREMP ; DON'T GET NEW BUFFER
380 PUSHJ P,%FDBUF ; GET A NEW BUFFER PAGE
381 NOREMP: MOVN A,(P) ; SET UP AOBJN PTR FOR MAPIN
386 MOVEM B,INF3 ; SAVE PTR FOR PURIFICATION
387 PUSHJ P,%MPIN1 ; MAP IT INTO PURE
390 SUB P,[1,,1] ; CLEAN OFF STACK
395 MOVE P,PSTO+1(PVP) ; GET REAL P
400 IRP AC,,[M,TP,TB,R,FRM]
401 MOVE AC,AC!STO+1(PVP)
405 ; NOW FIX UP POINTERS IN PURE STRUCTURE
408 PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP
410 MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK
413 SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE
415 MOVE A,[PUSHJ P,NPRFIX]
416 MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS
421 ; NOW FIX UP POINTERS TO PURIFIED STRUCTURE
423 MOVE A,[PUSHJ P,PURFIX]
424 MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS
431 POP P,LPVP ; GET BACK LPVP
433 PUSHJ P,%KILJB ; KILL IMAGE SAVING INFERIOR
434 PUSH P,[-1] ; INDICATION OF PURE ATOM SCAN
437 ; SET UP PMAP SO THAT NEW PURE PAGES ARE INDICATED
439 MOVE A,INF3 ; GET AOBJN PTR TO PAGES
440 FIXPMP: HRRZ B,A ; GET A PAGE
441 IDIVI B,16. ; DIVIDE SO AS TO PT TO PMAP WORD
442 PUSHJ P,PINIT ; SET UP PARAMETER
444 TDO E,D ; FIX UP WORD
445 MOVEM E,PMAPB(B) ; SEND IT BACK
449 MOVE A,[PUSHJ P,PURTFX] ; FIX UP PURE ATOM POINTERS
450 MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS
453 ; NOW FIX UP POINTERS IN PURE STRUCTURE
454 PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP
456 MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK
459 SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE
461 MOVE A,[PUSHJ P,PURTFX]
462 MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS
467 ; HERE TO FIX UP ATOMS WITH TYPES HACKED INTO THEIR GROWTH FIELD
469 MOVE A,TYPVEC+1 ; GET TYPE VECTOR
470 MOVEI B,400000 ; TLOSE==0
471 TTFIX: HRRZ D,1(A) ; GET ADDR
474 HRRM B,(D) ; SMASH IT IN
475 NOTFIX: ADDI B,1 ; NEXT TYPE
479 ; NOW CLOSE UP INFERIORS AND RETURN
481 PURCLS: MOVE P,[-2000,,MRKPDL]
482 PUSHJ P,%RSTRP ;RESETORE RPMAP TABLE FOR TENEX
486 MOVE P,PSTO+1(PVP) ; RESTORE P
487 MOVE AB,ABSTO+1(PVP) ; RESTORE R
489 MOVE A,INF3 ; GET PTR TO PURIFIED STRUCTURE
491 PUSHJ P,%PURIF ; PURIFY
492 IFE ITS, PUSHJ P,%PURMD
495 JRST EPURIF ; FINISH UP
501 PUSHJ P,SAT ; GET STORAGE ALLOCATION TYPE
502 MOVE C,MAPUP ; FIXUP AMOUNT
503 SUBI C,FPAG ; ADJUST FOR START ON FIRST PAGE
504 CAIE A,SLOCR ; DONT HACK TLOCRS
505 CAIN A,S1WORD ; SKIP IF NOT OF PRIMTYPE WORD
512 JRST OFFFXP ; FIXUP OFFSETS
514 JUMPE D,LSTFXP ; SKIP IF NIL
515 CAMG D,PURTOP ; SEE IF ALREADY PURE
517 LSTFXP: TLNN B,.LIST. ; SKIP IF NOT A PAIR
519 HRRZ D,(B) ; GET REST OF LIST
520 SKIPE D ; SKIP IF POINTS TO NIL
523 CAMG D,PURTOP ; SKIP IF ALREADY PURE
524 ADDM C,(B) ; FIX UP LIST
526 POP P,B ; RESTORE GCHACK AC'S
530 OFFFXP: HLRZ 0,D ; POINT TO LIST
531 JUMPE 0,LSTFXP ; POINTS TO NIL
532 CAML 0,PURTOP ; ALREADY PURE?
534 ADD 0,C ; UPDATE THE POINTER
535 HRLM 0,1(B) ; STUFF IT OUT
538 STRFXP: TLZN D,STATM ; SKIP IF REALLY ATOM
542 MOVE C,B ; GET ARG FOR BYTDOP
548 ATMFXP: HLRE 0,D ; GET LENGTH
549 SUB D,0 ; POINT TO FIRST DOPE WORD
551 ATMFXQ: CAML D,OGCSTP
552 CAIL D,HIBOT ; SKIP IF IMPURE
554 HRRZ 0,1(D) ; GET RELOCATION
556 ADDM 0,1(B) ; FIX UP PTR IN STRUCTURE
559 ; FIXUP OF PURE ATOM POINTERS
561 PURTFX: CAIE C,TATOM ; SKIP IF ATOM POINTER
563 HLRE E,D ; GET TO DOPE WORD
565 PURSF1: SKIPL 1(E) ; SKIP IF MARKED
567 HRRZ 0,1(E) ; RELATAVIZE PTR
569 ADD D,0 ; FIX UP PASSED POINTER
570 SKIPE B ; AND IF APPROPRIATE MUNG POINTER
571 ADDM 0,1(B) ; FIX UP POINTER
574 PURSFX: CAIE C,TCHSTR
576 MOVE C,B ; GET ARG FOR BYTDOP
580 MOVE A,[PUSHJ P,PURTFX]
588 PUSH P,C ; SAVE AC'S FOR GCHACK
589 EXCH A,C ; GET TYPE IN A
590 CAIN A,TATOM ; CHECK FOR ATOM
594 CAILE A,NUMSAT ; SKIP IF TEMPLATE
596 IFN ITS, JRST @PURDSP(A)
606 DISTBS DUM1,TLFX,[[S2WORD,LPLSTF],[S2DEFR,LPLSTF],[SNWORD,VECFX],
607 [S2NWORD,VECFX],[SSTORE,VECFX],[SBYTE,STRFX],[SATOM,ATPFX],[SLOCB,STRFX]
608 [SCHSTR,STRFX],[SLOCL,LPLSTF],[SLOCV,VECFX],[SLOCU,VECFX],[SLOCS,VECFX],[SOFFS,OFFSFX]]
612 VECFX: HLRE 0,D ; GET LENGTH
613 SUB D,0 ; POINT TO D.W.
614 SKIPL 1(D) ; SKIP IF MARKED
617 SUBI C,1(D) ; CALCULATE RELOCATION
618 ADD C,MAPUP ; ADJUSTMENT
621 TLFX: TLNN B,.LIST. ; SEE IF PAIR
622 JRST LVPUR ; LEAVE IF NOT
626 SKIPN D ; SKIP IF NOT ZERO
628 MOVE D,(D) ; GET CADR
629 SKIPL D ; SKIP IF MARKED
640 STRFX: MOVE C,B ; GET ARG FOR BYTDOP
642 SKIPL (A) ; SKIP IF MARKED
647 CAIN 0,SATOM ; REALLY ATOM?
649 HRRZ 0,(A) ; GET PTR IN NEW STRUCTURE
650 SUBI 0,(A) ; RELATAVIZE
653 ADDM 0,1(B) ; FIX UP PTR
658 SKIPL 1(C) ; SKIP IF MARKED
660 ATPFX1: HRRZS C ; SEE IF PURE
661 CAIL C,HIBOT ; SKIP IF NOT PURE
663 HRRZ 0,1(C) ; GET PTR TO NEW ATOM
664 SUBI 0,1(C) ; RELATAVIZE
670 LPLSTF: SKIPN D ; SKIP IF NOT PTR TO NIL
672 SKIPL (D) ; SKIP IF MARKED
674 HRRZ D,(D) ; GET UPDATED POINTER
675 ADD D,MAPUP ; ADJUSTMENT
680 OFFSFX: HLRZS D ; LIST POINTER
689 ; ROUTINES TO CAUSE A GARBAGE COLLECT WHEN EFFORTS TO GET STORAGE FAIL
692 MOVEM A,PARNEW ; SET UP GC PARAMS
696 LOSLP2: MOVEI A,@BOTNEW ; TOTAL AMOUNT NEEDED
698 ANDCMI A,1777 ; CALCULATE PURE PAGES NEEDED
703 PURLOS: MOVE P,[-2000,,MRKPDL]
706 MOVE R,C ; GET A COPY OF A
707 PUSHJ P,INFCLS ; CLOSE INFERIORS AND FIX UP WORLD
715 IRP AC,,[P,R,M,TP,TB,AB,FRM]
716 MOVE AC,AC!STO+1(PVP)
719 SETZM GCDFLG ; ZERO OUT FLAGS
724 PUSHJ P,AGC ; GARBAGE COLLECT
725 JRST PURIT1 ; TRY AGAIN
727 ; PURIFIER ATOM MARKER
731 JRST GCRET ; DONE IF FROZEN
732 HLRE B,A ; GET TO D.W.
734 SKIPG 1(A) ; SKIP IF NOT MARKED
737 IORM D,1(A) ; MARK THE ATOM
739 HRRM LPVP,(A) ; LINK ONTO CHAIN
744 .GLOBAL %LDRDO,%MPRDO
746 ; ROUTINES TO ALLOW GC-DUMPING OF PURIFIED STRUCTURES.
748 ; PROPUR MAPS PAGES CONTAINING PURIFIED STUFF INTO THE AGD INFERIOR SO THAT IN CASE
749 ; THE PAGES ARE MUNGED THEY CAN BE RESTORED USING MAPPING
751 ; REPURE REMAPS ANY PAGES THAT WERE MUNGED BY GC-DUMP BY RELOADING THEM FROM THE AGD
752 ; INFERIOR IN READ/EXEC MODE
754 REPURE: PUSH P,[PUSHJ P,%LDRDO] ; INSTRUCTION FOR MAPPING IN PAGES FROM AGD INF
756 PROPUR: PUSH P,[PUSHJ P,%MPRDO] ; INSTRUCTION FOR MAPPING PAGES TO AGD INF
757 MOVE A,PURBOT ; GET STARTING PAGE OF PURENESS
758 ASH A,-10. ; CONVERT TO PAGES
759 MOVEI C,HIBOT ; GET ENDING PAGE
760 ASH C,-10. ; CONVERT TO PAGES
761 PUSH P,A ; SAVE PAGE POINTER
762 PUSH P,C ; SAVE END OF PURENESS POINTER
763 PROLOP: CAML A,(P) ; SKIP IF STILL PURE PAGES TO CHECK
764 JRST PRODON ; DONE MAPPING PAGES
765 PUSHJ P,CHKPGI ; SKIP IF PAGE IS PURE
766 JRST NOTPUR ; IT IS NOT
767 MOVE A,-1(P) ; GET PAGE TO MAP
768 XCT -2(P) ; MAP IN/OUT TO AGD INFERIOR IN READ/EXEC MODE
769 NOTPUR: AOS A,-1(P) ; INCREMENT PAGE POINTER AND LOAD
770 JRST PROLOP ; LOOP BACK
771 PRODON: SUB P,[3,,3] ; CLEAN OFF STACK
776 .GLOBAL %SAVIN,STOSTR,%CLMP1,%IMSAV,%IMSV1,ILOOKC,PSHGCF,BSETG,%GCJB1
777 .GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%FDBUF
778 INFSU1: PUSH P,[-1] ; ENTRY USED BY GC-DUMP
781 MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS
783 PUSHJ P,%FDBUF ; GET A BUFFER FOR C/W HACKS
787 HRRZ TYPNT,TYPVEC+1 ; SETUP TYPNT
790 ANDCMI A,1777 ; TO PAGE BOUNDRY
791 SUB A,GCSTOP ; SET UP AOBJN POINTER FOR C/W HACK
792 ASH A,-10. ; TO PAGES
794 MOVEI B,STOSTR ; GET START OF MAPPING
798 PUSHJ P,%SAVIN ; PROTECT THE CORE IMAGE
799 SKIPGE (P) ; IF < 0 GC-DUMP CALL
800 PUSHJ P,PROPUR ; PROTECT PURE PAGES
801 SUB P,[1,,1] ; CLEAN OFF PSTACK
802 PUSHJ P,%CLSJB ; CLOSE INFERIOR
804 MOVSI D,400000 ; CREATE MARK WORD
805 SETZB LPVP,ABOTN ; ZERO ATOM COUNTER
806 MOVEI A,2000 ; MARKED INF STARTS AT PAGE ONE
813 PUSHJ P,%GCJB1 ; CREATE THE JOB
815 MOVEI A,LPUR ; SAVE THE PURE CORE IMAGE
816 ANDCMI A,1777 ; TO PAGE BOUNDRY
818 ASH 0,-10. ; TO PAGES
819 SUB A,HITOP ; SUBTRACT TOP OF CORE
824 PUSHJ P,%IMSV1 ; MAP OUT INTERPRETER
827 ; CREATE A PDL TO USE FOR THESE DUMPING FUNCTIONS
829 MOVE A,[-2000,,MRKPDL]
832 ; ROUTINE TO CLOSE GC's INFERIOR
835 INFCLS: MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT
839 ; CLOSE INFERIOR PROTECTING CORE IMAGE FOR GCDUMP
841 INFCL2: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES
842 INFCL3: MOVE A,INF1 ; RESTORE OPENING POINTER
844 MOVE B,A ; SATIFY MUDITS
845 PUSHJ P,%IFMP2 ; MAP IN GC PAGES AND CLOSE INFERIOR
846 POP P,INF2 ; RESTOR INF2 PARAMETER
849 INFCL1: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES
850 SKIPGE PURMNG ; SKIP IF NO PURE PAGES WERE MUNGED
851 PUSHJ P,REPURE ; REPURIFY MUNGED PAGES
856 ; ROUTINE TO DO TYPE HACKING FOR GC-DUMP. IT MARKS THE TYPE-WORD OF THE
857 ; SLOT IN THE TYPE VECTOR. IT ALSO MARKS THE ATOM REPLACING THE I.D. IN
858 ; THE RIGHT HALF OF THE ATOM SLOT. IF THE TYPE IS A TEMPLATE THE FIRST
859 ; USE OF THE SAT HAS ITS ATOM MARKED AND THE I.D. IS PLACED IN THE LEFT
860 ; HALF OF THE ATOM SLOT (IT GETS THE REAL PRIMTYPE).
862 TYPHK: CAILE B,NUMPRI ; SKIP IF A MUDDLE TYPE
863 JRST TYPHKR ; ITS A NEWTYPE SO GO TO TYPHACKER
864 CAIN B,TTYPEC ; SKIP IF NOT TYPE-C
865 JRST TYPCHK ; GO TO HACK TYPE-C
866 CAIE B,TTYPEW ; SKIP IF TYPE-W
870 JRST TYPHKA ; GO TO TYPE-HACKER
871 TYPCHK: PUSH P,B ; SAVE TYPE-WORD
875 ; GENERAL TYPE-HACKER FOR GC-DUMP
877 TYPHKR: PUSH P,B ; SAVE AC'S
880 LSH B,1 ; GET OFFSET TO SLOT IN TYPE VECTOR
881 MOVEI C,(TYPNT) ; GET TO SLOT
885 IORM D,(C) ; MARK THE SLOT
886 MOVEI B,TATOM ; NOW MARK THE ATOM SLOT
887 PUSHJ P,MARK1 ; MARK IT
888 HRRM A,1(C) ; SMASH IN ID
889 HRRZS 1(C) ; MAKE SURE THAT THATS ALL THATS THERE
891 ANDI B,SATMSK ; GET RID OF MAGIC BITS
892 HRRM B,(C) ; SMASH SAT BACK IN
893 CAIG B,NUMSAT ; SKIP IF TEMPLATE
895 MOVE A,TYPSAV ; GET POINTER TO TYPE VECTOR
896 ADDI A,NUMPRI*2 ; GET TO NEWTYPES SLOTS
898 HLLZS 0 ; MAKE SURE ONLY LEFT HALF
900 TYPHK1: HRRZ E,(A) ; GET SAT OF SLOT
901 CAMN E,B ; SKIP IF NOT EQUAL
905 TYPHK2: PUSH P,C ; SAVE POINTER TO ORIGINAL SLOT
907 MOVEI B,TATOM ; SET UP FOR MARK
908 MOVE A,1(C) ; ASSUME MARK DOESN'T HAVE TO TAKE PLACE
909 SKIPL (C) ; DON'T MARK IF ALREADY MARKED
912 HRLM A,1(C) ; SMASH IN PRIMTYPE OF TEMPLATE
913 EXTYP: POP P,C ; RESTORE AC'S
919 ; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER
921 GETYP A,(B) ; GET TYPE
922 PUSHJ P,SAT ; GET SAT
923 CAIG A,NUMSAT ; NOT DEFERRED IF TEMPLATE
925 AOS -1(P) ; SKIP IF NOT DEFFERED
930 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
936 DISTBS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,ERDP]
937 [STPSTK,ERDP],[SARGS,ERDP],[S2NWORD,VECTMK],[SPSTK,ERDP],[SSTORE,VECTMK]
938 [SFRAME,ERDP],[SBYTE,<SETZ BYTMK>],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP]
939 [SLOCID,ERDP],[SCHSTR,<SETZ BYTMK>],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP]
940 [SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ERDP]
941 [SLOCB,<SETZ BYTMK>],[SLOCR,LOCRDP],[SOFFS,OFFSMK]]
946 ; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS
951 HLRZ C,(A) ; GET LENGTH
952 TRZ C,400000 ; TURN OF 400000 BIT
953 SUBI A,-1(C) ; POINT TO START OF ATOM
954 MOVNI C,-2(C) ; MAKE IT LOOK LIKE AN ATOM POINTER
964 POP P,LPVP ; RESTORE A
969 FIXTM5: JUMPE LPVP,FIXTM4
970 MOVEI B,(LPVP) ; GET PTR TO ATOMS DOPE WORD
971 HRRZ LPVP,-1(B) ; SET UP LPVP FOR NEXT IN CHAIN
972 SKIPE -2(P) ; SEE IF PURE SCAN
976 FIXTM2: CAMG B,PARBOT ; SKIP IF NOT FROZEN
979 TRZ A,400000 ; GET RID OF MARK BIT
980 MOVE D,A ; GET A COPY OF LENGTH
983 PUSHJ P,CAFREE ; GET STORAGE
984 SKIPE GCDANG ; SEE IF WON
985 JRST LOSLP1 ; GO TO CAUSE GC
996 SUBI B,-1(D) ; POINT TO START OF ATOM
997 HRLZ C,B ; SET UP FOR BLT
999 ADDI A,-1(D) ; FIX UP TO POINT TO NEW DOPE WORD
1002 HLLOS (A) ; -1 IN RELOCATION FIELD SINCE ITS NOT GARBAGE
1003 ADDI B,-1(D) ; B POINTS TO SECOND D.W.
1004 HRRM A,(B) ; PUT IN RELOCATION
1005 MOVSI D,400000 ; UNMARK ATOM
1007 CAIL B,HIBOT ; SKIP IF IMPURE
1009 JRST FIXTM5 ; CONTINE FIXUP
1011 FIXTM4: POP P,LPVP ; FIX UP LPVP TO POINT TO NEW CHAIN
1014 FIXTM1: HRRM B,(B) ; SMASH IN RELOCATION
1016 ANDCAM D,(B) ; CLEAR MARK BIT
1021 MOVEM B,(P) ; FIX UP CHAIN
1028 ;SET FLAG FOR INTERRUPT HANDLER
1029 SETZB M,RCL ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR
1030 EXCH P,GCPDL ; IN CASE CURRENT PDL LOSES
1035 ; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING
1040 ADD A,GCSTOP ; ADJUSTMENT TO KEEP FREE REAL
1043 MOVE A,NOWP ; ADJUSTMENTS FOR STACKS
1050 MOVEI B,[ASCIZ /GIN /]
1051 SKIPE GCMONF ; MONITORING
1053 NOMON1: HRRZ C,(P) ; GET CAUSE OF GC INDICATOR
1054 MOVE B,GCNO(C) ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON
1057 MOVEM C,GCCAUS ; SAVE CAUSE OF GC
1058 SKIPN GCMONF ; MONITORING
1060 MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE
1062 NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC
1063 MOVEM C,GCCALL ; SAVE CALLER OF GC
1064 SKIPN GCMONF ; MONITORING
1068 NOMON3: SUB P,[1,,1] ; POP OFF C
1074 HLLZS SQUPNT ; FLUSH SQUOZE TABLE
1075 SETZB M,RCL ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION
1081 IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM]
1082 MOVEM AC,AC!STO"+1(PVP)
1086 MOVEM 0,PVPSTO+1(PVP)
1090 JSP E,CKPUR ; CHECK FOR PURE RSUBR
1093 ;SET UP E TO POINT TO TYPE VECTOR
1100 CHPDL: MOVE D,P ; SAVE FOR LATER
1101 CORGET: MOVE P,[-2000,,MRKPDL]
1103 ;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK
1105 MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS
1106 PUSHJ P,FRMUNG ;AND MUNG IT
1107 MOVE A,TP ;THEN TEMPORARY PDL
1110 MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK
1113 \f; FIRST CREATE INFERIOR TO HOLD NEW PAGES
1115 INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW
1118 ANDCMI A,1777 ; EVEN PAGE BOUNDARY
1119 HRRM A,BOTNEW ; INTO POINTER WORD
1124 HRRZ A,BOTNEW ; GET PAGE TO START INF AT
1125 ASH A,-10. ; TO PAGES
1126 MOVEI R,(A) ; COPY A
1127 PUSHJ P,%GCJOB ; GET PAGE HOLDER
1128 MOVSI FPTR,-2000 ; FIX UP FRONTIER POINTER
1130 ADDI A,2000 ; FIND WNDTOP
1133 ;MARK PHASE: MARK ALL LISTS AND VECTORS
1134 ;POINTED TO WITH ONE BIT IN SIGN BIT
1135 ;START AT TRANSFER VECTOR
1136 NOMAP: MOVE A,GLOBSP+1 ; GET GLOBSP TO SAVE
1138 MOVE A,ASOVEC+1 ; ALSO SAVE FOR USE BY GC
1140 MOVE A,NODES+1 ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT PHASE
1142 MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS
1144 MOVE A,PURVEC+1 ; SAVE PURE VECTOR FOR GETPAG
1149 SETZ LPVP, ;CLEAR NUMBER OF PAIRS
1150 MOVE 0,NGCS ; SEE IF NEED HAIR
1152 MOVEM 0,GCHAIR ; RESUME COUNTING
1153 MOVSI D,400000 ;SIGN BIT FOR MARKING
1154 MOVE A,ASOVEC+1 ;MARK ASSOC. VECTOR NOW
1155 PUSHJ P,PRMRK ; PRE-MARK
1162 MOVE A,IMQUOTE THIS-PROCESS
1168 ; HAIR TO DO AUTO CHANNEL CLOSE
1170 MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS
1171 MOVEI A,CHNL1 ; 1ST SLOT
1173 SKIPE 1(A) ; NOW A CHANNEL?
1174 SETZM (A) ; DON'T MARK AS CHANNELS
1180 MOVE A,PVSTOR+1 ; MARK MAIN PROCES EVEN IF SWAPPED OUT
1184 MOVE A,MAINPR ; MARK MAIN PROCES EVEN IF SWAPPED OUT
1186 MOVEM A,MAINPR ; ADJUST PTR
1188 ; ASSOCIATION AND VALUE FLUSHING PHASE
1190 SKIPN GCHAIR ; ONLY IF HAIR
1194 PUSHJ P,ATCLEA ; CLEAN UP ATOM TABLE
1196 SKIPE GCHAIR ; IF NOT HAIR, DO CHANNELS NOW
1199 PUSHJ P,ASSOUP ; UPDATE AND MOVE ASSOCIATIONS
1200 PUSHJ P,CHFIX ; SEND OUT CHANNELS AND MARK LOSERS
1201 PUSHJ P,STOGC ; FIX UP FROZEN WORLD
1202 MOVE P,GCPDL ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS
1205 MOVE A,NPARBO ; UPDATE GCSBOT
1209 MOVEM A,PURVEC+1 ; RESTORE PURVEC
1210 PUSHJ P,CORADJ ; ADJUST CORE SIZE
1215 \f; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE
1217 NOMAP1: MOVEI A,@BOTNEW
1218 ADDI A,1777 ; TO PAGE BOUNDRY
1221 DOMAP: ASH B,-10. ; TO PAGES
1223 MOVEI C,(A) ; COMPUTE HIS TOP
1226 SUBM A,B ; B==> - # OF PAGES
1227 HRLI A,(B) ; AOBJN TO SOURCE AND DEST
1228 MOVE B,A ; IN CASE OF FUNNY
1229 HRRI B,(C) ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES
1230 PUSHJ P,%INFMP ; NOW FLUSH INF AND MAKE HIS CORE MINE
1233 \f; CORE ADJUSTMENT PHASE
1235 CORADJ: MOVE A,PURTOP
1236 SUB A,CURPLN ; ADJUST FOR RSUBR
1237 ANDCMI A,1777 ; ROUND DOWN
1239 MOVEI A,@BOTNEW ; NEW GCSTOP
1240 ADDI A,1777 ; GCPDL AND ROUND
1241 ANDCMI A,1777 ; TO PAGE BOUNDRY
1242 MOVEM A,CORTOP ; TAKE CARE OF POSSIBLE LATER LOSSAGE
1243 CAMLE A,RPTOP ; SEE IF WE CAN MAP THE WORLD BACK IN
1244 FATAL AGC--UNABLE TO MAP GC-SPACE INTO CORE
1245 CAMG A,PURBOT ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT
1246 JRST CORAD0 ; DON'T HAVE TO PUNT SOME PURE
1247 PUSHJ P,MAPOUT ; GET THE CORE
1248 FATAL AGC--PAGES NOT AVAILABLE
1250 ; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS
1251 ; FIRST LETS SEE IF WE HAVE TO CORE DOWN.
1252 ; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED
1254 CORAD0: SKIPN B,GCDOWN ; CORE DOWN?
1255 JRST CORAD1 ; NO, LETS GET CORE REQUIREMENTS
1256 ADDI A,(B) ; AMOUNT+ONE FREE BLOCK
1257 CAMGE A,RPTOP ; CAN WE WIN
1258 JRST CORAD3 ; POSSIBLY
1260 ; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR
1261 CORAD2: SETOM GCDANG ; INDICATE LOSSAGE
1263 ; CALCULATE PARAMETERS BEFORE LEAVING
1264 CORAD6: MOVE A,PURSVT ; GET PURE TABLE
1265 PUSHJ P,SPCOUT ; OUT IT GOES IN CASE IT WAS CHANGED
1266 MOVEI A,@BOTNEW ; GCSTOP
1268 MOVE A,CORTOP ; ADJUST CORE IMAGE
1269 ASH A,-10. ; TO PAGES
1270 TRYPCO: PUSHJ P,P.CORE
1271 FATAL AGC--CORE SCREW UP
1272 MOVE A,CORTOP ; GET IT BACK
1278 ; TRIES TO SATISFY REQUEST FOR CORE
1279 CORAD1: MOVEM A,CORTOP
1281 ADD A,GETNUM ; ADD MINIMUM CORE NEEDED
1282 ADDI A,1777 ; ONE BLOCK+ROUND
1283 ANDCMI A,1777 ; TO BLOCK BOUNDRY
1284 CAMLE A,RPTOP ; CAN WE WIN
1287 JRST CORAD7 ; DON'T HAVE TO MAP OUT PURE
1291 ; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE
1292 CORAD7: MOVEM A,CORTOP ; STORE POSSIBLE VALUE
1293 MOVE B,RPTOP ; GET REAL PURTOP
1294 SUB B,PURMIN ; KEEP PURMIN
1295 CAMG B,CORTOP ; SEE IF CORTOP IS ALREADY HIGH
1296 MOVE B,CORTOP ; DONT GIVE BACK WHAT WE GOT
1297 MOVEM B,RPTOP ; FOOL CORE HACKING
1299 ANDCMI A,1777 ; TO PAGE BOUNDRY
1300 CAMGE A,RPTOP ; DO WE WIN TOTALLY
1302 MOVE A,RPTOP ; GET AS MUCH CORE AS POSSIBLE
1304 JRST CORAD6 ; LOSE, BUT YOU CAN'T HAVE EVERYTHING
1305 CORAD4: CAMG A,PURBOT ; DO WE HAVE TO PUNT SOME PURE
1307 PUSHJ P,MAPOUT ; GET IT
1309 CORAD8: MOVEM A,CORTOP ; ADJUST PARAMETER
1310 JRST CORAD6 ; WIN TOTALLY
1312 ; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE
1314 CORAD3: ADD A,FREMIN
1316 CAMGE A,PURBOT ; CAN WE WIN
1319 CORAD9: SUB A,GCDOWN ; SATISFY GCDOWN REQUEST
1320 JRST CORAD4 ; GO CHECK ALLOCATION
1322 MAPOUT: PUSH P,A ; SAVE A
1323 SUB A,P.TOP ; AMOUNT TO GET
1325 ANDCMI A,1777 ; TO PAGE BOUNDRY
1326 ASH A,-PGSZ ; TO PAGES
1327 PUSHJ P,GETPAG ; GET THEN
1328 JRST MAPLOS ; LOSSAGE
1329 AOS -1(P) ; INDICATE WINNAGE
1334 \f;GARBAGE ZEROING PHASE
1335 GARZER: MOVE A,GCSTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE
1336 MOVE B,FRETOP ;LAST ADDRESS OF GARBAGE + 1
1339 CLEARM (A) ;ZERO THE FIRST WORD
1340 CAIL A,-1(B) ; ARE WE AT THE TOP OF THE WORLD (FORMERLY CAML A,FRETOP)
1341 JRST GARZR1 ; DON'T BLT
1347 ADDI A,1 ;MAKE A A BLT POINTER
1348 BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA
1351 ; MAP UNWANTED PAGES OUT ON TWENEX (AFTER ZEROING REST OF LAST PAGE)
1368 ; NOW REHASH THE ASSOCIATIONS BASED ON VALUES
1369 GARZR1: PUSHJ P,REHASH
1373 TRYCOX: SKIPN GCMONF
1375 MOVEI B,[ASCIZ /GOUT /]
1377 NOMONO: MOVE PVP,PVSTOR+1
1378 IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM]
1379 MOVE AC,AC!STO+1(PVP)
1383 MOVE PVP,PVPSTO+1(PVP)
1385 ; CLOSING ROUTINE FOR G-C
1386 PUSH P,A ; SAVE AC'C
1391 MOVE A,FRETOP ; ADJUST BLOAT-STAT PARAMETERS
1394 PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS
1401 FSBR B,GCTIM ; GET TIME ELAPSED
1402 SKIPN INBLOT ; STORE TIME ONLY IF NO RETRY
1404 MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER
1405 SKIPN GCMONF ; SEE IF MONITORING
1407 PUSHJ P,FIXSEN ; OUTPUT TIME
1408 MOVEI A,15 ; OUTPUT C/R LINE-FEED
1412 GCCONT: MOVE C,[NTPGOO,,NTPMAX] ; MAY FIX UP TP PARAMS TO ENCOURAGE
1413 ; SHRINKAGE FOR EXTRA ROOM
1415 MOVE C,[ETPGOO,,ETPMAX]
1418 POP P,D ; RESTORE AC'C
1423 JUMPE A,AGCWIN ; IF ZERO THE GC WORKED
1424 SKIPN GCHAIR ; SEE IF HAIRY GC
1426 REAGCX: MOVEI A,1 ; PREPARE FOR A HAIRY GC
1429 MOVE C,[11,,10.] ; REASON FOR GC
1434 FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS
1437 AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL
1438 SETZM GETNUM ;ALSO CLEAR THIS
1442 SETZM PGROW ; CLEAR GROWTH
1444 SETOM GCHAPN ; INDICATE A GC HAS HAPPENED
1446 SETOM INTFLG ; AND REQUEST AN INTERRUPT
1450 ; JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT
1451 ; SKIPE PLODR ; LOADING ONE, M = 0 IS OK
1454 FATAL AGC--RUNNING RSUBR WENT AWAY
1456 AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR
1458 \f; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL
1461 FIXSEN: PUSH P,B ; SAVE TIME
1462 MOVEI B,[ASCIZ /TIME= /]
1463 PUSHJ P,MSGTYP ; PRINT OUT MESSAGE
1465 FMPRI B,(100.0) ; CONVERT TO FIX
1469 MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME
1471 IDIVI C,10. ; START COUNTING
1475 CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER
1477 FIXOUT: IDIVI C,10. ; RECOVER NUMBER
1482 CAIN A,2 ; DECIMAL POINT HERE?
1484 FIX1: HLRZ A,(P)-1 ; GET NUMBER
1485 ADDI A,60 ; MAKE IT A CHARACTER
1486 PUSHJ P,IMTYO ; OUT IT GOES
1490 DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0
1494 JRST FIXOUT ; CONTINUE
1495 DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT
1500 \f; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
1502 PDLCHK: JUMPGE A,CPOPJ
1503 HLRE B,A ;GET NEGATIVE COUNT
1504 MOVE C,A ;SAVE A COPY OF PDL POINTER
1505 SUBI A,-1(B) ;LOCATE DOPE WORD PAIR
1506 HRRZS A ; ISOLATE POINTER
1507 CAME A,TPGROW ;GROWING?
1508 ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD
1512 SETOM 1(C) ; START FENECE POST
1515 MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS
1517 BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS
1520 NOFENC: CAMG B,TPMAX ;NOW CHECK SIZE
1522 JRST MUNGTP ;TOO BIG OR TOO SMALL
1525 MUNGTP: SUB B,TPGOOD ;FIND DELTA TP
1526 MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED
1527 TRNE C,777000 ;SKIP IF NOT
1528 POPJ P, ;ASSUME GROWTH GIVEN WILL WIN
1530 ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS
1532 CAILE B,377 ; SKIP IF BELOW MAX
1533 MOVEI B,377 ; ELSE USE MAX
1534 TRO B,400 ;TURN ON SHRINK BIT
1538 MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD
1541 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)
1543 PDLCHP: HLRE B,A ;-LENGTH TO B
1545 SUBI A,-1(B) ;POINT TO DOPE WORD
1546 HRRZS A ;ISOLATE POINTER
1547 CAME A,PGROW ;GROWING?
1548 ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD
1552 SETOM 1(C) ; START FENECE POST
1559 NOPF: CAMG B,PMAX ;TOO BIG?
1560 CAMG B,PMIN ;OR TOO LITTLE
1561 JRST .+2 ;YES, MUNG IT
1567 ; ROUTINE TO PRE MARK SPECIAL HACKS
1569 PRMRK: SKIPE GCHAIR ; FLUSH IF NO HAIR
1572 SUBI A,(B) ;POINT TO DOPE WORD
1573 HLRZ F,1(A) ; GET LNTH
1574 LDB 0,[111100,,(A)] ; GET GROWTHS
1575 TRZE 0,400 ; SIGN HACK
1585 HRRM 0,1(A) ; NEW RELOCATION FIELD
1586 IORM D,1(A) ;AND MARK
1590 \f;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS
1591 ; A/ GOODIE TO MARK FROM
1592 ; B/ TYPE OF A (IN RH)
1593 ; C/ TYPE,DATUM PAIR POINTER
1596 MARK2: HLRZ B,(C) ;GET TYPE
1597 MARK1: MOVE A,1(C) ;GET GOODIE
1599 JUMPE A,CPOPJ ; NEVER MARK 0
1604 HRLM C,-1(P) ;AND POINTER TO IT
1605 ANDI B,TYPMSK ; FLUSH MONITORS
1606 SKIPE DUMFLG ; SKIP IF NOT IN DUMPER
1607 PUSHJ P,TYPHK ; HACK SOME TYPES
1608 LSH B,1 ;TIMES 2 TO GET SAT
1609 HRRZ B,@TYPNT ;GET SAT
1612 CAILE B,NUMSAT ; SKIP IF TEMPLATE DATA
1616 JRST @MKTBS(B) ;AND GO MARK
1617 JRST @GCDISP(B) ; DISPATCH FOR DUMPERS
1625 ; HERE TO MARK A POSSIBLE DEFER POINTER
1627 DEFQMK: GETYP B,(A) ; GET ITS TYPE
1630 ANDI B,SATMSK ; AND TO SAT
1633 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER
1635 DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG
1637 ;HERE TO MARK LIST ELEMENTS
1639 PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT
1640 PUSH P,[0] ; WILL HOLD BACK PNTR
1641 MOVEI C,(A) ; POINT TO LIST
1642 PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS
1644 FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE
1645 SKIPGE B,(C) ;SKIP IF NOT MARKED
1646 JRST RETNEW ;ALREADY MARKED, RETURN
1648 SKIPL FPTR ; SEE IF IN FRONTEIR
1649 PUSHJ P,MOVFNT ; EXPAND THE FRONTEIR
1651 MOVE 0,1(C) ; AND 2D
1652 AOBJN FPTR,.+2 ; AOS AND CHECK FRONTEIR
1653 PUSHJ P,MOVFNT ; EXPAND FRONTEIR
1655 ADD FPTR,[1,,1] ; MOVE ALONG IN FRONTIER
1658 PAIRM2: MOVEI A,@BOTNEW ; GET INF ADDR
1660 HRRM A,(C) ; LEAVE A POINTER TO NEW HOME
1661 HRRZ E,(P) ; GET BACK POINTER
1662 JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP
1663 MOVSI 0,(HRRM) ; INS FOR CLOBBER
1664 PUSHJ P,SMINF ; SMASH INF'S CORE IMAGE
1665 PAIRM4: MOVEM A,(P) ; NEW BACK POINTER
1666 JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER
1667 HRLM B,(P) ; SAVE OLD CDR
1668 PUSHJ P,MARK2 ;MARK THIS DATUM
1669 HRRZ E,(P) ; SMASH CAR IN CASE CHANGED
1673 HLRZ C,(P) ;GET CDR OF LIST
1674 CAIGE C,@PURBOT ; SKIP IF PURE (I.E. DONT MARK)
1675 JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT
1676 GCRETP: SUB P,[1,,1]
1678 GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT
1679 HLRZ C,-1(P) ;RESTORE C
1681 POPJ P, ;AND RETURN TO CALLER
1683 GCRETD: ANDI B,TYPMSK ; TURN OFF MONITORS
1684 CAIN B,TLOCR ; SEE IF A LOCR
1686 SKIPN GCDFLG ; SKIP IF IN PURIFIER OR DUMPER
1688 CAIE B,TATOM ; WE MARK PURE ATOMS
1689 CAIN B,TCHSTR ; AND STRINGS
1693 ;HERE TO MARK DEFERRED POINTER
1695 DEFDO: PUSH P,B ; PUSH OLD PAIR ON STACK
1697 MOVEI C,-1(P) ; USE AS NEW DATUM
1698 PUSHJ P,MARK2 ;MARK THE DATUM
1699 HRRZ E,-2(P) ; GET POINTER IN INF CORE
1702 PUSHJ P,SMINF ; AND CLOBBER
1705 MOVSI 0,(HRRM) ; SMASH IN RIGHT HALF
1708 JRST GCRET ;AND RETURN
1711 PAIRM7: MOVEM A,-1(P) ; SAVE NEW VAL FOR RETURN
1714 RETNEW: HRRZ A,(C) ; POINT TO NEW WORLD LOCN
1715 HRRZ E,(P) ; BACK POINTER
1716 JUMPE E,RETNW1 ; NONE
1721 RETNW1: MOVEM A,-1(P)
1724 ; ROUTINE TO EXPAND THE FRONTEIR
1726 MOVFNT: PUSH P,B ; SAVE REG B
1727 HRRZ A,BOTNEW ; CURRENT BOTTOM OF WINDOW
1728 ADDI A,2000 ; MOVE IT UP
1730 HRRZM A,FNTBOT ; BOTTOM OF FRONTEIR
1732 ASH A,-10. ; TO PAGES
1734 PUSHJ P,%SHWND ; SHARE THE PAGE
1735 MOVSI FPTR,-2000 ; FIX UP FPTR
1740 ; ROUTINE TO SMASH INFERIORS PPAGES
1741 ; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE
1743 SMINF: CAMGE E,FNTBOT
1744 JRST SMINF1 ; NOT IN FRONTEIR
1745 SUB E,FNTBOT ; ADJUST POINTER
1746 IOR 0,[0 A,FRONT(E)] ; BUILD INSTRUCTION
1749 SMINF1: CAML E,WNDBOT
1750 CAML E,WNDTOP ; SEE IF IN WINDOW
1752 SMINF3: SUB E,WNDBOT ; FIX UP
1753 IOR 0,[0 A,WIND(E)] ; FIX INS
1756 SMINF2: PUSH P,A ; SAVE E
1758 HRRZ A,E ; E SOMETIMES HAS STUFF IN LH
1760 MOVEI B,WNDP ; WINDOW PAGE
1761 PUSHJ P,%SHWND ; SHARE IT
1762 ASH A,10. ; TO PAGES
1763 MOVEM A,WNDBOT ; UPDATE POINTERS
1766 POP P,B ; RESTORE ACS
1768 JRST SMINF3 ; FIX UP INF
1772 \f; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
1774 TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG
1775 VECTMK: TLZ TYPNT,400000
1776 MOVEI 0,@BOTNEW ; POINTER TO INF
1778 MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR
1780 SUB A,B ;LOCATE DOPE WORD
1781 MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD
1782 CAIL A,STOSTR ; CHECK IN VECTOR SPACE
1784 JRST VECTB1 ;LOSE, COMPLAIN
1786 HLLM TYPNT,(P) ; SAVE MARKER INDICATING STACK
1787 JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK
1788 CAME A,PGROW ;IS THIS THE BLOWN P
1789 CAMN A,TPGROW ;IS THIS THE GROWING PDL
1790 JRST NOBUFR ;YES, DONT ADD BUFFER
1791 ADDI A,PDLBUF ;POINT TO REAL DOPE WORD
1792 MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER
1794 MOVEM 0,-1(P) ; FIXUP RET'D PNTR
1796 NOBUFR: HLRE B,(A) ;GET LENGTH FROM DOPE WORD
1797 JUMPL B,EXVECT ; MARKED, LEAVE
1798 LDB B,[111100,,-1(A)] ; GET TOP GROWTH
1799 TRZE B,400 ; HACK SIGN BIT
1801 ASH B,6 ; CONVERT TO WORDS
1802 PUSH P,B ; SAVE TOP GROWTH
1803 LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR
1804 TRZE 0,400 ;KILL SIGN BIT AND SKIP IF +
1806 ASH 0,6 ;CONVERT TO NUMBER OF WORDS
1807 PUSH P,0 ; SAVE BOTTOM GROWTH
1808 ADD B,0 ;TOTAL GROWTH TO B
1809 VECOK: HLRE E,(A) ;GET LENGTH AND MARKING
1810 MOVEI F,(E) ;SAVE A COPY
1812 SUBI E,2 ;- DOPE WORD LENGTH
1813 IORM D,(A) ;MAKE SURE NOW MARKED
1814 PUSHJ P,ALLOGC ; ALLOCATE SPACE FOR VECTOR IN THE INF
1816 VECOK1: JUMPLE E,MOVEC2 ; ZERO LENGTH, LEAVE
1817 PUSH P,A ; SAVE POINTER TO DOPE WORD
1818 SKIPGE B,-1(A) ;SKIP IF UNIFORM
1819 TLNE B,377777-.VECT. ;SKIP IF NOT SPECIAL
1820 JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR
1822 GENRAL: HLRZ 0,B ;CHECK FOR PSTACK
1824 JUMPE 0,NOTGEN ;IT ISN'T GENERAL
1825 JUMPL TYPNT,TPMK1 ; JUMP IF TP
1827 SUBI C,1(E) ; C POINTS TO BEGINNING OF VECTOR
1829 \f; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR
1830 VECTM2: HLRE B,(C) ;GET TYPE AND MARKING
1831 JUMPL B,UMOVEC ;RETURN, (EITHER DOPE WORD OR FENCE POST)
1832 MOVE A,1(C) ;DATUM TO A
1835 VECTM3: PUSHJ P,MARK ;MARK DATUM
1836 MOVEM A,1(C) ; IN CASE WAS FIXED
1841 MOVEC2: POP P,C ; RESTORE BOTTOM GROWTH
1842 HRRZ E,-1(P) ; GET POINTER INTO INF
1843 SKIPN C ; SKIP IF NO BOTTOM GROWTH
1845 JUMPL C,.+3 ; SEE IF BOTTOM SHRINKAGE
1847 JRST MOVEC3 ; CONTINUE
1848 HRLM C,E ; MOVE SHRINKAGE FOR TRANSFER PHASE
1849 MOVEC3: PUSHJ P,DOPMOD ; MODIFY DOPE WORD AND PLACE IN INF
1850 PUSHJ P,TRBLKV ; SEND VECTOR INTO INF
1851 TGROT: CAMGE A,PARBOT ; SKIP IF NOT STORAGE
1853 MOVE C,DOPSV1 ; RESTORE DOPE WORD
1854 SKIPN (P) ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH
1856 TGROT1: POP P,C ; IS THERE TOP GROWH
1857 SKIPN C ; SEE IF ANY GROWTH
1866 SETZ C, ; ZERO WHERE OLD DOPE WORDS WERE
1869 ADDI E,-1(C) ; MAKE ADJUSTMENT FOR TOP GROWTH
1870 OUTDOP: PUSHJ P,DOPOUT
1873 SUB P,[1,,1] ; GET RID OF FPTR
1874 PUSHJ P,RELATE ; RELATIVIZE
1875 TRNN B,400000 ; WAS THIS A STACK
1877 MOVSI 0,PDLBUF ; FIX UP STACK PTR
1881 VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE
1882 HLLZ 0,(C) ;GET TYPE
1883 MOVEI B,TILLEG ;GET ILLEGAL TYPE
1885 MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE
1886 JRST UMOVEC ;RETURN WITHOUT MARKING VECTOR
1888 CCRET: CLEARM 1(C) ;CLOBBER THE DATUM
1892 ; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN
1893 ; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL.
1898 HRRZ E,-1(P) ; FIX UP PARAMS
1901 HRRZ B,(A) ; CALCULATE RELOCATION
1903 MOVE C,-1(P) ; ADJUST FOR GROWTH
1910 TPMK3: HLRZ E,(A) ; GET LENGTH
1911 TRZ E,400000 ; GET RID OF MARK BIT
1912 SUBI A,-1(E) ;POINT TO FIRST ELEMENT
1913 MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C
1914 TPMK4: HLRE B,(C) ;GET TYPE AND MARKING
1915 JUMPL B,TPMK7 ;RETURN, (EITHER DOPE WORD OR FENCE POST)
1916 HRRZ A,(C) ;DATUM TO A
1917 ANDI B,TYPMSK ; FLUSH MONITORS
1919 CAIN B,TENTRY ;IS THIS A STACK FRAME
1920 JRST MFRAME ;YES, MARK IT
1921 CAIE B,TUBIND ; BIND
1922 CAIN B,TBIND ;OR A BINDING BLOCK
1924 CAIE B,TBVL ; CHECK FOR OTHER BINDING HACKS
1926 SKIPA ; FIX UP SP-CHAIN
1927 CAIN B,TSKIP ; OTHER BINDING HACK
1931 TPMK5: PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT
1932 HRRM A,(C) ; FIX UP IN CASE OF SP CHAIN
1933 PUSHJ P,MARK1 ;MARK DATUM
1937 PUSHJ P,OUTTP ; MOVE OUT TYPE
1939 PUSHJ P,OUTTP ; SEND OUT VALUE
1940 MOVEM M,(C) ; RESTORE TO OLD VALUE
1944 MFRAME: HRRZ 0,1(C) ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME
1945 HRROI C,FRAMLN+FSAV-1(C) ;POINT TO FUNCTION
1946 HRRZ A,1(C) ; GET IT
1947 CAIL A,STOSTR ; CHECK IN VECTOR SPACE
1949 JRST MFRAM1 ; IGNORE, NOT IN VECTOR SPACE
1950 HRL A,(A) ; GET LENGTH
1952 PUSHJ P,MARK ; AND MARK IT
1954 PUSHJ P,OUTTP ; SEND IT OUT
1955 HRRZ A,OTBSAV-FSAV+1(C) ; POINT TO TB TO PREVIOUS FRAME
1957 ADD A,-2(P) ; RELOCATE IF NOT 0
1959 PUSHJ P,OUTTP ; SEND IT OUT
1960 MOVE A,-2(P) ; ADJUST AB SLOT
1961 ADD A,ABSAV-FSAV+1(C) ; POINT TO SAVED AB
1962 PUSHJ P,OUTTP ; SEND IT OUT
1963 MOVE A,-2(P) ; ADJUST SP SLOT
1964 ADD A,SPSAV-FSAV+1(C) ;POINT TO SAVED SP
1965 SUB A,-3(P) ; ADJUSTMENT OF LENGTH IF GROWTH
1966 PUSHJ P,OUTTP ; SEND IT OUT
1967 HRROI C,PSAV-FSAV(C) ;POINT TO SAVED P
1969 PUSHJ P,MARK1 ;AND MARK IT
1970 PUSHJ P,OUTTP ; SEND IT OUT
1971 HLRE 0,TPSAV-PSAV+1(C)
1972 MOVE A,TPSAV-PSAV+1(C)
1975 MOVE A,TPSAV-PSAV+1(C)
1976 CAME 0,TPGROW ; SEE IF BLOWN
1981 SUB A,-3(P) ; ADJUST
1983 MOVE A,PCSAV-PSAV+1(C)
1985 HRROI C,-PSAV+1(C) ; POINT PAST THE FRAME
1986 JRST TPMK4 ;AND DO MORE MARKING
1989 MBIND: PUSHJ P,FIXBND
1990 MOVEI B,TATOM ;FIRST MARK ATOM
1991 SKIPN GCHAIR ; IF NO HAIR, MARK ALL NOW
1992 SKIPE (P) ; PASSED MARKER, IF SO DONT SKIP
1993 JRST MBIND2 ; GO MARK
1994 MOVE A,1(C) ; RESTORE A
1996 JRST MBIND1 ; NOT IT, CONTINUE SKIPPING
1997 HRRM LPVP,2(C) ; SAVE IN RH OF TPVP,,0
1998 MOVE 0,-4(P) ; RECOVER PTR TO DOPE WORD
1999 HRLM 0,2(C) ; SAVE FOR MOVEMENT
2000 MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS
2001 PUSHJ P,MARK1 ; MARK THE ATOM
2002 MOVEI LPVP,(C) ; POINT
2003 SETOM (P) ; INDICATE PASSAGE
2004 MBIND1: ADDI C,6 ; SKIP BINDING
2006 SKIPE -1(P) ; ONLY UPDATE IF SENDING OVER
2011 PUSHJ P,OUTTP ; FIX UP CHAIN
2012 MOVEI B,TATOM ; RESTORE IN CASE SMASHED
2013 PUSHJ P,MARK1 ; MARK ATOM
2014 PUSHJ P,OUTTP ; SEND IT OUT
2016 PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT
2017 PUSHJ P,MARK2 ;MARK DATUM
2021 PUSHJ P,OUTTP ; MOVE OUT TYPE
2023 PUSHJ P,OUTTP ; SEND OUT VALUE
2024 MOVEM M,(C) ; RESTORE TO OLD VALUE
2026 MOVEI B,TLIST ; POINT TO DECL SPECS
2028 PUSHJ P,MARK ; AND MARK IT
2029 HRR A,(C) ; LIST FIX UP
2031 SKIPL A,1(C) ; PREV LOC?
2033 MOVEI B,TLOCI ; NOW MARK LOCATIVE
2035 NOTLCI: PUSHJ P,OUTTP
2039 FIXBND: HRRZ A,(C) ; GET PTR TO CHAIN
2040 SKIPE A ; DO NOTHING IF EMPTY
2044 TPMK8: MOVNI A,1 ; FENCE-POST THE STACK
2046 ADDI C,1 ; INCREMENT C FOR FENCE-POST
2047 SUB P,[1,,1] ; CLEAN UP STACK
2048 POP P,E ; GET UPDATED PTR TO INF
2049 SUB P,[2,,2] ; POP OFF RELOCATION
2054 SUBI C,(A) ; GET # OF WORDS TRANSFERED
2055 SUB B,C ; GET # LEFT
2056 ADDI E,-2(B) ; ADJUST POINTER TO INF
2058 POP P,C ; IS THERE TOP GROWH
2059 ADD E,C ; MAKE ADJUSTMENT FOR TOP GROWTH
2061 PUSHJ P,DOPMOD ; FIX UP DOPE WORDS
2062 PUSHJ P,DOPOUT ; SEND THEM OUT
2066 \f; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR
2067 ; F= # OF WORDS TO ALLOCATE
2069 ALLOGC: HRRZS A ; GET ABS VALUE
2070 SKIPN GCDFLG ; SKIP IF IN DUMPER
2071 CAML A,GCSBOT ; SKIP IF IN STORAGE
2072 JRST ALOGC2 ; JUMP IF ALLOCATING
2075 ALOGC2: PUSH P,A ; SAVE A
2076 ALOGC1: HLRE 0,FPTR ; GET ROOM LEFT
2077 ADD 0,F ; SEE IF ITS ENOUGH
2081 PUSHJ P,MOVFNT ; MOVE UP FRONTEIR
2083 JRST ALOGC1 ; CONTINUE
2084 ALOCOK: ADD FPTR,F ; MODIFY FPTR
2089 SUBI 0,1 ; RELOCATION PTR
2095 ; TRBLK MOVES A VECTOR INTO THE INFERIOR
2096 ; E= STARTING ADDR IN INF A= DOPE WORD OF VECTOR
2101 CAMGE A,GCSBOT ; SEE IF IN GC-SPACE
2105 TRZ 0,400000 ; TURN OFF GC FLAG
2107 HLRE A,E ; GET SHRINKAGE
2108 ADD 0,A ; MUNG LENGTH
2110 ADDI F,1 ; F POINTS TO START OF VECTOR
2111 TRBLK2: HRRZ R,E ; SAVE POINTER TO INFERIOR
2112 ADD E,0 ; E NOW POINTS TO FINAL ADDRESS+1
2116 CAMGE R,FNTBOT ; SEE IF IN FRONTEIR
2118 SUB E,FNTBOT ; ADJUST E
2119 SUB 0,FNTBOT ; ADJ START
2122 TRBL10: CAML R,WNDBOT
2123 CAML R,WNDTOP ; SEE IF IN WINDOW
2128 TRBLK4: ADDI 0,-1777(A) ; CALCULATE START IN WINDOW OR FRONTEIR
2131 ADDI E,-1777(A) ; SUBTRACT WINDBOT
2132 HRL 0,F ; SET UP FOR BLT
2137 MOVE E,M ; GET END OF WORD
2140 MOVEI B,1(A) ; GET TOP OF WORLD
2147 MOVE E,M ; RESTORE E
2148 JRST TRBLK1 ; CONTINUE
2149 TRBLK5: HRRZ A,R ; COPY E
2150 ASH A,-10. ; TO PAGES
2152 MOVEI B,WNDP ; IT IS WINDOW
2154 ASH A,10. ; TO PAGES
2155 MOVEM A,WNDBOT ; UPDATE POINTERS
2164 ; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE
2167 SKIPE GCDFLG ; SKIP IF NOT IN DUMPER
2169 CAMGE A,GCSBOT ; SEE IF IN GC-SPACE
2171 TRBLV2: PUSH P,A ; SAVE A
2175 HLRE A,E ; GET SHRINKAGE
2176 ADD 0,A ; MUNG LENGTH
2178 ADDI F,1 ; F POINTS TO START OF VECTOR
2179 SKIPGE -2(P) ; SEE IF SHRINKAGE
2180 ADD 0,-2(P) ; IF SO COMPENSATE
2181 JRST TRBLK2 ; CONTINUE
2183 ; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN 0= # OF WORDS
2185 TRBLK3: PUSH P,A ; SAVE A
2189 ; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT
2190 ; F==> START OF TRANSFER IN GCS 0= # OF WORDS
2192 TRBLKX: PUSH P,A ; SAVE A
2193 JRST TRBLK2 ; SEND IT OUT
2196 ; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN
2197 ; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED
2198 ; A CONTAINS THE WORD TO BE SENT OUT
2200 OUTTP: AOS E,-2(P) ; INCREMENT PLACE
2201 MOVSI 0,(MOVEM) ; INS FOR SMINF
2205 ; ADWD PLACES ONE WORD IN THE INF
2206 ; E ==> INF C IS THE WORD
2208 ADWD: PUSH P,E ; SAVE AC'S
2211 MOVSI 0,(MOVEM) ; INS FOR SMINF
2212 PUSHJ P,SMINF ; SMASH IT IN
2217 ; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE
2218 ; SUCH AS THE TP AND GROWTH
2221 DOPOUT: MOVE C,-1(A)
2224 MOVE C,(A) ; GET SECOND DOPE WORD
2225 TLZ C,400000 ; TURN OFF POSSIBLE MARK BIT
2227 MOVE C,DOPSV1 ; FIX UP FIRST DOPE WORD
2230 MOVEM C,(A) ; RESTORE SECOND D.W.
2233 ; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF
2234 ; A ==> DOPE WORD E==> INF
2236 DOPMOD: SKIPE GCDFLG ; CHECK TO SEE IF IN DUMPER AND PURIFY
2239 POPJ P, ; EXIT IF NOT IN GCS
2240 MOVE C,-1(A) ; GET FIRST DOPE WORD
2242 HLLZS C ; CLEAR OUT GROWTH
2243 TLO C,.VECT. ; FIX UP FOR GCHACK
2245 MOVE C,(A) ; GET SECOND DOPE WORD
2246 HLRZ B,(A) ; GET LENGTH
2247 TRZ B,400000 ; TURN OFF MARK BIT
2249 HRRZ 0,-1(A) ; CHECK FOR GROWTH
2251 LDB 0,[111100,,-1(A)] ; MODIFY WITH GROWTH
2256 LDB 0,[001100,,-1(A)]
2261 DOPMD1: HRL C,B ; FIX IT UP
2262 MOVEM C,(A) ; FIX IT UP
2266 ADPMOD: CAMG A,GCSBOT
2267 POPJ P, ; EXIT IF NOT IN GCS
2268 MOVE C,-1(A) ; GET FIRST DOPE WORD
2269 TLO C,.VECT. ; FIX UP FOR GCHACK
2271 MOVE C,(A) ; GET SECOND DOPE WORD
2272 TLZ C,400000 ; TURN OFF PARK BIT
2279 \f; RELATE RELATAVIZES A POINTER TO A VECTOR
2280 ; B IS THE POINTER A==> DOPE WORD
2282 RELATE: SKIPE GCDFLG ; SEE IF DUMPER OR PURIFIER
2284 CAMGE A,GCSBOT ; SEE IF IN VECTOR SPACE
2285 POPJ P, ; IF NOT EXIT
2287 HLRE F,C ; GET LENGTH
2288 HRRZ 0,-1(A) ; CHECK FO GROWTH
2290 LDB 0,[111100,,-1(A)] ; GET TOP GROWTH
2291 TRZE 0,400 ; HACK SIGN BIT
2293 ASH 0,6 ; CONVERT TO WORDS
2294 SUB F,0 ; ACCOUNT FOR GROWTH
2295 RELAT1: HRLM F,C ; PLACE CORRECTED LENGTH BACK IN POINTER
2296 HRRZ F,(A) ; GET RELOCATED ADDR
2297 SUBI F,(A) ; FIND RELATIVIZATION AMOUNT
2298 ADD C,F ; ADJUST POINTER
2299 SUB C,0 ; ACCOUNT FOR GROWTH
2305 \f; MARK TB POINTERS
2306 TBMK: HRRZS A ; CHECK FOR NIL POINTER
2308 JRST GCRET ; IF POINTING TO NIL THEN RETURN
2309 HLRE B,TPSAV(A) ; MAKE POINTER LOOK LIKE A TP POINTER
2310 HRRZ C,TPSAV(A) ; GET TO DOPE WORD
2311 TBMK2: SUB C,B ; POINT TO FIRST DOPE WORD
2312 HRRZ A,(P) ; GET PTR TO FRAME
2313 SUB A,C ; GET PTR TO FRAME
2323 ABMK: HLRE B,A ; FIX UP TO GET TO FRAME
2325 HLRE B,FRAMLN+TPSAV(A) ; FIX UP TO LOOK LIKE TP
2326 HRRZ C,FRAMLN+TPSAV(A)
2333 ARGMK: HRRZ A,1(C) ; GET POINTER
2334 HLRE B,1(C) ; AND LNTH
2335 SUB A,B ; POINT TO BASE
2336 CAIL A,STOSTR ; CHECK IN VECTOR SPACE
2339 HLRZ 0,(A) ; GET TYPE
2343 CAIE 0,TENTRY ; IS NEXT A WINNER?
2345 JRST ARGMK1 ; YES, GO ON TO WIN CODE
2347 ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL
2348 SETZM (P) ; AND SAVED COPY
2351 ARGMK1: MOVE B,1(A) ; ASSUME TTB
2352 ADDI B,(A) ; POINT TO FRAME
2353 CAIE 0,TINFO ; IS IT?
2354 MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE
2355 HLRZ 0,OTBSAV(B) ; GET TIME
2356 HRRZ A,(C) ; AND FROM POINTER
2357 CAIE 0,(A) ; SKIP IF WINNER
2359 MOVE A,TPSAV(B) ; GET A RELATAVIZED TP
2363 SUB A,1(C) ; AMOUNT TO RELATAVIZE ARGS
2366 HRRM B,(P) ; PUT RELATAVIZED PTR BACK
2370 ; MARK FRAME POINTERS
2372 FRMK: HLRZ B,A ; GET TIME FROM FRAME PTR
2373 HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME
2374 CAME B,F ; SEE IF EQUAL
2376 SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR
2377 HRRZ A,1(C) ;USE AS DATUM
2378 SUBI A,1 ;FUDGE FOR VECTMK
2379 MOVEI B,TPVP ;IT IS A VECTRO
2380 PUSHJ P,MARK ;MARK IT
2381 ADDI A,1 ; READJUST PTR
2382 HRRM A,1(C) ; FIX UP PROCESS SLOT
2383 MOVEI C,1(C) ; SET UP FOR TBMK
2385 JRST TBMK ; MARK LIKE TB
2390 BYTMK: PUSHJ P,BYTDOP ; GET DOPE WORD IN A
2391 HLRZ F,-1(A) ; GET THE TYPE
2392 ANDI F,SATMSK ; FLUSH MONITOR BITS
2393 CAIN F,SATOM ; SEE IF ATOM
2395 HLRE F,(A) ; GET MARKING
2396 JUMPL F,BYTREL ; JUMP IF MARKED
2397 HLRZ F,(A) ; GET LENGTH
2398 PUSHJ P,ALLOGC ; ALLOCATE FOR IT
2399 HRRM 0,(A) ; SMASH IT IN
2402 SUBI E,-1(F) ; ADJUST INF POINTER
2408 ADDM E,(P) ; RELATAVIZE
2411 ATMSET: PUSH P,A ; SAVE A
2412 HLRZ B,(A) ; GET LENGTH
2413 TRZ B,400000 ; GET RID OF MARK BIT
2414 MOVNI B,-2(B) ; GET LENGTH
2415 ADDI A,-1(B) ; CALCULATE POINTER
2417 MOVEI B,TATOM ; TYPE
2422 MOVSI E,STATM ; GET "STRING IS ATOM BIT"
2427 JRST BYTREL ; TO BYTREL
2434 PUSH P,A ; PUSH LIST POINTER ON THE STACK
2435 MOVEI C,-1(P) ; POINTER TO PAIR
2436 PUSHJ P,MARK2 ; MARK THE LIST
2437 HRLM A,-2(P) ; UPDATE POINTER IN OFFSET
2442 ; MARK ATOMS IN GVAL STACK
2444 GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL
2448 MOVEI A,(B) ; POINT TO DECL FOR MARK
2452 HLRZ C,-1(P) ; RESTORE HOME POINTER
2453 HRRM A,(C) ; CLOBBER UPDATED LIST IN
2454 MOVE A,1(C) ; RESTORE ATOM POINTER
2460 PUSH P,0 ; SAVE POINTER TO INF
2461 TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED
2463 PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS
2464 JRST ATMRL1 ; ALREADY MARKED
2465 PUSH P,A ; SAVE DOPE WORD PTR FOR LATER
2466 HLRZ C,(A) ; FIND REAL ATOM PNTR
2467 SUBI C,400001 ; KILL MARK BIT AND ADJUST
2469 SUBM A,C ; NOW TOP OF ATOM
2470 MRKOBL: MOVEI B,TOBLS
2471 HRRZ A,2(C) ; IF > 0, NOT OBL
2475 PUSHJ P,MARK ; AND MARK IT
2483 NOMKNX: HLRZ B,(C) ; SEE IF UNBOUND
2484 TRZ B,400000 ; TURN OFF MARK BIT
2487 JRST ATOMK1 ; IT IS UNBOUND
2488 HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER
2489 MOVEI B,TVEC ; ASSUME VECTOR
2491 MOVEI B,TTP ; ITS A LOCAL VALUE
2492 PUSHJ P,MARK1 ; MARK IT
2493 MOVEM A,1(C) ; SMASH INTO SLOT
2494 ATOMK1: HRRZ 0,2(C) ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT
2496 POP P,E ; GET POINTER INTO INF
2501 ATMREL: HRRZ E,(A) ; RELATAVIZE
2505 ATMRL1: SUB P,[1,,1] ; POP OFF STACK
2509 GETLNT: HLRE B,A ;GET -LNTH
2510 SUB A,B ;POINT TO 1ST DOPE WORD
2511 MOVEI A,1(A) ;POINT TO 2ND DOPE WORD
2512 CAIL A,STOSTR ; CHECK IN VECTOR SPACE
2514 JRST VECTB1 ;BAD VECTOR, COMPLAIN
2515 HLRE B,(A) ;GET LENGTH AND MARKING
2516 IORM D,(A) ;MAKE SURE MARKED
2518 MOVEI F,(B) ; AMOUNT TO ALLOCATE
2519 PUSHJ P,ALLOGC ;ALLOCATE ROOM
2520 HRRM 0,(A) ; RELATIVIZE
2521 AMTK1: AOS (P) ; A NON MARKED ITEM
2522 AMTKE: POPJ P, ;AND RETURN
2524 GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS
2529 ; MARK NON-GENERAL VECTORS
2531 NOTGEN: CAMN B,[GENERAL+<SPVP,,0>]
2532 JRST GENRAL ;YES, MARK AS A VECTOR
2533 JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK
2534 SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR
2535 HLRZS B ;ISOLATE TYPE
2538 SKIPE DUMFLG ; SKIP IF NOT IN DUMPER
2539 PUSHJ P,TYPHK ; HACK WITH TYPE IF SPECIAL
2540 POP P,E ; RESTORE LENGTH
2541 MOVE F,B ; AND COPY IT
2542 LSH B,1 ;FIND OUT WHERE IT WILL GO
2543 HRRZ B,@TYPNT ;GET SAT IN B
2545 MOVEI C,@MKTBS(B) ;POINT TO MARK SR
2546 CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE
2548 MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START
2549 PUSH P,E ;SAVE NUMBER OF ELEMENTS
2550 PUSH P,F ;AND UNIFORM TYPE
2552 UNLOOP: MOVE B,(P) ;GET TYPE
2553 MOVE A,1(C) ;AND GOODIE
2554 TLO C,400000 ;CAN'T MUNG TYPE
2555 PUSHJ P,MARK ;MARK THIS ONE
2556 MOVEM A,1(C) ; LIST FIXUP
2558 AOJA C,UNLOOP ;IF MORE, DO NEXT
2560 SUB P,[2,,2] ;REMOVE STACK CRAP
2564 SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR
2565 SUB P,[4,,4] ; REOVER
2570 ; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS
2571 ; AND UPDATES PTR TO THE TABLE.
2573 GCRDMK: PUSH P,A ; SAVE PTR TO TOP
2574 MOVEI 0,@BOTNEW ; SAVE PTR TO INF
2576 PUSHJ P,GETLNT ; GET TO D.W. AND CHECK MARKING
2577 JRST GCRDRL ; RELATIVIZE
2578 PUSH P,A ; SAVE D.W POINTER
2580 MOVE B,ABOTN ; GET TOP OF ATOM TABLE
2582 ADD B,0 ; GET BOTTOM OF ATOM TABLE
2583 GCRD1: CAMG A,B ; DON'T SKIP IF DONE
2585 HLRZ C,(A) ; GET MARKING
2586 TRZN C,400000 ; SKIP IF MARKED
2589 SUBI A,(C) ; GO BACK ONE ATOM
2591 PUSH P,A ; SAVE POINTER
2592 MOVEI C,-2(E) ; SET UP POINTER
2593 MOVEI B,TATOM ; GO TO MARK
2596 MOVEM A,1(C) ; SMASH FIXED UP ATOM BACK IN
2600 GCRD3: SUBI A,(C) ; TO NEXT ATOM
2602 GCRD2: POP P,A ; GET PTR TO D.W.
2603 POP P,E ; GET PTR TO INF
2604 SUB P,[1,,1] ; GET RID OF TOP
2605 PUSHJ P,ADPMOD ; FIX UP D.W.
2606 PUSHJ P,TRBLK ; SEND IT OUT
2607 JRST ATMREL ; RELATIVIZE AND LEAVE
2608 GCRDRL: POP P,A ; GET PTR TO D.W
2609 SUB P,[2,,2] ; GET RID OF TOP AND PTR TO INF
2610 JRST ATMREL ; RELATAVIZE
2614 ;MARK RELATAVIZED GLOC HACKS
2616 LOCRMK: SKIPE GCHAIR
2618 LOCRDP: PUSH P,C ; SAVE C
2619 MOVEI C,-2(A) ; RELATAVIZED PTR TO ATOM
2620 ADD C,GLTOP ; ADD GLOTOP TO GET TO ATOM
2621 MOVEI B,TATOM ; ITS AN ATOM
2625 SKIPN DUMFLG ; IF GC-DUMP, WILL STORE ATOM FOR LOCR
2628 IORM B,3(A) ; MUNG ATOM TO SAY IT IS LOCR
2630 LOCRDD: MOVE A,1(C) ; GET RELATIVIZATION
2631 MOVEM A,(P) ; IT STAYS THE SAVE
2634 ;MARK LOCID TYPE GOODIES
2636 LOCMK: HRRZ B,(C) ;GET TIME
2637 JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL
2638 HRRZ 0,2(A) ; GET OTHER TIME
2640 SETZB A,(P) ; NO, SMASH LOCATIVE
2641 JUMPE A,GCRET ; LEAVE IF DONE
2643 MOVEI B,TATOM ; MARK ATOM
2644 MOVEI C,-2(A) ; POINT TO ATOM
2645 MOVE E,(C) ; SEE IF BLOCK IS MARKED
2646 TLNE E,400000 ; SKIP IF MARKED
2647 JRST LOCMK2 ; SKIP OVER BLOCK
2648 SKIPN GCHAIR ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED)
2649 PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM
2651 HRRZ E,(C) ; TIME BACK
2652 MOVEI B,TVEC ; ASSUME GLOBAL
2654 MOVEI B,TTP ; ITS LOCAL
2655 PUSHJ P,MARK1 ; MARK IT
2660 ; MARK ASSOCIATION BLOCKS
2663 ASMRK1: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER
2664 PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS
2665 JRST ASTREL ; ALREADY MARKED
2666 MOVEI C,-ASOLNT-1(A) ;COPY POINTER
2667 PUSHJ P,MARK2 ;MARK ITEM CELL
2669 ADDI C,INDIC-ITEM ;POINT TO INDICATOR
2675 SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS
2677 HRRZ A,NODPNT-VAL(C) ; NEXT
2678 JUMPN A,ASMRK1 ; IF EXISTS, GO
2679 ASTREL: POP P,A ; RESTORE PTR TO ASSOCIATION
2680 MOVEI A,ASOLNT+1(A) ; POINT TO D.W.
2681 SKIPN NODPNT-ASOLNT-1(A) ; SEE IF EMPTY NODPTR
2682 JRST ASTX ; JUMP TO SEND OUT
2683 ASTR1: HRRZ E,(A) ; RELATAVIZE
2687 ASTX: HRRZ E,(A) ; GET PTR IN FRONTEIR
2688 SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING
2693 ;HERE WHEN A VECTOR POINTER IS BAD
2695 VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE
2696 SUB P,[1,,1] ; RECOVERY
2697 AFIXUP: SETZM (P) ; CLOBBER SLOT
2698 JRST GCRET ; CONTINUE
2701 VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE
2703 JRST AFIXUP ; RECOVER
2705 PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE
2706 SUB P,[1,,1] ; RECOVER
2710 \f; HERE TO MARK TEMPLATE DATA STRUCTURES
2712 TD.MRK: MOVEI 0,@BOTNEW ; SAVE PTR TO INF
2714 HLRZ B,(A) ; GET REAL SPEC TYPE
2715 ANDI B,37777 ; KILL SIGN BIT
2716 MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE
2719 HRRZS C,A ; FLUSH COUNT AND SAVE
2720 SKIPL E ; WITHIN BOUNDS
2721 FATAL BAD SAT IN AGC
2722 PUSHJ P,GETLNT ; GOODIE IS NOW MARKED
2723 JRST TMPREL ; ALREADY MARKED
2727 SUB E,TD.AGC+1 ; POINT TO LENGTH
2729 XCT (E) ; RET # OF ELEMENTS IN B
2731 HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS
2732 PUSH P,[0] ; TEMP USED IF RESTS EXIST
2734 MOVEI B,(B) ; ZAP TO ONLY LENGTH
2735 PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE
2736 PUSH P,[0] ; HOME FOR VALUES
2737 PUSH P,[0] ; SLOT FOR TEMP
2740 PUSH P,E ; SAVE FOR FINDING OTHER TABLES
2741 JUMPE D,TD.MR2 ; NO REPEATING SEQ
2742 ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ
2743 HLRE E,(E) ; E ==> - LNTH OF TEMPLATE
2744 ADDI E,(D) ; E ==> -LENGTH OF REP SEQ
2746 HRLM E,-5(P) ; SAVE IT AND BASIC
2748 TD.MR2: SKIPG D,-1(P) ; ANY LEFT?
2753 MOVE E,(E) ; POINTER TO VECTOR IN E
2754 MOVEM D,-6(P) ; SAVE ELMENT #
2755 SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST
2758 MOVEI 0,(B) ; BASIC LNT TO 0
2759 SUBI 0,(D) ; SEE IF PAST BASIC
2760 JUMPGE 0,.-3 ; JUMP IF O.K.
2761 MOVSS B ; REP LNT TO RH, BASIC TO LH
2762 IDIVI 0,(B) ; A==> -WHICH REPEATER
2764 ADD A,-5(P) ; PLUS BASIC
2765 ADDI A,1 ; AND FUDGE
2766 MOVEM A,-6(P) ; SAVE FOR PUTTER
2767 ADDI E,-1(A) ; POINT
2770 TD.MR3: ADDI E,(D) ; POINT TO SLOT
2771 XCT (E) ; GET THIS ELEMENT INTO A AND B
2772 JFCL ; NO-OP FOR ANY CASE
2773 MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT
2775 EXCH A,B ; REARRANGE
2777 MOVEI C,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG
2778 MOVSI D,400000 ; RESET FOR MARK
2779 PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A)
2780 MOVE C,-4(P) ; REGOBBLE POINTER TO TEMPLATE
2782 MOVE B,-6(P) ; RESTORE COUNT
2784 MOVE E,(E) ; POINTER TO VECTOR IN E
2785 ADDI E,(B)-1 ; POINT TO SLOT
2786 MOVE B,-3(P) ; RESTORE TYPE WORD
2788 SOS D,-1(P) ; GET ELEMENT #
2789 XCT (E) ; SMASH IT BACK
2790 FATAL TEMPLATE LOSSAGE
2791 MOVE C,-4(P) ; RESTORE POINTER IN CASE MUNGED
2794 TD.MR1: MOVE A,-8(P) ; PTR TO DOPE WORD
2795 MOVE E,-7(P) ; RESTORE PTR TO FRONTEIR
2796 SUB P,[7,,7] ; CLEAN UP STACK
2797 USRAG1: ADDI A,1 ; POINT TO SECOND D.W.
2798 MOVSI D,400000 ; SET UP MARK BIT
2800 PUSHJ P,TRBLK ; SEND IT OUT
2801 TMPREL: SUB P,[1,,1]
2805 MOVSI D,400000 ; RESTORE MARK/UNMARK BIT
2808 USRAGC: HRRZ E,(E) ; MARK THE TEMPLATE
2810 MOVE A,-1(P) ; POINTER TO D.W
2811 MOVE E,(P) ; TOINTER TO FRONTIER
2814 ; This phase attempts to remove any unwanted associations. The program
2815 ; loops through the structure marking values of associations. It can only
2816 ; stop when no new values (potential items and/or indicators) are marked.
2818 VALFLS: PUSH P,LPVP ; SAVE LPVP FOR LATER
2819 PUSH P,[0] ; INDICATE WHETHER ANY ON THIS PASS
2820 PUSH P,[0] ; OR THIS BUCKET
2821 ASOMK1: MOVE A,GCASOV ; GET VECTOR POINTER
2822 SETOM -1(P) ; INITIALIZE FLAG
2824 ASOM6: SKIPG C,(A) ; SKIP IF BUCKET TO BE SCANNED
2826 SETOM (P) ; SAY BUCKET NOT CHANGED
2828 ASOM2: MOVEI F,(C) ; COPY POINTER
2829 SKIPG ASOLNT+1(C) ; SKIP IF NOT ALREADY MARKED
2830 JRST ASOM4 ; MARKED, GO ON
2831 PUSHJ P,MARKQ ; SEE IF ITEM IS MARKED
2832 JRST ASOM3 ; IT IS NOT, IGNORE IT
2833 MOVEI F,(C) ; IN CASE CLOBBERED BY MARK2
2834 MOVEI C,INDIC(C) ; POINT TO INDICATOR SLOT
2836 JRST ASOM3 ; NOT MARKED
2838 PUSH P,A ; HERE TO MARK VALUE
2840 HLRE F,ASOLNT-INDIC+1(C) ; GET LENGTH
2841 JUMPL F,.+3 ; SKIP IF MARKED
2842 CAMGE C,VECBOT ; SKIP IF IN VECT SPACE
2844 HRRM FPTR,ASOLNT-INDIC+1(C) ; PUT IN RELATIVISATION
2845 MOVEI F,12 ; AMOUNT TO ALLOCATE IN INF
2847 HRRM 0,5(C) ; STICK IN RELOCATION
2849 ASOM20: PUSHJ P,MARK2 ; AND MARK
2850 MOVEM A,1(C) ; LIST FIX UP
2851 ADDI C,ITEM-INDIC ; POINT TO ITEM
2854 ADDI C,VAL-ITEM ; POINT TO VALUE
2857 IORM D,ASOLNT-VAL+1(C) ; MARK ASOC BLOCK
2860 AOSA -1(P) ; INDICATE A MARK TOOK PLACE
2862 ASOM3: AOS (P) ; INDICATE AN UNMARKED IN THIS BUCKET
2863 ASOM4: HRRZ C,ASOLNT-1(F) ; POINT TO NEXT IN BUCKET
2864 JUMPN C,ASOM2 ; IF NOT EMPTY, CONTINUE
2865 SKIPGE (P) ; SKIP IF ANY NOT MARKED
2866 HRROS (A) ; MARK BUCKET AS NOT INTERESTING
2867 ASOM1: AOBJN A,ASOM6 ; GO TO NEXT BUCKET
2868 TLZE TYPNT,.ATOM. ; ANY ATOMS MARKED?
2869 JRST VALFLA ; YES, CHECK VALUES
2872 ; NOW SEE WHICH CHANNELS STILL POINTED TO
2874 CHNFL3: MOVEI 0,N.CHNS-1
2875 MOVEI A,CHNL1 ; SLOTS
2876 HRLI A,TCHAN ; TYPE HERE TOO
2878 CHNFL2: SKIPN B,1(A)
2881 SUBI B,(C) ; POINT TO DOPE
2882 HLLM A,(A) ; PUT TYPE BACK
2883 HRRE F,(A) ; SEE IF ALREADY MARKED
2887 HLLOS (A) ; MARK AS A LOSER
2890 CHNFL8: MOVEI F,1 ; MARK A GOOD CHANNEL
2895 SKIPE GCHAIR ; IF NOT HAIRY CASE
2898 SKIPL -1(P) ; SKIP IF NOTHING NEW MARKED
2901 SUB P,[2,,2] ; REMOVE FLAGS
2905 ; HERE TO REEMOVE UNUSED ASSOCIATIONS
2907 MOVE A,GCASOV ; GET ASOVEC BACK FOR FLUSHES
2909 ASOFL1: SKIPN C,(A) ; SKIP IF BUCKET NOT EMPTY
2910 JRST ASOFL2 ; EMPTY BUCKET, IGNORE
2911 HRRZS (A) ; UNDO DAMAGE OF BEFORE
2913 ASOFL5: SKIPGE ASOLNT+1(C) ; SKIP IF UNMARKED
2914 JRST ASOFL6 ; MARKED, DONT FLUSH
2916 HRRZ B,ASOLNT-1(C) ; GET FORWARD POINTER
2917 HLRZ E,ASOLNT-1(C) ; AND BACK POINTER
2918 JUMPN E,ASOFL4 ; JUMP IF NO BACK POINTER (FIRST IN BUCKET)
2919 HRRZM B,(A) ; FIX BUCKET
2922 ASOFL4: HRRM B,ASOLNT-1(E) ; FIX UP PREVIOUS
2923 JUMPE B,.+2 ; JUMP IF NO NEXT POINTER
2924 HRLM E,ASOLNT-1(B) ; FIX NEXT'S BACK POINTER
2925 HRRZ B,NODPNT(C) ; SPLICE OUT THRAD
2932 ASOFL3: HRRZ C,ASOLNT-1(C) ; GO TO NEXT
2934 ASOFL2: AOBJN A,ASOFL1
2938 ; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES
2940 MOVE A,GCGBSP ; GET GLOBAL PDL
2942 GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED
2945 PUSHJ P,ZERSLT ; CLOBBER THE SLOT
2947 SVDCL: ANDCAM D,(A) ; UNMARK
2949 JUMPL A,GLOFLS ; MORE?, KEEP LOOPING
2952 LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS
2955 JUMPE A,LOCFL2 ; NONE TO FLUSH
2957 LOCFLS: SKIPGE (A) ; MARKDE?
2961 ANDCAM D,(A) ;UNMARK
2964 LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS
2966 ; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT.
2967 ; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING. IT FIXES UP THE SP-CHAIN AND IT
2968 ; SENDS OUT THE ATOMS.
2971 MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS
2972 PUSHJ P,MARK1 ; MARK THE ATOM
2973 MOVEM A,1(C) ; NEW HOME
2974 MOVEI C,2(C) ; MARK VALUE
2975 MOVEI B,TPVP ; IT IS A PROCESS VECTOR POINTER
2976 PUSHJ P,MARK1 ; MARK IT
2979 NEXPRO: MOVEI 0,TPVP ; FIX UP SLOT
2980 HLRZ A,2(R) ; GET PTR TO NEXT PROCESS
2982 HRRZ E,(A) ; ADRESS IN INF
2983 HRRZ B,(A) ; CALCULATE RELOCATION
2986 HRRZ F,A ; CALCULATE START OF TP IN F
2987 HLRZ B,(A) ; ADJUST INF PTR
2990 LDB M,[111100,,-1(A)] ; CALCULATE TOP GROWTH
2991 TRZE M,400 ; FUDGE SIGN
2994 ADD B,M ; FIX UP LENGTH
2996 SUBM M,(P) ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH
2997 MOVE M,R ; GET A COPY OF R
2998 NEXP1: HRRZ C,(M) ; GET PTR TO NEXT IN CHAIN
2999 JUMPE C,NEXP2 ; EXIT IF END OF CHAIN
3000 MOVE 0,C ; GET COPY OF CHAIN PTR TO UPDATE
3005 NEXP2: SUB P,[1,,1] ; CLEAN UP STACK
3007 HRRI B,(R) ; GET POINTER TO THIS-PROCESS BINDING
3008 MOVEI B,6(B) ; POINT AFTER THE BINDING
3009 MOVE 0,F ; CALCULATE # OF WORDS TO SEND OUT
3011 PUSH P,R ; PRESERVE R
3012 PUSHJ P,TRBLKX ; SEND IT OUT
3014 HRRZS R,2(R) ; GET THE NEXT PROCESS
3019 MOVE A,GCGBSP ; PTR TO GLOBAL STACK
3020 PUSHJ P,SPCOUT ; SEND IT OUT
3022 PUSHJ P,SPCOUT ; SEND IT OUT
3025 ; THIS ROUTINE MARKS ALL THE CHANNELS
3026 ; IT THEN SENDS OUT A COPY OF THE TVP
3028 CHFIX: MOVEI 0,N.CHNS-1
3029 MOVEI A,CHNL1 ; SLOTS
3030 HRLI A,TCHAN ; TYPE HERE TOO
3032 DHNFL2: SKIPN B,1(A)
3034 MOVEI C,(A) ; MARK THE CHANNEL
3038 MOVEM A,1(C) ; ADJUST PTR
3046 ; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR
3050 MOVEI A,1(A) ; POINT TO DOPE WORD
3051 LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR
3052 TRZE 0,400 ;KILL SIGN BIT AND SKIP IF +
3054 ASH 0,6 ;CONVERT TO NUMBER OF WORDS
3056 HRRZ E,(A) ; GET PTR TO INF
3058 TRZ B,400000 ; GET RID OF MARK BIT
3061 PUSH P,0 ; DUMMY FOR TRBLKV
3062 PUSHJ P,TRBLKV ; OUT IT GOES
3066 ASOFL6: HLRZ E,ASOLNT-1(C) ; SEE IF FIRST IN BUCKET
3067 JUMPN E,ASOFL3 ; IF NOT CONTINUE
3068 HRRZ E,ASOLNT+1(C) ; GET PTR FROM DOPE WORD
3069 SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION
3070 HRRZM E,(A) ; SMASH IT IN
3074 MARK23: PUSH P,A ; SAVE BUCKET POINTER
3080 AOS -2(P) ; MARKING HAS OCCURRED
3081 IORM D,ASOLNT+1(C) ; MARK IT
3084 \f; CHANNEL FLUSHER FOR NON HAIRY GC
3087 SETOM (P) ; RESET FOR RETRY
3094 ; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP
3096 VALFLA: MOVE C,GCGBSP ; GET POINTER TO GLOBAL STACK
3097 VALFL1: SKIPL (C) ; SKIP IF NOT MARKED
3098 PUSHJ P,MARKQ ; SEE IF ATOM IS MARKED
3101 MOVEI B,TATOM ; UPDATE ATOM SLOT
3105 AOS -2(P) ; INDICATE MARK OCCURRED
3106 HRRZ B,(C) ; GET POSSIBLE GDECL
3107 JUMPE B,VLFL10 ; NONE
3108 CAIN B,-1 ; MAINFIFEST
3113 PUSHJ P,MARK ; MARK IT
3115 HRRM A,(C) ; CLOBBER UPDATE IN
3116 VLFL10: ADD C,[2,,2] ; BUMP TO VALUE
3117 PUSHJ P,MARK2 ; MARK VALUE
3120 VALFL2: ADD C,[4,,4]
3121 JUMPL C,VALFL1 ; JUMP IF MORE
3123 HRLM LPVP,(P) ; SAVE POINTER
3124 VALFL7: MOVEI C,(LPVP)
3128 VALFL5: HRRZ C,(C) ; CHAIN
3130 MOVEI B,TATOM ; TREAT LIKE AN ATOM
3132 PUSHJ P,MARKQ1 ; NO, SEE
3134 AOS -1(P) ; MARK WILL OCCUR
3135 MOVEI B,TATOM ; RELATAVIZE
3139 ADD C,[2,,2] ; POINT TO VALUE
3140 PUSHJ P,MARK2 ; MARK VALUE
3145 VALFL4: HRRZ C,(P) ; GET SAVED LPVP
3147 HRRZ C,2(C) ; POINT TO NEXT
3151 HRRM LPVP,2(A) ; NEW PROCESS WAS MARKED
3154 ZERSLT: HRRI B,(A) ; COPY POINTER
3159 VALFL9: HLRZ LPVP,(P) ; RESTORE CHAIN
3162 \f;SUBROUTINE TO SEE IF A GOODIE IS MARKED
3163 ;RECEIVES POINTER IN C
3164 ;SKIPS IF MARKED NOT OTHERWISE
3166 MARKQ: HLRZ B,(C) ;TYPE TO B
3167 MARKQ1: MOVE E,1(C) ;DATUM TO C
3169 CAIL 0,@PURBOT ; DONT CHACK PURE
3170 JRST MKD ; ALWAYS MARKED
3171 ANDI B,TYPMSK ; FLUSH MONITORS
3173 HRRZ B,@TYPNT ;GOBBLE SAT
3175 CAIG B,NUMSAT ; SKIP FOR TEMPLATE
3176 JRST @MQTBS(B) ;DISPATCH
3177 ANDI E,-1 ; FLUSH REST HACKS
3185 DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
3186 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ]
3187 [SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ]
3188 [SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ]
3189 [SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]]
3193 PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED
3194 SKIPL (E) ; SKIP IF MARKED
3200 BYTMQ: PUSH P,A ; SAVE A
3201 PUSHJ P,BYTDOP ; GET PTR TO DOPE WORD
3202 MOVE E,A ; COPY POINTER
3204 SKIPGE (E) ; SKIP IF NOT MARKED
3208 FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD
3211 ATMMQ: CAML 0,GCSBOT ; ALWAYS KEEP FROZEN ATOMS
3216 VECMQ: HLRE 0,E ;GET LENGTH
3217 SUB E,0 ;POINT TO DOPE WORDS
3219 VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED
3220 AOS (P) ;MARKED, CAUSE SKIP RETURN
3226 LOCMQ: HRRZ 0,(C) ; GET TIME
3227 JUMPE 0,VECMQ ; GLOBAL, LIKE VECTOR
3228 HLRE 0,E ; FIND DOPE
3230 MOVEI E,1(E) ; POINT TO LAST DOPE
3231 CAMN E,TPGROW ; GROWING?
3232 SOJA E,VECMQ1 ; YES, CHECK
3233 ADDI E,PDLBUF ; FUDGE
3238 OFFSMQ: HLRZS E ; POINT TO LIST STRUCTURE
3239 SKIPGE (E) ; MARKED?
3243 \f; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF
3245 ASSOUP: MOVE A,GCNOD ; RECOVER PTR TO START OF CHAIN
3246 ASSOP1: HRRZ B,NODPNT(A)
3247 PUSH P,B ; SAVE NEXT ON CHAIN
3249 HRRZ B,ASOLNT-1(A) ;POINT TO NEXT
3251 HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C
3252 SUBI C,ASOLNT+1(B) ; RELATIVIZE
3253 ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED POINTER
3254 ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER
3256 HRRZ F,ASOLNT+1(B) ;AND ITS RELOCATION
3257 SUBI F,ASOLNT+1(B) ; RELATIVIZE
3259 ADDM F,ASOLNT-1(A) ;RELOCATE
3260 ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN
3262 HRRZ C,ASOLNT+1(B) ;GET RELOC
3263 SUBI C,ASOLNT+1(B) ; RELATIVIZE
3264 ADDM C,NODPNT(A) ;AND UPDATE
3265 ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER
3267 HRRZ F,ASOLNT+1(B) ;RELOC
3271 ASOUP5: POP P,A ; RECOVER PTR TO DOPE WORD
3273 MOVSI B,400000 ;UNMARK IT
3275 HRRZ E,(A) ; SET UP PTR TO INF
3277 SUBI E,-1(B) ; ADJUST PTR
3279 PUSHJ P,TRBLK ; OUT IT GOES
3280 POP P,A ; RECOVER PTR TO ASSOCIATION
3281 JUMPN A,ASSOP1 ; IF NOT ZERO CONTINUP
3285 ; HERE TO CLEAN UP ATOM HASH TABLE
3287 ATCLEA: MOVE A,GCHSHT ; GET TABLE POINTER
3290 SKIPE C,(A) ; GET NEXT
3291 JRST ATCLE2 ; GOT ONE
3293 ATCLE3: PUSHJ P,OUTATM
3296 MOVE A,GCHSHT ; MOVE OUT TABLE
3304 ATCLE5: CAIL C,HIBOT
3306 CAMG C,VECBOT ; FROZEN ATOMS ALWAYS MARKED
3308 SKIPL 1(C) ; SKIP IF ATOM MARKED
3311 HRRZ 0,1(C) ; GET DESTINATION
3312 CAIN 0,-1 ; FROZEN/MAGIC ATOM
3313 MOVEI 0,1(C) ; USE CURRENT POSN
3314 SUBI 0,1 ; POINT TO CORRECT DOPE
3315 JUMPN B,ATCLE7 ; JUMP IF GOES INTO ATOM
3317 HRRZM 0,(A) ; INTO HASH TABLE
3320 ATCLE7: HRLM 0,2(B) ; INTO PREV ATOM
3324 ANDI B,377777 ; KILL MARK BIT
3329 JUMPE C,ATCLE3 ; DONE WITH BUCKET
3332 ; HERE TO PASS OVER LOST ATOM
3334 ATCLE6: HLRZ F,1(C) ; FIND NEXT ATOM
3344 OUTATM: JUMPE B,CPOPJ
3349 MOVSI D,400000 ;UNMARK IT
3351 HRRZ E,1(A) ; SET UP PTR TO INF
3353 SUBI E,-1(B) ; ADJUST PTR
3356 PUSHJ P,TRBLK ; OUT IT GOES
3358 POP P,A ; RECOVER PTR TO ASSOCIATION
3362 VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH
3365 ; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC
3367 MSGGCT: [ASCIZ /USER CALLED- /]
3368 [ASCIZ /FREE STORAGE- /]
3369 [ASCIZ /TP-STACK- /]
3370 [ASCIZ /TOP-LEVEL LOCALS- /]
3371 [ASCIZ /GLOBAL VALUES- /]
3373 [ASCIZ /STATIONARY IMPURE STORAGE- /]
3375 [ASCIZ /BOTH STACKS BLOWN- /]
3376 [ASCIZ /PURE STORAGE- /]
3377 [ASCIZ /GC-RCALL- /]
3379 ; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC
3384 MSGGFT: [ASCIZ /GC-READ /]
3392 [ASCIZ /PURE-PAGE LOADER /]
3394 [ASCIZ /INTERRUPT-HANDLER /]
3398 .GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL
3399 .GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX
3400 .GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP
3401 .GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB
3402 .GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG
3403 .GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN
3404 .GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR
3412 ; LOCACTIONS USED BY THE PAGE HACKER
3414 DOPSV1: 0 ;SAVED FIRST D.W.
3415 DOPSV2: 0 ; SAVED LENGTH
3418 ; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS.
3421 GCNO: 0 ; USER-CALLED GC
3422 BSTGC: 0 ; FREE STORAGE
3429 0 ; BOTH STATCKS BLOWN
3433 NOWFRE: 0 ; FREE STORAGE FROM LAST GC
3434 CURFRE: 0 ; STORAGE USED SINCE LAST GC
3435 MAXFRE: 0 ; MAXIMUM FREE STORAGE ALLOCATED
3436 USEFRE: 0 ; TOTAL FREE STORAGE USED
3437 NOWTP: 0 ; TP LENGTH FROM LAST GC
3438 CURTP: 0 ; # WORDS ON TP
3439 CTPMX: 0 ; MAXIMUM SIZE OF TP SO FAR
3440 NOWLVL: 0 ; # OF TOP-LEVEL LVAL-SLOTS
3441 CURLVL: 0 ; # OF TOP-LEVEL LVALS
3442 NOWGVL: 0 ; # OF GVAL SLOTS
3443 CURGVL: 0 ; # OF GVALS
3444 NOWTYP: 0 ; SIZE OF TYPE-VECTOR
3445 CURTYP: 0 ; # OF TYPES
3446 NOWSTO: 0 ; SIZE OF STATIONARY STORAGE
3447 CURSTO: 0 ; STATIONARY STORAGE IN USE
3448 CURMAX: 0 ; MAXIMUM BLOCK OF CONTIGUOUS STORAGE
3449 NOWP: 0 ; SIZE OF P-STACK
3450 CURP: 0 ; #WORDS ON P
3451 CPMX: 0 ; MAXIMUM P-STACK LENGTH SO FAR
3452 GCCAUS: 0 ; INDICATOR FOR CAUSE OF GC
3453 GCCALL: 0 ; INDICATOR FOR CALLER OF GC
3456 ; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW
3457 LVLINC: 6 ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS
3458 GVLINC: 4 ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS
3459 TYPIC: 1 ; TYPE INCREMENT ASSUMED TO BE 32 TYPES
3460 STORIC: 2000 ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE)
3463 RCL: 0 ; POINTER TO LIST OF RECYCLEABLE LIST CELLS
3464 RCLV: 0 ; POINTER TO RECYCLED VECTORS
3465 GCMONF: 0 ; NON-ZERO SAY GIN/GOUT
3466 GCDANG: 0 ; NON-ZERO, STORAGE IS LOW
3467 INBLOT: 0 ; INDICATE THAT WE ARE RUNNING OIN A BLOAT
3468 GETNUM: 0 ;NO OF WORDS TO GET
3470 RPTOP: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY
3471 CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY
3472 NGCS: 8 ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS
3474 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
3475 ;AND WHEN IT WILL GET UNHAPPY
3477 FREMIN: 20000 ;MINIMUM FREE WORDS
3479 ;POINTER TO GROWING PDL
3481 TPGROW: 0 ;POINTS TO A BLOWN TP
3482 PPGROW: 0 ;POINTS TO A BLOWN PP
3483 PGROW: 0 ;POINTS TO A BLOWN P
3488 GCFLCH: 0 ; TELL INT HANDLER TO ITIC CHARS
3489 GCHAIR: 1 ; COUNTS GCS AND TELLS WHEN TO HAIRIFY
3490 GCDOWN: 0 ; AMOUNT TO TRY AND MOVE DOWN
3491 CURPLN: 0 ; LENGTH OF CURRENTLY RUNNING PURE RSUBR
3492 PURMIN: 0 ; MINIMUM PURE STORAGE
3494 ; VARS ASSOCIATED WITH BLOAT LOGIC
3495 PMIN: 200 ; MINIMUM FOR PSTACK
3496 PGOOD: 1000 ; GOOD SIZE FOR PSTACK
3497 PMAX: 4000 ; MAX SIZE FOR PSTACK
3498 TPMIN: 1000 ; MINIMUM SIZE FOR TP
3499 TPGOOD: NTPGOO ; GOOD SIZE OF TP
3500 TPMAX: NTPMAX ; MAX SIZE OF TP
3506 ; VARS FOR PAGE WINDOW HACKS
3508 GCHSHT: 0 ; SAVED ATOM TABLE
3509 PURSVT: 0 ; SAVED PURVEC TABLE
3510 GLTOP: 0 ; SAVE GLOTOP
3511 GCNOD: 0 ; PTR TO START OF ASSOCIATION CHAIN
3512 GCGBSP: 0 ; SAVED GLOBAL SP
3513 GCASOV: 0 ; SAVED PTR TO ASSOCIATION VECTOR
3514 GCATM: 0 ; PTR TO IMQUOT THIS-PROCESS
3515 FNTBOT: 0 ; BOTTOM OF FRONTEIR
3516 WNDBOT: 0 ; BOTTOM OF WINDOW
3518 BOTNEW: (FPTR) ; POINTER TO FRONTIER
3520 NPARBO: 0 ; SAVED PARBOT
3522 ; FLAGS TO INDICATE DUMPER IS IN USE
3524 GPURFL: 0 ; INDICATE PURIFIER IS RUNNING
3525 GCDFLG: 0 ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING
3526 DUMFLG: 0 ; FLAG INDICATING DUMPER IS RUNNING
3528 ; CONSTANTS FOR DUMPER,READER AND PURIFYER
3530 ABOTN: 0 ; COUNTER FOR ATOMS
3531 NABOTN: 0 ; POINTER USED BY PURIFY
3532 OGCSTP: 0 ; CONTAINS OLD GCSTOP FOR READER
3533 MAPUP: 0 ; BEGINNING OF MAPPED UP PURE STUFF
3534 SAVRES: 0 ; SAVED UPDATED ITEM OF PURIFIER
3535 SAVRE2: 0 ; SAVED TYPE WORD
3536 SAVRS1: 0 ; SAVED PTR TO OBJECT
3537 INF1: 0 ; AOBJN PTR USED IN CREATING PROTECTION INF
3538 INF2: 0 ; AOBJN PTR USED IN CREATING SECOND INF
3539 INF3: 0 ; AOBJN PTR USED TO PURIFY A STRUCTURE
3541 ; VARIABLES USED BY GC INTERRUPT HANDLER
3543 GCHPN: 0 ; SET TO -1 EVERYTIME A GC HAS OCCURED
3544 GCKNUM: 0 ; NUMBER OF WORDS OF REQUEST TO INTERRUPT
3546 ; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN
3550 ; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES
3552 TYPTAB: 0 ; POINTER TO TYPE TABLE
3553 NNPRI: 0 ; NUMPRI FROM DUMPED OBJECT
3554 NNSAT: 0 ; NUMSAT FROM DUMPED OBJECT
3555 TYPSAV: 0 ; SAVE PTR TO TYPE VECTOR
3557 ; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING
3559 BUFGC: 0 ; BUFFER FOR COPY ON WRITE HACKING
3560 PURMNG: 0 ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP
3561 RPURBT: 0 ; SAVED VALUE OF PURTOP
3562 RGCSTP: 0 ; SAVED GCSTOP
3564 ; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO
3566 INCORF: 0 ; INDICATION OF UVECTOR HACKS FOR GC-DUMP
3567 PURCOR: 0 ; INDICATION OF UVECTOR TO PURE CORE
3571 PLODR: 0 ; INDICATE A PLOAD IS IN OPERATION
3574 ; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR
3576 MAXLEN: 0 ; MAXIMUM RECLAIMED SLOT
3612 .LOP <ASH @> WIND <,-10.>
3615 .LOP <ASH @> FRONT <,-10.>
3619 .LOP <ASH @> ZZ2 <,-10.>
3622 .LOP <ASH @> LENGC <,10.>
3625 .LOP <ASH @> AGCLD <,-10.>