Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) savedicd.fth 98/01/26 1.2 |
2 | \ Save dictionary as data table. | |
3 | \ | |
4 | \ Author: Phil Burk | |
5 | \ Copyright 1987 Phil Burk | |
6 | \ All Rights Reserved. | |
7 | \ | |
8 | \ 970311 PLB Fixed problem with calling SDAD when in HEX mode. | |
9 | \ 20010606 PLB Fixed AUTO.INIT , started with ';' !! | |
10 | ||
11 | decimal | |
12 | ANEW TASK-SAVE_DIC_AS_DATA | |
13 | ||
14 | \ !!! set to 4 for minimally sized dictionary to prevent DIAB | |
15 | \ compiler from crashing! Allocate more space in pForth. | |
16 | 4 constant SDAD_NAMES_EXTRA \ space for additional names | |
17 | 4 constant SDAD_CODE_EXTRA \ space for additional names | |
18 | ||
19 | \ buffer the file I/O for better performance | |
20 | 256 constant SDAD_BUFFER_SIZE | |
21 | create SDAD-BUFFER SDAD_BUFFER_SIZE allot | |
22 | variable SDAD-BUFFER-INDEX | |
23 | variable SDAD-BUFFER-FID | |
24 | 0 SDAD-BUFFER-FID ! | |
25 | ||
26 | : SDAD.FLUSH ( -- ior ) | |
27 | sdad-buffer sdad-buffer-index @ \ data | |
28 | \ 2dup type | |
29 | sdad-buffer-fid @ write-file | |
30 | 0 sdad-buffer-index ! | |
31 | ; | |
32 | ||
33 | : SDAD.EMIT ( char -- ) | |
34 | sdad-buffer-index @ sdad_buffer_size >= | |
35 | IF | |
36 | sdad.flush abort" SDAD.FLUSH failed!" | |
37 | THEN | |
38 | \ | |
39 | sdad-buffer sdad-buffer-index @ + c! | |
40 | 1 sdad-buffer-index +! | |
41 | ; | |
42 | ||
43 | : SDAD.TYPE ( c-addr cnt -- ) | |
44 | 0 DO | |
45 | dup c@ sdad.emit \ char to buffer | |
46 | 1+ \ advance char pointer | |
47 | LOOP | |
48 | drop | |
49 | ; | |
50 | ||
51 | : $SDAD.LINE ( $addr -- ) | |
52 | count sdad.type | |
53 | EOL sdad.emit | |
54 | ; | |
55 | ||
56 | : (U8.) ( u -- a l , unsigned conversion, at least 8 digits ) | |
57 | 0 <# # # # # # # # #S #> | |
58 | ; | |
59 | : (U2.) ( u -- a l , unsigned conversion, at least 2 digits ) | |
60 | 0 <# # #S #> | |
61 | ; | |
62 | ||
63 | : SDAD.CLOSE ( -- ) | |
64 | SDAD-BUFFER-FID @ ?dup | |
65 | IF | |
66 | sdad.flush abort" SDAD.FLUSH failed!" | |
67 | close-file drop | |
68 | 0 SDAD-BUFFER-FID ! | |
69 | THEN | |
70 | ; | |
71 | ||
72 | : SDAD.OPEN ( -- ior, open file ) | |
73 | sdad.close | |
74 | s" pfdicdat.h" r/w create-file dup >r | |
75 | IF | |
76 | drop ." Could not create file pfdicdat.h" cr | |
77 | ELSE | |
78 | SDAD-BUFFER-FID ! | |
79 | THEN | |
80 | r> | |
81 | ; | |
82 | ||
83 | : SDAD.DUMP.HEX { val -- } | |
84 | base @ >r hex | |
85 | s" 0x" sdad.type | |
86 | val (u8.) sdad.type | |
87 | r> base ! | |
88 | ; | |
89 | : SDAD.DUMP.HEX, | |
90 | s" " sdad.type | |
91 | sdad.dump.hex | |
92 | ascii , sdad.emit | |
93 | ; | |
94 | ||
95 | : SDAD.DUMP.HEX.BYTE { val -- } | |
96 | base @ >r hex | |
97 | s" 0x" sdad.type | |
98 | val (u2.) sdad.type | |
99 | r> base ! | |
100 | ; | |
101 | : SDAD.DUMP.HEX.BYTE, | |
102 | sdad.dump.hex.byte | |
103 | ascii , sdad.emit | |
104 | ; | |
105 | ||
106 | : SDAD.DUMP.DATA { start-address end-address num-zeros | num-bytes -- } | |
107 | end-address start-address - -> num-bytes | |
108 | num-bytes 0 | |
109 | ?DO | |
110 | i $ 7FF and 0= IF ." 0x" i .hex cr THEN \ progress report | |
111 | i 15 and 0= | |
112 | IF | |
113 | ||
114 | EOL sdad.emit | |
115 | s" /* " sdad.type | |
116 | i sdad.dump.hex | |
117 | s" : */ " sdad.type | |
118 | THEN \ 16 bytes per line, print offset | |
119 | start-address i + c@ | |
120 | sdad.dump.hex.byte, | |
121 | LOOP | |
122 | \ | |
123 | num-zeros 0 | |
124 | ?DO | |
125 | i $ 7FF and 0= IF i . cr THEN \ progress report | |
126 | i 15 and 0= IF EOL sdad.emit THEN \ 15 numbers per line | |
127 | 0 sdad.dump.hex.byte, | |
128 | LOOP | |
129 | ; | |
130 | ||
131 | : SDAD.DEFINE { $name val -- } | |
132 | s" #define " sdad.type | |
133 | $name count sdad.type | |
134 | s" (" sdad.type | |
135 | val sdad.dump.hex | |
136 | c" )" $sdad.line | |
137 | ; | |
138 | ||
139 | : IS.LITTLE.ENDIAN? ( -- flag , is Forth in Little Endian mode? ) | |
140 | 1 pad ! | |
141 | pad c@ | |
142 | ; | |
143 | ||
144 | : SDAD { | fid -- } | |
145 | sdad.open abort" sdad.open failed!" | |
146 | \ Write headers. | |
147 | c" /* This file generated by the Forth command SDAD */" $sdad.line | |
148 | ||
149 | c" HEADERPTR" headers-ptr @ namebase - sdad.define | |
150 | c" RELCONTEXT" context @ namebase - sdad.define | |
151 | c" CODEPTR" here codebase - sdad.define | |
152 | c" IF_LITTLE_ENDIAN" IS.LITTLE.ENDIAN? IF 1 ELSE 0 THEN sdad.define | |
153 | ||
154 | ." Saving Names" cr | |
155 | s" static const uint8_t MinDicNames[] = {" sdad.type | |
156 | namebase headers-ptr @ SDAD_NAMES_EXTRA sdad.dump.data | |
157 | EOL sdad.emit | |
158 | c" };" $sdad.line | |
159 | ||
160 | ." Saving Code" cr | |
161 | s" static const uint8_t MinDicCode[] = {" sdad.type | |
162 | codebase here SDAD_CODE_EXTRA sdad.dump.data | |
163 | EOL sdad.emit | |
164 | c" };" $sdad.line | |
165 | ||
166 | sdad.close | |
167 | ; | |
168 | ||
169 | if.forgotten sdad.close | |
170 | ||
171 | : AUTO.INIT ( -- , init at launch ) | |
172 | auto.init \ daisy chain initialization | |
173 | 0 SDAD-BUFFER-FID ! | |
174 | 0 SDAD-BUFFER-INDEX ! | |
175 | ; | |
176 | ||
177 | ." Enter: SDAD" cr |