Annotation of gforth/quotes.fs, revision 1.14
1.1 anton 1: \ quote: S\" and .\" words
2:
1.13 anton 3: \ Copyright (C) 2002,2003,2005,2007 Free Software Foundation, Inc.
1.1 anton 4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
1.14 ! anton 9: \ as published by the Free Software Foundation, either version 3
1.1 anton 10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
1.14 ! anton 18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1 anton 19:
20: : char/ ; immediate
21:
1.11 anton 22: : parse-num-x ( c-addr1 umax -- c-addr2 c )
23: >r 0. rot source chars + over - char/ r> umin >number
1.1 anton 24: drop rot rot drop ;
25:
1.11 anton 26: : parse-num ( c-addr1 umax base -- c-addr2 c )
27: ['] parse-num-x swap base-execute ;
1.1 anton 28:
29: create \-escape-table
1.11 anton 30: 7 c, #bs c, 'c c, 'd c, #esc c, #ff c, 'g c,
31: 'h c, 'i c, 'j c, 'k c, #lf c, #lf c, #lf c,
32: 'o c, 'p c, '" c, #cr c, 's c, #tab c, 'u c,
33: 11 c, 'w c, 'x c, 'y c, 0 c,
1.1 anton 34:
35: : \-escape ( c-addr1 -- c-addr2 c )
36: \ c-addr1 points at a char right after a '\', c-addr2 points right
37: \ after the whole sequence, c is the translated char
1.2 anton 38: dup c@
1.11 anton 39: dup 'x = if
40: drop char+ 2 16 parse-num exit
1.1 anton 41: endif
1.11 anton 42: dup '0 '8 within if
43: drop 3 8 parse-num exit
1.1 anton 44: endif
1.11 anton 45: dup 'n = if
1.2 anton 46: \ \-escapes were designed to translate to one character, so
47: \ this is quite ugly: copy all but the last char right away
48: drop newline 1-
49: 2dup here swap chars dup allot move
50: chars + c@
51: else
1.11 anton 52: dup 'm = if \ crlf; ugly, because it's two characters
53: #cr c, \ first half, the rest follows below
54: endif
55: dup 'a '{ within if
56: 'a - chars \-escape-table + c@
1.2 anton 57: endif
1.1 anton 58: endif
59: 1 chars under+ ;
60:
1.11 anton 61: : \"-parse ( "string"<"> -- c-addr u ) \ gforth-internal backslash-quote-parse
1.1 anton 62: \G parses string, translating @code{\}-escapes to characters (as in
1.11 anton 63: \G C). The resulting string resides at @code{here}. See @code{S\"}
64: \G for the supported @code{\-escapes}.
1.6 anton 65: here >r
1.1 anton 66: >in @ chars source chars over + >r + begin ( parse-area R: here parse-end )
67: dup r@ < while
1.11 anton 68: dup c@ '" <> while
69: dup c@ dup '\ = if ( parse-area c R: here parse-end )
1.1 anton 70: drop char+ dup r@ = abort" unfinished \-escape"
71: \-escape c,
72: else
73: c, char+
74: endif
75: repeat then
76: char+ source >r - r> min char/ >in !
77: r> drop
78: here r> - dup negate allot
1.6 anton 79: here swap char/ ;
1.1 anton 80:
81: :noname \"-parse save-mem ;
1.6 anton 82: :noname \"-parse save-mem 2dup postpone sliteral drop free throw ;
1.1 anton 83: interpret/compile: s\" ( compilation 'ccc"' -- ; run-time -- c-addr u ) \ gforth s-backslash-quote
1.11 anton 84: \G Like @code{S"}, but translates C-like \-escape-sequences, as
85: \G follows: @code{\a} BEL (alert), @code{\b} BS, @code{\e} ESC (not in
86: \G C99), @code{\f} FF, @code{\n} newline, @code{\r} CR, @code{\t} HT,
1.12 anton 87: \G @code{\v} VT, @code{\"} ", @code{\\} \, @code{\}[0-7]@{1,3@} octal
88: \G numerical character value (non-standard), @code{\x}[0-9a-f]@{0,2@}
1.11 anton 89: \G hex numerical character value (standard only with two digits); a
90: \G @code{\} before any other character is reserved.
1.1 anton 91:
92: :noname \"-parse type ;
1.6 anton 93: :noname postpone s\" postpone type ;
1.1 anton 94: interpret/compile: .\" ( compilation 'ccc"' -- ; run-time -- ) \ gforth dot-backslash-quote
1.11 anton 95: \G Like @code{."}, but translates C-like \-escape-sequences (see
96: \G @code{S\"}).
1.1 anton 97:
1.3 anton 98: 0 [if] \ test
1.1 anton 99: s" 123" drop 10 parse-num-x 123 <> throw drop .s
100: s" 123a" drop 10 parse-num 123 <> throw drop .s
101: s" x1fg" drop \-escape 31 <> throw drop .s
102: s" 00129" drop \-escape 10 <> throw drop .s
103: s" a" drop \-escape 7 <> throw drop .s
1.5 anton 104: \"-parse " s" " str= 0= throw .s
1.1 anton 105: \"-parse \a\b\c\e\f\n\r\t\v\100\x40xabcde" dump
1.7 anton 106: s\" \a\bcd\e\fghijklm\12op\"\rs\tu\v" \-escape-table over str= 0= throw
1.5 anton 107: s\" \w\0101\x041\"\\" name wAA"\ str= 0= throw
1.1 anton 108: s\" s\\\" \\" ' evaluate catch 0= throw
109: [endif]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>