fix for data left on return stack when AA tree is empty

This commit is contained in:
Jesse D. McDonald 2020-11-07 17:28:18 -06:00
parent 9361c6fef0
commit 3590996e43
1 changed files with 65 additions and 19 deletions

View File

@ -2289,10 +2289,9 @@ SYSTEM DEFINITIONS
\ From this point on we only execute threaded FORTH words defined in this file
\ *****************************************************************************
ONLY FORTH
ALSO UTILITY
ALSO SYSTEM
ALSO
ONLY FORTH ALSO
UTILITY ALSO
SYSTEM ALSO
SYSTEM DEFINITIONS
@ -2753,19 +2752,23 @@ UTILITY DEFINITIONS
AA>ROOT @ AA-TRAVERSE-NODE ;
: AA-ITERATE ( i*x xt aa-tree -- j*x )
NULL >R AA>ROOT @
BEGIN ?DUP WHILE
DUP >R AA>LEFT @
BEGIN ?DUP 0= WHILE
R> ?DUP 0= IF DROP EXIT THEN
2DUP 2>R SWAP EXECUTE 2R>
AA>RIGHT @
REPEAT
REPEAT ▪ DROP ;
AA>ROOT @ ?DUP IF
NULL >R
BEGIN
DUP >R AA>LEFT @
BEGIN ?DUP 0= WHILE
R> ?DUP 0= IF DROP EXIT THEN
2DUP 2>R SWAP EXECUTE 2R>
AA>RIGHT @
REPEAT
AGAIN
THEN ▪ DROP ;
: AA-#NODES ( aa-tree -- u )
>R 0 { DROP 1+ } R> AA-ITERATE ;
LINUX ALSO
LINUX DEFINITIONS
STRUCT
@ -2808,11 +2811,9 @@ ENDSTRUCT FILE%
{ CONTAINEROF FILE>NODE ▪ FILE>FD @ } ' <=> NEW-AA-TREE CONSTANT FILES
ALSO LINUX
open_how% %VARIABLE OPEN-HOW
stat64% %VARIABLE STAT64-RESULT
signed-long-long% %VARIABLE LLSEEK-RESULT
PREVIOUS
: FD>FILE ( fileid -- file-addr )
FILES AA-LOOKUP ?DUP 0= "unknown file ID" ?FAIL ;
@ -2828,8 +2829,6 @@ UTILITY DEFINITIONS
FORTH DEFINITIONS
ALSO LINUX
O_RDONLY CONSTANT R/O ( -- fam )
O_WRONLY CONSTANT W/O ( -- fam )
O_RDWR CONSTANT R/W ( -- fam )
@ -2881,8 +2880,55 @@ O_RDWR CONSTANT R/W ( -- fam )
0<> IF EXCP-FILE-IO THROW THEN
STAT64-RESULT stat64>size 2@ SWAP ;
: READ-FILE ( c-addr u1 fileid -- u2 ) ;
: READ-LINE ( c-addr u1 fileid -- u2 t=eof ) ;
UTILITY DEFINITIONS
: (READ-CHAR) ( file-addr -- c TRUE | FALSE )
>R
R@ FILE>LEFTOVER 2@ NIP 0= IF
R@ FILE>FD @ R@ FILE>BUFFER @ FILE-BUFFER-BYTES
SYS_READ SYSCALL3-RETRY
DUP 0< IF DROP EXCP-FILE-IO THROW THEN
DUP FILE-BUFFER-BYTES U> "read more data than requested" ?FAIL
R@ FILE>BUFFER @ SWAP R@ FILE>LEFTOVER 2!
THEN
R@ FILE>LEFTOVER 2@ DUP IF
OVER C@ -ROT 1/STRING R@ FILE>LEFTOVER 2!
R@ FILE>POSITION DUP 2@ 1# D+ ROT 2!
TRUE
ELSE
2DROP FALSE
THEN
RDROP ;
FORTH DEFINITIONS
: READ-FILE ( c-addr u1 fileid -- u2 )
FD>FILE LOCALS| addr max file |
0 BEGIN
DUP max U<
WHILE
file (READ-CHAR)
WHILE
OVER addr + C!
1+
REPEAT
ENDLOCALS ;
: READ-LINE ( c-addr u1 fileid -- u2 t=eof )
FD>FILE LOCALS| addr max file |
FALSE 0 BEGIN
DUP max U<
WHILE
file (READ-CHAR)
DUP 0= IF NIP TRUE SWAP THEN
WHILE
DUP LF <> DUP 0= IF NIP THEN
WHILE
OVER addr + C!
1+
REPEAT
SWAP
ENDLOCALS ;
: WRITE-FILE ( c-addr u fileid -- )
FD>FILE >R