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