--- /dev/null
+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
+
+\f
+;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,
+
+\f
+;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
+\fBADTYP: PUSH TP,$TATOM ;ARGUMENT OF TYPE ATOM
+ PUSH TP,MQUOTE 2ND-ARGUMENT-NOT-A-LIST
+ JRST CALER1 ;OFF TO ERROR HANDLER
+
+
+\f;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
+
+\f;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
+\fBDTYPV: 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
+
+\f
+; 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
+\f
+; 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
+\f
+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
+\f;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
+
+\f;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
+
+
+\f
+; 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,
+\f
+;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,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK]
+[SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK]
+[SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[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
+
+\f
+; 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
+\f
+; 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
+\f
+; 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
+
+\f
+; 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+<SPVP,,0>] ;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
+\f
+;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
+
+\f;HERE WHEN A VECTOR POINTER IS BAD
+
+VECTB1: MOVEI B,[ASCIZ /AGC -- VECTOR POINTS OUTSIDE VECTOR SPACE
+/]
+ PUSHJ P,MSGTYP
+ .VALUE 0
+
+
+\f
+; 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
+\f
+;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,
+
+
+\f
+
+
+;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
+
+\f;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,
+
+\f;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,
+\f
+;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
+
+\f;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
+
+\f;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
+
+\f
+; 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
+\f
+; 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
+
+\f
+;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
+
+\f;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
+\f;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
+\f
+;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,
+\f;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
+\f;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
+\f;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 -- TRANSFER2Y\eU 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,
+\f;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
+\rVECZE4: 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
+\rVECZE5: HRLZM F,(A) ;STORE THE NEW SIZE IN DOPEWD
+ JRST VECZE2
+\f
+;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 ;B\0UCKET 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,
+\fVCMLOS: 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
+\f\ 3\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff