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

diff --git a/<mdl.comp>/mapana.mud.231 b/<mdl.comp>/mapana.mud.231
new file mode 100644
index 0000000..e66683f
--- /dev/null
+++ b/<mdl.comp>/mapana.mud.231
@@ -0,0 +1,398 @@
+<PACKAGE "MAPANA">
+
+<ENTRY MAPPER-AN MAPRET-STOP-ANA MAPLEAVE-ANA MENTROPY MAUX MAUX1 MTUPLE MBAD
+       MOPT MOPT2 MARGS-ANA MNORM>
+
+<USE "SYMANA" "CHKDCL" "COMPDEC" "ADVMESS">
+
+<SETG SPECIAL-MAPF-R-SUBRS ![,LIST ,+ ,* ,MAX ,MIN!]>
+
+<DEFINE MAPPER-AN (MNOD MRTYP
+		   "AUX" (K <KIDS .MNOD>) TT ITRNOD FAP T TF (MPSTRS ())
+			 (R? <==? <NODE-SUBR .MNOD> ,MAPR>) (TUPCNT 1)
+			 (RETYPS NO-RETURN) TEM ASSU L-D L-V D-V VALSPCD SBR
+			 (SBRL <>) (SEGFX ()) FINTYPE STATE (FRET T) (FSTOP T)
+			 (OV .VARTBL) NSTR (CHF <>))
+   #DECL ((FAP ITRNOD) NODE (K) <LIST [REST NODE]> (TUPCNT TT NSTR) FIX
+	  (MPSTRS L-V D-V) <SPECIAL LIST> (R?) <SPECIAL <OR ATOM FALSE>>
+	  (STATE) <SPECIAL FIX> (SEGFX) <SPECIAL <LIST [REST NODE]>>
+	  (MNOD) <SPECIAL NODE> (OV) SYMTAB
+	  (FRET FSTOP MRTYP RETYPS) <SPECIAL ANY> (VALSPCD) <SPECIAL LIST>
+	  (ASSU L-D) LIST (SBRL) <OR UVECTOR FALSE>)
+   <SET TF <EANA <SET FAP <1 .K>> ANY <NODE-NAME .MNOD>>>
+   <COND (<AND <SET SBR <SUBAP? .FAP>>
+	       <SET SBRL <MEMQ ,.SBR ,SPECIAL-MAPF-R-SUBRS>>>
+	  <PUT .FAP ,NODE-TYPE ,MFIRST-CODE>
+	  <COND (<N==? ,.SBR ,LIST> <SET FINTYPE '<OR FIX FLOAT>> <SET STATE 1>)
+		(ELSE <SET FINTYPE LIST>)>
+	  <PUT .FAP ,NODE-SUBR <LENGTH .SBRL>>)>
+   <PUT .MNOD ,STACKS <* <SET NSTR <- <LENGTH .K> 2>> 2>>
+   <SET ITRNOD <2 .K>>
+   <MAPF <>
+	 <FUNCTION (N) 
+		 #DECL ((N) NODE)
+		 <COND (<L? <MINL <RESULT-TYPE .N>> 1> <SET CHF T>)>>
+	 <REST .K 2>>
+   <COND
+    (<==? <SET TT <NODE-TYPE .ITRNOD>> ,MFCN-CODE>
+     <PUT .ITRNOD ,SIDE-EFFECTS <>>
+     <MAPF <>
+      <FUNCTION (N "AUX" RT R) 
+	      #DECL ((N) NODE)
+	      <SET RT <EANA .N STRUCTURED <NODE-NAME .MNOD>>>
+	      <COND (<AND .VERBOSE
+			  <OR <NOT <SET R <STRUCTYP .RT>>> <==? .R TEMPLATE>>>
+		     <ADDVMESS
+		      .MNOD
+		      ("Non-specific structure for MAPF/R:  "
+		       .N
+		       " type is:  "
+		       .RT)>)>>
+      <SET K <REST .K 2>>>
+     <SET L-D <SAVE-L-D-STATE .VARTBL>>
+     <PROG ((HTMPS 0) (TMPS 0) (VARTBL <SYMTAB .ITRNOD>) (KK .K) (LL .LIFE)
+	    (OVV .VERBOSE))
+	   #DECL ((HTMPS TMPS) <SPECIAL FIX> (VARTBL) <SPECIAL SYMTAB>
+		  (KK) <LIST [REST NODE]>)
+	   <COND (.VERBOSE <PUTREST <SET VERBOSE .OVV> ()>)>
+	   <SET LIFE .LL>
+	   <SET L-V ()>
+	   <SET FSTOP T>
+	   <RESET-VARS .VARTBL .OV>
+	   <MUNG-L-D-STATE .VARTBL>
+	   <SET K .KK>
+	   <SET RETYPS NO-RETURN>
+	   <SET ASSU <BUILD-TYPE-LIST .OV>>
+	   <SET VALSPCD <BUILD-TYPE-LIST .OV>>
+	   <REPEAT ((CNT <+ .NSTR 1>) (B <BINDING-STRUCTURE .ITRNOD>))
+		   #DECL ((B) <LIST [REST SYMTAB]> (CNT) FIX)
+		   <COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)>
+		   <PUT <1 .B> ,CODE-SYM 3>
+		   <PUT <1 .B> ,USED-AT-ALL T>
+		   <SET B <REST .B>>>
+	   <REPEAT ((BNDS <REST <BINDING-STRUCTURE .ITRNOD> <+ .NSTR 1>>))
+		   <COND (<EMPTY? .BNDS>
+			  <AND <NOT <EMPTY? .K>>
+			      <MESSAGE ERROR
+				       "MAPF FUNC TAKES TOO FEW ARGS. "
+				       .ITRNOD>>
+			  <RETURN>)>
+		   <AND <APPLY <NTH ,MAPANALS <CODE-SYM <1 .BNDS>>>
+			      <1 .BNDS>
+			      <COND (<NOT <EMPTY? .K>> <1 .K>)>>
+		       <SET BNDS <REST .BNDS>>>
+		   <OR <EMPTY? .K> <SET K <REST .K>>>>
+	   <PUT .ITRNOD ,VSPCD (())>
+	   <PROG ((STMPS .TMPS) (SHTMPS .HTMPS) (LL .LIFE) (OV .VERBOSE))
+		 #DECL ((STMPS SHTMPS) FIX)
+		 <COND (.VERBOSE <PUTREST <SET VERBOSE .OV> ()>)>
+		 <SET LIFE .LL>
+		 <SET FRET T>
+		 <SET TMPS .STMPS>
+		 <SET HTMPS .SHTMPS>
+		 <PUT .ITRNOD ,ASSUM <BUILD-TYPE-LIST .VARTBL>>
+		 <PUT .ITRNOD ,ACCUM-TYPE NO-RETURN>
+		 <SET TEM <SEQ-AN <KIDS .ITRNOD> <INIT-DECL-TYPE .ITRNOD>>>
+		 <OR <NOT <AGND .ITRNOD>>
+		     <ASSUM-OK? <ASSUM .ITRNOD> <AGND .ITRNOD>>
+		     <AGAIN>>>
+	   <COND (<N==? .TEM NO-RETURN>
+		  <COND (<NOT .FRET>
+			 <SET L-V <MSAVE-L-D-STATE .L-V .OV>>
+			 <ASSERT-TYPES <ORUPC .VARTBL <VSPCD .ITRNOD>>>)
+			(ELSE <SET L-V <SAVE-L-D-STATE .OV>>)>)
+		 (<N==? <ACCUM-TYPE .ITRNOD> NO-RETURN>
+		  <ASSERT-TYPES <VSPCD .ITRNOD>>)>
+	   <SET VALSPCD <ORUPC .OV .VALSPCD>>
+	   <OR <ASSUM-OK? .ASSU <BUILD-TYPE-LIST .VARTBL>> <AGAIN>>
+	   <PUT .ITRNOD ,ACCUM-TYPE <TYPE-MERGE .TEM <ACCUM-TYPE .ITRNOD>>>
+	   <PUT .ITRNOD
+		,RESULT-TYPE
+		<TYPE-OK? <ACCUM-TYPE .ITRNOD> <INIT-DECL-TYPE .ITRNOD>>>>
+     <ASSERT-TYPES .VALSPCD>
+     <COND (<ASSIGNED? STATE>
+	    <FIX-STATE <ACCUM-TYPE .ITRNOD> .ITRNOD>
+	    <COND (<G? .STATE 4>
+		   <SET SBRL <>>
+		   <PUT .FAP ,NODE-TYPE ,GVAL-CODE>
+		   <SET FINTYPE '<OR FIX FLOAT>>)
+		  (ELSE
+		   <SET FINTYPE <NTH '![FIX FLOAT FLOAT!] <- .STATE 1>>>)>)>
+     <SAVE-SURVIVORS .L-D .LIFE T>
+     <SAVE-SURVIVORS .L-V .LIFE>
+     <SET D-V
+	  <COND (.FSTOP <SAVE-L-D-STATE .VARTBL>)
+		(ELSE <MSAVE-L-D-STATE .D-V .VARTBL>)>>
+     <FREST-L-D-STATE .D-V>
+     <SET LIFE <KILL-REM .LIFE .OV>>
+     <COND (.SBRL <MUNG-SEGS .SEGFX>)>
+     <COND (<SIDE-EFFECTS .ITRNOD>
+	    <PUT .MNOD
+		 ,SIDE-EFFECTS
+		 (!<SIDE-EFFECTS .ITRNOD> !<SIDE-EFFECTS .MNOD>)>)>
+     <COND (<AND <==? <NODE-TYPE .FAP> ,QUOTE-CODE>
+		 <==? <NODE-NAME .FAP> #FALSE ()>>
+	    <TYPE-OK? <COND (.CHF <TYPE-MERGE FALSE .TEM .RETYPS>)
+			    (ELSE <TYPE-OK? <TYPE-MERGE .TEM .RETYPS> .MRTYP>)>
+		      .MRTYP>)
+	   (<ASSIGNED? FINTYPE>
+	    <COND (<==? .FINTYPE LIST>
+		   <TYPE-OK? <TYPE-MERGE <FORM LIST
+					       [REST <RESULT-TYPE .ITRNOD>]>
+					 .RETYPS>
+			     .MRTYP>)
+		  (ELSE <TYPE-OK? <TYPE-MERGE .FINTYPE .RETYPS> .MRTYP>)>)
+	   (<AND <==? <NODE-TYPE .FAP> ,GVAL-CODE>
+		 <MEMQ <NODE-NAME .FAP> '![VECTOR UVECTOR!]>>
+	    <SET TEM <FORM <NODE-NAME .FAP> [REST .TEM]>>
+	    <TYPE-OK? <TYPE-MERGE .RETYPS .TEM> .MRTYP>)
+	   (ELSE <TYPE-OK? <TYPE-MERGE <APPLTYP .FAP> .RETYPS> .MRTYP>)>)
+    (ELSE
+     <COND (<N==? .TT ,MPSBR-CODE> <EANA .ITRNOD APPLICABLE <NODE-NAME .MNOD>>)>
+     <MAPF <>
+      <FUNCTION (N "AUX" RT R) 
+	      #DECL ((N) NODE)
+	      <SET RT <EANA .N STRUCTURED <NODE-NAME .MNOD>>>
+	      <COND (<AND .VERBOSE
+			  <OR <NOT <SET R <STRUCTYP .RT>>> <==? .R TEMPLATE>>>
+		     <ADDVMESS
+		      .MNOD
+		      ("Non-specific structure for MAPF/R:  "
+		       .N
+		       " type is:  "
+		       .RT)>)>>
+      <SET MPSTRS <REST .K 2>>>
+     <COND (<==? .TT ,MPSBR-CODE>
+	    <SET TEM <EANA <1 <KIDS .ITRNOD>> ANY <NODE-NAME .MNOD>>>
+	    <COND (.CHF <SET TEM <TYPE-MERGE .TEM FALSE>>)>)
+	   (ELSE <SET TEM ANY>)>
+     <COND (<ASSIGNED? STATE>
+	    <FIX-STATE .TEM <1 <KIDS .ITRNOD>>>
+	    <COND (<G? .STATE 4>
+		   <SET SBRL <>>
+		   <PUT .FAP ,NODE-TYPE ,GVAL-CODE>
+		   <SET FINTYPE '<OR FIX FLOAT>>)
+		  (ELSE
+		   <SET FINTYPE <NTH '![FIX FLOAT FLOAT!] <- .STATE 1>>>)>)>
+     <COND (.SBRL <MUNG-SEGS .SEGFX>)>
+     <COND (<AND <==? <NODE-TYPE .FAP> ,QUOTE-CODE>
+		 <==? <NODE-NAME .FAP> #FALSE ()>>
+	    <TYPE-OK? .TEM .MRTYP>)
+	   (<ASSIGNED? FINTYPE>
+	    <COND (<==? .FINTYPE LIST>
+		   <TYPE-OK? <FORM LIST [REST .TEM]> .MRTYP>)
+		  (ELSE <TYPE-OK? .FINTYPE .MRTYP>)>)
+	   (<AND <==? <NODE-TYPE .FAP> ,GVAL-CODE>
+		 <MEMQ <NODE-NAME .FAP> '![VECTOR UVECTOR!]>>
+	    <SET TEM <FORM <NODE-NAME .FAP> [REST .TEM]>>
+	    <TYPE-OK? <TYPE-MERGE .RETYPS .TEM> .MRTYP>)
+	   (ELSE <TYPE-OK? <APPLTYP .FAP> .MRTYP>)>)>>
+
+\ 
+
+<DEFINE FIX-STATE (TEM N "AUX" TT (SG <MEMQ <NODE-TYPE .N> ,SEG-CODES>)) 
+	#DECL ((STATE TT) FIX (N) NODE)
+	<SET TT
+	     <COND (<==? .TEM FIX> 1)
+		   (<==? .TEM FLOAT> 2)
+		   (<NOT <TYPE-OK? .TEM FLOAT>>
+		    <PUT .N
+			 ,RESULT-TYPE
+			 <COND (.SG
+				<TYPE-MERGE '<STRUCTURED [REST FIX]>
+					    <RESULT-TYPE .N>>)
+			       (ELSE FIX)>>
+		    1)
+		   (<NOT <TYPE-OK? .TEM FIX>>
+		    <PUT .N
+			 ,RESULT-TYPE
+			 <COND (.SG
+				<TYPE-MERGE '<STRUCTURED [REST FLOAT]>
+					    <RESULT-TYPE .N>>)
+			       (ELSE FLOAT)>>
+		    2)
+		   (ELSE 3)>>
+	<SET STATE <NTH <NTH ,ASTATE .STATE> .TT>>>
+
+<SETG SEG-CODES ![,SEG-CODE ,SEGMENT-CODE!]>
+
+<DEFINE MUNG-SEGS (SEGS) 
+	#DECL ((SEGS) <LIST [REST NODE]>)
+	<MAPF <>
+	      <FUNCTION (N) #DECL ((N) NODE) <PUT .N ,NODE-TYPE ,SEG-CODE>>
+	      .SEGS>>  
+ 
+<DEFINE MARGS-ANA (N R "AUX" (MK .MPSTRS) (NN <NODE-NAME .N>)) 
+	#DECL ((N) NODE (NN) FIX (MK) <LIST [REST NODE]>)
+	<SET R
+	     <TYPE-OK? <GET-ELE-TYPE <RESULT-TYPE <NTH .MK .NN>> ALL .R?>
+		       .R>>
+	<COND (.R? <TYPE-OK? .R '<STRUCTURED ANY>>) (ELSE .R)>>
+
+<DEFINE MAUX (SYM STRUC) 
+	#DECL ((SYM) SYMTAB (STRUC) <OR FALSE NODE>)
+	<COND (.STRUC <MESSAGE ERROR "TOO MANY ARGS TOO MAPF FCN ">)
+	      (ELSE <NORM-BAN .SYM>)>
+	T>   
+ 
+<DEFINE MAUX1 (SYM STRUC) 
+	#DECL ((SYM) SYMTAB (STRUC) <OR FALSE NODE>)
+	<COND (.STRUC <MESSAGE ERROR "TOO MANY ARGS TO MAPF FCN ">)>
+	T>    
+ 
+<DEFINE MNORM (SYM STRUC "AUX" (VARTBL <NEXT-SYM .SYM>) TEM COD N) 
+	#DECL ((SYM) SYMTAB (STRUC) <OR NODE FALSE> (VARTBL) <SPECIAL SYMTAB>
+	       (MNOD N) NODE)
+	<COND (.STRUC
+	       <PUT .SYM ,PURE-SYM <>>		  ;"Tell VARANA to allocate me."
+	       <OR <SET TEM
+			<TYPE-OK? <GET-ELE-TYPE <RESULT-TYPE .STRUC> ALL .R?>
+				  <1 <DECL-SYM .SYM>>>>
+		   <MESSAGE ERROR "BAD MAP FUNC ARG " <NAME-SYM .SYM>>>
+	       <COND (.R? <SET TEM <TYPE-AND .TEM '<STRUCTURED ANY>>>)>
+	       <COND (<N=? .TEM <1 <DECL-SYM .SYM>>>
+		      <PUT .SYM ,CURRENT-TYPE .TEM>)>
+	       <PUT .SYM ,COMPOSIT-TYPE .TEM>)
+	      (ELSE <MESSAGE ERROR "TOO FEW MAPF ARGS FOR FCN ">)>
+	T>
+
+<DEFINE MOPT (SYM STRUC "AUX" (VARTBL <NEXT-SYM .SYM>)) 
+	#DECL ((SYM) SYMTAB (VARTBL) <SPECIAL SYMTAB> (STRUC) <OR FALSE NODE>)
+	<COND (.STRUC <PUT .SYM ,INIT-SYM <>> <MNORM .SYM .STRUC>)
+	      (ELSE <NORM-BAN .SYM>)>
+	T>   
+ 
+<DEFINE MBAD (SYM STRUC) <MESSAGE ERROR "BAD ARG DECL IN MAP FCN " <NAME-SYM .SYM>>> 
+ 
+<DEFINE MOPT2 (SYM STRUC) <COND (.STRUC <MNORM .SYM .STRUC>)> T> 
+\ 
+
+<DEFINE MTUPLE (SYM STRUC
+		"AUX" (VARTBL <NEXT-SYM .SYM>)
+		      (ATYP
+		       <GET-ELE-TYPE <1 <DECL-SYM .SYM>>
+				     <SET TUPCNT <+ .TUPCNT 1>>>))
+	<COND (.STRUC
+	       <COND (.R?
+		      <SET TEM <EANA .STRUC STRUCTURED .NAME>>
+		      <==? <STRUCTYP .TEM> <STRUCTYP .ATYP>>)
+		     (ELSE
+		      <OR <TYPE-OK? <GET-ELE-TYPE <EANA .STRUC STRUCTURED .NAME>
+						      ALL>
+					.ATYP>
+			      <MESSAGE ERROR "BAD MAP FCN ARG " <NAME-SYM .SYM>>>)>
+	       <>)
+	      (ELSE T)>>    
+ 
+<DEFINE MENTROPY (N R) T>
+ 
+<SETG MAPANALS
+      [,MENTROPY
+       ,MAUX
+       ,MAUX1
+       ,MTUPLE
+       ,MBAD
+       ,MOPT
+       ,MOPT
+       ,MOPT2
+       ,MOPT2
+       ,MBAD
+       ,MENTROPY
+       ,MNORM
+       ,MNORM]>
+
+"Additional SUBR analyzers associated with MAP hackers."
+
+<DEFINE MAPLEAVE-ANA (N R "AUX" (K <KIDS .N>) (LN <LENGTH .K>) TEM) 
+	#DECL ((N) NODE (K) <LIST [REST NODE]> (LN) FIX)
+	<COND (<ASSIGNED? MNOD>
+	       <ARGCHK .LN '(0 1) MAPLEAVE>
+	       <COND (<0? .LN>
+		      <PUT .N
+			   ,KIDS
+			   <SET K (<NODE1 ,QUOTE-CODE .N ATOM T ()>)>>)>
+	       <SET TEM <EANA <1 .K> .MRTYP MAPLEAVE>>
+	       <SET VALSPCD <ORUPC .VARTBL .VALSPCD>>
+	       <SET D-V
+		    <COND (.FSTOP <SAVE-L-D-STATE .VARTBL>)
+			  (ELSE <MSAVE-L-D-STATE .D-V .VARTBL>)>>
+	       <SET FSTOP <>>
+	       <SET RETYPS <TYPE-MERGE .RETYPS .TEM>>
+	       <PUT .N ,NODE-TYPE ,MAPLEAVE-CODE>)
+	      (ELSE <SUBR-C-AN .N .R>)>
+	NO-RETURN>
+
+\ 
+
+<DEFINE MAPRET-STOP-ANA (NOD R "AUX" (ARGS 0) (TYP NO-RETURN) TYP1 ITRNOD) 
+   #DECL ((MNOD NOD ITRNOD) NODE (ARGS) FIX)
+   <PROG ()
+     <OR <ASSIGNED? MNOD> <RETURN <SUBR-C-AN .NOD .R>>>
+     <SET ITRNOD <2 <KIDS .MNOD>>>
+     <OR <NODE-NAME <1 <KIDS .MNOD>>>
+	 <MESSAGE ERROR " NOTHING TO MAPSTOP/RET TO " .MNOD>>
+     <MAPF <>
+      <FUNCTION (N) 
+	      #DECL ((N) NODE)
+	      <COND (<OR <==? <NODE-TYPE .N> ,SEGMENT-CODE>
+			 <==? <NODE-TYPE .N> ,SEG-CODE>>
+		     <SET TYP1
+			  <EANA <1 <KIDS .N>>
+				<COND (<ASSIGNED? STATE>
+				       '<STRUCTURED [REST <OR FIX FLOAT>]>)
+				      (ELSE STRUCTURED)>
+				SEGMENT>>
+		     <COND (<ASSIGNED? STATE> <SET STATE 5>)
+			   (ELSE <SET SEGFX (.N !.SEGFX)>)>
+		     <SET TYP <TYPE-MERGE .TYP <GET-ELE-TYPE .TYP1 ALL>>>
+		     <PUT .NOD ,SEGS T>)
+		    (ELSE
+		     <SET ARGS <+ .ARGS 1>>
+		     <SET TYP
+			  <TYPE-MERGE
+			   .TYP
+			   <EANA .N
+				 <COND (<ASSIGNED? STATE> '<OR FIX FLOAT>)
+				       (ELSE ANY)>
+				 <NODE-NAME .NOD>>>>)>>
+      <KIDS .NOD>>
+     <AND <ASSIGNED? STATE> <N==? .TYP NO-RETURN> <FIX-STATE .TYP .NOD>>
+     <COND (<==? <NODE-SUBR .NOD> ,MAPRET>
+	    <SET L-V
+		 <COND (.FRET <SAVE-L-D-STATE .VARTBL>)
+		       (ELSE <MSAVE-L-D-STATE .L-V .VARTBL>)>>
+	    <PUT .ITRNOD
+		 ,VSPCD
+		 <COND (.FRET <BUILD-TYPE-LIST .VARTBL>)
+		       (ELSE <ORUPC .VARTBL <VSPCD .ITRNOD>>)>>
+	    <SET FRET <>>)
+	   (ELSE
+	    <SET D-V
+		 <COND (.FSTOP <SAVE-L-D-STATE .VARTBL>)
+		       (ELSE <MSAVE-L-D-STATE .D-V .VARTBL>)>>
+	    <SET VALSPCD <ORUPC .VARTBL .VALSPCD>>
+	    <SET FSTOP <>>)>
+     <PUT <2 <KIDS .MNOD>>
+	  ,ACCUM-TYPE
+	  <TYPE-MERGE <ACCUM-TYPE <2 <KIDS .MNOD>>> .TYP>>
+     <PUT .NOD ,STACKS <* .ARGS 2>>
+     <PUT .NOD ,NODE-TYPE ,MAPRET-STOP-CODE>>
+   NO-RETURN>
+
+<PUT ,MAPLEAVE ANALYSIS ,MAPLEAVE-ANA>
+
+<PUT ,MAPRET ANALYSIS ,MAPRET-STOP-ANA>
+
+<PUT ,MAPSTOP ANALYSIS ,MAPRET-STOP-ANA>
+
+<DEFINE SUBAP? (NOD "AUX" TT (COD 0)) 
+	#DECL ((COD) FIX (NOD) NODE)
+	<AND <OR <==? <SET COD <NODE-TYPE .NOD>> ,FGVAL-CODE>
+		 <==? .COD ,GVAL-CODE>
+		 <==? .COD ,MFIRST-CODE>>
+	     <==? <NODE-TYPE <SET NOD <1 <KIDS .NOD>>>> ,QUOTE-CODE>
+	     <GASSIGNED? <SET TT <NODE-NAME .NOD>>>
+	     <TYPE? ,.TT SUBR>
+	     .TT>>
+
+<ENDPACKAGE>