URL
https://opencores.org/ocsvn/rtf65002/rtf65002/trunk
Subversion Repositories rtf65002
Compare Revisions
- This comparison shows the changes necessary to convert path
/
- from Rev 39 to Rev 40
- ↔ Reverse comparison
Rev 39 → Rev 40
/rtf65002/trunk/software/asm/SDCard.asm
0,0 → 1,566
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2013, 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; SDCard.asm |
; ============================================================================ |
; |
cpu RTF65002 |
|
.code |
|
align 4 |
;------------------------------------------------------------------------------ |
; Static device control block (SDBC) structure |
;------------------------------------------------------------------------------ |
|
public SDCardDCB: |
align 4 |
db "CARD1 " ; name |
dw 5 ; number of chars in name |
dw 16 ; type |
dw 1 ; nBPB |
dw 0 ; last erc |
dw 8388608 ; nBlocks |
dw SDCmdProc |
dw SDInit |
dw SDStat |
dw 1 ; reentrancy count (1 to 255 are valid) |
dw 0 ; single user |
dw 0 ; hJob |
dw 0 ; OSD1 |
dw 0 ; OSD2 |
dw 0 ; OSD3 |
dw 0 ; OSD4 |
dw 0 ; OSD5 |
dw 0 ; OSD6 |
|
SDOpTbl: |
dw SDNop |
dw SDInit |
dw SDMediaCheck |
dw SDBuildBPB |
dw SDNop ; GetChar ; GetChar() |
dw SDNop ; CheckForChar ; PeekChar() |
dw SDNop ; GetCharDirect ; unbuffered GetChar() |
dw SDNop ; CheckForCharDirect ; unbuffered PeekChar() |
dw SDNop ; PutChar ; KeybdPutChar |
dw SDNop ; SetEcho |
dw SDSetpos ; set position |
dw SDReadBlocks ; block read |
dw SDWriteBlocks ; block write |
dw SDNop |
dw SDNop |
dw SDNop |
|
SDStat: |
rts |
SDBuildBPB: |
rts |
SDSetpos: |
rts |
; |
;------------------------------------------------------------------------------ |
; SDCmdProc: |
; Device command processor. |
; |
; Parameters: |
; r1 = device # |
; r2 = opcode |
; r3 = position |
; r4 = number of blocks |
; r5 = pointer to data area |
;------------------------------------------------------------------------------ |
|
SDCmdProc: |
cmp #16 |
bne .0001 |
phx |
phy |
push r4 |
push r5 |
mul r1,r1,#DCB_SIZE ; convert device number to DCB pointer |
add #DCBs |
ld r0,DCB_pDevInit,r1 ; check for an initialization routine |
beq .0002 ; to see if device present |
cmp r2,#MAX_DEV_OP |
bhi .0003 |
pha ; save off DCB pointer |
jsr (SDOpTbl>>2,x) |
plx |
sta DCB_last_erc,x ; stuff the error return code in the DCB |
.ret: |
pop r5 |
pop r4 |
ply |
plx |
rts |
.0001: |
lda #E_BadDevNum |
rts |
.0002: |
lda #E_NoDev |
bra .ret |
.0003: |
lda #E_BadDevOp |
bra .ret |
|
;------------------------------------------------------------------------------ |
; SDNop: |
; No-operation routine. |
;------------------------------------------------------------------------------ |
|
SDNop: |
lda #E_Ok |
rts |
|
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
|
SDMediaCheck: |
lda #E_Ok |
rts |
|
;------------------------------------------------------------------------------ |
; Initialize the SD card |
; Returns |
; acc = 0 if successful, 1 otherwise |
; Z=1 if successful, otherwise Z=0 |
;------------------------------------------------------------------------------ |
; |
message "SDInit" |
public SDInit: |
lda #SPI_INIT_SD |
sta SPIMASTER+SPI_TRANS_TYPE_REG |
lda #SPI_TRANS_START |
sta SPIMASTER+SPI_TRANS_CTRL_REG |
nop |
.spi_init1 |
lda SPIMASTER+SPI_TRANS_STATUS_REG |
nop |
nop |
cmp #SPI_TRANS_BUSY |
beq .spi_init1 |
lda SPIMASTER+SPI_TRANS_ERROR_REG |
and #3 |
cmp #SPI_INIT_NO_ERROR |
bne spi_error |
; lda #spi_init_ok_msg |
; jsr DisplayStringB |
lda #0 |
rts |
spi_error |
jsr DisplayByte |
lda #spi_init_error_msg |
jsr DisplayStringB |
lda SPIMASTER+SPI_RESP_BYTE1 |
jsr DisplayByte |
lda SPIMASTER+SPI_RESP_BYTE2 |
jsr DisplayByte |
lda SPIMASTER+SPI_RESP_BYTE3 |
jsr DisplayByte |
lda SPIMASTER+SPI_RESP_BYTE4 |
jsr DisplayByte |
lda #1 |
rts |
|
spi_delay: |
nop |
nop |
rts |
|
|
;------------------------------------------------------------------------------ |
; SD read sector |
; |
; r1= sector number to read |
; r2= address to place read data |
; Returns: |
; r1 = 0 if successful |
;------------------------------------------------------------------------------ |
; |
public SDReadSector: |
phx |
phy |
push r4 |
|
sta SPIMASTER+SPI_SD_SECT_7_0_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_15_8_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_23_16_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_31_24_REG |
|
ld r4,#20 ; retry count |
|
.spi_read_retry: |
; Force the reciever fifo to be empty, in case a prior error leaves it |
; in an unknown state. |
lda #1 |
sta SPIMASTER+SPI_RX_FIFO_CTRL_REG |
|
lda #RW_READ_SD_BLOCK |
sta SPIMASTER+SPI_TRANS_TYPE_REG |
lda #SPI_TRANS_START |
sta SPIMASTER+SPI_TRANS_CTRL_REG |
nop |
.spi_read_sect1: |
lda SPIMASTER+SPI_TRANS_STATUS_REG |
jsr spi_delay ; just a delay between consecutive status reg reads |
cmp #SPI_TRANS_BUSY |
beq .spi_read_sect1 |
lda SPIMASTER+SPI_TRANS_ERROR_REG |
lsr |
lsr |
and #3 |
cmp #SPI_READ_NO_ERROR |
bne .spi_read_error |
ldy #512 ; read 512 bytes from fifo |
.spi_read_sect2: |
lda SPIMASTER+SPI_RX_FIFO_DATA_REG |
sb r1,0,x |
inx |
dey |
bne .spi_read_sect2 |
lda #0 |
bra .spi_read_ret |
.spi_read_error: |
dec r4 |
bne .spi_read_retry |
jsr DisplayByte |
lda #spi_read_error_msg |
jsr DisplayStringB |
lda #1 |
.spi_read_ret: |
pop r4 |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; BlocksToSectors: |
; Convert a logical block number (LBA) to a sector number |
;------------------------------------------------------------------------------ |
|
BlocksToSectors: |
asl r1,r1,#1 ; 1k blocks = 2 sectors |
rts |
|
;------------------------------------------------------------------------------ |
; SDReadBlocks: |
; |
; Registers Affected: r1-r5 |
; Parameters: |
; r1 = pointer to DCB |
; r3 = block number |
; r4 = number of blocks |
; r5 = pointer to data area |
;------------------------------------------------------------------------------ |
|
public SDReadBlocks: |
cpy DCB_nBlocks,r1 |
bhs .0002 |
add r2,r3,r4 |
cpx DCB_nBlocks,r1 |
bhi .0003 |
ld r2,r5 ; x = pointer to data buffer |
tya |
jsr BlocksToSectors ; acc = sector number |
pha |
ld r1,r4 |
jsr BlocksToSectors |
tay ; y = # of blocks to read |
pla ; acc = sector number again |
jsr SDReadMultiple |
cmp #0 |
bne .0001 |
lda #E_Ok |
rts |
.0001 |
lda #E_ReadError |
rts |
.0002 |
lda #E_BadBlockNum |
rts |
.0003: |
lda #E_TooManyBlocks |
rts |
|
;------------------------------------------------------------------------------ |
; SDWriteBlocks: |
; |
; Parameters: |
; r1 = pointer to DCB |
; r3 = block number |
; r4 = number of blocks |
; r5 = pointer to data area |
;------------------------------------------------------------------------------ |
|
public SDWriteBlocks: |
cpy DCB_nBlocks,r1 |
bhs .0002 |
add r2,r3,r4 |
cpx DCB_nBlocks,r1 |
bhi .0003 |
ld r2,r5 ; x = pointer to data buffer |
tya |
jsr BlocksToSectors ; acc = sector number |
pha |
ld r1,r4 |
jsr BlocksToSectors |
tay ; y = # of blocks to read |
pla ; acc = sector number again |
jsr SDWriteMultiple |
cmp #0 |
bne .0001 |
lda #E_Ok |
rts |
.0001 |
lda #E_WriteError |
rts |
.0002 |
lda #E_BadBlockNum |
rts |
.0003: |
lda #E_TooManyBlocks |
rts |
|
;------------------------------------------------------------------------------ |
; SDWriteSector: |
; |
; r1= sector number to write |
; r2= address to get data from |
; Returns: |
; r1 = 0 if successful |
;------------------------------------------------------------------------------ |
; |
public SDWriteSector: |
phx |
phy |
pha |
; Force the transmitter fifo to be empty, in case a prior error leaves it |
; in an unknown state. |
lda #1 |
sta SPIMASTER+SPI_TX_FIFO_CTRL_REG |
nop ; give I/O time to respond |
nop |
|
; now fill up the transmitter fifo |
ldy #512 |
.spi_write_sect1: |
lb r1,0,x |
sta SPIMASTER+SPI_TX_FIFO_DATA_REG |
nop ; give the I/O time to respond |
nop |
inx |
dey |
bne .spi_write_sect1 |
|
; set the sector number in the spi master address registers |
pla |
sta SPIMASTER+SPI_SD_SECT_7_0_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_15_8_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_23_16_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_31_24_REG |
|
; issue the write command |
lda #RW_WRITE_SD_BLOCK |
sta SPIMASTER+SPI_TRANS_TYPE_REG |
lda #SPI_TRANS_START |
sta SPIMASTER+SPI_TRANS_CTRL_REG |
nop |
.spi_write_sect2: |
lda SPIMASTER+SPI_TRANS_STATUS_REG |
nop ; just a delay between consecutive status reg reads |
nop |
cmp #SPI_TRANS_BUSY |
beq .spi_write_sect2 |
lda SPIMASTER+SPI_TRANS_ERROR_REG |
lsr r1,r1,#4 |
and #3 |
cmp #SPI_WRITE_NO_ERROR |
bne .spi_write_error |
lda #0 |
bra .spi_write_ret |
.spi_write_error: |
jsr DisplayByte |
lda #spi_write_error_msg |
jsr DisplayStringB |
lda #1 |
|
.spi_write_ret: |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; SDReadMultiple: read multiple sectors |
; |
; r1= sector number to read |
; r2= address to write data |
; r3= number of sectors to read |
; |
; Returns: |
; r1 = 0 if successful |
; |
;------------------------------------------------------------------------------ |
|
public SDReadMultiple: |
push r4 |
ld r4,#0 |
.spi_rm1: |
pha |
jsr SDReadSector |
add r4,r4,r1 |
add r2,r2,#512 |
pla |
ina |
dey |
bne .spi_rm1 |
ld r1,r4 |
pop r4 |
rts |
|
;------------------------------------------------------------------------------ |
; SPI write multiple sector |
; |
; r1= sector number to write |
; r2= address to get data from |
; r3= number of sectors to write |
; |
; Returns: |
; r1 = 0 if successful |
;------------------------------------------------------------------------------ |
; |
public SDWriteMultiple: |
push r4 |
ld r4,#0 |
.spi_wm1: |
pha |
jsr SDWriteSector |
add r4,r4,r1 ; accumulate an error count |
add r2,r2,#512 ; 512 bytes per sector |
pla |
ina |
dey |
bne .spi_wm1 |
ld r1,r4 |
pop r4 |
rts |
|
;------------------------------------------------------------------------------ |
; read the partition table to find out where the boot sector is. |
; Returns |
; r1 = 0 everything okay, 1=read error |
; also Z=1=everything okay, Z=0=read error |
;------------------------------------------------------------------------------ |
|
public SDReadPart: |
phx |
stz startSector ; default starting sector |
lda #0 ; r1 = sector number (#0) |
ldx #BYTE_SECTOR_BUF ; r2 = target address (word to byte address) |
jsr SDReadSector |
cmp #0 |
bne .spi_rp1 |
lb r1,BYTE_SECTOR_BUF+$1C9 |
asl r1,r1,#8 |
orb r1,r1,BYTE_SECTOR_BUF+$1C8 |
asl r1,r1,#8 |
orb r1,r1,BYTE_SECTOR_BUF+$1C7 |
asl r1,r1,#8 |
orb r1,r1,BYTE_SECTOR_BUF+$1C6 |
sta startSector ; r1 = 0, for okay status |
lb r1,BYTE_SECTOR_BUF+$1CD |
asl r1,r1,#8 |
orb r1,r1,BYTE_SECTOR_BUF+$1CC |
asl r1,r1,#8 |
orb r1,r1,BYTE_SECTOR_BUF+$1CB |
asl r1,r1,#8 |
orb r1,r1,BYTE_SECTOR_BUF+$1CA |
sta disk_size ; r1 = 0, for okay status |
plx |
lda #0 |
rts |
.spi_rp1: |
plx |
lda #1 |
rts |
|
;------------------------------------------------------------------------------ |
; Read the boot sector from the disk. |
; Make sure it's the boot sector by looking for the signature bytes 'EB' and '55AA'. |
; Returns: |
; r1 = 0 means this card is bootable |
; r1 = 1 means a read error occurred |
; r1 = 2 means the card is not bootable |
;------------------------------------------------------------------------------ |
|
public SDReadBoot: |
phx |
phy |
push r5 |
lda startSector ; r1 = sector number |
ldx #BYTE_SECTOR_BUF ; r2 = target address |
jsr SDReadSector |
cmp #0 |
bne spi_read_boot_err |
lb r1,BYTE_SECTOR_BUF |
cmp #$EB |
bne spi_eb_err |
spi_read_boot2: |
lda #msgFoundEB |
jsr DisplayStringB |
lb r1,BYTE_SECTOR_BUF+$1FE ; check for 0x55AA signature |
cmp #$55 |
bne spi_eb_err |
lb r1,BYTE_SECTOR_BUF+$1FF ; check for 0x55AA signature |
cmp #$AA |
bne spi_eb_err |
pop r5 |
ply |
plx |
lda #0 ; r1 = 0, for okay status |
rts |
spi_read_boot_err: |
pop r5 |
ply |
plx |
lda #1 |
rts |
spi_eb_err: |
lda #msgNotFoundEB |
jsr DisplayStringB |
pop r5 |
ply |
plx |
lda #2 |
rts |
|
msgFoundEB: |
db "Found EB code.",CR,LF,0 |
msgNotFoundEB: |
db "EB/55AA Code missing.",CR,LF,0 |
|
/rtf65002/trunk/software/asm/keyboard.asm
0,0 → 1,679
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2013, 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; keyboard.asm |
; ============================================================================ |
; |
DCMD_INITIALIZE EQU 0 |
DCMD_MEDIA_CHK EQU 1 |
DCMD_BUILD_BPB EQU 2 |
DCMD_IOCTRL_READ EQU 3 |
DCMD_READ EQU 4 |
DCMD_PEEK EQU 5 |
DCMD_INPUT_STATUS EQU 6 |
DCMD_FLUSH_INPUT EQU 7 |
DCMD_WRITE EQU 8 |
DCMD_WRITE_VERIFY EQU 9 |
DCMD_OUTPUT_STATUS EQU 10 |
DCMD_FLUSH_OUTPUT EQU 11 |
DCMD_IOCTRL_WRITE EQU 12 |
DCMD_OPEN EQU 13 |
DCMD_CLOSE EQU 14 |
DCMD_IS_REMOVEABLE EQU 15 |
DCMD_OUTPUT_UNTIL_BUSY EQU 16 |
DCMD_IRQ EQU 0xFFFFFFFD |
DCMD_GETCHAR EQU 32 |
|
DRSP_DONE EQU 1 |
|
cpu RTF65002 |
|
.code |
;------------------------------------------------------------------------------ |
; The keyboard interrupt is selectively disabled and enabled to protect |
; the keyboard buffers structure. Other interrupts are still enabled. |
;------------------------------------------------------------------------------ |
|
macro DisKeybd |
pha |
lda #15 |
sta PIC+2 |
pla |
endm |
|
macro EnKeybd |
pha |
lda #15 |
sta PIC+3 |
pla |
endm |
|
align 4 |
; Device driver struct |
dw 0xFFFFFFFF ; link to next device |
dw 0x00008001 ; device attributes |
dw KeybdStrategy ; strategy routine |
dw KeybdIRQ ; interrupt routine |
dw KeybdCmdProc ; command processor |
|
align 4 |
dw KeybdNop |
dw KeybdInit |
dw KeybdMediaChk |
dw KeybdBuildBPB |
dw KeybdGetChar ; GetChar() |
dw KeybdCheckForKey ; PeekChar() |
dw KeybdGetCharDirect ; unbuffered GetChar() |
dw KeybdCheckForKeyDirect ; unbuffered PeekChar() |
dw SendByteToKeybd ; KeybdPutChar |
dw SetKeyboardEcho |
dw KeybdSetpos ; set position |
|
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
public KeybdDCB: |
align 4 |
db "KBD1 " ; name |
dw 4 ; number of chars in name |
dw 1 ; type |
dw 1 ; nBPB |
dw 0 ; last erc |
dw 0 ; nBlocks |
dw KeybdCmdProc |
dw KeybdInit |
dw KeybdStat |
dw 1 ; reentrancy count (1 to 255 are valid) |
dw 0 ; single user |
dw 0 ; hJob |
dw 0 ; OSD1 |
dw 0 ; OSD2 |
dw 0 ; OSD3 |
dw 0 ; OSD4 |
dw 0 ; OSD5 |
dw 0 ; OSD6 |
|
KeybdStrategy: |
rts |
KeybdCmdProc: |
rts |
KeybdStat: |
rts |
KeybdBuildBPB: |
rts |
KeybdSetpos: |
rts |
KeybdNop: |
lda #E_Ok |
rts |
|
;------------------------------------------------------------------------------ |
; Setup keyboard |
; |
; Issues a 'reset keyboard' command to the keyboard, then selects scan code |
; set #2 (the most common one). Also sets up the keyboard buffer and |
; initializes the keyboard semaphore. |
;------------------------------------------------------------------------------ |
; |
message "KeybdSetup" |
public KeybdSetup: |
lda #1 ; setup semaphore |
sta keybd_sema |
lda #32 |
sta LEDS |
ldx #0 |
|
; Set Keyboard IRQ vector |
tsr vbr,r2 |
and r2,#-2 |
lda #KeybdIRQ |
sta 448+15,x |
|
lda #15 ; enable kbd_irq |
sta PIC+3 |
|
jsr KeybdInit |
|
lda #1 ; keyboard is device #1 |
ldx #KeybdDCB ; pointer to DCB |
ldy #1 ; number of DCB's to setup |
ld r4,#1 ; Flag: is okay to replace existing device |
; jsr InitDevDrv |
stz keybdInIRQ |
inc keybdIsSetup ; set the setup flag |
rts |
|
KeybdInit: |
lda #33 |
sta LEDS |
lda #$ff ; issue keyboard reset |
jsr SendByteToKeybd |
lda #38 |
sta LEDS |
lda #4 |
; jsr Sleep |
lda #1000000 ; delay a bit |
kbdi5: |
dea |
sta LEDS |
bne kbdi5 |
lda #34 |
sta LEDS |
lda #0xf0 ; send scan code select |
jsr SendByteToKeybd |
lda #35 |
sta LEDS |
ldx #0xFA |
jsr WaitForKeybdAck |
cmp #$FA |
bne kbdi2 |
lda #36 |
sta LEDS |
lda #2 ; select scan code set#2 |
jsr SendByteToKeybd |
lda #39 |
sta LEDS |
kbdi2: |
rts |
|
msgBadKeybd: |
db "Keyboard not responding.",0 |
|
SendByteToKeybd: |
phx |
ldx IOFocusNdx |
sta KEYBD |
lda #40 |
sta LEDS |
tsr TICK,r3 |
kbdi4: ; wait for transmit complete |
tsr TICK,r4 |
sub r4,r4,r3 |
cmp r4,#1000000 |
bhi kbdbad |
lda #41 |
sta LEDS |
lda KEYBD+3 |
bit #64 |
beq kbdi4 |
bra sbtk1 |
kbdbad: |
lda #42 |
sta LEDS |
lda JCB_KeybdBad,x |
bne sbtk2 |
lda #1 |
sta JCB_KeybdBad,x |
lda #43 |
sta LEDS |
lda #msgBadKeybd |
jsr DisplayStringCRLFB |
sbtk1: |
lda #44 |
sta LEDS |
plx |
rts |
sbtk2: |
bra sbtk1 |
|
; Wait for keyboard to respond with an ACK (FA) |
; |
WaitForKeybdAck: |
lda #64 |
sta LEDS |
tsr TICK,r3 |
wkbdack1: |
tsr TICK,r4 |
sub r4,r4,r3 |
cmp r4,#1000000 |
bhi wkbdbad |
lda #65 |
sta LEDS |
lda KEYBD |
bit #$8000 |
beq wkbdack1 |
; lda KEYBD+8 |
and #$ff |
wkbdbad: |
rts |
|
; Wait for keyboard to respond with an ACK (FA) |
; This routine picks up the ack status left by the |
; keyboard IRQ routine. |
; r2 = 0xFA (could also be 0xEE for echo command) |
; |
WaitForKeybdAck2: |
phy |
ldy IOFocusNdx |
WaitForKeybdAck2a: |
lda JCB_KeybdAck,y |
cmp r1,r2 |
bne WaitForKeybdAck2a |
stz JCB_KeybdAck,y |
ply |
rts |
|
;------------------------------------------------------------------------------ |
; Code in the works. |
;------------------------------------------------------------------------------ |
; |
comment ~ |
public KeybdService: |
lda #keybd_mbx |
jsr AllocMbx |
jsr KeybdSetup |
kbds3: |
; Wait for a message to arrive at the service |
lda keybd_mbx |
ldx #-1 ; wait forever |
jsr WaitMsg |
cpx #DCMD_IRQ |
beq kbds1 |
cpx #DCMD_GETCHAR |
beq kbds2 |
cpx #DCMD_INITIALIZE |
beq kbds4 |
bra kbds3 |
kbds1: |
tyx ; D2 holds character |
jsr IKeybdIRQ |
bra kbds3 |
kbds2: |
; The mailbox number is the same as the TCB number |
tya |
jsr IKeybdGetChar |
; Send a message back to the requester containing the key value. |
tax |
tya |
ldy #0 |
jsr SendMsg |
bra kbds3 |
kbds4: |
jsr KeybdInit |
bra kbds3 |
~ |
comment ~ |
public XKeybdIRQ: |
pha |
phx |
phy |
lda keybd_mbx |
ldx #DCMD_IRQ |
ldy KEYBD ; get keyboard character |
ld r0,KEYBD+1 ; clear keyboard strobe (turns off the IRQ) |
cli |
jsr PostMsg |
ply |
plx |
pla |
rti |
~ |
;------------------------------------------------------------------------------ |
; KeybdIRQ |
; |
; Normal keyboard interrupt, the lowest priority interrupt in the system. |
; Grab the character from the keyboard device and store it in a buffer. |
; The buffer of the task with the input focus is updated. |
; This IRQ has to check for the ALT-tab character and take care of |
; switching the IO focus if detected. It can't be done in the KeybdGetChar |
; because the app with the IO focus may not call that routine. We know for |
; sure the interrupt routine will be called when a key is pressed. The |
; mechanism used is to set a flag indicating a focus switch is required. |
; The actual focus switch occurs when a selected to run. The reason the |
; focus switch doesn't occur during the interrupt routine is that it takes |
; a large number of clock cycles (the screen buffer is transferred). |
;------------------------------------------------------------------------------ |
; |
message "KeybdIRQ" |
|
public IKeybdIRQ: |
public KeybdIRQ: |
inc keybdInIRQ |
cld |
pha |
phx |
phy |
push r4 |
|
lda #15 ; disable further keyboard interrupts |
sta PIC+2 |
ldx KEYBD ; get keyboard character |
ld r0,KEYBD+1 ; clear keyboard strobe (turns off the IRQ) |
txy ; |
cli ; global interrupt enable |
bit r3,#$800 ; test bit #11 |
bne KeybdIRQc ; ignore keyup messages for now |
ld r4,IOFocusNdx ; get the job with the input focus |
bit r3,#$200 ; check for ALT-tab |
beq KeybdIrq3 |
and r3,r3,#$FF |
cmp r3,#TAB ; if we find an ALT-tab |
bne KeybdIrq3 |
inc iof_switch |
; jsr SwitchIOFocus |
bra KeybdIRQc ; don't store off the ALT-tab character |
KeybdIrq3: |
and r3,r3,#$ff |
cmp r3,#$FA |
bne KeybdIrq1 |
sty JCB_KeybdAck,r4 |
bra KeybdIRQc |
; strip out non-key keyboard responses |
KeybdIrq1: |
cmp r3,#$AA ; self test pass |
beq KeybdIRQd |
cmp r3,#$EE ; echo response |
beq KeybdIRQd |
cmp r3,#$00 ; keyboard error |
beq KeybdIRQd |
cmp r3,#$FF ; keyboard error |
beq KeybdIRQd |
bit r2,#$800 ; test bit #11 |
bne KeybdIRQc ; ignore keyup messages for now |
KeybdIrq2: |
lda JCB_KeybdHead,r4 |
ina ; increment head pointer |
and #$f ; limit |
ldy JCB_KeybdTail,r4 ; check for room in the keyboard buffer |
cmp r1,r3 |
beq KeybdIRQc ; if no room, the newest char will be lost |
sta JCB_KeybdHead,r4 |
dea |
and #$f |
stx JCB_KeybdLocks,r4 |
stx keybdLock ; global keyboard lock status |
add r1,r1,r4 |
stx JCB_KeybdBuffer,r1 ; store character in buffer |
KeybdIRQc: |
|
; support EhBASIC's IRQ functionality |
; code derived from minimon.asm |
lda #15 ; Keyboard is IRQ #15 |
sta IrqSource |
lb r1,IrqBase ; get the IRQ flag byte |
lsr r2,r1 |
or r1,r1,r2 |
and #$E0 |
sb r1,IrqBase ; save the new IRQ flag byte |
KeybdIRQd: |
lda #15 ; re-enable keyboard interrupts |
sta PIC+3 |
pop r4 |
ply |
plx |
pla |
dec keybdInIRQ |
rti |
|
|
public KeybdRstIRQ: |
jmp start |
|
;----------------------------------------------------------------------------- |
; Media Check |
; A value of 1 is returned indicating that the media hasn't changed. |
;----------------------------------------------------------------------------- |
; |
KeybdMediaChk: |
lda #1 |
rts |
|
;----------------------------------------------------------------------------- |
; r1 0=echo off, non-zero = echo on |
;------------------------------------------------------------------------------ |
public SetKeyboardEcho: |
pha |
phx |
tax |
jsr GetPtrCurrentJCB |
stx JCB_KeybdEcho,r1 |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; Get character from keyboard buffer |
; return character in acc or -1 if no |
; characters available. |
;------------------------------------------------------------------------------ |
; |
message "KeybdGetChar" |
|
comment ~ |
public KeybdGetChar: |
phx |
phy |
push r4 |
; Send a message to the keyboard service requesting a character. |
lda keybd_mbx ; |
ldx #DCMD_GETCHAR ; opcode |
ldy RunningTCB ; response mailbox number |
jsr SendMsg |
; Wait for a response message from the keyboard service. |
tya |
ldx #-1 |
jsr WaitMsg |
txa |
pop r4 |
ply |
plx |
rts |
~ |
;------------------------------------------------------------------------------ |
; KeybdGetChar |
; |
; Get keyboard character from buffer for the current job. |
; |
; Registers Affected: r1, flags |
; Parameters: none |
; Returns: |
; r1 = keyboard character or -1 if no character is available. |
;------------------------------------------------------------------------------ |
; |
public KeybdGetChar: |
jsr GetCurrentJob |
|
;------------------------------------------------------------------------------ |
; Get keyboard character from buffer for the specified job. This entry point |
; is meant to be called by the keyboard service. |
; |
; Registers Affected: r1, flags |
; Parameters: |
; r1 = job number |
; Returns: |
; r1 = keyboard character or -1 if no character is available. |
;------------------------------------------------------------------------------ |
; |
IKeybdGetChar: |
phx |
phy |
ld r0,keybdIsSetup ; the system might call GetChar before the keyboard |
beq .nochar ; is setup. |
tay |
cmp r3,#NR_JCB |
bhs .nochar |
mul r3,r3,#JCB_Size ; convert handle to pointer |
add r3,r3,#JCBs |
lda #15 ; disable keyboard interrupt |
sta PIC+2 |
ld r0,keybdInIRQ |
bne .nochari |
ldx JCB_KeybdTail,y ; if keybdTail==keybdHead then there are no |
lda JCB_KeybdHead,y ; characters in the keyboard buffer |
cmp r1,r2 |
beq .nochari |
phx |
add r2,r2,r3 |
lda JCB_KeybdBuffer,x |
plx |
and r1,r1,#$ff ; mask off control bits |
inx ; increment index |
and r2,r2,#$0f |
stx JCB_KeybdTail,y |
ldx JCB_KeybdEcho,y |
php |
ldx #15 ; re-enable keyboard interrupt |
stx PIC+3 |
plp |
beq .xit ; status from the ldx |
cmp #CR |
bne .dispchar |
jsr CRLF ; convert CR keystroke into CRLF |
bra .xit |
.dispchar: |
jsr DisplayChar |
bra .xit |
.nochari |
lda #15 ; re-enable keyboard interrupt |
sta PIC+3 |
.nochar: |
lda #-1 |
.xit: |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; Check if there is a keyboard character available in the keyboard buffer. |
; |
; Returns |
; r1 = n, Z=0 if there is a key available, otherwise |
; r1 = 0, Z=1 if there is not a key available |
;------------------------------------------------------------------------------ |
; |
message "KeybdCheckForKey" |
public KeybdCheckForKey: |
phx |
phy |
ldx #0 |
ld r0,keybdIsSetup |
beq .nochar2 |
jsr GetPtrCurrentJCB |
tay |
lda #15 ; disable keyboard interrupt |
sta PIC+2 |
ld r0,keybdInIRQ |
bne .nochar |
ldx JCB_KeybdTail,y |
sub r2,r2,JCB_KeybdHead,y |
.nochar |
lda #15 ; re-enable keyboard interrupt |
sta PIC+3 |
.nochar2 |
txa |
ply |
plx |
cmp #0 |
rts |
|
;------------------------------------------------------------------------------ |
; Tests the keyboard port directly. |
; Check if there is a keyboard character available. If so return true (1) |
; otherwise return false (0) in r1. |
;------------------------------------------------------------------------------ |
; |
message "KeybdCheckForKeyDirect" |
public KeybdCheckForKeyDirect: |
lda KEYBD |
and #$8000 |
beq kcfkd1 |
lda #1 |
kcfkd1 |
rts |
|
;------------------------------------------------------------------------------ |
; Get character directly from keyboard. This routine blocks until a key is |
; available. |
;------------------------------------------------------------------------------ |
; |
public KeybdGetCharDirect: |
phx |
kgc1: |
lda KEYBD |
bit #$8000 |
beq kgc1 |
ld r0,KEYBD+1 ; clear keyboard strobe |
bit #$800 ; is it a keydown event ? |
bne kgc1 |
; bit #$200 ; check for ALT-tab |
; bne kgc2 |
; and r2,r1,#$7f |
; cmp r2,#TAB ; if we find an ALT-tab |
; bne kgc2 |
; jsr SwitchIOFocus |
; bra kgc1 |
;kgc2: |
and #$ff ; remove strobe bit |
ldx KeybdEcho ; is keyboard echo on ? |
beq gk1 |
cmp #CR |
bne gk2 ; convert CR keystroke into CRLF |
jsr CRLF |
bra gk1 |
gk2: |
jsr DisplayChar |
gk1: |
plx |
rts |
|
|
;------------------------------------------------------------------------------ |
; Keyboard LEDs task |
; This small task tracks the keyboard lock status keys and updates the |
; keyboard LEDs accordingly. This task runs every 100ms. |
;------------------------------------------------------------------------------ |
; |
public KeybdStatusLEDs: |
ksl4: |
lda #15 ; disable keyboard interrupt |
sta PIC+2 |
ld r0,keybdInIRQ |
bne ksl5 |
lda #$ED |
jsr SendByteToKeybd |
jsr WaitForKeybdAck ; wait for a feedback char |
cmp #$FA ; was it an acknowledge (should be) |
beq ksl7 |
lda #15 ; if not, re-enable keyboard, wait till next time |
sta PIC+3 |
bra ksl5 |
ksl7: |
lda #0 |
ldx keybdLock |
bit r2,#4000 ; bit 14 = scroll lock status |
beq ksl1 |
lda #1 |
ksl1: |
bit r2,#1000 ; bit 12 = numlock status |
beq ksl2 |
or r1,#2 |
ksl2: |
bit r2,#2000 ; bit 13 = capslock status |
beq ksl3 |
or r1,#4 |
ksl3: |
jsr SendByteToKeybd |
lda #15 ; re-enabled keyboard interrupt |
sta PIC+3 |
ksl5: |
lda #10 |
jsr Sleep |
bra ksl4 |
/rtf65002/trunk/software/asm/ReadTemp.asm
0,0 → 1,159
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2013, 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; ReadTemp.asm |
; ============================================================================ |
; |
;-------------------------------------------------------------------------- |
; ReadTemp |
; Read and display the temperature from a DS1626 temperature sensor |
; device. RTF65002 source code. |
;-------------------------------------------------------------------------- |
DS1626_CMD =$FFDC0300 |
DS1626_DAT =$FFDC0301 |
; Commands |
START_CNV = $51; |
STOP_CNV = $22; |
READ_TEMP = $AA; |
READ_CONFIG = $AC; |
READ_TH = $A1; |
READ_TL = $A2; |
WRITE_TH = $01; |
WRITE_TL = $02; |
WRITE_CONFIG = $0C; |
POR = $54; |
|
public ReadTemp: |
lda CONFIGREC ; Do we even have a temperature sensor ? |
bit #$10 |
beq rdtmp3 ; If not, output '0.000' |
rdtmp1: |
; On power up the DS1626 interface circuit sends a power on reset (POR) |
; command to the DS1626. Waiting here makes sure this command has been |
; completed. |
jsr rdt_busy_wait |
lda #$0F ; 12 bits resolution, cpu mode, one-shot mode |
sta DS1626_DAT |
lda #WRITE_CONFIG ; write the desired config to the device |
sta DS1626_CMD |
jsr rdt_busy_wait |
lda #10 |
jsr tSleep |
lda #0 |
sta DS1626_DAT |
lda #START_CNV ; issue a start conversion command |
sta DS1626_CMD |
jsr rdt_busy_wait |
lda #10 |
jsr tSleep |
; Now poll the config register to determine when the conversion has completed. |
rdtmp2: |
lda #READ_CONFIG ; issue the READ_CONFIG command |
sta DS1626_CMD |
jsr rdt_busy_wait |
pha |
lda #10 ; Wait a bit before checking again. The conversion |
jsr tSleep ; can take up to 1s to complete. |
pla |
bit #$80 ; test done bit |
beq rdtmp2 ; loop back if not done conversion |
lda #0 |
sta DS1626_DAT ; issue a stop conversion command |
lda #STOP_CNV |
sta DS1626_CMD |
jsr rdt_busy_wait |
lda #10 |
jsr tSleep |
lda #READ_TEMP ; issue the READ_TEMP command |
sta DS1626_CMD |
jsr rdt_busy_wait |
pha |
lda #10 |
jsr tSleep |
pla |
rdtmp4: |
jsr CRLF |
and #$FFF |
bit #$800 ; check for negative temperature |
beq rdtmp7 |
sub r1,r0,r1 ; negate the number |
and #$FFF |
pha |
lda #'-' ; output a minus sign |
jsr DisplayChar |
pla |
rdtmp7: |
pha ; save off value |
lsr r1,r1,#4 ; get rid of fractional portion |
and #$7F ; strip off sign bit |
ldx #3 ; output the whole number part |
jsr PRTNUM |
lda #'.' ; followed by a decimal point |
jsr DisplayChar |
pla ; get back temp value |
and #$0F |
mul r1,r1,#625 ; 1/16th's per degree |
ldx #1 |
jsr PRTNUM |
; pha ; save off fraction bits |
; div r1,r1,#1000 ; calculate the first digit |
; add #'0' |
; jsr DisplayChar ; output digit |
; pla ; get back fractions bits |
; pha ; and save again |
; div r1,r1,#100 ; shift over to second digit |
; mod r1,r1,#10 ; ignore high order bits |
; add #'0' |
; jsr DisplayChar ; display the digit |
; pla ; get back fraction |
; div r1,r1,#10 |
; mod r1,r1,#10 ; compute low order digit |
; add #'0' |
; jsr DisplayChar ; display low order digit |
jsr CRLF |
rts |
rdtmp3: |
lda #0 |
bra rdtmp4 |
|
; Returns: |
; acc = value from data register |
; |
rdt_busy_wait: |
jsr KeybdGetChar |
cmp #CTRLC |
beq Monitor |
lda DS1626_DAT |
bit #$8000 |
bne rdt_busy_wait |
rts |
|
tSleep: |
ldx Milliseconds |
txa |
tSleep1: |
ldx Milliseconds |
sub r2,r2,r1 |
cpx #100 |
blo tSleep1 |
rts |
|
/rtf65002/trunk/software/asm/Piano.asm
0,0 → 1,127
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2013, 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; Piano.asm |
; ============================================================================ |
; |
;-------------------------------------------------------------------------- |
;-------------------------------------------------------------------------- |
; |
public Piano: |
jsr RequestIOFocus |
lda #15 ; master volume to max |
sta PSG+64 |
playnt: |
jsr KeybdGetChar |
cmp #CTRLC |
beq PianoX |
cmp #'a' |
beq playnt1a |
cmp #'b' |
beq playnt1b |
cmp #'c' |
beq playnt1c |
cmp #'d' |
beq playnt1d |
cmp #'e' |
beq playnt1e |
cmp #'f' |
beq playnt1f |
cmp #'g' |
beq playnt1g |
bra playnt |
PianoX: |
jsr ReleaseIOFocus |
rts |
|
playnt1a: |
ld r4,#7217 |
bra playnta |
playnt1b: |
ld r4,#8101 |
bra playnta |
playnt1c: |
ld r4,#4291 |
bra playnta |
playnt1d: |
ld r4,#4817 |
bra playnta |
playnt1e: |
ld r4,#5407 |
bra playnta |
playnt1f: |
ld r4,#5728 |
bra playnta |
playnt1g: |
ld r4,#6430 |
playnta |
lda #1 ; priority 1 |
ldx #0 ; no flags |
ldy #Tone |
ld r5,#5 ; associate with JCB #5 |
int #4 |
db 1 ; start task |
bra playnt |
|
; The PSG supports four voices, so we use all the voices in succession. |
; The Tone task is reentrant. Multiple copies of the tone task may be |
; playing tones at the same time. |
; |
Tone: |
pha |
phx |
inc tone_cnt |
ldx tone_cnt |
and r2,r2,#3 |
asl r2,r2,#2 ; PSG has groups of four registers |
sta PSGFREQ0,x |
; decay (16.384 ms)2 |
; attack (8.192 ms)1 |
; release (1.024 s)A |
; sustain level C |
lda #0xCA12 |
sta PSGADSR0,x |
lda #0x1104 ; gate, output enable, triangle waveform |
sta PSGCTRL0,x |
lda #20 ; delay about 100ms |
int #4 |
db 5 ; Sleep |
; jsr Delay10 |
lda #0x0104 ; gate off, output enable, triangle waveform |
sta PSGCTRL0,x |
lda #20 ; delay about 100ms |
int #4 |
db 5 ; Sleep |
; jsr Delay10 |
lda #0x0000 ; gate off, output enable off, no waveform |
sta PSGCTRL0,x |
plx |
pla |
rts |
|
; This routine used when Sleep() didn't work. |
Delay10: |
lda #500000 |
dly10a: |
dea |
bne dly10a |
rts |
/rtf65002/trunk/software/asm/iofocus.asm
0,0 → 1,212
comment ~ |
;------------------------------------------------------------------------------ |
; Get a bit from the I/O focus table. |
;------------------------------------------------------------------------------ |
GetIOFocusBit: |
phx |
phy |
tax |
and r1,r1,#$1F ; get bit index into word |
lsr r2,r2,#5 ; get word index into table |
ldy IOFocusTbl,x |
lsr r3,r3,r1 ; extract bit |
and r1,r3,#1 |
ply |
plx |
rts |
~ |
;------------------------------------------------------------------------------ |
; ForceIOFocus |
; |
; Force the IO focus to a specific job. |
;------------------------------------------------------------------------------ |
; |
public ForceIOFocus: |
pha |
phx |
phy |
spl iof_sema + 1 |
ldy IOFocusNdx |
cmp r1,r3 |
beq fif1 |
tax |
jsr CopyScreenToVirtualScreen |
lda JCB_pVirtVid,y |
sta JCB_pVidMem,y |
lda JCB_pVirtVidAttr,y |
sta JCB_pVidMemAttr,y |
stx IOFocusNdx |
lda #TEXTSCR |
sta JCB_pVidMem,x |
add #$10000 |
sta JCB_pVidMemAttr,x |
jsr CopyVirtualScreenToScreen |
fif1: |
stz iof_sema + 1 |
ply |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; SwitchIOFocus |
; |
; Switches the IO focus to the next task requesting the I/O focus. This |
; routine may be called when a task releases the I/O focus as well as when |
; the user presses ALT-TAB on the keyboard. |
; On Entry: the io focus semaphore is set already. |
;------------------------------------------------------------------------------ |
; |
public SwitchIOFocus: |
pha |
phx |
phy |
|
; First check if it's even possible to switch the focus to another |
; task. The I/O focus list could be empty or there may be only a |
; single task in the list. In either case it's not possible to |
; switch. |
ldy IOFocusNdx ; Get the job at the head of the list. |
beq siof3 ; Is the list empty ? |
ldx JCB_iof_next,y ; Get the next job on the list. |
beq siof3 ; Nothing to switch to |
|
; Copy the current task's screen to it's virtual screen buffer. |
jsr CopyScreenToVirtualScreen |
lda JCB_pVirtVid,y |
sta JCB_pVidMem,y |
lda JCB_pVirtVidAttr,y |
sta JCB_pVidMemAttr,y |
|
stx IOFocusNdx ; Make task the new head of list. |
lda #TEXTSCR |
sta JCB_pVidMem,x |
add #$10000 |
sta JCB_pVidMemAttr,x |
|
; Copy the virtual screen of the task recieving the I/O focus to the |
; text screen. |
jsr CopyVirtualScreenToScreen |
siof3: |
ply |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; The I/O focus list is an array indicating which jobs are requesting the |
; I/O focus. The I/O focus is user controlled by pressing ALT-TAB on the |
; keyboard. |
;------------------------------------------------------------------------------ |
message "RequestIOFocus" |
public RequestIOFocus: |
pha |
phx |
phy |
push r4 |
DisTmrKbd |
ldx RunningTCB |
ldx TCB_hJCB,x |
cpx #NR_JCB |
bhs riof1 |
txa |
bmt IOFocusTbl ; is the job already in the IO focus list ? |
bne riof1 |
mul r4,r2,#JCB_Size |
add r4,r4,#JCBs |
lda IOFocusNdx ; Is the focus list empty ? |
beq riof2 |
ldy JCB_iof_prev,r1 |
beq riof4 |
st r4,JCB_iof_prev,r1 |
sta JCB_iof_next,r4 |
sty JCB_iof_prev,r4 |
st r4,JCB_iof_next,y |
riof3: |
txa |
bms IOFocusTbl |
riof1: |
EnTmrKbd |
pop r4 |
ply |
plx |
pla |
rts |
|
; Here, the IO focus list was empty. So expand it. |
; Make sure pointers are NULL |
riof2: |
st r4,IOFocusNdx |
stz JCB_iof_next,r4 |
stz JCB_iof_prev,r4 |
bra riof3 |
|
; Here there was only a single entry in the list. |
; Setup pointers appropriately. |
riof4: |
sta JCB_iof_next,r4 |
sta JCB_iof_prev,r4 |
st r4,JCB_iof_next,r1 |
st r4,JCB_iof_prev,r1 |
bra riof3 |
|
;------------------------------------------------------------------------------ |
; Releasing the I/O focus causes the focus to switch if the running job |
; had the I/O focus. |
; ForceReleaseIOFocus forces the release of the IO focus for a job |
; different than the one currently running. |
;------------------------------------------------------------------------------ |
; |
message "ForceReleaseIOFocus" |
public ForceReleaseIOFocus: |
pha |
phx |
phy |
push r4 |
tax |
DisTmrKbd |
jmp rliof4 |
message "ReleaseIOFocus" |
public ReleaseIOFocus: |
pha |
phx |
phy |
push r4 |
DisTmrKbd |
ldx RunningTCB |
ldx TCB_hJCB,x |
rliof4: |
cpx #NR_JCB |
bhs rliof3 |
; phx |
ldy #1 |
txa |
bmt IOFocusTbl |
beq rliof3 |
bmc IOFocusTbl |
; plx |
mul r4,r2,#JCB_Size |
add r4,r4,#JCBs |
cmp r4,IOFocusNdx ; Does the running job have the I/O focus ? |
bne rliof1 |
jsr SwitchIOFocus ; If so, then switch the focus. |
rliof1: |
lda JCB_iof_next,r4 ; get next and previous fields. |
beq rliof5 ; Is list emptying ? |
ldy JCB_iof_prev,r4 |
sta JCB_iof_next,y ; prev->next = current->next |
sty JCB_iof_prev,r1 ; next->prev = current->prev |
bra rliof2 |
rliof5: |
stz IOFocusNdx ; emptied. |
rliof2: |
stz JCB_iof_next,r4 ; Update the next and prev fields to indicate |
stz JCB_iof_prev,r4 ; the job is no longer on the list. |
rliof3: |
EnTmrKbd |
pop r4 |
ply |
plx |
pla |
rts |
|
/rtf65002/trunk/software/asm/supermon816.asm
0,0 → 1,5111
|
; .opt proc65c02,caseinsensitive |
cpu W65C02 |
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
;* * |
;* SUPERMON 816 MACHINE LANGUAGE MONITOR FOR THE W65C816S MICROPROCESSOR * |
|
|
;* * |
;* Permission is hereby granted to use, copy, modify and distribute this software, * |
;* provided this copyright notice remains in the source code and proper attribu- * |
;* tion is given. Redistribution, regardless of form, must be at no charge to the * |
;* end user. This code or any part thereof, including any derivation, MAY NOT be * |
;* incorporated into any package intended for sale, unless written permission has * |
;* been given by the copyright holder. * |
;* * |
;* THERE IS NO WARRANTY OF ANY KIND WITH THIS SOFTWARE. The user assumes all risk * |
;* in connection with the incorporation of this software into any system. * |
|
;* Supermon 816 is a salute to Jim Butterfield, who passed away on June 29, 2007. * |
;* * |
;* Jim, who was the unofficial spokesman for Commodore International during the * |
;* heyday of the company's 8 bit supremacy, scratch-developed the Supermon machine * |
;* language monitor for the PET & CBM computers. When the best-selling Commodore * |
;* 64 was introduced, Jim adapted his software to the new machine & gave the adap- * |
;* tation the name Supermon 64. Commodore subsequently integrated a customized * |
;* version of Supermon 64 into the C-128 to act as the resident M/L monitor. * |
;* * |
;* Although Supermon 816 is not an adaptation of Supermon 64, it was decided to * |
;* keep the Supermon name alive, since Supermon 816's general operation & user in- * |
;* terface is similar to that of Supermon 64. Supermon 816 is 100 percent native * |
;* mode 65C816 code & was developed from a blank canvas. * |
|
;* This version customized for the RTF65002 test system * |
;* Finitron.ca * |
|
;* Supermon 816 is a full featured monitor and supports the following operations: * |
;* * |
|
|
|
|
|
|
|
|
|
|
|
|
|
;* * |
;* Supermon 816 accepts binary (%), octal (@), decimal (+) and hexadecimal ($) as * |
;* input for numeric parameters. Additionally, the H and > operations accept an * |
;* ASCII string in place of numeric values by preceding the string with ', e.g.: * |
;* * |
;* h 042000 042FFF 'BCS Technology Limited * |
;* * |
;* If no radix symbol is entered hex is assumed. * |
;* * |
;* Numeric conversion is also available. For example, typing: * |
;* * |
;* +1234567 <CR> * |
;* * |
;* will display: * |
;* * |
;* $12D687 * |
;* +1234567 * |
;* @04553207 * |
;* %100101101011010000111 * |
;* * |
;* In the above example, <CR> means the console keyboard's return or enter key. * |
;* * |
;* All numeric values are internally processed as 32 bit unsigned integers. Addr- * |
;* esses may be entered as 8, 16 or 24 bit values. During instruction assembly, * |
;* immediate mode operands may be forced to 16 bits by preceding the operand with * |
;* an exclamation point if the instruction can accept a 16 bit operand, e.g.: * |
;* * |
;* a 1f2000 lda !#4 * |
;* * |
;* The above will assemble as: * |
;* * |
;* A 1F2000 A9 04 00 LDA #$0004 * |
;* * |
;* Entering: * |
;* * |
;* a 1f2000 ldx !#+157 * |
;* * |
;* will assemble as: * |
;* * |
;* A 1F2000 A2 9D 00 LDX #$009D * |
;* * |
;* Absent the ! in the operand field, the above would have been assembled as: * |
;* * |
;* A 1F2000 A2 9D LDX #$9D * |
;* * |
;* If an immediate mode operand is greater than $FF assembly of a 16 bit operand * |
;* is implied. * |
|
;* A Note on the PEA & PEI Instructions * |
|
;* * |
;* The Eyes and Lichty programming manual uses the following syntax for the PEA * |
;* and PEI instructions: * |
;* * |
;* PEA <operand> * |
;* PEI (<operand>) * |
;* * |
;* The WDC data sheet that was published at the time of the 65C816's release in * |
;* 1984 does not indicate a recommended or preferred syntax for any of the above * |
;* instructions. PEA pushes its operand to the stack and hence operates like any * |
;* other immediate mode instruction, in that the operand is the data (however, PEA * |
;* doesn't affect the status register). Similarly, PEI pushes the 16 bit value * |
;* stored at <operand> and <operand>+1, and hence operates like any other direct * |
;* (zero) page instruction, again without affecting the status register. * |
;* * |
;* BCS Technology Limited is of the opinion that the developer of the ORCA/M as- * |
;* sembler, which is the assembler referred to in the Eyes and Lichty manual, mis- * |
;* understood how PEA and PEI behave during runtime, and hence chose an incorrect * |
;* syntax for these two instructions. This error was subsequently carried forward * |
;* by Eyes and Lichty. * |
;* * |
;* Supermon 816's assembler uses the following syntax for PEA and PEI: * |
;* * |
;* PEA #<operand> * |
;* PEI <operand> * |
;* * |
;* The operand for PEA is treated as a 16 bit value, even if entered as an 8 bit * |
;* value. The operand for PEI must be 8 bits. * |
;* * |
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * |
; |
; * * * * * * * * * * * * |
; * VERSION INFORMATION * |
; * * * * * * * * * * * * |
; |
|
.byte "1" ;major |
.byte "." |
.byte "0" ;minor |
.byte "." |
.byte "1" ;revision |
.endm |
; |
;REVISION TABLE |
; |
;Ver Rev Date Description |
|
;1.0 2013/11/01 A) Original derived from the POC V1.1 single-board computer |
; firmware. |
; 2013/11/04 A) Fixed a problem where the B-accumulator wasn't always being |
; be copied to shadow storage after return from execution of |
; a J command. |
|
; |
; |
; COMMENT ABBREVIATIONS |
|
; BCD binary-coded decimal |
; DP direct page or page zero |
; EOF end-of-field |
; EOI end-of-input |
; LSB least significant byte/bit |
; LSD least significant digit |
; LSN least significant nybble |
; LSW least significant word |
; MPU microprocessor |
; MSB most significant byte/bit |
; MSD most significant digit |
; MSN most significant nybble |
; MSW most-significant word |
; RAM random access memory |
; WS whitespace, i.e., blanks & horizontal tabs |
|
; A word is defined as 16 bits. |
; |
; MPU REGISTER SYMBOLS |
|
; .A accumulator LSB |
; .B accumulator MSB |
; .C 16 bit accumulator |
; .X X-index |
; .Y Y-index |
; DB data bank |
; DP direct page |
; PB program bank |
; PC program counter |
; SP stack pointer |
; SR MPU status |
|
; |
; MPU STATUS REGISTER SYMBOLS |
|
; C carry |
; D decimal mode |
; I maskable interrupts |
; m accumulator/memory size |
; N result negative |
; V sign overflow |
; x index registers size |
; Z result zero |
|
; |
;================================================================================ |
; |
;SYSTEM INTERFACE DEFINITIONS |
; |
|
; This section defines the interface between Supermon 816 & the host |
; system. Change these definitions to suit your system, but do not |
; change any label names. All definitions must have valid values in |
; order to assemble Supermon 816. |
|
; |
|
_origin_ =$008000 ;assembly address... |
; |
; Set _ORIGIN_ to Supermon 816's desired assembly address. |
|
; |
|
vecexit =$00F403 ;exit to environment address... |
; |
; Set VECEXIT to where Supermon 816 should go when it exits. Supermon 816 |
; will do a JML (long jump) to this address, which means VECEXIT must be a |
; 24 bit address. |
|
; |
|
vecbrki =$0102 ;BRK handler indirect vector... |
; |
; Supermon 816 will modify this vector so that execution of a BRK instruc- |
; tion is intercepted & the registers are captured. Your BRK front end |
; should jump through this vector after pushing the registers as follows: |
; |
; phb ;save DB |
; phd ;save DP |
; rep #%00110000 ;16 bit registers |
; pha |
; phx |
; phy |
; jmp (vecbrki) ;indirect vector |
; |
; When a G or J command is issued, the above sequence will be reversed be- |
; fore a jump is made to the code to be executed. Upon exit from Supermon |
; 816, the original address at VECBRKI will be restored. |
; |
; If your BRK front end doesn't conform to the above you will have to mod- |
; ify Supermon 816 to accommodate the differences. The most likely needed |
; changes will be in the order in which registers are pushed to the stack. |
|
; |
|
hwstack =$3fff ;top of hardware stack... |
; |
; Supermon 816 initializes the stack pointer to this address when the cold |
; start at MONCOLD is called to enter the monitor. The stack pointer will |
; be undisturbed when entry into Supermon 816 is through JMONBRK (see jump |
; table definitions). |
|
; |
|
zeropage =$80 ;Supermon 816's direct page... |
; |
; Supermon 816 uses direct page starting at this address. Be sure that no |
; conflict occurs with other software. |
|
; |
|
getcha =$F400 ;get keystroke from console... |
; |
; GETCHA refers to an operating system API call that returns a keystroke |
; in the 8 bit accumulator. Supermon 816 assumes that GETCHA is a non- |
; blocking subroutine & returns with carry clear to indicate that a key- |
; stroke is in .A, or with carry set to indicate that no keystroke was |
; available. GETCHA will be called with a JSR instruction. |
; |
; Supermon 816 expects .X & .Y to be preserved upon return from GETCHA. |
; You may have to modify Supermon 816 at all calls to GETCHA if your "get |
; keystroke" routine works differently than described. |
|
; |
|
putcha =$F406 ;print character on console... |
; |
; PUTCHA refers to an operating system API call that prints a character to |
; the console screen. The character to be printed will be in .A, which |
; will be set to 8-bit width. Supermon 816 assumes that PUTCHA will block |
; until the character can be processed. PUTCHA will be called with a JSR |
; instructions. |
; |
; Supermon 816 expects .X & .Y to be preserved upon return from PUTCHA. |
; You may have to modify Supermon 816 at all calls to PUTCHA if your "put |
; character" routine works differently than described. |
|
; |
|
stopkey =$03 ;display abort key... |
; |
; Supermon 816 will poll for a "stop key" during display operations, such |
; as code disassembly & memory dumps, so as to abort further processing & |
; return to the command prompt. STOPKEY must be defined with the ASCII |
; value that the "stop key" will emit when typed. The polling is via a |
; call to GETCHA (described above). The default STOPKEY definition of $03 |
; is for ASCII <ETX> or [Ctrl-C]. |
|
; |
ibuffer =$000200 ;input buffer &... |
auxbuf =ibuffer+s_ibuf+s_byte ;auxiliary buffer... |
; |
|
; Supermon 816 will use the above definitions for input buffers. These |
; buffers may be located anywhere in RAM that is convenient. The buffers |
; are stateless, which means that unless Supermon 816 has control of your |
; system, they may be overwritten without consequence. |
|
; |
;================================================================================ |
; |
|
; |
_asm24_ .macro .ad |
.byte <.ad,>.ad,.ad >> 16 |
.endm |
; |
brl .macro .ad |
.ba =*+3 |
.byte $82 |
.word .ad-.ba |
.endm |
; |
; jml is supported for the RTF65002 in 65c02 mode. And the opcode is supported |
; by the assembler. |
;jml .macro .ad |
; ; .byte $5c |
; _asm24_ .ad |
; .endm |
; |
mvn .macro .s,.d |
.byte $54,.d,.s |
.endm |
; |
mvp .macro .s,.d |
.byte $44,.d,.s |
.endm |
; |
pea .macro .op |
.byte $f4 |
.word .op |
.endm |
; |
phb .macro |
.byte $8b |
.endm |
; |
phk .macro |
.byte $4b |
.endm |
; |
plb .macro |
.byte $ab |
.endm |
; |
rep .macro .op |
.byte $c2,.op |
.endm |
; |
sep .macro .op |
.byte $e2,.op |
.endm |
; |
tcd .macro |
.byte $5b |
.endm |
; |
tcs .macro |
.byte $1b |
.endm |
; |
tdc .macro |
.byte $7b |
.endm |
; |
tsc .macro |
.byte $3b |
.endm |
; |
txy .macro |
.byte $9b |
.endm |
; |
tyx .macro |
.byte $bb |
.endm |
; |
wai .macro |
.byte $cb |
.endm |
; |
xba .macro |
.byte $eb |
.endm |
; |
adcw .macro .op |
adc #<.op |
.byte >.op |
.endm |
; |
andw .macro .op |
and #<.op |
.byte >.op |
.endm |
; |
bitw .macro .op |
bit #<.op |
.byte >.op |
.endm |
; |
cmpw .macro .op |
cmp #<.op |
.byte >.op |
.endm |
; |
cpxw .macro .op |
cpx #<.op |
.byte >.op |
.endm |
; |
cpyw .macro .op |
cpy #<.op |
.byte >.op |
.endm |
; |
eorw .macro .op |
eor #<.op |
.byte >.op |
.endm |
; |
ldaw .macro .op |
lda #<.op |
.byte >.op |
.endm |
; |
ldxw .macro .op |
ldx #<.op |
.byte >.op |
.endm |
; |
ldyw .macro .op |
ldy #<.op |
.byte >.op |
.endm |
; |
oraw .macro .op |
ora #<.op |
.byte >.op |
.endm |
; |
sbcw .macro .op |
sbc #<.op |
.byte >.op |
.endm |
; |
ldalx .macro .ad |
.byte $bf |
_asm24_ .ad |
.endm |
; |
adcil .macro .ad |
.byte $67,.ad |
.endm |
; |
adcily .macro .ad |
.byte $77,.ad |
.endm |
; |
andil .macro .ad |
.byte $27,.ad |
.endm |
; |
andily .macro .ad |
.byte $37,.ad |
.endm |
; |
cmpil .macro .ad |
.byte $c7,.ad |
.endm |
; |
cmpily .macro .ad |
.byte $d7,.ad |
.endm |
; |
eoril .macro .ad |
.byte $47,.ad |
.endm |
; |
eorily .macro .ad |
.byte $57,.ad |
.endm |
; |
ldail .macro .ad |
.byte $a7,.ad |
.endm |
; |
ldaily .macro .ad |
.byte $b7,.ad |
.endm |
; |
orail .macro .ad |
.byte $07,.ad |
.endm |
; |
oraily .macro .ad |
.byte $17,.ad |
.endm |
; |
sbcil .macro .ad |
.byte $e7,.ad |
.endm |
; |
sbcily .macro .ad |
.byte $f7,.ad |
.endm |
; |
stail .macro .ad |
.byte $87,.ad |
.endm |
; |
staily .macro .ad |
.byte $97,.ad |
.endm |
; |
adcs .macro .of |
.byte $63,.of |
.endm |
; |
adcsi .macro .of |
.byte $73,.of |
.endm |
; |
ands .macro .of |
.byte $23,.of |
.endm |
; |
andsi .macro .of |
.byte $33,.of |
.endm |
; |
cmps .macro .of |
.byte $c3,.of |
.endm |
; |
cmpsi .macro .of |
.byte $d3,.of |
.endm |
; |
eors .macro .of |
.byte $43,.of |
.endm |
; |
eorsi .macro .of |
.byte $53,.of |
.endm |
; |
ldas .macro .of |
.byte $a3,.of |
.endm |
; |
ldasi .macro .of |
.byte $b3,.of |
.endm |
; |
oras .macro .of |
.byte $03,.of |
.endm |
; |
orasi .macro .of |
.byte $13,.of |
.endm |
; |
sbcs .macro .of |
.byte $e3,.of |
.endm |
; |
sbcsi .macro .of |
.byte $f3,.of |
.endm |
; |
stas .macro .of |
.byte $83,.of |
.endm |
; |
stasi .macro .of |
.byte $93,.of |
.endm |
; |
longa .macro |
.byte $c2,$20 |
.endm |
; |
longr .macro |
.byte $c2,$30 |
.endm |
; |
longx .macro |
.byte $c2,$10 |
.endm |
; |
shorta .macro |
.byte $e2,$20 |
.endm |
; |
shorti .macro |
.byte $e2,$10 |
.endm |
; |
shortr .macro |
.byte $e2,$30 |
.endm |
; |
shortx .macro |
.byte $e2,$10 |
.endm |
; |
;================================================================================ |
; |
;CONSOLE DISPLAY CONTROL MACROS |
; |
|
; The following macros execute terminal control procedures that perform |
; such tasks as clearing the screen, switching between normal & reverse |
; video, etc. These macros are for WYSE 60 & compatible displays, such as |
; the WYSE 150, WYSE 160, WYSE 325 & WYSE GPT. Only the functions needed |
; by Supermon 816 are included. |
; |
; If your console is not WYSE 60 compatible, you will need to edit these |
; macros as required to control your particular console or terminal. Note |
; that in some cases one macro may call another. Exercise caution in your |
; edits to avoid introducing display bugs. |
; |
; If your console display cannot execute one of these procedures, such as |
; 'CL' (clear to end of line), you will have to develop an alternative. |
|
; |
; |
; clearing data... |
; |
bs .macro ;destructive backspace |
.byte a_bs |
dcuc |
.endm |
; |
cl .macro ;clear to end of line |
.byte a_esc,"T" |
.endm |
; |
; |
; cursor control... |
; |
cn .macro ;cursor on |
.byte a_esc,"`1" |
.endm |
; |
co .macro ;cursor off |
.byte a_esc,"`0" |
.endm |
; |
cr .macro ;carriage return |
.byte a_cr |
.endm |
; |
lf .macro ;carriage return/line feed |
cr |
.byte a_lf |
.endm |
; |
; |
; display attributes... |
; |
bf .macro ;reverse foreground |
.byte a_esc,"(" |
.byte a_esc,"G4" |
.endm |
; |
er .macro ;enable normal foreground |
.byte a_esc,"(" |
.byte a_esc,"G0" |
.endm |
; |
sf .macro ;set foreground |
.byte a_esc,"(" |
.byte a_esc,"G0" |
.endm |
; |
; |
; display editing... |
; |
dcuc .macro ;delete char under cursor |
.byte a_esc,"W" |
.endm |
; |
; |
; miscellaneous control... |
; |
rb .macro ;ring "bell" |
.byte a_bel |
.endm |
; |
;================================================================================ |
; |
;ASCII CONTROL DEFINITIONS (menmonic order) |
; |
a_bel =$07 ;<BEL> alert/ring bell |
a_bs =$08 ;<BS> backspace |
a_cr =$0d ;<CR> carriage return |
a_del =$7f ;<DEL> delete |
a_esc =$1b ;<ESC> escape |
a_ht =$09 ;<HT> horizontal tabulation |
a_lf =$0a ;<LF> linefeed |
; |
; |
; miscellaneous (description order)... |
; |
a_blank =' ' ;blank (whitespace) |
a_asclch ='z' ;end of lowercase ASCII |
a_lctouc =$5f ;LC to UC conversion mask |
a_asclcl ='a' ;start of lowercase ASCII |
; |
;================================================================================ |
; |
;GLOBAL ATOMIC CONSTANTS |
; |
; |
; data type sizes... |
; |
s_byte =1 ;byte |
s_word =2 ;word (16 bits) |
s_xword =3 ;extended word (24 bits) |
s_dword =4 ;double word (32 bits) |
s_rampag =$0100 ;65xx RAM page |
; |
; |
; data type sizes in bits... |
; |
s_bibyte =8 ;byte |
s_bnybbl =4 ;nybble |
; |
; |
; miscellaneous... |
; |
bitabs =$2c ;absolute BIT opcode |
bitzp =$24 ;zero page BIT opcode |
; |
;================================================================================ |
; |
;W65C816S NATIVE MODE STATUS REGISTER DEFINITIONS |
; |
s_mpudbx =s_byte ;data bank size |
s_mpudpx =s_word ;direct page size |
s_mpupbx =s_byte ;program bank size |
s_mpupcx =s_word ;program counter size |
s_mpuspx =s_word ;stack pointer size |
s_mpusrx =s_byte ;status size |
; |
; |
; status register flags... |
; |
sr_car =@00000001 ;C |
sr_zer =sr_car << 1 ;Z |
sr_irq =sr_zer << 1 ;I |
sr_bdm =sr_irq << 1 ;D |
sr_ixw =sr_bdm << 1 ;x |
sr_amw =sr_ixw << 1 ;m |
sr_ovl =sr_amw << 1 ;V |
sr_neg =sr_ovl << 1 ;N |
; |
; NVmxDIZC |
; xxxxxxxx |
; |||||||| |
|
|
|
|
; |||| 1 = decimal arithmetic mode |
|
; ||| 1 = 8 bit index |
|
; || 1 = 8 bit .A & memory |
|
|
; |
;================================================================================ |
; |
;"SIZE-OF" CONSTANTS |
; |
s_addr =s_xword ;24 bit address |
s_auxbuf =32 ;auxiliary buffer |
s_ibuf =69 ;input buffer |
s_mnemon =3 ;MPU ASCII mnemonic |
s_mnepck =2 ;MPU encoded mnemonic |
s_mvinst =3 ;MVN/MVP instruction |
s_opcode =s_byte ;MPU opcode |
s_oper =s_xword ;operand |
s_pfac =s_dword ;primary math accumulator |
s_sfac =s_dword+s_word ;secondary math accumulators |
; |
;================================================================================ |
; |
;"NUMBER-OF" CONSTANTS |
; |
n_dbytes =21 ;default disassembly bytes |
n_dump =8 ;bytes per memory dump line |
n_mbytes =s_rampag-1 ;default memory dump bytes |
n_hccols =8 ;compare/hunt display columns |
n_opcols =3*s_oper ;disassembly operand columns |
n_opslsr =4 ;LSRs to extract instruction size |
n_shfenc =5 ;shifts to encode/decode mnemonic |
; |
;================================================================================ |
; |
;NUMERIC CONVERSION CONSTANTS |
; |
a_hexdec ='A'-'9'-2 ;hex to decimal difference |
c_bin ='%' ;binary prefix |
c_dec ='+' ;decimal prefix |
c_hex ='$' ;hexadecimal prefix |
c_oct ='@' ;octal prefix |
k_hex ='f' ;hex ASCII conversion |
m_bits =s_pfac*s_bibyte ;operand bit size |
m_cbits =s_sfac*s_bibyte ;workspace bit size |
bcdumask =@00001111 ;isolate BCD units mask |
btoamask =@00110000 ;binary to ASCII mask |
; |
;================================================================================ |
; |
;ASSEMBLER/DISASSEMBLER CONSTANTS |
; |
a_mnecvt ='?' ;encoded mnemonic conversion base |
aimmaska =@00011111 ;.A immediate opcode test #1 |
aimmaskb =@00001001 ;.A immediate opcode test #2 |
asmprfx ='A' ;assemble code prefix |
ascprmct =9 ;assembler prompt "size-of" |
disprfx ='.' ;disassemble code prefix |
flimmask =@11000000 ;force long immediate flag |
opc_mvn =$54 ;MVN opcode |
opc_mvp =$44 ;MVP opcode |
opc_rep =$c2 ;REP opcode |
opc_sep =$e2 ;SEP opcode |
pfmxmask =sr_amw | sr_ixw ;MPU m & x flag bits mask |
; |
; |
; assembler prompt buffer offsets... |
; |
apadrbkh =s_word ;instruction address bank MSN |
apadrbkl =apadrbkh+s_byte ;instruction address bank LSN |
apadrmbh =apadrbkl+s_byte ;instruction address MSB MSN |
apadrmbl =apadrmbh+s_byte ;instruction address MSB LSN |
apadrlbh =apadrmbl+s_byte ;instruction address LSB MSN |
apadrlbl =apadrlbh+s_byte ;instruction address LSB LSN |
; |
; |
; addressing mode preamble symbols... |
; |
amp_flim ='!' ;force long immediate |
amp_imm ='#' ;immediate |
amp_ind ='(' ;indirect |
amp_indl ='[' ;indirect long |
; |
; |
; addressing mode symbolic translation indices... |
; |
am_nam =@0000 ;(0) no symbol |
am_imm =@0001 ;(1) # |
am_adrx =@0010 ;(2) dp,X or addr,X |
am_adry =@0011 ;(3) dp,Y or addr,Y |
am_ind =@0100 ;(4) (dp) or (addr) |
am_indl =@0101 ;(5) [dp] or [addr] |
am_indly =@0110 ;(6) [dp],Y |
am_indx =@0111 ;(7) (dp,X) or (addr,X) |
am_indy =@1000 ;(8) (dp),Y |
am_stk =@1001 ;(9) offset,S |
am_stky =@1010 ;(10) (offset,S),Y |
am_move =@1011 ;(11) MVN/MVP sbnk,dbnk |
; |
; |
; operand size translation indices... |
; |
ops0 =@0000 << 4 ;no operand |
ops1 =@0001 << 4 ;8 bit operand |
ops2 =@0010 << 4 ;16 bit operand |
ops3 =@0011 << 4 ;24 bit operand |
bop1 =@0101 << 4 ;8 bit relative branch |
bop2 =@0110 << 4 ;16 bit relative branch |
vops =@1001 << 4 ;8 or 16 bit operand |
; |
; |
; operand size & addressing mode extraction masks... |
; |
amodmask =@00001111 ;addressing mode index |
opsmask =@00110000 ;operand size |
vopsmask =@11000000 ;BOPx & VOPS flag bits |
; |
; |
; instruction mnemonic encoding... |
; |
mne_adc =$2144 ;ADC |
mne_and =$2bc4 ;AND |
mne_asl =$6d04 ;ASL |
mne_bcc =$2106 ;BCC |
mne_bcs =$a106 ;BCS |
mne_beq =$9186 ;BEQ |
mne_bit =$aa86 ;BIT |
mne_bmi =$5386 ;BMI |
mne_bne =$33c6 ;BNE |
mne_bpl =$6c46 ;BPL |
mne_bra =$14c6 ;BRA |
mne_brk =$64c6 ;BRK |
mne_brl =$6cc6 ;BRL |
mne_bvc =$25c6 ;BVC |
mne_bvs =$a5c6 ;BVS |
mne_clc =$2348 ;CLC |
mne_cld =$2b48 ;CLD |
mne_cli =$5348 ;CLI |
mne_clv =$bb48 ;CLV |
mne_cmp =$8b88 ;CMP |
mne_cop =$8c08 ;COP |
mne_cpx =$cc48 ;CPX |
mne_cpy =$d448 ;CPY |
mne_dec =$218a ;DEC |
mne_dex =$c98a ;DEX |
mne_dey =$d18a ;DEY |
mne_eor =$9c0c ;EOR |
mne_inc =$23d4 ;INC |
mne_inx =$cbd4 ;INX |
mne_iny =$d3d4 ;INY |
mne_jml =$6b96 ;JML |
mne_jmp =$8b96 ;JMP |
mne_jsl =$6d16 ;JSL |
mne_jsr =$9d16 ;JSR |
mne_lda =$115a ;LDA |
mne_ldx =$c95a ;LDX |
mne_ldy =$d15a ;LDY |
mne_lsr =$9d1a ;LSR |
mne_mvn =$7ddc ;MVN |
mne_mvp =$8ddc ;MVP |
mne_nop =$8c1e ;NOP |
mne_ora =$14e0 ;ORA |
mne_pea =$11a2 ;PEA |
mne_pei =$51a2 ;PEI |
mne_per =$99a2 ;PER |
mne_pha =$1262 ;PHA |
mne_phb =$1a62 ;PHB |
mne_phd =$2a62 ;PHD |
mne_phk =$6262 ;PHK |
mne_php =$8a62 ;PHP |
mne_phx =$ca62 ;PHX |
mne_phy =$d262 ;PHY |
mne_pla =$1362 ;PLA |
mne_plb =$1b62 ;PLB |
mne_pld =$2b62 ;PLD |
mne_plp =$8b62 ;PLP |
mne_plx =$cb62 ;PLX |
mne_ply =$d362 ;PLY |
mne_rep =$89a6 ;REP |
mne_rol =$6c26 ;ROL |
mne_ror =$9c26 ;ROR |
mne_rti =$5566 ;RTI |
mne_rtl =$6d66 ;RTL |
mne_rts =$a566 ;RTS |
mne_sbc =$20e8 ;SBC |
mne_sec =$21a8 ;SEC |
mne_sed =$29a8 ;SED |
mne_sei =$51a8 ;SEI |
mne_sep =$89a8 ;SEP |
mne_sta =$1568 ;STA |
mne_stp =$8d68 ;STP |
mne_stx =$cd68 ;STX |
mne_sty =$d568 ;STY |
mne_stz =$dd68 ;STZ |
mne_tax =$c8aa ;TAX |
mne_tay =$d0aa ;TAY |
mne_tcd =$292a ;TCD |
mne_tcs =$a12a ;TCS |
mne_tdc =$216a ;TDC |
mne_trb =$1cea ;TRB |
mne_tsb =$1d2a ;TSB |
mne_tsc =$252a ;TSC |
mne_tsx =$cd2a ;TSX |
mne_txa =$166a ;TXA |
mne_txs =$a66a ;TXS |
mne_txy =$d66a ;TXY |
mne_tya =$16aa ;TYA |
mne_tyx =$ceaa ;TYX |
mne_wai =$50b0 ;WAI |
mne_wdm =$7170 ;WDM |
mne_xba =$10f2 ;XBA |
mne_xce =$3132 ;XCE |
; |
; |
; encoded instruction mnemonic indices... |
; |
mne_adcx =16 ;ADC |
mne_andx =29 ;AND |
mne_aslx =44 ;ASL |
mne_bccx =15 ;BCC |
mne_bcsx =65 ;BCS |
mne_beqx =59 ;BEQ |
mne_bitx =70 ;BIT |
mne_bmix =36 ;BMI |
mne_bnex =31 ;BNE |
mne_bplx =42 ;BPL |
mne_brax =5 ;BRA |
mne_brkx =39 ;BRK |
mne_brlx =43 ;BRL |
mne_bvcx =23 ;BVC |
mne_bvsx =68 ;BVS |
mne_clcx =20 ;CLC |
mne_cldx =27 ;CLD |
mne_clix =35 ;CLI |
mne_clvx =71 ;CLV |
mne_cmpx =53 ;CMP |
mne_copx =55 ;COP |
mne_cpxx =78 ;CPX |
mne_cpyx =88 ;CPY |
mne_decx =18 ;DEC |
mne_dexx =74 ;DEX |
mne_deyx =84 ;DEY |
mne_eorx =61 ;EOR |
mne_incx =21 ;INC |
mne_inxx =77 ;INX |
mne_inyx =87 ;INY |
mne_jmlx =40 ;JML |
mne_jmpx =54 ;JMP |
mne_jslx =45 ;JSL |
mne_jsrx =63 ;JSR |
mne_ldax =1 ;LDA |
mne_ldxx =73 ;LDX |
mne_ldyx =83 ;LDY |
mne_lsrx =64 ;LSR |
mne_mvnx =48 ;MVN |
mne_mvpx =58 ;MVP |
mne_nopx =56 ;NOP |
mne_orax =6 ;ORA |
mne_peax =2 ;PEA |
mne_peix =33 ;PEI |
mne_perx =60 ;PER |
mne_phax =3 ;PHA |
mne_phbx =10 ;PHB |
mne_phdx =26 ;PHD |
mne_phkx =38 ;PHK |
mne_phpx =51 ;PHP |
mne_phxx =75 ;PHX |
mne_phyx =85 ;PHY |
mne_plax =4 ;PLA |
mne_plbx =11 ;PLB |
mne_pldx =28 ;PLD |
mne_plpx =52 ;PLP |
mne_plxx =76 ;PLX |
mne_plyx =86 ;PLY |
mne_repx =49 ;REP |
mne_rolx =41 ;ROL |
mne_rorx =62 ;ROR |
mne_rtix =37 ;RTI |
mne_rtlx =46 ;RTL |
mne_rtsx =67 ;RTS |
mne_sbcx =14 ;SBC |
mne_secx =19 ;SEC |
mne_sedx =25 ;SED |
mne_seix =34 ;SEI |
mne_sepx =50 ;SEP |
mne_stax =7 ;STA |
mne_stpx =57 ;STP |
mne_stxx =80 ;STX |
mne_styx =89 ;STY |
mne_stzx =91 ;STZ |
mne_taxx =72 ;TAX |
mne_tayx =82 ;TAY |
mne_tcdx =24 ;TCD |
mne_tcsx =66 ;TCS |
mne_tdcx =17 ;TDC |
mne_trbx =12 ;TRB |
mne_tsbx =13 ;TSB |
mne_tscx =22 ;TSC |
mne_tsxx =79 ;TSX |
mne_txax =8 ;TXA |
mne_txsx =69 ;TXS |
mne_txyx =90 ;TXY |
mne_tyax =9 ;TYA |
mne_tyxx =81 ;TYX |
mne_waix =32 ;WAI |
mne_wdmx =47 ;WDM |
mne_xbax =0 ;XBA |
mne_xcex =30 ;XCE |
; |
;================================================================================ |
; |
;MISCELLANEOUS CONSTANTS |
; |
halftab =4 ;1/2 tabulation spacing |
memprfx ='>' ;memory dump prefix |
memsepch =':' ;memory dump separator |
memsubch ='.' ;memory dump non-print char |
srinit =@00110000 ;SR initialization value |
; |
;================================================================================ |
; |
;DIRECT PAGE STORAGE |
; |
reg_pbx =zeropage ;PB |
reg_pcx =reg_pbx+s_mpupbx ;PC |
reg_srx =reg_pcx+s_mpupcx ;SR |
reg_ax =reg_srx+s_mpusrx ;.C |
reg_xx =reg_ax+s_word ;.X |
reg_yx =reg_xx+s_word ;.Y |
reg_spx =reg_yx+s_word ;SP |
reg_dpx =reg_spx+s_mpuspx ;DP |
reg_dbx =reg_dpx+s_mpudpx ;DB |
; |
; |
; general workspace... |
; |
addra =reg_dbx+s_mpudbx ;address #1 |
addrb =addra+s_addr ;address #2 |
faca =addrb+s_addr ;primary accumulator |
facax =faca+s_pfac ;extended primary accumulator |
facb =facax+s_pfac ;secondary accumulator |
facc =facb+s_sfac ;tertiary accumulator |
operand =facc+s_sfac ;instruction operand |
auxbufix =operand+s_oper ;auxiliary buffer index |
ibufidx =auxbufix+s_byte ;input buffer index |
bitsdig =ibufidx+s_byte ;bits per numeral |
numeral =bitsdig+s_byte ;numeral buffer |
radix =numeral+s_byte ;radix index |
admodidx =radix+s_byte ;addressing mode index |
charcnt =admodidx+s_byte ;character counter |
instsize =charcnt+s_word ;instruction size |
mnepck =instsize+s_word ;encoded mnemonic |
opcode =mnepck+s_mnepck ;current opcode |
status =opcode+s_byte ;I/O status flag |
xrtemp =status+s_byte ;temp .X storage |
eopsize =xrtemp+s_byte ;entered operand size |
flimflag =eopsize+s_byte ;forced long immediate... |
; |
; xx000000 |
; || |
|
; | 1: .X/.Y = 18 bits |
|
; 1: .A = 16 bits |
; |
|
; During assembly, FLIMFLAG indicates the operand size used with an immed- |
; iate mode instruction, thus causing the following disassembly to display |
; the assembled operand size. During disassembly, FLIMFLAG will mirror |
; the effect of the most recent REP or SEP instruction. |
|
; |
iopsize =flimflag+s_byte ;operand size |
range =iopsize+s_byte ;allowable radix range |
vopsflag =range+s_byte ;VOPS & ROPS mode bits |
; |
; |
; copy/fill workspace (overlaps some of the above)... |
; |
mcftwork =vopsflag+s_byte ;faca ;start of copy/fill code |
mcftopc =mcftwork+s_byte ;instruction opcode |
mcftbnk =mcftopc+s_byte ;banks |
; |
;================================================================================ |
; |
;SUPERMON 816 JUMP TABLE |
; |
org _origin_ |
; |
JMON bra mon ;cold start entry |
JMONBRK bra monbrk ;software interrupt intercept |
; |
;================================================================================ |
; |
;mon: SUPERMON 816 COLD START |
; |
mon longa |
lda vecbrki ;BRK vector |
cmpw monbrk ;pointing at monitor? |
bne .2 ;yes, ignore cold start |
jmp monreg ; got a branch out of range here when debugging code |
; was included |
.2 |
; |
sta vecbrkia ;save vector for exit |
ldaw monbrk ;Supermon 816 intercepts... |
sta vecbrki ;BRK handler |
shortr ;8 bit registers |
ldx #vopsflag-reg_pbx |
; |
.0000010 stz reg_pbx,x ;clear DP storage |
dex |
bpl .0000010 |
; |
lda #srinit |
sta reg_srx ;status register |
longa ;16 bit .A |
ldaw hwstack ;top of hardware stack |
tcs ;set SP |
tdc ;get & save... |
sta reg_dpx ;DP register |
ldaw 0 |
shorta |
phk |
pla ;capture PB &... |
sta reg_pbx ;set |
phb |
pla ;capture DB &... |
sta reg_dbx ;set |
pea mm_entry ;"...ready..." |
bra moncom |
; |
;================================================================================ |
; |
;monbrk: SOFTWARE INTERRUPT INTERCEPT |
; |
|
; This is the entry point taken when a BRK instruction is executed. It is |
; assumed that the BRK handler has pushed the registers to the stack that |
; are not automatically pushed by the MPU in response to BRK. |
|
; |
monbrk cli ;reenable IRQs |
ply ;recover registers |
plx |
pla |
longr ;store 16 bit registers |
sta reg_ax ;.A |
stx reg_xx ;.X |
sty reg_yx ;.Y |
shortx ;8 bit index registers |
pla ;get DP &... |
sta reg_dpx ;store |
plx ;get DB &... |
stx reg_dbx ;store |
plx ;get SR &... |
stx reg_srx ;store |
pla ;get PC &... |
sta reg_pcx ;store |
shorta |
pla ;get PB &... |
sta reg_pbx ;store |
pea mm_brk ;"*BRK" |
; |
;================================================================================ |
; |
;moncom: COMMON ENTRY POINT |
; |
|
; DO NOT directly call this entry point! |
|
; |
moncom jsr sprint ;print heading |
longa |
tsc ;get SP &... |
sta reg_spx ;store |
rep @11111111 ;clear SR &... |
sep srinit ;set default state |
sec ;see next |
; |
;================================================================================ |
; |
;monreg: DISPLAY MPU REGISTERS |
; |
|
; syntax: R |
|
; |
monreg bcs .0000010 ;okay to proceed |
; |
jmp monerr ;error if called with a parm |
; |
.0000010 pea mm_regs |
jsr sprint ;display heading |
; |
; |
; display program bank & counter... |
; |
lda reg_pbx ;PB |
jsr dpyhex ;display as hex ASCII |
jsr printspc ;inter-field space |
longa |
lda reg_pcx |
shorta |
jsr dpyhexw ;display PC |
ldx #2 |
jsr multspc ;inter-field spacing |
; |
; |
; display SR in bitwise fashion... |
; |
ldx reg_srx ;SR |
ldy #s_bibyte ;bits in a byte |
; |
.0000020 txa ;remaining SR bits |
asl ;grab one of them |
tax ;save remainder |
lda #'0' ;a clear bit but... |
adc #0 ;adjust if set &... |
jsr putcha ;print |
dey ;bit processed |
bne .0000020 ;do another |
; |
; |
; display .C, .X, .Y, SP & DP... |
; |
.0000030 jsr printspc ;spacing |
longa |
lda reg_ax,y ;get register value |
shorta |
jsr dpyhexw ;convert & display |
; .rept s_word |
iny |
iny |
; .endr |
cpy #reg_dbx-reg_ax |
bcc .0000030 ;next |
; |
; |
; display DB... |
; |
jsr printspc ;more spacing |
lda reg_dbx ;get DB &... |
jsr dpyhex ;display it |
|
; |
;================================================================================ |
; |
;monce: COMMAND EXECUTIVE |
; |
monce shorta |
lda #0 ;default buffer index |
; |
moncea shortr ;alternate entry point |
sta ibufidx ;(re)set buffer index |
pea mm_prmpt |
jsr sprint ;display input prompt |
jsr input ;await some input |
; |
.0000010: |
jsr getcharc ;read from buffer |
beq monce ;terminator, just loop |
; |
cmp #a_blank |
beq .0000010 ;strip leading blanks |
; |
ldx #n_mpctab-1 ;number of primary commands |
; |
.0000020 cmp mpctab,x ;search primary command list |
bne .0000030 |
; |
txa ;get index |
asl ;double for offset |
tax |
longa |
lda mpcextab,x ;command address -1 |
pha ;prime the stack |
shorta |
jmp getparm ;evaluate parm & execute command |
; |
.0000030 dex |
bpl .0000020 ;continue searching primary commands |
; |
ldx #n_radix-1 ;number of radices |
; |
.0000040 cmp radxtab,x ;search conversion command list |
bne .0000050 |
; |
jmp monenv ;convert & display parameter |
; |
.0000050 dex |
bpl .0000040 |
; |
;================================================================================ |
; |
;monerr: COMMON ERROR HANDLER |
; |
monerr shortr ;8 bit registers |
; |
monerraa jsr dpyerr ;indicate an error &... |
bra monce ;return to input loop |
; |
;================================================================================ |
; |
;monasc: ASSEMBLE CODE |
; |
|
; syntax: A <addr> <mnemonic> [<argument>] |
; |
; After a line of code has been successfully assembled it will be disass- |
; embled & displayed, & the monitor will prompt with the next address to |
; which code may be assembled. |
|
; |
monasc bcc .0000020 ;assembly address entered |
; |
.0000010 jmp monerr ;terminate w/error |
; |
; |
; evaluate assembly address... |
; |
.0000020 jsr facasize ;check address... |
cmp #s_dword ;range |
|
; |
jsr facaddra ;store assembly address |
; |
; |
; initialize workspace... |
; |
ldx #s_auxbuf-s_byte |
; |
.0000030 stz auxbuf,x ;clear addressing mode buffer |
dex |
bne .0000030 |
; |
lda #a_blank |
sta auxbuf ;preamble placeholder |
jsr clroper ;clear operand |
stz auxbufix ;reset addressing mode index |
stz flimflag ;clear forced long immediate |
stz mnepck ;clear encoded... |
stz mnepck+s_byte ;mnemonic workspace |
stz vopsflag ;clear 8/16 or relative flag |
; |
; |
; encode mnemonic... |
; |
ldy #s_mnemon ;expected mnemonic size |
; |
.0000040 jsr getcharw ;get from buffer wo/whitespace |
bne .0000060 ;gotten |
; |
cpy #s_mnemon ;any input at all? |
bcc .0000050 ;yes |
; |
jmp monce ;no, abort further assembly |
; |
|
; |
.0000060 sec |
sbc #a_mnecvt ;ASCII to binary factor |
ldx #n_shfenc ;shifts required to encode |
; |
.0000070 lsr ;shift out a bit... |
ror mnepck+s_byte ;into... |
ror mnepck ;encoded mnemonic |
dex |
bne .0000070 ;next bit |
; |
dey |
bne .0000040 ;get next char |
; |
; |
; test for copy instruction... |
|
; The MVN & MVP instructions accept two operands & hence have an irregular |
; syntax. Therefore, special handling is necessary to assemble either of |
; these instructions. |
; |
; The official WDC syntax has the programmer entering a pair of 24 bit ad- |
; dresses as operands, with the assembler isolating bits 16-23 to use as |
; operands. This formality has been dispensed with in this monitor & the |
; operands are expected to be 8 bit bank values. |
|
; |
longa ;16 bit load |
lda mnepck ;packed menmonic |
ldx #opc_mvn ;MVN opcode |
cmpw mne_mvn ;is it MVN? |
beq monasc01 ;yes |
; |
ldx #opc_mvp ;MVP opcode |
cmpw mne_mvp ;is it MVP? |
bne monasc02 ;no |
; |
; |
; assemble copy instruction... |
; |
monasc01 stx opcode ;store relevant opcode |
shorta |
jsr instdata ;get instruction data |
stx eopsize ;effective operand size |
inx |
stx instsize ;instruction size |
ldx #s_oper-s_word ;operand index |
stx xrtemp ;set it |
; |
.0000010 jsr ascbin ;evaluate bank number |
bcs monasc04 ;conversion error |
; |
|
; |
jsr facasize ;bank must be... |
cmp #s_word ;8 bits |
|
; |
lda faca ;bank |
ldx xrtemp ;operand index |
sta operand,x ;store |
dec xrtemp ;index=index-1 |
bpl .0000010 ;get destination bank |
; |
jsr getcharr ;should be no more input |
|
; |
jmp monasc08 ;finish MVN/MVP assembly |
; |
; |
; continue with normal assembly... |
; |
monasc02 shorta ;back to 8 bits |
; |
monasc03 jsr getcharw ;get next char |
beq monasc06 ;EOI, no argument |
; |
cmp #amp_flim |
bne .0000010 ;no forced long immediate |
; |
lda flimflag ;FLIM already set? |
|
; |
lda #flimmask |
sta flimflag ;set flag &... |
bra monasc03 ;get next char |
; |
.0000010 cmp #amp_imm ;immediate mode? |
beq .0000020 ;yes |
; |
cmp #amp_ind ;indirect mode? |
beq .0000020 ;yes |
; |
cmp #amp_indl ;indirect long mode? |
bne .0000030 ;no |
; |
.0000020 sta auxbuf ;set addressing mode preamble |
inc auxbufix ;bump aux buffer index &... |
bra .0000040 ;evaluate operand |
; |
.0000030 dec ibufidx ;position back to char |
; |
.0000040 jsr ascbin ;evaluate operand |
bne monasc05 ;evaluated |
; |
bcs monasc04 ;conversion error |
; |
lda auxbufix ;no operand...any preamble? |
beq monasc06 ;no, syntax is okay so far |
; |
monasc04 jmp monasc10 ;abort w/error |
; |
monasc05 jsr facasize ;size operand |
cmp #s_dword ;max is 24 bits |
bcs monasc04 ;too big |
; |
sta eopsize ;save operand size |
jsr facaoper ;store operand |
; |
monasc06 dec ibufidx ;back to last char |
ldx auxbufix ;mode buffer index |
bne .0000010 ;preamble in buffer |
; |
inx ;step past preamble position |
; |
.0000010 jsr getcharc ;get a char w/forced UC |
beq .0000030 ;EOI |
; |
cpx #s_auxbuf ;mode buffer full? |
bcs monasc04 ;yes, too much input |
; |
.0000020 sta auxbuf,x ;store for comparison |
inx |
bne .0000010 |
; |
; |
; evaluate mnemonic... |
; |
.0000030 ldx #n_mnemon-1 ;starting mnemonic index |
; |
monasc07 txa ;convert index... |
asl ;to offset |
tay ;now mnemonic table index |
longa ;16 bit compare |
lda mnetab,y ;get mnemonic from table |
cmp mnepck ;compare to entered mnemonic |
shorta ;back to 8 bits |
beq .0000020 ;match |
; |
.0000010 dex ;try next mnemonic |
|
; |
bra monasc07 ;keep going |
; |
.0000020 stx mnepck ;save mnemonic index |
txa |
ldx #0 ;trial opcode |
; |
.0000030 cmp mnetabix,x ;search index table... |
beq .0000050 ;for a match |
; |
.0000040 inx ;keep going until we... |
bne .0000030 ;search entire table |
; |
bra monasc04 ;this shouldn't happen! |
; |
|
; If the mnemonic index table search fails then there is a coding error |
; somewhere, as every entry in the mnemonic table is supposed to have a |
; matching cardinal index. |
|
; |
; |
; evaluate addressing mode... |
; |
.0000050 stx opcode ;save trial opcode |
jsr instdata ;get related instruction data |
sta vopsflag ;save 8/16 or relative flag |
stx iopsize ;operand size |
inx |
stx instsize ;instruction size |
ldx opcode ;recover trial opcode |
tya ;addressing mode |
asl ;create table index |
tay |
longa |
lda ms_lutab,y ;mode lookup table |
sta addrb ;set pointer |
shorta |
ldy #0 |
; |
.0000060 lda (addrb),y ;table addressing mode |
cmp auxbuf,y ;entered addressing mode |
beq .0000080 ;okay so far |
; |
.0000070 lda mnepck ;reload mnemonic index |
bra .0000040 ;wrong opcode for addresing mode |
; |
.0000080 ora #0 ;last char the terminator? |
beq .0000090 ;yes, evaluate operand |
; |
iny |
bra .0000060 ;keep testing |
; |
; |
; evaluate operand... |
; |
.0000090 lda eopsize ;entered operand size |
bne .0000100 ;non-zero |
; |
ora iopsize ;instruction operand size |
|
; |
bra monasc08 ;assemble instruction |
; |
.0000100 bit vopsflag ;is this a branch? |
bvs .0000160 ;yes, evaluate |
; |
lda iopsize ;instruction operand size |
bit vopsflag ;variable size operand allowed? |
bmi .0000130 ;yes |
; |
bit flimflag ;was forced immediate set? |
bpl .0000110 ;no |
; |
|
; |
.0000110 cmp eopsize ;entered operand size |
bcc .0000070 ;operand too big |
; |
sta eopsize ;new operand size |
bra monasc08 ;assemble, otherwise... |
; |
.0000120 cmp eopsize ;exact size match required |
|
; |
bra monasc08 ;assemble |
; |
; |
; process variable size immediate mode operand... |
; |
.0000130 ldx eopsize ;entered operand size |
cpx #s_xword ;check size |
|
; |
bit flimflag ;forced long immediate? |
bpl .0000140 ;no |
; |
ldx #s_word ;promote operand size to... |
stx eopsize ;16 bits |
bra .0000150 |
; |
.0000140 cpx #s_word ;16 bits? |
bne .0000150 ;no |
; |
ldy #flimmask ;yes so force long... |
sty flimflag ;immediate disassembly |
; |
.0000150 ina ;new instruction operand size |
cmp eopsize ;compare against operand size |
|
; |
bra monasc08 ;okay, assemble |
; |
; |
; process relative branch... |
; |
.0000160 jsr targoff ;compute branch offset |
bcs monasc10 ;branch out of range |
; |
sta eopsize ;effective operand size |
; |
; |
; assemble instruction... |
; |
monasc08 lda opcode ;opcode |
stail addra ;store at assembly address |
ldx eopsize ;any operand to process? |
beq .0000020 ;no |
; |
txy ;also storage offset |
; |
.0000010 dex |
lda operand,x ;get operand byte &... |
staily addra ;poke into memory |
dey |
bne .0000010 ;next |
; |
.0000020 lda #a_cr |
jsr putcha ;return to left margin |
lda #asmprfx ;assembly prefix |
jsr dpycodaa ;disassemble & display |
; |
; |
; prompt for next instruction... |
; |
monasc09 lda #a_blank |
ldx #ascprmct-1 |
; |
.0000010 sta ibuffer,x ;prepare buffer for... |
dex ;next instruction |
bpl .0000010 |
; |
lda #asmprfx ;assemble code... |
sta ibuffer ;prompt prefix |
lda addra+s_word ;next instruction address bank |
jsr binhex ;convert to ASCII |
sta ibuffer+apadrbkh ;store MSN in buffer |
stx ibuffer+apadrbkl ;store LSN in buffer |
lda addra+s_byte ;next instruction address MSB |
jsr binhex |
sta ibuffer+apadrmbh |
stx ibuffer+apadrmbl |
lda addra ;next instruction address LSB |
jsr binhex |
sta ibuffer+apadrlbh |
stx ibuffer+apadrlbl |
lda #ascprmct ;effective input count |
jmp moncea ;reenter input loop |
; |
; |
; process assembly error... |
; |
monasc10 jsr dpyerr ;indicate error &... |
bra monasc09 ;prompt w/same assembly address |
; |
;================================================================================ |
; |
;mondsc: DISASSEMBLE CODE |
; |
|
; syntax: D [<addr1> [<addr2>]] |
|
; |
mondsc bcs .0000010 ;no parameters |
; |
stz flimflag ;reset to 8 bit mode |
jsr facasize ;check starting... |
cmp #s_dword ;address |
|
; |
jsr facaddra ;copy starting address |
jsr getparm ;get ending address |
bcc .0000020 ;gotten |
; |
.0000010 jsr clrfaca ;clear accumulator |
longa |
clc |
lda addra ;starting address |
adcw n_dbytes ;default bytes |
sta faca ;effective ending address |
shorta |
lda addra+s_word ;starting bank |
adc #0 |
sta faca+s_word ;effective ending bank |
bcs .0000050 ;end address > $FFFFFF |
; |
.0000020 jsr facasize ;check ending... |
cmp #s_dword ;address |
|
; |
jsr facaddrb ;set ending address |
jsr getparm ;check for excess input |
|
; |
jsr calccnt ;calculate bytes |
bcc .0000050 ;end < start |
; |
.0000030 jsr teststop ;test for display stop |
bcs .0000040 ;stopped |
; |
jsr newline ;next line |
jsr dpycod ;disassemble & display |
jsr decdcnt ;decrement byte count |
bcc .0000030 ;not done |
; |
.0000040 jmp monce ;back to main loop |
; |
.0000050 jmp monerr ;address range error |
; |
;================================================================================ |
; |
;monjmp: EXECUTE CODE |
; |
|
; syntax: G [<addr>] |
; |
; If no address is specified, the current values in the PB & PC |
; shadow registers are used. |
|
; |
monjmp jsr setxaddr ;set execution address |
|
; |
jsr getparm ;check for excess input |
|
; |
longa ;16 bit .A |
lda reg_spx |
tcs ;restore SP |
; |
monjmpaa shorta |
lda reg_pbx |
pha ;restore PB |
longa |
lda reg_pcx |
pha ;restore PC |
shorta |
lda reg_srx |
pha ;restore SR |
lda reg_dbx |
pha |
plb ;restore DB |
longr |
lda reg_dpx |
tcd ;restore DP |
lda reg_ax ;restore .C |
ldx reg_xx ;restore .X |
ldy reg_yx ;restore .Y |
rti ;execute code |
; |
monjmpab jmp monerr ;error |
; |
;================================================================================ |
; |
;monjsr: EXECUTE CODE AS SUBROUTINE |
; |
|
; syntax: J [<addr>] |
; |
; If no address is specified the current values in the PB & PC |
; shadow registers are used. An RTS at the end of the called |
; subroutine will return control to the monitor provided the |
; stack remains in balance. |
|
; |
monjsr jsr setxaddr ;set execution address |
|
; |
jsr getparm ;check for excess input |
|
; |
longa |
lda reg_spx |
tcs ;restore SP &... |
jsr monjmpaa ;call subroutine |
php ;push SR |
longr |
sta reg_ax ;save... |
stx reg_xx ;register... |
sty reg_yx ;returns |
shortx ;8 bit .X & .Y |
plx ;get & save... |
stx reg_srx ;return SR |
tsc ;get & save... |
sta reg_spx ;return SP |
tdc ;get & save... |
sta reg_dpx ;DP pointer |
shorta ;8 bit .A |
phk ;get &... |
pla ;save... |
sta reg_pbx ;return PB |
phb ;get &... |
pla ;save... |
sta reg_dbx ;return DB |
pea mm_rts ;"*RET" |
jmp moncom ;return to monitor |
; |
;================================================================================ |
; |
;monchm: CHANGE and/or DUMP MEMORY |
; |
|
; syntax: > [<addr> <operand> [<operand>]...] |
; |
; > <addr> without operands will dump 16 bytes |
; of memory, starting at <addr>. |
|
; |
|
; |
jsr facasize ;size address |
cmp #s_dword |
|
; |
jsr facaddra ;set starting address |
jsr getpat ;evaluate change pattern |
bcc .0000010 ;entered |
; |
bpl .0000020 ;not entered |
; |
bra .0000040 ;evaluation error |
; |
.0000010 dey ;next byte |
bmi .0000020 ;done |
; |
lda auxbuf,y ;write pattern... |
staily addra ;to memory |
bra .0000010 ;next |
; |
.0000020 jsr newline ;next line |
jsr dpymem ;regurgitate changes |
; |
.0000030 jmp monce ;back to command loop |
; |
.0000040 jmp monerr ;goto error handler |
; |
;================================================================================ |
; |
;moncmp: COMPARE MEMORY |
; |
|
; syntax: C <start> <end> <ref> |
|
; |
|
; |
jsr enddest ;get end & reference addresses |
bcs .0000040 ;range or other error |
; |
stz xrtemp ;column counter |
; |
.0000010 jsr teststop ;check for stop |
bcs .0000030 ;abort |
; |
ldail addra ;get from reference location |
cmpil operand ;test against compare location |
beq .0000020 ;match, don't display address |
; |
jsr dpycaddr ;display current location |
; |
.0000020 jsr nxtaddra ;next reference location |
bcs .0000030 ;done |
; |
longa |
inc operand ;bump bits 0-15 |
shorta |
bne .0000010 |
; |
inc operand+s_word ;bump bits 16-23 |
bra .0000010 |
; |
.0000030 jmp monce ;return to command exec |
; |
.0000040 jmp monerr ;goto error handler |
; |
;================================================================================ |
; |
;moncpy: COPY (transfer) MEMORY |
; |
|
; syntax: T <start> <end> <target> |
|
; |
|
; |
jsr enddest ;get end & target addresses |
bcs .0000050 ;range or other error |
; |
longa |
sec |
lda addrb ;ending address |
sbc addra ;starting address |
|
; |
sta facb ;bytes to copy |
shorta |
longx |
lda operand+s_word ;target bank |
ldy operand ;target address |
cmp addra+s_word ;source bank |
longa |
bne .0000020 ;can use forward copy |
; |
cpy addra ;source address |
bcc .0000020 ;can use forward copy |
; |
bne .0000010 ;must use reverse copy |
; |
|
; |
.0000010 lda facb ;get bytes to copy |
pha ;protect |
jsr lodbnk ;load banks |
jsr cprvsup ;do reverse copy setup |
pla ;get bytes to copy |
tax ;save a copy |
clc |
adc operand ;change target to... |
tay ;target end |
txa ;recover bytes to copy |
ldx addrb ;source end |
bra .0000030 |
; |
.0000020 lda facb ;get bytes to copy |
pha ;protect |
jsr lodbnk ;load banks |
jsr cpfwsup ;do forward copy setup |
pla ;get bytes to copy |
ldx addra ;source start |
; |
.0000030 jmp mcftwork ;copy memory |
; |
.0000040 jmp monce ;back to executive |
; |
.0000050 jmp monerr ;error |
; |
;================================================================================ |
; |
;mondmp: DISPLAY MEMORY RANGE |
; |
|
; syntax: M [<addr1> [<addr2>]] |
|
; |
mondmp bcs .0000010 ;no parameters |
; |
jsr facasize ;check address... |
cmp #s_dword ;range |
bcs .0000050 ;address out of range |
; |
jsr facaddra ;copy starting address |
jsr getparm ;get ending address |
bcc .0000020 ;gotten |
; |
.0000010 jsr clrfaca ;clear accumulator |
longa |
clc |
lda addra ;starting address |
adcw n_mbytes ;default bytes |
sta faca ;effective ending address |
shorta |
lda addra+s_word ;starting bank |
adc #0 |
sta faca+s_word ;effective ending bank |
bcs .0000050 ;end address > $FFFFFF |
; |
.0000020 jsr facasize ;check ending address... |
cmp #s_dword ;range |
|
; |
jsr facaddrb ;copy ending address |
jsr getparm ;check for excess input |
bcc .0000050 ;error |
; |
jsr calccnt ;calculate bytes to dump |
bcc .0000050 ;end < start |
; |
.0000030 jsr teststop ;test for display stop |
bcs .0000040 ;stopped |
; |
jsr newline ;next line |
jsr dpymem ;display |
jsr decdcnt ;decrement byte count |
bcc .0000030 ;not done |
; |
.0000040 jmp monce ;back to main loop |
; |
.0000050 jmp monerr ;address range error |
; |
;================================================================================ |
; |
;monfil: FILL MEMORY |
; |
|
; syntax: F <start> <end> <fill> |
; |
; <start> & <end> must be in the same bank. |
|
; |
|
; |
jsr facasize ;check size |
cmp #s_dword |
|
; |
jsr facaddra ;store start |
jsr getparm ;evaluate end |
|
; |
jsr facasize ;check size |
cmp #s_dword |
|
; |
lda faca+s_word ;end bank |
cmp addra+s_word ;start bank |
|
; |
jsr facaddrb ;store <end> |
longa |
sec |
lda addrb ;ending address |
sbc addra ;starting address |
|
; |
sta facb ;bytes to copy |
shorta |
jsr getparm ;evaluate <fill> |
|
; |
jsr facasize ;<fill> should be... |
cmp #s_word ;8 bits |
|
; |
jsr facaoper ;store <fill> |
jsr getparm ;should be no more parameters |
|
; |
lda operand ;<fill> |
stail addra ;fill 1st location |
longr ;16 bit operations |
lda facb ; |
|
; |
dea ;zero align &... |
pha ;protect |
shorta |
lda addra+s_word ;start bank |
xba |
lda addrb+s_word ;end bank |
jsr cpfwsup ;do forward copy setup |
pla ;recover fill count |
ldx addra ;fill-from starting location |
txy |
iny ;fill-to starting location |
jmp mcftwork ;fill memory |
; |
.0000010 jmp monce ;goto command executive |
; |
.0000020 jmp monerr ;goto error handler |
; |
;================================================================================ |
; |
;monhnt: SEARCH (hunt) MEMORY |
; |
|
; syntax: H <addr1> <addr2> <pattern> |
|
; |
monhnt bcs .0000050 ;no start address |
; |
jsr facasize ;size starting address |
cmp #s_dword |
|
; |
jsr facaddra ;store starting address |
jsr getparm ;evaluate ending address |
|
; |
jsr facasize ;size ending address |
cmp #s_dword |
|
; |
jsr facaddrb ;store ending address |
jsr calccnt ;calculate byte range |
bcc .0000060 ;end < start |
; |
jsr getpat ;evaluate search pattern |
bcs .0000060 ;error |
; |
stz xrtemp ;clear column counter |
; |
.0000010 jsr teststop ;check for stop |
bcs .0000050 ;abort |
; |
ldy auxbufix ;pattern index |
; |
.0000020 dey |
bmi .0000030 ;pattern match |
; |
ldaily addra ;get from memory |
cmp auxbuf,y ;test against pattern |
bne .0000040 ;mismatch, next location |
; |
beq .0000020 ;match, keep testing |
; |
.0000030 jsr dpycaddr ;display current location |
; |
.0000040 jsr nxtaddra ;next location |
bcc .0000010 ;not done |
; |
.0000050 jmp monce ;back to executive |
; |
.0000060 jmp monerr ;goto error handler |
; |
;================================================================================ |
; |
;monenv: CONVERT NUMERIC VALUE |
; |
|
; syntax: <radix><value> |
|
; |
monenv jsr getparmr ;reread & evaluate parameter |
bcs .0000020 ;none entered |
; |
ldx #0 ;radix index |
ldy #n_radix ;number of radices |
; |
.0000010 phy ;save counter |
phx ;save radix index |
jsr newline ;next line &... |
jsr clearlin ;clear it |
lda #a_blank |
ldx #halftab |
jsr multspc ;indent 1/2 tab |
plx ;get radix index but... |
phx ;put it back |
lda radxtab,x ;get radix |
jsr binasc ;convert to ASCII |
phy ;string address MSB |
phx ;string address LSB |
jsr sprint ;print |
plx ;get index again |
ply ;get counter |
inx |
dey |
bne .0000010 ;no |
|
.0000020 jmp monce ;back to command exec |
; |
;================================================================================ |
; |
;monchr: CHANGE REGISTERS |
; |
|
; syntax: ; [PB [PC [.S [.C [.X [.Y [SP [DP [DB]]]]]]]]] |
; |
; ; with no parameters is the same as the R command. |
|
; |
monchr bcs .0000040 ;dump registers & quit |
; |
ldy #0 ;register counter |
sty facc ;initialize register index |
; |
.0000010 jsr facasize ;get parameter size |
cmp rcvltab,y ;check against size table |
bcs .0000050 ;out of range |
; |
lda rcvltab,y ;determine number of bytes... |
cmp #s_word+1 ;to store |
ror facc+s_byte ;condition flag |
bpl .0000020 ;8 bit register size |
; |
longa ;16 bit register size |
; |
.0000020 ldx facc ;get register index |
lda faca ;get parm |
sta reg_pbx,x ;put in shadow storage |
shorta |
asl facc+s_byte ;mode flag to carry |
txa ;register index |
adc #s_byte ;at least 1 byte stored |
sta facc ;save new index |
jsr getparm ;get a parameter |
bcs .0000040 ;EOI |
; |
iny ;bump register count |
cpy #n_regchv ;all registers processed? |
bne .0000010 ;no, keep going |
; |
.0000030 jsr alert ;excessive input |
; |
.0000040 jmp monreg ;display changes |
; |
.0000050 jmp monerr ;goto error handler |
; |
;================================================================================ |
; |
;monxit: EXIT TO OPERATING ENVIRONMENT |
; |
|
; syntax: X |
|
; |
monxit bcc .0000020 ;no parameters allowed |
; |
longa |
lda vecbrki ;BRK indirect vector |
cmpw monbrk ;we intercept it? |
bne .0000010 ;no, don't change it |
; |
lda vecbrkia ;old vector |
sta vecbrki ;restore it |
stz vecbrkia ;invalidate old vector |
; |
.0000010 shortr |
jml vecexit ;long jump to exit |
; |
.0000020 jmp monerr ;goto error handler |
; |
; * * * * * * * * * * * * * * * * * * * * * * * * |
; * * * * * * * * * * * * * * * * * * * * * * * * |
; * * * * |
; * * S T A R T o f S U B R O U T I N E S * * |
; * * * * |
; * * * * * * * * * * * * * * * * * * * * * * * * |
; * * * * * * * * * * * * * * * * * * * * * * * * |
; |
;dpycaddr: DISPLAY CURRENT ADDRESS IN COLUMNS |
; |
dpycaddr ldx xrtemp ;column count |
bne .0000010 ;not at right side |
; |
jsr newline ;next row |
ldx #n_hccols ;max columns |
; |
.0000010 cpx #n_hccols ;max columns |
beq .0000020 ;at left margin |
; |
lda #a_ht |
jsr putcha ;tab a column |
; |
.0000020 dex ;one less column |
stx xrtemp ;save column counter |
jmp prntladr ;print reference address |
; |
;================================================================================ |
; |
;dpycod: DISASSEMBLE & DISPLAY CODE |
; |
|
; This function disassembles & displays the machine code at the location |
; pointed to by ADDRA. Upon return, ADDRA will point to the opcode of the |
; next instruction. The entry point at DPYCODAA should be called with a |
; disassembly prefix character loaded in .A. If entered at DPYCOD, the |
; default character will be display at the beginning of each disassembled |
; instruction. |
; |
; The disassembly of immediate mode instructions that can take an 8 or 16 |
; bit operand is affected by the bit pattern that is stored in FLIMFLAG |
; upon entry to this function: |
; |
; FLIMFLAG: xx000000 |
; || |
|
; | 1: 16 bit .X or .Y operand |
|
; 1: 16 bit .A or BIT # operand |
; |
; FLIMFLAG is conditioned according to the operand of the most recently |
; disassembled REP or SEP instruction. Hence repetitive calls to this |
; subroutine will usually result in the correct disassembly of 16 bit imm- |
; ediate mode instructions. |
|
; |
dpycod lda #disprfx ;default prefix |
; |
; |
; alternate prefix display entry point... |
; |
dpycodaa jsr putcha ;print prefix |
jsr printspc ;space |
jsr prntladr ;print long address |
jsr printspc ;space to opcode field |
jsr getbyte ;get opcode |
sta opcode ;save &... |
jsr printbyt ;display as hex |
; |
; |
; decode menmonic & addressing info... |
; |
ldx opcode ;current mnemonic |
lda mnetabix,x ;get mnemonic index |
asl ;double for... |
tay ;mnemonic table offset |
longa ;16 bit load |
lda mnetab,y ;copy encoded mnemonic to... |
sta mnepck ;working storage |
shorta ;back to 8 bits |
jsr instdata ;extract mode & size data |
sta vopsflag ;save mode flags |
sty admodidx ;save mode index |
asl ;variable immediate instruction? |
bcc dpycod01 ;no, effective operand size in .X |
; |
; |
; determine immediate mode operand size... |
; |
lda opcode ;current opcode |
bit flimflag ;operand display mode |
bpl .0000010 ;8 bit .A & BIT immediate mode |
; |
and #aimmaska ;determine if... |
cmp #aimmaskb ;.A or BIT immediate |
beq .0000030 ;display 16 bit operand |
; |
lda opcode ;not .A or BIT immediate |
; |
.0000010 bvc dpycod01 ;8 bit .X/.Y immediate mode |
; |
ldy #n_vopidx-1 ;opcodes to test |
; |
.0000020 cmp vopidx,y ;looking for LDX #, CPY #, etc. |
beq .0000040 ;disassemble a 16 bit operand |
; |
dey |
bpl .0000020 ;keep trying |
; |
bra dpycod01 ;not .X or .Y immediate |
; |
.0000030 lda opcode ;reload |
; |
.0000040 inx ;16 bit operand |
; |
; |
; get & display operand bytes... |
; |
dpycod01 stx iopsize ;operand size... |
inx ;plus opcode becomes... |
stx instsize ;instruction size |
stx charcnt ;total bytes to process |
lda #n_opcols+2 ;total operand columns plus WS |
sta xrtemp ;initialize counter |
jsr clroper ;clear operand |
ldy iopsize ;operand size |
beq .0000020 ;no operand |
; |
ldx #0 ;operand index |
; |
.0000010 jsr getbyte ;get operand byte |
sta operand,x ;save |
phx ;protect operand index |
jsr printbyt ;print operand byte |
dec xrtemp ;3 columns used, 2 for... |
dec xrtemp ;operand nybbles &... |
dec xrtemp ;1 for whitespace |
plx ;get operand index |
inx ;bump it |
dey |
bne .0000010 ;next |
; |
.0000020 ldx xrtemp ;operand columns remaining |
jsr multspc ;space to mnemonic field |
; |
; |
; display mnemonic... |
; |
ldy #s_mnemon ;size of ASCII mnemonic |
; |
.0000030 lda #0 ;initialize char |
ldx #n_shfenc ;shifts to execute |
; |
.0000040 asl mnepck ;shift encoded mnemonic |
rol mnepck+s_byte |
rol |
dex |
bne .0000040 |
; |
adc #a_mnecvt ;convert to ASCII &... |
pha ;stash |
dey |
bne .0000030 ;continue with mnemonic |
; |
ldy #s_mnemon |
; |
.0000050 pla ;get mnenmonic byte |
jsr putcha ;print it |
dey |
bne .0000050 |
; |
; |
; display operand... |
; |
lda iopsize ;operand size |
beq clearlin ;zero, disassembly finished |
; |
jsr printspc ;space to operand field |
bit vopsflag ;check mode flags |
bvc dpycod02 ;not a branch |
; |
jsr offtarg ;compute branch target |
ldx instsize ;effective instruction size |
dex |
stx iopsize ;effective operand size |
; |
dpycod02 stz vopsflag ;clear |
lda admodidx ;instruction addressing mode |
cmp #am_move ;block move instruction? |
bne .0000010 ;no |
; |
ror vopsflag ;yes |
; |
.0000010 asl ;convert addressing mode to... |
tax ;symbology table index |
longa ;do a 16 bit load |
lda ms_lutab,x ;addressing symbol pointer |
pha |
shorta ;back to 8 bit loads |
ldy #0 |
ldasi 1 ;get 1st char |
cmp #a_blank |
beq .0000020 ;no addresing mode preamble |
; |
jsr putcha ;print preamble |
; |
.0000020 lda #c_hex |
jsr putcha ;operand displayed as hex |
ldy iopsize ;operand size = index |
; |
.0000030 dey |
bmi .0000040 ;done with operand |
; |
lda operand,y ;get operand byte |
jsr dpyhex ;print operand byte |
bit vopsflag ;block move? |
bpl .0000030 ;no |
; |
stz vopsflag ;reset |
phy ;protect operand index |
pea ms_move |
jsr sprint ;display MVN/MVP operand separator |
ply ;recover operand index again |
bra .0000030 ;continue |
; |
.0000040 plx ;symbology LSB |
ply ;symbology MSB |
inx ;move past preamble |
bne .0000050 |
; |
iny |
; |
.0000050 phy |
phx |
jsr sprint ;print postamble, if any |
; |
; |
; condition immediate mode display format... |
; |
dpycod03 lda operand ;operand LSB |
and #pfmxmask ;isolate M & X bits |
asl ;shift to match... |
asl ;FLIMFLAG alignment |
ldx opcode ;current instruction |
cpx #opc_rep ;was it REP? |
bne .0000010 ;no |
; |
tsb flimflag ;set flag bits as required |
bra clearlin |
; |
.0000010 cpx #opc_sep ;was it SEP? |
bne clearlin ;no, just exit |
; |
trb flimflag ;clear flag bits as required |
; |
;================================================================================ |
; |
;clearlin: CLEAR DISPLAY LINE |
; |
clearlin pea dc_cl |
bra dpyerraa |
; |
;================================================================================ |
; |
;dpyibuf: DISPLAY MONITOR INPUT BUFFER CONTENTS |
; |
dpyibuf pea ibuffer |
bra dpyerraa |
; |
;================================================================================ |
; |
;dpymem: DISPLAY MEMORY |
; |
|
; This function displays 16 bytes of memory as hex values & as |
; ASCII equivalents. The starting address for the display is |
; in ADDRA & is expected to be a 24 bit address. Upon return, |
; ADDRA will point to the start of the next 16 bytes. |
|
; |
dpymem shortr |
stz charcnt ;reset |
lda #memprfx |
jsr putcha ;display prefix |
jsr prntladr ;print 24 bit address |
ldx #0 ;string buffer index |
ldy #n_dump ;bytes per line |
; |
.0000010 jsr getbyte ;get from RAM, also... |
pha ;save for decoding |
phx ;save string index |
jsr printbyt ;display as hex ASCII |
inc charcnt ;bytes displayed +1 |
plx ;recover string index &... |
pla ;byte |
cmp #a_blank ;printable? |
bcc .0000020 ;no |
; |
cmp #a_del |
bcc .0000030 ;is printable |
; |
.0000020 lda #memsubch ;substitute character |
; |
.0000030 sta ibuffer,x ;save char |
inx ;bump index |
dey ;byte count -= 1 |
bne .0000010 ;not done |
; |
stz ibuffer,x ;terminate ASCII string |
lda #memsepch |
jsr putcha ;separate ASCII from bytes |
pea dc_bf |
jsr sprint ;select reverse video |
jsr dpyibuf ;display ASCII equivalents |
pea dc_er ;normal video |
bra dpyerraa |
; |
;================================================================================ |
; |
;dpyerr: DISPLAY ERROR SIGNAL |
; |
dpyerr pea mm_err ;"*ERR" |
; |
dpyerraa jsr sprint |
rts |
; |
;================================================================================ |
; |
;gendbs: GENERATE DESTRUCTIVE BACKSPACE |
; |
gendbs pea dc_bs ;destructive backspace |
bra dpyerraa |
; |
;================================================================================ |
; |
;prntladr: PRINT 24 BIT CURRENT ADDRESS |
; |
prntladr php ;protect register sizes |
shorta |
lda addra+s_word ;get bank byte &... |
jsr dpyhex ;display it |
longa |
lda addra ;get 16 bit address |
plp ;restore register sizes |
; |
;================================================================================ |
; |
;dpyhexw: DISPLAY BINARY WORD AS HEX ASCII |
; |
|
; Preparatory Ops: .C: word to display |
; |
; Returned Values: .C: used |
; .X: used |
; .Y: entry value |
|
; |
dpyhexw php ;save register sizes |
longa |
pha ;protect value |
shorta |
xba ;get MSB &... |
jsr dpyhex ;display |
longa |
pla ;recover value |
shorta ;only LSB visible |
plp ;reset register sizes |
; |
;================================================================================ |
; |
;dpyhex: DISPLAY BINARY BYTE AS HEX ASCII |
; |
|
; Preparatory Ops: .A: byte to display |
; |
; Returned Values: .A: used |
; .X: used |
; .Y: entry value |
|
; |
dpyhex jsr binhex ;convert to hex ASCII |
jsr putcha ;print MSN |
txa |
jmp putcha ;print LSN |
; |
;================================================================================ |
; |
;multspc: PRINT MULTIPLE BLANKS |
; |
|
; Preparatory Ops : .X: number of blanks to print |
; |
; Register Returns: none |
; |
; Calling Example : ldx #3 |
; jsr multspc ;print 3 spaces |
; |
; Notes: This sub will print 1 blank if .X=0. |
|
; |
multspc txa |
bne .0000010 ;blank count specified |
; |
inx ;default to 1 blank |
; |
.0000010 lda #a_blank |
; |
.0000020 jsr putcha |
dex |
bne .0000020 |
; |
rts |
; |
;================================================================================ |
; |
;newline: PRINT NEWLINE (CRLF) |
; |
newline pea dc_lf |
bra dpyerraa |
; |
;================================================================================ |
; |
;printbyt: PRINT A BYTE WITH LEADING SPACE |
; |
printbyt pha ;protect byte |
jsr printspc ;print leading space |
pla ;restore &... |
bra dpyhex ;print byte |
; |
;================================================================================ |
; |
;alert: ALERT USER w/TERMINAL BELL |
; |
alert lda #a_bel |
bra printcmn |
; |
;================================================================================ |
; |
;printspc: PRINT A SPACE |
; |
printspc lda #a_blank |
; |
printcmn jmp putcha |
; |
;================================================================================ |
; |
;sprint: PRINT NULL-TERMINATED CHARACTER STRING |
; |
|
; Preparatory Ops : SP+1: string address LSB |
; SP+2: string address MSB |
; |
; Register Returns: .A: used |
; .B: entry value |
; .X: used |
; .Y: used |
; |
; MPU Flags: NVmxDIZC |
; |||||||| |
|
; ||||||| 1: string too long (1) |
|
|
|
|
; |
; Example: PER STRING |
; JSR SPRINT |
; BCS TOOLONG |
; |
; Notes: 1) Maximum permissible string length including the |
; terminator is 32,767 bytes. |
; 2) All registers are forced to 8 bits. |
; 3) DO NOT JUMP OR BRANCH INTO THIS FUNCTION! |
|
; |
sprint shorta ;8 bit accumulator |
longx ;16 bit index |
; |
|
.reetaddr =1 ;return address |
|
.src =.reetaddr+s_word ;string address stack offset |
|
|
; |
ldyw 0 |
clc ;no initial error |
; |
.0000010 ldasi .src ;get a byte |
beq .0000020 ;done |
; |
jsr putcha ;write to console port |
iny |
bpl .0000010 ;next |
; |
sec ;string too long |
; |
.0000020 plx ;pull RTS address |
ply ;clear string pointer |
phx ;replace RTS |
shortx |
rts |
; |
;================================================================================ |
; |
;ascbin: CONVERT NULL-TERMINATED ASCII NUMBER STRING TO BINARY |
; |
|
; Preparatory Ops: ASCII number string in IBUFFER |
; |
; Returned Values: FACA: converted parameter |
; .A: used |
; .X: used |
; .Y: used |
; .C: 1 = conversion error |
; .Z: 1 = nothing to convert |
; |
; Notes: 1) Conversion stops when a non-numeric char- |
; acter is encountered. |
; 2) Radix symbols are as follows: |
; |
; % binary |
; @ octal |
; + decimal |
; $ hexadecimal |
; |
; Hex is the default if no radix is speci- |
; fied in the 1st character of the string. |
|
; |
ascbin shortr |
jsr clrfaca ;clear accumulator |
stz charcnt ;zero char count |
stz radix ;initialize |
; |
; |
; process radix if present... |
; |
jsr getcharw ;get next non-WS char |
bne .0000010 ;got something |
; |
clc ;no more input |
rts |
; |
.0000010 ldx #n_radix-1 ;number of radices |
; |
.0000020 cmp radxtab,x ;recognized radix? |
beq .0000030 ;yes |
; |
dex |
bpl .0000020 ;try next |
; |
dec ibufidx ;reposition to previous char |
inx ;not recognized, assume hex |
; |
.0000030 cmp #c_dec ;decimal radix? |
bne .0000040 ;not decimal |
; |
ror radix ;flag decimal conversion |
; |
.0000040 lda basetab,x ;number bases table |
sta range ;set valid numeral range |
lda bitsdtab,x ;get bits per digit |
sta bitsdig ;store |
; |
; |
; process numerals... |
; |
ascbin01 jsr getchar ;get next char |
beq ascbin03 ;EOI |
; |
cmp #' ' |
|
; |
cmp #',' |
|
; |
cmp #a_ht |
|
; |
jsr nybtobin ;change to binary |
bcs ascbin04 ;not a recognized numeral |
; |
cmp range ;check range |
bcs ascbin04 ;not valid for base |
; |
sta numeral ;save processed numeral |
inc charcnt ;bump numeral count |
bit radix ;working in base 10? |
bpl .0000030 ;no |
; |
; |
; compute N*2 for decimal conversion... |
; |
ldx #0 ;accumulator index |
ldy #s_pfac/2 ;iterations |
longa |
clc |
; |
.0000020 lda faca,x ;N |
rol ;N=N*2 |
sta facb,x |
inx |
inx |
dey |
bne .0000020 |
; |
|
; |
shorta |
; |
; |
; compute N*base for binary, octal or hex... |
; or N*8 for decimal... |
; |
.0000030 ldx bitsdig ;bits per digit |
longa ;16 bit shifts |
; |
.0000040 asl faca |
rol faca+s_word |
|
; |
dex |
bne .0000040 ;next shift |
; |
shorta ;back to 8 bits |
bit radix ;check base |
bpl ascbin02 ;not decimal |
; |
; |
; compute N*10 for decimal (N*8 + N*2)... |
; |
ldy #s_pfac |
longa |
; |
.0000050 lda faca,x ;N*8 |
adc facb,x ;N*2 |
sta faca,x ;now N*10 |
inx |
inx |
dey |
bne .0000050 |
; |
|
; |
shorta |
; |
; |
; add current numeral to partial result... |
; |
ascbin02 lda faca ;N |
adc numeral ;N=N+D |
sta faca |
ldx #1 |
ldy #s_pfac-1 |
; |
.0000010 lda faca,x |
adc #0 ;account for carry |
sta faca,x |
inx |
dey |
bne .0000010 |
; |
bcc ascbin01 ;next if no overflow |
; |
|
; |
; |
; finish up... |
; |
ascbin03 clc ;no error |
; |
ascbin04 shorta ;reset if necessary |
lda charcnt ;load char count |
rts ;done |
; |
;================================================================================ |
; |
;bcdasc: CONVERT BCD DIGIT TO ASCII |
; |
|
; Preparatory Ops: .A: BCD digit, $00-$99 |
; |
; Returned Values: .A: ASCII MSD |
; .X: ASCII LSD |
; .Y: entry value |
|
; |
bcdasc jsr bintonyb ;extract nybbles |
pha ;save tens |
txa |
ora #btoamask ;change units to ASCII |
tax ;store |
pla ;get tens |
ora #btoamask ;change to ASCII |
rts |
; |
;================================================================================ |
; |
;bintonyb: EXTRACT BINARY NYBBLES |
; |
|
; Preparatory Ops: .A: binary value |
; |
; Returned Values: .A: MSN |
; .X: LSN |
; .Y: entry value |
|
; |
bintonyb pha ;save |
and #bcdumask ;extract LSN |
tax ;save it |
pla |
; .rept s_bnybbl ;extract MSN |
lsr |
lsr |
lsr |
lsr |
; .endr |
rts |
; |
;================================================================================ |
; |
;binasc: CONVERT 32-BIT BINARY TO NULL-TERMINATED ASCII NUMBER STRING |
; |
|
; Preparatory Ops: FACA: 32-bit operand |
; .A: radix character, w/bit 7 set to |
; suppress radix symbol in the |
; conversion string |
; |
; Returned Values: ibuffer: conversion string |
; .A: string length |
; .X: string address LSB |
; .Y: string address MSB |
; |
; Execution Notes: ibufidx & instsize are overwritten. |
|
; |
binasc stz ibufidx ;initialize string index |
stz instsize ;clear format flag |
; |
; |
; evaluate radix... |
; |
asl ;extract format flag &... |
ror instsize ;save it |
lsr ;extract radix character |
ldx #n_radix-1 ;total radices |
; |
.0000010 cmp radxtab,x ;recognized radix? |
beq .0000020 ;yes |
; |
dex |
bpl .0000010 ;try next |
; |
inx ;assume hex |
; |
.0000020 stx radix ;save radix index for later |
bit instsize |
bmi .0000030 ;no radix symbol wanted |
; |
lda radxtab,x ;radix table |
sta ibuffer ;prepend to string |
inc ibufidx ;bump string index |
; |
.0000030 cmp #c_dec ;converting to decimal? |
bne .0000040 ;no |
; |
jsr facabcd ;convert operand to BCD |
lda #0 |
bra .0000070 ;skip binary stuff |
; |
; |
; prepare for binary, octal or hex conversion... |
; |
.0000040 ldx #0 ;operand index |
ldy #s_sfac-1 ;workspace index |
; |
.0000050 lda faca,x ;copy operand to... |
sta facb,y ;workspace in... |
dey ;big-endian order |
inx |
cpx #s_pfac |
bne .0000050 |
; |
lda #0 |
tyx |
; |
.0000060 sta facb,x ;pad workspace |
dex |
bpl .0000060 |
; |
; |
; set up conversion parameters... |
; |
.0000070 sta facc ;initialize byte counter |
ldy radix ;radix index |
lda numstab,y ;numerals in string |
sta facc+s_byte ;set remaining numeral count |
lda bitsntab,y ;bits per numeral |
sta facc+s_word ;set |
lda lzsttab,y ;leading zero threshold |
sta facc+s_xword ;set |
; |
; |
; generate conversion string... |
; |
.0000080 lda #0 |
ldy facc+s_word ;bits per numeral |
; |
.0000090 ldx #s_sfac-1 ;workspace size |
clc ;avoid starting carry |
; |
.0000100 rol facb,x ;shift out a bit... |
dex ;from the operand or... |
bpl .0000100 ;BCD conversion result |
; |
rol ;bit to .A |
dey |
bne .0000090 ;more bits to grab |
; |
tay ;if numeral isn't zero... |
bne .0000110 ;skip leading zero tests |
; |
ldx facc+s_byte ;remaining numerals |
cpx facc+s_xword ;leading zero threshold |
bcc .0000110 ;below it, must convert |
; |
ldx facc ;processed byte count |
beq .0000130 ;discard leading zero |
; |
.0000110 cmp #10 ;check range |
bcc .0000120 ;is 0-9 |
; |
adc #a_hexdec ;apply hex adjust |
; |
.0000120 adc #'0' ;change to ASCII |
ldy ibufidx ;string index |
sta ibuffer,y ;save numeral in buffer |
inc ibufidx ;next buffer position |
inc facc ;bytes=bytes+1 |
; |
.0000130 dec facc+s_byte ;numerals=numerals-1 |
bne .0000080 ;not done |
; |
; |
; terminate string & exit... |
; |
ldx ibufidx ;printable string length |
stz ibuffer,x ;terminate string |
txa |
ldx #<ibuffer ;converted string |
ldy #>ibuffer |
clc ;all okay |
rts |
; |
;================================================================================ |
; |
;binhex: CONVERT BINARY BYTE TO HEX ASCII CHARS |
; |
|
; Preparatory Ops: .A: byte to convert |
; |
; Returned Values: .A: MSN ASCII char |
; .X: LSN ASCII char |
; .Y: entry value |
|
; |
binhex jsr bintonyb ;generate binary values |
pha ;save MSN |
txa |
jsr .0000010 ;generate ASCII LSN |
tax ;save |
pla ;get input |
; |
; |
; convert nybble to hex ASCII equivalent... |
; |
.0000010 cmp #10 |
bcc .0000020 ;in decimal range |
; |
adc #k_hex ;hex compensate |
; |
.0000020 eor #'0' ;finalize nybble |
rts ;done |
; |
;================================================================================ |
; |
;clrfaca: CLEAR FLOATING ACCUMULATOR A |
; |
clrfaca php |
longa |
stz faca |
stz faca+s_word |
plp |
rts |
; |
;================================================================================ |
; |
;clrfacb: CLEAR FLOATING ACCUMULATOR B |
; |
clrfacb php |
longa |
stz facb |
stz facb+s_word |
plp |
rts |
; |
;================================================================================ |
; |
;facabcd: CONVERT FACA INTO BCD |
; |
facabcd ldx #s_pfac-1 ;primary accumulator size -1 |
; |
.0000010 lda faca,x ;value to be converted |
pha ;preserve |
dex |
bpl .0000010 ;next |
; |
ldx #s_sfac-1 ;workspace size |
; |
.0000020 stz facb,x ;clear final result |
stz facc,x ;clear scratchpad |
dex |
bpl .0000020 |
; |
inc facc+s_sfac-s_byte |
sed ;select decimal mode |
ldy #m_bits-1 ;bits to convert -1 |
; |
.0000030 ldx #s_pfac-1 ;operand size |
clc ;no carry at start |
; |
.0000040 ror faca,x ;grab LS bit in operand |
dex |
bpl .0000040 |
; |
bcc .0000060 ;LS bit clear |
; |
clc |
ldx #s_sfac-1 |
; |
.0000050 lda facb,x ;partial result |
adc facc,x ;scratchpad |
sta facb,x ;new partial result |
dex |
bpl .0000050 |
; |
clc |
; |
.0000060 ldx #s_sfac-1 |
; |
.0000070 lda facc,x ;scratchpad |
adc facc,x ;double &... |
sta facc,x ;save |
dex |
bpl .0000070 |
; |
dey |
bpl .0000030 ;next operand bit |
; |
cld |
ldx #0 |
ldy #s_pfac |
; |
.0000080 pla ;operand |
sta faca,x ;restore |
inx |
dey |
bne .0000080 ;next |
; |
rts |
; |
;================================================================================ |
; |
;nybtobin: CONVERT ASCII NYBBLE TO BINARY |
; |
nybtobin jsr toupper ;convert case if necessary |
sec |
sbc #'0' ;change to binary |
|
; |
cmp #10 |
bcc .0000010 ;numeral is 0-9 |
; |
|
clc ;no conversion error |
; |
.0000010 rts |
; |
.0000020 sec ;conversion error |
rts |
; |
;================================================================================ |
; |
;calccnt: COMPUTE BYTE COUNT FROM ADDRESS RANGE |
; |
calccnt jsr clrfacb ;clear accumulator |
longa |
sec |
lda addrb ;ending address |
sbc addra ;starting address |
sta facb ;byte count |
shorta |
lda addrb+s_word ;handle banks |
sbc addra+s_word |
sta facb+s_word |
rts |
; |
;================================================================================ |
; |
;clroper: CLEAR OPERAND |
; |
clroper phx |
ldx #s_oper-1 |
; |
.0000010 stz operand,x |
dex |
bpl .0000010 |
; |
stz eopsize |
plx |
rts |
; |
;================================================================================ |
; |
;cpfwsup: FOWARD COPY MEMORY SETUP |
; |
cpfwsup longr |
ldxw opc_mvn ;"move next" opcode |
bra cpsup |
; |
;================================================================================ |
; |
;cprvsup: REVERSE COPY MEMORY SETUP |
; |
cprvsup longr |
ldxw opc_mvp ;"move previous" opcode |
; |
;================================================================================ |
; |
;cpsup: COPY MEMORY SETUP |
; |
cpsup pha ;save banks |
txa ;protect... |
xba ;opcode |
shorta |
ldxw (cpcodeee-cpcode-1) |
; |
.0000010 ldalx cpcode ;transfer copy code to... |
sta mcftwork,x ;to workspace |
dex |
bpl .0000010 |
; |
xba ;recover opcode &... |
sta mcftopc ;set it |
longa |
pla ;get banks &... |
sta mcftbnk ;set them |
|
;------------------------------------------------------------------------------- |
; We just dynamically created a routine, so the cache (if one is present) has |
; to be invalidated. Otherwise the processor could execute dead code from the |
; cache. Two lines are invalidated in case the code crosses a line boundary. |
; |
; Parameters to ICacheIL816: |
; acc = 16 bit address to invalidate |
; |
; The ICacheIL816 routine should invalidate the cache line and return. If there |
; is no cache in the processor then these lines can be deleted. |
;------------------------------------------------------------------------------- |
pha |
lda #mcftwork |
jsr ICacheIL816 |
lda #mcftwork+8 |
jsr ICacheIL816 |
pla |
;--------------------------------------------- |
rts |
; |
;================================================================================ |
; |
;cpcode: COPY MEMORY CODE |
; |
|
; This code is transfered to workspace when a |
; copy or fill operation is to be performed. |
|
; |
cpcode phb ;must preserve data bank |
; .rept s_mvinst |
nop ;placeholder |
nop |
nop |
; .endr |
plb ;restore data bank |
jml monce ;return to command executive |
|
; |
;================================================================================ |
; |
;decdcnt: DECREMENT DUMP COUNT |
; |
|
; Preparatory Ops: bytes to process in FACB |
; bytes processed in CHARCNT |
; |
; Returned Values: .A: used |
; .X: entry value |
; .Y: entry value |
; .C: 1 = count = zero |
|
; |
decdcnt shorta |
lda #0 |
xba ;clear .B |
lda facb+s_word ;count MSW |
longa |
sec |
ora facb ;count LSW |
beq .0000020 ;zero, just exit |
; |
lda facb |
sbc charcnt ;bytes processed |
sta facb |
shorta |
lda facb+s_word |
sbc #0 ;handle borrow |
bcc .0000010 ;underflow |
; |
sta facb+s_word |
clc ;count > 0 |
rts |
; |
.0000010 sec |
; |
.0000020 shorta |
rts |
; |
;================================================================================ |
; |
;enddest: GET 2ND & 3RD ADDRESSES FOR COMPARE & TRANSFER |
; |
enddest jsr facasize ;check start... |
cmp #s_dword ;for range |
|
; |
jsr facaddra ;store start |
jsr getparm ;get end |
|
; |
jsr facasize ;check end... |
cmp #s_dword ;for range |
|
; |
jsr facaddrb ;store end |
jsr getparm ;get destination |
|
; |
jsr facasize ;check destination... |
cmp #s_dword ;for range |
bcc facaoper ;store dest address |
; |
.0000010 rts ;exit w/error |
; |
;================================================================================ |
; |
;facaddra: COPY FACA TO ADDRA |
; |
facaddra ldx #s_xword-1 |
; |
.0000010 lda faca,x |
sta addra,x |
dex |
bpl .0000010 |
; |
rts |
; |
;================================================================================ |
; |
;facaddrb: COPY FACA TO ADDRB |
; |
facaddrb ldx #s_xword-1 |
; |
.0000010 lda faca,x |
sta addrb,x |
dex |
bpl .0000010 |
; |
rts |
; |
;================================================================================ |
; |
;facaoper: COPY FACA TO OPERAND |
; |
facaoper ldx #s_oper-1 |
; |
.0000010 lda faca,x |
sta operand,x |
dex |
bpl .0000010 |
; |
rts |
; |
;================================================================================ |
; |
;facasize: REPORT OPERAND SIZE IN FACA |
; |
|
; Preparatory Ops: operand in FACA |
; |
; Returned Values: .A: s_byte (1) |
; s_word (2) |
; s_xword (3) |
; s_dword (4) |
; |
; Notes: 1) This function will always report |
; a non-zero result. |
|
; |
facasize shortr |
ldx #s_dword-1 |
; |
.0000010 lda faca,x ;get byte |
bne .0000020 ;done |
; |
dex |
bne .0000010 ;next byte |
; |
.0000020 inx ;count=index+1 |
txa |
rts |
; |
;================================================================================ |
; |
;getbyte: GET A BYTE FROM MEMORY |
; |
getbyte ldail addra ;get a byte |
bra incaddra ;bump address |
; |
;================================================================================ |
; |
;getparm: GET A PARAMETER |
; |
|
; Preparatory Ops: null-terminated input in IBUFFER |
; |
; Returned Values: .A: chars in converted parameter |
; .X: used |
; .Y: entry value |
; .C: 1 = no parameter entered |
|
; |
getparmr dec ibufidx ;reread previous char |
; |
getparm phy ;preserve |
jsr ascbin ;convert parameter to binary |
bcs .0000040 ;conversion error |
; |
jsr getcharr ;reread last char |
bne .0000010 ;not end-of-input |
; |
dec ibufidx ;reindex to terminator |
lda charcnt ;get chars processed so far |
beq .0000030 ;none |
; |
bne .0000020 ;some |
; |
.0000010 cmp #a_blank ;recognized delimiter |
beq .0000020 ;end of parameter |
; |
cmp #',' ;recognized delimiter |
bne .0000040 ;unknown delimter |
; |
.0000020 clc |
.byte bitzp ;skip SEC below |
; |
.0000030 sec |
ply ;restore |
lda charcnt ;get count |
rts ;done |
; |
.0000040 |
;.rept 3 ;clean up stack |
pla |
pla |
pla |
; .endr |
jmp monerr ;abort w/error |
; |
;================================================================================ |
; |
;nxtaddra: TEST & INCREMENT WORKING ADDRESS 'A' |
; |
|
; Calling syntax: JSR NXTADDRA |
; |
; Exit registers: .A: used |
; .B: used |
; .X: entry value |
; .Y: entry value |
; DB: entry value |
; DP: entry value |
; PB: entry value |
; SR: NVmxDIZC |
; |||||||| |
|
; ||||||| 1: ADDRA >= ADDRB |
|
|
|
|
|
; |
nxtaddra shorta |
lda addra+s_word ;bits 16-23 |
cmp addrb+s_word |
bcc incaddra ;increment |
; |
bne .0000010 ;don't increment |
; |
longa |
lda addra ;bits 0-15 |
cmp addrb ;condition flags |
shorta |
bcc incaddra ;increment |
; |
.0000010 rts |
; |
;================================================================================ |
; |
;incaddra: INCREMENT WORKING ADDRESS 'A' |
; |
|
; Calling syntax: JSR INCADDRA |
; |
; Exit registers: .A: entry value |
; .B: entry value |
; .X: entry value |
; .Y: entry value |
; DB: entry value |
; DP: entry value |
; PB: entry value |
; SR: NVmxDIZC |
; |||||||| |
|
|
; |
incaddra php |
longa |
inc addra ;bump bits 0-15 |
bne .0000010 |
; |
shorta |
inc addra+s_word ;bump bits 16-23 |
; |
.0000010 plp |
rts |
; |
;================================================================================ |
; |
;incoper: INCREMENT OPERAND ADDRESS |
; |
incoper clc |
php |
longr |
pha |
inc operand ;handle base address |
bne .0000010 |
; |
shorta |
inc operand+s_word ;handle bank |
longa |
; |
.0000010 pla |
plp |
rts |
; |
;================================================================================ |
; |
;instdata: GET INSTRUCTION SIZE & ADDRESSING MODE DATA |
; |
|
; Preparatory Ops: .X: 65C816 opcode |
; |
; Returned Values: .A: mode flags |
; .X: operand size |
; .Y: mode index |
|
; |
instdata shortr |
lda mnetabam,x ;addressing mode data |
pha ;save mode flag bits |
pha ;save size data |
and #amodmask ;extract mode index &... |
tay ;save |
pla ;recover data |
and #opsmask ;mask mode fields &... |
; .rept n_opslsr ;extract operand size |
lsr |
lsr |
lsr |
lsr |
; .endr |
tax ;operand size |
pla ;recover mode flags |
and #vopsmask ;discard mode & size fields |
rts |
; |
;================================================================================ |
; |
;offtarg: CONVERT BRANCH OFFSET TO TARGET ADDRESS |
; |
|
; Preparatory Ops: ADDRA: base address |
; INSTSIZE: instruction size |
; OPERAND: offset |
; |
; Returned Values: OPERAND: target address (L/H) |
; .A: used |
; .X: entry value |
; .Y: entry value |
|
; |
offtarg longa |
lda addra ;base address |
shorta |
lsr instsize ;bit 0 will be set if... |
bcs .0000010 ;a long branch |
; |
bit operand ;short forward or backward? |
bpl .0000010 ;forward |
; |
xba ;expose address MSB |
dea ;back a page |
xba ;expose address LSB |
; |
.0000010 longa |
clc |
adc operand ;calculate target address |
sta operand ;new operand |
shorta |
lda #s_xword |
sta instsize ;effective instruction size |
rts |
; |
;================================================================================ |
; |
;setxaddr: SET EXECUTION ADDRESS |
; |
setxaddr bcs .0000010 ;no address given |
; |
jsr facasize ;check address... |
cmp #s_dword ;range |
bcs .0000020 ;out of range |
; |
longa |
lda faca ;execution address |
sta reg_pcx ;set new PC value |
shorta |
lda faca+s_word |
sta reg_pbx ;set new PB value |
; |
.0000010 clc ;no error |
; |
.0000020 rts |
; |
;================================================================================ |
; |
;targoff: CONVERT BRANCH TARGET ADDRESS TO BRANCH OFFSET |
; |
|
; Preparatory Ops: ADDRA: instruction address |
; OPERAND: target address |
; |
; Returned Values: OPERAND: computed offset |
; .A: effective operand size |
; .X: entry value |
; .Y: entry value |
; .C: 1 = branch out of range |
; |
; Execution notes: ADDRB is set to the branch base |
; address. |
|
; |
targoff stz instsize+s_byte ;always zero |
lda instsize ;instruction size will tell... |
lsr ;if long or short branch |
; |
|
.btype =facc+5 ;branch type flag |
|
; |
ror .btype ;set branch type... |
; |
; x0000000 |
; | |
|
; 1: long |
; |
longa |
clc |
lda addra ;instruction address |
adc instsize ;instruction size |
sta addrb ;base address |
sec |
lda operand ;target address |
sbc addrb ;base address |
sta operand ;offset |
shorta |
bcc .0000040 ;backward branch |
; |
bit .btype ;check branch range |
bmi .0000020 ;long |
; |
; |
; process short forward branch... |
; |
xba ;offset MSB should be zero |
|
; |
xba ;offset LSB should be $00-$7F |
|
; |
.0000010 lda #s_byte ;final instruction size |
clc ;branch in range |
rts |
; |
; |
; process long forward branch... |
; |
.0000020 xba ;offset MSB should be positive |
|
; |
.0000030 lda #s_word |
clc |
rts |
; |
; |
; process backward branch... |
; |
.0000040 bit .btype ;long or short? |
bmi .0000050 ;long |
; |
; |
; process short backward branch... |
; |
xba ;offset MSB should be negative |
|
; |
eor #@11111111 ;complement offset MSB 2s |
bne .0000060 ;out of range |
; |
xba ;offset LSB should be $80-$FF |
|
; |
bra .0000060 ;branch out of range |
; |
; |
; process long backward branch... |
; |
.0000050 xba ;offset MSB should be negative |
|
; |
.0000060 sec ;range error |
rts |
; |
;================================================================================ |
; |
;getcharr: GET PREVIOUS INPUT BUFFER CHARACTER |
; |
getcharr dec ibufidx ;move back a char |
; |
;================================================================================ |
; |
;getchar: GET A CHARACTER FROM INPUT BUFFER |
; |
|
; Preparatory Ops : none |
; |
; Register Returns: .A: character or <NUL> |
; .B: entry value |
; .X: entry value |
; .Y: entry value |
; |
; MPU Flags: NVmxDIZC |
; |||||||| |
|
|
|
|
|
|
|
|
|
; |
getchar phx |
phy |
php ;save register sizes |
shortr ;force 8 bits |
ldx ibufidx ;buffer index |
lda ibuffer,x ;get char |
inc ibufidx ;bump index |
plp ;restore register widths |
ply |
plx |
; Changed the following to XBA instruction which seems to work as well. |
; XBA doesn't access the stack memory saving a data memory access, |
; and hence is faster. |
xba ; pha ;condition... |
xba ; pla ;.Z |
rts |
; |
;================================================================================ |
; |
;getpat: GET PATTERN FOR MEMORY CHANGE or SEARCH |
; |
|
; Preparatory Ops: Null-terminated pattern in IBUFFER. |
; |
; Returned Values: .A: used |
; .X: used |
; .Y: pattern length if entered |
; .C: 0 = pattern valid |
; 1 = exception: |
; .N 0 = no pattern entered |
; 1 = evaluation error |
; |
; Notes: 1) If pattern is preceded by "'" the following |
; characters are interpreted as ASCII. |
; 2) A maximum of 32 bytes or characters is |
; accepted. Excess input will be discarded. |
|
; |
getpat stz status ;clear pattern type indicator |
ldy #0 ;pattern index |
jsr getcharr ;get last char |
beq .0000070 ;EOS |
; |
ldx ibufidx ;current buffer index |
jsr getcharw ;get next |
beq .0000070 ;EOS |
; |
cmp #''' |
bne .0000010 ;not ASCII input |
; |
ror status ;condition flag |
bra .0000030 ;balance of input is ASCII |
; |
.0000010 stx ibufidx ;restore buffer index |
; |
.0000020 jsr getparm ;evaluate numeric pattern |
bcs .0000060 ;done w/pattern |
; |
jsr facasize ;size |
cmp #s_word |
|
; |
lda faca ;get byte &... |
bra .0000040 ;store |
; |
.0000030 jsr getchar ;get ASCII char |
beq .0000060 ;done w/pattern |
; |
.0000040 cpy #s_auxbuf ;pattern buffer full? |
beq .0000050 ;yes |
; |
sta auxbuf,y ;store pattern |
iny |
bit status |
bpl .0000020 ;get next numeric value |
; |
bra .0000030 ;get next ASCII char |
; |
.0000050 jsr alert ;excess input |
; |
.0000060 sty auxbufix ;save pattern size |
tya ;condition .Z |
clc ;pattern valid |
rts |
; |
; |
; no pattern entered... |
; |
.0000070 rep @10000000 |
sec |
rts |
; |
; |
; evaluation error... |
; |
.0000080 sep @10000001 |
rts |
; |
;================================================================================ |
; |
;getcharw: GET FROM INPUT BUFFER, DISCARDING WHITESPACE |
; |
|
; Preparatory Ops: Null-terminated input in IBUFFER. |
; |
; Returned Values: .A: char or null |
; .X: entry value |
; .Y: entry value |
; .Z: 1 = null terminator detected |
; |
; Notes: Whitespace is defined as a blank ($20) or a |
; horizontal tab ($09). |
|
; |
getcharw jsr getchar ;get from buffer |
beq .0000010 ;EOI |
; |
cmp #' ' |
beq getcharw ;discard whitespace |
; |
cmp #a_ht ;also whitespace |
beq getcharw |
; |
.0000010 clc |
rts |
; |
;================================================================================ |
; |
;input: INTERACTIVE INPUT FROM CONSOLE CHANNEL |
; |
|
; Preparatory Ops: Zero IBUFIDX or load IBUFFER with default |
; input & set IBUFIDX to the number of chars |
; loaded into the buffer. |
; |
; Returned Values: .A: used |
; .X: characters entered |
; .Y: used |
; |
; Example: STZ IBUFIDX |
; JSR INPUT |
; |
; Notes: Input is collected in IBUFFER & is null-terminated. |
; IBUFIDX is reset to zero upon exit. |
|
; |
input: |
ldx ibufidx |
stz ibuffer,x ;be sure buffer is terminated |
jsr dpyibuf ;print default input if any |
pea dc_cn |
jsr sprint ;enable cursor |
ldx ibufidx ;starting buffer index |
; |
; |
; main input loop... |
; |
.0000010 jsr getcha ;poll for input |
bcc .0000020 ;got something |
; |
jsr $F409 ;wait 'til any IRQ &... (Reschedule tasks) |
bra .0000010 ;try again |
; |
.0000020 cmp #a_del ;above ASCII range? |
bcs .0000010 ;yes, ignore |
; |
cmp #a_ht ;horizontal tab? |
bne .0000030 ;no |
; |
lda #a_blank ;replace <HT> w/blank |
; |
.0000030 cmp #a_blank ;control char? |
bcc .0000050 ;yes |
; |
; |
; process QWERTY character... |
; |
cpx #s_ibuf ;room in buffer? |
bcs .0000040 ;no |
; |
sta ibuffer,x ;store char |
inx ;bump index |
.byte bitabs ;echo char |
; |
.0000040 lda #a_bel ;alert user |
jsr putcha |
bra .0000010 ;get some more |
; |
; |
; process carriage return... |
; |
.0000050 cmp #a_cr ;carriage return? |
bne .0000060 ;no |
; |
phx ;protect input count |
pea dc_co |
jsr sprint ;cursor off |
plx ;recover input count |
stz ibuffer,x ;terminate input &... |
stz ibufidx ;reset buffer index |
rts ;done |
; |
; |
; process backspace... |
; |
.0000060 cmp #a_bs ;backspace? |
bne .0000010 ;no |
; |
txa |
beq .0000010 ;no input, ignore <BS> |
; |
dex ;1 less char |
phx ;preserve count |
jsr gendbs ;destructive backspace |
plx ;restore count |
bra .0000010 ;get more input |
; |
;================================================================================ |
; |
;lodbnk: LOAD SOURCE & DESTINATION BANKS |
; |
lodbnk shorta |
lda operand+s_word ;destination bank |
xba ;make it MSB |
lda addra+s_word ;source bank is LSB |
rts |
; |
;================================================================================ |
; |
;getcharc: GET A CHARACTER FROM INPUT BUFFER & CONVERT CASE |
; |
|
; Preparatory Ops: Null-terminated input in IBUFFER. |
; |
; Returned Values: .A: char or null |
; .X: entry value |
; .Y: entry value |
; .Z: 1 = null terminator detected |
|
; |
getcharc jsr getchar ;get from buffer |
beq touppera ;just return |
; |
;================================================================================ |
; |
;toupper: FORCE CHARACTER TO UPPER CASE |
; |
|
; Preparatory Ops : .A: character to convert |
; |
; Register Returns: .A: converted character |
; .B: entry value |
; .X: entry value |
; .Y: entry value |
; |
; MPU Flags: no change |
; |
; Notes: 1) This subroutine has no effect on char- |
; acters that are not alpha. |
|
; |
toupper php ;protect flags |
cmp #a_asclcl ;check char range |
bcc .0000010 ;not LC alpha |
; |
cmp #a_asclch+s_byte |
bcs .0000010 ;not LC alpha |
; |
and #a_lctouc ;force to UC |
; |
.0000010 plp ;restore flags |
; |
touppera rts |
; |
;================================================================================ |
; |
;teststop: TEST FOR STOP KEY |
; |
|
; Preparatory Ops: none |
; |
; Returned Values: .A: detected keypress, if any |
; .X: entry value |
; .Y: entry value |
; |
; MPU Flags: NVmxDIZC |
; |||||||| |
|
; ||||||| 1: <STOP> detected |
|
; |
; Example: jsr teststop |
; bcs stopped |
; |
; Notes: The symbol STOPKEY defines the ASCII |
; value of the "stop key." |
|
; |
teststop jsr getcha ;poll console |
bcs .0000010 ;no input |
; |
cmp #stopkey ;stop key pressed? |
beq .0000020 ;yes |
; |
.0000010 clc |
; |
.0000020 rts |
; |
;================================================================================ |
; |
;COMMAND PROCESSING DATA TABLES |
; |
; |
; monitor commands... |
; |
mpctab .byte "A" ;assemble code |
.byte "C" ;compare memory ranges |
.byte "D" ;disassemble code |
.byte "F" ;fill memory |
.byte "G" ;execute code |
.byte "H" ;search memory |
.byte "J" ;execute code as subroutine |
.byte "M" ;dump memory range |
.byte "R" ;dump registers |
.byte "T" ;copy memory range |
.byte "X" ;exit from monitor |
.byte ">" ;change memory |
.byte ";" ;change registers |
n_mpctab =*-mpctab ;entries in above table |
; |
; |
; monitor command jump table... |
; |
mpcextab .word monasc-s_byte ; A assemble code |
.word moncmp-s_byte ; C compare memory ranges |
.word mondsc-s_byte ; D disassemble code |
.word monfil-s_byte ; F fill memory |
.word monjmp-s_byte ; G execute code |
.word monhnt-s_byte ; H search memory |
.word monjsr-s_byte ; J execute code as subroutine |
.word mondmp-s_byte ; M dump memory range |
.word monreg-s_byte ; R dump registers |
.word moncpy-s_byte ; T copy memory range |
.word monxit-s_byte ; X exit from monitor |
.word monchm-s_byte ; > change memory |
.word monchr-s_byte ; ; change registers |
; |
; |
; number conversion... |
; |
basetab .byte 16,10,8,2 ;supported number bases |
bitsdtab .byte 4,3,3,1 ;bits per binary digit |
bitsntab .byte 4,4,3,1 ;bits per ASCII character |
lzsttab .byte 3,2,9,2 ;leading zero suppression thresholds |
numstab .byte 12,12,16,48 ;bin to ASCII conversion numerals |
radxtab .byte c_hex ;hexadecimal radix |
.byte c_dec ;decimal radix |
.byte c_oct ;octal radix |
.byte c_bin ;binary radix |
n_radix =*-radxtab ;number of recognized radices |
; |
; |
; shadow MPU register sizes... |
; |
rcvltab .byte s_mpupbx+s_byte ; PB |
.byte s_mpupcx+s_byte ; PC |
.byte s_mpusrx+s_byte ; SR |
.byte s_word+s_byte ; .C |
.byte s_word+s_byte ; .X |
.byte s_word+s_byte ; .Y |
.byte s_mpuspx+s_byte ; SP |
.byte s_mpudpx+s_byte ; DP |
.byte s_mpudbx+s_byte ; DB |
n_regchv =*-rcvltab ;total shadow registers |
; |
;================================================================================ |
; |
;ASSEMBLER/DISASSEMBLER DATA TABLES |
; |
; |
; numerically sorted & encoded W65C816S mnemonics... |
; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
; |
s_mnetab =*-mnetab ;mnemonic table size |
n_mnemon =s_mnetab/s_word ;total mnemonics |
; |
; |
; mnemonic lookup indices in opcode order... |
; |
mnetabix .byte mne_brkx ; $00 BRK |
.byte mne_orax ; $01 ORA (dp,X) |
.byte mne_copx ; $02 COP |
.byte mne_orax ; $03 ORA offset,S |
.byte mne_tsbx ; $04 TSB dp |
.byte mne_orax ; $05 ORA dp |
.byte mne_aslx ; $06 ASL dp |
.byte mne_orax ; $07 ORA [dp] |
.byte mne_phpx ; $08 PHP |
.byte mne_orax ; $09 ORA # |
.byte mne_aslx ; $0A ASL A |
.byte mne_phdx ; $0B PHD |
.byte mne_tsbx ; $0C TSB abs |
.byte mne_orax ; $0D ORA abs |
.byte mne_aslx ; $0E ASL abs |
.byte mne_orax ; $0F ORA absl |
; |
.byte mne_bplx ; $10 BPL abs |
.byte mne_orax ; $11 ORA (dp),Y |
.byte mne_orax ; $12 ORA (dp) |
.byte mne_orax ; $13 ORA (offset,S),Y |
.byte mne_trbx ; $14 TRB dp |
.byte mne_orax ; $15 ORA dp,X |
.byte mne_aslx ; $16 ASL dp,X |
.byte mne_orax ; $17 ORA [dp],Y |
.byte mne_clcx ; $18 CLC |
.byte mne_orax ; $19 ORA abs |
.byte mne_incx ; $1A INC A |
.byte mne_tcsx ; $1B TCS |
.byte mne_trbx ; $1C TRB abs |
.byte mne_orax ; $1D ORA abs,X |
.byte mne_aslx ; $1E ASL abs,X |
.byte mne_orax ; $1F ORA absl,X |
; |
.byte mne_jsrx ; $20 JSR abs |
.byte mne_andx ; $21 AND (dp,X) |
.byte mne_jslx ; $22 JSL absl |
.byte mne_andx ; $23 AND offset,S |
.byte mne_bitx ; $24 BIT dp |
.byte mne_andx ; $25 AND dp |
.byte mne_rolx ; $26 ROL dp |
.byte mne_andx ; $27 AND [dp] |
.byte mne_plpx ; $28 PLP |
.byte mne_andx ; $29 AND # |
.byte mne_rolx ; $2A ROL A |
.byte mne_pldx ; $2B PLD |
.byte mne_bitx ; $2C BIT abs |
.byte mne_andx ; $2D AND abs |
.byte mne_rolx ; $2E ROL abs |
.byte mne_andx ; $2F AND absl |
; |
.byte mne_bmix ; $30 BMI abs |
.byte mne_andx ; $31 AND (dp),Y |
.byte mne_andx ; $32 AND (dp) |
.byte mne_andx ; $33 AND (offset,S),Y |
.byte mne_bitx ; $34 BIT dp,X |
.byte mne_andx ; $35 AND dp,X |
.byte mne_rolx ; $36 ROL dp,X |
.byte mne_andx ; $37 AND [dp],Y |
.byte mne_secx ; $38 SEC |
.byte mne_andx ; $39 AND abs,Y |
.byte mne_decx ; $3A DEC A |
.byte mne_tscx ; $3B TSC |
.byte mne_bitx ; $3C BIT abs,X |
.byte mne_andx ; $3D AND abs,X |
.byte mne_rolx ; $3E ROL abs,X |
.byte mne_andx ; $3F AND absl,X |
; |
.byte mne_rtix ; $40 RTI |
.byte mne_eorx ; $41 EOR (dp,X) |
.byte mne_wdmx ; $42 WDM |
.byte mne_eorx ; $43 EOR offset,S |
.byte mne_mvpx ; $44 MVP sb,db |
.byte mne_eorx ; $45 EOR dp |
.byte mne_lsrx ; $46 LSR dp |
.byte mne_eorx ; $47 EOR [dp] |
.byte mne_phax ; $48 PHA |
.byte mne_eorx ; $49 EOR # |
.byte mne_lsrx ; $4A LSR A |
.byte mne_phkx ; $4B PHK |
.byte mne_jmpx ; $4C JMP abs |
.byte mne_eorx ; $4D EOR abs |
.byte mne_lsrx ; $4E LSR abs |
.byte mne_eorx ; $4F EOR absl |
; |
.byte mne_bvcx ; $50 BVC abs |
.byte mne_eorx ; $51 EOR (dp),Y |
.byte mne_eorx ; $52 EOR (dp) |
.byte mne_eorx ; $53 EOR (offset,S),Y |
.byte mne_mvnx ; $54 MVN sb,db |
.byte mne_eorx ; $55 EOR dp,X |
.byte mne_lsrx ; $56 LSR dp,X |
.byte mne_eorx ; $57 EOR [dp],Y |
.byte mne_clix ; $58 CLI |
.byte mne_eorx ; $59 EOR abs,Y |
.byte mne_phyx ; $5A PHY |
.byte mne_tcdx ; $5B TCD |
.byte mne_jmlx ; $5C JML absl |
.byte mne_eorx ; $5D EOR abs,X |
.byte mne_lsrx ; $5E LSR abs,X |
.byte mne_eorx ; $5F EOR absl,X |
; |
.byte mne_rtsx ; $60 RTS |
.byte mne_adcx ; $61 ADC (dp,X) |
.byte mne_perx ; $62 PER |
.byte mne_adcx ; $63 ADC offset,S |
.byte mne_stzx ; $64 STZ dp |
.byte mne_adcx ; $65 ADC dp |
.byte mne_rorx ; $66 ROR dp |
.byte mne_adcx ; $67 ADC [dp] |
.byte mne_plax ; $68 PLA |
.byte mne_adcx ; $69 ADC # |
.byte mne_rorx ; $6A ROR A |
.byte mne_rtlx ; $6B RTL |
.byte mne_jmpx ; $6C JMP (abs) |
.byte mne_adcx ; $6D ADC abs |
.byte mne_rorx ; $6E ROR abs |
.byte mne_adcx ; $6F ADC absl |
; |
.byte mne_bvsx ; $70 BVS abs |
.byte mne_adcx ; $71 ADC (dp),Y |
.byte mne_adcx ; $72 ADC (dp) |
.byte mne_adcx ; $73 ADC (offset,S),Y |
.byte mne_stzx ; $74 STZ dp,X |
.byte mne_adcx ; $75 ADC dp,X |
.byte mne_rorx ; $76 ROR dp,X |
.byte mne_adcx ; $77 ADC [dp],Y |
.byte mne_seix ; $78 SEI |
.byte mne_adcx ; $79 ADC abs,Y |
.byte mne_plyx ; $7A PLY |
.byte mne_tdcx ; $7B TDC |
.byte mne_jmpx ; $7C JMP (abs,X) |
.byte mne_adcx ; $7D ADC abs,X |
.byte mne_rorx ; $7E ROR abs,X |
.byte mne_adcx ; $7F ADC absl,X |
; |
.byte mne_brax ; $80 BRA abs |
.byte mne_stax ; $81 STA (dp,X) |
.byte mne_brlx ; $82 BRL abs |
.byte mne_stax ; $83 STA offset,S |
.byte mne_styx ; $84 STY dp |
.byte mne_stax ; $85 STA dp |
.byte mne_stxx ; $86 STX dp |
.byte mne_stax ; $87 STA [dp] |
.byte mne_deyx ; $88 DEY |
.byte mne_bitx ; $89 BIT # |
.byte mne_txax ; $8A TXA |
.byte mne_phbx ; $8B PHB |
.byte mne_styx ; $8C STY abs |
.byte mne_stax ; $8D STA abs |
.byte mne_stxx ; $8E STX abs |
.byte mne_stax ; $8F STA absl |
; |
.byte mne_bccx ; $90 BCC abs |
.byte mne_stax ; $91 STA (dp),Y |
.byte mne_stax ; $92 STA (dp) |
.byte mne_stax ; $93 STA (offset,S),Y |
.byte mne_styx ; $94 STY dp,X |
.byte mne_stax ; $95 STA dp,X |
.byte mne_stxx ; $96 STX dp,Y |
.byte mne_stax ; $97 STA [dp],Y |
.byte mne_tyax ; $98 TYA |
.byte mne_stax ; $99 STA abs,Y |
.byte mne_txsx ; $9A TXS |
.byte mne_txyx ; $9B TXY |
.byte mne_stzx ; $9C STZ abs |
.byte mne_stax ; $9D STA abs,X |
.byte mne_stzx ; $9E STZ abs,X |
.byte mne_stax ; $9F STA absl,X |
; |
.byte mne_ldyx ; $A0 LDY # |
.byte mne_ldax ; $A1 LDA (dp,X) |
.byte mne_ldxx ; $A2 LDX # |
.byte mne_ldax ; $A3 LDA offset,S |
.byte mne_ldyx ; $A4 LDY dp |
.byte mne_ldax ; $A5 LDA dp |
.byte mne_ldxx ; $A6 LDX dp |
.byte mne_ldax ; $A7 LDA [dp] |
.byte mne_tayx ; $A8 TAY |
.byte mne_ldax ; $A9 LDA # |
.byte mne_taxx ; $AA TAX |
.byte mne_plbx ; $AB PLB |
.byte mne_ldyx ; $AC LDY abs |
.byte mne_ldax ; $AD LDA abs |
.byte mne_ldxx ; $AE LDX abs |
.byte mne_ldax ; $AF LDA absl |
; |
.byte mne_bcsx ; $B0 BCS abs |
.byte mne_ldax ; $B1 LDA (dp),Y |
.byte mne_ldax ; $B2 LDA (dp) |
.byte mne_ldax ; $B3 LDA (offset,S),Y |
.byte mne_ldyx ; $B4 LDY dp,X |
.byte mne_ldax ; $B5 LDA dp,X |
.byte mne_ldxx ; $B6 LDX dp,Y |
.byte mne_ldax ; $B7 LDA [dp],Y |
.byte mne_clvx ; $B8 CLV |
.byte mne_ldax ; $B9 LDA abs,Y |
.byte mne_tsxx ; $BA TSX |
.byte mne_tyxx ; $BB TYX |
.byte mne_ldyx ; $BC LDY abs,X |
.byte mne_ldax ; $BD LDA abs,X |
.byte mne_ldxx ; $BE LDX abs,Y |
.byte mne_ldax ; $BF LDA absl,X |
; |
.byte mne_cpyx ; $C0 CPY # |
.byte mne_cmpx ; $C1 CMP (dp,X) |
.byte mne_repx ; $C2 REP # |
.byte mne_cmpx ; $C3 CMP offset,S |
.byte mne_cpyx ; $C4 CPY dp |
.byte mne_cmpx ; $C5 CMP dp |
.byte mne_decx ; $C6 DEC dp |
.byte mne_cmpx ; $C7 CMP [dp] |
.byte mne_inyx ; $C8 INY |
.byte mne_cmpx ; $C9 CMP # |
.byte mne_dexx ; $CA DEX |
.byte mne_waix ; $CB WAI |
.byte mne_cpyx ; $CC CPY abs |
.byte mne_cmpx ; $CD CMP abs |
.byte mne_decx ; $CE DEC abs |
.byte mne_cmpx ; $CF CMP absl |
; |
.byte mne_bnex ; $D0 BNE abs |
.byte mne_cmpx ; $D1 CMP (dp),Y |
.byte mne_cmpx ; $D2 CMP (dp) |
.byte mne_cmpx ; $D3 CMP (offset,S),Y |
.byte mne_peix ; $D4 PEI dp |
.byte mne_cmpx ; $D5 CMP dp,X |
.byte mne_decx ; $D6 DEC dp,X |
.byte mne_cmpx ; $D7 CMP [dp],Y |
.byte mne_cldx ; $D8 CLD |
.byte mne_cmpx ; $D9 CMP abs,Y |
.byte mne_phxx ; $DA PHX |
.byte mne_stpx ; $DB STP |
.byte mne_jmpx ; $DC JMP [abs] |
.byte mne_cmpx ; $DD CMP abs,X |
.byte mne_decx ; $DE DEC abs,X |
.byte mne_cmpx ; $DF CMP absl,X |
; |
.byte mne_cpxx ; $E0 CPX # |
.byte mne_sbcx ; $E1 SBC (dp,X) |
.byte mne_sepx ; $E2 SEP # |
.byte mne_sbcx ; $E3 SBC offset,S |
.byte mne_cpxx ; $E4 CPX dp |
.byte mne_sbcx ; $E5 SBC dp |
.byte mne_incx ; $E6 INC dp |
.byte mne_sbcx ; $E7 SBC [dp] |
.byte mne_inxx ; $E8 INX |
.byte mne_sbcx ; $E9 SBC # |
.byte mne_nopx ; $EA NOP |
.byte mne_xbax ; $EB XBA |
.byte mne_cpxx ; $EC CPX abs |
.byte mne_sbcx ; $ED SBC abs |
.byte mne_incx ; $EE INC abs |
.byte mne_sbcx ; $EF SBC absl |
; |
.byte mne_beqx ; $F0 BEQ abs |
.byte mne_sbcx ; $F1 SBC (dp),Y |
.byte mne_sbcx ; $F2 SBC (dp) |
.byte mne_sbcx ; $F3 SBC (offset,S),Y |
.byte mne_peax ; $F4 PEA # |
.byte mne_sbcx ; $F5 SBC dp,X |
.byte mne_incx ; $F6 INC dp,X |
.byte mne_sbcx ; $F7 SBC [dp],Y |
.byte mne_sedx ; $F8 SED |
.byte mne_sbcx ; $F9 SBC abs,Y |
.byte mne_plxx ; $FA PLX |
.byte mne_xcex ; $FB XCE |
.byte mne_jsrx ; $FC JSR (abs,X) |
.byte mne_sbcx ; $FD SBC abs,X |
.byte mne_incx ; $FE INC abs,X |
.byte mne_sbcx ; $FF SBC absl,X |
; |
; |
; instruction addressing modes & sizes in opcode order... |
; |
; xxxxxxxx |
; |||||||| |
|
|
; |||| 0000 dp, abs, absl, implied or A |
; |||| 0001 # |
; |||| 0010 dp,X, abs,X or absl,X |
; |||| 0011 dp,Y or abs,Y |
; |||| 0100 (dp) or (abs) |
; |||| 0101 [dp] or [abs] |
; |||| 0110 [dp],Y |
; |||| 0111 (dp,X) or (abs,X) |
; |||| 1000 (dp),Y |
; |||| 1001 offset,S |
; |||| 1010 (offset,S),Y |
; |||| 1011 sbnk,dbnk (MVN or MVP) |
|
; |||| # = immediate |
; |||| A = accumulator |
; |||| abs = absolute |
; |||| absl = absolute long |
; |||| dbnk = destination bank |
; |||| dp = direct (zero) page |
; |||| S = stack relative |
; |||| sbnk = source bank |
|
; |||| |
|
|
|
; |
|
; Variable operand size refers to an immediate mode instruction |
; that can accept either an 8 or 16 bit operand. During instr- |
; uction assembly, an 8 bit operand can be forced to 16 bits by |
; preceding the operand field with !, e.g., LDA !#$01, which |
; will assemble as $A9 $01 $00. |
|
; |
mnetabam .byte ops0 | am_nam ; $00 BRK |
.byte ops1 | am_indx ; $01 ORA (dp,X) |
.byte ops1 | am_nam ; $02 COP |
.byte ops1 | am_stk ; $03 ORA offset,S |
.byte ops1 | am_nam ; $04 TSB dp |
.byte ops1 | am_nam ; $05 ORA dp |
.byte ops1 | am_nam ; $06 ASL dp |
.byte ops1 | am_indl ; $07 ORA [dp] |
.byte ops0 | am_nam ; $08 PHP |
.byte vops | am_imm ; $09 ORA # |
.byte ops0 | am_nam ; $0A ASL A |
.byte ops0 | am_nam ; $0B PHD |
.byte ops2 | am_nam ; $0C TSB abs |
.byte ops2 | am_nam ; $0D ORA abs |
.byte ops2 | am_nam ; $0E ASL abs |
.byte ops3 | am_nam ; $0F ORA absl |
; |
.byte bop1 | am_nam ; $10 BPL abs |
.byte ops1 | am_indy ; $11 ORA (dp),Y |
.byte ops1 | am_ind ; $12 ORA (dp) |
.byte ops1 | am_stky ; $13 ORA (offset,S),Y |
.byte ops1 | am_nam ; $14 TRB dp |
.byte ops1 | am_adrx ; $15 ORA dp,X |
.byte ops1 | am_adrx ; $16 ASL dp,X |
.byte ops1 | am_indly ; $17 ORA [dp],Y |
.byte ops0 | am_nam ; $18 CLC |
.byte ops2 | am_nam ; $19 ORA abs |
.byte ops0 | am_nam ; $1A INC A |
.byte ops0 | am_nam ; $1B TCS |
.byte ops2 | am_nam ; $1C TRB abs |
.byte ops2 | am_adrx ; $1D ORA abs,X |
.byte ops2 | am_adrx ; $1E ASL abs,X |
.byte ops3 | am_adrx ; $1F ORA absl,X |
; |
.byte ops2 | am_nam ; $20 JSR abs |
.byte ops1 | am_indx ; $21 AND (dp,X) |
.byte ops3 | am_nam ; $22 JSL absl |
.byte ops1 | am_stk ; $23 AND offset,S |
.byte ops1 | am_nam ; $24 BIT dp |
.byte ops1 | am_nam ; $25 AND dp |
.byte ops1 | am_nam ; $26 ROL dp |
.byte ops1 | am_indl ; $27 AND [dp] |
.byte ops0 | am_nam ; $28 PLP |
.byte vops | am_imm ; $29 AND # |
.byte ops0 | am_nam ; $2A ROL A |
.byte ops0 | am_nam ; $2B PLD |
.byte ops2 | am_nam ; $2C BIT abs |
.byte ops2 | am_nam ; $2D AND abs |
.byte ops2 | am_nam ; $2E ROL abs |
.byte ops3 | am_nam ; $2F AND absl |
; |
.byte bop1 | am_nam ; $30 BMI abs |
.byte ops1 | am_indy ; $31 AND (dp),Y |
.byte ops1 | am_ind ; $32 AND (dp) |
.byte ops1 | am_stky ; $33 AND (offset,S),Y |
.byte ops1 | am_adrx ; $34 BIT dp,X |
.byte ops1 | am_adrx ; $35 AND dp,X |
.byte ops1 | am_adrx ; $36 ROL dp,X |
.byte ops1 | am_indly ; $37 AND [dp],Y |
.byte ops0 | am_nam ; $38 SEC |
.byte ops2 | am_adry ; $39 AND abs,Y |
.byte ops0 | am_nam ; $3A DEC A |
.byte ops0 | am_nam ; $3B TSC |
.byte ops2 | am_adrx ; $3C BIT abs,X |
.byte ops2 | am_adrx ; $3D AND abs,X |
.byte ops2 | am_adrx ; $3E ROL abs,X |
.byte ops3 | am_adrx ; $3F AND absl,X |
; |
.byte ops0 | am_nam ; $40 RTI |
.byte ops1 | am_indx ; $41 EOR (dp,X) |
.byte ops0 | am_nam ; $42 WDM |
.byte ops1 | am_stk ; $43 EOR offset,S |
.byte ops2 | am_move ; $44 MVP sb,db |
.byte ops1 | am_nam ; $45 EOR dp |
.byte ops1 | am_nam ; $46 LSR dp |
.byte ops1 | am_indl ; $47 EOR [dp] |
.byte ops0 | am_nam ; $48 PHA |
.byte vops | am_imm ; $49 EOR # |
.byte ops0 | am_nam ; $4A LSR A |
.byte ops0 | am_nam ; $4B PHK |
.byte ops2 | am_nam ; $4C JMP abs |
.byte ops2 | am_nam ; $4D EOR abs |
.byte ops2 | am_nam ; $4E LSR abs |
.byte ops3 | am_nam ; $4F EOR absl |
; |
.byte bop1 | am_nam ; $50 BVC abs |
.byte ops1 | am_indy ; $51 EOR (dp),Y |
.byte ops1 | am_ind ; $52 EOR (dp) |
.byte ops1 | am_stky ; $53 EOR (offset,S),Y |
.byte ops2 | am_move ; $54 MVN sb,db |
.byte ops1 | am_adrx ; $55 EOR dp,X |
.byte ops1 | am_adrx ; $56 LSR dp,X |
.byte ops1 | am_indly ; $57 EOR [dp],Y |
.byte ops0 | am_nam ; $58 CLI |
.byte ops2 | am_adry ; $59 EOR abs,Y |
.byte ops0 | am_nam ; $5A PHY |
.byte ops0 | am_nam ; $5B TCD |
.byte ops3 | am_nam ; $5C JML absl |
.byte ops2 | am_adrx ; $5D EOR abs,X |
.byte ops2 | am_adrx ; $5E LSR abs,X |
.byte ops3 | am_adrx ; $5F EOR absl,X |
; |
.byte ops0 | am_nam ; $60 RTS |
.byte ops1 | am_indx ; $61 ADC (dp,X) |
.byte bop2 | am_nam ; $62 PER |
.byte ops1 | am_stk ; $63 ADC offset,S |
.byte ops1 | am_nam ; $64 STZ dp |
.byte ops1 | am_nam ; $65 ADC dp |
.byte ops1 | am_nam ; $66 ROR dp |
.byte ops1 | am_indl ; $67 ADC [dp] |
.byte ops0 | am_nam ; $68 PLA |
.byte vops | am_imm ; $69 ADC # |
.byte ops0 | am_nam ; $6A ROR A |
.byte ops0 | am_nam ; $6B RTL |
.byte ops2 | am_ind ; $6C JMP (abs) |
.byte ops2 | am_nam ; $6D ADC abs |
.byte ops2 | am_nam ; $6E ROR abs |
.byte ops3 | am_nam ; $6F ADC absl |
; |
.byte bop1 | am_nam ; $70 BVS abs |
.byte ops1 | am_indy ; $71 ADC (dp),Y |
.byte ops1 | am_ind ; $72 ADC (dp) |
.byte ops1 | am_stky ; $73 ADC (offset,S),Y |
.byte ops1 | am_adrx ; $74 STZ dp,X |
.byte ops1 | am_adrx ; $75 ADC dp,X |
.byte ops1 | am_adrx ; $76 ROR dp,X |
.byte ops1 | am_indly ; $77 ADC [dp],Y |
.byte ops0 | am_nam ; $78 SEI |
.byte ops2 | am_adry ; $79 ADC abs,Y |
.byte ops0 | am_nam ; $7A PLY |
.byte ops0 | am_nam ; $7B TDC |
.byte ops2 | am_indx ; $7C JMP (abs,X) |
.byte ops2 | am_adrx ; $7D ADC abs,X |
.byte ops2 | am_adrx ; $7E ROR abs,X |
.byte ops3 | am_adrx ; $7F ADC absl,X |
; |
.byte bop1 | am_nam ; $80 BRA abs |
.byte ops1 | am_indx ; $81 STA (dp,X) |
.byte bop2 | am_nam ; $82 BRL abs |
.byte ops1 | am_stk ; $83 STA offset,S |
.byte ops1 | am_nam ; $84 STY dp |
.byte ops1 | am_nam ; $85 STA dp |
.byte ops1 | am_nam ; $86 STX dp |
.byte ops1 | am_indl ; $87 STA [dp] |
.byte ops0 | am_nam ; $88 DEY |
.byte vops | am_imm ; $89 BIT # |
.byte ops0 | am_nam ; $8A TXA |
.byte ops0 | am_nam ; $8B PHB |
.byte ops2 | am_nam ; $8C STY abs |
.byte ops2 | am_nam ; $8D STA abs |
.byte ops2 | am_nam ; $8E STX abs |
.byte ops3 | am_nam ; $8F STA absl |
; |
.byte bop1 | am_nam ; $90 BCC abs |
.byte ops1 | am_indy ; $91 STA (dp),Y |
.byte ops1 | am_ind ; $92 STA (dp) |
.byte ops1 | am_stky ; $93 STA (offset,S),Y |
.byte ops1 | am_adrx ; $94 STY dp,X |
.byte ops1 | am_adrx ; $95 STA dp,X |
.byte ops1 | am_adry ; $96 STX dp,Y |
.byte ops1 | am_indly ; $97 STA [dp],Y |
.byte ops0 | am_nam ; $98 TYA |
.byte ops2 | am_adry ; $99 STA abs,Y |
.byte ops0 | am_nam ; $9A TXS |
.byte ops0 | am_nam ; $9B TXY |
.byte ops2 | am_nam ; $9C STZ abs |
.byte ops2 | am_adrx ; $9D STA abs,X |
.byte ops2 | am_adrx ; $9E STZ abs,X |
.byte ops3 | am_adrx ; $9F STA absl,X |
; |
.byte vops | am_imm ; $A0 LDY # |
.byte ops1 | am_indx ; $A1 LDA (dp,X) |
.byte vops | am_imm ; $A2 LDX # |
.byte ops1 | am_stk ; $A3 LDA offset,S |
.byte ops1 | am_nam ; $A4 LDY dp |
.byte ops1 | am_nam ; $A5 LDA dp |
.byte ops1 | am_nam ; $A6 LDX dp |
.byte ops1 | am_indl ; $A7 LDA [dp] |
.byte ops0 | am_nam ; $A8 TAY |
.byte vops | am_imm ; $A9 LDA # |
.byte ops0 | am_nam ; $AA TAX |
.byte ops0 | am_nam ; $AB PLB |
.byte ops2 | am_nam ; $AC LDY abs |
.byte ops2 | am_nam ; $AD LDA abs |
.byte ops2 | am_nam ; $AE LDX abs |
.byte ops3 | am_nam ; $AF LDA absl |
; |
.byte bop1 | am_nam ; $B0 BCS abs |
.byte ops1 | am_indy ; $B1 LDA (dp),Y |
.byte ops1 | am_ind ; $B2 LDA (dp) |
.byte ops1 | am_stky ; $B3 LDA (offset,S),Y |
.byte ops1 | am_adrx ; $B4 LDY dp,X |
.byte ops1 | am_adrx ; $B5 LDA dp,X |
.byte ops1 | am_adry ; $B6 LDX dp,Y |
.byte ops1 | am_indly ; $B7 LDA [dp],Y |
.byte ops0 | am_nam ; $B8 CLV |
.byte ops2 | am_adry ; $B9 LDA abs,Y |
.byte ops0 | am_nam ; $BA TSX |
.byte ops0 | am_nam ; $BB TYX |
.byte ops2 | am_adrx ; $BC LDY abs,X |
.byte ops2 | am_adrx ; $BD LDA abs,X |
.byte ops2 | am_adry ; $BE LDX abs,Y |
.byte ops3 | am_adrx ; $BF LDA absl,X |
; |
.byte vops | am_imm ; $C0 CPY # |
.byte ops1 | am_indx ; $C1 CMP (dp,X) |
.byte ops1 | am_imm ; $C2 REP # |
.byte ops1 | am_stk ; $C3 CMP offset,S |
.byte ops1 | am_nam ; $C4 CPY dp |
.byte ops1 | am_nam ; $C5 CMP dp |
.byte ops1 | am_nam ; $C6 DEC dp |
.byte ops1 | am_indl ; $C7 CMP [dp] |
.byte ops0 | am_nam ; $C8 INY |
.byte vops | am_imm ; $C9 CMP # |
.byte ops0 | am_nam ; $CA DEX |
.byte ops0 | am_nam ; $CB WAI |
.byte ops2 | am_nam ; $CC CPY abs |
.byte ops2 | am_nam ; $CD CMP abs |
.byte ops2 | am_nam ; $CE DEC abs |
.byte ops3 | am_nam ; $CF CMP absl |
; |
.byte bop1 | am_nam ; $D0 BNE abs |
.byte ops1 | am_indy ; $D1 CMP (dp),Y |
.byte ops1 | am_ind ; $D2 CMP (dp) |
.byte ops1 | am_stky ; $D3 CMP (offset,S),Y |
.byte ops1 | am_nam ; $D4 PEI dp |
.byte ops1 | am_adrx ; $D5 CMP dp,X |
.byte ops1 | am_adrx ; $D6 DEC dp,X |
.byte ops1 | am_indly ; $D7 CMP [dp],Y |
.byte ops0 | am_nam ; $D8 CLD |
.byte ops2 | am_adry ; $D9 CMP abs,Y |
.byte ops0 | am_nam ; $DA PHX |
.byte ops0 | am_nam ; $DB STP |
.byte ops2 | am_indl ; $DC JMP [abs] |
.byte ops2 | am_adrx ; $DD CMP abs,X |
.byte ops2 | am_adrx ; $DE DEC abs,X |
.byte ops3 | am_adrx ; $DF CMP absl,X |
; |
.byte vops | am_imm ; $E0 CPX # |
.byte ops1 | am_indx ; $E1 SBC (dp,X) |
.byte ops1 | am_imm ; $E2 SEP # |
.byte ops1 | am_stk ; $E3 SBC offset,S |
.byte ops1 | am_nam ; $E4 CPX dp |
.byte ops1 | am_nam ; $E5 SBC dp |
.byte ops1 | am_nam ; $E6 INC dp |
.byte ops1 | am_indl ; $E7 SBC [dp] |
.byte ops0 | am_nam ; $E8 INX |
.byte vops | am_imm ; $E9 SBC # |
.byte ops0 | am_nam ; $EA NOP |
.byte ops0 | am_nam ; $EB XBA |
.byte ops2 | am_nam ; $EC CPX abs |
.byte ops2 | am_nam ; $ED SBC abs |
.byte ops2 | am_nam ; $EE INC abs |
.byte ops3 | am_nam ; $EF SBC absl |
; |
.byte bop1 | am_nam ; $F0 BEQ abs |
.byte ops1 | am_indy ; $F1 SBC (dp),Y |
.byte ops1 | am_ind ; $F2 SBC (dp) |
.byte ops1 | am_stky ; $F3 SBC (offset,S),Y |
.byte ops2 | am_imm ; $F4 PEA # |
.byte ops1 | am_adrx ; $F5 SBC dp,X |
.byte ops1 | am_adrx ; $F6 INC dp,X |
.byte ops1 | am_indly ; $F7 SBC [dp],Y |
.byte ops0 | am_nam ; $F8 SED |
.byte ops2 | am_adry ; $F9 SBC abs,Y |
.byte ops0 | am_nam ; $FA PLX |
.byte ops0 | am_nam ; $FB XCE |
.byte ops2 | am_indx ; $FC JSR (abs,X) |
.byte ops2 | am_adrx ; $FD SBC abs,X |
.byte ops2 | am_adrx ; $FE INC abs,X |
.byte ops3 | am_adrx ; $FF SBC absl,X |
; |
; |
; .X & .Y immediate mode opcodes... |
; |
vopidx .byte $a0 ;LDY # |
.byte $a2 ;LDX # |
.byte $c0 ;CPY # |
.byte $e0 ;CPX # |
n_vopidx =*-vopidx ;number of opcodes |
; |
; |
; addressing mode symbology lookup... |
; |
ms_lutab .word ms_nam ;(0000) no symbol |
.word ms_imm ;(0001) # |
.word ms_addrx ;(0010) dp,X or abs,X |
.word ms_addry ;(0011) dp,Y or abs,Y |
.word ms_ind ;(0100) (dp) or (abs) |
.word ms_indl ;(0101) [dp] or [abs] |
.word ms_indly ;(0110) [dp],Y |
.word ms_indx ;(0111) (dp,X) or (abs,X) |
.word ms_indy ;(1000) (dp),Y |
.word ms_stk ;(1001) offset,S |
.word ms_stky ;(1010) (offset,S),Y |
.word ms_nam ;(1011) sbnk,dbnk |
; |
; |
; addressing mode symbology strings... |
; |
ms_nam .byte " ",0 ;no symbol |
ms_addrx .byte " ,X",0 ;dp,X or addr,X |
ms_addry .byte " ,Y",0 ;dp,Y or addr,Y |
ms_imm .byte "#",0 ;immediate |
ms_ind .byte "()",0 ;(dp) or (abs) |
ms_indl .byte "[]",0 ;[dp] or [abs] |
ms_indly .byte "[],Y",0 ;[dp],Y |
ms_indx .byte "(,X)",0 ;(dp,X) or (abs,X) |
ms_indy .byte "(),Y",0 ;(dp),Y |
ms_move .byte ",$",0 ;MVN/MVP sbnk,dbnk |
ms_stk .byte " ,S",0 ;offset,S |
ms_stky .byte "(,S),Y",0 ;(offset,S),Y |
; |
;================================================================================ |
; |
;CONSOLE DISPLAY CONTROL STRINGS |
; |
dc_bf bf ;enable reverse foreground |
.byte 0 |
; |
dc_bs bs ;destructive backspace |
.byte 0 |
; |
dc_cl cl ;clear to end of line |
.byte 0 |
; |
dc_cn cn ;cursor on |
.byte 0 |
; |
dc_co co ;cursor off |
.byte 0 |
; |
dc_er er ;enable normal foreground |
.byte 0 |
; |
dc_lf lf ;newline |
.byte 0 |
; |
;================================================================================ |
; |
;TEXT STRINGS |
; |
mm_brk rb |
lf |
.byte "**BRK" |
lf |
.byte 0 |
; |
mm_entry lf |
.byte a_lf,"Supermon 816 " |
softvers |
.byte " " |
lf |
.byte 0 |
; |
mm_err .byte " **ERR ",0 |
; |
mm_prmpt lf |
sf |
.byte ".",0 |
; |
mm_regs lf |
.byte " PB PC NVmxDIZC .C .X .Y SP DP DB" |
lf |
.byte "; ",0 |
; |
mm_rts rb |
lf |
.byte "**RTS" |
lf |
.byte 0 |
; |
;================================================================================ |
; |
;VECTOR STORAGE |
; |
vecbrkia .word 0 ;system indirect BRK vector |
; |
_txtend_ =* ;end of program text |
; |
;================================================================================ |
.end |
/rtf65002/trunk/software/asm/memory.asm
0,0 → 1,780
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2013, 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; ============================================================================ |
; |
MAX_VIRTUAL_PAGE EQU 320 |
MAX_PHYSICAL_PAGE EQU 2048 |
INV_PAGE EQU 000 ; page number to use for invalid entries |
|
;------------------------------------------------------------------------------ |
; InitMMU |
; |
; Initialize the 64 maps of the MMU. |
; Initially all the maps are set the same: |
; Virtual Page Physical Page |
; 000-319 000 (invalid page marker) |
; 320-511 1856-2047 |
; Note that there are only 512 virtual pages per map, and 2048 real |
; physical pages of memory. This limits maps to 32MB. |
; This range includes the BIOS assigned stacks for the tasks and tasks |
; virtual video buffers. |
; Note that physical pages 0 to 1855 are not mapped, but do exist. They may |
; be mapped into a task's address space as required. |
; If changing the maps the last 192 pages (12MB) of the map should always point |
; to the BIOS area. Don't change map entries 320-511 or the system may |
; crash. The last 192 pages map the virtual memory to the same physical |
; addresses so that the physical and virtual address are the same. |
; If the rts at the end of this routine works, then memory was mapped |
; successfully. |
; |
; System Memory Map (Physical Addresses) |
; Page |
; 0000 BASIC ROM, scratch memory ( 1 page global) |
; 0001-0063 unassigned (4MB - 63 pages) |
; 0064-0191 Bitmap video memory (8 MB - 128 pages) |
; 0192-0336 DOS usage, disk cache etc. (9.4MB - 145 pages) |
; 0337-1855 Heap space (99MB - 1519 pages) |
; 1856-1983 Virtual Screen buffers (8MB - 128 pages) |
; 1984-2047 BIOS/OS area (4MB - 64 pages) |
; 2032-2047 Stacks area (1MB - 16 pages) |
; 65535 BIOS ROM (64kB - 1 Page global) |
; 261952-262015 I/O area (4MB - 64 pages global) |
;------------------------------------------------------------------------------ |
|
align 8 |
public InitMMU: |
lda #1 |
sta MMU_KVMMU+1 |
dea |
sta MMU_KVMMU |
immu1: |
sta MMU_AKEY ; set access key for map |
ldx #0 |
immu2: |
; set the first 320 pages to invalid page marker |
; set the last 192 pages to physical page 1856-2047 |
ld r4,#INV_PAGE |
cpx #320 |
blo immu3 |
ld r4,r2 |
add r4,r4,#1536 ; 1856-320 |
immu3: |
st r4,MMU,x |
inx |
cpx #512 |
bne immu2 |
ina |
cmp #64 ; 64 MMU maps |
bne immu1 |
stz MMU_OKEY ; set operating key to map #0 |
lda #2 |
sta MMU_FUSE ; set fuse to 2 clocks before mapping starts |
nop |
nop |
|
;------------------------------------------------------------------------------ |
; Note that when switching the memory map, the stack address should not change |
; as the virtual address was mapped to the physical one. |
;------------------------------------------------------------------------------ |
; |
align 8 |
public EnableMMUMapping: |
pha |
lda RunningTCB ; no need to enable mapping for Monitor/Debugger job |
lda TCB_hJCB,r1 |
cmp #2 |
blo dmm2 |
lda #12 ; is there even an MMU present ? |
bmt CONFIGREC |
beq emm1 |
lda RunningTCB |
lda TCB_hJCB,r1 |
sta MMU_OKEY ; select the mmu map for the job |
lda #2 |
sta MMU_FUSE ; set fuse to 2 clocks before mapping starts |
lda #1 |
sta MMU_MAPEN ; set MMU_MAPEN = 1 |
emm1: |
pla |
rts |
|
public DisableMMUMapping: |
pha |
dmm2: |
lda #12 ; is there even an MMU present ? |
bmt CONFIGREC |
beq dmm1 |
stz MMU_MAPEN |
dmm1: |
pla |
rts |
|
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
; |
SetAKEYForCurrentJob: |
pha |
jsr GetPtrCurrentJCB |
lda JCB_Map,r1 |
sta MMU_AKEY |
pla |
rts |
|
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
; |
align 8 |
public MemInit: |
lda #1 ; initialize memory semaphore |
sta mem_sema |
lda #1519 |
sta nPagesFree |
|
; Initialize the allocated page map to zero. |
lda #64 ; 64*32 = 2048 bits |
ldx #0 |
ldy #PageMap |
stos |
; Mark the last 192 pages as used (by the OS) |
; 6-32 bit words |
lda #-1 |
sta PageMap+58 |
sta PageMap+59 |
sta PageMap+60 |
sta PageMap+61 |
sta PageMap+62 |
sta PageMap+63 |
; Mark page #0 used |
lda #1 |
sta PageMap |
; Mark 64-336 used (DOS) |
lda #64 |
meminit1: |
bms PageMap |
ina |
cmp #336 |
blo meminit1 |
rts |
|
;------------------------------------------------------------------------------ |
; Allocate a memory page from the available memory pool. |
; Returns a pointer to the page in memory. The address returned is the |
; virtual memory address. |
; |
; Returns: |
; r1 = 0 if no more memory is available or max mapped capacity is reached. |
; r1 = virtual address of allocated memory page |
;------------------------------------------------------------------------------ |
; |
align 8 |
public AllocMemPage: |
phx |
phy |
; Search the page bitmap for a free memory page. |
lda #0 |
ldx #MAX_PHYSICAL_PAGE |
spl mem_sema + 1 |
amp2: |
bmt PageMap |
beq amp1 ; found a free page ? |
ina |
dex |
bne amp2 |
; Here all memory pages are already in use. No more memmory is available. |
stz mem_sema + 1 |
ply |
plx |
lda #0 |
rts |
; Here we found an unallocated memory page. Next find a spot in the MMU |
; map to place the page. |
amp1: |
; Find unallocated map slot in the MMU |
jsr SetAKEYForCurrentJob |
ldx #0 |
amp4: |
ldy MMU,x |
cpy #INV_PAGE |
beq amp3 |
inx |
cpx #MAX_VIRTUAL_PAGE |
bne amp4 |
; Here we searched the entire MMU slots and none were available |
stz mem_sema + 1 |
ply |
plx |
lda #0 ; return NULL pointer |
rts |
; Here we have both an available page, and available map slot. |
amp3: |
bms PageMap ; mark page as allocated |
sta MMU,x ; put the page# into the map slot |
asl r1,r2,#14 ; pages are 16kW in size (compute virtual address) |
dec nPagesFree |
stz mem_sema + 1 |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; Parameters: |
; r1 = size of allocation in words |
; Returns: |
; r1 = word pointer to memory |
; No MMU |
;------------------------------------------------------------------------------ |
; |
align 8 |
public AllocMemPages: |
php |
phx |
phy |
push r4 |
sei |
amp5: |
tay |
lsr r3,r3,#14 ; convert amount to #pages |
iny ; round up |
cpy nPagesFree |
bhi amp11 |
tyx ; x = request size in pages |
; Search for enough free pages to satisfy the request |
lda #0 |
amp7: |
bmt PageMap ; test for a free page |
bne amp6 ; not a free page |
cpx #1 ; did we find enough free pages ? |
bls amp8 |
dex |
amp6: ; keep checking for next free page |
ina |
cmp #1855 ; did we hit end of map ? |
bhi amp11 ; can't allocate enough memory |
bra amp7 ; go back and test for another free page |
|
; Insufficient memory, return NULL pointer |
amp11: |
lda #0 |
pop r4 |
ply |
plx |
plp |
rts |
|
; Mark pages as allocated |
amp8: |
tyx ; x= #pages to allocate |
cpx #1 |
bne amp9 |
txa ; flag indicates last page |
bra amp10 |
amp9: |
lda #0 ; flag indicates middle page |
amp10: |
jsr AllocMemPage ; allocate first page |
ld r4,r1 ; save virtual address of first page allocated |
dex |
beq amp14 |
amp13: |
cpx #1 |
bne amp15 |
txa |
bra amp12 |
amp15: |
lda #0 |
amp12: |
jsr AllocMemPage |
dex |
bne amp13 |
amp14: |
ld r1,r4 ; r1 = first virtual address |
pop r4 |
ply |
plx |
plp |
rts |
|
;------------------------------------------------------------------------------ |
; FreeMemPage: |
; |
; Free a single page of memory. This is an internal function called by |
; FreeMemPages(). Normally FreeMemPages() will be called to free up the |
; entire run of pages. This function both unmarks the memory page in the |
; page bitmap and invalidates the page in the MMU. |
; |
; Parameters: |
; r1 = virtual memory address |
;------------------------------------------------------------------------------ |
; |
align 8 |
FreeMemPage: |
pha |
php |
phx |
sei |
; First mark the page as available in the virtual page map. |
pha |
lsr r1,r1,#14 |
and #$1ff ; 512 virtual pages max |
ldx RunningTCB |
ldx TCB_mmu_map,x ; x = map # |
asl r2,r2,#4 ; 16 words per map |
bmc VPM_bitmap_b0,x ; clear both bits |
bmc VPM_bitmap_b1,x |
pla |
; Mark the page available in the physical page map |
pha |
jsr VirtToPhys ; convert to a physical address |
lsr r1,r1,#14 |
and #$7ff ; 2048 physical pages max |
bmc PageMap |
pla |
; Now mark the MMU slot as empty |
lsr r1,r1,#14 ; / 16kW r1 = page # now |
and #$1ff ; 512 pages max |
jsr SetAKEYForCurrentJob |
tax |
lda #INV_PAGE |
sta MMU,x |
inc nPagesFree |
plx |
plp |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; FreeMemPages: |
; |
; Free up multiple pages of memory. The pages freed are a consecutive |
; run of pages. A double-bit bitmap is used to identify where the run of |
; pages ends. Bit code 00 indicates a unallocated page, 01 indicates an |
; allocated page somewhere in the run, and 11 indicates the end of a run |
; of allocated pages. |
; |
; Parameters: |
; r1 = pointer to memory |
;------------------------------------------------------------------------------ |
; |
align 8 |
public FreeMemPages: |
cmp #0x3fff ; test for a proper pointer |
bls fmp5 |
pha |
; Turn the memory pointer into a bit index |
lsr r1,r1,#14 ; / 16kW acc = virtual page # |
cmp #MAX_VIRTUAL_PAGE ; make sure index is sensible |
bhs fmp4 |
phx |
spl mem_sema + 1 |
ldx RunningTCB |
ldx TCB_mmu_map,x |
asl r2,r2,#4 |
fmp2: |
bmt VPM_bitmap_b1,x ; Test to see if end of allocation |
bne fmp3 |
asl r1,r1,#14 ; acc = virtual address |
jsr FreeMemPage ; |
lsr r1,r1,#14 ; acc = virtual page # again |
ina |
cmp #MAX_VIRTUAL_PAGE ; last 192 pages aren't freeable |
blo fmp2 |
fmp3 |
; Clear the last bit |
asl r1,r1,#14 ; acc = virtual address |
jsr FreeMemPage ; |
lsr r1,r1,#14 ; acc = virtual page # again |
bmc VPM_bitmap_b1,x |
stz mem_sema + 1 |
plx |
fmp4: |
pla |
fmp5: |
rts |
|
;------------------------------------------------------------------------------ |
; Convert a virtual address to a physical address. |
; Parameters: |
; r1 = virtual address to translate |
; Returns: |
; r1 = physical address |
;------------------------------------------------------------------------------ |
; |
align 8 |
public VirtToPhys: |
cmp #$3FFF ; page #0 is physical page #0 |
bls vtp2 |
cmp #$01FFFFFF ; outside of managed address bounds (ROM / IO) |
bhi vtp2 |
phx |
ldx CONFIGREC ; check if there is an MMU present |
bit r2,#4096 ; if not, then virtual and physical addresses |
beq vtp3 ; will match |
phy |
tay ; save original address |
and r3,r3,#$FF803FFF ; mask off MMU managed address bits |
jsr SetAKEYForCurrentJob |
lsr r2,r1,#14 ; convert to MMU index |
and r2,r2,#511 ; 512 mmu pages |
lda MMU,x ; a = physical page# |
beq vtp1 ; zero = invalid address translation |
asl r1,r1,#14 ; *16kW |
or r1,r1,r3 ; put back unmanaged address bits |
vtp1: |
ply |
vtp3: |
plx |
vtp2: |
rts |
|
;------------------------------------------------------------------------------ |
; PhysToVirt |
; |
; Convert a physical address to a virtual address. A little more complex |
; than converting virtual to physical addresses as the MMU map table must |
; be searched for the physical page. |
; |
; Parameters: |
; r1 = physical address to translate |
; Returns: |
; r1 = virtual address |
;------------------------------------------------------------------------------ |
; |
align 8 |
public PhysToVirt: |
cmp #$3FFF ; first check for direct translations |
bls ptv3 ; outside of the MMU managed range |
cmp #$01FFFFFF |
bhi ptv3 |
phx |
ldx CONFIGREC ; check if there is an MMU present |
bit r2,#4096 ; if not, then virtual and physical addresses |
beq ptv4 ; will match |
phy |
jsr SetAKEYForCurrentJob |
tay |
and r3,r3,#$FF803FFF ; mask off MMU managed address bits |
lsr r1,r1,#14 ; /16k to get index |
and r1,r1,#$7ff ; 2048 pages max |
ldx #0 |
ptv2: |
cmp MMU,x |
beq ptv1 |
inx |
cpx #512 |
bne ptv2 |
; Return NULL pointer if address translation fails |
ply |
plx |
lda #0 |
rts |
ptv1: |
asl r1,r2,#14 ; * 16k |
or r1,r1,r3 ; put back unmanaged address bits |
ply |
ptv4: |
plx |
ptv3: |
rts |
|
; ============================================================================ |
; Heap related functions. |
; |
; The heap is managed as a doublely linked list of memory blocks. |
; ============================================================================ |
|
align 8 |
public InitHeap: |
lda RunningTCB |
ldx TCB_HeapStart,r1 |
ldy TCB_HeapEnd,r1 |
lda #$4D454D20 |
sta MEM_CHK,x |
sta MEM_FLAG,x |
lda #$6D656D20 ; mark the last block as allocated |
sta MEM_CHK,y |
sta MEM_FLAG,y |
lda #0 |
sta MEM_PREV,x ; prev of first MEMHDR |
sty MEM_NEXT,x |
sta MEM_NEXT,y |
stx MEM_PREV,y |
rts |
|
;------------------------------------------------------------------------------ |
; Allocate memory from the heap. |
; Each task has it's own memory heap. |
;------------------------------------------------------------------------------ |
align 8 |
public MemAlloc: |
phx |
phy |
push r4 |
ldx RunningTCB |
ldx TCB_HeapStart,x |
mema4: |
ldy MEM_FLAG,x ; Check the flag word to see if this block is available |
cpy #$4D454D20 |
bne mema1 ; block not available, go to next block |
ld r4,MEM_NEXT,x ; compute the size of this block |
sub r4,r4,r2 |
sub r4,r4,#4 ; minus size of block header |
cmp r1,r4 ; is the block large enough ? |
bmi mema2 ; if yes, go allocate |
mema1: |
ldx MEM_NEXT,x ; go to the next block |
beq mema3 ; if no more blocks, out of memory error |
bra mema4 |
mema2: |
ldy #$6D656D20 |
sty MEM_FLAG,x |
sub r4,r4,r1 |
cmp r4,#4 ; is the block large enough to split |
bpl memaSplit |
txa |
add #4 ; point to payload area |
pop r4 |
ply |
plx |
rts |
mema3: ; insufficient memory |
pop r4 |
ply |
plx |
lda #0 |
rts |
memaSplit: |
add r4,r1,r2 |
add r4,#4 |
ldy #$4D454D20 |
sty (r4) |
sty MEM_FLAG,r4 |
stx MEM_PREV,r4 |
ldy MEM_NEXT,x |
sty MEM_NEXT,r4 |
st r4,MEM_PREV,y |
ld r1,r4 |
add #4 |
pop r4 |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; Free previously allocated memory. Recombine with next and previous blocks |
; if they are free as well. |
;------------------------------------------------------------------------------ |
align 8 |
public MemFree: |
cmp #4 ; null pointer ? |
blo memf2 |
phx |
phy |
sub #4 ; backup to header area |
ldx MEM_FLAG,r1 |
cpx #$6D656D20 ; is the block allocated ? |
bne memf1 |
ldx #$4D454D20 |
stx MEM_FLAG,r1 ; mark block as free |
ldx MEM_PREV,r1 ; is the previous block free ? |
beq memf3 ; no previous block |
ldy MEM_FLAG,x |
cpy #$4D454D20 |
bne memf3 ; the previous block is not free |
ldy MEM_NEXT,r1 |
sty MEM_NEXT,x |
beq memf1 ; no next block |
stx MEM_PREV,y |
memf3: |
ldy MEM_NEXT,r1 |
ldx MEM_FLAG,y |
cpx #$4D454D20 |
bne memf1 ; next block not free |
ldx MEM_PREV,r1 |
stx MEM_PREV,y |
beq memf1 ; no previous block |
sty MEM_NEXT,x |
memf1: |
ply |
plx |
memf2: |
rts |
|
;------------------------------------------------------------------------------ |
; Report the amount of system memory free. Counts up the number of |
; unallocated pages in the page bitmap. |
;------------------------------------------------------------------------------ |
; |
public ReportMemFree: |
jsr CRLF |
lda #' ' |
jsr DisplayChar |
lda #0 |
tay |
rmf2: |
bmt PageMap |
bne rmf1 |
iny |
rmf1: |
ina |
cmp #2048 |
blo rmf2 |
tya |
asl r1,r1,#14 ; 16kW per bit |
ldx #5 |
jsr PRTNUM |
lea r1,msgMemFree |
jsr DisplayStringB |
rts |
|
msgMemFree: |
db " words free",CR,LF,0 |
|
;============================================================================== |
; Memory Management routines follow. |
;============================================================================== |
|
;------------------------------------------------------------------------------ |
; brk |
; Establish a new program break |
; |
; Parameters: |
; r1 = new program break address |
;------------------------------------------------------------------------------ |
; |
public _brk: |
phx |
push r4 |
push r5 |
push r6 |
ldx RunningTCB |
ld r4,TCB_ASID,x |
st r4,MMU_AKEY |
ld r4,TCB_npages,x |
lsr r1,r1,#14 |
add r1,r1,#1 |
cmp r1,r4 |
beq brk6 ; allocation isn't changing |
blo brk1 ; reducing allocation |
|
; Here we're increasing the amount of memory allocated to the program. |
; |
cmp r1,#320 ; max 320 RAM pages |
bhi brk2 |
sub r1,r1,r4 ; number of new pages |
cmp r1,mem_pages_free ; are there enough free pages ? |
bhi brk2 |
ld r5,mem_pages_free |
sub r5,r5,r1 |
st r5,mem_pages_free |
ld r6,r1 ; r6 = number of pages to allocate |
add r1,r1,r4 ; get back value of address |
sta TCB_npages,x |
lda #0 |
brk5: |
bmt PageMap ; test if page is free |
bne brk4 ; no, go for next page |
bms PageMap ; allocate the page |
sta MMU,r4 ; store the page number in the MMU table |
add r4,#1 ; move to next MMU entry |
sub r6,#1 ; decrement count of needed |
beq brk6 ; we're done if count = 0 |
brk4: |
ina |
cmp #2048 |
blo brk5 |
|
; Here there was an OS or hardware error |
; According to mem_pages_free there should have been enough free pages |
; to fulfill the request. Something is corrupt. |
; |
|
; Here we are reducing the program break, which means freeing up pages of |
; memory. |
brk1: |
sta TCB_npages,x |
add r5,r1,#1 ; move to page after last page |
brk7: |
cmp r5,r4 ; are we done freeing pages ? |
bhi brk6 |
lda MMU,r5 ; get the page to free |
bmc PageMap ; free the page |
inc mem_pages_free |
add r5,#1 |
bra brk7 |
|
; Successful return |
brk6: |
pop r6 |
pop r5 |
pop r4 |
plx |
lda #0 |
rts |
|
; Return insufficient memory error |
; |
brk2: |
lda #E_NoMem |
sta TCB_errno,x |
pop r6 |
pop r5 |
pop r4 |
plx |
lda #-1 |
rts |
|
;------------------------------------------------------------------------------ |
; Parameters: |
; r1 = change in memory allocation |
;------------------------------------------------------------------------------ |
public _sbrk: |
phx |
push r4 |
push r5 |
ldx RunningTCB |
ld r4,TCB_npages,x ; get the current memory allocation |
cmp r1,#0 ; zero difference = get old brk address |
beq sbrk2 |
asl r5,r4,#14 ; convert to words |
add r1,r1,r5 ; +/- amount |
jsr _brk |
cmp r1,#-1 |
bne sbrk2 |
|
; Failure return, return -1 |
; |
pop r5 |
pop r4 |
plx |
rts |
|
; Successful return, return the old break address |
; |
sbrk2: |
ld r1,r4 |
asl r1,r1,#14 |
pop r5 |
pop r4 |
plx |
rts |
|
/rtf65002/trunk/software/asm/null.asm
0,0 → 1,57
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2013, 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; keyboard.asm |
; ============================================================================ |
; |
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
; |
public NullDCB: |
align 4 |
db "NULL " ; name |
dw 4 ; number of chars in name |
dw 0 ; type |
dw 1 ; nBPB |
dw 0 ; last erc |
dw 0 ; nBlocks |
dw NullCmdProc |
dw NullInit |
dw NullStat |
dw 255 ; reentrancy count (1 to 255 are valid) |
dw 0 ; single user |
dw 0 ; hJob |
dw 0 ; OSD1 |
dw 0 ; OSD2 |
dw 0 ; OSD3 |
dw 0 ; OSD4 |
dw 0 ; OSD5 |
dw 0 ; OSD6 |
|
NullCmdProc: |
rts |
|
NullInit: |
rts |
|
NullStat: |
rts |
/rtf65002/trunk/software/asm/RandomLines.asm
0,0 → 1,249
;-------------------------------------------------------------------------- |
; Draw random lines on the bitmap screen. |
;-------------------------------------------------------------------------- |
; |
message "RandomLines" |
align 8 |
public RandomLines: |
pha |
phx |
phy |
push r4 |
push r5 |
jsr RequestIOFocus |
jsr ClearScreen |
jsr HomeCursor |
lda #msgRandomLines |
jsr DisplayStringB |
lda #1 |
sta gr_cmd |
rl5: |
tsr LFSR,r1 |
tsr LFSR,r2 |
tsr LFSR,r3 |
mod r1,r1,#680 |
mod r2,r2,#384 |
jsr DrawPixel |
tsr LFSR,r1 |
sta LineColor ; select a random color |
rl1: ; random X0 |
tsr LFSR,r1 |
mod r1,r1,#680 |
rl2: ; random X1 |
tsr LFSR,r3 |
mod r3,r3,#680 |
rl3: ; random Y0 |
tsr LFSR,r2 |
mod r2,r2,#384 |
rl4: ; random Y1 |
tsr LFSR,r4 |
mod r4,r4,#384 |
rl8: |
ld r5,GA_STATE ; make sure state is IDLE |
bne rl8 |
ld r5,gr_cmd |
cmp r5,#2 |
bne rl11 |
jsr DrawLine |
bra rl12 |
rl11: |
cmp r5,#1 |
bne rl13 |
jsr DrawPixel |
bra rl12 |
rl13: |
cmp r5,#4 |
bne rl12 |
jsr DrawRectangle |
rl12: |
jsr KeybdGetChar |
cmp #CTRLC |
beq rl7 |
cmp #'p' |
bne rl9 |
jsr ClearBmpScreen |
lda #1 |
sta gr_cmd |
bra rl5 |
rl9: |
cmp #'r' |
bne rl10 |
jsr ClearBmpScreen |
lda #4 |
sta gr_cmd |
bra rl5 |
rl10 |
cmp #'l' |
bne rl5 |
jsr ClearBmpScreen |
lda #2 |
sta gr_cmd |
bra rl5 |
rl7: |
; jsr ReleaseIOFocus |
pop r5 |
pop r4 |
ply |
plx |
pla |
rts |
|
|
msgRandomLines: |
db CR,LF,"Random lines running - press CTRL-C to exit.",CR,LF,0 |
|
;-------------------------------------------------------------------------- |
; Draw a pixel on the bitmap screen. |
; r1 = x coordinate |
; r2 = y coordinate |
; r3 = color |
;-------------------------------------------------------------------------- |
message "DrawPixel" |
DrawPixel: |
pha |
sta GA_X0 |
stx GA_Y0 |
sty GA_PEN |
lda #1 |
sta GA_CMD |
pla |
rts |
comment ~ |
pha |
phx |
mul r2,r2,#680 ; y * 680 |
add r1,r1,r2 ; + x |
sb r3,BITMAPSCR<<2,r1 |
plx |
pla |
rts |
~ |
;-------------------------------------------------------------------------- |
; Draw a line on the bitmap screen. |
;-------------------------------------------------------------------------- |
;50 REM DRAWLINE |
;100 dx = ABS(xb-xa) |
;110 dy = ABS(yb-ya) |
;120 sx = SGN(xb-xa) |
;130 sy = SGN(yb-ya) |
;140 er = dx-dy |
;150 PLOT xa,ya |
;160 if xa<>xb goto 200 |
;170 if ya=yb goto 300 |
;200 ee = er * 2 |
;210 if ee <= -dy goto 240 |
;220 er = er - dy |
;230 xa = xa + sx |
;240 if ee >= dx goto 270 |
;250 er = er + dx |
;260 ya = ya + sy |
;270 GOTO 150 |
;300 RETURN |
|
message "DrawLine" |
DrawLine: |
pha |
sta GA_X0 |
stx GA_Y0 |
sty GA_X1 |
st r4,GA_Y1 |
lda LineColor |
sta GA_PEN |
lda #2 |
sta GA_CMD |
pla |
rts |
|
DrawRectangle: |
pha |
sta GA_X0 |
stx GA_Y0 |
sty GA_X1 |
st r4,GA_Y1 |
lda LineColor |
sta GA_PEN |
lda #4 |
sta GA_CMD |
pla |
rts |
|
comment ~ |
pha |
phx |
phy |
push r4 |
push r5 |
push r6 |
push r7 |
push r8 |
push r9 |
push r10 |
push r11 |
|
sub r5,r3,r1 ; dx = abs(x2-x1) |
bpl dln1 |
sub r5,r0,r5 |
dln1: |
sub r6,r4,r2 ; dy = abs(y2-y1) |
bpl dln2 |
sub r6,r0,r6 |
dln2: |
|
sub r7,r3,r1 ; sx = sgn(x2-x1) |
beq dln5 |
bpl dln4 |
ld r7,#-1 |
bra dln5 |
dln4: |
ld r7,#1 |
dln5: |
|
sub r8,r4,r2 ; sy = sgn(y2-y1) |
beq dln8 |
bpl dln7 |
ld r8,#-1 |
bra dln8 |
dln7: |
ld r8,#1 |
|
dln8: |
sub r9,r5,r6 ; er = dx-dy |
dln150: |
phy |
ldy LineColor |
jsr DrawPixel |
ply |
cmp r1,r3 ; if (xa <> xb) |
bne dln200 ; goto 200 |
cmp r2,r4 ; if (ya==yb) |
beq dln300 ; goto 300 |
dln200: |
asl r10,r9 ; ee = er * 2 |
sub r11,r0,r6 ; r11 = -dy |
cmp r10,r11 ; if (ee <= -dy) |
bmi dln240 ; goto 240 |
beq dln240 |
sub r9,r9,r6 ; er = er - dy |
add r1,r1,r7 ; xa = xa + sx |
dln240: |
cmp r10,r5 ; if (ee >= dx) |
bpl dln150 ; goto 150 |
add r9,r9,r5 ; er = er + dx |
add r2,r2,r8 ; ya = ya + sy |
bra dln150 ; goto 150 |
|
dln300: |
pop r11 |
pop r10 |
pop r9 |
pop r8 |
pop r7 |
pop r6 |
pop r5 |
pop r4 |
ply |
plx |
pla |
rts |
~ |
|
/rtf65002/trunk/software/asm/DeviceDriver.asm
0,0 → 1,201
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; ============================================================================ |
; |
;------------------------------------------------------------------ |
; Initialize/install a device driver. |
; |
; Parameters: |
; r1 = device number |
; r2 = pointer to (static) DCB array |
; r3 = # of devices in array |
;------------------------------------------------------------------ |
; |
cpu RTF65002 |
InitDevDrv: |
push r5 |
push r6 |
push r7 |
cmp #NR_DCB ; check for a good device number |
bhs .idd1 |
mul r5,r1,#DCB_SIZE |
add r5,r5,#DCBs |
ld r0,DCB_pDevOp,r5 ; check a pointer to see if device is setup |
beq .idd2 |
cmp r4,#1 |
beq .idd2 |
lda #E_DCBInUse |
pop r7 |
pop r6 |
pop r5 |
rts |
.idd2: |
.idd4: |
; Copy the DCB parameter to DCB array |
pha |
phy |
lda #DCB_SIZE-1 |
ld r3,r5 |
mvn |
ply |
pla |
; Initialize device semaphores |
pha |
asl r1,r1,#4 ; * 16 words per semaphore |
add r1,r1,#device_semas |
sta DCB_Sema,r5 |
ld r7,DCB_ReentCount,x ; prime the semaphore |
st r7,(r1) |
pla |
add r5,r5,#DCB_SIZE |
add r2,r2,#DCB_SIZE |
dey |
bne .idd4 |
pop r7 |
pop r6 |
pop r5 |
lda #E_Ok |
rts |
.idd1: |
pop r7 |
pop r6 |
pop r5 |
lda #E_BadDevNum |
rts |
|
;------------------------------------------------------------------ |
; Parameters: |
; r1 = device number |
;------------------------------------------------------------------ |
; |
public DeviceInit: |
cmp #NR_DCB |
bhs .dvi1 |
phx |
push r6 |
mul r2,r1,#DCB_SIZE |
add r2,r2,#DCBs |
ld r2,DCB_pDevInit,x ; check a pointer to see if device is setup |
beq .dvi2 |
|
asl r6,r1,#4 |
spl device_semas+1,r6 ; Wait for semaphore |
jsr (x) |
stz device_semas+1,r6 ; unlock device semaphore |
pop r6 |
plx |
; lda # result from jsr() above |
rts |
.dvi2: |
pop r6 |
plx |
.dvi1: |
lda #E_BadDevNum |
rts |
|
;------------------------------------------------------------------ |
; Parameters: |
; r1 = device number |
; r2 = operation code |
; r3 = block address |
; r4 = number of blocks |
; r5 = pointer to data |
;------------------------------------------------------------------ |
; |
public DeviceOp: |
cmp #NR_DCB |
bhs dvo1 |
push r6 |
push r7 |
mul r6,r1,#DCB_SIZE |
add r6,r6,#DCBs |
ld r6,DCB_pDevOp,r6 ; check a pointer to see if device is setup |
beq dvo2 |
|
asl r7,r1,#4 |
spl device_semas+1,r7 ; Wait for semaphore |
jsr (r6) |
stz device_semas+1,r7 ; unlock device semaphore |
pop r7 |
pop r6 |
rts |
dvo2: |
pop r7 |
pop r6 |
dvo1: |
lda #E_BadDevNum |
rts |
|
;------------------------------------------------------------------ |
; Parameters: |
; r1 = device number |
; r2 = pointer to status return buffer |
; r3 = size of buffer |
; r4 = pointer to status word returned |
;------------------------------------------------------------------ |
; |
public DeviceStat: |
cmp #NR_DCB |
bhs dvs1 |
push r6 |
push r7 |
mul r6,r1,#DCB_SIZE |
add r6,r6,#DCBs |
ld r6,DCB_pDevStat,r6 ; check a pointer to see if device is setup |
beq dvs2 |
|
asl r7,r1,#4 |
spl device_semas+1,r7 ; Wait for semaphore |
jsr (r6) ; Call the stat function |
stz device_semas+1,r7 ; unlock device semaphore |
pop r7 |
pop r6 |
rts |
dvs2: |
pop r7 |
pop r6 |
dvs1: |
lda #E_BadDevNum |
rts |
|
;------------------------------------------------------------------ |
; Load up the system's built in device drivers. |
;------------------------------------------------------------------ |
|
public InitDevices: |
lda #0 |
ldx #NullDCB>>2 |
ldy #1 |
jsr InitDevDrv |
lda #1 |
ldx #KeybdDCB>>2 |
ldy #1 |
jsr InitDevDrv |
lda #16 |
ldx #SDCardDCB>>2 |
ldy #1 |
jsr InitDevDrv |
rts |
|
|
|
/rtf65002/trunk/software/asm/ethernet.asm
0,0 → 1,645
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; ============================================================================ |
; |
;============================================================================== |
; Ethernet test code |
;============================================================================== |
my_MAC1 EQU 0x00 |
my_MAC2 EQU 0xFF |
my_MAC3 EQU 0xEE |
my_MAC4 EQU 0xF0 |
my_MAC5 EQU 0xDA |
my_MAC6 EQU 0x42 |
|
; r1 = PHY |
; r2 = regnum |
; r3 = data |
; |
eth_mii_write: |
pha |
phx |
push r4 |
ld r4,#ETHMAC |
asl r2,r2,#8 |
or r1,r1,r2 |
sta ETH_MIIADDRESS,r4 |
sty ETH_MIITX_DATA,r4 |
lda #ETH_WCTRLDATA |
sta ETH_MIICOMMAND,r4 |
stz ETH_MIICOMMAND,r4 |
emiw1: |
lda ETH_MIISTATUS,r4 |
bit #ETH_MIISTATUS_BUSY |
bne emiw1 |
pop r4 |
plx |
pla |
rts |
|
; r1 = PHY |
; r2 = reg |
|
eth_mii_read: |
phx |
phy |
ldy #ETHMAC |
asl r2,r2,#8 |
or r1,r1,r2 |
sta ETH_MIIADDRESS,y |
lda #ETH_MIICOMMAND_RSTAT |
sta ETH_MIICOMMAND,y |
stz ETH_MIICOMMAND,y |
emir1: |
lda ETH_MIISTATUS,y |
bit #ETH_MIISTATUS_BUSY |
bne emir1 |
lda ETH_MIIRX_DATA,y |
ply |
plx |
rts |
|
public ethmac_setup: |
ld r4,#ETHMAC |
lda #ETH_MIIMODER_RST |
sta ETH_MIIMODER,r4 |
lda ETH_MIIMODER,r4 |
and #~ETH_MIIMODER_RST |
sta ETH_MIIMODER,r4 |
lda #$10 ; /16=1.25MHz |
sta ETH_MIIMODER,r4 ; Clock divider for MII Management interface |
lda #ETH_MODER_RST |
sta ETH_MODER,r4 |
lda ETH_MODER,r4 |
and #~ETH_MODER_RST |
sta ETH_MODER,r4 |
|
stz ETH_MIITX_DATA,r4 |
stz ETH_MIIADDRESS,r4 |
stz ETH_MIICOMMAND,r4 |
|
lda #0xEEF0DA42 |
sta ETH_MAC_ADDR0,r4 ; MAC0 |
lda #0x00FF |
sta ETH_MAC_ADDR1,r4 ; MAC1 |
|
lda #-1 |
sta ETH_INT_SOURCE,r4 |
|
; Advertise support for 10/100 FD/HD |
lda #ETH_PHY |
ldx #ETH_MII_ADVERTISE |
jsr eth_mii_read |
or r3,r1,#ETH_ADVERTISE_ALL |
lda #ETH_PHY |
ldx #ETH_MII_ADVERTISE |
jsr eth_mii_write |
|
; Do NOT advertise support for 1000BT |
lda #ETH_PHY |
ldx #ETH_MII_CTRL1000 |
jsr eth_mii_read |
and r3,r1,#~(ETH_ADVERTISE_1000FULL|ETH_ADVERTISE_1000HALF) |
lda #ETH_PHY |
ldx #ETH_MII_CTRL1000 |
jsr eth_mii_write |
|
; Disable 1000BT |
lda #ETH_PHY |
ldx #ETH_MII_EXPANSION |
jsr eth_mii_read |
and r3,r1,#~(ETH_ESTATUS_1000_THALF|ETH_ESTATUS_1000_TFULL) |
ldx #ETH_MII_EXPANSION |
jsr eth_mii_write |
|
; Restart autonegotiation |
lda #0 |
ldx #ETH_MII_BMCR |
jsr eth_mii_read |
and r3,r1,#~(ETH_BMCR_ANRESTART|ETH_BMCR_ANENABLE) |
lda #7 |
jsr eth_mii_write |
|
; Enable BOTH the transmiter and receiver |
lda #$A003 |
sta ETH_MODER,r4 |
rts |
|
; Initialize the ethmac controller. |
; Supply a MAC address, set MD clock |
; |
message "eth_init" |
public eth_init: |
pha |
phy |
ldy #ETHMAC |
lda #$A003 |
sta ETH_MODER,y |
; lda #0x64 ; 100 |
; sta ETH_MIIMODER,y |
; lda #7 ; PHY address |
; sta ETH_MIIADDRESS,y |
lda #0xEEF0DA42 |
sta ETH_MAC_ADDR0,y ; MAC0 |
lda #0x00FF |
sta ETH_MAC_ADDR1,y ; MAC1 |
ply |
pla |
rts |
|
; Request a packet and display on screen |
; r1 = address where to put packet |
; |
message "eth_request_packet" |
public eth_request_packet: |
phx |
phy |
push r4 |
push r5 |
ldy #ETHMAC |
ldx #4 ; clear rx interrupt |
stx ETH_INT_SOURCE,y |
sta 0x181,y ; storage address |
ldx #0xe000 ; enable interrupt |
stx 0x180,y |
eth1: |
nop |
ldx ETH_INT_SOURCE,y |
bit r2,#4 ; get bit #2 |
beq eth1 |
ldx 0x180,y ; get from descriptor |
lsr r2,r2,#16 |
ldy #0 |
pha |
jsr GetScreenLocation |
add r4,r1,3780 ; second last line of screen |
pla |
eth20: |
add r5,r1,r3 |
lb r2,0,r5 ; get byte |
add r5,r4,r3 |
stx (r5) ; store to screen |
iny |
cpy #83 |
bne eth20 |
pop r5 |
pop r4 |
ply |
plx |
rts |
|
; r1 = packet address |
; |
message "eth_interpret_packet" |
public eth_interpret_packet: |
phx |
phy |
lb r2,12,r1 |
lb r3,13,r1 |
cpx #8 ; 0x806 ? |
bne eth2 |
cpy #6 |
bne eth2 |
lda #2 ; return r1 = 2 for ARP |
eth5: |
ply |
plx |
rts |
eth2: |
cpx #8 |
bne eth3 ; 0x800 ? |
cpy #0 |
bne eth3 |
lb r2,23,r1 |
cpx #1 |
bne eth4 |
lda #1 |
bra eth5 ; return 1 ICMP |
eth4: |
cpx #$11 |
bne eth6 |
lda #3 ; return 3 for UDP |
bra eth5 |
eth6: |
cpx #6 |
bne eth7 |
lda #4 ; return 4 for TCP |
bra eth5 |
eth7: |
eth3: |
eor r1,r1,r1 ; return zero for unknown |
ply |
plx |
rts |
|
; r1 = address of packet to send |
; r2 = packet length |
; |
message "eth_send_packet" |
public eth_send_packet: |
phx |
phy |
push r4 |
ldy #ETHMAC |
; wait for tx buffer to be clear |
eth8: |
ld r4,0x100,y |
bit r4,#$8000 |
bne eth8 |
ld r4,#1 ; clear tx interrupt |
st r4,ETH_INT_SOURCE,y |
; set address |
sta 0x101,y |
; set the packet length field and enable interrupts |
asl r2,r2,#16 |
or r2,r2,#0xF000 |
stx 0x100,y |
pop r4 |
ply |
plx |
rts |
|
; Only for IP type packets (not ARP) |
; r1 = rx buffer address |
; r2 = swap flag |
; Returns: |
; r1 = data start index |
; |
message "eth_build_packet" |
public eth_build_packet: |
phy |
push r4 |
push r5 |
push r6 |
push r7 |
push r8 |
push r9 |
push r10 |
|
lb r3,6,r1 |
lb r4,7,r1 |
lb r5,8,r1 |
lb r6,9,r1 |
lb r7,10,r1 |
lb r8,11,r1 |
; write to destination header |
sb r3,0,r1 |
sb r4,1,r1 |
sb r5,2,r1 |
sb r6,3,r1 |
sb r7,4,r1 |
sb r8,5,r1 |
; write to source header |
ld r3,#my_MAC1 |
sb r3,6,r1 |
ld r3,#my_MAC2 |
sb r3,7,r1 |
ld r3,#my_MAC3 |
sb r3,8,r1 |
ld r3,#my_MAC4 |
sb r3,9,r1 |
ld r3,#my_MAC5 |
sb r3,10,r1 |
ld r3,#my_MAC6 |
sb r3,11,r1 |
cmp r2,#1 |
bne eth16 ; if (swap) |
lb r3,26,r1 |
lb r4,27,r1 |
lb r5,28,r1 |
lb r6,29,r1 |
; read destination |
lb r7,30,r1 |
lb r8,31,r1 |
lb r9,32,r1 |
lb r10,33,r1 |
; write to sender |
sb r7,26,r1 |
sb r8,27,r1 |
sb r9,28,r1 |
sb r10,29,r1 |
; write destination |
sb r3,30,r1 |
sb r4,31,r1 |
sb r5,32,r1 |
sb r6,33,r1 |
eth16: |
ldy eth_unique_id |
iny |
sty eth_unique_id |
sb r3,19,r1 |
lsr r3,r3,#8 |
sb r3,18,r1 |
lb r3,14,r1 |
and r3,r3,#0xF |
asl r3,r3,#2 ; *4 |
add r1,r3,#14 ; return datastart in r1 |
pop r10 |
pop r9 |
pop r8 |
pop r7 |
pop r6 |
pop r5 |
pop r4 |
ply |
rts |
|
; Compute IPv4 checksum of header |
; r1 = packet address |
; r2 = data start |
; |
message "eth_checksum" |
public eth_checksum: |
phy |
push r4 |
push r5 |
push r6 |
; set checksum to zero |
stz 24,r1 |
stz 25,r1 |
eor r3,r3,r3 ; r3 = sum = zero |
ld r4,#14 |
eth15: |
ld r5,r2 |
dec r5 ; r5 = datastart - 1 |
cmp r4,r5 |
bpl eth14 |
add r6,r1,r4 |
lb r5,0,r6 ; shi = [rx_addr+i] |
lb r6,1,r6 ; slo = [rx_addr+i+1] |
asl r5,r5,#8 |
or r5,r5,r6 ; shilo |
add r3,r3,r5 ; sum = sum + shilo |
add r4,r4,#2 ; i = i + 2 |
bra eth15 |
eth14: |
ld r5,r3 ; r5 = sum |
and r3,r3,#0xffff |
lsr r5,r5,#16 |
add r3,r3,r5 |
eor r3,r3,#-1 |
sb r3,25,r1 ; low byte |
lsr r3,r3,#8 |
sb r3,24,r1 ; high byte |
pop r6 |
pop r5 |
pop r4 |
ply |
rts |
|
; r1 = packet address |
; returns r1 = 1 if this IP |
; |
message "eth_verifyIP" |
public eth_verifyIP: |
phx |
phy |
push r4 |
push r5 |
lb r2,30,r1 |
lb r3,31,r1 |
lb r4,32,r1 |
lb r5,33,r1 |
; Check for general broadcast |
cmp r2,#$FF |
bne eth11 |
cmp r3,#$FF |
bne eth11 |
cmp r4,#$FF |
bne eth11 |
cmp r5,#$FF |
bne eth11 |
eth12: |
lda #1 |
eth13: |
pop r5 |
pop r4 |
ply |
plx |
rts |
eth11: |
ld r1,r2 |
asl r1,r1,#8 |
or r1,r1,r3 |
asl r1,r1,#8 |
or r1,r1,r4 |
asl r1,r1,#8 |
or r1,r1,r5 |
cmp #$C0A8012A ; 192.168.1.42 |
beq eth12 |
eor r1,r1,r1 |
bra eth13 |
|
msgEthTest |
db CR,LF,"Ethernet test - press CTRL-C to exit.",CR,LF,0 |
|
message "eth_main" |
public eth_main: |
jsr RequestIOFocus |
jsr ClearScreen |
jsr HomeCursor |
lda #msgEthTest |
jsr DisplayStringB |
; jsr eth_init |
jsr ethmac_setup |
eth_loop: |
jsr KeybdGetChar |
cmp #-1 |
beq eth17 |
cmp #CTRLC |
bne eth17 |
lda #$A000 ; tunr off transmit/recieve |
sta ETH_MODER+ETHMAC |
jsr ReleaseIOFocus |
rts |
eth17 |
lda #eth_rx_buffer<<2 ; memory address zero |
jsr eth_request_packet |
jsr eth_interpret_packet ; r1 = packet type |
|
cmp #1 |
bne eth10 |
ld r2,r1 ; save off r1, r2 = packet type |
lda #eth_rx_buffer<<2 ; memory address zero |
jsr eth_verifyIP |
tay |
txa ; r1 = packet type again |
cpy #1 |
bne eth10 |
|
lda #eth_rx_buffer<<2 ; memory address zero |
ldx #1 |
jsr eth_build_packet |
tay ; y = icmpstart |
lda #eth_rx_buffer<<2 ; memory address zero |
add r4,r1,r3 |
sb r0,0,r4 ; [rx_addr+icmpstart] = 0 |
lb r2,17,r1 |
add r2,r2,#14 ; r2 = len |
ld r6,r2 ; r6 = len |
add r15,r1,r3 |
lb r4,2,r15 ; shi |
lb r5,3,r15 ; slo |
asl r4,r4,#8 |
or r4,r4,r5 ; sum = {shi,slo}; |
eor r4,r4,#-1 ; sum = ~sum |
sub r4,r4,#0x800 ; sum = sum - 0x800 |
eor r4,r4,#-1 ; sum = ~sum |
add r15,r1,r3 |
sb r4,3,r15 |
lsr r4,r4,#8 |
sb r4,2,r15 |
tyx |
jsr eth_checksum |
lda #eth_rx_buffer<<2 ; memory address zero |
ld r2,r6 |
jsr eth_send_packet |
jmp eth_loop |
eth10: |
; r2 = rx_addr |
cmp #2 |
bne eth_loop ; Do we have ARP ? |
; xor r2,r2,r2 ; memory address zero |
ldx #eth_rx_buffer<<2 |
; get the opcode |
lb r13,21,x |
cmp r13,#1 |
bne eth_loop ; ARP request |
; get destination IP address |
lb r9,38,x |
lb r10,39,x |
lb r11,40,x |
lb r12,41,x |
; set r15 = destination IP |
ld r15,r9 |
asl r15,r15,#8 |
or r15,r15,r10 |
asl r15,r15,#8 |
or r15,r15,r11 |
asl r15,r15,#8 |
or r15,r15,r12 |
; Is it our IP ? |
cmp r15,#$C0A8012A ; //192.168.1.42 |
bne eth_loop |
; get source IP address |
lb r5,28,x |
lb r6,29,x |
lb r7,30,x |
lb r8,31,x |
; set r14 = source IP |
ld r14,r5 |
asl r14,r14,#8 |
or r14,r14,r6 |
asl r14,r14,#8 |
or r14,r14,r7 |
asl r14,r14,#8 |
or r14,r14,r8 |
; Get the source MAC address |
push r6 |
push r7 |
push r8 |
push r9 |
push r10 |
push r11 |
lb r6,22,x |
lb r7,23,x |
lb r8,24,x |
lb r9,25,x |
lb r10,26,x |
lb r11,27,x |
; write to destination header |
sb r6,0,x |
sb r7,1,x |
sb r8,2,x |
sb r9,3,x |
sb r10,4,x |
sb r11,5,x |
; and write to ARP destination |
sb r6,32,x |
sb r7,33,x |
sb r8,34,x |
sb r9,35,x |
sb r10,36,x |
sb r11,37,x |
pop r11 |
pop r10 |
pop r9 |
pop r8 |
pop r7 |
pop r6 |
; write to source header |
; stbc #0x00,6[r2] |
; stbc #0xFF,7[r2] |
; stbc #0xEE,8[r2] |
; stbc #0xF0,9[r2] |
; stbc #0xDA,10[r2] |
; stbc #0x42,11[r2] |
sb r0,6,x |
lda #0xFF |
sb r1,7,x |
lda #0xEE |
sb r1,8,x |
lda #0xF0 |
sb r1,9,x |
lda #0xDA |
sb r1,10,x |
lda #0x42 |
sb r1,11,x |
; write to ARP source |
; stbc #0x00,22[r2] |
; stbc #0xFF,23[r2] |
; stbc #0xEE,24[r2] |
; stbc #0xF0,25[r2] |
; stbc #0xDA,26[r2] |
; stbc #0x42,27[r2] |
sb r0,22,x |
lda #0xFF |
sb r1,23,x |
lda #0xEE |
sb r1,24,x |
lda #0xF0 |
sb r1,25,x |
lda #0xDA |
sb r1,26,x |
lda #0x42 |
sb r1,27,x |
; swap sender / destination IP |
; write sender |
sb r9,28,x |
sb r10,29,x |
sb r11,30,x |
sb r12,31,x |
; write destination |
sb r5,38,x |
sb r6,39,x |
sb r7,40,x |
sb r8,41,x |
; change request to reply |
; stbc #2,21[r2] |
lda #2 |
sb r1,21,x |
txa ; r1 = packet address |
ldx #0x2A ; r2 = packet length |
jsr eth_send_packet |
jmp eth_loop |
|
/rtf65002/trunk/software/asm/serial.asm
0,0 → 1,357
|
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; ============================================================================ |
; |
UART EQU 0xFFDC0A00 |
UART_LS EQU 0xFFDC0A01 |
UART_MS EQU 0xFFDC0A02 |
UART_IS EQU 0xFFDC0A03 |
UART_IE EQU 0xFFDC0A04 |
UART_MC EQU 0xFFDC0A06 |
UART_CM1 EQU 0xFFDC0A09 |
UART_CM2 EQU 0xFFDC0A0A |
UART_CM3 EQU 0xFFDC0A0B |
txempty EQU 0x40 |
rxfull EQU 0x01 |
|
bss |
org 0x01FBC000 |
Uart_rxfifo fill.b 512,0 |
org 0x7D0 |
Uart_rxhead db 0 |
Uart_rxtail db 0 |
Uart_ms db 0 |
Uart_rxrts db 0 |
Uart_rxdtr db 0 |
Uart_rxxon db 0 |
Uart_rxflow db 0 |
Uart_fon db 0 |
Uart_foff db 0 |
Uart_txrts db 0 |
Uart_txdtr db 0 |
Uart_txxon db 0 |
Uart_txxonoff db 0 |
|
;============================================================================== |
; Serial port |
;============================================================================== |
code |
;------------------------------------------------------------------------------ |
; Initialize the serial port |
; r1 = low 28 bits = baud rate |
; r2 = other settings |
; The desired baud rate must fit in 28 bits or less. |
;------------------------------------------------------------------------------ |
; |
public SerialInit: |
; asl r1,r1,#4 ; * 16 |
; shlui r1,r1,#32 ; * 2^32 |
; inhu r2,CR_CLOCK ; get clock frequency from config record |
; divu r1,r1,r2 ; / clock frequency |
|
lsr r1,r1,#8 ; drop the lowest 8 bits |
sta UART_CM1 ; set LSB |
lsr r1,r1,#8 |
sta UART_CM2 ; set middle bits |
lsr r1,r1,#8 |
sta UART_CM3 ; set MSB |
stz Uart_rxhead ; reset buffer indexes |
stz Uart_rxtail |
lda #0x1f0 |
sta Uart_foff ; set threshold for XOFF |
lda #0x010 |
sta Uart_fon ; set threshold for XON |
lda #1 |
sta UART_IE ; enable receive interrupt only |
stz Uart_rxrts ; no RTS/CTS signals available |
stz Uart_txrts ; no RTS/CTS signals available |
stz Uart_txdtr ; no DTR signals available |
stz Uart_rxdtr ; no DTR signals available |
lda #1 |
sta Uart_txxon ; for now |
lda #1 |
sta SERIAL_SEMA |
rts |
|
;--------------------------------------------------------------------------------- |
; Get character directly from serial port. Blocks until a character is available. |
;--------------------------------------------------------------------------------- |
; |
public SerialGetCharDirect: |
sgc1: |
lda UART_LS ; uart status |
and #rxfull ; is there a char available ? |
beq sgc1 |
lda UART |
rts |
|
;------------------------------------------------ |
; Check for a character at the serial port |
; returns r1 = 1 if char available, 0 otherwise |
;------------------------------------------------ |
; |
public SerialCheckForCharDirect: |
lda UART_LS ; uart status |
and #rxfull ; is there a char available ? |
rts |
|
;----------------------------------------- |
; Put character to serial port |
; r1 = char to put |
;----------------------------------------- |
; |
public SerialPutChar: |
phx |
phy |
push r4 |
push r5 |
|
ldx UART_MC |
or r2,r2,#3 ; assert DTR / RTS |
stx UART_MC |
ldx Uart_txrts |
beq spcb1 |
ld r4,Milliseconds |
ldy #1000 ; delay count (1 s) |
spcb3: |
ldx UART_MS |
and r2,r2,#$10 ; is CTS asserted ? |
bne spcb1 |
ld r5,Milliseconds |
cmp r4,r5 |
beq spcb3 |
ld r4,r5 |
dey |
bne spcb3 |
bra spcabort |
spcb1: |
ldx Uart_txdtr |
beq spcb2 |
ld r4,Milliseconds |
ldy #1000 ; delay count |
spcb4: |
ldx UART_MS |
and r2,r2,#$20 ; is DSR asserted ? |
bne spcb2 |
ld r5,Milliseconds |
cmp r4,r5 |
beq spcb4 |
ld r4,r5 |
dey |
bne spcb4 |
bra spcabort |
spcb2: |
ldx Uart_txxon |
beq spcb5 |
spcb6: |
ldx Uart_txxonoff |
beq spcb5 |
ld r4,UART_MS |
and r4,r4,#0x80 ; DCD ? |
bne spcb6 |
spcb5: |
ld r4,Milliseconds |
ldy #1000 ; wait up to 1s |
spcb8: |
ldx UART_LS |
and r2,r2,#0x20 ; tx not full ? |
bne spcb7 |
ld r5,Milliseconds |
cmp r4,r5 |
beq spcb8 |
ld r4,r5 |
dey |
bne spcb8 |
bra spcabort |
spcb7: |
sta UART |
spcabort: |
pop r5 |
pop r4 |
ply |
plx |
rts |
|
;------------------------------------------------- |
; Compute number of characters in recieve buffer. |
; r4 = number of chars |
;------------------------------------------------- |
CharsInRxBuf: |
ld r4,Uart_rxhead |
ldx Uart_rxtail |
sub r4,r4,r2 |
bpl cirxb1 |
ld r4,#0x200 |
add r4,r4,r2 |
ldx Uart_rxhead |
sub r4,r4,r2 |
cirxb1: |
rts |
|
;---------------------------------------------- |
; Get character from rx fifo |
; If the fifo is empty enough then send an XON |
;---------------------------------------------- |
; |
public SerialGetChar: |
phx |
phy |
push r4 |
|
ldy Uart_rxhead |
ldx Uart_rxtail |
cmp r2,r3 |
beq sgcfifo1 ; is there a char available ? |
lda Uart_rxfifo,x ; get the char from the fifo into r1 |
inx ; increment the fifo pointer |
and r2,r2,#$1ff |
stx Uart_rxtail |
ldx Uart_rxflow ; using flow control ? |
beq sgcfifo2 |
ldy Uart_fon ; enough space in Rx buffer ? |
jsr CharsInRxBuf |
cmp r4,r3 |
bpl sgcfifo2 |
stz Uart_rxflow ; flow off |
ld r4,Uart_rxrts |
beq sgcfifo3 |
ld r4,UART_MC ; set rts bit in MC |
or r4,r4,#2 |
st r4,UART_MC |
sgcfifo3: |
ld r4,Uart_rxdtr |
beq sgcfifo4 |
ld r4,UART_MC ; set DTR |
or r4,r4,#1 |
st r4,UART_MC |
sgcfifo4: |
ld r4,Uart_rxxon |
beq sgcfifo5 |
ld r4,#XON |
st r4,UART |
sgcfifo5: |
sgcfifo2: ; return with char in r1 |
pop r4 |
ply |
plx |
rts |
sgcfifo1: |
lda #-1 ; no char available |
pop r4 |
ply |
plx |
rts |
|
|
;----------------------------------------- |
; Serial port IRQ |
;----------------------------------------- |
; |
public SerialIRQ: |
pha |
phx |
phy |
push r4 |
|
lda UART_IS ; get interrupt status |
bpl sirq1 ; no interrupt |
and #0x7f ; switch on interrupt type |
cmp #4 |
beq srxirq |
cmp #$0C |
beq stxirq |
cmp #$10 |
beq smsirq |
; unknown IRQ type |
sirq1: |
pop r4 |
ply |
plx |
pla |
rti |
|
|
; Get the modem status and record it |
smsirq: |
lda UART_MS |
sta Uart_ms |
bra sirq1 |
|
stxirq: |
bra sirq1 |
|
; Get a character from the uart and store it in the rx fifo |
srxirq: |
srxirq1: |
lda UART ; get the char (clears interrupt) |
ldx Uart_txxon |
beq srxirq3 |
cmp #XOFF |
bne srxirq2 |
lda #1 |
sta Uart_txxonoff |
bra srxirq5 |
srxirq2: |
cmp #XON |
bne srxirq3 |
stz Uart_txxonoff |
bra srxirq5 |
srxirq3: |
stz Uart_txxonoff |
ldx Uart_rxhead |
sta Uart_rxfifo,x ; store in buffer |
inx |
and r2,r2,#$1ff |
stx Uart_rxhead |
srxirq5: |
lda UART_LS ; check for another ready character |
and #rxfull |
bne srxirq1 |
lda Uart_rxflow ; are we using flow controls? |
bne srxirq8 |
jsr CharsInRxBuf |
lda Uart_foff |
cmp r4,r1 |
bmi srxirq8 |
lda #1 |
sta Uart_rxflow |
lda Uart_rxrts |
beq srxirq6 |
lda UART_MC |
and #$FD ; turn off RTS |
sta UART_MC |
srxirq6: |
lda Uart_rxdtr |
beq srxirq7 |
lda UART_MC |
and #$FE ; turn off DTR |
sta UART_MC |
srxirq7: |
lda Uart_rxxon |
beq srxirq8 |
lda #XOFF |
sta UART |
srxirq8: |
bra sirq1 |
|
|
/rtf65002/trunk/software/asm/basic.asm
0,0 → 1,9340
|
; Enhanced BASIC to assemble under 6502 simulator, $ver 2.22 |
|
; $E7E1 $E7CF $E7C6 $E7D3 $E7D1 $E7D5 $E7CF $E81E $E825 |
|
; 2.00 new revision numbers start here |
; 2.01 fixed LCASE$() and UCASE$() |
; 2.02 new get value routine done |
; 2.03 changed RND() to galoise method |
; 2.04 fixed SPC() |
; 2.05 new get value routine fixed |
; 2.06 changed USR() code |
; 2.07 fixed STR$() |
; 2.08 changed INPUT and READ to remove need for $00 start to input buffer |
; 2.09 fixed RND() |
; 2.10 integrated missed changes from an earlier version |
; 2.20 added ELSE to IF .. THEN and fixed IF .. GOTO <statement> to cause error |
; 2.21 fixed IF .. THEN RETURN to not cause error |
; 2.22 fixed RND() breaking the get byte routine |
|
macro nat |
.byte $42 |
xce |
cpu RTF65002 |
endm |
|
macro emm |
sec |
xce |
endm |
|
macro emm816 |
clc |
xce |
cpu W65C816S |
endm |
|
DisplayChar = $FFFF8000 |
KeybdCheckForKeyDirect = $FFFF8004 |
KeybdGetCharDirect = $FFFF8008 |
KeybdGetChar = $FFFF800C |
KeybdCheckForChar = $FFFF8010 |
RequestIOFocus = $FFFF8014 |
ReleaseIOFocus = $FFFF8018 |
ClearScreen = $FFFF801C |
HomeCursor = $FFFF8020 |
ExitTask = $FFFF8024 |
SetKeyboardEcho = $FFFF8028 |
Sleep = $FFFF802C |
LoadFile = $FFFF8030 |
SaveFile = $FFFF8034 |
ICacheInvalidateAll = $FFFF8038 |
ICacheInvalidateLine = $FFFF803C |
|
LEDS =$FFDC0600 |
|
OUTNDX EQU 0x778 |
INPNDX EQU 0x779 |
FILENAME EQU 0x6C0 |
FILEBUF EQU 0x05F60000 |
|
; zero page use .. |
|
LAB_WARM = $00 ; BASIC warm start entry point |
Wrmjpl = LAB_WARM+1; BASIC warm start vector jump low byte |
Wrmjph = LAB_WARM+2; BASIC warm start vector jump high byte |
|
Usrjmp = $0A ; USR function JMP address |
Usrjpl = Usrjmp+1 ; USR function JMP vector low byte |
Usrjph = Usrjmp+2 ; USR function JMP vector high byte |
Nullct = $0D ; nulls output after each line |
TPos = $0E ; BASIC terminal position byte |
TWidth = $0F ; BASIC terminal width byte |
Iclim = $10 ; input column limit |
Itempl = $11 ; temporary integer low byte |
Itemph = Itempl+1 ; temporary integer high byte |
|
nums_1 = Itempl ; number to bin/hex string convert MSB |
nums_2 = nums_1+1 ; number to bin/hex string convert |
nums_3 = nums_1+2 ; number to bin/hex string convert LSB |
|
Srchc = $5B ; search character |
Temp3 = Srchc ; temp byte used in number routines |
Scnquo = $5C ; scan-between-quotes flag |
Asrch = Scnquo ; alt search character |
|
XOAw_l = Srchc ; eXclusive OR, OR and AND word low byte |
XOAw_h = Scnquo ; eXclusive OR, OR and AND word high byte |
|
Ibptr = $5D ; input buffer pointer |
Dimcnt = Ibptr ; # of dimensions |
Tindx = Ibptr ; token index |
|
Defdim = $5E ; default DIM flag |
Dtypef = $5F ; data type flag, $FF=string, $00=numeric |
Oquote = $60 ; open quote flag (b7) (Flag: DATA scan; LIST quote; memory) |
Gclctd = $60 ; garbage collected flag |
Sufnxf = $61 ; subscript/FNX flag, 1xxx xxx = FN(0xxx xxx) |
Imode = $62 ; input mode flag, $00=INPUT, $80=READ |
|
Cflag = $63 ; comparison evaluation flag |
|
TabSiz = $64 ; TAB step size (was input flag) |
|
next_s = $65 ; next descriptor stack address |
|
; these two bytes form a word pointer to the item |
; currently on top of the descriptor stack |
last_sl = $66 ; last descriptor stack address low byte |
last_sh = $67 ; last descriptor stack address high byte (always $00) |
|
des_sk = $68 ; descriptor stack start address (temp strings) |
|
; = $70 ; End of descriptor stack |
|
ut1_pl = $71 ; utility pointer 1 low byte |
ut1_ph = ut1_pl+1 ; utility pointer 1 high byte |
ut2_pl = $73 ; utility pointer 2 low byte |
ut2_ph = ut2_pl+1 ; utility pointer 2 high byte |
|
Temp_2 = ut1_pl ; temp byte for block move |
|
FACt_1 = $75 ; FAC temp mantissa1 |
FACt_2 = FACt_1+1 ; FAC temp mantissa2 |
FACt_3 = FACt_2+1 ; FAC temp mantissa3 |
|
dims_l = FACt_2 ; array dimension size low byte |
dims_h = FACt_3 ; array dimension size high byte |
|
TempB = $78 ; temp page 0 byte |
|
Smeml = $79 ; start of mem low byte (Start-of-Basic) |
Smemh = Smeml+1 ; start of mem high byte (Start-of-Basic) |
Svarl = $7B ; start of vars low byte (Start-of-Variables) |
Svarh = Svarl+1 ; start of vars high byte (Start-of-Variables) |
Sarryl = $7D ; var mem end low byte (Start-of-Arrays) |
Sarryh = Sarryl+1 ; var mem end high byte (Start-of-Arrays) |
Earryl = $7F ; array mem end low byte (End-of-Arrays) |
Earryh = Earryl+1 ; array mem end high byte (End-of-Arrays) |
Sstorl = $81 ; string storage low byte (String storage (moving down)) |
Sstorh = Sstorl+1 ; string storage high byte (String storage (moving down)) |
Sutill = $83 ; string utility ptr low byte |
Sutilh = Sutill+1 ; string utility ptr high byte |
Ememl = $85 ; end of mem low byte (Limit-of-memory) |
Ememh = Ememl+1 ; end of mem high byte (Limit-of-memory) |
Clinel = $87 ; current line low byte (Basic line number) |
Clineh = Clinel+1 ; current line high byte (Basic line number) |
Blinel = $89 ; break line low byte (Previous Basic line number) |
Blineh = Blinel+1 ; break line high byte (Previous Basic line number) |
|
Cpntrl = $8B ; continue pointer low byte |
Cpntrh = Cpntrl+1 ; continue pointer high byte |
|
Dlinel = $8D ; current DATA line low byte |
Dlineh = Dlinel+1 ; current DATA line high byte |
|
Dptrl = $8F ; DATA pointer low byte |
Dptrh = Dptrl+1 ; DATA pointer high byte |
|
Rdptrl = $91 ; read pointer low byte |
Rdptrh = Rdptrl+1 ; read pointer high byte |
|
Varnm1 = $93 ; current var name 1st byte |
Varnm2 = Varnm1+1 ; current var name 2nd byte |
|
Cvaral = $95 ; current var address low byte |
Cvarah = Cvaral+1 ; current var address high byte |
|
Frnxtl = $97 ; var pointer for FOR/NEXT low byte |
Frnxth = Frnxtl+1 ; var pointer for FOR/NEXT high byte |
|
Tidx1 = Frnxtl ; temp line index |
|
Lvarpl = Frnxtl ; let var pointer low byte |
Lvarph = Frnxth ; let var pointer high byte |
|
prstk = $99 ; precedence stacked flag |
|
comp_f = $9B ; compare function flag, bits 0,1 and 2 used |
; bit 2 set if > |
; bit 1 set if = |
; bit 0 set if < |
|
func_l = $9C ; function pointer low byte |
func_h = func_l+1 ; function pointer high byte |
|
garb_l = func_l ; garbage collection working pointer low byte |
garb_h = func_h ; garbage collection working pointer high byte |
|
des_2l = $9E ; string descriptor_2 pointer low byte |
des_2h = des_2l+1 ; string descriptor_2 pointer high byte |
|
g_step = $A0 ; garbage collect step size |
|
Fnxjmp = $A1 ; jump vector for functions |
Fnxjpl = Fnxjmp+1 ; functions jump vector low byte |
Fnxjph = Fnxjmp+2 ; functions jump vector high byte |
|
g_indx = Fnxjpl ; garbage collect temp index |
|
FAC2_r = $A3 ; FAC2 rounding byte |
|
Adatal = $A4 ; array data pointer low byte |
Adatah = Adatal+1 ; array data pointer high byte |
|
Nbendl = Adatal ; new block end pointer low byte |
Nbendh = Adatah ; new block end pointer high byte |
|
Obendl = $A6 ; old block end pointer low byte |
Obendh = Obendl+1 ; old block end pointer high byte |
|
numexp = $A8 ; string to float number exponent count |
expcnt = $A9 ; string to float exponent count |
|
numbit = numexp ; bit count for array element calculations |
|
numdpf = $AA ; string to float decimal point flag |
expneg = $AB ; string to float eval exponent -ve flag |
|
Astrtl = numdpf ; array start pointer low byte |
Astrth = expneg ; array start pointer high byte |
|
Histrl = numdpf ; highest string low byte |
Histrh = expneg ; highest string high byte |
|
Baslnl = numdpf ; BASIC search line pointer low byte |
Baslnh = expneg ; BASIC search line pointer high byte |
|
Fvar_l = numdpf ; find/found variable pointer low byte |
Fvar_h = expneg ; find/found variable pointer high byte |
|
Ostrtl = numdpf ; old block start pointer low byte |
Ostrth = expneg ; old block start pointer high byte |
|
Vrschl = numdpf ; variable search pointer low byte |
Vrschh = expneg ; variable search pointer high byte |
|
FAC1_e = $AC ; FAC1 exponent |
FAC1_1 = FAC1_e+1 ; FAC1 mantissa1 |
FAC1_2 = FAC1_e+2 ; FAC1 mantissa2 |
FAC1_3 = FAC1_e+3 ; FAC1 mantissa3 |
FAC1_s = FAC1_e+4 ; FAC1 sign (b7) |
|
str_ln = FAC1_e ; string length |
str_pl = FAC1_1 ; string pointer low byte |
str_ph = FAC1_2 ; string pointer high byte |
|
des_pl = FAC1_2 ; string descriptor pointer low byte |
des_ph = FAC1_3 ; string descriptor pointer high byte |
|
mids_l = FAC1_3 ; MID$ string temp length byte |
|
negnum = $B1 ; string to float eval -ve flag |
numcon = $B1 ; series evaluation constant count |
|
FAC1_o = $B2 ; FAC1 overflow byte |
|
FAC2_e = $B3 ; FAC2 exponent |
FAC2_1 = FAC2_e+1 ; FAC2 mantissa1 |
FAC2_2 = FAC2_e+2 ; FAC2 mantissa2 |
FAC2_3 = FAC2_e+3 ; FAC2 mantissa3 |
FAC2_s = FAC2_e+4 ; FAC2 sign (b7) |
|
FAC_sc = $B8 ; FAC sign comparison, Acc#1 vs #2 |
FAC1_r = $B9 ; FAC1 rounding byte |
|
ssptr_l = FAC_sc ; string start pointer low byte |
ssptr_h = FAC1_r ; string start pointer high byte |
|
sdescr = FAC_sc ; string descriptor pointer |
|
csidx = $BA ; line crunch save index |
Asptl = csidx ; array size/pointer low byte |
Aspth = $BB ; array size/pointer high byte |
|
Btmpl = Asptl ; BASIC pointer temp low byte |
Btmph = Aspth ; BASIC pointer temp low byte |
|
Cptrl = Asptl ; BASIC pointer temp low byte |
Cptrh = Aspth ; BASIC pointer temp low byte |
|
Sendl = Asptl ; BASIC pointer temp low byte |
Sendh = Aspth ; BASIC pointer temp low byte |
|
LAB_IGBY = $BC ; get next BASIC byte subroutine |
|
LAB_GBYT = $C2 ; get current BASIC byte subroutine |
Bpntrl = $C3 ; BASIC execute (get byte) pointer low byte |
Bpntrh = Bpntrl+1 ; BASIC execute (get byte) pointer high byte |
|
; = $D7 ; end of get BASIC char subroutine |
|
Rbyte4 = $D8 ; extra PRNG byte |
Rbyte1 = Rbyte4+1 ; most significant PRNG byte |
Rbyte2 = Rbyte4+2 ; middle PRNG byte |
Rbyte3 = Rbyte4+3 ; least significant PRNG byte |
|
NmiBase = $DC ; NMI handler enabled/setup/triggered flags |
; bit function |
; === ======== |
; 7 interrupt enabled |
; 6 interrupt setup |
; 5 interrupt happened |
; = $DD ; NMI handler addr low byte |
; = $DE ; NMI handler addr high byte |
IrqBase = $DF ; IRQ handler enabled/setup/triggered flags |
; = $E0 ; IRQ handler addr low byte |
; = $E1 ; IRQ handler addr high byte |
|
; = $DE ; unused |
; = $DF ; unused |
; = $E0 ; unused |
; = $E1 ; unused |
; = $E2 ; unused |
; = $E3 ; unused |
; = $E4 ; unused |
; = $E5 ; unused |
; = $E6 ; unused |
; = $E7 ; unused |
; = $E8 ; unused |
; = $E9 ; unused |
; = $EA ; unused |
; = $EB ; unused |
; = $EC ; unused |
; = $ED ; unused |
; = $EE ; unused |
|
Decss = $EF ; number to decimal string start |
Decssp1 = Decss+1 ; number to decimal string start |
|
; = $FF ; decimal string end |
|
; token values needed for BASIC |
|
; primary command tokens (can start a statement) |
|
TK_END = $80 ; END token |
TK_FOR = TK_END+1 ; FOR token |
TK_NEXT = TK_FOR+1 ; NEXT token |
TK_DATA = TK_NEXT+1 ; DATA token |
TK_INPUT = TK_DATA+1 ; INPUT token |
TK_DIM = TK_INPUT+1 ; DIM token |
TK_READ = TK_DIM+1 ; READ token |
TK_LET = TK_READ+1 ; LET token |
TK_DEC = TK_LET+1 ; DEC token |
TK_GOTO = TK_DEC+1 ; GOTO token |
TK_RUN = TK_GOTO+1 ; RUN token |
TK_IF = TK_RUN+1 ; IF token |
TK_RESTORE = TK_IF+1 ; RESTORE token |
TK_GOSUB = TK_RESTORE+1 ; GOSUB token |
TK_RETIRQ = TK_GOSUB+1 ; RETIRQ token |
TK_RETNMI = TK_RETIRQ+1 ; RETNMI token |
TK_RETURN = TK_RETNMI+1 ; RETURN token |
TK_REM = TK_RETURN+1 ; REM token |
TK_STOP = TK_REM+1 ; STOP token |
TK_ON = TK_STOP+1 ; ON token |
TK_NULL = TK_ON+1 ; NULL token |
TK_INC = TK_NULL+1 ; INC token |
TK_WAIT = TK_INC+1 ; WAIT token |
TK_LOAD = TK_WAIT+1 ; LOAD token |
TK_SAVE = TK_LOAD+1 ; SAVE token |
TK_DEF = TK_SAVE+1 ; DEF token |
TK_POKE = TK_DEF+1 ; POKE token |
TK_DOKE = TK_POKE+1 ; DOKE token |
TK_CALL = TK_DOKE+1 ; CALL token |
TK_DO = TK_CALL+1 ; DO token |
TK_LOOP = TK_DO+1 ; LOOP token |
TK_PRINT = TK_LOOP+1 ; PRINT token |
TK_CONT = TK_PRINT+1 ; CONT token |
TK_LIST = TK_CONT+1 ; LIST token |
TK_CLEAR = TK_LIST+1 ; CLEAR token |
TK_NEW = TK_CLEAR+1 ; NEW token |
TK_WIDTH = TK_NEW+1 ; WIDTH token |
TK_GET = TK_WIDTH+1 ; GET token |
TK_SWAP = TK_GET+1 ; SWAP token |
TK_BITSET = TK_SWAP+1 ; BITSET token |
TK_BITCLR = TK_BITSET+1 ; BITCLR token |
TK_IRQ = TK_BITCLR+1 ; IRQ token |
TK_NMI = TK_IRQ+1 ; NMI token |
TK_BYE = TK_NMI+1 |
|
; secondary command tokens, can't start a statement |
|
TK_TAB = TK_BYE+1 ; TAB token |
TK_ELSE = TK_TAB+1 ; ELSE token |
TK_TO = TK_ELSE+1 ; TO token |
TK_FN = TK_TO+1 ; FN token |
TK_SPC = TK_FN+1 ; SPC token |
TK_THEN = TK_SPC+1 ; THEN token |
TK_NOT = TK_THEN+1 ; NOT token |
TK_STEP = TK_NOT+1 ; STEP token |
TK_UNTIL = TK_STEP+1 ; UNTIL token |
TK_WHILE = TK_UNTIL+1 ; WHILE token |
TK_OFF = TK_WHILE+1 ; OFF token |
|
; opperator tokens |
|
TK_PLUS = TK_OFF+1 ; + token |
TK_MINUS = TK_PLUS+1 ; - token |
TK_MUL = TK_MINUS+1 ; * token |
TK_DIV = TK_MUL+1 ; / token |
TK_POWER = TK_DIV+1 ; ^ token |
TK_AND = TK_POWER+1 ; AND token |
TK_EOR = TK_AND+1 ; EOR token |
TK_OR = TK_EOR+1 ; OR token |
TK_RSHIFT = TK_OR+1 ; RSHIFT token |
TK_LSHIFT = TK_RSHIFT+1 ; LSHIFT token |
TK_GT = TK_LSHIFT+1 ; > token |
TK_EQUAL = TK_GT+1 ; = token |
TK_LT = TK_EQUAL+1 ; < token |
|
; functions tokens |
|
TK_SGN = TK_LT+1 ; SGN token |
TK_INT = TK_SGN+1 ; INT token |
TK_ABS = TK_INT+1 ; ABS token |
TK_USR = TK_ABS+1 ; USR token |
TK_FRE = TK_USR+1 ; FRE token |
TK_POS = TK_FRE+1 ; POS token |
TK_SQR = TK_POS+1 ; SQR token |
TK_RND = TK_SQR+1 ; RND token |
TK_LOG = TK_RND+1 ; LOG token |
TK_EXP = TK_LOG+1 ; EXP token |
TK_COS = TK_EXP+1 ; COS token |
TK_SIN = TK_COS+1 ; SIN token |
TK_TAN = TK_SIN+1 ; TAN token |
TK_ATN = TK_TAN+1 ; ATN token |
TK_PEEK = TK_ATN+1 ; PEEK token |
TK_DEEK = TK_PEEK+1 ; DEEK token |
TK_SADD = TK_DEEK+1 ; SADD token |
TK_LEN = TK_SADD+1 ; LEN token |
TK_STRS = TK_LEN+1 ; STR$ token |
TK_VAL = TK_STRS+1 ; VAL token |
TK_ASC = TK_VAL+1 ; ASC token |
TK_UCASES = TK_ASC+1 ; UCASE$ token |
TK_LCASES = TK_UCASES+1 ; LCASE$ token |
TK_CHRS = TK_LCASES+1 ; CHR$ token |
TK_HEXS = TK_CHRS+1 ; HEX$ token |
TK_BINS = TK_HEXS+1 ; BIN$ token |
TK_BITTST = TK_BINS+1 ; BITTST token |
TK_MAX = TK_BITTST+1 ; MAX token |
TK_MIN = TK_MAX+1 ; MIN token |
TK_PI = TK_MIN+1 ; PI token |
TK_TWOPI = TK_PI+1 ; TWOPI token |
TK_VPTR = TK_TWOPI+1 ; VARPTR token |
TK_LEFTS = TK_VPTR+1 ; LEFT$ token |
TK_RIGHTS = TK_LEFTS+1 ; RIGHT$ token |
TK_MIDS = TK_RIGHTS+1 ; MID$ token |
|
; offsets from a base of X or Y |
|
PLUS_0 = $00 ; X or Y plus 0 |
PLUS_1 = $01 ; X or Y plus 1 |
PLUS_2 = $02 ; X or Y plus 2 |
PLUS_3 = $03 ; X or Y plus 3 |
|
LAB_STAK = $0100 ; stack bottom, no offset |
|
LAB_SKFE = LAB_STAK+$FE |
; flushed stack address |
LAB_SKFF = LAB_STAK+$FF |
; flushed stack address |
|
ccflag = $0200 ; BASIC CTRL-C flag, 00 = enabled, 01 = dis |
ccbyte = ccflag+1 ; BASIC CTRL-C byte |
ccnull = ccbyte+1 ; BASIC CTRL-C byte timeout |
|
VEC_CC = ccnull+1 ; ctrl c check vector |
|
VEC_IN = VEC_CC+2 ; input vector |
VEC_OUT = VEC_IN+2 ; output vector |
VEC_LD = VEC_OUT+2 ; load vector |
VEC_SV = VEC_LD+2 ; save vector |
|
; Ibuffs can now be anywhere in RAM, ensure that the max length is < $80 |
|
;Ibuffs = IRQ_vec+$14 |
Ibuffs = VEC_SV+$14 |
; start of input buffer after IRQ/NMI code |
Ibuffe = Ibuffs+$47; end of input buffer |
|
Ram_base = $0400 ; start of user RAM (set as needed, should be page aligned) |
Ram_top = $1800 ; end of user RAM+1 (set as needed, should be page aligned) |
|
include "supermon816.asm" |
|
; This start can be changed to suit your system |
|
; *= $C000 |
cpu W65C02 |
org $C000 |
|
; BASIC cold start entry point |
|
; new page 2 initialisation, copy block to ccflag on |
message "LAB_COLD" |
LAB_COLD |
LDY #PG2_TABE-PG2_TABS-1 |
; byte count-1 |
LAB_2D13 |
LDA PG2_TABS,Y ; get byte |
STA ccflag,Y ; store in page 2 |
DEY ; decrement count |
BPL LAB_2D13 ; loop if not done |
LDX #$FF ; set byte |
STX Ibuffs-1 ; *** Added by Daryl Rictor for SBC-2 compatibility |
STX Clineh ; set current line high byte (set immediate mode) |
TXS ; reset stack pointer |
|
LDA #$4C ; code for JMP |
STA Fnxjmp ; save for jump vector for functions |
|
; copy block from LAB_2CEE to $00BC - $00D3 |
|
LDX #StrTab-LAB_2CEE ; set byte count |
LAB_2D4E |
LDA LAB_2CEE-1,X ; get byte from table |
STA LAB_IGBY-1,X ; save byte in page zero |
DEX ; decrement count |
BNE LAB_2D4E ; loop if not all done |
|
; copy block from StrTab to $0000 - $0012 |
|
LAB_GMEM |
LDX #EndTab-StrTab-1 ; set byte count-1 |
TabLoop |
LDA StrTab,X ; get byte from table |
STA PLUS_0,X ; save byte in page zero |
DEX ; decrement count |
BPL TabLoop ; loop if not all done |
|
; set-up start values |
|
LDA #$00 ; clear A |
STA NmiBase ; clear NMI handler enabled flag |
STA IrqBase ; clear IRQ handler enabled flag |
STA FAC1_o ; clear FAC1 overflow byte |
STA last_sh ; clear descriptor stack top item pointer high byte |
|
LDA #$0E ; set default tab size |
STA TabSiz ; save it |
LDA #$03 ; set garbage collect step size for descriptor stack |
STA g_step ; save it |
LDX #des_sk ; descriptor stack start |
STX next_s ; set descriptor stack pointer |
|
JSR LAB_CRLF ; print CR/LF |
LDA #<LAB_MSZM ; point to memory size message (low addr) |
LDY #>LAB_MSZM ; point to memory size message (high addr) |
JSR LAB_18C3 ; print null terminated string from memory |
JSR LAB_INLN ; print "? " and get BASIC input |
STX Bpntrl ; set BASIC execute pointer low byte |
STY Bpntrh ; set BASIC execute pointer high byte |
JSR LAB_GBYT ; get last byte back |
|
BNE LAB_2DAA ; branch if not null (user typed something) |
|
LDY #$00 ; else clear Y |
; character was null so get memory size the hard way |
; we get here with Y=0 and Itempl/h = Ram_base |
LAB_2D93 |
INC Itempl ; increment temporary integer low byte |
BNE LAB_2D99 ; branch if no overflow |
|
INC Itemph ; increment temporary integer high byte |
LDA Itemph ; get high byte |
CMP #>Ram_top ; compare with top of RAM+1 |
BEQ LAB_2DB6 ; branch if match (end of user RAM) |
|
LAB_2D99 |
LDA #$55 ; set test byte |
STA (Itempl),Y ; save via temporary integer |
CMP (Itempl),Y ; compare via temporary integer |
BNE LAB_2DB6 ; branch if fail |
|
ASL ; shift test byte left (now $AA) |
STA (Itempl),Y ; save via temporary integer |
CMP (Itempl),Y ; compare via temporary integer |
BEQ LAB_2D93 ; if ok go do next byte |
|
BNE LAB_2DB6 ; branch if fail |
|
LAB_2DAA |
JSR LAB_2887 ; get FAC1 from string |
LDA FAC1_e ; get FAC1 exponent |
CMP #$98 ; compare with exponent = 2^24 |
BCS LAB_GMEM ; if too large go try again |
|
JSR LAB_F2FU ; save integer part of FAC1 in temporary integer |
; (no range check) |
|
LAB_2DB6 |
LDA Itempl ; get temporary integer low byte |
LDY Itemph ; get temporary integer high byte |
CPY #<Ram_base+1 ; compare with start of RAM+$100 high byte |
BCC LAB_GMEM ; if too small go try again |
|
|
; uncomment these lines if you want to check on the high limit of memory. Note if |
; Ram_top is set too low then this will fail. default is ignore it and assume the |
; users know what they're doing! |
|
; CPY #>Ram_top ; compare with top of RAM high byte |
; BCC MEM_OK ; branch if < RAM top |
|
; BNE LAB_GMEM ; if too large go try again |
; else was = so compare low bytes |
; CMP #<Ram_top ; compare with top of RAM low byte |
; BEQ MEM_OK ; branch if = RAM top |
|
; BCS LAB_GMEM ; if too large go try again |
|
;MEM_OK |
STA Ememl ; set end of mem low byte |
STY Ememh ; set end of mem high byte |
STA Sstorl ; set bottom of string space low byte |
STY Sstorh ; set bottom of string space high byte |
|
LDY #<Ram_base ; set start addr low byte |
LDX #>Ram_base ; set start addr high byte |
STY Smeml ; save start of mem low byte |
STX Smemh ; save start of mem high byte |
|
; this line is only needed if Ram_base is not $xx00 |
|
; LDY #$00 ; clear Y |
TYA ; clear A |
STA (Smeml),Y ; clear first byte |
INC Smeml ; increment start of mem low byte |
|
; these two lines are only needed if Ram_base is $xxFF |
|
; BNE LAB_2E05 ; branch if no rollover |
|
; INC Smemh ; increment start of mem high byte |
LAB_2E05 |
JSR LAB_CRLF ; print CR/LF |
JSR LAB_1463 ; do "NEW" and "CLEAR" |
LDA Ememl ; get end of mem low byte |
SEC ; set carry for subtract |
SBC Smeml ; subtract start of mem low byte |
TAX ; copy to X |
LDA Ememh ; get end of mem high byte |
SBC Smemh ; subtract start of mem high byte |
JSR LAB_295E ; print XA as unsigned integer (bytes free) |
LDA #<LAB_SMSG ; point to sign-on message (low addr) |
LDY #>LAB_SMSG ; point to sign-on message (high addr) |
JSR LAB_18C3 ; print null terminated string from memory |
LDA #<LAB_1274 ; warm start vector low byte |
LDY #>LAB_1274 ; warm start vector high byte |
STA Wrmjpl ; save warm start vector low byte |
STY Wrmjph ; save warm start vector high byte |
JMP (Wrmjpl) ; go do warm start |
|
; open up space in memory |
; move (Ostrtl)-(Obendl) to new block ending at (Nbendl) |
|
; Nbendl,Nbendh - new block end address (A/Y) |
; Obendl,Obendh - old block end address |
; Ostrtl,Ostrth - old block start address |
|
; returns with .. |
|
; Nbendl,Nbendh - new block start address (high byte - $100) |
; Obendl,Obendh - old block start address (high byte - $100) |
; Ostrtl,Ostrth - old block start address (unchanged) |
|
LAB_11CF |
JSR LAB_121F ; check available memory, "Out of memory" error if no room |
; addr to check is in AY (low/high) |
STA Earryl ; save new array mem end low byte |
STY Earryh ; save new array mem end high byte |
|
; open up space in memory |
; move (Ostrtl)-(Obendl) to new block ending at (Nbendl) |
; don't set array end |
|
LAB_11D6 |
SEC ; set carry for subtract |
LDA Obendl ; get block end low byte |
SBC Ostrtl ; subtract block start low byte |
TAY ; copy MOD(block length/$100) byte to Y |
LDA Obendh ; get block end high byte |
SBC Ostrth ; subtract block start high byte |
TAX ; copy block length high byte to X |
INX ; +1 to allow for count=0 exit |
TYA ; copy block length low byte to A |
BEQ LAB_120A ; branch if length low byte=0 |
|
; block is (X-1)*256+Y bytes, do the Y bytes first |
|
SEC ; set carry for add + 1, two's complement |
EOR #$FF ; invert low byte for subtract |
ADC Obendl ; add block end low byte |
|
STA Obendl ; save corrected old block end low byte |
BCS LAB_11F3 ; branch if no underflow |
|
DEC Obendh ; else decrement block end high byte |
SEC ; set carry for add + 1, two's complement |
LAB_11F3 |
TYA ; get MOD(block length/$100) byte |
EOR #$FF ; invert low byte for subtract |
ADC Nbendl ; add destination end low byte |
STA Nbendl ; save modified new block end low byte |
BCS LAB_1203 ; branch if no underflow |
|
DEC Nbendh ; else decrement block end high byte |
BCC LAB_1203 ; branch always |
|
LAB_11FF |
LDA (Obendl),Y ; get byte from source |
STA (Nbendl),Y ; copy byte to destination |
LAB_1203 |
DEY ; decrement index |
BNE LAB_11FF ; loop until Y=0 |
|
; now do Y=0 indexed byte |
LDA (Obendl),Y ; get byte from source |
STA (Nbendl),Y ; save byte to destination |
LAB_120A |
DEC Obendh ; decrement source pointer high byte |
DEC Nbendh ; decrement destination pointer high byte |
DEX ; decrement block count |
BNE LAB_1203 ; loop until count = $0 |
|
RTS |
|
; check room on stack for A bytes |
; stack too deep? do OM error |
|
LAB_1212 |
STA TempB ; save result in temp byte |
TSX ; copy stack |
CPX TempB ; compare new "limit" with stack |
BCC LAB_OMER ; if stack < limit do "Out of memory" error then warm start |
|
RTS |
|
; check available memory, "Out of memory" error if no room |
; addr to check is in AY (low/high) |
|
LAB_121F |
CPY Sstorh ; compare bottom of string mem high byte |
BCC LAB_124B ; if less then exit (is ok) |
|
BNE LAB_1229 ; skip next test if greater (tested <) |
|
; high byte was =, now do low byte |
CMP Sstorl ; compare with bottom of string mem low byte |
BCC LAB_124B ; if less then exit (is ok) |
|
; addr is > string storage ptr (oops!) |
LAB_1229 |
PHA ; push addr low byte |
LDX #$08 ; set index to save Adatal to expneg inclusive |
TYA ; copy addr high byte (to push on stack) |
|
; save misc numeric work area |
LAB_122D |
PHA ; push byte |
LDA Adatal-1,X ; get byte from Adatal to expneg ( ,$00 not pushed) |
DEX ; decrement index |
BPL LAB_122D ; loop until all done |
|
JSR LAB_GARB ; garbage collection routine |
|
; restore misc numeric work area |
LDX #$00 ; clear the index to restore bytes |
LAB_1238 |
PLA ; pop byte |
STA Adatal,X ; save byte to Adatal to expneg |
INX ; increment index |
CPX #$08 ; compare with end + 1 |
BMI LAB_1238 ; loop if more to do |
|
PLA ; pop addr high byte |
TAY ; copy back to Y |
PLA ; pop addr low byte |
CPY Sstorh ; compare bottom of string mem high byte |
BCC LAB_124B ; if less then exit (is ok) |
|
BNE LAB_OMER ; if greater do "Out of memory" error then warm start |
|
; high byte was =, now do low byte |
CMP Sstorl ; compare with bottom of string mem low byte |
BCS LAB_OMER ; if >= do "Out of memory" error then warm start |
|
; ok exit, carry clear |
LAB_124B |
RTS |
|
; do "Out of memory" error then warm start |
|
LAB_OMER |
LDX #$0C ; error code $0C ("Out of memory" error) |
|
; do error #X, then warm start |
|
LAB_XERR |
JSR LAB_CRLF ; print CR/LF |
|
LDA LAB_BAER,X ; get error message pointer low byte |
LDY LAB_BAER+1,X ; get error message pointer high byte |
JSR LAB_18C3 ; print null terminated string from memory |
|
JSR LAB_1491 ; flush stack and clear continue flag |
LDA #<LAB_EMSG ; point to " Error" low addr |
LDY #>LAB_EMSG ; point to " Error" high addr |
LAB_1269 |
JSR LAB_18C3 ; print null terminated string from memory |
LDY Clineh ; get current line high byte |
INY ; increment it |
BEQ LAB_1274 ; go do warm start (was immediate mode) |
|
; else print line number |
JSR LAB_2953 ; print " in line [LINE #]" |
|
; BASIC warm start entry point |
; wait for Basic command |
|
LAB_1274 |
; clear ON IRQ/NMI bytes |
LDA #$00 ; clear A |
STA IrqBase ; clear enabled byte |
STA NmiBase ; clear enabled byte |
LDA #<LAB_RMSG ; point to "Ready" message low byte |
LDY #>LAB_RMSG ; point to "Ready" message high byte |
|
JSR LAB_18C3 ; go do print string |
|
; wait for Basic command (no "Ready") |
|
LAB_127D |
JSR LAB_1357 ; call for BASIC input |
LAB_1280 |
STX Bpntrl ; set BASIC execute pointer low byte |
STY Bpntrh ; set BASIC execute pointer high byte |
JSR LAB_GBYT ; scan memory |
BEQ LAB_127D ; loop while null |
|
; got to interpret input line now .. |
|
LDX #$FF ; current line to null value |
STX Clineh ; set current line high byte |
BCC LAB_1295 ; branch if numeric character (handle new BASIC line) |
|
; no line number .. immediate mode |
JSR LAB_13A6 ; crunch keywords into Basic tokens |
JMP LAB_15F6 ; go scan and interpret code |
|
; handle new BASIC line |
|
LAB_1295 |
JSR LAB_GFPN ; get fixed-point number into temp integer |
JSR LAB_13A6 ; crunch keywords into Basic tokens |
STY Ibptr ; save index pointer to end of crunched line |
JSR LAB_SSLN ; search BASIC for temp integer line number |
BCC LAB_12E6 ; branch if not found |
|
; aroooogah! line # already exists! delete it |
LDY #$01 ; set index to next line pointer high byte |
LDA (Baslnl),Y ; get next line pointer high byte |
STA ut1_ph ; save it |
LDA Svarl ; get start of vars low byte |
STA ut1_pl ; save it |
LDA Baslnh ; get found line pointer high byte |
STA ut2_ph ; save it |
LDA Baslnl ; get found line pointer low byte |
DEY ; decrement index |
SBC (Baslnl),Y ; subtract next line pointer low byte |
CLC ; clear carry for add |
ADC Svarl ; add start of vars low byte |
STA Svarl ; save new start of vars low byte |
STA ut2_pl ; save destination pointer low byte |
LDA Svarh ; get start of vars high byte |
ADC #$FF ; -1 + carry |
STA Svarh ; save start of vars high byte |
SBC Baslnh ; subtract found line pointer high byte |
TAX ; copy to block count |
SEC ; set carry for subtract |
LDA Baslnl ; get found line pointer low byte |
SBC Svarl ; subtract start of vars low byte |
TAY ; copy to bytes in first block count |
BCS LAB_12D0 ; branch if overflow |
|
INX ; increment block count (correct for =0 loop exit) |
DEC ut2_ph ; decrement destination high byte |
LAB_12D0 |
CLC ; clear carry for add |
ADC ut1_pl ; add source pointer low byte |
BCC LAB_12D8 ; branch if no overflow |
|
DEC ut1_ph ; else decrement source pointer high byte |
CLC ; clear carry |
|
; close up memory to delete old line |
LAB_12D8 |
LDA (ut1_pl),Y ; get byte from source |
STA (ut2_pl),Y ; copy to destination |
INY ; increment index |
BNE LAB_12D8 ; while <> 0 do this block |
|
INC ut1_ph ; increment source pointer high byte |
INC ut2_ph ; increment destination pointer high byte |
DEX ; decrement block count |
BNE LAB_12D8 ; loop until all done |
|
; got new line in buffer and no existing same # |
LAB_12E6 |
LDA Ibuffs ; get byte from start of input buffer |
BEQ LAB_1319 ; if null line just go flush stack/vars and exit |
|
; got new line and it isn't empty line |
LDA Ememl ; get end of mem low byte |
LDY Ememh ; get end of mem high byte |
STA Sstorl ; set bottom of string space low byte |
STY Sstorh ; set bottom of string space high byte |
LDA Svarl ; get start of vars low byte (end of BASIC) |
STA Obendl ; save old block end low byte |
LDY Svarh ; get start of vars high byte (end of BASIC) |
STY Obendh ; save old block end high byte |
ADC Ibptr ; add input buffer pointer (also buffer length) |
BCC LAB_1301 ; branch if no overflow from add |
|
INY ; else increment high byte |
LAB_1301 |
STA Nbendl ; save new block end low byte (move to, low byte) |
STY Nbendh ; save new block end high byte |
JSR LAB_11CF ; open up space in memory |
; old start pointer Ostrtl,Ostrth set by the find line call |
LDA Earryl ; get array mem end low byte |
LDY Earryh ; get array mem end high byte |
STA Svarl ; save start of vars low byte |
STY Svarh ; save start of vars high byte |
LDY Ibptr ; get input buffer pointer (also buffer length) |
DEY ; adjust for loop type |
LAB_1311 |
LDA Ibuffs-4,Y ; get byte from crunched line |
STA (Baslnl),Y ; save it to program memory |
DEY ; decrement count |
CPY #$03 ; compare with first byte-1 |
BNE LAB_1311 ; continue while count <> 3 |
|
LDA Itemph ; get line # high byte |
STA (Baslnl),Y ; save it to program memory |
DEY ; decrement count |
LDA Itempl ; get line # low byte |
STA (Baslnl),Y ; save it to program memory |
DEY ; decrement count |
LDA #$FF ; set byte to allow chain rebuild. if you didn't set this |
; byte then a zero already here would stop the chain rebuild |
; as it would think it was the [EOT] marker. |
STA (Baslnl),Y ; save it to program memory |
|
LAB_1319 |
JSR LAB_1477 ; reset execution to start, clear vars and flush stack |
LDX Smeml ; get start of mem low byte |
LDA Smemh ; get start of mem high byte |
LDY #$01 ; index to high byte of next line pointer |
LAB_1325 |
STX ut1_pl ; set line start pointer low byte |
STA ut1_ph ; set line start pointer high byte |
LDA (ut1_pl),Y ; get it |
BEQ LAB_133E ; exit if end of program |
|
; rebuild chaining of Basic lines |
|
LDY #$04 ; point to first code byte of line |
; there is always 1 byte + [EOL] as null entries are deleted |
LAB_1330 |
INY ; next code byte |
LDA (ut1_pl),Y ; get byte |
BNE LAB_1330 ; loop if not [EOL] |
|
SEC ; set carry for add + 1 |
TYA ; copy end index |
ADC ut1_pl ; add to line start pointer low byte |
TAX ; copy to X |
LDY #$00 ; clear index, point to this line's next line pointer |
STA (ut1_pl),Y ; set next line pointer low byte |
TYA ; clear A |
ADC ut1_ph ; add line start pointer high byte + carry |
INY ; increment index to high byte |
STA (ut1_pl),Y ; save next line pointer low byte |
BCC LAB_1325 ; go do next line, branch always, carry clear |
|
|
LAB_133E |
JMP LAB_127D ; else we just wait for Basic command, no "Ready" |
|
; print "? " and get BASIC input |
|
LAB_INLN |
JSR LAB_18E3 ; print "?" character |
JSR LAB_18E0 ; print " " |
BNE LAB_1357 ; call for BASIC input and return |
|
; receive line from keyboard |
|
; $08 as delete key (BACKSPACE on standard keyboard) |
LAB_134B |
JSR LAB_PRNA ; go print the character |
DEX ; decrement the buffer counter (delete) |
.byte $2C ; make LDX into BIT abs |
|
; call for BASIC input (main entry point) |
|
LAB_1357 |
LDX #$00 ; clear BASIC line buffer pointer |
LAB_1359 |
JSR V_INPT ; call scan input device |
BCC LAB_1359 ; loop if no byte |
|
BEQ LAB_1359 ; loop until valid input (ignore NULLs) |
|
CMP #$07 ; compare with [BELL] |
BEQ LAB_1378 ; branch if [BELL] |
|
CMP #$0D ; compare with [CR] |
BEQ LAB_1384 ; do CR/LF exit if [CR] |
|
CPX #$00 ; compare pointer with $00 |
BNE LAB_1374 ; branch if not empty |
|
; next two lines ignore any non print character and [SPACE] if input buffer empty |
|
CMP #$21 ; compare with [SP]+1 |
BCC LAB_1359 ; if < ignore character |
|
LAB_1374 |
CMP #$08 ; compare with [BACKSPACE] (delete last character) |
BEQ LAB_134B ; go delete last character |
|
LAB_1378 |
CPX #Ibuffe-Ibuffs ; compare character count with max |
BCS LAB_138E ; skip store and do [BELL] if buffer full |
|
STA Ibuffs,X ; else store in buffer |
INX ; increment pointer |
LAB_137F |
JSR LAB_PRNA ; go print the character |
BNE LAB_1359 ; always loop for next character |
|
LAB_1384 |
JMP LAB_1866 ; do CR/LF exit to BASIC |
message "LAB_138E" |
; announce buffer full |
|
LAB_138E |
LDA #$07 ; [BELL] character into A |
BNE LAB_137F ; go print the [BELL] but ignore input character |
; branch always |
|
; crunch keywords into Basic tokens |
; position independent buffer version .. |
; faster, dictionary search version .... |
|
LAB_13A6 |
LDY #$FF ; set save index (makes for easy math later) |
|
SEC ; set carry for subtract |
LDA Bpntrl ; get basic execute pointer low byte |
SBC #<Ibuffs ; subtract input buffer start pointer |
TAX ; copy result to X (index past line # if any) |
|
STX Oquote ; clear open quote/DATA flag |
LAB_13AC |
LDA Ibuffs,X ; get byte from input buffer |
BEQ LAB_13EC ; if null save byte then exit |
|
CMP #'_' ; compare with "_" |
BCS LAB_13EC ; if >= go save byte then continue crunching |
|
CMP #'<' ; compare with "<" |
BCS LAB_13CC ; if >= go crunch now |
|
CMP #'0' ; compare with "0" |
BCS LAB_13EC ; if >= go save byte then continue crunching |
|
STA Scnquo ; save buffer byte as search character |
CMP #$22 ; is it quote character? |
BEQ LAB_1410 ; branch if so (copy quoted string) |
|
CMP #'*' ; compare with "*" |
BCC LAB_13EC ; if < go save byte then continue crunching |
|
; else crunch now |
LAB_13CC |
BIT Oquote ; get open quote/DATA token flag |
BVS LAB_13EC ; branch if b6 of Oquote set (was DATA) |
; go save byte then continue crunching |
|
STX TempB ; save buffer read index |
STY csidx ; copy buffer save index |
LDY #<TAB_1STC ; get keyword first character table low address |
STY ut2_pl ; save pointer low byte |
LDY #>TAB_1STC ; get keyword first character table high address |
STY ut2_ph ; save pointer high byte |
LDY #$00 ; clear table pointer |
|
LAB_13D0 |
CMP (ut2_pl),Y ; compare with keyword first character table byte |
BEQ LAB_13D1 ; go do word_table_chr if match |
|
BCC LAB_13EA ; if < keyword first character table byte go restore |
; Y and save to crunched |
|
INY ; else increment pointer |
BNE LAB_13D0 ; and loop (branch always) |
|
; have matched first character of some keyword |
|
LAB_13D1 |
TYA ; copy matching index |
ASL ; *2 (bytes per pointer) |
TAX ; copy to new index |
LDA TAB_CHRT,X ; get keyword table pointer low byte |
STA ut2_pl ; save pointer low byte |
LDA TAB_CHRT+1,X ; get keyword table pointer high byte |
STA ut2_ph ; save pointer high byte |
|
LDY #$FF ; clear table pointer (make -1 for start) |
|
LDX TempB ; restore buffer read index |
|
LAB_13D6 |
INY ; next table byte |
LDA (ut2_pl),Y ; get byte from table |
LAB_13D8 |
BMI LAB_13EA ; all bytes matched so go save token |
|
INX ; next buffer byte |
CMP Ibuffs,X ; compare with byte from input buffer |
BEQ LAB_13D6 ; go compare next if match |
|
BNE LAB_1417 ; branch if >< (not found keyword) |
|
LAB_13EA |
LDY csidx ; restore save index |
|
; save crunched to output |
LAB_13EC |
INX ; increment buffer index (to next input byte) |
INY ; increment save index (to next output byte) |
STA Ibuffs,Y ; save byte to output |
CMP #$00 ; set the flags, set carry |
BEQ LAB_142A ; do exit if was null [EOL] |
|
; A holds token or byte here |
SBC #':' ; subtract ":" (carry set by CMP #00) |
BEQ LAB_13FF ; branch if it was ":" (is now $00) |
|
; A now holds token-$3A |
CMP #TK_DATA-$3A ; compare with DATA token - $3A |
BNE LAB_1401 ; branch if not DATA |
|
; token was : or DATA |
LAB_13FF |
STA Oquote ; save token-$3A (clear for ":", TK_DATA-$3A for DATA) |
LAB_1401 |
EOR #TK_REM-$3A ; effectively subtract REM token offset |
BNE LAB_13AC ; If wasn't REM then go crunch rest of line |
|
STA Asrch ; else was REM so set search for [EOL] |
|
; loop for REM, "..." etc. |
LAB_1408 |
LDA Ibuffs,X ; get byte from input buffer |
BEQ LAB_13EC ; branch if null [EOL] |
|
CMP Asrch ; compare with stored character |
BEQ LAB_13EC ; branch if match (end quote) |
|
; entry for copy string in quotes, don't crunch |
LAB_1410 |
INY ; increment buffer save index |
STA Ibuffs,Y ; save byte to output |
INX ; increment buffer read index |
BNE LAB_1408 ; loop while <> 0 (should never be 0!) |
|
; not found keyword this go |
LAB_1417 |
LDX TempB ; compare has failed, restore buffer index (start byte!) |
|
; now find the end of this word in the table |
LAB_141B |
LDA (ut2_pl),Y ; get table byte |
PHP ; save status |
INY ; increment table index |
PLP ; restore byte status |
BPL LAB_141B ; if not end of keyword go do next |
|
LDA (ut2_pl),Y ; get byte from keyword table |
BNE LAB_13D8 ; go test next word if not zero byte (end of table) |
|
; reached end of table with no match |
LDA Ibuffs,X ; restore byte from input buffer |
BPL LAB_13EA ; branch always (all bytes in buffer are $00-$7F) |
; go save byte in output and continue crunching |
|
; reached [EOL] |
LAB_142A |
INY ; increment pointer |
INY ; increment pointer (makes it next line pointer high byte) |
STA Ibuffs,Y ; save [EOL] (marks [EOT] in immediate mode) |
INY ; adjust for line copy |
INY ; adjust for line copy |
INY ; adjust for line copy |
DEC Bpntrl ; allow for increment (change if buffer starts at $xxFF) |
RTS |
|
; search Basic for temp integer line number from start of mem |
|
LAB_SSLN |
LDA Smeml ; get start of mem low byte |
LDX Smemh ; get start of mem high byte |
|
; search Basic for temp integer line number from AX |
; returns carry set if found |
; returns Baslnl/Baslnh pointer to found or next higher (not found) line |
|
; old 541 new 507 |
|
LAB_SHLN |
LDY #$01 ; set index |
STA Baslnl ; save low byte as current |
STX Baslnh ; save high byte as current |
LDA (Baslnl),Y ; get pointer high byte from addr |
BEQ LAB_145F ; pointer was zero so we're done, do 'not found' exit |
|
LDY #$03 ; set index to line # high byte |
LDA (Baslnl),Y ; get line # high byte |
DEY ; decrement index (point to low byte) |
CMP Itemph ; compare with temporary integer high byte |
BNE LAB_1455 ; if <> skip low byte check |
|
LDA (Baslnl),Y ; get line # low byte |
CMP Itempl ; compare with temporary integer low byte |
LAB_1455 |
BCS LAB_145E ; else if temp < this line, exit (passed line#) |
|
LAB_1456 |
DEY ; decrement index to next line ptr high byte |
LDA (Baslnl),Y ; get next line pointer high byte |
TAX ; copy to X |
DEY ; decrement index to next line ptr low byte |
LDA (Baslnl),Y ; get next line pointer low byte |
BCC LAB_SHLN ; go search for line # in temp (Itempl/Itemph) from AX |
; (carry always clear) |
|
LAB_145E |
BEQ LAB_1460 ; exit if temp = found line #, carry is set |
|
LAB_145F |
CLC ; clear found flag |
LAB_1460 |
RTS |
|
; perform NEW |
|
LAB_NEW |
BNE LAB_1460 ; exit if not end of statement (to do syntax error) |
|
LAB_1463 |
LDA #$00 ; clear A |
TAY ; clear Y |
STA (Smeml),Y ; clear first line, next line pointer, low byte |
INY ; increment index |
STA (Smeml),Y ; clear first line, next line pointer, high byte |
CLC ; clear carry |
LDA Smeml ; get start of mem low byte |
ADC #$02 ; calculate end of BASIC low byte |
STA Svarl ; save start of vars low byte |
LDA Smemh ; get start of mem high byte |
ADC #$00 ; add any carry |
STA Svarh ; save start of vars high byte |
|
; reset execution to start, clear vars and flush stack |
|
LAB_1477 |
CLC ; clear carry |
LDA Smeml ; get start of mem low byte |
ADC #$FF ; -1 |
STA Bpntrl ; save BASIC execute pointer low byte |
LDA Smemh ; get start of mem high byte |
ADC #$FF ; -1+carry |
STA Bpntrh ; save BASIC execute pointer high byte |
|
; "CLEAR" command gets here |
|
LAB_147A |
LDA Ememl ; get end of mem low byte |
LDY Ememh ; get end of mem high byte |
STA Sstorl ; set bottom of string space low byte |
STY Sstorh ; set bottom of string space high byte |
LDA Svarl ; get start of vars low byte |
LDY Svarh ; get start of vars high byte |
STA Sarryl ; save var mem end low byte |
STY Sarryh ; save var mem end high byte |
STA Earryl ; save array mem end low byte |
STY Earryh ; save array mem end high byte |
JSR LAB_161A ; perform RESTORE command |
|
; flush stack and clear continue flag |
|
LAB_1491 |
LDX #des_sk ; set descriptor stack pointer |
STX next_s ; save descriptor stack pointer |
PLA ; pull return address low byte |
TAX ; copy return address low byte |
PLA ; pull return address high byte |
STX LAB_SKFE ; save to cleared stack |
STA LAB_SKFF ; save to cleared stack |
LDX #$FD ; new stack pointer |
TXS ; reset stack |
LDA #$00 ; clear byte |
STA Cpntrh ; clear continue pointer high byte |
STA Sufnxf ; clear subscript/FNX flag |
LAB_14A6 |
RTS |
|
; perform CLEAR |
|
LAB_CLEAR |
BEQ LAB_147A ; if no following token go do "CLEAR" |
|
; else there was a following token (go do syntax error) |
RTS |
|
; perform LIST [n][-m] |
; bigger, faster version (a _lot_ faster) |
|
LAB_LIST |
BCC LAB_14BD ; branch if next character numeric (LIST n..) |
|
BEQ LAB_14BD ; branch if next character [NULL] (LIST) |
|
CMP #TK_MINUS ; compare with token for - |
BNE LAB_14A6 ; exit if not - (LIST -m) |
|
; LIST [[n][-m]] |
; this bit sets the n , if present, as the start and end |
LAB_14BD |
JSR LAB_GFPN ; get fixed-point number into temp integer |
JSR LAB_SSLN ; search BASIC for temp integer line number |
; (pointer in Baslnl/Baslnh) |
JSR LAB_GBYT ; scan memory |
BEQ LAB_14D4 ; branch if no more characters |
|
; this bit checks the - is present |
CMP #TK_MINUS ; compare with token for - |
BNE LAB_1460 ; return if not "-" (will be Syntax error) |
|
; LIST [n]-m |
; the - was there so set m as the end value |
JSR LAB_IGBY ; increment and scan memory |
JSR LAB_GFPN ; get fixed-point number into temp integer |
BNE LAB_1460 ; exit if not ok |
|
LAB_14D4 |
LDA Itempl ; get temporary integer low byte |
ORA Itemph ; OR temporary integer high byte |
BNE LAB_14E2 ; branch if start set |
|
LDA #$FF ; set for -1 |
STA Itempl ; set temporary integer low byte |
STA Itemph ; set temporary integer high byte |
LAB_14E2 |
LDY #$01 ; set index for line |
STY Oquote ; clear open quote flag |
JSR LAB_CRLF ; print CR/LF |
LDA (Baslnl),Y ; get next line pointer high byte |
; pointer initially set by search at LAB_14BD |
BEQ LAB_152B ; if null all done so exit |
JSR LAB_1629 ; do CRTL-C check vector |
|
INY ; increment index for line |
LDA (Baslnl),Y ; get line # low byte |
TAX ; copy to X |
INY ; increment index |
LDA (Baslnl),Y ; get line # high byte |
CMP Itemph ; compare with temporary integer high byte |
BNE LAB_14FF ; branch if no high byte match |
|
CPX Itempl ; compare with temporary integer low byte |
BEQ LAB_1501 ; branch if = last line to do (< will pass next branch) |
|
LAB_14FF ; else .. |
BCS LAB_152B ; if greater all done so exit |
|
LAB_1501 |
STY Tidx1 ; save index for line |
JSR LAB_295E ; print XA as unsigned integer |
LDA #$20 ; space is the next character |
LAB_1508 |
LDY Tidx1 ; get index for line |
AND #$7F ; mask top out bit of character |
LAB_150C |
JSR LAB_PRNA ; go print the character |
CMP #$22 ; was it " character |
BNE LAB_1519 ; branch if not |
|
; we are either entering or leaving a pair of quotes |
LDA Oquote ; get open quote flag |
EOR #$FF ; toggle it |
STA Oquote ; save it back |
LAB_1519 |
INY ; increment index |
LDA (Baslnl),Y ; get next byte |
BNE LAB_152E ; branch if not [EOL] (go print character) |
TAY ; else clear index |
LDA (Baslnl),Y ; get next line pointer low byte |
TAX ; copy to X |
INY ; increment index |
LDA (Baslnl),Y ; get next line pointer high byte |
STX Baslnl ; set pointer to line low byte |
STA Baslnh ; set pointer to line high byte |
BNE LAB_14E2 ; go do next line if not [EOT] |
; else .. |
LAB_152B |
RTS |
|
LAB_152E |
BPL LAB_150C ; just go print it if not token byte |
|
; else was token byte so uncrunch it (maybe) |
BIT Oquote ; test the open quote flag |
BMI LAB_150C ; just go print character if open quote set |
|
LDX #>LAB_KEYT ; get table address high byte |
ASL ; *2 |
ASL ; *4 |
BCC LAB_152F ; branch if no carry |
|
INX ; else increment high byte |
CLC ; clear carry for add |
LAB_152F |
ADC #<LAB_KEYT ; add low byte |
BCC LAB_1530 ; branch if no carry |
|
INX ; else increment high byte |
LAB_1530 |
STA ut2_pl ; save table pointer low byte |
STX ut2_ph ; save table pointer high byte |
STY Tidx1 ; save index for line |
LDY #$00 ; clear index |
LDA (ut2_pl),Y ; get length |
TAX ; copy length |
INY ; increment index |
LDA (ut2_pl),Y ; get 1st character |
DEX ; decrement length |
BEQ LAB_1508 ; if no more characters exit and print |
|
JSR LAB_PRNA ; go print the character |
INY ; increment index |
LDA (ut2_pl),Y ; get keyword address low byte |
PHA ; save it for now |
INY ; increment index |
LDA (ut2_pl),Y ; get keyword address high byte |
LDY #$00 |
STA ut2_ph ; save keyword pointer high byte |
PLA ; pull low byte |
STA ut2_pl ; save keyword pointer low byte |
LAB_1540 |
LDA (ut2_pl),Y ; get character |
DEX ; decrement character count |
BEQ LAB_1508 ; if last character exit and print |
|
JSR LAB_PRNA ; go print the character |
INY ; increment index |
BNE LAB_1540 ; loop for next character |
|
; perform FOR |
|
LAB_FOR |
LDA #$80 ; set FNX |
STA Sufnxf ; set subscript/FNX flag |
JSR LAB_LET ; go do LET |
PLA ; pull return address |
PLA ; pull return address |
LDA #$10 ; we need 16d bytes ! |
JSR LAB_1212 ; check room on stack for A bytes |
JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL]) |
CLC ; clear carry for add |
TYA ; copy index to A |
ADC Bpntrl ; add BASIC execute pointer low byte |
PHA ; push onto stack |
LDA Bpntrh ; get BASIC execute pointer high byte |
ADC #$00 ; add carry |
PHA ; push onto stack |
LDA Clineh ; get current line high byte |
PHA ; push onto stack |
LDA Clinel ; get current line low byte |
PHA ; push onto stack |
LDA #TK_TO ; get "TO" token |
JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error then warm start |
JSR LAB_CTNM ; check if source is numeric, else do type mismatch |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
LDA FAC1_s ; get FAC1 sign (b7) |
ORA #$7F ; set all non sign bits |
AND FAC1_1 ; and FAC1 mantissa1 |
STA FAC1_1 ; save FAC1 mantissa1 |
LDA #<LAB_159F ; set return address low byte |
LDY #>LAB_159F ; set return address high byte |
STA ut1_pl ; save return address low byte |
STY ut1_ph ; save return address high byte |
JMP LAB_1B66 ; round FAC1 and put on stack (returns to next instruction) |
|
LAB_159F |
LDA #<LAB_259C ; set 1 pointer low addr (default step size) |
LDY #>LAB_259C ; set 1 pointer high addr |
JSR LAB_UFAC ; unpack memory (AY) into FAC1 |
JSR LAB_GBYT ; scan memory |
CMP #TK_STEP ; compare with STEP token |
BNE LAB_15B3 ; jump if not "STEP" |
|
;.was step so .. |
JSR LAB_IGBY ; increment and scan memory |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
LAB_15B3 |
JSR LAB_27CA ; return A=FF,C=1/-ve A=01,C=0/+ve |
STA FAC1_s ; set FAC1 sign (b7) |
; this is +1 for +ve step and -1 for -ve step, in NEXT we |
; compare the FOR value and the TO value and return +1 if |
; FOR > TO, 0 if FOR = TO and -1 if FOR < TO. the value |
; here (+/-1) is then compared to that result and if they |
; are the same (+ve and FOR > TO or -ve and FOR < TO) then |
; the loop is done |
JSR LAB_1B5B ; push sign, round FAC1 and put on stack |
LDA Frnxth ; get var pointer for FOR/NEXT high byte |
PHA ; push on stack |
LDA Frnxtl ; get var pointer for FOR/NEXT low byte |
PHA ; push on stack |
LDA #TK_FOR ; get FOR token |
PHA ; push on stack |
|
; interpreter inner loop |
message "LAB_15C2" |
LAB_15C2 |
JSR LAB_1629 ; do CRTL-C check vector |
LDA Bpntrl ; get BASIC execute pointer low byte |
LDY Bpntrh ; get BASIC execute pointer high byte |
|
LDX Clineh ; continue line is $FFxx for immediate mode |
; ($00xx for RUN from immediate mode) |
INX ; increment it (now $00 if immediate mode) |
BEQ LAB_15D1 ; branch if null (immediate mode) |
|
STA Cpntrl ; save continue pointer low byte |
STY Cpntrh ; save continue pointer high byte |
LAB_15D1 |
LDY #$00 ; clear index |
LDA (Bpntrl),Y ; get next byte |
BEQ LAB_15DC ; branch if null [EOL] |
|
CMP #':' ; compare with ":" |
BEQ LAB_15F6 ; branch if = (statement separator) |
|
LAB_15D9 |
JMP LAB_SNER ; else syntax error then warm start |
|
; have reached [EOL] |
LAB_15DC |
LDY #$02 ; set index |
LDA (Bpntrl),Y ; get next line pointer high byte |
CLC ; clear carry for no "BREAK" message |
BEQ LAB_1651 ; if null go to immediate mode (was immediate or [EOT] |
; marker) |
|
INY ; increment index |
LDA (Bpntrl),Y ; get line # low byte |
STA Clinel ; save current line low byte |
INY ; increment index |
LDA (Bpntrl),Y ; get line # high byte |
STA Clineh ; save current line high byte |
TYA ; A now = 4 |
ADC Bpntrl ; add BASIC execute pointer low byte |
STA Bpntrl ; save BASIC execute pointer low byte |
BCC LAB_15F6 ; branch if no overflow |
|
INC Bpntrh ; else increment BASIC execute pointer high byte |
LAB_15F6 |
JSR LAB_IGBY ; increment and scan memory |
|
LAB_15F9 |
JSR LAB_15FF ; go interpret BASIC code from (Bpntrl) |
|
LAB_15FC |
JMP LAB_15C2 ; loop |
|
; interpret BASIC code from (Bpntrl) |
|
LAB_15FF |
BEQ LAB_1628 ; exit if zero [EOL] |
|
LAB_1602 |
ASL ; *2 bytes per vector and normalise token |
BCS LAB_1609 ; branch if was token |
|
JMP LAB_LET ; else go do implied LET |
message "LAB_1609" |
LAB_1609 |
CMP #[TK_TAB-$80]*2 ; compare normalised token * 2 with TAB |
BCS LAB_15D9 ; branch if A>=TAB (do syntax error then warm start) |
; only tokens before TAB can start a line |
TAY ; copy to index |
LDA LAB_CTBL+1,Y ; get vector high byte |
PHA ; onto stack |
LDA LAB_CTBL,Y ; get vector low byte |
PHA ; onto stack |
JMP LAB_IGBY ; jump to increment and scan memory |
; then "return" to vector |
|
; CTRL-C check jump. this is called as a subroutine but exits back via a jump if a |
; key press is detected. |
message "LAB_1629" |
LAB_1629 |
JMP (VEC_CC) ; ctrl c check vector |
|
; if there was a key press it gets back here .. |
|
LAB_1636 |
CMP #$03 ; compare with CTRL-C |
|
; perform STOP |
|
LAB_STOP |
BCS LAB_163B ; branch if token follows STOP |
; else just END |
; END |
|
LAB_END |
CLC ; clear the carry, indicate a normal program end |
LAB_163B |
BNE LAB_167A ; if wasn't CTRL-C or there is a following byte return |
|
LDA Bpntrh ; get the BASIC execute pointer high byte |
EOR #>Ibuffs ; compare with buffer address high byte (Cb unchanged) |
BEQ LAB_164F ; branch if the BASIC pointer is in the input buffer |
; (can't continue in immediate mode) |
|
; else .. |
EOR #>Ibuffs ; correct the bits |
LDY Bpntrl ; get BASIC execute pointer low byte |
STY Cpntrl ; save continue pointer low byte |
STA Cpntrh ; save continue pointer high byte |
LAB_1647 |
LDA Clinel ; get current line low byte |
LDY Clineh ; get current line high byte |
STA Blinel ; save break line low byte |
STY Blineh ; save break line high byte |
LAB_164F |
PLA ; pull return address low |
PLA ; pull return address high |
LAB_1651 |
BCC LAB_165E ; if was program end just do warm start |
|
; else .. |
LDA #<LAB_BMSG ; point to "Break" low byte |
LDY #>LAB_BMSG ; point to "Break" high byte |
JMP LAB_1269 ; print "Break" and do warm start |
|
LAB_165E |
JMP LAB_1274 ; go do warm start |
|
; perform RESTORE |
|
LAB_RESTORE |
BNE LAB_RESTOREn ; branch if next character not null (RESTORE n) |
|
LAB_161A |
SEC ; set carry for subtract |
LDA Smeml ; get start of mem low byte |
SBC #$01 ; -1 |
LDY Smemh ; get start of mem high byte |
BCS LAB_1624 ; branch if no underflow |
|
LAB_uflow |
DEY ; else decrement high byte |
LAB_1624 |
STA Dptrl ; save DATA pointer low byte |
STY Dptrh ; save DATA pointer high byte |
LAB_1628 |
RTS |
|
; is RESTORE n |
LAB_RESTOREn |
JSR LAB_GFPN ; get fixed-point number into temp integer |
JSR LAB_SNBL ; scan for next BASIC line |
LDA Clineh ; get current line high byte |
CMP Itemph ; compare with temporary integer high byte |
BCS LAB_reset_search ; branch if >= (start search from beginning) |
|
TYA ; else copy line index to A |
SEC ; set carry (+1) |
ADC Bpntrl ; add BASIC execute pointer low byte |
LDX Bpntrh ; get BASIC execute pointer high byte |
BCC LAB_go_search ; branch if no overflow to high byte |
|
INX ; increment high byte |
BCS LAB_go_search ; branch always (can never be carry clear) |
|
; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml) |
|
LAB_reset_search |
LDA Smeml ; get start of mem low byte |
LDX Smemh ; get start of mem high byte |
|
; search for line # in temp (Itempl/Itemph) from (AX) |
|
LAB_go_search |
|
JSR LAB_SHLN ; search Basic for temp integer line number from AX |
BCS LAB_line_found ; if carry set go set pointer |
|
JMP LAB_16F7 ; else go do "Undefined statement" error |
|
LAB_line_found |
; carry already set for subtract |
LDA Baslnl ; get pointer low byte |
SBC #$01 ; -1 |
LDY Baslnh ; get pointer high byte |
BCS LAB_1624 ; branch if no underflow (save DATA pointer and return) |
|
BCC LAB_uflow ; else decrement high byte then save DATA pointer and |
; return (branch always) |
|
; perform NULL |
|
LAB_NULL |
JSR LAB_GTBY ; get byte parameter |
STX Nullct ; save new NULL count |
LAB_167A |
RTS |
|
; perform CONT |
message "LAB_CONT" |
LAB_CONT |
BNE LAB_167A ; if following byte exit to do syntax error |
|
LDY Cpntrh ; get continue pointer high byte |
BNE LAB_166C ; go do continue if we can |
|
LDX #$1E ; error code $1E ("Can't continue" error) |
JMP LAB_XERR ; do error #X, then warm start |
|
; we can continue so .. |
LAB_166C |
LDA #TK_ON ; set token for ON |
JSR LAB_IRQ ; set IRQ flags |
LDA #TK_ON ; set token for ON |
JSR LAB_NMI ; set NMI flags |
|
STY Bpntrh ; save BASIC execute pointer high byte |
LDA Cpntrl ; get continue pointer low byte |
STA Bpntrl ; save BASIC execute pointer low byte |
LDA Blinel ; get break line low byte |
LDY Blineh ; get break line high byte |
STA Clinel ; set current line low byte |
STY Clineh ; set current line high byte |
RTS |
|
; perform RUN |
|
LAB_RUN |
BNE LAB_1696 ; branch if RUN n |
JMP LAB_1477 ; reset execution to start, clear variables, flush stack and |
; return |
|
; does RUN n |
|
LAB_1696 |
JSR LAB_147A ; go do "CLEAR" |
BEQ LAB_16B0 ; get n and do GOTO n (branch always as CLEAR sets Z=1) |
|
; perform DO |
|
LAB_DO |
LDA #$05 ; need 5 bytes for DO |
JSR LAB_1212 ; check room on stack for A bytes |
LDA Bpntrh ; get BASIC execute pointer high byte |
PHA ; push on stack |
LDA Bpntrl ; get BASIC execute pointer low byte |
PHA ; push on stack |
LDA Clineh ; get current line high byte |
PHA ; push on stack |
LDA Clinel ; get current line low byte |
PHA ; push on stack |
LDA #TK_DO ; token for DO |
PHA ; push on stack |
JSR LAB_GBYT ; scan memory |
JMP LAB_15C2 ; go do interpreter inner loop |
|
; perform GOSUB |
|
LAB_GOSUB |
LDA #$05 ; need 5 bytes for GOSUB |
JSR LAB_1212 ; check room on stack for A bytes |
LDA Bpntrh ; get BASIC execute pointer high byte |
PHA ; push on stack |
LDA Bpntrl ; get BASIC execute pointer low byte |
PHA ; push on stack |
LDA Clineh ; get current line high byte |
PHA ; push on stack |
LDA Clinel ; get current line low byte |
PHA ; push on stack |
LDA #TK_GOSUB ; token for GOSUB |
PHA ; push on stack |
LAB_16B0 |
JSR LAB_GBYT ; scan memory |
JSR LAB_GOTO ; perform GOTO n |
JMP LAB_15C2 ; go do interpreter inner loop |
; (can't RTS, we used the stack!) |
|
; perform GOTO |
|
LAB_GOTO |
JSR LAB_GFPN ; get fixed-point number into temp integer |
JSR LAB_SNBL ; scan for next BASIC line |
LDA Clineh ; get current line high byte |
CMP Itemph ; compare with temporary integer high byte |
BCS LAB_16D0 ; branch if >= (start search from beginning) |
|
TYA ; else copy line index to A |
SEC ; set carry (+1) |
ADC Bpntrl ; add BASIC execute pointer low byte |
LDX Bpntrh ; get BASIC execute pointer high byte |
BCC LAB_16D4 ; branch if no overflow to high byte |
|
INX ; increment high byte |
BCS LAB_16D4 ; branch always (can never be carry) |
|
; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml) |
|
LAB_16D0 |
LDA Smeml ; get start of mem low byte |
LDX Smemh ; get start of mem high byte |
|
; search for line # in temp (Itempl/Itemph) from (AX) |
|
LAB_16D4 |
JSR LAB_SHLN ; search Basic for temp integer line number from AX |
BCC LAB_16F7 ; if carry clear go do "Undefined statement" error |
; (unspecified statement) |
|
; carry already set for subtract |
LDA Baslnl ; get pointer low byte |
SBC #$01 ; -1 |
STA Bpntrl ; save BASIC execute pointer low byte |
LDA Baslnh ; get pointer high byte |
SBC #$00 ; subtract carry |
STA Bpntrh ; save BASIC execute pointer high byte |
LAB_16E5 |
RTS |
|
LAB_DONOK |
LDX #$22 ; error code $22 ("LOOP without DO" error) |
JMP LAB_XERR ; do error #X, then warm start |
|
; perform LOOP |
|
LAB_LOOP |
TAY ; save following token |
TSX ; copy stack pointer |
LDA LAB_STAK+3,X ; get token byte from stack |
CMP #TK_DO ; compare with DO token |
BNE LAB_DONOK ; branch if no matching DO |
|
INX ; dump calling routine return address |
INX ; dump calling routine return address |
TXS ; correct stack |
TYA ; get saved following token back |
BEQ LoopAlways ; if no following token loop forever |
; (stack pointer in X) |
|
CMP #':' ; could be ':' |
BEQ LoopAlways ; if :... loop forever |
|
SBC #TK_UNTIL ; subtract token for UNTIL, we know carry is set here |
TAX ; copy to X (if it was UNTIL then Y will be correct) |
BEQ DoRest ; branch if was UNTIL |
|
DEX ; decrement result |
BNE LAB_16FC ; if not WHILE go do syntax error and warm start |
; only if the token was WHILE will this fail |
|
DEX ; set invert result byte |
DoRest |
STX Frnxth ; save invert result byte |
JSR LAB_IGBY ; increment and scan memory |
JSR LAB_EVEX ; evaluate expression |
LDA FAC1_e ; get FAC1 exponent |
BEQ DoCmp ; if =0 go do straight compare |
|
LDA #$FF ; else set all bits |
DoCmp |
TSX ; copy stack pointer |
EOR Frnxth ; EOR with invert byte |
BNE LoopDone ; if <> 0 clear stack and back to interpreter loop |
|
; loop condition wasn't met so do it again |
LoopAlways |
LDA LAB_STAK+2,X ; get current line low byte |
STA Clinel ; save current line low byte |
LDA LAB_STAK+3,X ; get current line high byte |
STA Clineh ; save current line high byte |
LDA LAB_STAK+4,X ; get BASIC execute pointer low byte |
STA Bpntrl ; save BASIC execute pointer low byte |
LDA LAB_STAK+5,X ; get BASIC execute pointer high byte |
STA Bpntrh ; save BASIC execute pointer high byte |
JSR LAB_GBYT ; scan memory |
JMP LAB_15C2 ; go do interpreter inner loop |
|
; clear stack and back to interpreter loop |
LoopDone |
INX ; dump DO token |
INX ; dump current line low byte |
INX ; dump current line high byte |
INX ; dump BASIC execute pointer low byte |
INX ; dump BASIC execute pointer high byte |
TXS ; correct stack |
JMP LAB_DATA ; go perform DATA (find : or [EOL]) |
|
; do the return without gosub error |
|
LAB_16F4 |
LDX #$04 ; error code $04 ("RETURN without GOSUB" error) |
.byte $2C ; makes next line BIT LAB_0EA2 |
|
LAB_16F7 ; do undefined statement error |
LDX #$0E ; error code $0E ("Undefined statement" error) |
JMP LAB_XERR ; do error #X, then warm start |
|
; perform RETURN |
|
LAB_RETURN |
BNE LAB_16E5 ; exit if following token (to allow syntax error) |
|
LAB_16E8 |
PLA ; dump calling routine return address |
PLA ; dump calling routine return address |
PLA ; pull token |
CMP #TK_GOSUB ; compare with GOSUB token |
BNE LAB_16F4 ; branch if no matching GOSUB |
|
LAB_16FF |
PLA ; pull current line low byte |
STA Clinel ; save current line low byte |
PLA ; pull current line high byte |
STA Clineh ; save current line high byte |
PLA ; pull BASIC execute pointer low byte |
STA Bpntrl ; save BASIC execute pointer low byte |
PLA ; pull BASIC execute pointer high byte |
STA Bpntrh ; save BASIC execute pointer high byte |
|
; now do the DATA statement as we could be returning into |
; the middle of an ON <var> GOSUB n,m,p,q line |
; (the return address used by the DATA statement is the one |
; pushed before the GOSUB was executed!) |
|
; perform DATA |
|
LAB_DATA |
JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL]) |
|
; set BASIC execute pointer |
LAB_170F |
TYA ; copy index to A |
CLC ; clear carry for add |
ADC Bpntrl ; add BASIC execute pointer low byte |
STA Bpntrl ; save BASIC execute pointer low byte |
BCC LAB_1719 ; skip next if no carry |
|
INC Bpntrh ; else increment BASIC execute pointer high byte |
LAB_1719 |
RTS |
|
LAB_16FC |
JMP LAB_SNER ; do syntax error then warm start |
|
; scan for next BASIC statement ([:] or [EOL]) |
; returns Y as index to [:] or [EOL] |
|
LAB_SNBS |
LDX #':' ; set look for character = ":" |
.byte $2C ; makes next line BIT $00A2 |
|
; scan for next BASIC line |
; returns Y as index to [EOL] |
|
LAB_SNBL |
LDX #$00 ; set alt search character = [EOL] |
LDY #$00 ; set search character = [EOL] |
STY Asrch ; store search character |
LAB_1725 |
TXA ; get alt search character |
EOR Asrch ; toggle search character, effectively swap with $00 |
STA Asrch ; save swapped search character |
LAB_172D |
LDA (Bpntrl),Y ; get next byte |
BEQ LAB_1719 ; exit if null [EOL] |
|
CMP Asrch ; compare with search character |
BEQ LAB_1719 ; exit if found |
|
INY ; increment index |
CMP #$22 ; compare current character with open quote |
BNE LAB_172D ; if not open quote go get next character |
|
BEQ LAB_1725 ; if found go swap search character for alt search character |
|
; perform IF |
|
LAB_IF |
JSR LAB_EVEX ; evaluate the expression |
JSR LAB_GBYT ; scan memory |
CMP #TK_THEN ; compare with THEN token |
BEQ LAB_174B ; if it was THEN go do IF |
|
; wasn't IF .. THEN so must be IF .. GOTO |
CMP #TK_GOTO ; compare with GOTO token |
BNE LAB_16FC ; if it wasn't GOTO go do syntax error |
|
LDX Bpntrl ; save the basic pointer low byte |
LDY Bpntrh ; save the basic pointer high byte |
JSR LAB_IGBY ; increment and scan memory |
BCS LAB_16FC ; if not numeric go do syntax error |
|
STX Bpntrl ; restore the basic pointer low byte |
STY Bpntrh ; restore the basic pointer high byte |
LAB_174B |
LDA FAC1_e ; get FAC1 exponent |
BEQ LAB_174E ; if the result was zero go look for an ELSE |
|
JSR LAB_IGBY ; else increment and scan memory |
BCS LAB_174D ; if not numeric go do var or keyword |
|
LAB_174C |
JMP LAB_GOTO ; else was numeric so do GOTO n |
message "LAB_174D" |
; is var or keyword |
LAB_174D |
CMP #TK_RETURN ; compare the byte with the token for RETURN |
BNE LAB_174G ; if it wasn't RETURN go interpret BASIC code from (Bpntrl) |
; and return to this code to process any following code |
|
JMP LAB_1602 ; else it was RETURN so interpret BASIC code from (Bpntrl) |
; but don't return here |
|
LAB_174G |
JSR LAB_15FF ; interpret BASIC code from (Bpntrl) |
|
; the IF was executed and there may be a following ELSE so the code needs to return |
; here to check and ignore the ELSE if present |
|
LDY #$00 ; clear the index |
LDA (Bpntrl),Y ; get the next BASIC byte |
CMP #TK_ELSE ; compare it with the token for ELSE |
BEQ LAB_DATA ; if ELSE ignore the following statement |
|
; there was no ELSE so continue execution of IF <expr> THEN <stat> [: <stat>]. any |
; following ELSE will, correctly, cause a syntax error |
|
RTS ; else return to the interpreter inner loop |
|
; perform ELSE after IF |
|
LAB_174E |
LDY #$00 ; clear the BASIC byte index |
LDX #$01 ; clear the nesting depth |
LAB_1750 |
INY ; increment the BASIC byte index |
LDA (Bpntrl),Y ; get the next BASIC byte |
BEQ LAB_1753 ; if EOL go add the pointer and return |
|
CMP #TK_IF ; compare the byte with the token for IF |
BNE LAB_1752 ; if not IF token skip the depth increment |
|
INX ; else increment the nesting depth .. |
BNE LAB_1750 ; .. and continue looking |
|
LAB_1752 |
CMP #TK_ELSE ; compare the byte with the token for ELSE |
BNE LAB_1750 ; if not ELSE token continue looking |
|
DEX ; was ELSE so decrement the nesting depth |
BNE LAB_1750 ; loop if still nested |
|
INY ; increment the BASIC byte index past the ELSE |
|
; found the matching ELSE, now do <{n|statement}> |
|
LAB_1753 |
TYA ; else copy line index to A |
CLC ; clear carry for add |
ADC Bpntrl ; add the BASIC execute pointer low byte |
STA Bpntrl ; save the BASIC execute pointer low byte |
BCC LAB_1754 ; branch if no overflow to high byte |
|
INC Bpntrh ; else increment the BASIC execute pointer high byte |
LAB_1754 |
JSR LAB_GBYT ; scan memory |
BCC LAB_174C ; if numeric do GOTO n |
; the code will return to the interpreter loop at the |
; tail end of the GOTO <n> |
|
JMP LAB_15FF ; interpret BASIC code from (Bpntrl) |
; the code will return to the interpreter loop at the |
; tail end of the <statement> |
|
; perform REM, skip (rest of) line |
|
LAB_REM |
JSR LAB_SNBL ; scan for next BASIC line |
JMP LAB_170F ; go set BASIC execute pointer and return, branch always |
|
LAB_16FD |
JMP LAB_SNER ; do syntax error then warm start |
|
; perform ON |
|
LAB_ON |
CMP #TK_IRQ ; was it IRQ token ? |
BNE LAB_NOIN ; if not go check NMI |
|
JMP LAB_SIRQ ; else go set-up IRQ |
|
LAB_NOIN |
CMP #TK_NMI ; was it NMI token ? |
BNE LAB_NONM ; if not go do normal ON command |
|
JMP LAB_SNMI ; else go set-up NMI |
|
LAB_NONM |
JSR LAB_GTBY ; get byte parameter |
PHA ; push GOTO/GOSUB token |
CMP #TK_GOSUB ; compare with GOSUB token |
BEQ LAB_176B ; branch if GOSUB |
|
CMP #TK_GOTO ; compare with GOTO token |
LAB_1767 |
BNE LAB_16FD ; if not GOTO do syntax error then warm start |
|
|
; next character was GOTO or GOSUB |
|
LAB_176B |
DEC FAC1_3 ; decrement index (byte value) |
BNE LAB_1773 ; branch if not zero |
|
PLA ; pull GOTO/GOSUB token |
JMP LAB_1602 ; go execute it |
|
LAB_1773 |
JSR LAB_IGBY ; increment and scan memory |
JSR LAB_GFPN ; get fixed-point number into temp integer (skip this n) |
; (we could LDX #',' and JSR LAB_SNBL+2, then we |
; just BNE LAB_176B for the loop. should be quicker .. |
; no we can't, what if we meet a colon or [EOL]?) |
CMP #$2C ; compare next character with "," |
BEQ LAB_176B ; loop if "," |
|
LAB_177E |
PLA ; else pull keyword token (run out of options) |
; also dump +/-1 pointer low byte and exit |
LAB_177F |
RTS |
|
; takes n * 106 + 11 cycles where n is the number of digits |
|
; get fixed-point number into temp integer |
|
LAB_GFPN |
LDX #$00 ; clear reg |
STX Itempl ; clear temporary integer low byte |
LAB_1785 |
STX Itemph ; save temporary integer high byte |
BCS LAB_177F ; return if carry set, end of scan, character was |
; not 0-9 |
|
CPX #$19 ; compare high byte with $19 |
TAY ; ensure Zb = 0 if the branch is taken |
BCS LAB_1767 ; branch if >=, makes max line # 63999 because next |
; bit does *$0A, = 64000, compare at target will fail |
; and do syntax error |
|
SBC #'0'-1 ; subtract "0", $2F + carry, from byte |
TAY ; copy binary digit |
LDA Itempl ; get temporary integer low byte |
ASL ; *2 low byte |
ROL Itemph ; *2 high byte |
ASL ; *2 low byte |
ROL Itemph ; *2 high byte, *4 |
ADC Itempl ; + low byte, *5 |
STA Itempl ; save it |
TXA ; get high byte copy to A |
ADC Itemph ; + high byte, *5 |
ASL Itempl ; *2 low byte, *10d |
ROL ; *2 high byte, *10d |
TAX ; copy high byte back to X |
TYA ; get binary digit back |
ADC Itempl ; add number low byte |
STA Itempl ; save number low byte |
BCC LAB_17B3 ; if no overflow to high byte get next character |
|
INX ; else increment high byte |
LAB_17B3 |
JSR LAB_IGBY ; increment and scan memory |
JMP LAB_1785 ; loop for next character |
|
; perform DEC |
|
LAB_DEC |
LDA #<LAB_2AFD ; set -1 pointer low byte |
.byte $2C ; BIT abs to skip the LDA below |
|
; perform INC |
|
LAB_INC |
LDA #<LAB_259C ; set 1 pointer low byte |
LAB_17B5 |
PHA ; save +/-1 pointer low byte |
LAB_17B7 |
JSR LAB_GVAR ; get var address |
LDX Dtypef ; get data type flag, $FF=string, $00=numeric |
BMI IncrErr ; exit if string |
|
STA Lvarpl ; save var address low byte |
STY Lvarph ; save var address high byte |
JSR LAB_UFAC ; unpack memory (AY) into FAC1 |
PLA ; get +/-1 pointer low byte |
PHA ; save +/-1 pointer low byte |
LDY #>LAB_259C ; set +/-1 pointer high byte (both the same) |
JSR LAB_246C ; add (AY) to FAC1 |
JSR LAB_PFAC ; pack FAC1 into variable (Lvarpl) |
|
JSR LAB_GBYT ; scan memory |
CMP #',' ; compare with "," |
BNE LAB_177E ; exit if not "," (either end or error) |
|
; was "," so another INCR variable to do |
JSR LAB_IGBY ; increment and scan memory |
JMP LAB_17B7 ; go do next var |
|
IncrErr |
JMP LAB_1ABC ; do "Type mismatch" error then warm start |
|
; perform LET |
|
LAB_LET |
JSR LAB_GVAR ; get var address |
STA Lvarpl ; save var address low byte |
STY Lvarph ; save var address high byte |
LDA #TK_EQUAL ; get = token |
JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start |
LDA Dtypef ; get data type flag, $FF=string, $00=numeric |
PHA ; push data type flag |
JSR LAB_EVEX ; evaluate expression |
PLA ; pop data type flag |
ROL ; set carry if type = string |
JSR LAB_CKTM ; type match check, set C for string |
BNE LAB_17D5 ; branch if string |
|
JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) and return |
|
; string LET |
|
LAB_17D5 |
LDY #$02 ; set index to pointer high byte |
LDA (des_pl),Y ; get string pointer high byte |
CMP Sstorh ; compare bottom of string space high byte |
BCC LAB_17F4 ; if less assign value and exit (was in program memory) |
|
BNE LAB_17E6 ; branch if > |
; else was equal so compare low bytes |
DEY ; decrement index |
LDA (des_pl),Y ; get pointer low byte |
CMP Sstorl ; compare bottom of string space low byte |
BCC LAB_17F4 ; if less assign value and exit (was in program memory) |
|
; pointer was >= to bottom of string space pointer |
LAB_17E6 |
LDY des_ph ; get descriptor pointer high byte |
CPY Svarh ; compare start of vars high byte |
BCC LAB_17F4 ; branch if less (descriptor is on stack) |
|
BNE LAB_17FB ; branch if greater (descriptor is not on stack) |
|
; else high bytes were equal so .. |
LDA des_pl ; get descriptor pointer low byte |
CMP Svarl ; compare start of vars low byte |
BCS LAB_17FB ; branch if >= (descriptor is not on stack) |
|
LAB_17F4 |
LDA des_pl ; get descriptor pointer low byte |
LDY des_ph ; get descriptor pointer high byte |
JMP LAB_1811 ; clean stack, copy descriptor to variable and return |
|
; make space and copy string |
LAB_17FB |
LDY #$00 ; index to length |
LDA (des_pl),Y ; get string length |
JSR LAB_209C ; copy string |
LDA des_2l ; get descriptor pointer low byte |
LDY des_2h ; get descriptor pointer high byte |
STA ssptr_l ; save descriptor pointer low byte |
STY ssptr_h ; save descriptor pointer high byte |
JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill) |
LDA #<FAC1_e ; set descriptor pointer low byte |
LDY #>FAC1_e ; get descriptor pointer high byte |
|
; clean stack and assign value to string variable |
LAB_1811 |
STA des_2l ; save descriptor_2 pointer low byte |
STY des_2h ; save descriptor_2 pointer high byte |
JSR LAB_22EB ; clean descriptor stack, YA = pointer |
LDY #$00 ; index to length |
LDA (des_2l),Y ; get string length |
STA (Lvarpl),Y ; copy to let string variable |
INY ; index to string pointer low byte |
LDA (des_2l),Y ; get string pointer low byte |
STA (Lvarpl),Y ; copy to let string variable |
INY ; index to string pointer high byte |
LDA (des_2l),Y ; get string pointer high byte |
STA (Lvarpl),Y ; copy to let string variable |
RTS |
|
; perform GET |
|
LAB_GET |
JSR LAB_GVAR ; get var address |
STA Lvarpl ; save var address low byte |
STY Lvarph ; save var address high byte |
JSR INGET ; get input byte |
LDX Dtypef ; get data type flag, $FF=string, $00=numeric |
BMI LAB_GETS ; go get string character |
|
; was numeric get |
TAY ; copy character to Y |
JSR LAB_1FD0 ; convert Y to byte in FAC1 |
JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) and return |
|
LAB_GETS |
PHA ; save character |
LDA #$01 ; string is single byte |
BCS LAB_IsByte ; branch if byte received |
|
PLA ; string is null |
LAB_IsByte |
JSR LAB_MSSP ; make string space A bytes long A=$AC=length, |
; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte |
BEQ LAB_NoSt ; skip store if null string |
|
PLA ; get character back |
LDY #$00 ; clear index |
STA (str_pl),Y ; save byte in string (byte IS string!) |
LAB_NoSt |
JSR LAB_RTST ; check for space on descriptor stack then put address |
; and length on descriptor stack and update stack pointers |
|
JMP LAB_17D5 ; do string LET and return |
|
; perform PRINT |
|
LAB_1829 |
JSR LAB_18C6 ; print string from Sutill/Sutilh |
LAB_182C |
JSR LAB_GBYT ; scan memory |
|
; PRINT |
|
LAB_PRINT |
BEQ LAB_CRLF ; if nothing following just print CR/LF |
|
LAB_1831 |
CMP #TK_TAB ; compare with TAB( token |
BEQ LAB_18A2 ; go do TAB/SPC |
|
CMP #TK_SPC ; compare with SPC( token |
BEQ LAB_18A2 ; go do TAB/SPC |
|
CMP #',' ; compare with "," |
BEQ LAB_188B ; go do move to next TAB mark |
|
CMP #';' ; compare with ";" |
BEQ LAB_18BD ; if ";" continue with PRINT processing |
|
JSR LAB_EVEX ; evaluate expression |
BIT Dtypef ; test data type flag, $FF=string, $00=numeric |
BMI LAB_1829 ; branch if string |
|
JSR LAB_296E ; convert FAC1 to string |
JSR LAB_20AE ; print " terminated string to Sutill/Sutilh |
LDY #$00 ; clear index |
|
; don't check fit if terminal width byte is zero |
|
LDA TWidth ; get terminal width byte |
BEQ LAB_185E ; skip check if zero |
|
SEC ; set carry for subtract |
SBC TPos ; subtract terminal position |
SBC (des_pl),Y ; subtract string length |
BCS LAB_185E ; branch if less than terminal width |
|
JSR LAB_CRLF ; else print CR/LF |
LAB_185E |
JSR LAB_18C6 ; print string from Sutill/Sutilh |
BEQ LAB_182C ; always go continue processing line |
|
; CR/LF return to BASIC from BASIC input handler |
|
LAB_1866 |
LDA #$00 ; clear byte |
STA Ibuffs,X ; null terminate input |
LDX #<Ibuffs ; set X to buffer start-1 low byte |
LDY #>Ibuffs ; set Y to buffer start-1 high byte |
|
; print CR/LF |
|
LAB_CRLF |
LDA #$0D ; load [CR] |
JSR LAB_PRNA ; go print the character |
LDA #$0A ; load [LF] |
BNE LAB_PRNA ; go print the character and return, branch always |
|
LAB_188B |
LDA TPos ; get terminal position |
CMP Iclim ; compare with input column limit |
BCC LAB_1897 ; branch if less |
|
JSR LAB_CRLF ; else print CR/LF (next line) |
BNE LAB_18BD ; continue with PRINT processing (branch always) |
|
LAB_1897 |
SEC ; set carry for subtract |
LAB_1898 |
SBC TabSiz ; subtract TAB size |
BCS LAB_1898 ; loop if result was +ve |
|
EOR #$FF ; complement it |
ADC #$01 ; +1 (twos complement) |
BNE LAB_18B6 ; always print A spaces (result is never $00) |
|
; do TAB/SPC |
LAB_18A2 |
PHA ; save token |
JSR LAB_SGBY ; scan and get byte parameter |
CMP #$29 ; is next character ) |
BNE LAB_1910 ; if not do syntax error then warm start |
|
PLA ; get token back |
CMP #TK_TAB ; was it TAB ? |
BNE LAB_18B7 ; if not go do SPC |
|
; calculate TAB offset |
TXA ; copy integer value to A |
SBC TPos ; subtract terminal position |
BCC LAB_18BD ; branch if result was < 0 (can't TAB backwards) |
|
; print A spaces |
LAB_18B6 |
TAX ; copy result to X |
LAB_18B7 |
TXA ; set flags on size for SPC |
BEQ LAB_18BD ; branch if result was = $0, already here |
|
; print X spaces |
LAB_18BA |
JSR LAB_18E0 ; print " " |
DEX ; decrement count |
BNE LAB_18BA ; loop if not all done |
|
; continue with PRINT processing |
LAB_18BD |
JSR LAB_IGBY ; increment and scan memory |
BNE LAB_1831 ; if more to print go do it |
|
RTS |
|
; print null terminated string from memory |
|
LAB_18C3 |
JSR LAB_20AE ; print " terminated string to Sutill/Sutilh |
|
; print string from Sutill/Sutilh |
|
LAB_18C6 |
JSR LAB_22B6 ; pop string off descriptor stack, or from top of string |
; space returns with A = length, X=$71=pointer low byte, |
; Y=$72=pointer high byte |
LDY #$00 ; reset index |
TAX ; copy length to X |
BEQ LAB_188C ; exit (RTS) if null string |
|
LAB_18CD |
|
LDA (ut1_pl),Y ; get next byte |
JSR LAB_PRNA ; go print the character |
INY ; increment index |
DEX ; decrement count |
BNE LAB_18CD ; loop if not done yet |
|
RTS |
|
; Print single format character |
; print " " |
|
LAB_18E0 |
LDA #$20 ; load " " |
.byte $2C ; change next line to BIT LAB_3FA9 |
|
; print "?" character |
|
LAB_18E3 |
LDA #$3F ; load "?" character |
|
; print character in A |
; now includes the null handler |
; also includes infinite line length code |
; note! some routines expect this one to exit with Zb=0 |
|
LAB_PRNA |
CMP #' ' ; compare with " " |
BCC LAB_18F9 ; branch if less (non printing) |
|
; else printable character |
PHA ; save the character |
|
; don't check fit if terminal width byte is zero |
|
LDA TWidth ; get terminal width |
BNE LAB_18F0 ; branch if not zero (not infinite length) |
|
; is "infinite line" so check TAB position |
|
LDA TPos ; get position |
SBC TabSiz ; subtract TAB size, carry set by CMP #$20 above |
BNE LAB_18F7 ; skip reset if different |
|
STA TPos ; else reset position |
BEQ LAB_18F7 ; go print character |
|
LAB_18F0 |
CMP TPos ; compare with terminal character position |
BNE LAB_18F7 ; branch if not at end of line |
|
JSR LAB_CRLF ; else print CR/LF |
LAB_18F7 |
INC TPos ; increment terminal position |
PLA ; get character back |
LAB_18F9 |
JSR V_OUTP ; output byte via output vector |
CMP #$0D ; compare with [CR] |
BNE LAB_188A ; branch if not [CR] |
|
; else print nullct nulls after the [CR] |
STX TempB ; save buffer index |
LDX Nullct ; get null count |
BEQ LAB_1886 ; branch if no nulls |
|
LDA #$00 ; load [NULL] |
LAB_1880 |
JSR LAB_PRNA ; go print the character |
DEX ; decrement count |
BNE LAB_1880 ; loop if not all done |
|
LDA #$0D ; restore the character (and set the flags) |
LAB_1886 |
STX TPos ; clear terminal position (X always = zero when we get here) |
LDX TempB ; restore buffer index |
LAB_188A |
AND #$FF ; set the flags |
LAB_188C |
RTS |
|
; handle bad input data |
|
LAB_1904 |
LDA Imode ; get input mode flag, $00=INPUT, $00=READ |
BPL LAB_1913 ; branch if INPUT (go do redo) |
|
LDA Dlinel ; get current DATA line low byte |
LDY Dlineh ; get current DATA line high byte |
STA Clinel ; save current line low byte |
STY Clineh ; save current line high byte |
LAB_1910 |
JMP LAB_SNER ; do syntax error then warm start |
|
; mode was INPUT |
LAB_1913 |
LDA #<LAB_REDO ; point to redo message (low addr) |
LDY #>LAB_REDO ; point to redo message (high addr) |
JSR LAB_18C3 ; print null terminated string from memory |
LDA Cpntrl ; get continue pointer low byte |
LDY Cpntrh ; get continue pointer high byte |
STA Bpntrl ; save BASIC execute pointer low byte |
STY Bpntrh ; save BASIC execute pointer high byte |
RTS |
|
; perform INPUT |
|
LAB_INPUT |
CMP #$22 ; compare next byte with open quote |
BNE LAB_1934 ; branch if no prompt string |
|
JSR LAB_1BC1 ; print "..." string |
LDA #$3B ; load A with ";" |
JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start |
JSR LAB_18C6 ; print string from Sutill/Sutilh |
|
; done with prompt, now get data |
LAB_1934 |
JSR LAB_CKRN ; check not Direct, back here if ok |
JSR LAB_INLN ; print "? " and get BASIC input |
LDA #$00 ; set mode = INPUT |
CMP Ibuffs ; test first byte in buffer |
BNE LAB_1953 ; branch if not null input |
|
CLC ; was null input so clear carry to exit program |
JMP LAB_1647 ; go do BREAK exit |
|
; perform READ |
|
LAB_READ |
LDX Dptrl ; get DATA pointer low byte |
LDY Dptrh ; get DATA pointer high byte |
LDA #$80 ; set mode = READ |
|
LAB_1953 |
STA Imode ; set input mode flag, $00=INPUT, $80=READ |
STX Rdptrl ; save READ pointer low byte |
STY Rdptrh ; save READ pointer high byte |
|
; READ or INPUT next variable from list |
LAB_195B |
JSR LAB_GVAR ; get (var) address |
STA Lvarpl ; save address low byte |
STY Lvarph ; save address high byte |
LDA Bpntrl ; get BASIC execute pointer low byte |
LDY Bpntrh ; get BASIC execute pointer high byte |
STA Itempl ; save as temporary integer low byte |
STY Itemph ; save as temporary integer high byte |
LDX Rdptrl ; get READ pointer low byte |
LDY Rdptrh ; get READ pointer high byte |
STX Bpntrl ; set BASIC execute pointer low byte |
STY Bpntrh ; set BASIC execute pointer high byte |
JSR LAB_GBYT ; scan memory |
BNE LAB_1988 ; branch if not null |
|
; pointer was to null entry |
BIT Imode ; test input mode flag, $00=INPUT, $80=READ |
BMI LAB_19DD ; branch if READ |
|
; mode was INPUT |
JSR LAB_18E3 ; print "?" character (double ? for extended input) |
JSR LAB_INLN ; print "? " and get BASIC input |
STX Bpntrl ; set BASIC execute pointer low byte |
STY Bpntrh ; set BASIC execute pointer high byte |
LAB_1985 |
JSR LAB_GBYT ; scan memory |
LAB_1988 |
BIT Dtypef ; test data type flag, $FF=string, $00=numeric |
BPL LAB_19B0 ; branch if numeric |
|
; else get string |
STA Srchc ; save search character |
CMP #$22 ; was it " ? |
BEQ LAB_1999 ; branch if so |
|
LDA #':' ; else search character is ":" |
STA Srchc ; set new search character |
LDA #',' ; other search character is "," |
CLC ; clear carry for add |
LAB_1999 |
STA Asrch ; set second search character |
LDA Bpntrl ; get BASIC execute pointer low byte |
LDY Bpntrh ; get BASIC execute pointer high byte |
|
ADC #$00 ; c is =1 if we came via the BEQ LAB_1999, else =0 |
BCC LAB_19A4 ; branch if no execute pointer low byte rollover |
|
INY ; else increment high byte |
LAB_19A4 |
JSR LAB_20B4 ; print Srchc or Asrch terminated string to Sutill/Sutilh |
JSR LAB_23F3 ; restore BASIC execute pointer from temp (Btmpl/Btmph) |
JSR LAB_17D5 ; go do string LET |
JMP LAB_19B6 ; go check string terminator |
|
; get numeric INPUT |
LAB_19B0 |
JSR LAB_2887 ; get FAC1 from string |
JSR LAB_PFAC ; pack FAC1 into (Lvarpl) |
LAB_19B6 |
JSR LAB_GBYT ; scan memory |
BEQ LAB_19C5 ; branch if null (last entry) |
|
CMP #',' ; else compare with "," |
BEQ LAB_19C2 ; branch if "," |
|
JMP LAB_1904 ; else go handle bad input data |
|
; got good input data |
LAB_19C2 |
JSR LAB_IGBY ; increment and scan memory |
LAB_19C5 |
LDA Bpntrl ; get BASIC execute pointer low byte (temp READ/INPUT ptr) |
LDY Bpntrh ; get BASIC execute pointer high byte (temp READ/INPUT ptr) |
STA Rdptrl ; save for now |
STY Rdptrh ; save for now |
LDA Itempl ; get temporary integer low byte (temp BASIC execute ptr) |
LDY Itemph ; get temporary integer high byte (temp BASIC execute ptr) |
STA Bpntrl ; set BASIC execute pointer low byte |
STY Bpntrh ; set BASIC execute pointer high byte |
JSR LAB_GBYT ; scan memory |
BEQ LAB_1A03 ; if null go do extra ignored message |
|
JSR LAB_1C01 ; else scan for "," , else do syntax error then warm start |
JMP LAB_195B ; go INPUT next variable from list |
|
; find next DATA statement or do "Out of DATA" error |
LAB_19DD |
JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL]) |
INY ; increment index |
TAX ; copy character ([:] or [EOL]) |
BNE LAB_19F6 ; branch if [:] |
|
LDX #$06 ; set for "Out of DATA" error |
INY ; increment index, now points to next line pointer high byte |
LDA (Bpntrl),Y ; get next line pointer high byte |
BEQ LAB_1A54 ; branch if end (eventually does error X) |
|
INY ; increment index |
LDA (Bpntrl),Y ; get next line # low byte |
STA Dlinel ; save current DATA line low byte |
INY ; increment index |
LDA (Bpntrl),Y ; get next line # high byte |
INY ; increment index |
STA Dlineh ; save current DATA line high byte |
LAB_19F6 |
LDA (Bpntrl),Y ; get byte |
INY ; increment index |
TAX ; copy to X |
JSR LAB_170F ; set BASIC execute pointer |
CPX #TK_DATA ; compare with "DATA" token |
BEQ LAB_1985 ; was "DATA" so go do next READ |
|
BNE LAB_19DD ; go find next statement if not "DATA" |
|
; end of INPUT/READ routine |
|
LAB_1A03 |
LDA Rdptrl ; get temp READ pointer low byte |
LDY Rdptrh ; get temp READ pointer high byte |
LDX Imode ; get input mode flag, $00=INPUT, $80=READ |
BPL LAB_1A0E ; branch if INPUT |
|
JMP LAB_1624 ; save AY as DATA pointer and return |
|
; we were getting INPUT |
LAB_1A0E |
LDY #$00 ; clear index |
LDA (Rdptrl),Y ; get next byte |
BNE LAB_1A1B ; error if not end of INPUT |
|
RTS |
|
; user typed too much |
LAB_1A1B |
LDA #<LAB_IMSG ; point to extra ignored message (low addr) |
LDY #>LAB_IMSG ; point to extra ignored message (high addr) |
JMP LAB_18C3 ; print null terminated string from memory and return |
|
; search the stack for FOR activity |
; exit with z=1 if FOR else exit with z=0 |
|
LAB_11A1 |
TSX ; copy stack pointer |
INX ; +1 pass return address |
INX ; +2 pass return address |
INX ; +3 pass calling routine return address |
INX ; +4 pass calling routine return address |
LAB_11A6 |
LDA LAB_STAK+1,X ; get token byte from stack |
CMP #TK_FOR ; is it FOR token |
BNE LAB_11CE ; exit if not FOR token |
|
; was FOR token |
LDA Frnxth ; get var pointer for FOR/NEXT high byte |
BNE LAB_11BB ; branch if not null |
|
LDA LAB_STAK+2,X ; get FOR variable pointer low byte |
STA Frnxtl ; save var pointer for FOR/NEXT low byte |
LDA LAB_STAK+3,X ; get FOR variable pointer high byte |
STA Frnxth ; save var pointer for FOR/NEXT high byte |
LAB_11BB |
CMP LAB_STAK+3,X ; compare var pointer with stacked var pointer (high byte) |
BNE LAB_11C7 ; branch if no match |
|
LDA Frnxtl ; get var pointer for FOR/NEXT low byte |
CMP LAB_STAK+2,X ; compare var pointer with stacked var pointer (low byte) |
BEQ LAB_11CE ; exit if match found |
|
LAB_11C7 |
TXA ; copy index |
CLC ; clear carry for add |
ADC #$10 ; add FOR stack use size |
TAX ; copy back to index |
BNE LAB_11A6 ; loop if not at start of stack |
|
LAB_11CE |
RTS |
|
; perform NEXT |
|
LAB_NEXT |
BNE LAB_1A46 ; branch if NEXT var |
|
LDY #$00 ; else clear Y |
BEQ LAB_1A49 ; branch always (no variable to search for) |
|
; NEXT var |
|
LAB_1A46 |
JSR LAB_GVAR ; get variable address |
LAB_1A49 |
STA Frnxtl ; store variable pointer low byte |
STY Frnxth ; store variable pointer high byte |
; (both cleared if no variable defined) |
JSR LAB_11A1 ; search the stack for FOR activity |
BEQ LAB_1A56 ; branch if found |
|
LDX #$00 ; else set error $00 ("NEXT without FOR" error) |
LAB_1A54 |
BEQ LAB_1ABE ; do error #X, then warm start |
|
LAB_1A56 |
TXS ; set stack pointer, X set by search, dumps return addresses |
|
TXA ; copy stack pointer |
SEC ; set carry for subtract |
SBC #$F7 ; point to TO var |
STA ut2_pl ; save pointer to TO var for compare |
ADC #$FB ; point to STEP var |
|
LDY #>LAB_STAK ; point to stack page high byte |
JSR LAB_UFAC ; unpack memory (STEP value) into FAC1 |
TSX ; get stack pointer back |
LDA LAB_STAK+8,X ; get step sign |
STA FAC1_s ; save FAC1 sign (b7) |
LDA Frnxtl ; get FOR variable pointer low byte |
LDY Frnxth ; get FOR variable pointer high byte |
JSR LAB_246C ; add (FOR variable) to FAC1 |
JSR LAB_PFAC ; pack FAC1 into (FOR variable) |
LDY #>LAB_STAK ; point to stack page high byte |
JSR LAB_27FA ; compare FAC1 with (Y,ut2_pl) (TO value) |
TSX ; get stack pointer back |
CMP LAB_STAK+8,X ; compare step sign |
BEQ LAB_1A9B ; branch if = (loop complete) |
|
; loop back and do it all again |
LDA LAB_STAK+$0D,X ; get FOR line low byte |
STA Clinel ; save current line low byte |
LDA LAB_STAK+$0E,X ; get FOR line high byte |
STA Clineh ; save current line high byte |
LDA LAB_STAK+$10,X ; get BASIC execute pointer low byte |
STA Bpntrl ; save BASIC execute pointer low byte |
LDA LAB_STAK+$0F,X ; get BASIC execute pointer high byte |
STA Bpntrh ; save BASIC execute pointer high byte |
LAB_1A98 |
JMP LAB_15C2 ; go do interpreter inner loop |
|
; loop complete so carry on |
LAB_1A9B |
TXA ; stack copy to A |
ADC #$0F ; add $10 ($0F+carry) to dump FOR structure |
TAX ; copy back to index |
TXS ; copy to stack pointer |
JSR LAB_GBYT ; scan memory |
CMP #',' ; compare with "," |
BNE LAB_1A98 ; branch if not "," (go do interpreter inner loop) |
|
; was "," so another NEXT variable to do |
JSR LAB_IGBY ; else increment and scan memory |
JSR LAB_1A46 ; do NEXT (var) |
|
; evaluate expression and check is numeric, else do type mismatch |
|
LAB_EVNM |
JSR LAB_EVEX ; evaluate expression |
|
; check if source is numeric, else do type mismatch |
|
LAB_CTNM |
CLC ; destination is numeric |
.byte $24 ; makes next line BIT $38 |
|
; check if source is string, else do type mismatch |
|
LAB_CTST |
SEC ; required type is string |
|
; type match check, set C for string, clear C for numeric |
|
LAB_CKTM |
BIT Dtypef ; test data type flag, $FF=string, $00=numeric |
BMI LAB_1ABA ; branch if data type is string |
|
; else data type was numeric |
BCS LAB_1ABC ; if required type is string do type mismatch error |
LAB_1AB9 |
RTS |
|
; data type was string, now check required type |
LAB_1ABA |
BCS LAB_1AB9 ; exit if required type is string |
|
; else do type mismatch error |
LAB_1ABC |
LDX #$18 ; error code $18 ("Type mismatch" error) |
LAB_1ABE |
JMP LAB_XERR ; do error #X, then warm start |
|
; evaluate expression |
|
LAB_EVEX |
LDX Bpntrl ; get BASIC execute pointer low byte |
BNE LAB_1AC7 ; skip next if not zero |
|
DEC Bpntrh ; else decrement BASIC execute pointer high byte |
LAB_1AC7 |
DEC Bpntrl ; decrement BASIC execute pointer low byte |
|
LAB_EVEZ |
LDA #$00 ; set null precedence (flag done) |
LAB_1ACC |
PHA ; push precedence byte |
LDA #$02 ; 2 bytes |
JSR LAB_1212 ; check room on stack for A bytes |
JSR LAB_GVAL ; get value from line |
LDA #$00 ; clear A |
STA comp_f ; clear compare function flag |
LAB_1ADB |
JSR LAB_GBYT ; scan memory |
LAB_1ADE |
SEC ; set carry for subtract |
SBC #TK_GT ; subtract token for > (lowest comparison function) |
BCC LAB_1AFA ; branch if < TK_GT |
|
CMP #$03 ; compare with ">" to "<" tokens |
BCS LAB_1AFA ; branch if >= TK_SGN (highest evaluation function +1) |
|
; was token for > = or < (A = 0, 1 or 2) |
CMP #$01 ; compare with token for = |
ROL ; *2, b0 = carry (=1 if token was = or <) |
; (A = 0, 3 or 5) |
EOR #$01 ; toggle b0 |
; (A = 1, 2 or 4. 1 if >, 2 if =, 4 if <) |
EOR comp_f ; EOR with compare function flag bits |
CMP comp_f ; compare with compare function flag |
BCC LAB_1B53 ; if <(comp_f) do syntax error then warm start |
; was more than one <, = or >) |
|
STA comp_f ; save new compare function flag |
JSR LAB_IGBY ; increment and scan memory |
JMP LAB_1ADE ; go do next character |
|
; token is < ">" or > "<" tokens |
LAB_1AFA |
LDX comp_f ; get compare function flag |
BNE LAB_1B2A ; branch if compare function |
|
BCS LAB_1B78 ; go do functions |
|
; else was < TK_GT so is operator or lower |
ADC #TK_GT-TK_PLUS ; add # of operators (+, -, *, /, ^, AND, OR or EOR) |
BCC LAB_1B78 ; branch if < + operator |
|
; carry was set so token was +, -, *, /, ^, AND, OR or EOR |
BNE LAB_1B0B ; branch if not + token |
|
BIT Dtypef ; test data type flag, $FF=string, $00=numeric |
BPL LAB_1B0B ; branch if not string |
|
; will only be $00 if type is string and token was + |
JMP LAB_224D ; add strings, string 1 is in descriptor des_pl, string 2 |
; is in line, and return |
|
LAB_1B0B |
STA ut1_pl ; save it |
ASL ; *2 |
ADC ut1_pl ; *3 |
TAY ; copy to index |
LAB_1B13 |
PLA ; pull previous precedence |
CMP LAB_OPPT,Y ; compare with precedence byte |
BCS LAB_1B7D ; branch if A >= |
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch |
LAB_1B1C |
PHA ; save precedence |
LAB_1B1D |
JSR LAB_1B43 ; get vector, execute function then continue evaluation |
PLA ; restore precedence |
LDY prstk ; get precedence stacked flag |
BPL LAB_1B3C ; branch if stacked values |
|
TAX ; copy precedence (set flags) |
BEQ LAB_1B9D ; exit if done |
|
BNE LAB_1B86 ; else pop FAC2 and return, branch always |
|
LAB_1B2A |
ROL Dtypef ; shift data type flag into Cb |
TXA ; copy compare function flag |
STA Dtypef ; clear data type flag, X is 0xxx xxxx |
ROL ; shift data type into compare function byte b0 |
LDX Bpntrl ; get BASIC execute pointer low byte |
BNE LAB_1B34 ; branch if no underflow |
|
DEC Bpntrh ; else decrement BASIC execute pointer high byte |
LAB_1B34 |
DEC Bpntrl ; decrement BASIC execute pointer low byte |
TK_LT_PLUS = TK_LT-TK_PLUS |
LDY #TK_LT_PLUS*3 ; set offset to last operator entry |
STA comp_f ; save new compare function flag |
BNE LAB_1B13 ; branch always |
|
LAB_1B3C |
CMP LAB_OPPT,Y ;.compare with stacked function precedence |
BCS LAB_1B86 ; branch if A >=, pop FAC2 and return |
|
BCC LAB_1B1C ; branch always |
|
;.get vector, execute function then continue evaluation |
|
LAB_1B43 |
LDA LAB_OPPT+2,Y ; get function vector high byte |
PHA ; onto stack |
LDA LAB_OPPT+1,Y ; get function vector low byte |
PHA ; onto stack |
; now push sign, round FAC1 and put on stack |
JSR LAB_1B5B ; function will return here, then the next RTS will call |
; the function |
LDA comp_f ; get compare function flag |
PHA ; push compare evaluation byte |
LDA LAB_OPPT,Y ; get precedence byte |
JMP LAB_1ACC ; continue evaluating expression |
|
LAB_1B53 |
JMP LAB_SNER ; do syntax error then warm start |
|
; push sign, round FAC1 and put on stack |
|
LAB_1B5B |
PLA ; get return addr low byte |
STA ut1_pl ; save it |
INC ut1_pl ; increment it (was ret-1 pushed? yes!) |
; note! no check is made on the high byte! if the calling |
; routine assembles to a page edge then this all goes |
; horribly wrong !!! |
PLA ; get return addr high byte |
STA ut1_ph ; save it |
LDA FAC1_s ; get FAC1 sign (b7) |
PHA ; push sign |
|
; round FAC1 and put on stack |
|
LAB_1B66 |
JSR LAB_27BA ; round FAC1 |
LDA FAC1_3 ; get FAC1 mantissa3 |
PHA ; push on stack |
LDA FAC1_2 ; get FAC1 mantissa2 |
PHA ; push on stack |
LDA FAC1_1 ; get FAC1 mantissa1 |
PHA ; push on stack |
LDA FAC1_e ; get FAC1 exponent |
PHA ; push on stack |
JMP (ut1_pl) ; return, sort of |
|
; do functions |
|
LAB_1B78 |
LDY #$FF ; flag function |
PLA ; pull precedence byte |
LAB_1B7B |
BEQ LAB_1B9D ; exit if done |
|
LAB_1B7D |
CMP #$64 ; compare previous precedence with $64 |
BEQ LAB_1B84 ; branch if was $64 (< function) |
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch |
LAB_1B84 |
STY prstk ; save precedence stacked flag |
|
; pop FAC2 and return |
LAB_1B86 |
PLA ; pop byte |
LSR ; shift out comparison evaluation lowest bit |
STA Cflag ; save comparison evaluation flag |
PLA ; pop exponent |
STA FAC2_e ; save FAC2 exponent |
PLA ; pop mantissa1 |
STA FAC2_1 ; save FAC2 mantissa1 |
PLA ; pop mantissa2 |
STA FAC2_2 ; save FAC2 mantissa2 |
PLA ; pop mantissa3 |
STA FAC2_3 ; save FAC2 mantissa3 |
PLA ; pop sign |
STA FAC2_s ; save FAC2 sign (b7) |
EOR FAC1_s ; EOR FAC1 sign (b7) |
STA FAC_sc ; save sign compare (FAC1 EOR FAC2) |
LAB_1B9D |
LDA FAC1_e ; get FAC1 exponent |
RTS |
|
; print "..." string to string util area |
|
LAB_1BC1 |
LDA Bpntrl ; get BASIC execute pointer low byte |
LDY Bpntrh ; get BASIC execute pointer high byte |
ADC #$00 ; add carry to low byte |
BCC LAB_1BCA ; branch if no overflow |
|
INY ; increment high byte |
LAB_1BCA |
JSR LAB_20AE ; print " terminated string to Sutill/Sutilh |
JMP LAB_23F3 ; restore BASIC execute pointer from temp and return |
|
; get value from line |
|
LAB_GVAL |
JSR LAB_IGBY ; increment and scan memory |
BCS LAB_1BAC ; branch if not numeric character |
|
; else numeric string found (e.g. 123) |
LAB_1BA9 |
JMP LAB_2887 ; get FAC1 from string and return |
|
; get value from line .. continued |
|
; wasn't a number so .. |
LAB_1BAC |
TAX ; set the flags |
BMI LAB_1BD0 ; if -ve go test token values |
|
; else it is either a string, number, variable or (<expr>) |
CMP #'$' ; compare with "$" |
BEQ LAB_1BA9 ; branch if "$", hex number |
|
CMP #'%' ; else compare with "%" |
BEQ LAB_1BA9 ; branch if "%", binary number |
|
CMP #'.' ; compare with "." |
BEQ LAB_1BA9 ; if so get FAC1 from string and return (e.g. was .123) |
|
; it wasn't any sort of number so .. |
CMP #$22 ; compare with " |
BEQ LAB_1BC1 ; branch if open quote |
|
; wasn't any sort of number so .. |
|
; evaluate expression within parentheses |
|
CMP #'(' ; compare with "(" |
BNE LAB_1C18 ; if not "(" get (var), return value in FAC1 and $ flag |
|
LAB_1BF7 |
JSR LAB_EVEZ ; evaluate expression, no decrement |
|
; all the 'scan for' routines return the character after the sought character |
|
; scan for ")" , else do syntax error then warm start |
|
LAB_1BFB |
LDA #$29 ; load A with ")" |
|
; scan for CHR$(A) , else do syntax error then warm start |
|
LAB_SCCA |
LDY #$00 ; clear index |
CMP (Bpntrl),Y ; check next byte is = A |
BNE LAB_SNER ; if not do syntax error then warm start |
|
JMP LAB_IGBY ; increment and scan memory then return |
|
; scan for "(" , else do syntax error then warm start |
|
LAB_1BFE |
LDA #$28 ; load A with "(" |
BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start |
; (branch always) |
|
; scan for "," , else do syntax error then warm start |
|
LAB_1C01 |
LDA #$2C ; load A with "," |
BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start |
; (branch always) |
|
; syntax error then warm start |
|
LAB_SNER |
LDX #$02 ; error code $02 ("Syntax" error) |
JMP LAB_XERR ; do error #X, then warm start |
|
; get value from line .. continued |
; do tokens |
|
LAB_1BD0 |
CMP #TK_MINUS ; compare with token for - |
BEQ LAB_1C11 ; branch if - token (do set-up for functions) |
|
; wasn't -n so .. |
CMP #TK_PLUS ; compare with token for + |
BEQ LAB_GVAL ; branch if + token (+n = n so ignore leading +) |
|
CMP #TK_NOT ; compare with token for NOT |
BNE LAB_1BE7 ; branch if not token for NOT |
|
; was NOT token |
TK_EQUAL_PLUS = TK_EQUAL-TK_PLUS |
LDY #TK_EQUAL_PLUS*3 ; offset to NOT function |
BNE LAB_1C13 ; do set-up for function then execute (branch always) |
|
; do = compare |
|
LAB_EQUAL |
JSR LAB_EVIR ; evaluate integer expression (no sign check) |
LDA FAC1_3 ; get FAC1 mantissa3 |
EOR #$FF ; invert it |
TAY ; copy it |
LDA FAC1_2 ; get FAC1 mantissa2 |
EOR #$FF ; invert it |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; get value from line .. continued |
|
; wasn't +, -, or NOT so .. |
LAB_1BE7 |
CMP #TK_FN ; compare with token for FN |
BNE LAB_1BEE ; branch if not token for FN |
|
JMP LAB_201E ; go evaluate FNx |
|
; get value from line .. continued |
|
; wasn't +, -, NOT or FN so .. |
LAB_1BEE |
SBC #TK_SGN ; subtract with token for SGN |
BCS LAB_1C27 ; if a function token go do it |
|
JMP LAB_SNER ; else do syntax error |
|
; set-up for functions |
|
LAB_1C11 |
TK_GT_PLUS = TK_GT-TK_PLUS |
LDY #TK_GT_PLUS*3 ; set offset from base to > operator |
LAB_1C13 |
PLA ; dump return address low byte |
PLA ; dump return address high byte |
JMP LAB_1B1D ; execute function then continue evaluation |
|
; variable name set-up |
; get (var), return value in FAC_1 and $ flag |
|
LAB_1C18 |
JSR LAB_GVAR ; get (var) address |
STA FAC1_2 ; save address low byte in FAC1 mantissa2 |
STY FAC1_3 ; save address high byte in FAC1 mantissa3 |
LDX Dtypef ; get data type flag, $FF=string, $00=numeric |
BMI LAB_1C25 ; if string then return (does RTS) |
|
LAB_1C24 |
JMP LAB_UFAC ; unpack memory (AY) into FAC1 |
|
LAB_1C25 |
RTS |
|
; get value from line .. continued |
; only functions left so .. |
|
; set up function references |
|
; new for V2.0+ this replaces a lot of IF .. THEN .. ELSEIF .. THEN .. that was needed |
; to process function calls. now the function vector is computed and pushed on the stack |
; and the preprocess offset is read. if the preprocess offset is non zero then the vector |
; is calculated and the routine called, if not this routine just does RTS. whichever |
; happens the RTS at the end of this routine, or the end of the preprocess routine, calls |
; the function code |
|
; this also removes some less than elegant code that was used to bypass type checking |
; for functions that returned strings |
|
LAB_1C27 |
ASL ; *2 (2 bytes per function address) |
TAY ; copy to index |
|
LDA LAB_FTBM,Y ; get function jump vector high byte |
PHA ; push functions jump vector high byte |
LDA LAB_FTBL,Y ; get function jump vector low byte |
PHA ; push functions jump vector low byte |
|
LDA LAB_FTPM,Y ; get function pre process vector high byte |
BEQ LAB_1C56 ; skip pre process if null vector |
|
PHA ; push functions pre process vector high byte |
LDA LAB_FTPL,Y ; get function pre process vector low byte |
PHA ; push functions pre process vector low byte |
|
LAB_1C56 |
RTS ; do function, or pre process, call |
|
; process string expression in parenthesis |
|
LAB_PPFS |
JSR LAB_1BF7 ; process expression in parenthesis |
JMP LAB_CTST ; check if source is string then do function, |
; else do type mismatch |
|
; process numeric expression in parenthesis |
|
LAB_PPFN |
JSR LAB_1BF7 ; process expression in parenthesis |
JMP LAB_CTNM ; check if source is numeric then do function, |
; else do type mismatch |
|
; set numeric data type and increment BASIC execute pointer |
|
LAB_PPBI |
LSR Dtypef ; clear data type flag, $FF=string, $00=numeric |
JMP LAB_IGBY ; increment and scan memory then do function |
|
; process string for LEFT$, RIGHT$ or MID$ |
|
LAB_LRMS |
JSR LAB_EVEZ ; evaluate (should be string) expression |
JSR LAB_1C01 ; scan for ",", else do syntax error then warm start |
JSR LAB_CTST ; check if source is string, else do type mismatch |
|
PLA ; get function jump vector low byte |
TAX ; save functions jump vector low byte |
PLA ; get function jump vector high byte |
TAY ; save functions jump vector high byte |
LDA des_ph ; get descriptor pointer high byte |
PHA ; push string pointer high byte |
LDA des_pl ; get descriptor pointer low byte |
PHA ; push string pointer low byte |
TYA ; get function jump vector high byte back |
PHA ; save functions jump vector high byte |
TXA ; get function jump vector low byte back |
PHA ; save functions jump vector low byte |
JSR LAB_GTBY ; get byte parameter |
TXA ; copy byte parameter to A |
RTS ; go do function |
|
; process numeric expression(s) for BIN$ or HEX$ |
|
LAB_BHSS |
JSR LAB_EVEZ ; process expression |
JSR LAB_CTNM ; check if source is numeric, else do type mismatch |
LDA FAC1_e ; get FAC1 exponent |
CMP #$98 ; compare with exponent = 2^24 |
BCS LAB_BHER ; branch if n>=2^24 (is too big) |
|
JSR LAB_2831 ; convert FAC1 floating-to-fixed |
LDX #$02 ; 3 bytes to do |
LAB_CFAC |
LDA FAC1_1,X ; get byte from FAC1 |
STA nums_1,X ; save byte to temp |
DEX ; decrement index |
BPL LAB_CFAC ; copy FAC1 mantissa to temp |
|
JSR LAB_GBYT ; get next BASIC byte |
LDX #$00 ; set default to no leading "0"s |
CMP #')' ; compare with close bracket |
BEQ LAB_1C54 ; if ")" go do rest of function |
|
JSR LAB_SCGB ; scan for "," and get byte |
JSR LAB_GBYT ; get last byte back |
CMP #')' ; is next character ) |
BNE LAB_BHER ; if not ")" go do error |
|
LAB_1C54 |
RTS ; else do function |
|
LAB_BHER |
JMP LAB_FCER ; do function call error then warm start |
|
; perform EOR |
|
; added operator format is the same as AND or OR, precedence is the same as OR |
|
; this bit worked first time but it took a while to sort out the operator table |
; pointers and offsets afterwards! |
|
LAB_EOR |
JSR GetFirst ; get first integer expression (no sign check) |
EOR XOAw_l ; EOR with expression 1 low byte |
TAY ; save in Y |
LDA FAC1_2 ; get FAC1 mantissa2 |
EOR XOAw_h ; EOR with expression 1 high byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; perform OR |
|
LAB_OR |
JSR GetFirst ; get first integer expression (no sign check) |
ORA XOAw_l ; OR with expression 1 low byte |
TAY ; save in Y |
LDA FAC1_2 ; get FAC1 mantissa2 |
ORA XOAw_h ; OR with expression 1 high byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; perform AND |
|
LAB_AND |
JSR GetFirst ; get first integer expression (no sign check) |
AND XOAw_l ; AND with expression 1 low byte |
TAY ; save in Y |
LDA FAC1_2 ; get FAC1 mantissa2 |
AND XOAw_h ; AND with expression 1 high byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; get first value for OR, AND or EOR |
|
GetFirst |
JSR LAB_EVIR ; evaluate integer expression (no sign check) |
LDA FAC1_2 ; get FAC1 mantissa2 |
STA XOAw_h ; save it |
LDA FAC1_3 ; get FAC1 mantissa3 |
STA XOAw_l ; save it |
JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression) |
JSR LAB_EVIR ; evaluate integer expression (no sign check) |
LDA FAC1_3 ; get FAC1 mantissa3 |
LAB_1C95 |
RTS |
|
; perform comparisons |
|
; do < compare |
|
LAB_LTHAN |
JSR LAB_CKTM ; type match check, set C for string |
BCS LAB_1CAE ; branch if string |
|
; do numeric < compare |
LDA FAC2_s ; get FAC2 sign (b7) |
ORA #$7F ; set all non sign bits |
AND FAC2_1 ; and FAC2 mantissa1 (AND in sign bit) |
STA FAC2_1 ; save FAC2 mantissa1 |
LDA #<FAC2_e ; set pointer low byte to FAC2 |
LDY #>FAC2_e ; set pointer high byte to FAC2 |
JSR LAB_27F8 ; compare FAC1 with FAC2 (AY) |
TAX ; copy result |
JMP LAB_1CE1 ; go evaluate result |
|
; do string < compare |
LAB_1CAE |
LSR Dtypef ; clear data type flag, $FF=string, $00=numeric |
DEC comp_f ; clear < bit in compare function flag |
JSR LAB_22B6 ; pop string off descriptor stack, or from top of string |
; space returns with A = length, X=pointer low byte, |
; Y=pointer high byte |
STA str_ln ; save length |
STX str_pl ; save string pointer low byte |
STY str_ph ; save string pointer high byte |
LDA FAC2_2 ; get descriptor pointer low byte |
LDY FAC2_3 ; get descriptor pointer high byte |
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space |
; returns with A = length, X=pointer low byte, |
; Y=pointer high byte |
STX FAC2_2 ; save string pointer low byte |
STY FAC2_3 ; save string pointer high byte |
TAX ; copy length |
SEC ; set carry for subtract |
SBC str_ln ; subtract string 1 length |
BEQ LAB_1CD6 ; branch if str 1 length = string 2 length |
|
LDA #$01 ; set str 1 length > string 2 length |
BCC LAB_1CD6 ; branch if so |
|
LDX str_ln ; get string 1 length |
LDA #$FF ; set str 1 length < string 2 length |
LAB_1CD6 |
STA FAC1_s ; save length compare |
LDY #$FF ; set index |
INX ; adjust for loop |
LAB_1CDB |
INY ; increment index |
DEX ; decrement count |
BNE LAB_1CE6 ; branch if still bytes to do |
|
LDX FAC1_s ; get length compare back |
LAB_1CE1 |
BMI LAB_1CF2 ; branch if str 1 < str 2 |
|
CLC ; flag str 1 <= str 2 |
BCC LAB_1CF2 ; go evaluate result |
|
LAB_1CE6 |
LDA (FAC2_2),Y ; get string 2 byte |
CMP (FAC1_1),Y ; compare with string 1 byte |
BEQ LAB_1CDB ; loop if bytes = |
|
LDX #$FF ; set str 1 < string 2 |
BCS LAB_1CF2 ; branch if so |
|
LDX #$01 ; set str 1 > string 2 |
LAB_1CF2 |
INX ; x = 0, 1 or 2 |
TXA ; copy to A |
ROL ; *2 (1, 2 or 4) |
AND Cflag ; AND with comparison evaluation flag |
BEQ LAB_1CFB ; branch if 0 (compare is false) |
|
LDA #$FF ; else set result true |
LAB_1CFB |
JMP LAB_27DB ; save A as integer byte and return |
|
LAB_1CFE |
JSR LAB_1C01 ; scan for ",", else do syntax error then warm start |
|
; perform DIM |
|
LAB_DIM |
TAX ; copy "DIM" flag to X |
JSR LAB_1D10 ; search for variable |
JSR LAB_GBYT ; scan memory |
BNE LAB_1CFE ; scan for "," and loop if not null |
|
RTS |
|
; perform << (left shift) |
|
LAB_LSHIFT |
JSR GetPair ; get integer expression and byte (no sign check) |
LDA FAC1_2 ; get expression high byte |
LDX TempB ; get shift count |
BEQ NoShift ; branch if zero |
|
CPX #$10 ; compare bit count with 16d |
BCS TooBig ; branch if >= |
|
Ls_loop |
ASL FAC1_3 ; shift low byte |
ROL ; shift high byte |
DEX ; decrement bit count |
BNE Ls_loop ; loop if shift not complete |
|
LDY FAC1_3 ; get expression low byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; perform >> (right shift) |
|
LAB_RSHIFT |
JSR GetPair ; get integer expression and byte (no sign check) |
LDA FAC1_2 ; get expression high byte |
LDX TempB ; get shift count |
BEQ NoShift ; branch if zero |
|
CPX #$10 ; compare bit count with 16d |
BCS TooBig ; branch if >= |
|
Rs_loop |
LSR ; shift high byte |
ROR FAC1_3 ; shift low byte |
DEX ; decrement bit count |
BNE Rs_loop ; loop if shift not complete |
|
NoShift |
LDY FAC1_3 ; get expression low byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
TooBig |
LDA #$00 ; clear high byte |
TAY ; copy to low byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
GetPair |
JSR LAB_EVBY ; evaluate byte expression, result in X |
STX TempB ; save it |
JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression) |
JMP LAB_EVIR ; evaluate integer expression (no sign check) |
|
; search for variable |
|
; return pointer to variable in Cvaral/Cvarah |
|
LAB_GVAR |
LDX #$00 ; set DIM flag = $00 |
JSR LAB_GBYT ; scan memory (1st character) |
LAB_1D10 |
STX Defdim ; save DIM flag |
LAB_1D12 |
STA Varnm1 ; save 1st character |
AND #$7F ; clear FN flag bit |
JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z" |
BCS LAB_1D1F ; branch if ok |
|
JMP LAB_SNER ; else syntax error then warm start |
|
; was variable name so .. |
LAB_1D1F |
LDX #$00 ; clear 2nd character temp |
STX Dtypef ; clear data type flag, $FF=string, $00=numeric |
JSR LAB_IGBY ; increment and scan memory (2nd character) |
BCC LAB_1D2D ; branch if character = "0"-"9" (ok) |
|
; 2nd character wasn't "0" to "9" so .. |
JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z" |
BCC LAB_1D38 ; branch if <"A" or >"Z" (go check if string) |
|
LAB_1D2D |
TAX ; copy 2nd character |
|
; ignore further (valid) characters in the variable name |
LAB_1D2E |
JSR LAB_IGBY ; increment and scan memory (3rd character) |
BCC LAB_1D2E ; loop if character = "0"-"9" (ignore) |
|
JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z" |
BCS LAB_1D2E ; loop if character = "A"-"Z" (ignore) |
|
; check if string variable |
LAB_1D38 |
CMP #'$' ; compare with "$" |
BNE LAB_1D47 ; branch if not string |
|
; to introduce a new variable type (% suffix for integers say) then this branch |
; will need to go to that check and then that branch, if it fails, go to LAB_1D47 |
|
; type is string |
LDA #$FF ; set data type = string |
STA Dtypef ; set data type flag, $FF=string, $00=numeric |
TXA ; get 2nd character back |
ORA #$80 ; set top bit (indicate string var) |
TAX ; copy back to 2nd character temp |
JSR LAB_IGBY ; increment and scan memory |
|
; after we have determined the variable type we need to come back here to determine |
; if it's an array of type. this would plug in a%(b[,c[,d]])) integer arrays nicely |
|
|
LAB_1D47 ; gets here with character after var name in A |
STX Varnm2 ; save 2nd character |
ORA Sufnxf ; or with subscript/FNX flag (or FN name) |
CMP #'(' ; compare with "(" |
BNE LAB_1D53 ; branch if not "(" |
|
JMP LAB_1E17 ; go find, or make, array |
|
; either find or create var |
; var name (1st two characters only!) is in Varnm1,Varnm2 |
|
; variable name wasn't var(... so look for plain var |
LAB_1D53 |
LDA #$00 ; clear A |
STA Sufnxf ; clear subscript/FNX flag |
LDA Svarl ; get start of vars low byte |
LDX Svarh ; get start of vars high byte |
LDY #$00 ; clear index |
LAB_1D5D |
STX Vrschh ; save search address high byte |
LAB_1D5F |
STA Vrschl ; save search address low byte |
CPX Sarryh ; compare high address with var space end |
BNE LAB_1D69 ; skip next compare if <> |
|
; high addresses were = so compare low addresses |
CMP Sarryl ; compare low address with var space end |
BEQ LAB_1D8B ; if not found go make new var |
|
LAB_1D69 |
LDA Varnm1 ; get 1st character of var to find |
CMP (Vrschl),Y ; compare with variable name 1st character |
BNE LAB_1D77 ; branch if no match |
|
; 1st characters match so compare 2nd characters |
LDA Varnm2 ; get 2nd character of var to find |
INY ; index to point to variable name 2nd character |
CMP (Vrschl),Y ; compare with variable name 2nd character |
BEQ LAB_1DD7 ; branch if match (found var) |
|
DEY ; else decrement index (now = $00) |
LAB_1D77 |
CLC ; clear carry for add |
LDA Vrschl ; get search address low byte |
ADC #$06 ; +6 (offset to next var name) |
BCC LAB_1D5F ; loop if no overflow to high byte |
|
INX ; else increment high byte |
BNE LAB_1D5D ; loop always (RAM doesn't extend to $FFFF !) |
|
; check byte, return C=0 if<"A" or >"Z" or "a" to "z" |
|
LAB_CASC |
CMP #'a' ; compare with "a" |
BCS LAB_1D83 ; go check <"z"+1 |
|
; check byte, return C=0 if<"A" or >"Z" |
|
LAB_1D82 |
CMP #'A' ; compare with "A" |
BCC LAB_1D8A ; exit if less |
|
; carry is set |
SBC #$5B ; subtract "Z"+1 |
SEC ; set carry |
SBC #$A5 ; subtract $A5 (restore byte) |
; carry clear if byte>$5A |
LAB_1D8A |
RTS |
|
LAB_1D83 |
SBC #$7B ; subtract "z"+1 |
SEC ; set carry |
SBC #$85 ; subtract $85 (restore byte) |
; carry clear if byte>$7A |
RTS |
|
; reached end of variable mem without match |
; .. so create new variable |
LAB_1D8B |
PLA ; pop return address low byte |
PHA ; push return address low byte |
LAB_1C18p2 = LAB_1C18+2 |
CMP #<LAB_1C18p2 ; compare with expected calling routine return low byte |
BNE LAB_1D98 ; if not get (var) go create new var |
|
; This will only drop through if the call was from LAB_1C18 and is only called |
; from there if it is searching for a variable from the RHS of a LET a=b statement |
; it prevents the creation of variables not assigned a value. |
|
; value returned by this is either numeric zero (exponent byte is $00) or null string |
; (descriptor length byte is $00). in fact a pointer to any $00 byte would have done. |
|
; doing this saves 6 bytes of variable memory and 168 machine cycles of time |
|
; this is where you would put the undefined variable error call e.g. |
|
; ; variable doesn't exist so flag error |
; LDX #$24 ; error code $24 ("undefined variable" error) |
; JMP LAB_XERR ; do error #X then warm start |
|
; the above code has been tested and works a treat! (it replaces the three code lines |
; below) |
|
; else return dummy null value |
LDA #<LAB_1D96 ; low byte point to $00,$00 |
; (uses part of misc constants table) |
LDY #>LAB_1D96 ; high byte point to $00,$00 |
RTS |
|
; create new numeric variable |
LAB_1D98 |
LDA Sarryl ; get var mem end low byte |
LDY Sarryh ; get var mem end high byte |
STA Ostrtl ; save old block start low byte |
STY Ostrth ; save old block start high byte |
LDA Earryl ; get array mem end low byte |
LDY Earryh ; get array mem end high byte |
STA Obendl ; save old block end low byte |
STY Obendh ; save old block end high byte |
CLC ; clear carry for add |
ADC #$06 ; +6 (space for one var) |
BCC LAB_1DAE ; branch if no overflow to high byte |
|
INY ; else increment high byte |
LAB_1DAE |
STA Nbendl ; set new block end low byte |
STY Nbendh ; set new block end high byte |
JSR LAB_11CF ; open up space in memory |
LDA Nbendl ; get new start low byte |
LDY Nbendh ; get new start high byte (-$100) |
INY ; correct high byte |
STA Sarryl ; save new var mem end low byte |
STY Sarryh ; save new var mem end high byte |
LDY #$00 ; clear index |
LDA Varnm1 ; get var name 1st character |
STA (Vrschl),Y ; save var name 1st character |
INY ; increment index |
LDA Varnm2 ; get var name 2nd character |
STA (Vrschl),Y ; save var name 2nd character |
LDA #$00 ; clear A |
INY ; increment index |
STA (Vrschl),Y ; initialise var byte |
INY ; increment index |
STA (Vrschl),Y ; initialise var byte |
INY ; increment index |
STA (Vrschl),Y ; initialise var byte |
INY ; increment index |
STA (Vrschl),Y ; initialise var byte |
|
; found a match for var ((Vrschl) = ptr) |
LAB_1DD7 |
LDA Vrschl ; get var address low byte |
CLC ; clear carry for add |
ADC #$02 ; +2 (offset past var name bytes) |
LDY Vrschh ; get var address high byte |
BCC LAB_1DE1 ; branch if no overflow from add |
|
INY ; else increment high byte |
LAB_1DE1 |
STA Cvaral ; save current var address low byte |
STY Cvarah ; save current var address high byte |
RTS |
|
; set-up array pointer (Adatal/h) to first element in array |
; set Adatal,Adatah to Astrtl,Astrth+2*Dimcnt+#$05 |
|
LAB_1DE6 |
LDA Dimcnt ; get # of dimensions (1, 2 or 3) |
ASL ; *2 (also clears the carry !) |
ADC #$05 ; +5 (result is 7, 9 or 11 here) |
ADC Astrtl ; add array start pointer low byte |
LDY Astrth ; get array pointer high byte |
BCC LAB_1DF2 ; branch if no overflow |
|
INY ; else increment high byte |
LAB_1DF2 |
STA Adatal ; save array data pointer low byte |
STY Adatah ; save array data pointer high byte |
RTS |
|
; evaluate integer expression |
|
LAB_EVIN |
JSR LAB_IGBY ; increment and scan memory |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
|
; evaluate integer expression (no check) |
|
LAB_EVPI |
LDA FAC1_s ; get FAC1 sign (b7) |
BMI LAB_1E12 ; do function call error if -ve |
|
; evaluate integer expression (no sign check) |
|
LAB_EVIR |
LDA FAC1_e ; get FAC1 exponent |
CMP #$90 ; compare with exponent = 2^16 (n>2^15) |
BCC LAB_1E14 ; branch if n<2^16 (is ok) |
|
LDA #<LAB_1DF7 ; set pointer low byte to -32768 |
LDY #>LAB_1DF7 ; set pointer high byte to -32768 |
JSR LAB_27F8 ; compare FAC1 with (AY) |
LAB_1E12 |
BNE LAB_FCER ; if <> do function call error then warm start |
|
LAB_1E14 |
JMP LAB_2831 ; convert FAC1 floating-to-fixed and return |
|
; find or make array |
|
LAB_1E17 |
LDA Defdim ; get DIM flag |
PHA ; push it |
LDA Dtypef ; get data type flag, $FF=string, $00=numeric |
PHA ; push it |
LDY #$00 ; clear dimensions count |
|
; now get the array dimension(s) and stack it (them) before the data type and DIM flag |
|
LAB_1E1F |
TYA ; copy dimensions count |
PHA ; save it |
LDA Varnm2 ; get array name 2nd byte |
PHA ; save it |
LDA Varnm1 ; get array name 1st byte |
PHA ; save it |
JSR LAB_EVIN ; evaluate integer expression |
PLA ; pull array name 1st byte |
STA Varnm1 ; restore array name 1st byte |
PLA ; pull array name 2nd byte |
STA Varnm2 ; restore array name 2nd byte |
PLA ; pull dimensions count |
TAY ; restore it |
TSX ; copy stack pointer |
LDA LAB_STAK+2,X ; get DIM flag |
PHA ; push it |
LDA LAB_STAK+1,X ; get data type flag |
PHA ; push it |
LDA FAC1_2 ; get this dimension size high byte |
STA LAB_STAK+2,X ; stack before flag bytes |
LDA FAC1_3 ; get this dimension size low byte |
STA LAB_STAK+1,X ; stack before flag bytes |
INY ; increment dimensions count |
JSR LAB_GBYT ; scan memory |
CMP #',' ; compare with "," |
BEQ LAB_1E1F ; if found go do next dimension |
|
STY Dimcnt ; store dimensions count |
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start |
PLA ; pull data type flag |
STA Dtypef ; restore data type flag, $FF=string, $00=numeric |
PLA ; pull DIM flag |
STA Defdim ; restore DIM flag |
LDX Sarryl ; get array mem start low byte |
LDA Sarryh ; get array mem start high byte |
|
; now check to see if we are at the end of array memory (we would be if there were |
; no arrays). |
|
LAB_1E5C |
STX Astrtl ; save as array start pointer low byte |
STA Astrth ; save as array start pointer high byte |
CMP Earryh ; compare with array mem end high byte |
BNE LAB_1E68 ; branch if not reached array mem end |
|
CPX Earryl ; else compare with array mem end low byte |
BEQ LAB_1EA1 ; go build array if not found |
|
; search for array |
LAB_1E68 |
LDY #$00 ; clear index |
LDA (Astrtl),Y ; get array name first byte |
INY ; increment index to second name byte |
CMP Varnm1 ; compare with this array name first byte |
BNE LAB_1E77 ; branch if no match |
|
LDA Varnm2 ; else get this array name second byte |
CMP (Astrtl),Y ; compare with array name second byte |
BEQ LAB_1E8D ; array found so branch |
|
; no match |
LAB_1E77 |
INY ; increment index |
LDA (Astrtl),Y ; get array size low byte |
CLC ; clear carry for add |
ADC Astrtl ; add array start pointer low byte |
TAX ; copy low byte to X |
INY ; increment index |
LDA (Astrtl),Y ; get array size high byte |
ADC Astrth ; add array mem pointer high byte |
BCC LAB_1E5C ; if no overflow go check next array |
|
; do array bounds error |
|
LAB_1E85 |
LDX #$10 ; error code $10 ("Array bounds" error) |
.byte $2C ; makes next bit BIT LAB_08A2 |
|
; do function call error |
|
LAB_FCER |
LDX #$08 ; error code $08 ("Function call" error) |
LAB_1E8A |
JMP LAB_XERR ; do error #X, then warm start |
|
; found array, are we trying to dimension it? |
LAB_1E8D |
LDX #$12 ; set error $12 ("Double dimension" error) |
LDA Defdim ; get DIM flag |
BNE LAB_1E8A ; if we are trying to dimension it do error #X, then warm |
; start |
|
; found the array and we're not dimensioning it so we must find an element in it |
|
JSR LAB_1DE6 ; set-up array pointer (Adatal/h) to first element in array |
; (Astrtl,Astrth points to start of array) |
LDA Dimcnt ; get dimensions count |
LDY #$04 ; set index to array's # of dimensions |
CMP (Astrtl),Y ; compare with no of dimensions |
BNE LAB_1E85 ; if wrong do array bounds error, could do "Wrong |
; dimensions" error here .. if we want a different |
; error message |
|
JMP LAB_1F28 ; found array so go get element |
; (could jump to LAB_1F28 as all LAB_1F24 does is take |
; Dimcnt and save it at (Astrtl),Y which is already the |
; same or we would have taken the BNE) |
|
; array not found, so build it |
LAB_1EA1 |
JSR LAB_1DE6 ; set-up array pointer (Adatal/h) to first element in array |
; (Astrtl,Astrth points to start of array) |
JSR LAB_121F ; check available memory, "Out of memory" error if no room |
; addr to check is in AY (low/high) |
LDY #$00 ; clear Y (don't need to clear A) |
STY Aspth ; clear array data size high byte |
LDA Varnm1 ; get variable name 1st byte |
STA (Astrtl),Y ; save array name 1st byte |
INY ; increment index |
LDA Varnm2 ; get variable name 2nd byte |
STA (Astrtl),Y ; save array name 2nd byte |
LDA Dimcnt ; get dimensions count |
LDY #$04 ; index to dimension count |
STY Asptl ; set array data size low byte (four bytes per element) |
STA (Astrtl),Y ; set array's dimensions count |
|
; now calculate the size of the data space for the array |
CLC ; clear carry for add (clear on subsequent loops) |
LAB_1EC0 |
LDX #$0B ; set default dimension value low byte |
LDA #$00 ; set default dimension value high byte |
BIT Defdim ; test default DIM flag |
BVC LAB_1ED0 ; branch if b6 of Defdim is clear |
|
PLA ; else pull dimension value low byte |
ADC #$01 ; +1 (allow for zeroeth element) |
TAX ; copy low byte to X |
PLA ; pull dimension value high byte |
ADC #$00 ; add carry from low byte |
|
LAB_1ED0 |
INY ; index to dimension value high byte |
STA (Astrtl),Y ; save dimension value high byte |
INY ; index to dimension value high byte |
TXA ; get dimension value low byte |
STA (Astrtl),Y ; save dimension value low byte |
JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl) |
STX Asptl ; save array data size low byte |
STA Aspth ; save array data size high byte |
LDY ut1_pl ; restore index (saved by subroutine) |
DEC Dimcnt ; decrement dimensions count |
BNE LAB_1EC0 ; loop while not = 0 |
|
ADC Adatah ; add size high byte to first element high byte |
; (carry is always clear here) |
BCS LAB_1F45 ; if overflow go do "Out of memory" error |
|
STA Adatah ; save end of array high byte |
TAY ; copy end high byte to Y |
TXA ; get array size low byte |
ADC Adatal ; add array start low byte |
BCC LAB_1EF3 ; branch if no carry |
|
INY ; else increment end of array high byte |
BEQ LAB_1F45 ; if overflow go do "Out of memory" error |
|
; set-up mostly complete, now zero the array |
LAB_1EF3 |
JSR LAB_121F ; check available memory, "Out of memory" error if no room |
; addr to check is in AY (low/high) |
STA Earryl ; save array mem end low byte |
STY Earryh ; save array mem end high byte |
LDA #$00 ; clear byte for array clear |
INC Aspth ; increment array size high byte (now block count) |
LDY Asptl ; get array size low byte (now index to block) |
BEQ LAB_1F07 ; branch if low byte = $00 |
message "LAB_1F02" |
LAB_1F02 |
DEY ; decrement index (do 0 to n-1) |
STA (Adatal),Y ; zero byte |
BNE LAB_1F02 ; loop until this block done |
|
LAB_1F07 |
DEC Adatah ; decrement array pointer high byte |
DEC Aspth ; decrement block count high byte |
BNE LAB_1F02 ; loop until all blocks done |
|
INC Adatah ; correct for last loop |
SEC ; set carry for subtract |
LDY #$02 ; index to array size low byte |
LDA Earryl ; get array mem end low byte |
SBC Astrtl ; subtract array start low byte |
STA (Astrtl),Y ; save array size low byte |
INY ; index to array size high byte |
LDA Earryh ; get array mem end high byte |
SBC Astrth ; subtract array start high byte |
STA (Astrtl),Y ; save array size high byte |
LDA Defdim ; get default DIM flag |
BNE LAB_1F7B ; exit (RET) if this was a DIM command |
|
; else, find element |
INY ; index to # of dimensions |
|
LAB_1F24 |
LDA (Astrtl),Y ; get array's dimension count |
STA Dimcnt ; save it |
|
; we have found, or built, the array. now we need to find the element |
|
LAB_1F28 |
LDA #$00 ; clear byte |
STA Asptl ; clear array data pointer low byte |
LAB_1F2C |
STA Aspth ; save array data pointer high byte |
INY ; increment index (point to array bound high byte) |
PLA ; pull array index low byte |
TAX ; copy to X |
STA FAC1_2 ; save index low byte to FAC1 mantissa2 |
PLA ; pull array index high byte |
STA FAC1_3 ; save index high byte to FAC1 mantissa3 |
CMP (Astrtl),Y ; compare with array bound high byte |
BCC LAB_1F48 ; branch if within bounds |
|
BNE LAB_1F42 ; if outside bounds do array bounds error |
|
; else high byte was = so test low bytes |
INY ; index to array bound low byte |
TXA ; get array index low byte |
CMP (Astrtl),Y ; compare with array bound low byte |
BCC LAB_1F49 ; branch if within bounds |
|
LAB_1F42 |
JMP LAB_1E85 ; else do array bounds error |
|
LAB_1F45 |
JMP LAB_OMER ; do "Out of memory" error then warm start |
|
LAB_1F48 |
INY ; index to array bound low byte |
LAB_1F49 |
LDA Aspth ; get array data pointer high byte |
ORA Asptl ; OR with array data pointer low byte |
BEQ LAB_1F5A ; branch if array data pointer = null (skip multiply) |
|
JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl) |
TXA ; get result low byte |
ADC FAC1_2 ; add index low byte from FAC1 mantissa2 |
TAX ; save result low byte |
TYA ; get result high byte |
LDY ut1_pl ; restore index |
LAB_1F5A |
ADC FAC1_3 ; add index high byte from FAC1 mantissa3 |
STX Asptl ; save array data pointer low byte |
DEC Dimcnt ; decrement dimensions count |
BNE LAB_1F2C ; loop if dimensions still to do |
|
ASL Asptl ; array data pointer low byte * 2 |
ROL ; array data pointer high byte * 2 |
ASL Asptl ; array data pointer low byte * 4 |
ROL ; array data pointer high byte * 4 |
TAY ; copy high byte |
LDA Asptl ; get low byte |
ADC Adatal ; add array data start pointer low byte |
STA Cvaral ; save as current var address low byte |
TYA ; get high byte back |
ADC Adatah ; add array data start pointer high byte |
STA Cvarah ; save as current var address high byte |
TAY ; copy high byte to Y |
LDA Cvaral ; get current var address low byte |
LAB_1F7B |
RTS |
|
; does XY = (Astrtl),Y * (Asptl) |
|
LAB_1F7C |
STY ut1_pl ; save index |
LDA (Astrtl),Y ; get dimension size low byte |
STA dims_l ; save dimension size low byte |
DEY ; decrement index |
LDA (Astrtl),Y ; get dimension size high byte |
STA dims_h ; save dimension size high byte |
|
LDA #$10 ; count = $10 (16 bit multiply) |
STA numbit ; save bit count |
LDX #$00 ; clear result low byte |
LDY #$00 ; clear result high byte |
LAB_1F8F |
TXA ; get result low byte |
ASL ; *2 |
TAX ; save result low byte |
TYA ; get result high byte |
ROL ; *2 |
TAY ; save result high byte |
BCS LAB_1F45 ; if overflow go do "Out of memory" error |
|
ASL Asptl ; shift multiplier low byte |
ROL Aspth ; shift multiplier high byte |
BCC LAB_1FA8 ; skip add if no carry |
|
CLC ; else clear carry for add |
TXA ; get result low byte |
ADC dims_l ; add dimension size low byte |
TAX ; save result low byte |
TYA ; get result high byte |
ADC dims_h ; add dimension size high byte |
TAY ; save result high byte |
BCS LAB_1F45 ; if overflow go do "Out of memory" error |
|
LAB_1FA8 |
DEC numbit ; decrement bit count |
BNE LAB_1F8F ; loop until all done |
|
RTS |
|
; perform FRE() |
|
LAB_FRE |
LDA Dtypef ; get data type flag, $FF=string, $00=numeric |
BPL LAB_1FB4 ; branch if numeric |
|
JSR LAB_22B6 ; pop string off descriptor stack, or from top of string |
; space returns with A = length, X=$71=pointer low byte, |
; Y=$72=pointer high byte |
|
; FRE(n) was numeric so do this |
LAB_1FB4 |
JSR LAB_GARB ; go do garbage collection |
SEC ; set carry for subtract |
LDA Sstorl ; get bottom of string space low byte |
SBC Earryl ; subtract array mem end low byte |
TAY ; copy result to Y |
LDA Sstorh ; get bottom of string space high byte |
SBC Earryh ; subtract array mem end high byte |
|
; save and convert integer AY to FAC1 |
|
LAB_AYFC |
LSR Dtypef ; clear data type flag, $FF=string, $00=numeric |
STA FAC1_1 ; save FAC1 mantissa1 |
STY FAC1_2 ; save FAC1 mantissa2 |
LDX #$90 ; set exponent=2^16 (integer) |
JMP LAB_27E3 ; set exp=X, clear FAC1_3, normalise and return |
|
; perform POS() |
|
LAB_POS |
LDY TPos ; get terminal position |
|
; convert Y to byte in FAC1 |
|
LAB_1FD0 |
LDA #$00 ; clear high byte |
BEQ LAB_AYFC ; always save and convert integer AY to FAC1 and return |
|
; check not Direct (used by DEF and INPUT) |
|
LAB_CKRN |
LDX Clineh ; get current line high byte |
INX ; increment it |
BNE LAB_1F7B ; return if can continue not direct mode |
|
; else do illegal direct error |
LAB_1FD9 |
LDX #$16 ; error code $16 ("Illegal direct" error) |
LAB_1FDB |
JMP LAB_XERR ; go do error #X, then warm start |
|
; perform DEF |
|
LAB_DEF |
JSR LAB_200B ; check FNx syntax |
STA func_l ; save function pointer low byte |
STY func_h ; save function pointer high byte |
JSR LAB_CKRN ; check not Direct (back here if ok) |
JSR LAB_1BFE ; scan for "(" , else do syntax error then warm start |
LDA #$80 ; set flag for FNx |
STA Sufnxf ; save subscript/FNx flag |
JSR LAB_GVAR ; get (var) address |
JSR LAB_CTNM ; check if source is numeric, else do type mismatch |
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start |
LDA #TK_EQUAL ; get = token |
JSR LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start |
LDA Cvarah ; get current var address high byte |
PHA ; push it |
LDA Cvaral ; get current var address low byte |
PHA ; push it |
LDA Bpntrh ; get BASIC execute pointer high byte |
PHA ; push it |
LDA Bpntrl ; get BASIC execute pointer low byte |
PHA ; push it |
JSR LAB_DATA ; go perform DATA |
JMP LAB_207A ; put execute pointer and variable pointer into function |
; and return |
|
; check FNx syntax |
|
LAB_200B |
LDA #TK_FN ; get FN" token |
JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error then warm start |
; return character after A |
ORA #$80 ; set FN flag bit |
STA Sufnxf ; save FN flag so array variable test fails |
JSR LAB_1D12 ; search for FN variable |
JMP LAB_CTNM ; check if source is numeric and return, else do type |
; mismatch |
|
; Evaluate FNx |
LAB_201E |
JSR LAB_200B ; check FNx syntax |
PHA ; push function pointer low byte |
TYA ; copy function pointer high byte |
PHA ; push function pointer high byte |
JSR LAB_1BFE ; scan for "(", else do syntax error then warm start |
JSR LAB_EVEX ; evaluate expression |
JSR LAB_1BFB ; scan for ")", else do syntax error then warm start |
JSR LAB_CTNM ; check if source is numeric, else do type mismatch |
PLA ; pop function pointer high byte |
STA func_h ; restore it |
PLA ; pop function pointer low byte |
STA func_l ; restore it |
LDX #$20 ; error code $20 ("Undefined function" error) |
LDY #$03 ; index to variable pointer high byte |
LDA (func_l),Y ; get variable pointer high byte |
BEQ LAB_1FDB ; if zero go do undefined function error |
|
STA Cvarah ; save variable address high byte |
DEY ; index to variable address low byte |
LDA (func_l),Y ; get variable address low byte |
STA Cvaral ; save variable address low byte |
TAX ; copy address low byte |
|
; now stack the function variable value before use |
INY ; index to mantissa_3 |
LAB_2043 |
LDA (Cvaral),Y ; get byte from variable |
PHA ; stack it |
DEY ; decrement index |
BPL LAB_2043 ; loop until variable stacked |
|
LDY Cvarah ; get variable address high byte |
JSR LAB_2778 ; pack FAC1 (function expression value) into (XY) |
; (function variable), return Y=0, always |
LDA Bpntrh ; get BASIC execute pointer high byte |
PHA ; push it |
LDA Bpntrl ; get BASIC execute pointer low byte |
PHA ; push it |
LDA (func_l),Y ; get function execute pointer low byte |
STA Bpntrl ; save as BASIC execute pointer low byte |
INY ; index to high byte |
LDA (func_l),Y ; get function execute pointer high byte |
STA Bpntrh ; save as BASIC execute pointer high byte |
LDA Cvarah ; get variable address high byte |
PHA ; push it |
LDA Cvaral ; get variable address low byte |
PHA ; push it |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
PLA ; pull variable address low byte |
STA func_l ; save variable address low byte |
PLA ; pull variable address high byte |
STA func_h ; save variable address high byte |
JSR LAB_GBYT ; scan memory |
BEQ LAB_2074 ; branch if null (should be [EOL] marker) |
|
JMP LAB_SNER ; else syntax error then warm start |
|
; restore Bpntrl,Bpntrh and function variable from stack |
|
LAB_2074 |
PLA ; pull BASIC execute pointer low byte |
STA Bpntrl ; restore BASIC execute pointer low byte |
PLA ; pull BASIC execute pointer high byte |
STA Bpntrh ; restore BASIC execute pointer high byte |
|
; put execute pointer and variable pointer into function |
|
LAB_207A |
LDY #$00 ; clear index |
PLA ; pull BASIC execute pointer low byte |
STA (func_l),Y ; save to function |
INY ; increment index |
PLA ; pull BASIC execute pointer high byte |
STA (func_l),Y ; save to function |
INY ; increment index |
PLA ; pull current var address low byte |
STA (func_l),Y ; save to function |
INY ; increment index |
PLA ; pull current var address high byte |
STA (func_l),Y ; save to function |
RTS |
|
; perform STR$() |
|
LAB_STRS |
JSR LAB_CTNM ; check if source is numeric, else do type mismatch |
JSR LAB_296E ; convert FAC1 to string |
LDA #<Decssp1 ; set result string low pointer |
LDY #>Decssp1 ; set result string high pointer |
BEQ LAB_20AE ; print null terminated string to Sutill/Sutilh |
|
; Do string vector |
; copy des_pl/h to des_2l/h and make string space A bytes long |
|
LAB_209C |
LDX des_pl ; get descriptor pointer low byte |
LDY des_ph ; get descriptor pointer high byte |
STX des_2l ; save descriptor pointer low byte |
STY des_2h ; save descriptor pointer high byte |
|
; make string space A bytes long |
; A=length, X=Sutill=ptr low byte, Y=Sutilh=ptr high byte |
|
LAB_MSSP |
JSR LAB_2115 ; make space in string memory for string A long |
; return X=Sutill=ptr low byte, Y=Sutilh=ptr high byte |
STX str_pl ; save string pointer low byte |
STY str_ph ; save string pointer high byte |
STA str_ln ; save length |
RTS |
|
; Scan, set up string |
; print " terminated string to Sutill/Sutilh |
|
LAB_20AE |
LDX #$22 ; set terminator to " |
STX Srchc ; set search character (terminator 1) |
STX Asrch ; set terminator 2 |
|
; print [Srchc] or [Asrch] terminated string to Sutill/Sutilh |
; source is AY |
|
LAB_20B4 |
STA ssptr_l ; store string start low byte |
STY ssptr_h ; store string start high byte |
STA str_pl ; save string pointer low byte |
STY str_ph ; save string pointer high byte |
LDY #$FF ; set length to -1 |
LAB_20BE |
INY ; increment length |
LDA (ssptr_l),Y ; get byte from string |
BEQ LAB_20CF ; exit loop if null byte [EOS] |
|
CMP Srchc ; compare with search character (terminator 1) |
BEQ LAB_20CB ; branch if terminator |
|
CMP Asrch ; compare with terminator 2 |
BNE LAB_20BE ; loop if not terminator 2 |
|
LAB_20CB |
CMP #$22 ; compare with " |
BEQ LAB_20D0 ; branch if " (carry set if = !) |
|
LAB_20CF |
CLC ; clear carry for add (only if [EOL] terminated string) |
LAB_20D0 |
STY str_ln ; save length in FAC1 exponent |
TYA ; copy length to A |
ADC ssptr_l ; add string start low byte |
STA Sendl ; save string end low byte |
LDX ssptr_h ; get string start high byte |
BCC LAB_20DC ; branch if no low byte overflow |
|
INX ; else increment high byte |
LAB_20DC |
STX Sendh ; save string end high byte |
LDA ssptr_h ; get string start high byte |
CMP #>Ram_base ; compare with start of program memory |
BCS LAB_RTST ; branch if not in utility area |
|
; string in utility area, move to string memory |
TYA ; copy length to A |
JSR LAB_209C ; copy des_pl/h to des_2l/h and make string space A bytes |
; long |
LDX ssptr_l ; get string start low byte |
LDY ssptr_h ; get string start high byte |
JSR LAB_2298 ; store string A bytes long from XY to (Sutill) |
|
; check for space on descriptor stack then .. |
; put string address and length on descriptor stack and update stack pointers |
|
LAB_RTST |
LDX next_s ; get string stack pointer |
CPX #des_sk+$09 ; compare with max+1 |
BNE LAB_20F8 ; branch if space on string stack |
|
; else do string too complex error |
LDX #$1C ; error code $1C ("String too complex" error) |
LAB_20F5 |
JMP LAB_XERR ; do error #X, then warm start |
|
; put string address and length on descriptor stack and update stack pointers |
|
LAB_20F8 |
LDA str_ln ; get string length |
STA PLUS_0,X ; put on string stack |
LDA str_pl ; get string pointer low byte |
STA PLUS_1,X ; put on string stack |
LDA str_ph ; get string pointer high byte |
STA PLUS_2,X ; put on string stack |
LDY #$00 ; clear Y |
STX des_pl ; save string descriptor pointer low byte |
STY des_ph ; save string descriptor pointer high byte (always $00) |
DEY ; Y = $FF |
STY Dtypef ; save data type flag, $FF=string |
STX last_sl ; save old stack pointer (current top item) |
INX ; update stack pointer |
INX ; update stack pointer |
INX ; update stack pointer |
STX next_s ; save new top item value |
RTS |
|
; Build descriptor |
; make space in string memory for string A long |
; return X=Sutill=ptr low byte, Y=Sutill=ptr high byte |
|
LAB_2115 |
LSR Gclctd ; clear garbage collected flag (b7) |
|
; make space for string A long |
LAB_2117 |
PHA ; save string length |
EOR #$FF ; complement it |
SEC ; set carry for subtract (twos comp add) |
ADC Sstorl ; add bottom of string space low byte (subtract length) |
LDY Sstorh ; get bottom of string space high byte |
BCS LAB_2122 ; skip decrement if no underflow |
|
DEY ; decrement bottom of string space high byte |
LAB_2122 |
CPY Earryh ; compare with array mem end high byte |
BCC LAB_2137 ; do out of memory error if less |
|
BNE LAB_212C ; if not = skip next test |
|
CMP Earryl ; compare with array mem end low byte |
BCC LAB_2137 ; do out of memory error if less |
|
LAB_212C |
STA Sstorl ; save bottom of string space low byte |
STY Sstorh ; save bottom of string space high byte |
STA Sutill ; save string utility ptr low byte |
STY Sutilh ; save string utility ptr high byte |
TAX ; copy low byte to X |
PLA ; get string length back |
RTS |
|
LAB_2137 |
LDX #$0C ; error code $0C ("Out of memory" error) |
LDA Gclctd ; get garbage collected flag |
BMI LAB_20F5 ; if set then do error code X |
|
JSR LAB_GARB ; else go do garbage collection |
LDA #$80 ; flag for garbage collected |
STA Gclctd ; set garbage collected flag |
PLA ; pull length |
BNE LAB_2117 ; go try again (loop always, length should never be = $00) |
|
; garbage collection routine |
|
LAB_GARB |
LDX Ememl ; get end of mem low byte |
LDA Ememh ; get end of mem high byte |
|
; re-run routine from last ending |
|
LAB_214B |
STX Sstorl ; set string storage low byte |
STA Sstorh ; set string storage high byte |
LDY #$00 ; clear index |
STY garb_h ; clear working pointer high byte (flag no strings to move) |
LDA Earryl ; get array mem end low byte |
LDX Earryh ; get array mem end high byte |
STA Histrl ; save as highest string low byte |
STX Histrh ; save as highest string high byte |
LDA #des_sk ; set descriptor stack pointer |
STA ut1_pl ; save descriptor stack pointer low byte |
STY ut1_ph ; save descriptor stack pointer high byte ($00) |
LAB_2161 |
CMP next_s ; compare with descriptor stack pointer |
BEQ LAB_216A ; branch if = |
|
JSR LAB_21D7 ; go garbage collect descriptor stack |
BEQ LAB_2161 ; loop always |
|
; done stacked strings, now do string vars |
LAB_216A |
ASL g_step ; set step size = $06 |
LDA Svarl ; get start of vars low byte |
LDX Svarh ; get start of vars high byte |
STA ut1_pl ; save as pointer low byte |
STX ut1_ph ; save as pointer high byte |
LAB_2176 |
CPX Sarryh ; compare start of arrays high byte |
BNE LAB_217E ; branch if no high byte match |
|
CMP Sarryl ; else compare start of arrays low byte |
BEQ LAB_2183 ; branch if = var mem end |
|
LAB_217E |
JSR LAB_21D1 ; go garbage collect strings |
BEQ LAB_2176 ; loop always |
|
; done string vars, now do string arrays |
LAB_2183 |
STA Nbendl ; save start of arrays low byte as working pointer |
STX Nbendh ; save start of arrays high byte as working pointer |
LDA #$04 ; set step size |
STA g_step ; save step size |
LAB_218B |
LDA Nbendl ; get pointer low byte |
LDX Nbendh ; get pointer high byte |
LAB_218F |
CPX Earryh ; compare with array mem end high byte |
BNE LAB_219A ; branch if not at end |
|
CMP Earryl ; else compare with array mem end low byte |
BEQ LAB_2216 ; tidy up and exit if at end |
|
LAB_219A |
STA ut1_pl ; save pointer low byte |
STX ut1_ph ; save pointer high byte |
LDY #$02 ; set index |
LDA (ut1_pl),Y ; get array size low byte |
ADC Nbendl ; add start of this array low byte |
STA Nbendl ; save start of next array low byte |
INY ; increment index |
LDA (ut1_pl),Y ; get array size high byte |
ADC Nbendh ; add start of this array high byte |
STA Nbendh ; save start of next array high byte |
LDY #$01 ; set index |
LDA (ut1_pl),Y ; get name second byte |
BPL LAB_218B ; skip if not string array |
|
; was string array so .. |
|
LDY #$04 ; set index |
LDA (ut1_pl),Y ; get # of dimensions |
ASL ; *2 |
ADC #$05 ; +5 (array header size) |
JSR LAB_2208 ; go set up for first element |
LAB_21C4 |
CPX Nbendh ; compare with start of next array high byte |
BNE LAB_21CC ; branch if <> (go do this array) |
|
CMP Nbendl ; else compare element pointer low byte with next array |
; low byte |
BEQ LAB_218F ; if equal then go do next array |
|
LAB_21CC |
JSR LAB_21D7 ; go defrag array strings |
BEQ LAB_21C4 ; go do next array string (loop always) |
|
; defrag string variables |
; enter with XA = variable pointer |
; return with XA = next variable pointer |
|
LAB_21D1 |
INY ; increment index (Y was $00) |
LDA (ut1_pl),Y ; get var name byte 2 |
BPL LAB_2206 ; if not string, step pointer to next var and return |
|
INY ; else increment index |
LAB_21D7 |
LDA (ut1_pl),Y ; get string length |
BEQ LAB_2206 ; if null, step pointer to next string and return |
|
INY ; else increment index |
LDA (ut1_pl),Y ; get string pointer low byte |
TAX ; copy to X |
INY ; increment index |
LDA (ut1_pl),Y ; get string pointer high byte |
CMP Sstorh ; compare bottom of string space high byte |
BCC LAB_21EC ; branch if less |
|
BNE LAB_2206 ; if greater, step pointer to next string and return |
|
; high bytes were = so compare low bytes |
CPX Sstorl ; compare bottom of string space low byte |
BCS LAB_2206 ; if >=, step pointer to next string and return |
|
; string pointer is < string storage pointer (pos in mem) |
LAB_21EC |
CMP Histrh ; compare to highest string high byte |
BCC LAB_2207 ; if <, step pointer to next string and return |
|
BNE LAB_21F6 ; if > update pointers, step to next and return |
|
; high bytes were = so compare low bytes |
CPX Histrl ; compare to highest string low byte |
BCC LAB_2207 ; if <, step pointer to next string and return |
|
; string is in string memory space |
LAB_21F6 |
STX Histrl ; save as new highest string low byte |
STA Histrh ; save as new highest string high byte |
LDA ut1_pl ; get start of vars(descriptors) low byte |
LDX ut1_ph ; get start of vars(descriptors) high byte |
STA garb_l ; save as working pointer low byte |
STX garb_h ; save as working pointer high byte |
DEY ; decrement index DIFFERS |
DEY ; decrement index (should point to descriptor start) |
STY g_indx ; save index pointer |
|
; step pointer to next string |
LAB_2206 |
CLC ; clear carry for add |
LAB_2207 |
LDA g_step ; get step size |
LAB_2208 |
ADC ut1_pl ; add pointer low byte |
STA ut1_pl ; save pointer low byte |
BCC LAB_2211 ; branch if no overflow |
|
INC ut1_ph ; else increment high byte |
LAB_2211 |
LDX ut1_ph ; get pointer high byte |
LDY #$00 ; clear Y |
RTS |
|
; search complete, now either exit or set-up and move string |
|
LAB_2216 |
DEC g_step ; decrement step size (now $03 for descriptor stack) |
LDX garb_h ; get string to move high byte |
BEQ LAB_2211 ; exit if nothing to move |
|
LDY g_indx ; get index byte back (points to descriptor) |
CLC ; clear carry for add |
LDA (garb_l),Y ; get string length |
ADC Histrl ; add highest string low byte |
STA Obendl ; save old block end low pointer |
LDA Histrh ; get highest string high byte |
ADC #$00 ; add any carry |
STA Obendh ; save old block end high byte |
LDA Sstorl ; get bottom of string space low byte |
LDX Sstorh ; get bottom of string space high byte |
STA Nbendl ; save new block end low byte |
STX Nbendh ; save new block end high byte |
JSR LAB_11D6 ; open up space in memory, don't set array end |
LDY g_indx ; get index byte |
INY ; point to descriptor low byte |
LDA Nbendl ; get string pointer low byte |
STA (garb_l),Y ; save new string pointer low byte |
TAX ; copy string pointer low byte |
INC Nbendh ; correct high byte (move sets high byte -1) |
LDA Nbendh ; get new string pointer high byte |
INY ; point to descriptor high byte |
STA (garb_l),Y ; save new string pointer high byte |
JMP LAB_214B ; re-run routine from last ending |
; (but don't collect this string) |
|
; concatenate |
; add strings, string 1 is in descriptor des_pl, string 2 is in line |
|
LAB_224D |
LDA des_ph ; get descriptor pointer high byte |
PHA ; put on stack |
LDA des_pl ; get descriptor pointer low byte |
PHA ; put on stack |
JSR LAB_GVAL ; get value from line |
JSR LAB_CTST ; check if source is string, else do type mismatch |
PLA ; get descriptor pointer low byte back |
STA ssptr_l ; set pointer low byte |
PLA ; get descriptor pointer high byte back |
STA ssptr_h ; set pointer high byte |
LDY #$00 ; clear index |
LDA (ssptr_l),Y ; get length_1 from descriptor |
CLC ; clear carry for add |
ADC (des_pl),Y ; add length_2 |
BCC LAB_226D ; branch if no overflow |
|
LDX #$1A ; else set error code $1A ("String too long" error) |
JMP LAB_XERR ; do error #X, then warm start |
|
LAB_226D |
JSR LAB_209C ; copy des_pl/h to des_2l/h and make string space A bytes |
; long |
JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill) |
LDA des_2l ; get descriptor pointer low byte |
LDY des_2h ; get descriptor pointer high byte |
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space |
; returns with A = length, ut1_pl = pointer low byte, |
; ut1_ph = pointer high byte |
JSR LAB_229C ; store string A bytes long from (ut1_pl) to (Sutill) |
LDA ssptr_l ;.set descriptor pointer low byte |
LDY ssptr_h ;.set descriptor pointer high byte |
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space |
; returns with A = length, X=ut1_pl=pointer low byte, |
; Y=ut1_ph=pointer high byte |
JSR LAB_RTST ; check for space on descriptor stack then put string |
; address and length on descriptor stack and update stack |
; pointers |
JMP LAB_1ADB ;.continue evaluation |
|
; copy string from descriptor (sdescr) to (Sutill) |
|
LAB_228A |
LDY #$00 ; clear index |
LDA (sdescr),Y ; get string length |
PHA ; save on stack |
INY ; increment index |
LDA (sdescr),Y ; get source string pointer low byte |
TAX ; copy to X |
INY ; increment index |
LDA (sdescr),Y ; get source string pointer high byte |
TAY ; copy to Y |
PLA ; get length back |
|
; store string A bytes long from YX to (Sutill) |
|
LAB_2298 |
STX ut1_pl ; save source string pointer low byte |
STY ut1_ph ; save source string pointer high byte |
|
; store string A bytes long from (ut1_pl) to (Sutill) |
|
LAB_229C |
TAX ; copy length to index (don't count with Y) |
BEQ LAB_22B2 ; branch if = $0 (null string) no need to add zero length |
|
LDY #$00 ; zero pointer (copy forward) |
LAB_22A0 |
LDA (ut1_pl),Y ; get source byte |
STA (Sutill),Y ; save destination byte |
|
INY ; increment index |
DEX ; decrement counter |
BNE LAB_22A0 ; loop while <> 0 |
|
TYA ; restore length from Y |
LAB_22A9 |
CLC ; clear carry for add |
ADC Sutill ; add string utility ptr low byte |
STA Sutill ; save string utility ptr low byte |
BCC LAB_22B2 ; branch if no carry |
|
INC Sutilh ; else increment string utility ptr high byte |
LAB_22B2 |
RTS |
|
; evaluate string |
|
LAB_EVST |
JSR LAB_CTST ; check if source is string, else do type mismatch |
|
; pop string off descriptor stack, or from top of string space |
; returns with A = length, X=pointer low byte, Y=pointer high byte |
|
LAB_22B6 |
LDA des_pl ; get descriptor pointer low byte |
LDY des_ph ; get descriptor pointer high byte |
|
; pop (YA) descriptor off stack or from top of string space |
; returns with A = length, X=ut1_pl=pointer low byte, Y=ut1_ph=pointer high byte |
|
LAB_22BA |
STA ut1_pl ; save descriptor pointer low byte |
STY ut1_ph ; save descriptor pointer high byte |
JSR LAB_22EB ; clean descriptor stack, YA = pointer |
PHP ; save status flags |
LDY #$00 ; clear index |
LDA (ut1_pl),Y ; get length from string descriptor |
PHA ; put on stack |
INY ; increment index |
LDA (ut1_pl),Y ; get string pointer low byte from descriptor |
TAX ; copy to X |
INY ; increment index |
LDA (ut1_pl),Y ; get string pointer high byte from descriptor |
TAY ; copy to Y |
PLA ; get string length back |
PLP ; restore status |
BNE LAB_22E6 ; branch if pointer <> last_sl,last_sh |
|
CPY Sstorh ; compare bottom of string space high byte |
BNE LAB_22E6 ; branch if <> |
|
CPX Sstorl ; else compare bottom of string space low byte |
BNE LAB_22E6 ; branch if <> |
|
PHA ; save string length |
CLC ; clear carry for add |
ADC Sstorl ; add bottom of string space low byte |
STA Sstorl ; save bottom of string space low byte |
BCC LAB_22E5 ; skip increment if no overflow |
|
INC Sstorh ; increment bottom of string space high byte |
LAB_22E5 |
PLA ; restore string length |
LAB_22E6 |
STX ut1_pl ; save string pointer low byte |
STY ut1_ph ; save string pointer high byte |
RTS |
|
; clean descriptor stack, YA = pointer |
; checks if AY is on the descriptor stack, if so does a stack discard |
|
LAB_22EB |
CPY last_sh ; compare pointer high byte |
BNE LAB_22FB ; exit if <> |
|
CMP last_sl ; compare pointer low byte |
BNE LAB_22FB ; exit if <> |
|
STA next_s ; save descriptor stack pointer |
SBC #$03 ; -3 |
STA last_sl ; save low byte -3 |
LDY #$00 ; clear high byte |
LAB_22FB |
RTS |
|
; perform CHR$() |
|
LAB_CHRS |
JSR LAB_EVBY ; evaluate byte expression, result in X |
TXA ; copy to A |
PHA ; save character |
LDA #$01 ; string is single byte |
JSR LAB_MSSP ; make string space A bytes long A=$AC=length, |
; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte |
PLA ; get character back |
LDY #$00 ; clear index |
STA (str_pl),Y ; save byte in string (byte IS string!) |
JMP LAB_RTST ; check for space on descriptor stack then put string |
; address and length on descriptor stack and update stack |
; pointers |
|
; perform LEFT$() |
|
LAB_LEFT |
PHA ; push byte parameter |
JSR LAB_236F ; pull string data and byte parameter from stack |
; return pointer in des_2l/h, byte in A (and X), Y=0 |
CMP (des_2l),Y ; compare byte parameter with string length |
TYA ; clear A |
BEQ LAB_2316 ; go do string copy (branch always) |
|
; perform RIGHT$() |
|
LAB_RIGHT |
PHA ; push byte parameter |
JSR LAB_236F ; pull string data and byte parameter from stack |
; return pointer in des_2l/h, byte in A (and X), Y=0 |
CLC ; clear carry for add-1 |
SBC (des_2l),Y ; subtract string length |
EOR #$FF ; invert it (A=LEN(expression$)-l) |
|
LAB_2316 |
BCC LAB_231C ; branch if string length > byte parameter |
|
LDA (des_2l),Y ; else make parameter = length |
TAX ; copy to byte parameter copy |
TYA ; clear string start offset |
LAB_231C |
PHA ; save string start offset |
LAB_231D |
TXA ; copy byte parameter (or string length if <) |
LAB_231E |
PHA ; save string length |
JSR LAB_MSSP ; make string space A bytes long A=$AC=length, |
; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte |
LDA des_2l ; get descriptor pointer low byte |
LDY des_2h ; get descriptor pointer high byte |
JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space |
; returns with A = length, X=ut1_pl=pointer low byte, |
; Y=ut1_ph=pointer high byte |
PLA ; get string length back |
TAY ; copy length to Y |
PLA ; get string start offset back |
CLC ; clear carry for add |
ADC ut1_pl ; add start offset to string start pointer low byte |
STA ut1_pl ; save string start pointer low byte |
BCC LAB_2335 ; branch if no overflow |
|
INC ut1_ph ; else increment string start pointer high byte |
LAB_2335 |
TYA ; copy length to A |
JSR LAB_229C ; store string A bytes long from (ut1_pl) to (Sutill) |
JMP LAB_RTST ; check for space on descriptor stack then put string |
; address and length on descriptor stack and update stack |
; pointers |
|
; perform MID$() |
|
LAB_MIDS |
PHA ; push byte parameter |
LDA #$FF ; set default length = 255 |
STA mids_l ; save default length |
JSR LAB_GBYT ; scan memory |
CMP #')' ; compare with ")" |
BEQ LAB_2358 ; branch if = ")" (skip second byte get) |
|
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start |
JSR LAB_GTBY ; get byte parameter (use copy in mids_l) |
LAB_2358 |
JSR LAB_236F ; pull string data and byte parameter from stack |
; return pointer in des_2l/h, byte in A (and X), Y=0 |
DEX ; decrement start index |
TXA ; copy to A |
PHA ; save string start offset |
CLC ; clear carry for sub-1 |
LDX #$00 ; clear output string length |
SBC (des_2l),Y ; subtract string length |
BCS LAB_231D ; if start>string length go do null string |
|
EOR #$FF ; complement -length |
CMP mids_l ; compare byte parameter |
BCC LAB_231E ; if length>remaining string go do RIGHT$ |
|
LDA mids_l ; get length byte |
BCS LAB_231E ; go do string copy (branch always) |
|
; pull string data and byte parameter from stack |
; return pointer in des_2l/h, byte in A (and X), Y=0 |
|
LAB_236F |
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start |
PLA ; pull return address low byte (return address) |
STA Fnxjpl ; save functions jump vector low byte |
PLA ; pull return address high byte (return address) |
STA Fnxjph ; save functions jump vector high byte |
PLA ; pull byte parameter |
TAX ; copy byte parameter to X |
PLA ; pull string pointer low byte |
STA des_2l ; save it |
PLA ; pull string pointer high byte |
STA des_2h ; save it |
LDY #$00 ; clear index |
TXA ; copy byte parameter |
BEQ LAB_23A8 ; if null do function call error then warm start |
|
INC Fnxjpl ; increment function jump vector low byte |
; (JSR pushes return addr-1. this is all very nice |
; but will go tits up if either call is on a page |
; boundary!) |
JMP (Fnxjpl) ; in effect, RTS |
|
; perform LCASE$() |
|
LAB_LCASE |
JSR LAB_EVST ; evaluate string |
STA str_ln ; set string length |
TAY ; copy length to Y |
BEQ NoString ; branch if null string |
|
JSR LAB_MSSP ; make string space A bytes long A=length, |
; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte |
STX str_pl ; save string pointer low byte |
STY str_ph ; save string pointer high byte |
TAY ; get string length back |
|
LC_loop |
DEY ; decrement index |
LDA (ut1_pl),Y ; get byte from string |
JSR LAB_1D82 ; is character "A" to "Z" |
BCC NoUcase ; branch if not upper case alpha |
|
ORA #$20 ; convert upper to lower case |
NoUcase |
STA (Sutill),Y ; save byte back to string |
TYA ; test index |
BNE LC_loop ; loop if not all done |
|
BEQ NoString ; tidy up and exit, branch always |
|
; perform UCASE$() |
|
LAB_UCASE |
JSR LAB_EVST ; evaluate string |
STA str_ln ; set string length |
TAY ; copy length to Y |
BEQ NoString ; branch if null string |
|
JSR LAB_MSSP ; make string space A bytes long A=length, |
; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte |
STX str_pl ; save string pointer low byte |
STY str_ph ; save string pointer high byte |
TAY ; get string length back |
|
UC_loop |
DEY ; decrement index |
LDA (ut1_pl),Y ; get byte from string |
JSR LAB_CASC ; is character "a" to "z" (or "A" to "Z") |
BCC NoLcase ; branch if not alpha |
|
AND #$DF ; convert lower to upper case |
NoLcase |
STA (Sutill),Y ; save byte back to string |
TYA ; test index |
BNE UC_loop ; loop if not all done |
|
NoString |
JMP LAB_RTST ; check for space on descriptor stack then put string |
; address and length on descriptor stack and update stack |
; pointers |
|
; perform SADD() |
|
LAB_SADD |
JSR LAB_IGBY ; increment and scan memory |
JSR LAB_GVAR ; get var address |
|
JSR LAB_1BFB ; scan for ")", else do syntax error then warm start |
JSR LAB_CTST ; check if source is string, else do type mismatch |
|
LDY #$02 ; index to string pointer high byte |
LDA (Cvaral),Y ; get string pointer high byte |
TAX ; copy string pointer high byte to X |
DEY ; index to string pointer low byte |
LDA (Cvaral),Y ; get string pointer low byte |
TAY ; copy string pointer low byte to Y |
TXA ; copy string pointer high byte to A |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; perform LEN() |
|
LAB_LENS |
JSR LAB_ESGL ; evaluate string, get length in A (and Y) |
JMP LAB_1FD0 ; convert Y to byte in FAC1 and return |
|
; evaluate string, get length in Y |
|
LAB_ESGL |
JSR LAB_EVST ; evaluate string |
TAY ; copy length to Y |
RTS |
|
; perform ASC() |
|
LAB_ASC |
JSR LAB_ESGL ; evaluate string, get length in A (and Y) |
BEQ LAB_23A8 ; if null do function call error then warm start |
|
LDY #$00 ; set index to first character |
LDA (ut1_pl),Y ; get byte |
TAY ; copy to Y |
JMP LAB_1FD0 ; convert Y to byte in FAC1 and return |
|
; do function call error then warm start |
|
LAB_23A8 |
JMP LAB_FCER ; do function call error then warm start |
|
; scan and get byte parameter |
|
LAB_SGBY |
JSR LAB_IGBY ; increment and scan memory |
|
; get byte parameter |
|
LAB_GTBY |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
|
; evaluate byte expression, result in X |
|
LAB_EVBY |
JSR LAB_EVPI ; evaluate integer expression (no check) |
|
LDY FAC1_2 ; get FAC1 mantissa2 |
BNE LAB_23A8 ; if top byte <> 0 do function call error then warm start |
|
LDX FAC1_3 ; get FAC1 mantissa3 |
JMP LAB_GBYT ; scan memory and return |
|
; perform VAL() |
|
LAB_VAL |
JSR LAB_ESGL ; evaluate string, get length in A (and Y) |
BNE LAB_23C5 ; branch if not null string |
|
; string was null so set result = $00 |
JMP LAB_24F1 ; clear FAC1 exponent and sign and return |
|
LAB_23C5 |
LDX Bpntrl ; get BASIC execute pointer low byte |
LDY Bpntrh ; get BASIC execute pointer high byte |
STX Btmpl ; save BASIC execute pointer low byte |
STY Btmph ; save BASIC execute pointer high byte |
LDX ut1_pl ; get string pointer low byte |
STX Bpntrl ; save as BASIC execute pointer low byte |
CLC ; clear carry |
ADC ut1_pl ; add string length |
STA ut2_pl ; save string end low byte |
LDA ut1_ph ; get string pointer high byte |
STA Bpntrh ; save as BASIC execute pointer high byte |
ADC #$00 ; add carry to high byte |
STA ut2_ph ; save string end high byte |
LDY #$00 ; set index to $00 |
LDA (ut2_pl),Y ; get string end +1 byte |
PHA ; push it |
TYA ; clear A |
STA (ut2_pl),Y ; terminate string with $00 |
JSR LAB_GBYT ; scan memory |
JSR LAB_2887 ; get FAC1 from string |
PLA ; restore string end +1 byte |
LDY #$00 ; set index to zero |
STA (ut2_pl),Y ; put string end byte back |
|
; restore BASIC execute pointer from temp (Btmpl/Btmph) |
|
LAB_23F3 |
LDX Btmpl ; get BASIC execute pointer low byte back |
LDY Btmph ; get BASIC execute pointer high byte back |
STX Bpntrl ; save BASIC execute pointer low byte |
STY Bpntrh ; save BASIC execute pointer high byte |
RTS |
|
; get two parameters for POKE or WAIT |
|
LAB_GADB |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
JSR LAB_F2FX ; save integer part of FAC1 in temporary integer |
|
; scan for "," and get byte, else do Syntax error then warm start |
|
LAB_SCGB |
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start |
LDA Itemph ; save temporary integer high byte |
PHA ; on stack |
LDA Itempl ; save temporary integer low byte |
PHA ; on stack |
JSR LAB_GTBY ; get byte parameter |
PLA ; pull low byte |
STA Itempl ; restore temporary integer low byte |
PLA ; pull high byte |
STA Itemph ; restore temporary integer high byte |
RTS |
|
; convert float to fixed routine. accepts any value that fits in 24 bits, +ve or |
; -ve and converts it into a right truncated integer in Itempl and Itemph |
|
; save unsigned 16 bit integer part of FAC1 in temporary integer |
|
LAB_F2FX |
LDA FAC1_e ; get FAC1 exponent |
CMP #$98 ; compare with exponent = 2^24 |
BCS LAB_23A8 ; if >= do function call error then warm start |
|
LAB_F2FU |
JSR LAB_2831 ; convert FAC1 floating-to-fixed |
LDA FAC1_2 ; get FAC1 mantissa2 |
LDY FAC1_3 ; get FAC1 mantissa3 |
STY Itempl ; save temporary integer low byte |
STA Itemph ; save temporary integer high byte |
RTS |
|
; perform PEEK() |
|
LAB_PEEK |
JSR LAB_F2FX ; save integer part of FAC1 in temporary integer |
LDX #$00 ; clear index |
LDA (Itempl,X) ; get byte via temporary integer (addr) |
TAY ; copy byte to Y |
JMP LAB_1FD0 ; convert Y to byte in FAC1 and return |
|
; perform POKE |
|
LAB_POKE |
JSR LAB_GADB ; get two parameters for POKE or WAIT |
TXA ; copy byte argument to A |
LDX #$00 ; clear index |
STA (Itempl,X) ; save byte via temporary integer (addr) |
RTS |
|
; perform DEEK() |
|
LAB_DEEK |
JSR LAB_F2FX ; save integer part of FAC1 in temporary integer |
LDX #$00 ; clear index |
LDA (Itempl,X) ; PEEK low byte |
TAY ; copy to Y |
INC Itempl ; increment pointer low byte |
BNE Deekh ; skip high increment if no rollover |
|
INC Itemph ; increment pointer high byte |
Deekh |
LDA (Itempl,X) ; PEEK high byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; perform DOKE |
|
LAB_DOKE |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
JSR LAB_F2FX ; convert floating-to-fixed |
|
STY Frnxtl ; save pointer low byte (float to fixed returns word in AY) |
STA Frnxth ; save pointer high byte |
|
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
JSR LAB_F2FX ; convert floating-to-fixed |
|
TYA ; copy value low byte (float to fixed returns word in AY) |
LDX #$00 ; clear index |
STA (Frnxtl,X) ; POKE low byte |
INC Frnxtl ; increment pointer low byte |
BNE Dokeh ; skip high increment if no rollover |
|
INC Frnxth ; increment pointer high byte |
Dokeh |
LDA Itemph ; get value high byte |
STA (Frnxtl,X) ; POKE high byte |
JMP LAB_GBYT ; scan memory and return |
|
; perform SWAP |
|
LAB_SWAP |
JSR LAB_GVAR ; get var1 address |
STA Lvarpl ; save var1 address low byte |
STY Lvarph ; save var1 address high byte |
LDA Dtypef ; get data type flag, $FF=string, $00=numeric |
PHA ; save data type flag |
|
JSR LAB_1C01 ; scan for "," , else do syntax error then warm start |
JSR LAB_GVAR ; get var2 address (pointer in Cvaral/h) |
PLA ; pull var1 data type flag |
EOR Dtypef ; compare with var2 data type |
BPL SwapErr ; exit if not both the same type |
|
LDY #$03 ; four bytes to swap (either value or descriptor+1) |
SwapLp |
LDA (Lvarpl),Y ; get byte from var1 |
TAX ; save var1 byte |
LDA (Cvaral),Y ; get byte from var2 |
STA (Lvarpl),Y ; save byte to var1 |
TXA ; restore var1 byte |
STA (Cvaral),Y ; save byte to var2 |
DEY ; decrement index |
BPL SwapLp ; loop until done |
|
RTS |
|
SwapErr |
JMP LAB_1ABC ; do "Type mismatch" error then warm start |
|
; perform CALL |
|
LAB_CALL |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
JSR LAB_F2FX ; convert floating-to-fixed |
LDA #>CallExit ; set return address high byte |
PHA ; put on stack |
LDA #<CallExit-1 ; set return address low byte |
PHA ; put on stack |
JMP (Itempl) ; do indirect jump to user routine |
|
; if the called routine exits correctly then it will return to here. this will then get |
; the next byte for the interpreter and return |
|
CallExit |
JMP LAB_GBYT ; scan memory and return |
|
; perform WAIT |
|
LAB_WAIT |
JSR LAB_GADB ; get two parameters for POKE or WAIT |
STX Frnxtl ; save byte |
LDX #$00 ; clear mask |
JSR LAB_GBYT ; scan memory |
BEQ LAB_2441 ; skip if no third argument |
|
JSR LAB_SCGB ; scan for "," and get byte, else SN error then warm start |
LAB_2441 |
STX Frnxth ; save EOR argument |
LAB_2445 |
LDA (Itempl),Y ; get byte via temporary integer (addr) |
EOR Frnxth ; EOR with second argument (mask) |
AND Frnxtl ; AND with first argument (byte) |
BEQ LAB_2445 ; loop if result is zero |
|
LAB_244D |
RTS |
|
; perform subtraction, FAC1 from (AY) |
|
LAB_2455 |
JSR LAB_264D ; unpack memory (AY) into FAC2 |
|
; perform subtraction, FAC1 from FAC2 |
|
LAB_SUBTRACT |
LDA FAC1_s ; get FAC1 sign (b7) |
EOR #$FF ; complement it |
STA FAC1_s ; save FAC1 sign (b7) |
EOR FAC2_s ; EOR with FAC2 sign (b7) |
STA FAC_sc ; save sign compare (FAC1 EOR FAC2) |
LDA FAC1_e ; get FAC1 exponent |
JMP LAB_ADD ; go add FAC2 to FAC1 |
|
; perform addition |
|
LAB_2467 |
JSR LAB_257B ; shift FACX A times right (>8 shifts) |
BCC LAB_24A8 ;.go subtract mantissas |
|
; add 0.5 to FAC1 |
|
LAB_244E |
LDA #<LAB_2A96 ; set 0.5 pointer low byte |
LDY #>LAB_2A96 ; set 0.5 pointer high byte |
|
; add (AY) to FAC1 |
|
LAB_246C |
JSR LAB_264D ; unpack memory (AY) into FAC2 |
|
; add FAC2 to FAC1 |
|
LAB_ADD |
BNE LAB_2474 ; branch if FAC1 was not zero |
|
; copy FAC2 to FAC1 |
|
LAB_279B |
LDA FAC2_s ; get FAC2 sign (b7) |
|
; save FAC1 sign and copy ABS(FAC2) to FAC1 |
|
LAB_279D |
STA FAC1_s ; save FAC1 sign (b7) |
LDX #$04 ; 4 bytes to copy |
LAB_27A1 |
LDA FAC1_o,X ; get byte from FAC2,X |
STA FAC1_e-1,X ; save byte at FAC1,X |
DEX ; decrement count |
BNE LAB_27A1 ; loop if not all done |
|
STX FAC1_r ; clear FAC1 rounding byte |
RTS |
|
; FAC1 is non zero |
LAB_2474 |
LDX FAC1_r ; get FAC1 rounding byte |
STX FAC2_r ; save as FAC2 rounding byte |
LDX #FAC2_e ; set index to FAC2 exponent addr |
LDA FAC2_e ; get FAC2 exponent |
LAB_247C |
TAY ; copy exponent |
BEQ LAB_244D ; exit if zero |
|
SEC ; set carry for subtract |
SBC FAC1_e ; subtract FAC1 exponent |
BEQ LAB_24A8 ; branch if = (go add mantissa) |
|
BCC LAB_2498 ; branch if < |
|
; FAC2>FAC1 |
STY FAC1_e ; save FAC1 exponent |
LDY FAC2_s ; get FAC2 sign (b7) |
STY FAC1_s ; save FAC1 sign (b7) |
EOR #$FF ; complement A |
ADC #$00 ; +1 (twos complement, carry is set) |
LDY #$00 ; clear Y |
STY FAC2_r ; clear FAC2 rounding byte |
LDX #FAC1_e ; set index to FAC1 exponent addr |
BNE LAB_249C ; branch always |
|
LAB_2498 |
LDY #$00 ; clear Y |
STY FAC1_r ; clear FAC1 rounding byte |
LAB_249C |
CMP #$F9 ; compare exponent diff with $F9 |
BMI LAB_2467 ; branch if range $79-$F8 |
|
TAY ; copy exponent difference to Y |
LDA FAC1_r ; get FAC1 rounding byte |
LSR PLUS_1,X ; shift FAC? mantissa1 |
JSR LAB_2592 ; shift FACX Y times right |
|
; exponents are equal now do mantissa subtract |
LAB_24A8 |
BIT FAC_sc ; test sign compare (FAC1 EOR FAC2) |
BPL LAB_24F8 ; if = add FAC2 mantissa to FAC1 mantissa and return |
|
LDY #FAC1_e ; set index to FAC1 exponent addr |
CPX #FAC2_e ; compare X to FAC2 exponent addr |
BEQ LAB_24B4 ; branch if = |
|
LDY #FAC2_e ; else set index to FAC2 exponent addr |
|
; subtract smaller from bigger (take sign of bigger) |
LAB_24B4 |
SEC ; set carry for subtract |
EOR #$FF ; ones complement A |
ADC FAC2_r ; add FAC2 rounding byte |
STA FAC1_r ; save FAC1 rounding byte |
LDA PLUS_3,Y ; get FACY mantissa3 |
SBC PLUS_3,X ; subtract FACX mantissa3 |
STA FAC1_3 ; save FAC1 mantissa3 |
LDA PLUS_2,Y ; get FACY mantissa2 |
SBC PLUS_2,X ; subtract FACX mantissa2 |
STA FAC1_2 ; save FAC1 mantissa2 |
LDA PLUS_1,Y ; get FACY mantissa1 |
SBC PLUS_1,X ; subtract FACX mantissa1 |
STA FAC1_1 ; save FAC1 mantissa1 |
|
; do ABS and normalise FAC1 |
|
LAB_24D0 |
BCS LAB_24D5 ; branch if number is +ve |
|
JSR LAB_2537 ; negate FAC1 |
|
; normalise FAC1 |
|
LAB_24D5 |
LDY #$00 ; clear Y |
TYA ; clear A |
CLC ; clear carry for add |
LAB_24D9 |
LDX FAC1_1 ; get FAC1 mantissa1 |
BNE LAB_251B ; if not zero normalise FAC1 |
|
LDX FAC1_2 ; get FAC1 mantissa2 |
STX FAC1_1 ; save FAC1 mantissa1 |
LDX FAC1_3 ; get FAC1 mantissa3 |
STX FAC1_2 ; save FAC1 mantissa2 |
LDX FAC1_r ; get FAC1 rounding byte |
STX FAC1_3 ; save FAC1 mantissa3 |
STY FAC1_r ; clear FAC1 rounding byte |
ADC #$08 ; add x to exponent offset |
CMP #$18 ; compare with $18 (max offset, all bits would be =0) |
BNE LAB_24D9 ; loop if not max |
|
; clear FAC1 exponent and sign |
|
LAB_24F1 |
LDA #$00 ; clear A |
LAB_24F3 |
STA FAC1_e ; set FAC1 exponent |
|
; save FAC1 sign |
|
LAB_24F5 |
STA FAC1_s ; save FAC1 sign (b7) |
RTS |
|
; add FAC2 mantissa to FAC1 mantissa |
|
LAB_24F8 |
ADC FAC2_r ; add FAC2 rounding byte |
STA FAC1_r ; save FAC1 rounding byte |
LDA FAC1_3 ; get FAC1 mantissa3 |
ADC FAC2_3 ; add FAC2 mantissa3 |
STA FAC1_3 ; save FAC1 mantissa3 |
LDA FAC1_2 ; get FAC1 mantissa2 |
ADC FAC2_2 ; add FAC2 mantissa2 |
STA FAC1_2 ; save FAC1 mantissa2 |
LDA FAC1_1 ; get FAC1 mantissa1 |
ADC FAC2_1 ; add FAC2 mantissa1 |
STA FAC1_1 ; save FAC1 mantissa1 |
BCS LAB_252A ; if carry then normalise FAC1 for C=1 |
|
RTS ; else just exit |
|
LAB_2511 |
ADC #$01 ; add 1 to exponent offset |
ASL FAC1_r ; shift FAC1 rounding byte |
ROL FAC1_3 ; shift FAC1 mantissa3 |
ROL FAC1_2 ; shift FAC1 mantissa2 |
ROL FAC1_1 ; shift FAC1 mantissa1 |
|
; normalise FAC1 |
|
LAB_251B |
BPL LAB_2511 ; loop if not normalised |
|
SEC ; set carry for subtract |
SBC FAC1_e ; subtract FAC1 exponent |
BCS LAB_24F1 ; branch if underflow (set result = $0) |
|
EOR #$FF ; complement exponent |
ADC #$01 ; +1 (twos complement) |
STA FAC1_e ; save FAC1 exponent |
|
; test and normalise FAC1 for C=0/1 |
|
LAB_2528 |
BCC LAB_2536 ; exit if no overflow |
|
; normalise FAC1 for C=1 |
|
LAB_252A |
INC FAC1_e ; increment FAC1 exponent |
BEQ LAB_2564 ; if zero do overflow error and warm start |
|
ROR FAC1_1 ; shift FAC1 mantissa1 |
ROR FAC1_2 ; shift FAC1 mantissa2 |
ROR FAC1_3 ; shift FAC1 mantissa3 |
ROR FAC1_r ; shift FAC1 rounding byte |
LAB_2536 |
RTS |
|
; negate FAC1 |
|
LAB_2537 |
LDA FAC1_s ; get FAC1 sign (b7) |
EOR #$FF ; complement it |
STA FAC1_s ; save FAC1 sign (b7) |
|
; twos complement FAC1 mantissa |
|
LAB_253D |
LDA FAC1_1 ; get FAC1 mantissa1 |
EOR #$FF ; complement it |
STA FAC1_1 ; save FAC1 mantissa1 |
LDA FAC1_2 ; get FAC1 mantissa2 |
EOR #$FF ; complement it |
STA FAC1_2 ; save FAC1 mantissa2 |
LDA FAC1_3 ; get FAC1 mantissa3 |
EOR #$FF ; complement it |
STA FAC1_3 ; save FAC1 mantissa3 |
LDA FAC1_r ; get FAC1 rounding byte |
EOR #$FF ; complement it |
STA FAC1_r ; save FAC1 rounding byte |
INC FAC1_r ; increment FAC1 rounding byte |
BNE LAB_2563 ; exit if no overflow |
|
; increment FAC1 mantissa |
|
LAB_2559 |
INC FAC1_3 ; increment FAC1 mantissa3 |
BNE LAB_2563 ; finished if no rollover |
|
INC FAC1_2 ; increment FAC1 mantissa2 |
BNE LAB_2563 ; finished if no rollover |
|
INC FAC1_1 ; increment FAC1 mantissa1 |
LAB_2563 |
RTS |
|
; do overflow error (overflow exit) |
|
LAB_2564 |
LDX #$0A ; error code $0A ("Overflow" error) |
JMP LAB_XERR ; do error #X, then warm start |
|
; shift FCAtemp << A+8 times |
|
LAB_2569 |
LDX #FACt_1-1 ; set offset to FACtemp |
LAB_256B |
LDY PLUS_3,X ; get FACX mantissa3 |
STY FAC1_r ; save as FAC1 rounding byte |
LDY PLUS_2,X ; get FACX mantissa2 |
STY PLUS_3,X ; save FACX mantissa3 |
LDY PLUS_1,X ; get FACX mantissa1 |
STY PLUS_2,X ; save FACX mantissa2 |
LDY FAC1_o ; get FAC1 overflow byte |
STY PLUS_1,X ; save FACX mantissa1 |
|
; shift FACX -A times right (> 8 shifts) |
|
LAB_257B |
ADC #$08 ; add 8 to shift count |
BMI LAB_256B ; go do 8 shift if still -ve |
|
BEQ LAB_256B ; go do 8 shift if zero |
|
SBC #$08 ; else subtract 8 again |
TAY ; save count to Y |
LDA FAC1_r ; get FAC1 rounding byte |
BCS LAB_259A ;. |
|
LAB_2588 |
ASL PLUS_1,X ; shift FACX mantissa1 |
BCC LAB_258E ; branch if +ve |
|
INC PLUS_1,X ; this sets b7 eventually |
LAB_258E |
ROR PLUS_1,X ; shift FACX mantissa1 (correct for ASL) |
ROR PLUS_1,X ; shift FACX mantissa1 (put carry in b7) |
|
; shift FACX Y times right |
|
LAB_2592 |
ROR PLUS_2,X ; shift FACX mantissa2 |
ROR PLUS_3,X ; shift FACX mantissa3 |
ROR ; shift FACX rounding byte |
INY ; increment exponent diff |
BNE LAB_2588 ; branch if range adjust not complete |
|
LAB_259A |
CLC ; just clear it |
RTS |
|
; perform LOG() |
|
LAB_LOG |
JSR LAB_27CA ; test sign and zero |
BEQ LAB_25C4 ; if zero do function call error then warm start |
|
BPL LAB_25C7 ; skip error if +ve |
|
LAB_25C4 |
JMP LAB_FCER ; do function call error then warm start (-ve) |
|
LAB_25C7 |
LDA FAC1_e ; get FAC1 exponent |
SBC #$7F ; normalise it |
PHA ; save it |
LDA #$80 ; set exponent to zero |
STA FAC1_e ; save FAC1 exponent |
LDA #<LAB_25AD ; set 1/root2 pointer low byte |
LDY #>LAB_25AD ; set 1/root2 pointer high byte |
JSR LAB_246C ; add (AY) to FAC1 (1/root2) |
LDA #<LAB_25B1 ; set root2 pointer low byte |
LDY #>LAB_25B1 ; set root2 pointer high byte |
JSR LAB_26CA ; convert AY and do (AY)/FAC1 (root2/(x+(1/root2))) |
LDA #<LAB_259C ; set 1 pointer low byte |
LDY #>LAB_259C ; set 1 pointer high byte |
JSR LAB_2455 ; subtract (AY) from FAC1 ((root2/(x+(1/root2)))-1) |
LDA #<LAB_25A0 ; set pointer low byte to counter |
LDY #>LAB_25A0 ; set pointer high byte to counter |
JSR LAB_2B6E ; ^2 then series evaluation |
LDA #<LAB_25B5 ; set -0.5 pointer low byte |
LDY #>LAB_25B5 ; set -0.5 pointer high byte |
JSR LAB_246C ; add (AY) to FAC1 |
PLA ; restore FAC1 exponent |
JSR LAB_2912 ; evaluate new ASCII digit |
LDA #<LAB_25B9 ; set LOG(2) pointer low byte |
LDY #>LAB_25B9 ; set LOG(2) pointer high byte |
|
; do convert AY, FCA1*(AY) |
|
LAB_25FB |
JSR LAB_264D ; unpack memory (AY) into FAC2 |
LAB_MULTIPLY |
BEQ LAB_264C ; exit if zero |
|
JSR LAB_2673 ; test and adjust accumulators |
LDA #$00 ; clear A |
STA FACt_1 ; clear temp mantissa1 |
STA FACt_2 ; clear temp mantissa2 |
STA FACt_3 ; clear temp mantissa3 |
LDA FAC1_r ; get FAC1 rounding byte |
JSR LAB_2622 ; go do shift/add FAC2 |
LDA FAC1_3 ; get FAC1 mantissa3 |
JSR LAB_2622 ; go do shift/add FAC2 |
LDA FAC1_2 ; get FAC1 mantissa2 |
JSR LAB_2622 ; go do shift/add FAC2 |
LDA FAC1_1 ; get FAC1 mantissa1 |
JSR LAB_2627 ; go do shift/add FAC2 |
JMP LAB_273C ; copy temp to FAC1, normalise and return |
|
LAB_2622 |
BNE LAB_2627 ; branch if byte <> zero |
|
JMP LAB_2569 ; shift FCAtemp << A+8 times |
|
; else do shift and add |
LAB_2627 |
LSR ; shift byte |
ORA #$80 ; set top bit (mark for 8 times) |
LAB_262A |
TAY ; copy result |
BCC LAB_2640 ; skip next if bit was zero |
|
CLC ; clear carry for add |
LDA FACt_3 ; get temp mantissa3 |
ADC FAC2_3 ; add FAC2 mantissa3 |
STA FACt_3 ; save temp mantissa3 |
LDA FACt_2 ; get temp mantissa2 |
ADC FAC2_2 ; add FAC2 mantissa2 |
STA FACt_2 ; save temp mantissa2 |
LDA FACt_1 ; get temp mantissa1 |
ADC FAC2_1 ; add FAC2 mantissa1 |
STA FACt_1 ; save temp mantissa1 |
LAB_2640 |
ROR FACt_1 ; shift temp mantissa1 |
ROR FACt_2 ; shift temp mantissa2 |
ROR FACt_3 ; shift temp mantissa3 |
ROR FAC1_r ; shift temp rounding byte |
TYA ; get byte back |
LSR ; shift byte |
BNE LAB_262A ; loop if all bits not done |
|
LAB_264C |
RTS |
|
; unpack memory (AY) into FAC2 |
|
LAB_264D |
STA ut1_pl ; save pointer low byte |
STY ut1_ph ; save pointer high byte |
LDY #$03 ; 4 bytes to get (0-3) |
LDA (ut1_pl),Y ; get mantissa3 |
STA FAC2_3 ; save FAC2 mantissa3 |
DEY ; decrement index |
LDA (ut1_pl),Y ; get mantissa2 |
STA FAC2_2 ; save FAC2 mantissa2 |
DEY ; decrement index |
LDA (ut1_pl),Y ; get mantissa1+sign |
STA FAC2_s ; save FAC2 sign (b7) |
EOR FAC1_s ; EOR with FAC1 sign (b7) |
STA FAC_sc ; save sign compare (FAC1 EOR FAC2) |
LDA FAC2_s ; recover FAC2 sign (b7) |
ORA #$80 ; set 1xxx xxx (set normal bit) |
STA FAC2_1 ; save FAC2 mantissa1 |
DEY ; decrement index |
LDA (ut1_pl),Y ; get exponent byte |
STA FAC2_e ; save FAC2 exponent |
LDA FAC1_e ; get FAC1 exponent |
RTS |
|
; test and adjust accumulators |
|
LAB_2673 |
LDA FAC2_e ; get FAC2 exponent |
LAB_2675 |
BEQ LAB_2696 ; branch if FAC2 = $00 (handle underflow) |
|
CLC ; clear carry for add |
ADC FAC1_e ; add FAC1 exponent |
BCC LAB_2680 ; branch if sum of exponents <$0100 |
|
BMI LAB_269B ; do overflow error |
|
CLC ; clear carry for the add |
.byte $2C ; makes next line BIT $1410 |
LAB_2680 |
BPL LAB_2696 ; if +ve go handle underflow |
|
ADC #$80 ; adjust exponent |
STA FAC1_e ; save FAC1 exponent |
BNE LAB_268B ; branch if not zero |
|
JMP LAB_24F5 ; save FAC1 sign and return |
|
LAB_268B |
LDA FAC_sc ; get sign compare (FAC1 EOR FAC2) |
STA FAC1_s ; save FAC1 sign (b7) |
LAB_268F |
RTS |
|
; handle overflow and underflow |
|
LAB_2690 |
LDA FAC1_s ; get FAC1 sign (b7) |
BPL LAB_269B ; do overflow error |
|
; handle underflow |
LAB_2696 |
PLA ; pop return address low byte |
PLA ; pop return address high byte |
JMP LAB_24F1 ; clear FAC1 exponent and sign and return |
|
; multiply by 10 |
|
LAB_269E |
JSR LAB_27AB ; round and copy FAC1 to FAC2 |
TAX ; copy exponent (set the flags) |
BEQ LAB_268F ; exit if zero |
|
CLC ; clear carry for add |
ADC #$02 ; add two to exponent (*4) |
BCS LAB_269B ; do overflow error if > $FF |
|
LDX #$00 ; clear byte |
STX FAC_sc ; clear sign compare (FAC1 EOR FAC2) |
JSR LAB_247C ; add FAC2 to FAC1 (*5) |
INC FAC1_e ; increment FAC1 exponent (*10) |
BNE LAB_268F ; if non zero just do RTS |
|
LAB_269B |
JMP LAB_2564 ; do overflow error and warm start |
|
; divide by 10 |
|
LAB_26B9 |
JSR LAB_27AB ; round and copy FAC1 to FAC2 |
LDA #<LAB_26B5 ; set pointer to 10d low addr |
LDY #>LAB_26B5 ; set pointer to 10d high addr |
LDX #$00 ; clear sign |
|
; divide by (AY) (X=sign) |
|
LAB_26C2 |
STX FAC_sc ; save sign compare (FAC1 EOR FAC2) |
JSR LAB_UFAC ; unpack memory (AY) into FAC1 |
JMP LAB_DIVIDE ; do FAC2/FAC1 |
|
; Perform divide-by |
; convert AY and do (AY)/FAC1 |
|
LAB_26CA |
JSR LAB_264D ; unpack memory (AY) into FAC2 |
|
; Perform divide-into |
LAB_DIVIDE |
BEQ LAB_2737 ; if zero go do /0 error |
|
JSR LAB_27BA ; round FAC1 |
LDA #$00 ; clear A |
SEC ; set carry for subtract |
SBC FAC1_e ; subtract FAC1 exponent (2s complement) |
STA FAC1_e ; save FAC1 exponent |
JSR LAB_2673 ; test and adjust accumulators |
INC FAC1_e ; increment FAC1 exponent |
BEQ LAB_269B ; if zero do overflow error |
|
LDX #$FF ; set index for pre increment |
LDA #$01 ; set bit to flag byte save |
LAB_26E4 |
LDY FAC2_1 ; get FAC2 mantissa1 |
CPY FAC1_1 ; compare FAC1 mantissa1 |
BNE LAB_26F4 ; branch if <> |
|
LDY FAC2_2 ; get FAC2 mantissa2 |
CPY FAC1_2 ; compare FAC1 mantissa2 |
BNE LAB_26F4 ; branch if <> |
|
LDY FAC2_3 ; get FAC2 mantissa3 |
CPY FAC1_3 ; compare FAC1 mantissa3 |
LAB_26F4 |
PHP ; save FAC2-FAC1 compare status |
ROL ; shift the result byte |
BCC LAB_2702 ; if no carry skip the byte save |
|
LDY #$01 ; set bit to flag byte save |
INX ; else increment the index to FACt |
CPX #$02 ; compare with the index to FACt_3 |
BMI LAB_2701 ; if not last byte just go save it |
|
BNE LAB_272B ; if all done go save FAC1 rounding byte, normalise and |
; return |
|
LDY #$40 ; set bit to flag byte save for the rounding byte |
LAB_2701 |
STA FACt_1,X ; write result byte to FACt_1 + index |
TYA ; copy the next save byte flag |
LAB_2702 |
PLP ; restore FAC2-FAC1 compare status |
BCC LAB_2704 ; if FAC2 < FAC1 then skip the subtract |
|
TAY ; save FAC2-FAC1 compare status |
LDA FAC2_3 ; get FAC2 mantissa3 |
SBC FAC1_3 ; subtract FAC1 mantissa3 |
STA FAC2_3 ; save FAC2 mantissa3 |
LDA FAC2_2 ; get FAC2 mantissa2 |
SBC FAC1_2 ; subtract FAC1 mantissa2 |
STA FAC2_2 ; save FAC2 mantissa2 |
LDA FAC2_1 ; get FAC2 mantissa1 |
SBC FAC1_1 ; subtract FAC1 mantissa1 |
STA FAC2_1 ; save FAC2 mantissa1 |
TYA ; restore FAC2-FAC1 compare status |
|
; FAC2 = FAC2*2 |
LAB_2704 |
ASL FAC2_3 ; shift FAC2 mantissa3 |
ROL FAC2_2 ; shift FAC2 mantissa2 |
ROL FAC2_1 ; shift FAC2 mantissa1 |
BCS LAB_26F4 ; loop with no compare |
|
BMI LAB_26E4 ; loop with compare |
|
BPL LAB_26F4 ; loop always with no compare |
|
; do A<<6, save as FAC1 rounding byte, normalise and return |
|
LAB_272B |
LSR ; shift b1 - b0 .. |
ROR ; .. |
ROR ; .. to b7 - b6 |
STA FAC1_r ; save FAC1 rounding byte |
PLP ; dump FAC2-FAC1 compare status |
JMP LAB_273C ; copy temp to FAC1, normalise and return |
|
; do "Divide by zero" error |
|
LAB_2737 |
LDX #$14 ; error code $14 ("Divide by zero" error) |
JMP LAB_XERR ; do error #X, then warm start |
|
; copy temp to FAC1 and normalise |
|
LAB_273C |
LDA FACt_1 ; get temp mantissa1 |
STA FAC1_1 ; save FAC1 mantissa1 |
LDA FACt_2 ; get temp mantissa2 |
STA FAC1_2 ; save FAC1 mantissa2 |
LDA FACt_3 ; get temp mantissa3 |
STA FAC1_3 ; save FAC1 mantissa3 |
JMP LAB_24D5 ; normalise FAC1 and return |
|
; unpack memory (AY) into FAC1 |
|
LAB_UFAC |
STA ut1_pl ; save pointer low byte |
STY ut1_ph ; save pointer high byte |
LDY #$03 ; 4 bytes to do |
LDA (ut1_pl),Y ; get last byte |
STA FAC1_3 ; save FAC1 mantissa3 |
DEY ; decrement index |
LDA (ut1_pl),Y ; get last-1 byte |
STA FAC1_2 ; save FAC1 mantissa2 |
DEY ; decrement index |
LDA (ut1_pl),Y ; get second byte |
STA FAC1_s ; save FAC1 sign (b7) |
ORA #$80 ; set 1xxx xxxx (add normal bit) |
STA FAC1_1 ; save FAC1 mantissa1 |
DEY ; decrement index |
LDA (ut1_pl),Y ; get first byte (exponent) |
STA FAC1_e ; save FAC1 exponent |
STY FAC1_r ; clear FAC1 rounding byte |
RTS |
|
; pack FAC1 into Adatal |
|
LAB_276E |
LDX #<Adatal ; set pointer low byte |
LAB_2770 |
LDY #>Adatal ; set pointer high byte |
BEQ LAB_2778 ; pack FAC1 into (XY) and return |
|
; pack FAC1 into (Lvarpl) |
|
LAB_PFAC |
LDX Lvarpl ; get destination pointer low byte |
LDY Lvarph ; get destination pointer high byte |
|
; pack FAC1 into (XY) |
|
LAB_2778 |
JSR LAB_27BA ; round FAC1 |
STX ut1_pl ; save pointer low byte |
STY ut1_ph ; save pointer high byte |
LDY #$03 ; set index |
LDA FAC1_3 ; get FAC1 mantissa3 |
STA (ut1_pl),Y ; store in destination |
DEY ; decrement index |
LDA FAC1_2 ; get FAC1 mantissa2 |
STA (ut1_pl),Y ; store in destination |
DEY ; decrement index |
LDA FAC1_s ; get FAC1 sign (b7) |
ORA #$7F ; set bits x111 1111 |
AND FAC1_1 ; AND in FAC1 mantissa1 |
STA (ut1_pl),Y ; store in destination |
DEY ; decrement index |
LDA FAC1_e ; get FAC1 exponent |
STA (ut1_pl),Y ; store in destination |
STY FAC1_r ; clear FAC1 rounding byte |
RTS |
|
; round and copy FAC1 to FAC2 |
|
LAB_27AB |
JSR LAB_27BA ; round FAC1 |
|
; copy FAC1 to FAC2 |
|
LAB_27AE |
LDX #$05 ; 5 bytes to copy |
LAB_27B0 |
LDA FAC1_e-1,X ; get byte from FAC1,X |
STA FAC1_o,X ; save byte at FAC2,X |
DEX ; decrement count |
BNE LAB_27B0 ; loop if not all done |
|
STX FAC1_r ; clear FAC1 rounding byte |
LAB_27B9 |
RTS |
|
; round FAC1 |
|
LAB_27BA |
LDA FAC1_e ; get FAC1 exponent |
BEQ LAB_27B9 ; exit if zero |
|
ASL FAC1_r ; shift FAC1 rounding byte |
BCC LAB_27B9 ; exit if no overflow |
|
; round FAC1 (no check) |
|
LAB_27C2 |
JSR LAB_2559 ; increment FAC1 mantissa |
BNE LAB_27B9 ; branch if no overflow |
|
JMP LAB_252A ; normalise FAC1 for C=1 and return |
|
; get FAC1 sign |
; return A=FF,C=1/-ve A=01,C=0/+ve |
|
LAB_27CA |
LDA FAC1_e ; get FAC1 exponent |
BEQ LAB_27D7 ; exit if zero (already correct SGN(0)=0) |
|
; return A=FF,C=1/-ve A=01,C=0/+ve |
; no = 0 check |
|
LAB_27CE |
LDA FAC1_s ; else get FAC1 sign (b7) |
|
; return A=FF,C=1/-ve A=01,C=0/+ve |
; no = 0 check, sign in A |
|
LAB_27D0 |
ROL ; move sign bit to carry |
LDA #$FF ; set byte for -ve result |
BCS LAB_27D7 ; return if sign was set (-ve) |
|
LDA #$01 ; else set byte for +ve result |
LAB_27D7 |
RTS |
|
; perform SGN() |
|
LAB_SGN |
JSR LAB_27CA ; get FAC1 sign |
; return A=$FF/-ve A=$01/+ve |
; save A as integer byte |
|
LAB_27DB |
STA FAC1_1 ; save FAC1 mantissa1 |
LDA #$00 ; clear A |
STA FAC1_2 ; clear FAC1 mantissa2 |
LDX #$88 ; set exponent |
|
; set exp=X, clearFAC1 mantissa3 and normalise |
|
LAB_27E3 |
LDA FAC1_1 ; get FAC1 mantissa1 |
EOR #$FF ; complement it |
ROL ; sign bit into carry |
|
; set exp=X, clearFAC1 mantissa3 and normalise |
|
LAB_STFA |
LDA #$00 ; clear A |
STA FAC1_3 ; clear FAC1 mantissa3 |
STX FAC1_e ; set FAC1 exponent |
STA FAC1_r ; clear FAC1 rounding byte |
STA FAC1_s ; clear FAC1 sign (b7) |
JMP LAB_24D0 ; do ABS and normalise FAC1 |
|
; perform ABS() |
|
LAB_ABS |
LSR FAC1_s ; clear FAC1 sign (put zero in b7) |
RTS |
|
; compare FAC1 with (AY) |
; returns A=$00 if FAC1 = (AY) |
; returns A=$01 if FAC1 > (AY) |
; returns A=$FF if FAC1 < (AY) |
|
LAB_27F8 |
STA ut2_pl ; save pointer low byte |
LAB_27FA |
STY ut2_ph ; save pointer high byte |
LDY #$00 ; clear index |
LDA (ut2_pl),Y ; get exponent |
INY ; increment index |
TAX ; copy (AY) exponent to X |
BEQ LAB_27CA ; branch if (AY) exponent=0 and get FAC1 sign |
; A=FF,C=1/-ve A=01,C=0/+ve |
|
LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign) |
EOR FAC1_s ; EOR FAC1 sign (b7) |
BMI LAB_27CE ; if signs <> do return A=FF,C=1/-ve |
; A=01,C=0/+ve and return |
|
CPX FAC1_e ; compare (AY) exponent with FAC1 exponent |
BNE LAB_2828 ; branch if different |
|
LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign) |
ORA #$80 ; normalise top bit |
CMP FAC1_1 ; compare with FAC1 mantissa1 |
BNE LAB_2828 ; branch if different |
|
INY ; increment index |
LDA (ut2_pl),Y ; get mantissa2 |
CMP FAC1_2 ; compare with FAC1 mantissa2 |
BNE LAB_2828 ; branch if different |
|
INY ; increment index |
LDA #$7F ; set for 1/2 value rounding byte |
CMP FAC1_r ; compare with FAC1 rounding byte (set carry) |
LDA (ut2_pl),Y ; get mantissa3 |
SBC FAC1_3 ; subtract FAC1 mantissa3 |
BEQ LAB_2850 ; exit if mantissa3 equal |
|
; gets here if number <> FAC1 |
|
LAB_2828 |
LDA FAC1_s ; get FAC1 sign (b7) |
BCC LAB_282E ; branch if FAC1 > (AY) |
|
EOR #$FF ; else toggle FAC1 sign |
LAB_282E |
JMP LAB_27D0 ; return A=FF,C=1/-ve A=01,C=0/+ve |
|
; convert FAC1 floating-to-fixed |
|
LAB_2831 |
LDA FAC1_e ; get FAC1 exponent |
BEQ LAB_287F ; if zero go clear FAC1 and return |
|
SEC ; set carry for subtract |
SBC #$98 ; subtract maximum integer range exponent |
BIT FAC1_s ; test FAC1 sign (b7) |
BPL LAB_2845 ; branch if FAC1 +ve |
|
; FAC1 was -ve |
TAX ; copy subtracted exponent |
LDA #$FF ; overflow for -ve number |
STA FAC1_o ; set FAC1 overflow byte |
JSR LAB_253D ; twos complement FAC1 mantissa |
TXA ; restore subtracted exponent |
LAB_2845 |
LDX #FAC1_e ; set index to FAC1 |
CMP #$F9 ; compare exponent result |
BPL LAB_2851 ; if < 8 shifts shift FAC1 A times right and return |
|
JSR LAB_257B ; shift FAC1 A times right (> 8 shifts) |
STY FAC1_o ; clear FAC1 overflow byte |
LAB_2850 |
RTS |
|
; shift FAC1 A times right |
|
LAB_2851 |
TAY ; copy shift count |
LDA FAC1_s ; get FAC1 sign (b7) |
AND #$80 ; mask sign bit only (x000 0000) |
LSR FAC1_1 ; shift FAC1 mantissa1 |
ORA FAC1_1 ; OR sign in b7 FAC1 mantissa1 |
STA FAC1_1 ; save FAC1 mantissa1 |
JSR LAB_2592 ; shift FAC1 Y times right |
STY FAC1_o ; clear FAC1 overflow byte |
RTS |
|
; perform INT() |
|
LAB_INT |
LDA FAC1_e ; get FAC1 exponent |
CMP #$98 ; compare with max int |
BCS LAB_2886 ; exit if >= (already int, too big for fractional part!) |
|
JSR LAB_2831 ; convert FAC1 floating-to-fixed |
STY FAC1_r ; save FAC1 rounding byte |
LDA FAC1_s ; get FAC1 sign (b7) |
STY FAC1_s ; save FAC1 sign (b7) |
EOR #$80 ; toggle FAC1 sign |
ROL ; shift into carry |
LDA #$98 ; set new exponent |
STA FAC1_e ; save FAC1 exponent |
LDA FAC1_3 ; get FAC1 mantissa3 |
STA Temp3 ; save for EXP() function |
JMP LAB_24D0 ; do ABS and normalise FAC1 |
|
; clear FAC1 and return |
|
LAB_287F |
STA FAC1_1 ; clear FAC1 mantissa1 |
STA FAC1_2 ; clear FAC1 mantissa2 |
STA FAC1_3 ; clear FAC1 mantissa3 |
TAY ; clear Y |
LAB_2886 |
RTS |
|
; get FAC1 from string |
; this routine now handles hex and binary values from strings |
; starting with "$" and "%" respectively |
|
LAB_2887 |
LDY #$00 ; clear Y |
STY Dtypef ; clear data type flag, $FF=string, $00=numeric |
LDX #$09 ; set index |
LAB_288B |
STY numexp,X ; clear byte |
DEX ; decrement index |
BPL LAB_288B ; loop until numexp to negnum (and FAC1) = $00 |
|
BCC LAB_28FE ; branch if 1st character numeric |
|
; get FAC1 from string .. first character wasn't numeric |
|
CMP #'-' ; else compare with "-" |
BNE LAB_289A ; branch if not "-" |
|
STX negnum ; set flag for -ve number (X = $FF) |
BEQ LAB_289C ; branch always (go scan and check for hex/bin) |
|
; get FAC1 from string .. first character wasn't numeric or - |
|
LAB_289A |
CMP #'+' ; else compare with "+" |
BNE LAB_289D ; branch if not "+" (go check for hex/bin) |
|
; was "+" or "-" to start, so get next character |
|
LAB_289C |
JSR LAB_IGBY ; increment and scan memory |
BCC LAB_28FE ; branch if numeric character |
|
; code here for hex and binary numbers |
|
LAB_289D |
CMP #'$' ; else compare with "$" |
BNE LAB_NHEX ; branch if not "$" |
|
JMP LAB_CHEX ; branch if "$" |
|
LAB_NHEX |
CMP #'%' ; else compare with "%" |
BNE LAB_28A3 ; branch if not "%" (continue original code) |
|
JMP LAB_CBIN ; branch if "%" |
|
LAB_289E |
JSR LAB_IGBY ; increment and scan memory (ignore + or get next number) |
LAB_28A1 |
BCC LAB_28FE ; branch if numeric character |
|
; get FAC1 from string .. character wasn't numeric, -, +, hex or binary |
|
LAB_28A3 |
CMP #'.' ; else compare with "." |
BEQ LAB_28D5 ; branch if "." |
|
; get FAC1 from string .. character wasn't numeric, -, + or . |
|
CMP #'E' ; else compare with "E" |
BNE LAB_28DB ; branch if not "E" |
|
; was "E" so evaluate exponential part |
JSR LAB_IGBY ; increment and scan memory |
BCC LAB_28C7 ; branch if numeric character |
|
CMP #TK_MINUS ; else compare with token for - |
BEQ LAB_28C2 ; branch if token for - |
|
CMP #'-' ; else compare with "-" |
BEQ LAB_28C2 ; branch if "-" |
|
CMP #TK_PLUS ; else compare with token for + |
BEQ LAB_28C4 ; branch if token for + |
|
CMP #'+' ; else compare with "+" |
BEQ LAB_28C4 ; branch if "+" |
|
BNE LAB_28C9 ; branch always |
|
LAB_28C2 |
ROR expneg ; set exponent -ve flag (C, which=1, into b7) |
LAB_28C4 |
JSR LAB_IGBY ; increment and scan memory |
LAB_28C7 |
BCC LAB_2925 ; branch if numeric character |
|
LAB_28C9 |
BIT expneg ; test exponent -ve flag |
BPL LAB_28DB ; if +ve go evaluate exponent |
|
; else do exponent = -exponent |
LDA #$00 ; clear result |
SEC ; set carry for subtract |
SBC expcnt ; subtract exponent byte |
JMP LAB_28DD ; go evaluate exponent |
|
LAB_28D5 |
ROR numdpf ; set decimal point flag |
BIT numdpf ; test decimal point flag |
BVC LAB_289E ; branch if only one decimal point so far |
|
; evaluate exponent |
LAB_28DB |
LDA expcnt ; get exponent count byte |
LAB_28DD |
SEC ; set carry for subtract |
SBC numexp ; subtract numerator exponent |
STA expcnt ; save exponent count byte |
BEQ LAB_28F6 ; branch if no adjustment |
|
BPL LAB_28EF ; else if +ve go do FAC1*10^expcnt |
|
; else go do FAC1/10^(0-expcnt) |
LAB_28E6 |
JSR LAB_26B9 ; divide by 10 |
INC expcnt ; increment exponent count byte |
BNE LAB_28E6 ; loop until all done |
|
BEQ LAB_28F6 ; branch always |
|
LAB_28EF |
JSR LAB_269E ; multiply by 10 |
DEC expcnt ; decrement exponent count byte |
BNE LAB_28EF ; loop until all done |
|
LAB_28F6 |
LDA negnum ; get -ve flag |
BMI LAB_28FB ; if -ve do - FAC1 and return |
|
RTS |
|
; do - FAC1 and return |
|
LAB_28FB |
JMP LAB_GTHAN ; do - FAC1 and return |
|
; do unsigned FAC1*10+number |
|
LAB_28FE |
PHA ; save character |
BIT numdpf ; test decimal point flag |
BPL LAB_2905 ; skip exponent increment if not set |
|
INC numexp ; else increment number exponent |
LAB_2905 |
JSR LAB_269E ; multiply FAC1 by 10 |
PLA ; restore character |
AND #$0F ; convert to binary |
JSR LAB_2912 ; evaluate new ASCII digit |
JMP LAB_289E ; go do next character |
|
; evaluate new ASCII digit |
|
LAB_2912 |
PHA ; save digit |
JSR LAB_27AB ; round and copy FAC1 to FAC2 |
PLA ; restore digit |
JSR LAB_27DB ; save A as integer byte |
LDA FAC2_s ; get FAC2 sign (b7) |
EOR FAC1_s ; toggle with FAC1 sign (b7) |
STA FAC_sc ; save sign compare (FAC1 EOR FAC2) |
LDX FAC1_e ; get FAC1 exponent |
JMP LAB_ADD ; add FAC2 to FAC1 and return |
|
; evaluate next character of exponential part of number |
|
LAB_2925 |
LDA expcnt ; get exponent count byte |
CMP #$0A ; compare with 10 decimal |
BCC LAB_2934 ; branch if less |
|
LDA #$64 ; make all -ve exponents = -100 decimal (causes underflow) |
BIT expneg ; test exponent -ve flag |
BMI LAB_2942 ; branch if -ve |
|
JMP LAB_2564 ; else do overflow error |
|
LAB_2934 |
ASL ; * 2 |
ASL ; * 4 |
ADC expcnt ; * 5 |
ASL ; * 10 |
LDY #$00 ; set index |
ADC (Bpntrl),Y ; add character (will be $30 too much!) |
SBC #'0'-1 ; convert character to binary |
LAB_2942 |
STA expcnt ; save exponent count byte |
JMP LAB_28C4 ; go get next character |
|
; print " in line [LINE #]" |
|
LAB_2953 |
LDA #<LAB_LMSG ; point to " in line " message low byte |
LDY #>LAB_LMSG ; point to " in line " message high byte |
JSR LAB_18C3 ; print null terminated string from memory |
|
; print Basic line # |
LDA Clineh ; get current line high byte |
LDX Clinel ; get current line low byte |
|
; print XA as unsigned integer |
|
LAB_295E |
STA FAC1_1 ; save low byte as FAC1 mantissa1 |
STX FAC1_2 ; save high byte as FAC1 mantissa2 |
LDX #$90 ; set exponent to 16d bits |
SEC ; set integer is +ve flag |
JSR LAB_STFA ; set exp=X, clearFAC1 mantissa3 and normalise |
LDY #$00 ; clear index |
TYA ; clear A |
JSR LAB_297B ; convert FAC1 to string, skip sign character save |
JMP LAB_18C3 ; print null terminated string from memory and return |
|
; convert FAC1 to ASCII string result in (AY) |
; not any more, moved scratchpad to page 0 |
|
LAB_296E |
LDY #$01 ; set index = 1 |
LDA #$20 ; character = " " (assume +ve) |
BIT FAC1_s ; test FAC1 sign (b7) |
BPL LAB_2978 ; branch if +ve |
|
LDA #$2D ; else character = "-" |
LAB_2978 |
STA Decss,Y ; save leading character (" " or "-") |
LAB_297B |
STA FAC1_s ; clear FAC1 sign (b7) |
STY Sendl ; save index |
INY ; increment index |
LDX FAC1_e ; get FAC1 exponent |
BNE LAB_2989 ; branch if FAC1<>0 |
|
; exponent was $00 so FAC1 is 0 |
LDA #'0' ; set character = "0" |
JMP LAB_2A89 ; save last character, [EOT] and exit |
|
; FAC1 is some non zero value |
LAB_2989 |
LDA #$00 ; clear (number exponent count) |
CPX #$81 ; compare FAC1 exponent with $81 (>1.00000) |
|
BCS LAB_299A ; branch if FAC1=>1 |
|
; FAC1<1 |
LDA #<LAB_294F ; set pointer low byte to 1,000,000 |
LDY #>LAB_294F ; set pointer high byte to 1,000,000 |
JSR LAB_25FB ; do convert AY, FCA1*(AY) |
LDA #$FA ; set number exponent count (-6) |
LAB_299A |
STA numexp ; save number exponent count |
LAB_299C |
LDA #<LAB_294B ; set pointer low byte to 999999.4375 (max before sci note) |
LDY #>LAB_294B ; set pointer high byte to 999999.4375 |
JSR LAB_27F8 ; compare FAC1 with (AY) |
BEQ LAB_29C3 ; exit if FAC1 = (AY) |
|
BPL LAB_29B9 ; go do /10 if FAC1 > (AY) |
|
; FAC1 < (AY) |
LAB_29A7 |
LDA #<LAB_2947 ; set pointer low byte to 99999.9375 |
LDY #>LAB_2947 ; set pointer high byte to 99999.9375 |
JSR LAB_27F8 ; compare FAC1 with (AY) |
BEQ LAB_29B2 ; branch if FAC1 = (AY) (allow decimal places) |
|
BPL LAB_29C0 ; branch if FAC1 > (AY) (no decimal places) |
|
; FAC1 <= (AY) |
LAB_29B2 |
JSR LAB_269E ; multiply by 10 |
DEC numexp ; decrement number exponent count |
BNE LAB_29A7 ; go test again (branch always) |
|
LAB_29B9 |
JSR LAB_26B9 ; divide by 10 |
INC numexp ; increment number exponent count |
BNE LAB_299C ; go test again (branch always) |
|
; now we have just the digits to do |
|
LAB_29C0 |
JSR LAB_244E ; add 0.5 to FAC1 (round FAC1) |
LAB_29C3 |
JSR LAB_2831 ; convert FAC1 floating-to-fixed |
LDX #$01 ; set default digits before dp = 1 |
LDA numexp ; get number exponent count |
CLC ; clear carry for add |
ADC #$07 ; up to 6 digits before point |
BMI LAB_29D8 ; if -ve then 1 digit before dp |
|
CMP #$08 ; A>=8 if n>=1E6 |
BCS LAB_29D9 ; branch if >= $08 |
|
; carry is clear |
ADC #$FF ; take 1 from digit count |
TAX ; copy to A |
LDA #$02 ;.set exponent adjust |
LAB_29D8 |
SEC ; set carry for subtract |
LAB_29D9 |
SBC #$02 ; -2 |
STA expcnt ;.save exponent adjust |
STX numexp ; save digits before dp count |
TXA ; copy to A |
BEQ LAB_29E4 ; branch if no digits before dp |
|
BPL LAB_29F7 ; branch if digits before dp |
|
LAB_29E4 |
LDY Sendl ; get output string index |
LDA #$2E ; character "." |
INY ; increment index |
STA Decss,Y ; save to output string |
TXA ;. |
BEQ LAB_29F5 ;. |
|
LDA #'0' ; character "0" |
INY ; increment index |
STA Decss,Y ; save to output string |
LAB_29F5 |
STY Sendl ; save output string index |
LAB_29F7 |
LDY #$00 ; clear index (point to 100,000) |
LDX #$80 ; |
LAB_29FB |
LDA FAC1_3 ; get FAC1 mantissa3 |
CLC ; clear carry for add |
ADC LAB_2A9C,Y ; add -ve LSB |
STA FAC1_3 ; save FAC1 mantissa3 |
LDA FAC1_2 ; get FAC1 mantissa2 |
ADC LAB_2A9B,Y ; add -ve NMSB |
STA FAC1_2 ; save FAC1 mantissa2 |
LDA FAC1_1 ; get FAC1 mantissa1 |
ADC LAB_2A9A,Y ; add -ve MSB |
STA FAC1_1 ; save FAC1 mantissa1 |
INX ; |
BCS LAB_2A18 ; |
|
BPL LAB_29FB ; not -ve so try again |
|
BMI LAB_2A1A ; |
|
LAB_2A18 |
BMI LAB_29FB ; |
|
LAB_2A1A |
TXA ; |
BCC LAB_2A21 ; |
|
EOR #$FF ; |
ADC #$0A ; |
LAB_2A21 |
ADC #'0'-1 ; add "0"-1 to result |
INY ; increment index .. |
INY ; .. to next less .. |
INY ; .. power of ten |
STY Cvaral ; save as current var address low byte |
LDY Sendl ; get output string index |
INY ; increment output string index |
TAX ; copy character to X |
AND #$7F ; mask out top bit |
STA Decss,Y ; save to output string |
DEC numexp ; decrement # of characters before the dp |
BNE LAB_2A3B ; branch if still characters to do |
|
; else output the point |
LDA #$2E ; character "." |
INY ; increment output string index |
STA Decss,Y ; save to output string |
LAB_2A3B |
STY Sendl ; save output string index |
LDY Cvaral ; get current var address low byte |
TXA ; get character back |
EOR #$FF ; |
AND #$80 ; |
TAX ; |
CPY #$12 ; compare index with max |
BNE LAB_29FB ; loop if not max |
|
; now remove trailing zeroes |
LDY Sendl ; get output string index |
LAB_2A4B |
LDA Decss,Y ; get character from output string |
DEY ; decrement output string index |
CMP #'0' ; compare with "0" |
BEQ LAB_2A4B ; loop until non "0" character found |
|
CMP #'.' ; compare with "." |
BEQ LAB_2A58 ; branch if was dp |
|
; restore last character |
INY ; increment output string index |
LAB_2A58 |
LDA #$2B ; character "+" |
LDX expcnt ; get exponent count |
BEQ LAB_2A8C ; if zero go set null terminator and exit |
|
; exponent isn't zero so write exponent |
BPL LAB_2A68 ; branch if exponent count +ve |
|
LDA #$00 ; clear A |
SEC ; set carry for subtract |
SBC expcnt ; subtract exponent count adjust (convert -ve to +ve) |
TAX ; copy exponent count to X |
LDA #'-' ; character "-" |
LAB_2A68 |
STA Decss+2,Y ; save to output string |
LDA #$45 ; character "E" |
STA Decss+1,Y ; save exponent sign to output string |
TXA ; get exponent count back |
LDX #'0'-1 ; one less than "0" character |
SEC ; set carry for subtract |
LAB_2A74 |
INX ; increment 10's character |
SBC #$0A ;.subtract 10 from exponent count |
BCS LAB_2A74 ; loop while still >= 0 |
|
ADC #':' ; add character ":" ($30+$0A, result is 10 less that value) |
STA Decss+4,Y ; save to output string |
TXA ; copy 10's character |
STA Decss+3,Y ; save to output string |
LDA #$00 ; set null terminator |
STA Decss+5,Y ; save to output string |
BEQ LAB_2A91 ; go set string pointer (AY) and exit (branch always) |
|
; save last character, [EOT] and exit |
LAB_2A89 |
STA Decss,Y ; save last character to output string |
|
; set null terminator and exit |
LAB_2A8C |
LDA #$00 ; set null terminator |
STA Decss+1,Y ; save after last character |
|
; set string pointer (AY) and exit |
LAB_2A91 |
LDA #<Decssp1 ; set result string low pointer |
LDY #>Decssp1 ; set result string high pointer |
RTS |
|
; perform power function |
|
LAB_POWER |
BEQ LAB_EXP ; go do EXP() |
|
LDA FAC2_e ; get FAC2 exponent |
BNE LAB_2ABF ; branch if FAC2<>0 |
|
JMP LAB_24F3 ; clear FAC1 exponent and sign and return |
|
LAB_2ABF |
LDX #<func_l ; set destination pointer low byte |
LDY #>func_l ; set destination pointer high byte |
JSR LAB_2778 ; pack FAC1 into (XY) |
LDA FAC2_s ; get FAC2 sign (b7) |
BPL LAB_2AD9 ; branch if FAC2>0 |
|
; else FAC2 is -ve and can only be raised to an |
; integer power which gives an x +j0 result |
JSR LAB_INT ; perform INT |
LDA #<func_l ; set source pointer low byte |
LDY #>func_l ; set source pointer high byte |
JSR LAB_27F8 ; compare FAC1 with (AY) |
BNE LAB_2AD9 ; branch if FAC1 <> (AY) to allow Function Call error |
; this will leave FAC1 -ve and cause a Function Call |
; error when LOG() is called |
|
TYA ; clear sign b7 |
LDY Temp3 ; save mantissa 3 from INT() function as sign in Y |
; for possible later negation, b0 |
LAB_2AD9 |
JSR LAB_279D ; save FAC1 sign and copy ABS(FAC2) to FAC1 |
TYA ; copy sign back .. |
PHA ; .. and save it |
JSR LAB_LOG ; do LOG(n) |
LDA #<garb_l ; set pointer low byte |
LDY #>garb_l ; set pointer high byte |
JSR LAB_25FB ; do convert AY, FCA1*(AY) (square the value) |
JSR LAB_EXP ; go do EXP(n) |
PLA ; pull sign from stack |
LSR ; b0 is to be tested, shift to Cb |
BCC LAB_2AF9 ; if no bit then exit |
|
; Perform negation |
; do - FAC1 |
|
LAB_GTHAN |
LDA FAC1_e ; get FAC1 exponent |
BEQ LAB_2AF9 ; exit if FAC1_e = $00 |
|
LDA FAC1_s ; get FAC1 sign (b7) |
EOR #$FF ; complement it |
STA FAC1_s ; save FAC1 sign (b7) |
LAB_2AF9 |
RTS |
|
; perform EXP() (x^e) |
|
LAB_EXP |
LDA #<LAB_2AFA ; set 1.443 pointer low byte |
LDY #>LAB_2AFA ; set 1.443 pointer high byte |
JSR LAB_25FB ; do convert AY, FCA1*(AY) |
LDA FAC1_r ; get FAC1 rounding byte |
ADC #$50 ; +$50/$100 |
BCC LAB_2B2B ; skip rounding if no carry |
|
JSR LAB_27C2 ; round FAC1 (no check) |
LAB_2B2B |
STA FAC2_r ; save FAC2 rounding byte |
JSR LAB_27AE ; copy FAC1 to FAC2 |
LDA FAC1_e ; get FAC1 exponent |
CMP #$88 ; compare with EXP limit (256d) |
BCC LAB_2B39 ; branch if less |
|
LAB_2B36 |
JSR LAB_2690 ; handle overflow and underflow |
LAB_2B39 |
JSR LAB_INT ; perform INT |
LDA Temp3 ; get mantissa 3 from INT() function |
CLC ; clear carry for add |
ADC #$81 ; normalise +1 |
BEQ LAB_2B36 ; if $00 go handle overflow |
|
SEC ; set carry for subtract |
SBC #$01 ; now correct for exponent |
PHA ; save FAC2 exponent |
|
; swap FAC1 and FAC2 |
LDX #$04 ; 4 bytes to do |
LAB_2B49 |
LDA FAC2_e,X ; get FAC2,X |
LDY FAC1_e,X ; get FAC1,X |
STA FAC1_e,X ; save FAC1,X |
STY FAC2_e,X ; save FAC2,X |
DEX ; decrement count/index |
BPL LAB_2B49 ; loop if not all done |
|
LDA FAC2_r ; get FAC2 rounding byte |
STA FAC1_r ; save as FAC1 rounding byte |
JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1 |
JSR LAB_GTHAN ; do - FAC1 |
LDA #<LAB_2AFE ; set counter pointer low byte |
LDY #>LAB_2AFE ; set counter pointer high byte |
JSR LAB_2B84 ; go do series evaluation |
LDA #$00 ; clear A |
STA FAC_sc ; clear sign compare (FAC1 EOR FAC2) |
PLA ;.get saved FAC2 exponent |
JMP LAB_2675 ; test and adjust accumulators and return |
|
; ^2 then series evaluation |
|
LAB_2B6E |
STA Cptrl ; save count pointer low byte |
STY Cptrh ; save count pointer high byte |
JSR LAB_276E ; pack FAC1 into Adatal |
LDA #<Adatal ; set pointer low byte (Y already $00) |
JSR LAB_25FB ; do convert AY, FCA1*(AY) |
JSR LAB_2B88 ; go do series evaluation |
LDA #<Adatal ; pointer to original # low byte |
LDY #>Adatal ; pointer to original # high byte |
JMP LAB_25FB ; do convert AY, FCA1*(AY) and return |
|
; series evaluation |
|
LAB_2B84 |
STA Cptrl ; save count pointer low byte |
STY Cptrh ; save count pointer high byte |
LAB_2B88 |
LDX #<numexp ; set pointer low byte |
JSR LAB_2770 ; set pointer high byte and pack FAC1 into numexp |
LDA (Cptrl),Y ; get constants count |
STA numcon ; save constants count |
LDY Cptrl ; get count pointer low byte |
INY ; increment it (now constants pointer) |
TYA ; copy it |
BNE LAB_2B97 ; skip next if no overflow |
|
INC Cptrh ; else increment high byte |
LAB_2B97 |
STA Cptrl ; save low byte |
LDY Cptrh ; get high byte |
LAB_2B9B |
JSR LAB_25FB ; do convert AY, FCA1*(AY) |
LDA Cptrl ; get constants pointer low byte |
LDY Cptrh ; get constants pointer high byte |
CLC ; clear carry for add |
ADC #$04 ; +4 to low pointer (4 bytes per constant) |
BCC LAB_2BA8 ; skip next if no overflow |
|
INY ; increment high byte |
LAB_2BA8 |
STA Cptrl ; save pointer low byte |
STY Cptrh ; save pointer high byte |
JSR LAB_246C ; add (AY) to FAC1 |
LDA #<numexp ; set pointer low byte to partial @ numexp |
LDY #>numexp ; set pointer high byte to partial @ numexp |
DEC numcon ; decrement constants count |
BNE LAB_2B9B ; loop until all done |
|
RTS |
|
; RND(n), 32 bit Galoise version. make n=0 for 19th next number in sequence or n<>0 |
; to get 19th next number in sequence after seed n. This version of the PRNG uses |
; the Galois method and a sample of 65536 bytes produced gives the following values. |
|
; Entropy = 7.997442 bits per byte |
; Optimum compression would reduce these 65536 bytes by 0 percent |
|
; Chi square distribution for 65536 samples is 232.01, and |
; randomly would exceed this value 75.00 percent of the time |
|
; Arithmetic mean value of data bytes is 127.6724, 127.5 would be random |
; Monte Carlo value for Pi is 3.122871269, error 0.60 percent |
; Serial correlation coefficient is -0.000370, totally uncorrelated would be 0.0 |
|
LAB_RND |
LDA FAC1_e ; get FAC1 exponent |
BEQ NextPRN ; do next random # if zero |
|
; else get seed into random number store |
LDX #Rbyte4 ; set PRNG pointer low byte |
LDY #$00 ; set PRNG pointer high byte |
JSR LAB_2778 ; pack FAC1 into (XY) |
NextPRN |
LDX #$AF ; set EOR byte |
LDY #$13 ; do this nineteen times |
LoopPRN |
ASL Rbyte1 ; shift PRNG most significant byte |
ROL Rbyte2 ; shift PRNG middle byte |
ROL Rbyte3 ; shift PRNG least significant byte |
ROL Rbyte4 ; shift PRNG extra byte |
BCC Ninc1 ; branch if bit 32 clear |
|
TXA ; set EOR byte |
EOR Rbyte1 ; EOR PRNG extra byte |
STA Rbyte1 ; save new PRNG extra byte |
Ninc1 |
DEY ; decrement loop count |
BNE LoopPRN ; loop if not all done |
|
LDX #$02 ; three bytes to copy |
CopyPRNG |
LDA Rbyte1,X ; get PRNG byte |
STA FAC1_1,X ; save FAC1 byte |
DEX |
BPL CopyPRNG ; loop if not complete |
|
LDA #$80 ; set the exponent |
STA FAC1_e ; save FAC1 exponent |
|
ASL ; clear A |
STA FAC1_s ; save FAC1 sign |
|
JMP LAB_24D5 ; normalise FAC1 and return |
|
; perform COS() |
|
LAB_COS |
LDA #<LAB_2C78 ; set (pi/2) pointer low byte |
LDY #>LAB_2C78 ; set (pi/2) pointer high byte |
JSR LAB_246C ; add (AY) to FAC1 |
|
; perform SIN() |
|
LAB_SIN |
JSR LAB_27AB ; round and copy FAC1 to FAC2 |
LDA #<LAB_2C7C ; set (2*pi) pointer low byte |
LDY #>LAB_2C7C ; set (2*pi) pointer high byte |
LDX FAC2_s ; get FAC2 sign (b7) |
JSR LAB_26C2 ; divide by (AY) (X=sign) |
JSR LAB_27AB ; round and copy FAC1 to FAC2 |
JSR LAB_INT ; perform INT |
LDA #$00 ; clear byte |
STA FAC_sc ; clear sign compare (FAC1 EOR FAC2) |
JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1 |
LDA #<LAB_2C80 ; set 0.25 pointer low byte |
LDY #>LAB_2C80 ; set 0.25 pointer high byte |
JSR LAB_2455 ; perform subtraction, (AY) from FAC1 |
LDA FAC1_s ; get FAC1 sign (b7) |
PHA ; save FAC1 sign |
BPL LAB_2C35 ; branch if +ve |
|
; FAC1 sign was -ve |
JSR LAB_244E ; add 0.5 to FAC1 |
LDA FAC1_s ; get FAC1 sign (b7) |
BMI LAB_2C38 ; branch if -ve |
|
LDA Cflag ; get comparison evaluation flag |
EOR #$FF ; toggle flag |
STA Cflag ; save comparison evaluation flag |
LAB_2C35 |
JSR LAB_GTHAN ; do - FAC1 |
LAB_2C38 |
LDA #<LAB_2C80 ; set 0.25 pointer low byte |
LDY #>LAB_2C80 ; set 0.25 pointer high byte |
JSR LAB_246C ; add (AY) to FAC1 |
PLA ; restore FAC1 sign |
BPL LAB_2C45 ; branch if was +ve |
|
; else correct FAC1 |
JSR LAB_GTHAN ; do - FAC1 |
LAB_2C45 |
LDA #<LAB_2C84 ; set pointer low byte to counter |
LDY #>LAB_2C84 ; set pointer high byte to counter |
JMP LAB_2B6E ; ^2 then series evaluation and return |
|
; perform TAN() |
|
LAB_TAN |
JSR LAB_276E ; pack FAC1 into Adatal |
LDA #$00 ; clear byte |
STA Cflag ; clear comparison evaluation flag |
JSR LAB_SIN ; go do SIN(n) |
LDX #<func_l ; set sin(n) pointer low byte |
LDY #>func_l ; set sin(n) pointer high byte |
JSR LAB_2778 ; pack FAC1 into (XY) |
LDA #<Adatal ; set n pointer low addr |
LDY #>Adatal ; set n pointer high addr |
JSR LAB_UFAC ; unpack memory (AY) into FAC1 |
LDA #$00 ; clear byte |
STA FAC1_s ; clear FAC1 sign (b7) |
LDA Cflag ; get comparison evaluation flag |
JSR LAB_2C74 ; save flag and go do series evaluation |
|
LDA #<func_l ; set sin(n) pointer low byte |
LDY #>func_l ; set sin(n) pointer high byte |
JMP LAB_26CA ; convert AY and do (AY)/FAC1 |
|
LAB_2C74 |
PHA ; save comparison evaluation flag |
JMP LAB_2C35 ; go do series evaluation |
|
; perform USR() |
|
LAB_USR |
JSR Usrjmp ; call user code |
JMP LAB_1BFB ; scan for ")", else do syntax error then warm start |
|
; perform ATN() |
|
LAB_ATN |
LDA FAC1_s ; get FAC1 sign (b7) |
PHA ; save sign |
BPL LAB_2CA1 ; branch if +ve |
|
JSR LAB_GTHAN ; else do - FAC1 |
LAB_2CA1 |
LDA FAC1_e ; get FAC1 exponent |
PHA ; push exponent |
CMP #$81 ; compare with 1 |
BCC LAB_2CAF ; branch if FAC1<1 |
|
LDA #<LAB_259C ; set 1 pointer low byte |
LDY #>LAB_259C ; set 1 pointer high byte |
JSR LAB_26CA ; convert AY and do (AY)/FAC1 |
LAB_2CAF |
LDA #<LAB_2CC9 ; set pointer low byte to counter |
LDY #>LAB_2CC9 ; set pointer high byte to counter |
JSR LAB_2B6E ; ^2 then series evaluation |
PLA ; restore old FAC1 exponent |
CMP #$81 ; compare with 1 |
BCC LAB_2CC2 ; branch if FAC1<1 |
|
LDA #<LAB_2C78 ; set (pi/2) pointer low byte |
LDY #>LAB_2C78 ; set (pi/2) pointer high byte |
JSR LAB_2455 ; perform subtraction, (AY) from FAC1 |
LAB_2CC2 |
PLA ; restore FAC1 sign |
BPL LAB_2D04 ; exit if was +ve |
|
JMP LAB_GTHAN ; else do - FAC1 and return |
|
; perform BITSET |
|
LAB_BITSET |
JSR LAB_GADB ; get two parameters for POKE or WAIT |
CPX #$08 ; only 0 to 7 are allowed |
BCS FCError ; branch if > 7 |
|
LDA #$00 ; clear A |
SEC ; set the carry |
S_Bits |
ROL ; shift bit |
DEX ; decrement bit number |
BPL S_Bits ; loop if still +ve |
|
INX ; make X = $00 |
ORA (Itempl,X) ; or with byte via temporary integer (addr) |
STA (Itempl,X) ; save byte via temporary integer (addr) |
LAB_2D04 |
RTS |
|
; perform BITCLR |
|
LAB_BITCLR |
JSR LAB_GADB ; get two parameters for POKE or WAIT |
CPX #$08 ; only 0 to 7 are allowed |
BCS FCError ; branch if > 7 |
|
LDA #$FF ; set A |
S_Bitc |
ROL ; shift bit |
DEX ; decrement bit number |
BPL S_Bitc ; loop if still +ve |
|
INX ; make X = $00 |
AND (Itempl,X) ; and with byte via temporary integer (addr) |
STA (Itempl,X) ; save byte via temporary integer (addr) |
RTS |
|
FCError |
JMP LAB_FCER ; do function call error then warm start |
|
; perform BITTST() |
|
LAB_BTST |
JSR LAB_IGBY ; increment BASIC pointer |
JSR LAB_GADB ; get two parameters for POKE or WAIT |
CPX #$08 ; only 0 to 7 are allowed |
BCS FCError ; branch if > 7 |
|
JSR LAB_GBYT ; get next BASIC byte |
CMP #')' ; is next character ")" |
BEQ TST_OK ; if ")" go do rest of function |
|
JMP LAB_SNER ; do syntax error then warm start |
|
TST_OK |
JSR LAB_IGBY ; update BASIC execute pointer (to character past ")") |
LDA #$00 ; clear A |
SEC ; set the carry |
T_Bits |
ROL ; shift bit |
DEX ; decrement bit number |
BPL T_Bits ; loop if still +ve |
|
INX ; make X = $00 |
AND (Itempl,X) ; AND with byte via temporary integer (addr) |
BEQ LAB_NOTT ; branch if zero (already correct) |
|
LDA #$FF ; set for -1 result |
LAB_NOTT |
JMP LAB_27DB ; go do SGN tail |
|
; perform BIN$() |
|
LAB_BINS |
CPX #$19 ; max + 1 |
BCS BinFErr ; exit if too big ( > or = ) |
|
STX TempB ; save # of characters ($00 = leading zero remove) |
LDA #$18 ; need A byte long space |
JSR LAB_MSSP ; make string space A bytes long |
LDY #$17 ; set index |
LDX #$18 ; character count |
NextB1 |
LSR nums_1 ; shift highest byte |
ROR nums_2 ; shift middle byte |
ROR nums_3 ; shift lowest byte bit 0 to carry |
TXA ; load with "0"/2 |
ROL ; shift in carry |
STA (str_pl),Y ; save to temp string + index |
DEY ; decrement index |
BPL NextB1 ; loop if not done |
|
LDA TempB ; get # of characters |
BEQ EndBHS ; branch if truncate |
|
TAX ; copy length to X |
SEC ; set carry for add ! |
EOR #$FF ; 1's complement |
ADC #$18 ; add 24d |
BEQ GoPr2 ; if zero print whole string |
|
BNE GoPr1 ; else go make output string |
|
; this is the exit code and is also used by HEX$() |
; truncate string to remove leading "0"s |
|
EndBHS |
TAY ; clear index (A=0, X=length here) |
NextB2 |
LDA (str_pl),Y ; get character from string |
CMP #'0' ; compare with "0" |
BNE GoPr ; if not "0" then go print string from here |
|
DEX ; decrement character count |
BEQ GoPr3 ; if zero then end of string so go print it |
|
INY ; else increment index |
BPL NextB2 ; loop always |
|
; make fixed length output string - ignore overflows! |
|
GoPr3 |
INX ; need at least 1 character |
GoPr |
TYA ; copy result |
GoPr1 |
CLC ; clear carry for add |
ADC str_pl ; add low address |
STA str_pl ; save low address |
LDA #$00 ; do high byte |
ADC str_ph ; add high address |
STA str_ph ; save high address |
GoPr2 |
STX str_ln ; X holds string length |
JSR LAB_IGBY ; update BASIC execute pointer (to character past ")") |
JMP LAB_RTST ; check for space on descriptor stack then put address |
; and length on descriptor stack and update stack pointers |
|
BinFErr |
JMP LAB_FCER ; do function call error then warm start |
|
; perform HEX$() |
|
LAB_HEXS |
CPX #$07 ; max + 1 |
BCS BinFErr ; exit if too big ( > or = ) |
|
STX TempB ; save # of characters |
|
LDA #$06 ; need 6 bytes for string |
JSR LAB_MSSP ; make string space A bytes long |
LDY #$05 ; set string index |
|
SED ; need decimal mode for nibble convert |
LDA nums_3 ; get lowest byte |
JSR LAB_A2HX ; convert A to ASCII hex byte and output |
LDA nums_2 ; get middle byte |
JSR LAB_A2HX ; convert A to ASCII hex byte and output |
LDA nums_1 ; get highest byte |
JSR LAB_A2HX ; convert A to ASCII hex byte and output |
CLD ; back to binary |
|
LDX #$06 ; character count |
LDA TempB ; get # of characters |
BEQ EndBHS ; branch if truncate |
|
TAX ; copy length to X |
SEC ; set carry for add ! |
EOR #$FF ; 1's complement |
ADC #$06 ; add 6d |
BEQ GoPr2 ; if zero print whole string |
|
BNE GoPr1 ; else go make output string (branch always) |
|
; convert A to ASCII hex byte and output .. note set decimal mode before calling |
|
LAB_A2HX |
TAX ; save byte |
AND #$0F ; mask off top bits |
JSR LAB_AL2X ; convert low nibble to ASCII and output |
TXA ; get byte back |
LSR ; /2 shift high nibble to low nibble |
LSR ; /4 |
LSR ; /8 |
LSR ; /16 |
LAB_AL2X |
CMP #$0A ; set carry for +1 if >9 |
ADC #'0' ; add ASCII "0" |
STA (str_pl),Y ; save to temp string |
DEY ; decrement counter |
RTS |
|
LAB_NLTO |
STA FAC1_e ; save FAC1 exponent |
LDA #$00 ; clear sign compare |
LAB_MLTE |
STA FAC_sc ; save sign compare (FAC1 EOR FAC2) |
TXA ; restore character |
JSR LAB_2912 ; evaluate new ASCII digit |
|
; gets here if the first character was "$" for hex |
; get hex number |
|
LAB_CHEX |
JSR LAB_IGBY ; increment and scan memory |
BCC LAB_ISHN ; branch if numeric character |
|
ORA #$20 ; case convert, allow "A" to "F" and "a" to "f" |
SBC #'a' ; subtract "a" (carry set here) |
CMP #$06 ; compare normalised with $06 (max+1) |
BCS LAB_EXCH ; exit if >"f" or <"0" |
|
ADC #$0A ; convert to nibble |
LAB_ISHN |
AND #$0F ; convert to binary |
TAX ; save nibble |
LDA FAC1_e ; get FAC1 exponent |
BEQ LAB_MLTE ; skip multiply if zero |
|
ADC #$04 ; add four to exponent (*16 - carry clear here) |
BCC LAB_NLTO ; if no overflow do evaluate digit |
|
LAB_MLTO |
JMP LAB_2564 ; do overflow error and warm start |
|
LAB_NXCH |
TAX ; save bit |
LDA FAC1_e ; get FAC1 exponent |
BEQ LAB_MLBT ; skip multiply if zero |
|
INC FAC1_e ; increment FAC1 exponent (*2) |
BEQ LAB_MLTO ; do overflow error if = $00 |
|
LDA #$00 ; clear sign compare |
LAB_MLBT |
STA FAC_sc ; save sign compare (FAC1 EOR FAC2) |
TXA ; restore bit |
JSR LAB_2912 ; evaluate new ASCII digit |
|
; gets here if the first character was "%" for binary |
; get binary number |
|
LAB_CBIN |
JSR LAB_IGBY ; increment and scan memory |
EOR #'0' ; convert "0" to 0 etc. |
CMP #$02 ; compare with max+1 |
BCC LAB_NXCH ; branch exit if < 2 |
|
LAB_EXCH |
JMP LAB_28F6 ; evaluate -ve flag and return |
|
; ctrl-c check routine. includes limited "life" byte save for INGET routine |
; now also the code that checks to see if an interrupt has occurred |
|
CTRLC |
LDA ccflag ; get [CTRL-C] check flag |
BNE LAB_FBA2 ; exit if inhibited |
|
JSR V_INPT ; scan input device |
BCC LAB_FBA0 ; exit if buffer empty |
|
STA ccbyte ; save received byte |
LDX #$20 ; "life" timer for bytes |
STX ccnull ; set countdown |
JMP LAB_1636 ; return to BASIC |
|
LAB_FBA0 |
LDX ccnull ; get countdown byte |
BEQ LAB_FBA2 ; exit if finished |
|
DEC ccnull ; else decrement countdown |
LAB_FBA2 |
LDX #NmiBase ; set pointer to NMI values |
JSR LAB_CKIN ; go check interrupt |
LDX #IrqBase ; set pointer to IRQ values |
JSR LAB_CKIN ; go check interrupt |
LAB_CRTS |
RTS |
|
; check whichever interrupt is indexed by X |
|
LAB_CKIN |
LDA PLUS_0,X ; get interrupt flag byte |
BPL LAB_CRTS ; branch if interrupt not enabled |
|
; we disable the interrupt here and make two new commands RETIRQ and RETNMI to |
; automatically enable the interrupt when we exit |
|
ASL ; move happened bit to setup bit |
AND #$40 ; mask happened bits |
BEQ LAB_CRTS ; if no interrupt then exit |
|
STA PLUS_0,X ; save interrupt flag byte |
|
TXA ; copy index .. |
TAY ; .. to Y |
|
PLA ; dump return address low byte, call from CTRL-C |
PLA ; dump return address high byte |
|
LDA #$05 ; need 5 bytes for GOSUB |
JSR LAB_1212 ; check room on stack for A bytes |
LDA Bpntrh ; get BASIC execute pointer high byte |
PHA ; push on stack |
LDA Bpntrl ; get BASIC execute pointer low byte |
PHA ; push on stack |
LDA Clineh ; get current line high byte |
PHA ; push on stack |
LDA Clinel ; get current line low byte |
PHA ; push on stack |
LDA #TK_GOSUB ; token for GOSUB |
PHA ; push on stack |
|
LDA PLUS_1,Y ; get interrupt code pointer low byte |
STA Bpntrl ; save as BASIC execute pointer low byte |
LDA PLUS_2,Y ; get interrupt code pointer high byte |
STA Bpntrh ; save as BASIC execute pointer high byte |
|
JMP LAB_15C2 ; go do interpreter inner loop |
; can't RTS, we used the stack! the RTS from the ctrl-c |
; check will be taken when the RETIRQ/RETNMI/RETURN is |
; executed at the end of the subroutine |
|
; get byte from input device, no waiting |
; returns with carry set if byte in A |
|
INGET |
JSR V_INPT ; call scan input device |
BCS LAB_FB95 ; if byte go reset timer |
|
LDA ccnull ; get countdown |
BEQ LAB_FB96 ; exit if empty |
|
LDA ccbyte ; get last received byte |
SEC ; flag we got a byte |
LAB_FB95 |
LDX #$00 ; clear X |
STX ccnull ; clear timer because we got a byte |
LAB_FB96 |
RTS |
|
; these routines only enable the interrupts if the set-up flag is set |
; if not they have no effect |
|
; perform IRQ {ON|OFF|CLEAR} |
|
LAB_IRQ |
LDX #IrqBase ; set pointer to IRQ values |
.byte $2C ; make next line BIT abs. |
|
; perform NMI {ON|OFF|CLEAR} |
|
LAB_NMI |
LDX #NmiBase ; set pointer to NMI values |
CMP #TK_ON ; compare with token for ON |
BEQ LAB_INON ; go turn on interrupt |
|
CMP #TK_OFF ; compare with token for OFF |
BEQ LAB_IOFF ; go turn off interrupt |
|
EOR #TK_CLEAR ; compare with token for CLEAR, A = $00 if = TK_CLEAR |
BEQ LAB_INEX ; go clear interrupt flags and return |
|
JMP LAB_SNER ; do syntax error then warm start |
|
LAB_IOFF |
LDA #$7F ; clear A |
AND PLUS_0,X ; AND with interrupt setup flag |
BPL LAB_INEX ; go clear interrupt enabled flag and return |
|
LAB_INON |
LDA PLUS_0,X ; get interrupt setup flag |
ASL ; Shift bit to enabled flag |
ORA PLUS_0,X ; OR with flag byte |
LAB_INEX |
STA PLUS_0,X ; save interrupt flag byte |
JMP LAB_IGBY ; update BASIC execute pointer and return |
|
; these routines set up the pointers and flags for the interrupt routines |
; note that the interrupts are also enabled by these commands |
|
; perform ON IRQ |
|
LAB_SIRQ |
CLI ; enable interrupts |
LDX #IrqBase ; set pointer to IRQ values |
.byte $2C ; make next line BIT abs. |
|
; perform ON NMI |
|
LAB_SNMI |
LDX #NmiBase ; set pointer to NMI values |
|
STX TempB ; save interrupt pointer |
JSR LAB_IGBY ; increment and scan memory (past token) |
JSR LAB_GFPN ; get fixed-point number into temp integer |
LDA Smeml ; get start of mem low byte |
LDX Smemh ; get start of mem high byte |
JSR LAB_SHLN ; search Basic for temp integer line number from AX |
BCS LAB_LFND ; if carry set go set-up interrupt |
|
JMP LAB_16F7 ; else go do "Undefined statement" error and warm start |
|
LAB_LFND |
LDX TempB ; get interrupt pointer |
LDA Baslnl ; get pointer low byte |
SBC #$01 ; -1 (carry already set for subtract) |
STA PLUS_1,X ; save as interrupt pointer low byte |
LDA Baslnh ; get pointer high byte |
SBC #$00 ; subtract carry |
STA PLUS_2,X ; save as interrupt pointer high byte |
|
LDA #$C0 ; set interrupt enabled/setup bits |
STA PLUS_0,X ; set interrupt flags |
LAB_IRTS |
RTS |
|
; return from IRQ service, restores the enabled flag. |
|
; perform RETIRQ |
|
LAB_RETIRQ |
BNE LAB_IRTS ; exit if following token (to allow syntax error) |
|
LDA IrqBase ; get interrupt flags |
ASL ; copy setup to enabled (b7) |
ORA IrqBase ; OR in setup flag |
STA IrqBase ; save enabled flag |
JMP LAB_16E8 ; go do rest of RETURN |
|
; return from NMI service, restores the enabled flag. |
|
; perform RETNMI |
|
LAB_RETNMI |
BNE LAB_IRTS ; exit if following token (to allow syntax error) |
|
LDA NmiBase ; get set-up flag |
ASL ; copy setup to enabled (b7) |
ORA NmiBase ; OR in setup flag |
STA NmiBase ; save enabled flag |
JMP LAB_16E8 ; go do rest of RETURN |
|
; MAX() MIN() pre process |
|
LAB_MMPP |
JSR LAB_EVEZ ; process expression |
JMP LAB_CTNM ; check if source is numeric, else do type mismatch |
|
; perform MAX() |
|
LAB_MAX |
JSR LAB_PHFA ; push FAC1, evaluate expression, |
; pull FAC2 and compare with FAC1 |
BPL LAB_MAX ; branch if no swap to do |
|
LDA FAC2_1 ; get FAC2 mantissa1 |
ORA #$80 ; set top bit (clear sign from compare) |
STA FAC2_1 ; save FAC2 mantissa1 |
JSR LAB_279B ; copy FAC2 to FAC1 |
BEQ LAB_MAX ; go do next (branch always) |
|
; perform MIN() |
|
LAB_MIN |
JSR LAB_PHFA ; push FAC1, evaluate expression, |
; pull FAC2 and compare with FAC1 |
BMI LAB_MIN ; branch if no swap to do |
|
BEQ LAB_MIN ; branch if no swap to do |
|
LDA FAC2_1 ; get FAC2 mantissa1 |
ORA #$80 ; set top bit (clear sign from compare) |
STA FAC2_1 ; save FAC2 mantissa1 |
JSR LAB_279B ; copy FAC2 to FAC1 |
BEQ LAB_MIN ; go do next (branch always) |
|
; exit routine. don't bother returning to the loop code |
; check for correct exit, else so syntax error |
|
LAB_MMEC |
CMP #')' ; is it end of function? |
BNE LAB_MMSE ; if not do MAX MIN syntax error |
|
PLA ; dump return address low byte |
PLA ; dump return address high byte |
JMP LAB_IGBY ; update BASIC execute pointer (to chr past ")") |
|
LAB_MMSE |
JMP LAB_SNER ; do syntax error then warm start |
|
; check for next, evaluate and return or exit |
; this is the routine that does most of the work |
|
LAB_PHFA |
JSR LAB_GBYT ; get next BASIC byte |
CMP #',' ; is there more ? |
BNE LAB_MMEC ; if not go do end check |
|
; push FAC1 |
JSR LAB_27BA ; round FAC1 |
LDA FAC1_s ; get FAC1 sign |
ORA #$7F ; set all non sign bits |
AND FAC1_1 ; AND FAC1 mantissa1 (AND in sign bit) |
PHA ; push on stack |
LDA FAC1_2 ; get FAC1 mantissa2 |
PHA ; push on stack |
LDA FAC1_3 ; get FAC1 mantissa3 |
PHA ; push on stack |
LDA FAC1_e ; get FAC1 exponent |
PHA ; push on stack |
|
JSR LAB_IGBY ; scan and get next BASIC byte (after ",") |
JSR LAB_EVNM ; evaluate expression and check is numeric, |
; else do type mismatch |
|
; pop FAC2 (MAX/MIN expression so far) |
PLA ; pop exponent |
STA FAC2_e ; save FAC2 exponent |
PLA ; pop mantissa3 |
STA FAC2_3 ; save FAC2 mantissa3 |
PLA ; pop mantissa1 |
STA FAC2_2 ; save FAC2 mantissa2 |
PLA ; pop sign/mantissa1 |
STA FAC2_1 ; save FAC2 sign/mantissa1 |
STA FAC2_s ; save FAC2 sign |
|
; compare FAC1 with (packed) FAC2 |
LDA #<FAC2_e ; set pointer low byte to FAC2 |
LDY #>FAC2_e ; set pointer high byte to FAC2 |
JMP LAB_27F8 ; compare FAC1 with FAC2 (AY) and return |
; returns A=$00 if FAC1 = (AY) |
; returns A=$01 if FAC1 > (AY) |
; returns A=$FF if FAC1 < (AY) |
|
; perform WIDTH |
|
LAB_WDTH |
CMP #',' ; is next byte "," |
BEQ LAB_TBSZ ; if so do tab size |
|
JSR LAB_GTBY ; get byte parameter |
TXA ; copy width to A |
BEQ LAB_NSTT ; branch if set for infinite line |
|
CPX #$10 ; else make min width = 16d |
BCC TabErr ; if less do function call error and exit |
|
; this next compare ensures that we can't exit WIDTH via an error leaving the |
; tab size greater than the line length. |
|
CPX TabSiz ; compare with tab size |
BCS LAB_NSTT ; branch if >= tab size |
|
STX TabSiz ; else make tab size = terminal width |
LAB_NSTT |
STX TWidth ; set the terminal width |
JSR LAB_GBYT ; get BASIC byte back |
BEQ WExit ; exit if no following |
|
CMP #',' ; else is it "," |
BNE LAB_MMSE ; if not do syntax error |
|
LAB_TBSZ |
JSR LAB_SGBY ; scan and get byte parameter |
TXA ; copy TAB size |
BMI TabErr ; if >127 do function call error and exit |
|
CPX #$01 ; compare with min-1 |
BCC TabErr ; if <=1 do function call error and exit |
|
LDA TWidth ; set flags for width |
BEQ LAB_SVTB ; skip check if infinite line |
|
CPX TWidth ; compare TAB with width |
BEQ LAB_SVTB ; ok if = |
|
BCS TabErr ; branch if too big |
|
LAB_SVTB |
STX TabSiz ; save TAB size |
|
; calculate tab column limit from TAB size. The Iclim is set to the last tab |
; position on a line that still has at least one whole tab width between it |
; and the end of the line. |
|
WExit |
LDA TWidth ; get width |
BEQ LAB_SULP ; branch if infinite line |
|
CMP TabSiz ; compare with tab size |
BCS LAB_WDLP ; branch if >= tab size |
|
STA TabSiz ; else make tab size = terminal width |
LAB_SULP |
SEC ; set carry for subtract |
LAB_WDLP |
SBC TabSiz ; subtract tab size |
BCS LAB_WDLP ; loop while no borrow |
|
ADC TabSiz ; add tab size back |
CLC ; clear carry for add |
ADC TabSiz ; add tab size back again |
STA Iclim ; save for now |
LDA TWidth ; get width back |
SEC ; set carry for subtract |
SBC Iclim ; subtract remainder |
STA Iclim ; save tab column limit |
LAB_NOSQ |
RTS |
|
TabErr |
JMP LAB_FCER ; do function call error then warm start |
|
; perform SQR() |
|
LAB_SQR |
LDA FAC1_s ; get FAC1 sign |
BMI TabErr ; if -ve do function call error |
|
LDA FAC1_e ; get exponent |
BEQ LAB_NOSQ ; if zero just return |
|
; else do root |
JSR LAB_27AB ; round and copy FAC1 to FAC2 |
LDA #$00 ; clear A |
|
STA FACt_3 ; clear remainder |
STA FACt_2 ; .. |
STA FACt_1 ; .. |
STA TempB ; .. |
|
STA FAC1_3 ; clear root |
STA FAC1_2 ; .. |
STA FAC1_1 ; .. |
|
LDX #$18 ; 24 pairs of bits to do |
LDA FAC2_e ; get exponent |
LSR ; check odd/even |
BCS LAB_SQE2 ; if odd only 1 shift first time |
|
LAB_SQE1 |
ASL FAC2_3 ; shift highest bit of number .. |
ROL FAC2_2 ; .. |
ROL FAC2_1 ; .. |
ROL FACt_3 ; .. into remainder |
ROL FACt_2 ; .. |
ROL FACt_1 ; .. |
ROL TempB ; .. never overflows |
LAB_SQE2 |
ASL FAC2_3 ; shift highest bit of number .. |
ROL FAC2_2 ; .. |
ROL FAC2_1 ; .. |
ROL FACt_3 ; .. into remainder |
ROL FACt_2 ; .. |
ROL FACt_1 ; .. |
ROL TempB ; .. never overflows |
|
ASL FAC1_3 ; root = root * 2 |
ROL FAC1_2 ; .. |
ROL FAC1_1 ; .. never overflows |
|
LDA FAC1_3 ; get root low byte |
ROL ; *2 |
STA Temp3 ; save partial low byte |
LDA FAC1_2 ; get root low mid byte |
ROL ; *2 |
STA Temp3+1 ; save partial low mid byte |
LDA FAC1_1 ; get root high mid byte |
ROL ; *2 |
STA Temp3+2 ; save partial high mid byte |
LDA #$00 ; get root high byte (always $00) |
ROL ; *2 |
STA Temp3+3 ; save partial high byte |
|
; carry clear for subtract +1 |
LDA FACt_3 ; get remainder low byte |
SBC Temp3 ; subtract partial low byte |
STA Temp3 ; save partial low byte |
|
LDA FACt_2 ; get remainder low mid byte |
SBC Temp3+1 ; subtract partial low mid byte |
STA Temp3+1 ; save partial low mid byte |
|
LDA FACt_1 ; get remainder high mid byte |
SBC Temp3+2 ; subtract partial high mid byte |
TAY ; copy partial high mid byte |
|
LDA TempB ; get remainder high byte |
SBC Temp3+3 ; subtract partial high byte |
BCC LAB_SQNS ; skip sub if remainder smaller |
|
STA TempB ; save remainder high byte |
|
STY FACt_1 ; save remainder high mid byte |
|
LDA Temp3+1 ; get remainder low mid byte |
STA FACt_2 ; save remainder low mid byte |
|
LDA Temp3 ; get partial low byte |
STA FACt_3 ; save remainder low byte |
|
INC FAC1_3 ; increment root low byte (never any rollover) |
LAB_SQNS |
DEX ; decrement bit pair count |
BNE LAB_SQE1 ; loop if not all done |
|
SEC ; set carry for subtract |
LDA FAC2_e ; get exponent |
SBC #$80 ; normalise |
ROR ; /2 and re-bias to $80 |
ADC #$00 ; add bit zero back in (allow for half shift) |
STA FAC1_e ; save it |
JMP LAB_24D5 ; normalise FAC1 and return |
|
; perform VARPTR() |
|
LAB_VARPTR |
JSR LAB_IGBY ; increment and scan memory |
JSR LAB_GVAR ; get var address |
JSR LAB_1BFB ; scan for ")" , else do syntax error then warm start |
LDY Cvaral ; get var address low byte |
LDA Cvarah ; get var address high byte |
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return |
|
; perform PI |
|
LAB_PI |
LDA #<LAB_2C7C ; set (2*pi) pointer low byte |
LDY #>LAB_2C7C ; set (2*pi) pointer high byte |
JSR LAB_UFAC ; unpack memory (AY) into FAC1 |
DEC FAC1_e ; make result = PI |
RTS |
|
; perform TWOPI |
|
LAB_TWOPI |
LDA #<LAB_2C7C ; set (2*pi) pointer low byte |
LDY #>LAB_2C7C ; set (2*pi) pointer high byte |
JMP LAB_UFAC ; unpack memory (AY) into FAC1 and return |
|
; system dependant i/o vectors |
; these are in RAM and are set by the monitor at start-up |
|
V_INPT |
JMP (VEC_IN) ; non halting scan input device |
V_OUTP |
JMP (VEC_OUT) ; send byte to output device |
V_LOAD |
JMP (VEC_LD) ; load BASIC program |
V_SAVE |
JMP (VEC_SV) ; save BASIC program |
|
LAB_BYE: |
; nat |
.byte $42 ; WDM |
xce |
cpu rtf65002 |
jmp (ExitTask>>2) |
cpu W65C02 |
|
; The rest are tables messages and code for RAM |
|
; the rest of the code is tables and BASIC start-up code |
|
PG2_TABS |
.byte $00 ; ctrl-c flag - $00 = enabled |
.byte $00 ; ctrl-c byte - GET needs this |
.byte $00 ; ctrl-c byte timeout - GET needs this |
.word CTRLC ; ctrl c check vector |
; .word xxxx ; non halting key input - monitor to set this |
; .word xxxx ; output vector - monitor to set this |
; .word xxxx ; load vector - monitor to set this |
; .word xxxx ; save vector - monitor to set this |
PG2_TABE |
|
; character get subroutine for zero page |
|
; For a 1.8432MHz 6502 including the JSR and RTS |
; fastest (>=":") = 29 cycles = 15.7uS |
; slowest (<":") = 40 cycles = 21.7uS |
; space skip = +21 cycles = +11.4uS |
; inc across page = +4 cycles = +2.2uS |
|
; the target address for the LDA at LAB_2CF4 becomes the BASIC execute pointer once the |
; block is copied to it's destination, any non zero page address will do at assembly |
; time, to assemble a three byte instruction. |
|
; page 0 initialisation table from $BC |
; increment and scan memory |
|
LAB_2CEE |
INC Bpntrl ; increment BASIC execute pointer low byte |
BNE LAB_2CF4 ; branch if no carry |
; else |
INC Bpntrh ; increment BASIC execute pointer high byte |
|
; page 0 initialisation table from $C2 |
; scan memory |
|
LAB_2CF4 |
LDA $FFFF ; get byte to scan (addr set by call routine) |
CMP #TK_ELSE ; compare with the token for ELSE |
BEQ LAB_2D05 ; exit if ELSE, not numeric, carry set |
|
CMP #':' ; compare with ":" |
BCS LAB_2D05 ; exit if >= ":", not numeric, carry set |
|
CMP #' ' ; compare with " " |
BEQ LAB_2CEE ; if " " go do next |
|
SEC ; set carry for SBC |
SBC #'0' ; subtract "0" |
SEC ; set carry for SBC |
SBC #$D0 ; subtract -"0" |
; clear carry if byte = "0"-"9" |
LAB_2D05 |
RTS |
|
; page zero initialisation table $00-$12 inclusive |
|
StrTab |
.byte $4C ; JMP opcode |
.word LAB_COLD ; initial warm start vector (cold start) |
|
.byte $00 ; these bytes are not used by BASIC |
.word $0000 ; |
.word $0000 ; |
.word $0000 ; |
|
.byte $4C ; JMP opcode |
.word LAB_FCER ; initial user function vector ("Function call" error) |
.byte $00 ; default NULL count |
.byte $00 ; clear terminal position |
.byte $00 ; default terminal width byte |
.byte $F2 ; default limit for TAB = 14 |
.word Ram_base ; start of user RAM |
EndTab |
|
LAB_MSZM |
.byte $0D,$0A,"Memory size ",$00 |
|
LAB_SMSG |
.byte " Bytes free",$0D,$0A,$0A |
.byte "Enhanced BASIC 2.22",$0A,$00 |
|
; numeric constants and series |
|
; constants and series for LOG(n) |
LAB_25A0 |
.byte $02 ; counter |
.byte $80,$19,$56,$62 ; 0.59898 |
.byte $80,$76,$22,$F3 ; 0.96147 |
;## .byte $80,$76,$22,$F1 ; 0.96147 |
.byte $82,$38,$AA,$40 ; 2.88539 |
;## .byte $82,$38,$AA,$45 ; 2.88539 |
|
LAB_25AD |
.byte $80,$35,$04,$F3 ; 0.70711 1/root 2 |
LAB_25B1 |
.byte $81,$35,$04,$F3 ; 1.41421 root 2 |
LAB_25B5 |
.byte $80,$80,$00,$00 ; -0.5 |
LAB_25B9 |
.byte $80,$31,$72,$18 ; 0.69315 LOG(2) |
|
; numeric PRINT constants |
LAB_2947 |
.byte $91,$43,$4F,$F8 ; 99999.9375 (max value with at least one decimal) |
LAB_294B |
.byte $94,$74,$23,$F7 ; 999999.4375 (max value before scientific notation) |
LAB_294F |
.byte $94,$74,$24,$00 ; 1000000 |
|
; EXP(n) constants and series |
LAB_2AFA |
.byte $81,$38,$AA,$3B ; 1.4427 (1/LOG base 2 e) |
LAB_2AFE |
.byte $06 ; counter |
.byte $74,$63,$90,$8C ; 2.17023e-4 |
.byte $77,$23,$0C,$AB ; 0.00124 |
.byte $7A,$1E,$94,$00 ; 0.00968 |
.byte $7C,$63,$42,$80 ; 0.05548 |
.byte $7E,$75,$FE,$D0 ; 0.24023 |
.byte $80,$31,$72,$15 ; 0.69315 |
.byte $81,$00,$00,$00 ; 1.00000 |
|
;## .byte $07 ; counter |
;## .byte $74,$94,$2E,$40 ; -1/7! (-1/5040) |
;## .byte $77,$2E,$4F,$70 ; 1/6! ( 1/720) |
;## .byte $7A,$88,$02,$6E ; -1/5! (-1/120) |
;## .byte $7C,$2A,$A0,$E6 ; 1/4! ( 1/24) |
;## .byte $7E,$AA,$AA,$50 ; -1/3! (-1/6) |
;## .byte $7F,$7F,$FF,$FF ; 1/2! ( 1/2) |
;## .byte $81,$80,$00,$00 ; -1/1! (-1/1) |
;## .byte $81,$00,$00,$00 ; 1/0! ( 1/1) |
|
; trigonometric constants and series |
LAB_2C78 |
.byte $81,$49,$0F,$DB ; 1.570796371 (pi/2) as floating # |
LAB_2C84 |
.byte $04 ; counter |
.byte $86,$1E,$D7,$FB ; 39.7109 |
;## .byte $86,$1E,$D7,$BA ; 39.7109 |
.byte $87,$99,$26,$65 ;-76.575 |
;## .byte $87,$99,$26,$64 ;-76.575 |
.byte $87,$23,$34,$58 ; 81.6022 |
.byte $86,$A5,$5D,$E1 ;-41.3417 |
;## .byte $86,$A5,$5D,$E0 ;-41.3417 |
LAB_2C7C |
.byte $83,$49,$0F,$DB ; 6.28319 (2*pi) as floating # |
;## .byte $83,$49,$0F,$DA ; 6.28319 (2*pi) as floating # |
|
LAB_2CC9 |
.byte $08 ; counter |
.byte $78,$3A,$C5,$37 ; 0.00285 |
.byte $7B,$83,$A2,$5C ;-0.0160686 |
.byte $7C,$2E,$DD,$4D ; 0.0426915 |
.byte $7D,$99,$B0,$1E ;-0.0750429 |
.byte $7D,$59,$ED,$24 ; 0.106409 |
.byte $7E,$91,$72,$00 ;-0.142036 |
.byte $7E,$4C,$B9,$73 ; 0.199926 |
.byte $7F,$AA,$AA,$53 ;-0.333331 |
|
;## .byte $08 ; counter |
;## .byte $78,$3B,$D7,$4A ; 1/17 |
;## .byte $7B,$84,$6E,$02 ;-1/15 |
;## .byte $7C,$2F,$C1,$FE ; 1/13 |
;## .byte $7D,$9A,$31,$74 ;-1/11 |
;## .byte $7D,$5A,$3D,$84 ; 1/9 |
;## .byte $7E,$91,$7F,$C8 ;-1/7 |
;## .byte $7E,$4C,$BB,$E4 ; 1/5 |
;## .byte $7F,$AA,$AA,$6C ;-1/3 |
|
LAB_1D96 = *+1 ; $00,$00 used for undefined variables |
LAB_259C |
.byte $81,$00,$00,$00 ; 1.000000, used for INC |
LAB_2AFD |
.byte $81,$80,$00,$00 ; -1.00000, used for DEC. must be on the same page as +1.00 |
|
; misc constants |
LAB_1DF7 |
.byte $90 ;-32768 (uses first three bytes from 0.5) |
LAB_2A96 |
.byte $80,$00,$00,$00 ; 0.5 |
LAB_2C80 |
.byte $7F,$00,$00,$00 ; 0.25 |
LAB_26B5 |
.byte $84,$20,$00,$00 ; 10.0000 divide by 10 constant |
|
; This table is used in converting numbers to ASCII. |
|
LAB_2A9A |
LAB_2A9B = LAB_2A9A+1 |
LAB_2A9C = LAB_2A9B+1 |
.byte $FE,$79,$60 ; -100000 |
.byte $00,$27,$10 ; 10000 |
.byte $FF,$FC,$18 ; -1000 |
.byte $00,$00,$64 ; 100 |
.byte $FF,$FF,$F6 ; -10 |
.byte $00,$00,$01 ; 1 |
|
LAB_CTBL |
.word LAB_END-1 ; END |
.word LAB_FOR-1 ; FOR |
.word LAB_NEXT-1 ; NEXT |
.word LAB_DATA-1 ; DATA |
.word LAB_INPUT-1 ; INPUT |
.word LAB_DIM-1 ; DIM |
.word LAB_READ-1 ; READ |
.word LAB_LET-1 ; LET |
.word LAB_DEC-1 ; DEC new command |
.word LAB_GOTO-1 ; GOTO |
.word LAB_RUN-1 ; RUN |
.word LAB_IF-1 ; IF |
.word LAB_RESTORE-1 ; RESTORE modified command |
.word LAB_GOSUB-1 ; GOSUB |
.word LAB_RETIRQ-1 ; RETIRQ new command |
.word LAB_RETNMI-1 ; RETNMI new command |
.word LAB_RETURN-1 ; RETURN |
.word LAB_REM-1 ; REM |
.word LAB_STOP-1 ; STOP |
.word LAB_ON-1 ; ON modified command |
.word LAB_NULL-1 ; NULL modified command |
.word LAB_INC-1 ; INC new command |
.word LAB_WAIT-1 ; WAIT |
.word V_LOAD-1 ; LOAD |
.word V_SAVE-1 ; SAVE |
.word LAB_DEF-1 ; DEF |
.word LAB_POKE-1 ; POKE |
.word LAB_DOKE-1 ; DOKE new command |
.word LAB_CALL-1 ; CALL new command |
.word LAB_DO-1 ; DO new command |
.word LAB_LOOP-1 ; LOOP new command |
.word LAB_PRINT-1 ; PRINT |
.word LAB_CONT-1 ; CONT |
.word LAB_LIST-1 ; LIST |
.word LAB_CLEAR-1 ; CLEAR |
.word LAB_NEW-1 ; NEW |
.word LAB_WDTH-1 ; WIDTH new command |
.word LAB_GET-1 ; GET new command |
.word LAB_SWAP-1 ; SWAP new command |
.word LAB_BITSET-1 ; BITSET new command |
.word LAB_BITCLR-1 ; BITCLR new command |
.word LAB_IRQ-1 ; IRQ new command |
.word LAB_NMI-1 ; NMI new command |
.word LAB_BYE-1 ; BYE new command |
|
; function pre process routine table |
|
LAB_FTPL |
LAB_FTPM = LAB_FTPL+$01 |
.word LAB_PPFN-1 ; SGN(n) process numeric expression in () |
.word LAB_PPFN-1 ; INT(n) " |
.word LAB_PPFN-1 ; ABS(n) " |
.word LAB_EVEZ-1 ; USR(x) process any expression |
.word LAB_1BF7-1 ; FRE(x) " |
.word LAB_1BF7-1 ; POS(x) " |
.word LAB_PPFN-1 ; SQR(n) process numeric expression in () |
.word LAB_PPFN-1 ; RND(n) " |
.word LAB_PPFN-1 ; LOG(n) " |
.word LAB_PPFN-1 ; EXP(n) " |
.word LAB_PPFN-1 ; COS(n) " |
.word LAB_PPFN-1 ; SIN(n) " |
.word LAB_PPFN-1 ; TAN(n) " |
.word LAB_PPFN-1 ; ATN(n) " |
.word LAB_PPFN-1 ; PEEK(n) " |
.word LAB_PPFN-1 ; DEEK(n) " |
.word $0000 ; SADD() none |
.word LAB_PPFS-1 ; LEN($) process string expression in () |
.word LAB_PPFN-1 ; STR$(n) process numeric expression in () |
.word LAB_PPFS-1 ; VAL($) process string expression in () |
.word LAB_PPFS-1 ; ASC($) " |
.word LAB_PPFS-1 ; UCASE$($) " |
.word LAB_PPFS-1 ; LCASE$($) " |
.word LAB_PPFN-1 ; CHR$(n) process numeric expression in () |
.word LAB_BHSS-1 ; HEX$(n) " |
.word LAB_BHSS-1 ; BIN$(n) " |
.word $0000 ; BITTST() none |
.word LAB_MMPP-1 ; MAX() process numeric expression |
.word LAB_MMPP-1 ; MIN() " |
.word LAB_PPBI-1 ; PI advance pointer |
.word LAB_PPBI-1 ; TWOPI " |
.word $0000 ; VARPTR() none |
.word LAB_LRMS-1 ; LEFT$() process string expression |
.word LAB_LRMS-1 ; RIGHT$() " |
.word LAB_LRMS-1 ; MID$() " |
|
; action addresses for functions |
|
LAB_FTBL |
LAB_FTBM = LAB_FTBL+$01 |
.word LAB_SGN-1 ; SGN() |
.word LAB_INT-1 ; INT() |
.word LAB_ABS-1 ; ABS() |
.word LAB_USR-1 ; USR() |
.word LAB_FRE-1 ; FRE() |
.word LAB_POS-1 ; POS() |
.word LAB_SQR-1 ; SQR() |
.word LAB_RND-1 ; RND() modified function |
.word LAB_LOG-1 ; LOG() |
.word LAB_EXP-1 ; EXP() |
.word LAB_COS-1 ; COS() |
.word LAB_SIN-1 ; SIN() |
.word LAB_TAN-1 ; TAN() |
.word LAB_ATN-1 ; ATN() |
.word LAB_PEEK-1 ; PEEK() |
.word LAB_DEEK-1 ; DEEK() new function |
.word LAB_SADD-1 ; SADD() new function |
.word LAB_LENS-1 ; LEN() |
.word LAB_STRS-1 ; STR$() |
.word LAB_VAL-1 ; VAL() |
.word LAB_ASC-1 ; ASC() |
.word LAB_UCASE-1 ; UCASE$() new function |
.word LAB_LCASE-1 ; LCASE$() new function |
.word LAB_CHRS-1 ; CHR$() |
.word LAB_HEXS-1 ; HEX$() new function |
.word LAB_BINS-1 ; BIN$() new function |
.word LAB_BTST-1 ; BITTST() new function |
.word LAB_MAX-1 ; MAX() new function |
.word LAB_MIN-1 ; MIN() new function |
.word LAB_PI-1 ; PI new function |
.word LAB_TWOPI-1 ; TWOPI new function |
.word LAB_VARPTR-1 ; VARPTR() new function |
.word LAB_LEFT-1 ; LEFT$() |
.word LAB_RIGHT-1 ; RIGHT$() |
.word LAB_MIDS-1 ; MID$() |
|
; hierarchy and action addresses for operator |
|
LAB_OPPT |
.byte $79 ; + |
.word LAB_ADD-1 |
.byte $79 ; - |
.word LAB_SUBTRACT-1 |
.byte $7B ; * |
.word LAB_MULTIPLY-1 |
.byte $7B ; / |
.word LAB_DIVIDE-1 |
.byte $7F ; ^ |
.word LAB_POWER-1 |
.byte $50 ; AND |
.word LAB_AND-1 |
.byte $46 ; EOR new operator |
.word LAB_EOR-1 |
.byte $46 ; OR |
.word LAB_OR-1 |
.byte $56 ; >> new operator |
.word LAB_RSHIFT-1 |
.byte $56 ; << new operator |
.word LAB_LSHIFT-1 |
.byte $7D ; > |
.word LAB_GTHAN-1 |
.byte $5A ; = |
.word LAB_EQUAL-1 |
.byte $64 ; < |
.word LAB_LTHAN-1 |
|
; keywords start with .. |
; this is the first character table and must be in alphabetic order |
|
TAB_1STC |
.byte "*" |
.byte "+" |
.byte "-" |
.byte "/" |
.byte "<" |
.byte "=" |
.byte ">" |
.byte "?" |
.byte "A" |
.byte "B" |
.byte "C" |
.byte "D" |
.byte "E" |
.byte "F" |
.byte "G" |
.byte "H" |
.byte "I" |
.byte "L" |
.byte "M" |
.byte "N" |
.byte "O" |
.byte "P" |
.byte "R" |
.byte "S" |
.byte "T" |
.byte "U" |
.byte "V" |
.byte "W" |
.byte "^" |
.byte $00 ; table terminator |
|
; pointers to keyword tables |
|
TAB_CHRT |
.word TAB_STAR ; table for "*" |
.word TAB_PLUS ; table for "+" |
.word TAB_MNUS ; table for "-" |
.word TAB_SLAS ; table for "/" |
.word TAB_LESS ; table for "<" |
.word TAB_EQUL ; table for "=" |
.word TAB_MORE ; table for ">" |
.word TAB_QEST ; table for "?" |
.word TAB_ASCA ; table for "A" |
.word TAB_ASCB ; table for "B" |
.word TAB_ASCC ; table for "C" |
.word TAB_ASCD ; table for "D" |
.word TAB_ASCE ; table for "E" |
.word TAB_ASCF ; table for "F" |
.word TAB_ASCG ; table for "G" |
.word TAB_ASCH ; table for "H" |
.word TAB_ASCI ; table for "I" |
.word TAB_ASCL ; table for "L" |
.word TAB_ASCM ; table for "M" |
.word TAB_ASCN ; table for "N" |
.word TAB_ASCO ; table for "O" |
.word TAB_ASCP ; table for "P" |
.word TAB_ASCR ; table for "R" |
.word TAB_ASCS ; table for "S" |
.word TAB_ASCT ; table for "T" |
.word TAB_ASCU ; table for "U" |
.word TAB_ASCV ; table for "V" |
.word TAB_ASCW ; table for "W" |
.word TAB_POWR ; table for "^" |
|
; tables for each start character, note if a longer keyword with the same start |
; letters as a shorter one exists then it must come first, else the list is in |
; alphabetical order as follows .. |
|
; [keyword,token |
; [keyword,token]] |
; end marker (#$00) |
|
TAB_STAR |
.byte TK_MUL,$00 ; * |
TAB_PLUS |
.byte TK_PLUS,$00 ; + |
TAB_MNUS |
.byte TK_MINUS,$00 ; - |
TAB_SLAS |
.byte TK_DIV,$00 ; / |
TAB_LESS |
LBB_LSHIFT |
.byte "<",TK_LSHIFT ; << note - "<<" must come before "<" |
.byte TK_LT ; < |
.byte $00 |
TAB_EQUL |
.byte TK_EQUAL,$00 ; = |
TAB_MORE |
LBB_RSHIFT |
.byte ">",TK_RSHIFT ; >> note - ">>" must come before ">" |
.byte TK_GT ; > |
.byte $00 |
TAB_QEST |
.byte TK_PRINT,$00 ; ? |
TAB_ASCA |
LBB_ABS |
.byte "BS(",TK_ABS ; ABS( |
LBB_AND |
.byte "ND",TK_AND ; AND |
LBB_ASC |
.byte "SC(",TK_ASC ; ASC( |
LBB_ATN |
.byte "TN(",TK_ATN ; ATN( |
.byte $00 |
TAB_ASCB |
LBB_BINS |
.byte "IN$(",TK_BINS ; BIN$( |
LBB_BITCLR |
.byte "ITCLR",TK_BITCLR ; BITCLR |
LBB_BITSET |
.byte "ITSET",TK_BITSET ; BITSET |
LBB_BITTST |
.byte "ITTST(",TK_BITTST |
; BITTST( |
LBB_BYE |
.byte "YE", TK_BYE ; BYE |
.byte $00 |
TAB_ASCC |
LBB_CALL |
.byte "ALL",TK_CALL ; CALL |
LBB_CHRS |
.byte "HR$(",TK_CHRS ; CHR$( |
LBB_CLEAR |
.byte "LEAR",TK_CLEAR ; CLEAR |
LBB_CONT |
.byte "ONT",TK_CONT ; CONT |
LBB_COS |
.byte "OS(",TK_COS ; COS( |
.byte $00 |
TAB_ASCD |
LBB_DATA |
.byte "ATA",TK_DATA ; DATA |
LBB_DEC |
.byte "EC",TK_DEC ; DEC |
LBB_DEEK |
.byte "EEK(",TK_DEEK ; DEEK( |
LBB_DEF |
.byte "EF",TK_DEF ; DEF |
LBB_DIM |
.byte "IM",TK_DIM ; DIM |
LBB_DOKE |
.byte "OKE",TK_DOKE ; DOKE note - "DOKE" must come before "DO" |
LBB_DO |
.byte "O",TK_DO ; DO |
.byte $00 |
TAB_ASCE |
LBB_ELSE |
.byte "LSE",TK_ELSE ; ELSE |
LBB_END |
.byte "ND",TK_END ; END |
LBB_EOR |
.byte "OR",TK_EOR ; EOR |
LBB_EXP |
.byte "XP(",TK_EXP ; EXP( |
.byte $00 |
TAB_ASCF |
LBB_FN |
.byte "N",TK_FN ; FN |
LBB_FOR |
.byte "OR",TK_FOR ; FOR |
LBB_FRE |
.byte "RE(",TK_FRE ; FRE( |
.byte $00 |
TAB_ASCG |
LBB_GET |
.byte "ET",TK_GET ; GET |
LBB_GOSUB |
.byte "OSUB",TK_GOSUB ; GOSUB |
LBB_GOTO |
.byte "OTO",TK_GOTO ; GOTO |
.byte $00 |
TAB_ASCH |
LBB_HEXS |
.byte "EX$(",TK_HEXS ; HEX$( |
.byte $00 |
TAB_ASCI |
LBB_IF |
.byte "F",TK_IF ; IF |
LBB_INC |
.byte "NC",TK_INC ; INC |
LBB_INPUT |
.byte "NPUT",TK_INPUT ; INPUT |
LBB_INT |
.byte "NT(",TK_INT ; INT( |
LBB_IRQ |
.byte "RQ",TK_IRQ ; IRQ |
.byte $00 |
TAB_ASCL |
LBB_LCASES |
.byte "CASE$(",TK_LCASES |
; LCASE$( |
LBB_LEFTS |
.byte "EFT$(",TK_LEFTS ; LEFT$( |
LBB_LEN |
.byte "EN(",TK_LEN ; LEN( |
LBB_LET |
.byte "ET",TK_LET ; LET |
LBB_LIST |
.byte "IST",TK_LIST ; LIST |
LBB_LOAD |
.byte "OAD",TK_LOAD ; LOAD |
LBB_LOG |
.byte "OG(",TK_LOG ; LOG( |
LBB_LOOP |
.byte "OOP",TK_LOOP ; LOOP |
.byte $00 |
TAB_ASCM |
LBB_MAX |
.byte "AX(",TK_MAX ; MAX( |
LBB_MIDS |
.byte "ID$(",TK_MIDS ; MID$( |
LBB_MIN |
.byte "IN(",TK_MIN ; MIN( |
.byte $00 |
TAB_ASCN |
LBB_NEW |
.byte "EW",TK_NEW ; NEW |
LBB_NEXT |
.byte "EXT",TK_NEXT ; NEXT |
LBB_NMI |
.byte "MI",TK_NMI ; NMI |
LBB_NOT |
.byte "OT",TK_NOT ; NOT |
LBB_NULL |
.byte "ULL",TK_NULL ; NULL |
.byte $00 |
TAB_ASCO |
LBB_OFF |
.byte "FF",TK_OFF ; OFF |
LBB_ON |
.byte "N",TK_ON ; ON |
LBB_OR |
.byte "R",TK_OR ; OR |
.byte $00 |
TAB_ASCP |
LBB_PEEK |
.byte "EEK(",TK_PEEK ; PEEK( |
LBB_PI |
.byte "I",TK_PI ; PI |
LBB_POKE |
.byte "OKE",TK_POKE ; POKE |
LBB_POS |
.byte "OS(",TK_POS ; POS( |
LBB_PRINT |
.byte "RINT",TK_PRINT ; PRINT |
.byte $00 |
TAB_ASCR |
LBB_READ |
.byte "EAD",TK_READ ; READ |
LBB_REM |
.byte "EM",TK_REM ; REM |
LBB_RESTORE |
.byte "ESTORE",TK_RESTORE |
; RESTORE |
LBB_RETIRQ |
.byte "ETIRQ",TK_RETIRQ ; RETIRQ |
LBB_RETNMI |
.byte "ETNMI",TK_RETNMI ; RETNMI |
LBB_RETURN |
.byte "ETURN",TK_RETURN ; RETURN |
LBB_RIGHTS |
.byte "IGHT$(",TK_RIGHTS |
; RIGHT$( |
LBB_RND |
.byte "ND(",TK_RND ; RND( |
LBB_RUN |
.byte "UN",TK_RUN ; RUN |
.byte $00 |
TAB_ASCS |
LBB_SADD |
.byte "ADD(",TK_SADD ; SADD( |
LBB_SAVE |
.byte "AVE",TK_SAVE ; SAVE |
LBB_SGN |
.byte "GN(",TK_SGN ; SGN( |
LBB_SIN |
.byte "IN(",TK_SIN ; SIN( |
LBB_SPC |
.byte "PC(",TK_SPC ; SPC( |
LBB_SQR |
.byte "QR(",TK_SQR ; SQR( |
LBB_STEP |
.byte "TEP",TK_STEP ; STEP |
LBB_STOP |
.byte "TOP",TK_STOP ; STOP |
LBB_STRS |
.byte "TR$(",TK_STRS ; STR$( |
LBB_SWAP |
.byte "WAP",TK_SWAP ; SWAP |
.byte $00 |
TAB_ASCT |
LBB_TAB |
.byte "AB(",TK_TAB ; TAB( |
LBB_TAN |
.byte "AN(",TK_TAN ; TAN( |
LBB_THEN |
.byte "HEN",TK_THEN ; THEN |
LBB_TO |
.byte "O",TK_TO ; TO |
LBB_TWOPI |
.byte "WOPI",TK_TWOPI ; TWOPI |
.byte $00 |
TAB_ASCU |
LBB_UCASES |
.byte "CASE$(",TK_UCASES |
; UCASE$( |
LBB_UNTIL |
.byte "NTIL",TK_UNTIL ; UNTIL |
LBB_USR |
.byte "SR(",TK_USR ; USR( |
.byte $00 |
TAB_ASCV |
LBB_VAL |
.byte "AL(",TK_VAL ; VAL( |
LBB_VPTR |
.byte "ARPTR(",TK_VPTR ; VARPTR( |
.byte $00 |
TAB_ASCW |
LBB_WAIT |
.byte "AIT",TK_WAIT ; WAIT |
LBB_WHILE |
.byte "HILE",TK_WHILE ; WHILE |
LBB_WIDTH |
.byte "IDTH",TK_WIDTH ; WIDTH |
.byte $00 |
TAB_POWR |
.byte TK_POWER,$00 ; ^ |
|
; new decode table for LIST |
; Table is .. |
; byte - keyword length, keyword first character |
; word - pointer to rest of keyword from dictionary |
|
; note if length is 1 then the pointer is ignored |
|
LAB_KEYT |
.byte 3,'E' |
.word LBB_END ; END |
.byte 3,'F' |
.word LBB_FOR ; FOR |
.byte 4,'N' |
.word LBB_NEXT ; NEXT |
.byte 4,'D' |
.word LBB_DATA ; DATA |
.byte 5,'I' |
.word LBB_INPUT ; INPUT |
.byte 3,'D' |
.word LBB_DIM ; DIM |
.byte 4,'R' |
.word LBB_READ ; READ |
.byte 3,'L' |
.word LBB_LET ; LET |
.byte 3,'D' |
.word LBB_DEC ; DEC |
.byte 4,'G' |
.word LBB_GOTO ; GOTO |
.byte 3,'R' |
.word LBB_RUN ; RUN |
.byte 2,'I' |
.word LBB_IF ; IF |
.byte 7,'R' |
.word LBB_RESTORE ; RESTORE |
.byte 5,'G' |
.word LBB_GOSUB ; GOSUB |
.byte 6,'R' |
.word LBB_RETIRQ ; RETIRQ |
.byte 6,'R' |
.word LBB_RETNMI ; RETNMI |
.byte 6,'R' |
.word LBB_RETURN ; RETURN |
.byte 3,'R' |
.word LBB_REM ; REM |
.byte 4,'S' |
.word LBB_STOP ; STOP |
.byte 2,'O' |
.word LBB_ON ; ON |
.byte 4,'N' |
.word LBB_NULL ; NULL |
.byte 3,'I' |
.word LBB_INC ; INC |
.byte 4,'W' |
.word LBB_WAIT ; WAIT |
.byte 4,'L' |
.word LBB_LOAD ; LOAD |
.byte 4,'S' |
.word LBB_SAVE ; SAVE |
.byte 3,'D' |
.word LBB_DEF ; DEF |
.byte 4,'P' |
.word LBB_POKE ; POKE |
.byte 4,'D' |
.word LBB_DOKE ; DOKE |
.byte 4,'C' |
.word LBB_CALL ; CALL |
.byte 2,'D' |
.word LBB_DO ; DO |
.byte 4,'L' |
.word LBB_LOOP ; LOOP |
.byte 5,'P' |
.word LBB_PRINT ; PRINT |
.byte 4,'C' |
.word LBB_CONT ; CONT |
.byte 4,'L' |
.word LBB_LIST ; LIST |
.byte 5,'C' |
.word LBB_CLEAR ; CLEAR |
.byte 3,'N' |
.word LBB_NEW ; NEW |
.byte 5,'W' |
.word LBB_WIDTH ; WIDTH |
.byte 3,'G' |
.word LBB_GET ; GET |
.byte 4,'S' |
.word LBB_SWAP ; SWAP |
.byte 6,'B' |
.word LBB_BITSET ; BITSET |
.byte 6,'B' |
.word LBB_BITCLR ; BITCLR |
.byte 3,'I' |
.word LBB_IRQ ; IRQ |
.byte 3,'N' |
.word LBB_NMI ; NMI |
.byte 3,'B' |
.word LBB_BYE ; BYE |
|
; secondary commands (can't start a statement) |
|
.byte 4,'T' |
.word LBB_TAB ; TAB |
.byte 4,'E' |
.word LBB_ELSE ; ELSE |
.byte 2,'T' |
.word LBB_TO ; TO |
.byte 2,'F' |
.word LBB_FN ; FN |
.byte 4,'S' |
.word LBB_SPC ; SPC |
.byte 4,'T' |
.word LBB_THEN ; THEN |
.byte 3,'N' |
.word LBB_NOT ; NOT |
.byte 4,'S' |
.word LBB_STEP ; STEP |
.byte 5,'U' |
.word LBB_UNTIL ; UNTIL |
.byte 5,'W' |
.word LBB_WHILE ; WHILE |
.byte 3,'O' |
.word LBB_OFF ; OFF |
|
; opperators |
|
.byte 1,'+' |
.word $0000 ; + |
.byte 1,'-' |
.word $0000 ; - |
.byte 1,'*' |
.word $0000 ; * |
.byte 1,'/' |
.word $0000 ; / |
.byte 1,'^' |
.word $0000 ; ^ |
.byte 3,'A' |
.word LBB_AND ; AND |
.byte 3,'E' |
.word LBB_EOR ; EOR |
.byte 2,'O' |
.word LBB_OR ; OR |
.byte 2,'>' |
.word LBB_RSHIFT ; >> |
.byte 2,'<' |
.word LBB_LSHIFT ; << |
.byte 1,'>' |
.word $0000 ; > |
.byte 1,'=' |
.word $0000 ; = |
.byte 1,'<' |
.word $0000 ; < |
|
; functions |
|
.byte 4,'S' ; |
.word LBB_SGN ; SGN |
.byte 4,'I' ; |
.word LBB_INT ; INT |
.byte 4,'A' ; |
.word LBB_ABS ; ABS |
.byte 4,'U' ; |
.word LBB_USR ; USR |
.byte 4,'F' ; |
.word LBB_FRE ; FRE |
.byte 4,'P' ; |
.word LBB_POS ; POS |
.byte 4,'S' ; |
.word LBB_SQR ; SQR |
.byte 4,'R' ; |
.word LBB_RND ; RND |
.byte 4,'L' ; |
.word LBB_LOG ; LOG |
.byte 4,'E' ; |
.word LBB_EXP ; EXP |
.byte 4,'C' ; |
.word LBB_COS ; COS |
.byte 4,'S' ; |
.word LBB_SIN ; SIN |
.byte 4,'T' ; |
.word LBB_TAN ; TAN |
.byte 4,'A' ; |
.word LBB_ATN ; ATN |
.byte 5,'P' ; |
.word LBB_PEEK ; PEEK |
.byte 5,'D' ; |
.word LBB_DEEK ; DEEK |
.byte 5,'S' ; |
.word LBB_SADD ; SADD |
.byte 4,'L' ; |
.word LBB_LEN ; LEN |
.byte 5,'S' ; |
.word LBB_STRS ; STR$ |
.byte 4,'V' ; |
.word LBB_VAL ; VAL |
.byte 4,'A' ; |
.word LBB_ASC ; ASC |
.byte 7,'U' ; |
.word LBB_UCASES ; UCASE$ |
.byte 7,'L' ; |
.word LBB_LCASES ; LCASE$ |
.byte 5,'C' ; |
.word LBB_CHRS ; CHR$ |
.byte 5,'H' ; |
.word LBB_HEXS ; HEX$ |
.byte 5,'B' ; |
.word LBB_BINS ; BIN$ |
.byte 7,'B' ; |
.word LBB_BITTST ; BITTST |
.byte 4,'M' ; |
.word LBB_MAX ; MAX |
.byte 4,'M' ; |
.word LBB_MIN ; MIN |
.byte 2,'P' ; |
.word LBB_PI ; PI |
.byte 5,'T' ; |
.word LBB_TWOPI ; TWOPI |
.byte 7,'V' ; |
.word LBB_VPTR ; VARPTR |
.byte 6,'L' ; |
.word LBB_LEFTS ; LEFT$ |
.byte 7,'R' ; |
.word LBB_RIGHTS ; RIGHT$ |
.byte 5,'M' ; |
.word LBB_MIDS ; MID$ |
|
; BASIC messages, mostly error messages |
|
LAB_BAER |
.word ERR_NF ;$00 NEXT without FOR |
.word ERR_SN ;$02 syntax |
.word ERR_RG ;$04 RETURN without GOSUB |
.word ERR_OD ;$06 out of data |
.word ERR_FC ;$08 function call |
.word ERR_OV ;$0A overflow |
.word ERR_OM ;$0C out of memory |
.word ERR_US ;$0E undefined statement |
.word ERR_BS ;$10 array bounds |
.word ERR_DD ;$12 double dimension array |
.word ERR_D0 ;$14 divide by 0 |
.word ERR_ID ;$16 illegal direct |
.word ERR_TM ;$18 type mismatch |
.word ERR_LS ;$1A long string |
.word ERR_ST ;$1C string too complex |
.word ERR_CN ;$1E continue error |
.word ERR_UF ;$20 undefined function |
.word ERR_LD ;$22 LOOP without DO |
|
; I may implement these two errors to force definition of variables and |
; dimensioning of arrays before use. |
|
; .word ERR_UV ;$24 undefined variable |
|
; the above error has been tested and works (see code and comments below LAB_1D8B) |
|
; .word ERR_UA ;$26 undimensioned array |
|
ERR_NF .byte "NEXT without FOR",$00 |
ERR_SN .byte "Syntax",$00 |
ERR_RG .byte "RETURN without GOSUB",$00 |
ERR_OD .byte "Out of DATA",$00 |
ERR_FC .byte "Function call",$00 |
ERR_OV .byte "Overflow",$00 |
ERR_OM .byte "Out of memory",$00 |
ERR_US .byte "Undefined statement",$00 |
ERR_BS .byte "Array bounds",$00 |
ERR_DD .byte "Double dimension",$00 |
ERR_D0 .byte "Divide by zero",$00 |
ERR_ID .byte "Illegal direct",$00 |
ERR_TM .byte "Type mismatch",$00 |
ERR_LS .byte "String too long",$00 |
ERR_ST .byte "String too complex",$00 |
ERR_CN .byte "Can't continue",$00 |
ERR_UF .byte "Undefined function",$00 |
ERR_LD .byte "LOOP without DO",$00 |
|
;ERR_UV .byte "Undefined variable",$00 |
|
; the above error has been tested and works (see code and comments below LAB_1D8B) |
|
;ERR_UA .byte "Undimensioned array",$00 |
|
LAB_BMSG .byte $0D,$0A,"Break",$00 |
LAB_EMSG .byte " Error",$00 |
LAB_LMSG .byte " in line ",$00 |
LAB_RMSG .byte $0D,$0A,"Ready",$0D,$0A,$00 |
|
LAB_IMSG .byte " Extra ignored",$0D,$0A,$00 |
LAB_REDO .byte " Redo from start",$0D,$0A,$00 |
|
AA_end_basic |
|
vecbrki=$0102 |
|
org $F000 |
|
cpu rtf65002 |
jsr (RequestIOFocus>>2) |
jsr (ClearScreen>>2) |
jsr (HomeCursor>>2) |
lda #0 ; turn off keyboard echoing |
jsr (SetKeyboardEcho>>2) |
emm |
cpu W65C02 |
LDA #<V__INPT |
STA VEC_IN |
LDA #>V__INPT |
STA VEC_IN+1 |
LDA #<V__OUTP |
STA VEC_OUT |
LDA #>V__OUTP |
STA VEC_OUT+1 |
LDA #<LOAD3 |
STA VEC_LD |
LDA #>LOAD3 |
STA VEC_LD+1 |
LDA #<SAVE3 |
STA VEC_SV |
LDA #>SAVE3 |
STA VEC_SV+1 |
JMP LAB_COLD |
|
; ===== Output character to the console from register r1 |
; (Preserves all registers.) |
; Does a far indirect subroutine call to native code. |
; |
V__OUTP: |
nat |
cpu rtf65002 |
pha |
jsr (DisplayChar>>2) ; should not trash char |
pla |
emm |
cpu W65C02 |
and #$FF ; set Z, N according to char in accumulator |
rts |
|
; ===== Output character to the console from register r1 |
; (Preserves all registers.) |
; Does a far indirect subroutine call to native code. |
; |
V__OUTP816: |
nat |
cpu rtf65002 |
pha |
jsr (DisplayChar>>2) ; should not trash char |
pla |
clc |
xce |
cpu W65C02 |
rts |
|
|
; ===== Input a character from the console into register R1 |
; set C if a char is available |
; clear C if no char is available |
; |
; |
V__INPT: |
nat |
cpu rtf65002 |
jsr (KeybdGetChar>>2) |
cmp #-1 |
beq .0001 |
emm |
cpu W65C02 |
sec |
rts |
.0001: |
cpu rtf65002 |
emm |
cpu W65C02 |
clc |
rts |
|
; ===== Input a character from the console into register R1 |
; clear C if a char is available |
; set C if no char is available |
; |
; |
V__INPT816: |
nat |
cpu rtf65002 |
jsr (KeybdGetChar>>2) |
cmp #-1 |
beq .001 |
clc |
xce |
cpu W65C02 |
clc |
rts |
.001: |
cpu rtf65002 |
clc |
xce |
cpu W65C02 |
sec |
rts |
|
Resched816: |
nat |
cpu rtf65002 |
int #2 |
clc |
xce |
cpu W65C816S |
rts |
|
;* |
;* ===== Input a character from the host into register r1 (or |
;* return Zero status if there's no character available). |
;* |
cpu rtf65002 |
AUXIN_INIT: |
stz INPNDX |
lda #FILENAME |
ldx #FILEBUF<<2 |
ldy #$3800 ; max length |
jsr (LoadFile>>2) |
rts |
|
cpu W65C02 |
AUXIN: |
nat |
cpu RTF65002 |
phx |
ldx INPNDX |
lb r1,FILEBUF<<2,x |
cmp #$1A ; end of file ? |
bne AUXIN1 |
sec |
xce |
cpu W65C02 |
; restore the regular output |
lda $E0 |
sta VEC_IN |
lda $E1 |
sta VEC_IN+1 |
lda #$0D |
sec |
rts |
cpu RTF65002 |
AUXIN1: |
inx |
stx INPNDX |
plx |
emm |
cpu W65C02 |
sec |
rts |
|
; ===== Output character to the host (Port 2) from register r1 |
; (Preserves all registers.) |
; |
AUXOUT_INIT: |
stz OUTNDX |
rts |
|
AUXOUT: |
cpu W65C02 |
nat |
cpu RTF65002 |
phx |
ldx OUTNDX |
sb r1,FILEBUF<<2,x |
inx |
stx OUTNDX |
plx |
emm |
cpu W65C02 |
rts |
|
cpu RTF65002 |
AUXOUT_FLUSH: |
lda #FILENAME |
ldx #FILEBUF<<2 |
ldy OUTNDX |
jsr (SaveFile>>2) |
rts |
|
LOAD3: |
jsr LAB_EVEZ ; get a string parameter |
lda Dtypef |
bpl LOAD4 |
ldy #0 |
lda (des_pl),y |
sta str_ln |
iny |
lda (des_pl),y |
sta str_pl |
iny |
lda (des_ph),y |
sta str_ph |
nat |
cpu RTF65002 |
lb r4,str_ph ; r4 = pointer to file name |
asl r4,r4,#8 |
orb r4,r4,str_pl |
lda #8 ; 8 words to zero out |
ldx #0 ; the value we want to use |
ldy #FILENAME ; the target address |
stos ; zap the memory |
lda str_ln ; number of bytes to move |
ld r2,r4 ; x = source |
ldy #FILENAME ; y = dest |
LOAD2: |
lb r4,0,r2 |
sb r4,0,r3 |
inx |
iny |
dea |
bne LOAD2 |
jsr AUXIN_INIT ; initialize for file input (get the file) |
emm |
cpu W65C02 |
; Save off the output vector and switch output to the |
; auxiallry output routine. |
sei |
lda VEC_IN ; save off the output vector to $E0 |
sta $E0 |
lda VEC_IN+1 |
sta $E1 |
lda #<AUXIN ; switch to the file output routine |
sta VEC_IN |
lda #>AUXIN |
sta VEC_IN+1 |
jsr LAB_22B6 ; pop string descriptor from stack |
LOAD4: |
rts |
|
SAVE3: |
JSR LAB_EVEZ ; get string parameter |
lda Dtypef |
bpl SAVE4 ; branch if not a string |
ldy #0 |
lda (des_pl),y |
sta str_ln |
iny |
lda (des_pl),y |
sta str_pl |
iny |
lda (des_ph),y |
sta str_ph |
nat |
cpu RTF65002 |
jsr AUXOUT_INIT ; initialize for file output |
lb r4,str_ph ; r4 = pointer to file name |
asl r4,r4,#8 |
orb r4,r4,str_pl |
lda #8 ; 8 words to zero out |
ldx #0 ; the value we want to use |
ldy #FILENAME ; the target address |
stos ; zap the memory |
lda str_ln ; number of bytes to move |
ld r2,r4 ; x = source |
ldy #FILENAME ; y = dest |
SAVE2: |
lb r4,0,r2 |
sb r4,0,r3 |
inx |
iny |
dea |
bne SAVE2 |
|
emm |
cpu W65C02 |
; Save off the output vector and switch output to the |
; auxiallry output routine. |
sei |
lda VEC_OUT ; save off the output vector to $E0 |
sta $E0 |
lda VEC_OUT+1 |
sta $E1 |
lda #<AUXOUT ; switch to the file output routine |
sta VEC_OUT |
lda #>AUXOUT |
sta VEC_OUT+1 |
; Invoke the LIST command |
lda #0 |
jsr LAB_LIST |
lda #$1A ; spit out end-of-file marker |
jsr AUXOUT |
; restore the regular output |
lda $E0 |
sta VEC_OUT |
lda $E1 |
sta VEC_OUT+1 |
nat |
cpu RTF65002 |
jsr AUXOUT_FLUSH |
emm |
cpu W65C02 |
jsr LAB_22B6 ; pop string descriptor from stack |
SAVE4: |
rts |
|
cpu rtf65002 |
outchar: |
jsr (DisplayChar>>2) ; should not trash char |
rts |
cpu rtf65002 |
|
ICacheIA816: |
nat |
jsr (ICacheInvalidateAll>>2) |
emm816 |
rts |
|
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
|
ICacheIL816: |
nat |
jsr (ICacheInvalidateLine>>2) |
emm816 |
rts |
|
;============================================================================== |
;============================================================================== |
SPIMASTER EQU 0xFFDC0500 |
SPI_MASTER_VERSION_REG EQU 0x00 |
SPI_MASTER_CONTROL_REG EQU 0x01 |
SPI_TRANS_TYPE_REG EQU 0x02 |
SPI_TRANS_CTRL_REG EQU 0x03 |
SPI_TRANS_STATUS_REG EQU 0x04 |
SPI_TRANS_ERROR_REG EQU 0x05 |
SPI_DIRECT_ACCESS_DATA_REG EQU 0x06 |
SPI_SD_SECT_7_0_REG EQU 0x07 |
SPI_SD_SECT_15_8_REG EQU 0x08 |
SPI_SD_SECT_23_16_REG EQU 0x09 |
SPI_SD_SECT_31_24_REG EQU 0x0a |
SPI_RX_FIFO_DATA_REG EQU 0x10 |
SPI_RX_FIFO_DATA_COUNT_MSB EQU 0x12 |
SPI_RX_FIFO_DATA_COUNT_LSB EQU 0x13 |
SPI_RX_FIFO_CTRL_REG EQU 0x14 |
SPI_TX_FIFO_DATA_REG EQU 0x20 |
SPI_TX_FIFO_CTRL_REG EQU 0x24 |
SPI_RESP_BYTE1 EQU 0x30 |
SPI_RESP_BYTE2 EQU 0x31 |
SPI_RESP_BYTE3 EQU 0x32 |
SPI_RESP_BYTE4 EQU 0x33 |
SPI_INIT_SD EQU 0x01 |
SPI_TRANS_START EQU 0x01 |
SPI_TRANS_BUSY EQU 0x01 |
SPI_INIT_NO_ERROR EQU 0x00 |
SPI_READ_NO_ERROR EQU 0x00 |
SPI_WRITE_NO_ERROR EQU 0x00 |
RW_READ_SD_BLOCK EQU 0x02 |
RW_WRITE_SD_BLOCK EQU 0x03 |
; |
; Initialize the SD card |
; Returns |
; acc = 0 if successful, 1 otherwise |
; Z=1 if successful, otherwise Z=0 |
; |
message "spi_init" |
spi_init |
lda #SPI_INIT_SD |
sta SPIMASTER+SPI_TRANS_TYPE_REG |
lda #SPI_TRANS_START |
sta SPIMASTER+SPI_TRANS_CTRL_REG |
nop |
spi_init1 |
lda SPIMASTER+SPI_TRANS_STATUS_REG |
nop |
nop |
cmp #SPI_TRANS_BUSY |
beq spi_init1 |
lda SPIMASTER+SPI_TRANS_ERROR_REG |
and #3 |
cmp #SPI_INIT_NO_ERROR |
bne spi_error |
; lda #spi_init_ok_msg |
; jsr DisplayStringB |
lda #0 |
rts |
spi_error |
; jsr DisplayByte |
; lda #spi_init_error_msg |
; jsr DisplayStringB |
; lda SPIMASTER+SPI_RESP_BYTE1 |
; jsr DisplayByte |
; lda SPIMASTER+SPI_RESP_BYTE2 |
; jsr DisplayByte |
; lda SPIMASTER+SPI_RESP_BYTE3 |
; jsr DisplayByte |
; lda SPIMASTER+SPI_RESP_BYTE4 |
; jsr DisplayByte |
lda #1 |
rts |
|
spi_delay: |
nop |
nop |
rts |
|
|
; SPI read sector |
; |
; r1= sector number to read |
; r2= address to place read data |
; Returns: |
; r1 = 0 if successful |
; |
spi_read_sector: |
phx |
phy |
push r4 |
|
sta SPIMASTER+SPI_SD_SECT_7_0_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_15_8_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_23_16_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_31_24_REG |
|
ld r4,#20 ; retry count |
|
spi_read_retry: |
; Force the reciever fifo to be empty, in case a prior error leaves it |
; in an unknown state. |
lda #1 |
sta SPIMASTER+SPI_RX_FIFO_CTRL_REG |
|
lda #RW_READ_SD_BLOCK |
sta SPIMASTER+SPI_TRANS_TYPE_REG |
lda #SPI_TRANS_START |
sta SPIMASTER+SPI_TRANS_CTRL_REG |
nop |
spi_read_sect1: |
lda SPIMASTER+SPI_TRANS_STATUS_REG |
jsr spi_delay ; just a delay between consecutive status reg reads |
cmp #SPI_TRANS_BUSY |
beq spi_read_sect1 |
lda SPIMASTER+SPI_TRANS_ERROR_REG |
lsr |
lsr |
and #3 |
cmp #SPI_READ_NO_ERROR |
bne spi_read_error |
ldy #512 ; read 512 bytes from fifo |
spi_read_sect2: |
lda SPIMASTER+SPI_RX_FIFO_DATA_REG |
sb r1,0,x |
inx |
dey |
bne spi_read_sect2 |
lda #0 |
bra spi_read_ret |
spi_read_error: |
dec r4 |
bne spi_read_retry |
; jsr DisplayByte |
; lda #spi_read_error_msg |
; jsr DisplayStringB |
lda #1 |
spi_read_ret: |
pop r4 |
ply |
plx |
rts |
|
; SPI write sector |
; |
; r1= sector number to write |
; r2= address to get data from |
; Returns: |
; r1 = 0 if successful |
; |
spi_write_sector: |
phx |
phy |
pha |
; Force the transmitter fifo to be empty, in case a prior error leaves it |
; in an unknown state. |
lda #1 |
sta SPIMASTER+SPI_TX_FIFO_CTRL_REG |
nop ; give I/O time to respond |
nop |
|
; now fill up the transmitter fifo |
ldy #512 |
spi_write_sect1: |
lb r1,0,x |
sta SPIMASTER+SPI_TX_FIFO_DATA_REG |
nop ; give the I/O time to respond |
nop |
inx |
dey |
bne spi_write_sect1 |
|
; set the sector number in the spi master address registers |
pla |
sta SPIMASTER+SPI_SD_SECT_7_0_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_15_8_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_23_16_REG |
lsr r1,r1,#8 |
sta SPIMASTER+SPI_SD_SECT_31_24_REG |
|
; issue the write command |
lda #RW_WRITE_SD_BLOCK |
sta SPIMASTER+SPI_TRANS_TYPE_REG |
lda #SPI_TRANS_START |
sta SPIMASTER+SPI_TRANS_CTRL_REG |
nop |
spi_write_sect2: |
lda SPIMASTER+SPI_TRANS_STATUS_REG |
nop ; just a delay between consecutive status reg reads |
nop |
cmp #SPI_TRANS_BUSY |
beq spi_write_sect2 |
lda SPIMASTER+SPI_TRANS_ERROR_REG |
lsr r1,r1,#4 |
and #3 |
cmp #SPI_WRITE_NO_ERROR |
bne spi_write_error |
lda #0 |
bra spi_write_ret |
spi_write_error: |
; jsr DisplayByte |
; lda #spi_write_error_msg |
; jsr DisplayStringB |
lda #1 |
|
spi_write_ret: |
ply |
plx |
rts |
|
|
cpu W65C816S |
brk_rout: |
phb ;save DB |
phd ;save DP |
rep #%00110000 ;16 bit registers |
pha |
phx |
phy |
jmp (vecbrki) ;indirect vector |
brk1: |
rep #%00110000 ;16 bit registers |
ply |
plx |
pla |
pld |
plb |
rti |
|
cpu W65C02 |
org $F400 |
jmp V__INPT816 |
jmp LAB_BYE |
jmp V__OUTP816 |
jmp Resched816 |
|
cpu RTF65002 |
org $F500 |
jsr (RequestIOFocus>>2) |
jsr (ClearScreen>>2) |
jsr (HomeCursor>>2) |
lda #0 ; turn off keyboard echoing |
jsr (SetKeyboardEcho>>2) |
; trs r0,cc ; turn caches off |
clc |
xce |
cpu W65C816S |
rep #%00110000 ;16 bit registers |
mem 16 |
ndx 16 |
lda #brk1 ; initialize the break routine vector |
sta vecbrki |
jmp $008000 |
|
org $FFE6 |
dw brk_rout |
|
/rtf65002/trunk/software/asm/DOS.asm
0,0 → 1,1493
;============================================================================== |
; __ |
; \\__/ o\ (C) 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@opencores.org |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; DOS.asm |
; Disk operating system code |
;============================================================================== |
; |
cpu rtf65002 |
; 64GB card |
; 36 address bits |
; 9 bits for 512 byte block size |
; 27 bits for block number |
; 4kB cluster size = 3 bits |
; 24 bit cluster number |
; 2MB bitmap of allocated clusters ( contained in 512 clusters) |
; 512 super bitmap bits |
; |
NO_DEV EQU -1 |
READING EQU 'R' |
WRITING EQU 'W' |
DIRTY EQU 'D' |
CLEAN EQU 'C' |
NORMAL EQU 0 |
|
ONE_SHOT EQU 1 |
WRITE_IMMED EQU 2 |
ZUPER_BLOCK EQU 2 ; write superblock immediately |
SUPER_BLOCK_NUM EQU 1 ; should calculate this |
; |
; Note that structure offsets are word offsets |
; The super block always occupies a whole block for simplicity even though |
; it's mostly unused. |
; |
; STRUCT SUPER_BLOCK |
; |
s_inodes_count EQU 0 |
s_blocks_count EQU 1 |
s_r_blocks_count EQU 2 |
s_free_blocks_count EQU 3 |
s_free_inodes_count EQU 4 |
s_first_data_block EQU 5 |
s_log_block_size EQU 6 |
s_log_frag_size EQU 7 |
s_blocks_per_group EQU 8 |
s_frags_per_group EQU 9 |
s_inodes_per_group EQU 10 |
s_pad EQU 11 |
s_mtime EQU 12 |
s_wtime EQU 14 |
s_mnt_cnt EQU 16 |
s_max_mnt_cnt EQU 17 |
s_magic EQU 18 |
s_state EQU 19 |
s_errors EQU 20 |
s_minor_rev_level EQU 21 |
s_lastcheck EQU 22 |
s_checkinterval EQU 24 |
s_creator_os EQU 26 |
s_rev_level EQU 27 |
s_def_res_uid EQU 28 |
s_def_res_gid EQU 29 |
s_inode_size EQU 31 |
s_volume_name EQU 40 |
; In memory management fields |
s_inodes_per_block EQU 124 |
s_dev EQU 125 |
s_dirty EQU 126 |
SUPERBUF_SIZE EQU 128 |
|
; STRUCT INODE |
; |
i_mode EQU 0 |
i_uid EQU 1 |
i_size EQU 2 |
i_gid EQU 3 |
i_atime EQU 4 |
i_ctime EQU 6 |
i_mtime EQU 8 |
i_dtime EQU 10 |
i_links_count EQU 12 |
i_blocks EQU 13 |
i_flags EQU 14 |
i_osd1 EQU 15 |
INODE_P0 EQU 16 |
INODE_P1 EQU INODE_P0+1 |
INODE_P2 EQU INODE_P1+1 |
INODE_P3 EQU INODE_P2+1 |
INODE_P4 EQU INODE_P3+1 |
INODE_P5 EQU INODE_P4+1 |
INODE_P6 EQU INODE_P5+1 |
INODE_P7 EQU INODE_P6+1 |
INODE_P8 EQU INODE_P7+1 |
INODE_P9 EQU INODE_P8+1 |
INODE_P10 EQU INODE_P9+1 |
INODE_P11 EQU INODE_P10+1 |
INODE_IP EQU INODE_P11+1 ; indirect pointer |
INODE_IIP EQU INODE_IP+1 ; double indirect pointer |
INODE_IIIP EQU INODE_IIP+1 ; triple indirect pointer |
i_generation EQU 31 |
i_file_acl EQU 32 |
i_dir_acl EQU 33 |
i_faddr EQU 34 |
i_osd2 EQU 35 |
INODE_DEV EQU 37 |
INODE_INUM EQU 38 |
INODE_ICOUNT EQU 39 |
INODE_DIRTY EQU 40 |
INODE_SIZE EQU 41 ; 41 words |
|
; STRUCT BGDESC |
; |
bg_block_bitmap EQU 0 |
bg_inode_bitmap EQU 1 |
bg_inode_table EQU 2 |
bg_free_blocks_count EQU 3 |
bg_free_inodes_count EQU 4 |
bg_used_dirs_count EQU 5 |
bg_reserved EQU 6 |
BGDESC_SIZE EQU 8 |
bg_dev EQU 9 |
bg_group_num EQU 10 |
bg_dirty EQU 11 |
BGD_BUFSIZE EQU 12 |
|
; STRUCT DIRENTRY |
; Directory entries are 64 bytes |
; 28 character file name |
; 4 byte i-node number |
; |
DE_NAME EQU 0 |
DE_TYPE EQU 14 |
DE_INODE EQU 15 |
DE_SIZE EQU 16 ; size in words |
|
; Structure of a disk buffer |
; The disk buffer contains a number of fields for file system management |
; followed by a payload area containing disk block contents. |
; |
; STRUCT BUF |
; |
b_dev EQU 0 ; device |
b_blocknum EQU 1 ; disk block number |
b_count EQU 2 ; reference count |
b_dirty EQU 3 ; buffer has been altered |
b_next EQU 4 ; next buffer on LRU list |
b_prev EQU 5 |
b_hash EQU 6 ; pointer to hashed buffer |
b_data EQU 8 ; beginning of data area |
BUF_INODE EQU 8 |
BUF_SIZE EQU b_data+256 |
|
NR_BUFS EQU 8192 ; number of disk buffers in the system (must be a power of 2) |
NR_BUF_HASH EQU 1024 ; number of hash chains (must be a power of two) |
NR_BGD_BUFS EQU 1024 |
BT_DATA_BLOCK EQU 0 |
BT_SUPERBLOCK EQU 1 |
|
IAM_BUF_SIZE EQU 1032 ; 1024 + 8 |
CAM_SUPERMAP_SIZE EQU 128 |
|
; $00000000 super block |
; $00000001 iam super map (512 bits) |
; $00000002 inode allocation map (128kB) |
; $00000102 inode array (1M x 128 byte entries) |
; $00040102 cam super bitmap bits (512 bits) |
; $00040103 cluster allocation map (2MB) |
; $00041103 start of data clusters |
|
; Approximately 12MB (10% of memory) is allowed for the file system variables. |
; Most of the space 8MB+ is alloted to disk buffers. |
|
DOS_DATA EQU 0x00300000 ; start address of DOS data area |
super_bufs EQU DOS_DATA |
super_bufs_end EQU super_bufs + SUPERBUF_SIZE * 32 |
BGD_bufs EQU super_bufs_end |
BGD_bufs_end EQU BGD_bufs + NR_BGD_BUFS * BGD_BUFSIZE ; 32 kB = 1024 descriptors |
iam_bufs EQU BGD_bufs_end |
inode_array EQU iam_bufs + IAM_BUF_SIZE * 32 ; 129 kB worth |
inode_array_end EQU inode_array + INODE_SIZE * 256 ; 41kB worth (256 open files) |
data_bufs EQU 0x00320000 ; room for 8192 buffers |
data_bufs_end EQU data_bufs + BUF_SIZE * NR_BUFS |
buf_hash EQU data_bufs_end |
buf_hash_end EQU buf_hash + NR_BUF_HASH |
superbuf_dump EQU buf_hash_end + 1 |
bufs_in_use EQU superbuf_dump + 1 |
blockbuf_dump EQU bufs_in_use + 1 |
disk_size EQU blockbuf_dump + 1 |
block_size EQU disk_size + 1 |
fs_start_block EQU block_size + 1 |
bgdt_valid EQU fs_start_block + 1 |
front EQU bgdt_valid + 1 |
rear EQU front + 1 |
panicking EQU rear + 1 |
fs_active EQU panicking + 1 |
DOS_DATA_ENDS EQU 0x0540000 |
|
; number of buffers for the inode allocation map |
; number of buffers for inode array |
; Total caching to be 12MB |
; 9MB reserved for data block caching |
; 3MB reserved for file management caching |
|
inode_bufs EQU DOS_DATA ; 128B x 256 bufs |
iam_buf EQU 0x01FBE800 |
sector_buf EQU 0x01FBEC00 |
|
org $FFFFD800 |
|
;------------------------------------------------------------------------------ |
; Initialize the file system. |
;------------------------------------------------------------------------------ |
; |
init_fs: |
stz bgdt_valid |
jsr init_superbufs |
jsr init_databufs |
lda #'A' |
sta fs_active |
lda #4 |
ldx #0 ; no flags (em =0 native mode) |
ldy #fs_clean |
jsr StartTask |
rts |
|
;------------------------------------------------------------------------------ |
; The file system offset is the offset in disk sectors to the start |
; of the file system. It may be desireable to reserve a number of |
; disk sectors prior to the actual file system start. |
;------------------------------------------------------------------------------ |
; |
get_filesystem_offset: |
lda #2 |
rts |
|
;------------------------------------------------------------------------------ |
; Initialize super block buffer array. |
;------------------------------------------------------------------------------ |
; |
init_superbufs: |
pha |
phx |
ldx #super_bufs |
isb1: |
lda #NO_DEV |
sta s_dev,x |
lda #CLEAN |
sta s_dirty,x |
add r2,r2,#SUPERBUF_SIZE |
cpx #super_bufs_end |
bltu isb1 |
plx |
pla |
rts |
|
init_databufs: |
pha |
phx |
phy |
stz bufs_in_use |
ldx #data_bufs |
stx front |
lda #data_bufs_end |
sub #BUF_SIZE |
sta rear |
idb1: |
lda #NO_DEV |
sta b_dev,x |
lda #CLEAN |
sta b_dirty,x |
sub r3,r2,#BUF_SIZE |
sty b_prev,x |
add r3,r2,#BUF_SIZE |
sty b_next,x |
sty b_hash,x |
tyx |
cpx #data_bufs_end |
bltu idb1 |
ldx front |
stz b_prev,x |
stx buf_hash ; buf_hash[0] = front |
ldx rear |
stz b_next,x |
ply |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; Parameters: |
; r1 = device |
; Returns: |
; r1 = block size in bytes |
;------------------------------------------------------------------------------ |
get_block_size: |
phx |
phy |
jsr get_super |
tax |
ldy s_log_block_size,x |
lda #1024 |
asl r1,r1,r3 |
ply |
plx |
rts |
|
get_log_block_size: |
phx |
jsr get_super |
tax |
lda s_log_block_size,x |
plx |
rts |
|
get_inode_size: |
phx |
jsr get_super |
tax |
lda s_inode_size,x |
plx |
rts |
|
get_inodes_per_group: |
phx |
jsr get_super |
tax |
lda s_inodes_per_group,x |
plx |
rts |
|
; inodes per block does not need to be a power of 2 |
; |
get_inodes_per_block: |
phx |
pha |
jsr get_block_size |
tax |
pla |
jsr get_inode_size |
div r1,r2,r1 |
plx |
rts |
|
get_bgd_per_block: |
jsr get_block_size |
lsr ; BGD size is 32 bytes |
lsr |
lsr |
lsr |
lsr |
rts |
|
get_bits_per_block: |
jsr get_block_size |
asl |
asl |
asl |
rts |
|
get_num_bgd: |
phx |
jsr get_super |
lda s_blocks_count,r1 |
tax |
jsr get_bits_per_block |
div r1,r2,r1 |
plx |
rts |
|
;============================================================================== |
; INODE code |
;============================================================================== |
;------------------------------------------------------------------------------ |
; Free an inode. |
; |
; Parameters: |
; r1 = device number |
; r2 = inode number |
;------------------------------------------------------------------------------ |
; |
free_inode: |
pha |
phx |
phy |
push r4 |
push r5 |
push r7 |
push r8 |
push r9 |
ld r7,r1 ; r7 = device number |
jsr get_inodes_per_group |
div r4,r2,r1 ; r4 = group number of inode |
mod r5,r2,r1 ; r5 = group index |
ld r1,r7 |
ld r2,r4 |
jsr get_bgdt_entry |
ld r9,r1 ; r9 = pointer to BGDesc |
ld r1,r7 |
ld r2,bg_inode_bitmap,r9 |
jsr get_block ; get the bitmap block |
ld r8,r1 ; r8 = bitmap block |
ld r1,r5 |
bmt b_data,r8 ; is the inode already free ? |
beq fi1 |
bmc b_data,r8 |
inc bg_free_inodes_count,r9 |
lda #DIRTY |
sta bg_dirty,r9 |
jsr get_super |
tax |
inc s_free_inodes_count,x |
lda #DIRTY |
sta s_dirty,x |
sta b_dirty,r8 |
txy |
jsr get_datetime |
stx s_mtime,y |
sta s_mtime+1,y |
fi1: |
pop r9 |
pop r8 |
pop r7 |
pop r5 |
pop r4 |
ply |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; Allocate an inode |
; This is called when a file or directory is created. The routine allocates |
; an inode on disk, then gets an inode buffer. |
; |
; Parameters: |
; r1 = device number |
; r2 = mode bits |
; Returns: |
; r1 = pointer to inode buffer |
;------------------------------------------------------------------------------ |
; |
alloc_inode: |
phx |
phy |
push r4 |
push r7 |
push r8 |
push r9 |
push r10 |
push r11 |
; search the super match for a block with available inode |
lda #0 ; start at bit zero |
ld r7,r1 |
ld r8,r2 |
jsr get_num_bgd |
tay |
jsr get_inodes_per_block |
ld r9,r1 |
ld r2,#0 ; start with group #0 |
alin2: |
ld r1,r7 |
jsr get_bgdt_entry |
ld r4,r1 |
lda bg_free_inodes_count,r4 |
bne alin3 |
inx |
dey |
bne alin2 |
ld r1,r7 |
jsr dos_msg |
db "Out of inodes on device ",0 |
alin7: |
pop r11 |
pop r10 |
pop r9 |
pop r8 |
pop r7 |
pop r4 |
ply |
plx |
lda #0 |
rts |
alin3: |
ld r1,r7 |
ld r10,r2 ; r10 = bgd entry number |
ldx bg_inode_bitmap,r4 |
ldy #NORMAL |
jsr get_block |
tax |
ld r3,r9 ; r3 = indoes per block |
lda #0 |
alin5: |
bmt b_data,x |
beq alin4 |
ina |
dey |
bne alin5 |
alin4: |
bms b_data,x ; mark inode allocated |
ld r5,r1 ; r5 = inode number within block |
dec bg_free_inodes_count,r4 |
mul r11,r10,r9 |
add r5,r5,r11 ; r5 = inode number |
lda #DIRTY |
sta bg_dirty,r4 |
jsr get_super ; decrement free inode count in superblock |
dec s_free_inodes_count,r1 ; and mark the superblock dirty |
tay |
lda #DIRTY |
sta s_dirty,y |
jsr get_datetime |
stx i_mtime,y |
sta i_mtime+1,y |
; |
ld r1,r7 ; r1 = device number |
ld r2,r5 ; r2 = inode number |
jsr get_inode |
cmp #0 |
bne alin6 |
ld r1,r7 |
ld r2,r5 |
jsr free_inode |
bra alin7 |
alin6: |
st r8,i_mode,r1 |
stz i_link_count,r1 |
; set uid,gid |
st r7,i_dev,r1 |
jsr wipe_inode |
pop r11 |
pop r10 |
pop r9 |
pop r8 |
pop r7 |
pop r4 |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
; |
wipe_inode: |
pha |
phx |
phy |
tay |
stz i_size,y |
jsr get_datetime |
stx i_mtime,y |
sta i_mtime+1,y |
lda #DIRTY |
sta i_dirty,y |
ldx #15 |
win1: |
stz INODE_P0,y |
iny |
dex |
bne win1 |
ply |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; Get an inode |
; |
; There are 256 inode buffers in the system which allows for 256 files |
; to be open at once. |
; |
; Parameters: |
; r1 = device |
; r2 = inode number |
; Returns: |
; r1 = pointer to inode buffer |
;------------------------------------------------------------------------------ |
; |
get_inode: |
; push working registers |
push r4 ; r4 = buffer number |
push r5 ; r5 points to inode buffer |
push r6 |
push r7 |
ld r7,#0 ; tracks the last free buffer |
; Search the in use inode buffers for the one corresponding |
; to the given device and node number. If found then increment |
; the reference count and return a pointer to the buffer. |
ld r4,#0 |
ld r5,#inode_bufs |
gib4: |
ld r6,INODE_ICOUNT,r5 ; check the count field to see if in use |
beq gib3 ; branch if not in use |
cmp INODE_DEV,r5 ; now check for a matching device |
bne gib5 ; branch if no match |
cpx INODE_INUM,r5 ; now check for matching node number |
bne gib5 |
inc INODE_ICOUNT,r5 ; increment count |
ld r1,r5 |
pop r7 |
pop r6 ; pop working registers |
pop r5 |
pop r4 |
cmp #0 |
rts |
|
gib3: |
ld r7,r5 ; remember the free inode |
gib5: |
add r4,#1 ; increment buffer number |
add r5,r5,#INODE_SIZE ; size of an inode in words |
cmp r4,#256 ; have we searched all buffers ? |
bltu gib4 |
cmp r7,#0 ; test if free buffer found |
bne gib6 |
pop r7 |
pop r6 |
pop r5 |
pop r4 |
ld r1,#0 ; no more inode buffers available |
rts |
gib6: |
sta INODE_DEV,r7 |
stx INODE_INUM,r7 |
inc INODE_ICOUNT,r7 ; count field =1, was 0 |
cmp #NO_DEV ; if there was a device number supplied |
beq gib7 ; read the inode from the device |
ld r1,r7 |
ldx #READING |
jsr rw_inode |
gib7: |
ld r1,r7 |
pop r7 ; restore work registers |
pop r6 |
pop r5 |
pop r4 |
cmp #0 |
rts |
|
;------------------------------------------------------------------------------ |
; Put inode |
; |
; Parameters: |
; r1 = pointer to inode buffer |
;------------------------------------------------------------------------------ |
; |
put_inode: |
cmp #0 ; check for NULL pointer |
bne pi1 |
rts |
pi1: |
phx |
tax |
dec INODE_ICOUNT,x |
bne pi2 |
; If the number of links to the inode is zero |
; then deallocate the storage for the inode |
pi2: |
lda INODE_DIRTY,x |
cmp #DIRTY |
bne pi3 |
txa ; acc = inode buffer pointer |
ldx #WRITING |
jsr rw_inode |
pi3: |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; Parameters: |
; r1 = inode |
; r2 = R/W indicator |
;------------------------------------------------------------------------------ |
rw_inode: |
pha |
phx |
phy |
push r4 |
push r5 |
push r6 |
push r7 |
; get the super block for the device |
phx |
pha |
lda INODE_DEV,r1 |
jsr get_inodes_per_group |
ld r5,r1 ; r4 = inodes per group |
pla |
ldx INODE_INUM,r1 |
div r6,r2,r5 ; r6 = group number |
mod r7,r2,r5 ; r7 = index into group |
lda INODE_DEV,r1 |
pha |
ld r2,r6 |
jsr get_bgdt_entry |
lda bg_inode_table,r1 ; get block address of inode table |
pha |
jsr get_inodes_per_block |
div r6,r7,r1 |
mod r8,r7,r1 |
pla |
add r2,r1,r6 |
pla |
ldy #NORMAL |
jsr get_block |
|
ld r7,r1 ; r7 = pointer to block buffer |
pop r4 ; r4 = inode |
add r5,r1,#BUF_INODE ; r5 = address of inode data |
|
mul r6,r8,#INODE_SIZE |
add r5,r5,r6 |
pop r6 ; r6 = R/W indicator |
cmp r6,#READING |
bne rwi1 |
jsr get_inode_size |
dea |
ld r2,r5 |
ld r3,r4 |
mvn |
bra rwi2 |
rwi1: |
jsr get_inode_size |
dea |
ld r2,r4 |
ld r3,r5 |
mvn |
jsr get_datetime |
stx INODE_WTIME,r4 |
sta INODE_WTIME+1,r4 |
lda #DIRTY |
sta b_dirty,r7 |
rwi2: |
jsr get_datetime |
stx INODE_ATIME,r4 |
sta INODE_ATIME+1,r4 |
ld r1,r7 ; r1 = pointer to block buffer |
ld r2,#INODE_BLOCK |
jsr put_block |
lda #CLEAN |
sta INODE_DIRTY,r4 |
pop r7 |
pop r6 |
pop r5 |
pop r4 |
ply |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
;------------------------------------------------------------------------------ |
dup_inode: |
inc INODE_ICOUNT,r1 |
rts |
|
;------------------------------------------------------------------------------ |
; get_bgdt_entry: |
; Get block group descriptor from the descriptor table. |
; |
; Parameters: |
; r1 = device number |
; r2 = group number |
; Returns: |
; r1 = pointer to BGD buffer |
;------------------------------------------------------------------------------ |
; |
get_bgdt_entry: |
push r5 |
and r5,r2,#NR_BGD_BUFS-1 ; r5 = hashed group number |
mul r5,r5,#BGD_BUFSIZE |
add r5,r5,#BGD_bufs ; r5 = pointer to BGD buffer |
cmp bg_dev,r5 |
bne gbe1 |
cpx bg_group_num,r5 |
beq gbe2 |
gbe1: |
push r4 |
push r6 |
push r7 |
push r8 |
ld r6,r1 ; r6 = device number |
ld r7,r2 ; r7 = group number |
; does the buffer need to be written to disk ? |
ld r4,bg_dirty,r5 |
cmp r4,#CLEAN |
beq gbe3 |
; Compute the block number containing the group |
jsr get_bgd_per_block |
ld r2,bg_group_num,r5 |
div r8,r2,r1 |
mod r4,r2,r1 |
lda fs_start_block |
ina ; the next block after the file system start |
add r2,r1,r8 ; r2 = block number |
ld r1,r6 ; r1 = device number |
jsr get_block |
pha |
add r1,r1,#b_data ; move to data area |
mul r4,r4,#BGDESC_SIZE |
add r1,r1,r4 ; r1 = pointer to desired BGD |
; copy BGD to the block |
tay |
ld r2,r5 |
lda #BGDESC_SIZE-1 |
mvn |
pla |
ld r2,#DIRTY |
stx b_dirty,r1 |
gbe3: |
; Compute the block number containing the group |
ld r1,r6 |
ld r2,r7 |
jsr get_bgd_per_block |
div r8,r2,r1 |
mod r4,r2,r1 |
lda fs_start_block |
ina ; the next block after the file system start |
add r2,r1,r8 ; r2 = block number |
ld r1,r6 ; r1 = device number |
jsr get_block |
add r1,r1,#b_data ; move to data area |
mul r4,r4,#BGDESC_SIZE |
add r1,r1,r4 ; r1 = pointer to desired BGD |
; copy BGD from the block to the buffer |
tax |
ld r3,r5 |
lda #BGDESC_SIZE-1 |
mvn |
st r6,bg_dev,r5 |
st r7,bg_group_num,r5 |
lda #CLEAN |
sta bg_dirty,r5 |
pop r8 |
pop r7 |
pop r6 |
pop r4 |
gbe2: |
ld r1,r5 |
pop r5 |
rts |
|
;============================================================================== |
; Block Caching |
;============================================================================== |
|
;------------------------------------------------------------------------------ |
; get_block |
; |
; Gets a block from the device. First the block cache is checked for the |
; block; if found the cached buffer is returned. |
; The block number is hashed to determine where to start the search for a |
; cached buffer. |
; |
; Parameters: |
; r1 = device |
; r2 = block number |
; r3 = only searching |
; Returns: |
; r1 = pointer to buffer containing block |
;------------------------------------------------------------------------------ |
; |
get_block: |
phx |
phy |
push r4 |
push r5 |
push r6 |
push r7 |
push r8 |
ld r4,r1 ; r4 = device number |
ld r5,r2 ; r5 = block number |
and r6,r5,#NR_BUF_HASH-1 |
ldx buf_hash,r6 |
cmp r4,#NO_DEV |
beq gb11 |
gb15: |
cmp r2,r0 ; while (bp <> NULL) { |
beq gb12 |
cmp r4,b_dev,x ; if (bp->b_dev == dev) { |
bne gb13 |
cmp r5,b_blocknum,x ; if (bp->b_blocknum==block) { |
bne gb13 |
cmp r0,b_count,x ; if (bp->b_count==0) |
bne gb14 |
inc bufs_in_use ; bufs_in_use++ |
gb14: |
inc b_count,x ; bp->b_count++ |
txa ; return (bp) |
gb_ret: |
pop r8 |
pop r7 |
pop r6 |
pop r5 |
pop r4 |
ply |
plx |
rts |
gb13: |
ldx b_hash,x ; bp = bp->b_hash |
bra gb15 |
gb11: |
gb12: |
lda bufs_in_use |
cmp #NR_BUFS |
bltu gb16 |
jsr panic |
db "All buffers in use.",0 |
gb16: |
inc bufs_in_use |
ldx front |
gb18: |
cmp r0,b_count,x |
bls gb17 |
cmp r0,b_next,x |
beq gb17 |
ldx b_next,x |
bra gb18 |
gb17: |
cmp r2,r0 |
beq gb19 |
cmp r0,b_count,x |
bls gb20 |
gb19: |
jsr panic |
db "No free buffer.", 0 |
gb20: |
ld r6,b_blocknum,x |
and r6,r6,#NR_BUF_HASH-1 |
ld r7,buf_hash,r6 |
cmp r7,r2 |
bne gb21 |
ld r8,b_hash,x |
st r8,buf_hash,r6 |
bra gb22 |
gb21: |
cmp r0,b_hash,r7 |
beq gb22 |
cmp r2,b_hash,r7 |
bne gb23 |
ld r8,b_hash,x |
st r8,b_hash,r7 |
bra gb22 |
gb23: |
ld r7,b_hash,r7 |
bra gb21 |
gb22: |
ld r8,b_dirty,x |
cmp r8,#DIRTY |
bne gb24 |
ld r8,b_dev,x |
cmp r8,#NO_DEV |
beq gb24 |
phx |
txa |
ldx #WRITING |
jsr rw_block |
plx |
gb24: |
st r4,b_dev,x ; bp->b_dev = dev |
st r5,b_blocknum,x ; bp->b_blocknum = block |
inc b_count,x ; bp->b_count++ |
ld r7,buf_hash,r6 |
st r7,b_hash,x ; bp->b_hash = buf_hash[bp->b_blocknr & (NR_b_hash - 1)] |
st r2,buf_hash,r6 ; buf_hash[bp->b_blocknr & (NR_b_hash - 1)] = bp |
cmp r4,#NO_DEV |
beq gb25 |
cmp r3,#NORMAL |
bne gb25 |
phx |
txa |
ldx #READING |
jsr rw_block |
pla |
bra gb_ret |
gb25: |
txa |
bra gb_ret |
|
;------------------------------------------------------------------------------ |
; put_block |
; Put a block back to device |
; |
; Parameters: |
; r1 = pointer to buffer to put |
; r2 = block type |
; |
;------------------------------------------------------------------------------ |
; |
put_block: |
cmp #0 ; NULL pointer check |
bne pb1 |
pb2: |
rts |
pb1: |
pha |
phx |
push r4 |
push r5 |
push r7 |
push r8 |
ld r4,r1 |
ld r5,r2 |
dec b_count,r1 ; if buf count > 0 then buffer is still in use |
bne pb2 |
dec bufs_in_use |
tax |
ld r7,b_next,x |
ld r8,b_prev,x |
beq pb3 |
st r7,b_next,r8 ; prev_ptr->b_next = next_ptr |
bra pb4 |
pb3: |
st r7,front ; front = next_ptr |
pb4: |
cmp r7,r0 |
beq pb5 |
st r8,b_next,r7 |
bra pb6 |
pb5: |
st r8,rear |
pb6: |
bit r5,#ONE_SHOT |
beq pb7 |
stz b_prev,x |
lda front |
sta b_next,x |
bne bp8 |
stx rear |
bra bp9 |
bp8: |
stx b_prev,r1 ; front->b_prev = bp |
bp9: |
stx front ; front = bp |
bra bp10 |
pb7: |
stz b_next,x ; bp->b_next = NULL |
lda rear |
sta b_prev,x ; bp->b_prev = rear |
bne bp11 |
stx front ; front = bp |
bra bp12 |
bp11: |
stx b_next,r1 ; rear->b_next = bp |
bp12: |
stx rear ; read = bp |
bp10: |
cmp r0,b_dev,x |
beq bp13 |
lda #DIRTY |
cmp b_dirty,x |
bne bp13 |
bit r5,#WRITE_IMMED |
beq bp13 |
phx |
txa |
ldx #WRITING |
jsr rw_block |
plx |
bp13: |
cmp r5,#ZUPER_BLOCK |
bne bp14 |
lda #NO_DEV |
sta b_dev,x |
bp14: |
pop r8 |
pop r7 |
pop r5 |
pop r4 |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; block_to_sector: |
; Convert a block number to a sector number. |
; |
; Parameters: |
; r1 = block number |
; Returns: |
; r1 = sector number |
;------------------------------------------------------------------------------ |
block_to_sector: |
phx |
pha |
jsr get_log_block_size |
tax |
pla |
inx |
asl r1,r1,r2 |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; rw_block: |
; ToDo: add error handling |
; |
; Parameters: |
; r1 = pointer to buffer to operate on |
; r2 = R/W flag |
;------------------------------------------------------------------------------ |
; |
rw_block: |
phx |
phy |
push r4 |
push r5 |
pha |
ld r5,r1 ; r5 = pointer to data buffer |
add r5,r5,#b_data |
ldy b_dev,r1 |
cpy #NO_DEV |
beq rwb1 |
ldy b_blocknum,r1 ; y = block number |
ld r4,#1 ; r4 = # of blocks |
lda b_dev,r1 ; device number |
cpx #READING |
bne rwb2 |
ldx #11 ; read blocks opcode |
bra rwb1 |
rwb2: |
ldx #12 ; write blocks opcode |
rwb1: |
jsr DeviceOp |
pla |
ldy #CLEAN |
sty b_dirty,r1 |
pop r5 |
pop r4 |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; invalidate_dev |
; Cycle through all the block buffers and mark the buffers for the |
; matching device as free. |
; |
; Parameters: |
; r1 = device number |
;------------------------------------------------------------------------------ |
; |
invalidate_dev: |
phx |
phy |
push r4 |
ldy #NR_BUFS |
ldx #data_bufs |
id2: |
ld r4,b_dev,x |
cmp r4,r1 |
bne id1 |
ld r4,#NO_DEV |
st r4,b_dev,x |
id1: |
add r2,r2,#BUF_SIZE |
dey |
bne id2 |
|
; invalidate the superblock |
; ldy #32 |
; ldx #super_bufs |
id3: |
; ld r4,s_dev,x |
; cmp r4,r1 |
; bne id4 |
; ld r4,#NO_DEV |
; st r4,s_dev,x |
id4: |
; add r2,r2,#SUPERBUF_SIZE |
; dey |
; bne id3 |
|
pop r4 |
ply |
plx |
rts |
|
;============================================================================== |
; SUPERBLOCK code |
;============================================================================== |
|
;------------------------------------------------------------------------------ |
; get_super: |
; Get the super block. |
; There is a super block for each device. Superblocks have their own buffer |
; cache. |
; |
; Parameters: |
; r1 = device number |
; Returns: |
; r1 = pointer to superblock buffer |
;------------------------------------------------------------------------------ |
; |
get_super: |
phx |
phy |
push r4 |
; first search the superbuf array to see if the block is already |
; memory resident |
ldy #0 |
ldx #super_bufs |
gs2: |
ld r4,s_dev,x |
cmp r1,r4 ; device number match ? |
beq gs1 ; yes, found superblock buffer for device |
cmp r4,#NO_DEV |
bne gs4 |
txy ; record empty buffer |
gs4: |
add r2,r2,#SUPERBUF_SIZE |
cpx #super_bufs_end |
blo gs2 |
cpy #0 |
beq gs5 |
tyx |
sta s_dev,x |
bra gs3 |
gs5: |
; Here we couldn't find the device superblock cached and there wasn't a slot free. |
; So dump one from memory and load cache |
inc superbuf_dump ; "randomizer" for dump select |
ldx superbuf_dump |
and r2,r2,#31 ; 32 buffers |
mul r2,r2,#SUPERBUF_SIZE |
add r2,r2,#super_bufs |
; if the superblock is dirty, then write it out |
ldy s_dirty,x |
cpy #DIRTY |
bne gs3 |
jsr write_super |
gs3: |
sta s_dev,x |
jsr read_super |
gs1: |
txa |
pop r4 |
ply |
plx |
rts |
|
;------------------------------------------------------------------------------ |
; read_super: |
; Read the superblock from disk. Only a single sector is read. |
; |
; Parameters: |
; r1 = pointer to superblock buffer |
;------------------------------------------------------------------------------ |
; |
read_super: |
pha |
phx |
phy |
ldy s_dev,r1 ; save device number in .Y |
pha |
jsr get_filesystem_offset |
tax |
pla |
pha |
asl ; convert pointer to byte pointer |
asl |
jsr SDReadSector |
plx |
lda #CLEAN ; mark superblock clean |
sta s_dirty,x |
sty s_dev,x ; restore device number |
ply |
plx |
pla |
rts |
|
;------------------------------------------------------------------------------ |
; Parameters: |
; r1 = pointer to superblock buffer |
;------------------------------------------------------------------------------ |
write_super: |
pha |
phx |
phy |
push r4 |
ld r4,r1 |
ldy s_dev,r1 ; save device number in .Y |
jsr get_datetime |
stx s_wtime,r4 |
sta s_wtime+1,r4 |
pop r4 |
pha |
jsr get_filesystem_offset |
tax |
pla |
pha |
asl ; convert pointer to byte pointer |
asl |
jsr SDWriteSector |
plx |
lda #CLEAN |
sta s_dirty,x |
sty s_dev,x ; restore device number |
ply |
plx |
pla |
rts |
|
;============================================================================== |
; Utility functions |
;============================================================================== |
|
;------------------------------------------------------------------------------ |
; get_datetime: |
; Get the date and time. |
; Returns: |
; r1 = date |
; r2 = time |
;------------------------------------------------------------------------------ |
get_datetime: |
php |
sei |
stz DATETIME_SNAPSHOT ; take a snapshot of the running date/time |
lda DATETIME_DATE |
ldx DATETIME_TIME |
plp |
rts |
|
;------------------------------------------------------------------------------ |
; panic |
; Display a filesystem panic message and abort. |
; |
; Parameters: |
; r1 = numeric constant |
; inline string |
;------------------------------------------------------------------------------ |
; |
panic: |
pha |
lda panicking |
beq pan1 |
pla |
rts |
pan1: |
ina |
sta panicking ; panicking = TRUE; |
jsr dos_msg |
db "File system panic: ", 0 |
ply |
plx ; pull return address from stack |
pan2: |
lb r1,0,x |
beq pan3 |
jsr DisplayChar |
inx |
bra pan2 |
pan3: |
inx |
phx |
tya |
cmp #NO_NUM |
beq pan4 |
ldx #5 |
jsr PRTNUM |
pan4: |
jsr CRLF |
jsr do_sync |
jsr sys_abort |
; |
pan5: ; we should not get back to here after the sys_abort() |
bra pan5 |
|
;------------------------------------------------------------------------------ |
; Display a message on the screen |
; Parameters: |
; inline string |
;------------------------------------------------------------------------------ |
; |
dos_msg: |
plx ; get return address |
dm2: |
lb r1,0,x |
beq dm1 |
jsr DisplayChar |
inx |
bra dm2 |
dm1: |
inx |
phx |
rts |
|
;============================================================================== |
;============================================================================== |
;------------------------------------------------------------------------------ |
; File system CLEAN task |
;------------------------------------------------------------------------------ |
fs_clean: |
fsc4: |
lda #100 ; sleep for 1s |
jsr Sleep |
fsc3: |
lda fs_active ; is the file system active ? |
cmp #'A' |
bne fsc4 |
ldx #data_bufs |
fsc2: |
lda b_dev,x ; is the buffer in use ? |
cmp #NO_DEV |
beq fsc1 ; if not, goto next buffer |
sei |
lda b_dirty,x ; is the buffer dirty ? |
cmp #CLEAN |
beq fsc1 ; if not, goto next buffer |
; Found a dirty buffer |
phx |
txa |
ldx #WRITING ; write the dirty buffer out to disk |
jsr rw_block |
plx |
lda #CLEAN ; mark the buffer as clean |
sta b_dirty,x |
fsc1: ; iterate to the next buffer |
cli |
add r2,r2,#BUF_SIZE |
cpx #data_bufs_end |
bltu fsc2 |
bra fsc3 |
|
|
;============================================================================== |
; DOS commands |
;============================================================================== |
|
;------------------------------------------------------------------------------ |
; MKFS - make file system |
;------------------------------------------------------------------------------ |
; |
;numb_block_group_sectors: |
; nbg = ((disk size in bytes / |
; (blocks per block group * block size)) * block group descriptor size ) / block size + 1 |
|
jsr SDInit |
lda #1024 |
sta block_size |
jsr SDReadPart |
jsr get_super |
tax |
; blocks_count = disk size * 512 / block size |
jsr get_log_block_size |
tax |
inx |
lda disk_size ; disk size in sectors |
lsr r1,r1,r2 ; r1 = disk size in blocks |
sta s_block_count,x |
sta s_free_blocks_count,x |
; # files = block count * block size / 2048 (average file size) |
lda disk_size |
lsr |
lsr |
sta s_inodes_count,x |
sta s_free_inodes_count,x |
stz s_log_block_size,x ; 0=1kB |
lda #8192 |
sta s_blocks_per_group,x |
sta s_inodes_per_group,x |
lda #$EF54EF54 |
sta s_magic,x |
stz s_errors,x |
jsr get_filesystem_offset |
jsr SDWriteSector ; put_block |
|
lda disk_size |
div r1,r1,#16384 ; 8388608/512 |
div r1,r1,#32 ; divide by size of block group descriptot |
add r1,#1 ; round up |
add r4,r1,#2 ; boot block + superblock |
; acc = number of blocks for descriptor table |
tay |
st r4,bg_block_bitmap, |
rts |
|
|
/rtf65002/trunk/software/asm/pi_calc816.asm
0,0 → 1,206
; ============================================================================ |
; __ |
; \\__/ o\ (C) 2014 Robert Finch, Stratford |
; \ __ / All rights reserved. |
; \/_// robfinch<remove>@finitron.ca |
; || |
; |
; |
; This source file is free software: you can redistribute it and/or modify |
; it under the terms of the GNU Lesser General Public License as published |
; by the Free Software Foundation, either version 3 of the License, or |
; (at your option) any later version. |
; |
; This source file is distributed in the hope that it will be useful, |
; but WITHOUT ANY WARRANTY; without even the implied warranty of |
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
; GNU General Public License for more details. |
; |
; You should have received a copy of the GNU General Public License |
; along with this program. If not, see <http://www.gnu.org/licenses/>. |
; |
; This code calculates PI to 360 digits. It runs on a 65C816 processor. |
; The code was found at www.6502.org |
; ============================================================================ |
; |
P EQU 2 |
Q EQU 1193*2 + 2 |
R EQU Q + 2 |
SSS EQU R + 2 |
|
jsr INITSUB |
ldx #359 |
ldy #1193 |
L1S: |
phy |
pha |
phx |
stz Q |
; txa |
; ldx #5 |
; wdm |
; xce |
; cpu RTF65002 |
; jsr PRTNUM |
; clc |
; xce |
; cpu W65C816S |
; rep #$30 |
; plx |
; phx |
tya |
tax |
L2S: |
txa |
|
; phx |
; ldx #5 |
; wdm |
; xce |
; cpu RTF65002 |
; jsr PRTNUM |
; clc |
; xce |
; cpu W65C816S |
; rep #$30 |
; plx |
; txa |
|
jsr MULSUB |
sta SSS |
lda #10 |
sta Q |
jsr ADJ1SUB |
lda P-1,x |
jsr UNADJ1SUB |
jsr MULSUB |
clc |
adc SSS |
sta Q |
txa |
asl |
dea |
jsr DIVSUB |
jsr ADJ1SUB |
sta P-1,x |
jsr UNADJ1SUB |
dex |
bne L2S |
lda #10 |
jsr DIVSUB |
sta P |
plx |
pla |
ldy Q |
cpy #10 |
bcc L3S |
ldy #0 |
ina |
L3S: |
cpx #358 |
bcc L4S |
bne L5S |
jsr OUTPUTSUB |
lda #46 |
L4S: |
jsr OUTPUTSUB |
L5S: |
tya |
eor #48 |
ply |
cpx #358 |
bcs L6S |
dey |
dey |
dey |
L6S: |
dex |
beq L7S |
jmp L1S |
L7S: |
jsr OUTPUTSUB |
wdm |
xce |
cpu RTF65002 |
rts |
|
cpu W65C816S |
INITSUB: |
lda #2 |
ldx #1192 |
IS1: |
jsr ADJSUB |
sta P,x |
jsr UNADJSUB |
dex |
bpl IS1 |
rts |
|
MULSUB: |
sta R |
ldy #16 |
M1S: asl |
asl Q |
bcc M2S |
clc |
adc R |
M2S: dey |
bne M1S |
rts |
|
DIVSUB: |
sta R |
ldy #16 |
lda #0 |
asl Q |
D1S: rol |
cmp R |
bcc D2S |
sbc R |
D2S: rol Q |
dey |
bne D1S |
rts |
|
ADJSUB: |
pha |
txa |
asl |
tax |
pla |
rts |
UNADJSUB: |
pha |
txa |
lsr |
tax |
pla |
rts |
ADJ1SUB: |
pha |
txa |
asl |
tax |
pla |
dex |
rts |
UNADJ1SUB: |
pha |
txa |
lsr |
tax |
pla |
inx |
rts |
|
OUTPUTSUB: |
; switching back to '816 mode will force the registers to 8 bit, so we |
; have to save off their values, then restore them after the switch |
wdm ; switch to 32 bit mode |
xce |
cpu RTF65002 |
jsr DisplayChar |
clc ; switch back to 816 mode |
xce |
cpu W65C816S |
rts |