mirror of
https://github.com/A2osX/A2osX.git
synced 2025-02-09 02:30:35 +00:00
Kernel 0.94
This commit is contained in:
Rémy GIBERT
parent
3dcd4e47cb
commit
13de2fc64a
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,25 +1,50 @@
|
||||
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
|
||||
|
||||
|
||||
lda #$AA TAX
|
||||
jsr EmitByte
|
||||
|
||||
|
||||
lda #$10 BPL
|
||||
jsr EmitByte
|
||||
|
||||
|
||||
lda #3 skip JMP abs
|
||||
jsr EmitByte
|
||||
|
||||
lda #$4C JMP
|
||||
jsr EmitByte
|
||||
|
||||
|
||||
ldy RP
|
||||
lda ZPCodePtr+1
|
||||
sta (pData),y
|
||||
@ -28,11 +53,13 @@ CP.IF jsr EmitPullA
|
||||
lda ZPCodePtr
|
||||
sta (pData),y
|
||||
dey
|
||||
|
||||
|
||||
sty RP
|
||||
|
||||
|
||||
lda #0
|
||||
jsr EmitByte
|
||||
|
||||
clc
|
||||
jmp EmitByte
|
||||
*--------------------------------------
|
||||
CP.ELSE
|
||||
@ -44,23 +71,80 @@ CP.ENDIF ldy RP
|
||||
iny
|
||||
lda (pData),y
|
||||
sta ZPPtr1
|
||||
|
||||
|
||||
iny
|
||||
lda (pData),y
|
||||
sta ZPPtr1+1
|
||||
|
||||
|
||||
sty RP
|
||||
|
||||
|
||||
lda ZPCodePtr
|
||||
sta (ZPPtr1)
|
||||
|
||||
|
||||
ldy #1
|
||||
lda ZPCodePtr+1
|
||||
sta (ZPPtr1),y
|
||||
|
||||
|
||||
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
|
||||
|
||||
212
BIN/FORTH.S.txt
212
BIN/FORTH.S.txt
@ -84,7 +84,7 @@ L.FMT.int16 .DA FMT.int16
|
||||
J.ESC .DA CL.BS left arrow
|
||||
.DA CL.DN
|
||||
.DA CL.UP
|
||||
* .DA HIS.GetNext
|
||||
* .DA HIS.GetNext
|
||||
* .DA HIS.GetPrev
|
||||
.DA CL.NAK right arrow
|
||||
L.KEYWORDS .DA KEYWORDS
|
||||
@ -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,11 +215,12 @@ CS.RUN >PUSHW L.MSG.GREETINGS
|
||||
>PUSHW A2osX.KVER
|
||||
>PUSHBI 2
|
||||
>SYSCALL PrintF
|
||||
* >DEBUG
|
||||
bcs CS.INIT.RTS
|
||||
|
||||
jsr CS.RUN.ARGS
|
||||
bcs CS.INIT.RTS
|
||||
|
||||
|
||||
>LDYAI CODE.SIZE
|
||||
>SYSCALL GetMem
|
||||
bcs CS.INIT.RTS
|
||||
@ -209,7 +229,7 @@ CS.RUN >PUSHW L.MSG.GREETINGS
|
||||
>STYA.G CodeBuf
|
||||
txa
|
||||
>STA.G hCodeBuf
|
||||
|
||||
|
||||
>LDYAI DATA.SIZE
|
||||
>SYSCALL GetMem
|
||||
.9 bcs CS.INIT.RTS
|
||||
@ -242,12 +262,12 @@ CS.RUN >PUSHW L.MSG.GREETINGS
|
||||
>STYA ZPCLBuf
|
||||
txa
|
||||
>STA.G hCLBuf
|
||||
|
||||
|
||||
>SYSCALL SListNew
|
||||
bcs .9
|
||||
|
||||
|
||||
>STA.G hSList
|
||||
|
||||
|
||||
stz bCompile
|
||||
lda #127
|
||||
sta RP
|
||||
@ -270,14 +290,14 @@ CS.RUN.LOOP >SLEEP
|
||||
|
||||
cmp #MLI.E.EOF
|
||||
beq .8
|
||||
|
||||
|
||||
cmp #3
|
||||
beq .99
|
||||
|
||||
pha
|
||||
>LDA.G bExitOnEOF
|
||||
bmi .9
|
||||
|
||||
|
||||
pla
|
||||
>PUSHA
|
||||
>PUSHW ZPCLBuf
|
||||
@ -285,7 +305,7 @@ CS.RUN.LOOP >SLEEP
|
||||
>LDYA ZPCLBuf
|
||||
>SYSCALL PutS
|
||||
bra CS.RUN.LOOP
|
||||
|
||||
|
||||
* jsr PrintErrMsg
|
||||
|
||||
.9 pla
|
||||
@ -296,12 +316,12 @@ CS.RUN.LOOP >SLEEP
|
||||
sec
|
||||
rts
|
||||
*--------------------------------------
|
||||
CS.RUN.ARGS inc ArgIndex
|
||||
CS.RUN.ARGS inc ArgIndex
|
||||
|
||||
lda ArgIndex
|
||||
>SYSCALL ArgV
|
||||
bcs .8
|
||||
|
||||
|
||||
>STYA ZPPtr1
|
||||
lda (ZPPtr1)
|
||||
cmp #'-'
|
||||
@ -356,9 +376,9 @@ CS.FORTH.Run jsr CL.Reset
|
||||
|
||||
jsr PrintPrompt
|
||||
bcs .9
|
||||
|
||||
|
||||
.1 >SYSCALL GetChar
|
||||
bcs .9 I/O error
|
||||
bcs .9 I/O error
|
||||
|
||||
.2 cmp #3 Ctrl-C
|
||||
beq .9 CS
|
||||
@ -366,15 +386,15 @@ CS.FORTH.Run jsr CL.Reset
|
||||
jsr CL.CHARIN
|
||||
|
||||
bit CL.bReady Something to execute ?
|
||||
bpl .1
|
||||
|
||||
bpl .1
|
||||
|
||||
>PUSHW L.MSG.PROMPTCRLF
|
||||
>PUSHBI 0
|
||||
>SYSCALL PrintF
|
||||
|
||||
jmp CS.RUN.EXEC
|
||||
|
||||
.9 rts
|
||||
|
||||
.9 rts
|
||||
*--------------------------------------
|
||||
CS.FORTH.Run.File
|
||||
>PUSHWI 256
|
||||
@ -386,17 +406,20 @@ CS.FORTH.Run.File
|
||||
|
||||
lda (ZPCLBuf)
|
||||
beq .8
|
||||
|
||||
|
||||
cmp #'\'
|
||||
beq .8
|
||||
|
||||
cmp #'#'
|
||||
bne .1
|
||||
|
||||
|
||||
ldy #1
|
||||
lda (ZPCLBuf),y
|
||||
beq .1
|
||||
|
||||
|
||||
cmp #'!'
|
||||
beq .8
|
||||
|
||||
|
||||
.1 jmp CS.RUN.EXEC
|
||||
|
||||
.8 clc
|
||||
@ -418,52 +441,52 @@ CS.RUN.EXEC lda (ZPCLBufPtr)
|
||||
|
||||
.2 jsr CS.RUN.GetSymbol
|
||||
bcs .5
|
||||
|
||||
|
||||
bit ZPType
|
||||
bmi .4
|
||||
|
||||
|
||||
bvc .3
|
||||
|
||||
|
||||
>PUSHW ZPAddrPtr
|
||||
|
||||
|
||||
rts
|
||||
|
||||
|
||||
.3 ldy #1
|
||||
>PUSHB (ZPAddrPtr),y
|
||||
>PUSHB (ZPAddrPtr)
|
||||
rts
|
||||
|
||||
|
||||
.4 bit bCompile
|
||||
bmi .40
|
||||
|
||||
|
||||
jsr .80
|
||||
bcc CS.RUN.EXEC
|
||||
|
||||
|
||||
rts
|
||||
|
||||
|
||||
.40 >LDYA ZPAddrPtr
|
||||
jsr EmitJsrYA
|
||||
jsr EmitJsrYA
|
||||
bra CS.RUN.EXEC
|
||||
|
||||
|
||||
.5 jsr CS.RUN.GetNum
|
||||
bcs .9
|
||||
|
||||
.6 jsr NextChar Skip SPACE if any
|
||||
bne .1
|
||||
|
||||
|
||||
.8 clc
|
||||
.9 rts
|
||||
|
||||
|
||||
.7 txa
|
||||
asl
|
||||
tax
|
||||
|
||||
|
||||
cpx #$A2 ; ECOLON always EXECUTE
|
||||
beq .71
|
||||
|
||||
bit bCompile
|
||||
bmi .72
|
||||
|
||||
|
||||
.70 bcs .99 cannot exec compil only
|
||||
|
||||
.71 jmp (J.KEYWORDS,x)
|
||||
@ -484,7 +507,7 @@ CS.RUN.FOpen >PUSHYA
|
||||
bcs .9
|
||||
|
||||
>STA.G hFile
|
||||
|
||||
|
||||
.9 rts
|
||||
*--------------------------------------
|
||||
CS.RUN.GetSymbol
|
||||
@ -492,27 +515,27 @@ CS.RUN.GetSymbol
|
||||
>PUSHW ZPCLBufPtr
|
||||
>SYSCALL SListLookup
|
||||
bcs .9
|
||||
|
||||
|
||||
>STYA ZPKeyID
|
||||
|
||||
|
||||
txa
|
||||
jsr NextKW
|
||||
|
||||
|
||||
>PUSHB.G hSList
|
||||
>PUSHW ZPKeyID
|
||||
>PUSHWI ZPType
|
||||
>PUSHWI 4 4 bytes
|
||||
>PUSHWZ From Start
|
||||
|
||||
|
||||
>SYSCALL SListGetData
|
||||
bcs .9
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
.9 rts
|
||||
*--------------------------------------
|
||||
CS.RUN.GetNum >PUSHW ZPCLBufPtr
|
||||
@ -520,24 +543,24 @@ CS.RUN.GetNum >PUSHW ZPCLBufPtr
|
||||
>PUSHBI 10
|
||||
>SYSCALL StrToL
|
||||
bcs .9
|
||||
|
||||
|
||||
ldy #2
|
||||
lda (pStack)
|
||||
sta (pStack),y
|
||||
|
||||
|
||||
inc pStack
|
||||
|
||||
|
||||
lda (pStack)
|
||||
sta (pStack),y
|
||||
|
||||
|
||||
inc pStack
|
||||
|
||||
bit bCompile
|
||||
bpl .9
|
||||
|
||||
.1 >PULLA
|
||||
.1 >PULLYA
|
||||
jsr EmitPushA
|
||||
>PULLA
|
||||
tya
|
||||
jmp EmitPushA
|
||||
|
||||
.9 rts
|
||||
@ -553,15 +576,15 @@ CS.QUIT >LDA.G hSList
|
||||
|
||||
.1 >LDA.G hFile
|
||||
beq .2
|
||||
|
||||
|
||||
>SYSCALL FClose
|
||||
|
||||
.2 ldy #hCodeBuf
|
||||
jsr .7
|
||||
|
||||
|
||||
ldy #hDataBuf
|
||||
jsr .7
|
||||
|
||||
|
||||
ldy #hInputBuf
|
||||
jsr .7
|
||||
|
||||
@ -572,9 +595,9 @@ CS.QUIT >LDA.G hSList
|
||||
|
||||
.7 lda (pData),y
|
||||
beq .8
|
||||
|
||||
|
||||
>SYSCALL FreeMem
|
||||
|
||||
|
||||
.8 clc
|
||||
rts
|
||||
*--------------------------------------
|
||||
@ -600,16 +623,16 @@ PrintTraceMsg.3 >PUSHBI '>'
|
||||
ldy #S.PS.hStdErr
|
||||
lda (pPS),y
|
||||
>SYSCALL FPutC
|
||||
|
||||
|
||||
ldy #$ff
|
||||
|
||||
.1 iny
|
||||
lda (ZPPtr3),y
|
||||
beq .8
|
||||
|
||||
|
||||
cmp #C.CR
|
||||
beq .8
|
||||
|
||||
|
||||
phy
|
||||
>PUSHA
|
||||
ldy #S.PS.hStdErr
|
||||
@ -617,11 +640,11 @@ PrintTraceMsg.3 >PUSHBI '>'
|
||||
>SYSCALL FPutC
|
||||
ply
|
||||
bra .1
|
||||
|
||||
|
||||
.8 ldy #S.PS.hStdErr
|
||||
lda (pPS),y
|
||||
>PUSHA
|
||||
|
||||
|
||||
>PUSHW L.MSG.ECHOCRLF
|
||||
>PUSHBI 0
|
||||
>SYSCALL FPrintF
|
||||
@ -632,11 +655,11 @@ CheckLFAfterCR ldy #S.PS.hStdIn Check for any extra LF
|
||||
lda (pPS),y
|
||||
>SYSCALL FEOF
|
||||
bcs .9
|
||||
|
||||
|
||||
tay
|
||||
bne .9
|
||||
>SYSCALL GetChar
|
||||
|
||||
|
||||
.9 rts
|
||||
*--------------------------------------
|
||||
IncPtr1 inc ZPPtr1
|
||||
@ -652,7 +675,7 @@ NextKW clc
|
||||
*--------------------------------------
|
||||
NextCharNB lda (ZPCLBufPtr)
|
||||
beq .8
|
||||
|
||||
|
||||
jsr IsSpaceOrCR
|
||||
bcs .8
|
||||
|
||||
@ -661,16 +684,16 @@ NextCharNB lda (ZPCLBufPtr)
|
||||
inc ZPCLBufPtr+1
|
||||
bra NextCharNB
|
||||
|
||||
.8 rts
|
||||
.8 rts
|
||||
*--------------------------------------
|
||||
NextChar lda (ZPCLBufPtr)
|
||||
beq .8
|
||||
|
||||
|
||||
inc ZPCLBufPtr
|
||||
bne .8
|
||||
|
||||
|
||||
inc ZPCLBufPtr+1
|
||||
|
||||
|
||||
.8 rts
|
||||
*--------------------------------------
|
||||
ToUpperCase cmp #'a'
|
||||
@ -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
|
||||
@ -884,7 +864,7 @@ KEYWORDS .AT "DUP" ( n - n n ) Duplicate top of stack.
|
||||
*--------------------------------------
|
||||
.DUMMY
|
||||
.OR 0
|
||||
DS.START .BS 128 RETURN STACK
|
||||
DS.START .BS 128 RETURN STACK
|
||||
|
||||
bDebug .BS 1
|
||||
bTrace .BS 1
|
||||
|
||||
@ -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
|
||||
@ -61,7 +61,7 @@ CS.START cld
|
||||
*--------------------------------------
|
||||
.1 .DA CS.INIT
|
||||
.DA CS.RUN
|
||||
.DA CS.DOEVENT
|
||||
.DA CS.DOEVENT
|
||||
.DA CS.QUIT
|
||||
L.LIBTCPIP .DA LIBTCPIP
|
||||
L.SA.LOCAL .DA SA.LOCAL
|
||||
@ -139,7 +139,7 @@ CS.RUN.RTS rts
|
||||
*--------------------------------------
|
||||
CS.RUN.HOSTOK jsr CS.RUN.GETNEXTARG
|
||||
bcc .10
|
||||
|
||||
|
||||
.8 jmp CS.RUN.ARGSOK
|
||||
|
||||
.10 >STYA ZPPtr
|
||||
@ -168,9 +168,9 @@ CS.RUN.HOSTOK jsr CS.RUN.GETNEXTARG
|
||||
bcc .11
|
||||
cmp #'z'+1
|
||||
bcs .11
|
||||
|
||||
|
||||
eor #$20
|
||||
|
||||
|
||||
.11 cmp #'U'
|
||||
bne .2
|
||||
|
||||
@ -190,10 +190,10 @@ CS.RUN.HOSTOK jsr CS.RUN.GETNEXTARG
|
||||
|
||||
.2 cmp #'F'
|
||||
bne .3
|
||||
|
||||
|
||||
bit bURI
|
||||
bmi CS.RUN.ESYN
|
||||
|
||||
|
||||
jsr CS.RUN.GETNEXTARG
|
||||
bcs .9
|
||||
|
||||
@ -208,19 +208,19 @@ CS.RUN.HOSTOK jsr CS.RUN.GETNEXTARG
|
||||
stx hReqBuf
|
||||
>SYSCALL GetMemPtr
|
||||
>STYA ZPReqBufPtr
|
||||
|
||||
|
||||
sec
|
||||
ror bURI
|
||||
jmp CS.RUN.HOSTOK
|
||||
|
||||
.3 cmp #'O'
|
||||
bne .9
|
||||
|
||||
|
||||
inc ArgIndex
|
||||
lda ArgIndex
|
||||
>SYSCALL ArgV
|
||||
bcs .9
|
||||
|
||||
|
||||
>STYA ZPFileName
|
||||
jmp CS.RUN.HOSTOK
|
||||
*--------------------------------------
|
||||
@ -228,7 +228,7 @@ CS.RUN.GETNEXTARG
|
||||
inc ArgIndex
|
||||
lda ArgIndex
|
||||
>SYSCALL ArgV
|
||||
rts
|
||||
rts
|
||||
*--------------------------------------
|
||||
CS.RUN.ARGSOK >PUSHW L.MSG.CONNECT
|
||||
ldx #0
|
||||
@ -239,8 +239,8 @@ CS.RUN.ARGSOK >PUSHW L.MSG.CONNECT
|
||||
bne .1
|
||||
|
||||
>PUSHW SA.REMOTE+S.SOCKADDR.PORT
|
||||
>PUSHW ZPHostPtr
|
||||
|
||||
>PUSHW ZPHostPtr
|
||||
|
||||
>PUSHBI 8
|
||||
>SYSCALL PrintF
|
||||
|
||||
@ -277,7 +277,7 @@ CS.RUN.OPENSKT >PUSHBI 0 no protocol
|
||||
|
||||
lda TimeOut
|
||||
bne .2
|
||||
|
||||
|
||||
lda #ERR.SKT.NOCONN
|
||||
bra .9
|
||||
|
||||
@ -285,7 +285,7 @@ CS.RUN.OPENSKT >PUSHBI 0 no protocol
|
||||
>SYSCALL PutS
|
||||
|
||||
>SLEEP
|
||||
|
||||
|
||||
CS.RUN.GET jsr CS.RUN.ENCODE
|
||||
bcs .99
|
||||
|
||||
@ -294,7 +294,7 @@ CS.RUN.GET jsr CS.RUN.ENCODE
|
||||
|
||||
>LDYA ZPFileName
|
||||
beq .1
|
||||
|
||||
|
||||
>PUSHYA
|
||||
>PUSHBI O.CREATE+O.WRONLY+O.TRUNC
|
||||
>PUSHBI 0 TYPE
|
||||
@ -302,7 +302,7 @@ CS.RUN.GET jsr CS.RUN.ENCODE
|
||||
>SYSCALL FOpen
|
||||
bcs .9
|
||||
sta hFile
|
||||
|
||||
|
||||
.1 jsr CS.RUN.RESPONSE
|
||||
bcs .99
|
||||
|
||||
@ -334,7 +334,7 @@ CS.RUN.IOERR pha
|
||||
*--------------------------------------
|
||||
CS.RUN.ENCODE >LDYA ZPReqBufPtr
|
||||
>STYA ZPPtr
|
||||
|
||||
|
||||
inc ZPEncodedBufLen for ending \0
|
||||
|
||||
.1 lda (ZPPtr)
|
||||
@ -351,7 +351,7 @@ CS.RUN.ENCODE >LDYA ZPReqBufPtr
|
||||
bcc .3
|
||||
|
||||
inc
|
||||
|
||||
|
||||
.3 adc ZPEncodedBufLen
|
||||
sta ZPEncodedBufLen
|
||||
bcc .1
|
||||
@ -440,29 +440,29 @@ CS.RUN.REQUEST jsr Init.TimeOut
|
||||
|
||||
>STYA ZPSendBufPtr
|
||||
stx hSendBuf
|
||||
|
||||
|
||||
>PUSHYA
|
||||
>PUSHW L.HTTP.GET
|
||||
>PUSHW ZPEncodedBufPtr
|
||||
>PUSHW ZPHostPtr
|
||||
>PUSHBI 4
|
||||
|
||||
|
||||
>SYSCALL SPrintF
|
||||
bcs .90
|
||||
|
||||
>PUSHYA Byte count
|
||||
>PUSHW ZPSendBufPtr
|
||||
|
||||
|
||||
lda hSocket
|
||||
>LIBCALL hLIBTCPIP,LIBTCPIP.Send
|
||||
|
||||
|
||||
.90 php
|
||||
pha
|
||||
lda hSendBuf
|
||||
>SYSCALL FreeMem
|
||||
pla
|
||||
plp
|
||||
|
||||
|
||||
.9 rts
|
||||
*--------------------------------------
|
||||
CS.RUN.RESPONSE jsr Init.TimeOut
|
||||
@ -472,40 +472,40 @@ CS.RUN.RESPONSE jsr Init.TimeOut
|
||||
lda hSocket
|
||||
>LIBCALL hLIBTCPIP,LIBTCPIP.Recv
|
||||
bcc .2
|
||||
|
||||
|
||||
cmp #E.NODATA
|
||||
bne .80
|
||||
|
||||
|
||||
lda TimeOut
|
||||
bne .1
|
||||
|
||||
|
||||
bit bHeader
|
||||
bmi .1
|
||||
|
||||
|
||||
.80 jmp .8
|
||||
|
||||
.2 jsr CS.RUN.GETRESPONSE
|
||||
|
||||
|
||||
bit bHeader
|
||||
bmi .6
|
||||
|
||||
|
||||
jsr CS.RUN.GETHEADER
|
||||
|
||||
|
||||
sec
|
||||
ror bHeader
|
||||
|
||||
|
||||
.6 >PUSHW ZPRespBufLen
|
||||
>PUSHW ZPRespBufPtr
|
||||
|
||||
|
||||
lda hFile
|
||||
bne .7
|
||||
|
||||
|
||||
ldy #S.PS.hStdOut
|
||||
lda (pPS),y
|
||||
|
||||
.7 >SYSCALL FWrite
|
||||
bcs .9
|
||||
|
||||
|
||||
lda hRespBuf
|
||||
stz hRespBuf
|
||||
>SYSCALL FreeMem
|
||||
@ -518,19 +518,19 @@ CS.RUN.RESPONSE jsr Init.TimeOut
|
||||
lda ZPRespBufLen+1
|
||||
adc Received+1
|
||||
sta Received+1
|
||||
|
||||
|
||||
bcc .70
|
||||
|
||||
inc Received+2
|
||||
bne .70
|
||||
|
||||
inc Received+3
|
||||
|
||||
|
||||
.70 >PUSHW L.MSG.Progress
|
||||
>PUSHL Received
|
||||
>PUSHL Length
|
||||
>PUSHBI 8
|
||||
|
||||
|
||||
>SYSCALL PrintF
|
||||
bcs .9
|
||||
|
||||
@ -538,7 +538,7 @@ CS.RUN.RESPONSE jsr Init.TimeOut
|
||||
|
||||
.8 bit bHeader
|
||||
bpl .99
|
||||
|
||||
|
||||
>PUSHW L.MSG.CRLF
|
||||
>PUSHBI 0
|
||||
>SYSCALL PrintF
|
||||
@ -554,65 +554,65 @@ CS.RUN.GETRESPONSE
|
||||
sta hRespBuf
|
||||
>SYSCALL GetMemPtr
|
||||
>STYA ZPRespBufPtr
|
||||
|
||||
|
||||
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
|
||||
clc
|
||||
adc #S.TCP
|
||||
sta ZPRespBufPtr
|
||||
bcc .8
|
||||
|
||||
|
||||
inc ZPRespBufPtr+1
|
||||
|
||||
.8 rts
|
||||
|
||||
.8 rts
|
||||
*--------------------------------------
|
||||
CS.RUN.GETHEADER
|
||||
.1 ldy #$ff
|
||||
|
||||
|
||||
.2 iny
|
||||
|
||||
lda (ZPRespBufPtr),y
|
||||
eor #C.CR
|
||||
bne .2
|
||||
|
||||
|
||||
sta (ZPRespBufPtr),y
|
||||
|
||||
|
||||
iny skip CR
|
||||
iny skip LF
|
||||
|
||||
|
||||
sty ArgIndex
|
||||
|
||||
|
||||
>LDYA ZPRespBufPtr
|
||||
>STYA ZPPtr
|
||||
|
||||
|
||||
lda ZPRespBufLen
|
||||
sec
|
||||
sbc ArgIndex
|
||||
sta ZPRespBufLen
|
||||
bcs .3
|
||||
|
||||
|
||||
dec ZPRespBufLen+1
|
||||
|
||||
|
||||
.3 lda ArgIndex
|
||||
tay
|
||||
clc
|
||||
adc ZPRespBufPtr
|
||||
sta ZPRespBufPtr
|
||||
bcc .4
|
||||
|
||||
|
||||
inc ZPRespBufPtr+1
|
||||
|
||||
|
||||
.4 dey
|
||||
dey
|
||||
beq .8
|
||||
@ -623,10 +623,10 @@ CS.RUN.GETHEADER
|
||||
lda (ZPPtr),y
|
||||
cmp HEAD.ContentLength,y
|
||||
bne .1
|
||||
|
||||
|
||||
cmp #C.SPACE
|
||||
bne .5
|
||||
|
||||
|
||||
tya
|
||||
sec skip SPACE
|
||||
adc ZPPtr
|
||||
@ -644,47 +644,32 @@ CS.RUN.GETHEADER
|
||||
jmp .1
|
||||
|
||||
.8 clc
|
||||
|
||||
.9 rts
|
||||
|
||||
.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?
|
||||
|
||||
|
||||
lda TimeOut
|
||||
beq .9
|
||||
|
||||
dec TimeOut
|
||||
|
||||
|
||||
dec TimeOut
|
||||
|
||||
.9 sec do not discard TIMER event
|
||||
rts
|
||||
*--------------------------------------
|
||||
@ -695,12 +680,12 @@ CS.QUIT lda hSocket
|
||||
|
||||
.1 lda hReqBuf
|
||||
beq .2
|
||||
|
||||
|
||||
>SYSCALL FreeMem
|
||||
|
||||
.2 lda hEncodedBuf
|
||||
beq .3
|
||||
|
||||
|
||||
>SYSCALL FreeMem
|
||||
|
||||
.3 lda hRespBuf
|
||||
@ -710,7 +695,7 @@ CS.QUIT lda hSocket
|
||||
|
||||
.4 lda hFile
|
||||
beq .5
|
||||
|
||||
|
||||
>SYSCALL FClose
|
||||
|
||||
.5 lda hLIBTCPIP
|
||||
@ -729,7 +714,7 @@ LIBTCPIP .AZ "libtcpip"
|
||||
hLIBTCPIP .BS 1
|
||||
MSG.IPKO .AZ "TCP/IP Not Loaded/Configured."
|
||||
MSG.USAGE .AS "Usage : HTTPGET <ip|host> [port]\r\n"
|
||||
.AS " -U Url\r\n"
|
||||
.AS " -U Url\r\n"
|
||||
.AS " -F UrlFile\r\n"
|
||||
.AZ " -O OutputFile\r\n"
|
||||
MSG.UNKNOWN .AZ "%s: Unknown host\r\n"
|
||||
@ -774,7 +759,7 @@ Length .BS 4
|
||||
*--------------------------------------
|
||||
.DUMMY
|
||||
.OR 0
|
||||
DS.START
|
||||
DS.START
|
||||
DS.END .ED
|
||||
*--------------------------------------
|
||||
MAN
|
||||
|
||||
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
|
||||
*--------------------------------------
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user