mirror of
https://github.com/A2osX/A2osX.git
synced 2025-08-11 21:25:11 +00:00
Kernel 0.94
This commit is contained in:
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,9 +1,34 @@
|
||||
NEW
|
||||
AUTO 3,1
|
||||
*--------------------------------------
|
||||
CP.RUN >LDYA J.KEYWORDS,x
|
||||
CP.RUN bcs .1 > A2
|
||||
|
||||
>LDYA J.KEYWORDS,x
|
||||
clc
|
||||
jmp EmitJsrYA
|
||||
|
||||
.1 jmp (J.CP-$A4,x)
|
||||
*--------------------------------------
|
||||
CP.VARIABLE
|
||||
*--------------------------------------
|
||||
CP.CONSTANT
|
||||
*--------------------------------------
|
||||
CP.ACODE
|
||||
*--------------------------------------
|
||||
CP.FCODE
|
||||
*--------------------------------------
|
||||
CP.DO
|
||||
*--------------------------------------
|
||||
CP.LOOP
|
||||
*--------------------------------------
|
||||
CP.pLOOP
|
||||
*--------------------------------------
|
||||
CP.I
|
||||
*--------------------------------------
|
||||
CP.LEAVE
|
||||
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
CP.IF jsr EmitPullA
|
||||
jsr EmitPullA
|
||||
@@ -33,6 +58,8 @@ CP.IF jsr EmitPullA
|
||||
|
||||
lda #0
|
||||
jsr EmitByte
|
||||
|
||||
clc
|
||||
jmp EmitByte
|
||||
*--------------------------------------
|
||||
CP.ELSE
|
||||
@@ -61,6 +88,63 @@ CP.ENDIF ldy RP
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
CP.BEGIN
|
||||
*--------------------------------------
|
||||
CP.UNTIL
|
||||
*--------------------------------------
|
||||
CP.REPEAT
|
||||
*--------------------------------------
|
||||
CP.WHILE
|
||||
|
||||
*--------------------------------------
|
||||
CP.COMMENT
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
EmitPullA lda #$B2 lda (zp)
|
||||
jsr EmitByte
|
||||
|
||||
lda #pStack
|
||||
jsr EmitByte
|
||||
|
||||
lda #$E6 inc zp
|
||||
jsr EmitByte
|
||||
|
||||
lda #pStack
|
||||
bra EmitByte
|
||||
*--------------------------------------
|
||||
EmitPushA pha
|
||||
lda #$A9 LDA imm
|
||||
jsr EmitByte
|
||||
|
||||
pla
|
||||
jsr EmitByte
|
||||
|
||||
lda #$C6 DEC zp
|
||||
jsr EmitByte
|
||||
|
||||
lda #pStack
|
||||
jsr EmitByte
|
||||
|
||||
lda #$92 STA (zp)
|
||||
jsr EmitByte
|
||||
|
||||
lda #pStack
|
||||
bra EmitByte
|
||||
*--------------------------------------
|
||||
EmitJsrYA pha
|
||||
lda #$20
|
||||
jsr EmitByte
|
||||
tya
|
||||
jsr EmitByte
|
||||
pla
|
||||
*--------------------------------------
|
||||
EmitByte 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
|
||||
|
@@ -438,13 +438,16 @@ KW.EQ jsr CheckStackPop4
|
||||
sec
|
||||
sbc (pStack)
|
||||
tax
|
||||
|
||||
inc pStack
|
||||
|
||||
lda (pStack),y
|
||||
sbc (pStack),y
|
||||
sbc (pStack)
|
||||
|
||||
inc pStack
|
||||
|
||||
bcc .1
|
||||
tay
|
||||
bne .1
|
||||
|
||||
txa
|
||||
bne .1
|
||||
@@ -454,7 +457,7 @@ KW.EQ jsr CheckStackPop4
|
||||
.1 clc
|
||||
|
||||
lda #0
|
||||
ror
|
||||
sbc #0
|
||||
sta (pStack)
|
||||
ldy #1
|
||||
sta (pStack),y
|
||||
@@ -720,6 +723,9 @@ KW.VOCABULARY
|
||||
KW.FORTH
|
||||
KW.EDITOR
|
||||
KW.ASSEMBLER
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
KW.VLIST
|
||||
clc
|
||||
rts
|
||||
@@ -757,7 +763,6 @@ KW.BCOLON bit bCompile
|
||||
clc
|
||||
.9 rts
|
||||
|
||||
|
||||
KW.COLON.SYN lda #E.SYN
|
||||
sec
|
||||
rts
|
||||
@@ -960,21 +965,12 @@ KW.I ldy RP
|
||||
rts
|
||||
*--------------------------------------
|
||||
KW.LEAVE
|
||||
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
KW.IF
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
KW.ELSE
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
KW.ENDIF
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
KW.BEGIN
|
||||
*--------------------------------------
|
||||
@@ -982,12 +978,12 @@ KW.UNTIL
|
||||
*--------------------------------------
|
||||
KW.REPEAT
|
||||
*--------------------------------------
|
||||
KW.WHILE
|
||||
|
||||
clc
|
||||
KW.WHILE lda #E.FUNDEF
|
||||
sec
|
||||
rts
|
||||
*--------------------------------------
|
||||
KW.COMMENT clc
|
||||
KW.COMMENT
|
||||
clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
MAN
|
||||
|
@@ -169,7 +169,8 @@ J.KEYWORDS .DA KW.DUP
|
||||
.DA KW.ASSEMBLER
|
||||
.DA KW.VLIST
|
||||
.DA KW.BCOLON
|
||||
.DA KW.ECOLON
|
||||
.DA KW.ECOLON A2
|
||||
*--------------------------------------
|
||||
.DA KW.VARIABLE
|
||||
.DA KW.CONSTANT
|
||||
.DA KW.ACODE
|
||||
@@ -187,6 +188,24 @@ J.KEYWORDS .DA KW.DUP
|
||||
.DA KW.REPEAT
|
||||
.DA KW.WHILE
|
||||
.DA KW.COMMENT
|
||||
*--------------------------------------
|
||||
J.CP .DA CP.VARIABLE
|
||||
.DA CP.CONSTANT
|
||||
.DA CP.ACODE
|
||||
.DA CP.FCODE
|
||||
.DA CP.DO
|
||||
.DA CP.LOOP
|
||||
.DA CP.pLOOP
|
||||
.DA CP.I
|
||||
.DA CP.LEAVE
|
||||
.DA CP.IF
|
||||
.DA CP.ELSE
|
||||
.DA CP.ENDIF
|
||||
.DA CP.BEGIN
|
||||
.DA CP.UNTIL
|
||||
.DA CP.REPEAT
|
||||
.DA CP.WHILE
|
||||
.DA CP.COMMENT
|
||||
.DA 0
|
||||
*--------------------------------------
|
||||
CS.INIT clc
|
||||
@@ -196,6 +215,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS
|
||||
>PUSHW A2osX.KVER
|
||||
>PUSHBI 2
|
||||
>SYSCALL PrintF
|
||||
* >DEBUG
|
||||
bcs CS.INIT.RTS
|
||||
|
||||
jsr CS.RUN.ARGS
|
||||
@@ -387,6 +407,9 @@ CS.FORTH.Run.File
|
||||
lda (ZPCLBuf)
|
||||
beq .8
|
||||
|
||||
cmp #'\'
|
||||
beq .8
|
||||
|
||||
cmp #'#'
|
||||
bne .1
|
||||
|
||||
@@ -535,9 +558,9 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
|
||||
bit bCompile
|
||||
bpl .9
|
||||
|
||||
.1 >PULLA
|
||||
.1 >PULLYA
|
||||
jsr EmitPushA
|
||||
>PULLA
|
||||
tya
|
||||
jmp EmitPushA
|
||||
|
||||
.9 rts
|
||||
@@ -707,49 +730,6 @@ CheckStackPop4 lda pStack
|
||||
.9 lda #E.STACKERROR
|
||||
sec
|
||||
rts
|
||||
*--------------------------------------
|
||||
EmitPullA lda #$B2 lda (zp)
|
||||
jsr EmitByte
|
||||
|
||||
lda #pStack
|
||||
jsr EmitByte
|
||||
|
||||
lda #$E6 inc zp
|
||||
|
||||
lda #pStack
|
||||
bra EmitByte
|
||||
*--------------------------------------
|
||||
EmitPushA pha
|
||||
lda #$A9 LDA imm
|
||||
jsr EmitByte
|
||||
|
||||
pla
|
||||
jsr EmitByte
|
||||
|
||||
lda #$C6 DEC zp
|
||||
jsr EmitByte
|
||||
|
||||
lda #pStack
|
||||
jsr EmitByte
|
||||
|
||||
lda #$92 STA (zp)
|
||||
jsr EmitByte
|
||||
|
||||
lda #pStack
|
||||
bra EmitByte
|
||||
*--------------------------------------
|
||||
EmitJsrYA pha
|
||||
lda #$20
|
||||
jsr EmitByte
|
||||
tya
|
||||
jsr EmitByte
|
||||
pla
|
||||
*--------------------------------------
|
||||
EmitByte sta (ZPCodePtr)
|
||||
inc ZPCodePtr
|
||||
bne .8
|
||||
inc ZPCodePtr+1
|
||||
.8 rts
|
||||
*--------------------------------------
|
||||
.INB usr/src/bin/forth.s.cl
|
||||
.INB usr/src/bin/forth.s.cp
|
||||
|
@@ -13,7 +13,7 @@ NEW
|
||||
.INB inc/libtcpip.i
|
||||
.INB inc/net.http.i
|
||||
*--------------------------------------
|
||||
TIMEOUT.MAX .EQ 200 20 sec.
|
||||
TIMEOUT.MAX .EQ 600 60 sec.
|
||||
*--------------------------------------
|
||||
.DUMMY
|
||||
.OR ZPBIN
|
||||
@@ -558,13 +558,13 @@ CS.RUN.GETRESPONSE
|
||||
ldy #S.IP.TOTAL.LENGTH+1
|
||||
lda (ZPRespBufPtr),y
|
||||
sec
|
||||
sbc #S.TCP-S.IP
|
||||
sbc #S.TCP-S.ETH.EII
|
||||
sta ZPRespBufLen
|
||||
|
||||
dey
|
||||
|
||||
lda (ZPRespBufPtr),y
|
||||
sbc /S.TCP-S.IP
|
||||
sbc /S.TCP-S.ETH.EII
|
||||
sta ZPRespBufLen+1
|
||||
|
||||
lda ZPRespBufPtr
|
||||
@@ -648,34 +648,19 @@ CS.RUN.GETHEADER
|
||||
.9 rts
|
||||
*--------------------------------------
|
||||
CS.RUN.CHECKLEN ldx #3
|
||||
ldy #Received
|
||||
|
||||
.1 lda (pData),y
|
||||
pha
|
||||
iny
|
||||
dex
|
||||
bpl .1
|
||||
|
||||
ldx #3
|
||||
ldy #Length+3
|
||||
|
||||
sec
|
||||
|
||||
.2 pla
|
||||
eor (pData),y
|
||||
.1 lda Received,x
|
||||
eor Length,x
|
||||
bne .9
|
||||
|
||||
dey
|
||||
dex
|
||||
bpl .2
|
||||
bpl .1
|
||||
|
||||
clc
|
||||
.99 rts
|
||||
|
||||
.9 dex
|
||||
bmi .99
|
||||
pla
|
||||
bra .9
|
||||
.9 rts
|
||||
*--------------------------------------
|
||||
CS.DOEVENT lda (pEvent)
|
||||
bpl .9 is it a TIMER event?
|
||||
|
85
EXAMPLES/MANDELBROT.F.txt
Normal file
85
EXAMPLES/MANDELBROT.F.txt
Normal file
@@ -0,0 +1,85 @@
|
||||
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 5 lshift 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
|
||||
|
||||
\ Compute squares, but rescale to remove extra scaling factor.
|
||||
: ZR_SQ ZREAL @ DUP RESCALE */ ;
|
||||
: ZI_SQ ZIMAG @ DUP RESCALE */ ;
|
||||
|
||||
\ Translate escape count to ascii greyscale.
|
||||
: .CHAR
|
||||
S" ..,'~!^:;[/<&?oxOX# "
|
||||
DROP + 1
|
||||
TYPE ;
|
||||
|
||||
\ 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
|
||||
5 lshift DUP CREAL ! ZREAL !
|
||||
5 lshift DUP CIMAG ! ZIMAG !
|
||||
1 COUNT ! ;
|
||||
|
||||
\ Performs a single iteration of the escape calculation.
|
||||
: DOESCAPE
|
||||
ZR_SQ ZI_SQ 2DUP +
|
||||
ESCAPES? IF
|
||||
2DROP
|
||||
TRUE
|
||||
ELSE
|
||||
- CREAL @ + \ leave result on stack
|
||||
ZREAL @ ZIMAG @ RESCALE */ 1 lshift
|
||||
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 ;
|
||||
|
||||
\ Run the computation.
|
||||
MANDELBROT
|
||||
MAN
|
||||
TEXT root/mandelbrot.f
|
@@ -1,11 +1,11 @@
|
||||
NEW
|
||||
AUTO 3,1
|
||||
*--------------------------------------
|
||||
IO.D2.SeekTimeR .EQ 140 LIBBLKDEV Recalibration
|
||||
IO.D2.SeekTimeF .EQ 70 LIBBLKDEV Track Formatter
|
||||
IO.D2.SeekTimeB .EQ 70 LIBBLKDEV Boot Block
|
||||
IO.D2.SeekTimeP .EQ 70 ProDOS.FX initial
|
||||
IO.D2.SeekTimeI .EQ 10 ProDOS.FX increment -> until > 128
|
||||
IO.D2.SeekTimeR .EQ 130 LIBBLKDEV Recalibration
|
||||
IO.D2.SeekTimeF .EQ 65 LIBBLKDEV Track Formatter
|
||||
IO.D2.SeekTimeB .EQ 65 LIBBLKDEV Boot Block
|
||||
IO.D2.SeekTimeP .EQ 85 ProDOS.FX initial
|
||||
IO.D2.SeekTimeI .EQ 20 ProDOS.FX increment -> until > 128
|
||||
*--------------------------------------
|
||||
IO.D2.Ph0Off .EQ $C080
|
||||
IO.D2.Ph0On .EQ $C081
|
||||
|
@@ -396,24 +396,6 @@ TrkWriter.Start lda IO.D2.ReadProt,x
|
||||
TrkWriter.Size .EQ *-TrkWriter.Start
|
||||
.EP
|
||||
*--------------------------------------
|
||||
D2.PhIn .DA #IO.D2.Ph3Off 7->0
|
||||
.DA #IO.D2.Ph1On 0->1
|
||||
.DA #IO.D2.Ph0Off 1->2
|
||||
.DA #IO.D2.Ph2On 2->3
|
||||
.DA #IO.D2.Ph1Off 3->4
|
||||
.DA #IO.D2.Ph3On 4->5
|
||||
.DA #IO.D2.Ph2Off 5->6
|
||||
.DA #IO.D2.Ph0On 6->7
|
||||
|
||||
D2.PhOut .DA #IO.D2.Ph1Off 1->0
|
||||
.DA #IO.D2.Ph0on 2->1
|
||||
.DA #IO.D2.Ph2off 3->2
|
||||
.DA #IO.D2.Ph1On 4->3
|
||||
.DA #IO.D2.Ph3Off 5->4
|
||||
.DA #IO.D2.Ph2On 6->5
|
||||
.DA #IO.D2.Ph0Off 7->6
|
||||
.DA #IO.D2.Ph3On 0->7
|
||||
*--------------------------------------
|
||||
ADDR.Head .HS 96AAD5
|
||||
DATA.Head .HS ADAAD5
|
||||
TAIL .HS EBAADE
|
||||
|
@@ -227,8 +227,8 @@ XRW.SectorIO lda #2
|
||||
adc #IO.D2.SeekTimeI
|
||||
sta XRW.SeekTime
|
||||
|
||||
ldx XRW.UnitIndex
|
||||
sta XRW.D2SeekTime-1,x
|
||||
* ldx XRW.UnitIndex
|
||||
* sta XRW.D2SeekTime-1,x
|
||||
|
||||
.5 lda XRW.ReqTrack
|
||||
jsr XRW.Seek
|
||||
@@ -395,7 +395,7 @@ XRW.Write lda IO.D2.ReadProt,x PREWRITE MODE
|
||||
|
||||
sta IO.D2.WriteMode,x (5) goto write mode
|
||||
ora IO.D2.WShift,x (4)
|
||||
ldy #$04 (2) for five nibls
|
||||
ldy #5 (2)
|
||||
nop (2)
|
||||
pha (3)
|
||||
pla (4)
|
||||
|
@@ -275,11 +275,14 @@ BIN.RelExe ldy #H.BIN.T+1
|
||||
lda (ZPPtr1),y
|
||||
cmp /H.BIN.T.BIN65
|
||||
beq .1
|
||||
|
||||
cmp /H.BIN.T.DRV65
|
||||
beq .1
|
||||
|
||||
lda #E.IBIN
|
||||
sec
|
||||
rts
|
||||
|
||||
.1 ldy #H.BIN.JMP relocate Main JMP
|
||||
jsr BIN.RelocateAtPtr1Y
|
||||
|
||||
@@ -292,10 +295,14 @@ BIN.RelDrv ldy #H.BIN.DRV.REL.TABLE
|
||||
.1 iny
|
||||
lda (ZPPtr1),y HI in A
|
||||
beq .2 $00xx = end of table
|
||||
|
||||
dey
|
||||
jsr BIN.RelocateAtPtr1Y
|
||||
|
||||
iny
|
||||
bne .1
|
||||
|
||||
inc ZPPtr1+1
|
||||
|
||||
bra .1
|
||||
*--------------------------------------
|
||||
|
Reference in New Issue
Block a user