more core forth words (memory access, return stack, inline data)

This commit is contained in:
Jeremy Penner 2023-09-01 21:51:22 -04:00
parent be7950520e
commit 141315b6fb
7 changed files with 158 additions and 23 deletions

15
asm.jrt
View file

@ -84,14 +84,10 @@ array patchtable 10 2 cells * allot
: patch-a16 ( tptr targ -- ) swap !t ; : patch-a16 ( tptr targ -- ) swap !t ;
: patch-r16 ( tptr targ -- ) over 2 + - swap !t ; : patch-r16 ( tptr targ -- ) over 2 + - swap !t ;
: patch-r8 ( tptr targ -- ) over 1 + - swap b!t ; : patch-r8 ( tptr targ -- ) over 1 + - swap b!t ;
' patch-a16 dbg" patch-a16" drop : apply-patch ( tptr type -- ) target @ swap execute ;
' patch-r16 dbg" patch-r16" drop
' patch-r8 dbg" patch-r8 " drop
: apply-patch ( tptr type -- ) target @ swap dbg" applying patch" execute ;
: @> ( patchid -- ) 0x13 set-oparg! @] ; : @> ( patchid -- ) 0x13 set-oparg! @] ;
: <: : <: ( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ;
( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ;
: L: here create wordname lastlabel ! target @ , does> @ @+ ; : L: here create wordname lastlabel ! target @ , does> @ @+ ;
: L@ [ ' ' , ] 2 cells + @ ; : L@ [ ' ' , ] 2 cells + @ ;
@ -212,7 +208,7 @@ var ignoreimm
: oparg-nearaddr? ( -- f ) oparg-mem? oparg-base @ -1 = and ; : oparg-nearaddr? ( -- f ) oparg-mem? oparg-base @ -1 = and ;
: >short-jmp* ( op -- ) oparg-nearaddr? if : >short-jmp* ( op -- ) oparg-nearaddr? if
2 diffaddr dup byteval? oparg-mempatch? or 2 diffaddr dup byteval? oparg-mempatch? or
if swap >t ' patch-r8 patchpoint cr >t 2ret then drop if swap >t ' patch-r8 patchpoint >t 2ret then drop
then drop ; then drop ;
: >near-reljmp* ( op -- ) oparg-nearaddr? if : >near-reljmp* ( op -- ) oparg-nearaddr? if
3 diffaddr swap >t ' patch-r16 patchpoint w>t 2ret then drop ; 3 diffaddr swap >t ' patch-r16 patchpoint w>t 2ret then drop ;
@ -299,7 +295,7 @@ var ignoreimm
then swap-args 'extregmem 1 ignoreimm ! *? 0 ignoreimm ! if 2ret then ; then swap-args 'extregmem 1 ignoreimm ! *? 0 ignoreimm ! if 2ret then ;
2 :op XCHG 2 :op XCHG
arg2 oparg-reg? oparg-val @ 0x00 = arg1 oparg-wreg? and arg2 oparg-reg? oparg-val @ 0x00 = and arg1 oparg-wreg? and
if 0x90 >wreg+op* then if 0x90 >wreg+op* then
0x86 >bar-war* ; 0x86 >bar-war* ;
2 :op MOV 2 :op MOV
@ -309,7 +305,8 @@ var ignoreimm
oparg-breg? if oparg-val @ 0x0f & 0xb0 | >t arg2 oparg-val @ >t return then oparg-breg? if oparg-val @ 0x0f & 0xb0 | >t arg2 oparg-val @ >t return then
0 0xc6 >extbmem* 0 0xc6 >extbmem*
0 0xc7 >extmem* 0 0xc7 >extmem*
then ; then
oparg-segreg? if oparg-val @ 0x8e arg2 >extwreg|mem* arg1 then ;
2 :op ADD 0x00 >6group-math* 0 >grp1* ; 2 :op ADD 0x00 >6group-math* 0 >grp1* ;
2 :op ADC 0x10 >6group-math* 2 >grp1* ; 2 :op ADC 0x10 >6group-math* 2 >grp1* ;
2 :op AND 0x20 >6group-math* 4 >grp1* ; 2 :op AND 0x20 >6group-math* 4 >grp1* ;

2
build.bat Executable file
View file

@ -0,0 +1,2 @@
minijort < tinyjort.jrt

View file

@ -5,6 +5,7 @@
#include <sys/stat.h> #include <sys/stat.h>
#include <dos.h> #include <dos.h>
#include <dir.h> #include <dir.h>
#include <alloc.h>
#include "minijort.h" #include "minijort.h"
#define STACK_OFFSET 0 #define STACK_OFFSET 0
@ -517,10 +518,10 @@ void f_lookup() { // name -- (codepointer flags) | (name 0)
f_wordname(); f_wordname();
f_streq(); f_streq();
if (TOP().i) { if (TOP().i) {
TOP().p = entry; TOP().p = entry;
f_codepointer(); f_codepointer();
f_swap(); f_swap();
return; return;
} }
DROP(2); DROP(2);
} else { } else {
@ -796,6 +797,10 @@ void f_segalloc() {
unsigned long linearaddr = ((unsigned long)FP_SEG(ptr) << 4) + unsigned long linearaddr = ((unsigned long)FP_SEG(ptr) << 4) +
((unsigned long)FP_OFF(ptr)); ((unsigned long)FP_OFF(ptr));
int segment = ((linearaddr & 0x000ffff0UL) >> 4); int segment = ((linearaddr & 0x000ffff0UL) >> 4);
if (ptr == NULL) {
exit(1);
}
PUSHI(segment); PUSHI(segment);
} }
@ -836,7 +841,6 @@ void f_init() {
CDEF("!=", f_neq); CDEF("!=", f_neq);
CDEF(">=", f_ge); CDEF(">=", f_ge);
CDEF(">", f_gt); CDEF(">", f_gt);
CDEF("=", f_eq);
CDEF("<", f_lt); CDEF("<", f_lt);
CDEF("<=", f_le); CDEF("<=", f_le);
CDEF("u>=", f_uge); CDEF("u>=", f_uge);
@ -872,7 +876,6 @@ void f_init() {
CDEF("r@", f_rtop); CDEF("r@", f_rtop);
CDEF("rdrop", f_rdrop); CDEF("rdrop", f_rdrop);
CDEF("rswap", f_rswap); CDEF("rswap", f_rswap);
CDEF("fputc", f_fputc);
CDEF("gets", f_gets); CDEF("gets", f_gets);
CDEF("number", f_number); CDEF("number", f_number);
CDEF("LIT_", f_lit_); CDEF("LIT_", f_lit_);

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -1,6 +1,8 @@
s" defs.jrt" loadfile s" defs.jrt" loadfile
dbg" loading asm.jrt"
s" asm.jrt" loadfile s" asm.jrt" loadfile
dbg" assembling..."
( tinyjort calling convention: ( tinyjort calling convention:
SP - data stack pointer, grows down SP - data stack pointer, grows down
BP - return stack pointer, grows up BP - return stack pointer, grows up
@ -54,6 +56,7 @@ L: LATEST 0 w>t
: t' word dup strlen over DICTLIST ( word len tptr-next-entry ) : t' word dup strlen over DICTLIST ( word len tptr-next-entry )
begin dup while 3dup WORD= if 5 + + swap drop return then @t repeat begin dup while 3dup WORD= if 5 + + swap drop return then @t repeat
drop drop drop 0 ; drop drop drop 0 ;
: t& t' cell + ;
: :ASM DEF target @ 2 + w>t ; : :ASM DEF target @ 2 + w>t ;
@ -65,7 +68,7 @@ L: $$CONST
: CONST DEF [ L@ $$CONST lit ] w>t w>t ; : CONST DEF [ L@ $$CONST lit ] w>t w>t ;
L@ DICTIONARY CONST dictionary L@ DICTIONARY CONST dictionary
L@ LATEST CONST latest L@ LATEST CONST &latest
L: $$VAR L: $$VAR
INC BX INC BX INC BX INC BX
@ -81,7 +84,6 @@ L: $$VAR
L@ $$VAR CONST $DOVAR L@ $$VAR CONST $DOVAR
:CP $DOCOLON :CP $DOCOLON
L: $$COLON
MOV @[ BP] SI MOV @[ BP] SI
INC BP INC BP INC BP INC BP
INC BX INC BX INC BX INC BX
@ -93,6 +95,11 @@ L: $$COLON
MOV @[ BP] SI MOV @[ BP] SI
NEXT NEXT
( some helpers for making manually defining colon words slightly less ugly )
: '>t t' w>t ;
: @>t t& @t w>t ;
: :t DEF [ t& $DOCOLON @t lit ] w>t ;
:CP $DODEFERRED :CP $DODEFERRED
INC BX INC BX INC BX INC BX
MOV BX @[ BX] MOV BX @[ BX]
@ -103,6 +110,12 @@ L: $$COLON
PUSH AX PUSH AX
NEXT NEXT
:ASM INLINEDATA_
LODSW
PUSH SI
MOV SI AX
NEXT
:ASM BZ_ :ASM BZ_
POP CX POP CX
JCXZ 0 @> JCXZ 0 @>
@ -221,24 +234,144 @@ L: fail-digit 0 <:
INT 0x21 # INT 0x21 #
NEXT 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 )
INT 0x21 # INT 0x21 #
( test program ) :ASM execute
ARRAY hex65 key 0 >t key x >t key 6 >t key 5 >t 0 >t POP BX
L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t JMP @[ BX]
0x101 @t . :ASM +
9 <: ( actual entry point ) POP AX POP BX
0x101 @t . ADD AX BX
LEA SI test-word PUSH AX
( TODO: configure stacks )
NEXT NEXT
.s :ASM -
POP BX POP AX
SUB AX BX
PUSH AX
NEXT
:ASM *
POP BX POP AX
IMUL BX
PUSH AX
NEXT
:ASM @
POP BX
MOV AX @[ BX]
PUSH AX
NEXT
:ASM b@
POP BX
MOV AL @[ BX]
CBW
PUSH AX
NEXT
:ASM @far
POP ES POP BX
MOV AX @[ ES: BX]
PUSH AX
NEXT
:ASM b@far
POP ES POP BX
MOV AL @[ ES: BX]
CBW
PUSH AX
NEXT
:ASM !
POP BX POP AX
MOV @[ BX] AX
NEXT
:ASM b!
POP BX POP AX
MOV @[ BX] AL
NEXT
:ASM !far
POP ES POP BX POP AX
MOV @[ ES: BX] AX
NEXT
:ASM b!far
POP ES POP BX POP AX
MOV @[ ES: BX] AL
NEXT
:ASM >r
POP AX
MOV @[ BP] AX
INC BP INC BP
NEXT
:ASM <r
DEC BP DEC BP
MOV AX @[ BP]
PUSH AX
NEXT
:ASM r@
MOV AX @[ -2 @+ BP]
PUSH AX
NEXT
:ASM rdrop
DEC BP DEC BP
NEXT
:ASM rswap
MOV AX @[ -2 @+ BP]
MOV BX @[ -4 @+ BP]
MOV @[ -2 @+ BP] BX
MOV @[ -4 @+ BP] AX
NEXT
0 VAR, &here
:t here '>t &here '>t @ '>t return
:t here! '>t &here '>t ! '>t return
0xffff CONST there
:t latest '>t &latest '>t @ '>t return
:t latest! '>t &latest '>t ! '>t return
0 VAR, lastseg
:t segalloc '>t lastseg '>t @ '>t LIT_ 4096 w>t '>t +
'>t dup '>t lastseg '>t ! '>t return
( test program )
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
9 <: ( actual entry point )
LEA SI test-word
PUSH CS
POP AX
ADD AX 4096 #
MOV SS AX
MOV t& lastseg @+ AX
MOV SP 0xfe #
MOV BP 0x00 #
NEXT
target @ t& &here !t
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 fputc next ; execute
close close