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
13 TPMAX==5000 ;PDLS LARGER THAN THIS WILL BE SHRUNK
14 PMAX==1000 ;MAXIMUM PSTACK SIZE
15 TPMIN==100 ;MINIMUM PDL SIZES
17 TPGOOD==2000 ; A GOOD STACK SIZE
23 TYPNT=AB ;SPECIAL AC USAGE DURING GC
24 F=TP ;ALSO SPECIAL DURING GC
25 LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN
26 LINF=TB ;SPECIAL FOR GC, HOLDS POINTER TO INFO CELL CHAIN
27 ;FUNCTION TO CONSTRUCT A LIST
30 HLRZ A,2(AB) ;GET TYPE OF 2ND ARG
32 JRST BADTYP ;NO , COMPLAIN
33 HLRZ A,(AB) ;GET TYPE OF FIRST
34 PUSHJ P,NWORDT ;GET NO. OF WORDS NEEDED FOR DATUM
35 SOJN A,CDEFER ;GREATER THAN 1, MUST MAKE DEFERRED POINTER
36 MOVEI A,2 ;SET UP CALL TO CELL
38 HLLZ A,(AB) ;TYPE OF FIRST ARG
39 MOVE C,1(AB) ;GET DATUM
40 CFINIS: PUSHJ P,CLOBIT ;STORE
43 ;HERE TO STORE IN PAIR
45 CLOBIT: HRR A,3(AB) ;GET CDR
46 CLOBT1: MOVEM A,(B) ;STORE FIRST
47 MOVEM C,1(B) ;AND SECOND
48 MOVSI A,TLIST ;GET FINAL TYPE
51 ;HERE FOR A DEFERRED CONS
53 CDEFER: MOVEI A,4 ;NEED 4 CELLS
55 MOVE A,(AB) ;GET COMPLETE 1ST WORD
56 MOVE C,1(AB) ;AND SECOND
58 MOVE C,B ;POINT TO DEFERRED PAIR WITH C
59 ADDI B,2 ;POINT TO OTHER PAIR
60 MOVSI A,TDEFER ;GET TYPE
64 ;THIS ROUTINE ALLOCATES A CELL
65 CELL: MOVE B,PARTOP ;GET TOP OF PAIRS
66 ADD B,A ;FIND PROPOSED NEW TOP
67 CAMLE B,VECBOT ;CROSSING INTO VECTORS?
68 JRST FULL ;YES, GO COLLECT GARBAGE
69 EXCH B,PARTOP ;NO, SET NEW TOP AND RETURN POINTER
72 FULL: MOVEM A,GETNUM ;STORE WORDS NEEDED
73 SETZM PARNEW ;NO MOVEMENT NEEDED
74 PUSHJ P,AGC ;COLLECT GARBAGE
75 JRST CELL ;AND TRY AGAIN
78 ;SUBROUTINES TO RETURN WORDS NEEDED BASED ON TYPE OR SAT
80 NWORDT: PUSHJ P,SAT ;GET STORAGE ALLOC TYPE
81 NWORDS: SKIPL MKTBS(A) ;-ENTRY IN TABLE MEANS 2 NEEDED
82 SKIPA A,[1] ;NEED ONLY 1
87 ;FUNCTION TO BUILD A LIST OF MANY ELEMENTS
92 HLRE A,AB ;GET -NUM OF ARGS
94 JUMPE A,LISTN ;JUMP IF 0
95 PUSHJ P,CELL ;GET NUMBER OF CELLS
96 PUSH TP,$TLIST ;SAVE IT
98 LSH A,-1 ;NUMBER OF REAL LIST ELEMENTS
100 CHAINL: ADDI B,2 ;LOOP TO CHAIN ELEMENTS
101 HRRZM B,-2(B) ;CHAIN LAST ONE TO NEXT ONE
102 SOJG A,.-2 ;LOOP TIL ALL DONE
103 CLEARM B,-2(B) ;SET THE LAST CDR TO NIL
105 ; NOW LOBEER THE DATA IN TO THE LIST
107 MOVE B,(TP) ;RESTORE LIS POINTER
108 LISTLP: HLRZ A,(AB) ;GET TYPE
109 PUSHJ P,NWORDT ;GET NUMBER OF WORDS
110 SOJN A,LDEFER ;NEED TO DEFER POINTER
111 HLLZ A,(AB) ;NOW CLOBBER ELEMENTS
113 MOVE A,1(AB) ;AND VALUE..
115 LISTL2: ADDI B,2 ;STEP B
116 ADD AB,[2,,2] ;STEP ARGS
123 ; MAKE A DEFERRED POINTER
125 LDEFER: PUSH TP,$TLIST ;SAVE CURRENT POINTER
127 MOVEI A,2 ; SET UP TO GET CELLS
129 MOVE A,(AB) ;GET FULL DATA
132 MOVE C,(TP) ;RESTORE LIST POINTER
133 MOVEM B,1(C) ;AND MAKE THIS BE THE VALUE
135 HLLM A,(C) ;AND STORE IT
143 \fBADTYP: PUSH TP,$TATOM ;ARGUMENT OF TYPE ATOM
144 PUSH TP,MQUOTE 2ND-ARGUMENT-NOT-A-LIST
145 JRST CALER1 ;OFF TO ERROR HANDLER
148 \f;FUNCTION WHICH CONSES ITS ARGUMENT WITH NIL
151 PUSH TP,(AB) ;SET UP CONS CALL
158 \f;FUNCTION TO GENERATE A VECTOR IN VECTOR SPACE
159 ;CALLED WITH ONE FIXNUM ARGUMENT, WHICH IS THE NUMBER OF ELEMENTS DESIRED.
161 MFUNCTION VECTOR,SUBR
163 MOVEI C,1 ;THIS IS A GENERAL VECTOR
164 VECTO3: JUMPGE AB,TFA ;TOO FEW ARGS
165 CAMGE AB,[-4,,0] ;ASSURE NOT TOO MANY
167 HLRZ A,(AB) ;GET TYPE OF ARGUMENT
168 CAIE A,TFIX ;IS IT A FIXED NUMBER?
169 JRST BDTYPV ;NO, GO COMPLAIN
170 SKIPGE A,1(AB) ;GET LENGTH
171 JRST BADNUM ;LOSING NUMBER
172 ASH A,(C) ;TIMES TWO FOR NUMBER OF WORDS IF GENERAL
173 ADDI A,2 ;PLUS TWO FOR DOPEWDS
174 VECTO2: MOVE B,VECBOT ;GET CURRENT BOTTOM OF VECTORS
175 SUB B,A ;AND SUBTRACT THE WORDS IN THIS VECTOR
176 CAMGE B,PARTOP ;HAVE WE BUMPED INTO PAIR SPACE?
177 JRST VECTO1 ;YES, GO GARBAGE COLLECT
178 EXCH B,VECBOT ;UPDATE VECBOT, GET OLD POINTER
179 HRLZM A,-1(B) ;PUT LENGTH IN DOPE WORD FIELD.
180 MOVSI D,400000 ;PREPARE TO SET NONUNIFORM BIT
181 JUMPE C,.+2 ;DONT SET IF UNIFORM
182 MOVEM D,-2(B) ;CLOBBER IT IN
183 HRRO B,VECBOT ;AND GET TOP OF VECTOR IN RH, -1 IN LH.
184 TLC B,-3(A) ;SET LH OF ANSWER TO NEGATIVE COUNT
185 MOVSI A,TVEC ;AND GET TYPE VECTOR TO MARK B AS AN AOBJN POINTER TO A VECTOR
186 CAML AB,[-2,,0] ;SKIP IF 2 ARGS SUPPLIED
187 JRST VFINIS ;ONLY ONE, LEAVE
188 JUMPE C,UINIT ;JUMP IF NOT GENERAL VECTOR
190 JUMPGE B,FINIS ;ZERO LENGTH, DONT INIT
194 PUSH TP,B ;SAVE THE VECTOR
197 PUSH TP,3(AB) ;PUSH FORM TO BE EVALLED
199 MOVE C,(TP) ;RESTORE VECTOR
201 MOVEM B,1(C) ;CLOBBER
204 JUMPL C,INLP ;JUMP TO DO NEXT
206 GETVEC: MOVE A,-3(TP)
211 UINIT: PUSH TP,$TUVEC
215 PUSH P,[-1] ;WILL HOLD TYPE
221 SKIPGE (P) ;SKIP IF 1ST SEEN
229 JRST UINLP ;AND CONTINUE
231 POP P,A ;RESTORE TYPE
232 HRLZM A,(C) ;CLOBBER UNIFORM TYPE
240 VFINIS: JUMPN C,FINIS
245 ;FUNCTION TO GENERATE A UNIFOM VECTOR
247 MFUNCTION UVECTOR,SUBR
249 MOVEI C,0 ;SET FOR A UNIFORM HACK
252 BADNUM: PUSH TP,$TATOM ;COMPLAIN
253 PUSH TP,MQUOTE NEGATIVE-ARGUMENT
255 \fBDTYPV: PUSH TP,$TATOM
256 PUSH TP,MQUOTE NON-INTEGER-ARGUMENT
259 VECTO1: SETZM PARNEW ;CLEAR RELOCATION OF PAIR SPACE
260 MOVEM A,GETNUM ;SAVE NUMBER OF WORDS TO GET
261 PUSHJ P,AGC ;GARBAGE COLLECT
262 JRST VECTO3 ;AND TRY AGAIN
264 MFUNCTION EVECTOR,SUBR
268 PUSH P,A ;SAVE NUMBER OF WORDS
269 ASH A,-1 ;FOR VECTOR TO WIN NEED NO. OF ELEMENTS
274 POP P,D ;RESTORE NUMBER OF WORDS
275 HRLI C,(AB) ;START BUILDING BLT POINTER
276 HRRI C,(B) ;TO ADDRESS
277 ADDI D,(B)-1 ;SET D TO FINAL ADDRESS
281 ;EXPLICIT VECTORS FOR THE UNIFORM CSE
283 MFUNCTION EUVECTOR,SUBR
286 HLRE A,AB ;-NUM OF ARGS
288 ASH A,-1 ;NEED HALF AS MANY WORDS
291 GETYP A,(AB) ;GET FIRST ARG
292 PUSHJ P,NWORDT ;SEE IF NEEDS EXTRA WORDS
294 MCALL 1,UVECTOR ;GET THE VECTOR
296 GETYP C,(AB) ;GET THE FIRST TYPE
297 MOVE D,AB ;COPY THE ARG POINTER
298 MOVE E,B ;COPY OF RESULT
300 EUVLP: GETYP 0,(D) ;GET A TYPE
302 JRST WRNGUT ;NO , LOSE
303 MOVE 0,1(D) ;GET GOODIE
305 ADD D,[2,,2] ;BUMP ARGS POINTER
308 HRLM C,(E) ;CLOBBER UNIFORM TYPE IN
311 WRNGUT: PUSH TP,$TATOM
312 PUSH TP,MQUOTE TYPES-DIFFER-IN-UNIFORM-VECTOR
315 CANTUN: PUSH TP,$TATOM
316 PUSH TP,MQUOTE DATA-CANT-GO-IN-UNIFORM-VECTOR
320 ; FUNCTION TO GROW A VECTOR
326 MOVEI D,0 ;STACK HACKING FLAG
327 HLRZ A,(AB) ;FIRST TYPE
328 PUSHJ P,SAT ;GET STORAGE TYPE
329 HLRZ B,2(AB) ;2ND ARG
330 CAIE A,STPSTK ;IS IT ASTACK
332 AOJA D,GRSTCK ;YES, WIN
333 CAIE A,SNWORD ;UNIFORM VECTOR
334 CAIN A,S2NWORD ;OR GENERAL
335 GRSTCK: CAIE B,TFIX ;IS 2ND FIXED
336 JRST WRONGT ;COMPLAIN
341 MOVEI E,1 ;UNIFORM/GENERAL FLAG
342 CAIE A,SNWORD ;SKIP IF UNIFORM
343 CAIN A,SPSTK ;DONT SKIP IF UNIFORM PDL
346 HRRZ B,1(AB) ;POINT TO START
347 HLRE A,1(AB) ;GET -LENGTH
348 SUB B,A ;POINT TO DOPE WORD
349 SKIPE D ;SKIP IF NOT STACK
350 ADDI B,PDLBUF ;FUDGE FOR PDL
351 HLLZS (B) ;ZERO OUT GROWTH SPECS
352 SKIPN A,3(AB) ;ANY TOP GROWTH?
353 JRST GROW1 ;NO, LOOK FOR BOTTOM GROWTH
354 ASH A,(E) ;MULT BY 2 IF GENERAL
355 ADDI A,77 ;ROUND TO NEAREST BLOCK
356 ANDCMI A,77 ;CLEAR LOW ORDER BITS
357 ASH A,9-6 ;DIVIDE BY 100 AND SHIFT TO POSTION
358 TRZE A,400000 ;CONVERT TO SIGN MAGNITUDE
360 TLNE A,-1 ;SKIP IF NOT TOO BIG
362 GROW1: SKIPN C,5(AB) ;CHECK LOW GROWTH
363 JRST GROW4 ;NONE, SKIP
364 ASH C,(E) ;GENRAL FUDGE
366 ANDCMI C,77 ;FUDGE FOR VALUE RETURN
368 ASH C,-6 ;DIVIDE BY 100
369 TRZE C,400 ;CONVERT TO SIGN MAGNITUDE
371 TDNE C,[-1,,777000] ;CHECK FOR OVERFLOW
373 GROW2: HLRZ E,1(B) ;GET TOTAL LENGTH OF VECTOR
374 SUBI E,2 ;FUDGE FOR DOPE WORDS
376 HRLI E,-1(E) ;TO BOTH HALVES
377 ADDI E,(B) ;POINTS TO TOP
379 ADD E,[PDLBUF,,0] ;YES, FUDGE LENGTH
380 SKIPL D,(P) ;SHRINKAGE?
381 JRST GROW3 ;NO, CONTINUE
383 HRLI D,(D) ;TO BOTH HALVES
384 ADD E,D ;POINT TO NEW LOW ADDR
385 GROW3: IORI A,(C) ;OR TOGETHER
386 HRRM A,(B) ;DEPOSIT INTO DOPEWORD
387 PUSH TP,(AB) ;PUSH TYPE
389 SKIPE A ;DON'T GC FOR NOTHING
391 POP P,C ;RESTORE GROWTH
393 POP TP,B ;GET VECTOR POINTER
394 SUB B,C ;POINT TO NEW TOP
398 GTOBIG: PUSH TP,$TATOM
399 PUSH TP,MQUOTE ATTEMPT-TO-GROW-VECTOR-TOO-MUCH
401 GROW4: PUSH P,[0] ;0 BOTTOM GROWTH
404 ; SUBROUTINE TO BUILD CHARACTER STRING GOODIES
406 MFUNCTION STRING,SUBR
410 MOVE B,AB ;COPY ARG POINTER
411 MOVEI C,0 ;INITIALIZE COUNTER
412 PUSH TP,$TAB ;SAVE A COPY
414 JUMPGE B,MAKSTR ;ZERO LENGTH
416 STRIN2: GETYP D,(B) ;GET TYPE CODE
417 CAIN D,TCHRS ;SINGLE CHARACTER?
419 CAIE D,TCHSTR ;OR STRING
422 MOVEM B,(TP) ;SAVE CURRENT POINTER
425 PUSH P,C ;SAVE CURRENT COUNT
426 MCALL 1,LENGTH ;FIND THE LENGTH
428 ADDI C,(B) ;BUMP COUNT
434 ; NOW GET THE NECESSARY VECTOR
436 MAKSTR: PUSH TP,$TFIX
437 ADDI C,4 ;COMPUTE NEEDED WORDS
440 MCALL 1,UVECTOR ;GET THE VECTOR
442 HRLI B,440700 ;CONVERT B TO A BYTE POINTER
443 SKIPL C,AB ;ANY ARGS?
446 NXTRG1: GETYP D,(C) ;GET AN ARG
449 LDB D,[350700,,1(C)] ;GET IT
450 IDPB D,B ;AND DEPOSIT IT
453 TRYSTR: MOVE E,1(C) ;GET BYTER
454 HRRZ 0,(C) ;AND DOPE WORD POINTER
455 LDB D,E ;GET 1ST CHAR
456 NXTCHR: CAIG 0,1(E) ;STILL WINNING?
457 JRST NXTARG ;NO, GET NEXT ARG
458 JUMPE D,NXTARG ;HIT 0, QUIT
460 ILDB D,E ;AND GET NEXT
463 NXTARG: ADD C,[2,,2] ;BUMP ARG POINTER
468 HLLM C,(B) ;AND CLOBBER AWAY
469 HLRZ C,1(B) ;GET LENGTH BACK
470 MOVEI A,1(B) ;POINT TO DOPE WORD
473 HRLI B,350700 ;MAKE A BYTE POINTER
477 ;SET FLAG FOR INTERRUPT HANDLER
482 IRP AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,TVP,PP,PVP]
483 MOVEM AC,AC!STO"+1(PVP)
486 ;SET UP E TO POINT TO TYPE VECTOR
490 HRRZ TYPNT,TYPVEC+1(TVP)
493 ;DECIDE WHETHER TO SWITCH TO GC PDL
495 MOVE D,P ;SAVE TRUE P FOR FRAME MUNGING
496 MOVEI A,(P) ;POINNT TO PDL
497 HRRZ B,GCPDL ;POINT TO BASE OF GC PDL
498 CAIG A,(B) ;SKIP IF MUST CHANGE
500 HLRE C,GCPDL ;-LENGTH OF GC'S PDL
501 SUB B,C ;POINT TO END OF GC'S PDL
502 CAILE A,(B) ;SKIP IF WITHIN GCPDL
503 CHPDL: MOVE P,GCPDL ;GET GC'S PDL
505 ;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK
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 SETZB LINF,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
535 ;THIS HAS BEEN FLUSHED BECAUSE OF PLANNER
537 SKIPE A,TIMOUT ;ANY TIME OVERFLOWS
538 PUSHJ P,RETIME ;YES, RE-CALIBRATE THEM
540 ;CORE ADJUSTMENT PHASE
541 SETZM CORSET ;CLEAR LATER CORE SETTING
542 PUSHJ P,CORADJ ;AND MAKE CORE ADJUSTMENTS
544 ;RELOCATION ESTABLISHMENT PHASE
545 ;1 -- IN PAIR SPACE, SWAP LOW GARBAGE WITH HIGHER NON GARBAGE
546 MOVE A,PARBOT" ;ONE POINTER TO BOTTOM OF PAIR SPACE
547 MOVE B,PARTOP" ;AND ANOTHER TO TOP.
548 PUSHJ P,PARREL ;AND ESTABLISH THE PAIR RELOCATION
549 MOVEM B,PARTOP ;ESTABLISH NEW TOP OF PAIRS HERE
551 ;2 -- IN VECTOR SPACE, ESTABLISH POINTERS TO TOP OF CORE
552 MOVE A,VECTOP" ;START AT TOP OF VECTOR SPACE
553 MOVE B,VECNEW" ;AND SET TO INITIAL OFFSET
554 SUBI A,1 ;POINT TO DOPE WORDS
555 PUSHJ P,VECREL ;AND ESTABLISH RELOCATION FOR VECTORS
556 MOVEM B,VECNEW ;SAVE FINAL OFFSET
558 \f;POINTER UPDATE PHASE
559 ;1 -- UPDATE ALL PAIR POINTERS
560 MOVE A,PARBOT ;START AT BOTTOM OF PAIR SPACE
561 PUSHJ P,PARUPD ;AND UPDATE ALL PAIR POINTERS
563 ;2 -- UPDATE ALL VECTORS
564 MOVE A,VECTOP ;START AT TOP OF VECTOR SPACE
565 PUSHJ P,VECUPD ;AND UPDATE THE POINTERS
567 ;3 -- UPDATE THE PVP AC
568 MOVEI A,PVP-1 ;SET LOC TO POINT TO PVP
569 MOVE C,PVP ;GET THE DATUM
570 PUSHJ P,NWRDUP ;AND UPDATE THIS VALUE
571 ;4 -- UPDATE THE MAIN PROCESS POINTER
572 MOVEI A,MAINPR-1 ;POINT TO MAIN PROCESS POINTER
573 MOVE C,MAINPR ;GET CONTENTS IN C
574 PUSHJ P,NWRDUP ;AND UPDATE IT
575 ;DATA MOVEMMENT ANDCLEANUP PHASE
577 ;1 -- ADJUST FOR SHRINKING VECTORS
578 MOVE A,VECTOP ;VECTOR SHRINKING PHASE
579 PUSHJ P,VECSH ;GO SHRINK ANY SHRINKERS
581 ;2 -- MOVE VECTORS (AND LIST ELEMENTS)
582 MOVE A,VECTOP ;START AT TOP OF VECTOR SPACE
583 PUSHJ P,VECMOVE ;AND MOVE THE VECTORS
584 MOVE A,VECNEW ;GET FINAL CHANGE TO VECBOT
585 ADDM A,VECBOT ;OFFSET VECBOT TO ITS NEW PLACE
586 MOVE A,CORTOP ;GET NEW VALUE FOR TOP OF VECTOR SPACE
587 MOVEM A,VECTOP ;AND UPDATE VECTOP
589 ;3 -- CLEANUP VECTORS (NOTE A CONTAINS NEW VECTOP)
593 ;GARBAGE ZEROING PHASE
594 GARZER: MOVE A,PARTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE
595 HRLS A ;GET FIRST ADDRESS IN LEFT HALF
596 MOVE B,VECBOT ;LAST ADDRESS OF GARBAGE + 1
597 CLEARM (A) ;ZERO THE FIRST WORD
598 ADDI A,1 ;MAKE A A BLT POINTER
599 BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA
601 ;FINAL CORE ADJUSTMENT
602 SKIPE A,CORSET ;IFLESS CORE NEEDED
603 PUSHJ P,CORADL ;GIVE SOME AWAY.
605 ;NOW REHASH THE ASSOCIATIONS BASED ON NEW VALUES
610 IRP AC,,[0,A,B,C,D,E,P,SP,TP,TB,AB,PP,PVP,TVP]
611 MOVE AC,AC!STO+1(PVP)
614 SETZM PARNEW ;CLEAR FOR NEXT AGC CALL
615 SETZM GETNUM ;ALSO CLEAR THIS
622 AGCE1: MOVEI B,[ASCIZ /TYPVEC IS NOT OF TYPE VECTOR
624 TYPSTP: PUSHJ P,MSGTYP" ;TYPE OUT A HOPELESSMESSAGE
629 ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING
631 PDLCHK: JUMPGE A,CPOPJ
632 HLRE B,A ;GET NEGATIVE COUNT
633 MOVE C,A ;SAVE A COPY OF PDL POINTER
634 SUBI A,-1(B) ;LOCATE DOPE WORD PAIR
635 HRRZS A ; ISOLATE POINTER
636 CAME A,TPGROW ;GROWING?
637 CAMN A,PPGROW ;OR PLANNER PDL
639 ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD
640 HLRZ D,(A) ;GET COUNT FROM DOPE WORD
641 MOVNS B ;GET POSITIVE AMOUNT LEFT
642 SUBI D,2(B) ; PDL FULL?
643 JUMPE D,NOFENC ;YES NO FENCE POSTING
644 SETOM 1(C) ;CLOBBER TOP WORD
645 SOJE D,NOFENC ;STILL MORE?
646 MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS
648 BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS
651 NOFENC: CAIG B,TPMAX ;NOW CHECK SIZE
653 JRST MUNGTP ;TOO BIG OR TOO SMALL
656 MUNGTP: SUBI B,TPGOOD ;FIND DELTA TP
657 MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED
658 TRNE C,777000 ;SKIP IF NOT
659 POPJ P, ;ASSUME GROWTH GIVEN WILL WIN
661 ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS
663 TRO B,400 ;TURN ON SHRINK BIT
667 MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD
670 ; CHECK UNMARKED STACK (NO NEED TO FENCE POST)
672 PDLCHP: HLRE B,A ;-LENGTH TO B
673 SUBI A,-1(B) ;POINT TO DOPE WORD
674 HRRZS A ;ISOLATE POINTER
675 CAME A,PGROW ;GROWING?
676 ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD
679 CAIG B,PMAX ;TOO BIG?
680 CAIG B,PMIN ;OR TOO LITTLE
681 JRST .+2 ;YES, MUNG IT
687 ;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS
688 ; A/ GOODIE TO MARK FROM
689 ; B/ TYPE OF A (IN RH)
690 ; C/ TYPE,DATUM PAIR POINTER
692 MARK2: HLRZ B,(C) ;GET TYPE
693 MARK1: MOVE A,1(C) ;GET GOODIE
694 MARK: JUMPE A,CPOPJ ; NEVER MARK 0
695 PUSH P,A ;SAVE GOODIE
696 HRLM C,-1(P) ;AND POINTER TO IT
697 LSH B,1 ;TIMES 2 TO GET SAT
698 HRRZ B,@TYPNT ;GET SAT
699 JRST @MKTBS(B) ;AND GO MARK
701 ; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED)
703 DISTBS MKTBS,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK]
704 [STPSTK,TPMK],[SARGS,<SETZ ARGMK>],[S2NWORD,VECTMK],[SPSTK,TPMK]
705 [SFRAME,<SETZ FRMK>],[SBYTE,<SETZ BYTMK>],[SATOM,ATOMK],[SPVP,VECTMK]
706 [SCHSTR,<SETZ BYTMK>],[SASOC,ASMRK],[SINFO,INFMK]]
709 ;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER
711 DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG
713 ;HERE TO MARK LIST ELEMENTS
715 PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT
716 MOVEI C,(A) ;POINT TO LIST
717 PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS
719 JRST BDPAIR ;OUT OF BOUNDS,COMPLAIN
720 SKIPGE B,(C) ;SKIP IF NOT MARKED
721 JRST GCRET ;ALREADY MARKED, RETURN
724 HLRZS B ;TYPE TO RH OF B
725 MOVE A,1(C) ;DATUM TO A
726 JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER
727 PUSHJ P,MARK ;MARK THIS DATUM
728 HRRZ C,(C) ;GET CDR OF LIST
729 JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT
731 GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT
732 HLRZ C,-1(P) ;RESTORE C
734 POPJ P, ;AND RETURN TO CALLER
736 ;HERE TO SQUAWK WHEN A PAIR POINTER IS BAD
738 BDPAIR: MOVEI B,[ASCIZ /AGC -- MARKED PAIR POINTS OUTSIDE PAIR SPACE
744 ;HERE TO MARK DEFERRED POINTER
746 DEFDO: PUSHJ P,MARK ;MARK THE DATUM
747 JRST GCRET ;AND RETURN
750 ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE
752 TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG
753 VECTMK: TLZ TYPNT,400000
754 MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR
756 SUB A,B ;LOCATE DOPE WORD
757 MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD
758 CAMGE A,VECTOP ;CHECK BOUNDS
760 JRST VECTB1 ;LOSE, COMPLAIN
762 JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK
763 CAMN A,PPGROW ;CHECK PLANNER PDL
765 CAME A,PGROW ;IS THIS THE BLOWN P
766 CAMN A,TPGROW ;IS THIS THE GROWING PDL
767 JRST NOBUFR ;YES, DONT ADD BUFFER
768 ADDI A,PDLBUF ;POINT TO REAL DOPE WORD
769 MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER
772 NOBUFR: HLRZ B,(A) ;GET LENGTH FROM DOPE WORD
773 ANDI B,377777 ;CLOBBER POSSIBLE MARK BIT
774 MOVEI F,(A) ;SAVE A POINTER TO DOPE WORD
775 SUBI F,1(B) ;F POINTS TO START OF VECTOR
776 HRRZ 0,-1(A) ;SEE IF GROWTH SPECIFIED
777 JUMPE 0,NOCHNG ;NONE, JUST CHECK CURRENT SIZES
779 LDB B,[001100,,0] ;GET GROWTH FACTOR
780 TRZE B,400 ;KILL SIGN BIT AND SKIP IF +
782 ASH B,6 ;CONVERT TO NUMBER OF WORDS
783 SUB F,B ;BOTTOM IS LOWER IN CORE
784 LDB 0,[111100,,0] ;GET TOP GROWTH
785 TRZE 0,400 ;HACK SIGN BIT
787 ASH 0,6 ;CONVERT TO WORDS
788 ADD B,0 ;TOTAL GROWTH TO B
790 VECOK: HLRE E,(A) ;GET LENGTH AND MARKING
791 MOVEI F,(E) ;SAVE A COPY
793 SUBI E,2 ;- DOPE WORD LENGTH
794 IORM D,(A) ;MAKE SURE NOW MARKED
795 JUMPLE E,GCRET ;ALREADY MARKED OR ZERO LENGTH, LEAVE
797 SKIPGE B,-1(A) ;SKIP IF UNIFORM
798 TLNE B,377777 ;SKIP IF NOT SPECIAL
799 JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR
801 GENRAL: HLRZ 0,B ;CHECK FOR PSTACK
802 JUMPE 0,NOTGEN ;IT ISN'T GENERAL
803 SUBI A,1(E) ;POINT TO FIRST ELEMENT
804 ADDM F,VECNUM ;AND UPDATE VECNUM
805 MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C
807 ; LOOP TO MARK ELEMENTS IN A GENRAL VECTOR
809 VECTM2: HLRE B,(C) ;GET TYPE AND MARKING
810 JUMPL B,GCRET ;RETURN, (EITHER DOPE WORD OR FENCE POST)
811 MOVE A,1(C) ;DATUM TO A
812 CAIE B,TENTS ;IS THIS A SAVED FRAME?
813 CAIN B,TENTRY ;IS THIS A STACK FRAME
814 JRST MFRAME ;YES, MARK IT
815 CAIN B,TPDLS ;IGNORE SAVED PDL BLOCKS
817 CAIN B,TBIND ;OR A BINDING BLOCK
820 VECTM3: PUSHJ P,MARK ;MARK DATUM
824 MFRAME: HRROI C,FRAMLN+SPSAV-1(C) ;POINT TO SAVED SP
826 PUSHJ P,MARK1 ;MARK THE GOODIE
827 HRROI C,PSAV-SPSAV(C) ;POINT TO SAVED P
829 PUSHJ P,MARK1 ;AND MARK IT
830 HRROI C,TPSAV-PSAV(C) ;POINT TO SAVED TP
832 PUSHJ P,MARK1 ;MARK IT ALS
833 MOVEI C,PPSAV-TPSAV(C) ;POINT SAVED PP
836 MOVEI C,-PPSAV+1(C) ;POINT PAST THE FRAME
837 JRST VECTM2 ;AND DO MORE MARKING
840 MBIND: MOVEI B,TATOM ;FIRST MARK ATOM
843 VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE
845 MOVEI B,TILLEG ;GET ILLEGAL TYPE
847 MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE
848 JRST GCRET ;RETURN WITHOUT MARKING VECTOR
850 CCRET: CLEARM 1(C) ;CLOBBER THE DATUM
854 IGBLK: HRRZ B,(C) ;SKIP TO END OF PP BLOCK
856 JRST VECTM2
\f;ARG POINTER-- MARK ITS INFO CELL AND STACK
857 ARGMK: HRRZ A,(C) ;A POINTS TO INFO CELL
862 ; MARK FRAME POINTERS
864 FRMK: SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR
865 HRRZ A,1(C) ;USE AS DATUM
866 SUBI A,1 ;FUDGE FOR VECTMK
867 MOVEI B,TPVP ;IT IS A VECTRO
868 PUSHJ P,MARK ;MARK IT
873 BYTMK: HRRZ A,(C) ;POINT TO DOPE WD
874 SOJG A,VECTMK ;FUDGE DOPE WORD POINTER FOR VECTMK
877 MOVEI B,[ASCIZ /AGC -- BYTE POINTER WITH ZERO DOPE WORD POINTER
885 ATOMK: PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS
888 MOVE A,1(C) ;AND VALUE
889 ;******FUDGE UNTIL MIRE WINNAGE******
891 HRRZ E,(C) ;GOBBLE PROCESS ID
892 CAIN B,TUNBOUND ;IF NOT UNBOUND
893 JRST GCRET ;IS UNVOUND, IGNORE
894 SKIPN E ;SKIP IF NOT GLOBAL PROCESS
895 MOVEI B,TVEC ;IS GLOBAL, MARK AS A VECTOR
896 PUSHJ P,MARK ;AND MARK IT
897 JRST GCRET ;AND LEAVE
899 GETLNT: HLRE B,A ;GET -LNTH
900 SUB A,B ;POINT TO 1ST DOPE WORD
901 MOVEI A,1(A) ;POINT TO 2ND DOPE WORD
902 CAMGE A,VECTOP ;CHECK BOUNDS
904 JRST VECTB1 ;BAD VECTOR, COMPLAIN
906 HLRE B,(A) ;GET LENGTH AND MARKING
907 IORM D,(A) ;MAKE SURE MARKED
908 JUMPL B,GCRET1 ;MARKED ALREADY, QUIT
909 SUBI A,-1(B) ;POINT TO TOP OF ATOM
910 ADDM B,VECNUM ;UPDATE VECNUM
913 GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS
916 ; MARK NON-GENERAL VECTORS
918 NOTGEN: CAMN B,[GENERAL+<SPVP,,0>] ;PROCESS VECTOR?
919 JRST GENRAL ;YES, MARK AS A VECTOR
920 JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK
921 SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR
922 ADDM F,VECNUM ;INCREASE VECNUM
923 HLRZS B ;ISOLATE TYPE
924 MOVE F,B ; AND COPY IT
925 LSH B,1 ;FIND OUT WHERE IT WILL GO
926 HRRZ B,@TYPNT ;GET SAT IN B
927 MOVEI C,@MKTBS(B) ;POINT TO MARK SR
928 CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE
930 MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START
931 PUSH P,E ;SAVE NUMBER OF ELEMENTS
932 PUSH P,F ;AND UNIFORM TYPE
934 UNLOOP: MOVE B,(P) ;GET TYPE
935 MOVE A,1(C) ;AND GOODIE
936 TLO C,400000 ;CAN'T MUNG TYPE
937 PUSHJ P,MARK ;MARK THIS ONE
939 AOJA C,UNLOOP ;IF MORE, DO NEXT
941 SUB P,[2,,2] ;REMOVE STACK CRAP
945 SPECLS: MOVEI B,[ASCIZ /AGC -- UNRECOGNIZED SPECIAL VECTOR
949 \f; MARK ASSOCIATION BLOCKS
951 ASMRK: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER
952 PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS
953 GETYP B,(A) ;CHECK TYPE OF FIRST
955 JRST GCRET ;THIS IS THE DUMMY
956 MOVEI C,(A) ;COPY POINTER
957 PUSHJ P,MARK2 ;MARK ITEM CELL
958 ADDI C,INDIC-ITEM ;POINT TO INDICATOR
962 ADDI C,NODPNT-VAL-1 ;POINT TO NODE CHAIN
963 HRRZ A,1(C) ;DOES IT EXIST
966 PUSHJ P,MARK ;AND MARK IT
972 INFMK: HLRZS A ;GENERATE AOBJN POINTER TO END OF STACK
973 JRST VECTMK ;GO MARK IT
\f;HERE WHEN A VECTOR POINTER IS BAD
975 VECTB1: MOVEI B,[ASCIZ /AGC -- VECTOR POINTS OUTSIDE VECTOR SPACE
982 ; THIS PHASE REMOVES ANY UNWANTED ASSOCIATIONS ALSO PRESERVES DATA POINTED TO ONLY BY ASSOCIATIONS
983 ; RECEIVES POINTER TO ASSOCIATION VECTOR IN A
985 ASOMRK: SKIPN C,(A) ;DOES BUCKET CONTAIN ANYTHING
986 JRST ASOM3 ;NO, ;IGNORE
988 ASOM2: HRRE 0,ASOLNT+1(C) ;CHECK FOR CIRCULARITY
989 AOJE 0,ASOM6 ;ALREADY MARKED, LOSE
992 SKIPGE ASOLNT+1(C) ;IS THIS ONE POINTED AT?
993 JRST ASOM4 ;YES, GOODIES ALREADY MARKED
994 PUSHJ P,MARKQ ;SEE IF ITS ITEM IS MARKED
995 JRST ASOFLS ;NO, FLUSH THIS ASSOCIATION
996 MOVEI E,MARKQ ;POINT TO QUESTIONER
997 SKIPE NODPNT(C) ;SKIP IF NOT ON A CHAIN
998 MOVEI E,MARK23 ;ON CHAIN, MARK THE INDICATOR
999 MOVEI C,INDIC(C) ;POINT TO INDICATOR
1001 JRST ASOFL7 ;INDICATOR NOT MARKED
1002 MOVEI C,-INDIC(C) ;POINT BACK TO START
1004 ASOM1: PUSH P,C ;ITEM IS MARKED, MARK INDIC AND VAL AND ASSOC
1006 ADDI C,VAL ;POINT TO VAL
1008 IORM D,ASOLNT+1-VAL(C) ;MARK THE ASSOCIATION BLOCK
1012 ASOM4: MOVEI E,(C) ;INCASE NEED TO FLUSH CIRCULARITY
1013 HRRZ C,ASOLNT-1(C) ;POINT TO NEXT IN CHAIN
1014 JUMPN C,ASOM2 ;GO MARKK IT
1017 ASOM3: AOBJN A,ASOMRK ;GO ONTO NEXT BUCKET
1018 POPJ P, ;ALL MARKED, QUIT
1020 ;HERE TO FLUSH AN ASSOCIATION
1022 ASOFLS: HRRZ B,ASOLNT-1(C) ;GET FORWARD AND BACKWARD POINTERS
1024 JUMPN E,ASOFL1 ;JUMP IF PREV EXISTS
1025 HRRZM B,(A) ;CLOBBER VECTOR ENTRY
1028 ASOFL1: HRRM B,ASOLNT-1(E) ;CLOBBER PREVIOUS BLOCKKS NEXT
1029 JUMPE B,ASOM4 ;IF NEXT IS 0, DONE
1030 HRLM E,ASOLNT-1(B) ;ELSE CLOBBER NEXT'S PREVIOUS
1033 ASOM6: HLLZS (E) ;FORCE CIRCULARITY AWAY
1034 HRRZS (C) ;AND THE OTHERS PREV
1035 JRST ASOM3 ;AND FINISH THIS BUCKET
1038 PUSHJ P,MARK2 ;MARK IT
1042 ASOFL7: MOVEI C,ITEM-INDIC(C) ;RESET C
1043 JRST ASOFLS ;AND FLUSH
1045 ;SUBROUTINE TO SEE IF A GOODIE IS MARKED
1046 ;RECEIVES POINTER IN C
1047 ;SKIPS IF MARKED NOT OTHERWISE
1049 MARKQ: MOVE E,1(C) ;DATUM TO C
1050 HLRZ B,(C) ;TYPE TO B
1052 HRRZ B,@TYPNT ;GOBBLE SAT
1053 JRST @MQTBS(B) ;DISPATCH
1056 DISTBS MQTBS,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ]
1057 [STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SBYTE,BYTMK]
1058 [SATOM,VECMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ]]
1060 PAIRMQ: SKIPGE (E) ;SKIP IF NOT MARKED
1064 BYTMQ: HRRZ E,(C) ;GET DOPE WORD POINTER
1065 SOJA E,VECMQ1 ;TREAT LIKE VECTOR
1067 ARGMQ: HLRE F,E ;CHECK AM ARG POINTER
1068 SUB E,F ;POINT TO END OF ARG BLOCK
1069 HLRZ B,(E) ;GET TYPE
1070 CAIN B,TENTRY ;IS IT AN ENTRY
1071 MOVEI E,FRAMLN+1(E) ;MAKE INTO FRAME POINTER
1072 CAIN B,TTB ;IS IT A FRAME POINTER
1073 HRRZ E,1(E) ;PICK IT UP
1075 FRMQ: MOVE E,TPSAV(E) ;PICK UP A STACK POINTER
1077 VECMQ: HLRE F,E ;GET LENGTH
1078 SUB E,F ;POINT TO DOPE WORDS
1080 VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED
1081 AOS (P) ;MARKED, CAUSE SKIP RETURN
1088 ;RETIME PHASE -- CALLED IFF A FRAME TIME HAS OVERFLOWED
1089 ;RECEIVES POINTER TO STACK TO BE RECALIBRATED IN A
1090 ;LEAVES HIGHEST TIME IN TIMOUT
1092 RETIME: HLRE B,A ;GET LENGTH IN B
1093 SUB A,B ;COMPUTE DOPE WORD LOCATION
1094 MOVEI A,1(A) ;POINT TO 2D DOPE WORD AND CLEAR LH
1095 CAME A,TPGROW ;IS THIS ONE BLOWN?
1096 ADDI A,PDLBUF ;NO, POINT TO DOPE WORD
1097 LDB B,[222100,,(A)] ;GET LENGTH FIELD (IGNOREING MARK BIT
1098 SUBI A,-1(B) ;POINT TO PDLS BASE
1099 MOVEI C,1 ;INITIALIZE NEW TIMES
1101 RETIM1: SKIPGE B,(A) ;IF <0, HIT DOPE WORD OR FENCE POST
1103 HLRZS B ;ISOLATE TYPE
1104 CAIE B,TENTRY ;FRAME START?
1105 AOJA A,RETIM2 ;NO, TRY BINDING
1106 HRLM C,FRAMLN+OTBSAV(A) ;STORE NEW TIME
1107 ADDI A,FRAMLN ;POINT TO NEXT ELEMENT
1108 AOJA C,RETIM1 ;BUMP TIME AND MOVE ON
1110 RETIM2: CAIN B,TBIND ;BINDING?
1111 HRRM C,3(A) ;YES, STORE CURRENT TIME
1112 AOJA A,RETIM1 ;AND GO ON
1114 RETIM3: MOVEM C,TIMOUT ;SAVE TIME
1117 \f;CORE ADJUSTMENT PHASE -- SETS TOP OF CORE
1118 ;AND TOP OF VECTOR SPACE TO SIZE NEEDED FOR SUFFICIENT FREE SPACE TO BE ADDED TO
1119 ;ALLOW FOR "EFFICIENT" PROCESSING
1121 CORADJ: .SUSET [.RMEMT,,CORTOP] ;SET CORTOP FROM SYSTEM
1122 MOVE A,PARBOT ;GET ADDRESS OF BOTTOM OF MOVABLE CORE
1123 ADD A,PARNEW ;AND ADDJUST TO WHERE IT WILL BE
1124 ADD A,PARNUM ;ADD NUMBER OF PAIRS
1125 ADD A,PARNUM ;TWICE TO GET TOP OF PAIR SPACE.
1126 ADD A,VECNUM ;ADD NUMBER OF VECTOR WORDS
1127 ADD A,GETNUM ;AND NUMBER OF WORDS TO BE GOTTEN THIS TIME
1128 ADD A,FREMIN ;AND NUMBER OF FREE WORDS MINIMUM
1129 SUB A,CORTOP ;LESS CURRENT TOP OF CORE
1130 JUMPG A,CORAD2 ;IF GREATER THAN ZERO, MORE CORE NEEDED
1131 ADD A,FREDIF ;ADD IN DIFFERENCE BETWEEEN FREE AND GOT
1132 ADDI A,1777 ;ROUND UP TO NEXT BLOCK
1133 ANDCMI A,1777 ;AND DOWN TO A BLOCK BOUNDARY
1134 JUMPGE A,CORAD1 ;IF POSITIVE, NO CORE ADJUSTMENT NEEDED
1135 ADDB A,CORTOP ;CALCULATE NEG TOP OF CORE
1136 ASH A,-10. ;CONVERT TO BLOCKS
1137 MOVEM A,CORSET ;AND SET NUMBER OF BLOCKS
1138 CORAD1: MOVE A,CORTOP ;CALCU;ATE NEW TOP OF CORE
1139 SUB A,VECTOP ;FIND OFFSET FROM CURRENT VECTOR TOP
1140 MOVEM A,VECNEW ;AND SAVE AS NEW HOME OF VECTORS
1143 \f;HERE IF MORE CORE NEEDED, NO OF WDS IN A
1145 CORAD2: ADD A,CORTOP ;FIND TOP OF CORE
1146 ADDI A,1777 ;AND ROUND UPWARDS
1147 ASH A,-10. ;AND CONVERT TO NUMBER OF BLOCKS
1148 CAMLE A,SYSMAX ;COMPARE TO MAXIMUM ALLOWED
1150 .CORE (A) ;ASK OFR THE NEW SIZE
1151 PUSHJ P,CORAD4 ;FAILURE, GO COMPLAIN
1152 JRST CORADJ ;OK TRY AGAIN
1155 CORAD3: SKIPA B,[[ASCIZ /ATTEMPT TO EXPAND PAST MUDDLE LIMIT/]]
1156 CORAD4: MOVEI B,[ASCIZ /NO CORE AVAILABLE/]
1157 PUSH P,A ;SAVE AMOUNT ASKED FOR
1159 MOVEI B,[ASCIZ /PROCEED?/]
1165 POP P,A ;RESTORE AMOUNT
1166 POPJ P, ;AND GO BACK
1169 CORADL: .CORE (A) ;SET TO NEW CORE VALUE
1173 ;PARREL -- PAIR RELOCATION ESTABLISMENT
1174 ;ESTABLISH PAIR RELOCATION. CALLED WITH
1175 ;BOTTOM IN AC A, AND TOP IN AC B.
1177 PARRE0: SUBI B,2 ;MOVE POINTER BACK
1178 IORM D,(B) ;MARK THIS PAIR AS JUNK
1179 PARREL: CAIG B,(A) ;HAVE THE POINTERS MET?
1180 POPJ P, ;YES -- RETURN WITH NEW PARTOP IN B
1181 SKIPL C,-2(B) ;MARKED PAIR ON BOTTOM?
1182 JRST PARRE0 ;NO -- MOVE TOWARD BOTTOM
1183 PARRE1: SKIPGE (A) ;JUNK ON BOTTOM?
1184 JRST PARRE2 ;NO -- MOVE FORWARD
1185 MOVEM C,(A) ;STORE PAIR IN NEW LOCATION
1186 MOVE C,-1(B) ;GET DATUM
1187 MOVEM C,1(A) ;AND STORE IN NEW HOME
1188 HRROM A,-2(B) ;SET "BROKEN HEART" TO NEW HOME
1189 JRST PARRE0 ;AND CONTINUE
1190 PARRE2: ANDCAM D,(A) ;UNMARK PAIR
1191 ADDI A,2 ;GO ON TO NEXT PAIR
1192 CAIG B,(A) ;TEST TO SEE IF POINTERS MET
1193 POPJ P, ;YES -- DONE
1194 JRST PARRE1 ;KEEP LOOKING FORWARD
1196 \f;VECTOR RELOCATE --GETS VECTOP IN A
1198 ;FILLS IN RELOCATION FIELDS OF MARKED VECTORS
1199 ;AND REUTRNS FINAL VECNEW IN B
1201 VECREL: CAMG A,VECBOT ;PROCESSED TO BOTTOM OF VECTOR SPACE?
1202 POPJ P, ;YES, RETURN
1203 HLRE C,(A) ;GET COUNT FROM DOPE WD, EXTEND MARK BIT
1204 JUMPL C,VECRE1 ;IF MARKED GO PROCESS
1205 HLLZS (A) ;CLEAR RELOC FIELD
1206 ADDI B,(C) ;INCREMENT OFFSET
1207 SUBI A,(C) ;MOVE ON TO NEXT VECTOR
1208 SOJG C,VECREL ;AND KEEP SCANNING
1209 JSP D,VCMLOS ;LOSER, LEAVE TRACKS AS TO WHO LOST
1211 VECRE1: HRRZ E,-1(A) ;GOBBLE THE GROWTH FILEDS
1212 HRRM B,(A) ;STORE RELOCATION
1213 JUMPE E,VECRE2 ;NO GROWTH (OR SHRINKAGE), GO AWAY
1214 LDB F,[111100,,E] ;GET TOP GROWTH IN F
1215 TRZN F,400 ;CHECK AND FLUSH SIGN
1216 MOVNS F ;WAS ON, NEGATE
1217 ASH F,6 ;CONVERT TO WORDS
1218 ADD B,F ;UPDATE RELOCATION
1219 HRRM B,(A) ;AND STORE IT
1220 ANDI E,777 ;ISOLATE BOTTOM GROWTH
1221 TRZN E,400 ;CHECK AND CLEAR SIGN
1223 ASH E,6 ;CONVERT TO WORDS
1224 ADD B,E ;UPDATE FUTURE RELOCATIONS
1225 VECRE2: SUBI A,400000(C) ;AND MOVE ON TO NEXT VECTOR
1226 ANDI C,377777 ;KILL MARK
1227 SOJG C,VECREL ;AND KEEP GOING
1228 JSP D,VCMLOS ;LOSES, LEAVE TRACKS
1232 ;GETS PARBOT IN AC A
1233 ;UPDATES VALUES AND CDRS UP TO PARTOP
1235 PARUPD: CAML A,PARTOP ;ARE THERE MORE PAIRS TO PROCESS
1236 POPJ P, ;NO -- RETURN
1237 HRRZ C,(A) ;GET CURRENT CDR
1238 HLRZ B,(A) ;GET TYPE
1240 HRRZ B,@TYPNT ;NOW GET SAT
1241 SKIPGE MKTBS(B) ;SKIP IF IT HAS A CDR
1242 JRST PARUP1 ;NO CDR, DON'T UPDATE IT
1243 JUMPE C,PARUP1 ;IF NIL, DON'T UPDATE
1244 SKIPGE B,(C) ;GET POINTER UPDATE AND SKIP IF THIS IS NOT A BROKEN HEART
1245 HRRM B,(A) ;IT WAS, STORE NEW POINTER
1246 SKIPE B,PARNEW ;IF LIST SPACE IS MOVING,
1247 ADDM B,(A) ;THEN ADD OFFSET TO CDR
1250 PARUP1: HLRZ B,(A) ;SET RH OF B TO TYPE
1251 MOVE C,1(A) ;SET C TO VALUE
1252 PUSHJ P,VALUPD ;UPDATE THIS VALUE
1253 ADDI A,2 ;MOVE ON TO NEXT PAIR
1254 JRST PARUPD ;AND CONTINUE
1256 \f;VECTOR SPACE UPDATE
1258 ;UPDATES ALL VALUE CELLS IN MARKED VECTORS
1259 ;ESCAPES WHEN IT GETS TO VECBOT
1261 VECUPD: SUBI A,1 ;MAKE A POINT TO LAST DOPE WD
1262 VECUP1: CAMG A,VECBOT ;ANY MORE VECTORS TO PROCESS?
1263 JRST ENHACK ;PROCESS ALL ENTRY BLOCKS NOW
1264 SKIPGE B,(A) ;IS DOPE WORD MARKED?
1265 JRST VECUP2 ;YES -- GO PROCESS VALUES IN THIS VECTOR
1266 HLLZS -1(A) ;MAKE SURE NO GROWTH ATTEMPTS
1267 HLRZS B ;NO -- SET RH OF B TO SIZE OF VECTOR
1268 VECUP5: SUB A,B ;SET A TO POINT TO DOPE WD OF NEXT VECTOR
1269 JRST VECUP1 ;AND CONTINUE
1271 VECUP2: PUSH P,A ;SAVE DOPE WORD POINTER
1272 HLRZ B,(A) ;GET LENGTH OF THIS VECTOR
1273 VECU11: ANDI B,377777 ;TURN OFF MARK BIT
1274 SKIPGE E,-1(A) ;CHECK FOR UNIFORM OR SPECIAL
1275 TLNE E,377777 ;SKIP IF GENERAL
1276 JRST VECUP6 ;UNIFORM OR SPECIAL, GO DO IT
1277 VECU10: SUB A,B ;SET AC A TO NEXT DOPE WORD
1278 ADDI A,1 ;AND ADVANCE TO FIRST ELEMENT OF THIS VECTOR
1279 VECUP3: HLRZ B,(A) ;GET TYPE
1280 TRNE B,400000 ;IF MARK BIT SET
1281 JRST VECUP4 ;DONE WITH THIS VECTOR
1282 CAIN B,TENTS ;SAVED ENTRY BLOCK?
1284 CAIN B,TPDLS ;SAVED P BLOCK?
1286 CAIN B,TENTRY ;SPECIAL HACK FOR ENTRY
1288 CAIE B,TBVL ;VECTOR BINDING?
1289 CAIN B,TBIND ;AND BINDING BLOCK
1291 VECU15: MOVE C,1(A) ;GET VALUE
1292 PUSHJ P,VALUPD ;UPDATE THIS VALUE
1293 VECU12: ADDI A,2 ;GO ON TO NEXT VECTOR
1294 JRST VECUP3 ;AND CONTINUE
1296 VECUP4: POP P,A ;SET TO OLD DOPE WORD
1297 ANDCAM D,(A) ;TURN OFF MARK BIT
1298 HLRZ B,(A) ;GET LENGTH
1299 JRST VECUP5 ;GO ON TO NEXT VECTOR
1303 ;UPDATE A SAVED SAVE BLOCK
1304 ENTSUP: MOVEI A,FRAMLN+SPSAV-1(A) ;A POINTS BEFORE SAVED SP
1306 PUSHJ P,VALPD1 ;UPDATE SPSAV
1307 MOVEI A,PSAV-SPSAV(A)
1309 PUSHJ P,VALPD1 ;UPDATE PSAV
1310 MOVEI A,TPSAV-PSAV(A)
1312 PUSHJ P,VALPD1 ;UPDATE TPSAV
1313 MOVEI A,PPSAV-TPSAV(A)
1315 PUSHJ P,VALPD1 ;UPDATE PPSAV
1316 ;SKIP TO END OF BLOCK
1321 IGBLK2: HRRZ B,(A) ;GET DISPLACEMENT
1325 ; ENTRY PART OF THE STACK UPDATER
1327 ENTRUP: ADDI A,FRAMLN-2 ;POINT PAST FRAME
1328 JRST VECU12 ;NOW REJOIN VECTOR UPDATE
1330 ; UPDATE A BINDING BLOCK
1332 BINDUP: HRRZ C,(A) ;POINT TO CHAIN
1333 JUMPE C,NONEXT ;JUMP IF NO NEXT BINDING IN CHAIN
1334 ADD C,@(P) ;ADD RELOCATION OF SELF
1335 HRRM C,(A) ;AND STORE IT BACK
1336 NONEXT: CAIE B,TBIND ;SKIP IF VAR BINDING
1337 JRST VECU14 ;NO, MUST BE A VECTOR BIND
1338 MOVEI B,TATOM ;UPDATE ATOM POINTER
1341 HLRZ B,(A) ;TYPE OF VALUE
1343 ADDI A,2 ;POINT TO LOCATIVE POINTER
1344 HLRZ B,(A) ;GET TYPE
1348 VECU14: MOVEI B,TVEC ;NOW TREAT LIKE A VECTOR
1351 ; NOW SAFE TO UPDATE ALL ENTRY BLOCKS
1353 ENHACK: HRRZ F,TBSTO(LPVP) ;GET POINTER TO TOP FRAME
1354 HLLZS TBSTO(LPVP) ;CLEAR FIELD
1356 JUMPE F,LSTFRM ;FINISHED
1358 ENHCK1: MOVEI A,OTBSAV-1(F) ;POINT PRIOR TO SAVED TB
1359 HRRZ F,1(A) ;POINT TO PRIOR FRAME
1360 MOVEI B,TTB ;MARK SAVED TB
1362 MOVEI B,TAB ;MARK ARG POINTER
1363 PUSHJ P,[AOJA A,VALPD1]
1364 MOVEI B,TSP ;SAVED SP
1365 PUSHJ P,[AOJA A,VALPD1]
1366 MOVEI B,TPDL ;SAVED P STACK
1367 PUSHJ P,[AOJA A,VALPD1]
1368 MOVEI B,TTP ;SAVED TP
1369 PUSHJ P,[AOJA A,VALPD1]
1371 PUSHJ P,[AOJA A,VALPD1] ;MARK THE PP
1372 JUMPN F,ENHCK1 ;MARK NEXT ONE IF IT EXISTS
1374 LSTFRM: HRRZ A,PROCID(LPVP) ;NEXT PROCESS
1375 HLLZS PROCID(LPVP) ;CLOBBER
1377 JUMPN LPVP,ENHACK ;DO NEXT PROCESS
1378 ;NOW UPDATE DOPE WORD POINTERS IN ALL INFO CELLS
1379 INFHCK: JUMPE LINF,CPOPJ ;IF ANY
1380 HLRZ A,1(LINF) ;GET DOPE WORD ADDRESS
1381 HRRE B,1(A) ;GET RELOCATION
1383 HRLM A,1(LINF) ;UPDATE DOPE WORD ADDRESS
1385 HLLZS (LINF) ;GO ON TO NEXT INFO CELL
1388 ; UPDATE ELEMENTS IN UNIFROM AND SPECIAL VECTORS
1390 VECUP6: JUMPL E,VECUP7 ;JUMP IF SPECIAL
1391 HLRZS E ;ISOLATE TYPE
1392 EXCH E,B ;TYPE TO B AND LENGTH TO E
1393 SUBI A,(E) ;POINT TO NEXT DOPE WORD
1396 MOVE B,UPDTBS(B) ;FIND WHERE POINTS
1397 CAIN B,CPOPJ ;UNMARKED?
1398 JRST VECUP4 ;YES, GO ON TO NEXT VECTOR
1399 PUSH P,B ;SAVE SR POINTER
1400 SUBI E,2 ;DON'T COUNT DOPE WORDS
1402 VECUP8: SKIPE C,1(A) ;GET GOODIE
1403 PUSHJ P,@(P) ;CALL UPDATE ROUTINE
1405 SOJG E,VECUP8 ;LOOP FOR ALL ELEMNTS
1407 SUB P,[1,,1] ;REMOVE RANDOMNESS
1410 ; SPECIAL VECTOR UPDATE
1412 VECUP7: HLRZS E ;ISOLATE SPECIAL TYPE
1413 CAIN E,SATOM+400000 ;ATOM?
1414 JRST ATOMUP ;YES, GO DO IT
1415 CAIN E,STPSTK+400000 ;STACK
1416 JRST VECU10 ;TREAT LIKE A VECTOR
1417 CAIN E,SPVP+400000 ;PROCESS VECTOR
1418 JRST PVPUP ;DO SPECIAL STUFF
1420 JRST ASOUP ;UPDATE ASSOCIATION BLOCK
1422 MOVEI B,[ASCIZ /VECTOR UPDATE, ENCOUNTERED FUNNY SPECIAL VECTOR
1427 ; UPDATE ATOM VALUE CELLS
1429 ATOMUP: SUBI A,-1(B) ; POINT TO VALUE CELL
1431 HRRZ 0,(A) ;GOBBLE PROCID
1432 JUMPN 0,.+3 ;NOT GLOBAL
1433 CAIN B,TLOCI ;IS IT A LOCATIVE?
1434 MOVEI B,TVEC ;MARK AS A VECTOR
1435 PUSHJ P,VALPD1 ;UPDATE IT
1438 ; UPDATE PROCESS VECTOR
1440 PVPUP: SUBI A,-1(B) ;POINT TO TOP
1441 HRRM LPVP,PROCID(A) ;CHAIN ALL PROCESSES TOGETHER
1443 HRRZ 0,TBSTO+1(A) ;POINT TO CURRENT FRAME
1444 HRRM 0,TBSTO(A) ;SAVE
1445 HRRZ 0,TPSTO+1(A) ;0_SAVED TP POINTER
1447 SUBI 0,-1(B) ;0 _ POINTER TO OLD DOPE WORD
1452 ;THIS SUBROUTINE TAKES CARE OF UPDATING ASSOCIATION BLOCKS
1454 ASOUP: SUBI A,-1(B) ;POINT TO START OF BLOCK
1455 HRRZ B,ASOLNT-1(A) ;POINT TO NEXT
1457 HRRE C,ASOLNT+1(B) ;AND GET ITS RELOC IN C
1458 ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED PONTER
1459 ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER
1461 HRLZ F,ASOLNT+1(B) ;AND ITS RELOCATION
1462 ADDM F,ASOLNT-1(A) ;RELOCATE
1463 ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN
1465 HRRE C,ASOLNT+1(B) ;GET RELOC
1466 ADDM C,NODPNT(A) ;ANID UPDATE
1467 ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER
1469 HRLZ F,ASOLNT+1(B) ;RELOC
1471 ASOUP5: HRLI A,-3 ;SET TO UPDATE OTHER CONTENTS
1473 ASOUP3: HLRZ B,(A) ;GET TYPE
1474 PUSHJ P,VALPD1 ;UPDATE
1475 ADD A,[1,,2] ;MOVE POINTER
1477 JRST VECUP4 ;AND QUIT
1479 \f;VALUPD UPDATES A SINLE VALUE FROM EITHER PAIR SPACE OR VECTOR SPACE
1480 ;GETS POINTER TO TYPE CELL IN RH OF A
1481 ;TYPE IN RH OF B (LH MUST BE 0)
1484 VALPD1: MOVE C,1(A) ;GET VALUE TO UPDATE
1485 VALUPD: TRNN C,-1 ;ANY POINTER PART?
1486 JRST CPOPJ ;NO, LEAVE
1487 LSH B,1 ;SET TYPE TIMES 2
1488 HRRZ B,@TYPNT ;GET STORAGE ALLOCATION TYPE
1489 JRST @UPDTBS(B) ;AND DISPATCH THROUGH STORAGE ALLOCATION DISPATCH TABLE
1493 DISTBS UPDTBS,CPOPJ,[[S2WORD,2WDUP],[S2DEFR,2WDUP],[SNWORD,NWRDUP],[STPSTK,STCKUP]
1494 [SFRAME,FRAMUP],[STBASE,TBUP],[SARGS,ARGUP],[SBYTE,BYTUP],[SATOM,NWRDUP],[SPSTK,STCKUP]
1495 [SPVP,NWRDUP],[S2NWORD,NWRDUP],[SABASE,ABUP],[SCHSTR,BYTUP],[SASOC,ASUP],[SINFO,INFUP]]
1500 ;PAIR POINTER UPDATE
1501 2WDUP: TRNN C,-1 ;POINT TO NIL?
1502 POPJ P, ;YES -- NO UPDATE NEEDED
1503 SKIPGE B,(C) ;NO -- IS THIS A BROKEN HEART
1504 HRRM B,1(A) ;YESS -- STORE NEW VALUE
1505 SKIPE B,PARNEW ;IF LIST SPACE IS MOVING
1506 ADDM B,1(A) ;THEN ADD OFFSET TO VALUE
1510 ; HERE TO UPDATE ASSOCIATIONS
1512 ASUP: HRLI C,-ASOLNT ;MAKE INTO VECTOR POINTER
1514 \f;VECTOR, ATOM, STACK, AND BASE POINTER UPDATE
1516 LOCUP: HRRZ B,(A) ;CHECK IF IT IS TIMED
1517 JUMPN B,LOCUP1 ;JUMP IF TIMED, OTHERWISE TREAT LIKE VECTORE
1519 NWRDUP: HLRE B,C ;EXTEND COUNT IN B
1520 SUBI C,-1(B) ;SET C TO POINT TO DOPE WORD
1521 HRRE B,(C) ;EXTEND RELOCATION IN B
1522 ADDM B,1(A) ;AND ADD RELOCATION TO STORED DATUM
1523 HRRZ C,-1(C) ;GET GROWTH SPECS
1524 JUMPE C,CPOPJ ;NO GROWTH, LEAVE
1525 LDB C,[111100,,C] ;GET UPWORD GROWTH
1526 TRZN C,400 ;FLUSH SIGN AN NEGATR DIRECTION
1528 ASH C,6+18. ;TO LH AND TIMES 100(8)
1529 ADDM C,1(A) ;UPDATE POINTER
1534 STCKUP: MOVSI B,PDLBUF ;GET OFFSET FOR PDLS
1535 ADDM B,1(A) ;AND ADD TO COUNT
1536 JRST NWRDUP ;NOW TREAT LIKE VECTOR
1538 BYTUP: HRRZ C,(A) ;SET C TO POINT TO DOPE WD
1539 HRRE B,(C) ;SET B TO RELOCATION FOR THIS VEC
1540 ADDM B,(A) ;UPDATE DOPE WD POINTER
1541 ADDM B,1(A) ;AND UPDATE VALUE
1542 POPJ P, ;DONE WITH UPDATE
1544 ARGUP: HRRZ B,(A) ;GET INFO CELL
1545 SKIPGE C,(B) ;BROKEN HEART?
1547 SKIPE C,PARNEW ;LISTS MOVING?
1550 HLRZ C,1(B) ;GET DOPE WORD ADDRESS
1551 JRST ABUP1 ;UPDATE ARGS POINTER
1552 ABUP: HLRE B,C ;GET LENGTH
1553 SUB C,B ;POINT TO FRAME
1554 HLRZ B,(C) ;GET TYPE OF NEXT GOODIE
1555 CAIN B,TENTRY ;IS IT A FRAME?
1556 JRST ABUP2 ;YES, ADD FRAMLN
1557 HRRZ C,1(C) ;NO-- GET TTB
1559 ABUP2: ADDI C,FRAMLN
1560 TBUP: MOVE C,TPSAV(C) ;GET A ASTACK POINTER TO FIND DOPE WORD
1561 HLRE B,C ;UPDATE BASED ON THIS POINTER
1563 ABUP1: HRRE B,1(C) ;GET RELOCATION
1564 ADDM B,1(A) ;AND MUNG POINTER
1567 FRAMUP: HRRZ B,(A) ;UPDATE PVP
1572 SUBI B,-1(C) ;ADDRESS OF PV
1573 HRRZ C,TPSTO(B) ;IF TPSTO HAS OLD TP DOPE WORD,
1574 SOJN C,ABUP1 ;USE IT
1575 HRRZ C,TPSTO+1(B) ;ELSE, GENERATE IT
1579 ;STRING INFO CELLS TOGETHER UNTIL THE END
1580 INFUP: HRRM LINF,(A)
1583 ;VECTOR SHRINKING PHASE
1585 VECSH: SUBI A,1 ;POOINT TO 1ST DOPE WORD
1586 VECSH1: CAMGE A,VECBOT ;FINISHED
1588 HRRZ B,-1(A) ;GET A SPEC
1589 JUMPE B,NXTSHN ;IGNORE IF NONE
1590 PUSHJ P,GETGRO ;GET THE SPECS
1591 JUMPGE C,SHRNBT ;SHRINKIGN AT BOTTOM
1592 MOVEI E,(A) ;COPY POINTER
1593 ADD A,C ;POINT TO NEW DOPE LOCATION WITH E
1594 MOVE F,-1(E) ;GET OLD DOPE
1595 ANDCMI F,777000 ;KILL THIS SPEC
1596 MOVEM F,-1(A) ;STORE
1597 MOVE F,(E) ;OTHER DOPE WORD
1599 ADD F,C ;CHANGE LENGTH
1600 MOVEM F,(A) ;AND STORE
1602 HLLZM C,(E) ;AND STORE
1604 SHRNBT: JUMPGE B,NXTSHN ;GROWTH, IGNOORE
1605 MOVM E,B ;GET A POSITIVE COPY
1607 ADDM B,(A) ;ADD INTO DOPE WORD
1608 MOVEI 0,777 ;SET TO CLOBBER GROWTH
1609 ANDCAM 0,-1(A) ;CLOBBER
1610 HLRZ B,(A) ;GET NEW LENGTH
1611 SUBI A,(B) ;POINT TO LOW END
1615 NXTSHN: HLRZ B,(A) ;GET LENGTH
1616 JUMPE B,VCMLOS ;LOOSE
1620 GETGRO: LDB C,[111100,,B] ;GET UPWARD GROWTH
1621 TRZE C,400 ;CHECK AND MUNG SIGN
1624 ANDI B,777 ;AND GET DOWN GROWTH
1625 TRZE B,400 ;CHECK AND MUNG SIGN
1629 \f;VECMOV -- MOVES VECTOR DATA TO WHERE RELOC FIELDS OF
1630 ;VECTORS INDICATE. MOVES DOPEWDS UP FOR VECTORS GROWING AT
1632 ;CALLED WITH VECTOP IN A. CALLS PARMOV TO MOVE PAIRS
1634 VECMOV: SUBI A,1 ;SET A TO ADDR OF TOP DOPE WD
1635 MOVSI D,400000 ;NEGATIVE D MARKS END OF BACK CHAIN
1636 MOVEI TYPNT,0 ;CLEAR ON GOING ADDRESS FOR FORWARD RESUME
1637 VECMO1: CAMGE A,VECBOT ;GOT TO BOTTOM OF VECTORS
1638 JRST PARMOV ;YES, MOVE LIST ELEMENTS AND RETURN
1639 MOVEI C,(A) ;NO, COPY ADDR OF THIS DOPEWD
1640 HRRE B,(A) ;GET RELOCATION OF THIS VECTOR
1641 JUMPL B,VECMO5 ;IF MOVING DOWNWARD, MAKE BACK CHAIN
1642 JUMPE B,VECMO4 ;IF NON MOVER, JUST ADJUST DOPW AND MOVE ON
1644 ADDI C,(B) ;SET ADDR OF LAST DESTINATION WD
1645 HRLI B,A ;MAKE B INDEX ON A
1646 HLL A,(A) ;COUNT TO A LEFT HALF
1648 POP A,@B ;MOVE A WORD
1649 TLNE A,-1 ;REACHED END OF MOVING
1650 JRST .-2 ;NO, REPEAT
1651 ;YES, NOTE A HAS ADDR OF NEXT DOPEWD
1652 ;HERE TO ADJUST LOCATION OF DOPEWDS FOR GROWTH (FORWARDLY)
1653 VECMO2: LDB B,[111000,,-1(C)] ;GET HIGH GROWTH FIELD
1654 JUMPE B,VECMO3 ;IF NO GROWTH, DONT MOVE
1655 ASH B,6 ;EXPRESS GROWTH IN WORDS
1656 HRLI C,2 ;SET COUNT FOR POPPING 2 DOPEWDS
1657 HRLI B,C ;MAKE B INDEX ON C
1658 POP C,@B ;MOVE PRIME DOPEWD
1659 POP C,@B ;MOVE AUX DOPEWD
1660 VECMO3: JUMPL D,VECMO1 ;IF NO BACK CHAIN THEN MOVE ON
1661 JRST VECMO6 ;YES, BACKCHAINING, CONTINUE SAME
1663 ;HERE TO SKIP OVER STILL VECTORS (FORWARDLY)
1664 VECMO4: HLRZ B,(A) ;GET SIZE OF UNMOVER
1665 SUBI A,(B) ;UPDATE A TO NEXT VECTOR
1666 JRST VECMO2 ;AND GO CLEAN UP GROWTH
1667 \f;HERE TO ESTABLISH A BACKWARDS CHAIN
1668 VECMO5: EXCH D,(A) ;CHAIN FORWARD
1670 SUBI A,(B) ;GO ON TO NEXT VECOTR
1671 CAMGE A,VECBOT ;HAVE WE GOT TO END OF VECTORS?
1672 JRST VECMO7 ;YES, GO MOVE PAIRS AND UNCHAIN
1673 HRRE B,(A) ;GET RELOCATION OF THIS VECTOR
1674 JUMPLE B,VECMO5 ;IF NOT POSITIVE, CONTINUE CHAINING
1675 MOVEM A,TYPNT ;SAVE ADDR FOR FORWARD RESUME
1677 ;HERE TO UNCHAIN A VECTOR, MOVE IT, AND ADJUST DOPEWDS
1678 VECMO6: HLRZ B,D ;GET SIZE
1679 MOVEI F,1(A) ;GET A COPY OF BEGINNING OF VECTOR
1680 ADDI A,(B) ;SET TO POINT TO ADDR OF DOPEWD CURRENTLY IN D
1681 EXCH D,(A) ;AND UNCHAIN
1682 HRRE B,(A) ;GET RELOCATION FOR THIS VECTOR
1683 MOVEI C,(A) ;COPY A POINTER TO DOPEW
1684 SKIPGE D ;HAVE WE REACHED THE TOP OF THE CHAIN?
1685 MOVE A,TYPNT ;YES, RESTORE FORWARD MOVE RESUME ADDR
1686 JUMPE B,VECMO2 ;IF STILL VECTOR,GO ADJUST DOPEWDS
1687 ADDI C,(B) ;MAKE C POINT TO NEW DOPEW ADDR
1688 ADDI B,(F) ;B RH NEW 1ST WORD
1689 HRLI B,(F) ;B LH OLD 1ST WD ADDR
1690 BLT B,(C) ;COPY THE DATA
1691 JRST VECMO2 ;AND GO ADJUST DOPEWDS
1693 ;HERE TO STOP CHAINING BECAUSE OF BOTTOM OF VECTOR SPACE
1694 VECMO7: MOVEM A,TYPNT
1700 \f;PAIR MOVEMENT PHASE -- USES PARNEW,PARBOT, AND PARTOP TO MOVE PAIRS
1703 PARMOV: SKIPN A,PARNEW ;IS THERE ANY PAIR MOVEMENT?
1705 JUMPL A,PARMO2 ;YES -- IF MOVING DOWNWARDS, GO DO A BLT
1706 HRLI A,B ;MOVING UPWARDS SETAC A TO INDEX OFF AC B
1707 MOVE B,PARTOP ;GET HIGH PAIR ADDREESS
1708 SUB B,PARBOT ;AND SUBTRACT BOTTOM TO GET NUMBER OF PAIRS
1709 HRLZS B ;PUT COUNT IN LEFT HALF
1710 HRR B,PARTOP ;GET HIGH ADDRESS PLUS ONE IN RH
1711 SUBI B,1 ;AND SUBTRACT ONE TO POINT TO LAST WORD TO BE MOVED
1713 PARMO1: TLNN B,-1 ;HAS COUNT REACHED ZERO?
1714 JRST PARMO3 ;YES -- FINISH UP
1715 POP B,@A ;NO -- TRANSFER2Y
\eU NEXT WORD
1716 JRST PARMO1 ;AND REPEAT
1718 PARMO2: MOVE B,PARBOT ;GET ADDRESS OF FIRST SOURCE WD
1719 HRLS B ;IN BOTH HALVES OF AC B
1720 ADD B,A ;MAKE RH OF B POINT TO FIRST DESTINATION WORD
1721 ADD A,PARTOP ;MAKE RH OF A POINT TO LAST DESTINATION WORD PLUS ONE
1722 BLT B,-1(A) ;AND TRANSFER THE BLOCK OF PAIRS
1724 PARMO3: MOVE A,PARNEW ;GET OFFSET FOR PAIR SPACE
1725 ADDM A,PARBOT ;AND CORRECT BOTTOM
1726 ADDM A,PARTOP ;AND CORRECT TOP.
1727 SETZM PARNEW ;CLEAR SO IF CALLED TWICE, NO LOSSAGE
1729 \f;VECZER -- CLEARS DATA IN AREAS JUST GROWN
1730 ;UPDATES SIZE OF VECTORS
1731 ;CLEARS RELOCATION AND GROWTH FIELDS IN DOPEWDS
1732 ;CALLED WITH NEW VECTOP IN A (VECBOT SHOULD BE NEW TOO)
1734 VECZER: SUBI A,1 ;MAKE A POINT TO HIGH VECTORS
1735 VECZE1: CAMGE A,VECBOT ;REACHED BOTTOM OF VECTORS?
1736 POPJ P, ;YES, RETURN
1737 HLLZS F,(A) ;NO, CLEAR RELOCATION GET SIZE
1738 HLRZS F ;AND PUT SIZE IN RH OF F
1739 HRRZ B,-1(A) ;GET GROWTH INTO B
1740 JUMPN B,VECZE3 ;IF THERE IS SOME GROWTH, GO DO IT
1741 VECZE2: SUBI A,(F) ;GROWTH DONE, MOVE ON TO NEXT VECTOR
1742 JRST VECZE1 ;AND REPEAT
1744 VECZE3: HLLZS -1(A) ;CLEAR GROWTH IN THE VECTOR
1745 LDB C,[111000,,B] ;GET HIGH ORDER GROWTH IN C
1746 ANDI B,377 ;AND LIMIT B TO LOW SIDE
1747 ASHC B,6 ;EXPRESS GROWTH IN WORDS
1748 JUMPE C,VECZE4 ;IF NO HIGH GROWTH SKIP TO LOW GROWTH
1749 ADDI F,(C) ;ADD HIGH GROWTH TO SIZE
1750 SUBM A,C ;GET ADDR OF 2ND WD TO BE ZEROED
1751 SETZM -1(C) ;CLEAR 1ST WORD
1752 HRLI C,-1(C) ;MAKE C A CLEARING BLT POINTER
1753 BLT C,-2(A) ;AND CLEAR HIGH END DATA
1754 \rVECZE4: JUMPE B,VECZE5 ;IF NO LOW GROWTH SKIP TO SIZE UPDATE
1755 MOVNI C,(F) ;GET NEGATIVE SIZE SO FAR
1756 ADDI C,(A) ;AND MAKE C POINT TO LAST WORD OF STUFF TO BE CLEARED
1757 ADDI F,(B) ;UPDATE SIZE
1758 SUBM C,B ;MAKE B POINT TO LAST WD OF NEXT VECT
1759 ADDI B,2 ;AND NOW TO 2ND DATA WD TO BE CLEARED
1760 SETZM -1(B) ;CLEAR 1ST DATA WD
1761 HRLI B,-1(B) ;MAKE B A CLEARING BLT POINTER
1762 BLT B,(C) ;AND CLEAR THE LOW DATA
1763 \rVECZE5: HRLZM F,(A) ;STORE THE NEW SIZE IN DOPEWD
1766 ;SUBROUTINE TO REBUILD THE NOW DEFUNCT HASH TABLE
1768 REHASH: MOVE TVP,TVPSTO+1(PVP) ;RESTORE TV POINTER
1769 MOVE D,ASOVEC+1(TVP) ;GET POINTER TO VECTOR
1771 PUSH P,E ;PUSH A POINTER
1772 HLRE A,D ;GET -LENGTH
1773 MOVMS A ;AND PLUSIFY
1774 PUSH P,A ;PUSH IT ALSO
1776 REH3: HRRZ C,(D) ;POINT TO FIRST BUCKKET
1777 HLRZS (D) ;MAKE SURE NEW POINTER IS IN RH
1778 JUMPE C,REH1 ;B
\0UCKET EMPTY, QUIT
1780 REH2: MOVEI E,(C) ;MAKE A COPY OF THE POINTER
1781 MOVE A,ITEM(C) ;START HASHING
1785 MOVMS A ;MAKE SURE FINAL HASH IS +
1786 IDIV A,(P) ;DIVIDE BY TOTAL LENGTH
1787 ADD B,-1(P) ;POINT TO WINNING BUCKET
1789 MOVE C,[002200,,(B)] ;BYTE POINTER TO RH
1790 CAILE B,(D) ;IF PAST CURRENT POINT
1791 MOVE C,[222200,,(B)] ;USE LH
1792 LDB A,C ;GET OLD VALUE
1793 DPB E,C ;STORE NEW VALUE
1794 HRRZ B,ASOLNT-1(E) ;GET NEXT POINTER
1795 HRRZM A,ASOLNT-1(E) ;AND CLOBBER IN NEW NEXT
1796 SKIPE A ;SKKIP IF NOTHING PREVIOUSLY IN BUCKET
1797 HRLM E,ASOLNT-1(A) ;OTHERWISE CLOBBER
1798 SKIPE C,B ;SKIP IF END OF CHAIN
1802 SUB P,[2,,2] ;FLUSH THE JUNK
1804 \fVCMLOS: MOVEI B,[ASCIZ /AGC -- VECTOR WITH ZERO IN DOPE WORD LENGTH
1810 GETNUM: 0 ;NO OF WORDS TO GET
1811 PARNUM: 0 ;NO OF PAIRS MARKED
1812 VECNUM: 0 ;NO OF WORDS IN MARKED VECTORS
1813 CORSET: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY
1814 CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY
1816 ;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE,
1817 ;AND WHEN IT WILL GET UNHAPPY
1819 SYSMAX: 50. ;MAXIMUM SIZE OF MUDDLE
1820 FREMIN: 1000 ;MINIMUM FREE WORDS
1821 FREDIF: 10000 ;DIFFERENCE BETWEEN FREMIN AND MAXIMUM NUMBER OF FREE WORDS
1822 ;POINTER TO GROWING PDL
1824 TPGROW: 0 ;POINTS TO A BLOWN TP
1825 PPGROW: 0 ;POINTS TO A BLOWN PP
1826 TIMOUT: 0 ;POINTS TO TIMED OUT PDL
1827 PGROW: 0 ;POINTS TO A BLOWN P