Pisi-Algol - Forth translaator

Eelnevas vaadeldud Pisi-Algoli translaator magasinmasina koodiks on lihtne ümber teha translaatoriks, mis teisendab Pisi-Algoli programmi Forth-koodiks. Kuna Forth kasutab arvutamisel magasini ja Forth-programmi käsud on (enamasti) kõik magasini ühe-kahe tippelemendi teisendused, jääb translaatori arvutav osa (avaldise arvutamine) samaks. Kuna Forth-is on olemas juhtimiskonstruktsioonid if-then-else ja mitmesugused tsüklid, lihtsustub nende käskude transleerimine - märgendeid pole enam tarvis, sellepärast on Pisi-Algol-i veidi laiendatud ja lisatud ka määratud arvu kordustega (tsüklimuutuja alg- ja lõppväärtusega määratud) tsükkel

FOR omistamine UNTIL avaldis DO programm ENDFOR

Selle semantika oleks nagu C-s: omistamine annab tsüklimuutujale algväärtuse, avaldis - lõppväärtuse (lihtsustamiseks loetakse, et algväärtus <= lõppväärtus) ja tsüklit täidetakse kuni tsüklimuutuja saab suuremaks lõppväärtusest; tsüklimuutujat suurendatakse tsükli lõpus, just enne tagasipöördumise kontrolli.

Järgnevas on lühidalt selgitatud translaatoris kasutatatud Forth-käske (Forth-i terminoloogias: sõnu); kogu programm on testitud Win32Forth-iga (vabalt mahalaaditav).

Forth on interpreteeritud keel (Forthi intrpretaator ootab kogu aeg sisendit), kui sellel on olemas (nagu enamusel interpreteeritud keeltest) ka kompilaator.

Forthi interpretaator kasutab vaid kolme tüüpi lekseeme:
- arv (täisarv)
- sõna (s.t. protseduur - kas sisseehitatud või kasutaja poolt defineeritud); kõigi sõnade vaatamiseks tuleb sisestada sõna words
- viga

Forthi sõnu (alamprogramme/funktsioone) selgitatakse Forth-i kommentaari formaadis ( n n n -- n n ), kus vasakul on magasini tipu elemendid enne sõna/käsu sooritamist, paremal - pärast seda (magasini tipp on paremal; kommentaari tunnuseks on tühikud avava sulu järel ja enne sugevat sulgu). Näiteks liitmisoperaator + asendab magasini tipus olnud kaks täisarvu nende summaga, seega kui magasinis olid näiteks 1 3 5 (Forthi eraldaja on tühik), siis pärast + sisestamist on magasini tipp 1 8 ehk kommentaarina (sulgudesse võetud kommentaare võib kirjutada Forth-i programmis ükskõik kuhu) (1 3 5 + -- 1 8). Analoogiliselt toimivad kõik arvutamis- ja võrdluskäsud: (3 4 5 * -- 3 20), (1 3 4 - -- 1 -1), ( 3 4 < -- 0 ) .

Kõik arvutused toimuvad magasinis. Magasini tipu trükib sõna . (punkt, see ühtlasi ka eemaldab selle), seega Forthis need näited võib sisestada ja tulemuse eraanile saada, sisestades
(järgnevates näidetes ( CR ) (tühikud sulgude juures!) on kommentaar, s.t. sellel kohal on vajutatud reavahetusklahvi, järgnev 25 ok on juba Forth-i väljund, kui reavahetust on tarvis käsuna (väljatrükki), tuleb kasutada sõna CR .

1 2 + . ( CR ) 3 ok
2 3 < . ( CR ) -1 ok. 
3 2 < . ( CR ) 0  ok.

Uue sõna defineerimine algab kooloniga, definitsioon lõpeb semikooloniga ja seejärel võib sõna kohe kasutada.

Defineerime näitena sõna, mis arvutab magasini tipus olnud arvu ruudu ja trükib selle ekraanile; ruutu võtmiseks dubleerime tipus olnud arvu, siis korrutame need kaks arvu ja lõpuks trükime ekraanile :

: ruutu dup * . ;

Eraldajad on kõikjal tühikud! Testime:

5 ruutu ( CR ) 25 ok

Trükkimiskäsk . ühtlasi eemaldab magasini tipust trükitud arvu; kui see peaks säilima, tuleb enne kasutada sõna dup.

Tingimuskäsk (seda ja tsüklikäske võib kasutada vaid sõnade definitsioonides, mitte otse magasinil!) on süntaksiga

if ( käsud ) then 

: võrdsed = if ." on võrdsed " then ." ei ole " ;  ok

2 3 võrdsed ei ole  ok
5 5 võrdsed on võrdsed ei ole  ok

: võrdsed = if ." on võrdsed" else ." ei ole " then ;

VÕRDSED isn't unique  ok

5 5 võrdsed on võrdsed ok
4 5 võrdsed ei ole  ok

Arvude 1 .. 10 summa arvutamiseks kasutame tsüklit. Määratud korduste arvuga tsükli süntaks on do ( käsud ) loop ja enne seda peab olema magasini tipus tsükli üla- ja alaraja (tsükli käivitamisel sõna do eemaldab need!); tsükliindeksiks on i (tsükli sees järgmise tsükli indeks on j), seega näiteks arvude 0..10 ruutude ekraanile väljastamiseks defineerime sõna

: jada 10 0 do i i * . loop ;

jada 0 1 4 9 16 25 36 49 64 81  ok

Tsükli abil on lihtne defineerida sõna fac magasini tipus oleva arvu n faktoriaali n! leidmiseks: paneme magasini korrutise algväärtuseks arvu 1, siis tõstame sõnaga swap tipus olnud arvu n sellest üle, suurendame seda ühe võrra sisseehitatud sõnaga 1+ (muidu ei toimu viimast korrutamist), lisame tsükliindeksi algvääruse 1 (mitte 0 - siis tuleks kogu korrutis 0!), seejärel käivitame sõnaga do tsükli (seejärel on magasini tipus vaid arv 1 - "jooksev" korrutis), pärast korrutamist tsükliindekisga i dubleerime selle (muidu see kaob väljastamisel) :

: fac 1 swap 1+ 1 do  i * dup . loop ; 
5 fac ( CR ) 1 2 6 24 120 ok 

Tsükli abil on lihtne defineerida sõna, mis arvutab magasini tipus olnud arvu n põhjal esimesed n Fibbonaci arvu.

Defineerime algul abisõna fib2, mis sooritab magasini tipus olnud kahe arvu teisenduse ( n1 n2 .. n2 n1+n2):

: fib2 dup rot + ;  ok;

3 5 fib2  ok..
. 8  ok.
. 5  ok

: fib 0 1 rot 0 do fib2 dup . loop ;  ok
10 fib 1 2 3 5 8 13 21 34 55 89  ok.

Tingimusega määratud tsükli kõige lihtsam (until) süntaks on begin ( käsud loogiline ) until - käske täidetakse kuni until leiab magasini tipust väärtuse true.

Võrdluseks C ja Forth-i programmijupid:
C:-s:

int floor5(int v) { return v < 6 ? 5 : v - 1; }

Sama Forth-is:

: floor5 ( n -- n' )   dup 6 < if drop 5 else 1 - then ;

Pisi-Algoli translaatoris saavad lähteprogrammi identifikaatoritest ka Forth-is identifikaatorid. Selle tõttu on transleerimise tulemus Forth-programmina väga mitte-Forthilik ja kohmakas - Forth-is programmeerides kasutatakse muutujaid harva, kõik saab teha otse magasiniga opereerides. Muutujad deklareeritakse programmi algul, näiteks muutujate F0, F1 deklaratsioonid oleks

variable F0
variable F1

Muutuja X väärtuse saamiseks magasini tuleb kirjutada X @ (ainult X paneb magasini X-i aadressi mälus) ja X-le väärtuse 3 omistamiseks tuleb kirjutada 3 X ! ; omistamisega kaob 3 magasinist, s.t. (1 3 X ! -- 1 ). Magasini tipu dubleerib sõna dup ja selle toob ekraanile sõna . ; kuna . ühtlasi ka kustutab näidatud arvu, kasutatakse arvu ekraanil näitamiseks (peaaegu) alati kombinatsiooni dup . - siis jääb magasin muutuseta. Mälus (mitte magasinis) oleva väärtuse suurendamiseks/vähendamiseks on sõnad +!, -!, näiteks 1 i +! on C-keeles i++ .

Kõik süsteemis olevad sõnad näitab words.

Juhtimislause if ... then vaatab enne if-i magasinis olnud väärtust: kui see on true (ei ole null), täidetakse if - then vahel olevad sõnad; kui magasini tipus oli 0, minnakse then-ile järgnevat sõna sooritama; ka if "sööb ära" kontrollitud väärtuse, s.t. mis oli magasini tipus enne sõna if; pikem versioon if ... else ... then toimib analoogiliselt - kui magasinis enne if-i oli true, täidetakse if...else vaheline osa, muidu else...then vaheline.

On olemas nii suvalise korduste arvuga tsükkel (while, until-tüüpi) kui ka määratud korduste arvuga (for-tüüpi) tsükkel. While-tüüpi tsükli üldkuju on

begin ... while ... repeat

ja seda täidetakse niikaua, kui enne while-sõna magasini tipus on true, (while võib olla ükskõik kus begin..repeat vahel), näiteks

: loenda 1 begin dup . 1 + dup 10 <= while repeat ;

loenda
1 2 3 4 5 6 7 8 9 10

Seega Pisi-Algoli tsükkel WHILE I < N DO ... ENDLOOP asendub Forth-is sõnadega begin i @ n @ < while ... repeat, märgendeid ja goto-sid pole tarvis.

Forthis on ka määratud korduste arvuga tsükkele n i do ... loop ( siin i on tsüklimuutuja algväärtus, n - lõppväärtus), mida saaks kasutada Pisi-Algol-i määratud arvu kordustega tsükli FOR i :=exp UNTIL exp1 DO ... ENDFOR transleerimisel, kuid siin on ka selle tsükli transleerimisel kasutatud eespoolvaadeldud begin ...while ... repeat tsüklit. Kuna Pisi-Algol-i tsükli lõppväärtus exp1 ei pea olema esitatud muutujaga, on selle tähistamiseks kasutatud Forth-i lokaalset muutujat n (kehtib vaid sõna sees). Sellise muutuja deklaratsioon Forth-is on locals| n | (püstkriipsude vahel võib olla ka rohkem identifikaatoreid) ja nende kasutamine erineb veidi eespoolvaadeldud grobaalsete muutujate (deklareeritud sõnaga variable) kasutamisest : n paigutab muutuja väärtuse magasini (s.t. selle järel pole @ vajalik) ja muutujale magasini tipus olnud väärtuse omistab to n .

Translaatori põhiskeem on sama kui oli magasinmasina koodiks transleerimisel. Ka siin on kiiruse saavutamiseks translaatoris kodeeritud kõik täisarvudena (ka loetlustüübi enum elemendid on määratud nende täisarvulise indeksiga).

Nimede tabel on samasugune, juurde on tulnud vaid funktsioon char *getname(int index), mis viida järgi väljastab muutuja nimekuju. Write-lauses kasutatavad stringid salvestatakse nimede tabeliga analoogilises tabelis str-table; stringide tabeli haldamine on lihtsam kui nimede tabeli haldamine, sest siin pole vaja otsida, kas string on juba kantud tabelisse. Forth-is väljastab stringi str ekraanile konstruktsioon ." str ", kus str ees ja taga peavad olema tühikud (Forth-i eraldajad). Sellepärast tuleb skannerist saadud stringist selle alguses ja lõpus olnud jutumärgid stringi salvestamisel funktsiooniga putstr eemaldada - nende jaoks pole kindel, kas esimese järel ja viimase ees on tühikud. Järgnevas on nimede tabeli faili ST.h tekst:

/*** Nimede tabel: kirjete lingitud nimistu  ***/
struct symrec
{
	char *name; /* identifikaatori nimekuju */
	int offset; /* indeks */
	struct symrec *next; /* link jargmisele */
};
typedef struct symrec symrec;
symrec *identifier;
symrec *sym_table = (symrec *)0; /* Viit nimede tabelile */
symrec *nextid; 

/****  Operatsioonid: Putsym, Getsym, getname - lisa, leia, väljasta ident  ***/
symrec * putsym (char *sym_name)
{
	symrec *ptr;
	ptr = (symrec *) malloc (sizeof(symrec));
	ptr -> name = (char *) malloc (strlen(sym_name)+1);
	strcpy (ptr -> name,sym_name);
	ptr->offset = data_location();
	ptr->next = (struct symrec *)sym_table;
	sym_table = ptr;
	return ptr;
}
symrec * getsym (char *sym_name)
{
	symrec *ptr;
	for ( ptr = sym_table;
		ptr != (symrec *) 0;
		ptr = (symrec *)ptr->next )
	if (strcmp (ptr -> name, sym_name) == 0)
		return ptr;
	return 0;
}
char *getname(int index)
		{	nextid = sym_table;
			int ind,j;
			for (j=0; j<index; j++)
			{
				nextid = nextid->next;}
				return nextid->name;
			}
			

/*** Stringide tabel  ***/

symrec *str_table = (symrec *)0; /* Viit stringide tabelile */

/*****  Operatsioonid: Putstr, Getstr - lisa, leia string  ****/
symrec * putstr (char *str)
{
	symrec *ptr;
	ptr = (symrec *) malloc (sizeof(symrec));
	ptr -> name = (char *) malloc (strlen(str)-1);
	// jutumärgid emaldatakse!
	str = str+1; //eemaldab esimese
	strcpy (ptr->name,str);
	ptr->name[strlen(str)-1]='\0';
	ptr->offset = data_location();
	ptr->next = (struct symrec *)str_table;
	str_table = ptr;
	return ptr;
}
char *getstr(int index)  //indeksi j„rgi string
		{	nextid = str_table;
			int ind ,j;
			for ( j=0;j<index;j++)
			{
				nextid = nextid->next;}
				return nextid->name;
			}



/************************** Nimede ja stringide tabel - end **************************/

Skannerisse pisi.l lisandusid vaid mõned read lekseemi STRING jaoks:

		/****** Pisi-Algoli skanner ********/
%{
	#include <string.h> /*  strdup */
	#include <stdlib.h>  /*  atoi */
	#include "pisi.tab.c" /* translator */
%}
	
DIGIT [0-9]
ID [A-Za-z][A-Za-z0-9_]*
	/*****  Lekseeme kirjeldavad regulaarsed avaldised ******/
%%
":=" { return(ASSGNOP); }
{DIGIT}+ { yylval.intval = atoi( yytext );
				return(NUMBER); }
DO { return(DO); }
ELSE { return(ELSE); }
END { return(END); }
FOR { return(FOR); }
UNTIL {return(UNTIL); }
ENDLOOP {return(ENDLOOP); }
ENDFOR {return(ENDFOR); }
ENDIF { return(ENDIF); }
IF { return(IF); }
READ { return(READ); }
SKIP { return(SKIP); }
THEN { return(THEN); }
WHILE { return(WHILE); }
WRITE { return(WRITE); }
RV { return(RV);}
\"[A-Za-z0-9_ -]*\" {yylval.id = (char *) strdup(yytext);
			return(STRING); printf("Lekseris: %s\n",yylval.id);}
{ID} { yylval.id = (char *) strdup(yytext);
			return(IDENTIFIER); }
[ \t\r\n]+ /* eat up whitespace NB - \r on oluline!*/
. { return(yytext[0]);}
%%
int yywrap(void){}
	/************************** Skanner lopp *****************************/

Magasinmasina tekstist SM.h jäävad järele vaid operatsioonide sisemise ja välise esituse tabelid ja koodide massiivi deklaratsioonid. Kuna gcc ei luba sisemiste nimede ja lekseemide kokkulangemist, on mõned uued sisemised nimed veidi väänatud kujuga: IFF,ELS jne - IF, ELSE on lekseemid ja neid ei või kasutada. Operatsioonide välise esituse tabelis on näidatud operatsioonile vastava Forth-koodi lõik.

 /******** Operatsioonide esitus ja koodide salvestamine ********/
/** OPERATSIOONID: Sisemine esitus (loetlustyyp) **/
enum code_ops { 
HALT, 
MOV, 
IFF, 
THN, ELS, 
BEGN, WHIL, REPEAT, 
LOOP_INIT, INCREMENT_I, 
LOCALS,    
LOAD_INT, LOAD_VAR, 
READ_INT,  WRITE_INT,  
CR, STR,
LT,LTE, EQ, GT,GTE, ADD, SUB, MULT, DIV, PWR };

/** OPERATSIOONID: Väline esitus **/

char *op_name[] = {"halt", "mov",  "if", "else", "then", "begin", "while", "repeat",
"BEGIN I @ N < WHILE", "  +!   ", 
"LOCALS| N | ",  
 "load_int", "load_var",
"in_int", ". ", " cr ", " .\"",
"<","<=", "=", ">",">=", "add", "sub", "mult", "div", "pwr" };
struct instruction
{
	enum code_ops op;
	int arg;
};
/** Koodide massiv **/
struct instruction code[999];

/*************************** Magasinmasin lopp **************************/

Koodi generaator CG.h ei muutu üldse, kuid tunduvalt lihtsustusid failis pisi.y kirjeldatud semantilised tegevused ja väljundkoodi genereerimine, sest pole enam tarvis mässata märgenditega:

/******* Pisi-Algoli syntaksianalysaator ja translaator ********/
%{
	#include <stdio.h> /* I/O */
	#include <stdlib.h> /* malloc  */
	#include <string.h> /* strcmp  */
	#include "ST.h" /* Symbol Table */
	#include "SM.h" /* Stack Machine */
	#include "CG.h" /* Code Generator */
	#define YYDEBUG 1 /* For Debugging */
	int errors; /* Error Count */
	int i;
	int ids=0, strs=0; /* ids - kui palju nimesid, strs - kui palju stringe */
	
	/*-------------------------------------------------------------------------
	Identikaatori kandmine nimede tabelisse ja kontroll - kas on juba seal?
	-------------------------------------------------------------------------*/
		install ( char *sym_name )
		{
			symrec *s;
			s = getsym (sym_name);
			if (s == 0)
				s = putsym (sym_name);
			else { errors++;
				printf( "%s on juba defineeritud\n", sym_name );
						}
		}
	/****  Identifikaatori kontroll ja käsu genereerimine  ****/
	/* avaldise paremal pool olev identifikaator
	deklareeritakse vajaduse korral! */	
		check_n_gen( enum code_ops operation, char *sym_name )
		{ symrec *identifier;
			identifier = getsym( sym_name );
			if ( identifier == 0 )
				{ 
					identifier = putsym( sym_name );
					ids++;
			//	printf("indeksid: %d, %d\n",identifier->offset, ids); 
				}
			 	gen_code( operation, identifier->offset );
		}
/*** Stringide korral ei kontrollita, alati tabelisse! ***/	
		add_n_gen( enum code_ops operation, char *str )
		{ symrec *identifier;
					identifier = putstr( str );
					strs++;
				 	gen_code( operation, identifier->offset );
		}
		
%}
	/*******  SEMANTIKA  ******/
	%union semrec 
	{
		int intval; /* Integer values */
		char *id; /* Identifiers */
		struct lbs *lbls; /* For backpatching */
	}
	/********  LEKSEEMIDE TYYP  *********/
%start program
%token  <intval> NUMBER
%token  <id> IDENTIFIER STRING /* Simple identifier */
%token  <lbls> IF WHILE FOR 
%token SKIP THEN ELSE ENDIF DO ENDLOOP ENDFOR END UNTIL 
%token  READ WRITE RV
%token ASSGNOP
	
%left '-' '+'
%left '*' '/'
%right '^'
	/*******  GRAMMATIKAREEGLID ja TEGEVUSED  *******/
%%
program :  
			commands
		END { gen_code( HALT, 0 ); YYACCEPT; }
	;

commands : /* tyhi */
		|  command ';' commands
	;
command : SKIP
	| READ IDENTIFIER { check_n_gen( READ_INT, $2 ); }
	| WRITE RV { gen_code( CR, 0); }
	| WRITE exp { gen_code( WRITE_INT, 0); }
	| WRITE STRING { add_n_gen( STR, $2); }
	
	| IF exp 
		THEN { gen_code( IFF, 0); }
		commands 
		ELSE { gen_code(THN,0); 	}
		commands
		ENDIF {gen_code(ELS, 0); }
		
	| WHILE { gen_code(BEGN, 0);	}
				exp
		DO	{ gen_code(WHIL, 0);}
				commands
		ENDLOOP { gen_code(REPEAT, 0);	}
		
	| FOR IDENTIFIER ASSGNOP exp { check_n_gen( MOV, $2 );  }
		UNTIL 
		exp		 { gen_code( LOCALS, 0); 	}
		
		DO		{ gen_code(LOOP_INIT, 0); }
				commands
		ENDFOR { check_n_gen( INCREMENT_I, $2);
							gen_code( REPEAT, 0);	 }
						
	| IDENTIFIER ASSGNOP exp { check_n_gen( MOV, $1 );  }
	;
	
	
exp : NUMBER { gen_code( LOAD_INT, $1 ); }
		| IDENTIFIER { check_n_gen( LOAD_VAR, $1 ); }
		| exp '<' exp { gen_code( LT, 0 ); }
		| exp "<=" exp { gen_code( LTE, 0 ); }
		| exp '=' exp { gen_code( EQ, 0 ); }
		| exp '>' exp { gen_code( GT, 0 ); }
		| exp ">=" exp { gen_code( GTE, 0 ); }
		| exp '+' exp { gen_code( ADD, 0 ); }
		| exp '-' exp { gen_code( SUB, 0 ); }
		| exp '*' exp { gen_code( MULT, 0); }
		| exp '/' exp { gen_code( DIV, 0 ); }
		| exp '^' exp { gen_code( PWR, 0 ); }
		| '(' exp ')'
	;
%%
	/***** Forth-kood ***********/
void print_forth_code ()
{int fi=0; 
struct instruction ir;
printf(": proge \n");
do 
{
	ir = code[fi++];
	switch (ir.op) 
	{
	case HALT : printf( "; \n" ); break;
	case READ_INT : 
		printf("%d  ",ir.arg); break;
	case WRITE_INT : 
	printf(" . \n");
 		break;
	case STR : printf("%s %s  \"\n",op_name[(int) ir.op],getstr(strs-1-ir.arg));
 		break;
	case CR : printf("%s \n",op_name[(int) ir.op]); break;
	case MOV : 
		printf("%s ! \n",getname(ids-1-ir.arg));  break;
	case IFF : printf("%s \n",op_name[(int) ir.op]); break;
	case THN : printf("%s \n",op_name[(int) ir.op]); break;
	case ELS : printf("%s \n",op_name[(int) ir.op]); break;
	case BEGN : printf("%s \n",op_name[(int) ir.op]); break;
	case WHIL : printf("%s \n",op_name[(int) ir.op]); break;
	case REPEAT : printf("%s \n",op_name[(int) ir.op]); break;
	case LOCALS : printf("%s \n",op_name[(int) ir.op]); break;
	case LOOP_INIT : printf("%s \n",op_name[(int) ir.op]); break;
	case INCREMENT_I: printf("1 %s %s\n",getname(ids-1-ir.arg),op_name[(int) ir.op]); break;
	case LOAD_INT : printf("%d ", ir.arg); break;
	case LOAD_VAR : printf("%s @ \n",getname(ids-1-ir.arg));  break;
	case LT :  printf("< \n"); break;
	case LTE :  printf("< \n"); break;
	case EQ : printf("= \n"); break;
	case GT : printf("> \n"); break;
	case GTE :  printf("> \n"); break;
	case ADD : printf("+ \n"); break;
	case SUB : printf("- \n"); break;
	case MULT : printf("* \n");	break;
	case DIV : printf("/ \n");break;
	case PWR : printf("pwr \n"); break;
	default : printf( "Viga 999: Memory Dump\n" ); break;
	}
}
while (ir.op != HALT);
}

	/*******  MAIN  *******/
	main( int argc, char *argv[] )
	{ extern FILE *yyin;
		++argv; --argc;
		yyin = fopen( argv[0], "r" );
	/*	yydebug = 1;  */ 
		errors = 0;
		yyparse ();
		if ( errors == 0 )
		{	int j;
			nextid = sym_table;
			while ( nextid != NULL ) 
				{
				printf( "VARIABLE %s \n", nextid->name );
				nextid = nextid->next;
				} 
		 print_forth_code ();
		}
	}
	/***** YYERROR  ******/
	yyerror ( char *s ) /*  yyparse on error */
	{
		errors++;
		printf ("%s\n", s);
	}
		
	/**************************** Translaator lopp ***************************/

Järgnevas on Pisi-Algolis kirjutatud programm, mis kasutab while-tüüpi tsüklit; selle kõrval on Forth-programm, nagu selle väljastab genereeritud translaator (veidi on muudetud reavahetusi, et Forth-sõnad satuks enam-vähem kohakuti neid genereerinud Pisi-Algol-i käskudega:

VARIABLE f2 
VARIABLE i 
VARIABLE n 
VARIABLE f1 
VARIABLE f0 

 
f0  := 1;
f1 := 1;
n := 40;
i :=2;
WHILE i < n  DO 
f2 := f1;
f1 := f1 + f0;
f0 := f2; 
WRITE i;
WRITE " -s Fibonacc1 arv on ";
WRITE f1;
WRITE RV;
i := i+1;
ENDLOOP;
END

: proge 
1 f0 ! 
1 f1 ! 
40 n ! 
2 i ! 
begin i @ n @ <= while 
f1 @ f2 ! 
f1 @ f0 @ + f1 ! 
f2 @ f0 ! 
i @  .  
."  -s Fibonacc1 arv on   "
f1 @  . 
 cr  
i @ 1 + i ! 
repeat 
; 

Ja sama tsükliloendajat kasutava tsükliga kirjutatud Pisi_Algoli programmi jaoks:

VARIABLE f2 
VARIABLE i 
VARIABLE f1 
VARIABLE f0 

 
f0  := 1;
f1 := 1;
WRITE RV;
FOR i :=2 UNTIL 40 DO
f2 := f1;
f1 := f1 + f0;
f0 := f2; 
WRITE i;
WRITE "-s Fibonacci arv on " ;
WRITE f1;
WRITE RV;
ENDFOR;
END

: proge 
1 f0 ! 
1 f1 ! 
 cr  
1 i ! 10 LOCALS| N |  BEGIN I @ N <= WHILE 
f1 @ f2 ! 
f1 @ f0 @ + f1 ! 
f2 @ f0 ! 
i @  . 
 ." -s Fibonacci arv on   "
f1 @  . 
 cr  
1 i  +!  repeat 
; 

Mõlemad transleerimisel saadud Forth-programmid annavad Win32Forth-is käivitamisel sama tulemuse:

proge
1 -s Fibonacci arv on   2
2 -s Fibonacci arv on   3
3 -s Fibonacci arv on   5
...
39 -s Fibonacci arv on   102334155
40 -s Fibonacci arv on   165580141

command  blokk | tsykkel
  blokk  '{' programm '}'
  tsykkel  for (IDENT '=' algv; tingimus; samm) blokk 
Sammus võib (lihtsustamiseks) kasutada vaid operaatoreid ++, -- .

Küsimused, probleemid: ©2004-2013 Jaak Henno