Test new READ-LINE (Rev 1 2021-11-06)

\ Test new READ-LINE
\
\ Rev 1  2021-11-06  fix READ-LINE return codes & test to match
\                    description
\
\ Suggested alterations to ANS READ-LINE specification to avoid the
\ quirky buffer requirements and ensure end-of-line detection.
\
\ Amend the interface to:
\
\  READ-LINE  ( c-addr u1 fid -- u2 n3 ior )
\
\ where 'n3' returns a code representing the status:
\  0 = EOF, -1 = EOL received, 1 = EOL not received
\
\ Summary of changes:
\
\ - Previously 'flag' was true|false.  In the replacement it may take
\   the values -1|0|1 so we rename 'flag' to 'n3'.
\
\ - Previously 'u1' was the maximum chars to receive.  'u1' now refers
\   to the buffer size.

\ Sample implementation & test:

empty

0 value ifid
0 value ofid

: readtext0 ( a u1 -- a u2 flag )  over swap ifid read-line throw ;

\ EOL string
 here  2 c, 13 c, 10 c,  count 2constant (cr) ( -- a u )
\ here  1 c, 10 c,        count 2constant (cr) ( -- a u )
\ here  1 c, 13 c,        count 2constant (cr) ( -- a u )

\ EOL scanner
: /EOL ( a u -- u' offs )
   over swap  begin  dup while
     over c@ dup $0D - while  $0A - while  1 /string
   repeat  \ got LF
     drop swap - dup 1+  exit
   then  \ got CR
     2drop tuck swap - swap 1+ c@ $0A <> over + 2 +  exit
   then  \ neither
   drop swap - dup ;

0 [if]

\ DTC 8086 version
\ Scan for CR LF CRLF return len & offset to next line
code /EOL ( a u -- u' offs )
   cx pop  bx pop  bx di mov  dx dx sub  $0A0D # ax mov
1 $:  4 $ jcxz  al 0 [bx] cmp  2 $ jz  ah 0 [bx] cmp  3 $ jz
   bx inc  cx dec  1 $ ju  2 $:  dx inc  ah 1 [bx] cmp  4 $ jnz
3 $:  dx inc  4 $:  di bx sub  bx push  dx bx add  bx push
   next
end-code

[then]

\ buffer size at least u chars and a minimum of one
\ n3: 0 = EOF, -1 = EOL received, 1 = EOL not received
: READ-LINE ( a u1 fid -- u2 n3 ior )
  >r  2dup r@ read-file
  dup if  r> drop  nip  exit  then  \ ior
  over 0= if  r> drop  2swap 2drop  0  exit  then  \ EOF
  drop  >r  tuck  1- r@ min  /eol  r> - s>d
  r@ file-position drop  d+  r> reposition-file drop
  tuck  1+ <> 2* 1+  0 ;

: writedata ( a u -- )  ofid write-file throw ;
: readtext ( a u1 -- a u2 flag )  over swap ifid read-line throw ;

: open ( a u -- )  r/o bin open-file throw to ifid ;
: make ( a u -- )  r/w bin create-file throw to ofid ;
: closein  ( -- )  ifid close-file drop ;
: closeout ( -- )  ofid close-file drop ;

: ?cr ( flag -- )  if  (cr) writedata  then ;

5 value bufsize

: read&write ( a u a2 u2 -- )
  2swap 2dup open
  cr ." Reading: " type ."  using READ-LINE u1 = " bufsize . cr
  cr ." Writing: " 2dup type ."  u2 chars using WRITE-FILE;"
  cr ." write EOL sequence only when n3 = -1" cr
  make
  0  begin
    ?cr  pad bufsize readtext  dup while  \ not done
    ( a u2 flag) >r  writedata  r> 1-
  repeat drop drop drop
  closein  closeout ;

: make-test ( a u -- )
  cr ." Making text file: " 2dup type cr  make
  s" 123456789"
  2dup 8 - writedata (cr) writedata
  2dup 7 - writedata (cr) writedata
  2dup 6 - writedata (cr) writedata
  2dup 5 - writedata (cr) writedata
  2dup 4 - writedata (cr) writedata
  2dup 3 - writedata (cr) writedata
  2dup 2 - writedata (cr) writedata
  2dup 1 - writedata (cr) writedata
           writedata (cr) writedata
  closeout ;

: show ( a u -- )
  cr ." Showing: " 2dup type   open
  cr  begin  pad 100 readtext0 while type cr repeat 2drop
  closein ;

: foobar
  page
  s" FOO" make-test  s" FOO" show
  s" FOO" s" BAR" read&write  s" BAR" show ;

foobar