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.   ‘¥­âï¡àì 1999: PARSE ¨ SKIP ¯à¥®¡à §®¢ ­ë ¨§ CODE
  4.   ¢ ¢ë᮪®ã஢­¥¢ë¥ ®¯à¥¤¥«¥­¨ï. ¥à¥¬¥­­ë¥ ¯à¥®¡à §®¢ ­ë ¢ USER.
  5. )
  6.  
  7. 512  VALUE  C/L \ ¬ ªá¨¬ «ì­ë© à §¬¥à áâப¨, ª®â®àãî ¬®¦­® ¢¢¥á⨠¢ TIB
  8.  
  9. : SOURCE ( -- c-addr u ) \ 94
  10. \ c-addr -  ¤à¥á ¢å®¤­®£® ¡ãä¥à . u - ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ ­¥¬.
  11.   TIB #TIB @
  12. ;
  13.  
  14. : SOURCE! ( c-addr u -- )
  15. \ ãáâ ­®¢¨âì  c-addr u ¢å®¤­ë¬ ¡ãä¥à®¬ (â®ç­¥¥, ®¡« áâìî à §¡®à  - PARSE-AREA)
  16.   #TIB ! TO TIB >IN 0! ;
  17.  
  18. : EndOfChunk ( -- flag )
  19.   >IN @ SOURCE NIP < 0=        \ >IN ­¥ ¬¥­ìè¥, 祬 ¤«¨­  ç ­ª 
  20. ;
  21.  
  22. : CharAddr ( -- c-addr )
  23.   SOURCE DROP >IN @
  24. \ CR ." CA=" DEPTH .SN
  25.  +
  26. ;
  27.  
  28. : PeekChar ( -- char )
  29.   CharAddr C@       \ ᨬ¢®« ¨§ ⥪ã饣® §­ ç¥­¨ï >IN
  30. ;
  31.  
  32. : IsDelimiter ( char -- flag )
  33.   BL 1+ <
  34. ;
  35.  
  36. : GetChar ( -- char flag )
  37.   EndOfChunk
  38.   IF 0 FALSE
  39.   ELSE PeekChar TRUE THEN
  40. ;
  41.  
  42. : OnDelimiter ( -- flag )
  43.   GetChar SWAP IsDelimiter AND
  44. ;
  45.  
  46. : SkipDelimiters ( -- ) \ ¯à®¯ãáâ¨âì ¯à®¡¥«ì­ë¥ ᨬ¢®«ë
  47.   BEGIN
  48.     OnDelimiter
  49.   WHILE
  50.     >IN 1+!
  51.   REPEAT >IN @  >IN_WORD ! ;
  52.  
  53. : OnNotDelimiter ( -- flag )
  54.   GetChar SWAP IsDelimiter 0= AND
  55. ;
  56.  
  57. : SkipWord ( -- ) \ ¯à®¯ãáâ¨âì ­¥¯à®¡¥«ì­ë¥ ᨬ¢®«ë
  58.   BEGIN
  59.     OnNotDelimiter
  60.   WHILE
  61.     >IN 1+!
  62.   REPEAT
  63. ;
  64. : SkipUpTo ( char -- ) \ ¯à®¯ãáâ¨âì ¤® ᨬ¢®«  char
  65.   BEGIN
  66.     DUP GetChar \ ." SC="  DUP M.
  67.   >R <> R> AND
  68.   WHILE
  69.     >IN 1+!
  70.   REPEAT DROP
  71. ;
  72.  
  73. : ParseWord ( -- c-addr u )
  74.   CharAddr \ CR ." P=" DUP 9 TYPE
  75.  >IN @
  76. \ CR ." XZ=" DEPTH .SN
  77.   SkipWord  >IN @
  78. \ CR ." X1=" DEPTH .SN
  79.  - NEGATE
  80. \ CR ." X2=" DEPTH .SN
  81. \ CR ." PZ=" 2DUP  TYPE
  82. ;
  83. CREATE UPPER_SCR  31 ALLOT
  84.  
  85. : UPC  ( c -- c' )
  86.   DUP [CHAR] Z U>
  87.   IF  0xDF AND
  88.   THEN   ;
  89.  
  90. : UPPER ( ADDR LEN -- )
  91.  0 ?DO COUNT UPC OVER 1- C! LOOP DROP ;
  92.  
  93. : UPPER_NW  ( ADDR LEN -- ADDR' LEN )
  94.    UPPER_SCR PLACE
  95.    UPPER_SCR COUNT 2DUP UPPER ;
  96.  
  97. : PARSE-WORD  ( "name" -- c-addr u )
  98.  \ http://www.complang.tuwien.ac.at/forth/ansforth/parse-word.html
  99.  \ íâ® á«®¢® ⥯¥àì ¡ã¤¥¬ ¨á¯®«ì§®¢ âì ¢ INTERPRET
  100.   \ - 㤮¡­¥¥: ­¥ ¨á¯®«ì§ã¥â WORD ¨, ᮮ⢥âá⢥­­®, ­¥ ¬ãá®à¨â ¢ HERE;
  101.   \ ¨ à §¤¥«¨â¥«ï¬¨ áç¨â ¥â ¢á¥ çâ® <=BL, ¢ ⮬ ç¨á«¥ TAB ¨ CRLF
  102.   SkipDelimiters ParseWord
  103.   >IN 1+! \ ¯à®¯ãá⨫¨ à §¤¥«¨â¥«ì §  á«®¢®¬
  104. \  UPPER_V @ EXECUTE
  105. ;
  106.  
  107. : NextWord PARSE-WORD ;
  108. : PARSE-NAME PARSE-WORD ;
  109.  
  110. : PARSE ( char "ccc<char>" -- c-addr u ) \ 94 CORE EXT
  111. \ ‚뤥«¨âì ccc, ®£à ­¨ç¥­­®¥ ᨬ¢®«®¬ char.
  112. \ c-addr -  ¤à¥á (¢­ãâਠ¢å®¤­®£® ¡ãä¥à ), ¨ u - ¤«¨­  ¢ë¤¥«¥­­®© áâப¨.
  113. \ …᫨ à §¡¨à ¥¬ ï ®¡« áâì ¡ë«  ¯ãáâ , १ã«ìâ¨àãîé ï áâப  ¨¬¥¥â ­ã«¥¢ãî
  114. \ ¤«¨­ã.
  115.   CharAddr >IN @
  116.   ROT SkipUpTo
  117.   >IN @ - NEGATE
  118.   >IN 1+!
  119. ;
  120.  
  121. : PSKIP ( char "ccc<char>" -- )
  122. \ à®¯ãáâ¨âì à §¤¥«¨â¥«¨ char.
  123.   BEGIN
  124.     DUP GetChar >R = R> AND
  125.   WHILE
  126.     >IN 1+!
  127.   REPEAT DROP
  128. ;
  129.