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

diff --git a/mim/development/mim/mimc/bitsgen.mud b/mim/development/mim/mimc/bitsgen.mud
new file mode 100644
index 0000000..6f20d05
--- /dev/null
+++ b/mim/development/mim/mimc/bitsgen.mud
@@ -0,0 +1,100 @@
+
+<PACKAGE "BITSGEN">
+
+<ENTRY BITLOG-GEN FGETBITS-GEN FPUTBITS-GEN>
+
+<USE "COMPDEC" "CODGEN" "CHKDCL" "MIMGEN">
+
+<DEFINE FGETBITS-GEN (N W "AUX" (K <KIDS .N>) REG S WI) 
+	#DECL ((N) NODE (K) <LIST [REST NODE]>)
+	<SET REG <GEN <1 .K>>>
+	<SET S <GEN <2 .K>>>
+	<FREE-TEMP <SET WI <GEN <3 .K>>> <>>
+	<FREE-TEMP .S <>>
+	<IEMIT `GETBITS
+	       .REG
+	       .S
+	       .WI
+	       =
+	       <COND (<N==? .W DONT-CARE>
+		      <FREE-TEMP .REG <>>
+		      <COND (<TYPE? .W TEMP> <USE-TEMP .W FIX>)>
+		      .W)
+		     (<AND <TYPE? .REG TEMP> <L=? <TEMP-REFS .REG> 1>>
+		      <SET W .REG>)
+		     (ELSE <FREE-TEMP .REG <>> <SET W <GEN-TEMP>>)>>
+	.W>
+
+<DEFINE FPUTBITS-GEN (N W
+		      "AUX" (K <KIDS .N>) REG S WI F
+			    (TY <ISTYPE? <RESULT-TYPE .N>>))
+	#DECL ((N) NODE (K) <LIST [REST NODE]>)
+	<SET REG <GEN <1 .K>>>
+	<SET S <GEN <2 .K>>>
+	<SET WI <GEN <3 .K>>>
+	<FREE-TEMP <SET F <GEN <4 .K>>> <>>
+	<FREE-TEMP .S <>>
+	<FREE-TEMP .WI <>>
+	<IEMIT `PUTBITS
+	       .REG
+	       .S
+	       .WI
+	       .F
+	       =
+	       <COND (<N==? .W DONT-CARE>
+		      <FREE-TEMP .REG <>>
+		      <COND (<TYPE? .W TEMP> <USE-TEMP .W .TY>)>
+		      .W)
+		     (<AND <TYPE? .REG TEMP> <L=? <TEMP-REFS .REG> 1>>
+		      <SET W .REG>)
+		     (ELSE
+		      <FREE-TEMP .REG <>>
+		      <SET W <GEN-TEMP <COND (.TY) (T)>>>)>>
+	.W>
+
+<DEFINE BITLOG-GEN (N W
+		    "AUX" (K <KIDS .N>) (FST <1 .K>)
+			  (INS <LGINS <NODE-SUBR .N>>) REG)
+	#DECL ((FST N) NODE (K) <LIST [REST NODE]>)
+	<COND (<==? <NODE-TYPE .FST> ,QUOTE-CODE>
+	       <PUT .K 1 <2 .K>>
+	       <PUT .K 2 .FST>)>
+	<SET REG <GEN <1 .K>>>
+	<MAPR <>
+	      <FUNCTION (NP "AUX" (NN <1 .NP>) (NXT <GEN .NN DONT-CARE>) TT
+				  (LAST <EMPTY? <REST .NP>>)) 
+		      #DECL ((NN) NODE (NP) <LIST NODE>)
+		      <IEMIT .INS
+			     .REG
+			     .NXT
+			     =
+			     <COND (<AND .LAST <OR <TYPE? .W TEMP>
+						   <==? .W ,POP-STACK>>>
+				    <COND (<N==? .W .REG>
+					   <FREE-TEMP .REG <>>
+					   <COND (<TYPE? .W TEMP>
+						  <USE-TEMP .W FIX>)>)>
+				    <SET REG .W>)
+				   (<AND .LAST
+					 <==? .W DONT-CARE>
+					 <TYPE? .REG TEMP>
+					 <L=? <TEMP-REFS .REG> 1>> .REG)
+				   (<OR <NOT <TYPE? .REG TEMP>>
+					<G? <TEMP-REFS .REG> 1>>
+				    <COND (<TYPE? .REG TEMP>
+					   <FREE-TEMP .REG <>>)>
+				    <SET REG <GEN-TEMP FIX>>)
+				   (ELSE .REG)>>
+		      <FREE-TEMP .NXT>>
+	      <REST .K>>
+	<MOVE-ARG .REG .W>>
+
+<DEFINE LGINS (SUBR) 
+	<NTH '[`AND `OR `XOR `EQV]
+	     <LENGTH <MEMQ .SUBR ,LSUBRS>>>>
+
+<SETG LSUBRS [,EQVB ,XORB ,ORB ,ANDB]>
+
+<GDECL (LSUBRS) VECTOR>
+
+<ENDPACKAGE>