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

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
+: 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 -- ) 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* ;

build.bat

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

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;
+	TOP().p = entry;
-        f_codepointer();
+	f_codepointer();
-        f_swap();
+	f_swap();
-        return;
+	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_);

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 #
 
-( 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
 
-.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
 0x100 target @ :noname for i tseg b@far fputc next ; execute
 close