; Kermit.m68 - a telecommunications & error free file transfer program
; Version 2.0 - supports wildcarding, 3 byte CRC
; Author: Robert P. Rubendunst, Soft Machines,
; P.O. box 3701, Champaign, IL 61821
; Copyright 1984, 1991 Robert P. Rubendunst. All rights reserved. In
; addition, anthology copyrights prohibited without written permission from
; the author.
; N O T E - requires 1.3D AMOS/L//1.0D AMOS/32 or later to assemble.
; To assemble, M68 KERMIT.m68 produces KERMIT.LIT
; Edit History:
;[024] 16 March 1994 13:45 Edited by Bob Rubendunst
; Added test & message when re-entering user tries to
; re-specify port name.
;[023] 31 January 1992 10:49 Edited by Bob Rubendunst
; Corrected problems in RPAR which caused file transfers to fail.
;[022] 10 January 1992 09:37 Edited by Bob Rubendunst
; Added logic to strip CONNECT to 7 bits if PARITY is not NONE.
;[021] 09 January 1992 09:37 Edited by Bob Rubendunst
; Documentation changes in CONNECT message
; Added TIMEOUT and ENDLINE parametes to SET parameters list in SHOW
; Changed SHOCHR to always display 3 characters, show ^ as dim if ctl
; fixed problem with outputting zero byte files
; improved SPAR & RPAR logic to handle 7 bit cases better.
;[020] 31 December 1991 11:06 Edited by Bob Rubendunst
; Added code to make CONNECT mode compatible with 8 bit terminals.
; (Exit character must match all 8 bits if TDV presents TD$EXT)
; Deleted BPT legerdemain and just used SUPVR instead in SETSTS!
;[019] 31 December 1991 10:41 Edited by Bob Rubendunst
; AUTORECEIVE feature completed
;[018] 06 December 1991 13:08 Edited by Bob Rubendunst
; Added random file bypass for batch SENDing.
; Added code to eliminate possible bogus packet timeout at midnight.
; Added command line help.
; Added SET PARITY input checking
;[017] 02 December 1991 11:48 Edited by Bob Rubendunst
; Added SET PACKETSTART option
; Deleted code to save & restore jcb jobtyp word (not used)
;[016] 22 November 1991 13:27 Edited by Bob Rubendunst
; Added AUTORECEIVE command
; Changed SEND logic to send a Break packet if no files sent.
; Corrected some help text with Karen Bojda's help.
; Streamlined INUSE subroutine
; Added code to revive job when attaching JCB & TCB
; Completed graceful abort code for SENDing
; Corrected tests for maximum retries - some were BNE instead of BLOS
;[015] 31 October 1991 16:49 Edited by Bob Rubendunst
; Added wildcarding via CMDLIN.SYS. Kudos to Tom Niccum of KW fame.
; Added totals statistics.
; Added code to make SEND automatically send KERMIT and REC commands
; to remote Kermit. Can be de-activated with SET AUTOSEND OFF.
; Changed filenames to lower case for Unix compatibility.
; Added 3 byte CRC check type. Should eliminate problems with
; PC Kermits that do 2 byte CRCs wrong (Select either 1 or 3 byte option
; in Procomm Plus - vers 2.0 STILL does 2 byte checksums wrong.)
; Added SY$M40 symbol for possible AM4000 machine.
; Added code to avoid T.SEM problems with smart I/O cards
; Enhanced file size calcs to work under extended directories
; Added file closes to make compatible with AMOS 2.x
; Kermit only delays five seconds before SENDING in REMOTE mode instead
; of fifteen.
; Changed VMAJOR to 2.
;[014] 28 March 1991 12:38 Edited by Bob Rubendunst
; Added routine to adjust sleep value for faster baud rates.
; Note that this does improve performance at higher baud rates,
; especially for file transfers. Due to limitations in TTYIN monitor
; call, Kermit can still lose characters at higher baud rates.
; Fixed bug in effective baud rate calculation when calculating
; date rollover at midnight.
;[013] 28 March 1991 12:08 Edited by Bob Rubendunst
; Corrected problems with received filenames being expanded to 6 & 3
; even if they were shorter.
; Fixed problem in edit 12 with max packetsize not being defaulted
; at startup.
;[012] 06 February 1990 09:23 Edited by Bob Rubendunst
; Corrected a few bugs in checking for previous or next packet
; needing to be ACKed. Also fixed parameter display to display
; active END-OF-LINE caharcter, rather than default end-of-line.
;[011] 02 Dec 1988
; made compare for ESCAPE character 7 bits instead of 8 bits
; added BLOCKSIZE to SET command
;[010] 11 Sept 1988
; Changed handling of port busy bit so that REMOTE users do not monitor
; or change the terminal busy bit. Defines new SY$ symbols for 68020 &
; 68030 if not already defined.
;[009] 29 Jun 1988
; Completed basic compatibility with AM3000 systems
;[008] May 1988
; Started compatibility with AM3000 systems.
;[007] 24 Oct 1986
; Changed CONNEC routine to properly set T.DAT bit and T.XLT bits so
; nulls can be sent from keyboard.
;[006] 29 Jul 1986
; Tidied up SHOW command, added dot for every packet of data sent or
; rec'd, SET ? now shows SET list.
;[005] ??
; Change Kermit to accept running under AMOS/32. rpr
;[004] 12 May 1986
; straightened out 8-bit quoting problem in RPAR
; updated INUSE bit to use new bit under 1.3B
; transformed SET BINQUOTE feature into SET PARITY feature
; (does not set parity, but info is used to determine 7 or 8 bit modes.)
; corrected checkbyte size detection problem when used with unix c
; where ACK to F contained new filename under c. Alpha-Kermit thought
; this was an ACK to an I packet and used the wrong checkbyte type.
; Fixed 255 to 255. in max retries entry code 6/27/85 rpr
; Fix requires keeping track of the ACKing of the I packet via RIACK(A0)
; Fixed QBIN not defined on short received SINIT packet 4/24/85 rpr
; AMUS release (clean-up same TCB use) 12/3/84 rpr
; Added 7 bit mode to allow use with ELS... 10/23/84 rpr
; First non-alpha transfers 10/5/84 with ibm pc
;[000] 07 Sept 1984 project begun
; Permission is granted to any individual or institution to copy or use this
; software and the routines described in it, except for explicitly commercial
; purposes. This software must not be sold to any person or institution.
;;;;;;;;;;;;;;;;;;;;;;;;;;;; D I S C L A I M E R ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; No warranty of the software or of the accuracy of the documentation ;;
;; surrounding it is expressed or implied, and neither the authors, ;;
;; Columbia University, Soft Machines, or AMUS acknowledge any liability ;;
;; resulting from program or documentation errors. ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; usage format:
; KERMIT <terminal-name> <escape character>
; then enter ? or HELP for use hints.
SEARCH SYS
SEARCH SYSSYM
SEARCH TRM
COPY CMDSYM
IF NDF,SY$M20, SY$M20 = ^O20000 ; supply missing symbols [010]
IF NDF,SY$M30, SY$M30 = ^O100000 ; supply missing symbols [010]
IF NDF,SY$M40, SY$M40 = ^O2000000000 ; support possible 68040 [015]
IF NDF,SY$EXT, SY$EXT = ^O10000000 ; support 8 bit terminals [021]
IF NDF,TD$EXT, TD$EXT = ^O1000000000 ; support 8 bit terminals [021]
IF NDF,T$EXT, T$EXT = ^O20000 ; support 8 bit terminals [021]
; supplementary symbols for finding file type & size
D.LEN=D.WRK
D.ACT=D.LEN+4
D.1ST=D.ACT+10
; symbols to define byte-word-lword relationships
; The Alpha Micro uses byte-swap logic to switch the sense of UDS & LDS
; in hardware, so that BYTE ACCESS of data is the opposite of normal 68000s.
; (This was done because the WD-16 processor used Intel style byte access,
; were the MSB of a word is stored at higher addresses. Motorola CPUs
; store words MSB at lower addresses.)
; (WORD & LWORD ACCESS is not affected, only BYTE ACCESS.)
; (change these definitions for non-AM style hardware!!)
.B0W7 = 0 ; access LS byte of a 16 bit word
.B8W15 = 1 ; access MS byte of a 16 bit word
.B0L7 = 2 ; access bits 00-07 of a 32 bit word
.B8L15 = 3 ; access bits 08-15 of a long word
.B16L23 = 0 ; access bits 16-23 of a long word
.B24L31 = 1 ; access bits 24-31 of a long word
.W0L15 = 2 ; access LS word of long word
.W16L31 = 0 ; access MS word of long word
; symbol definitions
TRUE = -1
FALSE = 1
PAKSIZ = 94. ; max packet size
SOH = 1. ; default MARK character
CR = 13. ; ASCII carriage return
SPACE = 32. ; ASCII SP
DEL = 127. ; ASCII DEL
ESCCHR = '^ ; default escape character
A.BEL = 7. ; ASCII bell [24]
TRIES = 10. ; number of packet tries
MYQUOT = '# ; control-quoting
MYPAD = 0 ; number of pad chars
MYPCHR = 0 ; the pad character I need
MYEOL = 0 ; my end of line character
MYTIME = 08. ; seconds before timeout
MYBIN = 'Y ; binary qoute mode
MYCHK = '3 ; try to use 3 byte check bytes
MAXCHK = 3 ; maximum check type supported
MAXTIM = 60. ; maximum timeout
MINTIM = 2 ; minimum timeout period
; This macro is used to read a packet
DEFINE RPACK LEN,SEQ,PACKET,TYPE
LEA A3,PACKET
CALL RECPAK
SSTS D7
MARG MOVB, D2,LEN
MARG MOVB, D3,SEQ
MARG MOVB, D4,TYPE
LCC D7
ENDM
; This macro sends a packet to the REMOTE
DEFINE SPACK TYPE,SEQ,SIZE,PACKET
LEA A3,PACKET
CCLR SIZE,D2
CCLR SEQ,D3
CCLR TYPE,D4
MARG MOVB, SIZE,D2
MARG MOVB, SEQ,D3
MARG MOVB, TYPE,D4
CALL SNDPAK
ENDM
; This macro assembles argument linkage opcodes only where the default
; argument is not used. This provides more readable code without adding
; unnecessary instructions.
; For example, if D2 is the standard data link register, the macro
; MARG MOVW D2,D2
; will not produce an assembly line, but
; MARG MOVW D2,D3
; will assemble the line MOVW D2,D3
DEFINE MARG OPCODE, SRC, DST
NTYPE ...X,SRC
NTYPE ...Y,DST
IF NE,...X-...Y,OPCODE SRC,DST
ENDM
ASECT
; This macro is used to pre-clear result variables before a packet call
; IF they are not registers.
DEFINE CCLR ARG,REG
NTYPE ...D,ARG
NTYPE ...E,REG
IF NE,...D-...E,CLR REG
ENDM
.=0
; define the impure area for KERMIT.
NOSYM
; CONNECT command variables and general REMOTE/LOCAL channel variable
TNAME: BLKW 2 ; terminal name packed RAD50
SAVTDV: BLKL 1 ; address of saved TDV
PSEUDO: BLKL 1 ; address of PSEUDO driver
SAVSTS: BLKW 1 ; saved TCB status
SAVJCB: BLKL 1 ; saved attached JCB index
REMOTE: BLKL 1 ; index to remote TCB
LOCAL: BLKL 1 ; index to local TCB
STIME: BLKL 1 ; start time of event
FSIZE: BLKL 1 ; size of file in bytes
KMETA: BLKB 1 ; escape character
DONE: BLKB 1 ; done with kermit flag
NOTALK: BLKB 1 ; flag that remote TCB is job's.
ECHO: BLKB 1 ; duplex flag 0 for full, 377 for half
CCOUNT: BLKB 1 ; control-c count
AUTOS: BLKB 1 ; autosend option for SEND
AUTOR: BLKB 1 ; AUTORECEIVE option for REC
COMSER: BLKB 1 ; flag -1 if COMSER routines O.K.
EXTEND: BLKB 1 ; extended device support flag
ABORTB: BLKB 1 ; -1 if send batch to be aborted
ABORTF: BLKB 1 ; -1 if send file to be aborted
WILDOK: BLKB 1 ; -1 if wildcarding O.K.
CMASK: BLKB 1 ; bit mask for 7 or 8 bit characters
CFLAG: BLKB 1 ; flag we have breifed user on CONNECT
ATERM: BLKB 7 ; terminal name in ASCII & null
EVEN
FIO: BLKB D.DDB ; file I/O ddb area
SIO: BLKB D.DDB ; ddb just for file spec & cmdlin
; KERMIT packet receiver variables
ASSUM: BLKW 1 ; checksum storage
FRMSUM: BLKW 1 ; CRC storage
RTOUT: BLKL 1 ; time's up in seconds from midnight.
FUDGE: BLKL 1 ; fudge factor for midnight wrap-around
TIMINT: BLKL 1 ; # of seconds for timeout on sends
DF.TIM: BLKL 1 ; default timeout
; Global variables for file section
LOGIC: BLKB 1 ; 1=false, -1=true
LDATA: BLKB 1 ; size of present data
SPSIZ: BLKB 1 ; max send packet size
PAD: BLKB 1 ; # of padding chars to send
PADCHR: BLKB 1 ; pad character
EOL: BLKB 1 ; EOL character to send
N: BLKB 1 ; packet number
MAXTRY: BLKB 1 ; max # of tries
NUMTRY: BLKB 1 ; times this packet retried
OLDTRY: BLKB 1 ; times previous packet retried
BUFCNT: BLKB 1 ; # of data bytes for packet
DEBUGO: BLKB 1 ; level of debug output (0=none)
DING: BLKB 1 ; ding after each command flag (#0=yes)
DF.EOL: BLKB 1 ; default EOL character
DF.CHK: BLKB 1 ; default check type character
PARITY: BLKB 1 ; parity mode (None, Odd, Even, Space.)
STATE: BLKB 1 ; present state of file transfer automaton
QUOTE: BLKB 1 ; incoming quote char
QBIN: BLKB 1 ; storage & flag controlling 8 bit quoting:
; 0 indicates 8 bit path, no quoting
; -1 indicates 7 bit path, no quoting
; all other values 33.-62. 96.-126. are valid
; 8 bit quote characters (usually &)
CHKT: BLKB 1 ; checkbyte method as ascii character
CHKNOW: BLKB 1 ; checkbyte in use for this packet
REPT: BLKB 1 ; repeat byte (not implemented yet)
FLLEN: BLKB 1 ; filename length
RMARK: BLKB 1 ; the MARK character
RIACK: BLKB 1 ; flag we got an ACK to an I packet
MXPKSZ: BLKB 1 ; maximum packet size allowed
STLCHR: BLKB 1 ; stall character time in 100ths of a second
RECPKT: BLKB PAKSIZ ; buffer for receiving packets
PACKET: BLKB PAKSIZ ; another one
NFILNM: BLKB 4 ; room for MARK,LEN,SEQ,TYPE
FILNAM: BLKB 60. ; current filename
BLKB 20.
COPY: BLKB 60. ; ; copied filename
BLKB PAKSIZ-80.
EVEN
SLPVAL: BLKL 1 ; sleep value in ticks for GETREM routine
TFILES: BLKL 1 ; total files sent or received
TBYTES: BLKL 1 ; total bytes in files sent or received
TTIME: BLKL 1 ; total elapsed times
CLDDB: BLKB D.DDB ; CMDLIN.SYS ddb area
CMDERR: BLKL 1 ; CMDLIN.SYS .CMINI error cod
CMDPTR: BLKL 1 ; ptr to CMDLIN.SYS module
SAVSPC: BLKL 1 ; ptr to user's command line
CMNEXT: BLKL 1 ; saved flags from CM.NXT in CMDLIN routines
NXTCNT: BLKB 1 ; count of times NXTSPC called w/o wildcard
CMDFLG: BLKB 1 ; flag we have CMDLIN.SYS
EVEN
CMDIMP: BLKB IMP.SZ+100. ; room for CMDLIN.SYS
EVEN
KSIZE=.
.=0
; definition of KERMIT packet offsets
MARK: BLKB 1 ; the MARK character
LEN: BLKB 1 ; received LEN
SEQ: BLKB 1 ; received sequence
TYPE: BLKB 1 ; received type
DATA: BLKB 1 ; beginning of DATA
; 1, 2, or 3 byte check bytes follow the data and end the packet
.=0
SYM
REMMOD = T$IMI!T$ECS!T$DAT ; IMAGE, NOECHO mode bits
; The following macros define character tranlation functions needed to
; implement the KERMIT protocol.
; MACROs to perform CHAR, UNCHAR & CTL functions via register argument.
; C H A R - change control character to printable character
DEFINE CHAR DST
ADDB #SPACE,DST
ENDM
; U N C H A R -change CHARed control character back into a control character
DEFINE UNCHAR DST
SUBB #SPACE,DST
ENDM
; CTL - UNCONTROLIFY a CHARACTER. CTL(CTL(CHAR)) leaves CHAR unchanged.
DEFINE CTL DST
XORB #64.,DST
ENDM
PSECT
; K E R M I T
; Main Kermit routine. The first time executed, KERMIT builds its impure area,
; KERMIT.IMP. Then the main routine accepts and performs user commands.
;
VMAJOR =2
VMINOR =0
VSUB = 0
VEDIT = 024.
VWHO =0
RADIX 8. ; default numbers in octal
KERMIT: PHDR -1,PV$RSM!PV$WSM!PV$RPD!PV$WPD,PH$REE!PH$REU
CMPB @A2,#'/ ; flag?
BNE 2$
INC A2
CMPB @A2,#'? ; help?
BEQ 1$
TTYI
ASCII "undefined switch - assuming /? switch"
BYTE CR,A.BEL,0
EVEN
1$: TTYL USAGE
EXIT
; make sure we are running under an OS that supports TTYOUT.
2$: CALL KERTTL ; show title and version
MOV SYSTEM,D5 ; get system word
AND #SY$M20!SY$M30!SY$M40,D5 ; mask to just AMOS/32
BNE 10$ ; we are on AMOS/32, has TTYOUT
CMPB PH.VER+.B8W15,#1. ; MAJOR higher than 1?
BHI 10$ ; yes-use new value
MOVB PH.VER+.B16L23,D5 ; no- get sub release
ANDB #^O17,D5 ; strip out VWHO in top 4 bits
CMPB D5,#2. ; is this 1.2 or later?
BHIS 10$ ; yes- we can execute
; no- time to update the system!
TTYI
ASCII "%This software requires AMOS/L 1.2 or later O/S."
BYTE CR,0
EVEN
EXIT
10$: CALL INIMEM ; initial memory area
BNE EXEUNT ; need more memory-abort
BMI 20$ ; TCB already assigned
; first time entry. Check for CONNECT terminal name
BYP ; scan past blanks
CALL FNDASN ; find and assign user supplied terminal-name
BNE EXEUNT ; no match
ORW #FIL!LOK,-10(A0) ; set file and locked in memo flags
20$: JOBIDX ; index A6 to JCB
ANDW #^C<J.CCC>,@A6 ; clear control-c
CALL CHOICE ; get user's command choice
BNE 20$ ; no such command!
CALL PROCES ; perform user's command
TSTB DONE(A0) ; done ?
BEQ 20$ ; no, accept another command.
40$: CLRB DONE(A0)
; E X E U N T - exit back to AMOS
EXEUNT: EXIT
; I N I M E M
; This routine builds, clears and initializes the user's impure area.
INIMEM: LEA A6,IMPNAM ; index impure module name
SRCH @A6,A0,F.USR ; search user area for kermit
BEQ 10$ ; already present-done
GETIMP KSIZE,A0,100$ ; allocate impure area
CLEAR @A0,KSIZE ; clear it (redundant now, so what!)
LEA A6,IMPNAM
MOV (A6)+,-6(A0) ; set module name to program name
MOVW @A6,-2(A0) ; set module extension to .IMP
; do first time-only inits
CALL INI2 ; get JCB & attached TCB addresses
CALL INIXFR ; init xfer section once.
CALL OSVER ; determine O/S version
CALL TRMVER ; determine terminal driver version
MOVB #ESCCHR,KMETA(A0) ; set CONNECT ESCAPE character
MOVB #PAKSIZ,MXPKSZ(A0) ; set maximum packet size allowed [13]
MOV #100.,SLPVAL(A0) ; set sleep ticks for GETREM [14]
MOVB #-1,AUTOS(A0) ; invoke auto-send [15]
MOVB #-1,AUTOR(A0) ; invoke auto-receive [16]
LCC #PS.Z
RTN
; finish re-entry inits
10$: CALL INI2 ; get JCB & attached TCB AGAIN
BYP ; [024]
LIN ; [024] port named?
BEQ 20$ ; [024] no
TTYL RENTER ; [024] yes, been there, done that!
20$: LCC #PS.N!PS.Z ; set N and Z if impure already there
RTN
; not enough memory, so depart
100$: TYPECR <?Insufficient memory for KERMIT.>
LCC #0 ; flag no memory
RTN
; OSVER plays twenty questions games to find out what resources are
; available in current operating system.
OSVER: MOV SYSTEM,D7
AND #SY$EXD,D7 ; system supports extended disks?
SETNE EXTEND(A0) ; set flag -1 if extended disk O.K.
CLRB COMSER(A0) ; assume we don't have new comm stuff
MOV SYSTEM,D7 ; get system word
AND #SY$M20!SY$M30!SY$M40,D7 ; mask to just AMOS/32
BNE 10$ ; all AMOS/32 has COMSER, CMDLIN
CMPB PH.VER+.B8W15,#1. ; MAJOR higher than 1?
BHI 10$ ; yes-use new value
MOVB PH.VER+.B16L23,D7 ; no- get sub release
ANDB #^O17,D7 ; strip out VWHO in top 4 bits
CMPB D7,#3. ; is this 1.3?
BLO 30$ ; no-1.2 or older, no COMSER
BHI 10$ ; no-1.4 or higher COMSER fur sure!
SETB WILDOK(A0) ; wildcarding started in 1.3
MOVB PH.VER+.B8L15,D7 ; exactly 1.3 - check for B
LSRB D7,#4. ; bring it to ground zero.
CMPB D7,#'I-'@ ; is it B or higher?
BEQ 30$ ; 1.3I comes before 1.3B (go figure)
CMPB D7,#'B-'@ ; is it B or higher?
BLO 30$ ; yes-use new value
10$: SETB WILDOK(A0) ; O.K. to user CMDLIN.SYS
20$: SETB COMSER(A0) ; O/S has COMSER routines
30$: RTN ; O/S has got not a lot...
; determine terminal driver resources (7 or 8 bit system & terminal driver)
TRMVER: MOVB #^B01111111,CMASK(A0) ; preset mask for 7 bit terminal
MOV SYSTEM,D7 ; get system type
AND #SY$EXT,D7 ; does system support 8 bit terms?
BEQ 10$ ; no
MOV LOCAL(A0),A5 ; A5 indexs local TCB
MOV T.TDV(A5),A6 ; index terminal driver
MOVW TD.TYP(A6),D7 ; get type word
ANDW #TD$NEW,D7 ; is it a "new" TDV
BEQ 10$ ; no, use 7 bit mask
MOV TD.FLG(A6),D7 ; yes, get tdv's flag bits
AND #TD$EXT,D7 ; mask
BEQ 10$ ; tdv is recent, but only 7 bit!
MOVB #-1,CMASK(A0) ; TDV supports 8 bit terminals
10$: RTN
; These values are inited every time KERMIT is executed.
INI2: JOBIDX A6 ; index A6 to JCB
MOV JOBTRM(A6),LOCAL(A0) ; save address of local TCB
RTN
; I N I X F R
; Initialize the the file transfer area
INIXFR: MOVB #MYEOL,DF.EOL(A0) ; set default EOL [17]
MOVB #MYCHK,DF.CHK(A0) ; set default check type
MOVB #'N,PARITY(A0) ; set parity to NONE.
MOVB #PAKSIZ,SPSIZ(A0) ; set max send size
;
MOVB #SOH,RMARK(A0) ; define start of packet byte
MOVB #MYQUOT,QUOTE(A0) ; set quote char
MOV LOCAL(A0),A5 ; set index
MOVB #MYPAD,PAD(A0) ; pad count
MOVB #MYPCHR,PADCHR(A0) ; & character
MOVB #TRIES,MAXTRY(A0) ; set max tries
MOVB #'1,CHKT(A0) ; checkbyte type
MOV #08.,TIMINT(A0) ; set timeout period
MOV #08.,DF.TIM(A0) ; set default timeout period
RTN
; F N D A S N
; FNDASN finds the user specified TCB, and marks it as busy if found.
; The "busy" bit in the TCB depends on the O/S version.
; If the O/S version is before 1.3B AMOS/L, the busy bit is bit 11. of T.STS
; If the O/S is AMOS/32, or AMOS/L 1.3B or later, the busy is bit 9. of T.STS
FNDASN: JOBIDX A6 ; index A6 to JCB
MOV JOBTRM(A6),A5 ; index our own TCB as default
LIN ; user provide terminal name
BEQ 25$ ; no-use our own terminal
LEA A1,TNAME(A0) ; index terminal name storage
PUSH A1 ; save for unpack
PACK
PACK ; pack the terminal name RAD50
POP A1
LEA A2,ATERM(A0) ; then unpack it for later
UNPACK
UNPACK
CLRB @A2 ; save ASCII version for SHOW.
MOV TNAME(A0),D6 ; D6 gets whole RAD50 terminal name
LEA A3,TRMDFC ; index the head of the TCB chain
10$: MOV @A3,D7 ; get link to next entry
JEQ 100$ ; no matching TCB name [010]
MOV D7,A3 ; A3 indexs next element
20$: CMPL D6,4(A3) ; compare to this entry
BNE 10$ ; try next one if no match
; TCB with matching name is found. Check for prior use
LEA A6,10(A3) ; index A6 to remote TCB [010]
CMP A5,A6 ; using specified own terminal? [010]
BNE 22$ ; no
CLRB ATERM(A0) ; yes-clear name of terminal to [010]
; to flag comm port & user's [010]
; port are the same. [010]
22$: MOV A6,A5 ; index A5 to comm port [010]
25$: MOVW @A5,SAVSTS(A0) ; save the TCB status
CALL INUSE ; get proper in-use bits
TSTB ATERM(A0) ; user & comm port the same? [010]
BEQ 250$ ; yes-leave busy bit as is [010]
BSET D6,1(A5) ; set "assigned" bit
BNE 110$ ; already set by prior use-.
250$: MOV A5,REMOTE(A0) ; save pointer to remote TCB [010]
MOV T.TDV(A5),SAVTDV(A0) ; save old TDV address
; find address of PSEUDO TCB in memory for data transfer use.
MOV SAVTDV(A0),PSEUDO(A0) ; preset any TDV in case PSEUDO is gone!
MOV TRMTDC,A6 ; get base of tdv chain
MOV #[PSE]_16.+[UDO],D7 ; D7 gets PSEUDO in RAD50 notation
30$: CMP D7,4(A6) ; match ?
BEQ 40$ ; yes
MOV @A6,A6 ; no-get next link
MOV A6,D6 ; set flags
BNE 30$ ; keep trying
BR 50$ ; give up
40$: ADD #^O10,A6 ; add offset size of link word and name
MOV A6,PSEUDO(A0) ; save address of PSEUDO driver
50$: CMP A5,LOCAL(A0) ; TCB same as job's terminal's?
SETEQ NOTALK(A0) ; yes-flag KERMIT owns the data TCB
BEQ 60$ ; and bypass TDV swap.
; swap in PSEUDO terminal driver instead of normal TDV because some TDVs will
; use multi-byte capture sequences or other translate routines, which will
; mess up incoming or outgoing data.
; (There is a cleaner way to do this in newer O/Ss, but it isn't
; backwards compatible, so we won't bother - rpr 12/31/91)
MOV PSEUDO(A0),T.TDV(A5) ; substitute PSEUDO driver on remote
; unless TCB is owned by KERMIT job, detach all TCB <=> JCB links
60$: MOV T.JLK(A5),A6 ; get JCB link
MOV A6,SAVJCB(A0) ; save the JCB address for EXIT
BEQ 70$ ; TCB already detached-done
TSTB NOTALK(A0) ; TCB owned by KERMIT job?
BNE 70$ ; yes-leave it attached
CLR JOBTRM(A6) ; else detach TCB from job
CLR T.JLK(A5) ; and job from TCB
70$: LCC #PS.Z
RTN
100$: TTYL NMTN
LCC #0
RTN
110$: TYPECR <?terminal is being used by another job.>
LCC #0
RTN
; INUSE - routine to determine the proper INUSE bit values for this OS.
; The "busy" bit in the TCB depends on the O/S version.
; If the O/S version is before 1.3B AMOS/L, the busy bit is bit 11. of T.STS
; If the O/S is AMOS/32, or AMOS/L 1.3B or later, the busy is bit 9. of T.STS
; delivers status bit value for BTST to D6
INUSE:
MOV #1+8.,D6 ; D6 gets new INUSE bit value
TSTB COMSER(A0) ; do we have COMSER?
BNE 20$ ; yes
MOV #3.+8.,D6 ; set old INUSE bit
20$: RTN
; R A W T R M - set datacomm TCB to pass all data intact, character mode.
RAWTRM: MOV REMOTE(A0),A5 ; get index to the TCB
MOVW #REMMOD,D1 ; remote mode bits
CALL SETSTS ; set the status
RTN
; L I N T R M - set datacomm TCB for normal AMOSL line mode.
; except echo is supressed if same TCB for comm & commands
LINTRM: TSTB NOTALK(A0) ; same TCB for comm and job?
BEQ 10$ ; no-just return
; enable line input mode so user can enter commands
MOV REMOTE(A0),A5 ; yes-get index to the TCB
MOVW #^C<REMMOD>,D1 ; clear remote mode bits
CALL SETSTS ; clear the status
10$: RTN
; P S E T D V - assign PSEUDO driver if data TCB is owned by KERMIT job.
PSETDV: TSTB NOTALK(A0) ; TCB owned by KERMIT job?
BEQ 10$ ; no-no need to swap
MOV PSEUDO(A0),T.TDV(A5) ; swap in PSEUDO driver
10$: RTN
; O R G T D V - set normal terminal driver if data TCB is owned by KERMIT job.
ORGTDV: TSTB NOTALK(A0) ; TCB owned by KERMIT job?
BEQ 10$ ; no-no need to swap
MOV SAVTDV(A0),T.TDV(A5) ; swap back real terminal driver
10$: RTN
; S E T S L P - set SLEEP delay time based on serial baud rate
; added in edit [14]
SETSLP: MOV #100.,D6 ; set default value
CLR D7
MOVW T.BAU(A5),D7 ; get baud rate code
CMPW D7,#^O23 ; is it defined in our table?
BHI 10$ ; no, use default
LSLW D7 ; double index value
MOVW SLPTBL[D7],D7 ; get table value in D7
BEQ 10$
MOV D7,D6
10$: MOV D6,SLPVAL(A0) ; set sleep value
RTN
; sleep time in ticks for one character at all defined alpha baud rates
SLPTBL: WORD 100000./50.
WORD 100000./75.
WORD 100000./110.
WORD 100000./134.
WORD 100000./150.
WORD 100000./200.
WORD 100000./300.
WORD 100000./600.
WORD 100000./1200.
WORD 100000./1800.
WORD 100000./2000.
WORD 100000./2400.
WORD 100000./3600.
WORD 100000./4800.
WORD 100000./7200.
WORD 100000./9600.
WORD 100000./19200.
WORD 100000./38400.
WORD 100000./57600.
WORD 100000./76800.
; end [14] additions for SETSLP
; S N O O Z E - delay if data TCB owned by KERMIT job. This gives user
; time to escape back to the other KERMIT and enter REC.
SNOOZE: TSTB NOTALK(A0) ; data TCB same as KERMITs?
BEQ 10$ ; no - do not wait.
SLEEP #5.*10000. ; yes - wait 5 seconds
10$: RTN
; E V L C H R
; EVLCHR evaluates the next non-blank character indexed by A2 and
; returns its value in D1.
; At exit, A2 is updated, and D1 contains the new character or 0.
; The Z flag is set if a character was encountered, else Z is clear.
EVLCHR: CLR D1 ; pre-clear
BYP
LIN ; end of line?
BEQ 100$ ; yes-no characters to process
NUM ; else check for numeric
BNE 10$ ; not numeric
GTDEC ; get the value
BR 40$ ; and use it
; process non-numeric
10$: MOVB (A2)+,D1
CMPB D1,#'^ ; control character prefix ?
BNE 20$ ; no-use straight ASCII.
LIN ; yes-check again for end of line
BEQ 40$ ; treat as the ^ character [21]
MOVB (A2)+,D1 ; else get next character
AND #^O37,D1 ; mask to control character
BR 40$ ; and exit
20$: CMPB D1,#SPACE ; compare to ASCII space
BLO 100$ ; invalid argument
LIN
BNE 100$ ; bad input, too many chars
40$: LCC #PS.Z ; arg ok, value in D1
RTN
100$: LCC #0 ; arg is bad.
RTN
; P R O M P T displays the KERMIT command prompt.
PROMPT:
MOV #CR,D1
TTY
TSTB ATERM(A0) ; is this kermit the REMOTE?
BNE 10$ ; no
TYPE <REMOTE > ; yes-give user different prompts
10$: TTYI ; for local & remote kermies.
ASCII /Alpha-Kermit >/
BYTE 0
EVEN
RTN
; C H O I C E - prompts the user for command & gets the command.
CHOICE: CALL PROMPT ; prompt the user
KBD 25$ ; get a command line in line mode
BYP ; scan past blanks
LIN ; end of line?
BEQ CHOICE ; ignore blank lines
LEA A1,KERCOM ; index argument list
CALL COMAND ; match the command
BEQ 30$ ; command matched
; no match - show user bad news.
TYPE<? >
10$: LIN
BEQ 20$ ; end of line.
MOVB (A2)+,D1 ; else
TTY ; type the
BR 10$ ; character and loop
20$: TYPECR <? - undefined command.>; end error display
25$: LCC #0 ; flag no command
RTN ; return
30$: LCC #PS.Z ; flag valid command
RTN ; return
; C O M A N D - This subroutine compares the user's command string
; to the command list indexed by A1 (e.g. KERCOM).
; If a match is found, A1 will index the command offset for a tabled call.
; At entry, A1 indexs the command/subcommand list. A2 indexs user's string.
; At exit, Z is set to indicate the command was valid.
; If Z is set, A1 indexs the command offset word.
;
; This routine will match the entire command, or to a valid and unique subset
; of the command name as defined in the table structure.
; e.g. The string CON will match the command name CONNECT.
COMAND: SUB #2,A1 ; adjustment for first entry
BYP ; scan past seperators
PUSH A2 ; save string address for compares
LIN ; end of line?
BEQ CHO.5 ; no command-exit.
; calculate address of next entry and place in A1.
CHO.1: MOV @SP,A2 ; restore string pointer
LEA A3,2(A1) ; A3 indexs next entry
TSTW @A3 ; end of table ?
BEQ CHO.5 ; yes-no match.
MOV A3,A1 ; no-get address of command size word
ADDW (A3)+,A1 ; and index to next command.
CLR D5
MOVB (A3)+,D5 ; D5 gets qualifier size in bytes
CHO.2: TRM ; check for end of word
BEQ CHO.4 ; yes-check match count
TSTB @A3 ; check for end of table entry
BEQ CHO.1 ; must be wrong if so.
CHO.3: MOVB @A2,D1
UCS ; convert to upper case
CMPB D1,(A3)+ ; compare strings
BNE CHO.4 ; until no match
ADD #1,A2 ; advance A2
TST D5 ; check for minimum match length
BEQ CHO.2 ; made it-stop counting
SUB #1,D5 ; decrement byte count
BR CHO.2 ; keep testing till line is terminated
CHO.4: TST D5 ; good match has zero count
BNE CHO.1 ; no good-try next
TRM ; good match has no more data
BNE CHO.1
POP ; toss old A2
LCC #PS.Z ; flag command match found
RTN
; undefined command - Clear Z flag
CHO.5: POP A2 ; update A2 to index args
LCC #0
RTN
; P R O C E S
; Process performs the process defined by the user command.
; At Entry, A1 indexs the word offset (from A1) of the command address
PROCES: ADDW @A1,A1 ; do a tabled called by adding
CALL @A1 ; offset @A1 to A1 and executing at
RTN ; that new address.
; S E N D sends a file to the remote KERMIT using the KERMIT protocol.
SEND: TSTB NOTALK(A0)
BNE 4$ ; AUTOsend doesn't make sense in REMOTE
TSTB AUTOS(A0) ; automatically sending KERMIT & RECEIVE?
BEQ 4$ ; no
TYPECR <Sending KERMIT and RECEIVE commands to remote Kermit>
LEA A1,PRESND ; index commands for remote kermit
CALL SREMOT ; send to remote
4$: CALL PREBAT ; init wildcarding, if present
BYP
5$: CALL GETNXT ; get next filename
; delay inspection of no files error until we are ready to send F packet,
; then, just send a B packet.
TSTB FIO+D.ERR(A0) ; file error?
BEQ 6$ ; no
CALL LFERR ; yes, display it
BR 5$ ; and try for another spec
6$: CALL GTSIZE ; save file size in bytes
CALL STARTT ; set start time
CALL RAWTRM ; put remote in data mode
CALL SNOOZE ; delay if TCB owned by KERMIT
CALL PSETDV ; swap in PSEUDO driver if needed
CALL SETSLP ; set sleep parameter
CALL SENDSW ; else send the file
CALL LINTRM ; put remote in line mode
CALL ORGTDV ; put back real TDV if PSEUDO used
TSTB LOGIC(A0) ; did it work?
BMI 10$ ; yes
TYPECR <?SEND failed> ; no
10$: CALL STATS
20$: RTN
100$: CALL LFERR
RTN
; L F E R R
; LFERR displays local file errors on the user's CRT
LFERR: TSTB NOTALK(A0) ; do we have a user terminal?
BNE 10$ ; no-do not print message.
TYPE <Local file error, >
PFILE FIO(A0) ; show filename
ERRMSG FIO+D.ERR(A0), OT$TRM!OT$LSP ; and error message
CRLF
10$: RTN
; R E C E I V - receive a file from remote KERMIT using the KERMIT protocol.
RECEIV:
MOV A2,SAVSPC(A0) ; save user's string ptr
MOVB #1,NXTCNT(A0) ; set count for output spec
CALL SCNSTR ; scan string for AUTO-receive
CLR TFILES(A0)
CLR TBYTES(A0)
CLR TTIME(A0) ; clear total stat amounts
MOV #60.,TIMINT(A0) ; 60 second timeout
CALL SETSLP ; set sleep parameter
CALL PSETDV ; swap in PSEUDO terminal driver
CALL RAWTRM ; remote TCB to character mode
CALL RECSW ; call receive state manager/switcher
CALL LINTRM ; remote TCB to line mode
CALL ORGTDV ; return to real TDV if PSEUDO used
TSTB LOGIC(A0) ; test for sucess
BMI 10$ ; it worked
TYPECR <?RECEIVE failed.> ; it didn't work
10$: CALL STATS ; show elapsed time & speed
RTN
; scan user spec for = and spec following it. If found, send remote Kermit
; the commands KERMIT^M, and SEND followed by the user's filespec.
SCNSTR:
SAVE A2
TSTB NOTALK(A0)
BNE 100$ ; AUTOREC doesn't make sense in REMOTE
TSTB AUTOR(A0) ; automatically sending KERMIT & SEND?
BEQ 100$ ; no
BYP
LIN ; any parms?
BEQ 100$ ; no
CMPB @A2,#'= ; do we have an equal sign?
BEQ 20$ ; yes
FSPEC FIO(A0),LST ; no, use FSPEC to skip past outspec
BYP
20$: CMPB (A2)+,#'= ; do we have AUTO spec?
BNE 100$ ; no
; yes
TYPECR <Sending KERMIT and SEND commands to remote Kermit>
LEA A1,PREREC ; index commands for remote kermit
CALL SREMOT ; send to remote
MOV A2,A1
CALL SREMOT ; send user string ( even CR & LF)
100$: REST A2
RTN
; G F I L N M
; This routine gets a filename and places it in FILNAM(A0)
; At entry, the filename has been loaded in ddb FIO(A0)
; On exit, FLLEN(A0) contains the length in bytes.
; Z is set if the filename was valid.
GFILNM:
; now convert the name to KERMIT standard form which is NAME.EXT.
; We must delete all spaces from the filespec.
LEA A2,FILNAM(A0) ; index the target area
PUSH A2 ; and save the index
LEA A1,FIO+D.FIL(A0) ; index the filname in the ddb
UNPACK
UNPACK ; put the ASCII filename @A1
MOVB #'.,(A2)+ ; add the comma
UNPACK
CLRB @A2 ; terminate it
; clean up the filespec by deleting space & other illegal characters.
POP A2 ; restore pointer to filnam
MOV A2,A1 ; A1 will be write pointer
CLR D0 ; D0 counts valid chars we found
10$: MOVB @A2,D1 ; get current char in D7
BEQ 20$ ; end of line
LCS ; convert to lower case [15]
CMPB D1,#'. ; current char a dot?
BEQ 20$ ; yes -it is ok
ALF ; is it alpha ?
BEQ 20$ ; yes-use it.
NUM ; or numeric ?
BNE 25$ ; yes-use it
20$: MOVB D1,(A1)+
BEQ 30$ ; end of string
ADD #1,D0 ; count how many we found
25$: ADD #1,A2 ; bump pointer
BR 10$ ; continue scan
30$: CMP D0,#3 ; got at least x.x?
BLO 100$ ; no-invalid filename
MOVB D0,FLLEN(A0) ; save the length
LCC #PS.Z ; valid filename received
RTN
100$: LCC #0 ; bad filename given.
RTN
; R F I L N M
; This routine gets the remote filename from NFILNM(A0)
; and places it in the FIO(A0) DDB.
; It then opens the file for input and returns the OPEN condition codes
; to the caller. Z is set if the open was succesful.
; [13] revised to not extend filenames or extensions rpr
RFILNM:
LEA A2,FILNAM(A0) ; index the filname
LEA A1,COPY(A0) ; index copy buffer
CLR D2
MOVB LDATA(A0),D2 ; d2 gets total length of filename
; from remote kermit
CMP D2,#30.-1 ; compare to max allowed by definition
BLOS 10$
MOV #30.-1,D2 ; set max
; terminate filename part to 6 characters
10$: MOV #6.,D0 ; set limit for filename
20$: ALF
BEQ 30$ ; letters ok
NUM
BEQ 30$ ; numbers ok, too.
CMPB @A2,#'. ; period?
BEQ 60$ ; yes-end of filename!
BNE 40$ ; no-toss bad char & continue
30$: MOVB @A2,(A1)+ ; save good character
40$: ADD #1,A2 ; advance pointer
SUB #1,D2 ; count down total filename size
BEQ 100$ ; end of filename (use .KMT extension)
SUB #1,D0 ; adjust allowed filename chars
BNE 20$ ; more allowed
; else wait for a period.
; truncate file names longer than 6 characters by waiting for a period
; wait for a period
50$: CMPB @A2,#'. ; period
BEQ 60$ ; yes-ok.
ADD #1,A2 ; no-advance ptr
SUB #1,D2 ; count down total filename size
BNE 50$ ; until period or end of file
BR 100$ ; no period found
; we found the period (and truncated a long filename)
60$: ADD #1,A2 ; no-advance
SUB #1,D2 ; count down original filename size
BEQ 100$ ; no more filename, use default ext!
MOVB #'.,(A1)+ ; buffer a period
MOV #3.,D0 ; max size of extension.
70$: ALF
BEQ 80$ ; ok
NUM
BNE 90$ ; not ok
80$: MOVB @A2,(A1)+ ; buffer o.k. character
90$: ADD #1,A2 ; advance pointer
SUB #1,D2 ; count down original filename size
BEQ 100$ ; until a period
SUB #1,D0 ; count down
BNE 70$ ; yes
100$: CLRB (A1)+ ; no- end with a null
; add code to override the name of first file received, if user gave a name
TSTB NXTCNT(A0) ; been here before?
BEQ 106$ ; yes, not first time
MOV SAVSPC(A0),A2 ; no, get user spec
BYP
LIN ; do we have text?
BEQ 106$ ; no, user name from F packet
CMPB @A2,#'= ; yes, is text a filename?
BNE 107$ ; yes, override filename!
INC A2 ; else use name from F packet
BYP
106$: CLRB NXTCNT(A0)
LEA A2,COPY(A0) ; index the new filename
107$: INIT FIO(A0) ; init the ddb
FSPEC FIO(A0),KMT ; load the ddb with filespec
LOOKUP FIO(A0) ; does file already exist?
BNE 110$ ; no
DSKDEL FIO(A0) ; yes-erase the old one
110$: OPENO FIO(A0) ; open it sequentially
BNE 120$
CALL STARTT ; start counting
CLR D7 ; clear Z flag
120$: RTN ; Z is set if file found
; C O N N E C
; CONNEC is the local terminal <--> remote terminal conversational routine.
; User keypresses are sent (except the ESCAPE or KMETA character) to the
; remote computer & incoming characters form the remote are displayed on
; the user's CRT screen.
CONNEC: TSTB NOTALK(A0) ; using same TCB for in & out?
BEQ 4$ ; no-ok.
TTYL NONONO ; tell user it is a no-no
RTN
4$: TAS CFLAG(A0) ; have we been here before?
BNE 5$ ; yes
TTYL CUSAGE ; no, explain CONNECT to user
5$: CALL RAWTRM ; set remote in "raw" mode.
CALL SETSLP ; set sleep parameter
CALL SHOESC ; show the escape character in effect.
MOV LOCAL(A0),A5 ; A5 indexs local TCB
MOVW #REMMOD,D1 ; allow function key xlation
TSTB CMASK(A0)
BPL 6$ ; 7 bit terminal
ORW #T$EXT,D1 ; 8 bit terminal
6$: CALL SETSTS ; set them via breakpoint
MOV A5,A4 ; A4 will be the local TCB pointer
MOV REMOTE(A0),A5 ; now A5 indexs REMOTE
10$: CTRLC 15$ ; user entered control-c?
TST T.ICC(A4) ; LOCAL chars present ?
BNE 20$ ; something to do
TST T.ICC(A5) ; REMOTE chars present ?
BNE 20$ ; something to do
SLEEP SLPVAL(A0) ; take a one character nap. [14]
BR 10$ ; see if the store needs minding now.
; handle control-c's by trapping them, unflagging them and sending them out.
15$: JOBIDX ; index A6 to JCB
ANDW #^C<J.CCC>,@A6 ; clear control-c flag
MOV #3,D1 ; get ASCII equivalent
BR 37$ ; send it out
; enter here when we have some communications data to move
20$: TST T.ICC(A5) ; have remote input ?
BEQ 30$ ; no
TTYIN ; yes-grab a character
CMPB PARITY(A0),#'N
BEQ 25$
ANDB #^B01111111,D1 ; strip to seven if PARITY is on [22]
25$: TTY ; print it
30$: TCKI ; have LOCAL input ?
BNE 40$ ; no local input
KBD ; yes-get local input via KBD
35$: MOVB D1,D7
ANDB CMASK(A0),D7 ; mask character to 7 or 8 bits
CMPB D7,KMETA(A0) ; escape character ?
BEQ 100$ ; yes-leave
; check for half duplex echoing
TSTB ECHO(A0) ; got echoing?
BEQ 37$ ; no-full duplex
CMPB D7,#SPACE ; printable?
BHIS 36$ ; yes-echo it
CMPB D7,#CR ; CR?
BEQ 36$ ; yes-echo
CMPB D7,#08. ; backspace?
BEQ 36$ ; yes-echo
CMPB D7,#12 ; line feed ?
BNE 37$ ; ignore other ctl chars
36$: TTY ; yes-half duplex,
; so echo the character
; transmit a character to the remote site.
37$: TTYOUT ; send byte to REMOTE
40$: BR 10$ ; loop
; exit back to main routine, since user entered ESCAPE character.
100$: MOV LOCAL(A0),A5 ; index user's TCB
MOVW #REMMOD,D1 ; get char mode bits
TSTB CMASK(A0)
BPL 110$ ; 7 bit terminal
ORW #T$EXT,D1 ; 8 bit terminal
110$: COMW D1 ; flip the bits to clear
CALL SETSTS ; clear them via breakpoint
;; CALL LINTRM ; reset remote TCB to line mode.
CRLF
RTN
; H E L P - inform user as to how KERMIT works.
HELP: TTYL HLP1
LEA A1,KERCOM ; index argument list
CALL COMAND ; see if we have an argument
BNE 100$ ; no-show the whole list.
; show the selected help line by backing up to the start of it
4$: TSTB -(A1) ; backup to non-null
BEQ 4$
10$: MOVB -(A1),D1 ; look for null byte between command
BNE 10$ ; and help strings.
CRLF
TTYL 1(A1) ; show the help message
CRLF
RTN
; Show help lines for all commands
100$: LEA A2,KERCOM ; index table
110$: MOV A2,A1
CLR D7
MOVW @A1,D7 ; get offset to end
BEQ 140$ ; null is end of table
MOV A1,A2
ADDW (A1)+,A2 ; A2 indexs the address field
ADD #2,A2 ; A2 now indexs the next entry
ADD #1,A1 ; ignore size byte
CLR D0
CALL PTRTYP ; type command name
TSTB @A1
BNE 120$
ADD #1,A1
120$: CMPB D0,#09. ; nine characters?
BHI 130$ ; yes, done spacing
INC D0 ; no,
TYPESP ; so space
BR 120$ ; out
130$: CALL PTRTYP ; type the help text
CRLF
BR 110$
140$: CRLF
CRLF
RTN
; S H O W - Show user the current optional settings & some packet info.
SHOW: CALL KERVER ; show kermit version
TTYL SH1.0 ; type modem port:
LEA A1,ATERM(A0) ; index TCB name
TSTB @A1 ; do we have remote? [1]
BNE 10$ ; yes
LEA A1,SH.DAS ; else index dashes
10$: TTYL @A1 ; show name or dashes
; [016] display auto-receive
TTYL SH2.0
LEA A6,SH.ON
TSTB AUTOR(A0)
BNE 20$
LEA A6,SH.OFF
20$: TTYL
; [015] display auto-send
TTYL SH2.1
LEA A6,SH.ON
TSTB AUTOS(A0)
BNE 30$
LEA A6,SH.OFF
30$: TTYL
; display bell
TTYL SH2.2 ; do end of line 1 & BELL label
LEA A6,SH.OFF
TSTB DING(A0)
BEQ 40$
LEA A6,SH.ON
40$: TTYL ; show on or off
; display blockcheck
TTYL SH2.3 ; blockcheck selected label
MOVB DF.CHK(A0),D1
TTY
; display debug
TTYL SH2.4 ; show DEBUG label
LEA A6,SH.OFF
TSTB DEBUGO(A0)
BEQ 50$
LEA A6,SH.ON
50$: TTYL
; show duplex
TTYL SH2.5 ; then type duplex label
LEA A6,SH.FUL ; assume FULL
TSTB ECHO(A0) ; check duplex 0=full, -1=half
BEQ 60$
LEA A6,SH.HAL ; o.k., then, HALF.
60$: TTYL ; type string @A6
; display user's endline
TTYL SH3.2 ; end of line 3, ENDLINE label
;[012] display end-of-line character in use, rather than default
MOVB DF.EOL(A0),D1 ; set end of line char
BNE 65$
TTYL SH.ZIP
BR 67$ ; [015]
65$: TYPE < >
CALL SHOCHR
67$:
; display ESCAPE
TTYL SH2.6 ; show ESCAPE label
CLR D1 ; preclear D1
MOVB KMETA(A0),D1
CALL SHOCHR ; show escape character
; display PACKETSIZE
TTYL SH2.7
CLR D1
MOVB MXPKSZ(A0),D1 ; set max value
DCVT 4,OT$TRM!OT$ZER
; display PACKETSTART
TTYL SH2.7A
MOVB RMARK(A0),D1
CALL SHOCHR
; display PARITY
TTYL SH2.8 ; type parity label
MOVB PARITY(A0),D1
CALL SHOCHR
; display default retries
TTYL SH2.8A
MOVB MAXTRY(A0),D1
DCVT 4,OT$TRM!OT$ZER
; display stall time in hundredths of seconds
TTYL SH2.9
CLR D1
MOVB STLCHR(A0),D1
DCVT 4,OT$TRM!OT$ZER
; display default TIMOUT
TTYL SH2.9A ; show timeout label
MOV DF.TIM(A0),D1 ;
DCVT 4,OT$TRM!OT$ZER
CRLF
; display packet parameters
; display blockchek
TTYL SH3.0
MOVB CHKT(A0),D1 ; get check type
TTY
; display eight bit quote
TTYL SH3.1
MOVB QBIN(A0),D1
BMI 70$ ; 7 bit path
BNE 80$ ; we have a real 8B quote, show it
TTYL SH.ZIP ; we don't need 8B quote so far
BR 90$
70$: MOVB #'&,D1 ; show default 8 bit quote
80$: TYPE < >
CALL SHOCHR
90$:
; display endline
TTYL SH3.2 ; end of line 3, ENDLINE label
;[012] display end-of-line character in use, rather than default
MOVB DF.EOL(A0),D1 ; set end of line char
BNE 100$
TTYL SH.ZIP
BR 110$ ; [015]
100$: TYPE < >
CALL SHOCHR
; display max packet size
110$: TTYL SH3.3 ; do end of line 2, packet parms.
CLR D1
MOVB SPSIZ(A0),D1 ; get packet size
DCVT 4,OT$TRM!OT$ZER
; display packet end
TTYL SH3.4 ; show number of pads
MOVB PAD(A0),D1 ;
DCVT 2,OT$TRM!OT$ZER
TTYL SH3.5 ; show pad character value
MOVB PADCHR(A0),D1 ;
CALL SHOCHR
TTYL SH3.6 ; show timout label
MOV TIMINT(A0),D1 ;
DCVT 4,OT$TRM!OT$ZER
TTYL SH3.8
RTN
; S E T - allow user to change some parameters.
; SET command accepts a sub-command (or argument) to define the action.
; If no sub-command is given, a short expansion of the subcommands is given.
SET: BYP
LIN ; end of line?
BEQ 100$ ; yes-show user what can be set.
CMPB @A2,#'? ; user wants some help?
BEQ 100$ ; yes-show user what he can set.
LEA A1,SETCOM ; index set command list
CALL COMAND ; see if we have an argument
BNE 10$ ; no-show user no can do.
; perform the desired function. Each function does its own error-checking.
CALL PROCES ; do the set
RTN
10$: TYPE<? > ; no match - show user bad news.
15$: LIN ; end of line?
BEQ 20$ ; yes-done typing user's entry
MOVB (A2)+,D1
TTY ; type a character
BR 15$ ; until the end of line
20$: TYPECR <? - undefined command.>
25$: RTN
; Show explanation for all set commands
100$: TTYL SET1
LEA A2,SETCOM ; index table
110$: MOV A2,A1
CLR D7
MOVW @A1,D7 ; get offset to end
BEQ 140$ ; null is end of table
MOV A1,A2
ADDW (A1)+,A2 ; A2 indexs the address field
ADD #2,A2 ; A2 now indexs the next entry
ADD #1,A1 ; ignore size byte
CLR D0 ; [015] count characters
CALL PTRTYP ; type command name
TSTB @A1
BNE 120$
ADD #1,A1
120$: CMPB D0,#11. ; eleven characters?
BHI 130$ ; yes, done spacing
INC D0 ; no,
TYPESP ; so space
BR 120$ ; out
130$: CALL PTRTYP ; type the help text
CRLF
BR 110$
140$: CRLF
CRLF
RTN
;; S E T S U B C O M M A N D S
; B E L L - set bell after each command completeion flag.
BELL: LEA A1,ONOFF ; index option list
CALL GETOPT ; process option
BNE 10$ ; no good
MOVB D1,DING(A0) ; set bell option
10$: RTN
; D U P L E X - set half or full duplex.
DUPLEX: LEA A1,EPLEX ; index echoplex options
CALL GETOPT ; process option
BNE 10$ ; no good
MOVB D1,ECHO(A0) ; set duplex option
10$: RTN
; B L O C K - set default check type. 1, 2 or 3 byte check types
BLOCK: LEA A1,ONE23 ; index check-type options
CALL GETOPT
BNE 10$ ; no good
MOVB D1,DF.CHK(A0) ; set default check type
10$: RTN
; D E B U G - Set debug message print flag.
DEBUG: LEA A1,ONOFF ; allow YES or NO.
CALL GETOPT
BNE 10$
MOVB D1,DEBUGO(A0) ; set debug option
10$: RTN
; A U T S N D - Set AUTOSEND option flag.
AUTSND: LEA A1,ONOFF ; allow YES or NO.
CALL GETOPT
BNE 10$
MOVB D1,AUTOS(A0) ; set autosend option
10$: RTN
; A U T R E C - Set AUTORECEIVE option flag.
AUTREC: LEA A1,ONOFF ; allow YES or NO.
CALL GETOPT
BNE 10$
MOVB D1,AUTOR(A0) ; set autosend option
10$: RTN
; E N D L I N - set optional end of packet character. (normally CR.)
ENDLIN: CALL EVLCHR ; get the character
BNE 10$
MOVB D1,DF.EOL(A0) ; set default EOL
10$: RTN
; P A K M R K - set optional start of packet character. (normally CR.)
PAKMRK: CALL EVLCHR ; get the character
BNE 10$
MOVB D1,RMARK(A0) ; set default MARK character
10$: RTN
; E S C A P E - set the escape from CONNECT mode character.
ESCAPE: CALL EVLCHR
BNE 10$ ; no good
ANDB CMASK(A0),D1 ; limit to valid character set range
MOVB D1,KMETA(A0) ; set escape character
10$: RTN
; T I M E R - set the timeout period used in packet transmission.
TIMER: BYP
GTDEC ; get decimal number
CMP D1,#MINTIM ; compare to minimum time
BHIS 10$ ; allow 2 or more
MOV #MINTIM,D1 ; force minimum
TYPECR <Setting timeout to 2 second minimum.>
10$: MOV D1,DF.TIM(A0) ; set default and
MOV D1,TIMINT(A0) ; current timer value
RTN
; N E W T R Y - sets the maximum # of tries for a packet.
NEWTRY: BYP
GTDEC
TST D1 ; test new value
BEQ 20$ ; zero is too few!
CMP D1,#255. ; this is max was ^O255
BHI 20$ ; too high-leave as is
MOVB D1,MAXTRY(A0) ; set max value
RTN
20$: TTYI
ASCII /?value out of range?/
BYTE A.BEL,CR,0
EVEN
RTN
; P A K M A X - set maximum packet size supported
PAKMAX: BYP
GTDEC
CMP D1,#10. ; compare to minimum
BLO 20$ ; too small [16]
CMP D1,#PAKSIZ ; compare to max size allowed
BHI 20$ ; too high-leave as is
MOVB D1,MXPKSZ(A0) ; set max value
MOVB D1,SPSIZ(A0) ; set max send size, too!
RTN
20$: TTYI
ASCII /?select a packet size from 10 to 94 bytes./
BYTE A.BEL,CR,0
EVEN
RTN
; S E T P A R - set the parity type (already in use) by the remote
; This allows Alpha-Kermit to know whether 8bit quoting is needed, or not.
SETPAR: LEA A1,PARLST ; allow YES or NO.
CALL GETOPT
BNE 10$
MOVB D1,PARITY(A0) ; set parity
CMPB D1,#'N ; no parity?
SETNE QBIN(A0)
TTYL NOSET ; tell user limitations
10$: RTN
; S T L V A L - set # of 100ths of seconds to stall between output
; characters for file transfers.
STLVAL: BYP
GTDEC
TST D1 ; test new value
BEQ 20$ ; zero is too few!
CMP D1,#255. ; this is max was ^O255
BHI 20$ ; too high-leave as is
MOVB D1,STLCHR(A0) ; set max value
RTN
20$: TTYI
ASCII /?STALL range is 0 to 255 hundredths of seconds./
BYTE A.BEL,CR,0
EVEN
RTN
; G E T O P T - compares the input option @A2 to the option list @A1.
; If there is a match, the match number is returned in D1 and Z is set.
; No match returns Z clear and displays the error message at the end of the
; option list.
GETOPT: SUB #2,A1 ; adjustment for first entry
BYP ; scan past seperators
PUSH A2 ; save string address for compares
; calculate address of next entry and place in A1.
OPT.1: MOV @SP,A2 ; restore string pointer
LEA A3,2(A1) ; A3 indexs next entry
TSTW @A3 ; end of table ?
BEQ OPT.5 ; yes-no match.
MOV A3,A1 ; no-get address of command size word
ADDW (A3)+,A1 ; and index to next command.
CLR D5
MOVB (A3)+,D5 ; D5 gets qualifier size in bytes
OPT.2: TRM ; check for end of word
BEQ OPT.4 ; yes-check match count
TSTB @A3 ; check for end of table entry
BEQ OPT.1 ; must be wrong if so.
OPT.3: MOVB @A2,D1
UCS ; convert to upper case
CMPB D1,(A3)+ ; compare strings
BNE OPT.4 ; until no match
ADD #1,A2 ; advance A2
TST D5 ; check for minimum match length
BEQ OPT.2 ; made it-stop counting
SUB #1,D5 ; decrement byte count
BR OPT.2 ; keep testing till line is terminated
OPT.4: TST D5 ; good match has zero count
BNE OPT.1 ; no good-try next
TRM ; good match has no more data
BNE OPT.1
POP ; toss old A2
CLR D1
MOVB @A1,D1 ; D1 gets argument value
LCC #PS.Z ; flag command match found
RTN
; undefined command - Clear Z flag
OPT.5: POP A2
TTYL 2(A3) ; display error message at end of list
CRLF ; [15]
LCC #0
RTN ; return with Z clear
; P T R T Y P - print the string indexed by A1 until a null is found.
PTRTYP: MOVB (A1)+,D1
BEQ 10$
INC D0 ; count characters
TTY
BR PTRTYP
10$: RTN
; G O O D B Y - exit from KERMIT to AMOS for good.
; re-attach comm TCB to its former JCB, if any.
GOODBY: ANDW #^C<FIL!LOK>,-10(A0) ; clear file and locked in mem flags
MOV REMOTE(A0),A5
MOV #^C<REMMOD>,D1 ; clear bits we set (except OIP)
CALL INUSE ; get in-use bit
TSTB ATERM(A0) ; user & comm port the same? [010]
BEQ 4$ ; yes-leave busy bit as is [010]
BCLR D6,D1 ; clear it for bit clear mask
4$: CALL SETSTS ; clear all those bits
CLR D1
MOVW SAVSTS(A0),D1 ; get saved status
AND #^CT$OIP,D1 ; less OIP bit which hangs output!
CALL SETSTS ; set the saved bits
MOV SAVJCB(A0),A6
MOV A6,T.JLK(A5) ; restore any attached job
BEQ 10$
MOV A5,JOBTRM(A6) ; and JCB, if there was one
10$: MOV SAVTDV(A0),T.TDV(A5) ; restore TDV
SAVE A0 ; [16] JRUN the newly reattached job,
; if it is waiting for OIP
MOV SAVJCB(A0),D7 ; get saved job
BEQ 20$ ; no saved job
MOV D7,A0
MOVW JOBSTS(A6),D7 ; get job status
ANDW #J.TOW,D7 ; was job waiting for output?
BEQ 20$ ; no
JRUN J.TOW ; yes
20$: REST A0
SETB DONE(A0) ; set the we are done flag
RTN
; A M O S - move to AMOS level temporarily.
AMOS: SETB DONE(A0) ; set the we are done flag
RTN
; S E T S T S
; This routine sets or clears status bits in D1.
; If D1 is minus, the bits are cleared. If they are +, the bits are set
; This routine is used to set and reset TRMSER status word bits without
; getting T$OIP fouled up and hanging the job's output.
SETSTS: SUPVR
; This routine runs in SUPVR mode
; Used to change TRMSER status bits.
; Made compatible with smart I/O cards by using new monitor calls if
; O/S is new enough for it.
SVLOK ; prevent interrupts
TSTB COMSER(A0) ; do we have COMSER? [015]
BEQ 8$ ; no, do it old way
TSTW D1 ; clear or set bits?
BMI 4$ ; clear bits
; new way to change T.STS word without violating T.SEM rules.
PUSHW D1
TRMRST D1,@A5 ; read status
ORW (SP)+,D1 ; stir in the new bits
TRMWST D1,@A5 ; write status
BR 20$
4$: PUSHW D1
TRMRST D1,@A5 ; read status
ANDW (SP)+,D1 ; pick out the icky bits
TRMWST D1,@A5 ; write status
BR 20$
; old way to change T.STS word
8$: TSTW D1 ; set or clear bits?
BMI 10$ ; clear is negative
ORW D1,@A5 ; set bits if + or 0.
BR 20$ ; done setting...
10$: ANDW D1,@A5 ; clear those bits
20$: LSTS #0 ; unlock CPU & return to user mode
RTN
;;; F I L E T R A N S F E R R O U T I N E S
; S E N D S W
; SENDSW is the state table switch for file transfers. It loops either
; until it finishes, or an error is encountered. The routines called
; by SENDSW change the automaton state.
SENDSW:
MOVB #'S,STATE(A0) ; start with SEND INIT
CLRB N(A0) ; clear the seq number
CLRB NUMTRY(A0) ; and the retry count
CLRB LOGIC(A0) ; CLEAR LOGIC
CLRB RIACK(A0) ; clear the I is ACKed flag
10$: TSTB LOGIC(A0) ; test logic flag
BNE 100$ ; we are done
CTRLC ABORT ; exit on control-C
TSTB DEBUGO(A0) ; debug on ?
BEQ 20$ ; no
TYPE <SENDSW state >
MOVB STATE(A0),D1
TTY
CRLF
CRLF
20$: LEA A6,SWSTAT-4 ; index the state table
MOVB STATE(A0),D7 ; D7 gets the current state
30$: ADD #4.,A6 ; pre-advance
MOVB @A6,D6
BEQ 100$ ; undefined state - so exit
CMPB D6,D7 ; matching state ?
BNE 30$ ; no
ADD #2.,A6 ; yes - advance to offset
ADDW @A6,A6 ; calc address of new routine
CALL @A6 ; execute it
BR 10$ ; loop till we exit
100$: RTN
ABORT: MOVB #'A,STATE(A0) ; flag it as bad.
MOVB #FALSE,LOGIC(A0)
CALL CLOSER
RTN
COMPLT: MOVB #TRUE,LOGIC(A0) ; flag complete o.k.
RTN
; S I N I T
; Send (I) Initiate Packet & receive REMOTEs reply
SINIT: ADDB #1,NUMTRY(A0) ; bump # of tries
CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max?
BLOS 20$
MOVB #'A,STATE(A0)
10$: RTN
20$: LEA A3,PACKET(A0) ; index the packet area
CALL SPAR ; load default data for S packet
CALL FLUSH ; flush pending input
MOVB DF.EOL(A0),EOL(A0) ; use default EOL
SPACK #'S,N(A0),#PARSIZ,PACKET(A0) ; send an S packet
; just in case host requires an EOL character, send the default EOL value.
MOVB #CR,D1 ; send universal EOL value
CALL OUTBYT ; output the EOL to get remote going
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,RECPKT(A0),D4 ; receive a packet
BNE 1000$ ; no packet received ; timeout
; or damaged packet
CMPB D4,#'N ; NAK, try again
JEQ 1000$ ; just return, leave state as is.
CMPB D4,#'Y ; ACK ?
BNE 30$ ; no ACK
CMPB D3,N(A0) ; yes-same # as I sent?
BNE 1000$ ; no-return, same state
; get other side's init info.
SETB RIACK(A0) ; flag we got ACK to I packet
LEA A3,RECPKT(A0) ; index work area
CALL RPAR ; load parameters from work area
CMPB QUOTE(A0),#SPACE ; check for space or null
BHI 32$
MOVB #MYQUOT,QUOTE(A0) ; reset to #
32$: CLRB NUMTRY(A0) ; clear retries
CALL BUMPP ; bump N mod 64.
MOVB #'F,STATE(A0) ; move to state F
JMP 1000$ ; done
30$: CMPB D4,#'E ; error packet received ?
BNE 40$ ; no
CALL PRTERR ; show error
; move to abort state on any undefined TYPEs
40$: MOVB #'A,STATE(A0) ; move to abort state.
1000$: RTN
; S F I L E sends the file header.
SFILE: TSTB FIO+D.ERR(A0) ; error on input file?
BNE 2$ ; yes, move to break state
MOV CMNEXT(A0),D7
AND #NX$END,D7 ; end of specs?
BEQ 4$ ; no
2$: MOVB #'B,STATE(A0) ; yes, send a break
RTN
4$: INCB NUMTRY(A0) ; bump the count
CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max?
BLOS 10$ ; no
MOVB #'A,STATE(A0) ; set state to abort
RTN
10$: CLR D2
MOVB FLLEN(A0),D2
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'F,N(A0),D2,NFILNM(A0) ; send the F packet
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,RECPKT(A0),D4 ; wait for reply
BNE 1000$ ; no reply
; compare received sequence # to expected #
CMPB D4,#'N ; NAK ?
BNE 30$ ; no NAK here
; check to see if NAK is for next block, which we will
; interpret as being an ACK for this block.
CALL NEXTN ; D1 gets NEXT packet #
CMPB D1,D3 ; NAK for next block ?
BNE 1000$ ; no-return with state unchanged
BR 35$ ; yes-treat as ACK for this block
30$: CMPB D4,#'Y ; ACK ?
BNE 40$ ; no
MOVB N(A0),D1 ; D1 gets current SEQ #
CMPB D3,D1 ; yes-is it expected SEQ?
BNE 1000$ ; no-return state unchanged
35$: CLRB NUMTRY(A0) ; yes-clear retries count
CALL BUMPP
LEA A3,PACKET(A0)
CALL BUFFIL ; fill a buffer @A3
MOVB #'D,STATE(A0) ; goto Data state
JMP 1000$
40$: CMPB D4,#'E ; Error packet received
BNE 50$
CALL PRTERR ; show the error
; if any other case, move to abort case
50$: MOVB #'A,STATE(A0) ; move to abort state
1000$: RTN
; S D A T A - sends a portion of file contents
SDATA: INCB NUMTRY(A0) ; bump try count
CMMB NUMTRY(A0),MAXTRY(A0) ; maxxed out ?
BLOS 10$ ; no
MOVB #'A,STATE(A0) ; yes-move to abort state
RTN
10$:
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'D,N(A0),BUFCNT(A0),PACKET(A0) ; send data packet
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,RECPKT(A0),D4 ; receive a packet
JNE 1000$ ; no data received
CMPB D4,#'N ; NAK ?
BNE 15$ ; no
CALL NEXTN ; D1 gets N
CMPB D1,D3 ; NAK for N+1?
BEQ 40$ ; yes-treat as lost ACK for N
JMP 1000$ ; else exit state unchanged
15$: CMPB D4,#'Y ; ACK ?
BNE 70$ ; no
CMPB D3,N(A0) ; right SEQ of ACK?
BNE 1000$ ; no-state unchanged
TSTB LDATA(A0) ; is data length zero?
BEQ 30$ ; yes
;test for graceful abort request from RECeiving Kermit.
MOVB RECPKT+DATA(A0),D7 ; no-get the byte
ANDB #^O177,D7 ; strip to ACSII
CMPB D7,#'Z ; is it abort batch?
BNE 20$ ; no
SETB ABORTB(A0) ; yes, set abort batch flag
BR 30$ ;
20$: CMPB D7,#'X ; is it abort file?
BNE 30$ ; yes
SETB ABORTF(A0)
30$: CALL SHODOT ; tell user we moved some data
40$: CALL BUMPP ; bump packet count
TSTB ABORTF(A0) ; abort file?
BNE 50$ ; yes
CLRB NUMTRY(A0) ; clear the try count
LEA A3,PACKET(A0) ; index the Packet
CALL BUFFIL ; get a buffer
TSTB BUFCNT(A0) ; any data to send ?
BNE 60$
50$: CALL CLOSER ; close file
MOVB #'Z,STATE(A0) ; move to Z state (end of file)
JMP 1000$
60$: MOVB #'D,STATE(A0) ; stay in D state
JMP 1000$
70$: CMPB D4,#'E ; Error packet ?
BNE 1000$
CALL PRTERR
MOVB #'A,STATE(A0) ; move to A state.
1000$: RTN
; S E O F - send the end of file packet.
SEOF: INCB NUMTRY(A0)
CMMB NUMTRY(A0),MAXTRY(A0)
BLOS 10$
MOVB #'A,STATE(A0)
RTN
10$: CLR D2 ; D2 is packet size
TSTB ABORTF(A0) ; aborting this file ( or batch)?
BEQ 20$ ; no
MOV #1,D2 ; yes, set size to 1 byte
MOVB #'D,PACKET+DATA(A0) ; flag "DISCARD" to remote
20$:
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Z,N(A0),D2,PACKET(A0) ; send a Z packet
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,RECPKT(A0),D4 ; get a reply
BNE 1000$ ;
CMPB D4,#'N ; NAK ?
BNE 30$
CALL NEXTN ; D1 gets next N mod 64.
CMPB D1,D3 ; NAK for SEQ+1?
BEQ 40$ ; yes-treat as ACK.
JMP 1000$ ; return as is
30$: CMPB D4,#'Y ; ACK ?
BNE 60$ ; no
CMPB D3,N(A0) ; matching SEQ #?
BNE 1000$ ; no-return as is
40$: CALL BUMPP ; bump the N value
CALL ENDTM ; display speed stats
CALL DINGEM ; [015]
TSTB ABORTB(A0) ; abort batch? [015]
BNE 50$ ; yes [015]
CALL GETNXT ; any more files?
BVS 50$ ; no
TSTB FIO+D.ERR(A0) ; file error?
BNE 50$ ; yes, end transfer
CALL GTSIZE ; calc file size
CALL STARTT ; set start time
MOVB #'F,STATE(A0) ; reset state for more files
; CLRB N(A0) ; clear the seq number
CLRB NUMTRY(A0) ; and the retry count
JMP 1000$
; we found the "free time" for multiple files in 1991!
50$: MOVB #'B,STATE(A0) ; goto Break state
JMP 1000$
60$: CMPB D4,#'E ; error packet ?
BNE 70$ ; no
CALL PRTERR ; yes-print erorrrr.
JMP 1000$
70$: MOVB #'A,STATE(A0) ; abort on undefined types
1000$: RTN
; S B R E A K - sends a break frame (no more files to send).
SBREAK: INCB NUMTRY(A0) ; bump the try count
CMMB NUMTRY(A0),MAXTRY(A0) ; maxxed out?
BLOS 10$ ; no
MOVB #'A,STATE(A0) ; yes-abort state
RTN
10$:
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'B,N(A0),#0,PACKET(A0) ; send a B packet
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,RECPKT(A0),D4 ; get a reply
BNE 1000$ ; no reply
CMPB D4,#'N ; NAK ?
BNE 20$
CALL NEXTN ; D1 gets next N mod 64.
CMPB D1,D3 ; NAK for SEQ+1?
BEQ 30$ ; yes-treat as ACK.
JMP 1000$ ; return as is
20$: CMPB D4,#'Y ; ACK ?
BNE 40$ ; no
CMPB D3,N(A0) ; matching SEQ #?
BNE 1000$ ; no-return as is
30$: CALL BUMPP ; bump the N value
MOVB #'C,STATE(A0) ; goto Complete state
JMP 1000$
40$: CMPB D4,#'E ; error packet ?
BNE 50$ ; no
CALL PRTERR ; yes-print erorrrr.
JMP 1000$
50$: MOVB #'A,STATE(A0) ; abort on undefined types
1000$: RTN
; R E C S W - is the state table switch for receiving files.
RECSW: MOVB #'R,STATE(A0) ; start with RECV INIT state
CLRB N(A0) ; clear the seq number
CLRB NUMTRY(A0) ; and the retry count
CLRB LOGIC(A0) ; clear logic
CLRB RIACK(A0) ; clear the I is ACKed flag
10$: TSTB LOGIC(A0) ; test logic flag
BNE 100$ ; we are done
CTRLC RABOR ; or user wants out
TSTB DEBUGO(A0) ; debug on ?
BEQ 20$ ; no
TYPE <RECSW state >
MOVB STATE(A0),D1
TTY
CRLF
20$: LEA A6,RCSTAT-4 ; index the state table
MOVB STATE(A0),D7 ; D7 gets the current state
30$: ADD #4.,A6 ; pre-advance
MOVB @A6,D6
BEQ 100$ ; undefined state - so exit
CMPB D6,D7 ; matching state ?
BNE 30$ ; no
ADD #2.,A6 ; yes - advance to offset
ADDW @A6,A6 ; calc address of new routine
CALL @A6 ; execute it
BR 10$ ; loop till we exit
100$: RTN
RABOR: MOVB #'A,STATE(A0) ; flag transfer as bad
MOVB #FALSE,LOGIC(A0)
RTN
RCOMP: MOVB #TRUE,LOGIC(A0) ; flag complete o.k.
RTN
; R I N I T - is the receive init routine
; Wait for the send-init packet from sending Kermit.
RINIT: ADDB #1,NUMTRY(A0) ; count the tries
CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max?
BLOS 20$
MOVB #'A,STATE(A0)
RTN
20$:
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,PACKET(A0),D4 ; receive a packet
BNE 50$ ; no packet received ; timeout
CMPB D4,#'S ; got an S packet ?
BNE 30$ ; no S packet
; get other side's init data
LEA A3,PACKET(A0) ; index data packet address
CALL RPAR ; get parameters
LEA A3,PACKET(A0) ; index data packet address
CALL SPAR ; send our parameters
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,N(A0),#PARSIZ,PACKET(A0); send ACK with reply
SETB RIACK(A0) ; flag ACK to I has been sent
MOVB NUMTRY(A0),OLDTRY(A0) ; save try count
CLRB NUMTRY(A0) ; clear count
CALL BUMPP ; bump packet #
MOVB #'F,STATE(A0) ; bump state
JMP 1000$ ; end
30$: CMPB D4,#'E ; error received ?
BNE 40$
CALL PRTERR ; display the error.
MOVB #'A,STATE(A0)
JMP 1000$ ; done
; all others default to A state
40$: MOVB #'A,STATE(A0) ; received junk-abort
JMP 1000$
; no packet received - send a NAK
50$: SPACK #'N,N(A0),#0,NFILNM(A0) ; send a NAK packet
; return without state change
1000$: RTN
; R F I L E - receive a file header frame with the filename.
RFILE: ADDB #1,NUMTRY(A0) ; count the tries
CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max?
BLOS 20$
MOVB #'A,STATE(A0)
RTN
20$:
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,NFILNM(A0),D4 ; receive a packet (expecting filename)
JNE 500$ ; no packet received ; timeout
CMPB D4,#'S ; got an S packet ?
BNE 50$ ; no
; SEND-INIT received, maybe ACK was lost.
CALL NEXTO ; D1 gets next OLDTRY value
CMPB D1,MAXTRY(A0) ; time to give up?
BLOS 30$ ; no
MOVB #'A,STATE(A0)
JMP 1000$ ; yes-goto abort state.
30$: MOVB N(A0),D1 ; D1 gets current packet #
CALL PREVP ; get previous packet #
CMPB D1,D3 ; previous packet ?
BNE 40$ ; no
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,D3,#PARSIZ,PACKET(A0) ; yes-ack again with SEND-INIT
CLRB NUMTRY(A0) ; clear retry count
JMP 1000$ ; stay in state.
40$: MOVB #'A,STATE(A0) ; goto abort
JMP 1000$ ; done
50$: CMPB D4,#'Z ; end of file?
BNE 80$ ; no
CALL NEXTO ; D1 gets next oldtry
CMPB D1,MAXTRY(A0) ; time to give up?
BLOS 60$ ; no
MOVB #'A,STATE(A0) ; yes-abort
JMP 1000$ ; done
60$: MOVB N(A0),D1 ; get N
CALL PREVP ; calc previous packet # to D1
CMPB D1,D3 ; same ?
BNE 70$ ; no
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,D3,#0,PACKET(A0) ; yes-ack Z from file before!
CLRB NUMTRY(A0) ; reset tries
JMP 1000$ ; done
70$: MOVB #'A,STATE(A0) ; goto ABORT otherwise.
JMP 1000$
80$: CMPB D4,#'F ; is it the blessed file header yet?
JNE 200$ ; no
CMPB D3,N(A0) ; yes-is the packet # correct?
BNE 70$ ; no-move to abort state.
CALL RFILNM ; process the filename & open.
BEQ 90$ ; it opened ok
CALL LFERR ; show local file error
MOVB #'A,STATE(A0) ; move to abort state
JMP 1000$ ; done
90$: TSTB NOTALK(A0) ; do we have a user terminal?
BNE 120$ ; no-bypass message
CRLF
TYPE <Receiving >
CLR D0
MOVB LDATA(A0),D0
LEA A1,FILNAM(A0)
BR 110$
100$: MOVB (A1)+,D1
TTY
110$: DBF D0,100$
TYPE < as >
PFILE FIO(A0)
CRLF
120$:
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,N(A0),#0,PACKET(A0) ; send ACK for the F packet
MOVB NUMTRY(A0),OLDTRY(A0) ; reset try counters
CLRB NUMTRY(A0)
CALL BUMPP ; get next packet #
MOVB #'D,STATE(A0) ; move to data state
JMP 1000$
200$: CMPB D4,#'B ; break ?
BNE 300$ ; no
CMPB D3,N(A0) ; yes-is packet # correct?
BNE 310$
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,N(A0),#0,PACKET(A0) ; send ACK for the B packet
MOVB #'C,STATE(A0) ; and move to Complete state
JMP 1000$ ; end
300$: CMPB D4,#'E ; error frame ?
BNE 400$ ; no
CALL PRTERR ; show it
310$: MOVB #'A,STATE(A0) ; move to abort
JMP 1000$
400$: MOVB #'A,STATE(A0) ; goto abort state
JMP 1000$
; didnt get a packet
500$:
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'N,N(A0),#0,PACKET(A0) ; send NAK
1000$: RTN
; R D A T A - receives the data packets that make up the file.
RDATA: ADDB #1,NUMTRY(A0) ; count the tries
CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max?
BLOS 20$
MOVB #'A,STATE(A0)
RTN
20$:
; RPACK LEN,SEQ,PACKET,TYPE
RPACK D2,D3,PACKET(A0),D4 ; receive a packet (expecting filename)
JNE 500$ ; no packet received ; timeout
CMPB D4,#'D ; got a Data packet ?
JNE 60$ ; no
CMPB D3,N(A0) ; yes-is it right packet # ?
BEQ 50$ ; YES
CALL NEXTO ; NO-get next OLDTRY value in D1
CMPB D1,MAXTRY(A0) ;
BLOS 25$
MOVB #'A,STATE(A0) ; abort -retries exceeded
JMP 1000$ ; done
25$: MOVB N(A0),D1 ; D1 gets current packet #
CALL PREVP ; get previous packet #
CMPB D1,D3 ; previous packet ?
BNE 40$ ; no
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,D3,#6,PACKET(A0) ; yes-re-ack.
CLRB NUMTRY(A0) ; clear retry count
JMP 1000$ ; stay in state.
40$: MOVB #'A,STATE(A0) ; goto abort
JMP 1000$ ; done
; received valid data frame - output it
50$: CALL BUFEMP ; empty the buffer to disk
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,N(A0),#0,PACKET(A0) ; ack the data
MOVB NUMTRY(A0),OLDTRY(A0) ; reset the try counters
CLRB NUMTRY(A0) ; clear retry count
CALL BUMPP ; bump the packet #
MOVB #'D,STATE(A0) ; stick in D state.
CALL SHODOT ; tell user we moved some data
JMP 1000$ ; stay in state.
60$: CMPB D4,#'F ; file header?
BNE 80$ ; no
CALL NEXTO ; D1 gets next oldtry
CMPB D1,MAXTRY(A0) ; time to give up?
BLOS 70$ ; no
65$: MOVB #'A,STATE(A0) ; yes-abort
JMP 1000$ ; done
70$: MOVB N(A0),D1 ; get N
CALL PREVP ; calc previous packet # to D1
CMPB D1,D3 ; same ?
BNE 65$ ; no
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,D3,#0,PACKET(A0) ; yes-ack again
CLRB NUMTRY(A0) ; reset tries
JMP 1000$ ; done
80$: CMPB D4,#'Z ; end of file?
BNE 200$ ; no
CMPB D3,N(A0) ; yes-is the packet # correct?
BNE 65$ ; no-move to abort state.
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'Y,D3,#0,PACKET(A0) ; ack the Z
CALL CLOSER
LOOKUP FIO(A0) ; do file lookup
CALL GTSIZE ; to get file size
CALL ENDTM ; show elapsed time & speed
CALL DINGEM ; [015] alert user
CALL BUMPP ; bumpthepacket#
MOVB #'F,STATE(A0) ; return the F state
BR 1000$
200$: CALL CLOSER ; close file if open
CMPB D4,#'E ; error frame ?
BNE 400$ ; no
CALL PRTERR ; show it
MOVB #'A,STATE(A0) ; move to abort
JMP 1000$
400$: MOVB #'A,STATE(A0) ; goto abort state
JMP 1000$
; didnt get a packet
500$:
; SPACK TYPE,SEQ,SIZE,PACKET
SPACK #'N,N(A0),#0,PACKET(A0) ; send NAK
1000$: RTN
;;; P A C K E T U T I L I T I E S
; B U M P P - bumps the current packet mod 64. The new N is returned in D1,
; and is also updated in N(A0).
BUMPP: BCALL NEXTN
MOVB D1,N(A0)
RTN
; N E X T N - returns the next N(A0) value in D1. It does NOT update N(A0).
NEXTN: CLR D1
MOVB N(A0),D1
ADD #1,D1
ANDB #63.,D1
RTN
; N E X T O - returns the next OLDTRY(A0) value in D1.
; It does not update OLDTRY(A0).
NEXTO: CLR D1
MOVB OLDTRY(A0),D1
ADD #1,D1
ANDB #63.,D1
RTN
; P R E V P - returns the prior packet to D1 in D1. ( D1-1 mod 64. )
PREVP: SUB #1,D1
AND #63.,D1
RTN
; P R T E R R - prints the error message contained in the Error packet
PRTERR: CLR D0 ;
MOVB LDATA(A0),D0 ; get length of data field
LEA A1,DATA(A3)
TTYL ABTTTL
BR 30$
20$: MOVB (A1)+,D1
TTY
30$: DBF D0,20$
CRLF
RTN
; R P A R - get the REMOTE's send-init parameters.
; At entry, A3 indexs the packet area
; revised [21]
RPAR: MOVB #'1,CHKT(A0) ; default to 1 char checksum
MOVB #SPACE,REPT(A0) ; and no repeat
CLRB QBIN(A0) ; default to no quoting, 7 bit path
10$: LEA A1,DATA(A3) ; index the payload area
CLR D1
MOVB (A1)+,D1 ; get MAXL byte
AND #177,D1 ; strip to ASCII in case of parity
UNCHAR D1
CMPB D1,#PAKSIZ ; bigger than protocol max?
BHI 19$ ; yes, use default
15$: CMPB D1,MXPKSZ(A0) ; compare to user's max
BLO 18$ ; but no higher
MOVB MXPKSZ(A0),D1 ; use our local max
18$: CMPB D1,#10. ; MAXL should be at least 10.
BHIS 30$
19$: MOV #80.,D1 ; yes, use default MAXL of 80.
30$: MOVB D1,SPSIZ(A0) ; set send packet size
MOVB (A1)+,D1 ; get TIME byte
UNCHAR D1
MOV D1,TIMINT(A0) ; set when I should time out
MOVB (A1)+,D1 ; get NPAD byte
UNCHAR D1
MOVB D1,PAD(A0) ; set pad count.
MOVB (A1)+,D1 ; get PADC byte
CTL D1
MOVB D1,PADCHR(A0) ; set pad character
MOVB (A1)+,D1 ; get EOL byte
UNCHAR D1
MOVB D1,EOL(A0) ; set end of line char
MOVB (A1)+,D1 ; get QCTL byte
CMPB D1,#SPACE
BHI 40$
MOV #MYQUOT,D1 ; default it
40$: MOVB D1,QUOTE(A0) ; set control-quote.
CLR D2
MOVB LDATA(A0),D2 ; get size of data area
SUB #6,D2 ; have more than basic 6 bytes?
JLOS 140$ ; no more data
; get QBIN
MOVB (A1)+,D1 ; get QBIN byte
AND #177,D1 ; strip to ASCII
CMPB D1,#'Y ; will quote if we request?
BNE 50$ ; no
MOV #1,D0 ; yes
BR 80$
; allowable ranges are decimal 33-62 & 96-126. Reject all others.
50$: CMPB D1,#SPACE ; was it a space through null?
BLOS 70$ ; not legal 8b quote value
CMPB D1,#62. ; ASCII 33-62?
BLOS 60$ ; yes-use it
CMPB D1,#127. ; check high boundary of 2nd range
BHIS 70$ ; not legal 8b quote value
CMPB D1,#96. ; check lower bound of 2nd range
BHIS 60$ ; legal
BR 70$ ; not legal
60$: MOV #2,D0 ; set case 2 - we have valid 8b q
BR 80$
70$: MOV #0,D0 ; case 0 - we have no 8b q info
; D0 is 0, 1 or 2
80$: DEC D0 ; was it 0?
BCC 90$ ; no
CMPB PARITY(A0),#'N ; do we have NO parity?
SETNE QBIN(A0) ; P=None, allow full 8 bits
; P=other, mask to 7 bits
BR 110$
90$: DEC D0 ; was it 1? (quote if needed only)
BCC 100$ ; no
CMPB PARITY(A0),#'N ; do we have NO parity?
BEQ 95$ ; yes-flag 8 bits, no quoting
MOVB #'&,QBIN(A0) ; else 7 bits, default quote
BR 110$
95$: CLRB QBIN(A0)
BR 110$
100$: MOVB D1,QBIN(A0) ; got QBIN - 7 bits w/quoting
110$: SUB #1,D2
BEQ 140$ ; no more
; get CHKT
MOVB (A1)+,D1 ; get CHKT byte
;;[023] CMPB D1,#'2 ; higher than 2?
CMPB D1,DF.CHK(A0) ; higher than max user value? [023]
BHI 120$ ; yes-force to one
BEQ 130$ ; no-allow it
CMPB D1,#1 ; do not allow zero
BEQ 130$
120$: MOV #'1,D1 ; force to 1 if BOTH SIDES don't agree
130$: MOVB D1,CHKT(A0) ; set checksum method
SUB #1,D2
BEQ 140$
; get REPT
MOVB (A1)+,D1 ; get REPT byte
UNCHAR D1
MOVB D1,REPT(A0) ; set repeat prefix
140$: CMPB QUOTE(A0),#SPACE ; quote undefined ?
BNE 150$ ; no-defined
MOVB #'#,QUOTE(A0) ; yes-use default
150$: RTN
; S P A R - fill data area with send-init parameters
SPAR: LEA A1,DATA(A3) ; index payload area
CLR D1
MOVB MXPKSZ(A0),D1 ; get max packet size
CHAR D1
MOVB D1,(A1)+ ; 1 max packet size
MOV DF.TIM(A0),D1 ; get our default value
CHAR D1
MOVB D1,(A1)+ ; 2 # of seconds to my timeout
MOV #MYPAD,D1
CHAR D1
MOVB D1,(A1)+ ; 3 # of padding characters
MOV #MYPCHR,D1
CTL D1 ; the pad character translated
MOVB D1,(A1)+ ; 4
MOV #0,D1 ; we do not need an EOL this end.
CHAR D1
MOVB D1,(A1)+ ; 5 end of line character
MOV #MYQUOT,D1
MOVB D1,(A1)+ ; 6 control quoting character
; handle QBIN
MOVB QBIN(A0),D1 ; get QBIN
BEQ 40$ ; only quote on request
CMPB D1,#^O377 ; is QBIN already defined?
BNE 60$ ; yes, else
40$: MOVB #'Y,D1 ; default to quoting on request
60$: MOVB D1,(A1)+ ; 7 the optional binary quoter
MOVB DF.CHK(A0),(A1)+ ; 8 the optional checkbyte type
PARSIZ =8.
RTN
; FLUSH deletes all pending input from the input buffer
FLUSH: MOV REMOTE(A0),A5
10$: TST T.ICC(A5) ; more data?
BEQ 20$ ; no, done
TTYIN ; dump a byte
BR 10$
20$: RTN
; B U F F I L - fills a packet @A3 with data.
; we will limit data size to 3 less than actual size to allow the last
; character to be control and 8bit quoted, without look-ahead schemes.
; the worst cases are '# = &## and '& = &#&.
; data count goes to BUFCNT(A0).
; At entry, A3 must index the data packet area to be filled,
; CHKNOW(A0) must contain the binary checkbyte size
BUFFIL: CLR D0
MOVB SPSIZ(A0),D0 ; D0 gets max msg size to remote
SUBB CHKNOW(A0),D0 ; less size of checkbyte
SUB #<3.>,D0 ; less overhead bytes
LEA A1,DATA(A3) ; index the data area
10$: CALL INBYTE ; get a data byte
TST FIO+D.SIZ(A0) ; end of file ?
BEQ 100$ ; yes
; test for high bit
BTST #7.,D1 ; no-test for eighth bit set.
BEQ 30$ ; bit 7 is clear
; handle high bit prefixing, if any
MOVB QBIN(A0),D7 ; get 8bit quote character.
BMI 20$ ; no high bit can be used
BEQ 30$ ; no 8 bit quoting needed!
MOVB D7,(A1)+ ; buffer the 8bit quote
SUB #1,D0 ; decrement the count
20$: AND #^O177,D1 ; strip to ascii
30$: MOVB D1,D2
ANDB #^O177,D2 ; D2 gets stripped version
CMPB D2,#DEL ; is it a DEL
BEQ 35$ ; this is non-printable.
; also prefix the prefix, and the high bit prefix with the prefix!
CMPB D2,QUOTE(A0) ; is this character the prefix?
BNE 32$ ; no
MOVB D2,(A1)+ ; yes-prefix it with itself
SUB #1,D0
32$: TSTB QBIN(A0) ; check 8 bit quoting
BLE 34$ ; none
CMPB D2,QBIN(A0) ; matching?
BNE 34$ ; no- [10/23/84 rpr]
MOVB QUOTE(A0),(A1)+ ; yes-quote it first
SUB #1,D0 ; less one for quote
34$: CMPB D2,#SPACE ; is it control ?
BHIS 50$ ; no-prinatble
; unctrol-ify the character, while preserving possible bit7.
35$: CTL D1 ; uncontrol-ify
40$: MOVB QUOTE(A0),(A1)+
SUB #1,D0
50$: MOVB D1,(A1)+
SUB #1,D0
BGT 10$ ; loop till filled up
100$: LEA A6,DATA(A3) ; ptr to start of data
MOV A1,D1 ; get ending ptr
SUB A6,D1 ; D1 gets outgoing data size
MOVB D1,BUFCNT(A0) ; set data count
RTN
; INBYTE gets a byte from a disk file.
INBYTE: TST FIO+D.SIZ(A0) ; EOF already?
BEQ 10$ ; yes, done
FILINB FIO(A0) ; get a byte from file
10$: RTN
; close file if it is open.
CLOSER: TSTB FIO+D.OPN(A0) ; is file open?
BEQ 10$ ; no
CLOSE FIO(A0) ; yes-close the file
CLRB FIO+D.OPN(A0) ; and clear open code!
10$: RTN
; B U F E M P - empties the incoming data contents of the packet @A3 to
; the FIO(A0) file.
BUFEMP: LEA A1,DATA(A3) ; index the data area
CLR D0
MOVB LDATA(A0),D0 ; D0 gets the count
BR 600$ ; check for 0 bytes in packet [21]
10$: CALL GETBYT ; get an input byte [10/23/84]
; doing 8bit quoting?
MOVB QBIN(A0),D2 ; get 8bit quote character
BLE 100$ ; no binary quoting
CMPB D2,D1 ; is it binary quote ?
BNE 100$ ; no
; 8bit quote received. Evaluate following characters.
MOV #^O200,D3 ; set high bit flag
CALL GETBYT ; get next byte
CALL EVALQ ; evaluate this & next chars
ORB D3,D1 ; combine evaluated char & top bit
BR 500$
100$: CLR D3 ; clear high bit flag
CALL EVALQ ; evaluate
500$: FILOTB FIO(A0) ; output the data byte
600$: TST D0
BGT 10$ ; output all bytes
RTN
; E V A L Q - evaluates the byte in D1. Expands quoted control characters,
; quoted quotes, and eighth bit quotes and quoted eighth bit quotes.
EVALQ: CMPB D1,QUOTE(A0) ; is it a quote ?
BNE 100$ ; no-just return with value
CALL GETBYT ; yes - get next byte
MOVB D1,D7
AND #^O177,D7 ; get stripped version of character
CMPB D7,QUOTE(A0) ; is it double qoute ?
BEQ 100$ ; yes-pass it literally
TSTB QBIN(A0) ; test for 8 bit quote active
BLE 10$ ; no-sending binaries
CMPB D1,QBIN(A0) ; 8bit quote prefixed by ctl quote?
BEQ 100$ ; yes-use literally.
10$: CTL D1 ; turn it to control
100$: RTN
; G E T B Y T - gets the next data byte for BUFEMP.
GETBYT: MOVB (A1)+,D1 ; get a byte
TSTB QBIN(A0) ; allowing binaries?
BEQ 10$ ; yes
AND #^O177,D1 ; no-strip to seven
10$: SUB #1,D0 ; adjust count
RTN
; R E C P A K - receives a data packet from the remote computer.
; This routine simply inputs a single packet, without performing
; packet checking or other details.
; On Entry, A3 indexs the packet destination
; On exit, D0 is the received checkbyte
; D1 is the calculated checkbyte
; D2 is the LEN
; D3 is the SEQ
; D4 is the TYPE
; Z is set if a packet is received
; CHKNOW(A0) contains binary 1,2, or 3 for checkbyte size
RECPAK:
; initialize packet receiver
CALL SETEND ; set timer ending time
MOV REMOTE(A0),A5 ; index the remote TCB
10$: CALL GETREM ; get remote character
JNE 100$ ; timeout, no data
; syncronize the packet to the mark byte (usually ^A)
AND #^O177,D1 ; strip parity here, always
CMPB D1,RMARK(A0) ; start of packet ?
BNE 10$ ; no-keep looking
20$: MOV A3,A1 ; use A1 as work register.
MOVB D1,(A1)+ ; yes-store it
; get the length from the next byte
CALL GETREM ; get LEN
JNE 100$ ; timeout, no data
CMPB D1,RMARK(A0) ; start of packet ?
BEQ 20$ ; yes-resync.
MOVB D1,(A1)+ ; else save the LEN
CALL CLRSUM ; clear checkbytes
CALL ACCUM
UNCHAR D1 ; convert to binary
MOV D1,D2 ; save the LEN
; receive the SEQ byte
30$: CALL GETREM ; get SEQ
JNE 100$ ; timeout, no data
CMPB D1,RMARK(A0) ; start of packet ?
BEQ 20$ ; yes-resync.
MOVB D1,(A1)+ ; else save the SEQ
CALL ACCUM
MOV D1,D3
UNCHAR D3 ; D3 is sequence #
; receive the TYPE byte
CALL GETREM ; get TYPE
JNE 100$ ; timeout, no data
CMPB D1,RMARK(A0) ; start of packet ?
BEQ 20$ ; yes-resync.
MOVB D1,(A1)+ ; else save the TYPE
CALL ACCUM ; update checkbyte
MOV D1,D4 ; D4 gets the type
; calc the data area size.
MOV D2,D1 ; D1 gets the binary length
CALL CALCHK ; calculate checkbyte size
CLR D0
MOVB CHKNOW(A0),D0 ; get checkbyte size
ADD #2.,D0 ; D0 gets size of SEQ,TYPE
SUB D0,D1 ; D1 gets size of data area
MOVB D1,LDATA(A0) ; save length of data
MOV D1,D0 ; D0 gets length
CMPB D0,#95.-3. ; is it legal ?
JHI 10$ ; no-toss it & try again
BR 45$ ; use DBF to control buffering of
; 0 or more characters.
; buffer the data bytes
40$: CALL GETREM ; get a byte
JNE 100$ ; timeout
CMPB D1,RMARK(A0) ; start of packet ?
BEQ 20$ ; yes-resync.
MOVB D1,(A1)+ ; store data
CALL ACCUM ; update checkbyte
45$: DBF D0,40$ ; gather packet.
; now get the checkbyte(s)
CALL GETREM ; get CHECK
JNE 100$ ; timeout, no data
CMPB D1,RMARK(A0) ; start of packet ?
JEQ 20$ ; yes-resync.
UNCHAR D1 ; convert CHECK
CLR D0
MOVB D1,D0 ; D0 gets checkbyte byte #1
CMPB CHKNOW(A0),#3. ; three character checkbyte?
BNE 50$ ; no-leave CHECK type as normal
; handle 3 byte 16 bit CCITT reverse CRC here
ANDB #^B1111,D0 ; yes, mask 1st byte to 4 bits
RORW D0,#4. ; move 1st byte bits to B15-B12
CALL GETREM ; and get second byte
JNE 100$ ; receive data fault
UNCHAR D1 ; convert it
LSLW D1,#6. ; shift 2nd byte to bits 11-6
ORW D1,D0 ; D0 gets bits 11-0
CALL GETREM ; yes- get 3rd byte
JNE 100$ ; receive data fault
UNCHAR D1 ; convert it
ORW D1,D0 ; D0 gets complete checkbytes
MOVW FRMSUM(A0),D1 ; D1 gets calculated CRC-ITT
BR 90$
; handle 2 byte 12 bit checksum here
50$: CMPB CHKNOW(A0),#2. ; two character checkbytes?
BNE 60$ ; no-leave CHECK type as normal
CALL GETREM ; yes- get second byte
JNE 100$ ; receive data fault
UNCHAR D1 ; convert it
LSL D0,#6. ; shift 1st byte to bits 11-6
ORW D1,D0 ; D0 gets bits 11-0
MOVW ASSUM(A0),D1 ; D1 gets calculated ASSUM
ANDW #^B0000111111111111,D1 ; mask it to 12 bits only
BR 90$
; handle one byte 6 bit checksum here
60$: CLR D1
MOVB ASSUM+.B0W7(A0),D1 ; {ok} get calculated sum
MOV D1,D7 ; twice
LSRW D7,#6. ; move bits 7-6 to 1-0
ANDW #3,D7 ; toss all other bits
ADDW D7,D1 ; add to sum
ANDW #^O77,D1 ; strip to 6 bits.
90$: TSTB DEBUGO(A0) ; debug mode ?
JEQ 95$ ; no
PUSH D1
CLR D1
TYPE <==Received Packet # >
MOV D3,D1
DCVT 2,OT$TRM!OT$TSP ; output as 2 characters
TYPE <, Type >
MOV D4,D1
TTY
TYPE < Length: >
MOV D2,D1
DCVT 2,OT$TRM
CRLF
TYPE <Checkbytes >
MOV @SP,D1 ; get calced sum
CMPW D0,D1 ; do they match ?
BNE 93$ ; no
TYPE <match (>
DCVT 0,OT$TRM
TYPE <)>
BR 94$
93$: TYPE <calculated = >
DCVT 0,OT$TRM
TYPE <, received = >
MOV D0,D1
DCVT 0,OT$TRM
94$: CRLF
CRLF
POP D1
95$: TSTB NOTALK(A0) ; are we showing crc errors?
BNE 98$ ; no
CMPW D0,D1 ; compare checkbytes
BEQ 96$ ; no error
TYPE c
BR 98$
; come here if packet is O.K. Check for NAK. If NAK, put n on screen
96$: CMPB D4,#'N ; was it a NAK?
BNE 98$
TYPE n
98$: CMPW D0,D1 ; compare checkbytes
RTN
; come here on timeout while waiting for packets.
; show timeouts as t's if there is a user watching.
100$: TSTB NOTALK(A0) ; TCB owned by KERMIT job?
BNE 110$ ; yes - do not type anything
TYPE <t> ; no-go ahead & show user kermit
110$: LCC #0 ; flag timeout
RTN ;
; S N D P A K - sends a packet.
; On Entry, A3 indexs the packet destination
; D2 is the LEN
; D3 is the SEQ
; D4 is the TYPE
; At exit, CHKNOW(A0) contains the checkbyte size used.
SNDPAK: TSTB DEBUGO(A0)
BEQ 30$
TYPE <Sending ">
MOVB D4,D1
TTY
TYPE <" packet # >
CLR D1
MOVB D3,D1
DCVT 0,OT$TRM
TYPE < of length >
MOVB D2,D1
DCVT 0,OT$TRM
CRLF
TYPE <Data =">
SAVE A2,D0
LEA A2,DATA(A3)
MOV D2,D0
SUB #1,D0
BMI 20$
10$: MOVB (A2)+,D1
TTY
DBF D0,10$
20$: REST A2,D0
TYPECR <">
CRLF
; send a packet to the remote KERMIT
30$: MOV REMOTE(A0),A5 ; index remote TCB
CLR D0
MOVB PAD(A0),D0 ; get pad count
MOVB PADCHR(A0),D1 ; and pad character
BR 50$
40$: TTYOUT ; send the pad character
CALL STALL ; stall, if needed
50$: DBF D0,40$ ; output pad chars while D0#0
MOV A3,A1 ; A1 is work pointer
MOVB RMARK(A0),(A1)+ ; buffer MARK character
MOV D2,D1 ; D1 gets LEN
CALL CALCHK ; calculate checkbyte size
ADDB CHKNOW(A0),D1 ; add size of checkbyte
ADD #2.,D1 ; plus SEQ & TYPE
CHAR D1 ; make it printable
MOVB D1,(A1)+ ; store LEN
CALL CLRSUM
CALL ACCUM ; update checkbyte & CRC
MOV D3,D1
CHAR D1
MOVB D1,(A1)+ ; store SEQ
CALL ACCUM ; update checkbyte & CRC
MOVB D4,(A1)+ ; store TYPE
MOVB D4,D1
CALL ACCUM ; update checkbyte & CRC
; data (if any) is already in buffer. Add it to checkbyte
CLR D1
BR 70$
60$: MOVB (A1)+,D1 ; get a byte
CALL ACCUM
70$: DBF D2,60$ ; loop till all data checked
; handle checkbyte(s) translation
; [015] add code for three character CRC
75$: CMPB CHKNOW(A0),#3. ; three character checkbyte ?
BNE 80$ ; no - try for two!
; three character checkbyte
CLR D1
MOVW FRMSUM(A0),D1 ; get all bits
CLR D7
MOVW D1,D7 ; in two regs
ROLW D7,#4. ; position bits D15-D12
ANDW #^B1111,D7 ; strip to 4 bits
CHAR D7 ; make it printable
MOVB D7,(A1)+ ; store D15-D12
MOVW D1,D7 ; in two regs
LSRW D7,#6. ; get bits D11-D6 in low 6
ANDW #^B111111,D7 ; strip to 6 bits
CHAR D7 ; make it printable
MOVB D7,(A1)+ ; store D11-D6
ANDW #^B111111,D1 ; strip to 6 bits
CHAR D1 ; make it printable
MOVB D1,(A1)+ ; store checkbyte bits D5-D0
BR 100$
80$: CMPB CHKNOW(A0),#2. ; two character checkbyte ?
BNE 90$ ; no - must be one character
; two character checkbyte
MOVW ASSUM(A0),D1 ; get all bits
MOV D1,D7 ; in two regs
LSR D7,#6. ; position bits D11-D6
AND #^O77,D7 ; strip to 6 bits
CHAR D7 ; make it printable
MOVB D7,(A1)+ ; store D11-D6
AND #^O77,D1 ; strip to 6 bits
CHAR D1 ; make it printable
MOVB D1,(A1)+ ; store checkbyte bits D5-D0
BR 100$
90$: MOVB ASSUM+.B0W7(A0),D1 ; {ok} D1 gets low eight of sum
MOV D1,D7 ; D7 gets same
AND #^O300,D7 ; take just bits 7-6.
LSR D7,#6. ; shift to bits 1-0
ADD D7,D1 ; D1 gets sum
AND #63.,D1 ; make it six bits again.
CHAR D1 ; make it prinatble
MOVB D1,(A1)+ ; store checkbyte
; check for EOL character
100$: MOVB EOL(A0),D7 ; remote need any EOL ?
BEQ 110$ ; no
MOVB D7,(A1)+ ; yes-store it
; calculate size of buffered packet from pointer displacement
110$: MOV A1,D0 ; current position
SUB A3,D0 ; less start is length
SUB #1,D0
120$: MOVB (A3)+,D1 ; get a byte
TTYOUT ; output it to REMOTE
CALL STALL ; stall ,if needed
DBF D0,120$ ; till packet is sent
RTN
; O U T B Y T - This routine outputs the byte in D1 to the remote.
OUTBYT: MOV REMOTE(A0),A5 ; get TCB pointer for remote
TTYOUT ; send the byte out
RTN
; S T A L L - stalls a certain amount of time after output in progress
; is lowered. At entry, A5 must index the output TCB.
STALL: TSTB STLCHR(A0) ; do we need to stall?
BEQ 20$ ; no
10$: CTRLC 20$ ; abort - CTS must be low
TSTB @A5
BMI 10$ ; wait for OIP to drop
CLR D7
MOVB STLCHR(A0),D7
MUL D7,#10000./100. ; transform to ticks
SLEEP D7
20$: RTN
; SREMOT - send the A1 string to the remote
SREMOT: MOV REMOTE(A0),A5 ; index to remote TCB
10$: MOVB (A1)+,D1
BEQ 100$
CMPB D1,#-1 ; is it wait byte?
BNE 20$ ; no
SLEEP #10000./2. ; yes, wait .5 seconds
BR 10$
20$: TTYOUT
BR 10$
100$: RTN
; C A L C H K - determines the current checkbyte size.
; This routine unifies the logic needed to force 1 byte checkbytes on SEND-INIT
; fields and their ACKS.
; At entry,
; D2 contains the LEN in binary
; D4 contains the packet type
; At exit, CHKNOW(A0) contains the binary value of the current checkbyte size.
CALCHK: CLR D7
MOVB CHKT(A0),D7 ; get checkbyte type
SUBB #'0,D7 ; less ASCII bias
; if NAK, we can deduce packet size from LEN
; this is useful if the 1st packet after changing checkbyte types is damaged.
; The other side will NAK, and we can recover the right length from the LEN
; of the NAK packet. (ACK packets may have filenames or discard info appended
; their size is not predictable.)
CMPB D4,#'N ; is it a NAK?
BNE 10$ ; no- use selected type
MOVB D2,D6 ; yes-get LEN
SUBB #2.,D6 ; less 2 gives checkbyte size
CMPB D6,#MAXCHK ; compare to largest supported type
BHI 30$ ; out of range - ignore bad advice
MOVB D6,D7 ; well
ADDB #'0,D6 ; D6 gets character
MOVB D6,CHKT(A0) ; force proper check type
BR 30$ ; and set binary type as well
; handle all but NAKs here
10$: TSTB RIACK(A0) ; have we recv'd "S" packet?
BNE 30$ ; yes, use
MOV #1,D7 ; no-force checkbyte type 1
30$: MOVB D7,CHKNOW(A0) ; save current checkbyte choice
RTN
; G E T R E M - gets a single character from the remote computer.
; At entry, A5 must index the REMOTE TCB
; At exit, D1 will contain the character, or a -1 for no character.
; Z will be set if a character was available for input.
GETREM: MOV #-1,D1 ; preset for no data
BR 20$
10$: SLEEP SLPVAL(A0) ; wait for more data [14]
; wait 1 character time for more date for higher throughput [14]
CTRLC 100$
GTIMEI D7
SUB FUDGE(A0),D7 ; less the fudge factor for wraparound
CMP D7,RTOUT(A0) ; EXPIRED?
BGT 200$ ; YES
20$: TST T.ICC(A5) ; any data to input ?
BEQ 10$ ; no input
CLR D1 ; pre-clear D1
TTYIN ; get a character
TSTB QBIN(A0) ; are we allowing 8 data bits?
BEQ 30$ ; yes
AND #^O177,D1 ; no-strip parity bit
30$: CMPB D1,#3. ; control-c?
BNE 40$ ; no
COMB CCOUNT(A0) ; yes-toggle /2 counter
BNE 50$ ; only one detected
JOBIDX
ORW #J.CCC,@A6 ; two detected - set control-c flag
40$: CLRB CCOUNT(A0) ; clear control-c count
50$: LCC #PS.Z
RTN
100$: LCC #0
RTN
200$: LCC #PS.V ; flag overflow for timeout
RTN
; S E T E N D - calculates and stores the value of the timeout point
; in internal format.
SETEND: CLR FUDGE(A0) ; clear wrap-around value
GTIMEI D7 ; D6 gets internal format time.
ADD TIMINT(A0),D7
MOV #24.*60.*60.,D6 ; D6 gets highest internal time+1
CMP D7,D6
BLO 10$ ; o.k. - no wraparound
SUB D6,D7 ; handle wrap-around
MOV D6,FUDGE(A0) ; set fudge factor to indicate
; time wraparound
10$: MOV D7,RTOUT(A0) ; SET TIME-OUT TIME
RTN
; G T S I Z E - gets file size in bytes. Destroys D6,D7. Assumes file
; has been looked up on FIO(A0). FSIZE(A0) contains the size on exit.
GTSIZE: MOV FIO+D.SIZ(A0),D7 ; D7 gets record size
MOV FIO+D.LEN(A0),D6 ; D6 gets # of blocks
TSTW FIO+D.ACT+.W0L15(A0) ; random file ?
BMI 10$ ; yep-straight multiply
SUB #2.,D7 ; no-subtract pointer bytes.
TSTB EXTEND(A0) ; O/S support extended disks?
BEQ 8$ ; no
SUBW FIO+D.FMT(A0),D7 ; yes, get extra link bytes (if any)
8$: SUB #1,D6 ; and less last block
10$: MUL D7,D6 ; block payload size * blocks
TSTW FIO+D.ACT+.W0l15(A0) ; random file ?
BMI 20$ ; yep.
ADD FIO+D.ACT(A0),D7 ; sequential-add last block's count
SUB #2.,D7 ; less link word in last block
TSTB EXTEND(A0) ; O/S support extended disks?
BEQ 20$ ; no
SUBW FIO+D.FMT(A0),D7 ; yes, get extra link bytes (if any)
20$: MOV D7,FSIZE(A0) ; size of the file
RTN
; send the user terminal a BELL if SET ALARM ON.
DINGEM: TSTB DING(A0) ; wake the user up?
BEQ 20$ ; no
TTYI ; yes
BYTE A.BEL,0
EVEN
20$: RTN
; S T A R T T - gets the current time and saves it in STIME(A0).
; Used to determine the elapsed time in file transfers.
STARTT: GTIMEI STIME(A0) ; save the start time
RTN
; E N D T M - calculate and display the elapsed time & effective baud rate
; for a file transfer.
; At entry, FSIZE must contain the file size in bytes.
ENDTM: TSTB NOTALK(A0) ; do we have a user terminal?
BNE 30$
TSTB ABORTF(A0) ; file aborted?
BNE 40$
GTIMEI D2 ; get current time
SUB STIME(A0),D2 ; less start time
BCC 10$ ; no midnight wraparound
ADD #24.*60.*60.,D2 ; else add 24 hours of seconds [14]
10$: ADD D2,TTIME(A0) ; add to total time
MOV FSIZE(A0),D7
ADD D7,TBYTES(A0) ; accum total bytes
INC TFILES(A0) ; accum total files
MOV D2,D4 ; save for effective baud rate
MOV FSIZE(A0),D3 ; get characters
CRLF
CALL ELAPSE
30$: RTN
40$: CRLF
TYPECR <File transfer interrupted.>
RTN
STATS: TSTB NOTALK(A0)
BNE 100$ ; no user to talk to
TYPE <A total of>
MOV TBYTES(A0),D1
DCVT 0,OT$TRM!OT$TSP!OT$LSP
TYPE <byte>
CALL PLURAL
TYPE < in>
MOV TFILES(A0),D1
DCVT 0,OT$TRM!OT$TSP!OT$LSP
TYPE <file>
CALL PLURAL
20$: TYPECR < transferred.>
CMP D1,#1
BLOS 100$ ; show cumulative effect for <1 file
MOV TBYTES(A0),D3 ; get characters
MOV TTIME(A0),D2 ; get seconds
TYPE <Total >
CALL ELAPSE
100$: RTN
; PLURAL - print an "s" if D1 is not 1.
PLURAL: CMP D1,#1 ; is it singular?
BEQ 20$ ; yes
TYPE <s> ; no, plural
20$: RTN
; ELAPSE displays the elapsed time & baud rate
; At entry, D2 contains the time, and D3 contains the number of bytes xferred
; trashes D4,D1,D6,D7,A6
ELAPSE: TYPE <elapsed time was >
CLR D1
MOV D2,D4
DIV D4,#60.*60. ; convert to hours
MOVW D4,D1
DCVT 2,OT$TRM!OT$ZER ; display hours
TYPE :
CLRW D4
SWAP D4 ; remainder to lower 16 bits
DIV D4,#60. ; make it minutes
MOVW D4,D1
DCVT 2,OT$TRM ; display minutes
TYPE :
CLRW D4
SWAP D4 ; seconds remiander to low 16
MOV D4,D1
DCVT 2,OT$TRM ; display seconds
TST D2 ; were seconds 0?
BEQ 20$ ; baud rate is infinite!
TYPE <, effective baud rate was >
MOV D3,D1
; multiply by 10 by adding 2*D1 and 8*D1
MOV D1,D7 ; duplicate
ADD D1,D1 ; double
LSL D7,#3. ; shift to make 8* old D1
ADD D7,D1 ; add to make 10 * old D1
DIV D1,D2 ; divided by seconds
AND #^O177777,D1 ; strip off remainder
DCVT 0,OT$TRM ; display it
20$: TYPECR <.> ; new line
30$: RTN
; S H O E S C displays the current escape from connect mode character.
SHOESC: TYPE <Escape character is >
MOVB KMETA(A0),D1
CALL SHOCHR
CRLF
RTN
; S H O C H R - displays in printable form the character in D1.
SHOCHR: PUSH D1
TSTB CMASK(A0) ; 7 or 8 bit terminal?
BMI 10$ ; terminal is 8 bits!
BTST #7.,D1
BEQ 10$
TYPE <%>
BR 15$
10$: TYPE < >
15$: ANDB CMASK(A0),D1
CMPB D1,#DEL
BNE 18$
TYPE DEL
BR 50$
18$: CMPB D1,#SPACE
BHIS 20$
PUSH D1
MOVW #177400!11.,D1
TCRT
TYPE ^
MOVW #177400!12.,D1
TCRT
POP D1
CTL D1 ; un-controlify it
BR 30$
20$: TYPE < >
30$: TTY
50$: POP D1
RTN
; show the notice & title & version
KERTTL: TTYL TITLE ; show the title
; show the program name & version
KERVER: TTYL TITL2
VCVT KERMIT+PH.VER,OT$TRM ; show the version #
CRLF
RTN
; S H O D O T - print a dot on user's terminal whenever a packet has been
; sent or recvd. (But don't do it when using user's terminal for I/O.)
SHODOT: TSTB NOTALK(A0) ; TCB owned by KERMIT job?
BNE 10$ ; yes - do not type dot!
TYPE <.> ; no-go ahead & show user kermit
10$: RTN ; is working
; initialize wildcarder
PREBAT:
ORB #D$BYP!D$ERC,FIO+D.FLG(A0) ; bypass error messages
CLRB ABORTB(A0) ; clear batch abort flag
CLR TFILES(A0)
CLR TBYTES(A0)
CLR TTIME(A0) ; clear total stat amounts
MOV A2,SAVSPC(A0) ; save user's file spec
CLR CMDPTR(A0) ; clear ptr to CMDLIN.SYS
CLR CMDERR(A0) ; clear CMDLIN error value
CLRB NXTCNT(A0) ; pre-clear # of times GETNXT called
TSTB WILDOK(A0) ; O.K. to use wildcarding?
JEQ 100$ ; no, don't even try!
LEA A2,CMDLNS
FSPEC CLDDB(A0) ; load the DDB
; fetch or find CMDLIN.SYS module - often in system memory
FETCH CLDDB(A0),A6 ; find or fetch it
BNE 100$ ; not found
MOV A6,CMDPTR(A0)
SAVE A0,A5
LEA A5,CMDIMP(A0)
MOV CMDPTR(A0),A6
MOV A6,D7
ADD #PH.SIZ,A6
; set up CMDLIN's internal ptrs in our impure area
MOV (A6)+,CMINI$(A5) ; CMINI offset
MOV (A6)+,CMNXT$(A5) ; CMNXT offset
MOV (A6)+,CMQRY$(A5) ; CMQRY offset
MOV (A6)+,CMCMP$(A5) ; CMCMP offset
MOV (A6)+,CMSKP$(A5) ; CMSKP offset
MOV (A6)+,CMFSP$(A5) ; CMFSP offset
ADD D7,CMINI$(A5) ; CMINI address
ADD D7,CMNXT$(A5) ; CMNXT address
ADD D7,CMQRY$(A5) ; CMQRY address
ADD D7,CMCMP$(A5) ; CMCMP address
ADD D7,CMSKP$(A5) ; CMSKP address
ADD D7,CMFSP$(A5) ; CMFSP address
; now init CMDLIN
MOV SAVSPC(A0),A2 ; user's spec
LEA A0,DFAULT ; default spec
CLR D7 ; operation flags
.CMINI
REST A0,A5 ; restore regs CMDLIN uses
MOV D6,CMDERR(A0) ; save CMDLIN error, if any
SETB CMDFLG(A0) ; flag we have CMDLIN.SYS
100$: MOV SAVSPC(A0),A2
RTN
; wildcard next spec routine
; handles a single spec if CMDLIN.SYS is not available.
; V set if end of spec
GETNXT:
PUSHB FIO+D.FLG(A0) ; save flags
PUSH FIO+D.BUF(A0) ; save buffer address (if any)
CLEAR FIO(A0),D.DDB ; clean the ddb for re-use
POP FIO+D.BUF(A0) ;
POPB FIO+D.FLG(A0) ; restore buffer address & flags
CLRB ABORTF(A0) ; clear abort file flag
TSTB CMDFLG(A0) ; do we have CMDLIN?
BNE 10$ ; yes
TSTB NXTCNT(A0) ; no, bump count
JNE 60$ ; done
INCB NXTCNT(A0)
MOV SAVSPC(A0),A2
ORB #D$BYP!D$ERC,SIO+D.FLG(A0) ; bypass error messages
FSPEC SIO(A0),LST
BR 20$ ; transfer
; handle file request via system wildcarder.
10$: MOV SAVSPC(A0),A2 ; index the spec
PUSH A5
LEA A5,CMDIMP(A0) ; index CMDLIN impure ptr
.CMNXT SIO(A0)
MOV D7,CMNEXT(A0)
POP A5
MOV A2,SAVSPC(A0) ; save the spec
MOV CMNEXT(A0),D7 ; get the flags
AND #NX$END,D7 ; end of specs?
JNE 60$ ; yes-end
; handle /Q logic if not invoking send remotely
TSTB NOTALK(A0) ; invoked remotely?
BNE 20$ ; yes, no user to query
PFILE SIO(A0)
SAVE A5
LEA A5,CMDIMP(A0) ; index CMDLIN impure ptr
.CMQRY ; ask user
REST A5
BEQ 10$ ; user didn't want to send that file
20$:
; copy filespec to working ddb
MOVW SIO+D.DEV(A0),FIO+D.DEV(A0)
MOVW SIO+D.DRV(A0),FIO+D.DRV(A0)
MOV SIO+D.FIL(A0),FIO+D.FIL(A0)
MOVW SIO+D.EXT(A0),FIO+D.EXT(A0)
MOVW SIO+D.PPN(A0),FIO+D.PPN(A0)
MOV SIO+D.CPU(A0),FIO+D.CPU(A0)
CALL GFILNM ; process the filename
INIT FIO(A0)
LOOKUP FIO(A0) ; does the file exist?
BEQ 30$ ; yes-ok, proceed
NEGB FIO+D.ERR(A0) ; normalize error code
BR 50$ ; and exit
30$: TSTW FIO+D.ACT+.W0L15(A0) ; random file ?
BPL 40$ ; no
TSTB NOTALK(A0) ; yes-we dont do these!
BNE 34$ ; no user to show!
TYPE <%Bypassing random file >
PFILE FIO(A0)
CRLF
34$: JMP 10$ ; skip the random file
40$: OPENI FIO(A0) ; open for input
50$: MOV #1,D7 ; cheap LCC #0
BR 70$
60$: LCC #PS.V ; end of spec
70$: RTN
; clear the checkbytes
CLRSUM: CLRW ASSUM(A0) ; clear checksum
CLRW FRMSUM(A0) ; and clear CRC
RTN
; accumulate the checksum & CRC
ACCUM: PUSH D1
AND #^H0FF,D1
ADDW D1,ASSUM(A0) ; handle 1 & 2 byte sums
CALL CCITT ; handle 3 byte CRC
POP D1
RTN
; x^16+x^12+x^5+1 REVERSE!!!!!
; Routine to calculate CCITT CRC for byte in D1.
; this routine breaks down the task into two nibble operations.
; based on C routine by andy lowry of columbia university.
; See page 257 of Da Cruz book.
CCITT: SAVE D2,D4,D7
MOVW FRMSUM(A0),D4 ; get remainder bits
ANDW #^H0FF,D1 ; mask to 8 bits
XORB D4,D1 ; combine
MOVW D1,D2 ; copy
RORW D2,#4. ; move bits 7-4 to 3-0
ANDW #^B1111,D2 ; strip to a nibble
ANDW #^B1111,D1 ; strip to a nibble
LSLW D2,#1
LSLW D1,#1 ; make them word offsets
; NOTE THAT [~Dx] IS OK SINCE D1 & D2 ARE STRIPPED TO A NIBBLE!
; (got to watch sign extend on word ops!)
MOVW CRCTB2[~D1],D1
MOVW CRCTAB[~D2],D7
XORW D7,D1
RORW D4,#8. ; get old B15-B8 in lo 8
ANDW #^O377,D4
XORW D1,D4 ; xor in new bits
MOVW D4,FRMSUM(A0) ; store CRC
REST D2,D4,D7
RTN
; Data tables for CRC-CCITT generation
CRCTAB: word 0
word 10201
word 20402
word 30603
word 41004
word 51205
word 61406
word 71607
word 102010
word 112211
word 122412
word 132613
word 143014
word 153215
word 163416
word 173617
CRCTB2: word 0
word 10611
word 21422
word 31233
word 43044
word 53655
word 62466
word 72277
word 106110
word 116701
word 127532
word 137323
word 145154
word 155745
word 164576
word 174367
IMPNAM: RAD50 /KERMITIMP/ ; name of user's variables module.
; This table defines the KERMIT commands and the subroutine address
DEFINE KCOM NAME, KSIZE, ADDR, HELP
WORD 10$$-.
BYTE KSIZE
ASCII /NAME/
BYTE 0
EVEN
ASCII /HELP/
BYTE 0
EVEN
10$$: WORD ADDR-.
ENDM
; K E R C O M is the main commands table for KERMIT.
KERCOM:
KCOM AMOS,1,AMOS,<Execute an AMOS command.>
KCOM CONNECT,1,CONNEC,<Connects your terminal to the remote KERMIT site.>
KCOM EXIT,1,GOODBY,<Exit from KERMIT to AMOS.>
KCOM HELP,1,HELP,<Types a summary of KERMIT commands and what they do.>
KCOM RECEIVE,1,RECEIV,<RECEIVE {filespec} receives one or more files from the remote KERMIT.>
KCOM SEND,1,SEND,<SEND {filespec} sends one or more files to remote KERMIT.>
KCOM SET,3,SET,<Set controls options: enter SET ? for more help.>
KCOM SHOW,2,SHOW,<Show displays the current SET options.>
KCOM ?,1,HELP,<The shorthand version of HELP.>
WORD 0
; S E T C O M is the SET subcommands table for SET.
SETCOM:
KCOM AUTORECEIVE,5,AUTREC,<RECEIVE command automatically sends KERMIT & SEND to remote Kermit.>
KCOM AUTOSEND,5,AUTSND,<SEND command automatically sends KERMIT & RECEIVE to remote Kermit.>
KCOM BELL,2,BELL,<Beep after each file transfer.>
KCOM BLOCKCHECK,2,BLOCK,<Block-check type: 1, 2, or 3 check bytes.>
KCOM DEBUG,2,DEBUG,<Debug option ON or OFF.>
KCOM DUPLEX,2,DUPLEX,<Set FULL or HALF duplex.>
KCOM ENDLINE,2, ENDLIN,<Packet terminator character.>
KCOM ESCAPE,2,ESCAPE,<Escape character for CONNECT.>
KCOM PACKETSIZE,8.,PAKMAX,<Maximum packet size.>
KCOM PACKETSTART,8.,PAKMRK,<Packet starting character.>
KCOM PARITY,2,SETPAR,<Denote parity type for NON-alpha remotes.>
KCOM RETRIES,1,NEWTRY,<Number of failed packet attempts that cause abort.>
KCOM STALL,1,STLVAL,<Number of hundreths of seconds to pause between characters.>
KCOM TIMEOUT,1,TIMER,<Packet time-out value in seconds.>
WORD 0
; This table defines the GETOPT list for options arguments.
DEFINE OPT NAME, KSIZE, VALUE
WORD 10$$-. ; offset to next entry
BYTE KSIZE ; # of unique bytes in entry
ASCII /NAME/ ; entry text
BYTE 0 ; terminator
EVEN ; word oriented table
10$$: WORD VALUE ; associated value
ENDM
; This defines the format of the end of the options list.
DEFINE OMSG STRING
WORD 0
ASCII /STRING/
BYTE 0
ENDM
; options list for logical options (YES, NO, 1,0, TRUE, FALSE are valid)
ONOFF:
YESNO: OPT YES,1,377
OPT NO,1,0
OPT ON,2,377
OPT OFF,2,0
OPT TRUE,1,377
OPT FALSE,1,0
OPT 1,1,377
OPT 0,1,0
OMSG <%Use YES or NO, ON or OFF, TRUE or FALSE, 1 or 0.>
EVEN
; options list for block check size
ONE23: OPT 1,1,'1
OPT 2,1,'2
OPT 3,1,'3
OPT ONE,1,'1
OPT TWO,2,'2
OPT THREE,2,'3
OPT III,3,'3
OPT II,2,'2
OPT I,1,'1
OMSG <%Use 1, 2, 3, ONE ,TWO, THREE, I, II, III to set check value size.>
EVEN
; list of valid parity settings, so you can't set parity George, but you
; can set parity Mark.
PARLST: OPT NONE,1,'N
OPT EVEN,1,'E
OPT ODD,1,'O
OPT MARK,1,'M
OPT SPACE,1,'S
OPT YES,1,'Y
OMSG <%Use None, Even, Odd, Mark, or Space.>
EVEN
; options for echoplex (see DUPLEX:)
EPLEX: OPT FULL,1,0
OPT HALF,1,377
OMSG <%Use FULL or HALF to set duplex options.>
EVEN
; S W C A S E - macro to define the switcher state table
DEFINE SWCASE STATE, ROUTE
BYTE STATE
EVEN
OFFSET ROUTE
ENDM
; S W S T A T is the table of valid SEND FILE states for KERMIT,
; and the offsets to the corresponding next routines.
SWSTAT: SWCASE 'S,SINIT
SWCASE 'F,SFILE
SWCASE 'D,SDATA
SWCASE 'Z,SEOF
SWCASE 'B,SBREAK
SWCASE 'C,COMPLT
SWCASE 'A,ABORT
BYTE 0
EVEN
; R C S T A T is the table of valid RECEIVE FILE states for KERMIT,
; and the offsets to the corresponding next routines.
RCSTAT: SWCASE 'R,RINIT ; receive init
SWCASE 'F,RFILE ; receive file
SWCASE 'D,RDATA ; receive data
SWCASE 'C,RCOMP ; receive complete
SWCASE 'A,RABOR ; receieve abort
BYTE 0
HLP1: ASCII / ========== Alpha-Kermit help ==========/
BYTE CR,CR,0
ABTTTL: ASCII /KERMIT aborting with the following error from REMOTE host:/
BYTE CR,0
; tables for GETOPT subroutine
DEFINE OPT CHAR,CODE = BYTE CHAR,CODE
SET1: ASCII / SET allows you to change the following parameters./
BYTE CR,CR,0
NONONO: ASCII /%You cannot CONNECT to your own terminal!/
BYTE CR
ASCII /You must specify the communications port name when KERMIT is invoked:/
BYTE CR
ASCII / e.g. KERMIT MODEM uses the MODEM communications port./
BYTE CR,0
TITLE:
ASCII 'Copyright 1984, 1994 Robert P. Rubendunst.'
BYTE CR
ASCII 'Alpha-Kermit by Soft Machines.'
BYTE CR
ASCII 'Permission is granted to use this software at no charge'
BYTE CR
ASCII 'provided that this message is not changed or deleted from'
BYTE CR
ASCII 'any copy of this software.'
BYTE CR,0
DEFINE TEXT ARG
ASCII ~ARG~
BYTE CR
ENDM
USAGE:
BYTE CR,CR
TEXT <Usage: KERMIT {communications-port}>
BYTE CR
TEXT < NOTE: KERMIT has two modes of operation - Local and Remote!>
BYTE CR
TEXT < LOCAL mode supports serial communications and file transfers through>
TEXT < a separate communications port, e.g. MODEM1.>
TEXT < For LOCAL mode, enter KERMIT and the name of the communications port,>
TEXT < and then a carriage return, e.g. KERMIT MODEM1.>
BYTE CR
TEXT < REMOTE mode is used to support only file transfers for REMOTE users,>
TEXT < e.g. PC users signed on to the Alpha Micro.>
TEXT < REMOTE mode uses the same port for commands and file transfers.>
TEXT < For REMOTE mode, just enter KERMIT and return.>
BYTE CR,CR
TEXT <KERMIT will display the prompt Alpha-Kermit> if you have selected LOCAL mode,>
TEXT <or REMOTE Alpha-Kermit if you have selected REMOTE mode.>
BYTE 0
CUSAGE:
BYTE CR
TEXT <You are now communicating with whatever device is connected>
TEXT <to the serial port (e.g. your modem, or another system.)>
TEXT <Data received by the serial port will be displayed on this screen.>
TEXT <Until you press the special escape character, all of your keypresses>
TEXT <will be sent out of the serial port.>
TEXT <Pressing the escape character returns you to Alpha-Kermit's command mode.>
BYTE CR
TEXT <If you are using a modem, your terminal is now "connected">
TEXT <to the modem. Consult your modem manual for instructions on>
TEXT <dialing, hanging up, changing modem settings, etc.>
BYTE CR
TEXT <Special tips for most modem users:>
TEXT < Before dialing, enter the characters ATE1Q0 and a return,>
TEXT < even though your keypresses may not be echoed on the screen.>
TEXT < Before exiting CONNECT, enter ATE0Q1 and a return!>
BYTE CR
TEXT <Have fun!>
BYTE CR,CR,0
; string that SEND command sends to remote Kermit to automatically get it
; ready to receive data.
PRESND: ASCII "KERMIT"
BYTE CR,-1
ASCII "RECEIVE"
BYTE CR,0
; string that RECEIVE command sends to remote Kermit to automatically get it
; ready to send data.
PREREC: ASCII "KERMIT"
BYTE CR,-1
ASCII "SEND " ; note no CR - RECEIVE will send the filespec later!
BYTE 0
; show command strings
SH1.0: ASCIZ "Modem Port: "
SH2.0: BYTE CR
TEXT < SET Options>
ASCIZ " Autoreceive: "
SH2.1: ASCIZ " Autosend: "
SH2.2: BYTE CR
ASCIZ " Bell: "
SH2.3: ASCIZ " Blockcheck: "
SH2.4: BYTE CR
ASCIZ " Debug: "
SH2.5: ASCIZ " Duplex: "
SH2.6: ASCIZ " Escape: "
SH2.7: BYTE CR
ASCIZ " Packet Size: "
SH2.7A:
ASCIZ " Packet Start: "
SH2.8: BYTE CR
ASCIZ " Parity: "
SH2.8A: ASCIZ " Retries: "
SH2.9: BYTE CR
ASCIZ " Stall: "
SH2.9A: ASCIZ "/100 Timeout: "
SH3.0: BYTE CR
TEXT <Received or Default Packet Parameters>
ASCIZ " Blockcheck: "
SH3.1: ASCIZ " 8Bit Quote: "
SH3.2: BYTE CR
ASCIZ " Endline: "
SH3.3: ASCIZ " Maximum Size: "
SH3.4: BYTE CR
ASCIZ " Pad Count: "
SH3.5: ASCIZ " Pad Value: "
SH3.6: BYTE CR
ASCIZ " Timeout: "
SH3.8: BYTE CR,CR,0
SH.DAS: ASCIZ "------"
SH.OFF: ASCIZ "OFF"
SH.ON: ASCIZ " ON"
SH.FUL: ASCIZ "FULL"
SH.HAL: ASCIZ "HALF"
SH.ZIP: ASCIZ "NONE"
NOSET: BYTE CR
ASCII /%Kermit cannot change the communications port parity, but setting is noted./
BYTE CR,0
TITL2: BYTE CR
ASCII 'Alpha-Kermit version '
BYTE 0
CMDLNS: ASCIZ "DSK0:CMDLIN.SYS[1,4]"
DFAULT: ASCIZ "*.*"
NMTN: ASCII "?No matching terminal name"
BYTE CR,0
RENTER: ASCII "Note: Kermit session already in progress - new port name ignored."
BYTE CR,A.BEL,0
EVEN
END END END
Glossary
JCB - Job Control Block. Used to access & control job related resources
TCB - Terminal control block. Used to access & control terminal resources
Kermit Packet Types
Type Name Function
---- ------------ -----------------------------------------------------
S Send-Init Sends local Kermit Parameters to remote Kermit
Y Acknowledge Receiver verifies reception of packet
Y (Acknowledge) Returns Kermit parameters to instigating Kermit
F File Header Contains name of file to be transferred
D File Data Contains a portion of the data file contents
Z End of File Signals receiver that all data file contents sent
B Break Signals receiver to conclude file transfer (batch)
N Negative Ack. Signal that receiver didn't get or like last packet
E Fatal Error Signal that other Kermit cannot proceed normally
ALPHA MICRO KERMIT
Program: Bob Rubendunst (Soft Machines)
Language: M68 (Alpha Micro 68000 assembler)
Documentation: Karen Bojda (Soft Machines)
Version: 2.0(24)
Date: March 16, 1994
Alpha-Kermit capabilities at a glance:
Local operation: Yes
Remote operation: Yes
Login scripts: No
Transfer text files: Yes
Transfer binary files: Yes
Wildcard send: Yes
File transfer interruption: No
Filename collision avoidance: No
Can time out: Yes
8th bit prefixing: Yes
Repeat count prefixing: No
Alternate block checks: Yes
Terminal emulation: Yes (Dumb or native terminal)
Communications settings: Duplex
XON/XOFF: No
Transmit BREAK: No
IBM mainframe communications: No
Transaction logging: No
Session logging: No
Debug Logging: No
Packet logging: No
Act as server: No
Talk to server: No
Advanced server functions: No
Local file management: No
Command/Init files: No
Key redifinition/macros: No
File attributes packets: No
Command macros: No
Raw file transmit: No
Long packets: No
Sliding windows: No