mim/development/mim/20c/ask.mud

   1 <USE "JCL">
   2
   3 <DEFINE SAV ("OPTIONAL" (FN "<MIM>MIMOC20.EXE")
   4              "AUX" FIL FILLEN REC (DIR "") TCH
   5              (BUF <ISTRING 100>) JCL-STR REM-STR N1
   6              GM (NM2 "MUD") SNM (OUTCHAN .OUTCHAN)
   7              (AUTO-PREC <>) (THINGS (T)) (TTHINGS .THINGS) WDATE)
   8         #DECL ((SNM NM2) <SPECIAL STRING> (OUTCHAN) CHANNEL (BUF) STRING
   9                (FN) <OR STRING FALSE>)
  10         <SNAME "">
  11         <RESET .INCHAN>
  12         <SETG DO-LOOPS
  13               <SETG SURVIVOR-MODE <SET DOC <SETG GLUE-MODE <SETG INT-MODE <>>>>>>
  14         <COND (<AND .FN <=? <SAVE .FN> "SAVED">> T)
  15               (T
  16                <COND (<SET JCL-STR <READJCL>>
  17                       <COND (<SET REM-STR <MEMQ !\/ .JCL-STR>>
  18                              <SET JCL-STR <SUBSTRUC .JCL-STR 0
  19                                                     <- <LENGTH .JCL-STR>
  20                                                        <LENGTH .REM-STR>>>>)>
  21                       <SET FIL <LEX .JCL-STR <LENGTH .JCL-STR>>>
  22                       <SET NM2 "MIMA">
  23                       <COND (<SET TCH <OPEN "READ" <1 .FIL>>>
  24                              <SET N1 <CHANNEL-OP .TCH NM1>>
  25                              <CLOSE .TCH>)
  26                             (ELSE
  27                              <PRINT .TCH>
  28                              <QUIT>)>
  29                       <SET NM2 "MUD">
  30                       <SETG VERBOSE <>>
  31                       <COND (.REM-STR
  32                              <SET REM-STR <LPARSE <REST .REM-STR>>>
  33                              <MAPF <>
  34                                 <FUNCTION (TOKEN)
  35                                   <COND (<TYPE? .TOKEN ADECL>
  36                                          <COND (<OR <==? <1 .TOKEN> P>
  37                                                     <==? <1 .TOKEN> /P>>
  38                                                 <COND
  39                                                  (<TYPE? <2 .TOKEN> ATOM>
  40                                                   <SET TOKEN
  41                                                        <SPNAME <2 .TOKEN>>>)
  42                                                  (T
  43                                                   <SET TOKEN <2 .TOKEN>>)>
  44                                                 <SET PRECOMPILED
  45                                                      <STRING .TOKEN
  46                                                              ".MSUBR">>)>)
  47                                         (<TYPE? .TOKEN ATOM>
  48                                          <COND (<OR <==? .TOKEN G>
  49                                                     <==? .TOKEN /G>>
  50                                                 <SETG GLUE-MODE T>
  51                                                 <COND (,INT-MODE
  52                                                        <SETG SURVIVOR-MODE
  53                                                              T>)>)
  54                                                (<OR <==? .TOKEN I>
  55                                                     <==? .TOKEN /I>>
  56                                                 <SETG INT-MODE T>
  57                                                 <COND (,GLUE-MODE
  58                                                        <SETG SURVIVOR-MODE
  59                                                              T>)>)
  60                                                (<OR <==? .TOKEN D>
  61                                                     <==? .TOKEN /D>
  62                                                     <==? .TOKEN L>
  63                                                     <==? .TOKEN /L>>
  64                                                 <SET DOC T>)
  65                                                (<OR <==? .TOKEN V>
  66                                                     <==? .TOKEN /V>>
  67                                                 <SETG VERBOSE T>)
  68                                                (<OR <==? .TOKEN /SV>
  69                                                     <==? .TOKEN SV>>
  70                                                 <SETG SURVIVOR-MODE T>)
  71                                                (<OR <==? .TOKEN /DL>
  72                                                     <==? .TOKEN DL>>
  73                                                 <SETG DO-LOOPS T>)
  74                                                (<OR <==? .TOKEN /P>
  75                                                     <==? .TOKEN P>>
  76                                                 <SET PRECOMPILED
  77                                                      <STRING .N1
  78                                                              ".MSUBR">>)
  79                                                (<OR <==? .TOKEN /PA>
  80                                                     <==? .TOKEN PA>>
  81                                                 <SET PRECOMPILED
  82                                                      <STRING .N1
  83                                                              ".MSUBR">>
  84                                                 <SET AUTO-PREC T>)>)
  85                                         (ELSE
  86                                          <SET TTHINGS
  87                                               <REST
  88                                                <PUTREST .TTHINGS
  89                                                         (.TOKEN)>>>)>>
  90                                 .REM-STR>)>)
  91                      (ELSE
  92                       <PROG ()
  93                             <PRINC "File(s): ">
  94                             <SET FILLEN <READSTRING .BUF .INCHAN "\e">>
  95                             <SET FIL <LEX .BUF .FILLEN>>
  96                             <SET NM2 "MIMA">
  97                             <COND (<SET TCH <OPEN "READ" <1 .FIL>>>
  98                                    <SET N1 <CHANNEL-OP .TCH NM1>>
  99                                    <CLOSE .TCH>)
 100                                   (ELSE
 101                                    <PRINT .TCH>
 102                                    <RESET .INCHAN>
 103                                    <AGAIN>)>>
 104                       <SET NM2 "MUD">
 105                       <SETG VERBOSE <>>
 106                       <CRLF>
 107                       <PRINC "Doc: ">
 108                       <COND (<SET DOC <MEMQ <TYI> "YyTt ">>
 109                              <PRINC " [Listing]
 110 ">)
 111                             (T
 112                              <PRINC " [No Listing]
 113 ">)>
 114                       <COND (<=? .N1 "BOOT">
 115                              <PRINC " [Boot mode]">
 116                              <CRLF>
 117                              <SETG BOOT-MODE <SETG INT-MODE T>>)
 118                             (T
 119                              <PRINC "Interpreter: ">
 120                              <COND (<MEMQ <TYI> " YyTt">
 121                                     <PRINC " [Interpreter Code]">
 122                                     <SET EXPFLOAD T>
 123                                     <SETG INT-MODE T>)
 124                                    (T
 125                                     <SETG INT-MODE <>>
 126                                     <PRINC " [User Code]">)>
 127                              <COND (<=? .FIL "MSG"> <SETG GC-MODE T>)>
 128                              <SETG BOOT-MODE <>>
 129                              <CRLF>
 130                              <PRINC "Glue: ">
 131                              <COND (<MEMQ <TYI> " YyTt">
 132                                     <SET GM T>
 133                                     <COND (,INT-MODE <SETG SURVIVOR-MODE T>)>
 134                                     <PRINC " [Glue]">)
 135                                    (T
 136                                     <PRINC " [No Glue]">
 137                                     <SET GM <>>)>
 138                              <CRLF>
 139                              <PRINC "Verbose ">
 140                              <COND (<MEMQ <TYI> " YyTt">
 141                                     <SETG VERBOSE T>
 142                                     <PRINC " [Verbose]]">)
 143                                    (T
 144                                     <PRINC " [No Verbose]">
 145                                     <SETG VERBOSE <>>)>
 146                              <CRLF>
 147                              <PRINC "Things to do: ">
 148                              <REPEAT ()
 149                                      <COND (<==? <NEXTCHR> <ASCII *33*>>
 150                                             <CRLF>
 151                                             <RETURN>)>
 152                                      <SET TTHINGS <REST <PUTREST .TTHINGS
 153                                                                  (<READ>)>>>>
 154                              <SETG GLUE-MODE .GM>)>)>
 155                <COND (<AND <ASSIGNED? PRECOMPILED> .PRECOMPILED .AUTO-PREC
 156                            <SET TCH <OPEN "READ" .PRECOMPILED>>
 157                            <SET WDATE <CHANNEL-OP .TCH WRITE-DATE>>>
 158                       <CLOSE .TCH>
 159                       <SET NM2 "MIMA">
 160                       <COND (<SET TCH <OPEN "READ" .N1>>
 161                              <COND (<G? .WDATE <CHANNEL-OP .TCH WRITE-DATE>>
 162                                     <PRINC
 163                                      "Precompiled is more recent than source.">
 164                                     <CRLF>
 165                                     <EXIT>)>
 166                              <CLOSE .TCH>)>)>
 167                <SET PACKAGE-MODE .N1>
 168                <MAPF <> ,EVAL <REST .THINGS>>
 169                <SET NM2 "MIMA">
 170                <COND (.DOC
 171                       <DOC !.FIL>)
 172                      (,GLUE-MODE
 173                       <FILE-GLUE !.FIL>)
 174                      (T
 175                       <FILE-MIMOC !.FIL>)>
 176                <PRINC "
 177 Done.">
 178                <QUIT>)>>
 179
 180 <DEFINE LEX (BUF LEN)
 181   #DECL ((BUF) STRING (LEN) FIX)
 182   <SET BUF <SUBSTRUC .BUF 0 .LEN <REST .BUF <- <LENGTH .BUF> .LEN>>>>
 183   <REPEAT ((L ("")) CHR (LS <>))
 184     <COND (<EMPTY? .BUF>
 185            <COND (.LS
 186                   <PUTREST <REST .L <- <LENGTH .L> 1>> (<STRING .LS>)>)>
 187            <RETURN <REST .L>>)>
 188     <COND (<MEMQ <SET CHR <1 .BUF>> "   ,
 189 \e">
 190            <COND (.LS
 191                   <SET LS <SUBSTRUC .LS 0 <- <LENGTH .LS><LENGTH .BUF>>>>
 192                   <PUTREST <REST .L <- <LENGTH .L> 1>> (.LS)>
 193                   <SET LS <>>)>)
 194           (<NOT .LS>
 195            <SET LS .BUF>)>
 196     <SET BUF <REST .BUF>>>>