Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. ( Žá⠢訥áï á«®¢  "ä®àâ-¯à®æ¥áá®à " ¢ ¢¨¤¥ ¢ë᮪®ã஢­¥¢ëå ®¯à¥¤¥«¥­¨©.
  2.   Copyright [C] 1992-1999 A.Cherezov ac@forth.org
  3.   à¥®¡à §®¢ ­¨¥ ¨§ 16-à §à來®£® ¢ 32-à §àï¤­ë© ª®¤ - 1995-96££
  4.   ¥¢¨§¨ï - ᥭâï¡àì 1999
  5. )
  6.  
  7. 0 CONSTANT FALSE ( -- false ) \ 94 CORE EXT
  8. \ ‚¥à­ãâì ä« £ "«®¦ì".
  9.  
  10. -1 CONSTANT TRUE ( -- true ) \ 94 CORE EXT
  11. \ ‚¥à­ãâì ä« £ "¨á⨭ ", ï祩ªã á® ¢á¥¬¨ ãáâ ­®¢«¥­­ë¬¨ ¡¨â ¬¨.
  12.  
  13. 4 CONSTANT CELL
  14.  
  15. : */ ( n1 n2 n3 -- n4 ) \ 94
  16. \ “¬­®¦¨âì n1 ­  n2, ¯®«ãç¨âì ¯à®¬¥¦ãâ®ç­ë© ¤¢®©­®© १ã«ìâ â d.
  17. \  §¤¥«¨âì d ­  n3, ¯®«ãç¨âì ç áâ­®¥ n4.
  18.   */MOD NIP
  19. ;
  20.  
  21. : CHAR+ ( c-addr1 -- c-addr2 ) \ 94
  22. \ à¨¡ ¢¨âì à §¬¥à ᨬ¢®«  ª c-addr1 ¨ ¯®«ãç¨âì c-addr2.
  23.   1+
  24. ;
  25. : CHARS ( n1 -- n2 ) \ 94
  26. \ n2 - à §¬¥à n1 ᨬ¢®«®¢.
  27. ; IMMEDIATE
  28.  
  29. : MOVE ( addr1 addr2 u -- ) \ 94
  30. \ …᫨ u ¡®«ìè¥ ­ã«ï, ª®¯¨à®¢ âì ᮤ¥à¦¨¬®¥ u ¡ ©â ¨§ addr1 ¢ addr2.
  31. \ ®á«¥ MOVE ¢ u ¡ ©â å ¯®  ¤à¥áã addr2 ᮤ¥à¦¨âáï ¢ â®ç­®á⨠⮠¦¥,
  32. \ çâ® ¡ë«® ¢ u ¡ ©â å ¯®  ¤à¥áã addr1 ¤® ª®¯¨à®¢ ­¨ï.
  33.   >R 2DUP SWAP R@ + U< \ ­ §­ ç¥­¨¥ ¯®¯ ¤ ¥â ¢ ¤¨ ¯ §®­ ¨áâ®ç­¨ª  ¨«¨ «¥¢¥¥
  34.   IF 2DUP U<           \ ˆ … «¥¢¥¥
  35.      IF R> CMOVE> ELSE R> CMOVE THEN
  36.   ELSE R> CMOVE THEN ;
  37.  
  38. : ERASE ( addr u -- ) \ 94 CORE EXT
  39. \ …᫨ u ¡®«ìè¥ ­ã«ï, ®ç¨áâ¨âì ¢á¥ ¡¨âë ª ¦¤®£® ¨§ u ¡ ©â ¯ ¬ïâ¨,
  40. \ ­ ç¨­ ï á  ¤à¥á  addr.
  41.   0 FILL ;
  42.  
  43. : BLANK ( addr len -- )     \ fill addr for len with spaces (blanks)
  44.   BL FILL ;
  45.  
  46. : DABS ( d -- ud ) \ 94 DOUBLE
  47. \ ud  ¡á®«îâ­ ï ¢¥«¨ç¨­  d.
  48.   DUP 0< IF DNEGATE THEN
  49. ;
  50.  
  51. 255 CONSTANT MAXCOUNTED   \ maximum length of contents of a counted string
  52.  
  53. \ : 0X BASE @ HEX >R BL WORD ?LITERAL
  54. \      R> BASE ! ; IMMEDIATE
  55. : "CLIP"        ( a1 n1 -- a1 n1' )   \ clip a string to between 0 and MAXCOUNTED
  56.                MAXCOUNTED AND ;
  57.  
  58. : PLACE         ( addr len dest -- )
  59.                SWAP "CLIP" SWAP
  60. 2DUP C! CHAR+ SWAP CHARS MOVE ;
  61.  
  62. : +PLACE        ( addr len dest -- ) \ append string addr,len to counted
  63. \ string dest
  64.    >R "CLIP" MAXCOUNTED  R@ C@ -  MIN R>
  65. \ clip total to MAXCOUNTED string
  66.    2DUP 2>R
  67.  
  68.    COUNT CHARS + SWAP MOVE
  69.    2R> +! ;
  70.  
  71. : C+PLACE       ( c1 a1 -- )    \ append char c1 to the counted string at a1
  72.                DUP 1+! COUNT + 1- C! ;
  73.  
  74. : STR>R ( addr u -- addr1 u)
  75. \ ®«®¦¨âì áâபã addr u ­  á⥪ ¢®§¢à â®¢
  76. \ ‚®§¢à â¨âì addr1  ¤à¥á ­®¢®© áâப¨
  77. ;
  78.  
  79. 0  VALUE  DOES-CODE
  80.  
  81. : $!         ( addr len dest -- )
  82.   PLACE ;
  83.  
  84. : ASCII-Z     ( addr len buff -- buff-z )        \ make an ascii string
  85.   DUP >R $! R> COUNT OVER + 0 SWAP C! ;
  86.  
  87. : 0MAX 0 MAX ;
  88.  
  89. : ASCIIZ>  ZCOUNT ;
  90.  
  91. : R>     ['] C-R>    INLINE, ;   IMMEDIATE
  92. : >R     ['] C->R    INLINE, ;   IMMEDIATE
  93.  
  94. : 2CONSTANT  ( d --- )
  95. \ Create a new definition that has the following runtime behavior.
  96. \ Runtime: ( --- d) push the constant double number on the stack.
  97.  CREATE HERE 2! 8 ALLOT DOES> 2@ ;
  98.  
  99. : U/MOD 0 SWAP UM/MOD ;
  100.  
  101. : 2NIP 2SWAP 2DROP ;
  102.  
  103. : ON TRUE SWAP ! ;
  104. : OFF ( a--) 0! ;
  105.