mim/development/mim/mimc/mimc.ask

   1 <USE "JCL" "TTY" "COMFIL" "ITIME" "CDRIVE" "HASH">
   2 <SETG BUFSTR <ISTRING 100>>
   3
   4 <DEFINE SAV ("OPT" (NAM "MIMC") "AUX" (S <SNAME>))
   5         <SNAME "">
   6         <COND (<=? <SAVE .NAM> "SAVED">
   7                <SNAME .S>
   8                T)
   9               (ELSE
  10                <START-MIMC>)>>
  11
  12 <DEFINE START-MIMC ("AUX" FIL FILLEN INFIL OUTFIL NM1 NM2 SNM RSNM TCH
  13                           (JCL-STR <>) REM-STR (JCL-VEC <>) REM-VEC A1 A2
  14                           (PREC <>) (CT <>) CHR (CARE T) (MF <>) (MC T) (REC T)
  15                           (KILL T) (AUTO-PREC <>) (STAT <>) WDATE REAL-NM2
  16                           (CPU <FIX <+ <TIME> 0.5>>) (REAL <QTIME <ITIME>>))
  17         #DECL ((NM1 NM2 SNM) <SPECIAL STRING>
  18                (REM-STR JCL-STR) <OR STRING FALSE>
  19                (JCL-VEC REM-VEC) <OR VECTOR FALSE>)
  20         <SET REDO ()>
  21         <SETG ERRORS-OCCURED <>>
  22         <IFSYS ("TOPS20" <SET JCL-STR <READJCL>>)
  23                ("UNIX" <SET JCL-VEC <READARGS>>)>
  24         <SET SNM <SNAME>>
  25         <COND (<OR .JCL-VEC .JCL-STR>
  26                <IFSYS
  27                 ("TOPS20"
  28                  <COND
  29                   (<SET REM-STR <OR <MEMQ !\/ .JCL-STR> <MEMQ !\< .JCL-STR>>>
  30                    <SET FIL <LEX <SUBSTRUC .JCL-STR 0 <- <LENGTH .JCL-STR>
  31                                                          <LENGTH .REM-STR>>>>>
  32                    <SET REM-STR <LPARSE <REST .REM-STR>>>
  33                    <MAPF <>
  34                      <FUNCTION (TOKEN)
  35                        <COND (<TYPE? .TOKEN ATOM>
  36                               <COND (<MEMQ .TOKEN '[C /C]>
  37                                      <SET CARE T>)
  38                                     (<MEMQ .TOKEN '[NC /NC]>
  39                                      <SET CARE <>>)
  40                                     (<MEMQ .TOKEN '[XM /XM]>
  41                                      <SETG EXPAND-FLAG T>)
  42                                     (<MEMQ .TOKEN '[NXM /NXM]>
  43                                      <SETG EXPAND-FLAG <>>)
  44                                     (<MEMQ .TOKEN '[R /R]>
  45                                      <SET REC T>)
  46                                     (<MEMQ .TOKEN '[NR /NR]>
  47                                      <SET REC <>>)
  48                                     (<MEMQ .TOKEN '[MF /MF]>
  49                                      <SET MF T>)
  50                                     (<MEMQ .TOKEN '[MC /MC]>
  51                                      <SET MC T>)
  52                                     (<MEMQ .TOKEN '[NMF /NMF]>
  53                                      <SET MF <>>)
  54                                     (<MEMQ .TOKEN '[NMC /NMC]>
  55                                      <SET MC <>>)
  56                                     (<MEMQ .TOKEN '[P /P]>
  57                                      <SET PREC T>)
  58                                     (<MEMQ .TOKEN '[PA /PA]>
  59                                      <SET PREC T>
  60                                      <SET AUTO-PREC T>)
  61                                     (<MEMQ .TOKEN '[SL /SL]>
  62                                      <SETG STATUS-LINE T>
  63                                      <UPDATE-STATUS "Start" "None" <> <> .CPU
  64                                                     .REAL>)
  65                                     (<MEMQ .TOKEN '[T /T]>
  66                                      <SET CT T>)
  67                                     (<MEMQ .TOKEN '[NK /NK]>
  68                                      <SET KILL <>>)
  69                                     (<==? .TOKEN />)
  70                                     (ELSE
  71                                      <ERROR BAD-TOKEN!-ERRORS .TOKEN .REM-STR>)>)
  72                              (<TYPE? .TOKEN ADECL>
  73                               <COND (<TYPE? <SET A2 <2 .TOKEN>> STRING>)
  74                                     (<TYPE? .A2 ATOM> <SET A2 <SPNAME .A2>>)>
  75                               <COND (<MEMQ <SET A1 <1 .TOKEN>> '[P /P PA /PA]>
  76                                      <COND (<NOT <TYPE? .A2 STRING>>
  77                                             <ERROR PRECOMPILE-NOT-STRING!-ERRORS
  78                                                    .TOKEN .REM-STR>)>
  79                                      <COND (<MEMQ .A1 '[PA /PA]>
  80                                             <SET AUTO-PREC T>)>
  81                                      <SET PREC .A2>)
  82                                     (<MEMQ .A1 '[T /T]>
  83                                      <COND (<NOT <TYPE? .A2 STRING>>
  84                                             <ERROR COMPILER-TYPE-NOT-STRING!-ERRORS
  85                                                    .TOKEN .REM-STR>)>
  86                                      <SET CT .A2>)
  87                                     (<MEMQ .A1 '[PM /PM]>
  88                                      <COND (<NOT <TYPE? .A2 STRING>>
  89                                             <ERROR PACKAGE-MODE-NOT-STRING!-ERRORS
  90                                                    .TOKEN .REM-STR>)>
  91                                      <SET PACKAGE-MODE .A2>)
  92                                     (<MEMQ .A1 '[RD /RD]>
  93                                      <COND (<OR <NOT <TYPE? .A2 LIST>>
  94                                                 <EMPTY? .A2>
  95                                                 <MAPF <>
  96                                                       <FUNCTION (X)
  97                                                            <COND
  98                                                             (<NOT <TYPE? .X ATOM>>
  99                                                              <MAPLEAVE T>)>>
 100                                                       .A2>>
 101                                             <ERROR REDO-LIST-MALFORMED!-ERRORS
 102                                                    .TOKEN .REM-STR>)
 103                                            (ELSE <SET REDO .A2>)>)
 104                                     (ELSE
 105                                      <ERROR BAD-TOKEN!-ERRORS .TOKEN .REM-STR>)>)
 106                              (ELSE
 107                               <EVAL .TOKEN>)>>
 108                      .REM-STR>)
 109                   (<SET FIL <LEX .JCL-STR <LENGTH .JCL-STR>>>)>
 110                  <SET FIL <1 .FIL>>)
 111                 ("UNIX"
 112                  <SET REM-VEC <>>
 113                  <MAPR <>
 114                    <FUNCTION (VV "AUX" (ST <1 .VV>))
 115                      #DECL ((VV) <VECTOR [REST STRING]>)
 116                      <COND (<AND <NOT <EMPTY? .ST>>
 117                                  <OR <==? <1 .ST> !\->
 118                                      <==? <1 .ST> !\<>>>
 119                             <COND (<==? <LENGTH .ST> 1>
 120                                    <SET REM-VEC <REST .VV>>)
 121                                   (ELSE <SET REM-VEC .VV>)>
 122                             <MAPLEAVE>)>>
 123                    .JCL-VEC>
 124                  <COND
 125                   (.REM-VEC
 126                    <SET FIL <SUBSTRUC .JCL-VEC 0
 127                                        <- <LENGTH .JCL-VEC>
 128                                           <LENGTH .REM-VEC>>>>
 129                    <MAPF <>
 130                      <FUNCTION (TOKEN)
 131                        <COND (<MEMBER .TOKEN '["C" "-C"]>
 132                               <SET CARE T>)
 133                              (<MEMBER .TOKEN '["NC" "-NC"]>
 134                               <SET CARE <>>)
 135                              (<MEMBER .TOKEN '["R" "-R"]>
 136                               <SET REC T>)
 137                              (<MEMBER .TOKEN '["NR" "-NR"]>
 138                               <SET REC <>>)
 139                              (<MEMBER .TOKEN '["MF" "-MF"]>
 140                               <SET MF T>)
 141                              (<MEMBER .TOKEN '["MC" "-MC"]>
 142                               <SET MC T>)
 143                              (<MEMBER .TOKEN '["NMF" "-NMF"]>
 144                               <SET MF <>>)
 145                              (<MEMBER .TOKEN '["NMC" "-NMC"]>
 146                               <SET MC <>>)
 147                              (<MEMBER .TOKEN '["P" "-P"]>
 148                               <SET PREC T>)
 149                              (<MEMBER .TOKEN '["PA" "-PA"]>
 150                               <SET PREC T>
 151                               <SET AUTO-PREC T>)
 152                              (<MEMBER .TOKEN '["SL" "-SL"]>
 153                               <SETG STATUS-LINE T>
 154                               <UPDATE-STATUS "Start" "None" <> <> .CPU
 155                                                     .REAL>)
 156                              (<MEMBER .TOKEN '["T" "-T"]>
 157                               <SET CT T>)
 158                              (<MEMBER .TOKEN '["NK" "-NK"]>
 159                               <SET KILL <>>)
 160                              (<OR <EMPTY? <SET TOKEN
 161                                                <CHTYPE <LPARSE .TOKEN> LIST>>>
 162                                   <TYPE? <1 .TOKEN> ATOM>>
 163                               <ERROR BAD-TOKEN!-ERRORS <1 .TOKEN> .REM-VEC>)
 164                              (<TYPE? <1 <CHTYPE .TOKEN LIST>> ADECL>
 165                               <SET TOKEN <1 <CHTYPE .TOKEN LIST>>>
 166                               <COND (<TYPE? <SET A2 <2 .TOKEN>> STRING>)
 167                                     (<TYPE? .A2 ATOM> <SET A2 <SPNAME .A2>>)>
 168                               <COND (<MEMQ <SET A1 <1 .TOKEN>> '[P -P
 169                                                                  PA -PA]>
 170                                      <COND (<NOT <TYPE? .A2 STRING>>
 171                                             <ERROR PRECOMPILE-NOT-STRING!-ERRORS
 172                                                    .TOKEN .REM-STR>)>
 173                                      <SET PREC .A2>
 174                                      <COND (<MEMQ .A1 '[PA -PA]>
 175                                             <SET AUTO-PREC T>)>)
 176                                     (<MEMQ .A1 '[T -T]>
 177                                      <COND (<NOT <TYPE? .A2 STRING>>
 178                                             <ERROR COMPILER-TYPE-NOT-STRING!-ERRORS
 179                                                    .TOKEN .REM-STR>)>
 180                                      <SET CT .A2>)
 181                                     (<MEMQ .A1 '[PM -PM]>
 182                                      <COND (<NOT <TYPE? .A2 STRING>>
 183                                             <ERROR PACKAGE-MODE-NOT-STRING!-ERRORS
 184                                                    .TOKEN .REM-STR>)>
 185                                      <SET PACKAGE-MODE .A2>)
 186                                     (<MEMQ .A1 '[RD -RD]>
 187                                      <COND (<OR <NOT <TYPE? .A2 LIST>>
 188                                                 <EMPTY? .A2>
 189                                                 <MAPF <>
 190                                                       <FUNCTION (X)
 191                                                            <COND
 192                                                             (<NOT <TYPE? .X ATOM>>
 193                                                              <MAPLEAVE T>)>>
 194                                                       .A2>>
 195                                             <ERROR REDO-LIST-MALFORMED!-ERRORS
 196                                                    .TOKEN .REM-STR>)
 197                                            (ELSE <SET REDO .A2>)>)
 198                                     (ELSE
 199                                      <ERROR BAD-TOKEN!-ERRORS .TOKEN .REM-STR>)>)
 200                              (ELSE
 201                               <EVAL .TOKEN>)>>
 202                      .REM-VEC>)
 203                   (<SET FIL .JCL-VEC>)>
 204                  <SET FIL <1 .FIL>>)>)
 205               (ELSE
 206                <PROG QL ((Q1 <>) (Q2 <>) (Q3 <>) (Q4 <>) (Q5 <>) (Q6 <>)
 207                          (READ-PROMPT <>) (READ-BREAKS <>))
 208                      <SET KILL T>
 209                      <COND (<NOT .Q1>
 210                             <SET READ-PROMPT "File: ">
 211                             <SET FILLEN <READSTRING ,BUFSTR .INCHAN "\e">>
 212                             <SET FIL <SUBSTRUC ,BUFSTR 0 <- .FILLEN 1>>>
 213                             <CRLF>
 214                             <SET Q1 T>)>
 215                      <SET READ-BREAKS <STRING <ASCII 2> <ASCII 27>>>
 216                      <COND (<NOT .Q2>
 217                             <COND (<==? <SET CHR <TYI-PROMPT "Record?: ">>
 218                                         <ASCII 2>>
 219                                    <SET Q1 <>>
 220                                    <CRLF>
 221                                    <AGAIN>)>
 222                             <SET Q2 T>
 223                             <SET REC <MEMQ .CHR "Yy Tt">>
 224                             <CRLF>)>
 225                      <COND (<NOT .Q3>
 226                             <COND (<==? <SET CHR <TYI-PROMPT "Precompilation?: ">>
 227                                         <ASCII 2>>
 228                                    <SET Q2 <>>
 229                                    <CRLF>
 230                                    <AGAIN>)>
 231                             <SET Q3 T>
 232                             <SET PREC <COND (<MEMQ .CHR "Yy Tt"> T)>>
 233                             <COND (<==? .CHR !\ >
 234                                    <SET READ-PROMPT "(file) ">
 235                                    <COND (<==? <SET CHR <NEXTCHR>>
 236                                                <ASCII 2>>
 237                                           <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 238                                           <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 239                                           <READCHR>
 240                                           <SET Q2 <SET Q3 <>>>
 241                                           <CRLF>
 242                                           <AGAIN>)>
 243                                    <SET FILLEN
 244                                         <READSTRING ,BUFSTR .INCHAN "\e">>
 245                                    <SET PREC <SUBSTRUC ,BUFSTR 0 <- .FILLEN 1>>>)>
 246                             <CRLF>)>
 247                      <COND (<AND <N==? .CHR !\\e> <NOT .Q4>>
 248                             <COND (<==? <SET CHR <TYI-PROMPT  "Careful?: ">>
 249                                         <ASCII 2>>
 250                                    <SET Q3 <>>
 251                                    <CRLF>
 252                                    <AGAIN>)>
 253                             <SET CARE <MEMQ .CHR "Yy Tt">>
 254                             <SET Q4 T>
 255                             <CRLF>)>
 256                       <COND (<AND <N==? .CHR !\\e> <NOT .Q5>>
 257                              <COND (<==? <SET CHR <TYI-PROMPT "Flush macros? ">>
 258                                          <ASCII 2>>
 259                                    <SET Q4 <>>
 260                                    <CRLF>
 261                                    <AGAIN>)>
 262                              <SET MF <MEMQ .CHR "Yy Tt">>
 263                              <CRLF>
 264                              <SET Q5 T>)>
 265                       <COND (<AND <N=? .CHR !\\e> <NOT .Q6>>
 266                              <COND (<==? <SET CHR <TYI-PROMPT "Compile macros? ">>
 267                                          <ASCII 2>>
 268                                    <SET Q5 <>>
 269                                    <CRLF>
 270                                    <AGAIN>)>
 271                              <SET MC <MEMQ .CHR "Yy tT">>
 272                              <SET Q6 T>
 273                              <CRLF>)>
 274                       <SET READ-PROMPT "Things to do: ">
 275                       <SET READ-BREAKS <STRING <ASCII 2> <ASCII 27>
 276                                                                !\?>>
 277                       <COND (<==? <SET CHR <NEXTCHR>>
 278                                   <ASCII 2>>
 279                              <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 280                              <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 281                              <COND (.Q6 <SET Q6 <>>)
 282                                    (.Q5 <SET Q5 <>>)
 283                                    (.Q4 <SET Q4 <>>)
 284                                    (.Q3 <SET Q3 <>>)
 285                                    (.Q2 <SET Q2 <>>)>
 286                              <READCHR>
 287                              <CRLF>
 288                              <AGAIN>)>
 289                       <COND (<==? .CHR !\?>
 290                              <READCHR>
 291                              <CRLF>
 292                              <COND (<==? <SET CHR <TYI-PROMPT "Save? ">> <ASCII 2>>
 293                                     <COND (.Q6 <SET Q6 <>>)
 294                                           (.Q5 <SET Q5 <>>)
 295                                           (.Q4 <SET Q4 <>>)
 296                                           (.Q3 <SET Q3 <>>)
 297                                           (.Q2 <SET Q2 <>>)>
 298                                     <CRLF>
 299                                     <AGAIN>)>
 300                              <COND (<MEMQ .CHR "Tt yY">
 301                                     <ERROR NOT-IMPLEMENTED!-ERRORS>
 302                                     <READCHR>)>
 303                              <CRLF>
 304                              <COND (.PREC
 305                                     <SET READ-PROMPT "Redo list? ">
 306                                     <SET READ-BREAKS
 307                                          <STRING <ASCII 2> <ASCII 27>
 308                                                  <ASCII 127> <ASCII 13>>>
 309                                     <COND (<==? <SET CHR <NEXTCHR>>
 310                                                 <ASCII 2>>
 311                                            <READCHR>
 312                                            <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 313                                            <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 314                                            <COND (.Q6 <SET Q6 <>>)
 315                                                  (.Q5 <SET Q5 <>>)
 316                                                  (.Q4 <SET Q4 <>>)
 317                                                  (.Q3 <SET Q3 <>>)
 318                                                  (.Q2 <SET Q2 <>>)>
 319                                            <CRLF>
 320                                            <AGAIN>)>
 321                                     <COND (<AND <N==? .CHR <ASCII 27>>
 322                                                 <N==? .CHR <ASCII 127>>
 323                                                 <N==? .CHR <ASCII 13>>>
 324                                            <REPEAT ()
 325                                                    <COND (<TYPE?
 326                                                            <SET REDO <READ>>
 327                                                            LIST>
 328                                                           <RETURN>)>
 329                                                    <CRLF>
 330                                                    <SET READ-PROMPT
 331                                                       "Must enter a list: ">>)
 332                                           (ELSE <READCHR>)>
 333                                     <CRLF>
 334                                     <SET READ-PROMPT  "Package mode: ">
 335                                     <COND (<==? <SET CHR <NEXTCHR>> <ASCII 2>>
 336                                            <READCHR>
 337                                            <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 338                                            <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 339                                            <COND (.Q6 <SET Q6 <>>)
 340                                                  (.Q5 <SET Q5 <>>)
 341                                                  (.Q4 <SET Q4 <>>)
 342                                                  (.Q3 <SET Q3 <>>)
 343                                                  (.Q2 <SET Q2 <>>)>
 344                                            <CRLF>
 345                                            <AGAIN>)>
 346                                     <COND (<AND <N==? .CHR <ASCII 27>>
 347                                                 <N==? .CHR <ASCII 127>>
 348                                                 <N==? .CHR <ASCII 13>>>
 349                                            <SET FILLEN
 350                                                 <READSTRING ,BUFSTR .INCHAN "\e">>
 351                                            <SET PACKAGE-MODE
 352                                                 <SUBSTRUC ,BUFSTR 0
 353                                                           <- .FILLEN 1>>>)
 354                                           (ELSE <READCHR>)>
 355                                     <CRLF>)>
 356                              <SET READ-PROMPT  "Things to do: ">
 357                              <COND (<==? <SET CHR <NEXTCHR>> <ASCII 2>>
 358                                     <READCHR>
 359                                     <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 360                                     <CHANNEL-OP ,OUTCHAN ERASE-CHAR>
 361                                     <COND (.Q6 <SET Q6 <>>)
 362                                           (.Q5 <SET Q5 <>>)
 363                                           (.Q4 <SET Q4 <>>)
 364                                           (.Q3 <SET Q3 <>>)
 365                                           (.Q2 <SET Q2 <>>)>
 366                                     <CRLF>
 367                                     <AGAIN>)>)>
 368                       <REPEAT ()
 369                        <COND (<==? <SET CHR <NEXTCHR>> <ASCII *33*>>
 370                               <READCHR>
 371                               <CRLF>
 372                               <SET READ-PROMPT <>>
 373                               <SET READ-BREAKS <>>
 374                               <RETURN T>)
 375                              (<==? .CHR <ASCII 2>> <READCHR> <AGAIN .QL>)>
 376                        <EVAL <READ>>>>)>
 377         <COND (<==? .FIL "BOOT">
 378                <SET INDIR <SET OUTDIR "<MIM.BOOT>">>)>
 379         <SET NM2 "MUD">
 380         ; "Allow compilation of .ZIL files"
 381         <PROG ((NMVEC:VECTOR '["ZIL"]) (OTCH T))
 382           <COND (<SET TCH <OPEN "READ" .FIL>>
 383                  <SET NM1 <CHANNEL-OP .TCH NM1>>
 384                  <SET NM2 <SET REAL-NM2 <CHANNEL-OP .TCH NM2>>>
 385                  <COND (<NOT <ASSIGNED? PACKAGE-MODE>>
 386                         <SET PACKAGE-MODE .NM1>)>
 387                  <COND (.AUTO-PREC
 388                         <SET WDATE <CHANNEL-OP .TCH WRITE-DATE>>)>
 389                  <CLOSE .TCH>)
 390                 (T
 391                  <COND (.OTCH <SET OTCH .TCH>)>
 392                  <COND (<EMPTY? .NMVEC>
 393                         <ERROR FILE-NOT-FOUND!-ERRORS .TCH>)
 394                        (T
 395                         <SET NM2 <1 .NMVEC>>
 396                         <SET NMVEC <REST .NMVEC>>
 397                         <AGAIN>)>)>>
 398         <COND (<==? .PREC T>
 399                <SET PRECOMPILED <STRING .FIL ".MIMA">>
 400                <COND (<NOT <FILE-EXISTS? .PRECOMPILED>> <SET PRECOMPILED <>>)>)
 401               (.PREC <SET PRECOMPILED .PREC>)>
 402         <COND (<AND .PREC .AUTO-PREC <SET TCH <OPEN "READ" .PRECOMPILED>>>
 403                <COND (<G? <CHANNEL-OP .TCH WRITE-DATE> .WDATE>
 404                       <PRINC "Precompiled is more recent than source.">
 405                       <CRLF>
 406                       <EXIT>)>
 407                <CLOSE .TCH>)>
 408         <SET CAREFUL!-COMPDEC!-PACKAGE .CARE>
 409         <SET MACRO-FLUSH .MF>
 410         <SET MACRO-COMPILE .MC>
 411         <SET RSNM <SNAME>>
 412         <SET INFIL .FIL>
 413         <COND (.REC
 414                <PROG ((SNM .RSNM) (NM2 "RECORD")
 415                       (OUTCHAN <OPEN "PRINT" "">))
 416                      #DECL ((SNM NM2) <SPECIAL STRING>
 417                             (OUTCHAN) <SPECIAL CHANNEL>)
 418                      <FILE-COMPILE .INFIL "" .REAL-NM2>
 419                      <CLOSE .OUTCHAN>>)
 420               (T <FILE-COMPILE .INFIL "" .REAL-NM2>)>
 421         <COND (,ERRORS-OCCURED
 422                <PRINC "Warning:  Compiler errors occured!" ,DEBUG-CHANNEL>
 423                <CRLF ,DEBUG-CHANNEL>)>
 424         <COND (.KILL <EXIT <COND (,ERRORS-OCCURED 1) (ELSE 0)>>) (ELSE <QUIT>)>>
 425
 426 <DEFINE LEX (BUF "OPTIONAL" (LEN <LENGTH .BUF>))
 427   #DECL ((BUF) STRING (LEN) FIX)
 428   <SET BUF <SUBSTRUC .BUF 0 .LEN <REST .BUF <- <LENGTH .BUF> .LEN>>>>
 429   <REPEAT ((L ("")) CHR (LS <>))
 430     <COND (<EMPTY? .BUF>
 431            <COND (.LS
 432                   <PUTREST <REST .L <- <LENGTH .L> 1>> (<STRING .LS>)>)>
 433            <RETURN <REST .L>>)>
 434     <COND (<MEMQ <SET CHR <1 .BUF>> "   ,
 435 \e">
 436            <COND (.LS
 437                   <SET LS <SUBSTRUC .LS 0 <- <LENGTH .LS><LENGTH .BUF>>>>
 438                   <PUTREST <REST .L <- <LENGTH .L> 1>> (.LS)>
 439                   <SET LS <>>)>)
 440           (<NOT .LS>
 441            <SET LS .BUF>)>
 442     <SET BUF <REST .BUF>>>>
 443
 444 <DEFINE TYI-PROMPT (P "AUX" (CH .INCHAN) CHR)
 445         <PRINC .P>
 446         <CHANNEL-OP .CH SET-ECHO-MODE <>>
 447         <PROG ()
 448               <COND (<==? <SET CHR <TYI>> !\\12>
 449                      <CHANNEL-OP .CH HOR-POS-CURSOR 0>
 450                      <CHANNEL-OP .CH FRESH-LINE>
 451                      <PRINC .P>
 452                      <AGAIN>)
 453                     (<==? .CHR !\\f>
 454                      <CHANNEL-OP .CH CLEAR-SCREEN>
 455                      <PRINC .P>
 456                      <AGAIN>)
 457                     (<N==? <ASCII .CHR> 2>
 458                      <PRINC .CHR>)>
 459               <CHANNEL-OP .CH SET-ECHO-MODE T>>
 460         .CHR>
 461