[bits 32] ; /usr/include/asm/unistd.h %macro pushs 1 ; Pushes something onto the stack lea ebp, [ebp - 4] mov dword [ebp], %1 %endmacro %macro pops 1 ; Pops something from the stack mov dword %1, [ebp] lea ebp, [ebp + 4] %endmacro %define link 0 F_IMMED equ 0x80 F_LENMASK equ 0x1f F_INLINE equ 0x40 %macro defcode 4 ; name, namelen, flags, label section .rodata align 4 global name_%4 name_%4: dd link %define link name_%4 db %2+%3 db %1 align 4 global %4 %4: %endmacro %macro defvar 5 ; name, namelen, flags, label, initial defcode %1, %2, %3, %4 pushs eax mov eax, [var_%4] ret section .data align 4 var_%4: dd %5 %endmacro %macro defconst 5 ; name, namelen, flags, label, value defcode %1, %2, %3, %4 pushs %5 ret %endmacro section .text global _start _start: cld mov ebp, stack_top mov [var_rz],esp finit fldcw [rnd_near] call alloc_dict call quit section .data rnd_trunc: dw 0xfff rnd_near: dw 0x3ff rnd_ceil: dw 0xbff rnd_floor: dw 0x7ff defcode 'lit', 3, 0, lit pushs eax mov ebx, [esp] mov eax, [ebx] add ebx, 4 mov [esp], ebx ret defcode 'drop', 4, F_INLINE, drop pops eax ret defcode 'swap', 4, F_INLINE, swap pops ebx pushs eax mov eax, ebx ret defcode 'dup', 3, F_INLINE, dup pushs eax ret defcode '2drop', 5, F_INLINE, twodrop mov eax, [ebp + 4] lea ebp, [ebp + 8] ret defcode 'over', 4, F_INLINE, over mov ebx,[ebp] pushs eax mov eax, ebx ret defcode '2dup', 4, F_INLINE, twodup mov ebx,[ebp] pushs eax mov eax, ebx mov ebx,[ebp] pushs eax mov eax, ebx ret defcode 'nip', 3, F_INLINE, nip pops ebx ret defcode 'rot', 3, F_INLINE, rot pops ebx pops ecx pushs ebx pushs eax mov eax,ecx ret defcode '-rot', 4, F_INLINE, irot pops ebx pops ecx pushs eax pushs ecx mov eax, ebx ret defcode '+', 1, F_INLINE, plus pops ebx add eax,ebx ret defcode '-', 1, F_INLINE, minus neg eax ret defcode '+-', 2, F_INLINE, plusminus pops ebx sub eax, ebx ret defcode 'not', 3, F_INLINE, lnot not eax ret defcode '1+', 2, F_INLINE, add1 inc eax ret defcode '1-', 2, F_INLINE, sub1 dec eax ret defcode 'under1+', 7, F_INLINE, underadd1 pops ebx inc ebx pushs ebx ret defcode 'under1-', 7, F_INLINE, undersub1 pops ebx dec ebx pushs ebx ret defcode '4+', 2, F_INLINE, add4 add eax, 4 ret defcode '4-', 2, F_INLINE, sub4 sub eax, 4 ret defcode 'under4+', 7, F_INLINE, underadd4 pops ebx sub ebx, -4 pushs ebx ret defcode 'under4-', 7, F_INLINE, undersub4 pops ebx sub ebx, 4 pushs ebx ret defcode '4*', 2, F_INLINE, mul4 sal eax, 2 ret defcode '4/', 2, F_INLINE, div4 sar eax, 2 ret defcode '*', 1, F_INLINE, mult pops ebx imul dword ebx ret defcode '*/', 2, F_INLINE, divmul mov ecx, eax pops ebx pops eax imul dword ebx xor edx, edx idiv ecx ret defcode '/mod', 4, 0, divmod mov ebx, eax pops eax xor edx, edx idiv dword ebx pushs edx ret defcode 'abs', 3, F_INLINE, iabs cmp eax, 0 jge abs_pos neg eax abs_pos: ret ; Morton dilations defcode 'undilate', 8, 0, dilate mov ebx, eax sar ebx, 1 or eax, ebx and eax, 0x33333333 mov ebx, eax sar ebx, 2 or eax, ebx and eax, 0x0f0f0f0f mov ebx, eax sar ebx, 4 or eax, ebx and eax, 0x00ff00ff mov ebx, eax sar ebx, 8 or eax, ebx and eax, 0x0000ffff ret defcode 'dilate', 6, 0, undilate mov ebx, eax sal ebx, 8 or eax, ebx and eax, 0x00ff00ff mov ebx, eax sal ebx, 4 or eax, ebx and eax, 0x0f0f0f0f mov ebx, eax sal ebx, 2 or eax, ebx and eax, 0x33333333 mov ebx, eax sal ebx, 1 or eax, ebx and eax, 0x55555555 ret ; Prints out a number defcode '.', 1, 0, dot push esi push edi mov ebx, eax test ebx, ebx jg dot_pos je dot_zero neg ebx pushs eax mov eax, 45 push ebx call emit pop ebx dot_pos: ; Calculate number of digits (log10 effectivly) ; Uses some bit hacks bsr ecx, ebx inc ecx imul ecx, 1233 sar ecx, 12 inc ecx mov eax, [log10 + ecx * 4] cmp ebx, eax jge dot_pdigs dec ecx dot_pdigs: mov eax, ebx xor edx,edx mov ebx, 10 push ecx dot_split: xor edx, edx idiv ebx add edx, 48 pushs edx loop dot_split pop ecx pops eax dot_emit: push ecx call emit pop ecx loop dot_emit pop edi pop esi ret dot_zero: mov eax, 48 pop edi pop esi jmp emit log10: dd 0 dd 1 dd 10 dd 100 dd 1000 dd 10000 dd 100000 dd 1000000 dd 10000000 dd 100000000 ; Converts to logrep from string ; Implements a little FSM defcode 'lnumber', 7, 0, lnumber push esi push edi pops esi pushs eax mov ecx, eax xor eax, eax xor ebx, ebx xor edi, edi lnumber_whole: test ecx, ecx jz lnumber_whole_terminate lodsb dec ecx cmp al, '+' je lnumber_whole cmp al, '-' je lnumber_whole_neg cmp al, '.' je lnumber_whole_frac cmp al, 'e' je lnumber_whole_exp cmp al, 'E' je lnumber_whole_exp imul ebx, 10 sub al, '0' add ebx, eax jmp lnumber_whole lnumber_whole_neg: inc edi jmp lnumber_whole lnumber_whole_frac: mov [ebp],ebx fild dword [ebp] test edi, edi jz lnumber_frac_init fchs jmp lnumber_frac_init lnumber_whole_exp: mov [ebp],ebx fild dword [ebp] test edi, edi jz lnumber_exp_init fchs jmp lnumber_exp_init lnumber_whole_terminate: mov [ebp],ebx fild dword [ebp] test edi, edi jz lnumber_whole_terminate_pos fchs lnumber_whole_terminate_pos: call tolog call fisteax pop edi pop esi ret lnumber_frac_init: mov edx, 1 xor ebx, ebx lnumber_frac: cmp edx, 1000000000 jge lnumber_frac_long test ecx, ecx jz lnumber_frac_terminate lodsb dec ecx cmp al, 'e' je lnumber_frac_exp cmp al, 'E' je lnumber_frac_exp imul ebx, 10 sub al, '0' add ebx, eax imul edx, 10 jmp lnumber_frac lnumber_frac_exp: mov [ebp],ebx fild dword [ebp] test edi, edi jz lnumber_frac_exp_pos fchs lnumber_frac_exp_pos: mov [ebp], edx fild dword [ebp] fdivp st1 faddp st1 jmp lnumber_exp_init lnumber_frac_terminate: mov [ebp],ebx fild dword [ebp] test edi, edi jz lnumber_frac_terminate_pos fchs lnumber_frac_terminate_pos: mov [ebp], edx fild dword [ebp] fdivp st1 faddp st1 call tolog call fisteax pop edi pop esi ret lnumber_frac_long: test ecx, ecx jz lnumber_frac_terminate lodsb dec ecx cmp al, 'e' je lnumber_frac_exp cmp al, 'E' je lnumber_frac_exp jmp lnumber_frac_long lnumber_exp_init: xor ebx, ebx xor eax, eax xor edi, edi lnumber_exp: test ecx, ecx jz lnumber_exp_terminate lodsb dec ecx cmp al, '+' je lnumber_exp cmp al, '-' je lnumber_exp_neg imul ebx, 10 sub al, '0' add ebx, eax jmp lnumber_exp lnumber_exp_neg: inc edi jmp lnumber_exp lnumber_exp_terminate: mov [ebp],ebx fild dword [ebp] test edi, edi jz lnumber_exp_pos fchs lnumber_exp_pos: fldl2t fmulp fld st0 frndint fsub st1, st0 fxch st1 f2xm1 fld1 fadd fscale fstp st1 fmulp call tolog call fisteax pop edi pop esi ret tolog: ftst push eax xor edx, edx xor ebx, ebx fstsw ax fwait sahf pop eax ja tolog_pos jz tolog_zero mov edx, 0x80000000 fchs tolog_pos: inc ebx fld1 fxch st1 fyl2x fimul dword [var_sfactor] tolog_zero: ret fromlog: fidiv dword [var_sfactor] fld st0 frndint fsub st1, st0 fxch st1 f2xm1 fld1 faddp st1, st0 fscale fstp st1 test edx,edx jz fromlog_pos fchs fromlog_pos: ret fldeax: mov edx, eax and edx, 0x80000000 and eax, 0x7fffffff sub eax, 0x40000000 pushs eax fild dword [ebp] ret fisteax: test ebx, ebx jz fisteax_zero fistp dword [ebp] pops eax add eax, 0x40000000 or eax, edx ret fisteax_zero: fstp st0 pops eax xor eax, eax ret ; Prints out a logrep number defcode 'l.', 2, 0, ldot push esi push edi call fldeax call fromlog ; Sign test edx, edx jz ldot_pos fchs mov eax, 45 call emit pushs eax ldot_pos: fldlg2 fld st1 fyl2x fild dword [floor] fcomip st0, st1 ja ldot_zero ; Catch zeros fild dword [ceil] fcomip st0, st1 jb ldot_inf ; Catch inf fldcw [rnd_floor] frndint fist dword [ebp] mov edx, [ebp] ; exponent base 10 ; Scale number fchs fldl2t fmulp fld st0 frndint fsub st1, st0 fxch st1 f2xm1 fld1 fadd fscale fstp st1 fmulp ; Print first digit fldcw [rnd_trunc] fist dword [ebp] pops eax add eax, 48 push edx call emit pushs eax mov eax, 46 call emit pop edx pushs eax pushs eax ; Print remaining digits mov ecx, [sigdigs] ldot_pdigs: fld st0 frndint fsubp st1 fimul dword [ten] fist dword [ebp] pops eax add eax, 48 push ecx push edx call emit pop edx pop ecx pushs eax pushs eax loop ldot_pdigs pops eax mov eax, 101 push edx call emit pop edx pushs eax mov eax, edx call dot pop edi pop esi fldcw [rnd_near] fstp st0 ret ldot_zero: pops eax pop edi pop esi mov eax, 48 fstp st0 fstp st0 jmp emit ldot_inf: pops eax pop edi pop esi mov eax, 105 call emit pushs eax mov eax, 110 call emit pushs eax mov eax, 102 fstp st0 fstp st0 jmp emit section .data floor: dd -50 ceil: dd 50 ten: dd 10 sigdigs: dd 5 defcode 'l*', 2, 0, lmult pops ebx test eax, 0x7fffffff jz lmult_zero test ebx, 0x7fffffff jz lmult_zero add eax, ebx sub eax, 0x40000000 ret lmult_zero: xor eax, eax ret defcode 'l/', 2, F_INLINE, linv xor eax, 0x7fffffff ret defcode 'l/*', 3, 0, ldiv pops ebx test ebx, 0x7fffffff jz ldiv_zero xor eax, 0x7fffffff add eax, ebx sub eax, 0x40000000 ret ldiv_zero: xor eax, eax ret defcode 'l+', 2, 0, ladd test eax, 0x7fffffff jz ladd_zero mov ebx, [ebp] test ebx, 0x7fffffff jz ladd_zero2 xor ebx, 0x7fffffff add eax, ebx sub eax, 0x40000000 call l1plus pops ebx add eax, ebx sub eax, 0x40000000 ret ladd_zero: pops eax ret ladd_zero2: pops ebx ret defcode 'l-', 2, F_INLINE, lsgn xor eax, 0x80000000 ret defcode 'l-+', 3, 0, lsub test eax, 0x7fffffff jz lsub_zero xor eax, 0x80000000 mov ebx, [ebp] test ebx, 0x7fffffff jz lsub_zero2 xor ebx, 0x7fffffff add eax, ebx sub eax, 0x40000000 call l1plus pops ebx add eax, ebx sub eax, 0x40000000 ret lsub_zero: pops eax ret lsub_zero2: pops ebx ret defcode 'lpow', 4, 0, lpow call fldeax call fromlog fimul dword [pow_factor] fistp dword [ebp] pops ebx pops eax sub eax, 0x40000000 imul eax, ebx xor edx, edx sar eax, 8 add eax, 0x40000000 ret section .data pow_factor: dd 0x100 defcode "l1+", 3, 0, l1plus call fldeax call fromlog fld1 faddp call tolog jmp fisteax defcode 'labs', 4, F_INLINE, labs and eax, 0x7fffffff ret defcode "log", 3, 0, log call fldeax call fromlog fldln2 fxch st1 fyl2x call tolog jmp fisteax defcode "exp", 3, 0, exp call fldeax call fromlog fldl2e fmulp fld st0 frndint fsub st1, st0 fxch st1 f2xm1 fld1 fadd fscale fstp st1 call tolog jmp fisteax defcode 'ilog', 4, F_INLINE, ilog bsr eax,eax ret defcode "ltoi", 4, 0, ltoi call fldeax call fromlog fistp dword [ebp] pops eax ret defcode "itol", 4, 0, itol pushs eax fild dword [ebp] call tolog jmp fisteax defcode 'rnd', 3, 0, rnd call fldeax call fromlog frndint call tolog jmp fisteax defcode '=', 1, F_INLINE, eq pops ebx cmp eax, ebx sete al movzx eax, al ret defcode '!=', 2, F_INLINE, neq pops ebx cmp eax, ebx setne al movzx eax, al ret defcode '<', 1, F_INLINE, lt pops ebx cmp eax, ebx setg al movzx eax, al ret defcode '>', 1, F_INLINE, gt pops ebx cmp eax, ebx setl al movzx eax, al ret defcode '<=', 2, F_INLINE, le pops ebx cmp eax, ebx setge al movzx eax, al ret defcode '>=', 2, F_INLINE, ge pops ebx cmp eax, ebx setle al movzx eax, al ret defcode 'l0=', 3, F_INLINE, lzeq test eax, 0x7fffffff setz al movzx eax, al ret defcode 'l0!=', 4, F_INLINE, lnzeq test eax, 0x7fffffff setnz al movzx eax, al ret defcode '0=', 2, F_INLINE, zeq test eax, eax setz al movzx eax, al ret defcode '0!=', 3, F_INLINE, nzeq test eax, eax setnz al movzx eax, al ret defcode '0<', 2, F_INLINE, zlt test eax, eax setl al movzx eax, al ret defcode '0>', 2, F_INLINE, zgt test eax, eax setg al movzx eax, al ret defcode '0<=', 3, F_INLINE, zle test eax, eax setle al movzx eax, al ret defcode '0>=', 3, F_INLINE, zge test eax, eax setge al movzx eax, al ret defcode 'and', 3, F_INLINE, and pops ebx and eax, ebx ret defcode 'or', 2, F_INLINE, or pops ebx or eax, ebx ret defcode 'xor', 3, F_INLINE, xor pops ebx xor eax, ebx ret defcode '2*', 2, F_INLINE, twotimes sal eax, 1 ret defcode '2/', 2, F_INLINE, twodiv sar eax, 1 ret defcode 'lshift', 6, F_INLINE, lshift shl eax, 1 ret defcode 'rshift', 6, F_INLINE, rshift shr eax, 1 ret defcode 'char', 4, 0, char call rword pops ebx xor eax, eax mov byte al, [ebx] ret defcode '>r', 2, F_INLINE, tor push eax pops eax ret defcode 'a', 2, F_INLINE, toa mov esi, eax pops eax ret defcode 'b', 2, F_INLINE, tob mov edi, eax pops eax ret defcode 'cfa', 4, 0, tcfa add eax, 4 xor ecx, ecx mov byte cl, [eax] inc eax and cl, F_LENMASK add eax, ecx add eax, 3 and eax, ~3 ret defcode 'create', 6, 0, create mov ecx, eax ; nlen push esi push edi pops esi ; str ptr mov edi, [var_here] add edi, 3 and edi, ~3 mov eax, [var_latest] mov [var_latest], edi stosd ; link pointer mov al, cl stosb ; nlen rep movsb ; store name ; pad add edi, 3 and edi, ~3 ; update here mov eax,[var_here] mov [var_here], edi pops eax pop edi pop esi ret defcode ',', 1, 0, comma push edi mov edi,[var_here] stosd mov [var_here], edi pop edi pops eax ret defcode 'c,', 2, 0, commac push edi mov edi,[var_here] stosb mov [var_here], edi pop edi pops eax ret defcode '[', 1, F_IMMED, lbrac mov dword [var_state], 0 ret defcode ']', 1, 0, rbrac mov dword [var_state], 1 ret defcode ':', 1, 0, colon call rword call create jmp rbrac defcode 'exit', 4, 0, exit jmp semicolon defcode 'nop', 3, 0, donothing ret defcode '!h', 2, F_INLINE, writehere mov [var_here], eax pops eax ret ; Tail-call optimised defcode ';', 1, F_IMMED, semicolon push eax push edi mov edi, [var_here] ; if last op was a call convert to jmp lea ebx,[edi - 5] mov byte al, [ebx] cmp al, 0xe8 jne compile_ret inc al mov byte [ebx], al pop edi pop eax jmp lbrac compile_ret: ; compile in a ret call mov al, 0xc3 stosb mov [var_here], edi pop edi pop eax jmp lbrac defcode 39, 1, 0, tick pushs eax mov ebx,[esp] inc ebx mov eax, [ebx] add ebx, 4 mov [esp], ebx add eax, ebx ret defcode ',,', 2, 0, ccomma push edi mov edi,[var_here] sub eax, edi add eax, -5 push eax mov al, 0xe8 stosb pop eax stosd mov [var_here], edi pop edi pops eax ret defcode 'allot', 5, 0, allot mov ebx, [var_here] add eax, ebx mov [var_here],eax pops eax ret defcode 'immediate', 9, F_IMMED, immediate mov ebx, [var_latest] add ebx, 4 mov byte cl, [ebx] add cl, F_IMMED mov byte [ebx], cl ret defcode '@', 1, F_INLINE, get mov ebx, [eax] mov eax, ebx ret defcode '!', 1, F_INLINE, put pops ebx mov [eax], ebx pops eax ret defcode 'c@', 2, F_INLINE, getc mov byte bl, [eax] xor eax, eax mov byte al, bl ret defcode 'c!', 2, F_INLINE, putc pops ebx mov byte [eax], bl pops eax ret defcode 'fsize', 5, 0, fsize mov ebx, eax mov eax, 108 sub esp, 88 ; size of struct mov ecx, esp int 0x80 test eax, eax jnz fsize_fail mov eax, [esp+20] ; size field add esp, 88 ret fsize_fail: mov eax, -1 add esp, 80 ret defcode 'execute', 7, 0, exec mov ebx, eax pops eax jmp ebx ; Radix sort defcode 'sort' , 4, 0, sort push esi push edi mov ebx, 1 push eax ; Convert to offset binary mov esi, [ebp] mov edi, [ebp] mov ecx, [esp] sort_offset: lodsd xor eax, 0x80000000 stosd loop sort_offset sort_again: mov edi, [var_here] ; Copy 0s mov esi, [ebp] mov ecx, [esp] sort_0cpy: lodsd test eax, ebx jnz sort_0cpy_next stosd sort_0cpy_next: loop sort_0cpy ; Copy 1s mov esi, [ebp] mov ecx, [esp] sort_1cpy: lodsd test eax, ebx jz sort_1cpy_next stosd sort_1cpy_next: loop sort_1cpy ; Copy back mov esi, [var_here] mov edi, [ebp] mov ecx, [esp] sort_cpy_back: lodsd stosd loop sort_cpy_back shl ebx, 1 test ebx,ebx jnz sort_again ; Convert from offset binary mov esi, [ebp] mov edi, [ebp] mov ecx, [esp] sort_offset2: lodsd xor eax, 0x80000000 stosd loop sort_offset2 pop ecx pop edi pop esi pops eax pops eax ret defvar 'state', 5, 0, state, 0 defvar 'here', 4, 0, here, 0 defvar 'latest', 6, 0, latest, name_syscall0 defvar 'sfactor', 7, 0, sfactor, 0x00010000 defvar 'sign-bit', 8, 0, sign_bit, 0x80000000 defvar 'exp-bit', 7, 0, exp_bit, 0x40000000 defvar 'inf', 3, 0, inf, 0x7fffffff defvar '-inf', 4, 0, ninf, 0xffffffff defvar 'oddbits', 7, 0, oddbits, 0x55555555 defvar 'evenbits', 8, 0, evenbits, 0xaaaaaaaa ; increases dictionary memory defcode 'brkinc', 6, 0, brkinc xor ebx, ebx mov ecx, eax mov eax, 45 ; brk int 0x80 add eax, ecx mov ebx, eax mov eax, 45 ; brk int 0x80 pops eax ret defcode 'syscall6', 8, 0, syscall6 push eax pops eax pops edi pops esi pops edx pops ecx pops ebx push ebp mov ebp, eax lea eax,[esp + 4] mov eax,[eax] int 0x80 pop ebp pop ebx ret defcode 'syscall3', 8, 0, syscall3 pops edx pops ecx pops ebx int 0x80 ret defcode 'syscall2', 8, 0, syscall2 pops ecx pops ebx int 0x80 ret defcode 'syscall1', 8, 0, syscall1 pops ebx int 0x80 ret defcode 'syscall0', 8, 0, syscall0 int 0x80 ret section .rodata align 4 alloc_dict: xor ebx, ebx mov eax, 45 ; brk int 0x80 mov [var_here], eax add eax, 65536 ; initial data-segment size mov ebx, eax mov eax, 45 ; brk int 0x80 ret section .data var_rz: dd 0 stack: times 128 db 0 stack_top: