; ; Copyright (C) 1981, 2001, ; The Trustees of Columbia University in the City of New York. ; ; Edit History and 'To Do' may be found in K20EDT.MAC Title Kermit -- That's Celtic for "free". ; Needs only standard DEC-distributed external files MONSYM, MACSYM, CMD. search monsym,macsym,cmd,k20unv ;[194] cmdacs ; Clean up p1-p4 definitions sall ; tidy listing, please .directive flblst ; We don't need to see all the ASCIZ bytes... ; Originally written by Bill Catchings, Columbia University, April 1981. ; Taken over by Frank da Cruz, Columbia University, March 1983. ; Added DECnet NRT support by Thomas DeBellis, ex-Columbia University, November 2021 ; Other enhancement include Batch and pseudo-terminal support, fixes. ; ; This program is the DEC-20 implementation of Columbia University's KERMIT ; file transfer protocol for use over serial asynchronous communication lines. ; See the KERMIT user and protocol manuals for the specifications. ; ; Version 1, 1981-82: Basic service (Bill) ; ; Version 2, Feb 83: Basic server service (Bill) ; ; Version 3, Mar 83: Local mode, TTLINK, talk to server (Frank) ; ; Version 3B, Oct 83: I packets, ^X,^Z interrupts, TAKE, DEFINE, etc (Frank) ; 3C, Nov 83: 8th-bit prefixing, repeat counts. ; 3.4, Dec 83: 2- and 3-character block checks. ; ; Version 4, Jan 84: Advanced server functions, LOG, ARPAnet support (Frank) ; ; Version 4.1, Jul 84: Integrated CONNECT code, no more TTLINK (Frank) ; ; Version 4.2, Oct 84: Non-Protocol upload/download, login scripts (Frank) ; ; Version 5.3, Nov 21: DECnet NRT, Batch, psuedo-terminal (Tom) subttl program code and text (makes debugging easier) ;[202] Has to be before we use any macros .psect text/ronly,txtorg ;[202] .endps text ;[202] .psect etext/ronly,etxorg ;[202] .endps etext ;[202] .psect code/ronly,codorg ;[190] Don't allow stores subttl Command Line Processing ; RESCAN - Routine to check for command line arguments. ; ;[85] Returns +1 always, with F$EXIT = 0 if no args, nonzero if some args. ; rescan: setzm f$exit ;[85] Assume no rescan arguments. movx t1, .rsini ; Now check. RSCAN% ; ... erjmp r ;[85] If none return. movx t1, .rscnt ; Get the size of the rescan. RSCAN% ; ... erjmp r ;[85] Return if unsucessful. jumpe t1, r ;[85] If the size is zero return. prompt <> ; Null prompt. movei t1, r+1 ; Get the address we want to go to on reparse. movem t1, repara ; Fudge it. This is to prevent looping back ; to prompt <> for ever on an error on the ; rescan line. movei t1, [flddb. (.cmkey,,<[exp <1,,1>,<[asciz/Kermit/],,0>]>)] call rflde ; Parse it. ret ;[85] If we don't find it return. setom f$exit ;[85] Assume we have command line arguments. movei t1, [flddb. (.cmcfm,cm%sdh)] ; See if we can parse a confirm. call rflde ; ... ret ; If not, we have a rescan argument. setzm f$exit ;[85] Parsed confirmation, so no arguments. ret ;[85] Done. subttl KERMIT Program entry, initialization, and exit. reen: entry reen ;[197] Mark for PDV jrst start ;[210] Nothing special start: entry start ;[197] Mark for PDV move p, [iowd pdlsiz,pdl] ;[186] Set up a stack, FIRST RESET% ; Normal startup: reset everything %jserr (,halt) ; It actually can fail... call fndvec## ;[223] Find a parser symbol table vector nop ;[223] Ignore it if it doesn't work movei t1, .fhslf ;[190] This process setob t2,t3 ;[190] Don't overwrite our code with PA1050!! SCVEC% ;[190] Shut off UUO simulation %jserr (,) ;[190] Odd, but continue call setgrd## ;[190] Start guarding call inicap ;[186] Set up capabilities before SYSGT%/GETAB% call initim ;[223] Get base time to calculate off of call inicty ;[223] Locate the console setom ccfail ;[187] Assume never failed sc%ctc GJINF% ;[186] Get current terminal movem t1, whoami## ;[210] Save for testing routines movem t4, ttynum ;[186] Set up default active line move t1, t4 ;[186] Pass in terminal line hrli t1,.dvdes!.dvtty ;[186] Turn into a device designator movei t2, svstt ;[186] Point to saved start up terminal area call savtty ;[186] Save terminal characteristics ermsg% (,halt) movei t2, svstt ;[194] Point to populated structure ifme. $dvchr+3(t2) ;[194] Any error? move t1, $dvchr(t2) ;[194] None, use what DVCHR% got else. ;[194] Otherwise, have to use something movei t1, .priou ;[194] Maybe old reliable will work endif. ;[194] End case determining controlling device movem t1, $PRIOU ;[194] Store and hope for the best call inipty## ;[186] Get system pseudo-terminal configuration call lclnod## ;[186] Determine and condition for DECnet, if available call getnam## ;[186] Get system name call setdef## ;[186] Set default prompt when NRT'ing call gtclas ;[130] Check status of class scheduler. setzm monv ; See what monitor version. move t1, [sixbit/MONVER/] ; This only works in V6 or later. SYSGT ifje. r ;[186] Can fail if no SC%GTB or fascist ACJ move t3,t1 ;[186] Save error for debuggers setzb t1,t2 ;[186] Return nothing endif. ;[186] End case JSYS error handling skipe t2 ; Got anything? movem t1, monv ; Yes, save it. setzm ttfork ; Clear connect receive fork handle setzm netjfn ; and communication line JFN setzm f$exit ; and exit flag, so we re-init if restarted. dmove t1,[ .fhslf ;[186] This fork frkchb ] ;[186] Inferior fork signalling channel AIC% ;[186] Assign and enable it %jserr (,) ;[78] Set up a JFN stack for 'take' commands. move t2, [iowd takel, takpdl] ;[78] Construct TAKE jfn stack pointer. movem t2, takep ;[78] setzm takdep ;[78] Start 'take depth' out at 0. setzm takjfn ;[78] And no TAKE file jfn. ; Run KERMIT... call main ; The actual program. remark ; Falls through to halt halt: entry halt ;[194] Can be hit by k20sub remark ;[186] Whack fork first in case using JFNs ifmn. ttfork ;[186] Is the terminal fork around? txmsg <[KERMIT-20: Killing remote terminal fork] > ;[186] With whom? movei t1, .priou ;[186] Primary output DOBE% ;[186] Wait for that to type out erjmpr .+1 ;[186] Catch and ignore error move t1,ttfork ;[186] Load the fork handle KFORK% ;[186] Ditch it erjmpr .+1 ;[186] Ignore error, we're leaving setzm ttfork ;[186] Remember it's gone. endif. ;[186] End case fork clean up skipg t1, ttyjfn ;[186] Do we have an open terminal? ifskp. ;[186] Yes, whack it as we may have detached ;; Flat out aborting the JFN on the controlling terminal may ;; not be a good idea for NRT's, CTerms and NVT's because ;; certain network clean up operations may be prevented from ;; occurring. Therefore, we use frclos, which tries a ;; normal CLOSF%, first. If this times out, then the abort ;; is attempted. This delay is setable with SET DELAY, zero ;; meaning not to time out. extern frclos ; Found in k20sub call frclos ;[186] Force a JFN to close, first gently ifnsk. ;[186] Failed?? %ermsg (,) ;[186] endif. ;[186] Either way, we're done with the JFN setzm ttyjfn ;[186] Stomp it endif. ;[186] ifmn. netjfn ;[186] Open connection? txmsg <[KERMIT-20: Closing active connection] > ;[186] With whom? movei t1, .priou ;[186] Primary output DOBE% ;[186] Wait for that to type out erjmpr .+1 ;[186] Catch and ignore error call clsnet## ;[186] Close the connection endif. ;[186] End case open connection movei t1, svstt ;[194] Load pointer to save area call restty ;[194] Restore terminal HALTF% ; Upon return, just halt. ; If continued, fall thru to here... contin: setzm f$exit ; Turn off the exit flag. call inicap ;[186] May have enabled or disabled, so check setom ccfail ;[187] Assume never failed sc%ctc call setty ;[220] Set up the terminal again call prsint ; Go to command level. jrst halt subttl KERMIT main program main: setzm local ; Start off running remotely. call pinit ; Initialize interrupt system. seto t1, ; Get job info for this job. dmove t2, [ ;[221] Negative number of items -.jiker,,jobtab ;[221] Kermit local job table .jijno ] ;[221] Starting from job number GETJI %jserr (,) dmove t3, jobtab ; Get job & terminal numbers. movem t3, myjob ; Job number of my job. movem t4, mytty ; Remember this is my controlling terminal. movem t4, pars3 ; Make believe we parsed terminal number setz debug, ; And no debugging setzm netjfn ; Force a new connection call setty ;[220] Get and set up local terminal panda < call chknbm > ;[181] Determine if we have network binary mode call cmdini ; Initialize the command package. call inifil ;[79] Execute commands from KERMIT.INI, if any. ccl: call rescan ;[85] If no .INI file, look for rescan now. skipe f$exit ;[85] If there was a rescan argument, jrst parse ;[85] go do that. jrst @dfstrt ; No rescan go to default: PROMPT or SERVER. server: jrst getcom ; Here if starting as server by default. remark Here if starting in command mode by default. extern cmdtab,cmdtb2 ;[225] These were moved to k20par ; [225] These chained FDB's and tokens were to catch a bizarre parsing ; error that started happening when the pages that held the symbol ; table, executable code, unchanging text (such as noise words and ; help test), constants, static TBLUK% tables and Function Descriptor ; Blocks (FDB's) were write-protected via LINK directives. ; ; If you type a bare ^L or a ^J to Kermit at top-level, the COMND% ; JSYS fails with a "Illegal memory read". However, there is nothing ; in these tables that is pointing to unreferenced memory... Further, ; the behavior does not happen when a command has been typed and is ; being confirmed with a ^L or ^J. ; ; The idea was to catch the ^L and ^J and just swallow them. The ; Control-Z was to test to see whether a control character could be ; parsed (it can), that is, whether the ^L and the ^J are being ; special cased (they are). ; ; Putting the fdb's into writable storage causes the problem to go ; away. This is counter-intuitive because in that case, one would ; have expected an "Illegal memory write" and not the read error. repeat 0,< ;[225] Just for trouble shooting toklfd: byte (7) .chlfd, .chnul ;[225] ASCIZ line feed tokffd: byte (7) .chffd, .chnul ;[225] ASCIZ form feed tokcnz: byte (7) .chcnz, .chnul ;[225] ASCIZ Control-Z maibug: remark ;[225] Beginning of hack for parsing bug lfdfdb: flddb. .cmtok,,,,,ffdfdb ffdfdb: flddb. .cmtok,,,,,cnzfdb cnzfdb: flddb. .cmtok,,,,,cfmfdb cfmfdb: flddb. .cmcfm,,,,, cleans() >;;[225] Repeat 0 ;To do, Leave this alone until I have time to trouble-shoot COMND% chgsec(code,data) ;;[225] Wants it in writable store??? maifdb: flddb. .cmkey,,cmdtab,,, ;;[225] Main parsing function descriptor block malfdb: flddb. .cmkey,,cmdtb2,,, ;;[225] fdb to use when in local mode retsec ;;[225] Restore psect assumptions promp: skipe iniflg ;[83] Doing init file? jrst prsint ;[83] Yes, don't print herald yet. move q1, [ret] ;[39] Hokey calling convention for routine call $shver## ;[39] to print current program version. prsint: setzm rcving ; Indicate neither receiving nor sending. skipe f$exit ; Exit flag set by EXIT command or CCL entry? jrst clenup## ; If so, go clean up and return. hrroi t1, prompx## ;[137] Otherwise, point to prompt text. call dpromp ;[137] Issue prompt. parse: setzm pars1 ;[40] Clean out old parse values. move t1, [pars1,,pars2] ;[40] blt t1, parsx ;[40] setzm definf## ;[203] Stomp macro define context setzm undeff## ;[203] Ditto removal setzm cjfnbk+.gjgen ; Clear the JFN bits. movei t1, maifdb ;[225] Point to command keyword table. skipe local ;[68] Running in local mode? movei t1, malfdb ;[225] Yes, use that table instead. call rflde ;[78] Parse a keyword. jrst eoftst ;[78] If error, test for EOF on command file. repeat 0,< ;[225] See comment, above with fdb's ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ;[225] Get function code. caie t4, .cmtok ;[225] Token? (This is a *HACK*) ifskp. ;[225] It is, so let's handle that specialty confrm ;[225] Confirm it movei t4, .cmcfm ;[225] And stomp into a confirm endif. ;[225] cain t4, .cmcfm ;[225] Confirmation? (Hack) jrst prsint ;[225] Swallow it and parse something else > ;[225] hrrz t2, (t2) ; Get the command routine addresses. movem t2, pars1 ; Save into pars1. hlrz t1, (t2) ; Get the next level routine. call (t1) ; Call it. eval: move t2, pars1 ; Get back data value. hrrz t1, (t2) ; Get evaluation routine. call (t1) ; Call it. jrst prsint ; Go round again. ;[78] EOFTST: Command file EOF handler. ; eoftst: push p, t2 ; Save this in case we can resume. movei t1, .fhslf ; Get last process error. GETER% ; Test for eof on COMND input file. move t1, t2 ; Move error code from t2 to t1 pop p, t2 ; and restore t2. hrrzs t1 ; Erase fork handle from this. caie t1, iox4 ; Was error EOF? cain t1, comnx9 ; Or this kind of EOF? jrst eofts2 ;[85] Yes, some kind of EOF. ifmn. f$exit ;[194] Parsing rescan line? emsg ;[187] hrroi t1, atmbuf ;[85] PSOUT ;[85] ret ;[85] And quit. endif. ;[194] ; Not EOF, and not parsing rescan line, just enter normal parse error handler. jrst cmderr ; Complain, then resume parsing. ; EOF on command file. eofts2: call popjfn ; It was EOF. Pop the command file JFN. ifnsk. ;[194] Returned +1 ... movei t1, .priin ; On any error, revert parsing to TTY. call setcsb ; ... endif. ;[194] skipn iniflg ;[83] Just closed init file? jrst prsint ;[83] No, don't bother with rescan stuff. ;[83] Just closed init file, check for command line (rescan) arguments. setzm iniflg ;[83] Flag that we're done with init file. jrst ccl ;[85] And go check for rescan arguments. subttl External variables and routines found in K20NET extern getnam ; Get system name extern sysnam ; Local Executor name (usually the same) extern $setln ;[218] Moved to K20NET extern nrtros ; If NRT, remote operating system type extern nrtflg ; Set if a valid Network Remote Terminal extern openet ; Open a generalized connection extern decnct ; Opens a DECnet NRT connection extern decerr ; Handle a DECnet error extern nrtbrk ; Used to send an NRT break (unused) extern intmsg ; Type a DECnet interrupt message (unused) extern ptyflg ; Set if doing pseudo-terminal I/O extern ndvchr ; Device characters double word extern inipty ; Initializes for pseudo-terminal usage extern asipty ; Assigned a psuedo-terminal extern ptynam ; Pseudo-terminal ASCII name extern ptytty ; Line number of associated terminal extern ttynam ; ASCII name of same extern BOUTR% ; BOUT% a record extern netvtx ; Handle lost virtual terminal connection extern netin ; Network input extern vtmpsh ; Virtual terminal push extern clrbuf ; Clear NAK's from terminal buffers extern clrest ; Return estimated characters in monitor buffers extern ttxon ; Unstick the line extern setty ; Set up a local terminal extern chknbm ;[190] Check if line will do TVT network binary extern inilin ;[190] Initialize line for a transfer extern reslin ;[190] Restore line after a transfer extern putpar ;[223] Put parity on an entire packet extern chkpar ;[223] Check parity on an entire packet extern padbuf ;[223] Build a padding buffer with correct parity ;[186] End code insertion ; Create and start a fork to get and display input from the remote end. ; N.B., When setting the CR%MAP bit when executing a CFORK%, *all* ; sections of the superior will be mapped, whether or not they ; exist! That is wasteful. On the Toad, you'd get 4,096 ; sections, which has to be a terrible idea. Cure would be to ; have the monitor only map the existing sections. ; ; Until that happens, probably should do an RSMAP$ and only ; map existing sections; Kermit and perhaps DDT. ttsfrk: entry ttsfrk ;[186] Inform LINK of our location call caxzof ;[186] Shut off so fork can swallow them skipn t1,ttfork ;[186] Do we already have a fork? ifskp. ;[186] Yes, reuse it RFORK% ;[186] Unfreeze it %jserr (,r) ;[186] Give up if failed else. ;[186] Otherwise, create it movx t1, ;[186] Share our map, don't start CFORK %jserr (,r) movem t1, ttfork ; It's running, save fork handle. setob t2,t3 ;[190] Don't overwrite our code with PA1050!! SCVEC% ;[190] Shut off UUO simulation %jserr (,) ;[190] Odd, but continue move t1, ttfork ;[190] Reload fork handle (just in case) dmove t2, mycaps ;[186] Load my capabilities txz t2, sc%log ;[186] Do not give the child the ability to LGOUT% txz t3, sc%log ;[186] and shut it off txo t2, sc%sup ;[186] Give the child the ability to poke us txo t3, sc%sup ;[186] and turn on the ability to poke us EPCAP% ;[186] Go set up the capabilities %jserr (,r) ;[186] Ditch the fork? movei t2, netin ;[186] Load inferior fork loop address SFORK% ;[186] Fire it up! %jserr (,r) ;[186] endif. ;[186] End case not reusing fork ;[151] Keyboard input loop. ttinch: entry ttinch ;[196] skipe forkls## ;[236] Using the monitor to do the connect? callret frklsc## ;[236] Yes, go handle it that way skipn ttfork ; Have a fork? jrst $connx ; No, it's gone, so disconnect. skipe vtermf ;[186] Physical line? jrst vtmpsh ;[186] No, push characters differently move t1, ttyjfn ; Get a byte from the controlling TTY. BIN %jserr (,) ; What could happen? ldb t3, [point 7, t2, 35] ; Make copy without parity. camn t3, escape ; Is it the escape character? jrst doesc ; Yes, go process single-char command. skipe duplex ; Have to echo locally? call echo ; Yes, do. move t1, t2 ; Tack on desired parity. call @parity ; The parity routine wants the character in t1. move t2, t1 skipg t1, netjfn ;[186] Output the character to the connected TTY. move t1, ttyjfn ;[186] Unless using local terminal BOUT jrst ttinch ; Go back and do it again. ; Error handler for connected TTY. tterr: skipn mdmlin ; Modem controlled line? jrst ttinch ; No, go back. tter1: entry tter1 ;[196] skipg t1, netjfn ;[186] Reload JFN, just in case move t1, ttyjfn ;[186] Unless using local terminal call chklin ;[186] Go check for carrier. skipn carier ; Still have it? skipa ; No, close the connection. jrst ttinch ; Yes, keep plugging away till they disconnect. skipe vtermf ;[186] Was it a network connection went away? call netvtx ;[186] Yes, can't be recovered ; Lost carrier, shut down the connection. txmsg < [KERMIT-20: Lost Carrier On Remote Connection -- Returning to > ;[186] hrroi t1,sysnam ;[186] Load local node name PSOUT% ;[186] Type it, not "DEC-20" txmsg <] > ;[186] jrst $connx ; Error handler for session log output. netlgx: entry netlgx ;[194] setz t1, ; Go shut down the session log. call $closs## ;[194] Moved to k20par, actually jrst netin ;[151] Escape character was typed -- Get argument. ;[186] N.B., expects t3 to be preserved! ;;;;[194] Maybe just do a jump table? doesc: entry doesc ;[186] Some network code jumps here move t1, ttyjfn BIN ; Escape char was typed, get argument. trz t2, 200 ; Strip any parity bit. cail t2, "a" ; Uppercase any letter. caile t2, "z" skipa subi t2, 40 caie t2, .chtab ;[186] Other useless white space cain t2, .chspc ;[186] The null command. jrst ttinch ; ... caie t2,"B" ;[194] is it a break? ifskp. ;[194] It is call brkin0 ;[194] So handle it jrst ttinch ; then continue endif. cain t2, "C" ; Close connection. jrst $connx cain t2, "K" ;[186] Go back to Kermit command level? jrst retker ;[186] Yes, return to Kermit command level caie t2, "Q" ;[194] Quit logging? ifskp. ;[194] Yes, shut off the log, but don't close it call qlog jrst ttinch endif. ;[194] caie t2, "R" ;[194] Resume logging? ifskp. ;[194] Yes, turn it back on call rlog jrst ttinch endif. ;[194] caie t2, "S" ;[194] Status query? ifskp. ;[194] Yes, give some blat hrlzi q1, () ;[194] Calling convention for show line. call $shlin## ;[194] ; Go show line parameters. jrst ttinch ; Go back for more input. endif. ;[194] caie t2, "P" ; PUSH to Exec? ifskp. ;[194] Yes, indeed. call fixtty ; Put TTY in normal mode. txmsg < [KERMIT-20: Returning to > ;[186] hrroi t1, sysnam ;[186] Local system PSOUT% ;[186] txmsg <::]> ;[186] $push will issue the CRLF call $push ; Do the pushing. call ttyini ; Put back in talk mode. txmsg < [KERMIT-20: Back at > ;[186] ifmn. nrtflg ;[186] DECnet? hrroi t1, nodnam ;[186] Where we went else. ;[186] Otherwise, it's local hrroi t1, sysnam ;[186] so stay here endif. ;[186] PSOUT% ;[186] txmsg <::] > ;[186] jrst ttinch endif. ;[194] ;[151]...DOESC, cont'd ; Define 30 bit escape help address pointer ehlpad==!.P07 ;;Forces LINK polish fix-up caie t2, "?" ;[194] Wants help? ifskp. ;[194] Yes, help out move t1, [ehlpad] ;[194] Load one word global pointer PSOUT% ;[194] Type the help text move t2, escape ; Type the escape character. call echo txmsg <". > jrst ttinch endif. ;[194] came t2, escape ;[194] Send escape character? ifskp. ;[194] Yes, double type means push it out skipe duplex ; If local echo call echo ; take care of that. move t1, t2 call @parity ; Add desired parity to it. move t2, t1 skipg t1, netjfn ;[186] Send it out the link. move t1, ttyjfn ;[186] Unless using local terminal call BOUTR% ;[236] Output a single character and push it %jserr (,tterr) jrst ttinch endif. ;[194] ; .... movei t1, 7 ; Anything else, just beep PBOUT jrst ttinch ; Come here to restore things. ; ; Take care of any session log file. We want to close it, but leave the JFN ; around in case the logging is resumed, the program continued, etc. ; $connx: entry $connx skipg t2, sesjfn ; Is a log file open? jrst $conx2 ; No, go do the rest. txmsg < [KERMIT-20: Closing Log File > caie t2, .nulio ;[194] Was just dumping it? ifskp. ;[194] Yes, that's easy txmsg ;[194] Because we know the name else. ;[194] Otherwise, some kind of file movei t1, .priou setz t3, JFNS %jserr (,) endif. ;[194] End .nulio conditional txmsg <] > setzm sesflg ;[195] Whatever we do, session logging is not active move t1, t2 ; Get the JFN back into t1. cain t1, .nulio ;[194] Just dumping in? ifskp. ;[194] Then no need to do this hrli t1, (co%nrj) ; Close, but don't release JFN. CLOSF% ; ... ifje. r ;[194] Catch and fetch error number hrrzs t1 ; If error, check what it was. cain t1, clsx1 ; Already closed? anskp. ;[194] Yes, ignore. setzm sesjfn ; Some other error, so JFNs are probably %ermsg (,$conx2) ; complain, and return. endif. ;[194] End CLOSF% error handling tlz t1, -1 ;[194] Closed OK, open it again to prevent CLZFF movx t2, ; from stomping on the JFN. OPENF erjmpr .+1 ;[194] Catch and ignore error endif. ;[194] End case .nulio special handling $conx2: call fixtty ; Put controlling tty back in data mode. movx t1, .priin ; Flush any pending tty input. CFIBF erjmp .+1 skipe t1, ttfork ;[186] Freeze any receive fork. FFORK% ;[186] See netin in k20net!!! erjmpr .+1 ;[194] Catch and ignore error ifmn. nrtflg ;[186] On a NRT? call clrbuf ;[186] Yes, handle a monitor bug (see netin) nop ;[186] Ignore error; already complained endif. ;[186] movei t1, .priou ; Output a CRLF if not at left margin. RFPOS% hrroi t1, crlf trne t2, -1 PSOUT% txmsg <[KERMIT-20: Connection Closed]> ; Closed message. ret ;[151] BREAK-sending routine. Simulate by sending some nulls at ; a low baud rate. Originally by Bill Schilit, Columbia. ; brkin0: saveac ; save all used registers skipe nrtflg ;[186] On an NRT? jrst nrtbrk ;[186] Do something different skipe ptyflg ;[186] pseudo-terminal? ret ;[186] Can't do any of this skipg speed ; do we know about a speed? jrst brkin2 ; no, give a message skipg t1, netjfn ;[186] get the output terminal jfn move t1, ttyjfn ;[186] Unless using local terminal movx t2, .mospd ; set the speed hrlz t3, speed ; same input speed hrri t3, ^d50 ; but output is lower (input,,output speeds) MTOPR %jserr (,r) skipg t3, brk ; get count of nulls to send movei t3, defbrk ; use the default caile t3, maxnul ; greater than we support? movei t3, maxnul ; yes, use that movns t3 ; make negative move t2, [point 7,nulls] ; point to them setzm t4 ; no stop char SOUT %jserr (,) movx t2, .mospd ; now reset speed move t3, speed hrls t3 ; make input same as output MTOPR %jserr (,r) ret brkin2: txmsg < [KERMIT-20: Can't send BREAK, line speed unknown -- use SET SPEED command.] > ret nulls: xlist ;[194] Don't need to see all the zeros repeat +1,<0> ; A string of nulls. list ;[194] ;[151] Quit logging session during CONNECT. qlog: entry qlog ;[194] Called from echo error handling ifmle. sesjfn ;[195] Do we have a session log? txmsg < %KERMIT-20 wasn't logging this session... > ;[195] We do not ret ;[195] Nothing else to do, then endif. ;[195] ifme. sesflg ;[195] Is logging currently suspended txmsg < %KERMIT-20 logging was already suspended for this session... > ;[195] It was, so nothing to do ret ;[195] And we're done endif. ;[195] setzm sesflg ;[195] Signal that session logging is not active. hrrz t1, sesjfn ;[195] Load the session log JFN hrli t1, (co%nrj) ; Close the log, but don't release JFN. CLOSF% ;[195] Checkpoint's the file erjmps .+1 ;[194] Preserve the JFN!! ; Open the log file again, to keep the JFN from getting flushed by CLZFF. tlz t1, -1 ; Clear out bits from left half. movx t2, ; Open for appending. OPENF %jsErr (,) ;[195] Complain, but continue txmsg < [KERMIT-20: Session logging is now inactive] > ;[195] Update message for clarity ret ;[151] Resume logging session after a hiatus. rlog: ifmle. sesjfn ;[194] Wait, was never doing it? txmsg < %KERMIT-20 was never logging... > ;[194] Except whine, that is... ret endif. ;[194] ifmn. sesflg ;[194] Already logging? txmsg < %KERMIT-20 was already logging... > ret endif. ;[194] ; A log was selected, but not active. Just tweak the flag setom sesflg ;[195] Flag that logging is active txmsg < [KERMIT-20: Logging resumed] > ;[195] ret subttl PUSH Command ;[151] Push to Exec REMARK Maybe release local terminal during push? Keeps TCB locked... .jitwo==.jipnm-.jisnm+1 ;[220] Length of items to grab $push: entry $push seto t1, ; Save subsystem & program names... dmove t2, [ ;[220] Grabbing two items -2,,pname ;[220] Storing them in subsystem/program name block .jisnm ] ;[220] First word is subsystem name GETJI ifje. r ;[220] Catch and handle any error move t4, t1 ;[220] Save that for debuggers setzb t1, t2 ;[220] Cons up some talismen dmovem t1, pname ;[220] Side-effect global storage for downstream endif. ;[220] End case GETJI% handling txmsg < [KERMIT-20: PUSHing to new EXEC.] [POP from Exec to return.] > skipg t1, execf ;[194] Have one already? ifskp. ;[194] Supposedly... txo t1, sf%con ; Yes, just continue it. SFORK ifje. r ;[194] Catch the error cain t1, frkhx1 ;[194] Did it disappear? ifskp. ;[194] No, some other odd happening %ermsg (,r) ;[194] endif. ;[194] remark frkhx1 ;[194] Otherwise falls out to CFORK else. ;[194] Otherwise the SFORK worked jrst push3 endif. ;[194] End case SFORK% error handling endif. ;[194] End case existing fork setzm execf ;[194] Whack any previous handle movx t1, cr%cap ; No, create a fork. CFORK %jserr (,r) movem t1, execf ; Save its handle. move t2, capas ; Mask capas with this fork's enabled ones. move t2, mycaps+1 ;[187] Use start up enabled caps, instead txz t2, sc%log ; Turn off logout capability. txo t2, sc%gtb ; Turn on GETAB capability (must have it...) skipe jobtab+.jibat ; Under batch? txz t2, sc%ctc ; If so, don't try to enable ^C capability. move t3, t2 ; Enable capabilities. EPCAP %jserr (,r) ; Fail if can't, since Exec must have them. movx t1, gj%old+gj%sht ; Get JFN on the Exec. sxtext (t2,) GTJFN %jserr (,r) move t4, t1 ; Save the JFN for a sec. hrl t1, execf ; Get the Exec into the fork. GET %jserr (,r) move t1, t4 ; Release the Exec's JFN, don't need it. RLJFN nop move t1, execf ; Exec fork handle. setz t2, ; Start up the fork. SFRKV %jserr (,r) push3: call caxzof ; Shut these off for inferior move t1, execf ; Load inferior handle WFORK ; Wait for it to halt. call caxzon ; Turn them back on, if on dmove t1, pname ; Restore program/subsys name. ifn. t1 ;[220] But only if we ever got them SETSN %jserr (,) ;[220] endif. ;[220] End case trying to restore pop1: remark ;[220] Check to see if we have a new controlling terminal call udjinf ;[220] Update job information move t4, jobtab+.jitno ;[220] Side-effect t4 like GJINF% would skipn t1, ttyjfn ;[220] Load terminal JFN ret ;[183] Nothing there, so don't bother DVCHR% ;[183] Otherwise, find out about it erjmp r ;[183] make this somebody else's problem... load t1, DV%TYP,t2 ;[183] Pick up the device type byte caie t1, .DVTTY ;[183] and is this a terminal? ret ;[220] No, that's odd, but shut up about it remark ;[220] t1, t2, t3 are now stomped, t4 unchanged hrrz t1, t3 ;[183] Load the TTY line number from DVCHR% came t1, mytty ;[183] Was this different from me? ret ;[183] Yes, so seperate line was being used camn t1, t4 ;[220] Otherwise, any change in our own line? ret ;[183] Nope, nothing to do, then ;[183] lifted from cleanup pop2: move t1, ttyjfn ;[220] Load this obsolete JFN call frclos ;[220] Force it closed nop ;[220] Ignore any odd return, we're done setzm ttyjfn ;[220] Stomp it callret setty ;[220] Get a new JFN for different terminal ; ; Handle Kermit "K" command, to return to Kermit command level ; ; ; Never called because needs to return to caller's caller retker: skipn t1,ttfork ; Have a communications fork? ifskp. ; Yes, don't let it get in our way FFORK% ; Freeze it %jserr (,) endif. ; End case freezing fork call fixtty ; Restore terminal txmsg < [KERMIT-20: Returning > ifmn. nrtflg ; DECnet? txmsg ; Yes, name the nodes hrroi t1,nodnam ; Remote system name PSOUT% txmsg <:: to > else. ; Otherwise, nothing to type txmsg endif. hrroi t1,sysnam ; Load local node name PSOUT% ; Type it, not "DEC-20" txmsg <::] > movei t1, .priou ;[186] Primary output DOBE% ;[186] Wait for that to type out erjmpr .+1 ;[186] to finish before we bonk anything ifmn. nrtflg ;[186] On a NRT? call clrbuf ;[186] Yes, handle a monitor bug (see netin) nop ;[186] Ignore any error; already complained endif. ;[186] ret ; Finally return to whatever call $conn ; GET remote files ; ;[11] This whole command is part of edit 11 ; GET command execution. $get: entry $get ;[194] ifme. takdep ;[176] Allow commands to servers from TAKE file ifme. local ;[194] Otherwse, this only works if local Kermit. ermsg% (, r) endif. ;[194] End case local endif. ;[194] End case in a take file ;[148] Check for and validate local filespec. skipn local ;[177] If we're in remote mode... call inilin setzm filjfn ; Assume no local file given. skipg t1, pars3 ;[193] JFN of local file, if any... jrst $get3 ; If none, skip this. cain t1, .nulio ;[193] NUL:'ed already? ifskp. ;[193] No, hope it's a real JFN... DVCHR ; Make sure it's on disk. ifje. r ;[193] Grab and ignore error setob t2, t3 ;[193] Pretend to return ...complete junk... endif. ;[193] End case jsys error handling else. ;[193] Otherwise, has already been changes movx t2, ;[193] Phoney up the device endif. ;[193] ldb t3,[pointr t2, dv%typ] ;[193] Pick up the device type caie t3,.dvnul ;[193] Wants to just dump it? ifskp. ;[193] Yes, let's touch that up hrrz t1, pars3 ;[193] Load output file JFN again caie t1, .nulio ;[193] Nothing to do, if we already did it RLJFN% ;[193] Just toss it, don't even open it erjmpr .+1 ;[193] Retrieve and ignore the error movei t1, .nulio ;[193] Just use default sink movem t1, pars3 ;[193] Stomp in as JFN else. ;[193] Not NUL:, then caie t3, .dvdsk ;[193] Disk, maybe? ermsg% (, r) endif. ;[193] End special case NUL: move t1, pars3 ; Get this back. movem t1, filjfn ; Save it here. ; Handle the remote filespec. $get3: setz t3, ; Count the characters... move t1, pars2 ; And move them from here move t2, [point 7, strbuf] ; to here. $get4: ildb t4, t1 ; Now copy the rest. Get a byte. cain t4, 26 ;[147] Control-V? ildb t4, t1 ;[147] Yes, it's a quote, get next byte. idpb t4, t2 ; Deposit the byte. skipe t4 ; Null? aoja t3, $get4 ; No, then keep going. ife. t3 ;[194] Yes, done, any chars? ermsg% (,r) ;[194] None?? endif. ;[194] movem t3, temp2 ; Save this till after next part. ; OK, they gave a remote filespec. Send an info packet in case we want to ; tell them to send with nonstandard parameters, like 8bq or fancy block check. setom bctone ;[98] Force 1-char checksum. call sinfo ;[100] Go send Info packet. ret ;[133] Failed, give up. setom bctone ;[100] In case sinfo or sinit clears this! ; Parameters exchanged (perhaps), now send the R packet. $get5: move t3, temp2 ; Restore length. movei t1, "R" ; Packet type is Receive-Init. setz t2, ; Packet number is zero. move t4, [point 7, strbuf] ; Point to remote filespec. call spack ; Send the packet. jrst $getx movei state, "R" ; Sent it ok, go into receive state. callret $recvb $getx: ermsg% (,r) subttl RECEIVE command ;[57] Resolve debugging status. (This made into a separate routine in edit 57). ; ; Call this routine at the beginning of any packet transaction (send, receive, ; server command, etc). ; ; Returns +1 if there's no debugging going on ; +2 if there is, with the log jfn set up correctly. ; setlog: entry setlog ;[220] Used by k20srv jumpe debug, r ; Return nonskip if not debugging. skipg t1, logjfn ;[194] Yes, has a log file been specified? ifskp. ;[194] Something has been specified caie t1, .priou ; Yes, but is it the terminal? jrst rskp ; No, it's a file, which is always OK. setzm logjfn ; It's the TTY, so say no log file, endif. ;[194] and do next bit. movei t1, .priou ; No log file specified. skipe local ; If running in local mode, movem t1, logjfn ; use the terminal. retskp ; RECEIVE, GET, REMOTE TYPE command execution. ; Initialization -- First, stuff only for when not being a server. $recv: entry $recv ;[194] Called by k20par remark ;[191] Maybe not an optimal place for this? skipg t1, filjfn ;[191] Do we have a JFN?? ifskp. ;[191] Yes, let's check it cain t1, .nulio ;[193] NUL:? anskp. ;[193] Yes, ignore it DVCHR% ;[191] Get its device erjmpr .+1 ;[191] or not... load t3, dv%typ,t2 ;[191] Pick up the device type cain t3, .dvdsk ;[191] Not a disk? anskp. ;[191] A disk, so we're fine move t1, filjfn ;[191] Isn't, so reject it RLJFN% ;[191] Punt our poor JFN erjmpr .+1 ;[191] Ignore cretinous lossage setzm filjfn ;[191] Either way, don't have a JFN emsg ;[191] ret ;[191] And get out of here endif. ;[191] No, somebody else's problem movei state, "R" ; Start out in receive init state. ; Entry point for server commands. $recvb: entry $recvb ;[220] setom $recvf ;[88] Executing RECEIVE command, setzm $sendf ;[88] not SEND command. setzm ttildb ;[180] (stats) setzm ttibin ;[180] (stats) setzm ttisin ;[180] (stats) setzm ttimax ;[180] (stats) call caxzon ;[62] Turn on keyboard interrupts. ifmn. local ;[62] if local. skipe ;[187] Batch frob? anskp. ;[187] txmsg <^A for status report, ^X to cancel file, ^Z to cancel batch. > ;[61] Tell about terminal interrupts, endif. ;[194] call inilin ; Initialize the line. call ccon ; Turn on the ^C trap. jrst reslin ;[27] On ^C go reset line & return from there. skipn gotx ; If I don't already have an X packet, setzm pktnum ; inititialize the packet sequence number. ; Entry point for server. $recvs: entry $recvs ;[220] call statim ;[207] Start timing the entire transfer setzm stot ; Initialize statistics variables. setzm rtot setzb schr, stchr setzb rchr, rtchr setzm files ;[61] File counter setom rptot ;[4] Init received-packet counter to -1. setom sptot setzm nnak ;[54] Init the number of NAKs setzm ntimou ;[54] and the number of timeouts. setzm timerx ;[132] Timer error counter. setzm errptr ; Zero the error message pointer. setom bctone ;[98] Force block check type to 1 initially. skipe autbyt ;[72] Using autobyte? setzm ebtflg ;[72] If so reset eight-bit-mode flag. dmove t1, rpause ;[212] ;[36] Get the requested receive-pause interval dmovem t1, pause ;[212] ;[36] and make it the current one. setzm numtry ; Set the number of tries to zero. $recva: call setlog ;[57] Set up any debugging log. nop ;... ; RECEIVE command, cont'd ; State Table Switcher $recv2: caie state, "D" ;[194] Are we in the data receive state? ifskp. ;[194] We are call rdata ; Go read data packets. jrst $recv2 endif. ;[194] caie state, "F" ;[194] Are we in the file receive state? ifskp. ;[194] We are move t1, filjfn ; Get the file's JFN. call rfile ; Call receive file. jrst $recv2 endif. ;[194] caie state, "R" ;[194] Are we in the receive initiate state? ifskp. ;[194] We are call rinit ; Call receive initiate. jrst $recv2 endif. ;[194] caie state, "C" ;[194] Are we in the receive complete state? ifskp. ;[194] We are call endtim ;[207] Get ending time(s) call elptim ;[207] Compute elapsed time(s) movei t1, "C" move t2, pktnum call diamsg ;[38] Write debugging message if doing that ifmn. local ;[31] if local skipe ;[187] Batch frob? anskp. ;[187] Yes; don't honk the batch log, it's silly movei t1, .chbel ;[31] Give a beep PBOUT ;[31] endif. ;[194] jrst $recvz ;[88] Done. endif. ;[194] caie state, "A" ;[194] Are we in the receive cAncel state? ifskp. ;[194] We are call endtim ;[207] Get ending time(s) call elptim ;[207] Compute elapsed time(s) movei t1, "A" ; Print diagnostic message if debugging. move t2, pktnum ; ... call diamsg ; ... call giveup ; Clean up the file if necessary. jrst $recvz ;[88] Done. endif. movei t1, "U" ; Undefined... move t2, pktnum call diamsg $recvz: call caxzof ;[62] Turn off ^A,^X,^Z traps. call reslin ;[88] Put the line back the way it was. setzm $recvf ;[88] RECEIVE command finished. ret subttl receive routines ; RINIT -- Receive Initiate; get other side's Send-Init packet. ; rinit: saveac ; Save this AC. skipe gots ; Got the S packet already? jrst rinit3 ; Yes, don't try to read it. ; Give up if we've tried too many times, otherwise keep trying. aos q1, numtry ; Increment the number of tries. camge q1, imxtry ;[194] Have we reached the maximum number of tries? ifskp. ;[194] We have movei state, "A" ; Change the state to cAncel. kermsg (,r) ;[46] ;[194] endif. ;[194] call rpack ; Try to get a packet. ifnsk. ;[194] Failed move t2, pktnum ;[53] NAK the one we want. callret nak ;[53] endif. ;[194] ; Got a packet. Check the type and take appropriate action. rinit2: cain t1, "E" ;[32] Error packet? jrst pxerr ;[82] Yes, print it & cancel. ; Should have the other side's Send-Init packet at this point, with T1-T4 ; containing the various pointers, counts, etc. rinit3: setzm gots ; Clear this flag. move q1, t1 ; Save the packet type. call statim ;[207] Start timing transfer cain q1, "S" ; Got a send-init? ifskp. ;[194] Didn't move t2, pktnum ; Something else, or timed out. callret nak ; Just NAK the packet we wanted. endif. ;[194] movem t2, pktnum ; Yes, synchronize packet numbers. call spar ; Get what the other side wants us to do. move t4, [point 8, datbuf] ;[190] Tell the other side what we want rinit4: call rpar ; it to do, by returning our Send-Init movei t1, "Y" ; parameters in our ACK to its Send-Init. move t2, pktnum ; Packet number. move t4, [point 8, datbuf] ;[190] The address of the data. call spack ; Send our params in the acknowledgment. jrst rinitx rinit5: call rrinit ; Go set things up for receiving. rinitz: movei state, "F" ; Set the state to file receive. ret rinitx: movei state, "A" ; Failed, set state to cAncel. ret ;[126] Set things up for receiving. ; ; This code is used by RINIT and by XSEND. ; rrinit: entry rrinit ;[220] Used by k20srv move t2, numtry ; Get the number of tries. movem t2, oldtry ; Save it. setzm numtry ; Reset the number of tries. aos t2, pktnum ; Increment the packet number, andi t2, 77 ; modulo 100, movem t2, pktnum ; and save it back. call ebqmsg ; Maybe print message about 8 bit prefix. setzm bctone ; Enable fancy block checks. ;[126] Log the beginning of this transaction. skipe iflg ;[134] Is this an I packet? ret ;[134] If so, skip logging. wtlog (<-- Receive Begins -->,); ;[194] ; The following can be called to log ebq & bct for either send or receive. rrlog: skipg t1, tlgjfn ; Logging transactions? jrst rinitz ; No, skip ahead. smsg (< 8th bit prefixing: >) ifme. ebqflg smsg () else. smsg () endif. smsg (< Block check type: >) move t2, bctu movei t3, ^d10 NOUT erjmps .+1 ;[194] hrroi t2, crlf dmove t3, [ exp -2, 0 ] ;[194] Counted SOUT SOUT erjmps .+1 ;[194] ret ;[89] EBQMSG ; ;Print warning message if 8th bit prefixing requested but won't be done. ebqmsg: ifmn. local ;[194] Local? skipn ebqr ; Yes, wanted 8th bit quoting? anskp. ; No, so no message will be needed. skipe ebqflg ; Will other side do it, too? anskp. ; Yes, so no need to blat txmsg < %Warning: Other side won't do 8th-bit prefixing. %Binary files will not be transmitted correctly. > ; No, warn. endif. ;[194] ret ; RFILE - Receive File Header rfile: saveac setzm cxseen ;[62] Zero ^X,^Z flags, since they apply setzm czseen ;[62] on a per-file basis. setzm bctone ;[99] Can't hurt... (but why do we need it????) move q1, numtry ; Have we reached the maximum number of tries? camge q1, maxtry ;[194] ... ifskp. ;[194] We have movei state, "A" ; Yes, change the state to cAncel. kermsg (,r) ;[194] endif. ;[194] aos numtry ; No, count this try. skipe gotx ;[112] Already got an "X" packet? jrst rfil3t ;[112] Yes, so don't need to get one. call rpack ; Try to get a packet. ifnsk. ;[194] Failed move t2, pktnum ;[53] NAK the one we want. callret nak ;[53] endif. ;[194] rfile1: caie t1, "S" ; Got a packet. What's the type? jrst rfile2 ; Send-Init? Missed our previous ACK? rfil1a: move q1, oldtry ; Yes, Send-Init. Get the number of tries. camge q1, imxtry ;[194] How many times have we tried to ACK this? ifskp. ;[194] Too many movei state, "A" ; Change the state to cAncel. kermsg (,r) ;[194] endif. ;[194] aos oldtry ; Save the updated number of tries. skipg q1, pktnum ;[3] Get the present packet number. movei q1, 100 ;[3] If it just wrapped around, do this. caie t2, -1(q1) ; Is the packet's number one less than now? ret ; No, fail, stay in this state, keep trying. setzm numtry ; OK, it's the Send-Init again. move t4, [point 8, datbuf] ;[190] ;[50] ... call rpar ; Put our parameters in it. movei t1, "Y" ; Send the ACK with our parameters again. move t2, pktnum ;[47] Not for the current packet, sos t2 ;[47] but the previous one. call spack ; ... jrst @[exp rfil1a, rinitx](t1) ; Handle failures. ret ;... ; RFILE, Cont'd rfile2: caie t1, "Z" ; Is the packet an EOF packet? jrst rfile3 ; No, try something else. rfil2a: move q1, oldtry ; Yes, EOF. How many ACKs have we sent? camge q1, maxtry ;[194] Too many? ifskp. ;[194] Yes movei state, "A" ; Change the state to cAncel. kermsg (,r) ;[194] endif. ;[194] aos oldtry ; Save the updated number of tries. skipg q1, pktnum ;[3] Get the present packet number. movei q1, 100 ;[3] If it just wrapped around, do this. caie t2, -1(q1) ; Is the packet's number one less than now? ret ; No, then hold out for right one. setzm numtry ; OK, it's the previous packet again. movei t1, "Y" ; Restart count, and re-ACK it. setzb t3, t4 ; No data. call spack ; Send the packet. jrst @[exp rfil2a, rfil2x](t1) ret rfil2x: movei state, "A" ; Set state to cAncel. ret ; Process the remote file header rfile3: came t2, pktnum ; Packet number OK? ret ; No, hold out for the right one. ;[104] Begin change for receiving "X" packets. cain t1, "F" ; Start of file? jrst rfil3k ; Yes. caie t1, "X" ; Text header? jrst rfile4 ; No. rfil3t: setzm gotx ;[112] Reset this flag. setom filjfn ; Yes, indicate this way. ifmn. local ;[194] Local, print the file name skipn t3, t4 ;[220] Anything to print, actually? anskp. ;[220] No, so don't print anything ildb t1, t3 ;[220] Pick up a character caie t1, .chcrt ;[220] A carriage return? ifskp. ;[220] It is, let's see if followed by a line feed ildb t1, t3 ;[220] Pick up another character caie t1, .chlfd ;[220] A line feed?? anskp. ;[220] No, so must advance the carriage remark ;[220] Fall out and skip the crlf else. ;[220] Need to get to a clean line hrroi t1, crlf PSOUT% erjmpr r ;[220] If fails, break out of the block, +1 endif. ;[220] Either way, ready to see something move t1, t4 PSOUT erjmpr .+1 ;[194] hrroi t1, crlf PSOUT erjmpr .+1 ;[194] endif. ;[194] jrst rfil3c ; Skip past file opening stuff. ;[177] jrst [ movei state, "A" ;[177] kermsg , r ] ;[177] jrst rfil3c ;[177] Let it come, just don't print it. ;... ; RFILE, Cont'd ; Come here with normal file header. rfil3k: move t1, t4 ; Got the header we want, point to filename. move t2, t3 ; Get the length of the filename string. call makfil ; Go get JFN on it. ifskp. ;[194] Got something movem t1, filjfn ; All OK, save the JFN. call isnulj ;[193] Is this NUL:? ifskp. ;[193] It is, propagate the talisman movem t1, filjfn ;[193] Stomp in as JFN endif. ;[193] End special case NUL: else. ;[194] Otherwise, didn't work movei state, "A" ; Can't, set state to cAncel. ret ; MAKFIL has already issued appropriate E pkt. endif. ;[194] Otherwise, it did work ; Open the file. setzm itsfil ;[75] Assume not ITS binary file. setzm itscnt ;[75] Init counter for header char matching. move t1, filjfn ; Open the file. dmove t2, [ of%wr ;[193] Write access. fld(^d7,of%bsz) ] ;[193] Assume a 7 bit ASCII file skipe ebtflg ;[193] Eight bit mode? movx t3, ;[193] OK, so an eight bit file ior t2, t3 ;[193] Combine for the OPENF% caie t1, .nulio ;[193] Don't bother for NUL: OPENF% ;[193] Open the file %jsker , rfil3a ;[42] Send this + JSYS error msg. wtlog (,filjfn) ;[233] jrst rfil3b ;[42] Opened OK, skip error handling. ; Come here if the file can't be opened. rfil3a: skipg t1, tlgjfn ;[126] Log this failure in transaction log. ifskp. ;[194] That is, IF we are logging .. wtlog (,filjfn) ;[233] smsg (< Because: >) hrloi t2, .fhslf ; Tell why. setz t3, ERSTR erjmps .+2 ;[194] Ignore odd return erjmps .+1 ;[194] Ignore really odd return hrroi t2, crlf movni t3, 2 ;[194] It's two characters long ... SOUT erjmpr .+1 ;[194] Catch and ignore error endif. ;[194] skipg t1, filjfn ;[193] Get the output JFN. ifskp. ;[194] As long as it isn't out and out gubbish cain t1, .nulio ;[193] Data sink? anskp. ;[194] Never needs releasing RLJFN% ; Release it. erjmps .+1 ;[194] ;[33] Ignore any error. endif. ;[193] setzm filjfn ; Clear the JFN. movei state, "A" ; Change state to cAncel. ret ;... ; RFILE, Cont'd... ;[66] If outputting to a file, set up the mapping page pointers. rfil3b: ifmg. filjfn ;[66] JFN on a file? movei t1, mappag*1000 ;[194] Resolve address of page hrli t1, (point 7,) ;[194] Let's assume ASCII skipe ebtflg ;[66] Eight bit mode? hrli t1, (point 8,) ;[66] Then use 8-bit bytes. movem t1, pagptr ;[66] Save it here. setzm pagno ;[66] Begin at file page zero. endif. ;[194] ; If running locally, echo filename to screen. movei t1, 7 ;[66] Remember file byte size for reporting. skipe ebtflg ;[66] (this may be revised later because movei t1, 8 ;[66] of ITS binary headers or similar...) movem t1, bytsiz ;[66] setom rcving ;[62] Indicate we're receiving a file. skipn local ;[12] Local Kermit? jrst rfil3c ;[12] No, no terminal messages necessary. movei t1, .priou ;[12] Yes, print the file name. RFPOS% ;[12] First see if we need to start a new line. hrroi t1, crlf ;[12] ... trne t2, -1 ;[12] ... PSOUT% ;[12] movei t1, .priou ;[12] Now print the file name. hrrz t2, filjfn ;[12] caie t2, .nulio ;[193] Dumping it? ifskp. ;[193] That's easy! smsg () ;[193] Always same name else. ;[193] Otherwise, do it for real setz t3, ;[12] JFNS% ;[12] erjmps .+1 ;[193] don't trash JFN!! endif. ;[193] End NUL: special case movei t1, " " ;[12] PBOUT% ;[12] ; ACK file header, initialize counters and go into Receive-Data state. rfil3c: movei t1, "Y" ; Acknowledge the packet. move t2, pktnum ; This packet number. setzb t3, t4 ; No data. call spack ; Send the packet. jrst rfil3x setzm mapflg ; Say no pages mapped in yet. move t2, numtry ; Get the number of tries. movem t2, oldtry ; Save it. setzm numtry ; Reset the number of tries. aos t2, pktnum ; Increment the packet number, andi t2, 77 ; modulo 100, movem t2, pktnum ; and save it back. setz rchr, ;[128] Initialize file character counter. movei state, "D" ; Set the state to file send. ret rfil3x: movei state, "A" ; On fatal errors, set the state to cAncel. ret ;...RFILE, cont'd ; It wasn't a File Header or EOF packet; check for other possibilities. rfile4: caie t1, "B" ; End of transmission? jrst rfile5 ; No. came t2, pktnum ; Yes, but is it the right packet number? ret ; No, hold out for the right one. movei t1, "Y" ; All OK, acknowledge the EOT packet. setzb t3, t4 ; No data. call spack ; Send the packet. skipa state, "A" movei state, "C" ; Sent ok, set state to Complete. remark ;[186] N.B., a time out here is NOT an error movei t1,rfil4a ;[186] Where to go on a time out call timeit ;[186] Start a timer skipg t1, netjfn ;[186] Wait until the packet move t1, ttyjfn ;[186] Unless using local terminal ifmn. ptyflg ;[186] On a pseudo-terminal? move t1,ptytty ;[186] Load PTY's associated TTY DIBE% ;[186] Wait for it to swallow everything %jsErr (,) ;[186] else. ;[186] Otherwise, do it the ordinary way DOBE ;[158] gets all the way out. erjmpr .+1 ;[186] Catch and ignore error endif. ;[186] End case waiting for output done call timoff ;[186] Shut off the timer remark ;[186] Just want to not hang forever at the end rfil4a: ifmg. filjfn ;[186] Were we writing to a file? wtlog (,) ;[126] Record in transaction log. endif. ret rfile5: caie t1, "T" ;[194] Timer interrupt pseudo packet? ifskp. ;[194] It is move t2, pktnum ; NAK the expected packet. callret nak endif. ;[194] cain t1, "E" ;[82] Error packet? jrst pxerr ;[82] Yes, print it & cancel. rfilex: ret ;[46] Something else, just hold out... ; RDATA -- Receive Data state. rdata: saveac ; Save these aos q1, numtry ;[42] Too many tries for this packet? camle q1, maxtry ;[42] kermsg (, rdterr) ;[194] call rpack ; Get a packet. ifnsk. ;[194] Failed move t2, pktnum ;[53] NAK the one we want. callret nak ;[53] endif. ;[194] caie t1, "D" ; Got one. Data packet? jrst rdata3 ;[42] No, go see what it is. came t2, pktnum ; Yes, but is it the right data packet? jrst rdata2 ; No. ; Process a normal data packet. rdok: move t1, t4 ; Got the one we want, point to data. move t2, t3 ; Get the length of the data. call putbuf ;[66] Write the buffer to the output file. kermsg ,rdterr ; This error is always fatal. movei t1, "Y" ; No error, acknowledge the packet we got. move t2, pktnum ; This sequence number. setzb t3, t4 ; Assume no data. skipn cxseen ;[62] Was ^X typed? skipe czseen ;[62] Or ^Z? ifnsk. ;[194] Yes (to either) hrlzi t3, () ;[62] Yes, put a "Z" ;[194] skipn czseen ;[62] or hrlzi t3, () ;[62] an "X" in the movem t3, datbuf ;[190] ;[62] data field of the ACK movei t3, 1 ;[62] (length of data is 1) move t4, [point 8, datbuf] ;[190] ;[62] and point to it. endif. ;[194] call spack ; Send the packet. jrst @[exp r, rdterr](t1) ;[60] Handle fatal & nonfatal errors. move t2, numtry ; Get the number of tries. movem t2, oldtry ; Save it. setzm numtry ; Reset the number of tries. aos t2, pktnum ; Increment the packet number, andi t2, 77 ; modulo 100, movem t2, pktnum ; and save it. ret ;... ; RDATA, cont'd ; Got a data packet, but it's the wrong one. rdata2: move q1, oldtry ; Get the number of tries. caml q1, maxtry ; Have we reached the maximum number of tries? kermsg ,rdterr ; Yes. aos oldtry ; Not too many, update number of tries. skipg q1, pktnum ;[3] Get the present packet number. movei q1, 100 ;[3] If it just wrapped around, do this. caie t2, -1(q1) ; Is it the previous packet? ret ;[46] No, fail, don't change state, retry. setzm numtry ; Yes, previous packet; start count over. movei t1, "Y" ; Acknowledge it again. setzb t3, t4 ; No data. call spack ; Send the ACK. jrst @[exp r, rdterr](t1) ;[60] Handle fatal & nonfatal errors. ret ; Otherwise return OK. rdata3: caie t1, "F" ; File header? jrst rdata4 ; Nope, try something else. caie t1, "X" ; Text header? jrst rdata4 ; Not that either. move q1, oldtry ; Yes, "F" or "X". Get the number of tries. caml q1, maxtry ; Have we reached the maximum number of tries? kermsg ,rdterr ; Yes, quit. aos oldtry ; Not yet, update number of tries. skipg q1, pktnum ;[3] Get the present packet number. movei q1, 100 ;[3] If it just wrapped around, do this. caie t2, -1(q1) ; Is the packet's number one less than now? ret ;[46] No, fail, don't change state, retry. setzm numtry ; Yes, so start count over. movei t1, "Y" ; Acknowledge the file header again. setzb t3, t4 ; No data. call spack ; Send the packet. jrst @[exp r, rdterr](t1) ;[60] Handle fatal & nonfatal errors. ret ; else try again to get data. ; RDATA, cont'd ; End Of File. rdata4: caie t1, "Z" ; Is it an EOF? jrst rdata5 ; No, try next thing... came t2, pktnum ; Yes, is the packet number correct? ret ;[46] No, ignore this packet, keep trying. ifn. t3 ;[194] Was there any data in the EOF packet? ildb t3, t4 ; Yes, see what it is. caie t3, "D" ; Code for Discard the file? anskp. ;[194] No, proceed. call giveup ; Yes, go "close/cancel" this one, jrst rdat5a ; and then proceed normally. endif. ;[194] block. ;[228] Enter block context for better control saveac ;[228] Save an accumulator move q1,filjfn ;[228] And a copy of the recieve file JFN call rdclos ;[42] Not discarding, close the file normally. ret ;[228] Uh oh, something blew up; don't get clever cain q1, .nulio ;[228] Were we chucking all this? movem q1,filjfn ;[228] We were, so carry on tossing it retskp ;[228] 'successful' block exit endbk. ;[228] End block context ifskp. ;[228] Analyse result of block remark ;[228] Worked, nothing else to do (placeholder) else. ;[228] Pass an error some place jrst rdterr ;[174] If can't give up. endif. ;[228] rdat4a: aos files ;[61] Count the file. ifmn. local ;[19] Print it if local. txmsg <[OK]> ;[19] Closed the file OK, make comforting msg. endif. ;[19] rdat5a: movei t1, "Y" ; Acknowledge the eof packet. move t2, pktnum setzb t3, t4 ; normally (no data). call spack ; Send the ACK. nop ; On any error, just forge ahead. addm rchr, rtchr ; Add character count for this file to total. setz rchr, ; Reset for next file. move t2, numtry ; Get the number of tries. movem t2, oldtry ; Save it. setzm numtry ; Reset the number of tries. aos t2, pktnum ; Increment the packet number, andi t2, 77 ; modulo 100, movem t2, pktnum ; and save it. movei state, "F" ; Change state to "F" ret ; and go back to the state switcher. ; Come here if there was a timeout or error. rdata5: caie t1, "T" ;[194] Timer interrupt pseudo packet? ifskp. ;[194] It is movei t1, "N" ; So send a NAK. move t2, pktnum ; for the expected packet. setzb t3, t4 ; No data. call spack ; Try to send it. jrst rdterr ;[46] Can't, set state to cAncel. ret ; Return to state switcher. endif. ;[194] cain t1, "E" ;[82] Error packet? call pxerr ;[82] Yes, print it, then fall thru... ;... ;...RDATA (cont'd) ; Handler for fatal errors reading/storing data, cancels the transfer. rdterr: call giveup ; Go clean up the file. movei state, "A" ; Change the state to cAncel. ret subttl Utility protocol routines ; SPAR - Get the arguments from a Send-Init packet. ; ;[47] Substitute them for our own unless we have given our own SET commands. ;[47] The way this is done here is less than perfect, but will work most of ;[47] the time (it won't work if the user SETs a value to be the same as the ;[47] default, or if the remote sends different parameters each time, or... ;[47] But it's better than it was before. If it becomes an issue, we can ;[47] add flags for each value saying who changed it, and figure out when ;[47] to set it back to the default, etc... ; ;[50] Call with: ;[50] t3/ Length of Send-Init packet data field (number of parameters) ;[50] t4/ Pointer to Send-Init packet data field. ;[50] The ACs t3-t4 are automatically set up this way upon return from RPACK, ;[50] provided nothing has been done to them before calling SPAR. ; ;[212] It's even more imperfect... spar: entry spar ;[220] Used in k20srv saveac ;[48] ; Packet Size spar1: move t2, spsiz ;[168] Get current setting. sojl t3, spar1a ;[100] Make sure the field is in packet. ildb t2, t4 ; It is, get it. subi t2, " " ; Convert it to a number. spar1a: move q1, spsiz ;[47] See what we have now. caie q1, dspsiz ;[47] Has default been changed already? jrst spar2 ;[47] Yes, probably by SET command, keep that. caige t2, spmin ;[47] No, check bounds for new value. movei t2, spmin ;[47] If too small, use our minimum. caile t2, spmax ;[47] Or if too great, movei t2, spmax ;[47] use our maximum value. movem t2, spsiz ; Set the maximum packet size to send. ; Timeout. spar2: move t2, stimou ;[212] ;[168] Get current setting in milliseconds sojl t3, spar2a ;[100] Got a packet field for this? ildb t2, t4 ; Yes, get it. subi t2, " " ; Convert the character to a number. imuli t2, ^d1000 ;[212] Convert seconds to milliseconds spar2a: ifge. t2 ;[212] Is the result positive? setz t2, ;[212] No, so clamp to zero endif. ;[212] move q1, stimou ;[47] Has the default already been changed, caie q1, dstim ;[47] for instance, by a SET command? jrst spar3 ;[47] Yes it has, so let that take precedence. camn t2, rtimou ;[212] ;[131] Same as other side's timeout? addi t2, ^d1000 ;[212] ;[131] If so, make it a little bit different. push p, t3 ;[212] Save counter over this math fltr t3, t2 ;[212] Float the milliseconds fdvrx t3, 1000. ;[212] Convert to floating seconds dmovem t2, stimou ;[212] Set the time out interval. dmovem t2, otimou ;[212] Here too, in case we want to change it. pop p, t3 ;[212] Restore the character counter ;... ; SPAR, cont'd ; Padding spar3: move t2, spadn ;[100][168] Set up default. sojl t3, spar3a ;[100] Make sure the field is there. ildb t2, t4 ; Get the 3rd field. subi t2, " " ; Convert it to a number. spar3a: move q1, spadn ;[47][168] Check if default already changed. caie q1, dspadn ;[47] jrst spar4 ;[50] It has, don't do this. skipge t2 ;[50] Make sure the number makes sense. movem t2, spadn ;[50] OK, set the padding. ; Pad character spar4: move t2, spadch ;[100][168] Set up default. sojl t3, spar4a ;[100] Make sure the field is there. ildb t2, t4 ; Get the 4th field. addi t2, ^o100 andi t2, ^o177 spar4a: move q1, spadch ;[47][168] Check for default already changed. caie q1, dspad ;[50] jrst spar5 ;[50] cain t2, 177 ;[50] DEL? jrst spar4a ;[50] Yes, can use it. cail t2, 0 ;[50] No, some other control character? caile t2, 37 ;[50] ... skipa ;[50] Nope, reject it. movem t2, spadch ; OK, set the padding char. ; End Of Line spar5: move t2, seolch ;[168] Set up default. sojl t3, spar5a ;[100] Make sure the field is there. ildb t2, t4 ; Get the 5th field. subi t2, " " ; Convert it to a number. spar5a: move q1, seolch ;[47][168] Default changed already? caie q1, dseol ;[47] jrst spar6 ;[50] Yes, so don't do this. cail t2, 0 ;[50] No, did they give a control character? caile t2, 37 ;[50] ... skipa ;[50] Nope, reject it. movem t2, seolch ; OK, in range, set the EOL character. ; Control Prefix spar6: move t2, rquote ;[168][132][100] Get current setting. sojl t3, spar6a ;[100] Make sure the field is there. ildb t2, t4 ; Get the 6th field. spar6a: move q1, rquote ;[168][132][47] Default already changed? caie q1, drquot ;[132][50] jrst spar7 ;[50] Yes, don't change it again. caile t2, " " ;[50] No, check for printable character caile t2, "~" ;[50] other than space. skipa ;[50] Out of range, reject it. movem t2, rquote ;[132] OK, set the quote character. ;... ;...SPAR, cont'd ; [88] 8th-bit prefix support added as edit 88. spar7: sojl t3, spar7x ; Did they give one? If not, do default. ildb t2, t4 ; They did, get it. caie t2, "Y" ; Is it WILL? jrst spar7a ; No, go check for WON'T. ; Other side sent "Y" (WILL). ifmn. ebqr ;[194] ; Did our user request prefixing? move t2, ebq ;[89] Yes, use the specified prefix. movem t2, ebqfld ; Put it here to be sent to other side. setom ebqflg ; Flag that we're doing this. cain t2, "N" ; However, was the request NOT to do it? setzm ebqflg ; In that case, don't. jrst spar8 endif. ;[194] jrst spar7x ; Didn't request it, so DON'T. ; Other side sent "N" (WON'T). spar7a: cain t2, "N" ; Is it WON'T? jrst spar7x ;[89] Yes, so DON'T. ; Not "Y" or "N". See if it's a valid prefix character. spar7b: call prechk ; Call the prefix checking routine. jrst spar7x ; It's not valid. ; Other side sent valid prefix character. spar7c: ifmn. $sendf ;[193] Sending? camn t2, ebq ;[89] matches what we said? jrst spar7d ;[89] Yes, go ahead. move q1, ebqfld ;[89] No, but... caie q1, "Y" ;[89] if this was "Y", then it's still OK. jrst spar7x ;[89] Otherwise, forget it. endif. ;[194] ; Got &/Y, Y/&, or &/& combination, so may be OK to do 8-bit prefixing. spar7d: caie t2, rquote ; Same as one of the control quotes? cain t2, squote ifskp. ;[194] Nope movem t2, ebq ; Unique, so save it as the 8b prefix. movei t2, "Y" ; Acknowledge that we will use it. movem t2, ebqfld ; ... setom ebqflg ; Set the flag saying we must do this. jrst spar8 ; On to next field. else. ;[194] Otherwise, matched one of them movei t2, "N" ; One of those, must refuse. jrst spar7y endif. ;[194] ; Field was none of the above. Take default action. spar7x: movei t2, "Y" ; What we normally say. spar7y: movem t2, ebqfld ; Put it where RPAR can find it. setzm ebqflg ; No 8th-bit prefixing. ; [88] (End of addition) .... ;...SPAR, cont'd ;[98] Block check type. (This section added as part of edit 98) spar8: movei t2, "1" ;[100] Set default, in case this field omitted. sojl t3, spar8a ;[100] See if there is one. ildb t2, t4 ; Here it is... cail t2, "1" ; Between 1 caile t2, "3" ; and 3? movei t2, "1" ; No, substitute default value. ifmn. $sendf ;[194] ; I'm sending? came t2, bctr ; Yes, does this match what I requested? movei t2, "1" ; No, so fall back to default. endif. ;[194] spar8a: movem t2, bctr ; Save as block check type requested. subi t2, "0" ; Convert to a number 1-3, movem t2, bctu ; and save as block check type to be used. ;...SPAR, cont'd ; [92] Repeat count prefix support added as edit 92. spar9: sojl t3, spar9x ; If they didn't give one, don't do this. ildb t2, t4 ; They did, see what it is. ; Is it a valid prefix character? call prechk ; Call the prefix checking routine. jrst spar9x ; It's not valid. ; Other side sent valid prefix character. ifmn. $sendf ;[194] ; I'm sending? caie t2, rptq ; Yes, see if theirs matches what I said. anskp. ;[194] ; It does, proceed. jrst spar9x ; It doesn't, don't do repeat counts. endif. ;[194] ; Got a valid prefix, but make sure it's not already in use. caie t2, rquote ;[194] ; Same as one of the control quotes? cain t2, squote jrst spar9y skipe ebqflg ; Doing 8th-bit prefixing? caie t2, ebq ; Yes, check that prefix too. skipa ; It's OK. jrst spar9x ; It's the same, don't do repeat counts. ; OK, it's valid, it's unique. spar9e: movem t2, rptq ; Save it as what we'll be using. movem t2, rptfld ; What we'll reply, in case we're receiving. setom rptflg ; Set the flag. jrst spar10 ; Go on to next field. ; Come here if we're not going to do repeat counts. spar9x: movei t2, " " ; Blank means default which is no repeat count. spar9y: movem t2, rptfld ; Put it here to reply in case we're receiving, setzm rptflg ; and flag that we're not going to do it. ; [92] (End of addition) ;... ;...SPAR, cont'd ; [179] Capabilities mask, window size (not supported), and long packet size. spar10: sojl t3, sparx ; [179] This field present? ildb t2, t4 ; [179] Yes, get it. subi t2, " " ; [179] Convert it to a number. trnn t2, 2 ; [179] Long Packets capability on? jrst sparx ; [179] No, done. sojl t3, sparx ; [179] Skip Window size ildb t2, t4 ; [179] ... sojl t3, sparx ; [179] Big part ildb t1, t4 ; [179] ... subi t1, " " ; [179] Convert it to a number. imuli t1, ^d95 ; [179] ... sojl t3, sparx ; [179] small part ildb t2, t4 ; [179] ... subi t2, " " ; [179] Convert to number add t1, t2 ; [179] Add to big part movem t1, spsiz ; [179] New packet length. ; Exit. Set up maximum data field size based on what transpired above. sparx: move t1, spsiz ; Get the send packet size. subi t1, 4 ; Deduct the constant overhead, sub t1, bctu ; and the length of the checksum. subi t1, 2 ; Room to leave at end: 2 for possible #X, skipe rptflg ; and if doing repeat counts, subi t1, 2 ; another 2 for repeat prefix, skipe ebqflg ; and if doing 8th-bit prefixing, subi t1, 1 ; another one for that. movem t1, maxdat ; Save max length for data field here. ret ; PRECHK - Check if character in T2 is valid prefix character. ; Return +1 if not, +2 if it is. ; prechk: cail t2, ^d33 ; Is it in the 33-62 range? caile t2, ^d62 skipa ; No, see if it's in the high range. retskp ; Yes, it's in range. cail t2, ^d96 ; Or in the 96-126 range? caile t2, ^d126 ret ; No, something else, not a valid prefix. retskp ; Yes, it's valid. ; RPAR ; ; Sets up the data field of an init packet with the our own parameters, ; which we want the other side to honor. ; ; Call with: ; t4/ Pointer to data field for S or I packet, or its ACK. ; EBQFLD contains the character to send in the 8-bit-quote field. ; Returns with: ; t3/ Length of data field (number of elements). ; t4/ Original pointer to data field. ; The ACs t3-t4 are returned suitably for a call to SPACK. ; rpar: entry rpar ;[220] Used also be k20srv saveac ; Save temp ACs, and t4 for return. move q1, rpsiz ; 1 Get the packet size. caile q1, ^d94 ; Fix to compare correctly. movei q1, ^d94 ;[179] Yes, make it 94. addi q1, " " ; Make the char printable. idpb q1, t4 ; Put it in the data block. ;[128] Tell the other side how to time out, based on the current 15-min ldav. movei t1, 2 ; Request 15-minute load average. call ldav move t2, rtimou ; Other side to use this timeout when I'm recving. cain state, "S" ;[131] But am I sending? subi t2, ^d2000 ;[131] Make it a little different (2 secs) ifl. t2 ;[212] Went negative? setz t2, ;[212] Clamp to no timeout, then else. ;[212] Otherwise, a positive number call adjtim ; Adjust based on load average. setz t1, ;[212] Cast to long (always positive) divi t1, ^d1000 ;[212] Convert to seconds cail t2, ^d512 ;[212] Need to round? addi t1, ^d1 ;[212] Yes, bump up by a second move t2, t1 ;[212] Put quotient in the right place endif. ;[212] addi t2, " " ; Make it printable. idpb t2, t4 ; 2 Put it in the data block. ; Easy fields... move q1, rpadn ; 3 Get the padding. addi q1, " " ; Make the char printable. idpb q1, t4 ; Put it in the data block. move q1, rpadch ; 4 Get the padding char. addi q1, ^o100 ; De-controllify it. andi q1, ^o177 ; idpb q1, t4 ; Put it in the data block. move q1, reolch ; 5 Get the EOL char. addi q1, " " ; Make the char printable. idpb q1, t4 ; Put it in the data block. move q1, squote ; 6 [132] Get the quote char. idpb q1, t4 ; Put it in the data block. move q1, ebqfld ; 7 Say what we'll do about 8th-bit quoting. idpb q1, t4 ; Put in the data block. move q1, bctr ; 8 Block check type requested. idpb q1, t4 ; Put in the data block. move q1, rptfld ; 9 The repeat-count-prefix field. idpb q1, t4 ; Put in the data block. ; [179] Capabilities mask movei q1, 2 ; [179] 10 Set long-packet capability bit addi q1, " " ; [179] Convert to ASCII idpb q1, t4 ; [179] Deposit in packet movei t3, ^d10 ; [179] Ten bytes of data so far move q1, rpsiz ; [179] RECEIVE PACKET-LENGTH caig q1, ^d94 ; [179] Regular (short) packet? ret ; [179] Done. ; [179] Long packets requested movei q1, " " ; [179] Window size is 0 (no sliding windows) idpb q1, t4 ; [179] Deposit aos t3 ; [179] Count move q1, rpsiz ; [179] RECEIVE PACKET-LENGTH idivi q1, ^d95 ; [179] Big part (quotient) addi q1, " " ; [179] Convert to ASCII idpb q1, t4 ; [179] Deposit aos t3 ; [179] Count addi q2, " " ; [179] Small part (remainder) idpb q2, t4 ; [179] Deposit aos t3 ; [179] Count ret ; Done ; Miscellaneous small routines for NAKs & Error packets. ; Send a NAK. Expects to find the packet number to NAK in AC2. nak: entry nak ;[220] Used by k20srv stkvar ; Counter for NAKs. setom naktry nak2: aos t1, naktry ; Count this try. camle t1, maxtry ; Less than maximum? jrst nakx ; No, fail. movei t1, "N" ; Send a NAK. setzb t3, t4 ; No data. call spack ; Send the packet. jrst @[exp nak2, nakx](t1) ; Handle failures. aos nnak ; Sent the NAK OK, count it. ret nakx: movei state, "A" ; If we can't, set state to cancel. ret endsv. ;[196] End lexical context naktry ; Print the contents of an error packet, if local. ; ; t1-t4 contain the packet parameters from RPACK. ; Sets state to cAncel. ; Returns +1 always. pxerr: movei state, "A" ; Set state to cAncel. skipe iflg ; Doing Info packet? ret ; Skip this. movem t4, errptr emsg ; Yes, print message. move t1, errptr ; Get pointer to it, PSOUT% ; and print it. movei t1, ";" ;[235] Don't junk up the discarding! PBOUT% ;[235] movei t1, .chspc ;[235] PBOUT% ;[235] ;[126] Print the error in the transaction log too. skipg t1, tlgjfn ; (if any) ret setom scrlft ;[235] Suppress the carriage return wtlog (,) move t1, tlgjfn ;[235] Reload the foolish JFN move t2, errptr setzb t3, t4 SOUT erjmps .+1 ;[235] Catch and suppress error dmove t2,[-1,,crlf ;[235] Tie off the line -2 ] ;[235] Counted SOUT%'s are faster SOUT erjmps .+1 ;[235] Catch and suppress error ret subttl SEND command ; SEND command execution. $send: entry $send ;[194] setom $sendf ;[88] Executing SEND command, setzm $recvf ;[88] not RECEIVE command. setzm ttildb ;[180] (stats) setzm ttibin ;[180] (stats) setzm ttisin ;[180] (stats) setzm ttimax ;[180] (stats) move t1, pars2 ;[111] Get JFN we just parsed. movem t1, ndxjfn ;[111] Save the wildcard bits here. hrrzm t1, nxtjfn ;[111] Initialize file lookahead. call gtnfil ;[111] Get JFN of first file. ermsg% (,r) ;[111] (if any). call caxzon ;[59] Turn on ^A,^X,^Z interrupts. ifmn. local ;[62] if local. skipe ;[187] Batch frob? anskp. ;[187] txmsg <^A for status report, ^X to cancel file, ^Z to cancel batch.> endif. ;[194] Tell about terminal interrupts, call inilin ; Initialize the line call ccon ; and turn on ^C trap. jrst reslin ;[10] on ^C, go reset line, return from there. ; Entry point for server. $sends: entry $sends ;[220] setzm stot ; Initialize statistics variables. setzm rtot setzb schr, stchr setzb rchr, rtchr setzm files setom sptot ;[4] Init the sent-packet counter to -1. setom rptot setzm nnak ;[54] Init the number of NAKs setzm ntimou ;[54] and the number of timeouts. setzm errptr ; Zero the error message pointer. setzm timerx ; Timer error counter. call statim ;[207] Start timing transfer ; Delay to give them time to escape back to other side and say "receive". skipn srvflg ; Don't delay if server skipe local ; or if local. jrst $send1 ;... ;...$SEND, cont'd ;[128] Remote, do the requested delay. move t4, delay ;[194] The specified delay in milliseconds. $sndxx: ifle. t4 ;[194] Nothing or less than nothing left? call statim ;[207] Start timing transfer jrst $send1 ;[189] Hit send initiate endif. ;[194] End case expired timer ;[194] Otherwise, have some sleepy time movei t1, ^d500 ;[194] Assuming sleeping half a second. caig t4, ^d500 ;[194] BUT!! More than a half second left? move t1, t4 ;[194] No, only sleep the remainder sub t4, t1 ;[194] Subtract from total ms remaining DISMS skipe t1, netjfn ;[186] Got a file transfer jfn? ifskp. ;[186] No... skipg t1, ttyjfn ;[186] How about local line? jrst $sndxx ; No reason why we shouldn't, but... endif. ;[186] ifmn. ptyflg ;[186] A pseudo-terminal? move t1,ptytty ;[186] Load PTY's associated TTY move t3,[SOBE%] ;[186] Look at terminal's OUTPUT buffer else. ;[186] Otherwise, some kind of network or line move t3,[SIBE%] ;[186] In which case, we look at the INPUT buffer endif. ;[186] End of pseudo-terminal special case xct t3 ;[186] Anything in input buffer? skipa jrst $sndxx call statim ;[207] Start timing transfer skipg t1, netjfn ;[186] Reload the JFN move t1, ttyjfn ;[186] Unless using local terminal remark ... ;[186] Fall through to $sndzz ;[128] If user escapes back to micro & types CR to send NAK for packet 0, ; no need to delay any longer -- start sending immediately. $sndzz: BIN ; Just get first character. came t2, rsthdr ; Start of packet? jrst $sndxx ; No, they're probably fumbling w/the keyboard call clrbuf ;[194] Yes, assume it's a NAK for packet 0, nop ;[186] ;[194] discard the rest and start sending. ; We can be sending with either a File Header (F) or a Text Header (X). ; XFLG nonzero means X header, XFLG zero means F header. ; If sending with F header, start with the Send-Init, as packet 0. ; If sending with X, we can skip the Send-Init and send X as packet 1. ; ;[124] BUT... If type 2 or 3 block check requested and agreed upon, ;[124] cannot skip Send-Init (even if I packet exchange just occurred). $send1: movei state, "S" ; Set the state to Send-Initiate. move t1, bctu ;[124] What kind of block check are we using? caig t1, 1 ;[194] ;[124] 2 or 3 character block check? ifskp. ;[194] ;[124] Yes, then must send a Send-Init. setzm pktnum jrst $sendb ;[124] endif. ;[194] ; Type 1 block check. Can obey XFLG. skipn xflg ; X or F header? setzm pktnum ; F, so reset packet number. skipe xflg ; X or F? movei state, "F" ; If X, go straight into file-sending state. $sendb: dmove t1, spause ;[212] ;[36] Get the requested send-pause interval dmovem t1, pause ;[212] ;[36] and make it the current one. setzm numtry ; Set the number of tries to zero. $senda: call setlog ;[57] Set up any debugging log. nop ; SEND command, cont'd... State Table Switcher: $send2: caie state, "D" ;[194] Are we in the data send state? ifskp. ;[194] call sdata jrst $send2 endif. ;[194] caie state, "F" ;[194] Are we in the file send state? ifskp. ;[194] call sfile ; Call send file. jrst $send2 endif. caie state, "Z" ;[194] Are we in the end of file state? ifskp. ;[194] call seof jrst $send2 endif. ;[194] caie state, "S" ;[194] Are we in the send initiate state? ifskp. ;[194] movei t1, "S" ;[100] Packet type for Send-Init. call sinit ; Call send-initiate routine. jrst $send2 endif. ;[194] caie state, "B" ;[194] Are we in the end of send state? ifskp. ;[194] call seot skipn t1, filjfn ;[228] Still have the file open? ifskp. ;[228] We do caie t1, .nulio ;[228] Was it because we were dumping everything anskp. ;[228] No, better leave that alone setzm filjfn ;[228] Yes, 'close' the JFN ... endif. ;[228] jrst $send2 endif. ;[194] caie state, "C" ;[194] Are we in the send complete state? ifskp. ;[194] call endtim ;[207] Get ending time(s) call elptim ;[207] Compute elapsed time(s) movei t1, "C" move t2, pktnum call diamsg call caxzoff ;[59] Turn off keyboard interrupts call reslin ; Restore the line. ifmn. local ;[194] ;[31] if local skipe ;[187] Batch frob? anskp. ;[187] Yes; don't honk the batch log, it's silly movei t1, .chbel ;[31] Give a beep PBOUT ;[31] endif. ;[194] ret endif. ;[194] caie state, "A" ;[194] Are we in the send cAncel state? ifskp. call endtim ;[207] Get ending time(s) call elptim ;[207] Compute elapsed time(s) movei t1, "A" move t2, pktnum call diamsg ;[38] call reslin ; Restore the line. skipg t1, filjfn ;[134] Last-ditch effort to close the file. ifskp. ;[194] If there is one tlz t1,-1 ;[194] Shut off any flags cain t1, .nulio ;[193] Data sink? anskp. ;[193] Yep, nothing to do, actually move t2, t1 ;[194] Save a copy CLOSF ;[134] ifje. r ;[194] cain t1, DESX3 ;[194] JFN not assigned? anskp. ;[194] Isn't, so we're done caie t1, CLSX1 ;[194] File not open? anskp. ;[194] No, something else move t1, t2 ;[194] Load our poor JFN RLJFN% ;[194] Just try to let go over it erjmpr .+1 ;[194] Catch and ignore error endif. ;[194] endif. ;[194] setzm filjfn ;[134] ret endif. ;[194] movei t1, "U" ; Some undefined state??? move t2, pktnum call diamsg ;[38] call caxzof ;[59] Turn off ^A,^X,^Z traps. call reslin ret subttl Send routines ; SINIT: Call with t1/packet type, "S" for Send-Init, "I" for Init-Info. ; sinit: entry sinit ;[221] saveac move q1, numtry ; Get the number of tries. camge q1, imxtry ;[194] Have we reached the maximum number of tries? ifskp. ;[194] Yes ifmn. local ;[194] Local? ermsg% (,sinitx) endif. ;[194] jrst sinitx ; Go cancel the transfer endif. ;[194] aos numtry ; Save updated number of tries. movei t4, "Y" ;[88] Say we agree to do 8-bit prefixing. skipe ebqr ;[88] Did our user explicitly ask for it? move t4, ebq ;[89] In that case, specify requested prefix. movem t4, ebqfld ;[88] Put it here. movei t4, drept ;[92] Want to use this as repeat count prefix. movem t4, rptfld ;[92] Put it here. move t4, [point 8, datbuf] ;[190] ;[50] The address of the data. call rpar ; Set the information. move t2, pktnum ; Packet number. T1 already has packet type. setom bctone ;[98] Force single char checksums. call spack ; Send the packet. jrst @[exp r, sinitx](t1) ; Handle errors. call rpack ; Get a packet. ret ; Trashed packet don't change state, retry. sinity: caie t1, "Y" ; Check packet type. ACK? jrst sinitn ; No, go see if it's a NAK. came t2, pktnum ; ACK. But is it the right ACK? ret ; No, don't settle, hold out for right one. call spar ; Yes, get the information. setzm numtry ; Reset the number of tries. aos t2, pktnum ; Increment the packet number, andi t2, 77 ; modulo 100, movem t2, pktnum ; and save it. call ebqmsg ;[89] Go warn if problem w/8-bit prefixing. setzm bctone ;[98] Finished with initialization. movei state, "F" ; Set the state to file send. ;[126] Start entry in transaction log. skipn t1, tlgjfn ; (if any) ret skipe iflg ; Not an I packet, is it? ret wtlog (<-- Send Begins -->,) ;[194] callret rrlog ; Go log details. sinitn: cain t1, "N" ;[30][54] NAK? aosa nnak ;[54] Yes, count it & return. sinitt: cain t1, "T" ; Timer interrupt pseudo packet? ret ;[30] One of those, just keep trying. cain t1, "E" ; But also print message if error packet. jrst pxerr ;[82] sinitx: movei state, "A" ; Anything else, just cancel. ret ; SFILE - Send File Header sfile: setzm bctone ; Don't require single-character checksum. setzm cxseen ; Zero these here, since they apply on setzm czseen ; on a per-file basis. move t1, numtry ; Get the number of tries. camge t1, maxtry ; Have we reached the maximum number of tries? ifskp. ;[194] We have movei state, "A" ; Change the state to cAncel. kermsg (, r) endif. aos numtry ; No, count this try. jumpg t1, sfild3 ; After first try, skip opening file, etc. sfilea: skipn local ;[12] Local Kermit? jrst sfileb ;[12] No, skip this. movei t1, .priou ;[12] Yes, print the file name. RFPOS% ;[12] First see if we need to start a new line. hrroi t1, crlf ;[12] ... trne t2, -1 ;[12] ... PSOUT% ;[12] movei t1, .priou ;[12] Now print the file name. hrrz t2, filjfn ;[12] cain t2, .nulio ;[193] Dumping it? ifskp. ;[193] Nope, real file (we hope) setzb t3, t4 ;[12] and also goofy prefix JFNS% ;[12] erjmpr .+1 ;[12] Catch and ignore error else. ;[193] Otherwise, JFNS% will blow up smsg () ;[193] Use hardwired name endif. ;[193] ;[194] Below used to be a movei! move t1, pars3 ;[194] ;[96] Did we have another name to use? caie t1, .cmtxt ;[194] Which would be parsed as text ifskp. ;[194] We did txmsg < as > ;[96] Yes, say what it was. hrroi t1, buffer ;[96] PSOUT ;[96] endif. ;[194] movei t1, .chspc ;[12] Leave a space. PBOUT% ;[12] ;... ; SFILE, cont'd sfileb: skipn source ; Are we getting data from a file? jrst sfilb2 ; Yes, go open the file, etc. movei t1, "X" ; No, so send X packet. move t2, pktnum ; This packet number. setzb t3, t4 ; No data. jrst sfildy ; Skip around all the file name baloney. sfilb2: move t1, filjfn ;[15] JFN of file caie t1, .nulio ;[193] Doing I/O to NUL:? ifskp. ;[193] Yes, don't bother with useless OPENF% remark ;[193] Stub if we eventually do something special else. ;[193] Otherwise, do it for real dmove t2, [ of%rd ;[193] Read access. fld(^d7,of%bsz) ] ;[193] Assume a 7 bit ASCII file skipe ebtflg ;[193] Eight bit mode? movx t3, ;[193] OK, so an eight bit file ior t2, t3 ;[193] Combine for the OPENF% OPENF% ;[15] erjmp sfilec ;[44] endif. ;[193] ifme. xflg ;[126] If zero, has an actual file wtlog (,filjfn) ;[233] endif. ;[194] jrst sfiled ;[44] Opened OK, proceed. sfilec: cain t1, opnx1 ;[44] Got an error. "File already open"? jrst sfiled ;[44] Yes, so it's not really an error. move t4, t1 ;[235] Tuck the error away for a little bit skipg t1, tlgjfn ;[194] Log this failure in transaction log. ifskp. ;[194] That is, if it's open wtlog (,filjfn) ;[233] move t1, tlgjfn ;[194] Reload the JFN smsg(< Because: >) hrloi t2, .fhslf ; Tell why. setz t3, ERSTR erjmps .+2 ;[194] Catch and suppress odd return erjmps .+1 ;[194] Catch and suppress bizarre return dmove t2,[-1,,crlf ;[233] Build a Tops-20 pointer -2 ] ;[233] Counted SOUT%'s are faster SOUT erjmps .+1 ;[194] Catch and suppress error endif. ;[194] ifmn. local ;[194] ;[15] No, really an error. txmsg < %Not sent because: > ;[194] Blat if local PSOUT movei t1, .priou hrloi t2, .fhslf setz t3, ERSTR% erjmps .+2 ;[194] Catch and suppress odd return erjmps .+1 ;[194] Catch and suppress bizarre return ret endif. ;[194] skipn t1,filjfn ;[235] See if have to close file ifskp. ;[235] We do. Or might have to tlz t1,-1 ;[235] Stop any flags cain t1,.nulio ;[235] Not just tossing it, are we? anskp. ;[235] We are, no need to close CLOSF% ;[235] Close whatever is there erjmpr .+1 ;[235] setzm filjfn ;[235] Stomp the JFN, either way movei t1, .fhslf ;[235] This process move t2, t4 ;[235] Load the error that failed the OPENF% SETER% ;[235] Reset the PSB for %erker endif. ;[235] movei state, "A" ;[235] Set state to cAncel %erker(,) ;[235] ret ;[235] Give +1 return repeat 0,< ;[235] call gtnfil ; Try to get the next file. ifskp. ;[194] Got one jrst sfilea ; Go try to open it. else. ;[194] setzm filjfn movei state, "B" ; No more, break transmission. ret endif. ;[194] >;repeat 0 ;[235] ;... ;...SFILE, Cont'd ;[96] See if user wants to send the file with a different name. sfiled: move t1, pars3 ; Use another name? caie t1, .cmtxt ; jrst sfild2 ; No, use the file's actual name. dmove t1, [point 7, buffer ;[194] Yes, copy the string the user gave us, point 7, filbuf] ;[102] converting to upper case. call movstu ; Returns length in t3. jrst sfild3 ; Proceed. ; Come here to use the file's actual name. sfild2: move t1, [point 7, filbuf] ;[102] Put string in file name buffer. hrrz t2, filjfn ;[193] The file's JFN. caie t2, .nulio ;[193] Sink? ifskp. ;[193] Yep, bum the JFNS% dmove t3 , [ exp , 0 ] ;[193] dmovem t3, filbuf ;[193] Put the file name into the buffer dmove t3, [exp ^d4,0] ;[193] Length of string jrst sfild4 ;[193] No trailing dot post processing needed else. ;[193] Otherwise, a real file, maybe movx t3, js%nam+js%typ+js%paf ; Only name, type, and punctuation. setzb t4, filbuf JFNS% ; Get the file name. ifje. r ;[194] Catch and ignore error move t1, [point 7, [asciz/XXXXXX.XXX/]] ; If any error movei t3, ^d10 ; substitute this string. jrst sfild4 endif. ;[194] endif. ;[193] ldb t3, t1 ;[175] See what the last character is. caie t3, "." ;[194] Dot? ifskp. ;[194] It is dpb t4, t1 ;[175] Zero it out. seto t4, ;[175] And remember. endif. ;[194] move t2, t1 ; Set up to subtract the byte pointers. idpb t4, t1 ; Terminate the string move t1, [point 7, filbuf] ;[102] Get a pointer to our data block. call subbp ; Subtract the byte pointers, get length in t3. ret ; Uh oh... this should never happen. skipe t4 ;[175] Last char was dot? sos t3 ;[175] Yes, so count one less character. ;... ;...SFILE, cont'd. ;[84] Strip out ^V's, convert filename to "normal form" if requested. ;[102] Do this using normal packet encoding & filling technique, but calling ;[102] an alternate GETCH routine. sfild3: ifmle. filjfn ;[194] ;[128] Not really a file? movei t1, "X" ; Just send an empty X header. move t2, pktnum ; Current packet number. setzb t3, t4 ; No data. jrst sfildy endif. ;[194] ; Really a file. move t1, [point 7, filbuf] ;[102] Keep file buffer pointer in memory. sfild4: movem t1, filptr ;[102] ... movei t1, gtfch ;[102] Address alternate GETCH routine movem t1, source ;[102] to call while getting characters. setom fildot ;[102] Initialize filename dot counter. setom next ;[102] Initialize character lookahead. move t1, maxdat ;[102] Set up maximum length. call getbuf ;[102] Fill up the packet with the filename. ifskp. ;[194] Worked? move t3, t1 ;[102] Set up length for call to SPACK. else. ;[194] Otherwise, some kind of failure ife. t1 ;[194] End of file? setz t3, ;[194] That's fine, no more length, then else. ;[194] Otherwise, another kind of error movei state, "A" ;[102] Shouldn't be any error here, but... ret ;[102] ... just stop doing this endif. ;[194] End case getbuf error analysis endif. ;[194] End case getbuf return analysis ; Send the file header packet. sfildx: setzm source ;[102] Done with alternate GETCH routine. movei t1, "F" ; Packet type is File Header. skipe xflg ; Unless it's teXt header... movei t1, "X" ; ... move t2, pktnum ; Packet number. move t4, [point 8, datbuf] ;[190] Get a pointer to our data block. sfildy: call spack ; Send the file header packet. skipa state, "A" ; Failed, set state to cAncel & return. call rpack ; Sent the file header OK, get reply. ret ; Trashed packet, don't change state, retry. ;... ; SFILE, cont'd ; Got a response, check for & handle ACKs. caie t1, "Y" ; Check the packet, is it an ACK? jrst sfile3 ; No. sfile2: came t2, pktnum ; Yes, but is it the right ACK? ret ; No, don't settle, hold out for right one. setzm rcving ; Indicate we're sending a file. aos rcving ; ... setzm numtry ; Yes, reset the number of tries. aos t2, pktnum ; Increment the packet number, andi t2, 77 ; modulo 100, movem t2, pktnum ; and save it. ifme. xflg ;[194] ;[126] Don't log if not sending a real file. skipn t1, tlgjfn ;[126] Logging transactions? anskp. ;[194] No, carry on smsg (< Sending As ">) ; Yes, log this. hrroi t2, filbuf setzb t3, t4 ;[194] Uncounted, .chnul terminated SOUT erjmps .+1 ;[194] Catch and suppress error dmove t2, [ -1,,[byte (7) .chdbq, .chcrt, .chlfd ] ;[194] -^d3 ] ;[194] Counted strings are faster SOUT erjmpr .+1 ;[194] Catch and ignore error endif. ;[194] jrst sfil3a ;[52] Join common code. ; Check for & handle NAKs. sfile3: caie t1, "N" ; NAK? jrst sfile4 ; No. aos nnak ;[54] Yes, count it. move t1, pktnum ;[51] Get the expected packet number. aos t1 ;[51] Figure out what the next one would be, andi t1, 77 ;[51] mod 64. caie t1, (t2) ;[51] Is the NAK for the next packet? ret ; No, so must send this packet again. setzm numtry ; Yes, for next, same as ACK for this. movem t1, pktnum ; Save incremented packet number. ;... ; SFILE, cont'd ;[75] Check for ITS binary format file. sfil3a: setzm itsfil ;[194] ; Assume this isn't an ITS file. skipn source ; Skip this if it's not really a file. skipn itsflg ; Looking for ITS files? jrst sfil3b ; No. setz t2, ; Yes, do a 36-bit BIN. skiple t1, filjfn ; ... BIN ; ... erjmp sfil3b ; If there's some error, catch it later. came t2, [sixbit/DSK8/] ; Is it an ITS binary file? jrst sfil3b ; No, then handle normally. setom itsfil ; Yes, flag this file as ITS. ifmn. local ; Say what happened if local. txmsg <(ITS binary format) > endif. ; Get first chunk of data. sfil3b: setzm mapflg ;[52] Say no pages mapped in yet. setzm eoflag ;[72] Not EOF yet. setom next ;[63] Initialize input character lookahead. move t1, maxdat ;[63] Maximum length for data field. setz schr, ;[128] Init number of file characters sent. call getbuf ;[63] Fill the first data packet. ifskp. ;[194] Worked! movei state, "D" ; Got data, set the state to file send. movem t1, size ; Save the length of the data. else. ;[194] Otherwise, failed somehow movem t1, cxseen ;[70] If error, send "discard" in EOF message. movei state, "Z" ; Get into EOF state. endif. ;[194] ret ; Back to state switcher. ; Catch-all for other states. sfile4: cain t1, "T" ; Timer interrupt pseudo packet? ret ; Yes, return without changing state. cain t1, "E" ;[80] Error packet? call pxerr ;[82] If so, print remote error message. movei state, "A" ; Cancel the transaction. skiple t1, filjfn ;[80] Close the file. CLOSF ;[80] erjmp .+1 ;[80] setzm filjfn ;[80] ret ; GETCH replacement routine for getting characters from a filename string. ; Uses global FILPTR for input string, FILDOT for counting dots in filename. ; Strips any ^V used as a quote, and if requested converts name to normal form. ; ; Returns: ; +1 never (no reason to fail). ; +2 always, with NEXT containing next character, -1 if no more. ; gtfch: ildb t1, filptr ;[102] Get next character. jumpe t1, gtfchz ;[102] If zero, must be done. cain t1, 26 ;[84] Control-V? ildb t1, filptr ;[102] Yes, it's just a prefix, get next char. skipn xfnflg ;[101] Converting to normal form? jrst gtfchx ;[101] No, skip other conversions. caie t1, "." ;[194] Yes, is this a period? ifskp. ;[194] It is aose fildot ;[84] Don't put more than one. movei t1, "X" ;[84] Substitute "X" for any extra dots. jrst gtfchx ;[84] ... endif. ;[194] gtfchy: move t1, xfntab(t1) ;[84] Translate it. ; Return with character like GETCH. gtfchx: movem t1, next ;[102] Put result in NEXT, as GETCH does. retskp ;[102] Done. ; "EOF" return, like GETCH gtfchz: setz t1, setom next ret ; SDATA - Send a data packet. sdata: skipn cxseen ;[59] Control-X typed? skipe czseen ;[59] Or Control-Z? ifskp. ;[194] Neither saveac ; ^X/^Z not typed, normal case. else. ;[194] Otherwise, one of them typed call unmapi ;[59] Must unmap current input file page. nop ;[59] Ignore any errors. movei state, "Z" ;[59] Get into EOF state. ret ;[59] Back to state switcher. endif. ;[194] sdatab: move q1, numtry ; Get the number of tries. camge q1, maxtry ;[194] Have we reached the maximum number of tries? ifskp. ;[194] Yep, it's all over movei state, "A" ; Change the state to cAncel. ermsg% (, r) endif. ;[194] aos numtry ; Increment number of tries. movei t1, "D" ; File send packet. move t2, pktnum ; Packet number. move t3, size ; Get the data length. move t4, [point 8, datbuf] ;[190] Get a pointer to our data block. call spack ; Send the data packet. jrst @[exp sdatab,sdatax](t1) ; Handle errors. call rpack ; Get a packet. ret ; Trashed packet, don't change state, retry. sdatay: caie t1, "Y" ; Got one, check the type. Is it ACK? jrst sdatan ; No, go check for NAK. came t2, pktnum ; Yes, but is it the right ACK? ret ; No, don't settle, hold out for right one. sosle t3 ;[194] Any data (interested in one & only char)? ifskp. ;[194] Yes ildb t3, t4 ;[62] What's there? caie t3, "X" ;[194] Is it an "X"? ifskp. ;[194] It is setom cxseen ;[140] Yes, set the C-X flag. move t3, source ;[140] What's the source of our data? cain t3, dirch ;[140] A directory listing? setom czseen ;[140] If so, set C-Z flag, too. jrst sdaty2 ;[140] endif. ;[194] cain t3, "Z" ;[62] Is it an "Z"? setom czseen ;[62] Yes, pretend ^Z was typed... endif. ;[194] Go thru one more time, then out. sdaty2: setzm numtry ; Correct normal packet, reset retry counter. aos t2 ;[51] Increment the packet number, andi t2, 77 ; modulo 100, movem t2, pktnum ; and remember it. jrst sdata2 ;[52] Go get some more data to send. sdatan: caie t1, "N" ;[194] NAK? ifskp. ;[194] It is move t1, pktnum ;[51] Get the expected packet number. aos nnak ;[54] Count the NAK. aos t1 ;[51] Figure out what the next one would be, andi t1, 77 ;[51] mod 64. caie t1, (t2) ;[51] Is the NAK for the next packet? ret ; No, then must send current one again. setzm numtry ; Yes, a NAK for n+1(mod 64) = ACK for n, movem t1, pktnum ; so play like we got an ACK, jrst sdata2 ;[52] and go get next packetful of data. endif. ;[194] ;... ;...SDATA, cont'd ; Handle timeout or unexpected packet types. sdatat: cain t1, "T" ; Timer interrupt pseudo packet? ret cain t1, "E" ;[82] Error packet? jrst pxerr ;[82] Yes, print it & cancel. sdatax: movei state, "A" ; Anything else, just cancel.. ret ; Fill up the next buffer of data. sdata2: move t1, maxdat ;[63] Length to work with. call getbuf ;[63] Try to get next bufferful. ifskp. ;[194] Worked movem t1, size ; Got more data, save length, and ret ; return, remaining in state "D". else. ;[194] Otherwise, couldn't movem t1, cxseen ;[70] If error, tell other side to discard. movei state, "Z" ; Set state to EOF. ret ; Go back to state switcher. endif. ;[194] ret ;[194] Shouldn't fall through, but... ; SEOF - Send End Of File packet. seof: move t1, numtry ; No ^X/^Z, get the number of tries. camge t1, maxtry ;[194] Have we reached the maximum number of tries? ifskp. ;[194] Yep, it's all over movei state, "A" ; Change the state to cAncel. ermsg% (, r) ret ;[194] Unnecessary due to ermsg%, but... endif. ;[194] aos numtry ; Still within our limit, bump retry count. skipn cxseen ;[59] Are we discarding this file? skipe czseen ;[59] ifskp. ;[194] We aren't setzb t3, t4 ; Normal case -- no data field. else. ;[194] Otherwise, discarding something dmove t3, [point 8, datbuf ;[190] ;[59] Yes, "D" ] ;[194] put a "D" for Discard in data field idpb t4, t3 ;[59] ... dmove t3, [ ^d1 ;[59] Say the data length is 1 point 8, datbuf ] ;[190] ;[194] point to it again... endif. ;[194] movei t1, "Z" ; Send a Z (EOF) packet. move t2, pktnum ; Packet number. call spack ; Send the packet. jrst @[exp seof, seofx](t1) ; Handle any errors. call rpack ; Get a packet. ret ; Trashed packet, don't change state, retry. ; Got a response. Check for ACK and handle it. caie t1, "Y" ;[52] Check the packet type. Is it an ACK? jrst seof2 ;[52] No... came t2, pktnum ; Yes but, is it the right ACK? ret ; No, don't settle, hold out for right one. aos t2, pktnum ; Increment the packet number, andi t2, 77 ; mod 100, movem t2, pktnum ; and save it. jrst seof4 ;[52] Join common code. ; Check for NAK and handle it. seof2: caie t1, "N" ; NAK? jrst seof3 ; No. aos nnak ;[54] Yes, count it. move t1, pktnum ;[51] What packet were we looking for? aos t1 ;[51] Is the NAK for the next packet? andi t1, 77 ;[51] (mod 64) caie t1, (t2) ;[51] ret ; No, then must send this one again. movem t1, pktnum ; Yes, behave like it was an ACK for this one. jrst seof4 ;[52] Join common code. ; SEOF, cont'd ; Check for other types & handle. seof3: cain t1, "T" ; Timer interrupt pseudo-packet? ret ; If so, just keep going. cain t1, "E" ;[80] Error packet? call pxerr ;[82] If so, print it. skipg t1, filjfn ;[80] Close the file. ifskp. ;[196] If it's open cain t1, .nulio ;[193] and it's not NUL: anskp. ;[193] It is, bum the CLOSF CLOSF% ;[80] erjmpr .+1 ;[196] Catch and ignore error endif. ;[196] setzm filjfn ;[80] seofx: movei state, "A" ; Otherwise cancel. ret ; EOF packet was ACK'd OK, close the file, get the next one (if any). seof4: ifme. xflg ;[126] Sending a real file? skipg t1, tlgjfn ;[194] Yes, transaction log? anskp. ;[194] No, so nothing to log to ... smsg (< Sent: >) ;[194] Yes, log this info. move t2, schr ; Number of bytes. movei t3, ^d10 NOUT erjmps .+1 ;[194] Catch and suppress error movei t2, .chspc ;[194] A space BOUT erjmps .+1 ;[194] Catch and suppress error movei t2, "7" ; Bytesize skipe ebtflg movei T2, "8" ;[194] (faster than AOS...) BOUT% ;[194] Faster than a NOUT% erjmps .+1 ;[194] Catch and suppress error smsg (<-bit bytes >) ;[233] endif. ;[194] setzm numtry ;[52] Reset the retry counter. addm schr, stchr ; Add the last file's size to the total. setz schr, ; Zero the present count. aos files ;[61] Count the file. ifme. source ;[128] Sending a file? skipg t1, filjfn ;[128] Yes, get the JFN of the file just sent. anskp. ;[194] If no valid JFN, don't bother closing. cain t1, .nulio ;[193] NUL: needs no closing anskp. ;[194] So don't do it txo t1, co%nrj ; Don't release it, GNJFN still needs it. CLOSF% ; Close the file. %jserr (,) ;[59] Print msg but continue if error. endif. ;... ;...SEOF, cont'd ; Messages to screen and transaction log. ifmg. filjfn ;[194] ;[127] Transaction log stuff. skipe xflg ;[126] Don't bother if not a real file. anskp. ;[194] Not a real file, then setom scrlft ;[233] Make sure the [OK] is on the same line!!!! wtlog (,filjfn) ;[233] endif. ;[194] ifmn. czseen ; Or this way? dxtext (t2,<[group interrupted]/>) ;[233] Yes, say so. else. ; Otherwise, might be something else ifmn. cxseen ; But was sending interrupted this way? dxtext (t2,<[interrupted]/>) ;[233] Yes, say so. else. ;[233] Otherwise, everything's Archie dxtext (t2,<[OK]>) ;[233] Normal comforting message. endif. endif. skipn local ;[233] Local use? ifskp. ;[233] Yes, so printing it won't bollox the channel block. ;[233] Get a stack frame saveac ;[233] Save the pointer and (negative) count) move t1,t2 ;[233] Load the OWGP dxtext gave us PSOUT% ;[233] Print selected message. erjmpr .+1 ;[233] Catch and ignore error dmove t1,[ .priou ;[233] Still going to primary output point 7,crlf ] ;[233] Point to carriage return line feed dmove t3,[ -2 ;[233] Counted SOUT% is faster 0 ] ;[233] Just in case it looks... SOUT% ;[233] Tie off the line erjmpr .+1 ;[233] Catch and ignore error endbk. ;[233] Tear down the stack frame, restoring t2,t3 endif. ;[233] End case not remote (and sharing channel) skipg t1, tlgjfn ;[194] Do we have a transaction log? ifskp. ;[194] Yes, then put it there, too. setz t4, ;[194] Don't let t4 be a stop character ... block. ;[233] Set up stack context saveac ;[233] Needs plenty registers for intersection jumps xsfm q3 ;[233] Get and store current processor flags move q4, bigsou## ;[233] Load up inter-section transfer address movei q5, .+2 ;[233] And the inter-section return adress xjrstf q3 ;[233] and take a giant step! ret ;[232] Get out of the block, restoring registers endbk. ;[232] End lexical SOUT% block hrroi t2, crlf ;[233] Point to carriage return line feed dmove t3,[ exp -2,0] ;[233] Counted SOUT% is faster SOUT% ;[233] Tie off the line erjmps .+1 ;[233] Catch and suppress error endif. ;[194] seof5: ifme. source ;[194] ;[121] Really doing files? call gtnfil ; If so, get the next file to send. anskp. ;[194] Failed movei state, "F" ; OK, switch to File-send state. else. ;[194] Otherwise no file (or no file any longer) setzm filjfn ; If not, or if no more, zero the JFN, movei state, "B" ; set state to complete, endif. ;[194] ret ;[59] and return to state switcher. ; SEOT -- Send End Of Transmission packet. seot: saveac seotb: move q1, numtry ; Get the number of tries. camge q1, maxtry ;[194] Have we reached the maximum number of tries? ifskp. ;[194] Yep, party's over movei state, "A" ; Change the state to cAncel. ermsg% (, r) remark ret ;[194] ermsg% did that endif. ;[194] aos numtry ; Increment number of tries. movei t1, "B" ; Packet type is Break (EOT). move t2, pktnum ; Packet number. setzb t3, t4 ; No data. call spack ; Send the packet. jrst @[exp seotb, seotx](t1) ; Handle any errors. call rpack ; Get a packet. ret ; Trashed packet don't change state, retry. caie t1, "Y" ;[194] Check the packet. ifskp. ;[194] It was acked came t2, pktnum ; Is it the right ACK? ret ; No, don't settle, hold out for right one. setzm numtry ; Reset the number of tries. aos t2, pktnum ; Increment packet number andi t2, 77 ; mod 100 movem t2, pktnum ; save it back. movei state, "C" ; Complete state. ifme. xflg ;[126] Put message in transaction log, wtlog (,) ;[126] endif. ;[194] End case real file transfer. ret endif. ;[194] caie t1, "N" ;[194] NAK? ifskp. ;[194] It was aos nnak ;[54] Yes, count the NAK. move t1, pktnum ;[51] Is the NAK for the next packet? aos t1 ;[51] andi t1, 77 ;[51] caie t1, (t2) ;[51] ret ; No, must send current one again. movem t1, pktnum ; Yes, behave like it was an ACK for this one. setzm numtry ; Reset the number of tries. movei state, "C" ; Complete state. ret endif. ;[194] cain t1, "T" ; Timer interrupt pseudo packet? ret cain t1, "E" ;[82] Error packet? jrst pxerr ;[82] Yes, print it & cancel. seotx: movei state, "A" ; Otherwise cancel. ret ;[63] Rewrite file routines. ; ; GETBUF - Get buffer (i.e. packet) full of characters from input file. ; ; Call with ; ; AC1/ desired number of characters to get (i.e. data buffer size) ; ; Returns: ; ; +1, failure, with AC1/ 0 if end of input file, or nonzero if other error. ; +2, success, with AC1/ number of characters actually gotten, and ; the result accessible by [point 8, datbuf]. getbuf: entry getbuf ;[220] Also used by k20srv saveac skipg t1 ; Make sure the number is not 0 or negative. ret ; This gives the right return code. caile t1, ^d9000 ; Make sure the number is not too big. movei t1, ^d9000 move q4, t1 ; Maximum number of characters to return. setz q2, ; Counter for actual characters returned. move q3, [point 8, datbuf] ;[190] Where to put the result. setzm rpt ;[126] Clear leftover repeat counts from last. getbfa: ifml. next ; First time through, get first character. call getch jumpn t1, r ;[64] Pass along any failure setz t1, ; Since GETCH puts the character it got in NEXT exch t1, next ; it has to be moved to CH, just this once. movem t1, ch endif. ;[194] getbfb: skipl ch ; Do we have one? If not, must be EOF. caml q2, q4 ; Or buffer full? jrst getbfx ; If so, return it. ; Get next character for lookahead. getbfc: call getch ; Get next one. jumpn t1, r ;[64] Pass along any failure call encode ; Go do any prefixing. skipge t1, next ; Set up for next time through. jrst getbfx ; If no next, we're done. movem t1, ch ; Otherwise next is now current. jrst getbfa ; Loop till done. ; Return the buffer. getbfx: skipg t1, q2 ; Return length of data ret ; +1 if 0 (= EOF) retskp ; +2 if greater than zero. ;[63] This routine added as part of edit 63. ; ; ENCODE - Process a character -- do any prefixing, etc, necessary to ; insert the character into a data packet. ; ; Call with character in global CH, global RPTFLG and EBQFLG indicating ; whether repeat and 8th-bit prefixing are to be done. ; ; Returns: ; +1 always, with CH unmodified, q2/ updated packet length. ; Uses t2-t4. ; encode: move t4, ch ; Get current character. skipn rptflg ; Doing repeat count prefixing? jrst enco8 ; No, skip to next part. ; Repeat count processing. Check if this character same as next. encor: came t4, next ;[194] ; Same as next one? ifskp. ;[194] Yes aos t2, rpt ; So just count it. caige t2, ^d94 ; Count within bounds? ret ; Yes, done. soja t2, encor4 ;[194] ;[93] No, adjust as though next char different. endif. ;[194] ; Go emit a repeat sequence for this much. ; Different, see if there were any repeats. encor2: skipg t2, rpt ; CH not same as next. Any repeats? jrst enco8 ; No, on to next part. caige q2, (q4) ;[93] Yes, near end of buffer? cain t2, 1 ; Or only repeated once? ifskp. ;[194] Both no jrst encor4 ;[194] Go handle general case else. ;[194] Otherwise, go recursive setzm rpt ;[144] Set all the repeat count back to zero. call enco8 ;[144] Call self, skipping around this part, move t4, ch ;[144] and again. call enco8 ;[144] another recursion! ret ;[93] and return. endif. ;[194] ; Repeated more than once -- general case. encor4: move t3, rptq ; Emit a repeat sequence -- idpb t3, q3 ; the repeat prefix character, addi t2, <40+1> ;[93] followed by 'tochar(count+1)' idpb t2, q3 ; because if it's repeated 1x there are 2... addi q2, 2 ; Account for these prefix characters. setzb t2, rpt ; Clear repeat count. ;... ;...ENCODE, cont'd ; 8th-bit prefixing. enco8: setz t2, ; Bit-8 flag. trzn t4, 200 ; Test & clear parity bit. jrst encoc ; Not set, on to next part. seto t2, ; Remember it was on. skipn ebqflg ; Doing 8th-bit quoting? jrst encoc ; No, so skip this. move t3, ebq ; Yes, stick in an 8th-bit prefix. idpb t3, q3 aos q2 ; Count it. ; Control prefixing. encoc: cail t4, 40 ; Control character cain t4, .chdel ; or DEL? ifskp. ; Both no. Prefix prefixing? camn t4, squote ; Control Prefix? jrst encoc4 ; Yes. else. ;[194] Otherwise, one of them xori t4, 100 ; Yes, convert to printable jrst encoc4 ; and go insert a control prefix. endif. ;[194] ifmn. rptflg ;[194] ; Repeat processing? camn t4, rptq ; Yes, is the character the repeat prefix? jrst encoc4 ; Yes, insert a control prefix before it. endif. ;[194] Otherwise, no repeat processing skipe ebqflg ; Eighth-bit prefixing? came t4, ebq ; Is the character the 8th-bit prefix? jrst encocx encoc4: move t3, squote ; Insert a control prefix. idpb t3, q3 aos q2 ; Count it. ; Now, finally, insert the character itself. encocx: skipe t2 ; Was 8th bit on originally? skipe ebqflg ;[109] Yes, but did we quote it already? skipa ;[109] In that case, don't put it back. tro t4, 200 ; It was on & wasn't quoted so put it back. idpb t4, q3 ; Deposit it. aos q2 ; Count it. ret subttl GETCH - Get a character from the disk file ;[63] This routine added as part of edit 63. ; ; If global SOURCE is nonzero, it is assumed to contain an address of a ; routine to be used instead of this one. ; ; Returns: ; +1 on failure, with t1/0 if EOF, t1/-1 if real error getting character. ; +2 on success, with global NEXT containing the character, -1 if EOF. getch: skipe t1, source ;[102] Alternate routine to call? jrst (t1) ;[102] Yes, go there instead. saveac ; Save permanent ACs. ifmn. eoflag ;[194] ; Is the end of file flag set? setzm eoflag ; Yes, reset EOF flag for next time, jrst getchz ; and return EOF. endif. ;[194] skipe mapflg ; Do we have anything mapped in? jrst getch2 ;[224] ; Yes, don't have to recalculate everything skipg t1, filjfn ;[193] No, must do mapping, here's the JFN. movei t1, .nulio ;[193] Gubbish? Force end of file cain t1, .nulio ;[193] Data sink? ifskp. ;[193] No, so business as usual movx t2, <2,,.fbbyv> ; Get number of pages and bytes movei t3, pagcnt ; into pagcnt and bytcnt, GTFDB% ; from the file descriptor block. %jsker ,getchx ; Return error. move t3, pagcnt ;[224] Load .fbbyv for downstream else. ;[193] Otherwise, nothing there movx t3, ;[224] Let's pretend it's ASCII movem t3, pagcnt ;[224] Store with no pages setzm bytcnt ;[193] Not no bytes in NUL:, not no how GTAD% ;[193] Get right now movem t1, crdate ;[193] Always created right now movei t1, .nulio ;[193] Reload the 'JFN' endif. ;[193] End case NUL: remark ;[224] Some sanity checking setom eoflag ;[224] Let's assume empty; set end-of-file flag hrrz t2, t3 ;fb%pgc ;[224] Pick up the page count jumpe t2, getchz ;[224] User can't lie about that skipg bytcnt ;[224] Any bytes in the file? jrst getchz ;[224] None or gubbish, return end of file ldb t2, [pointr t3, fb%bsz] ;[193] Get the file byte size. jumpe t2, getchz ;[224] Gubbish? Punt the file caile t2, ^d36 ;[224] Absurdly large? jrst getchz ;[224] Yes, so gubbish; return end of file movem t2, bytsiz ; Save it. setzm eoflag ;[224] Not empty, so clear end-of-file flag. ; 7- or 8-bit input from the file? First, check for ITS binary format. skipe itsfil ;[75] ITS binary format file? ifskp. ; It isn't... skipn autbyt ;[81] Are we using autobyte? anskp. ; Nope, so nothing to do setzm ebtflg ; Yes, assume seven-bit bytes. cain t2, ^d8 ; Really 8-bit? setom ebtflg ; Yes, act like user requested 8-bit. endif. ; End Not ITS and auto byting ; Now, if we're doing 8-bit input, convert the byte count, if necessary. remark begin [194] code insertion ;[194] The logic to figure out what kind of byte calculation got to ; be difficult to follow and hence maintain. The entire ; sequence was rewritten to use MACSYM's very useful (but rarely ; used) BLOCK. macro to handle the complex logic. ; ; Basically, BLOCK. sets up a stack frame from which we return ; either +2 for the 8 bit code or +2 for 7 bit code. Since we ; have a stack frame, we can also use the standard register ; saving and transient variable facilities. ; ; The algorithm is that we treat anything that is not 7 or 8 bit ; as 7 bit. This allows text output from Tops-10 utilities to ; get transferred properly. ; ; N.B., Do NOT jump out of a BLOCK. because the stack will be wrong. ; This isn't Algol, after all... getch1: block. ; Enter block context skipe itsfil ; ITS binary file? retskp ; Yes, then take 8 bit case skipe ebtflg ; or forcing eight bit mode? retskp ; Yes, then take 8 bit case endbk. ; Exit block context ifskp. ; +2 is the 8 bit case cain t2, ^d8 ; Is the file byte size also 8 bit? ifskp. ; It isn't, so time to do some math movei t3, ^d36 ; Get the size of a word. idiv t3, t2 ; Divide by the byte size to get bytes per word move q1, bytcnt ; Get the number of bytes in file. idiv q1, t3 ; Divide by the bytes word word to get words. imuli q1, 4 ; Multiply by 4 (as if they were 8-bit bytes). movem q1, bytcnt ; Save the new byte count. endif. ; End case non-8 bit file as 8 bit format ifmn. itsfil ;[86][170] ITS binary file? move q1, bytcnt ;[86] Load current byte count. subi q1, 4 ;[86] Subtract 4 to account for ITS header. movem q1, bytcnt ;[86] Save it back. endif. ; End case ITS header fix up else. ; Otherwise, it's the 7 bit case block. ; Handle some more complex logic cain t2, 7 ; Is the file 7 bits? ret ; Yes, nothing to do cain t2, ^d8 ; How about an 8 bit file? ret ; Leave that alone, too movei t3, ^d36 ; Must convert, so get the size of a word. idiv t3, t2 ; Divide by the byte size to get bytes per word move q1, bytcnt ; Get the number of bytes in file. idiv q1, t3 ; Divide by the bytes/word to get words. imuli q1, 5 ; Multiply by 5 (as if 7 bit bytes). movem q1, bytcnt ; Save the new byte count. endbk. ; End case non-7 bit file as 7 bit endif. ; End of control return structure remark End [194] code insertion remark Byte size figured out, now map in the first page. hrlzs t1 ; Form file JFN,, page 0 hrlm t1, pagcnt ; Zero left half of pagcnt (so can use against counter) call mapi ; Map it in. jrst getchx ; Pass along any failure. skipe itsfil ;[75] ITS binary file? aos pagptr ;[75] Yes, skip first word of it. setzm pagno ; Present page is zero. setom mapflg ; Say we've got a page mapped in. remark Come here if/when/after page is mapped in... getch2: camge schr, bytcnt ;[194] Any more bytes in file? ifskp. ;[194] We've hit or passed the file byte count setom eoflag ; No, Set the end of file flag. call unmapi ; Unmap the input file page. ret ; Fail if we can't setzm mapflg ; Say nothing mapped in. jrst getchz ; Return EOF. endif. ;[194] ;[224] The previous code would pick up a character and then check to ; see if the ildb went off the file page. If this was the case, a new ; file page was mapped in and another ildb was done, the difference ; being that schr didn't get incremented. ; ; This won't work when the file window page is followed by a guard ; page or it is the last page in a section that is followed by a ; non-existent section or section 7777. In that case, the first ildb ; will blow up trying to reference a page that can not or will not be ; created by Tops-20. ; ; This is a false negative. The fix is to check whether we are at the ; last byte in the page, FIRST. getch3: remark ; Are we at the end of the page yet? move t1, pagptr ;[224] Load the pointer ibp t1 ;[224] Bump it to the next one tlz t1, -1 ;[224] Stomp the local point portion caige t1, *1000 ;[64]... jrst getch4 ;[224] Not off the page, go get a character call unmapi ; Yes, unmap the input page. jrst getchx ; Pass along any failure. move t1, pagno ; Get the present page number. aos t1 ; Increment it. camge t1, pagcnt ;[194] ; Any more pages? ifskp. ;[194] Should not have hit this ... setom eoflag ; No, set the end of file flag for next time. %ermsg(,getchx) ;[224] endif. ;[194] schr said there was more data... movem t1, pagno ; Save the new number. hrl t1, filjfn ; call mapi ; Map in the page. jrst getchx ; Pass along any failure. getch4: ildb t2, pagptr ; Get the next character. ifje. s ;[70] (illegal memory read, hole in file...) skipn local ;[224] OK to blat? jrst getchx ;[224] No, just go ditch the transfer %ermsg(,getchx) ;[224] Otherwise, blat and ditch else. ;[224] Otherwise, nothing is wrong with the page aos schr ;[64] Got it OK, count it. endif. ;[224] End ildb check ; Got the character in t2. Worry about bit 35 if doing 7-bit i/o. ; The trick is to set the parity bit ("b8") of every 5th character to ; the value of b35 of the PDP-10 word it came from. The same trick is ; used by TOPS-20 when writing ANSI-ASCII tapes. This allows for ; Tops-10/20 .EXE's, other 36-bit binary files, and SOS-line numbered ; files, to be sent to 8-bit systems and retrieved intact. No adverse ; effects are suffered by ordinary text files. getch5: move q1, schr ;[64] Count the character. skipn itsfil ;[75] ITS binary file? skipe ebtflg ; Eight bit mode? jrst getch6 ; One of those, no need to do this. ; idivi q1, 5 ; No, 7-bit, divide character number by 5. ife. q2 ;[194] ; Last character of word if remainder is 0. move q1, pagptr ; In that case, get the entire contents. move q1, (q1) ; trne q1, 1 ; Bit 35 on? tro t2, 200 ; Yes, turn on bit 8 of this character. endif. ;[194] getch6: movem t2, next ; Return the character. retskp ; EOF return. getchz: setz t1, ; Return zero error code, setom next ; and character -1. ret ;... ;...GETCH, cont'd ; Error return. getchx: setob t1, next ; Return -1 error code, and character -1. movx t2, <.fhslf,,mappag> ;[70] Unmap any page that's still mapped in. setz t3, ;[70] PMAP% ;[70] erjmp .+1 ;[70] Ignore errors. setzm mapflg ;[70] ret ; MAPI - Map in file page. ; ; Call with ; t1/ jfn,,page number. ; ; Returns ; +1 on failure. ; +2 on success, with PAGPTR adjusted to point back to beginning of page. ; mapi: movx t2, <.fhslf,,mappag> ; Form our fork,,mapping page push p, t1 ;[193] Save source handle trz t1,-1 ;[193] Shut off the page number camn t1,[.nulio,,0] ;[193] Trying to map from NUL:?? ifskp. ;[193] No, then this is safe pop p, t1 ;[193] Restore the source handle movx t3, pm%rd ; Just want to read it. else. ;[193] Otherwise, nothing in NUL: ... adjsp p,-1 ;[193] Throw away handle seto t1, ;[193] Whacking page from address space setz t3, ;[193] No count (a single page) 1or flags endif. ;[193] End special case NUL: PMAP% ; Map it in. %jsker ,r ; Error, fail. move t3, [point 7, maporg] ;[190] Success, get a pointer to the page. skipn itsfil ;[75] An ITS binary file? skipe ebtflg ; Or eight bit access? hrli t3, (point 8,) ; Yes, then use 8-bit pointer. movem t3, pagptr retskp ; Return successfully. ; UNMAPI -- Unmap an input file page. ; ; Returns +1 on error, +2 on success. ; First check to see where we're getting our input from. ; unmapi: skipn t1, source ;[139] But are we really reading from a file? jrst unmap3 ;[139] Yes, really unmap. caie t1, dirch ;[139] No, is it a directory listing? jrst unmap2 ;[139] No, something else. ; From a directory listing buffer. Clear it & reset pointers for next time. call dmpbuf ;[139] Yes, directory listing; clear buffer. setzm source ;[139] Indicate no more alternate source. ret ;[139] Done. ; From some other source (add others here). unmap2: ret ; Source is really a file, unmap the current file page. unmap3: seto t1, ; Indicate unmap. movx t2, <.fhslf,,mappag> ; This process. setz t3, PMAP% ; Unmap the page. %jsker ,r retskp ;[66] PUTBUF -- Write the contents of the data field of a packet out to a file. ; ; Call with: ; ; t1/ pointer to data buffer. ; t2/ number of characters. ; pagptr/ output file page byte pointer. ; ; Returns: ; ; +1: Failure, Couldn't write the whole buffer, Error packet already sent. ; +2: Success putbuf: entry putbuf ;[220] ;[194] First check arguments jumpe t1, r ;[194] Yet, no buffer pointer? jumple t2, rskp ;[194] Done already? saveac ; Preserve these ACs. dmove q1, t1 ; Save the arguments. ildb t2, t1 ;[194] Test pointer anyway erjmpr r ;[194] Bad somehow, fail the call do. ;[194] ildb t2, q1 ; Not yet, get the next character from the pkt. call decode ; Go decode and store it. ret ; Pass along any error. skipn itsflg ;[194] Looking for ITS binary format? sojg q2, top. ;[194] No, loop. cain rchr, 4 ;[75] Just finished 4th character? call itschk ;[75] Yes, see if it was the ITS binary hdr. sojg q2, top. ;[194] Loop. enddo. retskp ;[194] Did the whole buffer ;[75] ITSCHK -- See if first 4 bytes of file are ITS binary file header. ; ; Uses t1-t3. ; Returns +1 always, with ITSFIL set if the first 4 bytes are the ITS binary ; file header, sixbit/DSK8/, and with the various pointers and counters ; adjusted appropriately. By the way, since this routine sets RCHR back to ; zero, it gets called again 4 characters later -- this should do no harm. itschk: skipe itsflg ; Is ITS checking enabled? skipg itscnt ; and any header characters counted? ret ; No, forget it. move t1, itscnt ; We were counting the matching characters... setzm itscnt ; Reset the counter. caie t1, 4 ; The four characters matched? ret ; No, done. setom itsfil ; Yes, flag it. move t1, [point 8, maporg] ; Set up page pointer for 8 bit. movem t1, pagptr setz rchr, ; Rewind the character counter. movei t1, 8 ; Record file bytesize correctly movem t1, bytsiz ; ... ifmn. local ; Say what happened if local. txmsg <(ITS binary format) > endif. ret ;[66] DECODE -- Convert data in Kermit packet to its original form. ; ; Call with: ; t2/ Character to decode ; q1/ Buffer pointer ; q2/ Position in buffer ; Returns: ; +1: Failure, if output could not be done. ; +2: Success, with q1,q2 updated. ; ; Note: If the input character is a prefix of any kind, this routine ; will input all further characters necessary to complete the prefixed ; sequence, and update the counts and pointers appropriately. ; decode: saveac ; Preserve this one. decod0: move t3, t2 ; Make a copy with the parity bit intact. andi t2, 177 ; And without, so comparisons will work. decod1: setzm rpt ; Reset repeat count. skipn rptflg ; Repeat count processing? jrst decod2 ; No. came t2, rptq ; Yes. Is this the repeat prefix? ifskp. ;[194] It is ildb t2, q1 ; Get the count. andi t2, 177 ; Let's be cautious... subi t2, 40 ; Convert from character to number. ifle. t2 ;[194] Nice and positive? movei t2, ^d1 ;[194] No, a zero negative count is bad... endif. ;[194] movem t2, rpt ; Save the repeat count. ildb t2, q1 ; Get the next character. move t3, t2 ; Copy with parity (in case it's not a prefix) trz t2, 200 ; and without... subi q2, 2 ; Account for the repeat prefix sequence. endif. ;[194] ;... ;...DECODE, cont'd decod2: setzm ebqchr ;[90] Say no 8th-bit prefix on this character. skipn ebqflg ; Doing 8th-bit quoting? jrst decod3 ; No. came t2, ebq ; Yes, is this the 8th-bit prefix? ifskp. ;[194] It is ildb t2, q1 ; Get the character it is prefix of. move t3, t2 ; Copy with parity in case not ctl prefix tro t3, 200 ; ... trz t2, 200 ; and without (this shouldn't anyway, but...) setom ebqchr ;[90] Flag that we did this. sos q2 ; Account for it. endif. ;[194] decod3: came t2, rquote ; Control Prefix? jrst decod4 ; No... ildb t2, q1 ; Yes, get its argument. move t3, t2 ; Copy with parity trz t2, 200 ; and without... skipe ebqchr ;[90] Was there an 8th-bit prefix? tro t3, 200 ;[90] If so, set the 8th bit. sos q2 ; Account for the ctl prefix. cail t2, "@" ; Check if the character is in the sequence caile t2, "_" ; "@ABC...XYZ[\]^_" skipa ; No, take it literally. xori t2, 100 ; Yes, controllify. cain t2, "?" ; Or is it a question mark? movei t2, 177 ; Yes, then it's really a DEL. decod4: trne t3, 200 ; 8th bit was on? tro t2, 200 ; Yes, then put it on in the result. decod5: skipg q4, rpt ;[194] ; Repeat Count. movei q4, 1 ;[194] ; If gubbish, make it 1. decod6: jumple q4, decodz ; Loop for repeat count. aos rchr ; Count the data character. ; The following check must be done here. We can't look directly at RECPKT, ; because it will contain quoting characters which must be evaluated by this ; routine. We can't do it by looking at the result in MAPPAG after calling ; PUTCH, because we might be writing to MAPPAG with a 7-bit pointer. ifmn. itsflg ;[194] Don't bother if not doing ITS caile rchr, 4 ;[75] Check for the ITS header in 1st 4 chars. anskp. ;[194] If past first 4, don't check. camn t2, [exp 0, 223, 72, 330, 0](rchr) ;[75] Check this character. aos itscnt ;[75] If it matches, count it. endif. ;[194] call putch ; Output the character. ret ; Pass along any failure. soja q4, decod6 ; Until done. decodz: retskp ; Success. ;[66] PUTCH -- Output a character to a file. ; ; Call with: ; t2/ Character to output. ; pagptr/ Pointer to where to put it (if disk file). ; Returns: ; +1: Failure (disk full, etc). ; +2: Success, pagptr updated. (Uses t1-t4) ; putch: skipe t1, dest ; Alternate PUTCH routine? jrst (t1) ; Yes, go to it. skiple filjfn ;[177] To file? jrst putch2 ;[177] Yes, go do that. skipn local ;[177] No, to screen. retskp ;[177] But if remote, skip it. move t1, t2 ; No, then just put it on the screen. PBOUT ;* Pretty dumb, make this more efficient retskp ;* later... ; File output. Test to see if page is full. putch2: move t1, pagptr ; Copy the byte pointer. ibp t1 ; Increment the copy. hrrzs t1 ; Clear out the LH. caig t1, <<*1000>-1> ; At the end yet? jrst putch5 ; No, proceed. ; A page is filled up -- map it out. putch3: move t4, t2 ; Yes, save the character around this. call unmapo ; Go unmap the current page. ret ; Pass along any failure. move t2, t4 ; Get back the character. aos pagno ; Advance the file page number. ; Rewind the memory page back to word 0. putch4: move t1, [point 7, mappag*1000] ; Success, make a pointer skipn itsfil ;[75] skipe ebtflg ; of the appropriate hrli t1, (point 8,) ; byte size. movem t1, pagptr ; Store it. ; Deposit the character into the memory page. putch5: idpb t2, pagptr ; Put it in the page. ;... ;...PUTCH, cont'd ; Worry about bit 35. putch6: skipe itsfil ;[75][81] ITS binary file? retskp ;[75] Yes, don't worry about this. skipn ebtflg ; Output to 7-bit file? trnn t2, 200 ; AND parity bit is on? retskp ; No, done. putch7: move t3, rchr ; Yes, both, get the char count, idivi t3, 5 ; modulo 5. jumpg t4, rskp ; Is this the last char in the word? putch8: move t3, pagptr ; Yes, get its contents. move t4, (t3) ; ... tro t4, 1 ; Turn on bit 35. movem t4, (t3) ; Put it back. retskp ; Done. subttl File Routines ;[119] MAKFIL - Rewritten as part of edit 119. ; ; Construct an output filespec from name given in file header packet. ; ; Call with: ; ; T1/ Pointer to a file name from packet. ; T2/ Number of characters. ; ; Return: ; +1: Failure ; +2, Success, with JFN in T1. makfil: ifmg. filjfn ;[194] Do we have a file already? move t1, filjfn ;[194] Must have overridden on receive retskp ;[194] Just return that JFN. endif. ;[194] ifle. t2 ;[194] Are there at least a few chars? setz t1, ;[194] No, so no file anwhere to be had kermsg (, r) ;[194] endif. call decodf ;[141] Decode the file name. kermsg (, r) ;[194] ; Now fix up the name, if desired, and get a JFN on it. call filfix ; Go check & fix the filename syntax. movx t1, gj%sht!gj%fou ; Short form. GTJFN% erjmp makfix ;[132] On error, go do something else. call isnulj ;[194] Was it NUL:? retskp ;[194] It wasn't, that's fine retskp ;[194] It was, that's fine too (we're easy) ;[132] Despite all efforts, couldn't construct legal name for file. makfix: movx t1, gj%sht!gj%fou ; Get a JFN for... sxtext (t2,<-UNTRANSLATABLE-FILENAME-.KERMIT.-1>) ; ...this. GTJFN %jsker ,r ; This should never fail, but... move q1, t1 ; Log what happened. wtlog (,q1) ;[233] move t1, q1 ; Get this back. retskp ;[141] Moved to separate routine as part of edit 141. ; ; Decode a file found in the data field of a KERMIT packet. ; Call with: ; t1/ pointer to data field. ; t2/ number of characters in data field. ; ; Returns: ; +1 on failure, ; +2 on success, with pointer to decoded filename in t1. ; decodf: entry decodf ;[220] saveac ; Preserve this. move q1, t1 ; Save argument for a sec. move t1, [point 7, strbuf] ; Build decoded name here. movem t1, strptr setzm strbuf ; Clear out the string buffer move t1, [strbuf,,strbuf+1] ; so result will be asciz. blt t1, strbz ; ... movei t1, putsch ; Routine to deposit decoded characters. movem t1, dest ; ... move t1, q1 ; Get argument back. call putbuf ; Decode the file name string. ret ; Failed for some reason, pass it along. setzm dest ; Decoded OK, restore normal destination. move t1, [point 7, strbuf] ; Return pointer to decoded file name. retskp ; +2. ; FILFIX - Fix incoming file names by quoting illegal characters with ^V. ;*(Should also make sure length is no greater than 39.39) ; ; Call with t1/ Pointer to filename ; Returns +1 always, with t2 pointing to legal TOPS-20 filename. ; filfix: skipe xfnflg ;[84] Doing filename conversion? jrst filcnv ;[84] Yes, then go do that. move t3, [point 7, filbuf] ; No, but still have to quote funnies. setzm filbuf ;[174] setom fildot ; Count dots. filfx2: ildb t2, t1 ; Get the next character. ife. t2 ;[194] Unless this is the end of the string idpb t2, t3 ; Put the null in. move t2, [point 7, filbuf] ; Return a pointer to the filename. ret endif. ;[194] ; Got a character, validate it. cail t2, "A" ; Upper case letters are legal. caile t2, "Z" skipa jrst filfx4 cail t2, "0" ; Digits are legal. caile t2, "9" skipa jrst filfx4 caie t2, "$" ; Dollar sign is legal cain t2, .chdas ;[194] So is dash. jrst filfx4 caie t2, "_" ; Underscore is legal. cain t2, .chsem ;[194] Allow semicolon for attributes. jrst filfx4 remark ;[193] Probably the wrong way to do this cain t2, ":" ;[193] Device punctuation? jrst filfx4 ;[193] It's a device, allow it caie t2, "." ;[194] A dot? ifskp. ;[194] It is aosg fildot ; Count it. jrst filfx4 ; First dot, ok to use it. jrst filfx3 ; Not first, go prefix it. endif. ;[194] caile t2, "z" ;[194] Before end of range, lower case? ifskp. ;[194] It is, might need upper casing caige t2, "a" ;[194] and after beginning of range, lower case? anskp. ;[194] No, something very illegal then. trz t2, 40 ;[153] Yes, convert to upper and jrst filfx4 ;[153] use it. endif. ;[194] ; Get here with illegal character that must be prefixed with control-V. filfx3: movei t4, ^o26 ; Control-V. idpb t4, t3 ; Insert it before the character. ;[174] Deposit the character, but if first and a dot, insert an X before it. filfx4: skipn filbuf ; Something in buffer already? caie t2, "." ; No, first character is a dot? jrst filfxx ; OK to go ahead. movei t4, "X" ; 1st char would be a dot, so... idpb t4, t3 ;[174] filfxx: idpb t2, t3 ; Now deposit the actual character. jrst filfx2 ; Loop till done. ;[84] Convert incoming filename to "normal form". ; This routine added as part of edit 84. ; ;;;; Move to k20sub and convert to use movst? filcnv: move t3, [point 7, filbuf] ; Where to put new file name. setzm filbuf ;[174] movei q1, 1 ; Dot counter. filcn2: ildb t4, t1 ; Get next character. jumpe t4, filcnx ;[142] If null, done. caie t4, "." ; Dot? jrst filcn4 ; No. ;[174] check for names starting with dot. ifme. filbuf ;[194] ; Anything in name yet? movei t4, "X" ; No, insert an X. idpb t4, t3 movei t4, "." endif. ;[194] ;[174] soje q1, filcn4 ; Yes, make sure there's only one dot. movei t4, "X" ; If more, translate extra dots to X's. jrst filcn5 filcn4: move t4, xfntab(t4) ; Translate it. filcn5: idpb t4, t3 ; Put it back. jrst filcn2 ; Loop till done. filcnx: setz t2, ; Put a null at the end. idpb t2, t3 move t2, [point 7, filbuf] ; Return a pointer to the file. ret ; Translate table to turn funny characters into X's, raise lower case ; letters, leave upper case letters and digits, and periods alone. ; For translating file names to "normal form". xfntab: xlist ;;[187] repeat <^d46>, exp ".","X" exp "0","1","2","3","4","5","6","7","8","9" repeat <7>, exp "A","B","C","D","E","F","G","H","I","J","K","L","M","N" exp "O","P","Q","R","S","T","U","V","W","X","Y","Z" repeat <6>, exp "A","B","C","D","E","F","G","H","I","J","K","L","M","N" exp "O","P","Q","R","S","T","U","V","W","X","Y","Z" repeat <5>, 0 list ;;[187] subttl SPACK (Send-Packet) ; ; Assembles & sends a packet from the given arguments. Assumes all quoting, ; prefixing, condensing, etc, already done. Sends the fields in the proper ; order, validating the control fields to some extent, adding desired parity ; (if any) to each character, calculates and appends the checksum, appends any ; desired padding or eol characters, and does any required pause or handshake. ; ; Call with: ; AC1 - Type of packet (D,Y,N,S,R,E,F,Z,T,I, or any uppercase letter) ; AC2 - Packet sequence number (binary) ; AC3 - Number (binary) of characters in data field ; AC4 - 7 or 8-bit byte pointer to data characters ; ; Returns: +1 on failure, with: ; AC1 - 0: SOUT failed or timeout on handshake (can retry). ; 1: invalid argument (no point retrying). ; (These values are suitable indexes for a jump table) ; +2 on success, with ACs 1-4 unchanged. spack: entry spack ;[194] Hit by k20par and k20srv saveac ; Preserve us! ; Set things up. dmovem t1, actmp ; Save what we were called with in a way that dmovem t3, actmp+2 ; that they only are restored if we want to. movem t1, type ; Save the type. call diamsg ; Print diagnostic if desired. skipg t1, spadn ;[223] Sending padding? ifskp. ;[223] We are. Do we need to recalculate? block. ;[223] Enter block context for better control flow came t1, spdcnt ;[223] Same as last count? retskp ;[223] No, have to recalculate move t2, parity ;[223] Load current parity setting came t2, spdpar ;[223] Unchanged? retskp ;[223] No, have to recalculate remark ;[223] Otherwise return +1, nothing to do endbk. ;[223] End block anskp. ;[223] If +1, nothing to recalculate remark t1, ;[223] Still loaded move t2, spadch ;[223] Load the padding character move t3, parity ;[223] Load the parity movei t4, spdbuf ;[223] Load address of padding buffer call padbuf ;[223] Build the buffer with parity and IAC doubling movem t1, spadn ;[247] Update padding count move t2, parity ;[223] Load current parity dmovem t1, spdcnt ;[223] Update last ones done endif. ;[223] setz q2, ; Zero the checksum AC. move q1, [point 8, sndpkt] ; Get a byte pointer to the send packet. ; Start of packet. move t1, ssthdr ;[18] Get the start of header char. ;;[223] call @parity ; Call the appropriate parity routine. idpb t1, q1 ; Put in the packet. ; Packet length. ; ;[98] This section changed to allow for different block check types. movem t3, datlen ; Remember data length for later. skipe bctone ; Forcing single-character checksum? aosa t3 ; Yes, then always use type 1. add t3, bctu ; Otherwise add the block check length. addi t3, 2 ;[179] Account for SEQ and TYPE. movem t3, pktlen ;[179] Remember value of packet length field. ;[179] cail t3, 5 ; Does the packet have the minimum length? camle t3, spsiz ; And is it below the maximum? kermsg (,spxx2) ; No, fatal. addm t3, stot ;[22] It's OK, account for the whole packet. setzm islong ;[179] Assume regular (short) packet caile t3, ^d94 ;[179] Long packet? setom islong ;[179] Set flag. addi t3, " " ;[179] Convert to ASCII. skipe islong ;[179] Long? movei t3, " " ;[179] Put a blank here add q2, t3 ; Add the LEN field to the checksum. move t1, t3 ;;[223] call @parity ; Call the appropriate parity routine. idpb t1, q1 ; Put the LEN field into the packet. ;... ; SPACK, cont'd ; Packet sequence number. skipl t1, t2 ; Is the sequence number valid? (0-64)? cail t2, ^o100 ermsg% ,spxx2 ; No, fatal. movem t1, sseqn ;[221] Store sending sequence number addi t1, .chspc ;[194] ; Add a space so the number is printable. add q2, t1 ; Add the number to the checksum. ;;[223] call @parity ; Call the appropriate parity routine. idpb t1, q1 ; Put the sequence number into the packet. ; Packet type. move t1, type ; Get the type. cail t1, "A" ; Check if the type is a capital letter. caile t1, "Z" ermsg% , spxx2 ;[60] Not, fatal. add q2, t1 ; Add in the message type to the checksum. ;;[223] call @parity ; Call the appropriate parity routine. idpb t1, q1 ; Put the type into the packet. movem q1, sdatpt ;[221] Store sending data pointer skipg t3, datlen ; Is there any data? jrst spack3 ; No, finish up. ;[179] Extended header for long packet. skipn islong ;[179] Long packet? jrst spack2 ;[179] No move t1, pktlen ;[179] Yes, length subi t1, 2 ;[179] This time we only count data + checksum idivi t1, ^d95 ;[179] Big part of length (quotient) addi t1, " " ;[179] Convert to ASCII add q2, t1 ;[179] Add to checksum ;;[223] call @parity ;[179] Tack on parity idpb t1, q1 ;[179] Deposit in packet addi t2, " " ;[179] Same deal for small part (remainder) add q2, t2 ;[179] Add to checksum move t1, t2 ;[179] Move remainder to t1 for parity routine ;;[223] call @parity ;[179] idpb t1, q1 ;[179] push p, q2 ;[179] Save current packet checksum move t2, q2 ;[179] Form header checksum andi q2, ^o300 ;[179] ... lsh q2, -6 ;[179] add q2, t2 ;[179] ldb t1, [point 6, q2, 35] ;[179] addi t1, " " ;[179] pop p, q2 ;[179] Restore packet checksum add q2, t1 ;[179] Include header checksum in it ;;[223] call @parity ;[179] Add parity to header checksum idpb t1, q1 ;[179] Put it in the packet move t3, datlen ;[179] Set t3 as spack2 expects to find it. ; Loop to put each data character in the packet. spack2: ildb t1, t4 ; Get the next character. add q2, t1 ; Add it to the checksum. ;;[223] call @parity ; Call the appropriate parity routine. idpb t1, q1 ; Put the character into the packet. sojg t3, spack2 ; Loop for all characters. ;... ; SPACK, cont'd. ;[98] SPACK3-SPAK3X rewritten as part of edit 98. ; Done with the data, now append the appropriate kind of block check. spack3: skipe bctone ; Doing send-init exchange? jrst spak3a ; Then always use type 1. move t1, bctu ; Get block check type, jrst @[exp spxx2, spak3a, spak3b, spak3c](t1) ; and do it. ; Single-character 6-bit checksum. spak3a: move t3, q2 ; Make an extra copy of the checksum. andi q2, ^o300 ; AND out all but 2 bits. lsh q2, -6 ; Shift them to the far right. add q2, t3 ; Add in the original value. ldb t1, [point 6, q2, 35] ; Take modulo 64. addi t1, " " ; Add a space so the result is printable. ;;[223] call @parity ; Call the appropriate parity routine. idpb t1, q1 ; Put the checksum into the packet. jrst spak3x ; Done with checksum. ; 2-Character 12-bit checksum. spak3b: ldb t1, [point 6, q2, 29] ; Get bits 24-29 (high order 6 bits). addi t1, " " ; CHAR of that. ;;[223] call @parity ; Do any parity. idpb t1, q1 ; Deposit this as first character of checksum. ldb t1, [point 6, q2, 35] ; Get bits 30-35 (low order 6 bits). addi t1, " " ; CHAR of that. ;;[223] call @parity ; Do any parity. idpb t1, q1 ; Deposit this as second checksum character. jrst spak3x ; Done with checksum. ; 3-character 16-bit CRC CCITT. spak3c: move t1, datlen ; Length of the data field. addi t1, 3 ; Plus LEN, SEQ, and TYPE fields. skipe islong ;[179] Long packet? addi t1, 3 ;[179] Add length of header. move t2, [point 8, sndpkt, 7] ; Point to packet starting at LEN field. call crcclc ; Go compute the CRC. move q2, t1 ; Here it is. ldb t1, [point 4, q2, 23] ; Get bits 20-23 (high order 4 bits). movem t1, blkchk ;[221] Store sending chksum addi t1, " " ; CHAR of that. ;;[223] call @parity ; Do any parity. idpb t1, q1 ; Deposit this as first CRC character. jrst spak3b ; Go back and do other two CRC characters. ;... ; SPACK, cont'd ; Supply requested End-of-Line. spak3x: move t1, seolch ; Get the requested EOL char. ;;[223] call @parity ; Call the appropriate parity routine. idpb t1, q1 ; Add it to the packet. setz t1, ;[243] ; Get a null. idpb t1, q1 ;[243] ; Put it at the end. ;[36] Do any requested interpacket pausing. spack5: skiple t1, pause ;[196] Pausing? DISMS ; Sleep for that long. ; To do: Could bum the SOUT% if we appended every packet to the end ; of the padding buffer and sent the whole kit and ka boodle in a ; single JSYS. Unknown how much communications actually want ; padding, so put this aside for the moment spak5a: ifmn. spadn ;[34] Sending pad characters? skipg t1, netjfn ;[186] Where to send the padding. move t1, ttyjfn ;[186] Unless using local terminal move t2, [point 8, spdbuf] ;[223] Load pointer to padding buffer movn t3, spdcnt ;[223] How many padding characters to spew SOUT% ;[223] Counted SOUT%'s are more efficient %ermsg (,spack6) ;[186] Warn about errors. endif. ;[223] End case sending padding ;... ; SPACK, cont'd ;[131] If ARPANET TVT then must double any hex FF's (TELNET IAC). ; Note, since IAC is DEL with parity bit on, we should never see one, right? ;[247] Telnet uses a special 8-bit character to indicate that the next byte ; should be interpreted as a command. This character is known as the ; IAC character and is octal 377, hex FF and decimal 256. When Kermit-20 ; is sending binary data, it is possible that a legitimate 377 can be seen ; in the data stream. Further, a delete or rubout character (octal 177) ; sent with even parity will also occur. This latter case is unlikely ; as TVT transport does not support parity. In either case, the IAC must ; quoted (meaning doubled) in order to be transmitted properly. Obviously, ; This cannot happen with a DECnet NRT as out-of-band signalling is done ; differently. spack6: remark Move this to AFTER parity determination move t2, [point 8, sndpkt] ; The address of the packet. ;[131] End. Now, finally send the packet. spak6x: movem t2, spakpt ;[221] Save pointer to whatever we're sending move t1, t2 ;[223] Load the beginning pointer move t2, q1 ;[223] Load the ending pointer call subbp ;[223] Calculate total bytes jrst spxx1 ;[223] If this fails, we've messed up somewhere sosg t3 ;[243] Don't count spak3x's terminating .CHNUL! jrst spxx1 ;[243] We are deeply ill if went negative movn t3, t3 ;[223] Counted SOUT%/SOUTR% is more efficient move t2, spakpt ;[223] Save pointer to whatever we're sending call putpar ;[223] Generate parity for the packet ifmn. tvtflg ;[247] TVT-Binary mode? movn t1, t3 ;[247] Wants positive length remark t2, ;[247] Already has source pointer move t3, [point 8, tvtbuf] ; Copy data field to this place. call iaciac ;[247] Double IAC's in a vastly more efficient way jrst spxx1 ;[247] If this fails, we've messed up somewhere move t2, [point 8, tvtbuf] ; Point to result. movn t3, t4 ;[247] Use new length endif. ;[247] End case IAC checking and doubling skipg t1, netjfn ;[186] JFN for sending the packet. move t1, ttyjfn ;[186] Unless using local terminal ifme. vtermf ;[186] Virtual Terminal? SOUT% ; Send the string. erjmp spxx1 ; JSYS error, go handle. else. ;[186] Otherwise, must push it SOUTR% ;[186] Send the string. erjmp spxx1 ;[186] JSYS error, go handle. endif. ;[186] End case virtual terminal spak6y: aos sptot ;[4] Count the packet we sent. skipn debug ;[128] Debugging? jrst spackb ; No, how about blips? caie debug, 2 ;[128] Yes, packets? jrst spackz ; No, states, that's taken care of elsewhere. ; Debugging -- Log the packet. skipn t1, logjfn ; Yes, but make sure we have a destination. jrst spackz ; We don't, skip this. ifmn. pdcodf ;[221] Decoding? block. ;[221] Get a stack frame saveac ;[221] And save the temporaries hrli t1, "S" ;[221] Yes, flag this is a send call pdecod ;[221] So break out the fields endbk. ;[221] Tear down the stack frame jrst spackz ;[221] Rejoin mainline endif. ;[221] End decoding special case ;[221] Otherwise, timestamp and dump dxtext (t2,< S,>) ; We do, give a crlf and "S," first. SOUT% ; Counted SOUT from extended section erjmp spkder seto t2, ; Include time stamp, current date/time. movx t3, ot%nda ; But no date. ODTIM erjmp spkder movei t2, "," ; Comma, BOUT erjmp spkder setzb t3, t4 move t2, [point 8, sndpkt] ; Now the packet itself. SOUT erjmp spkder dmove t2, [ -1,,[byte (7) .chcrt, .chlfd ] ;[221] -^d2 ] ;[221] Counted strings are faster SOUT erjmp spkder jrst spackz ;... ;...SPACK, cont'd ;[174] Recover from errors writing to debugging log. spkder: call deberr jrst spackz ;[4] Put blips on user's screen if local. spackb: skipl filjfn ;[106] No blips if output is to TTY. skipn local ; Not debugging, but still local? jrst spackz ; Remote, don't make blips. move t3, type ; Local, am I sending a NAK packet? movei t1, "%" ; Print a "%" for each one I send. move t2, numtry ; Or each resend I have to do. caig t2, 1 ; cain t3, "N" ; jrst spackx ; setz t3, ; Not a NAK, is it time to blip? move t4, sptot ; Check the absolute packet number. divi t3, blip ; We do it every "blip" packets. jumpn t4, spackz ; Not time for a blip. movei t1, "." ; It's time, here's the blip. spackx: PBOUT% ; "." ; Common exit point for successful exit. spackz: dmove t1, actmp ;[60] Restore what we were called with dmove t3, actmp+2 ;[60] retskp ; Exit point for nonfatal errors. spxx1: ifmn. mdmlin ;[194] Modem line? skipg t1, netjfn ;[186] See if we just dropped carrier. move t1, ttyjfn ;[186] Using local terminal not network call chklin ;[186] skipn carier ; Still have it? jrst spxx2 ; No, then fatal. endif. ;[194] Otherwise, can continue trying. setz t1, ;[60] Indicate nonfatal. ret ; Exit for fatal errors. spxx2: movei t1, 1 ;[60] Indicate fatal. ret ; RPACK -- Receive-Packet ; ; This routine waits for a packet to arrive. It reads characters until it ; finds the start-of-packet character, normally SOH. It then reads the packet ; into RECPKT based on the length supplied in the length field (no termination ; character necessary). ; ; Returns: ; +1 failure (if the checksum is wrong or the packet trashed) ; +2 success with: ; t1/ Packet type ; t2/ Packet number ; t3/ Length of data field ; t4/ 8-bit byte pointer to data field rpack: entry rpack ;[220] Used by k20srv saveac ; Save these ACs. setzm islong ;[179] Assume packet is not long. cain debug, 2 ; Logging packets? skipn t1, logjfn ; Yes, make sure there's a log. jrst rpackb skipe pdcodf ;[221] Decoding packets? jrst rpackb ;[221] Yes, so skip the raw data smsg (< R,>) ; "R" for Receive seto t2, ; Time stamp, current date/time. movx t3, ot%nda ; But no date. ODTIM erjmpr rpacke ;[194] movei t2, "/" ; Current timeout interval. BOUT erjmpr rpacke ;[194] remark ;[221] Has to call timeit to set curtim movei t1, tmout ; Place to go on timeout. call timeit ; Set the timer move t1, logjfn move t2, curtim ; Log current time interval movei t3, ^d10 NOUT erjmpr rpacke ;[194] jrst rpacka ;[194] Otherwise proceed rpacke: call deberr ;[174] remark rpacka ;[194] Falls through rpacka: movei t2, "," BOUT ifje. r ;[194] call deberr ;[174] jrst rpackb endif. ;[194] skipg t1, netjfn ;[186] JFN of the communication line. move t1, ttyjfn ;[186] Not doing network, use local jrst rpack0 ; Already set timer... ; Here if not logging packets. rpackb: movei t1, tmout ; Place to go on timeout. call timeit ; Time out if it takes too long. skipg t1, netjfn ;[186] JFN of the communication line. move t1, ttyjfn ;[186] Not doing network, use local ;... ;...RPACK, cont'd ; Eat interpacket garbage, read up to start-of-packet character. rpack0: call inchar ; Get a character from the line. jrst rperr ; If we can't, go fail. came t2, rsthdr ;[18] Is the char the start of header char? jrst rpack0 ; No, go until it is (or we are timed out). ; Now read the packet. rpack1: move q1, [point 8, recpkt] ; OK, now point to the packet buffer. idpb t2, q1 ; Put the start character into the packet. ; Packet length field = number of characters to follow the length field, ; up to and including the last block check character. call inchar ; Get next character from the line. jrst rperr camn t2, rsthdr ;[18] Is the char the start of header char? jrst rpack1 ; Yes, then go start over. idpb t2, q1 ; Copy character to packet buffer. move q2, t2 ; Start the checksum. move q3, t2 ; Save the length here for later. ; Packet sequence number. call inchar ; Get the next character jrst rperr camn t2, rsthdr ;[18] Start of header? jrst rpack1 ; Yes, go start over. idpb t2, q1 ; No, put it in the packet. add q2, t2 ; Add it to the checksum. subi t2, " " ; Get the real packet number. movem t2, num ; Save it for later. ; Packet type. call inchar ; Next character. jrst rperr camn t2, rsthdr ;[18] SOH? jrst rpack1 ; Yes, go back. idpb t2, q1 ; Not SOH, keep it. add q2, t2 ; Add it to the checksum. movem t2, type ; It's the message type, remember it. ;... ;...RPACK, cont'd ;[123] Beginning of change ; ; Now determine block check type for this packet. Here we violate the layered ; nature of the protocol by inspecting the packet type in order to detect when ; the two sides get out of sync. Two heuristics allow us to resync here: ; ; a. An S packet always has a type 1 checksum. ; b. A NAK never contains data, so its block check type is LEN-2. subi q3, " " ;[179] Convert ASCII length to number. skipn q3 ;[179] Is it zero? setom islong ;[179] Yes - long packet. skipn islong ;[179] Long? subi q3, 2 ;[179] No, subtract 2 for SEQ & TYPE fields. move t1, bctu ; Expected block check type. skipn bctone ; But if type 1 is required, cain t2, "S" ; or if this is an S packet, movei t1, 1 ; then force the type to 1. cain t2, "N" ; But, is this a NAK? move t1, q3 ; Yes, so this must be the block check type. movem t1, pktbct ; Save the block check type we have determined. skipn islong ;[179] Long packet? jrst rpackc ;[179] No, go get data. skipg t1, netjfn ;[186] Set up for inchar. move t1, ttyjfn ;[186] Not network, use terminal call inchar ;[179] Get next character. jrst rperr ;[179] idpb t2, q1 ;[179] Save it. add q2, t2 ;[179] Add to checksum. subi t2, " " ;[179] Convert to number. move q3, t2 ;[179] Set to make... imuli q3, ^d95 ;[179] big part of length. call inchar ;[179] Get next character. jrst rperr ;[179] idpb t2, q1 ;[179] Save it. add q2, t2 ;[179] Add to checksum. subi t2, " " ;[179] Convert to number. add q3, t2 ;[179] Add to big part of length. call inchar ;[179] Get next character (header checksum) jrst rperr ;[179] idpb t2, q1 ;[179] Save it. add q2, t2 ;[179] Add to checksum. ; [179] HERE WE SHOULD CHECK THE HEADER CHECKSUM... ; [179] But no big deal since overall checksum will catch any errors later. ; Now subtract the block check length from the packet length, which gives the ; length of the data field. rpackc: sub q3, pktbct ; Calculate the data length. movem q3, datlen ; Save it. ; Take in the data field. skipg t1, netjfn ;[186] Get the packet input jfn back again. move t1, ttyjfn ;[186] Using local terminal ;[123] End of change. movem q1, datptr ; Return pointer to the data buffer. skipg q3, datlen ; Use character count for loop control. jrst rpbc ;[99] If none, go get the block check. ; Loop to get the specified number of data characters. rpack2: hrrz t2, q1 ;[117] Check for buffer overflow. cail t2, recpkz ;[117] If we're past the end, go back and jrst rpack0 ;[117] eat characters until a ^A. call inchar ; Get a character from the line. jrst rperr ; Oops, can't. camn t2, rsthdr ; Is the char the start of header char? jrst rpack1 ; Yes, then go start over. idpb t2, q1 ; Put the char into the packet. add q2, t2 ; Add it to the checksum. sojg q3, rpack2 ; Get next character, if any. ;... ;...RPACK, cont'd ; Count exhausted, next characters will be the block check. ; ;[98] This section, thru RPACK4, mostly rewritten as part of edit 98. rpbc: movem q1, bctemp ; Save pointer to block check. move q3, pktbct ;[123] Length of block check for this packet. ;[123] skipl datlen ;[99] If data len negative, must be type 1 NAK! ;[123] skipe bctone ; or if this flag is set, ;[123] movei q3, 1 ; must look for single-character checksum. ; Get the checksum bytes and add them up. setz t3, ; Accumulator for checksum. rpack3: call inchar ; Get a character. jrst rperr camn t2, rsthdr ;[18] Is the char the start of header char? jrst rpack1 ; Yes, then go start over. idpb t2, q1 ; Got one, deposit it. lsh t3, 6 ; Accumulate numeric value addi t3, -40(t2) ; ... sojg q3, rpack3 ; Go back and get the rest. setz t1, ; Make the string ASCIZ. idpb t1, q1 ;[135] If doing handshake, look for that now. ;[135] (This code moved from beginning of SPACK) rpakh1: skipn handsh ; Doing handshake? jrst rpakcc ; Nope. rpakh2: skipg t1, netjfn ;[186] Try to get a character move t1, ttyjfn ;[186] Not network, use local call inchar ; from the line. jrst rpakhx ; If there was an error, try to proceed andi t2, 177 ; Strip the high bit. came t2, handsh ; Is it the handshake character? jrst rpakh2 ; No, keep going till it is. rpakhx: ;... ;[135](end of change) ;...RPACK, cont'd ; Check the checksum. rpakcc: skipl datlen ;[99] If negative data length, or skipe bctone ; explicitly requested to, jrst rpak3a ; then compute 1 character checksum. move t1, bctu ; Otherwise get the type which we're using. jrst @[exp rperr, rpak3a, rpak3b, rpak3c](t1) ; Here for single-character 6-bit checksum. rpak3a: move q3, q2 ; Make a copy of the arithmetic checksum. andi q2, ^o300 ; And out all but 2 bits. lsh q2, -6 ; Shift them to the far right. add q2, q3 ; Add in the original value. andi q2, 77 ; Get the modulo 64 of the char total. jrst rpak3x ; Go check it. ; Two-character 12-bit checksum. rpak3b: andi q2, 7777 ;[100] Mask out all but 12 bits. jrst rpak3x ; Go compare. ; 3-character 16-bit CRC CCITT. rpak3c: move t1, datlen ; Get the data length. addi t1, 3 ; Account for LEN, SEQ, and TYPE fields. skipe islong ;[179] Long packet? addi t1, 3 ;[179] Also account for extended header. move t2, [point 8, recpkt, 7] ; Point to packet starting at LEN field. call crcclc ; Compute CRC. ldb q2, [point 16, t1, 35] ;[100] Get exactly 16 bits worth. ;... ;...RPACK, cont'd ; Compare the two block checks. rpak3x: caie t3, (q2) ; Are they equal? jrst badbc ; No, bad block check. movem t3, blkchk ;[221] Save that ; All OK, turn off timer, flush buffer. rpack4: call timoff ; Got packet OK, turn off the timer. call clrbuf ;[194] ;[17] Clear out any further junk from input nop ;[186] ;[194] ;[17] buffer, there should be nothing there remark ;[194] ;[17] till after we reply. ; Set up ACs 1-4 with results and return successfully. rpackx: aos rptot ; Count the packet we received. move q1, bctemp ; Pointer to first character of block check. setz t1, ; Terminate the data string, nullifying idpb t1, q1 ; the block check. move t1, type ; Return the packet type in T1, move t2, num ; the sequence number in T2, call diamsg ; Log the packet type & number if desired. skipge t3, datlen ; the number of data characters in T3, setz t3, ;*** move t4, datptr ; and a pointer to the data in t4. ifmn. pdcodf ;[221] Decoding? block. ;[221] Get a stack frame saveac ;[221] And save the temporaries hrli t1, "R" ;[221] Yes, flag this is a recieve call pdecod ;[221] So break out the fields endbk. ;[221] End Block Context remark ;[221] Falls through to retskp endif. ;[221] End decoding special case retskp ; Return +2. ; Come here if block checks don't compare. badbc: skipn t1, logjfn ;[38] No, do we have a debugging log? ifskp. ;[194] We do, blat dxtext (t2,< %chksum >) ;[29] SOUT% ;[29] Counted SOUT% is faster ifje. r ;[194] Catch and ignore error call deberr ;[174] endif. ;[194] endif. ;[194] Otherwise, skip messages. ; Exit thru here upon any kind of error except a timeout. rperr: call timoff ; Cancel the time out. call clrbuf ;[194] ;[17] Flush any stacked up packets from the nop ;[186] ;[17] input buffer. If anything's there, we remark ;[17] don't want it! ret ; Return unsuccessfully. subttl Support Routines for RPACK. ; INCHAR - Get a character from the communication line. ; ; Call with: ; t1/ JFN of comm line. ; ; Returns: ; +1 on failure, with state set to "A" if carrier dropped. ; +2 on success with: ; t1/ unchanged ; t2/ character, with parity bit stripped if parity is being used. ; inchar: saveac ;[186] Save the JFN and others (not t2!!) ;[180] Begin buffering communications input change. inch1: skipg tticnt ;[186] Something in our own input buffer? ifskp. ;[186] Yes, return next byte sos tticnt ; Yes, decrement count ildb t2, ttiptr ; Load next byte. aos ttildb ; (stats) jrst inch3 ;[186] Go handle the byte. else. ;[186] Otherwise, time to do some I/O setzm tticnt ;[186] Reset the buffer count move t2, [point 8, ttibuf] ; Where to put them movem t2, ttiptr ; Reset buffer pointer remark ... ;[186] Falls through to the BIN% endif. ;[186] End case buffer fetch (if possible) setz t2, ; (in case of error) BIN% ; Get a character from the line. erjmpr inchxx ;[130] Error, go see what. aos ttibin ;[180] (stats) move t5,t2 ;[186] Save the character away move q2,t1 ;[186] Save the JFN call clrest ;[211] Get best estimate, outstanding data erjmpr inchxx ;[211] Bad. Give up skipge t4, t1 ;[211] Load and check jrst inchxx ;[211] What? A bogon? Depart... ife. t4 ;[211] Nothing more? move t3, parity ;[223] Load the parity setting (if set) caie t3, none ;[223] Not doing parity? ifskp. ;[223] Nope, so don't touch the character move t2,t5 ;[223] Load character as if BIN%'ed jrst inch3 ;[223] and hand it off to downstream endif. ;[223] End case no parity move t1,t5 ;[223] Otherwise, let's check this single character andi t1, 200 ;[223] WITHOUT THE PARITY!! call @parity ;[223] Calculate parity on supposed original caie t1, t5 ;[223] These are the same, right? ifskp. ;[223] Yep, it's a healthy character andi t1, 200 ;[223] Stomp the parity back off move t2,t5 ;[223] Load character as if BIN%'ed jrst inch3 ;[223] And go do something useful with it endif. ;[223] End case good parity on a single character aos ttipar ;[223] Sigh, bad parity detected jrst inchxx ;[223] hit the error handler else. ;[186] Otherwise, there is more data!! move t2,ttiptr ;[186] Load the buffer pointer idpb t5,t2 ;[186] Deposit the character aos tticnt ;[186] Update buffer counter with BIN% sos ttildb ;[186] Don't double count the ildb cail t4, IOBUF ;[186] More than buffer can do (plus BIN%)? movei t4, ;[186] Clip down to maximum minus BIN% addm t4, tticnt ;[186] Update buffer character tally movn t3,t4 ;[186] Set up for an exact read move t1,q2 ;[186] Restore the JFN SIN% ; Try to read erjmp inchxx ; Error... aos ttisin ; Number of SINs for stats addm t3, tticnt ;[186] How many we got (t3 may be negative) add t3,t4 ;[186] Update total (in case premature end) camle t3, ttimax ; Maximum size of a SIN for stats movem t3, ttimax ;[186] New maximum read!! move t2, ttiptr ;[223] Load starting pointer movn t3, t3 ;[223] Parity checker wants a negative count call chkpar ;[223] Check the parity ifskp. ;[223] Was it OK? jrst inch1 ;[223] Yes hit regular buffer processing endif. ;[223] Otherwise ... aos ttipar ;[223] Sigh, bad parity detected ifmn. local ;[223] Maybe blat (if local) ermsg% (,inchxx) endif. ;[223] jrst inchxx ;[223] hit the error handler endif. ;[186] End case non-zero SIBE% ;[180] End buffering change. inch3: caie debug, 2 ;[186] ; Logging packets? ifskp. ;[194] We are skipe pdcodf ;[221] Decoding packets? anskp. ;[221] Yes, so skip the raw data skipg t1, logjfn ;[194] Make sure there's a log. anskp. ;[194] There wasn't BOUT ; Record the character. erjmpr deberr ;[174] endif. ;[194] aos rtot ; Increment total character count. retskp ; Done, return successfully. ;[130] Error handler to check for carrier dropped. inchxx: skipn mdmlin ; Modem controlled line? ret ; No, just return +1 to indicate error. skipg t1, netjfn ;[186] Yes, see if we still have carrier move t1, ttyjfn ;[186] Unless using local terminal call chklin ;[186] ... skipe carier ; Do we? ret ; Yes, so some other error, handle normally. wtlog (,) ; No, lost it. Log. movei state, "A" ; Cancel this transaction. setzm carier ; Say no more carrier. ret ; Come here on timeout, via interrupt handler. tmout: call rperr ;[46] Clean up timers & buffer... call ttxon ;[91] Unstop the line in case it was XOFF'd. movei t1, "T" ; Make believe we got a "Timeout" packet move t2, pktnum setzb t3, t4 ; No data. call diamsg retskp ; Return successfully as if with real packet. subttl Various routines moved to a plethora of modules ; To do: reorganize all these by module and move to the beginning of k20mit extern chklin ;[194] Check (virtual) line status extern chktvt ;[194] See if line is a Telnet Virtual Terminal extern getnti ;[194] Get (Network) Terminal Information extern crcclc ;[194] Calculate CRC-CCITT polynomial extern echo ;[194] Echo a character defpar==none ; Default parity. extern none ;[194] No parity (I.E., do nothing) extern mark ;[194] Set parity bit to 1, always extern space ;[194] Set parity bit to 0, always extern even ;[194] Even parity extern odd ;[194] Odd parity extern todsec ; Convert Time of Day Ticks to Seconds extern elapst ; subtract two (unsigned) times of day extern isnulj ; Is this a JFN on NUL:? (and replace with .nulio) extern inicap ; Initialize capability vector extern initim ;[223] Get base of time (in K20TIM) extern inicty ;[223] Discover system console line number extern savtty ; Save terminal characteristics extern restty ; Restore terminal charactertics extern ttyini ; Set up local terminal as remote for transfer extern fixtty ; Used to fix a terminal's characteristics after transfer extern gtnfil ; Step to next file in a wildcarded specification extern ldav ; Get current system load extern gtclas ; Get our class (if we have any) extern adjtim ; Adjust time based on load average extern setcsb ; Set command state block extern $stat ; Types last transfer statistics extern $srvt ; Same thing, but do it as a REMOTE extern ifcrlf ; Maybe type a carriage return extern putc ; Type a control character with a "^" extern giveup ;[213] Handle an error during file processing or transfer extern rdclos ;[213] Close a file extern unmapo ;[213] Unmap a file output page extern %%jser ; Error macro handling extern %wtlog ; Write a log file entry extern %%krms ;[234] Signal an error via protocol extern %kerms ;[234] Ditto, without last JSYS error extern pdcodf ;[221] If logging packets, decode them extern pdecod ;[221] The packet decode routine (in k20pdc extern diamsg ;[221] Moved to k20pdc extern deberr ;[221] Error writing to the debug log extern dmpbuf ;[215] Moved to k20sub and enhanced extern %%smsg ;[216] smsg macro support extern k20hdr ;[194] Moved to k20sub extern movstu ;[245] Moved to k20sub and enhanced extern iaciac ;[247] Created in k20sub from spak6a remark ;[220] Moved to k20par extern inifil ;[220] Set up and take login KERMIT.INI extern popjfn ;[220] Unwind a level of TAKE remark ;[220] Moved to k20srv extern dirch ;[220] Like getch, but gets chars from a dir listing extern getcom ;[220] Server main loop extern gtsch ;[220] Alternative to gtsch to get a string extern putsch ;[220] Alternative to putch to write to a string extern puttch ;[220] Like putch, but puts the character on TTY extern sinfo ;[221] Like S, but sends an I extern udjinf ; Update Job Information Table (partially; in k20srv) remark ;[207] These are in a completely new module, k20tim extern statim ;[207] Start timing transfer extern endtim ;[207] End timing transfer extern elptim ;[207] Compute elapsed time subttl Interrupt routines for TIMER% and characters moved to K20SUB extern timeit ; Set a timer extern timoff ; Turn a timer off extern tmtrap ; TIMER interrupt handler extern pinit ; Initialize the Priority Interrupt system extern ccon ; Enable for Control-C trapping extern ccoff ; Turn Control-C trap off extern ccoff2 ; Force Control-C off, even if server extern caxzon ; Turn on ^A, ^X, and ^Z interrupts extern cmpon ; Turn ^M, ^P interrupts on extern caxzof ; Turn off ^A,^X,^Z interrupts extern cmpoff ; Turn ^M, ^P interrupts off extern frkchb ; Fork interrupt channel bit subttl subbp - Subtract two arbitrary byte pointers ; Subroutine to subtract two byte pointers in current section. ; The two byte pointers must point to bytes of the same size. ; ; Call with: ; t1/ First byte pointer. ; t2/ Second byte pointer. ; CALL SUBBP ; ; Returns: ; +1 if the byte sizes are different, with t1-t3 unchanged, or else ; +2 with: ; t1,t2/ Unchanged. ; t3/ The number of bytes of the specified bytesize in the string pointed ; to by the first byte pointer (in t1) up to, but not including, the ; byte pointed to by the second byte pointer (in t2). subbp: entry subbp ;[220] saveac ; Save permanent regs for work below. ldb q1, [point 6, t1, 11] ; q1 := bytesize 1. ldb q2, [point 6, t2, 11] ; q2 := bytesize 2. came q1, q2 ; Are they equal? ret ; No, failure ; Byte sizes are equal, can do arithmetic. movei q2, @t1 ; Do address calculation for t1 movei q4, @t2 ; and t2. sub q4, q2 ; q4 := (A1 - A2) = N words. movei q2, ^d36 ; q2 := bits/word. idiv q2, q1 ; q2 := bytes/word. imul q4, q2 ; q4 := bytes in N words. move q2, q4 ; (to leave q3-q4 free for IDIV) ldb q3, [point 6, t2, 5] ; q3 := Q2 ldb t3, [point 6, t1, 5] ; t3 := Q1 sub t3, q3 ; t3 := (Q1 - Q2) idiv t3, q1 ; t3 := (Q1 - Q2) / S add t3, q2 ; Adjust previous count. retskp ; And return, with success. lits: xlist ;[187] Don't need to see them... lit ; Assemble literals here. list ;[187] .endps code ;[190] Close off code .psect ; Some other miscellaneous pure data .psect const/ronly,conorg ;Which go into the constants section crlf:: byte (7) .chcrt, .chlfd, .chnul, .chnul, .chnul ; A carriage-return-linefeed. crlflf:: byte (7) .chcrt, .chlfd, .chcrt, .chlfd, .chnul ; As above, but double line feed .endps const Subttl impure data storage .psect data,datorg ;[190] Allows stores CMDSTG ; Allocate COMND JSYS storage ; The following items are from K20MAC and by rights should be in ; there, but... CMDSTG only defines CMDBLN here and thus it can ; only be used for a block definition here or you get "E" errors. remark Do NOT reorder the next four items!!!! intern namlen, namatm, explen, expatm namlen: block 1 ;[203] ; Length of string we put in macro name (atom) buffer namatm: block atmbln ;[203] ; Long enough for a copy of the atom buffer explen: block 1 ;[203] ; Length of macro expansion expatm: block atmbln ;[203] ; Long enough for all the set keywords put together remfil:: block cmdbln ;[208] Remote file specification pdl: block pdlsiz ; and stack. intpc:: 0 ;[194] ; PC to restore on timer interrupt. intstk:: 0 ;[194] ; Stack pointer to restore on timer interrupt. ccfail:: -1 ;[187] ; Set if we ever failed to turn it on caseen:: 0 ;[186] ; Flag for ^A trap. cmseen:: 0 ;[186] ;[165] Flag for ^M interrupt seen. cmloc:: 0 ;[186] ;[165] Where to go on ^M interrupt. cpseen:: 0 ;[186] ;[165] Flag for ^P interrupt seen. cploc:: 0 ;[186] ;[165] Where to go on ^P interrupt. cxseen:: 0 ;[186] ;[59] Flag for ^X interrupt seen. czseen:: 0 ;[104] ;[59] Flag for ^Z interrupt seen. capas:: 0 ;[194] ; Process capabilities. bigboy:: 0 ;[194] ;[186] If we are dangerous ;[194] Do *NOT* reorder ANY parse item as some are DMOVE'd!!! pars1:: 0 ;[194] Data from first parse. pars2:: 0 ;[194] Data from second parse. pars3:: 0 ;[194] Data from third parse. pars4:: 0 ;[194] Data from fourth parse. pars5:: 0 ;[194] [41] ... pars6:: 0 ;[218] May have a connection timer pars7:: 0 ;[229] May also need to send EOF pars8:: 0 ;[229] If $INPUT should type the text stream pars9:: 0 ;[247] If we should force IAC srvflg:: 0 ;[186] ; Are we serving? Erase if we go for command. iflg:: 0 ;[220] ;[100] -1 if sending INFO packet, else 0. lcflg:: 0 ;[194] ;[56] LOCAL command (-1 = LOCAL, 0 = REMOTE). source:: 0 ;[186] ;[102] Source routine for GETCH. dest:: 0 ;[220] ;[107] Destination routine for PUTCH. ffunc:: 0 ;[194] ;[118] File function (dir, del, ren, etc). parsx==:.-1 ;[203] ; For zeroing the above. dfstrt: PROMP ; Are we to be a SERVER or go to the PROMPT? ; (PROMP not PROMPT, which CMD package uses) f$exit:: 0 ; Exit flag for EXIT command or rescan entry. ttyjfn:: .priin ;[194] JFN for controlling terminal. logjfn:: 0 ;[194] ;[38] Debugging log file JFN. tlgjfn:: 0 ;[194] ;[126] Transaction log file JFN. sesjfn:: 0 ;[196] ;[128] Session log file JFN. sesflg:: 0 ;[196] ;[195] Whether the session log is active logbsz:: 0 ;[194] ;[41] Log file byte size. filjfn:: 0 ;[194] ; JFN of file being sent. ndxjfn:: 0 ;[194] ; Indexable JFN, for wildcard stepping. nxtjfn:: 0 ;[194] ;[111] JFN of next file to be sent. netjfn:: 0 ;[194] ; Line for packet transmission. netflg:: 0 ;[186] Returned GTJFN% flags if DCN: svstt:: block $tslen ;[194] Saved start up terminal $PRIOU:: block 1 ;[194] Whatever we think primary output is ttydim: 0 ;[185] Current controlling tty dimensions tiword:: 0 ;[194] ; Terminal interrupt word 0 ;[194] ; In case also have terminal differed mode word ttynum:: 0 ;[194] ; Number of the TTY being used. oldnum: 0 ;[7] Number of previous TTY in case of change. mytty:: 0 ;[194] ;[4] TTY number of job's controlling terminal. myjob:: 0 ;[194] ;[7] My job number. ;... ; Impure Data, cont'd pname: block .jitwo ;.jisnm ; Subsystem name, one sixbit word remark ;.jipnm ; Program name, one sixbit word ttfork:: 0 ;[196] Fork number of the connect receive fork. rufork:: 0 ; Fork number for LOCAL RUN program fork. rujfn: 0 ; JFN for LOCAL RUN program. execf: 0 ; Fork number of PUSH (to Exec) fork. errptr:: 0 ;[194] ; Pointer to most recent error string. atmptr: 0 ; Atom buffer pointer. xfnflg:: 0 ;[194] ;[84] Flag for file name conversion. xflg:: 0 ;[220] ;[104] Flag for sending with X header. ebtflg:: 0 ;[194] ; One if file is to be used in 8-bit mode. tbtflg:: 0 ;[232] ; One if forcing 36 bit byte size on files scrlft:: 0 ;[233] ; Set to -1 to suppress trailing CRLF in transaction log autbyt:: 1 ;[194] ; One if auto-byte is to be used. handsh:: 0 ;[194] ;[76] Handshake. flow:: 1 ;[194] ;[143] Flow-Control (nonzero = XON/XOFF) itsflg:: defits ;[194] ;[75] Flag for handling ITS-binary format files itsfil:: 0 ;[213] ;[75] Flag for this file is ITS format. itscnt: 0 ;[75] Counter for ITS header chars matched. mycaps:: block 2 ;[186] Current capability nodnum:: block 1 ;[186] Remote DECnet Node Number nodnam:: block syslen ;[186] Remote DECnet Node Name plus object vtermf:: 0 ;[186] Set if line is a virtual terminal tvtflg:: 0 ;[194] ;[129] Negotiate binary mode on ARPANET TVT. tvtchk:: 1 ;[194] ;[182] TVT discovery (MUST BE AFTER tvtflg!) asgflg:: 0 ;[7] -1 if I asg'd the TTY, 0 if already asg'd. asgdev:: 0 ;[186] Device I've assigned actmp: block 20 ;[59] A place for short-term saving of ACs. pktacs:: block 6 ;[220] ;[112] Place to save RPACK/SPACK ACs. parity:: defpar ;[194] ; Type of parity to use. gotx:: 0 ;[220] ; Flag for "already got an X-packet". gots:: 0 ;[220] ; Flag for "already got an S-packet". mapflg: 0 ; One if a page is mapped in. (Init to 0.) mdmlin:: 0 ;[196] ;[130] -1 = modem-controlled line, 0 = not. carier:: 0 ;[194] ;[130] Flag for carrier dropped (or connection good) monv:: 0 ;[194] ;[146] Monitor version (0 if less than 6.0). speed:: 0 ;[194] ;[130] Ostensible line speed -- input,,output. setspd:: 0 ;[194] ;[161] Flag speed was explicitly SET. defbrk==3 ;[16] default nulls to send on break brk:: defbrk ;[194] ;[16] nulls to send on BREAK key local:: 0 ;[194] ; -1 = local Kermit, 0 = remote. rcving:: 0 ;[186] ; -1=actually recving, +1=sending, 0=neither. $sendf: 0 ; SEND command in progress. $recvf: 0 ; RECEIVE command in progress. pagptr: 0 ; Pointer into the page. ;************** remark ;[194] ; File meta data pagcnt:: 0 ;** DO ;[194] ; Number of pages in the file, bytcnt:: 0 ; NOT ;[194] ; and byte count crdate:: 0 ; REORDER ** ;[194] ; and creation date (these 3 must be adjacent!) bytsiz:: 0 ; Byte size of file. ;************** abtfil:: 0 ;[194] ;[42] 0 = discard incomplete file, -1 = keep. expung:: 0 ;[194] ;[143] Automatically expunge when deleting. pagno:: 0 ;[213] ; Present page number. size: 0 ; Size of the present data. spsiz:: dspsiz ;[194] ; Maximum size packet to send. rpsiz:: drpsiz ;[194] ; Maximum size packet to receive. maxdat:: dspsiz-5 ;[220] ;[63] Max length for data field. ntimou:: 0 ;[194] ;[54] Timeout counter. curtim:: 0 ;[194] ;[131] Current load-adjusted timeout interval. timerx:: 0 ;[194] ;[132] Counter for timer errors. nnak:: 0 ;[194] ;[54] NAK counter. Remark Time-outs and delays ; Format is time is parsed as a floating second, to allow specification of ; fractional seconds. This is converted into the appropriate number of ; milliseconds, range checked and stored. ; ; The conversion happens a single time at parse confirmation. This is ; as opposed performing the calculation on every packet, which older ; versions of Kermit do. This can save a lot of processing time for ; long files!! ; ; Sub-second resolution is typically unnecessary and is only used to ; debug communications timing problems or to see how hard a given ; network connection can be driven. ; ; The format is the millisecond comes first, always. The floating is ; just used for display purposes as it is easier to read (however, the ; milliseconds are always displayed for checking purposes; see K20DSP. remark Double blocks (unnamed floating variables) srvtim:: dsrvtm ;[137] Server command wait timeout interval. dsrvtf ;[212] ; Same value as floating seconds stimou:: dstim ; Interval for my own timer. dstimf ;[212] ; Same as floating seconds otimou:: dstim ;[202] ;[26] Place to save old timout interval. dstimf ;[212] ; Same value as floating seconds rtimou:: drtim ; Minimum timeout interval I need. drtimf ;[212] ; Same value as floating seconds remark Both numeric formats named (DO NOT REORDER!!!!!!) rpause:: drpaus ;[212] ms ;[35] Pause before ACKing data packet. rpausf:: drpauf ;[212] fl ;[196] Same number as floating point spause:: dspaus ;[212] ms ;[36] Pause before sending data packet. spausf:: dspauf ;[212] fl ;[196] Same number as floating point pause:: drpaus ;[212] ms ;[36] Pause currently in effect. pausef:: drpaus ;[212] fl ;[36] Pause currently in effect. delay:: ddelay ;[212] ms ; How long before I send the first packet [194] delayf:: ddelaf ;[212] fl ; Same number as floating point odelay:: ddelay ;[212] ms ;[27] For saving & restoring delay. ;[[194] odelaf:: ddelaf ;[212] fl ; Same number as floating point ;[194] remark Other random stuff to check sec:: 0 ;[194] ; Seconds (for figuring baud rate) ; Impure Data, cont'd spadch:: dspad ;[194] ; Pad char micro wants. rpadch:: drpad ;[194] ; Pad char I want. spadn:: dspadn ;[194] ; Number of pad chars for micro. rpadn:: drpadn ;[194] ; Number for me. seolch:: dseol ;[194] ; EOL char micro needs. reolch:: dreol ;[194] ; EOL I need. squote:: dsquot ;[194] ; Quote character micro wants. rquote:: drquot ;[194] ; Quote character I want. escape:: defesc ;[194] Escape character for connecting (default ^\). duplex:: dxfull ;[194] Duplex for connecting. ssthdr:: SOH ;[194] ; Start of header character to send. rsthdr:: SOH ;[194] ; Start of header character to receive. rtchr:: 0 ;[194] ; Total file or data characters received. stchr:: 0 ;[194] ; ... sent. rtot:: 0 ;[194] ; Total characters recieved, everthing. stot:: 0 ;[194] numtry:: 0 ;[220] ; Number of tries on a packet. oldtry: 0 ; Number of tries for previous packet. maxtry:: dmxtry ;[194] ; Maximum retries for an ordinary packet. imxtry:: dimxtr ;[194] ; Maximum retries in send initiate. pktnum:: 0 ;[194] ; Current packet sequence number. num:: 0 ;[221] ; Number of packet just received. type:: 0 ;[221] ; Type of same. datlen:: 0 ;[221] ; Length of data field of same. pktlen:: 0 ;[221] ;[179] Packet length. islong:: 0 ;[221] ;[179] Packet is long. datptr:: 0 ;[221] ; Pointer to data field of same. rptot:: 0 ;[186] ;[4] Counter for received packets. sptot:: 0 ;[186] ;[4] Counter for sent packets. files:: 0 ;[186] ; File counter. eoflag: 0 ; End of file flag. temp: 0 ; Temporary location, to be used only for temp2: 0 ; very brief periods. ch: 0 ;[63] Current character. next:: 0 ;[220] ;[63] Next character. rpt: 0 ;[63] Repeat count of current character. rptq:: drept ;[194] ;[63] Repeat count prefix. rptflg:: 0 ;[194] ;[63] Repeat count processing flag. rptfld: drept ;[92] Repeat count field for Send-Init. ebq:: "Y" ;[63] 8th-bit-on prefix. ebqflg:: 0 ;[194] ;[63] 8th-bit prefixing flag. ebqr:: 0 ;[194] ;[88] 8th-bit prefixing requested flag. ebqfld: "Y" ;[88] 8th-bit prefix field for Send-Init. ebqchr: 0 ;[90] Current character has 8th-bit prefix. bctr:: "1" ;[194] ;[98] Block check type requested (character). bctu:: 1 ;[194] ;[98] Block check type in use (number). bctone:: 0 ;[220] ;[98] Use type 1 for this packet regardless... pktbct:: 0 ;[221] ; Block check type for this packet on receive bctemp: 0 ;[98] Place to store incoming block check. 0 ;[98] blkchk:: 0 ;[221] Final block check packet sseqn:: 0 ;[221] Sending sequence number sdatpt:: 0 ;[221] Sending data pointer spakpt:: 0 ;[221] Sending packet point ; Impure Data, cont'd iniflg:: 0 ;[220] ;[83] Init file in progress. takjfn:: 0 ;[194] ;[78] JFN of current TAKE command file. takdep:: 0 ;[194] ;[78] Depth of TAKE file JFN stack. takep:: 0 ;[78] TAKE file JFN stack pointer. takpdl: block ;[78] TAKE file JFN stack itself. filptr: 0 ;[102] Pointer into file name buffer. fildot: 0 ;[102] Counter for dots in filename. filbuf:: block ^d30 ;[194] ; Buffer for file name building. filbfz:: -1 ;[194] ; End of same... ;... ; Impure Data, cont'd -- big stuff at end. jobtab:: block .jiker ;[220] ;[194] Job info table for GETJI ttibuf: block IOBUF/4+1 ;[180] Communications device input buffer ttiptr: point 8, ttibuf ;[180] Pointer to communications input buffer tticnt: 0 ;[180] Communications input buffer count ttisin:: 0 ;[194] ;[180] Statistics counters... ttibin:: 0 ;[194] ;[180] ttildb:: 0 ;[194] ;[180] ttimax:: 0 ;[194] ;[180] ttipar:: 0 ;[223] Count of received parity errors buffer:: block MAXBUF/4+1 ; Buffer for file I/O. block ^d20 ; Superstition ;[190] Changed name from data to datbuf because MACRO doesn't flag ; conflicting storage names and .PSECT names... datbuf: intern datbuf ;[220] block MAXBUF/4+1 ;[190] ; Data field of packet. block ^d20 ; Superstition sndpkt: block MAXBUF/4+1 ; Place for building outbound packets. block ^d20 ; Superstition recpkt: block MAXBUF/4+1 ; Place for putting incoming packets. recpkz: block ^d20 ; Superstition tvtbuf: intern tvtbuf ;[247] IAC handling moved to K20SUB.MAC block MAXBUF/4+1 ;[131] For doubled-iac version of send packet. block ^d20 ; Superstition %%krbf: intern %%krbf ;[234] Routines moved to K20SUB.MAC block MAXPKT/4+1 ;[40] Place for packetized error messages. block ^d20 ; Superstition ;[209] Do not reorder the next two items ; ; To do: maybe surround these with a guard page? strc:: 0 ; Counter for, and... strptr:: 0 ;[194] ; Pointer into... strbuf:: intern strbuf ;[194] xlist ;[187] Save us a gigantic listing... repeat strblw,<0> ;[209] String buffer for big strings. list ;[187] strbf2: intern strbf2 ;[187] Also in k20ioc xlist ;[187] Save us a gigantic listing... repeat strblw,<0> ;[209] More of string buffer for big strings. list ;[187] strbz:: 0 ;[220] ; Where the padding ends. statxt: intern statxt ;[194] xlist ;[187] block ^d1000 ;[189] Server statistics list spdbuf: block <+1> ;[223] Sending padding buffer (eight bits) spdcnt: 0 ;Do *NOT* ;[223] Its current length spdpar: none ; reorder ;[223] Its parity rpdbuf: block <+1> ;[223] Receiving padding buffer (eight bits) rpdcnt: 0 ;Do *NOT* ;[223] Its current length rpdpar: none ; reorder ;[223] Its parity remark ;[203] It is probably evil to write literals lit ; Expand remaining literals here. .endps data ;[190] Close off data .psect .xcmsy ;[194] Ditch any MACSYM junk end ;[197] ; Entry information moved to k20sub ; Local Modes: ; Mode:MACRO ; Comment Column:32 ; Comment Start:;[247] ; Comment Begin:;[247] ; Auto Fill Mode: 0 ; End: