mim/development/mim/mimc/lnqgen.mud

   1
   2 <PACKAGE "LNQGEN">
   3
   4 <ENTRY LENGTH?-GEN>
   5
   6 <USE "COMPDEC" "CODGEN" "CHKDCL" "ADVMESS" "STRGEN" "MIMGEN">
   7
   8 <DEFINE LENGTH?-GEN (N W
   9                      "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>) (SETF <>)
  10                      "AUX" QDAT (STR <1 <KIDS .N>>) (FLG <>)
  11                            (NUM <2 <KIDS .N>>) (TYP <RESULT-TYPE .STR>)
  12                            (TPS <STRUCTYP .TYP>)
  13                            (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
  14                            (FLS <==? .W FLUSHED>) (SDIR .DIR) (B3 <MAKE-TAG>)
  15                            NK NN ANUM LP
  16                            (B2
  17                             <COND (<AND .FLS .BRANCH> .BRANCH)
  18                                   (ELSE <MAKE-TAG>)>) STRD NUMD TEM T1 (RW .W)
  19                            LP1)
  20    #DECL ((N STR NUM) NODE (NN) FIX (TPS TYP1 B2 B3) ATOM
  21           (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
  22    <COND (<==? <NODE-TYPE .NUM> ,QUOTE-CODE>
  23           <SET NK T>
  24           <COND (<OR <L? <SET NN <NODE-NAME .NUM>> 0> <G? .NN 262144>>
  25                  <COMPILE-ERROR "Argument out of range to LENGTH? " .NN .N>)>)
  26          (ELSE <SET NK <>>)>
  27    <COND (.NOTF <SET DIR <NOT .DIR>>)>
  28    <COND (.SETF
  29           <DEALLOCATE-TEMP <MOVE-ARG <REFERENCE <NOT .SDIR>> .W>>)>
  30    <COND (<==? .TPS LIST>
  31           <SET STRD <GEN .STR DONT-CARE>>
  32           <COND (<OR <NOT <TYPE? .STRD TEMP>> <G? <TEMP-REFS .STRD> 1>>
  33                  <SET STRD <MOVE-ARG .STRD <GEN-TEMP <>>>>)>
  34           <SET NUMD <GEN .NUM DONT-CARE>>
  35           <COND (<OR <NOT <TYPE? .NUMD TEMP>> <G? <TEMP-REFS .NUMD> 1>>
  36                  <SET NUMD <MOVE-ARG .NUMD <GEN-TEMP <>>>>)>
  37           <COND (<OR .NOTF
  38                      <NOT <==? <NOT .BRANCH> <NOT .DIR>>>
  39                      <AND .BRANCH .FLS>>
  40                  <IEMIT `LOOP
  41                         (<TEMP-NAME .STRD> VALUE)
  42                         (<TEMP-NAME .NUMD> VALUE)>)
  43                 (ELSE
  44                  <SET-TEMP <SET ANUM
  45                                 <COND (<AND <TYPE? .W TEMP>
  46                                             <0? <TEMP-REFS .W>>>
  47                                        <USE-TEMP .W>
  48                                        .W)
  49                                       (ELSE <SET W <GEN-TEMP>>)>>
  50                            0
  51                            '(`TYPE FIX)>
  52                  <IEMIT `LOOP
  53                         (<TEMP-NAME .STRD> VALUE)
  54                         (<TEMP-NAME .NUMD> VALUE)
  55                         (<TEMP-NAME .ANUM> VALUE)>)>
  56           <LABEL-TAG <SET LP <MAKE-TAG>>>
  57           <EMPTY-CHECK LIST .STRD LIST T <COND (.DIR .B2) (ELSE .B3)>>
  58           <IEMIT `SUB .NUMD 1 = .NUMD '(`TYPE FIX)>
  59           <COND (<ASSIGNED? ANUM> <IEMIT `ADD .ANUM 1 = .ANUM '(`TYPE FIX)>)>
  60           <IEMIT `LESS? .NUMD 0 + <SET LP1 <MAKE-TAG>>>
  61           <REST-DO LIST .STRD .STRD 1>
  62           <BRANCH-TAG .LP>
  63           <LABEL-TAG .LP1>
  64           <FREE-TEMP .STRD>
  65           <FREE-TEMP .NUMD>
  66           <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
  67           <COND (<AND .BRANCH .FLS>
  68                  <COND (<NOT .DIR> <BRANCH-TAG .B2> <LABEL-TAG .B3>)>)
  69                 (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
  70                  <COND (<AND .NOTF .DIR> <BRANCH-TAG .B3> <LABEL-TAG .B2>)>
  71                  <MOVE-ARG <REFERENCE .SDIR> .W>
  72                  <BRANCH-TAG .BRANCH>
  73                  <LABEL-TAG .B3>)
  74                 (ELSE
  75                  <COND (.BRANCH
  76                         <BRANCH-TAG .B3>
  77                         <LABEL-TAG .B2>
  78                         <SET W <MOVE-ARG .ANUM .W>>
  79                         <BRANCH-TAG .BRANCH>
  80                         <LABEL-TAG .B3>)
  81                        (ELSE
  82                         <RET-TMP-AC <MOVE-ARG <REFERENCE <>> .W>>
  83                         <BRANCH-TAG .B2>
  84                         <LABEL-TAG .B3>
  85                         <SET W <MOVE-ARG .ANUM .W>>
  86                         <LABEL-TAG .B2>)>)>)
  87          (ELSE
  88           <FREE-TEMP <SET STRD <GEN .STR DONT-CARE>> <>>
  89           <SET ANUM <GEN-TEMP>>
  90           <COND (<OR <==? .TPS VECTOR> <==? .TPS TUPLE>>
  91                  <LENGTH-VECTOR .STRD .ANUM>)
  92                 (<==? .TPS LIST> <LENGTH-LIST .STRD .ANUM>)
  93                 (<==? .TPS UVECTOR> <LENGTH-UVECTOR .STRD .ANUM>)
  94                 (<==? .TPS STRING> <LENGTH-STRING .STRD .ANUM>)
  95                 (ELSE <LENGTH-RECORD .STRD .ANUM <RECTYPE? .TYP>>)>
  96           <COND (.NK
  97                  <IEMIT `GRTR?
  98                         .ANUM
  99                         .NN
 100                         <COND (<OR .FLS <NOT .BRANCH>>
 101                                <COND (.DIR -) (ELSE +)>)
 102                               (ELSE <COND (.DIR +) (ELSE -)>)>
 103                         .B2>)
 104                 (ELSE
 105                  <SET NUMD <GEN .NUM DONT-CARE>>
 106                  <IEMIT `GRTR? .ANUM .NUMD <COND (.DIR -) (ELSE +)> .B2>
 107                  <FREE-TEMP .NUMD>)>
 108           <COND (<==? .W DONT-CARE> <SET W <GEN-TEMP <>>>)>
 109           <COND (<AND .BRANCH .FLS> <FREE-TEMP .ANUM>)
 110                 (<OR .NOTF <N==? <NOT .BRANCH> <NOT .DIR>>>
 111                  <FREE-TEMP .ANUM>
 112                  <COND (.BRANCH
 113                         <MOVE-ARG <REFERENCE .SDIR> .W>
 114                         <BRANCH-TAG .BRANCH>
 115                         <LABEL-TAG .B2>)>)
 116                 (ELSE
 117                  <COND (.BRANCH
 118                         <MOVE-ARG .ANUM .W>
 119                         <BRANCH-TAG .BRANCH>
 120                         <LABEL-TAG .B2>)
 121                        (ELSE
 122                         <MOVE-ARG .ANUM .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 <ENDPACKAGE>