Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!husc6!mit-eddie!ll-xn!ames!necntc!rayssd!unisec!mark
From: mark@unisec.usi.com (Mark Rinfret)
Newsgroups: comp.sys.cbm
Subject: C-ASSM Sources - Part 02/02
Message-ID: <509@unisec.usi.com>
Date: Thu, 14-May-87 07:54:21 EDT
Article-I.D.: unisec.509
Posted: Thu May 14 07:54:21 1987
Date-Received: Sat, 16-May-87 12:11:35 EDT
Organization: UniSecure Systems, Inc. Newport, RI
Lines: 2521
Keywords: C-Power C-ASSM assembly-langeuuage source
#! /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:
# mem.i
# menu.a
# printpkt.i
# punter.a
# screen.a
# sid.a
# startup.a
# stdlib.ctl
# string.a
# syslib.ctl
# termio.a
# This archive created: Thu May 14 06:56:46 1987
export PATH; PATH=/bin:$PATH
if test -f 'mem.i'
then
echo shar: will not over-write existing file "'mem.i'"
else
cat << \SHAR_EOF > 'mem.i'
;
; C64 Memory Assignments
; Filename: mem.i
;
; Zero-page Equates
; -----------------
;
;History:
;
curx = $d3 ;cursor 'x' position
col = $d3 ;an alias for curx
crsw = $d0 ;screen/keyboard flag
cury = $d6 ;cursor 'y' position
row = $d6 ;an alias for cury
d6510 = $00 ;data direction register
dfltn = $99 ;default input device
dflto = $9a ;default output device
fa = $ba ;current device number
fnadr = $bb ;filename
fnlen = $b7 ;filename length
indx = $c8 ;end of logical line
jclock = $a0 ;jiffy clock
la = $b8 ;current logical file
lstx = $c5 ;matrix coord. of last keypress
ptr1 = $fb ;pointer ($fb..$fc)
ptr2 = $fd ;pointer ($fd..$fe)
ptr3 = $c3 ;pointer ($c3..$c4)
;
r6510 = $01 ;memory map register
ribuf = $f7 ;rs-232 input buffer pointer
robuf = $f9 ;rs-232 output buffer pointer
rvs = $c7 ;reverse video flag
;
sa = $b9 ;current secondary address
status = $90 ;kernal i/o status byte
;
; *************************************
;
; Non-Zero Page Variables
baudof = $299 ;rs-232 bit time
buf = 512 ;input buffer
color = 646 ;current character color
colormem = $d800 ;color ram
enabl = $2a1 ;rs-232 busy flag
m51ajb = $295 ;rs-232 non-standard bit time
qtsw = 212 ;quote mode switch
rsstat = $297 ;rs-232 status register
SHAR_EOF
fi # end of overwriting check
if test -f 'menu.a'
then
echo shar: will not over-write existing file "'menu.a'"
else
cat << \SHAR_EOF > 'menu.a'
; General Menu Support Routines
; Filename: menu.a
;
.nlst
#include "mem.i" ;standard memory definitions
#include "char.i" ;character code definitions
#include "kernal.i" ;kernal vectors
#include "printpkt.i" ;printpkt code values
.list
.ref buzz
.ref center
.ref kbwait
.ref print,println,printpkt
.ref rvson,rvsoff
; Package parameters:
.def menu$list
menu$list
.word 0 ;list of string pointers
titlpkt
.byte PP$CLR|PP$CENTER ;clear screen, center text
.byte 0,0
.def menu$title
menu$title
.word 0 ;title string address
;NOTE: menu$title must NOT be moved! It
;is part of the title packet.
infomsg
.byte "Position to the desired command and hit\n"
.byte "RETURN or enter the first character of\n"
.byte "any command.",0
infopkt
.byte PP$NULL
.byte 21,0 ;row,column
.word infomsg ;string address
chr .byte 0 ;character temp
index .byte 0
lastx .byte 0 ;last index value
.def menu
menu
lda #255
pha ;save it - we'll use it soon
ldx #titlpkt
jsr printpkt
pla
ldx #infopkt
jsr printpkt
lda #0 ;initialize menu index
sta index
menu1 ;display all commands
jsr menupos
jsr menustr
cpx #0 ;end of list?
bne menu2
cpy #0
bne menu2
beq menu3
menu2
jsr println
lda index ;remember last valid entry
sta lastx
inc index
bne menu1
menu3
lda #0
sta index
menu4
jsr menupos ;set cursor position
jsr rvson ;set reverse mode
jsr menustr ;get current menu string
jsr print
jsr rvsoff ;disable reverse mode
jsr kbwait ;wait for keypress
pha ;save character on stack
jsr menupos
jsr menustr ;retrieve menu string
jsr print ;print it, normal mode
pla ;check keyboard character
cmp #13 ;carriage return?
beq menux ;yep - return
cmp #csrdn ;down?
bne menu5
;move down to next item
ldx index
cpx lastx ;at last one?
beq menu3 ;yes - start over
inc index ;no - advance to next
bne menu4
menu5
cmp #csrup ;up?
bne menu6
ldx index ;yes
bne menu51
ldx lastx ;wrap to end of list
stx index
bne menu4
menu51
dec index ;back up to previous
bpl menu4
menu6
sta chr ;save keyboard character
cmp #'a ;first letter of a command?
bcc menu7
cmp #'z+1
bcc menu8 ;match against strings
menu7
jsr buzz ;make a nasty sound
jmp menu4
menu8 ;check 1st char of all strings
lda index
pha ;save index
lda #0
sta index
menu9
jsr menustr ;get menu string
stx ptr1 ;store in zp pointer
sty ptr1+1
ldy #0
lda (ptr1),y ;get 1st character
and #$7f ;force lower case
cmp chr ;same as keyboard?
beq menu10
inc index
ldx lastx
inx
cmp index ;beyond last index?
bcs menu9 ;nope
pla ;restore old index
sta index
bcc menu7 ;go give user a buzz
menu10
pla ;discard index from stack
menux
lda #clrscrn ;clear the screen
jsr chrout
lda index
rts
;
; Get menu string pointer from
; string pointer list (menu$list+index).
; Returns:
; string pointer in X,Y
;
menustr
clc
lda index
rol A ;times 2
adc menu$list
sta ptr1
lda #0
adc menu$list+1
sta ptr1+1
ldy #0
lda (ptr1),y
tax
iny
lda (ptr1),y
tay
rts
;
; Set cursor position per 'index'
;
menupos
clc
lda index
adc #3
tax ;row
ldy #0 ;column
jsr plot
rts
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 'punter.a'
then
echo shar: will not over-write existing file "'punter.a'"
else
cat << \SHAR_EOF > 'punter.a'
;New Punter Protocol
;Adapted for C-ASSM Assembler for Pro-Line C-Power
;by Mark Rinfret
;
;Filename: punter.a
;History:
; 05/08/86 - changed escape key to shift run/stop
; 05/20/86 - disk file number is now
; externally defined
; 05/21/86 - removed C-Power calls for
; the asm version.
; 05/22/86 - enable transfer of all control characters,
; call bell sound effect for bell
;
;Conditional assembly switches:
c$term = 0 ;0 => no terminal loop code
;Externally defined symbols:
;
.def ppaccept,ppexit,ppinit
.def pprcv,ppxmit
.def pprtype,ppterm,ppreset,ppttype
.def ppbtime,ppftype,ppdiskfn
;The old 'dashes, colons and stars' display
;has been replaced with calls to 'pgood'
;and 'pbad' and pend (good block, bad block
;end block, respectively).
.ref pgood,pbad,pend
.ref bell ;sound effect for bell code
;Note: The buffer location must be chosen
;with care. The current location is the
;third line of the screen memory area.
;This allows the first two lines of the
;display to be used for information lines.
;In transmit mode, two buffers are used,
;thus occupying locations $0480-$067f or
;lines 2-16.
buffer = $0450 ;buffer for block (screen)
fa = $ba ;current device number
pnta = $62
pntb = $64
stat = $96
defto = $9a ;default output device (kernal)
ptr1 = $9e ;tape pass1 error log (kernal)
bufpntr = $a6 ;tape i/o buffer pointer [2]
tape1 = $b2 ;start of tape buffer pointer [2]
ribuf = $f7 ;rs232 input buffer pointer
robuf = $f9 ;rs232 output buffer pointer
ci2cra = $dd0e ;control register a
lastch = $200 ;last used character
ridbe = $29b
ridbs = $29c
rodbs = $29d ;rs232 output buffer start
rodbe = $29e ;rs232 output buffer end
rs232enb = $02a1 ;rs232 enable=128, disable=255
ibsout = $326 ;chrout routine vector (kernal) [2]
shflag = $28d ;shift/logo key flag
ti2alo = $dd04 ;timer 2 lo byte
ti2ahi = $dd05 ;timer 2 hi byte
;
codebuf .byte 0,0,0 ;incoming 3 char codes
bitpnt .byte 0 ;bit pointer for allowable matches
bitcnt .byte 0 ;bit counter (0 to 4)
bitpat .byte 0 ;bit pattern for searches
timer1 .word 0 ;timer for non-received characters (2)
gbsave .byte 0 ;good bad signal needed
bufcount .word 0 ;number of chrs to buffer into block
delay .byte 0 ;delay for wait period
skpdelay .byte 0 ;delay skip counter
endflag .byte 0 ;last block flag
check .bss 4 ;primary checksum (4)
check1 .bss 4 ;secondary checksum (4)
bufpnt .byte 0 ;current buffer pointer
recsize .byte 0 ;received buffer size
maxsize .byte 255 ;maximum block size
blocknum .word 0 ;block number (2)
ppdiskfn .byte 0 ;disk file number
ppftype .byte 0 ;file type (from basic)
stack .byte 0 ;stack pointer at entry
dontdash .byte 1 ;suppress dashes and colons
specmode .byte 0 ;special start code flag
oldout .word 0 ;old chrout vector
;
;ppbtime must be set by the calling program.
;The formula for calculating it is
; ppbtime = 1.02273e6 / baud rate
; = 852 for 1200 baud
; = 3409 for 300 baud
;
ppbtime .word 3409 ;??? timer value ???
;
;buffer positions
;
sizepos = 4
numpos = 5
datapos = 7
;
basic4 = $ef06 ;basic call from chrout
basic3 = $ef3b ;basic call from chrout
setup = $ef7e ;set up rs232 to receive again
;
;kernal locations
;
basic1 = $f80d ;basic call from chrout
basic2 = $f864 ;basic call from chrout
readst = $ffb7
chkin = $ffc6 ;open channel for input
chkout = $ffc9 ;open channel for output
clrchn = $ffcc ;close input and output channels
chrin = $ffcf ;input character from channel
chrout = $ffd2 ;output character to channel
getin = $ffe4 ;get a character from keyboard queue
zfffe = $fffe
;
startloc
;
ppaccept
lda #0 ;sys 49152 accept
.byte $2c
pprcv
lda #3 ;sys 49155 receive
.byte $2c
ppxmit
lda #6 ;sys 49158 transmit
.byte $2c
pprtype
lda #9 ;sys 49161 rectype
.byte $2c
ppttype
lda #12 ;sys 49164 trantype
.byte $2c
ppterm
lda #15 ;sys 49167 term
nop
jmp over
ppreset
jmp reset
jmp ppinit
;
over
sta pnta
tsx
stx stack
lda #table
adc #$00
sta jmppoint+2
jmppoint
jmp table
;
table
jmp accept
jmp receive
jmp transmit
jmp rectype
jmp trantype
jmp terminal
jmp ppinit
;
codes
.byte "goo"
.byte "bad"
.byte "ack"
.byte "s/b"
.byte "syn"
;
;accept characters and check for codes
;
accept
sta bitpat ;save required bit pattern
lda #$00
sta codebuf
sta codebuf+1
sta codebuf+2
cd1
lda #$00
sta timer1 ;clear timer
sta timer1+1
cd2
jsr exit
jsr getnum ;get#5,a$
lda stat
bne cd3 ;if no chr, do timer check
lda codebuf+1
sta codebuf
lda codebuf+2
sta codebuf+1
lda lastch
sta codebuf+2
lda #$00
sta bitcnt ;clear bit counter
lda #$01
sta bitpnt ;initialize bit pointer
cd4
lda bitpat ;look at bit pattern
bit bitpnt ;is bit set
beq cd5 ;no, don't check this code word
ldy bitcnt
ldx #$00
cd6
lda codebuf,x
cmp codes,y
bne cd5
iny
inx
cpx #$03
bne cd6
jmp cd7
;
cd5
asl bitpnt ;shift bit pointer
lda bitcnt
clc
adc #$03
sta bitcnt
cmp #15
bne cd4
jmp cd1
;
cd7
lda #255
sta timer1
sta timer1+1
jmp cd2
;
cd3
inc timer1
bne cd9
inc timer1+1
cd9
lda timer1+1
ora timer1
beq cd8
lda timer1
cmp #$07
lda timer1+1
cmp #20
bcc cd2
lda #$01
sta stat
jmp dodelay
;
cd8
lda #$00
sta stat
rts
;
;get# for c64
;
getnum1
nop
getnum
tya
pha
lda ridbe
cmp ridbs
beq get1
ldy ridbs
lda (ribuf),y
pha
inc ridbs
lda #$00
sta stat
pla
sta lastch
pla
tay
jmp dorts
;
get1
lda #$02
sta stat
lda #$00
sta lastch
pla
tay
;
dorts
pha
lda #$03 ;current device = screen
sta fa
pla
rts
;
;send a code
;
sendcode
ldx #$05
jsr chkout
ldx #$00
sn1
lda codes,y
jsr chrout
iny
inx
cpx #$03
bne sn1
jmp clrchn
;
;do handshaking for reception end
;
rechand
sta gbsave ;save good or bad signal as needed
lda #$00
sta delay ;no delay
rc1
lda #$02
sta pnta
ldy gbsave
jsr sendcode ;send g/b signal
rc9
lda #%00100 ;allow "ack" signals
jsr accept ;wait for code
lda stat
beq rc2 ;if ok, send g/b signal again
dec pnta
bne rc9
jmp rc1
;
rc2
ldy #$09
jsr sendcode ;send "s/b" code
lda endflag
beq rc5
lda gbsave
beq rc6
rc5
lda buffer+sizepos
sta bufcount
sta recsize
jsr recmodem ;wait for block
lda stat
cmp #%0001 ;check for good block
beq rc4
cmp #%0010 ;check for blank input
beq rc2
cmp #%0100 ;check for loss of signal
beq rc4
cmp #%1000 ;check for "ack" signal
beq rc2
rc4
rts
;
rc6
lda #%10000 ;wait for "syn" signal
jsr accept
lda stat
bne rc2 ;if not, send "s/b" again
lda #10
sta bufcount
rc8
ldy #12 ;send "syn" signal
jsr sendcode
lda #%01000 ;wait for "s/b" signal
jsr accept
lda stat
beq rc7
dec bufcount
bne rc8
rc7
rts
;
;do handshaking for transmission end
;
tranhand
lda #$01
sta delay ;use delay
tx2
lda specmode
beq tx20
ldy #$00
jsr sendcode ;send a "goo" signal
tx20
lda #%01011 ;allow "goo", "bad", and "s/b"
jsr accept ;wait for codes
lda stat
bne tx2 ;if no signal, wait again
lda #$00
sta specmode
lda bitcnt
cmp #$00 ;"good" signal
bne tx10 ;no, resend old block
lda endflag
bne tx4
inc blocknum
bne tx7
inc blocknum+1
tx7
jsr thisbuf
ldy #numpos ;block number high order part
iny
lda (pntb),y
cmp #255
bne tx3
lda #$01
sta endflag
lda bufpnt
eor #$01
sta bufpnt
jsr thisbuf
jsr dummybl1
jmp tx1
;
tx3
jsr dummyblk ;yes, get new block
tx1
jsr pgood
jmp tx100
tx10
jsr pbad ;bad block
tx100
ldy #$06
jsr sendcode ;send "ack" code
lda #%01000 ;allow only "s/b" code
jsr accept ;wait for code
lda stat
bne tx1
jsr thisbuf
ldy #sizepos ;block size
lda (pntb),y
sta bufcount
jsr altbuf
ldx #$05
jsr chkout
ldy #$00
tx6
lda (pntb),y ;transmit alternate buffer
jsr chrout
iny
cpy bufcount
bne tx6
jsr clrchn
lda #$00
rts
;
tx4
jsr clrchn
jsr pend ;last block
ldy #$06
jsr sendcode ;send "ack" signal
lda #%01000
jsr accept ;wait for "s/b" signal
lda stat
bne tx4 ;if not, resend "ack" signal
lda #10
sta bufcount
tx5
ldy #12
jsr sendcode ;send "syn" signal
lda #%10000
jsr accept ;wait for "syn" signal back
lda stat
beq tx8
dec bufcount
bne tx5
tx8
lda #$03
sta bufcount
tx9
ldy #$09
jsr sendcode ;send "s/b" signal
lda #$00000
jsr accept ;just wait
dec bufcount
bne tx9
lda #$01
rts
;
;receive a block from the modem
;
; stat returns with:
;
; bit 0 - buffered all characters successfully
; bit 1 - no characters received at all
; bit 2 - insufficient characters received
; bit 3 - "ack" signal received
;
recmodem
ldy #$00 ;start index
rcm5
lda #$00 ;clear timers
sta timer1
sta timer1+1
rcm1
jsr exit
jsr getnum ;get a chr from the modem
lda stat
bne rcm2 ;no character received
lda lastch
sta buffer,y ;save chr in buffer
cpy #$03 ;chr one of the first 3
bcs rcm3 ;no, skip code check
sta codebuf,y ;save chr in code buffer
cpy #$02 ;on the 3rd chr
bne rcm3 ;no, don't look at chrs yet
lda codebuf ;check for a "ack" signal
cmp #'a
bne rcm3
lda codebuf+1
cmp #'c
bne rcm3
lda codebuf+2
cmp #'k
beq rcm4 ;"ack" found
rcm3
iny ;inc index
cpy bufcount ;buffered all chrs
bne rcm5 ;no, buffer next
lda #%0001 ;yes, return bit 0 set
sta stat
rts
;
rcm4
lda #$ff ;"syn" found, set timer to -1
sta timer1
sta timer1+1
jmp rcm1 ;see if there is another chr
;
rcm2
inc timer1 ;inc timer
bne rcm6
inc timer1+1
rcm6
lda timer1
ora timer1+1 ;timer now at zero
beq rcm7 ;"syn" found with no following chrs
lda timer1
cmp #$06
lda timer1+1
cmp #16 ;time out yet
bne rcm1 ;no, get next chr
lda #%0010 ;yes, set bit 1
sta stat
cpy #$00
beq rcm9
lda #%0100 ;but if chrs received, set bit 2
sta stat
rcm9
jmp dodelay
;
rcm7
lda #%1000 ;"ack" found, set bit 2
sta stat
rts
;
;create dummy block for transmission
;
dummyblk
lda bufpnt
eor #$01
sta bufpnt
jsr thisbuf ;read block into "this" buffer
ldy #numpos ;block number
lda blocknum
clc
adc #$01
sta (pntb),y ;set block number low part
iny
lda blocknum+1
adc #$00
sta (pntb),y ;set block number high part
ldx ppdiskfn
jsr chkin
ldy #datapos ;actual block
db1
jsr chrin
sta (pntb),y
iny
jsr readst
bne db4
cpy maxsize
bne db1
tya
pha
jmp db5
;
db4
tya
pha
ldy #numpos ;block number
iny ;high part
lda #255
sta (pntb),y
jmp db5
;
dummybl1
pha ;save size of just read block
db5
jsr clrchn
jsr reset
jsr dod2
jsr reset
ldy #sizepos ;block size
lda (pntb),y
sta bufcount ;set bufcount for checksum
jsr altbuf
pla
ldy #sizepos ;block size
sta (pntb),y
jsr checksum
rts
;
;set pointers for current buffer
;
thisbuf
lda #buffer
sta pntb+1
rts
;
;set pointer b for alternate buffer
;
altbuf
lda #buffer
sta pntb+1
rts
;
;calculate checksum
;
checksum
lda #$00
sta check1
sta check1+1
sta check1+2
sta check1+3
ldy #sizepos
cks1
lda check1
clc
adc (pntb),y
sta check1
bcc cks2
inc check1+1
cks2
lda check1+2
eor (pntb),y
sta check1+2
lda check1+3
rol a ;set or clear carry flag
rol check1+2
rol check1+3
iny
cpy bufcount
bne cks1
ldy #$00
lda check1
sta (pntb),y
iny
lda check1+1
sta (pntb),y
iny
lda check1+2
sta (pntb),y
iny
lda check1+3
sta (pntb),y
rts
;
;transmit a program
;
transmit
lda #$00
sta endflag
sta skpdelay
sta dontdash
lda #$01
sta bufpnt
lda #$ff
sta blocknum
sta blocknum+1
jsr altbuf
ldy #sizepos ;block size
lda #datapos
sta (pntb),y
jsr thisbuf
ldy #numpos ;block number
lda #$00
sta (pntb),y
iny
sta (pntb),y
trm1
jsr tranhand
beq trm1
rec3
lda #$00
sta lastch
rts
;
;receive a file
;
receive
lda #$01
sta blocknum
lda #$00
sta blocknum+1
sta endflag
sta bufpnt
sta buffer+numpos ;block number
sta buffer+numpos+1
sta skpdelay
lda #datapos
sta buffer+sizepos ;block size
lda #$00
rec1
jsr rechand
lda endflag
bne rec3
jsr match ;do checksums match
bne rec2 ;no
jsr clrchn
lda bufcount
cmp #datapos
beq rec7
ldx ppdiskfn
jsr chkout
ldy #datapos
rec6
lda buffer,y
jsr chrout
iny
cpy bufcount
bne rec6
jsr clrchn
rec7
lda buffer+numpos+1 ;block number high order part
cmp #$ff
bne rec4
lda #$01
sta endflag
jsr clrchn
jsr pend ;signal last block
jmp rec40
rec4
jsr pgood ;signal good block
rec40
jsr reset
lda #$00
jmp rec1
;
rec2
jsr clrchn
jsr pbad ;signal bad block
lda recsize
sta buffer+sizepos
lda #$03
jmp rec1
;
;see if checksums match
;
match
lda buffer
sta check
lda buffer+1
sta check+1
lda buffer+2
sta check+2
lda buffer+3
sta check+3
jsr thisbuf
lda recsize
sta bufcount
jsr checksum
lda buffer
cmp check
bne mtc1
lda buffer+1
cmp check+1
bne mtc1
lda buffer+2
cmp check+2
bne mtc1
lda buffer+3
cmp check+3
bne mtc1
lda #$00
rts
;
mtc1
lda #$01
rts
;
;receive file type block
;
rectype
lda #$00
sta blocknum
sta blocknum+1
sta endflag
sta bufpnt
sta skpdelay
lda #datapos
clc
adc #$01
sta buffer+sizepos
lda #$00
rct3
jsr rechand
lda endflag
bne rct1
jsr match
bne rct2
lda buffer+datapos
sta ppftype
lda #$01
sta endflag
lda #$00
jmp rct3
;
rct2
lda recsize
sta buffer+sizepos
lda #$03
jmp rct3
;
rct1
lda #$00
sta lastch
rts
;
;transmit file type
;
trantype
lda #$00
sta endflag
sta skpdelay
lda #$01
sta bufpnt
sta dontdash
lda #255
sta blocknum
sta blocknum+1
jsr altbuf
ldy #sizepos ;block size
lda #datapos
clc
adc #$01
sta (pntb),y
jsr thisbuf
ldy #numpos ;block number
lda #255
sta (pntb),y
iny
sta (pntb),y
ldy #datapos
lda ppftype
sta (pntb),y
lda #$01
sta specmode
trf1
jsr tranhand
beq trf1
lda #$00
sta lastch
rts
;
;do delay for timing
;
dodelay
inc skpdelay
lda skpdelay
cmp #$03
bcc dod1
lda #$00
sta skpdelay
lda delay
beq dod2
bne dod3
;
dod1
lda delay
beq dod3
;
dod2
ldx #$00
lp1
ldy #$00
lp2
iny
bne lp2
inx
cpx #120
bne lp1
dod3
rts
.ifne 0,0 ;don't assemble prtdash
;
;print dash, colon, or star
;
prtdash
pha
lda blocknum
ora blocknum+1
beq prtd1
lda dontdash
bne prtd1
pla
jsr chrout
pha
prtd1
pla
rts
.fi ;end of non-assembled code
;
;reset rs232 port
;
reset
jsr setup
lda rs232enb
cmp #$80
beq reset
cmp #$92
beq reset
rts
;
;terminal emulation routine
;
terminal
.ifne c$term,0
jsr cursor
term
jsr getnum1
lda stat
bne keybj
lda lastch
and #$7f
sta lastch
cmp #$07 ;bell?
bne term1
jsr bell ;one ringy-dingy...
jmp keyboard
term1
cmp #$08 ;backspace?
beq ok1
cmp #$0d ;return?
beq ok1
cmp #$20 ;control character?
bpl ok1 ;no
cmp #$0c ;form feed? (clear screen)
bne keybj
lda #147 ;commodore clear screen
jmp ok6
;
keybj
jmp keyboard
;
ok1
cmp #'a+$20
bcc ok2
cmp #'z+$21
bcs ok2
sec
sbc #$20
sta lastch
jmp ok3
;
ok2
cmp #$41
bcc ok3
cmp #'z+1
bcs ok3
clc
adc #$80
sta lastch
;
ok3
cmp #$08 ;ASCII backspace
bne ok4
lda #$14 ;CBM delete
sta lastch
ok4
cmp #34 ;quote
bne ok5
jsr chrout
lda #$14 ;delete quote
jsr chrout
lda #34 ;??
ok5
lda lastch
cmp #$0d
bne ok6
lda #$20 ;space before return
jsr chrout
lda #$0d
ok6
jsr chrout
jsr cursor
;
keyboard
jsr getin
beq term
sta lastch
cmp #$83 ;shift run/stop key
beq termout
cmp #'a
bcc ok7 ;<"a"
cmp #'z+1
bcs ok7 ;>"z"
clc
adc #$20 ;to lowercase ascii
sta lastch
jmp ok8
;
ok7
lda lastch
cmp #'a+$80
bcc ok8 ;<"a"
cmp #'z+$81
bcs ok8 ;>"z"
sec
sbc #$80 ;to uppercase ascii
sta lastch
;
ok8
cmp #20 ;backspace
bne ok9
lda #$08
sta lastch
ok9
cmp #$83 ;shift r/s
bne oka
lda #$10 ;ctrl p
sta lastch
oka
ldx #$05
jsr chkout
lda lastch
jsr chrout
jsr clrchn
jmp term
;
termout
.fi ;end of conditional assembly
rts ;with shift run/stop
;
.ifne c$term,0
cursor
lda #$12
jsr chrout
lda #$20
jsr chrout
lda #$9d
jsr chrout
lda #$92
jsr chrout
.fi
;
;check for commodore key
;
exit
lda shflag ;is commodore key down?
cmp #$02
bne exit1
exit2
pla
tsx
cpx stack
bne exit2
exit1
lda #$01
sta lastch
rts
;
;Initialize this package.
;move chrout vector if necessary
;
ppinit
lda ibsout ;been moved yet
cmp #newout
beq ppinit2 ;yes, leave it
ppinit1
lda ibsout ;store old chrout vector
sta oldout
lda ibsout+1
sta oldout+1
lda #newout
sta ibsout+1
ppinit2
rts
;
;Restore C-Power environment
;
ppexit
lda ibsout
cmp #newout
bne ppexitx
sei
lda oldout
sta ibsout
lda oldout+1
sta ibsout+1
cli
ppexitx
rts
;
;new chrout routine to correct for 1200 baud speed problems
;
newout
pha ;duplicate original kernal routines
lda defto ;test default output device for
cmp #$03 ;screen, and...
bne newout1
pla ;if so, go back to original rom routines
jmp (oldout)
;
newout1
bcc newout2 ;if device number less than 3,
pla ;also go back to original kernal routines
jmp (oldout)
;
newout2
lsr a ;tape or modem?
pla
sta ptr1
txa
pha
tya
pha
bcc newout9 ;modem
jsr basic1 ;tape
bne newout5
jsr basic2
bcs newout7
lda #$02
ldy #$00
sta (tape1),y
iny
sty bufpntr
newout5
lda ptr1
sta (tape1),y
newout6
clc
newout7
pla
tay
pla
tax
lda ptr1
bcc newout8
lda #$00
newout8
rts
;
;New modem output routine
;
newout9
jsr newout10
jmp newout6
;
newout11
jsr newout12
newout10
ldy rodbe
iny
cpy rodbs
beq newout11
sty rodbe
dey
lda ptr1
sta (robuf),y
;
newout12
lda rs232enb
lsr a
bcs newout13
lda #$10 ;force latched value load
sta ci2cra
lda ppbtime ;activate baud rate timer
sta ti2alo ;timer 2 lo byte
lda ppbtime+1
sta ti2ahi ;timer 2 hi byte
lda #$81
jsr basic3
jsr basic4
lda #$11
sta ci2cra
newout13
rts
;
SHAR_EOF
fi # end of overwriting check
if test -f 'screen.a'
then
echo shar: will not over-write existing file "'screen.a'"
else
cat << \SHAR_EOF > 'screen.a'
;
; Screen Oriented Routines
; Filename: screen.a
;
; History:
; 08/09/86 - MRR - modified BLINKON to
; set blink counter to 2
#include "mem.i"
#include "kernal.i"
.ref flush
.ref gong
.ref imath$val,itoa
.ref print,println
.ref strlen
;Enable blinking cursor
blnct = $cd ;count to next blink
blnon = $cf ;1 = not blinked
blnsw = $cc ;blink switch
.def blinkon
blinkon
lda blnsw ;already on?
beq blinkonx
lda #0
sta blnsw
lda #2 ;set blink count to 2
sta blnct
blinkonx
rts
;Disable blinking cursor
.def blinkoff
blinkoff
sei ;prevent interrupts
lda blnon
bne blnkofx ;char in normal state
lda #1 ;set blink wait to 1 jiffy
sta blnct
cli ;enable interrupts
blnkof1
lda blnon ;wait for unblink
beq blnkof1
blnkofx
lda #1 ;disable further blinking
sta blnsw
cli ;enable interrupts
rts
;
; Center string at current row
; Called with:
; string pointer in X,Y
leng .byte 0
.def center
center
txa ;string address to stack
pha
tya
pha
jsr strlen
sta leng
cmp #38 ;39 or greater?
bcc center1 ;no
lda #0
jmp center2
center1
lda #40
sec
sbc leng
clc
ror A ;div. by 2
center2
tay
ldx row ;use current row
clc
jsr plot ;position cursor
pla ;retrieve string address
tay
pla
tax
jsr print
rts
;
;Wait for carriage return
;
crmsg .byte "Press RETURN to continue...",0
.def crwait
crwait
ldx #crmsg
jsr errmsg
cmp #13 ;CR?
bne crwait
rts
;Erase to end of line
;Called with:
; X,Y = starting row,column
;Returns:
; cursor set to starting row,column
.def eraseeol
eraseeol
stx ptr1 ;save x and y
sty ptr1+1
ldy #39 ;end of line
jsr $e9f0 ;compute screen line pointer
jsr $ea24 ;calculate color ram pointer
eraseeol1
lda #$20 ;space code
sta ($d1),y ;store space
jsr $e4da ;store background color
dey
cpy ptr1+1 ;at desired column?
bpl eraseeol1
clc ;unnecessary?
ldx ptr1
ldy ptr1+1
jsr plot ;position cursor
rts
;Erase to End of Screen
;Called with:
; X = starting row
.def eraseeos
eraseeos
jsr eraseln
inx
cpx #25
bcc eraseeos
rts
;
;Print flashing error message on line 24,
;wait for a keypress to return.
;Called with:
; string address in X,Y
;Returns:
; ACC = response character
errstr .word 0;
.def errmsg
errmsg
stx errstr
sty errstr+1
ldx #24 ;clear screen line
jsr eraseln
jsr flush ;empty keyboard buffer
errmsg1
jsr gong ;audible alarm
lda #0
sta jclock+2 ;zero jiffy clock lsb
lda rvs ;get reverse flag
eor #$12 ;toggle bits
sta rvs
errmsg2
ldx #24
ldy #0
clc
jsr plot
ldx errstr
ldy errstr+1
jsr print
jsr getin ;test keyboard
cmp #0
bne errmsg3
lda jclock+2 ;test clock
cmp #20 ;1/3 second elapsed?
bcc errmsg2 ;no
bcs errmsg1 ;yes
errmsg3
pha ;save response
jsr rvsoff
ldx #24 ;erase the line
jsr eraseln
pla ;ACC = response
rts
;Type an integer number at the current
;cursor location.
;Called with:
; X,Y = number
.def typenum
typenum
stx imath$val
sty imath$val+1
ldx #buf
jsr itoa ;integer to ascii
ldx #buf
jsr print
rts
;
; Enable reverse video
;
.def rvson
rvson
pha ;save ACC
lda #18
rvson1
sta rvs
pla ;restore ACC
rts
;
; Disable reverse video
;
.def rvsoff
rvsoff
pha ;save ACC
lda #0
beq rvson1 ;share code above
;Enable raster
.def raster
raster
lda $d011 ;VIC control register
ora #$10 ;bit 4 = 1 => enable
sta $d011
rts
;Disable raster
.def noraster
noraster
lda $d011
and #$ef ;bit 4 = 0 => disable
sta $d011
rts
SHAR_EOF
fi # end of overwriting check
if test -f 'sid.a'
then
echo shar: will not over-write existing file "'sid.a'"
else
cat << \SHAR_EOF > 'sid.a'
;
;Sound Interface Device (SID) Routines
;Filename: sid.a
;
sid = 54272
sid$lf = sid
sid$hf = sid+1
sid$lp = sid+2
sid$hp = sid+3
sid$wv = sid+4
sid$ad = sid+5
sid$sr = sid+6
;
;
;initialize sid chip
;
.def sid$init
sid$init
ldx #0
lda #0
sid$init1
sta sid,x
inx
cpx #25
bne sid$init1
lda #15 ;max volume
sta sid+24
rts
;
; buzzing sound
;
.def buzz
buzz
lda #0
sta sid$lf ;freq. lo
sta sid$ad ;attack/decay
lda #8
sta sid$hf
lda #169 ;sustain/release
sta sid$sr
lda #33 ;sawtooth
sta sid$wv
lda #32 ;start sustain/release
sta sid$wv
rts
;
;gong sound
;
.def gong
gong
lda #12
gong1 ;shared entry
sta sid$hf
lda #0
sta sid$lf
sta sid$ad ;attack/decay
lda #169 ;sustain/release
sta sid$sr
lda #17 ;triangle
sta sid$wv
lda #16 ;start sustain/release
sta sid$wv
rts
;
.def bell
bell
lda #24 ;twice gong frequency
bne gong1
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 'stdlib.ctl'
then
echo shar: will not over-write existing file "'stdlib.ctl'"
else
cat << \SHAR_EOF > 'stdlib.ctl'
a
imath.o
array.o
string.o
termio.o
disk.o
menu.o
screen.o
sid.o
clock.o
s
stdlib.l
q
SHAR_EOF
fi # end of overwriting check
if test -f 'string.a'
then
echo shar: will not over-write existing file "'string.a'"
else
cat << \SHAR_EOF > 'string.a'
;;String routines
;Filename: string.a
;History:
; 08/30/86 - added tabstr,gci,pci and modified strlen to use
; the new get and put routines.
;
#include "mem.i"
; Global Data
.def string$1,string$2
string$1 .word 0 ;first string parameter
string$2 .word 0 ;second string parameter
; Local Data
length .byte 0 ;short (0-255) length
;Compute string length
;Called with:
; X,Y = string address
;Returns:
; ACC = number of bytes in string
.def strlen
strlen
stx gci+1 ;set string pointer
sty gci+2
ldy #0
strlen1
jsr gci
beq strlen2
iny
bne strlen1
dey ;string overflow - set max
strlen2
tya ;return length in A
rts
;Copy string to string
;Called with:
; string$1 = address of destination
; string$2 = address of source
;
;Note: string 2 MUST be terminated
;with a null byte. Also, string 1 must
;be long enough to hold all of string 2
;or clobbered storage will result.
;Uses zero page pointers ptr1, ptr2
.def strcpy
strcpy
lda string$1
sta ptr1
lda string$1+1
sta ptr1+1
strcpy0
lda string$2
sta ptr2
lda string$2+1
sta ptr2+1
ldy #0
strcpy1
lda (ptr2),y
sta (ptr1),y
beq strcpyx
iny
bne strcpy1
strcpyx
rts
;Concatenate string to string
;Called with:
; string$1 = address of destination
; string$2 = address of source
;
;Note: a call to strcpy may be followed
;by a call to strcat, without setting up
;string$1 again. However, multiple calls
;to strcat require restoring string$1
;since it is modified here.
.def strcat
strcat
ldx string$1
ldy string$1+1
jsr strlen ;compute length of destination string
clc ;add length to destination address
adc string$1
sta string$1
lda string$1+1
adc #0
sta string$1+1
jmp strcpy ;share code above
;Tabulate String
;This routine pads the argument string
;with spaces up to the specified column
;where column begins with 0. Thus, calling
;this routine with a column parameter of
;zero has no effect.
;
;Called with:
; ACC = column number (non-inclusive)
; X,Y = string address
.def tabstr
tabstr
cmp #0
beq tabstrx
pha ;save desired length
jsr strlen ;get current length
sta length ;store actual length
sec ;compute spaces needed
pla ;retrieve current length
sbc length
bcc tabstrx ;already have it
tay ;Y = number of spaces
lda gci+1 ;move 'get' address
sta pci+1 ;to 'put' address
lda gci+2
sta pci+2
lda #32 ;space
tabstr1
jsr pci
dey
bne tabstr1
tabstrx
rts
;Internal, self-modifying routine to
;get 1 character and increment the
;string pointer if the result is non-zero.
;Prior to calling this routine, the
;address field of the first instruction
;must be set to the string address.
;Returns:
; ACC = character code
; ZERO flag
;
;Note: the behavior of gci/pci is
;depended upon by certain other routines.
;Modify only with CAUTION!
gci
lda $ffff
bne gci1
rts
gci1
pha
inc gci+1
bne gcix
inc gci+2
gcix
pla
rts
;Internal, self-modifying routine to
;store 1 character and increment the
;address pointer.
pci
sta $ffff
inc pci+1
bne pcix
inc pci+2
pcix
rts
SHAR_EOF
fi # end of overwriting check
if test -f 'syslib.ctl'
then
echo shar: will not over-write existing file "'syslib.ctl'"
else
cat << \SHAR_EOF > 'syslib.ctl'
a
punter.o
s
syslib.l
q
SHAR_EOF
fi # end of overwriting check
if test -f 'termio.a'
then
echo shar: will not over-write existing file "'termio.a'"
else
cat << \SHAR_EOF > 'termio.a'
;
; MRTERM Terminal Input/Output Routines
; Filename: termio.a
; History:
; 08/13/86 - expand gets legal characters
; 08/21/86 - remove length restriction from print,println
; 08/31/86 - fixed keyclick
.nlst
#include "kernal.i"
#include "mem.i"
#include "char.i"
#include "printpkt.i"
.list
.ref bell
.ref blinkon
.ref blinkoff
.ref buzz
.ref center
.ref eraseeol
.ref eraseeos
.ref gong
.ref rvson,rvsoff
;External Data
.def clickon
clickon .byte 0 ;non-zero => enable click
;======================================
;
; Print the null terminated string
; pointed to by X,Y. The string may
; be any length.
;
print$eol .byte 0 ;end of line flag
.def print
print
lda #0
print1
sta print$eol
stx ptr1 ;store address in zero
sty ptr1+1 ;page pointer
ldy #0
print2
lda (ptr1),y
beq print3
jsr chrout ;print character
inc ptr1
bne print2
inc ptr1+1
bne print2
;
print3
lda print$eol ;println?
beq printx
jsr chrout ;send return
printx
rts
;
.def println
println
lda #13 ;carriage return
jmp print1 ;share code
;Packetized Print
;Called With:
; ACC = color code (255 => current color)
; X,Y = packet address
;Returns:
; ACC = keyboard code (if PP$WAIT set)
;
;Notes:
; This is a very flexible routine which
;will economize on generated code if
;consistently used in an application
;which does lots of cursor positioning
;and screen I/O. The format of the
;5 byte packet, pointed to by X,Y is:
;
; Byte 0 - flag word
;
; bits 0,1 = erase code
; 00 PP$NULL => no erase
; 01 PP$EOL => erase to end of line before printing
; 10 PP$EOS => erase to end of screen before printing
; 11 PP$CLR => erase entire screen
;
; bit 2 = reverse flag
;
; bits 3,4 = sound effect code
; 00 PP$NULL => none
; 01 PP$BELL => bell PP$BELL
; 10 PP$GONG => gong PP$GONG
; 11 PP$BUZZ => buzz PP$BUZZ
;
; bit 5 PP$CENTER = center
; The COL parameter will be ignored and
; the specified text will be centered
; on the specified ROW
;
; bit 6 PP$CR = carriage return
;
; bit 7 PP$WAIT = wait for keypress and
; return it in ACC
; (set to zero)
;
; Byte 1 - row (0..24) or negative (128..255) (current)
;
; Byte 2 - column (0..39) or negative (current)
;
; Bytes 3,4 - address of null-terminated string
;
;Reverse mode is ALWAYS disabled upon
;exiting this routine. Also, the current
;character color is always restored to
;the color that was current upon entry.
;
pktinfo ;starting address for packet info
code .byte 0 ;print code
prow .byte 0 ;row
pcol .byte 0 ;column
padr .word 0 ;string address
.def printpkt
printpkt
stx ptr1
sty ptr1+1
ldx color ;save current color
cmp #$ff ;color specified?
beq ppkt0 ;no
sta color ;yes
ppkt0
txa ;save color code
pha
ldy #0
ppkt1
lda (ptr1),y ;copy packet
sta pktinfo,y
iny
cpy #5
bne ppkt1
lda prow ;current row?
bpl ppkt10
lda row ;transfer current to parameter
sta prow
ppkt10
lda pcol
bpl ppkt11
lda col
sta pcol
ppkt11
lda #PP$RVS ;reverse mode?
bit code
beq ppkt2
jsr rvson
ppkt2 ;sound effects?
lda code
and #PP$BUZZ
beq ppkt3 ;no sound
cmp #PP$BELL
bne ppkt21
jsr bell
jmp ppkt3
ppkt21
cmp #PP$GONG
bne ppkt22
jsr gong
jmp ppkt3
ppkt22
jsr buzz
ppkt3 ;erase/position
ldx prow ;prepare to position
ldy pcol
lda code
and #$03 ;get erase code
beq ppkt4 ;none?
cmp #PP$EOL ;erase to end of line?
bne ppkt31
jsr eraseeol
jmp ppkt4
ppkt31
cmp #PP$EOS
bne ppkt32
jsr eraseeos
jmp ppkt4
ppkt32 ;clear screen
lda #clrscrn
jsr chrout
ppkt4 ;position cursor, test for centering
clc
ldx prow
ldy pcol
jsr plot ;position cursor
ldx padr ;get string address
ldy padr+1
lda #PP$CENTER ;centering?
bit code
beq ppkt41 ;no
jsr center ;yes
jmp ppkt42
ppkt41
jsr print
ppkt42 ;want carriage return?
lda #PP$CR
bit code
beq ppktx
lda #13
jsr chrout
ppktx
pla ;restore color
sta color
jsr rvsoff ;disable reverse
lda #PP$WAIT ;wait for keyboard?
bit code
beq ppktxx
jsr kbwait ;wait for a key
ppktxx
rts
;
;Centralized routine for getting
;characters from the keyboard.
;If a character is gotten, an audible
;click is generated if 'clickon' is
;non-zero.
;Returns:
; ACC = character or 0
; Zero flag
voice2 = 54279
.def kbget
kbget
jsr getin
pha
beq kbgetx
ldx clickon ;click enabled?
beq kbgetx
lda #0 ;kill voice
sta voice2+4
lda #90 ;freq-hi
sta voice2+1
lda #0 ;A/D
sta voice2+5
lda #160 ;S/R
sta voice2+6
lda #33
sta voice2+4 ;start/stop
ldx #0
kbget1
nop ;delay loop
inx
bne kbget1
lda #32
sta voice2+4
kbgetx
pla
rts
;
;Wait for keyboard character
;Returns:
; ACC = character
.def kbwait
kbwait
jsr clrchn ;insure defaults
jsr flush ;empty keyboard buffer
kbwait1
jsr kbget ;get character
beq kbwait1
rts
;
;Flush keyboard input buffer
.def flush
flush
lda #0
sta 198 ;NDX = number of chars buffered
rts
;
;Get a string from the keyboard
;Called with:
; ACC = max input length
;Returns:
; ACC = actual input length
; text stored in system buffer (buf/512)
leng .byte 0
max .byte 0
.def gets
gets
sta max
lda #0
sta leng
gets1
jsr blinkon ;enable cursor
jsr kbget ;get character
beq gets1
pha
jsr blinkoff
pla
cmp #13 ;return?
beq getsx ;exit
cmp #del ;delete?
bne gets2
ldy leng ;length > 0?
dey
bmi gets1
sty leng ;store adjusted length
pha ;save delete code
lda #0 ;store null here
sta buf,y
pla ;restore delete code
jsr chrout ;print delete code
jmp gets1 ;go get some more
gets2
cmp #$20 ;control character?
bcc gets1 ;ignore
cmp #97
bcc gets21 ;yes - ok
cmp #'A ; A <= char <= Z ?
bcc gets1 ;no - ignore
cmp #'Z+1
bcs gets1
gets21
ldy leng
cpy max ;at maximum?
bne gets3
jsr buzz ;razz him
jmp gets1 ;don't store it
gets3
sta buf,y ;store new character
jsr chrout ;print it
inc leng
bne gets1
getsx
ldy leng
lda #0
sta buf,y ;null terminator
tya ;return length
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 |