home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / tsread.seq < prev    next >
Text File  |  1990-07-03  |  6KB  |  146 lines
  1. \\ TSREAD.SEQ    Target sequential LINEREAD support
  2.  
  3.   LINEREAD support for TCOM. Be sure to use LINEREAD_INIT before trying
  4. to use the LINEREAD function. Some extra DOS memory must be allocated for
  5. the line read buffer which currently defaults to 8000 bytes.
  6.  
  7.   LINEREAD reads a line into the buffer OUTBUF, and can be upto 255
  8. characters in length. If you lineread a file that does not contain LF
  9. characters, then LINEREAD will automatically break up the file into
  10. 255 character lines. Not wonderful perhaps, but better than crashing.
  11.  
  12.   The read lines will still contain the CRLF character pairs at the
  13. end of the line buffer. You will thus need to remove them before using
  14. the line.
  15.  
  16. {
  17.  
  18. FORTH DECIMAL TARGET >LIBRARY   \ A Library file
  19.  
  20. 8000 VALUE IBLEN                \ current input buffer length
  21.  $0A CONSTANT DELIMITER
  22.  255 CONSTANT OBLEN             \ output buffer length
  23.   VARIABLE INSTART
  24.   VARIABLE INLENGTH
  25.   VARIABLE INBSEG               \ the input buffer
  26.   VARIABLE LOADLINE
  27.  2VARIABLE FILEPOINTER          \ most recent read
  28.   VARIABLE LINE_LIMIT           \ line read limit of no LF detected
  29.  
  30. handle lreadhndl
  31.  
  32. 0 value lrhndl
  33.  
  34.  oblen 1+ array outbuf
  35.  
  36. : .lrhndl      ( --- )
  37.                 lrhndl count type ;
  38.  
  39. : memchk        ( f1 -- )
  40.                 if      ." Insufficient Memory"
  41.                         bye
  42.                 then ;
  43.  
  44. : IBRESET       ( --- )
  45.                 instart OFF
  46.                 inlength OFF
  47.                 loadline OFF ;
  48.  
  49. }
  50.  
  51.  Perform the following function, and then open a file on the handle
  52. LRHNDL. LINEREAD will read lines from this handle into the buffer called
  53. OUTBUF. The address of OUTBUF is also returned by LINEREAD.
  54.  
  55. {
  56.  
  57. : LINEREAD_INIT ( -- )          \ initialize the LINEREAD system.
  58.                 255 line_limit !
  59.                 lrhndl 0=
  60.                 if      lreadhndl =: lrhndl
  61.                         lrhndl clr-hcb
  62.                 then
  63.                 inbseg @ 0=
  64.                 if      iblen paragraph alloc 8 = memchk nip inbseg !
  65.                 then    ;
  66.  
  67. CODE CURPOINTER ( handle --- double-current )
  68.                 add bx, # hndloffset
  69.                 mov bx, 0 [bx]
  70.                 sub cx, cx
  71.                 mov dx, cx
  72.                 mov ax, # $4201  \ from end of file
  73.                 int $21
  74.                 dec si
  75.                 dec si
  76.                 mov 0 [si], ax
  77.                 mov bx, dx
  78.                 ret             end-code
  79.  
  80. : savepointer   ( --- )
  81.                 lrhndl curpointer inlength @ 0 d- filepointer 2! ;
  82.  
  83. code get_aline  ( --- a1 )
  84.                 save_bx
  85.                 push es                         \ Save ES for later restoral
  86.                 mov di, instart                 \ Searching from INSTART
  87.                 mov ax, # DELIMITER             \ Searching for line delimiter
  88.                 mov cx, inlength                \ for INLENGTH clipped to OBLEN
  89.                 cmp cx, # oblen                 \ if INLENGTH > OBLEN
  90.               > if      mov cx, line_limit      \ clip search to line_limit
  91.                 then    mov dx, cx              \ save search length in DX
  92.           cx<>0 if      mov es, inbseg          \ searching INBSEG segment
  93.                         repnz  scasb            \ Scan for Linefeed char
  94.                 then    sub dx, cx              \ DX = length of line
  95.                 sub inlength dx                 \ subtract line from remaining
  96.                 mov outbuf dl byte              \ set the length of OUTBUF
  97.                 mov bx, si                      \ save IP for later restoral
  98.                 mov si, instart                 \ moving from INSTART
  99.                 add instart dx                  \ set start to after line
  100.                 mov cx, dx                      \ cx = length to move
  101.                 mov di, # outbuf 1+             \ moving to OUTBUF
  102.                 mov dx, ds
  103.                 mov ds, inbseg                  \ from INBSEG segment
  104.                 mov es, dx
  105.           cx<>0 if      repnz   movsb           \ move the line to OUTBUF
  106.                 then
  107.                 mov ds, dx                      \ restore DS
  108.                 mov si, bx                      \ restore IP
  109.                 inc loadline word               \ bump line counter
  110.                 pop es                          \ restore ES
  111.                 mov bx, # outbuf                \ return address of buffer
  112.                 ret             end-code
  113.  
  114. : fillbuff      ( --- )         \ Refill the input buffer.
  115.                 inbseg @ instart @ over 0 inlength @ cmovel
  116.                 instart OFF
  117.                 inlength @ iblen inlength @ -
  118.                 lrhndl inbseg @ exhread      \ perform the actual read
  119.                 inlength +!                   \ adjust buffer length
  120.                 savepointer ;
  121.  
  122. code ?fillbuff  ( --- f1 )              \ f1 = true if refill needed
  123.                 save_bx
  124.                 cmp inlength # oblen 1+ word
  125.             u>= if      mov di, # filepointer   \ Set BX to point to FILEPOINTER
  126.                         sub cx, cx              \ clear CX
  127.                         mov cl, outbuf          \ read byte length of OUTBUF
  128.                         add 2 [di], cx          \ Add to 32bit contents
  129.                         adc 0 [di], # 0
  130.                         mov bx, # 0
  131.                         ret
  132.                 then                            \ If we got here, then
  133.                 mov bx, # -1                    \ go and re-fill the buffer
  134.                 ret     end-code
  135.  
  136. : LINEREAD      ( --- a1 )      \ read a line delimited by crlf
  137.                 ?fillbuff       \ re-fill buffer if needed.
  138.                 if      fillbuff
  139.                 then
  140.                 get_aline ;     \ returns line including CRLF
  141.  
  142. FORTH TARGET >TARGET
  143.  
  144. }
  145.  
  146.