forth/test/libs.fth · 5832 字节 · 下载原文

\ 共享库一览 —— 用 **Forth** 把四个共享库各叫一遍
\ Shared libraries tour -- calling all four shared libraries from **Forth**
\
\ ◆ 这份例程在练什么
\ ◆ What this example exercises
\
\ 共享库是**一次投入、22 门语言都受益**的那种东西：`regex`（正则）· `dbf`（dBASE 数据文件）
\ · `sql`（跑在 .dbf 上的查询）· `turtle`（海龟作图）。它们**不是 Forth 的库**，
\ 而是每一门语言都能调的同一份实现 —— 这份例程就是"从 Forth 这边调得动"的活证据。
\ The shared libraries are one investment serving all 22 languages: `regex`, `dbf` (dBASE data
\ files), `sql` (queries over .dbf) and `turtle`. They are not Forth libraries -- they are one
\ implementation every language can call. This example is the living proof that Forth can.
\
\   regex  : 模式 `abc` 在 `xxabcyy` 里**找得到**吗（1 = 找得到）
\   dbf    : 现建一张两字段的表、塞两条记录，再看一眼记录数
\   sql    : 在刚建的那张表上跑一句 `SELECT ... WHERE`
\   turtle : 抬笔走 50 步，看它的坐标（不写屏幕，所以**不需要开窗口**）
\
\ ◆ ⚠ 两条 Forth 特有的规矩（实测；写错了**不报错，只是结果不对**）
\ ◆ (!) Two Forth-specific rules (measured; getting either wrong **raises no error, the result
\     is just wrong**)
\
\   ① `S" …"` 压的是 **(地址, 长度) 两个单元**（标准 Forth 如此），而共享库要的是
\   1. `S" ..."` pushes **(address, length) -- two cells** (standard Forth behavior), while the
\      shared library wants the plain C pointer. So the length must be `DROP`ped:
\          S" xxabcyy" DROP S" abc" DROP re_test      ✅ ⇒ 1
\          S" xxabcyy"      S" abc"      re_test      ❌ ⇒ 0   （长度顶到指针的位置上）
\      ⇒ 少一个 `DROP`，宿主机收到的是一个长度数字，**问不出错、只是回一个错答案**。
\      => without the DROP the host receives a length as the pointer: no error is raised, it just
\         answers the wrong thing.
\
\   ② **实参顺序是反的**：最后压栈的 = C 的第 1 个实参 ⇒ **先压后面的实参**。
\   2. **The argument order is reversed**: the last value pushed is C's first argument, so push
\      the later arguments first.
\      C 里写 `dbf_put(h, rec, 0, "Alice")`，这里得写成
\      C writes `dbf_put(h, rec, 0, "Alice")`; here it is
\          S" Alice" DROP 0 REC @ H @ dbf_put DROP
\      （注意最后压的是 `H @`，也就是 C 的第 1 个实参 `h`）。
\      (note that `H @` -- C's first argument `h` -- goes last).
\
\ ◆ 为什么全程只调"返回整数"的那些接口
\ ◆ Why only the integer-returning calls
\
\ Forth 的字符串字面量**取不到可写地址**，而 `dbf_get` / `sql_cell` 这类要调用方给 dst。
\ 所以这里走另一条路：**要缓冲区的地方用 `alloc` 自己拿一块**（见下面 `REC` 那几行），
\ 取值一律用"只问长度"的形态（`dbf_fname(h, 0, 0)`）。
\ Forth string literals give no writable address, and `dbf_get`/`sql_cell` need a caller-supplied
\ dst. So: take a buffer yourself with `alloc` (see the `REC` lines below), and use the
\ "length only" form of the accessors (`dbf_fname(h, 0, 0)`).
\
\ ⚠ 跑一次会在**本文件所在目录**建一个 `libdemo.dbf`（这就是 dbf 那一半在演示的事）。
\ ⚠ Running this creates a small `libdemo.dbf` **next to this file** -- that is the point of it.

VARIABLE H
VARIABLE REC

\ ── regex：模式匹配 ──
." REGEX_HIT=" S" xxabcyy" DROP S" abc" DROP re_test . CR
." REGEX_MISS=" S" xxabxyy" DROP S" abc" DROP re_test . CR
." REGEX_VALID=" S" (a|b)+" DROP re_is_valid . CR

\ ── dbf：建表 → 塞两条 → 读记录数 ──
\ 字段类型用**字符的字节值**：'C' = 67（字符型）· 'N' = 78（数字型）——
\ Forth 没有字符字面量，所以这里直接写数字。
\ Field types are the **byte value of the character**: 'C' = 67, 'N' = 78 -- Forth has no
\ character literal, so the number goes in directly.
S" libdemo.dbf" DROP dbf_new H !
0 8 67 S" NAME" DROP H @ dbf_addfield DROP
0 3 78 S" AGE" DROP H @ dbf_addfield DROP
H @ dbf_build DROP

64 alloc REC !
REC @ H @ dbf_mkrec DROP
S" Alice" DROP 0 REC @ H @ dbf_put DROP
S" 30" DROP 1 REC @ H @ dbf_put DROP
REC @ H @ dbf_add DROP
REC @ H @ dbf_mkrec DROP
S" Bob" DROP 0 REC @ H @ dbf_put DROP
S" 7" DROP 1 REC @ H @ dbf_put DROP
REC @ H @ dbf_add DROP
H @ dbf_flush DROP

." DBF_ROWS=" H @ dbf_records . CR
." DBF_FIELDS=" H @ dbf_fields . CR
." DBF_FIELD0_LEN=" 0 0 H @ dbf_fname . CR
H @ dbf_close DROP

\ ── sql：在刚建的表上查 ──
." SQL_ROWS=" S" SELECT * FROM t WHERE AGE > 20" DROP S" libdemo.dbf" DROP sql_run . CR
." SQL_COLS=" sql_cols . CR
." SQL_COL0_LEN=" 0 0 sql_colname . CR

\ ── turtle：抬笔走 50 步（落笔会去画屏幕，那要窗口）──
\ 这三个返回 void（不留值在栈上），所以后面**不加** `DROP`。
\ These three return void (nothing left on the stack), so **no** `DROP` follows.
turtle_reset
turtle_pen_up
50 turtle_forward
." TURTLE_X=" turtle_x . CR
." TURTLE_Y=" turtle_y . CR

\ ── sed：sed 的替换规则（s / y 两条命令，依附 regex 库）—— 缓冲区那一半只有 C 拿得到，
\    这里压的是「只问长度」那一支（cap 传 0）与对账用的 sed_count。
." SED_COUNT=" S" banana" DROP S" s/a/X/g" DROP sed_count . CR
." SED_LEN=" 0 0 S" banana" DROP S" s/a/X/g" DROP sed_sub . CR
." DONE=" 1 . CR

\ 期望（scripts/lib-examples-check.sh 按这一行比对）：
\ EXPECT: REGEX_HIT=1|REGEX_MISS=0|REGEX_VALID=1|DBF_ROWS=2|DBF_FIELDS=2|DBF_FIELD0_LEN=4|SQL_ROWS=1|SQL_COLS=2|SQL_COL0_LEN=4|TURTLE_X=0|TURTLE_Y=50|SED_COUNT=3|SED_LEN=6|DONE=1