XForth/primitives.asm

;@+leo-ver=5-thin
;@+node:caminhante.20211214151146.6: * @file primitives.asm
;@@nocolor
;@@language assembly_x86
;@@tabwidth -2
;@+others
;@+node:caminhante.20211214151550.1: ** Utilities
;@+node:caminhante.20211214151505.1: *3* struc registers
struc registers {
  .eax rd 1
  .ebx rd 1
  .ecx rd 1
  .edx rd 1
  .esi rd 1
  .edi rd 1
}
;@+node:caminhante.20211214151537.1: *3* macro save_reg
macro save_reg [reg*] {
  mov [reg_buffer.#reg], reg
}
;@+node:caminhante.20211214151544.1: *3* macro restore_reg
macro restore_reg [reg*] {
  mov reg, [reg_buffer.#reg]
}
;@+node:caminhante.20211214151610.1: ** Stack management
;@+node:caminhante.20211214151640.1: *3* DROP
DROP:   dd _enter_native
  pop eax
  jmp _next_routine
;@+node:caminhante.20211214151646.1: *3* SWAP
SWAP:   dd _enter_native
  pop eax
  pop ebx
  push eax
  push ebx
  jmp _next_routine
;@+node:caminhante.20211214151650.1: *3* DUP1
DUP1: dd _enter_native
  push dword [esp]
  jmp _next_routine
;@+node:caminhante.20211214151655.1: *3* OVER
OVER: dd _enter_native
  push dword [esp+4]
  jmp _next_routine
;@+node:caminhante.20211214151659.1: *3* ROT
ROT:    dd _enter_native
  pop eax
  pop ebx
  pop ecx
  push ebx
  push eax
  push ecx
  jmp _next_routine
;@+node:caminhante.20211214151705.1: *3* UNROT
UNROT:  dd _enter_native
  pop eax
  pop ebx
  pop ecx
  push eax
  push ecx
  push ebx
  jmp _next_routine
;@+node:caminhante.20211214151709.1: *3* DROP2
DROP2:  dd _enter_native
  pop eax
  pop eax
  jmp _next_routine
;@+node:caminhante.20211214151714.1: *3* DUP2
DUP2:   dd _enter_native
  mov eax, [esp]
  mov ebx, [esp+4]
  push ebx
  push eax
  jmp _next_routine
;@+node:caminhante.20211214151720.1: *3* SWAP2
SWAP2:  dd _enter_native
  pop eax
  pop ebx
  pop ecx
  pop edx
  push ebx
  push eax
  push edx
  push ecx
  jmp _next_routine
;@+node:caminhante.20211214151726.1: *3* NZDUP
NZDUP:  dd _enter_native
  mov eax, [esp]
  test eax, eax
  jz @f
  push eax
  @@:
  jmp _next_routine
;@+node:caminhante.20211214153126.1: ** Basic arithmetic
;@+node:caminhante.20211214153135.1: *3* INCR1
INCR1:  dd _enter_native
  inc dword [esp]
  jmp _next_routine
;@+node:caminhante.20211214153142.1: *3* DECR1
DECR1:  dd _enter_native
  dec dword [esp]
  jmp _next_routine
;@+node:caminhante.20211214153150.1: *3* INCR4
INCR4:  dd _enter_native
  add dword [esp], 4
  jmp _next_routine
;@+node:caminhante.20211214153208.1: *3* DECR4
DECR4:  dd _enter_native
  sub dword [esp], 4
  jmp _next_routine
;@+node:caminhante.20211214153214.1: *3* ADDIT
ADDIT:  dd _enter_native
  pop eax
  add dword [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153220.1: *3* SUBIT
SUBIT:  dd _enter_native
  pop eax
  sub dword [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153229.1: *3* MULIT
MULIT:  dd _enter_native
  pop eax
  pop ebx
  imul ebx, eax
  push eax
  jmp _next_routine
;@+node:caminhante.20211214153247.1: *3* DIVMOD
DIVMOD: dd _enter_native
  xor edx, edx
  pop ebx
  pop eax
  idiv ebx
  push edx
  push eax
  jmp _next_routine
;@+node:caminhante.20211214153326.1: ** Arithmetic tests
;@+node:caminhante.20211214153335.1: *3* ISEQU
ISEQU:  dd _enter_native
  pop eax
  cmp eax, [esp]
  sete al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153349.1: *3* ISDIF
ISDIF:  dd _enter_native
  pop eax
  cmp eax, [esp]
  setne al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153355.1: *3* LT
LT:     dd _enter_native
  pop eax
  cmp eax, [esp]
  setl al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153401.1: *3* GT
GT:     dd _enter_native
  pop eax
  cmp eax, [esp]
  setg al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153407.1: *3* LE
LE:     dd _enter_native
  pop eax
  cmp eax, [esp]
  setle al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153411.1: *3* GE
GE:     dd _enter_native
  pop eax
  cmp eax, [esp]
  setge al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153418.1: *3* EQU0
EQU0:   dd _enter_native
  cmp dword [esp], 0
  setz al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153424.1: *3* DIF0
DIF0:   dd _enter_native
  cmp dword [esp], 0
  setnz al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153429.1: *3* LT0
LT0:    dd _enter_native
  cmp dword [esp], 0
  setl al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153434.1: *3* GT0
GT0:    dd _enter_native
  cmp dword [esp], 0
  setg al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153439.1: *3* LE0
LE0:    dd _enter_native
  cmp dword [esp], 0
  setle al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153444.1: *3* GE0
GE0:    dd _enter_native
  cmp dword [esp], 0
  setge al
  movzx eax, al
  mov [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153451.1: *3* AND4
AND4:   dd _enter_native
  pop eax
  and [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153456.1: *3* OR4
OR4:    dd _enter_native
  pop eax
  or [esp], eax
  jmp _next_routine
;@+node:caminhante.20211214153500.1: *3* NOT4
NOT4:   dd _enter_native
  not dword [esp]
  jmp _next_routine
;@+node:caminhante.20211214153505.1: *3* NEG4
NEG4:   dd _enter_native
  neg dword [esp]
  jmp _next_routine
;@+node:caminhante.20211214153530.1: ** Memory operations
;@-others
;; TODO
POKE4:  dd _enter_native
  pop ebx
  pop eax
  mov [ebx], eax
  jmp _next_routine

PEEK4:  dd _enter_native
  pop ebx
  mov eax, [ebx]
  push eax
  jmp _next_routine

POKE4ADD: dd _enter_native
  pop ebx
  pop eax
  add [ebx], eax
  jmp _next_routine

POKE4SUB: dd _enter_native
  pop ebx
  pop eax
  sub [ebx], eax
  jmp _next_routine

POKE1:  dd _enter_native
  pop ebx
  pop eax
  mov [ebx], al
  jmp _next_routine

PEEK1:  dd _enter_native
  pop ebx
  xor eax, eax
  mov al, [ebx]
  push eax
  jmp _next_routine

COPY1:  dd _enter_native
  mov ebx, [esp+4]
  mov edx, [esp]
  mov al, [ebx]
  mov [edx], al
  inc dword [esp]
  inc dword [esp+4]
  jmp _next_routine

COPY4:  dd _enter_native
  mov ebx, [esp+4]
  mov edx, [esp]
  mov eax, [ebx]
  mov [edx], eax
  add dword [esp], 4
  add dword [esp+4], 4
  jmp _next_routine

MOVE1:  dd _enter_native
  cld
  pop ecx
  mov edx, ecx
  shr ecx, 2
  and edx, 3
  pop edi
  pop esi
  rep movsd
  mov ecx, edx
  rep movsb
  jmp _next_routine

  ;; Return and Data Stack's pointer control

PUSHRST:  dd _enter_native
  lea ebp, [ebp-4]
  pop eax
  mov [ebp], eax
  jmp _next_routine

POPRST:   dd _enter_native
  push dword [ebp]
  lea ebp, [ebp+4]
  jmp _next_routine

RSTFETCH: dd _enter_native
  push ebp
  jmp _next_routine

RSTSTORE: dd _enter_native
  pop ebp
  jmp _next_routine

RSTDROP:  dd _enter_native
  lea ebp, [ebp+4]
  jmp _next_routine

DSTFETCH: dd _enter_native
  mov eax, esp
  push eax
  jmp _next_routine

DSTSTORE: dd _enter_native
  pop esp
  jmp _next_routine

  ;; Input/Output

KEY:    dd _enter_native
  call _KEY
  push eax
  jmp _next_routine
_KEY:
  save_reg ebx,ecx,edx
.start:
  movzx ebx, [read.cursor]
  movzx ecx, [read.top]
  cmp ebx, ecx
  jge .read_more
  movzx eax, byte [read.buffer+ebx]
  inc [read.cursor]
  restore_reg ebx,ecx,edx
  ret
.read_more:
  mov eax, sys_read
  mov ebx, STDIN
  mov ecx, read.buffer
  mov edx, 4096
  int 80h
  test eax, eax
  jbe .read_error
  mov [read.top], ax
  mov [read.cursor], 0
  jmp _KEY.start
.read_error:
  mov eax, -1
  restore_reg ebx,ecx,edx
  ret

EMIT:   dd _enter_native
  pop eax
  call _EMIT
  jmp _next_routine
_EMIT:
  save_reg ebx,ecx,edx
  push eax
  mov ebx, STDOUT
  mov ecx, esp
  mov edx, 1
  mov eax, sys_write
  int 80h
  pop eax
  restore_reg ebx,ecx,edx
  ret

WORD1:  dd _enter_native
  call _WORD
  push word_buffer
  push ecx
  jmp _next_routine
_WORD:
  save_reg edi,eax
.start:
  mov edi, word_buffer
  mov ecx, 31
.read_first:
  call _KEY
  cmp eax, -1
  je .error
  cmp al, '\'
  je .skip_comment
  cmp al, ' '
  je .read_first
  cmp al, 10
  je .read_first
  stosb
.read_next:
  call _KEY
  cmp eax, -1
  je .error
  cmp al, '\'
  je .skip_comment
  cmp al, ' '
  je .end
  cmp al, 10
  je .end
  stosb
  loop .read_next
.end:
  neg ecx
  add ecx, 32
  restore_reg edi,eax
  ret
.error:
  mov ecx, -1
  restore_reg edi,eax
  ret
.skip_comment:
  call _KEY
  cmp eax, -1
  je .error
  cmp al, 10
  jne .skip_comment
  jmp .end

WRITE1:  dd _enter_native
  save_reg eax,ebx,ecx,edx
  pop edx ecx
  test edx, edx
  js @f
  jz @f
  mov ebx, STDOUT
  mov eax, sys_write
  int 80h
  @@:
  restore_reg eax,ebx,ecx,edx
  jmp _next_routine
;@-leo