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