snapshot before branching

[rrq/jonasforth.git] / src / main.asm

diff --git a/src/main.asm b/src/main.asm
index 3af5713ba81790adf989d42a777bf744c59f0409..3914b11c72bf20fd41fa07d182203fc707b75ba7 100644 (file)
--- a/src/main.asm
+++ b/src/main.asm
@@ -31,7 +31,7 @@ macro next {
 }
 
 ;; pushr and popr work on the return stack, whose location is stored in the
-;; register RBP.
+;; register RBP. Always allocates an extra 8 bytes as "local frame"
 macro pushr x {
   sub rbp, 8
   mov qword [rbp], x
@@ -172,12 +172,30 @@ forth_asm ZBRANCH, '0BRANCH'
   cmp rax, 0    ; Compare top of stack to see if we should branch
   jnz .dont_branch
 .do_branch:
-  jmp BRANCH.start
+  add rsi,[rsi]
+  next
 .dont_branch:
   add rsi, 8     ; We need to skip over the next word, which contains
                 ; the offset.
   next
 
+;; Push the return stack pointer. "grows" negatively
+forth_asm RSPGET, 'R='
+  push rbp
+  next
+
+;; The return stack "grows" negatively, and rbp is the address of the top
+;; Move rbp by n (from stack) bytes
+forth_asm RSPADD, 'R+'
+  pop rax
+  sub rbp, rax
+  next
+
+;; Push top of the stack.
+forth_asm TOP_, 'TOP'
+  push rsp
+  next
+
 ;; Duplicate the top of the stack.
 forth_asm DUP_, 'DUP'
   push qword [rsp]
@@ -188,6 +206,13 @@ forth_asm EXEC, 'EXEC'
   pop rax
   jmp qword [rax]
 
+;; This word skips a word without exectuing, but pushes its address
+forth_asm SKIP_, 'SKIP'
+  push rsi
+  add rsi, 8     ; We need to skip over the next word, which contains
+                ; the offset.
+  next
+
 ;; Expects a character on the stack and prints it to standard output.
 forth_asm EMIT, 'EMIT'
   pushr rsi
@@ -239,9 +264,11 @@ forth_asm READ_WORD, 'READ-WORD'
 .skip_whitespace:
   ;; Read characters until one of them is not whitespace.
   call KEY.impl
-  ;; We consider newlines and spaces to be whitespace.
+  ;; We consider newlines, tabs and spaces to be whitespace.
   cmp al, ' '
   je .skip_whitespace
+  cmp al, $9
+  je .skip_whitespace
   cmp al, $A
   je .skip_whitespace
 
@@ -259,6 +286,8 @@ forth_asm READ_WORD, 'READ-WORD'
 
   cmp al, ' '
   je .end
+  cmp al, 9
+  je .end
   cmp al, $A
   jne .read_alpha
 
@@ -325,6 +354,14 @@ forth_asm DROP, 'DROP'
   add rsp, 8
   next
 
+;; Takes a value and an address, and stores the value at the given address.
+forth_asm AND_, '&'
+  pop rbx                       ; a
+  pop rax                       ; b
+  and rax, rbx
+  push rax
+  next
+
 forth_asm NOT_, 'NOT'
   pop rax
   cmp rax, 0
@@ -438,8 +475,16 @@ forth_asm MINUS, '-'
   push rbx
   next
 
-;; Given two integers a and b on the stack, pushes the quotient and remainder of
-;; division of a by b.
+;; Multiply two integers on the stack ignoring overflow
+forth_asm MULT, '*'
+  pop rax
+  pop rbx
+  mul rbx
+  push rax
+  next
+
+;; Given two integers a and b on the stack, pushes the quotient and
+;; remainder of division of a by b.
 forth_asm TIMESMOD, '/MOD'
   pop rbx                       ; b
   pop rax                       ; a
@@ -558,9 +603,9 @@ forth_asm ROT, 'ROT'
   pop rax
   pop rbx
   pop rdx
+  push rbx
   push rax
   push rdx
-  push rbx
   next
 
 forth_asm PICK, 'PICK'
@@ -570,6 +615,10 @@ forth_asm PICK, 'PICK'
   push rax
   next
 
+forth_asm OVER, 'OVER'
+  push qword [rsp + 8]
+  next
+
 forth_asm EQL, '='
   pop rax
   pop rbx
@@ -582,6 +631,30 @@ forth_asm EQL, '='
   push 1
   next
 
+forth_asm LT_, '<'
+  pop rax
+  pop rbx
+  cmp rax, rbx
+  jle .le
+.notle:
+  push 1
+  next
+.le:
+  push 0
+  next
+
+forth_asm GT_, '>'
+  pop rax
+  pop rbx
+  cmp rax, rbx
+  jge .ge
+.notge:
+  push 1
+  next
+.ge:
+  push 0
+  next
+
 forth MAIN, 'MAIN'
   dq SYSCODE
   dq INTERPRET_STRING
@@ -598,22 +671,18 @@ forth EFI_SYSTEM_TABLE_CONSTANT, 'SystemTable'
 forth_asm EFICALL1, 'EFICALL1'
   pop rax ; function pointer
   pop rcx ; 1st argument
-
   sub rsp, 32
   call rax
   add rsp, 32
-
   next
 
 forth_asm EFICALL2, 'EFICALL2'
   pop rax ; function pointer
   pop rdx ; 2nd argument
   pop rcx ; 1st argument
-
   sub rsp, 32
   call rax
   add rsp, 32
-
   next
 
 forth_asm EFICALL3, 'EFICALL3'
@@ -621,45 +690,61 @@ forth_asm EFICALL3, 'EFICALL3'
   pop r8  ; 3rd argument
   pop rdx ; 2nd argument
   pop rcx ; 1st argument
-
   sub rsp, 32
   call rax
   add rsp, 32
+  push rax
+  next
 
+forth_asm EFICALL4, 'EFICALL4'
+  pop rax ; function pointer
+  pop r9  ; 4th argument
+  pop r8  ; 3rd argument
+  pop rdx ; 2nd argument
+  pop rcx ; 1st argument
+  sub rsp, 32
+  call rax
+  add rsp, 32
   push rax
+  next
 
+forth_asm EFICALL5, 'EFICALL5'
+  pop rax ; function pointer
+  pop r10 ; 5th argument
+  pop r9  ; 4th argument
+  pop r8  ; 3rd argument
+  pop rdx ; 2nd argument
+  pop rcx ; 1st argument
+  push r10 ; restore as stack argument
+  sub rsp, 32
+  call rax
+  add rsp, 32 + 8
+  push rax
   next
 
 forth_asm EFICALL10, 'EFICALL10'
   pop rax ; function pointer
-
-  mov rcx, [rsp + 8 * 9]
-  mov rdx, [rsp + 8 * 8]
+  mov rcx, [rsp + 8 * 9]       ; 1st
+  mov rdx, [rsp + 8 * 8]       ; 2nd
   mov r8, [rsp + 8 * 7]
   mov r9, [rsp + 8 * 6]
-
   ;; Reverse order of stack arguments
   mov r10, [rsp + 8 * 5]
   mov r11, [rsp + 8 * 0]
   mov [rsp + 8 * 5], r11
   mov [rsp + 8 * 0], r10
-
   mov r10, [rsp + 8 * 4]
   mov r11, [rsp + 8 * 1]
   mov [rsp + 8 * 4], r11
   mov [rsp + 8 * 1], r10
-
   mov r10, [rsp + 8 * 3]
   mov r11, [rsp + 8 * 2]
   mov [rsp + 8 * 3], r11
   mov [rsp + 8 * 2], r10
-
   sub rsp, 32
   call rax
   add rsp, 32 + 8 * 10
-
   push rax
-
   next
 
 ;; Built-in variables:
@@ -715,7 +800,7 @@ READ_STRING.char_buffer db ?
 READ_STRING.buffer rb $FF
 READ_STRING.length dq ?
 
-DOTU.chars db '0123456789ABCDEF'
+DOTU.chars db '0123456789abcdef'
 DOTU.buffer rq 16     ; 64-bit number has no more than 16 digits in hex
 DOTU.rbuffer rq 16
 DOTU.length dq ?
@@ -741,5 +826,5 @@ return_stack_top:
 sysf:
 file '../init/sys.f'
 file '../init/uefi.f'
+file '../init/blurb.f'
 sysf.len = $ - sysf
-