X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.comp%3E%2Ftest.gen.3;fp=%3Cmdl.comp%3E%2Ftest.gen.3;h=3eef8e840902b21f68ec6ce41bfbc3e0d1a7f881;hp=0000000000000000000000000000000000000000;hb=3395a5e4ef72d59cdb6832af7808dc9c2cf2a413;hpb=363cc6ead5cf4df20759797fe46b5dc29b3886e9

diff --git a/<mdl.comp>/test.gen.3 b/<mdl.comp>/test.gen.3
new file mode 100644
index 0000000..3eef8e8
--- /dev/null
+++ b/<mdl.comp>/test.gen.3
@@ -0,0 +1,230 @@
+<PACKAGE "STRGEN">
+
+<ENTRY NTH-GEN REST-GEN PUT-GEN LNTH-GEN MT-GEN PUTREST-GEN IPUT-GEN
+	IREMAS-GEN FLUSH-COMMON-SYMT COMMUTE-STRUC DEFER-IT PUT-COMMON-DAT
+	LIST-LNT-SPEC RCHK>
+
+<USE "CODGEN" "CACS" "COMCOD" "CHKDCL" "COMPDEC" "SPCGEN" "COMTEM" "CARGEN">
+<DEFINE PUTREST-GEN (NOD WHERE
+		     "AUX" ST1 ST2 (K <KIDS .NOD>) (FLG T) N CD (ONO .NO-KILL)
+			   (NO-KILL .ONO) (2RET <>))
+	#DECL ((NOD N) NODE (K) <LIST NODE NODE> (ST1 ST2) DATUM
+	       (NO-KILL) <SPECIAL LIST> (ONO) LIST)
+	<COND (<==? <NODE-SUBR .NOD> ,REST>
+	       <SET NOD <1 .K>>
+	       <SET K <KIDS .NOD>>
+	       <SET 2RET T>)>			   ;"Really <REST <PUTREST ...."
+	<COND (<AND <==? <NODE-TYPE <2 .K>> ,QUOTE-CODE>
+		    <==? <NODE-NAME <2 .K>> ()>>
+	       <SET ST1 <GEN <1 .K> <UPDATE-WHERE .NOD .WHERE>>>)
+	      (<AND <NOT <SIDE-EFFECTS? <1 .K>>>
+		    <NOT <SIDE-EFFECTS? <2 .K>>>
+		    <MEMQ <NODE-TYPE <1 .K>> ,SNODES>>
+	       <AND <==? <NODE-TYPE <SET N <1 .K>>> ,LVAL-CODE>
+		    <COND (<==? <LENGTH <SET CD <TYPE-INFO .N>>> 2> <2 .CD>)
+			  (ELSE T)>
+		    <SET CD <NODE-NAME .N>>
+		    <NOT <MAPF <>
+			       <FUNCTION (LL) 
+				       #DECL ((LL) <LIST SYMTAB ANY>)
+				       <AND <==? .CD <1 .LL>> <MAPLEAVE>>>
+			       .NO-KILL>>
+		    <SET NO-KILL ((.CD <>) !.NO-KILL)>>
+	       <SET ST2
+		    <GEN <2 .K>
+			 <COND (.2RET <GOODACS <2 .K> .WHERE>)
+			       (ELSE <DATUM LIST ANY-AC>)>>>
+	       <SET ST1
+		    <GEN <1 .K>
+			 <COND (.2RET DONT-CARE)
+			       (ELSE <UPDATE-WHERE .NOD .WHERE>)>>>
+	       <DELAY-KILL .NO-KILL .ONO>)
+	      (ELSE
+	       <SET ST1
+		    <GEN <1 .K>
+			 <GOODACS .NOD
+				  <COND (<OR <==? .WHERE FLUSHED> .2RET>
+					 DONT-CARE)
+					(ELSE .WHERE)>>>>
+	       <SET ST2 <GEN <2 .K> <DATUM LIST ANY-AC>>>)>
+	<KILL-COMMON LIST>
+	<AND .CAREFUL
+	     <G? 1 <MINL <RESULT-TYPE <1 .K>>>>
+	     <COND (<TYPE? <DATVAL .ST1> AC>
+		    <EMIT <INSTRUCTION `JUMPE  <ACSYM <DATVAL .ST1>> |CERR2 >>)
+		   (ELSE
+		    <EMIT <INSTRUCTION `SKIPN  !<ADDR:VALUE .ST1>>>
+		    <BRANCH:TAG |CERR2 >)>>
+	<AND <ASSIGNED? ST2> <TOACV .ST2>>
+	<OR <TYPE? <DATVAL .ST1> AC> <SET FLG <>>>
+	<COND (<ASSIGNED? ST2>
+	       <COND (.FLG
+		      <EMIT <INSTRUCTION `HRRM 
+					 <ACSYM <CHTYPE <DATVAL .ST2> AC>>
+					 (<ADDRSYM <CHTYPE <DATVAL .ST1> AC>>)>>)
+		     (ELSE
+		      <EMIT <INSTRUCTION `HRRM 
+					 <ACSYM <CHTYPE <DATVAL .ST2> AC>>
+					 `@ 
+					 !<ADDR:VALUE .ST1>>>)>
+	       <RET-TMP-AC <COND (.2RET .ST1) (ELSE .ST2)>>)
+	      (ELSE
+	       <COND (.FLG
+		      <EMIT <INSTRUCTION `HLLZS  (<ADDRSYM <CHTYPE <DATVAL .ST1> AC>>)>>)
+		     (ELSE
+		      <EMIT <INSTRUCTION `HLLZS  `@  !<ADDR:VALUE .ST1>>>)>)>
+	<MOVE:ARG <COND (.2RET .ST2) (ELSE .ST1)> .WHERE>>
+
+<PUT ,GENERATORS ,PUTREST-CODE ,PUTREST-GEN>
+<DEFINE FLUSH-COMMON-SYMT (SYMT) 
+   #DECL ((SYMT) SYMTAB)
+   <MAPF <>
+    <FUNCTION (AC "AUX" ACR) 
+	    #DECL ((AC) AC)
+	    <SET ACR
+		 <COND (<SET ACR <ACRESIDUE .AC>>
+			<COND (<EQSYMT <1 .ACR> .SYMT> <REST .ACR>)
+			      (<REPEAT ((PTR <REST .ACR>) (SACR .ACR))
+				       <COND (<EMPTY? .PTR> <RETURN .SACR>)>
+				       <COND (<EQSYMT <1 .PTR> .SYMT>
+					      <PUTREST .ACR <REST .PTR>>
+					      <RETURN .SACR>)>
+				       <SET PTR <REST .PTR>>
+				       <SET ACR <REST .ACR>>>)>)>>
+	    <PUT .AC ,ACRESIDUE <COND (<EMPTY? .ACR> <>) (ELSE .ACR)>>>
+    ,ALLACS>>
+
+<ENDPACKAGE>
+<PACKAGE "CARGEN">
+
+<ENTRY ARITH-GEN ABS-GEN FLOAT-GEN FIX-GEN MOD-GEN ROT-GEN LSH-GEN 1?-GEN
+       GEN-FLOAT GENFLOAT MIN-MAX PRED:BRANCH:GEN 0-TEST FLIP TEST-GEN>
+
+<USE "CACS" "CODGEN" "CHKDCL" "COMCOD" "COMPDEC" "CONFOR" "STRGEN">
+
+<DEFINE TEST-GEN (NOD WHERE
+		  "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
+		  "AUX" (K <1 <KIDS .NOD>>) (K2 <2 <KIDS .NOD>>) REGT REGT2
+			(S <SW? <NODE-NAME .NOD>>) TRANSFORM ATYP ATYP2 B2
+			(SDIR .DIR) (RW .WHERE) TRANS1 (FLS <==? .RW FLUSHED>)
+			TEM (ONO .NO-KILL) (NO-KILL .ONO)
+		  "ACT" TA)
+   #DECL ((NOD K K2) NODE (REGT) DATUM (TRANSFORM) <SPECIAL TRANS>
+	  (TRANS1) TRANS (NO-KILL) <SPECIAL LIST>)
+   <SET WHERE
+	<COND (<==? .WHERE FLUSHED> FLUSHED)
+	      (ELSE <UPDATE-WHERE .NOD .WHERE>)>>
+   <COND (<OR <==? <NODE-TYPE .K2> ,QUOTE-CODE>
+	      <AND <NOT <MEMQ <NODE-TYPE .K> ,SNODES>>
+		   <NOT <SIDE-EFFECTS .NOD>>
+		   <MEMQ <NODE-TYPE .K2> ,SNODES>>>
+	  <COND (<AND <==? <NODE-TYPE .K> ,LVAL-CODE>
+		      <COND (<==? <LENGTH <SET TEM <TYPE-INFO .K>>> 2> <2 .TEM>)
+			    (ELSE T)>
+		      <SET TEM <NODE-NAME .K>>
+		      <NOT <MAPF <>
+				 <FUNCTION (LL) 
+					 <AND <==? <1 .LL> .TEM> <MAPLEAVE>>>
+				 .NO-KILL>>>
+		 <SET NO-KILL ((<NODE-NAME .K> <>) !.NO-KILL)>)>
+	  <SET K .K2>
+	  <SET K2 <1 <KIDS .NOD>>>
+	  <PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>)>
+   <SET ATYP <ISTYPE? <RESULT-TYPE .K2>>>
+   <SET ATYP2 <ISTYPE-GOOD? <RESULT-TYPE .K>>>
+   <SET REGT
+	<DATUM <COND (.ATYP .ATYP) (ELSE ANY-AC)> ANY-AC>>
+   <SET REGT2
+	<COND (<OR <==? <NODE-TYPE .K> ,QUOTE-CODE>
+		   <NOT <SIDE-EFFECTS .K2>>>
+	       DONT-CARE)
+	      (.ATYP2 <DATUM .ATYP2 ANY-AC>)
+	      (ELSE <DATUM ANY-AC ANY-AC>)>>
+   <COND (<N==? <NODE-TYPE .K> ,QUOTE-CODE>
+	  <COND (<OR <==? .ATYP FLOAT> <==? .ATYP2 FLOAT>>)
+		(ELSE
+		 <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>
+		 <PUT <2 .TRANSFORM> 6 1>
+		 <PUT <2 .TRANSFORM> 7 0>)>
+	  <SET REGT2 <GEN .K .REGT2>>
+	  <COND (<ASSIGNED? TRANSFORM>
+		 <SET TRANS1 .TRANSFORM>
+		 <SET TRANSFORM <UPDATE-TRANS .NOD .TRANS1>>)>
+	  <COND (<TYPE? <DATVAL .REGT2> AC>
+		 <SET REGT <GEN .K2 DONT-CARE>>
+		 <COND (<TYPE? <DATVAL .REGT2> AC>
+			<PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>
+			<SET TEM .REGT>
+			<SET REGT .REGT2>
+			<SET REGT2 .TEM>
+			<COND (<ASSIGNED? TRANSFORM>
+			       <SET TEM .TRANS1>
+			       <SET TRANS1 .TRANSFORM>
+			       <SET TRANSFORM .TEM>)>
+			<SET TEM .ATYP>
+			<SET ATYP .ATYP2>
+			<SET ATYP2 .TEM>)
+		       (ELSE <TOACV .REGT>)>)
+		(ELSE <SET REGT <GEN .K2 .REGT>>)>)
+	 (ELSE
+	  <COND (<OR <==? .ATYP FIX>
+		     <0? <NODE-NAME .K>>
+		     <1? <NODE-NAME .K>>>
+		 <SET TRANSFORM <MAKE-TRANS .NOD 1 1 0 1 1 <+ 2 <- .S>> .S>>)>
+	  <COND (<==? .ATYP FIX>
+		 <PUT <PUT <2 .TRANSFORM> 2 1> 3 <FIX <NODE-NAME .K>>>)>
+	  <COND (<LN-LST .K2> <SET REGT ,NO-DATUM>)
+		(ELSE
+		 <SET REGT <GEN .K2 .REGT>>
+		 <DATTYP-FLUSH .REGT>
+		 <PUT .REGT ,DATTYP .ATYP>)>
+	  <RETURN
+	   <TEST-DISP .NOD
+		      .WHERE
+		      .NOTF
+		      .BRANCH
+		      .DIR
+		      .REGT
+		      <COND (<ASSIGNED? TRANSFORM>
+			     <DO-TRANS <FIX <NODE-NAME .K>> .TRANSFORM>)
+			    (ELSE <NODE-NAME .K>)>
+		      <AND <ASSIGNED? TRANSFORM> <NOT <0? <1 <3 .TRANSFORM>>>>>>
+	   .TA>)>
+   <DELAY-KILL .NO-KILL .ONO>
+   <AND <ASSIGNED? TRANSFORM>
+	<CONFORM .REGT .REGT2 .TRANSFORM .TRANS1>
+	<PUT .NOD ,NODE-NAME <FLOP <NODE-NAME .NOD>>>>
+   <COND (.BRANCH
+	  <AND .NOTF <SET DIR <NOT .DIR>>>
+	  <VAR-STORE <>>
+	  <GEN-COMP2 <NODE-NAME .NOD>
+		     .ATYP2
+		     .ATYP
+		     .REGT2
+		     .REGT
+		     <COND (.FLS .DIR) (ELSE <NOT .DIR>)>
+		     <COND (.FLS .BRANCH) (ELSE <SET B2 <MAKE:TAG>>)>>
+	  <COND (<NOT .FLS>
+		 <SET RW <MOVE:ARG <MOVE:ARG <REFERENCE .SDIR> .WHERE> .RW>>
+		 <BRANCH:TAG .BRANCH>
+		 <LABEL:TAG .B2>
+		 .RW)>)
+	 (ELSE
+	  <VAR-STORE <>>
+	  <GEN-COMP2 <NODE-NAME .NOD>
+		     .ATYP2
+		     .ATYP
+		     .REGT2
+		     .REGT
+		     .NOTF
+		     <SET BRANCH <MAKE:TAG>>>
+	  <MOVE:ARG <REFERENCE T> .WHERE>
+	  <RET-TMP-AC .WHERE>
+	  <BRANCH:TAG <SET B2 <MAKE:TAG>>>
+	  <LABEL:TAG .BRANCH>
+	  <MOVE:ARG <REFERENCE <>> .WHERE>
+	  <LABEL:TAG .B2>
+	  <MOVE:ARG .WHERE .RW>)>>
+
+<PUT ,GENERATORS ,TEST-CODE ,TEST-GEN>
+<ENDPACKAGE>
\ No newline at end of file