--- /dev/null
+<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)>>
+
+\\f
+
+<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>
projects / pdp10-muddle.git / blobdiff