<mdl.comp>/lnqgen.mud.9

   1 <PACKAGE "LNQGEN">
   2
   3 <ENTRY LENGTH?-GEN>
   4
   5 <USE "CODGEN" "COMCOD" "CACS" "CHKDCL" "COMPDEC" "COMTEM">
   6
   7 <DEFINE LENGTH?-GEN (N W
   8                      "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
   9                      "AUX" QDAT (STR <1 <KIDS .N>>) (FLG <>) (NUM <2 <KIDS .N>>)
  10                            (TYP <RESULT-TYPE .STR>) (TPS <STRUCTYP .TYP>)
  11                            (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
  12                            (FLS <==? .W FLUSHED>) (SDIR .DIR) (B3 <MAKE:TAG>) NK
  13                            NN
  14                            (B2
  15                             <COND (<AND .FLS .BRANCH> .BRANCH)
  16                                   (ELSE <MAKE:TAG>)>) SAC NAC STRD NUMD TEM T1
  17                            (TEMP? <==? .TPS TEMPLATE>) (RW .W))
  18    #DECL ((N STR NUM) NODE (QDAT STRD NUMD) DATUM (SAC NAC) AC (NN) FIX
  19           (TPS TYP1 B2 B3) ATOM (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
  20    <SET W <GOODACS .N .W>>
  21    <COND (<==? <NODE-TYPE .NUM> ,QUOTE-CODE>
  22           <SET NK T>
  23           <COND (<OR <L? <SET NN <NODE-NAME .NUM>> 0> <G? .NN 262144>>
  24                  <MESSAGE ERROR " ARG OUT OF RANGE LENGTH? " .NN>)>)
  25          (ELSE <SET NK <>>)>
  26    <AND .NOTF <SET DIR <NOT .DIR>>>
  27    <COND
  28     (<==? .TPS LIST>
  29      <SET STRD <GEN .STR <DATUM .TYP1 ANY-AC>>>
  30      <COND
  31       (.NK
  32        <PUT <SET NUMD <REG? FIX .W>>
  33             ,DATVAL
  34             <SET NAC <GETREG .NUMD>>>
  35        <EMIT <INSTRUCTION `MOVSI  <ACSYM .NAC> <- -1 .NN>>>)
  36       (ELSE
  37        <SET NUMD <GEN .NUM DONT-CARE>>
  38        <COND (<TYPE? <DATVAL .NUMD> AC>
  39               <EMIT <INSTRUCTION `MOVNS  <ADDRSYM <SET NAC <DATVAL .NUMD>>>>>)
  40              (ELSE
  41               <EMIT <INSTRUCTION `MOVN
  42                                  <ACSYM <SET NAC <GETREG .NUMD>>>
  43                                  !<ADDR:VALUE .NUMD>>>
  44               <RET-TMP-AC <DATVAL .NUMD> .NUMD>
  45               <PUT .NUMD ,DATVAL .NAC>)>
  46        <RET-TMP-AC <DATTYP .NUMD> .NUMD>
  47        <PUT .NUMD ,DATTYP FIX>
  48        <EMIT <INSTRUCTION `MOVSI  <ACSYM .NAC> -1 (<ADDRSYM .NAC>)>>)>
  49      <VAR-STORE>
  50      <PUT .NAC ,ACPROT T>
  51      <TOACV .STRD>
  52      <PUT .NAC ,ACPROT <>>
  53      <SET SAC <DATVAL .STRD>>
  54      <MUNG-AC .SAC .STRD>
  55      <MUNG-AC .NAC .NUMD>
  56      <EMIT <INSTRUCTION `JUMPE
  57                         <ACSYM .SAC>
  58                         <COND (.DIR .B2) (ELSE .B3)>>>
  59      <EMIT <INSTRUCTION `HRRZ  <ACSYM .SAC> (<ADDRSYM .SAC>)>>
  60      <EMIT <INSTRUCTION `AOBJN  <ACSYM .NAC> '.HERE!-OP!-PACKAGE -2>>
  61      <RET-TMP-AC .STRD>
  62      <COND (<AND .BRANCH .FLS>
  63             <COND (<NOT .DIR> <BRANCH:TAG .B2> <LABEL:TAG .B3>)>
  64             <RET-TMP-AC .NUMD>)
  65            (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
  66             <RET-TMP-AC .NUMD>
  67             <COND (<AND .NOTF .DIR> <BRANCH:TAG .B3> <LABEL:TAG .B2>)>
  68             <MOVE:ARG <REFERENCE .SDIR> .W>
  69             <BRANCH:TAG .BRANCH>
  70             <LABEL:TAG .B3>)
  71            (ELSE
  72             <COND (.BRANCH
  73                    <BRANCH:TAG .B3>
  74                    <LABEL:TAG .B2>
  75                    <EMIT <INSTRUCTION `MOVEI  <ACSYM .NAC> (<ADDRSYM .NAC>)>>
  76                    <SET W <MOVE:ARG .NUMD .W>>
  77                    <BRANCH:TAG .BRANCH>
  78                    <LABEL:TAG .B3>)
  79                   (ELSE
  80                    <COND (<==? .NAC <DATVAL .W>> <RET-TMP-AC .NAC .NUMD>)>
  81                    <COND (<==? <DATTYP .NUMD> <DATTYP .W>>
  82                           <RET-TMP-AC <DATTYP .NUMD> .NUMD>)>
  83                    <RET-TMP-AC <MOVE:ARG <REFERENCE <>> .W>>
  84                    <BRANCH:TAG .B2>
  85                    <LABEL:TAG .B3>
  86                    <EMIT <INSTRUCTION `MOVEI  <ACSYM .NAC> (<ADDRSYM .NAC>)>>
  87                    <SET W <MOVE:ARG .NUMD .W>>
  88                    <LABEL:TAG .B2>)>)>)
  89     (ELSE
  90      <COND
  91       (<AND <N==? .TPS STRING> <N==? .TPS BYTES>
  92             .NK
  93             <OR .FLS .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>>
  94        <COND (.TEMP?
  95               <SET STRD <GEN .STR DONT-CARE>>
  96               <RET-TMP-AC <DATTYP .STRD> .STRD>)
  97              (<SET STRD <GEN .STR <DATUM .TYP1 ANY-AC>>>)>
  98        <VAR-STORE>
  99        <COND (.TEMP?
 100               <SET QDAT <DATUM FIX ANY-AC>>
 101               <COND (<TYPE? <DATVAL .STRD> AC>
 102                      <PUT .QDAT ,DATVAL <DATVAL .STRD>>)
 103                     (ELSE <PUT .QDAT ,DATVAL <GETREG .QDAT>>)>
 104               <GET:TEMPLATE:LENGTH <ISTYPE? .TYP> .STRD .QDAT>
 105               <EMIT <INSTRUCTION <COND (<COND (<AND .BRANCH .FLS> .DIR)
 106                                               (ELSE .DIR)>
 107                                         `CAIL )
 108                                        (ELSE `CAIG )>
 109                                  <ACSYM <DATVAL .QDAT>>
 110                                  .NN>>
 111               <RET-TMP-AC .QDAT>)
 112              (<EMIT <INSTRUCTION <COND (<COND (<AND .BRANCH .FLS> .DIR)
 113                                               (ELSE <NOT .DIR>)>
 114                                         `CAML )
 115                                        (ELSE `CAMG )>
 116                                  <ACSYM <SET SAC <DATVAL .STRD>>>
 117                                  [<FORM
 118                                    (<- <* .NN
 119                                           <COND (<OR <==? .TPS VECTOR>
 120                                                      <==? .TPS TUPLE>>
 121                                                  2)
 122                                                 (ELSE 1)>>>)>]>>)>
 123        <RET-TMP-AC .STRD>
 124        <SET FLG T>)
 125       (<OR <==? .TPS STRING> <==? .TPS BYTES>>
 126        <SET STRD <GEN .STR DONT-CARE>>
 127        <RET-TMP-AC <DATVAL .STRD> .STRD>
 128        <COND (<TYPE? <DATTYP .STRD> AC>
 129               <SET STRD <DATUM FIX <SET NAC <DATTYP <SET NUMD .STRD>>>>>
 130               <SET SAC
 131                    <COND (<AND <TYPE? .W DATUM> <TYPE? <DATVAL .W> AC>>
 132                           <SGETREG <DATVAL .W> .STRD>)
 133                          (<ACRESIDUE .NAC> <GETREG .STRD>)
 134                          (ELSE .NAC)>>
 135               <PUT .STRD ,DATVAL .SAC>
 136               <COND (<N==? .NAC .SAC>
 137                      <EMIT <INSTRUCTION `MOVEI  <ACSYM .SAC> (<ADDRSYM .NAC>)>>
 138                      <RET-TMP-AC .NAC .NUMD>)
 139                     (ELSE
 140                      <RET-TMP-AC .NUMD>
 141                      <SGETREG .SAC .STRD>
 142                      <MUNG-AC .SAC .STRD>
 143                      <EMIT <INSTRUCTION `MOVEI
 144                                         <ACSYM .SAC>
 145                                         (<ADDRSYM .NAC>)>>)>)
 146              (ELSE
 147               <SET SAC
 148                    <COND (<AND <TYPE? .W DATUM> <TYPE? <DATVAL .W> AC>>
 149                           <SGETREG <DATVAL .W> <>>)
 150                          (ELSE <GETREG <>>)>>
 151               <EMIT <INSTRUCTION `HRRZ  <ACSYM .SAC> !<ADDR:TYPE .STRD>>>
 152               <RET-TMP-AC <DATTYP .STRD> .STRD>
 153               <SET STRD <DATUM FIX .SAC>>
 154               <PUT .SAC ,ACLINK (.STRD !<ACLINK .SAC>)>)>)
 155       (ELSE
 156        <SET STRD <GEN .STR DONT-CARE>>
 157        <RET-TMP-AC <DATTYP .STRD> .STRD>
 158        <COND
 159         (<AND <TYPE? .W DATUM>
 160               <TYPE? <DATVAL .STRD> AC>
 161               <==? <DATVAL .W> <DATVAL .STRD>>>
 162          <COND (.TEMP?
 163                 <GET:TEMPLATE:LENGTH .STRD <SET SAC <DATVAL .STRD>>>)
 164                (ELSE
 165                 <EMIT <INSTRUCTION
 166                        `HLRES  <ADDRSYM <SET SAC <DATVAL .STRD>>>>>)>)
 167         (ELSE
 168          <SET SAC
 169               <COND (<AND <TYPE? .W DATUM> <TYPE? <DATVAL .W> AC>>
 170                      <SGETREG <DATVAL .W> .STRD>)
 171                     (ELSE <GETREG .STRD>)>>
 172          <RET-TMP-AC .STRD>
 173          <PUT .SAC ,ACPROT T>
 174          <COND (.TEMP? <GET:TEMPLATE:LENGTH <ISTYPE? .TYP> .STRD .SAC>)
 175                (<EMIT <INSTRUCTION `HLRE  <ACSYM .SAC> !<ADDR:VALUE .STRD>>>)>
 176          <PUT .SAC ,ACPROT <>>
 177          <PUT .STRD ,DATVAL .SAC>)>
 178        <PUT .STRD ,DATTYP FIX>
 179        <COND (<NOT .TEMP?>
 180               <EMIT <INSTRUCTION `MOVNS  <ADDRSYM .SAC>>>
 181               <COND (<OR <==? .TPS VECTOR> <==? .TPS TUPLE>>
 182                      <EMIT <INSTRUCTION `ASH  <ACSYM .SAC> -1>>)>)>)>
 183      <COND (<NOT .FLG>
 184             <MUNG-AC .SAC .STRD>
 185             <SET NUMD <GEN .NUM DONT-CARE>>
 186             <RET-TMP-AC <DATTYP .NUMD> .NUMD>
 187             <VAR-STORE>
 188             <PUT .NUMD ,DATTYP FIX>
 189             <COND (<N==? .SAC <DATVAL .STRD>>
 190                    <COND (<ACLINK .SAC> <TOACV .STRD> <SET SAC <DATVAL .STRD>>)
 191                          (ELSE
 192                           <MOVE:VALUE <DATVAL .STRD> .SAC>
 193                           <PUT .SAC ,ACLINK (.STRD !<ACLINK .SAC>)>
 194                           <PUT .STRD ,DATVAL .SAC>)>)>
 195             <IMCHK <COND (<COND (<AND .BRANCH .FLS> .DIR)
 196                                 (<OR .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>
 197                                  <NOT .DIR>)
 198                                 (ELSE <AND <SET FLG <=? .W .STRD>> .DIR>)>
 199                           '(`CAMG  `CAIG ))
 200                          (ELSE '(`CAMLE  `CAILE ))>
 201                    <ACSYM .SAC>
 202                    <DATVAL .NUMD>>
 203             <RET-TMP-AC .NUMD>)>
 204      <COND (<AND .BRANCH .FLS>
 205             <BRANCH:TAG .BRANCH>
 206             <OR .FLG <RET-TMP-AC .STRD>>)
 207            (<OR .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>
 208             <OR .FLG <RET-TMP-AC .STRD>>
 209             <BRANCH:TAG .B2>
 210             <COND (.BRANCH
 211                    <MOVE:ARG <REFERENCE .SDIR> .W>
 212                    <BRANCH:TAG .BRANCH>
 213                    <LABEL:TAG .B2>)>)
 214            (ELSE
 215             <COND (.BRANCH
 216                    <COND (<NOT .FLG> <BRANCH:TAG .B2>)>
 217                    <RET-TMP-AC <MOVE:ARG .STRD .W>>
 218                    <BRANCH:TAG .BRANCH>
 219                    <LABEL:TAG .B2>)
 220                   (ELSE
 221                    <BRANCH:TAG .B2>
 222                    <RET-TMP-AC <MOVE:ARG .STRD .W>>
 223                    <BRANCH:TAG .B3>
 224                    <LABEL:TAG .B2>
 225                    <MOVE:ARG <REFERENCE <>> .W>
 226                    <LABEL:TAG .B3>)>)>)>
 227    <MOVE:ARG .W .RW>>
 228
 229 <ENDPACKAGE>
 230 \f\ 3\ 3\ 3\ 3