<mdl.comp>/mmqgen.mud.27

   1 <PACKAGE "MMQGEN">
   2
   3 <ENTRY MEMQ-GEN>
   4
   5 <USE "CODGEN" "COMCOD" "CACS" "CHKDCL" "COMPDEC">
   6
   7
   8 <DEFINE MEMQ-GEN (N W
   9                   "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
  10                   "AUX" (STR <2 <KIDS .N>>) (THING <1 <KIDS .N>>)
  11                         (TYP <RESULT-TYPE .STR>) (TPS <STRUCTYP .TYP>)
  12                         (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
  13                         (FLS <==? .W FLUSHED>) (SDIR .DIR)
  14                         (TTYP <RESULT-TYPE .THING>) (TAC <>)
  15                         (ETY <GET-ELE-TYPE .TYP ALL>)
  16                         (TWIN <TYPESAME .ETY .TTYP>)
  17                         (B2
  18                          <COND (<AND .FLS .BRANCH> .BRANCH) (ELSE <MAKE:TAG>)>)
  19                         SAC NAC STRD NUMD DEAD (TWOW <>) TEM TY DAC DCOD
  20                         (B3 <MAKE:TAG>) (RW .W) (FC <0? <MINL .TYP>>)
  21                         (LP <MAKE:TAG>) B4 (DEADV <>))
  22    #DECL ((N STR THING) NODE (STRD NUMD) DATUM (DAC SAC NAC) AC (DCOD) FIX
  23           (TPS TYP1 B2 B3 B4) ATOM (DEAD) <PRIMTYPE LIST>
  24           (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
  25    <SET W <GOODACS .N .W>>
  26    <AND .NOTF <SET DIR <NOT .DIR>>>
  27    <COND (<OR <==? .TPS STRING> <==? .TPS BYTES>> <SET TWOW T>)>
  28    <SET TEM
  29         <COND (<TYPE? .W DATUM> <GOODACS .N .W>)
  30               (<AND .TWOW
  31                     <OR <AND <==? <NODE-TYPE .STR> ,LVAL-CODE>
  32                              <==? <LENGTH <SET DEAD <TYPE-INFO .STR>>> 2>
  33                              <NOT <2 .DEAD>>
  34                              <SET DEADV T>>
  35                         .FLS>>
  36                DONT-CARE)
  37               (.TWOW <DATUM ANY-AC ANY-AC>)
  38               (ELSE <DATUM .TYP1 ANY-AC>)>>
  39    <COND (<AND <NOT <SIDE-EFFECTS .N>>
  40                <NOT <MEMQ <NODE-TYPE .STR> ,SNODES>>
  41                <MEMQ <NODE-TYPE .THING> ,SNODES>>
  42           <SET STRD <GEN .STR .TEM>>
  43           <SET NUMD <GEN .THING DONT-CARE>>)
  44          (ELSE
  45           <SET NUMD
  46                <GEN .THING
  47                     <COND (<AND <NOT <==? <NODE-TYPE .STR> ,QUOTE-CODE>>
  48                                 <NOT .TWOW>
  49                                 <SIDE-EFFECTS .STR>>
  50                            <GOODACS .THING <DATUM ANY-AC ANY-AC>>)
  51                           (ELSE DONT-CARE)>>>
  52           <SET STRD <GEN .STR .TEM>>)>
  53    <VAR-STORE <>>
  54    <COND
  55     (<NOT .TWIN>
  56      <COND
  57       (<SET TY <ISTYPE? .ETY>>
  58        <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  !<ADDR:TYPE .NUMD>>>
  59        <EMIT <INSTRUCTION `CAIE  `O  <FORM TYPE-CODE!-OP!-PACKAGE .TY>>>
  60        <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>
  61        <SET TWIN T>)
  62       (<==? .TPS UVECTOR>
  63        <EMIT <INSTRUCTION `HLRE
  64                           <ACSYM <SET SAC <GETREG <>>>>
  65                           !<ADDR:VALUE .STRD>>>
  66        <PUT .SAC ,ACPROT T>
  67        <TOACV .STRD>
  68        <EMIT <INSTRUCTION `SUBM  <ACSYM <DATVAL .STRD>> <ADDRSYM .SAC>>>
  69        <PUT .SAC ,ACPROT <>>
  70        <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
  71                           <ACSYM .SAC>
  72                           (<ADDRSYM .SAC>)>>
  73        <COND (<SET TEM <ISTYPE? .TTYP>>
  74               <EMIT <INSTRUCTION `CAIE
  75                                  <ACSYM .SAC>
  76                                  <FORM TYPE-CODE!-OP!-PACKAGE .TEM>>>)
  77              (ELSE
  78               <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  !<ADDR:TYPE .NUMD>>>
  79               <EMIT <INSTRUCTION `CAIE  `O  (<ADDRSYM .SAC>)>>)>
  80        <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>
  81        <SET TWIN T>)>)>
  82    <COND (<NOT .TWOW>
  83           <TOACV .STRD>
  84           <COND (<ISTYPE-GOOD? .TPS>
  85                  <DATTYP-FLUSH .STRD>
  86                  <PUT .STRD ,DATTYP .TPS>)>)>
  87    <COND (<TYPE? <DATVAL .STRD> AC>
  88           <PUT <SET SAC <DATVAL .STRD>> ,ACPROT T>)>
  89    <COND (<NOT .TWOW>
  90           <TOACV .NUMD>
  91           <PUT <SET NAC <DATVAL .NUMD>> ,ACPROT T>)>
  92    <COND (<ASSIGNED? SAC> <MUNG-AC .SAC .STRD>)>
  93    <AND <TYPE? <DATTYP .STRD> AC>
  94         <MUNG-AC <DATTYP .STRD> .STRD>>
  95    <COND (<AND <NOT <ISTYPE? .TTYP>>
  96                <NOT .TY>
  97                <N==? .TPS UVECTOR>
  98                <NOT .TWOW>>
  99           <PUT <SET TAC <GETREG <>>> ,ACPROT T>
 100           <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
 101                              <ACSYM .TAC>
 102                              !<ADDR:TYPE .NUMD>>>)>
 103    <COND (<ASSIGNED? SAC> <PUT .SAC ,ACPROT <>>)>
 104    <COND (<NOT .TWOW> <PUT .NAC ,ACPROT <>>)>
 105    <COND (<AND .BRANCH <NOT .FLS> .DIR <NOT .NOTF> <=? .W .STRD>>
 106           <SET B2 .BRANCH>)>
 107    <COND
 108     (<==? .TPS LIST>
 109      <COND (<G=? <SET DCOD <MIN <DEFERN .ETY> <DEFERN .TTYP>>> 1>
 110             <SET DAC <GETREG <>>>)>
 111      <COND (.FC
 112             <EMIT <INSTRUCTION `JUMPE
 113                                <ACSYM .SAC>
 114                                <COND (.DIR .B3) (ELSE .B2)>>>)>
 115      <LABEL:TAG .LP>
 116      <COND (<0? .DCOD> <SET DAC .SAC>)
 117            (<1? .DCOD>
 118             <EMIT <INSTRUCTION `MOVE  <ACSYM .DAC> 1 (<ADDRSYM .SAC>)>>)
 119            (ELSE
 120             <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O  (<ADDRSYM .SAC>)>>
 121             <EMIT <INSTRUCTION `MOVE  <ACSYM .DAC> <ADDRSYM .SAC>>>
 122             <EMIT '<`CAIN  `O  TDEFER!-OP!-PACKAGE>>
 123             <EMIT <INSTRUCTION `MOVE  <ACSYM .DAC> 1 (<ADDRSYM .DAC>)>>)>
 124      <CHECK-VAL 1
 125                 .NAC
 126                 .DAC
 127                 .TAC
 128                 .TTYP
 129                 <COND (.DIR .B2) (ELSE .B3)>
 130                 .TWIN>
 131      <EMIT <INSTRUCTION `HRRZ  <ACSYM .SAC> (<ADDRSYM .SAC>)>>
 132      <EMIT <INSTRUCTION `JUMPN  <ACSYM .SAC> .LP>>)
 133     (<==? .TPS UVECTOR>
 134      <COND (.FC
 135             <EMIT <INSTRUCTION `JUMPGE
 136                                <ACSYM .SAC>
 137                                <COND (.DIR .B3) (ELSE .B2)>>>)>
 138      <LABEL:TAG .LP>
 139      <CHECK-VAL 0
 140                 .NAC
 141                 .SAC
 142                 .TAC
 143                 .TTYP
 144                 <COND (.DIR .B2) (ELSE .B3)>
 145                 .TWIN>
 146      <EMIT <INSTRUCTION `AOBJN  <ACSYM .SAC> .LP>>)
 147     (<NOT .TWOW>
 148      <COND (.FC
 149             <EMIT <INSTRUCTION `JUMPGE
 150                                <ACSYM .SAC>
 151                                <COND (.DIR .B3) (ELSE .B2)>>>)>
 152      <LABEL:TAG .LP>
 153      <CHECK-VAL 1
 154                 .NAC
 155                 .SAC
 156                 .TAC
 157                 .TTYP
 158                 <COND (.DIR .B2) (ELSE .B3)>
 159                 .TWIN>
 160      <EMIT <INSTRUCTION `ADD  <ACSYM .SAC> '[<2 (2)>]>>
 161      <EMIT <INSTRUCTION `JUMPL  <ACSYM .SAC> .LP>>)
 162     (.FLS
 163      <COND (<TYPE? <DATTYP .STRD> AC>
 164             <COND (<AND <ACRESIDUE <SET SAC <DATTYP .STRD>>>
 165                         <G? <FREE-ACS T> 0>>
 166                    <EMIT <INSTRUCTION `MOVEI
 167                                       <SET SAC <GETREG <>>>
 168                                       (<ADDRSYM <DATTYP .STRD>>)>>)
 169                   (ELSE
 170                    <MUNG-AC .SAC .STRD>
 171                    <EMIT <INSTRUCTION `MOVEI  <ACSYM .SAC> (<ADDRSYM .SAC>)>>)>)
 172            (ELSE
 173             <SET SAC <GETREG <>>>
 174             <EMIT <INSTRUCTION `HRRZ  <ACSYM .SAC> !<ADDR:TYPE .STRD>>>)>
 175      <PUT .SAC ,ACPROT T>
 176      <OR .DEADV
 177          <TYPE? <DATVAL .STRD> TEMP>
 178          <SET STRD <TOACV .STRD>>>
 179      <PUT .SAC ,ACPROT <>>
 180      <COND (.FC
 181             <EMIT <INSTRUCTION `JUMPE
 182                                <ACSYM .SAC>
 183                                <COND (.DIR .B3) (ELSE .B2)>>>)>
 184      <LABEL:TAG .LP>
 185      <EMIT <INSTRUCTION `ILDB  `O  !<ADDR:VALUE .STRD>>>
 186      <IMCHK (`CAMN  `CAIN ) `O  <DATVAL .NUMD>>
 187      <BRANCH:TAG <COND (.DIR .B2) (ELSE .B3)>>
 188      <EMIT <INSTRUCTION `SOJG  <ACSYM .SAC> .LP>>)
 189     (ELSE
 190      <LABEL:TAG .LP>
 191      <COND (<TYPE? <DATTYP .STRD> AC>
 192             <EMIT <INSTRUCTION `TRNN  <ACSYM <SET SAC <DATTYP .STRD>>> -1>>
 193             <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>)
 194            (ELSE
 195             <EMIT <INSTRUCTION `HRRZ  `O  !<ADDR:TYPE .STRD>>>
 196             <EMIT <INSTRUCTION `JUMPE  `O  <COND (.DIR .B3) (ELSE .B2)>>>)>
 197      <EMIT <INSTRUCTION `MOVE  `O  !<ADDR:VALUE .STRD>>>
 198      <EMIT '<`ILDB  `O  `O >>
 199      <IMCHK '(`CAMN  `CAIN ) `O  <DATVAL .NUMD>>
 200      <BRANCH:TAG <COND (.DIR .B2) (ELSE .B3)>>
 201      <EMIT <INSTRUCTION `IBP  !<ADDR:VALUE .STRD>>>
 202      <COND (<TYPE? <DATTYP .STRD> AC>
 203             <EMIT <INSTRUCTION `SOJA  <ACSYM .SAC> .LP>>)
 204            (ELSE
 205             <EMIT <INSTRUCTION `SOS  !<ADDR:TYPE .STRD>>>
 206             <BRANCH:TAG .LP>)>)>
 207    <AND .TAC <PUT .TAC ,ACPROT <>>>
 208    <RET-TMP-AC .TAC>
 209    <RET-TMP-AC .NUMD>
 210    <COND (<AND .BRANCH .FLS>
 211           <COND (<NOT .DIR> <BRANCH:TAG .B2> <LABEL:TAG .B3>)
 212                 (ELSE <LABEL:TAG .B3>)>
 213           <RET-TMP-AC .STRD>)
 214          (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
 215           <RET-TMP-AC .STRD>
 216           <COND (<AND .NOTF .DIR> <BRANCH:TAG .B3>)>
 217           <LABEL:TAG .B2>
 218           <MOVE:ARG <REFERENCE .SDIR> .W>
 219           <BRANCH:TAG .BRANCH>
 220           <LABEL:TAG .B3>)
 221          (ELSE
 222           <COND (.BRANCH
 223                  <COND (<==? .B2 .BRANCH>
 224                         <LABEL:TAG .B3>
 225                         <SET W <MOVE:ARG .STRD .W>>)
 226                        (ELSE
 227                         <BRANCH:TAG .B3>
 228                         <LABEL:TAG .B2>
 229                         <SET W <MOVE:ARG .STRD .W>>
 230                         <BRANCH:TAG .BRANCH>
 231                         <LABEL:TAG .B3>)>)
 232                 (ELSE
 233                  <RET-TMP-AC .STRD>
 234                  <LABEL:TAG .B2>
 235                  <RET-TMP-AC <SET W <MOVE:ARG <REFERENCE <>> .W>>>
 236                  <COND (<TYPE? <DATTYP .STRD> AC>
 237                         <PUT <DATTYP .STRD> ,ACLINK (.STRD)>)>
 238                  <COND (<TYPE? <DATVAL .STRD> AC>
 239                         <PUT <DATVAL .STRD> ,ACLINK (.STRD)>)>
 240                  <COND (<=? .W .STRD>
 241                         <LABEL:TAG .B3>
 242                         <SET W <MOVE:ARG .STRD .W>>)
 243                        (ELSE
 244                         <BRANCH:TAG <SET B4 <MAKE:TAG>>>
 245                         <LABEL:TAG .B3>
 246                         <SET W <MOVE:ARG .STRD .W>>
 247                         <LABEL:TAG .B4>)>)>)>
 248    <MOVE:ARG .W .RW>>
 249
 250 <DEFINE CHECK-VAL (OFFS VAC SAC TAC TTYP BR TWIN)
 251    #DECL ((OFFS) FIX (SAC VAC) AC (TAC) <OR AC FALSE>)
 252    <COND (.TWIN
 253           <EMIT <INSTRUCTION `CAMN  <ACSYM .VAC> .OFFS (<ADDRSYM .SAC>)>>
 254           <BRANCH:TAG .BR>)
 255          (ELSE
 256           <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
 257                              `O*
 258                              <- .OFFS 1>
 259                              (<ADDRSYM .SAC>)>>
 260           <EMIT <INSTRUCTION
 261                  `CAIN
 262                  `O*
 263                  <COND (<SET TTYP <ISTYPE? .TTYP>>
 264                         <FORM TYPE-CODE!-OP!-PACKAGE .TTYP>)
 265                        (ELSE (<ADDRSYM .TAC>))>>>
 266           <EMIT <INSTRUCTION `CAME  <ACSYM .VAC> .OFFS (<ADDRSYM .SAC>)>>
 267           <EMIT '<`SKIPA >>
 268           <BRANCH:TAG .BR>)>>
 269
 270 <ENDPACKAGE>
 271 \f\ 3\ 3