version 1.5, 1994/05/07 14:55:58
|
version 1.7, 1994/06/01 10:05:18
|
Line 131 Defer source
|
Line 131 Defer source
|
dup count chars bounds |
dup count chars bounds |
?DO I c@ toupper I c! 1 chars +LOOP ; |
?DO I c@ toupper I c! 1 chars +LOOP ; |
: (name) ( -- addr ) bl word ; |
: (name) ( -- addr ) bl word ; |
|
: (cname) ( -- addr ) bl word capitalize ; |
|
|
\ Literal 17dec92py |
\ Literal 17dec92py |
|
|
Line 254 hex
|
Line 255 hex
|
handler @ >r |
handler @ >r |
rp@ handler ! |
rp@ handler ! |
execute |
execute |
r> handler ! rdrop rdrop 0 ; |
r> handler ! rdrop rdrop rdrop 0 ; |
|
|
: throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) |
: throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) |
?DUP IF |
?DUP IF |
handler @ rp! |
handler @ rp! |
Line 263 hex
|
Line 265 hex
|
r> fp! |
r> fp! |
r> swap >r sp! r> |
r> swap >r sp! r> |
THEN ; |
THEN ; |
|
|
\ Bouncing is very fine, |
\ Bouncing is very fine, |
\ programming without wasting time... jaw |
\ programming without wasting time... jaw |
: bounce ( y1 .. ym error/0 -- y1 .. ym error / y1 .. ym ) |
: bounce ( y1 .. ym error/0 -- y1 .. ym error / y1 .. ym ) |
Line 592 AVariable current
|
Line 595 AVariable current
|
|
|
\ word list structure: |
\ word list structure: |
\ struct |
\ struct |
\ 1 cells: field find-method \ xt: ( c_addr u w1 -- name-id ) w1 is a method-\ specific wordlist-id (not the same as wid) |
\ 1 cells: field find-method \ xt: ( c_addr u wid -- name-id ) |
\ 1 cells: field reveal-method \ xt: ( -- ) |
\ 1 cells: field reveal-method \ xt: ( -- ) |
|
\ 1 cells: field rehash-method \ xt: ( wid -- ) |
\ \ !! what else |
\ \ !! what else |
\ end-struct wordlist-map-struct |
\ end-struct wordlist-map-struct |
|
|
\ struct |
\ struct |
\ 1 cells: field wordlist-id \ not the same as wid; representation depends on implementation |
\ 1 cells: field wordlist-id \ not the same as wid; representation depends on implementation |
\ 1 cells: field wordlist-map \ pointer to a wordlist-map-struct |
\ 1 cells: field wordlist-map \ pointer to a wordlist-map-struct |
\ 1 cells: field ???? |
\ 1 cells: field wordlist-link \ link field to other wordlists |
\ 1 cells: field ???? |
\ 1 cells: field wordlist-extend \ points to wordlist extensions (eg hash) |
\ end-struct wordlist-struct |
\ end-struct wordlist-struct |
|
|
|
: f83find ( addr len wordlist -- nfa / false ) @ (f83find) ; |
|
: f83casefind ( addr len wordlist -- nfa / false ) @ (f83casefind) ; |
|
|
\ Search list table: find reveal |
\ Search list table: find reveal |
Create f83search ' (f83find) A, ' (reveal) A, |
Create f83search ' f83casefind A, ' (reveal) A, ' drop A, |
|
|
|
: caps-name ['] (cname) IS name ['] f83find f83search ! ; |
|
: case-name ['] (name) IS name ['] f83casefind f83search ! ; |
|
: case-sensitive ['] (name) IS name ['] f83find f83search ! ; |
|
|
Create forth-wordlist NIL A, G f83search T A, NIL A, NIL A, |
Create forth-wordlist NIL A, G f83search T A, NIL A, NIL A, |
AVariable search G forth-wordlist search T ! |
AVariable search G forth-wordlist search T ! |
G forth-wordlist current T ! |
G forth-wordlist current T ! |
|
|
: (search-wordlist) ( addr count wid -- nfa / false ) |
: (search-wordlist) ( addr count wid -- nfa / false ) |
dup @ swap cell+ @ @ execute ; |
dup ( @ swap ) cell+ @ @ execute ; |
|
|
: search-wordlist ( addr count wid -- 0 / xt +-1 ) |
: search-wordlist ( addr count wid -- 0 / xt +-1 ) |
(search-wordlist) dup IF found THEN ; |
(search-wordlist) dup IF found THEN ; |
Line 642 Variable warnings G -1 warnings T !
|
Line 653 Variable warnings G -1 warnings T !
|
then |
then |
current @ cell+ @ cell+ @ execute ; |
current @ cell+ @ cell+ @ execute ; |
|
|
|
: rehash ( wid -- ) dup cell+ @ cell+ cell+ @ execute ; |
|
|
: ' ( "name" -- addr ) name find 0= no.extensions ; |
: ' ( "name" -- addr ) name find 0= no.extensions ; |
: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate |
: ['] ( "name" -- addr ) ' postpone ALiteral ; immediate |
\ Input 13feb93py |
\ Input 13feb93py |
Line 779 create nl$ 1 c, A c, 0 c, \ gnu includes
|
Line 792 create nl$ 1 c, A c, 0 c, \ gnu includes
|
|
|
\ INCLUDE 9may93jaw |
\ INCLUDE 9may93jaw |
|
|
: include |
: include ( "file" -- ) |
bl word count included ; |
bl word count included ; |
|
|
\ RECURSE 17may93jaw |
\ RECURSE 17may93jaw |
|
|