+os_code_section
+
+include "impl.asm" ; Misc. subroutines
+include "bootstrap.asm" ; Forth words encoded in Assembly
+
+main:
+ cld ; Clear direction flag so LODSQ does the right thing.
+ mov rbp, return_stack_top ; Initialize return stack
+
+ call os_initialize
+
+ mov rax, MAIN
+ jmp qword [rax]
+
+program: dq MAIN
+
+;; The codeword is the code that will be executed at the beginning of a forth
+;; word. It needs to save the old RSI and update it to point to the next word to
+;; execute.
+header DOCOL, 'DOCOL'
+ pushr rsi ; Save old value of RSI on return stack; we will continue execution there after we are done executing this word
+ lea rsi, [rax + 8] ; RAX currently points to the address of the codeword, so we want to continue at RAX+8
+ next ; Execute word pointed to by RSI
+
+;; This word is called at the end of a Forth definition. It just needs to
+;; restore the old value of RSI (saved by 'DOCOL') and resume execution.
+forth_asm EXIT, 'EXIT'
+ popr rsi
+ next
+
+;; LIT is a special word that reads the next "word pointer" and causes it to be
+;; placed on the stack rather than executed.
+forth_asm LIT, 'LIT'
+ lodsq
+ push rax
+ next
+
+;; When LITSTRING is encountered while executing a word, it instead reads a
+;; string from the definition of that word, and places that string on the stack
+;; as (buffer, length).
+forth_asm LITSTRING, 'LITSTRING'
+ lodsb
+ push rsi ; Buffer
+ movzx rax, al
+ push rax ; Length
+ add rsi, rax ; Skip over string before resuming execution
+ next
+
+;; Given a string (a pointer following by a size), return the location of the
+;; dictionary entry for that word. If no such word exists, return 0.
+forth_asm FIND, 'FIND'
+ mov [.rsi], rsi
+
+ pop [find.search_length]
+ pop [find.search_buffer]
+ mov rsi, [latest_entry] ; Start with the last added word
+ call find
+ push rsi
+
+ mov rsi, [.rsi]
+ next
+ push rsi
+
+ mov rsi, [.rsi]
+ next
+
+;; Given an entry in the dictionary, return a pointer to the codeword of that
+;; entry.
+forth_asm TCFA, '>CFA'
+ pop rax
+ add rax, 8 + 1 ; [rax] = length of name
+ movzx rbx, byte [rax]
+ inc rax
+ add rax, rbx ; [rax] = codeword
+ push rax
+ next
+
+;; BRANCH is the fundamental mechanism for branching. BRANCH reads the next word
+;; as a signed integer literal and jumps by that offset.
+forth_asm BRANCH, 'BRANCH'
+ add rsi, [rsi] ; [RSI], which is the next word, contains the offset; we add this to the instruction pointer.
+ next ; Then, we can just continue execution as normal
+
+;; 0BRANCH is like BRANCH, but it jumps only if the top of the stack is zero.
+forth_asm ZBRANCH, '0BRANCH'
+ ;; Compare top of stack to see if we should branch
+ pop rax
+ cmp rax, 0
+ jnz .dont_branch
+.do_branch:
+ jmp BRANCH.start
+.dont_branch:
+ add rsi, 8 ; We need to skip over the next word, which contains the offset.
+ next
+
+;; Duplicate the top of the stack.
+forth_asm DUP_, 'DUP'
+ push qword [rsp]
+ next
+
+;; Execute the codeword at the given address.
+forth_asm EXEC, 'EXEC'
+ pop rax
+ jmp qword [rax]
+
+;; Expects a character on the stack and prints it to standard output.
+forth_asm EMIT, 'EMIT'
+ pushr rsi
+ pushr rax
+
+ lea rcx, [rsp]
+ mov rdx, 1
+ call os_print_string
+
+ add rsp, 8
+ popr rax
+ popr rsi
+ next
+
+;; Read a single character from the current input stream. Usually, this will wait
+;; for the user to press a key, and then return the corresponding character. When
+;; reading from a special buffer, it will instead return the next characater from
+;; that buffer.
+;;
+;; The ASCII character code is placed on the stack.
+forth_asm KEY, 'KEY'
+ call .impl
+ push rax
+ next
+
+;; Result in RAX
+.impl:
+ ;; Are we reading from user input or from the input buffer?
+ cmp [input_buffer], 0
+ jne .from_buffer
+
+ ;; Reading user input
+ call os_read_char
+ ret
+
+.from_buffer:
+ ;; Reading from buffer
+ mov rax, [input_buffer]
+ movzx rax, byte [rax]
+
+ inc [input_buffer]
+ dec [input_buffer_length]
+ ret
+
+;; Read a word and push it onto the stack as a pointer and a size. The pointer
+;; is valid until the next call to READ_WORD.
+forth_asm READ_WORD, 'READ-WORD'
+ push rsi
+.skip_whitespace:
+ ;; Read characters until one of them is not whitespace.
+ call KEY.impl
+ ;; We consider newlines and spaces to be whitespace.
+ cmp al, ' '
+ je .skip_whitespace
+ cmp al, $A
+ je .skip_whitespace
+
+ ;; We got a character that wasn't whitespace. Now read the actual word.
+ mov [.length], 0
+
+.read_alpha:
+ movzx rbx, [.length]
+ mov rsi, .buffer
+ add rsi, rbx
+ mov [rsi], al
+ inc [.length]
+
+ call KEY.impl
+
+ cmp al, ' '
+ je .end
+ cmp al, $A
+ jne .read_alpha
+
+.end:
+ pop rsi
+ push .buffer
+ movzx rax, [.length]
+ push rax
+
+ next
+
+;; Takes a string on the stack and replaces it with the decimal number that the
+;; string represents.
+forth_asm PARSE_NUMBER, 'PARSE-NUMBER'
+ pop rcx ; Length
+ pop rdi ; String pointer
+
+ push rsi
+ call parse_number
+ pop rsi
+
+ push rax ; Result
+ next
+
+;; Takes a string (in the form of a pointer and a length on the stack) and
+;; prints it to standard output.
+forth_asm TELL, 'TELL'
+ pushr rax
+ pushr rsi
+
+ pop rdx ; Length
+ pop rcx ; Buffer
+ call os_print_string
+
+ popr rsi
+ popr rax
+ next
+
+;; Exit the program cleanly.
+forth_asm TERMINATE, 'TERMINATE'
+ mov rax, 0
+ call os_terminate
+
+;; Duplicate a pair of elements.
+forth_asm PAIRDUP, '2DUP'
+ pop rbx
+ pop rax
+ push rax
+ push rbx
+ push rax
+ push rbx
+ next
+
+;; Swap the top two elements on the stack.
+forth_asm SWAP, 'SWAP'
+ pop rax
+ pop rbx
+ push rax
+ push rbx
+ next
+
+;; Remove the top element from the stack.
+forth_asm DROP, 'DROP'
+ add rsp, 8
+ next
+
+forth_asm NOT_, 'NOT'
+ pop rax
+ cmp rax, 0
+ jz .false
+.true:
+ push 0
+ next
+.false:
+ push 1
+ next
+
+;; .U prints the value on the stack as an unsigned integer in hexadecimal.
+forth_asm DOTU, '.U'
+ mov [.length], 0
+ mov [.printed_length], 1
+ pop rax ; RAX = value to print
+ push rsi ; Save value of RSI
+
+ ;; We start by constructing the buffer to print in reverse
+
+.loop:
+ mov rdx, 0
+ mov rbx, $10
+ div rbx ; Put remainer in RDX and quotient in RAX
+
+ ;; Place the appropriate character in the buffer
+ mov rsi, .chars
+ add rsi, rdx
+ mov bl, [rsi]
+ mov rdi, .rbuffer
+ add rdi, [.length]
+ mov [rdi], bl
+ inc [.length]
+
+ ;; .printed_length is the number of characters that we ulitmately want to
+ ;; print. If we have printed a non-zero character, then we should update
+ ;; .printed_length.
+ cmp bl, '0'
+ je .skip_updating_real_length
+ mov rbx, [.length]
+ mov [.printed_length], rbx
+.skip_updating_real_length:
+
+ cmp [.length], 16
+ jle .loop
+
+ ;; Flip buffer around, since it is currently reversed
+ mov rcx, [.printed_length]
+.flip:
+ mov rsi, .rbuffer
+ add rsi, rcx
+ dec rsi
+ mov al, [rsi]