; 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 ; 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,@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 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 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,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 ; 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 ; 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 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 ; 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 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 ; 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 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,@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 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 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,-10(A0) ; clear file and locked in mem flags MOV REMOTE(A0),A5 MOV #^C,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 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 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 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 MOV @SP,D1 ; get calced sum CMPW D0,D1 ; do they match ? BNE 93$ ; no TYPE DCVT 0,OT$TRM TYPE <)> BR 94$ 93$: TYPE 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 ; 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 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 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 RTN STATS: TSTB NOTALK(A0) BNE 100$ ; no user to talk to TYPE MOV TBYTES(A0),D1 DCVT 0,OT$TRM!OT$TSP!OT$LSP TYPE CALL PLURAL TYPE < in> MOV TFILES(A0),D1 DCVT 0,OT$TRM!OT$TSP!OT$LSP TYPE 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 CALL ELAPSE 100$: RTN ; PLURAL - print an "s" if D1 is not 1. PLURAL: CMP D1,#1 ; is it singular? BEQ 20$ ; yes TYPE ; 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 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 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, KCOM CONNECT,1,CONNEC, KCOM EXIT,1,GOODBY, KCOM HELP,1,HELP, KCOM RECEIVE,1,RECEIV, KCOM SEND,1,SEND, KCOM SET,3,SET, KCOM SHOW,2,SHOW, KCOM ?,1,HELP, WORD 0 ; S E T C O M is the SET subcommands table for SET. SETCOM: KCOM AUTORECEIVE,5,AUTREC, KCOM AUTOSEND,5,AUTSND, KCOM BELL,2,BELL, KCOM BLOCKCHECK,2,BLOCK, KCOM DEBUG,2,DEBUG, KCOM DUPLEX,2,DUPLEX, KCOM ENDLINE,2, ENDLIN, KCOM ESCAPE,2,ESCAPE, KCOM PACKETSIZE,8.,PAKMAX, KCOM PACKETSTART,8.,PAKMRK, KCOM PARITY,2,SETPAR, KCOM RETRIES,1,NEWTRY, KCOM STALL,1,STLVAL, KCOM TIMEOUT,1,TIMER, 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 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 if you have selected LOCAL mode,> TEXT BYTE 0 CUSAGE: BYTE CR TEXT TEXT TEXT TEXT TEXT TEXT BYTE CR TEXT TEXT TEXT BYTE CR TEXT 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 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 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