> )> ) (ALLOC-ATOM <2 .L>) (END-ATOM <3 .L>) (NEXT-ATOM <4 .L>) (BOUNDS-ATOM <5 .L>) (RES <7 .L>) RLEN STK? ALLOCADDR ENDADDR (BOUNDS-LAB ) (IB-LAB ) (F-LAB ) (EXIT-LAB ) (M-LAB ) (F1 ) (B1 ) (HINT )) #DECL ((END-ATOM ALLOC-ATOM BOUND-ATOM NEXT-ATOM) !

(HINT) (RLEN) FIX (L) LIST) XGLOC>>> XGLOC>>> RECORD-TYPE>> >)> >) (<==? .HINT GBIND> >) (<==? .HINT LBIND> ) (T )> > ;"See if this guy is on the stack" > > > )> > >)> > >)> > > > > )> > > > '(O1*)> > ;"Jump if already marked" > > )> > >)> >> >)> > > '(O1*)> > >)> ) (ELSE >)>> ) (ALLOC-ATOM <2 .L>) (END-ATOM <3 .L>) (NEXT-ATOM <4 .L>) (RES <6 .L>)) #DECL ((L) LIST) > ;"Byte pointer to dope words." ;"A1* points one before dopeword." ;"A2* added to new dw pntr wins" > ) (ALLOC-ATOM <2 .L>) (END-ATOM <3 .L>) (NEXT-ATOM <4 .L>) (RES <6 .L>)) #DECL ((L) LIST) > > ; "Call this guy with A1* pointing to dope word and A2* being what is added to new dw pointer to win. All ACs are available" ) (F-LAB ) (F1 )) #DECL ((VAR RES) ATOM (NEXT-ATOM ALLOC-ATOM END-ATOM) !) XGLOC>>> XGLOC>>> ;"Pointers to GVAL slots for AL and END-SPACE" ;"Check and set mark bit" > ;"Jump if marked" ;"Store back with mark bit" ;"Add 2 to length for total words" ;"Point to ALLOC slot" ;"Possible new ALLOC" ;"Now compare with end" > ;"Jump if will fit" ;"Make O* be # words again" ;"Save useful stuff" >)> )> > ;"Pass space needed to NEXT-ATOM" >)> ;"Restore stuff" ;"O* is new ALLOC" >)> ;"Store new ALLOC" ;"Now point to first dw." ;"Store relocation" ;"Copy for XBLT" > > >)>) (ELSE > >)>> ) (ALLOC-ATOM <2 .L>) (END-ATOM <3 .L>) (NEXT-ATOM <4 .L>) (MARK-ATOM <5 .L>) (RES <7 .L>) ENDADDR ALLOCADDR (NF-LAB ) (F-LAB ) (F1 ) (LOOP-LAB ) (NM-LAB ) (F2 ) (DONE-LAB ) (M-LAB )) #DECL ((END-ATOM ALLOC-ATOM NEXT-ATOM MARK-ATOM) ! (L) LIST) XGLOC>>> XGLOC>>> ;"Pointers to GVAL slots for AL and END-SPACE" > ;"To number of words" > ;"A1* is #words, A2* 1st dw" ;"Check marking" > ;"Allocate temps" >)> ;"Mark bit on" ;"O2 total size with dw" ;"Compute new ALLOC" ;"Skip if area full" > )> > >)> ;"Call to use next AREA" ;"Store new ALLOC" ;"Fudge for dw" ;"Store new loc" ;"Store new dw not marked" ;"Number of elements" > > )> >)> > >)> > >)>) (ELSE > >)>> ) (ALLOC-ATOM <2 .L>) (END-ATOM <3 .L>) (NEXT-ATOM <4 .L>) (BOUNDS-ATOM <5 .L>) (MARK-ATOM <6 .L>) (LN ) (RES ) ENDADDR ALLOCADDR (M-LAB ) (DONE-LAB ) (LOOP-LAB ) (F-LAB ) (NB-LAB ) (MC-LAB ) (F1 ) (F2 ) (F3 ) (UNDO-ABLE <>)) #DECL ((LN) FIX (L) LIST (BOUNDS-ATOM MARK-ATOM NEXT-ATOM ALLOC-ATOM END-ATOM) !) <7 .L>> )> ;"UNDO-ABLE being true means old cdr clobbers new type word so its not lost if the world has to be undone" XGLOC>>> XGLOC>>> ;"Pointers to GVAL slots for AL and END-SPACE" >)> > > ;"Mark bit set, need to hack this up." > )> > > >)> ;"Pick up pointer to previous cell" ;"Fix up cdr pointer in previous cell" ;"New previous cell pointer" ;"Pick up cdr pointer" ;"Relocation for old cell" ;"Make sure new cell doesn't have garbage in cdr slot" ;"Clear mark bit in CAR" ;"See if car's type needs marking" ;"Save old cdr pointer" > )> >)> ;"Mark the guy" ;"Save old CDR...KLUDGE" ) (ELSE )> > ;"All done if empty cdr" )> > >)> ;"Check bounds of list cdr" > ;"Loop back if in bounds" > ;"Pick up pointer to last cell" > ;"None, just clean up and leave" ;"Clean up last cell" >)> > >)>) (ELSE >)>>