OVMF_VARS.fd: /usr/share/ovmf/x64/OVMF_VARS.fd
cp $< $@
-out/main: main.asm impl.asm bootstrap.asm sys.f os/uefi.asm
+out/main: src/main.asm src/impl.asm src/bootstrap.asm src/uefi.asm init/sys.f init/uefi.f
mkdir -p out
- OS_INCLUDE=os/uefi.asm fasm $< $@
+ fasm $< $@
out/startup.nsh:
mkdir -p out
Shell> fs0:main
Ready.
- S" Hello, World!" TELL
+ : SAY-HELLO S" Hello, World!" TELL NEWLINE ;
+ SAY-HELLO
Hello World!
-(Try typing in the code in `example.f` for something a little more
+(Try typing in the code in `lib/example.f` for something a little more
interesting.)
## Running on real hardware
+++ /dev/null
-;; vim: syntax=fasm
-
-;; We need some basic words to be available before we can implement the actual
-;; interpreter. For this reason we need to write some words in assembly, even
-;; though they depend only on other Forth words. Such words are defined in this
-;; file.
-;;
-;; With these words, we can finally defined INTERPRET, and from there we'll load
-;; everything else from an external file.
-;;
-;; This file is included from main.asm; see that file for more information.
-
-;; Define a Forth word that is implemented in Forth. (The body will be a list of
-;; 'dq' statements.)
-macro forth label, name, immediate {
- header label, name, immediate
- dq DOCOL
-}
-
-forth COMMA, ','
- dq HERE, GET, PUT ; Set the memory at the address pointed to by HERE
- dq HERE, GET, LIT, 8, PLUS ; Calculate new address for HERE to point to
- dq HERE, PUT ; Update HERE to point to the new address
- dq EXIT
-
-;; Mark the last added word as immediate.
-forth IMMEDIATE, 'IMMEDIATE', 1
- dq LIT, 1
- dq LATEST, GET
- dq LIT, 8, PLUS
- dq PUT_BYTE
- dq EXIT
-
-;; Given the address of a word, return 0 if the given word is not immediate.
-forth IS_IMMEDIATE, 'IMMEDIATE?'
- dq LIT, 8, PLUS
- dq GET_BYTE
- dq EXIT
-
-;; Enter immediate mode, immediately
-forth INTO_IMMEDIATE, '[', 1
- dq LIT, 0, STATE, PUT_BYTE
- dq EXIT
-
-;; Enter compilation mode
-forth OUTOF_IMMEDIATE, ']'
- dq LIT, 1, STATE, PUT_BYTE
- dq EXIT
-
-;; INTERPRET-WORD expects a word as a (buffer, length) pair on the stack. It
-;; interprets and executes the word. It's behavior depends on the current STATE.
-;; It provides special handling for integers.
-forth INTERPRET_WORD, 'INTERPRET-WORD'
- dq PAIRDUP
- ;; Stack is (word length word length).
- dq FIND ; Try to find word
- dq DUP_
- dq ZBRANCH, 8 * 22 ; Check if word is found
-
- ;; - Word is found -
-
- dq STATE, GET, ZBRANCH, 8 * 11 ; Check whether we are in compilation or immediate mode
-
- ;; (Word found, compilation mode)
- dq DUP_, IS_IMMEDIATE, NOT_, ZBRANCH, 8 * 6 ; If the word is immediate, continue as we would in immediate mode
-
- ;; Otherwise, we want to compile this word
- dq TCFA
- dq COMMA
- dq DROP, DROP
- dq EXIT
-
- ;; (Word found, immediate mode)
- ;; Execute word
- dq TCFA
- ;; Stack is (word length addr)
- dq SWAP, DROP
- dq SWAP, DROP
- ;; Stack is (addr)
- dq EXEC
- dq EXIT
-
- ;; - No word is found, assume it is an integer literal -
- ;; Stack is (word length addr)
- dq DROP
- dq PARSE_NUMBER
-
- dq STATE, GET, ZBRANCH, 8 * 5 ; Check whether we are in compilation or immediate mode
-
- ;; (Number, compilation mode)
- dq LIT, LIT, COMMA
- dq COMMA
- dq EXIT
-
- ;; (Number, immediate mode)
- dq EXIT
-
-;; The INTERPRET word reads and interprets a single word from the user.
-forth INTERPRET, 'INTERPRET'
- dq READ_WORD
- dq INTERPRET_WORD
- dq EXIT
-
-;; INTERPRET_STRING is a variant of INTERPRET that reads from a string instead
-;; of from the user. It takes a string as a (buffer, length) pair on the stack
-;; and interprets the entire string, even if the string has more than one word.
-forth INTERPRET_STRING, 'INTERPRET-STRING'
- dq INPUT_LENGTH, PUT
- dq INPUT_BUFFER, PUT
-
- ;; Check if the buffer is-non-empty
- ;; [TODO] This probably won't work for strings with whitespace at the end.
- dq INPUT_LENGTH, GET
- dq ZBRANCH, 8 * 5 ; to EXIT
-
- dq READ_WORD
-
- dq INTERPRET_WORD
- dq BRANCH, -8 * 7 ; to INPUT-LENGTH @
-
- dq LIT, 0, INPUT_BUFFER, PUT
-
- dq EXIT
+++ /dev/null
-: FIB ( n -- Fn )
- 0 1 ( n a b )
- 0 ( n a b i )
- BEGIN
- ROT ( n i a b )
- DUP ROT + ( n i b a+b )
- ROT ROT ( n b a+b i )
-
- 1 + ( n b a+b i+1 )
- DUP 4 PICK = UNTIL
- DROP SWAP DROP SWAP DROP ; ( a+b )
-
-: HELLO S" Hello!" TELL NEWLINE ;
-
-: TEST-FIB
- S" 10 FIB = " TELL
- 10 FIB .U
- SPACE S" (Expected: 59)" TELL NEWLINE ;
-
-\ This example calls the Blt() function on UEFI's Graphics Output Protocol. See
-\ the UEFI specification and uefi.f for more information.
-: BLUE-SQUARE
- GraphicsOutputProtocol
- HERE @ 255 C, 0 C, 0 C, 0 C, \ Buffer with single blue pixel
- EfiBltVideoFill
- 0 0 \ Source
- 100 100 20 20 \ Destination
- 0
- GOP.Blt() ;
-
-HELLO
-TEST-FIB
-BLUE-SQUARE
+++ /dev/null
-section '.text' code readable executable
-
-macro printlen msg, len {
- push rsi
- add rsp, 8
-
- mov rcx, msg
- mov rdx, len
- call os_print_string
-
- sub rsp, 8
- pop rsi
-}
-
-macro newline {
- push $A
- printlen rsp, 1
-}
-
-macro print msg {
- printlen msg, msg#.len
-}
-
-struc string bytes {
- . db bytes
- .len = $ - .
-}
-
-;; Find the given word in the dictionary of words. If no such word exists,
-;; return 0.
-;;
-;; Parameters:
-;; * [find.search_length] = Length of the word in bytes.
-;; * [find.search_buffer] = Pointer to the string containing the word.
-;; * rsi = Pointer to the last entry in the dictionary.
-;;
-;; Results:
-;; * rsi = Pointer to the found entry in the dictionary or 0.
-;;
-;; Clobbers rcx, rdx, rdi, rax.
-find:
- ;; RSI contains the entry we are currently looking at
-.loop:
- movzx rcx, byte [rsi + 8 + 1] ; Length of word being looked at
- cmp rcx, [.search_length]
- jne .next ; If the words don't have the same length, we have the wrong word
-
- ;; Otherwise, we need to compare strings
- lea rdx, [rsi + 8 + 1 + 1] ; Location of character being compared in entry
- mov rdi, [.search_buffer] ; Location of character being compared in search buffer
-.compare_char:
- mov al, [rdx]
- mov ah, [rdi]
- cmp al, ah
- jne .next ; They don't match; try again
- inc rdx ; These characters match; look at the next ones
- inc rdi
- loop .compare_char
-
- jmp .found ; They match! We are done.
-
-.next:
- mov rsi, [rsi] ; Look at the previous entry
- cmp rsi, 0
- jnz .loop ; If there is no previous word, exit and return 0
-
-.found:
- ret
-
-;; Read a word from a buffer. Returns the buffer without the word, as well as
-;; the word that was read (including lengths).
-;;
-;; Inputs:
-;; * rsi = Input buffer
-;; * rcx = Length of buffer
-;;
-;; Outputs:
-;; * rsi = Updated buffer
-;; * rcx = Length of updated buffer
-;; * rdi = Word buffer
-;; * rdx = Length of word buffer
-pop_word:
-.skip_whitespace:
- mov al, [rsi]
- cmp al, ' '
- je .got_whitespace
- cmp al, $A
- je .got_whitespace
- jmp .alpha
-.got_whitespace:
- ;; The buffer starts with whitespace; discard the first character from the buffer.
- inc rsi
- dec rcx
- jmp .skip_whitespace
-
-.alpha:
- ;; We got a character that wasn't whitespace. Now read the actual word.
- mov rdi, rsi ; This is where the word starts
- mov rdx, 1 ; Length of word
-
-.read_alpha:
- ;; Extract character from original buffer:
- inc rsi
- dec rcx
-
- ;; When we hit whitespace, we are done with this word
- mov al, [rsi]
- cmp al, ' '
- je .end
- cmp al, $A
- je .end
-
- ;; It wasn't whitespace; add it to word buffer
- inc rdx
- jmp .read_alpha
-
-.end:
- ;; Finally, we want to skip one whitespace character after the word.
- inc rsi
- dec rcx
-
- ret
-
-;; Parses a string.
-;;
-;; Parameters:
-;; * rcx = Length of string
-;; * rdi = Pointer to string buffer
-;;
-;; Results:
-;; * rax = Value
-;;
-;; Clobbers
-parse_number:
- mov r8, 0 ; Result
-
- ;; Add (10^(rcx-1) * parse_char(rdi[length - rcx])) to the accumulated value
- ;; for each rcx.
- mov [.length], rcx
-.loop:
- ;; First, calcuate 10^(rcx - 1)
- mov rax, 1
-
- mov r9, rcx
- .exp_loop:
- dec r9
- jz .break
- mov rbx, 10
- mul rbx
- jmp .exp_loop
- .break:
-
- ;; Now, rax = 10^(rcx - 1).
-
- ;; We need to calulate the value of the character at rdi[length - rcx].
- mov rbx, rdi
- add rbx, [.length]
- sub rbx, rcx
- movzx rbx, byte [rbx]
- sub rbx, '0'
-
- cmp rbx, 10
- jae .error
-
- ;; Multiply this value by rax to get (10^(rcx-1) * parse_char(rdi[length - rcx])),
- ;; then add this to the result.
- mul rbx
-
- ;; Add that value to r8
- add r8, rax
-
- dec rcx
- jnz .loop
-
- mov rax, r8
- ret
-
-.error:
- push rdi
- print parse_number.error_msg
- pop rdi
- printlen rdi, [.length]
- newline
- mov rax, 100
- call os_terminate
-
-section '.data' readable writable
-
-find.search_length dq ?
-find.search_buffer dq ?
-
-parse_number.length dq ?
-parse_number.error_msg string "Invalid number: "
-
--- /dev/null
+S" :" CREATE ] DOCOL
+ READ-WORD CREATE
+ LIT DOCOL ,
+ ]
+EXIT [
+
+: ;
+ LIT EXIT ,
+ [ S" [" FIND >CFA , ]
+ EXIT
+[ IMMEDIATE
+
+: IF IMMEDIATE
+ ' 0BRANCH ,
+ HERE @
+ 0 ,
+;
+
+: THEN IMMEDIATE
+ DUP
+ HERE @ SWAP -
+ SWAP !
+;
+
+: ELSE IMMEDIATE
+ ' BRANCH ,
+ HERE @
+ 0 ,
+ SWAP DUP HERE @ SWAP - SWAP !
+;
+
+: BEGIN IMMEDIATE
+ HERE @
+;
+
+: AGAIN IMMEDIATE
+ ' BRANCH ,
+ HERE @ - , ;
+
+: ( IMMEDIATE
+ BEGIN
+ READ-WORD
+ 1 = IF
+ C@ 41 = IF
+ EXIT
+ THEN
+ ELSE
+ DROP
+ THEN
+ AGAIN ; ( Yay! We now have comments! )
+
+: UNTIL IMMEDIATE
+ ' 0BRANCH ,
+ HERE @ - ,
+;
+
+( Compile a literal value into the current word. )
+: LIT, IMMEDIATE ( x -- )
+ ' LIT , , ;
+
+: / /MOD DROP ;
+: MOD /MOD SWAP DROP ;
+: NEG 0 SWAP - ;
+
+: C,
+ HERE @ C!
+ HERE @ 1 +
+ HERE ! ;
+
+: OVER ( a b -- a b a ) SWAP DUP ROT ;
+
+( An alternative comment syntax. Reads until the end of the line. )
+: \ IMMEDIATE
+ BEGIN
+ KEY
+ 10 = UNTIL ;
+
+\ So far, S" has only worked in immediate mode, which is backwards -- actually,
+\ the main use-case of this is as a compile-time word. Let's fix that.
+: S" IMMEDIATE
+ ' LITSTRING ,
+ HERE @ 0 C, \ We will put the length here
+ 0
+ BEGIN
+ 1 +
+ KEY DUP C,
+ 34 = UNTIL
+ \ Remove final "
+ HERE @ 1 - HERE !
+ 1 -
+ SWAP C! ;
+
+( Compile the given string into the current word directly. )
+: STORE-STRING ( str len -- )
+ BEGIN
+ OVER C@ C,
+ SWAP 1 + SWAP
+ 1 - DUP 0 = UNTIL
+ DROP DROP ;
+
+: NEWLINE 10 EMIT ;
+: SPACE 32 EMIT ;
+
+( Read a number from standard input. )
+: READ-NUMBER READ-WORD PARSE-NUMBER ;
+
+: RESTART S" Ready." TELL NEWLINE ;
+RESTART
+
--- /dev/null
+: ConOut SystemTable 64 + @ ;
+: ConOut.OutputString ConOut 8 + @ ;
+: ConOut.OutputString() ConOut SWAP ConOut.OutputString EFICALL2 ;
+
+: BootServices SystemTable 96 + @ ;
+: BootServices.LocateProtocol BootServices 320 + @ ;
+: GraphicsOutputProtocol
+ \ [TODO] It would be nice to cache this value, so we don't have to get it
+ \ every time.
+ HERE @ 5348063987722529246 , 7661046075708078998 , \ *Protocol = EFI_GRAPHICS_OUTPUT_PROTOCOL_GUID
+ 0 \ *Registration
+ HERE @ 0 , \ **Interface
+ BootServices.LocateProtocol EFICALL3 DROP
+ HERE @ 8 - @ \ *Interface
+ ;
+: GOP.Blt GraphicsOutputProtocol 16 + @ ;
+: GOP.Blt() ( GOP buffer mode sx sy dx dy dw dh pitch -- )
+ GOP.Blt EFICALL10 0 = IF ELSE S" Warning: Invalid Blt()" TELL THEN ;
+: GOP.SetMode GraphicsOutputProtocol 8 + @ ;
+
+: EfiBltVideoFill 0 ;
+
+\ Store a null-terminated UTF-16 string HERE, and return a pointer to its buffer
+\ at runtime.
+: UTF16"
+ HERE @
+ BEGIN
+ KEY DUP C,
+ 0 C,
+ 34 = UNTIL
+ HERE @ 2 - HERE ! \ Remove final "
+ 0 C, 0 C, \ Null terminator
+ ;
--- /dev/null
+: FIB ( n -- Fn )
+ 0 1 ( n a b )
+ 0 ( n a b i )
+ BEGIN
+ ROT ( n i a b )
+ DUP ROT + ( n i b a+b )
+ ROT ROT ( n b a+b i )
+
+ 1 + ( n b a+b i+1 )
+ DUP 4 PICK = UNTIL
+ DROP SWAP DROP SWAP DROP ; ( a+b )
+
+: HELLO S" Hello!" TELL NEWLINE ;
+
+: TEST-FIB
+ S" 10 FIB = " TELL
+ 10 FIB .U
+ SPACE S" (Expected: 59)" TELL NEWLINE ;
+
+\ This example calls the Blt() function on UEFI's Graphics Output Protocol. See
+\ the UEFI specification and uefi.f for more information.
+: BLUE-SQUARE
+ GraphicsOutputProtocol
+ HERE @ 255 C, 0 C, 0 C, 0 C, \ Buffer with single blue pixel
+ EfiBltVideoFill
+ 0 0 \ Source
+ 100 100 20 20 \ Destination
+ 0
+ GOP.Blt() ;
+
+HELLO
+TEST-FIB
+BLUE-SQUARE
+++ /dev/null
-;; The UEFI module defines the following functions. Each of these functions
-;; preserve the value of RSI and RSP. They may use other registers as they like.
-;;
-;; os_initialize
-;; Called at initialization.
-;;
-;; os_print_string
-;; Takes a string buffer in RCX and the length in RDX, and prints the string
-;; to the console.
-;;
-;; os_read_char
-;; Wait for the user to type a key, and then put the corresponding ASCII byte
-;; into RAX.
-;;
-;; os_terminate
-;; Shut down the system, returning the error code given in RAX.
-include 'os/uefi.asm'
-
-;; The code in this macro is placed at the end of each Forth word. When we are
-;; executing a definition, this code is what causes execution to resume at the
-;; next word in that definition.
-macro next {
- ;; RSI points to the address of the definition of the next word to execute.
- lodsq ; Load value at RSI into RAX and increment RSI
- ;; Now RAX contains the location of the next word to execute. The first 8
- ;; bytes of this word is the address of the codeword, which is what we want
- ;; to execute.
- jmp qword [rax] ; Jump to the codeword of the current word
-}
-
-;; pushr and popr work on the return stack, whose location is stored in the
-;; register RBP.
-macro pushr x {
- sub rbp, 8
- mov qword [rbp], x
-}
-macro popr x {
- mov x, [rbp]
- add rbp, 8
-}
-
-;; The following macro generates the dictionary header. It updates the
-;; initial_latest_entry variable, which is used as the initial value of the
-;; latest_entry variable that is made available at runtime.
-;;
-;; The header contains a link to the previous entry, the length of the name of
-;; the word and the word itself as a string literal.
-;;
-;; This macro also defines a label LABEL_entry.
-initial_latest_entry = 0
-macro header label, name, immediate {
- local .string_end
-
-label#_entry:
- dq initial_latest_entry
- if immediate eq
- db 0
- else
- db 1
- end if
- db .string_end - ($ + 1)
- db name
- .string_end:
-label:
-
-initial_latest_entry = label#_entry
-}
-
-;; Define a Forth word that is implemented in assembly. See 'header' for details.
-macro forth_asm label, name, immediate {
- header label, name, immediate
- dq .start
-.start:
-}
-
-section '.text' code readable executable
-
-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]
-
- mov rdi, .buffer
- add rdi, [.printed_length]
- sub rdi, rcx
- mov [rdi], al
-
- loop .flip
-
- ;; Print the buffer
- mov rcx, .buffer
- mov rdx, [.printed_length]
- call os_print_string
-
- ;; Restore RSI and continue execution
- pop rsi
- next
-
-;; Takes a value and an address, and stores the value at the given address.
-forth_asm PUT, '!'
- pop rbx ; Address
- pop rax ; Value
- mov [rbx], rax
- next
-
-;; Takes an address and returns the value at the given address.
-forth_asm GET, '@'
- pop rax
- mov rax, [rax]
- push rax
- next
-
-forth_asm PUT_BYTE, 'C!'
- pop rbx
- pop rax ; Value
- mov [rbx], al
- next
-
-forth_asm GET_BYTE, 'C@'
- pop rax
- movzx rax, byte [rax]
- push rax
- next
-
-;; Add two integers on the stack.
-forth_asm PLUS, '+'
- pop rax
- pop rbx
- add rax, rbx
- push rax
- next
-
-;; Calculate difference between two integers on the stack. The second number is
-;; subtracted from the first.
-forth_asm MINUS, '-'
- pop rax
- pop rbx
- sub rbx, rax
- push rbx
- 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
- mov rdx, 0
- div rbx
- push rax ; a / b
- push rdx ; a % b
- next
-
-;; Read input until next " character is found. Push a string containing the
-;; input on the stack as (buffer length). Note that the buffer is only valid
-;; until the next call to S" and that no more than 255 characters can be read.
-forth_asm READ_STRING, 'S"'
- ;; If the input buffer is set, we should read from there instead.
- cmp [input_buffer], 0
- jne read_string_buffer
-
- push rsi
-
- mov [.length], 0
-
-.read_char:
- call os_read_char
- cmp al, '"'
- je .done
-
- mov rdx, .buffer
- add rdx, [.length]
- mov [rdx], al
- inc [.length]
- jmp .read_char
-
-.done:
- pop rsi
-
- push .buffer
- push [.length]
-
- next
-
-read_string_buffer:
- push rsi
-
- ;; We borrow READ_STRING's buffer. They won't mind.
- mov [READ_STRING.length], 0
-
-.read_char:
- mov rbx, [input_buffer]
- mov al, [rbx]
- cmp al, '"'
- je .done
-
- mov rdx, READ_STRING.buffer
- add rdx, [READ_STRING.length]
- mov [rdx], al
- inc [READ_STRING.length]
-
- inc [input_buffer]
- dec [input_buffer_length]
-
- jmp .read_char
-
-.done:
- pop rsi
-
- ;; Skip closing "
- inc [input_buffer]
- dec [input_buffer_length]
-
- push READ_STRING.buffer
- push [READ_STRING.length]
-
- next
-
-;; CREATE inserts a new header in the dictionary, and updates LATEST so that it
-;; points to the header. To compile a word, the user can then call ',' to
-;; continue to append data after the header.
-;;
-;; It takes the name of the word as a string (address length) on the stack.
-forth_asm CREATE, 'CREATE'
- pop rcx ; Word string length
- pop rdx ; Word string pointer
-
- mov rdi, [here] ; rdi = Address at which to insert this entry
- mov rax, [latest_entry] ; rax = Address of the previous entry
- mov [rdi], rax ; Insert link to previous entry
- mov [latest_entry], rdi ; Update LATEST to point to this word
-
- add rdi, 8
- mov [rdi], byte 0 ; Insert immediate flag
-
- add rdi, 1
- mov [rdi], byte cl ; Insert length
-
- ;; Insert word string
- add rdi, 1
-
- push rsi
- mov rsi, rdx ; rsi = Word string pointer
- rep movsb
- pop rsi
-
- ;; Update HERE
- mov [here], rdi
-
- next
-
-forth_asm TICK, "'"
- lodsq
- push rax
- next
-
-forth_asm ROT, 'ROT'
- pop rax
- pop rbx
- pop rdx
- push rax
- push rdx
- push rbx
- next
-
-forth_asm PICK, 'PICK'
- pop rax
- lea rax, [rsp + 8 * rax]
- mov rax, [rax]
- push rax
- next
-
-forth_asm EQL, '='
- pop rax
- pop rbx
- cmp rax, rbx
- je .eq
-.noteq:
- push 0
- next
-.eq:
- push 1
- next
-
-forth MAIN, 'MAIN'
- dq SYSCODE
- dq INTERPRET_STRING
- dq INTERPRET
- dq BRANCH, -8 * 2
- dq TERMINATE
-
-;; EFI:
-
-forth EFI_SYSTEM_TABLE_CONSTANT, 'SystemTable'
- dq LIT, system_table, GET
- dq EXIT
-
-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'
- pop rax ; function pointer
- 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 EFICALL10, 'EFICALL10'
- pop rax ; function pointer
-
- mov rcx, [rsp + 8 * 9]
- mov rdx, [rsp + 8 * 8]
- 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:
-
-forth STATE, 'STATE'
- dq LIT, var_STATE
- dq EXIT
-
-forth LATEST, 'LATEST'
- dq LIT, latest_entry
- dq EXIT
-
-forth HERE, 'HERE'
- dq LIT, here
- dq EXIT
-
-forth SYSCODE, 'SYSCODE'
- dq LIT, sysf
- dq LIT, sysf.len
- dq EXIT
-
-forth INPUT_BUFFER, 'INPUT-BUFFER'
- dq LIT, input_buffer
- dq EXIT
-
-forth INPUT_LENGTH, 'INPUT-LENGTH'
- dq LIT, input_buffer_length
- dq EXIT
-
-section '.data' readable writable
-
-;; The LATEST variable holds a pointer to the word that was last added to the
-;; dictionary. This pointer is updated as new words are added, and its value is
-;; used by FIND to look up words.
-latest_entry dq initial_latest_entry
-
-;; The STATE variable is 0 when the interpreter is executing, and non-zero when
-;; it is compiling.
-var_STATE dq 0
-
-;; The interpreter can read either from standard input or from a buffer. When
-;; input-buffer is set (non-null), words like READ-WORD and S" will use this
-;; buffer instead of reading user input.
-input_buffer dq 0
-input_buffer_length dq 0
-
-FIND.rsi dq ?
-
-READ_WORD.rsi dq ?
-READ_WORD.rbp dq ?
-
-READ_STRING.char_buffer db ?
-READ_STRING.buffer rb $FF
-READ_STRING.length dq ?
-
-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 ?
-DOTU.printed_length dq ?
-
-KEY.buffer dq ?
-
-READ_WORD.buffer rb $FF
-READ_WORD.length db ?
-
-;; Reserve space for compiled words, accessed through HERE.
-here dq here_top
-here_top rq $4000
-
-;; Return stack
-rq $2000
-return_stack_top:
-
-;; We store some Forth code in sys.f that defined common words that the user
-;; would expect to have available at startup. To execute these words, we just
-;; include the file directly in the binary, and then interpret it at startup.
-sysf:
-file 'sys.f'
-file 'uefi.f'
-sysf.len = $ - sysf
-
+++ /dev/null
-;; vim: syntax=fasm
-
-format pe64 dll efi
-entry main
-
-;; EFI struct definitions {{{
-
-EFI_NOT_READY = 0x8000_0000_0000_0000 or 6
-
-;; Based on https://wiki.osdev.org/Uefi.inc
-macro struct name {
- virtual at 0
- name name
- end virtual
-}
-
-struc EFI_TABLE_HEADER {
- dq ?
- dd ?
- dd ?
- dd ?
- dd ?
-}
-
-struc EFI_SYSTEM_TABLE {
- .Hdr EFI_TABLE_HEADER
- .FirmwareVendor dq ? ; CHAR16*
- .FirmwareRevision dd ? ; UINT32
- align 8
- .ConsoleInHandle dq ? ; EFI_HANDLE
- .ConIn dq ? ; EFI_SIMPLE_TEXT_INPUT_PROTOCOL*
- .ConsoleOutHandle dq ? ; EFI_HANDLE
- .ConOut dq ? ; EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL*
- ; ...
-}
-struct EFI_SYSTEM_TABLE
-
-struc EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL {
- .Reset dq ? ; EFI_TEXT_RESET
- .OutputString dq ? ; EFI_TEXT_STRING
- ; ...
-}
-struct EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL
-
-struc EFI_SIMPLE_TEXT_INPUT_PROTOCOL {
- .Reset dq ? ; EFI_INPUT_RESET
- .ReadKeyStroke dq ? ; EFI_INPUT_READ_KEY
- ; ...
-}
-struct EFI_SIMPLE_TEXT_INPUT_PROTOCOL
-
-struc EFI_INPUT_KEY {
- .ScanCode dw ? ; UINT16
- .UnicodeChar dw ? ; CHAR16
- align 8
-}
-struct EFI_INPUT_KEY
-
-;; }}}
-
-section '.text' code executable readable
-
-os_initialize:
- ; At program startup, RDX contains an EFI_SYSTEM_TABLE*.
- mov [system_table], rdx
- ret
-
-os_print_string:
- ;; We take an input string of bytes without any terminator. We need to turn
- ;; this string into a string of words, terminated by a null character.
-
- mov rdi, .output_buffer ; Current location in output string
-
-.copy_byte:
- ;; When there are no characters left in the input string, we are done.
- cmp rdx, 0
- je .done
-
- ;; Load byte from input string
- mov al, byte [rcx]
-
- ;; Copy byte to output string
-
- cmp al, $A
- jne .not_newline
-.newline:
- ;; It's a newline; replace it with '\r\n' in output string.
- mov byte [rdi], $D
- inc rdi
- mov byte [rdi], 0
- inc rdi
- mov byte [rdi], $A
- inc rdi
- mov byte [rdi], 0
- inc rdi
- jmp .pop
-
-.not_newline:
- ;; Not a newline, proceed as normal:
- mov byte [rdi], al
- inc rdi
-
- ;; The output string has words rather than bytes for charactesr, so we need
- ;; to add an extra zero:
- mov byte [rdi], 0
- inc rdi
-
-.pop:
- ;; We finished copying character to output string, so pop it from the input
- ;; string.
- inc rcx
- dec rdx
-
- jmp .copy_byte
-.done:
- ;; Append a final null-word:
- mov word [rdi], 0
-
- ; At this point we have our null-terminated word-string at .output_buffer. Now
- ; we just need to print it.
-
- mov rcx, [system_table] ; EFI_SYSTEM_TABLE* rcx
- mov rcx, [rcx + EFI_SYSTEM_TABLE.ConOut] ; EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL* rcx
- mov rdx, .output_buffer
- mov rbx, [rcx + EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL.OutputString] ; EFI_TEXT_STRING rbx
- sub rsp, 32
- call rbx
- add rsp, 32
- ret
-
-os_read_char:
-.read_key:
- mov rcx, [system_table] ; EFI_SYSTEM_TABLE* rcx
- mov rcx, [rcx + EFI_SYSTEM_TABLE.ConIn] ; EFI_SIMPLE_TEXT_INPUT_PROTOCOL* rcx
- mov rbx, [rcx + EFI_SIMPLE_TEXT_INPUT_PROTOCOL.ReadKeyStroke] ; EFI_INPUT_READ_KEY rbx
- mov rdx, input_key ; EFI_INPUT_KEY* rdx
- sub rsp, 32
- call rbx
- add rsp, 32
-
- mov r8, EFI_NOT_READY
- cmp rax, r8
- je .read_key
-
- movzx rax, word [input_key.UnicodeChar]
-
- ;; Special handling of enter (UEFI gives us '\r', but we want '\n'.)
- cmp ax, $D
- jne .no_enter
- mov al, $A
-.no_enter:
-
- push rax
- ;; Print the character
- mov [char_buffer], al
- mov rcx, char_buffer
- mov rdx, 1
- call os_print_string
- pop rax
-
- ret
-
-;; Terminate with the given error code.
-;;
-;; Inputs:
-;; - RCX = Error code
-os_terminate:
- mov rcx, terminated_msg
- mov rdx, terminated_msg.len
- call os_print_string
- jmp $
-
-section '.data' readable writable
-
-system_table dq ? ; EFI_SYSTEM_TABLE*
-
-terminated_msg db 0xD, 0xA, '(The program has terminated.)', 0xD, 0xA
-.len = $ - terminated_msg
-
-os_print_string.output_buffer rq 0x400
-
-char_buffer db ?
-
-input_key EFI_INPUT_KEY
--- /dev/null
+;; vim: syntax=fasm
+
+;; We need some basic words to be available before we can implement the actual
+;; interpreter. For this reason we need to write some words in assembly, even
+;; though they depend only on other Forth words. Such words are defined in this
+;; file.
+;;
+;; With these words, we can finally defined INTERPRET, and from there we'll load
+;; everything else from an external file.
+;;
+;; This file is included from main.asm; see that file for more information.
+
+;; Define a Forth word that is implemented in Forth. (The body will be a list of
+;; 'dq' statements.)
+macro forth label, name, immediate {
+ header label, name, immediate
+ dq DOCOL
+}
+
+forth COMMA, ','
+ dq HERE, GET, PUT ; Set the memory at the address pointed to by HERE
+ dq HERE, GET, LIT, 8, PLUS ; Calculate new address for HERE to point to
+ dq HERE, PUT ; Update HERE to point to the new address
+ dq EXIT
+
+;; Mark the last added word as immediate.
+forth IMMEDIATE, 'IMMEDIATE', 1
+ dq LIT, 1
+ dq LATEST, GET
+ dq LIT, 8, PLUS
+ dq PUT_BYTE
+ dq EXIT
+
+;; Given the address of a word, return 0 if the given word is not immediate.
+forth IS_IMMEDIATE, 'IMMEDIATE?'
+ dq LIT, 8, PLUS
+ dq GET_BYTE
+ dq EXIT
+
+;; Enter immediate mode, immediately
+forth INTO_IMMEDIATE, '[', 1
+ dq LIT, 0, STATE, PUT_BYTE
+ dq EXIT
+
+;; Enter compilation mode
+forth OUTOF_IMMEDIATE, ']'
+ dq LIT, 1, STATE, PUT_BYTE
+ dq EXIT
+
+;; INTERPRET-WORD expects a word as a (buffer, length) pair on the stack. It
+;; interprets and executes the word. It's behavior depends on the current STATE.
+;; It provides special handling for integers.
+forth INTERPRET_WORD, 'INTERPRET-WORD'
+ dq PAIRDUP
+ ;; Stack is (word length word length).
+ dq FIND ; Try to find word
+ dq DUP_
+ dq ZBRANCH, 8 * 22 ; Check if word is found
+
+ ;; - Word is found -
+
+ dq STATE, GET, ZBRANCH, 8 * 11 ; Check whether we are in compilation or immediate mode
+
+ ;; (Word found, compilation mode)
+ dq DUP_, IS_IMMEDIATE, NOT_, ZBRANCH, 8 * 6 ; If the word is immediate, continue as we would in immediate mode
+
+ ;; Otherwise, we want to compile this word
+ dq TCFA
+ dq COMMA
+ dq DROP, DROP
+ dq EXIT
+
+ ;; (Word found, immediate mode)
+ ;; Execute word
+ dq TCFA
+ ;; Stack is (word length addr)
+ dq SWAP, DROP
+ dq SWAP, DROP
+ ;; Stack is (addr)
+ dq EXEC
+ dq EXIT
+
+ ;; - No word is found, assume it is an integer literal -
+ ;; Stack is (word length addr)
+ dq DROP
+ dq PARSE_NUMBER
+
+ dq STATE, GET, ZBRANCH, 8 * 5 ; Check whether we are in compilation or immediate mode
+
+ ;; (Number, compilation mode)
+ dq LIT, LIT, COMMA
+ dq COMMA
+ dq EXIT
+
+ ;; (Number, immediate mode)
+ dq EXIT
+
+;; The INTERPRET word reads and interprets a single word from the user.
+forth INTERPRET, 'INTERPRET'
+ dq READ_WORD
+ dq INTERPRET_WORD
+ dq EXIT
+
+;; INTERPRET_STRING is a variant of INTERPRET that reads from a string instead
+;; of from the user. It takes a string as a (buffer, length) pair on the stack
+;; and interprets the entire string, even if the string has more than one word.
+forth INTERPRET_STRING, 'INTERPRET-STRING'
+ dq INPUT_LENGTH, PUT
+ dq INPUT_BUFFER, PUT
+
+ ;; Check if the buffer is-non-empty
+ ;; [TODO] This probably won't work for strings with whitespace at the end.
+ dq INPUT_LENGTH, GET
+ dq ZBRANCH, 8 * 5 ; to EXIT
+
+ dq READ_WORD
+
+ dq INTERPRET_WORD
+ dq BRANCH, -8 * 7 ; to INPUT-LENGTH @
+
+ dq LIT, 0, INPUT_BUFFER, PUT
+
+ dq EXIT
--- /dev/null
+section '.text' code readable executable
+
+macro printlen msg, len {
+ push rsi
+ add rsp, 8
+
+ mov rcx, msg
+ mov rdx, len
+ call os_print_string
+
+ sub rsp, 8
+ pop rsi
+}
+
+macro newline {
+ push $A
+ printlen rsp, 1
+}
+
+macro print msg {
+ printlen msg, msg#.len
+}
+
+struc string bytes {
+ . db bytes
+ .len = $ - .
+}
+
+;; Find the given word in the dictionary of words. If no such word exists,
+;; return 0.
+;;
+;; Parameters:
+;; * [find.search_length] = Length of the word in bytes.
+;; * [find.search_buffer] = Pointer to the string containing the word.
+;; * rsi = Pointer to the last entry in the dictionary.
+;;
+;; Results:
+;; * rsi = Pointer to the found entry in the dictionary or 0.
+;;
+;; Clobbers rcx, rdx, rdi, rax.
+find:
+ ;; RSI contains the entry we are currently looking at
+.loop:
+ movzx rcx, byte [rsi + 8 + 1] ; Length of word being looked at
+ cmp rcx, [.search_length]
+ jne .next ; If the words don't have the same length, we have the wrong word
+
+ ;; Otherwise, we need to compare strings
+ lea rdx, [rsi + 8 + 1 + 1] ; Location of character being compared in entry
+ mov rdi, [.search_buffer] ; Location of character being compared in search buffer
+.compare_char:
+ mov al, [rdx]
+ mov ah, [rdi]
+ cmp al, ah
+ jne .next ; They don't match; try again
+ inc rdx ; These characters match; look at the next ones
+ inc rdi
+ loop .compare_char
+
+ jmp .found ; They match! We are done.
+
+.next:
+ mov rsi, [rsi] ; Look at the previous entry
+ cmp rsi, 0
+ jnz .loop ; If there is no previous word, exit and return 0
+
+.found:
+ ret
+
+;; Read a word from a buffer. Returns the buffer without the word, as well as
+;; the word that was read (including lengths).
+;;
+;; Inputs:
+;; * rsi = Input buffer
+;; * rcx = Length of buffer
+;;
+;; Outputs:
+;; * rsi = Updated buffer
+;; * rcx = Length of updated buffer
+;; * rdi = Word buffer
+;; * rdx = Length of word buffer
+pop_word:
+.skip_whitespace:
+ mov al, [rsi]
+ cmp al, ' '
+ je .got_whitespace
+ cmp al, $A
+ je .got_whitespace
+ jmp .alpha
+.got_whitespace:
+ ;; The buffer starts with whitespace; discard the first character from the buffer.
+ inc rsi
+ dec rcx
+ jmp .skip_whitespace
+
+.alpha:
+ ;; We got a character that wasn't whitespace. Now read the actual word.
+ mov rdi, rsi ; This is where the word starts
+ mov rdx, 1 ; Length of word
+
+.read_alpha:
+ ;; Extract character from original buffer:
+ inc rsi
+ dec rcx
+
+ ;; When we hit whitespace, we are done with this word
+ mov al, [rsi]
+ cmp al, ' '
+ je .end
+ cmp al, $A
+ je .end
+
+ ;; It wasn't whitespace; add it to word buffer
+ inc rdx
+ jmp .read_alpha
+
+.end:
+ ;; Finally, we want to skip one whitespace character after the word.
+ inc rsi
+ dec rcx
+
+ ret
+
+;; Parses a string.
+;;
+;; Parameters:
+;; * rcx = Length of string
+;; * rdi = Pointer to string buffer
+;;
+;; Results:
+;; * rax = Value
+;;
+;; Clobbers
+parse_number:
+ mov r8, 0 ; Result
+
+ ;; Add (10^(rcx-1) * parse_char(rdi[length - rcx])) to the accumulated value
+ ;; for each rcx.
+ mov [.length], rcx
+.loop:
+ ;; First, calcuate 10^(rcx - 1)
+ mov rax, 1
+
+ mov r9, rcx
+ .exp_loop:
+ dec r9
+ jz .break
+ mov rbx, 10
+ mul rbx
+ jmp .exp_loop
+ .break:
+
+ ;; Now, rax = 10^(rcx - 1).
+
+ ;; We need to calulate the value of the character at rdi[length - rcx].
+ mov rbx, rdi
+ add rbx, [.length]
+ sub rbx, rcx
+ movzx rbx, byte [rbx]
+ sub rbx, '0'
+
+ cmp rbx, 10
+ jae .error
+
+ ;; Multiply this value by rax to get (10^(rcx-1) * parse_char(rdi[length - rcx])),
+ ;; then add this to the result.
+ mul rbx
+
+ ;; Add that value to r8
+ add r8, rax
+
+ dec rcx
+ jnz .loop
+
+ mov rax, r8
+ ret
+
+.error:
+ push rdi
+ print parse_number.error_msg
+ pop rdi
+ printlen rdi, [.length]
+ newline
+ mov rax, 100
+ call os_terminate
+
+section '.data' readable writable
+
+find.search_length dq ?
+find.search_buffer dq ?
+
+parse_number.length dq ?
+parse_number.error_msg string "Invalid number: "
+
--- /dev/null
+;; The UEFI module defines the following functions. Each of these functions
+;; preserve the value of RSI and RSP. They may use other registers as they like.
+;;
+;; os_initialize
+;; Called at initialization.
+;;
+;; os_print_string
+;; Takes a string buffer in RCX and the length in RDX, and prints the string
+;; to the console.
+;;
+;; os_read_char
+;; Wait for the user to type a key, and then put the corresponding ASCII byte
+;; into RAX.
+;;
+;; os_terminate
+;; Shut down the system, returning the error code given in RAX.
+include 'os/uefi.asm'
+
+;; The code in this macro is placed at the end of each Forth word. When we are
+;; executing a definition, this code is what causes execution to resume at the
+;; next word in that definition.
+macro next {
+ ;; RSI points to the address of the definition of the next word to execute.
+ lodsq ; Load value at RSI into RAX and increment RSI
+ ;; Now RAX contains the location of the next word to execute. The first 8
+ ;; bytes of this word is the address of the codeword, which is what we want
+ ;; to execute.
+ jmp qword [rax] ; Jump to the codeword of the current word
+}
+
+;; pushr and popr work on the return stack, whose location is stored in the
+;; register RBP.
+macro pushr x {
+ sub rbp, 8
+ mov qword [rbp], x
+}
+macro popr x {
+ mov x, [rbp]
+ add rbp, 8
+}
+
+;; The following macro generates the dictionary header. It updates the
+;; initial_latest_entry variable, which is used as the initial value of the
+;; latest_entry variable that is made available at runtime.
+;;
+;; The header contains a link to the previous entry, the length of the name of
+;; the word and the word itself as a string literal.
+;;
+;; This macro also defines a label LABEL_entry.
+initial_latest_entry = 0
+macro header label, name, immediate {
+ local .string_end
+
+label#_entry:
+ dq initial_latest_entry
+ if immediate eq
+ db 0
+ else
+ db 1
+ end if
+ db .string_end - ($ + 1)
+ db name
+ .string_end:
+label:
+
+initial_latest_entry = label#_entry
+}
+
+;; Define a Forth word that is implemented in assembly. See 'header' for details.
+macro forth_asm label, name, immediate {
+ header label, name, immediate
+ dq .start
+.start:
+}
+
+section '.text' code readable executable
+
+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]
+
+ mov rdi, .buffer
+ add rdi, [.printed_length]
+ sub rdi, rcx
+ mov [rdi], al
+
+ loop .flip
+
+ ;; Print the buffer
+ mov rcx, .buffer
+ mov rdx, [.printed_length]
+ call os_print_string
+
+ ;; Restore RSI and continue execution
+ pop rsi
+ next
+
+;; Takes a value and an address, and stores the value at the given address.
+forth_asm PUT, '!'
+ pop rbx ; Address
+ pop rax ; Value
+ mov [rbx], rax
+ next
+
+;; Takes an address and returns the value at the given address.
+forth_asm GET, '@'
+ pop rax
+ mov rax, [rax]
+ push rax
+ next
+
+forth_asm PUT_BYTE, 'C!'
+ pop rbx
+ pop rax ; Value
+ mov [rbx], al
+ next
+
+forth_asm GET_BYTE, 'C@'
+ pop rax
+ movzx rax, byte [rax]
+ push rax
+ next
+
+;; Add two integers on the stack.
+forth_asm PLUS, '+'
+ pop rax
+ pop rbx
+ add rax, rbx
+ push rax
+ next
+
+;; Calculate difference between two integers on the stack. The second number is
+;; subtracted from the first.
+forth_asm MINUS, '-'
+ pop rax
+ pop rbx
+ sub rbx, rax
+ push rbx
+ 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
+ mov rdx, 0
+ div rbx
+ push rax ; a / b
+ push rdx ; a % b
+ next
+
+;; Read input until next " character is found. Push a string containing the
+;; input on the stack as (buffer length). Note that the buffer is only valid
+;; until the next call to S" and that no more than 255 characters can be read.
+forth_asm READ_STRING, 'S"'
+ ;; If the input buffer is set, we should read from there instead.
+ cmp [input_buffer], 0
+ jne read_string_buffer
+
+ push rsi
+
+ mov [.length], 0
+
+.read_char:
+ call os_read_char
+ cmp al, '"'
+ je .done
+
+ mov rdx, .buffer
+ add rdx, [.length]
+ mov [rdx], al
+ inc [.length]
+ jmp .read_char
+
+.done:
+ pop rsi
+
+ push .buffer
+ push [.length]
+
+ next
+
+read_string_buffer:
+ push rsi
+
+ ;; We borrow READ_STRING's buffer. They won't mind.
+ mov [READ_STRING.length], 0
+
+.read_char:
+ mov rbx, [input_buffer]
+ mov al, [rbx]
+ cmp al, '"'
+ je .done
+
+ mov rdx, READ_STRING.buffer
+ add rdx, [READ_STRING.length]
+ mov [rdx], al
+ inc [READ_STRING.length]
+
+ inc [input_buffer]
+ dec [input_buffer_length]
+
+ jmp .read_char
+
+.done:
+ pop rsi
+
+ ;; Skip closing "
+ inc [input_buffer]
+ dec [input_buffer_length]
+
+ push READ_STRING.buffer
+ push [READ_STRING.length]
+
+ next
+
+;; CREATE inserts a new header in the dictionary, and updates LATEST so that it
+;; points to the header. To compile a word, the user can then call ',' to
+;; continue to append data after the header.
+;;
+;; It takes the name of the word as a string (address length) on the stack.
+forth_asm CREATE, 'CREATE'
+ pop rcx ; Word string length
+ pop rdx ; Word string pointer
+
+ mov rdi, [here] ; rdi = Address at which to insert this entry
+ mov rax, [latest_entry] ; rax = Address of the previous entry
+ mov [rdi], rax ; Insert link to previous entry
+ mov [latest_entry], rdi ; Update LATEST to point to this word
+
+ add rdi, 8
+ mov [rdi], byte 0 ; Insert immediate flag
+
+ add rdi, 1
+ mov [rdi], byte cl ; Insert length
+
+ ;; Insert word string
+ add rdi, 1
+
+ push rsi
+ mov rsi, rdx ; rsi = Word string pointer
+ rep movsb
+ pop rsi
+
+ ;; Update HERE
+ mov [here], rdi
+
+ next
+
+forth_asm TICK, "'"
+ lodsq
+ push rax
+ next
+
+forth_asm ROT, 'ROT'
+ pop rax
+ pop rbx
+ pop rdx
+ push rax
+ push rdx
+ push rbx
+ next
+
+forth_asm PICK, 'PICK'
+ pop rax
+ lea rax, [rsp + 8 * rax]
+ mov rax, [rax]
+ push rax
+ next
+
+forth_asm EQL, '='
+ pop rax
+ pop rbx
+ cmp rax, rbx
+ je .eq
+.noteq:
+ push 0
+ next
+.eq:
+ push 1
+ next
+
+forth MAIN, 'MAIN'
+ dq SYSCODE
+ dq INTERPRET_STRING
+ dq INTERPRET
+ dq BRANCH, -8 * 2
+ dq TERMINATE
+
+;; EFI:
+
+forth EFI_SYSTEM_TABLE_CONSTANT, 'SystemTable'
+ dq LIT, system_table, GET
+ dq EXIT
+
+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'
+ pop rax ; function pointer
+ 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 EFICALL10, 'EFICALL10'
+ pop rax ; function pointer
+
+ mov rcx, [rsp + 8 * 9]
+ mov rdx, [rsp + 8 * 8]
+ 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:
+
+forth STATE, 'STATE'
+ dq LIT, var_STATE
+ dq EXIT
+
+forth LATEST, 'LATEST'
+ dq LIT, latest_entry
+ dq EXIT
+
+forth HERE, 'HERE'
+ dq LIT, here
+ dq EXIT
+
+forth SYSCODE, 'SYSCODE'
+ dq LIT, sysf
+ dq LIT, sysf.len
+ dq EXIT
+
+forth INPUT_BUFFER, 'INPUT-BUFFER'
+ dq LIT, input_buffer
+ dq EXIT
+
+forth INPUT_LENGTH, 'INPUT-LENGTH'
+ dq LIT, input_buffer_length
+ dq EXIT
+
+section '.data' readable writable
+
+;; The LATEST variable holds a pointer to the word that was last added to the
+;; dictionary. This pointer is updated as new words are added, and its value is
+;; used by FIND to look up words.
+latest_entry dq initial_latest_entry
+
+;; The STATE variable is 0 when the interpreter is executing, and non-zero when
+;; it is compiling.
+var_STATE dq 0
+
+;; The interpreter can read either from standard input or from a buffer. When
+;; input-buffer is set (non-null), words like READ-WORD and S" will use this
+;; buffer instead of reading user input.
+input_buffer dq 0
+input_buffer_length dq 0
+
+FIND.rsi dq ?
+
+READ_WORD.rsi dq ?
+READ_WORD.rbp dq ?
+
+READ_STRING.char_buffer db ?
+READ_STRING.buffer rb $FF
+READ_STRING.length dq ?
+
+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 ?
+DOTU.printed_length dq ?
+
+KEY.buffer dq ?
+
+READ_WORD.buffer rb $FF
+READ_WORD.length db ?
+
+;; Reserve space for compiled words, accessed through HERE.
+here dq here_top
+here_top rq $4000
+
+;; Return stack
+rq $2000
+return_stack_top:
+
+;; We store some Forth code in sys.f that defined common words that the user
+;; would expect to have available at startup. To execute these words, we just
+;; include the file directly in the binary, and then interpret it at startup.
+sysf:
+file '../init/sys.f'
+file '../init/uefi.f'
+sysf.len = $ - sysf
+
--- /dev/null
+;; vim: syntax=fasm
+
+format pe64 dll efi
+entry main
+
+;; EFI struct definitions {{{
+
+EFI_NOT_READY = 0x8000_0000_0000_0000 or 6
+
+;; Based on https://wiki.osdev.org/Uefi.inc
+macro struct name {
+ virtual at 0
+ name name
+ end virtual
+}
+
+struc EFI_TABLE_HEADER {
+ dq ?
+ dd ?
+ dd ?
+ dd ?
+ dd ?
+}
+
+struc EFI_SYSTEM_TABLE {
+ .Hdr EFI_TABLE_HEADER
+ .FirmwareVendor dq ? ; CHAR16*
+ .FirmwareRevision dd ? ; UINT32
+ align 8
+ .ConsoleInHandle dq ? ; EFI_HANDLE
+ .ConIn dq ? ; EFI_SIMPLE_TEXT_INPUT_PROTOCOL*
+ .ConsoleOutHandle dq ? ; EFI_HANDLE
+ .ConOut dq ? ; EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL*
+ ; ...
+}
+struct EFI_SYSTEM_TABLE
+
+struc EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL {
+ .Reset dq ? ; EFI_TEXT_RESET
+ .OutputString dq ? ; EFI_TEXT_STRING
+ ; ...
+}
+struct EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL
+
+struc EFI_SIMPLE_TEXT_INPUT_PROTOCOL {
+ .Reset dq ? ; EFI_INPUT_RESET
+ .ReadKeyStroke dq ? ; EFI_INPUT_READ_KEY
+ ; ...
+}
+struct EFI_SIMPLE_TEXT_INPUT_PROTOCOL
+
+struc EFI_INPUT_KEY {
+ .ScanCode dw ? ; UINT16
+ .UnicodeChar dw ? ; CHAR16
+ align 8
+}
+struct EFI_INPUT_KEY
+
+;; }}}
+
+section '.text' code executable readable
+
+os_initialize:
+ ; At program startup, RDX contains an EFI_SYSTEM_TABLE*.
+ mov [system_table], rdx
+ ret
+
+os_print_string:
+ ;; We take an input string of bytes without any terminator. We need to turn
+ ;; this string into a string of words, terminated by a null character.
+
+ mov rdi, .output_buffer ; Current location in output string
+
+.copy_byte:
+ ;; When there are no characters left in the input string, we are done.
+ cmp rdx, 0
+ je .done
+
+ ;; Load byte from input string
+ mov al, byte [rcx]
+
+ ;; Copy byte to output string
+
+ cmp al, $A
+ jne .not_newline
+.newline:
+ ;; It's a newline; replace it with '\r\n' in output string.
+ mov byte [rdi], $D
+ inc rdi
+ mov byte [rdi], 0
+ inc rdi
+ mov byte [rdi], $A
+ inc rdi
+ mov byte [rdi], 0
+ inc rdi
+ jmp .pop
+
+.not_newline:
+ ;; Not a newline, proceed as normal:
+ mov byte [rdi], al
+ inc rdi
+
+ ;; The output string has words rather than bytes for charactesr, so we need
+ ;; to add an extra zero:
+ mov byte [rdi], 0
+ inc rdi
+
+.pop:
+ ;; We finished copying character to output string, so pop it from the input
+ ;; string.
+ inc rcx
+ dec rdx
+
+ jmp .copy_byte
+.done:
+ ;; Append a final null-word:
+ mov word [rdi], 0
+
+ ; At this point we have our null-terminated word-string at .output_buffer. Now
+ ; we just need to print it.
+
+ mov rcx, [system_table] ; EFI_SYSTEM_TABLE* rcx
+ mov rcx, [rcx + EFI_SYSTEM_TABLE.ConOut] ; EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL* rcx
+ mov rdx, .output_buffer
+ mov rbx, [rcx + EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL.OutputString] ; EFI_TEXT_STRING rbx
+ sub rsp, 32
+ call rbx
+ add rsp, 32
+ ret
+
+os_read_char:
+.read_key:
+ mov rcx, [system_table] ; EFI_SYSTEM_TABLE* rcx
+ mov rcx, [rcx + EFI_SYSTEM_TABLE.ConIn] ; EFI_SIMPLE_TEXT_INPUT_PROTOCOL* rcx
+ mov rbx, [rcx + EFI_SIMPLE_TEXT_INPUT_PROTOCOL.ReadKeyStroke] ; EFI_INPUT_READ_KEY rbx
+ mov rdx, input_key ; EFI_INPUT_KEY* rdx
+ sub rsp, 32
+ call rbx
+ add rsp, 32
+
+ mov r8, EFI_NOT_READY
+ cmp rax, r8
+ je .read_key
+
+ movzx rax, word [input_key.UnicodeChar]
+
+ ;; Special handling of enter (UEFI gives us '\r', but we want '\n'.)
+ cmp ax, $D
+ jne .no_enter
+ mov al, $A
+.no_enter:
+
+ push rax
+ ;; Print the character
+ mov [char_buffer], al
+ mov rcx, char_buffer
+ mov rdx, 1
+ call os_print_string
+ pop rax
+
+ ret
+
+;; Terminate with the given error code.
+;;
+;; Inputs:
+;; - RCX = Error code
+os_terminate:
+ mov rcx, terminated_msg
+ mov rdx, terminated_msg.len
+ call os_print_string
+ jmp $
+
+section '.data' readable writable
+
+system_table dq ? ; EFI_SYSTEM_TABLE*
+
+terminated_msg db 0xD, 0xA, '(The program has terminated.)', 0xD, 0xA
+.len = $ - terminated_msg
+
+os_print_string.output_buffer rq 0x400
+
+char_buffer db ?
+
+input_key EFI_INPUT_KEY
+++ /dev/null
-S" :" CREATE ] DOCOL
- READ-WORD CREATE
- LIT DOCOL ,
- ]
-EXIT [
-
-: ;
- LIT EXIT ,
- [ S" [" FIND >CFA , ]
- EXIT
-[ IMMEDIATE
-
-: IF IMMEDIATE
- ' 0BRANCH ,
- HERE @
- 0 ,
-;
-
-: THEN IMMEDIATE
- DUP
- HERE @ SWAP -
- SWAP !
-;
-
-: ELSE IMMEDIATE
- ' BRANCH ,
- HERE @
- 0 ,
- SWAP DUP HERE @ SWAP - SWAP !
-;
-
-: BEGIN IMMEDIATE
- HERE @
-;
-
-: AGAIN IMMEDIATE
- ' BRANCH ,
- HERE @ - , ;
-
-: ( IMMEDIATE
- BEGIN
- READ-WORD
- 1 = IF
- C@ 41 = IF
- EXIT
- THEN
- ELSE
- DROP
- THEN
- AGAIN ; ( Yay! We now have comments! )
-
-: UNTIL IMMEDIATE
- ' 0BRANCH ,
- HERE @ - ,
-;
-
-( Compile a literal value into the current word. )
-: LIT, IMMEDIATE ( x -- )
- ' LIT , , ;
-
-: / /MOD DROP ;
-: MOD /MOD SWAP DROP ;
-: NEG 0 SWAP - ;
-
-: C,
- HERE @ C!
- HERE @ 1 +
- HERE ! ;
-
-: OVER ( a b -- a b a ) SWAP DUP ROT ;
-
-( An alternative comment syntax. Reads until the end of the line. )
-: \ IMMEDIATE
- BEGIN
- KEY
- 10 = UNTIL ;
-
-\ So far, S" has only worked in immediate mode, which is backwards -- actually,
-\ the main use-case of this is as a compile-time word. Let's fix that.
-: S" IMMEDIATE
- ' LITSTRING ,
- HERE @ 0 C, \ We will put the length here
- 0
- BEGIN
- 1 +
- KEY DUP C,
- 34 = UNTIL
- \ Remove final "
- HERE @ 1 - HERE !
- 1 -
- SWAP C! ;
-
-( Compile the given string into the current word directly. )
-: STORE-STRING ( str len -- )
- BEGIN
- OVER C@ C,
- SWAP 1 + SWAP
- 1 - DUP 0 = UNTIL
- DROP DROP ;
-
-: NEWLINE 10 EMIT ;
-: SPACE 32 EMIT ;
-
-( Read a number from standard input. )
-: READ-NUMBER READ-WORD PARSE-NUMBER ;
-
-: RESTART S" Ready." TELL NEWLINE ;
-RESTART
-
+++ /dev/null
-: ConOut SystemTable 64 + @ ;
-: ConOut.OutputString ConOut 8 + @ ;
-: ConOut.OutputString() ConOut SWAP ConOut.OutputString EFICALL2 ;
-
-: BootServices SystemTable 96 + @ ;
-: BootServices.LocateProtocol BootServices 320 + @ ;
-: GraphicsOutputProtocol
- \ [TODO] It would be nice to cache this value, so we don't have to get it
- \ every time.
- HERE @ 5348063987722529246 , 7661046075708078998 , \ *Protocol = EFI_GRAPHICS_OUTPUT_PROTOCOL_GUID
- 0 \ *Registration
- HERE @ 0 , \ **Interface
- BootServices.LocateProtocol EFICALL3 DROP
- HERE @ 8 - @ \ *Interface
- ;
-: GOP.Blt GraphicsOutputProtocol 16 + @ ;
-: GOP.Blt() ( GOP buffer mode sx sy dx dy dw dh pitch -- )
- GOP.Blt EFICALL10 0 = IF ELSE S" Warning: Invalid Blt()" TELL THEN ;
-: GOP.SetMode GraphicsOutputProtocol 8 + @ ;
-
-: EfiBltVideoFill 0 ;
-
-\ Store a null-terminated UTF-16 string HERE, and return a pointer to its buffer
-\ at runtime.
-: UTF16"
- HERE @
- BEGIN
- KEY DUP C,
- 0 C,
- 34 = UNTIL
- HERE @ 2 - HERE ! \ Remove final "
- 0 C, 0 C, \ Null terminator
- ;
projects / rrq / jonasforth.git / commitdiff