--- /dev/null
+TITLE AGC MUDDLE GARBAGE COLLECTOR\r
+\r
+;SYSTEM WIDE DEFINITIONS GO HERE\r
+\r
+.GLOBAL RCL,VECTOP,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG\r
+.GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR\r
+.GLOBAL PGROW,TPGROW,TIMOUT,MAINPR,%SLEEP,MSGTYP,PURTOP,PURBOT,STOSTR\r
+.GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,SYSMAX,FREDIF,FREMIN,GCHAPN,INTFLG\r
+.GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2\r
+.GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS\r
+.GLOBAL SPBASE,OUTRNG,CISTNG,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1\r
+.GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,%GCJOB,%SHWND,%SHFNT,%INFMP,%GETIP\r
+.GLOBAL TD.PUT,TD.GET,TD.LNT\r
+.GLOBAL CTIME,MTYO,ILOC,GCRSET\r
+.GLOBAL GCTIM,GCCAUS,GCCALL,AAGC,LVLINC,STORIC,GVLINC,TYPIC\r
+; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR\r
+\r
+.GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS\r
+.GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE\r
+\r
+.GLOBAL P.TOP,P.CORE,PMAP\r
+\r
+NGCS==8 ; AFTER NGCS, DO HAIRY VAL/ASSOC FLUSH\r
+PDLBUF=100\r
+TPMAX==20000 ;PDLS LARGER THAN THIS WILL BE SHRUNK\r
+PMAX==4000 ;MAXIMUM PSTACK SIZE\r
+TPMIN==1000 ;MINIMUM PDL SIZES\r
+PMIN==400\r
+TPGOOD==10000 ; A GOOD STACK SIZE\r
+PGOOD==1000\r
+.ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC)\r
+\r
+GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR\r
+STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT\r
+STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT\r
+\r
+\r
+RELOCATABLE\r
+.INSRT MUDDLE >\r
+\r
+TYPNT=AB ;SPECIAL AC USAGE DURING GC\r
+F=TP ;ALSO SPECIAL DURING GC\r
+LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN\r
+FPTR=TB ; POINT TO CURRENT FRONTIER OF INFERIOR\r
+\r
+\r
+; WINDOW AND FRONTIER PAGES\r
+\r
+FRONT==776000 ; PAGE 255. IS FRONTIER\r
+WIND==774000 ; PAGE 254. IS WINDOW\r
+FRNP==FRONT/2000\r
+WNDP==WIND/2000\r
+\r
+\r
+\r
+\r
+\r
+\f\r
+.GLOBAL FLIST\r
+\r
+MFUNCTION BLOATSTAT,SUBR,[BLOAT-STAT]\r
+\r
+ENTRY\r
+\r
+ JUMPGE AB,GETUVC ; SEE IF THERE IS AN ARGUMENT\r
+ GETYP A,(AB)\r
+ CAIE A,TUVEC ; SEE IF THE ARGUMENT IS A UVECTOR\r
+ JRST WTYP1 ; IF NOT COMPLAIN\r
+ HLRE 0,1(AB)\r
+ MOVNS 0\r
+ CAIGE 0,STATNO+STATGC ; SEE IF UVECTOR IS RIGHT LENGTH\r
+ JRST WTYP1\r
+ CAMGE AB,[-2,,0] ; SEE IF THERE ARE TOO MANY ARGUMENTS\r
+ JRST TMA\r
+ MOVE A,(AB) ; GET THE UVECTOR\r
+ MOVE B,1(AB)\r
+ JRST SETUV ; CONTINUE\r
+GETUVC: MOVEI A,STATNO+STATGC ; CREATE A UVECTOR\r
+ PUSHJ P,IBLOCK\r
+SETUV: PUSH P,A ; SAVE UVECTOR\r
+ PUSH P,B\r
+ MOVE 0,NOWFRE ; COMPUTE FREE STORAGE USED SINCE LAST GC\r
+ SUB 0,VECBOT\r
+ ADD 0,PARTOP\r
+ MOVEM 0,CURFRE\r
+ HLRE 0,TP ; COMPUTE STACK SPACE USED UP\r
+ ADD 0,NOWTP\r
+ SUBI 0,PDLBUF\r
+ MOVEM 0,CURTP\r
+ MOVE B,IMQUOTE THIS-PROCESS\r
+ PUSHJ P,ILOC\r
+ HRRZS B\r
+ HRRZ C,TPBASE+1(PVP) ; CALCULATE # OF ATOM SLOTS\r
+ MOVE 0,B\r
+ HRRZ D,SPBASE+1(PVP) ; COMPUTE CURRENT # OF BINDINGS\r
+ SUB 0,D\r
+ IDIVI 0,6\r
+ MOVEM 0,CURLVL\r
+ SUB B,C ; TOTAL WORDS ATOM STORAGE\r
+ IDIVI B,6 ; COMPUTE # OF SLOTS\r
+ MOVEM B,NOWLVL\r
+ HRRZ A,GLOBASE+1(TVP) ; COMPUTE TOTAL # OF GLOBAL SLOTS\r
+ HLRE 0,GLOBASE+1(TVP)\r
+ SUB A,0 ; POINT TO DOPE WORD\r
+ HLRZ B,1(A)\r
+ ASH B,-2 ; # OF GVAL SLOTS\r
+ MOVEM B,NOWGVL\r
+ HRRZ 0,GLOBASE+1(TVP) ; COMPUTE # OF GVAL SLOTS IN USE\r
+ HRRZ A,GLOBSP+1(TVP)\r
+ SUB A,0\r
+ ASH A,-2 ; NEGATIVE # OF SLOTS USED\r
+ SUBI B,(A)\r
+ MOVEM B,CURGVL\r
+ HRRZ A,TYPBOT+1(TVP) ; GET LENGTH OF TYPE VECTOR\r
+ HLRE 0,TYPBOT+1(TVP)\r
+ SUB A,0\r
+ HLRZ B,1(A) ; # OF WORDS IN TYPE-VECTOR\r
+ IDIVI B,2 ; CONVERT TO # OF TYPES\r
+ MOVEM B,NOWTYP\r
+ HLRE 0,TYPVEC+1(TVP) ; LENGTH OF VISABLE TYPE-VECTOR\r
+ MOVNS 0\r
+ IDIVI 0,2 ; GET # OF TYPES\r
+ MOVEM 0,CURTYP\r
+ MOVE 0,CODTOP ; GET LENGTH OF STATIONARY IMPURE STORAGE\r
+ MOVEM 0,NOWSTO\r
+ SETZB B,D ; ZERO OUT MAXIMUM\r
+ HRRZ C,FLIST\r
+LOOPC: HLRZ 0,(C) ; GET BLK LENGTH\r
+ ADD D,0 ; ADD # OF WORDS IN BLOCK\r
+ CAMGE B,0 ; SEE IF NEW MAXIMUM\r
+ MOVE B,0\r
+ HRRZ C,(C) ; POINT TO NEXT BLOCK\r
+ JUMPN C,LOOPC ; REPEAT\r
+ MOVEM D,CURSTO\r
+ MOVEM B,CURMAX\r
+ HLRE 0,P ; GET AMOUNT OF ROOM LEFT ON P\r
+ ADD 0,NOWP\r
+ SUBI 0,PDLBUF\r
+ MOVEM 0,CURP\r
+ PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS\r
+ MOVSI C,BSTGC ; SET UP BLT FOR GC FIGURES\r
+ HRRZ B,(P) ; RESTORE B\r
+ HRR C,B\r
+ BLT C,(B)STATGC-1\r
+ HRLI C,BSTAT ; MODIFY BLT FOR STATS\r
+ ADDI C,STATGC ; B HAS ELEMENTS\r
+ BLT C,(B)STATGC+STATNO-1\r
+ MOVEI 0,TFIX\r
+ HRLM 0,(B)STATNO+STATGC ; MOVE IN UTYPE\r
+ POP P,B\r
+ POP P,A ; RESTORE TYPE-WORD\r
+ JRST FINIS\r
+\r
+\r
+; THIS IS THE SCHEME USED TO UPDATE CERTAIN IMFORMATION USED BY THE\r
+; BLOAT-SPEC ROUTINE TO GIVE USERS IMFORMATION ABOUT USE OF SPACE BY\r
+; THEIR MUDDLE.\r
+\r
+GCRSET: SETZM GCNO ; CALL FROM INIT, ZAP ALL 1ST\r
+ MOVE 0,[GCNO,,GCNO+1]\r
+ BLT 0,GCCALL\r
+\r
+GCSET: MOVE A,VECBOT ; COMPUTE FREE SPACE AVAILABLE\r
+ SUB A,PARTOP\r
+ MOVEM A,NOWFRE\r
+ CAMLE A,MAXFRE\r
+ MOVEM A,MAXFRE ; MODIFY MAXIMUM\r
+ HLRE A,TP ; FIND THE DOPE WORD OF THE TP STACK\r
+ MOVNS A\r
+ ADDI A,1(TP) ; CLOSE TO DOPE WORD\r
+ CAME A,TPGROW\r
+ ADDI A,PDLBUF ; NOW AT REAL DOPE WORD\r
+ HLRZ B,(A) ; GET LENGTH OF TP-STACK\r
+ MOVEM B,NOWTP\r
+ CAMLE B,CTPMX ; SEE IF THIS IS THE BIGGEST TP\r
+ MOVEM B,CTPMX\r
+ HLRE B,P ; FIND DOPE WORD OF P-STACK\r
+ MOVNS B\r
+ ADDI B,1(P) ; CLOSE TO IT\r
+ CAME B,PGROW ; SEE IF THE STACK IS BLOWN\r
+ ADDI B,PDLBUF ; POINTING TO IT\r
+ HLRZ A,(B) ; GET IN LENGTH\r
+ MOVEM A,NOWP\r
+ CAMLE A,CPMX ; SEE IF WE HAVE THE BIGGEST P STACK\r
+ MOVEM A,CPMX\r
+ POPJ P, ; EXIT\r
+\r
+\r
+.GLOBAL PGFIND,PGGIVE,PGTAKE,PGINT\r
+\r
+; FIND AND ALLOCATE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A\r
+; RETURN THE NUMBER (0-255.) OF THE FIRST SUCH PAGE IN REG B\r
+; RETURN -1 IN REG B IF NONE FOUND\r
+\r
+PGFIND:\r
+ JUMPLE A,FPLOSS\r
+ PUSHJ P,PGFND1 ; SEE IF ALREADY ENOUGH\r
+ SKIPL B ; SKIP IF LOST\r
+ POPJ P,\r
+\r
+ SUBM M,(P)\r
+ PUSH P,E\r
+ PUSH P,C\r
+ PUSH P,D\r
+ MOVE C,PURBOT ; CHECK IF ROOM AT ALL\r
+ SUB C,P.TOP ; TOTAL SPACE\r
+ MOVEI D,(C) ; COPY FOR CONVERSION TO PAGES\r
+ ASH D,-10.\r
+ CAIGE C,(A) ; SKIP IF COULD WIN\r
+ JRST PGFLOS\r
+\r
+ MOVNS A ; MOVE PURE AREA DOWN "A" PAGES\r
+ PUSHJ P,MOVPUR\r
+ MOVE B,PURTOP ; GET FIRST PAGE ALLOCATED\r
+ ASH B,-10. ; TO PAGE #\r
+PGFLOS: POP P,D\r
+ POP P,C\r
+ POP P,E\r
+ PUSHJ P,RBLDM ; GET A NEW VALUE FOR M\r
+ JRST MPOPJ\r
+\r
+PGFND1: PUSH P,E\r
+ PUSH P,D\r
+ PUSH P,C\r
+ PUSH P,[-1] ;POSSIBLE CONTENTS FOR REG B\r
+ PUSH P,A ;SAVE LENGTH OF BLOCK DESIRED FOR LATER USE\r
+ SETZB B,C ;INITIAL SECTION AND PAGE NUMBERS\r
+ MOVEI 0,0 ;COUNT OF PAGES ALREADY FOUND\r
+ PUSHJ P,PINIT\r
+PLOOP: TDNE E,D ;FREE PAGE ?\r
+ JRST NOTFRE ;NO\r
+ JUMPN 0,NFIRST ;FIRST FREE PAGE OF A BLOCK ?\r
+ MOVEI A,(B) ;YES SAVE ADDRESS OF PAGE IN REG A\r
+ IMULI A,32.\r
+ ADDI A,(C)\r
+NFIRST: ADDI 0,1\r
+ CAML 0,(P) ;TEST IF ENOUGH PAGES HAVE BEEN FOUND\r
+ JRST PWIN ;YES, FINISHED\r
+ SKIPA \r
+NOTFRE: MOVEI 0,0 ;RESET COUNT\r
+ PUSHJ P,PNEXT ;NEXT PAGE\r
+ JRST PLOSE ;NONE--LOSE RETURNING -1 IN REG B\r
+ JRST PLOOP\r
+\r
+PWIN: MOVEI B,(A) ;GET WINNING ADDRESS\r
+ MOVEM B,(P)-1 ;RETURN ADDRESS OF WINNING PAGE\r
+ MOVE A,(P) ;RELOAD LENGTH OF BLOCK OF PAGES\r
+ MOVE 0,[TDO E,D] ;INST TO SET "BUSY" BITS\r
+ JRST ITAKE\r
+\r
+;CLAIM OR RETURN TO FREE STORAGE AS MANY CONTIGUOUS PAGES AS INDICATED BY REG A\r
+;THE NUMBER (0 - 255.) OF THE FIRST SUCH PAGE IS IN REG B\r
+PGGIVE: MOVE 0,[TDZ E,D] ;INST TO SET "FREE" BITS\r
+ SKIPA\r
+PGTAKE: MOVE 0,[TDO E,D] ;INST TO SET "BUSY" BITS\r
+ JUMPLE A,FPLOSS\r
+ CAIL B,0\r
+ CAILE B,255.\r
+ JRST FPLOSS\r
+ PUSH P,E\r
+ PUSH P,D\r
+ PUSH P,C\r
+ PUSH P,B\r
+ PUSH P,A\r
+ITAKE: IDIVI B,32.\r
+ PUSHJ P,PINIT\r
+ SUBI A,1\r
+RTL: XCT 0 ;SET APPROPRIATE BIT\r
+ PUSHJ P,PNEXT ;NEXT PAGE'S BIT\r
+ JUMPG A,FPLOSS ;TOO MANY ?\r
+ SOJGE A,RTL\r
+ MOVEM E,PMAP(B) ;REPLACE BIT MASK\r
+PLOSE: POP P,A\r
+ POP P,B\r
+ POP P,C\r
+ POP P,D\r
+ POP P,E\r
+ POPJ P,\r
+\r
+\r
+PINIT: MOVE E,PMAP(B) ;GET BITS FOR THIS SECTION\r
+ HRLZI D,400000 ;BIT MASK\r
+ MOVNS C\r
+ LSH D,(C) ;SHIFT TO APPROPRIATE BIT POSITION\r
+ MOVNS C\r
+ POPJ P,\r
+\r
+PNEXT: AOS (P) ;FOR SKIP RETURN ON EXPECTED SUCCESS\r
+ LSH D,-1 ;CONSIDER NEXT PAGE\r
+ CAIGE C,31. ;FINISHED WITH THIS SECTION ?\r
+ AOJA C,CPOPJ ;NO, INCREMENT AND CONTINUE\r
+ MOVEM E,PMAP(B) ;REPLACE BIT MASK\r
+ SETZ C,\r
+ CAIGE B,7. ;LAST SECTION ?\r
+ AOJA B,PINIT ;NO, INCREMENT AND CONTINUE\r
+ SOS (P) ;YES, UNDO SKIP RETURN\r
+ POPJ P,\r
+\r
+FPLOSS: FATAL PAGE LOSSAGE\r
+\r
+PGINT: MOVEI B,HIBOT ;INITIALIZE MUDDLE'S PAGE MAP TABLE\r
+ IDIVI B,2000 ;FIRST PAGE OF PURE CODE\r
+ MOVE C,HITOP\r
+ IDIVI C,2000\r
+ MOVEI A,(C)+1\r
+ SUBI A,(B) ;NUMBER OF SUCH PAGES\r
+ PUSHJ P,PGTAKE ;MARK THESE PAGES AS TAKEN\r
+ POPJ P,\r
+; USER GARBAGE COLLECTOR INTERFACE\r
+\r
+MFUNCTION GC,SUBR\r
+ ENTRY\r
+\r
+ JUMPGE AB,GC1\r
+ CAMGE AB,[-4,,0]\r
+ JRST TMA\r
+ PUSHJ P,GETFIX ; GET FREEE MIN IF GIVEN\r
+ MOVEM A,FREMIN\r
+ ADD AB,[2,,2] ; NEXT ARG\r
+ JUMPGE AB,GC1 ; NOT SUPPLIED\r
+ PUSHJ P,GETFIX ; GET FREDIF\r
+ MOVEM A,FREDIF\r
+GC1: PUSHJ P,COMPRM ; GET CURRENT USED CORE\r
+ PUSH P,A\r
+ MOVEI A,1\r
+ MOVEM A,GCHAIR ; FORCE FLUSH OF VALS ASSOCS\r
+ MOVE C,[11,,0] ; INDICATOR FOR AGC\r
+ PUSHJ P,AGC ; COLLECT THAT TRASH\r
+ SKIPGE A ; SKIP IF OK\r
+ PUSHJ P,FULLOS ; COMPLAIN ABOUT LACK OF SPACE\r
+ PUSHJ P,COMPRM ; HOW MUCH ROOM NOW?\r
+ POP P,B ; RETURN AMOUNT\r
+ SUB B,A\r
+ MOVSI A,TFIX\r
+ JRST FINIS\r
+\r
+\r
+COMPRM: MOVE A,PARTOP ; USED SPACE\r
+ SUB A,PARBOT\r
+ ADD A,VECTOP\r
+ SUB A,VECBOT\r
+ POPJ P,\r
+\r
+MFUNCTION GCDMON,SUBR,[GC-MON]\r
+\r
+ ENTRY 1\r
+\r
+ SETZM GCMONF ; ASSUME FALSE\r
+ GETYP 0,(AB)\r
+ CAIE 0,TFALSE\r
+ SETOM GCMONF\r
+ MOVE A,(AB)\r
+ MOVE B,1(AB)\r
+ JRST FINIS\r
+.GLOBAL EVATYP,APLTYP,PRNTYP\r
+\r
+\fMFUNCTION BLOAT,SUBR\r
+ ENTRY\r
+\r
+ MOVEI C,0 ; FLAG TO SAY WHETHER NEED A GC\r
+ MOVSI E,-NBLO ; AOBJN TO BLOATER TABLE\r
+\r
+BLOAT2: JUMPGE AB,BLOAT1 ; ALL DONE?\r
+ PUSHJ P,NXTFIX ; GET NEXT BLOAT PARAM\r
+ PUSHJ P,@BLOATER(E) ; DISPATCH\r
+ AOBJN E,BLOAT2 ; COUNT PARAMS SET\r
+\r
+ JUMPL AB,TMA ; ANY LEFT...ERROR\r
+BLOAT1: JUMPE C,BLOATD ; DONE, NO GC NEEDED\r
+ MOVEI 0,1\r
+ MOVEM 0,GCHAIR ; FORCE HAIR TO OCCUR\r
+ MOVE C,E ; MOVE IN INDICATOR\r
+ HRLI C,1 ; INDICATE THAT IT COMES FROM BLOAT\r
+ PUSHJ P,AGC ; DO ONE\r
+ SKIPGE A\r
+ PUSHJ P,FULLOS ; NO CORE LEFT\r
+ SKIPE A,TPBINC ; SMASH POINNTERS\r
+ ADDM A,TPBASE+1(PVP)\r
+ SKIPE A,GLBINC ; GLOBAL SP\r
+ ADDM A,GLOBASE+1(TVP)\r
+ SKIPE A,TYPINC\r
+ ADDM A,TYPBOT+1(TVP)\r
+ SETZM TPBINC ; RESET PARAMS\r
+ SETZM GLBINC\r
+ SETZM TYPINC\r
+\r
+BLOATD: MOVE B,VECBOT\r
+ SUB B,PARTOP\r
+ MOVSI A,TFIX ; RETURN CORE FOUND\r
+ JRST FINIS\r
+\r
+; TABLE OF BLOAT ROUTINES\r
+\r
+BLOATER:\r
+ MAINB\r
+ TPBLO\r
+ LOBLO\r
+ GLBLO\r
+ TYBLO\r
+ STBLO\r
+ PBLO\r
+ SFREM\r
+ SFRED\r
+ SLVL\r
+ SGVL\r
+ STYP\r
+ SSTO\r
+ NBLO==.-BLOATER\r
+\r
+; BLOAT MAIN STORAGE AREA\r
+\r
+MAINB: MOVE D,VECBOT ; COMPUTE CURRENT ROOM\r
+ SUB D,PARTOP\r
+ CAMGE A,D ; NEED MORE?\r
+ POPJ P, ; NO, LEAVE\r
+ MOVEM A,GETNUM ; SAVE\r
+ AOJA C,CPOPJ ; LEAVE SETTING C\r
+\r
+; BLOAT TP STACK (AT TOP)\r
+\r
+TPBLO: HLRE D,TP ; GET -SIZE\r
+ MOVNS B,D\r
+ ADDI D,1(TP) ; POINT TO DOPE (ALMOST)\r
+ CAME D,TPGROW ; BLOWN?\r
+ ADDI D,PDLBUF ; POINT TO REAL DOPE WORD\r
+ CAMG A,B ; SKIP IF GROWTH NEEDED\r
+ POPJ P,\r
+ ASH A,-6 ; CONVERT TO 64 WD BLOCKS\r
+ CAILE A,377\r
+ JRST OUTRNG\r
+ DPB A,[111100,,-1(D)] ; SMASH SPECS IN\r
+ AOJA C,CPOPJ\r
+\r
+; BLOAT TOP LEVEL LOCALS\r
+\r
+LOBLO: IMULI A,6 ; 6 WORDS PER BINDING\r
+ HRRZ 0,TPBASE+1(PVP)\r
+ HRRZ B,SPBASE+1(PVP) ; ROOM AVAIL TO E\r
+ SUB B,0\r
+ SUBI A,(B) ; HOW MUCH MORE?\r
+ JUMPLE A,CPOPJ ; NONE NEEDED\r
+ MOVEI B,TPBINC\r
+ PUSHJ P,NUMADJ\r
+ DPB A,[1100,,-1(D)] ; SMASH\r
+ AOJA C,CPOPJ\r
+\r
+; GLOBAL SLOT GROWER\r
+\r
+GLBLO: ASH A,2 ; 4 WORDS PER VAR\r
+ MOVE D,GLOBASE+1(TVP) ; CURRENT LIMITS\r
+ HRRZ B,GLOBSP+1(TVP)\r
+ SUBI B,(D)\r
+ SUBI A,(B) ; NEW AMOUNT NEEDED\r
+ JUMPLE A,CPOPJ\r
+ MOVEI B,GLBINC ; WHERE TO KEEP UPDATE\r
+ PUSHJ P,NUMADJ ; FIX NUMBER\r
+ HLRE 0,D\r
+ SUB D,0 ; POINT TO DOPE\r
+ DPB A,[1100,,(D)] ; AND SMASH\r
+ AOJA C,CPOPJ\r
+\r
+; HERE TO GROW TYPE VECTOR (AND FRIENDS)\r
+\r
+TYBLO: ASH A,1 ; TWO WORD PER TYPE\r
+ HRRZ B,TYPBOT+1(TVP) ; FIND CURRENT ROOM\r
+ MOVE D,TYPVEC+1(TVP)\r
+ SUBI B,(D)\r
+ SUBI A,(B) ; EXTRA NEEDED TO A\r
+ JUMPLE A,CPOPJ ; NONE NEEDED, LEAVE\r
+ MOVEI B,TYPINC ; WHERE TO STASH SPEC\r
+ PUSHJ P,NUMADJ ; FIX NUMBER\r
+ HLRE 0,D ; POINT TO DOPE\r
+ SUB D,0\r
+ DPB A,[1100,,(D)]\r
+ SKIPE D,EVATYP+1(TVP) ; GROW AUX TYPE VECS IF NEEDED\r
+ PUSHJ P,SGROW1\r
+ SKIPE D,APLTYP+1(TVP)\r
+ PUSHJ P,SGROW1\r
+ SKIPE D,PRNTYP+1(TVP)\r
+ PUSHJ P,SGROW1\r
+ AOJA C,CPOPJ\r
+\r
+; HERE TO CREATE STORAGE SPACE\r
+\r
+STBLO: MOVE D,PARBOT ; HOW MUCH NOW HERE\r
+ SUB D,CODTOP\r
+ SUBI A,(D) ; MORE NEEDED?\r
+ JUMPLE A,CPOPJ\r
+ MOVEM A,PARNEW ; FORCE PAIR SPACE TO MOVE ON OUT\r
+ AOJA C,CPOPJ\r
+\r
+; BLOAT P STACK\r
+\r
+PBLO: HLRE D,P\r
+ MOVNS B,D\r
+ SUBI D,5 ; FUDGE FOR THIS CALL\r
+ SUBI A,(D)\r
+ JUMPLE A,CPOPJ\r
+ ADDI B,1(P) ; POINT TO DOPE\r
+ CAME B,PGROW ; BLOWN?\r
+ ADDI B,PDLBUF ; NOPE, POIN TO REAL D.W.\r
+ ASH A,-6 ; TO 64 WRD BLOCKS\r
+ CAILE A,377 ; IN RANGE?\r
+ JRST OUTRNG\r
+ DPB A,[111100,,-1(B)]\r
+ AOJA C,CPOPJ\r
+ \r
+; SET FREMIN\r
+\r
+SFREM: MOVEM A,FREMIN\r
+ POPJ P,\r
+\r
+; SET FREDIF\r
+\r
+SFRED: MOVEM A,FREDIF\r
+ POPJ P,\r
+\r
+; SET LVAL INCREMENT\r
+\r
+SLVL: IMULI A,6 ; CALCULATE AMOUNT TO GROW B\r
+ IDIVI A,64. ; # OF GROW BLOCKS NEEDED\r
+ CAIE B,0 ; DOES B HAVE A REMAINDER\r
+ ADDI A,1 ; IF SO ADD A BLOCK\r
+ MOVEM A,LVLINC\r
+ POPJ P,\r
+\r
+; SET GVAL INCREMENT\r
+\r
+SGVL: IDIVI A,16. ; CALCULATE NUMBER OF GROW BLOCKS NEEDED\r
+ CAIE B,0\r
+ ADDI A,1 ; COMPENSATE FOR EXTRA\r
+ MOVEM A,GVLINC\r
+ POPJ P,\r
+\r
+; SET TYPE INCREMENT\r
+\r
+STYP: IDIVI A,32. ; CALCULATE NUMBER OF GROW BLOCKS NEEDED\r
+ CAIE B,0\r
+ ADDI A,1 ; COMPENSATE FOR EXTRA\r
+ MOVEM A,TYPIC\r
+ POPJ P,\r
+\r
+; SET STORAGE INCREMENT\r
+\r
+SSTO: IDIVI A,2000 ; # OF BLOCKS\r
+ CAIE B,0 ; REMAINDER?\r
+ ADDI A,1\r
+ IMULI A,2000 ; CONVERT BACK TO WORDS\r
+ MOVEM A,STORIC\r
+ POPJ P,\r
+\r
+\r
+; GET NEXT (FIX) ARG\r
+\r
+NXTFIX: PUSHJ P,GETFIX\r
+ ADD AB,[2,,2]\r
+ POPJ P,\r
+\r
+; ROUTINE TO GET POS FIXED ARG\r
+\r
+GETFIX: GETYP A,(AB)\r
+ CAIE A,TFIX\r
+ JRST WRONGT\r
+ SKIPGE A,1(AB)\r
+ JRST BADNUM\r
+ POPJ P,\r
+\r
+\r
+; GET NUMBERS FIXED UP FOR GROWTH FIELDS\r
+\r
+NUMADJ: ADDI A,77 ; ROUND UP\r
+ ANDCMI A,77 ; KILL CRAP\r
+ MOVE 0,A\r
+ MOVNS A ; COMPUTE ADD FACTOR FOR SPEC. POINTER UPDATE\r
+ HRLI A,-1(A)\r
+ MOVEM A,(B) ; AND STASH IT\r
+ MOVE A,0\r
+ ASH A,-6 ; TO 64 WD BLOCKS\r
+ CAILE A,377 ; CHECK FIT\r
+ JRST OUTRNG\r
+ POPJ P,\r
+\r
+; DO SYMPATHETIC GROWTHS\r
+\r
+SGROW1: HLRE 0,D\r
+ SUB D,0\r
+ DPB A,[111100,,(D)]\r
+ POPJ P,\r
+\r
+\f;FUNCTION TO CONSTRUCT A LIST\r
+\r
+MFUNCTION CONS,SUBR\r
+\r
+ ENTRY 2\r
+ GETYP A,2(AB) ;GET TYPE OF 2ND ARG\r
+ CAIE A,TLIST ;LIST?\r
+ JRST WTYP2 ;NO , COMPLAIN\r
+ MOVE C,(AB) ; GET THING TO CONS IN\r
+ MOVE D,1(AB)\r
+ HRRZ E,3(AB) ; AND LIST\r
+ PUSHJ P,ICONS ; INTERNAL CONS\r
+ JRST FINIS\r
+\r
+; COMPILER CALL TO CONS\r
+\r
+CICONS: SUBM M,(P)\r
+ PUSHJ P,ICONS\r
+MPOPJ: SUBM M,(P)\r
+ POPJ P,\r
+\r
+; INTERNAL CONS TO NIL--INCONS\r
+\r
+INCONS: MOVEI E,0\r
+\r
+; INTERNAL CONS--ICONS; C,D VALUE, E CDR\r
+\r
+ICONS: GETYP A,C ; CHECK TYPE OF VAL\r
+ PUSHJ P,NWORDT ; # OF WORDS\r
+ SOJN A,ICONS1 ; JUMP IF DEFERMENT NEEDED\r
+ PUSHJ P,ICELL2 ; NO DEFER, GET 2 WORDS FROM PAIR SPACE\r
+ JRST ICONS2 ; NO CORE, GO GC\r
+ HRRI C,(E) ; SET UP CDR\r
+ICONS3: MOVEM C,(B) ; AND STORE\r
+ MOVEM D,1(B)\r
+TLPOPJ: MOVSI A,TLIST\r
+ POPJ P,\r
+\r
+; HERE IF CONSING DEFERRED\r
+\r
+ICONS1: MOVEI A,4 ; NEED 4 WORDS\r
+ PUSHJ P,ICELL ; GO GET 'EM\r
+ JRST ICONS2 ; NOT THERE, GC\r
+ HRLI E,TDEFER ; CDR AND DEFER\r
+ MOVEM E,(B) ; STORE\r
+ MOVEI E,2(B) ; POINT E TO VAL CELL\r
+ HRRZM E,1(B)\r
+ MOVEM C,(E) ; STORE VALUE\r
+ MOVEM D,1(E)\r
+ JRST TLPOPJ\r
+\r
+\r
+\r
+; HERE TO GC ON A CONS\r
+\r
+ICONS2: PUSH TP,C ; SAVE VAL\r
+ PUSH TP,D\r
+ PUSH TP,$TLIST\r
+ PUSH TP,E ; SAVE VITAL STUFF\r
+ MOVEM A,GETNUM ; AMOUNT NEEDED\r
+ MOVE C,[3,,1] ; INDICATOR FOR AGC\r
+ PUSHJ P,AGC ; ATTEMPT TO WIN\r
+ SKIPGE A ; SKIP IF WON\r
+ PUSHJ P,FULLOS\r
+ MOVE D,-2(TP) ; RESTORE VOLATILE STUFF\r
+ MOVE C,-3(TP)\r
+ MOVE E,(TP)\r
+ SUB TP,[4,,4]\r
+ JRST ICONS ; BACK TO DRAWING BOARD\r
+\r
+; SUBROUTINE TO ALLOCATE WORDS IN PAIR SPACE. CALLS AGC IF NEEDED\r
+\r
+CELL2: MOVEI A,2 ; USUAL CASE\r
+CELL: PUSHJ P,ICELL ; INTERNAL\r
+ JRST .+2 ; LOSER\r
+ POPJ P,\r
+\r
+ MOVEM A,GETNUM ; AMOUNT REQUIRED\r
+ PUSH P,A ; PREVENT AGC DESTRUCTION\r
+ MOVE C,[3,,1] ; INDICATOR FOR AGC\r
+ PUSHJ P,AGC\r
+ SKIPGE A ; SKIP IF WINNER\r
+ PUSHJ P,FULLOS ; REPORT TROUBLE\r
+ POP P,A\r
+ JRST CELL ; AND TRY AGAIN\r
+\r
+; INTERNAL CELL GETTER, SKIPS IF ROO EXISTS, ELSE DOESN'T\r
+\r
+ICELL2: MOVEI A,2 ; MOST LIKELY CAE\r
+ICELL: SKIPE B,RCL\r
+ JRST ICELRC ;SEE IF WE CAN RE-USE A RECYCLE CELL\r
+ MOVE B,PARTOP ; GET TOP OF PAIRS\r
+ ADDI B,(A) ; BUMP\r
+ CAMLE B,VECBOT ; SKIP IF OK.\r
+ POPJ P, ; LOSE\r
+ EXCH B,PARTOP ; SETUP NEW PARTOP AND RETURN POINTER\r
+ PUSH P,B ; MODIFY TOTAL # OF FREE WORDS\r
+ MOVE B,USEFRE\r
+ ADDI B,(A)\r
+ MOVEM B,USEFRE\r
+ POP P,B\r
+ JRST CPOPJ1 ; SKIP RETURN\r
+\r
+ICELRC: CAIE A,2\r
+ JRST ICELL+2 ;IF HE DOESNT WANT TWO, USE OLD METHOD\r
+ PUSH P,A\r
+ MOVE A,(B)\r
+ HRRZM A,RCL\r
+ POP P,A\r
+ SETZM (B) ;GIVE HIM A CLEAN RECYCLED CELL\r
+ SETZM 1(B)\r
+ JRST CPOPJ ;THAT IT\r
+\r
+;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT\r
+\r
+NWORDT: PUSHJ P,SAT ;GET STORAGE ALLOC TYPE\r
+NWORDS: CAIG A,NUMSAT ; TEMPLATE?\r
+ SKIPL MKTBS(A) ;-ENTRY IN TABLE MEANS 2 NEEDED\r
+ SKIPA A,[1] ;NEED ONLY 1\r
+ MOVEI A,2 ;NEED 2\r
+ POPJ P,\r
+\r
+\f;FUNCTION TO BUILD A LIST OF MANY ELEMENTS\r
+\r
+MFUNCTION LIST,SUBR\r
+ ENTRY\r
+\r
+ PUSH P,$TLIST\r
+LIST12: HLRE A,AB ;GET -NUM OF ARGS\r
+ SKIPE RCL ;SEE IF WE WANT TO DO ONE AT A TIME\r
+ JRST LST12R ;TO GET RECYCLED CELLS\r
+ MOVNS A ;MAKE IT +\r
+ JUMPE A,LISTN ;JUMP IF 0\r
+ PUSHJ P,CELL ;GET NUMBER OF CELLS\r
+ PUSH TP,$TAB\r
+ PUSH TP,AB\r
+ PUSH TP,(P) ;SAVE IT\r
+ PUSH TP,B\r
+ SUB P,[1,,1]\r
+ LSH A,-1 ;NUMBER OF REAL LIST ELEMENTS\r
+\r
+CHAINL: ADDI B,2 ;LOOP TO CHAIN ELEMENTS\r
+ HRRZM B,-2(B) ;CHAIN LAST ONE TO NEXT ONE\r
+ SOJG A,.-2 ;LOOP TIL ALL DONE\r
+ CLEARM B,-2(B) ;SET THE LAST CDR TO NIL\r
+\r
+; NOW LOBEER THE DATA IN TO THE LIST\r
+\r
+ MOVE D,AB ; COPY OF ARG POINTER\r
+ MOVE B,(TP) ;RESTORE LIS POINTER\r
+LISTLP: GETYP A,(D) ;GET TYPE\r
+ PUSHJ P,NWORDT ;GET NUMBER OF WORDS\r
+ SOJN A,LDEFER ;NEED TO DEFER POINTER\r
+ GETYP A,(D) ;NOW CLOBBER ELEMENTS\r
+ HRLM A,(B)\r
+ MOVE A,1(D) ;AND VALUE..\r
+ MOVEM A,1(B)\r
+LISTL2: HRRZ B,(B) ;REST B\r
+ ADD D,[2,,2] ;STEP ARGS\r
+ JUMPL D,LISTLP\r
+\r
+ POP TP,B\r
+ POP TP,A\r
+ SUB TP,[2,,2] ; CLEANUP STACK\r
+ JRST FINIS\r
+\r
+\r
+LST12R: ASH A,-1 ;ONE AT A TIME TO GET RECYCLED CELLS\r
+ JUMPE A,LISTN\r
+ PUSH P,A ;SAVE COUNT ON STACK\r
+ SETZB C,D\r
+ SETZM E\r
+ PUSHJ P,ICONS\r
+ MOVE E,B ;LOOP AND CHAIN TOGETHER\r
+ AOSGE (P)\r
+ JRST .-3\r
+ PUSH TP,-1(P) ;PUSH ON THE TYPE WE WANT\r
+ PUSH TP,B\r
+ SUB P,[2,,2] ;CLEAN UP AFTER OURSELVES\r
+ JRST LISTLP-2 ;AND REJOIN MAIN STREAM\r
+\r
+\r
+; MAKE A DEFERRED POINTER\r
+\r
+LDEFER: PUSH TP,$TLIST ;SAVE CURRENT POINTER\r
+ PUSH TP,B\r
+ MOVEM D,1(TB) ; SAVE ARG HACKER\r
+ PUSHJ P,CELL2\r
+ MOVE D,1(TB)\r
+ GETYPF A,(D) ;GET FULL DATA\r
+ MOVE C,1(D)\r
+ MOVEM A,(B)\r
+ MOVEM C,1(B)\r
+ MOVE C,(TP) ;RESTORE LIST POINTER\r
+ MOVEM B,1(C) ;AND MAKE THIS BE THE VALUE\r
+ MOVSI A,TDEFER\r
+ HLLM A,(C) ;AND STORE IT\r
+ MOVE B,C\r
+ SUB TP,[2,,2]\r
+ JRST LISTL2\r
+\r
+LISTN: MOVEI B,0\r
+ POP P,A\r
+ JRST FINIS\r
+\r
+; BUILD A FORM\r
+\r
+MFUNCTION FORM,SUBR\r
+\r
+ ENTRY\r
+\r
+ PUSH P,$TFORM\r
+ JRST LIST12\r
+\r
+\f; COMPILERS CALLS TO FORM AND LIST A/ COUNT ELEMENTS ON STACK\r
+\r
+IILIST: SUBM M,(P)\r
+ PUSHJ P,IILST\r
+ MOVSI A,TLIST\r
+ JRST MPOPJ\r
+\r
+IIFORM: SUBM M,(P)\r
+ PUSHJ P,IILST\r
+ MOVSI A,TFORM\r
+ JRST MPOPJ\r
+\r
+IILST: JUMPE A,IILST0 ; NIL WHATSIT\r
+ PUSH P,A\r
+ MOVEI E,0\r
+IILST1: POP TP,D\r
+ POP TP,C\r
+ PUSHJ P,ICONS ; CONS 'EM UP\r
+ MOVEI E,(B)\r
+ SOSE (P) ; COUNT\r
+ JRST IILST1\r
+\r
+ SUB P,[1,,1]\r
+ POPJ P,\r
+\r
+IILST0: MOVEI B,0\r
+ POPJ P,\r
+\r
+\f;FUNCTION TO BUILD AN IMPLICIT LIST\r
+\r
+MFUNCTION ILIST,SUBR\r
+ ENTRY\r
+ PUSH P,$TLIST\r
+ILIST2: JUMPGE AB,TFA ;NEED AT LEAST ONE ARG\r
+ CAMGE AB,[-4,,0] ;NO MORE THAN TWO ARGS\r
+ JRST TMA\r
+ PUSHJ P,GETFIX ; GET POS FIX #\r
+ JUMPE A,LISTN ;EMPTY LIST ?\r
+ CAML AB,[-2,,0] ;ONLY ONE ARG?\r
+ JRST LOSEL ;YES\r
+ PUSH P,A ;SAVE THE CURRENT VALUE OF LENGTH FOR LOOP ITERATION\r
+ILIST0: PUSH TP,2(AB)\r
+ PUSH TP,(AB)3\r
+ MCALL 1,EVAL\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ SOSLE (P)\r
+ JRST ILIST0\r
+ POP P,C\r
+ILIST1: MOVE C,(AB)+1 ;REGOBBLE LENGTH\r
+ ACALL C,LIST\r
+ILIST3: POP P,A ; GET FINAL TYPE\r
+ JRST FINIS\r
+\r
+\r
+LOSEL: PUSH P,A ; SAVE COUNT\r
+ MOVEI E,0\r
+\r
+LOSEL1: SETZB C,D ; TLOSE,,0\r
+ PUSHJ P,ICONS\r
+ MOVEI E,(B)\r
+ SOSLE (P)\r
+ JRST LOSEL1\r
+\r
+ SUB P,[1,,1]\r
+ JRST ILIST3\r
+\r
+; IMPLICIT FORM\r
+\r
+MFUNCTION IFORM,SUBR\r
+\r
+ ENTRY\r
+ PUSH P,$TFORM\r
+ JRST ILIST2\r
+\r
+\f; IVECTOR AND IUVECTOR--GET VECTOR AND UVECTOR OF COMPUTED VALUES\r
+\r
+MFUNCTION VECTOR,SUBR,[IVECTOR]\r
+\r
+ MOVEI C,1\r
+ JRST VECTO3\r
+\r
+MFUNCTION UVECTOR,SUBR,[IUVECTOR]\r
+\r
+ MOVEI C,0\r
+VECTO3: ENTRY\r
+ JUMPGE AB,TFA ; AT LEAST ONE ARG\r
+ CAMGE AB,[-4,,0] ; NOT MORE THAN 2\r
+ JRST TMA\r
+ PUSHJ P,GETFIX ; GET A POS FIXED NUMBER\r
+ LSH A,(C) ; A-> NUMBER OF WORDS\r
+ PUSH P,C ; SAVE FOR LATER\r
+ PUSHJ P,IBLOCK ; GET BLOCK (TURN ON BIT APPROPRIATELY)\r
+ POP P,C\r
+ HLRE A,B ; START TO\r
+ SUBM B,A ; FIND DOPE WORD\r
+ JUMPE C,VECTO4\r
+ MOVSI D,400000 ; GET NOT UNIFORM BIT\r
+ MOVEM D,(A) ; INTO DOPE WORD\r
+ SKIPA A,$TVEC ; GET TYPE\r
+VECTO4: MOVSI A,TUVEC\r
+ CAML AB,[-2,,0] ; SKIP IF ARGS NEED TO BE HACKED\r
+ JRST FINIS\r
+ JUMPGE B,FINIS ; DON'T EVAL FOR EMPTY CASE\r
+\r
+ PUSH TP,A ; SAVE THE VECTOR\r
+ PUSH TP,B\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+\r
+ JUMPE C,UINIT\r
+ JUMPGE B,FINIS ; EMPTY VECTOR, LEAVE\r
+INLP: PUSHJ P,IEVAL ; EVAL EXPR\r
+ MOVEM A,(C)\r
+ MOVEM B,1(C)\r
+ ADD C,[2,,2] ; BUMP VECTOR\r
+ MOVEM C,(TP)\r
+ JUMPL C,INLP ; IF MORE DO IT\r
+\r
+GETVEC: MOVE A,-3(TP)\r
+ MOVE B,-2(TP)\r
+ SUB TP,[4,,4]\r
+ JRST FINIS\r
+\r
+; HERE TO FILL UP A UVECTOR\r
+\r
+UINIT: PUSHJ P,IEVAL ; HACK THE 1ST VALUE\r
+ GETYP A,A ; GET TYPE\r
+ PUSH P,A ; SAVE TYPE\r
+ PUSHJ P,NWORDT ; SEE IF IT CAN BE UNIFORMED\r
+ SOJN A,CANTUN ; COMPLAIN\r
+STJOIN: MOVE C,(TP) ; RESTORE POINTER\r
+ ADD C,1(AB) ; POINT TO DOPE WORD\r
+ MOVE A,(P) ; GET TYPE\r
+ HRLZM A,(C) ; STORE IN D.W.\r
+ MOVE C,(TP) ; GET BACK VECTOR\r
+ SKIPE 1(AB)\r
+ JRST UINLP1 ; START FILLING UV\r
+ JRST GETVE1\r
+\r
+UINLP: MOVEM C,(TP) ; SAVE PNTR\r
+ PUSHJ P,IEVAL ; EVAL THE EXPR\r
+ GETYP A,A ; GET EVALED TYPE\r
+ CAIE A,@(P) ; WINNER?\r
+ JRST WRNGSU ; SERVICE ERROR FOR UVECTOR,STORAGE\r
+UINLP1: MOVEM B,(C) ; STORE\r
+ AOBJN C,UINLP\r
+GETVE1: SUB P,[1,,1]\r
+ JRST GETVEC ; AND RETURN VECTOR\r
+\r
+IEVAL: PUSH TP,2(AB)\r
+ PUSH TP,3(AB)\r
+ MCALL 1,EVAL\r
+ MOVE C,(TP)\r
+ POPJ P,\r
+\r
+; ISTORAGE -- GET STORAGE OF COMPUTED VALUES\r
+\r
+MFUNCTION ISTORAGE,SUBR\r
+ ENTRY\r
+ JUMPGE AB,TFA\r
+ CAMGE AB,[-4,,0] ; AT LEAST ONE ARG\r
+ JRST TMA\r
+ PUSHJ P,GETFIX ; POSITIVE COUNT FIRST ARG\r
+ PUSHJ P,CAFRE ; GET CORE\r
+ MOVN B,1(AB) ; -COUNT\r
+ HRL A,B ; PUT IN LHW (A)\r
+ MOVM B,B ; +COUNT\r
+ HRLI B,2(B) ; LENGTH + 2\r
+ ADDI B,(A) ; MAKE POINTER TO DOPE WORDS\r
+ HLLZM B,1(B) ; PUT TOTAL LENGTH IN 2ND DOPE\r
+ HRRM A,1(B) ; PUT ADDRESS IN RHW (STORE DOES THIS TOO).\r
+ MOVE B,A\r
+ MOVSI A,TSTORAGE\r
+ CAML AB,[-2,,0] ; SECOND ARG TO EVAL?\r
+ JRST FINIS ; IF NOT, RETURN EMPTY\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ PUSH TP,A\r
+ PUSH TP,B\r
+ PUSHJ P,IEVAL ; EVALUATE FOR FIRST VALUE\r
+ GETYP A,A\r
+ PUSH P,A ; FOR COMPARISON LATER\r
+ PUSHJ P,SAT\r
+ CAIN A,S1WORD\r
+ JRST STJOIN ;TREAT LIKE A UVECTOR\r
+ ; IF NOT 1-WORD TYPES, CANNOT STORE, SO COMPLAIN\r
+ PUSHJ P,FREESV ; FREE STORAGE VECTOR\r
+ PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE DATA-CAN'T-GO-IN-STORAGE\r
+ JRST CALER1\r
+\r
+; FOR STORAGE, MUST FREE THE CORE ELSE IT IS LOST (NO GC)\r
+FREESV: MOVE A,1(AB) ; GET COUNT\r
+ ADDI A,2 ; FOR DOPE\r
+ HRRZ B,(TP) ; GET ADDRESS\r
+ PUSHJ P,CAFRET ; FREE THE CORE\r
+ POPJ P,\r
+\r
+\f; INTERNAL VECTOR ALLOCATOR. A/SIZE OF VECTOR (NOT INCLUDING DOPE WORDS)\r
+\r
+IBLOK1: ASH A,1 ; TIMES 2\r
+GIBLOK: TLOA A,400000 ; FUNNY BIT\r
+IBLOCK: TLZ A,400000 ; NO BIT ON\r
+ ADDI A,2 ; COMPENSATE FOR DOPE WORDS\r
+IBLOK2: MOVE B,VECBOT ; POINT TO BOTTOM OF SPACE\r
+ SUBI B,(A) ; SUBTRACT NEEDED AMOUNT\r
+ CAMGE B,PARTOP ; SKIP IF NO GC NEEDED\r
+ JRST IVECT1\r
+ EXCH B,VECBOT ; WIN, GET POINTER TO BLOCK AND UPDATE VECBOT\r
+ PUSH P,B\r
+ MOVE B,USEFRE\r
+ ADDI B,(A)\r
+ MOVEM B,USEFRE\r
+ POP P,B\r
+ HRLZM A,-1(B) ; STORE LENGTH IN DOPE WORD\r
+ HLLZM A,-2(B) ; AND BIT\r
+ HRRO B,VECBOT ; POINT TO START OF VECTOR\r
+ TLC B,-3(A) ; SETUP COUNT\r
+ HRRI A,TVEC\r
+ SKIPL A\r
+ HRRI A,TUVEC\r
+ MOVSI A,(A)\r
+ POPJ P,\r
+\r
+; HERE TO DO A GC ON A VECTOR ALLOCATION\r
+\r
+IVECT1: PUSH P,A ; SAVE DESIRED LENGTH\r
+ HRRZM A,GETNUM ; AND STORE AS DESIRED AMOUNT\r
+ MOVE C,[4,,1] ; GET INDICATOR FOR AGC\r
+ PUSHJ P,AGC\r
+ SKIPGE A\r
+ PUSHJ P,FULLOS ; LOST, COMPLAIN\r
+ POP P,A\r
+ JRST IBLOK2\r
+\r
+\r
+; INTERNAL EVECTOR (CALLED FROM READ) A/ #OF THINGS\r
+; ITEMS ON TOP OF STACK\r
+\r
+IEVECT: ASH A,1 ; TO NUMBER OF WORDS\r
+ PUSH P,A\r
+ PUSHJ P,IBLOCK ; GET VECTOR\r
+ HLRE D,B ; FIND DW\r
+ SUBM B,D ; A POINTS TO DW\r
+ MOVSI 0,400000\r
+ MOVEM 0,(D) ; CLOBBER NON UNIF BIT\r
+ POP P,A ; RESTORE COUNT\r
+ JUMPE A,IVEC1 ; 0 LNTH, DONE\r
+ MOVEI C,(TP) ; BUILD BLT\r
+ SUBI C,(A)-1 ; C POINTS TO 1ST ITEM ON STACK\r
+ MOVSI C,(C)\r
+ HRRI C,(B) ; B/ SOURCE,,DEST\r
+ BLT C,-1(D) ; XFER THE DATA\r
+ HRLI A,(A)\r
+ SUB TP,A ; FLUSH STACKAGE\r
+IVEC1: MOVSI A,TVEC\r
+ POPJ P,\r
+ \r
+\r
+; COMPILERS CALL\r
+\r
+CIVEC: SUBM M,(P)\r
+ PUSHJ P,IEVECT\r
+ JRST MPOPJ\r
+\r
+\r
+\f; INTERNAL CALL TO EUVECTOR\r
+\r
+IEUVEC: PUSH P,A ; SAVE LENGTH\r
+ PUSHJ P,IBLOCK\r
+ MOVE A,(P)\r
+ JUMPE A,IEUVE1 ; EMPTY, LEAVE\r
+ ASH A,1 ; NOW FIND STACK POSITION\r
+ MOVEI C,(TP) ; POINT TO TOP\r
+ MOVE D,B ; COPY VEC POINTER\r
+ SUBI C,-1(A) ; POINT TO 1ST DATUM\r
+ GETYP A,(C) ; CHECK IT\r
+ PUSHJ P,NWORDT\r
+ SOJN A,CANTUN ; WONT FIT\r
+ GETYP E,(C)\r
+\r
+IEUVE2: GETYP 0,(C) ; TYPE OF EL\r
+ CAIE 0,(E) ; MATCH?\r
+ JRST WRNGUT\r
+ MOVE 0,1(C)\r
+ MOVEM 0,(D) ; CLOBBER\r
+ ADDI C,2\r
+ AOBJN D,IEUVE2 ; LOOP\r
+ HRLZM E,(D) ; STORE UTYPE\r
+IEUVE1: POP P,A ; GET COUNY\r
+ ASH A,1 ; MUST FLUSH 2 TIMES # OF ELEMENTS\r
+ HRLI A,(A)\r
+ SUB TP,A ; CLEAN UP STACK\r
+ MOVSI A,TUVEC\r
+ POPJ P,\r
+\r
+; COMPILER'S CALL\r
+\r
+CIUVEC: SUBM M,(P)\r
+ PUSHJ P,IEUVEC\r
+ JRST MPOPJ\r
+\r
+MFUNCTION EVECTOR,SUBR,[VECTOR]\r
+ ENTRY\r
+ HLRE A,AB\r
+ MOVNS A\r
+ PUSH P,A ;SAVE NUMBER OF WORDS\r
+ PUSHJ P,IBLOCK ; GET WORDS\r
+ MOVEI D,-1(B) ; SETUP FOR BLT AND DOPE CLOBBER\r
+ JUMPGE B,FINISV ;DONT COPY A ZERO LENGTH VECTOR\r
+\r
+ HRLI C,(AB) ;START BUILDING BLT POINTER\r
+ HRRI C,(B) ;TO ADDRESS\r
+ ADDI D,@(P) ;SET D TO FINAL ADDRESS\r
+ BLT C,(D)\r
+FINISV: MOVSI 0,400000\r
+ MOVEM 0,1(D) ; MARK AS GENERAL\r
+ SUB P,[1,,1]\r
+ MOVSI A,TVEC\r
+ JRST FINIS\r
+\r
+\r
+\r
+\f;EXPLICIT VECTORS FOR THE UNIFORM CSE\r
+\r
+MFUNCTION EUVECTOR,SUBR,[UVECTOR]\r
+\r
+ ENTRY\r
+ HLRE A,AB ;-NUM OF ARGS\r
+ MOVNS A\r
+ ASH A,-1 ;NEED HALF AS MANY WORDS\r
+ PUSH P,A\r
+ JUMPGE AB,EUV1 ; DONT CHECK FOR EMPTY\r
+ GETYP A,(AB) ;GET FIRST ARG\r
+ PUSHJ P,NWORDT ;SEE IF NEEDS EXTRA WORDS\r
+ SOJN A,CANTUN\r
+EUV1: POP P,A\r
+ PUSHJ P,IBLOCK ; GET VECT\r
+ JUMPGE B,FINISU\r
+\r
+ GETYP C,(AB) ;GET THE FIRST TYPE\r
+ MOVE D,AB ;COPY THE ARG POINTER\r
+ MOVE E,B ;COPY OF RESULT\r
+\r
+EUVLP: GETYP 0,(D) ;GET A TYPE\r
+ CAIE 0,(C) ;SAME?\r
+ JRST WRNGUT ;NO , LOSE\r
+ MOVE 0,1(D) ;GET GOODIE\r
+ MOVEM 0,(E) ;CLOBBER\r
+ ADD D,[2,,2] ;BUMP ARGS POINTER\r
+ AOBJN E,EUVLP\r
+\r
+ HRLM C,(E) ;CLOBBER UNIFORM TYPE IN\r
+FINISU: MOVSI A,TUVEC\r
+ JRST FINIS\r
+\r
+WRNGSU: GETYP A,-1(TP)\r
+ CAIE A,TSTORAGE\r
+ JRST WRNGUT ;IF UVECTOR\r
+ PUSHJ P,FREESV ;FREE STORAGE VECTOR\r
+ PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE TYPES-DIFFER-IN-STORAGE-OBJECT\r
+ JRST CALER1\r
+\r
+ \r
+WRNGUT: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE TYPES-DIFFER-IN-UNIFORM-VECTOR\r
+ JRST CALER1\r
+\r
+CANTUN: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE DATA-CANT-GO-IN-UNIFORM-VECTOR\r
+ JRST CALER1\r
+\r
+BADNUM: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE NEGATIVE-ARGUMENT\r
+ JRST CALER1\r
+\f; FUNCTION TO GROW A VECTOR\r
+\r
+MFUNCTION GROW,SUBR\r
+\r
+ ENTRY 3\r
+\r
+ MOVEI D,0 ;STACK HACKING FLAG\r
+ GETYP A,(AB) ;FIRST TYPE\r
+ PUSHJ P,SAT ;GET STORAGE TYPE\r
+ GETYP B,2(AB) ;2ND ARG\r
+ CAIE A,STPSTK ;IS IT ASTACK\r
+ CAIN A,SPSTK\r
+ AOJA D,GRSTCK ;YES, WIN\r
+ CAIE A,SNWORD ;UNIFORM VECTOR\r
+ CAIN A,S2NWORD ;OR GENERAL\r
+GRSTCK: CAIE B,TFIX ;IS 2ND FIXED\r
+ JRST WTYP2 ;COMPLAIN\r
+ GETYP B,4(AB)\r
+ CAIE B,TFIX ;3RD ARG\r
+ JRST WTYP3 ;LOSE\r
+\r
+ MOVEI E,1 ;UNIFORM/GENERAL FLAG\r
+ CAIE A,SNWORD ;SKIP IF UNIFORM\r
+ CAIN A,SPSTK ;DONT SKIP IF UNIFORM PDL\r
+ MOVEI E,0\r
+\r
+ HRRZ B,1(AB) ;POINT TO START\r
+ HLRE A,1(AB) ;GET -LENGTH\r
+ SUB B,A ;POINT TO DOPE WORD\r
+ SKIPE D ;SKIP IF NOT STACK\r
+ ADDI B,PDLBUF ;FUDGE FOR PDL\r
+ HLLZS (B) ;ZERO OUT GROWTH SPECS\r
+ SKIPN A,3(AB) ;ANY TOP GROWTH?\r
+ JRST GROW1 ;NO, LOOK FOR BOTTOM GROWTH\r
+ ASH A,(E) ;MULT BY 2 IF GENERAL\r
+ ADDI A,77 ;ROUND TO NEAREST BLOCK\r
+ ANDCMI A,77 ;CLEAR LOW ORDER BITS\r
+ ASH A,9-6 ;DIVIDE BY 100 AND SHIFT TO POSTION\r
+ TRZE A,400000 ;CONVERT TO SIGN MAGNITUDE\r
+ MOVNS A\r
+ TLNE A,-1 ;SKIP IF NOT TOO BIG\r
+ JRST GTOBIG ;ERROR\r
+GROW1: SKIPN C,5(AB) ;CHECK LOW GROWTH\r
+ JRST GROW4 ;NONE, SKIP\r
+ ASH C,(E) ;GENRAL FUDGE\r
+ ADDI C,77 ;ROUND\r
+ ANDCMI C,77 ;FUDGE FOR VALUE RETURN\r
+ PUSH P,C ;AND SAVE\r
+ ASH C,-6 ;DIVIDE BY 100\r
+ TRZE C,400 ;CONVERT TO SIGN MAGNITUDE\r
+ MOVNS C\r
+ TDNE C,[-1,,777000] ;CHECK FOR OVERFLOW\r
+ JRST GTOBIG\r
+GROW2: HLRZ E,1(B) ;GET TOTAL LENGTH OF VECTOR\r
+ MOVNI E,-1(E)\r
+ HRLI E,(E) ;TO BOTH HALVES\r
+ ADDI E,1(B) ;POINTS TO TOP\r
+ SKIPE D ;STACK?\r
+ ADD E,[PDLBUF,,0] ;YES, FUDGE LENGTH\r
+ SKIPL D,(P) ;SHRINKAGE?\r
+ JRST GROW3 ;NO, CONTINUE\r
+ MOVNS D ;PLUSIFY\r
+ HRLI D,(D) ;TO BOTH HALVES\r
+ ADD E,D ;POINT TO NEW LOW ADDR\r
+GROW3: IORI A,(C) ;OR TOGETHER\r
+ HRRM A,(B) ;DEPOSIT INTO DOPEWORD\r
+ PUSH TP,(AB) ;PUSH TYPE\r
+ PUSH TP,E ;AND VALUE\r
+ JUMPE A,.+3 ;DON'T GC FOR NOTHING\r
+ MOVE C,[2,,0] ; GET INDICATOR FOR AGC\r
+ PUSHJ P,AGC\r
+ JUMPL A,GROFUL\r
+ POP P,C ;RESTORE GROWTH\r
+ HRLI C,(C)\r
+ POP TP,B ;GET VECTOR POINTER\r
+ SUB B,C ;POINT TO NEW TOP\r
+ POP TP,A\r
+ JRST FINIS\r
+\r
+GROFUL: SUB P,[1,,1] ; CLEAN UP STACK\r
+ SUB TP,[2,,2]\r
+ PUSHJ P,FULLOS\r
+ JRST GROW\r
+\r
+GTOBIG: PUSH TP,$TATOM\r
+ PUSH TP,EQUOTE ATTEMPT-TO-GROW-VECTOR-TOO-MUCH\r
+ JRST CALER1\r
+GROW4: PUSH P,[0] ;0 BOTTOM GROWTH\r
+ JRST GROW2\r
+\r
+FULLOS: PUSH TP,$TATOM ; GENERATE ERROR\r
+ PUSH TP,@ERRTB(A)\r
+ AOJL A,CALER1 ; IF BAD, CALL ERROR\r
+ SKIPN GCMONF\r
+ POPJ P,\r
+ PUSH TP,TTOCHN(TVP) ; FORCE MESSAGES TO TTY\r
+ PUSH TP,TTOCHN+1(TVP)\r
+ PUSH TP,TTOCHN(TVP) ; FORCE MESSAGES TO TTY\r
+ PUSH TP,TTOCHN+1(TVP)\r
+ MCALL 1,TERPRI ; JUST PRINT MESSAGE\r
+ MCALL 2,PRINC\r
+ POPJ P,\r
+\r
+\r
+ EQUOTE STILL-NO-STORAGE\r
+ EQUOTE NO-STORAGE\r
+ EQUOTE STORAGE-LOW\r
+ERRTB==.\r
+\f; SUBROUTINE TO BUILD CHARACTER STRING GOODIES\r
+\r
+MFUNCTION STRING,SUBR\r
+\r
+ ENTRY\r
+\r
+ MOVE B,AB ;COPY ARG POINTER\r
+ MOVEI C,0 ;INITIALIZE COUNTER\r
+ PUSH TP,$TAB ;SAVE A COPY\r
+ PUSH TP,B\r
+ HLRE A,B ; GET # OF ARGS\r
+ MOVNS A\r
+ ASH A,-1 ; 1/2 FOR # OF ARGS\r
+ PUSHJ P,IISTRN\r
+ JRST FINIS\r
+\r
+IISTRN: SKIPN E,A ; SKIP IF ARGS EXIST\r
+ JRST MAKSTR ; ALL DONE\r
+\r
+STRIN2: GETYP D,(B) ;GET TYPE CODE\r
+ CAIN D,TCHRS ;SINGLE CHARACTER?\r
+ AOJA C,STRIN1\r
+ CAIE D,TCHSTR ;OR STRING\r
+ JRST WRONGT ;NEITHER\r
+ HRRZ D,(B) ; GET CHAR COUNT\r
+ ADDI C,(D) ; AND BUMP\r
+\r
+STRIN1: ADD B,[2,,2]\r
+ SOJG A,STRIN2\r
+\r
+; NOW GET THE NECESSARY VECTOR\r
+\r
+MAKSTR: PUSH P,C ; SAVE CHAR COUNT\r
+ PUSH P,E ; SAVE ARG COUNT\r
+ MOVEI A,4(C) ; LNTH+4 TO A\r
+ IDIVI A,5\r
+ PUSHJ P,IBLOCK\r
+\r
+ POP P,A\r
+ JUMPGE B,DONEC ; 0 LENGTH, NO STRING\r
+ HRLI B,440700 ;CONVERT B TO A BYTE POINTER\r
+ MOVE C,(TP) ; POINT TO ARGS AGAIN\r
+\r
+NXTRG1: GETYP D,(C) ;GET AN ARG\r
+ CAIE D,TCHRS\r
+ JRST TRYSTR\r
+ MOVE D,1(C) ; GET IT\r
+ IDPB D,B ;AND DEPOSIT IT\r
+ JRST NXTARG\r
+\r
+TRYSTR: MOVE E,1(C) ;GET BYTER\r
+ HRRZ 0,(C) ;AND COUNT\r
+NXTCHR: SOJL 0,NXTARG ; IF RUNOUT, GET NEXT ARG\r
+ ILDB D,E ;AND GET NEXT\r
+ IDPB D,B ; AND DEPOSIT SAME\r
+ JRST NXTCHR\r
+\r
+NXTARG: ADD C,[2,,2] ;BUMP ARG POINTER\r
+ SOJG A,NXTRG1\r
+ ADDI B,1\r
+\r
+DONEC: MOVSI C,TCHRS\r
+ HLLM C,(B) ;AND CLOBBER AWAY\r
+ HLRZ C,1(B) ;GET LENGTH BACK\r
+ POP P,A\r
+ HRLI A,TCHSTR\r
+ SUBI B,-2(C)\r
+ HRLI B,440700 ;MAKE A BYTE POINTER\r
+ POPJ P,\r
+\r
+; COMPILER'S CALL TO MAKE A STRING\r
+\r
+CISTNG: SUBM M,(P)\r
+ MOVEI C,0 ; INIT CHAR COUNTER\r
+ MOVEI B,(A) ; SET UP STACK POINTER\r
+ ASH B,1 ; * 2 FOR NO. OF SLOTS\r
+ HRLI B,(B)\r
+ SUBM TP,B ; B POINTS TO ARGS\r
+ ADD B,[1,,1]\r
+ PUSH TP,$TTP\r
+ PUSH TP,B\r
+ PUSHJ P,IISTRN ; MAKE IT HAPPEN\r
+ POP TP,TP ; FLUSH ARGS\r
+ SUB TP,[1,,1]\r
+ JRST MPOPJ\r
+\f;BUILD IMPLICT STRING\r
+\r
+MFUNCTION ISTRING,SUBR\r
+\r
+ ENTRY\r
+ JUMPGE AB,TFA ; TOO FEW ARGS\r
+ CAMGE AB,[-4,,0] ; VERIFY NOT TOO MANY ARGS\r
+ JRST TMA\r
+ PUSHJ P,GETFIX\r
+ ADDI A,4\r
+ IDIVI A,5 ; # OF WORDS NEEDED TO A\r
+ PUSH TP,$TFIX\r
+ PUSH TP,A\r
+ MCALL 1,UVECTOR ; GET SAME\r
+ HLRE C,B ; -LENGTH TO C\r
+ SUBM B,C ; LOCN OF DOPE WORD TO C\r
+ HRLI D,TCHRS ; CLOBBER ITS TYPE\r
+ HLLM D,(C)\r
+ MOVSI A,TCHSTR\r
+ HRR A,1(AB) ; SETUP TYPE'S RH\r
+ HRLI B,440700 ; AND BYTE POINTER\r
+ SKIPE (AB)+1 ; SKIP IF NO CHARACTERS TO DEPOSIT\r
+ CAML AB,[-2,,0] ; SKIP IF 2 ARGS GIVEN\r
+ JRST FINIS\r
+ PUSH TP,A ;SAVE OUR STRING\r
+ PUSH TP,B\r
+ PUSH TP,A ;SAVE A TEMPORARY CLOBBER POINTER\r
+ PUSH TP,B\r
+ PUSH P,(AB)1 ;SAVE COUNT\r
+CLOBST: PUSH TP,(AB)+2\r
+ PUSH TP,(AB)+3\r
+ MCALL 1,EVAL\r
+ GETYP C,A ; CHECK IT\r
+ CAIE C,TCHRS ; MUST BE A CHARACTER\r
+ JRST WTYP2\r
+ IDPB B,(TP) ;CLOBBER\r
+ SOSLE (P) ;FINISHED?\r
+ JRST CLOBST ;NO\r
+ SUB P,[1,,1]\r
+ SUB TP,[4,,4]\r
+ MOVE A,(TP)+1\r
+ MOVE B,(TP)+2\r
+ JRST FINIS\r
+\r
+\r
+\fAGC":\r
+;SET FLAG FOR INTERRUPT HANDLER\r
+\r
+ SETZB M,RCL ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR\r
+ PUSH P,B\r
+ PUSH P,A\r
+ PUSH P,C ; SAVE C\r
+ PUSHJ P,CTIME ; GET TIME FOR GIN-GOUT\r
+ MOVEM B,GCTIM ; SAVE FOR LATER\r
+ MOVEI B,[ASCIZ /GIN /]\r
+ SKIPE GCMONF\r
+ PUSHJ P,MSGTYP\r
+NOMON1: HRRZ C,(P) ; GET CAUSE OF GC INDICATOR\r
+ MOVE B,GCNO(C) ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON\r
+ ADDI B,1\r
+ MOVEM B,GCNO(C)\r
+ MOVEM C,GCCAUS ; SAVE CAUSE OF GC\r
+ SKIPN GCMONF ; MONITORING\r
+ JRST NOMON2\r
+ MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE\r
+ PUSHJ P,MSGTYP\r
+NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC\r
+ MOVEM C,GCCALL ; SAVE CALLER OF GC\r
+ SKIPN GCMONF ; MONITORING\r
+ JRST NOMON3\r
+ MOVE B,MSGGFT(C)\r
+ PUSHJ P,MSGTYP\r
+NOMON3: SUB P,[1,,1] ; POP OFF C\r
+ POP P,A\r
+ POP P,B\r
+ JRST .+1\r
+AAGC: SETZB M,RCL ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION\r
+INITGC: SETOM GCFLG\r
+\r
+;SAVE AC'S\r
+ IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,PVP]\r
+ MOVEM AC,AC!STO"+1(PVP)\r
+ TERMIN\r
+\r
+; FUDGE NOWFRE FOR LATER WINNING\r
+\r
+ MOVE 0,NOWFRE\r
+ SUB 0,VECBOT\r
+ ADD 0,PARTOP\r
+ MOVEM 0,NOWFRE\r
+\r
+; IF IN A PURE RSUBR, FIND ITS LENGTH AND FUDGE ITS LRU\r
+\r
+ HRRZ A,FSAV(TB) ; GET NAME OF CURRENT GOODIE\r
+ SETZM CURPLN ; CLEAR FOR NONE\r
+ CAML A,PURTOP ; IF LESS THAN TOP OF PURE ASSUME RSUBR\r
+ JRST NRSUBR\r
+ GETYP 0,(A) ; SEE IF PURE\r
+ CAIE 0,TPCODE ; SKIP IF IT IS\r
+ JRST NRSUBR\r
+ HLRZ B,1(A) ; GET SLOT INDICATION\r
+ ADD B,PURVEC+1(TVP) ; POINT TO SLOT\r
+ HRROS 2(B) ; MUNG AGE\r
+ HLRE A,1(B) ; - LENGTH TO A\r
+ MOVNM A,CURPLN ; AND STORE\r
+NRSUBR:\r
+\r
+;SET UP E TO POINT TO TYPE VECTOR\r
+ GETYP E,TYPVEC(TVP)\r
+ CAIE E,TVEC\r
+ JRST AGCE1\r
+ HRRZ TYPNT,TYPVEC+1(TVP)\r
+ HRLI TYPNT,B\r
+\r
+CHPDL: MOVE D,P ; SAVE FOR LATER\r
+ MOVE P,GCPDL ;GET GC'S PDL\r
+CORGET: MOVE A,P.TOP ; UPDATE CORTOP\r
+ MOVEM A,CORTOP\r
+ MOVE A,VECTOP ; ROOM BETWEEN CORTOP AND VECTOP IS GC MARK PDL\r
+ SUB A,CORTOP\r
+ MOVSS A ; BUILD A PDL POINTER\r
+ ADD A,VECTOP\r
+ JUMPGE A,TRYCOR ; NO ROOM, GO GET SOME\r
+ MOVE P,A ; SET UP PDL POINTER\r
+\r
+;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK\r
+\r
+ MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS\r
+ PUSHJ P,FRMUNG ;AND MUNG IT\r
+ MOVE A,TP ;THEN TEMPORARY PDL\r
+ PUSHJ P,PDLCHK\r
+ MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK\r
+ PUSHJ P,PDLCHP\r
+\r
+\f; FIRST CREATE INFERIOR TO HOLD NEW PAGES\r
+\r
+INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW\r
+ ADD A,PARNEW\r
+ ADDI A,1777\r
+ ANDCMI A,1777 ; EVEN PAGE BOUNDARY\r
+ HRRM A,BOTNEW ; INTO POINTER WORD\r
+ MOVEM A,WNDBOT\r
+ MOVEI 0,2000(A) ; BOUNDS OF WINDOW\r
+ MOVEM 0,WNDTOP\r
+ SUB A,PARBOT\r
+ MOVEM A,PARNEW ; FIXED UP PARNEW\r
+ HRRZ A,BOTNEW ; GET PAGE TO START INF AT\r
+ ASH A,-10. ; TO PAGES\r
+ PUSHJ P,%GCJOB ; GET PAGE HOLDER\r
+ MOVSI FPTR,-2000 ; FIX UP FRONTIER POINTER\r
+\r
+;MARK PHASE: MARK ALL LISTS AND VECTORS\r
+;POINTED TO WITH ONE BIT IN SIGN BIT\r
+;START AT TRANSFER VECTOR\r
+\r
+ SETZB LPVP,VECNUM ;CLEAR NUMBER OF VECTOR WORDS\r
+ SETZB PARNUM ;CLEAR NUMBER OF PAIRS\r
+ MOVEI 0,NGCS ; SEE IF NEED HAIR\r
+ SOSGE GCHAIR\r
+ MOVEM 0,GCHAIR ; RESUME COUNTING\r
+ SETZM GREW ; ASSUME NO GROW/SHRINK\r
+ SETZM SHRUNK\r
+ MOVSI D,400000 ;SIGN BIT FOR MARKING\r
+ MOVE A,ASOVEC+1(TVP) ;MARK ASSOC. VECTOR NOW\r
+ PUSHJ P,PRMRK ; PRE-MARK\r
+ MOVE A,GLOBSP+1(TVP)\r
+ PUSHJ P,PRMRK\r
+\r
+; HAIR TO DO AUTO CHANNEL CLOSE\r
+\r
+ MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS\r
+ MOVEI A,CHNL1(TVP) ; 1ST SLOT\r
+\r
+ SKIPE 1(A) ; NOW A CHANNEL?\r
+ SETZM (A) ; DON'T MARK AS CHANNELS\r
+ ADDI A,2\r
+ SOJG 0,.-3\r
+\r
+ MOVE A,PVP ;START AT PROCESS VECTOR\r
+ MOVEI B,TPVP ;IT IS A PROCESS VECTOR\r
+ PUSHJ P,MARK ;AND MARK THIS VECTOR\r
+ MOVEI B,TPVP\r
+ MOVE A,MAINPR ; MARK MAIN PROCES EVEN IF SWAPPED OUT\r
+ PUSHJ P,MARK\r
+\r
+; ASSOCIATION AND VALUE FLUSHING PHASE\r
+\r
+ SKIPN GCHAIR ; ONLY IF HAIR\r
+ PUSHJ P,VALFLS\r
+\r
+ SKIPE GCHAIR ; IF NOT HAIR, DO CHANNELS NOW\r
+ PUSHJ P,CHNFLS\r
+\r
+;OPTIONAL RETIMING PHASE\r
+;THIS HAS BEEN FLUSHED BECAUSE OF PLANNER\r
+ REPEAT 0,[\r
+ SKIPE A,TIMOUT ;ANY TIME OVERFLOWS\r
+ PUSHJ P,RETIME ;YES, RE-CALIBRATE THEM\r
+]\r
+;UPDATE PARTOP\r
+\r
+ MOVEI A,@BOTNEW\r
+ SUB A,PARNEW\r
+ MOVEM A,PARTOP\r
+\r
+;CORE ADJUSTMENT PHASE\r
+ MOVE P,GCPDL ; GET A PDL\r
+ SETZM CORSET ;CLEAR LATER CORE SETTING\r
+ PUSHJ P,CORADJ ;AND MAKE CORE ADJUSTMENTS\r
+\r
+;RELOCATION ESTABLISHMENT PHASE\r
+;1 -- IN VECTOR SPACE, ESTABLISH POINTERS TO TOP OF CORE\r
+ MOVE A,VECTOP" ;START AT TOP OF VECTOR SPACE\r
+ MOVE B,VECNEW" ;AND SET TO INITIAL OFFSET\r
+ SUBI A,1 ;POINT TO DOPE WORDS\r
+ ADDI B,(A) ; WHERE TOP VECTOR WILL GO\r
+ PUSHJ P,VECREL ;AND ESTABLISH RELOCATION FOR VECTORS\r
+ SUBI B,(A) ; RE-RELATIVIZE VECNEW\r
+ MOVEM B,VECNEW ;SAVE FINAL OFFSET\r
+\r
+\r
+\f; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE\r
+\r
+ MOVE B,PARTOP ; POINT TO TOP OF PAIRS\r
+ ADDI B,2000\r
+ ANDCMI B,1777\r
+ CAMGE B,VECBOT ; OVERLAP VECTORS\r
+ JRST DOMAP\r
+ MOVE C,VECBOT\r
+ ANDI C,1777 ; REL TO PAGE\r
+ ADDI C,FRONT ; 1ST DEST WORD\r
+ HRL C,VECBOT\r
+ BLT C,FRONT+1777 ; MUNG IT\r
+\r
+DOMAP: ASH B,-10. ; TO PAGES\r
+ MOVE A,PARBOT\r
+ MOVEI C,(A) ; COMPUTE HIS TOP\r
+ ADD C,PARNEW\r
+ ASH C,-10.\r
+ ASH A,-10.\r
+ SUBM A,B ; B==> - # OF PAGES\r
+ HRLI A,(B) ; AOBJN TO SOURCE AND DEST\r
+ MOVE B,A ; IN CASE OF FUNNY\r
+ HRRI B,(C) ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES\r
+ PUSHJ P,%INFMP ; NOW FLUSH INF AND MAKE HIS CORE MINE\r
+\r
+\f;POINTER UPDATE PHASE\r
+;1 -- UPDATE ALL PAIR POINTERS\r
+ MOVE A,PARBOT ;START AT BOTTOM OF PAIR SPACE\r
+ PUSHJ P,PARUPD ;AND UPDATE ALL PAIR POINTERS\r
+\r
+;2 -- UPDATE ALL VECTORS\r
+ MOVE A,VECTOP ;START AT TOP OF VECTOR SPACE\r
+ PUSHJ P,VECUPD ;AND UPDATE THE POINTERS\r
+ MOVE A,CODTOP ; NOW UPDATE STORAGE STUFF\r
+ MOVEI D,0 ; FAKE OUT TO NOT UNMARK\r
+ PUSHJ P,STOUP\r
+ MOVSI D,400000\r
+\r
+;3 -- UPDATE THE PVP AC\r
+ MOVEI A,PVP-1 ;SET LOC TO POINT TO PVP\r
+ MOVE C,PVP ;GET THE DATUM\r
+ PUSHJ P,NWRDUP ;AND UPDATE THIS VALUE\r
+;4 -- UPDATE THE MAIN PROCESS POINTER\r
+ MOVEI A,MAINPR-1 ;POINT TO MAIN PROCESS POINTER\r
+ MOVE C,MAINPR ;GET CONTENTS IN C\r
+ PUSHJ P,NWRDUP ;AND UPDATE IT\r
+;DATA MOVEMMENT ANDCLEANUP PHASE\r
+\r
+;1 -- ADJUST FOR SHRINKING VECTORS\r
+ MOVE A,VECTOP ;VECTOR SHRINKING PHASE\r
+ SKIPE SHRUNK ; SKIP IF NO SHRINKERS\r
+ PUSHJ P,VECSH ;GO SHRINK ANY SHRINKERS\r
+\r
+;2 -- MOVE VECTORS (AND LIST ELEMENTS)\r
+ MOVE A,VECTOP ;START AT TOP OF VECTOR SPACE\r
+ PUSHJ P,VECMOVE ;AND MOVE THE VECTORS\r
+ MOVE A,VECNEW ;GET FINAL CHANGE TO VECBOT\r
+ ADDM A,VECBOT ;OFFSET VECBOT TO ITS NEW PLACE\r
+ MOVE A,CORTOP ;GET NEW VALUE FOR TOP OF VECTOR SPACE\r
+ SUBI A,2000 ; FUDGE FOR MARK PDL\r
+ MOVEM A,VECTOP ;AND UPDATE VECTOP\r
+\r
+;3 -- CLEANUP VECTORS (NOTE A CONTAINS NEW VECTOP)\r
+\r
+ SKIPE GREW ; SKIP IF NO GROWERS\r
+ PUSHJ P,VECZER ;\r
+ PUSHJ P,STOGC\r
+\r
+;GARBAGE ZEROING PHASE\r
+GARZER: MOVE A,PARTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE\r
+ HRLS A ;GET FIRST ADDRESS IN LEFT HALF\r
+ MOVE B,VECBOT ;LAST ADDRESS OF GARBAGE + 1\r
+ CLEARM (A) ;ZERO THE FIRST WORD\r
+ ADDI A,1 ;MAKE A A BLT POINTER\r
+ BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA\r
+\r
+;FINAL CORE ADJUSTMENT\r
+ SKIPE A,CORSET ;IFLESS CORE NEEDED\r
+ PUSHJ P,CORADL ;GIVE SOME AWAY.\r
+\r
+;NOW REHASH THE ASSOCIATIONS BASED ON NEW VALUES\r
+\r
+ PUSHJ P,REHASH\r
+\r
+\f;RESTORE AC'S\r
+TRYCOX: MOVE 0,VECBOT\r
+ SUB 0,PARTOP\r
+ ADDM 0,NOWFRE\r
+ SKIPN GCMONF\r
+ JRST NOMONO\r
+ MOVEI B,[ASCIZ /GOUT /]\r
+ PUSHJ P,MSGTYP\r
+NOMONO: IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,PVP,TVP]\r
+ MOVE AC,AC!STO+1(PVP)\r
+ TERMIN\r
+; CLOSING ROUTINE FOR G-C\r
+ PUSH P,A ; SAVE AC'C\r
+ PUSH P,B\r
+ PUSH P,C\r
+ PUSH P,D\r
+ PUSHJ P,CTIME\r
+ PUSHJ P,FIXSEN ; OUTPUT TIME\r
+ SKIPN GCMONF\r
+ JRST GCCONT\r
+ MOVEI A,15 ; OUTPUT C/R LINE-FEED\r
+ PUSHJ P,MTYO\r
+ MOVEI A,12\r
+ PUSHJ P,MTYO\r
+GCCONT: POP P,D ; RESTORE AC'C\r
+ POP P,C\r
+ POP P,B\r
+ POP P,A\r
+ MOVE A,GCDANG ; ERROR LEVELS TO ACS\r
+ ADD A,GCDNTG\r
+ SETZM GCDANG ; NOW CLEAR SAME\r
+ SETZM GCDNTG\r
+ JUMPGE A,AGCWIN\r
+ SKIPN GCHAIR ; WAS IT A FLUSHER?\r
+ JRST AGCWIN ; YES, NO MORE AVAILABLE\r
+ MOVEI A,1\r
+ MOVEM A,GCHAIR ; RE-DO WITH HAIR\r
+ MOVE A,SPARNW ; RESET PARNEW\r
+ MOVEM A,PARNEW\r
+ SETZM SPARNW\r
+ MOVE C,[11,10.] ; INDICATOR FOR AGC\r
+ JRST AGC ; TRY ONCE MORE\r
+\r
+AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL\r
+ SETZM GETNUM ;ALSO CLEAR THIS\r
+ SETZM GCFLG\r
+\r
+ JUMPGE P,RBLDM ; DONT LOSE ON BLOWN PDLS\r
+ JUMPGE TP,RBLDM\r
+ CAMGE A,[-1] ; SKIP IF GOOD NEWS\r
+ JRST RBLDM\r
+ SETZM PGROW ; CLEAR GROWTH\r
+ SETZM TPGROW\r
+ SETOM GCHAPN ; INDICATE A GC HAS HAPPENED\r
+ SETOM INTFLG ; AND REQUEST AN INTERRUPT\r
+ SETZM GCDOWN\r
+\r
+RBLDM: JUMPGE R,CPOPJ\r
+ SKIPGE M,1(R) ; SKIP IF FUNNY\r
+ POPJ P,\r
+\r
+ HLRS M\r
+ ADD M,PURVEC+1(TVP)\r
+ SKIPL M,1(M)\r
+ POPJ P,\r
+ PUSH P,0\r
+ HRRZ 0,1(R)\r
+ ADD M,0\r
+ POP P,0\r
+CPOPJ: POPJ P,\r
+\r
+\r
+AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR\r
+\r
+\f; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL\r
+; POINT.\r
+\r
+FIXSEN: PUSH P,B ; SAVE TIME\r
+ MOVEI B,[ASCIZ /TIME= /]\r
+ SKIPE GCMONF\r
+ PUSHJ P,MSGTYP ; PRINT OUT MESSAGE\r
+ POP P,B ; RESTORE B\r
+ FSBR B,GCTIM ; GET TIME ELAPSED\r
+ MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER\r
+ SKIPN GCMONF\r
+ POPJ P,\r
+ FMPRI B,(100.0) ; CONVERT TO FIX\r
+ MULI B,400\r
+ TSC B,B\r
+ ASH C,-163.(B)\r
+ MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME\r
+ PUSH P,C\r
+ IDIVI C,10. ; START COUNTING\r
+ JUMPLE C,.+2\r
+ AOJA A,.-2\r
+ POP P,C\r
+ CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER\r
+ JRST DOT1\r
+FIXOUT: IDIVI C,10. ; RECOVER NUMBER\r
+ HRLM D,(P)\r
+ SKIPE C\r
+ PUSHJ P,FIXOUT\r
+ PUSH P,A ; SAVE A\r
+ CAIN A,2 ; DECIMAL POINT HERE?\r
+ JRST DOT2\r
+FIX1: HLRZ A,(P)-1 ; GET NUMBER\r
+ ADDI A,60 ; MAKE IT A CHARACTER\r
+ PUSHJ P,MTYO ; OUT IT GOES\r
+ POP P,A\r
+ SOJ A,\r
+ POPJ P,\r
+DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0\r
+ PUSHJ P,MTYO\r
+ MOVEI A,"0\r
+ PUSHJ P,MTYO\r
+ JRST FIXOUT ; CONTINUE\r
+DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT\r
+ PUSHJ P,MTYO\r
+ JRST FIX1\r
+\r
+\f; INITIAL CORE ADJUSTMENT TO OBTAIN SPACE\r
+; FOR MARK PHASE PDL\r
+\r
+TRYCOR: MOVEI A,2000\r
+ ADDB A,CORTOP ; TRY AND GET 1 BLOCK\r
+ ASH A,-10.\r
+ MOVEI E,(A) ; SAVE FOR LOOPER\r
+ PUSHJ P,P.CORE ; GET CORE\r
+ JRST TRYCO2 ; FAILED, TAKE MORE ACTION\r
+ JRST CORGET\r
+\r
+TRYCO2: MOVNI A,2000 ; FIXUP CORTOP\r
+ ADDM A,CORTOP\r
+TRYCO3: MOVE 0,TPGROW\r
+ ADD 0,PGROW ; 0/ NEQ 0 IF STACK BLEW\r
+ SKIPGE TP ; SKIP IF TP BLOWN\r
+ SKIPL PSTO+1(PVP) ; SKIP IF P WINS\r
+ MOVEI 0,1\r
+ SKIPN 0\r
+ MOVEI B,[ASCIZ /\r
+CORE NEEDED:\r
+ TYPE C TO KEEP TRYING\r
+ TYPE N TO GET MUDDLE ERROR\r
+ TYPE V TO RETURN TO MONITOR\r
+/]\r
+ SKIPE 0\r
+ MOVEI B,[ASCIZ /\r
+CORE NEEDED:\r
+ TYPE C TO KEEP TRYING\r
+ TYPE V TO RETURN TO MONITOR\r
+/]\r
+ PUSH P,0\r
+ PUSHJ P,MSGTYP\r
+ SETOM GCFLCH ; TELL INTERRUPT HANDLER TO .ITYIC\r
+ PUSHJ P,MTYI\r
+ PUSHJ P,UPLO ; IN CASE LOWER CASE TYPED\r
+ SETZM GCFLCH\r
+ POP P,0\r
+ CAIN A,"C\r
+ JRST TRYCO4\r
+ CAIN A,"N\r
+ JUMPE 0,TRYCO5\r
+ CAIN A,"V\r
+ FATAL CORE LOSSAGE\r
+ JRST TRYCO3\r
+\r
+UPLO: CAIL A,"a\r
+ CAILE A,"z\r
+ POPJ P,\r
+ SUBI A,40\r
+ POPJ P,\r
+\r
+TRYCO4: MOVEI A,(E)\r
+TRYCO9: MOVEI B,1 ; SLEEP AND CORE UNTIL WINNAGE\r
+ EXCH A,B\r
+ PUSHJ P,%SLEEP ; SLEEP A WHILE\r
+ EXCH A,B\r
+ PUSHJ P,P.CORE\r
+ JRST TRYCO9\r
+\r
+ MOVEI B,[ASCIZ /\r
+WIN!\r
+/]\r
+ PUSHJ P,MSGTYP\r
+ JRST CORGET\r
+\r
+TRYCO5: MOVNI A,3 ; GIVE WORST ERROR RETURN\r
+ MOVEM A,GCDANG\r
+ JRST TRYCOX\r
+\r
+\r
+\f; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING\r
+\r
+PDLCHK: JUMPGE A,CPOPJ\r
+ HLRE B,A ;GET NEGATIVE COUNT\r
+ MOVE C,A ;SAVE A COPY OF PDL POINTER\r
+ SUBI A,-1(B) ;LOCATE DOPE WORD PAIR\r
+ HRRZS A ; ISOLATE POINTER\r
+ CAME A,TPGROW ;GROWING?\r
+ ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD\r
+ HLRZ D,(A) ;GET COUNT FROM DOPE WORD\r
+ MOVNS B ;GET POSITIVE AMOUNT LEFT\r
+ SUBI D,2(B) ; PDL FULL?\r
+ JUMPE D,NOFENC ;YES NO FENCE POSTING\r
+ SETOM 1(C) ;CLOBBER TOP WORD\r
+ SOJE D,NOFENC ;STILL MORE?\r
+ MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS\r
+ HRRI D,2(C)\r
+ BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS\r
+\r
+\r
+NOFENC: CAIG B,TPMAX ;NOW CHECK SIZE\r
+ CAIG B,TPMIN\r
+ JRST MUNGTP ;TOO BIG OR TOO SMALL\r
+ POPJ P,\r
+\r
+MUNGTP: SUBI B,TPGOOD ;FIND DELTA TP\r
+MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED\r
+ TRNE C,777000 ;SKIP IF NOT\r
+ POPJ P, ;ASSUME GROWTH GIVEN WILL WIN\r
+\r
+ ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS\r
+ JUMPLE B,MUNGT1\r
+ CAILE B,377 ; SKIP IF BELOW MAX\r
+ MOVEI B,377 ; ELSE USE MAX\r
+ TRO B,400 ;TURN ON SHRINK BIT\r
+ JRST MUNGT2\r
+MUNGT1: MOVMS B\r
+ ANDI B,377\r
+MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD\r
+ POPJ P,\r
+\r
+; CHECK UNMARKED STACK (NO NEED TO FENCE POST)\r
+\r
+PDLCHP: HLRE B,A ;-LENGTH TO B\r
+ MOVE C,A\r
+ SUBI A,-1(B) ;POINT TO DOPE WORD\r
+ HRRZS A ;ISOLATE POINTER\r
+ CAME A,PGROW ;GROWING?\r
+ ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD\r
+ MOVMS B ;PLUS LENGTH\r
+ HLRZ D,(A) ; D.W. LENGTH\r
+ SUBI D,2(B) ; PDL FULL\r
+ JUMPE D,NOPF\r
+ SETOM 1(C) ; START FENECE POST\r
+ SOJE D,NOPF ; 1 WORD?\r
+ MOVSI D,1(C)\r
+ HRRI D,2(C)\r
+ BLT D,-2(A)\r
+\r
+NOPF: CAIG B,PMAX ;TOO BIG?\r
+ CAIG B,PMIN ;OR TOO LITTLE\r
+ JRST .+2 ;YES, MUNG IT\r
+ POPJ P,\r
+ SUBI B,PGOOD\r
+ JRST MUNG3\r
+\r
+;THIS ROUTINE MAKES SURE CURRENT FRAME MAKES SENSE\r
+FRMUNG: MOVEM D,PSAV(A)\r
+ MOVEM SP,SPSAV(A)\r
+ MOVEM TP,TPSAV(A) ;SAVE FOR MARKING\r
+ POPJ P,\r
+\r
+; ROUTINE TO PRE MARK SPECIAL HACKS\r
+\r
+PRMRK: SKIPE GCHAIR ; FLUSH IF NO HAIR\r
+ POPJ P,\r
+ HLRE B,A\r
+ SUBI A,(B) ;POINT TO DOPE WORD\r
+ HLRZ B,1(A) ; GET LNTH\r
+ ADDM B,VECNUM ; AND UPDATE VECNUM\r
+ LDB B,[111100,,(A)] ; GET GROWTHS\r
+ TRZE B,400 ; SIGN HACK\r
+ MOVNS B\r
+ ASH B,6 ; TO WORDS\r
+ ADDM B,VECNUM\r
+ LDB 0,[001100,,(A)]\r
+ TRZE 0,400\r
+ MOVNS 0\r
+ ASH 0,6\r
+ ADDM 0,VECNUM\r
+ PUSHJ P,GSHFLG ; SET GROW FLAGS\r
+ IORM D,1(A) ;AND MARK\r
+ POPJ P,\r
+\r
+; SET UP FLAGS FOR OPTIOANAL GROW/SHRINK PHASES\r
+\r
+GSHFLG: SKIPG B\r
+ SKIPLE 0\r
+ SETOM GREW\r
+ SKIPL B\r
+ SKIPGE 0\r
+ SETOM SHRUNK\r
+ POPJ P,\r
+\r
+\f;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS\r
+; A/ GOODIE TO MARK FROM\r
+; B/ TYPE OF A (IN RH)\r
+; C/ TYPE,DATUM PAIR POINTER\r
+\r
+MARK2: HLRZ B,(C) ;GET TYPE\r
+MARK1: MOVE A,1(C) ;GET GOODIE\r
+MARK: JUMPE A,CPOPJ ; NEVER MARK 0\r
+ MOVEI 0,(A)\r
+ CAIL 0,@PURBOT ; DONT MARK PURE STUFF\r
+ POPJ P,\r
+ PUSH P,A ;SAVE GOODIE\r
+ HRLM C,-1(P) ;AND POINTER TO IT\r
+ ANDI B,TYPMSK ; FLUSH MONITORS\r
+ LSH B,1 ;TIMES 2 TO GET SAT\r
+ HRRZ B,@TYPNT ;GET SAT\r
+ ANDI B,SATMSK\r
+ CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA\r
+ JRST @MKTBS(B) ;AND GO MARK\r
+ JRST TD.MRK\r
+\r
+; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)\r
+\r
+DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK]\r
+[STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK],[SSTORE,VECTMK]\r
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK],[SGATOM,GATOMK]\r
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SLOCL,PAIRMK]\r
+[SLOCA,<SETZ ARGMK>],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,<SETZ BYTMK>],[SLOCN,ASMRK]]\r
+\r
+\r
+;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER\r
+\r
+DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG\r
+\r
+;HERE TO MARK LIST ELEMENTS\r
+\r
+PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT\r
+ PUSH P,[0] ; WILL HOLD BACK PNTR\r
+ MOVEI C,(A) ;POINT TO LIST\r
+PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS\r
+ CAMGE C,PARBOT\r
+ FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE\r
+ SKIPGE B,(C) ;SKIP IF NOT MARKED\r
+ JRST RETNEW ;ALREADY MARKED, RETURN\r
+ IORM D,(C) ;MARK IT\r
+ AOS PARNUM\r
+ MOVEM B,FRONT(FPTR) ; STORE 1ST WORD\r
+ MOVE 0,1(C) ; AND 2D\r
+ MOVEM 0,FRONT+1(FPTR)\r
+ ADD FPTR,[2,,2] ; MOVE ALONG IN FRONTIER\r
+ JUMPL FPTR,PAIRM2 ; NOD NEED FOR NEW CORE\r
+\r
+; HERE TO EXTEND THE FRONTIER\r
+\r
+ HRRZ A,BOTNEW ; CURRENT BOTTOM OF WINDOW IN INF\r
+ ADDI A,2000 ; MOVE IT UP\r
+ HRRM A,BOTNEW\r
+ ASH A,-10. ; TO PAGES\r
+SYSLO1: PUSHJ P,%GETIP ; GET PAGE\r
+ PUSHJ P,%SHFNT ; AND SHARE IT\r
+ MOVSI FPTR,-2000\r
+\r
+PAIRM2: MOVEI A,@BOTNEW ; GET INF ADDR\r
+ SUBI A,2\r
+ HRRM A,(C) ; LEAVE A POINTER TO NEW HOME\r
+ HRRZ E,(P) ; GET BACK POINTER\r
+ JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP\r
+ MOVSI 0,(HRRM) ; INS FOR CLOBBER\r
+ PUSHJ P,SMINF ; SMASH INF'S CORE IMAGE\r
+PAIRM4: MOVEM A,(P) ; NEW BACK POINTER\r
+ JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER\r
+ HRLM B,(P) ; SAVE OLD CDR\r
+ PUSHJ P,MARK2 ;MARK THIS DATUM\r
+ HRRZ E,(P) ; SMASH CAR IN CASE CHANGED\r
+ ADDI E,1\r
+ MOVSI 0,(MOVEM)\r
+ PUSHJ P,SMINF\r
+ HLRZ C,(P) ;GET CDR OF LIST\r
+ CAIGE C,@PURBOT ; SKIP IF PURE (I.E. DONT MARK)\r
+ JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT\r
+GCRETP: SUB P,[1,,1]\r
+\r
+GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT\r
+ HLRZ C,-1(P) ;RESTORE C\r
+ POP P,A\r
+ POPJ P, ;AND RETURN TO CALLER\r
+\r
+;HERE TO MARK DEFERRED POINTER\r
+\r
+DEFDO: PUSH P,B ; PUSH OLD PAIR ON STACK\r
+ PUSH P,1(C)\r
+ MOVEI C,-1(P) ; USE AS NEW DATUM\r
+ PUSHJ P,MARK2 ;MARK THE DATUM\r
+ HRRZ E,-2(P) ; GET POINTER IN INF CORE\r
+ ADDI E,1\r
+ MOVSI 0,(MOVEM)\r
+ PUSHJ P,SMINF ; AND CLOBBER\r
+ SUB P,[3,,3]\r
+ JRST GCRET ;AND RETURN\r
+\r
+\r
+PAIRM7: MOVEM A,-1(P) ; SAVE NEW VAL FOR RETURN\r
+ JRST PAIRM4\r
+\r
+RETNEW: HRRZ A,(C) ; POINT TO NEW WORLD LOCN\r
+ HRRZ E,(P) ; BACK POINTER\r
+ JUMPE E,RETNW1 ; NONE\r
+ MOVSI 0,(HRRM)\r
+ PUSHJ P,SMINF\r
+ JRST GCRETP\r
+\r
+RETNW1: MOVEM A,-1(P)\r
+ JRST GCRETP\r
+\r
+; ROUTINE TO SMASH INFERIORS PPAGES\r
+; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE\r
+\r
+SMINF: CAML E,WNDBOT ; SEE IF IN WINDOW\r
+ CAML E,WNDTOP\r
+ JRST SMINF1 ; NO TRY FRONTIER\r
+SMINF3: SUB E,WNDBOT ; FIX UP\r
+ IOR 0,[0 A,WIND(E)] ; FIX INS\r
+ XCT 0\r
+ POPJ P,\r
+\r
+SMINF1: PUSH P,0\r
+ HRRZ 0,BOTNEW ; GET FRONTIER RANGE\r
+ CAML E,0 ; SKIP IF BELOW\r
+ CAIL E,@BOTNEW\r
+ JRST SMINF2\r
+ SUB E,0 ; FIXUP E\r
+ POP P,0\r
+ IOR 0,[0 A,FRONT(E)]\r
+ XCT 0\r
+ POPJ P,\r
+\r
+SMINF2: PUSH P,A\r
+ MOVE A,E\r
+ ASH A,-10. ; TO PAGES\r
+ PUSHJ P,%SHWND\r
+ ASH A,10. ; BACK TO WORDS\r
+ MOVEM A,WNDBOT\r
+ ADDI A,2000\r
+ MOVEM A,WNDTOP\r
+ POP P,A\r
+ POP P,0 ; RESTORE INS OF INTEREST\r
+ JRST SMINF3\r
+ \r
+\r
+\f; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE\r
+\r
+TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG\r
+VECTMK: TLZ TYPNT,400000\r
+ MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR\r
+ HLRE B,A ;GET -LNTH\r
+ SUB A,B ;LOCATE DOPE WORD\r
+ MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD\r
+ PUSHJ P,VECBND ; CHECK IN VECTOR SPACE\r
+ JRST VECTB1 ;LOSE, COMPLAIN\r
+\r
+ JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK\r
+ CAME A,PGROW ;IS THIS THE BLOWN P\r
+ CAMN A,TPGROW ;IS THIS THE GROWING PDL\r
+ JRST NOBUFR ;YES, DONT ADD BUFFER\r
+ ADDI A,PDLBUF ;POINT TO REAL DOPE WORD\r
+ MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER\r
+ ADDB 0,1(C)\r
+ MOVEM 0,(P) ; FIXUP RET'D PNTR\r
+\r
+NOBUFR: HLRE B,(A) ;GET LENGTH FROM DOPE WORD\r
+ JUMPL B,GCRET ; MARKED, LEAVE\r
+ ANDI B,377777 ;CLOBBER POSSIBLE MARK BIT\r
+ MOVEI F,(A) ;SAVE A POINTER TO DOPE WORD\r
+ SUBI F,1(B) ;F POINTS TO START OF VECTOR\r
+ HRRZ 0,-1(A) ;SEE IF GROWTH SPECIFIED\r
+ MOVEI B,0 ; SET GROWTH 0\r
+ JUMPE 0,NOCHNG ;NONE, JUST CHECK CURRENT SIZES\r
+\r
+ LDB B,[001100,,0] ;GET GROWTH FACTOR\r
+ TRZE B,400 ;KILL SIGN BIT AND SKIP IF +\r
+ MOVNS B ;NEGATE\r
+ ASH B,6 ;CONVERT TO NUMBER OF WORDS\r
+ SUB F,B ;BOTTOM IS LOWER IN CORE\r
+ LDB 0,[111100,,0] ;GET TOP GROWTH\r
+ TRZE 0,400 ;HACK SIGN BIT\r
+ MOVNS 0\r
+ ASH 0,6 ;CONVERT TO WORDS\r
+ PUSHJ P,GSHFLG ; HACK FLAGS FOR GROW/SHRINK\r
+ ADD B,0 ;TOTAL GROWTH TO B\r
+NOCHNG:\r
+VECOK: HLRE E,(A) ;GET LENGTH AND MARKING\r
+ MOVEI F,(E) ;SAVE A COPY\r
+ ADD F,B ;ADD GROWTH\r
+ SUBI E,2 ;- DOPE WORD LENGTH\r
+ IORM D,(A) ;MAKE SURE NOW MARKED\r
+ CAML A,VECBOT ; ONLY IF REALLY IN VEC SPACE\r
+ ADDM F,VECNUM ; ADD LENGTH OF VECTOR\r
+ JUMPLE E,GCRET ;ALREADY MARKED OR ZERO LENGTH, LEAVE\r
+\r
+ SKIPGE B,-1(A) ;SKIP IF UNIFORM\r
+ TLNE B,377777 ;SKIP IF NOT SPECIAL\r
+ JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR\r
+\r
+GENRAL: HLRZ 0,B ;CHECK FOR PSTACK\r
+ JUMPE 0,NOTGEN ;IT ISN'T GENERAL\r
+ SUBI A,1(E) ;POINT TO FIRST ELEMENT\r
+ MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C\r
+\r
+\f; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR\r
+ PUSH P,[0]\r
+VECTM2: HLRE B,(C) ;GET TYPE AND MARKING\r
+ JUMPL B,GCRET1 ;RETURN, (EITHER DOPE WORD OR FENCE POST)\r
+ MOVE A,1(C) ;DATUM TO A\r
+ ANDI B,TYPMSK ; FLUSH MONITORS\r
+ CAIE B,TCBLK ;IS THIS A SAVED FRAME?\r
+ CAIN B,TENTRY ;IS THIS A STACK FRAME\r
+ JRST MFRAME ;YES, MARK IT\r
+ CAIE B,TUBIND ; BIND\r
+ CAIN B,TBIND ;OR A BINDING BLOCK\r
+ JRST MBIND\r
+\r
+VECTM3: PUSHJ P,MARK ;MARK DATUM\r
+ MOVEM A,1(C) ; IN CASE WAS FIXED\r
+VECTM4: ADDI C,2\r
+ JRST VECTM2\r
+\r
+MFRAME: HRROI C,FRAMLN+FSAV-1(C) ;POINT TO FUNCTION\r
+ HRRZ A,1(C) ; GET IT\r
+ PUSHJ P,VECBND ; CHECK IN VECTOR SPACE\r
+ JRST MFRAM1 ; IGNORE, NOT IN VECTOR SPACE\r
+ HRL A,(A) ; GET LENGTH\r
+ MOVEI B,TVEC\r
+ PUSHJ P,MARK ; AND MARK IT\r
+MFRAM1: HRROI C,SPSAV-FSAV(C) ;POINT TO SAVED SP\r
+ MOVEI B,TSP\r
+ PUSHJ P,MARK1 ;MARK THE GOODIE\r
+ HRROI C,PSAV-SPSAV(C) ;POINT TO SAVED P\r
+ MOVEI B,TPDL\r
+ PUSHJ P,MARK1 ;AND MARK IT\r
+ HRROI C,TPSAV-PSAV(C) ;POINT TO SAVED TP\r
+ MOVEI B,TTP\r
+ PUSHJ P,MARK1 ;MARK IT ALS\r
+ MOVEI C,-TPSAV+1(C) ;POINT PAST THE FRAME\r
+ JRST VECTM2 ;AND DO MORE MARKING\r
+\r
+\r
+MBIND: MOVEI B,TATOM ;FIRST MARK ATOM\r
+ SKIPN GCHAIR ; IF NO HAIR, MARK ALL NOW\r
+ SKIPE (P) ; PASSED MARKER, IF SO DONT SKIP\r
+ JRST MBIND2 ; GO MARK\r
+ CAME A,IMQUOTE THIS-PROCESS\r
+ JRST MBIND1 ; NOT IT, CONTINUE SKIPPING\r
+ HRRM LPVP,2(C) ; SAVE IN RH OF TPVP,,0\r
+ MOVEI LPVP,(C) ; POINT\r
+ SETOM (P) ; INDICATE PASSAGE\r
+MBIND1: ADDI C,6 ; SKIP BINDING\r
+ JRST VECTM2\r
+\r
+MBIND2: PUSHJ P,MARK1 ; MARK ATOM\r
+ ADDI C,2 ; POINT TO VAL\r
+ PUSHJ P,MARK2 ; AND MARK IT\r
+ MOVEM A,1(C)\r
+ ADDI C,2\r
+ MOVEI B,TLIST ; POINT TO DECL SPECS\r
+ HLRZ A,(C)\r
+ PUSHJ P,MARK ; AND MARK IT\r
+ HRLM A,(C) ; LIST FIX UP\r
+ MOVEI B,TLOCI ; NOW MARK LOCATIVE\r
+ MOVE A,1(C)\r
+ JRST VECTM3\r
+\r
+VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE\r
+ HLLZ 0,(C) ;GET TYPE\r
+ MOVEI B,TILLEG ;GET ILLEGAL TYPE\r
+ HRLM B,(C)\r
+ MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE\r
+ JRST GCRET ;RETURN WITHOUT MARKING VECTOR\r
+\r
+CCRET: CLEARM 1(C) ;CLOBBER THE DATUM\r
+ JRST GCRET\r
+\r
+\r
+IGBLK: HRRZ B,(C) ;SKIP TO END OF PP BLOCK\r
+ ADDI C,3(B)\r
+ JRST VECTM2\r
+\f; MARK ARG POINTERS\r
+\r
+ARGMK: HRRZ A,1(C) ; GET POINTER\r
+ HLRE B,1(C) ; AND LNTH\r
+ SUB A,B ; POINT TO BASE\r
+ PUSHJ P,VECBND\r
+ JRST ARGMK0\r
+ HLRZ 0,(A) ; GET TYPE\r
+ ANDI 0,TYPMSK\r
+ CAIN 0,TCBLK\r
+ JRST ARGMK1\r
+ CAIE 0,TENTRY ; IS NEXT A WINNER?\r
+ CAIN 0,TINFO\r
+ JRST ARGMK1 ; YES, GO ON TO WIN CODE\r
+\r
+ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL\r
+ SETZM (P) ; AND SAVED COPY\r
+ JRST GCRET\r
+\r
+ARGMK1: MOVE B,1(A) ; ASSUME TTB\r
+ ADDI B,(A) ; POINT TO FRAME\r
+ CAIE 0,TINFO ; IS IT?\r
+ MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE\r
+ HLRZ 0,OTBSAV(B) ; GET TIME\r
+ HRRZ A,(C) ; AND FROM POINTER\r
+ CAIE 0,(A) ; SKIP IF WINNER\r
+ JRST ARGMK0\r
+ HRROI C,TPSAV-1(B) ; MARK FROM TP SLOT\r
+ MOVEI B,TTP\r
+ MOVE A,1(C)\r
+; PUSHJ P,MARK ; WILL PUT BACK WHEN KNOWN HOW!\r
+ JRST GCRET\r
+\r
+; MARK FRAME POINTERS\r
+\r
+FRMK: SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR\r
+ HRRZ A,1(C) ;USE AS DATUM\r
+ SUBI A,1 ;FUDGE FOR VECTMK\r
+ MOVEI B,TPVP ;IT IS A VECTRO\r
+ PUSHJ P,MARK ;MARK IT\r
+ JRST GCRET\r
+\r
+; MARK BYTE POINTER\r
+\r
+BYTMK: PUSHJ P,BYTDOP ; GET DOPE WORD IN A\r
+ SOJG A,VECTMK ;FUDGE DOPE WORD POINTER FOR VECTMK\r
+\r
+ FATAL AGC--BYTE POINTER WITH ZERO DOPE WORD POINTER\r
+\r
+\f; MARK ATOMS IN GVAL STACK\r
+\r
+GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL\r
+ JUMPE B,ATOMK\r
+ CAIN B,-1\r
+ JRST ATOMK\r
+ MOVEI A,(B) ; POINT TO DECL FOR MARK\r
+ MOVEI B,TLIST\r
+ MOVEI C,0\r
+ PUSHJ P,MARK\r
+ HLRZ C,-1(P) ; RESTORE HOME POINTER\r
+ HRRM A,(C) ; CLOBBER UPDATED LIST IN\r
+ MOVE A,1(C) ; RESTORE ATOM POINTER\r
+\r
+; MARK ATOMS\r
+\r
+ATOMK:\r
+REPEAT 0,[\r
+ TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED\r
+ PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS\r
+ HRRZ C,(A) ; IF UNBOUND OR GLOBAL\r
+ JUMPE C,MRKOBL ; SKIP\r
+ HRRZ C,1(A) ; DONT MARK BUT UPDATE BASED ON TPGROW\r
+ HLRE B,1(A)\r
+ SUB C,B ; POINT TO DOPE WORD\r
+ MOVEI C,1(C) ; POINT TO 2D DOPE WORD\r
+ MOVSI B,-PDLBUF ; IN CASE UPDATE\r
+ CAME C,TPGROW ; SKIP IF GROWER\r
+ ADDM B,1(A) ; OTHERWISE UPDATE\r
+MRKOBL: MOVEI C,1(A) ; POINT TO OBLIST SLOT\r
+]\r
+ TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED\r
+ MOVEI C,1(A)\r
+ HRRZ 0,(A)\r
+ PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS\r
+ JUMPE 0,MRKOBL\r
+ HRRZ B,(C)\r
+ HLRE 0,(C)\r
+ SUB B,0\r
+ MOVEI B,1(B)\r
+ MOVSI 0,-PDLBUF\r
+ CAME B,TPGROW\r
+ ADDM 0,(C)\r
+MRKOBL: MOVEI B,TOBLS\r
+ SKIPGE 1(C) ; IF > 0, NOT OBL\r
+ PUSHJ P,MARK1 ; AND MARK IT\r
+ JRST GCRET ;AND LEAVE\r
+\r
+GETLNT: HLRE B,A ;GET -LNTH\r
+ SUB A,B ;POINT TO 1ST DOPE WORD\r
+ MOVEI A,1(A) ;POINT TO 2ND DOPE WORD\r
+ PUSHJ P,VECBND\r
+ JRST VECTB1 ;BAD VECTOR, COMPLAIN\r
+\r
+ HLRE B,(A) ;GET LENGTH AND MARKING\r
+ IORM D,(A) ;MAKE SURE MARKED\r
+ JUMPL B,GCRET1 ;MARKED ALREADY, QUIT\r
+ SUBI A,-1(B) ;POINT TO TOP OF ATOM\r
+ CAML A,VECBOT ; DONT COUNT STORAGE\r
+ ADDM B,VECNUM ;UPDATE VECNUM\r
+ POPJ P, ;AND RETURN\r
+\r
+GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS\r
+ JRST GCRET\r
+\r
+VECBND: CAMGE A,VECTOP\r
+ CAMGE A,VECBOT\r
+ JRST .+2\r
+ JRST CPOPJ1\r
+\r
+ CAMG A,CODTOP\r
+ CAIGE A,STOSTR\r
+ POPJ P,\r
+ JRST CPOPJ1\r
+\r
+; MARK NON-GENERAL VECTORS\r
+\r
+NOTGEN: CAMN B,[GENERAL+<SPVP,,0>] ;PROCESS VECTOR?\r
+ JRST GENRAL ;YES, MARK AS A VECTOR\r
+ JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK\r
+ SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR\r
+ HLRZS B ;ISOLATE TYPE\r
+ ANDI E,TYPMSK\r
+ MOVE F,B ; AND COPY IT\r
+ LSH B,1 ;FIND OUT WHERE IT WILL GO\r
+ HRRZ B,@TYPNT ;GET SAT IN B\r
+ ANDI B,SATMSK\r
+ MOVEI C,@MKTBS(B) ;POINT TO MARK SR\r
+ CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE\r
+ JRST GCRET\r
+ MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START\r
+ PUSH P,E ;SAVE NUMBER OF ELEMENTS\r
+ PUSH P,F ;AND UNIFORM TYPE\r
+\r
+UNLOOP: MOVE B,(P) ;GET TYPE\r
+ MOVE A,1(C) ;AND GOODIE\r
+ TLO C,400000 ;CAN'T MUNG TYPE\r
+ PUSHJ P,MARK ;MARK THIS ONE\r
+ MOVEM A,1(C) ; LIST FIXUP\r
+ SOSE -1(P) ;COUNT\r
+ AOJA C,UNLOOP ;IF MORE, DO NEXT\r
+\r
+ SUB P,[2,,2] ;REMOVE STACK CRAP\r
+ JRST GCRET\r
+\r
+\r
+SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR\r
+\r
+\f;MARK LOCID TYPE GOODIES\r
+\r
+LOCMK: HRRZ B,(C) ;GET TIME\r
+ JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL\r
+ HRRZ 0,2(A) ; GET OTHER TIME\r
+ CAIE 0,(B) ; SAME?\r
+ SETZB A,1(C) ; NO, SMASH LOCATIVE\r
+ JUMPE A,GCRET ; LEAVE IF DONE\r
+LOCMK1: PUSH P,C\r
+ MOVEI B,TATOM ; MARK ATOM\r
+ MOVEI C,-2(A) ; POINT TO ATOM\r
+ PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM\r
+ POP P,C\r
+ HRRZ B,(C) ; TIME BACK\r
+ MOVE A,1(C) ; RESTORE POINTER TO STACK\r
+ JUMPE B,VECTMK ;IF ZERO, GLOBAL\r
+ JRST TPMK ;ELSE, ON TP\r
+\r
+; MARK ASSOCIATION BLOCKS\r
+\r
+ASMRK: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER\r
+ PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS\r
+ MOVEI C,(A) ;COPY POINTER\r
+ PUSHJ P,MARK2 ;MARK ITEM CELL\r
+ MOVEM A,1(C)\r
+ ADDI C,INDIC-ITEM ;POINT TO INDICATOR\r
+ PUSHJ P,MARK2\r
+ MOVEM A,1(C)\r
+ ADDI C,VAL-INDIC\r
+ PUSHJ P,MARK2\r
+ MOVEM A,1(C)\r
+ SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS\r
+ JRST GCRET\r
+ HRRZ A,NODPNT-VAL(C) ; NEXT\r
+ JUMPN A,ASMRK ; IF EXISTS, GO\r
+ JRST GCRET\r
+\r
+\r
+\r
+;HERE WHEN A VECTOR POINTER IS BAD\r
+\r
+VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE\r
+\r
+\f; HERE TO MARK TEMPLATE DATA STRUCTURES\r
+\r
+TD.MRK: HLRZ B,(A) ; GET REAL SPEC TYPE\r
+ ANDI B,377777 ; KILL SIGN BIT\r
+ MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE\r
+ HRLI E,(E)\r
+ ADD E,TD.LNT+1(TVP)\r
+ HRRZS C,A ; FLUSH COUNT AND SAVE\r
+ SKIPL E ; WITHIN BOUNDS\r
+ FATAL BAD SAT IN AGC\r
+ PUSHJ P,GETLNT ; GOODIE IS NOW MARKED\r
+\r
+ XCT (E) ; RET # OF ELEMENTS IN B\r
+\r
+ HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS\r
+ PUSH P,[0] ; TEMP USED IF RESTS EXIST\r
+ PUSH P,D\r
+ MOVEI B,(B) ; ZAP TO ONLY LENGTH\r
+ PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE\r
+ PUSH P,[0] ; HOME FOR VALUES\r
+ PUSH P,[0] ; SLOT FOR TEMP\r
+ PUSH P,B ; SAVE\r
+ SUB E,TD.LNT+1(TVP)\r
+ PUSH P,E ; SAVE FOR FINDING OTHER TABLES\r
+ JUMPE D,TD.MR2 ; NO REPEATING SEQ\r
+ ADD E,TD.GET+1(TVP) ; COMP LNTH OF REPEATING SEQ\r
+ HLRE E,(E) ; E ==> - LNTH OF TEMPLATE\r
+ ADDI E,(D) ; E ==> -LENGTH OF REP SEQ\r
+ MOVNS E\r
+ HRLM E,-5(P) ; SAVE IT AND BASIC\r
+\r
+TD.MR2: SKIPG D,-1(P) ; ANY LEFT?\r
+ JRST TD.MR1\r
+\r
+ MOVE E,TD.GET+1(TVP)\r
+ ADD E,(P)\r
+ MOVE E,(E) ; POINTER TO VECTOR IN E\r
+ MOVEM D,-6(P) ; SAVE ELMENT #\r
+ SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST\r
+ SOJA D,TD.MR3\r
+\r
+ MOVEI 0,(B) ; BASIC LNT TO 0\r
+ SUBI 0,(D) ; SEE IF PAST BASIC\r
+ JUMPGE 0,.-3 ; JUMP IF O.K.\r
+ MOVSS B ; REP LNT TO RH, BASIC TO LH\r
+ IDIVI 0,(B) ; A==> -WHICH REPEATER\r
+ MOVNS A\r
+ ADD A,-5(P) ; PLUS BASIC\r
+ ADDI A,1 ; AND FUDGE\r
+ MOVEM A,-6(P) ; SAVE FOR PUTTER\r
+ ADDI E,-1(A) ; POINT\r
+ SOJA D,.+2\r
+\r
+TD.MR3: ADDI E,(D) ; POINT TO SLOT\r
+ XCT (E) ; GET THIS ELEMENT INTO A AND B\r
+ MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT\r
+ MOVEM B,-2(P)\r
+ EXCH A,B ; REARRANGE\r
+ GETYP B,B\r
+ MOVEI C,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG\r
+ MOVSI D,400000 ; RESET FOR MARK\r
+ PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A)\r
+ MOVE C,-4(P) ; REGOBBLE POINTER TO TEMPLATE\r
+ MOVE E,TD.PUT+1(TVP)\r
+ MOVE B,-6(P) ; RESTORE COUNT\r
+ ADD E,(P)\r
+ MOVE E,(E) ; POINTER TO VECTOR IN E\r
+ ADDI E,(B)-1 ; POINT TO SLOT\r
+ MOVE B,-3(P) ; RESTORE TYPE WORD\r
+ EXCH A,B\r
+ SOS D,-1(P) ; GET ELEMENT #\r
+ XCT (E) ; SMASH IT BACK\r
+ FATAL TEMPLATE LOSSAGE\r
+ MOVE C,-4(P) ; RESTORE POINTER IN CASE MUNGED\r
+ JRST TD.MR2\r
+\r
+TD.MR1: SUB P,[7,,7]\r
+ MOVSI D,400000 ; RESTORE MARK/UNMARK BIT\r
+ JRST GCRET\r
+\r
+; This phase attempts to remove any unwanted associations. The program\r
+; loops through the structure marking values of associations. It can only\r
+; stop when no new values (potential items and/or indicators) are marked.\r
+\r
+VALFLS: PUSH P,[0] ; INDICATE WHETHER ANY ON THIS PASS\r
+ PUSH P,[0] ; OR THIS BUCKET\r
+ASOMK1: MOVE A,ASOVEC+1(TVP) ; GET VECTOR POINTER\r
+ SETOM -1(P) ; INITIALIZE FLAG\r
+\r
+ASOM6: SKIPG C,(A) ; SKIP IF BUCKET TO BE SCANNED\r
+ JRST ASOM1\r
+ SETOM (P) ; SAY BUCKET NOT CHANGED\r
+\r
+ASOM2: MOVEI F,(C) ; COPY POINTER\r
+ SKIPG ASOLNT+1(C) ; SKIP IF NOT ALREADY MARKED\r
+ JRST ASOM4 ; MARKED, GO ON\r
+ PUSHJ P,MARKQ ; SEE IF ITEM IS MARKED\r
+ JRST ASOM3 ; IT IS NOT, IGNORE IT\r
+ MOVEI F,(C) ; IN CASE CLOBBERED BY MARK2\r
+ MOVEI C,INDIC(C) ; POINT TO INDICATOR SLOT\r
+ PUSHJ P,MARKQ\r
+ JRST ASOM3 ; NOT MARKED\r
+\r
+ PUSH P,A ; HERE TO MARK VALUE\r
+ PUSH P,F\r
+ HLRE F,ASOLNT-INDIC+1(C) ; GET LENGTH\r
+ JUMPL F,.+3 ; SKIP IF MARKED\r
+ CAML C,VECBOT ; SKIP IF IN NOT VECT SPACE\r
+ ADDM F,VECNUM\r
+ PUSHJ P,MARK2 ; AND MARK\r
+ MOVEM A,1(C) ; LIST FIX UP\r
+ ADDI C,ITEM-INDIC ; POINT TO ITEM\r
+ PUSHJ P,MARK2\r
+ MOVEM A,1(C)\r
+ ADDI C,VAL-ITEM ; POINT TO VALUE\r
+ PUSHJ P,MARK2\r
+ MOVEM A,1(C)\r
+ IORM D,ASOLNT-VAL+1(C) ; MARK ASOC BLOCK\r
+ POP P,F\r
+ POP P,A\r
+ AOSA -1(P) ; INDICATE A MARK TOOK PLACE\r
+\r
+ASOM3: AOS (P) ; INDICATE AN UNMARKED IN THIS BUCKET\r
+ASOM4: HRRZ C,ASOLNT-1(F) ; POINT TO NEXT IN BUCKET\r
+ JUMPN C,ASOM2 ; IF NOT EMPTY, CONTINUE\r
+ SKIPGE (P) ; SKIP IF ANY NOT MARKED\r
+ HRROS (A) ; MARK BUCKET AS NOT INTERESTING\r
+ASOM1: AOBJN A,ASOM6 ; GO TO NEXT BUCKET\r
+ TLZE TYPNT,.ATOM. ; ANY ATOMS MARKED?\r
+ JRST VALFLA ; YES, CHECK VALUES\r
+VALFL8:\r
+\r
+; NOW SEE WHICH CHANNELS STILL POINTED TO\r
+\r
+CHNFL3: MOVEI 0,N.CHNS-1\r
+ MOVEI A,CHNL1(TVP) ; SLOTS\r
+ HRLI A,TCHAN ; TYPE HERE TOO\r
+\r
+CHNFL2: SKIPN B,1(A)\r
+ JRST CHNFL1\r
+ HLRE C,B\r
+ SUBI B,(C) ; POINT TO DOPE\r
+ HLLM A,(A) ; PUT TYPE BACK\r
+ SKIPGE 1(B)\r
+ JRST CHNFL1\r
+ HLLOS (A) ; MARK AS A LOSER\r
+ PUSH P,A\r
+ PUSH P,0\r
+ MOVEI C,(A)\r
+ PUSHJ P,MARK2\r
+ POP P,0\r
+ POP P,A\r
+ SETZM -1(P) ; SAY MARKED\r
+CHNFL1: ADDI A,2\r
+ SOJG 0,CHNFL2\r
+\r
+ SKIPE GCHAIR ; IF NOT HAIRY CASE\r
+ POPJ P, ; LEAVE\r
+\r
+ SKIPL -1(P) ; SKIP IF NOTHING NEW MARKED\r
+ JRST ASOMK1\r
+\r
+ SUB P,[2,,2] ; REMOVE FLAGS\r
+\r
+\r
+\r
+\f; HERE TO REEMOVE UNUSED ASSOCIATIONS\r
+\r
+ MOVE A,ASOVEC+1(TVP) ; GET ASOVEC BACK FOR FLUSHES\r
+\r
+ASOFL1: SKIPN C,(A) ; SKIP IF BUCKET NOT EMPTY\r
+ JRST ASOFL2 ; EMPTY BUCKET, IGNORE\r
+ HRRZS (A) ; UNDO DAMAGE OF BEFORE\r
+\r
+ASOFL5: SKIPGE ASOLNT+1(C) ; SKIP IF UNMARKED\r
+ JRST ASOFL3 ; MARKED, DONT FLUSH\r
+\r
+ HRRZ B,ASOLNT-1(C) ; GET FORWARD POINTER\r
+ HLRZ E,ASOLNT-1(C) ; AND BACK POINTER\r
+ JUMPN E,ASOFL4 ; JUMP IF NO BACK POINTER (FIRST IN BUCKET)\r
+ HRRZM B,(A) ; FIX BUCKET\r
+ JRST .+2\r
+\r
+ASOFL4: HRRM B,ASOLNT-1(E) ; FIX UP PREVIOUS\r
+ JUMPE B,.+2 ; JUMP IF NO NEXT POINTER\r
+ HRLM E,ASOLNT-1(B) ; FIX NEXT'S BACK POINTER\r
+ HRRZ B,NODPNT(C) ; SPLICE OUT THRAD\r
+ HLRZ E,NODPNT(C)\r
+ SKIPE E\r
+ HRRM B,NODPNT(E)\r
+ SKIPE B\r
+ HRLM E,NODPNT(B)\r
+\r
+ASOFL3: HRRZ C,ASOLNT-1(C) ; GO TO NEXT\r
+ JUMPN C,ASOFL5\r
+ASOFL2: AOBJN A,ASOFL1\r
+\r
+; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES\r
+\r
+ MOVE A,GLOBSP+1(TVP) ; GET GLOBAL PDL\r
+\r
+GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED\r
+ JRST .+3 ; VIOLATE CARDINAL RULE #69\r
+ MOVSI B,-3\r
+ PUSHJ P,ZERSLT ; CLOBBER THE SLOT\r
+ ANDCAM D,(A) ; UNMARK\r
+ ADD A,[4,,4]\r
+ JUMPL A,GLOFLS ; MORE?, KEEP LOOPING\r
+\r
+LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS\r
+ HRRZ C,2(LPVP)\r
+ HLLZS 2(LPVP) ; NOW CLEAR\r
+ MOVEI LPVP,(C)\r
+ JUMPE A,LOCFL2 ; NONE TO FLUSH\r
+\r
+LOCFLS: SKIPGE (A) ; MARKDE?\r
+ JRST .+3\r
+ MOVSI B,-5\r
+ PUSHJ P,ZERSLT\r
+ ANDCAM D,(A) ;UNMARK\r
+ HRRZ A,(A) ; GO ON\r
+ JUMPN A,LOCFLS\r
+LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS\r
+ POPJ P,\r
+\r
+\r
+\r
+MARK23: PUSH P,A ; SAVE BUCKET POINTER\r
+ PUSH P,F\r
+ PUSHJ P,MARK2\r
+ MOVEM A,1(C)\r
+ POP P,F\r
+ POP P,A\r
+ AOS -2(P) ; MARKING HAS OCCURRED\r
+ IORM D,ASOLNT+1(C) ; MARK IT\r
+ JRST MKD\r
+\r
+\f; CHANNEL FLUSHER FOR NON HAIRY GC\r
+\r
+CHNFLS: PUSH P,[-1]\r
+ SETOM (P) ; RESET FOR RETRY\r
+ PUSHJ P,CHNFL3\r
+ SKIPL (P)\r
+ JRST .-3 ; REDO\r
+ SUB P,[1,,1]\r
+ POPJ P,\r
+\r
+; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP\r
+\r
+VALFLA: MOVE C,GLOBSP+1(TVP)\r
+\r
+VALFL1: SKIPL (C) ; SKIP IF NOT MARKED\r
+ PUSHJ P,MARKQ ; SEE IF ATOM IS MARKED\r
+ JRST VALFL2\r
+ IORM D,(C)\r
+ AOS -1(P) ; INDICATE MARK OCCURRED\r
+ PUSH P,C\r
+ HRRZ B,(C) ; GET POSSIBLE GDECL\r
+ JUMPE B,VLFL10 ; NONE\r
+ CAIN B,-1 ; MAINFIFEST\r
+ JRST VLFL10\r
+ MOVEI A,(B)\r
+ MOVEI B,TLIST\r
+ MOVEI C,0\r
+ PUSHJ P,MARK ; MARK IT\r
+ MOVE C,(P) ; POINT\r
+ HRRM A,(C) ; CLOBBER UPDATE IN\r
+VLFL10: ADD C,[2,,2] ; BUMP TO VALUE\r
+ PUSHJ P,MARK2 ; MARK VALUE\r
+ MOVEM A,1(C)\r
+ POP P,C\r
+VALFL2: ADD C,[4,,4]\r
+ JUMPL C,VALFL1 ; JUMP IF MORE\r
+\r
+ HRLM LPVP,(P) ; SAVE POINTER\r
+VALFL7: MOVEI C,(LPVP)\r
+ MOVEI LPVP,0\r
+VALFL6: HRRM C,(P)\r
+\r
+VALFL5: HRRZ C,(C) ; CHAIN\r
+ JUMPE C,VALFL4\r
+ MOVEI B,TATOM ; TREAT LIKE AN ATOM\r
+ SKIPL (C) ; MARKED?\r
+ PUSHJ P,MARKQ1 ; NO, SEE\r
+ JRST VALFL5 ; LOOP\r
+ AOS -1(P) ; MARK WILL OCCUR\r
+ IORM D,(C)\r
+ ADD C,[2,,2] ; POINT TO VALUE\r
+ PUSHJ P,MARK2 ; MARK VALUE\r
+ MOVEM A,1(C)\r
+ SUBI C,2\r
+ JRST VALFL5\r
+\r
+VALFL4: HRRZ C,(P) ; GET SAVED LPVP\r
+ MOVEI A,(C)\r
+ HRRZ C,2(C) ; POINT TO NEXT\r
+ JUMPN C,VALFL6\r
+ JUMPE LPVP,VALFL9\r
+\r
+ HRRM LPVP,2(A) ; NEW PROCESS WAS MARKED\r
+ JRST VALFL7\r
+\r
+ZERSLT: HRRI B,(A) ; COPY POINTER\r
+ SETZM 1(B)\r
+ AOBJN B,.-1\r
+ POPJ P,\r
+\r
+VALFL9: HLRZ LPVP,(P) ; RESTORE CHAIN\r
+ JRST VALFL8\r
+\r
+\r
+\f;SUBROUTINE TO SEE IF A GOODIE IS MARKED\r
+;RECEIVES POINTER IN C\r
+;SKIPS IF MARKED NOT OTHERWISE\r
+\r
+MARKQ: HLRZ B,(C) ;TYPE TO B\r
+MARKQ1: MOVE E,1(C) ;DATUM TO C\r
+ MOVEI 0,(E)\r
+ CAIL 0,@PURBOT ; DONT CHACK PURE\r
+ JRST MKD ; ALWAYS MARKED\r
+ ANDI B,TYPMSK ; FLUSH MONITORS\r
+ LSH B,1\r
+ HRRZ B,@TYPNT ;GOBBLE SAT\r
+ ANDI B,SATMSK\r
+ CAIG B,NUMSAT ; SKIP FOR TEMPLATE\r
+ JRST @MQTBS(B) ;DISPATCH\r
+ ANDI E,-1 ; FLUSH REST HACKS\r
+ JRST VECMQ\r
+\r
+\r
+DISTBS MQTBS,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]\r
+[STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SBYTE,BYTMQ],[SLOCID,LOCMQ]\r
+[SATOM,VECMQ],[SPVP,VECMQ],[SLOCID,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ]\r
+[SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,VECMQ]]\r
+\r
+PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED\r
+ SKIPL (E) ; SKIP IF MARKED\r
+ POPJ P,\r
+CPOPJ1:\r
+ARGMQ:\r
+MKD: AOS (P)\r
+ POPJ P,\r
+\r
+BYTMQ: HRRZ E,(C) ;GET DOPE WORD POINTER\r
+ SOJA E,VECMQ1 ;TREAT LIKE VECTOR\r
+\r
+FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD\r
+ SOJA E,VECMQ1\r
+\r
+\r
+VECMQ: HLRE 0,E ;GET LENGTH\r
+ SUB E,0 ;POINT TO DOPE WORDS\r
+\r
+VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED\r
+ AOS (P) ;MARKED, CAUSE SKIP RETURN\r
+ POPJ P,\r
+\r
+ASMQ: SUBI E,ASOLNT\r
+ JRST VECMQ1\r
+\r
+LOCMQ: HRRZ 0,(C) ; GET TIME\r
+ JUMPE 0,VECMQ ; GLOBAL, LIKE VECTOR\r
+ HLRE 0,E ; FIND DOPE\r
+ SUB E,0\r
+ MOVEI E,1(E) ; POINT TO LAST DOPE\r
+ CAMN E,TPGROW ; GROWING?\r
+ SOJA E,VECMQ1 ; YES, CHECK\r
+ ADDI E,PDLBUF ; FUDGE\r
+ MOVSI 0,-PDLBUF\r
+ ADDM 0,1(C)\r
+ SOJA E,VECMQ1\r
+\fREPEAT 0,[\r
+\r
+\r
+\r
+;RETIME PHASE -- CALLED IFF A FRAME TIME HAS OVERFLOWED\r
+;RECEIVES POINTER TO STACK TO BE RECALIBRATED IN A\r
+;LEAVES HIGHEST TIME IN TIMOUT\r
+\r
+RETIME: HLRE B,A ;GET LENGTH IN B\r
+ SUB A,B ;COMPUTE DOPE WORD LOCATION\r
+ MOVEI A,1(A) ;POINT TO 2D DOPE WORD AND CLEAR LH\r
+ CAME A,TPGROW ;IS THIS ONE BLOWN?\r
+ ADDI A,PDLBUF ;NO, POINT TO DOPE WORD\r
+ LDB B,[222100,,(A)] ;GET LENGTH FIELD (IGNOREING MARK BIT\r
+ SUBI A,-1(B) ;POINT TO PDLS BASE\r
+ MOVEI C,1 ;INITIALIZE NEW TIMES\r
+\r
+RETIM1: SKIPGE B,(A) ;IF <0, HIT DOPE WORD OR FENCE POST\r
+ JRST RETIM3\r
+ HLRZS B ;ISOLATE TYPE\r
+ CAIE B,TENTRY ;FRAME START?\r
+ AOJA A,RETIM2 ;NO, TRY BINDING\r
+ HRLM C,FRAMLN+OTBSAV(A) ;STORE NEW TIME\r
+ ADDI A,FRAMLN ;POINT TO NEXT ELEMENT\r
+ AOJA C,RETIM1 ;BUMP TIME AND MOVE ON\r
+\r
+RETIM2: CAIE B,TUBIND\r
+ CAIN B,TBIND ;BINDING?\r
+ HRRM C,3(A) ;YES, STORE CURRENT TIME\r
+ AOJA A,RETIM1 ;AND GO ON\r
+\r
+RETIM3: MOVEM C,TIMOUT ;SAVE TIME\r
+ POPJ P, ;RETURN\r
+\r
+\r
+]\r
+\r
+\f; Core adjustment phase, try to win in all obscure cases!\r
+\r
+CORADJ: MOVE A,P.TOP ; update AGCs core top\r
+ MOVEM A,CORTOP\r
+ MOVE A,PARBOT ; figure out all the core needed\r
+ ADD A,PARNEW\r
+ ADD A,PARNUM\r
+ ADD A,PARNUM\r
+ ADD A,VECNUM\r
+ ADDI A,3777 ; account for gc pdl and round to block\r
+ ANDCMI A,1777\r
+\r
+CORAD3: CAMG A,PURTOP ; any way of winning at all?\r
+ JRST CORAD1 ; yes, go try\r
+CORA33: SETOM GCDNTG ; no, can't even grow something\r
+ SETOM GCDANG ; or get current request\r
+ SKIPL C,PARNEW ; or move pairs up\r
+ SETZM PARNEW\r
+ MOVEM C,SPARNW ; save attempt in case of retry\r
+\r
+CORAD6: MOVE A,CORTOP ; update core gotton with needed\r
+ ASH A,-10. ; to blocks\r
+ PUSHJ P,P.CORE ; try to get it (any lossage will retry)\r
+ PUSHJ P,SLPM1\r
+CORA11: MOVE A,CORTOP ; compute new home for vectors\r
+ SUB A,VECTOP\r
+ SUBI A,2000 ; remember gc pdl\r
+ MOVEM A,VECNEW\r
+ POPJ P, ; return to main GC loop\r
+\r
+; Here if at least enough for growers\r
+\r
+CORAD1: SKIPN B,GCDOWN ; skip if were called to get pure space\r
+ JRST CORAD2\r
+ ADDI A,2000(B) ; A/ enough for move down and minimum free\r
+ CAMG A,PURTOP ; any chance of winning?\r
+ JRST CORAD4 ; yes, go win some\r
+\r
+; Here if cant move down\r
+\r
+ SETOM GCDANG ; complain upon return\r
+ SUBI A,2000(B) ; reset for re-entry into loop\r
+ CAMLE A,PURTOP ; win?\r
+ JRST CORA33\r
+\r
+; Here if may be able to grant current request\r
+\r
+CORAD2: ADD A,GETNUM ; A/ total neede including request\r
+ ADD A,CURPLN ; dont give self away or something\r
+ ADDI A,3777 ; at least one free block and round\r
+ ANDCMI A,1777 ; to block boundary\r
+ CAMG A,PURTOP ; any hope of this?\r
+ JRST CORAD5 ; yes, now see if some slop space can appear\r
+\r
+ SETOM GCDANG ; tell caller we lost\r
+ MOVE A,PURTOP ; try to get as much as possible anyway\r
+ SUB A,PURBOT\r
+ SUB A,CURPLN\r
+CORAD8: ASH A,-10. ; to pages\r
+ PUSHJ P,GETPAG\r
+ FATAL PAGES NOT AVAILABLE\r
+ MOVSI D,400000 ; wipes out D\r
+ MOVE A,PURBOT ; and use current PURBOT as new core top\r
+ SUBI A,2000 ; for gc pdl\r
+ MOVEM A,CORTOP\r
+ JRST CORAD6 ; and allocate necessary pages\r
+\r
+; Here if real necessities taken care of, try for slop space\r
+\r
+CORAD5: ADD A,FREMIN ; try for minimum\r
+ SUBI A,2000-1777 ; round and flush min 2000 of before\r
+ ANDCMI A,1777 ; round to block boundary\r
+ CAMG A,PURTOP ; again, do we win?\r
+ JRST CORAD7 ; yes, we win totally\r
+\r
+; Here if cant get desired free but get some\r
+\r
+ MOVE A,PURTOP ; compute pages to flush\r
+ SUB A,CURPLN ; again dont flush current prog\r
+ SUB A,PURBOT ; A/ words to get\r
+ JRST CORAD8 ; go do it\r
+\r
+; Here if can get all the free we want\r
+\r
+CORAD7: SUB A,CURPLN\r
+ CAMG A,PURBOT ; do any pages get the ax?\r
+ JRST CORAD9 ; no, see if can give core back!\r
+ SUB A,PURBOT ; words to get purely\r
+ JRST CORAD8\r
+\r
+CORAD9: CAMG A,CORTOP ; skip if must get core\r
+ JRST CORA10\r
+ MOVEM A,CORTOP\r
+ JRST CORAD6 ; and go get it\r
+\r
+; Here if still may have to give it back\r
+\r
+CORA10: MOVE B,CORTOP\r
+ SUB B,A\r
+ CAMG B,FREDIF ; skip if giving awy\r
+ JRST CORA11\r
+\r
+CORA12: MOVEM A,CORTOP\r
+ ASH A,-10.\r
+ MOVEM A,CORSET ; leave to shrink later\r
+ JRST CORA11\r
+\r
+; Here if going down to also get free space\r
+\r
+CORAD4: SUBI A,2000 ; uncompensate for min\r
+ ADD A,FREMIN\r
+ CAML A,CORTOP ; skip if ok for max\r
+ MOVE A,CORTOP ; else use up to pure\r
+ SUB A,GCDOWN ; new CORTOP to A\r
+ JRST CORA12 ; go set up final shrink\r
+\r
+; routine to wait for core\r
+\r
+SLPM1: MOVEI 0,1\r
+ .SLEEP 0,\r
+ SOS (P)\r
+ SOS (P) ; ret to prev ins\r
+ POPJ P,\r
+\r
+CORADL: PUSHJ P,P.CORE ;SET TO NEW CORE VALUE\r
+ FATAL AGC--CANT CORE DOWN\r
+ POPJ P,\r
+\f;VECTOR RELOCATE --GETS VECTOP IN A\r
+;AND VECNEW IN B\r
+;FILLS IN RELOCATION FIELDS OF MARKED VECTORS\r
+;AND REUTRNS FINAL VECNEW IN B\r
+\r
+VECREL: CAMG A,VECBOT ;PROCESSED TO BOTTOM OF VECTOR SPACE?\r
+ POPJ P, ;YES, RETURN\r
+ HLRE C,(A) ;GET COUNT FROM DOPE WD, EXTEND MARK BIT\r
+ JUMPL C,VECRE1 ;IF MARKED GO PROCESS\r
+ HRRM A,(A) ; INDICATE NON-MOVE BY LEAVING SAME\r
+ SUBI A,(C) ;MOVE ON TO NEXT VECTOR\r
+ SOJG C,VECREL ;AND KEEP SCANNING\r
+ JSP D,VCMLOS ;LOSER, LEAVE TRACKS AS TO WHO LOST\r
+\r
+VECRE1: HRRZ E,-1(A) ;GOBBLE THE GROWTH FILEDS\r
+ HRRM B,(A) ;STORE RELOCATION\r
+ JUMPE E,VECRE2 ;NO GROWTH (OR SHRINKAGE), GO AWAY\r
+ LDB F,[111100,,E] ;GET TOP GROWTH IN F\r
+ TRZN F,400 ;CHECK AND FLUSH SIGN\r
+ MOVNS F ;WAS ON, NEGATE\r
+ SKIPE GCDNTG ; SKIP IF GROWTH OK\r
+ JUMPL F,VECRE3 ; DONT ALLOW POSITIVE GROWTH\r
+ ASH F,6 ;CONVERT TO WORDS\r
+ ADD B,F ;UPDATE RELOCATION\r
+ HRRM B,(A) ;AND STORE IT\r
+VECRE3: ANDI E,777 ;ISOLATE BOTTOM GROWTH\r
+ TRZN E,400 ;CHECK AND CLEAR SIGN\r
+ MOVNS E\r
+ SKIPE GCDNTG ; SKIP IF GROWTH OK\r
+ JUMPL E,VECRE2\r
+ ASH E,6 ;CONVERT TO WORDS\r
+ ADD B,E ;UPDATE FUTURE RELOCATIONS\r
+VECRE2: SUBI A,400000(C) ;AND MOVE ON TO NEXT VECTOR\r
+ ANDI C,377777 ;KILL MARK\r
+ SUBI B,(C) ; UPDATE WHERE TO GO LOCN\r
+ SOJG C,VECREL ;AND KEEP GOING\r
+ JSP D,VCMLOS ;LOSES, LEAVE TRACKS\r
+\r
+;PAIR SPACE UPDATE\r
+\r
+;GETS PARBOT IN AC A\r
+;UPDATES VALUES AND CDRS UP TO PARTOP\r
+\r
+PARUPD: CAML A,PARTOP ;ARE THERE MORE PAIRS TO PROCESS\r
+ POPJ P, ;NO -- RETURN\r
+\r
+;UPDATE VALUE CELL\r
+PARUP1: ANDCAM D,(A) ; KILL MARK BIT\r
+ HLRZ B,(A) ;SET RH OF B TO TYPE\r
+ MOVE C,1(A) ;SET C TO VALUE\r
+ PUSHJ P,VALUPD ;UPDATE THIS VALUE\r
+ ADDI A,2 ;MOVE ON TO NEXT PAIR\r
+ JRST PARUPD ;AND CONTINUE\r
+\r
+\r
+\f;VECTOR SPACE UPDATE\r
+;GETS VECTOP IN A\r
+;UPDATES ALL VALUE CELLS IN MARKED VECTORS\r
+;ESCAPES WHEN IT GETS TO VECBOT\r
+\r
+VECUPD: SUBI A,1 ;MAKE A POINT TO LAST DOPE WD\r
+ PUSH P,VECBOT\r
+ PUSHJ P,UPD1\r
+ SUB P,[1,,1]\r
+ POPJ P,\r
+\r
+; STORAGE SPACE UPDATE\r
+\r
+STOUP: PUSH P,[STOSTR]\r
+ PUSHJ P,UPD1\r
+ SUB P,[1,,1]\r
+ JRST ENHACK\r
+UPD1:\r
+VECUP1: CAMG A,-1(P) ;ANY MORE VECTORS TO PROCESS?\r
+ POPJ P,\r
+ SKIPGE B,(A) ;IS DOPE WORD MARKED?\r
+ JRST VECUP2 ;YES -- GO PROCESS VALUES IN THIS VECTOR\r
+ HLLZS -1(A) ;MAKE SURE NO GROWTH ATTEMPTS\r
+ HLRZS B ;NO -- SET RH OF B TO SIZE OF VECTOR\r
+VECUP5: SUB A,B ;SET A TO POINT TO DOPE WD OF NEXT VECTOR\r
+ JRST VECUP1 ;AND CONTINUE\r
+\r
+VECUP2: PUSH P,A ;SAVE DOPE WORD POINTER\r
+ HLRZ B,(A) ;GET LENGTH OF THIS VECTOR\r
+VECU11: ANDI B,377777 ;TURN OFF MARK BIT\r
+ SKIPGE E,-1(A) ;CHECK FOR UNIFORM OR SPECIAL\r
+ TLNE E,377777 ;SKIP IF GENERAL\r
+ JRST VECUP6 ;UNIFORM OR SPECIAL, GO DO IT\r
+VECU10: SUB A,B ;SET AC A TO NEXT DOPE WORD\r
+ ADDI A,1 ;AND ADVANCE TO FIRST ELEMENT OF THIS VECTOR\r
+VECUP3: HLRZ B,(A) ;GET TYPE\r
+ TRNE B,400000 ;IF MARK BIT SET\r
+ JRST VECUP4 ;DONE WITH THIS VECTOR\r
+ ANDI B,TYPMSK\r
+ CAIE B,TCBLK\r
+ CAIN B,TENTRY ;SPECIAL HACK FOR ENTRY\r
+ JRST ENTRUP\r
+ CAIE B,TUNWIN\r
+ CAIN B,TSKIP ; SKIP POINTER\r
+ JRST BINDUP ; HACK APPROPRAITELY\r
+ CAIE B,TBVL ;VECTOR BINDING?\r
+ CAIN B,TBIND ;AND BINDING BLOCK\r
+ JRST BINDUP\r
+ CAIN B,TUBIND\r
+ JRST BINDUP\r
+VECU15: MOVE C,1(A) ;GET VALUE\r
+ PUSHJ P,VALUPD ;UPDATE THIS VALUE\r
+VECU12: ADDI A,2 ;GO ON TO NEXT VECTOR\r
+ JRST VECUP3 ;AND CONTINUE\r
+\r
+VECUP4: POP P,A ;SET TO OLD DOPE WORD\r
+ ANDCAM D,(A) ;TURN OFF MARK BIT\r
+ HLRZ B,(A) ;GET LENGTH\r
+ ANDI B,377777 ; IN CASE DING STORAGE\r
+ JRST VECUP5 ;GO ON TO NEXT VECTOR\r
+\r
+\r
+\r
+;UPDATE A SAVED SAVE BLOCK\r
+ENTSUP: MOVEI A,FRAMLN+SPSAV-1(A) ;A POINTS BEFORE SAVED SP\r
+ MOVEI B,TSP\r
+ PUSHJ P,VALPD1 ;UPDATE SPSAV\r
+ MOVEI A,PSAV-SPSAV(A)\r
+ MOVEI B,TPDL\r
+ PUSHJ P,VALPD1 ;UPDATE PSAV\r
+ MOVEI A,TPSAV-PSAV(A)\r
+ MOVEI B,TTP\r
+ PUSHJ P,VALPD1 ;UPDATE TPSAV\r
+;SKIP TO END OF BLOCK\r
+ SUBI A,PSAV-1\r
+ JRST VECUP3\r
+\r
+;IGNORE A BLOCK\r
+IGBLK2: HRRZ B,(A) ;GET DISPLACEMENT\r
+ ADDI A,3(B) ;USE IT\r
+ JRST VECUP3 ;GO\r
+\r
+\f; ENTRY PART OF THE STACK UPDATER\r
+\r
+ENTRUP: ADDI A,FRAMLN-2 ;POINT PAST FRAME\r
+ JRST VECU12 ;NOW REJOIN VECTOR UPDATE\r
+\r
+; UPDATE A BINDING BLOCK\r
+\r
+BINDUP: HRRZ C,(A) ;POINT TO CHAIN\r
+ JUMPE C,NONEXT ;JUMP IF NO NEXT BINDING IN CHAIN\r
+ HRRZ 0,@(P) ; GET OWN DESTINATION\r
+ SUBI 0,@(P) ; RELATIVIZE\r
+ ADD C,0 ; AND UPDATE\r
+ HRRM C,(A) ;AND STORE IT BACK\r
+NONEXT: CAIN B,TUBIND\r
+ JRST .+3\r
+ CAIE B,TBIND ;SKIP IF VAR BINDING\r
+ JRST VECU14 ;NO, MUST BE A VECTOR BIND\r
+ MOVEI B,TATOM ;UPDATE ATOM POINTER\r
+ PUSHJ P,VALPD1\r
+ ADDI A,2\r
+ HLRZ B,(A) ;TYPE OF VALUE\r
+ PUSHJ P,VALPD1\r
+ ADDI A,2 ; POINT TO PREV LOCATIVE\r
+VECU16: MOVEI B,TLOCI\r
+ SKIPN 1(A) ; IF NO LOCATIVE,\r
+ MOVEI B,TUNBOU ; SAY UNBOUND\r
+ PUSHJ P,VALPD1\r
+ JRST VECU12\r
+\r
+VECU14: CAIN B,TBVL ; CHANGE BVL TO VEC\r
+ MOVEI B,TVEC ;NOW TREAT LIKE A VECTOR\r
+ JRST VECU15\r
+\r
+; NOW SAFE TO UPDATE ALL ENTRY BLOCKS\r
+\r
+ENHACK: HRRZ F,TBSTO(LPVP) ;GET POINTER TO TOP FRAME\r
+ HLLZS TBSTO(LPVP) ;CLEAR FIELD\r
+ HLLZS TPSTO(LPVP)\r
+ JUMPE F,LSTFRM ;FINISHED\r
+\r
+ENHCK1: MOVEI A,FSAV-1(F) ;POINT PRIOR TO SAVED FUNCTION\r
+ HRRZ C,1(A) ; GET POINTER TO FCN\r
+ CAML C,VECBOT ; SKIP IF A LOSER\r
+ CAMLE C,VECTOP ; SKIP IF A WINNER\r
+ JRST ENHCK2\r
+ HRL C,(C) ; MAKE INTO AOBJN\r
+ MOVEI B,TVEC\r
+ PUSHJ P,VALUPD ; AND UPDATE\r
+ENHCK2: HRRZ F,2(A) ;POINT TO PRIOR FRAME\r
+ MOVEI B,TTB ;MARK SAVED TB\r
+ PUSHJ P,[AOJA A,VALPD1]\r
+ MOVEI B,TAB ;MARK ARG POINTER\r
+ PUSHJ P,[AOJA A,VALPD1]\r
+ MOVEI B,TSP ;SAVED SP\r
+ PUSHJ P,[AOJA A,VALPD1]\r
+ MOVEI B,TPDL ;SAVED P STACK\r
+ PUSHJ P,[AOJA A,VALPD1]\r
+ MOVEI B,TTP ;SAVED TP\r
+ PUSHJ P,[AOJA A,VALPD1]\r
+ JUMPN F,ENHCK1 ;MARK NEXT ONE IF IT EXISTS\r
+\r
+LSTFRM: HRRZ A,BINDID(LPVP) ;NEXT PROCESS\r
+ HLLZS BINDID(LPVP) ;CLOBBER\r
+ MOVEI LPVP,(A)\r
+ JUMPN LPVP,ENHACK ;DO NEXT PROCESS\r
+ POPJ P,\r
+\r
+\f; UPDATE ELEMENTS IN UNIFROM AND SPECIAL VECTORS\r
+\r
+VECUP6: JUMPL E,VECUP7 ;JUMP IF SPECIAL\r
+ CAIG B,2 ;EMPTY UVECTOR ?\r
+ JRST VECUP4 ;YES, NOTHING TO UPDATE\r
+ HLRZS E ;ISOLATE TYPE\r
+ ANDI E,37777\r
+ EXCH E,B ;TYPE TO B AND LENGTH TO E\r
+ SUBI A,(E) ;POINT TO NEXT DOPE WORD\r
+ LSH B,1 ;FIND SAT\r
+ HRRZ B,@TYPNT\r
+ ANDI B,SATMSK\r
+ MOVE B,UPDTBS(B) ;FIND WHERE POINTS\r
+ CAIN B,CPOPJ ;UNMARKED?\r
+ JRST VECUP4 ;YES, GO ON TO NEXT VECTOR\r
+ PUSH P,B ;SAVE SR POINTER\r
+ SUBI E,2 ;DON'T COUNT DOPE WORDS\r
+\r
+VECUP8: MOVE C,1(A) ;GET GOODIE\r
+ MOVEI 0,(C) ; ISOLATE ADDR\r
+ JUMPE 0,.+3 ; NEVER 0 PNTR\r
+ CAIGE 0,@PURBOT ; OR IF PURE\r
+ PUSHJ P,@(P) ;CALL UPDATE ROUTINE\r
+ ADDI A,1\r
+ SOJG E,VECUP8 ;LOOP FOR ALL ELEMNTS\r
+\r
+ SUB P,[1,,1] ;REMOVE RANDOMNESS\r
+ JRST VECUP4\r
+\r
+; SPECIAL VECTOR UPDATE\r
+\r
+VECUP7: HLRZS E ;ISOLATE SPECIAL TYPE\r
+ CAIN E,SATOM+400000 ;ATOM?\r
+ JRST ATOMUP ;YES, GO DO IT\r
+ CAIN E,STPSTK+400000 ;STACK\r
+ JRST VECU10 ;TREAT LIKE A VECTOR\r
+ CAIN E,SPVP+400000 ;PROCESS VECTOR\r
+ JRST PVPUP ;DO SPECIAL STUFF\r
+ CAIN E,SASOC+400000\r
+ JRST ASOUP ;UPDATE ASSOCIATION BLOCK\r
+\r
+ TRZ E,400000 ; CHECK FOR TEMPLATE VECTOR\r
+ CAIG E,NUMSAT ; SKIP IF POSSIBLE\r
+ FATAL AGC--UNRECOGNIZED SPECIAL VECTOR (UPDATE)\r
+ MOVEI E,-NUMSAT-1(E)\r
+ HRLI E,(E)\r
+ ADD E,TD.LNT+1(TVP)\r
+ SKIPL E\r
+ FATAL AGC--BAD TEMPLATE TYPE\r
+\r
+TD.UPD: MOVEI C,-1(A) ; POINTER TO OBJECT IN C\r
+ XCT (E)\r
+ HLRZ D,B ; POSSIBLE BASIC LENGTH\r
+ PUSH P,[0]\r
+ PUSH P,D\r
+ MOVEI B,(B) ; ISOLATE LENGTH\r
+ PUSH P,C ; SAVE POINTER TO OBJECT\r
+\r
+ PUSH P,[0] ; HOME FOR VALUES\r
+ PUSH P,[0] ; SLOT FOR TEMP\r
+ PUSH P,B ; SAVE\r
+ SUB E,TD.LNT+1(TVP)\r
+ PUSH P,E ; SAVE FOR FINDING OTHER TABLES\r
+ JUMPE D,TD.UP2 ; NO REPEATING SEQ\r
+ ADD E,TD.GET+1(TVP) ; COMP LNTH OF REPEATING SEQ\r
+ HLRE E,(E) ; E ==> - LNTH OF TEMPLATE\r
+ ADDI E,(D) ; E ==> -LENGTH OF REP SEQ\r
+ MOVNS E\r
+ HRLM E,-5(P) ; SAVE IT AND BASIC\r
+\r
+TD.UP2: SKIPG D,-1(P) ; ANY LEFT?\r
+ JRST TD.UP1\r
+\r
+ MOVE E,TD.GET+1(TVP)\r
+ ADD E,(P)\r
+ MOVE E,(E) ; POINTER TO VECTOR IN E\r
+ MOVEM D,-6(P) ; SAVE ELMENT #\r
+ SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST\r
+ SOJA D,TD.UP3\r
+\r
+ MOVEI 0,(B) ; BASIC LNT TO 0\r
+ SUBI 0,(D) ; SEE IF PAST BASIC\r
+ JUMPGE 0,.-3 ; JUMP IF O.K.\r
+ MOVSS B ; REP LNT TO RH, BASIC TO LH\r
+ IDIVI 0,(B) ; A==> -WHICH REPEATER\r
+ MOVNS A\r
+ ADD A,-5(P) ; PLUS BASIC\r
+ ADDI A,1 ; AND FUDGE\r
+ MOVEM A,-6(P) ; SAVE FOR PUTTER\r
+ ADDI E,-1(A) ; POINT\r
+ SOJA D,.+2\r
+\r
+TD.UP3: ADDI E,(D) ; POINT TO SLOT\r
+ XCT (E) ; GET THIS ELEMENT INTO A AND B\r
+ MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT\r
+ MOVEM B,-2(P)\r
+ MOVE C,B ; VALUE TO C FOR VALUPD\r
+ GETYP B,A\r
+ MOVEI A,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG\r
+ MOVSI D,400000 ; RESET FOR MARK\r
+ PUSHJ P,VALUPD ; AND MARK THIS GUY (RET FIXED POINTER IN A)\r
+ MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT\r
+ MOVE E,TD.PUT+1(TVP)\r
+ SOS D,-1(P) ; RESTORE COUNT\r
+ ADD E,(P)\r
+ MOVE E,(E) ; POINTER TO VECTOR IN E\r
+ MOVE B,-6(P) ; SAVED OFFSET\r
+ ADDI E,(B)-1 ; POINT TO SLOT\r
+ MOVE A,-3(P) ; RESTORE TYPE WORD\r
+ MOVE B,-2(P)\r
+ XCT (E) ; SMASH IT BACK\r
+ FATAL TEMPLATE LOSSAGE\r
+ MOVE C,-4(P)\r
+ JRST TD.UP2\r
+\r
+TD.UP1: SUB P,[7,,7]\r
+ MOVSI D,400000 ; RESTORE MARK/UNMARK BIT\r
+ JRST VECUP4\r
+\r
+\f; UPDATE ATOM VALUE CELLS\r
+\r
+ATOMUP: SUBI A,-1(B) ; POINT TO VALUE CELL\r
+ HLRZ B,(A)\r
+ HRRZ 0,(A) ;GOBBLE BINDID\r
+ JUMPN 0,.+3 ;NOT GLOBAL\r
+ CAIN B,TLOCI ;IS IT A LOCATIVE?\r
+ MOVEI B,TVEC ;MARK AS A VECTOR\r
+ HRRZ 0,1(A) ; GET POINTER\r
+ CAML 0,VECBOT\r
+ CAMLE 0,VECTOP\r
+ JRST .+2 ; OUT OF BOUNDS, DONT UPDATE\r
+ PUSHJ P,VALPD1 ;UPDATE IT\r
+ MOVEI B,TOBLS ; TYPE TO OBLIST\r
+ SKIPGE 2(A)\r
+ PUSHJ P,[AOJA A,VALPD1]\r
+ JRST VECUP4\r
+\r
+; UPDATE PROCESS VECTOR\r
+\r
+PVPUP: SUBI A,-1(B) ;POINT TO TOP\r
+ HRRM LPVP,BINDID(A) ;CHAIN ALL PROCESSES TOGETHER\r
+ MOVEI LPVP,(A)\r
+ HRRZ 0,TBSTO+1(A) ;POINT TO CURRENT FRAME\r
+ HRRM 0,TBSTO(A) ;SAVE\r
+ HRRZ 0,TPSTO+1(A) ;0_SAVED TP POINTER\r
+ HLRE B,TPSTO+1(A)\r
+ SUBI 0,-1(B) ;0 _ POINTER TO OLD DOPE WORD\r
+ HRRM 0,TPSTO(A)\r
+ JRST VECUP3\r
+\r
+\r
+\f;THIS SUBROUTINE TAKES CARE OF UPDATING ASSOCIATION BLOCKS\r
+\r
+ASOUP: SUBI A,-1(B) ;POINT TO START OF BLOCK\r
+ HRRZ B,ASOLNT-1(A) ;POINT TO NEXT\r
+ JUMPE B,ASOUP1\r
+ HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C\r
+ SUBI C,ASOLNT+1(B) ; RELATIVIZE\r
+ ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED PONTER\r
+ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER\r
+ JUMPE B,ASOUP2\r
+ HRRZ F,ASOLNT+1(B) ;AND ITS RELOCATION\r
+ SUBI F,ASOLNT+1(B) ; RELATIVIZE\r
+ MOVSI F,(F)\r
+ ADDM F,ASOLNT-1(A) ;RELOCATE\r
+ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN\r
+ JUMPE B,ASOUP4\r
+ HRRZ C,ASOLNT+1(B) ;GET RELOC\r
+ SUBI C,ASOLNT+1(B) ; RELATIVIZE\r
+ ADDM C,NODPNT(A) ;ANID UPDATE\r
+ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER\r
+ JUMPE B,ASOUP5\r
+ HRRZ F,ASOLNT+1(B) ;RELOC\r
+ SUBI F,ASOLNT+1(B)\r
+ MOVSI F,(F)\r
+ ADDM F,NODPNT(A)\r
+ASOUP5: HRLI A,-3 ;SET TO UPDATE OTHER CONTENTS\r
+\r
+ASOUP3: HLRZ B,(A) ;GET TYPE\r
+ PUSHJ P,VALPD1 ;UPDATE\r
+ ADD A,[1,,2] ;MOVE POINTER\r
+ JUMPL A,ASOUP3\r
+ JRST VECUP4 ;AND QUIT\r
+\r
+\f;VALUPD UPDATES A SINLE VALUE FROM EITHER PAIR SPACE OR VECTOR SPACE\r
+;GETS POINTER TO TYPE CELL IN RH OF A\r
+;TYPE IN RH OF B (LH MUST BE 0)\r
+;VALUE IN C\r
+\r
+VALPD1: MOVE C,1(A) ;GET VALUE TO UPDATE\r
+VALUPD: MOVEI 0,(C)\r
+ CAIGE 0,@PURBOT ; SKIP IF PURE, I.E. DONT HACK\r
+ TRNN C,-1 ;ANY POINTER PART?\r
+ JRST CPOPJ ;NO, LEAVE\r
+ ANDI B,TYPMSK\r
+ LSH B,1 ;SET TYPE TIMES 2\r
+ HRRZ B,@TYPNT ;GET STORAGE ALLOCATION TYPE\r
+ ANDI B,SATMSK\r
+ CAIG B,NUMSAT ; SKIP IF TEMPLATE\r
+ JRST @UPDTBS(B) ;AND DISPATCH THROUGH STORAGE ALLOCATION DISPATCH TABLE\r
+ AOJA C,TMPLUP\r
+\r
+;SAT DISPATCH TABLE\r
+\r
+DISTBS UPDTBS,CPOPJ,[[SNWORD,NWRDUP],[STPSTK,STCKUP]\r
+[SFRAME,FRAMUP],[STBASE,TBUP],[SARGS,ARGUP],[SBYTE,BYTUP],[SATOM,NWRDUP],[SPSTK,STCKUP]\r
+[SLOCID,LOCUP],[SPVP,NWRDUP],[S2NWORD,NWRDUP],[SABASE,ABUP],[SCHSTR,BYTUP],[SASOC,ASUP]\r
+[SLOCA,ARGUP],[SLOCU,NWRDUP],[SLOCN,ASUP],[SLOCS,BYTUP],[SGATOM,NWRDUP]]\r
+\r
+\r
+\r
+\r
+;PAIR POINTER UPDATE\r
+2WDUP: MOVEI 0,(C)\r
+ CAIGE 0,@PURBOT ; SKIP AND IGNORE IF PURE\r
+ TRNN C,-1 ;POINT TO NIL?\r
+ POPJ P, ;YES -- NO UPDATE NEEDED\r
+ SKIPGE B,(C) ;NO -- IS THIS A BROKEN HEART\r
+ HRRM B,1(A) ;YESS -- STORE NEW VALUE\r
+ SKIPE B,PARNEW ;IF LIST SPACE IS MOVING\r
+ ADDM B,1(A) ;THEN ADD OFFSET TO VALUE\r
+ POPJ P, ;FINISHED\r
+\r
+; HERE TO UPDATE ASSOCIATIONS\r
+\r
+ASUP: HRLI C,-ASOLNT ;MAKE INTO VECTOR POINTER\r
+ JRST NWRDUP\r
+\f;VECTOR, ATOM, STACK, AND BASE POINTER UPDATE\r
+\r
+LOCUP: HRRZ B,(A) ;CHECK IF IT IS TIMED\r
+ JUMPN B,LOCUP1 ;JUMP IF TIMED, OTHERWISE TREAT LIKE VECTORE\r
+\r
+NWRDUP: HLRE B,C ;EXTEND COUNT IN B\r
+ SUBI C,-1(B) ;SET C TO POINT TO DOPE WORD\r
+TMPLUP: HRRZ B,(C) ;EXTEND RELOCATION IN B\r
+ SUBI B,(C) ; RELATIVIZE\r
+ ADDM B,1(A) ;AND ADD RELOCATION TO STORED DATUM\r
+ HRRZ C,-1(C) ;GET GROWTH SPECS\r
+ JUMPE C,CPOPJ ;NO GROWTH, LEAVE\r
+ LDB C,[111100,,C] ;GET UPWORD GROWTH\r
+ TRZN C,400 ;FLUSH SIGN AN NEGATR DIRECTION\r
+ MOVNS C\r
+ SKIPE GCDNTG ; SKIP IF GROWTH WINS\r
+ JUMPL C,CPOPJ ; POS GROWTH, LOSE\r
+ ASH C,6+18. ;TO LH AND TIMES 100(8)\r
+ ADDM C,1(A) ;UPDATE POINTER\r
+ POPJ P,\r
+\r
+\r
+LOCUP1:\r
+STCKUP: MOVSI B,PDLBUF ;GET OFFSET FOR PDLS\r
+ ADDM B,1(A) ;AND ADD TO COUNT\r
+ JRST NWRDUP ;NOW TREAT LIKE VECTOR\r
+\r
+BYTUP: MOVEI C,(A) ; SET TO GET DOPE WORD\r
+ PUSH P,A\r
+ PUSHJ P,BYTDOP\r
+ POP P,C\r
+ HRRZ B,(A) ;SET B TO RELOCATION FOR THIS VEC\r
+ SUBI B,(A) ; RELATIVIZE\r
+ ADDM B,1(C) ;AND UPDATE VALUE\r
+ MOVE A,C ; FIX UP FOR SCANNER\r
+ POPJ P, ;DONE WITH UPDATE\r
+\r
+ARGUP:\r
+ABUP: HLRE B,C ;GET LENGTH\r
+ SUB C,B ;POINT TO FRAME\r
+ HLRZ B,(C) ;GET TYPE OF NEXT GOODIE\r
+ ANDI B,TYPMSK\r
+ CAIN B,TINFO ;IS IT A FRAME\r
+ ADD C,1(C) ;NO, POINT TO FRAME\r
+ CAIE B,TINFO ;IF IT IS A FRAME\r
+ ADDI C,FRAMLN ;POINT TO ITS BASE\r
+TBUP: MOVE C,TPSAV(C) ;GET A ASTACK POINTER TO FIND DOPE WORD\r
+ HLRE B,C ;UPDATE BASED ON THIS POINTER\r
+ SUBI C,(B)\r
+ABUP1: HRRZ B,1(C) ;GET RELOCATION\r
+ SUBI B,1(C) ; RELATIVIZE\r
+ ADDM B,1(A) ;AND MUNG POINTER\r
+ POPJ P,\r
+\r
+FRAMUP: HRRZ B,(A) ;UPDATE PVP\r
+ HRRZ C,(B) ;IN CELL\r
+ SUBI C,(B) ; RELATIVIZE\r
+ ADDM C,(A)\r
+ HLRZ C,(B)\r
+ ANDI C,377777\r
+ SUBI B,-1(C) ;ADDRESS OF PV\r
+ HRRZ C,TPSTO(B) ;IF TPSTO HAS OLD TP DOPE WORD,\r
+ JUMPN C,ABUP2 ;USE IT\r
+ HRRZ C,TPSTO+1(B) ;ELSE, GENERATE IT\r
+ HLRE B,TPSTO+1(B)\r
+ SUBI C,-1(B)\r
+ABUP2: SOJA C,ABUP1 ; FUDGE AND GO\r
+\r
+\f;VECTOR SHRINKING PHASE\r
+\r
+VECSH: SUBI A,1 ;POOINT TO 1ST DOPE WORD\r
+VECSH1: CAMGE A,VECBOT ;FINISHED\r
+ POPJ P, ;YES, QUIT\r
+ HRRZ B,-1(A) ;GET A SPEC\r
+ JUMPE B,NXTSHN ;IGNORE IF NONE\r
+ PUSHJ P,GETGRO ;GET THE SPECS\r
+ JUMPGE C,SHRNBT ;SHRINKIGN AT BOTTOM\r
+ MOVEI E,(A) ;COPY POINTER\r
+ ADD A,C ;POINT TO NEW DOPE LOCATION WITH E\r
+ MOVE F,-1(E) ;GET OLD DOPE\r
+ ANDCMI F,777000 ;KILL THIS SPEC\r
+ MOVEM F,-1(A) ;STORE\r
+ MOVE F,(E) ;OTHER DOPE WORD\r
+ ADD F,C ; UPDATE DESTINATION\r
+ HRLZI C,(C) ;TO LH\r
+ ADD F,C ;CHANGE LENGTH\r
+ MOVEM F,(A) ;AND STORE\r
+ MOVMS C ;PLUSIFY\r
+ HRRI C,(E) ; MAKE NOT MOVE\r
+ MOVEM C,(E) ;AND STORE\r
+ SETZM -1(E)\r
+SHRNBT: JUMPGE B,NXTSHN ;GROWTH, IGNOORE\r
+ MOVM E,B ;GET A POSITIVE COPY\r
+ HRLZI B,(B) ;TO LH\r
+ ADDM B,(A) ;ADD INTO DOPE WORD\r
+ MOVEI 0,777 ;SET TO CLOBBER GROWTH\r
+ ANDCAM 0,-1(A) ;CLOBBER\r
+ HLRZ B,(A) ;GET NEW LENGTH\r
+ SUBI A,(B) ;POINT TO LOW END\r
+ HRLI E,(A) ; MAKE NON MOVER\r
+ MOVSM E,(A) ;STORE\r
+ SETZM -1(A)\r
+\r
+NXTSHN: HLRZ B,(A) ;GET LENGTH\r
+ JUMPE B,VCMLOS ;LOOSE\r
+ SUBI A,(B) ;STEP\r
+ JRST VECSH1\r
+\r
+GETGRO: LDB C,[111100,,B] ;GET UPWARD GROWTH\r
+ TRZE C,400 ;CHECK AND MUNG SIGN\r
+ MOVNS C\r
+ ASH C,6 ;?IMES 100\r
+ ANDI B,777 ;AND GET DOWN GROWTH\r
+ TRZE B,400 ;CHECK AND MUNG SIGN\r
+ MOVNS B\r
+ ASH B,6\r
+ POPJ P,\r
+\f;VECMOV -- MOVES VECTOR DATA TO WHERE RELOC FIELDS OF\r
+;VECTORS INDICATE. MOVES DOPEWDS UP FOR VECTORS GROWING AT\r
+;THE END.\r
+;CALLED WITH VECTOP IN A. CALLS PARMOV TO MOVE PAIRS\r
+\r
+VECMOV: SUBI A,1 ;SET A TO ADDR OF TOP DOPE WD\r
+ MOVSI D,400000 ;NEGATIVE D MARKS END OF BACK CHAIN\r
+ MOVEI TYPNT,0 ;CLEAR ON GOING ADDRESS FOR FORWARD RESUME\r
+VECMO1: CAMGE A,VECBOT ;GOT TO BOTTOM OF VECTORS\r
+ JRST PARMOV ;YES, MOVE LIST ELEMENTS AND RETURN\r
+ MOVEI C,(A) ;NO, COPY ADDR OF THIS DOPEWD\r
+ HRRZ B,(A) ;GET RELOCATION OF THIS VECTOR\r
+ SUBI B,(A) ; RELATIVIZE\r
+ JUMPL B,VECMO5 ;IF MOVING DOWNWARD, MAKE BACK CHAIN\r
+ JUMPE B,VECMO4 ;IF NON MOVER, JUST ADJUST DOPW AND MOVE ON\r
+\r
+ ADDI C,(B) ;SET ADDR OF LAST DESTINATION WD\r
+ HRLI B,A ;MAKE B INDEX ON A\r
+ HLL A,(A) ;COUNT TO A LEFT HALF\r
+\r
+ POP A,@B ;MOVE A WORD\r
+ TLNE A,-1 ;REACHED END OF MOVING\r
+ JRST .-2 ;NO, REPEAT\r
+ ;YES, NOTE A HAS ADDR OF NEXT DOPEWD\r
+\f;HERE TO ADJUST LOCATION OF DOPEWDS FOR GROWTH (FORWARDLY)\r
+VECMO2: LDB B,[111000,,-1(C)] ;GET HIGH GROWTH FIELD\r
+ JUMPE B,VECMO3 ;IF NO GROWTH, DONT MOVE\r
+ SKIPE GCDNTG ; SKIP IF GROWTH PERMITTED\r
+ JRST VECMO3\r
+ ASH B,6 ;EXPRESS GROWTH IN WORDS\r
+ HRLI C,2 ;SET COUNT FOR POPPING 2 DOPEWDS\r
+ HRLI B,C ;MAKE B INDEX ON C\r
+ POP C,@B ;MOVE PRIME DOPEWD\r
+ POP C,@B ;MOVE AUX DOPEWD\r
+VECMO3: JUMPL D,VECMO1 ;IF NO BACK CHAIN THEN MOVE ON\r
+ JRST VECMO6 ;YES, BACKCHAINING, CONTINUE SAME\r
+\r
+;HERE TO SKIP OVER STILL VECTORS (FORWARDLY)\r
+VECMO4: HLRZ B,(A) ;GET SIZE OF UNMOVER\r
+ SUBI A,(B) ;UPDATE A TO NEXT VECTOR\r
+ JRST VECMO2 ;AND GO CLEAN UP GROWTH\r
+;HERE TO ESTABLISH A BACKWARDS CHAIN\r
+VECMO5: EXCH D,(A) ;CHAIN FORWARD\r
+ HLRZ B,D ;GET SIZE\r
+ SUBI A,(B) ;GO ON TO NEXT VECOTR\r
+ CAMGE A,VECBOT ;HAVE WE GOT TO END OF VECTORS?\r
+ JRST VECMO7 ;YES, GO MOVE PAIRS AND UNCHAIN\r
+ HRRZ B,(A) ;GET RELOCATION OF THIS VECTOR\r
+ SUBI B,(A) ; RELATIVIZE\r
+ JUMPLE B,VECMO5 ;IF NOT POSITIVE, CONTINUE CHAINING\r
+ MOVEM A,TYPNT ;SAVE ADDR FOR FORWARD RESUME\r
+\r
+;HERE TO UNCHAIN A VECTOR, MOVE IT, AND ADJUST DOPEWDS\r
+VECMO6: HLRZ B,D ;GET SIZE\r
+ MOVEI F,1(A) ;GET A COPY OF BEGINNING OF VECTOR\r
+ ADDI A,(B) ;SET TO POINT TO ADDR OF DOPEWD CURRENTLY IN D\r
+ EXCH D,(A) ;AND UNCHAIN\r
+ HRRZ B,(A) ;GET RELOCATION FOR THIS VECTOR\r
+ SUBI B,(A) ; RELATIVIZE\r
+ MOVEI C,(A) ;COPY A POINTER TO DOPEW\r
+ SKIPGE D ;HAVE WE REACHED THE TOP OF THE CHAIN?\r
+ MOVE A,TYPNT ;YES, RESTORE FORWARD MOVE RESUME ADDR\r
+ JUMPE B,VECMO2 ;IF STILL VECTOR,GO ADJUST DOPEWDS\r
+ ADDI C,(B) ;MAKE C POINT TO NEW DOPEW ADDR\r
+ ADDI B,(F) ;B RH NEW 1ST WORD\r
+ HRLI B,(F) ;B LH OLD 1ST WD ADDR\r
+ BLT B,(C) ;COPY THE DATA\r
+ JRST VECMO2 ;AND GO ADJUST DOPEWDS\r
+\r
+;HERE TO STOP CHAINING BECAUSE OF BOTTOM OF VECTOR SPACE\r
+VECMO7: MOVEM A,TYPNT\r
+ PUSH P,D\r
+ PUSHJ P,PARMOV\r
+ POP P,D\r
+ MOVE A,TYPNT\r
+ JRST VECMO6\r
+\f;PAIR MOVEMENT PHASE -- USES PARNEW,PARBOT, AND PARTOP TO MOVE PAIRS\r
+;TO NEW HOMES\r
+\r
+PARMOV: SKIPN A,PARNEW ;IS THERE ANY PAIR MOVEMENT?\r
+ POPJ P, ;NO, RETURN\r
+ JUMPL A,PARMO2 ;YES -- IF MOVING DOWNWARDS, GO DO A BLT\r
+ HRLI A,B ;MOVING UPWARDS SETAC A TO INDEX OFF AC B\r
+ MOVE B,PARTOP ;GET HIGH PAIR ADDREESS\r
+ SUB B,PARBOT ;AND SUBTRACT BOTTOM TO GET NUMBER OF PAIRS\r
+ HRLZS B ;PUT COUNT IN LEFT HALF\r
+ HRR B,PARTOP ;GET HIGH ADDRESS PLUS ONE IN RH\r
+ SUBI B,1 ;AND SUBTRACT ONE TO POINT TO LAST WORD TO BE MOVED\r
+\r
+PARMO1: TLNN B,-1 ;HAS COUNT REACHED ZERO?\r
+ JRST PARMO3 ;YES -- FINISH UP\r
+ POP B,@A ;NO -- TRANSFER2Y\eU NEXT WORD\r
+ JRST PARMO1 ;AND REPEAT\r
+\r
+PARMO2: MOVE B,PARBOT ;GET ADDRESS OF FIRST SOURCE WD\r
+ HRLS B ;IN BOTH HALVES OF AC B\r
+ ADD B,A ;MAKE RH OF B POINT TO FIRST DESTINATION WORD\r
+ ADD A,PARTOP ;MAKE RH OF A POINT TO LAST DESTINATION WORD PLUS ONE\r
+ BLT B,-1(A) ;AND TRANSFER THE BLOCK OF PAIRS\r
+\r
+PARMO3: MOVE A,PARNEW ;GET OFFSET FOR PAIR SPACE\r
+ ADDM A,PARBOT ;AND CORRECT BOTTOM\r
+ ADDM A,PARTOP ;AND CORRECT TOP.\r
+ SETZM PARNEW ;CLEAR SO IF CALLED TWICE, NO LOSSAGE\r
+ POPJ P,\r
+\f;VECZER -- CLEARS DATA IN AREAS JUST GROWN\r
+;UPDATES SIZE OF VECTORS\r
+;CLEARS RELOCATION AND GROWTH FIELDS IN DOPEWDS\r
+;CALLED WITH NEW VECTOP IN A (VECBOT SHOULD BE NEW TOO)\r
+\r
+VECZER: SUBI A,1 ;MAKE A POINT TO HIGH VECTORS\r
+VECZE1: CAMGE A,VECBOT ;REACHED BOTTOM OF VECTORS?\r
+ POPJ P, ;YES, RETURN\r
+ HLLZS F,(A) ;NO, CLEAR RELOCATION GET SIZE\r
+ HLRZS F ;AND PUT SIZE IN RH OF F\r
+ HRRZ B,-1(A) ;GET GROWTH INTO B\r
+ JUMPN B,VECZE3 ;IF THERE IS SOME GROWTH, GO DO IT\r
+VECZE2: SUBI A,(F) ;GROWTH DONE, MOVE ON TO NEXT VECTOR\r
+ JRST VECZE1 ;AND REPEAT\r
+\r
+VECZE3: HLLZS -1(A) ;CLEAR GROWTH IN THE VECTOR\r
+ LDB C,[111000,,B] ;GET HIGH ORDER GROWTH IN C\r
+ SKIPE GCDNTG\r
+ JRST VECZE5\r
+ ANDI B,377 ;AND LIMIT B TO LOW SIDE\r
+ ASHC B,6 ;EXPRESS GROWTH IN WORDS\r
+ JUMPE C,VECZE4 ;IF NO HIGH GROWTH SKIP TO LOW GROWTH\r
+ ADDI F,(C) ;ADD HIGH GROWTH TO SIZE\r
+ SUBM A,C ;GET ADDR OF 2ND WD TO BE ZEROED\r
+ SETZM -1(C) ;CLEAR 1ST WORD\r
+ HRLI C,-1(C) ;MAKE C A CLEARING BLT POINTER\r
+ BLT C,-2(A) ;AND CLEAR HIGH END DATA\r
+\r
+VECZE4: JUMPE B,VECZE5 ;IF NO LOW GROWTH SKIP TO SIZE UPDATE\r
+ MOVNI C,(F) ;GET NEGATIVE SIZE SO FAR\r
+ ADDI C,(A) ;AND MAKE C POINT TO LAST WORD OF STUFF TO BE CLEARED\r
+ ADDI F,(B) ;UPDATE SIZE\r
+ SUBM C,B ;MAKE B POINT TO LAST WD OF NEXT VECT\r
+ ADDI B,2 ;AND NOW TO 2ND DATA WD TO BE CLEARED\r
+ SETZM -1(B) ;CLEAR 1ST DATA WD\r
+ HRLI B,-1(B) ;MAKE B A CLEARING BLT POINTER\r
+ BLT B,(C) ;AND CLEAR THE LOW DATA\r
+\r
+VECZE5: HRLZM F,(A) ;STORE THE NEW SIZE IN DOPEWD\r
+ JRST VECZE2\r
+\r
+\f;SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE\r
+\r
+REHASH: MOVE TVP,TVPSTO+1(PVP) ;RESTORE TV POINTER\r
+ MOVE D,ASOVEC+1(TVP) ;GET POINTER TO VECTOR\r
+ MOVEI E,(D)\r
+ PUSH P,E ;PUSH A POINTER\r
+ HLRE A,D ;GET -LENGTH\r
+ MOVMS A ;AND PLUSIFY\r
+ PUSH P,A ;PUSH IT ALSO\r
+\r
+REH3: HRRZ C,(D) ;POINT TO FIRST BUCKKET\r
+ HLRZS (D) ;MAKE SURE NEW POINTER IS IN RH\r
+ JUMPE C,REH1 ;BUCKET EMPTY, QUIT\r
+\r
+REH2: MOVEI E,(C) ;MAKE A COPY OF THE POINTER\r
+ MOVE A,ITEM(C) ;START HASHING\r
+ TLZ A,TYPMSK#777777 ; KILL MONITORS\r
+ XOR A,ITEM+1(C)\r
+ MOVE 0,INDIC(C)\r
+ TLZ 0,TYPMSK#777777\r
+ XOR A,0\r
+ XOR A,INDIC+1(C)\r
+ TLZ A,400000 ;MAKE SURE FINAL HASH IS +\r
+ IDIV A,(P) ;DIVIDE BY TOTAL LENGTH\r
+ ADD B,-1(P) ;POINT TO WINNING BUCKET\r
+\r
+ MOVE C,[002200,,(B)] ;BYTE POINTER TO RH\r
+ CAILE B,(D) ;IF PAST CURRENT POINT\r
+ MOVE C,[222200,,(B)] ;USE LH\r
+ LDB A,C ;GET OLD VALUE\r
+ DPB E,C ;STORE NEW VALUE\r
+ HRRZ B,ASOLNT-1(E) ;GET NEXT POINTER\r
+ HRRZM A,ASOLNT-1(E) ;AND CLOBBER IN NEW NEXT\r
+ SKIPE A ;SKKIP IF NOTHING PREVIOUSLY IN BUCKET\r
+ HRLM E,ASOLNT-1(A) ;OTHERWISE CLOBBER\r
+ SKIPE C,B ;SKIP IF END OF CHAIN\r
+ JRST REH2\r
+REH1: AOBJN D,REH3\r
+\r
+ SUB P,[2,,2] ;FLUSH THE JUNK\r
+ POPJ P,\r
+\fVCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH\r
+\r
+\r
+; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC\r
+\r
+MSGGCT: [ASCIZ /USER CALLED- /]\r
+ [ASCIZ /FREE STORAGE- /]\r
+ [ASCIZ /TP-STACK- /]\r
+ [ASCIZ /TOP-LEVEL LOCALS- /]\r
+ [ASCIZ /GLOBAL VALUES- /]\r
+ [ASCIZ /TYPES- /]\r
+ [ASCIZ /STATIONARY IMPURE STORAGE- /]\r
+ [ASCIZ /P-STACK /]\r
+ [ASCIZ /BOTH STACKS BLOWN- /]\r
+ [ASCIZ /PURE STORAGE- /]\r
+ [ASCIZ /GC-RCALL- /]\r
+\r
+; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC\r
+\r
+MSGGFT: 0\r
+ [ASCIZ /BLOAT /]\r
+ [ASCIZ /GROW /]\r
+ [ASCIZ /LIST /]\r
+ [ASCIZ /VECTOR /]\r
+ [ASCIZ /SET /]\r
+ [ASCIZ /SETG /]\r
+ [ASCIZ /FREEZE /]\r
+ [ASCIZ /PURE-PAGE LOADER /]\r
+ [ASCIZ /GC /]\r
+ [ASCIZ /INTERRUPT-HANDLER /]\r
+ [ASCIZ /NEWTYPE /] \r
+\r
+\r
+\r
+\f\r
+;LOCAL VARIABLES\r
+\r
+IMPURE\r
+; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS.\r
+;\r
+\r
+GCNO: 0 ; USER-CALLED GC\r
+BSTGC: 0 ; FREE STORAGE\r
+ 0 ; BLOWN TP\r
+ 0 ; TOP-LEVEL LVALS\r
+ 0 ; GVALS\r
+ 0 ; TYPE\r
+ 0 ; STORAGE\r
+ 0 ; P-STACK\r
+ 0 ; BOTH STATCKS BLOWN\r
+ 0 ; STORAGE\r
+\r
+BSTAT:\r
+NOWFRE: 0 ; FREE STORAGE FROM LAST GC\r
+CURFRE: 0 ; STORAGE USED SINCE LAST GC\r
+MAXFRE: 0 ; MAXIMUM FREE STORAGE ALLOCATED\r
+USEFRE: 0 ; TOTAL FREE STORAGE USED\r
+NOWTP: 0 ; TP LENGTH FROM LAST GC\r
+CURTP: 0 ; # WORDS ON TP\r
+CTPMX: 0 ; MAXIMUM SIZE OF TP SO FAR\r
+NOWLVL: 0 ; # OF TOP-LEVEL LVAL-SLOTS\r
+CURLVL: 0 ; # OF TOP-LEVEL LVALS\r
+NOWGVL: 0 ; # OF GVAL SLOTS\r
+CURGVL: 0 ; # OF GVALS\r
+NOWTYP: 0 ; SIZE OF TYPE-VECTOR\r
+CURTYP: 0 ; # OF TYPES\r
+NOWSTO: 0 ; SIZE OF STATIONARY STORAGE\r
+CURSTO: 0 ; STATIONARY STORAGE IN USE\r
+CURMAX: 0 ; MAXIMUM BLOCK OF CONTIGUOUS STORAGE\r
+NOWP: 0 ; SIZE OF P-STACK\r
+CURP: 0 ; #WORDS ON P\r
+CPMX: 0 ; MAXIMUM P-STACK LENGTH SO FAR\r
+GCCAUS: 0 ; INDICATOR FOR CAUSE OF GC\r
+GCCALL: 0 ; INDICATOR FOR CALLER OF GC\r
+\r
+\r
+; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW\r
+LVLINC: 6 ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS\r
+GVLINC: 4 ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS\r
+TYPIC: 1 ; TYPE INCREMENT ASSUMED TO BE 32 TYPES\r
+STORIC: 2000 ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE)\r
+\r
+\r
+RCL: 0 ; POINTER TO LIST OF RECYCLEABLE LIST CELLS\r
+GCMONF: 0 ; NON-ZERO SAY GIN/GOUT\r
+GCDANG: 0 ; NON-ZERO, STORAGE IS LOW\r
+GCDNTG: 0 ; NON-ZERO ABORT GROWTHS\r
+GETNUM: 0 ;NO OF WORDS TO GET\r
+PARNUM: 0 ;NO OF PAIRS MARKED\r
+VECNUM: 0 ;NO OF WORDS IN MARKED VECTORS\r
+CORSET: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY\r
+CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY\r
+\r
+;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,\r
+;AND WHEN IT WILL GET UNHAPPY\r
+\r
+SYSMAX: 50. ;MAXIMUM SIZE OF MUDDLE\r
+FREMIN: 20000 ;MINIMUM FREE WORDS\r
+FREDIF: 10000 ;DIFFERENCE BETWEEN FREMIN AND MAXIMUM NUMBER OF FREE WORDS\r
+;POINTER TO GROWING PDL\r
+\r
+TPGROW: 0 ;POINTS TO A BLOWN TP\r
+PPGROW: 0 ;POINTS TO A BLOWN PP\r
+TIMOUT: 0 ;POINTS TO TIMED OUT PDL\r
+PGROW: 0 ;POINTS TO A BLOWN P\r
+\r
+;IN GC FLAG\r
+\r
+GCFLG: 0\r
+GCFLCH: 0 ; TELL INT HANDLER TO ITIC CHARS\r
+GCHAIR: 1 ; COUNTS GCS AND TELLS WHEN TO HAIRIFY\r
+SHRUNK: 0 ; NON-ZERO=> AVECTOR(S) SHRUNK\r
+GREW: 0 ; NON-ZERO=> A VECTOR(S) GREW\r
+SPARNW: 0 ; SAVED PARNEW\r
+GCDOWN: 0 ; AMOUNT TO TRY AND MOVE DOWN\r
+CURPLN: 0 ; LENGTH OF CURRENTLY RUNNING PURE RSUBR\r
+\r
+; VARS ASSOCIATED WITH BLOAT LOGIC\r
+\r
+TPBINC: 0\r
+GLBINC: 0\r
+TYPINC: 0\r
+\r
+; VARS FOR PAGE WINDOW HACKS\r
+\r
+WNDBOT: 0 ; BOTTOM OF WINDOW\r
+WNDTOP: 0\r
+BOTNEW: (FPTR) ; POINTER TO FRONTIER\r
+GCTIM: 0\r
+\r
+PURE\r
+\r
+\r
+END\r
+\r
+\r
+\r
+\r
+\r
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff