-


- (. ), .  — 8  ( 200 ).  — .

, , . . : : . , , . FIRST SECOND . PUSH, POP PULL . PUSH , POP , , PULL . , [, . 191], =F ( ) =B ( ). =H, . :

RW1 — , ;

RW2 — , ;

RI — ;

RRET — ;

RSTACK — ;

RD — - ;

RFORTH — , -;

RNEXT — NEXT ( , RFORTH);

RTWO — 2;


RMASK — 65535.

, 13 0, 1, 14 15 .

- 1 47. , . -.

. :

 — ;

 — ;

 — ;

 — ;

 — , ;

 — , ;

 — ;

+ — «-83»;

* — .

, ( ->), , ( ->). , ( ) .

, , :

+N — ;

 — -;

 — ( , , );

CFA — ;

D — ;

F — (0 — , 0 — );

FF — (0);

L — ();

LFA — ;

N — ;

NFA — ;



PFA — ;

 — ;

TF — ( 0, -1);

U — ;

UD — ;

W — (N U);

WD — (D UD).

, (/). : 0 () , 0 () — .

* -> ( ) - 40 [ -> 22 ['] -> // CFA 41 ->CFA // [COMPILE] -> 41 "IMMEDIATE" . N-> N 38 .( -> 28 ." -> 28 37 .R + N1,+N2-> N1 38 +N2 .VOC * PFA+2-> 43 < N1,N2->F F , N1 N2 19 <> + W1,W2->F F , W1 W2 19 <# -> 37 <MARK K ->A 19 <RESOLVE K A-> 19 ( -> - 28 (.") *K -> , ." 28 (+LOOP) * N-> "DO +LOOP" 5 N (;CODE) *K -> 31 (#SCR) * N->A,T N 46 (A") * F-> , ABORT" 29 (DO) *K W1,W2-> W2 W1 24 (EXPECT) * A,+N1->A,+N2 6 +N1 ; +N2 - (FIND) * -1,AN,,,A1,T->CFA,C,TF/FF 34 1,,,AN; CFA - (FORGET) * A-> 45 (LOOP) * -> "DO LOOP" 5 (VOC) * PFA1+2->PFA2,N/0,N N 43 PFA1+2 PFA , + W1,W2->W3 W1 W2 17 +! W,A-> W 17 +BUF * A1->A2,F 25 +LOOP HK A1,A2,3-> // 47 N-> // "DO +LOOP" N ! W,A-> W 11 !CSP * -> CSP 29 ] -> 22 * N1,N2->N3 N1 N2 18 */ N1,N2,N3->N4 N1*N2 N3 18 */MOD N1,N2,N3->N4,N5 N4 N5 18 N1*N2 N3 ; HK -> 32 ;S + -> 41 - W1,W2->W3 W2 W1 17 --> + -> 41 -FIND * ->A,N ; 35 , FIND -TRAILING A,N1->A,N2 41 / N1,N2->N3 N1 N2 18 /MOD N1,N2->N3,N4 N3 N4 18 N1 N2 , W-> W 11 ," * -> 28 > N1,N2->F F , N1 N2 19 >= * N1,N2->F F , N1 N2 19 >BODY CFA->PFA 30 >IN ->A - 8 >LINK * CFA->LFA 30 >MARK K ->A 19 >NAME * CFA->NFA 30 >R K W-> W 9 >RESOLVE K A-> 19 ? * A-> 38 ?+ * +N->+N , +N 29 ?ABORT * F,T-> F , 29 ABORT ?BRANCH K F-> F "", BRANCH, 5 , ?COMP * -> , - 29 ?CSP * -> " " 29 CSP ?DUP W->W,W W, 9 ?GAP * N-> " ", 29 N ?LOADING * -> " ", 29 ?PAIRS * W1,W2-> " ", 29 W1 W2 ?STACK * -> " ", 29 , , " " , 10 : -> 32 # D1->D2 D1 BASE 37 1 PAD, D2 #> D->A,+N ; 37 +N #S D1->0,0 D1 # 37 #TIB ->A - TIB 8 @ A->W 11 ' ->CFA CFA 41 = W1,W2->F F , W1 W2 19 " * -> // 28 ->T // ". * T-> T 28 ABORT -> QUIT 28 ABORT" -> // F "" ( ) 29 F-> // ABORT ABORT8 * -> " " 29 ABS N1->N2 17 AGAIN + A,1-> // "BEGIN AGAIN" 47 -> // ALIGN * +N-> +N 10 ALIGNH * -> 10 ALLOT W-> W 10 ALPHA * N->C N 37 AND W1,W2->W3 "" 13 B/BUF + ->1024 7 BADWORD * A-> 29 BASE ->A - 8 - BEGIN ->A,1 // "BEGIN" 47 -> // BL + ->64 - 7 BLANK + A,U-> U 22 BLK ->A - - 8 BLOCK +N->A +N 25 BODY> * PFA->CFA 30 BRANCH K -> 5 BRANCH# M 5 BUFFER +N->A +N 25 C! C,A-> 11 C, + C-> 11 @ A->C 11 C" *H -> // 28 ->C // CMOVE A1,A2,U-> U A1 A2 21 CMOVE> A1,A2,U-> U A1 21 2 COMPILE K -> 22 CONSTANT W-> 32 W CONTEXT ->A - , 7 CONVERT WD1,A1->WD2,A2 WD1 39 1+1 WD2 2 - 1- COUNT T->A,N 28 N T CR -> 6 CREATE -> ( PFA) 36 ; PFA CREATE# A "VARIABLE" 3 CSP * ->A 8 CURRENT ->A - 7 D.


D-> D 38 D.R D,+N-> D +N 38 D< D1,D2->F F "", D1 D2 15 D+ WD1,WD2->WD3 WD1 WD2 14 D- WD1,WD2->WD3 WD1-WD2 14 D/ * D1,D2->D3 D3 D1 D2 15 D/MOD * D1,D2->D3,D4 D3 D4 15 D1 D2 D= WD1,WD2->F F "", WD1 WD2 15 DABS D1->D2 14 DECIMAL -> 22 DEFINITIONS -> CURRENT CONTEXT 31 DEPTH ->+N 20 DIGIT * C,N1->N2,TF/FF N2 - 39 N1 DMAX WD1,WD2->WD3 16 DMIN WD1,WD2->WD3 16 DMOD * D1,D2->D3 D3 D1 D2 15 DNEGATE D1->D2 D1 14 DO HK ->A1,A2,3 // DO 47 N1,N2-> // N2 N1 DOES> HK -> "" 36 DOES# M - DOES> 3 DP! * A-> 10 DPL + ->A - 8 DROP W-> 9 DU< UD1,UD2->F F "", UD1 UD2 14 DUMP + A,U-> U 42 DUP W->W,W 9 D0< D->F F "", D 15 D0= WD->F F "", WD 15 D2/ D1->D2 15 ELSE HK A1,2->A2,2 // 2- 47 -> // IF EMIT C-> 6 EMPTY-BUFFERS + -> 25 ENCLOSE * A,C->A,N1,N2,N3 27 ERASE + A,U-> U 22 ERCOND8 M 4 EXECUTE CFA-> CFA 11 EXIT K -> 4 EXIT# M "EXIT" 4 EXPECT A,+N-> +N 40 ; SPAN ; FENCE * ->A - FORGET 7 FILL A,U,C-> U 22 FIND T->A,N 35 N=0, = ; =CFA , N=1 "IMMEDIATE" N=-1 FIRST * ->A - 2 FIRST# FIRST 2 FL# A 33 FORTH FLUSH -> 26 FORGET -> 45 , FORTH -> CONTEXT 33 FORTH-83 -> - 33 FORTH# A PFA+2 FORTH 33 GOTO M 4 H. + U-> U 38 16- HERE ->A 10 HEX + -> 22 HLD * ->A - , 8 PAD HOLD HOLD C-> PAD 37 I K ->W W DO 24 I' +K ->W W DO 24 ID. * NFA-> 31 IF HK ->A,2 // IF 47 F-> // IMMEDIATE -> IMMEDIATE 31 INDEX + N1,N2-> 46 N1 N2 INTERPRET + -> 40 IPUSH M - 4 J K ->W W 24 DO KEY ->C 6 L>NAME * LFA->NFA 30 LATEST * ->NFA NFA 31 LEAVE K -> DO 24 LENGMASK M - 2 IMMEDIATE LENG1MSK M - 2 IMMEDIATE SMUDGE LENG2MSK M - 2 LHRW12 M 4 RW2 () RW1 LIMIT * ->A - 2 LIMIT# M LIMIT 2 LINK> * LFA->CFA 30 LIST + N-> N 46 LIT *K ->W 23 LIT" *K ->T 28 , LITERAL H W-> // W 23 ->W // LOAD +N-> +N 41 LOOP HK A1,A2,3-> // "DO LOOP" 47 -> // LRW1 M 4 RW1 LRW12 M 4 RW2 () RW1 M* * N1,N2->D N1 N2 18 M/ * D,N1->N2,N3 N2 N3 18 D N1 M/MOD * UD1,U2->U3,UD4 U3 16 UD4 UD1 U2 MAX N1,N2->N3 N1 N2 22 MIN N1,N2->N3 N1 N2 22 MOD N1,N2->N3 N1 N2 18 MSG * ->A - MSG 2 MSG# M MSG 2 N>LINK * NFA->LFA 30 NAME> * NFA->CFA 30 NEGATE W1->W2 W1 17 NEXT M 1 NEXT1 M 1 - 14 NOT W1->W2 13 NUMBER + T->WD WD 39 OFFSET + ->A - 8 OR W1,W2->W3 "" 13 OVER W1,W2->W1,W2,W1 9 PAD ->A PAD 37 PICK WN,...,W0,+N->WN,...,W0,WN 12 N- POP M 3 POPPUT1 M 3 RW1 PREV *C ->A - 7 PUSHRW1 M 3 RW1 PUSH2RW1 M 3 RW1 PUTRW1 M 3 RW1 QUERY + -> TIB; 40 #TIB QUIT -> , 28 R. * -> 42 R> K ->W 9 R@ K ->W 9 RBLK * A,+N-> +N A 6 RDROP *K -> 9 RECURSE +HK -> 31 REMEMBER + -> , 45 REPEAT HK A1,1,A2,2-> // 47 -> // BEGIN WHILE REPEAT ROLL WN,WN-1,...,W0,+N->WN-1,...,W0,WN 12 N ROT W1,W2,W3->W2,W3,W1 9 RP! * A-> 20 RP@ * ->A 20 R0 *C ->A - 7 S. * -> 42 S>D * N->D N D 14 SAVE-BUFFERS -> 26 SCR + ->A - LIST 8 SIGN N-> 37 , N SMUDGE * -> SMUDGE 31 SNAPSTK * A1,A2,A3-> 1 2 42 3; " " SP! * A-> 20 SP@ + ->A 20 SPACE -> 23 SPACES +N-> +N 23 SPAN ->A EXPECT 8 STATE ->A 8 : "" - SWAP W1,W2->W2,W1 2 9 S0 + ->A - 7 TEMP M 2 THEN HK A,2-> // IF 47 -> // THRU + +N1,+N2-> 41 +N1 +N2 TIB ->A 2 TIB# M - TIB 2 TYPE A,+N-> +N 6 U.


U-> U 38 U.R + U,+N-> U 38 +N U< U1,U2->F F "", U1 U2 16 UM* U1,U2->UD UD U1 U2 16 UM/MOD UD,U1->U2,U3 U2 U3 16 UD U1 UNSMUDGE * -> SMUDGE 31 UNTIL HK A,1-> // "BEGIN UNTIL" 47 F-> // UPDATE -> 25 USE *C ->A - 7 VARIABLE -> 32 VOC-LINK * ->A - 33 VOCABULARY VOCABULARY -> 33 CURRENT VOCABULARY# A VOCABULARY 33 VOCS * -> 43 WBLK * A,+N-> +N 6 WHILE HK 1->A,2 // WHILE 47 F-> // "BEGIN WHILE REPEAT" WIDTH * ->N - 7 WORD C->T - ; 27 WORDS + -> 44 CONTEXT XOR W1,W2->W3 " " 13 0 * ->0 ( "") 7 0< N->F F "", N 13 0<> * W->F F "", W 19 0! * A-> 11 0= W->F F "", W 13 1+ W1->W2 W1 1 17 1+! + A-> 1 17 1- W1->W2 W1 1 17 2+ W1->W2 W1 2 17 2! WD,A-> WD A 20 2* + W1->W2 1 20 2- W1->W2 W1 2 17 2/ W1->W2 1 20 2@ A->WD 20 2CONSTANT WD-> 32 WD 2DROP WD-> 12 2DUP WD->WD,WD 12 2LIT *K ->WD 2 23 2LITERAL *H WD-> // WD 23 ->WD // 2OVER WD1,WD2->WD1,WD2,WD1 12 2POP M 3 2POPPUT1 M 3 4- RW1 2PUSHRW1 M 3 RW1 2PUTRW1 M 3 4- RW1 2ROT WD1,WD2,WD3->WD2,WD3,WD1 12 2SWAP WD1,WD2->WD2,WD1 12 2VARIABLE -> 32 - * -> - 40



1

( 09.09.86 - ) DECIMAL ( ) 128 CONSTANT &IFLAG ( "IMMEDIATE") 32 CONSTANT &SFLAG ( "SMUDGE") 31 CONSTANT &LENG ( ) &SFLAG 256 * 64 + CONSTANT &DWORD ( ) ( RFORTH) START-CODE *, RFORTH USING, ( ) M: NEXT 14 0 (, RI RFORTH LH, RI RTWO AR, M: NEXT1 14 RMASK NR, 15 0 (, 14 RFORTH LH, 15 RMASK NR, 15 RFORTH AR, 14 RTWO AR, 15 BR,

2

( 09.09.86 ) CONST MSG M: MSG# 0 H, ( MSG) CONST FIRST M: FIRST# 0 H, ( ) CONST LIMIT M: LIMIT# 0 H, ( ) CONST TIB M: TIB# 0 H, ( TIB) 4 ALIGN M: LENGMASK 255 &IFLAG - S>D F, ( IMMEDIATE) M: LENG1MSK 255 &IFLAG - &SFLAG - S>D F, ( IMMD SMDG) M: LENG2MSK &LENG S>D F, ( ) 8 ALIGN M: TEMP 16 ALLOT ( )

3

( 09.09.86 ) M: DOES# RI RPUSH, RI 4 (, 15 LA, RI RFORTH SR, A: CREATE# RW1 14 LR, ( PFA ) M: PUSHRW1 RSTACK RTWO SR, ( RW1) M: PUTRW1 RW1 PUT, RNEXT BR, ( ) M: 2POP RSTACK RTWO AR, ( ) M: POP RSTACK RTWO AR, RNEXT BR, ( ) M: POPPUT1 RSTACK RTWO AR, ( ) RW1 PUT, RNEXT BR, ( RW1) M: 2PUSHRW1 RSTACK RTWO SR, ( ) M: PUSH2RW1 RSTACK RTWO SR, ( ) M: 2PUTRW1 RW1 TEMP ST, ( ) FIRST (, 4 ), TEMP MVC, RNEXT BR, M: 2POPPUT1 RSTACK RTWO AR, RSTACK RTWO AR, 2PUTRW1 B,

4

( 09.09.86 : .14) M: LHRW12 RW1 SECOND LH, RW2 PULL, 14 BR, M: LRW1 TEMP (, 4 ), FIRST MVC, RW1 TEMP L, 14 BR, M: LRW12 TEMP (, 8 ), FIRST MVC, RW1 TEMP 4 +(, L, RW2 TEMP L, 14 BR, M: GOTO 14 0 (, 0 14 LH, NEXT1 B, M: IPUSH RI PUSH, RW2 RW2 SR, RW2 0 (, RI RFORTH IC, RI 2 (, RI RW2 LA, 14 BR, CODE EXIT M: EXIT# RI RPOP, RI RMASK NR, RNEXT BR, END-CODE M: ERCOND8 14 GOTO BAL, ] ABORT8 [



5

( 09.09.86 BRANCH ?BRANCH (LOOP/ (+LOOP/ ) CODE BRANCH M: BRANCH# RI 0 (, RI RFORTH LH, RI RMASK NR, RNEXT BR, CODE ?BRANCH RW1 POP, RW1 RW1 LTR, BRANCH# BZ, RI RTWO AR, RNEXT BR, CODE (LOOP) RW1 1 LA, 1 =F B, CODE (+LOOP) RW1 POP, 1 =H 0 RFIRST LH, 0 RSECOND SH, 0 RMASK NR, 0 RW1 AR, RW1 RFIRST AH, RW1 RFIRST STH, 0 RMASK CLR, BRANCH# BNH, RRET 6 (, 0 RRET LA, RI RTWO AR, RNEXT BR, END-CODE

6

( 09.09.86 KEY CR EMIT TYPE (EXPECT/ RBLK WBLK ) ( ) CODE KEY ( ->C ) END-CODE CODE CR ( -> ) END-CODE CODE EMIT ( C-> ) END-CODE CODE TYPE ( A,N-> N ) END-CODE CODE (EXPECT) ( A,N1->A,N2 N1 / / ; N2 - ) END-CODE CODE RBLK ( A,N-> N ) END-CODE CODE WBLK ( A,N-> N ) END-CODE

7

( 09.09.86 ) 64 CONSTANT BL ( ) 1024 CONSTANT B/BUF ( ) &LENG CONSTANT WIDTH ( ) 0 CONSTANT 0 ( ) VARIABLE USE ( ) VARIABLE PREV ( ) VARIABLE S0 ( ) VARIABLE R0 ( ) VARIABLE FENCE ( "FORGET") VARIABLE CONTEXT ( - ) VARIABLE CURRENT ( - )

8

( 09.09.86 - ) VARIABLE OFFSET ( ) VARIABLE BASE ( ) VARIABLE STATE ( ) VARIABLE DPL ( ) VARIABLE CSP ( ) VARIABLE HLD ( "PAD") VARIABLE BLK ( ) VARIABLE >IN ( ) VARIABLE SPAN ( , "EXPECT") VARIABLE #TIB ( , "TIB") VARIABLE SCR ( , "LIST")



9

( 31.03.86 DUP ?DUP DROP SWAP OVER >R R> R@ RDROP ROT ) CODE DUP ( W->W,W) RW1 PULL, PUSHRW1 B, END-CODE : ?DUP ( W->W,W; 0->0 ) DUP IF DUP THEN ; CODE DROP ( W-> ) RSTACK RTWO AR, RNEXT BR, END-CODE CODE SWAP ( W1,W2->W2,W1) 14 LHRW12 BAL, RW2 SECOND STH, PUTRW1 B, END-CODE CODE OVER ( W1,W2->W1,W2,W1) RW1 SECOND LH, PUSHRW1 B, END-CODE CODE >R ( W-> ) RW1 POP, RW1 RPUSH, RNEXT BR, END-CODE CODE R> ( ->W) RW1 RPOP, PUSHRW1 B, END-CODE CODE R@ ( ->W) RW1 RPULL, PUSHRW1 B, END-CODE CODE RDROP ( -> ) RRET RTWO AR, RNEXT BR, END-CODE : ROT ( N1,N2,N3->N2,N3,N1 ) >R SWAP R> SWAP ;

10

( 31.03.86 HERE ALLOT ALIGN ALIGNH DP! ) CODE HERE ( ->A ) RW1 RD LR, PUSHRW1 B, END-CODE CODE ALLOT ( N-> ) RD FIRST AH, POP B, END-CODE CODE ALIGN ( N-> ) RW1 0 (, RD RFORTH LA, 0 (, RW1 0 MVI, 1 (, 7 RW1 ), 0 (, RW1 MVC, RW1 PULL, RW2 RW1 LCR, RD RW1 AR, RD 0 BCTR, RD RW2 NR, POP B, END-CODE : ALIGNH ( -> ) 2 ALIGN ; CODE DP! ( A-> ) RD PULL, RD RMASK NR, POP B, END-CODE

11

( 31.03.86 ! 0! @ C! C@ , C, EXECUTE ) CODE ! ( W,A-> W ) 14 LHRW12 BAL, RW2 RMASK NR, RW1 0 (, RW2 RFORTH STH, 2POP B, END-CODE : 0! ( A-> ) 0 SWAP ! ; CODE @ ( A->W ) RW2 PULL, RW2 RMASK NR, RW1 0 (, RW2 RFORTH LH, PUTRW1 B, END-CODE CODE C@ ( A->C) RW2 PULL, RW2 RMASK NR, RW1 RW1 SR, RW1 0 (, RW2 RFORTH IC, PUTRW1 B, END-CODE CODE C! ( C,A-> ) 14 LHRW12 BAL, RW2 RMASK NR, RW1 0 (, RW2 RFORTH STC, 2POP B, END-CODE : , ( W-> ) HERE 2 ALLOT ! ; : C, ( C-> ) HERE 1 ALLOT C! ; CODE EXECUTE ( CFA-> ) 14 POP, NEXT1 B, END-CODE

12

( 31.03.86 ROLL PICK 2DUP 2DROP 2SWAP 2OVER 2ROT ) CODE ROLL ( WN,WN-1,...,W0,+N->WN-1,...,W0,WN) RW2 PULL, RW2 RW2 AR, ERCOND8 BM, RW1 SECOND (, RW2 LH, BEGIN, 0 FIRST (, RW2 LH, 0 SECOND (, RW2 STH, RW2 RTWO SR, ?NP UNTIL, POPPUT1 B, END-CODE CODE PICK ( WN,...,W0,+N->WN,...,W0,WN) RW2 PULL, RW2 RW2 AR, ERCOND8 BM, RW1 2 (, RW2 RSTACK LH, PUTRW1 B, END-CODE : 2DUP ( WD->WD,WD) OVER OVER ; : 2DROP ( WD->) DROP DROP ; : 2SWAP ( WD1,WD2->WD2,WD1) 3 ROLL 3 ROLL ; : 2OVER ( WD1,WD2->WD1,WD2,WD1) 3 PICK 3 PICK ; : 2ROT ( WD1,WD2,WD3->WD2,WD3,WD1) 5 ROLL 5 ROLL ;



13

( 31.03. 86 AND OR XOR NOT 0= 0< ) CODE AND ( W1,W2->W3) 14 LHRW12 BAL, RW1 RW2 NR, POPPUT1 B, END-CODE CODE OR ( W1,W2->W3) 14 LHRW12 BAL, RW1 RW2 OR, POPPUT1 B, END-CODE CODE XOR ( W1,W2->W3) 14 LHRW12 BAL, RW1 RW2 XR, POPPUT1 B, END-CODE : NOT ( W1->W2 ) -1 XOR ; CODE 0= ( W->F) RW1 RW1 SR, RW2 PULL, RW2 RW2 LTR, PUTRW1 BNZ, RW1 0 BCTR, PUTRW1 B, END-CODE CODE 0< ( N->F) RW1 RW1 SR, RW2 PULL, RW2 RW2 LTR, PUTRW1 BNM, RW1 0 BCTR, PUTRW1 B, END-CODE

14

( 31.03.86 S>D DABS DNEGATE D+ D- DU< ) CODE S>D ( N->D ) RW1 PULL, PUSH2RW1 B, END-CODE CODE DABS ( D1->D2) 14 LRW1 BAL, RW1 RW1 LPR, 2PUTRW1 B, END-CODE CODE DNEGATE ( WD1->WD2) 14 LRW1 BAL, RW1 RW1 LCR, 2PUTRW1 B, END-CODE CODE D+ ( WD1,WD2->WD3) 14 LRW12 BAL, RW1 RW2 AR, 2POPPUT1 B, END-CODE CODE D- ( WD1,WD2->WD3) 14 LRW12 BAL, RW1 RW2 SR, 2POPPUT1 B, END-CODE CODE DU< ( UD1,UD2->F) 14 LRW12 BAL, 0 0 SR, RW1 RW2 CLR, ?L IF, 0 0 BCTR, THEN, RSTACK 6 (, 0 RSTACK LA, 0 PUT, RNEXT BR, END-CODE

15

( 31.03.86 D/MOD D/ DMOD D0= D= D0< D< D2/ ) CODE D/MOD ( D1,D2->D3,D4) 14 LRW12 BAL, 1 RW1 LR, 0 RW2 LR, RW1 32 SRDA, RW1 0 DR, 1 0 XR, 1 1 LTR, ?M IF, RW1 0 AR, RW1 0 BCTR, THEN, RW1 TEMP ST, FIRST 4 +(, 4 ), TEMP MVC, RW1 RW2 LR, 2PUTRW1 B, END-CODE : D/ ( D1,D2->D3) D/MOD 2SWAP 2DROP ; : DMOD ( D1,D2->D3) D/MOD 2DROP ; : D0= ( WD->F) OR 0= ; : D= ( WD1,WD2->F) D- D0= ; : D0< ( D->F) SWAP DROP 0< ; : D< ( D1,D2->F) D- D0< ; CODE D2/ ( D1->D2) 14 LRW1 BAL, RW1 1 SRA, PUTRW1 B, END-CODE

16

( 09.09.86 UM* UM/MOD U< M/MOD DMAX DMIN ) CODE UM* ( U1,U2->UD) 14 LHRW12 BAL, RW1 RMASK NR, RW2 RMASK NR, RW1 RW1 MR, RW1 RW2 LR, 2PUTRW1 B, END-CODE CODE UM/MOD ( UD,U1->U2,U3) 1 POP, 1 RMASK NR, 14 LRW1 BAL, RSTACK RTWO SR, RW2 RW1 LR, RW1 RW1 SR, RW1 1 DR, RW1 FIRST 4 +(, STH, RW1 RW2 LR, POPPUT1 B, END-CODE CODE U< ( U1,U2->F) RW1 RW1 SR, RW2 PULL, RW2 RMASK NR, 0 SECOND LH, 0 RMASK NR, 0 RW2 CR, POPPUT1 BNL, RW1 0 BCTR, ( "") POPPUT1 B, END-CODE : M/MOD ( UD1,U2->U3,UD4) >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ; : DMAX ( D1,D2->D3) 2OVER 2OVER D< IF 2SWAP THEN 2DROP ; : DMIN ( D1,D2->D3) 2OVER 2OVER D< NOT IF 2SWAP THEN 2DROP ;



17

( 31.03.86 NEGATE ABS + - 1+ 1- 2+ 2- +! 1+! ) CODE NEGATE ( W1->W2) RW1 PULL, RW1 RW1 LCR, PUTRW1 B, END-CODE : ABS ( N1->+N2) S>D DABS DROP ; CODE + 14 LHRW12 BAL, RW1 RW2 AR, POPPUT1 B, END-CODE : - ( W1,W2->W3) NEGATE + ; : 1+ ( W1->W2) 1 + ; : 1- ( W1->W2) -1 + ; : 2+ ( W1->W2) 2 + ; : 2- ( W1->W2) 2 - ; CODE +! ( W,A->) 14 LHRW12 BAL, RW2 RMASK NR, RW1 0 (, RW2 RFORTH AH, RW1 0 (, RW2 RFORTH STH, 2POP B, END-CODE : 1+! ( A->) 1 SWAP +! ;

18

( 03.10.86 M* M/ * /MOD / MOD */MOD */ ) CODE M* ( N1,N2->D) RW1 SECOND LH, RW1 FIRST MH, 2PUTRW1 B, END-CODE CODE M/ ( D,N1->N2,N3) 1 POP, 14 LRW1 BAL, RSTACK RTWO SR, RW1 32 SRDA, 0 RW1 LR, RW1 1 DR, 0 1 XR, 0 0 LTR, ?M IF, RW1 1 AR, RW2 0 BCTR, THEN, RW1 FIRST 4 +(, STH, RW1 RW2 LR, ( ) POPPUT1 B, END-CODE : * ( N1,N2->N3) M* DROP ; : /MOD ( N1,N2->N3,N4) >R S>D R> M/ ; : / ( N1,N2->N3) /MOD SWAP DROP ; : MOD ( N1,N2->N3) /MOD DROP ; : */MOD ( N1,N2,N3->N4,N5) >R M* R> M/ ; : */ ( N1,N2,N3->N4) */MOD SWAP DROP ;

19

( 31.03.86 ) : 0<> ( N->F) 0= NOT ; : = ( W1,W2->F) - 0= ; : <> ( W1,W2->F) - 0<> ; : < ( N1,N2->F) - 0< ;

: >MARK ( ->A ) HERE 0 , ; : >RESOLVE ( A-> ) HERE SWAP ! ; : <MARK ( ->A ) HERE ; : <RESOLVE ( A-> ) , ;

20

( 31.03.86 SP@ SP! RP@ RP! 2/ 2* 2@ 2! DEPTH ) CODE SP@ ( ->A) RW1 RSTACK LR, RW1 RFORTH SR, PUSHRW1 B, END-CODE CODE SP! ( A->) RSTACK PULL, RSTACK RMASK NR, RSTACK RFORTH AR, RNEXT BR, END-CODE CODE RP@ ( ->A) RW1 RRET LR, RW1 RFORTH SR, PUSHRW1 B, END-CODE CODE RP! ( A->) RRET POP, RRET RMASK NR, RRET RFORTH AR, RNEXT BR, END-CODE CODE 2/ ( W1->W2 ) RW1 PULL, RW1 1 SRA, PUTRW1 B, END-CODE : 2* ( W1->W2 ) DUP + ; : 2@ ( A->WD) DUP 2+ @ SWAP @ ; : 2! ( WD,A->) DUP >R ! R> 2+ ! ; : DEPTH ( ->+N) SP@ S0 @ SWAP - 2/ ;

21

( 31.03.86 CMOVE CMOVE> ) CODE CMOVE ( A1,A2,U->) 14 LHRW12 BAL, RW2 RMASK NR, 2 =F BZ, RW1 RMASK NR, RW1 RFORTH AR, 1 FIRST 4 +(, LH, 1 RMASK NR, 1 RFORTH AR, 0 256 LA, 1 =F B, BEGIN, 0 (, 256 RW1 ), 0 (, 1 MVC, RW1 0 AR, 1 0 AR, 1 =H RW2 0 SR, ?M UNTIL, RW2 0 BCTR, RW2 0 AR, ?NM IF, RW2 3 =F EX, THEN, 2 =H RSTACK 6 (, 0 RSTACK LA, RNEXT BR, 3 =H 0 (, 1 RW1 ), 0 (, 1 MVC, END-CODE CODE CMOVE> ( A1,A2,U->) 14 LHRW12 BAL, RW2 RMASK NR, 1 =F BZ, RW1 RMASK NR, RW1 RFORTH AR, RW1 0 BCTR, 1 FIRST 4 +(, LH, 1 RMASK NR, 1 RFORTH AR, 1 0 BCTR, DO, 0 0 (, 1 RW2 IC, 0 0 (, RW1 RW2 STC, RW2 LOOPBCT, 1 =H RSTACK 6 (, 0 RSTACK LA, RNEXT BR, END-CODE



22

( 31.03. 86 FILL ERASE BLANK COMPILE [ ] MIN MAX HEX DECIMAL) : FILL ( A,U,C->) SWAP ?DUP IF >R OVER C! DUP 1+ R> 1- CMOVE EXIT THEN 2DROP ; : ERASE ( A,U-> ) 0 FILL ; : BLANK ( A,U-> ) BL FILL ; : COMPILE ( -> ) R> DUP 2+ >R @ , ; : [ ( -> ) STATE 0! ; IMMEDIATE : ] ( -> ) -1 STATE ! ; CODE MIN ( N1,N2->N3 ) 14 LHRW12 BAL, RW1 RW2 CR, POP BNH, RW1 RW2 LR, POPPUT1 B, END-CODE CODE MAX ( N1,N2->N3 ) 14 LHRW12 BAL, RW1 RW2 CR, POP BNL, RW1 RW2 LR, POPPUT1 B, END-CODE : HEX ( ->) 16 BASE ! ; : DECIMAL ( ->) 10 BASE ! ;

23

( 31.03.86 LIT 2LIT LITERAL 2LITERAL SPACE SPACES ) CODE LIT ( ->W ) RW1 0 (, RI RFORTH LH, RI RTWO AR, PUSHRW1 B, END-CODE CODE 2LIT ( ->WD ) RW1 4 LA, RSTACK RW1 SR, RW2 0 (, RI RFORTH LA, FIRST (, 4 ), 0 (, RW2 MVC, RI RW1 AR, RNEXT BR, END-CODE : LITERAL ( W->) STATE @ IF COMPILE LIT , THEN ; IMMEDIATE : 2LITERAL ( WD->) STATE @ IF COMPILE 2LIT , , THEN ; IMMEDIATE : SPACE ( ->) BL EMIT ; : SPACES ( +N->) 0 OVER < IF 0 DO SPACE LOOP EXIT THEN DROP ;

24

( 09.09.86 : (DO/ I I' J LEAVE ) CODE (DO) ( U1,U2-> ) 14 LHRW12 BAL, 1 =H 1 0 (, RI RFORTH LH, 1 RPUSH, RI RTWO AR, RW1 RPUSH, RW2 RPUSH, 2POP B, END-CODE CODE I ( ->U ) RW1 RPULL, PUSHRW1 B, END-CODE CODE I' ( ->U ) RW1 RSECOND LH, PUSHRW1 B, END-CODE CODE J ( ->U 2- ) RW1 RFIRST 6 +(, LH, PUSHRW1 B, END-CODE CODE LEAVE ( ->) RI RFIRST 4 +(, LH, RI RMASK NR, RRET 6 (, 0 RRET LA, RNEXT BR, END-CODE

25

( 31.03.86 +BUF BUFFER BLOCK EMPTY-BUFFERS UPDATE ) : +BUF ( A1->A2,F ) B/BUF 4 + + DUP LIMIT = IF DROP FIRST THEN DUP PREV @ - ; : BUFFER ( +N->A) OFFSET @ + USE @ DUP >R ( ) BEGIN +BUF UNTIL USE ! R@ @ 0< IF ( "UPDATE") R@ 2+ R@ @ 32767 AND WBLK THEN R@ ! R@ PREV ! R> 2+ ; : BLOCK ( +N->A) OFFSET @ + >R PREV @ DUP @ R@ - DUP + IF BEGIN +BUF 0= IF DROP R@ OFFSET @ - BUFFER DUP R@ RBLK 2- THEN DUP @ R@ - DUP + 0= UNTIL DUP PREV ! THEN RDROP 2+ ; : EMPTY-BUFFERS ( -> ) FIRST LIMIT OVER - ERASE ; : UPDATE ( -> ) PREV @ @ 32768 OR PREV @ ! ;



26

( 31.03.86 SAVE-BUFFERS FLUSH ) : SAVE-BUFFERS ( -> ) LIMIT FIRST DO I @ 32768 AND IF I @ 32767 AND DUP I ! I 2+ SWAP WBLK THEN B/BUF 4 + +LOOP ; : FLUSH ( -> ) SAVE-BUFFERS EMPTY-BUFFERS ;

27

( 31.03.86 ENCLOSE WORD ) CODE ENCLOSE ( A,C->A,N1,N2,N3) 14 LHRW12 BAL, RW1 RMASK NR, RW1 RFORTH AR, 14 14 SR, 0 0 SR, BEGIN, 0 0 (, 14 RW1 IC, 0 0 LTR 2 =F BZ, 14 1 (, 0 14 LA, 0 RW2 CR, ?NE UNTIL, 14 0 BCTR, 2 =H 14 PUT, BEGIN, 1 14 LR, 0 0 (, 1 RW1 IC, 0 0 LTR, 2 =F BZ, 14 1 (, 0 14 LA, 0 RW2 CR, ?E UNTIL, 2 =H 1 PUSH, RW1 14 LR, PUSHRW1 B, END-CODE : WORD ( C->T ) BLK @ IF BLK @ BLOCK ELSE TIB THEN >IN @ + SWAP ENCLOSE >IN +! HERE >R OVER - >R + ALIGNH HERE 1+ R@ CMOVE HERE R> 1+ ALLOT ALIGNH HERE OVER - 2- OVER C! R> DP! ;

28

( 31.03.86 LIT" COUNT ," " ". (."/ ." C" ( .( QUIT ABORT ) CODE LIT" ( ->T ) 14 IPUSH BAL, RNEXT BR, END-CODE : COUNT ( T->A,N) DUP 1+ SWAP C@ 2DUP + C@ IF 1+ THEN ; : ," ( -> ) C" " WORD C@ 2+ ALLOT ALIGNH ; : " ( ->T) ?COMP COMPILE LIT" ," ; IMMEDIATE : ". ( T-> ) COUNT TYPE ; CODE (.") ( ->) 14 IPUSH BAL, 14 GOTO BAL, ] ". [ : ." ( -> ) ?COMP COMPILE (.") ," ; IMMEDIATE : C" ( ->C) BL WORD 1+ C@ [COMPILE] LITERAL ; IMMEDIATE : ( ( ->) C" ) WORD DROP ; IMMEDIATE : .( ( ->) C" ) WORD COUNT TYPE ; IMMEDIATE : QUIT ( ->) [COMPILE] [ S0 @ SP! R0 @ RP! - ;

29

( 31.03.86 ) : ?ABORT ( F,T->) SWAP IF COUNT CR TYPE ABORT THEN DROP ; CODE (A") ( F->) 14 IPUSH BAL, 14 GOTO BAL, ] ?ABORT [ END-CODE : ABORT" ( F->) COMPILE (A") ," ; IMMEDIATE : ABORT8 ( ->) -1 ABORT" " ; : !CSP ( ->) SP@ CSP 1 ; : ?CSP ( ->) SP@ CSP @ - ABORT" " ; : ?PAIRS ( N1,N2-> ) - ABORT" " ; CODE ?+ ( N->N ) FIRST 128 TM, RNEXT BZR, ERCOND8 B, END-CODE : ?COMP ( ->) STATE @ NOT ABORT" " ; : BADWORD ( T->) CR ". ." ?" ABORT ;



30

( 31.03.86 >BODY BODY> >LINK LINK> L>NAME N>LINK >NAME NAME> ) : >BODY ( CFA->PFA) 2+ ; : BODY> ( PFA->CFA) 2- ; : >LINK ( CFA->LFA) 2- ; : LINK> ( LFA->CFA) 2+ ; CODE L>NAME ( LFA->NFA) RW2 PULL, RW2 RMASK NR, RW1 RW2 LR, 14 &LENG LA, 1 1 SR, DO, RW1 RTWO SR, 1 0 (, RW1 RFORTH IC, 1 LENG1MSK N, 0 2 (, 1 RW1 LA, 0 RW2 CR, PUTRW1 BE, 14 LOOPBCT, PUTRW1 B, END-CODE : N>LINK ( NFA->LFA) DUP C@ 31 AND + 2+ ; : >NAME ( CFA->NFA) >LINK L>NAME ; : NAME> ( NFA->CFA) N>LINK LINK> ;

31

( 31.03.86 LATEST DEFINITIONS SMUDGE UNSMUDGE IMMEDIATE ID.) : LATEST ( ->NFA) CURRENT @ @ ; ( (;CODE/ RECURSE ) : DEFINITIONS ( ->) CONTEXT @ CURRENT ! ; : SMUDGE ( ->) LATEST C@ [ &SFLAG ] LITERAL OR LATEST C! ; : UNSMUDGE ( ->) LATEST C@ [ 255 &SFLAG - ] LITERAL AND LATEST C! ; : IMMEDIATE ( ->) LATEST C@ [ &IFLAG ] LITERAL OR LATEST C! ; : ID. ( NFA-> ) DUP 1+ SWAP C@ [ &LENG ] LITERAL AND 2DUP + C@ IF 1+ THEN TYPE SPACE ; : (;CODE) ( -> ) R> LATEST NAME> ! ; : RECURSE ( -> ) LATEST NAME> , ; IMMEDIATE

32

( 31.03.86 CONSTANT VARIABLE 2CONSTANT 2VARIABLE : ; ) : ?LOADING ( ->) BLK @ 0= ABORT" " ; : ?GAP ( N->) HERE + SP@ SWAP U< ABORT" " ; : ?STACK ( ->) S0 @ SP@ U< ABORT" " 10 ?GAP ; : CONSTANT ( W-> ) CREATE , ;CODE RW1 0 (, 14 RFORTH LH, PUSHRW1 B, END-CODE : VARIABLE ( -> ) CREATE 0 , ; : 2VARIABLE ( -> ) CREATE 0 , 0 , ; : 2CONSTANT ( WD-> ) CREATE , , DOES> 2@ ; : : ( -> ) !CSP CREATE ] SMUDGE ;CODE RI RPUSH, RI 14 LR, RNEXT BR, END-CODE : ; ( -> ) ?CSP COMPILE EXIT UNSMUDGE [COMPILE] [ ; IMMEDIATE

33

( 09.09.86 FORTH FORTH# FL# VOC-LINK VOCABULARY VOCABULARY# ) VOC FORTH &DWORD H, ( FORTH-83 ) A: FORTH# LASTWORD ( ) A: FL# 0 H, ( ) CREATE VOC-LINK FL# ( ) : VOCABULARY ( -> ) CREATE [ &DWORD ] LITERAL , LIT [ FORTH# ] CONTEXT @ - IF CONTEXT @ 2- ELSE 0 THEN , HERE VOC-LINK @ , VOC-LINK ! DOES> [ THERE 4 - :A: VOCABULARY# ] 2+ CONTEXT ! ; : FORTH-83 ( ->) FORTH DEFINITIONS DECIMAL ;



34

( 31.03.86 (FIND/ ) CODE (FIND) ( -1,AN,...,A1,T->CFA,C,TF/FF ) RW2 POP, RW2 RMASK NR, RW2 RFORTH AR, ( ) 0 0 SR, 0 0 (, 0 RW2 IC, 0 LENG1MSK N, ( ) 1 1 SR, 1 0 BCTR, BEGIN, RW1 PULL, ( ) 2 =F B, BEGIN, RW1 RFORTH AR, 14 0 (, 0 RW1 IC, 14 LENGMASK N, 14 0 CR, ?E IF, 14 4 =F EX, 3 =F BE, THEN, 14 LENG1MSK N, RW1 2 (, 14 RW1 LH, 2 =H RW1 RMASK NR, ?Z UNTIL, RSTACK RTWO AR, 1 FIRST CH, ?E UNTIL, PUTRW1 B, BEGIN, RSTACK RTWO AR, 3 =H 1 FIRST CH, ?E UNTIL, 0 0 (, 0 RW1 IC, RW1 RFORTH SR, RW1 4 (, 14 RW1 LA, RW1 PUT, 0 PUSH, RW1 1 LR, PUSHRW1 B, 4 =H 1 (, 1 RW1 ), 1 (, RW2 CLC, END-CODE

35

( 31.03.86 FIND -FIND ) : FIND ( T->A,N) DUP >R -1 LIT [ FORTH# ] @ CURRENT @ @ 2DUP = IF DROP THEN CONTEXT @ @ 2DUP = IF DROP THEN R> (FIND) DUP IF DROP ROT DROP [ &IFLAG ] LITERAL AND IF 1 ELSE -1 THEN THEN ; : -FIND ( ->A,N) BL WORD FIND ;

36

( 09.09.86 CREATE DOES> ) : CREATE ( -> ) 100 ?GAP ALIGNH -FIND SWAP DROP IF HERE ID. ." " ABORT THEN HERE DUP C@ WIDTH AND 2+ ALLOT ALIGNH HERE OVER - 2- OVER C! LATEST , CURRENT @ ! LIT [ CREATE# ] , ;

: DOES> ( -> ) COMPILE (;CODE) 2LIT [ DOES# B, ] , , ; IMMEDIATE

37

( 31.03.86 PAD HOLD ALPHA <# #> # #S SIGN ) : PAD ( ->A) HERE 100 + ; : HOLD ( C-> ) -1 HLD +! HLD @ C! ; CODE ALPHA ( N->C) RW2 FIRST LH, RW1 RW1 SR, RW1 1 =F (, RW2 IC, PUTRW1 B, 1 =H C,' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' END-CODE : <# ( -> ) PAD HLD ! ; : #> ( D->A,+N) 2DROP HLD @ PAD OVER - ; : # ( D1->D2) BASE @ M/MOD ROT ALPHA HOLD ; : #S ( D->0,0) BEGIN # 2DUP OR 0= UNTIL ; : SIGN ( N->) 0< IF C" - HOLD THEN ;

38

( 31.03.86 D.R D. .R . H. U. U.R ? ) : D.R ( D,+N-> ) ?+ >R DUP >R DABS <# #S R> SIGN #> R> OVER - SPACES TYPE ; : D. ( D-> ) 0 D.R SPACE ; : .R ( N1,+N2->) >R S>D R> D.R ; : . ( N-> ) S>D D. ; : H. ( N->) BASE @ SWAP 0 HEX <# # # # # #> TYPE SPACE BASE ! ; : U. ( U->) 0 D. ; : U.R ( U,+N->) >R 0 >R D.R ; : ? ( A-> ) @ . ;



39

( 31.03.86 DIGIT CONVERT NUMBER ) : DIGIT ( C,N1->N2,TF/FF) 0 ROT ROT 0 DO I ALPHA OVER = IF 2DROP I -1 0 LEAVE THEN LOOP DROP ; : CONVERT ( WD1,A1->WD2,A2) BEGIN 1+ DUP >R C@ BASE @ DIGIT WHILE SWAP BASE @ UM* DROP ROT BASE @ UM* D+ DPL @ 1+ IF DPL 1+! THEN R> REPEAT R> ; : NUMBER ( T->WD ) 0 0 ROT DUP >R COUNT OVER + OVER C@ C" - = DUP >R SWAP >R IF ELSE 1- THEN -1 BEGIN DPL ! CONVERT DUP R@ < WHILE DUP C@ C" . <> IF RDROP RDROP R> BADWORD THEN 0 REPEAT DROP RDROP R> IF DNEGATE THEN RDROP ;

40

( 31.03.86 EXPECT QUERY INTERPRET - X ) : EXPECT ( A,+N-> ) DUP >R (EXPECT) DUP SPAN ! TYPE R> SPAN @ - IF SPACE THEN ; : QUERY ( ->) TIB 80 EXPECT >IN 0! BLK 0! SPAN @ #TIB ! ; : INTERPRET ( ->) BEGIN -FIND ?DUP IF 1+ IF EXECUTE ELSE STATE @ IF , ELSE EXECUTE THEN THEN ELSE NUMBER DPL @ 1+ IF [COMPILE] 2LITERAL ELSE DROP [COMPILE] LITERAL THEN THEN ?STACK AGAIN ; : - ( ->) BEGIN QUERY INTERPRET AGAIN ; CODE X ( ->) -X ( "X") EXIT# B, END-CODE IMMEDIATE

41

( 31.03.86 -TRAILING ' ['] [COMPILE] LOAD THRU ;S --> ) CODE -TRAILING ( A,N1->A,N2) 14 LHRW12 BAL, RW1 RMASK NR, RW1 RFORTH AR, 0 RW1 LR, RW1 RW2 AR, BEGIN, RW1 0 CR, 1 =F BNH, RW1 0 BCTR, 0 (, RW1 64 CLI, ?NE UNTIL, 0 0 BCTR, 1 =H RW1 0 SR, PUTRW1 B, END-CODE : ' ( ->CFA) -FIND 0= IF BADWORD THEN ; : ['] ( -> ) ?COMP ' [COMPILE] LITERAL ; IMMEDIATE : [COMPILE] ( ->) -FIND IF , EXIT THEN BADWORD ; IMMEDIATE : LOAD ( N-> N ) >IN @ >R BLK @ >R BLK ! >IN 0! INTERPRET R> BLK ! R> >IN ! ; : THRU ( N1,N2-> N1 N2 ) 1+ SWAP DO I LOAD LOOP ; : ;S ( ->) ?LOADING RDROP ; IMMEDIATE : --> ( ->) ?LOADING >IN 0! BLK 1+! ; IMMEDIATE

42

( 09.09.86 DUMP SNAPSTK S. R. ) : DUMP ( A,U-> U ) DUP IF BASE @ >R HEX OVER + SWAP DO CR I <# C" * HOLD 0 15 DO DUP I + C@ HOLD -1 +LOOP C" * HOLD 0 15 DO BL HOLD DUP I + C@ 0 # # 2DROP -1 +LOOP BL HOLD BL HOLD 0 # # # # #> TYPE 16 +LOOP R> BASE ! ELSE 2DROP THEN ; : SNAPSTK RDROP CR ". ." , " 2DUP SWAP - 2/ DUP . 0 SWAP , IF ." ( )" CR 2- DO I @ . -2 +LOOP ELSE 2DROP THEN ; : S. ( ->) SP@ S0 @ " " SNAPSTK ; : R. ( ->) RP@ 2+ R0 @ " " SNAPSTK ;



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










Forekc.ru
, , , , , , , , , ,