mim/development/mim/vaxc/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 <MANIFEST IN-ATOM
  53           NEED-MINUS
  54           QUOTE-NEXT
  55           NON-ATOM
  56           M$$R-BACKS
  57           M$$R-ALPHA
  58           M$$R-EXCL
  59           M$$R-E
  60           M$$R-DIGIT
  61           M$$R-PLUS>
  62
  63 <GDECL (I$TRANS-TABLE!-INTERNAL) BYTES>
  64
  65 <COND (<NOT <GASSIGNED? I$TRANS-TABLE!-INTERNAL>>
  66        <SETG I$TRANS-TABLE!-INTERNAL
  67              <BYTES 8
  68                     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
  69                     0 0 0 0 0 0 0 0 1 0 0 0 0 0 8 5 10 16 12
  70                     16 13 2 7 21 20 11 20 18 16 19 19 19 19 19 19
  71                     19 19 19 19 0 9 3 16 7 16 16 16 16 16 16 17
  72                     16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
  73                     16 16 16 16 16 4 15 7 16 16 16 16 16 16 16 17
  74                     16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
  75                     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           (T
 190            <SET POS <REST .POS>>)>
 191          <SET BB .POS>)
 192         (ELSE <RETURN>)>>
 193      <COND (<N==? .LEN .BL> <RETURN .INDEX>)>>>
 194
 195 <DEFINE SKIP-MIMA (CHAN NAME "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>>
 206            <REPEAT ((BB .B) (STATE ,IN-ATOM))
 207                    #DECL ((BB) STRING (STATE) FIX)
 208                <COND (<AND <SET POS <MEMQ .MCHAR .BB>>
 209                            <SET PL <LENGTH .POS>>
 210                            <OR <==? .BL .LEN> <G? .PL <- .BL .LEN>>>>
 211                       <COND (<G? .PL .MAXL>
 212                              <COND (<G? .TOTAL-ACCESS 0>
 213                                     <ACCESS .CHAN
 214                                             <SET TOTAL-ACCESS
 215                                                  <- .TOTAL-ACCESS .ML>>>
 216                                     <SET TOTAL-ACCESS <- .TOTAL-ACCESS .BL>>
 217                                     <AGAIN .OUTER>)
 218                                    (ELSE
 219                                     <SET BB <REST .POS>>
 220                                     <AGAIN>)>)>
 221                       <COND
 222                        (<MAPF <>
 223                               <FUNCTION (C1 C2)
 224                                    #DECL ((C1 C2) CHARACTER)
 225                                    <COND (<N==? .C1 .C2>
 226                                           <MAPLEAVE <>>)>
 227                                    1>
 228                               <REST .B <- .BL .PL .ML>>
 229                               .MS>
 230                         <MAPF <>
 231                               <FUNCTION ("AUX" C2)
 232                                   <COND (<EMPTY? <SET POS <REST .POS>>>
 233                                          <COND (<N==? .LEN .BL>
 234                                                 <ERROR BAD-MIMA!-ERRORS
 235                                                        .NAME>)>
 236                                          <SET LEN <CHANNEL-OP .CHAN
 237                                                               READ-BUFFER
 238                                                               <SET POS .B>>>
 239                                          <SET TOTAL-ACCESS
 240                                               <+ .TOTAL-ACCESS .BL>>)>
 241                                   <SET C2 <1 .POS>>
 242                                   <COND (<EMPTY? .SPN>
 243                                          <COND (<==? .C2 .ECHAR> <MAPLEAVE>)
 244                                                (<==? <SET STATE
 245                                                           <SKIP-TRL .C2 .STATE>>
 246                                                      ,NON-ATOM>
 247                                                 <ERROR BAD-MIMA!-ERRORS .NAME>)>)
 248                                         (<N==? .C2 <1 .SPN>>
 249                                          <ERROR BAD-MIMA!-ERRORS .NAME>)
 250                                         (ELSE <SET SPN <REST .SPN>>)>>>
 251                         <ACCESS .CHAN
 252                                 <+ .TOTAL-ACCESS <- .BL <LENGTH .POS> -2>>>
 253                         <RETURN T .OUTER>)
 254                        (ELSE <SET BB <REST .POS>>)>)
 255                      (ELSE <RETURN>)>>
 256            <COND (<N==? .LEN .BL> <ERROR BAD-MIMA!-ERRORS .NAME>)>>>
 257
 258 <DEFINE SKIP-TRL (CHAR STATE "AUX" (TRNS <NTH ,I$TRANS-TABLE!-INTERNAL
 259                                               <+ <ASCII .CHAR> 1>>))
 260                  #DECL ((CHAR) CHARACTER (TRNS STATE) FIX)
 261         <COND (<AND <==? .STATE ,IN-ATOM> <==? .TRNS ,M$$R-EXCL>> ,NEED-MINUS)
 262               (<==? .STATE ,NEED-MINUS>
 263                <COND (<==? .CHAR !\-> ,IN-ATOM) (ELSE ,NON-ATOM)>)
 264               (<==? .STATE ,QUOTE-NEXT> ,IN-ATOM)
 265               (<==? .TRNS ,M$$R-BACKS> ,QUOTE-NEXT)
 266               (<OR <==? .TRNS ,M$$R-ALPHA>
 267                    <==? .TRNS ,M$$R-DIGIT>
 268                    <==? .TRNS ,M$$R-PLUS>
 269                    <==? .TRNS ,M$$R-E>
 270                    <==? .TRNS ,M$$R-STAR>> ,IN-ATOM)
 271               (ELSE ,NON-ATOM)>>
 272 <ENDPACKAGE>