Apple-1-HW
/
retro1
mirror of https://github.com/jonthomasson/retro1.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

initial software checkin

This commit is contained in:
jth0mass0n 2017-04-17 10:09:33 -07:00
parent 98c9cf8e8b
commit b290497d95
717 changed files with 284406 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
software/retro1-tests/EhBasic/.gitignore vendored Normal file
View File

@ -0,0 +1,4 @@
*.rom
*.lst
*.map
*.o

12
software/retro1-tests/EhBasic/Makefile Normal file
View File

@ -0,0 +1,12 @@
SOURCES = min_mon.asm
%.o: %.asm
ca65 -o $@ -l $(@:.o=.lst) $<
all: firmware
firmware: $(SOURCES:.asm=.o)
ld65 -C symon.config -Ln ehbasic.lbl -m ehbasic.map -o $@ $^
clean:
rm -f *.o *.rom *.map *.lst

85
software/retro1-tests/EhBasic/README.txt Normal file
View File

@ -0,0 +1,85 @@
This directoy contains a very slightly modified version of EhBASIC 2.22
to support the Symon simulator.
Usage
-----
The pre-assemled ROM image 'ehbasic.rom' in the "samples" directory is all you
need unless you want to rebuild this source code.
Just copy the image 'ehbasic.rom' to the directory where you run Symon, and
rename the file to 'rom.bin'. It will be loaded at memory location $D000 when
the simulator starts up. Click "Run" and you'll be presented with BASIC.
At the first prompt, type 'C' for a Cold Start
When prompted for free memory, type: $C000
Note that EhBASIC only accepts upper case input, so you'll need to use caps
lock (the cruise control for cool) to really make the most of it.
Building
--------
To build it, you'll need the CC65 tool chain from http://www.cc65.org/
and a suitable version of 'make'. Just typing:
% make
in this directory should re-build everything. You'll get a listing,
some object files, and the ROM image itself.
Changes from the EhBASIC 2.22
-----------------------------
- Minor syntax changes to allow assembly with the cc65 tool chain.
- Memory map modified for Symon.
- At reset, configure the 6551 ACIA for 8-N-1, 2400 baud.
- Monitor routines 'ACIAin' and 'ACIAout' modified for the 6551 ACIA.
Specifically, reading and writing will check the 6551 status register for
the status of rx and tx registers before receive or transmit.
EhBASIC is copyright Lee Davison <leeedavison@googlemail.com>
My changes are so slight that I hesitate to even say this, but for "CYA"
reasons:
Changes are copyright Seth Morabito <web@loomcom.com> and are distributed under
the same license as EhBASIC. I claim no commercial interest whatsoever. Any
commercial use must be negotiated directly with Lee Davison.
Original EhBASIC 2.22 README
----------------------------
Enhanced BASIC is a BASIC interpreter for the 6502 family microprocessors. It
is constructed to be quick and powerful and easily ported between 6502 systems.
It requires few resources to run and includes instructions to facilitate easy
low level handling of hardware devices. It also retains most of the powerful
high level instructions from similar BASICs.
EhBASIC is free but not copyright free. For non commercial use there is only one
restriction, any derivative work should include, in any binary image distributed,
the string "Derived from EhBASIC" and in any distribution that includes human
readable files a file that includes the above string in a human readable form
e.g. not as a comment in an HTML file.
For commercial use please contact me, Lee Davison, at leeedavison@googlemail.com
for conditions.
For more information on EhBASIC, other versions of EhBASIC and other projects
please visit my site at ..
http://mycorner.no-ip.org/index.html
P.S. c't magazin, henceforth refered to as "those thieving german bastards", are
prohibited from using this or any version of EhBASIC for any of their projects
or products. The excuse "we don't charge people for it" doesn't wash, it adds
value to your product so you owe me.

8700
software/retro1-tests/EhBasic/basic.asm Normal file
View File

File diff suppressed because it is too large Load Diff

12
software/retro1-tests/EhBasic/compiled2/Makefile Normal file
View File

@ -0,0 +1,12 @@
SOURCES = min_mon.asm
%.o: %.asm
ca65 -o $@ -l $(@:.o=.lst) $<
all: firmware
firmware: $(SOURCES:.asm=.o)
ld65 -C symon.config -Ln ehbasic.lbl -m ehbasic.map -o $@ $^
clean:
rm -f *.o *.rom *.map *.lst

85
software/retro1-tests/EhBasic/compiled2/README.txt Normal file
View File

@ -0,0 +1,85 @@
This directoy contains a very slightly modified version of EhBASIC 2.22
to support the Symon simulator.
Usage
-----
The pre-assemled ROM image 'ehbasic.rom' in the "samples" directory is all you
need unless you want to rebuild this source code.
Just copy the image 'ehbasic.rom' to the directory where you run Symon, and
rename the file to 'rom.bin'. It will be loaded at memory location $D000 when
the simulator starts up. Click "Run" and you'll be presented with BASIC.
At the first prompt, type 'C' for a Cold Start
When prompted for free memory, type: $C000
Note that EhBASIC only accepts upper case input, so you'll need to use caps
lock (the cruise control for cool) to really make the most of it.
Building
--------
To build it, you'll need the CC65 tool chain from http://www.cc65.org/
and a suitable version of 'make'. Just typing:
% make
in this directory should re-build everything. You'll get a listing,
some object files, and the ROM image itself.
Changes from the EhBASIC 2.22
-----------------------------
- Minor syntax changes to allow assembly with the cc65 tool chain.
- Memory map modified for Symon.
- At reset, configure the 6551 ACIA for 8-N-1, 2400 baud.
- Monitor routines 'ACIAin' and 'ACIAout' modified for the 6551 ACIA.
Specifically, reading and writing will check the 6551 status register for
the status of rx and tx registers before receive or transmit.
EhBASIC is copyright Lee Davison <leeedavison@googlemail.com>
My changes are so slight that I hesitate to even say this, but for "CYA"
reasons:
Changes are copyright Seth Morabito <web@loomcom.com> and are distributed under
the same license as EhBASIC. I claim no commercial interest whatsoever. Any
commercial use must be negotiated directly with Lee Davison.
Original EhBASIC 2.22 README
----------------------------
Enhanced BASIC is a BASIC interpreter for the 6502 family microprocessors. It
is constructed to be quick and powerful and easily ported between 6502 systems.
It requires few resources to run and includes instructions to facilitate easy
low level handling of hardware devices. It also retains most of the powerful
high level instructions from similar BASICs.
EhBASIC is free but not copyright free. For non commercial use there is only one
restriction, any derivative work should include, in any binary image distributed,
the string "Derived from EhBASIC" and in any distribution that includes human
readable files a file that includes the above string in a human readable form
e.g. not as a comment in an HTML file.
For commercial use please contact me, Lee Davison, at leeedavison@googlemail.com
for conditions.
For more information on EhBASIC, other versions of EhBASIC and other projects
please visit my site at ..
http://mycorner.no-ip.org/index.html
P.S. c't magazin, henceforth refered to as "those thieving german bastards", are
prohibited from using this or any version of EhBASIC for any of their projects
or products. The excuse "we don't charge people for it" doesn't wash, it adds
value to your product so you owe me.

8691
software/retro1-tests/EhBasic/compiled2/basic.asm Normal file
View File

File diff suppressed because it is too large Load Diff

0
software/retro1-tests/EhBasic/compiled2/dhbasic.lbl Normal file
View File

0
software/retro1-tests/EhBasic/compiled2/ehbasic.lbl Normal file
View File

BIN
software/retro1-tests/EhBasic/compiled2/firmware Normal file
View File

Binary file not shown.

166
software/retro1-tests/EhBasic/compiled2/min_mon.asm Normal file
View File

@ -0,0 +1,166 @@
; minimal monitor for EhBASIC and 6502 simulator V1.05
; To run EhBASIC on the simulator load and assemble [F7] this file, start the simulator
; running [F6] then start the code with the RESET [CTRL][SHIFT]R. Just selecting RUN
; will do nothing, you'll still have to do a reset to run the code.
.feature labels_without_colons
.include "basic.asm"
; put the IRQ and MNI code in RAM so that it can be changed
IRQ_vec = VEC_SV+2 ; IRQ code vector
NMI_vec = IRQ_vec+$0A ; NMI code vector
; setup for the 6502 simulator environment
IO_AREA = $A000
ACIAdata = IO_AREA ; simulated ACIA r/w port
ACIAstatus = IO_AREA+1
ACIAcommand = IO_AREA+2
ACIAcontrol = IO_AREA+3
; now the code. all this does is set up the vectors and interrupt code
; and wait for the user to select [C]old or [W]arm start. nothing else
; fits in less than 128 bytes
.segment "MONITOR"
;.org $FF00 ; pretend this is in a 1/8K ROM
; reset vector points here
RES_vec
CLD ; clear decimal mode
LDX #$FF ; empty stack
TXS ; set the stack
; Initialize the ACIA
ACIA_init
LDA #$00
STA ACIAstatus ; Soft reset
LDA #$0B
STA ACIAcommand ; Parity disabled, IRQ disabled
LDA #$1F
STA ACIAcontrol ; Set output for 8-N-1 19200
; set up vectors and interrupt code, copy them to page 2
LDY #END_CODE-LAB_vec ; set index/count
LAB_stlp
LDA LAB_vec-1,Y ; get byte from interrupt code
STA VEC_IN-1,Y ; save to RAM
DEY ; decrement index/count
BNE LAB_stlp ; loop if more to do
; now do the signon message, Y = $00 here
LAB_signon
LDA LAB_mess,Y ; get byte from sign on message
BEQ LAB_nokey ; exit loop if done
JSR V_OUTP ; output character
INY ; increment index
BNE LAB_signon ; loop, branch always
LAB_nokey
JSR V_INPT ; call scan input device
BCC LAB_nokey ; loop if no key
AND #$DF ; mask xx0x xxxx, ensure upper case
CMP #'W' ; compare with [W]arm start
BEQ LAB_dowarm ; branch if [W]arm start
CMP #'C' ; compare with [C]old start
BNE RES_vec ; loop if not [C]old start
JMP LAB_COLD ; do EhBASIC cold start
LAB_dowarm
JMP LAB_WARM ; do EhBASIC warm start
; byte out to ACIA
ACIAout
PHA ; save accumulator
@loop
LDA ACIAstatus ; Read 6551 status
AND #$10 ; Is tx buffer full?
BEQ @loop ; if not, loop back
PLA ; Otherwise, restore accumulator
STA ACIAdata ; write byte to 6551
RTS
;
; byte in from ACIA. This subroutine will also force
; all lowercase letters to be uppercase.
;
ACIAin
LDA ACIAstatus ; Read 6551 status
AND #$08 ;
BEQ LAB_nobyw ; If rx buffer empty, no byte
LDA ACIAdata ; Read byte from 6551
CMP #'a' ; Is it < 'a'?
BCC @done ; Yes, we're done
CMP #'{' ; Is it >= '{'?
BCS @done ; Yes, we're done
AND #$5f ; Otherwise, mask to uppercase
@done
SEC ; Flag byte received
RTS
LAB_nobyw
CLC ; flag no byte received
no_load ; empty load vector for EhBASIC
no_save ; empty save vector for EhBASIC
RTS
; vector tables
LAB_vec
.word ACIAin ; byte in from simulated ACIA
.word ACIAout ; byte out to simulated ACIA
.word no_load ; null load vector for EhBASIC
.word no_save ; null save vector for EhBASIC
; EhBASIC IRQ support
IRQ_CODE
PHA ; save A
LDA IrqBase ; get the IRQ flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA IrqBase ; OR the original back in
STA IrqBase ; save the new IRQ flag byte
PLA ; restore A
RTI
; EhBASIC NMI support
NMI_CODE
PHA ; save A
LDA NmiBase ; get the NMI flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA NmiBase ; OR the original back in
STA NmiBase ; save the new NMI flag byte
PLA ; restore A
RTI
END_CODE
; sign on string
LAB_mess
.byte $0D,$0A,"Symon (c) 2008-2014, Seth Morabito"
.byte $0D,$0A,"Enhanced 6502 BASIC 2.22 (c) Lee Davison"
.byte $0D,$0A,"[C]old/[W]arm ?",$00
; system vectors
.segment "VECTORS"
;.org $FFFA
.word NMI_vec ; NMI vector
.word RES_vec ; RESET vector
.word IRQ_vec ; IRQ vector

14
software/retro1-tests/EhBasic/compiled2/symon.config Normal file
View File

@ -0,0 +1,14 @@
MEMORY {
RAM1: start = $0000, size = $8000;
ROM1: start = $8000, size = $8000, fill = no;
}
SEGMENTS {
CODE: load = ROM1, type = ro, offset=$4000;
DATA: load = ROM1, type = ro;
MONITOR: load = ROM1, type = ro, offset=$7F00;
VECTORS: load = ROM1, type = ro, offset=$7FFA;
}

0
software/retro1-tests/EhBasic/ehbasic.lbl Normal file
View File

4
software/retro1-tests/EhBasic/ehbasic_compiled/.gitignore vendored Normal file
View File

@ -0,0 +1,4 @@
*.rom
*.lst
*.map
*.o

13
software/retro1-tests/EhBasic/ehbasic_compiled/Makefile Normal file
View File

@ -0,0 +1,13 @@
CA=ca65
LD=ld65
all: ehbasic
ehbasic: ehbasic.o
$(LD) -C symon.config -Ln ehbasic.lbl -vm -m ehbasic.map -o ehbasic.rom ehbasic.o
ehbasic.o:
$(CA) -l ehbasic.lst -o ehbasic.o min_mon.asm
clean:
rm -f *.o *.rom *.map *.lst

85
software/retro1-tests/EhBasic/ehbasic_compiled/README.txt Normal file
View File

@ -0,0 +1,85 @@
This directoy contains a very slightly modified version of EhBASIC 2.22
to support the Symon simulator.
Usage
-----
The pre-assemled ROM image 'ehbasic.rom' in the "samples" directory is all you
need unless you want to rebuild this source code.
Just copy the image 'ehbasic.rom' to the directory where you run Symon, and
rename the file to 'rom.bin'. It will be loaded at memory location $D000 when
the simulator starts up. Click "Run" and you'll be presented with BASIC.
At the first prompt, type 'C' for a Cold Start
When prompted for free memory, type: $C000
Note that EhBASIC only accepts upper case input, so you'll need to use caps
lock (the cruise control for cool) to really make the most of it.
Building
--------
To build it, you'll need the CC65 tool chain from http://www.cc65.org/
and a suitable version of 'make'. Just typing:
% make
in this directory should re-build everything. You'll get a listing,
some object files, and the ROM image itself.
Changes from the EhBASIC 2.22
-----------------------------
- Minor syntax changes to allow assembly with the cc65 tool chain.
- Memory map modified for Symon.
- At reset, configure the 6551 ACIA for 8-N-1, 2400 baud.
- Monitor routines 'ACIAin' and 'ACIAout' modified for the 6551 ACIA.
Specifically, reading and writing will check the 6551 status register for
the status of rx and tx registers before receive or transmit.
EhBASIC is copyright Lee Davison <leeedavison@googlemail.com>
My changes are so slight that I hesitate to even say this, but for "CYA"
reasons:
Changes are copyright Seth Morabito <web@loomcom.com> and are distributed under
the same license as EhBASIC. I claim no commercial interest whatsoever. Any
commercial use must be negotiated directly with Lee Davison.
Original EhBASIC 2.22 README
----------------------------
Enhanced BASIC is a BASIC interpreter for the 6502 family microprocessors. It
is constructed to be quick and powerful and easily ported between 6502 systems.
It requires few resources to run and includes instructions to facilitate easy
low level handling of hardware devices. It also retains most of the powerful
high level instructions from similar BASICs.
EhBASIC is free but not copyright free. For non commercial use there is only one
restriction, any derivative work should include, in any binary image distributed,
the string "Derived from EhBASIC" and in any distribution that includes human
readable files a file that includes the above string in a human readable form
e.g. not as a comment in an HTML file.
For commercial use please contact me, Lee Davison, at leeedavison@googlemail.com
for conditions.
For more information on EhBASIC, other versions of EhBASIC and other projects
please visit my site at ..
http://mycorner.no-ip.org/index.html
P.S. c't magazin, henceforth refered to as "those thieving german bastards", are
prohibited from using this or any version of EhBASIC for any of their projects
or products. The excuse "we don't charge people for it" doesn't wash, it adds
value to your product so you owe me.

8691
software/retro1-tests/EhBasic/ehbasic_compiled/basic.asm Normal file
View File

File diff suppressed because it is too large Load Diff

0
software/retro1-tests/EhBasic/ehbasic_compiled/dhbasic.lbl Normal file
View File

0
software/retro1-tests/EhBasic/ehbasic_compiled/ehbasic.lbl Normal file
View File

166
software/retro1-tests/EhBasic/ehbasic_compiled/min_mon.asm Normal file
View File

@ -0,0 +1,166 @@
; minimal monitor for EhBASIC and 6502 simulator V1.05
; To run EhBASIC on the simulator load and assemble [F7] this file, start the simulator
; running [F6] then start the code with the RESET [CTRL][SHIFT]R. Just selecting RUN
; will do nothing, you'll still have to do a reset to run the code.
.feature labels_without_colons
.include "basic.asm"
; put the IRQ and MNI code in RAM so that it can be changed
IRQ_vec = VEC_SV+2 ; IRQ code vector
NMI_vec = IRQ_vec+$0A ; NMI code vector
; setup for the 6502 simulator environment
IO_AREA = $8800
ACIAdata = IO_AREA ; simulated ACIA r/w port
ACIAstatus = IO_AREA+1
ACIAcommand = IO_AREA+2
ACIAcontrol = IO_AREA+3
; now the code. all this does is set up the vectors and interrupt code
; and wait for the user to select [C]old or [W]arm start. nothing else
; fits in less than 128 bytes
.segment "MONITOR"
.org $FF00 ; pretend this is in a 1/8K ROM
; reset vector points here
RES_vec
CLD ; clear decimal mode
LDX #$FF ; empty stack
TXS ; set the stack
; Initialize the ACIA
ACIA_init
LDA #$00
STA ACIAstatus ; Soft reset
LDA #$0B
STA ACIAcommand ; Parity disabled, IRQ disabled
LDA #$1E
STA ACIAcontrol ; Set output for 8-N-1 9600
; set up vectors and interrupt code, copy them to page 2
LDY #END_CODE-LAB_vec ; set index/count
LAB_stlp
LDA LAB_vec-1,Y ; get byte from interrupt code
STA VEC_IN-1,Y ; save to RAM
DEY ; decrement index/count
BNE LAB_stlp ; loop if more to do
; now do the signon message, Y = $00 here
LAB_signon
LDA LAB_mess,Y ; get byte from sign on message
BEQ LAB_nokey ; exit loop if done
JSR V_OUTP ; output character
INY ; increment index
BNE LAB_signon ; loop, branch always
LAB_nokey
JSR V_INPT ; call scan input device
BCC LAB_nokey ; loop if no key
AND #$DF ; mask xx0x xxxx, ensure upper case
CMP #'W' ; compare with [W]arm start
BEQ LAB_dowarm ; branch if [W]arm start
CMP #'C' ; compare with [C]old start
BNE RES_vec ; loop if not [C]old start
JMP LAB_COLD ; do EhBASIC cold start
LAB_dowarm
JMP LAB_WARM ; do EhBASIC warm start
; byte out to ACIA
ACIAout
PHA ; save accumulator
@loop
LDA ACIAstatus ; Read 6551 status
AND #$10 ; Is tx buffer full?
BEQ @loop ; if not, loop back
PLA ; Otherwise, restore accumulator
STA ACIAdata ; write byte to 6551
RTS
;
; byte in from ACIA. This subroutine will also force
; all lowercase letters to be uppercase.
;
ACIAin
LDA ACIAstatus ; Read 6551 status
AND #$08 ;
BEQ LAB_nobyw ; If rx buffer empty, no byte
LDA ACIAdata ; Read byte from 6551
CMP #'a' ; Is it < 'a'?
BCC @done ; Yes, we're done
CMP #'{' ; Is it >= '{'?
BCS @done ; Yes, we're done
AND #$5f ; Otherwise, mask to uppercase
@done
SEC ; Flag byte received
RTS
LAB_nobyw
CLC ; flag no byte received
no_load ; empty load vector for EhBASIC
no_save ; empty save vector for EhBASIC
RTS
; vector tables
LAB_vec
.word ACIAin ; byte in from simulated ACIA
.word ACIAout ; byte out to simulated ACIA
.word no_load ; null load vector for EhBASIC
.word no_save ; null save vector for EhBASIC
; EhBASIC IRQ support
IRQ_CODE
PHA ; save A
LDA IrqBase ; get the IRQ flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA IrqBase ; OR the original back in
STA IrqBase ; save the new IRQ flag byte
PLA ; restore A
RTI
; EhBASIC NMI support
NMI_CODE
PHA ; save A
LDA NmiBase ; get the NMI flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA NmiBase ; OR the original back in
STA NmiBase ; save the new NMI flag byte
PLA ; restore A
RTI
END_CODE
; sign on string
LAB_mess
.byte $0D,$0A,"Symon (c) 2008-2014, Seth Morabito"
.byte $0D,$0A,"Enhanced 6502 BASIC 2.22 (c) Lee Davison"
.byte $0D,$0A,"[C]old/[W]arm ?",$00
; system vectors
.segment "VECTORS"
.org $FFFA
.word NMI_vec ; NMI vector
.word RES_vec ; RESET vector
.word IRQ_vec ; IRQ vector

16
software/retro1-tests/EhBasic/ehbasic_compiled/symon.config Normal file
View File

@ -0,0 +1,16 @@
MEMORY {
RAM1: start = $0000, size = $8000;
ROM1: start = $C000, size = $3F00, fill = yes;
MONITOR: start = $FF00, size = $FA, fill = yes;
ROMV: start = $FFFA, size = $6, file = %O, fill = yes;
}
SEGMENTS {
CODE: load = ROM1, type = ro;
DATA: load = ROM1, type = ro;
MONITOR: load = MONITOR, type = ro;
VECTORS: load = ROMV, type = ro;
}

BIN
software/retro1-tests/EhBasic/firmware Normal file
View File

Binary file not shown.

172
software/retro1-tests/EhBasic/min_mon.asm Normal file
View File

@ -0,0 +1,172 @@
; minimal monitor for EhBASIC and 6502 simulator V1.05
; To run EhBASIC on the simulator load and assemble [F7] this file, start the simulator
; running [F6] then start the code with the RESET [CTRL][SHIFT]R. Just selecting RUN
; will do nothing, you'll still have to do a reset to run the code.
.setcpu "65C02"
.feature labels_without_colons
.include "basic.asm"
; put the IRQ and MNI code in RAM so that it can be changed
IRQ_vec = VEC_SV+2 ; IRQ code vector
NMI_vec = IRQ_vec+$0A ; NMI code vector
; setup for the 6502 simulator environment
IO_AREA = $A000
ACIAdata = IO_AREA ; simulated ACIA r/w port
ACIAstatus = IO_AREA+1
ACIAcommand = IO_AREA+2
ACIAcontrol = IO_AREA+3
VIA1_DDRA = $8023 ;for debugging
VIA1_ORA = $8021
; now the code. all this does is set up the vectors and interrupt code
; and wait for the user to select [C]old or [W]arm start. nothing else
; fits in less than 128 bytes
;*= $FF80 ; pretend this is in a 1/8K ROM
;.org $FF00
.segment "MONITOR"
; reset vector points here
RES_vec
CLD ; clear decimal mode
LDX #$FF ; empty stack
TXS ; set the stack
lda #$ff ;init via
sta VIA1_DDRA
; Initialize the ACIA
ACIA_init
LDA #$00
STA ACIAstatus ; Soft reset
LDA #$0B
STA ACIAcommand ; Parity disabled, IRQ disabled
LDA #$1E
STA ACIAcontrol ; Set output for 8-N-1 19200
; set up vectors and interrupt code, copy them to page 2
LDY #END_CODE-LAB_vec ; set index/count
LAB_stlp
LDA LAB_vec-1,Y ; get byte from interrupt code
STA VEC_IN-1,Y ; save to RAM
DEY ; decrement index/count
BNE LAB_stlp ; loop if more to do
; now do the signon message, Y = $00 here
LAB_signon
LDA LAB_mess,Y ; get byte from sign on message
BEQ LAB_nokey ; exit loop if done
JSR V_OUTP ; output character
INY ; increment index
BNE LAB_signon ; loop, branch always
LAB_nokey
JSR V_INPT ; call scan input device
BCC LAB_nokey ; loop if no key
AND #$DF ; mask xx0x xxxx, ensure upper case
CMP #'W' ; compare with [W]arm start
BEQ LAB_dowarm ; branch if [W]arm start
CMP #'C' ; compare with [C]old start
BNE RES_vec ; loop if not [C]old start
JMP LAB_COLD ; do EhBASIC cold start
LAB_dowarm
JMP LAB_WARM ; do EhBASIC warm start
; byte out to simulated ACIA
ACIAout
PHA ; save accumulator
AND #$7F ;change to standard ascii
ACIAloop
LDA ACIAstatus ; Read 6551 status
AND #$10 ; Is tx buffer full?
BEQ ACIAloop ; if not, loop back
PLA ; Otherwise, restore accumulator
STA ACIAdata ; write byte to 6551
RTS
; byte in from simulated ACIA
ACIAin
LDA ACIAstatus ; Read 6551 status
AND #$08 ;
BEQ LAB_nobyw ; If rx buffer empty, no byte
;ORA #$80 ;convert to ascii keyboard
LDA ACIAdata ; Read byte from 6551
SEC ; flag byte received
RTS
LAB_nobyw
CLC ; flag no byte received
no_load ; empty load vector for EhBASIC
no_save ; empty save vector for EhBASIC
RTS
; vector tables
LAB_vec
.word ACIAin ; byte in from simulated ACIA
.word ACIAout ; byte out to simulated ACIA
.word no_load ; null load vector for EhBASIC
.word no_save ; null save vector for EhBASIC
; EhBASIC IRQ support
IRQ_CODE
PHA ; save A
LDA IrqBase ; get the IRQ flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA IrqBase ; OR the original back in
STA IrqBase ; save the new IRQ flag byte
PLA ; restore A
RTI
; EhBASIC NMI support
NMI_CODE
PHA ; save A
LDA NmiBase ; get the NMI flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA NmiBase ; OR the original back in
STA NmiBase ; save the new NMI flag byte
PLA ; restore A
RTI
END_CODE
LAB_mess
.byte $0D,$0A,"6502 EhBASIC [C]old/[W]arm ?",$00
; sign on string
; system vectors
;*= $FFFA
;.org $FFFA
.segment "VECTORS"
.word NMI_vec ; NMI vector
.word RES_vec ; RESET vector
.word IRQ_vec ; IRQ vector

12
software/retro1-tests/EhBasic/old/Makefile Normal file
View File

@ -0,0 +1,12 @@
SOURCES = min_mon.asm
%.o: %.asm
ca65 -o $@ -l $(@:.o=.lst) $<
all: firmware
firmware: $(SOURCES:.asm=.o)
ld65 -Ln ehbasic.lbl -o $@ $^
clean:
rm -f firmware *.o *.lst

8692
software/retro1-tests/EhBasic/old/basic.asm Normal file
View File

File diff suppressed because it is too large Load Diff

12
software/retro1-tests/EhBasic/old/ehbasic.cfg Normal file
View File

@ -0,0 +1,12 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $8000, size = $8000, fill = no, file = %O;
IOHANDLER: start = $8000, size = $8000, fill = no, file = %O;
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
CODE: load = BASROM, type = ro, offset=$4000;
VECTORS: load = BASROM, type = ro, offset=$7FFA;
}

135
software/retro1-tests/EhBasic/old/min_mon.asm Normal file
View File

@ -0,0 +1,135 @@
; minimal monitor for EhBASIC and 6502 simulator V1.05
; To run EhBASIC on the simulator load and assemble [F7] this file, start the simulator
; running [F6] then start the code with the RESET [CTRL][SHIFT]R. Just selecting RUN
; will do nothing, you'll still have to do a reset to run the code.
.include "basic.asm"
; put the IRQ and MNI code in RAM so that it can be changed
IRQ_vec = VEC_SV+2 ; IRQ code vector
NMI_vec = IRQ_vec+$0A ; NMI code vector
; setup for the 6502 simulator environment
IO_AREA = $F000 ; set I/O area for this monitor
ACIAsimwr = IO_AREA+$01 ; simulated ACIA write port
ACIAsimrd = IO_AREA+$04 ; simulated ACIA read port
; now the code. all this does is set up the vectors and interrupt code
; and wait for the user to select [C]old or [W]arm start. nothing else
; fits in less than 128 bytes
;*= $FF80 ; pretend this is in a 1/8K ROM
.org $FF80
; reset vector points here
RES_vec:
CLD ; clear decimal mode
LDX #$FF ; empty stack
TXS ; set the stack
; set up vectors and interrupt code, copy them to page 2
LDY #END_CODE-LAB_vec ; set index/count
LAB_stlp:
LDA LAB_vec-1,Y ; get byte from interrupt code
STA VEC_IN-1,Y ; save to RAM
DEY ; decrement index/count
BNE LAB_stlp ; loop if more to do
; now do the signon message, Y = $00 here
LAB_signon:
LDA LAB_mess,Y ; get byte from sign on message
BEQ LAB_nokey ; exit loop if done
JSR V_OUTP ; output character
INY ; increment index
BNE LAB_signon ; loop, branch always
LAB_nokey:
JSR V_INPT ; call scan input device
BCC LAB_nokey ; loop if no key
AND #$DF ; mask xx0x xxxx, ensure upper case
CMP #'W' ; compare with [W]arm start
BEQ LAB_dowarm ; branch if [W]arm start
CMP #'C' ; compare with [C]old start
BNE RES_vec ; loop if not [C]old start
JMP LAB_COLD ; do EhBASIC cold start
LAB_dowarm:
JMP LAB_WARM ; do EhBASIC warm start
; byte out to simulated ACIA
ACIAout:
STA ACIAsimwr ; save byte to simulated ACIA
RTS
; byte in from simulated ACIA
ACIAin:
LDA ACIAsimrd ; get byte from simulated ACIA
BEQ LAB_nobyw ; branch if no byte waiting
SEC ; flag byte received
RTS
LAB_nobyw:
CLC ; flag no byte received
no_load: ; empty load vector for EhBASIC
no_save : ; empty save vector for EhBASIC
RTS
; vector tables
LAB_vec:
.word ACIAin ; byte in from simulated ACIA
.word ACIAout ; byte out to simulated ACIA
.word no_load ; null load vector for EhBASIC
.word no_save ; null save vector for EhBASIC
; EhBASIC IRQ support
IRQ_CODE:
PHA ; save A
LDA IrqBase ; get the IRQ flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA IrqBase ; OR the original back in
STA IrqBase ; save the new IRQ flag byte
PLA ; restore A
RTI
; EhBASIC NMI support
NMI_CODE:
PHA ; save A
LDA NmiBase ; get the NMI flag byte
LSR ; shift the set b7 to b6, and on down ...
ORA NmiBase ; OR the original back in
STA NmiBase ; save the new NMI flag byte
PLA ; restore A
RTI
END_CODE:
LAB_mess:
.byte $0D,$0A,"6502 EhBASIC [C]old/[W]arm ?",$00
; sign on string
; system vectors
;*= $FFFA
.org $FFFA
.word NMI_vec ; NMI vector
.word RES_vec ; RESET vector
.word IRQ_vec ; IRQ vector

12
software/retro1-tests/EhBasic/symon.config Normal file
View File

@ -0,0 +1,12 @@
MEMORY {
ROM1: start = $8000, size = $8000, fill = yes;
}
SEGMENTS {
CODE: load = ROM1, type = ro, offset=$4000;
MONITOR: load = ROM1, type = ro, offset=$7F00;
VECTORS: load = ROM1, type = ro, offset=$7FFA;
}

62
software/retro1-tests/OSI/Makefile Normal file
View File

@ -0,0 +1,62 @@
all: osirom.lod basicrom.lod cegmon.lod
patch: errormessage.patch garbagecollection.patch
patch -p3 <errormessage.patch
patch -p3 <garbagecollection.patch
unpatch: errormessage.patch garbagecollection.patch
patch -R -p3 <errormessage.patch
patch -R -p3 <garbagecollection.patch
$(RM) -f msbasic/*.orig
osirom.lod: osirom.bin
./bintolod -s F800 -l FFF0 osirom.bin >osirom.lod
basicrom.lod: basicrom.bin
./bintolod -s A000 -l A000 basicrom.bin >basicrom.lod
cegmon.lod: cegmon.bin
./bintolod -s F800 -l F800 cegmon.bin >cegmon.lod
osirom.bin: fill.o diskboot.o keyboard.o osi65v.o coldstart.o
ld65 -t none -vm -m osirom.map -o osirom.bin fill.o diskboot.o keyboard.o osi65v.o coldstart.o
fill.o: fill.s
ca65 -g -l fill.lst --feature labels_without_colons --feature pc_assignment fill.s
diskboot.o: diskboot.s
ca65 -g -l diskboot.lst --feature labels_without_colons --feature pc_assignment diskboot.s
keyboard.o: keyboard.s
ca65 -g -l keyboard.lst --feature labels_without_colons --feature pc_assignment keyboard.s
osi65v.o: osi65v.s
ca65 -g -l osi65v.lst --feature labels_without_colons --feature pc_assignment osi65v.s
coldstart.o: coldstart.s
ca65 -g -l coldstart.lst --feature labels_without_colons --feature pc_assignment coldstart.s
osibasic.o: osibasic.s
ca65 -g -l osibasic.lst --feature labels_without_colons --feature pc_assignment osibasic.s
cegmon.o: cegmon.s
ca65 -g -l cegmon.lst --feature labels_without_colons --feature pc_assignment cegmon.s
osibasic.bin: osibasic.o
ld65 -t none -vm -m osirom.map -o osibasic.bin osibasic.o
cegmon.bin: cegmon.o
ld65 -t none -vm -m cegmon.map -o cegmon.bin cegmon.o
basicrom.bin: basic.bin osibasic.bin
cat basic.bin osibasic.bin >basicrom.bin
basic.bin:
cd msbasic ; ./make.sh
cp msbasic/tmp/osi.bin basic.bin
clean:
$(RM) *.o *.lst *.mon *.map *.bin *.lod
$(RM) -rf msbasic/tmp
distclean: clean

17
software/retro1-tests/OSI/README.txt Normal file
View File

@ -0,0 +1,17 @@
This is the source code for the Ohio Scientific Superboard II /
Challenger 1P / Model 600 ROMs, including the monitor, boot program,
keyboard scan routine, and BASIC.
The source code came from various sources including disassembly of the
ROMs.
This version builds with the CC65 assembler. In some cases I have also
added additional comments to the code.
Included here are a couple of optional patches to BASIC. One fixes the
display of error messages, and the other addresses the well-known
garbage collection bug.
On a Linux system with the CC65 assembler installed, you can build
everything by running "make" in this directory. Do "make patch" to
apply the two patches to BASIC. See the Makefile for more details.

25
software/retro1-tests/OSI/bintolod Normal file
View File

@ -0,0 +1,25 @@
#!/bin/sh
#
# Convert binary file to format used by OSI Monitor Load command.
# Default start address
start=FE00
# Default load (go) address
load=FE00
OPTIND=1 # Reset in case getopts has been used previously in the shell.
while getopts s:l: o
do case "$o" in
s) start="$OPTARG";;
l) load="$OPTARG";;
[?]) echo >&2 "Usage: $0 [-s <start address>] [-l <load address>] <filename>"
exit 1;;
esac
done
shift $((OPTIND-1))
echo -n ".${start}/"
hexdump -v -e '/1 "%02X\r"' $1
echo ".${load}G\r"

979
software/retro1-tests/OSI/cegmon.s Normal file
View File

@ -0,0 +1,979 @@
; Source for CEGMON monitor. Generated by disassembling ROM image.
.org $F800
L0000 := $0000
L002E := $002E
L00FD := $00FD
L00FE := $00FE
L0218 := $0218
L021A := $021A
L021C := $021C
L021E := $021E
L0220 := $0220
L0227 := $0227
L022A := $022A
L0233 := $0233
L2F44 := $2F44
L415A := $415A
LA34B := $A34B
LA374 := $A374
LA636 := $A636
LBF2D := $BF2D
LD08C := $D08C
LF800: lda $0E
beq LF80A
dec $0E
beq LF80A
dec $0E
LF80A: lda #$20
sta $0201
jsr LFF8F
bpl LF82D
sec
lda $022B
sbc #$40
sta $022B
lda $022C
sbc #$00
sta $022C
jsr LFBCF
bcs LF82D
jsr LFFD1
LF82D: stx $0200
jsr LFF88
jmp LF8D2
LF836: sta $0202
pha
txa
pha
tya
pha
lda $0202
bne LF846
jmp LF8D2
LF846: ldy $0206
beq LF84E
jsr LFCE1
LF84E: cmp #$5F
beq LF800
cmp #$0C
bne LF861
jsr LFF8C
jsr LFFD1
stx $0200
beq LF8CF
LF861: cmp #$0A
beq LF88C
cmp #$1E
beq LF8E0
cmp #$0B
beq LF87D
cmp #$1A
beq LF8D8
cmp #$0D
bne LF87A
jsr LFF6D
bne LF8D2
LF87A: sta $0201
LF87D: jsr LFF8C
inc $0200
inx
cpx $0222
bmi LF8CF
jsr LFF70
LF88C: jsr LFF8C
ldy #$02
jsr LFBD2
bcs LF89E
ldx #$03
jsr LFDEE
jmp LF8CF
LF89E: jsr LFE28
jsr LFFD1
jsr LFDEE
ldx $0222
LF8AA: jsr L0227
bpl LF8AA
inx
jsr LFDEE
ldx #$03
jsr LFDEE
jsr LFBCF
bcc LF8AA
lda #$20
LF8BF: jsr L022A
bpl LF8BF
ldx #$01
LF8C6: lda $0223,x
sta $0228,x
dex
bpl LF8C6
LF8CF: jsr LFF75
LF8D2: pla
tay
pla
tax
pla
rts
LF8D8: jsr LFE59
sta $0201
beq LF904
LF8E0: lda #$20
jsr LFF8F
jsr LFFD1
LF8E8: ldx $0222
lda #$20
LF8ED: jsr L022A
bpl LF8ED
sta $0201
ldy #$02
jsr LFBD2
bcs LF904
ldx #$03
jsr LFDEE
jmp LF8E8
LF904: jsr LFFD1
stx $0200
beq LF8D2
LF90C: jsr LF9A6
LF90F: jsr LFBF5
jsr LFEB6
jsr LFBE6
jsr LFBE0
ldx #$08
stx L00FD
LF91F: jsr LFBE6
jsr LFEF0
jsr LFBEB
bcs LF97B
jsr LFEF9
dec L00FD
bne LF91F
beq LF90F
LF933: jsr LFFBD
jsr LFDE4
bcs LF97E
LF93B: ldx $E4
txs
lda $E6
pha
lda $E5
pha
lda $E3
pha
lda $E0
ldx $E1
ldy $E2
rti
LF94E: ldx #$03
LF950: lda LFA4B,x
sta $0234,x
dex
bne LF950
jsr LFE8D
jsr LF9B5
lda (L00FE),y
sta $E7
tya
sta (L00FE),y
beq LF97E
LF968: jmp LFA7E
LF96B: dec $FB
bne LF9E8
LF96F: beq LF90C
LF971: rts
LF972: lda $FB
bne LF971
lda #$3F
jsr LFFEE
LF97B: ldx #$28
txs
LF97E: jsr LFBF5
ldy #$00
sty $FB
jsr LFBE0
LF988: jsr LFE8D
cmp #$4D
beq LF933
cmp #$52
beq LF93B
cmp #$5A
beq LF94E
cmp #$53
beq LF968
cmp #$4C
beq LF96B
cmp #$55
bne LF9D6
jmp (L0233)
LF9A6: jsr LFE8D
jsr LF9B5
jsr LFBE3
ldx #$00
LF9B1: jsr LFE8D
.byte $2C
LF9B5: ldx #$05
jsr LF9C0
jsr LFE8D
.byte $2C
LF9BE: ldx #$03
LF9C0: jsr LF9C6
jsr LFE8D
LF9C6: cmp #$2E
beq LF988
cmp #$2F
beq LF9E8
jsr LFE93
bmi LF972
jmp LFEDA
LF9D6: cmp #$54
beq LF96F
jsr LF9B5
LF9DD: lda #$2F
jsr LFFEE
jsr LFEF0
jsr LFBE6
LF9E8: jsr LFE8D
cmp #$47
bne LF9F2
jmp (L00FE)
LF9F2: cmp #$2C
bne LF9FC
jsr LFEF9
jmp LF9E8
LF9FC: cmp #$0A
beq LFA16
cmp #$0D
beq LFA1B
cmp #$5E
beq LFA21
cmp #$27
beq LFA3A
jsr LF9BE
lda $FC
sta (L00FE),y
LFA13: jmp LF9E8
LFA16: lda #$0D
jsr LFFEE
LFA1B: jsr LFEF9
jmp LFA31
LFA21: sec
lda L00FE
sbc #$01
sta L00FE
lda $FF
sbc #$00
sta $FF
LFA2E: jsr LFBF5
LFA31: jsr LFEB6
jmp LF9DD
jsr LFEF7
LFA3A: jsr LFE8D
cmp #$27
bne LFA46
jsr LFBE3
bne LFA13
LFA46: cmp #$0D
beq LFA2E
.byte $D0
LFA4B: .byte $EB
jmp LFA4F
LFA4F: sta $E0
pla
pha
and #$10
bne LFA5A
lda $E0
rti
LFA5A: stx $E1
sty $E2
pla
sta $E3
cld
sec
pla
sbc #$02
sta $E5
pla
sbc #$00
sta $E6
tsx
stx $E4
ldy #$00
lda $E7
sta ($E5),y
lda #$E0
sta L00FE
sty $FF
bne LFA2E
LFA7E: jsr LFFBD
jsr LFFF7
jsr LFEE9
jsr LFFEE
jsr LFFE3
lda #$2F
jsr LFFEE
bne LFA97
LFA94: jsr LFEF9
LFA97: jsr LFEF0
lda #$0D
jsr LFCB1
jsr LFBEB
bcc LFA94
lda $E4
ldx $E5
sta L00FE
stx $FF
jsr LFFE3
lda #$47
jsr LFFEE
jsr LFFAC
sty $0205
jmp LF97E
LFABD: txa
pha
tya
pha
lda $0204
bpl LFB1F
LFAC6: ldy $022F
lda $0231
sta $E4
lda $0232
sta $E5
lda ($E4),y
sta $0230
lda #$A1
sta ($E4),y
jsr LFD00
lda $0230
sta ($E4),y
lda $0215
cmp #$11
beq LFB13
cmp #$01
beq LFB0D
cmp #$04
beq LFB07
cmp #$13
beq LFB01
cmp #$06
bne LFB22
jsr LFB7C
jmp LFAC6
LFB01: jsr LFE28
jmp LFAC6
LFB07: jsr LFB6B
jmp LFAC6
LFB0D: jsr LFE19
jmp LFAC6
LFB13: lda $0230
sta $0215
jsr LFB6B
jmp LFB43
LFB1F: jsr LFD00
LFB22: cmp #$05
bne LFB43
lda $0204
eor #$FF
sta $0204
bpl LFB1F
lda $022B
sta $0231
lda $022C
sta $0232
ldx #$00
stx $022F
beq LFAC6
LFB43: jmp LFDD3
bit $0203
bpl LFB68
LFB4B: lda #$FD
sta $DF00
lda #$10
bit $DF00
beq LFB61
LFB57: lda $F000
lsr a
bcc LFB4B
lda $F001
rts
LFB61: lda #$00
sta $FB
sta $0203
LFB68: jmp LFABD
LFB6B: ldx $0222
cpx $022F
beq LFB77
inc $022F
rts
LFB77: ldx #$00
stx $022F
LFB7C: clc
lda $0231
adc #$40
sta $0231
lda $0232
adc #$00
cmp #$D8
bne LFB90
lda #$D0
LFB90: sta $0232
LFB93: rts
lda $0212
bne LFB93
lda #$FE
sta $DF00
bit $DF00
bvs LFB93
lda #$FB
sta $DF00
bit $DF00
bvs LFB93
lda #$03
jmp LA636
LFBB2: lsr $FB
.byte $9B
.byte $FF
sty $FB,x
LFBB8: bvs LFBB8
.byte $7B
inc $803F,x
bne LFC00
.byte $D7
lda LD08C,x
sta LD08C,x
dex
rts
brk
jsr LD08C
dey
.byte $F9
LFBCF: ldx $0222
LFBD2: sec
lda $022B
sbc $0223,y
lda $022C
sbc $0224,y
rts
LFBE0: lda #$3E
.byte $2C
LFBE3: lda #$2C
.byte $2C
LFBE6: lda #$20
jmp LFFEE
LFBEB: sec
lda L00FE
sbc $F9
lda $FF
sbc $FA
rts
LFBF5: lda #$0D
jsr LFFEE
lda #$0A
jmp LFFEE
rti
LFC00: jsr LFC0C
jmp (L00FD)
jsr LFC0C
jmp LFE00
LFC0C: ldy #$00
sty $C001
sty $C000
ldx #$04
stx $C001
sty $C003
dey
sty $C002
stx $C003
sty $C002
lda #$FB
bne LFC33
LFC2A: lda #$02
bit $C000
beq LFC4D
lda #$FF
LFC33: sta $C002
jsr LFCA5
and #$F7
sta $C002
jsr LFCA5
ora #$08
sta $C002
ldx #$18
jsr LFC91
beq LFC2A
LFC4D: ldx #$7F
stx $C002
jsr LFC91
LFC55: lda $C000
bmi LFC55
LFC5A: lda $C000
bpl LFC5A
lda #$03
sta $C010
lda #$58
sta $C010
jsr LFC9C
sta L00FE
tax
jsr LFC9C
sta L00FD
jsr LFC9C
sta $FF
ldy #$00
LFC7B: jsr LFC9C
sta (L00FD),y
iny
bne LFC7B
inc L00FE
dec $FF
bne LFC7B
stx L00FE
lda #$FF
sta $C002
rts
LFC91: ldy #$F8
LFC93: dey
bne LFC93
eor $FF,x
dex
bne LFC91
rts
LFC9C: lda $C010
lsr a
bcc LFC9C
lda $C011
LFCA5: rts
LFCA6: lda #$03
sta $F000
lda #$11
sta $F000
rts
LFCB1: pha
LFCB2: lda $F000
lsr a
lsr a
bcc LFCB2
pla
sta $F001
rts
LFCBE: eor #$FF
sta $DF00
eor #$FF
rts
LFCC6: pha
jsr LFCCF
tax
pla
dex
inx
rts
LFCCF: lda $DF00
eor #$FF
rts
cmp #$5F
beq LFCDC
jmp LA374
LFCDC: jmp LA34B
LFCDF: ldy #$10
LFCE1: ldx #$40
LFCE3: dex
bne LFCE3
dey
bne LFCE1
rts
LFCEA: .byte "CEGMON(C)1980 D/C/W/M?"
LFD00: txa
pha
tya
pha
LFD04: lda #$80
LFD06: jsr LFCBE
jsr LFCC6
bne LFD13
lsr a
bne LFD06
beq LFD3A
LFD13: lsr a
bcc LFD1F
txa
and #$20
beq LFD3A
lda #$1B
bne LFD50
LFD1F: jsr LFE86
tya
sta $0215
asl a
asl a
asl a
sec
sbc $0215
sta $0215
txa
lsr a
asl a
jsr LFE86
beq LFD47
lda #$00
LFD3A: sta $0216
LFD3D: sta $0213
lda #$02
sta $0214
bne LFD04
LFD47: clc
tya
adc $0215
tay
lda LFF3B,y
LFD50: cmp $0213
bne LFD3D
dec $0214
beq LFD5F
jsr LFCDF
beq LFD04
LFD5F: ldx #$64
cmp $0216
bne LFD68
ldx #$0F
LFD68: stx $0214
sta $0216
cmp #$21
bmi LFDD0
cmp #$5F
beq LFDD0
lda #$01
jsr LFCBE
jsr LFCCF
sta $0215
and #$01
tax
lda $0215
and #$06
bne LFDA2
bit $0213
bvc LFDBB
txa
eor #$01
and #$01
beq LFDBB
lda #$20
bit $0215
bvc LFDC3
lda #$C0
bne LFDC3
LFDA2: bit $0213
bvc LFDAA
txa
beq LFDBB
LFDAA: ldy $0213
cpy #$31
bcc LFDB9
cpy #$3C
bcs LFDB9
lda #$F0
bne LFDBB
LFDB9: lda #$10
LFDBB: bit $0215
bvc LFDC3
clc
adc #$C0
LFDC3: clc
adc $0213
and #$7F
bit $0215
bpl LFDD0
ora #$80
LFDD0: sta $0215
LFDD3: pla
tay
pla
tax
lda $0215
rts
LFDDB: jsr LFEF9
inc $E4
bne LFDE4
inc $E5
LFDE4: lda (L00FE),y
sta ($E4),y
jsr LFBEB
bcc LFDDB
rts
LFDEE: clc
lda #$40
adc $0228,x
sta $0228,x
lda #$00
adc $0229,x
sta $0229,x
rts
LFE00: ldx #$28
txs
cld
jsr LFCA6
jsr LFE40
nop
nop
jsr LFE59
sta $0201
sty L00FE
sty $FF
jmp LF97E
LFE19: ldx $022F
beq LFE22
dec $022F
rts
LFE22: ldx $0222
stx $022F
LFE28: sec
lda $0231
sbc #$40
sta $0231
lda $0232
sbc #$00
cmp #$CF
bne LFE3C
lda #$D7
LFE3C: sta $0232
rts
LFE40: ldy #$1C
LFE42: lda LFBB2,y
sta L0218,y
dey
bpl LFE42
ldy #$07
lda #$00
sta $0212
LFE52: sta $01FF,y
dey
bne LFE52
rts
LFE59: ldy #$00
sty $F9
lda #$D0
sta $FA
ldx #$08
lda #$20
LFE65: sta ($F9),y
iny
bne LFE65
inc $FA
dex
bne LFE65
rts
pha
dec $0203
lda #$00
LFE76: sta $0205
pla
rts
pha
lda #$01
bne LFE76
LFE80: jsr LFB57
and #$7F
rts
LFE86: ldy #$08
LFE88: dey
asl a
bcc LFE88
rts
LFE8D: jsr LFEE9
jmp LFFEE
LFE93: cmp #$30
bmi LFEA9
cmp #$3A
bmi LFEA6
cmp #$41
bmi LFEA9
cmp #$47
bpl LFEA9
sec
sbc #$07
LFEA6: and #$0F
rts
LFEA9: lda #$80
rts
jsr LFEB6
nop
nop
jsr LFBE6
bne LFEBD
LFEB6: ldx #$03
jsr LFEBF
dex
.byte $2C
LFEBD: ldx #$00
LFEBF: lda $FC,x
lsr a
lsr a
lsr a
lsr a
jsr LFECA
lda $FC,x
LFECA: and #$0F
ora #$30
cmp #$3A
bmi LFED5
clc
adc #$07
LFED5: jmp LFFEE
nop
nop
LFEDA: ldy #$04
asl a
asl a
asl a
asl a
LFEE0: rol a
rol $F9,x
rol $FA,x
dey
bne LFEE0
rts
LFEE9: lda $FB
bne LFE80
jmp LFD00
LFEF0: lda (L00FE),y
sta $FC
jmp LFEBD
LFEF7: sta (L00FE),y
LFEF9: inc L00FE
bne LFEFF
inc $FF
LFEFF: rts
LFF00: cld
ldx #$28
txs
jsr LFCA6
jsr LFE40
jsr LFE59
jsr LFFD1
LFF10: lda LFCEA,y
jsr LFFEE
iny
cpy #$16
bne LFF10
jsr LFFEB
and #$DF
cmp #'D'
bne LFF27
jmp LFC00
LFF27: cmp #$4D
bne LFF2E
jmp LFE00
LFF2E: cmp #$57
bne LFF35
jmp L0000
LFF35: cmp #$43
bne LFF00
.byte $4C
.byte $11
LFF3B: .byte $BD
.byte "P;/ ZAQ,MNBVCXKJHGFDSIUYTREW"
.byte $00, $00, $0D, $0A, 'O'
jmp L002E
.byte "_-:0987654321"
LFF6D: jsr LFF8C
LFF70: ldx #$00
stx $0200
LFF75: ldx $0200
lda #$BD
sta L022A
jsr L022A
sta $0201
lda #$9D
sta L022A
LFF88: lda #$5F
bne LFF8F
LFF8C: lda $0201
LFF8F: ldx $0200
jmp L022A
jsr LBF2D
jmp LFF9E
jsr LF836
LFF9E: pha
lda $0205
beq LFFBB
pla
jsr LFCB1
cmp #$0D
bne LFFBC
LFFAC: pha
txa
pha
ldx #$0A
lda #$00
LFFB3: jsr LFCB1
dex
bne LFFB3
pla
tax
LFFBB: pla
LFFBC: rts
LFFBD: jsr LF9A6
jsr LFBE0
ldx #$03
jsr LF9B1
lda $FC
ldx L00FD
sta $E4
stx $E5
rts
LFFD1: ldx #$02
LFFD3: lda $0222,x
sta L0227,x
sta L022A,x
dex
bne LFFD3
rts
eor $012F
LFFE3: lda #$2E
jsr LFFEE
jmp LFEB6
LFFEB: jmp (L0218)
LFFEE: jmp (L021A)
jmp (L021C)
jmp (L021E)
LFFF7: jmp (L0220)
.word $0237 ; NMI vector
.word $FF00 ; Reset vector
.word $0235 ; BRK/IRQ vector

134
software/retro1-tests/OSI/coldstart.s Normal file
View File

@ -0,0 +1,134 @@
; Source for coldstart and BASIC I/O ROM. Generated by disassembling
; code.
NMI = $0130 ; NMI interrupt address
IRQ = $01C0 ; IRQ interrupt address
L0000 = $0000
L0218 = $0218
L021A = $021A
L021C = $021C
L021E = $021E
L0220 = $0220
LA636 = $A636
LBD11 = $BD11
LBF2D = $BF2D
LFC00 = $FC00 ; Floppy disc bootstrap
LFCA6 = $FCA6
LFCB1 = $FCB1
LFD00 = $FD00 ; Keyboard input
LFE00 = $FE00 ; Monitor
* = $FF00
RESET: cld ; clear decimal mode
ldx #$28 ; initialize stack pointer to $0128
txs
ldy #$0A
LFF06: lda $FEEF,y
sta $0217,y
dey
bne LFF06
jsr LFCA6
sty $0212
sty $0203
sty $0205
sty $0206
lda LFFE0
sta $0200
lda #' '
LFF26: sta $D300,y ; Clear screen
sta $D200,y
sta $D100,y
sta $D000,y
iny
bne LFF26
LFF35: lda LFF5F,y
beq LFF40
jsr LBF2D
iny
bne LFF35
LFF40: jsr LFFBA
cmp #'M' ; User selected M for Monitor?
bne LFF4A
jmp LFE00 ; Jump to monitor
LFF4A: cmp #'W' ; User selected W for BASIC Warm start?
bne LFF51
jmp L0000 ; Jump to BASIC warm start
LFF51: cmp #'C' ; User selected C for BASIC Carm start?
bne LFF58
jmp LBD11 ; Jump to BASIC cold start
LFF58: cmp #'D' ; User selected D for boot from disk?
bne RESET ; Restart if invalid input
jmp LFC00 ; Jump to disk boot
LFF5F: .asciiz "D/C/W/M ?"
jsr LBF2D
pha
lda $0205
beq LFF94
pla
jsr LFCB1
cmp #$0D
bne LFF95
pha
txa
pha
ldx #$0A
lda #$00
LFF81: jsr LFCB1
dex
bne LFF81
pla
tax
pla
rts
pha
dec $0203
lda #$00
LFF91: sta $0205
LFF94: pla
LFF95: rts
pha
lda #$01
bne LFF91
lda $0212
bne LFFB9
lda #$FE
sta $DF00
bit $DF00
bvs LFFB9
lda #$FB
sta $DF00
bit $DF00
bvs LFFB9
lda #$03
jmp LA636
LFFB9: rts
LFFBA: bit $0203
bpl LFFD8
LFFBF: lda #$FD
sta $DF00
lda #$10
bit $DF00
beq LFFD5
lda $F000
lsr a
bcc LFFBF
lda $F001
rts
LFFD5: inc $0203
LFFD8: jmp LFD00
.byte $FF, $FF, $FF, $FF, $FF
LFFE0: .byte $65, $17, $00, $00, $03, $FF, $9F, $00, $03, $FF, $9F
jmp (L0218)
jmp (L021A)
jmp (L021C)
jmp (L021E)
jmp (L0220)
.word NMI
.word RESET
.word IRQ

125
software/retro1-tests/OSI/diskboot.s Normal file
View File

@ -0,0 +1,125 @@
; Source for floppy disk bootstrap ROM. Generated by disassembling
; code.
ADDR = $FD
DSKPIA = $C000
KBD = $DF00
VM = $FE00
ACIA = $F000
*=$FC00
jsr LFC0C
jmp (ADDR)
jsr LFC0C
jmp VM
LFC0C: ldy #$00
sty DSKPIA+1
sty DSKPIA
ldx #$04
stx DSKPIA+1
sty DSKPIA+3
dey
sty DSKPIA+2
stx DSKPIA+3
sty DSKPIA+2
lda #$FB
bne LFC33
LFC2A: lda #$02
bit DSKPIA
beq LFC4D
lda #$FF
LFC33: sta DSKPIA+2
jsr LFCA5
and #$F7
sta DSKPIA+2
jsr LFCA5
ora #$08
sta DSKPIA+2
ldx #$18
jsr LFC91
beq LFC2A
LFC4D: ldx #$7F
stx DSKPIA+2
jsr LFC91
LFC55: lda DSKPIA
bmi LFC55
LFC5A: lda DSKPIA
bpl LFC5A
lda #$03
sta DSKPIA+$10
lda #$58
sta DSKPIA+$10
jsr LFC9C
sta $FE
tax
jsr LFC9C
sta ADDR
jsr LFC9C
sta $FF
ldy #$00
LFC7B: jsr LFC9C
sta (ADDR),y
iny
bne LFC7B
inc $FE
dec $FF
bne LFC7B
stx $FE
lda #$FF
sta DSKPIA+2
rts
LFC91: ldy #$F8
LFC93: dey
bne LFC93
eor $FF,x
dex
bne LFC91
rts
LFC9C: lda DSKPIA+$10
lsr a
bcc LFC9C
lda DSKPIA+$11
LFCA5: rts
lda #$03
sta ACIA
lda #$11
sta ACIA
rts
pha
LFCB2: lda ACIA
lsr a
lsr a
bcc LFCB2
pla
sta ACIA+1
rts
eor #$FF
sta KBD
eor #$FF
rts
pha
jsr LFCCF
tax
pla
dex
inx
rts
LFCCF: lda KBD
eor #$FF
rts
.byte $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
.byte $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
.byte $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
.byte $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
.byte $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF
.byte $FF, $FF, $FF

69
software/retro1-tests/OSI/errormessage.patch Normal file
View File

@ -0,0 +1,69 @@
diff --git a/asm/OSI/msbasic/error.s b/asm/OSI/msbasic/error.s
index aa184e2..1f21a53 100644
--- a/asm/OSI/msbasic/error.s
+++ b/asm/OSI/msbasic/error.s
@@ -1,23 +1,23 @@
init_error_table
.ifdef CONFIG_SMALL
-define_error ERR_NOFOR, "NF"
-define_error ERR_SYNTAX, "SN"
-define_error ERR_NOGOSUB, "RG"
-define_error ERR_NODATA, "OD"
-define_error ERR_ILLQTY, "FC"
-define_error ERR_OVERFLOW, "OV"
-define_error ERR_MEMFULL, "OM"
-define_error ERR_UNDEFSTAT, "US"
-define_error ERR_BADSUBS, "BS"
-define_error ERR_REDIMD, "DD"
-define_error ERR_ZERODIV, "/0"
-define_error ERR_ILLDIR, "ID"
-define_error ERR_BADTYPE, "TM"
-define_error ERR_STRLONG, "LS"
-define_error ERR_FRMCPX, "ST"
-define_error ERR_CANTCONT, "CN"
-define_error ERR_UNDEFFN, "UF"
+define_err ERR_NOFOR, "NF"
+define_err ERR_SYNTAX, "SN"
+define_err ERR_NOGOSUB, "RG"
+define_err ERR_NODATA, "OD"
+define_err ERR_ILLQTY, "FC"
+define_err ERR_OVERFLOW, "OV"
+define_err ERR_MEMFULL, "OM"
+define_err ERR_UNDEFSTAT, "US"
+define_err ERR_BADSUBS, "BS"
+define_err ERR_REDIMD, "DD"
+define_err ERR_ZERODIV, "/0"
+define_err ERR_ILLDIR, "ID"
+define_err ERR_BADTYPE, "TM"
+define_err ERR_STRLONG, "LS"
+define_err ERR_FRMCPX, "ST"
+define_err ERR_CANTCONT, "CN"
+define_err ERR_UNDEFFN, "UF"
.else
define_error ERR_NOFOR, "NEXT WITHOUT FOR"
define_error ERR_SYNTAX, "SYNTAX"
@@ -46,4 +46,4 @@ define_error ERR_BADDATA, "FILE DATA"
define_error ERR_FRMCPX, "FORMULA TOO COMPLEX"
define_error ERR_CANTCONT, "CAN'T CONTINUE"
define_error ERR_UNDEFFN, "UNDEF'D FUNCTION"
-.endif
\ No newline at end of file
+.endif
diff --git a/asm/OSI/msbasic/macros.s b/asm/OSI/msbasic/macros.s
index 33f1ca0..ab5d6a2 100644
--- a/asm/OSI/msbasic/macros.s
+++ b/asm/OSI/msbasic/macros.s
@@ -68,6 +68,12 @@ ERROR_MESSAGES:
htasc msg
.endmacro
+.macro define_err error, msg
+ .segment "ERROR"
+ error := <(*-ERROR_MESSAGES)
+ .byte msg
+.endmacro
+
;---------------------------------------------
; set the MSB of every byte of a string
.macro asc80 str

35
software/retro1-tests/OSI/example1.s Normal file
View File

@ -0,0 +1,35 @@
;
; "Good Listener" Example program from OSI OS65V manual.
;
; Echoes keys pressed on a line of the screen with single line
; scrollng.
;
; Build using:
; ca65 -g -l example1.s
; ld65 -t none -vm -o example1.bin example1.o
; ./bintolod -s 0000 -l 0000 example1.bin >example1.lod
;
; Then upload and run using:
; ascii-xfr -s example1.lod >/dev/ttyUSB0
GETKEY := $FEED
.org 0
ldx #0 ; Clear index
fill: jsr GETKEY ; Next pressed into A
sta $D146,x ; Into next line cell
inx ; Increment index by 1
cpx #20 ; End of the line?
bne fill ; Back until equal
repeat: jsr GETKEY ; Next pressed to A
tay ; Save key in Y
ldx #0 ; Clear index
move: lda $D147,x ; Load line(i+1)
sta $D146,x ; Store into line(i)
inx ; Increment index
cpx #19 ; End of the line?
bne move ; Back until equal
tya ; Restore key-in
sta $D159 ; Store new key
jmp repeat ; Back for more

55
software/retro1-tests/OSI/example2.s Normal file
View File

@ -0,0 +1,55 @@
;
; OSI Serial/Cassette and console input/output.
;
; Build using:
; ca65 -g -l example2.s
; ld65 -t none -vm -o example2.bin example2.o
; ./bintolod -s 0000 -l 0000 example2.bin >example2.lod
;
; Then upload and run using:
; ascii-xfr -s example2.lod >/dev/ttyUSB0
; Useful ROM Routines:
; Get key from keyboard and return in A
; $FD00
; Send character to terminal screen.
; Character in A. Handles CR, LF, etc.
; Maintains cursor position as $D300 +($0200). Default (bottom left) is $65.
; $BF2D
; Send character to ACIA
; $FCB1
; Read character from ACIA
; $FE80
; ROM monitor uses these page zero addresses, so avoid:
; $FB,$FC,$FE,$FF
.org 0
; Write chars to serial port/UART
clearscreen:
ldx #$FF
lda #' '
loop1: sta $D000,x
sta $D100,x
sta $D300,x
sta $D200,x
dex
bne loop1
lda #$65
sta $0200
loop: jsr $FD00
jsr $BF2D
jsr $FCB1
jmp loop

4
software/retro1-tests/OSI/fill.s Normal file
View File

@ -0,0 +1,4 @@
; The ROM contains zeroes from $F800 to $FBFF.
* = $F800
.res 1024, 0

99
software/retro1-tests/OSI/garbagecollection.patch Normal file
View File

@ -0,0 +1,99 @@
diff --git a/asm/OSI/msbasic/string.s b/asm/OSI/msbasic/string.s
index 499d4cd..22910dc 100644
--- a/asm/OSI/msbasic/string.s
+++ b/asm/OSI/msbasic/string.s
@@ -189,17 +189,14 @@ FINDHIGHESTSTRING:
sta FRETOP+1
ldy #$00
sty FNCNAM+1
-.ifdef CONFIG_2
sty FNCNAM ; GC bugfix!
-.endif
lda STREND
ldx STREND+1
sta LOWTR
stx LOWTR+1
lda #TEMPST
- ldx #$00
sta INDEX
- stx INDEX+1
+ sty INDEX+1
L333D:
cmp TEMPPT
beq L3346
@@ -223,7 +220,7 @@ L335A:
L335F:
sta HIGHDS
stx HIGHDS+1
- lda #$03 ; OSI GC bugfix -> $04 ???
+ lda #$04 ; OSI GC bugfix -> $04 ???
sta DSCLEN
L3367:
lda HIGHDS
@@ -232,8 +229,8 @@ L336B:
cpx STREND+1
bne L3376
cmp STREND
- bne L3376
- jmp MOVE_HIGHEST_STRING_TO_TOP
+ beq MOVE_HIGHEST_STRING_TO_TOP
+
L3376:
sta INDEX
stx INDEX+1
@@ -266,9 +263,7 @@ L3376:
.ifdef CONFIG_CBM1_PATCHES
jsr LE7F3 ; XXX patch, call into screen editor
.else
- .ifdef CONFIG_11
ldy #$00 ; GC bugfix
- .endif
asl a
adc #$05
.endif
@@ -329,8 +324,9 @@ L33DF:
ldx INDEX+1
sta FNCNAM
stx FNCNAM+1
- lda DSCLEN
- sta Z52
+ dey
+ dey
+ sty Z52
; ----------------------------------------------------------------------------
; ADD (DSCLEN) TO PNTR IN INDEX
@@ -353,22 +349,12 @@ L33FA:
; TO TOP AND GO BACK FOR ANOTHER
; ----------------------------------------------------------------------------
MOVE_HIGHEST_STRING_TO_TOP:
-.ifdef CONFIG_2
+ dec DSCLEN
lda FNCNAM+1 ; GC bugfix
ora FNCNAM
-.else
- ldx FNCNAM+1
-.endif
beq L33FA
- lda Z52
-.ifndef CONFIG_10A
- sbc #$03
-.else
- and #$04
-.endif
- lsr a
- tay
- sta Z52
+ ldy Z52
+ clc
lda (FNCNAM),y
adc LOWTR
sta HIGHTR
@@ -390,6 +376,7 @@ MOVE_HIGHEST_STRING_TO_TOP:
iny
sta (FNCNAM),y
jmp FINDHIGHESTSTRING
+ .byte $FF, $FF
; ----------------------------------------------------------------------------
; CONCATENATE TWO STRINGS

122
software/retro1-tests/OSI/keyboard.s Normal file
View File

@ -0,0 +1,122 @@
; Source for polled keyboard ROM. Generated by disassembling code.
LFCBE = $FCBE
LFCC6 = $FCC6
LFCCF = $FCCF
*=$FD00
txa
pha
tya
pha
LFD04: lda #$01
LFD06: jsr LFCBE
jsr LFCC6
bne LFD13
LFD0E: asl a
bne LFD06
beq LFD66
LFD13: lsr a
bcc LFD1F
rol a
cpx #$21
bne LFD0E
lda #$1B
bne LFD40
LFD1F: jsr LFDC8
tya
sta $0213
asl a
asl a
asl a
sec
sbc $0213
sta $0213
txa
lsr a
jsr LFDC8
bne LFD66
clc
tya
adc $0213
tay
lda TABLE,y
LFD40: cmp $0215
bne LFD6B
dec $0214
beq LFD75
ldy #$05
LFD4C: ldx #$C8
LFD4E: dex
bne LFD4E
dey
bne LFD4C
beq LFD04
LFD56: cmp #$01
beq LFD8F
ldy #$00
cmp #$02
beq LFDA7
ldy #$C0
cmp #$20
beq LFDA7
LFD66: lda #$00
sta $0216
LFD6B: sta $0215
lda #$02
sta $0214
bne LFD04
LFD75: ldx #$96
cmp $0216
bne LFD7E
ldx #$14
LFD7E: stx $0214
sta $0216
lda #$01
jsr LFCBE
jsr LFCCF
LFD8C: lsr a
bcc LFDC2
LFD8F: tax
and #$03
beq LFD9F
ldy #$10
lda $0215
bpl LFDA7
ldy #$F0
bne LFDA7
LFD9F: ldy #$00
cpx #$20
bne LFDA7
ldy #$C0
LFDA7: lda $0215
and #$7F
cmp #$20
beq LFDB7
sty $0213
clc
adc $0213
LFDB7: sta $0213
pla
tay
pla
tax
lda $0213
rts
LFDC2: bne LFD56
ldy #$20
bne LFDA7
LFDC8: ldy #$08
LFDCA: dey
asl a
bcc LFDCA
rts
TABLE: .byte $D0, $BB, $2F, $20, $5A, $41, $51, $2C
.byte $4D, $4E, $42, $56, $43, $58, $4B, $4A
.byte $48, $47, $46, $44, $53, $49, $55, $59
.byte $54, $52, $45, $57, $00, $00, $0D, $0A
.byte $4F, $4C, $2E, $00, $FF, $2D, $BA, $30
.byte $B9, $B8, $B7, $B6, $B5, $B4, $B3, $B2, $B1

2
software/retro1-tests/OSI/msbasic/README.txt Normal file
View File

@ -0,0 +1,2 @@
look into msbasic.s for the README
visit www.pagetable.com for more info

10
software/retro1-tests/OSI/msbasic/TODO.txt Normal file
View File

@ -0,0 +1,10 @@
* convert messy init code into completely different
files without ifdefs (not much in common!)
* move all machine specific code into separate files
* rename all labels that point to RTS to RTSn
* add AppleSoft comments
* look for all " $", i.e. (zeropage) constants, replace them
with symbols
* convert platform ifdefs in generic files into feature ifdefs or macros
* reconstruct pre-CBM1, i.e. CBM1 without the patches
* add some comments to every file

128
software/retro1-tests/OSI/msbasic/apple_extra.s Normal file
View File

@ -0,0 +1,128 @@
.segment "EXTRA"
.byte 0,0,0
L2900:
jsr LFD6A
stx $33
ldx #$00
L2907:
lda $0200,x
and #$7F
cmp #$0D
bne L2912
lda #$00
L2912:
sta $0200,x
inx
bne L2907
ldx $33
rts
PLT:
jmp L29F0
L291E:
cmp #$47
bne L2925
jmp L29E0
L2925:
cmp #$43
bne L292B
beq L2988
L292B:
cmp #$50
beq L2930
inx
L2930:
stx $33
L2932:
jsr FRMEVL
jsr ROUND_FAC
jsr AYINT
lda FAC+4
ldx $33
sta $0300,x
dec $33
bmi L294Dx
lda #$2C
jsr SYNCHR
bpl L2932
L294Dx:
tay
pla
cmp #$43
bne L2957
tya
jmp LF864
L2957:
cmp #$50
bne L2962
tya
ldy $0301
jmp LF800
L2962:
pha
lda $0301
sta $2C
sta $2D
pla
cmp #$48
bne L2978
lda $0300
ldy $0302
jmp LF819
L2978:
cmp #$56
beq L297F
jmp SYNERR
L297F:
ldy $0300
lda $0302
jmp LF828
L2988:
dex
beq L2930
INLINX:
jsr OUTQUES
jsr OUTSP
ldx #$80
jmp INLIN1
.byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0,0,0
USR_FUNC:
jsr L29DA
lda FAC+3
sta FAC+5
jmp (FAC+4)
L29DA:
jmp (GOAYINT)
brk
brk
brk
L29E0:
pla
jmp LFB40
.byte 0,0,0,0,0,0,0,0,0,0,0,0
L29F0:
pha
ldx #$01
inc $B9
bne L29F9
inc $BA
L29F9:
jmp L291E
.byte $00,$00,$00,$00,$41,$53,$21,$D2
.byte $02,$FA,$00
lda $12
beq L2A0E
jmp (GOGIVEAYF)
L2A0E:
jsr LF689
.byte $15,$BC,$08,$10,$52,$45,$75,$10
.byte $CD,$00,$55,$15,$9E,$08,$10,$4C
.byte $45,$75,$10,$D4,$00,$55,$15,$0E
.byte $08,$10,$89,$10,$75,$15,$1C,$08
.byte $10,$1F,$10,$75,$00
jmp (GOGIVEAYF)
; ----------------------------------------------------------------------------
.byte 0,0,0,0,0,0

10
software/retro1-tests/OSI/msbasic/apple_iscntc.s Normal file
View File

@ -0,0 +1,10 @@
.segment "CODE"
ISCNTC:
lda $C000
cmp #$83
beq L0ECC
rts
L0ECC:
jsr RDKEY
cmp #$03
;!!! runs into "STOP"

39
software/retro1-tests/OSI/msbasic/apple_loadsave.s Normal file
View File

@ -0,0 +1,39 @@
.segment "CODE"
SAVE:
jsr L0F42
jsr LFECD
jsr L0F51
jmp LFECD
LOAD:
jsr L0F42
jsr LFEFD
jsr L0F51
jsr LFEFD
lda #<QT_LOADED
ldy #>QT_LOADED
jsr STROUT
jmp FIX_LINKS
QT_LOADED:
.byte 0 ; XXX PATCHED
.byte "OADED"
.byte 0
L0F42:
lda #$6C
ldy #$00
sta $3C
sty $3D
lda #$6E
sta $3E
sty $3F
rts
L0F51:
lda $6A
ldy $6B
sta $3C
sty $3D
lda $6C
ldy $6D
sta $3E
sty $3F
rts

19
software/retro1-tests/OSI/msbasic/applesoft.cfg Normal file
View File

@ -0,0 +1,19 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $0800, size = $3F00, fill = no, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
DUMMY: load = DUMMY; # don't include
}

413
software/retro1-tests/OSI/msbasic/array.s Normal file
View File

@ -0,0 +1,413 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; COMPUTE ADDRESS OF FIRST VALUE IN ARRAY
; ARYPNT = (LOWTR) + #DIMS*2 + 5
; ----------------------------------------------------------------------------
GETARY:
lda EOLPNTR
asl a
adc #$05
adc LOWTR
ldy LOWTR+1
bcc L2FAF
iny
L2FAF:
sta HIGHDS
sty HIGHDS+1
rts
; ----------------------------------------------------------------------------
NEG32768:
.byte $90,$80,$00,$00
.ifdef CONFIG_2C
.byte $00; bugfix: short number
.endif
; ----------------------------------------------------------------------------
; EVALUATE NUMERIC FORMULA AT TXTPTR
; CONVERTING RESULT TO INTEGER 0 <= X <= 32767
; IN FAC+3,4
; ----------------------------------------------------------------------------
MAKINT:
jsr CHRGET
.ifdef CONFIG_2
jsr FRMEVL
.else
jsr FRMNUM
.endif
; ----------------------------------------------------------------------------
; CONVERT FAC TO INTEGER
; MUST BE POSITIVE AND LESS THAN 32768
; ----------------------------------------------------------------------------
MKINT:
.ifdef CONFIG_2
jsr CHKNUM
.endif
lda FACSIGN
bmi MI1
; ----------------------------------------------------------------------------
; CONVERT FAC TO INTEGER
; MUST BE -32767 <= FAC <= 32767
; ----------------------------------------------------------------------------
AYINT:
lda FAC
cmp #$90
bcc MI2
lda #<NEG32768
ldy #>NEG32768
jsr FCOMP
MI1:
bne IQERR
MI2:
jmp QINT
; ----------------------------------------------------------------------------
; LOCATE ARRAY ELEMENT OR CREATE AN ARRAY
; ----------------------------------------------------------------------------
ARRAY:
lda DIMFLG
.ifndef CONFIG_SMALL
ora VALTYP+1
.endif
pha
lda VALTYP
pha
ldy #$00
L2FDE:
tya
pha
lda VARNAM+1
pha
lda VARNAM
pha
jsr MAKINT
pla
sta VARNAM
pla
sta VARNAM+1
pla
tay
tsx
lda STACK+2,x
pha
lda STACK+1,x
pha
lda FAC_LAST-1
sta STACK+2,x
lda FAC_LAST
sta STACK+1,x
iny
jsr CHRGOT
cmp #$2C
beq L2FDE
sty EOLPNTR
jsr CHKCLS
pla
sta VALTYP
pla
.ifndef CONFIG_SMALL
sta VALTYP+1
and #$7F
.endif
sta DIMFLG
; ----------------------------------------------------------------------------
; SEARCH ARRAY TABLE FOR THIS ARRAY NAME
; ----------------------------------------------------------------------------
ldx ARYTAB
lda ARYTAB+1
L301F:
stx LOWTR
sta LOWTR+1
cmp STREND+1
bne L302B
cpx STREND
beq MAKE_NEW_ARRAY
L302B:
ldy #$00
lda (LOWTR),y
iny
cmp VARNAM
bne L303A
lda VARNAM+1
cmp (LOWTR),y
beq USE_OLD_ARRAY
L303A:
iny
lda (LOWTR),y
clc
adc LOWTR
tax
iny
lda (LOWTR),y
adc LOWTR+1
bcc L301F
; ----------------------------------------------------------------------------
; ERROR: BAD SUBSCRIPTS
; ----------------------------------------------------------------------------
SUBERR:
ldx #ERR_BADSUBS
.byte $2C
; ----------------------------------------------------------------------------
; ERROR: ILLEGAL QUANTITY
; ----------------------------------------------------------------------------
IQERR:
ldx #ERR_ILLQTY
JER:
jmp ERROR
; ----------------------------------------------------------------------------
; FOUND THE ARRAY
; ----------------------------------------------------------------------------
USE_OLD_ARRAY:
ldx #ERR_REDIMD
lda DIMFLG
bne JER
jsr GETARY
lda EOLPNTR
ldy #$04
cmp (LOWTR),y
bne SUBERR
jmp FIND_ARRAY_ELEMENT
; ----------------------------------------------------------------------------
; CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT
; ----------------------------------------------------------------------------
MAKE_NEW_ARRAY:
jsr GETARY
jsr REASON
lda #$00
tay
sta STRNG2+1
ldx #BYTES_PER_ELEMENT
.if .def(CONFIG_SMALL) && (!.def(CONFIG_2))
stx STRNG2
.endif
lda VARNAM
sta (LOWTR),y
.ifndef CONFIG_SMALL
bpl L3078
dex
L3078:
.endif
iny
lda VARNAM+1
sta (LOWTR),y
.if (!.def(CONFIG_SMALL)) || .def(CONFIG_2)
bpl L3081
dex
.if !(.def(CONFIG_SMALL) && .def(CONFIG_2))
dex
.endif
L3081:
stx STRNG2
.endif
lda EOLPNTR
iny
iny
iny
sta (LOWTR),y
L308A:
ldx #$0B
lda #$00
bit DIMFLG
bvc L309A
pla
clc
adc #$01
tax
pla
adc #$00
L309A:
iny
sta (LOWTR),y
iny
txa
sta (LOWTR),y
jsr MULTIPLY_SUBSCRIPT
stx STRNG2
sta STRNG2+1
ldy INDEX
dec EOLPNTR
bne L308A
adc HIGHDS+1
bcs GME
sta HIGHDS+1
tay
txa
adc HIGHDS
bcc L30BD
iny
beq GME
L30BD:
jsr REASON
sta STREND
sty STREND+1
lda #$00
inc STRNG2+1
ldy STRNG2
beq L30D1
L30CC:
dey
sta (HIGHDS),y
bne L30CC
L30D1:
dec HIGHDS+1
dec STRNG2+1
bne L30CC
inc HIGHDS+1
sec
lda STREND
sbc LOWTR
ldy #$02
sta (LOWTR),y
lda STREND+1
iny
sbc LOWTR+1
sta (LOWTR),y
lda DIMFLG
bne RTS9
iny
; ----------------------------------------------------------------------------
; FIND SPECIFIED ARRAY ELEMENT
;
; (LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR
; THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS
; ----------------------------------------------------------------------------
FIND_ARRAY_ELEMENT:
lda (LOWTR),y
sta EOLPNTR
lda #$00
sta STRNG2
L30F6:
sta STRNG2+1
iny
pla
tax
sta FAC_LAST-1
pla
sta FAC_LAST
cmp (LOWTR),y
bcc FAE2
bne GSE
iny
txa
cmp (LOWTR),y
bcc FAE3
; ----------------------------------------------------------------------------
GSE:
jmp SUBERR
GME:
jmp MEMERR
; ----------------------------------------------------------------------------
FAE2:
iny
FAE3:
lda STRNG2+1
ora STRNG2
clc
beq L3124
jsr MULTIPLY_SUBSCRIPT
txa
adc FAC_LAST-1
tax
tya
ldy INDEX
L3124:
adc FAC_LAST
stx STRNG2
dec EOLPNTR
bne L30F6
.if .def(CONFIG_SMALL) && (!.def(CONFIG_2))
asl STRNG2
rol a
bcs GSE
asl STRNG2
rol a
bcs GSE
tay
lda STRNG2
.else
.ifdef CONFIG_11A
sta STRNG2+1
.endif
ldx #BYTES_FP
.ifdef CONFIG_SMALL
lda VARNAM+1
.else
lda VARNAM
.endif
bpl L3135
dex
L3135:
.ifdef CONFIG_SMALL
stx RESULT+1
.else
lda VARNAM+1
bpl L313B
dex
dex
L313B:
stx RESULT+2
.endif
lda #$00
jsr MULTIPLY_SUBS1
txa
.endif
adc HIGHDS
sta VARPNT
tya
adc HIGHDS+1
sta VARPNT+1
tay
lda VARPNT
RTS9:
rts
; ----------------------------------------------------------------------------
; MULTIPLY (STRNG2) BY ((LOWTR),Y)
; LEAVING PRODUCT IN A,X. (HI-BYTE ALSO IN Y.)
; USED ONLY BY ARRAY SUBSCRIPT ROUTINES
; ----------------------------------------------------------------------------
MULTIPLY_SUBSCRIPT:
sty INDEX
lda (LOWTR),y
sta RESULT_LAST-2
dey
lda (LOWTR),y
MULTIPLY_SUBS1:
sta RESULT_LAST-1
lda #$10
sta INDX
ldx #$00
ldy #$00
L3163:
txa
asl a
tax
tya
rol a
tay
bcs GME
asl STRNG2
rol STRNG2+1
bcc L317C
clc
txa
adc RESULT_LAST-2
tax
tya
adc RESULT_LAST-1
tay
bcs GME
L317C:
dec INDX
bne L3163
rts

51
software/retro1-tests/OSI/msbasic/cbm1_patches.s Normal file
View File

@ -0,0 +1,51 @@
.segment "INIT"
PATCH1:
clc
jmp CONTROL_C_TYPED
PATCH2:
bit FAC+4
bpl LE1AA
cmp #$54
bne LE1AA
jmp LCE3B
LE1AA:
rts
PATCH3:
bit FAC+4
bmi LE1B2
jmp LCE90
LE1B2:
cmp #$54
beq LE1B9
jmp LCE82
LE1B9:
jmp LCE69
PATCH4:
sta CHARAC
inx
jmp LE1D9
PATCH5:
bpl LE1C9
lda Z8C
ldy Z8C+1
rts
LE1C9:
ldy #$FF
rts
PATCH6:
bne LE1D8
LE1CE:
inc POSX
bne LE1D8
lda $E2
sta POSX
bne LE1CE
LE1D8:
rts
LE1D9:
stx TXTPTR
pla
pla
tya
jmp L2B1C

1
software/retro1-tests/OSI/msbasic/cbm_iscntc.s Normal file
View File

@ -0,0 +1 @@
; nothing - ISCNTC is a KERNAL function

19
software/retro1-tests/OSI/msbasic/cbmbasic1.cfg Normal file
View File

@ -0,0 +1,19 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $C000, size = $3F00, fill = no, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
DUMMY: load = DUMMY; # don't include
}

19
software/retro1-tests/OSI/msbasic/cbmbasic2.cfg Normal file
View File

@ -0,0 +1,19 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $C000, size = $3F00, fill = no, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
DUMMY: load = DUMMY; # don't include
}

23
software/retro1-tests/OSI/msbasic/chrget.s Normal file
View File

@ -0,0 +1,23 @@
.segment "CHRGET"
RAMSTART1:
GENERIC_CHRGET:
inc TXTPTR
bne GENERIC_CHRGOT
inc TXTPTR+1
GENERIC_CHRGOT:
GENERIC_TXTPTR = GENERIC_CHRGOT + 1
lda $EA60
.ifdef KBD
jsr LF430
.endif
cmp #$3A
bcs L4058
GENERIC_CHRGOT2:
cmp #$20
beq GENERIC_CHRGET
sec
sbc #$30
sec
sbc #$D0
L4058:
rts

83
software/retro1-tests/OSI/msbasic/defines.s Normal file
View File

@ -0,0 +1,83 @@
.if .def(cbmbasic1)
CBM1 := 1
.include "defines_cbm1.s"
.elseif .def(osi)
OSI := 1
.include "defines_osi.s"
.elseif .def(applesoft)
APPLE := 1
.include "defines_apple.s"
.elseif .def(kb9)
KIM := 1
.include "defines_kim.s"
.elseif .def(cbmbasic2)
CBM2 := 1
.include "defines_cbm2.s"
.elseif .def(kbdbasic)
KBD := 1
.include "defines_kbd.s"
.elseif .def(microtan)
MICROTAN := 1
.include "defines_microtan.s"
.endif
.ifdef CONFIG_2C
CONFIG_2B := 1
.endif
.ifdef CONFIG_2B
CONFIG_2A := 1
.endif
.ifdef CONFIG_2A
CONFIG_2 := 1
.endif
.ifdef CONFIG_2
CONFIG_11A := 1
.endif
.ifdef CONFIG_11A
CONFIG_11 := 1
.endif
.ifdef CONFIG_11
CONFIG_10A := 1
.endif
.ifdef CONFIG_SMALL
BYTES_FP := 4
.else
BYTES_FP := 5
.endif
.ifndef BYTES_PER_ELEMENT
BYTES_PER_ELEMENT := BYTES_FP
.endif
BYTES_PER_VARIABLE := BYTES_FP+2
MANTISSA_BYTES := BYTES_FP-1
BYTES_PER_FRAME := 2*BYTES_FP+8
FOR_STACK1 := 2*BYTES_FP+5
FOR_STACK2 := BYTES_FP+4
.ifndef MAX_EXPON
MAX_EXPON = 10
.endif
STACK := $0100
.ifdef INPUTBUFFER
.if INPUTBUFFER >= $0100
CONFIG_NO_INPUTBUFFER_ZP := 1
.endif
.if INPUTBUFFER = $0200
CONFIG_INPUTBUFFER_0200 := 1
.endif
.endif
INPUTBUFFERX = INPUTBUFFER & $FF00
CR=13
LF=10
.ifndef CRLF_1
CRLF_1 := CR
CRLF_2 := LF
.endif

49
software/retro1-tests/OSI/msbasic/defines_apple.s Normal file
View File

@ -0,0 +1,49 @@
; configuration
CONFIG_11 := 1
APPLE_BAD_BYTE := 1
CONFIG_IO_MSB := 1 ; all I/O has bit #7 set
CONFIG_PRINT_CR := 1 ; print CR when line end reached
CONFIG_SAFE_NAMENOTFOUND := 1
CONFIG_SCRTCH_ORDER := 3
BYTES_PER_ELEMENT := 6 ; XXX override
; zero page
ZP_START1 = $00
ZP_START2 = $4F
ZP_START3 = $0D
ZP_START4 = $55
;extra ZP variables
USR := $000A
; inputbuffer
INPUTBUFFER := $0200
; constants
STACK_TOP := $F8
SPACE_FOR_GOSUB := $36
CRLF_1 := CR
CRLF_2 := $80
WIDTH := 40
WIDTH2 := 14
; memory layout
RAMSTART2 := $2A00
; monitor functions
MONRDKEY := $FD0C
MONCOUT := $FDED
LF689 := $F689
LF800 := $F800
LF819 := $F819
LF828 := $F828
LF864 := $F864
TEX := $FB2F
LFB40 := $FB40
LFD0C := $FD0C
LFD6A := $FD6A
LFECD := $FECD
LFEFD := $FEFD

54
software/retro1-tests/OSI/msbasic/defines_cbm1.s Normal file
View File

@ -0,0 +1,54 @@
; configuration
; oldest known version, no CONFIG_n
CONFIG_CBM_ALL := 1
CONFIG_CBM1_PATCHES := 1 ; ** don't turn off! **
CONFIG_DATAFLG := 1
CONFIG_FILE := 1; support PRINT#, INPUT#, GET#, CMD
CONFIG_NO_CR := 1; terminal doesn't need explicit CRs on line ends
CONFIG_NO_LINE_EDITING := 1; support for "@", "_", BEL etc.
CONFIG_PRINTNULLS := 1; whether PRINTNULLS does anything
CONFIG_SCRTCH_ORDER := 2
; zero page
ZP_START1 = $00
ZP_START2 = $04
ZP_START3 = $5A
ZP_START4 = $65
; extra ZP variables
CURDVC := $0003
TISTR := $0200
Z96 := $020C
USR := GORESTART
; constants
SPACE_FOR_GOSUB := $36
STACK_TOP := $FC
NULL_MAX := $0A
MAX_EXPON := 12 ; XXX override
RAMSTART2 := $0400
; magic memory locations
ENTROPY = $9044
; monitor functions
OPEN := $FFC0
CLOSE := $FFC3
CHKIN := $FFC6
CHKOUT := $FFC9
CLRCH := $FFCC
CHRIN := $FFCF
CHROUT := $FFD2
LOAD := $FFD5
SAVE := $FFD8
VERIFY := $FFDB
SYS := $FFDE
ISCNTC := $FFE1
GETIN := $FFE4
CLALL := $FFE7
LE7F3 := $E7F3; for CBM1
MONCOUT := CHROUT
MONRDKEY := GETIN

60
software/retro1-tests/OSI/msbasic/defines_cbm2.s Normal file
View File

@ -0,0 +1,60 @@
; configuration
CONFIG_2A := 1
CONFIG_CBM_ALL := 1
CONFIG_DATAFLG := 1
CONFIG_EASTER_EGG := 1
CONFIG_FILE := 1; support PRINT#, INPUT#, GET#, CMD
CONFIG_NO_CR := 1; terminal doesn't need explicit CRs on line ends
CONFIG_NO_LINE_EDITING := 1; support for "@", "_", BEL etc.
CONFIG_NO_READ_Y_IS_ZERO_HACK := 1
CONFIG_PEEK_SAVE_LINNUM := 1
CONFIG_SCRTCH_ORDER := 2
; zero page
ZP_START1 = $00
ZP_START2 = $0D
ZP_START3 = $03
ZP_START4 = $13
; extra/override ZP variables
CURDVC := $000E
TISTR := $008D
Z96 := $0096
POSX := $00C6
TXPSV := LASTOP
USR := GORESTART ; XXX
; inputbuffer
INPUTBUFFER := $0200
; constants
SPACE_FOR_GOSUB := $3E
STACK_TOP := $FA
WIDTH := 40
WIDTH2 := 30
RAMSTART2 := $0400
; magic memory locations
ENTROPY = $E844
; monitor functions
OPEN := $FFC0
CLOSE := $FFC3
CHKIN := $FFC6
CHKOUT := $FFC9
CLRCH := $FFCC
CHRIN := $FFCF
CHROUT := $FFD2
LOAD := $FFD5
SAVE := $FFD8
VERIFY := $FFDB
SYS := $FFDE
ISCNTC := $FFE1
GETIN := $FFE4
CLALL := $FFE7
LE7F3 := $E7F3; for CBM1
MONCOUT := CHROUT
MONRDKEY := GETIN

52
software/retro1-tests/OSI/msbasic/defines_kbd.s Normal file
View File

@ -0,0 +1,52 @@
; configuration
CONFIG_2B := 1
CONFIG_NO_POKE := 1
CONFIG_NO_READ_Y_IS_ZERO_HACK := 1
CONFIG_SAFE_NAMENOTFOUND := 1
CONFIG_SCRTCH_ORDER := 3
CONFIG_SMALL := 1
; zero page
ZP_START1 = $00
ZP_START2 = $0F
ZP_START3 = $06
ZP_START4 = $15
; extra/override ZP variables
TXPSV := $0049
JMPADRS := $0093
LOWTRX := $0094 ; $AB also EXPSGN?
Z96 := $0096
Z17 := $06FC
Z18 := $06FD
; inputbuffer
INPUTBUFFER := $0700
; constants
STACK_TOP := $FE
SPACE_FOR_GOSUB := $49
CRLF_1 := LF
CRLF_2 := CR
; magic memory locations
L06FE := $06FE
L6874 := $6874
; memory layout
RAMSTART2 := $0300
CONST_MEMSIZ := $3FFF
; monitor functions
MONCOUT := $FDFA
LC000 := $C000
LC009 := $C009
LDE24 := $DE24
PRIMM := $DE42
LDE48 := $DE48
LDE53 := $DE53
LDE7F := $DE7F
LDE8C := $DE8C

32
software/retro1-tests/OSI/msbasic/defines_kim.s Normal file
View File

@ -0,0 +1,32 @@
; configuration
CONFIG_11A := 1
CONFIG_MONCOUT_DESTROYS_Y := 1
CONFIG_NULL := 1
CONFIG_PRINT_CR := 1 ; print CR when line end reached
CONFIG_RAM := 1
CONFIG_ROR_WORKAROUND := 1
CONFIG_SAFE_NAMENOTFOUND := 1
CONFIG_SCRTCH_ORDER := 2
; zero page
ZP_START1 = $00
ZP_START2 = $15
ZP_START3 = $0A
ZP_START4 = $63
; constants
STACK_TOP := $FC
SPACE_FOR_GOSUB := $36
NULL_MAX := $F2 ; probably different in original version; the image I have seems to be modified; see PDF
WIDTH := 72
WIDTH2 := 56
; magic memory locations
L1800 := $1800
L1873 := $1873
; monitor functions
MONRDKEY := $1E5A
MONCOUT := $1EA0

47
software/retro1-tests/OSI/msbasic/defines_microtan.s Normal file
View File

@ -0,0 +1,47 @@
; configuration
CONFIG_2C := 1
CONFIG_NULL := 1
CONFIG_MONCOUT_DESTROYS_Y := 1
CONFIG_PEEK_SAVE_LINNUM := 1
CONFIG_PRINT_CR := 1 ; print CR when line end reached
CONFIG_ROR_WORKAROUND := 1
CONFIG_SAFE_NAMENOTFOUND := 1
CONFIG_SCRTCH_ORDER := 1
; zero page
ZP_START1 = $17
ZP_START2 = $2F
ZP_START3 = $24
ZP_START4 = $85
;extra ZP variables
USR := $0021
TXPSV := $00BA
; constants
STACK_TOP := $FE
SPACE_FOR_GOSUB := $3E
NULL_MAX := $F0
WIDTH := 80
WIDTH2 := 56
; memory layout
RAMSTART2 := $0400
; monitor functions
MONRDKEY := $E210
MONRDKEY2 := $E213
MONCOUT := $E216
LF000 := $F000
LF003 := $F003
LF006 := $F006
LF009 := $F009
LF00C := $F00C
LF00F := $F00F
LF018 := $F018
LF01B := $F01B
LF01E := $F01E
LF021 := $F021
LFDFA := $FDFA
LFE73 := $FE73
LFE75 := $FE75

37
software/retro1-tests/OSI/msbasic/defines_osi.s Normal file
View File

@ -0,0 +1,37 @@
; configuration
CONFIG_10A := 1
CONFIG_DATAFLG := 1
CONFIG_NULL := 1
CONFIG_PRINT_CR := 1 ; print CR when line end reached
CONFIG_SCRTCH_ORDER := 3
CONFIG_SMALL := 1
; zero page
ZP_START1 = $00
ZP_START2 = $0D
ZP_START3 = $5B
ZP_START4 = $65
;extra ZP variables
USR := $000A
; constants
STACK_TOP := $FC
SPACE_FOR_GOSUB := $33
NULL_MAX := $0A
WIDTH := 72
WIDTH2 := 56
; memory layout
RAMSTART2 := $0300
; magic memory locations
L0200 := $0200
; monitor functions
MONRDKEY := $FFEB
MONCOUT := $FFEE
MONISCNTC := $FFF1
LOAD := $FFF4
SAVE := $FFF7

49
software/retro1-tests/OSI/msbasic/error.s Normal file
View File

@ -0,0 +1,49 @@
init_error_table
.ifdef CONFIG_SMALL
define_error ERR_NOFOR, "NF"
define_error ERR_SYNTAX, "SN"
define_error ERR_NOGOSUB, "RG"
define_error ERR_NODATA, "OD"
define_error ERR_ILLQTY, "FC"
define_error ERR_OVERFLOW, "OV"
define_error ERR_MEMFULL, "OM"
define_error ERR_UNDEFSTAT, "US"
define_error ERR_BADSUBS, "BS"
define_error ERR_REDIMD, "DD"
define_error ERR_ZERODIV, "/0"
define_error ERR_ILLDIR, "ID"
define_error ERR_BADTYPE, "TM"
define_error ERR_STRLONG, "LS"
define_error ERR_FRMCPX, "ST"
define_error ERR_CANTCONT, "CN"
define_error ERR_UNDEFFN, "UF"
.else
define_error ERR_NOFOR, "NEXT WITHOUT FOR"
define_error ERR_SYNTAX, "SYNTAX"
define_error ERR_NOGOSUB, "RETURN WITHOUT GOSUB"
define_error ERR_NODATA, "OUT OF DATA"
define_error ERR_ILLQTY, "ILLEGAL QUANTITY"
.ifdef CBM1
.byte 0,0,0,0,0
.endif
define_error ERR_OVERFLOW, "OVERFLOW"
define_error ERR_MEMFULL, "OUT OF MEMORY"
define_error ERR_UNDEFSTAT, "UNDEF'D STATEMENT"
define_error ERR_BADSUBS, "BAD SUBSCRIPT"
define_error ERR_REDIMD, "REDIM'D ARRAY"
define_error ERR_ZERODIV, "DIVISION BY ZERO"
define_error ERR_ILLDIR, "ILLEGAL DIRECT"
define_error ERR_BADTYPE, "TYPE MISMATCH"
define_error ERR_STRLONG, "STRING TOO LONG"
.ifdef CONFIG_FILE
.ifdef CBM1
define_error ERR_BADDATA, "BAD DATA"
.else
define_error ERR_BADDATA, "FILE DATA"
.endif
.endif
define_error ERR_FRMCPX, "FORMULA TOO COMPLEX"
define_error ERR_CANTCONT, "CAN'T CONTINUE"
define_error ERR_UNDEFFN, "UNDEF'D FUNCTION"
.endif

689
software/retro1-tests/OSI/msbasic/eval.s Normal file
View File

@ -0,0 +1,689 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "NEXT" STATEMENT
; ----------------------------------------------------------------------------
NEXT:
bne NEXT1
ldy #$00
beq NEXT2
NEXT1:
jsr PTRGET
NEXT2:
sta FORPNT
sty FORPNT+1
jsr GTFORPNT
beq NEXT3
ldx #$00
GERR:
beq JERROR
NEXT3:
txs
.ifndef CONFIG_2
inx
inx
inx
inx
.endif
txa
.ifdef CONFIG_2
clc
adc #$04
pha
adc #BYTES_FP+1
sta DEST
pla
.else
inx
inx
inx
inx
inx
.ifndef CONFIG_SMALL
inx
.endif
stx DEST
.endif
ldy #>STACK
jsr LOAD_FAC_FROM_YA
tsx
lda STACK+BYTES_FP+4,x
sta FACSIGN
lda FORPNT
ldy FORPNT+1
jsr FADD
jsr SETFOR
ldy #>STACK
jsr FCOMP2
tsx
sec
sbc STACK+BYTES_FP+4,x
beq L2C22
lda STACK+2*BYTES_FP+5,x
sta CURLIN
lda STACK+2*BYTES_FP+6,x
sta CURLIN+1
lda STACK+2*BYTES_FP+8,x
sta TXTPTR
lda STACK+2*BYTES_FP+7,x
sta TXTPTR+1
L2C1F:
jmp NEWSTT
L2C22:
txa
adc #2*BYTES_FP+7
tax
txs
jsr CHRGOT
cmp #$2C
bne L2C1F
jsr CHRGET
jsr NEXT1
; ----------------------------------------------------------------------------
; EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC
; ----------------------------------------------------------------------------
FRMNUM:
jsr FRMEVL
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS NUMERIC
; ----------------------------------------------------------------------------
CHKNUM:
clc
.byte $24
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS STRING
; ----------------------------------------------------------------------------
CHKSTR:
sec
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS CORRECT TYPE
; IF C=0, TYPE MUST BE NUMERIC
; IF C=1, TYPE MUST BE STRING
; ----------------------------------------------------------------------------
CHKVAL:
bit VALTYP
bmi L2C41
bcs L2C43
L2C40:
rts
L2C41:
bcs L2C40
L2C43:
ldx #ERR_BADTYPE
JERROR:
jmp ERROR
; ----------------------------------------------------------------------------
; EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
; RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC
; EXPRESSIONS.
; ----------------------------------------------------------------------------
FRMEVL:
ldx TXTPTR
bne L2C4E
dec TXTPTR+1
L2C4E:
dec TXTPTR
ldx #$00
.byte $24
FRMEVL1:
pha
txa
pha
lda #$01
jsr CHKMEM
jsr FRM_ELEMENT
lda #$00
sta CPRTYP
FRMEVL2:
jsr CHRGOT
L2C65:
sec
sbc #TOKEN_GREATER
bcc L2C81
cmp #$03
bcs L2C81
cmp #$01
rol a
eor #$01
eor CPRTYP
cmp CPRTYP
bcc SNTXERR
sta CPRTYP
jsr CHRGET
jmp L2C65
L2C81:
ldx CPRTYP
bne FRM_RELATIONAL
bcs L2D02
adc #$07
bcc L2D02
adc VALTYP
bne L2C92
jmp CAT
L2C92:
adc #$FF
sta INDEX
asl a
adc INDEX
tay
FRM_PRECEDENCE_TEST:
pla
cmp MATHTBL,y
bcs FRM_PERFORM1
jsr CHKNUM
L2CA3:
pha
L2CA4:
jsr FRM_RECURSE
pla
ldy LASTOP
bpl PREFNC
tax
beq GOEX
bne FRM_PERFORM2
; ----------------------------------------------------------------------------
; FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
; ----------------------------------------------------------------------------
FRM_RELATIONAL:
lsr VALTYP
txa
rol a
ldx TXTPTR
bne L2CBB
dec TXTPTR+1
L2CBB:
dec TXTPTR
ldy #$1B
sta CPRTYP
bne FRM_PRECEDENCE_TEST
PREFNC:
cmp MATHTBL,y
bcs FRM_PERFORM2
bcc L2CA3
; ----------------------------------------------------------------------------
; STACK THIS OPERATION AND CALL FRMEVL FOR
; ANOTHER ONE
; ----------------------------------------------------------------------------
FRM_RECURSE:
lda MATHTBL+2,y
pha
lda MATHTBL+1,y
pha
jsr FRM_STACK1
lda CPRTYP
jmp FRMEVL1
SNTXERR:
jmp SYNERR
; ----------------------------------------------------------------------------
; STACK (FAC)
; THREE ENTRY POINTS:
; 1, FROM FRMEVL
; 2, FROM "STEP"
; 3, FROM "FOR"
; ----------------------------------------------------------------------------
FRM_STACK1:
lda FACSIGN
ldx MATHTBL,y
; ----------------------------------------------------------------------------
; ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
; ----------------------------------------------------------------------------
FRM_STACK2:
tay
pla
sta INDEX
.ifndef CONFIG_2B
inc INDEX ; bug: assumes not on page boundary
; bug exists on AppleSoft II
.endif
pla
sta INDEX+1
.ifdef CONFIG_2B
inc INDEX
bne LEB69
inc INDEX+1
LEB69:
.endif
tya
pha
; ----------------------------------------------------------------------------
; ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
; TO PUSH INITIAL VALUE OF "FOR" VARIABLE
; ----------------------------------------------------------------------------
FRM_STACK3:
jsr ROUND_FAC
.ifndef CONFIG_SMALL
lda FAC+4
pha
.endif
lda FAC+3
pha
lda FAC+2
pha
lda FAC+1
pha
lda FAC
pha
jmp (INDEX)
L2D02:
ldy #$FF
pla
GOEX:
beq EXIT
; ----------------------------------------------------------------------------
; PERFORM STACKED OPERATION
;
; (A) = PRECEDENCE BYTE
; STACK: 1 -- CPRMASK
; 5 -- (ARG)
; 2 -- ADDR OF PERFORMER
; ----------------------------------------------------------------------------
FRM_PERFORM1:
cmp #$64
beq L2D0E
jsr CHKNUM
L2D0E:
sty LASTOP
FRM_PERFORM2:
pla
lsr a
sta CPRMASK
pla
sta ARG
pla
sta ARG+1
pla
sta ARG+2
pla
sta ARG+3
pla
.ifndef CONFIG_SMALL
sta ARG+4
pla
.endif
sta ARGSIGN
eor FACSIGN
sta SGNCPR
EXIT:
lda FAC
rts
; ----------------------------------------------------------------------------
; GET ELEMENT IN EXPRESSION
;
; GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
; TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
; ----------------------------------------------------------------------------
FRM_ELEMENT:
lda #$00
sta VALTYP
L2D31:
jsr CHRGET
bcs L2D39
L2D36:
jmp FIN
L2D39:
jsr ISLETC
bcs FRM_VARIABLE
.ifdef CONFIG_CBM_ALL
cmp #$FF
bne LCDC1
lda #<CON_PI
ldy #>CON_PI
jsr LOAD_FAC_FROM_YA
jmp CHRGET
CON_PI:
.byte $82,$49,$0f,$DA,$A1
LCDC1:
.endif
cmp #$2E
beq L2D36
cmp #TOKEN_MINUS
beq MIN
cmp #TOKEN_PLUS
beq L2D31
cmp #$22
bne NOT_
; ----------------------------------------------------------------------------
; STRING CONSTANT ELEMENT
;
; SET Y,A = (TXTPTR)+CARRY
; ----------------------------------------------------------------------------
STRTXT:
lda TXTPTR
ldy TXTPTR+1
adc #$00
bcc L2D57
iny
L2D57:
jsr STRLIT
jmp POINT
; ----------------------------------------------------------------------------
; "NOT" FUNCTION
; IF FAC=0, RETURN FAC=1
; IF FAC<>0, RETURN FAC=0
; ----------------------------------------------------------------------------
NOT_:
cmp #TOKEN_NOT
bne L2D74
ldy #$18
bne EQUL
; ----------------------------------------------------------------------------
; COMPARISON FOR EQUALITY (= OPERATOR)
; ALSO USED TO EVALUATE "NOT" FUNCTION
; ----------------------------------------------------------------------------
EQUOP:
jsr AYINT
lda FAC_LAST
eor #$FF
tay
lda FAC_LAST-1
eor #$FF
jmp GIVAYF
L2D74:
cmp #TOKEN_FN
bne L2D7B
jmp L31F3
L2D7B:
cmp #TOKEN_SGN
bcc PARCHK
jmp UNARY
; ----------------------------------------------------------------------------
; EVALUATE "(EXPRESSION)"
; ----------------------------------------------------------------------------
PARCHK:
jsr CHKOPN
jsr FRMEVL
CHKCLS:
lda #$29
.byte $2C
CHKOPN:
lda #$28
.byte $2C
CHKCOM:
lda #$2C
; ----------------------------------------------------------------------------
; UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
; ----------------------------------------------------------------------------
SYNCHR: ; XXX all CBM code calls SYNCHR instead of CHKCOM
ldy #$00
cmp (TXTPTR),y
bne SYNERR
jmp CHRGET
; ----------------------------------------------------------------------------
SYNERR:
ldx #ERR_SYNTAX
jmp ERROR
; ----------------------------------------------------------------------------
MIN:
ldy #$15
EQUL:
pla
pla
jmp L2CA4
; ----------------------------------------------------------------------------
FRM_VARIABLE:
jsr PTRGET
FRM_VARIABLE_CALL = *-1
sta FAC_LAST-1
sty FAC_LAST
.ifdef CONFIG_CBM_ALL
lda VARNAM
ldy VARNAM+1
.endif
ldx VALTYP
beq L2DB1
.ifdef CONFIG_CBM_ALL
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH2
clc
LCE3B:
.else
ldx #$00
stx STRNG1+1
bit FAC+4
bpl LCE53
cmp #$54 ; T
bne LCE53
.endif
cpy #$C9 ; I$
bne LCE53
jsr LCE76
sty EXPON
dey
sty STRNG2
ldy #$06
sty INDX
ldy #$24
jsr LDD3A
jmp LD353
LCE53:
.endif
.ifdef CONFIG_2
.ifndef CBM2
; bugfix?
; fixed on AppleSoft II, not on any CBM
ldx #$00
stx STRNG1+1
.endif
.endif
rts
L2DB1:
.ifndef CONFIG_SMALL
ldx VALTYP+1
bpl L2DC2
ldy #$00
lda (FAC+3),y
tax
iny
lda (FAC+3),y
tay
txa
jmp GIVAYF
L2DC2:
.endif
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH3
.byte $19
.endif
.ifdef CBM2
bit FAC+4
bpl LCE90
cmp #$54
bne LCE82
.endif
.ifndef CONFIG_CBM_ALL
jmp LOAD_FAC_FROM_YA
.endif
.ifdef CONFIG_CBM_ALL
LCE69:
cpy #$49
.ifdef CBM1
bne LCE82
.else
bne LCE90
.endif
jsr LCE76
tya
ldx #$A0
jmp LDB21
LCE76:
.ifdef CBM1
lda #$FE
ldy #$01
.else
lda #$8B
ldy #$00
.endif
sei
jsr LOAD_FAC_FROM_YA
cli
sty FAC+1
rts
LCE82:
cmp #$53
bne LCE90
cpy #$54
bne LCE90
lda Z96
jmp FLOAT
LCE90:
lda FAC+3
ldy FAC+4
jmp LOAD_FAC_FROM_YA
.endif
; ----------------------------------------------------------------------------
UNARY:
asl a
pha
tax
jsr CHRGET
cpx #<(TOKEN_LEFTSTR*2-1)
bcc L2DEF
jsr CHKOPN
jsr FRMEVL
jsr CHKCOM
jsr CHKSTR
pla
tax
lda FAC_LAST
pha
lda FAC_LAST-1
pha
txa
pha
jsr GETBYT
pla
tay
txa
pha
jmp L2DF4
L2DEF:
jsr PARCHK
pla
tay
L2DF4:
lda UNFNC-TOKEN_SGN-TOKEN_SGN+$100,y
sta JMPADRS+1
lda UNFNC-TOKEN_SGN-TOKEN_SGN+$101,y
sta JMPADRS+2
.ifdef KBD
jsr LF47D
.else
jsr JMPADRS
.endif
jmp CHKNUM
; ----------------------------------------------------------------------------
OR:
ldy #$FF
.byte $2C
; ----------------------------------------------------------------------------
TAND:
ldy #$00
sty EOLPNTR
jsr AYINT
lda FAC_LAST-1
eor EOLPNTR
sta CHARAC
lda FAC_LAST
eor EOLPNTR
sta ENDCHR
jsr COPY_ARG_TO_FAC
jsr AYINT
lda FAC_LAST
eor EOLPNTR
and ENDCHR
eor EOLPNTR
tay
lda FAC_LAST-1
eor EOLPNTR
and CHARAC
eor EOLPNTR
jmp GIVAYF
; ----------------------------------------------------------------------------
; PERFORM RELATIONAL OPERATIONS
; ----------------------------------------------------------------------------
RELOPS:
jsr CHKVAL
bcs STRCMP
lda ARGSIGN
ora #$7F
and ARG+1
sta ARG+1
lda #<ARG
ldy #$00
jsr FCOMP
tax
jmp NUMCMP
; ----------------------------------------------------------------------------
; STRING COMPARISON
; ----------------------------------------------------------------------------
STRCMP:
lda #$00
sta VALTYP
dec CPRTYP
jsr FREFAC
sta FAC
stx FAC+1
sty FAC+2
lda ARG_LAST-1
ldy ARG_LAST
jsr FRETMP
stx ARG_LAST-1
sty ARG_LAST
tax
sec
sbc FAC
beq L2E74
lda #$01
bcc L2E74
ldx FAC
lda #$FF
L2E74:
sta FACSIGN
ldy #$FF
inx
STRCMP1:
iny
dex
bne L2E84
ldx FACSIGN
NUMCMP:
bmi CMPDONE
clc
bcc CMPDONE
L2E84:
lda (ARG_LAST-1),y
cmp (FAC+1),y
beq STRCMP1
ldx #$FF
bcs CMPDONE
ldx #$01
CMPDONE:
inx
txa
rol a
and CPRMASK
beq L2E99
lda #$FF
L2E99:
jmp FLOAT

21
software/retro1-tests/OSI/msbasic/extra.s Normal file
View File

@ -0,0 +1,21 @@
.segment "EXTRA"
.ifdef KIM
.include "kim_extra.s"
.endif
.ifdef CONFIG_CBM1_PATCHES
.include "cbm1_patches.s"
.endif
.ifdef KBD
.include "kbd_extra.s"
.endif
.ifdef APPLE
.include "apple_extra.s"
.endif
.ifdef MICROTAN
.include "microtan_extra.s"
.endif

1884
software/retro1-tests/OSI/msbasic/float.s Normal file
View File

File diff suppressed because it is too large Load Diff

321
software/retro1-tests/OSI/msbasic/flow1.s Normal file
View File

@ -0,0 +1,321 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "FOR" STATEMENT
;
; FOR PUSHES 18 BYTES ON THE STACK:
; 2 -- TXTPTR
; 2 -- LINE NUMBER
; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
; 1 -- STEP SIGN
; 5 -- STEP VALUE
; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
; 1 -- FOR TOKEN ($81)
; ----------------------------------------------------------------------------
FOR:
lda #$80
sta SUBFLG
jsr LET
jsr GTFORPNT
bne L2619
txa
adc #FOR_STACK1
tax
txs
L2619:
pla
pla
lda #FOR_STACK2
jsr CHKMEM
jsr DATAN
clc
tya
adc TXTPTR
pha
lda TXTPTR+1
adc #$00
pha
lda CURLIN+1
pha
lda CURLIN
pha
lda #TOKEN_TO
jsr SYNCHR
jsr CHKNUM
jsr FRMNUM
lda FACSIGN
ora #$7F
and FAC+1
sta FAC+1
lda #<STEP
ldy #>STEP
sta INDEX
sty INDEX+1
jmp FRM_STACK3
; ----------------------------------------------------------------------------
; "STEP" PHRASE OF "FOR" STATEMENT
; ----------------------------------------------------------------------------
STEP:
lda #<CON_ONE
ldy #>CON_ONE
jsr LOAD_FAC_FROM_YA
jsr CHRGOT
cmp #TOKEN_STEP
bne L2665
jsr CHRGET
jsr FRMNUM
L2665:
jsr SIGN
jsr FRM_STACK2
lda FORPNT+1
pha
lda FORPNT
pha
lda #$81
pha
; ----------------------------------------------------------------------------
; PERFORM NEXT STATEMENT
; ----------------------------------------------------------------------------
NEWSTT:
jsr ISCNTC
lda TXTPTR
ldy TXTPTR+1
.if .def(CONFIG_NO_INPUTBUFFER_ZP) && .def(CONFIG_2)
cpy #>INPUTBUFFER
.ifdef CBM2
nop
.endif
beq LC6D4
.else
; BUG on AppleSoft I,
; fixed differently on AppleSoft II (ldx/inx)
beq L2683
.endif
sta OLDTEXT
sty OLDTEXT+1
LC6D4:
ldy #$00
L2683:
lda (TXTPTR),y
.ifndef CONFIG_11
beq LA5DC ; old: 1 cycle more on generic case
cmp #$3A
beq NEWSTT2
SYNERR1:
jmp SYNERR
LA5DC:
.else
bne COLON; new: 1 cycle more on ":" case
.endif
ldy #$02
lda (TXTPTR),y
clc
.ifdef CONFIG_2
jeq L2701
.else
beq L2701
.endif
iny
lda (TXTPTR),y
sta CURLIN
iny
lda (TXTPTR),y
sta CURLIN+1
tya
adc TXTPTR
sta TXTPTR
bcc NEWSTT2
inc TXTPTR+1
NEWSTT2:
jsr CHRGET
jsr EXECUTE_STATEMENT
jmp NEWSTT
; ----------------------------------------------------------------------------
; EXECUTE A STATEMENT
;
; (A) IS FIRST CHAR OF STATEMENT
; CARRY IS SET
; ----------------------------------------------------------------------------
EXECUTE_STATEMENT:
.ifndef CONFIG_11A
beq RET1
.else
beq RET2
.endif
.ifndef CONFIG_11
sec
.endif
EXECUTE_STATEMENT1:
sbc #$80
.ifndef CONFIG_11
jcc LET ; old: 1 cycle more on instr.
.else
bcc LET1; new: 1 cycle more on assignment
.endif
cmp #NUM_TOKENS
.ifdef CONFIG_2
bcs LC721
.else
bcs SYNERR1
.endif
asl a
tay
lda TOKEN_ADDRESS_TABLE+1,y
pha
lda TOKEN_ADDRESS_TABLE,y
pha
jmp CHRGET
.ifdef CONFIG_11
LET1:
jmp LET
COLON:
cmp #$3A
beq NEWSTT2
SYNERR1:
jmp SYNERR
.endif
.ifdef CONFIG_2; GO TO
LC721:
cmp #TOKEN_GO-$80
bne SYNERR1
jsr CHRGET
lda #TOKEN_TO
jsr SYNCHR
jmp GOTO
.endif
; ----------------------------------------------------------------------------
; "RESTORE" STATEMENT
; ----------------------------------------------------------------------------
RESTORE:
sec
lda TXTTAB
sbc #$01
ldy TXTTAB+1
bcs SETDA
dey
SETDA:
sta DATPTR
sty DATPTR+1
RET2:
rts
.include "iscntc.s"
;!!! runs into "STOP"
; ----------------------------------------------------------------------------
; "STOP" STATEMENT
; ----------------------------------------------------------------------------
STOP:
bcs END2
; ----------------------------------------------------------------------------
; "END" STATEMENT
; ----------------------------------------------------------------------------
END:
clc
END2:
bne RET1
lda TXTPTR
ldy TXTPTR+1
.if .def(CONFIG_NO_INPUTBUFFER_ZP) && .def(CONFIG_2)
; BUG on AppleSoft I
; fix exists on AppleSoft II
; TXTPTR+1 will always be > 0
ldx CURLIN+1
inx
.endif
beq END4
sta OLDTEXT
sty OLDTEXT+1
CONTROL_C_TYPED:
lda CURLIN
ldy CURLIN+1
sta OLDLIN
sty OLDLIN+1
END4:
pla
pla
L2701:
lda #<QT_BREAK
ldy #>QT_BREAK
.ifndef KBD
ldx #$00
stx Z14
.endif
bcc L270E
jmp PRINT_ERROR_LINNUM
L270E:
jmp RESTART
.ifdef KBD
LE664:
tay
jmp SNGFLT
.endif
; ----------------------------------------------------------------------------
; "CONT" COMMAND
; ----------------------------------------------------------------------------
CONT:
bne RET1
ldx #ERR_CANTCONT
ldy OLDTEXT+1
bne L271C
jmp ERROR
L271C:
lda OLDTEXT
sta TXTPTR
sty TXTPTR+1
lda OLDLIN
ldy OLDLIN+1
sta CURLIN
sty CURLIN+1
RET1:
rts
.ifdef KBD
PRT:
jsr GETBYT
txa
; not ROR bug safe
ror a
ror a
ror a
sta $8F
rts
LE68C:
ldy #$12
LE68E:
lda LEA30,y
sta $03A2,y
dey
bpl LE68E
rts
.endif
.if .def(CONFIG_NULL) || .def(CONFIG_PRINTNULLS)
; CBM1 has the keyword removed,
; but the code is still here
NULL:
jsr GETBYT
bne RET1
inx
cpx #NULL_MAX
bcs L2739
dex
stx Z15
rts
L2739:
jmp IQERR
.endif
.ifndef CONFIG_11A
CLEAR:
bne RET1
jmp CLEARC
.endif

215
software/retro1-tests/OSI/msbasic/flow2.s Normal file
View File

@ -0,0 +1,215 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "RUN" COMMAND
; ----------------------------------------------------------------------------
RUN:
bne L27CF
jmp SETPTRS
L27CF:
jsr CLEARC
jmp L27E9
; ----------------------------------------------------------------------------
; "GOSUB" STATEMENT
;
; LEAVES 7 BYTES ON STACK:
; 2 -- RETURN ADDRESS (NEWSTT)
; 2 -- TXTPTR
; 2 -- LINE #
; 1 -- GOSUB TOKEN
; ----------------------------------------------------------------------------
GOSUB:
lda #$03
jsr CHKMEM
lda TXTPTR+1
pha
lda TXTPTR
pha
lda CURLIN+1
pha
lda CURLIN
pha
lda #TOKEN_GOSUB
pha
L27E9:
jsr CHRGOT
jsr GOTO
jmp NEWSTT
; ----------------------------------------------------------------------------
; "GOTO" STATEMENT
; ALSO USED BY "RUN" AND "GOSUB"
; ----------------------------------------------------------------------------
GOTO:
jsr LINGET
jsr REMN
lda CURLIN+1
cmp LINNUM+1
bcs L2809
tya
sec
adc TXTPTR
ldx TXTPTR+1
bcc L280D
inx
bcs L280D
L2809:
lda TXTTAB
ldx TXTTAB+1
L280D:
.ifdef KBD
jsr LF457
bne UNDERR
.else
jsr FL1
bcc UNDERR
.endif
lda LOWTRX
sbc #$01
sta TXTPTR
lda LOWTRX+1
sbc #$00
sta TXTPTR+1
L281E:
rts
; ----------------------------------------------------------------------------
; "POP" AND "RETURN" STATEMENTS
; ----------------------------------------------------------------------------
POP:
bne L281E
lda #$FF
.ifdef CONFIG_2A
sta FORPNT+1 ; bugfix, wrong in AppleSoft II
.else
sta FORPNT
.endif
jsr GTFORPNT
txs
cmp #TOKEN_GOSUB
beq RETURN
ldx #ERR_NOGOSUB
.byte $2C
UNDERR:
ldx #ERR_UNDEFSTAT
jmp ERROR
; ----------------------------------------------------------------------------
SYNERR2:
jmp SYNERR
; ----------------------------------------------------------------------------
RETURN:
pla
pla
sta CURLIN
pla
sta CURLIN+1
pla
sta TXTPTR
pla
sta TXTPTR+1
; ----------------------------------------------------------------------------
; "DATA" STATEMENT
; EXECUTED BY SKIPPING TO NEXT COLON OR EOL
; ----------------------------------------------------------------------------
DATA:
jsr DATAN
; ----------------------------------------------------------------------------
; ADD (Y) TO TXTPTR
; ----------------------------------------------------------------------------
ADDON:
tya
clc
adc TXTPTR
sta TXTPTR
bcc L2852
inc TXTPTR+1
L2852:
rts
; ----------------------------------------------------------------------------
; SCAN AHEAD TO NEXT ":" OR EOL
; ----------------------------------------------------------------------------
DATAN:
ldx #$3A
.byte $2C
REMN:
ldx #$00
stx CHARAC
ldy #$00
sty ENDCHR
L285E:
lda ENDCHR
ldx CHARAC
sta CHARAC
stx ENDCHR
L2866:
lda (TXTPTR),y
beq L2852
cmp ENDCHR
beq L2852
iny
cmp #$22
.ifndef CONFIG_11
beq L285E; old: swap & cont is faster
bne L2866
.else
bne L2866; new: cont is faster
beq L285E
.endif
; ----------------------------------------------------------------------------
; "IF" STATEMENT
; ----------------------------------------------------------------------------
IF:
jsr FRMEVL
jsr CHRGOT
cmp #TOKEN_GOTO
beq L2884
lda #TOKEN_THEN
jsr SYNCHR
L2884:
lda FAC
bne L288D
; ----------------------------------------------------------------------------
; "REM" STATEMENT, OR FALSE "IF" STATEMENT
; ----------------------------------------------------------------------------
REM:
jsr REMN
beq ADDON
L288D:
jsr CHRGOT
bcs L2895
jmp GOTO
L2895:
jmp EXECUTE_STATEMENT
; ----------------------------------------------------------------------------
; "ON" STATEMENT
;
; ON <EXP> GOTO <LIST>
; ON <EXP> GOSUB <LIST>
; ----------------------------------------------------------------------------
ON:
jsr GETBYT
pha
cmp #TOKEN_GOSUB
beq L28A4
L28A0:
cmp #TOKEN_GOTO
bne SYNERR2
L28A4:
dec FAC_LAST
bne L28AC
pla
jmp EXECUTE_STATEMENT1
L28AC:
jsr CHRGET
jsr LINGET
cmp #$2C
beq L28A4
pla
L28B7:
rts

5
software/retro1-tests/OSI/msbasic/header.s Normal file
View File

@ -0,0 +1,5 @@
.segment "HEADER"
.ifdef KBD
jmp LE68C
.byte $00,$13,$56
.endif

443
software/retro1-tests/OSI/msbasic/init.s Normal file
View File

@ -0,0 +1,443 @@
.segment "INIT"
.ifdef KBD
FNDLIN2:
php
jmp FNDLIN
.endif
; ----------------------------------------------------------------------------
PR_WRITTEN_BY:
.ifndef KBD
.ifndef CONFIG_CBM_ALL
lda #<QT_WRITTEN_BY
ldy #>QT_WRITTEN_BY
jsr STROUT
.endif
.endif
COLD_START:
.ifdef KBD
lda #<LFD81
sta $03A0
lda #>LFD81
sta $03A1
lda #$20
sta $0480
lda $0352
sta $04
lda $0353
sta $05
.else
.ifndef CBM2
ldx #$FF
stx CURLIN+1
.endif
.ifdef CONFIG_NO_INPUTBUFFER_ZP
ldx #$FB
.endif
txs
.ifndef CONFIG_CBM_ALL
lda #<COLD_START
ldy #>COLD_START
sta GORESTART+1
sty GORESTART+2
sta GOSTROUT+1
sty GOSTROUT+2
lda #<AYINT
ldy #>AYINT
sta GOAYINT
sty GOAYINT+1
lda #<GIVAYF
ldy #>GIVAYF
sta GOGIVEAYF
sty GOGIVEAYF+1
.endif
lda #$4C
.ifdef CONFIG_CBM_ALL
sta JMPADRS
.endif
sta GORESTART
.ifndef CONFIG_CBM_ALL
sta GOSTROUT
sta JMPADRS
.endif
.if (!.def(CONFIG_RAM)) && (!.def(CONFIG_CBM_ALL))
sta USR
.endif
.ifndef CONFIG_RAM
.ifdef APPLE
lda #<USR_FUNC
ldy #>USR_FUNC
.else
lda #<IQERR
ldy #>IQERR
.endif
sta USR+1
sty USR+2
.endif
.ifndef CBM1
lda #WIDTH
sta Z17
lda #WIDTH2
sta Z18
.endif
.endif
; All non-CONFIG_SMALL versions of BASIC have
; the same bug here: While the number of bytes
; to be copied is correct for CONFIG_SMALL,
; it is one byte short on non-CONFIG_SMALL:
; It seems the "ldx" value below has been
; hardcoded. So on these configurations,
; the last byte of GENERIC_RNDSEED, which
; is 5 bytes instead of 4, does not get copied -
; which is nothing major, because it is just
; the least significant 8 bits of the mantissa
; of the random number seed.
; KBD added three bytes to CHRGET and removed
; the random number seed, but only adjusted
; the number of bytes by adding 3 - this
; copies four bytes too many, which is no
; problem.
.ifdef CONFIG_SMALL
.ifdef KBD
ldx #GENERIC_CHRGET_END-GENERIC_CHRGET+4
.else
ldx #GENERIC_CHRGET_END-GENERIC_CHRGET
.endif
.else
ldx #GENERIC_CHRGET_END-GENERIC_CHRGET-1 ; XXX
.endif
L4098:
lda GENERIC_CHRGET-1,x
sta CHRGET-1,x
dex
bne L4098
.ifdef CONFIG_2
lda #$03
sta DSCLEN
.endif
.ifndef KBD
txa
sta SHIFTSIGNEXT
.ifdef CONFIG_CBM_ALL
sta CURDVC
.endif
sta LASTPT+1
.if .defined(CONFIG_NULL) || .defined(CONFIG_PRINTNULLS)
sta Z15
.endif
.ifndef CONFIG_11
sta POSX
.endif
pha
sta Z14
.ifndef CBM2
.ifndef MICROTAN
lda #$03
sta DSCLEN
.endif
.ifndef CONFIG_11
lda #$2C
sta LINNUM+1
.endif
jsr CRDO
.endif
.ifdef CBM2
inx
stx INPUTBUFFER-3
stx INPUTBUFFER-4
.endif
.ifdef APPLE
lda #$01
sta INPUTBUFFER-3
sta INPUTBUFFER-4
.endif
ldx #TEMPST
stx TEMPPT
.ifndef CONFIG_CBM_ALL
lda #<QT_MEMORY_SIZE
ldy #>QT_MEMORY_SIZE
jsr STROUT
.ifdef APPLE
jsr INLINX
.else
jsr NXIN
.endif
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
cmp #$41
beq PR_WRITTEN_BY
tay
bne L40EE
.endif
.ifndef CBM2
lda #<RAMSTART2
.endif
ldy #>RAMSTART2
.ifdef CONFIG_2
sta TXTTAB
sty TXTTAB+1
.endif
sta LINNUM
sty LINNUM+1
.ifdef CBM2
tay
.else
ldy #$00
.endif
L40D7:
inc LINNUM
bne L40DD
inc LINNUM+1
.ifdef CBM1
; CBM: hard RAM top limit is $8000
lda LINNUM+1
cmp #$80
beq L40FA
.endif
.ifdef CBM2
; optimized version of the CBM1 code
bmi L40FA
.endif
L40DD:
.ifdef CONFIG_2
lda #$55 ; 01010101 / 10101010
.else
lda #$92 ; 10010010 / 00100100
.endif
sta (LINNUM),y
cmp (LINNUM),y
bne L40FA
asl a
sta (LINNUM),y
cmp (LINNUM),y
.ifdef CONFIG_CBM_ALL
beq L40D7
.else
.ifndef CONFIG_11
beq L40D7; old: faster
bne L40FA
.else
bne L40FA; new: slower
beq L40D7
.endif
L40EE:
jsr CHRGOT
jsr LINGET
tay
beq L40FA
jmp SYNERR
.endif
L40FA:
lda LINNUM
ldy LINNUM+1
sta MEMSIZ
sty MEMSIZ+1
.ifndef MICROTAN
sta FRETOP
sty FRETOP+1
.endif
L4106:
.ifndef CONFIG_CBM_ALL
.ifdef APPLE
lda #$FF
jmp L2829
.word STROUT ; PATCH!
jsr NXIN
.else
lda #<QT_TERMINAL_WIDTH
ldy #>QT_TERMINAL_WIDTH
jsr STROUT
jsr NXIN
.endif
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
tay
beq L4136
jsr LINGET
lda LINNUM+1
bne L4106
lda LINNUM
cmp #$10
bcc L4106
L2829:
sta Z17
L4129:
sbc #$0E
bcs L4129
eor #$FF
sbc #$0C
clc
adc Z17
sta Z18
.endif
L4136:
.ifdef CONFIG_RAM
lda #<QT_WANT
ldy #>QT_WANT
jsr STROUT
jsr NXIN
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
ldx #<RAMSTART1
ldy #>RAMSTART1
cmp #'Y'
beq L4183
cmp #'A'
beq L4157
cmp #'N'
bne L4136
L4157:
ldx #<IQERR
ldy #>IQERR
stx UNFNC_ATN
sty UNFNC_ATN+1
ldx #<ATN ; overwrite starting
ldy #>ATN ; with ATN
cmp #'A'
beq L4183
ldx #<IQERR
ldy #>IQERR
stx UNFNC_COS
sty UNFNC_COS+1
stx UNFNC_TAN
sty UNFNC_TAN+1
stx UNFNC_SIN
sty UNFNC_SIN+1
ldx #<SIN_COS_TAN_ATN ; overwrite
ldy #>SIN_COS_TAN_ATN ; all of trig.s
L4183:
.else
ldx #<RAMSTART2
ldy #>RAMSTART2
.endif
stx TXTTAB
sty TXTTAB+1
ldy #$00
tya
sta (TXTTAB),y
inc TXTTAB
.ifndef CBM2
bne L4192
inc TXTTAB+1
L4192:
.endif
.if CONFIG_SCRTCH_ORDER = 1
jsr SCRTCH
.endif
lda TXTTAB
ldy TXTTAB+1
jsr REASON
.ifdef CBM2
lda #<QT_BASIC
ldy #>QT_BASIC
jsr STROUT
.else
jsr CRDO
.endif
lda MEMSIZ
sec
sbc TXTTAB
tax
lda MEMSIZ+1
sbc TXTTAB+1
jsr LINPRT
lda #<QT_BYTES_FREE
ldy #>QT_BYTES_FREE
jsr STROUT
.if CONFIG_SCRTCH_ORDER = 2
jsr SCRTCH
.endif
.ifdef CONFIG_CBM_ALL
jmp RESTART
.else
lda #<STROUT
ldy #>STROUT
sta GOSTROUT+1
sty GOSTROUT+2
.if CONFIG_SCRTCH_ORDER = 3
jsr SCRTCH
.endif
lda #<RESTART
ldy #>RESTART
sta GORESTART+1
sty GORESTART+2
jmp (GORESTART+1)
.endif
.if .def(CONFIG_RAM) || .def(OSI)
; OSI is compiled for ROM, but includes
; this unused string
QT_WANT:
.byte "WANT SIN-COS-TAN-ATN"
.byte 0
.endif
QT_WRITTEN_BY:
.ifndef CONFIG_CBM_ALL
.ifdef APPLE
asc80 "COPYRIGHT 1977 BY MICROSOFT CO"
.byte CR,0
.else
.byte CR,LF,$0C ; FORM FEED
.ifndef CONFIG_11
.byte "WRITTEN BY RICHARD W. WEILAND."
.else
.byte "WRITTEN BY WEILAND & GATES"
.endif
.byte CR,LF,0
.endif
QT_MEMORY_SIZE:
.byte "MEMORY SIZE"
.byte 0
QT_TERMINAL_WIDTH:
.byte "TERMINAL WIDTH"
.byte 0
.endif
QT_BYTES_FREE:
.byte " BYTES FREE"
.ifdef CBM1
.elseif .def(CBM2)
.byte CR,0
.elseif .def(APPLE)
.byte 0
.else
.byte CR,LF,CR,LF
.endif
QT_BASIC:
.ifdef OSI
.byte "OSI 6502 BASIC VERSION 1.0 REV 3.2"
.endif
.ifdef KIM
.byte "MOS TECH 6502 BASIC V1.1"
.endif
.ifdef MICROTAN
.byte "MICROTAN BASIC"
.endif
.ifdef CBM1
.byte $13 ; HOME
.byte "*** COMMODORE BASIC ***"
.byte $11,$11,$11,0 ; DOWN/DOWN/DOWN
.endif
.ifdef CBM2
.byte "### COMMODORE BASIC ###"
.byte CR,CR,0
.endif
.ifdef APPLE
.byte LF,CR,LF
.byte "APPLE BASIC V1.1"
.endif
.ifndef CONFIG_CBM_ALL
.byte CR,LF
.ifdef MICROTAN
.byte "(C) 1980 MICROSOFT"
.else
.byte "COPYRIGHT 1977 BY MICROSOFT CO."
.endif
.byte CR,LF,0
.endif
.endif

133
software/retro1-tests/OSI/msbasic/inline.s Normal file
View File

@ -0,0 +1,133 @@
.segment "CODE"
.ifndef CONFIG_NO_INPUTBUFFER_ZP
L2420:
.ifdef OSI
jsr OUTDO
.endif
dex
bpl INLIN2
L2423:
.ifdef OSI
jsr OUTDO
.endif
jsr CRDO
.endif
; ----------------------------------------------------------------------------
; READ A LINE, AND STRIP OFF SIGN BITS
; ----------------------------------------------------------------------------
.ifndef KBD
INLIN:
.ifdef APPLE
ldx #$DD
INLIN1:
stx $33
jsr L2900
cpx #$EF
bcs L0C32
ldx #$EF
L0C32:
lda #$00
sta INPUTBUFFER,x
ldx #<INPUTBUFFER-1
ldy #>INPUTBUFFER-1
rts
.endif
.ifndef APPLE
ldx #$00
INLIN2:
jsr GETLN
.ifndef CONFIG_NO_LINE_EDITING
cmp #$07
beq L2443
.endif
cmp #$0D
beq L2453
.ifndef CONFIG_NO_LINE_EDITING
cmp #$20
bcc INLIN2
.ifdef MICROTAN
cmp #$80
.else
cmp #$7D
.endif
bcs INLIN2
cmp #$40 ; @
beq L2423
.ifdef MICROTAN
cmp #$7F ; DEL
.else
cmp #$5F ; _
.endif
beq L2420
L2443:
.ifdef MICROTAN
cpx #$4F
.else
cpx #$47
.endif
bcs L244C
.endif
sta INPUTBUFFER,x
inx
.ifdef OSI
.byte $2C
.else
bne INLIN2
.endif
L244C:
.ifndef CONFIG_NO_LINE_EDITING
lda #$07 ; BEL
jsr OUTDO
bne INLIN2
.endif
L2453:
jmp L29B9
.endif
.endif
.ifndef KBD
.ifndef APPLE
GETLN:
.ifdef CONFIG_FILE
jsr CHRIN
ldy CURDVC
bne L2465
.else
jsr MONRDKEY
.endif
.ifdef OSI
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
and #$7F
.endif
.endif
.ifdef APPLE
RDKEY:
jsr LFD0C
and #$7F
.endif
cmp #$0F
bne L2465
pha
lda Z14
eor #$FF
sta Z14
pla
L2465:
rts
.endif

429
software/retro1-tests/OSI/msbasic/input.s Normal file
View File

@ -0,0 +1,429 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; INPUT CONVERSION ERROR: ILLEGAL CHARACTER
; IN NUMERIC FIELD. MUST DISTINGUISH
; BETWEEN INPUT, READ, AND GET
; ----------------------------------------------------------------------------
INPUTERR:
lda INPUTFLG
beq RESPERR ; INPUT
.ifndef CONFIG_SMALL
.ifdef CONFIG_10A
; without this, it treats GET errors
; like READ errors
bmi L2A63 ; READ
ldy #$FF ; GET
bne L2A67
L2A63:
.endif
.endif
.ifdef CONFIG_CBM1_PATCHES
jsr PATCH5
nop
.else
lda Z8C
ldy Z8C+1
.endif
L2A67:
sta CURLIN
sty CURLIN+1
SYNERR4:
jmp SYNERR
RESPERR:
.ifdef CONFIG_FILE
lda CURDVC
beq LCA8F
ldx #ERR_BADDATA
jmp ERROR
LCA8F:
.endif
lda #<ERRREENTRY
ldy #>ERRREENTRY
jsr STROUT
lda OLDTEXT
ldy OLDTEXT+1
sta TXTPTR
sty TXTPTR+1
RTS20:
rts
; ----------------------------------------------------------------------------
; "GET" STATEMENT
; ----------------------------------------------------------------------------
.ifndef CONFIG_SMALL
GET:
jsr ERRDIR
; CBM: if GET#, then switch input
.ifdef CONFIG_FILE
cmp #'#'
bne LCAB6
jsr CHRGET
jsr GETBYT
lda #','
jsr SYNCHR
jsr CHKIN
stx CURDVC
LCAB6:
.endif
ldx #<(INPUTBUFFER+1)
ldy #>(INPUTBUFFER+1)
.ifdef CONFIG_NO_INPUTBUFFER_ZP
lda #$00
sta INPUTBUFFER+1
.else
sty INPUTBUFFER+1
.endif
lda #$40
jsr PROCESS_INPUT_LIST
; CBM: if GET#, then switch input back
.ifdef CONFIG_FILE
ldx CURDVC
bne LCAD8
.endif
rts
.endif
; ----------------------------------------------------------------------------
; "INPUT#" STATEMENT
; ----------------------------------------------------------------------------
.ifdef CONFIG_FILE
INPUTH:
jsr GETBYT
lda #$2C
jsr SYNCHR
jsr CHKIN
stx CURDVC
jsr L2A9E
LCAD6:
lda CURDVC
LCAD8:
jsr CLRCH
ldx #$00
stx CURDVC
rts
LCAE0:
.endif
; ----------------------------------------------------------------------------
; "INPUT" STATEMENT
; ----------------------------------------------------------------------------
INPUT:
.ifndef KBD
lsr Z14
.endif
cmp #$22
bne L2A9E
jsr STRTXT
lda #$3B
jsr SYNCHR
jsr STRPRT
L2A9E:
jsr ERRDIR
lda #$2C
sta INPUTBUFFER-1
LCAF8:
.ifdef APPLE
jsr INLINX
.else
jsr NXIN
.endif
.ifdef KBD
bmi L2ABE
.else
.ifdef CONFIG_FILE
lda CURDVC
beq LCB0C
lda Z96
and #$02
beq LCB0C
jsr LCAD6
jmp DATA
LCB0C:
.endif
lda INPUTBUFFER
bne L2ABE
.ifdef CONFIG_FILE
lda CURDVC
bne LCAF8
.endif
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH1
.else
clc
jmp CONTROL_C_TYPED
.endif
.endif
NXIN:
.ifdef KBD
jsr INLIN
bmi RTS20
pla
jmp LE86C
.else
.ifdef CONFIG_FILE
lda CURDVC
bne LCB21
.endif
jsr OUTQUES ; '?'
jsr OUTSP
LCB21:
jmp INLIN
.endif
; ----------------------------------------------------------------------------
; "GETC" STATEMENT
; ----------------------------------------------------------------------------
.ifdef KBD
GETC:
jsr CONINT
jsr LF43D
jmp LE664
.endif
; ----------------------------------------------------------------------------
; "READ" STATEMENT
; ----------------------------------------------------------------------------
READ:
ldx DATPTR
ldy DATPTR+1
.ifdef CONFIG_NO_READ_Y_IS_ZERO_HACK
; AppleSoft II, too
lda #$98 ; READ
.byte $2C
L2ABE:
lda #$00 ; INPUT
.else
.byte $A9 ; LDA #$98
L2ABE:
tya
.endif
; ----------------------------------------------------------------------------
; PROCESS INPUT LIST
;
; (Y,X) IS ADDRESS OF INPUT DATA STRING
; (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
; $40 FOR GET
; $98 FOR READ
; ----------------------------------------------------------------------------
PROCESS_INPUT_LIST:
sta INPUTFLG
stx INPTR
sty INPTR+1
PROCESS_INPUT_ITEM:
jsr PTRGET
sta FORPNT
sty FORPNT+1
lda TXTPTR
ldy TXTPTR+1
sta TXPSV
sty TXPSV+1
ldx INPTR
ldy INPTR+1
stx TXTPTR
sty TXTPTR+1
jsr CHRGOT
bne INSTART
bit INPUTFLG
.ifndef CONFIG_SMALL ; GET
bvc L2AF0
.ifdef MICROTAN
jsr MONRDKEY2
.else
jsr MONRDKEY
.endif
.ifdef CONFIG_IO_MSB
and #$7F
.endif
sta INPUTBUFFER
; BUG: The beq/bne L2AF8 below is supposed
; to be always taken. For this to happen,
; the last load must be a 0 for beq
; and != 0 for bne. The original Microsoft
; code had ldx/ldy/bne here, which was only
; correct for a non-ZP INPUTBUFFER. Commodore
; fixed it in CBMBASIC V1 by swapping the
; ldx and the ldy. It was broken on KIM,
; but okay on APPLE and CBM2, because
; these used a non-ZP INPUTBUFFER.
; Microsoft fixed this somewhere after KIM
; and before MICROTAN, by using beq instead
; of bne in the ZP case.
.ifdef CBM1
ldy #>(INPUTBUFFER-1)
ldx #<(INPUTBUFFER-1)
.else
ldx #<(INPUTBUFFER-1)
ldy #>(INPUTBUFFER-1)
.endif
.if .def(CONFIG_2) && (!.def(CONFIG_NO_INPUTBUFFER_ZP))
beq L2AF8 ; always
.else
bne L2AF8 ; always
.endif
L2AF0:
.endif
bmi FINDATA
.ifdef CONFIG_FILE
lda CURDVC
bne LCB64
.endif
.ifdef KBD
jsr OUTQUESSP
.else
jsr OUTQUES
.endif
LCB64:
jsr NXIN
L2AF8:
stx TXTPTR
sty TXTPTR+1
; ----------------------------------------------------------------------------
INSTART:
jsr CHRGET
bit VALTYP
bpl L2B34
.ifndef CONFIG_SMALL ; GET
bit INPUTFLG
bvc L2B10
.ifdef CONFIG_CBM1_PATCHES
lda #$00
jsr PATCH4
nop
.else
inx
stx TXTPTR
lda #$00
sta CHARAC
beq L2B1C
.endif
L2B10:
.endif
sta CHARAC
cmp #$22
beq L2B1D
lda #$3A
sta CHARAC
lda #$2C
L2B1C:
clc
L2B1D:
sta ENDCHR
lda TXTPTR
ldy TXTPTR+1
adc #$00
bcc L2B28
iny
L2B28:
jsr STRLT2
jsr POINT
.ifdef CONFIG_SMALL
jsr LETSTRING
.else
jsr PUTSTR
.endif
jmp INPUT_MORE
; ----------------------------------------------------------------------------
L2B34:
jsr FIN
.ifdef CONFIG_SMALL
jsr SETFOR
.else
lda VALTYP+1
jsr LET2
.endif
; ----------------------------------------------------------------------------
INPUT_MORE:
jsr CHRGOT
beq L2B48
cmp #$2C
beq L2B48
jmp INPUTERR
L2B48:
lda TXTPTR
ldy TXTPTR+1
sta INPTR
sty INPTR+1
lda TXPSV
ldy TXPSV+1
sta TXTPTR
sty TXTPTR+1
jsr CHRGOT
beq INPDONE
jsr CHKCOM
jmp PROCESS_INPUT_ITEM
; ----------------------------------------------------------------------------
FINDATA:
jsr DATAN
iny
tax
bne L2B7C
ldx #ERR_NODATA
iny
lda (TXTPTR),y
beq GERR
iny
lda (TXTPTR),y
sta Z8C
iny
lda (TXTPTR),y
iny
sta Z8C+1
L2B7C:
lda (TXTPTR),y
tax
jsr ADDON
cpx #$83
bne FINDATA
jmp INSTART
; ---NO MORE INPUT REQUESTED------
INPDONE:
lda INPTR
ldy INPTR+1
ldx INPUTFLG
.if .def(CONFIG_SMALL) && (!.def(CONFIG_11))
beq L2B94 ; INPUT
.else
bpl L2B94; INPUT or GET
.endif
jmp SETDA
L2B94:
ldy #$00
lda (INPTR),y
beq L2BA1
.ifdef CONFIG_FILE
lda CURDVC
bne L2BA1
.endif
lda #<ERREXTRA
ldy #>ERREXTRA
jmp STROUT
L2BA1:
rts
; ----------------------------------------------------------------------------
ERREXTRA:
.ifdef KBD
.byte "?Extra"
.else
.byte "?EXTRA IGNORED"
.endif
.byte $0D,$0A,$00
ERRREENTRY:
.ifdef KBD
.byte "What?"
.else
.byte "?REDO FROM START"
.endif
.byte $0D,$0A,$00
.ifdef KBD
LEA30:
.byte "B"
.byte $FD
.byte "GsBASIC"
.byte $00,$1B,$0D,$13
.byte " BASIC"
.endif

23
software/retro1-tests/OSI/msbasic/iscntc.s Normal file
View File

@ -0,0 +1,23 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; SEE IF CONTROL-C TYPED
; ----------------------------------------------------------------------------
.ifndef CONFIG_CBM_ALL
.include "cbm_iscntc.s"
.endif
.ifdef KBD
.include "kbd_iscntc.s"
.endif
.ifdef OSI
.include "osi_iscntc.s"
.endif
.ifdef APPLE
.include "apple_iscntc.s"
.endif
.ifdef KIM
.include "kim_iscntc.s"
.endif
.ifdef MICROTAN
.include "microtan_iscntc.s"
.endif
;!!! runs into "STOP"

19
software/retro1-tests/OSI/msbasic/kb9.cfg Normal file
View File

@ -0,0 +1,19 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $2000, size = $3F00, fill = no, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
DUMMY: load = DUMMY; # don't include
}

335
software/retro1-tests/OSI/msbasic/kbd_extra.s Normal file
View File

@ -0,0 +1,335 @@
.segment "EXTRA"
stx SHIFTSIGNEXT
stx $0800
inx
stx Z17
stx Z18
stx TXTTAB
lda #$08
sta TXTTAB+1
jsr SCRTCH
sta STACK+255
LFD81:
jsr PRIMM
.byte $1B,$06,$01,$0C
.byte "INTELLIVISION BASIC"
.byte $0D,$0A,$0A
.byte "Copyright Microsoft, Mattel 1980"
.byte $0D,$0A,$00
sta $0435
sta $8F
ldy #$0F
lda #$FF
sta ($04),y
jsr LDE8C
.byte $0C ; NOP $xxxx
jmp RESTART
OUTQUESSP:
jsr OUTQUES
jmp OUTSP
INLIN:
ldy #$FF
LFDDC:
iny
LFDDD:
jsr GETLN
cmp #$03 ; CTRL+C
beq LFDF7
cmp #$20
bcs LFDEC ; no control char
sbc #$09
bne LFDDD
LFDEC:
sta INPUTBUFFER,y
tax
bne LFDDC
jsr CRDO2
ldy #$06
LFDF7:
tax
clc
rts
LFDFA:
bit $8F
bmi LFE01
jsr LDE48
LFE01:
bit $8F
bvc LFE10
jmp LDE53
LFE08:
jsr LFDFA
LFE0B:
jsr LDE24
bne LFE08
LFE10:
rts
VSAV:
jsr GARBAG
lda FRETOP
sta $00
lda FRETOP+1
.byte $85
LFE1B:
ora ($A5,x)
.byte $2F
sta $02
lda STREND+1
sta $03
ldy #$00
LFE26:
lda ($00),y
sta ($02),y
inc $02
bne LFE30
inc $03
LFE30:
inc $00
bne LFE26
inc $01
bit $01
bvc LFE26
ldx VARTAB
ldy VARTAB+1
lda #$01
bne LFE50
PSAV:
lda VARTAB
sta $02
lda VARTAB+1
sta $03
ldx #$01
ldy #$08
lda #$02
LFE50:
sta $0513
stx $0503
stx $00
sty $0504
sty $01
ldy #$0D
lda #$00
LFE61:
sta $0504,y
dey
bne LFE61
sty $0500
lda #$40
sta $0505
lda $02
sec
sbc $00
sta $00
lda $03
sbc $01
sta $01
lsr a
lsr a
lsr a
sta $03
jsr LE870
sta $02
jsr CHRGOT
beq LFEA6
cmp #$2C
beq L40FA
jmp SYNERR
L40FA:
jsr CHRGET
jsr LE870
sec
sbc $02
cmp $03
bpl LFEBF
lda #$27
sta JMPADRS
jmp LFFBD
LFEA6:
lda $02
clc
adc $03
jsr LE874
pha
jsr LFE0B
jsr L6874
.byte $72
adc $00,x
pla
tax
lda #$00
jsr LINPRT
LFEBF:
ldx #$07
LBF83:
dex
lda VARTAB,x
sec
sbc TXTTAB,x
sta $051B,x
lda VARTAB+1,x
sbc TXTTAB+1,x
sta $051C,x
dex
bpl LBF83
txa
sbc FRETOP
sta $0521
lda #>CONST_MEMSIZ
sbc FRETOP+1
sta $0522
lda FRETOP
sta $0523
lda FRETOP+1
sta $0524
ldx $02
jsr LFFDD
jsr LFFD1
lda $01
ldx #$05
LFEF7:
stx $0511
ldy #$E4
sec
sbc #$08
sta $01
bpl LFF15
adc #$08
asl $00
rol a
asl $00
rol a
asl $00
rol a
adc #$01
sta $0505
ldy #$00
LFF15:
sty $0512
jsr LE4C0
ldx #$00
lda $01
bpl LFEF7
LFF21:
rts
VLOD:
jsr LFFD1
stx JMPADRS
lda VARTAB
ldy VARTAB+1
ldx #$01
jsr LFF64
ldx #$00
ldy #$02
LFF34:
jsr LE39A
iny
iny
inx
inx
cpx #$05
bmi LFF34
lda STREND
sta LOWTR
lda STREND+1
sta LOWTR+1
lda FRETOP
sta HIGHTR
lda FRETOP+1
sta HIGHTR+1
lda #<CONST_MEMSIZ
sta HIGHDS
lda #>CONST_MEMSIZ
sta HIGHDS+1
lda $0523
sta FRETOP
lda $0524
sta FRETOP+1
jmp BLTU2
LFF64:
sta $9A
sty $9B
stx $00
jsr LE870
jsr LFFDD
lda JMPADRS
beq LFF7F
lda #$01
sta $9A
lda #$08
sta $9B
jsr STXTPT
LFF7F:
lda $9A
sta $0503
lda $9B
sta $0504
lda #$ED
sta $0512
lda #$05
sta $01
LFF92:
ldx $0512
beq LFF21
ldy #$04
jsr LE4C4
lda $01
cmp $0511
bne LFFB2
lda #$00
sta $01
lda $00
cmp $0513
beq LFF92
lda #$18
bne LFFB8
LFFB2:
lda #$27
bne LFFB8
LFFB6:
lda #$3C
LFFB8:
sta JMPADRS
jsr CLEARC
LFFBD:
jsr VARTAB_MINUS_2_TO_AY
sta $9A
sty $9B
lda #$00
tay
sta ($9A),y
iny
sta ($9A),y
ldx JMPADRS
jmp ERROR
LFFD1:
ldx #$00
LFFD3:
lda #$02
.byte $2C
LFFD6:
lda #$03
jsr LDE8C
asl FACSIGN
LFFDD:
jsr CHRGOT
beq LFFE5
jmp SYNERR
LFFE5:
lda #$0D
ldy #$00
jsr LDE8C
.byte $06
LFFED:
lda $034C
bmi LFFED
ldy #$01
lda ($04),y
bne LFFB6
rts
.byte $FF
; NMI
.addr LC000
; RESET
.addr LC000
; IRQ
.addr LC009

10
software/retro1-tests/OSI/msbasic/kbd_iscntc.s Normal file
View File

@ -0,0 +1,10 @@
.segment "CODE"
ISCNTC:
jsr LE8F3
bcc RET1
LE633:
jsr LDE7F
beq STOP
cmp #$03
bne LE633
;!!! runs into "STOP"

37
software/retro1-tests/OSI/msbasic/kbd_loadsave.s Normal file
View File

@ -0,0 +1,37 @@
.segment "CODE"
SLOD:
ldx #$01
.byte $2C
PLOD:
ldx #$00
ldy CURLIN+1
iny
sty JMPADRS
jsr LFFD3
jsr VARTAB_MINUS_2_TO_AY
ldx #$02
jsr LFF64
ldx #$6F
ldy #$00
jsr LE39A
jsr LE33D
jmp CLEARC
.byte $FF,$FF,$FF
; ----------------------------------------------------------------------------
VER:
lda #$13
ldx FAC
beq LE397
lda $DFF9
LE397:
jmp FLOAT
LE39A:
lda VARTAB,x
clc
adc $051B,y
sta VARTAB,y
lda VARTAB+1,x
adc $051C,y
sta VARTAB+1,y
; !!! next instruction is an RTS!

19
software/retro1-tests/OSI/msbasic/kbdbasic.cfg Normal file
View File

@ -0,0 +1,19 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $E000, size = $3F00, fill = no, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
DUMMY: load = DUMMY; # don't include
}

5
software/retro1-tests/OSI/msbasic/kim_extra.s Normal file
View File

@ -0,0 +1,5 @@
.segment "EXTRA"
RAMSTART2:
.byte $08,$29,$25,$20,$60,$2A,$E5,$E4
.byte $20,$66,$24,$65,$AC,$04,$A4

10
software/retro1-tests/OSI/msbasic/kim_iscntc.s Normal file
View File

@ -0,0 +1,10 @@
.segment "CODE"
ISCNTC:
lda #$01
bit $1740
bmi RET2
ldx #$08
lda #$03
clc
cmp #$03
;!!! runs into "STOP"

62
software/retro1-tests/OSI/msbasic/kim_loadsave.s Normal file
View File

@ -0,0 +1,62 @@
.segment "CODE"
SAVE:
tsx
stx INPUTFLG
lda #$37
sta $F2
lda #$FE
sta $17F9
lda TXTTAB
ldy TXTTAB+1
sta $17F5
sty $17F6
lda VARTAB
ldy VARTAB+1
sta $17F7
sty $17F8
jmp L1800
ldx INPUTFLG
txs
lda #<QT_SAVED
ldy #>QT_SAVED
jmp STROUT
QT_LOADED:
.byte "LOADED"
.byte $00
QT_SAVED:
.byte "SAVED"
.byte $0D,$0A,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00
LOAD:
lda TXTTAB
ldy TXTTAB+1
sta $17F5
sty $17F6
lda #$FF
sta $17F9
lda #<L27A6
ldy #>L27A6
sta GORESTART+1
sty GORESTART+2
jmp L1873
L27A6:
ldx #$FF
txs
lda #<RESTART
ldy #>RESTART
sta GORESTART+1
sty GORESTART+2
lda #<QT_LOADED
ldy #>QT_LOADED
jsr STROUT
ldx $17ED
ldy $17EE
txa
bne L27C2
nop
L27C2:
nop
stx VARTAB
sty VARTAB+1
jmp FIX_LINKS

11
software/retro1-tests/OSI/msbasic/loadsave.s Normal file
View File

@ -0,0 +1,11 @@
.segment "CODE"
.ifdef APPLE
.include "apple_loadsave.s"
.endif
.ifdef KIM
.include "kim_loadsave.s"
.endif
.ifdef MICROTAN
.include "microtan_loadsave.s"
.endif

78
software/retro1-tests/OSI/msbasic/macros.s Normal file
View File

@ -0,0 +1,78 @@
; htasc - set the hi bit on the last byte of a string for termination
; (by Tom Greene)
.macro htasc str
.repeat .strlen(str)-1,I
.byte .strat(str,I)
.endrep
.byte .strat(str,.strlen(str)-1) | $80
.endmacro
; For every token, a byte gets put into segment "DUMMY".
; This way, we count up with every token. The DUMMY segment
; doesn't get linked into the binary.
.macro init_token_tables
.segment "VECTORS"
TOKEN_ADDRESS_TABLE:
.segment "KEYWORDS"
TOKEN_NAME_TABLE:
.segment "DUMMY"
DUMMY_START:
.endmacro
; optionally define token symbol
; count up token number
.macro define_token token
.segment "DUMMY"
.ifnblank token
token := <(*-DUMMY_START)+$80
.endif
.res 1; count up in any case
.endmacro
; lay down a keyword, optionally define a token symbol
.macro keyword key, token
.segment "KEYWORDS"
htasc key
define_token token
.endmacro
; lay down a keyword and an address (RTS style),
; optionally define a token symbol
.macro keyword_rts key, vec, token
.segment "VECTORS"
.word vec-1
keyword key, token
.endmacro
; lay down a keyword and an address,
; optionally define a token symbol
.macro keyword_addr key, vec, token
.segment "VECTORS"
.addr vec
keyword key, token
.endmacro
.macro count_tokens
.segment "DUMMY"
NUM_TOKENS := <(*-DUMMY_START)
.endmacro
.macro init_error_table
.segment "ERROR"
ERROR_MESSAGES:
.endmacro
.macro define_error error, msg
.segment "ERROR"
error := <(*-ERROR_MESSAGES)
htasc msg
.endmacro
;---------------------------------------------
; set the MSB of every byte of a string
.macro asc80 str
.repeat .strlen(str),I
.byte .strat(str,I)+$80
.endrep
.endmacro

13
software/retro1-tests/OSI/msbasic/make.sh Normal file
View File

@ -0,0 +1,13 @@
if [ ! -d tmp ]; then
mkdir tmp
fi
#for i in cbmbasic1 cbmbasic2 kbdbasic osi kb9 applesoft microtan; do
for i in osi; do
echo $i
ca65 -D $i msbasic.s -o tmp/$i.o &&
ld65 -C $i.cfg tmp/$i.o -o tmp/$i.bin -Ln tmp/$i.lbl
done

154
software/retro1-tests/OSI/msbasic/memory.s Normal file
View File

@ -0,0 +1,154 @@
; generic stack and memory management code
; this code is identical across all versions of
; BASIC
.segment "CODE"
; ----------------------------------------------------------------------------
; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
; THE STACK FOR A FRAME WITH THE SAME VARIABLE.
;
; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
; = $XXFF IF CALLED FROM "RETURN"
; <<< BUG: SHOULD BE $FFXX >>>
;
; RETURNS .NE. IF VARIABLE NOT FOUND,
; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
;
; .EQ. IF FOUND
; (X) = STACK PNTR OF FRAME FOUND
; ----------------------------------------------------------------------------
GTFORPNT:
tsx
inx
inx
inx
inx
L2279:
lda STACK+1,x
cmp #$81
bne L22A1
lda FORPNT+1
bne L228E
lda STACK+2,x
sta FORPNT
lda STACK+3,x
sta FORPNT+1
L228E:
cmp STACK+3,x
bne L229A
lda FORPNT
cmp STACK+2,x
beq L22A1
L229A:
txa
clc
adc #BYTES_PER_FRAME
tax
bne L2279
L22A1:
rts
; ----------------------------------------------------------------------------
; MOVE BLOCK OF MEMORY UP
;
; ON ENTRY:
; (Y,A) = (HIGHDS) = DESTINATION END+1
; (LOWTR) = LOWEST ADDRESS OF SOURCE
; (HIGHTR) = HIGHEST SOURCE ADDRESS+1
; ----------------------------------------------------------------------------
BLTU:
jsr REASON
sta STREND
sty STREND+1
BLTU2:
sec
lda HIGHTR
sbc LOWTR
sta INDEX
tay
lda HIGHTR+1
sbc LOWTR+1
tax
inx
tya
beq L22DD
lda HIGHTR
sec
sbc INDEX
sta HIGHTR
bcs L22C6
dec HIGHTR+1
sec
L22C6:
lda HIGHDS
sbc INDEX
sta HIGHDS
bcs L22D6
dec HIGHDS+1
bcc L22D6
L22D2:
lda (HIGHTR),y
sta (HIGHDS),y
L22D6:
dey
bne L22D2
lda (HIGHTR),y
sta (HIGHDS),y
L22DD:
dec HIGHTR+1
dec HIGHDS+1
dex
bne L22D6
rts
; ----------------------------------------------------------------------------
; CHECK IF ENOUGH ROOM LEFT ON STACK
; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
; ----------------------------------------------------------------------------
CHKMEM:
asl a
adc #SPACE_FOR_GOSUB
bcs MEMERR
sta INDEX
tsx
cpx INDEX
bcc MEMERR
rts
; ----------------------------------------------------------------------------
; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
; (Y,A) = ADDR ARRAYS NEED TO GROW TO
; ----------------------------------------------------------------------------
REASON:
cpy FRETOP+1
bcc L231E
bne L22FC
cmp FRETOP
bcc L231E
L22FC:
pha
ldx #FAC-TEMP1-1
tya
L2300:
pha
lda TEMP1,x
dex
bpl L2300
jsr GARBAG
ldx #<(TEMP1-FAC+1)
L230B:
pla
sta FAC,x
inx
bmi L230B
pla
tay
pla
cpy FRETOP+1
bcc L231E
bne MEMERR
cmp FRETOP
bcs MEMERR
L231E:
rts

59
software/retro1-tests/OSI/msbasic/message.s Normal file
View File

@ -0,0 +1,59 @@
; global messages: "error", "in", "ready", "break"
.segment "CODE"
QT_ERROR:
.ifdef KBD
.byte " err"
.else
.ifdef APPLE
.byte " ERR"
.byte $07,$07
.else
.byte " ERROR"
.endif
.endif
.byte 0
.ifndef KBD
QT_IN:
.byte " IN "
.byte $00
.endif
.ifdef KBD
.byte $54,$D2 ; ???
OKPRT:
jsr PRIMM
.byte CR,CR,">>",CR,LF
.byte 0
rts
nop
.else
QT_OK:
.ifdef CONFIG_CBM_ALL
.byte CR,LF,"READY.",CR,LF
.else
.ifdef APPLE
; binary patch!
.byte CR,0,0,"K",CR,LF
.else
.byte CR,LF,"OK",CR,LF
.endif
.endif
.byte 0
.endif
QT_BREAK:
.ifdef KBD
.byte CR,LF," Brk"
.byte 0
.byte $54,$D0 ; ???
.elseif .def(MICROTAN)
.byte CR,LF," BREAK"
.byte 0
.else
.byte CR,LF,"BREAK"
.byte 0
.endif

19
software/retro1-tests/OSI/msbasic/microtan.cfg Normal file
View File

@ -0,0 +1,19 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $C000, size = $3F00, fill = no, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
DUMMY: load = DUMMY; # don't include
}

923
software/retro1-tests/OSI/msbasic/microtan_extra.s Normal file
View File

@ -0,0 +1,923 @@
.byte 0,0,0,0,0,0,0,0,0
LE210:
jmp LE34A
LE213:
jmp LE34A
LE216:
jmp LE33C
LE219:
jmp LE252
LE21C:
jmp LE6AD
LE21F:
jmp LE6B9
LE222:
pla
tay
sta $5E
pla
sta $5F
pha
tya
pha
ldy #$03
LE22E:
lda ($5E),y
beq LE238
jsr LFE75
iny
bne LE22E
LE238:
jsr LFDFA
lda $01
cmp #$03
beq LE24C
cmp #$0D
beq LE24B
jsr LFE75
jmp LE238
LE24B:
rts
LE24C:
pla
pla
pla
jmp LE2D6
LE252:
tya
pha
jsr LE222
bcs LE260
.byte "FAST?"
.byte $0D,$00
LE260:
ldy #$00
sty $50
sty $31
lda $03E0
cmp #$59
beq LE26F
inc $50
LE26F:
pla
pha
beq LE28C
jsr LE222
bcs LE280
ora $5845
.byte "AM?"
.byte $0D,$00
LE280:
lda $03E0
cmp #$59
beq LE28C
pla
clc
adc #$01
pha
LE28C:
jsr LE222
bcs LE29D
ora $4946
.byte "LENAME?"
.byte $0D,$00
LE29D:
ldy #$FF
jsr LF006
bcs LE28C
cmp #$FF
bne LE28C
lda #$00
lda #$42
jsr LF003
jsr LF000
pla
bne LE2C3
ldy #$20
jsr LF009
jsr LF00C
jsr LF01E
jmp LE2D6
LE2C3:
pha
jsr LF01B
pla
clc
sbc #$00
jsr LF021
lda $1E
sta $9C
lda $1F
sta $9D
LE2D6:
jsr LFE73
cli
lda #$00
sta $BFCB
sta $BFC2
ldx #$00
LE2E4:
pla
sta $13,x
inx
cpx #$4D
bne LE2E4
rts
lda #$0F
sta $0C
lda #$00
sta $BFC2
sta $15
sta $16
jmp COLD_START
LE2FD:
pha
txa
pha
lda #$02
sta $14
lda #$00
LE306:
dex
bmi LE312
clc
adc #$20
bcc LE306
inc $14
bne LE306
LE312:
sta $13
pla
tax
pla
rts
LE318:
jsr LE2FD
sta ($13),y
rts
LE31E:
pha
txa
pha
ldx #$00
LE323:
lda $0220,x
sta $0200,x
inx
cpx #$A0
bne LE323
lda #$20
ldx #$1F
LE332:
sta $0280,x
dex
bpl LE332
pla
tax
LE33A:
pla
rts
LE33C:
pha
lda $16
beq LE346
bpl LE33A
jmp LE714
LE346:
pla
jmp LC7A5
LE34A:
lda $16
beq LE357
bmi LE353
jmp LE778
LE353:
lda #$00
sta $16
LE357:
lda $15
beq LE35E
jmp LE660
LE35E:
jsr LC764
cmp #$05
beq LE366
rts
LE366:
stx $0E
lda #$00
sta $33
sta $34
ldx #$FF
LE370:
inx
cpx $0E
beq LE3C8
lda $34
cmp #$19
bcs LE3A7
pha
lda $33
asl a
rol $34
asl a
rol $34
adc $33
sta $33
pla
adc $34
sta $34
asl $33
rol $34
lda $35,x
sec
sbc #$30
bmi LE3A7
cmp #$3A
bcs LE3A7
clc
adc $33
sta $33
bcc LE370
inc $34
bne LE370
LE3A7:
ldx #$00
LE3A9:
lda LE3B4,x
beq LE3C3
jsr LFE75
inx
bne LE3A9
LE3B4:
ora $4F4E
.byte " SUCH LINE"
.byte $0D,$00
LE3C3:
ldx #$00
lda #$0D
rts
LE3C8:
ldx #$09
LE3CA:
lda #$04
sta $45,x
dex
lda #$01
sta $45,x
dex
bpl LE3CA
sta $CE
lda #$04
sta $CF
stx $7D
stx $7B
LE3E0:
ldy #$03
lda ($CE),y
pha
dey
lda ($CE),y
pha
dey
lda ($CE),y
tax
dey
lda ($CE),y
sta $CE
stx $CF
sta $4F
stx $50
pla
tax
pla
cmp $34
bne LE403
cpx $33
beq LE419
LE403:
stx $7A
sta $7B
ldx #$00
LE409:
lda $47,x
sta $45,x
inx
cpx #$0A
bne LE409
iny
lda ($CE),y
beq LE3A7
bne LE3E0
LE419:
iny
lda ($CE),y
beq LE428
iny
lda ($CE),y
sta $7C
iny
lda ($CE),y
sta $7D
LE428:
ldx #$03
LE42A:
lda $7A,x
pha
dex
bpl LE42A
lda #$20
ldx #$0F
LE434:
ldy #$1F
LE436:
jsr LE318
dey
bpl LE436
dex
bpl LE434
ldx #$05
LE441:
ldy #$1F
lda #$2D
LE445:
jsr LE318
dey
bpl LE445
cpx #$09
beq LE453
ldx #$09
bne LE441
LE453:
lda $45
sta $CE
lda $46
sta $CF
LE45B:
txa
pha
lda #$00
sta $07
ldy #$02
lda ($CE),y
tax
iny
lda ($CE),y
cmp $34
beq LE473
bcc LE479
LE46F:
dec $07
bmi LE47B
LE473:
cpx $33
beq LE47B
bcs LE46F
LE479:
inc $07
LE47B:
sty $08
stx $D2
sta $D1
ldx #$90
sec
jsr FLOAT2
jsr FOUT
ldx #$00
LE48C:
lda $0100,x
beq LE496
sta $35,x
inx
bne LE48C
LE496:
lda #$20
LE498:
ldy $08
and #$7F
LE49C:
sta $35,x
beq LE4D0
inx
cpx #$4F
bcc LE4A9
lda #$00
beq LE49C
LE4A9:
iny
lda ($CE),y
bpl LE49C
sec
sbc #$7F
stx $09
tax
sty $08
ldy #$FF
LE4B8:
dex
beq LE4C3
LE4BB:
iny
lda TOKEN_NAME_TABLE,y
bpl LE4BB
bmi LE4B8
LE4C3:
ldx $09
LE4C5:
iny
lda TOKEN_NAME_TABLE,y
bmi LE498
sta $35,x
inx
bne LE4C5
LE4D0:
ldx #$00
stx $08
pla
tax
ldy #$00
lda $07
bne LE4E0
ldx #$06
bne LE4EE
LE4E0:
bpl LE4E9
LE4E2:
inx
cpx #$0E
beq LE529
bne LE4EE
LE4E9:
jsr LE31E
ldx #$04
LE4EE:
stx $09
LE4F0:
ldx $08
lda $35,x
beq LE50D
inx
stx $08
ldx $09
jsr LE318
iny
cpy #$20
bne LE4F0
ldy #$00
lda $07
beq LE4E2
bpl LE4E9
bmi LE4E2
LE50D:
ldy #$00
lda ($CE),y
pha
iny
lda ($CE),y
sta $CF
pla
sta $CE
lda ($CE),y
beq LE529
ldx $09
lda $07
bne LE526
ldx #$09
LE526:
jmp LE45B
LE529:
ldx #$00
LE52B:
lda $02C1,x
cmp #$20
beq LE53A
sta $03E1,x
inx
stx $0E
bne LE52B
LE53A:
ldx #$00
LE53C:
pla
sta $7A,x
inx
cpx #$04
bne LE53C
ldx #$06
ldy #$00
sty $01
LE54A:
jsr LE2FD
lda ($13),y
sta $82
lda #$FF
sta ($13),y
LE555:
lda #$40
sta $80
sta $81
LE55B:
lda $01
bne LE574
dec $80
bne LE55B
dec $81
bne LE55B
lda ($13),y
pha
lda $82
sta ($13),y
pla
sta $82
jmp LE555
LE574:
lda $82
bmi LE57A
sta ($13),y
LE57A:
lda $01
cmp #$18
bne LE584
dey
bpl LE584
iny
LE584:
cmp #$06
bne LE58D
cpy #$1F
beq LE58D
iny
LE58D:
cmp #$02
bne LE596
cpx #$06
beq LE596
dex
LE596:
cmp #$04
bne LE59F
cpx #$08
beq LE59F
inx
LE59F:
cmp #$7F
bne LE5B6
cpy #$00
bne LE5AB
cpx #$06
beq LE5B6
LE5AB:
dey
bpl LE5BA
ldy #$1F
dex
jsr LE2FD
bne LE5BA
LE5B6:
cmp #$05
bne LE5D5
LE5BA:
pha
tya
pha
LE5BD:
tya
clc
adc $13
cmp #$1F
beq LE5CE
iny
lda ($13),y
dey
sta ($13),y
iny
bne LE5BD
LE5CE:
lda #$20
sta ($13),y
pla
tay
pla
LE5D5:
cmp #$1B
beq LE641
cmp #$0D
beq LE657
cmp #$0A
beq LE631
cmp #$03
beq LE645
cmp #$0B
beq LE627
cmp #$09
beq LE63D
cmp #$20
bcc LE620
cmp #$7E
bcs LE620
pha
tya
pha
lda ($13),y
LE5FA:
sta $80
tya
clc
adc $13
cmp #$1F
beq LE60F
iny
lda ($13),y
pha
lda $80
sta ($13),y
pla
bne LE5FA
LE60F:
pla
tay
pla
sta ($13),y
cpy #$1F
bne LE61F
cpx #$08
beq LE620
inx
ldy #$FF
LE61F:
iny
LE620:
lda #$00
sta $01
jmp LE54A
LE627:
ldx #$5F
lda #$20
LE62B:
sta $02C0,x
dex
bpl LE62B
LE631:
ldx #$02
LE633:
lda $7A,x
sta $13
inx
lda $7A,x
jmp LE659
LE63D:
ldx #$00
stx $0E
LE641:
ldx #$00
beq LE633
LE645:
jsr LFE73
ldx #$00
lda #$00
sta $16
LE64E:
sta $15
ldy #$00
sty $03
lda #$0D
rts
LE657:
lda #$FF
LE659:
sta $14
lda #$01
pha
bne LE685
LE660:
cmp #$03
beq LE69E
cmp #$02
beq LE681
ldx $03C0
cpx #$20
bne LE645
ldx #$FF
LE671:
inx
cpx $0E
bne LE67A
lda #$02
bne LE64E
LE67A:
lda $03E1,x
sta $35,x
bne LE671
LE681:
tax
inx
txa
pha
LE685:
ldx #$4F
LE687:
lda $02C0,x
sta $35,x
dex
bpl LE687
ldx #$4F
LE691:
lda $02BF,x
cmp #$20
bne LE69B
dex
bne LE691
LE69B:
pla
bne LE64E
LE69E:
ldx $14
cpx #$FF
beq LE645
stx $34
lda $13
sta $33
jmp LE3C8
LE6AD:
pha
lda #$05
sta $0E
pla
jsr LINGET
jmp LC57E
LE6B9:
lda $0E
bmi LE6D1
dec $0E
bne LE6D1
jsr LFDFA
lda #$82
sta $0E
lda $01
cmp #$0A
beq LE6D1
sec
rol $0E
LE6D1:
jsr ISCNTC
jmp LC5A9
LE6D7:
ldx #$FF
LE6D9:
jsr LE6E2
dey
bne LE6D9
dex
bne LE6D9
LE6E2:
rts
LE6E3:
lda #$0C
LE6E5:
ldx #$FF
tay
lda $01
cmp #$03
beq LE6E2
tya
LE6EF:
pha
lda $BFC0
LE6F3:
lda $BFCD
and #$08
beq LE6F3
lda $BFC9
pha
lda #$FF
sta $BFC9
pla
cmp #$FC
pla
bcc LE6E5
dex
bne LE6EF
dey
bne LE6EF
rts
LE710:
lda #$06
bne LE6E5
LE714:
stx $13
sty $14
lda $16
cmp #$FD
beq LE749
lda #$00
sta $BFCB
lda #$20
sta $BFC0
lda #$40
sta $BFC2
jsr LE6D7
jsr LF000
lda $16
cmp #$FF
bne LE740
ldy #$20
jsr LF009
dec $16
LE740:
ldy #$10
ldx #$FF
jsr LF009
dec $16
LE749:
pla
sei
pha
cmp #$0A
beq LE771
ldx $0E
stx $50
jsr LF00F
cli
lda $01
cmp #$03
beq LE771
pla
pha
cmp #$0D
bne LE771
lda #$00
sta $16
sta $BFCB
jsr LE6D7
sta $BFC2
LE771:
ldx $13
ldy $14
cli
pla
rts
LE778:
lda #$40
sta $BFC0
jsr LF000
cli
lda $16
cmp #$01
bne LE78A
jsr LE6E3
LE78A:
jsr LE710
lda $01
cmp #$03
beq LE7CE
LE793:
lda $50
pha
lda $51
pha
lda $0E
sta $50
sei
jsr LF018
cli
tay
pla
sta $51
pla
sta $50
bcs LE7BD
lda #$00
sta $16
ldx #$06
LE7B1:
lda LE7DC,x ; "PARITY"
jsr LFE75
dex
bpl LE7B1
inx
beq LE7CE
LE7BD:
lda $01
cmp #$03
beq LE7CE
cpy #$0D
beq LE7CE
sty $35,x
inx
cpx #$4F
bne LE793
LE7CE:
lda #$00
sta $BFCB
sta $BFC2
sta $16
cli
lda #$0D
rts
LE7DC:
.byte "YTIRAP"
.byte $0D,$FF,$FF,$FF,$FF,$FF,$FF,$FF
.byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
.byte $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
.byte $FF,$FF,$FF,$FF,$FF,$FF

12
software/retro1-tests/OSI/msbasic/microtan_iscntc.s Normal file
View File

@ -0,0 +1,12 @@
.segment "CODE"
ISCNTC:
lda $01
cmp #$03
beq LC6EF
lda #$01
rts
LC6EF:
nop
nop
cmp #$03
;!!! runs into "STOP"

75
software/retro1-tests/OSI/msbasic/microtan_loadsave.s Normal file
View File

@ -0,0 +1,75 @@
.segment "CODE"
SAVE:
ldy #$00
beq LC74D
LC74B:
ldy #$01
LC74D:
ldx #$4C
LC74F:
lda $13,x
pha
dex
bpl LC74F
ldx #$03
LC757:
lda TXTTAB,x
sta GOSTROUT+2,x
dex
bpl LC757
jmp LE219
nop
nop
nop
LC764:
tya
pha
ldy $03
lda #$FF
sta ($0A),y
pla
tay
jsr LFDFA
lda $01
jsr LC7A5
rts
.byte "DED"
.byte $0D,$0A
.byte "OK"
.byte $0D,$0A,$00
.byte "SAVED"
.byte $0D,$0A,$00
LOAD:
jsr LC74B
ldx #$FF
tsx
lda #$4F
jsr LFE75
lda #$4B
jsr LFE75
jsr LFE73
lda VARTAB
tax
ldy VARTAB+1
jmp FIX_LINKS
nop
LC7A5:
pha
cmp #$0A
beq LC7AD
jsr LFE75
LC7AD:
tya
pha
ldy $03
lda #$20
sta ($0A),y
pla
tay
pla
rts
inc $8A17
stx VARTAB
sty VARTAB+1
jmp FIX_LINKS

223
software/retro1-tests/OSI/msbasic/misc1.s Normal file
View File

@ -0,0 +1,223 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; CONVERT LINE NUMBER
; ----------------------------------------------------------------------------
LINGET:
ldx #$00
stx LINNUM
stx LINNUM+1
L28BE:
bcs L28B7
sbc #$2F
sta CHARAC
lda LINNUM+1
sta INDEX
cmp #$19
bcs L28A0
; <<<<<DANGEROUS CODE>>>>>
; NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
; ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
; FOR OTHER CALLS TO LINGET.
;
; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
; THEN TYPE "GO TO 437761".
;
; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
; THE PROBLEM. ($AB00 - $ABFF)
; <<<<<DANGEROUS CODE>>>>>
lda LINNUM
asl a
rol INDEX
asl a
rol INDEX
adc LINNUM
sta LINNUM
lda INDEX
adc LINNUM+1
sta LINNUM+1
asl LINNUM
rol LINNUM+1
lda LINNUM
adc CHARAC
sta LINNUM
bcc L28EC
inc LINNUM+1
L28EC:
jsr CHRGET
jmp L28BE
; ----------------------------------------------------------------------------
; "LET" STATEMENT
;
; LET <VAR> = <EXP>
; <VAR> = <EXP>
; ----------------------------------------------------------------------------
LET:
jsr PTRGET
sta FORPNT
sty FORPNT+1
lda #TOKEN_EQUAL
jsr SYNCHR
.ifndef CONFIG_SMALL
lda VALTYP+1
pha
.endif
lda VALTYP
pha
jsr FRMEVL
pla
rol a
jsr CHKVAL
bne LETSTRING
.ifndef CONFIG_SMALL
pla
LET2:
bpl L2923
jsr ROUND_FAC
jsr AYINT
ldy #$00
lda FAC+3
sta (FORPNT),y
iny
lda FAC+4
sta (FORPNT),y
rts
L2923:
.endif
; ----------------------------------------------------------------------------
; REAL VARIABLE = EXPRESSION
; ----------------------------------------------------------------------------
jmp SETFOR
LETSTRING:
.ifndef CONFIG_SMALL
pla
.endif
; ----------------------------------------------------------------------------
; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
; ----------------------------------------------------------------------------
PUTSTR:
.ifdef CONFIG_CBM_ALL
ldy FORPNT+1
.ifdef CBM1
cpy #$D0 ; TI$
.else
cpy #$DE
.endif
bne LC92B
jsr FREFAC
cmp #$06
.ifdef CBM2
bne IQERR1
.else
jne IQERR
.endif
ldy #$00
sty FAC
sty FACSIGN
LC8E8:
sty STRNG2
jsr LC91C
jsr MUL10
inc STRNG2
ldy STRNG2
jsr LC91C
jsr COPY_FAC_TO_ARG_ROUNDED
tax
beq LC902
inx
txa
jsr LD9BF
LC902:
ldy STRNG2
iny
cpy #$06
bne LC8E8
jsr MUL10
jsr QINT
ldx #$02
sei
LC912:
lda FAC+2,x
sta TISTR,x
dex
bpl LC912
cli
rts
LC91C:
lda (INDEX),y
jsr CHRGOT2
bcc LC926
IQERR1:
jmp IQERR
LC926:
sbc #$2F
jmp ADDACC
LC92B:
.endif
ldy #$02
lda (FAC_LAST-1),y
cmp FRETOP+1
bcc L2946
bne L2938
dey
lda (FAC_LAST-1),y
cmp FRETOP
bcc L2946
L2938:
ldy FAC_LAST
cpy VARTAB+1
bcc L2946
bne L294D
lda FAC_LAST-1
cmp VARTAB
bcs L294D
L2946:
lda FAC_LAST-1
ldy FAC_LAST
jmp L2963
L294D:
ldy #$00
lda (FAC_LAST-1),y
jsr STRINI
lda DSCPTR
ldy DSCPTR+1
sta STRNG1
sty STRNG1+1
jsr MOVINS
lda #FAC
ldy #$00
L2963:
sta DSCPTR
sty DSCPTR+1
jsr FRETMS
ldy #$00
lda (DSCPTR),y
sta (FORPNT),y
iny
lda (DSCPTR),y
sta (FORPNT),y
iny
lda (DSCPTR),y
sta (FORPNT),y
rts
.ifdef CONFIG_FILE
PRINTH:
jsr CMD
jmp LCAD6
CMD:
jsr GETBYT
beq LC98F
lda #$2C
jsr SYNCHR
LC98F:
php
jsr CHKOUT
stx CURDVC
plp
jmp PRINT
.endif

174
software/retro1-tests/OSI/msbasic/misc2.s Normal file
View File

@ -0,0 +1,174 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "FRE" FUNCTION
;
; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT
; ----------------------------------------------------------------------------
FRE:
lda VALTYP
beq L3188
jsr FREFAC
L3188:
jsr GARBAG
sec
lda FRETOP
sbc STREND
tay
lda FRETOP+1
sbc STREND+1
; FALL INTO GIVAYF TO FLOAT THE VALUE
; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE
; ----------------------------------------------------------------------------
; FLOAT THE SIGNED INTEGER IN A,Y
; ----------------------------------------------------------------------------
GIVAYF:
ldx #$00
stx VALTYP
sta FAC+1
sty FAC+2
ldx #$90
jmp FLOAT1
POS:
ldy POSX
; ----------------------------------------------------------------------------
; FLOAT (Y) INTO FAC, GIVING VALUE 0-255
; ----------------------------------------------------------------------------
SNGFLT:
lda #$00
beq GIVAYF
; ----------------------------------------------------------------------------
; CHECK FOR DIRECT OR RUNNING MODE
; GIVING ERROR IF DIRECT MODE
; ----------------------------------------------------------------------------
ERRDIR:
ldx CURLIN+1
inx
bne RTS9
ldx #ERR_ILLDIR
.ifdef CONFIG_2
.byte $2C
LD288:
ldx #ERR_UNDEFFN
.endif
L31AF:
jmp ERROR
DEF:
jsr FNC
jsr ERRDIR
jsr CHKOPN
lda #$80
sta SUBFLG
jsr PTRGET
jsr CHKNUM
jsr CHKCLS
lda #TOKEN_EQUAL
jsr SYNCHR
.ifndef CONFIG_SMALL
pha
.endif
lda VARPNT+1
pha
lda VARPNT
pha
lda TXTPTR+1
pha
lda TXTPTR
pha
jsr DATA
jmp L3250
FNC:
lda #TOKEN_FN
jsr SYNCHR
ora #$80
sta SUBFLG
jsr PTRGET3
sta FNCNAM
sty FNCNAM+1
jmp CHKNUM
L31F3:
jsr FNC
lda FNCNAM+1
pha
lda FNCNAM
pha
jsr PARCHK
jsr CHKNUM
pla
sta FNCNAM
pla
sta FNCNAM+1
ldy #$02
.ifndef CONFIG_2
ldx #ERR_UNDEFFN
.endif
lda (FNCNAM),y
.ifndef CONFIG_2
beq L31AF
.endif
sta VARPNT
tax
iny
lda (FNCNAM),y
.ifdef CONFIG_2
beq LD288
.endif
sta VARPNT+1
.ifndef CONFIG_SMALL
iny
.endif
L3219:
lda (VARPNT),y
pha
dey
bpl L3219
ldy VARPNT+1
jsr STORE_FAC_AT_YX_ROUNDED
lda TXTPTR+1
pha
lda TXTPTR
pha
lda (FNCNAM),y
sta TXTPTR
iny
lda (FNCNAM),y
sta TXTPTR+1
lda VARPNT+1
pha
lda VARPNT
pha
jsr FRMNUM
pla
sta FNCNAM
pla
sta FNCNAM+1
jsr CHRGOT
beq L324A
jmp SYNERR
L324A:
pla
sta TXTPTR
pla
sta TXTPTR+1
L3250:
ldy #$00
pla
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
.ifndef CONFIG_SMALL
pla
iny
sta (FNCNAM),y
.endif
rts

76
software/retro1-tests/OSI/msbasic/misc3.s Normal file
View File

@ -0,0 +1,76 @@
; KBD specific patches
.segment "CODE"
.ifdef KBD
VARTAB_MINUS_2_TO_AY:
lda VARTAB
sec
sbc #$02
ldy VARTAB+1
bcs LF42C
dey
LF42C:
rts
; ----------------------------------------------------------------------------
GET_UPPER:
lda INPUTBUFFERX,x
LF430:
cmp #'a'
bcc LF43A
cmp #'z'+1
bcs LF43A
LF438:
sbc #$1F
LF43A:
rts
; ----------------------------------------------------------------------------
GETLN:
ldx #$5D
LF43D:
txa
and #$7F
cmp $0340
beq LF44D
sta $0340
lda #$03
jsr LDE48
LF44D:
jsr LDE7F
bne RTS4
cpx #$80
bcc LF44D
RTS4:
rts
; ----------------------------------------------------------------------------
LF457:
lda TXTTAB
ldx TXTTAB+1
LF45B:
sta JMPADRS+1
stx JMPADRS+2
ldy #$01
lda (JMPADRS+1),y
beq LF438
iny
iny
lda (JMPADRS+1),y
dey
cmp LINNUM+1
bne LF472
lda (JMPADRS+1),y
cmp LINNUM
LF472:
bcs LF43A
dey
lda (JMPADRS+1),y
tax
dey
lda (JMPADRS+1),y
bcc LF45B
LF47D:
jmp (JMPADRS+1)
.endif

101
software/retro1-tests/OSI/msbasic/msbasic.s Normal file
View File

@ -0,0 +1,101 @@
; Microsoft BASIC for 6502
;
; (first revision of this distribution, 20 Oct 2008, Michael Steil www.pagetable.com)
;
; This is a single integrated assembly source tree that can generate seven different versions of
; Microsoft BASIC for 6502.
;
; By running ./make.sh, this will generate all versions and compare them to the original files
; byte by byte. The CC65 compiler suite is need to build this project.
;
; These are the first eight (known) versions of Microsoft BASIC for 6502:
;
; Name Release MS Version ROM 9digit INPUTBUFFER extensions .define
;---------------------------------------------------------------------------------------------------
; Commodore BASIC 1 1977 Y Y ZP CBM
; OSI BASIC 1977 1.0 REV 3.2 Y N ZP - CONFIG_10A
; AppleSoft I 1977 1.1 N Y $0200 Apple CONFIG_11
; KIM BASIC 1977 1.1 N Y ZP - CONFIG_11A
; AppleSoft II 1978 Y Y $0200 Apple CONFIG_2
; Commodore BASIC 2 1979 Y Y $0200 CBM CONFIG_2A
; KBD BASIC 1982 Y N $0700 KBD CONFIG_2B
; MicroTAN 1980 Y Y ZP - CONFIG_2C
;
; (Note that this assembly source cannot (yet) build AppleSoft II.)
;
; This lists the versions in the order in which they were forked from the Microsoft source base.
; Commodore BASIC 1, as used on the original PET is the oldest known version of Microsoft BASIC
; for 6502. It contains some additions to Microsoft's version, like Commodore-style file I/O.
;
; The CONFIG_n defines specify what Microsoft-version the OEM version is based on. If CONFIG_2B
; is defined, for example, CONFIG_2A, CONFIG_2, CONFIG_11A, CONFIG_11 and CONFIG_10A will be
; defined as well, and all bugfixes up to version 2B will be enabled.
;
; The following symbols can be defined in addition:
;
; CONFIG_CBM1_PATCHES jump out into CBM1's binary patches instead of doing the right thing inline
; CONFIG_CBM_ALL add all Commodore-specific additions except file I/O
; CONFIG_DATAFLG ?
; CONFIG_EASTER_EGG include the CBM2 "WAIT 6502" easter egg
; CONFIG_FILE support Commodore PRINT#, INPUT#, GET#, CMD
; CONFIG_IO_MSB all I/O has bit #7 set
; CONFIG_MONCOUT_DESTROYS_Y Y needs to be preserved when calling MONCOUT
; CONFIG_NO_CR terminal doesn't need explicit CRs on line ends
; CONFIG_NO_LINE_EDITING disable support for Microsoft-style "@", "_", BEL etc.
; CONFIG_NO_POKE don't support PEEK, POKE and WAIT
; CONFIG_NO_READ_Y_IS_ZERO_HACK don't do a very volatile trick that saves one byte
; CONFIG_NULL support for the NULL statement
; CONFIG_PEEK_SAVE_LINNUM preserve LINNUM on a PEEK
; CONFIG_PRINTNULLS whether PRINTNULLS does anything
; CONFIG_PRINT_CR print CR when line end reached
; CONFIG_RAM optimizations for RAM version of BASIC, only use on 1.x
; CONFIG_ROR_WORKAROUND use workaround for buggy 6502s from 1975/1976; not safe for CONFIG_SMALL!
; CONFIG_SAFE_NAMENOTFOUND check both bytes of the caller's address in NAMENOTFOUND
; CONFIG_SCRTCH_ORDER where in the init code to call SCRTCH
; CONFIG_SMALL use 6 digit FP instead of 9 digit, use 2 character error messages, don't have GET
;
; Changing symbol definitions can alter an existing base configuration, but it not guaranteed to assemble
; or work correctly.
;
; Credits:
; * main work by Michael Steil
; * function names and all uppercase comments taken from Bob Sander-Cederlof's excellent AppleSoft II disassembly:
; http://www.txbobsc.com/scsc/scdocumentor/
; * Applesoft lite by Tom Greene http://cowgod.org/replica1/applesoft/ helped a lot, too.
; * Thanks to Joe Zbicak for help with Intellision Keyboard BASIC
; * This work is dedicated to the memory of my dear hacking pal Michael "acidity" Kollmann.
.debuginfo +
.setcpu "6502"
.macpack longbranch
.include "defines.s"
.include "macros.s"
.include "zeropage.s"
.include "header.s"
.include "token.s"
.include "error.s"
.include "message.s"
.include "memory.s"
.include "program.s"
.include "flow1.s"
.include "loadsave.s"
.include "flow2.s"
.include "misc1.s"
.include "print.s"
.include "input.s"
.include "eval.s"
.include "var.s"
.include "array.s"
.include "misc2.s"
.include "string.s"
.include "misc3.s"
.include "poke.s"
.include "float.s"
.include "chrget.s"
.include "rnd.s"
.include "trig.s"
.include "init.s"
.include "extra.s"

19
software/retro1-tests/OSI/msbasic/osi.cfg Normal file
View File

@ -0,0 +1,19 @@
MEMORY {
ZP: start = $0000, size = $0100, type = rw;
BASROM: start = $A000, size = $3F00, fill = no, file = %O;
DUMMY: start = $0000, size = $00FF, file = "";
}
SEGMENTS {
ZEROPAGE: load = ZP, type = zp;
HEADER: load = BASROM, type = ro;
VECTORS: load = BASROM, type = ro;
KEYWORDS: load = BASROM, type = ro;
ERROR: load = BASROM, type = ro;
CODE: load = BASROM, type = ro;
CHRGET: load = BASROM, type = ro;
INIT: load = BASROM, type = ro;
EXTRA: load = BASROM, type = ro;
DUMMY: load = DUMMY; # don't include
}

12
software/retro1-tests/OSI/msbasic/osi_iscntc.s Normal file
View File

@ -0,0 +1,12 @@
.segment "CODE"
ISCNTC:
jmp MONISCNTC
nop
nop
nop
nop
lsr a
bcc RET2
jsr GETLN
cmp #$03
;!!! *used*to* run into "STOP"

118
software/retro1-tests/OSI/msbasic/poke.s Normal file
View File

@ -0,0 +1,118 @@
.segment "CODE"
.ifndef CONFIG_NO_POKE
; ----------------------------------------------------------------------------
; EVALUATE "EXP1,EXP2"
;
; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM
; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG
; ----------------------------------------------------------------------------
GTNUM:
jsr FRMNUM
jsr GETADR
; ----------------------------------------------------------------------------
; EVALUATE ",EXPRESSION"
; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
COMBYTE:
jsr CHKCOM
jmp GETBYT
; ----------------------------------------------------------------------------
; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM
; ----------------------------------------------------------------------------
GETADR:
lda FACSIGN
.ifdef APPLE
nop ; PATCH
nop
.else
bmi GOIQ
.endif
lda FAC
cmp #$91
bcs GOIQ
jsr QINT
lda FAC_LAST-1
ldy FAC_LAST
sty LINNUM
sta LINNUM+1
rts
; ----------------------------------------------------------------------------
; "PEEK" FUNCTION
; ----------------------------------------------------------------------------
PEEK:
.ifdef CONFIG_PEEK_SAVE_LINNUM
lda LINNUM+1
pha
lda LINNUM
pha
.endif
jsr GETADR
ldy #$00
.ifdef CBM1
; disallow PEEK between $C000 and $DFFF
cmp #$C0
bcc LD6F3
cmp #$E1
bcc LD6F6
LD6F3:
.endif
.ifdef CBM2
nop ; patch that disables the compares above
nop
nop
nop
nop
nop
nop
nop
.endif
lda (LINNUM),y
tay
.ifdef CONFIG_PEEK_SAVE_LINNUM
pla
sta LINNUM
pla
sta LINNUM+1
.endif
LD6F6:
jmp SNGFLT
; ----------------------------------------------------------------------------
; "POKE" STATEMENT
; ----------------------------------------------------------------------------
POKE:
jsr GTNUM
txa
ldy #$00
sta (LINNUM),y
rts
; ----------------------------------------------------------------------------
; "WAIT" STATEMENT
; ----------------------------------------------------------------------------
WAIT:
jsr GTNUM
stx FORPNT
ldx #$00
jsr CHRGOT
.ifdef CONFIG_EASTER_EGG
beq EASTER_EGG
.else
beq L3628
.endif
jsr COMBYTE
L3628:
stx FORPNT+1
ldy #$00
L362C:
lda (LINNUM),y
eor FORPNT+1
and FORPNT
beq L362C
RTS3:
rts
.endif

386
software/retro1-tests/OSI/msbasic/print.s Normal file
View File

@ -0,0 +1,386 @@
.segment "CODE"
PRSTRING:
jsr STRPRT
L297E:
jsr CHRGOT
; ----------------------------------------------------------------------------
; "PRINT" STATEMENT
; ----------------------------------------------------------------------------
PRINT:
beq CRDO
PRINT2:
beq L29DD
cmp #TOKEN_TAB
beq L29F5
cmp #TOKEN_SPC
.ifdef CONFIG_2
clc ; also AppleSoft II
.endif
beq L29F5
cmp #','
; Pre-KIM had no CLC. KIM added the CLC
; here. Post-KIM moved the CLC up...
; (makes no sense on KIM, liveness = 0)
.if .def(CONFIG_11A) && (!.def(CONFIG_2))
clc
.endif
beq L29DE
cmp #$3B
beq L2A0D
jsr FRMEVL
bit VALTYP
bmi PRSTRING
jsr FOUT
jsr STRLIT
.ifndef CONFIG_NO_CR
ldy #$00
lda (FAC_LAST-1),y
clc
adc POSX
.ifdef KBD
cmp #$28
.else
cmp Z17
.endif
bcc L29B1
jsr CRDO
L29B1:
.endif
jsr STRPRT
.ifdef KBD
jmp L297E
.else
jsr OUTSP
bne L297E ; branch always
.endif
.ifdef KBD
; PATCHES
LE86C:
pla
jmp CONTROL_C_TYPED
LE870:
jsr GETBYT
txa
LE874:
beq LE878
bpl LE8F2
LE878:
jmp IQERR
; PATCHES
.endif
.ifndef KBD
L29B9:
.ifdef CBM2
lda #$00
sta INPUTBUFFER,x
ldx #<(INPUTBUFFER-1)
ldy #>(INPUTBUFFER-1)
.else
.ifndef APPLE
ldy #$00
sty INPUTBUFFER,x
ldx #LINNUM+1
.endif
.ifdef MICROTAN
bne CRDO2
.endif
.endif
.ifdef CONFIG_FILE
lda CURDVC
bne L29DD
.endif
.endif
CRDO:
.if .def(CONFIG_PRINTNULLS) && .def(CONFIG_FILE)
lda CURDVC
bne LC9D8
sta POSX
LC9D8:
.endif
lda #CRLF_1
.ifndef CONFIG_CBM_ALL
sta POSX
.endif
jsr OUTDO
CRDO2:
lda #CRLF_2
jsr OUTDO
PRINTNULLS:
.ifdef KBD
lda #$00
sta POSX
eor #$FF
.else
.if .def(CONFIG_NULL) || .def(CONFIG_PRINTNULLS)
.ifdef CONFIG_FILE
; Although there is no statement for it,
; CBM1 had NULL support and ignores
; it when not targeting the screen,
; CBM2 dropped it completely.
lda CURDVC
bne L29DD
.endif
txa
pha
ldx Z15
beq L29D9
lda #$00
L29D3:
jsr OUTDO
dex
bne L29D3
L29D9:
stx POSX
pla
tax
.else
.ifndef CONFIG_2
lda #$00
sta POSX
.endif
eor #$FF
.endif
.endif
L29DD:
rts
L29DE:
lda POSX
.ifndef CONFIG_NO_CR
.ifdef KBD
cmp #$1A
.else
cmp Z18
.endif
bcc L29EA
jsr CRDO
jmp L2A0D
L29EA:
.endif
sec
L29EB:
.ifdef CONFIG_CBM_ALL
sbc #$0A
.else
.ifdef KBD
sbc #$0D
.else
sbc #$0E
.endif
.endif
bcs L29EB
eor #$FF
adc #$01
bne L2A08
L29F5:
.ifdef CONFIG_11A
php
.else
pha
.endif
jsr GTBYTC
cmp #')'
.ifdef CONFIG_11A
.ifdef CONFIG_2
bne SYNERR4
.else
jne SYNERR
.endif
plp
bcc L2A09
.else
.ifdef CONFIG_11
jne SYNERR
.else
bne SYNERR4
.endif
pla
cmp #TOKEN_TAB
.ifdef CONFIG_11
bne L2A09
.else
bne L2A0A
.endif
.endif
txa
sbc POSX
bcc L2A0D
.ifndef CONFIG_11
beq L2A0D
.endif
L2A08:
tax
.ifdef CONFIG_11
L2A09:
inx
.endif
L2A0A:
.ifndef CONFIG_11
jsr OUTSP
.endif
dex
.ifndef CONFIG_11
bne L2A0A
.else
bne L2A13
.endif
L2A0D:
jsr CHRGET
jmp PRINT2
.ifdef CONFIG_11
L2A13:
jsr OUTSP
bne L2A0A
.endif
; ----------------------------------------------------------------------------
; PRINT STRING AT (Y,A)
; ----------------------------------------------------------------------------
STROUT:
jsr STRLIT
; ----------------------------------------------------------------------------
; PRINT STRING AT (FACMO,FACLO)
; ----------------------------------------------------------------------------
STRPRT:
jsr FREFAC
tax
ldy #$00
inx
L2A22:
dex
beq L29DD
lda (INDEX),y
jsr OUTDO
iny
cmp #$0D
bne L2A22
jsr PRINTNULLS
jmp L2A22
; ----------------------------------------------------------------------------
OUTSP:
.ifdef CONFIG_FILE
.ifndef CBM1
; on non-screen devices, print SPACE
; instead of CRSR RIGHT
lda CURDVC
beq LCA40
lda #$20
.byte $2C
LCA40:
.endif
lda #$1D ; CRSR RIGHT
.else
lda #$20
.endif
.byte $2C
OUTQUES:
lda #$3F
; ----------------------------------------------------------------------------
; PRINT CHAR FROM (A)
; ----------------------------------------------------------------------------
OUTDO:
.ifndef KBD
bit Z14
bmi L2A56
.endif
.if .def(CONFIG_PRINT_CR) || .def(CBM1)
; Commodore forgot to remove this in CBM1
pha
.endif
.ifdef CBM1
cmp #$1D ; CRSR RIGHT
beq LCA6A
cmp #$9D ; CRSR LEFT
beq LCA5A
cmp #$14 ; DEL
bne LCA64
LCA5A:
lda POSX
beq L2A4E
lda CURDVC
bne L2A4E
dec POSX
LCA64:
and #$7F
.endif
.ifndef CBM2
cmp #$20
bcc L2A4E
.endif
LCA6A:
.ifdef CONFIG_CBM1_PATCHES
lda CURDVC
jsr PATCH6
nop
.endif
.ifdef CONFIG_PRINT_CR
lda POSX
cmp Z17
bne L2A4C
.ifdef APPLE
nop ; PATCH!
nop ; don't print CR
nop
.else
jsr CRDO
.endif
L2A4C:
.endif
.ifndef CONFIG_CBM_ALL
inc POSX
.endif
L2A4E:
.if .def(CONFIG_PRINT_CR) || .def(CBM1)
; Commodore forgot to remove this in CBM1
pla
.endif
.ifdef CONFIG_MONCOUT_DESTROYS_Y
sty DIMFLG
.endif
.ifdef CONFIG_IO_MSB
ora #$80
.endif
jsr MONCOUT
.ifdef CONFIG_IO_MSB
and #$7F
.endif
.ifdef CONFIG_MONCOUT_DESTROYS_Y
ldy DIMFLG
.endif
.ifdef OSI
nop
nop
nop
nop
.endif
L2A56:
and #$FF
LE8F2:
rts
; ----------------------------------------------------------------------------
; ???
; ----------------------------------------------------------------------------
.ifdef KBD
LE8F3:
pha
lda $047F
clc
beq LE900
lda #$00
sta $047F
sec
LE900:
pla
rts
.endif

786
software/retro1-tests/OSI/msbasic/program.s Normal file
View File

@ -0,0 +1,786 @@
; error
; line input, line editing
; tokenize
; detokenize
; BASIC program memory management
; MICROTAN has some nonstandard extension to LIST here
.segment "CODE"
MEMERR:
ldx #ERR_MEMFULL
; ----------------------------------------------------------------------------
; HANDLE AN ERROR
;
; (X)=OFFSET IN ERROR MESSAGE TABLE
; (ERRFLG) > 128 IF "ON ERR" TURNED ON
; (CURLIN+1) = $FF IF IN DIRECT MODE
; ----------------------------------------------------------------------------
ERROR:
lsr Z14
.ifdef CONFIG_FILE
lda CURDVC ; output
beq LC366 ; is screen
jsr CLRCH ; otherwise redirect output back to screen
lda #$00
sta CURDVC
LC366:
.endif
jsr CRDO
jsr OUTQUES
L2329:
lda ERROR_MESSAGES,x
.ifndef CONFIG_SMALL
pha
and #$7F
.endif
jsr OUTDO
.ifdef CONFIG_SMALL
lda ERROR_MESSAGES+1,x
.ifdef KBD
and #$7F
.endif
jsr OUTDO
.else
inx
pla
bpl L2329
.endif
jsr STKINI
lda #<QT_ERROR
ldy #>QT_ERROR
; ----------------------------------------------------------------------------
; PRINT STRING AT (Y,A)
; PRINT CURRENT LINE # UNLESS IN DIRECT MODE
; FALL INTO WARM RESTART
; ----------------------------------------------------------------------------
PRINT_ERROR_LINNUM:
jsr STROUT
ldy CURLIN+1
iny
beq RESTART
jsr INPRT
; ----------------------------------------------------------------------------
; WARM RESTART ENTRY
; ----------------------------------------------------------------------------
RESTART:
.ifdef KBD
jsr CRDO
nop
L2351X:
jsr OKPRT
L2351:
jsr INLIN
LE28E:
bpl RESTART
.else
lsr Z14
lda #<QT_OK
ldy #>QT_OK
.ifdef CONFIG_CBM_ALL
jsr STROUT
.else
jsr GOSTROUT
.endif
L2351:
jsr INLIN
.endif
stx TXTPTR
sty TXTPTR+1
jsr CHRGET
.ifdef CONFIG_11
; bug in pre-1.1: CHRGET sets Z on '\0'
; and ':' - a line starting with ':' in
; direct mode gets ignored
tax
.endif
.ifdef KBD
beq L2351X
.else
beq L2351
.endif
ldx #$FF
stx CURLIN+1
bcc NUMBERED_LINE
jsr PARSE_INPUT_LINE
jmp NEWSTT2
; ----------------------------------------------------------------------------
; HANDLE NUMBERED LINE
; ----------------------------------------------------------------------------
NUMBERED_LINE:
jsr LINGET
jsr PARSE_INPUT_LINE
sty EOLPNTR
.ifdef KBD
jsr FNDLIN2
lda JMPADRS+1
sta LOWTR
sta Z96
lda JMPADRS+2
sta LOWTR+1
sta Z96+1
lda LINNUM
sta L06FE
lda LINNUM+1
sta L06FE+1
inc LINNUM
bne LE2D2
inc LINNUM+1
bne LE2D2
jmp SYNERR
LE2D2:
jsr LF457
ldx #Z96
jsr CMPJMPADRS
bcs LE2FD
LE2DC:
ldx #$00
lda (JMPADRS+1,x)
sta (Z96,x)
inc JMPADRS+1
bne LE2E8
inc JMPADRS+2
LE2E8:
inc Z96
bne LE2EE
inc Z96+1
LE2EE:
ldx #VARTAB
jsr CMPJMPADRS
bne LE2DC
lda Z96
sta VARTAB
lda Z96+1
sta VARTAB+1
LE2FD:
jsr SETPTRS
jsr LE33D
lda INPUTBUFFER
LE306:
beq LE28E
cmp #$A5
beq LE306
clc
.else
jsr FNDLIN
bcc PUT_NEW_LINE
ldy #$01
lda (LOWTR),y
sta INDEX+1
lda VARTAB
sta INDEX
lda LOWTR+1
sta DEST+1
lda LOWTR
dey
sbc (LOWTR),y
clc
adc VARTAB
sta VARTAB
sta DEST
lda VARTAB+1
adc #$FF
sta VARTAB+1
sbc LOWTR+1
tax
sec
lda LOWTR
sbc VARTAB
tay
bcs L23A5
inx
dec DEST+1
L23A5:
clc
adc INDEX
bcc L23AD
dec INDEX+1
clc
L23AD:
lda (INDEX),y
sta (DEST),y
iny
bne L23AD
inc INDEX+1
inc DEST+1
dex
bne L23AD
.endif
; ----------------------------------------------------------------------------
PUT_NEW_LINE:
.ifndef KBD
.ifdef CONFIG_2
jsr SETPTRS
jsr LE33D
lda INPUTBUFFER
beq L2351
clc
.else
lda INPUTBUFFER
beq FIX_LINKS
lda MEMSIZ
ldy MEMSIZ+1
sta FRETOP
sty FRETOP+1
.endif
.endif
lda VARTAB
sta HIGHTR
adc EOLPNTR
sta HIGHDS
ldy VARTAB+1
sty HIGHTR+1
bcc L23D6
iny
L23D6:
sty HIGHDS+1
jsr BLTU
.ifdef CONFIG_INPUTBUFFER_0200
lda LINNUM
ldy LINNUM+1
sta INPUTBUFFER-2
sty INPUTBUFFER-1
.endif
lda STREND
ldy STREND+1
sta VARTAB
sty VARTAB+1
ldy EOLPNTR
dey
; ---COPY LINE INTO PROGRAM-------
L23E6:
lda INPUTBUFFER-4,y
sta (LOWTR),y
dey
bpl L23E6
; ----------------------------------------------------------------------------
; CLEAR ALL VARIABLES
; RE-ESTABLISH ALL FORWARD LINKS
; ----------------------------------------------------------------------------
FIX_LINKS:
jsr SETPTRS
.ifdef CONFIG_2
jsr LE33D
jmp L2351
LE33D:
.endif
lda TXTTAB
ldy TXTTAB+1
sta INDEX
sty INDEX+1
clc
L23FA:
ldy #$01
lda (INDEX),y
.ifdef CONFIG_2
beq RET3
.else
jeq L2351
.endif
ldy #$04
L2405:
iny
lda (INDEX),y
bne L2405
iny
tya
adc INDEX
tax
ldy #$00
sta (INDEX),y
lda INDEX+1
adc #$00
iny
sta (INDEX),y
stx INDEX
sta INDEX+1
bcc L23FA ; always
; ----------------------------------------------------------------------------
.ifdef KBD
.include "kbd_loadsave.s"
.endif
.ifdef CONFIG_2
; !!! kbd_loadsave.s requires an RTS here!
RET3:
rts
.endif
.include "inline.s"
; ----------------------------------------------------------------------------
; TOKENIZE THE INPUT LINE
; ----------------------------------------------------------------------------
PARSE_INPUT_LINE:
ldx TXTPTR
ldy #$04
sty DATAFLG
L246C:
lda INPUTBUFFERX,x
.ifdef CONFIG_CBM_ALL
bpl LC49E
cmp #$FF
beq L24AC
inx
bne L246C
LC49E:
.endif
cmp #$20
beq L24AC
sta ENDCHR
cmp #$22
beq L24D0
bit DATAFLG
bvs L24AC
cmp #$3F
bne L2484
lda #TOKEN_PRINT
bne L24AC
L2484:
cmp #$30
bcc L248C
cmp #$3C
bcc L24AC
; ----------------------------------------------------------------------------
; SEARCH TOKEN NAME TABLE FOR MATCH STARTING
; WITH CURRENT CHAR FROM INPUT LINE
; ----------------------------------------------------------------------------
L248C:
sty STRNG2
ldy #$00
sty EOLPNTR
dey
stx TXTPTR
dex
L2496:
iny
L2497:
inx
L2498:
.ifdef KBD
jsr GET_UPPER
.else
lda INPUTBUFFERX,x
.ifndef CONFIG_2
cmp #$20
beq L2497
.endif
.endif
sec
sbc TOKEN_NAME_TABLE,y
beq L2496
cmp #$80
bne L24D7
ora EOLPNTR
; ----------------------------------------------------------------------------
; STORE CHARACTER OR TOKEN IN OUTPUT LINE
; ----------------------------------------------------------------------------
L24AA:
ldy STRNG2
L24AC:
inx
iny
sta INPUTBUFFER-5,y
lda INPUTBUFFER-5,y
beq L24EA
sec
sbc #$3A
beq L24BF
cmp #$49
bne L24C1
L24BF:
sta DATAFLG
L24C1:
sec
sbc #TOKEN_REM-':'
bne L246C
sta ENDCHR
; ----------------------------------------------------------------------------
; HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,
; BY COPYING CHARS UP TO ENDCHR.
; ----------------------------------------------------------------------------
L24C8:
lda INPUTBUFFERX,x
beq L24AC
cmp ENDCHR
beq L24AC
L24D0:
iny
sta INPUTBUFFER-5,y
inx
bne L24C8
; ----------------------------------------------------------------------------
; ADVANCE POINTER TO NEXT TOKEN NAME
; ----------------------------------------------------------------------------
L24D7:
ldx TXTPTR
inc EOLPNTR
L24DB:
iny
lda MATHTBL+28+1,y
bpl L24DB
lda TOKEN_NAME_TABLE,y
bne L2498
lda INPUTBUFFERX,x
bpl L24AA
; ---END OF LINE------------------
L24EA:
sta INPUTBUFFER-3,y
.ifdef CONFIG_NO_INPUTBUFFER_ZP
dec TXTPTR+1
.endif
lda #<INPUTBUFFER-1
sta TXTPTR
rts
; ----------------------------------------------------------------------------
; SEARCH FOR LINE
;
; (LINNUM) = LINE # TO FIND
; IF NOT FOUND: CARRY = 0
; LOWTR POINTS AT NEXT LINE
; IF FOUND: CARRY = 1
; LOWTR POINTS AT LINE
; ----------------------------------------------------------------------------
FNDLIN:
.ifdef KBD
jsr CHRGET
jmp LE444
LE440:
php
jsr LINGET
LE444:
jsr LF457
ldx #$FF
plp
beq LE464
jsr CHRGOT
beq L2520
cmp #$A5
bne L2520
jsr CHRGET
beq LE464
bcs LE461
jsr LINGET
beq L2520
LE461:
jmp SYNERR
LE464:
stx LINNUM
stx LINNUM+1
.else
lda TXTTAB
ldx TXTTAB+1
FL1:
ldy #$01
sta LOWTR
stx LOWTR+1
lda (LOWTR),y
beq L251F
iny
iny
lda LINNUM+1
cmp (LOWTR),y
bcc L2520
beq L250D
dey
bne L2516
L250D:
lda LINNUM
dey
cmp (LOWTR),y
bcc L2520
beq L2520
L2516:
dey
lda (LOWTR),y
tax
dey
lda (LOWTR),y
bcs FL1
L251F:
clc
.endif
L2520:
rts
; ----------------------------------------------------------------------------
; "NEW" STATEMENT
; ----------------------------------------------------------------------------
NEW:
bne L2520
SCRTCH:
lda #$00
tay
sta (TXTTAB),y
iny
sta (TXTTAB),y
lda TXTTAB
.ifdef CONFIG_2
clc
.endif
adc #$02
sta VARTAB
lda TXTTAB+1
adc #$00
sta VARTAB+1
; ----------------------------------------------------------------------------
SETPTRS:
jsr STXTPT
.ifdef CONFIG_11A
lda #$00
; ----------------------------------------------------------------------------
; "CLEAR" STATEMENT
; ----------------------------------------------------------------------------
CLEAR:
bne L256A
.endif
CLEARC:
.ifdef KBD
lda #<CONST_MEMSIZ
ldy #>CONST_MEMSIZ
.else
lda MEMSIZ
ldy MEMSIZ+1
.endif
sta FRETOP
sty FRETOP+1
.ifdef CONFIG_CBM_ALL
jsr CLALL
.endif
lda VARTAB
ldy VARTAB+1
sta ARYTAB
sty ARYTAB+1
sta STREND
sty STREND+1
jsr RESTORE
; ----------------------------------------------------------------------------
STKINI:
ldx #TEMPST
stx TEMPPT
pla
.ifdef CONFIG_2
tay
.else
sta STACK+STACK_TOP+1
.endif
pla
.ifndef CONFIG_2
sta STACK+STACK_TOP+2
.endif
ldx #STACK_TOP
txs
.ifdef CONFIG_2
pha
tya
pha
.endif
lda #$00
sta OLDTEXT+1
sta SUBFLG
L256A:
rts
; ----------------------------------------------------------------------------
; SET TXTPTR TO BEGINNING OF PROGRAM
; ----------------------------------------------------------------------------
STXTPT:
clc
lda TXTTAB
adc #$FF
sta TXTPTR
lda TXTTAB+1
adc #$FF
sta TXTPTR+1
rts
; ----------------------------------------------------------------------------
.ifdef KBD
LE4C0:
ldy #<LE444
ldx #>LE444
LE4C4:
jsr LFFD6
jsr LFFED
lda $0504
clc
adc #$08
sta $0504
rts
CMPJMPADRS:
lda 1,x
cmp JMPADRS+2
bne LE4DE
lda 0,x
cmp JMPADRS+1
LE4DE:
rts
.endif
; ----------------------------------------------------------------------------
; "LIST" STATEMENT
; ----------------------------------------------------------------------------
LIST:
.ifdef KBD
jsr LE440
bne LE4DE
pla
pla
L25A6:
jsr CRDO
.else
.ifdef MICROTAN
php
jmp LE21C ; patch
LC57E:
.else
bcc L2581
beq L2581
cmp #TOKEN_MINUS
bne L256A
L2581:
jsr LINGET
.endif
jsr FNDLIN
.ifdef MICROTAN
plp
beq L2598
.endif
jsr CHRGOT
.ifdef MICROTAN
beq L25A6
.else
beq L2598
.endif
cmp #TOKEN_MINUS
bne L2520
jsr CHRGET
.ifdef MICROTAN
beq L2598
jsr LINGET
beq L25A6
rts
.else
jsr LINGET
bne L2520
.endif
L2598:
.ifndef MICROTAN
pla
pla
lda LINNUM
ora LINNUM+1
bne L25A6
.endif
lda #$FF
sta LINNUM
sta LINNUM+1
L25A6:
.ifdef MICROTAN
pla
pla
.endif
L25A6X:
.endif
ldy #$01
.ifdef CONFIG_DATAFLG
sty DATAFLG
.endif
lda (LOWTRX),y
beq L25E5
.ifdef MICROTAN
jmp LE21F
LC5A9:
.else
jsr ISCNTC
.endif
.ifndef KBD
jsr CRDO
.endif
iny
lda (LOWTRX),y
tax
iny
lda (LOWTRX),y
cmp LINNUM+1
bne L25C1
cpx LINNUM
beq L25C3
L25C1:
bcs L25E5
; ---LIST ONE LINE----------------
L25C3:
sty FORPNT
jsr LINPRT
lda #$20
L25CA:
ldy FORPNT
and #$7F
L25CE:
jsr OUTDO
.ifdef CONFIG_DATAFLG
cmp #$22
bne LA519
lda DATAFLG
eor #$FF
sta DATAFLG
LA519:
.endif
iny
.ifdef CONFIG_11
beq L25E5
.endif
lda (LOWTRX),y
bne L25E8
tay
lda (LOWTRX),y
tax
iny
lda (LOWTRX),y
stx LOWTRX
sta LOWTRX+1
.ifdef MICROTAN
bne L25A6X
.else
bne L25A6
.endif
L25E5:
jmp RESTART
L25E8:
bpl L25CE
.ifdef CONFIG_DATAFLG
cmp #$FF
beq L25CE
bit DATAFLG
bmi L25CE
.endif
sec
sbc #$7F
tax
sty FORPNT
ldy #$FF
L25F2:
dex
beq L25FD
L25F5:
iny
lda TOKEN_NAME_TABLE,y
bpl L25F5
bmi L25F2
L25FD:
iny
lda TOKEN_NAME_TABLE,y
bmi L25CA
jsr OUTDO
bne L25FD ; always

17
software/retro1-tests/OSI/msbasic/regress.sh Normal file
View File

@ -0,0 +1,17 @@
if [ ! -d orig ]; then
echo Please first run make.sh on the original .s files, create
echo the directory \"orig\", and copy all .bin files from \"tmp\"
echo into \"orig\".
exit;
fi
for i in cbmbasic1 cbmbasic2 kbdbasic osi kb9 applesoft microtan; do
echo $i
ca65 -D $i msbasic.s -o tmp/$i.o &&
ld65 -C $i.cfg tmp/$i.o -o tmp/$i-new.bin -Ln tmp/$i.lbl &&
xxd -g 1 orig/$i.bin > tmp/$i.bin.txt
xxd -g 1 tmp/$i-new.bin > tmp/$i-new.bin.txt
diff -u tmp/$i.bin.txt tmp/$i-new.bin.txt | head
done

135
software/retro1-tests/OSI/msbasic/rnd.s Normal file
View File

@ -0,0 +1,135 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "RND" FUNCTION
; ----------------------------------------------------------------------------
.ifdef KBD
RND:
ldx #$10
jsr SIGN
beq LFC26
bmi LFC10
lda RNDSEED
ldy RNDSEED+1
LFBFA:
sta FAC+2
sty FAC+1
LFBFE:
asl a
asl a
eor FAC+2
asl a
eor FAC+1
asl a
asl a
asl a
asl a
eor FAC+1
asl a
rol FAC+2
rol FAC+1
LFC10:
lda FAC+2
dex
bne LFBFE
sta RNDSEED
sta FAC+3
lda FAC+1
sta RNDSEED+1
lda #$80
sta FAC
stx FACSIGN
jmp NORMALIZE_FAC2
LFC26:
ldy $03CA
lda $03C7
ora #$01
GOMOVMF:
bne LFBFA
.byte $F0
.else
; <<< THESE ARE MISSING ONE BYTE FOR FP VALUES >>>
; (non CONFIG_SMALL)
CONRND1:
.byte $98,$35,$44,$7A
CONRND2:
.byte $68,$28,$B1,$46
RND:
jsr SIGN
.ifdef CONFIG_CBM_ALL
bmi L3F01
bne LDF63
lda ENTROPY
sta FAC+1
lda ENTROPY+4
sta FAC+2
lda ENTROPY+1
sta FAC+3
lda ENTROPY+5
sta FAC+4
jmp LDF88
LDF63:
.else
tax
bmi L3F01
.endif
lda #<RNDSEED
ldy #>RNDSEED
jsr LOAD_FAC_FROM_YA
.ifndef CONFIG_CBM_ALL
txa
beq RTS19
.endif
lda #<CONRND1
ldy #>CONRND1
jsr FMULT
lda #<CONRND2
ldy #>CONRND2
jsr FADD
L3F01:
ldx FAC_LAST
lda FAC+1
sta FAC_LAST
stx FAC+1
.ifdef CONFIG_CBM_ALL
ldx FAC+2
lda FAC+3
sta FAC+2
stx FAC+3
LDF88:
.endif
lda #$00
sta FACSIGN
lda FAC
sta FACEXTENSION
lda #$80
sta FAC
jsr NORMALIZE_FAC2
ldx #<RNDSEED
ldy #>RNDSEED
GOMOVMF:
jmp STORE_FAC_AT_YX_ROUNDED
.endif
.segment "CHRGET"
; ----------------------------------------------------------------------------
; INITIAL VALUE FOR RANDOM NUMBER, ALSO COPIED
; IN ALONG WITH CHRGET, BUT ERRONEOUSLY:
; <<< THE LAST BYTE IS NOT COPIED >>>
; (on all non-CONFIG_SMALL)
; ----------------------------------------------------------------------------
GENERIC_RNDSEED:
.ifndef KBD
; random number seed
.ifdef CONFIG_SMALL
.byte $80,$4F,$C7,$52
.else
.ifdef CONFIG_11
.byte $80,$4F,$C7,$52,$58
.else
.byte $80,$4F,$C7,$52,$59
.endif
.endif
.endif
GENERIC_CHRGET_END:

779
software/retro1-tests/OSI/msbasic/string.s Normal file
View File

@ -0,0 +1,779 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "STR$" FUNCTION
; ----------------------------------------------------------------------------
STR:
jsr CHKNUM
ldy #$00
jsr FOUT1
pla
pla
LD353:
lda #$FF
ldy #$00
beq STRLIT
; ----------------------------------------------------------------------------
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
; ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
; ----------------------------------------------------------------------------
STRINI:
ldx FAC_LAST-1
ldy FAC_LAST
stx DSCPTR
sty DSCPTR+1
; ----------------------------------------------------------------------------
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
; ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
; ----------------------------------------------------------------------------
STRSPA:
jsr GETSPA
stx FAC+1
sty FAC+2
sta FAC
rts
; ----------------------------------------------------------------------------
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
; AND TERMINATED BY $00 OR QUOTATION MARK
; RETURN WITH DESCRIPTOR IN A TEMPORARY
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
STRLIT:
ldx #$22
stx CHARAC
stx ENDCHR
; ----------------------------------------------------------------------------
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
; AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
;
; RETURN WITH DESCRIPTOR IN A TEMPORARY
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
STRLT2:
sta STRNG1
sty STRNG1+1
sta FAC+1
sty FAC+2
ldy #$FF
L3298:
iny
lda (STRNG1),y
beq L32A9
cmp CHARAC
beq L32A5
cmp ENDCHR
bne L3298
L32A5:
cmp #$22
beq L32AA
L32A9:
clc
L32AA:
sty FAC
tya
adc STRNG1
sta STRNG2
ldx STRNG1+1
bcc L32B6
inx
L32B6:
stx STRNG2+1
lda STRNG1+1
.ifdef CONFIG_NO_INPUTBUFFER_ZP
beq LD399
cmp #>INPUTBUFFER
.endif
bne PUTNEW
LD399:
tya
jsr STRINI
ldx STRNG1
ldy STRNG1+1
jsr MOVSTR
; ----------------------------------------------------------------------------
; STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
;
; THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
; PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
PUTNEW:
ldx TEMPPT
cpx #TEMPST+9
bne PUTEMP
ldx #ERR_FRMCPX
JERR:
jmp ERROR
PUTEMP:
lda FAC
sta 0,x
lda FAC+1
sta 1,x
lda FAC+2
sta 2,x
ldy #$00
stx FAC_LAST-1
sty FAC_LAST
.ifdef CONFIG_2
sty FACEXTENSION
.endif
dey
sty VALTYP
stx LASTPT
inx
inx
inx
stx TEMPPT
rts
; ----------------------------------------------------------------------------
; MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
; (A)=# BYTES SPACE TO MAKE
;
; RETURN WITH (A) SAME,
; AND Y,X = ADDRESS OF SPACE ALLOCATED
; ----------------------------------------------------------------------------
GETSPA:
lsr DATAFLG
L32F1:
pha
eor #$FF
sec
adc FRETOP
ldy FRETOP+1
bcs L32FC
dey
L32FC:
cpy STREND+1
bcc L3311
bne L3306
cmp STREND
bcc L3311
L3306:
sta FRETOP
sty FRETOP+1
sta FRESPC
sty FRESPC+1
tax
pla
rts
L3311:
ldx #ERR_MEMFULL
lda DATAFLG
bmi JERR
jsr GARBAG
lda #$80
sta DATAFLG
pla
bne L32F1
; ----------------------------------------------------------------------------
; SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
; IN MEMORY (AGAINST HIMEM), FREEING UP SPACE
; BELOW STRING AREA DOWN TO STREND.
; ----------------------------------------------------------------------------
GARBAG:
.ifdef CONST_MEMSIZ
ldx #<CONST_MEMSIZ
lda #>CONST_MEMSIZ
.else
ldx MEMSIZ
lda MEMSIZ+1
.endif
FINDHIGHESTSTRING:
stx FRETOP
sta FRETOP+1
ldy #$00
sty FNCNAM+1
.ifdef CONFIG_2
sty FNCNAM ; GC bugfix!
.endif
lda STREND
ldx STREND+1
sta LOWTR
stx LOWTR+1
lda #TEMPST
ldx #$00
sta INDEX
stx INDEX+1
L333D:
cmp TEMPPT
beq L3346
jsr CHECK_VARIABLE
beq L333D
L3346:
lda #BYTES_PER_VARIABLE
sta DSCLEN
lda VARTAB
ldx VARTAB+1
sta INDEX
stx INDEX+1
L3352:
cpx ARYTAB+1
bne L335A
cmp ARYTAB
beq L335F
L335A:
jsr CHECK_SIMPLE_VARIABLE
beq L3352
L335F:
sta HIGHDS
stx HIGHDS+1
lda #$03 ; OSI GC bugfix -> $04 ???
sta DSCLEN
L3367:
lda HIGHDS
ldx HIGHDS+1
L336B:
cpx STREND+1
bne L3376
cmp STREND
bne L3376
jmp MOVE_HIGHEST_STRING_TO_TOP
L3376:
sta INDEX
stx INDEX+1
.ifdef CONFIG_SMALL
ldy #$01
.else
ldy #$00
lda (INDEX),y
tax
iny
.endif
lda (INDEX),y
php
iny
lda (INDEX),y
adc HIGHDS
sta HIGHDS
iny
lda (INDEX),y
adc HIGHDS+1
sta HIGHDS+1
plp
bpl L3367
.ifndef CONFIG_SMALL
txa
bmi L3367
.endif
iny
lda (INDEX),y
.ifdef CONFIG_CBM1_PATCHES
jsr LE7F3 ; XXX patch, call into screen editor
.else
.ifdef CONFIG_11
ldy #$00 ; GC bugfix
.endif
asl a
adc #$05
.endif
adc INDEX
sta INDEX
bcc L33A7
inc INDEX+1
L33A7:
ldx INDEX+1
L33A9:
cpx HIGHDS+1
bne L33B1
cmp HIGHDS
beq L336B
L33B1:
jsr CHECK_VARIABLE
beq L33A9
; ----------------------------------------------------------------------------
; PROCESS A SIMPLE VARIABLE
; ----------------------------------------------------------------------------
CHECK_SIMPLE_VARIABLE:
.ifndef CONFIG_SMALL
lda (INDEX),y
bmi CHECK_BUMP
.endif
iny
lda (INDEX),y
bpl CHECK_BUMP
iny
; ----------------------------------------------------------------------------
; IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
; ----------------------------------------------------------------------------
CHECK_VARIABLE:
lda (INDEX),y
beq CHECK_BUMP
iny
lda (INDEX),y
tax
iny
lda (INDEX),y
cmp FRETOP+1
bcc L33D5
bne CHECK_BUMP
cpx FRETOP
bcs CHECK_BUMP
L33D5:
cmp LOWTR+1
bcc CHECK_BUMP
bne L33DF
cpx LOWTR
bcc CHECK_BUMP
L33DF:
stx LOWTR
sta LOWTR+1
lda INDEX
ldx INDEX+1
sta FNCNAM
stx FNCNAM+1
lda DSCLEN
sta Z52
; ----------------------------------------------------------------------------
; ADD (DSCLEN) TO PNTR IN INDEX
; RETURN WITH Y=0, PNTR ALSO IN X,A
; ----------------------------------------------------------------------------
CHECK_BUMP:
lda DSCLEN
clc
adc INDEX
sta INDEX
bcc L33FA
inc INDEX+1
L33FA:
ldx INDEX+1
ldy #$00
rts
; ----------------------------------------------------------------------------
; FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
; TO TOP AND GO BACK FOR ANOTHER
; ----------------------------------------------------------------------------
MOVE_HIGHEST_STRING_TO_TOP:
.ifdef CONFIG_2
lda FNCNAM+1 ; GC bugfix
ora FNCNAM
.else
ldx FNCNAM+1
.endif
beq L33FA
lda Z52
.ifndef CONFIG_10A
sbc #$03
.else
and #$04
.endif
lsr a
tay
sta Z52
lda (FNCNAM),y
adc LOWTR
sta HIGHTR
lda LOWTR+1
adc #$00
sta HIGHTR+1
lda FRETOP
ldx FRETOP+1
sta HIGHDS
stx HIGHDS+1
jsr BLTU2
ldy Z52
iny
lda HIGHDS
sta (FNCNAM),y
tax
inc HIGHDS+1
lda HIGHDS+1
iny
sta (FNCNAM),y
jmp FINDHIGHESTSTRING
; ----------------------------------------------------------------------------
; CONCATENATE TWO STRINGS
; ----------------------------------------------------------------------------
CAT:
lda FAC_LAST
pha
lda FAC_LAST-1
pha
jsr FRM_ELEMENT
jsr CHKSTR
pla
sta STRNG1
pla
sta STRNG1+1
ldy #$00
lda (STRNG1),y
clc
adc (FAC_LAST-1),y
bcc L3454
ldx #ERR_STRLONG
jmp ERROR
L3454:
jsr STRINI
jsr MOVINS
lda DSCPTR
ldy DSCPTR+1
jsr FRETMP
jsr MOVSTR1
lda STRNG1
ldy STRNG1+1
jsr FRETMP
jsr PUTNEW
jmp FRMEVL2
; ----------------------------------------------------------------------------
; GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
; AND MOVE DESCRIBED STRING TO (FRESPC)
; ----------------------------------------------------------------------------
MOVINS:
ldy #$00
lda (STRNG1),y
pha
iny
lda (STRNG1),y
tax
iny
lda (STRNG1),y
tay
pla
; ----------------------------------------------------------------------------
; MOVE STRING AT (Y,X) WITH LENGTH (A)
; TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1
; ----------------------------------------------------------------------------
MOVSTR:
stx INDEX
sty INDEX+1
MOVSTR1:
tay
beq L3490
pha
L3487:
dey
lda (INDEX),y
sta (FRESPC),y
tya
bne L3487
pla
L3490:
clc
adc FRESPC
sta FRESPC
bcc L3499
inc FRESPC+1
L3499:
rts
; ----------------------------------------------------------------------------
; IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
; ----------------------------------------------------------------------------
FRESTR:
jsr CHKSTR
; ----------------------------------------------------------------------------
; IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS
; A TEMPORARY STRING, RELEASE IT.
; ----------------------------------------------------------------------------
FREFAC:
lda FAC_LAST-1
ldy FAC_LAST
; ----------------------------------------------------------------------------
; IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
; A TEMPORARY STRING, RELEASE IT.
; ----------------------------------------------------------------------------
FRETMP:
sta INDEX
sty INDEX+1
jsr FRETMS
php
ldy #$00
lda (INDEX),y
pha
iny
lda (INDEX),y
tax
iny
lda (INDEX),y
tay
pla
plp
bne L34CD
cpy FRETOP+1
bne L34CD
cpx FRETOP
bne L34CD
pha
clc
adc FRETOP
sta FRETOP
bcc L34CC
inc FRETOP+1
L34CC:
pla
L34CD:
stx INDEX
sty INDEX+1
rts
; ----------------------------------------------------------------------------
; RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
; ----------------------------------------------------------------------------
FRETMS:
.ifdef KBD
cpy #$00
.else
cpy LASTPT+1
.endif
bne L34E2
cmp LASTPT
bne L34E2
sta TEMPPT
sbc #$03
sta LASTPT
ldy #$00
L34E2:
rts
; ----------------------------------------------------------------------------
; "CHR$" FUNCTION
; ----------------------------------------------------------------------------
CHRSTR:
jsr CONINT
txa
pha
lda #$01
jsr STRSPA
pla
ldy #$00
sta (FAC+1),y
pla
pla
jmp PUTNEW
; ----------------------------------------------------------------------------
; "LEFT$" FUNCTION
; ----------------------------------------------------------------------------
LEFTSTR:
jsr SUBSTRING_SETUP
cmp (DSCPTR),y
tya
SUBSTRING1:
bcc L3503
lda (DSCPTR),y
tax
tya
L3503:
pha
SUBSTRING2:
txa
SUBSTRING3:
pha
jsr STRSPA
lda DSCPTR
ldy DSCPTR+1
jsr FRETMP
pla
tay
pla
clc
adc INDEX
sta INDEX
bcc L351C
inc INDEX+1
L351C:
tya
jsr MOVSTR1
jmp PUTNEW
; ----------------------------------------------------------------------------
; "RIGHT$" FUNCTION
; ----------------------------------------------------------------------------
RIGHTSTR:
jsr SUBSTRING_SETUP
clc
sbc (DSCPTR),y
eor #$FF
jmp SUBSTRING1
; ----------------------------------------------------------------------------
; "MID$" FUNCTION
; ----------------------------------------------------------------------------
MIDSTR:
lda #$FF
sta FAC_LAST
jsr CHRGOT
cmp #$29
beq L353F
jsr CHKCOM
jsr GETBYT
L353F:
jsr SUBSTRING_SETUP
.ifdef CONFIG_2
beq GOIQ
.endif
dex
txa
pha
clc
ldx #$00
sbc (DSCPTR),y
bcs SUBSTRING2
eor #$FF
cmp FAC_LAST
bcc SUBSTRING3
lda FAC_LAST
bcs SUBSTRING3
; ----------------------------------------------------------------------------
; COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$:
; REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR
; ADDRESS, GET 1ST PARAMETER OF COMMAND
; ----------------------------------------------------------------------------
SUBSTRING_SETUP:
jsr CHKCLS
pla
.ifndef CONFIG_11
sta JMPADRS+1
pla
sta JMPADRS+2
.else
tay
pla
sta Z52
.endif
pla
pla
pla
tax
pla
sta DSCPTR
pla
sta DSCPTR+1
.ifdef CONFIG_11
lda Z52
pha
tya
pha
.endif
ldy #$00
txa
.ifndef CONFIG_2
beq GOIQ
.endif
.ifndef CONFIG_11
inc JMPADRS+1
jmp (JMPADRS+1)
.else
rts
.endif
; ----------------------------------------------------------------------------
; "LEN" FUNCTION
; ----------------------------------------------------------------------------
LEN:
jsr GETSTR
SNGFLT1:
jmp SNGFLT
; ----------------------------------------------------------------------------
; IF LAST RESULT IS A TEMPORARY STRING, FREE IT
; MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG
; ----------------------------------------------------------------------------
GETSTR:
jsr FRESTR
ldx #$00
stx VALTYP
tay
rts
; ----------------------------------------------------------------------------
; "ASC" FUNCTION
; ----------------------------------------------------------------------------
ASC:
jsr GETSTR
beq GOIQ
ldy #$00
lda (INDEX),y
tay
.ifndef CONFIG_11A
jmp SNGFLT1
.else
jmp SNGFLT
.endif
; ----------------------------------------------------------------------------
GOIQ:
jmp IQERR
; ----------------------------------------------------------------------------
; SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION
; TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
GTBYTC:
jsr CHRGET
; ----------------------------------------------------------------------------
; EVALUATE EXPRESSION AT TXTPTR, AND
; CONVERT IT TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
GETBYT:
jsr FRMNUM
; ----------------------------------------------------------------------------
; CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG
; ----------------------------------------------------------------------------
CONINT:
jsr MKINT
ldx FAC_LAST-1
bne GOIQ
ldx FAC_LAST
jmp CHRGOT
; ----------------------------------------------------------------------------
; "VAL" FUNCTION
; ----------------------------------------------------------------------------
VAL:
jsr GETSTR
bne L35AC
jmp ZERO_FAC
L35AC:
ldx TXTPTR
ldy TXTPTR+1
stx STRNG2
sty STRNG2+1
ldx INDEX
stx TXTPTR
clc
adc INDEX
sta DEST
ldx INDEX+1
stx TXTPTR+1
bcc L35C4
inx
L35C4:
stx DEST+1
ldy #$00
lda (DEST),y
pha
lda #$00
sta (DEST),y
jsr CHRGOT
jsr FIN
pla
ldy #$00
sta (DEST),y
; ----------------------------------------------------------------------------
; COPY STRNG2 INTO TXTPTR
; ----------------------------------------------------------------------------
POINT:
ldx STRNG2
ldy STRNG2+1
stx TXTPTR
sty TXTPTR+1
rts

Some files were not shown because too many files have changed in this diff Show More