From: Michael D. Lowis Date: Wed, 10 Jul 2024 01:14:59 +0000 (-0400) Subject: initial commit X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=2277639769633957521d17bc54a3fb21bc657b88;p=proto%2Fforth.git initial commit --- 2277639769633957521d17bc54a3fb21bc657b88 diff --git a/SForth.dmp b/SForth.dmp new file mode 100644 index 0000000..e7c6ec5 --- /dev/null +++ b/SForth.dmp @@ -0,0 +1,562 @@ +# David Smith 2022 david.a.c.v.smith@gmail.com http://dacvs.neocities.org/ +# This is the 1st of the 2 files that define SmithForth, a subroutine-threaded Forth for x86-64. + +# Understanding this file may be easier if first you watch my video series on hand-made +# Linux x86 executables (featuring the ELF header and general-purpose x86 instructions): +# https://www.youtube.com/playlist?list=PLZCIHSjpQ12woLj0sjsnqDH8yVuXwTy3p + +# ============= ELF FILE HEADER +# +# Linux will run a computing job given the name of an executable file. An executable file +# contains machine code for the processor and information for the operating system about the +# layout of the file and the dimensions of the job. Working without the usual development +# tools, we write this information by hand. + +7F 45 4C 46 # e_ident[EI_MAG]: ELF magic number + 02 # e_ident[EI_CLASS]: 1: 32-bit, 2: 64-bit + 01 # e_ident[EI_DATA]: 1: little-endian, 2: big-endian + 01 # e_ident[EI_VERSION]: ELF header version; must be 1 + 00 # e_ident[EI_OSABI]: Target OS ABI; should be 0 +00 # e_ident[EI_ABIVERSION]: ABI version; 0 is ok for Linux + 00 00 00 00 00 00 00 # e_ident[EI_PAD]: unused, should be 0 +02 00 # e_type: object file type; 2: executable + 3E 00 # e_machine: instruction set architecture; 3: x86, 3E: amd64 + 01 00 00 00 # e_version: ELF identification version; must be 1 +78 00 40 00 00 00 00 00 # e_entry: memory address of entry point (where process starts) +40 00 00 00 00 00 00 00 # e_phoff: file offset where program headers begin (34: 32-bit, 40: 64) +00 00 00 00 00 00 00 00 # e_shoff: file offset where section headers begin +00 00 00 00 # e_flags: 0 for x86 + 40 00 # e_ehsize: size of this header (34: 32-bit, 40: 64-bit) + 38 00 # e_phentsize: size of each program header (20: 32-bit, 38: 64-bit) +01 00 # e_phnum: number of program headers + 40 00 # e_shentsize: size of each section header (28: 32-bit, 40: 64-bit) + 00 00 # e_shnum: number of section headers + 00 00 # e_shstrndx: index of section header containing section names + +# ============= ELF PROGRAM HEADER + +01 00 00 00 # p_type: segment type; 1: loadable + 07 00 00 00 # p_flags: segment-dependent flags (1: X, 2: W, 4: R) +00 00 00 00 00 00 00 00 # p_offset: file offset where segment begins +00 00 40 00 00 00 00 00 # p_vaddr: virtual address of segment in memory (amd64: 00400000) +00 00 00 00 00 00 00 00 # p_paddr: physical address of segment, unspecified by 386 supplement +02 1E 01 00 00 00 00 00 ##### p_filesz: size in bytes of the segment in the file image (see make.sh) +00 00 C0 7F 00 00 00 00 # p_memsz: (>= filesz) size in bytes of the segment in memory +00 10 00 00 00 00 00 00 # p_align: 1000 for x86 + +# ============= 64-BIT EXTENSIONS +# +# SmithForth has 64-bit Forth cells (i.e., integers) and uses the instruction set +# x86-64 (a.k.a. amd64). Changes from x86 to x86-64 are explained in Intel's +# manual (and in AMD's). See for instance Vol 1 Sec 3.2.1, Vol 2 Sec 2.2.1, and the +# instruction set reference, Vol 2 Chs 3, 4, 5. There are many subtle details. +# +# In a nutshell, general-purpose registers are widened from 32 bits to 64. The old eight +# 32-bit general-purpose registers EAX, ECX, ..., EDI are still available as operands. +# They are the lower halves of their new 64-bit counterparts RAX, RCX, ..., RDI. +# There are also 8 new 64-bit general-purpose registers R8, R9, ..., R15. +# +# The x86-64 instruction set is almost a superset of x86. Many of the extensions are +# 64-bit counterparts to old 32-bit instructions. Often an instruction on 64-bit operands +# is obtained from a 32-bit instruction by adding a REX prefix byte valued 40 ... 4F (see below). +# Bytes ModR/M and SIB are used in x86-64 as in x86. These bytes provide only 3-bit fields to +# select operands. If we want to select a new register R8 ... R15 as an operand, each 3-bit field +# should have another bit. These bits occur in the REX byte. +# +# The 4 high bits of REX are 0100 (=4). The 4 low bits are named WRXB: (see Intel manual Vol 2 Sec 2.2.1) +# W=1 iff certain operands are 64 bits wide +# "REX.W" (W=1) or "REX" (W=0) appears in the instruction reference for most of our instructions. +# R=1 iff a register R8 ... R15 is referred to by: +# field reg (middle) of the ModR/M byte; +# X=1 iff a register R8 ... R15 is referred to by: +# field index of the SIB byte; +# B=1 iff a register R8 ... R15 is referred to by: +# field r/m (last) of the ModR/M byte, +# field base of the SIB byte, or +# field reg of the opcode. +# +# Most operations that set a 32-bit register (the lower half of a 64-bit register) also zero +# out the higher 32 bits of the containing 64-bit register. For example, XOR EAX, EAX = 31 C0 +# (even without prefix REX) sets all 64 bits of RAX to 0. +# +# Q: In an x86-64 instruction like CMP r/m8, imm8 with opcode 80 /7 ib, does ModR/M byte 00 111 000 refer to [eax] or to [rax]? +# A: [rax]. Register ax contains an address, not an operand. The default AddressSize in 64-bit mode is 64 bits. +# AddressSize is defined not in our usual Volume 2 of Intel's manual, but in Volume 1. See Table 3-4. +# See also AMD's manual, Table 1-3 (p. 9) of https://www.amd.com/system/files/TechDocs/24594.pdf + +# ============= FORTH INTERPRETER +# +# Forth words are defined in terms of more primitive Forth words. The most primitive +# SmithForth words are defined in machine language. SmithForth is written "from scratch." +# In the beginning, there is only machine code. We want to switch from writing machine +# code to writing (more pleasant) Forth. Our immediate goal is to write a simple Forth +# interpreter in machine code. Here is an example of Forth input: +# +# 1 2 + . ( Interpreting, not compiling, so far. ) +# : newWord ( -- ) ." After colon, compiling." ; ( After semicolon, interpreting. ) +# newWord ( Interpreting: newWord is executed ) +# +# The interpreter reads words and executes them until it reaches a colon. After the colon, +# the interpreter stops executing and starts compiling. To keep the design simple, perhaps +# the colon should require no special treatment. Let the colon, when executed, add a new word +# to the dictionary. We have the following TENTATIVE PLAN: +# +# Interpret: +# Consume the next word (from the input stream). +# Find it in the dictionary. +# Execute it. +# Go to Interpret. +# +# Colon: +# Name: +# Consume the next word (the first word of the colon definition) and write a new Forth +# header signifying a new dictionary entry named by this word. +# Constituent: +# Consume the next word. +# If it is a semicolon, exit routine Colon. Else: +# Find the word in the dictionary. +# Compile the word (append x86 instr. CALL to the dict. entry of the current definition). +# Go to Constituent. +# +# Loops Interpret and Constituent are similar. +# We can combine them into one loop if we remember whether we are +# outside a definition (STATE = Interpreting) or +# inside a definition (STATE = Compiling). +# Some words like semicolon should not be compiled, even when Compiling. +# Such words are labeled "immediate" and treated specially. We have: +# +# ============= THE PLAN +# (a typical Forth interpreter, simplified) +# +# Set STATE to Interpreting. +# Loop: +# Consume the next word. +# Find it in the dictionary. +# If STATE is Interpreting, or if the word is immediate: +# Execute the word. +# Else: +# Compile the word. +# Go to Loop. +# +# Colon: +# Consume the next word and make it the name of a new dictionary entry. +# Set STATE to Compiling. +# Return from subroutine Colon. +# +# Semicolon, an immediate word: +# Set STATE to Interpreting. +# Return from subroutine Semicolon. +# +# Our first interpreter cannot recognize whole words. We provide special +# commands to start a definition or compile or execute a word. The input +# stream is binary. This binary interpreter (bi) transmits most bytes (all +# but 99) unchanged. A command begins with byte 99. After 99 is a 1-byte +# argument indicating which command is issued. If the command indicates a +# definition, the argument also encodes the length of the word's name, and +# the name of the word is given in full. If the command is to execute or +# compile the word, only the first character of the name is provided, encoded +# in the argument. +# +# MACHINE CODE ########## INTENTION ############ 78 INSTRUCTION ####### OPCODE ######## ModR/M #### SIB ###### +BE B2 00 40 00 #:rsi(input) = 004000__ mov r32, imm32 B8+rd id +BF 30 00 00 10 # rdi(output) = 10000030 mov r32, imm32 B8+rd id + +######################### binary interpreter >>> 82 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +E8 02 00 00 00 #+call (bi) call rel32 +EB F9 #-jump bi 89 jmp rel8 EB cb +# # # # # # # # # # # # # (bi) 89 +AC # al = [rsi++] lods m8 AC +3C 99 # cmp al, 99(command) cmp al, imm8 3C ib +74 02 #+jump _command if == 8E je rel8 74 cb +AA # [rdi++] = al (xmit) stos m8 AA +C3 # return ret C3 +# _command: # 90 +BA 28 00 00 10 # rdx = Latest mov r32, imm32 B8+rd id +AC # al = [rsi++] (argument) lods m8 AC +A8 60 # al & 60(graphic)? test al, imm8 A8 ib +74 31 #+jump Head if zero 9A jz rel8 74 cb +48 8B 1A # rbx = [rdx] mov r64, r/m64 REX.W 8B /r 00 011 010 +# _find1: # 9D +50 # push al push r64 50+rd +24 7F # al &= 7F and al, imm8 24 ib +3A 43 11 # cmp al, [rbx+11] cmp r8, r/m8 REX 3A /r 01 000 011 +58 # pop al pop r64 58+rd +74 06 #+jump _match if == A6 je rel8 74 cb +48 8B 5B 08 # rbx = [rbx+8] mov r64, r/m64 REX.W 8B /r 01 011 011 +EB F1 #-jump _find1 AC jmp rel8 EB cb +# _match: # AC +A8 80 # al & 80(exec) ? test al, imm8 A8 ib +74 09 #+jump COMPL if zero B0 jz rel8 74 cb +FF 23 # jump [rbx] (exec) B2 jmp r/m64 REX FF /4 00 100 011 + +######################### Interpreter subroutines ################################################ + +99 05 43 4F 4D 50 4C #### COMPL Forth's COMPILE, B9 ( ebx=xt -- ) +B0 FF AA # compile >>>>>>>>>>>>>>>>> call r/m64 FF /2 00 010 100 00 100 101 +B0 14 AA # al = _ mov r8, imm8 B0+rb ib +B0 25 AA # [rdi++] = al stos m8 AA +93 # eax = ebx xchg eax, r32 90+rd +AB # [rdi(++4)] = eax stos m32 AB +C3 # return ret C3 + +99 04 48 65 61 64 ####### Head ================= CB ( al=flag rdx=Latest rsi=addr -- rdx=Latest rsi=addr' ) +48 83 C7 0F # rdi += 0F add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +48 83 E7 F0 # rdi &= F0 and r/m64, imm8 REX.W 83 /4 ib 11 100 111 +48 8B 0A # rcx = [rdx] mov r64, r/m64 REX.W 8B /r 00 001 010 +48 89 4F 08 # [rdi+8] = rcx mov r/m64, r64 REX.W 89 /r 01 001 111 +48 89 3A # [rdx] = rdi mov r/m64, r64 REX.W 89 /r 00 111 010 +48 83 C7 10 # rdi += 10 add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +AA # [rdi++] = al stos m8 AA +91 # ecx = eax xchg eax, r32 90+rd +83 E1 1F # ecx &= 1F and r/m32, imm8 83 /4 ib 11 100 001 +F3 A4 # copy Name rep movs m8, m8 F3 A4 +48 8B 0A # rcx = [rdx] mov r64, r/m64 REX.W 8B /r 00 001 010 +48 89 39 # [rcx] = rdi mov r/m64, r64 REX.W 89 /r 00 111 001 +C3 # return ret C3 + +# ============= DICTIONARY FORMAT +# +# Each SmithForth dictionary entry begins with: +# (8 bytes) Code +# (8 bytes) Link +# (1 byte) Flag (3 bits) and Length (5 bits) of Name +# (Length bytes) Name, where Length < 2^5. +# Each subroutine call refers to its callee. See argument ZZ in the following example: +# +# WW WW WW WW WW WW WW WW # Code: address of a subroutine (usually right after Name) +# XX XX XX XX XX XX XX XX # Link: address of the next earlier dictionary entry +# YY # Flag: 80=IMMEDIATE, 40=HIDDEN ; Name Length +# 2E 53 # Name: .S ( -- ) show the values on the data stack +# 4D 89 7F F8 # [r15-8] = r15 (obuf) mov r/m64, r64 REX.W 89 /r 01 111 111 +# 49 C7 47 F0 00 00 00 10 # [r15-10] = 10000000 (len) mov r/m64, imm32 REX.W C7 /0 id 01 000 111 +# 4D 29 7F F0 # [r15-10] -= r15 sub r/m64, r64 REX.W 29 /r 01 111 111 +# 49 83 EF 10 # r15 -= 2 cells sub r/m64, imm8 REX.W 83 /5 ib 11 101 111 +# FF 14 25 ZZ ZZ ZZ ZZ # call TYPE call r/m64 FF /2 00 010 100 00 100 101 +# C3 # return ret C3 + +99 03 42 59 45 ########## BYE ( -- ) ============================================================= +6A 3C 58 # rax = exit (no return) push imm8; pop 6A ib ; 58+rd +31 FF # rdi = stat xor r/m32, r32 31 /r 11 111 111 +0F 05 # syscall syscall 0F 05 + +# 99 C2 # BYE + +# Linux syscall: ( RDI RSI RDX R10 R8 R9 RAX=syscall# -- RAX=stat RCX=? R11=? ) +# Manual pages on system calls: `man 2 syscalls ; man 2 exit ; man 2 read ; man 2 write ; man 2 mmap` +# syscall numbers: /usr/include/x86_64-linux-gnu/asm/unistd_64.h +# syscall error numbers: /usr/include/asm-generic/errno-base.h +# mmap flag values: /usr/include/asm-generic/mman-common.h + +99 04 54 59 50 45 ####### TYPE ( rsi=addr rdx=u -- rsi=? rdi=? ) show memory [addr, addr+u) ====== +6A 01 5F # rdi(fd) = stdout = 1 push imm8; pop 6A ib ; 58+rd +# _beg: # 00 +8B C7 # rax = write = 1 = rdi mov r32, r/m32 8B /r 11 000 111 +0F 05 # syscall syscall 0F 05 +48 85 C0 # cmp rax, 0 test r/m64, r64 REX.W 85 /r 11 000 000 +7C 08 #+jump _end if < 09 jl rel8 7C cb +48 01 C6 # rsi(buf) += rax add r/m64, r64 REX.W 01 /r 11 000 110 +48 29 C2 # rdx(cnt) -= rax sub r/m64, r64 REX.W 29 /r 11 000 010 +7F EF #-jump _beg if > 11 jg rel8 7F cb +# _end: # 11 +C3 # return ret C3 + +# ============= DEBUGGING +# +# During development, a program like this one may crash with an uninformative error message like +# "Segmentation fault" or "Illegal instruction." How can we work in such an environment? +# We start with a trivial program that works (i.e., simply invokes syscall exit, as in BYE), +# and then expand it gradually until it does what we want. When a program breaks after a small +# change, we know where the bug is. Here is one way to go. +# +# Insert a jump to BYE at the top of the program. You have to compute the length of the jump. +# After this chore, updating it is easy if you expand the program only one instruction at a time. +# You will want to disable and enable parts of the program as you expand it. The most basic ways: +# -- Hide unwanted code in comments. If this disrupts byte counts, replace lost bytes by no-op +# instructions NOP = 90. +# -- Inside a subroutine, leave early by inserting a return instruction RET = C3. + +99 03 64 62 67 ########## dbg ( -- ) show stack and data; use `./SForth | xxd -o 0x0fffffe0` ===== +56 57 # push rsi, rdi push r64 50+rd +BE E0 FF FF 0F # rsi = addr mov r32, imm32 B8+rd id +BA 00 0A 00 00 # rdx = u mov r32, imm32 B8+rd id +99 54 # Call TYPE +5F 5E # pop rdi, rsi pop r64 58+rd +C3 # return ret C3 + +# 99 E4 99 C2 # dbg BYE + +99 03 72 65 67 ########## reg ( -- ) show registers; use `./SForth | xxd` ======================== +56 57 # push rsi, rdi push r64 50+rd +41 57 57 41 56 56 # push r15, rdi, r14, rsi push r64 REX 50+rd +41 55 55 41 54 54 # push r13, rbp, r12, rsp push r64 REX 50+rd +41 53 53 41 52 52 # push r11, rbx, r10, rdx push r64 REX 50+rd +41 51 51 41 50 50 # push r9 , rcx, r8 , rax push r64 REX 50+rd +48 8B F4 # rsi = rsp mov r64, r/m64 REX.W 8B /r 11 110 100 +BA 80 00 00 00 # rdx = u mov r32, imm32 B8+rd id +99 54 # Call TYPE +48 83 EC 80 # rsp -= -80 sub r/m64, imm8 REX.W 83 /5 ib 11 101 100 +5F 5E # pop rdi, rsi pop r64 58+rd +C3 # return ret C3 + +# 99 F2 99 C2 # reg BYE + +# ============= TEXT INTERPRETER +# +# Standard Forth handles input one line at a time. +# SmithForth's text interpreter is a simple interpreter in the standard Forth style. +# SVAL (see standard Forth's EVALUATE) interprets each line. +# REFILL fetches a line of input, including its trailing LF, and sets the input source state. +# 10000000 #IN cell contains #characters in the current line. +# 10000008 TIB cell contains the address where the current line begins. +# 10000010 >IN cell contains #characters in the current line that have been parsed. +# 10000020 STATE cell contains 0(Interpreting) or 1(Compiling). +# 10000028 Latest cell contains the execution token (xt) of the latest defined Forth word. +# In Forth, to parse is to remove from the input stream. As a line is parsed, [>IN] increases from 0 to [#IN]. +# Forth's "parse area" is the part of the line not yet parsed. + +99 06 52 45 46 49 4C 4C # REFILL ( -- ) ========================================================== +49 C7 C1 00 00 00 10 # r9 = VAR mov r/m64, imm32 REX.W C7 /0 id 11 000 001 +49 8B 01 # rax = [#IN] mov r64, r/m64 REX.W 8B /r 00 000 001 +49 01 41 08 # [TIB] += rax add r/m64, r64 REX.W 01 /r 01 000 001 +49 83 21 00 # [#IN] = 0 and r/m64, imm8 REX.W 83 /4 ib 00 100 001 +49 83 61 10 00 # [>IN] = 0 and r/m64, imm8 REX.W 83 /4 ib 01 100 001 +# _beg: # 00 +49 FF 01 # [#IN]++ inc r/m64 REX.W FF /0 00 000 001 +49 8B 41 08 # rax = [TIB] mov r64, r/m64 REX.W 8B /r 01 000 001 +49 03 01 # rax += [#IN] add r64, r/m64 REX.W 03 /r 00 000 001 +80 78 FF 0A # cmp [rax-1], LF cmp r/m8, imm8 80 /7 ib 01 111 000 +75 F0 #-jump _beg if != 10 jne rel8 75 cb +C3 # return ret C3 + +99 04 73 65 65 6B ####### seek ( cl dl "ccc" -- eflags ) parse until 1st char of parse area is within [cl, dl) or parse area is empty +49 C7 C1 00 00 00 10 # r9 = VAR mov r/m64, imm32 REX.W C7 /0 id 11 000 001 +2A D1 # dl -= cl sub r8, r/m8 2A /r 11 010 001 +# _beg: # 00 like WITHIN ( al cl dl -- eflags ) +49 8B 41 10 # rax = [>IN] mov r64, r/m64 REX.W 8B /r 01 000 001 +49 3B 01 # cmp rax, [#IN] cmp r64, r/m64 REX.W 3B /r 00 000 001 +73 16 #+jump _end if U>= 09 jae rel8 73 cb +49 8B 41 08 # rax = [TIB] mov r64, r/m64 REX.W 8B /r 01 000 001 +49 03 41 10 # rax += [>IN] add r64, r/m64 REX.W 03 /r 01 000 001 +8A 00 # al = [rax] mov r8, r/m8 8A /r 00 000 000 +2A C1 # al -= cl sub r8, r/m8 2A /r 11 000 001 +3A C2 # cmp al, dl cmp r8, r/m8 3A /r 11 000 010 +72 06 #+jump _end if U< 19 jb rel8 72 cb +49 FF 41 10 # [>IN]++ inc r/m64 REX.W FF /0 01 000 001 +EB E1 #-jump _beg 1F jmp rel8 EB cb +# _end: # 1F +C3 # return ret C3 + +99 05 50 41 52 53 45 #### PARSE ( cl dl "ccc" -- rbp=addr rax=u ) addr: where ccc begins ; u: length of ccc +49 C7 C1 00 00 00 10 # r9 = VAR mov r/m64, imm32 REX.W C7 /0 id 11 000 001 +49 8B 69 10 # rbp = [>IN] mov r64, r/m64 REX.W 8B /r 01 101 001 +99 73 # Call seek parse until 1st instance within [cl, dl) is parsed or parse area empty +49 8B 41 10 # rax = [>IN] mov r64, r/m64 REX.W 8B /r 01 000 001 +73 04 #+jump _end if U>= 00 jae rel8 73 cb +49 FF 41 10 # [>IN]++ inc r/m64 REX.W FF /0 01 000 001 +# _end: # 04 +48 29 E8 # rax -= rbp sub r/m64, r64 REX.W 29 /r 11 101 000 +49 03 69 08 # rbp += [TIB] add r64, r/m64 REX.W 03 /r 01 101 001 +C3 # return ret C3 + +99 05 70 6E 61 6D 65 #### pname ( "ccc" -- rbp=addr rax=u ) PARSE-NAME ============ +B1 21 B2 7F # (cl, dl) = (BL+1, ...) mov r8, imm8 B0+rb ib +99 73 # Call seek +B1 7F B2 21 # (cl, dl) = (..., BL+1) mov r8, imm8 B0+rb ib +99 50 # Call PARSE +C3 # return ret C3 + +99 81 5B ################ [ ( -- ) lbracket IMMEDIATE ============================================ +6A 00 # push 0(Interpreting) push imm8 6A ib +8F 04 25 20 00 00 10 # pop [STATE] pop r/m64 8F /0 00 000 100 00 100 101 +C3 # return ret C3 + +99 01 5D ################ ] ( -- ) rbracket ====================================================== +6A 01 # push 1(Compiling) push imm8 6A ib +8F 04 25 20 00 00 10 # pop [STATE] pop r/m64 8F /0 00 000 100 00 100 101 +C3 # return ret C3 + +99 81 5C ################ \ ( "ccc" -- ) backslash IMMEDIATE ================================ +48 8B 04 25 00 00 00 10 # rax = [#IN] mov r64, r/m64 REX.W 8B /r 00 000 100 00 100 101 +48 89 04 25 10 00 00 10 # [>IN] = rax mov r/m64, r64 REX.W 89 /r 00 000 100 00 100 101 +C3 # return ret C3 + +99 81 28 ################ ( ( "ccc" -- ) lparen IMMEDIATE ================================ +B1 29 B2 2A # (cl, dl) = (RP, RP+1) mov r8, imm8 B0+rb ib +99 50 # Call PARSE Forth 2012 implies comment ends at rparen or newline. +C3 # return ret C3 + +99 01 3A ################ : ( "ccc" -- ) colon ==================================== +99 70 # Call pname See Forth 2012 Table 2.1 +48 89 EE # rsi = rbp mov r/m64, r64 REX.W 89 /r 11 101 110 +BA 28 00 00 10 # rdx = Latest mov r32, imm32 B8+rd id +99 48 # Call Head +48 8B 0A # rcx = [rdx] mov r64, r/m64 REX.W 8B /r 00 001 010 +48 83 C1 10 # rcx += 10 add r/m64, imm8 REX.W 83 /0 ib 11 000 001 +80 09 40 # [rcx] |= 40(HIDDEN) or r/m8, imm8 80 /1 ib 00 001 001 +99 5D # Call ] +C3 # return ret C3 + +99 81 3B ################ ; ( C: -- ) semicolon IMMEDIATE ======================================== +B0 C3 # al = opcode ret mov r8, imm8 B0+rb ib +AA # [rdi++] = al stos m8 AA +48 8B 0C 25 28 00 00 10 # rcx = [Latest] mov r64, r/m64 REX.W 8B /r 00 001 100 00 100 101 +48 83 C1 10 # rcx += 10 add r/m64, imm8 REX.W 83 /0 ib 11 000 001 +80 21 BF # [rcx] &= BF(~HIDDEN) and r/m8, imm8 80 /4 ib 00 100 001 +99 5B # Call [ +C3 # return ret C3 + +99 01 2E ################ . ( char -- ) nonstandard name for C, ================================== +41 8A 07 # al = [r15] mov r8, r/m8 REX 8A /r 00 000 111 +49 83 C7 08 # r15 += 8 add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +AA # [rdi++] = al stos m8 AA +C3 # return ret C3 + +99 83 4C 49 54 ########## LIT ( C: x -- ) ( -- x ) IMMEDIATE ===================================== TODO compare xchg r15, rsp ; push imm8 ; xchg r15, rsp +B8 49 83 EF 08 AB # compile r15 -= 8 sub r/m64, imm8 REX.W 83 /5 ib 11 101 111 +B8 6A 41 8F 07 AA # eax = push x ; pop [r15] push i8 ; pop r/m64 6A ib;REX 8F /0 00 000 111 +41 8A 07 AB # al = [r15] ; compile mov r8, r/m8 REX 8A /r 00 000 111 +49 83 C7 08 # r15 += 8 add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +C3 # return ret C3 + +99 03 78 74 3D ########## xt= ( rbp=addr rax=u rbx=xt -- rbx=xt rax=? rdi=? eflags ) rbx == 0 or unhidden and matches +48 85 DB # rbx(xt) ? test r/m64, r64 REX.W 85 /r 11 011 011 +75 01 #+jump _nonzero if != 0 jnz rel8 75 cb +C3 # return ret C3 +# _nonzero: # +48 8B C8 # rcx = rax(u) mov r64, r/m64 REX.W 8B /r 11 001 000 +48 8D 73 10 # rsi = rbx(xt) + 10 lea r64, m REX.W 8D /r 01 110 011 +AC # al = [rsi++] lods m8 AC +A8 40 # al & 40(HIDDEN) ? test al, imm8 A8 ib +74 01 #+jump _unhidden if == 0 jz rel8 74 cb +C3 # return ret C3 +# _unhidden: # +48 83 E0 1F # rax &= 1F(Length) and r/m64, imm8 REX.W 83 /4 ib 11 100 000 +48 39 C8 # cmp rax, rcx cmp r/m64, r64 REX.W 39 /r 11 001 000 +74 01 #+jump _lengthEq if == je rel8 74 cb +C3 # return ret C3 +# _lengthEq: # +48 8B FD # rdi = rbp mov r64, r/m64 REX.W 8B /r 11 111 101 +F3 A6 # strings equal ? repe cmps m8, m8 F3 A6 +C3 # return ret C3 + +99 04 46 49 4E 44 ####### FIND ( rbp=addr rax=u -- rbp=addr rax=u rbx=xt ) xt==0 if not found ==== +48 8B 1C 25 28 00 00 10 # rbx = [Latest] mov r64, r/m64 REX.W 8B /r 00 011 100 00 100 101 +# _beg: # +E8 03 00 00 00 #+call (FIND) call rel32 E8 cd +75 F9 #-jump _beg if != jne rel8 75 cb +C3 # return ret C3 +# # # # # # # # # # # # # (FIND) +50 57 # push rax, rdi push r64 50+rd +99 78 # Call xt= +5F 58 # pop rdi, rax pop r64 58+rd +74 04 #+jump _end if == je rel8 74 cb +48 8B 5B 08 # rbx = [rbx+8] mov r64, r/m64 REX.W 8B /r 01 011 011 +# _end: # +C3 # return ret C3 + +99 03 4E 75 6D ########## Num ( rbp=addr rax=u -- n ) ============================================ +49 83 EF 08 # r15 -= 8 sub r/m64, imm8 REX.W 83 /5 ib 11 101 111 +49 83 27 00 # [r15] = 0 and r/m64, imm8 REX.W 83 /4 ib 00 100 111 +48 89 C1 # rcx = rax mov r/m64, r64 REX.W 89 /r 11 000 001 +48 8B F5 # rsi = rbp mov r64, r/m64 REX.W 8B /r 11 110 101 +# _beg: # +E8 03 00 00 00 #+call (Num) call rel32 E8 cd +E2 F9 #-jump beg if --rcx loop rel8 E2 cb +C3 # return ret C3 +# # # # # # # # # # # # # (Num) +AC # al = [rsi++] lods m8 AC +3C 41 # cmp al, 'A' cmp al, imm8 3C ib +7C 02 #+jump _digit if < jl rel8 7C cb +# _letter: # +2C 07 # al -= 7 sub al, imm8 2C ib +# _digit: # +2C 30 # al -= 30 sub al, imm8 2C ib +49 C1 27 04 # [r15] <<= 4 sal r/m64, imm8 REX.W C1 /4 ib 00 100 111 +49 09 07 # [r15] |= rax or r/m64, r64 REX.W 09 /r 00 000 111 +C3 # return ret C3 + +99 04 6D 69 73 73 ####### miss ( rbp=addr rax=u rbx=xt -- |n rbx=xt ) n present iff u nonzero ==== +48 85 DB # rbx(xt) ? test r/m64, r64 REX.W 85 /r 11 011 011 +74 01 #+jump (miss) if == 0 jz rel8 74 cb +C3 # return ret C3 +# # # # # # # # # # # # # (miss) +48 85 C0 # rax(u) ? test r/m64, r64 REX.W 85 /r 11 000 000 +75 01 #+jump _nonempty if != jne rel8 75 cb +C3 # return ret C3 +# _nonempty: # +99 4E # Call Num +F6 04 25 20 00 00 10 01 # [STATE] ? test r/m8, imm8 F6 /0 ib 00 000 100 00 100 101 +75 01 #+jump _lit if != 0 jnz rel8 75 cb +C3 # return ret C3 +# _lit: # +99 4C # Call LIT +C3 # return ret C3 + +99 04 45 58 45 43 ####### EXEC ( rbx=xt -- ) ===================================================== +B9 F8 FF FF 7F # rcx = _ mov r32, imm32 B8+rd id +57 # push rdi push r64 50+rd +89 CF # rdi = rcx mov r/m32, r32 89 /r 11 001 111 +99 43 # Call COMPL +B0 C3 # al = C3 mov r8, imm8 B0+rb ib +AA # [rdi++] = al stos m8 AA +5F # pop rdi pop r64 58+rd +FF D1 # call rcx call r/m64 FF /2 11 010 001 +C3 # return ret C3 + +99 04 65 78 65 63 ####### exec ( al rbx=xt -- ) iff al != 1 ====================================== +3C 01 # cmp al, 1 cmp al, imm8 3C ib +75 01 #+jump (exec) if != jne rel8 75 cb +C3 # return ret C3 +# # # # # # # # # # # # # (exec) +99 45 # Call EXEC +C3 # return ret C3 + +99 05 63 6F 6D 70 6C #### compl ( al -- al ) iff al == 1 ========================================== +3C 01 # cmp al, 1 cmp al, imm8 3C ib +74 01 #+jump (compl) if == je rel8 74 cb +C3 # return ret C3 +# # # # # # # # # # # # # (compl) +99 43 # Call COMPL +B0 01 # al = 1 mov r8, imm8 B0+rb ib +C3 # return ret C3 + +99 03 68 69 74 ########## hit ( rbx=xt -- ) ====================================================== +48 85 DB # rbx(xt) ? test r/m64, r64 REX.W 85 /r 11 011 011 +75 01 #+jump (hit) if != 0 jnz rel8 75 cb +C3 # return ret C3 +# # # # # # # # # # # # # (hit) +40 8A 43 10 # al = [rbx+10] mov r8, r/m8 REX 8A /r 01 000 011 +24 80 # al &= 80(IMMEDIATE) and al, imm8 24 ib +0A 04 25 20 00 00 10 # al |= [STATE] or r8, r/m8 0A /r 00 000 100 00 100 101 +99 63 # Call compl +99 65 # Call exec +C3 # return ret C3 + +99 04 53 56 41 4C ####### SVAL ( i*x -- j*x ) == 00 EVALUATE ===================================== +E8 03 00 00 00 #+call (SVAL) 05 call rel32 E8 cd +7C F9 #-jump SVAL if < 07 jl rel8 7C cb +C3 # return ret C3 +# # # # # # # # # # # # # (SVAL) 08 +99 70 # Call pname +99 46 # Call FIND +99 6D # Call miss +99 68 # Call hit +48 8B 04 25 10 00 00 10 # rax = [>IN] mov r64, r/m64 REX.W 8B /r 00 000 100 00 100 101 +48 3B 04 25 00 00 00 10 # cmp rax, [#IN] cmp r64, r/m64 REX.W 3B /r 00 000 100 00 100 101 +C3 # return ret C3 + +99 02 74 69 ############# ti ( -- ) text interpreter ============================================= +49 C7 C7 00 00 00 10 # r15(stack) = 10000000 mov r/m64, imm32 REX.W C7 /0 id 11 000 111 +49 89 77 08 # [TIB] = rsi mov r/m64, r64 REX.W 89 /r 01 110 111 +99 5B # Call [ +# _beg: # +E8 02 00 00 00 #+call (ti) call rel32 E8 cd +EB F9 #-jump _beg jmp rel8 EB cb +# # # # # # # # # # # # # (ti) +99 52 # Call REFILL +99 53 # Call SVAL +C3 # return ret C3 + +# 99 E4 99 C2 # dbg BYE + +99 F4 # ti diff --git a/SForth.dmp.bak b/SForth.dmp.bak new file mode 100644 index 0000000..e7c6ec5 --- /dev/null +++ b/SForth.dmp.bak @@ -0,0 +1,562 @@ +# David Smith 2022 david.a.c.v.smith@gmail.com http://dacvs.neocities.org/ +# This is the 1st of the 2 files that define SmithForth, a subroutine-threaded Forth for x86-64. + +# Understanding this file may be easier if first you watch my video series on hand-made +# Linux x86 executables (featuring the ELF header and general-purpose x86 instructions): +# https://www.youtube.com/playlist?list=PLZCIHSjpQ12woLj0sjsnqDH8yVuXwTy3p + +# ============= ELF FILE HEADER +# +# Linux will run a computing job given the name of an executable file. An executable file +# contains machine code for the processor and information for the operating system about the +# layout of the file and the dimensions of the job. Working without the usual development +# tools, we write this information by hand. + +7F 45 4C 46 # e_ident[EI_MAG]: ELF magic number + 02 # e_ident[EI_CLASS]: 1: 32-bit, 2: 64-bit + 01 # e_ident[EI_DATA]: 1: little-endian, 2: big-endian + 01 # e_ident[EI_VERSION]: ELF header version; must be 1 + 00 # e_ident[EI_OSABI]: Target OS ABI; should be 0 +00 # e_ident[EI_ABIVERSION]: ABI version; 0 is ok for Linux + 00 00 00 00 00 00 00 # e_ident[EI_PAD]: unused, should be 0 +02 00 # e_type: object file type; 2: executable + 3E 00 # e_machine: instruction set architecture; 3: x86, 3E: amd64 + 01 00 00 00 # e_version: ELF identification version; must be 1 +78 00 40 00 00 00 00 00 # e_entry: memory address of entry point (where process starts) +40 00 00 00 00 00 00 00 # e_phoff: file offset where program headers begin (34: 32-bit, 40: 64) +00 00 00 00 00 00 00 00 # e_shoff: file offset where section headers begin +00 00 00 00 # e_flags: 0 for x86 + 40 00 # e_ehsize: size of this header (34: 32-bit, 40: 64-bit) + 38 00 # e_phentsize: size of each program header (20: 32-bit, 38: 64-bit) +01 00 # e_phnum: number of program headers + 40 00 # e_shentsize: size of each section header (28: 32-bit, 40: 64-bit) + 00 00 # e_shnum: number of section headers + 00 00 # e_shstrndx: index of section header containing section names + +# ============= ELF PROGRAM HEADER + +01 00 00 00 # p_type: segment type; 1: loadable + 07 00 00 00 # p_flags: segment-dependent flags (1: X, 2: W, 4: R) +00 00 00 00 00 00 00 00 # p_offset: file offset where segment begins +00 00 40 00 00 00 00 00 # p_vaddr: virtual address of segment in memory (amd64: 00400000) +00 00 00 00 00 00 00 00 # p_paddr: physical address of segment, unspecified by 386 supplement +02 1E 01 00 00 00 00 00 ##### p_filesz: size in bytes of the segment in the file image (see make.sh) +00 00 C0 7F 00 00 00 00 # p_memsz: (>= filesz) size in bytes of the segment in memory +00 10 00 00 00 00 00 00 # p_align: 1000 for x86 + +# ============= 64-BIT EXTENSIONS +# +# SmithForth has 64-bit Forth cells (i.e., integers) and uses the instruction set +# x86-64 (a.k.a. amd64). Changes from x86 to x86-64 are explained in Intel's +# manual (and in AMD's). See for instance Vol 1 Sec 3.2.1, Vol 2 Sec 2.2.1, and the +# instruction set reference, Vol 2 Chs 3, 4, 5. There are many subtle details. +# +# In a nutshell, general-purpose registers are widened from 32 bits to 64. The old eight +# 32-bit general-purpose registers EAX, ECX, ..., EDI are still available as operands. +# They are the lower halves of their new 64-bit counterparts RAX, RCX, ..., RDI. +# There are also 8 new 64-bit general-purpose registers R8, R9, ..., R15. +# +# The x86-64 instruction set is almost a superset of x86. Many of the extensions are +# 64-bit counterparts to old 32-bit instructions. Often an instruction on 64-bit operands +# is obtained from a 32-bit instruction by adding a REX prefix byte valued 40 ... 4F (see below). +# Bytes ModR/M and SIB are used in x86-64 as in x86. These bytes provide only 3-bit fields to +# select operands. If we want to select a new register R8 ... R15 as an operand, each 3-bit field +# should have another bit. These bits occur in the REX byte. +# +# The 4 high bits of REX are 0100 (=4). The 4 low bits are named WRXB: (see Intel manual Vol 2 Sec 2.2.1) +# W=1 iff certain operands are 64 bits wide +# "REX.W" (W=1) or "REX" (W=0) appears in the instruction reference for most of our instructions. +# R=1 iff a register R8 ... R15 is referred to by: +# field reg (middle) of the ModR/M byte; +# X=1 iff a register R8 ... R15 is referred to by: +# field index of the SIB byte; +# B=1 iff a register R8 ... R15 is referred to by: +# field r/m (last) of the ModR/M byte, +# field base of the SIB byte, or +# field reg of the opcode. +# +# Most operations that set a 32-bit register (the lower half of a 64-bit register) also zero +# out the higher 32 bits of the containing 64-bit register. For example, XOR EAX, EAX = 31 C0 +# (even without prefix REX) sets all 64 bits of RAX to 0. +# +# Q: In an x86-64 instruction like CMP r/m8, imm8 with opcode 80 /7 ib, does ModR/M byte 00 111 000 refer to [eax] or to [rax]? +# A: [rax]. Register ax contains an address, not an operand. The default AddressSize in 64-bit mode is 64 bits. +# AddressSize is defined not in our usual Volume 2 of Intel's manual, but in Volume 1. See Table 3-4. +# See also AMD's manual, Table 1-3 (p. 9) of https://www.amd.com/system/files/TechDocs/24594.pdf + +# ============= FORTH INTERPRETER +# +# Forth words are defined in terms of more primitive Forth words. The most primitive +# SmithForth words are defined in machine language. SmithForth is written "from scratch." +# In the beginning, there is only machine code. We want to switch from writing machine +# code to writing (more pleasant) Forth. Our immediate goal is to write a simple Forth +# interpreter in machine code. Here is an example of Forth input: +# +# 1 2 + . ( Interpreting, not compiling, so far. ) +# : newWord ( -- ) ." After colon, compiling." ; ( After semicolon, interpreting. ) +# newWord ( Interpreting: newWord is executed ) +# +# The interpreter reads words and executes them until it reaches a colon. After the colon, +# the interpreter stops executing and starts compiling. To keep the design simple, perhaps +# the colon should require no special treatment. Let the colon, when executed, add a new word +# to the dictionary. We have the following TENTATIVE PLAN: +# +# Interpret: +# Consume the next word (from the input stream). +# Find it in the dictionary. +# Execute it. +# Go to Interpret. +# +# Colon: +# Name: +# Consume the next word (the first word of the colon definition) and write a new Forth +# header signifying a new dictionary entry named by this word. +# Constituent: +# Consume the next word. +# If it is a semicolon, exit routine Colon. Else: +# Find the word in the dictionary. +# Compile the word (append x86 instr. CALL to the dict. entry of the current definition). +# Go to Constituent. +# +# Loops Interpret and Constituent are similar. +# We can combine them into one loop if we remember whether we are +# outside a definition (STATE = Interpreting) or +# inside a definition (STATE = Compiling). +# Some words like semicolon should not be compiled, even when Compiling. +# Such words are labeled "immediate" and treated specially. We have: +# +# ============= THE PLAN +# (a typical Forth interpreter, simplified) +# +# Set STATE to Interpreting. +# Loop: +# Consume the next word. +# Find it in the dictionary. +# If STATE is Interpreting, or if the word is immediate: +# Execute the word. +# Else: +# Compile the word. +# Go to Loop. +# +# Colon: +# Consume the next word and make it the name of a new dictionary entry. +# Set STATE to Compiling. +# Return from subroutine Colon. +# +# Semicolon, an immediate word: +# Set STATE to Interpreting. +# Return from subroutine Semicolon. +# +# Our first interpreter cannot recognize whole words. We provide special +# commands to start a definition or compile or execute a word. The input +# stream is binary. This binary interpreter (bi) transmits most bytes (all +# but 99) unchanged. A command begins with byte 99. After 99 is a 1-byte +# argument indicating which command is issued. If the command indicates a +# definition, the argument also encodes the length of the word's name, and +# the name of the word is given in full. If the command is to execute or +# compile the word, only the first character of the name is provided, encoded +# in the argument. +# +# MACHINE CODE ########## INTENTION ############ 78 INSTRUCTION ####### OPCODE ######## ModR/M #### SIB ###### +BE B2 00 40 00 #:rsi(input) = 004000__ mov r32, imm32 B8+rd id +BF 30 00 00 10 # rdi(output) = 10000030 mov r32, imm32 B8+rd id + +######################### binary interpreter >>> 82 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +E8 02 00 00 00 #+call (bi) call rel32 +EB F9 #-jump bi 89 jmp rel8 EB cb +# # # # # # # # # # # # # (bi) 89 +AC # al = [rsi++] lods m8 AC +3C 99 # cmp al, 99(command) cmp al, imm8 3C ib +74 02 #+jump _command if == 8E je rel8 74 cb +AA # [rdi++] = al (xmit) stos m8 AA +C3 # return ret C3 +# _command: # 90 +BA 28 00 00 10 # rdx = Latest mov r32, imm32 B8+rd id +AC # al = [rsi++] (argument) lods m8 AC +A8 60 # al & 60(graphic)? test al, imm8 A8 ib +74 31 #+jump Head if zero 9A jz rel8 74 cb +48 8B 1A # rbx = [rdx] mov r64, r/m64 REX.W 8B /r 00 011 010 +# _find1: # 9D +50 # push al push r64 50+rd +24 7F # al &= 7F and al, imm8 24 ib +3A 43 11 # cmp al, [rbx+11] cmp r8, r/m8 REX 3A /r 01 000 011 +58 # pop al pop r64 58+rd +74 06 #+jump _match if == A6 je rel8 74 cb +48 8B 5B 08 # rbx = [rbx+8] mov r64, r/m64 REX.W 8B /r 01 011 011 +EB F1 #-jump _find1 AC jmp rel8 EB cb +# _match: # AC +A8 80 # al & 80(exec) ? test al, imm8 A8 ib +74 09 #+jump COMPL if zero B0 jz rel8 74 cb +FF 23 # jump [rbx] (exec) B2 jmp r/m64 REX FF /4 00 100 011 + +######################### Interpreter subroutines ################################################ + +99 05 43 4F 4D 50 4C #### COMPL Forth's COMPILE, B9 ( ebx=xt -- ) +B0 FF AA # compile >>>>>>>>>>>>>>>>> call r/m64 FF /2 00 010 100 00 100 101 +B0 14 AA # al = _ mov r8, imm8 B0+rb ib +B0 25 AA # [rdi++] = al stos m8 AA +93 # eax = ebx xchg eax, r32 90+rd +AB # [rdi(++4)] = eax stos m32 AB +C3 # return ret C3 + +99 04 48 65 61 64 ####### Head ================= CB ( al=flag rdx=Latest rsi=addr -- rdx=Latest rsi=addr' ) +48 83 C7 0F # rdi += 0F add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +48 83 E7 F0 # rdi &= F0 and r/m64, imm8 REX.W 83 /4 ib 11 100 111 +48 8B 0A # rcx = [rdx] mov r64, r/m64 REX.W 8B /r 00 001 010 +48 89 4F 08 # [rdi+8] = rcx mov r/m64, r64 REX.W 89 /r 01 001 111 +48 89 3A # [rdx] = rdi mov r/m64, r64 REX.W 89 /r 00 111 010 +48 83 C7 10 # rdi += 10 add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +AA # [rdi++] = al stos m8 AA +91 # ecx = eax xchg eax, r32 90+rd +83 E1 1F # ecx &= 1F and r/m32, imm8 83 /4 ib 11 100 001 +F3 A4 # copy Name rep movs m8, m8 F3 A4 +48 8B 0A # rcx = [rdx] mov r64, r/m64 REX.W 8B /r 00 001 010 +48 89 39 # [rcx] = rdi mov r/m64, r64 REX.W 89 /r 00 111 001 +C3 # return ret C3 + +# ============= DICTIONARY FORMAT +# +# Each SmithForth dictionary entry begins with: +# (8 bytes) Code +# (8 bytes) Link +# (1 byte) Flag (3 bits) and Length (5 bits) of Name +# (Length bytes) Name, where Length < 2^5. +# Each subroutine call refers to its callee. See argument ZZ in the following example: +# +# WW WW WW WW WW WW WW WW # Code: address of a subroutine (usually right after Name) +# XX XX XX XX XX XX XX XX # Link: address of the next earlier dictionary entry +# YY # Flag: 80=IMMEDIATE, 40=HIDDEN ; Name Length +# 2E 53 # Name: .S ( -- ) show the values on the data stack +# 4D 89 7F F8 # [r15-8] = r15 (obuf) mov r/m64, r64 REX.W 89 /r 01 111 111 +# 49 C7 47 F0 00 00 00 10 # [r15-10] = 10000000 (len) mov r/m64, imm32 REX.W C7 /0 id 01 000 111 +# 4D 29 7F F0 # [r15-10] -= r15 sub r/m64, r64 REX.W 29 /r 01 111 111 +# 49 83 EF 10 # r15 -= 2 cells sub r/m64, imm8 REX.W 83 /5 ib 11 101 111 +# FF 14 25 ZZ ZZ ZZ ZZ # call TYPE call r/m64 FF /2 00 010 100 00 100 101 +# C3 # return ret C3 + +99 03 42 59 45 ########## BYE ( -- ) ============================================================= +6A 3C 58 # rax = exit (no return) push imm8; pop 6A ib ; 58+rd +31 FF # rdi = stat xor r/m32, r32 31 /r 11 111 111 +0F 05 # syscall syscall 0F 05 + +# 99 C2 # BYE + +# Linux syscall: ( RDI RSI RDX R10 R8 R9 RAX=syscall# -- RAX=stat RCX=? R11=? ) +# Manual pages on system calls: `man 2 syscalls ; man 2 exit ; man 2 read ; man 2 write ; man 2 mmap` +# syscall numbers: /usr/include/x86_64-linux-gnu/asm/unistd_64.h +# syscall error numbers: /usr/include/asm-generic/errno-base.h +# mmap flag values: /usr/include/asm-generic/mman-common.h + +99 04 54 59 50 45 ####### TYPE ( rsi=addr rdx=u -- rsi=? rdi=? ) show memory [addr, addr+u) ====== +6A 01 5F # rdi(fd) = stdout = 1 push imm8; pop 6A ib ; 58+rd +# _beg: # 00 +8B C7 # rax = write = 1 = rdi mov r32, r/m32 8B /r 11 000 111 +0F 05 # syscall syscall 0F 05 +48 85 C0 # cmp rax, 0 test r/m64, r64 REX.W 85 /r 11 000 000 +7C 08 #+jump _end if < 09 jl rel8 7C cb +48 01 C6 # rsi(buf) += rax add r/m64, r64 REX.W 01 /r 11 000 110 +48 29 C2 # rdx(cnt) -= rax sub r/m64, r64 REX.W 29 /r 11 000 010 +7F EF #-jump _beg if > 11 jg rel8 7F cb +# _end: # 11 +C3 # return ret C3 + +# ============= DEBUGGING +# +# During development, a program like this one may crash with an uninformative error message like +# "Segmentation fault" or "Illegal instruction." How can we work in such an environment? +# We start with a trivial program that works (i.e., simply invokes syscall exit, as in BYE), +# and then expand it gradually until it does what we want. When a program breaks after a small +# change, we know where the bug is. Here is one way to go. +# +# Insert a jump to BYE at the top of the program. You have to compute the length of the jump. +# After this chore, updating it is easy if you expand the program only one instruction at a time. +# You will want to disable and enable parts of the program as you expand it. The most basic ways: +# -- Hide unwanted code in comments. If this disrupts byte counts, replace lost bytes by no-op +# instructions NOP = 90. +# -- Inside a subroutine, leave early by inserting a return instruction RET = C3. + +99 03 64 62 67 ########## dbg ( -- ) show stack and data; use `./SForth | xxd -o 0x0fffffe0` ===== +56 57 # push rsi, rdi push r64 50+rd +BE E0 FF FF 0F # rsi = addr mov r32, imm32 B8+rd id +BA 00 0A 00 00 # rdx = u mov r32, imm32 B8+rd id +99 54 # Call TYPE +5F 5E # pop rdi, rsi pop r64 58+rd +C3 # return ret C3 + +# 99 E4 99 C2 # dbg BYE + +99 03 72 65 67 ########## reg ( -- ) show registers; use `./SForth | xxd` ======================== +56 57 # push rsi, rdi push r64 50+rd +41 57 57 41 56 56 # push r15, rdi, r14, rsi push r64 REX 50+rd +41 55 55 41 54 54 # push r13, rbp, r12, rsp push r64 REX 50+rd +41 53 53 41 52 52 # push r11, rbx, r10, rdx push r64 REX 50+rd +41 51 51 41 50 50 # push r9 , rcx, r8 , rax push r64 REX 50+rd +48 8B F4 # rsi = rsp mov r64, r/m64 REX.W 8B /r 11 110 100 +BA 80 00 00 00 # rdx = u mov r32, imm32 B8+rd id +99 54 # Call TYPE +48 83 EC 80 # rsp -= -80 sub r/m64, imm8 REX.W 83 /5 ib 11 101 100 +5F 5E # pop rdi, rsi pop r64 58+rd +C3 # return ret C3 + +# 99 F2 99 C2 # reg BYE + +# ============= TEXT INTERPRETER +# +# Standard Forth handles input one line at a time. +# SmithForth's text interpreter is a simple interpreter in the standard Forth style. +# SVAL (see standard Forth's EVALUATE) interprets each line. +# REFILL fetches a line of input, including its trailing LF, and sets the input source state. +# 10000000 #IN cell contains #characters in the current line. +# 10000008 TIB cell contains the address where the current line begins. +# 10000010 >IN cell contains #characters in the current line that have been parsed. +# 10000020 STATE cell contains 0(Interpreting) or 1(Compiling). +# 10000028 Latest cell contains the execution token (xt) of the latest defined Forth word. +# In Forth, to parse is to remove from the input stream. As a line is parsed, [>IN] increases from 0 to [#IN]. +# Forth's "parse area" is the part of the line not yet parsed. + +99 06 52 45 46 49 4C 4C # REFILL ( -- ) ========================================================== +49 C7 C1 00 00 00 10 # r9 = VAR mov r/m64, imm32 REX.W C7 /0 id 11 000 001 +49 8B 01 # rax = [#IN] mov r64, r/m64 REX.W 8B /r 00 000 001 +49 01 41 08 # [TIB] += rax add r/m64, r64 REX.W 01 /r 01 000 001 +49 83 21 00 # [#IN] = 0 and r/m64, imm8 REX.W 83 /4 ib 00 100 001 +49 83 61 10 00 # [>IN] = 0 and r/m64, imm8 REX.W 83 /4 ib 01 100 001 +# _beg: # 00 +49 FF 01 # [#IN]++ inc r/m64 REX.W FF /0 00 000 001 +49 8B 41 08 # rax = [TIB] mov r64, r/m64 REX.W 8B /r 01 000 001 +49 03 01 # rax += [#IN] add r64, r/m64 REX.W 03 /r 00 000 001 +80 78 FF 0A # cmp [rax-1], LF cmp r/m8, imm8 80 /7 ib 01 111 000 +75 F0 #-jump _beg if != 10 jne rel8 75 cb +C3 # return ret C3 + +99 04 73 65 65 6B ####### seek ( cl dl "ccc" -- eflags ) parse until 1st char of parse area is within [cl, dl) or parse area is empty +49 C7 C1 00 00 00 10 # r9 = VAR mov r/m64, imm32 REX.W C7 /0 id 11 000 001 +2A D1 # dl -= cl sub r8, r/m8 2A /r 11 010 001 +# _beg: # 00 like WITHIN ( al cl dl -- eflags ) +49 8B 41 10 # rax = [>IN] mov r64, r/m64 REX.W 8B /r 01 000 001 +49 3B 01 # cmp rax, [#IN] cmp r64, r/m64 REX.W 3B /r 00 000 001 +73 16 #+jump _end if U>= 09 jae rel8 73 cb +49 8B 41 08 # rax = [TIB] mov r64, r/m64 REX.W 8B /r 01 000 001 +49 03 41 10 # rax += [>IN] add r64, r/m64 REX.W 03 /r 01 000 001 +8A 00 # al = [rax] mov r8, r/m8 8A /r 00 000 000 +2A C1 # al -= cl sub r8, r/m8 2A /r 11 000 001 +3A C2 # cmp al, dl cmp r8, r/m8 3A /r 11 000 010 +72 06 #+jump _end if U< 19 jb rel8 72 cb +49 FF 41 10 # [>IN]++ inc r/m64 REX.W FF /0 01 000 001 +EB E1 #-jump _beg 1F jmp rel8 EB cb +# _end: # 1F +C3 # return ret C3 + +99 05 50 41 52 53 45 #### PARSE ( cl dl "ccc" -- rbp=addr rax=u ) addr: where ccc begins ; u: length of ccc +49 C7 C1 00 00 00 10 # r9 = VAR mov r/m64, imm32 REX.W C7 /0 id 11 000 001 +49 8B 69 10 # rbp = [>IN] mov r64, r/m64 REX.W 8B /r 01 101 001 +99 73 # Call seek parse until 1st instance within [cl, dl) is parsed or parse area empty +49 8B 41 10 # rax = [>IN] mov r64, r/m64 REX.W 8B /r 01 000 001 +73 04 #+jump _end if U>= 00 jae rel8 73 cb +49 FF 41 10 # [>IN]++ inc r/m64 REX.W FF /0 01 000 001 +# _end: # 04 +48 29 E8 # rax -= rbp sub r/m64, r64 REX.W 29 /r 11 101 000 +49 03 69 08 # rbp += [TIB] add r64, r/m64 REX.W 03 /r 01 101 001 +C3 # return ret C3 + +99 05 70 6E 61 6D 65 #### pname ( "ccc" -- rbp=addr rax=u ) PARSE-NAME ============ +B1 21 B2 7F # (cl, dl) = (BL+1, ...) mov r8, imm8 B0+rb ib +99 73 # Call seek +B1 7F B2 21 # (cl, dl) = (..., BL+1) mov r8, imm8 B0+rb ib +99 50 # Call PARSE +C3 # return ret C3 + +99 81 5B ################ [ ( -- ) lbracket IMMEDIATE ============================================ +6A 00 # push 0(Interpreting) push imm8 6A ib +8F 04 25 20 00 00 10 # pop [STATE] pop r/m64 8F /0 00 000 100 00 100 101 +C3 # return ret C3 + +99 01 5D ################ ] ( -- ) rbracket ====================================================== +6A 01 # push 1(Compiling) push imm8 6A ib +8F 04 25 20 00 00 10 # pop [STATE] pop r/m64 8F /0 00 000 100 00 100 101 +C3 # return ret C3 + +99 81 5C ################ \ ( "ccc" -- ) backslash IMMEDIATE ================================ +48 8B 04 25 00 00 00 10 # rax = [#IN] mov r64, r/m64 REX.W 8B /r 00 000 100 00 100 101 +48 89 04 25 10 00 00 10 # [>IN] = rax mov r/m64, r64 REX.W 89 /r 00 000 100 00 100 101 +C3 # return ret C3 + +99 81 28 ################ ( ( "ccc" -- ) lparen IMMEDIATE ================================ +B1 29 B2 2A # (cl, dl) = (RP, RP+1) mov r8, imm8 B0+rb ib +99 50 # Call PARSE Forth 2012 implies comment ends at rparen or newline. +C3 # return ret C3 + +99 01 3A ################ : ( "ccc" -- ) colon ==================================== +99 70 # Call pname See Forth 2012 Table 2.1 +48 89 EE # rsi = rbp mov r/m64, r64 REX.W 89 /r 11 101 110 +BA 28 00 00 10 # rdx = Latest mov r32, imm32 B8+rd id +99 48 # Call Head +48 8B 0A # rcx = [rdx] mov r64, r/m64 REX.W 8B /r 00 001 010 +48 83 C1 10 # rcx += 10 add r/m64, imm8 REX.W 83 /0 ib 11 000 001 +80 09 40 # [rcx] |= 40(HIDDEN) or r/m8, imm8 80 /1 ib 00 001 001 +99 5D # Call ] +C3 # return ret C3 + +99 81 3B ################ ; ( C: -- ) semicolon IMMEDIATE ======================================== +B0 C3 # al = opcode ret mov r8, imm8 B0+rb ib +AA # [rdi++] = al stos m8 AA +48 8B 0C 25 28 00 00 10 # rcx = [Latest] mov r64, r/m64 REX.W 8B /r 00 001 100 00 100 101 +48 83 C1 10 # rcx += 10 add r/m64, imm8 REX.W 83 /0 ib 11 000 001 +80 21 BF # [rcx] &= BF(~HIDDEN) and r/m8, imm8 80 /4 ib 00 100 001 +99 5B # Call [ +C3 # return ret C3 + +99 01 2E ################ . ( char -- ) nonstandard name for C, ================================== +41 8A 07 # al = [r15] mov r8, r/m8 REX 8A /r 00 000 111 +49 83 C7 08 # r15 += 8 add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +AA # [rdi++] = al stos m8 AA +C3 # return ret C3 + +99 83 4C 49 54 ########## LIT ( C: x -- ) ( -- x ) IMMEDIATE ===================================== TODO compare xchg r15, rsp ; push imm8 ; xchg r15, rsp +B8 49 83 EF 08 AB # compile r15 -= 8 sub r/m64, imm8 REX.W 83 /5 ib 11 101 111 +B8 6A 41 8F 07 AA # eax = push x ; pop [r15] push i8 ; pop r/m64 6A ib;REX 8F /0 00 000 111 +41 8A 07 AB # al = [r15] ; compile mov r8, r/m8 REX 8A /r 00 000 111 +49 83 C7 08 # r15 += 8 add r/m64, imm8 REX.W 83 /0 ib 11 000 111 +C3 # return ret C3 + +99 03 78 74 3D ########## xt= ( rbp=addr rax=u rbx=xt -- rbx=xt rax=? rdi=? eflags ) rbx == 0 or unhidden and matches +48 85 DB # rbx(xt) ? test r/m64, r64 REX.W 85 /r 11 011 011 +75 01 #+jump _nonzero if != 0 jnz rel8 75 cb +C3 # return ret C3 +# _nonzero: # +48 8B C8 # rcx = rax(u) mov r64, r/m64 REX.W 8B /r 11 001 000 +48 8D 73 10 # rsi = rbx(xt) + 10 lea r64, m REX.W 8D /r 01 110 011 +AC # al = [rsi++] lods m8 AC +A8 40 # al & 40(HIDDEN) ? test al, imm8 A8 ib +74 01 #+jump _unhidden if == 0 jz rel8 74 cb +C3 # return ret C3 +# _unhidden: # +48 83 E0 1F # rax &= 1F(Length) and r/m64, imm8 REX.W 83 /4 ib 11 100 000 +48 39 C8 # cmp rax, rcx cmp r/m64, r64 REX.W 39 /r 11 001 000 +74 01 #+jump _lengthEq if == je rel8 74 cb +C3 # return ret C3 +# _lengthEq: # +48 8B FD # rdi = rbp mov r64, r/m64 REX.W 8B /r 11 111 101 +F3 A6 # strings equal ? repe cmps m8, m8 F3 A6 +C3 # return ret C3 + +99 04 46 49 4E 44 ####### FIND ( rbp=addr rax=u -- rbp=addr rax=u rbx=xt ) xt==0 if not found ==== +48 8B 1C 25 28 00 00 10 # rbx = [Latest] mov r64, r/m64 REX.W 8B /r 00 011 100 00 100 101 +# _beg: # +E8 03 00 00 00 #+call (FIND) call rel32 E8 cd +75 F9 #-jump _beg if != jne rel8 75 cb +C3 # return ret C3 +# # # # # # # # # # # # # (FIND) +50 57 # push rax, rdi push r64 50+rd +99 78 # Call xt= +5F 58 # pop rdi, rax pop r64 58+rd +74 04 #+jump _end if == je rel8 74 cb +48 8B 5B 08 # rbx = [rbx+8] mov r64, r/m64 REX.W 8B /r 01 011 011 +# _end: # +C3 # return ret C3 + +99 03 4E 75 6D ########## Num ( rbp=addr rax=u -- n ) ============================================ +49 83 EF 08 # r15 -= 8 sub r/m64, imm8 REX.W 83 /5 ib 11 101 111 +49 83 27 00 # [r15] = 0 and r/m64, imm8 REX.W 83 /4 ib 00 100 111 +48 89 C1 # rcx = rax mov r/m64, r64 REX.W 89 /r 11 000 001 +48 8B F5 # rsi = rbp mov r64, r/m64 REX.W 8B /r 11 110 101 +# _beg: # +E8 03 00 00 00 #+call (Num) call rel32 E8 cd +E2 F9 #-jump beg if --rcx loop rel8 E2 cb +C3 # return ret C3 +# # # # # # # # # # # # # (Num) +AC # al = [rsi++] lods m8 AC +3C 41 # cmp al, 'A' cmp al, imm8 3C ib +7C 02 #+jump _digit if < jl rel8 7C cb +# _letter: # +2C 07 # al -= 7 sub al, imm8 2C ib +# _digit: # +2C 30 # al -= 30 sub al, imm8 2C ib +49 C1 27 04 # [r15] <<= 4 sal r/m64, imm8 REX.W C1 /4 ib 00 100 111 +49 09 07 # [r15] |= rax or r/m64, r64 REX.W 09 /r 00 000 111 +C3 # return ret C3 + +99 04 6D 69 73 73 ####### miss ( rbp=addr rax=u rbx=xt -- |n rbx=xt ) n present iff u nonzero ==== +48 85 DB # rbx(xt) ? test r/m64, r64 REX.W 85 /r 11 011 011 +74 01 #+jump (miss) if == 0 jz rel8 74 cb +C3 # return ret C3 +# # # # # # # # # # # # # (miss) +48 85 C0 # rax(u) ? test r/m64, r64 REX.W 85 /r 11 000 000 +75 01 #+jump _nonempty if != jne rel8 75 cb +C3 # return ret C3 +# _nonempty: # +99 4E # Call Num +F6 04 25 20 00 00 10 01 # [STATE] ? test r/m8, imm8 F6 /0 ib 00 000 100 00 100 101 +75 01 #+jump _lit if != 0 jnz rel8 75 cb +C3 # return ret C3 +# _lit: # +99 4C # Call LIT +C3 # return ret C3 + +99 04 45 58 45 43 ####### EXEC ( rbx=xt -- ) ===================================================== +B9 F8 FF FF 7F # rcx = _ mov r32, imm32 B8+rd id +57 # push rdi push r64 50+rd +89 CF # rdi = rcx mov r/m32, r32 89 /r 11 001 111 +99 43 # Call COMPL +B0 C3 # al = C3 mov r8, imm8 B0+rb ib +AA # [rdi++] = al stos m8 AA +5F # pop rdi pop r64 58+rd +FF D1 # call rcx call r/m64 FF /2 11 010 001 +C3 # return ret C3 + +99 04 65 78 65 63 ####### exec ( al rbx=xt -- ) iff al != 1 ====================================== +3C 01 # cmp al, 1 cmp al, imm8 3C ib +75 01 #+jump (exec) if != jne rel8 75 cb +C3 # return ret C3 +# # # # # # # # # # # # # (exec) +99 45 # Call EXEC +C3 # return ret C3 + +99 05 63 6F 6D 70 6C #### compl ( al -- al ) iff al == 1 ========================================== +3C 01 # cmp al, 1 cmp al, imm8 3C ib +74 01 #+jump (compl) if == je rel8 74 cb +C3 # return ret C3 +# # # # # # # # # # # # # (compl) +99 43 # Call COMPL +B0 01 # al = 1 mov r8, imm8 B0+rb ib +C3 # return ret C3 + +99 03 68 69 74 ########## hit ( rbx=xt -- ) ====================================================== +48 85 DB # rbx(xt) ? test r/m64, r64 REX.W 85 /r 11 011 011 +75 01 #+jump (hit) if != 0 jnz rel8 75 cb +C3 # return ret C3 +# # # # # # # # # # # # # (hit) +40 8A 43 10 # al = [rbx+10] mov r8, r/m8 REX 8A /r 01 000 011 +24 80 # al &= 80(IMMEDIATE) and al, imm8 24 ib +0A 04 25 20 00 00 10 # al |= [STATE] or r8, r/m8 0A /r 00 000 100 00 100 101 +99 63 # Call compl +99 65 # Call exec +C3 # return ret C3 + +99 04 53 56 41 4C ####### SVAL ( i*x -- j*x ) == 00 EVALUATE ===================================== +E8 03 00 00 00 #+call (SVAL) 05 call rel32 E8 cd +7C F9 #-jump SVAL if < 07 jl rel8 7C cb +C3 # return ret C3 +# # # # # # # # # # # # # (SVAL) 08 +99 70 # Call pname +99 46 # Call FIND +99 6D # Call miss +99 68 # Call hit +48 8B 04 25 10 00 00 10 # rax = [>IN] mov r64, r/m64 REX.W 8B /r 00 000 100 00 100 101 +48 3B 04 25 00 00 00 10 # cmp rax, [#IN] cmp r64, r/m64 REX.W 3B /r 00 000 100 00 100 101 +C3 # return ret C3 + +99 02 74 69 ############# ti ( -- ) text interpreter ============================================= +49 C7 C7 00 00 00 10 # r15(stack) = 10000000 mov r/m64, imm32 REX.W C7 /0 id 11 000 111 +49 89 77 08 # [TIB] = rsi mov r/m64, r64 REX.W 89 /r 01 110 111 +99 5B # Call [ +# _beg: # +E8 02 00 00 00 #+call (ti) call rel32 E8 cd +EB F9 #-jump _beg jmp rel8 EB cb +# # # # # # # # # # # # # (ti) +99 52 # Call REFILL +99 53 # Call SVAL +C3 # return ret C3 + +# 99 E4 99 C2 # dbg BYE + +99 F4 # ti diff --git a/SmithForth.html b/SmithForth.html new file mode 100644 index 0000000..b3ff470 --- /dev/null +++ b/SmithForth.html @@ -0,0 +1,382 @@ + + + + +SmithForth + + + +

A Forth for x86-64 personal computers

+ +

+

David Smith 2022 david.a.c.v.smith@gmail.com
+

+ +

+

    +
  • SmithForth runs on Linux x86-64 systems.
    • +
  • I believe some other Unix x86-64 systems can run Linux ELF binaries. SmithForth should run on these.
    • +
  • SmithForth should run on your Windows system if you have installed the Windows Subsystem for Linux. I haven't tried it.
    • +
+

+ +

SmithForth design

+ +

+SmithForth is an implementation of the Forth programming language for x86-64 desktop computers. +SmithForth is a text interpreter that runs in a Linux text console. +

+ +

+You can use SmithForth as you would use any other standard Forth system. +SmithForth follows the the Forth standard of 2012. +The Forth standard describes some optional word sets concerning features like floating-point arithmetic and dynamic memory allocation that most programmers today would regard as standard, but the Forth community considers optional, perhaps because Forth runs on modest machines like microcontrollers. +SmithForth does not yet have floating-point arithmetic, local variables, or file access. +

+ +

+When I consider using a programming environment, I expect it to work on my hardware, and I expect it to be concrete and simple as possible. +Good luck finding tools that meet this standard. +So I wrote SmithForth. +Please take a look at the source code and the comments. +SmithForth is implemented in the subroutine-threaded style, which I think is the most straightforward way. +The Intel manual is our source of information on the x86 architecture. +

+ +

+We use none of the usual tools from the world of C, not even an assembler. +SmithForth is implemented in two source files: +

    +
  1. SForth.dmp contains a primitive Forth system in 1000 hand-written bytes of annotated machine code.
    2. +
  2. system.fs contains 1000 lines of system Forth to complete a standard Forth system.
    3. +
+

+ +

How to run SmithForth

+ +
    + +
  1. +

    Combine SForth.dmp and system.fs into one binary file.

    +

    +Machine code is converted from a human-readable format "DMP" to binary by xxd +(hex dump) -r (reverse). +

    $ cut -d'#' -f1 SForth.dmp | xxd -p -r > SForth
+$ cat system.fs >> SForth
+
    +The Forth source text is grafted onto the binary. +

    +
    2. + +
  2. +

    Turn the binary file into a proper executable.

    +

    +Grant permission to execute the file on the Linux system. +

    $ chmod +x SForth
    +You should now have a working executable (if your system is similar enough to mine). +

    +

    +(Optional:) +Advanced users might edit the kernel or system.fs. +You must ensure that the ELF segment header entry p_filesz contains the number of bytes of the segment that appear in binary file SForth. +In my design, that's the whole file, including ELF header, machine code, and system Forth. +We prefer not to count those bytes by hand. +An easy solution is: +

      +
    1. Make the binary as above. Don't run the binary yet.
      2. +
    2. Ask the system for the size of the binary file.
      3. +
    3. Write the result into field p_filesz of dmqc.dmp.
      4. +
    4. Remake the binary. The binary is ready to run.
      5. +
    +

    +

    +My script make.sh does these steps automatically: +

    $ ./make.sh # if and only if you modified SForth.dmp or system.fs
    +

    +
    3. + +
  3. +

    Run the SmithForth executable.

    +

    +You can use SmithForth interactively, or you can feed your program into the standard input stream. +

    $ ./SForth
+$ ./SForth < YourProgram.fs
+$ cat YourProgram.fs - | ./SForth
+
    +The last command allows you to use SmithForth interactively after your programs. +

    + +
+ +
+

Numbers in machines

+ +If you aren't an experienced programmer, here are some things to know before you read the DMP source file. + +

Hexadecimal

+Numbers in machine-code listings are often written in hexadecimal, +the base-sixteen number system with numerals 0123456789ABCDEF. In +hexadecimal, the nonnegative integers are: +
+0, 1, 2, ..., 9, A, B, C, D, E, F, 10, 11, ..., 1F, 20, ..., FF, 100, 101, ... +
+ +

Bytes

+A byte is eight bits. The eight bits of a byte have 28 different states, +but our alphabet has fewer symbols. Instead we write these +states in base sixteen (=24) using a pair of hexadecimal numerals. The +states of a byte are: +
+ 00, 01, 02, ..., FE, FF. +
+ +

Binary

+Sometimes we need to convert hexadecimal numbers to and from binary (base 2). +Conveniently, one base is the fourth power of the other, and the conversion +can be done in one-to-four fashion, repeatedly, independently. For example: +
+ 3E hexadecimal = 0011 1110 binary, +
+as 3 = 0011 and E = 1110. +You may see bits of a binary number grouped in various ways. For example, +x86 instruction "sub r/m32, r32" has a ModR/M byte written: +
+ 11 111 000. +
+Bits 11 select an access mode for argument r/m32, and bits 000 select +register EAX for that argument. The middle three bits 111 select +register EDI. To convert this into hexadecimal, we regroup the eight bits: +
+ 1111 1000 binary = F8 hexadecimal (as 1111 = F and 1000 = 8). +
+ +

Endianness

+In hexadecimal, and in our usual decimal system, numbers with more than one +numeral are written with more significant numerals first: +
    +
  • Decimal has hundreds before tens before ones.
    • +
  • Hexadecimal has two hundred fifty-sixes before sixteens before ones.
    • +
+Such systems are big-endian. Little-endian is the reverse order, with +less significant numerals first. + +

The little-endian x86

+

+The x86 architecture is little-endian in bytes (that is, little-endian in base 28) ... +

+When an integer is moved from a CPU register into memory, for example, the +least significant byte appears first in memory. +
+... but each byte is written as a big-endian pair of hexadecimal numerals. +This custom is observed: +
    +
  • in Intel's manuals,
    • +
  • in the output of tools (like xxd) that convert binary files to text, and
    • +
  • in the input of tools that convert text (like our DMP file) to binary files.
    • +
+For example, +
    +
  • hexadecimal 12 is eighteen,
    • +
  • hexadecimal 12 00 is eighteen (= 0012 big-endian), and
    • +
  • hexadecimal 12 00 00 00 is eighteen (= 00000012 big-endian).
    • +
+ +

Machine arithmetic is modular

+

There are infinitely many integers, but digital machines have finitely many states. +Integers processed by the Arithmetic Logic Unit (ALU) of the machine are more aptly +called congruence classes, as the ALU performs modular arithmetic for addition, +subtraction, and multiplication, where the modulus of the congruence relation is a +power of 2, like 28. However, some operations involve a particular representative +of a congruence class. +

+ +

+Two rules are commonly used to select a representative. They are: +

    +
  1. unsigned, where the representatives are +
    + 0, 1, 2, ..., modulus - 1, and +
    2. +
  2. signed, where the representatives are +
    + 0, 1, ..., modulus/2 - 1, (nonnegative) and +
    +
    + -1, -2, ..., modulus/2 (negative); +
    + but the machine has no "minus sign," so instead we use +
    + modulus - 1, modulus - 2, ..., modulus/2 (negative). +
    3. +
+

+ +

+For example, if the modulus is 28, the signed representatives are +

+ 00, 01, ..., 7F, (nonnegative) + FF, FE, ..., 80 (negative). +
+We can tell negative from nonnegative by the most significant bit. +
    +
  • Nonnegatives have most significant bit 0.
    • +
  • Negatives have most significant bit 1.
    • +
+Watch for "unsigned" and "signed" in the Intel manual. +

+ +

Implementing Forth

+If you aren't an experienced Forth programmer, here are some things to know before you read the Forth system file. + +

Conditionals

+

+Compiling in Forth is simple. The compiler sees a word W, looks it up in the dictionary, +and appends to the body of the current dictionary entry a CALL instruction. The target of +the CALL is the address of the body of the dictionary entry of word W. +

+ +

CALL facilitates the use of subroutines, which normally return control to the point in the instruction +stream where CALL occurred. There are other forms of flow control, mainly conditionals +and loops. +

: X ... flag IF  ...  ( do this if flag is nonzero )  ...  THEN ... ;
+              \                                               /
+               -->-- ( skip to THEN if flag is zero ) ---->---
+
+

+ +

+Forth has words IF and THEN for conditional execution. They are used in compilation mode. +Normally IF is paired with an instance of THEN later in a word definition. +When the interpreter reaches IF at run time, it examines the number at the top of the stack. +If the number is nonzero, execution continues past IF. +If the number is zero, execution jumps past THEN. +

+ +

+The microprocessor has flow-control features including jumps and conditional jumps. +The Forth compiler, when it sees IF, might emit a conditional jump. +A likely instruction of this kind in x86 is JZ, jump if zero. JZ has a parameter that +indicates where to jump to, past THEN in this case. However, when the compiler +first sees IF, it has not yet seen any THEN. So the plan is: +

    +
  1. Upon IF, reserve space in the compiler's output for instruction JZ and produce (push) a reference.
    2. +
  2. Continue compiling as usual.
    3. +
  3. Upon THEN, consume (pop) a reference and finish formulating instruction JZ. +In the Forth standard, this is resolving a forward reference. +
    4. +
+

+ +

+Forth implements this plan by using the data stack during compilation: +

    +
  • IF ( flag -- ) Compilation: ( -- orig ) ... ;
    • +
  • THEN ( -- ) Compilation: ( orig -- ) ... ;
    • +
+Stack-effect comments like ( bef -- aft ) describe the end of the stack before and after the word is executed. +The LIFO property of the stack allows IF-THEN statements to be nested. +

+ +

Loops

+

+Forth offers several ways to write loops. +One is BEGIN-WHILE-REPEAT. +

              --------------------------------<---------------------------
+             /                                                            \
+: X ... BEGIN ... flag WHILE  ...  ( do this if flag is nonzero )  ...  REPEAT ... ;
+                         \                                                   /
+                          --->-- ( skip to REPEAT if flag is zero ) ---->----
+
+
    +
  • BEGIN ( -- ) Compilation: ( -- dest ) ... ;
    • +
  • WHILE ( flag -- ) Compilation: ( dest -- orig dest ) ... ;
    • +
  • REPEAT ( -- ) Compilation: ( orig dest -- )
    • +
+BEGIN-WHILE-REPEAT is versatile, allowing to exit from the middle of a loop body. +BEGIN-WHILE-REPEAT can emulate other control structures: +
+
IF-THEN:
flag BEGIN WHILE ... 0 REPEAT
+
IF-ELSE-THEN:
flag DUP BEGIN WHILE DROP ... 1 0 REPEAT 0= BEGIN WHILE ... 0 REPEAT
+
BEGIN-UNTIL:
BEGIN ... flag 0= WHILE REPEAT
+
+

+ +
+ +

Simpler software

+

+Here are my opinions and motivations for this project. +Forth is a simple programming language that achieved some fame back when personal computers were young. +What else would run on such modest computers? +Nowadays computers and languages are fancy and complex. +I say Forth is still a good choice. Forth is simple enough that we may reason about it and understand it. +Forth provides: +

    +
  • features found in most programming languages: +
      +
    • conditionals (if-else)
      • +
    • loops
      • +
    • variables
      • +
    • user-defined functions
      • +
    +
    • +
  • and more: +
      +
    • CREATE
      • +
    • DOES>
      • +
    +
    • +
+

+ +

+A good system helps us to solve our problems quickly. +Some systems try to be comprehensive. + + +Others keep it simple. +SmithForth is small and flat enough that a programmer can understand it all. +SmithForth has only a couple files. +We use none of the usual tools from the world of C. +You might argue that C makes programming simpler by insulating us from the workings of the machine. +I might agree if: +

    +
  • in our daily work, we are allowed to focus on a small number of layers, and
    • +
  • each layer is well documented,
    • +
+but this has not been my experience. +C is intentionally vague about the dimensions of machines -- an irritation the programmer -- so that programs are portable -- a feature I never use. +There is always one kind of machine available, usually x86. +The Intel architecture is fairly well documented, and although the Intel manual is huge, we can find the few parts we need. +For an introduction to x86 machine-language programming (without Forth), please see +my video series on that topic. +

+ +

+I can imagine a system that contains its own documentation and C source code and tailors these to the computer on which it is installed in such a way that the user can study them and be unconcerned with other computers. No one does this, as far as I know. +

+ +

+Forth has been implemented many times. +Some Forths have a small kernel so that the system can be ported easily to other architectures (by implementing only a small number of kernel words in machine code). +But if you want the system to run well, you have to write more machine code anyway, don't you? +My goal with SmithForth is not to stop writing machine code early, but to start writing Forth early. +In SmithForth, our early Forth contains a lot of machine code. +

+ +

+I believe SmithForth is a good first Forth to learn and a good first programming environment. +The shortened presentation may appeal to mathematicians. +

+ +

+If you want to know my ideas for the direction of this project, I would like to write extensions so that SmithForth becomes +fast and suitable for scientific computing; +and to add enough features of Lisp, Python, Awk, and Tcl that I wouldn't think to use those languages. +I would like to adapt it to other machines and make it usable without an underlying operating system like Linux. +

+ + + + \ No newline at end of file diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..0abb25e --- /dev/null +++ b/build.sh @@ -0,0 +1,5 @@ +#!/bin/sh + +cut -d'#' -f1 SForth.dmp | xxd -p -r > SForth +cat system.fs >> SForth +chmod +x SForth diff --git a/intel.pdf b/intel.pdf new file mode 100644 index 0000000..684526a Binary files /dev/null and b/intel.pdf differ diff --git a/system.fs b/system.fs new file mode 100644 index 0000000..2ec99f9 --- /dev/null +++ b/system.fs @@ -0,0 +1,905 @@ +\ David Smith 2022 david.a.c.v.smith@gmail.com http://dacvs.neocities.org/ +\ This is the 2nd of the 2 files that define SmithForth, a subroutine-threaded Forth for x86-64. +\ Read this file with the Intel manual in one hand and the Forth 2012 specification in the other. + +\ dbg BYE + +\ SmithForth is meant to be, in the language of the Forth 2012 standard, a: +\ Forth-2012 System +\ Providing the Core Extensions word set ( but SAVE-INPUT and RESTORE-INPUT are useless ) +\ Providing the Double-Number Extensions word set +\ Providing the Programming-Tools word set +\ Providing AHEAD BYE FORGET SEE STATE [DEFINED] [UNDEFINED] [IF] [ELSE] [THEN] from the Programming-Tools Extensions word set +\ Elements of Forth-2012 compliance: (see Forth 2012 5.1 system compliance and 4.1 system documentation) +\ 4.1.1 Implementation-defined options: +\ Aligned addresses: Every address is character-aligned. Every address is aligned. +\ EMIT on nongraphic characters: Sends them to syscall write just the same. In my usual environment (Ubuntu, Bash), the output is: +\ 0, 5, 7, 8, D-F: nothing +\ 1-4, 6, 10-19: a strange glyph +\ 9: a horizontal tab of 8 spaces +\ A-C: newline +\ ACCEPT : Character editing works as usual for Linux programs in plain old canonical terminal input mode. +\ Backspace works. Ctrl-D ends the input stream. Ctrl-C kills the process. Ctrl-Z suspends the process. +\ Character set: US-ASCII +\ Character-aligned address requirements: none +\ Character-set extensions matching characteristics: not offered +\ Conditions under which control characters match a space delimiter: +\ PARSE does not treat control characters as a space delimiter. +\ The following words do treat control characters as a space delimiter: +\ two parsing words from SForth.dmp: seek pname +\ and their applications: PARSE-NAME CREATE ' DEFER POSTPONE [COMPILE] CHAR FORGET [CHAR] ['] +\ MARKER VARIABLE BUFFER: CONSTANT 2CONSTANT VALUE 2VALUE TO +TO -TO SEE DEFER ACTION-OF IS +\ WORD and its applications: [DEFINED] [UNDEFINED] [ELSE] +\ Format of control-flow stack: The control-flow stack is the data stack. Each cell of the control-flow stack is one cell of the data stack. +\ Conversion of digits larger than thirty-five: No BASE beyond thirty-six is supported. There are no digits larger than thirty-five. +\ Display after input terminates in ACCEPT : ok occurs on a new line, the line after the input text. +\ Exception abort sequence: exceptions are not implemented. +\ Input line terminator: LF , the usual Linux line terminator +\ Maximum size of a counted string: see ENVIRONMENT? /COUNTED-STRING +\ Maximum size of a parsed string: two hundred fifty-five bytes. +\ Maximum size of a definition name, in characters: thirty-one. +\ Maximum string length: 2^(2^6) - 1. +\ Method of selecting user input device: there is only the standard input stream. +\ Method of selecting user output device: there is only the standard output stream. +\ Methods of dictionary compilation: +\ The dictionary is a sequence of entries. +\ Each entry consists of a header (see DICTIONARY FORMAT in file SForth.dmp) followed by an area for code and data. +\ First field of the header is the address of a subroutine (here subroutine is simply an address to call) associated with the entry. +\ Often the subroutine begins immediately after the header, but this is not required. +\ My dictionary entries customarily start at a multiple of sixteen, but this is not required. +\ Number of bits in one address unit: eight. +\ Ranges of number types: +\ -2^(2^6-1) <= n < +2^(2^6-1) +\ 0 <= +n < +2^(2^6-1) Note, +n implies n (see 3.1.1) +\ 0 <= u < +2^(2^6 ) +\ -2^(2^7-1) <= d < +2^(2^7-1) +\ 0 <= +d < +2^(2^7-1) Note, +d implies d (see 3.1.1) +\ 0 <= ud < +2^(2^7 ) +\ Read-only data-space regions: none. +\ Size of WORD buffer: see wbuf +\ Size of one cell in address units: eight. +\ Size of one character in address units: one. +\ Size of the keyboard terminal input buffer: see kbuf +\ Size of the pictured numeric output string buffer: see bufLen +\ Size of the PAD scratch area: see bufLen +\ System case-sensitivity characteristics: case-sensitive, except for the usual case-insensitive treatment of numerals ABC... abc... +\ System prompt: see QUIT +\ Type of division rounding: floored as in FM/MOD +\ Value of STATE when true: 1. +\ Values returned after arithmetic overflow: The usual values under two's complement arithmetic. +\ Whether the current definition can be found after compilation of DOES> : No. +\ Definitions of conditions below: +\ segfault: The Forth system halts and returns control to the Linux system with a Linux return code indicating a segmentation violation. +\ corruption: +\ The operation proceeds without warning. If the operation writes, then possibly something important is disturbed. +\ The system continues to run with unpredictable behavior, possibly normal behavior, segfault, or other fatal error. +\ 4.1.2 Ambiguous conditions: +\ A name is neither a valid definition name nor a valid number: a warning is issued. Stacks and other state are preserved. +\ Addressing a region not listed in 3.3.3 Data space: segfault +\ Argument type incompatible with specified input parameter: There is no data type checking. This is a two's complement system. +\ Attempting to obtain the execution token of a definition (by e.g. Tick or FIND) with undefined interpretation semantics +\ Dividing by zero: floating point exception, system halts with warning. +\ Insufficient data-stack space or return-stack space: segfault. +\ Insufficient space for loop-control parameters: segfault (these parameters are kept on the return stack) +\ Insufficient space in the dictionary: segfault. +\ Interpreting a word with undefined interpretation semantics: +\ For lbracket ( [ ), the effect is its execution semantics. +\ For semicolon ( ; ), the effect is its compilation semantics. +\ For return-stack words ( >R R@ R> 2>R 2R@ 2R> ), string words ( ." C" S" S\" ), control-flow words ( IF etc. ), and some others +\ ( ['] [COMPILE] [CHAR] ), the effect is to compile the word's execution semantics into the dictionary (at HERE). +\ If there are more such words, please remind me. See also the source code. +\ Modifying the contents of the input buffer or a string literal: corruption. +\ Overflow of a pictured numeric output string: corruption. +\ Parsed string overflow: corruption. +\ Producing a result out of range, e.g., multiplication (using *) results in a value too big to be represented by a single-cell integer: +\ numeric overflow warning is issued and system halts. +\ Reading from an empty data stack or return stack: reading an empty data stack shouldn't be a problem +\ (the data will be from the beginning of the data area), but subsequent writes will cause corruption. +\ Reading from an empty return stack should yield the address of the caller of the text interpreter. +\ If the stack pointer advances farther than that, segfault. +\ Unexpected end of input buffer, resulting in an attempt to use a zero-length string as a name: corruption. +\ >IN greater than size of input buffer: there is no range checking. Accesses past the end of the buffer entail corruption. +\ However, >IN is compared to #IN by >= rather than by = . If >IN strays from interval [ 0 , #IN ] , it may be restored ( see REFILL ) . +\ RECURSE appears after DOES> : RECURSE refers to the current word, the word whose definition includes DOES> , not to DOES> +\ Argument input source different than current input source for RESTORE-INPUT : there is only one input source. +\ Data space containing definitions is de-allocated: corruption (without ill effect until the space is rewritten) +\ Data space read/write with incorrect alignment: Impossible. Every address is aligned. +\ Data space pointer not properly aligned: Impossible. Every address is aligned. +\ Less than u+2 stack items on PICK or ROLL : PICK has no range checking. PICK will return whatever happens to be beyond the stack. +\ If PICK attempts to fetch a cell beyond the maximum stack size, segfault. ROLL is similar. +\ Loop-control parameters not available: There is no error checking. The value in the expected place on the return stack is used. +\ I J : These words succeed, leaving meaningless values on the data stack. +\ +LOOP LOOP UNLOOP LEAVE : corruption. +\ Most recent definition does not have a name on IMMEDIATE : IMMEDIATE works nonetheless. +\ TO not followed directly by a name defined by a word with "TO name runtime" semantics: corruption. +\ Name not found: corruption. An invalid xt is returned with value 0 and the system proceeds without warning. +\ Parameters not of the same type ( DO ?DO WITHIN ): The system is unaware of the program's desired type. +\ Each of these words produces the same results whether the type is signed or unsigned. +\ POSTPONE [COMPILE] ' ['] applied to TO : They work on TO as they do on other words. +\ String longer than a counted string returned by WORD : corruption. +\ u >= #bits in a cell on LSHIFT or RSHIFT : the operation proceeds as if u modulo sixty-four were provided instead of u +\ Word not defined via CREATE on >BODY or DOES> : +\ >BODY runs as usual (without warning), even though the resulting xt has no special meaning +\ DOES> in a word not defined via CREATE : corruption. +\ Words improperly used outside <# #> including # #S HOLD HOLDS SIGN : They write as usual without any warning. +\ Access to a DEFERred word which has yet to be assigned to an xt : corruption. +\ Access to a DEFERred word which was not defined by DEFER : corruption. +\ POSTPONE [COMPILE] ' ['] applied to ACTION-OF or IS : They work on ACTION-OF and on IS as they do on other words. +\ \x is not followed by two hex characters on S\" : a (garbage) character is added to the string. +\ \ is placed before a character not defined in S\" : a null (zero) character is added to the string. +\ +\ SmithForth offers no support yet for floating-point arithmetic, local variables, exceptions, dynamic memory allocation (like malloc), +\ or access to blocks or files, other than by the standard input and output streams of the Linux process, +\ which may be redirected from or to files in the usual Unix way. +\ +\ Environment of text interpreter (see SForth.dmp): +\ RSP: address of end cell of return stack. Return stack grows toward lesser addresses. +\ R15: address of end cell of data stack. Initially R15=10000000. Stack grows toward lesser addresses. +\ RDI: data space pointer ( HERE ) +\ Data space: +\ 10000000 Forth data space begins +\ 10000000 #IN contains the number of characters in the current input line (including trailing LF) +\ 10000008 TIB contains the address where the current input line begins. +\ 10000010 >IN contains the number of characters in the current input line parsed. +\ 10000018 source_id https://forth-standard.org/standard/core/SOURCE-ID +\ 10000020 STATE contains 0(Interpreting) or 1(Compiling). +\ 10000028 latest contains the address where the latest dictionary entry begins. See SForth.dmp for dictionary layout. +\ 10000030 Forth dictionary begins +\ 7FFFFFF8 reserved by EXEC +\ < 80000000 Forth data space ends, segment ends + +\ TODO Measure speed. We use many instructions that take an operand from memory and return the result to memory. This is somewhat slow. +\ Brad Rodriguez in Moving Forth Part 1 (https://www.bradrodriguez.com/papers/moving1.htm) discusses keeping stack cells in registers. + +\ Arithmetic, stack, etc. \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ +\ +\ Forth 2012: signed 2-cell integer is written d = ( lo hi ) ; unsigned 2-cell integer is written ud = ( lo hi ). Either: xd. + +: 1+ ( n|u -- n'|u' ) [ 49 . FF . 07 . ] ; \ [r15]++ inc r/m64 REX.W FF /0 00 000 111 OnePlus +: 1- ( n|u -- n'|u' ) [ 49 . FF . 0F . ] ; \ [r15]-- dec r/m64 REX.W FF /1 00 001 111 OneMinus +: 2* ( x -- x' ) [ 49 . D1 . 27 . ] ; \ [r15] <<= 1 sal r/m64, 1 REX.W D1 /4 00 100 111 TwoTimes +: 4* ( x -- x' ) [ 49 . C1 . 27 . 02 . ] ; \ [r15] <<= 2 sal r/m64, imm8 REX.W C1 /4 ib 00 100 111 +: 8* ( x -- x' ) [ 49 . C1 . 27 . 03 . ] ; \ [r15] <<= 3 sal r/m64, imm8 REX.W C1 /4 ib 00 100 111 +: 2/ ( x -- x' ) [ 49 . D1 . 3F . ] ; \ [r15] >>= 1 sar r/m64, 1 REX.W D1 /7 00 111 111 TwoDiv +: NEGATE ( n -- n' ) [ 49 . F7 . 1F . ] ; \ [r15] *= -1 neg r/m64 REX.W F7 /3 00 011 111 +: INVERT ( x -- x' ) [ 49 . F7 . 17 . ] ; \ [r15] ^= -1 not r/m64 REX.W F7 /2 00 010 111 +: ` ( u -- ) B0 . . \ al = u mov r8, imm8 B0+rb ib backtick + AA . ; \ [rdi++] = al stos m8 AA +: syscall ( -- ) [ 0F ` 05 ` ] ; \ syscall syscall 0F 05 +: += ( n -- ) [ 49 ` 83 ` C7 ` ] . ; \ r15 += n add r/m64, imm8 REX.W 83 /0 ib 11 000 111 PlusEquals +: ++= ( n -- ) [ 48 ` 83 ` C4 ` ] . ; \ rsp += n add r/m64, imm8 REX.W 83 /0 ib 11 000 100 PlusPlusEquals +: & ( u -- ) [ 41 . 8A . 07 . 8 += ] \ al = [r15] mov r8, r/m8 REX 8A /r 00 000 111 (adjust?) + [ 00 . 47 . FF . ] ; \ [rdi-1] += al add r/m8, r8 00 /r 01 000 111 +: UM/MOD ( ud u -- uRem uQuot ) [ 49 . 8B . 57 . 08 . ] \ rdx = [r15+8] mov r64, r/m64 REX.W 8B /r 01 010 111 + [ 49 . 8B . 47 . 10 . ] \ rax = [r15+10] mov r64, r/m64 REX.W 8B /r 01 000 111 + [ 49 . F7 . 37 . 8 += ] \ rdx:rax / [r15] div r/m64 REX.W F7 /6 00 110 111 + [ 49 . 89 . 57 . 08 . ] \ [r15+8] = rdx mov r/m64, r64 REX.W 89 /r 01 010 111 rdx=rem + [ 49 . 89 . 07 . ] ; \ [r15] = rax mov r/m64, r64 REX.W 89 /r 00 000 111 rax=quot +: 8/mod ( u -- rem quot ) 0 8 UM/MOD ; +: ^ ( n u -- ) 8/mod [ 49 ` ] 4* & [ 89 ` 47 ` ] 8* & . ; \ [r15+n] = rux mov r/m64, r64 REX.WuB 89 /r 01 uuu 111 up +: v ( n u -- ) 8/mod [ 49 ` ] 4* & [ 8B ` 47 ` ] 8* & . ; \ rux = [r15+n] mov r64, r/m64 REX.WuB 8B /r 01 uuu 111 down +: ^^ ( n u -- ) 8/mod [ 48 ` ] 4* & [ 89 ` 44 ` ] 8* & [ 24 ` ] . ; \ [1*0+rsp+n] = rux mov r/m64, r64 REX.Wu 89 /r 01 uuu 100 00 100 100 +: vv ( n u -- ) 8/mod [ 48 ` ] 4* & [ 8B ` 44 ` ] 8* & [ 24 ` ] . ; \ rux = [1*0+rsp+n] mov r64, r/m64 REX.Wu 8B /r 01 uuu 100 00 100 100 +: push ( u -- ) [ 50 ` ] & ; \ push push r64 50+rd +: pop ( u -- ) [ 58 ` ] & ; \ pop pop r64 58+rd +: TYPE ( addr u -- ) [ 7 push 8 6 v 0 2 v 10 += ] TYPE [ 7 pop ] ; + +\ 0FFFFFE0 E00 TYPE BYE + +: + ( n1|u1 n2|u2 -- n|u ) [ 0 0 v 8 += 49 . 01 . 07 . ] ; \ [r15] += rax add r/m64, r64 REX.W 01 /r 00 000 111 Plus +: - ( n1|u1 n2|u2 -- n|u ) [ 0 0 v 8 += 49 . 29 . 07 . ] ; \ [r15] -= rax sub r/m64, r64 REX.W 29 /r 00 000 111 Minus +: AND ( x1 x2 -- x ) [ 0 0 v 8 += 49 . 21 . 07 . ] ; \ [r15] &= rax and r/m64, r64 REX.W 21 /r 00 000 111 +: OR ( x1 x2 -- x ) [ 0 0 v 8 += 49 . 09 . 07 . ] ; \ [r15] |= rax or r/m64, r64 REX.W 09 /r 00 000 111 +: XOR ( x1 x2 -- x ) [ 0 0 v 8 += 49 . 31 . 07 . ] ; \ [r15] ^= rax xor r/m64, r64 REX.W 31 /r 00 000 111 +: LSHIFT ( x1 u -- x2 ) [ 0 1 v 8 += 49 . D3 . 27 . ] ; \ [r15] <<= cl shl r/m64, cl REX.W D3 /4 00 100 111 +: RSHIFT ( x1 u -- x2 ) [ 0 1 v 8 += 49 . D3 . 2F . ] ; \ [r15] >>= cl shr r/m64, cl REX.W D3 /5 00 101 111 +: from4 ( n -- n' ) [ 49 . 63 . 07 . 0 0 ^ ] ; \ rax = ..[r15] movsx r64,r/m32 REX.W 63 /r 00 000 111 +: from1 ( n -- n' ) [ 49 . 0F . BE . 07 . 0 0 ^ ] ; \ rax = ..[r15] movsx r64, r/m8 REX.W 0F BE /r 00 000 111 +: D+ ( d1 d2 -- d ) [ 8 0 v 0 1 v 10 += 49 . 01 . 47 . 08 . ] \ [r15+8] += rax add r/m64, r64 REX.W 01 /r 01 000 111 + [ 49 . 11 . 0F . ] ; \ [r15] += rcx+CF adc r/m64, r64 REX.W 11 /r 00 001 111 +: D- ( d1 d2 -- d ) [ 8 0 v 0 1 v 10 += 49 . 29 . 47 . 08 . ] \ [r15+8] -= rax sub r/m64, r64 REX.W 29 /r 01 000 111 + [ 49 . 19 . 0F . ] ; \ [r15] -= rcx+CF sbb r/m64, r64 REX.W 19 /r 00 001 111 +: D2/ ( xd -- xd' ) 2/ [ 49 . D1 . 5F . 08 . ] ; \ rot [r15+8] right thru CF rcr r/m64, 1 REX.W D1 /3 01 011 111 +: CHAR+ ( addr -- addr' ) 1+ ; +: CHARS ( n -- n' ) ; +: CELL+ ( addr -- addr' ) 8 + ; +: CELLS ( n1 -- n2 ) 8* ; +: ALIGN ( -- ) ; \ TODO revisit alignment when dealing with speed +: ALIGNED ( addr -- a-addr ) ; +: ALLOT ( n -- ) [ 0 0 v 8 += 48 . 01 . C7 . ] ; \ rdi += rax add r/m64, r64 REX.W 01 /r 11 000 111 +: , ( x -- ) [ 0 0 v 8 += 48 . AB . ] ; \ [rdi(++8)] = rax stos m64 REX.W AB Comma +: 4, ( x -- ) [ 0 0 v 8 += AB . ] ; \ [rdi(++4)] = eax stos m32 AB FourComma +: C, ( char -- ) [ 0 0 v 8 += AA . ] ; \ [rdi++] = al stos m8 AA CComma +: ! ( x addr -- ) [ 8 0 v 0 1 v 10 += 48 . 89 . 01 . ] ; \ [rcx] = rax mov r/m64, r64 REX.W 89 /r 00 000 001 Store +: 4! ( x addr -- ) [ 8 0 v 0 1 v 10 += 89 . 01 . ] ; \ [rcx] = eax mov r/m32, r32 89 /r 00 000 001 FourStore +: 4@ ( addr -- x ) [ 0 0 v 8B . 00 . 0 0 ^ ] ; \ eax = [rax] mov r32, r/m32 8B /r 00 000 000 FourFetch +: @ ( addr -- x ) [ 0 0 v 48 . 8B . 00 . 0 0 ^ ] ; \ rax = [rax] mov r64, r/m64 REX.W 8B /r 00 000 000 Fetch +: C! ( char addr -- ) [ 8 0 v 0 1 v 10 += 40 . 88 . 01 . ] ; \ [rcx] = al mov r/m8, r8 REX 88 /r 00 000 001 CStore +: C@ ( addr -- char ) [ 0 0 v 48 . 0F . B6 . 00 . 0 0 ^ ] ; \ rax = 0..[rax] movzx r64, r/m8 REX.W 0F B6 /r 00 000 000 CFetch +: 2! ( x y addr -- ) [ 10 0 v 8 1 v 0 2 v 48 . 89 . 0A . ] \ [rdx] = rcx mov r/m64, r64 REX.W 89 /r 00 001 010 TwoStore + [ 18 += 48 . 89 . 42 . 08 . ] ; \ [rdx+8] = rax mov r/m64, r64 REX.W 89 /r 01 000 010 mem: y x +: 2@ ( addr -- x y ) [ 0 2 v F8 += 48 . 8B . 42 . 08 . ] \ rax = [rdx+8] mov r64, r/m64 REX.W 8B /r 01 000 010 TwoFetch + [ 48 . 8B . 0A . 8 0 ^ 0 1 ^ ] ; \ rcx = [rdx] mov r64, r/m64 REX.W 8B /r 00 001 010 mem: y x +: +! ( n|u addr -- ) [ 8 0 v 0 1 v 10 += 48 . 01 . 01 . ] ; \ [rcx] += rax add r/m64, r64 REX.W 01 /r 00 000 001 +: -! ( n|u addr -- ) [ 8 0 v 0 1 v 10 += 48 . 29 . 01 . ] ; \ [rcx] -= rax sub r/m64, r64 REX.W 29 /r 00 000 001 +: sgn ( -- ) [ 48 ` C1 ` FA ` 3F ` ] ; \ rdx = 0,-1 if <0 sar r/m64, imm8 REX.W C1 /7 ib 11 111 010 +: S>D ( n -- d ) [ 0 2 v sgn F8 += 0 2 ^ ] ; +: ABS ( n -- u ) [ 0 2 v sgn 49 . 31 . 17 . ] \ [r15] ^= rdx xor r/m64, r64 REX.W 31 /r 00 010 111 + [ 49 . 29 . 17 . ] ; \ [r15] -= rdx sub r/m64, r64 REX.W 29 /r 00 010 111 +: MAX ( n n' -- n" ) [ 0 0 v 8 1 v 8 += 48 . 3B . C1 . ] \ cmp rax, rcx cmp r64, r/m64 REX.W 3B /r 11 000 001 + [ 48 . 0F . 4C . C1 . 0 0 ^ ] ; \ rax = rcx if < cmovl r64,r/m64 REX.W 0F 4C /r 11 000 001 +: MIN ( n n' -- n" ) [ 0 0 v 8 1 v 8 += 48 . 3B . C1 . ] \ cmp rax, rcx cmp r64, r/m64 REX.W 3B /r 11 000 001 + [ 48 . 0F . 4F . C1 . 0 0 ^ ] ; \ rax = rcx if > cmovg r64,r/m64 REX.W 0F 4F /r 11 000 001 +: * ( n n' -- n" ) [ 0 0 v 8 += 49 . 0F . AF . 07 . 0 0 ^ ] ; \ rax *= [r15] imul r64, r/m64 REX.W 0F AF /r 00 000 111 (un)signed +: PICK ( xu .. x0 u -- xu .. x0 xu ) + [ 0 0 v 49 . 8B . 44 . C7 . 08 . 0 0 ^ ] ; \ rax = [8*rax+r15+8] mov r64, r/m64 REX.W 8B /r 01 000 100 11 000 111 +: COMPILE, ( xt -- ) [ 0 3 v 8 += ] COMPL ; +: EXECUTE ( i*x xt -- j*x ) [ 0 3 v 8 += ] EXEC ; +: SP@ ( -- addr ) [ F8 F ^ F8 += ] ; \ See https://forth-standard.org/standard/exception/CATCH +: SP! ( addr -- ) [ 8 += F8 F v ] ; \ See https://forth-standard.org/standard/exception/CATCH +: RP@ ( -- addr ) [ F8 += 0 4 ^ ] ; \ See https://forth-standard.org/standard/exception/CATCH +: RP! ( addr -- ) [ 0 4 v 8 += ] ; \ See https://forth-standard.org/standard/exception/CATCH +: HERE ( -- addr ) [ F8 += 0 7 ^ ] ; +: #IN ( -- addr ) 1 1C LSHIFT ; +: TIB ( -- addr ) #IN CELL+ ; +: >IN ( -- addr ) #IN 10 + ; +: source_id ( -- addr ) #IN 18 + ; +: SOURCE-ID ( -- 0|-1 ) source_id @ ; +: STATE ( -- addr ) #IN 20 + ; +: latest ( -- addr ) #IN 28 + ; +: SOURCE ( -- addr u ) #IN 2@ ; +: UNUSED ( -- u ) 1 1F LSHIFT HERE - ; +: DROP ( x -- ) [ 8 += ] ; +: 2DROP ( x y -- ) [ 10 += ] ; +: DUP ( x -- x x ) [ 0 0 v F8 += 0 0 ^ ] ; +: 2DUP ( x y -- x y x y ) [ 8 0 v 0 1 v F0 += 8 0 ^ 0 1 ^ ] ; +: OVER ( x y -- x y x ) [ 8 0 v F8 += 0 0 ^ ] ; +: 2OVER ( x y z w -- x y z w x y ) [ 18 0 v 10 1 v F0 += 8 0 ^ 0 1 ^ ] ; +: SWAP ( x y -- y x ) [ 8 0 v 0 1 v 8 1 ^ 0 0 ^ ] ; +: 2SWAP ( x y z w -- z w x y ) [ 18 0 v 8 2 v 8 0 ^ 18 2 ^ 10 1 v 0 2 v 10 2 ^ 0 1 ^ ] ; +: NIP ( x y -- y ) [ 0 1 v 8 += 0 1 ^ ] ; +: TUCK ( x y -- y x y ) [ 8 0 v 0 1 v F8 += 10 1 ^ 8 0 ^ 0 1 ^ ] ; +: ROT ( x y z -- y z x ) [ 10 0 v 8 1 v 0 2 v 10 1 ^ 8 2 ^ 0 0 ^ ] ; \ TODO local variables +: -ROT ( x y z -- z x y ) [ 10 0 v 8 1 v 0 2 v 10 2 ^ 8 0 ^ 0 1 ^ ] ; +: 2ROT ( x y z w a b -- z w a b x y ) [ 28 0 v 20 1 v 18 2 v 10 3 v 8 5 v 0 6 v ] + [ 28 2 ^ 20 3 ^ 18 5 ^ 10 6 ^ 8 0 ^ 0 1 ^ ] ; +: IMMEDIATE ( -- ) latest @ 10 + DUP C@ 80 OR SWAP C! ; +: S> ( n -- ) [ 41 ` FF ` 77 ` ] . ; \ push [r15+n] push r/m64 REX FF /6 01 110 111 cf. vv ^^ +: >S ( n -- ) [ 41 ` 8F ` 47 ` ] . ; \ pop [r15+n] pop r/m64 REX 8F /0 01 000 111 +: >R ( x -- ) ( R: -- x ) 0 S> 8 += ; IMMEDIATE \ toR +: R> ( -- x ) ( R: x -- ) F8 += 0 >S ; IMMEDIATE \ Rfrom +: R@ ( -- x ) ( R: x -- x ) F8 += 0 >S 0 S> ; IMMEDIATE \ RFetch +: 2>R ( x y -- ) ( R: -- x y ) 8 S> 0 S> 10 += ; IMMEDIATE \ TwotoR +: 2R> ( -- x y ) ( R: x y -- ) F0 += 0 >S 8 >S ; IMMEDIATE \ TwoRfrom +: 2R@ ( -- x y ) ( R: x y -- x y ) F0 += 8 0 vv 0 1 vv 8 0 ^ 0 1 ^ ; IMMEDIATE \ TwoRFetch +: EXIT ( -- ) ( R: nestsys ret -- nestsys ) [ 0 pop ] ; +: COUNT ( addr -- addr' u ) >R R@ 1+ R> C@ ; +: name ( xt -- addr u ) 10 + COUNT 1F AND ; +: stack) ( -- u ) #IN ; +: DEPTH ( -- +n ) SP@ stack) SWAP - 3 RSHIFT ; +: EMIT ( x -- ) SP@ 1 TYPE DROP ; +: D>S ( d -- n ) DROP ; +: DNEGATE ( d -- d' ) 0 0 2SWAP D- ; +: D2* ( xd -- xd' ) 2DUP D+ ; +: 2+! ( d|ud addr -- ) >R R@ 2@ D+ R> 2! ; +: 2-! ( d|ud addr -- ) >R R@ 2@ 2SWAP D- R> 2! ; +: PARSE-NAME ( "name" -- addr u ) pname [ F0 += 8 5 ^ 0 0 ^ ] ; +: PARSE ( char "ccc" -- addr u ) DUP 1+ [ 8 1 v 0 2 v ] PARSE [ 8 5 ^ 0 0 ^ ] ; +: ' ( "ccc" -- xt ) pname FIND [ F8 += 0 3 ^ ] ; \ Tick +: CHAR ( "name" -- char ) PARSE-NAME DROP C@ ; +: (forget) ( xt -- ) [ 0 7 v ] CELL+ @ latest ! ; +: FORGET ( "name" -- ) ' (forget) ; + +\ In Forth 2012, the stack notation ( C: ... ) refers to the control-flow stack. However, Forth 2012 allows +\ the control-flow stack to be the data stack, and these control-flow effects occur only during compilation. +\ We want a brief notation for compilation effects. In SmithForth ( C: ... ) denotes compilation effects. + +: RECURSE ( C: -- ) latest @ COMPILE, ; IMMEDIATE +: :NONAME ( C: -- colonsys ) ( -- xt ) + 15 \ ASCII negative acknowledge, an arbitrary whitespace for a dummy name + SP@ \ rsi = name_addr + 1 \ al = name_length + latest \ rdx = Latest + [ 10 6 v 8 0 v 0 2 v 20 += ] Head latest @ 10 + >R R@ @ 40 ( HIDDEN ) OR R> ! ] latest @ ; + +\ Comparisons \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: flag^ ( u -- ) [ 0F ` ] . [ C1 ` ] \ cl = 0,1 if cc setcc r/m8 0F uu /? 11 000 001 + [ F6 ` D9 ` ] \ cl *= -1 neg r/m8 F6 /3 11 011 001 + [ 48 ` 0F ` BE ` C9 ` ] 0 1 ^ ; \ rcx = ..cl movsx r64, r/m8 REX.W 0F BE /r 11 001 001 +: ?1 ( u -- ) [ 49 ` 83 ` 3F ` 00 ` ] flag^ ; \ cmp [r15], 0 cmp r/m64, imm8 REX.W 83 /7 ib 00 111 111 ( eflags ) +: ?2 ( u -- ) 0 1 v 8 += [ 49 ` 39 ` 0F ` ] flag^ ; \ cmp [r15], rcx cmp r/m64, r64 REX.W 39 /r 00 001 111 ( eflags ) +: 0= ( x -- flag ) [ 94 ?1 ] ; \ ZeroEqual +: 0< ( n -- flag ) [ 9C ?1 ] ; \ Zeroless +: 0<= ( n -- flag ) [ 9E ?1 ] ; \ +: 0> ( n -- flag ) [ 9F ?1 ] ; \ Zeromore +: 0>= ( n -- flag ) [ 9D ?1 ] ; \ +: 0<> ( x -- flag ) [ 95 ?1 ] ; \ Zerone +: = ( x x' -- flag ) [ 94 ?2 ] ; \ +: < ( n n' -- flag ) [ 9C ?2 ] ; \ less +: <= ( n n' -- flag ) [ 9E ?2 ] ; \ +: > ( n n' -- flag ) [ 9F ?2 ] ; \ more +: >= ( n n' -- flag ) [ 9D ?2 ] ; \ +: <> ( x x' -- flag ) [ 95 ?2 ] ; \ ne +: U< ( u u' -- flag ) [ 92 ?2 ] ; \ Uless +: U<= ( u u' -- flag ) [ 96 ?2 ] ; \ +: U> ( u u' -- flag ) [ 97 ?2 ] ; \ Umore +: U>= ( u u' -- flag ) [ 93 ?2 ] ; \ +: D0= ( xd -- flag ) OR 0= ; \ DZeroEqual +: D0< ( d -- flag ) NIP 0< ; \ DZeroless +: D= ( xd xd' -- flag ) ROT = -ROT = AND ; \ DEqual +: D< ( d d' -- flag ) ROT >R >R < 2R@ = AND 2R> < OR ; \ Dless +: DU< ( ud ud' -- flag ) ROT >R >R U< 2R@ = AND 2R> U< OR ; \ DUless +: WITHIN ( n|u n'|u' n"|u" -- flag ) OVER - >R - R> U< ; \ as in https://forth-standard.org/standard/core/WITHIN + +\ Conditionals and loops \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ +\ +\ : W ... test IF ... THEN ... ; +\ : W ... test IF ... ELSE ... THEN ... ; +\ : W ... BEGIN ... AGAIN ... ; +\ : W ... BEGIN ... test UNTIL ... ; +\ : W ... BEGIN ... test WHILE ... REPEAT ... ; +\ +\ In Forth 2012, "orig" denotes a forward reference, and "dest" denotes a backward reference. In SmithForth, +\ dest is an address to jump to, and +\ orig is an address to jump from, so a reference is resolved by: [orig-4] = len = HERE - orig +\ Jump length is measured from the end of the jump instruction. + +: zero ( -- ) 8 += [ 49 ` 83 ` 7F ` F8 ` 00 ` ] \ cmp [r15-8], 0 cmp r/m64, imm8 REX.W 83 /7 ib 01 111 111 + [ 0F ` 84 ` ] ; \ jump if 0 jz rel32 0F 84 cd +: ever ( -- ) [ E9 ` ] ; \ jump jmp rel32 E9 cd +: jump ( -- orig ) 0 4, HERE ; +: land ( orig -- ) >R HERE R@ - R> 4 - 4! ; +: back ( dest orig -- ) >R HERE - R> 4 - 4! ; +: AHEAD ( C: -- orig ) ( -- ) ever jump ; IMMEDIATE +: IF ( C: -- orig ) ( x -- ) zero jump ; IMMEDIATE +: THEN ( C: orig -- ) ( -- ) land ; IMMEDIATE +: ELSE ( C: orig -- orig' ) ( -- ) ever jump SWAP land ; IMMEDIATE +: BEGIN ( C: -- dest ) ( -- ) HERE ; IMMEDIATE +: AGAIN ( C: dest -- ) ( -- ) ever jump back ; IMMEDIATE +: UNTIL ( C: dest -- ) ( x -- ) zero jump back ; IMMEDIATE +: WHILE ( C: dest -- orig dest ) ( x -- ) zero jump SWAP ; IMMEDIATE +: REPEAT ( C: orig dest -- ) ( -- ) ever jump back land ; IMMEDIATE + +\ Strings etc. \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: imm ( xt -- flag ) 10 + C@ 80 AND ; +: fnd ( addr u -- addr u 0 | xt 1 | xt -1 ) [ 8 5 v 0 0 v ] FIND [ F8 += 0 3 ^ ] DUP IF NIP NIP DUP imm IF 1 ELSE FF THEN THEN ; +: FIND ( addr -- addr 0 | xt 1 | xt -1 ) DUP COUNT fnd DUP IF ROT DROP ELSE NIP NIP THEN ; +: [COMPILE] ( "ccc" -- ) ' COMPILE, ; IMMEDIATE \ see AntonErtl @ https://forth-standard.org/standard/core/BracketCOMPILE +: LITERAL ( C: x -- ) ( -- x ) DUP 7 RSHIFT IF F8 += [ B8 ` ] 4, 0 0 ^ ELSE [COMPILE] LIT THEN ; IMMEDIATE +: LITERAL ( C: x -- ) ( -- x ) DUP 20 RSHIFT IF F8 += [ 48 ` B8 ` ] , 0 0 ^ ELSE [COMPILE] LITERAL THEN ; IMMEDIATE +: 2LITERAL ( C: x x' -- ) ( -- x x' ) SWAP [COMPILE] LITERAL [COMPILE] LITERAL ; IMMEDIATE +: [CHAR] ( C: "name" -- ) ( -- char ) CHAR [COMPILE] LITERAL ; IMMEDIATE \ BracketChar +: ['] ( C: "name" -- ) ( -- xt ) ' [COMPILE] LITERAL ; IMMEDIATE \ BracketTick +: POSTPONE ( "ccc" -- ) ' DUP imm IF COMPILE, ELSE [COMPILE] LITERAL ['] COMPILE, COMPILE, THEN ; IMMEDIATE +: (cmov ( -- ) 7 push 10 6 v 8 7 v 0 1 v 18 += ; +: cmov) ( -- ) [ E3 ` 02 ` ] ( jrcxz rel8 ) [ F3 ` A4 ` ] ( rep movs ) 7 pop ; +: CMOVE ( addr1 addr2 u -- ) [ (cmov cmov) ] ; \ copy 1 to 2, bytes lo to hi +: CMOVE> ( addr1 addr2 u -- ) [ (cmov ] \ copy 1 to 2, bytes hi to lo + [ 48 . 8D . 74 . 31 . FF . ] \ rsi = 1*rsi+rcx-1 lea r64, m REX.W 8D /r 01 110 100 00 110 001 + [ 48 . 8D . 7C . 39 . FF . ] \ rdi = 1*rdi+rcx-1 lea r64, m REX.W 8D /r 01 111 100 00 111 001 + [ FD . cmov) FC . ] ; \ FD : std(reverse) ; FC : cld(forward) +: MOVE ( addr1 addr2 u -- ) 2 PICK 2 PICK < IF CMOVE> ELSE CMOVE THEN ; \ [addr2, addr2+u) = [addr1, addr1+u) +: s, ( addr u -- ) >R HERE R@ ALLOT R> MOVE ; \ compile a string +: C" ( C: "ccc" -- ) ( -- addr ) ever jump [CHAR] " PARSE HERE >R DUP C, s, land R> POSTPONE LITERAL ; IMMEDIATE +: S" ( C: "ccc" -- ) ( -- addr u ) POSTPONE C" ['] COUNT COMPILE, ; IMMEDIATE +: ." ( C: "ccc" -- ) ( -- ) POSTPONE S" ['] TYPE COMPILE, ; IMMEDIATE +: .( ( "ccc" -- ) [CHAR] ) PARSE TYPE ; IMMEDIATE +: ROLL ( xu ... x0 u -- xu-1 ... x0 xu ) >R R@ PICK SP@ DUP CELL+ R> 1+ CELLS CMOVE> DROP ; +: ?DUP ( x -- 0 | x x ) DUP IF DUP THEN ; +: FILL ( addr u char -- ) OVER IF 2 PICK C! ( addr u ) 1- OVER 1+ ( addr u-1 addr+1 ) SWAP CMOVE ELSE DROP DROP DROP THEN ; +: ERASE ( addr u -- ) 0 FILL ; +: DABS ( d -- ud ) DUP 0< IF DNEGATE THEN ; +: DMAX ( d d' -- d" ) 2OVER 2OVER D< IF 2SWAP THEN 2DROP ; +: DMIN ( d d' -- d" ) 2OVER 2OVER D< IF ELSE 2SWAP THEN 2DROP ; +: aligned8 ( addr -- addr' ) 7 + 7 INVERT AND ; +: aligned10 ( addr -- addr' ) F + F INVERT AND ; +: align8 ( -- ) [ F8 += 0 7 ^ ] aligned8 [ 0 7 v 8 += ] ; +: align10 ( -- ) [ F8 += 0 7 ^ ] aligned10 [ 0 7 v 8 += ] ; +: >BODY ( xt -- addr ) 10 + DUP C@ 1F AND 1+ 1+ + aligned8 ; \ 1+ for flag byte, 1+ for return ( C3 ) +: (create) ( -- addr ) ( R: ret -- ret ) R@ 4 - 4@ >BODY ; +: CREATE ( "name" -- ) : ['] (create) @ latest @ ! POSTPONE ; align8 ; + +\ DOES> \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +\ https://forth-standard.org/standard/core/DOES (see WEIRD especially) +\ https://www.bradrodriguez.com/papers/moving3.htm +\ http://win32forth.sourceforge.net/doc/Forth_Primer.pdf +\ http://galileo.phys.virginia.edu/classes/551.jvn.fall01/primer.htm#create +\ https://archive.org/details/brown_j_w_welcome_forth/page/n25/mode/2up +\ https://archive.org/details/R.G.LoeligerThreadedInterpretiveLanguagesTheirDesignAndImplementationByteBooks1981/page/n83/ +\ https://cfhcable.dl.sourceforge.net/project/thinking-forth/reprint/rel-1.0/thinking-forth-color.pdf +\ http://www.forth.org/svfig/Len/arrays.htm +\ +\ Compilation ( C: colonsys -- colonsys' ) +\ append run-time semantics to the current definition ( CONSTANT ) ( 1: WEIRD ) ( 2: WEIRD.DOES>.1 ) +\ consume colonsys ( CONSTANT ) and produce colonsys' ( CONSTANT.DOES> ) ( 1: WEIRD WEIRD.DOES>.1 ) ( 2: WEIRD.DOES>.1 WEIRD.DOES>.2 ) +\ append initiation semantics to the current definition ( CONSTANT.DOES> ) ( 1: WEIRD.DOES>.1 ) ( 2: WEIRD.DOES>.2 ) +\ Runtime ( -- ) ( R: nestsys -- ) +\ replace execution semantics of most recent definition Name ( FOUR ) by Name execution semantics +\ return control to the calling definition ( CONSTANT ) specified by nestsys +\ Initiation ( i*x -- i*x addr ) ( R: -- nestsys' ) note, i*x are arguments to Name ( FOUR ) +\ save implementation-dependent information nestsys' referring to calling definition +\ place onto stack data field address of Name ( FOUR ) +\ Name execution: ( i*x -- j*x ) note, i*x and j*x are arguments and results of Name ( FOUR ) +\ execute the portion of the definition that begins with the initiation semantics appended by the DOES> which modified Name ( FOUR ) + +: (run) ( -- ) ( R: r -- r ) R@ 1+ ( addr ) latest @ ! ; \ addr: begin code of CONSTANT.DOES> ; extra byte for C3 ; latest: FOUR +: (ini) ( -- addr ) ( R: r r' -- r r' ) 2R@ DROP 4 - 4@ >BODY ; \ addr: data area of FOUR ; r: caller of FOUR ; r': CONSTANT.DOES> +: DOES> ( C: colonsys -- colonsys' ) ['] (run) COMPILE, [ C3 ` ] ['] (ini) COMPILE, ; IMMEDIATE + +\ Variables etc. \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: MARKER ( "name" -- ) CREATE latest @ , DOES> @ (forget) ; +: VARIABLE ( "name" -- ) CREATE 0 , ; +: 2VARIABLE ( "name" -- ) CREATE 0 , 0 , ; +: BUFFER: ( u "name" -- ) CREATE ALLOT ; +VARIABLE BASE +: DECIMAL ( -- ) A BASE ! ; +: HEX ( -- ) 10 BASE ! ; HEX +: CONSTANT ( x "name" -- ) CREATE , DOES> @ ; +: 2CONSTANT ( x y "name" -- ) CREATE , , DOES> 2@ ; +: VALUE ( x "name" -- ) CREATE 0 ( id ) latest @ >BODY 1- C! , DOES> @ ; +: 2VALUE ( x y "name" -- ) CREATE 1 ( id ) latest @ >BODY 1- C! , , DOES> 2@ ; +: (to) ( i*x xt -- ) >BODY DUP 1- C@ IF 2! ELSE ! THEN ; +: TO ( i*x "name" -- ) STATE @ IF ' POSTPONE LITERAL ['] (to) COMPILE, + ( C: "name" -- ) ELSE ' (to) THEN ; IMMEDIATE +: (+to) ( i*x xt -- ) >BODY DUP 1- C@ IF 2+! ELSE +! THEN ; +: +TO ( i*x "name" -- ) STATE @ IF ' POSTPONE LITERAL ['] (+to) COMPILE, + ( C: "name" -- ) ELSE ' (+to) THEN ; IMMEDIATE +: (-to) ( i*x xt -- ) >BODY DUP 1- C@ IF 2-! ELSE -! THEN ; +: -TO ( i*x "name" -- ) STATE @ IF ' POSTPONE LITERAL ['] (-to) COMPILE, + ( C: "name" -- ) ELSE ' (-to) THEN ; IMMEDIATE +: uChar ( u -- char ) DUP A < IF [CHAR] 0 + ELSE A - [CHAR] A + THEN ; \ 0..F.. -> '0'..'9', 'A'..'F'.. +: charu ( char -- u ) DUP [CHAR] 0 [CHAR] 9 1+ WITHIN IF [CHAR] 0 - ELSE DROP FF THEN ; +: charu ( char -- u ) DUP [CHAR] A [CHAR] Z 1+ WITHIN IF [CHAR] A - A + ELSE charu THEN ; +: charu ( char -- u ) DUP [CHAR] a [CHAR] z 1+ WITHIN IF [CHAR] a - A + ELSE charu THEN ; +: signum ( n -- n' ) >R R@ 0< R> 0> - ; +: rstackBytes ( -- nHard nSoft nRet ) \ nRet : 0(success) or -1(error) + 61 \ getrlimit (/usr/include/x86_64-linux-gnu/asm/unistd_64.h) + 3 \ RLIMIT_STACK (/usr/include/x86_64-linux-gnu/bits/resource.h) + SP@ [ 10 0 v 8 7 v 0 6 v syscall 0 0 ^ ] ; +\ I guess Linux syscalls, in the layout of structs, conform to the System V ABI (general) chapter 7 on network protocol, as "network" (or "RPC") +\ here might simply refer to the situation where two programs attempt to communicate without having been compiled by the same tools and options. +\ http://www.sco.com/developers/devspecs/gabi41.pdf +: rstackCells ( -- n ) rstackBytes DROP NIP 3 RSHIFT ; \ getrlimit(RLIMIT_STACK) values vary only if we change them? +VARIABLE s0 VARIABLE u0 VARIABLE match \ lexicographic order: 0 if str1 == str2 +VARIABLE s1 VARIABLE u1 \ -1 if str1 < str2, +1 if str1 > str2 +: known ( -- 0 | n -1 ) u0 @ u1 @ * IF s0 @ C@ s1 @ C@ - signum ?DUP ELSE u0 @ u1 @ - signum FF THEN ; +: COMPARE ( addr u addr' u' -- n ) u1 ! s1 ! u0 ! s0 ! BEGIN known 0= WHILE 1 s0 +! 1 u0 -! 1 s1 +! 1 u1 -! REPEAT ; +: streq ( addr u addr' u' -- flag ) COMPARE 0= DUP IF DUP match ! THEN ; +: max-n ( -- n ) 1 3F LSHIFT INVERT ; +: bufLen ( -- u ) 40 4* ; +: ENVIRONMENT? ( addr u -- 0 | i*x -1 ) 2>R 0 match ! \ Values must be constant. + S" /COUNTED-STRING" 2R@ streq IF 40 4* 1- ( n ) THEN + S" /HOLD" 2R@ streq IF bufLen ( n ) THEN + S" /PAD" 2R@ streq IF bufLen ( n ) THEN + S" ADDRESS-UNIT-BITS" 2R@ streq IF 8 ( n ) THEN + S" FLOORED" 2R@ streq IF FF ( flag ) THEN + S" MAX-CHAR" 2R@ streq IF 40 4* 1- ( u ) THEN + S" MAX-D" 2R@ streq IF FF max-n ( d ) THEN + S" MAX-N" 2R@ streq IF max-n ( n ) THEN + S" MAX-U" 2R@ streq IF FF ( u ) THEN + S" MAX-UD" 2R@ streq IF FF FF ( ud ) THEN + S" RETURN-STACK-CELLS" 2R@ streq IF rstackCells ( n ) THEN + S" STACK-CELLS" 2R@ streq IF 1 15 LSHIFT ( n ) THEN + 2R> 2DROP match @ ; +0 CONSTANT FALSE +0 1- CONSTANT TRUE +20 CONSTANT BL +: SPACE ( -- ) BL EMIT ; +: CR ( -- ) A EMIT ; +: WORDS ( -- ) latest @ BEGIN DUP WHILE SPACE DUP name TYPE CELL+ @ REPEAT DROP CR ; + + +\ Arithmetic again \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ +\ +\ See Knuth TAOCP Vol 2 Sec 4.3.1. Our approach is to convert negative numbers to nonnegative for multiplication and +\ division. Multiplication and division on 2- and 3-cell numbers is like on 2- and 3-digit numbers. We use all 2^6 bits +\ of each cell and unsigned basic operations. We have only 1-cell divisors, so we can use the "short division" algorithm. +\ I found AMD's manual clearer than Intel's on the meaning of flags CF (carry, unsigned ops) and OF (overflow, signed ops). + +: M+ ( d|ud n -- d'|ud' ) S>D D+ ; +: M* ( n n' -- d ) [ 8 0 v 49 . F7 . 2F . 8 0 ^ 0 2 ^ ] ; \ rdx:rax=rax*[r15] imul r/m64 REX.W F7 /5 00 101 111 signed +: UM* ( u u' -- ud ) [ 8 0 v 49 . F7 . 27 . 8 0 ^ 0 2 ^ ] ; \ rdx:rax=rax*[r15] mul r/m64 REX.W F7 /4 00 100 111 unsigned +: udm* ( ud u -- t ) TUCK 2>R UM* 0 2R> UM* D+ ; \ t: 3-cell prod \ ____q_p +\ udm* H L \ m*/ n ) H M L +\ x u \ n*q +\ --- \ s L +\ L*u: M L' \ n*p +\ H*u: H' N \ r +: m*/ ( ud u +n -- d r ) >R udm* R@ UM/MOD -ROT R> UM/MOD -ROT ; +VARIABLE -ve +: sfloor ( ud r -- d ) >R -ve @ IF DNEGATE THEN R> 0<> -ve @ AND S>D D+ ; \ roughly, if quot < 0 and rem != 0, then quot-- +: M*/ ( d n +n -- d' ) >R DUP 0< -ve ! ABS >R 2DUP D0< -ve @ XOR -ve ! DABS R> R> m*/ sfloor ; + +\ Symmetric division (provided by x86) note, idiv fails if quotient doesn't fit in rax \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: imul ( -- ) [ 49 ` F7 ` 6F ` 08 ` ] ; \ rdx:rax=rax*[r15+8] imul r/m64 REX.W F7 /5 01 101 111 +: idiv ( -- ) [ 49 ` F7 ` 3F ` ] ; \ rdx:rax / [r15] idiv r/m64 REX.W F7 /7 00 111 111 rdx=rem rax=quot +: SM/REM ( d m -- rem quot ) [ 10 0 v 8 2 v idiv 8 += 8 2 ^ 0 0 ^ ] ; \ signed d ( lo hi ) / m +: /' ( n m -- quot ) [ 8 0 v 8 2 v sgn idiv 8 += 0 0 ^ ] ; \ Divprime +: MOD' ( n m -- rem ) [ 8 0 v 8 2 v sgn idiv 8 += 0 2 ^ ] ; \ MODprime +: /MOD' ( n m -- rem quot ) [ 8 0 v 8 2 v sgn idiv 8 2 ^ 0 0 ^ ] ; \ DivMODprime +: */' ( n n' m -- quot ) [ 10 0 v imul idiv 10 += 0 0 ^ ] ; \ TimesDivprime +: */MOD' ( n n' m -- rem quot ) [ 10 0 v imul idiv 8 += 8 2 ^ 0 0 ^ ] ; \ TimesDivMODprime + +\ Floored division: (customary in mathematics, 0 <= remainder < m when 0 < m as in modular arithmetic, a little slower) + +\ The difference between symmetric (SM/REM) and floored (FM/MOD) division is illustrated in Table 3.3 of Forth 2012 +\ (https://forth-standard.org/standard/usage). I prefer floored as in the division algorithm, a.k.a. the division lemma. + +: adjust ( rem m -- flag ) >R R@ 0< IF NEGATE 0 R> NEGATE ELSE 0 R> THEN WITHIN 0= ; +: adjust ( rem quot m -- rem' quot' ) >R OVER R@ adjust >R ( rem quot R: m flag ) R@ + SWAP 2R> AND + SWAP ; +: FM/MOD ( d m -- rem quot ) >R R@ SM/REM R> adjust ; +: /MOD ( n m -- rem quot ) >R S>D R> FM/MOD ; +: / ( n m -- quot ) /MOD NIP ; +: MOD ( n m -- rem ) /MOD DROP ; +: */MOD ( n n' m -- rem quot ) >R R@ */MOD' R> adjust ; +: */ ( n n' m -- quot ) */MOD NIP ; + +\ Numeric output \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +bufLen BUFFER: nbuf VARIABLE [nbuf +: HOLD ( char -- ) 1 [nbuf -! [nbuf @ C! ; +: HOLDS ( addr u -- ) BEGIN DUP WHILE 1- 2DUP + C@ HOLD REPEAT 2DROP ; \ as in https://forth-standard.org/standard/core/HOLDS +: SIGN ( n -- ) 0< IF [CHAR] - HOLD THEN ; +: +SIGN ( n -- ) 0< IF [CHAR] - ELSE [CHAR] + THEN HOLD ; +: <# ( -- ) nbuf bufLen + [nbuf ! ; +: # ( ud -- ud' ) 1 BASE @ m*/ uChar HOLD ; +: #S ( ud -- ud' ) BEGIN # 2DUP D0= UNTIL ; +: #> ( xd -- addr u ) 2DROP [nbuf @ nbuf bufLen + [nbuf @ - ; +: d. ( d -- addr u ) TUCK DABS <# #S ROT SIGN #> ; +: +d. ( d -- addr u ) TUCK DABS <# #S ROT +SIGN #> ; +: D. ( d -- ) d. TYPE SPACE ; +: c. ( char -- addr u ) 0 <# # # #> ; +: C. ( char -- ) c. TYPE ; +: u8. ( u -- addr u ) 0 <# # # # # # # # # #> ; +: U8. ( u -- ) u8. TYPE ; +: u. ( u -- addr u ) 0 <# #S #> ; +: U. ( u -- ) u. TYPE SPACE ; +: n. ( n -- addr u ) S>D d. ; +: +n. ( n -- addr u ) S>D +d. ; +: N. ( n -- ) n. TYPE SPACE ; +: ? ( addr -- ) @ N. ; +: .S ( -- ) [CHAR] ( EMIT DEPTH n. TYPE [CHAR] ) EMIT SPACE + DEPTH 0 BEGIN 2DUP > WHILE 1+ stack) OVER CELLS - ? REPEAT 2DROP CR ; + +\ Reports (nonstandard) \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: #T 60 ; #T BUFFER: T +: Twrite ( addr u vddr -- ) 2>R 2R@ @ T + SWAP MOVE 2R> +! ; \ suppose buffer T has room for u chars +: Twrite ( addr u vddr -- ) >R #T R@ @ #T MIN - MIN R> Twrite ; \ update variable vddr which keeps a value from 0 to #T + +\ SEE \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: nextLater ( xt -- xt' ) >R latest @ BEGIN DUP CELL+ @ R@ - WHILE CELL+ @ REPEAT R> DROP ; +: endCode ( xt -- addr ) DUP latest @ = IF DROP HERE ELSE nextLater THEN ; +: endCode ( xt -- addr ) DUP IF endCode THEN ; +: begCode ( xt -- addr ) DUP IF @ THEN ; +: begCode ( xt -- addr ) DUP IF 10 + DUP C@ 1F AND 1+ + THEN ; + +\ TODO extend input facility ( TIB >IN #IN etc. ) to use other input source ( machine code )? Similar issues arise in S\" , binary interpreter. +0 VALUE [& \ Note, whenever these are used, assume 1 CHARS is equal to 1. Otherwise there are irritations. +0 VALUE &> \ For instance, to tell how many chars are between two addresses, must divide. +0 VALUE &) +VARIABLE err +VARIABLE fin + +CREATE >T 3 CELLS ALLOT +: col ( n -- vddr ) CELLS >T + ; +: h ( addr u -- ) 2 col Twrite ; +: ul ( u -- ) 3 * S" al cl dl bl ah ch dh bh" DROP + 2 h ; +: eux ( u -- ) 4* S" eax ecx edx ebx esp ebp esi edi" DROP + 3 h ; +: rux ( u -- ) 4* S" rax rcx rdx rbx rsp rbp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15 " DROP + 3 h ; +: | ( n -- char ) 1 8 LSHIFT MOD ; \ sign extension of literals is inconvenient for byte arithmetic below +: |> ( -- ) err @ fin @ OR IF ELSE 1 fin ! [& u8. 0 col Twrite &> TO [& T #T TYPE CR THEN + T #T BL FILL 0 0 col ! B 1 col ! #T 2/ 2 col ! [& TO &> 0 err ! ; +: ~ ( -- ) ." " &> C@ C. err @ IF ." E " ELSE ." " THEN .S ; \ to debug see +: byte ( -- u ) &> C@ DUP c. 1 col Twrite 1 1 col +! 1 +TO &> ; +: 4byte ( -- u ) byte byte byte byte 8 LSHIFT + 8 LSHIFT + 8 LSHIFT + ; +: must ( flag -- ) IF ELSE 1 err ! THEN ; +: [0,8) ( u -- u' ) DUP 0 8 WITHIN must 8 MOD ; +: -REX ( u -- B X R W ) 2 /MOD 2 /MOD 2 /MOD 2 /MOD 4 = must ; +: -REX.wx ( u -- B R ) -REX 0= must SWAP 0= must ; +: -REX.Wx ( u -- B R ) -REX 1 = must SWAP 0= must ; +: -00r/m ( B R u -- r/m reg ) 8 /MOD 8 /MOD 0 = must ROT 8* + >R SWAP 8* + R> ; +: -01r/m ( B R u -- r/m reg ) 8 /MOD 8 /MOD 1 = must ROT 8* + >R SWAP 8* + R> ; +: -11r/m ( B R u -- r/m reg ) 8 /MOD 8 /MOD 3 = must ROT 8* + >R SWAP 8* + R> ; \ TODO -ModR/M ( B R u -- r/m reg mod ) and allow any mod +: see ( -- ) 1 err ! 0 fin ! + |> byte C3 | = must S" return" h + |> byte 8 /MOD 50 | 8 / = must S" push " h rux + |> byte 8 /MOD 58 | 8 / = must S" pop " h rux + |> byte 8B | = must 0 0 byte -00r/m [0,8) eux S" = [" h [0,8) rux S" ]" h + |> byte 2B | = must 0 0 byte -11r/m [0,8) eux S" -= " h [0,8) eux + |> byte -REX.Wx byte 83 | = must byte -11r/m 5 = must rux S" -= " h byte c. h + |> byte 83 | = must 0 0 byte -11r/m 5 = must [0,8) eux S" -= " h byte c. h + |> byte AA | = must S" [rdi++] = al" h + |> byte AB | = must S" [rdi(++4)] = eax" h + |> byte AC | = must S" al = [rsi++]" h + |> byte AD | = must S" eax = [rsi(++4)]" h + |> byte 8 /MOD 90 | 8 / = must S" xchg eax, " h eux + |> byte 8 /MOD B0 | 8 / = must ul S" = " h byte c. h + |> byte 8 /MOD B8 | 8 / = must eux S" = " h 4byte u. h + |> byte 75 | = must S" jump if != to " h byte from1 +n. h + |> byte EB | = must S" jump to " h byte from1 +n. h + |> byte 6A | = must S" push " h byte c. h + |> byte -REX.wx byte 8F | = must byte -00r/m 0= must S" pop [" h rux S" ]" h + |> byte -REX.wx byte FF | = must byte -01r/m 6 = must S" push [" h rux S" +" h byte c. h S" ]" h + |> byte -REX.Wx byte 83 | = must byte -01r/m 7 = must S" cmp [" h rux S" +" h byte c. h S" ], " h byte c. h + |> byte 0F | = must byte 05 | = must S" syscall" h + |> byte 0F | = must byte 84 | = must S" jump if 0 to " h 4byte from4 +n. h + |> byte E8 | = must S" call " h 4byte &> + from4 +n. h \ TODO call goes to code, not to xt ; get name by begCode endCode ? + |> byte E9 | = must S" jump to " h 4byte from4 +n. h + |> byte -REX.Wx byte 83 | = must byte -11r/m 0= must rux S" += " h byte c. h + |> byte FF | = must byte 14 | = must byte 25 | = must S" call " h 4byte err @ IF DROP ELSE name h THEN + |> byte -REX.Wx byte 8B | = must byte -01r/m rux S" = [" h rux S" +" h byte c. h S" ]" h \ TODO incorrect on output of vv ; where are other use cases? v is one ( search 8B ) ; detect SIB condition + |> byte -REX.Wx byte 89 | = must byte -01r/m S" [" h SWAP rux S" +" h byte c. h S" ] = " h rux + |> byte S" (unknown) " h 20 7F WITHIN IF &> 1- 1 h THEN + |> ; +: SEE ( "name" -- ) ' DUP begCode TO [& DUP endCode TO &) DUP U8. ." Code: " DUP @ U8. + ." Link: " DUP CELL+ @ U8. ." ( " DUP CELL+ @ ?DUP IF name TYPE THEN ." ) Flag: " DUP 10 + C@ C. ." Name: " name TYPE CR + BEGIN [& &) ( ." PASS " .S ) < WHILE see REPEAT ; + +\ Counted loops (simple) \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ +\ +\ : W ... limit index DO ... LOOP ... ; +\ +\ L=loop-sys ( R: limit index ) + +: DO ( limit index -- ) ( R: -- L ) ( C: -- dest ) POSTPONE 2>R HERE ; IMMEDIATE +: (loop) ( -- flag ) ( R: L ret -- L' ret ) [ 2 pop ] R> 1+ >R 2R@ = [ 2 push ] ; +: LOOP ( -- ) ( R: L -- |L' ) ( C: dest -- ) ['] (loop) COMPILE, zero jump back 10 ++= ; IMMEDIATE +: I ( -- n ) ( R: L ret -- L ret ) [ 8 0 vv F8 += 0 0 ^ ] ; + +\ DUMP \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: lim_ind ( lo -- lo limit index ) DUP F0 AND DUP 10 + SWAP ; +: within ( hi lo n -- hi lo flag ) 1 PICK 3 PICK WITHIN ; +: DHex ( hi lo -- hi lo ) lim_ind DO I within IF I C@ c. TYPE ELSE SPACE SPACE THEN I 1 AND IF SPACE THEN LOOP ; +: DRaw ( hi lo -- hi lo ) lim_ind DO I within IF I C@ 20 7F WITHIN IF I C@ ELSE [CHAR] . THEN EMIT ELSE SPACE THEN LOOP ; +: DLine ( hi lo -- ) DUP F0 AND u8. TYPE [CHAR] : EMIT SPACE DHex SPACE DRaw 2DROP CR ; +: DUMP ( addr u -- ) OVER + SWAP BEGIN 2DUP DLine 10 + F0 AND 2DUP <= UNTIL 2DROP ; + +\ 0FFFFFE0 120 DUMP BYE + +\ CASE \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ +\ +\ : W ... +\ x CASE +\ x1 OF ... ENDOF +\ x2 OF ... ENDOF +\ ( default ) ... ENDCASE ... ; +\ +\ In SmithForth, +\ casesys (1 cell) is a forward reference (orig) emanating from the previous ENDOF of this case statement, or 0 if none, and +\ ofsys (1 cell) is a forward reference (orig) emanating from a statement OF, used to jump past the next ENDOF. + +: (of) ( x y -- -1 | x 0 ) OVER = DUP IF NIP THEN ; +: CASE ( -- ) ( C: -- casesys ) 0 ; IMMEDIATE +: OF ( x y -- |x ) ( C: -- ofsys ) ['] (of) COMPILE, zero jump ; IMMEDIATE +: ENDOF ( -- ) ( C: casesys ofsys -- casesys' ) ever jump SWAP land TUCK 4 - 4! ; IMMEDIATE +: ENDCASE ( x -- ) ( C: casesys -- ) ['] DROP COMPILE, BEGIN DUP WHILE DUP 4 - 4@ SWAP land REPEAT DROP ; IMMEDIATE + +\ Strings with escape sequences \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: getc ( -- 0 | char -1 ) >IN @ #IN @ < DUP IF TIB @ >IN @ + C@ 1 >IN +! SWAP THEN ; +: getq ( -- 0 | char -1 ) getc DUP IF OVER [CHAR] " = IF 2DROP 0 THEN THEN ; \ 0 if double quote +: \c ( -- ) getc IF CASE + [CHAR] a OF [ 7 ` ] ENDOF + [CHAR] b OF [ 8 ` ] ENDOF + [CHAR] e OF [ 1B ` ] ENDOF + [CHAR] f OF [ C ` ] ENDOF + [CHAR] l OF [ A ` ] ENDOF + [CHAR] m OF [ D ` A ` ] ENDOF + [CHAR] n OF [ A ` ] ENDOF + [CHAR] q OF [ 22 ` ] ENDOF + [CHAR] r OF [ D ` ] ENDOF + [CHAR] t OF [ 9 ` ] ENDOF + [CHAR] v OF [ B ` ] ENDOF + [CHAR] " OF [ 22 ` ] ENDOF + [CHAR] \ OF [ 5C ` ] ENDOF + [CHAR] x OF 0 getc IF charu SWAP 4* 4* + THEN getc IF charu SWAP 4* 4* + THEN C, ENDOF + [ 0 ` ] ENDCASE THEN ; +: S\" ( C: "ccc" -- ) ( -- addr u ) ever jump BEGIN getq WHILE DUP [CHAR] \ = IF DROP \c ELSE C, THEN REPEAT + ( orig ) HERE OVER - ( orig u ) OVER land POSTPONE 2LITERAL ; IMMEDIATE +\ TODO Make strings more space-efficient with a better scheme than 2LITERAL. Use only a single 1-byte parameter, length. +\ Address can be retrieved from the return stack. Down from twenty-two bytes to perhaps nine? + +\ Counted loops (complete) \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ +\ +\ : W ... limit index DO ... LOOP ... ; +\ : W ... limit index DO ... step +LOOP ... ; +\ : W ... limit index ?DO ... LOOP ... ; +\ : W ... limit index ?DO ... step +LOOP ... ; +\ +\ L=loop-sys ( R: addr limit k ) where +\ addr is the location of the DO header +\ k = min-n + index - limit +\ min-n = 8000000000000000 +\ The reason to translate the index by min-n - limit is to detect more easily when to exit a DO ... +LOOP. +\ See AntonErtl's comment (https://forth-standard.org/standard/core/PlusLOOP#reply-214). +\ Gist: jump back if k + n does not overflow. There are two cases n|u (signed and unsigned). +\ Each instance of a DO loop gets a DO header, consisting of a 64-bit address where LEAVE statements jump to. +\ Next instruction: call UNLOOP. Right before the DO header is an instruction to jump past the header. +\ See also Dr. C. H. Ting's account of F83 (http://forth.org/OffeteStore/1003_InsideF83.pdf), +\ especially "The New F83 Loops" (p. 48) and "The New Leave" (p. 50). + +: min-n ( -- n ) max-n 1+ ; +: (do) ( limit index addr -- ) ( R: ret -- addr limit k ret ) -ROT min-n + OVER - + [ 10 0 v 8 1 v 0 2 v 18 += 3 pop E8 ++= 10 0 ^^ 8 1 ^^ 0 2 ^^ 3 push ] ; +: (DO) ( -- ) ( R: -- L ) ( C: -- addr dest ) EB . 08 . \ skip DO header jmp rel8 EB cb + HERE ( addr ) HERE ( for POSTPONE LITERAL ) 0 , POSTPONE LITERAL ['] (do) COMPILE, HERE ( dest ) ; +: (q) ( x y -- -1 | x y 0 ) 2DUP = DUP IF NIP NIP THEN INVERT ; +: DO ( n1|u1 n2|u2 -- ) ( R: -- L ) ( C: -- orig addr dest ) 0 (DO) ; IMMEDIATE +: ?DO ( n1|u1 n2|u2 -- ) ( R: -- L ) ( C: -- orig addr dest ) ['] (q) COMPILE, zero jump (DO) ; IMMEDIATE \ qDO +: UNLOOP ( -- ) ( R: L ret -- ret ) [ 0 pop 18 ++= 0 push ] ; +: (+loop) ( n -- flag ) ( R: addr limit k ret -- addr limit k' ret ) + [ 0 0 v 48 . 01 . 44 . 24 . 08 . ] \ [1*0+rsp+8] += rax add r/m64, r64 REX.W 01 /r 01 000 100 00 100 100 + [ 0F . 90 . C0 . ] \ al = 0, 1 if overflow seto r/m8 0F 90 /? 11 000 000 + [ 48 . 0F . B6 . C0 . 0 0 ^ ] ; \ rax = 0..0al movzx r64, r/m8 REX.W 0F B6 /r 11 000 000 +: +LOOP ( n -- ) ( R: L -- |L' ) ( C: orig addr dest -- ) + ['] (+loop) COMPILE, zero jump back HERE SWAP ! ['] UNLOOP COMPILE, ?DUP IF land THEN ; IMMEDIATE +: LOOP ( -- ) ( R: L -- |L' ) ( C: orig addr dest -- ) 1 POSTPONE LITERAL POSTPONE +LOOP ; IMMEDIATE +: I ( -- n|u ) ( R: L ret -- L ret ) [ 8 0 vv 10 1 vv F0 += 0 0 ^ 8 1 ^ ] + min-n - ; +: J ( -- n|u ) ( R: L1 L2 ret -- L1 L2 ret ) [ 20 0 vv 28 1 vv F0 += 0 0 ^ 8 1 ^ ] + min-n - ; +: K ( -- n|u ) ( R: L1 L2 L3 ret -- L1 L2 L3 ret ) [ 38 0 vv 40 1 vv F0 += 0 0 ^ 8 1 ^ ] + min-n - ; +: LEAVE ( -- ) ( R: L ret -- L ) + [ 0 pop 10 0 vv FF . 20 . ] ; \ jump [rax] jmp r/m64 FF /4 00 100 000 + +\ Buffers \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +bufLen BUFFER: PAD +bufLen BUFFER: wbuf +bufLen BUFFER: kbuf +bufLen BUFFER: bbuf + +\ Terminal input mode noncanonical \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ +\ +\ The Forth core standard word KEY must not echo the character entered. +\ The usual behavior in a Unix terminal is to echo characters entered. +\ Unix (POSIX) provides a non-echoing terminal mode called noncanonical mode. +\ The terminal mode may be changed by helper programs like `stty`, `stdbuf`, or `unbuffer`. +\ I find it easier to understand what is going on if instead we change the mode from within our own program by syscalls. +\ My approach is to leave and enter canonical mode upon each call of KEY. +\ ACCEPT uses canonical mode and enjoys the standard line-editing features. +\ +\ Choice of mode is controlled by item ICANON in member c_lflag of struct termios. +\ This is a libc thing, but is also exposed in syscall ioctl ( `man 2 ioctl_tty` ). Useful info: +\ https://www.gnu.org/software/libc/manual/html_node/Terminal-Modes.html +\ https://www.gnu.org/software/libc/manual/html_node/Noncanon-Example.html +\ https://www.gnu.org/software/libc/manual/html_node/Canonical-or-Not.html +\ https://www.gnu.org/software/libc/manual/html_node/Noncanonical-Input.html +\ https://www.gnu.org/software/libc/manual/html_node/Local-Modes.html ( see ECHO and other flags ) +\ In these headers and in POSIX, local mode flags are in a 4-byte field after three other 4-byte fields of the struct. +\ /usr/include/x86_64-linux-gnu/bits/termios.h +\ /usr/include/asm-generic/termbits.h +\ libc has a function isatty() to determine whether stdin is a terminal. We might want to do something like this. `man 2 fstat` + +5401 CONSTANT TCGETS \ see /usr/include/asm-generic/ioctls.h +5402 CONSTANT TCSETS \ see /usr/include/asm-generic/ioctls.h +2 CONSTANT ICANON \ see /usr/include/x86_64-linux-gnu/bits/termios.h +8 CONSTANT ECHO \ see /usr/include/x86_64-linux-gnu/bits/termios.h +24 BUFFER: tcbuf \ #bytes written by syscall. I cannot find a definition of termios in Linux that agrees, but it is consistent with POSIX. +: c_lflag ( -- addr ) tcbuf C + ; +: ioctl? ( cmd -- flag ) 10 0 tcbuf ( cmd ioctl stdin argp ) + [ 7 push 18 6 v 10 0 v 8 7 v 0 2 v syscall 18 += 0 0 ^ 7 pop ] ; +: ioctl ( cmd -- ) ioctl? DROP ; \ ignore any error +\ #define ENOTTY 25 /* Not a typewriter */ +\ ENOTTY fd is not associated with a character special device. +\ ENOTTY The specified request does not apply to the kind of object that the file descriptor fd references. +\ Apparently even isatty() (`man 3 isatty`) just tries syscall TCGETS ioctl; is TTY iff it succeeds (ret=0). +\ https://stackoverflow.com/questions/41906713/is-there-a-way-to-determine-if-stdin-is-a-tty-through-a-system-call +TCGETS ioctl? VALUE notty +: -echo ( -- ) 0 TO notty ; \ useful in case `cat myprog.fs - | ./SForth` +: +echo ( -- ) 1 TO notty ; +: tty ( -- flag ) notty 0= ; +: nonca ( -- ) tty IF TCGETS ioctl c_lflag 4@ ICANON INVERT AND ECHO INVERT AND c_lflag 4! TCSETS ioctl THEN ; +: canon ( -- ) tty IF TCGETS ioctl c_lflag 4@ ICANON OR ECHO OR c_lflag 4! TCSETS ioctl THEN ; + +\ Input etc. \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: WORD ( char "ccc" -- addr ) DUP BL = IF DROP PARSE-NAME ELSE [ 0 2 v ] 1+ [ 0 1 v ] seek 1- PARSE THEN + ( addr u ) [ FF ] LITERAL AND DUP wbuf C! wbuf 1+ SWAP MOVE wbuf ; +: more ( addr u -- flag ) IF C@ charu 0 BASE @ WITHIN ELSE DROP 0 THEN ; +: >NUMBER ( ud addr u -- ud' addr+1 u-1 ) 1- >R DUP 1+ >R C@ charu >R BASE @ 1 M*/ R> 0 D+ R> R> ; +: >NUMBER ( ud addr u -- ud' addr' u' ) BEGIN 2DUP more WHILE >NUMBER REPEAT ; +: SPACES ( u -- ) 0 ?DO SPACE LOOP ; +: .r ( addr u n -- u ) OVER - 0 MAX SPACES TYPE ; +: .R ( n n' -- ) >R n. R> .r ; +: U.R ( u n -- ) >R u. R> .r ; +: D.R ( d n -- ) >R d. R> .r ; +: read ( addr u -- u' ) 0 ( read=stdin ) [ 7 push 10 6 v 8 2 v 0 0 v 0 7 v syscall 10 += 0 0 ^ 7 pop ] ; +: KEY ( -- char ) nonca 0 SP@ 1 read DROP canon ; +VARIABLE b>IN +VARIABLE b#IN +: brefill ( -- ) 0 b>IN ! bbuf bufLen read 0 MAX b#IN ! ; +: bchar ( -- 0 | addr 1 ) b>IN @ b#IN @ >= IF brefill THEN + b>IN @ b#IN @ >= IF 0 ELSE bbuf b>IN @ + notty IF DUP C@ EMIT THEN 1 b>IN +! 1 THEN ; +: ACCEPT ( addr +n -- +n' ) OVER + TO &) TO [& [& TO &> BEGIN &> &) < WHILE + bchar IF C@ DUP &> ! 1 +TO &> A ( LF ) = IF &> TO &) THEN + ELSE &> TO &) THEN REPEAT &> [& - ; +\ : SAVE-INPUT ( -- xn ... x1 n ) >IN @ 1 ; +\ : RESTORE-INPUT ( xn ... x1 n -- flag ) 0 DO I IF DROP ELSE >IN ! >IN @ 0 #IN @ 1+ WITHIN THEN LOOP ; +\ : RESTORE-INPUT ( xn ... x1 n -- flag ) DUP 0<= IF 0 MAX ELSE RESTORE-INPUT THEN ; +: SAVE-INPUT ( -- xn ... x1 n ) 0 ; \ presently we have no text file input ... +: RESTORE-INPUT ( xn ... x1 n -- flag ) 0 ?DO DROP LOOP TRUE ; \ ... nor do we save lines of standard input + +\ Number conversion: Recognize 1-cell numbers, 2-cell numbers (ending with '.'), and non-numbers ("0-cell"). Parameter u is #cells. + +: >num ( -- ud u ) 0 0 [& &) OVER - >NUMBER NIP ( ud u ) IF 0 ELSE 2 THEN ; \ string bare, nonempty ; u = 0 or 2 only +: >num ( -- ud u ) [& &) < IF >num ELSE 0 0 0 THEN ; \ string bare ; u = 0 or 2 only +: dotted ( -- flag ) &) 1- C@ [CHAR] . = DUP IF 1 -TO &) THEN ; \ string nonempty +: dotted ( -- flag ) [& &) < IF dotted ELSE 0 THEN ; +: >num ( -- ud u ) dotted 0= >R >num R> IF 2/ THEN ; +: neg ( -- flag ) [& &) < IF [& C@ CASE + [CHAR] + OF 1 +TO [& 0 ENDOF + [CHAR] - OF 1 +TO [& FF ENDOF + 0 SWAP ENDCASE ELSE 0 THEN ; +: >num ( -- d u ) neg >num ( +/- ud u ) >R ROT IF DNEGATE THEN R> ; +: base! ( -- ) [& &) < IF [& C@ CASE + [CHAR] # OF 1 +TO [& DECIMAL ENDOF + [CHAR] $ OF 1 +TO [& HEX ENDOF + [CHAR] % OF 1 +TO [& 2 BASE ! ENDOF ENDCASE THEN ; +: >num ( -- d u ) BASE @ >R base! >num R> BASE ! ; +: cnum ( -- flag ) &) [& - 3 = DUP IF [& C@ [CHAR] ' = AND [& 1+ 1+ C@ [CHAR] ' = AND THEN ; +: >num ( addr u -- d u ) OVER + TO &) TO [& cnum IF [& 1+ C@ 0 1 ELSE >num THEN ; +\ TODO regex w/ capture groups ( addr u ) on the stack ? Outer pair of parens to determine match or not ? + +\ Forth interpreter \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: tib ( -- ) ." tib: #IN: " #IN @ N. ." ; >IN: " >IN @ N. ." ; '" TIB @ #IN @ TYPE ." '" CR ; \ show the TIB ( for debugging ) +: trynum ( addr u -- n | d | ) 2DUP >num CASE + 2 OF 0 err ! 2SWAP 2DROP STATE @ IF POSTPONE 2LITERAL THEN ENDOF + 1 OF 0 err ! 2SWAP 2DROP D>S STATE @ IF POSTPONE LITERAL THEN ENDOF + 0 OF 1 err ! 2DROP ." Error: no word or number " TYPE CR ENDOF ENDCASE ; +: INTERPRET ( -- ) BEGIN >IN @ #IN @ < WHILE PARSE-NAME + DUP IF fnd STATE @ 0= IF ABS THEN CASE + FF OF COMPILE, ENDOF + 1 OF EXECUTE ENDOF + 0 OF trynum err @ IF #IN @ >IN ! THEN ENDOF + ENDCASE ELSE 2DROP THEN REPEAT ; +: EVALUATE ( i*x addr u -- j*x ) + #IN @ >R TIB @ >R >IN @ >R source_id @ >R + #IN ! TIB ! 0 >IN ! FF source_id ! INTERPRET R> R> R> R> + #IN ! TIB ! >IN ! source_id ! ; +: REFILL ( -- flag ) 0 >IN ! kbuf TIB ! kbuf bufLen ACCEPT DUP #IN ! 0<> ; +RP@ CONSTANT RP0 +10000000 CONSTANT SP0 +: QUIT ( -- ) ( R: i*x -- ) 0 source_id ! RP0 [ 0 4 v 8 += ] + POSTPONE [ BEGIN REFILL WHILE INTERPRET STATE @ 0= IF ." ok" THEN CR REPEAT BYE ; +: ABORT ( i*x -- ) ( R: j*x -- ) SP0 [ 0 F v ] QUIT ; +: (abort) ( x addr u -- ) ROT IF TYPE ABORT ELSE 2DROP THEN ; +: ABORT" ( C: "ccc" -- ) ( i*x x -- | i*x ) ( R: j*x -- | j*x ) POSTPONE S" ['] (abort) COMPILE, ; IMMEDIATE +: DEFER ( "name" -- ) CREATE ['] ABORT , DOES> ( i*x -- j*x ) @ EXECUTE ; +: DEFER@ ( xt -- xt' ) >BODY @ ; \ DEFER DEFER@ DEFER! ACTION-OF IS are implemented ... +: DEFER! ( xt' xt -- ) >BODY ! ; \ ... as in https://forth-standard.org/standard/core/ +: ACTION-OF ( Compilation: "name" -- ) ( -- xt ) STATE @ IF POSTPONE ['] POSTPONE DEFER@ + ( Interpretation: "name" -- xt ) ELSE ' DEFER@ THEN ; IMMEDIATE +: IS ( Compilation: "name" -- ) ( xt -- ) STATE @ IF POSTPONE ['] POSTPONE DEFER! + ( Interpretation: xt "name" -- ) ELSE ' DEFER! THEN ; IMMEDIATE +: [DEFINED] ( C: "name" -- flag ) BL WORD FIND NIP 0<> ; IMMEDIATE \ as in https://forth-standard.org/standard/tools/BracketDEFINED +: [UNDEFINED] ( C: "name" -- flag ) BL WORD FIND NIP 0= ; IMMEDIATE \ as in https://forth-standard.org/standard/tools/BracketUNDEFINED +: [ELSE] ( -- ) \ used in Forth 2012 test harness \ as in https://forth-standard.org/standard/tools/BracketELSE + 1 BEGIN \ level + BEGIN BL WORD COUNT DUP WHILE \ level adr len + 2DUP S" [IF]" COMPARE 0= IF \ level adr len + 2DROP 1+ \ level' + ELSE \ level adr len + 2DUP S" [ELSE]" COMPARE 0= IF \ level adr len + 2DROP 1- DUP IF 1+ THEN \ level' + ELSE \ level adr len + S" [THEN]" COMPARE 0= IF \ level + 1- \ level' + THEN + THEN + THEN ?DUP 0= IF EXIT THEN \ level' + REPEAT 2DROP \ level + REFILL 0= UNTIL \ level + DROP +; IMMEDIATE +: [IF] ( flag -- ) 0= IF POSTPONE [ELSE] THEN ; IMMEDIATE \ as in https://forth-standard.org/standard/tools/BracketIF +: [THEN] ( -- ) ; IMMEDIATE \ as in https://forth-standard.org/standard/tools/BracketTHEN +: . ( n -- ) N. ; \ the usual Forth dot +QUIT \ start the Forth interpreter