--- /dev/null
+<MSETG BIT0 1>
+<MSETG BIT1 2>
+<MSETG BIT2 4>
+<MSETG BIT3 8>
+<MSETG BIT4 16>
+<MSETG BIT5 32>
+
+<MSETG ADDR-MASK-2 3>
+
+<MSETG SHORT-MARK-BIT <CHTYPE <LSH 1 7> FIX>>
+
+<MSETG MARK-BIT <CHTYPE <LSH 1 15> FIX>>
+
+<MSETG DOPE-BIT <CHTYPE <LSH 1 5> FIX>>
+
+<MSETG FLEN 28>
+
+<MSETG LIST-LEN 12>
+<MSETG ATOM-LEN 20>
+<MSETG GBIND-LEN 20>
+<MSETG LBIND-LEN 32>
+
+<DEFINE GCTEMP (NUM)
+ <MA-DISP ,AC-TP <* .NUM -4>>>
+
+<DEFINE CGC-RECORD-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM BOUNDS-ATOM RES
+ "OPTIONAL" (HINT <>) "AUX" RLEN STK? ALLOCADDR ENDADDR
+ (BOUNDS-LAB <MAKE-LABEL>) (IB-LAB <MAKE-LABEL>)
+ (F-LAB <MAKE-LABEL>) (EXIT-LAB <MAKE-LABEL>)
+ (M-LAB <MAKE-LABEL>))
+ <COND (.HINT
+ <SET HINT <PARSE-HINT .HINT RECORD-TYPE>>)>
+ <COND (<==? .HINT ATOM>
+ <SET RLEN ,ATOM-LEN>
+ <SET STK? <>>)
+ (<==? .HINT GBIND>
+ <SET RLEN ,GBIND-LEN>
+ <SET STK? <>>)
+ (<==? .HINT LBIND>
+ <SET RLEN ,LBIND-LEN>
+ <SET STK? T>)
+ (T
+ <ERROR BAD-HINT-FOR-CGC-RECORD!-ERRORS .HINT CGC-RECORD-GEN>)>
+ <MAPF <>
+ <FUNCTION (X) <MUNG-AC ,.X>>
+ '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
+ <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
+ <SET ALLOCADDR
+ <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
+ <COND (.STK?
+ <EMIT ,INST-CMPL <MA-REG ,AC-TP> <VAR-VALUE-ADDRESS .VAR>>
+ ; "See if this guy is on the stack"
+ <EMIT-BRANCH ,INST-BLSS .BOUNDS-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVQ <MA-DISP ,AC-M <ADD-MVEC <>>> <MA-REG ,AC-0>>
+ <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
+ <EMIT-LABEL .BOUNDS-LAB T>
+ <FRAME-GEN .BOUNDS-ATOM>
+ <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAR> <MA-AINC ,AC-TP>>
+ <CALL-GEN .BOUNDS-ATOM 1>
+ <EMIT ,INST-TSTL <MA-REG ,AC-1>>
+ <EMIT-BRANCH ,INST-BNEQ .IB-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-0>>
+ <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
+ <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
+ <EMIT-LABEL .IB-LAB T>)>
+ <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
+ <EMIT ,INST-TSTB <MA-DISP ,AC-1 <+ .RLEN 1>>>
+ <EMIT-BRANCH ,INST-BGEQ .M-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
+ <EMIT ,INST-MOVL <MA-DISP ,AC-1 <+ .RLEN 4>> <MA-REG ,AC-1>>
+ <EMIT-BRANCH ,INST-BRB .EXIT-LAB <> ,LAST-INST-LENGTH>
+ ; "Jump if already marked"
+ <EMIT-LABEL .M-LAB T>
+ <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-1 <+ .RLEN 1>>>
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>
+ <EMIT ,INST-ADDL3 <MA-IMM <+ .RLEN 8>> <MA-REG ,AC-3> <MA-REG ,AC-6>>
+ <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
+ <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
+ <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
+ <FRAME-GEN .NEXT-ATOM>
+ <EMIT-PUSH <TYPE-WORD FIX> LONG>
+ <EMIT ,INST-MOVL <MA-IMM <+ .RLEN 8>> <MA-AINC ,AC-TP>>
+ <CALL-GEN .NEXT-ATOM 1>
+ <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>>
+ <EMIT ,INST-ADDL3 <MA-IMM <+ .RLEN 8>> <MA-REG ,AC-3> <MA-REG ,AC-6>>
+ <EMIT-LABEL .F-LAB T>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-DISP ,AC-1 <+ .RLEN 4>>>
+ <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
+ <EMIT ,INST-MOVQ <MA-DISP ,AC-1 .RLEN> <MA-DISP ,AC-3 .RLEN>>
+ <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 <+ .RLEN 1>>>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-REG ,AC-1>>
+ <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-0>>
+ <EMIT-LABEL .EXIT-LAB T>
+ <COND (<==? .RES STACK>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-0><MA-AINC ,AC-TP>>)
+ (T
+ <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
+ NORMAL>
+
+<DEFINE CGC-STBYTE-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES)
+ <MAPF <>
+ <FUNCTION (X) <MUNG-AC ,.X>>
+ '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
+ <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-0>>
+ <EMIT ,INST-ADDL3 <MA-REG ,AC-0> <VAR-VALUE-ADDRESS .VAR>
+ <MA-REG ,AC-1>>
+ <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG ,AC-1>>
+ <EMIT ,INST-BICB2 <MA-IMM 3> <MA-REG ,AC-1>>
+ ; "Actual dope word pointer"
+ <EMIT ,INST-SUBL3 <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1> <MA-REG ,AC-0>>
+ ; "Number of bytes including slop in last word"
+ <CGC-UV-ST .VAR .ALLOC-ATOM .END-ATOM .NEXT-ATOM .RES>>
+
+<DEFINE CGC-UVECTOR-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES)
+ <MAPF <>
+ <FUNCTION (X) <MUNG-AC ,.X>>
+ '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
+ <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-0>>
+ <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-0> <MA-REG ,AC-0>>
+ <EMIT ,INST-ADDL3 <MA-REG ,AC-0> <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-1>>
+ <CGC-UV-ST .VAR .ALLOC-ATOM .END-ATOM .NEXT-ATOM .RES>>
+
+; "Call this guy with ac-0 set up to have number of bytes to subtract from
+ dope word pointer to get new pointer; ac-1 has pointer to dope word. 0-6
+ have been munged."
+<DEFINE CGC-UV-ST (VAR ALLOC-ATOM END-ATOM NEXT-ATOM RES
+ "AUX" ENDADDR ALLOCADDR (M-LAB <MAKE-LABEL>)
+ (BLT-LOOP <MAKE-LABEL>) (NF-LAB <MAKE-LABEL>)
+ (F-LAB <MAKE-LABEL>) (SHT-LAB <MAKE-LABEL>)
+ (DONE-LAB <MAKE-LABEL>))
+ #DECL ((VAR) VARTBL (ALLOC-ATOM END-ATOM NEXT-ATOM) ATOM
+ (RES) <OR VARTBL ATOM>)
+ <SET ENDADDR <MA-DEF-DISP ,AC-M
+ <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
+ <SET ALLOCADDR
+ <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
+ ;"Pointers to GVAL slots for AL and END-SPACE"
+ <EMIT ,INST-TSTB <MA-DISP ,AC-1 1>>
+ <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-1 1>>
+ ;"can be BBSS when assembler and friends hacked"
+ <EMIT ,INST-PUSHL <MA-REG ,AC-0>> ;"Save for making new pointer"
+ <EMIT ,INST-MOVZWL <MA-DISP ,AC-1 2> <MA-REG ,AC-6>>
+ ;"Size of whole structure"
+ <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-6> <MA-REG ,AC-6>> ;"in bytes"
+ <EMIT ,INST-PUSHL <MA-REG ,AC-6>>
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>> ;"Current allocation"
+ <EMIT ,INST-ADDL2 <MA-REG ,AC-3> <MA-REG ,AC-6>>
+ <EMIT-BRANCH ,INST-BVS .NF-LAB <> ,LAST-INST-LENGTH>
+ ;"See if overflowed--won't fit"
+ <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
+ <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
+ ;"See if won't fit in current area"
+ <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
+ <EMIT-LABEL .NF-LAB T>
+ <FRAME-GEN .NEXT-ATOM>
+ <EMIT-PUSH <TYPE-WORD FIX> LONG>
+ <EMIT ,INST-MOVL <MA-REGD ,AC-P> <MA-AINC ,AC-TP>>
+ <EMIT ,INST-PUSHL <MA-REG ,AC-1>>
+ <CALL-GEN .NEXT-ATOM 1> ;"Go to another area"
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-2>> ;"get AL back"
+ <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG ,AC-1>>
+ <EMIT ,INST-MOVL <MA-REGD ,AC-P> <MA-REG ,AC-6>>
+ ;"get stuff back from stack"
+ <EMIT ,INST-ADDL2 <MA-REG ,AC-3> <MA-REG ,AC-6>> ;"compute new AL"
+ <EMIT-LABEL .F-LAB T>
+ <EMIT ,INST-MOVAL <MA-DISP ,AC-6 -8> <MA-DISP ,AC-1 4>>
+ ;"stuff relocation into dope word
+ now points to 1st dw"
+ <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR> ;"update AL"
+ <EMIT ,INST-MOVL <MA-AINC ,AC-P> <MA-REG ,AC-6>>
+ ;"Get gross byte count back"
+ <EMIT ,INST-SUBL2 <MA-REG ,AC-6> <MA-REG ,AC-1>> ;"Top old structure"
+ <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-1>>
+ <EMIT-LABEL .BLT-LOOP T>
+ <EMIT ,INST-MOVL <MA-REG ,AC-6> <MA-REG ,AC-5>>
+ <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-IMM 65535>>
+ <GEN-BRANCH ,INST-BLSS .SHT-LAB <>>
+ <EMIT ,INST-MOVL <MA-IMM 65535> <MA-REG ,AC-5>>
+ <EMIT-LABEL .SHT-LAB T>
+ <EMIT ,INST-MOVC3 <MA-REG ,AC-5> <MA-REGD ,AC-1> <MA-REGD ,AC-3>>
+ <EMIT ,INST-SUBL2 <MA-IMM 65535> <MA-REG ,AC-6>>
+ <GEN-BRANCH ,INST-BGTR .BLT-LOOP <>>
+ <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 -7>>
+ ;"Turn off mark bit"
+ <EMIT ,INST-SUBL3 <MA-IMM 8> <MA-REG ,AC-3> <MA-REG ,AC-1>>
+ <EMIT ,INST-SUBL2 <MA-AINC ,AC-P> <MA-REG ,AC-1>>
+ <GEN-BRANCH ,INST-BRB .DONE-LAB <>>
+ <EMIT-LABEL .M-LAB T>
+ <EMIT ,INST-MOVL <MA-DISP ,AC-1 4> <MA-REG ,AC-1>>
+ ; "Point to top"
+ <EMIT ,INST-SUBL2 <MA-REG ,AC-0> <MA-REG ,AC-1>>
+ <EMIT-LABEL .DONE-LAB T>
+ <COND (<==? .RES STACK>
+ <EMIT-PUSH <VAR-TYPE-ADDRESS .VAR> LONG>
+ <EMIT-PUSH ,AC-1 LONG>)
+ (T
+ <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
+ <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
+ NORMAL>
+
+<DEFINE CGC-VECTOR-GEN (VAR ALLOC-ATOM END-ATOM NEXT-ATOM MARK-ATOM RES
+ "AUX" ENDADDR ALLOCADDR (NF-LAB <MAKE-LABEL>)
+ (F-LAB <MAKE-LABEL>) (LOOP-LAB <MAKE-LABEL>)
+ (NM-LAB <MAKE-LABEL>) (DONE-LAB <MAKE-LABEL>)
+ (M-LAB <MAKE-LABEL>))
+ <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
+ <SET ALLOCADDR
+ <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
+ <MAPF <>
+ <FUNCTION (X) <MUNG-AC ,.X>>
+ '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
+ <EMIT ,INST-ADDL2 <MA-IMM <* 5 4>> <MA-REG ,AC-TP>>
+ ; "Allocate temps"
+ <EMIT ,INST-MOVZWL <VAR-COUNT-ADDRESS .VAR> <MA-REG ,AC-2>>
+ <EMIT ,INST-ASHL <MA-IMM 3> <MA-REG ,AC-2> <MA-REG ,AC-2>>
+ <EMIT ,INST-MOVL <MA-REG ,AC-2> <GCTEMP 5>>
+ <EMIT ,INST-ADDL3 <MA-REG ,AC-2> <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-3>>
+ ; "2 has # of bytes in current pointer; 3 points to first dw"
+ <EMIT ,INST-TSTB <MA-DISP ,AC-3 1>>
+ <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
+ ; "jump if already marked"
+ <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 1>>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 1>>
+ <EMIT ,INST-MOVZWL <MA-DISP ,AC-3 2> <MA-REG ,AC-6>>
+ ; "# of words in whole structure"
+ <EMIT ,INST-ASHL <MA-IMM 2> <MA-REG ,AC-6> <MA-REG ,AC-6>>
+ ; "Bytes in structure"
+ <EMIT ,INST-MOVL <MA-REG ,AC-6> <GCTEMP 2>>
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
+ <EMIT ,INST-ADDL2 <MA-REG ,AC-1> <MA-REG ,AC-6>>
+ <EMIT-BRANCH ,INST-BVS .NF-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
+ <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
+ <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
+ <EMIT-LABEL .NF-LAB T>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 3>>
+ <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
+ <FRAME-GEN .NEXT-ATOM>
+ <EMIT-PUSH <TYPE-WORD FIX> LONG>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <MA-AINC ,AC-TP>>
+ <CALL-GEN .NEXT-ATOM 1>
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
+ <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-3>>
+ <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-6>>
+ <EMIT ,INST-ADDL2 <MA-REG ,AC-1> <MA-REG ,AC-6>>
+ ; "New AL"
+ <EMIT-LABEL .F-LAB T>
+ <EMIT ,INST-MOVAL <MA-DISP ,AC-6 -8> <MA-DISP ,AC-3 4>>
+ ; "Stuff pointer to new dw into old"
+ <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-DISP ,AC-6 -8>>
+ ; "copy dope words"
+ <EMIT ,INST-BICB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-6 -7>>
+ ; "Clear mark bit in new"
+ <EMIT ,INST-MOVL <TYPE-CODE FIX> <MA-REG ,AC-5>>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
+ <EMIT ,INST-SUBL2 <MA-IMM 8> <GCTEMP 2>>
+ ; "Flush dope words from byte count"
+ <EMIT ,INST-SUBL2 <GCTEMP 2> <MA-REG ,AC-3>>
+ ; "Point to top of old (ac 1 points to top of new)"
+ <EMIT ,INST-ASHL <MA-IMM -3> <GCTEMP 2> <GCTEMP 2>>
+ ; "Number of elements to mark"
+ <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-REG ,AC-4>>
+ <EMIT-LABEL .LOOP-LAB T>
+ <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-REG ,AC-0>>
+ <EMIT ,INST-BITB <MA-BYTE-IMM 7> <MA-REG ,AC-0>>
+ ; "See if this guy is structured"
+ <EMIT-BRANCH ,INST-BEQL .NM-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 3>>
+ <EMIT ,INST-MOVL <MA-REG ,AC-4> <GCTEMP 4>>
+ <FRAME-GEN .MARK-ATOM>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>
+ <CALL-GEN .MARK-ATOM 1>
+ <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-3>>
+ <EMIT ,INST-MOVL <GCTEMP 4> <MA-REG ,AC-4>>
+ <EMIT-LABEL .NM-LAB T>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-REGD ,AC-4>>
+ <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-3>>
+ <EMIT ,INST-ADDL2 <MA-IMM 8> <MA-REG ,AC-4>>
+ <EMIT ,INST-DECL <GCTEMP 2>>
+ <EMIT-BRANCH ,INST-BGTR .LOOP-LAB <> ,LAST-INST-LENGTH>
+ <EMIT-LABEL .DONE-LAB T>
+ <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-3>>
+ <EMIT-LABEL .M-LAB T>
+ <EMIT ,INST-MOVL <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
+ <EMIT ,INST-MOVL <MA-DISP ,AC-3 4> <MA-REG ,AC-1>>
+ <EMIT ,INST-SUBL2 <GCTEMP 5> <MA-REG ,AC-1>>
+ <EMIT ,INST-SUBL2 <MA-IMM <* 5 4>> <MA-REG ,AC-TP>>
+ <COND (<==? .RES STACK>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>)
+ (<DEST-PAIR ,AC-1 ,AC-0 .RES>)>
+ NORMAL>
+
+<DEFINE CGC-LIST-GEN
+ (VAR ALLOC-ATOM END-ATOM NEXT-ATOM BOUNDS-ATOM MARK-ATOM CHOMP "OPT" RES
+ "AUX" ENDADDR ALLOCADDR (M-LAB <MAKE-LABEL>) (DONE-LAB <MAKE-LABEL>)
+ (LOOP-LAB <MAKE-LABEL>) (NF-LAB <MAKE-LABEL>)
+ (F-LAB <MAKE-LABEL>) (NB-LAB <MAKE-LABEL>)
+ (MC-LAB <MAKE-LABEL>) (UNDO? <>))
+ <COND (<NOT <ASSIGNED? RES>>
+ <SET RES .CHOMP>)
+ (<SET UNDO? T>)>
+ <SET ENDADDR <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .END-ATOM XGLOC>> 4>>>
+ <SET ALLOCADDR
+ <MA-DEF-DISP ,AC-M <+ <ADD-MVEC <CHTYPE .ALLOC-ATOM XGLOC>> 4>>>
+ <MAPF <>
+ <FUNCTION (X) <MUNG-AC ,.X>>
+ '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
+ <EMIT ,INST-ADDL2 <MA-IMM <* 3 4>> <MA-REG ,AC-TP>>
+ <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR> <MA-REG ,AC-3>>
+ <EMIT ,INST-MOVL <MA-IMM 0> <GCTEMP 1>>
+ <EMIT-LABEL .LOOP-LAB T>
+ <EMIT ,INST-TSTB <MA-DISP ,AC-3 1>>
+ <EMIT-BRANCH ,INST-BLSS .M-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-BISB2 <MA-BYTE-IMM ,SHORT-MARK-BIT> <MA-DISP ,AC-3 1>>
+ ;"Mark bit set, need to hack this up."
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
+ <EMIT ,INST-ADDL3 <MA-IMM ,LIST-LEN> <MA-REG ,AC-1> <MA-REG ,AC-6>>
+ <EMIT ,INST-MOVQ .ENDADDR <MA-REG ,AC-4>>
+ <EMIT ,INST-CMPL <MA-REG ,AC-6> <MA-REG ,AC-5>>
+ <EMIT-BRANCH ,INST-BLEQ .F-LAB <> ,LAST-INST-LENGTH>
+ <EMIT-LABEL .NF-LAB T>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
+ <FRAME-GEN .NEXT-ATOM>
+ <EMIT-PUSH <TYPE-WORD FIX> LONG>
+ <EMIT-PUSH <MA-IMM ,LIST-LEN> LONG>
+ <CALL-GEN .NEXT-ATOM 1>
+ <EMIT ,INST-MOVQ .ALLOCADDR <MA-REG ,AC-0>>
+ <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
+ <EMIT ,INST-ADDL3 <MA-IMM ,LIST-LEN> <MA-REG ,AC-1> <MA-REG ,AC-6>>
+ <EMIT-LABEL .F-LAB T>
+ <EMIT ,INST-MOVL <TYPE-WORD FIX> <MA-REG ,AC-5>>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-5> .ALLOCADDR>
+ <EMIT ,INST-ADDL2 <MA-IMM 4> <MA-REG ,AC-1>>
+ ;"Point to right part of list cell"
+ <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-4>>
+ ;"Pick up pointer to previous cell"
+ <EMIT-BRANCH ,INST-BEQL .NB-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-DISP ,AC-4 -4>>
+ ;"Fix up cdr pointer in previous cell"
+ <EMIT-LABEL .NB-LAB T>
+ <EMIT ,INST-MOVL <MA-REG ,AC-1> <GCTEMP 1>>
+ ;"New previous cell pointer"
+ <EMIT ,INST-MOVL <MA-DISP ,AC-3 -4> <MA-REG ,AC-4>>
+ ;"Pick up cdr pointer"
+ <EMIT ,INST-MOVL <MA-REG ,AC-1> <MA-DISP ,AC-3 -4>>
+ ;"Relocation for old cell"
+ <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-DISP ,AC-1 -4>>
+ ;"Make sure new cell doesn't have garbage in cdr slot"
+ <EMIT ,INST-MOVQ <MA-REGD ,AC-3> <MA-REG ,AC-0>>
+ <EMIT ,INST-BICL2 <MA-IMM ,MARK-BIT> <MA-REG ,AC-0>>
+ <EMIT ,INST-BITB <MA-BYTE-IMM 7> <MA-REG ,AC-0>>
+ ;"See if car's type needs marking"
+ <EMIT-BRANCH ,INST-BEQL .MC-LAB <> ,LAST-INST-LENGTH>
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
+ <EMIT ,INST-MOVL <MA-REG ,AC-4> <GCTEMP 3>>
+ ;"Save pointer to old cell"
+ ;"Save old cdr pointer"
+ <FRAME-GEN .MARK-ATOM>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>
+ <CALL-GEN .MARK-ATOM 1> ;"Mark the guy"
+ <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
+ <EMIT ,INST-MOVL <GCTEMP 3> <MA-REG ,AC-4>>
+ <EMIT-LABEL .MC-LAB T>
+ <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-2>>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-REGD ,AC-2>>
+ <COND (.UNDO?
+ ; "Save old CDR in new cell in case want to undo all this"
+ <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-REGD ,AC-2>>)>
+ <EMIT ,INST-MOVL <MA-REG ,AC-4> <MA-REG ,AC-3>>
+ ;"Move cdr pointer to right place"
+ <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
+ ;"All done if empty cdr"
+ <EMIT ,INST-MOVL <MA-REG ,AC-3> <GCTEMP 2>>
+ <FRAME-GEN .BOUNDS-ATOM>
+ <EMIT-PUSH <TYPE-WORD LIST> LONG>
+ <EMIT-PUSH <MA-REG ,AC-3> LONG>
+ <CALL-GEN .BOUNDS-ATOM 1> ;"Check bounds of list cdr"
+ <EMIT ,INST-MOVL <GCTEMP 2> <MA-REG ,AC-3>>
+ <EMIT ,INST-TSTL <MA-REG ,AC-1>>
+ <EMIT-BRANCH ,INST-BNEQ .LOOP-LAB <> ,LAST-INST-LENGTH>
+ ;"Loop back if in bounds"
+ <EMIT-BRANCH ,INST-BRB .DONE-LAB <> ,LAST-INST-LENGTH>
+ <EMIT-LABEL .M-LAB T>
+ <EMIT ,INST-MOVL <GCTEMP 1> <MA-REG ,AC-2>>
+ ;"Pick up pointer to last cell"
+ <EMIT-BRANCH ,INST-BEQL .DONE-LAB <> ,LAST-INST-LENGTH>
+ ;"None, just clean up and leave"
+ <EMIT ,INST-MOVL <MA-DISP ,AC-3 -4> <MA-DISP ,AC-2 -4>>
+ ;"Clean up last cell"
+ <EMIT-LABEL .DONE-LAB T>
+ <EMIT ,INST-SUBL2 <MA-IMM <* 3 4>> <MA-REG ,AC-TP>>
+ <EMIT ,INST-MOVQ <VAR-TYPE-ADDRESS .VAR> <MA-REG ,AC-0>>
+ <EMIT ,INST-MOVL <MA-DISP ,AC-1 -4> <MA-REG ,AC-1>>
+ <COND (<==? .RES STACK>
+ <EMIT ,INST-MOVQ <MA-REG ,AC-0> <MA-AINC ,AC-TP>>)
+ (T <DEST-PAIR ,AC-1 ,AC-0 .RES>)>
+ NORMAL>
+
+<DEFINE MARKL-GEN (VAR VAL "AUX" VAC)
+ #DECL ((VAR) VARTBL (VAL) FIX)
+ <SET VAC <LOAD-VAR .VAR JUST-VALUE <> PREF-VAL>>
+ <FINISH-MARK .VAC .VAL>
+ NORMAL>
+
+<DEFINE IMARKU-GEN (VAR VAL SHIFT "AUX" VAC)
+ #DECL ((VAR) VARTBL (SHIFT) FIX (VAL) <OR FIX VARTBL>)
+ <USE-AC <SET VAC <LOAD-VAR .VAR COUNT T PREF-VAL>>>
+ <COND (<NOT <0? .SHIFT>>
+ <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .VAC> <MA-REG .VAC>>)>
+ <EMIT ,INST-ADDL2 <VAR-VALUE-ADDRESS .VAR> <MA-REG .VAC>>
+ <COND (<0? .SHIFT>
+ <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG .VAC>>
+ <EMIT ,INST-BICB2
+ <MA-IMM ,ADDR-MASK-2>
+ <MA-REG .VAC>>)>
+ <FINISH-MARK .VAC .VAL>
+ .VAC>
+
+<DEFINE FINISH-MARK (VAC VAL)
+ #DECL ((VAC) AC (VAL) <OR FIX VARTBL>)
+ <COND (<==? .VAL 0>
+ <EMIT ,INST-BICW2 <MA-WORD-IMM ,MARK-BIT> <MA-DISP .VAC 0>>)
+ (ELSE
+ <EMIT ,INST-BISW2 <MA-WORD-IMM ,MARK-BIT> <MA-DISP .VAC 0>>
+ <COND (<NOT <TYPE? .VAL FIX>>
+ <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAL>
+ <MA-DISP .VAC 4>>)>)>>
+
+<DEFINE MARKUS-GEN (VAR VAL "OPT" (RES <>))
+ #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
+ <IMARKU-GEN .VAR .VAL 0>
+ NORMAL>
+
+<COND (<GASSIGNED? MARKUS-GEN><SETG MARKUB-GEN ,MARKUS-GEN>)>
+
+<DEFINE MARKUV-GEN (VAR VAL)
+ #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
+ <IMARKU-GEN .VAR .VAL 3>
+ NORMAL>
+
+<DEFINE MARKUU-GEN (VAR VAL)
+ #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
+ <IMARKU-GEN .VAR .VAL 2>
+ NORMAL>
+
+<DEFINE MARKR-GEN (VAR VAL)
+ #DECL ((VAR) VARTBL (VAL) <OR FIX VARTBL>)
+ <CALL-RTE ,IMARKR!-MIMOP CALL <> <> .VAR .VAL>
+ NORMAL>
+
+<DEFINE MARKL?-GEN (VAR RES "AUX" VAC)
+ #DECL ((VAR) VARTBL (RES) <OR VARTBL ATOM>)
+ <SET VAC <LOAD-VAR .VAR VALUE T PREF-VAL>>
+ <FINISH-MARK? .VAC .RES>
+ NORMAL>
+
+<DEFINE FINISH-MARK? (VAC RES
+ "OPT" (REL <>) VAR
+ "AUX" (TLAB <MAKE-LABEL>) (ELAB <MAKE-LABEL>) NAC ADDR)
+ #DECL ((VAC) AC)
+ <EMIT ,INST-TSTB <MA-DISP .VAC 1>>
+ <GEN-BRANCH ,INST-BLSS .TLAB <> <>>
+ <EMIT ,INST-CLRL <MA-REG .VAC>>
+ <COND (.REL
+ <PROTECT .VAC>
+ <EMIT ,INST-MOVL <TYPE-CODE FIX>
+ <MA-REG <SET NAC <GET-AC PREF-TYPE T>>>>)>
+ <GEN-BRANCH ,INST-BRB .ELAB <> <>>
+ <EMIT-LABEL .TLAB <>>
+ <COND (.REL
+ <EMIT ,INST-MOVL <SET ADDR <MA-DISP .VAC 4>> <MA-REG .VAC>>
+ <LOAD-AC .VAC .ADDR>
+ <PROTECT .VAC>
+ <EMIT ,INST-MOVL <SET ADDR <VAR-TYPE-ADDRESS .VAR TYPE-WORD>>
+ <MA-REG .NAC>>)
+ (ELSE <EMIT ,INST-MOVL <MA-IMM 1> <MA-REG .VAC>>)>
+ <EMIT-LABEL .ELAB <>>
+ <COND (<NOT .REL> <DEST-DECL .VAC .RES FIX>)
+ (ELSE <DEST-PAIR .VAC .NAC .REL>)>>
+
+<DEFINE IMARKU?-GEN (VAR RES SHIFT REL "AUX" VAC)
+ #DECL ((VAR) VARTBL (SHIFT) FIX)
+ <SET VAC <LOAD-VAR .VAR COUNT T PREF-VAL>>
+ <COND (<NOT <0? .SHIFT>>
+ <EMIT ,INST-ASHL <MA-IMM .SHIFT> <MA-REG .VAC>
+ <MA-REG .VAC>>)>
+ <EMIT ,INST-ADDL2 <VAR-VALUE-ADDRESS .VAR> <MA-REG .VAC>>
+ <COND (<0? .SHIFT>
+ <EMIT ,INST-ADDL2 <MA-IMM 3> <MA-REG .VAC>>
+ <EMIT ,INST-BICB2 <MA-IMM ,ADDR-MASK-2> <MA-REG .VAC>>)>
+ <FINISH-MARK? .VAC .RES .REL .VAR>
+ .VAC>
+
+<DEFINE MARKUU?-GEN (VAR RES "OPT" (REL <>))
+ #DECL ((VAR) VARTBL)
+ <IMARKU?-GEN .VAR .RES 2 .REL>
+ NORMAL>
+
+<DEFINE MARKUV?-GEN (VAR RES "OPT" (REL <>))
+ #DECL ((VAR) VARTBL)
+ <IMARKU?-GEN .VAR .RES 3 .REL>
+ NORMAL>
+
+<DEFINE MARKUS?-GEN (VAR RES "OPT" (REL <>))
+ #DECL ((VAR) VARTBL)
+ <IMARKU?-GEN .VAR .RES 0 .REL>
+ NORMAL>
+
+<COND (<GASSIGNED? MARKUS?-GEN><SETG MARKUB?-GEN ,MARKUS?-GEN>)>
+
+<DEFINE MARKR?-GEN (VAR RES "OPT" (REL .RES))
+ #DECL ((VAR) VARTBL (REL) <OR VARTBL FALSE>)
+ <CALL-RTE ,IMARKR?!-MIMOP CALL .REL <> .VAR>
+ NORMAL>
+
+<DEFINE SWNEXT-GEN (VAR GCP RES)
+ #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,ISWNEXT!-MIMOP CALL .RES <> .VAR .GCP>
+ NORMAL>
+
+<DEFINE NEXTS-GEN (VAR RES)
+ #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
+ <CALL-RTE ,INEXTS!-MIMOP CALL .RES <> .VAR>
+ NORMAL>
+
+<DEFINE CONTENTS-GEN (VAR RES
+ "AUX" VAC (TAC <>) (TLAB <MAKE-LABEL>)
+ (TLAB2 <MAKE-LABEL>) (ELAB <MAKE-LABEL>))
+ #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
+ <PROTECT <SET VAC <LOAD-VAR .VAR JUST-VALUE <> PREF-VAL>>>
+ <EMIT ,INST-MOVQ <MA-DISP .VAC 0>
+ <COND (<==? .RES STACK> <MA-AINC ,AC-TP>)
+ (ELSE <SET TAC <GET-AC DOUBLE T>>)>>
+ <EMIT ,INST-BITW <MA-WORD-IMM ,DOPE-BIT>
+ <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
+ (ELSE <MA-REG .TAC>)>>
+ <GEN-BRANCH ,INST-BEQL .TLAB2 <> <>>
+ <EMIT ,INST-BICW2 <MA-WORD-IMM ,DOPE-BIT>
+ <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
+ (ELSE <MA-REG .TAC>)>>
+ <EMIT ,INST-ADDL3 <MA-IMM 4> <MA-REG .VAC>
+ <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
+ (ELSE <MA-REG <NEXT-AC .TAC>>)>>
+ <EMIT ,INST-CMPW <TYPE-CODE FRAME WORD>
+ <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
+ (ELSE <MA-REG .TAC>)>>
+ <GEN-BRANCH ,INST-BEQL .TLAB <> <>>
+ <EMIT ,INST-CMPW <TYPE-CODE SFRAME WORD>
+ <COND (<==? .RES STACK> <MA-DISP ,AC-TP -8>)
+ (T <MA-REG .TAC>)>>
+ <GEN-BRANCH ,INST-BNEQ .TLAB2 <> <>>
+ <EMIT-LABEL .TLAB <>>
+ <EMIT ,INST-ADDL3 <MA-IMM ,FLEN> <MA-REG .VAC>
+ <COND (<==? .RES STACK> <MA-DISP ,AC-TP -4>)
+ (ELSE <MA-REG <NEXT-AC .TAC>>)>>
+ <EMIT-LABEL .TLAB2 <>>
+ <COND (<N==? .RES STACK>
+ <DEST-PAIR <NEXT-AC .TAC> .TAC .RES>)>
+ NORMAL>
+
+<DEFINE PUTS-GEN (VAR1 VAR2
+ "AUX" VAC (TAC <>) (TLAB <MAKE-LABEL>)
+ (ELAB <MAKE-LABEL>) LV)
+ #DECL ((VAR) VARTBL (RES) <OR ATOM VARTBL>)
+ <PROTECT <SET VAC <LOAD-VAR .VAR1 JUST-VALUE <> PREF-VAL>>>
+ <EMIT ,INST-BITW <MA-WORD-IMM ,DOPE-BIT> <MA-DISP .VAC 0>>
+ <GEN-BRANCH ,INST-BNEQ .TLAB <> <>>
+ <EMIT ,INST-MOVL <VAR-VALUE-ADDRESS .VAR2> <MA-DISP .VAC 4>>
+ <EMIT-LABEL .TLAB <>>
+ NORMAL>
+
+<DEFINE RELL-GEN (VAR)
+ #DECL ((VAR) VARTBL)
+ <CALL-RTE ,IRELL!-MIMOP CALL <> <> .VAR>>
+
+<DEFINE RELU-GEN (VAR)
+ #DECL ((VAR) VARTBL)
+ <CALL-RTE ,IRELU!-MIMOP CALL <> <> .VAR>>
+
+<DEFINE RELR-GEN (VAR)
+ #DECL ((VAR) VARTBL)
+ <CALL-RTE ,IRELR!-MIMOP CALL <> <> .VAR>>
+
+<DEFINE ALLOCL-GEN (VAR DEST "AUX" VAC)
+ <SET VAC <LOAD-VAR .VAR JUST-VALUE T PREF-VAL>>
+ <EMIT ,INST-ADDL2 <MA-IMM 4> <MA-REG .VAC>>
+ <DEST-DECL .VAC .DEST LIST>>
+
+<DEFINE ALLOCUU-GEN (VAR OLD DEST "OPT" (HINT <>) "AUX" VAC1 VAC2)
+ <PROTECT <SET VAC1 <LOAD-VAR .OLD TYPE-WORD <> PREF-VAL>>>
+ <SET VAC2 <LOAD-VAR .VAR VALUE <> PREF-VAL>>
+ <DEST-PAIR .VAC2 .VAC1 .DEST>>
+
+<COND (<GASSIGNED? ALLOCUU-GEN><SETG ALLOCUV-GEN ,ALLOCUU-GEN>
+
+<SETG ALLOCUS-GEN ,ALLOCUU-GEN>
+
+<SETG ALLOCUB-GEN ,ALLOCUU-GEN>
+
+<SETG ALLOCR-GEN ,ALLOCUU-GEN>)>
+
+<DEFINE BLT-GEN (FROM TO NUMBER "OPT" (HINT <>) "AUX" (VAC <>)
+ (LAB <MAKE-LABEL>) (LAB1 <MAKE-LABEL>) VVAC)
+ <MAPF <> <FUNCTION (X) <MUNG-AC ,.X>>
+ '(AC-0 AC-1 AC-2 AC-3 AC-4 AC-5 AC-6)>
+ <COND (<AND <TYPE? .NUMBER FIX>
+ <SET NUMBER <* .NUMBER 4>>
+ <L=? .NUMBER *177777*>>
+ <LOAD-VAR .FROM JUST-VALUE T ,AC-1>
+ <LOAD-VAR .TO JUST-VALUE T ,AC-3>
+ <EMIT ,INST-MOVC3 <MA-WORD-IMM .NUMBER>
+ <MA-REGD ,AC-1>
+ <MA-REGD ,AC-3>>)
+ (T
+ <SET VAC <MA-REG <GET-AC ,AC-5 T>>>
+ <SET VVAC <MA-REG <GET-AC ,AC-6 T>>>
+ <COND (<TYPE? .NUMBER FIX>
+ <EMIT ,INST-MOVL <MA-IMM .NUMBER>
+ .VVAC>)
+ (ELSE
+ <EMIT ,INST-ASHL <MA-IMM 2> <VAR-VALUE-ADDRESS .NUMBER>
+ .VVAC>)>
+ <LOAD-VAR .FROM JUST-VALUE T ,AC-1>
+ <LOAD-VAR .TO JUST-VALUE T ,AC-3>
+ <EMIT-LABEL .LAB T>
+ <EMIT-MOVE .VVAC .VAC LONG>
+ <EMIT ,INST-CMPL .VVAC <MA-IMM *177777*>>
+ <GEN-BRANCH ,INST-BLSS .LAB1 <>>
+ <EMIT-MOVE <MA-IMM *177777*> .VAC LONG>
+ <EMIT-LABEL .LAB1 T>
+ <EMIT ,INST-MOVC3 .VAC
+ <MA-REGD ,AC-1>
+ <MA-REGD ,AC-3>>
+ <EMIT ,INST-SUBL2 <MA-IMM *177777*> .VVAC>
+ <GEN-BRANCH ,INST-BGTR .LAB <>>)>
+ NORMAL>
+
+<DEFINE MPAGES-GEN (PGS DEST)
+ <CALL-RTE ,IMPAGES!-MIMOP CALL .DEST <> .PGS>>
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff