X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=MUDDLE%2Fagc.168;fp=MUDDLE%2Fagc.168;h=0182add148daa936817e1dbb3c77fb3c6c2607f8;hb=39c5769144e7f2a58076bdb973d2c80fa603345c;hp=0000000000000000000000000000000000000000;hpb=bab072f950a643ac109660a223b57e635492ac25;p=pdp10-muddle.git diff --git a/MUDDLE/agc.168 b/MUDDLE/agc.168 new file mode 100644 index 0000000..0182add --- /dev/null +++ b/MUDDLE/agc.168 @@ -0,0 +1,1834 @@ +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 +  \ No newline at end of file