diff options
Diffstat (limited to 'forth.s')
| -rw-r--r-- | forth.s | 1712 |
1 files changed, 1712 insertions, 0 deletions
@@ -0,0 +1,1712 @@ +[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 '<r', 2, F_INLINE, fromr + pushs eax + pop eax + ret + +defcode '>a', 2, F_INLINE, toa + mov esi, eax + pops eax + ret + +defcode '<a', 2, F_INLINE, froma + pushs eax + mov eax, esi + ret + +defcode '@a', 2, F_INLINE, ata + pushs eax + mov eax, [esi] + ret + +defcode '!a', 2, F_INLINE, puta + mov [esi], eax + pops eax + ret + +defcode 'c@a', 3, F_INLINE, cata + pushs eax + xor eax, eax + mov al, [esi] + ret + +defcode 'c!a', 3, F_INLINE, putca + mov [esi], al + pops eax + ret + +defcode '@+', 2, F_INLINE, getinca + pushs eax + lodsd + ret + +defcode 'c@+', 3, F_INLINE, getcinca + pushs eax + xor eax, eax + lodsb + ret + +defcode '>b', 2, F_INLINE, tob + mov edi, eax + pops eax + ret + +defcode '<b', 2, F_INLINE, fromb + pushs eax + mov eax, edi + ret + +defcode '@b', 2, F_INLINE, atb + pushs eax + mov eax, [edi] + ret + +defcode '!b', 2, F_INLINE, putb + mov [edi], eax + pops eax + ret + +defcode 'c@b', 3, F_INLINE, atcb + pushs eax + xor eax, eax + mov al, [edi] + ret + +defcode 'c!b', 3, F_INLINE, putcb + mov [edi], al + pops eax + ret + +defcode '!+', 2, F_INLINE, putincb + stosd + pops eax + ret + +defcode 'c!+', 3, F_INLINE, puctincb + stosb + pops eax + ret + +defcode '+!', 2, F_INLINE, addput + pops ebx + mov ecx, [eax] + add ecx, ebx + mov [eax], ecx + pops eax + ret + +defcode 'b+', 2, F_INLINE, incb + inc edi + ret + +defcode 'a+', 2, F_INLINE, inca + inc esi + ret + +defcode 'memcpy', 6, 0, memcpy + mov ecx, eax +memcpy_loop: + lodsd + stosd + loop memcpy_loop + pops eax + ret + +defcode 'branch', 6, 0, branch + mov ebx,[esp] + mov ecx, [ebx] + mov [esp], ecx + ret + +defcode '0branch', 7, 0, nbranch + test eax,eax + pops eax + jz branch + mov ebx, [esp] + add ebx, 4 + mov [esp], ebx + ret + +defcode 'quit', 4, 0, quit + mov esp,[var_rz] + call interpret + jmp quit + +defcode 'abort', 5, 0, abort + mov ebp, stack_top + jmp quit + +defcode 'interpret', 9, 0, interpret + call rword + call twodup + call find + test eax,eax + jz push_lit ; a number + call nip + call nip + mov dword ebx, [var_state] + test ebx, ebx + jz execute + mov byte bl, [eax+4] + and bl, F_IMMED + jnz execute + + ; we are compiling a word +compile_word: + ; Check to see if we inline + mov bl, [eax + 4] + test bl, F_INLINE + jnz compile_inline_word + call tcfa + call ccomma + ret + +compile_inline_word: + call tcfa + push esi + push edi + + mov esi, eax + mov edi, [var_here] +compile_inline_word_loop: + lodsb + cmp al, 0xc3 + je compile_inline_word_done + stosb + jmp compile_inline_word_loop + +compile_inline_word_done: + mov [var_here], edi + pop edi + pop esi + pops eax + ret + +execute: + call tcfa +exaf: + mov ebx, eax + pops eax + call ebx + ret + +push_lit: + pops eax + pusha + mov ecx, eax + mov edi, [ebp] + mov al, 46 + cld + repne scasb + popa + jne push_int + call lnumber + jmp push_cont +push_int: + call number +push_cont: + mov dword ebx, [var_state] + test ebx, ebx + jnz compile_lit + ret + +compile_lit: + push edi + mov edi, [var_here] + push eax + mov eax, lit + sub eax, edi + add eax, -5 + push eax + mov al, 0xe8 + stosb + pop eax + stosd + pop eax + stosd + mov [var_here], edi + pops eax + pop edi + ret + +defcode 'number', 6, 0, number + mov ecx, eax + pops edx + xor eax, eax + xor ebx, ebx + mov byte [is_neg], 0 + test ecx, ecx + jle number_end + mov byte bl, [edx] + inc edx + dec ecx + cmp bl, '+' + je number_parse_digits + cmp bl, '-' + je number_neg + sub bl, '0' + mov al, bl + +number_parse_digits: + test ecx, ecx + jz number_end + imul eax, 10 + mov byte bl, [edx] + inc edx + dec ecx + sub bl, '0' + add eax, ebx + jmp number_parse_digits + +number_neg: + inc byte [is_neg] + jmp number_parse_digits + +number_end: + mov byte bl, [is_neg] + test bl, bl + jz number_pos + neg eax + +number_pos: + ret + + section .data +is_neg: db 0 + +defcode 'key',3,0,key + pushs eax + mov eax, 3 + xor ebx, ebx + mov ecx, buffer + mov edx, 1 + int 0x80 + test eax, eax + jbe dead + mov eax, [buffer] + ret + +dead: + mov eax, 1 + xor ebx, ebx + int 0x80 + +defcode 'emit', 4, 0, emit + mov [buffer], eax + mov eax, 4 + mov ebx, 1 + mov ecx, buffer + mov edx, 1 + int 0x80 + pops eax + ret + + section .data + align 4 +buffer: + dd 0 + +defcode 'word', 4, 0, rword + call key + cmp al, ' ' + je word_space + cmp al, 10 + je word_space + cmp al, 9 + je word_space + push edi + mov edi, word_buffer + mov ebx, 1 + stosb + pops eax +fill: + push ebx + call key + pop ebx + cmp al, ' ' + je end_word + cmp al, 9 + je end_word + cmp al, 10 + je end_word + stosb + pops eax + inc ebx + jmp fill + +end_word: + mov eax, word_buffer + pushs eax + mov eax, ebx + pop edi + ret + +word_space: + pops eax + jmp rword + + section .data + align 4 +word_buffer: + times 64 db 0 + +defcode 'find', 4, 0, find + pops ebx + mov ecx, eax + mov edx, var_latest +check_name: + test edx, edx + je nothing_found + + ; length check + xor eax, eax + mov al, [edx + 4] + and al, F_LENMASK + cmp cl, al + jne mismatch + + ; full check + push ecx + push esi + push edi + mov edi, ebx + lea esi, [edx + 5] + repe cmpsb + pop edi + pop esi + pop ecx + jne mismatch + + ; match + mov eax, edx + ret + +mismatch: + mov edx, [edx] + jmp check_name + +nothing_found: + xor eax, 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 |