home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / zz.seq < prev   
Text File  |  1990-07-24  |  10KB  |  259 lines
  1. \\ ZZ.SEQ                Mini Shell                      Tom Zimmer
  2.  
  3.   A very small program that just processes commands from the file
  4. ZZ.CFG which contains programs and parameters passed between shelled
  5. programs.
  6.  
  7.   Compile as follows:   TCOM ZZ /OPT /NOINIT enter
  8.  
  9. {
  10.  
  11. \ ***************************************************************************
  12. \ the next few lines define immediate words that allow definitions to
  13. \ select what will be compiled from source lines for either F-PC or TCOM.
  14.  
  15. DEFINED TARGET-INIT NIP 0= #IF  \ Test for NOT target compiling
  16.  
  17. ' noop alias \F immediate       \ create \F as a NOOP while in F-PC
  18. ' \    alias \T immediate       \ create \T as "\" while in F-PC
  19.  
  20. only forth also definitions hidden also
  21.  
  22. : DS:ALLOC      ( n1 -- a1 )    \ allocate n1 bytes of ram at runtime,
  23.                                 \ returning a1 the address of the ram
  24.                 HERE SWAP ALLOT ;
  25.  
  26. : SET_MEMORY    drop ;
  27. : DOS_TO_TIB         ;  immediate
  28. : COMSPEC_INIT       ;  immediate
  29.  
  30. : +PLACE        DUP>R COUNT + SWAP DUP>R CMOVE R> R> C+! ;
  31.  
  32. #ELSE
  33.  
  34. ' \    alias \F immediate       \ create \F as "\" while TCOMing
  35. ' noop alias \T immediate       \ create \T as a NOOP while TCOMing
  36.  
  37. #ENDIF
  38.  
  39. CHECK_/NOINIT
  40.  
  41. \ ***************************************************************************
  42. \ now start the Mini Shell program
  43.  
  44. handle mshndl
  45.  
  46.  256 constant cmd_max
  47.  64  constant cmd_item
  48. 4096 constant cfg_max
  49.   50 constant cfg_max_lines
  50.    0    value cfg_len
  51.    0    value cfg_#lines
  52.    0    value cfg_buf
  53.    0    value cmd_buf
  54.    0    value cmx_buf
  55.    0    value nam_buf
  56.    0    value na2_buf
  57.    0    value cfg_row
  58.    0    value cfg_col
  59.  
  60. cfg_max_lines 2* array cfg_lines
  61.  
  62. \ ***************************************************************************
  63. \ When the editor returns, it "may", place a command in the file ZZ.CMD to
  64. \ pass back to Mini-Shell. If MS gets a command, it will try to process
  65. \ it. If no command is received, then it will quit.
  66.  
  67. : cmd_set       ( -- )
  68.                 " ZZ.CMD" ">$ mshndl $>handle ;
  69.  
  70. : read_item     ( a1 -- )
  71.                 bl word count cmd_item min rot place ;
  72.  
  73. : read_cmd      ( -- n1 )               \ read the command byte
  74.                 cmd_set
  75.                 mshndl hopen
  76.                 if      0       exit
  77.                 then
  78.                 pad 'tib !      \ make sure there is room for 256 bytes
  79.                 tib cmd_max mshndl hread #tib ! >in off
  80.                 bl word c@
  81.                 if      here 1+ c@
  82.                         nam_buf read_item
  83.                         cfg_row read_item
  84.                         cfg_col read_item
  85.                         na2_buf read_item
  86.                 else    0
  87.                         nam_buf off
  88.                         na2_buf off
  89.                         cfg_row off
  90.                         cfg_col off
  91.                 then    mshndl hclose drop
  92.                 sp0 @ 2+ 'tib ! ;
  93.  
  94. : del_cmd       ( -- )                  \ delete the command byte file
  95.                 cmd_set
  96.                 mshndl hdelete drop ;
  97.  
  98. \ ***************************************************************************
  99. \ read the configuration file into memory
  100.  
  101. : no_cfg        ( -- )
  102.                 ." Cannot find ZZ.CFG, creating.."
  103.                 mshndl hcreate
  104.                 if      cr ." Can't create ZZ.CFG, quitting."
  105.                         bye
  106.                 else    " NEWZ %1 %2 %3 /cmd||" mshndl hwrite drop
  107.                                      2573 sp@ 2 mshndl hwrite 2drop
  108.                                                 mshndl hclose drop
  109.                                                 mshndl hopen drop
  110.                 then    ;
  111.  
  112. : read_cfg      ( -- )                  \ read the configuration file
  113.                 " ZZ.CFG" ">$ mshndl $>handle
  114.                 mshndl hopen if no_cfg then
  115.                 cfg_buf cfg_max mshndl hread =: cfg_len
  116.                 mshndl hclose drop
  117.                 cfg_len 0=
  118.                 if      cr ." ZZ.CFG has invalid length=0, quitting"
  119.                         bye
  120.                 then    ;
  121.  
  122. : cfg_next_lf   ( a1 -- a2 f1 )         \ find next LF in CFG file
  123.                 begin   1+ dup c@ $0A =                 \ an LF
  124.                         over cfg_buf cfg_len + u>= or   \ or buf end
  125.                 until   dup cfg_buf cfg_len + u>= ;
  126.  
  127. : cfg_lcalc     ( -- )                  \ calculate the line starts
  128.                 off> cfg_#lines
  129.                 cfg_buf
  130.                 cfg_max_lines 2 - 0
  131.                 do      dup cfg_lines i 2* + !
  132.                         cfg_next_lf ?leave 1+
  133.                         incr> cfg_#lines
  134.                 loop    drop ;
  135.  
  136. : >cmd_buf      ( c1 -- )
  137.                 cmd_buf count + c! cmd_buf incr ;
  138.  
  139. : ">cmd_buf     ( a1 n1 -- )
  140.                 cmd_buf +place ;
  141.  
  142. : params>cmd_buf ( n1 a1 -- n2 )   \ prompt for parameters for command line
  143.                 0 rows 1- at cols 1- spaces
  144.                 0 rows 1- at                    \ set start of line
  145.                 1+ dup c@
  146.                 dup $20 = swap '|' = or 0=      \ if not blank or "|"
  147.                 if      40 2dup '"' scan nip -  \ scan for " delimited $
  148.                         dup 1+ >r ?dup 0=
  149.                 else    true 0 >r
  150.                 then
  151.                 if      drop " Command line: "
  152.                 then
  153.                 type
  154.                 r> +                    \ adjust offset for next char
  155.                 tib 40 expect           \ get the command line
  156.                 tib span @ ">cmd_buf ;  \ append it to command buffer
  157.  
  158. : do_esc        ( n1 a1 -- n2 ) \ test char at a1, process then return n2,
  159.                                 \ an adjusted n1 the number of characters
  160.                                 \ to skip.
  161.                 >r
  162.                 r@ c@ '1' = if  nam_buf count ">cmd_buf then
  163.                 r@ c@ '2' = if  cfg_row count ">cmd_buf then
  164.                 r@ c@ '3' = if  cfg_col count ">cmd_buf then
  165.                 r@ c@ '4' = if  na2_buf count ">cmd_buf then
  166.                 r@ c@ 'P' = if  r@ params>cmd_buf       then
  167.                 r@ c@ 'F' = if  nam_buf count 2dup '.' scan nip -    \ no EXT
  168.                                 ">cmd_buf               then
  169.                 r>drop ;
  170.  
  171. : to_cmd_buf    ( a1 n1 -- )
  172.                 2dup $0D scan nip -                     \ strip off CRLF
  173.                 cmd_buf off
  174.                 bounds
  175.                 ?do     i c@ '%' =
  176.                         if      2 i 1+ do_esc      \ process 7 skip ESC strng
  177.                         else    i c@ >cmd_buf   1  \ do next char
  178.                         then
  179.                +loop    ;
  180.  
  181. : >cfg_line"    ( n1 -- a1 n2 )         \ get addr & len of line n1
  182.                 2* cfg_lines + dup @ swap 2+ @ over - ;
  183.  
  184. comment:
  185.  
  186. : "sys          ( a1 n1 a2 n2 --- f1 )         \ spawn a program
  187.                 exec.param 16 erase
  188.                 dup
  189.         if      exec.buf place
  190.                 exec.buf count + off
  191.         else    2drop exec.buf off
  192.         then    ?CS: 44 @L  exec.param      !   \ environment segmnt
  193.                 ?ds:        exec.param  4 + !   \ command line seg
  194.                 exec.buf    exec.param  2 + !   \ and offset
  195.                 $0D exec.buf count + c!         \ append a carraige return
  196.                 cmdpath place
  197.                 cmdpath count + off
  198.                 cmdpath 1+ exec.param execf ;
  199.  
  200. comment;
  201.  
  202. : run_cmd_buf   ( -- )  \ process multiple commands seperated by '|' chars
  203.                 cmd_buf count
  204.                 begin   2dup '|' scan 2dup 2>r nip - dup
  205.                 while   cmx_buf place
  206.                         cmx_buf count + 1- c@ $0A =
  207.                         if      -2 cmx_buf c+!
  208.                         then
  209.                         cmx_buf $sys drop       \ process DOS command
  210.                         2r> 1 /string
  211.                 repeat  2drop 2r> 2drop ;
  212.  
  213. : do_cfgline    ( n1 -- )
  214.                 dup cfg_#lines <
  215.                 if      >cfg_line" 255 min to_cmd_buf space
  216.                         run_cmd_buf
  217.                 else    drop            \ ignore greater than lines
  218.                 then    ;
  219.  
  220. : do_cmd        ( c1 -- )
  221.                 upc
  222.                 dup 'Q' =               if drop bye             then
  223.                 dup '1' '9' between     if dup '0' - do_cfgline then
  224.                 dup '0' =               if      10   do_cfgline then
  225.                 dup 'A' 'H' between     if dup 'A' - 11 + do_cfgline    then
  226.                 drop ;
  227.  
  228. : main          ( -- )
  229.                 DECIMAL                         \ always select decimal
  230.                 cfg_max  1+ ds:alloc =: cfg_buf \ allocate buffer space
  231.                 cmd_max  1+ ds:alloc =: cmd_buf
  232.                 cmd_max  1+ ds:alloc =: cmx_buf
  233.                 cmd_item 1+ ds:alloc =: nam_buf
  234.                 cmd_item 1+ ds:alloc =: na2_buf
  235.                 cmd_item 1+ ds:alloc =: cfg_row
  236.                 cmd_item 1+ ds:alloc =: cfg_col
  237.                 ?DS: SSEG !                     \ set search segment
  238.                 0 SET_MEMORY                    \ reduce memory usage
  239.                 dosio_init                      \ init DOS I/O for DEBUGGING
  240.                 DOS_TO_TIB                      \ move command tail to TIB
  241.                 COMSPEC_INIT                    \ init command specification
  242.                 read_cfg                        \ read configuration file
  243.                 cfg_lcalc                       \ calculate line starts
  244.                 bl word count cmd_item min nam_buf place \ get filename
  245.                 bl word count cmd_item min cfg_row place \ starting row and
  246.                 bl word count cmd_item min cfg_col place \ starting column
  247.                 bl word count cmd_item min na2_buf place \ second filename
  248.                 nam_buf c@ 0=                     \ if no cmdline parameters
  249.                 if      read_cmd drop             \ then use most recent
  250.                 then
  251.                 begin   del_cmd
  252.                         0 do_cfgline
  253.                         read_cfg
  254.                         cfg_lcalc
  255.                         read_cmd ?dup
  256.                 while   do_cmd
  257.                 repeat  ;
  258.  
  259.