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

diff --git a/<mdl.comp>/comtem.mud.2 b/<mdl.comp>/comtem.mud.2
new file mode 100644
index 0000000..8894fb4
--- /dev/null
+++ b/<mdl.comp>/comtem.mud.2
@@ -0,0 +1,361 @@
+<PACKAGE "COMTEM">
+
+<ENTRY TEMPLATE-NTH TEMPLATE-PUT GET:TEMPLATE:LENGTH>
+
+<USE "CODGEN" "CACS" "CHKDCL" "COMCOD" "COMPDEC">
+
+<DEFINE TEMPLATE-NTH (NOD WHERE TYP TPS NK NNUM STRN NUMN
+		      "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) EX1 EX2
+		      "AUX" RLEN COMPLFORM (DIR1 .DIR)
+			    (FLS <==? .WHERE FLUSHED>)
+			    (B2 <COND (.BRANCH .BRANCH) (ELSE <MAKE:TAG>)>)
+			    (TTYPE <GET <SET TYP <ISTYPE? .TYP>> TEMPLATE-DATA>)
+			    DEST (NORMUSE <1 .TTYPE>) (RESTUSE <2 .TTYPE>)
+			    (RX <GEN .STRN <DATUM .TYP ANY-AC>>) RUSE LENCOMB PC
+			    TYPER PCA BITR IDX AC1 AC2)
+   #DECL ((B2 TYPER) ATOM (AC1 AC2) <PRIMTYPE WORD>
+	  (NNUM RLEN LENCOMB PC PCA IDX) FIX (DEST) <LIST <PRIMTYPE WORD>>
+	  (RX RUSE) DATUM (TTYPE) <VECTOR [2 LIST] [2 FIX] ANY [2 FIX]>
+	  (RESTUSE NORMUSE) <LIST [REST LIST]> (COMPLFORM) <LIST ATOM [4 FIX]>
+	  (STRN NOD) NODE)
+   <AND .NOTF <SET DIR <NOT .DIR>>>
+   <COND (<G? .NNUM <3 .TTYPE>>
+	  <COND (<0? <4 .TTYPE>> <MESSAGE ERROR TEMPLATE-OVERFLOW!-ERRORS>)>
+	  <SET RLEN <+ 1 <MOD <- .NNUM 1 <3 .TTYPE>> <4 .TTYPE>>>>
+	  <SET COMPLFORM <NTH .RESTUSE .RLEN>>
+	  <SET COMPLFORM
+	       (<1 .COMPLFORM>
+		<2 .COMPLFORM>
+		<3 .COMPLFORM>
+		<+ <4 .COMPLFORM>
+		   <* <7 .TTYPE>
+		      <COND (<G? <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1> 0>
+			     <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1>)
+			    (ELSE 0)>>>
+		<5 .COMPLFORM>)>)
+	 (ELSE <SET COMPLFORM <NTH .NORMUSE .NNUM>>)>
+   <SET RUSE
+	<GOODACS .NOD <COND (.FLS DONT-CARE) (ELSE .WHERE)>>>
+   <SET TYPER <1 .COMPLFORM>>
+   <SET PCA <3 .COMPLFORM>>
+   <SET PC <5 .COMPLFORM>>
+   <SET LENCOMB <2 .COMPLFORM>>
+   <SET DEST (<ADDRSYM <DATVAL .RX>>)>
+   <COND (<AND <NOT <==? .LENCOMB 72>>
+	       <NOT <1? .LENCOMB>>
+	       <NOT <==? .LENCOMB 36>>>
+	  <COND (<==? <DATVAL .RUSE> ANY-AC>
+		 <PUT .RUSE ,DATVAL <GETREG .RUSE>>)
+		(ELSE <SGETREG <DATVAL .RUSE> .RUSE>)>
+	  <SET AC2 <ACSYM <DATVAL .RUSE>>>)>
+   <COND (<5 .TTYPE>
+	  <SET IDX <+ <4 .COMPLFORM> 1>>
+	  <MUNG-AC <DATVAL .RX> .RX>
+	  <EMIT <INSTRUCTION `LDB  `O  [<FORM (74816) 1 .DEST>]>>
+	  <EMIT <INSTRUCTION `SUB  <ACSYM <DATVAL .RX>> `O >>)
+	 (ELSE <SET IDX <- <4 .COMPLFORM> <6 .TTYPE>>>)>
+   <COND (<OR <AND <NOT <==? .LENCOMB 72>> <G? .LENCOMB 36>>
+	      <AND <==? .LENCOMB 36> <NOT <0? .PCA>>>>
+	  <COND (<==? <DATTYP .RUSE> ANY-AC>
+		 <PUT .RUSE ,DATTYP <GETREG .RUSE>>)
+		(ELSE <SGETREG <DATTYP .RUSE> .RUSE>)>
+	  <SET AC1 <ACSYM <DATTYP .RUSE>>>)>
+   <TOACV .RX>
+   <SET DEST (<ADDRSYM <DATVAL .RX>>)>
+   <COND
+    (<==? .LENCOMB 72>
+     <COND (<NOT .FLS>
+	    <COND (<AND .BRANCH .NOTF>
+		   <SET WHERE <MOVE:ARG <REFERENCE .DIR1> .RUSE>>)
+		  (ELSE
+		   <PUT .RUSE ,DATTYP <OFFPTR .IDX .RX .TYP>>
+		   <PUT .RUSE ,DATVAL <OFFPTR .IDX .RX .TYP>>
+		   <SET WHERE <MOVE:ARG .RUSE .WHERE>>)>)>
+     <COND (.BRANCH
+	    <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
+			       `O 
+			       .IDX
+			       (!<ADDR:VALUE .RX>)>>
+	    <EMIT <INSTRUCTION <COND (.DIR `CAIE ) (ELSE `CAIN )>
+			       `O 
+			       '<TYPE-CODE!-OP!-PACKAGE FALSE>>>
+	    <BRANCH:TAG .BRANCH>)>
+     <COND (<OR .FLS <AND .BRANCH .NOTF>> <RET-TMP-AC .RX>)>)
+    (<NOT <0? .PCA>>
+     <COND (<==? .LENCOMB 36>
+	    <EMIT <INSTRUCTION `MOVE  .AC2 .IDX .DEST>>
+	    <RET-TMP-AC .RX>
+	    <EMIT <INSTRUCTION `HRLI  .AC1 '<TYPE-CODE!-OP!-PACKAGE STRING>>>
+	    <EMIT <INSTRUCTION `HRRI  .AC1 .PCA>>)
+	   (ELSE
+	    <PUT .RUSE ,DATTYP .TYPER>
+	    <COND (<==? .PC 36> <EMIT <INSTRUCTION `HLR  .AC2 .IDX .DEST>>)
+		  (ELSE <EMIT <INSTRUCTION `HRR  .AC2 .IDX .DEST>>)>
+	    <RET-TMP-AC .RX>
+	    <EMIT <INSTRUCTION `HRLI 
+			       .AC2
+			       <COND (<==? .TYPER UVECTOR> <- .PCA>)
+				     (ELSE <* -2 .PCA>)>>>)>)
+    (<==? .LENCOMB 54>
+     <COND (<==? .PC 36>
+	    <EMIT <INSTRUCTION `MOVE  .AC2 .IDX .DEST>>
+	    <EMIT <INSTRUCTION `HLR  .AC1 <+ .IDX 1> .DEST>>)
+	   (ELSE
+	    <EMIT <INSTRUCTION `MOVE  .AC2 <+ .IDX 1> .DEST>>
+	    <EMIT <INSTRUCTION `HRR  .AC1 .IDX .DEST>>)>
+     <EMIT <INSTRUCTION `HRLI  .AC1 '<TYPE-CODE!-OP!-PACKAGE STRING>>>
+     <RET-TMP-AC .RX>)
+    (<==? .LENCOMB 36>
+     <PUT .RUSE ,DATTYP .TYPER>
+     <PUT .RUSE ,DATVAL <OFFPTR <- .IDX 1> .RX .TYP>>)
+    (<==? .LENCOMB 18>
+     <PUT .RUSE ,DATTYP .TYPER>
+     <COND (<AND <==? .TYPER FALSE> .FLS>)
+	   (<EMIT <INSTRUCTION <COND (<==? .PC 36>
+				      <COND (<==? .TYPER FIX> `HLRE )
+					    (<==? .TYPER FLOAT> `HLLZ )
+					    (ELSE `HLRZ )>)
+				     (ELSE
+				      <COND (<==? .TYPER FIX> `HRRE )
+					    (<==? .TYPER FLOAT> `HRLZ )
+					    (ELSE `HRRZ )>)>
+			       .AC2
+			       .IDX
+			       .DEST>>)>
+     <COND (<==? .TYPER FALSE>
+	    <COND (<NOT .FLS> <SET WHERE <MOVE:ARG .RUSE .WHERE>>)>
+	    <COND (<AND .BRANCH <NOT .DIR>> <BRANCH:TAG .BRANCH>)>)>)
+    (<1? .LENCOMB>
+     <EMIT <INSTRUCTION `MOVE  `O  .IDX .DEST>>
+     <SET BITR
+	  <BITS 1 <COND (<G? .PC 18> <- .PC 19>) (ELSE <- .PC 1>)>>>
+     <SET BITR
+	  <PUTBITS #WORD *000000000000* .BITR #WORD *777777777777*>>
+     <RET-TMP-AC .RX>
+     <COND (<OR <AND <NOT .DIR> <NOT .BRANCH> <NOT .FLS>>
+		<AND <NOT .DIR1> <NOT .FLS>>>
+	    <RET-TMP-AC <MOVE:ARG <REFERENCE <>> .RUSE>>)>
+     <COND (<G? .PC 18> <EMIT <INSTRUCTION `TLNN  `O  .BITR>>)
+	   (ELSE <EMIT <INSTRUCTION `TRNN  `O  .BITR>>)>
+     <SET BITR <MAKE:TAG>>
+     <COND (<NOT .DIR> <BRANCH:TAG .B2>)
+	   (ELSE <BRANCH:TAG .BITR>)>
+     <COND (<OR <AND <NOT .DIR> <NOT .BRANCH> <NOT .FLS>>
+		<AND .DIR1 <NOT .FLS>>>
+	    <MOVE:ARG <REFERENCE T> .RUSE>)>
+     <COND (<AND .DIR .BRANCH> <BRANCH:TAG .B2>)>
+     <LABEL:TAG .BITR>
+     <COND (<NOT .BRANCH> <LABEL:TAG .B2>)>)
+    (ELSE
+     <PUT .RUSE ,DATTYP .TYPER>
+     <EMIT <INSTRUCTION `LDB 
+			.AC2
+			<BYTE <- .PC .LENCOMB> .LENCOMB .IDX .DEST>>>)>
+   <COND (<NOT <OR <NOT <0? .PCA>>
+		   <G? .LENCOMB 36>
+		   <1? .LENCOMB>
+		   <==? .LENCOMB 36>>>
+	  <RET-TMP-AC .RX>)>
+   <COND (<AND <NOT <==? .LENCOMB 72>> <NOT <==? .TYPER FALSE>>>
+	  <MOVE:ARG .RUSE .WHERE>)
+	 (ELSE .WHERE)>>
+
+\ 
+
+<DEFINE TEMPLATE-PUT (NOD WHERE TYP TPS NK NNUM SNOD NNOD VNOD
+		      "OPTIONAL" EX1 EX2
+		      "AUX" CK YDAT XDAT RLEN DEST COMPLFORM XTP VDAT
+			    (TTYPE <GET <SET TYP <ISTYPE? .TYP>> TEMPLATE-DATA>)
+			    (NORMUSE <1 .TTYPE>) (RESTUSE <2 .TTYPE>)
+			    (RX <GEN .SNOD <GOODACS .NOD .WHERE>>) LENCOMB PC
+			    TYPER PCA BITR IDX AC1 AC2 TT)
+   #DECL ((PCA NNUM PC IDX LENCOMB RLEN) FIX (TYPER) ATOM
+	  (AC1 AC2) <PRIMTYPE WORD> (DEST) <LIST <PRIMTYPE WORD>>
+	  (RX XDAT YDAT VDAT) DATUM (RESTUSE NORMUSE) <LIST [REST LIST]>
+	  (TTYPE) <VECTOR [2 LIST] [2 FIX] ANY [2 FIX]>
+	  (COMPLFORM) <LIST ATOM [4 FIX]> (SNOD VNOD NOD) NODE)
+   <COND (<G? .NNUM <3 .TTYPE>>
+	  <COND (<0? <4 .TTYPE>> <MESSAGE ERROR TEMPLATE-OVERFLOW!-ERRORS>)>
+	  <SET RLEN <+ 1 <MOD <- .NNUM 1 <3 .TTYPE>> <4 .TTYPE>>>>
+	  <SET COMPLFORM <NTH .RESTUSE .RLEN>>
+	  <SET COMPLFORM
+	       (<1 .COMPLFORM>
+		<2 .COMPLFORM>
+		<3 .COMPLFORM>
+		<+ <4 .COMPLFORM>
+		   <* <7 .TTYPE>
+		      <COND (<G? <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1> 0>
+			     <- </ <- .NNUM <3 .TTYPE>> <4 .TTYPE>> 1>)
+			    (ELSE 0)>>>
+		<5 .COMPLFORM>)>)
+	 (ELSE <SET COMPLFORM <NTH .NORMUSE .NNUM>>)>
+   <SET LENCOMB <2 .COMPLFORM>>
+   <SET TYPER <1 .COMPLFORM>>
+   <SET PCA <3 .COMPLFORM>>
+   <SET PC <5 .COMPLFORM>>
+   <TOACV .RX>
+   <SET DEST (<ADDRSYM <DATVAL .RX>>)>
+   <COND (<SET CK <5 .TTYPE>>
+	  <SET IDX <+ <4 .COMPLFORM> 1>>
+	  <COND (<AND <5 .TTYPE> <N==? .WHERE FLUSHED>>
+		 <PUT <DATVAL .RX> ,ACPROT T>
+		 <SET YDAT <DATUM .TYP ANY-AC>>
+		 <PUT .YDAT ,DATVAL <GETREG .YDAT>>
+		 <EMIT <INSTRUCTION `MOVE 
+				    <ACSYM <DATVAL .YDAT>>
+				    <ADDRSYM <DATVAL .RX>>>>
+		 <PUT <DATVAL .RX> ,ACPROT <>>)>)
+	 (ELSE <SET IDX <- <4 .COMPLFORM> <6 .TTYPE>>>)>
+   <SET XTP <ISTYPE? <RESULT-TYPE .VNOD>>>
+   <COND
+    (<NOT <1? .LENCOMB>>
+     <SET VDAT
+	  <GEN .VNOD
+	       <DATUM <COND (<NOT <ISTYPE-GOOD? .XTP>> ANY-AC) (ELSE .XTP)>
+		      ANY-AC>>>
+     <COND
+      (<AND <NOT <==? .LENCOMB 72>>
+	    <SET XTP <ISTYPE? <RESULT-TYPE .VNOD>>>>
+       <COND (<NOT <OR <==? .TYPER .XTP> <1? .LENCOMB>>>
+	      <MESSAGE ERROR TEMPLATE-TYPE-ERROR-PUT!-ERRORS>)>)
+      (ELSE
+       <COND (<AND .CAREFUL
+		   <NOT <==? .TYPER ANY>>
+		   <NOT <==? <RESULT-TYPE .VNOD> .TYPER>>>
+	      <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  !<ADDR:TYPE .VDAT>>>
+	      <EMIT <INSTRUCTION `CAIE 
+				 `O 
+				 <FORM TYPE-CODE!-OP!-PACKAGE .TYPER>>>
+	      <BRANCH:TAG |COMPER >)>)>)>
+   <TOACV .RX>
+   <SET DEST (<ADDRSYM <DATVAL .RX>>)>
+   <COND (<AND .CK <NOT <1? .LENCOMB>>>
+	  <MUNG-AC <DATVAL .RX> .RX>
+	  <EMIT <INSTRUCTION `LDB  `O  [<FORM (74816) 1 .DEST>]>>
+	  <EMIT <INSTRUCTION `SUB  <ACSYM <DATVAL .RX>> `O >>)>
+   <COND (<NOT <1? .LENCOMB>> <SET AC2 <ACSYM <DATVAL .VDAT>>>)>
+   <COND
+    (<==? .LENCOMB 72>
+     <TOACT .VDAT>
+     <EMIT <INSTRUCTION `MOVEM  <ACSYM <DATTYP .VDAT>> .IDX .DEST>>
+     <RET-TMP-AC <DATTYP .VDAT> .VDAT>
+     <EMIT <INSTRUCTION `MOVEM  .AC2 <+ .IDX 1> .DEST>>)
+    (<NOT <0? .PCA>>
+     <COND (<==? .LENCOMB 36>
+	    <COND (.CAREFUL
+		   <EMIT `HRRZ  `O  !<ADDR:TYPE .VDAT>>
+		   <EMIT <INSTRUCTION `CAIE  <ACSYM <DATTYP .VDAT>> .PCA>>
+		   <BRANCH:TAG |COMPER >)>
+	    <EMIT <INSTRUCTION `MOVEM  .AC2 .IDX .DEST>>)
+	   (ELSE
+	    <COND (.CAREFUL
+		   <EMIT <INSTRUCTION `HLRZ  `O  <ADDRSYM <DATVAL .VDAT>>>>
+		   <EMIT <INSTRUCTION `CAIE 
+				      `O 
+				      <COND (<==? .TYPER UVECTOR> <- .PCA>)
+					    (ELSE <* -2 .PCA>)>>>
+		   <BRANCH:TAG |COMPER >)>
+	    <EMIT <INSTRUCTION <COND (<==? .PC 36> `HRLM ) (ELSE `HRRM )>
+			       .AC2
+			       .IDX
+			       .DEST>>)>)
+    (<==? .LENCOMB 54>
+     <TOACT .VDAT>
+     <COND (<==? .PC 36>
+	    <EMIT <INSTRUCTION `MOVEM  .AC2 .IDX .DEST>>
+	    <EMIT <INSTRUCTION `HRLM 
+			       <ACSYM <DATTYP .VDAT>>
+			       <+ .IDX 1>
+			       .DEST>>
+	    <RET-TMP-AC <DATTYP .VDAT> .VDAT>)
+	   (ELSE
+	    <EMIT <INSTRUCTION `MOVEM  .AC2 <+ .IDX 1> .DEST>>
+	    <EMIT <INSTRUCTION `HRRM  <ACSYM <DATTYP .VDAT>> .IDX .DEST>>
+	    <RET-TMP-AC <DATTYP .VDAT> .VDAT>)>
+     <RET-TMP-AC <DATTYP .VDAT> .VDAT>)
+    (<==? .LENCOMB 36>
+     <EMIT <INSTRUCTION `MOVEM  .AC2 .IDX .DEST>>)
+    (<==? .LENCOMB 18>
+     <EMIT <INSTRUCTION <COND (<==? .PC 36>
+			       <COND (<==? .TYPER FLOAT> `HLLM ) (ELSE `HRLM )>)
+			      (ELSE
+			       <COND (<==? .TYPER FLOAT> `HLRM )
+				     (ELSE `HRRM )>)>
+			.AC2
+			.IDX
+			.DEST>>)
+    (<1? .LENCOMB>
+     <SET BITR <BITS 1 <- .PC 1>>>
+     <SET BITR
+	  <PUTBITS #WORD *000000000000* .BITR #WORD *777777777777*>>
+     <SET VDAT <GEN .VNOD DONT-CARE>>
+     <TOACV .RX>
+     <SET DEST (<ADDRSYM <DATVAL .RX>>)>
+     <COND (.CK
+	    <MUNG-AC <DATVAL .RX> .RX>
+	    <EMIT <INSTRUCTION `LDB  `O  [<FORM (74816) 1 .DEST>]>>
+	    <EMIT <INSTRUCTION `SUB  <ACSYM <DATVAL .RX>> `O >>)>
+     <COND (<NOT .XTP>
+	    <SET XDAT <DATUM FIX ANY-AC>>
+	    <PUT <DATVAL .RX> ,ACPROT T>
+	    <PUT .XDAT ,DATVAL <GETREG .XDAT>>
+	    <PUT <DATVAL .RX> ,ACPROT <>>
+	    <SET TT <ACSYM <DATVAL .XDAT>>>)
+	   (ELSE <RET-TMP-AC .VDAT> <SET TT 0>)>
+     <EMIT <INSTRUCTION `MOVE  .TT [.BITR]>>
+     <COND (.XTP
+	    <EMIT <INSTRUCTION <COND (<==? .XTP FALSE> `ANDCAM ) (ELSE `IORM )>
+			       .TT
+			       .IDX
+			       .DEST>>)
+	   (ELSE
+	    <D:B:TAG <SET BITR <MAKE:TAG>> .VDAT T <RESULT-TYPE .VNOD>>
+	    <RET-TMP-AC .XDAT>
+	    <EMIT <INSTRUCTION `ANDCAM  .TT .IDX .DEST>>
+	    <EMIT '<`SKIPA >>
+	    <LABEL:TAG .BITR>
+	    <RET-TMP-AC .VDAT>
+	    <EMIT <INSTRUCTION `IORM  .TT .IDX .DEST>>)>)
+    (ELSE
+     <EMIT <INSTRUCTION `DPB 
+			.AC2
+			<BYTE <- .PC .LENCOMB> .LENCOMB .IDX .DEST>>>)>
+   <COND (<NOT <1? .LENCOMB>> <RET-TMP-AC .VDAT>)>
+   <COND (<NOT <5 .TTYPE>> <MOVE:ARG .RX .WHERE>)
+	 (<N==? .WHERE FLUSHED>
+	  <RET-TMP-AC .RX>
+	  <MOVE:ARG .YDAT .WHERE>)
+	 (ELSE <MOVE:ARG .RX .WHERE>)>>
+
+"ROUTINE TO FIND THE LENGTH OF A TEMPLATE"
+
+<DEFINE GET:TEMPLATE:LENGTH (NM DAT NDAT "AUX" (TD <GET .NM TEMPLATE-DATA>)) 
+	#DECL ((NM) ATOM (TD) <OR FALSE <VECTOR [2 LIST] [5 ANY]>>
+	       (NDAT) <OR <DATUM ANY AC> AC>)
+	<COND (<NOT .TD>
+	       <MESSAGE INCONSISTENCY "TEMPLATE DATA NOT AVAIABLE">)>
+	<COND
+	 (<NOT <5 .TD>>
+	  <MESSAGE WARNING "ASKING LENGTH OF CONSTANT TEMPLATE">
+	  <EMIT <INSTRUCTION `MOVEI 
+			     <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
+					  (ELSE .NDAT)>>
+			     <LENGTH <1 .TD>>>>)
+	 (ELSE
+	  <EMIT <INSTRUCTION `MOVE 
+			     <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
+					  (ELSE .NDAT)>>
+			     !<ADDR:VALUE1
+			       <COND (<TYPE? .DAT DATUM> <DATVAL .DAT>)>>>>
+	  <EMIT <INSTRUCTION `HRRZ 
+			     <ACSYM <COND (<TYPE? .NDAT DATUM> <DATVAL .NDAT>)
+					  (ELSE .NDAT)>>
+			     (<ADDRSYM <COND (<TYPE? .NDAT DATUM>
+					      <DATVAL .NDAT>)
+					     (ELSE .NDAT)>>)
+			     <COND (<EMPTY? <2 .TD>> 0) (ELSE -1)>>>)>>
+
+<DEFINE BYTE (BOUND SIZE "TUPLE" LOC) 
+	[<FORM (<+ <* .BOUND 4096> <* .SIZE 64>>) !.LOC>]>
+
+<ENDPACKAGE>