version 1.1, 1994/05/07 14:55:57
|
version 1.11, 2007/12/31 19:02:24
|
Line 1
|
Line 1
|
\ Copyright 1990 Martin Anton Ertl |
|
\ |
|
\ TERMS AND CONDITIONS FOR USE, COPYING, MODIFICATION AND DISTRIBUTION |
|
\ |
|
\ 1. You may use this product provided that |
|
\ a) you DO NOT USE IT FOR MILITARY PURPOSES; and |
|
\ b) cause the terms of parapraph 1 to apply to any products |
|
\ developed using this product and make these terms known to all |
|
\ users of such product; |
|
\ By using this product, you indicate the acceptance of the terms of |
|
\ this paragraph. |
|
\ |
|
\ 2. Except for the restrictions mentioned in paragraph 1, you may use |
|
\ the Program. |
|
\ |
|
\ 3. You may distribute verbatim or modified copies of this program, |
|
\ provided that |
|
\ a) you keep intact all copyright notices, this license, and the notices |
|
\ referring to this license and to the absence of warranty; and |
|
\ b) you cause any work that you distribute or publish that contains the |
|
\ Program or part of it to be licensed to all third parties under the |
|
\ terms of this license. You may not impose any further restriction |
|
\ on the recipients exercise of the rights granted herein. Mere |
|
\ aggregation of another independent work with the Program or its |
|
\ derivative on a volume of storage or distribution medium does not |
|
\ bring the other work under the scope of these terms; and |
|
\ c) you cause the derivative to carry prominent notices saying that |
|
\ you changed the Program. |
|
\ |
|
\ 4. You may distribute the Program or its derivative in intermediate, |
|
\ object or executable code, if you accompany it with the complete |
|
\ machine-readable source code. |
|
\ |
|
\ 5. By using, modifying, copying or distributing the Program you |
|
\ indicate your acceptance of this license and all its terms and |
|
\ conditions. |
|
\ |
|
\ 6. This Program is provided WITHOUT WARRANTY of any kind, either |
|
\ express or implied, including, but not limited to, the implied |
|
\ warranties of merchantability and fitness for a particular purpose. In |
|
\ no event, unless required by applicable law or agreed to in writing, |
|
\ will any copyright holder, or any other party who may modify and or |
|
\ redistribute the Program, be liable to you for any damages, even if |
|
\ such holder or other party has been advised of the possibility of such |
|
\ damages. |
|
\ END OF TERMS AND CONDITIONS ) |
|
|
|
\ recursive descent parser generator ) |
\ recursive descent parser generator ) |
|
|
.( Loading Gray ... Copyright 1990 Martin Anton Ertl; NO WARRANTY ) cr |
\ Copyright (C) 1995,1996,1997,2000,2003,2007 Free Software Foundation, Inc. |
|
\ Copyright 1990, 1991, 1994 Martin Anton Ertl |
|
|
|
\ This file is part of Gforth. |
|
|
|
\ Gforth is free software; you can redistribute it and/or |
|
\ modify it under the terms of the GNU General Public License |
|
\ as published by the Free Software Foundation, either version 3 |
|
\ of the License, or (at your option) any later version. |
|
|
|
\ This program is distributed in the hope that it will be useful, |
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
\ GNU General Public License for more details. |
|
|
|
\ You should have received a copy of the GNU General Public License |
|
\ along with this program. If not, see http://www.gnu.org/licenses/. |
|
|
|
\ ANS FORTH prologue |
|
|
|
: defined? ( "word" -- flag ) bl word find nip ; |
|
defined? WARNINGS 0= |
|
[IF] |
|
Variable warnings |
|
warnings on |
|
[THEN] |
|
|
|
\ end of ANS FORTH prolog |
|
|
|
warnings @ [IF] |
|
.( Loading Gray ... Copyright 1990-1994 Martin Anton Ertl; NO WARRANTY ) cr |
|
[THEN] |
|
|
\ misc ) |
\ misc ) |
: noop ; |
: noop ; |
|
|
1 cells constant cell |
1 cells constant cell |
cell 8 * constant bits/cell \ !! implementation dependent ) |
s" address-unit-bits" environment? 0= |
|
[IF] |
|
warnings @ [IF] |
|
cr .( environmental attribute address-units-bits unknown, computing... ) cr |
|
[THEN] |
|
\ if your machine has more bits/au, this assumption wastes space |
|
\ if your machine has fewer bits/au, gray will not work |
|
: (bits/cell) ( -- n ) 1 0 invert dup 1 rshift xor |
|
BEGIN dup 1 = 0= WHILE 1 rshift swap 1+ swap REPEAT drop ; |
|
(bits/cell) |
|
warnings @ [IF] |
|
.( You seem to have ) dup 1 cells / . .( bits/address unit) cr |
|
[THEN] |
|
[ELSE] |
|
cells |
|
[THEN] |
|
constant bits/cell \ !! implementation dependent ) |
|
|
: ?not? ( f -- f ) |
: ?not? ( f -- f ) |
0= ; |
postpone 0= ; immediate |
|
|
: 2, ( w1 w2 -- ) |
: 2, ( w1 w2 -- ) |
here 2 cells allot 2! ; |
here 2 cells allot 2! ; |
Line 136 variable empty-ptr 0 empty-ptr ! \ updat
|
Line 136 variable empty-ptr 0 empty-ptr ! \ updat
|
bits/cell /mod |
bits/cell /mod |
cells rot + |
cells rot + |
swap ; |
swap ; |
|
\ the /mod could be optimized into a RSHIFT and an AND, if bits/cell is |
|
\ a power of 2, but in an interpreted implementation this would only be |
|
\ faster if the machine has very slow division and in a native code |
|
\ implementation the compiler should be intelligent enough to optimize |
|
\ without help. |
|
|
: add-member \ u set -- ) |
: add-member \ u set -- ) |
\ changes set to include u ) |
\ changes set to include u ) |
Line 278 struct
|
Line 283 struct
|
\ true if the syntax-expr can derive eps ) |
\ true if the syntax-expr can derive eps ) |
aligned cell context-var follow-set |
aligned cell context-var follow-set |
\ the tokens of the terminals that can follow the syntax-expr ) |
\ the tokens of the terminals that can follow the syntax-expr ) |
|
s" gforth" environment? |
|
[IF] 2drop \ clear gforth's version numbers ) |
aligned 2 cells context-var source-location \ for error msgs ) |
aligned 2 cells context-var source-location \ for error msgs ) |
constant syntax-expr \ length of a syntax-expr ) |
[ELSE] |
|
s" bigFORTH" environment? |
|
[IF] 2drop \ clear bigFORTH' version numbers ) |
|
aligned cell context-var source-location |
|
\ for error msgs |
|
[ELSE] |
|
\ !! replace the stuff until constant with something working on your system |
|
aligned 3 cells context-var source-location |
|
\ for error msgs |
|
80 chars context-var error-info |
|
\ string |
|
[THEN] [THEN] |
|
aligned constant syntax-expr \ length of a syntax-expr ) |
|
|
: make-syntax-expr \ map -- syntax-expr ) |
: make-syntax-expr \ map -- syntax-expr ) |
\ allocate a syntax-expr and initialize it ) |
\ allocate a syntax-expr and initialize it ) |
here swap , false c, false c, |
here swap , false c, false c, |
align 0 , false c, align empty , |
align 0 , false c, align empty , |
\ source location !! implementation dependent ) |
\ source location. !! replace the stuff until `;' with your stuff |
\ if you use blocks, use: |
\ if you use blocks, use: |
\ blk @ >in @ 2, |
\ blk @ >in @ 2, |
\ the following is just a dummy |
\ the following is just a dummy |
0 loadline @ 2, |
[ s" gforth" environment? ] |
|
[IF] [ 2drop ] |
|
0 sourceline# 2, |
|
[ELSE] |
|
[ s" bigFORTH" environment? ] |
|
[IF] [ 2drop ] |
|
makeview w, >in @ w, |
|
[ELSE] |
|
source 80 min >r here 3 cells + r@ cmove |
|
here 3 cells + , r@ , >in @ 80 min , r> chars allot align |
|
[THEN] [THEN] |
; |
; |
|
|
|
|
Line 298 constant syntax-expr \ length of a syn
|
Line 327 constant syntax-expr \ length of a syn
|
\ !! implementation dependent ) |
\ !! implementation dependent ) |
\ prints the info stored in source-location in a usable way ) |
\ prints the info stored in source-location in a usable way ) |
\ prints where the error happened ) |
\ prints where the error happened ) |
|
[ s" gforth" environment? ] |
|
[IF] [ 2drop ] |
source-location 2@ ." line" . drop ." :" ; |
source-location 2@ ." line" . drop ." :" ; |
|
[ELSE] |
|
[ s" bigFORTH" environment? ] |
|
[IF] [ 2drop ] |
|
source-location dup w@ $3FF and scr ! 2+ w@ r# ! ; |
|
[ELSE] |
|
source-location 2@ swap cr type cr |
|
error-info @ 2 - spaces ." ^" cr ." ::: " ; |
|
[THEN] [THEN] |
|
|
: gray-error abort ; |
: gray-error abort ; |
|
|
Line 311 variable print-token ' . print-token !
|
Line 349 variable print-token ' . print-token !
|
|
|
: check-conflict \ set1 set2 -- ) |
: check-conflict \ set1 set2 -- ) |
\ print the intersection of set1 and set2 if it isn't empty ) |
\ print the intersection of set1 and set2 if it isn't empty ) |
2dup disjoint? ?not? if |
2dup disjoint? ?not? warnings @ and if |
cr .in ." conflict:" |
cr .in ." conflict:" |
intersection print-token @ apply-to-members |
intersection print-token @ apply-to-members |
else |
else |
Line 498 create concatenation-map
|
Line 536 create concatenation-map
|
: compute-alternative \ -- first maybe-empty ) |
: compute-alternative \ -- first maybe-empty ) |
operand1 compute |
operand1 compute |
operand2 compute |
operand2 compute |
rot 2dup and if |
rot 2dup and warnings @ and if |
cr .in ." warning: two branches may be empty" endif |
cr .in ." warning: two branches may be empty" endif |
or >r union r> ; |
or >r union r> ; |
|
|
Line 570 constant unary-syntax-expr
|
Line 608 constant unary-syntax-expr
|
|
|
\ options ) |
\ options ) |
: compute-option \ -- set f ) |
: compute-option \ -- set f ) |
operand compute if |
operand compute warnings @ and if |
cr .in ." warning: unnessesary option" endif |
cr .in ." warning: unnessesary option" endif |
true ; |
true ; |
|
|
Line 600 create option-map
|
Line 638 create option-map
|
|
|
\ *-repetitions ) |
\ *-repetitions ) |
: compute-*repetition \ -- set f ) |
: compute-*repetition \ -- set f ) |
operand compute if |
operand compute warnings @ and if |
cr .in ." warning: *repetition of optional term" endif |
cr .in ." warning: *repetition of optional term" endif |
true ; |
true ; |
|
|