;----------------------------------------------------------------------- ;----------------------------------------------------------------------- ; ; 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