mirror of https://github.com/mist64/cbmsrc.git
Michael Steil
6 years ago
77 changed files with 8614 additions and 1 deletions
@ -0,0 +1,806 @@
|
||||
.page |
||||
.subttl 'declare 06/05/84' |
||||
dclver =$0605 ;************keep current mmdd |
||||
|
||||
; assignments |
||||
|
||||
addprc =1 |
||||
lenfor =18 ;length of a 'for' entry in the run-time stack |
||||
lengos =5 ;length of a 'gosub'.... |
||||
buflen =89 ;ted input buffer size |
||||
bufpag =2 |
||||
stkend =507 |
||||
clmwid =10 ;print window 10 chars |
||||
pi =255 |
||||
numlev =23 |
||||
strsiz =3 |
||||
sperr =$10 |
||||
maxchr =80 |
||||
nwrap =2 ;max # of physical lines per logical line |
||||
.page |
||||
; i/o devices |
||||
; |
||||
|
||||
acia =$fd00 ;6551 acia |
||||
|
||||
xport =$fd10 ;6529 port |
||||
|
||||
bnksel =$fdd0 ;switch paragraph for banking cartridges |
||||
|
||||
ted =$ff00 |
||||
|
||||
timr1l =ted+0 ;timer 1 is used to write to tape |
||||
timr1h =ted+1 |
||||
timr2l =ted+2 ;timer 2 used by serial(timeout) |
||||
timr2h =ted+3 ;dipole hunter |
||||
timr3l =ted+4 ;timer 3 used to read data bits |
||||
timr3h =ted+5 |
||||
tedvcr =ted+6 ;ted's video control register |
||||
keybrd =ted+8 |
||||
tedirq =ted+9 |
||||
tedicr =ted+10 |
||||
tedcrh =ted+12 ;high byte of ted cursor register |
||||
tedcrl =ted+13 ;low byte of ted cursor register |
||||
tedmlo =ted+14 ;start of ls bytes of sound freq. values |
||||
tedmhi =ted+16 ;start of ms 2 bits of sound freq. values |
||||
tedvoi =ted+17 ;ls nybble is vol, ms nybble is voice on/off bits |
||||
tedcbr =ted+19 ;character base |
||||
romon =ted+62 |
||||
romoff =ted+63 |
||||
cbrlsb =$04 ;lsb of character base in char. base reg |
||||
|
||||
|
||||
; screen editor constants |
||||
; |
||||
llen =40 ;single line 40 columns |
||||
nlines =25 ;25 rows on screen |
||||
cr =$0d ;carriage return |
||||
lf =$0a ;line feed |
||||
.page |
||||
; basic zp storage |
||||
; |
||||
|
||||
*=0 |
||||
|
||||
pdir *=*+1 ;6510 port data dir reg |
||||
port *=*+1 ;6510 internal i/o port |
||||
srchtk *=*+1 ;token 'search' looks for (run-time stack) |
||||
zpvec1 *=*+2 ;temp (renumber) |
||||
zpvec2 *=*+2 ;temp (renumber) |
||||
integr |
||||
charac *=*+1 |
||||
endchr *=*+1 |
||||
trmpos *=*+1 |
||||
verck *=*+1 |
||||
count *=*+1 |
||||
dimflg *=*+1 |
||||
valtyp *=*+1 |
||||
intflg *=*+1 |
||||
garbfl |
||||
dores *=*+1 |
||||
subflg *=*+1 |
||||
inpflg *=*+1 |
||||
domask |
||||
tansgn *=*+1 |
||||
channl *=*+1 |
||||
poker |
||||
linnum *=*+2 |
||||
temppt *=*+1 |
||||
lastpt *=*+2 |
||||
tempst *=*+9 |
||||
index |
||||
index1 *=*+2 |
||||
index2 *=*+2 |
||||
resho *=*+1 |
||||
resmoh *=*+1 |
||||
addend |
||||
resmo *=*+1 |
||||
reslo *=*+1 |
||||
*=*+1 |
||||
txttab *=*+2 |
||||
vartab *=*+2 |
||||
arytab *=*+2 |
||||
strend *=*+2 |
||||
fretop *=*+2 |
||||
frespc *=*+2 |
||||
memsiz *=*+2 |
||||
curlin *=*+2 |
||||
txtptr *=*+2 ;pointer to basic text used by chrget,etc. |
||||
form ;used by print using |
||||
fndpnt *=*+2 ;pointer to item found by search |
||||
datlin *=*+2 |
||||
datptr *=*+2 |
||||
inpptr *=*+2 |
||||
varnam *=*+2 |
||||
fdecpt |
||||
varpnt *=*+2 |
||||
lstpnt |
||||
andmsk |
||||
forpnt *=*+2 |
||||
eormsk =forpnt+1 |
||||
vartxt |
||||
opptr *=*+2 |
||||
opmask *=*+1 |
||||
grbpnt |
||||
tempf3 |
||||
defpnt *=*+2 |
||||
dscpnt *=*+2 |
||||
*=*+1 |
||||
helper *=*+1 ;flags 'help' or 'list' |
||||
jmper *=*+1 |
||||
size *=*+1 |
||||
oldov *=*+1 |
||||
|
||||
tempf1 *=*+1 |
||||
ptarg1 =tempf1 ;multiply defined for instr |
||||
ptarg2 =tempf1+2 |
||||
str1 =tempf1+4 |
||||
str2 =tempf1+7 |
||||
positn =tempf1+10 |
||||
match =tempf1+11 |
||||
|
||||
temp =tempf1 ;multiply defined for graphic subs |
||||
|
||||
arypnt |
||||
highds *=*+2 |
||||
hightr *=*+2 |
||||
tempf2 |
||||
*=*+1 |
||||
deccnt |
||||
lowds *=*+2 |
||||
grbtop |
||||
dptflg |
||||
lowtr *=*+1 |
||||
expsgn *=*+1 |
||||
tenexp =lowds+1 |
||||
dsctmp |
||||
fac |
||||
facexp *=*+1 |
||||
facho *=*+1 |
||||
facmoh *=*+1 |
||||
indice |
||||
facmo *=*+1 |
||||
faclo *=*+1 |
||||
facsgn *=*+1 |
||||
degree |
||||
sgnflg *=*+1 |
||||
bits *=*+1 |
||||
argexp *=*+1 |
||||
argho *=*+1 |
||||
argmoh *=*+1 |
||||
argmo *=*+1 |
||||
arglo *=*+1 |
||||
argsgn *=*+1 |
||||
strng1 |
||||
arisgn *=*+1 |
||||
facov *=*+1 |
||||
|
||||
strng2 |
||||
polypt |
||||
curtol |
||||
fbufpt *=*+2 |
||||
|
||||
autinc *=*+2 ;inc. val for auto (0=off) |
||||
mvdflg *=*+1 ;flag if 10k hires allocated |
||||
|
||||
noze ;using's leading zero counter |
||||
keynum *=*+1 |
||||
|
||||
hulp ;counter |
||||
keysiz *=*+1 |
||||
|
||||
syntmp *=*+1 ;used as temp for indirect loads |
||||
dsdesc *=*+3 ;descriptor for ds$ |
||||
tos *=*+2 ;top of run time stack |
||||
tmpton *=*+2 ;temps used by music (tone & vol) |
||||
voicno *=*+1 |
||||
runmod *=*+1 ;flags run/direct mode |
||||
|
||||
parsts ;dos parser status word |
||||
point *=*+1 ;using's pointer to dec.pt |
||||
|
||||
|
||||
|
||||
; graphic zp storage |
||||
|
||||
graphm *=*+1 ;current graphic mode |
||||
colsel *=*+1 ;current color selected |
||||
mc1 *=*+1 ;multicolor1 |
||||
fg *=*+1 ;foreground color |
||||
scxmax *=*+1 ;maximum # of columns |
||||
scymax *=*+1 ;maximum # of rows |
||||
ltflag *=*+1 ;paint-left flag |
||||
rtflag *=*+1 ;paint-right flag |
||||
stopnb *=*+1 ;stop paint if not background/not same color |
||||
grapnt *=*+2 |
||||
vtemp1 *=*+1 |
||||
vtemp2 *=*+1 |
||||
|
||||
|
||||
|
||||
; kernal zp storage |
||||
; |
||||
*=$90 |
||||
status *=*+1 ;i/o operation status byte |
||||
stkey *=*+1 ;stop key flag |
||||
spverr *=*+1 ;temporary |
||||
verfck *=*+1 ;load or verify flag |
||||
c3p0 *=*+1 ;ieee buffered char flag |
||||
bsour *=*+1 ;char buffer for ieee |
||||
xsav *=*+1 ;temp for basin |
||||
ldtnd *=*+1 ;index to logical file |
||||
dfltn *=*+1 ;default input device # |
||||
dflto *=*+1 ;default output device # |
||||
msgflg *=*+1 ;os message flag |
||||
sal *=*+1 |
||||
sah *=*+1 |
||||
eal *=*+1 |
||||
eah *=*+1 |
||||
t1 *=*+2 ;temporary 1 |
||||
t2 *=*+2 ;temporary 2 |
||||
time *=*+3 ;24 hour clock in 1/60th seconds |
||||
r2d2 *=*+1 ;serial bus usage |
||||
tpbyte *=*+1 ;byte to be written/read on/off tape |
||||
bsour1 *=*+1 ;temp used by serial routine |
||||
sedeal ;temp. for scrolling |
||||
fpverr *=*+1 |
||||
dcount *=*+1 |
||||
fnlen *=*+1 ;length current file n str |
||||
la *=*+1 ;current file logical addr |
||||
sa *=*+1 ;current file 2nd addr |
||||
fa *=*+1 ;current file primary addr |
||||
fnadr *=*+2 ;addr current file name str |
||||
errsum *=*+1 |
||||
tmp0 |
||||
stal *=*+1 |
||||
stah *=*+1 |
||||
memuss *=*+2 ;load ram base |
||||
tapebs *=*+2 ;base pointer to cass buffer |
||||
tmp2 *=*+2 |
||||
wrbase *=*+2 ;pointer to data for tape writes |
||||
imparm *=*+2 ;pointer to immediate string for primm |
||||
fetptr *=*+2 ;pointer to byte to be fetched in banking fetchl routine |
||||
|
||||
; variables for screen editor |
||||
; |
||||
sedsal *=*+2 ;temp. for scrolling |
||||
rvs *=*+1 ;rvs field on flag |
||||
indx *=*+1 |
||||
lsxp *=*+1 ;x pos at start |
||||
lstp *=*+1 |
||||
sfdx *=*+1 ;shift mode on print |
||||
crsw *=*+1 ;input vs get flag |
||||
pnt *=*+2 ;pointer to row |
||||
pntr *=*+1 ;pointer to column |
||||
qtsw *=*+1 ;quote switch |
||||
sedt1 *=*+1 ;editor temp. use |
||||
tblx *=*+1 |
||||
datax *=*+1 |
||||
insrt *=*+1 ;insert mode flag |
||||
|
||||
*=*+25 ;area for use by banking software |
||||
cirseg *=*+1 ;degrees/circle-segment |
||||
user *=*+2 ;screen editor color ip |
||||
keytab *=*+2 ;keyscan table indirect |
||||
tmpkey *=*+1 |
||||
ndx *=*+1 ;index to keyboard q |
||||
stpflg *=*+1 ;pause flag |
||||
|
||||
; monitor zp storage |
||||
; |
||||
t0 *=*+2 |
||||
chrptr *=*+1 |
||||
bufend *=*+1 |
||||
|
||||
|
||||
|
||||
chksum *=*+1 ;temp for checksum calc |
||||
length *=*+1 |
||||
pass *=*+1 ;which pass we're doing str |
||||
type *=*+1 ;what type of block we're dealing with |
||||
usekdy *=*+1 ;(b.7=1)=> use for wr, (b.6=1)=> use for rd |
||||
xstop *=*+1 ;save x reg for quick stopkey test |
||||
|
||||
|
||||
|
||||
curbnk *=*+1 ;current bank configuration |
||||
xon *=*+1 ;char to send for an x-on |
||||
xoff *=*+1 ;char to send for an x-off |
||||
sedt2 *=*+1 ;editor temp. use |
||||
|
||||
|
||||
|
||||
*=$ff |
||||
lofbuf *=*+1 |
||||
fbuffr *=*+16 |
||||
|
||||
savea *=*+1 ;temp locations |
||||
savey *=*+1 ;...for save & restore |
||||
savex *=*+1 ;...for save & restore |
||||
colkey *=*+16 ;default color/luminance table |
||||
sysstk ;bottom of system stack |
||||
.page |
||||
*=$200 |
||||
buf *=*+buflen ;basic/monitor buffer |
||||
oldlin *=*+2 ;basic storage |
||||
oldtxt *=*+2 ;basic storage |
||||
|
||||
; basic/dos interface vars |
||||
; |
||||
xcnt *=*+1 ;dos loop counter |
||||
|
||||
fnbufr *=*+16 ;area for filename |
||||
dosf1l *=*+1 ;dos filename 1 len |
||||
dosds1 *=*+1 ;dos disk drive 1 |
||||
dosf1a *=*+2 ;dos filename 1 addr |
||||
|
||||
dosf2l *=*+1 ;dos filename 2 len |
||||
dosds2 *=*+1 ;dos disk drive 2 |
||||
dosf2a *=*+2 ;dos filename 2 addr |
||||
|
||||
dosla *=*+1 ;dos logical addr |
||||
dosfa *=*+1 ;dos phys addr |
||||
dossa *=*+1 ;dos sec. addr |
||||
|
||||
dosdid *=*+2 ;dos dsk identif. |
||||
didchk *=*+1 ;dos did flg |
||||
|
||||
dosstr *=*+1 ;dos output str. buf |
||||
dosspc =*-fnbufr ;space used by dos rout. |
||||
*=*+48 ;area to build dos string |
||||
.page |
||||
vwork ;graphics vars |
||||
|
||||
xypos |
||||
xpos *=*+2 ;current x position |
||||
ypos *=*+2 ;current y position |
||||
dest |
||||
xdest *=*+2 ;x-coordinate destination |
||||
ydest *=*+2 ;y-coordinate destination |
||||
|
||||
; line drawing variables |
||||
; |
||||
xyabs |
||||
xabs *=*+2 |
||||
yabs *=*+2 |
||||
xysgn |
||||
xsgn *=*+2 |
||||
ysgn *=*+2 |
||||
fct |
||||
fct1 *=*+2 |
||||
fct2 *=*+2 |
||||
errval *=*+2 |
||||
lesser *=*+1 |
||||
greatr *=*+1 |
||||
|
||||
; angle routine variables |
||||
; |
||||
angsgn *=*+1 ;sign of angle |
||||
sinval *=*+2 ;sine of value of angle |
||||
cosval *=*+2 ;cosine of value of angle |
||||
angcnt *=*+2 ;temps for angle distance routines |
||||
.page |
||||
; the following 24 bytes are multiply defined, beginning on this |
||||
; page, and continuing for the next 4 pages. |
||||
|
||||
params =* |
||||
*=*+1 ;placeholder |
||||
bnr *=*+1 ;pointer to begin. no. |
||||
enr *=*+1 ;pointer to end no. |
||||
dolr *=*+1 ;dollar flag |
||||
flag *=*+1 ;comma flag |
||||
swe *=*+1 ;counter |
||||
usgn *=*+1 ;sign exponent |
||||
uexp *=*+1 ;pointer to exponent |
||||
vn *=*+1 ;# of digits before decimal point |
||||
chsn *=*+1 ;justify flag |
||||
vf *=*+1 ;# of pos before decimal point (field) |
||||
nf *=*+1 ;# of pos after decimal point (field) |
||||
posp *=*+1 ;+/- flag (field) |
||||
fesp *=*+1 ;exponent flag (field) |
||||
etof *=*+1 ;switch |
||||
cform *=*+1 ;char counter (field) |
||||
sno *=*+1 ;sign no |
||||
blfd *=*+1 ;blank/star flag |
||||
begfd *=*+1 ;pointer to begin of field |
||||
lfor *=*+1 ;length of format |
||||
endfd *=*+1 ;pointer to end of field |
||||
*=*+3 ;placeholder |
||||
parend =* |
||||
.page |
||||
; general use parameters. (multiply defined with print using) |
||||
|
||||
*=params |
||||
|
||||
xcentr *=*+2 |
||||
ycentr *=*+2 |
||||
xdist1 *=*+2 |
||||
ydist1 *=*+2 |
||||
xdist2 *=*+2 |
||||
ydist2 *=*+2 |
||||
disend |
||||
*=*+2 ;placeholder |
||||
colcnt *=*+1 ;char's col. counter |
||||
rowcnt *=*+1 |
||||
strcnt *=*+1 |
||||
|
||||
|
||||
; box drawing variables. (multiply defined with print using) |
||||
|
||||
*=params |
||||
|
||||
xcord1 *=*+2 ;point 1 x-coord. |
||||
ycord1 *=*+2 ;point 1 y-coord. |
||||
boxang *=*+2 ;rotation angle |
||||
xcount *=*+2 |
||||
ycount *=*+2 |
||||
bxleng *=*+2 ;length of a side |
||||
xcord2 *=*+2 |
||||
ycord2 *=*+2 |
||||
|
||||
|
||||
; circle drawing variables. (multiply defined with print using) |
||||
|
||||
*=params |
||||
|
||||
xcircl *=*+2 ;circle center, x coordinate |
||||
ycircl *=*+2 ;circle center, y coordinate |
||||
xradus *=*+2 ;x radius |
||||
yradus *=*+2 ;y radius |
||||
rotang *=*+4 ;rotation angle |
||||
angbeg *=*+2 ;arc angle start |
||||
angend *=*+2 ;arc angle end |
||||
xrcos *=*+2 ;x radius * cos(rotation angle) |
||||
yrsin *=*+2 ;y radius * sin(rotation angle) |
||||
xrsin *=*+2 ;x radius * sin(rotation angle) |
||||
yrcos *=*+2 ;y radius * cos(rotation angle) |
||||
.page |
||||
; shape and move-shape variables (multiply defined with print using) |
||||
|
||||
*=params |
||||
|
||||
*=*+1 ;placeholder |
||||
keylen *=*+1 |
||||
keynxt *=*+1 |
||||
strsz *=*+1 ;string len |
||||
gettyp *=*+1 ;replace shape mode |
||||
strptr *=*+1 ;string pos'n counter |
||||
oldbyt *=*+1 ;old bit map byte |
||||
newbyt *=*+1 ;new string or bit map byte |
||||
*=*+1 ;placeholder |
||||
xsize *=*+2 ;shape column length |
||||
ysize *=*+2 ;shape row length |
||||
xsave *=*+2 ;temp for column length |
||||
stradr *=*+2 ;save shape string descriptor |
||||
bitidx *=*+1 ;bit index into byte |
||||
savsiz *=*+4 ;temp work locations |
||||
|
||||
|
||||
*=parend |
||||
|
||||
; graphic variables |
||||
; |
||||
chrpag *=*+1 ;high byte of address of char rom for 'char' command |
||||
bitcnt *=*+1 ;temp for gshape |
||||
scalem *=*+1 ;scale mode flag |
||||
width *=*+1 ;double width flag |
||||
filflg *=*+1 ;box fill flag |
||||
bitmsk *=*+1 ;temp for bit mask |
||||
numcnt *=*+1 |
||||
trcflg *=*+1 ;flags trace mode |
||||
|
||||
|
||||
t3 *=*+1 |
||||
t4 *=*+2 |
||||
vtemp3 *=*+1 ;graphic temp storage |
||||
vtemp4 *=*+1 |
||||
vtemp5 *=*+1 |
||||
|
||||
|
||||
adray1 *=*+2 ;ptr to routine: convert float -> integer |
||||
adray2 *=*+2 ;ptr to routine: convert integer -> float |
||||
.page |
||||
*=$2fe |
||||
|
||||
bnkvec *=*+2 ;vector for function cart. users |
||||
ierror *=*+2 ;indirect error (output error in .x) |
||||
imain *=*+2 ;indirect main (system direct loop) |
||||
icrnch *=*+2 ;indirect crunch (tokenization routine) |
||||
iqplop *=*+2 ;indirect list (char list) |
||||
igone *=*+2 ;indirect gone (char dispatch) |
||||
ieval *=*+2 ;indirect eval (symbol evaluation) |
||||
iesclk *=*+2 ;escape token crunch, |
||||
iescpr *=*+2 ;..list, |
||||
iescex *=*+2 ;..and execute |
||||
itime *=*+2 ;60 hz interrupt vector (before jiffy) |
||||
cinv *=*+2 ;irq ram vector |
||||
cbinv *=*+2 ;brk instr ram vector |
||||
iopen *=*+2 ;indirects for code |
||||
iclose *=*+2 ;conforms to kernal spec 8/19/80 |
||||
ichkin *=*+2 |
||||
ickout *=*+2 |
||||
iclrch *=*+2 |
||||
ibasin *=*+2 |
||||
ibsout *=*+2 |
||||
istop *=*+2 |
||||
igetin *=*+2 |
||||
iclall *=*+2 |
||||
usrcmd *=*+2 |
||||
iload *=*+2 |
||||
isave *=*+2 ;savesp |
||||
|
||||
*=*+1 ;*******************************************available |
||||
|
||||
|
||||
tapbuf *=*+192 ;cassette tape buffer |
||||
wrlen *=*+2 ;length in 2's compl. of data to be written to cassette |
||||
rdcnt *=*+2 ;length in 2's compl. of data to be read from cassette |
||||
|
||||
inpqln =64 ;length of rs232 input queue |
||||
inpque *=*+inpqln |
||||
hiwatr =$38 ;x-off trip point |
||||
lowatr =$08 ;x-on trip point |
||||
|
||||
estksz =30 ;size of cassette error stack |
||||
estakl *=*+estksz ;low addr |
||||
estakh *=*+estksz ;high addr |
||||
|
||||
chrget *=*+6 |
||||
chrgot *=*+12 |
||||
qnum *=*+15 |
||||
|
||||
|
||||
|
||||
; indirect load subroutine area |
||||
; |
||||
indsub *=*+14 ;shared rom fetch sub |
||||
zero *=*+3 ;numeric constant for basic, downloaded from rom |
||||
|
||||
indtxt *=*+11 ;txtptr |
||||
indin1 *=*+11 ;index & index1 |
||||
indin2 *=*+11 ;index2 |
||||
indst1 *=*+11 ;strng1 |
||||
indlow *=*+11 ;lowtr |
||||
indfmo *=*+11 ;facmo |
||||
|
||||
|
||||
|
||||
; declarations for print using |
||||
; |
||||
puchrs |
||||
pufill *=*+1 ;print using fill symbol |
||||
pucoma *=*+1 ;print using comma symbol |
||||
pudot *=*+1 ;print using d.p. symbol |
||||
pumony *=*+1 ;print using monetary symbol |
||||
|
||||
tmpdes *=*+4 ;temp for instr |
||||
|
||||
errnum *=*+1 ;used by error trapping routine-last error number |
||||
errlin *=*+2 ;line # of last error - ffff if no error |
||||
trapno *=*+2 ;line to go to on error.. ffxx if none set |
||||
tmptrp *=*+1 ;hold trap # tempor. |
||||
errtxt *=*+2 |
||||
oldstk *=*+1 |
||||
|
||||
tmptxt *=*+2 ;used by do-loop. could be mult. assigned |
||||
tmplin *=*+2 |
||||
|
||||
mtimlo *=*+2 ;table of pending jiffies till turnoff (in 2's comp) |
||||
mtimhi *=*+2 |
||||
usrpok *=*+3 |
||||
rndx *=*+5 |
||||
|
||||
dejavu *=*+1 ;'cold' or 'warm' reset status (must be in page 5!) |
||||
|
||||
|
||||
|
||||
; tables for open files |
||||
; |
||||
lat *=*+10 ;logical file numbers |
||||
fat *=*+10 ;primary device numbers |
||||
sat *=*+10 ;secondary addresses |
||||
|
||||
|
||||
; system storage |
||||
; |
||||
keyd *=*+10 ;irq keyboard buffer |
||||
memstr *=*+2 ;start of memory |
||||
msiz *=*+2 ;top of memory |
||||
timout *=*+1 ;ieee timeout flag |
||||
|
||||
|
||||
; cassette declarations... |
||||
; |
||||
filend *=*+1 ;filend reached::=1, 0 otherwise |
||||
ctally *=*+1 ;#of chars left in buffer (for r&w) |
||||
cbufva *=*+1 ;#of total valid chars in buffer (for r.o.) |
||||
tptr *=*+1 ;pointer to next chr in buffer (for r&w) |
||||
fltype *=*+1 ;contains type of current cass file |
||||
bufmax =191 ;size of the buffer for data entries (excluding type) |
||||
; |
||||
; tape block types |
||||
; |
||||
eot =5 ;end of tape |
||||
blf =1 ;basic load file |
||||
bdf =2 ;basic data file |
||||
plf =3 ;fixed program type |
||||
bdfh =4 ;basic data file header |
||||
|
||||
|
||||
|
||||
; screen editor storage |
||||
; |
||||
color *=*+1 ;active attribute byte |
||||
flash *=*+1 ;character flash flag |
||||
*=*+1 ;*******************************************available |
||||
hibase *=*+1 ;base location of screen (top) |
||||
xmax *=*+1 |
||||
rptflg *=*+1 ;key repeat flag |
||||
kount *=*+1 |
||||
delay *=*+1 |
||||
shflag *=*+1 ;shift flag byte |
||||
lstshf *=*+1 ;last shift pattern |
||||
keylog *=*+2 ;indirect for keyboard table setup |
||||
mode *=*+1 |
||||
autodn *=*+1 ;auto scroll down flag(=0 on,<>0 off) |
||||
lintmp *=*+1 |
||||
rolflg *=*+1 |
||||
|
||||
|
||||
|
||||
; monitor non-zp storage |
||||
; |
||||
format *=*+1 |
||||
msal *=*+3 |
||||
wrap *=*+1 |
||||
tmpc *=*+1 |
||||
diff *=*+1 |
||||
pch *=*+1 |
||||
pcl *=*+1 |
||||
flgs *=*+1 |
||||
acc *=*+1 |
||||
xr *=*+1 |
||||
yr *=*+1 |
||||
sp *=*+1 |
||||
invl *=*+1 |
||||
invh *=*+1 |
||||
cmpflg *=*+1 ;used by various monitor routines |
||||
bad *=*+1 |
||||
|
||||
kyndx *=*+1 ;used for programmable keys |
||||
keyidx *=*+1 |
||||
keybuf *=*+8 ;table of p.f. lengths |
||||
maxkys =128 |
||||
pkybuf *=*+maxkys ;p.f. key storage area |
||||
|
||||
|
||||
; kennedy interface variables... |
||||
; |
||||
kdata *=*+1 ;temp for data write to kennedy |
||||
kdycmd *=*+1 ;select for kennedy rd or wr |
||||
kdynum *=*+1 ;kennedy's dev# |
||||
kdyprs *=*+1 ;kennedy present::=$ff, else::=$00 |
||||
kdytyp *=*+1 ;temp stor. for type of open for kdy |
||||
; |
||||
; and constants... |
||||
; |
||||
tedrva =$fef0 |
||||
tedrvb =$fef1 |
||||
tedrvc =$fef2 |
||||
drva2 =$fef3 |
||||
drvb2 =$fef4 |
||||
drvc2 =$fef5 |
||||
|
||||
italk =$40 ;ieee talk |
||||
ilstn =$20 ;listen |
||||
iutalk =$5f ;untalk |
||||
iulstn =$3f ;unlisten |
||||
|
||||
kcmd1 =$81 ;state change |
||||
kcmd2 =$82 ;sec. addr |
||||
kcmd3 =$83 ;dout |
||||
kcmd4 =$84 ;din |
||||
|
||||
|
||||
|
||||
savram *=*+256 ;1 page used by banking routines |
||||
pat =savram ;physical address table for banking |
||||
lngjmp =savram+4 ;long jump address for banking 'long' routine |
||||
fetarg =savram+6 ;storage for long jumps |
||||
fetxrg =savram+7 |
||||
fetsrg =savram+8 |
||||
|
||||
stktop *=*+196 ;basic run-time stack |
||||
stkbot =* |
||||
|
||||
|
||||
; cassette primitive r&w variables |
||||
; |
||||
typenb ;doubly defined |
||||
wrout *=*+1 ;byte to be written on tape |
||||
|
||||
parity *=*+1 ;temp for parity calc |
||||
tt1 *=*+1 ;temp for write-header |
||||
tt2 *=*+1 ;temp for write-header |
||||
*=*+1 ;*************************************available |
||||
rdbits *=*+1 ;local index for readbyte routine |
||||
errsp *=*+1 ;pointer to the current entry in the error stack |
||||
fperrs *=*+1 ;number of first pass errors |
||||
; |
||||
; *** don't ever re-order the following 3 variables !!! *** |
||||
; |
||||
dsamp1 *=*+2 ;time constant for x cell sample |
||||
dsamp2 *=*+2 ;time constant for y cell sample |
||||
zcell *=*+2 ;time constant for z cell verify |
||||
|
||||
srecov *=*+1 ;stack marker for stopkey recover |
||||
drecov *=*+1 ;stack marker for dropout recover |
||||
trsave *=*+4 ;parmeters passed to rdblok |
||||
rdetmp *=*+1 ;temp stat save for rdblok |
||||
ldrscn *=*+1 ;#consec. shorts to find in leader |
||||
cderrm *=*+1 ;#errors fatal in rd countdown |
||||
vsave *=*+1 ;temp for verify command |
||||
t1pipe *=*+4 ;pipe temp for t1 |
||||
enext *=*+1 ;read error propagate |
||||
|
||||
|
||||
|
||||
; for rs-232... |
||||
; |
||||
uoutq *=*+1 ;user char to send |
||||
uoutfg *=*+1 ;0::=empty, 1::=full |
||||
soutq *=*+1 ;system char to send |
||||
soutfg *=*+1 ;0::=empty, 1::=full |
||||
inqfpt *=*+1 ;ptr to front of input queue |
||||
inqrpt *=*+1 ;ptr to rear of input queue |
||||
inqcnt *=*+1 ;# of chars in input queue |
||||
astat *=*+1 ;temp ststus word for the acia |
||||
aintmp *=*+1 ;temp for input routine |
||||
alstop *=*+1 ;flg to indicate if we're paused locally |
||||
arstop *=*+1 ;flg to indicate if remote is paused |
||||
apres *=*+1 ;flg to indicate if acia in system |
||||
|
||||
|
||||
|
||||
; indirect routine downloaded here... |
||||
; |
||||
kludes *=*+12 |
||||
sinner =kludes+6 |
||||
|
||||
|
||||
scbot *=*+1 |
||||
sctop *=*+1 |
||||
sclf *=*+1 |
||||
scrt *=*+1 |
||||
scrdis *=*+1 |
||||
insflg *=*+1 |
||||
lstchr *=*+1 |
||||
logscr *=*+1 |
||||
tcolor *=*+1 |
||||
bitabl *=*+4 |
||||
|
||||
|
||||
sareg *=*+1 ;reg's for sys command |
||||
sxreg *=*+1 |
||||
syreg *=*+1 |
||||
spreg *=*+1 |
||||
|
||||
lstx *=*+1 ;key scan index |
||||
stpdsb *=*+1 ;flag to disable ctl-s pause |
||||
ramrom *=*+1 ;msb flags monitor fetches from ram (0) or rom (1) |
||||
colsw *=*+1 ;msb flags color/lum. table in ram (0) or rom (1) |
||||
ffrmsk *=*+1 ;rom mask (split screen) |
||||
vmbmsk *=*+1 ;v.m. base mask (split screen) |
||||
lsem *=*+1 ;motor lock semaphore for cassette (**02/08/84) |
||||
palcnt *=*+1 ;pal tod (**02/17/84) |
||||
|
||||
|
||||
tedatr =$0800 ;ted attribute bytes |
||||
tedscn =$0c00 ;ted character pointers |
||||
basbgn =$1000 |
||||
grbase =$2000 ;graphic base is the same as basic beginning |
||||
bmcolr =$1c00 |
||||
bmlum =$1800 |
||||
chrbas =$d000 ;beginning of 'character rom' |
||||
|
||||
;end |
||||
@ -0,0 +1,417 @@
|
||||
.page |
||||
.subttl 'ed1 ted 07/10/84' |
||||
|
||||
.byte >dclver,<dclver ;mark declare version |
||||
|
||||
ldtb2 ;screen lines low byte table |
||||
.byte <linz0 ;**must** be at $d802...if this is changed, tell basic! |
||||
.byte <linz1 |
||||
.byte <linz2 |
||||
.byte <linz3 |
||||
.byte <linz4 |
||||
.byte <linz5 |
||||
.byte <linz6 |
||||
.byte <linz7 |
||||
.byte <linz8 |
||||
.byte <linz9 |
||||
.byte <linz10 |
||||
.byte <linz11 |
||||
.byte <linz12 |
||||
.byte <linz13 |
||||
.byte <linz14 |
||||
.byte <linz15 |
||||
.byte <linz16 |
||||
.byte <linz17 |
||||
.byte <linz18 |
||||
.byte <linz19 |
||||
.byte <linz20 |
||||
.byte <linz21 |
||||
.byte <linz22 |
||||
.byte <linz23 |
||||
.byte <linz24 |
||||
ldtb1 ;screen lines high byte table |
||||
.byte >linz0 |
||||
.byte >linz1 |
||||
.byte >linz2 |
||||
.byte >linz3 |
||||
.byte >linz4 |
||||
.byte >linz5 |
||||
.byte >linz6 |
||||
.byte >linz7 |
||||
.byte >linz8 |
||||
.byte >linz9 |
||||
.byte >linz10 |
||||
.byte >linz11 |
||||
.byte >linz12 |
||||
.byte >linz13 |
||||
.byte >linz14 |
||||
.byte >linz15 |
||||
.byte >linz16 |
||||
.byte >linz17 |
||||
.byte >linz18 |
||||
.byte >linz19 |
||||
.byte >linz20 |
||||
.byte >linz21 |
||||
.byte >linz22 |
||||
.byte >linz23 |
||||
.byte >linz24 |
||||
.page |
||||
scrorg ;return max. # rows, cols of screen |
||||
ldx #llen |
||||
ldy #nlines |
||||
rts |
||||
|
||||
|
||||
plot ;set or read cursor position |
||||
bcs plot10 |
||||
stx tblx ;.c=0 means set it |
||||
stx lsxp |
||||
sty pntr |
||||
sty lstp |
||||
jsr sreset ;(in case it's outside window) |
||||
jsr stupt |
||||
plot10 |
||||
ldx tblx ;.c=1 means read it |
||||
ldy pntr |
||||
rts |
||||
|
||||
|
||||
|
||||
;**************************************** |
||||
; |
||||
; cint: initialize screen & editor |
||||
; |
||||
;**************************************** |
||||
|
||||
cint |
||||
lda #$0c ;set up base of screen |
||||
sta hibase |
||||
|
||||
lda #3 |
||||
sta dflto |
||||
lda #0 |
||||
sta dfltn |
||||
|
||||
sta mode ;always pet mode |
||||
sta graphm ;always text mode |
||||
sta ndx ;no keys in buffer yet |
||||
sta stpflg ;flag 'no ctl-s yet' |
||||
|
||||
lda #<shflog ;set shift logic indirects |
||||
sta keylog |
||||
lda #>shflog |
||||
sta keylog+1 |
||||
lda #10 |
||||
sta xmax ;maximum type ahead buffer size |
||||
sta rolflg ;flag 'roll ok, if in basic, and if in direct mode' |
||||
sta delay |
||||
lda #$80 |
||||
sta rptflg ;make all keys repeat |
||||
lda #16 ;init color to gk. blue |
||||
sta color |
||||
lda #4 |
||||
sta kount ;delay between key repeats |
||||
|
||||
setbig ;setup full screen window, clear it & clear wrap table |
||||
jsr sreset |
||||
clsr ;clear screen |
||||
jsr home ;start at top of window |
||||
cls10 |
||||
jsr scrset ;point to line |
||||
jsr clrln ;clear the line |
||||
cpx scbot ;done? |
||||
inx |
||||
bcc cls10 ;no |
||||
|
||||
home ;home cursor |
||||
ldx sctop ;move to top of window |
||||
stx tblx |
||||
stx lsxp ;(for input after home or clear) |
||||
stu10 |
||||
ldy sclf ;move to left side of window |
||||
sty pntr |
||||
sty lstp |
||||
stupt |
||||
ldx tblx ;set pointers to beginning of line |
||||
|
||||
scrset |
||||
lda ldtb2,x ;.x=line # to set up |
||||
sta pnt |
||||
lda ldtb1,x ;pointer to screen ram |
||||
sta pnt+1 |
||||
|
||||
;pointer to screen ram, fall into 'scolor' |
||||
; |
||||
scolor |
||||
lda pnt ;generate color pointer |
||||
sta user |
||||
lda pnt+1 |
||||
and #$03 |
||||
ora #>tedatr ;address of ted attribute byte area |
||||
sta user+1 |
||||
rts |
||||
|
||||
|
||||
; remove character from queue |
||||
; |
||||
lp2 |
||||
ldy kyndx ;are there any pf keys? |
||||
beq lp3 ;branch if not |
||||
ldy keyidx ;get index to current char |
||||
lda pkybuf,y ;get current byte |
||||
dec kyndx ;1 byte down |
||||
inc keyidx ;bump index to next char |
||||
cli |
||||
rts |
||||
lp3 |
||||
ldy keyd ;get key from irq buffer |
||||
ldx #0 |
||||
lp1 |
||||
lda keyd+1,x |
||||
sta keyd,x |
||||
inx |
||||
cpx ndx |
||||
bne lp1 |
||||
dec ndx |
||||
tya |
||||
cli |
||||
clc ;always good return from keybd! |
||||
rts |
||||
|
||||
loop4 |
||||
jsr print |
||||
loop3 ;turn on cursor |
||||
jsr scolor ;set up (user) to point to start of current attr bytes row |
||||
ldy pntr ;get column |
||||
lda (user),y ;get old color |
||||
pha ;save it |
||||
|
||||
lda color ;make cursor flash in current color |
||||
sta (user),y |
||||
|
||||
tya ;calculate current screen position |
||||
clc |
||||
adc pnt |
||||
sta tedcrl ;point cursor there |
||||
lda pnt+1 |
||||
adc #0 ;(.c will be clear for sbc following!) |
||||
sbc #>tedscn-1 ;ted crsr posn. is relative to start of screen |
||||
sta tedcrh |
||||
|
||||
waitky |
||||
lda ndx ;are there any keys ready? |
||||
ora kyndx ;or any in the pf key buffer? |
||||
beq waitky ;loop if not |
||||
|
||||
; turn off cursor |
||||
; |
||||
pla ;get saved color |
||||
sta (user),y ;put it in |
||||
lda #$ff ;point cursor to cuba |
||||
sta tedcrh ;(it's the only way to turn it off) |
||||
sta tedcrl |
||||
jsr lp2 ;get key input |
||||
|
||||
cmp #$83 ;<shift><run/stop>? |
||||
bne lp22 |
||||
ldx #9 |
||||
sei ;fill buffer with load/run cmds |
||||
stx ndx |
||||
lp21 |
||||
lda runtb-1,x |
||||
sta keyd-1,x |
||||
dex |
||||
bne lp21 |
||||
lp211 |
||||
beq loop3 |
||||
|
||||
lp22 |
||||
cmp #cr ;<cr>? |
||||
bne loop4 |
||||
sta crsw ;flag - we pass chars now |
||||
jsr fndend ;check nxt line for cont |
||||
stx lintmp ;save last line number of sentence |
||||
jsr fistrt ;find begining of line |
||||
lda #0 |
||||
sta qtsw ;clear quote mode |
||||
ldy sclf ;retrieve from line start if left it |
||||
lda lsxp ;input started row |
||||
bmi lp80 ;flag we left start line |
||||
cmp tblx |
||||
bcc lp80 |
||||
ldy lstp ;input started column |
||||
cmp lintmp ;on start line |
||||
bne lp70 |
||||
cpy indx ;past start column |
||||
beq lp75 ;ok if the same |
||||
lp70 |
||||
bcs clp2 ;yes - null input |
||||
lp75 |
||||
sta tblx ;start from here on input |
||||
lp80 |
||||
sty pntr |
||||
jmp lop5 |
||||
|
||||
|
||||
; input a line until carriage return |
||||
; |
||||
loop5 |
||||
tya |
||||
pha |
||||
txa |
||||
pha |
||||
lda crsw ;passing chars to input |
||||
beq lp211 ;no - buffer on screen (jmp's to loop3) |
||||
bpl lop5 ;not done - get next char |
||||
clp2 |
||||
lda #0 ;input done clear flag |
||||
sta crsw |
||||
jmp clppat ;**patch 01/03/84 fab |
||||
nop ;** |
||||
lop5 |
||||
jsr stupt ;set pnt and user |
||||
jsr get1ch ;get a screen char |
||||
sta datax |
||||
and #$3f |
||||
asl datax |
||||
bit datax |
||||
bpl lop54 |
||||
ora #$80 |
||||
lop54 |
||||
bcc lop52 |
||||
ldx qtsw |
||||
bne lop53 |
||||
lop52 |
||||
bvs lop53 |
||||
ora #$40 |
||||
lop53 |
||||
jsr qtswc |
||||
ldy tblx ;on input end line ? |
||||
cpy lintmp |
||||
bcc clp00 ;no |
||||
ldy pntr ;on input end column ? |
||||
cpy indx |
||||
bcc clp00 ;no |
||||
ror crsw ;c=1 minus flags last char sent |
||||
bmi clp1 ;always |
||||
|
||||
clp00 |
||||
jsr nxtchr ;at next char |
||||
clp1 |
||||
cmp #$de ;a pi ? |
||||
bne clp7 ;no |
||||
lda #$ff ;translate |
||||
clp7 |
||||
sta datax |
||||
pla |
||||
tax |
||||
pla |
||||
tay |
||||
lda datax |
||||
clc ;**patch 12/22/83 tvr |
||||
rts |
||||
|
||||
|
||||
qtswc |
||||
cmp #$22 |
||||
bne qtswl |
||||
lda qtsw |
||||
eor #$1 |
||||
sta qtsw |
||||
lda #$22 |
||||
qtswl |
||||
rts |
||||
|
||||
|
||||
loop2 |
||||
lda datax |
||||
sta lstchr ;save for next escape test |
||||
pla |
||||
tay |
||||
lda insrt |
||||
beq lop2 |
||||
lsr qtsw |
||||
lop2 |
||||
pla |
||||
tax |
||||
pla |
||||
clc ;good return |
||||
; cli ;shouldn't be necessary here |
||||
rts |
||||
|
||||
|
||||
nxt33 |
||||
ora #$40 |
||||
nxt3 |
||||
ldx rvs |
||||
beq nvs |
||||
nc3 |
||||
ora #$80 |
||||
nvs |
||||
ldx insrt |
||||
beq nvsa |
||||
dec insrt |
||||
nvsa |
||||
bit insflg ;are we in auto insert? |
||||
bpl nvs1 ;branch if not |
||||
pha ;save char. |
||||
jsr insert ;make room |
||||
ldx #0 |
||||
stx insrt ;make sure insert flag is off |
||||
pla |
||||
nvs1 |
||||
jsr dspp ;fall thru to movchr! (will return to 'loop2') |
||||
.page |
||||
; movchr - move to next char position |
||||
; insert blank line if at end of line |
||||
; y = column position |
||||
; on exit - carry set = abort - scroll disabled |
||||
; |
||||
movchr |
||||
cpy scrt |
||||
bcc movc10 ;easy if not at end of line |
||||
ldx tblx |
||||
cpx scbot |
||||
bcc movc10 ;skip if not last line of screen |
||||
bit scrdis |
||||
bmi movc30 ;abort if scrolling disabled |
||||
movc10 |
||||
jsr stupt ;set pnt address |
||||
jsr nxtchr ;move to next char position |
||||
bcc movc30 ;done if not move to new line |
||||
jsr getbit ;check if on a continued line |
||||
bcs movc20 ;skip ahead if not |
||||
sec ;incase we abort |
||||
bit scrdis |
||||
bvs movc30 |
||||
jsr scrdwn ;else insert a blank line |
||||
movc20 |
||||
clc ;for clean exit |
||||
movc30 |
||||
rts |
||||
|
||||
|
||||
; skip to next line |
||||
; wrap to top if scroll disabled |
||||
; |
||||
nxln |
||||
ldx tblx |
||||
cpx scbot ;of the bottom of window ? |
||||
bcc nxln1 ;no |
||||
bit scrdis ;what if scrolling is disabled? |
||||
bpl doscrl ;branch if scroll is enabled |
||||
lda sctop ;wrap to top |
||||
sta tblx |
||||
bcs nowhop ;always |
||||
|
||||
doscrl |
||||
jsr scrup ;scroll it all |
||||
clc ;indicate scroll ok |
||||
nxln1 |
||||
inc tblx |
||||
nowhop |
||||
jmp stupt ;set line base adr |
||||
|
||||
;end |
||||
;(07/10/84) tvr & fab: pressing a fct key during a 'getkey' cmd returned |
||||
; a error and shouldn't have. code needed a 'clc'. |
||||
@ -0,0 +1,264 @@
|
||||
.page |
||||
.subttl 'openchannel' |
||||
;*************************************** |
||||
;* chkin -- open channel for input * |
||||
;* * |
||||
;* the number of the logical file to be* |
||||
;* opened for input is passed in .x. * |
||||
;* chkin searches the logical file * |
||||
;* to look up device and command info. * |
||||
;* errors are reported if the device * |
||||
;* was not opened for input ,(e.g. * |
||||
;* cassette write file), or the logical* |
||||
;* file has no reference in the tables.* |
||||
;* device 0, (keyboard), and device 3 * |
||||
;* (screen), require no table entries * |
||||
;* and are handled separate. * |
||||
;*************************************** |
||||
|
||||
nchkin |
||||
jsr lookup ;see if file known |
||||
beq jx310 ;yup... |
||||
jmp error3 ;no...file not open |
||||
|
||||
jx310 |
||||
jsr jz100 ;extract file info (returns w/.a=fa & flags set) |
||||
beq jx320 ;is keyboard...done. |
||||
; |
||||
; could be screen, keyboard, or serial |
||||
; |
||||
cmp #3 |
||||
beq jx320 ;is screen...done. |
||||
bcs jx330 ;is serial...address it |
||||
cmp #2 |
||||
bne opcasi ;open cass for input |
||||
jsr aready ;open rs-232 for input |
||||
bcs excp1 ;carry set if acia not ready |
||||
lda fa |
||||
|
||||
jx320 |
||||
sta dfltn ;all input comes from here |
||||
clc ;good exit |
||||
excp1 |
||||
rts |
||||
; |
||||
; a serial device has to be a talker |
||||
; |
||||
jx330 |
||||
tax ;device # for dflto |
||||
jsr ttalk ;tell him to talk |
||||
bit status ;anybody home? (case of no devices on bus) |
||||
bmi dnpci ;no... |
||||
|
||||
lda sa ;a second? |
||||
bpl jx340 ;yes...send it |
||||
jsr ttkatn ;no...let go |
||||
jmp jx350 |
||||
|
||||
jx340 |
||||
jsr ttksa ;send second |
||||
jx350 |
||||
txa ;restore dev# |
||||
bit status ;secondary address sent ok? |
||||
bpl jx320 ;yep, done |
||||
dnpci |
||||
jmp error5 ;input channel device not present |
||||
|
||||
|
||||
opcasi |
||||
ldx sa ;open cass for input |
||||
cpx #$60 ;is command a read? |
||||
beq jx320 ;yes |
||||
jmp error6 |
||||
.page |
||||
;*************************************** |
||||
;* chkout -- open channel for output * |
||||
;* * |
||||
;* the number of the logical file to be* |
||||
;* opened for output is passed in .x. * |
||||
;* chkout searches the logical file * |
||||
;* to look up device and command info. * |
||||
;* errors are reported if the device * |
||||
;* was not opened for input ,(e.g. * |
||||
;* keyboard), or the logical file has * |
||||
;* reference in the tables. * |
||||
;* device 0, (keyboard), and device 3 * |
||||
;* (screen), require no table entries * |
||||
;* and are handled separate. * |
||||
;*************************************** |
||||
|
||||
nckout |
||||
jsr lookup ;is file in table? |
||||
beq ck5 ;yes... |
||||
jmp error3 ;no...file not open |
||||
|
||||
ck5 |
||||
jsr jz100 ;extract table info (returns w/.a=fa & flags set) |
||||
bne ck10 ;no...something else. |
||||
ck20 |
||||
jmp error7 ;yes...not output file |
||||
; |
||||
; could be screen, serial, or tape |
||||
; |
||||
ck10 |
||||
cmp #3 |
||||
beq ck30 ;is screen...done |
||||
bcs ck40 ;is serial...address it |
||||
cmp #2 |
||||
bne optapo ;open tape for output |
||||
jsr aready ;open rs-232 for output |
||||
bcs excp2 ;carry set if acia not ready |
||||
lda fa |
||||
|
||||
ck30 |
||||
sta dflto ;all output goes here |
||||
clc ;good exit |
||||
excp2 |
||||
rts |
||||
|
||||
ck40 |
||||
tax ;save device for dflto |
||||
jsr tlistn ;tell him to listen |
||||
bit status ;anybody home? (case of no devices on bus) |
||||
bmi dnpco ;no... |
||||
|
||||
lda sa ;is there a second? |
||||
bpl ck50 ;yes... |
||||
jsr tscatn ;no...release lines |
||||
bne ck60 ;branch always |
||||
|
||||
ck50 |
||||
jsr tsecnd ;send second... |
||||
ck60 |
||||
txa |
||||
bit status ;speaketh ye? |
||||
bpl ck30 ;yep, done |
||||
dnpco |
||||
jmp error5 ;device not present |
||||
|
||||
|
||||
optapo |
||||
ldx sa ;open tape for output |
||||
cpx #$60 ;read? |
||||
beq ck20 ;yes...bad! |
||||
bne ck30 ;always |
||||
.page |
||||
;***** tedisk support routines... {state transition} ***** |
||||
|
||||
tstkdy |
||||
pha ;save .a |
||||
stx wrbase ;save .x |
||||
ldx #$30 ;starting i/o offset |
||||
lda fa ;load file address |
||||
cmp #8 ;=8? |
||||
beq tstok |
||||
nok8 cmp #9 ;=9? |
||||
bne notprs |
||||
ldx #0 ;must be $fec0 |
||||
tstok lda #$55 ;write a pattern to cmd channel |
||||
sta tedrva-48,x |
||||
eor tedrva-48,x ;is it the same |
||||
bne notprs |
||||
lda tedrvb-48,x ;i tied a status bit hi |
||||
and #2 |
||||
bne notprs ;br, he is blown away |
||||
stx usekdy ;store offset into i/o slot |
||||
clc ;ok |
||||
.byte $24 |
||||
notprs sec ;sorry not home |
||||
ldx wrbase ;restore .x |
||||
pla ;restore .a |
||||
rts ;45 bytes |
||||
|
||||
patchb lda tedrvc-48,x ;wait for rdy ack to go hi |
||||
bpl patchb |
||||
bmi ptchbb ;bra |
||||
|
||||
patcha lda #0 |
||||
sta tedrva-48,x ;clear cmd channel |
||||
ptchbb lda #$40 |
||||
sta tedrvc-48,x ;set dav hi |
||||
ldx wrbase ;restor .x |
||||
pla ;restore .a for ciout, data for acptr |
||||
clc ;ok |
||||
rts ;* |
||||
|
||||
patchd sta tedrvc |
||||
sta drvc2-48 |
||||
sta tedrvc-48 |
||||
dex |
||||
stx drva2-48 |
||||
jmp ptchdd |
||||
|
||||
;this is in the patch area: |
||||
;ptchdd inx ;.x=0 |
||||
; stx drvb2-48 |
||||
; stx tedrva-48 |
||||
; rts ;x must = 0 on rts !!! |
||||
|
||||
ttalk |
||||
jsr tstkdy ;who do we talk to??? |
||||
bcc kdy1 ;he's out there |
||||
jmp talk ;serial dev. |
||||
|
||||
kdy1 pha ;save (a)data |
||||
lda #italk |
||||
sta kdycmd |
||||
lda usekdy |
||||
ora #$40 ;write to kdy |
||||
sta usekdy |
||||
lda #kcmd1 |
||||
jmp kdy75 ;finish up |
||||
|
||||
ttkatn |
||||
bit usekdy ;do an open in with no sa... |
||||
bvs kdy5 ;kdy is pres...do nothing |
||||
jmp tkatn ;serial |
||||
|
||||
ttksa |
||||
bit usekdy ;do an open in with sa... |
||||
bvs kdy3 ;kdy is pres |
||||
jmp tksa |
||||
|
||||
kdy3 |
||||
pha ;save (a) data |
||||
lda sa |
||||
sta kdycmd |
||||
lda #kcmd2 |
||||
jmp kdy75 |
||||
|
||||
tlistn |
||||
jsr tstkdy ;do an open out with fa... |
||||
bcc kdy4 ;he's out there... |
||||
jmp listn |
||||
|
||||
kdy4 |
||||
pha ;save (a) data |
||||
lda #ilstn |
||||
sta kdycmd |
||||
lda usekdy |
||||
ora #$80 |
||||
sta usekdy |
||||
lda #kcmd1 ;tell tedisk to listen |
||||
jmp kdy75 |
||||
|
||||
tscatn |
||||
bit usekdy ;do an open out with no sa... |
||||
bmi kdy5 |
||||
jmp scatn |
||||
|
||||
kdy5 |
||||
rts ;do nothing for kdy |
||||
|
||||
tsecnd |
||||
bit usekdy ;do an open out with sa... |
||||
bmi kdy6 |
||||
jmp secnd |
||||
|
||||
kdy6 |
||||
pha ;save (a) data |
||||
sta kdycmd |
||||
lda #kcmd2 |
||||
jmp kdy75 |
||||
|
||||
;end |
||||
@ -0,0 +1,69 @@
|
||||
.page |
||||
.subttl 'vectors 02/17/84' |
||||
*=$ff4c |
||||
jmp print ;**must be here**... basic needs this jump |
||||
jmp primm ;**must be here**... basic needs this jump |
||||
jmp entry ;**must be here**... basic needs this jump |
||||
|
||||
*=$ff80 |
||||
.if palmod |
||||
.byte $84 ;release number of ted kernal (msb=1=pal version) |
||||
.else |
||||
.byte $04 ;release number of ted kernal (msb=0=ntsc version) |
||||
.endif |
||||
|
||||
jmp cint |
||||
jmp ioinit |
||||
jmp ramtas |
||||
jmp restor ;restore vectors to initial system |
||||
jmp vector ;change vectors for user |
||||
jmp setmsg ;control o.s. messages |
||||
jmp tsecnd ;send sa after listen /cheap/ |
||||
jmp ttksa ;send sa after talk /cheap/ |
||||
jmp memtop ;set/read top of memory |
||||
jmp membot ;set/read bottom of memory |
||||
jmp scnkey ;scan keyboard |
||||
jmp settmo ;set timeout in ieee |
||||
jmp tacptr ;handshake ieee byte in /cheap/ |
||||
jmp tciout ;handshake ieee byte out /cheap/ |
||||
jmp tuntlk ;send untalk out ieee /cheap/ |
||||
jmp tunlsn ;send unlisten out ieee /cheap/ |
||||
jmp tlistn ;send listen out ieee /cheap/ |
||||
jmp ttalk ;send talk out ieee /cheap/ |
||||
jmp readss ;return i/o status byte |
||||
jmp setlfs ;set la, fa, sa |
||||
jmp setnam ;set length and fn adr |
||||
open jmp (iopen) ;open logical file |
||||
close jmp (iclose) ;close logical file |
||||
chkin jmp (ichkin) ;open channel in |
||||
ckout jmp (ickout) ;open channel out |
||||
clrch jmp (iclrch) ;close i/o channel |
||||
basin jmp (ibasin) ;input from channel |
||||
bsout jmp (ibsout) ;output to channel |
||||
jmp loadsp ;load from file |
||||
jmp savesp ;save to file |
||||
jmp settim ;set internal clock |
||||
jmp rdtim ;read internal clock |
||||
stop jmp (istop) ;scan stop key |
||||
getin jmp (igetin) ;get char from q |
||||
clall jmp (iclall) ;close all files |
||||
judtim jmp udtim ;increment clock |
||||
jscrog jmp scrorg ;screen org |
||||
jplot jmp plot ;read/set x,y coord |
||||
jmp iobase |
||||
.page |
||||
; the following code is necessary to prevent the problem where |
||||
; the reset button is pressed while the rom is banked out. since |
||||
; the ted chip has no reset pin, the processor will attempt to |
||||
; fetch the reset vectors without banking in rom, and will get |
||||
; garbage. this code is copied into ram behind the reset vectors, |
||||
; and will switch the rom back on before transferring execution |
||||
; to the reset routine. |
||||
|
||||
gostrt |
||||
sta romon |
||||
jmp start |
||||
.wor gostrt ;initialization code |
||||
.wor puls ;interrupt handler |
||||
|
||||
;end |
||||
@ -0,0 +1,254 @@
|
||||
.page |
||||
.subttl 'assem' |
||||
; simple assembler |
||||
; syntax: a 1111 lda ($00,x) |
||||
; a 1111 dex: (':' = terminator) |
||||
|
||||
assem |
||||
bcc as005 |
||||
jmp error |
||||
as005 |
||||
jsr t0tot2 |
||||
as010 |
||||
ldx #0 |
||||
stx hulp+1 ;clear left mnemonic |
||||
as020 |
||||
jsr gnc ;get a char |
||||
bne as025 ;check for eol |
||||
cpx #0 |
||||
bne as025 |
||||
jmp main ;if eol & no mnemonic, exit cleanly |
||||
as025 |
||||
cmp #$20 ;is it a space ? |
||||
beq as010 ;yes - start again |
||||
sta msal,x ;no - save char |
||||
inx |
||||
cpx #3 ;got three chars ? |
||||
bne as020 ;no - loop |
||||
as030 |
||||
dex ;squished all three ? |
||||
bmi as045 ;yes |
||||
lda msal,x ;no - first in last out |
||||
sec ;no borrow |
||||
sbc #$3f ;normalize |
||||
ldy #5 ;set for 5 shift rights |
||||
as040 |
||||
lsr a |
||||
ror hulp+1 ;left mnemonic |
||||
ror hulp ;right mnemonic |
||||
dey ;done 5 shifts? |
||||
bne as040 ;no-loop |
||||
beq as030 ;always |
||||
|
||||
as045 |
||||
ldx #2 ;move index past mnemonic |
||||
as050 |
||||
jsr gnc ;get a char |
||||
beq as100 ;done if eol |
||||
cmp #' ' ;a space |
||||
beq as050 ;yes-skip it |
||||
jsr chrtst ;a hex #? |
||||
bcs as070 ;no-buffer if |
||||
jsr rdob2 ;fin a read byte |
||||
ldy t0 ;shift t0 to t0+1 |
||||
sty t0+1 |
||||
sta t0 ;save byte |
||||
lda #'0 ;buffer ascii 0 |
||||
sta hulp,x |
||||
inx |
||||
as070 |
||||
sta hulp,x |
||||
inx |
||||
cpx #10 ;watch buffer size |
||||
bcc as050 ;branch if not full |
||||
as100 |
||||
stx t1 ;save input # of chars |
||||
ldx #0 |
||||
stx wrap ;start trial at zero |
||||
as110 |
||||
ldx #0 |
||||
stx tmpc ;disa index=0 |
||||
lda wrap ;get trial byte |
||||
jsr dset ;digest it |
||||
ldx format ;save format for later |
||||
stx t1+1 |
||||
tax ;index into mnemonic table |
||||
lda mnemr,x ;get compressed |
||||
jsr tstrx ;mnemonic and test |
||||
lda mneml,x |
||||
jsr tstrx |
||||
ldx #6 ;six format bits |
||||
as210 |
||||
cpx #3 |
||||
bne as230 |
||||
ldy length |
||||
beq as230 ;skip-single byte instr |
||||
as220 |
||||
lda format |
||||
cmp #$e8 ;a relative instr? |
||||
lda #'0 ;test zeros |
||||
bcs as250 ;no-3 byte |
||||
jsr tst2 ;test a byte,2 chars |
||||
dey |
||||
bne as220 |
||||
as230 |
||||
asl format |
||||
bcc as240 |
||||
lda char1-1,x |
||||
jsr tstrx ;test syntax |
||||
lda char2-1,x |
||||
beq as240 |
||||
jsr tstrx ;test more syntax |
||||
as240 |
||||
dex |
||||
bne as210 |
||||
beq as300 |
||||
as250 |
||||
jsr tst2 ;test a word,4 chars |
||||
jsr tst2 |
||||
as300 |
||||
lda t1 ;check # chars of both |
||||
cmp tmpc |
||||
beq as310 ;match, skip |
||||
jmp tst05 ;fail |
||||
as310 |
||||
ldy length |
||||
beq as500 ;if only 1 byte instr skip |
||||
lda t1+1 ;get saved format |
||||
cmp #$9d ;a relative instr? |
||||
bne as400 ;no-skip |
||||
|
||||
lda t0 ;calculate a relative |
||||
sbc t2 ;(.c=1 already) |
||||
sta diff |
||||
lda t0+1 |
||||
sbc t2+1 |
||||
|
||||
bcc as320 |
||||
bne aerr ;out of range |
||||
ldx diff |
||||
bmi aerr |
||||
bpl as340 |
||||
as320 |
||||
tay |
||||
iny ;out of range,y=$ff |
||||
bne aerr |
||||
ldx diff |
||||
bpl aerr |
||||
as340 |
||||
dex ;subtract 2 for instr |
||||
dex |
||||
txa |
||||
ldy length ;set index to length |
||||
bne as420 ;branch always |
||||
|
||||
as400 |
||||
lda t0-1,y ;no-put byte out there |
||||
as420 |
||||
sta (t2),y |
||||
dey |
||||
bne as400 |
||||
as500 |
||||
lda wrap ;get good op code |
||||
sta (t2),y |
||||
jsr cronly ;get ready to overstrike line |
||||
ldx #msgasm ;print 'a(sp)' |
||||
jsr msgxxx |
||||
jsr dis400 ;disassemble one line |
||||
|
||||
inc length |
||||
lda length |
||||
jsr addt2 ;update address |
||||
|
||||
lda #'a ;set up next line with 'a nnnn ' for convience |
||||
sta keyd ;put it in the keyboard buffer |
||||
lda #$20 |
||||
sta keyd+1 |
||||
sta keyd+6 |
||||
lda t2+1 |
||||
jsr makhex |
||||
sta keyd+2 |
||||
stx keyd+3 |
||||
lda t2 |
||||
jsr makhex |
||||
sta keyd+4 |
||||
stx keyd+5 |
||||
lda #7 |
||||
sta ndx |
||||
jmp main |
||||
|
||||
|
||||
|
||||
; test char in .a with char in hulp |
||||
; |
||||
tst2 |
||||
jsr tstrx ;do two tests |
||||
tstrx |
||||
stx sxreg |
||||
ldx tmpc ;get current position |
||||
cmp hulp,x ;same char |
||||
beq tst10 ;yes-skip |
||||
pla ;pull jsr off stack |
||||
pla |
||||
|
||||
tst05 |
||||
inc wrap ;try next trial |
||||
beq aerr ;=0 tried all,sorry |
||||
jmp as110 |
||||
|
||||
aerr |
||||
jmp error |
||||
|
||||
tst10 |
||||
inx |
||||
stx tmpc |
||||
ldx sxreg ;restore x |
||||
rts |
||||
|
||||
|
||||
|
||||
; character test |
||||
; test for char between 0-f |
||||
; if 0<=char<=f then carry=0 |
||||
; |
||||
chrtst |
||||
cmp #'a |
||||
bcc chr10 ;must be 0-9 |
||||
cmp #'g |
||||
rts |
||||
chr10 |
||||
cmp #'0 |
||||
bcc chr20 ;error |
||||
cmp #': |
||||
rts |
||||
|
||||
|
||||
|
||||
rdob2 |
||||
jsr hexit |
||||
asl a |
||||
asl a |
||||
asl a |
||||
asl a |
||||
sta bad |
||||
jsr gnc |
||||
jsr hexit |
||||
ora bad |
||||
chr20 |
||||
sec |
||||
rts |
||||
|
||||
|
||||
|
||||
hexit |
||||
cmp #$3a |
||||
php |
||||
and #$0f |
||||
plp |
||||
bcc hex09 |
||||
adc #8 |
||||
hex09 |
||||
rts |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,198 @@
|
||||
.page |
||||
.subttl 'banking' |
||||
;*********************************************************************** |
||||
; |
||||
; software supporting banking hardware |
||||
; |
||||
; ******* this code must fit *entirely* between $fc00-$fcff ******* |
||||
; |
||||
; |
||||
; set up each of the four possible slots, and test if there is a |
||||
; device in that slot. if so, store that devices number in the cor- |
||||
; responding entry in the physical address translation (pat) table. |
||||
; if a device is found to have a number of '1', it will be logged in the |
||||
; table, and a jump to that devices cold-start routine will be performed. |
||||
; |
||||
;*********************************************************************** |
||||
|
||||
poll |
||||
ldx #3 |
||||
stx xsav |
||||
lda #0 |
||||
poll10 |
||||
sta pat,x ;first zero out all pat entries |
||||
dex |
||||
bpl poll10 |
||||
|
||||
poll20 ;set up and test each bank |
||||
ldx xsav |
||||
lda dblx,x ;set up both upper & lower banks |
||||
tax |
||||
sta bnksel,x |
||||
ldy #2 |
||||
poll30 |
||||
lda $8007,y ;test for 'cbm' (in ascii) |
||||
cmp cbmmsg,y |
||||
bne poll50 ;no match |
||||
dey |
||||
bpl poll30 ;keep looking |
||||
|
||||
lda $8006 ;it's 'cbm'...now get device number |
||||
ldx xsav |
||||
sta pat,x |
||||
cmp #1 ;autostart? |
||||
bne poll50 ;no |
||||
stx curbnk ;yes, give them the bank configuration, |
||||
jsr $8000 ;.. then go to cold start routine. |
||||
|
||||
poll50 |
||||
dec xsav |
||||
bpl poll20 |
||||
rts |
||||
|
||||
cbmmsg .byte 'CBM' |
||||
.page |
||||
;************************************************* |
||||
; |
||||
; call every active cartridges cold start routine. |
||||
; |
||||
;************************************************* |
||||
|
||||
phenix |
||||
sei |
||||
ldx #3 |
||||
phen2 |
||||
lda pat,x |
||||
beq phen3 ;no cartridge in this slot if 0 |
||||
|
||||
txa |
||||
pha |
||||
lda dblx,x ;select low and high rom |
||||
tax |
||||
sta bnksel,x |
||||
stx curbnk |
||||
jsr $8000 ;call it's cold start routine |
||||
pla |
||||
tax |
||||
phen3 |
||||
dex |
||||
bne phen2 ;do slots 3,2,1 - ext2, ext1, int |
||||
|
||||
sta bnksel ;set up system bank |
||||
stx curbnk ;..as current bank |
||||
cli |
||||
rts |
||||
|
||||
dblx .byte %00000000,%00000101,%00001010,%00001111 |
||||
.page |
||||
;*********************************************** |
||||
; fetch a byte long |
||||
; entry: |
||||
; your bank in acc |
||||
; target bank in x |
||||
; target address in fetptr,fetptr+1 |
||||
; offset from address in y |
||||
; |
||||
; return with value in a |
||||
;*********************************************** |
||||
|
||||
fetchl |
||||
sta bnksel,x |
||||
tax |
||||
lda (fetptr),y |
||||
sta bnksel,x |
||||
rts |
||||
.page |
||||
;*********************************************************************** |
||||
; call a subroutine in another bank |
||||
; enter with: |
||||
; your bank in acc |
||||
; target bank in x |
||||
; fetxrg, fetarg, fetsrg loaded with x, a, and s to go into routine |
||||
; address in lngjmp, lngjmp+1 |
||||
; |
||||
; return with: |
||||
; fetxrg, fetarg, fetsrg loaded with x, a, and s from routine |
||||
;*********************************************************************** |
||||
|
||||
long |
||||
pha ;save return bank combo |
||||
stx curbnk ;set up target bank combo |
||||
sta bnksel,x |
||||
ldx fetxrg |
||||
lda fetsrg |
||||
pha |
||||
lda fetarg |
||||
plp |
||||
jsr lngrt1 |
||||
sta fetarg |
||||
php |
||||
pla |
||||
sta fetsrg |
||||
stx fetxrg |
||||
pla |
||||
sta curbnk |
||||
tax |
||||
sta bnksel,x |
||||
rts |
||||
|
||||
lngrt1 |
||||
jmp (lngjmp) |
||||
.page |
||||
;*********************************************************************** |
||||
; |
||||
; long irq routine. |
||||
; called by a bank which has received an interrupt, and wishes to have |
||||
; the system roms (kernal/basic) service the interrupt. |
||||
; |
||||
; the users irq vector should point to the following routine in his rom: |
||||
; |
||||
; pha ;save accum. |
||||
; txa |
||||
; pha ;save x reg |
||||
; tya |
||||
; pha ;save y reg |
||||
; . |
||||
; . |
||||
; determine if this is an interrupt to be serviced by the kernal. |
||||
; if so.... |
||||
; jmp lngirq |
||||
; |
||||
; *note* before calling this routine, curbank must contain your bank # |
||||
; |
||||
;*********************************************************************** |
||||
|
||||
puls ;entry for normal irq's |
||||
pha |
||||
txa |
||||
pha |
||||
tya |
||||
pha |
||||
|
||||
lngirq ;entry for irq's passed from banking cartridges |
||||
sta bnksel ;select system roms |
||||
jmp krnirq ;kernal irq routine |
||||
|
||||
irqret |
||||
ldx curbnk ;restore previous bank |
||||
sta bnksel,x |
||||
pla |
||||
tay |
||||
pla |
||||
tax |
||||
pla |
||||
rti |
||||
.page |
||||
gobvec |
||||
ldx curbnk |
||||
sta $fdd0,x |
||||
jmp (bnkvec) |
||||
|
||||
*=$fcf1 ;jump table for banking routines |
||||
jmp gobvec |
||||
jmp phenix |
||||
jmp fetchl |
||||
jmp long |
||||
jmp lngirq |
||||
|
||||
;end |
||||
@ -0,0 +1,255 @@
|
||||
.page |
||||
.subttl 'channelio' |
||||
;*************************************** |
||||
;* getin -- get character from channel * |
||||
;* channel is determined by dfltn. * |
||||
;* if device is 0, keyboard queue is * |
||||
;* examined and a character removed if * |
||||
;* available. if queue is empty, z * |
||||
;* flag is returned set. devices 1-31 * |
||||
;* advance to basin. * |
||||
;*************************************** |
||||
|
||||
ngetin |
||||
lda dfltn ;check device |
||||
bne bn10 ;not keyboard |
||||
|
||||
lda ndx ;queue index |
||||
ora kyndx |
||||
beq gn20 ;nobody there...exit |
||||
sei |
||||
jmp lp2 ;go remove a character |
||||
|
||||
|
||||
|
||||
;*************************************** |
||||
;* basin-- input character from channel* |
||||
;* input differs from get on device * |
||||
;* #0 function which is keyboard. the * |
||||
;* screen editor makes ready an entire * |
||||
;* line which is passed char by char * |
||||
;* up to the carriage return. other * |
||||
;* devices are: * |
||||
;* 0 -- keyboard * |
||||
;* 3 -- screen * |
||||
;* 1 -- cassette * |
||||
;* 2 -- rs-232 * |
||||
;* 4-31 -- serial bus * |
||||
;*************************************** |
||||
|
||||
nbasin |
||||
lda dfltn ;check device |
||||
bne bn10 ;is not keyboard... |
||||
; |
||||
; input from keyboard |
||||
; |
||||
lda pntr ;save current... |
||||
sta lstp ;... cursor column |
||||
lda tblx ;save current... |
||||
sta lsxp ;... line number |
||||
jmp loop5 ;blink cursor until return |
||||
|
||||
bn10 |
||||
cmp #3 ;is input from screen? |
||||
bne bn30 ;nope, try cassette, 232 or serial |
||||
|
||||
ora crsw |
||||
sta crsw ;fake a carriage return |
||||
lda scrt ;say we ended... |
||||
sta indx ;...up on this line |
||||
jmp loop5 ;pick up characters |
||||
|
||||
casi |
||||
jsr savxy |
||||
cmp #1 |
||||
bne rs232i |
||||
jsr getcas |
||||
jmp rstxy |
||||
|
||||
rs232i |
||||
jsr agetch |
||||
jmp rstxy |
||||
; |
||||
; input from serial bus |
||||
; |
||||
bn30 |
||||
bcc casi ;<3 |
||||
lda status ;status from last |
||||
beq tacptr ;was good |
||||
lda #$0d ;bad...all done |
||||
gn20 |
||||
clc ;valid data, good return |
||||
rts |
||||
|
||||
|
||||
|
||||
getcas ;get a chr from the cassette buffer |
||||
ldy tptr ;test for bufr empty |
||||
cpy #bufmax |
||||
bcc notmt1 ;-mt |
||||
jsr rdblok ;mt, read another block |
||||
bcc getcas ;!bra, try again |
||||
rts ;bad exit, carry should be set |
||||
|
||||
notmt1 |
||||
ldy tptr ;get bufptr |
||||
lda (tapebs),y ;get chr |
||||
pha ;save it |
||||
iny ;try to look at next chr |
||||
cpy #bufmax |
||||
bcs notovr ;no next chr |
||||
lda (tapebs),y ;get next chr |
||||
bne notovr ;..ok, not a #00 |
||||
lda #64 ;wooops!, eof |
||||
jsr udst ;flag it so |
||||
|
||||
notovr |
||||
inc tptr ;advance buf ptr |
||||
pla ;chr to be returned |
||||
clc ;sucess flag |
||||
rts |
||||
.page |
||||
;*************************************** |
||||
;* bsout -- out character to channel * |
||||
;* determined by variable dflto: * |
||||
;* 0 -- invalid (rs232?) * |
||||
;* 1 -- cassette * |
||||
;* 2 -- rs-232 * |
||||
;* 3 -- screen * |
||||
;* 4-31 -- serial bus * |
||||
;*************************************** |
||||
|
||||
nbsout |
||||
pha ;preserve .a |
||||
lda dflto ;check device |
||||
cmp #3 ;is it the screen? |
||||
bne bo10 ;nope, try somethin else... |
||||
; |
||||
; print to crt |
||||
; |
||||
pla ;restore data |
||||
jmp print ;print on crt |
||||
|
||||
bo10 |
||||
bcc bo9 ;<3 |
||||
pla |
||||
jmp tciout ;print to serial bus |
||||
|
||||
bo9 |
||||
jsr savaxy |
||||
cmp #1 ;is it cass? |
||||
bne boa ;nope, try 232 |
||||
ldy tptr |
||||
|
||||
;char to write is on top of stack...how much we got? |
||||
|
||||
cpy #bufmax |
||||
bcc less1 ;ok, less than the max# |
||||
jsr wfblok |
||||
|
||||
;buf is full, write the block out to tape |
||||
|
||||
bcs wrerr1 ;somebody goofed... |
||||
lda #bdf ;set up a new output buffer... |
||||
sta type |
||||
ldy #0 ;reset tape buf ptr |
||||
less1 |
||||
pla ;get the chr to write... |
||||
sta (tapebs),y ;into buffer |
||||
iny ;advance buf ptr |
||||
sty tptr ;save it (or reset it...) |
||||
bcc boa1 ;good exit, tell 'em (.c=0 always!) |
||||
|
||||
wrerr1 |
||||
pla ;ditch data |
||||
lda #0 |
||||
jmp rstxy ;(.c=1) |
||||
|
||||
|
||||
boa |
||||
pla |
||||
jsr aputch ;input a char to queue |
||||
boa1 |
||||
jmp rstaxy |
||||
.page |
||||
; ***** tedisk support routines... {channel i/o} ***** |
||||
; |
||||
tacptr |
||||
stx wrbase ;save .x |
||||
bit usekdy ;use kdy for rd? |
||||
bvs kdy8 ;yes b.6=1 |
||||
ldx wrbase ;restore .x |
||||
jmp acptr ;...else serial |
||||
|
||||
kdy8 |
||||
lda usekdy ;get i/o slot |
||||
and #%00110000 |
||||
tax ;$fec0, $fef0 |
||||
lda #kcmd4 |
||||
sta tedrva-48,x ;write command |
||||
kdy85 |
||||
lda tedrvc-48,x ;wait for rdy to go low |
||||
bmi kdy85 |
||||
lda #$00 |
||||
sta drva2-48,x ;setup dat/dir for inputs |
||||
sta tedrvc-48,x ;drop rdy low |
||||
kdy86 |
||||
lda tedrvc-48,x ;wait for rdy to go high |
||||
bpl kdy86 |
||||
lda tedrvb-48,x ;retr status |
||||
and #3 ;mask status bits |
||||
cmp #3 ;eoi ? |
||||
bne kdy88 |
||||
lda #$40 |
||||
kdy88 |
||||
jsr udst ;update status for basic |
||||
lda tedrva-48,x ;get data |
||||
pha ;* |
||||
lda #$40 |
||||
sta tedrvc-48,x ;set rdy high |
||||
kdy89 |
||||
lda tedrvc-48,x ;wait for dav to go low |
||||
bmi kdy89 |
||||
lda #$ff |
||||
sta drva2-48,x ;turn ports around i got data & status |
||||
lda #$00 |
||||
sta tedrva-48,x ;clear cmd chnl |
||||
sta tedrvc-48,x ;drop rdy low |
||||
kdy90 |
||||
jmp patchb ;finish up |
||||
nop ;extra byte |
||||
|
||||
|
||||
tciout |
||||
bit usekdy ;use kdy for wr? |
||||
bmi kdy7 ;yes b.7=1 |
||||
jmp ciout ;else serial |
||||
|
||||
kdy7 |
||||
pha ;save (a) |
||||
sta kdycmd |
||||
lda #kcmd3 |
||||
kdy75 stx wrbase |
||||
pha ;save cmd |
||||
lda usekdy |
||||
and #%00110000 |
||||
tax ;get i/o offset |
||||
pla ;retr. cmd |
||||
sta tedrva-48,x ;send cmd |
||||
kdy76 |
||||
lda tedrvc-48,x ;wait for dav ack |
||||
bmi kdy76 |
||||
lda kdycmd ;ret state cmd |
||||
sta tedrva-48,x |
||||
lda #$00 |
||||
sta tedrvc-48,x ;drop dav low |
||||
kdy77 |
||||
lda tedrvc-48,x ;wait for rdy to go high |
||||
bpl kdy77 |
||||
lda tedrvb-48,x ;retr status |
||||
and #3 ;mask status |
||||
kdy79 |
||||
jsr udst ;update basic |
||||
jmp patcha ;finish up |
||||
|
||||
;end |
||||
@ -0,0 +1,75 @@
|
||||
.page |
||||
.subttl 'close all files' |
||||
;************************************* |
||||
;* clall -- close all logical files * |
||||
;* deletes all table entries and * |
||||
;* restores default i/o channels * |
||||
;* and clears serial port devices. * |
||||
;************************************* |
||||
|
||||
nclall |
||||
lda #0 |
||||
sta ldtnd ;forget all files |
||||
|
||||
|
||||
|
||||
;**************************************** |
||||
;* clrch -- clear channels * |
||||
;* unlisten or untalk serial devcs, but * |
||||
;* leave others alone. default channels * |
||||
;* are restored. * |
||||
;**************************************** |
||||
|
||||
nclrch |
||||
ldx #3 |
||||
cpx dflto ;is output channel serial? |
||||
bcs jx750 ;no... |
||||
jsr tunlsn ;yes...unlisten it |
||||
jx750 |
||||
cpx dfltn ;is input channel serial? |
||||
bcs clall2 ;no... |
||||
jsr tuntlk ;yes...untalk it |
||||
; |
||||
; restore default values |
||||
; |
||||
clall2 |
||||
stx dflto ;output chan=3=screen |
||||
lda #0 |
||||
sta dfltn ;input chan=0=keyboard |
||||
rts |
||||
|
||||
|
||||
;***** tedisk support routines {state change} ***** |
||||
; |
||||
tunlsn |
||||
bit usekdy ;unlisten patch |
||||
bmi kdy9 ;kdy was listening... |
||||
jmp unlsn ;serial was... |
||||
|
||||
kdy9 |
||||
pha ;save (a) |
||||
lda #iulstn |
||||
sta kdycmd |
||||
lda usekdy ;status shows unlisten |
||||
and #$7f |
||||
sta usekdy |
||||
lda #kcmd1 |
||||
jmp kdy75 ;send cmd |
||||
|
||||
tuntlk |
||||
bit usekdy ;untalk patch |
||||
bvs kdya |
||||
jmp untlk |
||||
|
||||
kdya |
||||
pha ;save (a) |
||||
lda #iutalk |
||||
sta kdycmd |
||||
lda usekdy |
||||
and #$bf |
||||
sta usekdy |
||||
lda #kcmd1 |
||||
jmp kdy75 ;send cmd |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,154 @@
|
||||
.page |
||||
.subttl 'close' |
||||
;*************************************** |
||||
;* close -- close logical file * |
||||
;* * |
||||
;* the logical file number of the * |
||||
;* file to be closed is passed in .a. * |
||||
;* keyboard, screen, and files not * |
||||
;* open pass straight through. tape * |
||||
;* files open for write are closed by * |
||||
;* dumping the last buffer and * |
||||
;* conditionally writing an end of * |
||||
;* tape block.serial files are closed * |
||||
;* by sending a close file command if * |
||||
;* a secondary address was specified * |
||||
;* in its open command. * |
||||
;*************************************** |
||||
|
||||
nclose |
||||
ror wrbase ;save serial close flag |
||||
jsr jltlk ;look file up |
||||
beq jx050 ;open... |
||||
clc ;else return |
||||
rts |
||||
|
||||
jx050 |
||||
jsr jz100 ;extract table data |
||||
txa ;save table index |
||||
pha |
||||
|
||||
lda fa ;check device number |
||||
beq jx150 ;is keyboard...done |
||||
cmp #3 |
||||
beq jx150 ;is screen...done |
||||
|
||||
bcs jx120 ;is serial address it |
||||
cmp #2 ;rs232? |
||||
bne jx115 ;no, was tape |
||||
; |
||||
; rs232 close ;...by brute force |
||||
; |
||||
php ;!mutex |
||||
sei |
||||
jsr ainit ;reset pointers, variables, & acia |
||||
plp ;!mutex |
||||
beq jx150 ;always |
||||
; |
||||
; close tape data file |
||||
; |
||||
jx115 |
||||
lda sa ;was it a tape read? |
||||
and #$f |
||||
beq jx150 ;yes |
||||
ldy tptr ;else a write |
||||
cpy #bufmax |
||||
bcc jx116 ;buf not full |
||||
jsr wfblok ;else write out a full block first |
||||
bcs jx117 ;write exception |
||||
lda #bdf ;setup new block |
||||
sta type |
||||
ldy #0 |
||||
sty tptr |
||||
jx116 |
||||
lda #0 |
||||
sta (tapebs),y |
||||
jsr wfblok ;write out final block |
||||
bcc jx118 ;ok |
||||
jx117 |
||||
pla ;get index off stack |
||||
lda #0 ;error exit (stop key pressed) |
||||
rts |
||||
|
||||
jx118 |
||||
lda sa ;write eot-block? |
||||
cmp #$62 |
||||
bne jx150 ;no |
||||
jsr wreot ;yes |
||||
jmp jx150 |
||||
; |
||||
; close a serial file |
||||
; |
||||
jx120 |
||||
bit wrbase ;do a real close? |
||||
bpl ropen ;yep |
||||
lda fa ;no if a disk & sa=$f |
||||
cmp #8 |
||||
bcc ropen ;>8 ==>not a disk, do real close |
||||
lda sa |
||||
and #$f |
||||
cmp #$f |
||||
beq jx150 ;sa=$f, no real close |
||||
ropen |
||||
jsr clsei ;else do a real close |
||||
|
||||
|
||||
; entry to remove a give logical file |
||||
; from table of logical, primary, |
||||
; and secondary addresses |
||||
|
||||
jx150 |
||||
pla ;get table index off stack |
||||
tax |
||||
dec ldtnd |
||||
cpx ldtnd ;is deleted file at end? |
||||
beq jx170 ;yes...done |
||||
|
||||
; delete entry in middle by moving |
||||
; last entry to that position. |
||||
|
||||
ldy ldtnd |
||||
lda lat,y |
||||
sta lat,x |
||||
lda fat,y |
||||
sta fat,x |
||||
lda sat,y |
||||
sta sat,x |
||||
|
||||
jx170 |
||||
clc ;close exit |
||||
jx175 |
||||
rts |
||||
|
||||
|
||||
|
||||
; lookup tablized logical file data |
||||
; |
||||
lookup |
||||
lda #0 |
||||
sta status |
||||
txa |
||||
jltlk |
||||
ldx ldtnd |
||||
jx600 |
||||
dex |
||||
bmi jz101 |
||||
cmp lat,x |
||||
bne jx600 |
||||
rts |
||||
; |
||||
; routine to fetch table entries |
||||
; |
||||
jz100 |
||||
lda lat,x |
||||
sta la |
||||
lda sat,x |
||||
sta sa |
||||
lda fat,x ;must return w/.a=fa & flags set! |
||||
sta fa |
||||
jz101 |
||||
rts |
||||
|
||||
;rsr 5/12/82 - modify for cln232 |
||||
;end |
||||
|
||||
@ -0,0 +1,307 @@
|
||||
.page |
||||
.subttl 'cmds1 02/17/84' |
||||
;********************************************** |
||||
; |
||||
; monitor with mini-assembler/disassembler |
||||
; |
||||
;********************************************** |
||||
|
||||
entry |
||||
ldx #0 ;call entry*************** |
||||
stx flgs |
||||
beq ent010 ;always (.x=msgmon=0) |
||||
|
||||
entbrk |
||||
cld ;break entry*************** |
||||
ldx #5 |
||||
ent005 |
||||
pla ;save regs & flags |
||||
sta pch,x |
||||
dex |
||||
bpl ent005 |
||||
ldx #msgbrk |
||||
|
||||
ent010 |
||||
stx syreg |
||||
lda #$c0 |
||||
sta msgflg ;enable kernal msgs |
||||
|
||||
tsx |
||||
stx sp |
||||
ldx syreg |
||||
jsr msgxxx |
||||
|
||||
lda tedvcr ;make sure screen is enabled |
||||
ora #$10 |
||||
sta tedvcr |
||||
|
||||
lda #0 ;zero out 'last address' reg |
||||
sta t2 |
||||
sta t2+1 |
||||
cli ;be sure to allow these! |
||||
|
||||
|
||||
dspreg |
||||
ldx #msgreg |
||||
jsr msgxxx |
||||
lda pch |
||||
jsr puthex |
||||
ldy #0 |
||||
dspr10 |
||||
lda pcl,y |
||||
jsr puthxs |
||||
iny |
||||
cpy #6 |
||||
bcc dspr10 |
||||
bcs main ;always |
||||
|
||||
|
||||
error |
||||
jsr putqst |
||||
|
||||
|
||||
main |
||||
jsr crlf |
||||
ldx #0 ;'getbuf' now in-line! |
||||
stx chrptr |
||||
main00 |
||||
jsr basin |
||||
sta buf,x |
||||
inx |
||||
cmp #cr ;read one line into buffer |
||||
bne main00 |
||||
dex |
||||
stx bufend |
||||
|
||||
main01 |
||||
jsr gnc ;get a character from buffer |
||||
beq main ;end of line |
||||
cmp #' ' ;skip leading spaces |
||||
beq main01 |
||||
|
||||
ldx #cmdqty-1 |
||||
main05 |
||||
cmp cmdchr,x |
||||
beq main10 |
||||
dex |
||||
bpl main05 |
||||
bmi error |
||||
main10 |
||||
cpx #cmdls |
||||
bcs main30 ;load/save don't use parse, handle seperatly |
||||
txa |
||||
asl a |
||||
tax |
||||
lda cmdtbl+1,x |
||||
pha |
||||
lda cmdtbl,x |
||||
pha |
||||
jmp parse ;cute but effective |
||||
main30 |
||||
sta cmpflg |
||||
jmp lodsav |
||||
|
||||
|
||||
dspmem |
||||
bcs dspm20 ;no range, do 1/2 screen |
||||
jsr t0tot2 ;else move 'from' value into place |
||||
jsr parse |
||||
bcc dspm30 ;got 'to', go dump |
||||
dspm20 |
||||
lda #11 ;do 12 lines |
||||
sta t0 |
||||
bne dspm40 |
||||
dspm30 ;calculate # of lines |
||||
jsr sub0m2 ;calculate bytes |
||||
lsr a |
||||
ror t0 ;divide by 8 |
||||
lsr a |
||||
ror t0 |
||||
lsr a |
||||
ror t0 |
||||
sta t0+1 |
||||
dspm40 |
||||
jsr stop ;is stop key down? |
||||
beq dspm70 |
||||
jsr dmpone |
||||
lda #8 ;add 8 to 'starting address' |
||||
jsr addt2 |
||||
dspm60 |
||||
jsr dect0 ;test if dump finished |
||||
bcs dspm40 |
||||
dspm70 |
||||
jmp main |
||||
|
||||
|
||||
setreg |
||||
bcs dspm70 ;no arg's, done |
||||
lda t0 |
||||
ldy t0+1 |
||||
sta pcl |
||||
sty pch |
||||
ldy #0 |
||||
setr10 |
||||
jsr parse |
||||
bcs dspm70 ;quit anytime arg list is empty |
||||
lda t0 |
||||
sta flgs,y |
||||
iny |
||||
cpy #5 |
||||
bcc setr10 |
||||
bcs dspm70 ;always ('main') |
||||
|
||||
|
||||
setmem |
||||
bcs setm20 |
||||
jsr t0tot2 |
||||
ldy #0 |
||||
setm10 |
||||
jsr parse |
||||
bcs setm20 |
||||
lda t0 |
||||
sta (t2),y |
||||
iny |
||||
cpy #8 |
||||
bcc setm10 |
||||
setm20 ;**(02/06/84 fix: fab) |
||||
jsr primm ;clear all modes & cursor up |
||||
.byte $1b,$4f,$91,0 |
||||
|
||||
jsr dmpone |
||||
jmp main |
||||
|
||||
|
||||
go |
||||
bcs go10 |
||||
lda t0 |
||||
sta pcl |
||||
lda t0+1 |
||||
sta pch |
||||
go10 |
||||
ldx sp |
||||
txs |
||||
ldx #0 |
||||
go15 |
||||
lda pch,x |
||||
pha |
||||
inx |
||||
cpx #3 |
||||
bne go15 |
||||
ldx xr |
||||
ldy yr |
||||
lda acc |
||||
rti |
||||
|
||||
|
||||
|
||||
CMDCHR |
||||
.BYTE 'X' ;JUMP TO BASIC WARM START |
||||
.BYTE 'M' ;MEMORY DUMP |
||||
.BYTE 'R' ;DISPLAY REGS |
||||
.BYTE 'G' ;GO |
||||
.BYTE 'T' ;TRANSFER |
||||
.BYTE 'C' ;COMPARE |
||||
.BYTE 'D' ;DISASSEMBLE |
||||
.BYTE 'A' ;ASSEMBLE |
||||
.BYTE '.' ;ASSEMBLE, ALSO |
||||
.BYTE 'H' ;HUNT |
||||
.BYTE 'F' ;FILL |
||||
.BYTE '>' ;SET MEMORY |
||||
.BYTE ';' ;SET REGS |
||||
|
||||
CMDLS=*-CMDCHR ;L,S & V MUST BE LAST IN TABLE |
||||
.BYTE 'L' ;LOAD MEMORY |
||||
.BYTE 'S' ;SAVE MEMORY |
||||
.BYTE 'V' ;VERIFY MEMORY |
||||
CMDQTY=*-CMDCHR |
||||
|
||||
cmdtbl |
||||
.wor $8003-1 ;use basic's warm start vector |
||||
.wor dspmem-1 |
||||
.wor dspreg-1 |
||||
.wor go-1 |
||||
.wor trnsfr-1 |
||||
.wor compar-1 |
||||
.wor disasm-1 |
||||
.wor assem-1 |
||||
.wor assem-1 |
||||
.wor hunt-1 |
||||
.wor fill-1 |
||||
.wor setmem-1 |
||||
.wor setreg-1 |
||||
|
||||
|
||||
dmpone |
||||
jsr crlf |
||||
lda #'>' ;flag as dump |
||||
jsr bsout |
||||
jsr putt2 ;print address |
||||
ldy #0 |
||||
dmp150 |
||||
jsr pick1 ;***patch 01/16/84 to select ram/rom |
||||
jsr puthxs ;print hex byte, space |
||||
iny |
||||
cpy #8 |
||||
bcc dmp150 |
||||
|
||||
jsr primm ;block off ascii dump & turn rvs on |
||||
.byte ':',18,0 |
||||
|
||||
ldy #0 |
||||
dmp155 |
||||
jsr pick1 ;***patch 01/16/84 to select ram/rom |
||||
and #$7f ;no weird stuff |
||||
cmp #$20 |
||||
bcs dmp156 |
||||
lda #'.' |
||||
dmp156 |
||||
jsr bsout |
||||
iny |
||||
cpy #8 |
||||
bcc dmp155 |
||||
rts |
||||
|
||||
|
||||
compar |
||||
lda #0 ;flag 'compare' |
||||
.byte $2c |
||||
trnsfr |
||||
lda #$80 ;flag 'transfer' |
||||
tnsf10 |
||||
sta wrbase+1 ;**02/17 |
||||
jsr range ;get sa in t2, len in t1 |
||||
bcs tnsf99 ;no defaults, please |
||||
jsr parse ;get new addr. |
||||
bcs tnsf99 |
||||
|
||||
jsr crlf |
||||
ldy #0 |
||||
tnsf15 |
||||
jsr pick1 ;**02/17/84 mod to fetch from ram or rom |
||||
bit wrbase+1 ;**02/17 |
||||
bpl tnsf20 ;branch if compare |
||||
sta (t0),y ;else transfer |
||||
tnsf20 |
||||
cmp (t0),y ;correct? |
||||
beq tnsf30 |
||||
jsr stop |
||||
beq tnsf98 |
||||
jsr putt2 |
||||
tnsf30 |
||||
inc t0 |
||||
bne tnsf35 |
||||
inc t0+1 |
||||
tnsf35 |
||||
jsr inct2 |
||||
jsr dect1 |
||||
bcs tnsf15 |
||||
tnsf98 |
||||
jmp main |
||||
tnsf99 |
||||
jmp error |
||||
nop ;**02/17/84 placeholder |
||||
|
||||
;02/06/84 fab: fixes ascii display @ 'dmpone' should quote mode be set |
||||
;02/17/84 tvr: transfer & compare now use ram/rom switch for fetches |
||||
;end |
||||
|
||||
@ -0,0 +1,167 @@
|
||||
.page |
||||
.subttl 'cmds2 02/07/84' |
||||
; hunt for bytes or string |
||||
; syntax: h 0000 1111 'af... <or> h 0000 1111 22 33 44 ... |
||||
|
||||
hunt |
||||
jsr range ;get sa in t2, calculate length, put in t1 |
||||
bcs tnsf99 ;error if eol |
||||
ldy #0 |
||||
jsr gnc ;get first char |
||||
cmp #$27 ;is it a ' |
||||
bne ht50 ;no-must be hex |
||||
jsr gnc ;yes-get first string chr |
||||
ht30 |
||||
sta xcnt,y ;save in buf (** 02/07/84 fix: was 'hulp') |
||||
iny |
||||
jsr gnc ;get next |
||||
beq ht80 ;yes-end of string |
||||
cpy #$20 ;no-32 char yet? |
||||
bne ht30 ;no-get more |
||||
beq ht80 ;yes-go look for it |
||||
ht50 |
||||
sty bad ;zero for rdob |
||||
jsr pargot ;finish hex read |
||||
ht60 |
||||
lda t0 |
||||
sta xcnt,y ;save in buf (** 02/07/84 fix) |
||||
iny |
||||
jsr parse ;get next character |
||||
bcs ht80 ;no more -go look for bytes |
||||
cpy #$20 ;32 bytes yet? |
||||
bne ht60 ;no-get more |
||||
ht80 |
||||
sty cmpflg ;yes-start search |
||||
jsr crlf ;next line |
||||
ht85 |
||||
ldx #0 |
||||
ldy #0 |
||||
ht90 |
||||
jsr pick1 ;***patch 01/16/84 to select fetches from ram or rom |
||||
cmp xcnt,x ;same? (** 02/07/84 fix) |
||||
bne ht100 ;no-move on |
||||
iny |
||||
inx |
||||
cpx cmpflg ;checked full string? |
||||
bne ht90 ;no-check on |
||||
|
||||
jsr stop |
||||
beq tnsf98 ;stop (goto 'main') |
||||
jsr putt2 ;print address found |
||||
ht100 |
||||
jsr inct2 ;increment t2 |
||||
jsr dect1 ;decrement byte counter |
||||
bcs ht85 ;loop if not done |
||||
bcc tnsf98 ;goto 'main' |
||||
.page |
||||
; load/save/verify |
||||
; |
||||
; l {"name"} {,device-number} |
||||
; v {"name"} {,device-number} |
||||
; s "name",device-number,starting-address,ending-address |
||||
|
||||
lodsav |
||||
ldy #1 |
||||
sty fa |
||||
sty sa |
||||
dey |
||||
sty fnlen ;(.y=0) |
||||
sty status |
||||
sty verfck |
||||
lda #>xcnt ;(** 02/07/84 fix: was 'hulp') |
||||
sta fnadr+1 |
||||
lda #<xcnt |
||||
sta fnadr |
||||
l1 |
||||
jsr gnc ;look for name |
||||
beq l5 ;branch if no name (must be default load) |
||||
cmp #' ' |
||||
beq l1 ;skip spaces |
||||
cmp #'"' |
||||
bne errl |
||||
ldx chrptr |
||||
l3 |
||||
cpx bufend |
||||
bcs l5 ;eol, must be load |
||||
lda buf,x ;get chr |
||||
inx |
||||
cmp #'"' ;pass everything up to closing quote |
||||
beq l8 |
||||
sta (fnadr),y |
||||
inc fnlen |
||||
iny |
||||
cpy #17 ;check length of name (02/07/84 fix: 16 max.) |
||||
bcc l3 |
||||
errl |
||||
jmp error |
||||
nop |
||||
|
||||
l8 |
||||
stx chrptr |
||||
jsr gnc ;trash delimitor |
||||
jsr parse ;get device # |
||||
bcs l5 ;use default |
||||
lda t0 ;(** 02/07/84 fix: removed 'and #$0f') |
||||
beq errl ;can't be device 0, |
||||
cmp #3 |
||||
beq errl ;..or device 3 |
||||
sta fa |
||||
|
||||
jsr parse ;get starting address |
||||
bcs l5 ;none, must be load |
||||
jsr t0tot2 ;save sa in t2 |
||||
|
||||
jsr parse ;get ending address |
||||
bcs errl ;can't default now! |
||||
jsr crlf ;prep for 'saving...' msg |
||||
ldx t0 ;pickup end addr |
||||
ldy t0+1 |
||||
lda cmpflg |
||||
cmp #'s ;check that this is a save |
||||
bne errl |
||||
lda #0 |
||||
sta sa |
||||
lda #<t2 ;pointer to start. addr |
||||
jsr $ffd8 |
||||
l999 |
||||
jmp main |
||||
|
||||
l5 |
||||
lda cmpflg ;check for load |
||||
cmp #'v ;..or verify |
||||
beq l6 |
||||
cmp #'l |
||||
bne errl |
||||
lda #0 ;flag load |
||||
l6 |
||||
jsr $ffd5 |
||||
lda status |
||||
and #$10 |
||||
beq l999 ;ok to cont. |
||||
lda cmpflg ;l & v have diff. err. msgs |
||||
cmp #'l |
||||
beq errl |
||||
ldx #msgver |
||||
jsr msgxxx |
||||
bmi l999 ;always |
||||
|
||||
|
||||
fill |
||||
jsr range ;sa in t2, len in t1 |
||||
bcs errl ;error if eol |
||||
jsr parse ;get fill value |
||||
bcs errl |
||||
ldy #0 |
||||
fill10 |
||||
lda t0 |
||||
sta (t2),y |
||||
jsr inct2 |
||||
jsr dect1 |
||||
bcs fill10 |
||||
bcc l999 |
||||
|
||||
;02/07/84 fix: move tedmon string buffer from 'hulp' to 'xcnt' |
||||
;02/07/84 fix: remove load/save/ver masking of 't0' to 4 bits! |
||||
;02/07/84 fix: allow 16 char. max. file name length |
||||
;end |
||||
|
||||
@ -0,0 +1,258 @@
|
||||
.page |
||||
.subttl 'disasm 01/16/84' |
||||
disasm |
||||
bcs disa10 ;use a default length from current sa |
||||
jsr t0tot2 |
||||
jsr parse |
||||
bcc disa20 ;got sa,ea. use 'em |
||||
disa10 |
||||
lda #20 ;guess at 1/2 page |
||||
sta t0 |
||||
bne disa30 |
||||
disa20 |
||||
jsr sub0m2 ;put ea-sa in t0 |
||||
disa30 |
||||
jsr crlf |
||||
jsr stop |
||||
beq l999 ;stop ('main') |
||||
jsr dis300 ;disassemble 1 line |
||||
inc length |
||||
lda length |
||||
jsr addt2 |
||||
lda length |
||||
jsr subt0 |
||||
bcs disa30 |
||||
bcc l999 ;always done ('main') |
||||
|
||||
|
||||
dis300 |
||||
lda #'. |
||||
jsr bsout |
||||
jsr putspc |
||||
dis400 |
||||
jsr putt2 |
||||
jsr putspc |
||||
ldy #0 |
||||
jsr pick1 ;***patch 01/16/84 select fetches from ram or rom |
||||
jsr dset ;get instr & digest it |
||||
|
||||
pha ;dump (length+1) bytes |
||||
ldx length ;(.y=0 from 'dset' above) |
||||
inx |
||||
pradr0 |
||||
dex |
||||
bpl pradrl ;pad non-printers |
||||
jsr primm ;print 3 spaces |
||||
.byte ' ',0 |
||||
jmp pradrm |
||||
nop |
||||
pradrl |
||||
jsr pick1 ;***patch 01/16/84 select fetches from ram or rom |
||||
jsr puthxs |
||||
pradrm |
||||
iny |
||||
cpy #3 |
||||
bcc pradr0 |
||||
pla |
||||
|
||||
ldx #3 |
||||
jsr prmne ;print mnemonic |
||||
ldx #6 ;6 format bits |
||||
pradr1 |
||||
cpx #3 |
||||
bne pradr3 ;if x=3 print adr val |
||||
ldy length |
||||
beq pradr3 ;no print if len=0 |
||||
pradr2 |
||||
lda format |
||||
cmp #$e8 ;relative addressing mode? |
||||
jsr pick1 ;***patch 01/16/84 select fetches from ram or rom |
||||
bcs reladr |
||||
jsr puthex |
||||
dey |
||||
bne pradr2 |
||||
pradr3 |
||||
asl format ;test next format bit |
||||
bcc pradr4 ;no print if=0 |
||||
lda char1-1,x |
||||
jsr bsout |
||||
lda char2-1,x |
||||
beq pradr4 |
||||
jsr bsout |
||||
pradr4 |
||||
dex |
||||
bne pradr1 |
||||
rts |
||||
|
||||
|
||||
reladr |
||||
jsr pcadj3 ;pcl,h + disp + 1 into a,x |
||||
clc ;add 1 |
||||
adc #1 |
||||
bne relad2 |
||||
inx |
||||
relad2 |
||||
jmp putwrd |
||||
|
||||
|
||||
pcadj3 |
||||
ldx t2+1 |
||||
tay |
||||
bpl pcadj4 |
||||
dex |
||||
pcadj4 |
||||
adc t2 |
||||
bcc pcrts |
||||
inx |
||||
pcrts |
||||
rts |
||||
|
||||
|
||||
|
||||
; disassembler digest routine |
||||
; |
||||
dset |
||||
tay |
||||
lsr a ;even/odd test |
||||
bcc ieven |
||||
lsr a ;test b1 |
||||
bcs err ;xxxxxx11 instr bad |
||||
cmp #$22 |
||||
beq err ;10001001 instr bad |
||||
and #$7 ;mask 3 bits for adr mode |
||||
ora #$80 ;add indexing offset |
||||
ieven |
||||
lsr a ;left/right test |
||||
tax |
||||
lda nmode,x ;index into mode table |
||||
bcs rtmode ;if carry set use lsb for |
||||
lsr a ;print format index |
||||
lsr a |
||||
lsr a ;if carry clr use msb |
||||
lsr a |
||||
rtmode |
||||
and #$0f ;mask for 4-bit index |
||||
bne getfmt ;$0 for bad opcodes |
||||
err |
||||
ldy #$80 ;sub $80 for bad opcode |
||||
lda #0 ;set format index to zero |
||||
getfmt |
||||
tax |
||||
lda nmode2,x ;index into prt format tab |
||||
sta format ;save for adr field format |
||||
and #3 ;mask 2-bit length. 0=1byte |
||||
sta length ;1=2byte,2=3byte |
||||
tya ;op code |
||||
and #$8f ;mask for 1xxx1010 test |
||||
tax ;save in x |
||||
tya ;op code again |
||||
ldy #3 |
||||
cpx #$8a |
||||
beq mnndx3 |
||||
mnndx1 |
||||
lsr a |
||||
bcc mnndx3 ;form index into mnemonic tab |
||||
lsr a |
||||
mnndx2 |
||||
lsr a ;1xxx1010->00101xxx |
||||
ora #$20 ;xxxyyy01->00111xxx |
||||
dey ;xxxyyy10->00110xxx |
||||
bne mnndx2 ;xxxyy100->00100xxx |
||||
iny ;xxxxx000->000xxxxx |
||||
mnndx3 |
||||
dey |
||||
bne mnndx1 |
||||
rts ;(.y=0 is assumed!) |
||||
|
||||
|
||||
|
||||
; print mnemonic |
||||
; enter x=3 characters |
||||
; |
||||
prmne |
||||
tay |
||||
lda mneml,y ;fetch 3 char mnemonic |
||||
sta t1 |
||||
lda mnemr,y |
||||
sta t1+1 |
||||
prmn1 |
||||
lda #0 |
||||
ldy #5 |
||||
prmn2 |
||||
asl t1+1 ;shift 5 bits of char |
||||
rol t1 ;into a |
||||
rol a ;clear carry |
||||
dey |
||||
bne prmn2 |
||||
adc #$3f ;add '?' offset |
||||
jsr bsout |
||||
dex |
||||
bne prmn1 |
||||
jmp putspc ;finish with space |
||||
|
||||
|
||||
nmode |
||||
.byte $40,2,$45,3 |
||||
.byte $d0,8,$40,9 |
||||
.byte $30,$22,$45,$33 |
||||
.byte $d0,8,$40,9 |
||||
.byte $40,2,$45,$33 |
||||
.byte $d0,8,$40,9 |
||||
.byte $40,$02,$45,$b3 |
||||
.byte $d0,$08,$40,$09 |
||||
.byte 0,$22,$44,$33 |
||||
.byte $d0,$8c,$44,0 |
||||
.byte $11,$22,$44,$33 |
||||
.byte $d0,$8c,$44,$9a |
||||
.byte $10,$22,$44,$33 |
||||
.byte $d0,8,$40,9 |
||||
.byte $10,$22,$44,$33 |
||||
.byte $d0,8,$40,9 |
||||
.byte $62,$13,$78,$a9 |
||||
nmode2 |
||||
.byte 0,$21,$81,$82 |
||||
.byte 0,0,$59,$4d |
||||
.byte $91,$92,$86,$4a |
||||
.byte $85,$9d |
||||
char1 |
||||
.byte ',),#($' |
||||
char2 |
||||
.byte 'Y',0,'X$$',0 |
||||
mneml |
||||
.byte $1c,$8a,$1c,$23 |
||||
.byte $5d,$8b,$1b,$a1 |
||||
.byte $9d,$8a,$1d,$23 |
||||
.byte $9d,$8b,$1d,$a1 |
||||
.byte 0,$29,$19,$ae |
||||
.byte $69,$a8,$19,$23 |
||||
.byte $24,$53,$1b,$23 |
||||
.byte $24,$53,$19,$a1 |
||||
.byte 0,$1a,$5b,$5b |
||||
.byte $a5,$69,$24,$24 |
||||
.byte $ae,$ae,$a8,$ad |
||||
.byte $29,0,$7c,0 |
||||
.byte $15,$9c,$6d,$9c |
||||
.byte $a5,$69,$29,$53 |
||||
.byte $84,$13,$34,$11 |
||||
.byte $a5,$69,$23,$a0 |
||||
mnemr |
||||
.byte $d8,$62,$5a,$48 |
||||
.byte $26,$62,$94,$88 |
||||
.byte $54,$44,$c8,$54 |
||||
.byte $68,$44,$e8,$94 |
||||
.byte 0,$b4,8,$84 |
||||
.byte $74,$b4,$28,$6e |
||||
.byte $74,$f4,$cc,$4a |
||||
.byte $72,$f2,$a4,$8a |
||||
.byte 0,$aa,$a2,$a2 |
||||
.byte $74,$74,$74,$72 |
||||
.byte $44,$68,$b2,$32 |
||||
.byte $b2,0,$22,0 |
||||
.byte $1a,$1a,$26,$26 |
||||
.byte $72,$72,$88,$c8 |
||||
.byte $c4,$ca,$26,$48 |
||||
.byte $44,$44,$a2,$c8 |
||||
regk |
||||
.byte cr,$20,$20,$20 |
||||
|
||||
;end |
||||
@ -0,0 +1,45 @@
|
||||
; ****************************************************************** |
||||
; * * |
||||
; * PPPPPPPP LLL UUU UUU SSSSSSS 444 * |
||||
; * PPP PPP LLL UUU UUU SSS SSS 44444 * |
||||
; * PPP PPP LLL UUU UUU SSS 44 444 * |
||||
; * PPPPPPPP LLL UUU UUU SSSSSSS 44 444 * |
||||
; * PPP LLL UUU UUU SSS 444444444 * |
||||
; * PPP LLL UUU UUU SSS SSS 444 * |
||||
; * PPP LLLLLLL UUUUUUU SSSSSSS 444 * |
||||
; * * |
||||
; * * |
||||
; * KKK KKK EEEEEEEEE RRRRRRRR NNN NN AAA LLL * |
||||
; * KKK KKK EEE RRR RRR NNNN NN AA AA LLL * |
||||
; * KKK KKK EEE RRR RRR NNNNN NN AAA AAA LLL * |
||||
; * KKKKK EEEEEE RRRRRRRR NNN NN NN AAAAAAAAA LLL * |
||||
; * KKK KKK EEE RRR RRR NNN NNNN AAA AAA LLL * |
||||
; * KKK KKK EEE RRR RRR NNN NNN AAA AAA LLL * |
||||
; * KKK KKK EEEEEEEEE RRR RRR NNN NN AAA AAA LLLLLLL * |
||||
; * * |
||||
; * * |
||||
; * V E R S I O N 3 . 5 * |
||||
; * * |
||||
; * * |
||||
; * COPYRIGHT (C)1984 BY COMMODORE BUSINESS MACHINES, INC. * |
||||
; * * |
||||
; ****************************************************************** |
||||
|
||||
|
||||
|
||||
; ****************************************************************** |
||||
; * * |
||||
; * THIS SOFTWARE IS FURNISHED FOR USE IN COMMODORE COMPUTER * |
||||
; * SYSTEMS ONLY. COPIES MAY NOT BE MADE IN WHOLE OR IN PART FOR * |
||||
; * USE ON ANY OTHER SYSTEM. * |
||||
; * * |
||||
; * THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE * |
||||
; * WITHOUT NOTICE. * |
||||
; * * |
||||
; * NO RESPONSIBILITY IS ASSUMED FOR THE RELIABILITY OF THIS * |
||||
; * SOFTWARE. * |
||||
; * * |
||||
; ****************************************************************** |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,144 @@
|
||||
.page |
||||
.subttl 'ed2 ted 01/17/84' |
||||
; ****** scroll routines ****** |
||||
; |
||||
movlin |
||||
lda ldtb2,x |
||||
sta sedeal |
||||
sta sedsal |
||||
lda ldtb1,x |
||||
sta sedsal+1 |
||||
and #$03 |
||||
ora #>tedatr |
||||
sta sedeal+1 |
||||
movl10 |
||||
lda (sedsal),y ;move character byte |
||||
sta (pnt),y |
||||
lda (sedeal),y ;move color byte |
||||
sta (user),y |
||||
cpy scrt ;done a whole line ? |
||||
iny |
||||
bcc movl10 ;no |
||||
rts |
||||
|
||||
|
||||
; ****** scroll down ****** |
||||
; |
||||
scrdwn |
||||
ldx lsxp |
||||
bmi scd30 ;skip if new line flag already set |
||||
cpx tblx |
||||
bcc scd30 ;skip if old line is below scroll area |
||||
inc lsxp ;else inc start line number |
||||
scd30 |
||||
ldx scbot ;scroll down, start bottom |
||||
scd10 |
||||
jsr scrset ;set 'pnt' to line |
||||
ldy sclf |
||||
cpx tblx ;test if at destination line |
||||
beq scd20 ;done if yes |
||||
dex ;point to previous line as source |
||||
jsr getbt1 |
||||
inx |
||||
jsr putbt1 ;move continuation byte |
||||
dex |
||||
jsr movlin ;move one line |
||||
bcs scd10 ;always |
||||
scd20 |
||||
jsr clrln ;set line to blanks |
||||
jmp setbit ;mark as continuation line |
||||
|
||||
|
||||
; ****** scroll up ****** |
||||
; |
||||
scrup |
||||
ldx sctop |
||||
scru00 |
||||
inx |
||||
jsr getbt1 ;find first non-continued line |
||||
bcc scru15 |
||||
cpx scbot |
||||
bcc scru00 |
||||
ldx sctop |
||||
inx |
||||
jsr clrbit ;clear to only scroll 1 line |
||||
scru15 |
||||
dec tblx |
||||
bit lsxp |
||||
bmi scru20 ;no change if already new line |
||||
dec lsxp ;move input up one |
||||
scru20 |
||||
ldx sctop |
||||
cpx sedt2 |
||||
bcs scru30 |
||||
dec sedt2 ;in case doing insert |
||||
scru30 |
||||
jsr scr10 ;scroll |
||||
ldx sctop |
||||
jsr getbt1 |
||||
php |
||||
jsr clrbit ;make sure top line is not continuation |
||||
plp |
||||
bcc scru10 ;done if top line off |
||||
bit logscr ;logical scroll ? |
||||
bmi scrup ;no - keep scrolling |
||||
scru10 |
||||
rts |
||||
|
||||
|
||||
scr10 |
||||
jsr scrset |
||||
ldy sclf |
||||
cpx scbot ;at last line ? |
||||
bcs scr40 ;yes |
||||
inx ;point to next line |
||||
jsr getbt1 |
||||
dex |
||||
jsr putbt1 ;move continuation byte |
||||
inx |
||||
jsr movlin ;move one line |
||||
bcs scr10 |
||||
|
||||
scr40 |
||||
jsr clrln ;make last line blank |
||||
lda #$7f ;check for slo-scroll screen |
||||
jsr keyscn ;**01/17/84 mod |
||||
cmp #$df |
||||
bne scr80 ;no commodore key |
||||
ldy #0 ;delay |
||||
scr60 |
||||
nop |
||||
dex |
||||
bne scr60 |
||||
dey |
||||
bne scr60 |
||||
scr80 |
||||
rts |
||||
.byte $ea,$ea,$ea |
||||
|
||||
|
||||
|
||||
;**************************************************** |
||||
; clear one line subroutine |
||||
; enter with x=line number |
||||
; entry at clrln - clear entire line |
||||
; clrprt - y=starting column number |
||||
;**************************************************** |
||||
; |
||||
clrln |
||||
ldy sclf |
||||
jsr clrbit ;make sure non-continued line |
||||
clrprt |
||||
jsr scrset |
||||
dey |
||||
clr10 |
||||
iny |
||||
lda #' ' |
||||
sta (pnt),y ;print space |
||||
lda color |
||||
sta (user),y ;update color ram |
||||
cpy scrt |
||||
bne clr10 |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,199 @@
|
||||
.page |
||||
.subttl 'ed.3 ted 01/18/84' |
||||
; ****** general keyboard scan ****** |
||||
; |
||||
scnkey |
||||
lda #0 |
||||
sta shflag |
||||
ldy #64 ;last key index |
||||
sty sfdx ;null key found |
||||
jsr keyscn ;raise all lines (**01/17/84 mod) |
||||
tax ;check for a key down |
||||
cpx #$ff ;no keys down? |
||||
bne scn10 ;branch if somthing down |
||||
jmp ckit2 |
||||
scn10 |
||||
ldy #0 ;init key counter |
||||
lda #<mode1 |
||||
sta keytab |
||||
lda #>mode1 |
||||
sta keytab+1 |
||||
lda #$fe ;start with 1st column |
||||
scn20 |
||||
ldx #8 ;8 row keybrd |
||||
pha |
||||
scn22 |
||||
pla |
||||
pha |
||||
jsr keyscn ;debounce (**01/17/84 mod) |
||||
sta tmpkey |
||||
pla |
||||
pha |
||||
jsr keyscn ;(**01/17/84 mod) |
||||
cmp tmpkey |
||||
bne scn22 |
||||
scn30 |
||||
lsr a ;look for key down |
||||
bcs ckit ;none |
||||
pha |
||||
lda (keytab),y ;get char code |
||||
cmp #$05 |
||||
bcs spck2 ;if not special key go on |
||||
cmp #$03 ;could it be a stop key? |
||||
beq spck2 ;branch if so |
||||
ora shflag |
||||
sta shflag ;put shift bit in flag byte |
||||
bpl ckut |
||||
spck2 |
||||
sty sfdx ;save key number |
||||
ckut |
||||
pla |
||||
ckit |
||||
iny |
||||
cpy #65 |
||||
bcs ckit1 ;branch if finished |
||||
dex |
||||
bne scn30 |
||||
sec |
||||
pla ;reload column info |
||||
rol a |
||||
bne scn20 ;always branch |
||||
ckit1 |
||||
pla ;dump column output...all done |
||||
lda sfdx ;check function keys |
||||
jmp (keylog) ;sent to 'shflog' at init |
||||
|
||||
|
||||
|
||||
keyscn ;** 01/17/84 mod for new keyboard port |
||||
sta $fd30 |
||||
sta keybrd |
||||
lda keybrd |
||||
rts |
||||
.page |
||||
; shift logic |
||||
; |
||||
shflog |
||||
lda shflag |
||||
cmp #$03 ;commodore shift combination? |
||||
bne keylg2 ;branch if not |
||||
lda mode |
||||
bmi shfout ;don't shift if it's locked out |
||||
lda lstshf ;was it done recently? |
||||
bne shfout ;yes- ignore it |
||||
|
||||
lda tedcbr ;character base register |
||||
eor #cbrlsb ;lsb of char base in cbr |
||||
sta tedcbr ;get characters from new area |
||||
lda #%00001000 |
||||
;disallow cbm/shift again until 'lstshf' |
||||
sta lstshf ;...is reset by 'ckit2' shifting it right |
||||
bne shfout ;always |
||||
|
||||
keylg2 |
||||
asl a |
||||
cmp #8 ;was it a control key |
||||
bcc nctrl ;branch if not |
||||
lda #6 ;else use table #4 |
||||
|
||||
ldx stpdsb ;is the pause disable set? |
||||
bne nctrl ;branch if so |
||||
ldx sfdx ;get the number of the key pressed |
||||
cpx #13 ;'s'? |
||||
bne nctrl |
||||
stx stpflg ;flag 'pause' |
||||
rts |
||||
|
||||
nctrl |
||||
tax |
||||
lda keycod,x |
||||
sta keytab |
||||
lda keycod+1,x |
||||
sta keytab+1 |
||||
|
||||
; fall into shfout |
||||
; |
||||
shfout |
||||
ldy sfdx ;get key index |
||||
lda (keytab),y ;get char code |
||||
tax ;save the char |
||||
cpy lstx ;same as prev char index? |
||||
beq rpt10 ;yes |
||||
ldy #$10 ;no - reset delay before repeat |
||||
sty delay |
||||
bne ckit2 ;always |
||||
rpt10 |
||||
and #$7f ;unshift it |
||||
bit rptflg ;check for repeat disable |
||||
bmi rpt20 ;yes |
||||
bvs scnrts |
||||
cmp #$7f ;no keys ? |
||||
beq ckit2 ;yes - get out |
||||
cmp #$14 ;an inst/del key ? |
||||
beq rpt20 ;yes - repeat it |
||||
cmp #$20 ;a space key ? |
||||
beq rpt20 ;yes |
||||
cmp #$1d ;a crsr left/right ? |
||||
beq rpt20 ;yes |
||||
cmp #$11 ;a crsr up/dwn ? |
||||
bne scnrts ;no - exit |
||||
rpt20 |
||||
ldy delay ;time to repeat ? |
||||
beq rpt40 ;yes |
||||
dec delay |
||||
bne scnrts |
||||
rpt40 |
||||
dec kount ;time for next repeat ? |
||||
bne scnrts ;no |
||||
ldy #4 ;yes - reset ctr |
||||
sty kount |
||||
ldy ndx ;no repeat if queue full |
||||
dey |
||||
bpl scnrts |
||||
ckit2 |
||||
.byte $ea,$ea ;**mod to save bytes 01/13/84 fab. |
||||
lsr lstshf |
||||
ckit3 |
||||
ldy sfdx ;get index of key |
||||
sty lstx ;save this index to key found |
||||
cpx #$ff ;a null key or no key ? |
||||
beq scnrts ;branch if so |
||||
txa ;need x as index so... |
||||
ldx #0 |
||||
stx stpflg ;clear pause flag- we have a key |
||||
ldx #7 |
||||
dokey1 |
||||
cmp funtab,x ;is it a function key? |
||||
beq dopfky ;yes |
||||
dex |
||||
bpl dokey1 |
||||
ldx ndx ;get # of chars in key queue |
||||
cpx xmax ;irq buffer full ? |
||||
bcs scnrts ;yes - no more insert |
||||
sta keyd,x ;put raw data here |
||||
inx |
||||
stx ndx ;update key queue count |
||||
scnrts |
||||
rts |
||||
|
||||
|
||||
|
||||
dopfky |
||||
lda keybuf,x ;find length of function key string |
||||
sta kyndx |
||||
lda #0 ;find index to start of string |
||||
fndky1 |
||||
dex |
||||
bmi fndky2 |
||||
clc |
||||
adc keybuf,x |
||||
bcc fndky1 ;always |
||||
fndky2 |
||||
sta keyidx |
||||
rts |
||||
|
||||
funtab |
||||
.byte $85,$89,$86,$8a |
||||
.byte $87,$8b,$88,$8c |
||||
|
||||
;end |
||||
@ -0,0 +1,323 @@
|
||||
.page |
||||
.subttl 'ed.4 ted 01/16/84' |
||||
; print a character on the screen |
||||
; |
||||
print |
||||
sta datax ;save a copy of character |
||||
pha ;save reg's |
||||
txa |
||||
pha |
||||
tya |
||||
pha |
||||
|
||||
print1 |
||||
lda stpflg ;is there a pause going on? |
||||
bne print1 ;if so, loop until the keyboard routine clears it. |
||||
sta crsw |
||||
|
||||
lopwrk = loop2-1 |
||||
|
||||
lda #>lopwrk ;push 'loop2' onto stack for common return mechanism |
||||
pha |
||||
lda #<lopwrk |
||||
pha |
||||
|
||||
ldy pntr |
||||
lda datax |
||||
cmp #cr ;if <cr> or <shift><cr> jump out now |
||||
beq nxt1 |
||||
cmp #$8d |
||||
beq nxt1 |
||||
ldx lstchr ;see if last char. was an <escape> |
||||
cpx #$1b |
||||
bne print3 ;no |
||||
jmp escape ;go service <escape> & rts to loop2 |
||||
print3 |
||||
tax ;set flags per last char. |
||||
bmi goshft ;see if last char. was shifted |
||||
|
||||
cmp #$20 ;is this a control chr? |
||||
bcc ctlchr ;yes |
||||
|
||||
cmp #$60 ;lower case? |
||||
bcc print2 ;no |
||||
and #$df ;yes, convert to pet ascii |
||||
bne print4 ;always |
||||
print2 |
||||
and #$3f |
||||
print4 |
||||
jsr qtswc ;if quote char, toggle quote switch |
||||
jmp nxt3 ;put char on screen, do rts |
||||
|
||||
goshft |
||||
jmp shiftd ;go service a shifted char. |
||||
|
||||
nxt1 |
||||
jsr fndend ;find the end of the current line |
||||
inx |
||||
jsr clrbit ;set next line as non-continued |
||||
ldy sclf ;and point to start of next line |
||||
sty pntr |
||||
jsr nxln ;set up next line & fall thru to 'togm' |
||||
|
||||
|
||||
toqm |
||||
lda #0 ;turn off modes |
||||
sta insrt |
||||
sta rvs |
||||
sta qtsw |
||||
sta flash |
||||
rts |
||||
|
||||
|
||||
ctlchr |
||||
cmp #$1b ;is char. 'escape'? |
||||
beq chk3 ;yes, ignore & just quit |
||||
ldx insrt ;are we in insert mode? |
||||
beq ctlc10 ;no. |
||||
ctlc05 |
||||
jmp nc3 ;yes, go make reverse, and print it |
||||
|
||||
ctlc10 |
||||
cmp #$14 ;is char. 'delete'? |
||||
bne ctlc20 ;no |
||||
jmp delete ;yes...service & rts to loop2 |
||||
|
||||
ctlc20 |
||||
ldx qtsw ;are we in quote-mode? |
||||
bne ctlc05 ;yes, make reverse, and print it |
||||
|
||||
cmp #$12 ;is char 'reverse on'? |
||||
bne ctlc30 ;no. |
||||
sta rvs ;yes, set reverse flag |
||||
|
||||
ctlc30 |
||||
cmp #$13 ;is char. 'home'? |
||||
bne ctlc40 ;no |
||||
cmp lstchr ;deja vu? |
||||
bne ctlc35 ;no |
||||
jsr sreset ;yes- reset window to max. |
||||
ctlc35 |
||||
jmp home ;yes...service & rts to loop2 |
||||
|
||||
ctlc40 |
||||
cmp #$1d ;is char 'cursor right'? |
||||
beq crsrrt ;yes |
||||
|
||||
cmp #$11 ;is char. 'cursor down'? |
||||
beq crsrdn ;yes |
||||
|
||||
ctlc60 |
||||
cmp #$0e ;is char. 'set lower case'? |
||||
beq lower ;yes |
||||
|
||||
cmp #$08 ;is char. 'lock in this mode'? |
||||
beq lock ;yes |
||||
|
||||
cmp #$09 ;is char. 'unlock keyboard'? |
||||
beq unlock ;yes |
||||
|
||||
ctlc90 |
||||
ldx #15 ;test if one of 16 colors |
||||
chk1 |
||||
cmp coltab,x |
||||
beq chk2 |
||||
dex |
||||
bpl chk1 |
||||
rts |
||||
chk2 |
||||
pha |
||||
jsr chkpat ;***patch 01/16/84 fetch color & lum from ram (or rom) table |
||||
sta color |
||||
pla |
||||
chk3 |
||||
rts ;done, return to loop2 |
||||
|
||||
|
||||
crsrrt |
||||
jsr nxtchr ;cursor right |
||||
bcs cdn10 ;branch if wrap |
||||
rts |
||||
|
||||
|
||||
crsrdn |
||||
jsr nxln ;cursor down |
||||
cdn10 |
||||
jsr getbit ;a wrapped line? |
||||
bcs cdrts |
||||
sec |
||||
ror lsxp ;flag we left line |
||||
cdrts |
||||
clc |
||||
critgo |
||||
rts ;return to loop2 (sometimes) |
||||
|
||||
|
||||
crsrup |
||||
ldx sctop ;cursor up |
||||
cpx tblx ;at top of window? |
||||
bcs critgo ;yes...do nothing |
||||
cup10 |
||||
jsr cdn10 ;about to wrap? |
||||
dec tblx ;up a line |
||||
jmp stupt ;& rts to loop2 |
||||
|
||||
|
||||
cleft |
||||
jsr bakchr ;move back |
||||
bcs critgo ;abort if at top left |
||||
bne cdrts ;no - exit |
||||
inc tblx |
||||
bne cup10 ;go set flag if needed |
||||
|
||||
|
||||
lower ;set lower character set |
||||
lda tedcbr ;get character base reg. |
||||
ora #cbrlsb ;set lsb (point to lower char set) |
||||
bne upper2 ;always |
||||
|
||||
|
||||
lock |
||||
lda #$80 ;lock keyboard in current mode |
||||
ora mode ;set lock bit on |
||||
bmi ulock2 ;always |
||||
|
||||
|
||||
unlock |
||||
lda #$7f ;unlock keyboard |
||||
and mode |
||||
ulock2 |
||||
sta mode |
||||
rts ;return to loop2 |
||||
|
||||
|
||||
upper ;set upper charscter set |
||||
lda tedcbr ;get character base reg. |
||||
and #$ff-cbrlsb ;clear lsb (point to upper case) |
||||
upper2 |
||||
sta tedcbr |
||||
rts ;return to loop2 |
||||
|
||||
|
||||
|
||||
shiftd ;process shifted keycodes |
||||
and #$7f ;for some obscure reason |
||||
cmp #$7f |
||||
bne shft10 |
||||
lda #$5e |
||||
|
||||
shft10 |
||||
cmp #$20 ;is it a function key? |
||||
bcc shft15 ;yes |
||||
jmp nxt33 ;no, print it |
||||
|
||||
shft15 |
||||
ldx qtsw ;are we in quote mode? |
||||
beq shft25 ;no |
||||
shft21 |
||||
ora #$40 ;make reverse |
||||
jmp nc3 ;...and print it. |
||||
|
||||
shft25 |
||||
cmp #$14 ;is char. 'insert'? |
||||
beq insert ;yes...service & rts to loop2 |
||||
|
||||
shft30 |
||||
ldx insrt ;are we in insert mode? |
||||
bne shft21 ;yes, make reverse, and print. |
||||
|
||||
cmp #$11 ;is char. 'cursor up'? |
||||
beq crsrup ;yes |
||||
|
||||
cmp #$12 ;is char. 'reverse off'? |
||||
bne shft40 ;no |
||||
lda #0 |
||||
sta rvs |
||||
|
||||
shft40 |
||||
cmp #$1d ;is char. 'cursor left'? |
||||
beq cleft ;yes |
||||
|
||||
cmp #$13 ;is char. 'clear screen'? |
||||
bne shft50 |
||||
jmp clsr ;yes...service & rts to loop2 |
||||
|
||||
shft50 |
||||
cmp #$02 ;is char. 'flash on'? |
||||
bne shft55 ;no |
||||
lda #$80 |
||||
sta flash |
||||
|
||||
shft55 |
||||
cmp #$04 ;is char. 'flash off'? |
||||
bne shft60 ;no |
||||
lda #0 |
||||
sta flash |
||||
|
||||
shft60 |
||||
cmp #$0e ;is char. 'set upper char set'? |
||||
beq upper ;yes |
||||
|
||||
ora #$80 ;restore msb |
||||
jmp ctlc90 ;test for color, return |
||||
|
||||
|
||||
delete |
||||
jsr cleft ;move back 1 position |
||||
jsr savpos ;save column & row positions |
||||
bcs delout ;abort if at top left corner |
||||
deloop |
||||
cpy scrt ;at right margin? |
||||
bcc delop1 ;no - skip ahead |
||||
ldx tblx |
||||
inx |
||||
jsr getbt1 ;is next line a wrapped line? |
||||
bcs delop1 ;yes - continue with delete |
||||
jsr doblnk ;no - blank last character |
||||
delout |
||||
lda sedt1 ;restore column and row positions |
||||
sta pntr |
||||
lda sedt2 |
||||
sta tblx |
||||
jmp stupt ;restore pnt & rts to loop2 |
||||
delop1 |
||||
jsr nxtchr |
||||
jsr get1ch ;get next character |
||||
jsr bakchr |
||||
jsr dsppc ;move it back 1 position |
||||
jsr nxtchr ;move up 1 position |
||||
jmp deloop ;loop until at end of line |
||||
|
||||
|
||||
; insert a character |
||||
; |
||||
insert |
||||
jsr savpos ;save column & row positions |
||||
jsr fndend ;move to last char on the line |
||||
cpx sedt2 ;last row equal to starting row? |
||||
bne ins10 ;no - skip ahead |
||||
cpy sedt1 ;is last position before starting position? |
||||
ins10 |
||||
bcc ins50 ;yes - no need to move anything |
||||
jsr movchr ;move to next char position |
||||
bcs insout ;abort if scroll needed but disabled |
||||
ins30 |
||||
jsr bakchr |
||||
jsr get1ch ;move char forward 1 position |
||||
jsr nxtchr |
||||
jsr dsppc |
||||
jsr bakchr |
||||
ldx tblx |
||||
cpx sedt2 ;at original position |
||||
bne ins30 |
||||
cpy sedt1 |
||||
bne ins30 ;no - loop till we are |
||||
jsr doblnk ;insert a blank |
||||
ins50 |
||||
inc insrt ;inc insert count |
||||
bne insout ;only allow up to 255 |
||||
dec insrt |
||||
insout |
||||
jmp delout ;restore original position |
||||
|
||||
;end |
||||
@ -0,0 +1,266 @@
|
||||
.page |
||||
.subttl 'ed.5 ted 12/09/83' |
||||
;************************************************************ |
||||
;* |
||||
;* routines involved in executing escape functions |
||||
;* |
||||
;************************************************************ |
||||
|
||||
; escape sequence handler |
||||
; entry: character following escape character in .a |
||||
|
||||
escape |
||||
and #$7f |
||||
sec |
||||
sbc #'a ;table begins at ascii 'a' & ends at 'w' |
||||
cmp #$17 ;'w'-'a'+1 |
||||
bcs none ;invalid char...ignore it! |
||||
|
||||
escgo ;get address of escape routine, push it, & rts to it |
||||
asl a ;multiply index by 2 |
||||
tax |
||||
lda escvct+1,x ;get high byte |
||||
pha |
||||
lda escvct,x ;and low |
||||
pha |
||||
none |
||||
rts ;and go to that address, if any |
||||
|
||||
|
||||
escvct |
||||
.word auton-1 ;a auto insert |
||||
.word sethtb-1 ;b set bottom |
||||
.word autoff-1 ;c cancel auto insert |
||||
.word dline-1 ;d delete line |
||||
.word none-1 ;e select non-flashing cursor |
||||
.word none-1 ;f flashing cursor |
||||
.word none-1 ;g enable bell |
||||
.word none-1 ;h disable bell |
||||
.word iline-1 ;i insert line |
||||
.word fndsol-1 ;j move to start of line |
||||
.word fndend-1 ;k move to end of line |
||||
.word scrsw0-1 ;l enable scrolling |
||||
.word scrsw1-1 ;m disable scrolling |
||||
.word setbig-1 ;n normal size screen (40 x 25) |
||||
.word toqm-1 ;o cancel insert,quote, and reverse |
||||
.word etstol-1 ;p erase to start of line |
||||
.word etol-1 ;q erase to end of line |
||||
.word setsml-1 ;r reduced size screen (38 x 23) |
||||
.word none-1 ;s solid cursor (not underscore) |
||||
.word sethtt-1 ;t set top of page |
||||
.word none-1 ;u underscore cursor |
||||
.word suup-1 ;v scroll up |
||||
.word sddn-1 ;w scroll down |
||||
.page |
||||
;***************************** |
||||
; |
||||
; window modes |
||||
; |
||||
;***************************** |
||||
|
||||
setsml ;set small screen (38 x 23) |
||||
jsr sreset ;first be sure entire... |
||||
jsr clsr ;...screen is clear & un-wrapped |
||||
lda #1 |
||||
tax |
||||
jsr sttop ;set top at 1,1 |
||||
lda #nlines-2 |
||||
ldx #llen-2 |
||||
jsr stbot ;set bottom at 39,23 |
||||
jmp home ;put cursor within window & rts |
||||
|
||||
sethtt |
||||
clc ;set top of window |
||||
.byte $24 |
||||
sethtb |
||||
sec ;set bottom of window |
||||
ldx pntr |
||||
lda tblx |
||||
bcc sttop |
||||
|
||||
stbot |
||||
sta scbot |
||||
stx scrt |
||||
jmp rewrap |
||||
|
||||
sreset ;reset screen to full window |
||||
lda #nlines-1 ;max # of rows |
||||
ldx #llen-1 ;max # of columns |
||||
jsr stbot |
||||
lda #0 |
||||
tax ;fall thru to set top |
||||
|
||||
sttop |
||||
sta sctop ;set top of window |
||||
stx sclf |
||||
|
||||
rewrap |
||||
lda #0 ;make all lines non-continued |
||||
ldx #4 |
||||
rewra1 |
||||
sta bitabl-1,x |
||||
dex |
||||
bne rewra1 |
||||
rts |
||||
|
||||
|
||||
|
||||
;***************************** |
||||
; |
||||
; insert line |
||||
; |
||||
;***************************** |
||||
|
||||
iline |
||||
jsr scrdwn ;insert a blank line |
||||
jsr stu10 ;move to start of line |
||||
inx |
||||
jsr getbt1 |
||||
php |
||||
jsr putbit ;set continuation same as in previous line |
||||
plp |
||||
bcs linrts ;skip if was wrapped |
||||
sec |
||||
ror lsxp ;set flag - new line |
||||
linrts |
||||
rts |
||||
|
||||
|
||||
|
||||
;************************** |
||||
; |
||||
; delete line |
||||
; |
||||
;************************** |
||||
|
||||
dline |
||||
jsr fistrt ;find start of line |
||||
lda sctop ;save current of window |
||||
pha |
||||
lda tblx ;make 1st display line top of window |
||||
sta sctop |
||||
lda logscr ;make sure logical scrl is off |
||||
pha |
||||
lda #$80 |
||||
sta logscr |
||||
jsr scru15 ;scroll the top line away |
||||
pla |
||||
sta logscr |
||||
lda sctop ;make old 1st line of this 1 current |
||||
sta tblx |
||||
pla |
||||
sta sctop |
||||
sec |
||||
ror lsxp ;set flag - new line |
||||
jmp stu10 ;make this line the current one |
||||
|
||||
|
||||
|
||||
;****************************** |
||||
; |
||||
; erase to end of line |
||||
; |
||||
;****************************** |
||||
|
||||
etol |
||||
jsr savpos |
||||
etol2 |
||||
jsr clrprt ;blank rest of line |
||||
inc tblx ;move to next line |
||||
jsr stupt |
||||
ldy sclf |
||||
jsr getbit ;check if next is wrapped line |
||||
bcs etol2 ;yes - blank next line |
||||
etout |
||||
jmp delout ;exit and restore original position |
||||
|
||||
|
||||
|
||||
;***************************** |
||||
; |
||||
; erase to start of line |
||||
; |
||||
;***************************** |
||||
|
||||
etstol |
||||
jsr savpos |
||||
etsto2 |
||||
jsr doblnk ;do a blank |
||||
cpy sclf ;done a line ? |
||||
bne ets100 ;no |
||||
jsr getbit ;at top of line |
||||
bcc etout ;yes - exit |
||||
ets100 jsr bakchr ;back up |
||||
bcc etsto2 ;always |
||||
|
||||
|
||||
|
||||
;***************************** |
||||
; |
||||
; scroll up |
||||
; |
||||
;***************************** |
||||
|
||||
suup |
||||
jsr savpos |
||||
txa |
||||
pha |
||||
jsr scrup |
||||
pla |
||||
sta sedt2 |
||||
jmp etout ;always |
||||
|
||||
|
||||
|
||||
;***************************** |
||||
; |
||||
; scroll down |
||||
; |
||||
;***************************** |
||||
|
||||
sddn |
||||
jsr savpos |
||||
jsr getbit |
||||
bcs sddn2 |
||||
sec |
||||
ror lsxp ;set flag - left line |
||||
sddn2 |
||||
lda sctop |
||||
sta tblx ;scroll from screen top |
||||
jsr scrdwn |
||||
jsr clrbit ;make first line non-continued |
||||
jmp etout ;always |
||||
|
||||
|
||||
|
||||
;******************************** |
||||
; |
||||
; scrolling enable/disable |
||||
; |
||||
;******************************** |
||||
|
||||
scrsw0 |
||||
lda #0 ;enable scrolling |
||||
.byte $2c |
||||
scrsw1 |
||||
lda #$80 ;disable scrolling |
||||
sta scrdis |
||||
rts |
||||
|
||||
|
||||
|
||||
;******************************* |
||||
; |
||||
; auto insert on/off |
||||
; |
||||
;******************************* |
||||
|
||||
autoff |
||||
lda #0 |
||||
.byte $2c |
||||
auton |
||||
lda #$ff |
||||
sta insflg |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,200 @@
|
||||
.page |
||||
.subttl 'ed.6 ted 12/09/83' |
||||
; grab a character |
||||
|
||||
get1ch |
||||
ldy pntr ;get char/color index |
||||
lda (user),y ;get the color |
||||
sta tcolor |
||||
lda (pnt),y ;get the character |
||||
rts |
||||
|
||||
; wrap table subroutines |
||||
; |
||||
getbit |
||||
ldx tblx |
||||
getbt1 |
||||
jsr bitpos ;get byte & bit positions |
||||
and bitabl,x |
||||
cmp #1 ;make carry clear if zero |
||||
jmp bitout |
||||
|
||||
; putbit - set bit according to carry |
||||
; |
||||
putbit |
||||
ldx tblx |
||||
putbt1 |
||||
bcs setbit ;go if to mark as wrappped line |
||||
|
||||
; clrbit - clear wrap bit |
||||
; |
||||
clrbit |
||||
jsr bitpos ;get byte & bit positions |
||||
eor #$ff ;invert bit position |
||||
and bitabl,x ;clear bit |
||||
bitsav |
||||
sta bitabl,x |
||||
bitout |
||||
ldx bitmsk |
||||
rts |
||||
|
||||
; setbit - set bit to mark as wrapped line |
||||
; |
||||
setbit |
||||
bit scrdis ;check for line-link disable |
||||
bvs getbt1 |
||||
jsr bitpos ;get byte & bit position |
||||
ora bitabl,x ;set wrap bit |
||||
bne bitsav ;always |
||||
|
||||
; bitpos - get byte & bit position of wrap bit |
||||
; input - x = row number |
||||
; output - x = byte number |
||||
; a = bit mask |
||||
|
||||
bitpos |
||||
stx bitmsk |
||||
txa |
||||
and #$07 ;get bit position |
||||
tax |
||||
lda scbits,x ;get bit mask |
||||
pha |
||||
lda bitmsk |
||||
lsr a |
||||
lsr a ;shift to get byte position |
||||
lsr a |
||||
tax |
||||
pla |
||||
rts |
||||
|
||||
scbits .byte $80,$40,$20,$10,$08,$04,$02,$01 |
||||
|
||||
; ****** move to end/start of line |
||||
; |
||||
fndsol |
||||
ldy sclf ;will move to start of line... |
||||
sty pntr ;set to leftmost column |
||||
|
||||
|
||||
; ****** find beginning of line |
||||
; |
||||
fistrt |
||||
jsr getbit ;find start of current line |
||||
bcc fnd0 ;branch if found |
||||
dec tblx ;up a line |
||||
bpl fistrt ;always |
||||
inc tblx ;whoops went too far |
||||
fnd0 |
||||
jmp stupt ;set line base adr |
||||
|
||||
|
||||
; ****** find last non-blank char of line |
||||
; |
||||
; pntr= column # |
||||
; tblx= line # |
||||
|
||||
fndend |
||||
inc tblx |
||||
jsr getbit ;is this line continued |
||||
bcs fndend ;branch if so |
||||
dec tblx ;found it - compensate for inc tblx |
||||
jsr stupt |
||||
ldy scrt ;get right margin |
||||
sty pntr ;point to right margin |
||||
eloup2 |
||||
jsr get1ch |
||||
cmp #$20 |
||||
bne endbye ;yes |
||||
cpy sclf ;are we at the left margin? |
||||
bne eloup1 ;no- keep going |
||||
jsr getbit ;are we on a wrapped line? |
||||
bcc endbye ;no- get out |
||||
eloup1 |
||||
jsr bakchr |
||||
bcc eloup2 ;ok- not at top left |
||||
endbye |
||||
sty indx ;remember this |
||||
rts |
||||
|
||||
|
||||
; ****** move to next char |
||||
; |
||||
; scroll if enabled |
||||
; wrap to top if disabled |
||||
|
||||
nxtchr |
||||
pha |
||||
ldy pntr |
||||
cpy scrt ;are we at the right margin? |
||||
bcc bumpnt ;branch if not |
||||
.space 1 |
||||
jsr nxln ;point to nextline |
||||
ldy sclf ;point to first char of 1st line |
||||
dey |
||||
sec ;set to show moved to new line |
||||
bumpnt iny ;increment char index |
||||
sty pntr |
||||
pla |
||||
rts |
||||
|
||||
|
||||
; ****** backup one char |
||||
; |
||||
; wrap up and stop a top left |
||||
|
||||
bakchr |
||||
ldy pntr |
||||
dey |
||||
bmi bakot1 |
||||
cpy sclf ;are we at the left margin |
||||
bcs bakout ;no - past it |
||||
bakot1 |
||||
ldy sctop |
||||
cpy tblx ;are we at top line last character? |
||||
bcs bakot2 ;leave with carry set |
||||
dec tblx ;else backup a line |
||||
pha |
||||
jsr stupt ;set line base adr |
||||
pla |
||||
ldy scrt ;move cursor to right side |
||||
bakout |
||||
sty pntr |
||||
cpy scrt ;set z-flag if moved to new line |
||||
clc ;always clear |
||||
bakot2 |
||||
rts |
||||
|
||||
|
||||
; ****** save row & column position |
||||
; |
||||
savpos |
||||
ldy pntr |
||||
sty sedt1 |
||||
ldx tblx |
||||
stx sedt2 |
||||
rts |
||||
|
||||
|
||||
doblnk |
||||
lda #$20 |
||||
|
||||
|
||||
dspp |
||||
ldy pntr |
||||
sta (pnt),y |
||||
jsr scolor |
||||
lda color |
||||
ora flash |
||||
sta (user),y |
||||
rts |
||||
|
||||
|
||||
dsppc |
||||
ldy pntr |
||||
sta (pnt),y |
||||
jsr scolor |
||||
lda tcolor |
||||
sta (user),y |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,344 @@
|
||||
.page |
||||
.subttl 'ed.7 ted 12/09/83' |
||||
keycod ;keyboard mode 'dispatch' |
||||
.word mode1 |
||||
.word mode2 |
||||
.word mode3 |
||||
.word contrl ;control keys |
||||
|
||||
|
||||
mode1 ;unshifted,no control |
||||
.byte $14 ; del |
||||
.byte $0d ; return |
||||
.byte $5c ; pound-l |
||||
.byte $8c ; f8 (help) |
||||
.byte $85 ; f1 |
||||
.byte $89 ; f2 |
||||
.byte $86 ; f3 |
||||
.byte $40 ; @ |
||||
|
||||
.byte $33 ; 3 |
||||
.byte $57 ; w |
||||
.byte $41 ; a |
||||
.byte $34 ; 4 |
||||
.byte $5a ; z |
||||
.byte $53 ; s |
||||
.byte $45 ; e |
||||
.byte $01 ; shift |
||||
|
||||
.byte $35 ; 5 |
||||
.byte $52 ; r |
||||
.byte $44 ; d |
||||
.byte $36 ; 6 |
||||
.byte $43 ; c |
||||
.byte $46 ; f |
||||
.byte $54 ; t |
||||
.byte $58 ; x |
||||
|
||||
.byte $37 ; 7 |
||||
.byte $59 ; y |
||||
.byte $47 ; g |
||||
.byte $38 ; 8 |
||||
.byte $42 ; b |
||||
.byte $48 ; h |
||||
.byte $55 ; u |
||||
.byte $56 ; v |
||||
|
||||
.byte $39 ; 9 |
||||
.byte $49 ; i |
||||
.byte $4a ; j |
||||
.byte $30 ; 0 |
||||
.byte $4d ; m |
||||
.byte $4b ; k |
||||
.byte $4f ; o |
||||
.byte $4e ; n |
||||
|
||||
.byte $11 ; crsr down |
||||
.byte $50 ; p |
||||
.byte $4c ; l |
||||
.byte $91 ; crsr up |
||||
.byte $2e ; . |
||||
.byte $3a ; : |
||||
.byte $2d ; - |
||||
.byte $2c ; , |
||||
|
||||
.byte $9d ; crsr left |
||||
.byte $2a ; * |
||||
.byte $3b ; ; |
||||
.byte $1d ; crsr right |
||||
.byte $1b ; escape |
||||
.byte $3d ; = |
||||
.byte $2b ; + |
||||
.byte $2f ; / |
||||
|
||||
.byte $31 ; 1 |
||||
.byte $13 ; home |
||||
.byte $04 ; control |
||||
.byte $32 ; 2 |
||||
.byte $20 ; space |
||||
.byte $02 ; commodore key |
||||
.byte $51 ; q |
||||
.byte $03 ; stop |
||||
.byte $ff ;end of table null |
||||
|
||||
|
||||
mode2 ;shifted,no control |
||||
.byte $94 ; insert |
||||
.byte $8d ; shift return |
||||
.byte $a9 ; pound-l |
||||
.byte $88 ; f7 |
||||
.byte $8a ; f4 |
||||
.byte $87 ; f5 |
||||
.byte $8b ; f6 |
||||
.byte $ba ; @ |
||||
|
||||
.byte $23 ; # |
||||
.byte $d7 ; w |
||||
.byte $c1 ; a |
||||
.byte $24 ; $ |
||||
.byte $da ; z |
||||
.byte $d3 ; s |
||||
.byte $c5 ; e |
||||
.byte $01 ; shift |
||||
|
||||
.byte $25 ; % |
||||
.byte $d2 ; r |
||||
.byte $c4 ; d |
||||
.byte $26 ; & |
||||
.byte $c3 ; c |
||||
.byte $c6 ; f |
||||
.byte $d4 ; t |
||||
.byte $d8 ; x |
||||
|
||||
.byte $27 ; ' |
||||
.byte $d9 ; y |
||||
.byte $c7 ; g |
||||
.byte $28 ; ( |
||||
.byte $c2 ; b |
||||
.byte $c8 ; h |
||||
.byte $d5 ; u |
||||
.byte $d6 ; v |
||||
|
||||
.byte $29 ; ) |
||||
.byte $c9 ; i |
||||
.byte $ca ; j |
||||
.byte $5e ; ~ |
||||
.byte $cd ; m |
||||
.byte $cb ; k |
||||
.byte $cf ; o |
||||
.byte $ce ; n |
||||
|
||||
.byte $11 ; crsr down |
||||
.byte $d0 ; p |
||||
.byte $cc ; l |
||||
.byte $91 ; crsr up |
||||
.byte $3e ; > |
||||
.byte $5b ; { |
||||
.byte $dd ; - |
||||
.byte $3c ; < |
||||
|
||||
.byte $9d ; crsr left |
||||
.byte $c0 ; * |
||||
.byte $5d ; } |
||||
.byte $1d ; crsr right |
||||
.byte $1b ; escape |
||||
.byte $5f ; left arrow |
||||
.byte $db ; + |
||||
.byte $3f ; ? |
||||
|
||||
.byte $21 ; ! |
||||
.byte $93 ; clr screen |
||||
.byte $04 ; control |
||||
.byte $22 ; " |
||||
.byte $a0 ; shifted space |
||||
.byte $02 ; commodore key |
||||
.byte $d1 ; q |
||||
.byte $83 ; run |
||||
.byte $ff ;end of table null |
||||
|
||||
|
||||
mode3 ;commodore key (left window graphics) |
||||
.byte $94 ; insert |
||||
.byte $8d ; shifted return |
||||
.byte $a8 ; pound-l |
||||
.byte $88 ; f7 |
||||
.byte $8a ; f4 |
||||
.byte $87 ; f5 |
||||
.byte $8b ; f6 |
||||
.byte $a4 ; @ |
||||
|
||||
.byte $96 ; color 10 |
||||
.byte $b3 ; w |
||||
.byte $b0 ; a |
||||
.byte $97 ; color 11 |
||||
.byte $ad ; z |
||||
.byte $ae ; s |
||||
.byte $b1 ; e |
||||
.byte $01 ; shift |
||||
|
||||
.byte $98 ; color 12 |
||||
.byte $b2 ; r |
||||
.byte $ac ; d |
||||
.byte $99 ; color 13 |
||||
.byte $bc ; c |
||||
.byte $bb ; f |
||||
.byte $a3 ; t |
||||
.byte $bd ; x |
||||
|
||||
.byte $9a ; color 14 |
||||
.byte $b7 ; y |
||||
.byte $a5 ; g |
||||
.byte $9b ; color 15 |
||||
.byte $bf ; b |
||||
.byte $b4 ; h |
||||
.byte $b8 ; u |
||||
.byte $be ; v |
||||
|
||||
.byte $29 ; ) |
||||
.byte $a2 ; i |
||||
.byte $b5 ; j |
||||
.byte $30 ; 0 |
||||
.byte $a7 ; m |
||||
.byte $a1 ; k |
||||
.byte $b9 ; o |
||||
.byte $aa ; n |
||||
|
||||
.byte $11 ; crsr down |
||||
.byte $af ; p |
||||
.byte $b6 ; l |
||||
.byte $91 ; crsr up |
||||
.byte $3e ; > |
||||
.byte $5b ; { |
||||
.byte $dc ; - |
||||
.byte $3c ; < |
||||
|
||||
.byte $9d ; crsr left |
||||
.byte $df ; * |
||||
.byte $5d ; } |
||||
.byte $1d ; crsr right |
||||
.byte $1b ; escape |
||||
.byte $de ; pi |
||||
.byte $a6 ; + |
||||
.byte $3f ; ? |
||||
|
||||
.byte $81 ; color 8 |
||||
.byte $93 ; cls |
||||
.byte $04 ; control |
||||
.byte $95 ; color 9 |
||||
.byte $a0 ; shifted space |
||||
.byte $02 ; commodore key |
||||
.byte $ab ; q |
||||
.byte $83 ; run |
||||
.byte $ff ;end of table null |
||||
|
||||
|
||||
contrl |
||||
.byte $ff ; del |
||||
.byte $ff ; return |
||||
.byte $1c ; pound-l |
||||
.byte $ff ; f8 (help) |
||||
.byte $ff ; f1 |
||||
.byte $ff ; f2 |
||||
.byte $ff ; f3 |
||||
.byte $ff ; @ |
||||
|
||||
.byte $1c ; 3 |
||||
.byte $17 ; w |
||||
.byte $01 ; a |
||||
.byte $9f ; 4 |
||||
.byte $1a ; z |
||||
.byte $13 ; s |
||||
.byte $05 ; e |
||||
.byte $ff ; shift |
||||
|
||||
.byte $9c ; 5 |
||||
.byte $12 ; r |
||||
.byte $04 ; d |
||||
.byte $1e ; 6 |
||||
.byte $03 ; c |
||||
.byte $06 ; f |
||||
.byte $14 ; t |
||||
.byte $18 ; x |
||||
|
||||
.byte $1f ; 7 |
||||
.byte $19 ; y |
||||
.byte $07 ; g |
||||
.byte $9e ; 8 |
||||
.byte $02 ; b |
||||
.byte $08 ; h |
||||
.byte $15 ; u |
||||
.byte $16 ; v |
||||
|
||||
.byte $12 ; 9 |
||||
.byte $09 ; i |
||||
.byte $0a ; j |
||||
.byte $92 ; 0 |
||||
.byte $0d ; m |
||||
.byte $0b ; k |
||||
.byte $0f ; o |
||||
.byte $0e ; n |
||||
|
||||
.byte $ff ; crsr down |
||||
.byte $10 ; p |
||||
.byte $0c ; l |
||||
.byte $ff ; crsr up |
||||
.byte $84 ; flash off |
||||
.byte $1b ; : |
||||
.byte $ff ; - |
||||
.byte $82 ; flash on |
||||
|
||||
.byte $ff ; crsr left |
||||
.byte $ff ; * |
||||
.byte $1d ; ; |
||||
.byte $ff ; crsr right |
||||
.byte $1b ; escape |
||||
.byte $06 ; = |
||||
.byte $ff ; + |
||||
.byte $ff ; / |
||||
|
||||
.byte $90 ; 1 |
||||
.byte $ff ; home |
||||
.byte $ff ; control |
||||
.byte $05 ; 2 |
||||
.byte $ff ; space |
||||
.byte $ff ; commodore key |
||||
.byte $11 ; q |
||||
.byte $ff ; stop |
||||
.byte $ff ;end of table null |
||||
|
||||
runtb .byte $44,$cc,$22,$2a,cr,'RUN',cr ;dload '* : run |
||||
|
||||
coltab |
||||
.byte $90,$05,$1c,$9f,$9c,$1e,$1f,$9e |
||||
.byte $81,$95,$96,$97,$98,$99,$9a,$9b |
||||
collum |
||||
.byte $00,$71,$32,$63,$44,$35,$46,$77 |
||||
.byte $48,$29,$5a,$6b,$5c,$6d,$2e,$5f |
||||
|
||||
linz0 = tedscn |
||||
linz1 = linz0+llen |
||||
linz2 = linz1+llen |
||||
linz3 = linz2+llen |
||||
linz4 = linz3+llen |
||||
linz5 = linz4+llen |
||||
linz6 = linz5+llen |
||||
linz7 = linz6+llen |
||||
linz8 = linz7+llen |
||||
linz9 = linz8+llen |
||||
linz10 = linz9+llen |
||||
linz11 = linz10+llen |
||||
linz12 = linz11+llen |
||||
linz13 = linz12+llen |
||||
linz14 = linz13+llen |
||||
linz15 = linz14+llen |
||||
linz16 = linz15+llen |
||||
linz17 = linz16+llen |
||||
linz18 = linz17+llen |
||||
linz19 = linz18+llen |
||||
linz20 = linz19+llen |
||||
linz21 = linz20+llen |
||||
linz22 = linz21+llen |
||||
linz23 = linz22+llen |
||||
linz24 = linz23+llen |
||||
|
||||
;end |
||||
@ -0,0 +1,68 @@
|
||||
.page |
||||
.subttl 'error handler' |
||||
;*************************************** |
||||
;* stop -- check stop key flag and * |
||||
;* return z flag set if flag true. * |
||||
;* also closes active channels and * |
||||
;* flushes keyboard queue. * |
||||
;* also returns key downs from last * |
||||
;* keyboard row in .a. * |
||||
;*************************************** |
||||
|
||||
nstop lda stkey ;value of last row |
||||
cmp #$7f ;check stop key position |
||||
bne stop2 ;not down |
||||
php |
||||
jsr clrch ;clear channels |
||||
sta ndx ;flush queue |
||||
plp |
||||
stop2 rts |
||||
|
||||
|
||||
|
||||
;************************************ |
||||
;* * |
||||
;* error handler * |
||||
;* * |
||||
;* prints kernal error message if * |
||||
;* bit 6 of msgflg set. returns * |
||||
;* with error # in .a and carry. * |
||||
;* * |
||||
;************************************ |
||||
|
||||
error1 lda #1 ;too many files |
||||
.byte $2c |
||||
error2 lda #2 ;file open |
||||
.byte $2c |
||||
error3 lda #3 ;file not open |
||||
.byte $2c |
||||
error4 lda #4 ;file not found |
||||
.byte $2c |
||||
error5 lda #5 ;device not present |
||||
.byte $2c |
||||
error6 lda #6 ;not input file |
||||
.byte $2c |
||||
error7 lda #7 ;not output file |
||||
.byte $2c |
||||
error8 lda #8 ;missing file name |
||||
.byte $2c |
||||
error9 lda #9 ;bad device # |
||||
|
||||
pha ;error number on stack |
||||
jsr clrch ;restore i/o channels |
||||
|
||||
ldy #ms1-ms1 |
||||
bit msgflg ;are we printing error? |
||||
bvc erexit ;no... |
||||
|
||||
jsr msg ;print "cbm i/o error #" |
||||
pla |
||||
pha |
||||
ora #$30 ;make error # ascii |
||||
jsr bsout ;print it |
||||
|
||||
erexit pla |
||||
sec |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,325 @@
|
||||
.page |
||||
.subttl 'init (kernal) 02/17/84' |
||||
;**************************************** |
||||
; |
||||
; start - all kernal initialization |
||||
; is done here. |
||||
; |
||||
;**************************************** |
||||
|
||||
start |
||||
ldx #$ff |
||||
sei |
||||
txs |
||||
cld |
||||
jsr spkpat ;see which cartridge slots are occupied (and go if autostart) |
||||
jsr ioinit ;initialize ted, i/o |
||||
|
||||
jsr ud60 ;test for run/stop key down <and> 'cold' reset |
||||
php ;(save for 'jmp to monitor' test later) |
||||
bmi start1 ;key not down, do full init |
||||
lda #$a5 |
||||
cmp dejavu ;test for 'cold' or 'warm' reset |
||||
beq start2 ;it is 'warm' reset w/ run/stop down: skip 'ramtas' |
||||
|
||||
start1 |
||||
jsr ramtas ;find mem top, init system storage, download ram code |
||||
start2 |
||||
jsr restor ;set up indirects |
||||
jsr cint ;initialize screen & editor |
||||
plp |
||||
bmi basic ;branch to basic if no run/stop key |
||||
|
||||
jmp entry ;go to monitor |
||||
basic |
||||
jmp $8000 ;go to basic |
||||
|
||||
|
||||
|
||||
;******************************************** |
||||
; |
||||
; restor - set kernal indirects and vectors |
||||
; |
||||
;******************************************** |
||||
|
||||
restor |
||||
ldx #<vectss |
||||
ldy #>vectss |
||||
clc |
||||
|
||||
; vector - set kernal indirect and vectors (user) |
||||
; |
||||
vector |
||||
stx tmp2 |
||||
sty tmp2+1 |
||||
ldy #vectse-vectss-1 |
||||
movos1 |
||||
lda itime,y ;get from storage |
||||
bcs movos2 ;c...want storage to user |
||||
lda (tmp2),y ;...want user to storage |
||||
movos2 |
||||
sta itime,y ;put in storage |
||||
bcc movos3 |
||||
sta (tmp2),y ;put in user |
||||
movos3 |
||||
dey |
||||
bpl movos1 |
||||
rts |
||||
|
||||
vectss |
||||
.wor ntime,srvirq,entbrk |
||||
.wor nopen,nclose,nchkin |
||||
.wor nckout,nclrch,nbasin |
||||
.wor nbsout,nstop,ngetin |
||||
.wor nclall,entbrk |
||||
.wor nload,nsave |
||||
vectse |
||||
.page |
||||
;************************************ |
||||
; |
||||
; ioinit - initialize i/o |
||||
; |
||||
;************************************ |
||||
|
||||
ioinit |
||||
lda #%00001111 ;set up 6510 port |
||||
sta pdir |
||||
lda #%00001000 |
||||
sta port |
||||
|
||||
ldx #$ff |
||||
stx xport ;init 6529 |
||||
stx drva2 ;cmd channel all outputs |
||||
inx ;.x=0 |
||||
stx drvb2 ;inputs |
||||
stx tedrva ;clear cmd |
||||
|
||||
lda #%01000000 ;($40) |
||||
sta drvc2 ;set up handshake line |
||||
; sta tedrvc ;init line to '1' |
||||
jsr patchd |
||||
|
||||
initlp |
||||
lda table,x ;(.x=0 initially) |
||||
sta ted,x ;init ted registers |
||||
inx |
||||
cpx #26 |
||||
bne initlp |
||||
|
||||
jmp ainit ;init rs-232 buffers & rts |
||||
|
||||
|
||||
table |
||||
.byte $f1,$39 ;0,1: t1 |
||||
.byte 0,0 ;2,3: t2 |
||||
.byte 0,0 ;4,5: t3 |
||||
.byte $1b ;6: elm=0, bmm=0, blnk=1, 25 rows, y=3 |
||||
|
||||
.if palmod |
||||
.byte $08 ;7: rev. video on,pal,freeze=0,mcm=0,40col,x=0 |
||||
.else |
||||
.byte $48 ;7: rev. video on,ntsc,freeze=0,mcm=0,40col,x=0 |
||||
.endif |
||||
|
||||
.byte 0,0 ;8,9: kbd, int read (don't care) |
||||
.byte $02 ;10: disable all interrupts except raster |
||||
.byte $cc ;11: raster compare (end of screen) |
||||
.byte 0,0 ;12,13: cursor position |
||||
.byte 0,0 ;14,15: lsb of sound 1 & 2 |
||||
.byte 0 ;16: msb of sound 2 off |
||||
.byte 0 ;17: no voice, volume off |
||||
.byte $04 ;18: bm base, charset from rom, ms bits sound 1 off |
||||
.byte $d0 ;19: character base @ $d000, single clock, status |
||||
.byte $08 ;20: vm base @ $c00 |
||||
.byte $71 ;21: bkgd 0, ful lum, white |
||||
.byte $5b ;22: bkgd 1, med lum, lt. red |
||||
.byte $75 ;23: bkgd 2, ful lum, lt. green (not used) |
||||
.byte $77 ;24: bkgd 3, ful lum, yellow (not used) |
||||
.byte $6e ;25: exterior (ful lum)-1, dk. blue |
||||
.page |
||||
;***************************************** |
||||
; |
||||
; ramtas - memory size check and set |
||||
; |
||||
;***************************************** |
||||
|
||||
ramtas |
||||
lda #0 ;zero low memory |
||||
tay |
||||
ramtz0 |
||||
sta $0002,y ;zero page (skip over 6510 port!) |
||||
sta $0200,y ;user buffers and vars |
||||
sta $0300,y ;system space and user space |
||||
sta $0400,y ;basic stuff |
||||
sta $0700,y ;editor stuff |
||||
iny |
||||
bne ramtz0 |
||||
|
||||
; set top of memory |
||||
; |
||||
ramtbt |
||||
ldx #8 ;(.y=0 already) |
||||
stx t1 ;set up a counter |
||||
ramtlp ;copy reset vector & code into ram, in case of a reset |
||||
lda gostrt-1,x ;..while rom is banked out. |
||||
sta gostrt-1,x |
||||
cmp gostrt-$c000-1,x ;test if write appeared in lowest 16k bank. |
||||
bne ramtzx ;nope |
||||
iny ;yes, means write may have bled thru. count # of occurances |
||||
ramtzx |
||||
cmp gostrt-$8000-1,x ;test if write appeared in second 16k bank. |
||||
bne ramtzy ;nope |
||||
dec t1 |
||||
ramtzy |
||||
dex |
||||
bne ramtlp ;go for 8 bytes |
||||
|
||||
cpy #8 ;did all 8 bytes bleed thru to lowest 16k? |
||||
beq ramtz3 ;yes, means 16k system |
||||
lda t1 ;did all 8 bytes bleed thru to second 16k? |
||||
bne ramtz1 ;must be 64k system |
||||
ldy #$7f ;32k system, top of ram at $7ff6 |
||||
.byte $2c |
||||
|
||||
ramtz3 |
||||
ldy #$3f ;16k system, top of ram at $3ff6 |
||||
ldx #$f6 |
||||
.byte $2c |
||||
|
||||
ramtz1 |
||||
ldy #$fd ;64k system..top of memory @ $fd00 (*assume x=0*) |
||||
ramtz2 |
||||
clc |
||||
jsr settop |
||||
|
||||
lda #$10 ;set bottom of ram at $1000 |
||||
sta memstr+1 |
||||
|
||||
ldx #pfkend-pfktbl |
||||
pfinit |
||||
lda pfktbl-1,x ;init prog. function keys |
||||
sta keybuf-1,x |
||||
dex |
||||
bne pfinit |
||||
stx kyndx ;clear key count |
||||
|
||||
ldx #ugh-sobsob-1 |
||||
mmm |
||||
lda sobsob,x ;download indirect routine for save & verify |
||||
sta kludes,x |
||||
dex |
||||
bpl mmm |
||||
|
||||
ldx #15 |
||||
mmmm |
||||
lda collum,x ;download color default values to mr. f's table |
||||
sta colkey,x ;now mr. f can choose his own colors!!! |
||||
dex |
||||
bpl mmmm |
||||
|
||||
lda #$a5 |
||||
sta dejavu |
||||
|
||||
; ted is now 'warm': set flag to show ram is init-ed |
||||
; |
||||
lda #$04 |
||||
sta ffrmsk ;fetch characters from rom |
||||
lda #$18 |
||||
sta vmbmsk ;set video matrix base pointer |
||||
rts |
||||
|
||||
.byte $ea,$ea ;(** 01/24/84 patch to conform to 'ces' release!) |
||||
|
||||
|
||||
pfktbl |
||||
.byte key2-key1 |
||||
.byte key3-key2 |
||||
.byte key4-key3 |
||||
.byte key5-key4 |
||||
.byte key6-key5 |
||||
.byte key7-key6 |
||||
.byte key8-key7 |
||||
.byte pfkend-key8 |
||||
key1 |
||||
.BYTE 'GRAPHIC' |
||||
KEY2 |
||||
.BYTE 'DLOAD',34 |
||||
KEY3 |
||||
.BYTE 'DIRECTORY',CR |
||||
KEY4 |
||||
.BYTE 'SCNCLR',CR |
||||
KEY5 |
||||
.BYTE 'DSAVE',34 |
||||
KEY6 |
||||
.BYTE 'RUN',CR |
||||
KEY7 |
||||
.BYTE 'LIST',CR |
||||
KEY8 |
||||
.BYTE 'HELP',CR |
||||
pfkend |
||||
.page |
||||
setnam |
||||
sta fnlen ;set up filename |
||||
stx fnadr |
||||
sty fnadr+1 |
||||
rts |
||||
|
||||
|
||||
setlfs |
||||
sta la ;set up la, fa, sa |
||||
stx fa |
||||
sty sa |
||||
rts |
||||
|
||||
|
||||
setmsg |
||||
sta msgflg ;enable/disable kernal messages |
||||
readss |
||||
lda status ;read i/o status |
||||
udst |
||||
ora status ;update i/o status |
||||
sta status |
||||
rts |
||||
|
||||
|
||||
settmo |
||||
sta timout ;update timeout flag |
||||
rts |
||||
|
||||
|
||||
; manage top of memory |
||||
; |
||||
memtop |
||||
bcc settop |
||||
|
||||
; carry set - read top of memory |
||||
; |
||||
gettop |
||||
ldx msiz |
||||
ldy msiz+1 |
||||
|
||||
; carry clear - set top of memory |
||||
; |
||||
settop |
||||
stx msiz |
||||
sty msiz+1 |
||||
rts |
||||
|
||||
; manage bottom of memory |
||||
; |
||||
membot |
||||
bcc setbot |
||||
|
||||
; carry set - read bottom of memory |
||||
; |
||||
ldx memstr |
||||
ldy memstr+1 |
||||
|
||||
; carry clear - set bottom of memory |
||||
; |
||||
setbot |
||||
stx memstr |
||||
sty memstr+1 |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,72 @@
|
||||
.page |
||||
.subttl 'interrupt 01/16/84' |
||||
;******************************* |
||||
; |
||||
; irq / break service routine |
||||
; |
||||
;******************************* |
||||
|
||||
krnirq ;enter from 'puls' in non-banking rom |
||||
tsx |
||||
lda $104,x ;get old status |
||||
and #$10 ;test if irq or break |
||||
bne puls1 ;branch if break |
||||
jmp (cinv) ;usually goes to srvirq |
||||
puls1 |
||||
jmp (cbinv) ;usually goes to monitor |
||||
|
||||
|
||||
|
||||
srvirq |
||||
lda tedirq |
||||
and #%00000010 ;is this a raster interrupt? |
||||
beq srv010 ;no, go test for acia |
||||
jsr srvspl ;service split screen |
||||
|
||||
srv010 ;test the acia |
||||
bit apres ;see if acia is present |
||||
bpl srv020 ;no, don't poll |
||||
lda acia+1 |
||||
sta astat ;read sensitive device |
||||
bpl srv020 ;no acia interrupt |
||||
jsr ain ;did we get a char? |
||||
jsr aout ;can we send a char? |
||||
|
||||
srv020 |
||||
jsr dtimeo ;see if cass interrupt |
||||
lda tedirq |
||||
and #%00000010 ;is this a raster interrupt? |
||||
beq srv080 ;nope |
||||
|
||||
sta tedirq ;turn off interrupt |
||||
bit ted+11 ;line 20 or end of screen? |
||||
lda #$cc ;assume line 20 |
||||
bvc srv070 ;it was line 20! just reload raster compare reg. |
||||
|
||||
jmp (itime) |
||||
ntime |
||||
jsr judt2 ;update jiffy clock +++ |
||||
jsr domus ;service sound generators |
||||
|
||||
; *** 01/16/84 fix: remove function key handler from irq |
||||
; (let screen editor do it all) |
||||
|
||||
lda curbnk ;save old bank configuration, |
||||
pha |
||||
lda #0 |
||||
sta curbnk ;make kernal (temporarily) the new configuration, |
||||
php |
||||
cli ;key scan must be interruptable |
||||
jsr scnkey ;scan keyboard |
||||
plp ;protect our retreat |
||||
pla ;get old 'current bank' |
||||
sta curbnk |
||||
srv060 |
||||
lda #$a1 ;set up to load raster compare reg for line 20 |
||||
srv070 |
||||
sta ted+11 |
||||
srv080 |
||||
jmp irqret ;restore registers, exit from irq |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,49 @@
|
||||
.nam ted_kernal |
||||
|
||||
.include disclaim |
||||
.include declare |
||||
|
||||
true =-1 |
||||
false =0 |
||||
truted =true |
||||
palmod =false |
||||
|
||||
*=$d800 |
||||
.include ed1 |
||||
.include ed2 |
||||
.include ed3 |
||||
.include ed4 |
||||
.include ed5 |
||||
.include ed6 |
||||
.include ed7 |
||||
.include serial |
||||
.include tapsup |
||||
.include tapwrt |
||||
.include tapred |
||||
.include rs232 |
||||
.include messages |
||||
.include channelio |
||||
.include openchanl |
||||
.include close |
||||
.include clall |
||||
.include open |
||||
.include load |
||||
.include save |
||||
.include errorhdlr |
||||
.include init |
||||
.include cmds1 |
||||
.include cmds2 |
||||
.include disasm |
||||
.include assem |
||||
.include util |
||||
.include banking |
||||
|
||||
*=$ce00 |
||||
.include interrupt |
||||
.include split |
||||
.include music |
||||
.include time |
||||
.include overflow |
||||
.include patches |
||||
.include vectors |
||||
.end |
||||
@ -0,0 +1,255 @@
|
||||
.page |
||||
.subttl 'load' |
||||
;********************************** |
||||
;* load * |
||||
;* * |
||||
;* fa: 0= invalid * |
||||
;* 1= cassette * |
||||
;* 2= invalid * |
||||
;* 3-31= serial * |
||||
;* * |
||||
;* sa: 0= alternate load * |
||||
;* .x,.y= load address * |
||||
;* 1= normal load * |
||||
;* * |
||||
;* .a: 0= load * |
||||
;* >0= verify only * |
||||
;* * |
||||
;* ending address returned in x,y * |
||||
;* * |
||||
;********************************** |
||||
|
||||
loadsp |
||||
stx memuss ;.x has low alt start |
||||
sty memuss+1 |
||||
load |
||||
jmp (iload) ;monitor load entry |
||||
|
||||
nload |
||||
sta verfck ;store verify flag |
||||
lda #0 |
||||
sta status ;clear status |
||||
lda fa ;check device number |
||||
bne ld20 |
||||
|
||||
ld10 |
||||
jmp error9 ;bad device #-keyboard |
||||
|
||||
ld20 |
||||
cmp #3 |
||||
beq ld10 ;disallow screen load |
||||
bcs ldieee ;>=4 |
||||
cmp #2 |
||||
beq ld10 ;no load from rs232 |
||||
jmp ldcass ;some of our people listen to them when they program |
||||
; |
||||
; load from serial |
||||
; |
||||
ldieee |
||||
ldy fnlen ;must have file name |
||||
bne ld25 ;yes...ok |
||||
jmp error8 ;missing file name |
||||
|
||||
ld25 |
||||
ldx sa ;save sa in .x |
||||
jsr luking ;tell user looking |
||||
lda #$60 ;special load command |
||||
sta sa |
||||
jsr openi ;open the file |
||||
|
||||
lda fa |
||||
jsr ttalk ;%% establish the channel |
||||
lda sa |
||||
jsr ttksa ;%% tell it to load |
||||
|
||||
jsr tacptr ;%% get first byte |
||||
sta eal |
||||
|
||||
lda status ;test status for error |
||||
lsr a |
||||
lsr a |
||||
bcs ld90 ;file not found...actually i'm just too lazy |
||||
jsr tacptr ;%% |
||||
sta eah |
||||
|
||||
txa ;find out old sa |
||||
bne ld30 ;sa<>0 use disk address |
||||
lda memuss ;else load where user wants |
||||
sta eal |
||||
lda memuss+1 |
||||
sta eah |
||||
ld30 |
||||
jsr loding ;tell user loading |
||||
|
||||
ld40 |
||||
lda #$fd ;mask off timeout |
||||
and status |
||||
sta status |
||||
|
||||
jsr stop ;stop key? |
||||
bne ld45 ;no... |
||||
|
||||
jmp break ;stop key pressed |
||||
|
||||
ld45 |
||||
jsr tacptr ;%% get byte off ieee |
||||
tax |
||||
lda status ;was there a timeout? |
||||
lsr a |
||||
lsr a |
||||
bcs ld40 ;yes...try again |
||||
txa |
||||
ldy verfck ;performing verify? |
||||
beq ld50 ;no...load |
||||
ldy #0 |
||||
sta vsave ;temp for check |
||||
lda #eal ;verify it |
||||
sta sinner |
||||
jsr kludes |
||||
cmp vsave |
||||
beq ld60 ;o.k.... |
||||
lda #sperr ;no good...verify error |
||||
jsr udst ;update status |
||||
.byte $2c ;skip next store |
||||
|
||||
ld50 |
||||
sta (eal),y |
||||
ld60 |
||||
inc eal ;increment store addr |
||||
bne ld64 |
||||
inc eah |
||||
ld64 |
||||
bit status ;eoi? |
||||
bvc ld40 ;no...continue load |
||||
|
||||
jsr tuntlk ;%% close channel |
||||
jsr clsei ;close the file |
||||
bcc ld180 ;branch always |
||||
|
||||
ld90 |
||||
jmp error4 ;file not found |
||||
; |
||||
; set end load addresses |
||||
; |
||||
ld180 |
||||
ldx eal ;.c=0 already! |
||||
ldy eah |
||||
ld190 |
||||
rts |
||||
; |
||||
; load from cassette |
||||
; |
||||
ldcass |
||||
jsr tstply ;tell user to press the little buttons |
||||
bcs ld190 ;stop key pressed |
||||
jsr luking ;tell user searching |
||||
ld101 |
||||
lda fnlen ;ark!, have we a name for this creature? |
||||
beq ld150 ;no |
||||
jsr faf ;yes get a named file |
||||
bcc ld170 |
||||
beq ld190 ;stopkey again |
||||
bcs ld90 ;error |
||||
|
||||
ld150 |
||||
jsr fah ;nothing in particular (any header) |
||||
beq ld190 ;stop key |
||||
bcs ld90 ;no header |
||||
|
||||
ld170 |
||||
lda type ;is it a movable program? |
||||
cmp #blf |
||||
beq ld175 ;basic load file |
||||
|
||||
cmp #plf ;perhaps a fixed file? |
||||
bne ld101 ;another throw of the dice |
||||
ld173 |
||||
ldy #0 ;fixed load |
||||
lda (tapebs),y ;get starting address from header |
||||
sta memuss ;into memuss |
||||
iny |
||||
lda (tapebs),y |
||||
sta memuss+1 |
||||
jmp ld179 |
||||
|
||||
ld175 |
||||
lda sa ;check for a monitor load |
||||
bne ld173 ;i'm sorry, excuse me... |
||||
ld179 |
||||
sec ;calculate tape ea-sa |
||||
ldy #2 |
||||
lda (tapebs),y |
||||
ldy #0 |
||||
sbc (tapebs),y |
||||
tax ;low to .x |
||||
ldy #3 |
||||
lda (tapebs),y |
||||
ldy #1 |
||||
sbc (tapebs),y |
||||
tay ;high to .y |
||||
|
||||
clc ;ea = sa + (tape ea-sa) |
||||
txa |
||||
adc memuss |
||||
sta eal |
||||
tya |
||||
adc memuss+1 |
||||
sta eah |
||||
|
||||
lda memuss ;set up starting address |
||||
sta stal |
||||
lda memuss+1 |
||||
sta stah |
||||
|
||||
jsr loding ;tell user loading |
||||
jsr rvblok ;read a variable (program) block |
||||
bcc ld180 ;all correct |
||||
lda #29 ;load error |
||||
bit verfck |
||||
bpl ld190 ;it really was |
||||
lda #28 ;it was a verify error |
||||
bne ld190 ;always |
||||
|
||||
|
||||
; subroutine to print to console: |
||||
; searching {for filename} |
||||
; |
||||
luking |
||||
lda msgflg ;supposed to print? |
||||
bpl ld115 ;...no |
||||
ldy #ms5-ms1 ;"searching" |
||||
jsr msg |
||||
lda fnlen |
||||
beq ld115 |
||||
ldy #ms6-ms1 ;"for" |
||||
jsr msg |
||||
; |
||||
; subroutine to output file name |
||||
; |
||||
outfn |
||||
ldy fnlen ;is there a name? |
||||
beq ld115 ;no...done |
||||
ldy #0 |
||||
ld110 |
||||
lda #fnadr |
||||
sta sinner |
||||
jsr kludes |
||||
jsr bsout |
||||
iny |
||||
cpy fnlen |
||||
bne ld110 |
||||
ld115 |
||||
rts |
||||
; |
||||
; subroutine to print: |
||||
; loading/verifing |
||||
; |
||||
loding |
||||
ldy #ms10-ms1 ;assume 'loading' |
||||
lda verfck ;check flag |
||||
beq ld410 ;are doing load |
||||
ldy #ms21-ms1 ;are 'verifying' |
||||
ld410 |
||||
jmp spmsg |
||||
|
||||
;end |
||||
@ -0,0 +1,30 @@
|
||||
.page |
||||
.subttl 'messages' |
||||
MS1 .BYTE CR,'I/O ERROR ',$A3 |
||||
MS5 .BYTE CR,'SEARCHING',$A0 |
||||
MS6 .BYTE 'FOR',$A0 |
||||
MS7 .BYTE CR,'PRESS PLAY ON TAP',$C5 |
||||
MS8 .BYTE 'PRESS RECORD & PLAY ON TAP',$C5 |
||||
MS10 .BYTE CR,'LOADIN',$C7 |
||||
MS11 .BYTE CR,'SAVING',$A0 |
||||
MS21 .BYTE CR,'VERIFYIN',$C7 |
||||
MS17 .BYTE CR,'FOUND',$A0 |
||||
MS18 .BYTE CR,'OK',$8D |
||||
|
||||
|
||||
;print message to screen only if |
||||
;output enabled |
||||
|
||||
spmsg bit msgflg ;printing messages? |
||||
bpl msg10 ;no... |
||||
msg lda ms1,y |
||||
php |
||||
and #$7f |
||||
jsr bsout |
||||
iny |
||||
plp |
||||
bpl msg |
||||
msg10 clc |
||||
rts |
||||
|
||||
;.end |
||||
@ -0,0 +1,27 @@
|
||||
.page |
||||
.subttl 'music' |
||||
domus |
||||
ldx #1 ;service tone generators |
||||
domus0 |
||||
lda mtimlo,x |
||||
ora mtimhi,x ;check each voices's duration counter |
||||
beq domus1 ;not set, do next |
||||
|
||||
inc mtimlo,x ;stored as 2's complement |
||||
bne domus1 |
||||
inc mtimhi,x |
||||
bne domus1 |
||||
|
||||
lda domtab,x ;timer timed out..turn off voice |
||||
and tedvoi |
||||
sta tedvoi |
||||
domus1 |
||||
dex |
||||
bpl domus0 |
||||
rts |
||||
|
||||
domtab |
||||
.byte $ef,$9f ;if voice 2, turn off 2 & 3 |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,195 @@
|
||||
.page |
||||
.subttl 'open' |
||||
;*********************************** |
||||
;* * |
||||
;* open function * |
||||
;* * |
||||
;* creates an entry in the logical * |
||||
;* files tables consisting of * |
||||
;* logical file number--la, device * |
||||
;* number--fa, and secondary cmd-- * |
||||
;* sa. * |
||||
;* * |
||||
;* a file name descriptor, fnadr & * |
||||
;* fnlen are passed to this routine* |
||||
;* * |
||||
;* on entry c=0==>normal open * |
||||
;* with file tables used * |
||||
;* ...c=1==> xmit open only * |
||||
;* * |
||||
;*********************************** |
||||
|
||||
nopen |
||||
ldx la ;check file # |
||||
|
||||
op98 |
||||
jsr lookup ;see if in table |
||||
bne op100 ;not found...o.k. |
||||
jmp error2 ;file open |
||||
|
||||
op100 |
||||
ldx ldtnd ;logical device table end |
||||
cpx #10 ;maximum # of open files |
||||
bcc op110 ;less than 10...o.k. |
||||
jmp error1 ;too many files |
||||
|
||||
op110 |
||||
inc ldtnd ;new file |
||||
lda la |
||||
sta lat,x ;store logical file # |
||||
lda sa |
||||
ora #$60 ;make sa an serial command |
||||
sta sa |
||||
sta sat,x ;store command # |
||||
lda fa |
||||
sta fat,x ;store device # |
||||
; |
||||
; perform device specific open tasks |
||||
; |
||||
beq op300 ;is keyboard...done. |
||||
cmp #3 |
||||
beq op300 ;is screen...done. |
||||
bcc op150 ;devices 1 or 2 |
||||
|
||||
jsr openi ;is on serial...open it |
||||
op300 |
||||
clc ;done |
||||
rts |
||||
|
||||
op150 |
||||
cmp #2 |
||||
bne op152 |
||||
; |
||||
; open for rs-232 |
||||
; |
||||
jsr ainit ;init |
||||
tax ;x=0 |
||||
avery |
||||
inx |
||||
beq ahere ;i think he's home |
||||
stx acia+3 ;write to control reg |
||||
cpx acia+3 ;verify control reg |
||||
beq avery ;so far, so good |
||||
jmp error5 ;verify error |
||||
|
||||
ahere |
||||
sec |
||||
ror apres ;indicate to sysm that acia is present |
||||
lda #fnadr ;set up indirect subby |
||||
sta sinner |
||||
ldy #0 |
||||
jsr kludes ;get control byte |
||||
sta acia+3 |
||||
iny |
||||
jsr kludes ;get command byte |
||||
sta acia+2 |
||||
|
||||
clc ;don't shoot. |
||||
rts |
||||
; |
||||
; open for cassette |
||||
; |
||||
op152 |
||||
lda sa |
||||
and #$f |
||||
bne op200 ;non-zero =>tape write |
||||
jsr tstply ;tell user to press play for tape read |
||||
bcs op180 ;doesn't want to play |
||||
jsr luking ;tell: searching |
||||
|
||||
lda fnlen |
||||
beq op170 ;=0=>looking for any file |
||||
jsr faf ;looking for named file |
||||
bcc op171 ;found it! |
||||
beq op180 ;stop key pressed... |
||||
op160 |
||||
jmp error4 ;file not found (.a=0 .c=1) |
||||
|
||||
op170 |
||||
jsr fah |
||||
beq op180 ;get any header |
||||
bcs op160 ;file not found |
||||
cmp #eot |
||||
beq op160 ;nothin' left |
||||
op171 |
||||
ldy #bufmax ;force a read upon first input from buffer |
||||
sty tptr |
||||
lda #bdf ;tell sysm type of cominng data |
||||
sta type |
||||
|
||||
op175 |
||||
clc ;everything's fine |
||||
op180 |
||||
rts |
||||
|
||||
|
||||
op200 |
||||
jsr tstrec ;tell: press play & record for tape write |
||||
bcs op180 |
||||
lda #bdfh |
||||
sta type |
||||
jsr tphead ;write out data block header |
||||
bcs op201 ;woops! |
||||
|
||||
lda #bdf ;!c=0 /setup type for next data block |
||||
sta type |
||||
ldy #0 |
||||
sty tptr |
||||
sty ctally |
||||
op201 |
||||
rts ;(.c=0) |
||||
|
||||
|
||||
openi |
||||
lda sa |
||||
bmi op175 ;no sa...done |
||||
|
||||
ldy fnlen |
||||
beq op175 ;no file name...done |
||||
|
||||
lda #0 ;clear the serial status |
||||
sta status |
||||
|
||||
lda fa |
||||
jsr tlistn ;device la to listen |
||||
bit status ;anybody home |
||||
bmi unp ;nope |
||||
|
||||
lda sa |
||||
ora #$f0 |
||||
jsr tsecnd |
||||
|
||||
lda status ;anybody home?...get a dev -pres? |
||||
bpl op35 ;yes...continue |
||||
|
||||
; this routine is called by other |
||||
; kernal routines which are called |
||||
; directly by os. kill return |
||||
; address to return to os. |
||||
|
||||
unp |
||||
pla |
||||
pla |
||||
jmp error5 ;device not present |
||||
|
||||
op35 |
||||
lda fnlen |
||||
beq op45 ;no name...done sequence |
||||
; |
||||
; send file name over serial |
||||
; |
||||
ldy #0 |
||||
op40 |
||||
lda #fnadr |
||||
sta sinner |
||||
jsr kludes |
||||
jsr tciout |
||||
iny |
||||
cpy fnlen |
||||
bne op40 |
||||
|
||||
op45 |
||||
jmp cunlsn ;jsr unlsn: clc: rts |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,25 @@
|
||||
.page |
||||
.subttl 'overflow' |
||||
msgs=* |
||||
msgmon=*-msgs |
||||
.BYTE CR,'MONITOR',$8D |
||||
MSGBRK=*-MSGS |
||||
.BYTE CR,'BREA',$CB |
||||
MSGREG=*-MSGS |
||||
.BYTE CR,' PC SR AC XR YR SP',CR,';',$A0 |
||||
MSGASM=*-MSGS |
||||
.BYTE 'A',$A0 |
||||
MSGVER=*-MSGS |
||||
.BYTE ' ERRO',$D2 |
||||
|
||||
msgxxx |
||||
lda msgs,x |
||||
php |
||||
and #$7f |
||||
jsr bsout |
||||
inx |
||||
plp |
||||
bpl msgxxx |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,119 @@
|
||||
.page |
||||
.subttl 'patches 02/17/84' |
||||
; ** clppat ** fixes: open4,4 <cr> cmd4 <cr> list <cr> problem |
||||
; from 'ed.1' |
||||
; |
||||
clppat |
||||
lda #cr ;pass a <return> |
||||
ldx dfltn |
||||
cpx #3 ;is input from screen? |
||||
beq clppa1 ;yes |
||||
ldx dflto |
||||
cpx #3 ;is output to the screen? |
||||
beq clppa2 ;yes |
||||
clppa1 |
||||
jsr print ;force it |
||||
clppa2 |
||||
lda #cr |
||||
jmp clp7 ;return to in-line code |
||||
|
||||
|
||||
|
||||
; ** chkpat ** fixes: allows selection between rom or ram color |
||||
; tables in 'ed.4'. |
||||
; |
||||
chkpat |
||||
lda colkey,x ;assume fetch is from ram (default) |
||||
bit colsw |
||||
bpl chkpa1 ;it is from ram |
||||
lda collum,x ;no, fetch from rom table |
||||
chkpa1 |
||||
rts |
||||
|
||||
|
||||
|
||||
; ** pick1 ** fixes: allows selection between rom or ram reads |
||||
; in the monitor. |
||||
; |
||||
pick1 |
||||
bit ramrom |
||||
bmi pick2 ;branch if ram |
||||
lda (t2),y ;fetch byte from rom (default) |
||||
rts |
||||
pick2 |
||||
lda #t2 ;use subbie to fetch from ram |
||||
sta sinner |
||||
jmp kludes |
||||
|
||||
|
||||
|
||||
; ** spkpat ** fixes: babbling speech module |
||||
; |
||||
spkpat |
||||
lda #$09 |
||||
sta $fd20 ;shut up |
||||
ora #$80 |
||||
sta $fd20 ;shut up now (texans think this way...) |
||||
jmp poll |
||||
|
||||
|
||||
|
||||
; ** sobsob, wimper ** code to download for ram fetch routine |
||||
; |
||||
sobsob |
||||
php |
||||
sei |
||||
sta romoff |
||||
wimper |
||||
lda ($00),y |
||||
sta romon |
||||
plp |
||||
rts |
||||
ugh |
||||
|
||||
|
||||
|
||||
; +++ patches for cassette |
||||
; |
||||
judt2 |
||||
lda xport |
||||
and #4 |
||||
bne supz |
||||
; else sw is down |
||||
bit lsem |
||||
bmi exitz |
||||
lda port |
||||
and #$f7 ;***patch 16mar84 tvr |
||||
sta port |
||||
exitz |
||||
.if palmod |
||||
dec palcnt ;test if 5th jiffy (pal system only) |
||||
bpl pal001 ;it's not |
||||
lda #4 |
||||
sta palcnt ;reset counter |
||||
jsr udtim ;give one extra tick to correct |
||||
pal001 |
||||
.endif |
||||
jmp udtim |
||||
supz |
||||
sta lsem ; ac.7=0 from jsr castst |
||||
jsr motoff |
||||
jmp exitz |
||||
|
||||
|
||||
|
||||
ptchdd ;84.2.13 |
||||
inx ;x=0 |
||||
stx drvb2-48 |
||||
stx tedrva-48 |
||||
|
||||
lda #$80 |
||||
;+++patch 2mar84 - reset white noise generator |
||||
sta ted+17 |
||||
|
||||
rts ;x must =0 on rts !!! ****** |
||||
|
||||
|
||||
;**patch 16mar84 fix to eliminate cassette/serial bus interference |
||||
;end |
||||
|
||||
@ -0,0 +1,206 @@
|
||||
.page |
||||
.subttl 'rs232' |
||||
; interrupt handler |
||||
; |
||||
aout |
||||
lda astat |
||||
and #$10 |
||||
beq txnmt ; tx reg is busy |
||||
lda xport ;hardware xoff? |
||||
and #$02 |
||||
beq txnmt ;yes! |
||||
ldx #0 ; preload |
||||
bit soutfg ; got a system char to send |
||||
bpl nosysc ; nope |
||||
|
||||
; yep, send sys char |
||||
|
||||
lda soutq ; get sys char |
||||
stx soutfg ; reset flag |
||||
jmp aoutc ; send it |
||||
|
||||
nosysc |
||||
bit uoutfg ; have a user char to send? |
||||
bpl txnmt ; nope |
||||
|
||||
; yes, send user char |
||||
|
||||
bit alstop ; are we ~s'ed? |
||||
bmi txnmt ; yep... |
||||
lda uoutq ; else...get char |
||||
stx uoutfg ; reset flag |
||||
|
||||
; send some char |
||||
|
||||
aoutc |
||||
sta acia |
||||
|
||||
lda astat ; update status |
||||
and #$ef |
||||
sta astat |
||||
txnmt ; just passing thru exit |
||||
rts |
||||
|
||||
|
||||
ain |
||||
lda astat |
||||
and #$8 |
||||
beq rxfull ; no char has been received |
||||
lda astat ; got one...reset stat bit |
||||
and #$f7 |
||||
sta astat |
||||
lda acia |
||||
beq notacc |
||||
|
||||
; it's a null, don't let thru for x-disable |
||||
|
||||
sta aintmp ; save char |
||||
cmp xon ; is it a ~q |
||||
bne trycs ; nope |
||||
|
||||
; got a ~q |
||||
|
||||
lda #0 |
||||
sta alstop ; tell local xmit to go |
||||
beq rxfull ; !bra, what character? |
||||
|
||||
trycs |
||||
cmp xoff ; is it a ~s |
||||
bne notacc ; nope |
||||
|
||||
; got a ~s |
||||
|
||||
lda #$ff |
||||
sta alstop ; tell local xmit to stop |
||||
bne rxfull ; !bra, i didn't see that... |
||||
|
||||
notacc |
||||
lda inqcnt |
||||
cmp #inpqln-1 ; is queue full |
||||
beq rxfull ; yep |
||||
cmp #hiwatr ; high water mark |
||||
bne nohw ; nope |
||||
|
||||
; hit high water mark, tell sender to stop |
||||
|
||||
lda xoff : x-sw is off |
||||
beq nohw |
||||
sta soutq ; ~s |
||||
lda #$ff |
||||
sta soutfg ; flag it present |
||||
sta arstop ; flag remote stopped |
||||
|
||||
nohw |
||||
; not full, insert char |
||||
ldx inqfpt ; do: inqfpt <- inqfpt+1 mod 64 |
||||
inx |
||||
txa |
||||
and #$3f |
||||
sta inqfpt |
||||
tax |
||||
lda aintmp ; get char to insert |
||||
sta inpque,x ; insert it |
||||
inc inqcnt ; another drop in the bucket |
||||
rxfull ; error exit |
||||
rts ; all ok |
||||
|
||||
|
||||
|
||||
; get a char out of the input buffer |
||||
|
||||
agetch |
||||
lda inqcnt ; got any? |
||||
beq bukbuk ; nope, inqcnt=0 then return a $00 |
||||
|
||||
; not empty |
||||
|
||||
php ; save int enb bit |
||||
|
||||
; { mut-ex begin |
||||
|
||||
sei |
||||
ldx inqrpt ; do: inqrpt <- inqrpt+1 mod 64 |
||||
inx |
||||
txa |
||||
and #$3f |
||||
sta inqrpt |
||||
plp |
||||
|
||||
; mut-ex end } |
||||
|
||||
tax |
||||
lda inpque,x ; get char from queue |
||||
pha ; save it |
||||
dec inqcnt ; one less |
||||
lda inqcnt |
||||
cmp #lowatr ; low watermark? |
||||
bne notlow ; nope |
||||
|
||||
; hit low water mark |
||||
|
||||
bit arstop ; is remote ~s'ed |
||||
bpl notlow ; nope, then don't ~q |
||||
lda xon |
||||
beq notlow ; x-sw is off |
||||
sta soutq ; send a ~q |
||||
sec |
||||
ror soutfg ; flag it |
||||
lsr arstop ; remote now not ~s'ed (msb cleared) |
||||
|
||||
|
||||
aready ; entry for chkin & chkout |
||||
bit apres ; is he there? |
||||
bpl anrdy ; no, don't even bother to look |
||||
bukbuk ; i'll just be jumping in here |
||||
pha |
||||
notlow ; here too |
||||
lda astat ; get status definition |
||||
and #$4f ; use bits 0..3, and 6 |
||||
eor #$40 ; invert dsr |
||||
sta status |
||||
pla |
||||
anrdy |
||||
clc |
||||
rts |
||||
|
||||
|
||||
; put a character in the output queue |
||||
|
||||
aputch |
||||
bit uoutfg |
||||
bmi aputch ; busy wait for buffer empty |
||||
sta uoutq ; now, put it in the buf |
||||
sec ; flag buf as full |
||||
ror uoutfg |
||||
jmp bukbuk ; update status exit |
||||
|
||||
|
||||
; initialize rs-232 variables & pointers |
||||
; reset to 0: |
||||
; uoutfg - user out buf is empty |
||||
; inqfpt - make front=rear |
||||
; inqrpt |
||||
; inqcnt - no chars in queue |
||||
; soutfg - sysm out buf is empty |
||||
; alstop - we're not ~s'ed |
||||
; arstop - i'll assume remote isn't either |
||||
; apres - acia assumed not to be present yet |
||||
; xon - x-on is deselected |
||||
; xoff - x-off is deselected |
||||
|
||||
|
||||
ainit |
||||
lda #0 |
||||
ldx #11 |
||||
gerber |
||||
sta uoutq,x ; clear above flags (and some others) |
||||
dex |
||||
bpl gerber |
||||
|
||||
sta acia+1 ; programmed reset of the acia |
||||
sta xon ; deselect handshake protocol |
||||
sta xoff |
||||
rts |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,154 @@
|
||||
.page |
||||
.subttl 'save' |
||||
;*********************************** |
||||
;* save * |
||||
;* * |
||||
;* fa: 0= invalid * |
||||
;* 1= cassette * |
||||
;* 2= invalid * |
||||
;* 4-31= serial device * |
||||
;* * |
||||
;* start of save in indirect @.a * |
||||
;* end of save is @ .x, .y * |
||||
;* * |
||||
;*********************************** |
||||
|
||||
savesp |
||||
stx eal |
||||
sty eah |
||||
tax ;set up start |
||||
lda $00,x |
||||
sta stal |
||||
lda $01,x |
||||
sta stah |
||||
|
||||
save |
||||
jmp (isave) |
||||
nsave |
||||
lda fa ;***monitor entry |
||||
bne sv20 |
||||
|
||||
sv10 |
||||
jmp error9 ;bad device # eg: screen or kbd |
||||
|
||||
sv20 |
||||
cmp #3 |
||||
beq sv10 |
||||
cmp #2 |
||||
beq sv10 ;beneath my dignity to save to rs232 |
||||
bcc stape ;save tape |
||||
|
||||
wombat |
||||
lda #$61 |
||||
sta sa |
||||
ldy fnlen |
||||
bne sv25 |
||||
jmp error8 ;missing file name |
||||
; |
||||
; choose the serial bus |
||||
; |
||||
sv25 |
||||
jsr openi |
||||
jsr saving |
||||
lda fa |
||||
jsr tlistn ;%% |
||||
lda sa |
||||
jsr tsecnd ;%% |
||||
ldy #0 |
||||
lda stah |
||||
sta sah |
||||
lda stal |
||||
sta sal |
||||
lda sal |
||||
jsr tciout ;%% |
||||
lda sah |
||||
jsr tciout ;%% |
||||
sv30 |
||||
sec ;compare start to end |
||||
lda sal |
||||
sbc eal |
||||
lda sah |
||||
sbc eah |
||||
bcs sv50 ;have reached end |
||||
lda #sal |
||||
sta sinner |
||||
jsr kludes |
||||
jsr tciout ;%% |
||||
jsr stop |
||||
bne sv40 |
||||
|
||||
break |
||||
jsr clsei |
||||
lda #0 |
||||
sec |
||||
rts |
||||
|
||||
sv40 |
||||
inc sal ;increment current address |
||||
bne sv30 |
||||
inc sal+1 |
||||
bne sv30 |
||||
sv50 |
||||
jsr tunlsn ;%% |
||||
|
||||
clsei |
||||
bit sa |
||||
bmi clsei2 |
||||
lda fa |
||||
jsr tlistn |
||||
lda sa |
||||
and #$ef |
||||
ora #$e0 |
||||
jsr tsecnd |
||||
|
||||
cunlsn |
||||
jsr tunlsn ;entry for openi |
||||
|
||||
clsei2 |
||||
clc |
||||
rts |
||||
|
||||
|
||||
; subroutine to output: |
||||
; 'saving <file name>' |
||||
; |
||||
saving |
||||
lda msgflg |
||||
bpl svrts ;no print |
||||
ldy #ms11-ms1 ;'saving' |
||||
jsr msg |
||||
jmp outfn ;<file name> |
||||
; |
||||
; save to tape |
||||
; |
||||
stape |
||||
jsr tstrec ;tell play&rec |
||||
bcs sabort ;stop key pressed |
||||
jsr saving ;tell user |
||||
ldx #plf |
||||
lda sa |
||||
and #1 |
||||
bne svs ;1->plf, 0->bdf |
||||
ldx #blf |
||||
svs |
||||
stx type |
||||
jsr tphead ;write tape header |
||||
bcs sabort |
||||
lda #0 |
||||
sta type |
||||
jsr wvblok ;write actual tape data |
||||
bcs sabort |
||||
lda sa |
||||
and #2 ;write eot? |
||||
beq sgex ;no |
||||
jsr wreot ;yep |
||||
bcs sabort |
||||
sgex |
||||
clc ;good exit |
||||
sabort ;bad exit |
||||
lda #0 ;break error |
||||
svrts |
||||
rts |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,396 @@
|
||||
.page |
||||
.subttl 'serial' |
||||
; command serial bus device to talk |
||||
; |
||||
talk |
||||
ora #$40 ;make a talk adr |
||||
.byte $2c |
||||
|
||||
|
||||
; command serial bus device to listen |
||||
; |
||||
listn |
||||
ora #$20 ;make a listen adr |
||||
|
||||
list1 |
||||
pha |
||||
bit c3p0 ;character left in buf? |
||||
bpl list2 ;no... |
||||
|
||||
; send buffered character |
||||
; |
||||
sec ;initialize eoi flag |
||||
ror r2d2 |
||||
jsr isour ;send last character |
||||
lsr c3p0 ;buffer clear flag |
||||
lsr r2d2 ;clear eoi flag |
||||
|
||||
list2 |
||||
pla ;talk/listen address |
||||
sta bsour |
||||
sei |
||||
jsr datahi |
||||
jsr clklo |
||||
|
||||
list5 |
||||
lda port ;assert attention |
||||
ora #%00000100 |
||||
sta port |
||||
|
||||
|
||||
isoura |
||||
sei |
||||
jsr clklo ;set clock line low |
||||
jsr datahi |
||||
jsr w1ms ;delay 1 ms |
||||
|
||||
|
||||
isour |
||||
sei ;no irq's allowed |
||||
jsr datahi ;make sure data is released |
||||
jsr debpia ;data should be low |
||||
bcs nodev ;%% |
||||
jsr clkhi ;clock line high |
||||
bit r2d2 ;eoi flag test |
||||
bpl noeoi |
||||
|
||||
; do the eoi |
||||
; |
||||
isr02 |
||||
jsr debpia ;wait for data to go high |
||||
bcc isr02 ;%% |
||||
|
||||
isr03 |
||||
lda port ;wait for data to go low |
||||
cmp port |
||||
bne isr03 |
||||
asl a |
||||
bcs isr03 |
||||
|
||||
noeoi |
||||
jsr debpia ;wait for data high |
||||
bcc noeoi ;%% |
||||
jsr clklo ;set clock low |
||||
|
||||
; set to send data |
||||
; |
||||
lda #$08 ;count 8 bits |
||||
sta dcount |
||||
isr01 |
||||
jsr debpia ;debounce the bus & shift data-in bit to carry bit |
||||
bcc frmerr ;...if data=low then, frame error |
||||
|
||||
ror bsour ;next bit into carry |
||||
bcs isrhi |
||||
jsr datalo |
||||
bne isrclk |
||||
isrhi |
||||
jsr datahi |
||||
isrclk |
||||
jsr dilly |
||||
jsr clkhi ;clock hi |
||||
jsr dilly ;mod for ted 1.7 mhz clk |
||||
lda port |
||||
and #%11111110 ;data high |
||||
ora #%00000010 ;clock low |
||||
sta port |
||||
dec dcount |
||||
bne isr01 |
||||
|
||||
isr04 |
||||
txa |
||||
pha |
||||
ldx #120 |
||||
isr04a |
||||
lda port |
||||
cmp port |
||||
bne isr04a |
||||
asl a |
||||
bcc isr04b |
||||
dex |
||||
bne isr04a |
||||
pla |
||||
tax |
||||
bcs frmerr ;always |
||||
|
||||
isr04b |
||||
pla |
||||
tax |
||||
cli ;irq's ok now |
||||
rts |
||||
|
||||
nodev |
||||
lda #$80 |
||||
jmp csberr |
||||
frmerr |
||||
lda #$03 ;framing error |
||||
csberr |
||||
jsr udst ;commodore serial bus error entry |
||||
cli ;irq's were off...turn on |
||||
clc ;make sure no kernal error returned |
||||
bcc dlabye ;turn atn off ,release all lines |
||||
|
||||
|
||||
; send secondary address after listen |
||||
; |
||||
secnd |
||||
sta bsour ;buffer character |
||||
jsr isoura ;send it |
||||
|
||||
|
||||
; release attention after listen |
||||
; |
||||
scatn |
||||
lda port |
||||
and #%11111011 |
||||
sta port ;release attention |
||||
rts |
||||
|
||||
|
||||
; talk second address |
||||
; |
||||
tksa |
||||
sta bsour ;buffer character |
||||
jsr isoura ;send second addr |
||||
bit status ;sa sent ok? |
||||
bmi dlabye ;no, get out! |
||||
|
||||
|
||||
tkatn |
||||
sei ;shift over to listener. no irq's |
||||
jsr datalo ;data line low |
||||
jsr scatn |
||||
jsr clkhi ;clock line high jsr/rts |
||||
tkatn1 |
||||
bit port ;wait for clock to go low ( use bit ( timing shit )) |
||||
bvs tkatn1 ;%% |
||||
cli ;irq's okay now |
||||
rts |
||||
.byte $ff ; free |
||||
|
||||
|
||||
; buffered output to serial bus |
||||
; |
||||
ciout |
||||
bit c3p0 ;buffered char? |
||||
bmi ci2 ;yes...send last |
||||
|
||||
sec ;no... |
||||
ror c3p0 ;set buffered char flag |
||||
bne ci4 ;branch always |
||||
|
||||
ci2 |
||||
pha ;save current char |
||||
jsr isour ;send last char |
||||
pla ;restore current char |
||||
ci4 |
||||
sta bsour ;buffer current char |
||||
clc ;carry-good exit |
||||
rts |
||||
|
||||
|
||||
; send untalk command on serial bus |
||||
; |
||||
untlk |
||||
sei |
||||
jsr clklo |
||||
lda port ;pull atn |
||||
ora #%00000100 |
||||
sta port |
||||
lda #$5f ;untalk command |
||||
bne untlk2 ;!bra |
||||
|
||||
|
||||
; send unlisten command on serial bus |
||||
; |
||||
unlsn |
||||
lda #$3f ;unlisten command |
||||
untlk2 |
||||
jsr list1 ;send it |
||||
|
||||
; release all lines |
||||
; |
||||
dlabye |
||||
jsr scatn ;always release atn |
||||
|
||||
; delay then release clock and data |
||||
; |
||||
dladlh |
||||
txa ;delay at least 60 us (max=120us w. 2x ted clock) |
||||
ldx #20 |
||||
dlad00 |
||||
dex |
||||
bne dlad00 |
||||
tax |
||||
jsr clkhi |
||||
jmp datahi |
||||
|
||||
|
||||
; input a byte from serial bus |
||||
; |
||||
acptr |
||||
sei ;no irq allowed |
||||
lda #$00 ;set eoi/error flag |
||||
sta dcount |
||||
jsr clkhi ;make sure clock line is released |
||||
|
||||
acp00a |
||||
txa |
||||
pha |
||||
acpz |
||||
jsr debpia |
||||
bpl acpz |
||||
eoiacp |
||||
ldx #32 |
||||
jsr datahi |
||||
acpy |
||||
lda port |
||||
cmp port |
||||
bne acpy |
||||
asl a |
||||
bpl acp01 |
||||
dex |
||||
bne acpy |
||||
lda dcount |
||||
beq acp00c |
||||
pla |
||||
tax |
||||
lda #2 |
||||
jmp csberr |
||||
|
||||
|
||||
; timer ran out do an eoi thing |
||||
; |
||||
acp00c |
||||
jsr datalo |
||||
ldx #64 |
||||
hohum |
||||
dex |
||||
bne hohum |
||||
lda #$40 |
||||
jsr udst |
||||
inc dcount |
||||
bne eoiacp |
||||
|
||||
; do the byte transfer from serial bus |
||||
; |
||||
acp01 |
||||
ldx #$8 ;set up counter |
||||
|
||||
acp03 |
||||
lda port ;%% wait for clk hi |
||||
asl a ;shift clk to d7, data into carry |
||||
bpl acp03 ;clock still low... |
||||
|
||||
ror bsour1 ;rotate data bit in |
||||
|
||||
acp03a |
||||
lda port ;debounce, then wait for clk low |
||||
cmp port |
||||
bne acp03a |
||||
asl a |
||||
bmi acp03a ;clk still hi...wait |
||||
dex ;another bit ??? |
||||
bne acp03 ;more bits..... |
||||
stx dcount ;update dcount |
||||
pla ;restore x |
||||
tax ;from stack |
||||
|
||||
; ...exit... |
||||
; |
||||
jsr datalo ;set data low to do frame handshake |
||||
lda #%01000000 |
||||
bit status ;check for eoi |
||||
bvc acp04 ;none... |
||||
|
||||
jsr dladlh ;delay then set data high |
||||
|
||||
acp04 |
||||
lda bsour1 ;return constructed byte in acc |
||||
cli ;irq is ok now |
||||
clc ;good exit |
||||
rts |
||||
|
||||
clkhi |
||||
lda port ;set clock line high (inverted) |
||||
and #%11111101 |
||||
sta port |
||||
rts |
||||
|
||||
clklo |
||||
lda port ;set clock line low (inverted) |
||||
ora #%00000010 |
||||
sta port |
||||
rts |
||||
|
||||
datahi |
||||
lda port ;set data line high (inverted) |
||||
and #%11111110 |
||||
sta port |
||||
rts |
||||
|
||||
datalo |
||||
lda port ;set data line low (inverted) |
||||
ora #%00000001 |
||||
sta port |
||||
rts |
||||
|
||||
debpia |
||||
lda port ;debounce the pia |
||||
cmp port |
||||
bne debpia |
||||
asl a ;%% data bit->carry, clock bit->d7 |
||||
rts |
||||
|
||||
w1ms |
||||
jsr twait1 ;delay 1ms using t2 |
||||
lda #$10 |
||||
bzywt |
||||
bit tedirq |
||||
beq bzywt ;wait until t2 times out |
||||
sta tedirq ;reset t2 interrupt |
||||
rts |
||||
|
||||
w16ms |
||||
jsr twait3 ;delay 16ms using t2 |
||||
lda #$10 |
||||
bzywt2 |
||||
bit tedirq |
||||
beq bzywt2 ;wait until t2 times out |
||||
sta tedirq ;reset t2 interrupt |
||||
rts |
||||
|
||||
|
||||
; timer timeout setup routine for 16ms, 1ms & 256us deltas |
||||
; |
||||
twait1 |
||||
lda #$04 ;entry for 1ms time delay |
||||
bne stime |
||||
twait3 |
||||
lda #$40 ;entry for 16ms time delay |
||||
stime |
||||
php ;to save int enb bit |
||||
pha ;save high time val |
||||
sei ;can't be interrupted here |
||||
lda #0 |
||||
sta timr2l |
||||
pla |
||||
sta timr2h ;start timer running |
||||
lda #$10 |
||||
sta tedirq ;clear any prior flag |
||||
plp ;restore int enb bit |
||||
rts |
||||
|
||||
|
||||
; dilly dally for the data to setup to clock pos tran |
||||
; |
||||
dilly |
||||
txa |
||||
ldx #5 |
||||
dally |
||||
dex |
||||
bne dally |
||||
tax |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,82 @@
|
||||
.page |
||||
.subttl 'split 01/24/84' |
||||
;********************************************************** |
||||
; |
||||
; split - service split screen |
||||
; |
||||
; test for 3 cases: |
||||
; 1) raster before line 20 (wait for 20, then flip if ss) |
||||
; 2) after 20, but before end of screen (exit) |
||||
; 3) after end of screen ( flip to graphics) |
||||
; |
||||
;********************************************************** |
||||
|
||||
srvspl |
||||
lda ted+28 ;check bit 8 of raster value- if set, def. eos |
||||
and #1 |
||||
bne spls55 ;end of screen |
||||
lda ted+29 ;now test lower 8 bits of raster value |
||||
cmp #$a3 ;is this line 20 ($a1) or end of screen ($cc) |
||||
bcs spls50 ;it's past line 20 |
||||
|
||||
bit graphm ;is current mode split screen? |
||||
bvc splrts ;no, we have no need for this interrupt |
||||
|
||||
lda #%00001000 ;point vm base at real vm area ($0800) |
||||
sta ted+20 |
||||
|
||||
lda ted+6 ;set up to display text screen |
||||
and #%11011111 ;clear bmm |
||||
tay ;wait... |
||||
|
||||
lda ted+7 |
||||
and #%11101111 ;clear mcm |
||||
tax ;wait... |
||||
|
||||
lda ted+18 ;set 'fetch from rom' bit on. |
||||
ora ffrmsk |
||||
pha ;wait... |
||||
|
||||
spls30 ;wait for edge of visible screen |
||||
lda ted+29 |
||||
cmp #$a3 |
||||
bcc spls30 |
||||
|
||||
pla |
||||
sta ted+18 |
||||
sty ted+6 |
||||
stx ted+7 |
||||
rts |
||||
|
||||
|
||||
|
||||
spls50 |
||||
cmp #$cc ;is this the end of screen? |
||||
bcc splrts ;not yet |
||||
spls55 |
||||
ldx graphm ;what is current mode? |
||||
beq splrts ;branch if text |
||||
bpl spls60 ;branch if not mcm |
||||
|
||||
lda ted+7 |
||||
ora #%00010000 ;set mcm |
||||
sta ted+7 |
||||
|
||||
spls60 |
||||
lda ted+6 |
||||
ora #%00100000 ;set bmm |
||||
sta ted+6 |
||||
|
||||
lda ted+18 ;turn off 'fetch from rom' bit |
||||
and #%11111011 |
||||
sta ted+18 |
||||
|
||||
lda vmbmsk ;point vmbase at bit map vm |
||||
sta ted+20 |
||||
splrts |
||||
rts |
||||
|
||||
.byte $ea,$ea,$ea,$ea,$ea,$ea,$ea,$ea |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,890 @@
|
||||
.page |
||||
.subttl 'tapred 01/17/84' |
||||
; *** tape read routines *** |
||||
; |
||||
; primitives first... |
||||
; |
||||
; read a dipole from tape |
||||
; |
||||
; if c=1 then error |
||||
; else if v=1 then short |
||||
; else if n=0 then long |
||||
; else word |
||||
; end |
||||
; end |
||||
; end |
||||
; n : v |
||||
; local parms... ----- |
||||
|
||||
tshrtd .byte $40 ; token for a short 0 : 1 |
||||
tlongd .byte $00 ; and a long 0 : 0 |
||||
twordd .byte $80 ; and word dipole 1 : 0 |
||||
|
||||
|
||||
; trigger on negative edge (beginning) of dipole |
||||
; |
||||
rddipl |
||||
ldx dsamp1 ; setup x,y with 1st sample point |
||||
ldy dsamp1+1 |
||||
badeg1 |
||||
lda dsamp2+1 ; put 2nd samp value on stack in reverse order |
||||
pha |
||||
lda dsamp2 |
||||
pha |
||||
|
||||
lda #$10 |
||||
rwtl ; wait till rd line is high |
||||
bit port |
||||
beq rwtl ; !ls! |
||||
|
||||
rwth ;it's high...now wait till it's low |
||||
bit port |
||||
bne rwth ; caught the edge |
||||
|
||||
stx timr2l |
||||
sty timr2h |
||||
|
||||
; go! ...ta |
||||
|
||||
pla ;go! ...ta |
||||
sta timr3l |
||||
pla |
||||
sta timr3h ;go! ...tb |
||||
|
||||
; clear timer flags |
||||
|
||||
lda #$50 ; clr ta,tb |
||||
sta tedirq |
||||
|
||||
; um...check that edge again |
||||
|
||||
casdb1 |
||||
lda port |
||||
cmp port |
||||
bne casdb1 ; something is going on here... |
||||
and #$10 ; a look at that edge again |
||||
bne badeg1 ; woa! got a bad edge trigger !ls! |
||||
|
||||
; must have been a valid edge |
||||
; |
||||
; do stop key check here |
||||
|
||||
jsr balout |
||||
lda #$10 |
||||
wata ; wait for ta to timeout |
||||
bit port ; kuldge, kludge, kludge !!! <<><>> |
||||
bne rshort ; kuldge, kludge, kludge !!! <<><>> |
||||
bit tedirq |
||||
beq wata |
||||
|
||||
; now do the dipole sample #1 |
||||
|
||||
casdb2 |
||||
lda port |
||||
cmp port |
||||
bne casdb2 |
||||
and #$10 |
||||
bne rshort ; shorts anyone? |
||||
|
||||
; perhaps a long or a word? |
||||
|
||||
lda #$40 |
||||
watb |
||||
bit tedirq |
||||
beq watb |
||||
|
||||
; wait for tb to timeout |
||||
; now do the dipole sample #2 |
||||
|
||||
casdb3 |
||||
lda port |
||||
cmp port |
||||
bne casdb3 |
||||
and #$10 |
||||
bne rlong ; looks like a long from here !ls! |
||||
; or could it be a word? |
||||
lda zcell |
||||
sta timr2l |
||||
lda zcell+1 |
||||
sta timr2h |
||||
; go! z-cell check |
||||
; clear ta flag |
||||
lda #$10 |
||||
sta tedirq ; verify +180 half of word dipole |
||||
lda #$10 |
||||
wata2 |
||||
bit tedirq |
||||
beq wata2 ; check z-cell is low |
||||
casdb4 |
||||
lda port |
||||
cmp port |
||||
bne casdb4 |
||||
and #$10 |
||||
beq rderr1 ; !ls! |
||||
bit twordd ; got a word dipole |
||||
bmi dipok ; !bra |
||||
|
||||
rshort |
||||
bit tshrtd ; got a short |
||||
bvs dipok ; !bra |
||||
|
||||
rlong |
||||
bit tlongd ; got a long |
||||
|
||||
dipok |
||||
clc ; everything's fine |
||||
rts |
||||
|
||||
rderr1 |
||||
sec ; i'm confused |
||||
rts |
||||
|
||||
|
||||
|
||||
; read a bit |
||||
; emulate a simple deterministic finite automaton |
||||
|
||||
tzerob .byte $40 ; zero bit |
||||
toneb .byte $00 ; one bit |
||||
twordm .byte $80 ; word marker |
||||
|
||||
|
||||
; bool cond equ d(t) d(f) |
||||
; --------------------------------- |
||||
; c=1=> error ::: bcs bcc |
||||
; v=1=> short ::: bvs bvc |
||||
; (n=0)&(v=0)=> long ::: bpl bmi |
||||
; (n=1)&(v=0)=> word ::: bmi bpl |
||||
|
||||
rdbit |
||||
s0 |
||||
jsr rddipl |
||||
bcs s8 |
||||
bvs s3 |
||||
bpl s1 |
||||
bmi s6 |
||||
s1 ; d(c,l,w)=s10 |
||||
jsr rddipl |
||||
bcs s8 |
||||
bvs s2 |
||||
bvc s8 |
||||
s2 ; final state {1} |
||||
bit toneb |
||||
clc |
||||
rts |
||||
s3 |
||||
jsr rddipl |
||||
bvs s4 |
||||
bpl s5 |
||||
bmi s8 |
||||
s4 |
||||
jsr rddipl |
||||
bcs s8 |
||||
bvs s4 |
||||
bpl s8 |
||||
bmi s6 |
||||
s5 ; final state {0} |
||||
bit tzerob |
||||
clc |
||||
rts |
||||
s6 |
||||
jsr rddipl |
||||
bcs s8 |
||||
bvs s8 |
||||
bpl s7 |
||||
bmi s8 |
||||
s7 ; final state {w} |
||||
bit twordm |
||||
clc |
||||
rts |
||||
s8 ; final state {error} |
||||
sec |
||||
rts |
||||
|
||||
|
||||
|
||||
; sync on a word marker |
||||
; ...attempt to do a fixed # of times as defined by value passed |
||||
; in accumulator and report failure when it occurs. |
||||
|
||||
wsync |
||||
tsx ; mark stack |
||||
stx drecov |
||||
|
||||
clc |
||||
ror enext ; no propagation of errors |
||||
cli ; enable interrupts |
||||
|
||||
wserr |
||||
jsr rdbit |
||||
bcs wserr ; a dipole error |
||||
bvs wserr ; a zero |
||||
bpl wserr ; a one |
||||
; else got a wm! |
||||
jsr setd1 ; setup t1 for delta 1 |
||||
clc |
||||
rts |
||||
|
||||
|
||||
|
||||
; read a byte from tape into (tpbyte) |
||||
; c=0=>ok, (c=1)&(a=1)=>parity error, (c=1)&(a=2)=> timing error |
||||
; |
||||
rdbyte ; look for a wm, then read a byte |
||||
bit enext ; a carry over error? |
||||
bmi rdbite ; yep |
||||
|
||||
jsr wsync |
||||
bcs rdbite ; ok, well |
||||
|
||||
rdbytd ; read a byte directly, don't look for a wm... |
||||
lda #1 |
||||
sta parity |
||||
|
||||
ldx #8 ; init counter |
||||
stx rdbits |
||||
|
||||
sec |
||||
ror enext ; assume error propagate |
||||
|
||||
rdbylp |
||||
jsr rdbit |
||||
bcs rdbite ; read bit in error |
||||
bvs rdzero ; read a 0 |
||||
bpl rdone ; read a 1 |
||||
bmi rdbite ; got a wm! |
||||
|
||||
rdzero |
||||
clc |
||||
ror tpbyte ; shift a 0 into tpbyte |
||||
inc parity |
||||
dec rdbits |
||||
bne rdbylp ; more bits |
||||
beq rdpary ; no more, check parity |
||||
|
||||
rdone |
||||
sec |
||||
ror tpbyte ; shift a 1 into tpbyte |
||||
dec rdbits |
||||
bne rdbylp ; more bits |
||||
; else do parity |
||||
rdpary |
||||
jsr rdbit |
||||
bcs rdbite ; bad bit |
||||
bvs pzero ; parbit=0 |
||||
bpl pone ; parbit=1 |
||||
bmi rdbite ; bad bit |
||||
|
||||
pzero |
||||
lda parity |
||||
and #1 |
||||
bne rdbite ; parity should be a 0 but its not! |
||||
beq rbytok |
||||
|
||||
pone |
||||
lda parity |
||||
and #1 |
||||
beq rdbite ; parity should be a 1 but its not! |
||||
; else ok... |
||||
rbytok |
||||
clc ; good exit |
||||
bcc mork |
||||
rdbite ; error exit |
||||
sec |
||||
mork |
||||
sei |
||||
php ; save status |
||||
clc |
||||
ror enext ; no next error |
||||
plp ; restore status |
||||
rts |
||||
|
||||
|
||||
; ### read first elemental tape block ### |
||||
; assume counter & pointer are already specified |
||||
|
||||
rtblok |
||||
tsx ; save stack mark |
||||
stx srecov |
||||
|
||||
lda verfck ; fix verify flag |
||||
beq fload ; a load =0, leave alone |
||||
sec ; a verify== msb=1 |
||||
ror verfck |
||||
fload |
||||
jsr moton ; roll 'em |
||||
jsr faster |
||||
|
||||
lda trsave ; get counter & pointer values for 1st pass |
||||
sta tapebs |
||||
lda trsave+1 |
||||
sta tapebs+1 |
||||
lda trsave+2 |
||||
sta rdcnt |
||||
lda trsave+3 |
||||
sta rdcnt+1 |
||||
|
||||
jsr ldsync ; sync on first leader |
||||
|
||||
ldy #0 ; init errlist, #errors, & checksum |
||||
sty errsp |
||||
sty fperrs |
||||
sty chksum |
||||
sty errsum |
||||
sty type ; !assume no type initially |
||||
|
||||
lda #tapebs ; set up kludes in case of verify |
||||
sta sinner |
||||
|
||||
bit typenb ; does a type exist in this block? |
||||
bpl rtl1 ; no |
||||
|
||||
jsr rdbyte |
||||
bcs fpterr ; first pass type error |
||||
lda tpbyte |
||||
sta type ; type is ok |
||||
eor chksum ; !type is included in checksum |
||||
sta chksum |
||||
jmp rtl1 ; continue with data |
||||
fpterr |
||||
sec |
||||
ror type ; set msb of type to=1=>error |
||||
|
||||
rtl1 |
||||
jsr rdbyte ; read a byte from the block |
||||
bcs rerrfb ; first eblock read error |
||||
; else ok |
||||
ldy #0 ; read a byte from tape to tpbyte |
||||
jsr kludes ; acc <= byte in memory at desired location |
||||
nop |
||||
bit verfck ; if we are doing a load |
||||
bmi rtl111 |
||||
lda tpbyte ; acc <= byte from tape |
||||
rtl111 |
||||
cmp tpbyte ; if acc <> byte from tape |
||||
bne rerrfb ; go execute code for error! |
||||
|
||||
|
||||
fpload |
||||
sta (tapebs),y ;stash byte |
||||
|
||||
mc6809 |
||||
eor chksum ; update checksum |
||||
sta chksum |
||||
jmp rincfp |
||||
|
||||
rerrfb ; *** read error |
||||
ldy errsp |
||||
cpy #estksz |
||||
bcs errovf ; bra if errsp>=estksz |
||||
lda tapebs ; put address in table |
||||
sta estakl,y |
||||
lda tapebs+1 |
||||
sta estakh,y |
||||
inc errsp ; another entry |
||||
inc errsum ; another error |
||||
jmp rincfp |
||||
|
||||
errovf ; error table overflow |
||||
lda #$ff |
||||
sta errsp |
||||
|
||||
; special case of ptr, simulate errors>>>30 |
||||
|
||||
rincfp |
||||
inc tapebs |
||||
bne incnt1 |
||||
inc tapebs+1 |
||||
incnt1 |
||||
inc rdcnt |
||||
bne rtl1 |
||||
inc rdcnt+1 |
||||
bne rtl1 ; done with first eblock |
||||
|
||||
lda errsp ; errsp=>fperrs on entry to 2nd pass |
||||
sta fperrs |
||||
jsr rdbyte ; get chksum |
||||
lda fperrs |
||||
bne errfp ; we have some fp errors |
||||
|
||||
; else no errors detected, test checksum |
||||
|
||||
lda tpbyte ; check checksum |
||||
cmp chksum |
||||
bne ckerr ; branch if bad; else good |
||||
errfp |
||||
jmp rtebk2 ; no checksum error & 0<=errors<=30 |
||||
|
||||
ckerr |
||||
lda pass ; first eblock fatal, but was this the second pass? |
||||
bmi rtebk2 ; no, so try to read 2nd pass |
||||
jmp reberr ; read fatal error exit #1 |
||||
|
||||
|
||||
; ### read elemental tape block for second pass ### |
||||
; |
||||
rtebk2 |
||||
lda pass |
||||
bmi wasfp ; that was the fp |
||||
lda fperrs ; was 2nd pass, any errors? |
||||
beq nerrfp ; nope |
||||
jmp reberr ; yep, read fatal error exit #2 |
||||
nerrfp |
||||
jmp rebgd ; good exit |
||||
|
||||
wasfp ; have read fp & 0<=errors<=30 |
||||
lda #0 |
||||
sta errsp ; reset error pointer |
||||
sta chksum |
||||
|
||||
lda trsave ; restore pointers & counters |
||||
sta tapebs |
||||
lda trsave+1 |
||||
sta tapebs+1 |
||||
lda trsave+2 |
||||
sta rdcnt |
||||
lda trsave+3 |
||||
sta rdcnt+1 |
||||
|
||||
; clc ; tell no servo calc |
||||
jsr ldsync ; sync on second block hopefuly |
||||
|
||||
bit typenb ; is there a type? |
||||
bpl rtl2 ; no |
||||
|
||||
jsr rdbyte ; get sp type |
||||
bit type ; how was fp type ? |
||||
bpl udcks ; ok--use it |
||||
lda tpbyte ; fp was bad--rely on sp |
||||
sta type |
||||
bcc udcks ; sp was good, don't ror in error flag |
||||
ror type |
||||
udcks |
||||
lda type |
||||
eor chksum ; !type is included in checksum |
||||
sta chksum |
||||
|
||||
rtl2 |
||||
jsr rdbyte |
||||
ror rdetmp ; save returned status |
||||
lda tpbyte ; compute checksum |
||||
eor chksum |
||||
sta chksum |
||||
|
||||
; was this a bad byte in fp? |
||||
|
||||
bit fperrs ; errors >>>30? |
||||
bmi notbad ; yes, don't try to fix |
||||
ldy errsp |
||||
cpy fperrs |
||||
beq notbad ; no errors in stack |
||||
lda estakl,y |
||||
cmp tapebs |
||||
bne notbad ; nope |
||||
lda estakh,y |
||||
cmp tapebs+1 |
||||
bne notbad ; nope |
||||
inc errsp ; byte was bad, advance ptr |
||||
|
||||
; but is this one ok? |
||||
|
||||
lda rdetmp |
||||
bmi e2both ; fp & sp errors |
||||
|
||||
; else sp is good, replace it |
||||
|
||||
ldy #0 |
||||
jsr kludes |
||||
|
||||
; acc <- byte in ram ( maybe from behind rom ) |
||||
|
||||
nop ; make mem addresses come out the same |
||||
bit verfck ; if this is a load |
||||
bmi rtl222 |
||||
lda tpbyte ; acc <- byte read from tape |
||||
rtl222 |
||||
cmp tpbyte ; if acc <> byte from tape |
||||
bne e2both ; go commit error code |
||||
|
||||
spload |
||||
dec errsum ; 1 less error |
||||
sta (tapebs),y ; stash byte ( in case of load ) |
||||
|
||||
e2both ; have an unrecoverable fp & sp error |
||||
; just ignore...it'll get caught |
||||
notbad ; advance pointer & counter |
||||
inc tapebs |
||||
bne inccn2 |
||||
inc tapebs+1 |
||||
inccn2 |
||||
inc rdcnt |
||||
bne rtl2 |
||||
inc rdcnt+1 |
||||
bne rtl2 |
||||
|
||||
; done with sp read |
||||
|
||||
jsr rdbyte ; read chksum byte |
||||
spserr |
||||
lda #0 ; make system staus word say ok. |
||||
sta status |
||||
lda type ; good return with type in accumilaator |
||||
ldx errsum ; if no errors to speak of |
||||
beq rebgd ; go exit with carry clear |
||||
bit verfck ; if verify command |
||||
bmi mvexit ; exit with a bad verify |
||||
; fall through to irrecoverable error |
||||
|
||||
reberr ; read an block in error |
||||
lda #$60 ; indicate unrecoverable error. |
||||
sta status |
||||
sec |
||||
jmp bweep ; !bra |
||||
|
||||
|
||||
mvexit |
||||
lda #$10 ; indicate verify error |
||||
sta status |
||||
sec |
||||
jmp bweep |
||||
|
||||
rebgd ; good exit |
||||
clc |
||||
bweep |
||||
jsr motoff |
||||
jsr slower |
||||
rts |
||||
|
||||
|
||||
; $$$ read a fixed length data block $$$ |
||||
; |
||||
fldbtb .byte <tapbuf,>tapbuf,$41,$ff |
||||
|
||||
rdblok |
||||
ldy #3 ; 4-bytes |
||||
ateam |
||||
lda fldbtb,y |
||||
sta trsave,y |
||||
dey |
||||
bpl ateam |
||||
|
||||
sty typenb ; enable type read of tape(msb=1) y=$ff |
||||
|
||||
; fixed block must be a write |
||||
|
||||
lda verfck ; save intended flag |
||||
pha |
||||
iny ; y=0 |
||||
sty verfck ; enable write (=0) |
||||
sty tptr ; reset fixed buffer pointer (=0) |
||||
|
||||
jsr rtblok ; read header |
||||
|
||||
pla |
||||
sta verfck ; restore flag |
||||
|
||||
; point to beg of buffer with tapebs |
||||
|
||||
jmp bufini ; does rts ; !carry preserved |
||||
|
||||
|
||||
|
||||
; $$$ read a variable length block $$$ |
||||
; |
||||
rvblok |
||||
lda stal ; sta(l,h) => trsave(0,1) |
||||
sta trsave |
||||
lda stah |
||||
sta trsave+1 |
||||
clc |
||||
lda eal ; ((((sta-ea)+1)<xor> $ffff)+1) => trsave(2,3) |
||||
sbc stal |
||||
eor #$ff |
||||
sta trsave+2 |
||||
lda eah |
||||
sbc stah |
||||
eor #$ff |
||||
sta trsave+3 |
||||
|
||||
clc ; disable type read |
||||
ror typenb |
||||
jmp rtblok ; does rts |
||||
|
||||
|
||||
|
||||
; $$$ sync on leader $$$ |
||||
|
||||
dstab .byte <ids1,>ids1,<ids2,>ids2,<izcell,>izcell |
||||
|
||||
sparms= dsamp1 ; keep these samp vals contiguous !!!!!! |
||||
|
||||
|
||||
|
||||
; *** note: these values not changed whenn tape speed changed |
||||
; ( see definitins for tshort,tlong, and tbyte ) |
||||
|
||||
ids1= 268-10 ; dipole sample #1 initial delta |
||||
ids2= 536-22 ; dipole sample #2 initial delta |
||||
izcell=536-11 ; initial delta for a z-cell verify |
||||
|
||||
ldsync |
||||
ldx #5 |
||||
fweep |
||||
lda dstab,x |
||||
sta sparms,x |
||||
dex |
||||
bpl fweep |
||||
|
||||
molson |
||||
lda #10 ; find 10 consecutive good shorts |
||||
sta ldrscn |
||||
ale |
||||
jsr rddipl |
||||
bcs molson ; dipole read in error |
||||
bvc molson ; read a long or a word |
||||
; got a short |
||||
dec ldrscn |
||||
bne ale ; counting down |
||||
|
||||
|
||||
; measure dipole down-time via skewed samples to minimize |
||||
; sample-point granularity. |
||||
; |
||||
; ...this is as good as it gets folks: |
||||
|
||||
sigma = 16 ; number of skewed samples (x3) |
||||
accm=wrbase ; use wrbase for servo accumulator |
||||
|
||||
|
||||
servo |
||||
lda #0 |
||||
sta accm |
||||
sta accm+1 ; init accum |
||||
ldy #sigma ; for 2:1 sample ratio |
||||
sum |
||||
ldx #0 |
||||
lda #$10 |
||||
swhi |
||||
bit port ; wait till high |
||||
beq swhi |
||||
swlo |
||||
bit port |
||||
bne swlo |
||||
|
||||
; caught neg. edge: |
||||
;************************************************************************** |
||||
; caution!!!, the following loop is sensitive to crossing page boundaries: |
||||
;************************************************************************** |
||||
|
||||
srvlow |
||||
inx |
||||
beq servo ; error, re-try |
||||
bit port ; you figure it out... |
||||
beq srvlow ; keep counting |
||||
srvhi |
||||
inx |
||||
beq servo |
||||
bit port |
||||
bne srvhi |
||||
|
||||
;************************************************************************* |
||||
; |
||||
; add current count to accm |
||||
|
||||
txa |
||||
clc |
||||
adc accm |
||||
sta accm |
||||
lda #0 |
||||
adc accm+1 |
||||
sta accm+1 |
||||
dey |
||||
bne sum |
||||
|
||||
; do *3 ---inherent in #of samples taken |
||||
|
||||
lsr accm+1 ; do /4 |
||||
ror accm |
||||
lsr accm+1 |
||||
ror accm |
||||
|
||||
lda accm ; 3/4 absolute good for: |
||||
sta dsamp1 ; d1 |
||||
asl a ; 6/4 for: |
||||
sta dsamp2 ; d2, and |
||||
sta zcell ; z-cell |
||||
|
||||
lda accm+1 |
||||
sta dsamp1+1 |
||||
rol a |
||||
sta dsamp2+1 |
||||
sta zcell+1 |
||||
|
||||
|
||||
; ...i have a feeling we're not in kansas anymore |
||||
|
||||
spansh ; span all shorts till a wm |
||||
jsr rddipl |
||||
bcs spansh ; error |
||||
bvs spansh ; short |
||||
bpl spansh ; long |
||||
|
||||
; else got a word (maybe) |
||||
|
||||
jsr rddipl |
||||
bcs spansh ; error:backup |
||||
bvs spansh ; short:backup |
||||
bmi spansh ; word:backup |
||||
|
||||
; ok, have seen a bm & have consumed it |
||||
|
||||
clc ; boundary case |
||||
ror enext |
||||
jsr setd1 ; get ready for first byte |
||||
lda #3 ; max # of erros allowed in countdown |
||||
sta cderrm |
||||
jsr rdbytd ; gobble up cd.9 |
||||
bcc rdcdok ; its ok |
||||
dec cderrm ; first error |
||||
rdcdok |
||||
jsr rdbyte ; read a countdown byte |
||||
bcc rcdok2 ; got a good read |
||||
dec cderrm ; another error |
||||
bne rcdok2 ; not fatal |
||||
jmp ldsync ; else==00, start from scratch |
||||
rcdok2 |
||||
lda tpbyte |
||||
and #$f |
||||
cmp #1 ; is cdbyte=1? |
||||
bne rdcdok ; no |
||||
|
||||
; got cdbyte=1 |
||||
|
||||
lda tpbyte ; specify pass |
||||
and #$80 ; msb of type=>pass |
||||
sta pass |
||||
rts ; good return |
||||
|
||||
|
||||
; find any header |
||||
; ---read tape until one of the following block types is found: |
||||
; bdfh - basic data file header |
||||
; blf - basic load file |
||||
; |
||||
; if c=0 then success /* ac=type of header found */ |
||||
; else if ac=0 then stop/key/pressed |
||||
; else end/of/tape /* ac=5 */ |
||||
; fi |
||||
; fi |
||||
|
||||
|
||||
fah |
||||
jsr rdblok ; read a data-type block |
||||
bcs fhderr ; hey! stop key??? if not keep looking |
||||
|
||||
lda type |
||||
cmp #eot |
||||
beq fah40 ; no more blocks |
||||
cmp #blf |
||||
beq gothed ; good nuf |
||||
cmp #plf |
||||
beq gothed ; good |
||||
cmp #bdfh |
||||
bne fah |
||||
|
||||
gothed |
||||
tax ; is this necessary??? |
||||
bit msgflg ; r we printing messages? |
||||
bpl ctlo ; nope |
||||
jsr primm |
||||
.byte $d,'FOUND ',0 |
||||
|
||||
ldy #4 |
||||
fah55 ; output filename |
||||
lda (tapebs),y |
||||
jsr bsout |
||||
iny |
||||
cpy #21 |
||||
bne fah55 |
||||
|
||||
; <wait 8 seconds> or <wait for <<run/stop> or <commodore> key>> |
||||
|
||||
fah45 |
||||
ldx #$ff |
||||
tapewt |
||||
jsr w16ms |
||||
jsr w16ms |
||||
dex |
||||
beq ctlo |
||||
|
||||
lda #$7f |
||||
jsr keyscn ;** 01/17/84 mod for new keyboard port |
||||
; cmp #$ef ; was this the space key? |
||||
; beq fah ; yep, skip this file |
||||
cmp #$7f ; was it the run/stop key |
||||
beq fhderr ; yep |
||||
cmp #$df ; how about the commodore key? |
||||
bne tapewt ; no, continue with timeout loop |
||||
|
||||
; else: yes, load this file |
||||
|
||||
ctlo ; got a timeout or user pressed commodore key |
||||
clc |
||||
lda type |
||||
fah40 |
||||
rts |
||||
.byte $ea,$ea,$ea |
||||
fhderr |
||||
lda #0 |
||||
rts |
||||
|
||||
|
||||
; find a file |
||||
; |
||||
; if c=0 then sucess /* ac=type of header found */ |
||||
; else if ac=0 then stop/key/pressed |
||||
; else end/of/tape /* ac=5 */ |
||||
; fi |
||||
; fi |
||||
|
||||
faf |
||||
jsr fah ; pick any card |
||||
bcs faf35 ; ...not that one |
||||
cmp #eot ; if end of tape |
||||
beq faf30 ; go quit |
||||
; ok let's take a look |
||||
ldy #$ff |
||||
faf20 |
||||
iny ; if filename matches |
||||
cpy fnlen |
||||
beq faf40 ; goto faf40 |
||||
lda #fnadr |
||||
sta sinner |
||||
jsr kludes |
||||
cmp tapbuf+4,y |
||||
beq faf20 |
||||
lsr type ; if type <> 1 or 3 |
||||
bcc faf ; go load next header |
||||
ldy #$ff |
||||
|
||||
; read two bytes of prog into tape buffer |
||||
|
||||
sty trsave+3 ; and go find next file |
||||
dey |
||||
sty trsave+2 |
||||
ldy #1 |
||||
jsr ateam |
||||
jmp faf |
||||
|
||||
faf35 |
||||
lda #0 ; stop key pressed exit |
||||
faf30 ; forced error exit |
||||
sec |
||||
rts |
||||
|
||||
faf40 |
||||
clc |
||||
lda type ; ac returns type of header found |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,187 @@
|
||||
.page |
||||
.subttl 'tape support' |
||||
; if cas plat sw is not pressed give message & wait until pressed |
||||
; entry to test sw for record: |
||||
; |
||||
tstrec ;i just have to keep thinking about the 68000... |
||||
sec |
||||
.byte $24 |
||||
tstply |
||||
clc |
||||
lda xport |
||||
and #4 |
||||
beq pok |
||||
php |
||||
jsr primm |
||||
.byte cr,'PRESS PLAY ',0 |
||||
plp |
||||
bcc qq2 |
||||
jsr primm |
||||
.byte '& RECORD ',0 |
||||
qq2 |
||||
jsr primm |
||||
.byte 'ON TAPE',0 |
||||
|
||||
waitpl |
||||
jsr tstsky ; does user want to play some more? |
||||
bcs pabort ; nope, boo... |
||||
lda xport |
||||
and #4 |
||||
bne waitpl ; play still not down |
||||
jsr primm ; finally! |
||||
.byte cr,'OK',0 |
||||
pok |
||||
clc ; everything's fine |
||||
pabort ; ooops |
||||
rts ; exit |
||||
|
||||
|
||||
; prep system for cassette useage... |
||||
; stop dma's by blanking screen & disable interrupts |
||||
; |
||||
; call motor/on after this routine to allow ds clk to setup |
||||
; |
||||
|
||||
faster |
||||
sei ; pass on the irq's |
||||
|
||||
; select screen blanking: 1.7mhz clock & no dma's |
||||
; |
||||
lda tedvcr ; have mutex from above <sei> |
||||
and #$ef |
||||
sta tedvcr |
||||
|
||||
lda tedicr |
||||
and #$fd ; raster int off |
||||
ora #$08 ; t1 int on |
||||
sta tedicr |
||||
rts |
||||
|
||||
; restore system to normal(?) mode of operation... |
||||
; restore timer t1, re-enable dma's & irq's |
||||
|
||||
slower ; !carry preserved |
||||
sei |
||||
lda tedvcr ; de-select blanking |
||||
ora #$10 |
||||
sta tedvcr |
||||
|
||||
lda tedicr |
||||
and #$f7 ; t1 int off |
||||
ora #$02 ; raster int on |
||||
sta tedicr |
||||
cli ; yes, you too |
||||
rts ; !carry preserved |
||||
|
||||
|
||||
; turn motor on & delay |
||||
; modifies a,x,y |
||||
; |
||||
moton |
||||
php ; !preserve carry |
||||
sec |
||||
ror lsem |
||||
lda port |
||||
and #$f5 ; motor on & init write line to high |
||||
sta port ; ...have to write inverted |
||||
ldx #30 ; wait 480ms for motor to come up to speed |
||||
md1 ; to do skewed servo |
||||
jsr w16ms ; ...wait 16ms |
||||
dex |
||||
bne md1 |
||||
plp ; !restore carry |
||||
rts |
||||
|
||||
|
||||
.byte 'C1984COMMODORE' |
||||
|
||||
|
||||
; turn motor off |
||||
|
||||
motoff ; !carry preserved |
||||
lda port |
||||
ora #$08 |
||||
sta port ; !carry preserved |
||||
rts |
||||
|
||||
|
||||
; write blanks to tape buffer |
||||
; modifies a,x |
||||
|
||||
blkbuf |
||||
ldy #0 |
||||
lda #$20 |
||||
blklop |
||||
sta (tapebs),y |
||||
iny |
||||
cpy #bufmax+1 |
||||
bne blklop |
||||
rts |
||||
|
||||
|
||||
; setup tape pointer to reserved buffer |
||||
|
||||
bufini |
||||
pha ; !save ac |
||||
lda #<tapbuf |
||||
sta tapebs |
||||
lda #>tapbuf |
||||
sta tapebs+1 |
||||
pla ; !restore ac |
||||
rts |
||||
|
||||
|
||||
|
||||
balout ; error recovery for stop-key pressed |
||||
jsr tstsky |
||||
bcc cont |
||||
jsr motoff ; restore system |
||||
jsr slower |
||||
|
||||
ldx srecov |
||||
txs |
||||
lda #0 |
||||
sta srecov |
||||
sec |
||||
cont |
||||
rts ; blind faith |
||||
|
||||
|
||||
d2 = 13200 ; dead man-2 |
||||
|
||||
dtimeo |
||||
lda tedirq ; was this a t1 int |
||||
and tedicr |
||||
and #$08 |
||||
bne nott1 ; no return |
||||
rts |
||||
nott1 |
||||
sta tedirq ; yep, clear it |
||||
sei |
||||
|
||||
lda #<d2 ; set up d2 |
||||
sta timr1l ; timeout sets up d2 |
||||
lda #>d2 |
||||
sta timr1h |
||||
|
||||
ldx drecov ; get stack mark |
||||
txs |
||||
sec ; indicate error |
||||
rts ; return to upper lexical level |
||||
|
||||
|
||||
; word marker sets this time up |
||||
|
||||
d1 = 18600 ; dead man-1 |
||||
|
||||
setd1 ; setup delta #1 for byte read |
||||
lda #<d1 |
||||
sta timr1l |
||||
lda #>d1 |
||||
sta timr1h |
||||
|
||||
lda #$08 ; clear any pending t1 int's |
||||
sta tedirq |
||||
rts |
||||
|
||||
;end |
||||
@ -0,0 +1,377 @@
|
||||
.page |
||||
.subttl 'tape write' |
||||
; *** tape write routines *** |
||||
; |
||||
; primitives first... |
||||
; <w>ait for <t>imer to <t>oggle <t>wice |
||||
|
||||
wttt |
||||
sec |
||||
bcs wtts |
||||
|
||||
; <w>ait for <t>imer to <t>oggle |
||||
|
||||
wtt |
||||
clc |
||||
wtts |
||||
sty t1pipe+2 ; save x,y |
||||
stx t1pipe+3 |
||||
ldy t1pipe ; pre-load for spipe |
||||
ldx t1pipe+1 |
||||
lda #$10 |
||||
w1 ; wait for timeout |
||||
bit tedirq |
||||
beq w1 |
||||
sty timr2l ; reload timer with latch |
||||
stx timr2h |
||||
sta tedirq ; clear flag |
||||
lda port ; toggle write line |
||||
eor #$02 |
||||
sta port |
||||
|
||||
php ; preserve carry (pass indicator) |
||||
jsr balout ; do stopkey check |
||||
plp ; restore carry |
||||
|
||||
ldy t1pipe+2 ; restore x,y |
||||
ldx t1pipe+3 |
||||
bcs wtt ; if c=1 then do twice |
||||
rts |
||||
|
||||
|
||||
tshort=212-4 ; 240us / 8 cycles(4us) to setup |
||||
tlong= 424-4 ; 480us / " " |
||||
tbyte= 850-4 ; 960us / " " |
||||
|
||||
|
||||
; setup >byte< dipole time: 306 cycles |
||||
|
||||
setupb |
||||
lda #<tbyte |
||||
sta t1pipe |
||||
lda #>tbyte |
||||
sta t1pipe+1 |
||||
rts |
||||
|
||||
; setup >short< dipole time: 163 cycles |
||||
|
||||
setups |
||||
lda #<tshort |
||||
sta t1pipe |
||||
lda #>tshort |
||||
sta t1pipe+1 |
||||
rts |
||||
|
||||
; setup >long< dipole time: 234 cycles |
||||
|
||||
setupl |
||||
lda #<tlong |
||||
sta t1pipe |
||||
lda #>tlong |
||||
sta t1pipe+1 |
||||
rts |
||||
|
||||
; write a 0 on tape; ie: s,l |
||||
|
||||
write0 |
||||
jsr setups |
||||
jsr wttt |
||||
jsr setupl |
||||
jmp wttt ; does rts |
||||
|
||||
; write a 1 on tape; ie: l,s |
||||
|
||||
write1 |
||||
jsr setupl |
||||
jsr wttt |
||||
jsr setups |
||||
jmp wttt ; does rts |
||||
|
||||
; write a word marker on tape; ie: b,l |
||||
|
||||
writew |
||||
jsr setupb |
||||
jsr wttt |
||||
jsr setupl |
||||
jmp wttt ; does rts |
||||
|
||||
; write the byte in (tpbyte) to the tape with leading word marker, |
||||
; and ending odd parity. |
||||
|
||||
wrbyte |
||||
sta tpbyte ; save byte to be written |
||||
lda #1 |
||||
sta parity |
||||
jsr writew |
||||
ldx #8 ; #of bits |
||||
twloop |
||||
ror tpbyte ; lsb first |
||||
bcs aone |
||||
inc parity ; count the zeros |
||||
jsr write0 |
||||
jmp wjoin |
||||
aone |
||||
jsr write1 |
||||
wjoin |
||||
dex ; done yet? |
||||
bne twloop ; nope |
||||
ror parity ; yep, get parity |
||||
bcs aoneb |
||||
jsr write0 |
||||
jmp wjoin2 |
||||
aoneb |
||||
jsr write1 |
||||
wjoin2 |
||||
rts |
||||
|
||||
|
||||
; write elemental block to tape as defined by: |
||||
; (wrbase{+1})::=@beg of data to be written |
||||
; (wrlen{+1})::= 2's compl of numeric length of data |
||||
; pass::= {=0 for pass1}, {=$80 for pass2} |
||||
|
||||
welemb |
||||
tsx ; save stack mark |
||||
stx srecov ; ...for stopkey |
||||
|
||||
lda port ; assert external line low |
||||
ora #$02 |
||||
sta port |
||||
|
||||
jsr setups ; get ready for short* |
||||
ldy #1 |
||||
sty timr2h ; prime t2 to use as one-shot |
||||
|
||||
lda #$10 ; clear any flag |
||||
sta tedirq |
||||
|
||||
; lots & lots of shorts... |
||||
|
||||
bit pass ; what pass are we doing |
||||
bpl l1loop |
||||
|
||||
; y=1... shorter shorts for second pass |
||||
|
||||
ldy #$40 ; hi loop index...for first pass |
||||
ldx #$fe ; low loop index...for both passes |
||||
|
||||
; write leader 1 |
||||
|
||||
l1loop |
||||
jsr wttt |
||||
dex |
||||
bne l1loop |
||||
dey |
||||
bne l1loop |
||||
|
||||
; now write countdown loop |
||||
|
||||
ldy #9 |
||||
cdloop |
||||
tya |
||||
ora pass ; pass modifies b(7) of data |
||||
jsr wrbyte |
||||
dey |
||||
bne cdloop |
||||
|
||||
; init checksum |
||||
|
||||
lda type |
||||
sta chksum |
||||
|
||||
; now write block type |
||||
|
||||
beq wdloop ; if=0 then no type in block |
||||
jsr wrbyte |
||||
|
||||
; write data block |
||||
|
||||
wdloop |
||||
ldy #0 |
||||
lda #wrbase ; fetch byte ( may be under rom ) |
||||
sta sinner |
||||
jsr kludes |
||||
pha ;save |
||||
eor chksum |
||||
sta chksum |
||||
pla |
||||
|
||||
jsr wrbyte |
||||
|
||||
inc wrbase |
||||
bne okeefe |
||||
inc wrbase+1 |
||||
okeefe |
||||
inc wrlen ; one more byte |
||||
bne wdloop |
||||
inc wrlen+1 |
||||
bne wdloop |
||||
|
||||
; data written, now do checksum |
||||
|
||||
lda chksum |
||||
jsr wrbyte |
||||
|
||||
; do block end marker; ie: l |
||||
|
||||
jsr setupl |
||||
jsr wttt |
||||
|
||||
; do end leader; ie: l*450 |
||||
|
||||
jsr setups |
||||
ldy #1 ; loop hi |
||||
ldx #$c2 ; loop lo |
||||
l2loop |
||||
jsr wttt |
||||
dex |
||||
bne l2loop |
||||
dey |
||||
bne l2loop ; done with elemental block |
||||
rts |
||||
|
||||
|
||||
; write a >fixed length data< block |
||||
; assumed data is in the pre-allocated tape buffer of 192 bytes. |
||||
; *** type must be specified externally !!! *** |
||||
|
||||
wfblok |
||||
jsr tstrec |
||||
jsr faster ; 1.7mhz/get timer1/no irq's |
||||
jsr moton ; get em goin |
||||
bcs wdabor ; stop key pressed |
||||
|
||||
lda #$80 |
||||
sta pass |
||||
web |
||||
lda tapebs ; tapebs->wrbase |
||||
sta wrbase |
||||
lda tapebs+1 |
||||
sta wrbase+1 |
||||
|
||||
; setup length & type |
||||
|
||||
lda #$41 ; 2's compl of #191 |
||||
sta wrlen |
||||
lda #$ff |
||||
sta wrlen+1 |
||||
|
||||
jsr welemb |
||||
bcs wdabor ; stop key pressed |
||||
|
||||
lda pass |
||||
bpl wdone ; if second pass |
||||
lda #0 |
||||
sta pass |
||||
bpl web ; else, do second pass |
||||
|
||||
; done with both elemental blocks |
||||
|
||||
wdone ; good exit |
||||
clc |
||||
wdabor ; bad exit |
||||
jsr motoff ; stop em |
||||
jmp slower ; whatever clk/give up timer1/ok irq's & RTS |
||||
|
||||
|
||||
; write a tape header |
||||
; ...write starting, ending address, and filename to tape. |
||||
; *** type must be specified externally !!! *** |
||||
|
||||
tphead |
||||
jsr bufini |
||||
jsr blkbuf |
||||
ldy #0 |
||||
lda stal |
||||
sta (tapebs),y |
||||
iny |
||||
lda stah |
||||
sta (tapebs),y |
||||
iny |
||||
lda eal |
||||
sta (tapebs),y |
||||
iny |
||||
lda eah |
||||
sta (tapebs),y |
||||
iny ; y=4 ; y@ beg of filename |
||||
|
||||
sty tt2 ; pointer to tape buffer (dest) |
||||
ldy #0 |
||||
sty tt1 ; pointer to filename (source) |
||||
tfname |
||||
ldy tt1 |
||||
cpy fnlen |
||||
beq fnisin ; all done ! |
||||
lda #fnadr ; get filename from under rom |
||||
sta sinner |
||||
jsr kludes |
||||
ldy tt2 |
||||
sta (tapebs),y |
||||
inc tt1 |
||||
inc tt2 |
||||
jmp tfname |
||||
fnisin ; header data area is complete, now write it to tape... |
||||
jmp wfblok ; does rts ; c=0=>ok, else error |
||||
|
||||
|
||||
|
||||
; write a >variable length data< block (ie: program type). |
||||
; block to be written is defined by: (stah/stal,eah/eal) |
||||
; *** type must be specified externallly !!! *** |
||||
|
||||
wvblok |
||||
jsr tstrec |
||||
jsr faster ; 1.7mhz/get timer1/no irq's |
||||
jsr moton |
||||
bcs wpabor ; stop key pressed |
||||
|
||||
lda #$80 |
||||
sta pass |
||||
|
||||
wepb |
||||
lda stal ; starting address -> wrbase |
||||
sta wrbase |
||||
lda stah |
||||
sta wrbase+1 |
||||
|
||||
; compute: ((( end-start ) <xor> $ffff)+1) -> wrlen |
||||
; by: ((end-start)-1)) <xor> $ffff) -> wrlen |
||||
; |
||||
clc |
||||
lda eal |
||||
sbc stal |
||||
eor #$ff |
||||
sta wrlen |
||||
lda eah |
||||
sbc stah |
||||
eor #$ff |
||||
sta wrlen+1 |
||||
|
||||
jsr welemb ; write a elem block |
||||
bcs wpabor ; ooops! |
||||
lda pass |
||||
bpl wpdone ; done with both blocks |
||||
|
||||
lda #0 |
||||
sta pass |
||||
bpl wepb ; write second block |
||||
|
||||
; done with both elem var blocks |
||||
|
||||
wpdone ; good exit |
||||
clc |
||||
wpabor ; bad exit |
||||
jsr motoff |
||||
jmp slower ; whatever clk/give up timer1/ok irq's & RTS |
||||
|
||||
|
||||
|
||||
; write end-of-tape block |
||||
|
||||
wreot |
||||
jsr blkbuf |
||||
lda #eot |
||||
sta type |
||||
jmp wfblok ;& RTS |
||||
|
||||
;end |
||||
@ -0,0 +1,81 @@
|
||||
.page |
||||
.subttl 'time 01/17/84' |
||||
;*********************************** |
||||
;* * |
||||
;* time * |
||||
;* * |
||||
;*consists of three functions: * |
||||
;* (1) udtim-- update time. usually* |
||||
;* called every 60th second. * |
||||
;* (2) settim-- set time. .y=msd, * |
||||
;* .x=next significant,.a=lsd * |
||||
;* (3) rdtim-- read time. .y=msd, * |
||||
;* .x=next significant,.a=lsd * |
||||
;* * |
||||
;*********************************** |
||||
|
||||
; interrupts are coming from timer 1 |
||||
; here we proceed with an increment |
||||
; of the time register. |
||||
|
||||
udtim |
||||
inc time+2 |
||||
bne ud30 |
||||
inc time+1 |
||||
bne ud30 |
||||
inc time |
||||
|
||||
; here we check for roll-over 23:59:59 |
||||
; and reset the clock to zero if true |
||||
|
||||
ud30 |
||||
sec |
||||
lda time+2 |
||||
sbc #$01 |
||||
lda time+1 |
||||
sbc #$1a |
||||
lda time |
||||
sbc #$4f |
||||
bcc ud60 |
||||
; |
||||
; time has rolled--zero register |
||||
; |
||||
ldx #0 |
||||
stx time |
||||
stx time+1 |
||||
stx time+2 |
||||
; |
||||
; set stop key flag here |
||||
; |
||||
ud60 |
||||
lda #$7f ;debounce (** 01/17/84 mod for new keyboard ports) |
||||
jsr keyscn |
||||
sta tmpkey |
||||
lda #$7f |
||||
jsr keyscn |
||||
cmp tmpkey |
||||
bne ud60 |
||||
ora #$7f |
||||
sta stkey ;stkey is now either $ff (no stop) or $7f (stop) |
||||
rts |
||||
|
||||
|
||||
|
||||
rdtim |
||||
sei ;keep time from rolling |
||||
lda time+2 ;get lsd |
||||
ldx time+1 ;get next most sig. |
||||
ldy time ;get msd |
||||
|
||||
|
||||
|
||||
settim |
||||
sei ;keep time from changing |
||||
sta time+2 ;store lsd |
||||
stx time+1 ;next most significant |
||||
sty time ;store msd |
||||
cli |
||||
rts |
||||
|
||||
;end |
||||
|
||||
@ -0,0 +1,327 @@
|
||||
.page |
||||
.subttl 'util' |
||||
; parse entry when 1st char has already been read |
||||
; |
||||
pargot |
||||
dec chrptr |
||||
|
||||
; get a number in t0,t0+1. z set if no value found, |
||||
; c set if end of line. y is preserved |
||||
|
||||
parse |
||||
lda #0 |
||||
sta t0 |
||||
sta t0+1 |
||||
sta syreg ;flag for valid number |
||||
|
||||
par005 |
||||
jsr gnc |
||||
beq par040 |
||||
cmp #$20 |
||||
beq par005 |
||||
par006 |
||||
cmp #$20 |
||||
beq par030 |
||||
cmp #', |
||||
beq par030 |
||||
|
||||
cmp #'0 ;check if hex, and convert |
||||
bcc parerr |
||||
cmp #'g |
||||
bcs parerr |
||||
cmp #': ;'9'+1 |
||||
bcc par010 |
||||
cmp #'a |
||||
bcc parerr |
||||
sbc #8 ;adjust if in a..f |
||||
par010 |
||||
sbc #$2f ;adjust to 00..0f |
||||
asl a |
||||
asl a ;shift nibble left |
||||
asl a |
||||
asl a |
||||
ldx #4 ;mult old val by 16,add new |
||||
par015 |
||||
asl a |
||||
rol t0 |
||||
rol t0+1 |
||||
dex |
||||
bne par015 |
||||
|
||||
inc syreg ;make syreg non-zero |
||||
jsr gnc |
||||
bne par006 ;keep going if not e-o-l |
||||
par030 |
||||
lda syreg ;set z flag if a real number |
||||
clc ;flag as number |
||||
par040 |
||||
rts |
||||
parerr |
||||
pla ;pop this call |
||||
pla |
||||
jmp error |
||||
|
||||
|
||||
|
||||
; print t2 as 4 hex digits: .x destroyed, .y preserved |
||||
; |
||||
putt2 |
||||
lda t2 |
||||
ldx t2+1 |
||||
putwrd |
||||
pha |
||||
txa |
||||
jsr puthex |
||||
pla |
||||
puthxs |
||||
jsr puthex |
||||
putspc |
||||
lda #$20 |
||||
.byte $2c |
||||
putqst |
||||
lda #'? |
||||
jmp bsout |
||||
|
||||
|
||||
|
||||
; print .a as 2 hex digits |
||||
; |
||||
puthex |
||||
stx sxreg |
||||
jsr makhex |
||||
jsr bsout |
||||
txa |
||||
ldx sxreg |
||||
jmp bsout |
||||
|
||||
|
||||
|
||||
; convert .a to 2 hex digits & put msb in .a, lsb in .x |
||||
; |
||||
makhex |
||||
pha |
||||
jsr makhx1 |
||||
tax |
||||
pla |
||||
lsr a |
||||
lsr a |
||||
lsr a |
||||
lsr a |
||||
makhx1 |
||||
and #$0f |
||||
cmp #$0a |
||||
bcc makhx2 |
||||
adc #6 |
||||
makhx2 |
||||
adc #'0 |
||||
rts |
||||
|
||||
|
||||
|
||||
cronly |
||||
lda #145 ;cursor up |
||||
jsr bsout |
||||
crlf |
||||
lda #$0d |
||||
jmp bsout |
||||
|
||||
|
||||
|
||||
; get next character: return in .a (return $00 if buffer empty) |
||||
; |
||||
gnc |
||||
stx sxreg |
||||
ldx chrptr |
||||
cpx bufend |
||||
bcs gnc99 |
||||
lda buf,x |
||||
cmp #': ;eol-return with z=1 |
||||
beq gnc99 |
||||
inc chrptr |
||||
gnc98 |
||||
php |
||||
ldx sxreg |
||||
plp |
||||
rts |
||||
gnc99 |
||||
lda #0 |
||||
beq gnc98 |
||||
|
||||
|
||||
|
||||
; move t0,t0+1 to t2,t2+1 |
||||
; |
||||
t0tot2 |
||||
lda t0 |
||||
sta t2 |
||||
lda t0+1 |
||||
sta t2+1 |
||||
rts |
||||
|
||||
|
||||
|
||||
; subtract t2 from t0, result in t0 |
||||
; |
||||
sub0m2 |
||||
sec |
||||
lda t0 |
||||
sbc t2 |
||||
sta t0 |
||||
lda t0+1 |
||||
sbc t2+1 |
||||
sta t0+1 |
||||
rts |
||||
|
||||
|
||||
|
||||
; decrement t0 |
||||
; |
||||
dect0 |
||||
lda #1 |
||||
subt0 |
||||
sta sxreg ;subtract .a from t2 |
||||
sec |
||||
lda t0 |
||||
sbc sxreg |
||||
sta t0 |
||||
lda t0+1 |
||||
sbc #0 |
||||
sta t0+1 |
||||
rts |
||||
|
||||
; decrement t1 |
||||
; |
||||
dect1 |
||||
sec |
||||
lda t1 |
||||
sbc #1 |
||||
sta t1 |
||||
lda t1+1 |
||||
sbc #0 |
||||
sta t1+1 |
||||
rts |
||||
|
||||
|
||||
inct2 |
||||
lda #1 ;increment t2 |
||||
addt2 |
||||
clc ;add .a to t2 |
||||
adc t2 |
||||
sta t2 |
||||
bcc addt2r |
||||
inc t2+1 |
||||
addt2r |
||||
rts |
||||
|
||||
|
||||
; read a range - put sa in t2, count in t1 |
||||
; |
||||
range |
||||
bcs rang99 ;no defaults |
||||
jsr t0tot2 |
||||
jsr parse ;get ea |
||||
bcs rang99 |
||||
jsr sub0m2 |
||||
lda t0 ;move t0 to t1 |
||||
sta t1 |
||||
lda t0+1 |
||||
sta t1+1 |
||||
clc ;flag ok |
||||
rang99 |
||||
rts |
||||
|
||||
|
||||
savaxy |
||||
sta savea |
||||
savxy |
||||
stx savex |
||||
sty savey |
||||
rts |
||||
|
||||
rstaxy |
||||
lda savea |
||||
rstxy |
||||
ldx savex |
||||
ldy savey |
||||
rts |
||||
.page |
||||
; test stop key in a sane manner & cause no reg alterations... |
||||
; |
||||
; .c=0 => no stopkey, .c=1 => stopkey pressed |
||||
|
||||
tstsky |
||||
stx xstop ;save |
||||
jsr ud60 ;do actual stopkey test |
||||
ldx xstop ;restore |
||||
eor #$80 |
||||
asl a |
||||
lda #0 |
||||
rts |
||||
|
||||
|
||||
|
||||
; *** print immediate *** |
||||
; a jsr to this routine is followed by a immediate ascii string, |
||||
; terminated by a $00. the immediate string must not be longer |
||||
; than 255 characters including the terminator. |
||||
; |
||||
primm |
||||
pha ;protect a,x,y |
||||
tya |
||||
pha |
||||
txa |
||||
pha |
||||
tsx ;get sp |
||||
inx ;make it point to return addr low |
||||
inx |
||||
inx |
||||
inx |
||||
|
||||
lda $0100,x ;get it |
||||
sta imparm ;in base ptr. |
||||
inx ;point to hi |
||||
lda $0100,x ;get it |
||||
sta imparm+1 ;in base ptr. |
||||
inc imparm ;this was actually a return addr minus 1 |
||||
bne ipskip ;...note that a string of only a $0 will work |
||||
inc imparm+1 |
||||
ipskip |
||||
ldy #0 ;we're pointing to 1st byte of string |
||||
emsg |
||||
lda (imparm),y ;loop to output string |
||||
beq priend |
||||
jsr bsout |
||||
iny |
||||
bne emsg |
||||
|
||||
priend ;shove true return addr in the stack |
||||
tya ;y has offset to add onto imparm base |
||||
tsx |
||||
inx ;x points to ret adr lo |
||||
inx |
||||
inx |
||||
inx |
||||
|
||||
clc |
||||
adc imparm |
||||
sta $0100,x ;new lo ret adr |
||||
lda #0 |
||||
adc imparm+1 |
||||
inx |
||||
sta $0100,x ;new hi ret adr |
||||
|
||||
pla |
||||
tax |
||||
pla |
||||
tay |
||||
pla |
||||
rts |
||||
|
||||
|
||||
iobase |
||||
ldx #$00 ;return sa of i/o page |
||||
ldy #$fd |
||||
rts |
||||
|
||||
;end |
||||
|
||||
Loading…
Reference in new issue