049cb13e8b50df3ca0d56c7bdbc01fd5a19ba7df
[rrq/jonasforth.git] / main.asm
1 format ELF64 executable
2
3 ;; The code in this macro is placed at the end of each Forth word. When we are
4 ;; executing a definition, this code is what causes execution to resume at the
5 ;; next word in that definition.
6 macro next {
7   ;; RSI points to the address of the definition of the next word to execute.
8   lodsq                   ; Load value at RSI into RAX and increment RSI
9   ;; Now RAX contains the location of the next word to execute. The first 8
10   ;; bytes of this word is the address of the codeword, which is what we want
11   ;; to execute.
12   jmp qword [rax]         ; Jump to the codeword of the current word
13 }
14
15 ;; pushr and popr work on the return stack, whose location is stored in the
16 ;; register RBP.
17 macro pushr x {
18   sub rbp, 8
19   mov qword [rbp], x
20 }
21 macro popr x {
22   mov x, [rbp]
23   add rbp, 8
24 }
25
26 segment readable executable
27
28 main:
29   cld                        ; Clear direction flag so LODSQ does the right thing.
30   mov rbp, return_stack_top  ; Initialize return stack
31
32   mov rsi, program
33   next
34
35 program: dq MAIN
36
37 ;; The codeword is the code that will be executed at the beginning of a forth
38 ;; word. It needs to save the old RSI and update it to point to the next word to
39 ;; execute.
40 docol:
41   pushr rsi            ; Save old value of RSI on return stack; we will continue execution there after we are done executing this word
42   lea rsi, [rax + 8]   ; RAX currently points to the address of the codeword, so we want to continue at RAX+8
43   next                 ; Execute word pointed to by RSI
44
45 ;; This word is called at the end of a Forth definition. It just needs to
46 ;; restore the old value of RSI (saved by 'docol') and resume execution.
47 EXIT:
48   dq .start
49 .start:
50   popr rsi
51   next
52
53 ;; LIT is a special word that reads the next "word pointer" and causes it to be
54 ;; placed on the stack rather than executed.
55 LIT:
56   dq .start
57 .start:
58   lodsq
59   push rax
60   next
61
62 EMIT:
63   dq .start
64 .start:
65   pushr rsi
66   pushr rax
67   mov rax, 1
68   mov rdi, 1
69   lea rsi, [rsp]
70   mov rdx, 1
71   syscall
72   add rsp, 8
73   popr rax
74   popr rsi
75   next
76
77 NEWLINE:
78   dq docol
79   dq LIT, $A
80   dq EMIT
81   dq EXIT
82
83 ;; Read a word from standard input and push it onto the stack as a pointer and a
84 ;; size. The pointer is valid until the next call to READ_WORD.
85 READ_WORD:  ; 400170
86   dq .start
87 .start:
88   mov [.rsi], rsi
89   mov [.rax], rax
90
91 .skip_whitespace:
92   ;; Read characters into .char_buffer until one of them is not whitespace.
93   mov rax, 0
94   mov rdi, 0
95   mov rsi, .char_buffer
96   mov rdx, 1
97   syscall
98
99   cmp [.char_buffer], ' '
100   je .skip_whitespace
101   cmp [.char_buffer], $A
102   je .skip_whitespace
103
104 .alpha:
105   ;; We got a character that wasn't whitespace. Now read the actual word.
106   mov [.length], 0
107
108 .read_alpha:
109   mov al, [.char_buffer]
110   movzx rbx, [.length]
111   mov rsi, .buffer
112   add rsi, rbx
113   mov [rsi], al
114   inc [.length]
115
116   mov rax, 0
117   mov rdi, 0
118   mov rsi, .char_buffer
119   mov rdx, 1
120   syscall
121
122   cmp [.char_buffer], ' '
123   je .end
124   cmp [.char_buffer], $A
125   jne .read_alpha
126
127 .end:
128   push .buffer
129   movzx rax, [.length]
130   push rax
131
132   mov rsi, [.rsi]
133   mov rax, [.rax]
134
135   next
136
137 TYPE:
138   dq .start
139 .start:
140   mov rbx, rsi
141   mov rcx, rax
142
143   mov rax, 1
144   mov rdi, 1
145   pop rdx     ; Length
146   pop rsi     ; Buffer
147   syscall
148
149   mov rax, rcx
150   mov rsi, rbx
151   next
152
153 PUSH_HELLO_CHARS:
154   dq docol
155   dq LIT, $A
156   dq LIT, 'o'
157   dq LIT, 'l'
158   dq LIT, 'l'
159   dq LIT, 'e'
160   dq LIT, 'H'
161   dq EXIT
162
163 PUSH_YOU_TYPED:
164   dq .start
165 .start:
166   push you_typed_string
167   push you_typed_string.length
168   next
169
170 HELLO:
171   dq docol
172   dq LIT, 'H', EMIT
173   dq LIT, 'e', EMIT
174   dq LIT, 'l', EMIT
175   dq LIT, 'l', EMIT
176   dq LIT, 'o', EMIT
177   dq LIT, '!', EMIT
178   dq NEWLINE
179   dq EXIT
180
181 TERMINATE:
182   dq .start
183 .start:
184   mov rax, $3C
185   mov rdi, 0
186   syscall
187
188 MAIN:
189   dq docol
190   dq HELLO
191   dq READ_WORD
192   dq LIT, you_typed_string
193   dq LIT, you_typed_string.length
194   dq TYPE
195   dq TYPE
196   dq NEWLINE
197   dq HELLO
198   dq TERMINATE
199
200 segment readable writable
201
202 you_typed_string db 'You typed: '
203 .length = $ - you_typed_string
204
205 READ_WORD.rsi dq ?
206 READ_WORD.rax dq ?
207 READ_WORD.max_size = $FF
208 READ_WORD.buffer rb READ_WORD.max_size
209 READ_WORD.length db ?
210 READ_WORD.char_buffer db ?
211
212
213 ;; Return stack
214 rq $2000
215 return_stack_top: