1 TITLE AGC MUDDLE GARBAGE COLLECTOR
2 ;SYSTEM WIDE DEFINITIONS GO HERE
3 .GLOBAL PDLBUF,VECTOP,VECBOT,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,WRONGT
4 .GLOBAL PGROW,TPGROW,TIMOUT,MAINPR,TMA,TFA,PPGROW
6 ; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR
8 .GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS
12 TPMAX==5000 ;PDLS LARGER THAN THIS WILL BE SHRUNK
13 PMAX==1000 ;MAXIMUM PSTACK SIZE
14 TPMIN==100 ;MINIMUM PDL SIZES
16 TPGOOD==2000 ; A GOOD STACK SIZE
22 TYPNT=AB ;SPECIAL AC USAGE DURING GC
23 F=TP ;ALSO SPECIAL DURING GC
24 LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN
26 ;FUNCTION TO CONSTRUCT A LIST
29 HLRZ A,2(AB) ;GET TYPE OF 2ND ARG
31 JRST BADTYP ;NO , COMPLAIN
32 HLRZ A,(AB) ;GET TYPE OF FIRST
33 PUSHJ P,NWORDT ;GET NO. OF WORDS NEEDED FOR DATUM
34 SOJN A,CDEFER ;GREATER THAN 1, MUST MAKE DEFERRED POINTER
35 MOVEI A,2 ;SET UP CALL TO CELL
37 HLLZ A,(AB) ;TYPE OF FIRST ARG
38 MOVE C,1(AB) ;GET DATUM
39 CFINIS: PUSHJ P,CLOBIT ;STORE
42 ;HERE TO STORE IN PAIR
44 CLOBIT: HRR A,3(AB) ;GET CDR
45 CLOBT1: MOVEM A,(B) ;STORE FIRST
46 MOVEM C,1(B) ;AND SECOND
47 MOVSI A,TLIST ;GET FINAL TYPE
50 ;HERE FOR A DEFERRED CONS
52 CDEFER: MOVEI A,4 ;NEED 4 CELLS
54 MOVE A,(AB) ;GET COMPLETE 1ST WORD
55 MOVE C,1(AB) ;AND SECOND
57 MOVE C,B ;POINT TO DEFERRED PAIR WITH C
58 ADDI B,2 ;POINT TO OTHER PAIR
59 MOVSI A,TDEFER ;GET TYPE
63 ;THIS ROUTINE ALLOCATES A CELL
64 CELL: MOVE B,PARTOP ;GET TOP OF PAIRS
65 ADD B,A ;FIND PROPOSED NEW TOP
66 CAMLE B,VECBOT ;CROSSING INTO VECTORS?
67 JRST FULL ;YES, GO COLLECT GARBAGE
68 EXCH B,PARTOP ;NO, SET NEW TOP AND RETURN POINTER
71 FULL: MOVEM A,GETNUM ;STORE WORDS NEEDED
72 SETZM PARNEW ;NO MOVEMENT NEEDED
73 PUSHJ P,AGC ;COLLECT GARBAGE
74 JRST CELL ;AND TRY AGAIN
77 ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT
79 NWORDT: PUSHJ P,SAT ;GET STORAGE ALLOC TYPE
80 NWORDS: SKIPL MKTBS(A) ;-ENTRY IN TABLE MEANS 2 NEEDED
81 SKIPA A,[1] ;NEED ONLY 1
86 ;FUNCTION TO BUILD A LIST OF MANY ELEMENTS
91 HLRE A,AB ;GET -NUM OF ARGS
93 JUMPE A,LISTN ;JUMP IF 0
94 PUSHJ P,CELL ;GET NUMBER OF CELLS
95 PUSH TP,$TLIST ;SAVE IT
97 LSH A,-1 ;NUMBER OF REAL LIST ELEMENTS
99 CHAINL: ADDI B,2 ;LOOP TO CHAIN ELEMENTS
100 HRRZM B,-2(B) ;CHAIN LAST ONE TO NEXT ONE
101 SOJG A,.-2 ;LOOP TIL ALL DONE
102 CLEARM B,-2(B) ;SET THE LAST CDR TO NIL
104 ; NOW LOBEER THE DATA IN TO THE LIST
106 MOVE B,(TP) ;RESTORE LIS POINTER
107 LISTLP: HLRZ A,(AB) ;GET TYPE
108 PUSHJ P,NWORDT ;GET NUMBER OF WORDS
109 SOJN A,LDEFER ;NEED TO DEFER POINTER
110 HLLZ A,(AB) ;NOW CLOBBER ELEMENTS
112 MOVE A,1(AB) ;AND VALUE..
114 LISTL2: ADDI B,2 ;STEP B
115 ADD AB,[2,,2] ;STEP ARGS
122 ; MAKE A DEFERRED POINTER
124 LDEFER: PUSH TP,$TLIST ;SAVE CURRENT POINTER
126 MOVEI A,2 ; SET UP TO GET CELLS
128 MOVE A,(AB) ;GET FULL DATA
131 MOVE C,(TP) ;RESTORE LIST POINTER
132 MOVEM B,1(C) ;AND MAKE THIS BE THE VALUE
134 HLLM A,(C) ;AND STORE IT
142 \fBADTYP: PUSH TP,$TATOM ;ARGUMENT OF TYPE ATOM
143 PUSH TP,MQUOTE 2ND-ARGUMENT-NOT-A-LIST
144 JRST CALER1 ;OFF TO ERROR HANDLER
147 \f;FUNCTION WHICH CONSES ITS ARGUMENT WITH NIL
150 PUSH TP,(AB) ;SET UP CONS CALL
157 \f;FUNCTION TO GENERATE A VECTOR IN VECTOR SPACE
158 ;CALLED WITH ONE FIXNUM ARGUMENT, WHICH IS THE NUMBER OF ELEMENTS DESIRED.
160 MFUNCTION VECTOR,SUBR
162 MOVEI C,1 ;THIS IS A GENERAL VECTOR
163 VECTO3: JUMPGE AB,TFA ;TOO FEW ARGS
164 CAMGE AB,[-4,,0] ;ASSURE NOT TOO MANY
166 HLRZ A,(AB) ;GET TYPE OF ARGUMENT
167 CAIE A,TFIX ;IS IT A FIXED NUMBER?
168 JRST BDTYPV ;NO, GO COMPLAIN
169 SKIPGE A,1(AB) ;GET LENGTH
170 JRST BADNUM ;LOSING NUMBER
171 ASH A,(C) ;TIMES TWO FOR NUMBER OF WORDS IF GENERAL
172 ADDI A,2 ;PLUS TWO FOR DOPEWDS
173 VECTO2: MOVE B,VECBOT ;GET CURRENT BOTTOM OF VECTORS
174 SUB B,A ;AND SUBTRACT THE WORDS IN THIS VECTOR
175 CAMGE B,PARTOP ;HAVE WE BUMPED INTO PAIR SPACE?
176 JRST VECTO1 ;YES, GO GARBAGE COLLECT
177 EXCH B,VECBOT ;UPDATE VECBOT, GET OLD POINTER
178 HRLZM A,-1(B) ;PUT LENGTH IN DOPE WORD FIELD.
179 MOVSI D,400000 ;PREPARE TO SET NONUNIFORM BIT
180 JUMPE C,.+2 ;DONT SET IF UNIFORM
181 MOVEM D,-2(B) ;CLOBBER IT IN
182 HRRO B,VECBOT ;AND GET TOP OF VECTOR IN RH, -1 IN LH.
183 TLC B,-3(A) ;SET LH OF ANSWER TO NEGATIVE COUNT
184 MOVSI A,TVEC ;AND GET TYPE VECTOR TO MARK B AS AN AOBJN POINTER TO A VECTOR
185 CAML AB,[-2,,0] ;SKIP IF 2 ARGS SUPPLIED
186 JRST VFINIS ;ONLY ONE, LEAVE
187 JUMPE C,UINIT ;JUMP IF NOT GENERAL VECTOR
189 JUMPGE B,FINIS ;ZERO LENGTH, DONT INIT
193 PUSH TP,B ;SAVE THE VECTOR
196 PUSH TP,3(AB) ;PUSH FORM TO BE EVALLED
198 MOVE C,(TP) ;RESTORE VECTOR
200 MOVEM B,1(C) ;CLOBBER
203 JUMPL C,INLP ;JUMP TO DO NEXT
205 GETVEC: MOVE A,-3(TP)
210 UINIT: PUSH TP,$TUVEC
214 PUSH P,[-1] ;WILL HOLD TYPE
220 SKIPGE (P) ;SKIP IF 1ST SEEN
228 JRST UINLP ;AND CONTINUE
230 POP P,A ;RESTORE TYPE
231 HRLZM A,(C) ;CLOBBER UNIFORM TYPE
239 VFINIS: JUMPN C,FINIS
244 ;FUNCTION TO GENERATE A UNIFOM VECTOR
246 MFUNCTION UVECTOR,SUBR
248 MOVEI C,0 ;SET FOR A UNIFORM HACK
251 BADNUM: PUSH TP,$TATOM ;COMPLAIN
252 PUSH TP,MQUOTE NEGATIVE-ARGUMENT
254 \fBDTYPV: PUSH TP,$TATOM
255 PUSH TP,MQUOTE NON-INTEGER-ARGUMENT
258 VECTO1: SETZM PARNEW ;CLEAR RELOCATION OF PAIR SPACE
259 MOVEM A,GETNUM ;SAVE NUMBER OF WORDS TO GET
260 PUSHJ P,AGC ;GARBAGE COLLECT
261 JRST VECTO3 ;AND TRY AGAIN
263 MFUNCTION EVECTOR,SUBR
267 PUSH P,A ;SAVE NUMBER OF WORDS
268 ASH A,-1 ;FOR VECTOR TO WIN NEED NO. OF ELEMENTS
273 POP P,D ;RESTORE NUMBER OF WORDS
274 HRLI C,(AB) ;START BUILDING BLT POINTER
275 HRRI C,(B) ;TO ADDRESS
276 ADDI D,(B)-1 ;SET D TO FINAL ADDRESS
280 ;EXPLICIT VECTORS FOR THE UNIFORM CSE
282 MFUNCTION EUVECTOR,SUBR
285 HLRE A,AB ;-NUM OF ARGS
287 ASH A,-1 ;NEED HALF AS MANY WORDS
290 GETYP A,(AB) ;GET FIRST ARG
291 PUSHJ P,NWORDT ;SEE IF NEEDS EXTRA WORDS
293 MCALL 1,UVECTOR ;GET THE VECTOR
295 GETYP C,(AB) ;GET THE FIRST TYPE
296 MOVE D,AB ;COPY THE ARG POINTER
297 MOVE E,B ;COPY OF RESULT
299 EUVLP: GETYP 0,(D) ;GET A TYPE
301 JRST WRNGUT ;NO , LOSE
302 MOVE 0,1(D) ;GET GOODIE
304 ADD D,[2,,2] ;BUMP ARGS POINTER
307 HRLM C,(E) ;CLOBBER UNIFORM TYPE IN
310 WRNGUT: PUSH TP,$TATOM
311 PUSH TP,MQUOTE TYPES-DIFFER-IN-UNIFORM-VECTOR
314 CANTUN: PUSH TP,$TATOM
315 PUSH TP,MQUOTE DATA-CANT-GO-IN-UNIFORM-VECTOR
319 ; FUNCTION TO GROW A VECTOR
325 MOVEI D,0 ;STACK HACKING FLAG
326 HLRZ A,(AB) ;FIRST TYPE
327 PUSHJ P,SAT ;GET STORAGE TYPE
328 HLRZ B,2(AB) ;2ND ARG
329 CAIE A,STPSTK ;IS IT ASTACK
331 AOJA D,GRSTCK ;YES, WIN
332 CAIE A,SNWORD ;UNIFORM VECTOR
333 CAIN A,S2NWORD ;OR GENERAL
334 GRSTCK: CAIE B,TFIX ;IS 2ND FIXED
335 JRST WRONGT ;COMPLAIN
340 MOVEI E,1 ;UNIFORM/GENERAL FLAG
341 CAIE A,SNWORD ;SKIP IF UNIFORM
342 CAIN A,SPSTK ;DONT SKIP IF UNIFORM PDL
345 HRRZ B,1(AB) ;POINT TO START
346 HLRE A,1(AB) ;GET -LENGTH
347 SUB B,A ;POINT TO DOPE WORD
348 SKIPE D ;SKIP IF NOT STACK
349 ADDI B,PDLBUF ;FUDGE FOR PDL
350 HLLZS (B) ;ZERO OUT GROWTH SPECS
351 SKIPN A,3(AB) ;ANY TOP GROWTH?
352 JRST GROW1 ;NO, LOOK FOR BOTTOM GROWTH
353 ASH A,(E) ;MULT BY 2 IF GENERAL
354 ADDI A,77 ;ROUND TO NEAREST BLOCK
355 ANDCMI A,77 ;CLEAR LOW ORDER BITS
356 ASH A,9-6 ;DIVIDE BY 100 AND SHIFT TO POSTION
357 TRZE A,400000 ;CONVERT TO SIGN MAGNITUDE
359 TLNE A,-1 ;SKIP IF NOT TOO BIG
361 GROW1: SKIPN C,5(AB) ;CHECK LOW GROWTH
362 JRST GROW4 ;NONE, SKIP
363 ASH C,(E) ;GENRAL FUDGE
365 ANDCMI C,77 ;FUDGE FOR VALUE RETURN
367 ASH C,-6 ;DIVIDE BY 100
368 TRZE C,400 ;CONVERT TO SIGN MAGNITUDE
370 TDNE C,[-1,,777000] ;CHECK FOR OVERFLOW
372 GROW2: HLRZ E,1(B) ;GET TOTAL LENGTH OF VECTOR
373 SUBI E,2 ;FUDGE FOR DOPE WORDS
375 HRLI E,-1(E) ;TO BOTH HALVES
376 ADDI E,(B) ;POINTS TO TOP
378 ADD E,[PDLBUF,,0] ;YES, FUDGE LENGTH
379 SKIPL D,(P) ;SHRINKAGE?
380 JRST GROW3 ;NO, CONTINUE
382 HRLI D,(D) ;TO BOTH HALVES
383 ADD E,D ;POINT TO NEW LOW ADDR
384 GROW3: IORI A,(C) ;OR TOGETHER
385 HRRM A,(B) ;DEPOSIT INTO DOPEWORD
386 PUSH TP,(AB) ;PUSH TYPE
388 SKIPE A ;DON'T GC FOR NOTHING
390 POP P,C ;RESTORE GROWTH
392 POP TP,B ;GET VECTOR POINTER
393 SUB B,C ;POINT TO NEW TOP
397 GTOBIG: PUSH TP,$TATOM
398 PUSH TP,MQUOTE ATTEMPT-TO-GROW-VECTOR-TOO-MUCH
400 GROW4: PUSH P,[0] ;0 BOTTOM GROWTH
403 ; SUBROUTINE TO BUILD CHARACTER STRING GOODIES
405 MFUNCTION STRING,SUBR
409 MOVE B,AB ;COPY ARG POINTER
410 MOVEI C,0 ;INITIALIZE COUNTER
411 PUSH TP,$TAB ;SAVE A COPY
413 JUMPGE B,MAKSTR ;ZERO LENGTH
415 STRIN2: GETYP D,(B) ;GET TYPE CODE
416 CAIN D,TCHRS ;SINGLE CHARACTER?
418 CAIE D,TCHSTR ;OR STRING
421 MOVEM B,(TP) ;SAVE CURRENT POINTER
424 PUSH P,C ;SAVE CURRENT COUNT
425 MCALL 1,LENGTH ;FIND THE LENGTH
427 ADDI C,(B) ;BUMP COUNT
433 ; NOW GET THE NECESSARY VECTOR
435 MAKSTR: PUSH TP,$TFIX
436 ADDI C,4 ;COMPUTE NEEDED WORDS
439 MCALL 1,UVECTOR ;GET THE VECTOR
441 HRLI B,440700 ;CONVERT B TO A BYTE POINTER
442 SKIPL C,AB ;ANY ARGS?
445 NXTRG1: GETYP D,(C) ;GET AN ARG
448 LDB D,[350700,,1(C)] ;GET IT
449 IDPB D,B ;AND DEPOSIT IT
452 TRYSTR: MOVE E,1(C) ;GET BYTER
453 HRRZ 0,(C) ;AND DOPE WORD POINTER
454 LDB D,E ;GET 1ST CHAR
455 NXTCHR: CAIG 0,1(E) ;STILL WINNING?
456 JRST NXTARG ;NO, GET NEXT ARG
457 JUMPE D,NXTARG ;HIT 0, QUIT
459 ILDB D,E ;AND GET NEXT
462 NXTARG: ADD C,[2,,2] ;BUMP ARG POINTER
467 HLLM C,(B) ;AND CLOBBER AWAY
468 HLRZ C,1(B) ;GET LENGTH BACK
469 MOVEI A,1(B) ;POINT TO DOPE WORD
472 HRLI B,350700 ;MAKE A BYTE POINTER
476 ;SET FLAG FOR INTERRUPT HANDLER
481 IRP AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,TVP,PP,PVP]
482 MOVEM AC,AC!STO"+1(PVP)
485 ;SET UP E TO POINT TO TYPE VECTOR
489 HRRZ TYPNT,TYPVEC+1(TVP)
492 ;DECIDE WHETHER TO SWITCH TO GC PDL
494 MOVEI A,(P) ;POINNT TO PDL
495 HRRZ B,GCPDL ;POINT TO BASE OF GC PDL
496 CAIG A,(B) ;SKIP IF MUST CHANGE
498 HLRE C,GCPDL ;-LENGTH OF GC'S PDL
499 SUB B,C ;POINT TO END OF GC'S PDL
500 CAILE A,(B) ;SKIP IF WITHIN GCPDL
501 CHPDL: MOVE P,GCPDL ;GET GC'S PDL
503 ;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK
505 MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS
506 PUSHJ P,FRMUNG ;AND MUNG IT
507 MOVE A,TP ;THEN TEMPORARY PDL
509 MOVE A,PP ;GET PLANNER PDL
510 PUSHJ P,PDLCHK ;AND CHECK IT FOR GROWTH
511 MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK
512 CAMN P,GCPDL ;DID PDLS CHANGE
514 \f;MARK PHASE: MARK ALL LISTS AND VECTORS
515 ;POINTED TO WITH ONE BIT IN SIGN BIT
516 ;START AT TRANSFER VECTOR
518 SETZB LPVP,VECNUM ;CLEAR NUMBER OF VECTOR WORDS
519 SETZM PARNUM ;CLEAR NUMBER OF PAIRS
520 MOVSI D,400000 ;SIGN BIT FOR MARKING
521 MOVE A,ASOVEC+1(TVP) ;MARK ASSOC. VECTOR NOW
523 SUBI A,(B) ;POINT TO DOPE WORD
524 IORM D,1(A) ;AND MARK
525 MOVE A,PVP ;START AT PROCESS VECTOR
526 MOVEI B,TPVP ;IT IS A PROCESS VECTOR
527 PUSHJ P,MARK ;AND MARK THIS VECTOR
529 ; ASSOCIATION FLUSHING PHASE
531 MOVE A,ASOVEC+1(TVP) ;GET POINTER TO VECTOR
532 PUSHJ P,ASOMRK ;MARK AND FLUSH
534 ;OPTIONAL RETIMING PHASE
536 SKIPE A,TIMOUT ;ANY TIME OVERFLOWS
537 PUSHJ P,RETIME ;YES, RE-CALIBRATE THEM
539 ;CORE ADJUSTMENT PHASE
540 SETZM CORSET ;CLEAR LATER CORE SETTING
541 PUSHJ P,CORADJ ;AND MAKE CORE ADJUSTMENTS
543 ;RELOCATION ESTABLISHMENT PHASE
544 ;1 -- IN PAIR SPACE, SWAP LOW GARBAGE WITH HIGHER NON GARBAGE
545 MOVE A,PARBOT" ;ONE POINTER TO BOTTOM OF PAIR SPACE
546 MOVE B,PARTOP" ;AND ANOTHER TO TOP.
547 PUSHJ P,PARREL ;AND ESTABLISH THE PAIR RELOCATION
548 MOVEM B,PARTOP ;ESTABLISH NEW TOP OF PAIRS HERE
550 ;2 -- IN VECTOR SPACE, ESTABLISH POINTERS TO TOP OF CORE
551 MOVE A,VECTOP" ;START AT TOP OF VECTOR SPACE
552 MOVE B,VECNEW" ;AND SET TO INITIAL OFFSET
553 SUBI A,1 ;POINT TO DOPE WORDS
554 PUSHJ P,VECREL ;AND ESTABLISH RELOCATION FOR VECTORS
555 MOVEM B,VECNEW ;SAVE FINAL OFFSET
557 \f;POINTER UPDATE PHASE
558 ;1 -- UPDATE ALL PAIR POINTERS
559 MOVE A,PARBOT ;START AT BOTTOM OF PAIR SPACE
560 PUSHJ P,PARUPD ;AND UPDATE ALL PAIR POINTERS
562 ;2 -- UPDATE ALL VECTORS
563 MOVE A,VECTOP ;START AT TOP OF VECTOR SPACE
564 PUSHJ P,VECUPD ;AND UPDATE THE POINTERS
566 ;3 -- UPDATE THE PVP AC
567 MOVEI A,PVP-1 ;SET LOC TO POINT TO PVP
568 MOVE C,PVP ;GET THE DATUM
569 PUSHJ P,NWRDUP ;AND UPDATE THIS VALUE
570 ;4 -- UPDATE THE MAIN PROCESS POINTER
571 MOVEI A,MAINPR-1 ;POINT TO MAIN PROCESS POINTER
572 MOVE C,MAINPR ;GET CONTENTS IN C
573 PUSHJ P,NWRDUP ;AND UPDATE IT
574 ;DATA MOVEMMENT ANDCLEANUP PHASE
576 ;1 -- ADJUST FOR SHRINKING VECTORS
577 MOVE A,VECTOP ;VECTOR SHRINKING PHASE
578 PUSHJ P,VECSH ;GO SHRINK ANY SHRINKERS
580 ;2 -- MOVE VECTORS (AND LIST ELEMENTS)
581 MOVE A,VECTOP ;START AT TOP OF VECTOR SPACE
582 PUSHJ P,VECMOVE ;AND MOVE THE VECTORS
583 MOVE A,VECNEW ;GET FINAL CHANGE TO VECBOT
584 ADDM A,VECBOT ;OFFSET VECBOT TO ITS NEW PLACE
585 MOVE A,CORTOP ;GET NEW VALUE FOR TOP OF VECTOR SPACE
586 MOVEM A,VECTOP ;AND UPDATE VECTOP
588 ;3 -- CLEANUP VECTORS (NOTE A CONTAINS NEW VECTOP)
592 ;GARBAGE ZEROING PHASE
593 GARZER: MOVE A,PARTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE
594 HRLS A ;GET FIRST ADDRESS IN LEFT HALF
595 MOVE B,VECBOT ;LAST ADDRESS OF GARBAGE + 1
596 CLEARM (A) ;ZERO THE FIRST WORD
597 ADDI A,1 ;MAKE A A BLT POINTER
598 BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA
600 ;FINAL CORE ADJUSTMENT
601 SKIPE A,CORSET ;IFLESS CORE NEEDED
602 PUSHJ P,CORADL ;GIVE SOME AWAY.
604 ;NOW REHASH THE ASSOCIATIONS BASED ON NEW VALUES
609 IRP AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,PP,PVP,TVP]
610 MOVE AC,AC!STO+1(PVP)
613 SETZM PARNEW ;CLEAR FOR NEXT AGC CALL
614 SETZM GETNUM ;ALSO CLEAR THIS
621 AGCE1: MOVEI B,[ASCIZ /TYPVEC IS NOT OF TYPE VECTOR
623 TYPSTP: PUSHJ P,MSGTYP" ;TYPE OUT A HOPELESSMESSAGE
628 ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
630 PDLCHK: JUMPGE A,CPOPJ
631 HLRE B,A ;GET NEGATIVE COUNT
632 MOVE C,A ;SAVE A COPY OF PDL POINTER
633 SUBI A,-1(B) ;LOCATE DOPE WORD PAIR
634 HRRZS A ; ISOLATE POINTER
635 CAME A,TPGROW ;GROWING?
636 CAMN A,PPGROW ;OR PLANNER PDL
638 ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD
639 HLRZ D,(A) ;GET COUNT FROM DOPE WORD
640 MOVNS B ;GET POSITIVE AMOUNT LEFT
641 SUBI D,2(B) ; PDL FULL?
642 JUMPE D,NOFENC ;YES NO FENCE POSTING
643 SETOM 1(C) ;CLOBBER TOP WORD
644 SOJE D,NOFENC ;STILL MORE?
645 MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS
647 BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS
650 NOFENC: CAIG B,TPMAX ;NOW CHECK SIZE
652 JRST MUNGTP ;TOO BIG OR TOO SMALL
655 MUNGTP: SUBI B,TPGOOD ;FIND DELTA TP
656 MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED
657 TRNE C,777000 ;SKIP IF NOT
658 POPJ P, ;ASSUME GROWTH GIVEN WILL WIN
660 ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS
662 TRO B,400 ;TURN ON SHRINK BIT
666 MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD
669 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)
671 PDLCHP: HLRE B,A ;-LENGTH TO B
672 SUBI A,-1(B) ;POINT TO DOPE WORD
673 HRRZS A ;ISOLATE POINTER
674 CAME A,PGROW ;GROWING?
675 ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD
678 CAIG B,PMAX ;TOO BIG?
679 CAIG B,PMIN ;OR TOO LITTLE
680 JRST .+2 ;YES, MUNG IT
685 ;THIS ROUTINE CLOBBERS USELESS STUFF IN CURRENT FRAME
687 FRMUNG: SETZM PCSAV(A)
691 MOVEM TP,TPSAV(A) ;SAVE FOR MARKING
694 ;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS
695 ; A/ GOODIE TO MARK FROM
696 ; B/ TYPE OF A (IN RH)
697 ; C/ TYPE,DATUM PAIR POINTER
699 MARK2: HLRZ B,(C) ;GET TYPE
700 MARK1: MOVE A,1(C) ;GET GOODIE
701 MARK: JUMPE A,CPOPJ ; NEVER MARK 0
702 PUSH P,A ;SAVE GOODIE
703 HRLM C,-1(P) ;AND POINTER TO IT
704 LSH B,1 ;TIMES 2 TO GET SAT
705 HRRZ B,@TYPNT ;GET SAT
706 JRST @MKTBS(B) ;AND GO MARK
708 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
710 DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK]
711 [STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK]
712 [SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK]
713 [SLOCID,<SETZ LOCMK>],[SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK]]
716 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER
718 DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG
720 ;HERE TO MARK LIST ELEMENTS
722 PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT
723 MOVEI C,(A) ;POINT TO LIST
724 PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS
726 JRST BDPAIR ;OUT OF BOUNDS,COMPLAIN
727 SKIPGE B,(C) ;SKIP IF NOT MARKED
728 JRST GCRET ;ALREADY MARKED, RETURN
731 HLRZS B ;TYPE TO RH OF B
732 MOVE A,1(C) ;DATUM TO A
733 JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER
734 PUSHJ P,MARK ;MARK THIS DATUM
735 HRRZ C,(C) ;GET CDR OF LIST
736 JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT
738 GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT
739 HLRZ C,-1(P) ;RESTORE C
741 POPJ P, ;AND RETURN TO CALLER
743 ;HERE TO SQUAWK WHEN A PAIR POINTER IS BAD
745 BDPAIR: MOVEI B,[ASCIZ /AGC -- MARKED PAIR POINTS OUTSIDE PAIR SPACE
751 ;HERE TO MARK DEFERRED POINTER
753 DEFDO: PUSHJ P,MARK ;MARK THE DATUM
754 JRST GCRET ;AND RETURN
757 ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
759 TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG
760 VECTMK: TLZ TYPNT,400000
761 MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR
763 SUB A,B ;LOCATE DOPE WORD
764 MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD
765 CAMGE A,VECTOP ;CHECK BOUNDS
767 JRST VECTB1 ;LOSE, COMPLAIN
769 JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK
770 CAMN A,PPGROW ;CHECK PLANNER PDL
772 CAME A,PGROW ;IS THIS THE BLOWN P
773 CAMN A,TPGROW ;IS THIS THE GROWING PDL
774 JRST NOBUFR ;YES, DONT ADD BUFFER
775 ADDI A,PDLBUF ;POINT TO REAL DOPE WORD
776 MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER
779 NOBUFR: HLRZ B,(A) ;GET LENGTH FROM DOPE WORD
780 ANDI B,377777 ;CLOBBER POSSIBLE MARK BIT
781 MOVEI F,(A) ;SAVE A POINTER TO DOPE WORD
782 SUBI F,1(B) ;F POINTS TO START OF VECTOR
783 HRRZ 0,-1(A) ;SEE IF GROWTH SPECIFIED
784 JUMPE 0,NOCHNG ;NONE, JUST CHECK CURRENT SIZES
786 LDB B,[001100,,0] ;GET GROWTH FACTOR
787 TRZE B,400 ;KILL SIGN BIT AND SKIP IF +
789 ASH B,6 ;CONVERT TO NUMBER OF WORDS
790 SUB F,B ;BOTTOM IS LOWER IN CORE
791 LDB 0,[111100,,0] ;GET TOP GROWTH
792 TRZE 0,400 ;HACK SIGN BIT
794 ASH 0,6 ;CONVERT TO WORDS
795 ADD B,0 ;TOTAL GROWTH TO B
796 ADD A,0 ;DOPE WORD IS HIGHER
797 NOCHNG: SKIPGE TYPNT ;IS THIS A PDL?
798 SUBI F,1 ;YES, POINTER MAY POINT OUTSIDE
800 CAIG E,(A) ;IS E IN BOUNDS?
802 JRST VECLOS ;NO, CLOBBER POINTER TO IT
804 VECOK: SUB A,0 ;A POINTS TO DOPW WORD AGAIN
805 HLRE E,(A) ;GET LENGTH AND MARKING
806 MOVEI F,(E) ;SAVE A COPY
808 SUBI E,2 ;- DOPE WORD LENGTH
809 IORM D,(A) ;MAKE SURE NOW MARKED
810 JUMPLE E,GCRET ;ALREADY MARKED OR ZERO LENGTH, LEAVE
812 SKIPGE B,-1(A) ;SKIP IF UNIFORM
813 TLNE B,377777 ;SKIP IF NOT SPECIAL
814 JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR
816 GENRAL: HLRZ 0,B ;CHECK FOR PSTACK
817 JUMPE 0,NOTGEN ;IT ISN'T GENERAL
818 SUBI A,1(E) ;POINT TO FIRST ELEMENT
819 ADDM F,VECNUM ;AND UPDATE VECNUM
820 MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C
822 ; LOOP TO MARK ELEMENTS IN A GENRAL VECTOR
824 VECTM2: HLRE B,(C) ;GET TYPE AND MARKING
825 JUMPL B,GCRET ;RETURN, (EITHER DOPE WORD OR FENCE POST)
826 MOVE A,1(C) ;DATUM TO A
827 CAIN B,TENTRY ;IS THIS A STACK FRAME
828 JRST MFRAME ;YES, MARK IT
829 CAIN B,TBIND ;OR A BINDING BLOCK
832 VECTM3: PUSHJ P,MARK ;MARK DATUM
836 MFRAME: HRROI C,FRAMLN+SPSAV-1(C) ;POINT TO SAVED SP
838 PUSHJ P,MARK1 ;MARK THE GOODIE
839 HRROI C,PSAV-SPSAV(C) ;POINT TO SAVED P
841 PUSHJ P,MARK1 ;AND MARK IT
842 HRROI C,TPSAV-PSAV(C) ;POINT TO SAVED TP
844 PUSHJ P,MARK1 ;MARK IT ALS
845 MOVEI C,PPSAV-TPSAV(C) ;POINT SAVED PP
848 MOVEI C,-PPSAV+1(C) ;POINT PAST THE FRAME
849 JRST VECTM2 ;AND DO MORE MARKING
852 MBIND: MOVEI B,TATOM ;FIRST MARK ATOM
855 VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE
857 MOVEI B,TILLEG ;GET ILLEGAL TYPE
859 MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE
860 JRST GCRET ;RETURN WITHOUT MARKING VECTOR
862 CCRET: CLEARM 1(C) ;CLOBBER THE DATUM
865 ; SUBROUTINE TO CHECK THE TIME FOR LOCIDS,ARGS AND FRAMES
866 ; A/ POINT TO FRAME C/GOODIE B/ITS TIME
868 TIMECH: HLRZ 0,OTBSAV(A) ;GET THE FRAMES TIME
871 SUB P,[1,,1] ;NO, REMOVE RETLOC
873 TIMLOS: HLLZ 0,(C) ;GET OLD TYPE
874 MOVSI B,TILLEG ;ILLEGAL TYPE
875 MOVEM B,(C) ;AND STORE IT
876 MOVEM 0,1(C) ;USE OLD TYPE AS DATUM
877 JRST GCRET ;AND STOP MARKING FROM THE LOSER
879 ; MARK ARG POINTERS (SABASE AND SARGS)
881 ARGMK: HLRE B,A ;-LENGTH TO B
882 SUBI A,(B) ;POINT TO FRAME OR FRAME POINTER
884 CAIE E,TENTRY ;IS TJHIS A FRAME
885 JRST ARGMK2 ;NO, CHECK OTHER
886 MOVEI A,FRAMLN(A) ;POINT ABOVE FRAME
887 ARGMK3: HRRZ B,(C) ;GET TIME
892 ARGMK2: CAIE E,TTB ;BASE POINTER?
894 HRRZ A,1(A) ;POINT TO FRAME
895 JRST ARGMK3 ;AND MARK IT AS SUCH
897 ; MARK FRAME POINTERS
899 FRMK: HLRZ B,A ;GET TIME IN B
900 PUSHJ P,TIMECH ;CHECK ITS TIME
901 SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR
902 HRRZ A,1(C) ;USE AS DATUM
903 SUBI A,1 ;FUDGE FOR VECTMK
904 MOVEI B,TPVP ;IT IS A VECTRO
905 PUSHJ P,MARK ;MARK IT
910 BYTMK: HRRZ A,(C) ;POINT TO DOPE WD
911 SOJG A,VECTMK ;FUDGE DOPE WORD POINTER FOR VECTMK
914 MOVEI B,[ASCIZ /AGC -- BYTE POINTER WITH ZERO DOPE WORD POINTER
922 ATOMK: PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS
925 MOVE A,1(C) ;AND VALUE
926 ;******FUDGE UNTIL MIRE WINNAGE******
928 HRRZ E,(C) ;GOBBLE PROCESS ID
929 CAIN B,TUNBOUND ;IF NOT UNBOUND
930 JRST GCRET ;IS UNVOUND, IGNORE
931 SKIPN E ;SKIP IF NOT GLOBAL PROCESS
932 MOVEI B,TVEC ;IS GLOBAL, MARK AS A VECTOR
933 PUSHJ P,MARK ;AND MARK IT
934 JRST GCRET ;AND LEAVE
936 GETLNT: HLRE B,A ;GET -LNTH
937 SUB A,B ;POINT TO 1ST DOPE WORD
938 MOVEI A,1(A) ;POINT TO 2ND DOPE WORD
939 CAMGE A,VECTOP ;CHECK BOUNDS
941 JRST VECTB1 ;BAD VECTOR, COMPLAIN
943 HLRE B,(A) ;GET LENGTH AND MARKING
944 IORM D,(A) ;MAKE SURE MARKED
945 JUMPL B,GCRET1 ;MARKED ALREADY, QUIT
946 SUBI A,-1(B) ;POINT TO TOP OF ATOM
947 ADDM B,VECNUM ;UPDATE VECNUM
950 GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS
953 ; MARK NON-GENERAL VECTORS
955 NOTGEN: CAMN B,[GENERAL+<SPVP,,0>] ;PROCESS VECTOR?
956 JRST GENRAL ;YES, MARK AS A VECTOR
957 JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK
958 SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR
959 ADDM F,VECNUM ;INCREASE VECNUM
960 HLRZS B ;ISOLATE TYPE
961 MOVE F,B ; AND COPY IT
962 LSH B,1 ;FIND OUT WHERE IT WILL GO
963 HRRZ B,@TYPNT ;GET SAT IN B
964 MOVEI C,@MKTBS(B) ;POINT TO MARK SR
965 CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE
967 MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START
968 PUSH P,E ;SAVE NUMBER OF ELEMENTS
969 PUSH P,F ;AND UNIFORM TYPE
971 UNLOOP: MOVE B,(P) ;GET TYPE
972 MOVE A,1(C) ;AND GOODIE
973 TLO C,400000 ;CAN'T MUNG TYPE
974 PUSHJ P,MARK ;MARK THIS ONE
976 AOJA C,UNLOOP ;IF MORE, DO NEXT
978 SUB P,[2,,2] ;REMOVE STACK CRAP
982 SPECLS: MOVEI B,[ASCIZ /AGC -- UNRECOGNIZED SPECIAL VECTOR
987 ;MARK LOCID TYPE GOODIES
989 LOCMK: HRRZ B,(C) ;GET TIME
990 JUMPE B,GLBSP ;IF TIME IS 0, THIS IS THE GLOBAL SP
991 HRRZ 0,2(A) ;GET TIME
993 JRST TIMLOS ;NO, LOSE
994 MOVE A,3(A) ;GOBBLE SP POINTER
998 GLBSP: MOVE A,1(C) ;MARK LIKE A VECTOR
1002 ; MARK ASSOCIATION BLOCKS
1004 ASMRK: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER
1005 PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS
1006 GETYP B,(A) ;CHECK TYPE OF FIRST
1008 JRST GCRET ;THIS IS THE DUMMY
1009 MOVEI C,(A) ;COPY POINTER
1010 PUSHJ P,MARK2 ;MARK ITEM CELL
1011 ADDI C,INDIC-ITEM ;POINT TO INDICATOR
1015 ADDI C,NODPNT-VAL-1 ;POINT TO NODE CHAIN
1016 HRRZ A,1(C) ;DOES IT EXIST
1019 PUSHJ P,MARK ;AND MARK IT
1022 \f;HERE WHEN A VECTOR POINTER IS BAD
1024 VECTB1: MOVEI B,[ASCIZ /AGC -- VECTOR POINTS OUTSIDE VECTOR SPACE
1031 ; THIS PHASE REMOVES ANY UNWANTED ASSOCIATIONS ALSO PRESERVES DATA POINTED TO ONLY BY ASSOCIATIONS
1032 ; RECEIVES POINTER TO ASSOCIATION VECTOR IN A
1034 ASOMRK: SKIPN C,(A) ;DOES BUCKET CONTAIN ANYTHING
1035 JRST ASOM3 ;NO, ;IGNORE
1037 ASOM2: HRRE 0,ASOLNT+1(C) ;CHECK FOR CIRCULARITY
1038 AOJE 0,ASOM6 ;ALREADY MARKED, LOSE
1041 SKIPGE ASOLNT+1(C) ;IS THIS ONE POINTED AT?
1042 JRST ASOM4 ;YES, GOODIES ALREADY MARKED
1043 PUSHJ P,MARKQ ;SEE IF ITS ITEM IS MARKED
1044 JRST ASOFLS ;NO, FLUSH THIS ASSOCIATION
1045 MOVEI E,MARKQ ;POINT TO QUESTIONER
1046 SKIPE NODPNT(C) ;SKIP IF NOT ON A CHAIN
1047 MOVEI E,MARK23 ;ON CHAIN, MARK THE INDICATOR
1048 MOVEI C,INDIC(C) ;POINT TO INDICATOR
1050 JRST ASOFL7 ;INDICATOR NOT MARKED
1051 MOVEI C,-INDIC(C) ;POINT BACK TO START
1053 ASOM1: PUSH P,C ;ITEM IS MARKED, MARK INDIC AND VAL AND ASSOC
1055 ADDI C,VAL ;POINT TO VAL
1057 IORM D,ASOLNT+1-VAL(C) ;MARK THE ASSOCIATION BLOCK
1061 ASOM4: MOVEI E,(C) ;INCASE NEED TO FLUSH CIRCULARITY
1062 HRRZ C,ASOLNT-1(C) ;POINT TO NEXT IN CHAIN
1063 JUMPN C,ASOM2 ;GO MARKK IT
1066 ASOM3: AOBJN A,ASOMRK ;GO ONTO NEXT BUCKET
1067 POPJ P, ;ALL MARKED, QUIT
1069 ;HERE TO FLUSH AN ASSOCIATION
1071 ASOFLS: HRRZ B,ASOLNT-1(C) ;GET FORWARD AND BACKWARD POINTERS
1073 JUMPN E,ASOFL1 ;JUMP IF PREV EXISTS
1074 HRRZM B,(A) ;CLOBBER VECTOR ENTRY
1077 ASOFL1: HRRM B,ASOLNT-1(E) ;CLOBBER PREVIOUS BLOCKKS NEXT
1078 JUMPE B,ASOM4 ;IF NEXT IS 0, DONE
1079 HRLM E,ASOLNT-1(B) ;ELSE CLOBBER NEXT'S PREVIOUS
1082 ASOM6: HLLZS (E) ;FORCE CIRCULARITY AWAY
1083 HRRZS (C) ;AND THE OTHERS PREV
1084 JRST ASOM3 ;AND FINISH THIS BUCKET
1087 PUSHJ P,MARK2 ;MARK IT
1091 ASOFL7: MOVEI C,ITEM-INDIC(C) ;RESET C
1092 JRST ASOFLS ;AND FLUSH
1094 ;SUBROUTINE TO SEE IF A GOODIE IS MARKED
1095 ;RECEIVES POINTER IN C
1096 ;SKIPS IF MARKED NOT OTHERWISE
1098 MARKQ: MOVE E,1(C) ;DATUM TO C
1099 HLRZ B,(C) ;TYPE TO B
1101 HRRZ B,@TYPNT ;GOBBLE SAT
1102 JRST @MQTBS(B) ;DISPATCH
1105 DISTBS MQTBS,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
1106 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SBYTE,BYTMK]
1107 [SATOM,VECMQ],[SPVP,VECMQ],[SLOCID,VECMQ],[SCHSTR,BYTMQ]]
1109 PAIRMQ: SKIPGE (E) ;SKIP IF NOT MARKED
1113 BYTMQ: HRRZ E,(C) ;GET DOPE WORD POINTER
1114 SOJA E,VECMQ1 ;TREAT LIKE VECTOR
1116 ARGMQ: HLRE F,E ;CHECK AM ARG POINTER
1117 SUB E,F ;POINT TO END OF ARG BLOCK
1118 HLRZ B,(E) ;GET TYPE
1119 CAIN B,TENTRY ;IS IT AN ENTRY
1120 MOVEI E,FRAMLN+1(E) ;MAKE INTO FRAME POINTER
1121 CAIN B,TTB ;IS IT A FRAME POINTER
1122 HRRZ E,1(E) ;PICK IT UP
1124 FRMQ: MOVE E,TPSAV(E) ;PICK UP A STACK POINTER
1126 VECMQ: HLRE F,E ;GET LENGTH
1127 SUB E,F ;POINT TO DOPE WORDS
1129 VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED
1130 AOS (P) ;MARKED, CAUSE SKIP RETURN
1137 ;RETIME PHASE -- CALLED IFF A FRAME TIME HAS OVERFLOWED
1138 ;RECEIVES POINTER TO STACK TO BE RECALIBRATED IN A
1139 ;LEAVES HIGHEST TIME IN TIMOUT
1141 RETIME: HLRE B,A ;GET LENGTH IN B
1142 SUB A,B ;COMPUTE DOPE WORD LOCATION
1143 MOVEI A,1(A) ;POINT TO 2D DOPE WORD AND CLEAR LH
1144 CAME A,TPGROW ;IS THIS ONE BLOWN?
1145 ADDI A,PDLBUF ;NO, POINT TO DOPE WORD
1146 LDB B,[222100,,(A)] ;GET LENGTH FIELD (IGNOREING MARK BIT
1147 SUBI A,-1(B) ;POINT TO PDLS BASE
1148 MOVEI C,1 ;INITIALIZE NEW TIMES
1150 RETIM1: SKIPGE B,(A) ;IF <0, HIT DOPE WORD OR FENCE POST
1152 HLRZS B ;ISOLATE TYPE
1153 CAIE B,TENTRY ;FRAME START?
1154 AOJA A,RETIM2 ;NO, TRY BINDING
1155 HRLM C,FRAMLN+OTBSAV(A) ;STORE NEW TIME
1156 ADDI A,FRAMLN ;POINT TO NEXT ELEMENT
1157 AOJA C,RETIM1 ;BUMP TIME AND MOVE ON
1159 RETIM2: CAIN B,TBIND ;BINDING?
1160 HRRM C,3(A) ;YES, STORE CURRENT TIME
1161 AOJA A,RETIM1 ;AND GO ON
1163 RETIM3: MOVEM C,TIMOUT ;SAVE TIME
1166 \f;CORE ADJUSTMENT PHASE -- SETS TOP OF CORE
1167 ;AND TOP OF VECTOR SPACE TO SIZE NEEDED FOR SUFFICIENT FREE SPACE TO BE ADDED TO
1168 ;ALLOW FOR "EFFICIENT" PROCESSING
1170 CORADJ: .SUSET [.RMEMT,,CORTOP] ;SET CORTOP FROM SYSTEM
1171 MOVE A,PARBOT ;GET ADDRESS OF BOTTOM OF MOVABLE CORE
1172 ADD A,PARNEW ;AND ADDJUST TO WHERE IT WILL BE
1173 ADD A,PARNUM ;ADD NUMBER OF PAIRS
1174 ADD A,PARNUM ;TWICE TO GET TOP OF PAIR SPACE.
1175 ADD A,VECNUM ;ADD NUMBER OF VECTOR WORDS
1176 ADD A,GETNUM ;AND NUMBER OF WORDS TO BE GOTTEN THIS TIME
1177 ADD A,FREMIN ;AND NUMBER OF FREE WORDS MINIMUM
1178 SUB A,CORTOP ;LESS CURRENT TOP OF CORE
1179 JUMPG A,CORAD2 ;IF GREATER THAN ZERO, MORE CORE NEEDED
1180 ADD A,FREDIF ;ADD IN DIFFERENCE BETWEEEN FREE AND GOT
1181 ADDI A,1777 ;ROUND UP TO NEXT BLOCK
1182 ANDCMI A,1777 ;AND DOWN TO A BLOCK BOUNDARY
1183 JUMPGE A,CORAD1 ;IF POSITIVE, NO CORE ADJUSTMENT NEEDED
1184 ADDB A,CORTOP ;CALCULATE NEG TOP OF CORE
1185 ASH A,-10. ;CONVERT TO BLOCKS
1186 MOVEM A,CORSET ;AND SET NUMBER OF BLOCKS
1187 CORAD1: MOVE A,CORTOP ;CALCU;ATE NEW TOP OF CORE
1188 SUB A,VECTOP ;FIND OFFSET FROM CURRENT VECTOR TOP
1189 MOVEM A,VECNEW ;AND SAVE AS NEW HOME OF VECTORS
1192 \f;HERE IF MORE CORE NEEDED, NO OF WDS IN A
1194 CORAD2: ADD A,CORTOP ;FIND TOP OF CORE
1195 ADDI A,1777 ;AND ROUND UPWARDS
1196 ASH A,-10. ;AND CONVERT TO NUMBER OF BLOCKS
1197 CAMLE A,SYSMAX ;COMPARE TO MAXIMUM ALLOWED
1199 .CORE (A) ;ASK OFR THE NEW SIZE
1200 PUSHJ P,CORAD4 ;FAILURE, GO COMPLAIN
1201 JRST CORADJ ;OK TRY AGAIN
1204 CORAD3: SKIPA B,[[ASCIZ /ATTEMPT TO EXPAND PAST MUDDLE LIMIT/]]
1205 CORAD4: MOVEI B,[ASCIZ /NO CORE AVAILABLE/]
1206 PUSH P,A ;SAVE AMOUNT ASKED FOR
1208 MOVEI B,[ASCIZ /PROCEED?/]
1214 POP P,A ;RESTORE AMOUNT
1215 POPJ P, ;AND GO BACK
1218 CORADL: .CORE (A) ;SET TO NEW CORE VALUE
1222 ;PARREL -- PAIR RELOCATION ESTABLISMENT
1223 ;ESTABLISH PAIR RELOCATION. CALLED WITH
1224 ;BOTTOM IN AC A, AND TOP IN AC B.
1226 PARRE0: SUBI B,2 ;MOVE POINTER BACK
1227 IORM D,(B) ;MARK THIS PAIR AS JUNK
1228 PARREL: CAIG B,(A) ;HAVE THE POINTERS MET?
1229 POPJ P, ;YES -- RETURN WITH NEW PARTOP IN B
1230 SKIPL C,-2(B) ;MARKED PAIR ON BOTTOM?
1231 JRST PARRE0 ;NO -- MOVE TOWARD BOTTOM
1232 PARRE1: SKIPGE (A) ;JUNK ON BOTTOM?
1233 JRST PARRE2 ;NO -- MOVE FORWARD
1234 MOVEM C,(A) ;STORE PAIR IN NEW LOCATION
1235 MOVE C,-1(B) ;GET DATUM
1236 MOVEM C,1(A) ;AND STORE IN NEW HOME
1237 HRROM A,-2(B) ;SET "BROKEN HEART" TO NEW HOME
1238 JRST PARRE0 ;AND CONTINUE
1239 PARRE2: ANDCAM D,(A) ;UNMARK PAIR
1240 ADDI A,2 ;GO ON TO NEXT PAIR
1241 CAIG B,(A) ;TEST TO SEE IF POINTERS MET
1242 POPJ P, ;YES -- DONE
1243 JRST PARRE1 ;KEEP LOOKING FORWARD
1245 \f;VECTOR RELOCATE --GETS VECTOP IN A
1247 ;FILLS IN RELOCATION FIELDS OF MARKED VECTORS
1248 ;AND REUTRNS FINAL VECNEW IN B
1250 VECREL: CAMG A,VECBOT ;PROCESSED TO BOTTOM OF VECTOR SPACE?
1251 POPJ P, ;YES, RETURN
1252 HLRE C,(A) ;GET COUNT FROM DOPE WD, EXTEND MARK BIT
1253 JUMPL C,VECRE1 ;IF MARKED GO PROCESS
1254 HLLZS (A) ;CLEAR RELOC FIELD
1255 ADDI B,(C) ;INCREMENT OFFSET
1256 SUBI A,(C) ;MOVE ON TO NEXT VECTOR
1257 SOJG C,VECREL ;AND KEEP SCANNING
1258 JSP D,VCMLOS ;LOSER, LEAVE TRACKS AS TO WHO LOST
1260 VECRE1: HRRZ E,-1(A) ;GOBBLE THE GROWTH FILEDS
1261 HRRM B,(A) ;STORE RELOCATION
1262 JUMPE E,VECRE2 ;NO GROWTH (OR SHRINKAGE), GO AWAY
1263 LDB F,[111100,,E] ;GET TOP GROWTH IN F
1264 TRZN F,400 ;CHECK AND FLUSH SIGN
1265 MOVNS F ;WAS ON, NEGATE
1266 ASH F,6 ;CONVERT TO WORDS
1267 ADD B,F ;UPDATE RELOCATION
1268 HRRM B,(A) ;AND STORE IT
1269 ANDI E,777 ;ISOLATE BOTTOM GROWTH
1270 TRZN E,400 ;CHECK AND CLEAR SIGN
1272 ASH E,6 ;CONVERT TO WORDS
1273 ADD B,E ;UPDATE FUTURE RELOCATIONS
1274 VECRE2: SUBI A,400000(C) ;AND MOVE ON TO NEXT VECTOR
1275 ANDI C,377777 ;KILL MARK
1276 SOJG C,VECREL ;AND KEEP GOING
1277 JSP D,VCMLOS ;LOSES, LEAVE TRACKS
1281 ;GETS PARBOT IN AC A
1282 ;UPDATES VALUES AND CDRS UP TO PARTOP
1284 PARUPD: CAML A,PARTOP ;ARE THERE MORE PAIRS TO PROCESS
1285 POPJ P, ;NO -- RETURN
1286 HRRZ C,(A) ;GET CURRENT CDR
1287 HLRZ B,(A) ;GET TYPE
1289 HRRZ B,@TYPNT ;NOW GET SAT
1290 SKIPGE MKTBS(B) ;SKIP IF IT HAS A CDR
1291 JRST PARUP1 ;NO CDR, DON'T UPDATE IT
1292 JUMPE C,PARUP1 ;IF NIL, DON'T UPDATE
1293 SKIPGE B,(C) ;GET POINTER UPDATE AND SKIP IF THIS IS NOT A BROKEN HEART
1294 HRRM B,(A) ;IT WAS, STORE NEW POINTER
1295 SKIPE B,PARNEW ;IF LIST SPACE IS MOVING,
1296 ADDM B,(A) ;THEN ADD OFFSET TO CDR
1299 PARUP1: HLRZ B,(A) ;SET RH OF B TO TYPE
1300 MOVE C,1(A) ;SET C TO VALUE
1301 PUSHJ P,VALUPD ;UPDATE THIS VALUE
1302 ADDI A,2 ;MOVE ON TO NEXT PAIR
1303 JRST PARUPD ;AND CONTINUE
1305 \f;VECTOR SPACE UPDATE
1307 ;UPDATES ALL VALUE CELLS IN MARKED VECTORS
1308 ;ESCAPES WHEN IT GETS TO VECBOT
1310 VECUPD: SUBI A,1 ;MAKE A POINT TO LAST DOPE WD
1311 VECUP1: CAMG A,VECBOT ;ANY MORE VECTORS TO PROCESS?
1312 JRST ENHACK ;PROCESS ALL ENTRY BLOCKS NOW
1313 SKIPGE B,(A) ;IS DOPE WORD MARKED?
1314 JRST VECUP2 ;YES -- GO PROCESS VALUES IN THIS VECTOR
1315 HLLZS -1(A) ;MAKE SURE NO GROWTH ATTEMPTS
1316 HLRZS B ;NO -- SET RH OF B TO SIZE OF VECTOR
1317 VECUP5: SUB A,B ;SET A TO POINT TO DOPE WD OF NEXT VECTOR
1318 JRST VECUP1 ;AND CONTINUE
1320 VECUP2: PUSH P,A ;SAVE DOPE WORD POINTER
1321 HLRZ B,(A) ;GET LENGTH OF THIS VECTOR
1322 VECU11: ANDI B,377777 ;TURN OFF MARK BIT
1323 SKIPGE E,-1(A) ;CHECK FOR UNIFORM OR SPECIAL
1324 TLNE E,377777 ;SKIP IF GENERAL
1325 JRST VECUP6 ;UNIFORM OR SPECIAL, GO DO IT
1326 VECU10: SUB A,B ;SET AC A TO NEXT DOPE WORD
1327 ADDI A,1 ;AND ADVANCE TO FIRST ELEMENT OF THIS VECTOR
1328 VECUP3: HLRZ B,(A) ;GET TYPE
1329 TRNE B,400000 ;IF MARK BIT SET
1330 JRST VECUP4 ;DONE WITH THIS VECTOR
1331 CAIN B,TENTRY ;SPECIAL HACK FOR ENTRY
1333 CAIE B,TBVL ;VECTOR BINDING?
1334 CAIN B,TBIND ;AND BINDING BLOCK
1336 VECU15: MOVE C,1(A) ;GET VALUE
1337 PUSHJ P,VALUPD ;UPDATE THIS VALUE
1338 VECU12: ADDI A,2 ;GO ON TO NEXT VECTOR
1339 JRST VECUP3 ;AND CONTINUE
1341 VECUP4: POP P,A ;SET TO OLD DOPE WORD
1342 ANDCAM D,(A) ;TURN OFF MARK BIT
1343 HLRZ B,(A) ;GET LENGTH
1344 JRST VECUP5 ;GO ON TO NEXT VECTOR
1347 ; ENTRY PART OF THE STACK UPDATER
1349 ENTRUP: ADDI A,FRAMLN-2 ;POINT PAST FRAME
1350 JRST VECU12 ;NOW REJOIN VECTOR UPDATE
1352 ; UPDATE A BINDING BLOCK
1354 BINDUP: HRRZ C,(A) ;POINT TO CHAIN
1355 JUMPE C,NONEXT ;JUMP IF NO NEXT BINDING IN CHAIN
1356 ADD C,@(P) ;ADD RELOCATION OF SELF
1357 HRRM C,(A) ;AND STORE IT BACK
1358 NONEXT: CAIE B,TBIND ;SKIP IF VAR BINDING
1359 JRST VECU14 ;NO, MUST BE A VECTOR BIND
1360 MOVEI B,TATOM ;UPDATE ATOM POINTER
1363 HLRZ B,(A) ;TYPE OF VALUE
1365 ADDI A,2 ;POINT TO LOCATIVE POINTER
1366 HLRZ B,(A) ;GET TYPE
1370 VECU14: MOVEI B,TVEC ;NOW TREAT LIKE A VECTOR
1373 ; NOW SAFE TO UPDATE ALL ENTRY BLOCKS
1375 ENHACK: HRRZ F,TBSTO(LPVP) ;GET POINTER TO TOP FRAME
1376 HLLZS TBSTO(LPVP) ;CLEAR FIELD
1377 JUMPE F,LSTFRM ;FINISHED
1379 ENHCK1: MOVEI A,OTBSAV-1(F) ;POINT PRIOR TO SAVED TB
1380 HRRZ F,1(A) ;POINT TO PRIOR FRAME
1381 MOVEI B,TTB ;MARK SAVED TB
1383 MOVEI B,TAB ;MARK ARG POINTER
1384 PUSHJ P,[AOJA A,VALPD1]
1385 MOVEI B,TSP ;SAVED SP
1386 PUSHJ P,[AOJA A,VALPD1]
1387 MOVEI B,TPDL ;SAVED P STACK
1388 PUSHJ P,[AOJA A,VALPD1]
1389 MOVEI B,TTP ;SAVED TP
1390 PUSHJ P,[AOJA A,VALPD1]
1392 PUSHJ P,[AOJA A,VALPD1] ;MARK THE PP
1393 JUMPN F,ENHCK1 ;MARK NEXT ONE IF IT EXISTS
1395 LSTFRM: HRRZ A,PROCID(LPVP) ;NEXT PROCESS
1396 HLLZS PROCID(LPVP) ;CLOBBER
1398 JUMPN LPVP,ENHACK ;DO NEXT PROCESS
1401 ; UPDATE ELEMENTS IN UNIFROM AND SPECIAL VECTORS
1403 VECUP6: JUMPL E,VECUP7 ;JUMP IF SPECIAL
1404 HLRZS E ;ISOLATE TYPE
1405 EXCH E,B ;TYPE TO B AND LENGTH TO E
1406 SUBI A,(E) ;POINT TO NEXT DOPE WORD
1409 MOVE B,UPDTBS(B) ;FIND WHERE POINTS
1410 CAIN B,CPOPJ ;UNMARKED?
1411 JRST VECUP4 ;YES, GO ON TO NEXT VECTOR
1412 PUSH P,B ;SAVE SR POINTER
1413 SUBI E,2 ;DON'T COUNT DOPE WORDS
1415 VECUP8: SKIPE C,1(A) ;GET GOODIE
1416 PUSHJ P,@(P) ;CALL UPDATE ROUTINE
1418 SOJG E,VECUP8 ;LOOP FOR ALL ELEMNTS
1420 SUB P,[1,,1] ;REMOVE RANDOMNESS
1423 ; SPECIAL VECTOR UPDATE
1425 VECUP7: HLRZS E ;ISOLATE SPECIAL TYPE
1426 CAIN E,SATOM+400000 ;ATOM?
1427 JRST ATOMUP ;YES, GO DO IT
1428 CAIN E,STPSTK+400000 ;STACK
1429 JRST VECU10 ;TREAT LIKE A VECTOR
1430 CAIN E,SPVP+400000 ;PROCESS VECTOR
1431 JRST PVPUP ;DO SPECIAL STUFF
1433 JRST ASOUP ;UPDATE ASSOCIATION BLOCK
1435 MOVEI B,[ASCIZ /VECTOR UPDATE, ENCOUNTERED FUNNY SPECIAL VECTOR
1440 ; UPDATE ATOM VALUE CELLS
1442 ATOMUP: SUBI A,-1(B) ; POINT TO VALUE CELL
1444 HRRZ 0,(A) ;GOBBLE PROCID
1445 JUMPN 0,.+3 ;NOT GLOBAL
1446 CAIN B,TLOCI ;IS IT A LOCATIVE?
1447 MOVEI B,TVEC ;MARK AS A VECTOR
1448 PUSHJ P,VALPD1 ;UPDATE IT
1451 ; UPDATE PROCESS VECTOR
1453 PVPUP: SUBI A,-1(B) ;POINT TO TOP
1454 HRRM LPVP,PROCID(A) ;CHAIN ALL PROCESSES TOGETHER
1456 HRRZ 0,TBSTO+1(A) ;POINT TO CURRENT FRAME
1457 HRRM 0,TBSTO(A) ;SAVE
1461 ;THIS SUBROUTINE TAKES CARE OF UPDATING ASSOCIATION BLOCKS
1463 ASOUP: SUBI A,-1(B) ;POINT TO START OF BLOCK
1464 HRRZ B,ASOLNT-1(A) ;POINT TO NEXT
1466 HRRE C,ASOLNT+1(B) ;AND GET ITS RELOC IN C
1467 ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED PONTER
1468 ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER
1470 HRLZ F,ASOLNT+1(B) ;AND ITS RELOCATION
1471 ADDM F,ASOLNT-1(A) ;RELOCATE
1472 ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN
1474 HRRE C,ASOLNT+1(B) ;GET RELOC
1475 ADDM C,NODPNT(A) ;ANID UPDATE
1476 ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER
1478 HRLZ F,ASOLNT+1(B) ;RELOC
1480 ASOUP5: HRLI A,-3 ;SET TO UPDATE OTHER CONTENTS
1482 ASOUP3: HLRZ B,(A) ;GET TYPE
1483 PUSHJ P,VALPD1 ;UPDATE
1484 ADD A,[1,,2] ;MOVE POINTER
1486 JRST VECUP4 ;AND QUIT
1488 \f;VALUPD UPDATES A SINLE VALUE FROM EITHER PAIR SPACE OR VECTOR SPACE
1489 ;GETS POINTER TO TYPE CELL IN RH OF A
1490 ;TYPE IN RH OF B (LH MUST BE 0)
1493 VALPD1: MOVE C,1(A) ;GET VALUE TO UPDATE
1494 VALUPD: TRNN C,-1 ;ANY POINTER PART?
1495 JRST CPOPJ ;NO, LEAVE
1496 LSH B,1 ;SET TYPE TIMES 2
1497 HRRZ B,@TYPNT ;GET STORAGE ALLOCATION TYPE
1498 JRST @UPDTBS(B) ;AND DISPATCH THROUGH STORAGE ALLOCATION DISPATCH TABLE
1502 DISTBS UPDTBS,CPOPJ,[[S2WORD,2WDUP],[S2DEFR,2WDUP],[SNWORD,NWRDUP],[STPSTK,STCKUP]
1503 [SFRAME,FRAMUP],[STBASE,TBUP],[SARGS,ARGUP],[SBYTE,BYTUP],[SATOM,NWRDUP],[SPSTK,STCKUP]
1504 [SLOCID,LOCUP],[SPVP,NWRDUP],[S2NWORD,NWRDUP],[SABASE,ABUP],[SCHSTR,BYTUP],[SASOC,ASUP]]
1509 ;PAIR POINTER UPDATE
1510 2WDUP: TRNN C,-1 ;POINT TO NIL?
1511 POPJ P, ;YES -- NO UPDATE NEEDED
1512 SKIPGE B,(C) ;NO -- IS THIS A BROKEN HEART
1513 HRRM B,1(A) ;YESS -- STORE NEW VALUE
1514 SKIPE B,PARNEW ;IF LIST SPACE IS MOVING
1515 ADDM B,1(A) ;THEN ADD OFFSET TO VALUE
1519 ; HERE TO UPDATE ASSOCIATIONS
1521 ASUP: HRLI C,-ASOLNT ;MAKE INTO VECTOR POINTER
1523 \f;VECTOR, ATOM, STACK, AND BASE POINTER UPDATE
1525 LOCUP: HRRZ B,(A) ;CHECK IF IT IS TIMED
1526 JUMPN B,LOCUP1 ;JUMP IF TIMED, OTHERWISE TREAT LIKE VECTORE
1528 NWRDUP: HLRE B,C ;EXTEND COUNT IN B
1529 SUBI C,-1(B) ;SET C TO POINT TO DOPE WORD
1530 HRRE B,(C) ;EXTEND RELOCATION IN B
1531 ADDM B,1(A) ;AND ADD RELOCATION TO STORED DATUM
1532 HRRZ C,-1(C) ;GET GROWTH SPECS
1533 JUMPE C,CPOPJ ;NO GROWTH, LEAVE
1534 LDB C,[111100,,C] ;GET UPWORD GROWTH
1535 TRZN C,400 ;FLUSH SIGN AN NEGATR DIRECTION
1537 ASH C,6+18. ;TO LH AND TIMES 100(8)
1538 ADDM C,1(A) ;UPDATE POINTER
1542 LOCUP1: HRRZ B,2(C) ;GET TIME FROM STACK
1543 HRRM B,(A) ;AND USE IT
1545 STCKUP: MOVSI B,PDLBUF ;GET OFFSET FOR PDLS
1546 ADDM B,1(A) ;AND ADD TO COUNT
1547 JRST NWRDUP ;NOW TREAT LIKE VECTOR
1549 BYTUP: HRRZ C,(A) ;SET C TO POINT TO DOPE WD
1550 HRRE B,(C) ;SET B TO RELOCATION FOR THIS VEC
1551 ADDM B,(A) ;UPDATE DOPE WD POINTER
1552 ADDM B,1(A) ;AND UPDATE VALUE
1553 POPJ P, ;DONE WITH UPDATE
1555 ARGUP: TLOA TYPNT,400000 ;FLAG AS AN ARGS POINTER
1556 ABUP: TLZ TYPNT,400000 ;FLAG AS NOT ARGS POINTER
1557 HLRE B,C ;GET LENGTH
1558 SUB C,B ;POINT TO FRAME
1559 HLRZ B,(C) ;GET TYPE OF NEXT GOODIE
1560 CAIE B,TENTRY ;IS IT A FRAME
1561 HRRZ C,1(C) ;NO, POINT TO FRAME
1562 CAIN B,TENTRY ;IF IT IS A FRAME
1563 ADDI C,FRAMLN ;POINT TO ITS BASE
1564 TLZN TYPNT,400000 ;SKIP IF ARGS BLOCK
1565 JRST TBUP ;NO, JUST AN AB
1566 HLRZ B,OTBSAV(C) ;GET TIME
1567 HRRM B,(A) ;AND CLOBBER IT AWAY
1568 TBUP: MOVE C,TPSAV(C) ;GET A ASTACK POINTER TO FIND DOPE WORD
1569 HLRE B,C ;UPDATE BASED ON THIS POINTER
1571 HRRE B,1(C) ;GET RELOCATION
1572 ADDM B,1(A) ;AND MUNG POINTER
1575 FRAMUP: HRRZ B,(A) ;GET PROCESS POINTER
1576 HRRE B,(B) ;GET ITS RELOCATION
1578 HLLZ B,OTBSAV(C) ;GET FRAMES TIME
1579 HLLM B,1(A) ;AND STORE IN FRAME POINTER
1580 JRST TBUP ;AND CONTINUE UPDATING
1582 ;VECTOR SHRINKING PHASE
1584 VECSH: SUBI A,1 ;POOINT TO 1ST DOPE WORD
1585 VECSH1: CAMGE A,VECBOT ;FINISHED
1587 HRRZ B,-1(A) ;GET A SPEC
1588 JUMPE B,NXTSHN ;IGNORE IF NONE
1589 PUSHJ P,GETGRO ;GET THE SPECS
1590 JUMPGE C,SHRNBT ;SHRINKIGN AT BOTTOM
1591 MOVEI E,(A) ;COPY POINTER
1592 ADD A,C ;POINT TO NEW DOPE LOCATION WITH E
1593 MOVE F,-1(E) ;GET OLD DOPE
1594 ANDCMI F,777000 ;KILL THIS SPEC
1595 MOVEM F,-1(A) ;STORE
1596 MOVE F,(E) ;OTHER DOPE WORD
1598 ADD F,C ;CHANGE LENGTH
1599 MOVEM F,(A) ;AND STORE
1601 HLLZM C,(E) ;AND STORE
1603 SHRNBT: JUMPGE B,NXTSHN ;GROWTH, IGNOORE
1604 MOVM E,B ;GET A POSITIVE COPY
1606 ADDM B,(A) ;ADD INTO DOPE WORD
1607 MOVEI 0,777 ;SET TO CLOBBER GROWTH
1608 ANDCAM 0,-1(A) ;CLOBBER
1609 HLRZ B,(A) ;GET NEW LENGTH
1610 SUBI A,(B) ;POINT TO LOW END
1614 NXTSHN: HLRZ B,(A) ;GET LENGTH
1615 JUMPE B,VCMLOS ;LOOSE
1619 GETGRO: LDB C,[111100,,B] ;GET UPWARD GROWTH
1620 TRZE C,400 ;CHECK AND MUNG SIGN
1623 ANDI B,777 ;AND GET DOWN GROWTH
1624 TRZE B,400 ;CHECK AND MUNG SIGN
1628 \f;VECMOV -- MOVES VECTOR DATA TO WHERE RELOC FIELDS OF
1629 ;VECTORS INDICATE. MOVES DOPEWDS UP FOR VECTORS GROWING AT
1631 ;CALLED WITH VECTOP IN A. CALLS PARMOV TO MOVE PAIRS
1633 VECMOV: SUBI A,1 ;SET A TO ADDR OF TOP DOPE WD
1634 MOVSI D,400000 ;NEGATIVE D MARKS END OF BACK CHAIN
1635 MOVEI TYPNT,0 ;CLEAR ON GOING ADDRESS FOR FORWARD RESUME
1636 VECMO1: CAMGE A,VECBOT ;GOT TO BOTTOM OF VECTORS
1637 JRST PARMOV ;YES, MOVE LIST ELEMENTS AND RETURN
1638 MOVEI C,(A) ;NO, COPY ADDR OF THIS DOPEWD
1639 HRRE B,(A) ;GET RELOCATION OF THIS VECTOR
1640 JUMPL B,VECMO5 ;IF MOVING DOWNWARD, MAKE BACK CHAIN
1641 JUMPE B,VECMO4 ;IF NON MOVER, JUST ADJUST DOPW AND MOVE ON
1643 ADDI C,(B) ;SET ADDR OF LAST DESTINATION WD
1644 HRLI B,A ;MAKE B INDEX ON A
1645 HLL A,(A) ;COUNT TO A LEFT HALF
1647 POP A,@B ;MOVE A WORD
1648 TLNE A,-1 ;REACHED END OF MOVING
1649 JRST .-2 ;NO, REPEAT
1650 ;YES, NOTE A HAS ADDR OF NEXT DOPEWD
1651 ;HERE TO ADJUST LOCATION OF DOPEWDS FOR GROWTH (FORWARDLY)
1652 VECMO2: LDB B,[111100,,-1(C)] ;GET HIGH GROWTH FIELD
1653 JUMPE B,VECMO3 ;IF NO GROWTH, DONT MOVE
1654 ASH B,6 ;EXPRESS GROWTH IN WORDS
1655 HRLI C,2 ;SET COUNT FOR POPPING 2 DOPEWDS
1656 HRLI B,C ;MAKE B INDEX ON C
1657 POP C,@B ;MOVE PRIME DOPEWD
1658 POP C,@B ;MOVE AUX DOPEWD
1659 VECMO3: JUMPL D,VECMO1 ;IF NO BACK CHAIN THEN MOVE ON
1660 JRST VECMO6 ;YES, BACKCHAINING, CONTINUE SAME
1662 ;HERE TO SKIP OVER STILL VECTORS (FORWARDLY)
1663 VECMO4: HLRZ B,(A) ;GET SIZE OF UNMOVER
1664 SUBI A,(B) ;UPDATE A TO NEXT VECTOR
1665 JRST VECMO2 ;AND GO CLEAN UP GROWTH
1666 \f;HERE TO ESTABLISH A BACKWARDS CHAIN
1667 VECMO5: EXCH D,(A) ;CHAIN FORWARD
1669 SUBI A,(B) ;GO ON TO NEXT VECOTR
1670 CAMGE A,VECBOT ;HAVE WE GOT TO END OF VECTORS?
1671 JRST VECMO7 ;YES, GO MOVE PAIRS AND UNCHAIN
1672 HRRE B,(A) ;GET RELOCATION OF THIS VECTOR
1673 JUMPLE B,VECMO5 ;IF NOT POSITIVE, CONTINUE CHAINING
1674 MOVEM A,TYPNT ;SAVE ADDR FOR FORWARD RESUME
1676 ;HERE TO UNCHAIN A VECTOR, MOVE IT, AND ADJUST DOPEWDS
1677 VECMO6: HLRZ B,D ;GET SIZE
1678 MOVEI F,1(A) ;GET A COPY OF BEGINNING OF VECTOR
1679 ADDI A,(B) ;SET TO POINT TO ADDR OF DOPEWD CURRENTLY IN D
1680 EXCH D,(A) ;AND UNCHAIN
1681 HRRE B,(A) ;GET RELOCATION FOR THIS VECTOR
1682 MOVEI C,(A) ;COPY A POINTER TO DOPEW
1683 SKIPGE D ;HAVE WE REACHED THE TOP OF THE CHAIN?
1684 MOVE A,TYPNT ;YES, RESTORE FORWARD MOVE RESUME ADDR
1685 JUMPE B,VECMO2 ;IF STILL VECTOR,GO ADJUST DOPEWDS
1686 ADDI C,(B) ;MAKE C POINT TO NEW DOPEW ADDR
1687 ADDI B,(F) ;B RH NEW 1ST WORD
1688 HRLI B,(F) ;B LH OLD 1ST WD ADDR
1689 BLT B,(C) ;COPY THE DATA
1690 JRST VECMO2 ;AND GO ADJUST DOPEWDS
1692 ;HERE TO STOP CHAINING BECAUSE OF BOTTOM OF VECTOR SPACE
1693 VECMO7: MOVEM A,TYPNT
1699 \f;PAIR MOVEMENT PHASE -- USES PARNEW,PARBOT, AND PARTOP TO MOVE PAIRS
1702 PARMOV: SKIPN A,PARNEW ;IS THERE ANY PAIR MOVEMENT?
1704 JUMPL A,PARMO2 ;YES -- IF MOVING DOWNWARDS, GO DO A BLT
1705 HRLI A,B ;MOVING UPWARDS SETAC A TO INDEX OFF AC B
1706 MOVE B,PARTOP ;GET HIGH PAIR ADDREESS
1707 SUB B,PARBOT ;AND SUBTRACT BOTTOM TO GET NUMBER OF PAIRS
1708 HRLZS B ;PUT COUNT IN LEFT HALF
1709 HRR B,PARTOP ;GET HIGH ADDRESS PLUS ONE IN RH
1710 SUBI B,1 ;AND SUBTRACT ONE TO POINT TO LAST WORD TO BE MOVED
1712 PARMO1: TLNN B,-1 ;HAS COUNT REACHED ZERO?
1713 JRST PARMO3 ;YES -- FINISH UP
1714 POP B,@A ;NO -- TRANSFER2Y
\eU NEXT WORD
1715 JRST PARMO1 ;AND REPEAT
1717 PARMO2: MOVE B,PARBOT ;GET ADDRESS OF FIRST SOURCE WD
1718 HRLS B ;IN BOTH HALVES OF AC B
1719 ADD B,A ;MAKE RH OF B POINT TO FIRST DESTINATION WORD
1720 ADD A,PARTOP ;MAKE RH OF A POINT TO LAST DESTINATION WORD PLUS ONE
1721 BLT B,-1(A) ;AND TRANSFER THE BLOCK OF PAIRS
1723 PARMO3: MOVE A,PARNEW ;GET OFFSET FOR PAIR SPACE
1724 ADDM A,PARBOT ;AND CORRECT BOTTOM
1725 ADDM A,PARTOP ;AND CORRECT TOP.
1726 SETZM PARNEW ;CLEAR SO IF CALLED TWICE, NO LOSSAGE
1728 \f;VECZER -- CLEARS DATA IN AREAS JUST GROWN
1729 ;UPDATES SIZE OF VECTORS
1730 ;CLEARS RELOCATION AND GROWTH FIELDS IN DOPEWDS
1731 ;CALLED WITH NEW VECTOP IN A (VECBOT SHOULD BE NEW TOO)
1733 VECZER: SUBI A,1 ;MAKE A POINT TO HIGH VECTORS
1734 VECZE1: CAMGE A,VECBOT ;REACHED BOTTOM OF VECTORS?
1735 POPJ P, ;YES, RETURN
1736 HLLZS F,(A) ;NO, CLEAR RELOCATION GET SIZE
1737 HLRZS F ;AND PUT SIZE IN RH OF F
1738 HRRZ B,-1(A) ;GET GROWTH INTO B
1739 JUMPN B,VECZE3 ;IF THERE IS SOME GROWTH, GO DO IT
1740 VECZE2: SUBI A,(F) ;GROWTH DONE, MOVE ON TO NEXT VECTOR
1741 JRST VECZE1 ;AND REPEAT
1743 VECZE3: HLLZS -1(A) ;CLEAR GROWTH IN THE VECTOR
1744 LDB C,[111100,,B] ;GET HIGH ORDER GROWTH IN C
1745 ANDI B,777 ;AND LIMIT B TO LOW SIDE
1746 ASHC B,6 ;EXPRESS GROWTH IN WORDS
1747 JUMPE C,VECZE4 ;IF NO HIGH GROWTH SKIP TO LOW GROWTH
1748 ADDI F,(C) ;ADD HIGH GROWTH TO SIZE
1749 SUBM A,C ;GET ADDR OF 2ND WD TO BE ZEROED
1750 SETZM -1(C) ;CLEAR 1ST WORD
1751 HRLI C,-1(C) ;MAKE C A CLEARING BLT POINTER
1752 BLT C,-2(A) ;AND CLEAR HIGH END DATA
1753 \rVECZE4: JUMPE B,VECZE5 ;IF NO LOW GROWTH SKIP TO SIZE UPDATE
1754 MOVNI C,(F) ;GET NEGATIVE SIZE SO FAR
1755 ADDI C,(A) ;AND MAKE C POINT TO LAST WORD OF STUFF TO BE CLEARED
1756 ADDI F,(B) ;UPDATE SIZE
1757 SUBM C,B ;MAKE B POINT TO LAST WD OF NEXT VECT
1758 ADDI B,2 ;AND NOW TO 2ND DATA WD TO BE CLEARED
1759 SETZM -1(B) ;CLEAR 1ST DATA WD
1760 HRLI B,-1(B) ;MAKE B A CLEARING BLT POINTER
1761 BLT B,(C) ;AND CLEAR THE LOW DATA
1762 \rVECZE5: HRLZM F,(A) ;STORE THE NEW SIZE IN DOPEWD
1765 ;SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE
1767 REHASH: MOVE TVP,TVPSTO+1(PVP) ;RESTORE TV POINTER
1768 MOVE D,ASOVEC+1(TVP) ;GET POINTER TO VECTOR
1770 PUSH P,E ;PUSH A POINTER
1771 HLRE A,D ;GET -LENGTH
1772 MOVMS A ;AND PLUSIFY
1773 PUSH P,A ;PUSH IT ALSO
1775 REH3: HRRZ C,(D) ;POINT TO FIRST BUCKKET
1776 HLRZS (D) ;MAKE SURE NEW POINTER IS IN RH
1777 JUMPE C,REH1 ;B
\0UCKET EMPTY, QUIT
1779 REH2: MOVEI E,(C) ;MAKE A COPY OF THE POINTER
1780 MOVE A,ITEM(C) ;START HASHING
1784 MOVMS A ;MAKE SURE FINAL HASH IS +
1785 IDIV A,(P) ;DIVIDE BY TOTAL LENGTH
1786 ADD B,-1(P) ;POINT TO WINNING BUCKET
1788 MOVE C,[002200,,(B)] ;BYTE POINTER TO RH
1789 CAILE B,(D) ;IF PAST CURRENT POINT
1790 MOVE C,[222200,,(B)] ;USE LH
1791 LDB A,C ;GET OLD VALUE
1792 DPB E,C ;STORE NEW VALUE
1793 HRRZ B,ASOLNT-1(E) ;GET NEXT POINTER
1794 HRRZM A,ASOLNT-1(E) ;AND CLOBBER IN NEW NEXT
1795 SKIPE A ;SKKIP IF NOTHING PREVIOUSLY IN BUCKET
1796 HRLM E,ASOLNT-1(A) ;OTHERWISE CLOBBER
1797 SKIPE C,B ;SKIP IF END OF CHAIN
1801 SUB P,[2,,2] ;FLUSH THE JUNK
1803 \fVCMLOS: MOVEI B,[ASCIZ /AGC -- VECTOR WITH ZERO IN DOPE WORD LENGTH
1809 GETNUM: 0 ;NO OF WORDS TO GET
1810 PARNUM: 0 ;NO OF PAIRS MARKED
1811 VECNUM: 0 ;NO OF WORDS IN MARKED VECTORS
1812 CORSET: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY
1813 CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY
1815 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
1816 ;AND WHEN IT WILL GET UNHAPPY
1818 SYSMAX: 50. ;MAXIMUM SIZE OF MUDDLE
1819 FREMIN: 1000 ;MINIMUM FREE WORDS
1820 FREDIF: 10000 ;DIFFERENCE BETWEEN FREMIN AND MAXIMUM NUMBER OF FREE WORDS
1821 ;POINTER TO GROWING PDL
1823 TPGROW: 0 ;POINTS TO A BLOWN TP
1824 PPGROW: 0 ;POINTS TO A BLOWN PP
1825 TIMOUT: 0 ;POINTS TO TIMED OUT PDL
1826 PGROW: 0 ;POINTS TO A BLOWN P