diff --git a/.Docs/Forth Words.md b/.Docs/Forth Words.md index 14b0506c..575d81a7 100644 --- a/.Docs/Forth Words.md +++ b/.Docs/Forth Words.md @@ -23,24 +23,27 @@ The I/C Column symbols indicate attributes of the defined words: ### Stack Parameters Unless otherwise stated, all reference to numbers apply to 16-bit signed integers. The implied range of values is shown as {from..to}. The content of an address is shown by double curly brackets, particularly for the contents of variables, i.e., BASE {{2..70}}. -### addr {0..65,535} +### addr {0..65,535} A value representing the address of a byte, within the FORTH standard memory space. This addressed byte may represent the first byte of a larger data field in memory. -### byte {0..255} +### byte {0..255} A value representing an 8 bit byte. When in a larger field, the higher bits are zero. -### char {0..127} +### char {0..127} A value representing a 7 bit ASCII character code. When in a larger field, the higher bits are zero. +### n {-32,768..32,767} +16 bit signed integer number. Any other symbol refers to an arbitrary signed 16-bit integer in the range {-32,768..32,767}, unless otherwise noted. + +### u {0..65,535} +16 bit unsigned integer number. + ### d {-2,147,483,648..2,147,483,647} 32 bit signed 'double' number. The most significant 16-bits, with sign, is most accessible on the stack. ### flag A numerical value with two logical states; 0 = false, non-zero = true. -### n {-32,768..32,767} -16 bit signed integer number. Any other symbol refers to an arbitrary signed 16-bit integer in the range {-32,768..32,767}, unless otherwise noted. - ### Input Text **name** An arbitrary FORTH word accepted from the input stream. This notation refers to text from the input stream, not to values on the data stack. If the input stream is exhausted before encountering , an error condition exists. @@ -51,21 +54,21 @@ The definitions are listed in ASCII alphabetical order in several groups con #### Nucleus Words -! * */ */MOD + +! +loop - / /MOD 0< 0= 0> 1+ 1- 2+ 2- < = > >R ?DUP @ ABS AND begin C! C@ colon CMOVE constant create D+ D< DEPTH DNEGATE do does> DROP DUP else EXECUTE EXIT FILL I if J LEAVE literal loop MAX MIN MOD MOVE NEGATE NOT OR OVER PICK R> R@ repeat ROLL ROT semicolon SWAP then U* U/ until variable while XOR + ! * */ */MOD + +! +loop - / /MOD 0< 0= 0> 1+ 1- 2+ 2- < = > >R ?DUP @ ABS AND begin C! C@ colon CMOVE constant create D+ D< DEPTH DNEGATE do does> DROP DUP else EXECUTE EXIT FILL I if J LEAVE literal loop MAX MIN MOD MOVE NEGATE NOT OR OVER PICK R> R@ repeat ROLL ROT semicolon SWAP then U* U/ until variable while XOR (note that lower case entries refer to just the run-time code corresponding to a compiling word.) #### Interpreter Words -# #> #S ' ( -TRAILING . 79-STANDARD <# >IN ? ABORT BASE BLK CONTEXT CONVERT COUNT CR CURRENT DECIMAL EMIT EXPECT FIND FORTH HERE HOLD KEY PAD QUERY QUIT SIGN SPACE SPACES TYPE U. WORD + # #> #S ' ( -TRAILING . 79-STANDARD <# >IN ? ABORT BASE BLK CONTEXT CONVERT COUNT CR CURRENT DECIMAL EMIT EXPECT FIND FORTH HERE HOLD KEY PAD QUERY QUIT SIGN SPACE SPACES TYPE U. WORD #### Compiler Words -+LOOP , ." : ; ALLOT BEGIN COMPILE CONSTANT CREATE DEFINITIONS DO DOES> ELSE FORGET IF IMMEDIATE LITERAL LOOP REPEAT STATE THEN UNTIL VARIABLE VOCABULARY WHILE [ [COMPILE] ] + +LOOP , ." : ; ALLOT BEGIN COMPILE CONSTANT CREATE DEFINITIONS DO DOES> ELSE FORGET IF IMMEDIATE LITERAL LOOP REPEAT STATE THEN UNTIL VARIABLE VOCABULARY WHILE [ [COMPILE] ] #### Device Words -BLOCK BUFFER EMPTY-BUFFERS LIST LOAD SAVE-BUFFERS SCR UPDATE + BLOCK BUFFER EMPTY-BUFFERS LIST LOAD SAVE-BUFFERS SCR UPDATE ## Words @@ -106,9 +109,9 @@ BLOCK BUFFER EMPTY-BUFFERS LIST LOAD SAVE-BUFFERS SCR UPDATE | > | n1 n2 -- flag | I,C | Working | True if n1 greater than n2 | | | >IN | -- addr | U | | Leave addr of variable of char offset input stream {0,,1023}| | | >R | n -- | C | | Move n to return stack | | -| ? | addr -- | I,C | Working | Print contents of address | | +| ? | addr -- | I,C | Working | Print contents of address | | | ?DUP | n -- n ( n) | | duplicate n if non-zero | | -| @ | addr -- n | I,C | Working | Put on stack number at addr | | +| @ | addr -- n | I,C | Working | Put on stack number at addr | | | ABORT | | | Clear data and return stacks | | | ABS | n1 -- n1 | I,C | Working | Absolute value of n1 | | | ALLOT | n -- | I,C | Working | Add n bytes to parameter field of most recently defined word | | @@ -134,7 +137,7 @@ BLOCK BUFFER EMPTY-BUFFERS LIST LOAD SAVE-BUFFERS SCR UPDATE | DECIMAL | -- | | | Set input-output numeric conversation base to ten | | | DEFINITIONS | -- | | | Set current vocabulary to context vocabulary | | | DEPTH | -- n | | | Leave number of the quantity of 16-bit values contained in the data stack, before n added | | -| DNEGATE | d -- -d | | | Leave the two's complement of a double number. | | +| DNEGATE | d -- -d | I,C | impl. | Leave the two's complement of a double number. | | | DO | n1 n2 -- | C | Working | Used in a colon-definition:
DO ... LOOP or
DO ... +LOOP
Begin a loop which will terminate based on control parameters. The loop index begins at n2, and terminates based on the limit n1. At LOOP or +LOOP, the index is modified by a positive or negative value. The range of a DO-LOOP is determined by the terminating word. DO-LOOP may be nested. Capacity for three levels of nesting is specified as a minimum for standard systems. | | | DOES | | I,C | | Define the run-time action of a word created by a high-level defining word. Used in the form:
: **name** ... CREATE ... DOES> ... ;
and then **namex name**
Marks the termination of the defining part of the defining word **name** and begins the defining of the run-time action for words that will later be defined by **name**. On execution of **namex** the sequence of words between DOES> and ; are executed, with the address of **namex**'s parameter field on the stack. | | | DROP | n -- | I,C | Working | Drop top number from the stack | | @@ -171,7 +174,7 @@ BLOCK BUFFER EMPTY-BUFFERS LIST LOAD SAVE-BUFFERS SCR UPDATE | OVER | n1 n2 -- n1 n2 n1 | I,C | Working | Leave a copy of the second number on the stack. | | | PAD | -- addr | I,C | Working | The address of a scratch area used to hold character strings for intermediate processing. The minimum capacity of PAD is 64 characters (addr through addr+63). | | | PICK | n1 -- n2 | | | Return the contents of the n1-th stack value, not counting n1 itself. An error condition results for n less than one.
2 PICK is equivalent to OVER. {1..n} | | -| QUERY | | | | ccept input of up to 80 characters (or until a 'return') from the operator's terminal, into the terminal input buffer. WORD may be used to accept text from this buffer as the input stream, by setting >IN and BLK to zero. | | +| QUERY | | | | Accept input of up to 80 characters (or until a 'return') from the operator's terminal, into the terminal input buffer. WORD may be used to accept text from this buffer as the input stream, by setting >IN and BLK to zero. | | | QUIT | | | | Clear the return stack, setting execution mode, and return control to the terminal. No message is given. | | | R> | -- n | C | | Transfer n from the return stack to the data stack. | | | R@ | -- n | C | | Copy the number on top of the return stack to the data stack. | | @@ -217,17 +220,17 @@ DOUBLE NUMBER WORD SET | 2ROT | d1 d2 d3 -- d2 d3 d1 | | | Rotate the third double number to the top of the stack. | | | 2SWAP | d1 d2 -- d2 d1 | | | Exchange the top two double numbers on the stack. | | | 2VARIABLE | | | | A defining word used in the form:
2VARIABLE **name**
to create a dictionary entry of **name** and assign four bytes for storage in the parameter field. When **name** is later executed, it will leave the address of the first byte of its parameter field is placed on the stack. | | -| D+ | d1 d2 -- d3 | | | Leave the arithmetic sum of d1 and d2. | | -| D- | d1 d2 -- d3 | | | Subtract d2 from d1 and leave the difference d3. | | -| | D. | d -- | | | Display d converted according to BASE in a free field format, with one trailing blank. Display the sign only if negative. | | +| D+ | d1 d2 -- d3 | I,C | impl. | Leave the arithmetic sum of d1 and d2. | | +| D- | d1 d2 -- d3 | I,C | impl. | Subtract d2 from d1 and leave the difference d3. | | +| | D. | d -- | I,C | impl. | Display d converted according to BASE in a free field format, with one trailing blank. Display the sign only if negative. | | | D.R | d n -- | | | Display d converted according to BASE, right aligned in an n character field. Display the sign only if negative. | | | D0= | d -- flag | | | Leave true if d is zero. | | | D< | d1 d2 -- flag | | | True if d1 is less than d2. | | | D= | d1 d2 -- flag | | | True if d1 equals d2. | | -| DABS | d1 -- d2 | | | Leave as a positive double number d2, the absolute value of a double number, d1. {0..2,147,483,647} | | +| DABS | d1 -- d2 | I,C | impl. | Leave as a positive double number d2, the absolute value of a double number, d1. {0..2,147,483,647} | | | DMAX | d1 d2 -- d3 | | | Leave the larger of two double numbers. | | | DMIN | d1 d2 -- d3 | | | Leave the smaller of two double numbers. | | -| DNEGATE | d -- -d | | | Leave the double number two's complement of a double number, i.e., the difference 0 less d. | | +| DNEGATE | d -- -d | I,C | impl. | Leave the double number two's complement of a double number, i.e., the difference 0 less d. | | | DU< | ud1 ud2 -- flag | | | rue if ud1 is less than ud2. Both numbers are unsigned. | | ##Assembler Word Set diff --git a/.Floppies/A2OSX.BOOTHD.woz b/.Floppies/A2OSX.BOOTHD.woz index 51a500c0..8e40be4d 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 1f216567..54293913 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 07cc60a1..7388991a 100644 Binary files a/.Floppies/A2OSX.TEST.po and b/.Floppies/A2OSX.TEST.po differ diff --git a/BIN/CSH.S.EXEC.txt b/BIN/CSH.S.EXEC.txt index e9f47108..52682d3e 100644 --- a/BIN/CSH.S.EXEC.txt +++ b/BIN/CSH.S.EXEC.txt @@ -19,14 +19,7 @@ CSH.BOPS.ADDu8 clc rts CSH.BOPS.ADDi16 -CSH.BOPS.ADDu16 clc - ldy #1 - >PULLA - adc (pStack),y - sta (pStack),y - >PULLA - adc (pStack),y - sta (pStack),y +CSH.BOPS.ADDu16 >FPU ADD16 clc rts CSH.BOPS.ADDi32 @@ -53,18 +46,7 @@ CSH.BOPS.SUBu8 sec rts CSH.BOPS.SUBi16 -CSH.BOPS.SUBu16 sec - ldy #2 - lda (pStack),y - sbc (pStack) - sta (pStack),y - iny - lda (pStack),y - ldy #1 - sbc (pStack),y - inc pStack - inc pStack - sta (pStack),y +CSH.BOPS.SUBu16 >FPU SUB16 clc rts CSH.BOPS.SUBi32 diff --git a/BIN/FORTH.S.CP.txt b/BIN/FORTH.S.CP.txt index e096bb0e..41eca26c 100644 --- a/BIN/FORTH.S.CP.txt +++ b/BIN/FORTH.S.CP.txt @@ -1,17 +1,70 @@ NEW AUTO 3,1 *-------------------------------------- -CP.RUN cpx #KW.CONLY - bcs .1 >= KW.CONLY +CP.JSRX lda #$20 JSR + jsr CP.Emit.Byte + lda I.KEYWORDS,x + jsr CP.Emit.Byte + lda I.KEYWORDS+1,x + jmp CP.Emit.Byte +*-------------------------------------- +CP.ECOLON lda #$60 RTS + jsr CP.Emit.Byte - cpx #KW.ECOLON.ID - beq .1 END Compilation + stz bCompile - >LDYA J.KEYWORDS,x clc - jmp CP.Emit.JsrYA + rts +*-------------------------------------- +CP.INVALID lda #E.CSYN + sec + rts +*-------------------------------------- +* : TEST ." hello" CR ; +*-------------------------------------- +CP.PRINT ldy #$ff -.1 jmp (J.KEYWORDS,x) +.1 iny + lda (ZPCLBufPtr),y + + beq CP.INVALID + cmp #'"' + beq .2 + + sta (ZPDataPtr),y + bra .1 + +.2 lda #0 + sta (ZPDataPtr),y + + phy + + >LDYA ZPDataPtr + jsr CP.Emit.LDYAI + + ldx #SYS.PutS + jsr CP.Emit.SYSCALL + + pla + pha + sec skip " + adc ZPCLBufPtr + sta ZPCLBufPtr + bcc .3 + + inc ZPCLBufPtr+1 + +.3 pla + clc + adc ZPDataPtr + sta ZPDataPtr + bcc .4 + + inc ZPDataPtr+1 + +.4 + clc + rts *-------------------------------------- CP.DO jsr CP.Emit.DO I,n -> RP @@ -324,6 +377,28 @@ CP.Emit.LEAVE ldx #CODE.LEAVE.L rts *-------------------------------------- +CP.Emit.LDYAI pha + lda #$A0 LDY #imm + jsr CP.Emit.Byte + tya + jsr CP.Emit.Byte + + lda #$A9 LDA #imm + jsr CP.Emit.Byte + pla + jmp CP.Emit.Byte +*-------------------------------------- +CP.Emit.SYSCALL lda #$A2 LDX #imm + jsr CP.Emit.Byte + txa + jsr CP.Emit.Byte + lda #$20 JSR + jsr CP.Emit.Byte + lda #A2osX.SYSCALL + jsr CP.Emit.Byte + lda /A2osX.SYSCALL + jmp CP.Emit.Byte +*-------------------------------------- CP.Emit.JsrYA pha lda #$20 jsr CP.Emit.Byte diff --git a/BIN/FORTH.S.KW.txt b/BIN/FORTH.S.KW.txt index 0b103424..3880712a 100644 --- a/BIN/FORTH.S.KW.txt +++ b/BIN/FORTH.S.KW.txt @@ -53,6 +53,10 @@ KW.Lookup >LDYA L.KEYWORDS jmp IsSpaceOrCR CS=end of valid chars *-------------------------------------- +KW.INVALID lda #E.CSYN + sec + rts +*-------------------------------------- KW.qDUP lda (pStack) ldy #1 ora (pStack),y @@ -396,28 +400,7 @@ KW.MIN jsr CheckStackPop4 KW.ABS ldy #1 lda (pStack),y HI - bpl .8 - - lda (pStack) - clc - eor #$ff - adc #1 - sta (pStack) - - lda (pStack),y - eor #$ff - adc #0 - sta (pStack),y - - - -.8 clc - rts -*-------------------------------------- -KW.DABS - lda #E.SYN - sec - rts + bpl KW.NEGATE.8 *-------------------------------------- KW.NEGATE lda (pStack) LO eor #$ff @@ -431,9 +414,14 @@ KW.NEGATE lda (pStack) LO adc #0 sta (pStack),y - clc +KW.NEGATE.8 clc rts *-------------------------------------- +KW.DABS ldy #3 + + lda (pStack),y HI + bpl KW.DNEGATE.8 +*-------------------------------------- KW.DNEGATE lda (pStack) LO eor #$ff sec @@ -458,7 +446,7 @@ KW.DNEGATE lda (pStack) LO adc #0 sta (pStack),y - clc +KW.DNEGATE.8 clc rts *-------------------------------------- KW.AND jsr CheckStackPop4 @@ -649,8 +637,23 @@ KW.U. jsr KW.DUP .9 rts *-------------------------------------- KW..R + lda #E.SYN + sec + rts *-------------------------------------- -KW.D. +KW.D. >PUSHW L.FMT.int32 + ldy #5 + ldx #4 + +.1 lda (pStack),y + >PUSHA + dex + bne .1 + + >PUSHBI 4 + >SYSCALL PrintF + + >RET 4 *-------------------------------------- KW.D.R lda #E.SYN @@ -920,32 +923,21 @@ KW.ASSEMBLER sec rts *-------------------------------------- -KW.VLIST bit bCompile - bpl .10 - -.8 clc -.9 rts - -.10 stz ZPPtr2 - stz ZPPtr2+1 +KW.VLIST stz ZPPtr1 + stz ZPPtr1+1 -.1 >LDYA ZPPtr2 - >STYA ZPPtr1 +.1 >LDYA ZPPtr1 + >STYA ZPKeyID >PUSHB.G hSList - >PUSHW ZPPtr1 + >PUSHW ZPKeyID >PUSHW ZPOutputBufPtr >SYSCALL SListGetByID bcs .8 - >STYA ZPPtr2 Save Next ID + >STYA ZPPtr1 Save Next ID - >PUSHB.G hSList - >PUSHW ZPPtr1 KeyID - >PUSHW ZPType - >PUSHWI 4 - >PUSHWZ from Start - >SYSCALL SListGetData + jsr CS.RUN.GetSymbolData bcs .9 >PUSHW L.MSG.DUMP2 @@ -953,17 +945,23 @@ KW.VLIST bit bCompile ldx #4 bit ZPType bmi .2 + dex dex bvs .2 + dex dex + .2 >PUSHW L.MSG.TYPES,x >PUSHW ZPAddrPtr >PUSHBI 6 >SYSCALL PrintF jmp .1 +.8 clc +.9 rts + KW.VC.9 lda #E.STACKERROR sec rts @@ -1024,10 +1022,7 @@ KM.VC sta ZPType .9 rts *-------------------------------------- -KW.BCOLON bit bCompile - bmi KW.COLON.SYN - - >PUSHB.G hSList +KW.BCOLON >PUSHB.G hSList >PUSHW ZPCLBufPtr >SYSCALL SListNewKey @@ -1056,21 +1051,6 @@ KW.BCOLON bit bCompile clc .9 rts - -KW.COLON.SYN lda #E.SYN - sec - rts -*-------------------------------------- -KW.ECOLON bit bCompile - bpl KW.COLON.SYN - - lda #$60 - jsr CP.Emit.Byte - - stz bCompile - - clc - rts *-------------------------------------- KW.ACODE *-------------------------------------- diff --git a/BIN/FORTH.S.txt b/BIN/FORTH.S.txt index 17409999..8c5aa303 100644 --- a/BIN/FORTH.S.txt +++ b/BIN/FORTH.S.txt @@ -93,20 +93,21 @@ L.MSG.TYPES .DA MSG.CONST L.FMT.Byte .DA FMT.Byte L.FMT.int16 .DA FMT.int16 L.FMT.uint16 .DA FMT.uint16 +L.FMT.int32 .DA FMT.int32 J.ESC .DA CL.BS left arrow .DA HIS.GetNext .DA HIS.GetPrev .DA CL.NAK right arrow L.KEYWORDS .DA KEYWORDS -J.KEYWORDS .DA GFX.PLOT +I.KEYWORDS .DA GFX.PLOT .DA GFX.RECT -J.KEYWORDS.DUP .DA KW.DUP + .DA KW.DUP .DA KW.DROP .DA KW.SWAP -J.KEYWORDS.OVER .DA KW.OVER + .DA KW.OVER .DA KW.ROT .DA KW.qDUP -J.KEYWORDS.ADD .DA KW.Add + .DA KW.Add .DA KW.DAdd .DA KW.Sub .DA KW.DSub @@ -125,7 +126,7 @@ J.KEYWORDS.ADD .DA KW.Add .DA KW.AND .DA KW.OR .DA KW.XOR -J.KEYWORDS.LWR .DA KW.LWR + .DA KW.LWR .DA KW.GTR .DA KW.EQ .DA KW.NEGATIVE @@ -184,20 +185,120 @@ J.KEYWORDS.LWR .DA KW.LWR .DA KW.CONSTANT *-------------------------------------- .DA KW.BCOLON -KW.ECOLON.ID .EQ *-J.KEYWORDS - .DA KW.ECOLON + .DA KW.INVALID KW.ECOLON .DA KW.ACODE .DA KW.FCODE +KW.DO.ID .EQ *-I.KEYWORDS + .DA KW.INVALID KW.DO + .DA KW.INVALID KW.LOOP + .DA KW.INVALID KW.pLOOP + .DA KW.INVALID KW.I + .DA KW.INVALID KW.LEAVE +KW.IF.ID .EQ *-I.KEYWORDS + .DA KW.INVALID KW.IF + .DA KW.INVALID KW.ELSE + .DA KW.INVALID KW.THEN + .DA KW.INVALID KW.BEGIN + .DA KW.INVALID KW.UNTIL + .DA KW.INVALID KW.REPEAT + .DA KW.INVALID KW.WHILE + .DA KW.gR + .DA KW.Rg + .DA KW.R *-------------------------------------- -KW.CONLY .EQ *-J.KEYWORDS -*-------------------------------------- -KW.DO.ID .EQ *-J.KEYWORDS +C.KEYWORDS .DA CP.JSRX GFX.PLOT + .DA CP.JSRX GFX.RECT + .DA CP.JSRX KW.DUP + .DA CP.JSRX KW.DROP + .DA CP.JSRX KW.SWAP + .DA CP.JSRX KW.OVER + .DA CP.JSRX KW.ROT + .DA CP.JSRX KW.qDUP + .DA CP.JSRX KW.Add + .DA CP.JSRX KW.DAdd + .DA CP.JSRX KW.Sub + .DA CP.JSRX KW.DSub + .DA CP.JSRX KW.Mul + .DA CP.JSRX KW.Div + .DA CP.JSRX KW.Mod + .DA CP.JSRX KW.DivMod + .DA CP.JSRX KW.MulDivMod + .DA CP.JSRX KW.MulDiv + .DA CP.JSRX KW.MAX + .DA CP.JSRX KW.MIN + .DA CP.JSRX KW.ABS + .DA CP.JSRX KW.DABS + .DA CP.JSRX KW.NEGATE + .DA CP.JSRX KW.DNEGATE + .DA CP.JSRX KW.AND + .DA CP.JSRX KW.OR + .DA CP.JSRX KW.XOR + .DA CP.JSRX KW.LWR + .DA CP.JSRX KW.GTR + .DA CP.JSRX KW.EQ + .DA CP.JSRX KW.NEGATIVE + .DA CP.JSRX KW.ZERO + .DA CP.JSRX KW.. + .DA CP.JSRX KW.U. + .DA CP.JSRX KW..R + .DA CP.JSRX KW.D. + .DA CP.JSRX KW.D.R + .DA CP.JSRX KW.CR + .DA CP.JSRX KW.SPACE + .DA CP.JSRX KW.SPACES + .DA CP.PRINT + .DA CP.JSRX KW.DUMP + .DA CP.JSRX KW.TYPE + .DA CP.JSRX KW.COUNT + .DA CP.JSRX KW.TERMINAL + .DA CP.JSRX KW.KEY + .DA CP.JSRX KW.EMIT + .DA CP.JSRX KW.EXPECT + .DA CP.JSRX KW.WORD + .DA CP.JSRX KW.NUMBER + .DA CP.JSRX KW.STARTSTR + .DA CP.JSRX KW.STRADD + .DA CP.JSRX KW.STRDBL + .DA CP.JSRX KW.SIGN + .DA CP.JSRX KW.ENDSTR + .DA CP.JSRX KW.HOLD + .DA CP.JSRX KW.DECIMAL + .DA CP.JSRX KW.HEX + .DA CP.JSRX KW.OCTAL + .DA CP.JSRX KW.FETCHSP + .DA CP.JSRX KW.FETCHW + .DA CP.JSRX KW.STOREW + .DA CP.JSRX KW.FETCHB + .DA CP.JSRX KW.STOREB + .DA CP.JSRX KW.FETCHPRINTW + .DA CP.JSRX KW.ADDTOW + .DA CP.JSRX KW.CMOVE + .DA CP.JSRX KW.FILL + .DA CP.JSRX KW.ERASE + .DA CP.JSRX KW.BLANKS + .DA CP.JSRX KW.HERE + .DA CP.JSRX KW.PAD + .DA CP.JSRX KW.ALLOT + .DA CP.JSRX KW.nCOMPILE + .DA CP.JSRX KW.QUOTE + .DA CP.JSRX KW.FORGET + .DA CP.JSRX KW.DEFINITIONS + .DA CP.JSRX KW.VOCABULARY + .DA CP.JSRX KW.FORTH + .DA CP.JSRX KW.EDITOR + .DA CP.JSRX KW.ASSEMBLER + .DA CP.INVALID KW.VLIST + .DA CP.JSRX KW.VARIABLE + .DA CP.JSRX KW.CONSTANT + .DA CP.INVALID KW.BCOLON + .DA CP.ECOLON + .DA CP.INVALID KW.ACODE + .DA CP.INVALID KW.FCODE .DA CP.DO .DA CP.LOOP .DA CP.pLOOP .DA CP.I .DA CP.LEAVE -KW.IF.ID .EQ *-J.KEYWORDS .DA CP.IF .DA CP.ELSE .DA CP.THEN @@ -205,9 +306,9 @@ KW.IF.ID .EQ *-J.KEYWORDS .DA CP.UNTIL .DA CP.REPEAT .DA CP.WHILE - .DA KW.gR - .DA KW.Rg - .DA KW.R + .DA CP.JSRX KW.gR + .DA CP.JSRX KW.Rg + .DA CP.JSRX KW.R .DA 0 *-------------------------------------- CS.INIT clc @@ -457,25 +558,16 @@ CS.RUN.EXEC lda (ZPCLBufPtr) rts .8 clc -.9 rts + rts .7 bit bCompile bmi .71 - cpx #KW.CONLY - bcc .70 +.70 jmp (I.KEYWORDS,x) INTERPRET - lda #E.SYN - sec - rts +.71 jmp (C.KEYWORDS,x) COMPILE -.70 jmp (J.KEYWORDS,x) INTERPRET - -.71 jmp CP.RUN COMPILE - -.80 -* >DEBUG - jmp (ZPAddrPtr) +.80 jmp (ZPAddrPtr) RUN *-------------------------------------- CS.RUN.ARGS inc ArgIndex @@ -536,25 +628,26 @@ CS.RUN.FOpen >PUSHYA >STA.G hFile -.9 rts +.9 +CS.RUN.FOpen.RTS + rts *-------------------------------------- CS.RUN.GetSymbol >PUSHB.G hSList >PUSHW ZPCLBufPtr >SYSCALL SListLookup - bcs .9 + bcs CS.RUN.FOpen.RTS >STYA ZPKeyID txa jsr NextKW - +CS.RUN.GetSymbolData >PUSHB.G hSList >PUSHW ZPKeyID >PUSHWI ZPType >PUSHWI 4 4 bytes >PUSHWZ From Start - >SYSCALL SListGetData .9 rts @@ -831,6 +924,7 @@ MSG.CODE .AZ "Code @=" FMT.Byte .AZ "%d " FMT.int16 .AZ "%I " FMT.uint16 .AZ "%D " +FMT.int32 .AZ "%L " *-------------------------------------- OptionList .AS "DdTt" OptionVars .DA #bDebug,#bDebug,#bTrace,#bTrace diff --git a/LIB/LIBBLKDEV.S.D2.txt b/LIB/LIBBLKDEV.S.D2.txt index 9e96edb7..85fe773e 100644 --- a/LIB/LIBBLKDEV.S.D2.txt +++ b/LIB/LIBBLKDEV.S.D2.txt @@ -135,10 +135,10 @@ D2.MoveHead.SEI lda D2.CurrentQTrack jsr D2.Wait25600usec - lda IO.D2.Ph0Off,x - nop - nop - lda IO.D2.Ph0Off,y + sta IO.D2.Ph0Off,x +* nop +* nop + sta IO.D2.Ph0Off,y rts D2.SeekPhOnY and #6 diff --git a/ProDOS.FX/ProDOS.S.XRW.txt b/ProDOS.FX/ProDOS.S.XRW.txt index 7f66fb67..20f1e4ff 100644 --- a/ProDOS.FX/ProDOS.S.XRW.txt +++ b/ProDOS.FX/ProDOS.S.XRW.txt @@ -399,18 +399,13 @@ XRW.TestWP ldx A2L * on entry: x = slotnum times 16 *-------------------------------------- .LIST ON -XRW.Write lda IO.D2.RData,x (4) +XRW.Write bit IO.D2.ReadProt,x (4) PREWRITE MODE .LIST OFF - bpl XRW.Write (2) - - lda #$FF (2) - - bit IO.D2.ReadProt,x (4) PREWRITE MODE * bit IO.D2.ReadMode,x (4) - - bra .11 (3) -.11 sta IO.D2.WriteMode,x (5) goto write mode + lda #$FF (2) + + sta IO.D2.WriteMode,x (5) goto write mode ora IO.D2.WShift,x (4) nop (2) @@ -844,25 +839,25 @@ XRW.SeekYA sta XRW.D2Trk-1,x will be current track at the end jsr XRW.Wait25600usec -XRW.SeekPhOff lda IO.D2.Ph0Off,x - nop - nop - lda IO.D2.Ph0Off,y +XRW.SeekPhOff sta IO.D2.Ph0Off,x +* nop +* nop + sta IO.D2.Ph0Off,y clc Exit wit CC (recalibrate) rts *-------------------------------------- -XRW.SeekPhOnXY lda XRW.ReqTrack2 +*XRW.SeekPhOnXY lda XRW.ReqTrack2 - jsr XRW.Trk2Qtrk - pha - and #6 - ora A2L - tax +* jsr XRW.Trk2Qtrk +* pha +* and #6 +* ora A2L +* tax - lda IO.D2.Ph0On,x +* lda IO.D2.Ph0On,x - pla - inc +* pla +* inc XRW.SeekPhOnY and #6 ora A2L