[pforth] / fth / savedicd.fth

\ @(#) 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
Commit	Line	Data
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
1cb310e6	155	s" static const uint8_t MinDicNames[] = {" sdad.type\r
bb6b2dcd	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
1cb310e6	161	s" static const uint8_t MinDicCode[] = {" sdad.type\r
bb6b2dcd	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