<mdl.comp>/infcmp.mud.21

   1 <PACKAGE "INFCMP">
   2
   3 <ENTRY ALLTYPES-ANA ROOT-ANA ERRORS-ANA INTERRUPTS-ANA INFO-GEN OBLIST?-ANA OBLIST?-GEN
   4        ASSOCIATIONS-ANA NEXT-ANA ASSOC-HACK ASSOC-FIELD-GET AS-NXT-GEN>
   5
   6 <USE "SYMANA" "CHKDCL" "CODGEN" "CACS" "COMCOD" "COMPDEC">
   7
   8 <DEFINE ALLTYPES-ANA (N R)
   9         <INFO-GET .N .R |TYPVEC '<VECTOR [REST ATOM]>>>
  10
  11 <DEFINE ROOT-ANA (N R) <INFO-GET .N .R |ROOT OBLIST>>
  12
  13 <DEFINE ERRORS-ANA (N R) <INFO-GET .N .R |ERROBL OBLISTT>>
  14
  15 <DEFINE INTERRUPTS-ANA (N R) <INFO-GET .N .R |INTOBL OBLIST>>
  16
  17 <DEFINE INFO-GET (N R SYM TYP)
  18         #DECL ((N) NODE)
  19         <ARGCHK <LENGTH <KIDS .N>> 0 <NODE-NAME .N>>
  20         <PUT .N ,NODE-TYPE ,INFO-CODE>
  21         <PUT .N ,NODE-NAME .SYM>
  22         <TYPE-OK? .R .TYP>>
  23
  24 <DEFINE INFO-GEN (N W
  25                   "AUX" (ADR <ADDRESS:C <NODE-NAME .N>>))
  26         #DECL ((N) NODE (VALUE) DATUM)
  27         <MOVE:ARG <DATUM <ISTYPE? <RESULT-TYPE .N>> .ADR> .W>>
  28
  29 <PUT ,ALLTYPES ANALYSIS ,ALLTYPES-ANA>
  30
  31 <PUT ,ROOT ANALYSIS ,ROOT-ANA>
  32
  33 <PUT ,ERRORS ANALYSIS ,ERRORS-ANA>
  34
  35 <PUT ,INTERRUPTS ANALYSIS ,INTERRUPTS-ANA>
  36
  37 <DEFINE OBLIST?-ANA (N R "AUX" (K <KIDS .N>))
  38         #DECL ((N) NODE (K) <LIST [REST NODE]>)
  39         <COND (<SEGFLUSH .N .R>)
  40               (ELSE
  41                <ARGCHK <LENGTH .K> 1 OBLIST?>
  42                <EANA <1 .K> ATOM OBLIST?>
  43                <PUT .N ,NODE-TYPE ,OBLIST?-CODE>)>
  44         <TYPE-OK? '<OR FALSE OBLIST> .R>>
  45
  46 <PUT ,OBLIST? ANALYSIS ,OBLIST?-ANA>
  47
  48 <DEFINE OBLIST?-GEN (N W
  49                      "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
  50                      "AUX" (FLS <==? .W FLUSHED>) (SDIR .DIR)
  51                            (B2
  52                             <COND (<AND .FLS .BRANCH> .BRANCH)
  53                                   (ELSE <MAKE:TAG>)>) (B3 <MAKE:TAG>) (RW .W)
  54                            ATO B4 VAC W2)
  55    #DECL ((N) NODE (ATO) DATUM (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
  56    <SET W <GOODACS .N .W>>
  57    <AND .NOTF <SET DIR <NOT .DIR>>>
  58    <SET ATO <GEN <1 <KIDS .N>> <DATUM ATOM ANY-AC>>>
  59    <VAR-STORE <>>
  60    <COND
  61     (<AND .BRANCH .FLS>
  62      <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
  63             <EMIT <INSTRUCTION <COND (.DIR `SKIPE ) (ELSE `SKIPN )>
  64                                2
  65                                (<ADDRSYM <DATVAL .ATO>>)>>
  66             <BRANCH:TAG .BRANCH>
  67             <RET-TMP-AC .ATO>)
  68            (ELSE
  69             <EMIT <INSTRUCTION `HRRZ 2 (<ADDRSYM <DATVAL .ATO>>)>>
  70             <EMIT <INSTRUCTION <COND (.DIR `JUMPN) (ELSE `JUMPE)> .BRANCH>>
  71             <RET-TMP-AC .ATO>)>)
  72     (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
  73      <RET-TMP-AC .ATO>
  74      <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
  75             <EMIT <INSTRUCTION <COND (.DIR `SKIPE ) (ELSE `SKIPN )>
  76                                2
  77                                (<ADDRSYM <DATVAL .ATO>>)>>
  78             <BRANCH:TAG .B3>)
  79            (ELSE
  80             <EMIT <INSTRUCTION `HRRZ 2 (<ADDRSYM <DATVAL .ATO>>)>>
  81             <EMIT <INSTRUCTION <COND (.DIR `JUMPN) (ELSE `JUMPE)> .B3>>)>
  82      <MOVE:ARG <REFERENCE .SDIR> .W>
  83      <BRANCH:TAG .BRANCH>
  84      <LABEL:TAG .B3>)
  85     (ELSE
  86      <SET W2 <DATUM OBLIST <DATVAL .W>>>
  87      <COND (<TYPE? <DATVAL .W2> AC>
  88             <SGETREG <SET VAC <DATVAL .W2>> .W2>)
  89            (ELSE <PUT .W2 ,DATVAL <SET VAC <GETREG .W2>>>)>
  90      <RET-TMP-AC .ATO>
  91      <COND (.BRANCH
  92             <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
  93                    <EMIT <INSTRUCTION `SKIPN <ACSYM .VAC> 2
  94                                       (<ADDRSYM <DATVAL .ATO>>)>>)
  95                   (ELSE
  96                    <EMIT <INSTRUCTION `HRRZ <ACSYM .VAC> 2
  97                                       (<ADDRSYM <DATVAL .ATO>>)>>)>
  98             <COND (<==? .BRANCH .B2>
  99                    <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
 100                           <BRANCH:TAG .BRANCH>)
 101                          (ELSE
 102                           <EMIT <INSTRUCTION `JUMPE <ACSYM .VAC> .BRANCH>>)>
 103                    <GEN-OBL .VAC .W .W2>)
 104                   (ELSE
 105                    <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
 106                           <BRANCH:TAG .B3>)
 107                          (ELSE
 108                           <EMIT <INSTRUCTION `JUMPE <ACSYM .VAC> .B3>>)>
 109                    <GEN-OBL .VAC .W .W2>
 110                    <BRANCH:TAG .BRANCH>
 111                    <LABEL:TAG .B3>)>)
 112            (ELSE
 113             <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
 114                    <EMIT <INSTRUCTION `SKIPN <ACSYM .VAC> 2
 115                                       (<ADDRSYM <DATVAL .ATO>>)>>
 116                    <BRANCH:TAG .B2>)
 117                   (ELSE
 118                    <EMIT <INSTRUCTION `HRRZ <ACSYM .VAC> 2
 119                                       (<ADDRSYM <DATVAL .ATO>>)>>
 120                    <EMIT <INSTRUCTION `JUMPE <ACSYM .VAC> .B2>>)>
 121             <GEN-OBL .VAC .W .W2>
 122             <RET-TMP-AC .W>
 123             <BRANCH:TAG .B3>
 124             <LABEL:TAG .B2>
 125             <MOVE:ARG <REFERENCE <>> .W>
 126             <LABEL:TAG .B3>)>)>
 127    <MOVE:ARG .W .RW>>
 128
 129 <DEFINE GEN-OBL (AC W1 W2 "AUX" (B <MAKE:TAG>))
 130         #DECL ((AC) AC (W1 W2) DATUM)
 131         <COND (<OR <==? ,MUDDLE 105> <==? ,MUDDLE 55>>
 132                <EMIT <INSTRUCTION `JUMPL  <ACSYM .AC> .B>>
 133                <EMIT <INSTRUCTION `MOVE  <ACSYM .AC> (<ADDRSYM .AC>)>>
 134                <LABEL:TAG .B>)
 135               (ELSE
 136                <EMIT <INSTRUCTION `CAMGE  <ACSYM .AC> |VECBOT>>
 137                <EMIT <INSTRUCTION `MOVE  <ACSYM .AC> (<ADDRSYM .AC>)>>
 138                <EMIT <INSTRUCTION `HRLI <ACSYM .AC> -1>>)>
 139         <MOVE:ARG .W2 .W1>>
 140
 141 <DEFINE ASSOCIATIONS-ANA (N R) <AS-NXT .N .R <>>>
 142
 143 <DEFINE NEXT-ANA (N R) <AS-NXT .N .R T>>
 144
 145 <DEFINE AS-NXT (N R ARG)
 146         <COND (<SEGFLUSH .N .R>)
 147               (ELSE
 148                <COND (.ARG
 149                       <ARGCHK <LENGTH <KIDS .N>> 1 NEXT>
 150                       <EANA <1 <KIDS .N>> ASOC NEXT>)
 151                      (ELSE <ARGCHK <LENGTH <KIDS .N>> 0 ASSOCIATIONS>)>
 152                <PUT .N ,NODE-TYPE ,AS-NXT-CODE>)>
 153         <TYPE-OK? .R '<OR ASOC FALSE>>>
 154
 155 <DEFINE ASSOC-HACK (N R)
 156         <COND (<SEGFLUSH .N .R>)
 157               (ELSE
 158                <ARGCHK <LENGTH <KIDS .N>> 1 <NODE-NAME .N>>
 159                <EANA <1 <KIDS .N>> ASOC <NODE-NAME .N>>
 160                <PUT .N ,NODE-TYPE ,AS-IT-IND-VAL-CODE>)>
 161         <TYPE-OK? .R ANY>>
 162
 163 <PUT ,ASSOCIATIONS ANALYSIS ,ASSOCIATIONS-ANA>
 164
 165 <PUT ,NEXT ANALYSIS ,NEXT-ANA>
 166
 167 <PUT ,ITEM ANALYSIS ,ASSOC-HACK>
 168
 169 <PUT ,INDICATOR ANALYSIS ,ASSOC-HACK>
 170
 171 <PUT ,AVALUE ANALYSIS ,ASSOC-HACK>
 172
 173 <DEFINE ASSOC-FIELD-GET (N W "AUX" (NN <1 <KIDS .N>>) DAT OFF)
 174         #DECL ((N NN) NODE (OFF) FIX)
 175         <SET OFF
 176              <COND (<==? <NODE-SUBR .N> ,ITEM> 0)
 177                    (<==? <NODE-SUBR .N> ,AVALUE> 2)
 178                    (ELSE 4)>>
 179         <SET DAT <GEN .NN <DATUM ASOC ANY-AC>>>
 180         <SET DAT <OFFPTR .OFF .DAT ASOC>>
 181         <MOVE:ARG <DATUM .DAT .DAT> .W>>
 182
 183 <DEFINE AS-NXT-GEN (N W
 184                     "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
 185                     "AUX" (FLS <==? .W FLUSHED>) (SDIR .DIR)
 186                           (B2
 187                            <COND (<AND .FLS .BRANCH> .BRANCH)
 188                                  (ELSE <MAKE:TAG>)>) (B3 <MAKE:TAG>) (RW .W) ATO
 189                           B4 VAC W2)
 190    #DECL ((N) NODE (ATO) DATUM (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
 191    <SET W <GOODACS .N .W>>
 192    <AND .NOTF <SET DIR <NOT .DIR>>>
 193    <SET ATO
 194         <COND (<==? <NODE-NAME .N> NEXT>
 195                <GEN <1 <KIDS .N>> <DATUM ASOC ANY-AC>>)
 196               (ELSE
 197                <SET ATO <DATUM ASOC ANY-AC>>
 198                <PUT .ATO ,DATVAL <GETREG .ATO>>
 199                <EMIT <INSTRUCTION `MOVE
 200                                   <ACSYM <DATVAL .ATO>>
 201                                   |NODES
 202                                   1>>
 203                .ATO)>>
 204    <VAR-STORE <>>
 205    <COND
 206     (<AND .BRANCH .FLS>
 207      <EMIT <INSTRUCTION `HRRZ  `O*  6 (<ADDRSYM <DATVAL .ATO>>)>>
 208      <EMIT <INSTRUCTION <COND (.DIR `JUMPN ) (ELSE `JUMPE )>
 209                         `O*
 210                         .BRANCH>>
 211      <RET-TMP-AC .ATO>)
 212     (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
 213      <RET-TMP-AC .ATO>
 214      <EMIT <INSTRUCTION `HRRZ  `O*  6 (<ADDRSYM <DATVAL .ATO>>)>>
 215      <EMIT <INSTRUCTION <COND (.DIR `JUMPN ) (ELSE `JUMPE )> `O*  .B3>>
 216      <MOVE:ARG <REFERENCE .SDIR> .W>
 217      <BRANCH:TAG .BRANCH>
 218      <LABEL:TAG .B3>)
 219     (ELSE
 220      <SET W2 <DATUM ASOC <DATVAL .W>>>
 221      <COND (<TYPE? <DATVAL .W2> AC>
 222             <SGETREG <SET VAC <DATVAL .W2>> .W2>)
 223            (ELSE <PUT .W2 ,DATVAL <SET VAC <GETREG .W2>>>)>
 224      <RET-TMP-AC .ATO>
 225      <COND (.BRANCH
 226             <COND (<==? .BRANCH .B2>
 227                    <EMIT <INSTRUCTION `HRRZ
 228                                       <ACSYM .VAC>
 229                                       6
 230                                       (<ADDRSYM <DATVAL .ATO>>)>>
 231                    <EMIT <INSTRUCTION `JUMPE  <ACSYM .VAC> .BRANCH>>
 232                    <MOVE:ARG .W2 .W>)
 233                   (ELSE
 234                    <EMIT <INSTRUCTION `HRRZ
 235                                       <ACSYM .VAC>
 236                                       6
 237                                       (<ADDRSYM <DATVAL .ATO>>)>>
 238                    <EMIT <INSTRUCTION `JUMPE  <ACSYM .VAC> .B3>>
 239                    <MOVE:ARG .W2 .W>
 240                    <BRANCH:TAG .BRANCH>
 241                    <LABEL:TAG .B3>)>)
 242            (ELSE
 243             <EMIT <INSTRUCTION `HRRZ
 244                                <ACSYM .VAC>
 245                                6
 246                                (<ADDRSYM <DATVAL .ATO>>)>>
 247             <EMIT <INSTRUCTION `JUMPE  <ACSYM .VAC> .B2>>
 248             <MOVE:ARG .W2 .W>
 249             <RET-TMP-AC .W>
 250             <BRANCH:TAG .B3>
 251             <LABEL:TAG .B2>
 252             <MOVE:ARG <REFERENCE <>> .W>
 253             <LABEL:TAG .B3>)>)>
 254    <MOVE:ARG .W .RW>>
 255
 256 <ENDPACKAGE>
 257 \f