Ïðèëîæåíèå 1.Ìîäåëü ôîðò-ñèñòåìû - ÷àñòü 16

Ýêðàí íîìåð 43

( 31.03.86 .VOC (VOC/ VOCS ) : .VOC ( PFA+2-> ) 2- BODY> >NAME ID. ; : (VOC) ( PFA1+2->PFA2,N) @ 0 BEGIN OVER DUP IF @ [ &DWORD ] LITERAL <> THEN WHILE 1+ ( Ñ×ÅÒ×ÈÊ ÑËÎÂ) SWAP N>LINK @ SWAP REPEAT ; : VOCS ( -> ) -1 ['] FORTH >BODY 2+ CURRENT @ ." ÑÏÈÑÎÊ CURRENT: " DUP .VOC OVER @ OVER @ = IF DROP THEN CONTEXT @ ." ÑÏÈÑÎÊ CONTEXT: " DUP .VOC OVER @ OVER @ = IF DROP THEN CR ." ÑÒÀÍÄÀÐÒÍÛÉ ÏÎÐßÄÎÊ ÏÎÈÑÊÀ: " BEGIN 2- BEGIN 2+ DUP .VOC (VOC) DROP DUP 0= UNTIL DROP DUP -1 = UNTIL DROP CR ." ÍÀËÈ×ÍÛÅ ÑÏÈÑÊÈ ÑËÎÂ: " VOC-LINK @ BEGIN DUP 2- .VOC @ DUP 0= UNTIL DROP ;

Ýêðàí íîìåð 44

( 31.03.86 WORDS ) : WORDS ( -> ) ." ÑÏÈÑÎÊ " CONTEXT @ DUP .VOC DUP (VOC) ." ÂÑÅÃÎ ÑËÎÂ - " . ." CËÅÄÓÞÙÈÉ ÑÏÈÑÎÊ - " ?DUP IF 2+ .VOC THEN CR @ BEGIN DUP DUP IF @ [ &DWORD ] LITERAL <> THEN WHILE DUP C@ [ &SFLAG ] LITERAL AND 0= IF DUP ID. SPACE THEN N>LINK @ REPEAT DROP ;

Ýêðàí íîìåð 45

( 31.03.86 (FORGET/ FORGET REMEMBER FORGET0 ) : (FORGET) ( A-> ÈÑÊËÞ×ÈÒÜ ÂÑÅ ÑËÎÂÀ ÂÛØÅ ÀÄÐÅÑÀ À ) DUP FENCE @ U< ABORT" ÇÀÙÈÒÀ ÏÎ FENCE" >R VOC-LINK @ BEGIN R@ OVER U< WHILE FORTH DEFINITIONS @ DUP VOC-LINK ! REPEAT ( ÄÎØËÈ ÄÎ ÑÏÈÑÊÀ, ÃÄÅ ÅÑÒÜ ÝÒÎ ÑËÎÂÎ ) BEGIN DUP 4 - BEGIN N>LINK @ DUP R@ U< UNTIL OVER 2- ! @ ?DUP 0= UNTIL R> DP! ; : FORGET ( ->) ' >NAME (FORGET) ; : REMEMBER ( ->) CREATE DOES> (FORGET) ;

Ýêðàí íîìåð 46

( 31.09.86 (#SCR/ LIST SCR? INDEX ) : (#SCR) ( N->A,T ÏÅÐÅÂÅÑÒÈ ÍÎÌÅÐ N ÝÊÐÀÍÀ  ÒÅÊÑÒÎÂÎÅ ÈÌß ) BASE @ >R DECIMAL 0 <# #S #> R> BASE ! ; : LIST ( N-> ÐÀÑÏÅ×ÀÒÀÒÜ ÝÊÐÀÍ N, ÇÀÏÎÌÍÈÒÜ ÅÃÎ Â "SCR" ) DUP SCR ! CR ." ÝÊÐÀÍ " DUP (#SCR) TYPE BLOCK 16 0 DO DUP I 64 * + CR I 3 .R SPACE 64 TYPE LOOP DROP ;

Ýêðàí íîìåð 47

( 31.03.86 ÑÒÀÍÄÀÐÒÍÛÅ ÑÒÐÓÊÒÓÐÛ ÓÏÐÀÂËÅÍÈß ) : BEGIN ?COMP <MARK 1 ; IMMEDIATE : UNTIL 1 ?PAIRS COMPILE ?BRANCH <RESOLVE ; IMMEDIATE : AGAIN 1 ?PAIRS COMPILE BRANCH <RESOLVE ; IMMEDIATE : IF ?COMP COMPILE ?BRANCH &gtMARK 2 ; IMMEDIATE : THEN 2 ?PAIRS &gtRESOLVE ; IMMEDIATE : ELSE 2 ?PAIRS COMPILE BRANCH &gtMARK SWAP &gtRESOLVE 2 ; IMMEDIATE : WHILE 1 ?PAIRS 1 [COMPILE] IF ; IMMEDIATE : REPEAT &gtR &gtR [COMPILE] AGAIN R&gt R&gt [COMPILE] THEN ; IMMEDIATE : DO ?COMP COMPILE (DO) &gtMARK <MARK 3 ; IMMEDIATE : LOOP 3 ?PAIRS COMPILE (LOOP) <RESOLVE &gtRESOLVE ; IMMEDIATE : +LOOP 3 ?PAIRS COMPILE (+LOOP) <RESOLVE &gtRESOLVE ; IMMEDIATE