Machine-Independent MDL for TOPS-20 and VAX.

[pdp10-muddle.git] / mim / development / mim / mimc / lnqgen.mud

diff --git a/mim/development/mim/mimc/lnqgen.mud b/mim/development/mim/mimc/lnqgen.mud
new file mode 100644 (file)
index 0000000..3f41606
--- /dev/null
+++ b/mim/development/mim/mimc/lnqgen.mud
@@ -0,0 +1,129 @@
+
+<PACKAGE "LNQGEN">
+
+<ENTRY LENGTH?-GEN>
+
+<USE "COMPDEC" "CODGEN" "CHKDCL" "ADVMESS" "STRGEN" "MIMGEN">
+
+<DEFINE LENGTH?-GEN (N W
+                    "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
+                    "AUX" QDAT (STR <1 <KIDS .N>>) (FLG <>)
+                          (NUM <2 <KIDS .N>>) (TYP <RESULT-TYPE .STR>)
+                          (TPS <STRUCTYP .TYP>)
+                          (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
+                          (FLS <==? .W FLUSHED>) (SDIR .DIR) (B3 <MAKE-TAG>)
+                          NK NN ANUM LP
+                          (B2
+                           <COND (<AND .FLS .BRANCH> .BRANCH)
+                                 (ELSE <MAKE-TAG>)>) STRD NUMD TEM T1 (RW .W)
+                          LP1)
+   #DECL ((N STR NUM) NODE (NN) FIX (TPS TYP1 B2 B3) ATOM
+         (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
+   <COND (<==? <NODE-TYPE .NUM> ,QUOTE-CODE>
+         <SET NK T>
+         <COND (<OR <L? <SET NN <NODE-NAME .NUM>> 0> <G? .NN 262144>>
+                <COMPILE-ERROR "Argument out of range to LENGTH? " .NN .N>)>)
+        (ELSE <SET NK <>>)>
+   <COND (.NOTF <SET DIR <NOT .DIR>>)>
+   <COND (.SETF
+         <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>>)>
+   <COND (<==? .TPS LIST>
+         <SET STRD <GEN .STR DONT-CARE>>
+         <COND (<OR <NOT <TYPE? .STRD TEMP>> <G? <TEMP-REFS .STRD> 1>>
+                <SET STRD <MOVE-ARG .STRD <GEN-TEMP <>>>>)>
+         <SET NUMD <GEN .NUM DONT-CARE>>
+         <COND (<OR <NOT <TYPE? .NUMD TEMP>> <G? <TEMP-REFS .NUMD> 1>>
+                <SET NUMD <MOVE-ARG .NUMD <GEN-TEMP <>>>>)>
+         <COND (<OR .NOTF
+                    <NOT <==? <NOT .BRANCH> <NOT .DIR>>>
+                    <AND .BRANCH .FLS>>
+                <IEMIT `LOOP
+                       (<TEMP-NAME .STRD> VALUE)
+                       (<TEMP-NAME .NUMD> VALUE)>)
+               (ELSE
+                <SET-TEMP <SET ANUM
+                               <COND (<AND <TYPE? .W TEMP>
+                                           <0? <TEMP-REFS .W>>>
+                                      <USE-TEMP .W>
+                                      .W)
+                                     (ELSE <SET W <GEN-TEMP>>)>>
+                          0
+                          '(`TYPE FIX)>
+                <IEMIT `LOOP
+                       (<TEMP-NAME .STRD> VALUE)
+                       (<TEMP-NAME .NUMD> VALUE)
+                       (<TEMP-NAME .ANUM> VALUE)>)>
+         <LABEL-TAG <SET LP <MAKE-TAG>>>
+         <EMPTY-CHECK LIST .STRD LIST T <COND (.DIR .B2) (ELSE .B3)>>
+         <IEMIT `SUB .NUMD 1 = .NUMD '(`TYPE FIX)>
+         <COND (<ASSIGNED? ANUM> <IEMIT `ADD .ANUM 1 = .ANUM '(`TYPE FIX)>)>
+         <IEMIT `LESS? .NUMD 0 + <SET LP1 <MAKE-TAG>>>
+         <REST-DO LIST .STRD .STRD 1>
+         <BRANCH-TAG .LP>
+         <LABEL-TAG .LP1>
+         <FREE-TEMP .STRD>
+         <FREE-TEMP .NUMD>
+         <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
+         <COND (<AND .BRANCH .FLS>
+                <COND (<NOT .DIR> <BRANCH-TAG .B2> <LABEL-TAG .B3>)>)
+               (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
+                <COND (<AND .NOTF .DIR> <BRANCH-TAG .B3> <LABEL-TAG .B2>)>
+                <MOVE-ARG <REFERENCE .SDIR> .W>
+                <BRANCH-TAG .BRANCH>
+                <LABEL-TAG .B3>)
+               (ELSE
+                <COND (.BRANCH
+                       <BRANCH-TAG .B3>
+                       <LABEL-TAG .B2>
+                       <SET W <MOVE-ARG .ANUM .W>>
+                       <BRANCH-TAG .BRANCH>
+                       <LABEL-TAG .B3>)
+                      (ELSE
+                       <RET-TMP-AC <MOVE-ARG <REFERENCE <>> .W>>
+                       <BRANCH-TAG .B2>
+                       <LABEL-TAG .B3>
+                       <SET W <MOVE-ARG .ANUM .W>>
+                       <LABEL-TAG .B2>)>)>)
+        (ELSE
+         <FREE-TEMP <SET STRD <GEN .STR DONT-CARE>> <>>
+         <SET ANUM <GEN-TEMP>>
+         <COND (<OR <==? .TPS VECTOR> <==? .TPS TUPLE>>
+                <LENGTH-VECTOR .STRD .ANUM>)
+               (<==? .TPS LIST> <LENGTH-LIST .STRD .ANUM>)
+               (<==? .TPS UVECTOR> <LENGTH-UVECTOR .STRD .ANUM>)
+               (<==? .TPS STRING> <LENGTH-STRING .STRD .ANUM>)
+               (ELSE <LENGTH-RECORD .STRD .ANUM <RECTYPE? .TYP>>)>
+         <COND (.NK
+                <IEMIT `GRTR?
+                       .ANUM
+                       .NN
+                       <COND (<OR .FLS <NOT .BRANCH>>
+                              <COND (.DIR -) (ELSE +)>)
+                             (ELSE <COND (.DIR +) (ELSE -)>)>
+                       .B2>)
+               (ELSE
+                <SET NUMD <GEN .NUM DONT-CARE>>
+                <IEMIT `GRTR? .ANUM .NUMD <COND (.DIR -) (ELSE +)> .B2>
+                <FREE-TEMP .NUMD>)>
+         <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
+         <COND (<AND .BRANCH .FLS> <FREE-TEMP .ANUM>)
+               (<OR .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>
+                <FREE-TEMP .ANUM>
+                <COND (.BRANCH
+                       <MOVE-ARG <REFERENCE .SDIR> .W>
+                       <BRANCH-TAG .BRANCH>
+                       <LABEL-TAG .B2>)>)
+               (ELSE
+                <COND (.BRANCH
+                       <MOVE-ARG .ANUM .W>
+                       <BRANCH-TAG .BRANCH>
+                       <LABEL-TAG .B2>)
+                      (ELSE
+                       <MOVE-ARG .ANUM .W>
+                       <BRANCH-TAG .B3>
+                       <LABEL-TAG .B2>
+                       <MOVE-ARG <REFERENCE <>> .W>
+                       <LABEL-TAG .B3>)>)>)>
+   <MOVE-ARG .W .RW>>
+
+<ENDPACKAGE>