3 <DEFINE INIT-RECORD-DEFS ()
4 <SETG RECORD-TABLE ()>>
6 <DEFINE DEFINE-RECORD (TYP STACK "TUPLE" ELEMENTS "AUX" DESC ELIST)
7 <SET ELIST <LIST !.ELEMENTS>>
8 <SET DESC <CHTYPE <VECTOR .TYP .ELIST .STACK> RECORD-DESCRIPTOR>>
9 <SETG RECORD-TABLE (.DESC !,RECORD-TABLE)>>
11 <DEFINE PARSE-RED (TYP OFFSET
12 "OPTIONAL" (ALTOFF 0) (LEN? <>) (SBOOL? <>)
14 #DECL ((TYP) ATOM (OFFSET ALTOFF) FIX (LEN?) <OR FALSE FIX>
17 <SET RES <VECTOR .OFFSET .ALTOFF ANY 0 <> <> <>>>)
20 <==? .TYP SMALL-POS-INT>
21 <==? .TYP SMALL-FR-OFFSET>>
22 <SET RES <VECTOR .OFFSET 0 .TYP 0 <> <> <>>>)
24 <SET RES <VECTOR .OFFSET 0 BOOLEAN .ALTOFF <> <> <>>>)
26 <SET RES <VECTOR .OFFSET 0 TYPE-C 0 .SBOOL? <> .TYP>>)
27 (<AND <VALID-TYPE? .TYP>
28 <MEMQ <TYPEPRIM .TYP> '[VECTOR STRING UVECTOR BYTES]>
30 <SET RES <VECTOR .OFFSET .ALTOFF COUNTVWORD 0 .SBOOL? <> .TYP>>)
32 <MEMQ .TYP '[T$ATOM T$LBIND T$MSUBR T$GBIND T$FRAME
34 <==? <TYPEPRIM .TYP> LIST> <==? <TYPEPRIM .TYP> FIX>>
35 <SET RES <VECTOR .OFFSET 0 VWORD1 0 .SBOOL? .LEN? .TYP>>)>
36 <CHTYPE .RES RECORD-ELEMENT-DESCRIPTOR>>
38 <DEFINE GET-RELE-DESCRIPTOR (NUM HINT "AUX" RTYP RECTYP)
39 #DECL ((NUM) FIX (HINT) <OR ATOM HINT>)
40 <COND (<TYPE? .HINT ATOM> <SET RTYP .HINT>)
41 (<SET RTYP <PARSE-HINT .HINT RECORD-TYPE>>)>
44 <COND (<OR <MEMQ .RTYP <SET RECTYP <REC-TYPE-NAME .ELE>>>
45 <MEMQ <CLEAN-DECL .RTYP> .RECTYP>>
46 <MAPLEAVE <NTH <REC-ELEMENTS .ELE> .NUM>>)>>
49 <DEFINE GET-RSTACK? (HINT "AUX" RTYP RECTYP)
50 #DECL ((HINT) <OR ATOM HINT>)
51 <COND (<TYPE? .HINT ATOM> <SET RTYP .HINT>)
52 (<SET RTYP <PARSE-HINT .HINT RECORD-TYPE>>)>
55 <COND (<OR <MEMQ .RTYP <SET RECTYP <REC-TYPE-NAME .ELE>>>
56 <MEMQ <CLEAN-DECL .RTYP> .RECTYP>>
57 <MAPLEAVE <REC-STACK .ELE>>)>>
60 <DEFINE GET-RELE-BRANCH? (HINT2)
61 #DECL ((HINT2) <OR FALSE HINT>)
63 <OR <==? <1 .HINT2> BRANCH-FALSE>
64 <==? <1 .HINT2> BRANCH-TAG>>>
65 <PROG ((CP .CODPTR) FROB)
67 <COND (<AND <NOT <EMPTY? .CP>>
68 <TYPE? <SET FROB <1 .CP>> FORM>>
69 <COND (<N==? <1 .FROB> DEAD!-MIMOP>
70 <PUTPROP .FROB DONE T>)
76 <DEFINE INIT-REC-DEFS ()
78 <DEFINE-RECORD [T$ATOM T$LINK T$GVAL T$LVAL ATOM LINK GVAL LVAL]
80 <PARSE-RED T$GBIND 0 0 <> T>
81 <PARSE-RED T$LBIND 4 0 <> T>
82 <PARSE-RED STRING 12 10 <> <>>
83 <PARSE-RED T$OBLIST 16 0 <> T>
84 <PARSE-RED TYPE-C 8 0 <> T>>
85 <DEFINE-RECORD [T$FRAME FRAME]
87 <PARSE-RED T$MSUBR -24 0 4 <>>
88 <PARSE-RED FIX -20 0 <> <>>
89 <PARSE-RED SMALL-POS-INT -16 0 <> <>>
90 <PARSE-RED SMALL-POS-INT -14 0 <> <>>
91 <PARSE-RED T$FRAME -12 0 <> <>>
92 <PARSE-RED SMALL-POS-INT -6 0 0 <>>
93 <PARSE-RED SMALL-FR-OFFSET -8 0 <> <>>
94 <PARSE-RED FIX -4 0 <> <>>>
95 <DEFINE-RECORD [T$LBIND LBIND]
97 <PARSE-RED ANY 4 0 <> <>>
98 <PARSE-RED T$ATOM 8 0 <> <>>
99 <PARSE-RED ANY 16 12 <> <>>
100 <PARSE-RED T$LBIND 20 0 <> T>
101 <PARSE-RED T$LBIND 24 0 <> T>
102 <PARSE-RED FIX 28 0 <> <>>>
103 <DEFINE-RECORD [T$GBIND GBIND]
105 <PARSE-RED ANY 4 0 <> <>>
106 <PARSE-RED T$ATOM 8 0 <> <>>
107 <PARSE-RED ANY 16 12 <> <>>>>