home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacQForth 1.0 / code / stdio.4th < prev   
Encoding:
Text File  |  1995-03-22  |  2.3 KB  |  86 lines  |  [TEXT/ALFA]
  1.  
  2. ( STDIO.4TH  -- Standard I/O words for QForth, including disk I/O and )
  3. (               string functions.                                     )
  4. (                                                                     )
  5. ( Ronald T. Kneusel, 01/31/95                                         )
  6.  
  7. ( Last Mod:  02/03/95 )
  8.  
  9. ( =================================================================== )
  10.  
  11.  
  12. ( Disk access routines )
  13.  
  14. ( Misc utility words )
  15.  
  16. 256 constant $MAX$  ( maximum string length )
  17.  
  18. variable $file#     ( file number = 0, 1, or 2 )
  19. variable $addr#     ( address of string )
  20. variable $char#     ( a single character )
  21.  
  22. : $file  $file# @ ; ( return file number )
  23. : $addr  $addr# @ ; ( return string address )
  24.  
  25. ( Get and Put characters )
  26.  
  27. : fget ( file# -- char ec )  ( get a character from disk )
  28.    $char# 1 fread swap drop $char# c@ 127 b.and swap ;
  29.  
  30. : fput ( char file# -- ec )  ( put a character to disk   )
  31.    swap $char# c! $char# 1 fwrite swap drop ;
  32.  
  33. ( Read a string from disk )
  34.  
  35. : fread$ ( file# addr --  ) 
  36.    $addr# !  $file# !           ( store file number and string address )
  37.    $MAX$ 0 do
  38.      $file fget                       ( get a character )
  39.      0 = if                           ( no ProDOS error )
  40.        dup 13 = if                    
  41.         drop 0 $addr i + c!  leave    ( '\n' character  )
  42.        else
  43.         $addr i + c!                  ( read next character )
  44.        then
  45.      else
  46.        drop 0 $addr i + c!   leave    ( error, bomb out )
  47.      then
  48.    loop
  49. ;
  50.  
  51. ( Write a string to disk )
  52.  
  53. : fwrite$  ( file# addr --  )
  54.    $addr# !  $file# !
  55.    $MAX$ 0 do
  56.      $addr i + c@              ( get a character                    )
  57.      dup 0 = if
  58.        drop                    ( end-of-string, output '\n'         )
  59.        13 $file fput drop
  60.        $MAX$
  61.      else
  62.        $file fput drop         ( send character to disk             )
  63.        1
  64.      then
  65.    +loop
  66. ;
  67.  
  68. ( ==================================================================== )
  69.  
  70. ( String I/O )
  71.  
  72. : $get  ( addr -- )  ( get a null terminated string )
  73.    dup >r $MAX$ expect  0 r> span + c!
  74. ;
  75.  
  76. : len  ( addr -- len )   ( string length )
  77.    0 swap dup $MAX$ + swap do 
  78.      i c@ 0 = if leave else 1+ then
  79.    loop
  80. ;
  81.  
  82. : TYPE ( addr -- )  ( display a string )
  83.    dup $MAX$ + swap do  i c@ dup 0 = if drop leave else emit then  loop
  84. ;
  85.  
  86.