OSDN > Finden Software > Split Stack Runtime -- 分岐型スタックの稼働環境 > SCM > git > splitstack-runtimelib > Commit

Split Stack Runtime -- 分岐型スタックの稼働環境
Fork

R/O
HTTP
SSH
HTTPS

splitstack-runtimelib: Commit

Main development of the libraries, proceeding in parallel

Commit MetaInfo

Revision	0af58d5f857824584387f72f83f4fc362d7d9b90 (tree)
Zeit	2020-10-18 23:04:23
Autor	Joel Matthew Rees <joel.rees@gmai...>
Commiter	Joel Matthew Rees

Log Message

Started on 8086, more cleaning up others, esp 68K

Ändern Zusammenfassung

modified: figbase.68c (diff)
modified: runt6800.68c (diff)
modified: runt68000.ask (diff)
modified: runt6801.68c (diff)
modified: runt6805.as5 (diff)
modified: runt6809.as9 (diff)
modified: runt8080.asm (diff)
modified: runt8080DE.asm (diff)
modified: runt8080gnusim.asm (diff)
add: runt8086.asm (diff)

Diff

--- a/figbase.68c

+++ b/figbase.68c

		@@ -802,31 +802,8 @@ OVER FDB *+2
802	802	LDA B 3,X
803	803	JMP PUSHBA
804	804	*
805		-* ======>> 38 <<
806		- FCB $84
807		- FCC 'DRO' ; 'DROP'
808		- FCB $D0
809		- FDB OVER-7
810		-DROP FDB *+2
811		- INS
812		- INS
813		- JMP NEXT
814		-*
815	805
816	806
817		-*
818		-* ======>> 40 <<
819		- FCB $83
820		- FCC 'DU' ; 'DUP'
821		- FCB $D0
822		- FDB SWAP-7
823		-DUP FDB *+2
824		- PUL A
825		- PUL B
826		- PSH B
827		- PSH A
828		- JMP PUSHBA
829		-*
830	807	* ######>> screen 31 <<
831	808	* ======>> 41 <<
832	809	FCB $82

--- a/runt6800.68c

+++ b/runt6800.68c

		@@ -289,7 +289,7 @@ DEALL2
289	289	STX PSP
290	290	RTS
291	291
292		-* _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ):
	292	+* _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) ):
293	293	USTAR
294	294	LDX PSP
295	295	LDAA #CELLBSZ ; bits/cell

--- a/runt68000.ask

+++ b/runt68000.ask

		@@ -6,6 +6,10 @@
6	6	* Borrowing some concepts from fig-Forth.
7	7	* Purely theoretical, not tested!
8	8
	9	+* Natural 32-bit version.
	10	+* Unnatural 16-bit version might be a project for another day?
	11	+* (Would primarily be of interest for MUL and DIV, but CPU32 version is more interesting.)
	12	+
9	13	* ------------------------------------LICENSE-------------------------------------
10	14	*
11	15	* Copyright (c) 2009, 2010, 2011 Joel Matthew Rees

		@@ -163,90 +167,106 @@ WARM JMP.S WARMENT
163	167	*
164	168	* This would be part of the _WORD_ macro.
165	169
	170	+*************
	171	+* Taking the AND and the @ and ! primitives as examples,
	172	+* would using intermediates make optimization easier?
	173	+* (As in optimize by stripping stack maintenance
	174	+* and replacing it with register allocation.)
	175	+*
	176	+* AND
	177	+* MOVE.L CELLSZ(A6),D3
	178	+* AND.L (A6)+,D3
	179	+* MOVE.L D3,(A6)
	180	+* RTS
	181	+*
	182	+* BFETCH
	183	+* MOVE.L (A6),A0
	184	+* MOVEQ #0,D0
	185	+* MOVE.B (A0),D0
	186	+* MOVE.L D0,(A6) ; whole cell to TOS
	187	+* RTS
	188	+*
	189	+* SSTORE
	190	+* MOVE.L (A6)+,A0
	191	+* MOVE.L (A6)+,D0 ; Get whole cell to keep stack address correct.
	192	+* MOVE.W D0,(A1) ; Store only half-cell, do not clear high half!
	193	+* RTS
	194	+
166	195
167	196	* _WORD_ Take logical AND of top two on stack ( n1 n2 --- n3 ):
168	197	AND
169		- MOVE.L ADRWDSZ(A6),D3
170		- AND.L (A6)+,D3
171		- MOVE.l D0,(A6)
	198	+ MOVE.L (A6)+,D3
	199	+ AND.L D3,(A6)
172	200	RTS
173	201
174	202	* _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
175	203	OR
176		- MOVE.L ADRWDSZ(A6),D3
177		- OR.L (A6)+,D3
178		- MOVE.l D0,(A6)
	204	+ MOVE.L (A6)+,D3
	205	+ OR.L D3,(A6)
179	206	RTS
180	207
181	208	* _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
182	209	XOR
183		- MOVE.L ADRWDSZ(A6),D3
184		- EOR.L (A6)+,D3
185		- MOVE.l D0,(A6)
	210	+ MOVE.L (A6)+,D3
	211	+ EOR.L D3,(A6) ; (Not) coincidentally, EOR does not do (A6),D3.
186	212	RTS
187	213
188	214	* _WORD_ + Add top two cells on stack ( n1 n2 --- sum ):
189	215	ADD
190		- MOVE.L ADRWDSZ(A6),D3
191		- ADD.L (A6)+,D3
192		- MOVE.l D0,(A6)
	216	+ MOVE.L (A6)+,D3
	217	+ ADD.L D3,(A6)
193	218	RTS
194	219
195	220	* _WORD_ - Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
196	221	SUB
197		- MOVE.L ADRWDSZ(A6),D3
198		- SUB.L (A6)+,D3
199		- MOVE.l D0,(A6)
	222	+ MOVE.L (A6)+,D3
	223	+ SUB.L D3,(A6)
200	224	RTS
201	225
202	226	* _WORD_ B@ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
203	227	* (Refer to Forth's C@, but byte is not character!)
204	228	BFETCH
205	229	MOVE.L (A6),A1
206		- CLR.L D3
207		- MOVE.B (A1),D3
208		- MOVE.L D3,(A6)
	230	+ CLR.L (A6) ; instead of intermediate Dn and CLR
	231	+ MOVE.B (A1),(A6)
209	232	RTS
210	233
211	234	* _WORD_ B! Store low byte of cell at 2nd at address on top of stack, deallocate both ( b adr --- ):
212	235	* (Refer to Forth's C!, but byte is not character!)
213	236	BSTORE
214	237	MOVE.L (A6)+,A1
215		- MOVE.L (A6)+,D3 ; Get whole cell instead of pre-clearing.
216		- MOVE.B D3,(A1) ; Store only byte, do not clear high bytes!
	238	+ MOVE.B (A6),(A1) ; Store only byte, do not clear high bytes!
	239	+ LEA ADRWDSZ(A6),A6 ; Less footprint than intermediate post-inc
217	240	RTS
218	241
219	242	* _WORD_ S@ Fetch half-cell only pointed to by top cell on stack ( adr --- h(at adr) ):
220		-* adr must be even address aligned on many 68K.
	243	+* adr must be even address aligned on most 68K.
221	244	SFETCH
222	245	MOVE.L (A6),A1
223		- CLR.L D3
224		- MOVE.W (A1),D3
225		- MOVE.L D3,(A6)
	246	+ CLR.L (A6) ; instead of intermediate Dn and CLR
	247	+ MOVE.W (A1),(A6)
226	248	RTS
227	249
228	250	* _WORD_ S! Store half-cell at 2nd at address on top of stack, deallocate both ( h adr --- ):
229		-* adr must be even address aligned on many 68K.
	251	+* adr must be even address aligned on most 68K.
230	252	SSTORE
231	253	MOVE.L (A6)+,A1
232		- MOVE.L (A6)+,D3 ; Get whole cell from stack instead of pre-clearing.
233		- MOVE.W D3,(A1) ; Store only half-cell, do not clear high half!
	254	+ MOVE.W (A6),(A1) ; Store only half-cell, do not clear high half!
	255	+ LEA ADRWDSZ(A6),A6 ; Less footprint than intermediate post-inc
234	256	RTS
235	257
236	258	* _WORD_ @ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
237		-* adr must be even address aligned on many 68K.
	259	+* adr must be even address aligned on most 68K.
238	260	FETCH
239	261	MOVE.L (A6).A1
240		- MOVE.L (A1),D3
241		- MOVE.L D3,(A6)
	262	+ MOVE.L (A1),(A6)
242	263	RTS
243	264
244	265	* _WORD_ ! Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
245		-* adr must be even address aligned on many 68K.
	266	+* adr must be even address aligned on most 68K.
246	267	STORE
247	268	MOVE.L (A6)+,A1
248		- MOVE.L (A6)+,D3
249		- MOVE.L D3,(A1)
	269	+ MOVE.L (A6)+,(A1)
250	270	RTS
251	271
252	272	* Low confidence in the multiply and divide without an emulator to check.

		@@ -278,8 +298,43 @@ USTARX MOVEM.L D2/D3,(A6) ; Store result.
278	298	*
279	299	* _WORD_ U* Unsigned multiply of top two on stack ( u1 u2 --- udproduct(n1*n2) )
280	300	* Using 68000's MUL for speed.
	301	+* Optimize for small operands at runtime.
281	302	* More code, less time, but I need to check that I'm handling the halves right:
282	303	USTAR
	304	+ MOVEM.L (A6),D4/D3
	305	+ MOVE.L D3,D0
	306	+ OR.L D4,D0
	307	+ AND.L #$FFFF0000,D0 ; both < 2^16?
	308	+ BNE.B USTAR2
	309	+ MULU D4,D3
	310	+ MOVEQ #0,D2 ;
	311	+ MOVE.L D3/D2,(A6)
	312	+ RTS
	313	+
	314	+ SWAP D3
	315	+ MOVE.L D2,D0
	316	+ SWAP D0
	317	+ MOVE.L D0,D6
	318	+
	319	+
	320	+
	321	+ MOVE.L D5,D3
	322	+ SWAP D3
	323	+ MOVE.L D2,D1
	324	+
	325	+ SWAP D2
	326	+ SWAP D0
	327	+* MOVE.L D3,D0
	328	+* OR.L D2,D0
	329	+* AND.L $FFFF0000,D0
	330	+* BNE.B USTAR2
	331	+* MULU D2,D3
	332	+* MOVEQ #0,D2
	333	+* MOVE.L D3/D2,(A6)
	334	+* RTS
	335	+USTAR2
	336	+
	337	+
283	338	MOVEQ #0 D1 ; Scratch area for inner products
284	339	MOVEQ #0 D0
285	340	*

		@@ -333,7 +388,7 @@ SWAP
333	388
334	389	* _WORD_ U/MODbit Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
335	390	* ( ud u --- uremainder uquotient )
336		-* Dividend should be range of product of 16 by 16 bit unsigned multiply,
	391	+* Dividend should be range of product of 32 by 32 bit unsigned multiply,
337	392	* divisor should be the multiplier or multiplicand:
338	393	* Consider bit test instead of shift?
339	394	* Also, examine the native divide again.

		@@ -350,10 +405,10 @@ USLSUB
350	405	SUB.L D1,D2
351	406	ORI #1,CCR ; quotient bit,
352	407	USLBIT
353		- ROXL.L D3 ; save it
	408	+ ROXL.L #1,D3 ; save it
354	409	SUBQ #1,D0 ; more bits?
355	410	BEQ.B USLR ; Can DBcc be used here?
356		- ROXL.L D2 ; move remainder in as we move dividend out
	411	+ ROXL.L #1,D2 ; move remainder in as we move dividend out
357	412	BCC USLDIV
358	413	BRA USLSUB
359	414	USLR

		@@ -362,6 +417,25 @@ USLR
362	417	MOVE.L D2,ADRWDSZ(A6) ; remainder
363	418	RTS
364	419
	420	+* _WORD_ U/MOD Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
	421	+* ( ud u --- uremainder uquotient )
	422	+* Assume native divide trap on n/0 simply sets quotient to all ones or something.
	423	+* Start by doing 32/16 divide if divisor less than 65536.
	424	+* Maybe call the bit divide until I understand better, when divisor is more than 16 bits.
	425	+* Dividend should be range of product of 32 by 32 bit unsigned multiply,
	426	+* divisor should be the multiplier or multiplicand:
	427	+* Consider bit test instead of shift?
	428	+* Also, examine the native divide again.
	429	+* ** Native divide requires divide-by-zero trap code!
	430	+USLASH
	431	+ MOVEM.L (A6),D3/D2/D1 ; D1 is divisor, D2:D3 is dividend
	432	+ CMPI.L #$10000,D1
	433	+ BHS.B USLASH32
	434	+ DIVU
	435	+USLASH32
	436	+
	437	+Try working out 16/8 on 6801 (6800) for clues.
	438	+
365	439	* _WORD_ >L Save top cell on stack to locals stack ( n --- ) { --- n }:
366	440	TOL
367	441	MOVE.L (A4)+,-(A6)

--- a/runt6801.68c

+++ b/runt6801.68c

		@@ -247,7 +247,7 @@ DEALL2
247	247	STD PSP
248	248	RTS
249	249
250		-* _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ):
	250	+* _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) ):
251	251	* USTARB
252	252	* LDX PSP
253	253	* LDAA #CELLBSZ ; bits/cell

		@@ -266,7 +266,7 @@ DEALL2
266	266	* USTARX STD 0,X ; store more significant 16 bits
267	267	* RTS
268	268
269		-* _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) )
	269	+* _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) )
270	270	* Using 6801's MUL for speed -- more code less time:
271	271	USTAR
272	272	LDX PSP

--- a/runt6805.as5

+++ b/runt6805.as5

		@@ -67,7 +67,7 @@ ALLOGAP EQU (GAPCT*CELLSZ) ; For crude checks, gaps always zero.
67	67	* Declare initial Return Stack (flow-of-control stack):
68	68	RSTKBND EQU $80 ; Bound: one beyond
69	69	RSTKINI EQU (RSTKBND-1) ; Init: next available byte on 6800
70		-RSTKSZ EQU (62*CELLSZ) ; Size: Safe for most purposes.
	70	+RSTKSZ EQU (8*CELLSZ) ; Size: Safe for most purposes.
71	71	RSTKLIM EQU (RSTKBND-RSTKSZ) ; Limit: Last useable
72	72	* Kibitzing -- CPUs really should have automatic stack bounds checking.
73	73	* Don't forget gaps for CPUs that don't automatically check.

		@@ -76,13 +76,13 @@ RSTKLIM EQU (RSTKBND-RSTKSZ) ; Limit: Last useable
76	76	* Declare initial Locals Stack (temporaries stack):
77	77	LSTKBND EQU (RSTKLIM-ALLOGAP)
78	78	LSTKINI EQU (LSTKBND-CELLSZ) ; Pre-dec, even on 6800, but on address word boundary.
79		-LSTKSZ EQU (30*CELLSZ) ; Size: CELL addressing, small stacks.
	79	+LSTKSZ EQU (6*CELLSZ) ; Size: CELL addressing, small stacks.
80	80	LSTKLIM EQU (LSTKBND-LSTKSZ)
81	81
82	82	* Declare initial Parameter Stack (data stack):
83	83	SSTKBND EQU (LSTKLIM-ALLOGAP)
84	84	SSTKINI EQU (SSTKBND-CELLSZ) ; Also post-dec on 6800, but on address word boundary.
85		-SSTKSZ EQU (126*CELLSZ) ; Size: CELL addressing, small stacks.
	85	+SSTKSZ EQU (16*CELLSZ) ; Size: CELL addressing, small stacks.
86	86	SSTKLIM EQU (SSTKBND-SSTKSZ)
87	87
88	88	* The paramater stack and heap at opposite ends of the same region

		@@ -90,7 +90,7 @@ SSTKLIM EQU (SSTKBND-SSTKSZ)
90	90
91	91	* The initial per-user allocation heap:
92	92	UPGBND EQU (SSTKLIM-ALLOGAP)
93		-UPGSZ EQU (64*CELLSZ) ; This will need adjusting in many cases.
	93	+UPGSZ EQU (16*CELLSZ) ; This will need adjusting in many cases.
94	94	UPGBASE EQU (UPGBND-UPGSZ)
95	95	UPGINI EQU UPGBASE
96	96

		@@ -118,6 +118,8 @@ PSP RMB ADRWDSZ ; the parameter/data stack pointer (Forth SP)
118	118	UP RMB ADRWDSZ ; pointer to the per-task heap
119	119	TEMP RMB 2*CELLSZ ; for general math
120	120	GCOUNT RMB CELLSZ ; general counter
	121	+HIBYTE RMB 1 ; general purpose
	122	+LOBYTE RMB 1 ; general purpose
121	123	* Generalizing the move would require self-modifying code.
122	124	* What would work better is a macro.
123	125	IXDEST RMB ADRWDSZ ; destination index pointer

		@@ -177,7 +179,7 @@ Need to decide on whether the runtime sees more than 8 address bits, etc.
177	179	* How useful would it be?
178	180
179	181
180		-* _WORD_ Take logical AND of top two on stack ( n1 n2 --- n3 ):
	182	+* _WORD_ AND Take logical AND of top two on stack ( n1 n2 --- n3 ):
181	183	AND
182	184	LDX PSP
183	185	LDA 1+CELLSZ,X

		@@ -187,7 +189,7 @@ AND
187	189	AND ,X
188	190	BRA ADDSTHI
189	191
190		-* _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
	192	+* _WORD_ OR Take logical OR of top two on stack ( n1 n2 --- n3 ):
191	193	OR
192	194	LDX PSP
193	195	LDA 1+CELLSZ,X

		@@ -197,7 +199,7 @@ OR
197	199	ORA ,X
198	200	BRA ADDSTHI
199	201
200		-* _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
	202	+* _WORD_ XOR Take logical OR of top two on stack ( n1 n2 --- n3 ):
201	203	XOR
202	204	LDX PSP
203	205	LDA 1+CELLSZ,X

		@@ -207,7 +209,7 @@ XOR
207	209	EOR ,X
208	210	BRA ADDSTHI
209	211
210		-* _WORD_ Add top two cells on stack ( n1 n2 --- sum ):
	212	+* _WORD_ + Add top two cells on stack ( n1 n2 --- sum ):
211	213	ADD
212	214	LDX PSP
213	215	LDA 1+CELLSZ,X

		@@ -222,7 +224,7 @@ ADDSTHI
222	224	STX PSP
223	225	RTS
224	226
225		-* _WORD_ Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
	227	+* _WORD_ - Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
226	228	SUB
227	229	LDX PSP
228	230	LDA 1+CELLSZ,X

		@@ -234,7 +236,7 @@ SUB
234	236
235	237	* Full address would require self-modifying code.
236	238
237		-* _WORD_ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
	239	+* _WORD_ B@ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
238	240	* (Refer to Forth's C@, but byte is not character!)
239	241	BFETCH
240	242	LDX PSP

		@@ -251,7 +253,7 @@ BFETCH
251	253	CLR ,X ; high byte
252	254	RTS
253	255
254		-* _WORD_ Store low byte of cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
	256	+* _WORD_ B! Store low byte of cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
255	257	* (Refer to Forth's C!, but byte is not character!)
256	258	BSTORE
257	259	LDX PSP

		@@ -272,7 +274,7 @@ BSTORE
272	274	STX PSP
273	275	RTS
274	276
275		-* _WORD_ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
	277	+* _WORD_ @ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
276	278	FETCH
277	279	LDX PSP
278	280	LDA MMLDA

		@@ -293,7 +295,7 @@ FETCHNI
293	295	STA 1,X
294	296	RTS
295	297
296		-* _WORD_ Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
	298	+* _WORD_ ! Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
297	299	STORE
298	300	LDX PSP
299	301	LDA MMSTA

		@@ -321,13 +323,34 @@ STORENI
321	323
322	324	* Conversion needs to proceed from here.
323	325
324		-* _WORD_ Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ):
	326	+* _WORD_ B* Unsigned byte multiply of top two on stack ( b1 b2 --- uproduct(n1*n2) ):
325	327	USTAR
326	328	LDX PSP
327		- LDAA #CELLBSZ ; bits/cell
328		- STAA 1+GCOUNT
	329	+ LDA #CELLBSZ ; bits/cell
	330	+ STA 1+GCOUNT
	331	+ CLRA
	332	+ CLR HIBYTE
	333	+USTARL ROR ADRWDSZ,X ; shift multiplier
	334	+ ROR 1+ADRWDSZ,X
	335	+ DEC 1+GCOUNT ; done?
	336	+ BMI USTARX
	337	+ BCC USTARNA
	338	+ ADDB 1+ADRWDSZ,X
	339	+ ADCA ADRWDSZ,X
	340	+USTARNA RORA
	341	+ RORB ; shift result in
	342	+ BRA USTARL
	343	+USTARX STAB 1,X ; store more significant 16 bits
	344	+ STAA 0,X
	345	+ RTS
	346	+
	347	+* _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) ):
	348	+USTAR
	349	+ LDX PSP
	350	+ LDA #CELLBSZ ; bits/cell
	351	+ STA 1+GCOUNT
329	352	CLRA
330		- CLRB
	353	+ CLR HIBYTE
331	354	USTARL ROR ADRWDSZ,X ; shift multiplier
332	355	ROR 1+ADRWDSZ,X
333	356	DEC 1+GCOUNT ; done?

		@@ -342,7 +365,7 @@ USTARX STAB 1,X ; store more significant 16 bits
342	365	STAA 0,X
343	366	RTS
344	367
345		-* _WORD_ swap top two cells on stack ( n1 n2 --- n2 n1 ):
	368	+* _WORD_ SWAP swap top two cells on stack ( n1 n2 --- n2 n1 ):
346	369	SWAP
347	370	LDX PSP
348	371	SWAPROB

		@@ -356,7 +379,7 @@ SWAPROB
356	379	STAA 1+ADRWDSZ,x
357	380	RTS
358	381
359		-* _WORD_ Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
	382	+* _WORD_ U/MOD Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
360	383	* ( ud u --- uremainder uquotient )
361	384	* Dividend should be range of product of 16 by 16 bit unsigned multiply,
362	385	* divisor should be the multiplier or multiplicand:

		@@ -393,7 +416,7 @@ USLX INX ; Drop high cell.
393	416	* Steal return.
394	417
395	418
396		-* _WORD_ Save top cell on stack to return stack ( n --- ) { --- n }:
	419	+* _WORD_ >R Save top cell on stack to return stack ( n --- ) { --- n }:
397	420	TOR
398	421	LDX PSP
399	422	LDAA 0,X

		@@ -405,13 +428,13 @@ TOR
405	428	STX PSP
406	429	RTS
407	430
408		-* _WORD_ Pop top of return stack to parameter stack ( --- n ) { n --- }:
	431	+* _WORD_ R> Pop top of return stack to parameter stack ( --- n ) { n --- }:
409	432	RFROM
410	433	PULA ; Watch order
411	434	PULB
412	435	BRA ALLOSTO
413	436
414		-* _WORD_ Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }:
	437	+* _WORD_ R Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }:
415	438	R
416	439	TSX
417	440	LDAA 0,X

		@@ -426,7 +449,8 @@ ALLOSTO
426	449	RTS
427	450
428	451	* Should true be set as 1 or -1?
429		-* _WORD_ Test top cell on stack for zero ( n --- f(top==0) ):
	452	+* _WORD_ 0= Test top cell on stack for zero ( n --- f(top==0) ):
	453	+ZEQU
430	454	LDX PSP
431	455
432	456	CLR A

--- a/runt6809.as9

+++ b/runt6809.as9

		@@ -296,7 +296,7 @@ USLR LEAS 1,S
296	296
297	297	**** gotta look at ,S references one more time
298	298
299		-* _WORD_ >L Save top cell on stack to locals stack ( n --- ) { --- n }:
	299	+* _WORD_ >L Save top cell on parameter stack to locals stack ( n --- ) { --- n }:
300	300	TOL
301	301	PULU D
302	302	LDX <LSP

		@@ -304,7 +304,7 @@ TOL
304	304	STX <LSP
305	305	RTS
306	306
307		-* _WORD_ >R Save top cell on stack to return stack ( n --- ) { --- n }:
	307	+* _WORD_ >R Save top cell on parameter stack to return stack ( n --- ) { --- n }:
308	308	TOR
309	309	LDX ,S ; return address, oh forgetful one!
310	310	PULU D

		@@ -317,7 +317,7 @@ TOR_M
317	317	PSHS D
318	318	TOR_M_END
319	319
320		-* _WORD_ L> Pop top of return stack to locals stack ( --- n ) { n --- }:
	320	+* _WORD_ L> Pop top of locals stack to parameter stack ( --- n ) { n --- }:
321	321	LFROM
322	322	LDX <LSP
323	323	LDD ,X++

--- a/runt8080.asm

+++ b/runt8080.asm

		@@ -266,7 +266,7 @@ STORE: MOV C,M ; address low byte
266	266	RET
267	267
268	268
269		-; _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ):
	269	+; _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) ):
270	270	USTAR: MOV E,M ; multiplier
271	271	INX HL
272	272	MOV D,M

--- a/runt8080DE.asm

+++ b/runt8080DE.asm

		@@ -268,7 +268,7 @@ DEALL2:
268	268	STX PSP
269	269	RTS
270	270
271		-; _WORD_ Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ):
	271	+; _WORD_ Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) ):
272	272	USTAR:
273	273	LDX PSP
274	274	LDAA #CELLBSZ ; bits/cell

--- a/runt8080gnusim.asm

+++ b/runt8080gnusim.asm

		@@ -324,7 +324,7 @@ STORE: MOV C,M ; address low byte
324	324	RET
325	325
326	326
327		-; _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ):
	327	+; _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) ):
328	328	USTAR: MOV E,M ; multiplier
329	329	INX H
330	330	MOV D,M

--- /dev/null

+++ b/runt8086.asm

		@@ -0,0 +1,382 @@
	1	+ OPT PRT
	2	+
	3	+; runtimelib FOR 8086
	4	+; Joel Matthew Rees September 2020
	5	+
	6	+; Borrowing some concepts from fig-Forth.
	7	+; Not tested!
	8	+; In fact, I was never all that good with 8086 code,
	9	+; and it has been almost 40 years, so ...
	10	+; don't expect it to work without fixing it.
	11	+; Patterned after 6809 libs.
	12	+;
	13	+; Natural 16-bit version.
	14	+; Unnatural 32-bit version is a project for another day,
	15	+; as is any attempt to work with segmentation.
	16	+
	17	+; ------------------------------------LICENSE-------------------------------------
	18	+;
	19	+; Copyright (c) 2020 Joel Matthew Rees
	20	+;
	21	+; Permission is hereby granted, free of charge, to any person obtaining a copy
	22	+; of this software and associated documentation files (the "Software"), to deal
	23	+; in the Software without restriction, including without limitation the rights
	24	+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
	25	+; copies of the Software, and to permit persons to whom the Software is
	26	+; furnished to do so, subject to the following conditions:
	27	+;
	28	+; The above copyright notice and this permission notice shall be included in
	29	+; all copies or substantial portions of the Software.
	30	+;
	31	+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
	32	+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
	33	+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
	34	+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
	35	+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
	36	+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
	37	+; THE SOFTWARE.
	38	+;
	39	+; --------------------------------END-OF-LICENSE----------------------------------
	40	+;
	41	+
	42	+
	43	+; These must be edited for target runtime:
	44	+
	45	+; Necessary here for fake forward referencing:
	46	+
	47	+
	48	+BYTESZ: EQU 8 ; bit count in byte
	49	+
	50	+ADRWDSZ: EQU 2 ; bytes per address word
	51	+; This is a 16-bit library/run-time,
	52	+; without pretensions to long pointers or 32 bit cell size.
	53	+
	54	+; If at all possible, a CELL should be able to contain an address.
	55	+; Otherwise, fetch and store become oddities.
	56	+CELLSZ: EQU ADRWDSZ
	57	+CELLBSZ: EQU (ADRWDSZ*BYTESZ) ; bit count in CELL
	58	+DBLSZ: EQU (ADRWDSZ*2)
	59	+DBLBSZ: EQU (DBLSZ*BYTESZ) ; bit count in DOUBLE
	60	+
	61	+GAPCT: EQU 2 ; address words for the gaps
	62	+ALLOGAP: EQU (GAPCT*ADRWDSZ) ; For crude checks, gaps always zero.
	63	+
	64	+
	65	+; Declare initial Return Stack (flow-of-control stack):
	66	+RSTKBND: EQU 08000H ; Bound: one beyond
	67	+RSTKINI: EQU (RSTKBND) ; Init: next available byte on 8086 -- pre-dec
	68	+RSTKSZ: EQU (62*ADRWDSZ) ; Size: Safe for most purposes.
	69	+RSTKLIM: EQU (RSTKBND-RSTKSZ) ; Limit: Last useable
	70	+; Kibitzing -- CPUs really should have automatic stack bounds checking.
	71	+; Don't forget gaps for CPUs that don't automatically check.
	72	+; Crude guard rails is better than none?
	73	+
	74	+; Declare initial Locals Stack (temporaries stack):
	75	+LSTKBND: EQU (RSTKLIM-ALLOGAP)
	76	+LSTKINI: EQU (LSTKBND-CELLSZ) ; 8080? pre-dec, but on address word boundary.
	77	+LSTKSZ: EQU (30*CELLSZ) ; Size: CELL addressing, small stacks.
	78	+LSTKLIM: EQU (LSTKBND-LSTKSZ)
	79	+
	80	+; Declare initial Parameter Stack (data stack):
	81	+SSTKBND: EQU (LSTKLIM-ALLOGAP)
	82	+SSTKINI: EQU (SSTKBND) ; Also pre-dec, but on address word boundary.
	83	+SSTKSZ: EQU (126*ADRWDSZ) ; Size: CELL addressing, small stacks.
	84	+SSTKLIM: EQU (SSTKBND-SSTKSZ)
	85	+
	86	+; The paramater stack and heap at opposite ends of the same region
	87	+; has mixed benefits.
	88	+
	89	+; The initial per-user allocation heap:
	90	+UPGBND: EQU (SSTKLIM-ALLOGAP)
	91	+UPGSZ: EQU 64*ADRWDSZ ; This will need adjusting in many cases.
	92	+UPGBASE: EQU (UPGBND-UPGSZ)
	93	+UPGINI: EQU UPGBASE
	94	+
	95	+
	96	+
	97	+
	98	+; ORG directives in older assemblers can get tangled up
	99	+; if they are convoluted.
	100	+; Keep the ORGs in assending order.
	101	+
	102	+
	103	+; Keep an eye on address handling!
	104	+ ORG 400H ; This assumes the library will be in the same space as interrupts.
	105	+; I'll try to keep the model sane if the interrupts are moved out.
	106	+
	107	+; Internal registers --
	108	+; (When switching contexts, these must be saved and restored.):
	109	+
	110	+; This is the small model, all segments are same.
	111	+
	112	+; RP EQU ADRWDSZ ; the return/flow-of-control stack pointer is 8086 SP
	113	+; PSP RMB ADRWDSZ ; the parameter/data stack pointer (Forth SP) is 8086 BP
	114	+; LSP RMB ADRWDSZ ; the locals stack pointer is 8086 SI (save before other use)
	115	+; TEMP RMB 2*ADRWDSZ ; for math on X -- all temps allocated local on BP
	116	+; GCOUNT RMB ADRWDSZ ; general counter is 8086 CX
	117	+; IXDEST RMB ADRWDSZ ; destination index pointer is often 8086 DI (after saving)
	118	+; IXSRC RMB ADRWDSZ ; source index pointer is often 8086 SI (after saving)
	119	+; UP RMB ADRWDSZ ; pointer to the per-task heap is 8086 DI (save before other use)
	120	+; BX will be general purpose index.
	121	+
	122	+
	123	+
	124	+ ORG 480H
	125	+ NOP
	126	+COLD: JMP COLDENT
	127	+ NOP
	128	+WARM: JMP WARMENT
	129	+
	130	+
	131	+; _WORD_ AND Take logical AND of top two on stack ( n1 n2 --- n3 ):
	132	+AND:
	133	+ MOV AX,[BP]
	134	+ AND CELLSZ[BP],AX
	135	+ LEA BP,CELLSZ[BP]
	136	+ RET
	137	+
	138	+; _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
	139	+OR:
	140	+ MOV AX,BYTE PTR [BP]
	141	+ OR CELLSZ[BP],AX
	142	+ LEA BP,CELLSZ[BP]
	143	+ RET
	144	+
	145	+; _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
	146	+XOR:
	147	+ MOV AX,[BP]
	148	+ XOR CELLSZ[BP],AX
	149	+ LEA BP,CELLSZ[BP]
	150	+ RET
	151	+
	152	+; _WORD_ Add top two cells on stack ( n1 n2 --- sum ):
	153	+ADD:
	154	+ MOV AX,[BP]
	155	+ ADD CELLSZ[BP],AX
	156	+ LEA BP,CELLSZ[BP]
	157	+ RET
	158	+
	159	+; _WORD_ Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
	160	+SUB:
	161	+ MOV AX,[BP]
	162	+ ADD CELLSZ[BP],AX
	163	+ LEA BP,CELLSZ[BP]
	164	+ RET
	165	+
	166	+; _WORD_ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
	167	+; (Refer to Forth's C@, but byte is not character!)
	168	+BFETCH:
	169	+ MOV BX,[BP]
	170	+ MOV AL,[BX]
	171	+ CBW
	172	+ MOV [BP],AX
	173	+ RET
	174	+
	175	+; _WORD_ Store low byte of cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
	176	+; (Refer to Forth's C!, but byte is not character!)
	177	+BSTORE:
	178	+ MOV BX,[BP]
	179	+ MOV AL,CELLSZ[BP] ; Least Significant First, no auto-inc, so this works.
	180	+ MOV [BX],AL
	181	+ LEA BP,CELLSZ+ADRWDSZ[BP]
	182	+ RET
	183	+
	184	+; _WORD_ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
	185	+FETCH:
	186	+ MOV BX,[BP]
	187	+ MOV AX,[BX]
	188	+ MOV [BP],AX
	189	+ RET
	190	+
	191	+; _WORD_ Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
	192	+STORE:
	193	+ MOV BX,[BP]
	194	+ MOV AX,CELLSZ[BP]
	195	+ MOV [BX],AX
	196	+ LEA BP,CELLSZ+ADRWDSZ[BP]
	197	+ RET
	198	+
	199	+; _WORD_ Unsigned multiply of top two on stack ( u1 u2 --- udproduct(n1*n2) ):
	200	+; Run-time optimize for small numbers.
	201	+USTAR:
	202	+ MOV AX,[BP]
	203	+ MOV CX,CELLSZ[BP]
	204	+ MOV DX,CX
	205	+ OR DH,AH
	206	+ JZ USTARB
	207	+ MUL CX
	208	+ JMP USTARD
	209	+USTARB:
	210	+ XOR DX,DX
	211	+ MUL CL
	212	+USTARD:
	213	+ MOV [BP],AX
	214	+ MOV CELLSZ[BP],DX
	215	+ RET
	216	+
	217	+; _WORD_ SWAP swap top two cells on stack ( n1 n2 --- n2 n1 ):
	218	+SWAP
	219	+ MOV AX,[BP]
	220	+ MOV DX,CELLSZ[BP]
	221	+ MOV [BP],DX
	222	+ MOV CELLSZ[BP],AX
	223	+ RET
	224	+
	225	+; _WORD_ Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
	226	+; ( ud u --- uremainder uquotient )
	227	+; Run-time optimize for small numbers.
	228	+; Dividend should be range of product of 16 by 16 bit unsigned multiply,
	229	+; divisor should be the multiplier or multiplicand:
	230	+USLASH:
	231	+ MOV AX,CELLSZ[BP]
	232	+ MOV CX,[BP]
	233	+ MOV DX,CX
	234	+ OR DH,AH
	235	+ JZ USLASB
	236	+ DIV CX ; CX/AX => DX is modulus, AX is quotient
	237	+ JMP USLASD
	238	+USLASB:
	239	+ XOR DX,DX ; clear DX to receive low byte
	240	+ DIV CL ; CL/AL => AH is modulus, AL is quotient
	241	+ MOV DL,AH
	242	+ XOR AH,AH ; clear AH so AX is unsigned quotient
	243	+USLASD:
	244	+ MOV CELLSZ[BP],DX
	245	+ MOV [BP],AX
	246	+ RET
	247	+
	248	+; _WORD_ >L Save top cell on parameter stack to locals stack ( n --- ) { --- n }:
	249	+TOL:
	250	+ MOV AX,[BP]
	251	+ LEA BP,CELLSZ[BP]
	252	+ LEA SI,-CELLSZ[SI]
	253	+ MOV [SI],AX
	254	+ RET
	255	+
	256	+
	257	+; _WORD_ Save top cell on parameter stack to return stack ( n --- ) { --- n }:
	258	+TOR:
	259	+ MOV AX,[BP]
	260	+ LEA BP,CELLSZ[BP]
	261	+ POP BX ; return address, oh forgetful one!
	262	+ PUSH AX
	263	+ JMP BX
	264	+
	265	+; _WORD_ L> Pop top of locals stack to parameter stack ( --- n ) { n --- }:
	266	+LFROM:
	267	+ MOV AX,[SI]
	268	+ LEA SI,CELLSZ[SI]
	269	+ LEA BP,-CELLSZ[BP]
	270	+ MOV [BP],AX
	271	+ RET
	272	+
	273	+; _WORD_ Pop top of return stack to parameter stack ( --- n ) { n --- }:
	274	+RFROM:
	275	+ POP BX ; return address, oh forgetful one!
	276	+ POP AX
	277	+ LEA BP,-CELLSZ[BP]
	278	+ MOV [BP],AX
	279	+ JMP BX
	280	+
	281	+
	282	+* _WORD_ L Retrieve, do not pop top of locals stack to parameter stack ( --- n ) { n --- n }:
	283	+L:
	284	+ MOV AX,[SI]
	285	+ LEA BP,-CELLSZ[BP]
	286	+ MOV [BP],AX
	287	+ RET
	288	+
	289	+; _WORD_ Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }:
	290	+R:
	291	+ MOV BX,SP
	292	+ MOV AX,SS:CELLSZ[BX] ; skip return address, oh forgetful one!
	293	+ LEA BP,-CELLSZ[BP]
	294	+ MOV [BP],AX
	295	+ RET
	296	+
	297	+******
	298	+
	299	+; Should true be set as 1 or -1?
	300	+; Going with all bits False (0)
	301	+; or all bits True (-1) as the flag to set.
	302	+; D really doesn't help here.
	303	+; _WORD_ Test top cell on stack for zero ( n --- f(top==0) ):
	304	+ZEQU:
	305	+ LDX PSP
	306	+ CLRA
	307	+ LDAB 0,X
	308	+ ORAB 1,X
	309	+ BNE ZEQUF
	310	+ COMA
	311	+ZEQUF:
	312	+ STAA 0,X
	313	+ STAA 1,X
	314	+ RTS
	315	+;
	316	+; True as 1 would look like
	317	+; ZEQU
	318	+; LDX PSP
	319	+; CLRA
	320	+; LDAB 0,X
	321	+; ORAB 1,X
	322	+; BNE ZEQUF
	323	+; INCA
	324	+; ZEQUF
	325	+; CLR 0,X
	326	+; STAA 1,X
	327	+; RTS
	328	+
	329	+
	330	+
	331	+; _LOWORD_ Duplicate (count in B) bytes on stack:
	332	+NDUP:
	333	+; STX TEMP
	334	+
	335	+
	336	+
	337	+;***** Working in here to make it go both ways.
	338	+;***** Also need to check multiply and divide.
	339	+
	340	+
	341	+; _LOWORD_ Move 256 bytes or less:
	342	+; 0=256, do not enter without pretesting for 0 count!
	343	+; source in X, destination in Y, count in B:
	344	+; Overlaps only work if source is higher than dest.
	345	+SMOVE:
	346	+ LDA ,X+
	347	+ STA ,Y+
	348	+ DECB
	349	+ BNE SMOVE
	350	+ RTS
	351	+
	352	+; _WORD_ Move up to 32K bytes ( src dest count --- ):
	353	+; Copies zero when count >= 2^15
	354	+; Compare CMOVE in Forth.
	355	+BMOVE:
	356	+ LDX 2*ADRWDSZ,U ; src
	357	+ LDY ADRWDSZ,U ; dest
	358	+ LDD 0,U ; count
	359	+ BEQ BMOVEX ; Pre-test, do nothing if zero,
	360	+ BMI BMOVEX ; or too big.
	361	+BMOVEL: BSR SMOVE ; partial block and full blocks
	362	+ DEC 0,U ; count high byte down (blocks)
	363	+ BPL BMOVEL ; This limits the count.
	364	+BMOVEX: LEAU 3*ADRWDSZ,U
	365	+ RTS
	366	+
	367	+; _WORD_ Execute the address on the stack:
	368	+EXEC:
	369	+ JMP [,U++] ; For debugging and flattening, no early optimizations.
	370	+
	371	+
	372	+
	373	+COLDENT:
	374	+ MOV SP,RSTKINI
	375	+ MOV BP,SSTKINI
	376	+ MOV SI,LSTKINI
	377	+ MOV DI,UPGINI
	378	+WARMENT:
	379	+ EQU COLDENT
	380	+
	381	+
	382	+

Show on old repository browser