mim/development/mim/20c/file-index.mud

   1
   2 <PACKAGE "FILE-INDEX">
   3
   4 <ENTRY BUILD-INDEX SKIP-MIMA>
   5
   6 <SETG BUFLENGTH 1024>
   7
   8 <SETG BUFFER <ISTRING ,BUFLENGTH>>
   9
  10 <SETG MAGIC-CHAR <ASCII 26>                                       ;"Control Z">
  11
  12 <SETG LAST-CHAR1 !\0>
  13
  14 <SETG LAST-CHAR2 !\]>
  15
  16 <SETG LAST-CHAR3 !\>>
  17
  18 <SETG WORD-STRING "#WORD "                  ;"Comes before hash codes">
  19
  20 <SETG MAGIC-STRING "<SETG "                 ;"Comes before MSUBRs and IMSUBRs">
  21
  22 <SETG MAGIC-LENGTH <LENGTH ,MAGIC-STRING>>
  23
  24 <SETG MAGIC-MAX <- ,BUFLENGTH ,MAGIC-LENGTH>>
  25
  26 <SETG MAGIC-STRING2 "<END "                           ;"Comes at end of MIMAs">
  27
  28 <SETG MAGIC-LENGTH2 <LENGTH ,MAGIC-STRING2>>
  29
  30 <SETG MAGIC-MAX2 <- ,BUFLENGTH ,MAGIC-LENGTH2>>
  31
  32 <SETG IN-ATOM 0>
  33
  34 <SETG NEED-MINUS 1>
  35
  36 <SETG QUOTE-NEXT 2>
  37
  38 <SETG NON-ATOM 3>
  39
  40 <SETG M$$R-EXCL 8>
  41
  42 <SETG M$$R-BACKS 15>
  43
  44 <SETG M$$R-ALPHA 16>
  45
  46 <SETG M$$R-E 17>
  47
  48 <SETG M$$R-DIGIT 19>
  49
  50 <SETG M$$R-PLUS 20>
  51
  52 <SETG M$$R-STAR 21>
  53
  54 <MANIFEST IN-ATOM
  55           NEED-MINUS
  56           QUOTE-NEXT
  57           NON-ATOM
  58           M$$R-BACKS
  59           M$$R-ALPHA
  60           M$$R-EXCL
  61           M$$R-E
  62           M$$R-DIGIT
  63           M$$R-PLUS>
  64
  65 <GDECL (I$TRANS-TABLE!-INTERNAL) BYTES>
  66
  67 <COND (<NOT <GASSIGNED? I$TRANS-TABLE!-INTERNAL>>
  68        <SETG I$TRANS-TABLE!-INTERNAL
  69              <BYTES 8
  70                     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0
  71                     0 0 0 8 5 10 16 12 16 13 2 7 21 20 11 20 18 16 19 19 19 19 19
  72                     19 19 19 19 19 0 9 3 16 7 16 16 16 16 16 16 17 16 16 16 16 16
  73                     16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 4 15 7 16 16
  74                     16 16 16 16 16 17 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
  75                     16 16 16 16 16 16 6 14 7 16 16>>)>
  76
  77 <DEFMAC GET-ACCESS ('CHAN)
  78         <COND (<GASSIGNED? NEW-CHANNEL-TYPE> <FORM ACCESS .CHAN>)
  79               (ELSE <FORM 17 .CHAN>)>>
  80
  81 <DEFINE BUILD-INDEX (CHAN OBL
  82                      "AUX" (B ,BUFFER) (BL ,BUFLENGTH) (CHAR ,MAGIC-CHAR)
  83                            (MAXL ,MAGIC-MAX) (TOTAL-ACCESS <- .BL>)
  84                            (MS ,MAGIC-STRING) (ML ,MAGIC-LENGTH)
  85                            (LC1 ,LAST-CHAR1) (LC2 ,LAST-CHAR2)
  86                            (LC3 ,LAST-CHAR3) SL (WS ,WORD-STRING)
  87                            WRD SETG-OK WORD-OK)
  88    #DECL ((CHAN) CHANNEL (WS MS B) STRING (WRD ML BL MAXL TOTAL-ACCESS SL) FIX
  89           (OBL) OBLIST (CHAR LC1 LC2 LC3) CHARACTER)
  90    <REPEAT OUTER (START PL LEN POS (IM-POS <>) (INDEX ()) NAMESTR NAME-ATOM)
  91      #DECL ((PL LEN) FIX (POS) <OR FALSE STRING> (START) STRING)
  92      <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
  93      <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
  94      <REPEAT ((BB .B))
  95        #DECL ((BB) STRING)
  96        <COND
  97         (<AND <SET POS <MEMQ .CHAR .BB>>
  98               <SET PL <LENGTH .POS>>
  99               <OR <==? .LEN .BL> <G? .PL <- .BL .LEN>>>>
 100          <COND (<G? .PL .MAXL>                         ;"Foo! must back access"
 101                 <COND (<G? .TOTAL-ACCESS 0>
 102                        <ACCESS .CHAN <SET TOTAL-ACCESS <- .TOTAL-ACCESS .ML>>>
 103                        <SET TOTAL-ACCESS <- .TOTAL-ACCESS .BL>>
 104                        <AGAIN .OUTER>)
 105                       (ELSE                               ;"Must be bogus char"
 106                        <SET BB <REST .POS>> <AGAIN>)>)>
 107          <SET SL <LENGTH <SET START <REST .B <- .BL .PL .ML>>>>>
 108          <SET SETG-OK <SET WORD-OK T>>
 109          <COND
 110           (<MAPF <>
 111                  <FUNCTION (C1 C2 C3)
 112                          #DECL ((C1 C2 C3) CHARACTER)
 113                          <COND (<N==? .C1 .C2> <SET SETG-OK <>>)>
 114                          <COND (<N==? .C1 .C3> <SET WORD-OK <>>)>
 115                          .SETG-OK>
 116                  .START
 117                  .MS
 118                  .WS>
 119            <SET NAMESTR
 120             <MAPF ,STRING
 121              <FUNCTION ("AUX" CH)
 122                      <COND (<EMPTY? <SET POS <REST .POS>>>
 123                             <SET SL <+ .SL .BL>>
 124                             <COND (<L? .LEN .BL>
 125                                    <ERROR BAD-FILE!-ERRORS .CHAN>)>
 126                             <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
 127                             <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
 128                             <SET POS .B>)>
 129                      <COND (<OR <==? <SET CH <1 .POS>> <ASCII 32>>
 130                                 <==? .CH !\!>>
 131                             <MAPSTOP>)
 132                            (ELSE .CH)>>>>
 133            <SET NAME-ATOM <OR <LOOKUP .NAMESTR .OBL> <INSERT .NAMESTR .OBL>>>
 134            <COND
 135             (.IM-POS
 136              <PROG (CH)
 137                    <COND
 138                     (<SET POS <MEMQ .LC1 .POS>>
 139                      <SET POS <REST .POS>>
 140                      <PROG ()
 141                            <COND (<EMPTY? .POS>
 142                                   <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
 143                                   <SET POS .B>
 144                                   <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>)>
 145                            <COND (<L=? <ASCII <SET CH <1 .POS>>> 32>
 146                                   <SET POS <REST .POS>>
 147                                   <AGAIN>)>>
 148                      <COND (<N==? <1 .POS> .LC2> <AGAIN>)>
 149                      <SET POS <REST .POS>>
 150                      <PROG ()
 151                            <COND (<EMPTY? .POS>
 152                                   <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
 153                                   <SET POS .B>
 154                                   <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>)>
 155                            <COND (<L=? <ASCII <SET CH <1 .POS>>> 32>
 156                                   <SET POS <REST .POS>>
 157                                   <AGAIN>)>>
 158                      <COND (<N==? <1 .POS> .LC3> <AGAIN>)>
 159                      <SET POS <REST .POS>>)
 160                     (ELSE
 161                      <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
 162                      <SET POS .B>
 163                      <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
 164                      <AGAIN>)>>
 165              <SET INDEX
 166                   ((.NAME-ATOM .IM-POS <+ .TOTAL-ACCESS <- .BL <LENGTH .POS>>>
 167                     !<COND (<ASSIGNED? WRD> (<CHTYPE .WRD WORD>))
 168                            (ELSE ())>)
 169                    !.INDEX)>
 170              <SET IM-POS <>>)
 171             (ELSE <SET IM-POS <+ .TOTAL-ACCESS <- .BL .SL>>>)>)
 172           (.WORD-OK
 173            <SET WRD 0>
 174            <MAPF <>
 175              <FUNCTION ("AUX" CH)
 176                      <COND (<EMPTY? <SET POS <REST .POS>>>
 177                             <SET SL <+ .SL .BL>>
 178                             <COND (<L? .LEN .BL>
 179                                    <ERROR BAD-FILE!-ERRORS .CHAN>)>
 180                             <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
 181                             <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>>
 182                             <SET POS .B>)>
 183                      <COND (<==? <SET CH <1 .POS>> !\*>
 184                             <COND (.WORD-OK <SET WORD-OK <>>)
 185                                   (ELSE <MAPLEAVE>)>)
 186                            (<NOT .WORD-OK>
 187                             <SET WRD <ORB <LSH .WRD 3>
 188                                           <- <ASCII .CH> <ASCII !\0>>>>)>>>)
 189           (ELSE <SET POS <REST .POS>>)>
 190          <SET BB .POS>)
 191         (ELSE <RETURN>)>>
 192      <COND (<N==? .LEN .BL> <RETURN .INDEX>)>>>
 193
 194 <DEFINE SKIP-MIMA (CHAN NAME "OPT" (FUDGE -2)
 195                    "AUX" (MCHAR ,MAGIC-CHAR) (MS ,MAGIC-STRING2)
 196                                    (ML ,MAGIC-LENGTH2) (MAXL ,MAGIC-MAX2)
 197                                    (SPN <SPNAME .NAME>) (ECHAR ,LAST-CHAR3))
 198    #DECL ((CHAN) CHANNEL (NAME) ATOM (MS) STRING (MAXL ML) FIX
 199           (MCHAR ECHAR) CHARACTER)
 200    <REPEAT OUTER ((B ,BUFFER) (BL ,BUFLENGTH) POS PL LEN
 201                   (TOTAL-ACCESS <- <GET-ACCESS .CHAN> .BL>))
 202            #DECL ((B) STRING (LEN PL BL TOTAL-ACCESS) FIX
 203                   (POS) <OR FALSE STRING>)
 204            <SET LEN <CHANNEL-OP .CHAN READ-BUFFER .B>>
 205            <SET TOTAL-ACCESS <+ .TOTAL-ACCESS .BL>> ;"Point to first character
 206                                                       looked at this time"
 207            <REPEAT ((BB .B) (STATE ,IN-ATOM))
 208                    #DECL ((BB) STRING (STATE) FIX)
 209                <COND (<AND <SET POS <MEMQ .MCHAR .BB>>
 210                            <SET PL <LENGTH .POS>>
 211                            <OR <==? .BL .LEN> <G? .PL <- .BL .LEN>>>>
 212                       <COND (<G? .PL .MAXL>
 213                              ; "Got hit too close to beginning of buffer"
 214                              <COND (<G? .TOTAL-ACCESS 0>
 215                                     ; "Already read at least one buffer,
 216                                        so back up a bit and try again."
 217                                     <ACCESS .CHAN
 218                                             <SET TOTAL-ACCESS
 219                                                  <- .TOTAL-ACCESS .ML>>>
 220                                     <SET TOTAL-ACCESS <- .TOTAL-ACCESS .BL>>
 221                                     <AGAIN .OUTER>)
 222                                    (ELSE
 223                                     <SET BB <REST .POS>>
 224                                     <AGAIN>)>)>
 225                       <COND
 226                        (<MAPF <>
 227                               <FUNCTION (C1 C2)
 228                                    #DECL ((C1 C2) CHARACTER)
 229                                    <COND (<N==? .C1 .C2>
 230                                           <MAPLEAVE <>>)>
 231                                    1>
 232                               <REST .B <- .BL .PL .ML>>
 233                               .MS>
 234                         ; "Succeed if ^Z is actually <END ^Z..., then
 235                            check the name of the function to make sure
 236                            it matches"
 237                         <MAPF <>
 238                               <FUNCTION ("AUX" C2)
 239                                   <COND (<EMPTY? <SET POS <REST .POS>>>
 240                                          <COND (<N==? .LEN .BL>
 241                                                 <ERROR BAD-MIMA!-ERRORS
 242                                                        .NAME>)>
 243                                          <SET LEN <CHANNEL-OP .CHAN
 244                                                               READ-BUFFER
 245                                                               <SET POS .B>>>
 246                                          <SET TOTAL-ACCESS
 247                                               <+ .TOTAL-ACCESS .BL>>)>
 248                                   <SET C2 <1 .POS>>
 249                                   <COND (<EMPTY? .SPN>
 250                                          <COND (<==? .C2 .ECHAR> <MAPLEAVE>)
 251                                                (<==? <SET STATE
 252                                                           <SKIP-TRL .C2 .STATE>>
 253                                                      ,NON-ATOM>
 254                                                 <ERROR BAD-MIMA!-ERRORS .NAME>)>)
 255                                         (<N==? .C2 <1 .SPN>>
 256                                          <ERROR BAD-MIMA!-ERRORS .NAME>)
 257                                         (ELSE <SET SPN <REST .SPN>>)>>>
 258                         ; "POS points to > closing <END ^ZFCNNAME>;
 259                            TOTAL-ACCESS is character number of beginning
 260                            current buffer."
 261                         <ACCESS .CHAN
 262                                 <+ .TOTAL-ACCESS <- .BL <LENGTH .POS>
 263                                                     .FUDGE>>>
 264                         <RETURN T .OUTER>)
 265                        (ELSE <SET BB <REST .POS>>)>)
 266                      (ELSE
 267                       ; "Come here when went past end of good buffer"
 268                       <RETURN>)>>
 269            <COND (<N==? .LEN .BL> <ERROR BAD-MIMA!-ERRORS .NAME>)>>>
 270
 271 <DEFINE SKIP-TRL (CHAR STATE "AUX" (TRNS <NTH ,I$TRANS-TABLE!-INTERNAL
 272                                               <+ <ASCII .CHAR> 1>>))
 273                  #DECL ((CHAR) CHARACTER (TRNS STATE) FIX)
 274         <COND (<AND <==? .STATE ,IN-ATOM> <==? .TRNS ,M$$R-EXCL>> ,NEED-MINUS)
 275               (<==? .STATE ,NEED-MINUS>
 276                <COND (<==? .CHAR !\-> ,IN-ATOM) (ELSE ,NON-ATOM)>)
 277               (<==? .STATE ,QUOTE-NEXT> ,IN-ATOM)
 278               (<==? .TRNS ,M$$R-BACKS> ,QUOTE-NEXT)
 279               (<OR <==? .TRNS ,M$$R-ALPHA>
 280                    <==? .TRNS ,M$$R-DIGIT>
 281                    <==? .TRNS ,M$$R-PLUS>
 282                    <==? .TRNS ,M$$R-E>
 283                    <==? .TRNS ,M$$R-STAR>> ,IN-ATOM)
 284               (ELSE ,NON-ATOM)>>
 285 <ENDPACKAGE>