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
|
\ @(#) savedicd.fth 98/01/26 1.2
\ Save dictionary as data table.
\
\ Author: Phil Burk
\ Copyright 1987 Phil Burk
\ All Rights Reserved.
\
\ 970311 PLB Fixed problem with calling SDAD when in HEX mode.
decimal
ANEW TASK-SAVE_DIC_AS_DATA
\ !!! set to 4 for minimally sized dictionary to prevent DIAB
\ compiler from crashing! Allocate more space in pForth.
4 constant SDAD_NAMES_EXTRA \ space for additional names
4 constant SDAD_CODE_EXTRA \ space for additional names
\ buffer the file I/O for better performance
256 constant SDAD_BUFFER_SIZE
create SDAD-BUFFER SDAD_BUFFER_SIZE allot
variable SDAD-BUFFER-INDEX
variable SDAD-BUFFER-FID
0 SDAD-BUFFER-FID !
: SDAD.FLUSH ( -- ior )
sdad-buffer sdad-buffer-index @ \ data
\ 2dup type
sdad-buffer-fid @ write-file
0 sdad-buffer-index !
;
: SDAD.EMIT ( char -- )
sdad-buffer-index @ sdad_buffer_size >=
IF
sdad.flush abort" SDAD.FLUSH failed!"
THEN
\
sdad-buffer sdad-buffer-index @ + c!
1 sdad-buffer-index +!
;
: SDAD.TYPE ( c-addr cnt -- )
0 DO
dup c@ sdad.emit \ char to buffer
1+ \ advance char pointer
LOOP
drop
;
: $SDAD.LINE ( $addr -- )
count sdad.type
EOL sdad.emit
;
: (U8.) ( u -- a l , unsigned conversion, at least 8 digits )
0 <# # # # # # # # #S #>
;
: (U2.) ( u -- a l , unsigned conversion, at least 2 digits )
0 <# # #S #>
;
: SDAD.CLOSE ( -- )
SDAD-BUFFER-FID @ ?dup
IF
sdad.flush abort" SDAD.FLUSH failed!"
close-file drop
0 SDAD-BUFFER-FID !
THEN
;
: SDAD.OPEN ( -- ior, open file )
sdad.close
s" pfdicdat.h" r/w create-file dup >r
IF
drop ." Could not create file pfdicdat.h" cr
ELSE
SDAD-BUFFER-FID !
THEN
r>
;
: SDAD.DUMP.HEX { val -- }
base @ >r hex
s" 0x" sdad.type
val (u8.) sdad.type
r> base !
;
: SDAD.DUMP.HEX,
s" " sdad.type
sdad.dump.hex
ascii , sdad.emit
;
: SDAD.DUMP.HEX.BYTE { val -- }
base @ >r hex
s" 0x" sdad.type
val (u2.) sdad.type
r> base !
;
: SDAD.DUMP.HEX.BYTE,
sdad.dump.hex.byte
ascii , sdad.emit
;
: SDAD.DUMP.DATA { start-address end-address num-zeros | num-bytes -- }
end-address start-address - -> num-bytes
num-bytes 0
?DO
i $ 7FF and 0= IF ." 0x" i .hex cr THEN \ progress report
i 15 and 0=
IF
EOL sdad.emit
s" /* " sdad.type
i sdad.dump.hex
s" : */ " sdad.type
THEN \ 16 bytes per line, print offset
start-address i + c@
sdad.dump.hex.byte,
LOOP
\
num-zeros 0
?DO
i $ 7FF and 0= IF i . cr THEN \ progress report
i 15 and 0= IF EOL sdad.emit THEN \ 15 numbers per line
0 sdad.dump.hex.byte,
LOOP
;
: SDAD.DEFINE { $name val -- }
s" #define " sdad.type
$name count sdad.type
s" (" sdad.type
val sdad.dump.hex
c" )" $sdad.line
;
: IS.LITTLE.ENDIAN? ( -- flag , is Forth in Little Endian mode? )
1 pad !
pad c@
;
: SDAD { | fid -- }
sdad.open abort" sdad.open failed!"
\ Write headers.
c" /* This file generated by the Forth command SAVE-DIC-AS-DATA */" $sdad.line
c" HEADERPTR" headers-ptr @ namebase - sdad.define
c" RELCONTEXT" context @ namebase - sdad.define
c" CODEPTR" here codebase - sdad.define
c" IF_LITTLE_ENDIAN" IS.LITTLE.ENDIAN? IF 1 ELSE 0 THEN sdad.define
." Saving Names" cr
s" static const uint8 MinDicNames[] = {" sdad.type
namebase headers-ptr @ SDAD_NAMES_EXTRA sdad.dump.data
EOL sdad.emit
c" };" $sdad.line
." Saving Code" cr
s" static const uint8 MinDicCode[] = {" sdad.type
codebase here SDAD_CODE_EXTRA sdad.dump.data
EOL sdad.emit
c" };" $sdad.line
sdad.close
;
if.forgotten sdad.close
." Enter: SDAD" cr
|
