From 4575706684a0621b39510bcf5331ae464bbe073f Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Fri, 1 Sep 2023 19:10:52 -0400 Subject: [PATCH] Assemble to dedicated segment by default, start of Forth kernel rename assembly words to be ALL CAPS --- asm.jrt | 198 +++++++++++++++++++++++++++------------------------ tinyjort.com | Bin 7 -> 217 bytes tinyjort.jrt | 109 ++++++++++++++++++++++++++-- 3 files changed, 208 insertions(+), 99 deletions(-) diff --git a/asm.jrt b/asm.jrt index 9570f6d..3204228 100755 --- a/asm.jrt +++ b/asm.jrt @@ -1,14 +1,21 @@ var target 0x100 target ! -: >t b, 1 target +! ; ( todo: write to target segment ) -: w>t , 2 target +! ; +segalloc const tseg + +: @t tseg @far ; +: b@t tseg b@far ; +: !t tseg !far ; +: b!t tseg b!far ; +: +target! ( bytes -- prevtarget ) target @ dup >rot + target ! ; +: >t 1 +target! b!t ; +: w>t 2 +target! !t ; var op-encode -var lastop +var lastop var lastlabel var op-memwidth -: byteptr 1 op-memwidth ! ; : byteptr? op-memwidth @ 1 = ; -: farptr 4 op-memwidth ! ; : farptr? op-memwidth @ 4 = ; +: BYTE 1 op-memwidth ! ; : byteptr? op-memwidth @ 1 = ; +: FAR 4 op-memwidth ! ; : farptr? op-memwidth @ 4 = ; var current-oparg var opargs-remaining @@ -40,7 +47,7 @@ array oparg2 3 cells allot : byteval? ( v -- f ) 0xff00 & dup 0xff00 = swap 0 = or ; : oparg-bwreg? ( -- f ) byteop? if oparg-breg? else oparg-wreg? then ; -: operror ( err -- ) lastop @ wordname type s" : " type type cr ; +: operror ( err -- ) lastop @ type s" near " type lastlabel @ type s" : " type type cr ; : oparg-complete! opargs-remaining @ dup if 1 - dup opargs-remaining ! @@ -55,54 +62,52 @@ array oparg2 3 cells allot : unexpected-addr ( addr -- ) drop s" unexpected address" operror ; : @+ ( disp -- ) opargs-remaining @ if - oparg-type @ dup 0 = if drop oparg-mem! oparg-complete! + oparg-type @ dup 0 = if drop oparg-mem! @] else 3 = if oparg-val ! else unexpected-addr then then else unexpected-addr then ; -: @far ( offset segment -- ) 4 set-oparg! oparg-base ! ; +: @FAR ( offset segment -- ) 4 set-oparg! oparg-base ! ; : oparg-faraddr? oparg-type @ 4 = ; -: l: create target @ , does> @ @+ ; -: l@ [ ' ' , ] cell + @ ; +: L: here create wordname lastlabel ! target @ , does> @ @+ ; +: L@ [ ' ' , ] 2 cells + @ ; : memreg create , does> @ oparg-base ! oparg-complete! ; -0 memreg bx+si] 1 memreg bx+di] 2 memreg bp+si] 3 memreg bp+di] -4 memreg si] 5 memreg di] 6 memreg bp] 7 memreg bx] +0 memreg BX+SI] 1 memreg BX+DI] 2 memreg BP+SI] 3 memreg BP+DI] +4 memreg SI] 5 memreg DI] 6 memreg BP] 7 memreg BX] : reg create , does> @ oparg-reg! oparg-complete! ; ( data registers: take the bottom four bits and you have the REG and R/M encoding for the modr/m byte ) -0x00 reg ax 0x01 reg cx 0x02 reg dx 0x03 reg bx -0x04 reg sp 0x05 reg bp 0x06 reg si 0x07 reg di +0x00 reg AX 0x01 reg CX 0x02 reg DX 0x03 reg BX +0x04 reg SP 0x05 reg BP 0x06 reg SI 0x07 reg DI ( 8-bit data registers, same scheme ) -0x10 reg al 0x11 reg cl 0x12 reg dl 0x13 reg bl -0x14 reg ah 0x15 reg ch 0x16 reg dh 0x17 reg bh -( segment registers: take the bottom four bits, left shift 1, - and you have the PUSH instruction byte. bitwise or 0x01 and - you have POP.) -0x20 reg es 0x21 reg cs 0x22 reg ss 0x23 reg ds +0x10 reg AL 0x11 reg CL 0x12 reg DL 0x13 reg BL +0x14 reg AH 0x15 reg CH 0x16 reg DH 0x17 reg BH +( segment registers; same scheme, ) +0x20 reg ES 0x21 reg CS 0x22 reg SS 0x23 reg DS -: start-op ( does-ptr argcount -- ) +: start-op ( dictentry argcount -- ) 0 op-memwidth ! ( start unknown ) opargs-remaining @ if s" not enough arguments" operror then - opargs-remaining ! cell - lastop ! arg1 ; + opargs-remaining ! lastop ! arg1 ; : prefix create , does> @ >t ; -: 0op create , does> dup 0 start-op @ >t ; +: 0op here create wordname , b, does> dup @ 0 start-op cell + b@ >t ; -0x26 prefix es: 0x36 prefix ss: 0x2e prefix cs: 0x3e prefix ds: -0xf0 prefix lock 0xf2 prefix repnz 0xf3 prefix repz +0x26 prefix ES: 0x36 prefix SS: 0x2e prefix CS: 0x3e prefix DS: +0xf0 prefix LOCK 0xf2 prefix REPNZ 0xf3 prefix REPZ -0x90 0op nop 0xa4 0op movsb 0xa5 0op movsw 0xa6 0op cmpsb -0xa7 0op cmpsw 0xc3 0op ret 0xd7 0op xlat 0xf4 0op hlt -0x98 0op cbw 0x99 0op cwd 0x9c 0op pushf 0x9d 0op popf -0x9e 0op sahf 0x9f 0op lahf 0xaa 0op stosb 0xab 0op stosw -0xac 0op lodsb 0xad 0op lodsw 0xae 0op scasb 0xaf 0op scasw -0xcb 0op retf 0xce 0op into 0xcf 0op iret 0xf8 0op clc -0xf9 0op stc 0xfa 0op cli 0xfb 0op sti 0xfc 0op cld -0xfd 0op std 0xf5 0op cmc +0x90 0op NOP 0xa4 0op MOVSB 0xa5 0op MOVSW 0xa6 0op CMPSB +0xa7 0op CMPSW 0xc3 0op RET 0xd7 0op XLAT 0xf4 0op HLT +0x98 0op CBW 0x99 0op CWD 0x9c 0op PUSHF 0x9d 0op POPF +0x9e 0op SAHF 0x9f 0op LAHF 0xaa 0op STOSB 0xab 0op STOSW +0xac 0op LODSB 0xad 0op LODSW 0xae 0op SCASB 0xaf 0op SCASW +0xcb 0op RETF 0xce 0op INTO 0xcf 0op IRET 0xf8 0op CLC +0xf9 0op STC 0xfa 0op CLI 0xfb 0op STI 0xfc 0op CLD +0xfd 0op STD 0xf5 0op CMC -: :op ( count -- ) create , $DOCOLON , ] does> - dup @ dup start-op cell + op-encode ! ; +: :op ( count -- ) here create wordname , , $DOCOLON , ] does> + dup @ over cell + @ start-op 2 cells + op-encode ! ; : memarg>case ( -- 0|1|2 ) oparg-base @ dup -1 = if drop 1 ( D16 ) else @@ -112,7 +117,7 @@ array oparg2 3 cells allot oparg-val @ dup 0 = if drop 0 else byteval? if 1 else 2 then then then then ; : memarg>mod+rm ( -- mod rm ) - memarg>case dup 1 = if drop 0 6 else 2 = if 2 6 else + memarg>case dup 1 = if drop 0 6 else 2 = if 1 6 else memarg>dispsize oparg-base @ then then ; : regarg>mod+rm ( -- mod rm ) 3 oparg-val @ ; @@ -131,42 +136,39 @@ array oparg2 3 cells allot oparg-segreg? if oparg-val @ 0x0f & 3 << + >t rdrop else drop then ; : >mem ( reg op -- ) >t memarg>mod+rm modrm>t disp>t swap-args imm?>t ; : >memreg ( op -- ) swap-args oparg-val @ swap-args swap >mem ; -: >mem* oparg-mem? byteop? not and if >mem rdrop else 2drop then ; -: >bmem* oparg-mem? byteop? and if >mem rdrop else 2drop then ; +: >extmem* oparg-mem? byteop? not and if >mem rdrop else 2drop then ; +: >extbmem* oparg-mem? byteop? and if >mem rdrop else 2drop then ; -: >regreg ( reg op -- ) >t regarg>mod+rm modrm>t ; -: >byte-regreg* ( reg op -- ) oparg-breg? if >regreg rdrop else 2drop then ; -: >regreg* ( reg op -- ) oparg-wreg? if >regreg rdrop else 2drop then ; +: >extreg ( reg op -- ) >t regarg>mod+rm modrm>t ; +: >extbreg* ( ext op -- ) oparg-breg? if >extreg rdrop else 2drop then ; +: >extreg* ( ext op -- ) oparg-wreg? if >extreg rdrop else 2drop then ; -1 :op ret- oparg-imm? if oparg-val @ w>t else invalid-args then ; -1 :op push +1 :op RET- oparg-imm? if oparg-val @ w>t else invalid-args then ; +1 :op PUSH 0x50 >wreg+op* 0x06 >segreg+op* - 6 0xff >mem* + 6 0xff >extmem* invalid-args ; -1 :op pop +1 :op POP 0x58 >wreg+op* 0x07 >segreg+op* - 0 0x8f >mem* + 0 0x8f >extmem* invalid-args ; -1 :op inc +1 :op INC 0x40 >wreg+op* - 0 0xfe >byte-regreg* - 0 0xff >regreg* - 0 0xff >mem* + 0 0xfe >extbreg* + 0 0xff >extreg* + 0 0xff >extmem* + 1 0xff >extmem* invalid-args ; -1 :op incb - 0 0xfe >byte-regreg* - 0 0xfe >mem* - invalid-args ; -1 :op dec +1 :op DEC 0x48 >wreg+op* - 1 0xfe >byte-regreg* - 1 0xff >regreg* - 0 0xff >mem* - 1 0xfe >bmem* + 1 0xfe >extbreg* + 1 0xff >extreg* + 1 0xff >extmem* + 1 0xfe >extbmem* invalid-args ; -1 :op int +1 :op INT oparg-imm? if oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then else invalid-args then ; @@ -180,33 +182,37 @@ array oparg2 3 cells allot : >far-jmp* ( op -- ) oparg-faraddr? if >t oparg-base @ w>t oparg-val @ w>t rdrop else drop then ; -1 :op jo 0x70 >short-jmp* invalid-args ; -1 :op jno 0x71 >short-jmp* invalid-args ; -1 :op jb 0x72 >short-jmp* invalid-args ; -1 :op jnb 0x73 >short-jmp* invalid-args ; -1 :op jz 0x74 >short-jmp* invalid-args ; -1 :op jnz 0x75 >short-jmp* invalid-args ; -1 :op jbe 0x76 >short-jmp* invalid-args ; -1 :op ja 0x77 >short-jmp* invalid-args ; -1 :op js 0x78 >short-jmp* invalid-args ; -1 :op jns 0x79 >short-jmp* invalid-args ; -1 :op jpe 0x7a >short-jmp* invalid-args ; -1 :op jpo 0x7b >short-jmp* invalid-args ; -1 :op jl 0x7c >short-jmp* invalid-args ; -1 :op jge 0x7d >short-jmp* invalid-args ; -1 :op jle 0x7e >short-jmp* invalid-args ; -1 :op jg 0x7f >short-jmp* invalid-args ; -1 :op loopnz 0xe0 >short-jmp* invalid-args ; -1 :op loopz 0xe1 >short-jmp* invalid-args ; -1 :op loop 0xe2 >short-jmp* invalid-args ; -1 :op jcxz 0xe3 >short-jmp* invalid-args ; -1 :op jmp +1 :op JO 0x70 >short-jmp* invalid-args ; +1 :op JNO 0x71 >short-jmp* invalid-args ; +1 :op JB 0x72 >short-jmp* invalid-args ; +1 :op JNB 0x73 >short-jmp* invalid-args ; +1 :op JZ 0x74 >short-jmp* invalid-args ; +1 :op JNZ 0x75 >short-jmp* invalid-args ; +1 :op JBE 0x76 >short-jmp* invalid-args ; +1 :op JA 0x77 >short-jmp* invalid-args ; +1 :op JS 0x78 >short-jmp* invalid-args ; +1 :op JNS 0x79 >short-jmp* invalid-args ; +1 :op JPE 0x7a >short-jmp* invalid-args ; +1 :op JPO 0x7b >short-jmp* invalid-args ; +1 :op JL 0x7c >short-jmp* invalid-args ; +1 :op JGE 0x7d >short-jmp* invalid-args ; +1 :op JLE 0x7e >short-jmp* invalid-args ; +1 :op JG 0x7f >short-jmp* invalid-args ; +1 :op LOOPNZ 0xe0 >short-jmp* invalid-args ; +1 :op LOOPZ 0xe1 >short-jmp* invalid-args ; +1 :op LOOP 0xe2 >short-jmp* invalid-args ; +1 :op JCXZ 0xe3 >short-jmp* invalid-args ; +1 :op JMP 0xeb >short-jmp* 0xe9 >near-reljmp* 0xea >far-jmp* + farptr? if 0x05 0xff >extmem* then + 0x04 0xff >extmem* ( todo: JMP to reg allowed ) invalid-args ; -1 :op call +1 :op CALL 0xe8 >near-reljmp* + farptr? if 0x03 0xff >extmem* then + 0x02 0xff >extmem* ( todo: CALL reg allowed ) invalid-args ; ( four opcodes laid out next to each other: @@ -214,8 +220,16 @@ array oparg2 3 cells allot : memreg? ( -- f ) oparg-mem? swap-args oparg-bwreg? swap-args and ; : >bmr-wmr? ( base -- f ) memreg? if byteop? not if 1 + then >memreg 1 else drop 0 then ; +: regreg? oparg-wreg? swap-args oparg-wreg? swap-args and ; +: bregbreg? oparg-breg? swap-args oparg-breg? swap-args and ; +: >regreg ( op -- f ) swap-args oparg-val @ swap swap-args >extreg ; + +: >brr-wrr? ( base -- f ) + regreg? if 1 + else bregbreg? not if drop 0 return then then >regreg 1 ; + : >bmr-wmr-brm-wrm* ( base -- ) dup >bmr-wmr? if drop rdrop return then + dup >brr-wrr? if drop rdrop return then 2 + swap-args >bmr-wmr? swap-args if rdrop then ; : >bmr-wmr-brm-wrm? ( base -- f ) 1 swap >bmr-wmr-brm-wrm* drop 0 ; @@ -226,25 +240,25 @@ array oparg2 3 cells allot oparg-val @ dup 0x10 = if drop >t swap-args imm?>t swap-args rdrop return then 0x00 = if 1 + >t swap-args imm?>t swap-args rdrop return else drop then ; -2 :op xchg +2 :op XCHG arg2 oparg-reg? oparg-val @ 0x00 = arg1 oparg-wreg? and if 0x90 >wreg+op* then invalid-args ; -2 :op mov +2 :op MOV 0x88 >bmr-wmr-brm-wrm* arg2 oparg-imm? arg1 if oparg-wreg? if oparg-val @ 0xb8 | >t arg2 oparg-val @ w>t return then oparg-breg? if oparg-val @ 0x0f & 0xb0 | >t arg2 oparg-val @ >t return then - 0 0xc6 >bmem* - 0 0xc7 >mem* + 0 0xc6 >extbmem* + 0 0xc7 >extmem* then invalid-args ; -2 :op add 0x00 >6group-math* invalid-args ; -2 :op adc 0x10 >6group-math* invalid-args ; +2 :op ADD 0x00 >6group-math* invalid-args ; +2 :op ADC 0x10 >6group-math* invalid-args ; 2 :op AND 0x20 >6group-math* invalid-args ; -2 :op xor 0x30 >6group-math* invalid-args ; +2 :op XOR 0x30 >6group-math* invalid-args ; 2 :op OR 0x08 >6group-math* invalid-args ; -2 :op sbb 0x18 >6group-math* invalid-args ; -2 :op sub 0x28 >6group-math* invalid-args ; -2 :op cmp 0x38 >6group-math* invalid-args ; +2 :op SBB 0x18 >6group-math* invalid-args ; +2 :op SUB 0x28 >6group-math* invalid-args ; +2 :op CMP 0x38 >6group-math* invalid-args ; diff --git a/tinyjort.com b/tinyjort.com index 5020b9203eba60c1eb889af80d9ce01287e1a9e0..77cad5a3c3fc3c8f036d3c6858fd79d55ce1d089 100755 GIT binary patch literal 217 zcmaF)myZDmS{NA^W&<$;!%;8^Vr_=AoSpxhukAeiUmYmQm6DlUl9`{ESX9ZN%E$~- z!M=5~skr!uIR*iR0~jM1890DkXMZ1mKZXFt&N2p9S7+zW zdoWYkic(8Ti}DyIGWz-gCBee!j11gBJua?pu0cVrEt 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t +0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t 0 w>t +L: LATEST 0 w>t + +: savelabel ( word -- ) + here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ; +: DICTLIST ( word -- tptr ) b@ 0x0f & dup . cells [ L@ DICTIONARY lit ] + ; +: strlen ( word -- len ) 0 swap begin dup b@ while swap 1 + swap 1 + repeat drop ; +: str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t drop ; +: link>t ( tptr-head -- ) dup @t swap target @ swap !t w>t ; +: DEF word dup savelabel dup DICTLIST link>t 0 >t dup strlen >t str>t ; + +: WORD= ( word len tptr -- f ) ; +: t' word dup strlen over DICTLIST @t ( word len tptr ) + begin dup @t while 3dup WORD= if 5 + + swap drop return then repeat + drop drop drop 0 ; +; +: :ASM DEF target @ 2 + w>t ; + +L: $$CONST + INC BX INC BX + PUSH @[ BX] + NEXT + +: CONST DEF [ L@ $$CONST lit ] w>t w>t ; + +L@ DICTIONARY CONST dictionary +L@ LATEST CONST latest + +L: $$VAR + INC BX INC BX + PUSH BX + NEXT + +: ARRAY DEF [ L@ $$VAR lit ] w>t ; +: VAR, ARRAY w>t ; + +( "codepointer words" that evaluate to a pointer to the assembly - + useful to define things like $DOCOLON. ) +: :CP ARRAY ; +L@ $$VAR CONST $DOVAR + +:CP $DOCOLON +L: $$COLON + MOV @[ BP] SI + INC BP INC BP + INC BX INC BX + MOV SI BX + NEXT + +:ASM return + DEC BP DEC BP + MOV @[ BP] SI + NEXT + +:CP $DODEFERRED + INC BX INC BX + MOV BX @[ BX] + JMP @[ BX] + +:ASM LIT_ + LODSW + PUSH AX + NEXT + +:ASM GOTO_ + LODSW + MOV SI AX + NEXT + +( 0x1000 target ! ) + +.s -here s" tinyjort.com" overwrite -:noname for i b@ fputc next ; execute +0x100 target @ :noname for i tseg b@far fputc next ; execute close