home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / pathset.seq < prev    next >
Encoding:
Text File  |  1991-04-10  |  1.9 KB  |  48 lines
  1. \ PATHSET.SEQ   Words used to set the path of a file.   by Tom Zimmer
  2.  
  3.    0 value flhndl            \ plugged later
  4.  
  5. : ?drive.extract ( handle --- drive-value )
  6.                 dup >nam 1+ c@ ':' =
  7.                 if      dup>r >nam c@ bl or 96 -
  8.                         r@ count 2- >r dup 2+ swap r> cmove
  9.                         r@ c@ 2- r@ c! r> count + off
  10.                 else    drop 0 25 bdos 1+ then    ;
  11.  
  12. : ?drive.prepend ( drive-value handle --- )
  13.                 over 0=
  14.                 if      2drop
  15.                 else    dup>r count >r dup 2+ r> cmove>
  16.                         64 + r@ >nam c! ':' r@ >nam 1+ c!
  17.                         r@ c@ 2+ r> c!
  18.                 then    ;
  19.  
  20. handle pathhndl
  21.  
  22. : prepend.path  ( handle --- f1 )
  23.                 dup c@ 0= if drop true exit then    \ leave if no name
  24.                 pathhndl clr-hcb
  25.                 dup =: flhndl ?drive.extract >r
  26.                 flhndl >nam c@ '\' <> dup           \ leave if got path
  27.         if      drop
  28.                 '\' pathhndl 1+ c! 64 pathhndl c!
  29.                 pathhndl 2+ r@ pdos dup 0=
  30.                 if      drop
  31.                         pathhndl 1+ 64 0   \ determine path length
  32.                         do      dup i + c@ 0= if i pathhndl c! leave then
  33.                         loop    drop pathhndl c@ 1 >
  34.                         if      '\' pathhndl count + c!
  35.                                 pathhndl c@ 1+ pathhndl c!
  36.                         then    flhndl c@ pathhndl c@ + 62 > dup 0=
  37.                         if      drop
  38.                                 flhndl 1+ pathhndl c@ over + flhndl c@ cmove>
  39.                                 pathhndl count flhndl 1+ swap cmove
  40.                                 pathhndl c@ flhndl c@ + flhndl c!
  41.                                 false
  42.                         then
  43.                 then
  44.         then    r> flhndl ?drive.prepend 0 flhndl count + c! ;
  45.  
  46. ' PREPEND.PATH IS PATHSET
  47.  
  48.