more core forth words (memory access, return stack, inline data)
This commit is contained in:
parent
be7950520e
commit
141315b6fb
15
asm.jrt
15
asm.jrt
|
|
@ -84,14 +84,10 @@ array patchtable 10 2 cells * allot
|
|||
: patch-a16 ( tptr targ -- ) swap !t ;
|
||||
: patch-r16 ( tptr targ -- ) over 2 + - swap !t ;
|
||||
: patch-r8 ( tptr targ -- ) over 1 + - swap b!t ;
|
||||
' patch-a16 dbg" patch-a16" drop
|
||||
' patch-r16 dbg" patch-r16" drop
|
||||
' patch-r8 dbg" patch-r8 " drop
|
||||
: apply-patch ( tptr type -- ) target @ swap dbg" applying patch" execute ;
|
||||
: apply-patch ( tptr type -- ) target @ swap execute ;
|
||||
|
||||
: @> ( 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@ [ ' ' , ] 2 cells + @ ;
|
||||
|
|
@ -212,7 +208,7 @@ var ignoreimm
|
|||
: oparg-nearaddr? ( -- f ) oparg-mem? oparg-base @ -1 = and ;
|
||||
: >short-jmp* ( op -- ) oparg-nearaddr? if
|
||||
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 ;
|
||||
: >near-reljmp* ( op -- ) oparg-nearaddr? if
|
||||
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 ;
|
||||
|
||||
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
|
||||
0x86 >bar-war* ;
|
||||
2 :op MOV
|
||||
|
|
@ -309,7 +305,8 @@ var ignoreimm
|
|||
oparg-breg? if oparg-val @ 0x0f & 0xb0 | >t arg2 oparg-val @ >t return then
|
||||
0 0xc6 >extbmem*
|
||||
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 ADC 0x10 >6group-math* 2 >grp1* ;
|
||||
2 :op AND 0x20 >6group-math* 4 >grp1* ;
|
||||
|
|
|
|||
15
minijort.c
15
minijort.c
|
|
@ -5,6 +5,7 @@
|
|||
#include <sys/stat.h>
|
||||
#include <dos.h>
|
||||
#include <dir.h>
|
||||
#include <alloc.h>
|
||||
#include "minijort.h"
|
||||
|
||||
#define STACK_OFFSET 0
|
||||
|
|
@ -517,10 +518,10 @@ void f_lookup() { // name -- (codepointer flags) | (name 0)
|
|||
f_wordname();
|
||||
f_streq();
|
||||
if (TOP().i) {
|
||||
TOP().p = entry;
|
||||
f_codepointer();
|
||||
f_swap();
|
||||
return;
|
||||
TOP().p = entry;
|
||||
f_codepointer();
|
||||
f_swap();
|
||||
return;
|
||||
}
|
||||
DROP(2);
|
||||
} else {
|
||||
|
|
@ -796,6 +797,10 @@ void f_segalloc() {
|
|||
unsigned long linearaddr = ((unsigned long)FP_SEG(ptr) << 4) +
|
||||
((unsigned long)FP_OFF(ptr));
|
||||
int segment = ((linearaddr & 0x000ffff0UL) >> 4);
|
||||
if (ptr == NULL) {
|
||||
exit(1);
|
||||
}
|
||||
|
||||
PUSHI(segment);
|
||||
}
|
||||
|
||||
|
|
@ -836,7 +841,6 @@ void f_init() {
|
|||
CDEF("!=", f_neq);
|
||||
CDEF(">=", f_ge);
|
||||
CDEF(">", f_gt);
|
||||
CDEF("=", f_eq);
|
||||
CDEF("<", f_lt);
|
||||
CDEF("<=", f_le);
|
||||
CDEF("u>=", f_uge);
|
||||
|
|
@ -872,7 +876,6 @@ void f_init() {
|
|||
CDEF("r@", f_rtop);
|
||||
CDEF("rdrop", f_rdrop);
|
||||
CDEF("rswap", f_rswap);
|
||||
CDEF("fputc", f_fputc);
|
||||
CDEF("gets", f_gets);
|
||||
CDEF("number", f_number);
|
||||
CDEF("LIT_", f_lit_);
|
||||
|
|
|
|||
BIN
minijort.exe
BIN
minijort.exe
Binary file not shown.
BIN
minijort.prj
BIN
minijort.prj
Binary file not shown.
BIN
tinyjort.com
BIN
tinyjort.com
Binary file not shown.
149
tinyjort.jrt
149
tinyjort.jrt
|
|
@ -1,6 +1,8 @@
|
|||
s" defs.jrt" loadfile
|
||||
dbg" loading asm.jrt"
|
||||
s" asm.jrt" loadfile
|
||||
|
||||
dbg" assembling..."
|
||||
( tinyjort calling convention:
|
||||
SP - data stack pointer, grows down
|
||||
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 )
|
||||
begin dup while 3dup WORD= if 5 + + swap drop return then @t repeat
|
||||
drop drop drop 0 ;
|
||||
: t& t' cell + ;
|
||||
|
||||
: :ASM DEF target @ 2 + w>t ;
|
||||
|
||||
|
|
@ -65,7 +68,7 @@ L: $$CONST
|
|||
: CONST DEF [ L@ $$CONST lit ] w>t w>t ;
|
||||
|
||||
L@ DICTIONARY CONST dictionary
|
||||
L@ LATEST CONST latest
|
||||
L@ LATEST CONST &latest
|
||||
|
||||
L: $$VAR
|
||||
INC BX INC BX
|
||||
|
|
@ -81,7 +84,6 @@ L: $$VAR
|
|||
L@ $$VAR CONST $DOVAR
|
||||
|
||||
:CP $DOCOLON
|
||||
L: $$COLON
|
||||
MOV @[ BP] SI
|
||||
INC BP INC BP
|
||||
INC BX INC BX
|
||||
|
|
@ -93,6 +95,11 @@ L: $$COLON
|
|||
MOV @[ BP] SI
|
||||
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
|
||||
INC BX INC BX
|
||||
MOV BX @[ BX]
|
||||
|
|
@ -103,6 +110,12 @@ L: $$COLON
|
|||
PUSH AX
|
||||
NEXT
|
||||
|
||||
:ASM INLINEDATA_
|
||||
LODSW
|
||||
PUSH SI
|
||||
MOV SI AX
|
||||
NEXT
|
||||
|
||||
:ASM BZ_
|
||||
POP CX
|
||||
JCXZ 0 @>
|
||||
|
|
@ -221,24 +234,144 @@ L: fail-digit 0 <:
|
|||
INT 0x21 #
|
||||
NEXT
|
||||
|
||||
:ASM key
|
||||
MOV AH 8 #
|
||||
INT 0x21 #
|
||||
XOR AH AH
|
||||
PUSH AX
|
||||
NEXT
|
||||
|
||||
:ASM terminate
|
||||
MOV AH 0x4c #
|
||||
MOV AL 0 # ( todo: pop )
|
||||
INT 0x21 #
|
||||
|
||||
:ASM execute
|
||||
POP BX
|
||||
JMP @[ BX]
|
||||
|
||||
:ASM +
|
||||
POP AX POP BX
|
||||
ADD AX BX
|
||||
PUSH AX
|
||||
NEXT
|
||||
|
||||
: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 0 >t key x >t 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
|
||||
|
||||
0x101 @t .
|
||||
9 <: ( actual entry point )
|
||||
0x101 @t .
|
||||
LEA SI test-word
|
||||
( TODO: configure stacks )
|
||||
NEXT
|
||||
PUSH CS
|
||||
POP AX
|
||||
ADD AX 4096 #
|
||||
MOV SS AX
|
||||
MOV t& lastseg @+ AX
|
||||
MOV SP 0xfe #
|
||||
MOV BP 0x00 #
|
||||
NEXT
|
||||
|
||||
.s
|
||||
target @ t& &here !t
|
||||
|
||||
dbg" Program assembled, saving tinyjort.com"
|
||||
s" tinyjort.com" overwrite
|
||||
0x100 target @ :noname for i tseg b@far fputc next ; execute
|
||||
close
|
||||
|
|
|
|||
Loading…
Reference in a new issue