--- /dev/null
+<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>
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff