\ SEQREAD.SEQ Sequential read and load file by Tom Zimmer \ Link this file into the FILELIST chain. FILES DEFINITIONS VARIABLE SEQREAD.SEQ FORTH DEFINITIONS \ Read sequential lines from a file, delimited by CRLF. 0 CONSTANT WITHPATH \ should the PATH be included in the file var 4096 CONSTANT IBLEN \ input buffer length 256 CONSTANT OBLEN \ output buffer length 0 CONSTANT INSTART 0 CONSTANT INLENGTH 0 CONSTANT INBSEG \ the input buffer VARIABLE TOTALLINES CREATE OUTBUF OBLEN ALLOT \ the line output buffer 4 B/HCB * CONSTANT MAXNEST \ maximum of 5 hcb's CREATE HNDLS MAXNEST B/HCB + ALLOT HNDLS SHNDL !-T \ Preset pointer VARIABLE LOADOFF \ line offset of error VARIABLE FILEPOINTER 2 allot \ most recent read VARIABLE LOADING \ Are we in the proccess of loading a file? 0 LOADING !-T \ initialize to not loading. CREATE CONHNDL B/HCB ALLOT 1 CONHNDL >HNDLE !-T CREATE PRNHNDL B/HCB ALLOT 4 PRNHNDL >HNDLE !-T : (CONSOLE) ( C1 --- ) OUTPAUSE SP@ 1 CONHNDL TYPESEG @ EXHWRITE 2DROP #OUT INCR ; : (TYPE) ( A1 N1 --- ) OUTPAUSE 0 MAX PRINTING @ IF 2DUP PRNHNDL TYPESEG @ EXHWRITE DROP THEN CONHNDL TYPESEG @ EXHWRITE #OUT +! ; : (PRINT) ( C1 --- ) OUTPAUSE SP@ 1 PRNHNDL TYPESEG @ EXHWRITE 2DROP #OUT INCR ; : (EXTYPE) ( SEG A1 N1 --- ) \ External type, from other segment ROT TYPESEG DUP @ >R ! TYPE R> TYPESEG ! ; DEFER LOADSTAT ' NOOP IS LOADSTAT : SHNDL+ ( --- a1 ) shndl @ b/hcb + ; : .SHNDL ( --- ) shndl @ count type ; \ : FILEPOINTER+ ( --- ) \ outbuf c@ 0 filepointer 2@ d+ filepointer 2! ; CODE FILEPOINTER+ ( --- ) mov bx, # filepointer \ Set BX to point to FILEPOINTER mov ax, 0 [bx] \ read the 32bit contents mov dx, 2 [bx] sub cx, cx mov cl, outbuf \ read byte length of OUTBUF add dx, cx \ Add to 32bit contents adc ax, # 0 mov 0 [bx], ax \ store back in FILEPOINTER mov 2 [bx], dx next end-code HEX CODE CURPOINTER ( handle --- double-current ) pop bx add bx, # hndloffset mov ax, 0 [bx] mov bx, ax mov cx, # 0 mov dx, # 0 mov ax, # 4201 \ from end of file int 21 push ax push dx next end-code DECIMAL : SAVEPOINTER ( --- ) shndl @ curpointer inlength 0 d- filepointer 2! ; CODE GET_ALINE ( --- ) mov ax, ' inbseg >body \ inbseg mov sseg ax \ (=:) sseg mov di, ' instart >body \ instart mov ax, # 10 mov cx, ' inlength >body cx<>0 if push es mov es, sseg mov bx, cx repnz scasb pop es 0= if inc cx dec di then cx<>0 if dec cx then then mov ax, ' inlength >body sub ax, cx mov ' inlength >body cx cmp ax, # oblen 1- > if mov ax, # oblen 1- then mov outbuf al byte cld mov bx, si mov si, ' instart >body add ' instart >body ax mov cx, ax mov di, # outbuf 1+ mov ax, cs mov ds, ' inbseg >body push es mov es, ax or cx, cx 0<> if repnz movsb then pop es mov ax, cs mov ds, ax mov si, bx inc errorline word mov sseg cs next end-code comment: \ high level version of GET_ALINE : GET_ALINE ( --- ) inbseg (=:) sseg instart inlength 10 scan nip dup if 1- then inlength over - >r \ save length traversed (=:) inlength \ set new length r@ oblen 1- min outbuf c! inbseg instart ?cs: outbuf count cmovel r> +!> instart errorline incr ?cs: (=:) sseg ; comment; : ?FILLBUFF ( --- ) \ refill INBUF [ inline mov ax, ' inlength >body cmp ax, # oblen u>= if mov ip, 0 [rp] \ Same as EXIT mov es, 2 [rp] add rp, # 4 jmp ' filepointer+ then next end-inline ] \ continues beyond here ONLY if the \ buffer needs to be refilled. inbseg instart over 0 inlength cmovel 0 (=:) instart inlength iblen inlength - shndl @ inbseg exhread +!> inlength savepointer ; : LINEREAD ( --- a1 ) \ read a line delimited by CRLF ?fillbuff \ re-fill buffer if needed. get_aline \ returns line including CRLF outbuf ; \ DEFER LINEREAD ' IS LINEREAD : (?SERROR) ( ADDR N1 BOOL --- ) loading @ if if >r >r sp0 @ sp! printing off loading off decimal cr ." file = " .shndl ." at Line " errorline @ u. cr outbuf count type cr >in @ 1- here c@ - 0 max dup loadoff ! 0 ?do ascii - emit loop ." ^-- " r> r> type space ['] is run quit \ disk error else 2drop \ no error comes here then else dup \ if error, then reset the deferred run word. if ['] is run then (?error) \ command line error then ; : SEQUP ( --- ) shndl @ >hndle @ -1 > if shndl @ b/hcb + dup hndls maxnest + U< 0= abort" Nested too deeply on FLOAD !" dup shndl ! clr-hcb then ; : SEQINIT ( --- ) noop hndls shndl ! hndls maxnest over + swap do i clr-hcb b/hcb +loop iblen 0 16 um/mod nip 1+ alloc 8 = memchk nip (=:) inbseg CONHNDL CLR-HCB " CON." ">$ CONHNDL $>HANDLE 1 CONHNDL >HNDLE ! PRNHNDL CLR-HCB " PRN." ">$ PRNHNDL $>HANDLE 4 PRNHNDL >HNDLE ! ; : IBRESET ( --- ) 0 (=:) instart 0 (=:) inlength ; : SEQDOWN ( --- ) shndl @ hclose drop shndl @ clr-hcb shndl @ b/hcb - hndls max shndl ! shndl @ >hndle @ -1 <> if filepointer 2@ shndl @ movepointer >in off span off #tib off IBRESET then ; : CLOSE ( --- ) seqdown ; : $HOPEN ( A1 --- F1 ) \ Returns a boolean for open successful shndl @ dup >r hclose drop r@ $>handle r> hopen ibreset ; DEFER GETFILE ( --- f1 ) \ return a1 filename addr and ' FALSE IS GETFILE \ Default to failed : FILE>TIB ( a1 --- ) count 2dup type space 2dup true -rot over + swap do i c@ ascii . = if drop false leave then loop >r dup span ! dup #tib ! >in off tib swap cmove r> if ascii . span @ tib + c! span incr #tib incr then ; : GFL ( --- ) >in @ span @ 1- > if getfile 0= abort" No filename specified" file>tib then ; : FILE ( --- ) gfl bl word $hopen abort" File open Error!" ." of " shndl @ endfile d. ." bytes." 0.0 shndl @ movepointer \ reset to beginning of file errorline off \ reset last line variable loadline off ; \ reset file offset : SEEK ( d1 --- ) \ Move the filepointer in SHNDL to the shndl @ movepointer ; \ specified by d1. 0 CONSTANT LISTVAR : SHOWLINES ( --- ) -1 (=:) listvar ; : HIDELINES ( --- ) 0 (=:) listvar ; CODE CRLF>BL'S ( a1 --- a1 ) \ change CRLF at end of string to blanks pop bx \ leaving the string address on the stack push bx \ Same as -> DUP COUNT + 2- 8224 SWAP ! mov al, 0 [bx] sub ah, ah add bx, ax mov -1 [bx], # 8224 word next end-code CODE SETTIB ( a1 --- ) \ Set TIB to counted string a1 pop bx mov al, 0 [bx] inc bx mov 'tib bx sub ah, ah mov span ax mov #tib ax mov >in # 0 next end-code : .LOADLINE ( a1 --- a1 ) [ inline mov cx, ' listvar >body cx<>0 if next \ LISTVAR <> zero, continue then \ if LISTVAR is zero then jmp ' exit \ leave definition. end-inline ] cr errorline @ 5 u.r space dup count type ; : FILLTIB ( --- ) span @ loadline +! lineread crlf>bl's .loadline settib ; CODE ?.STAT ( --- ) test errorline # 255 \ only once every 256 lines 0= if mov ax, # ' loadstat \ loadstat is : def jmp ax \ so we need to goto it this then \ way. Can't just do a direct next end-code \ JMP ' LOADSTAT : ( --- ) loadstat (@) loading >r on> loading (@) 'tib >r (@) >in >r (@) span >r off> span (@) errorline >r begin (@) span +!> loadline lineread inlength 0> while crlf>bl's .loadline settib run ?.stat repeat drop (@) errorline +!> totallines r> (=:) errorline r> dup (=:) span (=:) #tib r> (=:) >in r> (=:) 'tib r> (=:) loading ; DEFER LOADER ' IS LOADER : >LINE ( n1 --- ) 0.0 shndl @ movepointer loadline off IBRESET errorline off 1- 0 max ?dup if cr ." Stepping to line " dup 1+ u. ." .." 0 ?do lineread c@ dup loadline +! 0= ?leave loop then ; : LOADED, ( --- ) (@) 'tib >r (@) >in >r (@) span >r \ save state shndl @ count withpath 0= \ Should the PATH not be if \ included in the file VARIABLE? begin 2dup ascii \ scan dup \ skip the leading path while 2swap 2drop 1 -1 d+ repeat 2drop then dup (=:) span (=:) #tib \ set span and #tib (=:) 'tib \ set tib to shndl off> >in \ clear >in context @ >r \ save current context current @ >r \ and current vocab state files definitions \ select files vocabulary variable \ make the header r> current ! r> context ! \ restore vocabulary state r> dup (=:) span (=:) #tib \ restore state r> (=:) >in r> (=:) 'tib ; : ( --- ) loaded, 0.0 shndl @ movepointer (@) loadline >r off> loadline off> errorline loader r> (=:) loadline ; : FLOAD ( --- t1 ) (@) ?error >r sequp IBRESET ['] (?serror) is ?error >in @ bl word c@ over >in ! + >r outbuf off loadoff off shndl @ !hcb R> 0 filepointer 2@ d+ >r >r shndl @ hopen 0<> if cr ." Open error in " .shndl abort then r> r> filepointer 2! shndl @ c@ 6 + loadline +! \ adj for filename length \ and "FLOAD ". seqdown r> is ?error ; : CHARREAD ( --- c1 ) \ Read a character from the current file. loading @ if begin >in @ span @ = \ If nothing in line inlength 0> and \ and input buf not empty while ?fillbuff \ Optionally refill buffer filltib \ refill the TIB repeat then >in @ >in incr tib + c@ ; : OK ( --- ) \ Load currently open file IBRESET ; : \S ( n1 --- ) \ Ignore the rest of the file. shndl @ endfile 2drop \ Move to end of file loadline off IBRESET span @ >in ! ; \ Ignore rest of line