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 * ------------------------------------------------------------------------
17 * Module name: double.c
18 * Abstract: double-number word set
26 /**************************************************************************/
27 /* WORDS ******************************************************************/
28 /**************************************************************************/
30 void _two_constant() {
31 register DCell d = GET_DCELL(sp);
33 create_definition(A_2CONSTANT);
34 compile_cell((Cell) d);
35 compile_cell((Cell) (d >> CellBits));
40 compile_cell((Cell) _do_literal);
41 compile_cell((Cell) sp[1]);
42 compile_cell((Cell) _do_literal);
43 compile_cell((Cell) sp[0]);
47 void _two_variable() {
48 create_definition(A_2VARIABLE);
55 register DCell d1 = GET_DCELL(sp + 2);
56 register DCell d2 = GET_DCELL(sp);
63 register DCell d1 = GET_DCELL(sp + 2);
64 register DCell d2 = GET_DCELL(sp);
71 register DCell u = GET_DCELL(sp);
72 register int usign = u < 0;
81 _number_sign_greater();
87 register Cell r = *sp++;
88 register DCell u = GET_DCELL(sp);
89 register int usign = u < 0;
90 if (usign && _base == 10) u = -u;
98 _number_sign_greater();
108 void _d_zero_less() {
109 register DCell d = GET_DCELL(sp);
111 sp[0] = FFLAG(d < 0);
114 void _d_zero_equals() {
115 register DCell d = GET_DCELL(sp);
117 sp[0] = FFLAG(d == 0);
121 register DCell d = GET_DCELL(sp);
126 void _d_two_slash() {
127 register DCell d = GET_DCELL(sp);
132 void _d_less_than() {
133 register DCell d1 = GET_DCELL(sp + 2);
134 register DCell d2 = GET_DCELL(sp);
136 sp[0] = FFLAG(d1 < d2);
140 register DCell d1 = GET_DCELL(sp + 2);
141 register DCell d2 = GET_DCELL(sp);
143 sp[0] = FFLAG(d1 == d2);
147 register DCell d = GET_DCELL(sp);
153 register DCell d1 = GET_DCELL(sp + 2);
154 register DCell d2 = GET_DCELL(sp);
156 if (d2 > d1) PUT_DCELL(sp, d2);
160 register DCell d1 = GET_DCELL(sp + 2);
161 register DCell d2 = GET_DCELL(sp);
163 if (d2 < d1) PUT_DCELL(sp, d2);
167 register DCell d = -GET_DCELL(sp);
171 void _m_star_slash() {
172 register Cell n2 = *sp++;
173 register Cell n1 = *sp++;
174 register DCell d = GET_DCELL(sp);