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

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