'SPACE' -> BL (standard FORTH word)
authorrich <rich>
Sat, 29 Sep 2007 23:13:45 +0000 (23:13 +0000)
committerrich <rich>
Sat, 29 Sep 2007 23:13:45 +0000 (23:13 +0000)
Lots of replacements to use ?DUP.
Removed DOES> (not possible in this FORTH).
Added Z" .." for ASCIIZ strings.
Added a number of Linux syscalls.
Added a notes section.

jonesforth.f

index 3c62f34dcfce938b80cec795f161b17f2e8ae08c..711cf8521930c2d17146ad73c2467805cd550531 100644 (file)
@@ -2,7 +2,7 @@
 \      A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*-
 \      By Richard W.M. Jones <rich@annexia.org> http://annexia.org/forth
 \      This is PUBLIC DOMAIN (see public domain release statement below).
-\      $Id: jonesforth.f,v 1.10 2007-09-29 16:06:27 rich Exp $
+\      $Id: jonesforth.f,v 1.11 2007-09-29 23:13:45 rich Exp $
 \
 \      The first part of this tutorial is in jonesforth.S.  Get if from http://annexia.org/forth
 \
 : MOD /MOD DROP ;
 
 \ Define some character constants
-: '\n'   10 ;
-: 'SPACE' 32 ;
+: '\n' 10 ;
+: BL   32 ; \ BL (BLank) is a standard FORTH word for space.
 
 \ CR prints a carriage return
 : CR '\n' EMIT ;
 
 \ SPACE prints a space
-: SPACE 'SPACE' EMIT ;
+: SPACE BL EMIT ;
 
 \ DUP, DROP are defined in assembly for speed, but this is how you might define them
 \ in FORTH.  Notice use of the scratch variables _X and _Y.
 ( This is the underlying recursive definition of U. )
 : U.           ( u -- )
        BASE @ /MOD     ( width rem quot )
-       DUP 0<> IF      ( if quotient <> 0 then )
+       ?DUP IF                 ( if quotient <> 0 then )
                RECURSE         ( print the quotient )
-       ELSE
-               DROP            ( drop the zero quotient )
        THEN
 
        ( print the remainder )
 ( This word returns the width (in characters) of an unsigned number in the current base )
 : UWIDTH       ( u -- width )
        BASE @ /        ( rem quot )
-       DUP 0<> IF      ( if quotient <> 0 then )
+       ?DUP IF         ( if quotient <> 0 then )
                RECURSE 1+      ( return 1+recursive call )
        ELSE
-               DROP            ( drop the zero quotient )
                1               ( return 1 )
        THEN
 ;
 : WORDS
        LATEST @        ( start at LATEST dictionary entry )
        BEGIN
-               DUP 0<>         ( while link pointer is not null )
+               ?DUP            ( while link pointer is not null )
        WHILE
                DUP ?HIDDEN NOT IF      ( ignore hidden words )
                        DUP ID.         ( but if not hidden, print the word )
                SPACE
                @               ( dereference the link pointer - go to previous word )
        REPEAT
-       DROP
        CR
 ;
 
 : CFA>
        LATEST @        ( start at LATEST dictionary entry )
        BEGIN
-               DUP 0<>         ( while link pointer is not null )
+               ?DUP            ( while link pointer is not null )
        WHILE
                DUP >CFA        ( cfa curr curr-cfa )
                2 PICK          ( cfa curr curr-cfa cfa )
                THEN
                @               ( follow link pointer back )
        REPEAT
-       2DROP           ( restore stack )
+       DROP            ( restore stack )
        0               ( sorry, nothing found )
 ;
 
                        ." 0BRANCH ( "
                        4 + DUP @               ( print the offset )
                        .
-                       ')' EMIT SPACE
+                       ." ) "
                ENDOF
                ' BRANCH OF             ( is it BRANCH ? )
                        ." BRANCH ( "
                        4 + DUP @               ( print the offset )
                        .
-                       ')' EMIT SPACE
+                       ." ) "
                ENDOF
                ' ' OF                  ( is it ' (TICK) ? )
                        [ CHAR ' ] LITERAL EMIT SPACE
        2DROP           ( restore stack )
 ;
 
-(
-       DOES> ----------------------------------------------------------------------
-
-       CREATE ... DOES> is a tricky construct allowing you to create words which create other words.
-       For example CONSTANT (defined above) is a word which creates words, and it could have been
-       written as follows:
-
-               : CONSTANT CREATE DOCOL , , DOES> @ ;
-
-       Even explaining what DOES> is supposed to do is tricky.  It's possible that the implementation
-       is easier to understand than the explanation.
-
-       If we look at the definition of CONSTANT here, and remember that when it is called the value
-       of the constant is on the stack and the name follows.  So first CREATE makes the header of a
-       new word with the name.  Secondly the codeword is set to DOCOL.  Thirdly , (COMMA) takes the
-       value off the stack and adds it to the definition.  At this point (just before executing DOES>)
-       the word looks like this:
-
-         ________ CREATE _______   _ DOCOL ,_   ____ , ___
-        /                       \ /          \ /          \
-       +---------+---+---+---+---+------------+------------+
-       | LINK    | 3 | T | E | N | DOCOL      | 10         |
-       +---------+---+---+---+---+------------+------------+
-            ^      len              codeword
-           |
-         LATEST
-
-       
-)
-
-
-
-
-: DOES>
-       R> LATEST @ >DFA !
-;
-
 (
        C STRINGS ----------------------------------------------------------------------
 
        prints a C string).
 )
 
+(
+       Z" .." is like S" ..." except that the string is terminated by an ASCII NUL character.
+
+       To make it more like a C string, at runtime Z" just leaves the address of the string
+       on the stack (not address & length as with S").  To implement this we need to add the
+       extra NUL to the string and also a DROP instruction afterwards.  Apart from that the
+       implementation just a modified S".
+)
+: Z" IMMEDIATE
+       STATE @ IF      ( compiling? )
+               ' LITSTRING ,   ( compile LITSTRING )
+               HERE @          ( save the address of the length word on the stack )
+               0 ,             ( dummy length - we don't know what it is yet )
+               BEGIN
+                       KEY             ( get next character of the string )
+                       DUP '"' <>
+               WHILE
+                       HERE @ C!       ( store the character in the compiled image )
+                       1 HERE +!       ( increment HERE pointer by 1 byte )
+               REPEAT
+               0 HERE @ C!     ( add the ASCII NUL byte )
+               1 HERE +!
+               DROP            ( drop the double quote character at the end )
+               DUP             ( get the saved address of the length word )
+               HERE @ SWAP -   ( calculate the length )
+               4-              ( subtract 4 (because we measured from the start of the length word) )
+               SWAP !          ( and back-fill the length location )
+               ALIGN           ( round up to next multiple of 4 bytes for the remaining code )
+               ' DROP ,        ( compile DROP (to drop the length) )
+       ELSE            ( immediate mode )
+               HERE @          ( get the start address of the temporary space )
+               BEGIN
+                       KEY
+                       DUP '"' <>
+               WHILE
+                       OVER C!         ( save next character )
+                       1+              ( increment address )
+               REPEAT
+               DROP            ( drop the final " character )
+               0 SWAP C!       ( store final ASCII NUL )
+               HERE @          ( push the start address )
+       THEN
+;
+
 ( STRLEN returns the length of a C string )
 : STRLEN       ( str -- len )
        DUP             ( save start address )
        S0 @ +          ( add to base stack address )
 ;
 
+(
+       SYSTEM CALLS ----------------------------------------------------------------------
+
+       Some wrappers around Linux system calls
+)
+
+( BYE exits by calling the Linux exit(2) syscall. )
+: BYE          ( -- )
+       0
+       0
+       0               ( return code (0) )
+       SYS_EXIT        ( system call number )
+       SYSCALL3
+;
+
+(
+       OPEN, CREAT and CLOSE are just like the Linux syscalls open(2), creat(2) and close(2).
+
+       Notice that they take C strings and may return error codes (-errno).
+)
+: OPEN         ( mode flags c-pathname -- ret )
+       SYS_OPEN
+       SYSCALL3
+;
+
+: CREAT                ( mode c-pathname -- ret )
+       0 ROT
+       SYS_CREAT
+       SYSCALL3
+;
+
+: CLOSE                ( fd -- ret )
+       0 ROT 0 ROT
+       SYS_CLOSE
+       SYSCALL3
+;
+
+( READ and WRITE system calls. )
+: READ         ( len buffer fd -- ret )
+       SYS_READ
+       SYSCALL3
+;      
+
+: WRITE                ( len buffer fd -- ret )
+       SYS_WRITE
+       SYSCALL3
+;      
+
 (
        ANS FORTH ----------------------------------------------------------------------
 
        http://www.taygeta.com/forth/dpans.html
        http://www.taygeta.com/forth/dpansf.htm (list of words)
 )
-( BL pushes the ASCII character code of space on the stack. )
-: BL 32 ;
 
 ( C, writes a byte at the HERE pointer. )
 : C, HERE @ C! 1 HERE +! ;
 
 
 
-( Finally print the welcome prompt. )
+
+
+
+
+
+
+(
+       NOTES ----------------------------------------------------------------------
+
+       DOES> isn't possible to implement with this FORTH because we don't have a separate
+       data pointer.
+)
+
+(
+       WELCOME MESSAGE ----------------------------------------------------------------------
+
+       Print the version and OK prompt.
+)
+
 ." JONESFORTH VERSION " VERSION . CR
 ." OK "