Kernel 0.94

.Docs/Forth Words.md

@@ -99,9 +99,9 @@ This document lists all of the **Forth Words** supported in the A2osX implementa
 | +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 |
-| IF | ( f - ) | | If top of stack is true, execute true clause |
-| ELSE | ( - ) | | Beginning of the false clause |
-| ENDIF | ( - ) | | End of the IF-ELSE structure |
+| 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 |
 | BEGIN | ( - ) | | Start an indefinite loop |
 | UNTIL | ( f - ) | | Loop back to BEGIN until f is true |
 | REPEAT | ( - ) | | Loop back to BEGIN unconditionally |

BIN/FORTH.S.CP.txt

@@ -42,41 +42,26 @@ CP.IF			jsr EmitPullA
 				lda #3					skip JMP abs
 				jsr EmitByte
 
-				lda #$4C				JMP
-				jsr EmitByte
-
-				ldy RP
-				lda ZPCodePtr+1
-				sta (pData),y
-				dey
-
-				lda ZPCodePtr
-				sta (pData),y
-				dey
-
-				sty RP
-
-				lda #0
-				jsr EmitByte
-				
-				clc
-				jmp EmitByte
-*--------------------------------------
-CP.ELSE
+				jsr EmitPendingJMP		to put jmp -> ELSE/ENDIF later
 
 				clc
 				rts
 *--------------------------------------
-CP.ENDIF		ldy RP
-				iny
-				lda (pData),y
-				sta ZPPtr1
+CP.ELSE			jsr CP.PopPtr1			get previous JMP -> ptr1
 
-				iny
-				lda (pData),y
-				sta ZPPtr1+1
+				jsr EmitPendingJMP		to put jmp -> ENDIF later 
 
-				sty RP
+				lda ZPCodePtr
+				sta (ZPPtr1)
+
+				ldy #1
+				lda ZPCodePtr+1
+				sta (ZPPtr1),y			update pending JMP to here
+
+				clc
+				rts
+*--------------------------------------
+CP.ENDIF		jsr CP.PopPtr1
 
 				lda ZPCodePtr
 				sta (ZPPtr1)
@@ -101,6 +86,43 @@ CP.COMMENT
 				clc
 				rts
 *--------------------------------------
+CP.PushCodePtr	ldy RP
+
+				lda ZPCodePtr+1
+				sta (pData),y
+				dey
+
+				lda ZPCodePtr
+				sta (pData),y
+				dey
+
+				sty RP
+				rts
+*--------------------------------------
+CP.PopPtr1		ldy RP
+				iny
+				lda (pData),y
+				sta ZPPtr1
+
+				iny
+				lda (pData),y
+				sta ZPPtr1+1
+
+				sty RP
+
+				rts
+*--------------------------------------
+EmitPendingJMP	lda #$4C				JMP
+				jsr EmitByte
+
+				jsr CP.PushCodePtr
+
+				lda #0
+				jsr EmitByte
+				jsr EmitByte
+
+				rts
+*--------------------------------------
 EmitPullA		lda #$B2				lda (zp)
 				jsr EmitByte
 

BIN/FORTH.S.txt

@@ -493,7 +493,9 @@ CS.RUN.EXEC		lda (ZPCLBufPtr)
 
 .72				jmp CP.RUN
 
-.80				jmp (ZPAddrPtr)
+.80
+*			>DEBUG
+				jmp (ZPAddrPtr)
 
 .99				lda #E.SYN
 				sec

INC/IO.D2.I.txt

@@ -4,7 +4,7 @@ NEW
 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.SeekTimeP	.EQ 65					ProDOS.FX initial
 IO.D2.SeekTimeI	.EQ 20					ProDOS.FX increment -> until > 128
 *--------------------------------------
 IO.D2.Ph0Off	.EQ $C080

LIB/LIBBLKDEV.S.D2.txt

@@ -154,6 +154,8 @@ D2MoveHead.SEI	ldx Slotn0
 				nop
 				nop
 				
+				ldx Slotn0
+				bit IO.D2.RData,x
 				rts
 *--------------------------------------
 D2.Wait25600usec

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
@@ -822,6 +822,8 @@ XRW.Seek		ldx XRW.UnitIndex
 				nop
 				nop
 				
+				ldx A2L
+				bit IO.D2.RData,x
 				rts				
 *--------------------------------------
 XRW.Reset		ldx A2L