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