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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
~ current output point, string pointer
: pack-raw-string
{ unpack8 dup } { 3roll swap pack8 swap } while drop drop ;
: origin 0x08000000 ;
~ Status is a bit field:
~ bit zero is whether it's been used
~ bit one is whether it's been defined
~ bit two is whether it was used before being defined
~ bit three is whether the guessed value wound up equaling the actual value
: init-labels
8 allocate s" labels" variable
0 s" labels" find entry-to-execution-token execute !
;
~ This needs to happen now because otherwise the word "labels" won't exist.
init-labels
~ (entry pointer --)
: label-heading
dup entry-to-name dup emitstring space
stringlen 1+ 54 swap - 0 max indent
entry-to-execution-token dup 8 + @ .hex64 space @ .hex8
newline ;
~ (dictionary handle)
: oldest-entry-in
dup
dup { { dup @ } { @ } while } if
dup 3roll = { drop 0 } if
;
~ (entry pointer, dictionary handle)
: next-newer-entry-in
@
2dup = { 2drop 0 exit } if
{ dup { 2dup @ != } if }
{ @ } while swap drop ;
: list-labels
labels oldest-entry-in { dup }
{ dup label-heading labels next-newer-entry-in } while drop ;
~ (name string pointer -- )
: new-label labels create-in 0 , 0 , ;
: label-status entry-to-execution-token ;
: label-value entry-to-execution-token 8 + ;
: intern-label
dup labels swap find-in
dup { swap drop }
{ drop dup new-label labels swap find-in } if-else ;
: L'
word value@
interpreter-flags @ 0x01 &
{ ' litstring entry-to-execution-token ,
here @ swap packstring 0 pack8 8 packalign here !
' intern-label entry-to-execution-token ,
dropstring }
{ intern-label dropstring-with-result } if-else
; make-immediate
~ (label entry pointer -- label value)
: use-label
~ If it hasn't been defined yet, mark it used-before-set.
dup label-status dup @ dup 0x01 & not { 0x02 | swap ! } { drop drop } if-else
~ Mark it used. It's faster to just do this than to check if it's needed.
dup label-status dup @ 0x01 | swap !
~ Return the guessed value.
label-value @ ;
;
~ (new label value, label entry pointer --)
: set-label
~ We always set the defined bit to true. We leave the other status bits
~ as-is, except that we check whether it's unused up to now, and whether
~ the previous value equals the new value. If either of those holds, we set
~ the guessed-equals-actual bit to true.
dup label-status @ 0x02 |
~ (new value, entry, updated status)
3unroll dup 4 unroll label-value @ swap dup 3unroll =
~ (entry, updated status, new value, equality)
3roll dup 4 unroll 0x01 & not
~ (entry, updated status, new value, equality, unused)
|| { swap 0x08 | swap } if
~ (entry, updated status, new value)
3roll dup 3unroll
~ (updated status, entry, new value, entry)
label-value ! label-status !
;
~ (output memory start, current output point
~ -- output memory start, current output point, offset)
: current-offset 2dup swap - ;
~ ~~
~ ~~ ELF header
~ ~~
~ ~~ This is the top-level ELF header, for the entire file. An ELF always
~ ~~ has exactly one of this header, which is always at the start of the file.
~ ~~
: elf-file-header
0x7f pack8 s" ELF" pack-raw-string ~ magic number
2 pack8 ~ 64-bit
1 pack8 ~ little-endian
1 pack8 ~ ELF header format v1
0 pack8 ~ System-V ABI
0 pack64 ~ (padding)
2 pack16 ~ executable
0x3e pack16 ~ Intel x86-64
1 pack32 ~ ELF format version
~ Compute the entry pointer.
~ origin 0x78 + pack64 ~ entry point
L' start use-label origin + pack64
~ This includes the origin, intentionally.
L' program-header use-label pack64
~ 0 pack64 ~ program header offset
~ We place the program header immediately after the ELF header. This
~ offset is from the start of the file.
0 pack64 ~ section header offset
0 pack32 ~ processor flags
64 pack16 ~ ELF header size
56 pack16 ~ program header entry size
1 pack16 ~ number of program header entries
0 pack16 ~ section header entry size
0 pack16 ~ number of section header entries
0 pack16 ~ section name string table index
;
~ ~~
~ ~~ Program header
~ ~~
~ ~~ An ELF program header consists of any number of these entries; they are
~ ~~ always consecutive, but may be anywhere in the file. We always have
~ ~~ exactly one, and it's always right after the ELF file header.
~ ~~
: elf-program-header
current-offset L' program-header set-label
1 pack32 ~ "loadable" segment type
0x05 pack32 ~ read+execute permission
0 pack64 ~ offset in file
origin pack64 ~ virtual address
~ required, but can be anything, subject to alignment
0 pack64 ~ physical address (ignored)
L' total-size use-label pack64 ~ size in file
L' total-size use-label pack64 ~ size in memory
0 pack64 ~ segment alignment
~ for relocation, but this doesn't apply to us
;
: output-start-routine
current-offset L' start set-label
1 :rax mov-reg64-imm32
1 :rdi mov-reg64-imm64
origin L' greeting use-label + :rsi mov-reg64-imm64
L' greeting-size use-label :rdx mov-reg64-imm64
syscall
60 :rax mov-reg64-imm32
0 :rdi mov-reg64-imm32
syscall
;
: output-greeting
current-offset dup L' greeting set-label 3unroll
s" Hello, Irenes!" packstring
current-offset 4 roll - L' greeting-size set-label ;
~ (output memory start, current output point
~ -- output memory start, current output point)
~
~ Everything directly called by all-contents has this same interface.
~
: all-contents
elf-file-header
elf-program-header
output-start-routine
output-greeting
current-offset L' total-size set-label
;
0x1000 allocate dup
~ output memory start, current output point
all-contents
~ The two-pass magick: Reset the output offset to the beginning of the block.
drop dup
all-contents
~ output memory start, current output point
over - swap sys-write bye
|