mim/development/mim/boot/boot.mud

   1 ;"This is the MUM/MDL bootstrap file.  One hopes that, when compiled,
   2 this file will cause an MDL to be brought up and initialized.
   3 Fat chance."
   4
   5 \f
   6 ;"READ part of bootstrap"
   7
   8 <DEFINE T$READ (T$INCHAN "AUX" VAL)
   9         #DECL ((T$INCHAN) <SPECIAL VECTOR>)
  10         <SETG I$CONT <>>
  11         <SETG I$R? .T$INCHAN>
  12         <COND (<TYPE? <I$RDBUF .T$INCHAN> T$UNBOUND>
  13                <CHTYPE ,ZERO T$UNBOUND>)
  14               (T <I$PARSE>)>>
  15
  16 <DEFINE I$RDBUF (C "AUX" (BUF <M$$BUFF .C>) LEN)
  17         #DECL ((C) T$BCHANNEL (BUF) STRING (LEN) FIX)
  18         <COND (<AND <NOT <0? <M$$BPOS .C>>> <NOT <EMPTY? .BUF>>>
  19                <SETG BI$STR <REST .BUF <- <M$$BUFL .C> <M$$BPOS .C>>>>)
  20               (T
  21                <M$$BPOS .C
  22                         <SET LEN <CALL READ <M$$CHAN .C>
  23                                        .BUF
  24                                        <LENGTH .BUF>
  25                                        0>>>
  26                <M$$BUFL .C .LEN>
  27                <SETG BI$STR .BUF>
  28                <COND (<0? <M$$BPOS .C>>
  29                       <CHTYPE ,ZERO T$UNBOUND>)>)>>
  30
  31 <DEFINE T$RCHR (CHN)
  32         #DECL ((CHN) VECTOR)
  33         <CALL READ <M$$CHAN .CHN> ,I$CHRSTR 1 0>
  34         <1 ,I$CHRSTR>>
  35
  36 <DEFINE I$NXTCHR ("AUX" CHR NCHR (R ,I$R?))
  37         #DECL ((CHR) CHARACTER (NCHR) <OR CHARACTER FALSE>
  38                (R) <OR FALSE T$BCHANNEL>)
  39         <COND (<SET NCHR ,BI$NCHR>
  40                <SETG BI$NCHR <>>
  41                .NCHR)
  42               (<OR <AND .R <0? <M$$BPOS .R>>>
  43                    <AND <NOT .R> <EMPTY? ,BI$STR>>>
  44                <COND (.R
  45                       <COND (<OR ,I$CONT
  46                                  <N==? <M$$CHAN .R> 64>>
  47                              <SETG I$CONT <>>
  48                              <AND <==? <M$$CHAN .R> 64>
  49                                   <T$RCHR .R>>
  50                              <COND (<TYPE? <I$RDBUF .R> T$UNBOUND>
  51                                     <CHTYPE ,ZERO CHARACTER>)
  52                                    (T <I$NXTCHR>)>)
  53                             (T
  54                              <SETG I$CONT T>
  55                              <CHTYPE ,ZERO CHARACTER>)>)
  56                      (T <CHTYPE ,ZERO CHARACTER>)>)
  57               (T
  58                <SET CHR <1 ,BI$STR>>
  59                <SETG BI$STR <REST ,BI$STR>>
  60                <AND .R <M$$BPOS .R <- <M$$BPOS .R> 1>>>
  61                .CHR)>>
  62
  63 <DEFINE I$PARSE ("OPTIONAL" (PFX <>) "AUX" CHR ASC NCHR TYP)
  64         #DECL ((CHR NCHR) CHARACTER (ASC) FIX (TYP) ANY
  65                (PFX) <OR ATOM FALSE>)
  66         <REPEAT ()
  67                 <COND (<MEMQ <SET CHR <I$NXTCHR>> ,BREAKS>)
  68                       (T
  69                        <RETURN>)>>
  70         <SET ASC <ASCII .CHR>>
  71         <COND (<==? .CHR !\(>
  72                <RETVAL <I$PLIST> .PFX>)
  73               (<==? .CHR !\<>
  74                <RETVAL <CHTYPE <I$PLIST !\>> FORM> .PFX>)
  75               (<==? .CHR !\[>
  76                <RETVAL <I$PVECTOR> .PFX>)
  77               (<==? .CHR !\">
  78                <RETVAL <I$PSTRING> .PFX>)
  79               (<==? .CHR !\|>
  80                <RETVAL <I$PMCODE> .PFX>)
  81               (<MEMQ .CHR ")]>">
  82                <CHTYPE .ASC T$UNBOUND>)
  83               (<==? .CHR !\!>
  84                <COND (<==? <SET NCHR <I$NXTCHR>> <ASCII 0>>
  85                       <CHTYPE ,ZERO T$UNBOUND>)
  86                      (<==? .NCHR <ASCII 92>>
  87                       <SET CHR <I$NXTCHR>>
  88                       <RETVAL .CHR .PFX>)
  89                      (<==? .NCHR !\<>
  90                       <RETVAL <CHTYPE <I$PLIST !\>> SEGMENT> .PFX>)
  91                      (<==? .NCHR !\>>
  92                       <CHTYPE .NCHR T$UNBOUND>)
  93                      (<T$ERROR %<P-E "BAD-USE-OF-EXCL">>)>)
  94               (<OR <AND <G=? .ASC <ASCII !\0>>
  95                         <L=? .ASC <ASCII !\9>>>
  96                    <==? .CHR !\+>
  97                    <==? .CHR !\->>
  98                <SETG BI$NCHR .CHR>
  99                <RETVAL <I$PNUMBER> .PFX>)
 100               (<==? .CHR !\#>
 101                <SET TYP <I$PARSE>>
 102                <COND (<TYPE? .TYP FIX>
 103                       <SETG BI$RADIX .TYP>
 104                       <RETVAL <I$PARSE> .PFX>)
 105                      (T
 106                       <RETVAL <T$CHTYPE <I$PARSE> .TYP> .PFX>)>)
 107               (<==? .CHR !\%>
 108                <COND (<==? <SET NCHR <I$NXTCHR>> !\%>
 109                       <T$EVAL <I$PARSE>>
 110                       <I$PARSE>)
 111                      (T
 112                       <SETG BI$NCHR .NCHR>
 113                       <T$EVAL <I$PARSE>>)>)
 114               (<==? .CHR !\,>
 115                <SET TYP <I$PARSE T>>
 116                <RETVAL <FORM <LOOKUP "GVAL" ,M$$ROOT> .TYP> .PFX>)
 117               (<==? .CHR !\'>
 118                <RETVAL <FORM <LOOKUP "QUOTE" ,M$$ROOT> <I$PARSE T>> .PFX>)
 119               (<==? .CHR !\.>
 120                <SETG I$FRC T>
 121                <SET TYP <I$PARSE T>>
 122                <SETG I$FRC <>>
 123                <COND (<TYPE? .TYP FLOAT>
 124                       <RETVAL .TYP .PFX>)
 125                      (T
 126                       <RETVAL <FORM <LOOKUP "LVAL" ,M$$ROOT> .TYP> .PFX>)>)
 127               (<==? .CHR !\;>
 128                <I$PARSE>
 129                <I$PARSE>)
 130               (T
 131                <SETG BI$NCHR .CHR>
 132                <RETVAL <I$PNUMBER T> .PFX>)>>
 133
 134 <DEFINE RETVAL (RET PFX)
 135         #DECL ((RET) ANY (PFX) <OR ATOM FALSE>)
 136         .RET>
 137
 138 <DEFINE I$PLIST ("OPTIONAL" (TERM !\)))
 139         #DECL ((TERM) CHARACTER)
 140         <MAPF ,LIST
 141               <FUNCTION ("AUX" ITM)
 142                    #DECL ((ITM) ANY)
 143                    <COND (<TYPE? <SET ITM <I$PARSE>> T$UNBOUND>
 144                           <COND (<OR <==? <CHTYPE .ITM FIX> <ASCII .TERM>>
 145                                      <==? .ITM <CHTYPE ,ZERO T$UNBOUND>>>
 146                                  <MAPSTOP>)
 147                                 (T
 148                                  <I$PUNMATCH .ITM .TERM>)>)
 149                          (.ITM)>>>>
 150 <DEFINE I$PVECTOR ()
 151         <MAPF ,VECTOR
 152               <FUNCTION ("AUX" ITM)
 153                    #DECL ((ITM) ANY)
 154                    <COND (<TYPE? <SET ITM <I$PARSE>> T$UNBOUND>
 155                           <COND (<OR <==? <CHTYPE .ITM FIX> <ASCII !\]>>
 156                                      <==? .ITM <CHTYPE ,ZERO T$UNBOUND>>>
 157                                  <MAPSTOP>)
 158                                 (T
 159                                  <I$PUNMATCH .ITM !\]>)>)
 160                          (.ITM)>>>>
 161
 162 <DEFINE I$PUNMATCH (TERMIN EXPECT)
 163         #DECL ((TERMIN) T$UNBOUND (EXPECT) CHARACTER)
 164         <T$ERROR %<P-E "SYNTAX-ERROR">
 165                  <STRING <CHTYPE .TERMIN CHARACTER>
 166                          " INSTEAD OF "
 167                          .EXPECT>
 168                  %<P-R "READ!-">>>
 169
 170 <DEFINE I$PSTRING ("AUX" (QUOTE <>) STR)
 171         #DECL ((QUOTE) <OR FALSE ATOM> (STR VALUE) STRING)
 172         <SET STR <MAPF ,STRING
 173                        <FUNCTION ("AUX" (CHR <I$NXTCHR>))
 174                             #DECL ((CHR) CHARACTER)
 175                             <COND (.QUOTE
 176                                    <SET QUOTE <>>
 177                                    .CHR)
 178                                   (<==? .CHR <ASCII 92>>
 179                                    <SET QUOTE T>
 180                                    <MAPRET>)
 181                                   (<==? .CHR !\">
 182                                    <MAPSTOP>)
 183                                   (.CHR)>>>>
 184          <COND (<EMPTY? .STR> .STR)
 185                (<T$LOOKUP .STR ,STOBLIST>
 186                 <M$$PNAM <CHTYPE <T$LOOKUP .STR ,STOBLIST> T$ATOM>>)
 187                (.STR)>>
 188
 189 <DEFINE I$NOLF ("AUX" CHR1)
 190         #DECL ((CHR1 VALUE) CHARACTER)
 191         <COND (<OR <==? <SET CHR1 <I$NXTCHR>> <ASCII 13>>
 192                    <==? .CHR1 <ASCII 10>>>
 193                <COND (<==? <SET CHR1 <I$NXTCHR>> <ASCII 10>>
 194                       <SET CHR1 <I$NXTCHR>>)>)>
 195         .CHR1>
 196
 197 <DEFINE I$PMCODE ("AUX" (NUM 0) MC (VERT? <>))
 198         #DECL ((NUM) FIX (MC) <PRIMTYPE UVECTOR> (VERT?) <OR FALSE ATOM>)
 199         <REPEAT ((N 2) CHR1)
 200                 #DECL ((N) FIX (CHR1) CHARACTER)
 201                 <SET CHR1 <I$NOLF>>
 202                 <SET NUM <+ .NUM
 203                             <CHTYPE <ORB <- <CHTYPE <I$NOLF> FIX>
 204                                             <ASCII !\A>>
 205                                          <LSH <- <ASCII .CHR1> <ASCII !\A>> 5>>
 206                                     FIX>>>
 207                 <COND (<L? <SET N <- .N 1>> 0> <RETURN>)
 208                       (T <SET NUM <CHTYPE <LSH .NUM 8> FIX>>)>>
 209         <SET MC <CALL IRECORD
 210                             *1006* ;<T$TYPE-C MCODE>
 211                             .NUM
 212                             .NUM>>
 213         <MAPR <>
 214               <FUNCTION (MCD "AUX" CHR1)
 215                    #DECL ((CHR1) CHARACTER (MCD) <PRIMTYPE UVECTOR>)
 216                    <SET CHR1 <I$NOLF>>
 217                    <COND (<==? .CHR1 !\|>
 218                           <SET VERT? T>
 219                           <MAPLEAVE T>)
 220                          (T
 221                           <REPEAT ((I 3) QW (WD <ONE-Q-WD .CHR1>))
 222                                   #DECL ((I WD) FIX (QW) <OR FALSE FIX>)
 223                               <COND (<SET QW <ONE-Q-WD>>
 224                                      <SET WD
 225                                           <ORB <LSH .WD ,QWSIZ> .QW>>)
 226                                     (ELSE
 227                                      <SET WD <LSH .WD <* .I ,QWSIZ>>>
 228                                      <PUT .MCD 1 .WD>
 229                                      <RETURN>)>
 230                               <COND (<0? <SET I <- .I 1>>>
 231                                      <PUT .MCD 1 .WD>
 232                                      <RETURN>)>>)>>
 233               .MC>
 234         <COND (<NOT .VERT?> <I$NOLF>)>
 235         .MC>
 236
 237 <DEFINE ONE-Q-WD ("OPT" (FCHR <I$NOLF>) "AUX" CHR)
 238         #DECL ((CHR FCHR) CHARACTER)
 239         <COND (<AND <N==? .FCHR !\|>
 240                     <N==? <SET CHR <I$NOLF>> !\|>>
 241                <ORB <- <CHTYPE .CHR FIX> <ASCII !\A>>
 242                     <LSH <- <ASCII .FCHR> <ASCII !\A>> 5>>)>>
 243
 244 <DEFINE I$PNUMBER ("OPTIONAL" (ATM? <>) "AUX" (EXP 0) (FRC 0) (NUM 0) VAL NV
 245                                               (EXP? <>) (FRC? ,I$FRC)
 246                                               OBNAM OBL (FRCN 1) (SGN? <>)
 247                                               (QUOTE? <>) (NEG? <>) CHR ATM
 248                                               (TRL? <>) (DIVIDE <>))
 249         #DECL ((ATM? EXP? FRC? TRL? SGN? NEG? QUOTE? DIVIDE) <OR FALSE ATOM>
 250                (NUM EXP FRC RADIX FRCN) FIX (VAL) <OR STRING FALSE>
 251                (NV) <OR FIX FLOAT> (CHR) CHARACTER (OBL) T$OBLIST
 252                (ATM) <OR T$ATOM ANY> (OBNAM) ANY)
 253         <COND (<==? <SET CHR <I$NXTCHR>> <ASCII 0>>
 254                <CHTYPE ,ZERO T$UNBOUND>)
 255               (T
 256                <SETG BI$NCHR .CHR>
 257                <SET VAL
 258                     <MAPF ,STRING
 259                           <FUNCTION ("AUX" (CHR <I$NXTCHR>) (ASC <ASCII .CHR>))
 260                                #DECL ((CHR) CHARACTER (ASC) FIX)
 261                                <COND (.QUOTE?
 262                                       <SET QUOTE? <>>)
 263                                      (<==? .CHR <ASCII 92>>
 264                                       <SET ATM? T>
 265                                       <SET QUOTE? T>)
 266                                      (<OR <MEMQ .CHR ,BREAKS>
 267                                           <MEMQ .CHR ,BRACKS>
 268                                           <==? .CHR !\!>>
 269                                       <COND (<==? .CHR !\!>
 270                                              <COND (<==? <SET CHR <I$NXTCHR>>
 271                                                          !\->
 272                                                     <SET TRL? T>)
 273                                                    (<==? .CHR <ASCII 0>>
 274                                                     <SETG BI$NCHR .CHR>)
 275                                                    (<MAPRET>)>)
 276                                             (T
 277                                              <SETG BI$NCHR .CHR>)>
 278                                       <COND (<OR .ATM?
 279                                                  <AND .SGN?
 280                                                       <0? .NUM>
 281                                                       <0? .FRC>>>
 282                                              <MAPSTOP>)
 283                                             (T
 284                                              <MAPLEAVE <>>)>)
 285                                      (<==? .ASC 0>
 286                                       <COND (<OR .ATM?
 287                                                  <AND .SGN?
 288                                                       <0? .NUM>
 289                                                       <0? .FRC>>>
 290                                              <MAPSTOP>)
 291                                             (T <MAPLEAVE <>>)>)
 292                                      (.ATM?)
 293                                      (<OR <==? .CHR !\+> <==? .CHR !\->>
 294                                       <COND (<AND .EXP? <0? .EXP>>
 295                                              <COND (<==? .CHR !\->
 296                                                     <SET DIVIDE T>)>)
 297                                             (<AND <0? .NUM>
 298                                                   <0? .FRC>
 299                                                   <NOT .NEG?>
 300                                                   <NOT .ATM?>>
 301                                              <SET SGN? T>
 302                                              <AND <==? .CHR !\->
 303                                                   <SET NEG? T>>)
 304                                             (T <SET ATM? T>)>)
 305                                      (<AND <G=? .ASC <ASCII !\0>>
 306                                            <L=? .ASC <ASCII !\9>>>
 307                                       <SET ASC <- .ASC <ASCII !\0>>>
 308                                       <COND (.EXP?
 309                                              <SET EXP <+ <* .EXP 10> .ASC>>)
 310                                             (.FRC?
 311                                              <SET FRC <+ <* .FRC 10> .ASC>>
 312                                              <SET FRCN <* .FRCN 10>>)
 313                                             (T
 314                                              <SET NUM <+ <* .NUM ,BI$RADIX>
 315                                                          .ASC>>)>)
 316                                      (<OR <==? .CHR !\E> <==? .CHR !\e>>
 317                                       <COND (.EXP? <SET ATM? T>)
 318                                             (T <SET EXP? T>)>)
 319                                      (<==? .CHR !\.>
 320                                       <COND (.FRC? <SET ATM? T>)
 321                                             (T <SET FRC? T>)>)
 322                                      (T <SET ATM? T>)>
 323                                <COND (.QUOTE? <MAPRET>)
 324                                      (.CHR)>>>>
 325                <COND (<NOT .VAL>
 326                       <SETG BI$RADIX 10>
 327                       <SET NV
 328                            <COND (.FRC?
 329                                   <+ <FLOAT .NUM>
 330                                      </ <FLOAT .FRC> <FLOAT .FRCN>>>)
 331                                  (.NUM)>>
 332                       <COND (.EXP?
 333                              <COND (<0? .EXP>)
 334                                    (<L=? .EXP 7>
 335                                     <SET NV
 336                                          <COND (.DIVIDE
 337                                                 </ <FLOAT .NV>
 338                                                    <NTH ,I$POWERS .EXP>>)
 339                                                (ELSE
 340                                                 <* <FLOAT .NV>
 341                                                    <NTH ,I$POWERS .EXP>>)>>)
 342                                    (T
 343                                     <T$ERROR %<P-E "NUMBER-OUT-OF-RANGE">
 344                                              %<P-R "READ">>)>)>
 345                       <COND (.NEG? <SET NV <- .NV>>)>
 346                       .NV)
 347                      (.TRL?
 348                       <COND (<OR <MEMQ <SET CHR <I$NXTCHR>> ,BREAKS>
 349                                  <==? .CHR <ASCII 0>>
 350                                  <==? .CHR !\!>>
 351                              <SET OBL ,M$$ROOT>)
 352                             (<MEMQ .CHR ,BRACKS>
 353                              <SET OBL ,M$$ROOT>
 354                              <SETG BI$NCHR .CHR>)
 355                             (<AND <SETG BI$NCHR .CHR>
 356                                   <TYPE? <SET OBNAM <I$PARSE>> T$ATOM>
 357                                   <=? <M$$PNAM .OBNAM>:STRING "IMSUBR">>
 358                              <SET OBL ,IMSUBOB>)
 359                             (<T$ERROR %<P-E "NON-ATOMIC-NAME">
 360                                       .OBNAM>)>
 361                       <OR <T$LOOKUP .VAL .OBL>
 362                           <T$INSERT .VAL .OBL>>)
 363                      (<==? <1 .VAL> !\@>
 364                       <OR <T$LOOKUP <REST .VAL> ,EROBLIST>
 365                           <T$INSERT <REST .VAL> ,EROBLIST>>)
 366                      (<OR <T$LOOKUP .VAL ,M$$INTERNAL>
 367                           <T$INSERT .VAL ,M$$INTERNAL>>)>)>>
 368
 369 <DEFINE T$FLOAD (STR "OPTIONAL" (OSTR <>) "AUX" C)
 370         #DECL ((STR OSTR) <OR STRING FALSE> (C) <OR VECTOR FALSE>)
 371         <COND (<AND .STR <SET C <T$OPEN "READ" .STR>>>
 372                <REPEAT (VAL)
 373                        <SET VAL <T$READ .C>>
 374                        <COND (<TYPE? .VAL T$UNBOUND> <RETURN>)
 375                              (T <T$EVAL .VAL>)>>
 376                <T$CLOSE .C>
 377                "DONE")
 378               (.OSTR
 379                <T$FLOAD .OSTR <>>)
 380               (.C)>>
 381
 382 <DEFINE T$CLOSE (CHAN "AUX" (CNUM <M$$CHAN .CHAN>))
 383         #DECL ((CHAN) VECTOR (CNUM) FIX)
 384         <CALL CLOSE .CNUM>
 385         <M$$CHAN .CHAN 0>>
 386
 387 <DEFINE T$OPEN (DIR FNM "OPTIONAL" (RADX 10) "AUX" ID CHN)
 388         #DECL ((DIR FNM) STRING (RADX) FIX (ID) <OR FALSE FIX> (CHN) VECTOR)
 389         <COND (<SET ID <CALL OPEN 0 7 .FNM>>
 390                <SET CHN [.ID .DIR "FOO" .FNM 79 0 24 0 10
 391                              "////////////////////////////////////////
 392 ////////////////////////////////////////
 393 ////////////////////////////////////////
 394 ////////////////////////////////////////
 395 ////////////////////////////////////////
 396 //////////////////////////////////////////////" 0 0 0]>
 397                <SETG BI$NCHR <>>
 398                .CHN)>>
 399
 400 ;"Primitive TYPEs"
 401
 402 <DEFINE T$CHTYPE (ITM TYP "AUX" (SPN <M$$PNAM .TYP>) TYPC)
 403         #DECL ((ITM) ANY (TYP) T$ATOM (SPN) STRING (TYPC) FIX)
 404         <COND (<=? .SPN "MSUBR">
 405                <SET TYPC *1207*>)
 406               (<=? .SPN "IMSUBR">
 407                <SET TYPC *4007*>)
 408               (<=? .SPN "MCODE">
 409                <SET TYPC *1006*>)
 410               (<=? .SPN "FALSE">
 411                <SET TYPC *501*>)
 412               (<=? .SPN "I$TERMIN">
 413                <SET TYPC *2200*>)
 414               (<=? .SPN "UNBOUND">
 415                <SET TYPC 0>)
 416               (<ERROR .SPN>)>
 417         <CALL CHTYPE .ITM .TYPC>>
 418
 419 \f
 420 ;"Primitive structure builders"
 421
 422 <DEFINE T$ATOM (STR)
 423         #DECL ((STR) STRING)
 424         <CALL RECORD *1502* ;<TYPE-CODE ATOM> <> <> <STRING .STR> <> <>>>
 425
 426 \f
 427 ;"Primitive EVAL"
 428
 429 <DEFINE T$EVAL (FOO "AUX" PN ATM)
 430         #DECL ((FOO) ANY (PN) STRING (ATM) T$ATOM)
 431         <COND (<TYPE? .FOO FORM>
 432                <COND (<NOT <EMPTY? .FOO>>
 433                       <SET PN <M$$PNAM <SET ATM <1 .FOO>>>>
 434                       <COND (<=? .PN "SETG">
 435                              <T$SETG <2 .FOO> <3 .FOO>>)
 436                             (<=? .PN "GBIND">
 437                              <COND (<NOT <M$$GVAL <SET ATM <2 .FOO>>>>
 438                                     <T$SETG .ATM <CHTYPE ,ZERO T$UNBOUND>>
 439                                     <M$$GVAL .ATM>)
 440                                    (<M$$GVAL .ATM>)>)
 441                             (<=? .PN "PCODE">
 442                              <T$PCODE <2 .FOO> <3 .FOO>>)
 443                             (<=? .PN "QUOTE">
 444                              .FOO)
 445                             (<ERROR LOSER>)>)
 446                      (T <>)>)
 447               (.FOO)>>
 448
 449 ;"ATOM part of bootstrap"
 450
 451 <DEFINE I$HASH (STR "OPTIONAL" (MOD 0) "AUX" (VAL 0) OFF)
 452         #DECL ((STR) STRING (MOD OFF VAL) FIX)
 453         <IFSYS ("TOPS20" <SET OFF 36>)("UNIX" <SET OFF 32>)>
 454         <MAPF <>
 455           <FUNCTION (CHR)
 456             <IFSYS ("TOPS20"
 457                     <COND (<L? <SET OFF <- .OFF 7>> 0>
 458                            <SET OFF 29>)>)
 459                    ("UNIX"
 460                     <COND (<L? <SET OFF <- .OFF 8>> 0>
 461                            <SET OFF 24>)>)>
 462             <SET VAL <XORB .VAL <LSH .CHR .OFF>>>>
 463           .STR>
 464         <SET VAL <ANDB .VAL <MIN>>>
 465         <COND (<0? .MOD> .VAL) (ELSE <+ <MOD .VAL .MOD> 1>)>>
 466
 467 <DEFINE T$LOOKUP (ARG1 ARG2 "AUX" BUCK)
 468         #DECL ((ARG1) STRING (ARG2) T$OBLIST (BUCK) <LIST [REST T$ATOM]>)
 469         <SET BUCK <NTH ,M$$OBLIST <I$HASH .ARG1 ,M$$SIZE>>>
 470         <MAPF <>
 471               <FUNCTION (ATM)
 472                    #DECL ((ATM) T$ATOM)
 473                    <COND (<AND <==? <M$$OBLS .ATM> .ARG2>
 474                                <=? <M$$PNAM .ATM>:STRING .ARG1>>
 475                           <MAPLEAVE .ATM>)>>
 476               .BUCK>>
 477
 478 <DEFINE T$INSERT (ARG1 ARG2 "AUX" ATM (OFF <I$HASH .ARG1 ,M$$SIZE>))
 479         #DECL ((ARG1) <OR T$ATOM STRING> (ARG2) T$OBLIST (OFF) FIX
 480                (ATM) T$ATOM)
 481         <SET ATM <CALL RECORD T$ATOM <> <> <STRING .ARG1> <> <>>>
 482         <PUT ,M$$OBLIST .OFF (.ATM !<NTH ,M$$OBLIST .OFF>)>
 483         <M$$OBLS .ATM .ARG2>>
 484
 485 <DEFINE T$SETG (ARG1 ARG2 "AUX" BIND)
 486         #DECL ((ARG1) T$ATOM (ARG2 VALUE) ANY (BIND) T$GBIND)
 487         <COND (<NOT <M$$GVAL .ARG1>>
 488                <M$$GVAL .ARG1 <CALL RECORD T$GBIND .ARG2 .ARG1 <>>>)>
 489         <M$$VALU <SET BIND <M$$GVAL .ARG1>> .ARG2>
 490         .ARG2>
 491
 492 <DEFINE T$GVAL (ARG "AUX" G)
 493         #DECL ((ARG) T$ATOM (G) <OR FALSE T$GBIND>)
 494         <COND (<SET G <M$$GVAL .ARG>>
 495                <M$$VALU .G>)>>
 496
 497 <DEFINE I$ATOM-INIT ("AUX" FOO)
 498         #DECL ((FOO) T$ATOM)
 499         <SETG M$$OBLIST <CALL GETS OBLIST>>
 500         <SETG M$$SIZE <LENGTH ,M$$OBLIST>>
 501         <SETG M$$INTERNAL <CHTYPE <T$ATOM "INTERNAL"> T$OBLIST>>
 502         <T$INSERT "INTERNAL" ,M$$INTERNAL>
 503         <SETG M$$ROOT <CHTYPE <SET FOO <T$INSERT "ROOT" ,M$$INTERNAL>>
 504                               T$OBLIST>>
 505         <M$$OBLS .FOO ,M$$ROOT>
 506         <SETG STOBLIST <CHTYPE <T$ATOM "STRINGS"> T$OBLIST>>
 507         <MAPF <>
 508               <FUNCTION (X)
 509                 <T$INSERT .X ,STOBLIST>>
 510               '["AUX" "NAME" "OPTIONAL" "OPT" "EXTRA" "QUOTE"
 511                 "BIND" "CALL" "ARGS" "TUPLE" "ACT" "DECL" "OWN"
 512                 "VALUE" "PRINT" "READ" "MUD" "DONE"]>
 513         <SETG EROBLIST <CHTYPE <T$INSERT "ERRORS" ,M$$ROOT> T$OBLIST>>
 514         <SETG IMSUBOB <CHTYPE <T$INSERT "IMSUBR" ,M$$ROOT> T$OBLIST>>
 515         <T$INSERT "STRINGS" ,M$$ROOT>
 516         <T$INSERT "QUOTE" ,M$$ROOT>
 517         <T$INSERT "LVAL" ,M$$ROOT>
 518         <T$INSERT "GVAL" ,M$$ROOT>>
 519
 520 \f
 521 <DEFINE T$PCODE (ID DBNAM "AUX" DBID (PURVEC ,I$PURVEC) CPC DBVEC)
 522   #DECL ((DBID ID) FIX (DBNAM) STRING (PURVEC) <LIST [REST T$PCODE]>
 523          (CPC) T$PCODE (DBVEC) VECTOR)
 524   <COND (<EMPTY? .PURVEC>
 525          <SET DBVEC [<> <> <> <> <>]>
 526          <SETG I$DBVEC .DBVEC>)
 527         (<SET DBVEC ,I$DBVEC>)>
 528   <REPEAT ((CT 1) (DBV .DBVEC) DB)
 529     #DECL ((CT) FIX (DBV) <VECTOR [REST <OR DB FALSE>]>
 530            (DB) <OR DB FALSE>)
 531     <COND (<AND <SET DB <1 .DBV>>
 532                 <=? <DB-NAME .DB>:STRING .DBNAM>>
 533            <SET DBID .CT>
 534            <RETURN>)
 535           (<NOT .DB>
 536            <SET DBID .CT>
 537            <1 .DBV [.DBNAM <>]>
 538            <RETURN>)>
 539     <SET CT <+ .CT 1>>
 540     <COND (<EMPTY? <SET DBV <REST .DBV>>>
 541            <T$ERROR>)>>
 542   <COND (<MAPF <>
 543              <FUNCTION (PV) #DECL ((PV) <OR T$PCODE UVECTOR>)
 544                <REPEAT ()
 545                  <COND (<AND <==? <M$$PC-ID .PV> .ID>
 546                              <==? <M$$PC-DB .PV> .DBID>>
 547                         <MAPLEAVE .PV>)>
 548                  <COND (<EMPTY? <SET PV <REST .PV ,M$$PC-ENTLEN>>>
 549                         <RETURN <>>)>
 550                  <SET PV <CHTYPE .PV T$PCODE>>>>
 551              .PURVEC>)
 552         (T
 553          <COND (<OR <EMPTY? .PURVEC>
 554                     <==? <LENGTH <SET CPC <1 .PURVEC>>> <* 20 ,M$$PC-ENTLEN>>>
 555                 <SET PURVEC (<SET CPC <CHTYPE <REST <IUVECTOR 100>
 556                                                     <* 19 ,M$$PC-ENTLEN>>
 557                                       T$PCODE>>
 558                              !.PURVEC)>
 559                 <SETG I$PURVEC .PURVEC>)>
 560          <COND (<NOT <0? <M$$PC-ID .CPC>>>
 561                 <SET CPC <CHTYPE <CALL BACKU .CPC ,M$$PC-ENTLEN> T$PCODE>>
 562                 <1 .PURVEC .CPC>)>
 563          <M$$PC-ID .CPC .ID>
 564          <M$$PC-DB .CPC .DBID>
 565          <M$$PC-DBLOC .CPC -1>
 566          <M$$PC-CORLOC .CPC 0>
 567          <M$$PC-LEN .CPC 0>
 568          .CPC)>>
 569 \f
 570 ;"Bootstrap routine"
 571 ; "Arg of 0 means use MBINs where possible.  Arg of 1 means use
 572    moby-glued stuff, MBINs where possible.  Arg of -1 means use
 573    only msubrs."
 574 <DEFINE BOOT ("OPTIONAL" (BT 0) "AUX" ICH OCH MI)
 575         #DECL ((BT) FIX (ICH OCH) VECTOR (MI) <UVECTOR [REST FIX]>)
 576         <SET MI <CALL GETS MINF>>
 577         <SETG QWSIZ <LSH <I$MINF-WDSIZE .MI> -2>>
 578         <SETG ZERO 0>
 579         <SETG BI$RADIX 10>
 580         <SETG INMCODE <>>
 581         <SETG I$FRC <>>
 582         <SETG I$POWERS
 583 [10.0 100.0 1000.0 10000.0 100000.0 1000000.0 10000000.0]>
 584         <SETG BREAKS "  \1a
 585 \f\r\e :">
 586         <SETG BRACKS "|:,[(<>)]\"">
 587         <SETG BI$NCHR <>>
 588         <SETG I$CONT <>>
 589         <SETG I$R? <>>
 590         <SETG BI$STR "">
 591         <SETG I$CHRSTR " ">
 592         <SETG M$$R-TAT <IVECTOR ,M$$TYPE-INFO-SIZE <>>>
 593         <SETG M$$R-TDT <IVECTOR ,M$$TYPE-INFO-SIZE <>>>
 594         <I$ATOM-INIT>
 595         <SETG I$PURVEC ()>
 596         <SETG I$DBVEC <>>
 597         <SET ICH [64 "" "" "" 79 0 24 0 10
 598 "////////////////////////////////////////
 599 ////////////////////////////////////////
 600 ////////////////////////////////////////
 601 ////////////////////////////////////////
 602 ////////////////////////////////////////
 603 //////////////////////////////////////////////" 0 0 0]>
 604         <SETG I$INCHAN .ICH>
 605         <SET OCH [65 "" "" "" 79 0 24 0 10
 606  "////////////////////////////////////////
 607 ////////////////////////////////////////
 608 ////////////////////////////////////////
 609 ////////////////////////////////////////
 610 ////////////////////////////////////////
 611 //////////////////////////////////////////////" 0 0 0]>
 612         <COND (<0? .BT>
 613                <T$FLOAD "APPLY.MBIN" "APPLY.MSUBR">
 614                <T$FLOAD "ARITH.MBIN" "ARITH.MSUBR">
 615                <T$FLOAD "ATOM.MBIN" "ATOM.MSUBR">
 616                <IFSYS ("UNIX" <T$FLOAD "BUFFERS.MBIN" "BUFFERS.MSUBR">)>
 617                <T$FLOAD "CHANNELS.MBIN" "CHANNELS.MSUBR">
 618                <T$FLOAD "DECL.MBIN" "DECL.MSUBR">
 619                <T$FLOAD "DEFAULT.MBIN" "DEFAULT.MSUBR">
 620                <T$FLOAD "DISK.MBIN" "DISK.MSUBR">
 621                <T$FLOAD "FRAME.MSUBR">
 622                <T$FLOAD "FS.MSUBR">
 623                <T$FLOAD "FSUBRS.MBIN" "FSUBRS.MSUBR">
 624                <T$FLOAD "IO-UTILS.MBIN" "IO-UTILS.MSUBR">
 625                <T$FLOAD "LOC.MBIN" "LOC.MSUBR">
 626                <T$FLOAD "MAPPUR.MSUBR">
 627                <T$FLOAD "PCK.MBIN" "PCK.MSUBR">
 628                <T$FLOAD "PMAP.MSUBR">
 629                <T$FLOAD "PRINT.MBIN" "PRINT.MSUBR">
 630                <T$FLOAD "REUSE.MBIN" "REUSE.MSUBR">
 631                <T$FLOAD "READ.MBIN" "READ.MSUBR">
 632                <T$FLOAD "STRUC.MBIN" "STRUC.MSUBR">
 633                <T$FLOAD "TYPE.MBIN" "TYPE.MSUBR">
 634                <T$FLOAD "TYPINI.MSUBR">
 635                <T$FLOAD "USER-IO.MBIN" "USER-IO.MSUBR">)
 636               (<1? .BT>
 637                <T$FLOAD "BIG.MBIN" "BIG.MSUBR">
 638                <T$FLOAD "BIGIO.MBIN" "BIGIO.MSUBR">
 639                <T$FLOAD "IO-UTILS.MBIN" "IO-UTILS.MSUBR">
 640                <T$FLOAD "USER-IO.MBIN" "USER-IO.MSUBR">
 641                <T$FLOAD "DEFAULT.MBIN" "DEFAULT.MSUBR">
 642                <T$FLOAD "FRAME.MSUBR">
 643                <T$FLOAD "FS.MSUBR">
 644                <T$FLOAD "MAPPUR.MSUBR">
 645                <T$FLOAD "PCK.MBIN" "PCK.MSUBR">
 646                <T$FLOAD "PMAP.MSUBR">
 647                <T$FLOAD "REUSE.MBIN" "REUSE.MSUBR">
 648                <T$FLOAD "TYPINI.MSUBR">)
 649               (<==? .BT -1>
 650                <T$FLOAD "APPLY.MSUBR">
 651                <T$FLOAD "ARITH.MSUBR">
 652                <T$FLOAD "ATOM.MSUBR">
 653                <IFSYS ("UNIX" <T$FLOAD "BUFFERS.MSUBR">)>
 654                <T$FLOAD "CHANNELS.MSUBR">
 655                <T$FLOAD "DECL.MSUBR">
 656                <T$FLOAD "DEFAULT.MSUBR">
 657                <T$FLOAD "DISK.MSUBR">
 658                <T$FLOAD "FRAME.MSUBR">
 659                <T$FLOAD "FS.MSUBR">
 660                <T$FLOAD "FSUBRS.MSUBR">
 661                <T$FLOAD "IO-UTILS.MSUBR">
 662                <T$FLOAD "LOC.MSUBR">
 663                <IFSYS ("TOPS20" <T$FLOAD "MAPPUR.MSUBR">)>
 664                <T$FLOAD "PCK.MSUBR">
 665                <T$FLOAD "PMAP.MSUBR">
 666                <T$FLOAD "PRINT.MSUBR">
 667                ;<T$FLOAD "REUSE.MSUBR">
 668                <T$FLOAD "READ.MSUBR">
 669                <T$FLOAD "STRUC.MSUBR">
 670                <T$FLOAD "TYPE.MSUBR">
 671                <T$FLOAD "TYPINI.MSUBR">
 672                <T$FLOAD "USER-IO.MSUBR">)>
 673         <CALL CALL
 674               <LOOKUP "I$INITIALIZE" ,M$$INTERNAL>
 675               .BT
 676               ,M$$ROOT
 677               ,M$$INTERNAL
 678               ,STOBLIST
 679               ,I$PURVEC
 680               ,I$DBVEC>>