TITLE AGC MUDDLE GARBAGE COLLECTOR ;SYSTEM WIDE DEFINITIONS GO HERE .GLOBAL PDLBUF,VECTOP,VECBOT,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,WRONGT .GLOBAL PGROW,TPGROW,TIMOUT,MAINPR,TMA,TFA,PPGROW ; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR .GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS PDLBUF=100 TPMAX==5000 ;PDLS LARGER THAN THIS WILL BE SHRUNK PMAX==1000 ;MAXIMUM PSTACK SIZE TPMIN==100 ;MINIMUM PDL SIZES PMIN==100 TPGOOD==2000 ; A GOOD STACK SIZE PGOOD==1000 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 ;FUNCTION TO CONSTRUCT A LIST MFUNCTION CONS,SUBR ENTRY 2 HLRZ A,2(AB) ;GET TYPE OF 2ND ARG CAIE A,TLIST ;LIST? JRST BADTYP ;NO , COMPLAIN HLRZ A,(AB) ;GET TYPE OF FIRST PUSHJ P,NWORDT ;GET NO. OF WORDS NEEDED FOR DATUM SOJN A,CDEFER ;GREATER THAN 1, MUST MAKE DEFERRED POINTER MOVEI A,2 ;SET UP CALL TO CELL PUSHJ P,CELL HLLZ A,(AB) ;TYPE OF FIRST ARG MOVE C,1(AB) ;GET DATUM CFINIS: PUSHJ P,CLOBIT ;STORE JRST FINIS ;HERE TO STORE IN PAIR CLOBIT: HRR A,3(AB) ;GET CDR CLOBT1: MOVEM A,(B) ;STORE FIRST MOVEM C,1(B) ;AND SECOND MOVSI A,TLIST ;GET FINAL TYPE POPJ P, ;HERE FOR A DEFERRED CONS CDEFER: MOVEI A,4 ;NEED 4 CELLS PUSHJ P,CELL MOVE A,(AB) ;GET COMPLETE 1ST WORD MOVE C,1(AB) ;AND SECOND PUSHJ P,CLOBT1 ;STORE MOVE C,B ;POINT TO DEFERRED PAIR WITH C ADDI B,2 ;POINT TO OTHER PAIR MOVSI A,TDEFER ;GET TYPE JRST CFINIS ;THIS ROUTINE ALLOCATES A CELL CELL: MOVE B,PARTOP ;GET TOP OF PAIRS ADD B,A ;FIND PROPOSED NEW TOP CAMLE B,VECBOT ;CROSSING INTO VECTORS? JRST FULL ;YES, GO COLLECT GARBAGE EXCH B,PARTOP ;NO, SET NEW TOP AND RETURN POINTER POPJ P, FULL: MOVEM A,GETNUM ;STORE WORDS NEEDED SETZM PARNEW ;NO MOVEMENT NEEDED PUSHJ P,AGC ;COLLECT GARBAGE JRST CELL ;AND TRY AGAIN ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT NWORDT: PUSHJ P,SAT ;GET STORAGE ALLOC TYPE NWORDS: 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 HLRE A,AB ;GET -NUM OF ARGS MOVNS A ;MAKE IT + JUMPE A,LISTN ;JUMP IF 0 PUSHJ P,CELL ;GET NUMBER OF CELLS PUSH TP,$TLIST ;SAVE IT PUSH TP,B 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 B,(TP) ;RESTORE LIS POINTER LISTLP: HLRZ A,(AB) ;GET TYPE PUSHJ P,NWORDT ;GET NUMBER OF WORDS SOJN A,LDEFER ;NEED TO DEFER POINTER HLLZ A,(AB) ;NOW CLOBBER ELEMENTS HLLM A,(B) MOVE A,1(AB) ;AND VALUE.. MOVEM A,1(B) LISTL2: ADDI B,2 ;STEP B ADD AB,[2,,2] ;STEP ARGS JUMPL AB,LISTLP POP TP,B POP TP,A JRST FINIS ; MAKE A DEFERRED POINTER LDEFER: PUSH TP,$TLIST ;SAVE CURRENT POINTER PUSH TP,B MOVEI A,2 ; SET UP TO GET CELLS PUSHJ P,CELL MOVE A,(AB) ;GET FULL DATA MOVE C,1(AB) PUSHJ P,CLOBT1 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 MOVSI A,TLIST JRST FINIS BADTYP: PUSH TP,$TATOM ;ARGUMENT OF TYPE ATOM PUSH TP,MQUOTE 2ND-ARGUMENT-NOT-A-LIST JRST CALER1 ;OFF TO ERROR HANDLER ;FUNCTION WHICH CONSES ITS ARGUMENT WITH NIL MFUNCTION NCONS,SUBR ENTRY 1 PUSH TP,(AB) ;SET UP CONS CALL PUSH TP,1(AB) PUSH TP,$TLIST PUSH TP,[0] MCALL 2,CONS JRST FINIS ;FUNCTION TO GENERATE A VECTOR IN VECTOR SPACE ;CALLED WITH ONE FIXNUM ARGUMENT, WHICH IS THE NUMBER OF ELEMENTS DESIRED. MFUNCTION VECTOR,SUBR ENTRY MOVEI C,1 ;THIS IS A GENERAL VECTOR VECTO3: JUMPGE AB,TFA ;TOO FEW ARGS CAMGE AB,[-4,,0] ;ASSURE NOT TOO MANY JRST TMA HLRZ A,(AB) ;GET TYPE OF ARGUMENT CAIE A,TFIX ;IS IT A FIXED NUMBER? JRST BDTYPV ;NO, GO COMPLAIN SKIPGE A,1(AB) ;GET LENGTH JRST BADNUM ;LOSING NUMBER ASH A,(C) ;TIMES TWO FOR NUMBER OF WORDS IF GENERAL ADDI A,2 ;PLUS TWO FOR DOPEWDS VECTO2: MOVE B,VECBOT ;GET CURRENT BOTTOM OF VECTORS SUB B,A ;AND SUBTRACT THE WORDS IN THIS VECTOR CAMGE B,PARTOP ;HAVE WE BUMPED INTO PAIR SPACE? JRST VECTO1 ;YES, GO GARBAGE COLLECT EXCH B,VECBOT ;UPDATE VECBOT, GET OLD POINTER HRLZM A,-1(B) ;PUT LENGTH IN DOPE WORD FIELD. MOVSI D,400000 ;PREPARE TO SET NONUNIFORM BIT JUMPE C,.+2 ;DONT SET IF UNIFORM MOVEM D,-2(B) ;CLOBBER IT IN HRRO B,VECBOT ;AND GET TOP OF VECTOR IN RH, -1 IN LH. TLC B,-3(A) ;SET LH OF ANSWER TO NEGATIVE COUNT MOVSI A,TVEC ;AND GET TYPE VECTOR TO MARK B AS AN AOBJN POINTER TO A VECTOR CAML AB,[-2,,0] ;SKIP IF 2 ARGS SUPPLIED JRST VFINIS ;ONLY ONE, LEAVE JUMPE C,UINIT ;JUMP IF NOT GENERAL VECTOR JUMPGE B,FINIS ;ZERO LENGTH, DONT INIT PUSH TP,A PUSH TP,B PUSH TP,A PUSH TP,B ;SAVE THE VECTOR INLP: PUSH TP,2(AB) PUSH TP,3(AB) ;PUSH FORM TO BE EVALLED MCALL 1,EVAL MOVE C,(TP) ;RESTORE VECTOR MOVEM A,(C) MOVEM B,1(C) ;CLOBBER ADD C,[2,,2] MOVEM C,(TP) JUMPL C,INLP ;JUMP TO DO NEXT GETVEC: MOVE A,-3(TP) MOVE B,-2(TP) SUB TP,[4,,4] ;GC TP JRST FINIS UINIT: PUSH TP,$TUVEC PUSH TP,B PUSH TP,$TUVEC PUSH TP,B PUSH P,[-1] ;WILL HOLD TYPE UINLP: PUSH TP,2(AB) PUSH TP,3(AB) MCALL 1,EVAL HLRZS A ;TYPE TO RH SKIPGE (P) ;SKIP IF 1ST SEEN JRST SET1ST CAME A,(P) JRST WRNGUT UINLP1: MOVE C,(TP) MOVEM B,(C) AOBJP C,.+3 MOVEM C,(TP) JRST UINLP ;AND CONTINUE POP P,A ;RESTORE TYPE HRLZM A,(C) ;CLOBBER UNIFORM TYPE JRST GETVEC SET1ST: MOVEM A,(P) PUSHJ P,NWORDT SOJN A,CANTUN JRST UINLP1 VFINIS: JUMPN C,FINIS MOVSI A,TUVEC JRST FINIS ;FUNCTION TO GENERATE A UNIFOM VECTOR MFUNCTION UVECTOR,SUBR MOVEI C,0 ;SET FOR A UNIFORM HACK JRST VECTO3 BADNUM: PUSH TP,$TATOM ;COMPLAIN PUSH TP,MQUOTE NEGATIVE-ARGUMENT JRST CALER1 BDTYPV: PUSH TP,$TATOM PUSH TP,MQUOTE NON-INTEGER-ARGUMENT JRST CALER1 VECTO1: SETZM PARNEW ;CLEAR RELOCATION OF PAIR SPACE MOVEM A,GETNUM ;SAVE NUMBER OF WORDS TO GET PUSHJ P,AGC ;GARBAGE COLLECT JRST VECTO3 ;AND TRY AGAIN MFUNCTION EVECTOR,SUBR ENTRY HLRE A,AB MOVNS A PUSH P,A ;SAVE NUMBER OF WORDS ASH A,-1 ;FOR VECTOR TO WIN NEED NO. OF ELEMENTS PUSH TP,$TFIX PUSH TP,A MCALL 1,VECTOR POP P,D ;RESTORE NUMBER OF WORDS HRLI C,(AB) ;START BUILDING BLT POINTER HRRI C,(B) ;TO ADDRESS ADDI D,(B)-1 ;SET D TO FINAL ADDRESS BLT C,(D) JRST FINIS ;EXPLICIT VECTORS FOR THE UNIFORM CSE MFUNCTION EUVECTOR,SUBR ENTRY HLRE A,AB ;-NUM OF ARGS MOVNS A ASH A,-1 ;NEED HALF AS MANY WORDS PUSH TP,$TFIX PUSH TP,A GETYP A,(AB) ;GET FIRST ARG PUSHJ P,NWORDT ;SEE IF NEEDS EXTRA WORDS SOJN A,CANTUN MCALL 1,UVECTOR ;GET THE VECTOR 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 JRST FINIS WRNGUT: PUSH TP,$TATOM PUSH TP,MQUOTE TYPES-DIFFER-IN-UNIFORM-VECTOR JRST CALER1 CANTUN: PUSH TP,$TATOM PUSH TP,MQUOTE DATA-CANT-GO-IN-UNIFORM-VECTOR JRST CALER1 ; FUNCTION TO GROW A VECTOR MFUNCTION GROW,SUBR ENTRY 3 MOVEI D,0 ;STACK HACKING FLAG HLRZ A,(AB) ;FIRST TYPE PUSHJ P,SAT ;GET STORAGE TYPE HLRZ 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 WRONGT ;COMPLAIN HLRZ B,4(AB) CAIE B,TFIX ;3RD ARG JRST WRONGT ;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 SUBI E,2 ;FUDGE FOR DOPE WORDS MOVNS E HRLI E,-1(E) ;TO BOTH HALVES ADDI E,(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 SKIPE A ;DON'T GC FOR NOTHING PUSHJ P,AGC 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 GTOBIG: PUSH TP,$TATOM PUSH TP,MQUOTE ATTEMPT-TO-GROW-VECTOR-TOO-MUCH JRST CALER1 GROW4: PUSH P,[0] ;0 BOTTOM GROWTH JRST GROW2 ; 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 JUMPGE B,MAKSTR ;ZERO LENGTH STRIN2: GETYP D,(B) ;GET TYPE CODE CAIN D,TCHRS ;SINGLE CHARACTER? AOJA C,STRIN1 CAIE D,TCHSTR ;OR STRING JRST WRONGT ;NEITHER MOVEM B,(TP) ;SAVE CURRENT POINTER PUSH TP,(B) PUSH TP,1(B) PUSH P,C ;SAVE CURRENT COUNT MCALL 1,LENGTH ;FIND THE LENGTH POP P,C ADDI C,(B) ;BUMP COUNT MOVE B,(TP) ;RESTORE STRIN1: ADD B,[2,,2] JUMPL B,STRIN2 ; NOW GET THE NECESSARY VECTOR MAKSTR: PUSH TP,$TFIX ADDI C,4 ;COMPUTE NEEDED WORDS IDIVI C,5 PUSH TP,C MCALL 1,UVECTOR ;GET THE VECTOR HRLI B,440700 ;CONVERT B TO A BYTE POINTER SKIPL C,AB ;ANY ARGS? JRST DONEC NXTRG1: GETYP D,(C) ;GET AN ARG CAIE D,TCHRS JRST TRYSTR LDB D,[350700,,1(C)] ;GET IT IDPB D,B ;AND DEPOSIT IT JRST NXTARG TRYSTR: MOVE E,1(C) ;GET BYTER HRRZ 0,(C) ;AND DOPE WORD POINTER LDB D,E ;GET 1ST CHAR NXTCHR: CAIG 0,1(E) ;STILL WINNING? JRST NXTARG ;NO, GET NEXT ARG JUMPE D,NXTARG ;HIT 0, QUIT IDPB D,B ;INSERT ILDB D,E ;AND GET NEXT JRST NXTCHR NXTARG: ADD C,[2,,2] ;BUMP ARG POINTER JUMPL C,NXTRG1 ADDI B,1 DONEC: MOVSI C,TCHRS HLLM C,(B) ;AND CLOBBER AWAY HLRZ C,1(B) ;GET LENGTH BACK MOVEI A,1(B) ;POINT TO DOPE WORD HRLI A,TCHSTR SUBI B,-2(C) HRLI B,350700 ;MAKE A BYTE POINTER JRST FINIS AGC": ;SET FLAG FOR INTERRUPT HANDLER SETOM GCFLG ;SAVE AC'S IRP AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,TVP,PP,PVP] MOVEM AC,AC!STO"+1(PVP) TERMIN ;SET UP E TO POINT TO TYPE VECTOR HLRZ E,TYPVEC(TVP) CAIE E,TVEC JRST AGCE1 HRRZ TYPNT,TYPVEC+1(TVP) HRLI TYPNT,B ;DECIDE WHETHER TO SWITCH TO GC PDL MOVEI A,(P) ;POINNT TO PDL HRRZ B,GCPDL ;POINT TO BASE OF GC PDL CAIG A,(B) ;SKIP IF MUST CHANGE JRST CHPDL HLRE C,GCPDL ;-LENGTH OF GC'S PDL SUB B,C ;POINT TO END OF GC'S PDL CAILE A,(B) ;SKIP IF WITHIN GCPDL CHPDL: MOVE P,GCPDL ;GET GC'S PDL ;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,PP ;GET PLANNER PDL PUSHJ P,PDLCHK ;AND CHECK IT FOR GROWTH MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK CAMN P,GCPDL ;DID PDLS CHANGE PUSHJ P,PDLCHP ;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 SETZM PARNUM ;CLEAR NUMBER OF PAIRS MOVSI D,400000 ;SIGN BIT FOR MARKING MOVE A,ASOVEC+1(TVP) ;MARK ASSOC. VECTOR NOW HLRE B,A SUBI A,(B) ;POINT TO DOPE WORD IORM D,1(A) ;AND MARK MOVE A,PVP ;START AT PROCESS VECTOR MOVEI B,TPVP ;IT IS A PROCESS VECTOR PUSHJ P,MARK ;AND MARK THIS VECTOR ; ASSOCIATION FLUSHING PHASE MOVE A,ASOVEC+1(TVP) ;GET POINTER TO VECTOR PUSHJ P,ASOMRK ;MARK AND FLUSH ;OPTIONAL RETIMING PHASE SKIPE A,TIMOUT ;ANY TIME OVERFLOWS PUSHJ P,RETIME ;YES, RE-CALIBRATE THEM ;CORE ADJUSTMENT PHASE SETZM CORSET ;CLEAR LATER CORE SETTING PUSHJ P,CORADJ ;AND MAKE CORE ADJUSTMENTS ;RELOCATION ESTABLISHMENT PHASE ;1 -- IN PAIR SPACE, SWAP LOW GARBAGE WITH HIGHER NON GARBAGE MOVE A,PARBOT" ;ONE POINTER TO BOTTOM OF PAIR SPACE MOVE B,PARTOP" ;AND ANOTHER TO TOP. PUSHJ P,PARREL ;AND ESTABLISH THE PAIR RELOCATION MOVEM B,PARTOP ;ESTABLISH NEW TOP OF PAIRS HERE ;2 -- 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 PUSHJ P,VECREL ;AND ESTABLISH RELOCATION FOR VECTORS MOVEM B,VECNEW ;SAVE FINAL OFFSET ;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 ;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 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 MOVEM A,VECTOP ;AND UPDATE VECTOP ;3 -- CLEANUP VECTORS (NOTE A CONTAINS NEW VECTOP) PUSHJ P,VECZER ; ;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 IRP AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,PP,PVP,TVP] MOVE AC,AC!STO+1(PVP) TERMIN SETZM PARNEW ;CLEAR FOR NEXT AGC CALL SETZM GETNUM ;ALSO CLEAR THIS SETZM GCFLG CPOPJ: POPJ P, AGCE1: MOVEI B,[ASCIZ /TYPVEC IS NOT OF TYPE VECTOR /] TYPSTP: PUSHJ P,MSGTYP" ;TYPE OUT A HOPELESSMESSAGE .VALUE ;AND GIVE UP ; 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? CAMN A,PPGROW ;OR PLANNER PDL JRST .+2 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 JUMPL B,MUNGT1 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 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 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 CLOBBERS USELESS STUFF IN CURRENT FRAME FRMUNG: SETZM PCSAV(A) SETZM PSAV(A) SETZM SPSAV(A) SETZM PPSAV(A) MOVEM TP,TPSAV(A) ;SAVE FOR MARKING 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 PUSH P,A ;SAVE GOODIE HRLM C,-1(P) ;AND POINTER TO IT LSH B,1 ;TIMES 2 TO GET SAT HRRZ B,@TYPNT ;GET SAT JRST @MKTBS(B) ;AND GO MARK ; 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] [SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECTMK] [SLOCID,],[SCHSTR,],[SASOC,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 MOVEI C,(A) ;POINT TO LIST PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS CAMGE C,PARBOT JRST BDPAIR ;OUT OF BOUNDS,COMPLAIN SKIPGE B,(C) ;SKIP IF NOT MARKED JRST GCRET ;ALREADY MARKED, RETURN IORM D,(C) ;MARK IT AOS PARNUM HLRZS B ;TYPE TO RH OF B MOVE A,1(C) ;DATUM TO A JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER PUSHJ P,MARK ;MARK THIS DATUM HRRZ C,(C) ;GET CDR OF LIST JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT HLRZ C,-1(P) ;RESTORE C POP P,A POPJ P, ;AND RETURN TO CALLER ;HERE TO SQUAWK WHEN A PAIR POINTER IS BAD BDPAIR: MOVEI B,[ASCIZ /AGC -- MARKED PAIR POINTS OUTSIDE PAIR SPACE /] PUSHJ P,MSGTYP .VALUE 0 ;HERE TO MARK DEFERRED POINTER DEFDO: PUSHJ P,MARK ;MARK THE DATUM JRST GCRET ;AND RETURN ; 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 CAMGE A,VECTOP ;CHECK BOUNDS CAMGE A,VECBOT JRST VECTB1 ;LOSE, COMPLAIN JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK CAMN A,PPGROW ;CHECK PLANNER PDL JRST NOBUFR 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 ADDM 0,1(C) NOBUFR: HLRZ B,(A) ;GET LENGTH FROM DOPE WORD 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 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 ADD B,0 ;TOTAL GROWTH TO B ADD A,0 ;DOPE WORD IS HIGHER NOCHNG: SKIPGE TYPNT ;IS THIS A PDL? SUBI F,1 ;YES, POINTER MAY POINT OUTSIDE CAIG E,(A) ;IS E IN BOUNDS? CAIG E,(F) JRST VECLOS ;NO, CLOBBER POINTER TO IT VECOK: SUB A,0 ;A POINTS TO DOPW WORD AGAIN 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 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 ADDM F,VECNUM ;AND UPDATE VECNUM MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C ; LOOP TO MARK ELEMENTS IN A GENRAL VECTOR VECTM2: HLRE B,(C) ;GET TYPE AND MARKING JUMPL B,GCRET ;RETURN, (EITHER DOPE WORD OR FENCE POST) MOVE A,1(C) ;DATUM TO A CAIN B,TENTRY ;IS THIS A STACK FRAME JRST MFRAME ;YES, MARK IT CAIN B,TBIND ;OR A BINDING BLOCK JRST MBIND VECTM3: PUSHJ P,MARK ;MARK DATUM ADDI C,2 JRST VECTM2 MFRAME: HRROI C,FRAMLN+SPSAV-1(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,PPSAV-TPSAV(C) ;POINT SAVED PP MOVEI B,TPP PUSHJ P,MARK1 MOVEI C,-PPSAV+1(C) ;POINT PAST THE FRAME JRST VECTM2 ;AND DO MORE MARKING MBIND: MOVEI B,TATOM ;FIRST MARK ATOM 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 ; SUBROUTINE TO CHECK THE TIME FOR LOCIDS,ARGS AND FRAMES ; A/ POINT TO FRAME C/GOODIE B/ITS TIME TIMECH: HLRZ 0,OTBSAV(A) ;GET THE FRAMES TIME CAIN 0,(B) ;SAME? POPJ P, ;YES, WIN SUB P,[1,,1] ;NO, REMOVE RETLOC BADARG: TIMLOS: HLLZ 0,(C) ;GET OLD TYPE MOVSI B,TILLEG ;ILLEGAL TYPE MOVEM B,(C) ;AND STORE IT MOVEM 0,1(C) ;USE OLD TYPE AS DATUM JRST GCRET ;AND STOP MARKING FROM THE LOSER ; MARK ARG POINTERS (SABASE AND SARGS) ARGMK: HLRE B,A ;-LENGTH TO B SUBI A,(B) ;POINT TO FRAME OR FRAME POINTER HLRZ E,(A) ;GET TYPE CAIE E,TENTRY ;IS TJHIS A FRAME JRST ARGMK2 ;NO, CHECK OTHER MOVEI A,FRAMLN(A) ;POINT ABOVE FRAME ARGMK3: HRRZ B,(C) ;GET TIME PUSHJ P,TIMECH JRST GCRET ;DONE ARGMK2: CAIE E,TTB ;BASE POINTER? JRST BADARG ;LOSE HRRZ A,1(A) ;POINT TO FRAME JRST ARGMK3 ;AND MARK IT AS SUCH ; MARK FRAME POINTERS FRMK: HLRZ B,A ;GET TIME IN B PUSHJ P,TIMECH ;CHECK ITS TIME 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: HRRZ A,(C) ;POINT TO DOPE WD SOJG A,VECTMK ;FUDGE DOPE WORD POINTER FOR VECTMK MOVEI B,[ASCIZ /AGC -- BYTE POINTER WITH ZERO DOPE WORD POINTER /] PUSHJ P,MSGTYP .VALUE ; MARK ATOMS ATOMK: PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS MOVEI C,(A) HLRZ B,(C) ;GET TYPE MOVE A,1(C) ;AND VALUE ;******FUDGE UNTIL MIRE WINNAGE****** HRRZ E,(C) ;GOBBLE PROCESS ID CAIN B,TUNBOUND ;IF NOT UNBOUND JRST GCRET ;IS UNVOUND, IGNORE SKIPN E ;SKIP IF NOT GLOBAL PROCESS MOVEI B,TVEC ;IS GLOBAL, MARK AS A VECTOR PUSHJ P,MARK ;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 CAMGE A,VECTOP ;CHECK BOUNDS CAMGE A,VECBOT 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 ADDM B,VECNUM ;UPDATE VECNUM POPJ P, ;AND RETURN GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS JRST GCRET ; 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 ADDM F,VECNUM ;INCREASE VECNUM HLRZS B ;ISOLATE TYPE MOVE F,B ; AND COPY IT LSH B,1 ;FIND OUT WHERE IT WILL GO HRRZ B,@TYPNT ;GET SAT IN B 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 SOSE -1(P) ;COUNT AOJA C,UNLOOP ;IF MORE, DO NEXT SUB P,[2,,2] ;REMOVE STACK CRAP JRST GCRET SPECLS: MOVEI B,[ASCIZ /AGC -- UNRECOGNIZED SPECIAL VECTOR /] PUSHJ P,MSGTYP .VALUE ;MARK LOCID TYPE GOODIES LOCMK: HRRZ B,(C) ;GET TIME JUMPE B,GLBSP ;IF TIME IS 0, THIS IS THE GLOBAL SP HRRZ 0,2(A) ;GET TIME CAIE 0,(B) ;EQUAL? JRST TIMLOS ;NO, LOSE MOVE A,3(A) ;GOBBLE SP POINTER JRST TPMK GLBSP: MOVE A,1(C) ;MARK LIKE A VECTOR JRST VECTMK ; MARK ASSOCIATION BLOCKS ASMRK: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS GETYP B,(A) ;CHECK TYPE OF FIRST CAIN B,TTP JRST GCRET ;THIS IS THE DUMMY MOVEI C,(A) ;COPY POINTER PUSHJ P,MARK2 ;MARK ITEM CELL ADDI C,INDIC-ITEM ;POINT TO INDICATOR PUSHJ P,MARK2 ADDI C,VAL-INDIC PUSHJ P,MARK2 ADDI C,NODPNT-VAL-1 ;POINT TO NODE CHAIN HRRZ A,1(C) ;DOES IT EXIST JUMPE A,GCRET MOVEI B,TASOC PUSHJ P,MARK ;AND MARK IT JRST GCRET ;HERE WHEN A VECTOR POINTER IS BAD VECTB1: MOVEI B,[ASCIZ /AGC -- VECTOR POINTS OUTSIDE VECTOR SPACE /] PUSHJ P,MSGTYP .VALUE 0 ; THIS PHASE REMOVES ANY UNWANTED ASSOCIATIONS ALSO PRESERVES DATA POINTED TO ONLY BY ASSOCIATIONS ; RECEIVES POINTER TO ASSOCIATION VECTOR IN A ASOMRK: SKIPN C,(A) ;DOES BUCKET CONTAIN ANYTHING JRST ASOM3 ;NO, ;IGNORE ASOM2: HRRE 0,ASOLNT+1(C) ;CHECK FOR CIRCULARITY AOJE 0,ASOM6 ;ALREADY MARKED, LOSE HLLOS ASOLNT+1(C) SKIPGE ASOLNT+1(C) ;IS THIS ONE POINTED AT? JRST ASOM4 ;YES, GOODIES ALREADY MARKED PUSHJ P,MARKQ ;SEE IF ITS ITEM IS MARKED JRST ASOFLS ;NO, FLUSH THIS ASSOCIATION MOVEI E,MARKQ ;POINT TO QUESTIONER SKIPE NODPNT(C) ;SKIP IF NOT ON A CHAIN MOVEI E,MARK23 ;ON CHAIN, MARK THE INDICATOR MOVEI C,INDIC(C) ;POINT TO INDICATOR PUSHJ P,(E) JRST ASOFL7 ;INDICATOR NOT MARKED MOVEI C,-INDIC(C) ;POINT BACK TO START ASOM1: PUSH P,C ;ITEM IS MARKED, MARK INDIC AND VAL AND ASSOC PUSH P,A ADDI C,VAL ;POINT TO VAL PUSHJ P,MARK2 IORM D,ASOLNT+1-VAL(C) ;MARK THE ASSOCIATION BLOCK POP P,A POP P,C ASOM4: MOVEI E,(C) ;INCASE NEED TO FLUSH CIRCULARITY HRRZ C,ASOLNT-1(C) ;POINT TO NEXT IN CHAIN JUMPN C,ASOM2 ;GO MARKK IT ASOM3: AOBJN A,ASOMRK ;GO ONTO NEXT BUCKET POPJ P, ;ALL MARKED, QUIT ;HERE TO FLUSH AN ASSOCIATION ASOFLS: HRRZ B,ASOLNT-1(C) ;GET FORWARD AND BACKWARD POINTERS HLRZ E,ASOLNT-1(C) JUMPN E,ASOFL1 ;JUMP IF PREV EXISTS HRRZM B,(A) ;CLOBBER VECTOR ENTRY JRST .+2 ASOFL1: HRRM B,ASOLNT-1(E) ;CLOBBER PREVIOUS BLOCKKS NEXT JUMPE B,ASOM4 ;IF NEXT IS 0, DONE HRLM E,ASOLNT-1(B) ;ELSE CLOBBER NEXT'S PREVIOUS JRST ASOM4 ASOM6: HLLZS (E) ;FORCE CIRCULARITY AWAY HRRZS (C) ;AND THE OTHERS PREV JRST ASOM3 ;AND FINISH THIS BUCKET MARK23: PUSH P,A PUSHJ P,MARK2 ;MARK IT POP P,A ;RESTORE A JRST MKD ;MUST SKIP ASOFL7: MOVEI C,ITEM-INDIC(C) ;RESET C JRST ASOFLS ;AND FLUSH ;SUBROUTINE TO SEE IF A GOODIE IS MARKED ;RECEIVES POINTER IN C ;SKIPS IF MARKED NOT OTHERWISE MARKQ: MOVE E,1(C) ;DATUM TO C HLRZ B,(C) ;TYPE TO B LSH B,1 HRRZ B,@TYPNT ;GOBBLE SAT JRST @MQTBS(B) ;DISPATCH DISTBS MQTBS,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ] [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SBYTE,BYTMK] [SATOM,VECMQ],[SPVP,VECMQ],[SLOCID,VECMQ],[SCHSTR,BYTMQ]] PAIRMQ: SKIPGE (E) ;SKIP IF NOT MARKED MKD: AOS (P) POPJ P, BYTMQ: HRRZ E,(C) ;GET DOPE WORD POINTER SOJA E,VECMQ1 ;TREAT LIKE VECTOR ARGMQ: HLRE F,E ;CHECK AM ARG POINTER SUB E,F ;POINT TO END OF ARG BLOCK HLRZ B,(E) ;GET TYPE CAIN B,TENTRY ;IS IT AN ENTRY MOVEI E,FRAMLN+1(E) ;MAKE INTO FRAME POINTER CAIN B,TTB ;IS IT A FRAME POINTER HRRZ E,1(E) ;PICK IT UP FRMQ: MOVE E,TPSAV(E) ;PICK UP A STACK POINTER VECMQ: HLRE F,E ;GET LENGTH SUB E,F ;POINT TO DOPE WORDS VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED AOS (P) ;MARKED, CAUSE SKIP RETURN POPJ P, ;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: 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 -- SETS TOP OF CORE ;AND TOP OF VECTOR SPACE TO SIZE NEEDED FOR SUFFICIENT FREE SPACE TO BE ADDED TO ;ALLOW FOR "EFFICIENT" PROCESSING CORADJ: .SUSET [.RMEMT,,CORTOP] ;SET CORTOP FROM SYSTEM MOVE A,PARBOT ;GET ADDRESS OF BOTTOM OF MOVABLE CORE ADD A,PARNEW ;AND ADDJUST TO WHERE IT WILL BE ADD A,PARNUM ;ADD NUMBER OF PAIRS ADD A,PARNUM ;TWICE TO GET TOP OF PAIR SPACE. ADD A,VECNUM ;ADD NUMBER OF VECTOR WORDS ADD A,GETNUM ;AND NUMBER OF WORDS TO BE GOTTEN THIS TIME ADD A,FREMIN ;AND NUMBER OF FREE WORDS MINIMUM SUB A,CORTOP ;LESS CURRENT TOP OF CORE JUMPG A,CORAD2 ;IF GREATER THAN ZERO, MORE CORE NEEDED ADD A,FREDIF ;ADD IN DIFFERENCE BETWEEEN FREE AND GOT ADDI A,1777 ;ROUND UP TO NEXT BLOCK ANDCMI A,1777 ;AND DOWN TO A BLOCK BOUNDARY JUMPGE A,CORAD1 ;IF POSITIVE, NO CORE ADJUSTMENT NEEDED ADDB A,CORTOP ;CALCULATE NEG TOP OF CORE ASH A,-10. ;CONVERT TO BLOCKS MOVEM A,CORSET ;AND SET NUMBER OF BLOCKS CORAD1: MOVE A,CORTOP ;CALCU;ATE NEW TOP OF CORE SUB A,VECTOP ;FIND OFFSET FROM CURRENT VECTOR TOP MOVEM A,VECNEW ;AND SAVE AS NEW HOME OF VECTORS POPJ P, ;HERE IF MORE CORE NEEDED, NO OF WDS IN A CORAD2: ADD A,CORTOP ;FIND TOP OF CORE ADDI A,1777 ;AND ROUND UPWARDS ASH A,-10. ;AND CONVERT TO NUMBER OF BLOCKS CAMLE A,SYSMAX ;COMPARE TO MAXIMUM ALLOWED PUSHJ P,CORAD3 .CORE (A) ;ASK OFR THE NEW SIZE PUSHJ P,CORAD4 ;FAILURE, GO COMPLAIN JRST CORADJ ;OK TRY AGAIN CORAD3: SKIPA B,[[ASCIZ /ATTEMPT TO EXPAND PAST MUDDLE LIMIT/]] CORAD4: MOVEI B,[ASCIZ /NO CORE AVAILABLE/] PUSH P,A ;SAVE AMOUNT ASKED FOR PUSHJ P,MSGTYP MOVEI B,[ASCIZ /PROCEED?/] PUSHJ P,MSGTYP PUSHJ P,TYI" CAIN A,"Y JRST .+2 .VALUE POP P,A ;RESTORE AMOUNT POPJ P, ;AND GO BACK CORADL: .CORE (A) ;SET TO NEW CORE VALUE .VALUE POPJ P, ;PARREL -- PAIR RELOCATION ESTABLISMENT ;ESTABLISH PAIR RELOCATION. CALLED WITH ;BOTTOM IN AC A, AND TOP IN AC B. PARRE0: SUBI B,2 ;MOVE POINTER BACK IORM D,(B) ;MARK THIS PAIR AS JUNK PARREL: CAIG B,(A) ;HAVE THE POINTERS MET? POPJ P, ;YES -- RETURN WITH NEW PARTOP IN B SKIPL C,-2(B) ;MARKED PAIR ON BOTTOM? JRST PARRE0 ;NO -- MOVE TOWARD BOTTOM PARRE1: SKIPGE (A) ;JUNK ON BOTTOM? JRST PARRE2 ;NO -- MOVE FORWARD MOVEM C,(A) ;STORE PAIR IN NEW LOCATION MOVE C,-1(B) ;GET DATUM MOVEM C,1(A) ;AND STORE IN NEW HOME HRROM A,-2(B) ;SET "BROKEN HEART" TO NEW HOME JRST PARRE0 ;AND CONTINUE PARRE2: ANDCAM D,(A) ;UNMARK PAIR ADDI A,2 ;GO ON TO NEXT PAIR CAIG B,(A) ;TEST TO SEE IF POINTERS MET POPJ P, ;YES -- DONE JRST PARRE1 ;KEEP LOOKING FORWARD ;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 HLLZS (A) ;CLEAR RELOC FIELD ADDI B,(C) ;INCREMENT OFFSET 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 ASH F,6 ;CONVERT TO WORDS ADD B,F ;UPDATE RELOCATION HRRM B,(A) ;AND STORE IT ANDI E,777 ;ISOLATE BOTTOM GROWTH TRZN E,400 ;CHECK AND CLEAR SIGN MOVNS E 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 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 HRRZ C,(A) ;GET CURRENT CDR HLRZ B,(A) ;GET TYPE LSH B,1 ;TIMES 2 HRRZ B,@TYPNT ;NOW GET SAT SKIPGE MKTBS(B) ;SKIP IF IT HAS A CDR JRST PARUP1 ;NO CDR, DON'T UPDATE IT JUMPE C,PARUP1 ;IF NIL, DON'T UPDATE SKIPGE B,(C) ;GET POINTER UPDATE AND SKIP IF THIS IS NOT A BROKEN HEART HRRM B,(A) ;IT WAS, STORE NEW POINTER SKIPE B,PARNEW ;IF LIST SPACE IS MOVING, ADDM B,(A) ;THEN ADD OFFSET TO CDR ;UPDATE VALUE CELL PARUP1: 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 VECUP1: CAMG A,VECBOT ;ANY MORE VECTORS TO PROCESS? JRST ENHACK ;PROCESS ALL ENTRY BLOCKS NOW 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 CAIN B,TENTRY ;SPECIAL HACK FOR ENTRY JRST ENTRUP CAIE B,TBVL ;VECTOR BINDING? CAIN B,TBIND ;AND BINDING BLOCK 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 JRST VECUP5 ;GO ON TO NEXT VECTOR ; 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 ADD C,@(P) ;ADD RELOCATION OF SELF HRRM C,(A) ;AND STORE IT BACK NONEXT: 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 LOCATIVE POINTER HLRZ B,(A) ;GET TYPE PUSHJ P,VALPD1 JRST VECU12 VECU14: 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 JUMPE F,LSTFRM ;FINISHED ENHCK1: MOVEI A,OTBSAV-1(F) ;POINT PRIOR TO SAVED TB HRRZ F,1(A) ;POINT TO PRIOR FRAME MOVEI B,TTB ;MARK SAVED TB PUSHJ P,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] MOVEI B,TPP PUSHJ P,[AOJA A,VALPD1] ;MARK THE PP JUMPN F,ENHCK1 ;MARK NEXT ONE IF IT EXISTS LSTFRM: HRRZ A,PROCID(LPVP) ;NEXT PROCESS HLLZS PROCID(LPVP) ;CLOBBER MOVEI LPVP,(A) JUMPN LPVP,ENHACK ;DO NEXT PROCESS POPJ P, ;ALL DONE ; UPDATE ELEMENTS IN UNIFROM AND SPECIAL VECTORS VECUP6: JUMPL E,VECUP7 ;JUMP IF SPECIAL HLRZS E ;ISOLATE TYPE 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 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: SKIPE C,1(A) ;GET GOODIE 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 MOVEI B,[ASCIZ /VECTOR UPDATE, ENCOUNTERED FUNNY SPECIAL VECTOR /] PUSHJ P,MSGTYP .VALUE ; UPDATE ATOM VALUE CELLS ATOMUP: SUBI A,-1(B) ; POINT TO VALUE CELL HLRZ B,(A) HRRZ 0,(A) ;GOBBLE PROCID JUMPN 0,.+3 ;NOT GLOBAL CAIN B,TLOCI ;IS IT A LOCATIVE? MOVEI B,TVEC ;MARK AS A VECTOR PUSHJ P,VALPD1 ;UPDATE IT JRST VECUP4 ; UPDATE PROCESS VECTOR PVPUP: SUBI A,-1(B) ;POINT TO TOP HRRM LPVP,PROCID(A) ;CHAIN ALL PROCESSES TOGETHER MOVEI LPVP,(A) HRRZ 0,TBSTO+1(A) ;POINT TO CURRENT FRAME HRRM 0,TBSTO(A) ;SAVE 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 HRRE C,ASOLNT+1(B) ;AND GET ITS RELOC IN C ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED PONTER ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER JUMPE B,ASOUP2 HRLZ F,ASOLNT+1(B) ;AND ITS RELOCATION ADDM F,ASOLNT-1(A) ;RELOCATE ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN JUMPE B,ASOUP4 HRRE C,ASOLNT+1(B) ;GET RELOC ADDM C,NODPNT(A) ;ANID UPDATE ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER JUMPE B,ASOUP5 HRLZ F,ASOLNT+1(B) ;RELOC 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: TRNN C,-1 ;ANY POINTER PART? JRST CPOPJ ;NO, LEAVE LSH B,1 ;SET TYPE TIMES 2 HRRZ B,@TYPNT ;GET STORAGE ALLOCATION TYPE JRST @UPDTBS(B) ;AND DISPATCH THROUGH STORAGE ALLOCATION DISPATCH TABLE ;SAT DISPATCH TABLE DISTBS UPDTBS,CPOPJ,[[S2WORD,2WDUP],[S2DEFR,2WDUP],[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]] ;PAIR POINTER UPDATE 2WDUP: 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 HRRE B,(C) ;EXTEND RELOCATION IN B 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 ASH C,6+18. ;TO LH AND TIMES 100(8) ADDM C,1(A) ;UPDATE POINTER POPJ P, LOCUP1: HRRZ B,2(C) ;GET TIME FROM STACK HRRM B,(A) ;AND USE IT STCKUP: MOVSI B,PDLBUF ;GET OFFSET FOR PDLS ADDM B,1(A) ;AND ADD TO COUNT JRST NWRDUP ;NOW TREAT LIKE VECTOR BYTUP: HRRZ C,(A) ;SET C TO POINT TO DOPE WD HRRE B,(C) ;SET B TO RELOCATION FOR THIS VEC ADDM B,(A) ;UPDATE DOPE WD POINTER ADDM B,1(A) ;AND UPDATE VALUE POPJ P, ;DONE WITH UPDATE ARGUP: TLOA TYPNT,400000 ;FLAG AS AN ARGS POINTER ABUP: TLZ TYPNT,400000 ;FLAG AS NOT ARGS POINTER HLRE B,C ;GET LENGTH SUB C,B ;POINT TO FRAME HLRZ B,(C) ;GET TYPE OF NEXT GOODIE CAIE B,TENTRY ;IS IT A FRAME HRRZ C,1(C) ;NO, POINT TO FRAME CAIN B,TENTRY ;IF IT IS A FRAME ADDI C,FRAMLN ;POINT TO ITS BASE TLZN TYPNT,400000 ;SKIP IF ARGS BLOCK JRST TBUP ;NO, JUST AN AB HLRZ B,OTBSAV(C) ;GET TIME HRRM B,(A) ;AND CLOBBER IT AWAY TBUP: MOVE C,TPSAV(C) ;GET A ASTACK POINTER TO FIND DOPE WORD HLRE B,C ;UPDATE BASED ON THIS POINTER SUBI C,(B) HRRE B,1(C) ;GET RELOCATION ADDM B,1(A) ;AND MUNG POINTER POPJ P, FRAMUP: HRRZ B,(A) ;GET PROCESS POINTER HRRE B,(B) ;GET ITS RELOCATION ADDM B,(A) HLLZ B,OTBSAV(C) ;GET FRAMES TIME HLLM B,1(A) ;AND STORE IN FRAME POINTER JRST TBUP ;AND CONTINUE UPDATING ;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 HRLZI C,(C) ;TO LH ADD F,C ;CHANGE LENGTH MOVEM F,(A) ;AND STORE MOVMS C ;PLUSIFY HLLZM 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 HRLZM 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 HRRE B,(A) ;GET RELOCATION OF THIS VECTOR 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,[111100,,-1(C)] ;GET HIGH GROWTH FIELD JUMPE B,VECMO3 ;IF NO GROWTH, DONT MOVE 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 HRRE B,(A) ;GET RELOCATION OF THIS VECTOR 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 HRRE B,(A) ;GET RELOCATION FOR THIS VECTOR 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,[111100,,B] ;GET HIGH ORDER GROWTH IN C ANDI B,777 ;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 XOR A,ITEM+1(C) XOR A,INDIC(C) XOR A,INDIC+1(C) MOVMS A ;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: MOVEI B,[ASCIZ /AGC -- VECTOR WITH ZERO IN DOPE WORD LENGTH /] PUSHJ P,MSGTYP .VALUE ;LOCAL VARIABLES 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: 1000 ;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 END