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

diff --git a/<mdl.comp>/infcmp.mud.21 b/<mdl.comp>/infcmp.mud.21
new file mode 100644
index 0000000..3828c1a
--- /dev/null
+++ b/<mdl.comp>/infcmp.mud.21
@@ -0,0 +1,257 @@
+<PACKAGE "INFCMP">
+
+<ENTRY ALLTYPES-ANA ROOT-ANA ERRORS-ANA INTERRUPTS-ANA INFO-GEN OBLIST?-ANA OBLIST?-GEN
+       ASSOCIATIONS-ANA NEXT-ANA ASSOC-HACK ASSOC-FIELD-GET AS-NXT-GEN>
+
+<USE "SYMANA" "CHKDCL" "CODGEN" "CACS" "COMCOD" "COMPDEC">
+
+<DEFINE ALLTYPES-ANA (N R) 
+	<INFO-GET .N .R |TYPVEC '<VECTOR [REST ATOM]>>>
+
+<DEFINE ROOT-ANA (N R) <INFO-GET .N .R |ROOT OBLIST>>
+
+<DEFINE ERRORS-ANA (N R) <INFO-GET .N .R |ERROBL OBLISTT>>
+
+<DEFINE INTERRUPTS-ANA (N R) <INFO-GET .N .R |INTOBL OBLIST>>
+
+<DEFINE INFO-GET (N R SYM TYP) 
+	#DECL ((N) NODE)
+	<ARGCHK <LENGTH <KIDS .N>> 0 <NODE-NAME .N>>
+	<PUT .N ,NODE-TYPE ,INFO-CODE>
+	<PUT .N ,NODE-NAME .SYM>
+	<TYPE-OK? .R .TYP>>
+
+<DEFINE INFO-GEN (N W
+		  "AUX" (ADR <ADDRESS:C <NODE-NAME .N>>))
+	#DECL ((N) NODE (VALUE) DATUM)
+	<MOVE:ARG <DATUM <ISTYPE? <RESULT-TYPE .N>> .ADR> .W>>
+
+<PUT ,ALLTYPES ANALYSIS ,ALLTYPES-ANA>
+
+<PUT ,ROOT ANALYSIS ,ROOT-ANA>
+
+<PUT ,ERRORS ANALYSIS ,ERRORS-ANA>
+
+<PUT ,INTERRUPTS ANALYSIS ,INTERRUPTS-ANA>
+
+<DEFINE OBLIST?-ANA (N R "AUX" (K <KIDS .N>)) 
+	#DECL ((N) NODE (K) <LIST [REST NODE]>)
+	<COND (<SEGFLUSH .N .R>)
+	      (ELSE
+	       <ARGCHK <LENGTH .K> 1 OBLIST?>
+	       <EANA <1 .K> ATOM OBLIST?>
+	       <PUT .N ,NODE-TYPE ,OBLIST?-CODE>)>
+	<TYPE-OK? '<OR FALSE OBLIST> .R>>
+
+<PUT ,OBLIST? ANALYSIS ,OBLIST?-ANA>
+
+<DEFINE OBLIST?-GEN (N W
+		     "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
+		     "AUX" (FLS <==? .W FLUSHED>) (SDIR .DIR)
+			   (B2
+			    <COND (<AND .FLS .BRANCH> .BRANCH)
+				  (ELSE <MAKE:TAG>)>) (B3 <MAKE:TAG>) (RW .W)
+			   ATO B4 VAC W2)
+   #DECL ((N) NODE (ATO) DATUM (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
+   <SET W <GOODACS .N .W>>
+   <AND .NOTF <SET DIR <NOT .DIR>>>
+   <SET ATO <GEN <1 <KIDS .N>> <DATUM ATOM ANY-AC>>>
+   <VAR-STORE <>>
+   <COND
+    (<AND .BRANCH .FLS>
+     <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
+	    <EMIT <INSTRUCTION <COND (.DIR `SKIPE ) (ELSE `SKIPN )>
+			       2
+			       (<ADDRSYM <DATVAL .ATO>>)>>
+	    <BRANCH:TAG .BRANCH>
+	    <RET-TMP-AC .ATO>)
+	   (ELSE
+	    <EMIT <INSTRUCTION `HRRZ 2 (<ADDRSYM <DATVAL .ATO>>)>>
+	    <EMIT <INSTRUCTION <COND (.DIR `JUMPN) (ELSE `JUMPE)> .BRANCH>>
+	    <RET-TMP-AC .ATO>)>)
+    (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
+     <RET-TMP-AC .ATO>
+     <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
+	    <EMIT <INSTRUCTION <COND (.DIR `SKIPE ) (ELSE `SKIPN )>
+			       2
+			       (<ADDRSYM <DATVAL .ATO>>)>>
+	    <BRANCH:TAG .B3>)
+	   (ELSE
+	    <EMIT <INSTRUCTION `HRRZ 2 (<ADDRSYM <DATVAL .ATO>>)>>
+	    <EMIT <INSTRUCTION <COND (.DIR `JUMPN) (ELSE `JUMPE)> .B3>>)>
+     <MOVE:ARG <REFERENCE .SDIR> .W>
+     <BRANCH:TAG .BRANCH>
+     <LABEL:TAG .B3>)
+    (ELSE
+     <SET W2 <DATUM OBLIST <DATVAL .W>>>
+     <COND (<TYPE? <DATVAL .W2> AC>
+	    <SGETREG <SET VAC <DATVAL .W2>> .W2>)
+	   (ELSE <PUT .W2 ,DATVAL <SET VAC <GETREG .W2>>>)>
+     <RET-TMP-AC .ATO>
+     <COND (.BRANCH
+	    <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
+		   <EMIT <INSTRUCTION `SKIPN <ACSYM .VAC> 2
+				      (<ADDRSYM <DATVAL .ATO>>)>>)
+		  (ELSE
+		   <EMIT <INSTRUCTION `HRRZ <ACSYM .VAC> 2
+				      (<ADDRSYM <DATVAL .ATO>>)>>)>
+	    <COND (<==? .BRANCH .B2>
+		   <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
+			  <BRANCH:TAG .BRANCH>)
+			 (ELSE
+			  <EMIT <INSTRUCTION `JUMPE <ACSYM .VAC> .BRANCH>>)>
+		   <GEN-OBL .VAC .W .W2>)
+		  (ELSE
+		   <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
+			  <BRANCH:TAG .B3>)
+			 (ELSE
+			  <EMIT <INSTRUCTION `JUMPE <ACSYM .VAC> .B3>>)>
+		   <GEN-OBL .VAC .W .W2>
+		   <BRANCH:TAG .BRANCH>
+		   <LABEL:TAG .B3>)>)
+	   (ELSE
+	    <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
+		   <EMIT <INSTRUCTION `SKIPN <ACSYM .VAC> 2
+				      (<ADDRSYM <DATVAL .ATO>>)>>
+		   <BRANCH:TAG .B2>)
+		  (ELSE
+		   <EMIT <INSTRUCTION `HRRZ <ACSYM .VAC> 2
+				      (<ADDRSYM <DATVAL .ATO>>)>>
+		   <EMIT <INSTRUCTION `JUMPE <ACSYM .VAC> .B2>>)>
+	    <GEN-OBL .VAC .W .W2>
+	    <RET-TMP-AC .W>
+	    <BRANCH:TAG .B3>
+	    <LABEL:TAG .B2>
+	    <MOVE:ARG <REFERENCE <>> .W>
+	    <LABEL:TAG .B3>)>)>
+   <MOVE:ARG .W .RW>>
+
+<DEFINE GEN-OBL (AC W1 W2 "AUX" (B <MAKE:TAG>)) 
+	#DECL ((AC) AC (W1 W2) DATUM)
+	<COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
+	       <EMIT <INSTRUCTION `JUMPL  <ACSYM .AC> .B>>
+	       <EMIT <INSTRUCTION `MOVE  <ACSYM .AC> (<ADDRSYM .AC>)>>
+	       <LABEL:TAG .B>)
+	      (ELSE
+	       <EMIT <INSTRUCTION `CAMGE  <ACSYM .AC> |VECBOT>>
+	       <EMIT <INSTRUCTION `MOVE  <ACSYM .AC> (<ADDRSYM .AC>)>>
+	       <EMIT <INSTRUCTION `HRLI <ACSYM .AC> -1>>)>
+	<MOVE:ARG .W2 .W1>>
+
+<DEFINE ASSOCIATIONS-ANA (N R) <AS-NXT .N .R <>>>
+
+<DEFINE NEXT-ANA (N R) <AS-NXT .N .R T>>
+
+<DEFINE AS-NXT (N R ARG) 
+	<COND (<SEGFLUSH .N .R>)
+	      (ELSE
+	       <COND (.ARG
+		      <ARGCHK <LENGTH <KIDS .N>> 1 NEXT>
+		      <EANA <1 <KIDS .N>> ASOC NEXT>)
+		     (ELSE <ARGCHK <LENGTH <KIDS .N>> 0 ASSOCIATIONS>)>
+	       <PUT .N ,NODE-TYPE ,AS-NXT-CODE>)>
+	<TYPE-OK? .R '<OR ASOC FALSE>>>
+
+<DEFINE ASSOC-HACK (N R) 
+	<COND (<SEGFLUSH .N .R>)
+	      (ELSE
+	       <ARGCHK <LENGTH <KIDS .N>> 1 <NODE-NAME .N>>
+	       <EANA <1 <KIDS .N>> ASOC <NODE-NAME .N>>
+	       <PUT .N ,NODE-TYPE ,AS-IT-IND-VAL-CODE>)>
+	<TYPE-OK? .R ANY>>
+
+<PUT ,ASSOCIATIONS ANALYSIS ,ASSOCIATIONS-ANA>
+
+<PUT ,NEXT ANALYSIS ,NEXT-ANA>
+
+<PUT ,ITEM ANALYSIS ,ASSOC-HACK>
+
+<PUT ,INDICATOR ANALYSIS ,ASSOC-HACK>
+
+<PUT ,AVALUE ANALYSIS ,ASSOC-HACK>
+
+<DEFINE ASSOC-FIELD-GET (N W "AUX" (NN <1 <KIDS .N>>) DAT OFF) 
+	#DECL ((N NN) NODE (OFF) FIX)
+	<SET OFF
+	     <COND (<==? <NODE-SUBR .N> ,ITEM> 0)
+		   (<==? <NODE-SUBR .N> ,AVALUE> 2)
+		   (ELSE 4)>>
+	<SET DAT <GEN .NN <DATUM ASOC ANY-AC>>>
+	<SET DAT <OFFPTR .OFF .DAT ASOC>>
+	<MOVE:ARG <DATUM .DAT .DAT> .W>>
+
+<DEFINE AS-NXT-GEN (N W
+		    "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
+		    "AUX" (FLS <==? .W FLUSHED>) (SDIR .DIR)
+			  (B2
+			   <COND (<AND .FLS .BRANCH> .BRANCH)
+				 (ELSE <MAKE:TAG>)>) (B3 <MAKE:TAG>) (RW .W) ATO
+			  B4 VAC W2)
+   #DECL ((N) NODE (ATO) DATUM (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
+   <SET W <GOODACS .N .W>>
+   <AND .NOTF <SET DIR <NOT .DIR>>>
+   <SET ATO
+	<COND (<==? <NODE-NAME .N> NEXT>
+	       <GEN <1 <KIDS .N>> <DATUM ASOC ANY-AC>>)
+	      (ELSE
+	       <SET ATO <DATUM ASOC ANY-AC>>
+	       <PUT .ATO ,DATVAL <GETREG .ATO>>
+	       <EMIT <INSTRUCTION `MOVE 
+				  <ACSYM <DATVAL .ATO>>
+				  |NODES
+				  1>>
+	       .ATO)>>
+   <VAR-STORE <>>
+   <COND
+    (<AND .BRANCH .FLS>
+     <EMIT <INSTRUCTION `HRRZ  `O*  6 (<ADDRSYM <DATVAL .ATO>>)>>
+     <EMIT <INSTRUCTION <COND (.DIR `JUMPN ) (ELSE `JUMPE )>
+			`O* 
+			.BRANCH>>
+     <RET-TMP-AC .ATO>)
+    (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
+     <RET-TMP-AC .ATO>
+     <EMIT <INSTRUCTION `HRRZ  `O*  6 (<ADDRSYM <DATVAL .ATO>>)>>
+     <EMIT <INSTRUCTION <COND (.DIR `JUMPN ) (ELSE `JUMPE )> `O*  .B3>>
+     <MOVE:ARG <REFERENCE .SDIR> .W>
+     <BRANCH:TAG .BRANCH>
+     <LABEL:TAG .B3>)
+    (ELSE
+     <SET W2 <DATUM ASOC <DATVAL .W>>>
+     <COND (<TYPE? <DATVAL .W2> AC>
+	    <SGETREG <SET VAC <DATVAL .W2>> .W2>)
+	   (ELSE <PUT .W2 ,DATVAL <SET VAC <GETREG .W2>>>)>
+     <RET-TMP-AC .ATO>
+     <COND (.BRANCH
+	    <COND (<==? .BRANCH .B2>
+		   <EMIT <INSTRUCTION `HRRZ 
+				      <ACSYM .VAC>
+				      6
+				      (<ADDRSYM <DATVAL .ATO>>)>>
+		   <EMIT <INSTRUCTION `JUMPE  <ACSYM .VAC> .BRANCH>>
+		   <MOVE:ARG .W2 .W>)
+		  (ELSE
+		   <EMIT <INSTRUCTION `HRRZ 
+				      <ACSYM .VAC>
+				      6
+				      (<ADDRSYM <DATVAL .ATO>>)>>
+		   <EMIT <INSTRUCTION `JUMPE  <ACSYM .VAC> .B3>>
+		   <MOVE:ARG .W2 .W>
+		   <BRANCH:TAG .BRANCH>
+		   <LABEL:TAG .B3>)>)
+	   (ELSE
+	    <EMIT <INSTRUCTION `HRRZ 
+			       <ACSYM .VAC>
+			       6
+			       (<ADDRSYM <DATVAL .ATO>>)>>
+	    <EMIT <INSTRUCTION `JUMPE  <ACSYM .VAC> .B2>>
+	    <MOVE:ARG .W2 .W>
+	    <RET-TMP-AC .W>
+	    <BRANCH:TAG .B3>
+	    <LABEL:TAG .B2>
+	    <MOVE:ARG <REFERENCE <>> .W>
+	    <LABEL:TAG .B3>)>)>
+   <MOVE:ARG .W .RW>>
+
+<ENDPACKAGE>
+
\ No newline at end of file