kolibrios/programs/develop/SPForth/src/spf_forthproc_hl.f

( <20><>⠢訥<EFBFBD><EFBFBD> ᫮<EFBFBD><EFBFBD> "<22><><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>" <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>᮪<EFBFBD><EFBFBD>஢<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
  Copyright [C] 1992-1999 A.Cherezov ac@forth.org
  <20>८<EFBFBD>ࠧ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> 16-ࠧ<EFBFBD>來<EFBFBD><EFBFBD><EFBFBD> <EFBFBD> 32-ࠧ<EFBFBD>來<EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> - 1995-96<EFBFBD><EFBFBD>
  <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - ᥭ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 1999
)

0 CONSTANT FALSE ( -- false ) \ 94 CORE EXT
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 䫠<EFBFBD> "<22><><EFBFBD><EFBFBD>".

-1 CONSTANT TRUE ( -- true ) \ 94 CORE EXT
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 䫠<EFBFBD> "<22><>⨭<EFBFBD>", <EFBFBD>祩<EFBFBD><EFBFBD> <EFBFBD><EFBFBD> <EFBFBD>ᥬ<EFBFBD> <EFBFBD><EFBFBD>⠭<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>묨 <EFBFBD><EFBFBD>⠬<EFBFBD>.

4 CONSTANT CELL

: */ ( n1 n2 n3 -- n4 ) \ 94
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> n1 <EFBFBD><EFBFBD> n2, <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>஬<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> १<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> d.
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> d <EFBFBD><EFBFBD> n3, <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD>⭮<EFBFBD> n4.
  */MOD NIP
;

: CHAR+ ( c-addr1 -- c-addr2 ) \ 94
\ <20>ਡ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ࠧ<EFBFBD><EFBFBD><EFBFBD> ᨬ<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD> c-addr1 <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> c-addr2.
  1+
;
: CHARS ( n1 -- n2 ) \ 94
\ n2 - ࠧ<EFBFBD><EFBFBD><EFBFBD> n1 ᨬ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
; IMMEDIATE

: MOVE ( addr1 addr2 u -- ) \ 94
\ <20>᫨ u <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <EFBFBD><EFBFBD><EFBFBD><EFBFBD>஢<EFBFBD><EFBFBD><EFBFBD> ᮤ<EFBFBD>ন<EFBFBD><EFBFBD><EFBFBD> u <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> addr1 <EFBFBD> addr2.
\ <20><>᫥ MOVE <EFBFBD> u <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> addr2 ᮤ<EFBFBD>ন<EFBFBD><EFBFBD><EFBFBD> <EFBFBD> <EFBFBD><EFBFBD>筮<EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> <EFBFBD><EFBFBD>,
\ <20><><EFBFBD> <EFBFBD>뫮 <EFBFBD> u <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> addr1 <EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD>஢<EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
  >R 2DUP SWAP R@ + U< \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>祭<EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD>筨<EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  IF 2DUP U<           \ <EFBFBD> <EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
     IF R> CMOVE> ELSE R> CMOVE THEN
  ELSE R> CMOVE THEN ;

: ERASE ( addr u -- ) \ 94 CORE EXT
\ <20>᫨ u <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> u <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,
\ <20><>稭<EFBFBD><EFBFBD> <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> addr.
  0 FILL ;

: BLANK ( addr len -- )     \ fill addr for len with spaces (blanks)
  BL FILL ;

: DABS ( d -- ud ) \ 94 DOUBLE
\ ud <EFBFBD><EFBFBD>᮫<EFBFBD>⭠<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD>稭<EFBFBD> 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><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>ப<EFBFBD> addr u <EFBFBD><EFBFBD> <EFBFBD>⥪ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>⮢
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> addr1 <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>ப<EFBFBD>
;

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! ;