1 <DEFINE XCOP-PRINT (X "AUX" (OUTCHAN .OUTCHAN))
2 <PRINC "%<CHANNEL-OPERATION " .OUTCHAN>
3 <PRIN1 <1 .X> .OUTCHAN>
5 <PRIN1 <2 .X> .OUTCHAN>
8 <DEFINE XGLOC-PRINT (X "AUX" (OUTCHAN .OUTCHAN))
11 <PRIN1 <CHTYPE .X ATOM> .OUTCHAN>
14 <PRINC "%<GBIND " .OUTCHAN>
15 <PRIN1 <CHTYPE .X ATOM> .OUTCHAN>
16 <PRINC " T> " .OUTCHAN>)>>
18 <DEFINE XTYPE-C-PRINT (X "AUX" ATM (OUTCHAN .OUTCHAN))
19 #DECL ((X) XTYPE-C (ATM) ATOM)
20 <SET ATM <CHTYPE .X ATOM>>
21 <PRINC "%<TYPE-C " .OUTCHAN>
24 <PRIN1 <TYPEPRIM .ATM> .OUTCHAN>
27 <DEFINE XTYPE-W-PRINT (X "AUX" ATM (OUTCHAN .OUTCHAN))
28 #DECL ((X) XTYPE-W (ATM) ATOM)
29 <SET ATM <CHTYPE .X ATOM>>
30 <PRINC "%<TYPE-W " .OUTCHAN>
33 <PRIN1 <TYPEPRIM .ATM> .OUTCHAN>
36 <COND (<GASSIGNED? XCOP-PRINT>
37 <PRINTTYPE XCHANNEL-OP ,XCOP-PRINT>
38 <PRINTTYPE XGLOC ,XGLOC-PRINT>
39 <PRINTTYPE XTYPE-C ,XTYPE-C-PRINT>
40 <PRINTTYPE XTYPE-W ,XTYPE-W-PRINT>)>
42 <DEFINE TYPE-CODE (TYP "OPTIONAL" (LENGTH LONG) "AUX" L OFF TST)
43 #DECL ((TYP) ATOM (L) <OR FALSE VECTOR>)
45 <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
46 <COND (<==? .LENGTH VALUE> <2 .L>)
49 <SET OFF <ADD-MVEC <CHTYPE .TYP XTYPE-C>>>
50 <ADDR-VALUE-M .OFF .LENGTH>)
51 (<SET TST <CHECK-MIMOP-TYPE .TYP>> <SET TYP .TST> <AGAIN>)
52 (<ERROR "UNDEFINED-TYPE" .TYP>)>>>
54 <DEFINE TYPE-WORD (TYP "OPTIONAL" (EXTWORD <>) "AUX" L VAL M OFF)
55 #DECL ((TYP) ATOM (L M) <OR FALSE VECTOR> (VAL) FIX)
57 <COND (<SET L <MEMQ .TYP ,TYPE-WORDS>>
59 <COND (<SET M <MEMQ .TYP ,TYPE-LENGTHS>>
60 <SET VAL <CHTYPE <ORB .VAL <LSH <2 .M> 16>> FIX>>)>
63 <SET OFF <ADD-MVEC <CHTYPE .TYP XTYPE-W>>>
65 (<SET TST <CHECK-MIMOP-TYPE .TYP>> <SET TYP .TST> <AGAIN>)
66 (<ERROR "UNDEFINED-TYPE" .TYP>)>>>
68 <GDECL (TYPE-WORDS TYPE-LENGTHS) <VECTOR [REST ATOM FIX]>>
70 <DEFINE INIT-MVEC-STUFF ()
71 <SETG MVEC-OFF ,START-MVEC-OFF>
74 <DEFINE PRINT-MVEC-ELEMENTS ("OPTIONAL" (OUTCHAN .OUTCHAN))
75 #DECL ((OUTCHAN) <SPECIAL CHANNEL>)
76 <MAPF <> <FCN (X) <PRIN1 .X> <PRINC !\ >> ,MVEC-LIST>>
78 <MSETG START-MVEC-OFF 16>
80 <DEFINE ADD-MVEC (ITM "AUX" (OFF ,MVEC-OFF) (LST ,MVEC-LIST) TLST)
82 <COND (<SET TLST <MEMBER .ITM ,MVEC-LIST>>
83 <SET OFF <- .OFF <* <LENGTH .TLST> 8>>>)
85 <COND (<EMPTY? .LST> <SETG MVEC-LIST (.ITM)>)
86 (<PUTREST <REST .LST <- <LENGTH .LST> 1>> (.ITM)>)>
87 <SETG MVEC-OFF <+ .OFF 8>>)>
90 <DEFINE PRINT-MREF (NUM "AUX" RNUM (OUTCHAN .OUTCHAN))
92 <SET RNUM <+ </ <- .NUM ,START-MVEC-OFF> 8> 1>>
93 <PRINC "<MQUOTE " .OUTCHAN>
94 <PRIN1 <NTH ,MVEC-LIST .RNUM> .OUTCHAN>
96 <PRIN1 <MOD .NUM 8> .OUTCHAN>
100 <DEFINE ADDR-VALUE-M (OFF "OPTIONAL" (LEN LONG))
102 <COND (<==? .LEN LONG> <MA-DISP ,AC-M <+ .OFF 4>>)
103 (ELSE <MA-DISP ,AC-M <+ .OFF 4>>)>>
105 <DEFINE ADDR-VALUE-MQUOTE (OBJ)
107 <ADDR-VALUE-M <ADD-MVEC .OBJ>>>
109 <DEFINE ADDR-TYPE-MQUOTE (OBJ) #DECL ((OBJ) ANY) <ADDR-TYPE-M <ADD-MVEC .OBJ>>>
111 <DEFINE ADDR-TYPE-M (OFF)
113 <MA-DISP ,AC-M .OFF>>
115 <DEFINE ADDR-COUNT-M (OFF)
117 <MA-DISP ,AC-M <+ .OFF 2>>>