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