mark@unisec.UUCP (05/15/87)
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# phone.a
# pprotocol.a
# printer.a
# printpkt.i
# startup.a
# terminal.a
# trtable.a
# xmprotocol.a
# xmrcv.i
# xmsnd.i
# This archive created: Fri May 15 15:05:32 1987
export PATH; PATH=/bin:$PATH
if test -f 'phone.a'
then
echo shar: will not over-write existing file "'phone.a'"
else
cat << \SHAR_EOF > 'phone.a'
;MRTERM Phone Number Management
;Filename: phone.a
;History (most recent change first)
; 12/05/86 -3.4- assert DTR when dialing Hayes Compatible
;
.nlst
#include "mem.i"
#include "kernal.i"
#include "char.i"
#include "printpkt.i"
.list
;External References
.ref asc2cbm,cbm2asc
.ref bkrd,bkwt
.ref buzz
.ref center
.ref dialcmd
.ref disk$status
.ref eraseeol,eraseeos
.ref errmsg
.ref fclose
.ref gets
.ref gong
.ref hilite
.ref imath$val
.ref imul
.ref itoa
.ref kbwait
.ref mdmrd,mdmwrt
.ref menu,menu$list,menu$title
.ref mfill
.ref modemtype
.ref offline
.ref open$seq
.ref print,println,printpkt
.ref rvsoff,rvson
.ref scratch
.ref scrndmp
.ref sleep
.ref strcpy,string$1,string$2
.ref term
.ref tsleep
.ref typenum
;Package Constants
bbsmax = 20 ;max bbs number
ci2pra = $dd01 ;data port register a
c2ddrb = $dd03 ;data direction register b
logo$p = $af ;screen print key code
nameleng = 16 ;max bbs name length
nbrleng = 20 ;max phone number length
namesize = bbsmax*[nameleng+1]
nbrsize = bbsmax*[nbrleng+1]
noload .byte "Bad or incompatible phone directory!",0
dirname .byte "mrterm.phone",0
;External Data
bbsnames .dseg namesize+2
bbsnbrs .dseg nbrsize+2
;Local Data
attempt .byte 0 ;dial attempt number
dfn .byte 0 ;disk file number
bbscnt .byte 0 ;count of bbs's stored
pnums .bss 21 ;phone number string
px .byte 0 ;phone number edit index
rvflag .byte 0 ;1 => display in reverse
trm .byte 0 ;termination character
m$title .byte "Phone Book Utilities",0
m$quit .byte "Quit",0
m$dial .byte "Auto-Dial",0
m$edit .byte "Edit Phone Book",0
m$load .byte "Load Phone Book",0
m$save .byte "Save Phone Book",0
m$list
.word m$quit
.word m$dial
.word m$edit
.word m$load
.word m$save
null
.word 0
m$vect
.word $ffff ;quit handled specially
.word dial
.word editphone
.word loadphone
.word savephone
pjump jmp $ffff
;Phone Utilities - Main Routine
.def phoneutil
phoneutil
lda #<m$list
sta menu$list
lda #>m$list
sta menu$list+1
ldx #<m$title
ldy #>m$title
jsr menu
cmp #0 ;quit?
beq putlx
clc
rol A
tay
lda m$vect,y
sta pjump+1
lda m$vect+1,y
sta pjump+2
lda #clrscrn ;display command as title
jsr chrout
lda m$list,y
tax
lda m$list+1,y
tay
jsr center
jsr pjump
jmp phoneutil
putlx
rts
;======================================
namprmpt .byte "Name (16): ",0
nampkt
.byte PP$EOS|PP$BELL
.byte 23,0
.word namprmpt
nbrprmpt .byte "Phone Number (20): ",0
nbrpkt
.byte PP$EOS|PP$BELL
.byte 24,0
.word nbrprmpt
editphone
lda #0
sta px
sta rvflag
jsr dphone ;display phone numbers
edph1
jsr select
cmp #$83 ;abort?
beq edphx
ldx px ;can't edit entry 0
bne edph2
jsr buzz
jmp edph1
edph2
inc rvflag ;redisplay in reverse
jsr tphone
dec rvflag
lda hilite
ldx #<nampkt
ldy #>nampkt
jsr printpkt
lda #nameleng
jsr gets
lda buf ;null name => changed mind
beq edph1
jsr nameaddr ;copy to database
stx string$1
sty string$1+1
lda #<buf
sta string$2
lda #>buf
sta string$2+1
jsr strcpy
edpnbr
lda hilite
ldx #<nbrpkt
ldy #>nbrpkt
jsr printpkt
lda #nbrleng
jsr gets
lda buf ;null number not allowed
beq edpnbr
jsr nbraddr
stx string$1
sty string$1+1
lda #<buf
sta string$2
lda #>buf
sta string$2+1
jsr strcpy
jmp edph1
edphx
ldx #23
jsr eraseeos
rts
;Display All Phone Numbers
dphone
lda px ;save current index
pha
lda #0
sta px
dph1
jsr tphone
inc px
lda px
cmp #bbsmax+1
bne dph1
pla ;restore index
sta px
rts
;Type one BBS Name / Phone Number Combo
;Called with:
; px = phone number index
tphone
lda px
clc
adc #2 ;start at row 2
tax
jsr eraseln
ldy #0
clc
jsr plot
lda px ;entry zero is special
beq tph1
cmp #10 ;10 and above need no pad
bcs tph0
lda #32
jsr chrout
tph0
ldx px
ldy #0
jsr typenum
tph1 ;print bbs name
ldx row
ldy #3
clc
jsr plot
lda rvflag ;print reversed?
beq tph11
jsr rvson
tph11
jsr nameaddr ;get name string address
jsr print
lda #32
jsr chrout
jsr rvsoff
ldx row
ldy #21
clc
jsr plot
jsr nbraddr
jsr print
rts
;Compute BBS Name Address
;Called with:
; px = BBS index
unrecmsg .byte "Unrecorded",0
nameaddr
lda px
bne namadr1
ldx #<unrecmsg
ldy #>unrecmsg
rts
namadr1
ldy #0
tax ;offset = (number-1)*nameleng+1
dex
beq namadr2
lda #nameleng+1
jsr imul
namadr2
clc
txa
adc #<bbsnames
tax
tya
adc #>bbsnames
tay
rts
;Compute BBS Number Address
;Called with:
; px = number index
nbraddr
lda px
bne nbradr1
ldx #<null
ldy #>null
rts
nbradr1
ldy #0
tax ;offset = (number-1)*nbrleng+1
dex
beq nbradr2
lda #nbrleng+1
jsr imul
nbradr2
clc
txa
adc #<bbsnbrs
tax
tya
adc #>bbsnbrs
tay
rts
;Select a Phone Number
selmsg .byte "Position to entry, then RETURN to",13
.byte "select or SHIFT-RUN/STOP to abort.",0
selpkt
.byte PP$EOS|PP$WAIT
.byte 23,0
.word selmsg
select
inc rvflag
jsr tphone ;display in reverse
dec rvflag
lda hilite
ldx #<selpkt
ldy #>selpkt
jsr printpkt
pha ;save character
jsr tphone ;redisplay - normal mode
pla
jsr scrndmp
cmp #logo$p ;screen dump?
beq select
cmp #13 ;CR?
beq selectx
cmp #$83 ;SHIFT/STOP
beq selectx
cmp #csrup
beq select1
cmp #csrdn
beq select2
jsr buzz
jmp select
selectx
rts
select1 ;cursor up
ldx px
bne select10
ldx #bbsmax
bne select11
select10
dex
select11
stx px ;store new phone index
select12
jmp select
select2 ;cursor down
ldx px
cpx #bbsmax
bne select20
ldx #0
beq select11
select20
inx
bne select11
;Load Phone Book
.def loadphone
loadphone
jsr i$phone ;zero phone directory
ldx #<dirname
ldy #>dirname
lda #'r ;read access
jsr open$seq
sta dfn
bne ldph1
showstatus
ldx #23
ldy #0
clc
jsr plot
ldx #<disk$status
ldy #>disk$status
jsr print
ldx #<noload
ldy #>noload
jsr errmsg
rts
ldph1
ldx dfn
jsr chkin
jsr getin ;get number of numbers
pha
jsr clrchn
pla
sta bbscnt
cmp #bbsmax ;must be exact
beq ldph2
ldpherr
ldx #<noload
ldy #>noload
jsr errmsg
jmp ldphx
ldph2
lda #<bbsnames
sta ptr1
lda #>bbsnames
sta ptr1+1
ldx #<namesize
ldy #>namesize
lda dfn
jsr bkrd ;read bbs names
bcc ldph3
jmp ldpherr
ldph3
lda #<bbsnbrs
sta ptr1
lda #>bbsnbrs
sta ptr1+1
ldx #<nbrsize
ldy #>nbrsize
lda dfn
jsr bkrd
bcc ldphx
jmp ldpherr
ldphx
lda dfn
jsr fclose
rts
;Save Phone Directory
savephone
ldx #<dirname
ldy #>dirname
jsr scratch
ldx #<dirname
ldy #>dirname
lda #'w ;write access
jsr open$seq
sta dfn
bne svph1
jmp showstatus
svph1
ldx dfn
jsr chkout
lda #bbsmax ;output number of bbs's
jsr chrout
jsr clrchn
lda #<bbsnames
sta ptr1
lda #>bbsnames
sta ptr1+1
ldx #<namesize
ldy #>namesize
lda dfn
jsr bkwt ;output names
lda #<bbsnbrs
sta ptr1
lda #>bbsnbrs
sta ptr1+1
ldx #<nbrsize
ldy #>nbrsize
lda dfn
jsr bkwt
svphx
lda dfn
jsr fclose
rts
;Initialize Phone Directory
.def i$phone
i$phone
lda #<bbsnames
sta ptr1
lda #>bbsnames
sta ptr1+1
lda #<namesize
sta ptr2
lda #>namesize
sta ptr2+1
lda #0
jsr mfill
lda #<bbsnbrs
sta ptr1
lda #>bbsnbrs
sta ptr1+1
lda #<nbrsize
sta ptr2
lda #>nbrsize
sta ptr2+1
lda #0
jsr mfill
rts
;
; General dial routine
;
dialing .byte "Dialing: ",0
dlpkt
.byte PP$NULL
.byte 5,0
.word dialing
dialtitle .byte "Auto-Dialer",0
dialinst .byte "Press any key to abort",0
dialprmpt .byte "Phone number: ",0
dlprpkt
.byte PP$EOS|PP$GONG
.byte 10,0
.word dialprmpt
.def dial
dial
lda #0
sta attempt
ldx #<dialtitle
ldy #>dialtitle
jsr center
jsr dphone ;display directory
jsr select ;select number
cmp #$83 ;abort?
bne dialck
jmp dialx
dialck
lda px ;unrecorded entry?
bne dialcpy ;copy number to string
jsr gpn ;get phone number
lda pnums ;null string?
bne dialgo
jmp dialx
dialcpy
lda #<pnums
sta string$1
lda #>pnums
sta string$1+1
jsr nbraddr
stx string$2
sty string$2+1
jsr strcpy
;Print instructions
dialgo
ldx #2
jsr eraseeos
lda hilite
ldx #<dlpkt
ldy #>dlpkt
jsr printpkt
jsr nameaddr
jsr print
lda #13
jsr chrout
lda hilite
sta color
ldx #<dialinst
ldy #>dialinst
jsr print
lda offline
sta color
dial0
jsr dialattmpt ;report attempt
lda modemtype
bne dial1
jsr dial1650
jmp dial2
dial1
jsr dialhayes
dial2
cmp #0 ;failed?
beq dial0 ;try again
cmp #1 ;connected?
bne dialx ;abort
jsr gong
jsr term ;call terminal mode
dialx
rts
;
;Report current attempt number
attmptstr .byte "Attempt: ",0
attpkt
.byte PP$EOS
.byte 12,0
.word attmptstr
dialattmpt
lda #255
ldx #<attpkt
ldy #>attpkt
jsr printpkt
inc attempt
lda attempt
sta imath$val
lda #0
sta imath$val+1
ldx #<buf
ldy #>buf
jsr itoa ;integer to ascii
ldx #<buf
ldy #>buf
jsr print
lda #$20
jsr chrout
rts
;1650/1660 dialer
;Called with:
; pnums = phone number string
;Returns:
; ACC = 0 => failed
; = 1 => connected
; = 255 => abort
goodsec ;address same as dgcnt
dgcnt .byte 0
waitsec ;address same as pulsecnt
pulsecnt .byte 0
.def dial1650
dial1650
lda #4 ;hang up phone, set DTR
sta ci2pra
lda #2 ;sleep 2 seconds
jsr sleep
lda #36 ;phone off-hook + DTR
sta ci2pra
lda #2 ;sleep 2 seconds
jsr sleep
lda #32
sta c2ddrb
lda #0 ;digit count = 0
sta dgcnt
dial16a
ldy dgcnt
inc dgcnt
lda pnums,y
beq dial16wait
pha
jsr chrout ;echo digit/character
pla
cmp #', ;comma?
bne dial16b
lda #2 ;2 second pause
jsr sleep
jmp dial16a
dial16b
cmp #'0 ;in range of valid digits?
bcc dial16a ;too low - ignore
cmp #'9+1
bcs dial16a ;too high - ignore
sec
sbc #'0 ;get numeric value
bne dial16c ;not zero?
lda #10 ;0 = 10 pulses
dial16c
sta pulsecnt
dial16d
ldx #3 ;wait 3/60 second
ldy #0
jsr tsleep
lda #0
sta ci2pra
ldx #2 ;delay
ldy #0
jsr tsleep
lda #32
sta ci2pra
dec pulsecnt
bne dial16d
ldx #7 ;delay between digits
ldy #0
jsr tsleep
jmp dial16a ;go do next digit
dial16wait
jsr dialwt ;wait for result code
rts
;Hayes dialer
;Called with:
; X,Y = address of phone number string
.def dialhayes
dialhayes
lda #4 ;set DTR, clear all else
sta ci2pra ;hang up
lda #2 ;sleep 2 seconds
jsr sleep
; lda #32 ;off hook
;12/05/86 - Bill Fink says that DTR must
;be held high on some Hayes compatibles
;in order to work properly. Add bit 2:
lda #36 ;off hook + DTR
sta ci2pra
lda #2 ;sleep again
jsr sleep
ldx #5 ;output to modem
jsr chkout
;This area will change when the new
;terminal loop is installed
ldx #<dialcmd ;send dial command
ldy #>dialcmd
jsr print
; lda #1 ;wait a second
; jsr sleep
ldx #<pnums ;phone number
ldy #>pnums
jsr println
jsr clrchn
jsr dialwt ;wait for carrier or keypress
rts ;returning result in ACC
dialwt
lda #0
sta waitsec
sta goodsec
dialwt1
lda #0 ;reset lsb of jiffy clock
sta jclock+2
dialwt2
lda modemtype ;hayes type modem?
beq dialwt21 ;no
jsr mdmrd
bcs dialwt21
tax ;convert to CBM ascii
lda asc2cbm,x
jsr chrout ;echo modem reply
dialwt21
lda goodsec ;have carrier?
bne dialwt22 ;yes - disable keyboard
jsr getin ;key pressed?
cmp #0
bne dialwabt ;yes - abort
dialwt22
lda ci2pra ;see if we have carrier
ora #47
cmp #47
beq dialwt3
lda #0 ;reset carrier count
sta goodsec
dialwt3
lda goodsec ;3 seconds with carrier?
cmp #3
beq dialwok
lda jclock+2 ;check timer
cmp #60 ;one second?
bcc dialwt2
inc goodsec ;will reset if carrier lost
inc waitsec ;count seconds waited
lda waitsec
cmp #30 ;waited 30 seconds?
bcc dialwt1 ;reset the clock
dialwfl ;failure exit
lda modemtype
beq dialwfl1 ;Hayes fail exit
lda #13 ;send C/R
jsr mdmwrt
lda #1
jsr sleep
dialwfl0
jsr mdmrd ;discard response
bcc dialwfl0
lda #0
rts
dialwfl1
lda #4 ;1650 fail exit
sta ci2pra ;hang up
rts
dialwok ;success exit
lda #1
rts
dialwabt
lda #4 ;hang up, but assert DTR
sta ci2pra
lda modemtype ;hayes type modem?
beq dialwabt1 ;no
lda #13
jsr mdmwrt ;output carriage return
dialwabt1
lda #2 ;abort exit
rts
;Prompt User for Phone Number
gpn
ldx #2
jsr eraseeos
lda hilite
ldx #<dlprpkt
ldy #>dlprpkt
jsr printpkt
;Prompt for phone number
lda #nbrleng
jsr gets
lda #<pnums ;make copy of string
sta string$1
lda #>pnums
sta string$1+1
lda #<buf
sta string$2
lda #>buf
sta string$2+1
jsr strcpy
rts
SHAR_EOF
fi # end of overwriting check
if test -f 'pprotocol.a'
then
echo shar: will not over-write existing file "'pprotocol.a'"
else
cat << \SHAR_EOF > 'pprotocol.a'
;MRTERM Punter Protocol Interface Package
;Filename: pprotocol.a
;
;History:
; 07/17/86 - make FILPRMPT external
; 08/22/86 - added printpkt, typenum calls
.nlst
#include "mem.i"
#include "kernal.i"
#include "char.i"
#include "printpkt.i"
.list
.ref center
.ref ckfile
.ref disk$ftyp,disk$status
.ref errmsg
.ref fclose
.ref gets
.ref itoa,imath$val
.ref mfill
.ref online,offline,hilite
.ref open$prg,open$seq
.ref ppdiskfn,ppftype
.ref pprcv,ppreset,pprtype,ppterm
.ref ppttype,ppxmit
.ref print,printpkt
.ref strcpy,string$1,string$2
.ref typenum
;Package Data
countflg .byte 0
badblks .word 0
goodblks .word 0
.def fname ;used elsewhere
fname .bss 25 ;file name
abrtstr .byte "File transfer aborted",0
badfile .byte "Bad file specification?",0
badstr .byte "Bad: ",0
badpkt
.byte PP$BUZZ
.byte 1,30
.word badstr
goodstr .byte "Good: ",0
goodpkt
.byte PP$NULL
.byte 1,0
.word goodstr
notopen .byte "File would not open",0
sendstr .byte "Punter Send",0
;***************************************
;Count and report good blocks transferred
.def pgood
pgood
lda countflg ;ok to count?
beq pgoodx
inc goodblks
bne pgood1
inc goodblks+1
pgood1
lda hilite
sta color
ldx #<goodpkt
ldy #>goodpkt
jsr printpkt
ldx goodblks
ldy goodblks+1
jsr typenum
lda online
sta color
pgoodx
rts
;Count and report bad blocks transferred
.def pbad
pbad
lda countflg ;ok to count?
beq pbadx
inc badblks
bne pbad1
inc badblks+1
pbad1
lda hilite
sta color
ldx #<badpkt
ldy #>badpkt
jsr printpkt
ldx badblks
ldy badblks+1
jsr typenum
lda online
sta color
pbadx
rts
;End of Punter transmission
.def pend
pend
rts
;Signal end of transmission, close file.
pdonestr .byte "File transfer complete",0
.def pdone
pdone
lda ppdiskfn ;close file
jsr fclose
lda offline
sta color
ldx #<pdonestr
ldy #>pdonestr
jsr errmsg ;flash and gong
rts
; Enter terminal mode
.def pterm
pterm
lda online ;online color
sta color
jsr ppreset
jsr ppterm
rts
;Prepare for transfer
prep
lda #0 ;reset block counters
sta goodblks
sta goodblks+1
sta badblks
sta badblks+1
sta countflg
;Fill color memory with online color
lda #<colormem ;fill color memory
sta ptr1
lda #>colormem
sta ptr1+1
lda #<1000 ;size of color memory
sta ptr2
lda #>1000
sta ptr2+1
lda online ;get online color
jsr mfill
rts
;Prompt for file name
;Called with:
; X,Y = prompt string address
filppkt
.byte PP$EOS|PP$BELL
.byte 22,0
filpadr
.word 0
.def filprmpt
filprmpt
stx filpadr ;store prompt address
sty filpadr+1 ;in packet
lda hilite
ldx #<filppkt
ldy #>filppkt
jsr printpkt ;display prompt
lda #18 ;18 characters max
jsr gets
lda #<fname ;make local copy
sta string$1
lda #>fname
sta string$1+1
lda #<buf
sta string$2
lda #>buf
sta string$2+1
jsr strcpy
rts
;Prompt for SEND file name
;Returns:
; ACC = first byte of filename
; (zero implies null response)
sendprmpt .byte "SEND File: ",0
.def sendpr
sendpr
ldx #<sendprmpt
ldy #>sendprmpt
sendpr1
jsr filprmpt
lda fname
rts
;Prompt for RECEIVE file name
;Returns:
; ACC = first byte of filename
rcvprmpt .byte "RECEIVE File: ",0
.def rcvpr
rcvpr
ldx #<rcvprmpt
ldy #>rcvprmpt
jmp sendpr1 ;share code with sendpr
;Receive a file
rcvstr .byte "Punter Receive",0
.def precv
precv
lda #clrscrn
jsr chrout
jsr prep ;prepare for transfer
ldx #<rcvstr
ldy #>rcvstr
jsr center
precv1
jsr rcvpr ;prompt for file name
beq precvx ;null response - abort
jsr ppreset
jsr pprtype ;receive file type
lda buf ;test status
cmp #1
beq pabort
inc countflg ;can now count blocks
ldx #<fname
ldy #>fname
lda ppftype
cmp #2 ;seq?
bne precvp ;program file
lda #'w ;write access
jsr open$seq
jmp precv2
precvp
lda #'w ;write access
jsr open$prg
precv2
bne precv3 ;good status?
ldx #<disk$status
ldy #>disk$status
jsr errmsg
jmp precv1 ;try again
precv3
sta ppdiskfn ;save file number
jsr ppreset
jsr pprcv ;receive file
jsr pdone ;close file, inform user
precvx
rts
pabort
ldx #<abrtstr
ldy #>abrtstr
jsr errmsg
rts
;Send a file
.def psend
psend
lda #clrscrn
jsr chrout
jsr prep
ldx #<sendstr
ldy #>sendstr
jsr center
jsr sendpr
beq psendx
ldx #<fname
stx string$1
ldx #>fname
stx string$1+1
ldx #<buf
stx string$2
ldx #>buf
stx string$2+1
jsr strcpy ;copy buf to fname
ldx #<fname
ldy #>fname
jsr ckfile ;test file's existence
beq psendf ;no such file?
lda disk$ftyp ;which file type?
cmp #'s ;sequential?
beq psends
cmp #'p ;program?
bne psendf
;Send program file
lda #1
sta ppftype
ldx #<fname
ldy #>fname
jsr open$prg
jmp psend1
psends
lda #2
sta ppftype
ldx #<fname
ldy #>fname
jsr open$seq
psend1
bne psend2
ldx #<disk$status
ldy #>disk$status
jsr errmsg
jmp psend
psend2
sta ppdiskfn
jsr ppreset
jsr ppttype
lda buf
cmp #1
bne psend3
jmp pabort
psend3
inc countflg ;start counting
jsr ppreset
jsr ppxmit
jsr pdone ;close file, inform user
psendx
rts
psendf ;failure exit
ldx #<badfile
ldy #>badfile
jsr errmsg
jmp psend ;try again
SHAR_EOF
fi # end of overwriting check
if test -f 'printer.a'
then
echo shar: will not over-write existing file "'printer.a'"
else
cat << \SHAR_EOF > 'printer.a'
;MRTERM Printer Routines
;Filename: printer.a
;History:
; 08/27/86 - 2.5 - New module
.nlst
#include "mem.i"
#include "kernal.i"
#include "mrterm.i"
#include "char.i"
.list
.ref openmodem
.ref pdvc,psa,pinit
.ref strlen
;Open the printer
.def opnptr
opnptr
lda #pfn ;file number
ldx pdvc ;device number
ldy psa ;secondary address
jsr setlfs
ldx #<pinit
ldy #>pinit
jsr strlen
ldx #<pinit
ldy #>pinit
jsr setnam
jsr open ;open printer
rts
;Close the printer
.def clsptr
clsptr
lda #pfn
jsr close
rts
;Output character to printer
.def prtchr
prtchr
pha ;save it
ldx #pfn
jsr chkout
pla
jsr chrout
jsr clrchn
rts
;Dump screen to printer
;Called with:
; ACC = logo$p => print
; ACC != logo$p => no print
;Note: all registers are left unchanged.
logo$p = 175
srow .byte 0
.def scrndmp
scrndmp
cmp #logo$p
bne sdx
php ;save all registers
pha
txa
pha
tya
pha
; lda #mdmfn ;close modem
; jsr close
jsr opnptr
lda #0
sta srow
sd1
lda #0
sta curx ;set cursor column
lda #40
sta indx ;set line length
sta crsw ;non-zero = input from screen
ldx srow
jsr $e9f0 ;compute screen line pointer
sd2
jsr $e632 ;get char from screen
jsr prtchr
lda crsw ;mode changed?
bne sd2 ;no - keep going
inc srow
ldx srow
cpx #25
bne sd1 ;do next line
jsr clsptr
; lda #mdmfn
; jsr openmodem
pla ;restore registers
tay
pla
tax
pla
plp
sdx
rts
DEBUG = 0
.ifeq DEBUG,1
;DEBUG code
sbase = 1024+320
cbase = 55296+320
.def start
start
ldx #0
fill
txa
sta sbase,x
lda #1 ;white
sta cbase,x
inx
bne fill
jsr scrndmp
rts
.fi
SHAR_EOF
fi # end of overwriting check
if test -f 'printpkt.i'
then
echo shar: will not over-write existing file "'printpkt.i'"
else
cat << \SHAR_EOF > 'printpkt.i'
;Code Definitons for PRINTPKT routine
;Filename: printpkt.i
;History:
; 08/17/86 - File created
;
;Description:
;
; This file may be included by any
;application package using the printpkt
;routine. Each equate defined herein
;represents the value of the bit or
;combination of bits as they appear in
;the code word. Combinations of bits are
;achieved by OR-ing (||) values together.
PP$NULL = 0
PP$EOL = 1 ;bit 0
PP$EOS = 2 ;bit 1
PP$CLR = 3 ;bits 0+1
PP$RVS = 4 ;bit 2
PP$BELL = 8 ;bit 3
PP$GONG = 16 ;bit 4
PP$BUZZ = 24 ;bits 3+4
PP$CENTER = 32 ;bit 5
PP$CR = 64 ;bit 6
PP$WAIT =128 ;bit 7
SHAR_EOF
fi # end of overwriting check
if test -f 'startup.a'
then
echo shar: will not over-write existing file "'startup.a'"
else
cat << \SHAR_EOF > 'startup.a'
;
;Provide Assembly Language with a BASIC
;startup statement. This segment MUST
;be the first segment linked, and the
;program MUST be linked at 2049 (dec)
;for this to work.
;
.ref start ;external label
.word link
.word 100 ;stmt number
.byte 158 ;'sys'
.byte "(2063)"
link
.byte 0,0,0 ;null stmt
;
;This address must match the value in
;parens, above.
;
jmp start
SHAR_EOF
fi # end of overwriting check
if test -f 'terminal.a'
then
echo shar: will not over-write existing file "'terminal.a'"
else
cat << \SHAR_EOF > 'terminal.a'
;MRTERM - Main Terminal Loop
;Filename: terminal.a
;
#include "mem.i"
#include "kernal.i"
#include "char.i"
.ref asc2cbm,cbm2asc
.ref bell,buzz
.ref blinkon,blinkoff
.ref bufrem
.ref clickon
.ref hilite
.ref kbget
.ref keysub
.ref klick
.ref mdmrd,mdmwrt
.ref offline,online
.ref pcbuf
.ref ppreset
.ref rcvfil
.ref rvsoff,rvson
.ref scrndmp
.ref sndfil
.ref togglebuf
;Logo key combinations
logo$b = $bf ;toggle buffer
logo$k = $a1 ;toggle key click
logo$p = $af ;screen to printer
logo$r = $b2 ;receive file
logo$s = $ae ;send file
.def term ;terminal loop
term
lda online ;set online color
sta color
jsr ppreset ;reset rs-232
jsr clrchn ;set I/O defaults
term0
jsr blinkon
jsr mdmrd
bcs keybd ;no modem character - test keyboard
pha
jsr blinkoff
pla
tax
lda asc2cbm,x ;translate
beq keybd ;ignore character
cmp #7 ;bell?
bne term1
jsr bell ;sound bell
jmp keybd
termx ;exit
lda offline ;set offline color
sta color
rts
term1
term2
pha
jsr chrout ;display character
lda #0
sta qtsw ;keep quote mode disabled
pla
jsr pcbuf ;output to buffer
;test keyboard
keybd
jsr kbget
beq term0 ;nothing available
pha
jsr blinkoff
pla
cmp #$83 ;shift run/stop?
beq termx ;exit
cmp #logo$k ;keyclick
bne kb01
lda klick
eor #1
sta klick
sta clickon
jmp term0
kb01
cmp #logo$b ;toggle buffer?
bne kb02
jsr togglebuf
jmp term0
kb02
cmp #logo$r ;receive file?
bne kb03
jsr rcvfil
jmp term0
kb03
cmp #logo$s ;send file?
bne kb04
jsr sndfil
jmp term0
kb04
cmp #logo$p ;screen to printer?
bne kb05
jsr scrndmp
jmp term0
kb05
jsr keysub ;function key?
cmp #0
bne keybd2
jmp term0
keybd2
; Add local echo code later...
tax
lda cbm2asc,x
bne keybd1
jsr buzz ;invalid character
jmp term0
keybd1
jsr mdmwrt ;send to modem
jmp term0 ;keep on truckin'
;Display terminal status
termstat
rts
SHAR_EOF
fi # end of overwriting check
if test -f 'trtable.a'
then
echo shar: will not over-write existing file "'trtable.a'"
else
cat << \SHAR_EOF > 'trtable.a'
;MRTERM Translation Tables and Related Routines
;Filename: trtable.a
;
#include "mem.i"
#include "kernal.i"
;CBM to ASCII translation table:
;
.def cbm2asc
cbm2asc
;0-31
.byte 0,1,2,3,4,5,6,7
.byte 8,9,10,11,12,13,14,15
.byte 16,17,18,19,8,21,22,23
.byte 24,25,26,27,28,29,30,31
;31-63
.byte 32,33,34,35,36,37,38,39
.byte 40,41,42,43,44,45,46,47
.byte 48,49,50,51,52,53,54,55
.byte 56,57,58,59,60,61,62,63
;64-95
.byte 64,97,98,99,100,101,102,103
.byte 104,105,106,107,108,109,110,111
.byte 112,113,114,115,116,117,118,119
.byte 120,121,122,91,92,93,94,95
;96-127
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,123,124,125,126,127
;128-159
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
.byte 0,0,127,12,0,0,0,0 ;INST => DEL (VMS)
.byte 0,0,0,0,0,0,0,0 ;CLR => FF
;160-191
.byte 0,0,0,0,137,0,0,0 ;logo-@ => underscore
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
;192-223
.byte 0,65,66,67,68,69,70,71
.byte 72,73,74,75,76,77,78,79
.byte 80,81,82,83,84,85,86,87
.byte 88,89,90,0,0,0,0,0
;224-255
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
;ASCII to CBM translation table:
;
.def asc2cbm
asc2cbm
;00-31
.byte 0,0,0,0,0,0,0,7
.byte 20,0,0,0,147,13,0,0
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
;32-63
.byte 32,33,34,35,36,37,38,39
.byte 40,41,42,43,44,45,46,47
.byte 48,49,50,51,52,53,54,55
.byte 56,57,58,59,60,61,62,63
;64-95
.byte 64,193,194,195,196,197,198,199
.byte 200,201,202,203,204,205,206,207
.byte 208,209,210,211,212,213,214,215
.byte 216,217,218,91,92,93,94,95
;96-127
.byte 0,65,66,67,68,69,70,71
.byte 72,73,74,75,76,77,78,79
.byte 80,81,82,83,84,85,86,87
.byte 88,89,90,123,98,125,126,127
;128-159
.byte 0,0,0,0,0,0,0,0
.byte 0,164,0,0,0,0,0,0 ;underscore => logo-@
.byte 0,0,0,0,0,0,0,0
.byte 0,0,0,0,0,0,0,0
;160-191
.byte 32,33,34,35,36,37,38,39
.byte 40,41,42,43,44,45,46,47
.byte 48,49,50,51,52,53,54,55
.byte 56,57,58,59,60,61,62,63
;192-223
.byte 64,193,194,195,196,197,198,199
.byte 200,201,202,203,204,205,206,207
.byte 208,209,210,211,212,213,214,215
.byte 216,217,218,91,92,93,94,95
;224-255
.byte 0,65,66,67,68,69,70,71
.byte 72,73,74,75,76,77,78,79
.byte 80,81,82,83,84,85,86,87
.byte 88,89,90,0,0,0,0,0
.def itrtbl ;initialize translation tables
itrtbl
rts
SHAR_EOF
fi # end of overwriting check
if test -f 'xmprotocol.a'
then
echo shar: will not over-write existing file "'xmprotocol.a'"
else
cat << \SHAR_EOF > 'xmprotocol.a'
;MRTERM XMODEM Protocol Support
;Filename: xmprotocol.a
;History:
; 08/22/86 - 2.5 - added printpkt, typenum calls
; 09/06/86 - 3.0 - fixed xmstat bug
; 09/15/86 - 3.1 - added XMODEM modes
;
;This file contains routines which are
;common to both the send and receive
;functions. The send and receive
;routines are in separate source files
;which are included by this package.
.nlst
#include "mem.i"
#include "kernal.i"
#include "char.i"
#include "printpkt.i"
.list
;*** .ref's to array.a ***
.ref mfill
;*** .ref's to disk.a: ***
.ref bkrd,bkwt
.ref ckfile
.ref eraseeos
.ref fclose
.ref open$prg,open$seq
;*** .ref's to global.a ***
.ref hilite,offline,online,protocol
;*** .ref's to modem.a ***
.ref mdmrd,mdmwrt
;*** .ref's to screen.a, termio.a: ***
.ref center
.ref errmsg
.ref flush
.ref kbwait
.ref print,println,printpkt
.ref typenum
;*** .ref's to sid.a ***
.ref bell,buzz,gong
;*** .ref's to pprotocol.a ***
.ref fname ;file name string
.ref rcvpr ;prompt for receive file
.ref sendpr ;prompt for send file
;Package equates
ACK = $06 ;acknowlege
CAN = $18 ;cancel
EOT = $04 ;end of text
NAK = $15 ;negative acknowlege
SOH = $01 ;start of header
bufadr = 1024+80 ;buffer is screen memory
fbsize = 6*128 ;six 128 byte blocks
endbuf = bufadr+fbsize+1 ;1 past end of buffer
mblock = $33c ;modem buffer block
stline = 23 ;status display line number
;**************************************
;Package data
badblks .byte 0 ;0..255
block .byte 0
ch .byte 0
cksum .byte 0 ;checksum
crcflag .byte 0
crctest .word 0 ;received from sender
crcword .word 0 ;crc value
dkstat .byte 0 ;previous disk status
dfn .byte 0 ;disk file number
endptr .word 0 ;end of block list
fbleng .word 0 ;actual length of buffer
goodblks .word 0 ;good block count
head .word 0 ;beginning of block list
mode .byte 0 ;0 = checksum, $43 (C) = crc
modemmask .byte 0
notblock .byte 0
retry .byte 0
thisblock .byte 0
lastblock .byte 0
stack .byte 0 ;saves stack pointer
temp .word 0
;Message Strings
badchar .byte "Bad character received",0
badchk .byte "Checksum error",0
badcrc .byte "CRC error",0
badstr .byte "Bad: ",0
badpkt
.byte PP$NULL
.byte 1,30
.word badstr
blkchk .byte "Block/Notblock error",0
blkerr .byte "Block error",0
canmsg .byte "Transfer CANcelled",0
eotmsg .byte "EOT received",0
goodstr .byte "Good: ",0
goodpkt
.byte PP$NULL
.byte 1,0
.word goodstr
nosuch .byte "No such file?",0
onlysp .byte "Can only send SEQ or PRG files!",0
seqerr .byte "Block sequence error",0
switchmsg .byte "Switching to checksum mode",0
timmsg .byte "Timeout",0
waitmsg .byte "Waiting...",0
xfrbad .byte "Transfer aborted.",0
xfrok .byte "Transfer completed.",0
;Initialize file block buffer pointers
fbinit
lda #<bufadr
sta head
sta endptr
lda #>bufadr
sta head+1
sta endptr+1
rts
;Flush the file block buffer
;Called with:
; ACC = file number (disk or modem)
fbflush
lda head ;test for empty buffer
cmp #<bufadr
bne fbflush1
lda head+1
cmp #>bufadr
bne fbflush1
rts ;nothing to write out
fbflush1
lda #<bufadr ;set address of data
sta ptr1 ;for bkwt call
lda #>bufadr
sta ptr1+1
sec ;compute number of bytes to
lda head ;transfer, place in
sbc #<bufadr ;X,Y
tax
lda head+1
sbc #>bufadr
tay
lda dfn ;retrieve file number
jsr bkwt
lda #<bufadr ;reset head pointer
sta head
lda #>bufadr
sta head+1
rts
;Calculate new crc word from current character
calc$crc
;crcword = crcword ^ ch << 8 (^ = bitwise xor)
lda crcword+1
eor ch
sta crcword+1
;for (i = 0; i < 8; i++)
; if (crcword & 0x800)
; crcword = crcword << 1 ^ 0x1021;
; else
; crcword = crcword << 1;
;
ldx #0
calc$crc1
lda crcword+1
and #$80
pha ;save high order bit result
asl crcword
rol crcword+1
pla ;retrieve high order bit result
beq calc$crc2 ;hi bit zero?
lda #$21
eor crcword
sta crcword
lda #$10
eor crcword+1
sta crcword+1
calc$crc2
inx
cpx #8
bne calc$crc1
rts
;Display XMODEM Status Message and
;Sound Gong
;Called with:
; X,Y = string pointer
statpkt
.byte PP$EOL|PP$GONG
.byte stline,0
statadr
.word 0
xmstat
lda #PP$EOL|PP$GONG
sta statpkt
xmstat0 ;shared entry
stx statadr
sty statadr+1
lda hilite
ldx #<statpkt
ldy #>statpkt
jsr printpkt
rts
;Display status message with no gong
xmstat1
lda #PP$EOL
sta statpkt
bne xmstat0
;Timed Modem Read
;Called with:
; X,Y = number of jiffies to wait
;Returns:
; carry set = failed
; ACC = 0
; carry clear = got a character
; ACC = character code
tmdmrd
stx ptr1
sty ptr1+1
lda #0
sta jclock+2
sta jclock+1
tmdmrd1
jsr mdmrd
bcc tmdmrdx
jsr xmstop ;user wants stop?
sec ;test time interval
lda jclock+2
sbc ptr1
lda jclock+1
sbc ptr1+1
bcc tmdmrd1
lda #0 ;timeout - return null
sec ;and set carry
tmdmrdx
rts
;1 second timed read from modem
mdm1sec
ldx #60 ;60 jiffies = 1 second
ldy #0
jmp tmdmrd ;share code above
;10 second timed read from modem
mdm10sec
ldx #<600 ;600 jiffies = 10 seconds
ldy #>600
jmp tmdmrd
;Purge the modem buffer of any
;extraneous characters
mdmpurge
jsr mdm1sec
bcc mdmpurge
rts
;Count good blocks transferred and
;report them to the screen.
xmgood
inc goodblks
bne xmgood1
inc goodblks+1
xmgood1
lda hilite
sta color
ldx #<goodpkt
ldy #>goodpkt
jsr printpkt
ldx goodblks
ldy goodblks+1
xmgood2 ;shared code
jsr typenum
lda offline
sta color
rts
;Count and report bad blocks
xmbad
lda hilite
sta color
ldx #<badpkt
ldy #>badpkt
jsr printpkt
inc badblks
ldx badblks
ldy #0
beq xmgood2
;Perform initialization common to
;send and receive.
xminit
lda #0
sta crcword
sta crcword+1
sta cksum
sta retry
sta goodblks
sta goodblks+1
sta badblks
jsr fbinit ;initialize file block buffer
lda #1
sta thisblock
sta lastblock
ldx #20 ;erase lines 20-24
jsr eraseeos
rts
;Check for SHIFT RUN/STOP. IF pressed,
;close file and exit.
xmstop
jsr getin
cmp #$83
beq xmstop1
xmstopx
rts
xmstop1
ldx #5
jsr chkout
lda #CAN ;send control-x
jsr chrout
jsr clrchn
lda dfn
jsr fclose ;close file
jsr flush
ldx #<xfrbad
ldy #>xfrbad
jsr errmsg
xmstop2
pla ;discard stack byte
tsx
cpx stack
bne xmstop2
rts
;**************************************
#include "xmrcv.i"
;**************************************
#include "xmsnd.i"
SHAR_EOF
fi # end of overwriting check
if test -f 'xmrcv.i'
then
echo shar: will not over-write existing file "'xmrcv.i'"
else
cat << \SHAR_EOF > 'xmrcv.i'
;MRTERM XMODEM Receive Routines
;Filename: xmrcv.i
;Note: This file is included by
; xmprotocol.a
;History:
; 08/22/86 - 2.5 - use printpkt
; 09/15/86 - 3.1 - add XMODEM mode options
;
;Receive File
xrcrc .byte "XMODEM/CRC Receive",0
xrchk .byte "XMODEM/CHECKSUM Receive",0
xrtitle
ldx #0
jsr eraseln
lda offline
sta color
lda protocol
cmp #1
bne xrtitl1
ldx #<xrcrc
ldy #>xrcrc ;assumes xrcrc > 256, of course
bne xrtitl2
xrtitl1
ldx #<xrchk
ldy #>xrchk
xrtitl2
jsr center
lda online
sta color
rts
.def xrecv
xrecv
tsx ;save stack pointer
stx stack
lda #clrscrn
jsr chrout
jsr xrtitle
jsr rcvpr ;prompt for receive file name
beq xrecvx
jsr asktype ;get receive file type
cmp #0 ;null response?
beq xrecvx
ldx #<fname
ldy #>fname
cmp #'s ;sequential?
beq xrecv1 ;yes
lda #'w ;write access
jsr open$prg ;open program file
jmp xrecv2
xrecv1
lda #'w
jsr open$seq ;open sequential file
xrecv2
sta dfn ;save file number
beq xrecvx ;failure?
lda protocol
cmp #1 ;CRC mode?
bne xrecv3
lda #$43 ;set initial mode to crc
sta mode
lda #1
sta crcflag
bne xrecv4
xrecv3
lda #NAK
sta mode
lda #0
sta crcflag
xrecv4
jsr xmrecv ;receive the file
xrecvx
jsr clrchn
lda dfn
jsr fclose
rts
;Ask for receive file type
typeprmpt .byte "File type (p or s): ",0
typpkt
.byte PP$EOL|PP$BELL|PP$WAIT
.byte 23,0
.word typeprmpt
asktype
lda hilite
ldx #<typpkt
ldy #>typpkt
jsr printpkt
cmp #13 ;carriage return?
bne asktype2
lda #0 ;return null
asktypex
rts
asktype2
cmp #'p ;program
beq asktypex
cmp #'s ;sequential
beq asktypex
jsr buzz ;indicate bad response
jmp asktype ;try again
;Receive file
xmrecv
jsr xminit ;initialize for transfer
ldx #<waitmsg
ldy #>waitmsg
jsr xmstat
xmr0
jsr mdmpurge ;purge modem
lda mode ;send mode preference
jsr mdmwrt
xmr1 ;top of loop
lda retry
cmp #11 ; retry > 10?
bcc xmr10 ;no
jmp xmr5 ;yes - exit
xmr10
jsr mdm10sec
sta ch
bcc xmr2 ;branch on good status
ldx #<timmsg ;Timeout
ldy #>timmsg
jsr xmstat
lda retry
inc retry
cmp #3 ;retry > 3?
bcc xmr11 ;no
lda crcflag ;crc mode?
cmp #1
bne xmr11
lda #0
sta crcflag
ldx #<switchmsg
ldy #>switchmsg
jsr xmstat
xmr11
lda #NAK ;select 'send block' command
ldx crcflag
cpx #1
bne xmr12
lda #$43 ; 'C' crc mode
xmr12
jsr mdmwrt
jmp xmr1 ;to top of loop
xmr2 ;got a character
lda ch
cmp #SOH ;start of header
bne xmr3
lda crcflag ;first SOH in crc mode?
cmp #1
bne xmr21
inc crcflag ;'lock in' to crc mode
xmr21
lda #0
sta crcword
sta crcword+1
jsr getmdmblk ;get a modem block
bcs xmr22 ;failed?
lda #ACK ;send acknowledge
jsr mdmwrt
ldx #stline ;erase status line
jsr eraseln
jsr xmgood ;count good blocks
lda #0 ;reset retry count
sta retry
jmp xmr1
xmr22
jmp xmr41
xmr3
cmp #EOT ;end of text?
bne xmr4
ldx #<eotmsg
ldy #>eotmsg
jsr xmstat
lda #ACK ;acknowledge
jsr mdmwrt
jmp xmr5
xmr4 ;unknown character
ldx #<badchar
ldy #>badchar
jsr xmstat
xmr41
inc retry
jsr mdmpurge
jmp xmr11 ;go send NAK
xmr5 ;transfer complete or aborted
jsr fbflush
lda ch ;good or bad termination
cmp #EOT
bne xmrf
ldx #<xfrok
ldy #>xfrok
jsr errmsg
rts
xmrf
ldx #<xfrbad
ldy #>xfrbad
jsr errmsg
rts
;Transfer modem block to block buffer
mb2fb
clc ;head+128 > endbuf ?
lda head
adc #128
sta temp
lda head+1
adc #0
sta temp+1
sec
lda temp
sbc #<endbuf
lda temp+1
sbc #>endbuf
bcc mb2fb1
jsr fbflush ;flush to disk
clc ;set buffer to bufadr+128
lda #<bufadr
adc #128
sta temp
lda #>bufadr
adc #0
sta temp+1
mb2fb1
lda head
sta ptr1
lda head+1
sta ptr1+1
ldy #0
mb2fb2 ;copy modem block to buffer
lda mblock,y
sta (ptr1),y
iny
cpy #128
bne mb2fb2
lda temp ;update head pointer
sta head
lda temp+1
sta head+1
rts
;Get 1 block from the modem
cnt .byte 0
getmdmblk
lda #0
sta cnt
jsr mdm1sec ;1 second timed read
bcs getmdmto
sta block
jsr mdm1sec
bcs getmdmto
sta notblock
sec ;block + notblock + 1 == 0 ?
adc block
beq getmdmb1
ldx #<blkchk
ldy #>blkchk
jsr xmstat
getmdmf ;failure exit
jsr xmbad
jsr mdmpurge
sec ;bad status indicator
rts
getmdmto ;timeout
ldx #<timmsg
ldy #>timmsg
jsr xmstat
jmp getmdmf
getmdmb1
lda block
cmp thisblock
beq getmdmb2
cmp lastblock
beq getmdmb2
ldx #<seqerr
ldy #>seqerr
jsr xmstat
jmp getmdmf
getmdmb2
lda #0
sta cksum
sta cnt
getmdmb3
jsr mdm1sec
bcs getmdmto ;timeout?
sta ch
ldx cnt
sta mblock,x
inc cnt
ldx crcflag ;crc or checksum?
bne getmdmb4
clc ;compute checksum
adc cksum
sta cksum
jmp getmdmb5
getmdmb4
jsr calc$crc ;update crc word
getmdmb5
lda cnt
cmp #128
bne getmdmb3 ;get next character
;End of block - test checksum or crc
;Get checksum or 1st crc byte from sender
jsr mdm1sec
bcs getmdmto
sta ch
ldx crcflag ;which mode?
beq getmdmb6 ;checksum
sta crctest+1
jsr mdm1sec
bcs getmdmto
sta crctest
cmp crcword
bne getmdmcrcf
lda crctest+1
cmp crcword+1
bne getmdmcrcf
beq getmdmb7
getmdmb6 ;test checksum
cmp cksum ;match checksum?
beq getmdmb7 ;yes
ldx #<badchk ;no
ldy #>badchk
jsr xmstat
jmp getmdmf
getmdmb7 ;good block
lda block
cmp thisblock
bne getmdmbx
jsr mb2fb ;write block to buffer
lda thisblock
sta lastblock
inc thisblock
getmdmbx
clc ;set good status indicator
rts
getmdmcrcf ;crc error
ldx #<badcrc
ldy #>badcrc
jsr xmstat
jmp getmdmf
SHAR_EOF
fi # end of overwriting check
if test -f 'xmsnd.i'
then
echo shar: will not over-write existing file "'xmsnd.i'"
else
cat << \SHAR_EOF > 'xmsnd.i'
;MRTERM XMODEM Send Routines
;Filename: xmsnd.i
;Note: This file is included by
; xmprotocol.a
;
;Send File
xsendtitle .byte "XMODEM Send",0
.def xsend
xsend
tsx ;save stack pointer
stx stack
lda #clrscrn
jsr chrout
ldx #<xsendtitle
ldy #>xsendtitle
jsr center
jsr sendpr ;prompt for send file name
beq xsendx
ldx #<fname ;check file's existence
ldy #>fname
jsr ckfile
beq xsendnf ;no file?
ldx #<fname :prepare to open
ldy #>fname
cmp #'p ;program?
beq xsend1
cmp #'s ;sequential?
beq xsend2
ldx #<onlysp
ldy #>onlysp
jmp xsenderr
xsend1
lda #'r
jsr open$prg ;open prg file
jmp xsend3
xsend2
lda #'r
jsr open$seq ;open seq file
xsend3
sta dfn ;save file number
beq xsendnf ;big boo-boo
lda #$43 ;set initial mode to crc
sta mode
jsr xmsend ;do file transfer
xsendx
lda dfn
jsr fclose
rts
xsendnf ;no such file?
ldx #<nosuch
ldy #>nosuch
xsenderr
jsr errmsg
jmp xsend
;Send file
nakcnt .byte 0 ;NAK counter
xmsend
lda #0 ;dkstat = 0
sta dkstat
sta nakcnt
jsr xminit ;general initialization
jsr mdmpurge ;purge modem
jsr fb2mb ;get first block to send
bne xms0
jmp xmseot
xms0
ldx #<waitmsg
ldy #>waitmsg
jsr xmstat1
xms1
lda retry ;retry < 11?
cmp #11
bcc xms10
xmsf ;failure exit
ldx #<xfrbad
ldy #>xfrbad
jsr errmsg
rts
xms10
jsr mdm10sec
bcc xms2
;timeout
xmsto
ldx #<timmsg
ldy #>timmsg
jsr xmstat
inc retry
bne xms1
xms2
pha
ldx #stline ;erase status line
jsr eraseln
pla
cmp #NAK ;normal mode
bne xms3
inc nakcnt
lda nakcnt ;1st NAK? (sets mode)
cmp #1
beq xms21
jsr xmbad ;was a bad block
inc retry
xms21
jsr putmdmblk ;output modem block
jmp xms1 ;to top of loop
xms3
cmp #$43 ;'C' ?
bne xms4
inc crcflag
bne xms21
xms4
cmp #ACK ;good block transferred?
bne xms5
lda #0 ;reset retry counter
sta retry
jsr xmgood ;update good block display
inc thisblock
jsr fb2mb ;get next block
beq xmseot ;end of file?
jmp xms21 ;send next block
xms5
cmp #CAN ;control-X?
beq xms51
ldx #<badchar
ldy #>badchar
jsr xmstat
inc retry
jmp xms1
xms51 ;cancel transmission
ldx #<canmsg
ldy #>canmsg
jsr xmstat
xmseot
lda #EOT
jsr mdmwrt
jsr mdm10sec
bcc xmsx
cmp #ACK
beq xmsx
lda #EOT ;send EOT once more
jsr mdmwrt
xmsx
ldx #<xfrok
ldy #>xfrok
jsr errmsg
rts
;Fill buffer area from disk
;Returns:
; X,Y = Actual number of bytes read
fbfill
lda dkstat ;get old disk status
beq fbfill1 ;zero is good
ldx #0
ldy #0
rts
fbfill1
lda #<bufadr ;fill buffer with zeros
sta ptr1
lda #>bufadr
sta ptr1+1
ldx #<fbsize ;parameter conventions
stx ptr2 ;for mfill should be altered
ldy #>fbsize
sty ptr2+1
lda #0
jsr mfill
lda #<bufadr
sta ptr1
lda #>bufadr
sta ptr1+1
ldx #<fbsize
ldy #>fbsize
lda dfn
jsr bkrd
stx fbleng
sty fbleng+1
sta dkstat
;endptr = bufadr + fbfill()
clc
txa
adc #<bufadr
sta endptr
tya
adc #>bufadr
sta endptr+1
lda #<bufadr
sta head
lda #>bufadr
sta head+1
rts ;actual length in X,Y
;Get a 128 byte modem block from the buffer
fb2mb
sec
lda head ;head < endptr?
sbc endptr
lda head+1
sbc endptr+1
bcc fb2mb1 ;yes
jsr fbfill ;no - fill buffer
sec
lda head ;head < endptr? (test again)
sbc endptr
lda head+1
sbc endptr+1
bcc fb2mb1 ;yes
fb2mbf ;no more data
lda #0 ;nothing read
rts ;return
fb2mb1
lda head
sta ptr1
lda head+1
sta ptr1+1
ldy #0
fb2mb2
lda (ptr1),y
sta mblock,y
iny
cpy #128
bne fb2mb2
clc
lda head
adc #128
sta head
lda head+1
adc #0
sta head+1
lda #128 ;ACC = byte count
rts
;Output modem block to other system
putcnt .byte 0
putmdmblk
lda #SOH
jsr mdmwrt
lda thisblock
jsr mdmwrt
lda thisblock
eor #$ff ;one's complement
jsr mdmwrt
lda #0
sta cksum
sta crcword
sta crcword+1
sta putcnt
putmdm1
ldx putcnt
lda mblock,x
sta ch
jsr mdmwrt
lda crcflag
beq putmdm10
jsr calc$crc ;compute crc word
jmp putmdm2
putmdm10
clc
lda cksum
adc ch
sta cksum
putmdm2
inc putcnt
lda putcnt
cmp #128
bne putmdm1
lda crcflag ;checksum or CRC mode?
beq putmdm3
lda crcword+1 ;CRC mode
jsr mdmwrt ;output CRC word
lda crcword
jsr mdmwrt
jmp putmdm4
putmdm3 ;checksum mode
lda cksum ;output checksum byte
jsr mdmwrt
putmdm4
rts
SHAR_EOF
fi # end of overwriting check
# End of shell archive
exit 0
--
| Mark R. Rinfret, SofTech, Inc. mark@unisec.usi.com |
| Guest of UniSecure Systems, Inc., Newport, RI |
| UUCP: {gatech|mirror|cbosgd|uiucdcs|ihnp4}!rayssd!unisec!mark |
| work: (401)-849-4174 home: (401)-846-7639 |