cleanup and implement file i/o, boolean logic

removed "active file" concept from minijort in favour of taking a
file pointer on the stack
This commit is contained in:
Jeremy Penner 2023-10-16 15:54:44 -04:00
parent 141315b6fb
commit e5384d5aef
7 changed files with 213 additions and 98 deletions

View file

@ -290,9 +290,14 @@ var ignoreimm
: >grp2* ( ext -- ) : >grp2* ( ext -- )
0xd0 swap-args 0xd0 swap-args
oparg-imm? oparg-val @ 1 = and not if ( 1, d0/d1 ) oparg-imm? oparg-val @ 1 = and not if ( 1, d0/d1 )
oparg-reg? oparg-val @ 0x11 = and oparg-reg? oparg-val @ 0x11 = and
if 2 + ( CL, d2/d3 ) else swap-args 2drop return then if 2 + ( CL, d2/d3 ) else swap-args 2drop return then
then swap-args 'extregmem 1 ignoreimm ! *? 0 ignoreimm ! if 2ret then ; then swap-args
oparg-wreg? if 1 + ' >extreg* else
oparg-breg? if ' >extbreg* else
oparg-mem? if byteptr? not if 1 + then :| >mem 2ret |; else
2drop then then then
1 ignoreimm ! *? 0 ignoreimm ! if 2ret then ;
2 :op XCHG 2 :op XCHG
arg2 oparg-reg? oparg-val @ 0x00 = and arg1 oparg-wreg? and arg2 oparg-reg? oparg-val @ 0x00 = and arg1 oparg-wreg? and

View file

@ -49,13 +49,13 @@ key const sp
then ; then ;
: interpreter : interpreter
begin word dup b@ while compileword repeat drop ; begin word dup b@ while compileword repeat drop ;
: loadfp ( -- ) : loadfp ( fp -- fp )
infile @ >r infile @ >r
fdeactivate infile ! infile !
interpreter interpreter
infile @ factivate infile @
<r infile ! ; <r infile ! ;
: loadfile ( filename -- ) fdeactivate >r open loadfp close <r factivate ; : loadfile ( filename -- ) open loadfp close ;
( image loading ) ( image loading )
: noop ; : noop ;

View file

@ -23,7 +23,6 @@ cell *rstack = ((cell*)mem) + STACK_SIZE;
int TRACING = 0; int TRACING = 0;
#endif #endif
FILE *ACTIVE_FILE = NULL;
FILE *IN_FILE = stdin; FILE *IN_FILE = stdin;
FILE *OUT_FILE = stdout; FILE *OUT_FILE = stdout;
@ -110,9 +109,6 @@ void f_fromratio() { // a*r ( a r -- b )
DROP(1); DROP(1);
} }
void f_eq0() {
TOP().i = (TOP().i == 0);
}
void f_not() { void f_not() {
TOP().i = !TOP().i; TOP().i = !TOP().i;
} }
@ -259,63 +255,32 @@ void f_word() {
} }
void f_fputc() { void f_fputc() {
if (ACTIVE_FILE) { fwrite(&ST1().i, 1, 1, TOP().fp);
fwrite(&TOP().i, 1, 1, ACTIVE_FILE); DROP(2);
}
DROP(1);
} }
void f_gets() { void f_gets() {
gets(TOP().s); gets(TOP().s);
} }
void f_fput() { void f_fwrite() { // ( length p fp )
if (ACTIVE_FILE) { fwrite(ST1().p, ST2().u, 1, TOP().fp);
fwrite(&TOP().u, 2, 1, ACTIVE_FILE); DROP(3);
}
DROP(1);
}
void f_fwrite() { // ( length p )
if (ACTIVE_FILE) {
fwrite(TOP().p, ST1().u, 1, ACTIVE_FILE);
}
DROP(2);
} }
void f_fgetc() { void f_fgetc() {
int result = EOF; int result;
if (ACTIVE_FILE) { result = fgetc(TOP().fp);
result = fgetc(ACTIVE_FILE); TOP().i = result;
}
PUSHI(result);
} }
void f_fget() { void f_fread() { // ( length p fp )
unsigned int result = 0; fread(ST1().p, ST2().u, 1, TOP().fp);
if (ACTIVE_FILE) { DROP(3);
int low = fgetc(ACTIVE_FILE);
int high = fgetc(ACTIVE_FILE);
if (low != EOF && high != EOF) {
result = low | (high << 8);
}
}
PUSHU(result);
}
void f_fread() { // ( length p )
if (ACTIVE_FILE) {
fread(TOP().p, ST1().u, 1, ACTIVE_FILE);
}
DROP(2);
} }
void f_feof() { void f_feof() {
if (ACTIVE_FILE) { PUSHI(feof(TOP().fp));
PUSHI(feof(ACTIVE_FILE));
} else {
PUSHI(1);
}
} }
void f_puts() { void f_puts() {
@ -640,48 +605,36 @@ void f_interpreter() {
} }
void f_close() { void f_close() {
if (ACTIVE_FILE) { fclose(TOP().fp);
fclose(ACTIVE_FILE); DROP(1);
ACTIVE_FILE = NULL;
}
} }
void f_open() { void f_open() {
FILE *fp; FILE *fp;
fp = fopen(TOP().s, "ab+"); fp = fopen(TOP().s, "ab+");
fseek(fp, 0, SEEK_SET); fseek(fp, 0, SEEK_SET);
ACTIVE_FILE = fp; TOP().fp = fp;
DROP(1);
} }
void f_overwrite() { void f_overwrite() {
f_close(); FILE *fp;
ACTIVE_FILE = fopen(TOP().s, "wb+"); fp = fopen(TOP().s, "wb+");
DROP(1); TOP().fp = fp;
}
void f_deactivate() {
PUSHP(ACTIVE_FILE);
ACTIVE_FILE = NULL;
}
void f_activate() {
f_close();
ACTIVE_FILE = TOP().fp;
DROP(1);
} }
void f_seek() { void f_seek() {
fseek(ACTIVE_FILE, TOP().u, SEEK_SET); fseek(TOP().fp, ST1().u, SEEK_SET);
DROP(1); DROP(2);
} }
void f_seekend() { void f_seekend() {
fseek(ACTIVE_FILE, 0, SEEK_END); fseek(TOP().fp, 0, SEEK_END);
DROP(1);
} }
void f_tell() { void f_tell() {
PUSHU(ftell(ACTIVE_FILE)); unsigned int pos = ftell(TOP().fp);
TOP().u = pos;
} }
void f_exists() { void f_exists() {
@ -835,7 +788,6 @@ void f_init() {
CDEF("*", f_mul); CDEF("*", f_mul);
CDEF("/", f_div); CDEF("/", f_div);
CDEF("%", f_mod); CDEF("%", f_mod);
CDEF("=0", f_eq0);
CDEF("not", f_not); CDEF("not", f_not);
CDEF("=", f_eq); CDEF("=", f_eq);
CDEF("!=", f_neq); CDEF("!=", f_neq);
@ -895,17 +847,13 @@ void f_init() {
CDEF("overwrite", f_overwrite); CDEF("overwrite", f_overwrite);
CDEF("close", f_close); CDEF("close", f_close);
CDEF("exists", f_exists); CDEF("exists", f_exists);
CDEF("factivate", f_activate);
CDEF("fdeactivate", f_deactivate);
CDEF("seek", f_seek); CDEF("seek", f_seek);
CDEF("seekend", f_seekend); CDEF("seekend", f_seekend);
CDEF("tell", f_tell); CDEF("tell", f_tell);
CDEF("fputc", f_fputc); CDEF("fputc", f_fputc);
CDEF("fput", f_fput);
CDEF("fgetc", f_fgetc); CDEF("fgetc", f_fgetc);
CDEF("fget", f_fget);
CDEF("fwrite", f_fwrite);
CDEF("fread", f_fread); CDEF("fread", f_fread);
CDEF("fwrite", f_fwrite);
CDEF("findfile", f_findfirst); CDEF("findfile", f_findfirst);
CDEF("nextfile", f_findnext); CDEF("nextfile", f_findnext);
CDEF("chdir", f_chdir); CDEF("chdir", f_chdir);

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -98,13 +98,15 @@ L@ $$VAR CONST $DOVAR
( some helpers for making manually defining colon words slightly less ugly ) ( some helpers for making manually defining colon words slightly less ugly )
: '>t t' w>t ; : '>t t' w>t ;
: @>t t& @t w>t ; : @>t t& @t w>t ;
: :t DEF [ t& $DOCOLON @t lit ] w>t ; : :t DEF [ t& $DOCOLON lit ] w>t ;
:CP $DODEFERRED :CP $DODEFERRED
INC BX INC BX INC BX INC BX
MOV BX @[ BX] MOV BX @[ BX]
JMP @[ BX] JMP @[ BX]
: DEFERRED DEF [ t& $DODEFERRED lit ] w>t '>t ;
:ASM LIT_ :ASM LIT_
LODSW LODSW
PUSH AX PUSH AX
@ -228,19 +230,6 @@ L: fail-digit 0 <:
PUSH CX PUSH CX
NEXT NEXT
:ASM emit
MOV AH 2 #
POP DX
INT 0x21 #
NEXT
:ASM key
MOV AH 8 #
INT 0x21 #
XOR AH AH
PUSH AX
NEXT
:ASM terminate :ASM terminate
MOV AH 0x4c # MOV AH 0x4c #
MOV AL 0 # ( todo: pop ) MOV AL 0 # ( todo: pop )
@ -268,6 +257,97 @@ L: fail-digit 0 <:
PUSH AX PUSH AX
NEXT NEXT
L: TRUE 0xffff w>t
L: FALSE 0 w>t
L: RETTRUE
PUSH TRUE
NEXT
L: RETFALSE
PUSH FALSE
NEXT
:ASM not
POP AX
CMP AX FALSE
JZ RETTRUE
JMP RETFALSE
:ASM =
POP AX
POP BX
CMP AX BX
JZ RETTRUE
JMP RETFALSE
:ASM <
POP AX
POP BX
CMP AX BX
JL RETTRUE
JMP RETFALSE
:ASM >
POP AX
POP BX
CMP AX BX
JG RETTRUE
JMP RETFALSE
:ASM and
POP AX
POP BX
CMP AX FALSE
JZ RETFALSE
CMP BX FALSE
JZ RETFALSE
JMP RETTRUE
:ASM or
POP AX
POP BX
OR AX BX
JZ RETFALSE
JMP RETTRUE
:t != '>t = '>t not '>t return
:t <= '>t > '>t not '>t return
:t >= '>t < '>t not '>t return
:ASM &
POP AX
POP BX
AND AX BX
PUSH AX
NEXT
:ASM |
POP AX
POP BX
OR AX BX
PUSH AX
NEXT
:ASM ^
POP AX
POP BX
XOR AX BX
PUSH AX
NEXT
:ASM << ( val count )
POP CX
POP AX
SHL AX CL
PUSH AX
NEXT
:ASM >>
POP CX
POP AX
SHR AX CL
PUSH AX
NEXT
:ASM @ :ASM @
POP BX POP BX
MOV AX @[ BX] MOV AX @[ BX]
@ -281,6 +361,13 @@ L: fail-digit 0 <:
PUSH AX PUSH AX
NEXT NEXT
:ASM ub@
POP BX
MOV AL @[ BX]
XOR AH AH
PUSH AX
NEXT
:ASM @far :ASM @far
POP ES POP BX POP ES POP BX
MOV AX @[ ES: BX] MOV AX @[ ES: BX]
@ -354,6 +441,81 @@ L: fail-digit 0 <:
:t segalloc '>t lastseg '>t @ '>t LIT_ 4096 w>t '>t + :t segalloc '>t lastseg '>t @ '>t LIT_ 4096 w>t '>t +
'>t dup '>t lastseg '>t ! '>t return '>t dup '>t lastseg '>t ! '>t return
2 CONST cell
:t allot '>t here '>t + '>t here! '>t return
:t , '>t here '>t ! '>t cell '>t allot '>t return
:t b, '>t here '>t b! '>t LIT_ 1 w>t '>t allot '>t return
:ASM overwrite
MOV AH 0x3c #
XOR CX CX ( non-system, non-hidden )
POP DX ( filename ptr )
INT 0x21 #
PUSH AX
NEXT
:ASM open
MOV AH 0x3d #
MOV AL 2 # ( read/write access, allow child inheritance )
POP DX ( filename ptr )
INT 0x21 #
PUSH AX
NEXT
:ASM close
MOV AH 0x3e #
POP BX
INT 0x21 #
NEXT
0 VAR, fcount
:ASM fread
MOV AH 0x3f #
POP BX ( fp )
POP DX ( buffer )
POP CX ( length )
INT 0x21 #
MOV t& fcount @+ AX ( save number of bytes read )
NEXT
:ASM fwrite
MOV AH 0x40 #
POP BX ( fp )
POP DX ( buffer )
POP CX ( length )
INT 0x21 #
MOV t& fcount @+ AX ( save number of bytes written )
NEXT
-1 CONST EOF
0 VAR, fbuffer
:t fgetc '>t LIT_ 1 w>t '>t fbuffer '>t <rot '>t fread
'>t fbuffer '>t ub@
'>t fcount '>t @ '>t not '>t BZ_ target @ 3 cells + w>t
'>t drop '>t EOF '>t return
:t fputc '>t swap '>t fbuffer '>t b!
'>t LIT_ 1 w>t '>t fbuffer '>t <rot '>t fwrite '>t return
:ASM console-emit
MOV AH 2 #
POP DX
INT 0x21 #
NEXT
DEFERRED emit console-emit
:ASM console-key
MOV AH 8 #
INT 0x21 #
XOR AH AH
PUSH AX
NEXT
0 VAR, infile ( 0 is a predefined file handle meaning stdin )
:t in-key '>t infile '>t @ '>t dup '>t BZ_ target @ 4 cells + w>t
'>t drop '>t console-key '>t return
'>t fgetc '>t return
DEFERRED key in-key
( test program ) ( test program )
ARRAY hex65 key 6 >t key 5 >t 0 >t ARRAY hex65 key 6 >t key 5 >t 0 >t
L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t
@ -373,5 +535,5 @@ target @ t& &here !t
dbg" Program assembled, saving tinyjort.com" dbg" Program assembled, saving tinyjort.com"
s" tinyjort.com" overwrite s" tinyjort.com" overwrite
0x100 target @ :noname for i tseg b@far fputc next ; execute 0x100 target @ :noname for i tseg b@far over fputc next ; execute
close close