6 <USE "COMPDEC" "CODGEN" "CHKDCL" "ADVMESS" "STRGEN" "MIMGEN">
8 <DEFINE LENGTH?-GEN (N W
9 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
10 "AUX" QDAT (STR <1 <KIDS .N>>) (FLG <>)
11 (NUM <2 <KIDS .N>>) (TYP <RESULT-TYPE .STR>)
13 (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
14 (FLS <==? .W FLUSHED>) (SDIR .DIR) (B3 <MAKE-TAG>)
17 <COND (<AND .FLS .BRANCH> .BRANCH)
18 (ELSE <MAKE-TAG>)>) STRD NUMD TEM T1 (RW .W)
20 #DECL ((N STR NUM) NODE (NN) FIX (TPS TYP1 B2 B3) ATOM
21 (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
22 <COND (<==? <NODE-TYPE .NUM> ,QUOTE-CODE>
24 <COND (<OR <L? <SET NN <NODE-NAME .NUM>> 0> <G? .NN 262144>>
25 <COMPILE-ERROR "Argument out of range to LENGTH? " .NN .N>)>)
27 <COND (.NOTF <SET DIR <NOT .DIR>>)>
29 <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>>)>
30 <COND (<==? .TPS LIST>
31 <SET STRD <GEN .STR DONT-CARE>>
32 <COND (<OR <NOT <TYPE? .STRD TEMP>> <G? <TEMP-REFS .STRD> 1>>
33 <SET STRD <MOVE-ARG .STRD <GEN-TEMP <>>>>)>
34 <SET NUMD <GEN .NUM DONT-CARE>>
35 <COND (<OR <NOT <TYPE? .NUMD TEMP>> <G? <TEMP-REFS .NUMD> 1>>
36 <SET NUMD <MOVE-ARG .NUMD <GEN-TEMP <>>>>)>
38 <NOT <==? <NOT .BRANCH> <NOT .DIR>>>
41 (<TEMP-NAME .STRD> VALUE)
42 (<TEMP-NAME .NUMD> VALUE)>)
45 <COND (<AND <TYPE? .W TEMP>
49 (ELSE <SET W <GEN-TEMP>>)>>
53 (<TEMP-NAME .STRD> VALUE)
54 (<TEMP-NAME .NUMD> VALUE)
55 (<TEMP-NAME .ANUM> VALUE)>)>
56 <LABEL-TAG <SET LP <MAKE-TAG>>>
57 <EMPTY-CHECK LIST .STRD LIST T <COND (.DIR .B2) (ELSE .B3)>>
58 <IEMIT `SUB .NUMD 1 = .NUMD '(`TYPE FIX)>
59 <COND (<ASSIGNED? ANUM> <IEMIT `ADD .ANUM 1 = .ANUM '(`TYPE FIX)>)>
60 <IEMIT `LESS? .NUMD 0 + <SET LP1 <MAKE-TAG>>>
61 <REST-DO LIST .STRD .STRD 1>
66 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
67 <COND (<AND .BRANCH .FLS>
68 <COND (<NOT .DIR> <BRANCH-TAG .B2> <LABEL-TAG .B3>)>)
69 (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
70 <COND (<AND .NOTF .DIR> <BRANCH-TAG .B3> <LABEL-TAG .B2>)>
71 <MOVE-ARG <REFERENCE .SDIR> .W>
78 <SET W <MOVE-ARG .ANUM .W>>
82 <RET-TMP-AC <MOVE-ARG <REFERENCE <>> .W>>
85 <SET W <MOVE-ARG .ANUM .W>>
88 <FREE-TEMP <SET STRD <GEN .STR DONT-CARE>> <>>
90 <COND (<OR <==? .TPS VECTOR> <==? .TPS TUPLE>>
91 <LENGTH-VECTOR .STRD .ANUM>)
92 (<==? .TPS LIST> <LENGTH-LIST .STRD .ANUM>)
93 (<==? .TPS UVECTOR> <LENGTH-UVECTOR .STRD .ANUM>)
94 (<==? .TPS STRING> <LENGTH-STRING .STRD .ANUM>)
95 (ELSE <LENGTH-RECORD .STRD .ANUM <RECTYPE? .TYP>>)>
100 <COND (<OR .FLS <NOT .BRANCH>>
101 <COND (.DIR -) (ELSE +)>)
102 (ELSE <COND (.DIR +) (ELSE -)>)>
105 <SET NUMD <GEN .NUM DONT-CARE>>
106 <IEMIT `GRTR? .ANUM .NUMD <COND (.DIR -) (ELSE +)> .B2>
108 <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
109 <COND (<AND .BRANCH .FLS> <FREE-TEMP .ANUM>)
110 (<OR .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>
113 <MOVE-ARG <REFERENCE .SDIR> .W>
125 <MOVE-ARG <REFERENCE <>> .W>
126 <LABEL-TAG .B3>)>)>)>