--- /dev/null
+# 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<char>" -- 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 ( "<spaces>ccc<space>" -- 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<eol>" -- ) 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<rparen>" -- ) 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 ################ : ( "<spaces>ccc<space>" -- ) 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
--- /dev/null
+# 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<char>" -- 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 ( "<spaces>ccc<space>" -- 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<eol>" -- ) 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<rparen>" -- ) 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 ################ : ( "<spaces>ccc<space>" -- ) 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
--- /dev/null
+<!DOCTYPE html>
+<!-- saved from url=(0031)https://dacvs.neocities.org/SF/ -->
+<html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+
+<title>SmithForth</title>
+</head>
+
+<body>
+<h1>A Forth for x86-64 personal computers</h1>
+
+<p>
+</p><pre><a href="https://dacvs.neocities.org/">David Smith</a> 2022 david.a.c.v.smith@gmail.com</pre>
+<p></p>
+
+<p>
+</p><ul>
+<li>SmithForth runs on Linux x86-64 systems.</li>
+<li>I believe some other Unix x86-64 systems can run Linux ELF binaries. SmithForth should run on these.</li>
+<li>SmithForth should run on your Windows system if you have installed the Windows Subsystem for Linux. I haven't tried it.</li>
+</ul>
+<p></p>
+
+<h2>SmithForth design</h2>
+
+<p>
+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.
+</p>
+
+<p>
+You can use SmithForth as you would use any other standard Forth system.
+SmithForth follows the <a href="https://forth-standard.org/">the Forth standard of 2012</a>.
+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.
+ </p>
+
+<p>
+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 <a href="https://software.intel.com/content/www/us/en/develop/articles/intel-sdm.html">Intel manual</a> is our source of information on the x86 architecture.
+</p>
+
+<p>
+We use none of the usual tools from the world of C, not even an assembler.
+SmithForth is implemented in two source files:
+</p><ol>
+<li><b><a href="https://dacvs.neocities.org/SF/SForth220711dmp.txt">SForth.dmp</a></b> contains a primitive Forth system in 1000 hand-written bytes of annotated machine code.</li>
+<li><b><a href="https://dacvs.neocities.org/SF/system220711fs.txt">system.fs</a></b> contains 1000 lines of system Forth to complete a standard Forth system.</li>
+</ol>
+<p></p>
+
+<h2>How to run SmithForth</h2>
+
+<ol>
+
+<li>
+<h3>Combine SForth.dmp and system.fs into one binary file.</h3>
+<p>
+Machine code is converted from a human-readable format "DMP" to binary by <kbd>xxd</kbd>
+(hex dump) <kbd>-r</kbd> (reverse).
+</p><pre><kbd>$ cut -d'#' -f1 SForth.dmp | xxd -p -r > SForth
+$ cat system.fs >> SForth
+</kbd></pre>
+The Forth source text is grafted onto the binary.
+<p></p>
+</li>
+
+<li>
+<h3>Turn the binary file into a proper executable.</h3>
+<p>
+Grant permission to execute the file on the Linux system.
+</p><pre><kbd>$ chmod +x SForth</kbd></pre>
+You should now have a working executable (if your system is similar enough to mine).
+<p></p>
+<p>
+(<i>Optional:</i>)
+Advanced users might edit the kernel or system.fs.
+You must ensure that the ELF segment header entry <kbd>p_filesz</kbd> contains the number of bytes of the segment that appear in binary file <kbd>SForth</kbd>.
+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:
+</p><ol>
+<li>Make the binary as above. Don't run the binary yet.</li>
+<li>Ask the system for the size of the binary file. <!-- with <kbd>wc -c</kbd>, for example.--></li>
+<li>Write the result into field <kbd>p_filesz</kbd> of <kbd>dmqc.dmp</kbd>.</li>
+<li>Remake the binary. The binary is ready to run.</li>
+</ol>
+<p></p>
+<p>
+My script <a href="https://dacvs.neocities.org/SF/make220711sh.txt">make.sh</a> does these steps automatically:
+</p><pre><kbd>$ ./make.sh # <em>if and only if you modified SForth.dmp or system.fs</em></kbd></pre>
+<p></p>
+</li>
+
+<li>
+<h3>Run the SmithForth executable.</h3>
+<p>
+You can use SmithForth interactively, or you can feed your program into the standard input stream.
+</p><pre><kbd>$ ./SForth
+$ ./SForth < YourProgram.fs
+$ cat YourProgram.fs - | ./SForth
+</kbd></pre>
+The last command allows you to use SmithForth interactively after your programs.
+<p></p>
+
+</li></ol>
+
+<hr>
+<h2>Numbers in machines</h2>
+
+If you aren't an experienced programmer, here are some things to know before you read the DMP source file.
+
+<h3>Hexadecimal</h3>
+Numbers in machine-code listings are often written in hexadecimal,
+the base-sixteen number system with numerals 0123456789ABCDEF. In
+hexadecimal, the nonnegative integers are:
+<blockquote>
+0, 1, 2, ..., 9, A, B, C, D, E, F, 10, 11, ..., 1F, 20, ..., FF, 100, 101, ...
+</blockquote>
+
+<h3>Bytes</h3>
+A byte is eight bits. The eight bits of a byte have 2<sup>8</sup> different states,
+but our alphabet has fewer symbols. Instead we write these
+states in base sixteen (=2<sup>4</sup>) using a pair of hexadecimal numerals. The
+states of a byte are:
+<blockquote>
+ 00, 01, 02, ..., FE, FF.
+</blockquote>
+
+<h3>Binary</h3>
+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:
+<blockquote>
+ 3E hexadecimal = 0011 1110 binary,
+</blockquote>
+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:
+<blockquote>
+ 11 111 000.
+</blockquote>
+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:
+<blockquote>
+ 1111 1000 binary = F8 hexadecimal (as 1111 = F and 1000 = 8).
+</blockquote>
+
+<h3>Endianness</h3>
+In hexadecimal, and in our usual decimal system, numbers with more than one
+numeral are written with more significant numerals first:
+<ul>
+ <li>Decimal has hundreds before tens before ones.</li>
+ <li>Hexadecimal has two hundred fifty-sixes before sixteens before ones.</li>
+</ul>
+Such systems are <em>big-endian</em>. <em>Little-endian</em> is the reverse order, with
+less significant numerals first.
+
+<h3>The little-endian x86</h3>
+<p>
+The x86 architecture is <b>little-endian in bytes</b> (that is, little-endian in base 2<sup>8</sup>) ...
+</p><blockquote>
+When an integer is moved from a CPU register into memory, for example, the
+least significant byte appears first in memory.
+</blockquote>
+... but each byte is written as a <b>big-endian pair</b> of hexadecimal numerals.
+This custom is observed:
+<ul>
+ <li>in Intel's manuals,</li>
+ <li>in the output of tools (like xxd) that convert binary files to text, and</li>
+ <li>in the input of tools that convert text (like our DMP file) to binary files.</li>
+</ul>
+For example,
+<ul>
+ <li>hexadecimal 12 is eighteen,</li>
+ <li>hexadecimal 12 00 is eighteen (= 0012 big-endian), and</li>
+ <li>hexadecimal 12 00 00 00 is eighteen (= 00000012 big-endian).</li>
+</ul>
+
+<h3>Machine arithmetic is modular</h3>
+<p>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 2<sup>8</sup>. However, some operations involve a particular representative
+of a congruence class.
+</p>
+
+<p>
+Two rules are commonly used to select a representative. They are:
+</p><ol>
+ <li><b>unsigned</b>, where the representatives are
+ <blockquote>
+ 0, 1, 2, ..., modulus - 1, and
+ </blockquote></li>
+ <li><b>signed</b>, where the representatives are
+ <blockquote>
+ 0, 1, ..., modulus/2 - 1, (<em>nonnegative</em>) and
+ </blockquote>
+ <blockquote>
+ -1, -2, ..., modulus/2 (<em>negative</em>);
+ </blockquote>
+ but the machine has no "minus sign," so instead we use
+ <blockquote>
+ modulus - 1, modulus - 2, ..., modulus/2 (<em>negative</em>).
+ </blockquote></li>
+</ol>
+<p></p>
+
+<p>
+For example, if the modulus is 2<sup>8</sup>, the signed representatives are
+</p><blockquote>
+ 00, 01, ..., 7F, (nonnegative)
+ FF, FE, ..., 80 (negative).
+</blockquote>
+We can tell negative from nonnegative by the most significant bit.
+<ul>
+ <li>Nonnegatives have most significant bit 0.</li>
+ <li>Negatives have most significant bit 1.</li>
+</ul>
+Watch for "unsigned" and "signed" in the Intel manual.
+<p></p>
+
+<h2>Implementing Forth</h2>
+If you aren't an experienced Forth programmer, here are some things to know before you read the Forth system file.
+
+<h3>Conditionals</h3>
+<p>
+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.
+</p>
+
+<p>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.
+</p><pre><kbd>: X ... flag IF ... ( do this if flag is nonzero ) ... THEN ... ;
+ \ /
+ -->-- ( skip to THEN if flag is zero ) ---->---
+</kbd></pre>
+<p></p>
+
+<p>
+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.
+</p>
+
+<p>
+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, <em>past THEN</em> in this case. However, when the compiler
+first sees IF, it has not yet seen any THEN. So the plan is:
+</p><ol>
+<li>Upon IF, reserve space in the compiler's output for instruction JZ and produce (push) a reference.</li>
+<li>Continue compiling as usual.</li>
+<li>Upon THEN, consume (pop) a reference and finish formulating instruction JZ.
+In the Forth standard, this is <em>resolving a forward reference</em>.
+</li>
+</ol>
+<p></p>
+
+<p>
+Forth implements this plan by using the data stack during compilation:
+</p><ul>
+<li>IF ( flag -- ) Compilation: ( -- orig ) ... ;</li>
+<li>THEN ( -- ) Compilation: ( orig -- ) ... ;</li>
+</ul>
+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.
+<p></p>
+
+<h3>Loops</h3>
+<p>
+Forth offers several ways to write loops.
+One is BEGIN-WHILE-REPEAT.
+</p><pre><kbd> --------------------------------<---------------------------
+ / \
+: X ... BEGIN ... flag WHILE ... ( do this if flag is nonzero ) ... REPEAT ... ;
+ \ /
+ --->-- ( skip to REPEAT if flag is zero ) ---->----
+</kbd></pre>
+<ul>
+<li>BEGIN ( -- ) Compilation: ( -- dest ) ... ;</li>
+<li>WHILE ( flag -- ) Compilation: ( dest -- orig dest ) ... ;</li>
+<li>REPEAT ( -- ) Compilation: ( orig dest -- )</li>
+</ul>
+BEGIN-WHILE-REPEAT is versatile, allowing to exit from the middle of a loop body.
+BEGIN-WHILE-REPEAT can emulate other control structures:
+<dl>
+<dt>IF-THEN:</dt> <dd>flag BEGIN WHILE ... 0 REPEAT</dd>
+<dt>IF-ELSE-THEN:</dt> <dd>flag DUP BEGIN WHILE DROP ... 1 0 REPEAT 0= BEGIN WHILE ... 0 REPEAT</dd>
+<dt>BEGIN-UNTIL:</dt> <dd>BEGIN ... flag 0= WHILE REPEAT</dd>
+</dl>
+<p></p>
+
+<hr>
+
+<h2>Simpler software</h2>
+<p>
+Here are my opinions and motivations for this project.
+<b>Forth</b> 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:
+</p><ul>
+<li>features found in most programming languages:
+ <ul>
+ <li>conditionals (if-else)</li>
+ <li>loops</li>
+ <li>variables</li>
+ <li>user-defined functions</li>
+ </ul>
+</li>
+<li>and more:
+ <ul>
+ <li>CREATE</li>
+ <li>DOES></li>
+ </ul>
+</li>
+</ul>
+<p></p>
+
+<p>
+A good system helps us to solve our problems quickly.
+Some systems try to be comprehensive.
+<!-- , providing easy solutions to many problems.
+This may work when our problems are like everyone else's problems. -->
+<!-- Another approach is to gather a collection of -->
+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:
+</p><ul>
+<li>in our daily work, we are allowed to focus on a small number of layers, and</li>
+<li>each layer is well documented,</li>
+</ul>
+but this has not been my experience.
+C is intentionally vague about the dimensions of machines -- <em>an irritation the programmer</em> -- so that programs are portable -- <em>a feature I never use</em>.
+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
+<a href="https://www.youtube.com/playlist?list=PLZCIHSjpQ12woLj0sjsnqDH8yVuXwTy3p">my video series</a> on that topic.
+<p></p>
+
+<p>
+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.
+</p>
+
+<p>
+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.
+</p>
+
+<p>
+I believe SmithForth is a good first Forth to learn and a good first programming environment.
+The shortened presentation may appeal to mathematicians.
+</p>
+
+<p>
+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.
+</p>
+
+
+
+</body></html>
\ No newline at end of file
--- /dev/null
+#!/bin/sh
+
+cut -d'#' -f1 SForth.dmp | xxd -p -r > SForth
+cat system.fs >> SForth
+chmod +x SForth
--- /dev/null
+\ 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 ( "<spaces>name<space>" -- addr u ) pname [ F0 += 8 5 ^ 0 0 ^ ] ;
+: PARSE ( char "ccc<char>" -- addr u ) DUP 1+ [ 8 1 v 0 2 v ] PARSE [ 8 5 ^ 0 0 ^ ] ;
+: ' ( "<spaces>ccc" -- xt ) pname FIND [ F8 += 0 3 ^ ] ; \ Tick
+: CHAR ( "<spaces>name" -- char ) PARSE-NAME DROP C@ ;
+: (forget) ( xt -- ) [ 0 7 v ] CELL+ @ latest ! ;
+: FORGET ( "<spaces>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] ( "<spaces>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: "<spaces>name" -- ) ( -- char ) CHAR [COMPILE] LITERAL ; IMMEDIATE \ BracketChar
+: ['] ( C: "<spaces>name" -- ) ( -- xt ) ' [COMPILE] LITERAL ; IMMEDIATE \ BracketTick
+: POSTPONE ( "<spaces>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<quote>" -- ) ( -- addr ) ever jump [CHAR] " PARSE HERE >R DUP C, s, land R> POSTPONE LITERAL ; IMMEDIATE
+: S" ( C: "ccc<quote>" -- ) ( -- addr u ) POSTPONE C" ['] COUNT COMPILE, ; IMMEDIATE
+: ." ( C: "ccc<quote>" -- ) ( -- ) POSTPONE S" ['] TYPE COMPILE, ; IMMEDIATE
+: .( ( "ccc<rparen>" -- ) [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 ( "<spaces>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 ( "<spaces>name" -- ) CREATE latest @ , DOES> @ (forget) ;
+: VARIABLE ( "<spaces>name" -- ) CREATE 0 , ;
+: 2VARIABLE ( "<spaces>name" -- ) CREATE 0 , 0 , ;
+: BUFFER: ( u "<spaces>name" -- ) CREATE ALLOT ;
+VARIABLE BASE
+: DECIMAL ( -- ) A BASE ! ;
+: HEX ( -- ) 10 BASE ! ; HEX
+: CONSTANT ( x "<spaces>name" -- ) CREATE , DOES> @ ;
+: 2CONSTANT ( x y "<spaces>name" -- ) CREATE , , DOES> 2@ ;
+: VALUE ( x "<spaces>name" -- ) CREATE 0 ( id ) latest @ >BODY 1- C! , DOES> @ ;
+: 2VALUE ( x y "<spaces>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 "<spaces>name" -- ) STATE @ IF ' POSTPONE LITERAL ['] (to) COMPILE,
+ ( C: "<spaces>name" -- ) ELSE ' (to) THEN ; IMMEDIATE
+: (+to) ( i*x xt -- ) >BODY DUP 1- C@ IF 2+! ELSE +! THEN ;
+: +TO ( i*x "<spaces>name" -- ) STATE @ IF ' POSTPONE LITERAL ['] (+to) COMPILE,
+ ( C: "<spaces>name" -- ) ELSE ' (+to) THEN ; IMMEDIATE
+: (-to) ( i*x xt -- ) >BODY DUP 1- C@ IF 2-! ELSE -! THEN ;
+: -TO ( i*x "<spaces>name" -- ) STATE @ IF ' POSTPONE LITERAL ['] (-to) COMPILE,
+ ( C: "<spaces>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 ( "<spaces>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<quote>" -- ) ( -- 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 "<chars>ccc<char>" -- 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<quote>" -- ) ( i*x x -- | i*x ) ( R: j*x -- | j*x ) POSTPONE S" ['] (abort) COMPILE, ; IMMEDIATE
+: DEFER ( "<spaces>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: "<spaces>name" -- ) ( -- xt ) STATE @ IF POSTPONE ['] POSTPONE DEFER@
+ ( Interpretation: "<spaces>name" -- xt ) ELSE ' DEFER@ THEN ; IMMEDIATE
+: IS ( Compilation: "<spaces>name" -- ) ( xt -- ) STATE @ IF POSTPONE ['] POSTPONE DEFER!
+ ( Interpretation: xt "<spaces>name" -- ) ELSE ' DEFER! THEN ; IMMEDIATE
+: [DEFINED] ( C: "<spaces>name" -- flag ) BL WORD FIND NIP 0<> ; IMMEDIATE \ as in https://forth-standard.org/standard/tools/BracketDEFINED
+: [UNDEFINED] ( C: "<spaces>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
projects / proto / forth.git / commitdiff