home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
ucsdappleii
/
asm.kermit.text
< prev
next >
Wrap
Text File
|
2020-01-01
|
16KB
|
437 lines
;-----------------------------------------------------------------------
;-----------------------------------------------------------------------
;
; This procedure is external to the unit kermpack.
;
;-----------------------------------------------------------------------
;-----------------------------------------------------------------------
;
;FUNCTION rpack( n : INTEGER;
; VAR len, num : INTEGER;
; VAR data : packet_type;
; time_out : INTEGER;
; soh : CHAR ) : CHAR;
;------------------------------------------------------------------------
; This function listens to the serial input port, detects a kermit
; package, decodes it, returns the data part of the package, the
; length of the data part and the number of the package. Its function
; value is the packet-type.
; n = the number of the last packet send. It is only used to initialize
; num, otherwise num would be undefined in case of receive failure.
; The function takes the value '@' in case a transmission error is
; detected when decoding the packet or when no valid packet has been
; received during the time_out period.
; time_out can be specified in seconds : this value will be multiplied
; within rpack by 8 to approximate real time. Because only the least
; significant byte of time_out is passed to rpack, the valid range for
; time_out will be 1..31 seconds.
; This function will not work without the system.attach and attach.drivers
; that implement a remin buffer and the remin unitstatus statement.
;
;--------------------------------------------------------------------------
;
.FUNC RPACK, 6.
;
BIOSAF .EQU 0FF5C ; base of bios jump table. Same in V1.1 & V1.2
BIOSRAM .EQU 0C083 ; switch for extra bios ram.
INTPRAM .EQU 0C08B ; switch back to main ram.
RREAD .EQU BIOSAF+24. ; bios remote read routine adress.
RSTAT .EQU BIOSAF+51. ; bios remote status routine adress.
DUMMY .EQU 0FFFF ; dummy adress : will be filled in at runtime
TEMP1 .EQU 00 ; temp zero page adresses.
TEMP2 .EQU 02
;
; get parameters from stack:
;
PLA ; pop return adress.
STA RETURN
PLA
STA RETURN+1
;-------------------
PLA ; remove function bias.
PLA
PLA
PLA
;-------------------
PLA ; pop soh ( nearly always ^A )
STA SOH
PLA ; discard msb.
;-------------------
PLA ; pop timeout.
ASL A ; timeout = timeout * 8
ASL A ; to approximate real time.
ASL A
STA TIMEOUT
PLA ; discard msb.
;-------------------
PLA ; move adress of recpkt to the the right place.
STA RPADR+1
PLA
STA RPADR+2
;-------------------
PLA ; move adress of num .
STA TEMP1
STA NUMADR+1
PLA
STA TEMP1+1
STA NUMADR+2
;-------------------
PLA ; move adress of len .
STA TEMP2
STA LENADR+1
PLA
STA TEMP2+1
STA LENADR+2
;-------------------
PLA ; pop n
AND #3F ; take mod 64
LDY #00 ; init num to n in case of receive failure.
STA @TEMP1,Y
PLA ; discard msb of n.
TYA
INY
STA @TEMP1,Y
;-------------------
;
; initialization code
;
LDA #00 ; init len to zero.
TAY
STA @TEMP2,Y
INY
STA @TEMP2,Y
STA RESYNCNT ; set resynchronization count to 0
STA C1 ; set all timeout counters to 0
STA C2
LDA BIOSRAM ; switch in bios ram
;
; start rpack
;
WAITSOH JSR GETCHAR2 ; wait for a soh (^A)
BNE WAITSOH
RESYN INC RESYNCNT ; if more than 256 resync's : give up
BEQ RECFAIL
;-------------------
JSR GETCHAR1 ; get packet length ( len ).
BEQ RESYN ; if it was a soh then resync.
STA CHKSUM ; init checksum .
SEC
SBC #35. ; len := len - 32 - 3.
BMI RECFAIL ; if len < 0 then something is wrong.
STA LEN ; save len temporarily.
LENADR STA DUMMY ; save len for pascal.
;-------------------
JSR GETCHAR1 ; get packet number ( num ).
BEQ RESYN ; if it was a soh then resync.
PHA ; save num
CLC
ADC CHKSUM ; increase chksum
STA CHKSUM
PLA ; get original num back.
SEC
SBC #32. ; subtract 32.
NUMADR STA DUMMY ; save num for pascal.
;-------------------
JSR GETCHAR1 ; get packet type ( function value of rpack )
BEQ RESYN
STA PTYPE
CLC
ADC CHKSUM ; increase checksum
STA CHKSUM
;-------------------
LDY #00 ; get data char's ( recpkt )
FILLPACK STY LENCNT ; save y reg.
CPY LEN ; if no (more) data expected : skip this loop.
BEQ GETCHKSUM
JSR GETCHAR1 ; get data char.
BEQ RESYN
LDY LENCNT ; restore y reg.
RPADR STA DUMMY,Y ; fill in recpkt for pascal
CLC
ADC CHKSUM ; increase checksum
STA CHKSUM
INY ; increase length counter
BNE FILLPACK ; branch always to get next data char.
;-------------------
GETCHKSUM JSR GETCHAR1 ; get packet checksum.
BEQ RESYN
SEC
SBC #32. ; subtract 32.
STA PCHKSUM
;-------------------
LDA CHKSUM ; calculate final checksum.
ROL A
ROL A
ROL A
AND #03
CLC
ADC CHKSUM
AND #3F
; equivalent to s = ( s + ( ( s and 192 ) div 64 ) ) and 63
CMP PCHKSUM ; compare to received checksum.
BEQ EXIT ; if ok then back to pascal.
;-------------------
RECFAIL LDA #40 ; rpack = '@' if a receive failure was
STA PTYPE ; detected.
;-------------------
EXIT LDA #00 ; push msb of function value.
PHA
LDA PTYPE ; push lsb of function value.
PHA
;-------------------
LDA INTPRAM ; switch back to main ram.
;-------------------
LDA RETURN+1 ; push return adress
PHA
LDA RETURN
PHA
;-------------------
RTS ; back to pascal.
;---------------------------------------------------------------------
;
; subroutines GETCHAR1 & GETCHAR2
;
GETCHAR1 LDA #00 ; zero timeout counters
STA C1
STA C2
;-------------------
GETCHAR2 JSR RSTATUS ; entry point without timeout reset.
LDA BUFLEN ; something in remin buffer?
BNE GET ; then get it.
INC C1 ; if not then increase timeout counter
BNE GETCHAR2 ; and keep testing remin buffer.
INC C2
LDA C2
CMP TIMEOUT ; if timeout period has expired then
BNE GETCHAR2 ; indicate a receive failure.
PLA ; remove this routine's return adress
PLA ; from stack and go
JMP RECFAIL ; back to pascal.
;-------------------
GET LDX #00 ; x = 0 : read request.
JSR RREAD ; read remin buffer. Char in accu.
CMP SOH ; main rpack will take action if a ^A is
RTS ; detected.
;---------------------------------------------------------------------
;
; subroutine RSTATUS
;
RSTATUS LDA #00 ; push controlword on stack
PHA
LDA #01
PHA
;-------------------
LDA BUFLENPTR+1 ; push adress of buflen on stack
PHA
LDA BUFLENPTR
PHA
;-------------------
LDX #04 ; x = 4 : status request.
JSR RSTAT ; number of char's in reminbuffer
RTS ; can now be found in buflen.
;---------------------------------------------------------------------
;
; variable space:
;
RETURN .WORD 00
SOH .BYTE 00
TIMEOUT .BYTE 00
RESYNCNT .BYTE 00
C1 .BYTE 00
C2 .BYTE 00
LEN .BYTE 00
LENCNT .BYTE 00
PTYPE .BYTE 00
CHKSUM .BYTE 00
PCHKSUM .BYTE 00
BUFLEN .WORD 00
BUFLENPTR .WORD BUFLEN
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
;
; These procedures are external to unit kermutil.
;
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
;
; FUNCTION calc_checksum( var packet : packettype; len : integer ) : CHAR;
;
; calculates one character checksum of a packet.
;
; FUNCTION ctl( ch : char ) : CHAR;
;
; transforms a control char to a printable char and vice versa.
;
;-----------------------------------------------------------------------
;
.FUNC CALCCHECKSUM, 2 ; two parameters
RETURN .EQU 00
PACKETPTR .EQU 02
CHKSUM .EQU 04
;---------------------
PLA ; pop return address
STA RETURN
PLA
STA RETURN+1
;---------------------
PLA ; pop .func bias
PLA
PLA
PLA
;---------------------
PLA ; save len in y reg.
TAY
DEY ; len = len - 1
PLA ; discard msb.
;---------------------
PLA ; pop address of var packet
STA PACKETPTR
PLA
STA PACKETPTR+1
;---------------------
LDA #00 ; push msb of function result
PHA
;---------------------
SUM CLC ; sum characters except packet[0]
ADC @PACKETPTR,Y
DEY
BNE SUM
;--------------------
STA CHKSUM ; save this sum temporarily
ROL A
ROL A
ROL A
AND #03
CLC
ADC CHKSUM
AND #3F
;---------------------
; equivalent to s = ( s + ( ( s and 192 ) div 64 ) ) and 63
PHA ; push lsb of function result
LDA RETURN+1 ; push return and back to pascal
PHA
LDA RETURN
PHA
RTS
;----------------------------------------------------------------------
;
.FUNC CTL, 1 ; one parameter
PLA ; save return address in x and y
TAX
PLA
TAY
;--------------------
PLA ; pop .func bias
PLA
PLA
PLA
;--------------------
PLA ; leave msb function result on stack (=0)
EOR #40 ; toggle bit 7 of character
PHA ; push lsb funtion result
;--------------------
TYA ; push return address
PHA
TXA
PHA
RTS
;-------------------------------------------------------------------------
;-------------------------------------------------------------------------
;
; These procedures are external to the unit kermacia.
;
;-------------------------------------------------------------------------
;-------------------------------------------------------------------------
;
; PROCEDURE Send_6551_Break ( adr_comm_reg : INTEGER )
;
; This procedure is external to the unit "kermacia" and is specific for a
; 6551 acia in slot 2.
; It sends a "break" signal to the the remote host.
; The signal is switched off by pressing any key.
; The previous state of the command register is restored.
;-------------------------------------------------------------------------
;
;
.PROC SEND6551BREAK, 1 ; one parameter : the address of the 6551
; command register.
COMREG .EQU 00 ; zero page pointer.
;---------------------------------
PLA ; pop return adress.
STA RETURN
PLA
STA RETURN+1
;-------------------
PLA ; pop 6511 command reg. address.
STA COMREG
PLA
STA COMREG+1
;-------------------
LDY #00
LDA @COMREG,Y
PHA ; save content of command register.
ORA #0C ; turn on break bits 00001100
STA @COMREG,Y ; give break signal.
;-------------------
KEYBOARD LDA 0C000 ; test apple keyboard
BPL KEYBOARD
STA 0C010 ; clear keyboard strobe
;-------------------
PLA ; retrieve content of command register.
STA @COMREG,Y ; and restore old situation
;-------------------
LDA RETURN+1 ; push return adress
PHA
LDA RETURN
PHA
RTS ; and back to pascal.
;-------------------
RETURN .WORD 00
;----------------------------------------------------------------------
;
; PROCEDURE Send_6850_Break ( adr_comm_reg : INTEGER )
;
; This procedure is external to the unit "kermacia" and is specific for a
; 6850 acia in slot 2.
; It sends a "break" signal to the the remote host.
; The signal is switched off by pressing any key.
; The previous state of the command register is restored by the procedure
; set_acia_parms in unit kermacia.
;-------------------------------------------------------------------------
;
;
.PROC SEND6850BREAK, 1 ; one parameter : the address of the 6850
; command register.
COMREG .EQU 00 ; zero page pointer.
;---------------------------------
PLA ; pop return adress.
STA RETURN
PLA
STA RETURN+1
;-------------------
PLA ; pop 6511 command reg. address.
STA COMREG
PLA
STA COMREG+1
;-------------------
LDY #00
LDA #70 ; set break signal on .
STA @COMREG,Y
;-------------------
KEYBOARD LDA 0C000 ; test apple keyboard
BPL KEYBOARD
STA 0C010 ; clear keyboard strobe
;-------------------
LDA #13 ; give an acia master reset.
STA @COMREG,Y ;
;-------------------
LDA RETURN+1 ; push return adress
PHA
LDA RETURN
PHA
RTS ; and back to pascal.
;-------------------
RETURN .WORD 0
;-----------------------------------------------------------------------
.END