| |
On Fri, Jan 30, 2004 at 08:47:41PM +0000, Ralph Hempel wrote:
> We just got between 60cm and 90 cm of fresh snow, so snowboarding
Lucky you! We had just some cm's and its all melting away today:(
Ok, here's a new version of SEE, WORDS and friends for pbforth 2.x (tested
on 2.1.5). First there are some words (Graphic? ... Head) which actually
exist in pbforth, but without name, meaning that the compiler can't find
them and we can't use them. Except for Head, I just copied the definitions
from the pbforth sources. Head is the head of the wordlist. The code below
attempts to grab the xt of the VARIABLE Head from IMMEDIATE; after the
definition there is a check whether this grab was successful. If it prints
'Head invalid!!!' while loading DO NOT use either WORDS or SEE!
Next comes some auxiliary stuff and then DUMP, WORDS, SEE. The same usage
notes apply as in my previous post, but because many words (in particular
branches and other internal stuff) are without names SEE'ing is not always
very informative:(
Oh, as an extra I threw in a version of . which prints large numbers only
signed when the base is decimal, and unsigned otherwise. I find .S a lot
more useful that way. If you don't like it you can remove (.) and . without
problems.
Another oh: DUMP refuses to dump more than 128 bytes at a time now. This
as a safety measure.
Ernst
------------------------------------------------------
DECIMAL
\ Print signed if decimal, unsigned otherwise.
: (.) ( n -- caddr n )
BASE @ 10 = IF DUP ABS S>D <# #S ROT SIGN #>
ELSE 0 <# #S #>
THEN ;
: . ( n -- ) (.) TYPE SPACE ; \ CORE
: Graphic? ( ch -- flag ) BL 127 WITHIN ;
: L>Name ( linkfield& -- namefield& ) CELL+ ;
: >Name ( codefield& -- namefield& )
[ -1 CHARS ] LITERAL +
BEGIN
[ -1 CHARS ] LITERAL +
DUP C@ UNTIL
DUP C@ CHARS - ;
: Name> ( namefield& -- codefield& )
BEGIN CHAR+ DUP C@ BL < UNTIL CHAR+ CHAR+ ALIGNED ;
: N>Link ( namefield& -- linkfield& ) [ 1 CELLS NEGATE ] LITERAL + ;
: Head ( -- addr )
[ ' IMMEDIATE 3 CELLS + @ ] LITERAL EXECUTE ;
Head @ ' Head = 0= IF ABORT" Head invalid!!!"
: Name# (namefield& -- count ) BEGIN CHAR+ DUP C@ BL < UNTIL C@ ;
: COUNT> ( addr -- addr count ) DUP Name# ;
: .name ( addr -- ) COUNT> TYPE SPACE ;
\ Search through the wordlist for the name of the given codefield
: >Name? ( codefield& -- namefield&|0 )
>R
Head @ >Name N>Link
BEGIN DUP
WHILE DUP L>Name Name> R@ = IF L>Name R> DROP EXIT THEN
@
REPEAT R> DROP ;
: enough? DUP 0= ; ( x -- x flag )
: C@++ ( c-addr -- next-c-addr x ) DUP CHAR+ SWAP C@ ;
: @++ ( a-addr -- next-a-addr x ) DUP CELL+ SWAP @ ;
: .S ( -- ) \ TOOLS
DEPTH ?DUP IF BEGIN DUP 0 >
WHILE DUP PICK . 1-
REPEAT DROP
THEN ;
: C.dump ( ch -- )
DUP Graphic? 0= IF DROP [CHAR] . THEN EMIT ;
\ DUMP ( addr u -- ) \ TOOLS
\ Display the contents of u consecutive address units starting
\ at addr.
\
: DUMP DUP 0 128 WITHIN 0= IF ABORT" Length out of range" THEN
BASE @ >R HEX
1- 16 / 1+
0 DO CR DUP DUP 0 <# # # # # #> TYPE SPACE SPACE
16 0 DO DUP C@ 0 <# # # #> TYPE SPACE CHAR+ LOOP
SPACE SWAP
16 0 DO DUP C@ C.dump CHAR+
LOOP DROP
enough? IF LEAVE THEN
LOOP
R> BASE ! ;
\ WORDS ( -- ) \ TOOLS
\ List the definition names in the first wordlist of the
\ search order.
: WORDS
Head @ >Name N>Link
CR 0 >R
BEGIN ?DUP
WHILE DUP L>Name .name R> 1+ >R
@
REPEAT SPACE R> . ." words " ;
\ (see) ( a-addr1 -- )
\ List the words called from a-addr1 onwards upto the next EXIT,
\ preceded by the address, and literal bytes.
: (see) ( a-addr1 - )
BASE @ >R HEX
BEGIN CR 3 SPACES
DUP S>D <# # # # # #> TYPE 2 SPACES \ addr
DUP C@++ S>D <# # # #> TYPE SPACE
C@ S>D <# # # #> TYPE 2 SPACES \ xx xx
DUP C@++ C.dump
C@ C.dump 2 SPACES \ ch ch
@++ DUP >Name? ?DUP IF .name THEN \ word
['] EXIT =
UNTIL
DROP
R> BASE ! ;
\ SEE ( " name" -- ) \ TOOLS
\ List the definition of name, upto the first EXIT.
\ The remainder can be seen by using (see).
: SEE ( " name" -- )
'
DUP @ ['] (see) @ = 0= ABORT" Not a : word"
DUP >Name ." : " .name
DUP [ -1 CHARS ] LITERAL + C@ IF ." IMMEDIATE" THEN
CELL+ (see) CR ;
--
Ernst de Ridder - hnridder@informatik.uni-rostock.de
Universitaet Rostock - Lehrstuhl fuer Theoretische Informatik
Albert Einstein Str. 21 - D-18051 Rostock - Germany
http://wwwteo.informatik.uni-rostock.de/~hnridder
|
|
Message is in Reply To:
 | | RE: WORDLIST
|
| I should help with this tooo, maybe this weekend. Sigh. We just got between 60cm and 90 cm of fresh snow, so snowboarding and shovelling will be the primary activities, unless the roads are closed - which does happen frequently... Ralph (...) (21 years ago, 30-Jan-04, to lugnet.robotics.rcx.pbforth)
|
14 Messages in This Thread:
 
  
- Entire Thread on One Page:
- Nested:
All | Brief | Compact | Dots
Linear:
All | Brief | Compact
|
|
|
|
