home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / tenviron.seq < prev    next >
Text File  |  1989-11-02  |  3KB  |  97 lines
  1. \ TENVIRON.SEQ   Environment manipulation words          by Tom Zimmer
  2.  
  3. >FORTH FORTH DECIMAL TARGET >LIBRARY       \ a Library file
  4.  
  5. : evseg         ( --- n1 )      \ Return the segment of environment $.
  6.                 ?cs: 44 @L ;
  7.  
  8. : envsize       ( --- n1 )      \ Calculate the environment $ size.
  9.                 ?cs: evseg - 2047 min 16 * ;
  10.  
  11. : "envfind      ( a1 n1 --- n2 bool )   \ n2 is offset into environment
  12.                 caps dup @ >r off       \  where string a1,n1 was found.
  13.                 evseg sseg dup @ >r !   \ Set the search segment
  14.                 0 envsize search
  15.                 r> SSEG !               \ Restore the search segment
  16.                 r> caps ! ;
  17.  
  18. : .envchr       ( i -- )
  19.                 >r evseg r@ c@l 0=
  20.                 if      cr
  21.                 else    evseg r@ c@L emit
  22.                 then    r>drop ;
  23.  
  24. : .env          ( --- )         \ print the environment string
  25.                 envsize 0 cr
  26.                ?do      i .envchr
  27.                         evseg i @L 0= ?leave
  28.                 loop    ;
  29.  
  30. HANDLE COMSPEC$
  31.  
  32. : com_extract   ( a1 -- )
  33.                 8 + envsize swap
  34.                 comspec$ dup clr-hcb >nam -rot
  35.                 do      evseg i c@l 0= ?leave
  36.                         evseg i c@l over c! 1+
  37.                         1 comspec$ c+!
  38.                 loop    drop ;
  39.  
  40. : comspec@      ( --- )         \ extract the command spec
  41.                 " COMSPEC=" "envfind 0=
  42.                 if      drop comspec$ off
  43.                 else    com_extract
  44.                 then    ;
  45.  
  46. : .comspec      ( --- ) comspec@ comspec$ count type ;
  47.  
  48. : comspec_init  ( -- )
  49.                 comspec@ comspec$ count dup     \ init command specification
  50.                                                 \ for DOS shell operations
  51.                 if      cmdpath place
  52.                 else    2drop
  53.                         " \COMMAND.COM" cmdpath place
  54.                 then    ;
  55.  
  56. 132 ARRAY  PATH$
  57.  
  58. : path_extract  ( a1 -- )
  59.                 5 + envsize swap
  60.                 path$ dup clr-hcb >nam -rot
  61.                 do      evseg i c@l 0= ?leave
  62.                         evseg i c@l over c! 1+
  63.                         1 path$ c+!
  64.                 loop    drop    ;
  65.  
  66. : path@         ( --- )         \ extract the command spec
  67.                 " PATH=" "envfind 0=
  68.                 if      drop path$ off
  69.                 else    path_extract
  70.                 then    ;
  71.  
  72. : .path         ( --- ) path@ path$ count type ;
  73.  
  74. HANDLE ME$
  75.  
  76. : me_extract    ( a1 -- )
  77.                 4 + envsize swap
  78.                 me$ dup clr-hcb >nam -rot
  79.                 do      evseg i c@l 0= ?leave
  80.                         evseg i c@l over c! 1+
  81.                         1 me$ c+!
  82.                 loop    drop ;
  83.  
  84. : me@           ( --- ) \ extract my own execution name string
  85.                         \ returns a null ME$ if it fails
  86.                 me$ off dosver 3 >=     \ need DOS version 3 or greater
  87.                 if      me$ 2 "envfind
  88.                         if      me_extract
  89.                         else    drop
  90.                         then
  91.                 then            ;
  92.  
  93. : .me           ( --- ) me@ me$ count type ;
  94.  
  95. FORTH TARGET >TARGET
  96.  
  97.