1 /* yForth? - A Forth interpreter written in ANSI C
2 * Copyright (C) 2012 Luca Padovani
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 * ------------------------------------------------------------------------
27 /**************************************************************************/
28 /* WORDS ******************************************************************/
29 /**************************************************************************/
31 void _dash_trailing() {
32 register Char *s = (Char *) sp[1];
33 register int i = sp[0];
34 while (i-- > 0) if (!isspace(s[i])) break;
38 void _slash_string() {
39 register Cell n = *sp++;
40 sp[1] = (Cell) ((Char *) sp[1] + n);
45 register UCell u = (UCell) *sp++;
46 register Char *s = (Char *) *sp++;
47 if (u) memset(s, ' ', u);
51 register UCell u = (UCell) *sp++;
52 register Char *dest = (Char *) *sp++;
53 register Char *source = (Char *) *sp++;
54 while (u--) *dest++ = *source++;
58 register UCell u = (UCell) *sp++;
59 register Char *dest = (Char *) *sp++ + u;
60 register Char *source = (Char *) *sp++ + u;
61 while (u--) *--dest = *--source;
65 register UCell u2 = (UCell) *sp++;
66 register Char *s2 = (Char *) *sp++;
67 register UCell u1 = (UCell) *sp++;
68 register Char *s1 = (Char *) *sp;
69 register UCell m = u2 <= u1 ? u2 : u1;
71 if (*s1 != *s2) break;
76 if (u1 == u2 && !m) *sp = 0;
77 else if (!m) *sp = u1 < u2 ? -1 : 1;
78 else *sp = *s1 < *s2 ? -1 : 1;
82 register UCell u2 = (UCell) *sp++;
83 register Char *s2 = (Char *) sp[0];
84 register UCell u1 = (UCell) sp[1];
85 register Char *s1 = (Char *) sp[2];
86 if (u2 > u1) *sp = FFLAG(0);
108 register UCell u = (UCell) *sp++;
109 register Char *s = (Char *) *sp++;
110 compile_cell((Cell) _do_literal);
111 compile_cell((Cell) s);
112 compile_cell((Cell) _do_literal);
113 compile_cell((Cell) u);