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