Machine-Independent MDL for TOPS-20 and VAX.

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

diff --git a/mim/development/mim/mimc/mmqgen.mud b/mim/development/mim/mimc/mmqgen.mud
new file mode 100644 (file)
index 0000000..6fb2952
--- /dev/null
+++ b/mim/development/mim/mimc/mmqgen.mud
@@ -0,0 +1,135 @@
+
+<PACKAGE "MMQGEN">
+
+<ENTRY MEMQ-GEN>
+
+<USE "COMPDEC" "CODGEN" "CHKDCL" "MIMGEN" "ADVMESS" "STRGEN">
+
+<DEFINE MEMQ-GEN (N W
+                 "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
+                 "AUX" (STR <2 <KIDS .N>>) (THING <1 <KIDS .N>>)
+                       (TYP <RESULT-TYPE .STR>) (TPS <STRUCTYP .TYP>)
+                       (FLS <==? .W FLUSHED>) (SDIR .DIR)
+                       (TTYP <RESULT-TYPE .THING>) TYPTMP VAL-TEMP
+                       (ETY <GET-ELE-TYPE .TYP ALL>)
+                       (TWIN <TYPESAME .ETY .TTYP>)
+                       (B2
+                        <COND (<AND .FLS .BRANCH> .BRANCH) (ELSE <MAKE-TAG>)>)
+                       STRD NUMD TEM TY (B3 <MAKE-TAG>) (RW .W)
+                       (FC <0? <CHTYPE <MINL .TYP> FIX>>) (LP <MAKE-TAG>) B4
+                       (NXT-TAG <MAKE-TAG>))
+   #DECL ((N STR THING) NODE (DCOD) FIX (B2 B3 B4) ATOM (TPS) <OR ATOM FALSE>
+         (DEAD) <PRIMTYPE LIST> (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
+   <AND .NOTF <SET DIR <NOT .DIR>>>
+   <SET TEM <COND (<AND <TYPE? .W TEMP> <L=? <TEMP-REFS .W> 0>> .W)
+                 (ELSE DONT-CARE)>>
+   <COND (<AND <NOT <SIDE-EFFECTS .N>>
+              <NOT <MEMQ <NODE-TYPE .STR> ,SNODES>>
+              <MEMQ <NODE-TYPE .THING> ,SNODES>>
+         <SET STRD <GEN .STR .TEM>>
+         <SET NUMD <GEN .THING DONT-CARE>>)
+        (ELSE
+         <SET NUMD <GEN .THING DONT-CARE>>
+         <SET NUMD <INTERF-CHANGE .NUMD .STR>>
+         <SET STRD <GEN .STR .TEM>>)>
+   <COND (<OR <NOT <TYPE? .STRD TEMP>> <G? <TEMP-REFS .STRD> 1>>
+         <COND (<AND <NOT .FLS> <NOT .NOTF> .TPS <N==? .TPS <ISTYPE? .TYP>>>
+                <FREE-TEMP .STRD <>>
+                <IEMIT `CHTYPE .STRD <FORM `TYPE-CODE .TPS> =
+                       <SET STRD <GEN-TEMP .TPS>>>)
+               (ELSE
+                <SET STRD <MOVE-ARG .STRD <GEN-TEMP <>>>>)>)
+        (<AND <NOT .FLS> <NOT .NOTF> .TPS <N==? .TPS <ISTYPE? .TYP>>>
+         <IEMIT `CHTYPE .STRD <FORM `TYPE-CODE .TPS> = .STRD>)>
+   <COND (<AND <NOT .TWIN> <SET TY <ISTYPE? .ETY>>>
+         <GEN-TYPE? .NUMD .TY <COND (.DIR .B3) (ELSE .B2)> <>>
+         <SET TWIN T>)>
+   <COND (<AND <NOT <SET TTYP <ISTYPE? .TTYP>>> <NOT .TY>>
+         <IEMIT `TYPE .NUMD = <SET TYPTMP <GEN-TEMP>>>)>
+   <COND (<AND .BRANCH <NOT .FLS> .DIR <NOT .NOTF> <=? .W .STRD> <NOT .SETF>>
+         <SET B2 .BRANCH>)>
+   <COND (.FC
+         <COND (.TPS
+                <EMPTY-CHECK .TPS .STRD .TPS T <COND (.DIR .B3) (ELSE .B2)>>)
+               (ELSE <IEMIT `EMPTY? .STRD + <COND (.DIR .B3) (ELSE .B2)>>)>)>
+   <IEMIT `LOOP !<COND (<TYPE? .NUMD TEMP>
+                       <COND (<ASSIGNED? TYPTMP>
+                              ((<TEMP-NAME .NUMD> VALUE)
+                               (<TEMP-NAME .TYPTMP> VALUE)))
+                             (ELSE ((<TEMP-NAME .NUMD> VALUE)))>)
+                      (<ASSIGNED? TYPTMP> ((<TEMP-NAME .TYPTMP> VALUE)))
+                      (ELSE ())>
+         <COND (<NOT .TPS> (<TEMP-NAME .STRD> LENGTH VALUE TYPE))
+               (<==? .TPS LIST> (<TEMP-NAME .STRD> VALUE))
+               (ELSE (<TEMP-NAME .STRD> LENGTH VALUE))>>
+   <LABEL-TAG .LP>
+   <COND (.TPS <NTH-DO .TPS .STRD <SET VAL-TEMP <GEN-TEMP>> 1>)
+        (ELSE <IEMIT `NTH1 .STRD = <SET VAL-TEMP <GEN-TEMP>>>)>
+   <COND (<ASSIGNED? TYPTMP> <GEN-TYPE? .VAL-TEMP .TYPTMP .NXT-TAG <>>)
+        (<NOT .TWIN> <GEN-TYPE? .VAL-TEMP .TTYP .NXT-TAG <>>)>
+   <IEMIT `VEQUAL? .VAL-TEMP <ATOMCHK .NUMD> + <COND (.DIR .B2) (ELSE .B3)>>
+   <FREE-TEMP .VAL-TEMP>
+   <LABEL-TAG .NXT-TAG>
+   <COND (.TPS <REST-DO .TPS .STRD .STRD 1>)
+        (ELSE <IEMIT `REST1 .STRD = .STRD>)>
+   <COND (.TPS <EMPTY-CHECK .TPS .STRD .TPS <> .LP>)
+        (ELSE <IEMIT `EMPTY? .STRD - .LP>)>
+   <FREE-TEMP .NUMD>
+   <COND (<ASSIGNED? TYPTMP> <FREE-TEMP .TYPTMP>)>
+   <COND (<AND .BRANCH .FLS>
+         <COND (<NOT .DIR> <BRANCH-TAG .B2> <LABEL-TAG .B3>)
+               (ELSE <LABEL-TAG .B3>)>
+         <FREE-TEMP .STRD>)
+        (<OR .NOTF <AND <NOT .SETF> <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>>
+         <COND (<==? .STRD .W> <DEALLOCATE-TEMP .STRD>)
+               (ELSE <FREE-TEMP .STRD>)>
+         <COND (<AND .NOTF .DIR> <BRANCH-TAG .B3>)>
+         <LABEL-TAG .B2>
+         <MOVE-ARG <REFERENCE .SDIR>
+                   <SET W
+                        <COND (<==? .W DONT-CARE> <GEN-TEMP <>>) (ELSE .W)>>>
+         <BRANCH-TAG .BRANCH>
+         <COND (.SETF
+                <DEALLOCATE-TEMP .W>
+                <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>)>
+         <LABEL-TAG .B3>)
+        (ELSE
+         <COND (.BRANCH
+                <COND (<==? .B2 .BRANCH>
+                       <LABEL-TAG .B3>
+                       <SET W <MOVE-ARG .STRD .W>>)
+                      (<NOT .DIR>
+                       <LABEL-TAG .B2>
+                       <COND (.SETF
+                              <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <>> .W>>)>
+                       <BRANCH-TAG .BRANCH>
+                       <LABEL-TAG .B3>
+                       <SET W <MOVE-ARG .STRD .W>>)
+                      (ELSE
+                       <BRANCH-TAG .B3>
+                       <LABEL-TAG .B2>
+                       <SET W <MOVE-ARG .STRD .W>>
+                       <BRANCH-TAG .BRANCH>
+                       <LABEL-TAG .B3>
+                       <COND (.SETF
+                              <DEALLOCATE-TEMP .W>
+                              <MOVE-ARG <REFERENCE <>> .W>)>)>)
+               (ELSE
+                <DEALLOCATE-TEMP .STRD>
+                <LABEL-TAG .B2>
+                <SET W
+                     <MOVE-ARG <REFERENCE <>>
+                               <COND (<==? .W DONT-CARE> .STRD)
+                                     (ELSE .W)>>>
+                <COND (<==? .W .STRD>
+                       <LABEL-TAG .B3>
+                       .W)
+                      (ELSE
+                       <DEALLOCATE-TEMP .W>
+                       <BRANCH-TAG <SET B4 <MAKE-TAG>>>
+                       <LABEL-TAG .B3>
+                       <SET W <MOVE-ARG .STRD .W>>
+                       <LABEL-TAG .B4>)>)>)>
+   <MOVE-ARG .W .RW>>
+
+<ENDPACKAGE>