105 lines
2.9 KiB
Forth
105 lines
2.9 KiB
Forth
( Žá⠢訥áï á«®¢ "ä®àâ-¯à®æ¥áá®à " ¢ ¢¨¤¥ ¢ë᮪®ã஢¥¢ëå ®¯à¥¤¥«¥¨©.
|
||
Copyright [C] 1992-1999 A.Cherezov ac@forth.org
|
||
<EFBFBD>८¡à §®¢ ¨¥ ¨§ 16-à §à冷£® ¢ 32-à §àï¤ë© ª®¤ - 1995-96££
|
||
<EFBFBD>¥¢¨§¨ï - á¥âï¡àì 1999
|
||
)
|
||
|
||
0 CONSTANT FALSE ( -- false ) \ 94 CORE EXT
|
||
\ ‚¥àãâì ä« £ "«®¦ì".
|
||
|
||
-1 CONSTANT TRUE ( -- true ) \ 94 CORE EXT
|
||
\ ‚¥àãâì ä« £ "¨á⨠", ï祩ªã á® ¢á¥¬¨ ãáâ ®¢«¥ë¬¨ ¡¨â ¬¨.
|
||
|
||
4 CONSTANT CELL
|
||
|
||
: */ ( n1 n2 n3 -- n4 ) \ 94
|
||
\ “¬®¦¨âì n1 n2, ¯®«ãç¨âì ¯à®¬¥¦ãâ®çë© ¤¢®©®© १ã«ìâ â d.
|
||
\ <20> §¤¥«¨âì d n3, ¯®«ãç¨âì ç á⮥ n4.
|
||
*/MOD NIP
|
||
;
|
||
|
||
: CHAR+ ( c-addr1 -- c-addr2 ) \ 94
|
||
\ <20>ਡ ¢¨âì à §¬¥à ᨬ¢®« ª c-addr1 ¨ ¯®«ãç¨âì c-addr2.
|
||
1+
|
||
;
|
||
: CHARS ( n1 -- n2 ) \ 94
|
||
\ n2 - à §¬¥à n1 ᨬ¢®«®¢.
|
||
; IMMEDIATE
|
||
|
||
: MOVE ( addr1 addr2 u -- ) \ 94
|
||
\ …᫨ u ¡®«ìè¥ ã«ï, ª®¯¨à®¢ âì ᮤ¥à¦¨¬®¥ u ¡ ©â ¨§ addr1 ¢ addr2.
|
||
\ <20>®á«¥ MOVE ¢ u ¡ ©â å ¯® ¤à¥áã addr2 ᮤ¥à¦¨âáï ¢ â®ç®á⨠⮠¦¥,
|
||
\ çâ® ¡ë«® ¢ u ¡ ©â å ¯® ¤à¥áã addr1 ¤® ª®¯¨à®¢ ¨ï.
|
||
>R 2DUP SWAP R@ + U< \ § 票¥ ¯®¯ ¤ ¥â ¢ ¤¨ ¯ §® ¨áâ®ç¨ª ¨«¨ «¥¢¥¥
|
||
IF 2DUP U< \ ˆ <20>… «¥¢¥¥
|
||
IF R> CMOVE> ELSE R> CMOVE THEN
|
||
ELSE R> CMOVE THEN ;
|
||
|
||
: ERASE ( addr u -- ) \ 94 CORE EXT
|
||
\ …᫨ u ¡®«ìè¥ ã«ï, ®ç¨áâ¨âì ¢á¥ ¡¨âë ª ¦¤®£® ¨§ u ¡ ©â ¯ ¬ïâ¨,
|
||
\ ç¨ ï á ¤à¥á addr.
|
||
0 FILL ;
|
||
|
||
: BLANK ( addr len -- ) \ fill addr for len with spaces (blanks)
|
||
BL FILL ;
|
||
|
||
: DABS ( d -- ud ) \ 94 DOUBLE
|
||
\ ud ¡á®«îâ ï ¢¥«¨ç¨ d.
|
||
DUP 0< IF DNEGATE THEN
|
||
;
|
||
|
||
255 CONSTANT MAXCOUNTED \ maximum length of contents of a counted string
|
||
|
||
\ : 0X BASE @ HEX >R BL WORD ?LITERAL
|
||
\ R> BASE ! ; IMMEDIATE
|
||
: "CLIP" ( a1 n1 -- a1 n1' ) \ clip a string to between 0 and MAXCOUNTED
|
||
MAXCOUNTED AND ;
|
||
|
||
: PLACE ( addr len dest -- )
|
||
SWAP "CLIP" SWAP
|
||
2DUP C! CHAR+ SWAP CHARS MOVE ;
|
||
|
||
: +PLACE ( addr len dest -- ) \ append string addr,len to counted
|
||
\ string dest
|
||
>R "CLIP" MAXCOUNTED R@ C@ - MIN R>
|
||
\ clip total to MAXCOUNTED string
|
||
2DUP 2>R
|
||
|
||
COUNT CHARS + SWAP MOVE
|
||
2R> +! ;
|
||
|
||
: C+PLACE ( c1 a1 -- ) \ append char c1 to the counted string at a1
|
||
DUP 1+! COUNT + 1- C! ;
|
||
|
||
: STR>R ( addr u -- addr1 u)
|
||
\ <20>®«®¦¨âì áâபã addr u á⥪ ¢®§¢à ⮢
|
||
\ ‚®§¢à â¨âì addr1 ¤à¥á ®¢®© áâப¨
|
||
;
|
||
|
||
0 VALUE DOES-CODE
|
||
|
||
: $! ( addr len dest -- )
|
||
PLACE ;
|
||
|
||
: ASCII-Z ( addr len buff -- buff-z ) \ make an ascii string
|
||
DUP >R $! R> COUNT OVER + 0 SWAP C! ;
|
||
|
||
: 0MAX 0 MAX ;
|
||
|
||
: ASCIIZ> ZCOUNT ;
|
||
|
||
: R> ['] C-R> INLINE, ; IMMEDIATE
|
||
: >R ['] C->R INLINE, ; IMMEDIATE
|
||
|
||
: 2CONSTANT ( d --- )
|
||
\ Create a new definition that has the following runtime behavior.
|
||
\ Runtime: ( --- d) push the constant double number on the stack.
|
||
CREATE HERE 2! 8 ALLOT DOES> 2@ ;
|
||
|
||
: U/MOD 0 SWAP UM/MOD ;
|
||
|
||
: 2NIP 2SWAP 2DROP ;
|
||
|
||
: ON TRUE SWAP ! ;
|
||
: OFF ( a--) 0! ;
|