X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=mim%2Fdevelopment%2Fmim%2Fmimc%2Fmmqgen.mud;fp=mim%2Fdevelopment%2Fmim%2Fmimc%2Fmmqgen.mud;h=6fb29523df5a3feb8e469a204ef0aa4fccca82c5;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hp=0000000000000000000000000000000000000000;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07;p=pdp10-muddle.git

diff --git a/mim/development/mim/mimc/mmqgen.mud b/mim/development/mim/mimc/mmqgen.mud
new file mode 100644
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>