mim/development/mim/vaxc/ask.mud

   1 <USE "JCL">
   2
   3 <DEFINE SAV ()
   4         <GC-MON <>>
   5         <RESET .INCHAN>
   6         <SNAME "">
   7         <COND (<=? <SAVE "MV"> "SAVED"> T)
   8               (<RUN-QUESTIONS>)>>
   9
  10 <SETG BUFSTRING <ISTRING 200>>
  11
  12 <DEFINE RQ ("OPT" (NOJCL? <>))
  13   <PROG ()
  14     <RESET ,INCHAN>
  15     <RUN-QUESTIONS .NOJCL?>>>
  16
  17 <DEFINE RUN-QUESTIONS ("OPT" (NOJCL? <>) "AUX" FIL FILLEN REC (BUF ,BUFSTRING) CH
  18                        (JCL-STR <>) REM-STR (JCL-VEC <>) REM-VEC
  19                        (QUICK? <>) (UN <UNAME>) (ANY-JCL? <>))
  20   #DECL ((REM-STR JCL-STR) <OR STRING FALSE>
  21          (JCL-VEC REM-VEC) <OR VECTOR FALSE> (FIL) LIST)
  22   <PROG ()
  23    <IFSYS ("TOPS20" <COND (.NOJCL? <SET JCL-STR <>>)
  24                           (T <SET JCL-STR <READJCL>>)>)
  25           ("VAX" <COND (.NOJCL? <SET JCL-VEC <>>)
  26                        (T <SET JCL-VEC <READARGS>>)>)>
  27    <COND (<NOT .QUICK?>
  28           <UNASSIGN PRECOMPILED>
  29           <UNASSIGN AUTO-PRECOMP>
  30           <UNASSIGN REDO>)>
  31    <COND (<OR .JCL-VEC .JCL-STR>
  32           <SET NOJCL? T>
  33           <SET QUICK? T>
  34           <SETG VERBOSE? <>>
  35           <SET DOC <>>
  36           <SETG GLUE <>>
  37           <SETG BOOT-MODE <>>
  38           <SETG INT-MODE <>>
  39           <SETG GC-MODE <>>
  40           <IFSYS ("TOPS20"
  41                   <COND
  42                    (<SET REM-STR <MEMQ !\/ .JCL-STR>>
  43                     <SET FIL <LEX <SUBSTRUC .JCL-STR 0 <- <LENGTH .JCL-STR>
  44                                                           <LENGTH .REM-STR>>>>>
  45                     <SET REM-STR <LPARSE <REST .REM-STR>>>
  46                     <MAPF <>
  47                           <FUNCTION (TOKEN)
  48                                     <COND (<TYPE? .TOKEN ATOM>
  49                                            <COND (<MEMQ .TOKEN '[L /L D /D]>
  50                                                   <SET ANY-JCL? T>
  51                                                   <SET DOC T>)
  52                                                  (<MEMQ .TOKEN '[V /V]>
  53                                                   <SETG VERBOSE? T>)
  54                                                  (<MEMQ .TOKEN '[G /G]>
  55                                                   <SET ANY-JCL? T>
  56                                                   <SETG GLUE T>)
  57                                                  (<MEMQ .TOKEN '[GC /GC]>
  58                                                   <SET ANY-JCL? T>
  59                                                   <SETG GC-MODE T>)
  60                                                  (<MEMQ .TOKEN '[I /I]>
  61                                                   <SET ANY-JCL? T>
  62                                                   <SETG INT-MODE T>)
  63                                                  (<MEMQ .TOKEN '[P /P]>
  64                                                   <SET PRECOMPILED T>)
  65                                                  (<MEMQ .TOKEN '[PA /PA]>
  66                                                   <SET PRECOMPILED T>
  67                                                   <SET AUTO-PRECOMP T>)>)
  68                                           (<TYPE? .TOKEN ADECL>
  69                                            <COND (<MEMQ <1 .TOKEN> '[P /P
  70                                                                      PA /PA]>
  71                                                   <SET PRECOMPILED
  72                                                        <2 .TOKEN>>
  73                                                   <COND (<MEMQ <1 .TOKEN>
  74                                                                '[PA /PA]>
  75                                                          <SET AUTO-PRECOMP
  76                                                               T>)>)>)
  77                                           (T
  78                                            <EVAL .TOKEN>)>>
  79                           .REM-STR>)
  80                    (<SET FIL <LEX .JCL-STR <LENGTH .JCL-STR>>>)>)
  81                  ("VAX"
  82                   <SET REM-VEC <>>
  83                   <MAPR <>
  84                         <FUNCTION (VV "AUX" (ST <1 .VV>))
  85                                   #DECL ((VV) <VECTOR [REST STRING]>)
  86                                   <COND (<AND <NOT <EMPTY? .ST>>
  87                                               <==? <1 .ST> !\->>
  88                                          <SET REM-VEC .VV>
  89                                          <MAPLEAVE>)>>
  90                         .JCL-VEC>
  91                   <COND
  92                    (.REM-VEC
  93                     <SET FIL <ILIST <- <LENGTH .JCL-VEC>
  94                                        <LENGTH .REM-VEC>>>>
  95                     <MAPR <>
  96                           <FUNCTION (X Y)
  97                                     <1 .X <1 .Y>>>
  98                           .FIL .JCL-VEC>
  99                     <MAPF <>
 100                           <FUNCTION (TOKEN)
 101                                     <COND (<MEMBER .TOKEN '["L" "-L" "D" "-D"]>
 102                                            <SET ANY-JCL? T>
 103                                            <SET DOC T>)
 104                                           (<MEMBER .TOKEN '["V" "-V"]>
 105                                            <SETG VERBOSE? T>)
 106                                           (<MEMBER .TOKEN '["G" "-G"]>
 107                                            <SET ANY-JCL? T>
 108                                            <SETG GLUE T>)
 109                                           (<MEMBER .TOKEN '["GC" "-GC"]>
 110                                            <SET ANY-JCL? T>
 111                                            <SETG GC-MODE T>)
 112                                           (<MEMBER .TOKEN '["I" "-I"]>
 113                                            <SET ANY-JCL? T>
 114                                            <SETG INT-MODE T>)
 115                                           (<MEMBER .TOKEN '["P" "-P"]>
 116                                            <SET PRECOMPILED T>)
 117                                           (<MEMBER .TOKEN '["PA" "-PA"]>
 118                                            <SET PRECOMPILED T>
 119                                            <SET AUTO-PRECOMP T>)
 120                                           (T
 121                                            <MAPF <>
 122                                              <FUNCTION (X)
 123                                                <COND (<AND <TYPE? .X ADECL>
 124                                                            <MEMQ <1 .X>
 125                                                                  '[P -P
 126                                                                    PA -PA]>>
 127                                                       <COND
 128                                                        (<TYPE?
 129                                                          <SET PRECOMPILED
 130                                                               <2 .X>> ATOM>
 131                                                         <COND
 132                                                          (<MEMQ <1 .X>
 133                                                                 '[PA -PA]>
 134                                                           <SET AUTO-PRECOMP
 135                                                                T>)>
 136                                                         <SET PRECOMPILED
 137                                                              <SPNAME
 138                                                               .PRECOMPILED>>)>)
 139                                                      (T
 140                                                       <EVAL .X>)>>
 141                                              <LPARSE .TOKEN>>)>>
 142                           .REM-VEC>)
 143                    (<SET FIL (!.JCL-VEC)>)>)>
 144           <COND (<NOT .ANY-JCL?>
 145                  <SET QUICK? <>>)>
 146           <COND (<EMPTY? .FIL>
 147                  <AGAIN>)
 148                 (<=? <1 .FIL> "BOOT">
 149                  <SETG BOOT-MODE T>
 150                  <SETG INT-MODE T>
 151                  <SETG GC-MODE <>>)>
 152           <COND (,INT-MODE
 153                  <SET EXPFLOAD T>)>)
 154          (T
 155           <SETG VERBOSE? <>>
 156           <PRINC "File(s): ">
 157           <SET FILLEN <READSTRING .BUF .INCHAN "\e">>
 158           <SET FIL <LEX .BUF .FILLEN>>
 159           <CRLF>
 160           <COND (<EMPTY? .FIL>
 161                  <LEAVE-MIMOC .UN>
 162                  <AGAIN>)>
 163           <COND
 164            (<NOT .QUICK?>
 165             <PRINC "Doc: ">
 166             <COND (<SET DOC <MEMQ <TYI> "YyTt ">> <PRINC " [Listing]"> <CRLF>)
 167                   (T <PRINC " [No Listing]"> <CRLF>)>)>
 168           <COND (<N=? <1 .FIL> "BOOT">
 169                  <SETG BOOT-MODE <>>
 170                  <COND
 171                   (<NOT .QUICK?>
 172                    <PRINC "Interpreter: ">
 173                    <COND (<MEMQ <TYI> " YyTt">
 174                           <PRINC " [Interpreter Code]">
 175                           <SET EXPFLOAD T>
 176                           <SETG INT-MODE T>)
 177                          (T <SETG INT-MODE <>> <PRINC " [User Code]">)>
 178                    <CRLF>
 179                    <PRINC "GC: ">
 180                    <COND (<MEMQ <TYI> " YyTt">
 181                           <PRINC " [GC Code]">
 182                           <SETG GC-MODE T>)
 183                          (T <SETG GC-MODE <>> <PRINC " [Non-GC Code]">)>
 184                    <CRLF>)>)
 185                 (ELSE
 186                  <PRINC " [Boot mode]">
 187                  <CRLF>
 188                  <SETG BOOT-MODE <SETG INT-MODE T>>
 189                  <SETG GC-MODE <>>)>
 190           <COND (<AND <NOT .QUICK?> <NOT ,BOOT-MODE>>
 191                  <PRINC "Glue: ">
 192                  <COND (<MEMQ <TYI> " YyTt"> <SETG GLUE T> <PRINC " [Glue]">)
 193                        (T <PRINC " [No Glue]"> <SETG GLUE <>>)>
 194                  <CRLF>)>
 195           <COND (<AND <NOT .QUICK?> <NOT ,INT-MODE>>
 196                  <PRINC "Things to do: ">
 197                  <REPEAT ()
 198                          <COND (<==? <NEXTCHR> <ASCII 27>> <CRLF> <RETURN>)>
 199                          <EVAL <READ>>>)>)>
 200    <COND (<SET CH <CHANNEL-OPEN PARSE <1 .FIL>>>
 201           <FILE-MIMOC <CHANNEL-OP .CH NM1> <> <> .DOC !.FIL>
 202           <CHANNEL-CLOSE .CH>
 203           <CRLF>
 204           <PRINC "Done">
 205           <LEAVE-MIMOC .UN>)
 206          (T
 207           <SET CH <SYS-ERR <1 .FIL> .CH T>>
 208           <PRINT-MANY .OUTCHAN PRINC "Can't find name of output file:  "
 209                  <1 .CH> "--" <2 .CH>>
 210           <CRLF>
 211           <SET QUICK? T>
 212           <SET NOJCL? T>
 213           <AGAIN>)>
 214    <SET NOJCL? T>
 215    <AGAIN>>>
 216
 217 <DEFINE LEAVE-MIMOC (UN)
 218   #DECL ((UN) STRING)
 219   <COND (<=? .UN "TAA"> <QUIT>)
 220         (T <EXIT>)>>
 221
 222 <DEFINE LEX (BUF "OPTIONAL" (LEN <LENGTH .BUF>))
 223   #DECL ((BUF) STRING (LEN) FIX)
 224   <SET BUF <SUBSTRUC .BUF 0 .LEN <REST .BUF <- <LENGTH .BUF> .LEN>>>>
 225   <REPEAT ((L ("")) CHR (LS <>))
 226     <COND (<EMPTY? .BUF>
 227            <COND (.LS
 228                   <PUTREST <REST .L <- <LENGTH .L> 1>> (<STRING .LS>)>)>
 229            <RETURN <REST .L>>)>
 230     <COND (<MEMQ <SET CHR <1 .BUF>> "   ,
 231 \e">
 232            <COND (.LS
 233                   <SET LS <SUBSTRUC .LS 0 <- <LENGTH .LS><LENGTH .BUF>>>>
 234                   <PUTREST <REST .L <- <LENGTH .L> 1>> (.LS)>
 235                   <SET LS <>>)>)
 236           (<NOT .LS>
 237            <SET LS .BUF>)>
 238     <SET BUF <REST .BUF>>>>