stubforth/core.m4 at master · anse1/stubforth · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
dnl start consing a dodoes word
secondary(builds, <builds,,
  WORD, CONS, LIT, &&dodoes, COMMA, NEUTRAL, COMMA, SMUDGE, SUSPEND)

dnl set the dodoes address to the thread following does>
secondary(does, does>,, RFROM, CONTEXT, LOAD, TOCODE, TOBODY, STORE)

primary(zlt, 0<)
sp[-1].i = sp[-1].i < 0 ;

define(ubinop, `
primary(`$1', ifelse(`$3',`',`$2',`$3'))
    t = *--sp;
    sp[-1].u = sp[-1].u $2 t.u;
')

ubinop(ult, <, u<)

primary(twomul, 2*)
sp[-1].i <<= 1;

primary(twodiv, 2/)
sp[-1].i >>= 1;

dnl ( x1 x2 a-addr -- )
primary(twostore, 2!)
{
  cell *p = sp[-1].a;
  *p++ = sp[-2];
  *p++ = sp[-3];
  sp -= 3;
}

dnl ( a-addr -- x1 x2 )
primary(twoload, 2@)
{
  cell *p = sp[-1].a;
  sp[0] = *p++;
  sp[-1] = *p++;
  sp++;
}

primary(twodup, 2dup)
  sp[0] = sp[-2];
  sp[1] = sp[-1];
  sp += 2;

primary(twodrop, 2drop)
  sp -= 2;

primary(twoover, 2over)
  sp[0] = sp[-4];
  sp[1] = sp[-3];
  sp += 2;

primary(twoswap, 2swap)
  t = sp[-1];
  sp[-1] = sp[-3];
  sp[-3] = t;
  t = sp[-2];
  sp[-2] = sp[-4];
  sp[-4] = t;

primary(abs)
  if (sp[-1].i < 0)
     sp[-1].i = -sp[-1].i;

secondary(evaluate,,, l(
 REDIRECT LOAD RTO
 REDIRECT STORE
 LIT QUIT CATCH
 QDUP
 ZBRANCH self[12]
 THROW
 RFROM REDIRECT STORE
))

dnl dividend divisor -- remainder quotient
primary(umdivmod, um/mod)
{
  vmint quot, rem;
  quot = sp[-2].u / sp[-1].u;
  rem = sp[-2].u % sp[-1].u;
  sp[-2].u = rem;
  sp[-1].u = quot;
}

secondary(ichar, [char], .immediate=1, l(
 KEY LITERAL
))

thread(udot1,
 &&enter, BASE, CLOAD, UMDIVMOD,
 QDUP, ZBRANCH, self[8], self,
 HEXCHARS, ADD, CLOAD, EMIT, EXIT)

secondary(udot, u.,, UDOT1, BL)

dnl ( n1 n2 n3 -- n4 )
primary(star_slash, */)
{
   dvmint tmp = (dvmint)sp[-3].i * sp[-2].i;
   tmp /= sp[-1].i;
   sp -= 2;
   sp[-1].i = tmp;
}