KOS_qrcodes/programs/develop/SPForth/src/compiler/spf_parser.f

( <EFBFBD> àá¥à áâப¨ á ¨á室­ë¬ ⥪á⮬ ¯à®£à ¬¬ë ­  ”®àâ¥.
  Copyright [C] 1992-1999 A.Cherezov ac@forth.org
  ‘¥­âï¡àì 1999: PARSE ¨ SKIP ¯à¥®¡à §®¢ ­ë ¨§ CODE
  ¢ ¢ë᮪®ã஢­¥¢ë¥ ®¯à¥¤¥«¥­¨ï. <EFBFBD>¥à¥¬¥­­ë¥ ¯à¥®¡à §®¢ ­ë ¢ USER.
)

512  VALUE  C/L \ ¬ ªá¨¬ «ì­ë© à §¬¥à áâப¨, ª®â®àãî ¬®¦­® ¢¢¥á⨠¢ TIB

: SOURCE ( -- c-addr u ) \ 94
\ c-addr -  ¤à¥á ¢å®¤­®£® ¡ãä¥à . u - ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ ­¥¬.
  TIB #TIB @
;

: SOURCE! ( c-addr u -- ) 
\ ãáâ ­®¢¨âì  c-addr u ¢å®¤­ë¬ ¡ãä¥à®¬ (â®ç­¥¥, ®¡« áâìî à §¡®à  - PARSE-AREA)
  #TIB ! TO TIB >IN 0! ;

: EndOfChunk ( -- flag )
  >IN @ SOURCE NIP < 0=        \ >IN ­¥ ¬¥­ìè¥, 祬 ¤«¨­  ç ­ª 
;

: CharAddr ( -- c-addr )
  SOURCE DROP >IN @
\ CR ." CA=" DEPTH .SN
 +
;

: PeekChar ( -- char )
  CharAddr C@       \ ᨬ¢®« ¨§ ⥪ã饣® §­ ç¥­¨ï >IN
;

: IsDelimiter ( char -- flag )
  BL 1+ <
;

: GetChar ( -- char flag )
  EndOfChunk
  IF 0 FALSE
  ELSE PeekChar TRUE THEN
;

: OnDelimiter ( -- flag )
  GetChar SWAP IsDelimiter AND
;

: SkipDelimiters ( -- ) \ ¯à®¯ãáâ¨âì ¯à®¡¥«ì­ë¥ ᨬ¢®«ë
  BEGIN
    OnDelimiter
  WHILE
    >IN 1+!
  REPEAT >IN @  >IN_WORD ! ;

: OnNotDelimiter ( -- flag )
  GetChar SWAP IsDelimiter 0= AND
;

: SkipWord ( -- ) \ ¯à®¯ãáâ¨âì ­¥¯à®¡¥«ì­ë¥ ᨬ¢®«ë
  BEGIN
    OnNotDelimiter
  WHILE
    >IN 1+!
  REPEAT
;
: SkipUpTo ( char -- ) \ ¯à®¯ãáâ¨âì ¤® ᨬ¢®«  char
  BEGIN
    DUP GetChar \ ." SC="  DUP M.
  >R <> R> AND
  WHILE
    >IN 1+!
  REPEAT DROP
;

: ParseWord ( -- c-addr u )
  CharAddr \ CR ." P=" DUP 9 TYPE
 >IN @
\ CR ." XZ=" DEPTH .SN
  SkipWord  >IN @
\ CR ." X1=" DEPTH .SN
 - NEGATE
\ CR ." X2=" DEPTH .SN
\ CR ." PZ=" 2DUP  TYPE
;
CREATE UPPER_SCR  31 ALLOT

: UPC  ( c -- c' )
   DUP [CHAR] Z U>
   IF  0xDF AND
   THEN   ;

: UPPER ( ADDR LEN -- )
  0 ?DO COUNT UPC OVER 1- C! LOOP DROP ;

: UPPER_NW  ( ADDR LEN -- ADDR' LEN )
   UPPER_SCR PLACE 
   UPPER_SCR COUNT 2DUP UPPER ;

: PARSE-WORD  ( "name" -- c-addr u )
 \ http://www.complang.tuwien.ac.at/forth/ansforth/parse-word.html 
 \ íâ® á«®¢® ⥯¥àì ¡ã¤¥¬ ¨á¯®«ì§®¢ âì ¢ INTERPRET
  \ - 㤮¡­¥¥: ­¥ ¨á¯®«ì§ã¥â WORD ¨, ᮮ⢥âá⢥­­®, ­¥ ¬ãá®à¨â ¢ HERE;
  \ ¨ à §¤¥«¨â¥«ï¬¨ áç¨â ¥â ¢á¥ çâ® <=BL, ¢ ⮬ ç¨á«¥ TAB ¨ CRLF
  SkipDelimiters ParseWord
  >IN 1+! \ ¯à®¯ãá⨫¨ à §¤¥«¨â¥«ì §  á«®¢®¬
\  UPPER_V @ EXECUTE
;

: NextWord PARSE-WORD ;
: PARSE-NAME PARSE-WORD ;

: PARSE ( char "ccc<char>" -- c-addr u ) \ 94 CORE EXT
\ ‚뤥«¨âì ccc, ®£à ­¨ç¥­­®¥ ᨬ¢®«®¬ char.
\ c-addr -  ¤à¥á (¢­ãâਠ¢å®¤­®£® ¡ãä¥à ), ¨ u - ¤«¨­  ¢ë¤¥«¥­­®© áâப¨.
\ …᫨ à §¡¨à ¥¬ ï ®¡« áâì ¡ë«  ¯ãáâ , १ã«ìâ¨àãîé ï áâப  ¨¬¥¥â ­ã«¥¢ãî
\ ¤«¨­ã.
  CharAddr >IN @
  ROT SkipUpTo
  >IN @ - NEGATE
  >IN 1+!
;

: PSKIP ( char "ccc<char>" -- )
\ <20>யãáâ¨âì à §¤¥«¨â¥«¨ char.
  BEGIN
    DUP GetChar >R = R> AND
  WHILE
    >IN 1+!
  REPEAT DROP
;