diff --git a/.Floppies/A2OSX.BOOTHD.woz b/.Floppies/A2OSX.BOOTHD.woz index b9e72c4b..12b74c41 100644 Binary files a/.Floppies/A2OSX.BOOTHD.woz and b/.Floppies/A2OSX.BOOTHD.woz differ diff --git a/.Floppies/A2OSX.BUILD.po b/.Floppies/A2OSX.BUILD.po index ad358340..bac9918f 100644 Binary files a/.Floppies/A2OSX.BUILD.po and b/.Floppies/A2OSX.BUILD.po differ diff --git a/.Floppies/A2OSX.TEST.po b/.Floppies/A2OSX.TEST.po index 4d77ac1a..9ab97ba2 100644 Binary files a/.Floppies/A2OSX.TEST.po and b/.Floppies/A2OSX.TEST.po differ diff --git a/BIN/FORTH.S.CP.txt b/BIN/FORTH.S.CP.txt index ad3daa6c..e3190d22 100644 --- a/BIN/FORTH.S.CP.txt +++ b/BIN/FORTH.S.CP.txt @@ -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 diff --git a/BIN/FORTH.S.KW.txt b/BIN/FORTH.S.KW.txt index 670b858a..e489f8a1 100644 --- a/BIN/FORTH.S.KW.txt +++ b/BIN/FORTH.S.KW.txt @@ -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 diff --git a/BIN/FORTH.S.txt b/BIN/FORTH.S.txt index 6348cc11..40a72075 100644 --- a/BIN/FORTH.S.txt +++ b/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 diff --git a/BIN/HTTPGET.S.txt b/BIN/HTTPGET.S.txt index 978acd23..8af25ead 100644 --- a/BIN/HTTPGET.S.txt +++ b/BIN/HTTPGET.S.txt @@ -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 [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 diff --git a/EXAMPLES/MANDELBROT.F.txt b/EXAMPLES/MANDELBROT.F.txt new file mode 100644 index 00000000..b1b39508 --- /dev/null +++ b/EXAMPLES/MANDELBROT.F.txt @@ -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 diff --git a/INC/IO.D2.I.txt b/INC/IO.D2.I.txt index 6416a61a..6370bb1c 100644 --- a/INC/IO.D2.I.txt +++ b/INC/IO.D2.I.txt @@ -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 diff --git a/LIB/LIBBLKDEV.S.txt b/LIB/LIBBLKDEV.S.txt index edaf4b2f..6ef030a5 100644 --- a/LIB/LIBBLKDEV.S.txt +++ b/LIB/LIBBLKDEV.S.txt @@ -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 diff --git a/ProDOS.FX/ProDOS.S.XRW.txt b/ProDOS.FX/ProDOS.S.XRW.txt index 0331b0d1..07cf82a5 100644 --- a/ProDOS.FX/ProDOS.S.XRW.txt +++ b/ProDOS.FX/ProDOS.S.XRW.txt @@ -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) diff --git a/SYS/KERNEL.S.BIN.txt b/SYS/KERNEL.S.BIN.txt index 3c101dd4..f5782014 100644 --- a/SYS/KERNEL.S.BIN.txt +++ b/SYS/KERNEL.S.BIN.txt @@ -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 *--------------------------------------