Implemented COUNT, renamed TELL to TYPE

[forth.jl.git] / src / lib.4th

diff --git a/src/lib.4th b/src/lib.4th
index a43f6c1..c38faa1 100644 (file)
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -1,3 +1,10 @@
+: \ IMMEDIATE
+        KEY
+        10 = 0BRANCH [ -5 , ]
+; \ We can now comment!
+
+\ BASIC DEFINITIONS  ----------------------------------------------------------------------
+
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
 : */ -ROT * SWAP / ;
@@ -8,7 +15,8 @@
 : FALSE 0 ;
 : NOT 0= ;
 
- \ Allow for slightly more portable code
+\ Translate a number of cells into memory units
+\ (in our case 1 cell = 1 memory unit)
 : CELLS ;
 
 \ Since the smallest unit of memory in our system is 64 bits and since strings
@@ -25,17 +33,15 @@
 
 : LITERAL IMMEDIATE ['] LIT , , ;
 
-: ':' [ CHAR : ] LITERAL ;
-: ';' [ CHAR ; ] LITERAL ;
-: '(' [ CHAR ( ] LITERAL ;
-: ')' [ CHAR ) ] LITERAL ;
-: '<' [ CHAR < ] LITERAL ;
-: '>' [ CHAR > ] LITERAL ;
-: '"' [ CHAR " ] LITERAL ;
-: 'A' [ CHAR A ] LITERAL ;
-: '0' [ CHAR 0 ] LITERAL ;
-: '-' [ CHAR - ] LITERAL ;
-: '.' [ CHAR . ] LITERAL ;
+: CHAR
+    WORD
+    DROP @
+;
+
+: [CHAR] IMMEDIATE
+    CHAR
+    ['] LIT , ,
+;
 
 : CR '\n' emit ;
 : SPACE BL emit ;
@@ -215,11 +221,11 @@
         1               \ allowed nested parens by keeping track of depth
         BEGIN
                 KEY             \ read next character
-                DUP '(' = IF    \ open paren?
+                DUP [CHAR] ( = IF    \ open paren?
                         DROP            \ drop the open paren
                         1+              \ depth increases
                 ELSE
-                        ')' = IF        \ close paren?
+                        [CHAR] ) = IF        \ close paren?
                                 1-              \ depth decreases
                         THEN
                 THEN
@@ -291,10 +297,10 @@
 
         ( print the remainder )
         DUP 10 < IF
-                '0'             ( decimal digits 0..9 )
+                [CHAR] 0             ( decimal digits 0..9 )
         ELSE
                 10 -            ( hex and beyond digits A..Z )
-                'A'
+                [CHAR] A
         THEN
         +
         EMIT
@@ -347,7 +353,7 @@
         SWAP            ( u flag )
 
         IF                      ( was it negative? print the - character )
-                '-' EMIT
+                [CHAR] - EMIT
         THEN
 
         U.
@@ -356,7 +362,7 @@
 : . 0 .R SPACE ;
 
 : .S            ( -- )
-        '<' EMIT DEPTH U. '>' EMIT SPACE
+        [CHAR] < EMIT DEPTH U. [CHAR] > EMIT SPACE
         PSP0 @ 1+
         BEGIN
                 DUP PSP@ 2 - <=
@@ -425,7 +431,7 @@
                 KEY DROP
                 BEGIN
                         KEY             ( get next character of the string )
-                        DUP '"' <>
+                        DUP [CHAR] " <>
                 WHILE
                         C,              ( copy character )
                 REPEAT
@@ -439,7 +445,7 @@
                 KEY DROP
                 BEGIN
                         KEY
-                        DUP '"' <>
+                        DUP [CHAR] " <>
                 WHILE
                         OVER C!         ( save next character )
                         1+              ( increment address )
@@ -453,14 +459,14 @@
 
 : ." IMMEDIATE          ( -- )
         [COMPILE] S"    ( read the string, and compile LITSTRING, etc. )
-        ['] TELL ,      ( compile the final TELL )
+        ['] TYPE ,      ( compile the final TYPE )
 ;
 
 : .( 
         KEY DROP
         BEGIN
                 KEY
-                DUP ')' = IF
+                DUP [CHAR] ) = IF
                         DROP    ( drop the double quote character )
                         EXIT    ( return from this function )
                 THEN
@@ -468,6 +474,11 @@
         AGAIN
 ;
 
+( Converts address of counted string into address of
+  start of string and length of string. )
+: COUNT ( addr1 -- addr2 n )
+        DUP 1+ SWAP @ ;
+
 
 ( CONSTANTS AND VARIABLES ------------------------------------------------------ )
 
@@ -620,7 +631,14 @@
 ;
 
 : SEE
-        WORD FIND       ( find the dictionary entry to decompile )
+        WORD 2DUP FIND       ( find the dictionary entry to decompile )
+
+        ?DUP 0= IF
+                ." Word '" TYPE ." ' not found in dictionary."
+                EXIT
+        THEN
+
+        -ROT 2DROP
 
         ( Now we search again, looking for the next word in the dictionary.  This gives us
           the length of the word that we will be decompiling.  (Well, mostly it does). )
@@ -641,7 +659,7 @@
         DUP >CFA @ CASE
                 DOCOL OF
                         \ Colon definition
-                        ':' EMIT SPACE DUP ID. SPACE
+                        [CHAR] : EMIT SPACE DUP ID. SPACE
                         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR
                 ENDOF
                 DOVAR OF
@@ -661,7 +679,7 @@
         ENDCASE
 
         ( begin the definition with : NAME [IMMEDIATE] )
-        ( ':' EMIT SPACE DUP ID. SPACE
+        ( [CHAR] : EMIT SPACE DUP ID. SPACE
         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR 4 )
 
         4 SPACES
@@ -680,11 +698,11 @@
                         .                       ( and print it )
                 ENDOF
                 ['] LITSTRING OF          ( is it LITSTRING ? )
-                        [ CHAR S ] LITERAL EMIT '"' EMIT SPACE ( print S"<space> )
+                        [CHAR] S EMIT [CHAR] " EMIT SPACE ( print S"<space> )
                         1+ DUP @                ( get the length word )
                         SWAP 1+ SWAP            ( end start+1 length )
-                        2DUP TELL               ( print the string )
-                        '"' EMIT SPACE          ( finish the string with a final quote )
+                        2DUP TYPE               ( print the string )
+                        [CHAR] " EMIT SPACE          ( finish the string with a final quote )
                         +                       ( end start+1+len, aligned )
                         1-                     ( because we're about to add 4 below )
                 ENDOF
@@ -725,7 +743,7 @@
                 1+             ( end start+1 )
         REPEAT
 
-        ';' EMIT CR
+        [CHAR] ; EMIT CR
 
         2DROP           ( restore stack )
 ;