| 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 |