cheat sheet (/CHēt SHēt/) a piece of paper bearing written notes intended to aid one’s memory, typically one used surreptitiously in an examination.
This cheat sheet is using pforth forth implementation.
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 )
>R ( x -- ) ( R: -- x ) \ Move x to the return stack.
R> ( -- x ) ( R: x -- ) \ Move x from the return stack to the data stack.
R@ ( -- x ) ( R: x -- x ) \ Copy x from the return stack to the data stack.
2>R ( x1 x2 -- ) ( R: -- x1 x2 ) \ Transfer cell pair x1 x2 to the return stack.
2R> ( -- x1 x2 ) ( R: x1 x2 -- ) \ Transfer cell pair x1 x2 from the return stack.
2R@ ( -- x1 x2 ) ( R: x1 x2 -- x1 x2 ) \ Copy cell pair x1 x2 from the return stack.
: 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?"
ENDCASE
;
: 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 )
C@ ( c-addr -- char , Fetch the character stored at c-addr. )
C! ( char c-addr -- , Store char at c-addr. )
A@ ( dictionary_address addr -- , Fetch relocatable data addresses. )
A! ( addr -- dictionary_address , Store relocatable data addresses. )
VARIABLE ( <name> -- , define a 4 byte memory storage location )
CONSTANT ( x "<spaces>name" -- , create name with execution semantic -- x )
ALLOCATE ( u -- a-addr ior , Allocate u address units of contiguous data space. )
ALLOT ( n -- , If n is greater than zero, reserve n address units of data space. )
RESIZE ( a-addr1 u -- a-addr2 ior , Change the allocation of the contiguous data space starting at the address a-addr1, previously allocated by ALLOCATE or RESIZE, to u address units.)
FREE ( a-addr -- ior , Return the contiguous region of data space indicated by a-addr to the system for later allocation. )
HERE ( -- addr , addr is the data-space pointer. )
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 !
BEGIN-STRUCTURE COLOR%
DROP 2 1 +FIELD COLOR-B
DROP 0 1 +FIELD COLOR-R
DROP 1 1 +FIELD COLOR-G
DROP 3 1 +FIELD COLOR-A
DROP 4
END-STRUCTURE
: >COLOR% ( R G B A -- COLOR%-addr )
COLOR% ALLOCATE THROW >R
R@ COLOR-A C!
R@ COLOR-B C!
R@ COLOR-G C!
R@ COLOR-R C!
R>
;
: COLOR%> ( COLOR%-addr -- R G B A )
>R
R@ COLOR-A C@
R@ COLOR-B C@
R@ COLOR-G C@
R@ COLOR-R C@
R> FREE THROW
;
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 ↩