Kernel 0.94+

.Docs/Forth Words.md

@@ -98,7 +98,7 @@ This document lists all of the **Forth Words** supported in the A2osX implementa
 | LOOP | ( - ) | Working | Increment index, terminate loop if equal to limit |
 | +LOOP | ( n - ) | Working | Increment index by n. Terminate loop if outside limit |
 | I | ( - index ) | Working | Place loop index on stack |
-| LEAVE | ( - ) | | Terminate loop at next LOOP or +LOOP |
+| LEAVE | ( - ) | Working | Terminate loop at next LOOP or +LOOP |
 | IF | ( f - ) | Working | If top of stack is true, execute true clause |
 | ELSE | ( - ) | Working | Beginning of the false clause |
 | ENDIF | ( - ) | Working | End of the IF-ELSE structure |

BIN/FORTH.S.CP.txt

@@ -13,37 +13,33 @@ CP.RUN			cpx #KW.CONLY
 
 .1				jmp (J.KEYWORDS,x)
 *--------------------------------------
-CP.DO			jsr CP.PushCodePtr		for compiling LOOP later
+CP.DO			jsr CP.Emit.DO
-
+				jsr CP.PushCodePtr		for compiling LOOP later
 				clc
 				rts
 *--------------------------------------
-CP.LOOP			lda #$A9				lda #imm
+CP.LOOP			lda #$00
-				jsr CP.Emit.Byte
+				jsr CP.Emit.PUSHBI		>PUSHBI 0
-				lda #$00
-				jsr CP.Emit.Byte
-				jsr CP.Emit.PUSHA				
 
-				lda #$A9				lda #imm
+				lda #$01				>PUSHBI 1
-				jsr CP.Emit.Byte
+				jsr CP.Emit.PUSHBI
-				lda #$01
-				jsr CP.Emit.Byte
-				jsr CP.Emit.PUSHA		pushed n = 1			
 *--------------------------------------
-CP.pLOOP		>LDYA J.KEYWORDS.ADD	MAX I n	-> MAX NEWI
+CP.pLOOP		jsr CP.Emit.LOOP
-				jsr CP.Emit.JsrYA
-				jsr CP.Emit.LOOP
 				jsr CP.Emit.JMPBack
 				jsr CP.Emit.LOOPEND
+
+				inc RP
+				inc RP
+
 				clc
 				rts
 *--------------------------------------
-CP.I			>LDYA J.KEYWORDS		DUP
+CP.I			jsr CP.Emit.I
-			
 				clc
-				jmp CP.Emit.JsrYA			
+				rts
 *--------------------------------------
-CP.LEAVE
+CP.LEAVE		jsr CP.Emit.LEAVE
+				jsr CP.Emit.JMPBack
 
 				clc
 				rts
@@ -91,40 +87,6 @@ CP.WHILE		jsr CP.Emit.TESTTRUE
 				clc
 				rts
 *--------------------------------------
-CP.PushCodePtr	ldy RP
-
-				lda ZPCodePtr+1
-				sta (pData),y
-				dey
-
-				lda ZPCodePtr
-				sta (pData),y
-				dey
-
-				sty RP
-				rts
-*--------------------------------------
-CP.PopPtr1		ldy RP
-				iny
-				lda (pData),y
-				sta ZPPtr1
-
-				iny
-				lda (pData),y
-				sta ZPPtr1+1
-
-				sty RP
-
-				rts
-*--------------------------------------
-CP.UpdatePtr1	lda ZPCodePtr
-				sta (ZPPtr1)
-
-				ldy #1
-				lda ZPCodePtr+1
-				sta (ZPPtr1),y
-				rts
-*--------------------------------------
 CP.Emit.JMP0000	lda #$4C				JMP
 				jsr CP.Emit.Byte
 
@@ -194,6 +156,12 @@ CP.Emit.PULLA	ldx #CODE.PULLA.L
 
 				rts
 *--------------------------------------
+CP.Emit.PUSHBI	pha
+				lda #$A9				lda #imm
+				jsr CP.Emit.Byte
+				pla
+				jsr CP.Emit.Byte
+*--------------------------------------
 CP.Emit.PUSHA	ldx #CODE.PUSHA.L
 				ldy #0
 
@@ -205,6 +173,17 @@ CP.Emit.PUSHA	ldx #CODE.PUSHA.L
 
 				rts
 *--------------------------------------
+CP.Emit.DO		ldx #CODE.DO.L
+				ldy #0
+
+.1				lda CODE.DO,y
+				jsr CP.Emit.Byte
+				iny
+				dex
+				bne .1
+
+				rts
+*--------------------------------------
 CP.Emit.LOOP	ldx #CODE.LOOP.L
 				ldy #0
 
@@ -227,6 +206,28 @@ CP.Emit.LOOPEND	ldx #CODE.LOOPEND.L
 
 				rts
 *--------------------------------------
+CP.Emit.I		ldx #CODE.I.L
+				ldy #0
+
+.1				lda CODE.I,y
+				jsr CP.Emit.Byte
+				iny
+				dex
+				bne .1
+
+				rts
+*--------------------------------------
+CP.Emit.LEAVE	ldx #CODE.LEAVE.L
+				ldy #0
+
+.1				lda CODE.LEAVE,y
+				jsr CP.Emit.Byte
+				iny
+				dex
+				bne .1
+
+				rts
+*--------------------------------------
 CP.Emit.JsrYA	pha
 				lda #$20
 				jsr CP.Emit.Byte
@@ -240,6 +241,40 @@ CP.Emit.Byte	sta (ZPCodePtr)
 				inc ZPCodePtr+1
 .8				rts
 *--------------------------------------
+CP.PushCodePtr	ldy RP
+
+				lda ZPCodePtr+1
+				sta (pData),y
+				dey
+
+				lda ZPCodePtr
+				sta (pData),y
+				dey
+
+				sty RP
+				rts
+*--------------------------------------
+CP.PopPtr1		ldy RP
+				iny
+				lda (pData),y
+				sta ZPPtr1
+
+				iny
+				lda (pData),y
+				sta ZPPtr1+1
+
+				sty RP
+
+				rts
+*--------------------------------------
+CP.UpdatePtr1	lda ZPCodePtr
+				sta (ZPPtr1)
+
+				ldy #1
+				lda ZPCodePtr+1
+				sta (ZPPtr1),y
+				rts
+*--------------------------------------
 MAN
 SAVE usr/src/bin/forth.s.cp
 LOAD usr/src/bin/forth.s

BIN/FORTH.S.GFX.txt

@@ -8,18 +8,15 @@ GFX.Open		>PUSHBI 0
 
 				>STA.G hDevGFX
 
-*				ldy #S.PS.hStdIn
+				ldy #S.PS.hStdIn
-*				lda (pPS),y
+				lda (pPS),y
-*				>SYSCALL GetMemPtr
+				bit #1
-*				>STYA ZPPtr1
+				beq .9
 
-*				ldy #S.FD.DEV.DEVID
+				>PUSHA
-*				lda (ZPPtr1),y
+				>PUSHBI IOCTL.CONTROL
-				
+				>PUSHWI 0
-*				>PUSHA
+				>SYSCALL IOCTL
-*				>PUSHBI IOCTL.CONTROL
-*				>PUSHWI 0
-*				>SYSCALL IOCTL
 
 .9				rts
 *--------------------------------------
@@ -32,74 +29,52 @@ GFX.Close		>LDA.G hDevGFX
 *--------------------------------------
 * (Y X C)
 *--------------------------------------
-GFX.PLOT		lda #S.CB.CMD.SETPIXEL
+GFX.PLOT		ldx #S.CB.CMD.SETPIXEL
-				>STA.G GFX.CB+S.CB.CMD 
+				jsr GFX.WriteX
-				lda #S.CB.OP.SET
-				>STA.G GFX.CB+S.CB.OP
-				lda #S.CB.M.C16
-				>STA.G GFX.CB+S.CB.M
-				
-				>PULLA
-				>STA.G GFX.CB+S.CB.COLOR
-				
-				>PULLA
-				
-				ldx #4
-				ldy #GFX.CB+S.CB.X1+3
-
-.1				>PULLA
-				sta (pData),y
-				dey
-				dex
-				bne .1
-				
-				>PUSHB.G hDevGFX
-				>PUSHBI IOCTL.WRITE
-				>PUSHEA.G GFX.CB
-				>SYSCALL IOCTL
 
 				lda pStack
 				clc
-				adc #6
+				adc #8
 				sta pStack
-				
+				clc
 				rts
 *--------------------------------------
 * (Y2 X2 Y1 X1 C)
 *--------------------------------------
-GFX.RECT		lda #S.CB.CMD.FILLRECT
+GFX.RECT		ldx #S.CB.CMD.FILLRECT
-				>STA.G GFX.CB+S.CB.CMD 
-				lda #S.CB.OP.SET
-				>STA.G GFX.CB+S.CB.OP
-				lda #S.CB.M.C16
-				>STA.G GFX.CB+S.CB.M
 
-				>PULLA
+				jsr GFX.WriteX
-				>STA.G GFX.CB+S.CB.COLOR
-
-				>PULLA
-
-				ldx #8
-				ldy #GFX.CB+S.CB.X1+7
-
-.1				>PULLA
-				sta (pData),y
-				dey
-				dex
-				bne .1
-				
-				>PUSHB.G hDevGFX
-				>PUSHBI IOCTL.WRITE
-				>PUSHEA.G GFX.CB
-				>SYSCALL IOCTL
 
 				lda pStack
 				clc
-				adc #10
+				adc #12
 				sta pStack
-				
+				clc
 				rts
 *--------------------------------------
+GFX.WriteX		ldy #1
+				lda (pStack)
+				sta (pStack),y
+
+				lda #S.CB.M.MONO
+				sta (pStack)
+
+				>PUSHBI S.CB.OP.SET
+				txa
+				>PUSHA
+
+				>PUSHB.G hDevGFX
+				>PUSHBI IOCTL.WRITE
+				lda pStack
+				clc
+				adc #2
+				tay
+				lda pStack+1
+				adc #0
+				>PUSHYA
+				>SYSCALL IOCTL
+			clc							DHGR.DRV bug ?	
+				rts
 *--------------------------------------
 *--------------------------------------
 *--------------------------------------

BIN/FORTH.S.txt

@@ -7,6 +7,7 @@ NEW
 *--------------------------------------
 				.INB inc/macros.i
 				.INB inc/a2osx.i
+				.INB inc/kernel.i
 				.INB inc/mli.i
 				.INB inc/mli.e.i
 				.INB inc/gfx.i
@@ -98,7 +99,7 @@ J.ESC			.DA CL.BS			left arrow
 L.KEYWORDS		.DA KEYWORDS
 J.KEYWORDS		.DA GFX.PLOT
 				.DA GFX.RECT
-				.DA KW.DUP
+J.KEYWORDS.DUP	.DA KW.DUP
 				.DA KW.DROP
 				.DA KW.SWAP
 J.KEYWORDS.OVER	.DA KW.OVER
@@ -417,9 +418,18 @@ CS.RUN.EXEC		lda (ZPCLBufPtr)
 				bit ZPType
 				bmi .4					CODE
 
+				bit bCompile
+				bmi .3
+				
 				>PUSHW ZPAddrPtr		CONSTANT,VARIABLE
 				bra CS.RUN.EXEC
 
+.3				lda ZPAddrPtr+1			VARIABLE : push addr, CONSTANT : push value
+				jsr CP.Emit.PUSHBI
+				lda ZPAddrPtr
+				jsr CP.Emit.PUSHBI
+				bra CS.RUN.EXEC
+				
 .4				bit bCompile
 				bmi .40
 
@@ -932,25 +942,80 @@ CODE.PULLA.L	.EQ *-CODE.PULLA
 CODE.PUSHA		>PUSHA
 CODE.PUSHA.L	.EQ *-CODE.PUSHA
 *--------------------------------------
-CODE.LOOP		ldy #2
+CODE.DO			lda RP
-				lda (pStack),y
+				sec
-				cmp (pStack)
+				sbc #4
-				inc pStack
+				sta RP
+				tay
 				
-				lda (pStack),y
+				ldx #4
-				sbc (pStack)
 				
-				dec pStack
+.1				>PULLA
+				sta (pData),y
+				iny
+				dex
+				bne .1
+CODE.DO.L		.EQ *-CODE.DO
+*--------------------------------------
+CODE.LOOP		>PULLA
+				ldy RP
+				clc
+				adc (pData),y
+				sta (pData),y
 
-.1				bcc .1+5				
+				>PULLA
+				iny
+				adc (pData),y
+				sta (pData),y
+
+				dey
+				
+				lda (pData),y
+				iny
+				iny
+				cmp (pData),y
+				
+				dey
+				
+				lda (pData),y
+				iny
+				iny
+				sbc (pData),y
+
+.1				bcs .1+5
 CODE.LOOP.L		.EQ *-CODE.LOOP
 *--------------------------------------
-CODE.LOOPEND	lda pStack				POP 4 bytes
+CODE.LOOPEND	lda RP					POP 4 bytes
 				clc
 				adc #4
-				sta pStack
+				sta RP
 				clc
 CODE.LOOPEND.L	.EQ *-CODE.LOOPEND
+*--------------------------------------
+CODE.I			ldy RP
+				iny
+				lda (pData),y
+				>PUSHA
+				dey
+				lda (pData),y
+				>PUSHA
+CODE.I.L		.EQ *-CODE.I
+*--------------------------------------
+CODE.LEAVE		ldy RP
+				iny
+				iny
+				lda (pData),y
+				tax
+				iny
+				lda (pData),y
+				dey
+				dey
+				sta (pData),y
+				txa
+				dey
+				sta (pData),y
+				>DEBUG
+CODE.LEAVE.L	.EQ *-CODE.LEAVE
 *--------------------------------------
 				.DUMMY
 				.OR 0

DRV/DHGR.DRV.S.LINE.txt

@@ -19,6 +19,7 @@ HLINE.MONO		>LDYA CB.Cache+S.CB.X1
 				lda #%01111111
 
 .1				ldx LBUF.C1
+
 .2				sta LBUF.DATA,x
 				cpx LBUF.C2
 				inx

EXAMPLES/MANDELBROT.F.txt

@@ -1,84 +1,71 @@
 NEW
   AUTO 3,1
 #!/bin/forth
-\ Setup constants to remove magic numbers to allow
-\ for greater zoom with different scale factors.
-20 CONSTANT MAXITER
--39 CONSTANT MINVAL
-40 CONSTANT MAXVAL
-20 32 * CONSTANT RESCALE
-RESCALE 4 * CONSTANT S_ESCAPE
 
-\ These variables hold values during the escape calculation.
+140 CONSTANT MAXX
-0 VARIABLE CREAL
+70 CONSTANT CENTERX 
-0 VARIABLE CIMAG
+192 CONSTANT MAXY
-0 VARIABLE ZREAL
+92 CONSTANT CENTERY 
-0 VARIABLE ZIMAG
+100 CONSTANT ZOOM
-0 VARIABLE COUNT
+16 CONSTANT MAXITER
 
-\ Compute squares, but rescale to remove extra scaling factor.
+0 VARIABLE X
-: ZR_SQ ZREAL @ DUP RESCALE */ ;
+0 VARIABLE Y
-: ZI_SQ ZIMAG @ DUP RESCALE */ ;
+0 VARIABLE ZX
+0 VARIABLE ZY
+0 VARIABLE ZX2
+0 VARIABLE ZY2
+0 VARIABLE CX
+0 VARIABLE CY
+0 VARIABLE TMP
+0 VARIABLE ITER
  
-\ Translate escape count to ascii greyscale.
+\for y in range(0,200)
-: .CHAR
+\	for x in range(0,300)
-  S" ..,'~!^:;[/<&?oxOX#  "
+\		zx = 0
-  DROP + 1
+\		zy = 0
-  TYPE ;
+\		cx = (x - 200) / ZOOM
+\		cy = (y - 100) / ZOOM
+\		for iter in range(MAX_ITER)
+\			if zx*zx + zy*zy > 4 then break
+\			tmp = zx * zx - zy * zy + cx
+\			zy = 2 * zx * zy + cy
+\			zx = tmp
+\		end for
+\		if iter then
+\			gfx.setPixel x, y, rgb(255-iter*6, 0, iter*6)
+\		end if
+\	end for
+\end for
 
-\ Numbers above 4 will always escape, so compare to a scaled value.
+: CELL
-: ESCAPES?
+	0 ZX !
-  S_ESCAPE > ;
+	0 ZY !
+	0 ITER !
+	X CENTERX - ZOOM / CX !
+	Y CENTERY - ZOOM / CY !
 	
-\ Increment count and compare to max iterations.
+	MAXITER 0 DO
-: COUNT_AND_TEST?
+		ZX ZX * ZX2 !
-  COUNT @ 1+ DUP COUNT !
+		ZY ZY * ZY2 !
-  MAXITER > ;
+		ZX2 ZY2 + 4 > IF I ITER ! LEAVE ENDIF
-
+		ZX2 ZY2 - CX + TMP !
-\ stores the row column values from the stack for the escape calculation.
+		ZX ZY * 2 * CY + ZY !
-: INIT_VARS
+		TMP ZX !
-  32 * DUP CREAL ! ZREAL !
-  32 * DUP CIMAG ! ZIMAG !
-  1 COUNT ! ;
-
-\ Performs a single iteration of the escape calculation.
-: DOESCAPE
-    ZR_SQ ZI_SQ 2DUP +
-    ESCAPES? IF
-      DROP DROP 1
-    ELSE
-      - CREAL @ +   \ leave result on stack
-      ZREAL @ ZIMAG @ RESCALE */ 2 *
-      CIMAG @ + ZIMAG !
-      ZREAL !                   \ Store stack item into ZREAL
-      COUNT_AND_TEST?
-    ENDIF ;
-
-\ Iterates on a single cell to compute its escape factor.
-: DOCELL
-  INIT_VARS
-  BEGIN
-    DOESCAPE
-  UNTIL
-  COUNT @
-  .CHAR ;
-
-\ For each cell in a row.
-: DOROW
-  MAXVAL MINVAL DO
-    DUP I
-    DOCELL
 		LOOP
-  DROP ;
+\	Y 4 / X ITER PLOT
+	Y @ . X @ . ITER @ . CR ;
 
-\ For each row in the set.
 : MANDELBROT
-  CR
+\  191 559 0 0 0 RECT
-  MAXVAL MINVAL DO
+  MAXY 0 DO
-    I DOROW CR
+    I Y !
+	MAXX 0 DO
+		I X !
+		CELL
+		LOOP
 	LOOP ;
 
-\ Run the computation.
 MANDELBROT
 MAN
 TEXT root/mandelbrot.f

SBIN/TELNETD.S.txt

@@ -185,7 +185,7 @@ CS.RUN.CLIENT	>SLEEP					give some time for TCPIP SYN/ACK
 				>PUSHBI 1
 				>SYSCALL SPrintF
 
-CS.RUN.CLIENT1	>PUSHEA.G NodBuf
+CS.RUN.CLIENT1	>PUSHEA.G NodBuf+5
 				>PUSHW 0
 				>PUSHB hClientSocket
 				>SYSCALL MKNod