;\r
; hForth 8086 EXE model v0.9.9 by Wonyong Koh, 1997\r
;\r
+; 1997. 7. 11.\r
+; Fix SPACES. Thank Benjamin Hoyt.\r
+; 1997. 6. 23.\r
+; Fix pack".\r
; 1997 6. 4.\r
; Fix the problem that data are corrupted at segment boundary\r
; when .EXE file saved by SAVE-INPUT-AS is larger\r
$NAME 5,'code,',CodeComma,NameCodeComma,_SLINK\r
$NAME 5,'ALIGN',ALIGNN,NameALIGNN,_FLINK\r
$NAME 7,'ALIGNED',ALIGNED,NameALIGNED,_FLINK\r
- $NAME 5,'pack"',PackQuote,NamePackQuote,_SLINK\r
- $NAME 5,'CELLS',CELLS,NameCELLS,_FLINK\r
+ $NAME 5,'pack"',PackQuote,NamePackQuote,_SLINK\r
+ $NAME 5,'CELLS',CELLS,NameCELLS,_FLINK\r
$NAME 5,'CHARS',CHARS,NameCHARS,_FLINK\r
$NAME 7,'1chars/',OneCharsSlash,NameOneCharsSlash,_SLINK\r
$NAME 1,'!',Store,NameStore,_FLINK\r
AND BX,0FFFEh\r
$NEXT\r
\r
-; pack" is dependent of cell alignment.\r
-;\r
-; pack" ( c-addr u a-addr -- a-addr2 )\r
-; Place a string c-addr u at a-addr and gives the next\r
-; cell-aligned address. Fill the rest of the last cell with\r
-; null character.\r
-;\r
-; : pack" OVER max-char > IF -18 THROW THEN \ parsed string overflow\r
-; 2DUP SWAP CHARS + CHAR+ ALIGNED DUP >R \ ca u aa aa+u+1\r
-; cell- 0 SWAP ! \ fill 0 at the end of string\r
-; 2DUP C! CHAR+ SWAP \ c-addr a-addr+1 u\r
-; CHARS MOVE R> ;\r
-;\r
-; $COLON NamePackQuote,PackQuote\r
-; DW OVER,DoLIT,MaxChar,GreaterThan,ZBranch,PACKQ1\r
-; DW DoLIT,-18,THROW\r
-; PACKQ1 DW TwoDUP,SWAP,CHARS,Plus,CHARPlus,ALIGNED,DUPP,ToR\r
-; DW CellMinus,DoLIT,0,SWAP,Store\r
-; DW TwoDUP,CStore,CHARPlus,SWAP\r
-; DW CHARS,MOVE,RFrom,EXIT\r
-\r
- $CODE NamePackQuote,PackQuote\r
- POP AX\r
- PUSH AX\r
- CMP AX,MaxChar\r
- JG PACKQ1\r
- MOV DI,BX\r
- MOV DX,SI\r
- MOV AX,DS\r
- MOV ES,AX\r
- POP CX\r
- POP SI\r
- MOV BYTE PTR [DI],CL\r
- INC DI\r
- REP MOVSB\r
- TEST DI,1 ;odd address?\r
- JZ PACKQ2\r
- MOV BYTE PTR [DI],0\r
- INC DI\r
-PACKQ2: MOV BX,DI\r
- MOV SI,DX\r
- $NEXT\r
-PACKQ1: MOV BX,-18\r
- JMP THROW\r
- $ALIGN\r
-\r
; CELLS ( n1 -- n2 ) \ CORE\r
; Calculate number of address units for n1 cells.\r
;\r
MOV BX,[BX-2*CELLL]\r
$NEXT\r
\r
+; pack" ( c-addr u a-addr -- a-addr2 )\r
+; Place a string c-addr u at a-addr and gives the next\r
+; cell-aligned address. Fill the rest of the last cell with\r
+; null character.\r
+;\r
+; : pack" 2DUP SWAP CHARS + CHAR+ DUP >R \ ca u aa aa+u+1\r
+; ALIGNED cell- 0 SWAP ! \ fill 0 at the end of string\r
+; 2DUP C! CHAR+ SWAP \ c-addr a-addr+1 u\r
+; CHARS MOVE R> ALIGNED ; COMPILE-ONLY\r
+;\r
+; $COLON 5,'pack"',PackQuote,_SLINK\r
+; DW TwoDUP,SWAP,CHARS,Plus,CHARPlus,DUPP,ToR\r
+; DW ALIGNED,CellMinus,Zero,SWAP,Store\r
+; DW TwoDUP,CStore,CHARPlus,SWAP\r
+; DW CHARS,MOVE,RFrom,ALIGNED,EXIT\r
+\r
+ $CODE NamePackQuote,PackQuote\r
+ MOV DI,BX\r
+ MOV DX,SI\r
+ MOV AX,DS\r
+ MOV ES,AX\r
+ POP CX\r
+ POP SI\r
+ MOV BYTE PTR [DI],CL\r
+ INC DI\r
+ REP MOVSB\r
+ TEST DI,1 ;odd address?\r
+ JZ PACKQ2\r
+ MOV BYTE PTR [DI],0\r
+ INC DI\r
+PACKQ2: MOV BX,DI\r
+ MOV SI,DX\r
+ $NEXT\r
+\r
; PARSE-WORD ( "<spaces>ccc<space>" -- c-addr u )\r
; Skip leading spaces and parse a word. Return the name.\r
;\r
; SPACES ( n -- ) \ CORE\r
; Send n spaces to the output device if n is greater than zero.\r
;\r
-; : SPACES ?DUP IF 0 DO SPACE LOOP THEN ;\r
+; : SPACES DUP 0 > IF 0 DO SPACE LOOP EXIT THEN DROP;\r
;\r
-; $COLON NameSPACES,SPACES\r
-; DW QuestionDUP,ZBranch,SPACES2\r
-; DW DoLIT,0,DoDO\r
-; SPACES1 DW SPACE,DoLOOP,SPACES1\r
-; SPACES2 DW EXIT\r
+; $COLON 6,'SPACES',SPACES,_FLINK\r
+; DW DUPP,Zero,GreaterThan,ZBranch,SPACES1\r
+; DW Zero,DoDO\r
+; SPACES2 DW SPACE,DoLOOP,SPACES2\r
+; DW EXIT\r
+; SPACES1 DW DROP,EXIT\r
\r
$CODE NameSPACES,SPACES\r
OR BX,BX\r
- JZ SPACES2\r
+ JLE SPACES2\r
PUSH SI\r
SUB BP,CELLL\r
MOV [BP],BX\r
; hForth 8086 RAM model v0.9.9 by Wonyong Koh, 1997\r
;\r
;\r
+; 1997. 7. 11.\r
+; Fix SPACES. Thank Benjamin Hoyt.\r
+; 1997. 6. 23.\r
+; Fix pack".\r
; 1997. 2. 19.\r
; Split environmental variable systemID into CPU and Model.\r
; 1997. 2. 6.\r
AND BX,0FFFEh\r
$NEXT\r
\r
-; pack" is dependent of cell alignment.\r
-;\r
-; pack" ( c-addr u a-addr -- a-addr2 )\r
-; Place a string c-addr u at a-addr and gives the next\r
-; cell-aligned address. Fill the rest of the last cell with\r
-; null character.\r
-;\r
-; : pack" 2DUP SWAP CHARS + CHAR+ DUP >R \ ca u aa aa+u+1\r
-; 1 CHARS - 0 SWAP ! \ fill 0 at the end of string\r
-; 2DUP C! CHAR+ SWAP \ c-addr a-addr+1 u\r
-; CHARS MOVE R> ; COMPILE-ONLY\r
-\r
- $COLON 5,'pack"',PackQuote,_SLINK\r
- DW TwoDUP,SWAP,CHARS,Plus,CHARPlus,DUPP,ToR\r
- DW DoLIT,CHARR,Minus,Zero,SWAP,Store\r
- DW TwoDUP,CStore,CHARPlus,SWAP\r
- DW CHARS,MOVE,RFrom,EXIT\r
-\r
; CELLS ( n1 -- n2 ) \ CORE\r
; Calculate number of address units for n1 cells.\r
;\r
$COLON 7,'name>xt',NameToXT,_SLINK\r
DW COUNT,DoLIT,MASKK,ANDD,Plus,ALIGNED,CELLPlus,EXIT\r
\r
+; pack" ( c-addr u a-addr -- a-addr2 )\r
+; Place a string c-addr u at a-addr and gives the next\r
+; cell-aligned address. Fill the rest of the last cell with\r
+; null character.\r
+;\r
+; : pack" 2DUP SWAP CHARS + CHAR+ DUP >R \ ca u aa aa+u+1\r
+; ALIGNED cell- 0 SWAP ! \ fill 0 at the end of string\r
+; 2DUP C! CHAR+ SWAP \ c-addr a-addr+1 u\r
+; CHARS MOVE R> ALIGNED ; COMPILE-ONLY\r
+\r
+ $COLON 5,'pack"',PackQuote,_SLINK\r
+ DW TwoDUP,SWAP,CHARS,Plus,CHARPlus,DUPP,ToR\r
+ DW ALIGNED,CellMinus,Zero,SWAP,Store\r
+ DW TwoDUP,CStore,CHARPlus,SWAP\r
+ DW CHARS,MOVE,RFrom,ALIGNED,EXIT\r
+\r
; PARSE-WORD ( "<spaces>ccc<space>" -- c-addr u )\r
; Skip leading spaces and parse a word. Return the name.\r
;\r
; SPACES ( n -- ) \ CORE\r
; Send n spaces to the output device if n is greater than zero.\r
;\r
-; : SPACES ?DUP IF 0 DO SPACE LOOP THEN ;\r
+; : SPACES DUP 0 > IF 0 DO SPACE LOOP EXIT THEN DROP;\r
\r
$COLON 6,'SPACES',SPACES,_FLINK\r
- DW QuestionDUP,ZBranch,SPACES2\r
+ DW DUPP,Zero,GreaterThan,ZBranch,SPACES1\r
DW Zero,DoDO\r
-SPACES1 DW SPACE,DoLOOP,SPACES1\r
-SPACES2 DW EXIT\r
+SPACES2 DW SPACE,DoLOOP,SPACES2\r
+ DW EXIT\r
+SPACES1 DW DROP,EXIT\r
\r
; TO Interpretation: ( x "<spaces>name" -- ) \ CORE EXT\r
; Compilation: ( "<spaces>name" -- )\r
; hForth 8086 ROM model v0.9.9 by Wonyong Koh, 1997\r
;\r
;\r
+; 1999. 3. 5.\r
+; Fix bugs reported by Mr. Neal Crook. Thank Neal Crook.\r
+; Fix Forth definition of ACCEPT. \r
+; Add high-level definition of 2DROP and 2DUP.\r
+; Remove superfluous THEN in optiCOMPILE,ACCEPT, and UM/MOD.\r
+; LITERAL in the high-level definitions of doubleAlso, singleOnly,\r
+; and SLITERAL should have been 'POSTPONE LITERAL'.\r
+; S" in the high-level definitions of ABORT" should have been \r
+; 'POSTPONE S"'.\r
+; The hith-level definition of REPEAT should have been \r
+; 'POSTPONE AGAIN POSTPONE THEN'.\r
+; Add COMSTANT word 'sysVar00'.\r
+; 1998. 1. 5.\r
+; Mr. Kwon Hyuk Kun reported several bugs. Thank Mr. Kwon.\r
+; Fix REFILL . 'Fetch' was missing in DW statement. Thank Kwon Hyuk Kun.\r
+; Fix PARSE . It should have been 'CHARS OVER +' to calculate\r
+; c_addr+u*chars from 'c_addr u'.\r
+; Add CHARS in the definition of 'head,'.\r
+; It is more convenient to use up-growing stack for some \r
+; microprocessors such as 8051 family. I, J, and DEPTH\r
+; are now processor-dependent words.\r
+; 1997. 8. 26.\r
+; Introduce MaxCountedString.\r
+; 1997. 8. 16.\r
+; Replace 'EKEY max-char AND' with KEY in ACCEPT.\r
+; 1997. 7. 11.\r
+; Fix SPACES. Thank Benjamin Hoyt.\r
+; 1997. 6. 23.\r
+; Fix pack".\r
; 1997. 2. 19.\r
; Split environmental variable systemID into CPU and Model.\r
; 1997. 2. 6.\r
\r
CHARR EQU 1 ;byte size of a character\r
CELLL EQU 2 ;byte size of a cell\r
+MaxCountedString EQU 0FFh ;max char length of counted string\r
MaxChar EQU 0FFh ;Extended character set\r
; Use 07Fh for ASCII only\r
MaxSigned EQU 07FFFh ;max value of signed integer\r
ROM0 EQU 0 ;bottom of ROM memory ******\r
ROMEnd EQU 08000h ;end of ROM memory ******\r
;ROM size = 32KB\r
-COLDD EQU ROM0+00100h ;cold start vector ******\r
+COLDD EQU 00100h ;cold start vector ******\r
\r
Trapfpc EQU RAMEnd ;reserve a cell for microdebugger\r
RPP EQU RAMEnd-CELLL ;start of return stack (RP0)\r
DW 0 ;bal\r
DW 0 ;notNONAME?\r
DW 0 ;rakeVar\r
-NOrder0 DW 2 ;#order\r
+ DW 2 ;#order\r
DW FORTH_WORDLISTAddr ;search order stack\r
DW NONSTANDARD_WORDLISTAddr\r
DW (OrderDepth-2) DUP (0)\r
$THROWMSG '[IF], [ELSE], or [THEN] exception' ;-58\r
\r
;;;;;;;;;;;;;;;;\r
-; System dependent words -- Must be re-definded for each system.\r
+; System dependent words -- Must be re-defined for each system.\r
;;;;;;;;;;;;;;;;\r
; I/O words must be redefined if serial communication is used instead of\r
; keyboard. Following words are for MS-DOS system.\r
; CR ( -- ) \ CORE\r
; Carriage return and linefeed.\r
;\r
-; : CR carriage-return-char EMIT linefeed-char EMIT ;\r
+; : CR [ carriage-return-char ] LITERAL EMIT [ linefeed-char ] LITERAL EMIT ;\r
\r
$COLON 2,'CR',CR,_FLINK\r
DW DoLIT,CRR,EMIT,DoLIT,LFF,EMIT,EXIT\r
; ." by Wonyong Koh, 1997" CR\r
; ." ALL noncommercial and commercial uses are granted." CR\r
; ." Please send comment, bug report and suggestions to:" CR\r
-; ." wykoh@pado.krict.re.kr or wykoh@hitel.kol.co.kr" CR ;\r
+; ." wykoh@pado.krict.re.kr or wykoh@free.xtel.com" CR ;\r
\r
$COLON 2,'hi',HI,_SLINK\r
DW CR\r
DW TYPEE,CR\r
$INSTR 'Please send comment, bug report and suggestions to:'\r
DW TYPEE,CR\r
- $INSTR ' wykoh@pado.krict.re.kr or wykoh@hitel.kol.co.kr'\r
+ $INSTR ' wykoh@pado.krict.re.kr or wykoh@free.xtel.com'\r
DW TYPEE,CR,EXIT\r
\r
; COLD ( -- )\r
; >R \ wid R: ca1 u\r
; BEGIN @ \ ca2 R: ca1 u\r
; DUP 0= IF R> R> 2DROP EXIT THEN \ not found\r
-; DUP COUNT [ =MASK ] LITERAL AND R@ = \ ca2 ca2+char f\r
+; DUP COUNT [ =mask ] LITERAL AND R@ = \ ca2 ca2+char f\r
; IF R> R@ SWAP DUP >R \ ca2 ca2+char ca1 u\r
; same? \ ca2 flag\r
; \ ELSE DROP -1 \ unnecessary since ca2+char is not 0.\r
; WHILE cell- \ pointer to next word in wordlist\r
; REPEAT\r
; R> R> 2DROP DUP name>xt SWAP \ xt ca2\r
-; C@ DUP [ =COMP ] LITERAL AND 0= SWAP\r
-; [ =IMED ] LITERAL AND 0= 2* 1+ ;\r
+; C@ DUP [ =comp ] LITERAL AND 0= SWAP\r
+; [ =immed ] LITERAL AND 0= 2* 1+ ;\r
;\r
; $COLON 17,'(search-wordlist)',ParenSearch_Wordlist,_SLINK\r
; DW ROT,ToR,SWAP,DUPP,ZBranch,PSRCH6\r
; CALL instruction and leaves the next cell address after the\r
; CALL instruction. Otherwise leaves the original xt1 and zero.\r
;\r
-; : ?call DUP @ call-code =\r
+; : ?call DUP @ [ call-code ] LITERAL =\r
; IF CELL+ DUP @ SWAP CELL+ DUP ROT + EXIT THEN\r
; \ Direct Threaded Code 8086 relative call\r
; 0 ;\r
; CREATE . Return xt2 of current definition.\r
;\r
; : xt, xhere ALIGNED DUP TOxhere SWAP\r
-; call-code code, \ Direct Threaded Code\r
-; xhere CELL+ - code, ; \ 8086 relative call\r
+; [ call-code ] LITERAL code, \ Direct Threaded Code\r
+; xhere CELL+ - code, ; \ 8086 relative call\r
\r
$COLON 3,'xt,',xtComma,_SLINK\r
DW XHere,ALIGNED,DUPP,TOXHere,SWAP\r
; ALIGNED ( addr -- a-addr ) \ CORE\r
; Align address to the cell boundary.\r
;\r
-; : ALIGNED DUP 0 cell-size UM/MOD DROP DUP\r
-; IF cell-size SWAP - THEN + ; \ slow, very portable\r
+; : ALIGNED DUP 0 [ cell-size ] LITERAL UM/MOD DROP DUP\r
+; IF [ cell-size ] LITERAL SWAP - THEN + ; \ slow, very portable\r
;\r
; $COLON 7,'ALIGNED',ALIGNED,_FLINK\r
; DW DUPP,Zero,DoLIT,CELLL\r
AND BX,0FFFEh\r
$NEXT\r
\r
-; pack" is dependent of cell alignment.\r
-;\r
-; pack" ( c-addr u a-addr -- a-addr2 )\r
-; Place a string c-addr u at a-addr and gives the next\r
-; cell-aligned address. Fill the rest of the last cell with\r
-; null character.\r
-;\r
-; : pack" 2DUP SWAP CHARS + CHAR+ DUP >R \ ca u aa aa+u+1\r
-; 1 CHARS - 0 SWAP ! \ fill 0 at the end of string\r
-; 2DUP C! CHAR+ SWAP \ c-addr a-addr+1 u\r
-; CHARS MOVE R> ; COMPILE-ONLY\r
-\r
- $COLON 5,'pack"',PackQuote,_SLINK\r
- DW TwoDUP,SWAP,CHARS,Plus,CHARPlus,DUPP,ToR\r
- DW DoLIT,CHARR,Minus,Zero,SWAP,Store\r
- DW TwoDUP,CStore,CHARPlus,SWAP\r
- DW CHARS,MOVE,RFrom,EXIT\r
-\r
-; CELLS ( n1 -- n2 ) \ CORE\r
+; CELLS ( n1 -- n2 ) \ CORE\r
; Calculate number of address units for n1 cells.\r
;\r
-; : CELLS cell-size * ; \ slow, very portable\r
-; : CELLS 2* ; \ fast, must be redefined for each system\r
+; : CELLS [ cell-size ] LITERAL * ; \ slow, very portable\r
+; : CELLS 2* ; \ fast, must be redefined for each system\r
\r
$COLON 5,'CELLS',CELLS,_FLINK\r
DW TwoStar,EXIT\r
; CHARS ( n1 -- n2 ) \ CORE\r
; Calculate number of address units for n1 characters.\r
;\r
-; : CHARS char-size * ; \ slow, very portable\r
-; : CHARS ; \ fast, must be redefined for each system\r
+; : CHARS [ char-size ] LITERAL * ; \ slow, very portable\r
+; : CHARS ; \ fast, must be redefined for each system\r
\r
$COLON 5,'CHARS',CHARS,_FLINK\r
DW EXIT\r
\r
+; It is more convenient to use up-growing stack for some microprocessors such as 8051 family.\r
+; In those cases I, J, and DEPTH should be redefined.\r
+\r
+; I ( -- n|u ) ( R: loop-sys -- loop-sys ) \ CORE\r
+; Push the innermost loop index.\r
+;\r
+; : I rp@ [ 1 CELLS ] LITERAL + @\r
+; rp@ [ 2 CELLS ] LITERAL + @ + ; COMPILE-ONLY\r
+\r
+ $COLON COMPO+1,'I',I,_FLINK\r
+ DW RPFetch,DoLIT,CELLL,Plus,Fetch\r
+ DW RPFetch,DoLIT,2*CELLL,Plus,Fetch,Plus,EXIT\r
+\r
+; J ( -- n|u ) ( R: loop-sys -- loop-sys ) \ CORE\r
+; Push the index of next outer loop.\r
+;\r
+; : J rp@ [ 3 CELLS ] LITERAL + @\r
+; rp@ [ 4 CELLS ] LITERAL + @ + ; COMPILE-ONLY\r
+\r
+ $COLON COMPO+1,'J',J,_FLINK\r
+ DW RPFetch,DoLIT,3*CELLL,Plus,Fetch\r
+ DW RPFetch,DoLIT,4*CELLL,Plus,Fetch,Plus,EXIT\r
+\r
+; DEPTH ( -- +n ) \ CORE\r
+; Return the depth of the data stack.\r
+;\r
+; : DEPTH sp@ sp0 SWAP - [ cell-size ] LITERAL / ;\r
+\r
+ $COLON 5,'DEPTH',DEPTH,_FLINK\r
+ DW SPFetch,SPZero,SWAP,Minus\r
+ DW DoLIT,CELLL,Slash,EXIT\r
+\r
; ! ( x a-addr -- ) \ CORE\r
; Store x at a aligned address.\r
\r
\r
$CONST 7,'sysVar0',SysVar0,UZERO,_SLINK\r
\r
+; sysVar00 ( -- a-addr )\r
+; Start of backup copy of original value table of system variables.\r
+\r
+ $CONST 8,'sysVar00',SysVar00,UZERO0,_SLINK\r
+\r
; sysVar0End ( -- a-addr )\r
; End of initial value table of system variables.\r
\r
$CONST 10,'sysVar0End',SysVar0End,ULAST,_SLINK\r
\r
+; THROWMsgTbl ( -- a-addr ) \ CORE\r
+; Return the address of the THROW message table.\r
+\r
+ $CONST 11,'THROWMsgTbl',THROWMsgTbl,AddrTHROWMsgTbl,_SLINK\r
+\r
; 'ekey? ( -- a-addr )\r
; Execution vector of EKEY?.\r
\r
\r
$VAR 4,'BASE',BASE,_FLINK\r
\r
-; THROWMsgTbl ( -- a-addr ) \ CORE\r
-; Return the address of the THROW message table.\r
-\r
- $CONST 11,'THROWMsgTbl',THROWMsgTbl,AddrTHROWMsgTbl,_SLINK\r
-\r
; ROMB ( -- a-addr )\r
; Bottom of free ROM area.\r
\r
DW DoLIT,VersionStr,COUNT,EXIT\r
\r
$ENVIR 15,'/COUNTED-STRING'\r
- DW DoLIT,MaxChar,EXIT\r
+ DW DoLIT,MaxCountedString,EXIT\r
\r
$ENVIR 5,'/HOLD'\r
DW DoLIT,PADSize,EXIT\r
DW TYPEE,EXIT\r
\r
; .prompt ( -- )\r
-; Disply Forth prompt. This word is vectored.\r
+; Display Forth prompt. This word is vectored.\r
;\r
; : .prompt 'prompt EXECUTE ;\r
\r
; cell- ( a-addr1 -- a-addr2 )\r
; Return previous aligned cell address.\r
;\r
-; : cell- -(cell-size) + ;\r
+; : cell- [ cell-size NEGATE ] LITERAL + ;\r
\r
$COLON 5,'cell-',CellMinus,_SLINK\r
DW DoLIT,0-CELLL,Plus,EXIT\r
; doDO ( n1|u1 n2|u2 -- ) ( R: -- n1 n2-n1-max_negative )\r
; Run-time funtion of DO.\r
;\r
-; : doDO >R max-negative + R> OVER - SWAP R> SWAP >R SWAP >R >R ;\r
+; : doDO >R [ max-negative ] LITERAL + R> OVER - SWAP R> SWAP >R SWAP >R >R ;\r
\r
$COLON COMPO+4,'doDO',DoDO,_SLINK\r
DW ToR,DoLIT,MaxNegative,Plus,RFrom\r
; : head, PARSE-WORD DUP 0=\r
; IF errWord 2! -16 THROW THEN\r
; \ attempt to use zero-length string as a name\r
-; DUP =mask > IF -19 THROW THEN \ definition name too long\r
+; DUP [ =mask ] LITERAL > IF -19 THROW THEN\r
+; \ definition name too long\r
; 2DUP GET-CURRENT SEARCH-WORDLIST \ name exist?\r
; IF DROP ." redefine " 2DUP TYPE SPACE THEN \ warn if redefined\r
-; npVar @ OVER CELL+ - ALIGNED\r
+; npVar @ OVER CHARS CHAR+ - \r
+; DUP ALIGNED SWAP OVER XOR IF CELL- THEN \ aligned to lower addr\r
; DUP >R pack" DROP R> \ pack the name in dictionary\r
; cell- GET-CURRENT @ OVER ! \ build wordlist link\r
; cell- DUP npVar ! ! ; \ adjust name space pointer\r
DW DROP\r
$INSTR 'redefine '\r
DW TYPEE,TwoDUP,TYPEE,SPACE\r
-HEADC2 DW NPVar,Fetch,OVER,CELLPlus,Minus,ALIGNED\r
- DW DUPP,ToR,PackQuote,DROP,RFrom\r
+HEADC2 DW NPVar,Fetch,OVER,CHARS,CHARPlus,Minus\r
+ DW DUPP,ALIGNED,SWAP,OVER,XORR,ZBranch,HEADC4\r
+ DW CellMinus\r
+HEADC4 DW DUPP,ToR,PackQuote,DROP,RFrom\r
DW CellMinus,GET_CURRENT,Fetch,OVER,Store\r
DW CellMinus,DUPP,NPVar,Store,Store,EXIT\r
HEADC1 DW ErrWord,TwoStore,DoLIT,-16,THROW\r
; 2DROP EXIT THEN\r
; DUP CELL+ @ ['] EXIT = IF \ if second word is EXIT\r
; @ DUP ['] doLIT XOR \ make sure it is not literal value\r
-; IF SWAP THEN THEN\r
-; THEN THEN DROP COMPILE, ;\r
+; IF SWAP THEN THEN\r
+; THEN DROP COMPILE, ;\r
\r
$COLON 12,'optiCOMPILE,',OptiCOMPILEComma,_SLINK\r
DW DUPP,QCall,DoLIT,DoLIST,Equals,ZBranch,OPTC2\r
; single cell number in compilation state.\r
;\r
; : singleOnly,\r
-; singleOnly LITERAL ;\r
+; singleOnly POSTPONE LITERAL ;\r
\r
$COLON 11,'singleOnly,',SingleOnlyComma,_SLINK\r
DW SingleOnly,LITERAL,EXIT\r
; compilation state.\r
;\r
; : doubleAlso,\r
-; (doubleAlso) 1- IF SWAP LITERAL THEN LITERAL ;\r
+; (doubleAlso) 1- IF SWAP POSTPONE LITERAL THEN POSTPONE LITERAL ;\r
\r
$COLON 11,'doubleAlso,',DoubleAlsoComma,_SLINK\r
DW ParenDoubleAlso,OneMinus,ZBranch,DOUBC1\r
$COLON 7,'name>xt',NameToXT,_SLINK\r
DW CellMinus,CellMinus,Fetch,EXIT\r
\r
+; pack" ( c-addr u a-addr -- a-addr2 )\r
+; Place a string c-addr u at a-addr and gives the next\r
+; cell-aligned address. Fill the rest of the last cell with\r
+; null character.\r
+;\r
+; : pack" OVER max-counted-string SWAP U< \r
+; IF -18 THROW THEN \ parsed string overflow\r
+; 2DUP SWAP CHARS + CHAR+ DUP >R \ ca u aa aa+u+1\r
+; ALIGNED cell- 0 SWAP ! \ fill 0 at the end of string\r
+; 2DUP C! CHAR+ SWAP \ c-addr a-addr+1 u\r
+; CHARS MOVE R> ALIGNED ; COMPILE-ONLY\r
+\r
+ $COLON COMPO+5,'pack"',PackQuote,_SLINK\r
+ DW OVER,DoLIT,MaxCountedString,SWAP,ULess,ZBranch,PACKQ1\r
+ DW DoLIT,-18,THROW\r
+PACKQ1 DW TwoDUP,SWAP,CHARS,Plus,CHARPlus,DUPP,ToR\r
+ DW ALIGNED,CellMinus,Zero,SWAP,Store\r
+ DW TwoDUP,CStore,CHARPlus,SWAP\r
+ DW CHARS,MOVE,RFrom,ALIGNED,EXIT\r
+\r
; PARSE-WORD ( "<spaces>ccc<space>" -- c-addr u )\r
; Skip leading spaces and parse a word. Return the name.\r
;\r
; Prepare the output string to be TYPE'd.\r
; ||xhere>WORD/#-work-area|\r
;\r
-; : #> 2DROP hld @ xhere size-of-PAD + OVER - 1chars/ ;\r
+; : #> 2DROP hld @ xhere [ size-of-PAD ] LITERAL + OVER - 1chars/ ;\r
\r
$COLON 2,'#>',NumberSignGreater,_FLINK\r
DW TwoDROP,HLD,Fetch,XHere,DoLIT,PADSize*CHARR,Plus\r
; , ( x -- ) \ CORE\r
; Reserve one cell in RAM or ROM data space and store x in it.\r
;\r
-; : , HERE ! cell-size hereVar +! ;\r
+; : , HERE ! [ cell-size ] LITERAL hereVar +! ;\r
\r
$COLON 1,',',Comma,_FLINK\r
DW HERE,Store\r
\r
; 2DROP ( x1 x2 -- ) \ CORE\r
; Drop cell pair x1 x2 from the stack.\r
+;\r
+; : 2DROP DROP DROP ;\r
\r
$COLON 5,'2DROP',TwoDROP,_FLINK\r
DW DROP,DROP,EXIT\r
\r
; 2DUP ( x1 x2 -- x1 x2 x1 x2 ) \ CORE\r
; Duplicate cell pair x1 x2.\r
+;\r
+; : 2DUP DUP DUP ;\r
\r
$COLON 4,'2DUP',TwoDUP,_FLINK\r
DW OVER,OVER,EXIT\r
; Initiate the numeric output conversion process.\r
; ||xhere>WORD/#-work-area|\r
;\r
-; : <# xhere size-of-PAD + hld ! ;\r
+; : <# xhere [ size-of-PAD ] LITERAL + hld ! ;\r
\r
$COLON 2,'<#',LessNumberSign,_FLINK\r
DW XHere,DoLIT,PADSize*CHARR,Plus,HLD,Store,EXIT\r
; = ( x1 x2 -- flag ) \ CORE\r
; Return true if top two are equal.\r
;\r
-; : = XORR 0= ;\r
+; : = XOR 0= ;\r
\r
$COLON 1,'=',Equals,_FLINK\r
DW XORR,ZeroEquals,EXIT\r
$COLON 1,'>',GreaterThan,_FLINK\r
DW SWAP,LessThan,EXIT\r
\r
-; >IN ( -- a-addr )\r
+; >IN ( -- a-addr ) \ CORE\r
; Hold the character pointer while parsing input stream.\r
\r
$VAR 3,'>IN',ToIN,_FLINK\r
;\r
; : ACCEPT >R 0\r
; BEGIN DUP R@ < \ ca n2 f R: n1\r
-; WHILE EKEY max-char AND\r
-; DUP BL <\r
-; IF DUP cr# = IF ROT 2DROP R> DROP EXIT THEN\r
-; DUP tab# =\r
+; WHILE KEY DUP BL <\r
+; IF DUP [ cr# ] LITERAL = IF ROT 2DROP R> DROP EXIT THEN\r
+; DUP [ tab# ] LITERAL =\r
; IF DROP 2DUP + BL DUP EMIT SWAP C! 1+\r
-; ELSE DUP bsp# =\r
-; SWAP del# = OR\r
-; IF DROP DUP\r
-; \ discard the last char if not 1st char\r
-; IF 1- bsp# EMIT BL EMIT bsp# EMIT THEN THEN\r
+; ELSE DUP [ bsp# ] LITERAL =\r
+; SWAP [ del# ] LITERAL = OR\r
+; IF DUP \ discard the last char if not 1st char\r
+; IF 1- [ bsp# ] LITERAL EMIT \r
+; BL EMIT [ bsp# ] LITERAL EMIT THEN \r
+; THEN\r
; THEN\r
-; ELSE >R 2DUP CHARS + R> DUP EMIT SWAP C! 1+ THEN\r
+; ELSE >R 2DUP CHARS + R> DUP EMIT SWAP C! 1+\r
; THEN\r
; REPEAT SWAP R> 2DROP ;\r
\r
$COLON 6,'ACCEPT',ACCEPT,_FLINK\r
DW ToR,Zero\r
ACCPT1 DW DUPP,RFetch,LessThan,ZBranch,ACCPT5\r
- DW EKEY,DoLIT,MaxChar,ANDD\r
- DW DUPP,BLank,LessThan,ZBranch,ACCPT3\r
+ DW KEY,DUPP,BLank,LessThan,ZBranch,ACCPT3\r
DW DUPP,DoLIT,CRR,Equals,ZBranch,ACCPT4\r
DW ROT,TwoDROP,RFrom,DROP,EXIT\r
ACCPT4 DW DUPP,DoLIT,TABB,Equals,ZBranch,ACCPT6\r
; CELL+ ( a-addr1 -- a-addr2 ) \ CORE\r
; Return next aligned cell address.\r
;\r
-; : CELL+ cell-size + ;\r
+; : CELL+ [ cell-size ] LITERAL + ;\r
\r
$COLON 5,'CELL+',CELLPlus,_FLINK\r
DW DoLIT,CELLL,Plus,EXIT\r
; CHAR+ ( c-addr1 -- c-addr2 ) \ CORE\r
; Returns next character-aligned address.\r
;\r
-; : CHAR+ char-size + ;\r
+; : CHAR+ [ char-size ] LITERAL + ;\r
\r
$COLON 5,'CHAR+',CHARPlus,_FLINK\r
DW DoLIT,CHARR,Plus,EXIT\r
$COLON 7,'DECIMAL',DECIMAL,_FLINK\r
DW DoLIT,10,BASE,Store,EXIT\r
\r
-; DEPTH ( -- +n ) \ CORE\r
-; Return the depth of the data stack.\r
-;\r
-; : DEPTH sp@ sp0 SWAP - cell-size / ;\r
-\r
- $COLON 5,'DEPTH',DEPTH,_FLINK\r
- DW SPFetch,SPZero,SWAP,Minus\r
- DW DoLIT,CELLL,Slash,EXIT\r
-\r
; DNEGATE ( d1 -- d2 ) \ DOUBLE\r
; Two's complement of double-cell number.\r
;\r
DW HLD,Fetch,DoLIT,0-CHARR,Plus\r
DW DUPP,HLD,Store,CStore,EXIT\r
\r
-; I ( -- n|u ) ( R: loop-sys -- loop-sys ) \ CORE\r
-; Push the innermost loop index.\r
-;\r
-; : I rp@ [ 1 CELLS ] LITERAL + @\r
-; rp@ [ 2 CELLS ] LITERAL + @ + ; COMPILE-ONLY\r
-\r
- $COLON COMPO+1,'I',I,_FLINK\r
- DW RPFetch,DoLIT,CELLL,Plus,Fetch\r
- DW RPFetch,DoLIT,2*CELLL,Plus,Fetch,Plus,EXIT\r
-\r
; IF Compilation: ( C: -- orig ) \ CORE\r
; Run-time: ( x -- )\r
; Put the location of a new unresolved forward reference orig\r
; KEY ( -- char ) \ CORE\r
; Receive a character. Do not display char.\r
;\r
-; : KEY EKEY max-char AND ;\r
+; : KEY EKEY [ max-char ] LITERAL AND ;\r
\r
$COLON 3,'KEY',KEY,_FLINK\r
DW EKEY,DoLIT,MaxChar,ANDD,EXIT\r
;\r
; : PARSE >R SOURCE >IN @ /STRING \ c-addr u R: char\r
; DUP IF\r
-; OVER CHARS + OVER \ c-addr c-addr+u c-addr R: char\r
+; CHARS OVER + OVER \ c-addr c-addr+u c-addr R: char\r
; BEGIN DUP C@ R@ XOR\r
; WHILE CHAR+ 2DUP =\r
; UNTIL DROP OVER - 1chars/ DUP\r
$COLON 5,'PARSE',PARSE,_FLINK\r
DW ToR,SOURCE,ToIN,Fetch,SlashSTRING\r
DW DUPP,ZBranch,PARSE4\r
- DW OVER,CHARS,Plus,OVER\r
+ DW CHARS,OVER,Plus,OVER\r
PARSE1 DW DUPP,CFetch,RFetch,XORR,ZBranch,PARSE3\r
DW CHARPlus,TwoDUP,Equals,ZBranch,PARSE1\r
PARSE2 DW DROP,OVER,Minus,DUPP,OneCharsSlash,Branch,PARSE5\r
;\r
; : REFILL SOURCE-ID IF 0 EXIT THEN\r
; npVar @ [ size-of-PAD CHARS 2* ] LITERAL - DUP\r
-; size-of-PAD ACCEPT sourceVar 2!\r
+; [ size-of-PAD ] LITERAL ACCEPT sourceVar 2!\r
; 0 >IN ! -1 ;\r
\r
$COLON 6,'REFILL',REFILL,_FLINK\r
DW SOURCE_ID,ZBranch,REFIL1\r
DW Zero,EXIT\r
-REFIL1 DW NPVar,DoLIT,0-PADSize*CHARR*2,Plus,DUPP\r
+REFIL1 DW NPVar,Fetch,DoLIT,PADSize*CHARR*2,Minus,DUPP\r
DW DoLIT,PADSize*CHARR,ACCEPT,SourceVar,TwoStore\r
DW Zero,ToIN,Store,MinusOne,EXIT\r
\r
; UM* ( u1 u2 -- ud ) \ CORE\r
; Unsigned multiply. Return double-cell product.\r
;\r
-; : UM* 0 SWAP cell-size-in-bits 0 DO\r
+; : UM* 0 SWAP [ cell-size-in-bits ] LITERAL 0 DO\r
; DUP um+ >R >R DUP um+ R> +\r
; R> IF >R OVER um+ R> + THEN \ if carry\r
; LOOP ROT DROP ;\r
;\r
; : UM/MOD DUP 0= IF -10 THROW THEN \ divide by zero\r
; 2DUP U< IF\r
-; NEGATE cell-size-in-bits 0\r
+; NEGATE [ cell-size-in-bits ] LITERAL 0\r
; DO >R DUP um+ >R >R DUP um+ R> + DUP\r
; R> R@ SWAP >R um+ R> OR\r
-; IF >R DROP 1+ R> THEN\r
-; ELSE DROP THEN\r
-; R>\r
+; IF >R DROP 1+ R> ELSE DROP THEN\r
; LOOP DROP SWAP EXIT\r
; ELSE -11 THROW \ result out of range\r
; THEN ;\r
; An UNLOOP is required for each nesting level before the\r
; definition may be EXITed.\r
;\r
-; : UNLOOP R> R> R> 2DROP >R ;\r
+; : UNLOOP R> R> R> 2DROP >R ; COMPILE-ONLY\r
\r
$COLON COMPO+6,'UNLOOP',UNLOOP,_FLINK\r
DW RFrom,RFrom,RFrom,TwoDROP,ToR,EXIT\r
; ( ( "ccc<)>" -- ) \ CORE\r
; Ignore following string up to next ) . A comment.\r
;\r
-; : ( [CHAR] ) PARSE 2DROP ;\r
+; : ( [CHAR] ) PARSE 2DROP ; IMMEDIATE\r
\r
$COLON IMMED+1,'(',Paren,_FLINK\r
DW DoLIT,')',PARSE,TwoDROP,EXIT\r
; Run-time ( i*x x1 -- | i*x ) ( R: j*x -- | j*x )\r
; Conditional abort with an error message.\r
;\r
-; : ABORT" S" POSTPONE ROT\r
+; : ABORT" POSTPONE S" POSTPONE ROT\r
; POSTPONE IF POSTPONE abort"msg POSTPONE 2!\r
; -2 POSTPONE LITERAL POSTPONE THROW\r
; POSTPONE ELSE POSTPONE 2DROP POSTPONE THEN\r
; control stack.\r
;\r
; : BEGIN xhere 0 bal+ \ dest type is 0\r
-; ; COMPILE-ONLY IMMDEDIATE\r
+; ; COMPILE-ONLY IMMEDIATE\r
\r
$COLON IMMED+COMPO+5,'BEGIN',BEGIN,_FLINK\r
DW XHere,Zero,BalPlus,EXIT\r
; C, ( char -- ) \ CORE\r
; Compile a character into data space.\r
;\r
-; : C, HERE C! char-size hereVar +! ;\r
+; : C, HERE C! [ char-size ] LITERAL hereVar +! ;\r
\r
$COLON 2,'C,',CComma,_FLINK\r
DW HERE,CStore,DoLIT,CHARR,HereVar,PlusStore,EXIT\r
; Put the location of new unresolved forward reference orig2\r
; onto control-flow stack.\r
;\r
-; : ELSE POSTPONE AHEAD 2SWAP POSTPONE THEN ; COMPILE-ONLY IMMDEDIATE\r
+; : ELSE POSTPONE AHEAD 2SWAP POSTPONE THEN ; COMPILE-ONLY IMMEDIATE\r
\r
$COLON IMMED+COMPO+4,'ELSE',ELSEE,_FLINK\r
DW AHEAD,TwoSWAP,THENN,EXIT\r
; IMMEDIATE ( -- ) \ CORE\r
; Make the most recent definition an immediate word.\r
;\r
-; : IMMEDIATE lastName [ =imed ] LITERAL OVER @ OR SWAP ! ;\r
+; : IMMEDIATE lastName [ =immed ] LITERAL OVER @ OR SWAP ! ;\r
\r
$COLON 9,'IMMEDIATE',IMMEDIATE,_FLINK\r
DW LastName,DoLIT,IMMED,OVER,Fetch,ORR,SWAP,Store,EXIT\r
\r
-; J ( -- n|u ) ( R: loop-sys -- loop-sys ) \ CORE\r
-; Push the index of next outer loop.\r
-;\r
-; : J rp@ [ 3 CELLS ] LITERAL + @\r
-; rp@ [ 4 CELLS ] LITERAL + @ + ; COMPILE-ONLY\r
-\r
- $COLON COMPO+1,'J',J,_FLINK\r
- DW RPFetch,DoLIT,3*CELLL,Plus,Fetch\r
- DW RPFetch,DoLIT,4*CELLL,Plus,Fetch,Plus,EXIT\r
-\r
; LEAVE ( -- ) ( R: loop-sys -- ) \ CORE\r
; Terminate definite loop, DO|?DO ... LOOP|+LOOP, immediately.\r
;\r
; Terminate a BEGIN-WHILE-REPEAT indefinite loop. Resolve\r
; backward reference dest and forward reference orig.\r
;\r
-; : REPEAT AGAIN THEN ; COMPILE-ONLY IMMEDIATE\r
+; : REPEAT POSTPONE AGAIN POSTPONE THEN ; COMPILE-ONLY IMMEDIATE\r
\r
$COLON IMMED+COMPO+6,'REPEAT',REPEATT,_FLINK\r
DW AGAIN,THENN,EXIT\r
; Put 0 into the most significant bits vacated by the shift.\r
;\r
; : RSHIFT ?DUP IF\r
-; 0 SWAP cell-size-in-bits SWAP -\r
+; 0 SWAP [ cell-size-in-bits ] LITERAL SWAP -\r
; 0 DO 2DUP D+ LOOP\r
; NIP\r
; THEN ;\r
; Run-time ( -- c-addr2 u )\r
; Compile a string literal. Return the string on execution.\r
;\r
-; : SLITERAL DUP LITERAL POSTPONE doS"\r
+; : SLITERAL DUP POSTPONE LITERAL POSTPONE doS"\r
; CHARS xhere 2DUP + ALIGNED TOxhere\r
; SWAP MOVE ; COMPILE-ONLY IMMEDIATE\r
\r
; SPACES ( n -- ) \ CORE\r
; Send n spaces to the output device if n is greater than zero.\r
;\r
-; : SPACES ?DUP IF 0 DO SPACE LOOP THEN ;\r
+; : SPACES DUP 0 > IF 0 DO SPACE LOOP EXIT THEN DROP;\r
\r
$COLON 6,'SPACES',SPACES,_FLINK\r
- DW QuestionDUP,ZBranch,SPACES2\r
+ DW DUPP,Zero,GreaterThan,ZBranch,SPACES1\r
DW Zero,DoDO\r
-SPACES1 DW SPACE,DoLOOP,SPACES1\r
-SPACES2 DW EXIT\r
+SPACES2 DW SPACE,DoLOOP,SPACES2\r
+ DW EXIT\r
+SPACES1 DW DROP,EXIT\r
\r
; TO Interpretation: ( x "<spaces>name" -- ) \ CORE EXT\r
; Compilation: ( "<spaces>name" -- )\r
-+ ( \88t1 \88t2 -- \88t3 )\r
- \88t1\89Á \88t2\9fi \94áÐe\94a.\r
- 1 2 +\r
- Àá\9cñ ¯¡Ç¡¡e 1\89Á 2\9fi \94áÐe \88t 3·i \94ᣡµA µ©\9f¥\94a.\r
-- ( \88t1 \88t2 -- \88t3 )\r
- \88t1µA¬á \88t2\9fi ¨\85\94a.\r
- 2 1 -\r
- Àá\9cñ ¯¡Ç¡¡e 2µA¬á 1·i ¨\85 \88t 1·i \94ᣡµA µ©\9f¥\94a.\r
-* ( \88t1 \88t2 -- \88t3 )\r
- \88t1µA \88t2\9fi \89³Ðe\94a.\r
- 2 3 *\r
- Àá\9cñ ¯¡Ç¡¡e \89³Ðe \88t 6·i \94ᣡµA µ©\9f¥\94a.\r
-/ ( \88t1 \88t2 -- \88t3 )\r
- \88t1·i \88t2\9d¡ \90a\92\85\94a.\r
- 6 2 /\r
- Àá\9cñ ¯¡Ç¡¡e 6·i 2\9d¡ \90a\92\85 \88t 3·i \94ᣡµA µ©\9f¥\94a.\r
-MOD ( \88t1 \88t2 -- \88t3 )\r
- \88t1·i \88t2\9d¡ \90a\92\85 \90a ỡ\9fi \8a\81Ðe\94a.\r
- 8 3 MOD\r
- Àá\9cñ ¯¡Ç¡¡e 8·i 3·a\9d¡ \90a\92\85 \90a ỡ 2\9fi \94ᣡµA µ©\9f¥\94a.\r
-\90a ỡ ( \88t1 \88t2 -- \88t3 )\r
- \88t1·i \88t2\9d¡ \90a\92\85 \90a ỡ\9fi \8a\81Ðe\94a.\r
- 8 3 \90a ỡ\r
- Àá\9cñ ¯¡Ç¡¡e 8·i 3·a\9d¡ \90a\92\85 \90a ỡ 2\9fi \94ᣡµA µ©\9f¥\94a.\r
-. ( \88t -- )\r
- \94ᣡ·\81 \85 ¶á \88t·i ÑÁ¡eµA ¯³»¥®\81\9d¡ ¥¡·¥\94a.\r
-DUP ( \88t -- \88t \88t )\r
- \94ᣡ·\81 \85 ¶á \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
- 1 DUP\r
- Àá\9cñ ¯¡Ç¡¡e 1·i \96\81 \88\81 \94ᣡµA µ©\9f¥\94a.\r
-¥A\8da ( \88t -- \88t \88t )\r
- \94ᣡ·\81 \85 ¶á \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
- 1 ¥A\8da\r
- Àá\9cñ ¯¡Ç¡¡e 1·i \96\81 \88\81 \94ᣡµA µ©\9f¥\94a.\r
-OVER ( \88t1 \88t2 -- \88t1 \88t2 \88t1 )\r
- \94ᣡ·\81 \96\81 ¤å¼\81 \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
- 1 2 OVER\r
- Àá\9cñ ¯¡Ç¡¡e 1, 2, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
-\88å\90á ( \88t1 \88t2 -- \88t1 \88t2 \88t1 )\r
- "\88å\90á (¥A\8da)". \94ᣡ·\81 \96\81 ¤å¼\81 \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
- 1 2 \88å\90á\r
- Àá\9cñ ¯¡Ç¡¡e 1, 2, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
-SWAP ( \88t1 \88t2 -- \88t2 \88t1 )\r
- \94ᣡ·\81 \85 ¶á \96\81 \88t·\81 ¸a\9f¡\9fi ¤a\8e\85\94a.\r
- 1 2 SWAP\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA\93e 1·¡, ¤a\9d¡ £»µA 2\88a ·¶\94a.\r
-¤a\8e¡ ( \88t1 \88t2 -- \88t2 \88t1 )\r
- \94ᣡ·\81 \85 ¶á \96\81 \88t·\81 ¸a\9f¡\9fi ¤a\8e\85\94a.\r
- 1 2 ¤a\8e¡\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA\93e 1·¡, ¤a\9d¡ £»µA 2\88a ·¶\94a.\r
-DROP ( \88t1 -- )\r
- \94ᣡ·\81 \85 ¶á \88t·i ¤á\9f¥\94a.\r
-¤á\9da ( \88t1 -- )\r
- \94ᣡ·\81 \85 ¶á \88t·i ¤á\9f¥\94a.\r
-ROT ( \88t1 \88t2 \88t3 -- \88t2 \88t3 \88t1 )\r
- \94ᣡ·\81 \85 ¶á A \88t·i \95©\9f¥\94a. A ¤å¼\81 \88t·i \8cá\90\81 \85 ¶áµA µ©\9f¥\94a.\r
- 1 2 3 ROT\r
- Àá\9cñ ¯¡Ç¡¡e 2, 3, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
-\95©\9da ( \88t1 \88t2 \88t3 -- \88t2 \88t3 \88t1 )\r
- \94ᣡ·\81 \85 ¶á A \88t·i \95©\9f¥\94a. A ¤å¼\81 \88t·i \8cá\90\81 \85 ¶áµA µ©\9f¥\94a.\r
- 1 2 3 \95©\9da\r
- Àá\9cñ ¯¡Ç¡¡e 2, 3, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
->R ( \88t\94ᣡ: \88t -- ; \96A\95©·¡\94ᣡ: -- \88t )\r
- \88t\94ᣡ·\81 \88t·i \96A\95©·¡\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
- \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
- ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
->\96A ( \88t\94ᣡ: \88t -- ; \96A\95©·¡\94ᣡ: -- \88t )\r
- \88t\94ᣡ·\81 \88t·i \96A\95©·¡\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
- \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
- ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
-R> ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- )\r
- \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
- \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
- ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
-\96A> ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- )\r
- \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
- \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
- ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
-R@ ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- \88t )\r
- \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ ¥A\8f¥\94a.\r
-\96A@ ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- \88t )\r
- \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ ¥A\8f¥\94a.\r
-= ( \88t1 \88t2 -- -1|0 )\r
- 5 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¡\89¡\r
- 6 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¥\94a.\r
-== ( \88t1 \88t2 -- -1|0 )\r
- 5 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¡\89¡\r
- 6 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¥\94a.\r
-> ( \88t1 \88t2 -- -1|0 )\r
- 5 6 > Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¡\89¡\r
- 5 5 > Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¡\89¡\r
- 6 5 > Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¥\94a.\r
-< ( \88t1 \88t2 -- -1|0 )\r
- 5 6 < Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¡\89¡\r
- 5 5 < Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¡\89¡\r
- 6 5 < Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¥\94a.\r
-AND ( \88t1 \88t2 -- \88t3 )\r
- \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
-\90{Ðq\8dA ( \88t1 \88t2 -- \88t3 )\r
- \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
-OR ( \88t1 \88t2 -- \88t3 )\r
- \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡Ðs·i \94ᣡµA µ©\9f¥\94a.\r
-\90{´a¶\89\9cá ( \88t1 \88t2 -- \88t3 )\r
- \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡Ðs·i \94ᣡµA µ©\9f¥\94a.\r
-XOR ( \88t1 \88t2 -- \88t3 )\r
- \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe ¤\81Èa¸â \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
-\90{\98a\9d¡ ( \88t1 \88t2 -- \88t3 )\r
- \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe ¤\81Èa¸â \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
-WORDS ( -- )\r
- ³i ®\81 ·¶\93e ¯¡Ç± i\97i·i ÑÁ¡eµA ¥¡·¥\94a.\r
- iÍa ( -- )\r
- ³i ®\81 ·¶\93e ¯¡Ç± i\97i·i ÑÁ¡eµA ¥¡·¥\94a.\r
-.S ( -- )\r
- \88t\94ᣡ·\81 \88t\97i·i ¥¡·¥\94a.\r
-.\94ᣡ ( -- )\r
- \88t\94ᣡ·\81 \88t\97i·i ¥¡·¥\94a.\r
-BYE ( -- )\r
- \93iÎ\91·i \8f{\90\85\94a.\r
-\8f{ ( -- )\r
- \93iÎ\91·i \8f{\90\85\94a.\r
-CR ( -- )\r
- ÑÁ¡eµA ¬\81 º\89·i e\97e\94a.\r
-\94a·qº\89 ( -- )\r
- ÑÁ¡eµA ¬\81 º\89·i e\97e\94a.\r
-HELP ( -- )\r
- HELP \94a·q·\81 \90{ iµA \94\81Ðe \95¡¶\91 i·i Ìa·© 'HFORTH.HLP'µA¬á Àx´a ¥¡·¥\94a.\r
- HELP DUP\r
- Àá\9cñ ¯¡Ç¡¡e '¥A\8da'\9fi ´á\98ý\89A ³a\93e»¡ ÑÁ¡eµA ¥¡·¥\94a.\r
-\95¡¶\91 i ( -- )\r
- HELP \94a·q·\81 \90{ iµA \94\81Ðe \95¡¶\91 i·i Ìa·© 'HFORTH.HLP'µA¬á Àx´a ¥¡·¥\94a.\r
- \95¡¶\91 i ¥A\8da\r
- Àá\9cñ ¯¡Ç¡¡e '¥A\8da'\9fi ´á\98ý\89A ³a\93e»¡ ÑÁ¡eµA ¥¡·¥\94a.\r
-CLS ( -- )\r
- ÑÁ¡e·i »¡¶\85\94a.\r
-ÑÁ¡e»¡¶¡ ( -- )\r
- ÑÁ¡e·i »¡¶\85\94a.\r
-CONSTANT ( \88t -- )\r
- »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- \88t )\r
- \94ᣡ·\81 \88t·i °á¬á '\8a\88·e\88t' \94a·qµA \90aµ¡\93e ·¡\9fq·a\9d¡ \8a\88·e\88t(¬w®\81)·i\r
- e\97e\94a.\r
- 5 CONSTANT FIVE\r
- Àá\9cñ ¯¡Ç¡¡e 'FIVE'\9ca\93e ·¡\9fq·\81 \8a\88·e\88t·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
- FIVE\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA 5\9fi µ©\9f¥\94a.\r
-\8a\88·e\88t ( \88t -- )\r
- »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- \88t )\r
- \94ᣡ·\81 \88t·i °á¬á '\8a\88·e\88t' \94a·qµA \90aµ¡\93e ·¡\9fq·a\9d¡ \8a\88·e\88t(¬w®\81)·i\r
- e\97e\94a.\r
- 5 \8a\88·e\88t \94a¬õ\r
- Àá\9cñ ¯¡Ç¡¡e '\94a¬õ'·¡\9ca\93e ·¡\9fq·\81 \8a\88·e\88t·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
- \94a¬õ\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA 5\9fi µ©\9f¥\94a.\r
-VARIABLE ( -- )\r
- »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- º\81¡ )\r
- VARIABLE AGE\r
- Àá\9cñ ¯¡Ç¡¡e 'AGE'\9ca\93e ·¡\9fq·\81 ¢\81\9fe\88t(¥e®\81)·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
- AGE\r
- Àá\9cñ ¯¡Ç¡¡e 'AGE'·\81 \88t·\81 º\81¡\9fi \94ᣡ·\81 \85 ¶áµA µ©\9f¥\94a.\r
-¢\81\9fe\88t ( -- )\r
- »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- º\81¡ )\r
- ¢\81\9fe\88t \90a·¡\r
- Àá\9cñ ¯¡Ç¡¡e '\90a·¡'\9ca\93e ·¡\9fq·\81 ¢\81\9fe\88t(¥e®\81)·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
- \90a·¡\r
- Àá\9cñ ¯¡Ç¡¡e '\90a·¡'·\81 \88t·\81 º\81¡\9fi \94ᣡ·\81 \85 ¶áµA µ©\9f¥\94a.\r
-! ( \88t º\81¡ -- )\r
- \94ᣡ·\81 \85 ¶áµA ·¶\93e º\81¡µA \94ᣡ·\81 \96\81 ¤å¼\81 \88t·i °á\90ý\93e\94a.\r
- 16 \90a·¡ !\r
- Àá\9cñ ¯¡Ç¡¡e ¢\81\9fe\88t '\90a·¡'µA 16·i °á\90ý\93e\94a.\r
-@ ( º\81¡ -- \88t )\r
- \94ᣡ·\81 \85 ¶áµA ·¶\93e º\81¡µA \97e \88t·i \94ᣡµA µ©\9f¥\94a.\r
- \90a·¡ @\r
- Àá\9cñ ¯¡Ç¡¡e ¢\81\9fe\88t '\90a·¡'·\81 \88t·i \94ᣡµA µ©\9f¥\94a.\r
-: ( -- )\r
- \90{ i »µ\8b¡\9fi ¯¡¸bÐe\94a.\r
- : ¬\81\90{ i \90{ i1 \90{ i2 \90{ i3 ;\r
- Àá\9cñ °á¬á ¬\81 \90{ i '¬\81\90{ i'·\81 ¸÷·\81\9fi ¯¡¸bÐe\94a.\r
-; ( -- )\r
- \90{ i »µ\8b¡\9fi \8f{\90\85\94a.\r
- : ¬\81\90{ i \90{ i1 \90{ i2 \90{ i3 ;\r
- Àá\9cñ ³e\94a.\r
-( ( -- )\r
- ')' \90aµ© \98\81\8ca»¡ \8bi·i ¯¡Ç¡»¡ ´g\89¡ \88å\90á\9aå\94a. '('\95¡ Ða\90a·\81 \90{ i·¡£a\9d¡\r
- \96áµA §¥Äe·¡ ¤e\97a¯¡ Ða\90a ·¡¬w ·¶´á´¡ Ðe\94a.\r
- ( ·¡\88õ·e \94õ¦\9b·± i·³\93¡\94a.)\r
- Àá\9cñ ³e\94a. º\81·\81: '('\93e ¯¡Ç± i·¡»¡ e ')'\93e ¯¡Ç± i·¡ ´a\93¡\94a.\r
-." ( -- )\r
- '"'·¡ \90aµ© \98\81\8ca»¡·\81 \8bi·i ÑÁ¡eµA ¥¡·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
- ·¶\94a.\r
- : ¯¡Ðñ ." ·¡ \8bi·¡ ÑÁ¡eµA ¥¡µa»³\93¡\94a." ;\r
- Àá\9cñ ¯¡Ç¥ \94a·q\r
- ¯¡Ðñ\r
- ·¡\9ca\89¡ ¯¡Ç¡¡e ÑÁ¡eµA '·¡ \8bi·¡ ÑÁ¡eµA ¥¡µa»³\93¡\94a.'\9fi ¥¡·¥\94a.\r
-IF ¯¡Åa»© \98\81: ( \88t -- )\r
- 'IF ... THEN'\90a 'IF ... ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
- ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a. 'IF ... THEN'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á\r
- \88t·¡ 0·¡ ´a\93© \98\81 e 'IF ... THEN' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a. 'IF ...\r
- ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e 'IF ...\r
- THEN' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e 'ELSE ... THEN' ¬a·¡·\81\r
- \90{ i·¡ ¯¡Åa»¥\94a.\r
- : ?DUP DUP IF DUP THEN ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 3 ?DUP\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
- 0 ?DUP\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i 1 \88\81 µ©\9f¥\94a.\r
-¡e ¯¡Åa»© \98\81: ( \88t -- )\r
- '¡e ... \9ca'\90a '¡e ... ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
- ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a. '¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á\r
- \88t·¡ 0·¡ ´a\93© \98\81 e '¡e ... \9ca' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a. '¡e ...\r
- ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e '¡e\r
- ... \9ca' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e '´a\93¡¡e ... \9ca' ¬a·¡·\81\r
- \90{ i·¡ ¯¡Åa»¥\94a.\r
- : ?¥A\8da ¥A\8da ¡e ¥A\8da \9ca ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 3 ?¥A\8da\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
- 0 ?¥A\8da\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i 1 \88\81 µ©\9f¥\94a.\r
-ELSE ¯¡Åa»© \98\81: ( -- )\r
- 'IF ... ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
- ·¶\94a. \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e 'IF ... ELSE' ¬a·¡·\81 \90{ i·¡\r
- ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e 'ELSE ... THEN' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a.\r
- : TEST IF DUP ELSE DROP THEN ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 3 1 TEST\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
- 3 0 TEST\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA ´a¢\81 \88õ\95¡ µ©\9f¡»¡ ´g\93e\94a.\r
-´a\93¡¡e ¯¡Åa»© \98\81: ( -- )\r
- '¡e ... ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
- ·¶\94a. \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e '¡e ... ´a\93¡¡e' ¬a·¡·\81 \90{ i·¡\r
- ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e '´a\93¡¡e ... \9ca' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a.\r
- : ¯¡Ðñ ¡e ¥A\8da ´a\93¡¡e ¤á\9da \9ca ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 3 1 ¯¡Ðñ\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
- 3 0 ¯¡Ðñ\r
- Àá\9cñ ¯¡Ç¡¡e \94ᣡµA ´a¢\81 \88õ\95¡ µ©\9f¡»¡ ´g\93e\94a.\r
-THEN ¯¡Åa»© \98\81: ( -- )\r
- 'IF ... THEN'\90a 'IF ... ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
- ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
-\9ca ¯¡Åa»© \98\81: ( -- )\r
- '¡e ... \9ca'\90a '¡e ... ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
- ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
-ENDIF ¯¡Åa»© \98\81: ( -- )\r
- 'IF ... ENDIF'\90a 'IF ... ELSE ... ENDIF'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
- ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
-BEGIN ¯¡Åa»© \98\81: ( -- )\r
- 'BEGIN ... UNTIL'\90a 'BEGIN ... WHILE ... REPEAT'·\81 ¼b·a\9d¡ ³aµa\r
- \88á\97s¯¡Ç±·\81 Àá·q·i Îa¯¡Ðe\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
-·¡¹A¦\81Èá ¯¡Åa»© \98\81: ( -- )\r
- '·¡¹A¦\81Èá ... \8ca»¡'\90a '·¡¹A¦\81Èá ... \95·´e... \88á\97sÐ\81'·\81 ¼b·a\9d¡ ³aµa\r
- \88á\97s¯¡Ç±·\81 Àá·q·i Îa¯¡Ðe\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
-UNTIL ¯¡Åa»© \98\81: ( \88t -- )\r
- 'BEGIN ... UNTIL'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
- '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a 'UNTIL' \94a·q·\81 \90{ i·¡ ¯¡Åa»¡\89¡\r
- '\88t'·¡ 0·¡¡e 'BEGIN ... UNTIL' ¬a·¡·\81 \90{ i·i \88á\97s¯¡Ç¥\94a.\r
- : COUNTDOWN BEGIN DUP . 1 - DUP 0 = UNTIL ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 5 COUNTDOWN\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
-\8ca»¡ ¯¡Åa»© \98\81: ( \88t -- )\r
- '·¡¹A¦\81Èá ... \8ca»¡'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
- '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a '\8ca»¡' \94a·q·\81 \90{ i·¡ ¯¡Åa»¡\89¡\r
- '\88t'·¡ 0·¡¡e '·¡¹A¦\81Èá ... \8ca»¡' ¬a·¡·\81 \90{ i·i \88á\97s¯¡Ç¥\94a.\r
- : ¦\81Èá.´a\9c\81\9d¡.A ·¡¹A¦\81Èá ¥A\8da . 1 - ¥A\8da 0 = \8ca»¡ ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 5 ¦\81Èá.´a\9c\81\9d¡.A\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
-WHILE ¯¡Åa»© \98\81: ( \88t -- )\r
- 'BEGIN ... WHILE ... REPEAT'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
- ³i ®\81 ·¶\94a. '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·¡ \89\81¢\96A´á 'WHILE' \94a·q·\81\r
- \90{ i·¡ ¯¡Åa»¡\89¡ '\88t'·¡ 0·¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a 'REPEAT' \94a·q·\81\r
- \90{ i·¡ ¯¡Åa»¥\94a.\r
- : COUNTDOWN BEGIN DUP WHILE DUP . 1 - REPEAT ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 5 COUNTDOWN\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
-\95·´e ¯¡Åa»© \98\81: ( \88t -- )\r
- '·¡¹A¦\81Èá ... \95·´e... \88á\97sÐ\81'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
- ³i ®\81 ·¶\94a. '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·¡ \89\81¢\96A´á '\95·´e' \94a·q·\81\r
- \90{ i·¡ ¯¡Åa»¡\89¡ '\88t'·¡ 0·¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a '\88á\97sÐ\81' \94a·q·\81\r
- \90{ i·¡ ¯¡Åa»¥\94a.\r
- : ¦\81Èá.´a\9c\81\9d¡.A ·¡¹A¦\81Èá ¥A\8da \95·´e ¥A\8da . 1 - \88á\97sÐ\81 ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 5 ¦\81Èá.´a\9c\81\9d¡.A\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
-REPEAT ¯¡Åa»© \98\81: ( -- )\r
- 'BEGIN ... WHILE ... REPEAT'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
- ³i ®\81 ·¶\94a. 'BEGIN' \94a·q·a\9d¡ \88á\97s¯¡Ç±·i \89\81¢Ðe\94a.\r
-\88á\97sÐ\81 ¯¡Åa»© \98\81: ( -- )\r
- '·¡¹A¦\81Èá ... \95·´e... \88á\97sÐ\81'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
- ³i ®\81 ·¶\94a. '·¡¹A¦\81Èá' \94a·q·a\9d¡ \88á\97s¯¡Ç±·i \89\81¢Ðe\94a.\r
-DO ¯¡Åa»© \98\81: ( \88t1 \88t2 -- )\r
- ¤e\97a¯¡ 'DO ... LOOP'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
- ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ 'DO ... LOOP' ¬a·¡·\81\r
- \90{ i·i \88á\97s¯¡Ç¥\94a.\r
- : 5STARS 5 0 DO ." *" LOOP ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 5STARS\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '*****'\88a Îa¯¡\96E\94a.\r
- \91 ¯¡Åa»© \98\81: ( \88t1 \88t2 -- )\r
- ¤e\97a¯¡ ' \91 ... \95©´a'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
- ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ ' \91 ... \95©´a' ¬a·¡·\81\r
- \90{ i·i \88á\97s¯¡Ç¥\94a.\r
- : \94a¬õ¥i 5 0 \91 ." *" \95©´a ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- \94a¬õ¥i\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '*****'\88a Îa¯¡\96E\94a.\r
-LOOP ¯¡Åa»© \98\81: ( -- )\r
- ¤e\97a¯¡ 'DO ... LOOP'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
- ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ 'DO ... LOOP' ¬a·¡·\81\r
- \90{ i·i \88á\97s¯¡Ç¥\94a.\r
-\95©´a ¯¡Åa»© \98\81: ( -- )\r
- ¤e\97a¯¡ ' \91 ... \95©´a'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
- ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ ' \91 ... \95©´a' ¬a·¡·\81\r
- \90{ i·i \88á\97s¯¡Ç¥\94a.\r
-I ¯¡Åa»© \98\81: ( -- \88t )\r
- \91\95©·¡ \88a\9f¡Ç±®\81\9d¡ ¤e\97a¯¡ 'DO ... LOOP' ´eµA¬á ³e\94a.\r
- '\88t2 \88t1 DO I LOOP'µA¬á '\88a'\93e Àa\9d\81\9d¡ '\88t1'µA¬á '\88t2'-1 \8ca»¡·\81\r
- \88t\97i·i \94ᣡµA µ©\9f¥\94a.\r
- : COUNT 0 DO I . LOOP ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 5 COUNT\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '0 1 2 3 4'\9fi ¥¡·¥\94a.\r
-\88a ¯¡Åa»© \98\81: ( -- \88t )\r
- "\88a(\9f¡Ç±®\81)." \91\95©·¡ \88a\9f¡Ç±®\81\9d¡ ¤e\97a¯¡ ' \91 ... \95©´a' ´eµA¬á ³e\94a.\r
- '\88t2 \88t1 \91 \88a \95©´a'µA¬á '\88a'\93e Àa\9d\81\9d¡ '\88t1'µA¬á '\88t2'-1 \8ca»¡·\81\r
- \88t\97i·i \94ᣡµA µ©\9f¥\94a.\r
- : ¤å.A\8b¡ 0 \91 \88a . \95©´a ;\r
- Àá\9cñ \90{ i·i »µ\89¡\r
- 5 ¤å.A\8b¡\r
- Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '0 1 2 3 4'\9fi ¥¡·¥\94a.\r
-IMMEDIATE ( -- )\r
- ¤w\8bq »¡·e i·i i»µ\8b¡ ¬wÈ\81µA¬á\95¡ ¯©Ð\97\96A\93e '¤a\9d¡ i'\9d¡ e\97e\94a.\r
-¤a\9d¡ i ( -- )\r
- ¤w\8bq »¡·e i·i i»µ\8b¡ ¬wÈ\81µA¬á\95¡ ¯©Ð\97\96A\93e '¤a\9d¡ i'\9d¡ e\97e\94a.\r
-' ( -- º\81¡ )\r
- "'" \94a·qµA \90aµ¡\93e \90{ i·\81 º\81¡\9fi \94ᣡµA \90q\8b¥\94a.\r
-\88{·e i ( º\81¡ -- )\r
- '\88{·e i' \94a·qµA \90aµ¡\93e ·¡\9fq·a\9d¡, \94ᣡµA º\81¡\88a ·¶\93e \90{ i\89Á \99¢\88{·e\r
- ·©·i Ða\93e \90{ i·i e\97e\94a.\r
- ' DUP \88{·e i ¥A\8da\r
- Àá\9cñ ¯¡Ç¡¡e DUP µÁ \88{·e ·©·i Ða\93e \90{ i '¥A\8da'\9fi e\97e\94a.\r
-º\89ÑÁ¡e ( º\89®\81 -- )\r
- ´a\9c\81¬á¦\81Èá \8bi¸a\88a ¥¡·© º\89 ®\81\9fi ¸÷Ðe\94a.\r
-sin* ( \8b©·¡ \88b\95¡ -- \8b©·¡*sin[\88b\95¡] )\r
- \8b©·¡µÁ \88b\95¡\9d¡¦\81Èá \8b©·¡µA ¬q\88b§¡\9fi \89³Ðe \88t·i \89\81¬eÐe\94a.\r
-cos* ( \8b©·¡ \88b\95¡ -- \8b©·¡*cos[\88b\95¡] )\r
- \8b©·¡µÁ \88b\95¡\9d¡¦\81Èá \8b©·¡µA ¬q\88b§¡\9fi \89³Ðe \88t·i \89\81¬eÐe\94a.\r
-\9d¡.\8ba´á ( x y -- )\r
- »¡\8bq ¸a\9f¡µA¬á \88á¦\82¹ÁÎa (x,y)\9d¡ ¬å·i \8bu\93e\94a. ÑÁ¡eµA \8bq·i \8bu\93e \88a¸w\r
- \8b¡¥¥¸â·¥ \90{ i·¡\94a. \88á¦\82 ¶\91»¢·± \90{ i '¹A¸a\9f¡\9d¡'µÁ ' eÇq.\88a'µA\r
- ³a·¥\94a.\r
-\88á¦\82¥¡µa ( -- )\r
- ÑÁ¡eµA \88á¦\82·¡ ·¶·a¡e »¡¶\81\89¡ ´ô·a¡e ¥¡·¥\94a.\r
-¤wз ( -- º\81¡ )\r
- ¢\81\9fe\88t '¤wз'. \88á¦\82·\81 ¤wз·¡ \94q\89a ·¶\94a.\r
-\88a\9d¡¶áá ( -- º\81¡ )\r
- ¢\81\9fe\88t '\88a\9d¡¶áá'. \88á¦\82·\81 x ¹ÁÎa\88a \94q\89a ·¶\94a.\r
-A\9d¡¶áá ( -- º\81¡ )\r
- ¢\81\9fe\88t '\88a\9d¡¶áá'. \88á¦\82·\81 y ¹ÁÎa\88a \94q\89a ·¶\94a.\r
- eÇq.\88a ( \88a\9d¡\88á\9f¡ A\9d¡\88á\9f¡ -- )\r
- \88á¦\82·¡ »¡\8bq ¹ÁÎa (x,y)µA¬á (x+\88a\9d¡\88á\9f¡, y+A\9d¡\88á\9f¡)\9d¡ ¶\91»¢·¥\94a.\r
- \90{ i '´|·a\9d¡'µÁ '\96á\9d¡'µA ³a·¥\94a.\r
-__µ¡\9fe½¢.ÑÉ\8d© ( \88á\9f¡ ÒU®\81 -- )\r
- \88á\9f¡ eÇq \88a\89¡ 10 \95¡ µ¡\9fe½¢·a\9d¡ \95¡\93e \88õ·i ÒU®\81 eÇq \96AÎ\89·¡Ðe\94a.\r
- \90{ i 'µ¡\9fe½¢.ÑÉ\8d©'µA ³a·¥\94a.\r
-__¶E½¢.ÑÉ\8d© ( \88á\9f¡ ÒU®\81 -- )\r
- \88á\9f¡ eÇq \88a\89¡ 10 \95¡ ¶E½¢·a\9d¡ \95¡\93e \88õ·i ÒU®\81 eÇq \96AÎ\89·¡Ðe\94a.\r
- \90{ i '¶E½¢.ÑÉ\8d©'µA ³a·¥\94a.\r
-\8a\8a\89A ( -- )\r
- \88á¦\82·¡ »¡\90a\88e ¸aÂá\9fi \8a\8a\89A \8ba\9f¥\94a.\r
-\88a\93i\89A ( -- )\r
- \88á¦\82·¡ »¡\90a\88e ¸aÂá\9fi \88a\93i\89A \8ba\9f¥\94a.\r
-¦\95\97i´á ( -- )\r
- \88á¦\82·¡ »¡\90a\88e ¸aÂá\9fi \90q\8b¡»¡ ´g\93e\94a.\r
-¦\95\90\81\9da ( -- )\r
- \88á¦\82·¡ º\89·i \8ba·a¡a \88e\94a.\r
-ÑÁ¡e»¡¶¡ ( -- )\r
- \88á¦\82·i ¹A¸a\9f¡\9d¡ ¥¡\90\81\89¡ ÑÁ¡e·i »¡¶\85\94a.\r
-½¡\88\85ÑÁ¡e ( -- )\r
- \8bi¸a\9fi ´a\9c\81 8 º\89µA e ¥¡·¥\94a.\r
-µ¥ÑÁ¡e ( -- )\r
- \8bi¸a\9fi ¸åÁA ÑÁ¡eµA ¥¡·¥\94a.\r
-¹A¸a\9f¡\9d¡ ( -- )\r
- \88á¦\82·\81 á\9f¡\9fi ¶á½¢·a\9d¡ Ð\81¬á ÑÁ¡e \88a¶\85\95A\9d¡ ¥¡\90\81\89¡ ÑÁ¡e·i »¡¶\85\94a.\r
-\95¡.µ¡\9fe½¢ ( \88b\95¡ -- )\r
- \88á¦\82·\81 ¤wз·i \88b\95¡ eÇq µ¡\9fe½¢·a\9d¡ \95©\9f¥\94a.\r
-\95¡.¶E½¢ ( \88b\95¡ -- )\r
- \88á¦\82·\81 ¤wз·i \88b\95¡ eÇq ¶E½¢·a\9d¡ \95©\9f¥\94a.\r
-´|·a\9d¡ ( \88á\9f¡ -- )\r
- \88á¦\82·¡ \88á\9f¡ eÇq ´|·a\9d¡ \88e\94a.\r
-\96á\9d¡ ( \88á\9f¡ -- )\r
- \88á¦\82·¡ \88á\9f¡ eÇq \96á\9d¡ \88e\94a.\r
-µ¡\9fe½¢.ÑÉ\8d© ( ¤e»¡\9fq \88b\95¡ -- )\r
- º\81´á»¥ ¤e»¡\9fq\89Á \88b\95¡\9d¡ µ¡\9fe½¢·a\9d¡ ÑÉ\8d©·i \8ba\9f¥\94a.\r
-µ¡\9fe½¢.¶¥ ( ¤e»¡\9fq -- )\r
- º\81´á»¥ ¤e»¡\9fq·a\9d¡ µ¡\9fe½¢·a\9d¡ \95·\8ba\9ca£¡\9fi \8ba\9f¥\94a.\r
-¶E½¢.ÑÉ\8d© ( ¤e»¡\9fq \88b\95¡ -- )\r
- º\81´á»¥ ¤e»¡\9fq\89Á \88b\95¡\9d¡ ¶E½¢·a\9d¡ ÑÉ\8d©·i \8ba\9f¥\94a.\r
-¶E½¢.¶¥ ( ¤e»¡\9fq -- )\r
- º\81´á»¥ ¤e»¡\9fq·a\9d¡ ¶E½¢·a\9d¡ \95·\8ba\9ca£¡\9fi \8ba\9f¥\94a.\r
-\91A¡¡ ( Ça\8b¡ --\r
- º\81´á»¥ Ça\8b¡·\81 \91A¡¡\9fi \8ba\9f¥\94a.\r
-\89sÃ¥\91A¡¡ ( -- )\r
- \88b ¥e·\81 \8b©·¡\88a 100, 200, 300, 400 ·¥ \91A¡¡\9fi \89sÁa \8ba\9f¥\94a.\r
-\94a·¡´a¡¥\97a ( -- )\r
- \94a·¡´a¡¥\97a ¡¡´··i \8ba\9f¥\94a.\r
-\8bµ¤i ( Ça\8b¡ -- )\r
- \8bµ¤i ¡¡´··i \8ba\9f¥\94a.\r
-µa¬õ\8bµ¤i ( Ça\8b¡ -- )\r
- 60 \95¡³¢ \95©´a\88a¡a \8bµ¤i 6 \88\81\9fi \8ba\9f¥\94a.\r
-¤a\9cq\88\81§¡ ( -- )\r
- ¤a\9cq\88\81§¡ ¡¡´··i \8ba\9f¥\94a.\r
-\8d¹·¼ ( Ça\8b¡ -- )\r
- \8d¹·¼ ¡¡´··i \8ba\9f¥\94a.\r
-\8d¹ ( Ça\8b¡ -- )\r
- \8d¹·¼ 8 \88\81·¥ \8d¹·i \8ba\9f¥\94a.\r
-\94a\9fe\8d¹·¼ ( Ça\8b¡ -- )\r
- \94a\9fe ¡¡´··\81 \8d¹·¼·i \8ba\9f¥\94a.\r
-\94a\9fe\8d¹ ( Ça\8b¡ -- )\r
- \8d¹·¼ 6 \88\81·¥ \8d¹·i \8ba\9f¥\94a.\r
-Ð\95¬i ( Ça\8b¡ -- )\r
- ¢\89\89i ¡¡´··i \8ba\9f¥\94a.\r
-Ð\81 ( Ça\8b¡ -- )\r
- Ð\81 ¡¡´··i \8ba\9f¥\94a.\r
-\88bÑw ( Ça\8b¡ ¡¡¬á\9f¡®\81 -- )\r
- ¸÷\94a\88bÑw·i \8ba\9f¥\94a.\r
-¥i ( ¥e·\81_®\81 ÒU®\81 -- )\r
- ¥i ¡¡´··i \8ba\9f¥\94a.\r
-\94a\88bÑw ( Ça\8b¡ \88b\95¡ -- )\r
- Ça\8b¡µÁ \88b\95¡µA \98a\9ca µa\9cá ¡¡´··\81 \94a\88bÑw\89Á ¥i ¡¡´··i \8ba\9f¥\94a.\r
-\94a\88bÑw¸a\9cw5 ( -- )\r
- \90{ i '\94a\88bÑw'·i ·¡¶wÐe ¸a\9cw\r
-\94a\88bÑw¸a\9cw4 ( -- )\r
- \90{ i '\94a\88bÑw'·i ·¡¶wÐe \94a\9fe ¸a\9cw\r
-\94a\88bÑw¸a\9cw12 ( -- )\r
- \90{ i '\94a\88bÑw'·i ·¡¶wÐe \99¡ \94a\9fe ¸a\9cw\r
-\90a¢\81 ( \88a»¡\88b\95¡ \88a»¡\8b©·¡ \88a»¡Ã¡\8b¡®\81 -- )\r
- ¯a¯a\9d¡\9fi \96A¦\89\9cá¬á (recursive call) \90a¢\81 ¡¡´··i \8ba\9f¥\94a.\r
-§¡\93iÇa\8b¡ ( -- º\81¡ )\r
- \90{ i '¶w'µA¬á ¬a¶wÐa\93e ¢\81\9fe\88t\r
-¶w ( \90a·¡ -- )\r
- ¯a¯a\9d¡\9fi \96A¦\89\9cá¬á ¶w\8ba\9f±(dragon curve)·i \8ba\9f¥\94a.\r
+\\r
+\ HTURTLE.F\r
+\ Turtle graphics package for hForth\r
+\ Words names are in Korean.\r
+\\r
+\ HTURTLE.EXE\93e HF86EXE.EXE\9fi ¯¡¸bÐe Ò\81 \94a·q ®\85¬á\9d¡ Í¡¯a Ìa·©\97i·i µ©\9da¬á\r
+\ e\97e \88õ·³\93¡\94a.\r
+\\r
+\ << OPTIONAL.F\r
+\ << ASM8086.F\r
+\ << COREEXT.F\r
+\ << MSDOS.F\r
+\ BL PARSE MULTI.F INCLUDED\r
+\ BL PARSE HIOMULT2.F INCLUDED\r
+\ BL PARSE HTURTLE.F INCLUDED\r
+\ SAVE-SYSTEM-AS HTURTLE.EXE\r
+\\r
+\ 1996. 2. 21. \ Wonyong Koh\r
+\r
+BASE @\r
+GET-ORDER GET-CURRENT\r
+Ðe\8bi·³Â\89\9db-WORDLIST GET-ORDER 1 + SET-ORDER\r
+\r
+MARKER ~TURTLE\r
+\r
+DECIMAL\r
+CREATE sin16384\r
+ 0 , 286 , 572 , 857 , 1143 , 1428 , 1713 , 1997 , 2280 , 2563 ,\r
+ 2845 , 3126 , 3406 , 3686 , 3964 , 4240 , 4516 , 4790 , 5063 , 5334 ,\r
+ 5604 , 5872 , 6138 , 6402 , 6664 , 6924 , 7182 , 7438 , 7692 , 7943 ,\r
+ 8192 , 8438 , 8682 , 8923 , 9162 , 9397 , 9630 , 9860 , 10087 , 10311 ,\r
+ 10531 , 10749 , 10963 , 11174 , 11381 , 11585 , 11786 , 11982 , 12176 , 12365 ,\r
+ 12551 , 12733 , 12911 , 13085 , 13255 , 13421 , 13583 , 13741 , 13894 , 14044 ,\r
+ 14189 , 14330 , 14466 , 14598 , 14726 , 14849 , 14968 , 15082 , 15191 , 15296 ,\r
+ 15396 , 15491 , 15582 , 15668 , 15749 , 15826 , 15897 , 15964 , 16026 , 16083 ,\r
+ 16135 , 16182 , 16225 , 16262 , 16294 , 16322 , 16344 , 16362 , 16374 , 16382 ,\r
+ 16384 , 16382 , 16374 , 16362 , 16344 , 16322 , 16294 , 16262 , 16225 , 16182 ,\r
+ 16135 , 16083 , 16026 , 15964 , 15897 , 15826 , 15749 , 15668 , 15582 , 15491 ,\r
+ 15396 , 15296 , 15191 , 15082 , 14968 , 14849 , 14726 , 14598 , 14466 , 14330 ,\r
+ 14189 , 14044 , 13894 , 13741 , 13583 , 13421 , 13255 , 13085 , 12911 , 12733 ,\r
+ 12551 , 12365 , 12176 , 11982 , 11786 , 11585 , 11381 , 11174 , 10963 , 10749 ,\r
+ 10531 , 10311 , 10087 , 9860 , 9630 , 9397 , 9162 , 8923 , 8682 , 8438 ,\r
+ 8192 , 7943 , 7692 , 7438 , 7182 , 6924 , 6664 , 6402 , 6138 , 5872 ,\r
+ 5604 , 5334 , 5063 , 4790 , 4516 , 4240 , 3964 , 3686 , 3406 , 3126 ,\r
+ 2845 , 2563 , 2280 , 1997 , 1713 , 1428 , 1143 , 857 , 572 , 286 ,\r
+ 0 , -286 , -572 , -857 , -1143 , -1428 , -1713 , -1997 , -2280 , -2563 ,\r
+ -2845 , -3126 , -3406 , -3686 , -3964 , -4240 , -4516 , -4790 , -5063 , -5334 ,\r
+ -5604 , -5872 , -6138 , -6402 , -6664 , -6924 , -7182 , -7438 , -7692 , -7943 ,\r
+ -8192 , -8438 , -8682 , -8923 , -9162 , -9397 , -9630 , -9860 , -10087 , -10311 ,\r
+-10531 , -10749 , -10963 , -11174 , -11381 , -11585 , -11786 , -11982 , -12176 , -12365 ,\r
+-12551 , -12733 , -12911 , -13085 , -13255 , -13421 , -13583 , -13741 , -13894 , -14044 ,\r
+-14189 , -14330 , -14466 , -14598 , -14726 , -14849 , -14968 , -15082 , -15191 , -15296 ,\r
+-15396 , -15491 , -15582 , -15668 , -15749 , -15826 , -15897 , -15964 , -16026 , -16083 ,\r
+-16135 , -16182 , -16225 , -16262 , -16294 , -16322 , -16344 , -16362 , -16374 , -16382 ,\r
+-16384 , -16382 , -16374 , -16362 , -16344 , -16322 , -16294 , -16262 , -16225 , -16182 ,\r
+-16135 , -16083 , -16026 , -15964 , -15897 , -15826 , -15749 , -15668 , -15582 , -15491 ,\r
+-15396 , -15296 , -15191 , -15082 , -14968 , -14849 , -14726 , -14598 , -14466 , -14330 ,\r
+-14189 , -14044 , -13894 , -13741 , -13583 , -13421 , -13255 , -13085 , -12911 , -12733 ,\r
+-12551 , -12365 , -12176 , -11982 , -11786 , -11585 , -11381 , -11174 , -10963 , -10749 ,\r
+-10531 , -10311 , -10087 , -9860 , -9630 , -9397 , -9162 , -8923 , -8682 , -8438 ,\r
+ -8192 , -7943 , -7692 , -7438 , -7182 , -6924 , -6664 , -6402 , -6138 , -5872 ,\r
+ -5604 , -5334 , -5063 , -4790 , -4516 , -4240 , -3964 , -3686 , -3406 , -3126 ,\r
+ -2845 , -2563 , -2280 , -1997 , -1713 , -1428 , -1143 , -857 , -572 , -286 ,\r
+ -0 , 286 , 572 , 857 , 1143 , 1428 , 1713 , 1997 , 2280 , 2563 ,\r
+ 2845 , 3126 , 3406 , 3686 , 3964 , 4240 , 4516 , 4790 , 5063 , 5334 ,\r
+ 5604 , 5872 , 6138 , 6402 , 6664 , 6924 , 7182 , 7438 , 7692 , 7943 ,\r
+ 8192 , 8438 , 8682 , 8923 , 9162 , 9397 , 9630 , 9860 , 10087 , 10311 ,\r
+ 10531 , 10749 , 10963 , 11174 , 11381 , 11585 , 11786 , 11982 , 12176 , 12365 ,\r
+ 12551 , 12733 , 12911 , 13085 , 13255 , 13421 , 13583 , 13741 , 13894 , 14044 ,\r
+ 14189 , 14330 , 14466 , 14598 , 14726 , 14849 , 14968 , 15082 , 15191 , 15296 ,\r
+ 15396 , 15491 , 15582 , 15668 , 15749 , 15826 , 15897 , 15964 , 16026 , 16083 ,\r
+ 16135 , 16182 , 16225 , 16262 , 16294 , 16322 , 16344 , 16362 , 16374 , 16382 ,\r
+ 16384 , 16382 , 16374 , 16362 , 16344 , 16322 , 16294 , 16262 , 16225 , 16182 ,\r
+ 16135 , 16083 , 16026 , 15964 , 15897 , 15826 , 15749 , 15668 , 15582 , 15491 ,\r
+ 15396 , 15296 , 15191 , 15082 , 14968 , 14849 , 14726 , 14598 , 14466 , 14330 ,\r
+ 14189 , 14044 , 13894 , 13741 , 13583 , 13421 , 13255 , 13085 , 12911 , 12733 ,\r
+ 12551 , 12365 , 12176 , 11982 , 11786 , 11585 , 11381 , 11174 , 10963 , 10749 ,\r
+ 10531 , 10311 , 10087 , 9860 , 9630 , 9397 , 9162 , 8923 , 8682 , 8438 ,\r
+ 8192 , 7943 , 7692 , 7438 , 7182 , 6924 , 6664 , 6402 , 6138 , 5872 ,\r
+ 5604 , 5334 , 5063 , 4790 , 4516 , 4240 , 3964 , 3686 , 3406 , 3126 ,\r
+ 2845 , 2563 , 2280 , 1997 , 1713 , 1428 , 1143 , 857 , 572 , 286 ,\r
+ 0 , -286 , -572 , -857 , -1143 , -1428 , -1713 , -1997 , -2280 , -2563 ,\r
+ -2845 , -3126 , -3406 , -3686 , -3964 , -4240 , -4516 , -4790 , -5063 , -5334 ,\r
+ -5604 , -5872 , -6138 , -6402 , -6664 , -6924 , -7182 , -7438 , -7692 , -7943 ,\r
+ -8192 , -8438 , -8682 , -8923 , -9162 , -9397 , -9630 , -9860 , -10087 , -10311 ,\r
+-10531 , -10749 , -10963 , -11174 , -11381 , -11585 , -11786 , -11982 , -12176 , -12365 ,\r
+-12551 , -12733 , -12911 , -13085 , -13255 , -13421 , -13583 , -13741 , -13894 , -14044 ,\r
+-14189 , -14330 , -14466 , -14598 , -14726 , -14849 , -14968 , -15082 , -15191 , -15296 ,\r
+-15396 , -15491 , -15582 , -15668 , -15749 , -15826 , -15897 , -15964 , -16026 , -16083 ,\r
+-16135 , -16182 , -16225 , -16262 , -16294 , -16322 , -16344 , -16362 , -16374 , -16382 ,\r
+-16384 , -16382 , -16374 , -16362 , -16344 , -16322 , -16294 , -16262 , -16225 , -16182 ,\r
+-16135 , -16083 , -16026 , -15964 , -15897 , -15826 , -15749 , -15668 , -15582 , -15491 ,\r
+-15396 , -15296 , -15191 , -15082 , -14968 , -14849 , -14726 , -14598 , -14466 , -14330 ,\r
+-14189 , -14044 , -13894 , -13741 , -13583 , -13421 , -13255 , -13085 , -12911 , -12733 ,\r
+-12551 , -12365 , -12176 , -11982 , -11786 , -11585 , -11381 , -11174 , -10963 , -10749 ,\r
+-10531 , -10311 , -10087 , -9860 , -9630 , -9397 , -9162 , -8923 , -8682 , -8438 ,\r
+ -8192 , -7943 , -7692 , -7438 , -7182 , -6924 , -6664 , -6402 , -6138 , -5872 ,\r
+ -5604 , -5334 , -5063 , -4790 , -4516 , -4240 , -3964 , -3686 , -3406 , -3126 ,\r
+ -2845 , -2563 , -2280 , -1997 , -1713 , -1428 , -1143 , -857 , -572 , -286 ,\r
+ -0 , 286 , 572 , 857 , 1143 , 1428 , 1713 , 1997 , 2280 , 2563 ,\r
+ 2845 , 3126 , 3406 , 3686 , 3964 , 4240 , 4516 , 4790 , 5063 , 5334 ,\r
+ 5604 , 5872 , 6138 , 6402 , 6664 , 6924 , 7182 , 7438 , 7692 , 7943 ,\r
+ 8192 , 8438 , 8682 , 8923 , 9162 , 9397 , 9630 , 9860 , 10087 , 10311 ,\r
+ 10531 , 10749 , 10963 , 11174 , 11381 , 11585 , 11786 , 11982 , 12176 , 12365 ,\r
+ 12551 , 12733 , 12911 , 13085 , 13255 , 13421 , 13583 , 13741 , 13894 , 14044 ,\r
+ 14189 , 14330 , 14466 , 14598 , 14726 , 14849 , 14968 , 15082 , 15191 , 15296 ,\r
+ 15396 , 15491 , 15582 , 15668 , 15749 , 15826 , 15897 , 15964 , 16026 , 16083 ,\r
+ 16135 , 16182 , 16225 , 16262 , 16294 , 16322 , 16344 , 16362 , 16374 , 16382 ,\r
+\r
+HEX\r
+\ : PLOT ( x y -- )\r
+\ Y>SEG SWAP 8 /MOD SWAP >R \ seg_addr x/8 R: x_mod_8\r
+\ 2DUP LC@ R> CHARS XMASK + C@ OR ROT ROT LC! ;\r
+\r
+CODE PLOT ( x y -- )\r
+ BX 1 SHL,\r
+ Y>SegTable ) BX ADD,\r
+ 0 [BX] ES MOV,\r
+ BX POP,\r
+ BX CX MOV,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ ES: 0 [BX] AL MOV,\r
+ 1 # AH MOV,\r
+ CL NOT,\r
+ 7 # CL AND,\r
+ AH CL ROL,\r
+ AH AL OR,\r
+ ES: AL 0 [BX] MOV,\r
+ BX POP,\r
+ NEXT,\r
+END-CODE\r
+\r
+\ : 2ROT\r
+\ >R >R 2SWAP R> R> 2SWAP ;\r
+\\r
+\ : LINE ( x1 y1 x2 y2--)\r
+\ 2OVER 2OVER ROT - ABS >R - ABS R> MAX 2 <\r
+\ IF 2DROP PLOT EXIT THEN\r
+\ 2OVER 2OVER ROT + 1+ 2/ >R + 1+ 2/ R>\r
+\ 2DUP 2ROT RECURSE RECURSE ;\r
+\r
+VARIABLE Delta\r
+VARIABLE Delta/2\r
+\r
+\ y changing faster than x\r
+CODE steep640 \ on entry, ax = delta x, bx = delta y, cx=x1, dx=y1\r
+ BX BP MOV, \ for counter\r
+ BX 1 SHR,\r
+ BX Delta/2 ) MOV, \ halfy\r
+ BX BX XOR, \ clear for cmp\r
+6 L:\r
+ BX PUSH,\r
+ CX PUSH, \ x\r
+ DX BX MOV,\r
+ BX 1 SHL,\r
+ Y>SegTable ) BX ADD,\r
+ 0 [BX] ES MOV,\r
+ CX BX MOV,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ ES: 0 [BX] AL MOV,\r
+ 1 # AH MOV,\r
+ CL NOT,\r
+ 7 # CL AND,\r
+ AH CL ROL,\r
+ AH AL OR,\r
+ ES: AL 0 [BX] MOV,\r
+ CX POP,\r
+ BX POP,\r
+ DX INC, \ y is always increasing\r
+ MAX-Y 16* # DX CMP,\r
+ 8 L# JL,\r
+ DX DX XOR,\r
+8 L:\r
+ Delta ) BX ADD, \ = bx + delta_y\r
+ Delta/2 ) BX CMP, \ bx > halfy ?\r
+ 7 L# JLE,\r
+ SI BX SUB, \ bx - delta_y\r
+ DI CX ADD, \ inc or dec x\r
+ MAX-X 8 * # CX SUB,\r
+ 7 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+ 7 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+7 L:\r
+ BP DEC,\r
+ 6 L# JGE,\r
+ BP POP,\r
+ SI POP,\r
+ BX POP,\r
+ NEXT,\r
+END-CODE\r
+\r
+\ on exit, cx=x1, dx=y1, ax=x2, bx=y2\r
+CODE line640 ( x1 y1 x2 y2 -- ) \ writes to screen directly\r
+ AX POP,\r
+ DX POP,\r
+ CX POP,\r
+ SI PUSH, ( used to hold direction)\r
+ BP PUSH, ( used as counter)\r
+\ see if we'll inc or dec x, y (draws in any direction)\r
+ DX BX SUB, \ bx <- y2-y1 (delta y)\r
+ 2 L# JGE,\r
+ BX DX ADD, \ dx <- y2\r
+ BX NEG, \ abs(delta y)\r
+ CX AX XCHG,\r
+2 L:\r
+ BX SI MOV, \ delta_y(BX) to SI\r
+ CX AX SUB, \ x2 - x1 = delta_x\r
+ 1 # DI MOV, \ di to increment x\r
+ 4 L# JGE,\r
+ -1 # DI MOV, \ di to decrement x\r
+ AX NEG, \ abs(delta x)\r
+4 L:\r
+ \ adjust x1(CX), y1(DX) in proper range\r
+ AX PUSH,\r
+ DX PUSH,\r
+ CX AX MOV,\r
+ CWD,\r
+ MAX-X 8 * # BP MOV,\r
+ BP IDIV,\r
+ DX DX OR,\r
+ 1 L# JNS,\r
+ BP DX ADD,\r
+1 L:\r
+ DX CX MOV,\r
+ DX POP,\r
+ DX AX MOV,\r
+ CWD,\r
+ MAX-Y 16* # BP MOV,\r
+ BP IDIV,\r
+ DX DX OR,\r
+ 8 L# JNS,\r
+ BP DX ADD,\r
+8 L:\r
+ AX POP,\r
+ AX Delta ) MOV, \ abs(delta x)\r
+ BX AX CMP, \ delta_x - delta_y\r
+ 5 L# JGE,\r
+ ' steep640 # JMP, \ y changes faster than x\r
+5 L:\r
+\ x changing faster than y\r
+ AX BP MOV, \ for counter\r
+ AX 1 SHR,\r
+ AX Delta/2 ) MOV, \ halfx\r
+ BX BX XOR, \ clear for cmp\r
+6 L:\r
+ BX PUSH,\r
+ CX PUSH, \ x\r
+ DX BX MOV,\r
+ BX 1 SHL,\r
+ Y>SegTable ) BX ADD,\r
+ 0 [BX] ES MOV,\r
+ CX BX MOV,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ ES: 0 [BX] AL MOV,\r
+ 1 # AH MOV,\r
+ CL NOT,\r
+ 7 # CL AND,\r
+ AH CL ROL,\r
+ AH AL OR,\r
+ ES: AL 0 [BX] MOV,\r
+ CX POP,\r
+ BX POP,\r
+ DI CX ADD, \ inc or dec x\r
+ MAX-X 8 * # CX SUB,\r
+ 9 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+ 9 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+9 L:\r
+ SI BX ADD, \ = bx + delta_y\r
+ Delta/2 ) BX CMP, \ bx > halfx ?\r
+ 7 L# JLE,\r
+ Delta ) BX SUB, \ bx - delta_x\r
+ DX INC, \ y is always increasing\r
+ MAX-Y 16* # DX CMP,\r
+ 7 L# JL,\r
+ DX DX XOR,\r
+7 L:\r
+ BP DEC,\r
+ 6 L# JGE,\r
+ BP POP,\r
+ SI POP,\r
+ BX POP,\r
+ NEXT,\r
+END-CODE\r
+\r
+\ y changing faster than x\r
+CODE xsteep640 \ on entry, ax = delta x, bx = delta y, cx=x1, dx=y1\r
+ BX BP MOV, \ for counter\r
+ BX 1 SHR,\r
+ BX Delta/2 ) MOV, \ halfy\r
+ BX BX XOR, \ clear for cmp\r
+6 L:\r
+ BX PUSH,\r
+ CX PUSH, \ x\r
+ DX BX MOV,\r
+ BX 1 SHL,\r
+ Y>SegTable ) BX ADD,\r
+ 0 [BX] ES MOV,\r
+ CX BX MOV,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ ES: 0 [BX] AL MOV,\r
+ 1 # AH MOV,\r
+ CL NOT,\r
+ 7 # CL AND,\r
+ AH CL ROL,\r
+ AH AL XOR,\r
+ ES: AL 0 [BX] MOV,\r
+ CX POP,\r
+ BX POP,\r
+ DX INC, \ y is always increasing\r
+ MAX-Y 16* # DX CMP,\r
+ 8 L# JL,\r
+ DX DX XOR,\r
+8 L:\r
+ Delta ) BX ADD, \ = bx + delta_y\r
+ Delta/2 ) BX CMP, \ bx > halfy ?\r
+ 7 L# JLE,\r
+ SI BX SUB, \ bx - delta_y\r
+ DI CX ADD, \ inc or dec x\r
+ MAX-X 8 * # CX SUB,\r
+ 7 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+ 7 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+7 L:\r
+ BP DEC,\r
+ 6 L# JGE,\r
+ BP POP,\r
+ SI POP,\r
+ BX POP,\r
+ NEXT,\r
+END-CODE\r
+\r
+\ on exit, cx=x1, dx=y1, ax=x2, bx=y2\r
+CODE xline640 ( x1 y1 x2 y2 -- ) \ writes to screen directly\r
+ AX POP,\r
+ DX POP,\r
+ CX POP,\r
+ SI PUSH, ( used to hold direction)\r
+ BP PUSH, ( used as counter)\r
+\ see if we'll inc or dec x, y (draws in any direction)\r
+ DX BX SUB, \ bx <- y2-y1 (delta y)\r
+ 2 L# JGE,\r
+ BX DX ADD, \ dx <- y2\r
+ BX NEG, \ abs(delta y)\r
+ CX AX XCHG,\r
+2 L:\r
+ BX SI MOV, \ delta_y(BX) to SI\r
+ CX AX SUB, \ x2 - x1 = delta_x\r
+ 1 # DI MOV, \ di to increment x\r
+ 4 L# JGE,\r
+ -1 # DI MOV, \ di to decrement x\r
+ AX NEG, \ abs(delta x)\r
+4 L:\r
+ \ adjust x1(CX), y1(DX) in proper range\r
+ MAX-X 8 * # CX SUB,\r
+ 1 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+ 1 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+1 L:\r
+ MAX-Y 16* # DX SUB,\r
+ 8 L# JNS,\r
+ MAX-Y 16* # DX ADD,\r
+ 8 L# JNS,\r
+ MAX-Y 16* # DX ADD,\r
+8 L:\r
+ AX Delta ) MOV, \ abs(delta x)\r
+ BX AX CMP, \ delta_x - delta_y\r
+ 5 L# JGE,\r
+ ' xsteep640 # JMP, \ y changes faster than x\r
+5 L:\r
+\ x changing faster than y\r
+ AX BP MOV, \ for counter\r
+ AX 1 SHR,\r
+ AX Delta/2 ) MOV, \ halfx\r
+ BX BX XOR, \ clear for cmp\r
+6 L:\r
+ BX PUSH,\r
+ CX PUSH, \ x\r
+ DX BX MOV,\r
+ BX 1 SHL,\r
+ Y>SegTable ) BX ADD,\r
+ 0 [BX] ES MOV,\r
+ CX BX MOV,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ BX 1 SHR,\r
+ ES: 0 [BX] AL MOV,\r
+ 1 # AH MOV,\r
+ CL NOT,\r
+ 7 # CL AND,\r
+ AH CL ROL,\r
+ AH AL XOR,\r
+ ES: AL 0 [BX] MOV,\r
+ CX POP,\r
+ BX POP,\r
+ DI CX ADD, \ inc or dec x\r
+ MAX-X 8 * # CX SUB,\r
+ 9 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+ 9 L# JNS,\r
+ MAX-X 8 * # CX ADD,\r
+9 L:\r
+ SI BX ADD, \ = bx + delta_y\r
+ Delta/2 ) BX CMP, \ bx > halfx ?\r
+ 7 L# JLE,\r
+ Delta ) BX SUB, \ bx - delta_x\r
+ DX INC, \ y is always increasing\r
+ MAX-Y 16* # DX CMP,\r
+ 7 L# JL,\r
+ DX DX XOR,\r
+7 L:\r
+ BP DEC,\r
+ 6 L# JGE,\r
+ BP POP,\r
+ SI POP,\r
+ BX POP,\r
+ NEXT,\r
+END-CODE\r
+\r
+DECIMAL\r
+10 CONSTANT scale\r
+0 VALUE \90\81\9f¥¦\95?\r
+VARIABLE ¤wз\r
+MAX-X 8 * 2/ VALUE xOffset\r
+MAX-Y 16 * 2/ VALUE yOffset\r
+VARIABLE xCoord xOffset xCoord !\r
+VARIABLE yCoord yOffset yCoord !\r
+\r
+: ¦\95\97i´á ( -- ) FALSE TO \90\81\9f¥¦\95? ;\r
+: ¦\95\90\81\9da ( -- ) TRUE TO \90\81\9f¥¦\95? ;\r
+: º\89ÑÁ¡e ( y -- ) MAX-Y SWAP - TO YTop ;\r
+: µ¥ÑÁ¡e ( -- ) PAGE ;\r
+\r
+CODE sin* ( \88á\9f¡ \88b\95¡ -- \88á\9f¡*sin[\88b\95¡] )\r
+\ : sin* CELLS sin16384 + @ M* 16384 SM/REM NIP ;\r
+ BX 1 SHL,\r
+ sin16384 [BX] BX MOV,\r
+ AX POP,\r
+ BX IMUL,\r
+ BX BX XOR,\r
+ AX 1 SHL,\r
+ DX 1 RCL,\r
+ AX 1 SHL,\r
+ DX 1 RCL,\r
+ DX BX ADC,\r
+ NEXT,\r
+END-CODE\r
+\r
+CODE cos* ( \88á\9f¡ \88b\95¡ -- \88á\9f¡*cos[\88b\95¡] )\r
+\ : cos* 90 + CELLS sin16384 + @ M* 16384 SM/REM NIP ;\r
+ 90 # BX ADD,\r
+ BX 1 SHL,\r
+ sin16384 [BX] BX MOV,\r
+ AX POP,\r
+ BX IMUL,\r
+ BX BX XOR,\r
+ AX 1 SHL,\r
+ DX 1 RCL,\r
+ AX 1 SHL,\r
+ DX 1 RCL,\r
+ DX BX ADC,\r
+ NEXT,\r
+END-CODE\r
+\r
+: \9d¡.\8ba´á ( x y -- )\r
+ scale / yOffset SWAP - \ x y1\r
+ SWAP scale / xOffset + SWAP \ x1 y1\r
+ \90\81\9f¥¦\95? IF 2DUP xCoord @ yCoord @ line640 THEN\r
+ yCoord ! xCoord ! ;\r
+\r
+: \88á¦\82¥¡µa ( -- )\r
+ xCoord @ 8 ¤wз @ 270 + sin* +\r
+ yCoord @ 8 ¤wз @ 270 + cos* -\r
+ 2DUP xCoord @ yCoord @ xline640 \ x1 y1\r
+ xCoord @ 16 ¤wз @ sin* +\r
+ yCoord @ 16 ¤wз @ cos* - \ x1 y1 x2 y2\r
+ 2SWAP 2OVER xline640 \ x2 y2\r
+ xCoord @ 8 ¤wз @ 90 + sin* +\r
+ yCoord @ 8 ¤wз @ 90 + cos* - \ x2 y2 x3 y3\r
+ 2SWAP 2OVER xline640 \ x3 y3\r
+ xCoord @ yCoord @ xline640 ;\r
+\r
+: ÑÁ¡e»¡¶¡ ( -- ) YTop PAGE 0 OVER AT-XY TO YTop \88á¦\82¥¡µa ;\r
+\r
+HEX\r
+: \88{·e i ( xt 'name2' -- )\r
+ DUP xt>name ?DUP 0= IF -12 THROW THEN\r
+ SWAP head, linkLast\r
+ C@ DUP\r
+ 040 AND IF IMMEDIATE THEN\r
+ 020 AND IF COMPILE-ONLY THEN ;\r
+\r
+DECIMAL\r
+' IMMEDIATE \88{·e i ¤a\9d¡\r
+' RECURSE \88{·e i \96A¦\89\9cá\r
+' IF \88{·e i ¡e\r
+' ELSE \88{·e i ´a\93¡¡e\r
+' THEN \88{·e i \9ca\r
+' BEGIN \88{·e i ·¡¹A¦\81Èá\r
+' UNTIL \88{·e i \8ca»¡\r
+' WHILE \88{·e i \95·´e\r
+' REPEAT \88{·e i \88á\97sÐ\81\r
+' DO \88{·e i \91\r
+' LOOP \88{·e i \95©´a\r
+' I \88{·e i \88a\r
+' CONSTANT \88{·e i \8a\88·e\88t\r
+' VARIABLE \88{·e i ¢\81\9fe\88t\r
+' DUP \88{·e i ¥A\8da\r
+' OVER \88{·e i \88å\90á\r
+' DROP \88{·e i ¤á\9da\r
+' SWAP \88{·e i ¤a\8e¡\r
+' ROT \88{·e i \95©\9da\r
+' >R \88{·e i >\96A\r
+' R> \88{·e i \96A>\r
+' R@ \88{·e i \96A@\r
+' AND \88{·e i \90{Ðq\8dA\r
+' OR \88{·e i \90{´a¶\89\9cá\r
+' XOR \88{·e i \90{\98a\9d¡\r
+' MOD \88{·e i \90a ỡ\r
+' CR \88{·e i \94a·qº\89\r
+' WORDS \88{·e i iÍa\r
+' .S \88{·e i .\94ᣡ\r
+\r
+' THEN \88{·e i ENDIF\r
+' = \88{·e i ==\r
+' BYE \88{·e i \8f{\r
+' BYE \88{·e i EXIT\r
+' BYE \88{·e i exit\r
+\r
+¢\81\9fe\88t \88a\9d¡¶áá\r
+¢\81\9fe\88t A\9d¡¶áá\r
+\r
+: ¹A¸a\9f¡\9d¡ ( -- )\r
+ \88á¦\82¥¡µa\r
+ 0 ¤wз !\r
+ 0 \88a\9d¡¶áá !\r
+ 0 A\9d¡¶áá !\r
+ 0 0 \9d¡.\8ba´á\r
+ \88á¦\82¥¡µa ;\r
+\r
+: ÑÁ¡e»¡¶¡ ( -- )\r
+ ¦\95\97i´á ¹A¸a\9f¡\9d¡ ÑÁ¡e»¡¶¡ ¦\95\90\81\9da ;\r
+\r
+: ½¡\88\85ÑÁ¡e ( -- ) 8 º\89ÑÁ¡e ÑÁ¡e»¡¶¡ ;\r
+: µ¥ÑÁ¡e ( -- ) µ¥ÑÁ¡e ÑÁ¡e»¡¶¡ ;\r
+\r
+: \95¡.µ¡\9fe½¢ ( \88b\95¡ -- )\r
+ \88á¦\82¥¡µa\r
+ ¤wз @ +\r
+ ¥A\8da 0 < ¡e ( \88b\95¡\88a 0¥¡\94a ¸b·a¡e)\r
+ ·¡¹A¦\81Èá 360 + ( 0 ·¡¬w·¡ \96I \98\81\8ca»¡ 360·i \94áÐq)\r
+ ¥A\8da -1 > \8ca»¡\r
+ ´a\93¡¡e 360 \90a ỡ ( 0¥¡\94a Ça¡e 360·a\9d¡ \90a\92\85 \90a ỡ\9fi \90q\8b±)\r
+ \9ca\r
+ ¤wз !\r
+ \88á¦\82¥¡µa ;\r
+\r
+: \95¡.¶E½¢ -1 * \95¡.µ¡\9fe½¢ ;\r
+\r
+: eÇq.\88a ( dx dy -- )\r
+ \88á¦\82¥¡µa\r
+ A\9d¡¶áá @ + ( dx y+dy )\r
+ ¥A\8da A\9d¡¶áá ! ( dx y+dy )\r
+ ¤a\8e¡ \88a\9d¡¶áá @ + ( y+dy x+dx )\r
+ ¥A\8da \88a\9d¡¶áá ! ( y+dy x+dx )\r
+ ¤a\8e¡ ( x+dx y+dy )\r
+ \9d¡.\8ba´á\r
+ \88á¦\82¥¡µa ;\r
+\r
+: ´|·a\9d¡ ( l -- )\r
+ ¥A\8da ( l l )\r
+ ¤wз @ sin* ( l dx )\r
+ ¤a\8e¡ ( dx l )\r
+ ¤wз @ cos* ( dx dy )\r
+ eÇq.\88a ;\r
+\r
+: \96á\9d¡ ( \88á\9f¡ -- )\r
+ -1 * ´|·a\9d¡ ;\r
+\r
+: __µ¡\9fe½¢.ÑÉ\8d© ( \88á\9f¡ ÒU®\81 -- )\r
+ 0 \91 5 \95¡.µ¡\9fe½¢ ¥A\8da ´|·a\9d¡ 5 \95¡.µ¡\9fe½¢ \95©´a ¤á\9da ;\r
+\r
+: µ¡\9fe½¢.ÑÉ\8d© ( ¤e»¡\9fq \88b\95¡ -- )\r
+ ¤a\8e¡ 355 2034 */ ( \88b\95¡ \88á\9f¡ ) ( ÑÉ\8d©·i 10\95¡³¢ \90a\92\81´á \8ba\9f± )\r
+ ( 2*pi*r*\88b\95¡/360*10 = pi*r*\88b\95¡/18 )\r
+ ( pi = 355/113 = 3.141593 )\r
+ ¥A\8da >\96A ( \96A\95©·¡ \94ᣡµA \88á\9f¡\9fi \88i¢\81\9f¡)\r
+ \88å\90á 10 / ( \88b\95¡ \88á\9f¡ ÒU®\81 )\r
+ __µ¡\9fe½¢.ÑÉ\8d© ( \88b\95¡ )\r
+ 10 \90a ỡ ( \88b\95¡_\90a ỡ )\r
+ ¥A\8da \96A> ( \88b\95¡_\90a ỡ \88b\95¡_\90a ỡ \88á\9f¡ )\r
+ ( 10·a\9d¡ \90a\92\85 \90a ỡ \88b\95¡µA Ð\81\94wÐa\93e \88á\9f¡ eÇq ´|·a\9d¡ \88q)\r
+ * 10 / ´|·a\9d¡ ( \88b\95¡_\90a ỡ )\r
+ \95¡.µ¡\9fe½¢ ;\r
+\r
+: µ¡\9fe½¢.¶¥ ( ¤e»¡\9fq -- ) 360 µ¡\9fe½¢.ÑÉ\8d© ;\r
+\r
+: __¶E½¢.ÑÉ\8d© ( \88á\9f¡ ÒU®\81 -- )\r
+ 0 \91 5 \95¡.¶E½¢ ¥A\8da ´|·a\9d¡ 5 \95¡.¶E½¢ \95©´a ¤á\9da ;\r
+\r
+: ¶E½¢.ÑÉ\8d© ( ¤e»¡\9fq \88b\95¡ -- )\r
+ ¤a\8e¡ 355 2034 */ ( \88b\95¡ \88á\9f¡ ) ( ÑÉ\8d©·i 10\95¡³¢ \90a\92\81´á \8ba\9f± )\r
+ ( 2*pi*r*\88b\95¡/360*10 = pi*r*\88b\95¡/18 )\r
+ ¥A\8da >\96A ( \96A\95©·¡ \94ᣡµA \88á\9f¡\9fi \88i¢\81\9f¡)\r
+ \88å\90á 10 / ( \88b\95¡ \88á\9f¡ ÒU®\81 )\r
+ __¶E½¢.ÑÉ\8d© ( \88b\95¡ )\r
+ 10 \90a ỡ ( \88b\95¡_\90a ỡ )\r
+ ¥A\8da \96A> ( \88b\95¡_\90a ỡ \88b\95¡_\90a ỡ \88á\9f¡ )\r
+ ( 10·a\9d¡ \90a\92\85 \90a ỡ \88b\95¡µA Ð\81\94wÐa\93e \88á\9f¡ eÇq ´|·a\9d¡ \88q)\r
+ * 10 / ´|·a\9d¡ ( \88b\95¡_\90a ỡ )\r
+ \95¡.¶E½¢ ;\r
+\r
+: ¶E½¢.¶¥ ( ¤e»¡\9fq -- ) 360 ¶E½¢.ÑÉ\8d© ;\r
+\r
+: \91A¡¡ ( Ça\8b¡ -- )\r
+ 4 0 \91 ¥A\8da ´|·a\9d¡ 90 \95¡.µ¡\9fe½¢ \95©´a ¤á\9da ;\r
+\r
+: \89sÃ¥\91A¡¡ ( -- )\r
+ 100 \91A¡¡ 200 \91A¡¡ 300 \91A¡¡ 400 \91A¡¡ ;\r
+\r
+: \94a·¡´a¡¥\97a ( -- )\r
+ 45 \95¡.µ¡\9fe½¢\r
+ 4 0 \91 \89sÃ¥\91A¡¡ 90 \95¡.µ¡\9fe½¢ \95©´a ;\r
+\r
+: \8bµ¤i ( Ça\8b¡ -- )\r
+ ¥A\8da ´|·a\9d¡ ¥A\8da \91A¡¡ \96á\9d¡ ;\r
+\r
+: µa¬õ\8bµ¤i ( Ça\8b¡ -- )\r
+ 6 0 \91 ¥A\8da \8bµ¤i 60 \95¡.µ¡\9fe½¢ \95©´a ;\r
+\r
+: ¤a\9cq\88\81§¡ ( -- )\r
+ 100 µa¬õ\8bµ¤i 400 µa¬õ\8bµ¤i ;\r
+\r
+: \8d¹·¼ ( Ça\8b¡ -- )\r
+ ¥A\8da 90 µ¡\9fe½¢.ÑÉ\8d© 90 \95¡.µ¡\9fe½¢\r
+ 90 µ¡\9fe½¢.ÑÉ\8d© 90 \95¡.µ¡\9fe½¢ ;\r
+\r
+: \8d¹ ( Ça\8b¡ -- )\r
+ 8 0 \91 ¥A\8da \8d¹·¼ 45 \95¡.µ¡\9fe½¢ \95©´a ¤á\9da ;\r
+\r
+: \94a\9fe\8d¹·¼ ( Ça\8b¡ -- )\r
+ ¥A\8da 60 µ¡\9fe½¢.ÑÉ\8d© 120 \95¡.µ¡\9fe½¢\r
+ 60 µ¡\9fe½¢.ÑÉ\8d© 120 \95¡.µ¡\9fe½¢ ;\r
+\r
+: \94a\9fe\8d¹ ( Ça\8b¡ -- )\r
+ 6 0 \91 ¥A\8da \94a\9fe\8d¹·¼ 60 \95¡.µ¡\9fe½¢ \95©´a ¤á\9da ;\r
+\r
+: Ð\95¬i ( Ça\8b¡ -- )\r
+ ¥A\8da 90 ¶E½¢.ÑÉ\8d© ¥A\8da 90 µ¡\9fe½¢.ÑÉ\8d©\r
+ ¥A\8da 90 ¶E½¢.ÑÉ\8d© 90 µ¡\9fe½¢.ÑÉ\8d© ;\r
+\r
+: Ð\81 ( Ça\8b¡ -- )\r
+ 9 0 \91 ¥A\8da Ð\95¬i 160 \95¡.µ¡\9fe½¢ \95©´a ¤á\9da ;\r
+\r
+: \88bÑw ( Ça\8b¡ ¡¡¬á\9f¡®\81 -- )\r
+ 360 \88å\90á / ¤a\8e¡ ( Ça\8b¡ \95©_\88b\95¡ ¡¡¬á\9f¡®\81 )\r
+ 0 \91 \88å\90á ´|·a\9d¡ ¥A\8da \95¡.µ¡\9fe½¢ \95©´a\r
+ ¤á\9da ¤á\9da ;\r
+\r
+: ¥i ( ¥e·\81_®\81 ¡y¤å -- )\r
+ \88å\90á \88å\90á *\r
+ 0 \91 600 ´|·a\9d¡ \88å\90á \88å\90á 360 * ¤a\8e¡ / \95¡.µ¡\9fe½¢ \95©´a\r
+ ¤á\9da ¤á\9da ;\r
+\r
+: \94a\88bÑw ( Ça\8b¡ \88b\95¡ -- )\r
+ ¤wз @ >\96A ( \96A\95©·¡\94ᣡµA Àá·q ¤wз·i \88i¢\81\9f¡)\r
+ ·¡¹A¦\81Èá\r
+ \88å\90á ´|·a\9d¡ ¥A\8da \95¡.µ¡\9fe½¢\r
+ ¤wз @ \96A@ = \8ca»¡ ( ¤wз·¡ Àá·q¤wз\89Á \88{´a»© \98\81\8ca»¡ \96AÎ\89·¡)\r
+ ¤á\9da ¤á\9da \96A> ¤á\9da ; ( \88t\94ᣡµÁ \96A\95©·¡ \94ᣡ\9fi À÷¡ )\r
+\r
+: \94a\88bÑw¸a\9cw5 5 0 \91 450 72 \94a\88bÑw 72 \95¡.µ¡\9fe½¢ \95©´a ;\r
+: \94a\88bÑw¸a\9cw4 4 0 \91 700 135 \94a\88bÑw 90 \95¡.µ¡\9fe½¢ \95©´a ;\r
+: \94a\88bÑw¸a\9cw12 12 0 \91 15 \95¡.µ¡\9fe½¢ ¦\95\97i´á 400 ´|·a\9d¡ ¦\95\90\81\9da\r
+ 200 135 \94a\88bÑw 15 \95¡.µ¡\9fe½¢ \95©´a ;\r
+\r
+: \90a¢\81 ( \88a»¡\88b\95¡ \88a»¡\8b©·¡ \88a»¡Ã¡\8b¡®\81 -- )\r
+ >\96A ( \88a»¡Ã¡\8b¡®\81\9fi \96A\95©·¡\94ᣡµA \88i¢\81\9f¡)\r
+ \96A@ ¡e ( '\96A@ 0 <> ¡e' \89Á \88{·q)\r
+ \88å\90á \95¡.¶E½¢\r
+ ¥A\8da 2 * ´|·a\9d¡\r
+ \88å\90á \88å\90á \96A@ 1 - \96A¦\89\9cá\r
+ ¥A\8da 2 * \96á\9d¡\r
+ \88å\90á 2 * \95¡.µ¡\9fe½¢\r
+ ¥A\8da ´|·a\9d¡\r
+ \88å\90á \88å\90á \96A@ 1 - \96A¦\89\9cá\r
+ \96á\9d¡ \95¡.¶E½¢\r
+ ´a\93¡¡e ¤á\9da ¤á\9da \9ca\r
+ \96A> ¤á\9da ;\r
+\r
+¢\81\9fe\88t §¡\93iÇa\8b¡ 20 §¡\93iÇa\8b¡ !\r
+: ¶w ( \90a·¡ -- )\r
+ ¥A\8da 0 = ¡e §¡\93iÇa\8b¡ @ ´|·a\9d¡\r
+ ´a\93¡¡e ¥A\8da 0 > ¡e ¥A\8da 1 - \96A¦\89\9cá ( \90a·¡-1 ¶w )\r
+ 90 \95¡.µ¡\9fe½¢\r
+ 1 \88å\90á - \96A¦\89\9cá ( 1-\90a·¡ ¶w )\r
+ ´a\93¡¡e -1 \88å\90á - \96A¦\89\9cá ( -1-\90a·¡ ¶w )\r
+ 90 \95¡.¶E½¢\r
+ 1 \88å\90á + \96A¦\89\9cá ( 1+\90a·¡ ¶w )\r
+ \9ca \9ca\r
+ ¤á\9da ;\r
+\r
+: ·¥¬a i\r
+ ½¡\88\85ÑÁ¡e\r
+ ." '\93iÎ\91'·a\9d¡ ¼e \88á¦\82\8ba\9f± Ïa\9d¡\8ba\9c\91·i ¯¡¸bÐs\93¡\94a." \94a·qº\89 \94a·qº\89\r
+ ." ¯¡Ç± i\97i·i ¥¡\9da¡e ' iÍa' \9ca\89¡ ᯡ\89¡" \94a·qº\89\r
+ ." ¯¡Ç± i·i ´á\98ý\89A ³a\93e»¡ ¥¡\9da¡e '\95¡¶\91 i \95¡¶\91 i' Àá\9cñ ᯡ\89¡" \94a·qº\89\r
+ ." DOS\9d¡ \95©´a \88a\9da¡e '\8f{' ·¡\9ca\89¡ ᯳¯¡µ¡." \94a·qº\89\r
+ ." \8ba\9f±\89Á \8bi¸a\9fi \88{·¡ ¥¡\9da¡e 'µ¥ÑÁ¡e' \98a\9d¡ ¥¡\9da¡e '½¡\88\85ÑÁ¡e'·¡\9ca\89¡ ᯳¯¡µ¡"\r
+ \94a·qº\89\r
+ ¦\95\90\81\9da\r
+ 300 \8d¹ 450 \8d¹ 600 \8d¹\r
+ ¦\95\97i´á 90 \95¡.¶E½¢ 2000 ´|·a\9d¡ ¦\95\90\81\9da\r
+ 900 \94a\9fe\8d¹ 700 \94a\9fe\8d¹ 500 \94a\9fe\8d¹\r
+ ¦\95\97i´á 4000 \96á\9d¡ 90 \95¡.µ¡\9fe½¢ ¦\95\90\81\9da\r
+ 300 Ð\r
+ 1 \8bi®A·³\9db¬wÈ\81 ! ; \ Ðe\8bi·³\9db\r
+\r
+·¥¬a i\r
+\r
+: TURTLE-hi\r
+ DOSCommand>PAD\r
+ GET-MODE TO OldMode# HGRAPHIC hi\r
+ ." ·\81\89e\89Á ¹A´e\89Á §¡Íw·i Ða·¡ÉI wykoh\9d¡ ¥¡\90\81 º\81¯³¯¡µ¡." CR\r
+ S" BLOCKS.BLK" MAPPED-TO-BLOCK\r
+ ·¥¬a i QUIT ;\r
+\r
+' TURTLE-hi TO 'boot\r
+\r
+( \94a·q·i Àa\9d\81\9d¡ ¯¡Åa¥¡¯³¯¡µ¡. )\r
+( \94a·¡´a¡¥\97a )\r
+( 400 \8bµ¤i 400 µa¬õ\8bµ¤i ¤a\9cq\88\81§¡ )\r
+( 400 3 \88bÑw 400 5 \88bÑw 400 7 \88bÑw )\r
+( 5 2 ¥i 7 2 ¥i 7 3 ¥i 8 3 ¥i 9 2 ¥i 9 4 ¥i 10 3 ¥i 11 3 ¥i 11 5 ¥i )\r
+( \94a\88bÑw¸a\9cw5 )\r
+( \94a\88bÑw¸a\9cw5 )\r
+( \94a\88bÑw¸a\9cw12 )\r
+( 30 400 4 \90a¢\81 )\r
+( 20 250 5 \90a¢\81 )\r
+( 20 250 6 \90a¢\81 )\r
+( 50 §¡\93iÇa\8b¡ ! 9 ¶w )\r
+( 20 §¡\93iÇa\8b¡ ! 12 ¶w )\r
+\r
+SET-CURRENT SET-ORDER\r
+BASE !\r
-\\r
-\ LOG.F\r
-\ Capture screen output in a textfile for hForth.\r
-\\r
-\ 1996. 2. 28.\r
-\ Wonyong Koh.\r
-\\r
-\ Usage:\r
-\ LOGON ( -- )\r
-\ ÑÁ¡e Â\89\9db·i HFORTH.LOGµA \88i¢\81\9f¡Ðs\93¡\94a. Â\89\9db \88a\9f¡Ç±¯©Ð\97\88t 'emit·¡\r
-\ ¤a\8eå Ò\81µA\93e (µ\81\9fi \97i´á, HIOMULT?.F·\81 TEXT\90a HGRAPHIC·i ¯¡Ç¥ Ò\81\90a\r
-\ Í¡¯a ¯¡¯aÉQ·¡ '?'·i ¥¡µa ¸i¡µ·i ´i\9f¥ \89w¶\81) LOGON·¡\9ca\89¡ \94a¯¡ ¯¡Åa´¡\r
-\ \88i¢\81\9f¡\88a \89\81¢\96S\93¡\94a.\r
-\ Start to save screen output in HFORTH.LOG.\r
-\ Please reissue 'LOGON' after changing "'emit" vector.\r
-\ (for example, after TEXT or HGRAPHIC of HIOMULT?.F)\r
-\ LOGOFF ( -- )\r
-\ HFORTH.LOG\9fi \94h\89¡ ÑÁ¡e \88i¢\81\9f¡\9fi ñÂ\93\93¡\94a.\r
-\ Close HFORTH.LOG and stop saving screen output.\r
-\r
-MARKER ~LOG\r
-\r
-BASE @\r
-GET-ORDER GET-CURRENT\r
-\r
-GET-ORDER DOS-WORDLIST SWAP 1+ SET-ORDER\r
-DOS-WORDLIST SET-CURRENT\r
-\r
-HEX\r
-8000 CONSTANT invalid-fid\r
-\r
-invalid-fid VALUE logfid\r
-0 VALUE old'emit\r
-CREATE LogBUFFER 1 CHARS ALLOT ALIGN\r
-\r
-: LogEMIT ( char -- )\r
- DUP LogBUFFER C! LogBUFFER 1 CHARS logfid WRITE-FILE THROW\r
- old'emit EXECUTE ;\r
-\r
-NONSTANDARD-WORDLIST SET-CURRENT\r
-\r
-: LOGON\r
- logfid CLOSE-FILE DROP\r
- S" HFORTH.LOG" W/O OPEN-FILE\r
- ?DUP IF\r
- DUP [ 2 iorOffset + ] LITERAL <> \ file not found?\r
- IF THROW THEN\r
- 2DROP S" HFORTH.LOG" W/O CREATE-FILE THROW TO logfid\r
- ELSE\r
- TO logfid\r
- logfid FILE-SIZE THROW logfid REPOSITION-FILE THROW\r
- THEN\r
- CR ." All characters on screen will be saved in HFORTH.LOG until 'emit is revectored."\r
- CR ." ÑÁ¡eµA ¥¡·¡\93e \8bi¸a\97i·e ¡¡\96\81 'emit·¡ ¤a\8eá\8b¡ ¸å\8ca»¡ HFORTH.LOGµA \88i¢\81\9f¡\96S\93¡\94a." CR\r
- 'emit ['] LogEMIT <> IF\r
- 'emit TO old'emit\r
- ['] LogEMIT TO 'emit\r
- THEN ;\r
-\r
-: LOGOFF\r
- logfid CLOSE-FILE\r
- invalid-fid TO logfid\r
- old'emit TO 'emit ;\r
-\r
-LOGON\r
-\r
-SET-CURRENT SET-ORDER\r
-BASE !\r
-\r
-CHAR " PARSE FILE" ENVIRONMENT?\r
-[IF]\r
- 0= [IF] << CON [THEN]\r
-[ELSE] << CON\r
-[THEN]\r
++ ( \88t1 \88t2 -- \88t3 )\r
+ \88t1\89Á \88t2\9fi \94áÐe\94a.\r
+ 1 2 +\r
+ Àá\9cñ ¯¡Ç¡¡e 1\89Á 2\9fi \94áÐe \88t 3·i \94ᣡµA µ©\9f¥\94a.\r
+- ( \88t1 \88t2 -- \88t3 )\r
+ \88t1µA¬á \88t2\9fi ¨\85\94a.\r
+ 2 1 -\r
+ Àá\9cñ ¯¡Ç¡¡e 2µA¬á 1·i ¨\85 \88t 1·i \94ᣡµA µ©\9f¥\94a.\r
+* ( \88t1 \88t2 -- \88t3 )\r
+ \88t1µA \88t2\9fi \89³Ðe\94a.\r
+ 2 3 *\r
+ Àá\9cñ ¯¡Ç¡¡e \89³Ðe \88t 6·i \94ᣡµA µ©\9f¥\94a.\r
+/ ( \88t1 \88t2 -- \88t3 )\r
+ \88t1·i \88t2\9d¡ \90a\92\85\94a.\r
+ 6 2 /\r
+ Àá\9cñ ¯¡Ç¡¡e 6·i 2\9d¡ \90a\92\85 \88t 3·i \94ᣡµA µ©\9f¥\94a.\r
+MOD ( \88t1 \88t2 -- \88t3 )\r
+ \88t1·i \88t2\9d¡ \90a\92\85 \90a ỡ\9fi \8a\81Ðe\94a.\r
+ 8 3 MOD\r
+ Àá\9cñ ¯¡Ç¡¡e 8·i 3·a\9d¡ \90a\92\85 \90a ỡ 2\9fi \94ᣡµA µ©\9f¥\94a.\r
+\90a ỡ ( \88t1 \88t2 -- \88t3 )\r
+ \88t1·i \88t2\9d¡ \90a\92\85 \90a ỡ\9fi \8a\81Ðe\94a.\r
+ 8 3 \90a ỡ\r
+ Àá\9cñ ¯¡Ç¡¡e 8·i 3·a\9d¡ \90a\92\85 \90a ỡ 2\9fi \94ᣡµA µ©\9f¥\94a.\r
+. ( \88t -- )\r
+ \94ᣡ·\81 \85 ¶á \88t·i ÑÁ¡eµA ¯³»¥®\81\9d¡ ¥¡·¥\94a.\r
+DUP ( \88t -- \88t \88t )\r
+ \94ᣡ·\81 \85 ¶á \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
+ 1 DUP\r
+ Àá\9cñ ¯¡Ç¡¡e 1·i \96\81 \88\81 \94ᣡµA µ©\9f¥\94a.\r
+¥A\8da ( \88t -- \88t \88t )\r
+ \94ᣡ·\81 \85 ¶á \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
+ 1 ¥A\8da\r
+ Àá\9cñ ¯¡Ç¡¡e 1·i \96\81 \88\81 \94ᣡµA µ©\9f¥\94a.\r
+OVER ( \88t1 \88t2 -- \88t1 \88t2 \88t1 )\r
+ \94ᣡ·\81 \96\81 ¤å¼\81 \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
+ 1 2 OVER\r
+ Àá\9cñ ¯¡Ç¡¡e 1, 2, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
+\88å\90á ( \88t1 \88t2 -- \88t1 \88t2 \88t1 )\r
+ "\88å\90á (¥A\8da)". \94ᣡ·\81 \96\81 ¤å¼\81 \88t·i ¥A\8da¬á \94ᣡµA µ©\9f¥\94a.\r
+ 1 2 \88å\90á\r
+ Àá\9cñ ¯¡Ç¡¡e 1, 2, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
+SWAP ( \88t1 \88t2 -- \88t2 \88t1 )\r
+ \94ᣡ·\81 \85 ¶á \96\81 \88t·\81 ¸a\9f¡\9fi ¤a\8e\85\94a.\r
+ 1 2 SWAP\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA\93e 1·¡, ¤a\9d¡ £»µA 2\88a ·¶\94a.\r
+¤a\8e¡ ( \88t1 \88t2 -- \88t2 \88t1 )\r
+ \94ᣡ·\81 \85 ¶á \96\81 \88t·\81 ¸a\9f¡\9fi ¤a\8e\85\94a.\r
+ 1 2 ¤a\8e¡\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA\93e 1·¡, ¤a\9d¡ £»µA 2\88a ·¶\94a.\r
+DROP ( \88t1 -- )\r
+ \94ᣡ·\81 \85 ¶á \88t·i ¤á\9f¥\94a.\r
+¤á\9da ( \88t1 -- )\r
+ \94ᣡ·\81 \85 ¶á \88t·i ¤á\9f¥\94a.\r
+ROT ( \88t1 \88t2 \88t3 -- \88t2 \88t3 \88t1 )\r
+ \94ᣡ·\81 \85 ¶á A \88t·i \95©\9f¥\94a. A ¤å¼\81 \88t·i \8cá\90\81 \85 ¶áµA µ©\9f¥\94a.\r
+ 1 2 3 ROT\r
+ Àá\9cñ ¯¡Ç¡¡e 2, 3, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
+\95©\9da ( \88t1 \88t2 \88t3 -- \88t2 \88t3 \88t1 )\r
+ \94ᣡ·\81 \85 ¶á A \88t·i \95©\9f¥\94a. A ¤å¼\81 \88t·i \8cá\90\81 \85 ¶áµA µ©\9f¥\94a.\r
+ 1 2 3 \95©\9da\r
+ Àá\9cñ ¯¡Ç¡¡e 2, 3, 1·i Àa\9d\81\9d¡ \94ᣡµA µ©\9f¥\94a.\r
+>R ( \88t\94ᣡ: \88t -- ; \96A\95©·¡\94ᣡ: -- \88t )\r
+ \88t\94ᣡ·\81 \88t·i \96A\95©·¡\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
+ \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
+ ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
+>\96A ( \88t\94ᣡ: \88t -- ; \96A\95©·¡\94ᣡ: -- \88t )\r
+ \88t\94ᣡ·\81 \88t·i \96A\95©·¡\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
+ \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
+ ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
+R> ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- )\r
+ \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
+ \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
+ ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
+\96A> ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- )\r
+ \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ µ«\8b¥\94a. 'DO ... LOOP'\90a ' \91 ...\r
+ \95©´a'\88a \96A\95©·¡\94ᣡ\9fi ¬a¶wÐa£a\9d¡ LOOPµÁ '\95©´a' ¸åµA \96A\95©·¡\94ᣡ\9fi\r
+ ¶¥¬wÈ\81\9d¡ \95©\9da \91½´a´¡ Ðe\94a.\r
+R@ ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- \88t )\r
+ \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ ¥A\8f¥\94a.\r
+\96A@ ( \88t\94ᣡ: -- \88t ; \96A\95©·¡\94ᣡ: \88t -- \88t )\r
+ \96A\95©·¡\94ᣡ·\81 \88t·i \88t\94ᣡ\9d¡ ¥A\8f¥\94a.\r
+= ( \88t1 \88t2 -- -1|0 )\r
+ 5 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¡\89¡\r
+ 6 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¥\94a.\r
+== ( \88t1 \88t2 -- -1|0 )\r
+ 5 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¡\89¡\r
+ 6 5 = Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¥\94a.\r
+> ( \88t1 \88t2 -- -1|0 )\r
+ 5 6 > Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¡\89¡\r
+ 5 5 > Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¡\89¡\r
+ 6 5 > Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¥\94a.\r
+< ( \88t1 \88t2 -- -1|0 )\r
+ 5 6 < Àá\9cñ ¯¡Ç¡¡e \94ᣡµA -1·i µ©\9f¡\89¡\r
+ 5 5 < Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¡\89¡\r
+ 6 5 < Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i µ©\9f¥\94a.\r
+AND ( \88t1 \88t2 -- \88t3 )\r
+ \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
+\90{Ðq\8dA ( \88t1 \88t2 -- \88t3 )\r
+ \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
+OR ( \88t1 \88t2 -- \88t3 )\r
+ \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡Ðs·i \94ᣡµA µ©\9f¥\94a.\r
+\90{´a¶\89\9cá ( \88t1 \88t2 -- \88t3 )\r
+ \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe \91¥\9f¡Ðs·i \94ᣡµA µ©\9f¥\94a.\r
+XOR ( \88t1 \88t2 -- \88t3 )\r
+ \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe ¤\81Èa¸â \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
+\90{\98a\9d¡ ( \88t1 \88t2 -- \88t3 )\r
+ \88t1\89Á \88t2·\81 \88b \90{(bit)µA \94\81Ðe ¤\81Èa¸â \91¥\9f¡\89³·i \94ᣡµA µ©\9f¥\94a.\r
+WORDS ( -- )\r
+ ³i ®\81 ·¶\93e ¯¡Ç± i\97i·i ÑÁ¡eµA ¥¡·¥\94a.\r
+ iÍa ( -- )\r
+ ³i ®\81 ·¶\93e ¯¡Ç± i\97i·i ÑÁ¡eµA ¥¡·¥\94a.\r
+.S ( -- )\r
+ \88t\94ᣡ·\81 \88t\97i·i ¥¡·¥\94a.\r
+.\94ᣡ ( -- )\r
+ \88t\94ᣡ·\81 \88t\97i·i ¥¡·¥\94a.\r
+BYE ( -- )\r
+ \93iÎ\91·i \8f{\90\85\94a.\r
+\8f{ ( -- )\r
+ \93iÎ\91·i \8f{\90\85\94a.\r
+CR ( -- )\r
+ ÑÁ¡eµA ¬\81 º\89·i e\97e\94a.\r
+\94a·qº\89 ( -- )\r
+ ÑÁ¡eµA ¬\81 º\89·i e\97e\94a.\r
+HELP ( -- )\r
+ HELP \94a·q·\81 \90{ iµA \94\81Ðe \95¡¶\91 i·i Ìa·© 'HFORTH.HLP'µA¬á Àx´a ¥¡·¥\94a.\r
+ HELP DUP\r
+ Àá\9cñ ¯¡Ç¡¡e '¥A\8da'\9fi ´á\98ý\89A ³a\93e»¡ ÑÁ¡eµA ¥¡·¥\94a.\r
+\95¡¶\91 i ( -- )\r
+ HELP \94a·q·\81 \90{ iµA \94\81Ðe \95¡¶\91 i·i Ìa·© 'HFORTH.HLP'µA¬á Àx´a ¥¡·¥\94a.\r
+ \95¡¶\91 i ¥A\8da\r
+ Àá\9cñ ¯¡Ç¡¡e '¥A\8da'\9fi ´á\98ý\89A ³a\93e»¡ ÑÁ¡eµA ¥¡·¥\94a.\r
+CLS ( -- )\r
+ ÑÁ¡e·i »¡¶\85\94a.\r
+ÑÁ¡e»¡¶¡ ( -- )\r
+ ÑÁ¡e·i »¡¶\85\94a.\r
+CONSTANT ( \88t -- )\r
+ »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- \88t )\r
+ \94ᣡ·\81 \88t·i °á¬á '\8a\88·e\88t' \94a·qµA \90aµ¡\93e ·¡\9fq·a\9d¡ \8a\88·e\88t(¬w®\81)·i\r
+ e\97e\94a.\r
+ 5 CONSTANT FIVE\r
+ Àá\9cñ ¯¡Ç¡¡e 'FIVE'\9ca\93e ·¡\9fq·\81 \8a\88·e\88t·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
+ FIVE\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA 5\9fi µ©\9f¥\94a.\r
+\8a\88·e\88t ( \88t -- )\r
+ »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- \88t )\r
+ \94ᣡ·\81 \88t·i °á¬á '\8a\88·e\88t' \94a·qµA \90aµ¡\93e ·¡\9fq·a\9d¡ \8a\88·e\88t(¬w®\81)·i\r
+ e\97e\94a.\r
+ 5 \8a\88·e\88t \94a¬õ\r
+ Àá\9cñ ¯¡Ç¡¡e '\94a¬õ'·¡\9ca\93e ·¡\9fq·\81 \8a\88·e\88t·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
+ \94a¬õ\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡ·\81 \85 ¶áµA 5\9fi µ©\9f¥\94a.\r
+VARIABLE ( -- )\r
+ »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- º\81¡ )\r
+ VARIABLE AGE\r
+ Àá\9cñ ¯¡Ç¡¡e 'AGE'\9ca\93e ·¡\9fq·\81 ¢\81\9fe\88t(¥e®\81)·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
+ AGE\r
+ Àá\9cñ ¯¡Ç¡¡e 'AGE'·\81 \88t·\81 º\81¡\9fi \94ᣡ·\81 \85 ¶áµA µ©\9f¥\94a.\r
+¢\81\9fe\88t ( -- )\r
+ »¡·e \90{ i·¡ ¯¡Åa»© \98\81: ( -- º\81¡ )\r
+ ¢\81\9fe\88t \90a·¡\r
+ Àá\9cñ ¯¡Ç¡¡e '\90a·¡'\9ca\93e ·¡\9fq·\81 ¢\81\9fe\88t(¥e®\81)·i e\97e\94a. \8ba\9f¡\89¡ \90a¬á\r
+ \90a·¡\r
+ Àá\9cñ ¯¡Ç¡¡e '\90a·¡'·\81 \88t·\81 º\81¡\9fi \94ᣡ·\81 \85 ¶áµA µ©\9f¥\94a.\r
+! ( \88t º\81¡ -- )\r
+ \94ᣡ·\81 \85 ¶áµA ·¶\93e º\81¡µA \94ᣡ·\81 \96\81 ¤å¼\81 \88t·i °á\90ý\93e\94a.\r
+ 16 \90a·¡ !\r
+ Àá\9cñ ¯¡Ç¡¡e ¢\81\9fe\88t '\90a·¡'µA 16·i °á\90ý\93e\94a.\r
+@ ( º\81¡ -- \88t )\r
+ \94ᣡ·\81 \85 ¶áµA ·¶\93e º\81¡µA \97e \88t·i \94ᣡµA µ©\9f¥\94a.\r
+ \90a·¡ @\r
+ Àá\9cñ ¯¡Ç¡¡e ¢\81\9fe\88t '\90a·¡'·\81 \88t·i \94ᣡµA µ©\9f¥\94a.\r
+: ( -- )\r
+ \90{ i »µ\8b¡\9fi ¯¡¸bÐe\94a.\r
+ : ¬\81\90{ i \90{ i1 \90{ i2 \90{ i3 ;\r
+ Àá\9cñ °á¬á ¬\81 \90{ i '¬\81\90{ i'·\81 ¸÷·\81\9fi ¯¡¸bÐe\94a.\r
+; ( -- )\r
+ \90{ i »µ\8b¡\9fi \8f{\90\85\94a.\r
+ : ¬\81\90{ i \90{ i1 \90{ i2 \90{ i3 ;\r
+ Àá\9cñ ³e\94a.\r
+( ( -- )\r
+ ')' \90aµ© \98\81\8ca»¡ \8bi·i ¯¡Ç¡»¡ ´g\89¡ \88å\90á\9aå\94a. '('\95¡ Ða\90a·\81 \90{ i·¡£a\9d¡\r
+ \96áµA §¥Äe·¡ ¤e\97a¯¡ Ða\90a ·¡¬w ·¶´á´¡ Ðe\94a.\r
+ ( ·¡\88õ·e \94õ¦\9b·± i·³\93¡\94a.)\r
+ Àá\9cñ ³e\94a. º\81·\81: '('\93e ¯¡Ç± i·¡»¡ e ')'\93e ¯¡Ç± i·¡ ´a\93¡\94a.\r
+." ( -- )\r
+ '"'·¡ \90aµ© \98\81\8ca»¡·\81 \8bi·i ÑÁ¡eµA ¥¡·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
+ ·¶\94a.\r
+ : ¯¡Ðñ ." ·¡ \8bi·¡ ÑÁ¡eµA ¥¡µa»³\93¡\94a." ;\r
+ Àá\9cñ ¯¡Ç¥ \94a·q\r
+ ¯¡Ðñ\r
+ ·¡\9ca\89¡ ¯¡Ç¡¡e ÑÁ¡eµA '·¡ \8bi·¡ ÑÁ¡eµA ¥¡µa»³\93¡\94a.'\9fi ¥¡·¥\94a.\r
+IF ¯¡Åa»© \98\81: ( \88t -- )\r
+ 'IF ... THEN'\90a 'IF ... ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
+ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a. 'IF ... THEN'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á\r
+ \88t·¡ 0·¡ ´a\93© \98\81 e 'IF ... THEN' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a. 'IF ...\r
+ ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e 'IF ...\r
+ THEN' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e 'ELSE ... THEN' ¬a·¡·\81\r
+ \90{ i·¡ ¯¡Åa»¥\94a.\r
+ : ?DUP DUP IF DUP THEN ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 3 ?DUP\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
+ 0 ?DUP\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i 1 \88\81 µ©\9f¥\94a.\r
+¡e ¯¡Åa»© \98\81: ( \88t -- )\r
+ '¡e ... \9ca'\90a '¡e ... ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
+ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a. '¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á\r
+ \88t·¡ 0·¡ ´a\93© \98\81 e '¡e ... \9ca' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a. '¡e ...\r
+ ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¡¡e \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e '¡e\r
+ ... \9ca' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e '´a\93¡¡e ... \9ca' ¬a·¡·\81\r
+ \90{ i·¡ ¯¡Åa»¥\94a.\r
+ : ?¥A\8da ¥A\8da ¡e ¥A\8da \9ca ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 3 ?¥A\8da\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
+ 0 ?¥A\8da\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 0·i 1 \88\81 µ©\9f¥\94a.\r
+ELSE ¯¡Åa»© \98\81: ( -- )\r
+ 'IF ... ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
+ ·¶\94a. \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e 'IF ... ELSE' ¬a·¡·\81 \90{ i·¡\r
+ ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e 'ELSE ... THEN' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a.\r
+ : TEST IF DUP ELSE DROP THEN ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 3 1 TEST\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
+ 3 0 TEST\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA ´a¢\81 \88õ\95¡ µ©\9f¡»¡ ´g\93e\94a.\r
+´a\93¡¡e ¯¡Åa»© \98\81: ( -- )\r
+ '¡e ... ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
+ ·¶\94a. \94ᣡ·\81 \85 ¶á \88t·¡ 0·¡ ´a\93¡¡e '¡e ... ´a\93¡¡e' ¬a·¡·\81 \90{ i·¡\r
+ ¯¡Åa»¡\89¡, \88t·¡ 0·¡¡e '´a\93¡¡e ... \9ca' ¬a·¡·\81 \90{ i·¡ ¯¡Åa»¥\94a.\r
+ : ¯¡Ðñ ¡e ¥A\8da ´a\93¡¡e ¤á\9da \9ca ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 3 1 ¯¡Ðñ\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA 3·i 2 \88\81 µ©\9f¥\94a.\r
+ 3 0 ¯¡Ðñ\r
+ Àá\9cñ ¯¡Ç¡¡e \94ᣡµA ´a¢\81 \88õ\95¡ µ©\9f¡»¡ ´g\93e\94a.\r
+THEN ¯¡Åa»© \98\81: ( -- )\r
+ 'IF ... THEN'\90a 'IF ... ELSE ... THEN'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
+ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
+\9ca ¯¡Åa»© \98\81: ( -- )\r
+ '¡e ... \9ca'\90a '¡e ... ´a\93¡¡e ... \9ca'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
+ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
+ENDIF ¯¡Åa»© \98\81: ( -- )\r
+ 'IF ... ENDIF'\90a 'IF ... ELSE ... ENDIF'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡\r
+ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
+BEGIN ¯¡Åa»© \98\81: ( -- )\r
+ 'BEGIN ... UNTIL'\90a 'BEGIN ... WHILE ... REPEAT'·\81 ¼b·a\9d¡ ³aµa\r
+ \88á\97s¯¡Ç±·\81 Àá·q·i Îa¯¡Ðe\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
+·¡¹A¦\81Èá ¯¡Åa»© \98\81: ( -- )\r
+ '·¡¹A¦\81Èá ... \8ca»¡'\90a '·¡¹A¦\81Èá ... \95·´e... \88á\97sÐ\81'·\81 ¼b·a\9d¡ ³aµa\r
+ \88á\97s¯¡Ç±·\81 Àá·q·i Îa¯¡Ðe\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
+UNTIL ¯¡Åa»© \98\81: ( \88t -- )\r
+ 'BEGIN ... UNTIL'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
+ '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a 'UNTIL' \94a·q·\81 \90{ i·¡ ¯¡Åa»¡\89¡\r
+ '\88t'·¡ 0·¡¡e 'BEGIN ... UNTIL' ¬a·¡·\81 \90{ i·i \88á\97s¯¡Ç¥\94a.\r
+ : COUNTDOWN BEGIN DUP . 1 - DUP 0 = UNTIL ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 5 COUNTDOWN\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
+\8ca»¡ ¯¡Åa»© \98\81: ( \88t -- )\r
+ '·¡¹A¦\81Èá ... \8ca»¡'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81 ·¶\94a.\r
+ '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a '\8ca»¡' \94a·q·\81 \90{ i·¡ ¯¡Åa»¡\89¡\r
+ '\88t'·¡ 0·¡¡e '·¡¹A¦\81Èá ... \8ca»¡' ¬a·¡·\81 \90{ i·i \88á\97s¯¡Ç¥\94a.\r
+ : ¦\81Èá.´a\9c\81\9d¡.A ·¡¹A¦\81Èá ¥A\8da . 1 - ¥A\8da 0 = \8ca»¡ ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 5 ¦\81Èá.´a\9c\81\9d¡.A\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
+WHILE ¯¡Åa»© \98\81: ( \88t -- )\r
+ 'BEGIN ... WHILE ... REPEAT'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
+ ³i ®\81 ·¶\94a. '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·¡ \89\81¢\96A´á 'WHILE' \94a·q·\81\r
+ \90{ i·¡ ¯¡Åa»¡\89¡ '\88t'·¡ 0·¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a 'REPEAT' \94a·q·\81\r
+ \90{ i·¡ ¯¡Åa»¥\94a.\r
+ : COUNTDOWN BEGIN DUP WHILE DUP . 1 - REPEAT ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 5 COUNTDOWN\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
+\95·´e ¯¡Åa»© \98\81: ( \88t -- )\r
+ '·¡¹A¦\81Èá ... \95·´e... \88á\97sÐ\81'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
+ ³i ®\81 ·¶\94a. '\88t'·¡ 0·¡ ´a\93¡¡e \88á\97s¯¡Ç±·¡ \89\81¢\96A´á '\95·´e' \94a·q·\81\r
+ \90{ i·¡ ¯¡Åa»¡\89¡ '\88t'·¡ 0·¡¡e \88á\97s¯¡Ç±·i ¤õ´á\90a '\88á\97sÐ\81' \94a·q·\81\r
+ \90{ i·¡ ¯¡Åa»¥\94a.\r
+ : ¦\81Èá.´a\9c\81\9d¡.A ·¡¹A¦\81Èá ¥A\8da \95·´e ¥A\8da . 1 - \88á\97sÐ\81 ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 5 ¦\81Èá.´a\9c\81\9d¡.A\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '5 4 3 2 1'·i ¥¡·¥\94a.\r
+REPEAT ¯¡Åa»© \98\81: ( -- )\r
+ 'BEGIN ... WHILE ... REPEAT'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
+ ³i ®\81 ·¶\94a. 'BEGIN' \94a·q·a\9d¡ \88á\97s¯¡Ç±·i \89\81¢Ðe\94a.\r
+\88á\97sÐ\81 ¯¡Åa»© \98\81: ( -- )\r
+ '·¡¹A¦\81Èá ... \95·´e... \88á\97sÐ\81'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e\r
+ ³i ®\81 ·¶\94a. '·¡¹A¦\81Èá' \94a·q·a\9d¡ \88á\97s¯¡Ç±·i \89\81¢Ðe\94a.\r
+DO ¯¡Åa»© \98\81: ( \88t1 \88t2 -- )\r
+ ¤e\97a¯¡ 'DO ... LOOP'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
+ ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ 'DO ... LOOP' ¬a·¡·\81\r
+ \90{ i·i \88á\97s¯¡Ç¥\94a.\r
+ : 5STARS 5 0 DO ." *" LOOP ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 5STARS\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '*****'\88a Îa¯¡\96E\94a.\r
+ \91 ¯¡Åa»© \98\81: ( \88t1 \88t2 -- )\r
+ ¤e\97a¯¡ ' \91 ... \95©´a'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
+ ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ ' \91 ... \95©´a' ¬a·¡·\81\r
+ \90{ i·i \88á\97s¯¡Ç¥\94a.\r
+ : \94a¬õ¥i 5 0 \91 ." *" \95©´a ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ \94a¬õ¥i\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '*****'\88a Îa¯¡\96E\94a.\r
+LOOP ¯¡Åa»© \98\81: ( -- )\r
+ ¤e\97a¯¡ 'DO ... LOOP'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
+ ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ 'DO ... LOOP' ¬a·¡·\81\r
+ \90{ i·i \88á\97s¯¡Ç¥\94a.\r
+\95©´a ¯¡Åa»© \98\81: ( -- )\r
+ ¤e\97a¯¡ ' \91 ... \95©´a'·\81 ¼b·a\9d¡ ³a·¥\94a. i»µ\8b¡ ¬wÈ\81µA¬á e ³i ®\81\r
+ ·¶\94a. '\88t2'\88a Ða\90a³¢ Äá¹a¬á '\88t1'·¡ \96I \98\81\8ca»¡ ' \91 ... \95©´a' ¬a·¡·\81\r
+ \90{ i·i \88á\97s¯¡Ç¥\94a.\r
+I ¯¡Åa»© \98\81: ( -- \88t )\r
+ \91\95©·¡ \88a\9f¡Ç±®\81\9d¡ ¤e\97a¯¡ 'DO ... LOOP' ´eµA¬á ³e\94a.\r
+ '\88t2 \88t1 DO I LOOP'µA¬á '\88a'\93e Àa\9d\81\9d¡ '\88t1'µA¬á '\88t2'-1 \8ca»¡·\81\r
+ \88t\97i·i \94ᣡµA µ©\9f¥\94a.\r
+ : COUNT 0 DO I . LOOP ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 5 COUNT\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '0 1 2 3 4'\9fi ¥¡·¥\94a.\r
+\88a ¯¡Åa»© \98\81: ( -- \88t )\r
+ "\88a(\9f¡Ç±®\81)." \91\95©·¡ \88a\9f¡Ç±®\81\9d¡ ¤e\97a¯¡ ' \91 ... \95©´a' ´eµA¬á ³e\94a.\r
+ '\88t2 \88t1 \91 \88a \95©´a'µA¬á '\88a'\93e Àa\9d\81\9d¡ '\88t1'µA¬á '\88t2'-1 \8ca»¡·\81\r
+ \88t\97i·i \94ᣡµA µ©\9f¥\94a.\r
+ : ¤å.A\8b¡ 0 \91 \88a . \95©´a ;\r
+ Àá\9cñ \90{ i·i »µ\89¡\r
+ 5 ¤å.A\8b¡\r
+ Àá\9cñ ¯¡Ç¡¡e ÑÁ¡eµA '0 1 2 3 4'\9fi ¥¡·¥\94a.\r
+IMMEDIATE ( -- )\r
+ ¤w\8bq »¡·e i·i i»µ\8b¡ ¬wÈ\81µA¬á\95¡ ¯©Ð\97\96A\93e '¤a\9d¡ i'\9d¡ e\97e\94a.\r
+¤a\9d¡ i ( -- )\r
+ ¤w\8bq »¡·e i·i i»µ\8b¡ ¬wÈ\81µA¬á\95¡ ¯©Ð\97\96A\93e '¤a\9d¡ i'\9d¡ e\97e\94a.\r
+' ( -- º\81¡ )\r
+ "'" \94a·qµA \90aµ¡\93e \90{ i·\81 º\81¡\9fi \94ᣡµA \90q\8b¥\94a.\r
+\88{·e i ( º\81¡ -- )\r
+ '\88{·e i' \94a·qµA \90aµ¡\93e ·¡\9fq·a\9d¡, \94ᣡµA º\81¡\88a ·¶\93e \90{ i\89Á \99¢\88{·e\r
+ ·©·i Ða\93e \90{ i·i e\97e\94a.\r
+ ' DUP \88{·e i ¥A\8da\r
+ Àá\9cñ ¯¡Ç¡¡e DUP µÁ \88{·e ·©·i Ða\93e \90{ i '¥A\8da'\9fi e\97e\94a.\r
+º\89ÑÁ¡e ( º\89®\81 -- )\r
+ ´a\9c\81¬á¦\81Èá \8bi¸a\88a ¥¡·© º\89 ®\81\9fi ¸÷Ðe\94a.\r
+sin* ( \8b©·¡ \88b\95¡ -- \8b©·¡*sin[\88b\95¡] )\r
+ \8b©·¡µÁ \88b\95¡\9d¡¦\81Èá \8b©·¡µA ¬q\88b§¡\9fi \89³Ðe \88t·i \89\81¬eÐe\94a.\r
+cos* ( \8b©·¡ \88b\95¡ -- \8b©·¡*cos[\88b\95¡] )\r
+ \8b©·¡µÁ \88b\95¡\9d¡¦\81Èá \8b©·¡µA ¬q\88b§¡\9fi \89³Ðe \88t·i \89\81¬eÐe\94a.\r
+\9d¡.\8ba´á ( x y -- )\r
+ »¡\8bq ¸a\9f¡µA¬á \88á¦\82¹ÁÎa (x,y)\9d¡ ¬å·i \8bu\93e\94a. ÑÁ¡eµA \8bq·i \8bu\93e \88a¸w\r
+ \8b¡¥¥¸â·¥ \90{ i·¡\94a. \88á¦\82 ¶\91»¢·± \90{ i '¹A¸a\9f¡\9d¡'µÁ ' eÇq.\88a'µA\r
+ ³a·¥\94a.\r
+\88á¦\82¥¡µa ( -- )\r
+ ÑÁ¡eµA \88á¦\82·¡ ·¶·a¡e »¡¶\81\89¡ ´ô·a¡e ¥¡·¥\94a.\r
+¤wз ( -- º\81¡ )\r
+ ¢\81\9fe\88t '¤wз'. \88á¦\82·\81 ¤wз·¡ \94q\89a ·¶\94a.\r
+\88a\9d¡¶áá ( -- º\81¡ )\r
+ ¢\81\9fe\88t '\88a\9d¡¶áá'. \88á¦\82·\81 x ¹ÁÎa\88a \94q\89a ·¶\94a.\r
+A\9d¡¶áá ( -- º\81¡ )\r
+ ¢\81\9fe\88t '\88a\9d¡¶áá'. \88á¦\82·\81 y ¹ÁÎa\88a \94q\89a ·¶\94a.\r
+ eÇq.\88a ( \88a\9d¡\88á\9f¡ A\9d¡\88á\9f¡ -- )\r
+ \88á¦\82·¡ »¡\8bq ¹ÁÎa (x,y)µA¬á (x+\88a\9d¡\88á\9f¡, y+A\9d¡\88á\9f¡)\9d¡ ¶\91»¢·¥\94a.\r
+ \90{ i '´|·a\9d¡'µÁ '\96á\9d¡'µA ³a·¥\94a.\r
+__µ¡\9fe½¢.ÑÉ\8d© ( \88á\9f¡ ÒU®\81 -- )\r
+ \88á\9f¡ eÇq \88a\89¡ 10 \95¡ µ¡\9fe½¢·a\9d¡ \95¡\93e \88õ·i ÒU®\81 eÇq \96AÎ\89·¡Ðe\94a.\r
+ \90{ i 'µ¡\9fe½¢.ÑÉ\8d©'µA ³a·¥\94a.\r
+__¶E½¢.ÑÉ\8d© ( \88á\9f¡ ÒU®\81 -- )\r
+ \88á\9f¡ eÇq \88a\89¡ 10 \95¡ ¶E½¢·a\9d¡ \95¡\93e \88õ·i ÒU®\81 eÇq \96AÎ\89·¡Ðe\94a.\r
+ \90{ i '¶E½¢.ÑÉ\8d©'µA ³a·¥\94a.\r
+\8a\8a\89A ( -- )\r
+ \88á¦\82·¡ »¡\90a\88e ¸aÂá\9fi \8a\8a\89A \8ba\9f¥\94a.\r
+\88a\93i\89A ( -- )\r
+ \88á¦\82·¡ »¡\90a\88e ¸aÂá\9fi \88a\93i\89A \8ba\9f¥\94a.\r
+¦\95\97i´á ( -- )\r
+ \88á¦\82·¡ »¡\90a\88e ¸aÂá\9fi \90q\8b¡»¡ ´g\93e\94a.\r
+¦\95\90\81\9da ( -- )\r
+ \88á¦\82·¡ º\89·i \8ba·a¡a \88e\94a.\r
+ÑÁ¡e»¡¶¡ ( -- )\r
+ \88á¦\82·i ¹A¸a\9f¡\9d¡ ¥¡\90\81\89¡ ÑÁ¡e·i »¡¶\85\94a.\r
+½¡\88\85ÑÁ¡e ( -- )\r
+ \8bi¸a\9fi ´a\9c\81 8 º\89µA e ¥¡·¥\94a.\r
+µ¥ÑÁ¡e ( -- )\r
+ \8bi¸a\9fi ¸åÁA ÑÁ¡eµA ¥¡·¥\94a.\r
+¹A¸a\9f¡\9d¡ ( -- )\r
+ \88á¦\82·\81 á\9f¡\9fi ¶á½¢·a\9d¡ Ð\81¬á ÑÁ¡e \88a¶\85\95A\9d¡ ¥¡\90\81\89¡ ÑÁ¡e·i »¡¶\85\94a.\r
+\95¡.µ¡\9fe½¢ ( \88b\95¡ -- )\r
+ \88á¦\82·\81 ¤wз·i \88b\95¡ eÇq µ¡\9fe½¢·a\9d¡ \95©\9f¥\94a.\r
+\95¡.¶E½¢ ( \88b\95¡ -- )\r
+ \88á¦\82·\81 ¤wз·i \88b\95¡ eÇq ¶E½¢·a\9d¡ \95©\9f¥\94a.\r
+´|·a\9d¡ ( \88á\9f¡ -- )\r
+ \88á¦\82·¡ \88á\9f¡ eÇq ´|·a\9d¡ \88e\94a.\r
+\96á\9d¡ ( \88á\9f¡ -- )\r
+ \88á¦\82·¡ \88á\9f¡ eÇq \96á\9d¡ \88e\94a.\r
+µ¡\9fe½¢.ÑÉ\8d© ( ¤e»¡\9fq \88b\95¡ -- )\r
+ º\81´á»¥ ¤e»¡\9fq\89Á \88b\95¡\9d¡ µ¡\9fe½¢·a\9d¡ ÑÉ\8d©·i \8ba\9f¥\94a.\r
+µ¡\9fe½¢.¶¥ ( ¤e»¡\9fq -- )\r
+ º\81´á»¥ ¤e»¡\9fq·a\9d¡ µ¡\9fe½¢·a\9d¡ \95·\8ba\9ca£¡\9fi \8ba\9f¥\94a.\r
+¶E½¢.ÑÉ\8d© ( ¤e»¡\9fq \88b\95¡ -- )\r
+ º\81´á»¥ ¤e»¡\9fq\89Á \88b\95¡\9d¡ ¶E½¢·a\9d¡ ÑÉ\8d©·i \8ba\9f¥\94a.\r
+¶E½¢.¶¥ ( ¤e»¡\9fq -- )\r
+ º\81´á»¥ ¤e»¡\9fq·a\9d¡ ¶E½¢·a\9d¡ \95·\8ba\9ca£¡\9fi \8ba\9f¥\94a.\r
+\91A¡¡ ( Ça\8b¡ --\r
+ º\81´á»¥ Ça\8b¡·\81 \91A¡¡\9fi \8ba\9f¥\94a.\r
+\89sÃ¥\91A¡¡ ( -- )\r
+ \88b ¥e·\81 \8b©·¡\88a 100, 200, 300, 400 ·¥ \91A¡¡\9fi \89sÁa \8ba\9f¥\94a.\r
+\94a·¡´a¡¥\97a ( -- )\r
+ \94a·¡´a¡¥\97a ¡¡´··i \8ba\9f¥\94a.\r
+\8bµ¤i ( Ça\8b¡ -- )\r
+ \8bµ¤i ¡¡´··i \8ba\9f¥\94a.\r
+µa¬õ\8bµ¤i ( Ça\8b¡ -- )\r
+ 60 \95¡³¢ \95©´a\88a¡a \8bµ¤i 6 \88\81\9fi \8ba\9f¥\94a.\r
+¤a\9cq\88\81§¡ ( -- )\r
+ ¤a\9cq\88\81§¡ ¡¡´··i \8ba\9f¥\94a.\r
+\8d¹·¼ ( Ça\8b¡ -- )\r
+ \8d¹·¼ ¡¡´··i \8ba\9f¥\94a.\r
+\8d¹ ( Ça\8b¡ -- )\r
+ \8d¹·¼ 8 \88\81·¥ \8d¹·i \8ba\9f¥\94a.\r
+\94a\9fe\8d¹·¼ ( Ça\8b¡ -- )\r
+ \94a\9fe ¡¡´··\81 \8d¹·¼·i \8ba\9f¥\94a.\r
+\94a\9fe\8d¹ ( Ça\8b¡ -- )\r
+ \8d¹·¼ 6 \88\81·¥ \8d¹·i \8ba\9f¥\94a.\r
+Ð\95¬i ( Ça\8b¡ -- )\r
+ ¢\89\89i ¡¡´··i \8ba\9f¥\94a.\r
+Ð\81 ( Ça\8b¡ -- )\r
+ Ð\81 ¡¡´··i \8ba\9f¥\94a.\r
+\88bÑw ( Ça\8b¡ ¡¡¬á\9f¡®\81 -- )\r
+ ¸÷\94a\88bÑw·i \8ba\9f¥\94a.\r
+¥i ( ¥e·\81_®\81 ÒU®\81 -- )\r
+ ¥i ¡¡´··i \8ba\9f¥\94a.\r
+\94a\88bÑw ( Ça\8b¡ \88b\95¡ -- )\r
+ Ça\8b¡µÁ \88b\95¡µA \98a\9ca µa\9cá ¡¡´··\81 \94a\88bÑw\89Á ¥i ¡¡´··i \8ba\9f¥\94a.\r
+\94a\88bÑw¸a\9cw5 ( -- )\r
+ \90{ i '\94a\88bÑw'·i ·¡¶wÐe ¸a\9cw\r
+\94a\88bÑw¸a\9cw4 ( -- )\r
+ \90{ i '\94a\88bÑw'·i ·¡¶wÐe \94a\9fe ¸a\9cw\r
+\94a\88bÑw¸a\9cw12 ( -- )\r
+ \90{ i '\94a\88bÑw'·i ·¡¶wÐe \99¡ \94a\9fe ¸a\9cw\r
+\90a¢\81 ( \88a»¡\88b\95¡ \88a»¡\8b©·¡ \88a»¡Ã¡\8b¡®\81 -- )\r
+ ¯a¯a\9d¡\9fi \96A¦\89\9cá¬á (recursive call) \90a¢\81 ¡¡´··i \8ba\9f¥\94a.\r
+§¡\93iÇa\8b¡ ( -- º\81¡ )\r
+ \90{ i '¶w'µA¬á ¬a¶wÐa\93e ¢\81\9fe\88t\r
+¶w ( \90a·¡ -- )\r
+ ¯a¯a\9d¡\9fi \96A¦\89\9cá¬á ¶w\8ba\9f±(dragon curve)·i \8ba\9f¥\94a.\r
updated IF\r
current-block# 1K UM* block-fid REPOSITION-FILE THROW\r
block-buffer 1K block-fid WRITE-FILE THROW\r
- block-fid FLUSH-FILE\r
+ block-fid FLUSH-FILE THROW\r
0 TO updated\r
THEN ;\r
\r
sp0 sp!\r
AGAIN ;\r
\r
-: BYE block-fid FLUSH-FILE BYE ;\r
+: BYE block-fid FLUSH-FILE THROW BYE ;\r
\r
NONSTANDARD-WORDLIST SET-CURRENT\r
\r
\\r
\ by Wonyong Koh\r
\\r
+; 1997. 7. 11.\r
+; Fix D.R . Thank Benjamin Hoyt.\r
\ 1997. 2. 28.\r
\ Facelift to be used with other CPUs.\r
\ 1996. 12. 6.\r
\r
\ D.R ( d n -- ) \ DOUBLE\r
\ Display d right-justified in field of width n.\r
-: D.R >R (d.) R> OVER - 0 MAX SPACES TYPE ;\r
+: D.R >R (d.) R> OVER - SPACES TYPE ;\r
\r
\ .R ( n1 n2 -- ) \ CORE EXT\r
\ Display n right-justified in field of width n2.\r
\\r
\ 1996. 2. 9.\r
\ Wonyong Koh\r
+\\r
+\ 1997. 6. 21\r
+\ Align 'IrptServ' according to new EXE structure.\r
\r
HEX\r
\r
3 CONSTANT IRQ \ normally COM1 and COM3 use IRQ4,\r
\ COM2 and COM4 use IRQ3\r
-2F8 CONSTANT COMBASE \ base address, 3F8 for COM1, 2F8 for COM2\r
+02F8 CONSTANT COMBASE \ base address, 3F8 for COM1, 2F8 for COM2\r
\ 3E8 for COM3, 2E8 for COM4\r
\r
: BINARY 2 BASE ! ;\r
MCR PC@ 11110111 AND MCR PC! ;\r
\r
DECIMAL\r
+\r
1 10 LSHIFT CONSTANT RxBufSize \ receive buffer size = 2 ^ 10 (1024)\r
\ The buffer size should be power of 2.\r
VARIABLE RxBuffer RxBufSize ALLOT\r
VARIABLE RxTail\r
VARIABLE RxOverflow\r
\r
-1 8 LSHIFT CONSTANT TxBufSize \ receive buffer size = 2 ^ 8 (256)\r
+1 8 LSHIFT CONSTANT TxBufSize \ transmit buffer size = 2 ^ 8 (256)\r
\ The buffer size should be power of 2.\r
CREATE TxBuffer TxBufSize CHARS ALLOT\r
VARIABLE #Tx\r
VARIABLE MSR@\r
\r
HEX\r
+\r
: CLEAR-BUFFER\r
DISABLE\r
0 #Rx !\r
CREATE IrptTable\r
' ModemServ , ' TxServ , ' RxServ , ' LineServ ,\r
\r
+HEX\r
+\r
CODE IrptServ\r
STI, \ Enable irpt\r
AX PUSH,\r
CHAR " PARSE model" ENVIRONMENT? DROP\r
CHAR " PARSE RAM Model" COMPARE 0= OR\r
[IF]\r
- DS AX MOV,\r
+ CS AX MOV,\r
AX DS MOV,\r
[THEN]\r
CHAR " PARSE model" ENVIRONMENT? DROP\r
CHAR " PARSE EXE Model" COMPARE 0=\r
[IF]\r
- CS:\r
- 0 ) AX MOV, \ CS:0 contains data segment address\r
+ CS AX MOV,\r
+ 1000 # AX ADD, \ data segment follows after 64KB code segment\r
AX DS MOV,\r
[THEN]\r
IIR # DX MOV, \ identify irpt\r
THEN ;\r
\r
DECIMAL\r
- 9600 BPS NO PARITY 8 BITS 0 STOPBIT\r
+\r
: TERM\r
+ 19200 BPS NO PARITY 8 BITS 0 STOPBIT\r
CLEAR-BUFFER\r
ATTACH-IRPT\r
ENABLE-IRQ\r
SER-OUT\r
THEN\r
AGAIN ;\r
+\r
+CHAR " PARSE FILE" ENVIRONMENT?\r
+[IF]\r
+ 0= [IF] << CON [THEN]\r
+[ELSE] << CON\r
+[THEN]\r
Some bugs are fixed including RESTORE-INPUT.\r
\r
\r
+Changes from 0.9.9\r
+\r
+1997. 6. 30.\r
+ Add TRHOW after FLUSH-FILE in SAVE-BUFFERS and BYE in MSDOS.F.\r
+\r
+1997. 6. 23.\r
+ Fix pack" in HF86ROM.ASM and HF86RAM.ASM.\r
+ Fix SIO.F according to new EXE program structure.\r
+\r
Changes from 0.9.7\r
\r
1997. 5. 26.\r
RESTORE-INPUT·i §¡\9dµÐe ¡y \88a»¡ ¤é\9dA\9fi ¸s´v¯s\93¡\94a.\r
\r
\r
+Changes from 0.9.9\r
+\r
+1997. 6. 30.\r
+ Add TRHOW after FLUSH-FILE in SAVE-BUFFERS and BYE in MSDOS.F.\r
+\r
+1997. 6. 23.\r
+ Fix pack" in HF86ROM.ASM and HF86RAM.ASM.\r
+ Fix SIO.F according to new EXE program structure.\r
+\r
Changes from 0.9.7\r
\r
1997. 5. 26.\r
RESTORE-INPUTÀ» ºñ·ÔÇÑ ¸î °¡Áö ¹ú·¹¸¦ Àâ¾Ò½À´Ï´Ù.\r
\r
\r
+Changes from 0.9.9\r
+\r
+1997. 6. 30.\r
+ Add TRHOW after FLUSH-FILE in SAVE-BUFFERS and BYE in MSDOS.F.\r
+\r
+1997. 6. 23.\r
+ Fix pack" in HF86ROM.ASM and HF86RAM.ASM.\r
+ Fix SIO.F according to new EXE program structure.\r
+\r
Changes from 0.9.7\r
\r
1997. 5. 26.\r
public / hf86v099.git / commitdiff