Still Trying to Meta-compile ════════════════════════════ October 14, 2023 Meta-compilation ════════════════ • Building a Forth from within another Forth • Generate an image of the new Forth • As much as possible write the new Forth in Forth Meta-compiler vs Cross-compiler ═══════════════════════════════ • Is a Meta-compiler a Cross-compiler? • Outside Forth a meta-compiler sometimes refers to lexer/parser generators like lex/yacc - Forth's coinage considered odd • Forth meta-compilers often cannot target other architectures easily • Frequently have leaky assumptions about things like dictionary format • How "hermetic" is often where I get stuck Dictionaries ════════════ • Meta-compilers have to deal with words in both host and target • Need for immediate words run on the host • High potential for host target collisions • Vocabularies can help resolve this, but they add a lot of complexity • Simpler vocabulary scheme's like Chuck's FORTH + MACRO dictionaries are appealing Repetition ══════════ • IMMEDIATE words often need to be used in both host and target • LOAD / INCLUDE source twice? • How to clean up? - FORGET the whole thing? - Trash the current system? My Goals ════════ • An x86-64 subroutine threaded target • Wrap in an ELF executable (Linux) • Probably use source instead of blocks • Avoid relying on vocabularies My "Plan" ═════════ • Define a start marker • Compile immediate / assembling words into host • Define an alternate FIND • Define an alternate : and ] • Compile immediate / assembling words into target • Compile normal words into target • Write out the new image • FORGET everything back to the marker Assembling x64 ══════════════ • I'm too lazy to write a whole x64 assembler • Focus on just what's needed for the core • Optimize moving the stack pointer Register Assignment ═══════════════════ RBP - Data stack pointer RSP - Return stack pointer RBX - Top of stack Linux System Calls ══════════════════ RAX - Function number RDI, RSI, RDX, R10, R8, R9 - Arguments Call Examples ═════════════ RAX=60, RDI=result - exit RAX=1, RDI=file#, RSI=buffer, RDX=count - write x64 Instructions ════════════════ Legacy - CS: DS: LOCK REP etc. REX - Register extension Opcode - Sometimes multi-byte ModR/M - Address mode SIB - Scale / index / base Immediate - 1-8 bytes REX OP ModR/M Immediate 48 89 5d 20 mov %rbx,0x20(%rbp) REX PREFIX ══════════ 0 1 0 0 w r x b - - - - - - - - w = width (64-bit) r = ModR/M extra bit x = SIB Index extra bit b = SIB or ModR/M Base extra bit : rex.W $48 c, ; : ++rsp rex.W $83 c, $c4 c, $08 c, ( add $0x8,%rsp ) ; : rsp+! ( n -- ) rex.W $81 c, $c4 c, ,4 ( add $n32,%rsp ) ; variable offset : rbp+= ( n -- ) dup negate offset +! rex.W $83 c, $c5 c, c, ( add $n,%rbp ) ; : rbp-= ( n -- ) dup offset +! rex.W $83 c, $ed c, c, ( sub $n,%rbp ) ; : offset@ ( -- n ) offset @ ; : offset@- ( -- n ) offset @ 8 - ; : balance offset@ 0< if offset@ negate rbp-= then offset@ 0> if offset@ rbp+= then ; : ++rbp 8 offset +! offset@ 120 >= if balance then ; : --rbp -8 offset +! offset@ -120 <= if balance then ; : drop0 $31 c, $db c, ( xor %ebx,%ebx ) ; : cmp0 rex.W $83 c, $fb c, $00 c, ( cmp $0x0,%rbx ) ; : past>tos rex.W $8b c, $5d c, $08 c, ( mov 0x8[%rbp],%rbx ) ; : nip ( a b -- b ) --rbp ; : dup' ( n -- n n ) ++rbp rex.W $89 c, $5d c, offset@ c, ( mov %rbx,o+0x0[%rbp] ) ; : 1+ ( n -- n ) rex.W $ff c, $c3 c, ( inc %rbx ) ; : 1- ( n -- n ) rex.W $ff c, $cb c, ( dec %rbx ) ; : drop ( n -- ) rex.W $8b c, $5d c, offset@ c, ( mov o+0x0[%rbp],%rbx ) nip ; : dup ( n -- n n ) dup' ; : over ( n -- n n ) ++rbp rex.W $89 c, $5d c, offset@- c, ( mov %rbx,-0x8[%rbp] ) ; : rdrop ( a b -- b ) rex.W $83 c, $ec c, $08 c, ( sub $0x8,%rsp ) ; : push ( n -- r: n ) ++rsp rex.W $89 c, $1c c, $24 c, ( mov %rbx,[%rsp] ) drop ; : pop ( r: n -- n ) dup rex.W $8b c, $1c c, $24 c, ( mov [%rsp],%rbx ) rdrop ; : + ( n n -- n ) rex.W $03 c, $5d c, offset@ c, ( add o+0x0[%rbp],%rbx ) nip ; : - ( n n -- n ) rex.W $2b c, $5d c, offset@ c, ( sub o+0x0[%rbp],%rbx ) nip ; : * ( n n -- n ) rex.W $0f c, $af c, $5d c, offset@ c, ( imul o+0x0[%rbp],%rbx ) nip ; : and ( n n -- n ) rex.W $23 c, $5d c, offset@ c, ( and o+0x0[%rbp],%rbx ) nip ; : or ( n n -- n ) rex.W $0b c, $5d c, offset@ c, ( or o+0x0[%rbp],%rbx ) nip ; : xor ( n n -- n ) rex.W $33 c, $5d c, offset@ c, ( xor o+0x0[%rbp],%rbx ) nip ; : invert ( n -- n ) rex.W $f7 c, $d3 c, ( not %rbx ) ; : negate ( n -- n ) rex.W $f7 c, $db c, ( neg %rbx ) ; : 0= ( n -- n ) cmp0 drop0 $0f c, $9c c, $c3 c, ( setl %bl ) negate ; : 0< ( n -- n ) cmp0 drop0 $0f c, $94 c, $c3 c, ( sete %bl ) negate ; : exit balance $c3 c, ; : nop $90 c, ; : @ ( a -- n ) rex.W $8b c, $1b c, ( mov [%rbx],%rbx ) ; : ! ( n a -- ) rex.W $8b c, $4d c, offset@ c, ( mov o+0x0[%rbp],%rcx ) rex.W $89 c, $0b c, ( mov %rcx,[%rbx] ) nip drop ; : c@ ( a -- ch ) rex.W $0f c, $b6 c, $1b c, ( movzbq [%rbx],%rbx ) : c! ( ch a -- ) $8a c, $4d c, offset@ c, ( mov o+0x0[%rbp],%cl ) $88 c, $0b c, ( mov %cl,[%rbx] ) ; : aliteral32u ( n -- ) dup' $bb c, ,4 ( mov $n32,%ebx ) ; : aliteral32s ( n -- ) dup' rex.W $c7 c, $c3 c, ,4 ( mov $n32, %rbx ) ; : aliteral64 ( n -- ) dup' rex.W $bb c, ,8 ( movabs $n64,%rbx ) ; : aliteral ( n -- ) dup dup $ffffffff and = if aliteral32u else dup negate $80000000 < if aliteral32s else aliteral64 then then ; : begin balance here ; : again balance $eb c, here 1+ - c, ; : ahead balance $eb c, here 0 c, ; : then balance here over 1+ - swap c! ; : until ( n -- ) nip balance cmp0 past>tos $74 c, here 1+ - c, ; : if ( n -- ) nip balance cmp0 past>tos $74 c, here 0 c, ; : syscall ( n n n n n n - n ) balance rex.W $89 c, $d8 c, ( mov %rbx,%rax ) $4c c, $8b c, $4d c, $00 c, ( mov 0x0[%rbp],%r9 ) $4c c, $8b c, $45 c, $F8 c, ( mov -0x8[%rbp],%r8 ) $4c c, $8b c, $55 c, $F0 c, ( mov -0x10[%rbp],%r10 ) rex.W $8b c, $55 c, $E8 c, ( mov -0x18[%rbp],%rdx ) rex.W $8b c, $75 c, $E0 c, ( mov -0x20[%rbp],%rsi ) rex.W $8b c, $7d c, $D8 c, ( mov -0x28[%rbp],%rdi ) rex.W $83 c, $ed c, $30 c, ( sub $0x30,%rbp ) $0f c, 05 c, ( syscall ) rex.W $89 c, $c3 c, ( mov %rax,%rbx ) ; : elf-magic $7f c, [char] E c, [char] L c, [char] F c, 2 c, ( ELFCLASS64) 1 c, ( ELFDATA2LSB ) 1 c, ( EV_CURRENT ) 3 c, ( ELFOSABI_LINUX ) 0, ( ABI version ) 0, 0, 0, 0, 0, 0, 0, ( EI_PAD ) ; : elf-header elf-magic 2 ,2 ( e_type = ET_EXEC ) 62 ,2 ( e_machine = EM_X86_64 ) 1 ,4 ( e_version = EV_CURRENT ) entry-addr ,8 ( e_entry = offset to entry below ) $40 ,8 ( e_phoff = offset to program header below ) 0 ,8 ( e_shoff, no section header ) 0 ,4 ( e_flags ) $40 ,2 ( e_ehdrsize = size of main header ) $38 ,2 ( e_phentsize = header size below ) 1 ,2 ( e_phnum = 1 entry below ) 0 ,2 ( e_shentsize ) 0 ,2 ( e_shnum ) 0 ,2 ( e_shstrndx ) ; : program-header 1 ,4 ( p_type = PT_LOAD ) 7 ,4 ( p_flags = PF_X | PF_W | PF_R ) 0 ,8 ( p_offset ) $400000 ,8 ( p_vaddr ) $400000 ,8 ( p_paddr ) $100000 ,8 ( p_filesz ) $100000 ,8 ( p_memsz ) 0 ,8 ( p_align ) ; start-image elf-header program-header ( START ) init 1 aliteral $400000 aliteral 3 aliteral 0 aliteral 0 aliteral 0 aliteral 1 aliteral syscall drop 42 aliteral 0 aliteral 0 aliteral 0 aliteral 0 aliteral 0 aliteral 60 aliteral syscall drop end-image bye DEMO Dictionary ══════════ • Needs to at least support macros + forth words • Conventional linked dictionary mixes code + data • Use pairs of (word-hash, address) • Use a (0, 0) marker at the top : hash ( a n -- n ) 71 >r begin dup while swap dup c@ >r 1+ swap 1- r> r> 31 * + >r repeat 2drop r> ; : find ( a n dct -- xt ) >r hash r> begin dup @ while 2dup @ = if cell+ @ nip exit then 2 cells - repeat ; variable regular variable macros variable current : +word ( nm adr -- ) 2 cells current @ +! current @ @ cell+ ! current @ @ ! ; create dict here regular ! 0 , 0 , 100 cells allot here macros ! 0 , 0 , 100 cells allot regular current ! : header bl parse hash here +word ; : >number ( a n -- n ) 0 >r begin dup while swap dup c@ [char] 0 - r> base @ * + >r 1+ swap 1- repeat 2drop r> ; : ] begin bl parse 2dup macros @ find if >r 2drop r> execute else regular @ find if >r 2drop r> $e8 here 1+ - ,4 else >number then then again ; Order Challenge ═══════════════ • On host should use host macros, but compile for target • So ] may have to have two versions? • The ordering + name clashes seem so brittle... That's it for now... Still need a better name! ═════════════════════════ • Was going call it "wisp", but is already taken • Suggestions? QUESTIONS❓ 🙏 Thank you!