-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathforth.S
More file actions
172 lines (152 loc) · 1.83 KB
/
forth.S
File metadata and controls
172 lines (152 loc) · 1.83 KB
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
; forth.S : initialization and glue code
;
; Copyright (c) 2024 Charles Suresh <[email protected]>
; SPDX-License-Identifier: AGPL-3.0-only
; Please see the LICENSE file for the Affero GPL 3.0 license details
.area CODEIVT (ABS)
.org 0xfffa
.dw start
.dw start
.dw start
.area ZP
.ds 0x100
.area STACK
.ds 0x100
.area CODE
start:
ldx #0xff
txs
jsr rom
lda #'s'
sta 0x7fff
realemit:
pha
lda #'w'
sta 0x7fff
pla
sta 0x7fff
realdrop:
dex
lda dstk,x
rts
realdup:
sta dstk,x
inx
rts
realkey:
jsr realdup
lda #'r'
sta 0x7fff
lda 0x7fff
rts
realneg:
eor #0xff
clc
adc #0x1
rts
realnip:
dex
; ldy dstk,x ; ucsim treats this as an illegal instruction
pha
lda dstk,x
tay
pla
rts
realdip:
; sty dstk,x ; ucsim treats this as an illegal instruction
pha
tya
sta dstk,x
pla
inx
rts
realover:
jsr realdup
lda #1
realpick:
sta temp
txa
clc
sbc temp
tay
lda dstk,y
rts
realstick:
sta temp
txa
clc
sbc temp
tay
jsr realdrop
sta dstk,y
jsr realdrop
rts
swapsp:
stx temp
tsx
stx temp1
tax
txs
lda temp1
ldx temp
; now restore it so the return will work
stx temp
tax
txs
ldx temp
rts
trampoline:
pha
jsr realdrop
pha
jsr realdrop
rts ; which results in a "call" to the pushed address
shiftleft:
tay
jsr realdrop
cpy #0
beq retleft
leftshift:
asl a
dey
bne leftshift
retleft:
rts
shiftright:
tay
jsr realdrop
cpy #0
beq retright
rightshift:
lsr a
dey
bne rightshift
retright:
rts
rom:
ldx #0
ldy #state
lda #1
sta mem,y
#include "rom.s"
#define USEDEFS 0
#define USEDICT 0
#if USEDEFS
#if USEDICT
#include "dict.s"
#include "defs_dict.s"
#else
#include "defs.s"
#endif
#endif
.area DATA
here: .db 0
state: .ds 1
dstk:
.ds 32
.area BSS
temp: .ds 1
temp1: .ds 1
mem: .ds 1 ; reserve the first byte for "here"
.ds 1 ; reserve the second byte for "state"
.ds 1024