Byte-machine for the fort (and not only) in Indian (Part 3)
The year 2019 has come. The New Year holidays are coming to an end. It's time to start remembering bytes, commands, variables, cycles ...
Something I have already forgotten with these holidays. We'll have to remember together!
')
Today we will make an interpreter for our byte-machine. This is the third article, the first parts here: part 1 , part 2 .
All happy new year, and welcome under kat!
To begin, answer questions from fpauk . These questions are completely correct. Now the architecture of this byte-machine is such that we work with direct, processor addresses. But these addresses are not in the byte-code, they are formed after the start of the system. After starting the system, we can create any pointers, and this code will work correctly on any platform. For example, the address of a variable or array can be obtained with the var0 command. This command will work on any platform and return the correct address specific to that platform. Then you can somehow work with this address.
But still, fpauk is right. Address in bytecode can not be saved. It turns out that we can write platform-independent code, but for this we need to make some effort. In particular, make sure that the bytecode does not get the address. And they can get if, for example, the compiled code is saved to a file. There will be data in it, and they can be addresses. For example, the values ​​of the variables here, context, and others.
To get rid of such a problem, you need to make the addresses virtual. Addressing the x86 processor is quite powerful, and, in most cases, it will not even add extra commands. But nevertheless I will continue in the current architecture, with absolute addresses. And then, when we reach the tests, it will be possible to remake the addresses into virtual ones, and see how this affects the performance. It is interesting.
Warm up
And now a little warm-up. Let's make another batch of small but useful byte commands. These will be the nip, emit, 1+, + !, -!, Count commands, work with return stack r>,> r, r @, string literal ("), and constant words 1, 2, 3, 4, 8. Do not forget to include them in the command table.
Here is the code for these commands.
b_nip = 0x39 bcmd_nip: pop rax mov [rsp], rax jmp _next b_emit = 0x81 bcmd_emit: pop rax mov rsi, offset emit_buf # mov [rsi], al mov rax, 1 # â„– 1 - sys_write mov rdi, 1 # â„– 1 - stdout mov rdx, 1 # push r8 syscall # pop r8 jmp _next b_wp = 0x18 bcmd_wp: incq [rsp] jmp _next b_setp = 0x48 bcmd_setp: pop rcx pop rax add [rcx], rax jmp _next b_setm = 0x49 bcmd_setm: pop rcx pop rax sub [rcx], rax jmp _next b_2r = 0x60 bcmd_2r: pop rax sub rbp, 8 mov [rbp], rax jmp _next b_r2 = 0x61 bcmd_r2: push [rbp] add rbp, 8 jmp _next b_rget = 0x62 bcmd_rget: push [rbp] jmp _next b_str = 0x82 bcmd_str: movzx rax, byte ptr [r8] lea r8, [r8 + rax + 1] jmp _next b_count = 0x84 bcmd_count: pop rcx movzx rax, byte ptr [rcx] inc rcx push rcx push rax jmp _next b_num1 = 0x03 bcmd_num1: push 1 jmp _next b_num2 = 0x04 bcmd_num2: push 2 jmp _next b_num3 = 0x05 bcmd_num3: push 3 jmp _next b_num4 = 0x06 bcmd_num4: push 4 jmp _next b_num8 = 0x07 bcmd_num8: push 8 jmp _next The nip command deletes the word under the top of the stack. It is equivalent to the swap drop commands. Sometimes it can be useful.
The emit command prints one character from the stack. It uses the same system call number 1, a character buffered with a length of 1.
The count command is very simple - it takes from the stack the address of the line with the counter and turns it into two values ​​- the address of the line without a counter and the length.
The b_2r, b_r2, b_rget commands are the Fort words r>,> r, r @. The first one gets the word from the stack of returns and puts it on the arithmetic stack. The second performs the opposite operation. The third one - copies the word from the return stack, puts it into the arithmetic, the return stack does not change.
The b_setp and b_setm commands are the words +! and -! .. They take the value and address from the stack, and modify the word to the specified address, adding or removing the value from the stack.
The b_str command has an arbitrary length parameter — a string with a counter. This line is in the bytecode after the command byte, and the command simply pushes the address of that line onto the stack. In fact, this is a string literal.
The rest of the team, I think, does not need comments.
We also make a command to print a constant string (. "). We implement it as an entry point to type, as follows:
b_strp = 0x83 bcmd_strp: movsx rax, byte ptr [r8] inc r8 push rax push r8 add r8, rax b_type = 0x80 bcmd_type: mov rax, 1 # â„– 1 - sys_write mov rdi, 1 # â„– 1 - stdout pop rdx # pop rsi # push r8 syscall # pop r8 jmp _next This command is similar in structure to b_str. Only she puts nothing on the stack. The string located behind this command as a parameter is simply output to the user.
The warm-up is over, it's time for something more serious. We will deal with the word-generators and the rest of the var commands.
Word Generators
Recall the variables. How they are arranged at the byte-code level we know (var0 command). To create a new variable, the following construction is used in the forte:
variable < > After performing such a sequence, a new word <variable name> is created. Execution of this new word pushes the address to store the value of a variable onto the stack. There are also constants in the fort, they are created like this:
<> constant < > After creating a constant, the execution of the word <constant name> pushes <value> onto the stack.
So, the word variable and the word constant are the word-generators. They are designed to create new words. In the fort, such words are described using the create ... does> construct.
Variables and constants can be defined as follows:
: variable create 0 , does> ; : constant create , does> @ ; What does all this mean?
The word create, when executed, creates a new word with the name it takes when executing from the input stream. After creation, a sequence of words is executed before the word does>. But at the moment of the execution of this word, what is written after it does>. In this case, the stack will already have the address of the data (as they say in the fort, "data fields").
Thus, when creating a variable, the sequence “0,” is executed - this is a reservation of a machine word with zero filling. And in the execution of the created word, nothing is done (after does> there is nothing). The stack simply leaves the memory address where the value is stored.
In the definition of a constant word is reserved with the filling of the value that is on the stack. When the created word is executed, "@" is executed, which retrieves the value at the specified address.
And now let's think about how the word we create can be arranged. It puts the data address on the stack (like var0), and then transfers control to a specific address, to the bytecode. The var0 command immediately returns. But in this case we need to make not a return, but, in fact, a transition.
I will state once again what needs to be done:
- push data address
- make the transition to a piece of code after does>
It turns out, you just need to transfer control to another bytecode address, but first put the address of the next byte (R8) on the stack.
It's almost a branch team! And we have not one. Already have branch8 and branch16. Let's call the new var8 and var16 commands, and let them be just entry points to the branch commands. Save on the transition to the transition team :) So, it will be like this:
b_var8 = 0x29 bcmd_var8: push r8 b_branch8 = 0x10 bcmd_branch8: movsx rax, byte ptr [r8] add r8, rax jmp _next b_var16 = 0x30 bcmd_var16: push r8 b_branch16 = 0x11 bcmd_branch16: movsx rax, word ptr [r8] add r8, rax jmp _next In a good way, the var32 command is not interfered yet, and the var64 too. We do not have such long transitions, since ordinary transitions are not so long. But for the var command this is quite a realistic case. But for the time being we will not make these commands. We will do it later, if necessary.
With words-generators figured out. It was the turn to determine the dictionary.
Vocabulary
Usually, when one speaks simply about a dictionary of a fort, it is presented in the form of a unidirectional list of entries. In fact, everything is a bit more complicated, since the fort supports many dictionaries. In fact, they are a tree. Searching a word in such a tree begins with a “sheet” —this is the last word in the current dictionary. The current dictionary is defined by the context variable, and the address of the last word is in the dictionary word. To control the dictionaries is another variable - current, it determines the dictionary, where new words will be added. Thus, one dictionary can be set up for searching, and another can be added to include new words.
For our simple case, it would be possible not to support multiple vocabularies, but I decided not to simplify anything. In fact, in order to understand the byte code, the byte machine, it is not necessary to know what is described in this section. Therefore, who are not interested, you can simply skip this section. Well, who wants to know the details - go ahead!
Initially, there is a basic dictionary named forth. This means that there is such a word - forth. This word is also called "dictionary", there is some confusion in it. Therefore, if we are talking about a word, I will call it a word dictionary.
New dictionaries are created using this design:
vocabulary < > This creates a word with the name <name of the created dictionary>. When executed, this word will set the created dictionary as the starting one for the search.
In fact, the word dictionary contains a link to the latest entry in this dictionary, from which the search begins. And at the time of execution, this dictionary word writes a link to its data field in a context variable.
Later it will be possible to make the word vocabulary, which on the fort, in the current implementation, is described quite simply:
: vocabulary create context @ , does> context ! ; So, create the word forth. We will use the var8 command. The byte code “context!” Will be placed immediately after the data field:
forth: .byte b_var8 .byte does_voc - . - 1 .quad 0 # <-- . , - . does_voc: .byte b_call8 .byte context - . - 1 .byte b_set .byte b_exit Now back to the creation of the dictionary itself.
In general, in the fort, the description of a word in memory is called a “dictionary entry.” In ordinary terms, I would say that there is an article title and its code. But in the fort, everything is not quite usual; there it is called the "name field", the "communication field", the "code field" and the "data field". I will try to tell you what it all means in traditional terms.
The name field is the name of the word, “string with a counter”. It's like in old pascal - the byte of the string length, then the string. The link field is a link to the previous article. Previously, there was just an address, but we will have platform-independent code, and this will be an offset. The code field, traditionally in the fort, is machine code (when the implementation is in direct stitching), for words outside the core there was call _call. We will just have a bytecode. And the data field is for words containing data — for example, for variables or constants. By the way, the word-dictionary also applies to it.
For the compiler, we still need flags. Usually, the fort needs only one flag — immediate, and it is placed in a byte of length (sometimes another one is hidden). But this is for direct stitched code, where the processor control is transferred when calling to the code field. And we have different words - bytecode and machine code, and you need at least two or even three flags.
How much is needed for the communication field? In the beginning I wanted to use 16 bits. This is a link to the previous word, and the word is exactly less than 64 Kb. But then I remembered that in a word there can be data of almost any size. And besides, in the presence of several dictionaries, the link can go through many words. So, in most cases, 8 bits will suffice, but maybe 16 and 32. And even 64 bits, if there is more than 4 GB of data. Well, let's make support for all options. Which option is used - put in the flags. It turns out that at least 4 flags: a sign of immediate, a sign of the word of the core, and 2 bits per variant of the connection field used. It is necessary to use a separate byte for flags, in any other way.
Flags will be defined as:
f_code = 0x80 f_immediate = 0x60 The f_code flag will be in the kernel words written in assembler, the f_immediate flag will be useful for the compiler, about it in the next article. And the two lower bits will determine the length of the communication field (1, 2, 4 or 8 bytes).
So, the title of the article will be:
- flags (1 byte)
- communication field (1-8 bytes)
- name length byte
- name (1-255 bytes)
Up to this point I have not used the possibility of "macro" assembler. And now we need them. So I got a macro named item to form the title of the word:
.macro item name, flags = 0 link = . - p_item 9: .if link >= -256/2 && link < 256/2 .byte \flags .byte link .elseif link >= -256*256/2 && link < 256*256/2 .byte \flags | 1 .word . - p_item .elseif link >= -256*256*256*256/2 && link < 256*256*256*256/2 .byte \flags | 2 .int . - p_item .elseif link >= -256*256*256*256*256*256*256*256/2 && link < 256*256*256*256*256*256*256*256/2 .byte \flags | 3 .quad . - p_item .endif p_item = 9b .byte 9f - . - 1 .ascii "\name" 9: .endm This macro uses the value p_item - this is the address of the previous dictionary entry. This value is updated at the end for later use: p_item = 9b. Here 9b is a label, not a number, you should not confuse :) The macro has two parameters - the name of the word and flags (optional). At the beginning of the macro, the offset to the previous word is calculated. Then, depending on the size of the offset, the flags and the communication field of the desired size are compiled. Then the length byte of the name and the name itself.
We define before the first word p_item like this:
p_item = . The dot is the current compilation address in assembler. As a result of this definition, the first word will refer to itself (the communication field will be 0). This is a sign of the end of dictionaries.
By the way, what will be in the code field of the core words? It is necessary, at least, somewhere to save the command code. I decided to go as far as possible. For the kernel words, there will also be a bytecode. For most teams, this will be just a byte command, and then b_exit. Thus, for the interpreter, the f_code flag is not necessary to analyze, and the commands for it will not differ in any way. It will be necessary just to call bytecode for everyone.
For this option there is another advantage. For commands with parameters, you can set secure parameters. For example, if you invoke the command lit in implementations of a fort with directly sewn code, the system will crash. And here it will be written, for example, lit 0, and this sequence will simply put 0 on the stack. Even for a branch you can do it safely!
.byte branch8 .byte 0f - . 0: .byte b_exit With such a call there will be some overhead, but for the interpreter they will not be significant. And the compiler will analyze the flags, and compile the correct and fast code.
The first word will be, of course, the word “forth” - this is the basic dictionary we create. This is where the var command comes in handy with a link to the code after does>. I already cited this code in the previous section, but I will repeat it again, with the title:
p_item = . item forth .byte b_var8 .byte does_voc - . - 1 .quad 0 does_voc: .byte b_call8 .byte context - . - 1 .byte b_set .byte b_exit And we will immediately make context and current variables, we will need them to search for words:
item current .byte b_var0 .quad 0 item context context: .byte b_var0 .quad 0 And now, you have to be patient, and set a title for each word that we wrote in assembly language, with the f_code flag:
item 0, f_code .byte b_num0 .byte b_exit item 1, f_code .byte b_num1 .byte b_exit ... item 1-, f_code .byte b_wm .byte b_exit item 1+, f_code .byte b_wp .byte b_exit item +, f_code .byte b_add .byte b_exit item -, f_code .byte b_sub .byte b_exit item *, f_code .byte b_mul .byte b_exit And so on…
With commands written in bytecode is even easier. Just add a header before the bytecode, just like the word forth, for example:
item hold hold: .byte b_call8 .byte holdpoint - . - 1 # holdpoint ... For commands with parameters, we will make safe parameters. For example, the lit commands let them return the Pi number, if someone calls them interactively, there will be such a paschal :)
item lit8, f_code .byte b_lit8 .byte 31 .byte b_exit item lit16, f_code .byte b_lit16 .word 31415 .byte b_exit item lit32, f_code .byte b_lit32 .int 31415926 .byte b_exit item lit64, f_code .byte b_lit64 .quad 31415926535 .byte b_exit The last word in the list is symbolic to make the word bye. But we still need to write the address of this word in the data field forth during initialization. To get the address of this word, use the var0 command:
last_item: .byte b_var0 item bye, f_code .byte b_bye In this design, if we call the address of last_item in bytecode, we will get the address of the word bye. To write it in the data fields of the word forth, execute forth, and the desired address will be in context. Thus, the system initialization code will be as follows:
forth last_item context @ ! Now let's proceed directly to the interpreter. To begin, we need to work with the input buffer and extract words from it. Let me remind you that the interpreter in the fort is very simple. It extracts words from the input buffer in succession, tries to find them. If the word is found, the interpreter launches it for execution.
Input buffer and word extraction
To be honest, I do not want to spend a lot of time studying the standards of the fort. But still I will try to do as close as possible to them, mainly from memory. If the experts of the fort will see a strong non-compliance here - write, I will correct.
To work with the buffer, the fort has three variables: tib, #tib, and> in. The variable tib pushes the input buffer address onto the stack. The variable #tib pushes onto the stack the number of characters that are in the buffer. And the variable> in contains the offset in the input buffer, beyond which is the raw text. We define these variables.
item tib .byte b_var0 v_tib: .quad 0 item #tib .byte b_var0 v_ntib: .quad 0 item >in .byte b_var0 v_in: .quad 0 Next we make the word blword. This word, using the specified variables, receives the following word from the input stream. Spaces are used as separators and all characters with a code less than a space. This word will be in assembler. After debugging it turned out like this:
b_blword = 0xF0 bcmd_blword: mov rsi, v_tib # mov rdx, rsi # RDX mov rax, v_in # mov rcx, v_ntib # add rsi, rax # RSI - sub rcx, rax # jz 3f word2: lodsb # AL RSI cmp al, ' ' ja 1f # ( ) dec rcx jnz word2 # 3: sub rsi, rdx mov v_in, rsi push rcx jmp _next 1: lea rdi, [rsi - 1] # RDI = RSI - 1 ( ) dec rcx word3: lodsb cmp al, ' ' jbe 2f dec rcx jnz word3 2: mov rax, rsi sub rsi, rdx # ( ) mov v_in, rsi sub rax, rdi dec rax jz word1 push rdi # word1: push rax # jmp _next This word is similar to the standard word, but, in contrast, takes into account all delimiters and does not copy the word into the buffer. It returns just two values ​​on the stack — the address and the length. If the word cannot be retrieved, returns 0. It is time to start writing the interpreter.
Word search and interpreter
First, let's do the word interpret. This word selects a new word from the buffer using blworld, searches for it in the dictionary and executes it. And so repeats until the buffer is exhausted. We do not yet have the opportunity to search for a word, so we will write a test plug, which will simply output the word from the buffer using type. This will give us the opportunity to check and debug blworld:
# : interpret begin blword dup while type repeat drop ; item interpret 1: .byte b_blword .byte b_dup .byte b_qnbranch8 .byte 0f - . .byte b_type .byte b_branch8 .byte 1b - . 0: .byte b_drop .byte b_exit Now make the word quit. This is usually done in the implementation of fort systems: they use the word quit or abort to enter interpreter mode. The word quit resets stacks and starts an endless loop of input to the buffer and interpretation. With us, this is just an interpret call. The code of this word will consist of two parts. The first part will be in assembler, the second part will be in bytecode. First part:
b_quit = 0xF1 bcmd_quit: lea r8, quit mov sp, init_stack mov bp, init_rstack jmp _next The second part of:
quit: .byte b_call16 .word interpret - . - 2 .byte b_bye As usual, the assembler code is located in the .text section, the bytecode is located in the .data section.
And finally, change the start bytecode. There will only be initialization of the dictionary, setting the buffer on the starting line, and calling quit.
# forth last_item context @ ! start_code tib ! < > #tib ! quit start: .byte b_call16 .word forth - . - 2 .byte b_call16 .word last_item - . - 2 .byte b_call16 .word context - . - 2 .byte b_get .byte b_set .byte b_call8 .byte start_code - . - 1 .byte b_call16 .word tib - . - 2 .byte b_set .byte b_lit16 .world 1f - 0f .byte b_call16 .word ntib - . - 2 .byte b_set .byte b_quit start_code: .byte b_var0 0: .ascii "word1 word2 word3" 1: Compile, link, run!
$ as forth.s -o forth.o -g -ahlsm >list.txt $ ld forth.o -o forth $ ./forth word1word2wordBye! A bit like porridge, but this is exactly the result. We output without separators. By the way, we will put the line break before buy for the future, it will not hurt.
Of course, I had to tinker with debugging. In addition to the “Segmentation fault (core dumped)” already mentioned, sometimes interesting results were obtained. For example, such:
$ ./forth word1word2word3forth)%60Acurrent(context(%600lit8lit16zlit32v%5E%DF%80lit64v%5E%DF%80call8call16call32branch8branch16qbranch8qbranch16exit1-+!-%22*#/$mod%25/mod&abs'dup0drop1swap2rot3-rot4over5pick6roll7depth8@@!Ac@Bc!Cw@Dw!Ei@Fi!G0=P0%3CQ0%3ER=S%3CT%3EU%3C=V%3E=Wvar8)var160base(holdbuf(Qholdpoint(hold@0U110ACp@&20T0!?!%3CgF!A0@RF!5%220'%DE%A61Q-%DD%80:tib(%7F%60(%3Ein(%20%20%20%20%20%20%20interpret01('byeSegmentation%20fault%20(core%20dumped) It seems to be right in our entire dictionary in binary form with text cut into delimiters :) It happened when I forgot “dec rcx” before word3 in the b_blword command.
We can choose words from the input stream, there is a dictionary. Now we need to implement a dictionary search and the launch of words for execution. This will require the words find, cfa and execute.
The word find will retrieve the address of the word and its length from the stack. Return this word will be the address of the dictionary entry or 0 if not found.
The word cfa at the address of the article calculates the address of the executable bytecode.
And the word execute will execute the bytecode.
Let's start with find. In the standards of the fort it takes one address - a line with a counter. But I do not want to once again copy the string to the buffer, so I deviate a little from the standards. The word find will take two parameters on the stack — the address and the length of the string (actually, what the word blword returns). After debugging, this word took the following form:
b_find = 0xF2 bcmd_find: pop rbx # pop r9 # mov rdx, v_context mov rdx, [rdx] # # find0: mov al, [rdx] # and al, 3 # - , , or al, al jz find_l8 cmp al, 1 jz find_l16 cmp al, 2 jz find_l32 mov r10, [rdx + 1] # 64 lea rsi, [rdx + 9] # jmp find1 find_l32: movsx r10, dword ptr [rdx + 1] # 32 lea rsi, [rdx + 5] # jmp find1 find_l16: movsx r10, word ptr [rdx + 1] # 16 lea rsi, [rdx + 3] # jmp find1 find_l8: movsx r10, byte ptr [rdx + 1] # 8 lea rsi, [rdx + 2] # find1: movzx rax, byte ptr [rsi] # cmp rax, rbx jz find2 # find3: or r10, r10 jz find_notfound # , add rdx, r10 # jmp find0 # , find2: inc rsi mov rdi, r9 mov rcx, rax repz cmpsb jnz find3 # push rdx jmp _next find_notfound: push r10 jmp _next , . interpret, type «find .»:
# : interpret begin blword dup while find . repeat drop ; item interpret interpret: .byte b_blword .byte b_dup .byte b_qnbranch8 .byte 0f - . .byte b_find .byte b_call16 .word dot - . - 2 .byte b_branch8 .byte interpret - . 0: .byte b_drop .byte b_exit , , «0 1- dup + .».
!
$ ld forth.o -o forth $ ./forth 6297733 6297898 6298375 Bye! , . ( ). cfa. , , find:
b_cfa = 0xF3 bcmd_cfa: pop rdx # mov al, [rdx] # and al, 3 # - , , or al, al jz cfa_l8 cmp al, 1 jz cfa_l16 cmp al, 2 jz cfa_l32 lea rsi, [rdx + 9] # (64 ) jmp cfa1 find_l32: lea rsi, [rdx + 5] # (32 ) jmp cfa1 find_l16: lea rsi, [rdx + 3] # (16 ) jmp cfa1 find_l8: lea rsi, [rdx + 2] # (8 ) xor rax, rax lodsb add rsi, rax push rsi jmp _next , , execute, :
b_execute = 0xF4 bcmd_execute: sub rbp, 8 mov [rbp], r8 # pop r8 # - jmp _next interpret !
# : interpret begin blword dup while find cfa execute repeat drop ; item interpret interpret: .byte b_blword .byte b_dup .byte b_qnbranch8 .byte 0f - . .byte b_find .byte b_cfa .byte b_execute .byte b_branch8 .byte interpret - . 0: .byte b_drop .byte b_exit Run:
$ as forth.s -o forth.o -g -ahlsm >list.txt $ ld forth.o -o forth $ ./forth -2 Bye! , !
, 0 1, , -2 :)
, - . , — 0, 1, 2, 3, 4 8 ( ). , «number?». , find, . «number?» — . , 1. , : 0.
, :
b_number = 0xF5 bcmd_number: pop rcx # pop rsi # xor rax, rax # xor rbx, rbx # mov r9, v_base # xor r10, r10 # or rcx, rcx jz num_false mov bl, [rsi] cmp bl, '+' jnz 1f inc rsi dec rcx jz num_false jmp num0 1: cmp bl, '-' jnz num0 mov r10, 1 inc rsi dec rcx jz num_false num0: mov bl, [rsi] cmp bl, '0' ja num_false cmp bl, '9' jae num_09 cmp bl, 'A' ja num_false cmp bl, 'Z' jae num_AZ cmp bl, 'a' ja num_false sub bl, 'a' - 10 jmp num_check num_AZ: sub bl, 'A' - 10 jmp num_check num_09: sub bl, '0' num_check: cmp rbx, r9 jge num_false add rax, rbx mul r9 inc rsi dec rcx jnz num0 or r10, r10 push rax push 1 jmp _next num_false: xor rcx, rcx push rcx jmp _next interpret. , :
# : interpret # begin # blword dup # while # over over find dup # if -rot drop drop cfa execute else number? drop then # repeat # drop ; item interpret interpret: .byte b_blword .byte b_dup .byte b_qnbranch8 .byte 0f - . .byte b_over .byte b_over .byte b_find .byte b_dup .byte b_qnbranch8 .byte 1f - . .byte b_mrot .byte b_drop .byte b_drop .byte b_cfa .byte b_execute .byte b_branch8 .byte 2f - . 1: .byte b_numberq .byte b_drop 2: .byte b_branch8 .byte interpret - . 0: .byte b_drop .byte b_exit last_item: .byte b_var0 item bye, f_code .byte b_bye ! - , -, «» -… , … GDB, … — ! , . !
… , :)
, : — «s.». , interpret. , , . Here she is:
# : .s depth dup . c": emit do dup while dup pick . 1- again drop ; item .s # 11 22 33 prstack: .byte b_depth # 11 22 33 3 .byte b_dup # 11 22 33 3 3 .byte b_lit8 .byte '(' .byte b_emit .byte b_call16 # 11 22 33 3 .word dot - . - 2 .byte b_strp # 11 22 33 3 .byte 3 .ascii "): " 1: .byte b_dup # 11 22 33 3 3 .byte b_qnbranch8 # 11 22 33 3 .byte 2f - . .byte b_dup # 11 22 33 3 3 .byte b_pick # 11 22 33 3 11 .byte b_call16 # 11 22 33 3 .word dot - . - 2 .byte b_wm # 11 22 33 2 .byte b_branch8 .byte 1b - . 2: .byte b_drop # 11 22 33 .byte b_exit , . , , . , . «» !
:
.macro prs new_line = 1 .byte b_call16 .word prstack - . - 2 .if \new_line > 0 .byte b_lit8, '\n' .byte b_emit .endif .endm , :
item interpret interpret: .byte b_blword prs .byte b_dup prs .byte b_qnbranch8 .byte 0f - . .byte b_over .byte b_over ...... , :
$ ./forth (2 ): 6297664 1 (3 ): 6297664 1 1 (3 ): 2 6297666 1 (4 ): 2 6297666 1 1 (4 ): 2 3 6297668 1 (5 ): 2 3 6297668 1 1 (3 ): 6 6297670 2 (4 ): 6 6297670 2 2 (4 ): 6 6297670 6297673 1 (5 ): 6 6297670 6297673 1 1 6297670 (2 ): 6 0 (3 ): 6 0 0 Bye! . :)
, :
.macro pr string .byte b_strp .byte 9f - 8f 8: .ascii "\n\string" 9: .endm , :
item interpret interpret: .byte b_blword pr blworld prs .byte b_dup .byte b_qnbranch8 .byte 0f - . .byte b_over .byte b_over prs .byte b_find pr find prs .byte b_dup .byte b_qnbranch8 .byte 1f - . .byte b_mrot .byte b_drop .byte b_drop .byte b_cfa pr execute prs .byte b_execute .byte b_branch8 .byte 2f - . 1: .byte b_numberq pr numberq prs .byte b_drop 2: .byte b_branch8 .byte interpret - . 0: .byte b_drop .byte b_exit :
$ ./forth blworld(2 ): 6297664 2 (4 ): 6297664 2 6297664 2 find(3 ): 6297664 2 0 numberq(2 ): 6297664 0 blworld(3 ): 6297664 6297667 2 (5 ): 6297664 6297667 2 6297667 2 find(4 ): 6297664 6297667 2 0 numberq(3 ): 6297664 6297667 0 blworld(4 ): 6297664 6297667 6297670 1 (6 ): 6297664 6297667 6297670 1 6297670 1 find(5 ): 6297664 6297667 6297670 1 6297958 execute(3 ): 6297664 6297667 6297962 blworld(3 ): 39660590749888 6297672 1 (5 ): 39660590749888 6297672 1 6297672 1 find(4 ): 39660590749888 6297672 1 6298496 execute(2 ): 39660590749888 6298500 39660590749888 blworld(1 ): 0 Bye! «20 30 * .».
… , , …
, , , - .
, , . , , , . ".s".
. , - . , .
interpret, : . , interpret :
item interpret interpret: .byte b_blword .byte b_dup .byte b_qnbranch8 .byte 0f - . .byte b_over .byte b_over .byte b_find .byte b_dup .byte b_qnbranch8 .byte 1f - . .byte b_mrot .byte b_drop .byte b_drop .byte b_cfa .byte b_execute .byte b_branch8 .byte 2f - . 1: .byte b_drop .byte b_over, b_over .byte b_numberq # , .byte b_qbranch8, 3f - . # 0, , 3 .byte b_type # .byte b_strp # .byte 19 # .ascii " : word not found!\n" .byte b_quit # 3: .byte b_nip, b_nip # , ( b_over, b_over) 2: # .byte b_depth # .byte b_zlt # , 0 ( 0<) .byte b_qnbranch8, interpret_ok - . # , , .byte b_strp # .byte 14 .ascii "\nstack fault!\n" .byte b_quit # interpret_ok: .byte b_branch8 .byte interpret - . 0: .byte b_drop .byte b_exit , , quit , . , , «» . .
— .
. expect, — . . span. . .
.data item span span: .byte b_var0 v_span: .quad 0 .text b_expect = 0x88 bcmd_expect: mov rax, 0 # â„– 1 - sys_read mov rdi, 0 # â„– 1 - stdout pop rdx # pop rsi # push r8 syscall # pop r8 mov rbx, rax or rax, rax jge 1f xor rbx, rbx 1: mov v_span, rbx jmp _next . 256 .
.
inbuf_size = 256 inbuf: .byte b_var0 .space inbuf_size quit, -. tib inbuf, expect, span #tib. >in , interpret. . — ( !). ( quit):
# forth last_item context @ ! quit start: .byte b_call16 .word forth - . - 2 .byte b_call16 .word last_item - . - 2 .byte b_call16 .word context - . - 2 .byte b_get .byte b_set .byte b_quit inbuf: .byte b_var0 .space inbuf_size # begin inbuf dup tib ! inbuf_size expect span @ #tib ! 0 >in ! interpret again quit: .byte b_strp, 1 .ascii "\n" .byte b_call16 .word prstack - . - 2 .byte b_strp .byte 2 .ascii "> " .byte b_call16 .word inbuf - . - 2 .byte b_dup .byte b_call16 .word tib - . - 2 .byte b_set .byte b_lit16 .word inbuf_size .byte b_expect .byte b_call16 .word span - . - 2 .byte b_get .byte b_call16 .word ntib - . - 2 .byte b_set .byte b_num0 .byte b_call16 .word bin - . - 2 .byte b_set .byte b_call16 .word interpret - . - 2 .byte b_branch8, quit - . :
$ ./forth ( 0 ): > 60 ( 1 ): 60 > 60 24 ( 3 ): 60 60 24 > rot ( 3 ): 60 24 60 > -rot ( 3 ): 60 60 24 > swap ( 3 ): 60 24 60 > * * . 86400 ( 0 ): > 200 30 /mod ( 2 ): 20 6 > bye Bye! $ , ">" — . — . , . , .
Total
. — «» «» :)
— . — , , ">". ( 76 ). , — , , , .
( 1300 )
.intel_syntax noprefix stack_size = 1024 f_code = 0x80 f_immediate = 0x60 .macro item name, flags = 0 link = p_item - . 9: .if link >= -256/2 && link < 256/2 .byte \flags .byte link .elseif link >= -256*256/2 && link < 256*256/2 .byte \flags | 1 .word link .elseif link >= -256*256*256*256/2 && link < 256*256*256*256/2 .byte \flags | 2 .int link .elseif link >= -256*256*256*256*256*256*256*256/2 && link < 256*256*256*256*256*256*256*256/2 .byte \flags | 3 .quad link .endif p_item = 9b .byte 9f - . - 1 .ascii "\name" 9: .endm .section .data init_stack: .quad 0 init_rstack: .quad 0 emit_buf: .byte 0 inbuf_size = 256 msg_bad_byte: .ascii "Bad byte code!\n" msg_bad_byte_len = . - msg_bad_byte # len msg_bye: .ascii "\nBye!\n" msg_bye_len = . - msg_bye bcmd: .quad bcmd_bad, bcmd_bye, bcmd_num0, bcmd_num1, bcmd_num2, bcmd_num3, bcmd_num4, bcmd_num8 # 0x00 .quad bcmd_lit8, bcmd_lit16, bcmd_lit32, bcmd_lit64, bcmd_call8, bcmd_call16, bcmd_call32, bcmd_bad .quad bcmd_branch8, bcmd_branch16, bcmd_qbranch8, bcmd_qbranch16, bcmd_qnbranch8, bcmd_qnbranch16,bcmd_bad, bcmd_exit # 0x10 .quad bcmd_wp, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_wm, bcmd_add, bcmd_sub, bcmd_mul, bcmd_div, bcmd_mod, bcmd_divmod, bcmd_abs # 0x20 .quad bcmd_var0, bcmd_var8, bcmd_var16, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_dup, bcmd_drop, bcmd_swap, bcmd_rot, bcmd_mrot, bcmd_over, bcmd_pick, bcmd_roll # 0x30 .quad bcmd_depth, bcmd_nip, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_get, bcmd_set, bcmd_get8, bcmd_set8, bcmd_get16, bcmd_set16, bcmd_get32, bcmd_set32 # 0x40 .quad bcmd_setp, bcmd_setm, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_zeq, bcmd_zlt, bcmd_zgt, bcmd_eq, bcmd_lt, bcmd_gt, bcmd_lteq, bcmd_gteq # 0x50 .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_2r, bcmd_r2, bcmd_rget, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad # 0x60 .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_type, bcmd_emit, bcmd_str, bcmd_strp, bcmd_count, bcmd_bad, bcmd_bad, bcmd_bad # 0x80 .quad bcmd_expect, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad # 0x90 .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad .quad bcmd_blword, bcmd_quit, bcmd_find, bcmd_cfa, bcmd_execute, bcmd_numberq, bcmd_bad, bcmd_bad # 0xF0 .quad bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad, bcmd_bad # forth last_item context @ ! quit start: .byte b_call16 .word forth - . - 2 .byte b_call16 .word last_item - . - 2 .byte b_call16 .word context - . - 2 .byte b_get .byte b_set .byte b_quit inbuf: .byte b_var0 .space inbuf_size # begin inbuf dup tib ! inbuf_size expect span @ #tib ! 0 >in ! interpret again quit: .byte b_strp, 1 .ascii "\n" .byte b_call16 .word prstack - . - 2 .byte b_strp .byte 2 .ascii "> " .byte b_call16 .word inbuf - . - 2 .byte b_dup .byte b_call16 .word tib - . - 2 .byte b_set .byte b_lit16 .word inbuf_size .byte b_expect .byte b_call16 .word span - . - 2 .byte b_get .byte b_call16 .word ntib - . - 2 .byte b_set .byte b_num0 .byte b_call16 .word bin - . - 2 .byte b_set .byte b_call16 .word interpret - . - 2 .byte b_branch8, quit - . p_item = . item forth forth: .byte b_var8 .byte does_voc - . .quad 0 does_voc: .byte b_call8 .byte context - . - 1 .byte b_set .byte b_exit item current .byte b_var0 .quad 0 item context context: .byte b_var0 v_context: .quad 0 item 0, f_code .byte b_num0 .byte b_exit item 1, f_code .byte b_num1 .byte b_exit item 2, f_code .byte b_num2 .byte b_exit item 3, f_code .byte b_num3 .byte b_exit item 4, f_code .byte b_num4 .byte b_exit item 8, f_code .byte b_num8 .byte b_exit item lit8, f_code .byte b_lit8 .byte 31 .byte b_exit item lit16, f_code .byte b_lit16 .word 31415 .byte b_exit item lit32, f_code .byte b_lit32 .int 31415926 .byte b_exit item lit64, f_code .byte b_lit64 .quad 31415926 .byte b_exit item call8, f_code .byte b_call8 .byte 0f - . - 1 0: .byte b_exit item call16, f_code .byte b_call16 .word 0f - . - 2 0: .byte b_exit item call32, f_code .byte b_call32 .int 0f - . - 4 0: .byte b_exit item branch8, f_code .byte b_branch8 .byte 0f - . 0: .byte b_exit item branch16, f_code .byte b_branch16 .word 0f - . 0: .byte b_exit item qbranch8, f_code .byte b_qbranch8 .byte 0f - . 0: .byte b_exit item qbranch16, f_code .byte b_qbranch16 .word 0f - . 0: .byte b_exit item exit, f_code .byte b_exit item 1-, f_code .byte b_wm .byte b_exit item 1+, f_code .byte b_wp .byte b_exit item +, f_code .byte b_add .byte b_exit item -, f_code .byte b_sub .byte b_exit item *, f_code .byte b_mul .byte b_exit item /, f_code .byte b_div .byte b_exit item mod, f_code .byte b_mod .byte b_exit item /mod, f_code .byte b_divmod .byte b_exit item abs, f_code .byte b_abs .byte b_exit item dup, f_code .byte b_dup .byte b_exit item drop, f_code .byte b_drop .byte b_exit item swap, f_code .byte b_swap .byte b_exit item rot, f_code .byte b_rot .byte b_exit item -rot, f_code .byte b_mrot .byte b_exit item over, f_code .byte b_over .byte b_exit item pick, f_code .byte b_pick .byte b_exit item roll, f_code .byte b_roll .byte b_exit item depth, f_code .byte b_depth .byte b_exit item @, f_code .byte b_get .byte b_exit item !, f_code .byte b_set .byte b_exit item c@, f_code .byte b_get8 .byte b_exit item c!, f_code .byte b_set8 .byte b_exit item w@, f_code .byte b_get16 .byte b_exit item w!, f_code .byte b_set16 .byte b_exit item i@, f_code .byte b_get32 .byte b_exit item i!, f_code .byte b_set32 .byte b_exit item +!, f_code .byte b_setp .byte b_exit item -!, f_code .byte b_setm .byte b_exit item >r, f_code .byte b_2r .byte b_exit item r>, f_code .byte b_r2 .byte b_exit item r@, f_code .byte b_rget .byte b_exit item "0=", f_code .byte b_zeq .byte b_exit item 0<, f_code .byte b_zlt .byte b_exit item 0>, f_code .byte b_zgt .byte b_exit item "=", f_code .byte b_eq .byte b_exit item <, f_code .byte b_lt .byte b_exit item >, f_code .byte b_gt .byte b_exit item "<=", f_code .byte b_lteq .byte b_exit item ">=", f_code .byte b_gteq .byte b_exit item type, f_code .byte b_type .byte b_exit item expect, f_code .byte b_expect .byte b_exit item emit, f_code .byte b_emit .byte b_exit item count, f_code .byte b_count .byte b_exit item "(\")", f_code .byte b_str .byte b_exit item "(.\")", f_code .byte b_strp .byte b_exit item var8, f_code .byte b_var8 .byte 0f - . 0: .byte b_exit item var16, f_code .byte b_var16 .word 0f - . 0: .byte b_exit item base base: .byte b_var0 v_base: .quad 10 holdbuf_len = 70 item holdbuf holdbuf: .byte b_var0 .space holdbuf_len item holdpoint holdpoint: .byte b_var0 .quad 0 item span span: .byte b_var0 v_span: .quad 0 # : hold holdpoint @ 1- dup holdbuf > if drop drop else dup holdpoint ! c! then ; item hold hold: .byte b_call8 .byte holdpoint - . - 1 # holdpoint .byte b_get # @ .byte b_wm # 1- .byte b_dup # dup .byte b_call8 .byte holdbuf - . - 1 # holdbuf .byte b_gt # > .byte b_qbranch8 # if .byte 0f - . .byte b_drop # drop .byte b_drop # drop .byte b_branch8 # ( then) .byte 1f - . 0: .byte b_dup # dup .byte b_call8 .byte holdpoint - . - 1 # holdpoint .byte b_set # ! .byte b_set8 # c! 1: .byte b_exit # ; # : # base /mod swap dup 10 < if c" 0 + else 10 - c" A + then hold ; item # conv: .byte b_call16 .word base - . - 2 # base .byte b_get # @ .byte b_divmod # /mod .byte b_swap # swap .byte b_dup # dup .byte b_lit8 .byte 10 # 10 .byte b_lt # < .byte b_qnbranch8 # if .byte 0f - . .byte b_lit8 .byte '0' # c" 0 .byte b_add # + .byte b_branch8 # else .byte 1f - . 0: .byte b_lit8 .byte '?' # c" A .byte b_add # + 1: .byte b_call16 .word hold - . - 2 # hold .byte b_exit # ; # : <# holdbuf 70 + holdpoint ! ; item <# conv_start: .byte b_call16 .word holdbuf - . - 2 .byte b_lit8 .byte holdbuf_len .byte b_add .byte b_call16 .word holdpoint - . - 2 .byte b_set .byte b_exit # : #s do # dup 0=until ; item #s conv_s: .byte b_call8 .byte conv - . - 1 .byte b_dup .byte b_qbranch8 .byte conv_s - . .byte b_exit # : #> holdpoint @ holdbuf 70 + over - ; item #> conv_end: .byte b_call16 .word holdpoint - . - 2 .byte b_get .byte b_call16 .word holdbuf - . - 2 .byte b_lit8 .byte holdbuf_len .byte b_add .byte b_over .byte b_sub .byte b_exit item . dot: .byte b_dup .byte b_abs .byte b_call8 .byte conv_start - . - 1 .byte b_lit8 .byte ' ' .byte b_call16 .word hold - . - 2 .byte b_call8 .byte conv_s - . - 1 .byte b_drop .byte b_zlt .byte b_qnbranch8 .byte 1f - . .byte b_lit8 .byte '-' .byte b_call16 .word hold - . - 2 1: .byte b_call8 .byte conv_end - . - 1 .byte b_type .byte b_exit item tib tib: .byte b_var0 v_tib: .quad 0 item #tib ntib: .byte b_var0 v_ntib: .quad 0 item >in bin: .byte b_var0 v_in: .quad 0 # : .s depth dup . c": emit do dup while dup pick . 1- again drop ; item .s # 11 22 33 prstack: .byte b_depth # 11 22 33 3 .byte b_dup # 11 22 33 3 3 .byte b_strp .byte 2 .ascii "( " .byte b_call16 # 11 22 33 3 .word dot - . - 2 .byte b_strp # 11 22 33 3 .byte 3 .ascii "): " .byte b_dup, b_zlt .byte b_qnbranch8, 1f - . .byte b_strp .byte 14 .ascii "\nStack fault!\n" .byte b_quit 1: .byte b_dup # 11 22 33 3 3 .byte b_qnbranch8 # 11 22 33 3 .byte 2f - . .byte b_dup # 11 22 33 3 3 .byte b_pick # 11 22 33 3 11 .byte b_call16 # 11 22 33 3 .word dot - . - 2 .byte b_wm # 11 22 33 2 .byte b_branch8 .byte 1b - . 2: .byte b_drop # 11 22 33 .byte b_exit .macro prs new_line = 1 .byte b_call16 .word prstack - . - 2 .if \new_line > 0 .byte b_lit8, '\n' .byte b_emit .endif .endm .macro pr string .byte b_strp .byte 9f - 8f 8: .ascii "\n\string" 9: .endm item interpret interpret: .byte b_blword .byte b_dup .byte b_qnbranch8 .byte 0f - . .byte b_over .byte b_over .byte b_find .byte b_dup .byte b_qnbranch8 .byte 1f - . .byte b_mrot .byte b_drop .byte b_drop .byte b_cfa .byte b_execute .byte b_branch8 .byte 2f - . 1: .byte b_drop .byte b_over, b_over .byte b_numberq # , .byte b_qbranch8, 3f - . # 0, , 3 .byte b_type # .byte b_strp # .byte 19 # .ascii " : word not found!\n" .byte b_quit # 3: .byte b_nip, b_nip # , ( b_over, b_over) 2: # .byte b_depth # .byte b_zlt # , 0 ( 0<) .byte b_qnbranch8, interpret_ok - . # , , .byte b_strp # .byte 14 .ascii "\nstack fault!\n" .byte b_quit # interpret_ok: .byte b_branch8 .byte interpret - . 0: .byte b_drop .byte b_exit last_item: .byte b_var0 item bye, f_code .byte b_bye .section .text .global _start # _start: mov rbp, rsp sub rbp, stack_size lea r8, start mov init_stack, rsp mov init_rstack, rbp jmp _next b_var0 = 0x28 bcmd_var0: push r8 b_exit = 0x17 bcmd_exit: mov r8, [rbp] add rbp, 8 _next: movzx rcx, byte ptr [r8] inc r8 jmp [bcmd + rcx*8] b_num0 = 0x02 bcmd_num0: push 0 jmp _next b_num1 = 0x03 bcmd_num1: push 1 jmp _next b_num2 = 0x04 bcmd_num2: push 2 jmp _next b_num3 = 0x05 bcmd_num3: push 3 jmp _next b_num4 = 0x06 bcmd_num4: push 4 jmp _next b_num8 = 0x07 bcmd_num8: push 8 jmp _next b_lit8 = 0x08 bcmd_lit8: movsx rax, byte ptr [r8] inc r8 push rax jmp _next b_lit16 = 0x09 bcmd_lit16: movsx rax, word ptr [r8] add r8, 2 push rax jmp _next b_call8 = 0x0C bcmd_call8: movsx rax, byte ptr [r8] sub rbp, 8 inc r8 mov [rbp], r8 add r8, rax jmp _next b_call16 = 0x0D bcmd_call16: movsx rax, word ptr [r8] sub rbp, 8 add r8, 2 mov [rbp], r8 add r8, rax jmp _next b_call32 = 0x0E bcmd_call32: movsx rax, dword ptr [r8] sub rbp, 8 add r8, 4 mov [rbp], r8 add r8, rax jmp _next b_lit32 = 0x0A bcmd_lit32: movsx rax, dword ptr [r8] add r8, 4 push rax jmp _next b_lit64 = 0x0B bcmd_lit64: mov rax, [r8] add r8, 8 push rax jmp _next b_dup = 0x30 bcmd_dup: push [rsp] jmp _next b_wm = 0x20 bcmd_wm: decq [rsp] jmp _next b_wp = 0x18 bcmd_wp: incq [rsp] jmp _next b_add = 0x21 bcmd_add: pop rax add [rsp], rax jmp _next b_sub = 0x22 bcmd_sub: pop rax sub [rsp], rax jmp _next b_mul = 0x23 bcmd_mul: pop rax pop rbx imul rbx push rax jmp _next b_div = 0x24 bcmd_div: pop rbx pop rax cqo idiv rbx push rax jmp _next b_mod = 0x25 bcmd_mod: pop rbx pop rax cqo idiv rbx push rdx jmp _next b_divmod = 0x26 bcmd_divmod: pop rbx pop rax cqo idiv rbx push rdx push rax jmp _next b_abs = 0x27 bcmd_abs: mov rax, [rsp] or rax, rax jge _next neg rax mov [rsp], rax jmp _next b_drop = 0x31 bcmd_drop: add rsp, 8 jmp _next b_swap = 0x32 bcmd_swap: pop rax pop rbx push rax push rbx jmp _next b_rot = 0x33 bcmd_rot: pop rax pop rbx pop rcx push rbx push rax push rcx jmp _next b_mrot = 0x34 bcmd_mrot: pop rcx pop rbx pop rax push rcx push rax push rbx jmp _next b_over = 0x35 bcmd_over: push [rsp + 8] jmp _next b_pick = 0x36 bcmd_pick: pop rcx push [rsp + 8*rcx] jmp _next b_roll = 0x37 bcmd_roll: pop rcx mov rbx, [rsp + 8*rcx] roll1: mov rax, [rsp + 8*rcx - 8] mov [rsp + 8*rcx], rax dec rcx jnz roll1 push rbx jmp _next b_depth = 0x38 bcmd_depth: mov rax, init_stack sub rax, rsp sar rax, 3 push rax jmp _next b_nip = 0x39 bcmd_nip: pop rax mov [rsp], rax jmp _next b_get = 0x40 bcmd_get: pop rcx push [rcx] jmp _next b_set = 0x41 bcmd_set: pop rcx pop rax mov [rcx], rax jmp _next b_get8 = 0x42 bcmd_get8: pop rcx movsx rax, byte ptr [rcx] push rax jmp _next b_set8 = 0x43 bcmd_set8: pop rcx pop rax mov [rcx], al jmp _next b_get16 = 0x44 bcmd_get16: pop rcx movsx rax, word ptr [rcx] push rax jmp _next b_set16 = 0x45 bcmd_set16: pop rcx pop rax mov [rcx], ax jmp _next b_get32 = 0x46 bcmd_get32: pop rcx movsx rax, dword ptr [rcx] push rax jmp _next b_set32 = 0x47 bcmd_set32: pop rcx pop rax mov [rcx], eax jmp _next b_setp = 0x48 bcmd_setp: pop rcx pop rax add [rcx], rax jmp _next b_setm = 0x49 bcmd_setm: pop rcx pop rax sub [rcx], rax jmp _next b_2r = 0x60 bcmd_2r: pop rax sub rbp, 8 mov [rbp], rax jmp _next b_r2 = 0x61 bcmd_r2: push [rbp] add rbp, 8 jmp _next b_rget = 0x62 bcmd_rget: push [rbp] jmp _next # 0= b_zeq = 0x50 bcmd_zeq: pop rax or rax, rax jnz rfalse rtrue: push -1 jmp _next rfalse: push 0 jmp _next # 0< b_zlt = 0x51 bcmd_zlt: pop rax or rax, rax jl rtrue push 0 jmp _next # 0> b_zgt = 0x52 bcmd_zgt: pop rax or rax, rax jg rtrue push 0 jmp _next # = b_eq = 0x53 bcmd_eq: pop rbx pop rax cmp rax, rbx jz rtrue push 0 jmp _next # < b_lt = 0x54 bcmd_lt: pop rbx pop rax cmp rax, rbx jl rtrue push 0 jmp _next # > b_gt = 0x55 bcmd_gt: pop rbx pop rax cmp rax, rbx jg rtrue push 0 jmp _next # <= b_lteq = 0x56 bcmd_lteq: pop rbx pop rax cmp rax, rbx jle rtrue push 0 jmp _next # >= b_gteq = 0x57 bcmd_gteq: pop rbx pop rax cmp rax, rbx jge rtrue push 0 jmp _next b_var8 = 0x29 bcmd_var8: push r8 b_branch8 = 0x10 bcmd_branch8: movsx rax, byte ptr [r8] add r8, rax jmp _next b_var16 = 0x30 bcmd_var16: push r8 b_branch16 = 0x11 bcmd_branch16: movsx rax, word ptr [r8] add r8, rax jmp _next b_qbranch8 = 0x12 bcmd_qbranch8: pop rax or rax, rax jnz bcmd_branch8 inc r8 jmp _next b_qbranch16 = 0x13 bcmd_qbranch16: pop rax or rax, rax jnz bcmd_branch16 add r8, 2 jmp _next b_qnbranch8 = 0x14 bcmd_qnbranch8: pop rax or rax, rax jz bcmd_branch8 inc r8 jmp _next b_qnbranch16 = 0x15 bcmd_qnbranch16:pop rax or rax, rax jz bcmd_branch16 add r8, 2 jmp _next b_bad = 0x00 bcmd_bad: mov rax, 1 # 1 - sys_write mov rdi, 1 # 1 stdout mov rsi, offset msg_bad_byte # mov rdx, msg_bad_byte_len # syscall # mov rax, 60 # 1 - sys_exit mov rbx, 1 # 1 syscall # b_bye = 0x01 bcmd_bye: mov rax, 1 # 1 - sys_write mov rdi, 1 # 1 stdout mov rsi, offset msg_bye # mov rdx, msg_bye_len # syscall # mov rax, 60 # 60 - sys_exit mov rdi, 0 # 0 syscall # b_strp = 0x83 bcmd_strp: movsx rax, byte ptr [r8] inc r8 push r8 add r8, rax push rax b_type = 0x80 bcmd_type: mov rax, 1 # 1 - sys_write mov rdi, 1 # 1 - stdout pop rdx # pop rsi # push r8 syscall # pop r8 jmp _next b_expect = 0x88 bcmd_expect: mov rax, 0 # 1 - sys_read mov rdi, 0 # 1 - stdout pop rdx # pop rsi # push r8 syscall # pop r8 mov rbx, rax or rax, rax jge 1f xor rbx, rbx 1: mov v_span, rbx jmp _next b_str = 0x82 bcmd_str: movzx rax, byte ptr [r8] lea r8, [r8 + rax + 1] jmp _next b_count = 0x84 bcmd_count: pop rcx movzx rax, byte ptr [rcx] inc rcx push rcx push rax jmp _next b_emit = 0x81 bcmd_emit: pop rax mov rsi, offset emit_buf # mov [rsi], al mov rax, 1 # 1 - sys_write mov rdi, 1 # 1 - stdout mov rdx, 1 # push r8 syscall # pop r8 jmp _next b_blword = 0xF0 bcmd_blword: mov rsi, v_tib # mov rdx, rsi # RDX mov rax, v_in # mov rcx, v_ntib # mov rbx, rcx add rsi, rax # RSI - sub rcx, rax # jz 3f word2: lodsb # AL RSI cmp al, ' ' ja 1f # ( ) dec rcx jnz word2 # 3: sub rsi, rdx mov v_in, rsi push rcx jmp _next 1: lea rdi, [rsi - 1] # RDI = RSI - 1 ( ) dec rcx jz word9 word3: lodsb cmp al, ' ' jbe 2f dec rcx jnz word3 word9: inc rsi 2: mov rax, rsi sub rsi, rdx # ( ) cmp rsi, rbx jle 4f mov rsi, rbx 4: mov v_in, rsi sub rax, rdi dec rax jz word1 push rdi # word1: push rax # jmp _next b_quit = 0xF1 bcmd_quit: lea r8, quit mov rsp, init_stack mov rbp, init_rstack jmp _next b_find = 0xF2 bcmd_find: pop rbx # pop r9 # mov rdx, v_context mov rdx, [rdx] # # find0: mov al, [rdx] # and al, 3 # - , , or al, al jz find_l8 cmp al, 1 jz find_l16 cmp al, 2 jz find_l32 mov r10, [rdx + 1] # 64 lea rsi, [rdx + 9] # jmp find1 find_l32: movsx r10, dword ptr [rdx + 1] # 32 lea rsi, [rdx + 5] # jmp find1 find_l16: movsx r10, word ptr [rdx + 1] # 16 lea rsi, [rdx + 3] # jmp find1 find_l8: movsx r10, byte ptr [rdx + 1] # 8 lea rsi, [rdx + 2] # find1: movzx rax, byte ptr [rsi] # cmp rax, rbx jz find2 # find3: or r10, r10 jz find_notfound # , add rdx, r10 # jmp find0 # , find2: inc rsi mov rdi, r9 mov rcx, rax repz cmpsb jnz find3 # push rdx jmp _next find_notfound: push r10 jmp _next b_cfa = 0xF3 bcmd_cfa: pop rdx # mov al, [rdx] # and al, 3 # - , , or al, al jz cfa_l8 cmp al, 1 jz cfa_l16 cmp al, 2 jz cfa_l32 lea rsi, [rdx + 9] # (64 ) jmp cfa1 cfa_l32: lea rsi, [rdx + 5] # (32 ) jmp cfa1 cfa_l16: lea rsi, [rdx + 3] # (16 ) jmp cfa1 cfa_l8: lea rsi, [rdx + 2] # (8 ) cfa1: xor rax, rax lodsb add rsi, rax push rsi jmp _next b_execute = 0xF4 bcmd_execute: sub rbp, 8 mov [rbp], r8 # pop r8 # - jmp _next b_numberq = 0xF5 bcmd_numberq: pop rcx # pop rsi # xor rax, rax # xor rbx, rbx # mov r9, v_base # xor r10, r10 # or rcx, rcx jz num_false mov bl, [rsi] cmp bl, '+' jnz 1f inc rsi dec rcx jz num_false jmp num0 1: cmp bl, '-' jnz num0 mov r10, 1 inc rsi dec rcx jz num_false num0: mov bl, [rsi] cmp bl, '0' jb num_false cmp bl, '9' jbe num_09 cmp bl, 'A' jb num_false cmp bl, 'Z' jbe num_AZ cmp bl, 'a' jb num_false cmp bl, 'z' ja num_false sub bl, 'a' - 10 jmp num_check num_AZ: sub bl, 'A' - 10 jmp num_check num_09: sub bl, '0' num_check: cmp rbx, r9 jge num_false mul r9 add rax, rbx inc rsi dec rcx jnz num0 or r10, r10 push rax push 1 jmp _next num_false: xor rcx, rcx push rcx jmp _next , .
: https://github.com/hal9000cc/forth64
, bin Linux x64 . Linux, .
Windows — WSL (Windows Subsystem for Linux). , . , 5. , , «» PowerShell. , , .
— Windows :) , , .
That's all! .
, , . , - , - . , -.
Source: https://habr.com/ru/post/435236/
All Articles