Cookbook (cook·book) a book containing recipes and other information about the preparation and cooking of food.
The way I cook in the Forth programming language. Let me cook!.
This cookbook is using pforth forth implementation.
All Forth Word Capitalize
Souce 1
git clone https://github.com/philburk/pforth.git
cd pforth
cmake -S . -B build -G Ninja
cmake --build build
./fth/pforth_standalone
CR is EMIT newline
." It's Forth" CR
. ( N -- , print number on top of stack )
DUP ( n -- n n , DUPlicate top of stack )
SWAP ( a b -- b a , swap top two items on stack )
OVER ( a b -- a b a , copy second item on stack )
DROP ( a -- , remove item from the stack )
ROT ( a b c -- b c a , ROTate third item to top )
NIP ( a b -- b , remove second item from stack )
TUCK ( a b -- b a b , copy top item to third position )
?DUP ( n -- n n | 0 , duplicate only if non-zero, '|' means OR )
-ROT ( a b c -- c a b , rotate top to third position )
2SWAP ( a b c d -- c d a b , swap pairs )
2OVER ( a b c d -- a b c d a b , leapfrog pair )
2DUP ( a b -- a b a b , duplicate pair )
2DROP ( a b -- , remove pair )
PICK ( ... v3 v2 v1 v0 N -- ... v3 v2 v1 v0 vN )
: SQUARE ( N -- N*N , calculate square )
DUP *
;
In forth FALSE is 0 and TRUE is -1 or any number that not zero is TRUE
ELSE is Optional
: GT4? ( -- , check if greater than 4 )
DUP 4 >
IF ." YES"
ELSE ." NO"
THEN
;
: PRINT.NUM ( -- , print a number )
CASE
0 OF ." ZERO" ENDOF
1 OF ." ONE" ENDOF
2 OF ." TWO" ENDOF
3 OF ." THREE" ENDOF
4 OF ." FORTH" ENDOF
DUP . ." WHO?"
ENDCACE
;
: COUNT.UP ( N -- , print number 0 to N )
0
BEGIN
DUP .
1 +
2DUP <
UNTIL
2DROP
;
I is Special (Optional)
: COUNT.UP ( N -- , print number 0 to N )
1 + 0
DO
I .
LOOP
;
in DO … LOOP you can also LEAVE
: COUNT.UP ( N -- , print number 0 no N )
1 + 0
BEGIN
2DUP >
WHILE
DUP .
1 +
REPEAT
2DROP
;
@ ( address -- value , FETCH value FROM address in memory )
! ( value address -- , STORE value TO address in memory )
? ( address -- , Display the value stored at a-addr )
VARIABLE ( <name> -- , define a 4 byte memory storage location )
CONSTANT ( x "<spaces>name" -- , create name with execution semantic -- x )
VARIABLE NUMBER
513 NUMBER !
NUMBER @ .
128 CONSTANT NUMBER
NUMBER .
EMIT ( char -- , output character )
KEY ( -- char , input character )
SPACE ( -- , output a space )
SPACES ( n -- , output n spaces )
CHAR ( <char> -- char , convert to ASCII )
CR ( -- , start new line , carriage return )
." ( -- , output " delimited text )
CHAR ( <char> -- char , get ASCII value of a character )
CHAR+ ( address -- address' , add the size of one character )
COUNT ( $addr -- addr #bytes , extract string information )
TYPE ( addr #bytes -- , output characters at addr )
ACCEPT ( addr maxbytes -- numbytes , input text, save at address )
S and C is add string to stack, but C add null termination
: GREET ( -- , print friendly )
S" Hello Friend" TYPE
;
: GREET ( -- , print friendly )
C" Hello Friend" COUNT TYPE
;
: GREET ( -- , greet to <name> )
PAD 1+
CR
." COUMPUTER: Who are you?" CR
." HUMAN: Hi My name is " 128 ACCEPT PAD C! PAD CR
." COMPUTER: Hello " COUNT TYPE ." Nice to meet you" CR
;
HEX, DECIMAL & BINARY for changing base
6 BINARY
6 DECIMAL
6 HEX
also can change any BASE, BASE is variable
7 BASE !
diff --git a/csrc/pfcustom.c b/csrc/pfcustom.c
index 469bb5a..63af9f8 100644
--- a/csrc/pfcustom.c
+++ b/csrc/pfcustom.c
@@ -33,6 +33,7 @@
static cell_t CTest0( cell_t Val );
static void CTest1( cell_t Val1, cell_t Val2 );
+static void System( const char* val, cell_t val1 );
/****************************************************************
** Step 1: Put your own special glue routines here
@@ -51,6 +52,36 @@ static void CTest1( cell_t Val1, cell_t Val2 )
MSG_NUM_D(", Val2 = ", Val2);
}
+static void System( const char* val, cell_t val1 )
+{
+ char output[256], buff[256], temp[256];
+ FILE *fp;
+ cell_t outLen = 0, status = -1;
+
+ ForthStringToC(buff, val - 1, val1 >= sizeof(buff) ? sizeof(buff) - 1 : val1 + 1);
+ strcat(buff, " 2>/dev/null");
+
+ if(!(fp = popen(buff, "r"))){
+ PUSH_DATA_STACK(status);
+ return;
+ }
+
+ while(fgets(temp + outLen, sizeof(temp) - outLen, fp) && outLen < sizeof(temp) - 1)
+ outLen += strlen(temp + outLen);
+
+ temp[outLen] = '\0';
+
+ status = pclose(fp);
+ if(WIFEXITED(status) && WEXITSTATUS(status) != 0)
+ status = -1;
+ else
+ status = 0;
+
+ if(status == 0)
+ PUSH_DATA_STACK(CStringToForth(output, temp, sizeof(output)));
+ PUSH_DATA_STACK(status);
+}
+
/****************************************************************
** Step 2: Create CustomFunctionTable.
** Do not change the name of CustomFunctionTable!
@@ -72,6 +103,7 @@ Err LoadCustomFunctionTable( void )
{
CustomFunctionTable[0] = CTest0;
CustomFunctionTable[1] = CTest1;
+ CustomFunctionTable[2] = System;
return 0;
}
@@ -83,7 +115,8 @@ Err LoadCustomFunctionTable( void )
CFunc0 CustomFunctionTable[] =
{
(CFunc0) CTest0,
- (CFunc0) CTest1
+ (CFunc0) CTest1,
+ (CFunc0) System,
};
#endif
@@ -106,6 +139,8 @@ Err CompileCustomFunctions( void )
if( err < 0 ) return err;
err = CreateGlueToC( "CTEST1", i++, C_RETURNS_VOID, 2 );
if( err < 0 ) return err;
+ err = CreateGlueToC( "SYSTEM", i++, C_RETURNS_VOID, 2 );
+ if( err < 0 ) return err;
return 0;
}
Forth Tutorial by https://www.softsynth.com/pforth/pf_tut.php ↩