Apple-2-SW
/
A2osX
mirror of https://github.com/A2osX/A2osX.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.Docs/Forth Words.md
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 | ( 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
.Floppies/A2OSX.BUILD.po
View File

Binary file not shown.

317
BIN/FORTH.S.CP.txt
View File

@ -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 #$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
rts
*--------------------------------------
CP.LOOP lda #$A9 lda #imm
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
CP.I jsr CP.Emit.I
clc
rts
*--------------------------------------
CP.I >LDYA J.KEYWORDS DUP
clc
jmp CP.Emit.JsrYA
*--------------------------------------
CP.LEAVE
CP.LEAVE jsr CP.Emit.LEAVE
jsr CP.Emit.JMPBack
clc
rts
@ -55,7 +51,7 @@ CP.IF jsr CP.Emit.TESTTRUE
rts
*--------------------------------------
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
clc
@ -87,10 +83,164 @@ CP.REPEAT jsr CP.Emit.JMPBack
CP.WHILE jsr CP.Emit.TESTTRUE
jsr CP.Emit.JMPBack
jsr CP.Emit.RPDROP2
clc
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
lda ZPCodePtr+1
@ -125,121 +275,6 @@ CP.UpdatePtr1 lda ZPCodePtr
sta (ZPPtr1),y
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
SAVE usr/src/bin/forth.s.cp
LOAD usr/src/bin/forth.s

109
BIN/FORTH.S.GFX.txt
View File

@ -7,19 +7,16 @@ GFX.Open >PUSHBI 0
bcs .9
>STA.G hDevGFX
* ldy #S.PS.hStdIn
* lda (pPS),y
* >SYSCALL GetMemPtr
* >STYA ZPPtr1
* ldy #S.FD.DEV.DEVID
* lda (ZPPtr1),y
* >PUSHA
* >PUSHBI IOCTL.CONTROL
* >PUSHWI 0
* >SYSCALL IOCTL
ldy #S.PS.hStdIn
lda (pPS),y
bit #1
beq .9
>PUSHA
>PUSHBI IOCTL.CONTROL
>PUSHWI 0
>SYSCALL IOCTL
.9 rts
*--------------------------------------
@ -27,79 +24,57 @@ GFX.Close >LDA.G hDevGFX
beq .9
>SYSCALL Close
.9 rts
.9 rts
*--------------------------------------
* (Y X C)
*--------------------------------------
GFX.PLOT lda #S.CB.CMD.SETPIXEL
>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
ldx #4
ldy #GFX.CB+S.CB.X1+3
GFX.PLOT ldx #S.CB.CMD.SETPIXEL
jsr GFX.WriteX
.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
>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
GFX.RECT ldx #S.CB.CMD.FILLRECT
>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
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
*--------------------------------------
*--------------------------------------
*--------------------------------------

137
BIN/FORTH.S.txt
View File

@ -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
@ -266,7 +267,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS
stz bCompile
lda #127
sta RP
jsr GFX.Open
*--------------------------------------
CS.RUN.LOOP >SLEEP
@ -278,15 +279,15 @@ CS.RUN.LOOP >SLEEP
.2 jsr CS.FORTH.Run
bcs .7
>LDA.G hFile
bne CS.RUN.LOOP
>PUSHW L.MSG.OK
>PUSHBI 0
>SYSCALL PrintF
bcs .99
bra CS.RUN.LOOP
.7 cmp #MLI.E.EOF
@ -298,17 +299,17 @@ CS.RUN.LOOP >SLEEP
pha
>LDA.G hFile
beq .71
>LDA.G bTrace
bmi .70
jsr PrintTraceMsg
.70 pla
pha
jsr PrintErrPtr
bra .9
.71 pla
>PUSHA
@ -360,7 +361,7 @@ CS.FORTH.Run jsr CL.Reset
*--------------------------------------
CS.FORTH.Run.File
>INCW.G LineCounter
>PUSHWI 256
>PUSHW ZPCLBuf
@ -399,7 +400,7 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
jsr IsSpaceOrCR
bcc .1
jsr NextChar
bra CS.RUN.EXEC
@ -417,8 +418,17 @@ 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
@ -445,7 +455,7 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
cpx #KW.CONLY
bcc .70
lda #E.SYN
sec
rts
@ -559,7 +569,7 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
sta (pStack),y
inc pStack
* clc
.9 rts
@ -570,14 +580,14 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
jsr CP.Emit.Byte
jsr CP.Emit.PUSHA
lda #$A9 lda #imm
jsr CP.Emit.Byte
lda (pStack)
jsr CP.Emit.Byte
jsr CP.Emit.PUSHA
>RET 4
*--------------------------------------
CS.DOEVENT sec
@ -630,7 +640,7 @@ PrintDebugMsg >PUSHW L.MSG.DEBUG
>PUSHB RP
>PUSHBI 6
>SYSCALL PrintF
rts
*--------------------------------------
PrintTraceMsg ldy #S.PS.hStdErr
@ -651,25 +661,25 @@ PrintErrPtr lda ZPCLBufPtr
sbc ZPCLBuf
tax
ldy #0
lda #C.SPACE
.1 sta (ZPCLBuf),y
iny
cpy #7
bne .1
txa
beq .3
lda #'-'
.2 sta (ZPCLBuf),y
iny
dex
bne .2
.3 lda #'^'
sta (ZPCLBuf),y
iny
@ -681,14 +691,14 @@ PrintErrPtr lda ZPCLBufPtr
lda #C.LF
sta (ZPCLBuf),y
iny
txa
sta (ZPCLBuf),y
ldy #S.PS.hStdErr
lda (pPS),y
>PUSHA
>PUSHW ZPCLBuf
>SYSCALL FPutS
@ -755,12 +765,12 @@ IsSpaceOrCR cmp #C.SPACE CS=TRUE
beq .8
clc
.8 rts
*--------------------------------------
CheckStackPop4 lda pStack
beq .9
cmp #$FD
bcs .9
@ -932,25 +942,80 @@ CODE.PULLA.L .EQ *-CODE.PULLA
CODE.PUSHA >PUSHA
CODE.PUSHA.L .EQ *-CODE.PUSHA
*--------------------------------------
CODE.LOOP ldy #2
lda (pStack),y
cmp (pStack)
inc pStack
CODE.DO lda RP
sec
sbc #4
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
sbc (pStack)
>PULLA
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.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

1
DRV/DHGR.DRV.S.LINE.txt
View File

@ -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

131
EXAMPLES/MANDELBROT.F.txt
View File

@ -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.
0 VARIABLE CREAL
0 VARIABLE CIMAG
0 VARIABLE ZREAL
0 VARIABLE ZIMAG
0 VARIABLE COUNT
140 CONSTANT MAXX
70 CONSTANT CENTERX
192 CONSTANT MAXY
92 CONSTANT CENTERY
100 CONSTANT ZOOM
16 CONSTANT MAXITER
\ Compute squares, but rescale to remove extra scaling factor.
: ZR_SQ ZREAL @ DUP RESCALE */ ;
: ZI_SQ ZIMAG @ DUP RESCALE */ ;
0 VARIABLE X
0 VARIABLE Y
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.
: .CHAR
S" ..,'~!^:;[/<&?oxOX# "
DROP + 1
TYPE ;
: CELL
0 ZX !
0 ZY !
0 ITER !
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
CR
MAXVAL MINVAL DO
I DOROW CR
LOOP ;
\ 191 559 0 0 0 RECT
MAXY 0 DO
I Y !
MAXX 0 DO
I X !
CELL
LOOP
LOOP ;
\ Run the computation.
MANDELBROT
MAN
TEXT root/mandelbrot.f

2
SBIN/TELNETD.S.txt
View File

@ -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