Kernel 0.94+

This commit is contained in:
Rémy GIBERT 2020-12-17 21:23:54 +01:00
parent 0f9ebec8be
commit 76c8a3dc5f
8 changed files with 381 additions and 318 deletions

View File

@ -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 | ( - ) | Working | Increment index, terminate loop if equal to limit |
| +LOOP | ( n - ) | Working | Increment index by n. Terminate loop if outside limit | | +LOOP | ( n - ) | Working | Increment index by n. Terminate loop if outside limit |
| I | ( - index ) | Working | Place loop index on stack | | 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 | | IF | ( f - ) | Working | If top of stack is true, execute true clause |
| ELSE | ( - ) | Working | Beginning of the false clause | | ELSE | ( - ) | Working | Beginning of the false clause |
| ENDIF | ( - ) | Working | End of the IF-ELSE structure | | ENDIF | ( - ) | Working | End of the IF-ELSE structure |

Binary file not shown.

View File

@ -13,37 +13,33 @@ CP.RUN cpx #KW.CONLY
.1 jmp (J.KEYWORDS,x) .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 #$00
jsr CP.Emit.PUSHBI >PUSHBI 0
lda #$01 >PUSHBI 1
jsr CP.Emit.PUSHBI
*--------------------------------------
CP.pLOOP jsr CP.Emit.LOOP
jsr CP.Emit.JMPBack
jsr CP.Emit.LOOPEND
inc RP
inc RP
clc clc
rts rts
*-------------------------------------- *--------------------------------------
CP.LOOP lda #$A9 lda #imm CP.I jsr CP.Emit.I
jsr CP.Emit.Byte
lda #$00
jsr CP.Emit.Byte
jsr CP.Emit.PUSHA
lda #$A9 lda #imm
jsr CP.Emit.Byte
lda #$01
jsr CP.Emit.Byte
jsr CP.Emit.PUSHA pushed n = 1
*--------------------------------------
CP.pLOOP >LDYA J.KEYWORDS.ADD MAX I n -> MAX NEWI
jsr CP.Emit.JsrYA
jsr CP.Emit.LOOP
jsr CP.Emit.JMPBack
jsr CP.Emit.LOOPEND
clc clc
rts rts
*-------------------------------------- *--------------------------------------
CP.I >LDYA J.KEYWORDS DUP CP.LEAVE jsr CP.Emit.LEAVE
jsr CP.Emit.JMPBack
clc
jmp CP.Emit.JsrYA
*--------------------------------------
CP.LEAVE
clc clc
rts rts
@ -55,7 +51,7 @@ CP.IF jsr CP.Emit.TESTTRUE
rts rts
*-------------------------------------- *--------------------------------------
CP.ELSE jsr CP.PopPtr1 get previous JMP -> ptr1 CP.ELSE jsr CP.PopPtr1 get previous JMP -> ptr1
jsr CP.Emit.JMP0000 to put jmp -> ENDIF later jsr CP.Emit.JMP0000 to put jmp -> ENDIF later
jsr CP.UpdatePtr1 jsr CP.UpdatePtr1
clc clc
@ -87,10 +83,164 @@ CP.REPEAT jsr CP.Emit.JMPBack
CP.WHILE jsr CP.Emit.TESTTRUE CP.WHILE jsr CP.Emit.TESTTRUE
jsr CP.Emit.JMPBack jsr CP.Emit.JMPBack
jsr CP.Emit.RPDROP2 jsr CP.Emit.RPDROP2
clc clc
rts rts
*-------------------------------------- *--------------------------------------
CP.Emit.JMP0000 lda #$4C JMP
jsr CP.Emit.Byte
jsr CP.PushCodePtr
lda #0
jsr CP.Emit.Byte
jsr CP.Emit.Byte
rts
*--------------------------------------
CP.Emit.JMPBack lda #$4C JMP
jsr CP.Emit.Byte
ldy RP
iny
lda (pData),y
jsr CP.Emit.Byte
iny
lda (pData),y
jmp CP.Emit.Byte
*--------------------------------------
CP.Emit.RPDROP2 ldx #CODE.RPDROP2.L
ldy #0
.1 lda CODE.RPDROP2,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.TESTTRUE
ldx #CODE.TESTTRUE.L
ldy #0
.1 lda CODE.TESTTRUE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.TESTFALSE
ldx #CODE.TESTFALSE.L
ldy #0
.1 lda CODE.TESTFALSE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.PULLA ldx #CODE.PULLA.L
ldy #0
.1 lda CODE.PULLA,y
jsr CP.Emit.Byte
iny
dex
bne .1
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
.1 lda CODE.PUSHA,y
jsr CP.Emit.Byte
iny
dex
bne .1
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
.1 lda CODE.LOOP,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LOOPEND ldx #CODE.LOOPEND.L
ldy #0
.1 lda CODE.LOOPEND,y
jsr CP.Emit.Byte
iny
dex
bne .1
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
tya
jsr CP.Emit.Byte
pla
*--------------------------------------
CP.Emit.Byte sta (ZPCodePtr)
inc ZPCodePtr
bne .8
inc ZPCodePtr+1
.8 rts
*--------------------------------------
CP.PushCodePtr ldy RP CP.PushCodePtr ldy RP
lda ZPCodePtr+1 lda ZPCodePtr+1
@ -125,121 +275,6 @@ CP.UpdatePtr1 lda ZPCodePtr
sta (ZPPtr1),y sta (ZPPtr1),y
rts rts
*-------------------------------------- *--------------------------------------
CP.Emit.JMP0000 lda #$4C JMP
jsr CP.Emit.Byte
jsr CP.PushCodePtr
lda #0
jsr CP.Emit.Byte
jsr CP.Emit.Byte
rts
*--------------------------------------
CP.Emit.JMPBack lda #$4C JMP
jsr CP.Emit.Byte
ldy RP
iny
lda (pData),y
jsr CP.Emit.Byte
iny
lda (pData),y
jmp CP.Emit.Byte
*--------------------------------------
CP.Emit.RPDROP2 ldx #CODE.RPDROP2.L
ldy #0
.1 lda CODE.RPDROP2,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.TESTTRUE
ldx #CODE.TESTTRUE.L
ldy #0
.1 lda CODE.TESTTRUE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.TESTFALSE
ldx #CODE.TESTFALSE.L
ldy #0
.1 lda CODE.TESTFALSE,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.PULLA ldx #CODE.PULLA.L
ldy #0
.1 lda CODE.PULLA,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.PUSHA ldx #CODE.PUSHA.L
ldy #0
.1 lda CODE.PUSHA,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LOOP ldx #CODE.LOOP.L
ldy #0
.1 lda CODE.LOOP,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.LOOPEND ldx #CODE.LOOPEND.L
ldy #0
.1 lda CODE.LOOPEND,y
jsr CP.Emit.Byte
iny
dex
bne .1
rts
*--------------------------------------
CP.Emit.JsrYA pha
lda #$20
jsr CP.Emit.Byte
tya
jsr CP.Emit.Byte
pla
*--------------------------------------
CP.Emit.Byte sta (ZPCodePtr)
inc ZPCodePtr
bne .8
inc ZPCodePtr+1
.8 rts
*--------------------------------------
MAN MAN
SAVE usr/src/bin/forth.s.cp SAVE usr/src/bin/forth.s.cp
LOAD usr/src/bin/forth.s LOAD usr/src/bin/forth.s

View File

@ -7,19 +7,16 @@ GFX.Open >PUSHBI 0
bcs .9 bcs .9
>STA.G hDevGFX >STA.G hDevGFX
* ldy #S.PS.hStdIn
* lda (pPS),y
* >SYSCALL GetMemPtr
* >STYA ZPPtr1
* ldy #S.FD.DEV.DEVID ldy #S.PS.hStdIn
* lda (ZPPtr1),y lda (pPS),y
bit #1
* >PUSHA beq .9
* >PUSHBI IOCTL.CONTROL
* >PUSHWI 0 >PUSHA
* >SYSCALL IOCTL >PUSHBI IOCTL.CONTROL
>PUSHWI 0
>SYSCALL IOCTL
.9 rts .9 rts
*-------------------------------------- *--------------------------------------
@ -27,79 +24,57 @@ GFX.Close >LDA.G hDevGFX
beq .9 beq .9
>SYSCALL Close >SYSCALL Close
.9 rts .9 rts
*-------------------------------------- *--------------------------------------
* (Y X C) * (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 lda pStack
clc clc
adc #6 adc #8
sta pStack sta pStack
clc
rts rts
*-------------------------------------- *--------------------------------------
* (Y2 X2 Y1 X1 C) * (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
>STA.G GFX.CB+S.CB.COLOR
>PULLA jsr GFX.WriteX
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 lda pStack
clc clc
adc #10 adc #12
sta pStack sta pStack
clc
rts 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
*-------------------------------------- *--------------------------------------
*-------------------------------------- *--------------------------------------
*-------------------------------------- *--------------------------------------

View File

@ -7,6 +7,7 @@ NEW
*-------------------------------------- *--------------------------------------
.INB inc/macros.i .INB inc/macros.i
.INB inc/a2osx.i .INB inc/a2osx.i
.INB inc/kernel.i
.INB inc/mli.i .INB inc/mli.i
.INB inc/mli.e.i .INB inc/mli.e.i
.INB inc/gfx.i .INB inc/gfx.i
@ -98,7 +99,7 @@ J.ESC .DA CL.BS left arrow
L.KEYWORDS .DA KEYWORDS L.KEYWORDS .DA KEYWORDS
J.KEYWORDS .DA GFX.PLOT J.KEYWORDS .DA GFX.PLOT
.DA GFX.RECT .DA GFX.RECT
.DA KW.DUP J.KEYWORDS.DUP .DA KW.DUP
.DA KW.DROP .DA KW.DROP
.DA KW.SWAP .DA KW.SWAP
J.KEYWORDS.OVER .DA KW.OVER J.KEYWORDS.OVER .DA KW.OVER
@ -266,7 +267,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS
stz bCompile stz bCompile
lda #127 lda #127
sta RP sta RP
jsr GFX.Open jsr GFX.Open
*-------------------------------------- *--------------------------------------
CS.RUN.LOOP >SLEEP CS.RUN.LOOP >SLEEP
@ -278,15 +279,15 @@ CS.RUN.LOOP >SLEEP
.2 jsr CS.FORTH.Run .2 jsr CS.FORTH.Run
bcs .7 bcs .7
>LDA.G hFile >LDA.G hFile
bne CS.RUN.LOOP bne CS.RUN.LOOP
>PUSHW L.MSG.OK >PUSHW L.MSG.OK
>PUSHBI 0 >PUSHBI 0
>SYSCALL PrintF >SYSCALL PrintF
bcs .99 bcs .99
bra CS.RUN.LOOP bra CS.RUN.LOOP
.7 cmp #MLI.E.EOF .7 cmp #MLI.E.EOF
@ -298,17 +299,17 @@ CS.RUN.LOOP >SLEEP
pha pha
>LDA.G hFile >LDA.G hFile
beq .71 beq .71
>LDA.G bTrace >LDA.G bTrace
bmi .70 bmi .70
jsr PrintTraceMsg jsr PrintTraceMsg
.70 pla .70 pla
pha pha
jsr PrintErrPtr jsr PrintErrPtr
bra .9 bra .9
.71 pla .71 pla
>PUSHA >PUSHA
@ -360,7 +361,7 @@ CS.FORTH.Run jsr CL.Reset
*-------------------------------------- *--------------------------------------
CS.FORTH.Run.File CS.FORTH.Run.File
>INCW.G LineCounter >INCW.G LineCounter
>PUSHWI 256 >PUSHWI 256
>PUSHW ZPCLBuf >PUSHW ZPCLBuf
@ -399,7 +400,7 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
jsr IsSpaceOrCR jsr IsSpaceOrCR
bcc .1 bcc .1
jsr NextChar jsr NextChar
bra CS.RUN.EXEC bra CS.RUN.EXEC
@ -417,8 +418,17 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
bit ZPType bit ZPType
bmi .4 CODE bmi .4 CODE
bit bCompile
bmi .3
>PUSHW ZPAddrPtr CONSTANT,VARIABLE >PUSHW ZPAddrPtr CONSTANT,VARIABLE
bra CS.RUN.EXEC 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 .4 bit bCompile
bmi .40 bmi .40
@ -445,7 +455,7 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
cpx #KW.CONLY cpx #KW.CONLY
bcc .70 bcc .70
lda #E.SYN lda #E.SYN
sec sec
rts rts
@ -559,7 +569,7 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
sta (pStack),y sta (pStack),y
inc pStack inc pStack
* clc * clc
.9 rts .9 rts
@ -570,14 +580,14 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
jsr CP.Emit.Byte jsr CP.Emit.Byte
jsr CP.Emit.PUSHA jsr CP.Emit.PUSHA
lda #$A9 lda #imm lda #$A9 lda #imm
jsr CP.Emit.Byte jsr CP.Emit.Byte
lda (pStack) lda (pStack)
jsr CP.Emit.Byte jsr CP.Emit.Byte
jsr CP.Emit.PUSHA jsr CP.Emit.PUSHA
>RET 4 >RET 4
*-------------------------------------- *--------------------------------------
CS.DOEVENT sec CS.DOEVENT sec
@ -630,7 +640,7 @@ PrintDebugMsg >PUSHW L.MSG.DEBUG
>PUSHB RP >PUSHB RP
>PUSHBI 6 >PUSHBI 6
>SYSCALL PrintF >SYSCALL PrintF
rts rts
*-------------------------------------- *--------------------------------------
PrintTraceMsg ldy #S.PS.hStdErr PrintTraceMsg ldy #S.PS.hStdErr
@ -651,25 +661,25 @@ PrintErrPtr lda ZPCLBufPtr
sbc ZPCLBuf sbc ZPCLBuf
tax tax
ldy #0 ldy #0
lda #C.SPACE lda #C.SPACE
.1 sta (ZPCLBuf),y .1 sta (ZPCLBuf),y
iny iny
cpy #7 cpy #7
bne .1 bne .1
txa txa
beq .3 beq .3
lda #'-' lda #'-'
.2 sta (ZPCLBuf),y .2 sta (ZPCLBuf),y
iny iny
dex dex
bne .2 bne .2
.3 lda #'^' .3 lda #'^'
sta (ZPCLBuf),y sta (ZPCLBuf),y
iny iny
@ -681,14 +691,14 @@ PrintErrPtr lda ZPCLBufPtr
lda #C.LF lda #C.LF
sta (ZPCLBuf),y sta (ZPCLBuf),y
iny iny
txa txa
sta (ZPCLBuf),y sta (ZPCLBuf),y
ldy #S.PS.hStdErr ldy #S.PS.hStdErr
lda (pPS),y lda (pPS),y
>PUSHA >PUSHA
>PUSHW ZPCLBuf >PUSHW ZPCLBuf
>SYSCALL FPutS >SYSCALL FPutS
@ -755,12 +765,12 @@ IsSpaceOrCR cmp #C.SPACE CS=TRUE
beq .8 beq .8
clc clc
.8 rts .8 rts
*-------------------------------------- *--------------------------------------
CheckStackPop4 lda pStack CheckStackPop4 lda pStack
beq .9 beq .9
cmp #$FD cmp #$FD
bcs .9 bcs .9
@ -932,25 +942,80 @@ CODE.PULLA.L .EQ *-CODE.PULLA
CODE.PUSHA >PUSHA CODE.PUSHA >PUSHA
CODE.PUSHA.L .EQ *-CODE.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
ldx #4
.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
lda (pStack),y >PULLA
sbc (pStack) iny
adc (pData),y
sta (pData),y
dec pStack dey
lda (pData),y
iny
iny
cmp (pData),y
dey
lda (pData),y
iny
iny
sbc (pData),y
.1 bcc .1+5 .1 bcs .1+5
CODE.LOOP.L .EQ *-CODE.LOOP CODE.LOOP.L .EQ *-CODE.LOOP
*-------------------------------------- *--------------------------------------
CODE.LOOPEND lda pStack POP 4 bytes CODE.LOOPEND lda RP POP 4 bytes
clc clc
adc #4 adc #4
sta pStack sta RP
clc clc
CODE.LOOPEND.L .EQ *-CODE.LOOPEND 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 .DUMMY
.OR 0 .OR 0

View File

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

View File

@ -1,84 +1,71 @@
NEW NEW
AUTO 3,1 AUTO 3,1
#!/bin/forth #!/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
\for y in range(0,200)
\ for x in range(0,300)
\ zx = 0
\ zy = 0
\ 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
\ Translate escape count to ascii greyscale. : CELL
: .CHAR 0 ZX !
S" ..,'~!^:;[/<&?oxOX# " 0 ZY !
DROP + 1 0 ITER !
TYPE ; X CENTERX - ZOOM / CX !
Y CENTERY - ZOOM / CY !
MAXITER 0 DO
ZX ZX * ZX2 !
ZY ZY * ZY2 !
ZX2 ZY2 + 4 > IF I ITER ! LEAVE ENDIF
ZX2 ZY2 - CX + TMP !
ZX ZY * 2 * CY + ZY !
TMP ZX !
LOOP
\ Y 4 / X ITER PLOT
Y @ . X @ . ITER @ . CR ;
\ Numbers above 4 will always escape, so compare to a scaled value.
: ESCAPES?
S_ESCAPE > ;
\ Increment count and compare to max iterations.
: COUNT_AND_TEST?
COUNT @ 1+ DUP COUNT !
MAXITER > ;
\ stores the row column values from the stack for the escape calculation.
: INIT_VARS
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 ;
\ For each row in the set.
: MANDELBROT : MANDELBROT
CR \ 191 559 0 0 0 RECT
MAXVAL MINVAL DO MAXY 0 DO
I DOROW CR I Y !
LOOP ; MAXX 0 DO
I X !
CELL
LOOP
LOOP ;
\ Run the computation.
MANDELBROT MANDELBROT
MAN MAN
TEXT root/mandelbrot.f TEXT root/mandelbrot.f

View File

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