FILE TRIPOS.BCP --------------- /* This file contains the source of Tripos Kermit. There are two distinct source files here, with the break point marked with a line of asterisks. You should edit the file to split it into its two constituent parts. WARNING, This program uses the console driver to do I/O to the terminal, and serial line. The code puts the driver in 1 character per packet mode, and the kernal must be modified to allow up to 96 outstanding packets. It also is helpful to remove the code which strips the top bit, but explicit use of parity (e.g. space) will overcome this problem. */ // This is the main TRIPOS Kermit source file SECTION "Kermit" /********************************************************************* KK KK EEEEEEEE RRRRRRR MM MM IIIIIIII TTTTTTTT KK KK EEEEEEEE RRRRRRRR MMM MMM IIIIIIII TTTTTTTT KK KK EE RR RR MMMMMMMM II TT KKKK EEEEEE RRRRRRRR MM MM MM II TT KK KK EE RRRRRRR MM MM II TT KK KK EE RR RR MM MM II TT KK KK EEEEEEEE RR RR MM MM IIIIIIII TT KK KK EEEEEEEE RR RR MM MM IIIIIIII TT *********************************************************************/ /* This is TRIPOS KERMIT by C.G. Selwyn Elec.Eng. Dept. Bath University It is based on a translated version of the generic KERMIT in the protocol manual. However the following additions have been made Update 1. --------- 1) Correct handling of an upto seven character Send-init packet 2) Command parser to handle user commands e.g. SET command etc. 3) Server mode 4) Image mode 5) Take command Update 2. (08-NOV-84) --------------------- 6) Multilink interface Update 3. (17-JUL-85) --------------------- 7) Changed Multilink Interface 8) Message packet handling 9) Server bug corrected Update 4. (30-SEP-85) --------------------- 10) Filename parsing of names with '-' fixed 11) SETDIR command added 12) DO command added Update 5. (03-FEB-86) IWJS -------------------------- 13) Fixed incorrect padding request */ GET "libhdr" GET "clihdr" GET "iohdr" GET "prshdr" GET "manhdr" MANIFEST $( version = 1 update = 5 maxpack = 94 // Maximum packet size soh = 1 // Start of header sp = 32 // ASCII space cr = 13 // ASCII Carriage return del = 127 // ASCII rubout ctrld = 4 brkchr = ctrld // Default escape character maxtry = 5 // Time I try a packet myquote = '#' // Quote character I will use mypad = 0 // Number of padding characters I will need mypchar = 0 // Padding character I will need myeol = '*N' // End of line character I will need mytime = 5 // Seconds after which I should be timed out myquote8 = '&' // My 8 bit quoting character maxtim = 20 // Maximum Time out interval mintim = 2 // Minimum time out interval maxfiles = 10 // Maximum no. of files in argument string null = 0 xoff = 'S'-'@' xon = 'Q'-'@' argvl = 50 w.s = 0 w.r = 1 w.c = 2 w.e = 3 w.help = 4 w.set = 5 w.status = 6 w.show = 7 w.server = 8 w.finish = 9 w.get = 10 w.take = 11 w.endstream = 12 w.setdir = 13 w.setdir2= 14 w.do = 15 p.plen = 0 p.pad = 1 p.padchar= 2 p.eol = 3 p.sop = 4 p.quote = 5 p.timeout= 6 p.upb = 6 s1 = 1 ; s2 = s1+1 ; s3 = s2+1 ; s4 = s3+1 ; s5 = s4+1 s6 = s5+1 ; s7 = s6+1 ; s8 = s7+1 ; s9 = s8+1 ; sa = s9+1 sb = sa+1 ; sc = sb+1 ; sd = sc+1 ; s10 = sd+1 ; s10a= s10+1 s11 = s10a+1; s11a = s11+1 s31 = s11a+1 s51 = s31+1 ; s52 = s51+1 ; s53 = s52+1; s54 = s53+1 s55 = s54+1 ; s56 = s55+1 s531= s56+1 ; s532 = s531+1; s533=s532+1; s534= s533+1; s535= s534+1 s536= s535+1; s537 = s536+1; s538=s537+1 s5a = s538+1; s5b = s5a+1 ; s53a=s5b+1 ; s53b= s53a+1 sc1 = s53b+1 sd1 = sc1+1 term= sd1+1 file=term+1; f1 = file+1;f2 = f1+1 ; f3 = f2+1 ; f4 = f3+1 f5 = f4+1 ; f6 = f5+1 ; f7 = f6+1 ; f8 = f7+1 ; dirname = f8+1 anychs = dirname+1 ticksperminute = tickspersecond * 60 ticksperhour = ticksperminute * 60 ticksperday = ticksperhour * 24 bitsperbyte = 10 act.connect = 1020 act.disconnect = 1021 $) GLOBAL $( size : ug // Size of present data // ug+1 // ug+2 // ug+3 // Used by prshdr // ug+4 // ug+5 n : ug+6 // Message number r.packet.length : ug+7 // Maximum recieve packet size r.pad : ug+8 // How much padding to send r.padchar : ug+9 // Padding character to be received r.eol : ug+10 // End of line character to be received r.sop : ug+11 // Start of receive packet character r.quote : ug+12 // Receive quote character r.timeout : ug+13 // Timeout on receive s.packet.length : ug+14 // Maximum send packet size s.pad : ug+15 // How much padding to send s.padchar : ug+16 // Padding character to be sent s.eol : ug+17 // End of line character to be sent s.sop : ug+18 // Start of packet character to send s.quote : ug+19 // Send quote character s.timeout : ug+20 // Timeout for my send packet serving : ug+21 // Server mode numtry : ug+22 // Times this packet retried oldtry : ug+23 // Times previous packet retried fd : ug+24 // Scb pointer for read/write file remfd : ug+25 // Console handler number of remote line image : ug+26 // True means 8 bit mode pakcnt : ug+27 // No. of packets debug : ug+28 // Means we're debugging (Unlucky for some) astate : ug+29 // Present state of the automaton escchr : ug+30 // Connect command escape character filelist : ug+31 // List of files to be sent filnam : ug+32 // Current file name recpkt : ug+33 // Receive packet buffer packet : ug+34 // Packet buffer clk.p : ug+35 // Clock packet environment clk.l : ug+36 filecnt : ug+37 // Output file count sys.pktwait : ug+38 end.connect : ug+39 // Flag to end connect mode consin : ug+40 // Console input stream consout : ug+41 // Console output stream sc.read.pkt : ug+42 // Single character read packet got.sc.pkt : ug+43 // Single character packet queued flag remote : ug+44 // True means we're a remote kermit local : ug+45 // User kermit flag remote.delay : ug+46 // Delay to sending Send-Init packet if remote parse.vec : ug+47 // Current parameter table vector used by the parser argv : ug+48 // Argument vector argvp : ug+49 // Next free slot in argument vector numfiles : ug+50 // No. of files to be sent command : ug+51 // sic. cbuf : ug+52 // Command line buffer cptr : ug+53 // Command line buffer pointer starttime : ug+54 // Start time of last transfer finishtime : ug+55 // Finish time of last transfer bytes : ug+56 // No. of bytes transfered quote8 : ug+57 // 8-bit quoting character quote8ing : ug+58 // Flag 8-bit quoting operational word : ug+59 // Current word to send if in image mode wptr : ug+60 // Pointer into above reporting : ug+61 // Progress reporting flag currentin : ug+62 // Current command input stream reclevel : ug+63 // Recursion level erroring : ug+64 // Error flag sendchars : ug+65 // Current routine for sending a buffer mlink : ug+66 // True if connected to multilink close : ug+67 // Closedown routine message.pkts : ug+68 // Queue of unprocessed message pkts orig.dir : ug+69 // Original currentdir my.setname : ug+70 // Dir name $) /* S T A R T of T R I P O S K E R M I T Initialise and call the handle routine to execute the current command input stream */ LET start() BE $( LET rp = VEC maxpack/bytesperword LET pk = VEC maxpack/bytesperword LET srp = VEC pkt.arg1-1 LET avec = VEC argvl LET c = VEC 80/bytesperword LET tvec = VEC 1 LET setname = VEC 40 starttime := tvec finishtime := tvec+1 cbuf := c argv := avec pakcnt := 0 reclevel := 0 erroring := FALSE mlink := 0 message.pkts := 0 orig.dir := currentdir my.setname := setname copystring(cli.setname,my.setname) consout := findterminal() consin := consout currentin := consin finishtime!0 := -1 filecnt := 0 recpkt := rp packet := pk fd := 0 // No file open escchr := brkchr remote.delay := 5 image := FALSE quote8ing := FALSE quote8 := myquote8 reporting := TRUE s.eol := cr s.packet.length := maxpack s.quote := myquote s.pad := 0 s.padchar := null s.sop := soh s.timeout := 5 r.eol := myeol r.packet.length := maxpack r.quote := myquote r.pad := mypad r.padchar := mypchar r.sop := soh r.timeout := 5 local := TRUE remote := ~local serving := FALSE sys.pktwait := pktwait pktwait := my.pktwait sc.read.pkt := srp sc.read.pkt!pkt.link := notinuse sc.read.pkt!pkt.id := remfd sc.read.pkt!pkt.type := act.sc.read qpkt(sc.read.pkt) got.sc.pkt := FALSE writef("Tripos Kermit - Version %N.%N*N",version,update) initialise() handle() cons(writef,"Workspace used = %N%%*N",distat()) close() $) /* H A N D L E This routine handles the parsing and actioning of the current command input stream. Take commands are a recursive call to handle(). */ AND handle() BE $( filecnt := 0 erroring := FALSE selectinput(currentin) selectoutput(consout) IF currentin = consin THEN writef("Kermit-68K (%S) > *E",remote->"Remote","Local") command := -1 readline(cbuf) cptr := 1 TEST do.parse() THEN $( SWITCHON command INTO $( CASE w.set : do.set() ENDCASE CASE w.status : do.status() ENDCASE CASE w.show : do.show() ENDCASE CASE w.c : IF reclevel ~= 0 THEN $( writes("Can't connect from take file*N") erroring := TRUE ENDCASE $) IF remote THEN $( writes("Can't connect if remote*N") erroring := TRUE ENDCASE $) connect() ENDCASE CASE w.s : CASE w.r : handle.sr() ENDCASE CASE w.get : TEST local THEN do.get() ELSE writes("Can't perform get if remote*N") ENDCASE CASE w.endstream : IF reclevel ~= 0 THEN RETURN // If executing file CASE w.e : // Otherwise treat as end command BREAK CASE w.help : show.help() ENDCASE CASE w.server : TEST remote THEN TEST serve() THEN BREAK ELSE ENDCASE ELSE $( erroring := TRUE writes("Can't serve if local kermit*N") $) ENDCASE CASE w.finish : TEST local THEN remote.finish() ELSE $( erroring := TRUE writes("Can't issue finish if remote*N") $) ENDCASE CASE w.take : $( LET newin = findinput(argv!0) LET oldin = currentin IF newin = 0 THEN $( writef("Can't find file %S*N",argv!0) erroring := TRUE ENDCASE $) currentin := newin reclevel := reclevel+1 handle() reclevel := reclevel-1 selectinput(currentin) endread() currentin := oldin ENDCASE $) $) $) ELSE $( erroring := TRUE writes("Bad command*N") $) IF erroring & (reclevel ~= 0) THEN RETURN $) REPEAT /* s e r v e r Loop collecting commands from the other end and executing them */ AND serve() = VALOF $( LET num,len = ?,? LET r = ? rem.sc.mode(TRUE) n := 0 serving := TRUE $( numfiles := 1 filecnt := 0 SWITCHON rpack(@len,@num,recpkt) INTO $( CASE 'S' : rpar(recpkt,len) len := spar(packet) report(TRUE) spack('Y',n,len,packet) oldtry := numtry numtry := 0 n := (n+1) REM 64 datstamp(starttime) TEST recsw() THEN datstamp(finishtime) ELSE finishtime!0 := -1 ENDCASE CASE 'R' : filnam := argv FOR i = 0 TO len-1 DO filnam%(i+1) := recpkt%i filnam%0 := len filelist := @filnam datstamp(starttime) bytes := 0 TEST sendsw() THEN datstamp(finishtime) ELSE finishtime!0 := -1 ENDCASE CASE 'G' : // Generic commands SWITCHON recpkt%0 INTO $( CASE 'F' : // Finish FOR i = 1 TO 4 DO packet%(i-1) := "OK.*N"%i spack('Y',n,4,packet) r := FALSE // Don't exit BREAK CASE 'L' : // Logout FOR i = 1 TO 4 DO packet%(i-1) := "OK.*N"%i spack('Y',n,4,packet) r := TRUE // Exit BREAK $) DEFAULT : CASE FALSE : ENDCASE $) IF fd ~= 0 THEN $( endstream(fd) fd := 0 $) $) REPEAT rem.sc.mode(FALSE) RESULTIS r $) AND remote.finish() = VALOF $( LET num,len = ?,? numtry := 0 n := 0 packet%0 := 'F' $( spack('G',0,1,packet) SWITCHON rpack(@len,@num,recpkt) INTO $( CASE 'Y' : IF len ~= 0 THEN message(recpkt,len) RESULTIS TRUE CASE 'N' : CASE FALSE : numtry := numtry+1 IF numtry >= maxtry THEN RESULTIS FALSE ENDCASE DEFAULT : erroring := TRUE RESULTIS FALSE $) $) REPEAT $) AND show.help() BE $( writes("C - Connect*N") writes("E - Exit*N") writes("FINISH - Finish server mode on a * *remote kermit*N") writes("G file1 ... - Get file(s) from a server*N") writes("HELP - This message*N") writes("R - Receive file(s)*N") writes("S file1 ... - Send file(s)*N") writes("SET - Set various options*N") writes("SERVER - Set server mode*N") writes("SHOW - Show the settable option settings*N") writes("STATUS - Print information about*N* * latest transaction*N") $) /* Do.status Display status information */ AND printtime(t) BE writef("%N:%N:%N",(t!1)/60,(t!1) REM 60,(t!2)/tickspersecond) AND do.status() BE $( TEST finishtime!0 = -1 THEN writes("No valid last transfer*N") ELSE $( LET t1 = ? writef("Last transfer :-*N") writef(" Started at : ") ; printtime(starttime) ; newline() writef(" Finished at : ") ; printtime(finishtime) ; newline() writef("Bytes transferred : %N*N",bytes) t1 := (finishtime!0 - starttime!0) writef("Effective baud rate : %N baud*N", (bytes*bitsperbyte)*tickspersecond/t1) $) $) /* Do.show Show a selection of currently set parameters etc. */ AND do.show() BE $( writef("Escape character - CTRL-%C*N",escchr+'@') writef("Remote delay - %N seconds*N",remote.delay) writef("Image mode - %S*N",image->"ON","OFF") writef("8-bit quote character - %C*N",quote8) writef("Reporting - %S*N",reporting->"ON","OFF") newline() writef("Transmission section : -*N") writef(" Packet length - %N*N",s.packet.length) writef(" No. of pad chars - %N*N",s.pad) writef(" Pad character - #X%X2*N",s.padchar) writef(" End of line char - #X%X2*N",s.eol) writef(" Start of packet char - #X%X2*N",s.sop) writef(" Quote character - %C*N",s.quote) writef(" Timeout - %N seconds*N",s.timeout) newline() writef("Reception section : -*N") writef(" Packet length - %N*N",r.packet.length) writef(" No. of pad chars - %N*N",r.pad) writef(" Pad character - #X%X2*N",r.padchar) writef(" End of line char - #X%X2*N",r.eol) writef(" Start of packet char - #X%X2*N",r.sop) writef(" Quote character - %C*N",r.quote) writef(" Timeout - %N seconds*N",r.timeout) $) /* Handle the get command */ AND do.get() = VALOF $( LET r = ? LET len,num = ?,? bytes := 0 numtry := 0 datstamp(starttime) filelist := argv FOR i = 0 TO numfiles-1 DO $( filnam := filelist!i FOR j = 0 TO filnam%0 -1 DO packet%j := filnam%(j+1) spack('R',n,filnam%0,packet) r := recsw() UNLESS r THEN $( finishtime!0 := -1 selectoutput(consout) writef("Unable to receive %S*N",filnam) RESULTIS FALSE $) $) selectoutput(consout) datstamp(finishtime) writes("*NOK.*N") RESULTIS TRUE $) /* Handle a Send/Receive command */ AND handle.sr() = VALOF $( LET r = ? IF remote THEN rem.sc.mode(TRUE) bytes := 0 datstamp(starttime) TEST command = w.s THEN $( filelist := argv filnam := filelist!0 r := sendsw() $) ELSE $( r := recsw() $) selectoutput(consout) TEST r THEN $( datstamp(finishtime) IF ~remote THEN writef("*NOK.*N") $) ELSE $( IF ~remote THEN writef("%S failed.*N",command=w.s->"Send","Receive") finishtime!0 := -1 $) IF remote THEN rem.sc.mode(FALSE) IF fd ~= 0 THEN $( endstream(fd) fd := 0 $) RESULTIS FALSE $) /* s e n d s w Sendsw is the state table switcher for sending files. It loops until either it finishes, or an error is encountered. The routines called by sendsw are responsible for changing the state. */ AND sendsw() = VALOF $( n := 0 astate := 'S' numtry := 0 $( SWITCHON astate INTO $( CASE 'D' : astate := sdata() ; ENDCASE /* Data-send state */ CASE 'F' : astate := sfile() ; ENDCASE /* File-send */ CASE 'Z' : astate := seof() ; ENDCASE /* End-Of-File */ CASE 'S' : astate := sinit() ; ENDCASE /* Send Init */ CASE 'B' : astate := sbreak(); ENDCASE /* Break-Send */ CASE 'C' : RESULTIS TRUE /* Complete */ DEFAULT : /* Unknown, fail */ CASE 'A' : erroring := TRUE RESULTIS FALSE /* Unknown, fail */ $) $) REPEAT $) /* s i n i t Send initiate: Send my parameters, get other side's back. */ AND sinit() = VALOF $( LET num,len = ?,? IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 len := spar(packet) IF remote & (~serving) THEN delay(remote.delay*tickspersecond) spack('S',n,len,packet) SWITCHON rpack(@len,@num,recpkt) INTO $( CASE 'N' : report(FALSE) RESULTIS astate /* Nak */ CASE 'Y' : /* Ack */ $( report(n=num) IF n ~= num RESULTIS astate rpar(recpkt,len) numtry := 0 n := (n+1) REM 64 fd := findinput(filnam) IF fd = 0 THEN RESULTIS 'A' cons(writef,"Sending file %S*N",filnam) selectinput(fd) RESULTIS 'F' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* s f i l e Send File Header */ AND sfile() = VALOF $( LET num,len = ?,? LET name = VEC 20 wptr := 4 IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 len := filnam%0 FOR i = 1 TO len DO name%(i-1) := filnam%i spack('F',n,len,name) SWITCHON rpack(@len,@num,recpkt) INTO $( CASE 'N' : /* NAK */ $( num := num = 0 -> 63,num-1 IF n ~= num THEN $( report(FALSE) RESULTIS astate $) $) CASE 'Y' : $( report(n=num) IF n ~= num THEN RESULTIS astate numtry := 0 n := (n+1) REM 64 size := bufill(packet) RESULTIS 'D' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* s d a t a Send File Data */ AND sdata() = VALOF $( LET num,len = ?,? IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 spack('D',n,size,packet) SWITCHON rpack(@len,@num,recpkt) INTO $( CASE 'N' : /* NAK */ $( num := num = 0 -> 63,num-1 IF n ~= num THEN $( report(FALSE) RESULTIS astate $) $) CASE 'Y' : $( report(n=num) IF n ~= num THEN RESULTIS astate numtry := 0 n := (n+1) REM 64 size := bufill(packet) RESULTIS size = 0 ->'Z','D' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* s e o f Send End-Of-File */ AND seof() = VALOF $( LET num,len = ?,? IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 spack('Z',n,0,packet) SWITCHON rpack(@len,@num,recpkt) INTO $( CASE 'N' : /* NAK */ $( num := num = 0 -> 63,num-1 IF n ~= num THEN $( report(FALSE) RESULTIS astate $) $) CASE 'Y' : $( report(n=num) IF n ~= num THEN RESULTIS astate numtry := 0 n := (n+1) REM 64 endread() fd := 0 UNLESS gnxtfl() THEN RESULTIS 'B' RESULTIS 'F' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* s b r e a k Send Break (EOT) */ AND sbreak() = VALOF $( LET num,len = ?,? IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 spack('B',n,0,packet) SWITCHON rpack(@len,@num,recpkt) INTO $( CASE 'N' : /* NAK */ $( num := num = 0 -> 63,num-1 IF n ~= num THEN $( report(FALSE) RESULTIS astate $) $) CASE 'Y' : $( report(n=num) IF n ~= num THEN RESULTIS astate numtry := 0 n := (n+1) REM 64 RESULTIS 'C' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* r e c s w This is the state table switcher for receiving files. */ AND recsw() = VALOF $( TEST serving THEN $( astate := 'F' n := 1 $) ELSE $( n := 0 astate := 'R' $) numtry := 0 $( SWITCHON astate INTO $( CASE 'D' : astate := rdata() ; ENDCASE // Data receive state CASE 'F' : astate := rfile() ; ENDCASE // File receive state CASE 'R' : astate := rinit() ; ENDCASE // Send initiate state CASE 'C' : RESULTIS TRUE // Complete state CASE 'A' : erroring := TRUE RESULTIS FALSE // Abort state $) $) REPEAT $) /* r i n i t Receive Initialisation */ AND rinit() = VALOF $( LET len,num = ?,? IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 SWITCHON rpack(@len,@num,packet) INTO $( CASE 'S' : $( rpar(packet,len) len := spar(packet) report(TRUE) spack('Y',n,len,packet) oldtry := numtry numtry := 0 n := (n+1) REM 64 RESULTIS 'F' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* r f i l e Receive File Header */ AND rfile() = VALOF $( LET len,num = ?,? wptr := 0 IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 SWITCHON rpack(@len,@num,packet) INTO $( CASE 'S' : $( IF oldtry > maxtry THEN $( oldtry := oldtry + 1 RESULTIS 'A' $) oldtry := oldtry + 1 TEST (num = (n=0 -> 63,n-1)) THEN $( len := spar(packet) report(FALSE) spack('Y',num,len,packet) numtry := 0 RESULTIS astate $) ELSE RESULTIS 'A' $) CASE 'Z' : $( IF oldtry > maxtry THEN $( oldtry := oldtry + 1 RESULTIS 'A' $) oldtry := oldtry + 1 TEST (num = (n=0 -> 63,n-1)) THEN $( spack('Y',num,0,0) report(FALSE) numtry := 0 RESULTIS astate $) ELSE RESULTIS 'A' $) CASE 'F' : /* File Header */ $( IF (num ~= n) RESULTIS 'A' IF ~getfil(packet) THEN RESULTIS 'A' spack('Y',num,0,0) report(TRUE) oldtry := numtry numtry := 0 n := (n+1) REM 64 RESULTIS 'D' $) CASE 'B' : /* Break transmission */ $( IF num ~= n THEN RESULTIS 'A' spack('Y',n,0,0) RESULTIS 'C' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* r d a t a Receive data */ AND rdata() = VALOF $( LET num,len = ?,? IF numtry > maxtry THEN $( numtry := numtry + 1 RESULTIS 'A' $) numtry := numtry + 1 SWITCHON rpack(@len,@num,packet) INTO $( CASE 'D' : $( TEST num ~= n THEN $( IF oldtry > maxtry THEN $( oldtry := oldtry + 1 RESULTIS 'A' $) oldtry := oldtry + 1 IF num = (n=0 -> 63,n-1) THEN $( spack('Y',num,6,packet) report(FALSE) numtry := 0 RESULTIS astate $) RESULTIS 'A' $) ELSE $( bufemp(packet,fd,len) spack('Y',n,0,0) report(TRUE) oldtry := numtry numtry := 0 n := (n+1) REM 64 RESULTIS 'D' $) $) CASE 'F' : // Got a file header $( IF oldtry > maxtry THEN $( oldtry := oldtry + 1 RESULTIS 'A' $) oldtry := oldtry + 1 IF num = (n=0 -> 63,n-1) THEN $( spack('Y',num,0,0) report(FALSE) numtry := 0 RESULTIS astate $) RESULTIS 'A' $) CASE 'Z' : $( IF num ~= n THEN RESULTIS 'A' spack('Y',n,0,0) report(TRUE) IF image & (wptr ~= 0) THEN writewords(@word,1) endwrite() fd := 0 n := (n+1) REM 64 RESULTIS 'F' $) CASE FALSE : report(FALSE) RESULTIS astate DEFAULT : RESULTIS 'A' $) $) /* c o n n e c t Establish a virtual terminal connection with the remote machine, over the other tty line. */ AND connect.pktwait(dest,p) = cowait(p) AND rem.rdch() = readchar() AND loc.rdch() = sendpkt(notinuse,consoletask,act.sc.read, ?,?) AND rem.wrch(ch) BE sendpkt(notinuse,remfd, act.sc.write,?,?,ch) AND loc.wrch(ch) BE sendpkt(notinuse,consoletask,act.sc.write,?,?,ch) AND co1.rtn() BE // Local to remote $( LET ch = ? $( ch := loc.rdch() IF ch = escchr THEN $( end.connect := TRUE cowait(0) $) rem.wrch(ch) $) REPEAT $) AND co2.rtn() BE // Remote to local $( LET ch = ? $( IF got.sc.pkt THEN $( ch := sc.read.pkt!pkt.res1 qpkt(sc.read.pkt) got.sc.pkt := FALSE loc.wrch(ch) $) // see if there are any messages and shove them out UNTIL message.pkts = 0 DO $( LET p = message.pkts LET msg = p ! pkt.arg1 LET size = p ! pkt.arg2 LET banner = "*C*NKermit: Message...*C*N" message.pkts := !p UNLESS size = 0 DO $( FOR i = 1 TO banner%0 DO loc.wrch(banner%i) FOR i = 0 TO size-1 DO $( IF msg%i = '*N' THEN loc.wrch('*C') loc.wrch(msg%i) $) $) !p := -1 returnpkt(p,TRUE,0) $) cowait(0) $) REPEAT $) AND connect() BE $( LET co1 = createco(co1.rtn,200) LET co2 = createco(co2.rtn,200) LET p1 = ? LET p2 = ? cons(writef,"[Connecting to remote host, type CTRL-%C to return]*N", escchr+'@') loc.sc.mode(TRUE) pktwait := connect.pktwait p1 := callco(co1) p2 := callco(co2) end.connect := FALSE $( LET p = taskwait() TEST p = p1 THEN p1 := callco(co1,p) // local to remote ELSE TEST p = p2 THEN p2 := callco(co2,p) // remote to local ELSE $( TEST p = sc.read.pkt THEN got.sc.pkt := TRUE ELSE $( LET qe = @message.pkts UNLESS p!pkt.type = act.sc.msg THEN abort(200) UNTIL !qe=0 DO qe := !qe !qe := p !p := 0 $) $) IF p2=0 & ( got.sc.pkt | message.pkts~=0) THEN p2:=callco(co2) IF end.connect THEN BREAK $) REPEAT pktwait := my.pktwait loc.sc.mode(FALSE) cons(writes,"*N[Back at TRIPOS]*N") deleteco(co1) deleteco(co2) $) /* KERMIT utilities */ AND clkint() BE $( longjump(clk.p,clk.l) $) /* tochar converts a control character to a printable one by adding a space */ AND tochar(ch) = ch + '*S' /* unchar undoes tochar */ AND unchar(ch) = ch - '*S' /* ctl turns a control character into a printable character by toggling the control bit (ie. ^A -> A and A -> ^A */ AND ctl(ch) = ch NEQV 64 /* s p a c k Send a packet */ AND spack(type,num,len,data) BE $( LET i = ? LET chksum = ? LET buffer = VEC 100/bytesperword FOR i = 1 TO s.pad DO sendchar(s.padchar) buffer%0 := s.sop chksum := tochar(len+3) buffer%1 := tochar(len+3) chksum := chksum+tochar(num) buffer%2 := tochar(num) chksum := chksum+type buffer%3 := type FOR i = 4 TO 4+len-1 DO $( LET d = data%(i-4) buffer%i := d chksum := chksum+d $) chksum := (chksum + ((chksum & #XC0) >> 6)) & #X3F buffer%(4+len) := tochar(chksum) buffer%(5+len) := s.eol sendchars(buffer,5+len) $) AND sendchar(ch) BE sendpkt(notinuse,remfd,act.sc.write,?,?,ch) AND sngl.sc(b,upb) BE FOR i = 0 TO upb DO sendchar(b%i) AND multi.sc(b,upb) BE sendpkt(notinuse,remfd,act.sc.write,?,?,b,0,upb+1) AND readchar() = VALOF $( LET r = ? UNLESS got.sc.pkt THEN pktwait(remfd,sc.read.pkt) r := sc.read.pkt!pkt.res1 qpkt(sc.read.pkt) got.sc.pkt := FALSE RESULTIS r $) /* r p a c k Receive a packet */ AND rpack(len,num,data) = VALOF $( LET i,done = ?,? LET chksum,t,type = ?,~SOH,? LET clkpkt = TABLE notinuse,-1,0,?,?,? clk.p := level() clk.l := l1 IF ((r.timeout>maxtim) | (r.timeout < mintim)) THEN r.timeout := mytime clkpkt!pkt.arg1 := r.timeout*tickspersecond qpkt(clkpkt) WHILE (t ~= r.sop) DO t := readchar() done := FALSE WHILE ~done DO $( t := readchar() IF ~image THEN t := t & #X7F IF t = r.sop LOOP chksum := t !len := unchar(t)-3 t := readchar() IF ~image THEN t := t & #X7F IF t = r.sop LOOP chksum := chksum+t !num := unchar(t) t := readchar() IF ~image THEN t := t & #X7F IF t = r.sop LOOP chksum := chksum+t type := t FOR i = 0 TO (!len)-1 DO $( t := readchar() IF ~image THEN t := t & #X7F IF t = r.sop LOOP chksum := chksum+t data%i := t $) data%(!len) := 0 t := readchar() IF ~image THEN t := t & #X7F IF t = r.sop LOOP done := TRUE dqpkt(-1,clkpkt) $) chksum := (chksum + ((chksum & #XC0)>>6)) & #X3F IF chksum ~= unchar(t) RESULTIS FALSE RESULTIS type l1: RESULTIS FALSE $) /* p u t b u f f Put a character in the buffer Control and 8-bit quoting are performed if required/elected */ AND putbuff(buffer,i,ch) = VALOF $( LET j = 0 LET ch7 = ch & #X7F IF quote8ing THEN // Do 8-bit quote $( IF (ch & #X80) ~= 0 THEN $( buffer%(i+j) := quote8 j := j+1 $) ch := ch7 $) IF (ch7 < sp) | (ch7 = del) | // Quote control characters (ch7 = s.quote) | // And the funnies ((ch7 = quote8) & quote8ing) THEN $( IF ~image & (ch7 = '*N') THEN $( buffer%(i+j) := s.quote buffer%(i+j+1) := ctl('*C') j := j+2 $) buffer%(i+j) := s.quote j := j+1 IF (ch7 < sp) | (ch7 = del) THEN ch := ctl(ch) $) buffer%(i+j) := ch j := j+1 RESULTIS j $) /* b u f i l l Get a bufferful of data from the file that's being sent. */ AND image.rdch() = VALOF $( LET r = ? IF wptr = 4 THEN $( r := readwords(@word,1) IF r = 0 THEN RESULTIS endstreamch wptr := 0 $) r := (@word)%wptr wptr := wptr+1 RESULTIS r $) AND image.unrdch() BE wptr := wptr-1 AND bufill(buffer) = VALOF $( LET i,j = ?,? LET rch = image -> image.rdch,rdch LET unrch = image -> image.unrdch,unrdch LET t = rch() i := 0 WHILE t ~= endstreamch DO $( bytes := bytes+1 j := putbuff(buffer,i,t) IF i+j > s.packet.length-8 THEN $( unrch() ; RESULTIS i $) i := i+j t := rch() $) RESULTIS i $) /* b u f e m p Get data from an incoming packet into a file */ AND image.wrch(ch) BE $( (@word)%wptr := ch wptr := (wptr + 1) REM 4 IF wptr = 0 THEN writewords(@word,1) $) AND bufemp(buffer,fd,len) BE $( LET t = ? LET wch = image-> image.wrch,wrch FOR i = 0 TO len-1 DO $( LET m = 0 t := buffer%i IF (t = quote8) & quote8ing THEN $( m := #X80 i := i+1 t := buffer%i $) IF t = r.quote THEN $( LET t7 = ? i := i+1 t := buffer%i t7 := t & #X7F IF (t7 ~= r.quote) & (t7 ~= quote8) THEN t := ctl(t) $) IF image | (t ~= '*C') THEN $( bytes := bytes+1 ; wch(t|m) $) $) $) /* g e t f i l Open a new file */ AND alphanumeric(ch) = ('A' <= capitalch(ch) <= 'Z') | ('0' <= ch <= '9') AND getfil(filenm) = VALOF $( LET l = 0 UNTIL filenm%l = 0 DO l := l+1 FOR i = l TO 1 BY -1 DO filenm%i := filenm%(i-1) filenm%0 := l fd := findoutput(filenm) TEST fd ~= 0 THEN cons(writef,"*NReceiving file %S*N",filenm) ELSE $( FOR i = 1 TO filenm%0 DO IF ~alphanumeric(filenm%i) THEN filenm%i := '-' fd := findoutput(filenm) IF fd ~= 0 THEN cons(writef,"*NReceiving file %S*N",filenm) $) selectoutput(fd) RESULTIS fd ~= 0 $) /* g n x t f l Get next file in a file group */ AND gnxtfl() = VALOF $( filecnt := filecnt + 1 IF filecnt = numfiles THEN RESULTIS FALSE filnam := filelist!filecnt fd := findinput(filnam) IF fd ~= 0 THEN cons(writef,"*NSending file %S*N",filnam) selectinput(fd) RESULTIS fd ~= 0 $) AND cons(f,a1,a2,a3,a4,a5) BE IF ~remote THEN $( LET co = output() selectoutput(consout) f(a1,a2,a3,a4,a5) selectoutput(co) $) AND report(f) BE IF reporting THEN $( TEST f THEN $( pakcnt := (pakcnt+1) REM 5 IF pakcnt = 0 THEN cons(writes,".*E") $) ELSE cons(writes,"%*E") $) AND my.pktwait(dest,pkt) = VALOF $( $( LET p = taskwait() IF p = pkt THEN RESULTIS p TEST p = sc.read.pkt THEN got.sc.pkt := TRUE ELSE TEST p!pkt.type = act.sc.msg THEN returnpkt(p) ELSE TEST p!pkt.id = -1 THEN longjump(clk.p,clk.l) ELSE $( abort(100,p) returnpkt(p,FALSE) $) $) REPEAT $) /* s p a r Fill the data area with the send-init parameters */ AND spar(data) = VALOF $( data%0 := tochar(r.packet.length) data%1 := tochar(s.timeout) data%2 := tochar(r.pad) data%3 := ctl(r.padchar) data%4 := tochar(r.eol) data%5 := s.quote data%6 := command = w.s -> 'Y', quote8ing -> quote8,'*S' RESULTIS 7 $) /* r p a r Get the remote's send-init parameters */ AND rpar(data,len) BE $( LET v = ? s.packet.length := maxpack r.timeout := mytime s.eol := myeol s.quote := myquote s.pad := mypad s.padchar := mypchar quote8ing := FALSE SWITCHON len INTO $( DEFAULT : CASE 8: CASE 7 : // 8-bit SWITCHON data%6 INTO $( CASE 'N' : quote8ing := FALSE ENDCASE DEFAULT : quote8 := data%6 CASE 'Y' : quote8ing := TRUE ENDCASE $) CASE 6 : // quote character UNLESS data%5 = '*S' THEN r.quote := data%5 CASE 5 : // eol character UNLESS data%4 = '*S' THEN s.eol := unchar(data%4) CASE 4 : // pad character UNLESS data%3 = '*S' THEN s.padchar := ctl(data%3) CASE 3 : // no. of pad characters UNLESS data%2 = '*S' THEN s.pad := unchar(data%2) CASE 2 : // timeout UNLESS data%1 = '*S' THEN r.timeout := unchar(data%1) CASE 1 : // packet length UNLESS data%0 = '*S' THEN s.packet.length := unchar(data%0) CASE 0 : $) $) /* p a r s e r The command parser to is based on the table driven parser by CGS. */ /* The action routines */ AND parm.vec(buff,buffs,buffl,val,id) = VALOF // Set the parameter vector $( parse.vec := id // we are to play with RESULTIS TRUE $) AND set.p(buff,buffs,buffl,val,id) = VALOF // Change a parameter $( parse.vec!id := val // in the current vector RESULTIS TRUE $) AND commandtype(buff,buffs,buffl,val,id) = VALOF // Store the command word $( command := id RESULTIS TRUE $) AND set.delay(buff,buffs,buffl,val,id) = VALOF // Host delay $( remote.delay := val RESULTIS TRUE $) AND set.image(buff,buffs,buffl,val,id) = VALOF // Image flag $( image := id RESULTIS TRUE $) AND set.reporting(buff,buffs,buffl,val,id) = VALOF // Reporting flag $( reporting := id RESULTIS TRUE $) AND set.escchr(buff,buffs,buffl,val,id) = VALOF // Escape character $( IF val < '*S' THEN $( escchr := val RESULTIS TRUE $) RESULTIS FALSE $) AND set.quote8(buff,buffs,buffl,val,id) = VALOF // 8-bit quote character $( quote8 := val RESULTIS TRUE $) AND setfile(buff,buffs,buffl,val,id) = VALOF // Remember file name $( LET p = argv+argvp argvp := argvp+buffl/bytesperword+1 IF argvp > argvl THEN RESULTIS FALSE p%0 := buffl FOR i = 0 TO buffl-1 DO p%(i+1) := buff%(buffs+i) argv!numfiles := p numfiles := numfiles+1 RESULTIS TRUE $) AND blank(buff,buffs,buffl,val,id,flg) = VALOF $( !flg := id -> !flg | f.bsupp, !flg & (~f.bsupp) RESULTIS TRUE $) AND copyvec(b1,b2,u) BE FOR i = 0 TO u DO b2!i := b1!i AND copystring(s1,s2) BE FOR i = 0 TO s1%0 DO s2%i := s1%i AND change.setname(name) = VALOF $( LET newdir = currentdir LET setname = name LET clilen = my.setname%0 LET dir = ? IF compstring(setname,".")=0 THEN // request to set to previous dir $( for i=clilen to 1 by -1 do // look for '.' or ':' $( if my.setname%i='.' then $( clilen := i-1 break $) if my.setname%i=':' then $( clilen := i break $) $) my.setname%0 := clilen setname := my.setname $) dir := locatedir(setname) TEST dir=0 THEN RESULTIS 0 ELSE $( // A new directory. Set it and remember the name let prefix = VEC 4 let p = splitname(prefix, ':', setname, 0) TEST p=0 THEN // No ':' UNLESS my.setname%clilen=':' do // not if just eg 'sys:' $( clilen := clilen+1 my.setname%clilen := '.' $) ELSE $( TEST p=2 then // just ':', so leave device part alone $( p := splitname(prefix, ':', my.setname, 0) clilen := p-2 $) ELSE clilen := 0 $) // concatenate name for i=1 to setname%0 do my.setname%(i+clilen) := setname%i my.setname%0 := clilen + setname%0 newdir := dir $) RESULTIS newdir $) /* Initialise the state transition table */ AND init.state.table() BE $( istat(1000) state(s1) ; state(s2) ; state(s3) ; state(s4) ; state(s5) state(s6) ; state(s7) ; state(s8) ; state(s9) ; state(sa) state(sb) ; state(sc) ; state(sd) ; state(s10) ; state(s10a) state(s31) ; state(s11) ; state(s11a) state(s51) ; state(s52) ; state(s53) state(s531) ; state(s532) ; state(s533) ; state(s534) ; state(s535) state(s536) ; state(s537) ; state(s538) state(s5a) ; state(s5b) ; state(s53a) ; state(s53b) ; state(s54) state(s55) ; state(s56) state(sc1) state(sd1) state(term) state(file) ; state(f1) ; state(f2) ; state(f3) ; state(f4) state(f5) ; state(f6) ; state(f7) ; state(f8) ; state(dirname) state(anychs) trans(s1,s2,it.key, "C", 0,?) trans(s1,s3,it.key, "S", 0,?) trans(s1,s4,it.key, "R", 0,?) trans(s1,s5a,it.key, "SET", 0,?) trans(s1,s10,it.key, "SETDIR",0,?) trans(s1,s11,it.key, "DO" ,0,?) trans(s1,s6,it.key, "STATUS",0,?) trans(s1,s7,it.key, "E", 0,?) trans(s1,s7,it.key, "EXIT", 0,?) trans(s1,s7,it.key, "Q", 0,?) trans(s1,s7,it.key, "QUIT", 0,?) trans(s1,s8,it.key, "HELP", 0,?) trans(s1,exit.state, it.eos, ?,commandtype,w.endstream) trans(s1,s9,it.key, "SHOW", 0,?) trans(s1,sa,it.key, "SERVER",0,?) trans(s1,sb,it.key, "FINISH",0,?) trans(s1,sc,it.key, "G" ,0,?) trans(s1,sd,it.key, "TAKE" ,0,?) trans(s1,exit.state,it.subxp,term,0,?) trans(s2,exit.state,it.subxp,term,commandtype,w.c) trans(s3,s31,it.subxp,file, setfile,?) trans(s31,s31,it.subxp,file, setfile,?) trans(s31,exit.state,it.subxp,term,commandtype,w.s) trans(s4,exit.state,it.subxp,term,commandtype,w.r) trans(s5a,s5b,it.subxp,s5,0,?) trans(s5b,s5b,it.subxp,s5,0,?) trans(s5b,exit.state,it.subxp,term,0,?) trans(s5,s51,it.key,"DELAY",0,?) trans(s5,s52,it.key,"ESCCHR",0,?) trans(s5,s54,it.key,"IMAGE",0,?) trans(s5,s53a,it.key,"RECEIVE",parm.vec,@r.packet.length) trans(s5,s53a,it.key,"SEND",parm.vec,@s.packet.length) trans(s5,s55,it.key,"QUOTE8",0,?) trans(s5,s56,it.key,"REPORT",0,?) trans(s51,exit.state,it.dnumb,?,set.delay,?) trans(s52,exit.state,it.dnumb,?,set.escchr,?) trans(s53a,s53b,it.subxp,s53,0,?) trans(s53b,s53b,it.subxp,s53,0,?) trans(s53b,exit.state,it.lamda,?,0,?) trans(s53,s531,it.key,"EOL",0,?) trans(s53,s532,it.key,"PLEN",0,?) trans(s53,s533,it.key,"PAD",0,?) trans(s53,s534,it.key,"PADCHAR",0,?) trans(s53,s535,it.key,"QUOTE",0,?) trans(s53,s536,it.key,"SOP",0,?) trans(s53,s537,it.key,"TIMEOUT",0,?) trans(s531,exit.state,it.numbr,?,set.p,p.eol) trans(s532,exit.state,it.numbr,?,set.p,p.plen) trans(s533,exit.state,it.numbr,?,set.p,p.pad) trans(s534,exit.state,it.numbr,?,set.p,p.padchar) trans(s535,exit.state,it.numbr,?,set.p,p.quote) trans(s536,exit.state,it.numbr,?,set.p,p.sop) trans(s537,exit.state,it.numbr,?,set.p,p.timeout) trans(s54,exit.state,it.key,"ON",set.image,TRUE) trans(s54,exit.state,it.key,"OFF",set.image,FALSE) trans(s55,exit.state,it.numbr,?,set.quote8,?) trans(s56,exit.state,it.key,"ON",set.reporting,TRUE) trans(s56,exit.state,it.key,"OFF",set.reporting,FALSE) trans(s6,exit.state,it.subxp,term,commandtype,w.status) trans(s7,exit.state,it.subxp,term,commandtype,w.e) trans(s8,exit.state,it.subxp,term,commandtype,w.help) trans(s9,exit.state,it.subxp,term,commandtype,w.show) trans(sa,exit.state,it.subxp,term,commandtype,w.server) trans(sb,exit.state,it.subxp,term,commandtype,w.finish) trans(sc,sc1,it.subxp,file, setfile,?) trans(sc1,sc1,it.subxp,file, setfile,?) trans(sc1,exit.state,it.subxp,term,commandtype,w.get) trans(sd,sd1,it.subxp,file,setfile,?) trans(sd1,exit.state,it.subxp,term,commandtype,w.take) trans(s10,s10a,it.subxp,dirname,setfile,?) trans(s10,exit.state,it.subxp,term,commandtype,w.setdir2) trans(s10a,exit.state,it.subxp,term,commandtype,w.setdir) trans(s11,s11a,it.subxp,anychs,setfile,?) trans(s11a,exit.state,it.subxp,term,commandtype,w.do) trans(term,exit.state,it.eol,?,0,?) trans(term,exit.state,it.char,'*E',0,?) trans(term,exit.state,it.eos,?,0,?) trans(file , exit.state, it.subxp, f4 , blank , TRUE ) trans(f4 , f1 , it.strng, ? , blank , FALSE ) trans(f4 , f2 , it.char , ':' , blank , FALSE ) trans(f4 , f3 , it.char , '-' , blank , FALSE ) trans(f1 , f2 , it.char , ':' , 0 , ? ) trans(f1 , f3 , it.lamda, ? , 0 , ? ) trans(f2 , f3 , it.strng, ? , 0 , ? ) trans(f2 , f3 , it.char , '-' , 0 , ? ) trans(f3 , f2 , it.char , '.' , 0 , ? ) trans(f3 , f3 , it.char , '-' , 0 , ? ) trans(f3 , f3 , it.strng, ? , 0 , ? ) trans(f3 , exit.state, it.lamda, ? , 0 , ? ) trans(dirname,exit.state, it.subxp, f5 , blank , TRUE ) trans(f5 , f6 , it.strng, ? , blank , FALSE ) trans(f5 , f7 , it.char , ':' , blank , FALSE ) trans(f5 , f8 , it.char , '-' , blank , FALSE ) trans(f5 , exit.state, it.char , '.' , 0 , ? ) trans(f6 , f7 , it.char , ':' , 0 , ? ) trans(f6 , f8 , it.lamda, ? , 0 , ? ) trans(f7 , f8 , it.strng, ? , 0 , ? ) trans(f7 , f8 , it.char , '-' , 0 , ? ) trans(f7 , exit.state, it.lamda, ? , 0 , ? ) trans(f8 , f2 , it.char , '.' , 0 , ? ) trans(f8 , f3 , it.char , '-' , 0 , ? ) trans(f8 , f3 , it.strng, ? , 0 , ? ) trans(f8 , exit.state, it.lamda, ? , 0 , ? ) trans(anychs, anychs , it.any , ? , 0 , ? ) trans(anychs, exit.state, it.lamda, ? , 0 , ? ) $) AND debug.rtn(f,t) BE RETURN AND parse.rdch() = VALOF $( LET r = ? IF cptr > cbuf%0 THEN RESULTIS endstreamch r := cbuf%cptr cptr := cptr+1 RESULTIS r $) AND do.parse() = VALOF $( LET c.delay = remote.delay LET c.escchr = escchr LET c.r = VEC p.upb LET c.s = VEC p.upb LET c.image = image LET c.rep = reporting LET r1 = ? copyvec(@r.packet.length,c.r,p.upb) copyvec(@s.packet.length,c.s,p.upb) FOR i = 0 TO maxfiles-1 DO argv!i := 0 numfiles := 0 argvp := maxfiles r1 := parse(s1,parse.rdch,f.bsupp,debug.rtn) UNLESS r1 DO $( remote.delay := c.delay escchr := c.escchr copyvec(c.r,@r.packet.length,p.upb) copyvec(c.s,@s.packet.length,p.upb) image := c.image reporting := c.rep $) RESULTIS r1 $) AND readline(b) BE $( LET l = 0 LET ch = ? $( ch := rdch() IF ch = endstreamch THEN BREAK $( l := l+1 b%l := ch $) $) REPEATUNTIL (ch = '*N') | (ch = '*E') b%0 := l $) AND findcoh() = VALOF $( LET ttab = rtn.tasktab ! rootnode LET csegl = tcb.seglist ! (ttab ! task.consolehandler) LET task = 0 LET mine = consoletask MANIFEST $( cg = ug ; in.id = cg+4 ; out.id = cg+5 $) $( FOR j = 1 TO ttab ! 0 DO $( LET ttcb = ttab!j LET segl = ? IF ttcb = 0 LOOP segl := tcb.seglist ! ttcb IF (segl ! 3 = csegl ! 3) & (j ~= mine) & (ttcb!tcb.gbase!in.id < 0) THEN $( task := j BREAK $) $) $) RESULTIS task $) /* Find a multilink console handler */ AND findml(stname) = VALOF $( LET newcoh = ? LET coh = rootnode!rtn.tasktab!consoletask LET mlink = devicetask("MLINK:") LET r = ? IF mlink = 0 THEN $( writes("Can't find multilink*N") RESULTIS 0 $) r := sendpkt(notinuse,mlink,act.connect,?,?,stname) IF r = 0 THEN RESULTIS 0 sendpkt(notinuse,r,act.sc.mode,?,?,TRUE) RESULTIS r $) AND closetty() BE IF local rem.sc.mode(FALSE) AND closeml() BE IF local $( LET mlink = devicetask("MLINK:") sendpkt(notinuse,mlink,act.disconnect) $) AND rem.sc.mode(m) BE sendpkt(notinuse,remfd,act.sc.mode,?,?,m) AND loc.sc.mode(m) BE sendpkt(notinuse,consoletask,act.sc.mode,?,?,m) AND message(m,n) BE FOR i = 0 TO n-1 DO wrch(m%i) ******************************************************************************** // This file is the second (and last) TRIPOS Kermit source file // // // Header for TRIPOS CLI and some commands. // (e.g. C, SPOOL, STACK, etc.) MANIFEST $( return.severe = 20 return.hard = 10 return.soft = 5 return.ok = 0 flag.break = 1 flag.commbreak = 2 cli.module.gn = 149 cli.initialstack = 1000 cli.initialfaillevel = return.hard $) GLOBAL $( cli.init: 133 cli.result2: 134 cli.setname: 135 cli.commanddir: 136 cli.returncode: 137 cli.commandname: 138 cli.faillevel: 139 cli.prompt: 140 cli.standardinput: 141 cli.currentinput: 142 cli.commandfile: 143 cli.interactive: 144 cli.background: 145 cli.currentoutput: 146 cli.defaultstack: 147 cli.standardoutput:148 cli.module: 149 $) ---------------------------------------- sys:g.iohdr /*********************************************************************** ** (C) Copyright 1980 TRIPOS Research Group ** ** University of Cambridge Computer Laboratory ** ************************************************************************ ######## ###### ## ## ###### ####### ######## ######## ## ## ####### ######## ## ## ## ## ## ## ## ## ## ## ## ## ######## ## ## ######## ## ## ## ## ## ## ## ####### ## ## ## ## ## ## ## ## ## ######## ######## ## ## ####### ## ## ######## ###### ## ## ###### ## ## ************************************************************************ ** ** ***********************************************************************/ || TRIPOS Input/Output header. MANIFEST $( || General actions. Act.Dummy =1000 Act.Read =1001 Act.Write =1002 Act.Seek =1008 Act.EndInput =1003 Act.EndOutput =1004 Act.Findinput =1005 Act.Findoutput =1006 Act.End =1007 Act.Writetrack =1009 Act.Readtrack =1010 Act.Print =1011 Act.Abortp =1012 Act.Format =1020 Act.Tape =1021 // VDU handling Act.Vdu = 992 Act.SetVdu = 993 // Single character I/O through terminal handlers Act.sc.mode = 994 Act.sc.read = 995 Act.sc.write = 996 Act.sc.msg = 997 act.self.immolation = 998 // Console interface to driver act.ttyin = 999 act.ttyout = 1000 || Mag tape act.offline =1007 act.wreof =1008 act.spacefw =1009 act.spacerv =1010 act.wreig =1011 act.rewind =1012 || Device packet offset manifests. || Common: Pkt.Action =Pkt.Type Pkt.Status =Pkt.Res1 Pkt.Status2 =Pkt.Res2 || Timer: Pkt.Time1 =Pkt.Res1 Pkt.Time2 =Pkt.Res2 Pkt.Delay =Pkt.Arg1 || Disc & MT drivers: Pkt.BuffAddr =Pkt.Arg1 Pkt.WordCount =Pkt.Arg2 Pkt.Drive =Pkt.Arg3 Pkt.Unit =Pkt.Drive Pkt.Cylinder =Pkt.Arg4 Pkt.Surface =Pkt.Arg5 Pkt.Sector =Pkt.Arg6 || Stream control block. Id.InScb =['S'< tbuf+tbufsize THEN $( result2 := err.no.workspace longjump(ex.p,ex.l) $) tbuftop := ntop RESULTIS r $) LET istat(n) = VALOF $( IF tbuf ~= 0 THEN $( result2 := err.initialised RESULTIS FALSE $) tbuf := getvec(n) tbufsize := n tbuftop := tbuf lbuf := 0 lbufptr := 1 flags := 0 statevec := getblk(9) FOR i = 0 TO 9 DO statevec!i := 0 lbuf := getblk(80/bytesperword) user.rdch := 0 RESULTIS TRUE $) LET distat() = VALOF $( LET r = ? IF tbuf = 0 THEN RESULTIS 0 freevec(tbuf) r := ((tbuftop-tbuf)*100)/tbufsize tbuf := 0 RESULTIS r $) LET copystring(v) = VALOF $( LET v1 = getblk((v%0)/4) FOR i = 0 TO v%0 DO v1%i := v%i RESULTIS v1 $) LET state(sname) = VALOF $( LET r = ? ex.p := level() ex.l := exit.l r := getblk(s.upb) add.to.q(statevec+(ABS sname REM 10),r) r!s.name := sname r!s.trns := 0 RESULTIS TRUE exit.l: RESULTIS FALSE $) LET findstate(sname) = VALOF $( LET s = statevec + (ABS sname REM 10) IF sname = exit.state THEN RESULTIS exit.state UNTIL s = 0 DO $( IF sname = s!s.name THEN RESULTIS s s := !s $) result2 := err.no.state longjump(ex.p,ex.l) RESULTIS 0 $) LET trans(sname,tname,itype,v,action,id) = VALOF $( LET tvec,s = ?,? LET blkl = ? ex.p := level() ex.l := exit.l blkl := (itype=it.key)|(itype=it.char)|(itype=it.subxp) ->t.upb,t.upb-1 tvec := getblk(blkl) s := findstate(sname) add.to.q(s+s.trns,tvec) tvec!t.dest := tname tvec!t.type := itype IF itype = it.key THEN v := copystring(v) tvec!t.val := v tvec!t.act := action tvec!t.id := id RESULTIS TRUE exit.l: RESULTIS FALSE $) LET readnumber(radix) = VALOF $( LET sum, ch = 0, 0 AND neg = FALSE $( ch := capitalch(rdch()) SWITCHON ch INTO $( DEFAULT: BREAK CASE '-': neg := TRUE CASE '+': ch := rdch() BREAK CASE '*S': CASE '*T': CASE '*N': CASE '*P': $) $) REPEAT $( LET c = '0' <= ch <= '9' -> ch-'0', 'A' <= ch <= 'Z' -> ch-'A'+10 , 100 IF c >= radix DO $( unrdch() ; RESULTIS neg -> -sum,sum $) sum := sum*radix + c ch := capitalch(rdch()) $) REPEAT $) LET my.unrdch() = VALOF $( IF lbufptr = 1 THEN RESULTIS FALSE lbufptr := lbufptr-1 RESULTIS TRUE $) LET my.rdch() = VALOF $( LET ch = ? TEST lbufptr <= lbuf%0 THEN $( ch := lbuf%lbufptr lbufptr := lbufptr + 1 $) ELSE $( ch := user.rdch() UNLESS ch = endstreamch DO $( lbuf%lbufptr := ch lbuf%0 := lbufptr lbufptr := lbufptr+1 $) $) RESULTIS capitalch(ch) $) LET blank(ch) = ch = '*S' | ch = '*T' LET alpha(ch) = 'A' <= capitalch(ch) <= 'Z' LET numeric(ch) = '0' <= ch <= '9' LET alphameric(ch) = alpha(ch) | numeric(ch) LET chk.any() = VALOF $( result2 := rdch() RESULTIS (result2 ~= endstreamch) & (result2 ~= '*N') $) LET chk.alpha() = VALOF $( result2 := rdch() RESULTIS alpha(result2) $) LET chk.digit() = VALOF $( result2 := rdch() RESULTIS numeric(result2) $) LET chk.numbr() = VALOF $( LET ch = rdch() LET base = 10 TEST ch = '#' THEN $( base := 8 ch := rdch() TEST ch = 'X' THEN $( ch := rdch() TEST numeric(ch) | 'A' <= ch <= 'F' THEN $( base := 16 unrdch() $) ELSE RESULTIS FALSE $) ELSE $( TEST '0'<=ch<='7' THEN unrdch() ELSE RESULTIS FALSE $) $) ELSE $( TEST numeric(ch) THEN unrdch() ELSE RESULTIS FALSE $) result2 := readnumber(base) RESULTIS TRUE $) LET chk.dnumb() = VALOF $( LET ch = rdch() IF numeric(ch) THEN $( unrdch() result2 := readn() RESULTIS TRUE $) RESULTIS FALSE $) LET chk.strng() = VALOF $( LET lstr = 0 LET ch = rdch() UNTIL ~alphameric(ch) DO $( lstr := lstr +1 ch := rdch() $) unrdch() RESULTIS lstr ~= 0 $) LET chk.blank() = VALOF $( IF ~blank(rdch()) THEN RESULTIS FALSE UNTIL ~blank(rdch()) LOOP unrdch() RESULTIS TRUE $) LET chk.eos() = rdch() = endstreamch LET chk.eol() = rdch() = '*N' LET chk.char(c) = rdch() = capitalch(c) LET chk.key(s) = VALOF $( LET ch = ? LET r = ? FOR i = 1 TO s%0 DO $( ch := rdch() IF ch ~= capitalch(s%i) THEN RESULTIS FALSE $) r := ~alphameric(rdch()) unrdch() RESULTIS r $) LET check.input(ctrans) = VALOF $( LET succeed = ? LET lbstart = ? IF (lbuf%(lbuf%0) = '*N')&(lbufptr > lbuf%0) THEN $( lbuf%0 := 0 lbufptr := 1 newl.global := TRUE $) // // If blank suppression then do so // IF (ctrans!t.type ~= it.lamda)&((flags&f.bsupp)~=0) THEN $( $( LET ch = my.rdch() IF ~blank(ch) THEN BREAK $) REPEAT unrdch() $) lbstart := lbufptr SWITCHON ctrans!t.type INTO $( CASE it.any : succeed := chk.any() ENDCASE CASE it.alpha : succeed := chk.alpha() ENDCASE CASE it.digit : succeed := chk.digit() ENDCASE CASE it.lamda : succeed := TRUE ENDCASE CASE it.numbr : succeed := chk.numbr() ENDCASE CASE it.dnumb : succeed := chk.dnumb() ENDCASE CASE it.strng : succeed := chk.strng() ENDCASE CASE it.blank : succeed := chk.blank() ENDCASE CASE it.eos : succeed := chk.eos() ENDCASE CASE it.eol : succeed := chk.eol() ENDCASE CASE it.char : succeed := chk.char(ctrans!t.val) ENDCASE CASE it.key : succeed := chk.key(ctrans!t.val) ENDCASE CASE it.subxp : succeed := do.parse(ctrans!t.val) ENDCASE DEFAULT : result2 := err.bad.state longjump(ex.p,ex.l) $) TEST succeed THEN IF (ctrans!t.act ~= 0) THEN $( LET arg1 = lbuf LET arg2 = newl.global -> 1,lbstart LET arg3 = lbufptr - arg2 LET arg4 = result2 LET arg5 = ctrans!t.id LET arg6 = @flags succeed := (ctrans!t.act)(arg1,arg2,arg3,arg4,arg5,arg6) $) ELSE lbufptr := lbstart RESULTIS succeed $) AND do.parse(isname) = VALOF $( LET cstate = findstate(isname) LET newl.local = newl.global newl.global := FALSE UNTIL cstate = exit.state DO $( LET ctrans = ? ctrans := cstate!s.trns UNTIL ctrans = 0 DO $( IF check.input(ctrans) THEN $( LET nstate = findstate(ctrans!t.dest) IF user.debug ~=0 THEN user.debug(cstate!s.name, nstate = exit.state -> exit.state,nstate!s.name) cstate := nstate BREAK $) ctrans := !ctrans $) newl.global := newl.global | newl.local IF (ctrans = 0) THEN $( IF newl.global THEN $( result2 := err.bad.backtrack longjump(ex.p,ex.l) $) RESULTIS FALSE $) $) RESULTIS TRUE $) LET parse(isname,rdchrtn,f,drtn) = VALOF $( LET cstate,ctrans = ?,? LET succeed = ? LET sys.rdch,sys.unrdch = ?,? LET r = ? ex.l := exit.l ex.p := level() IF tbuf ~= 0 THEN $( sys.rdch := rdch sys.unrdch := unrdch flags := f user.debug := drtn newl.global := FALSE user.rdch := rdchrtn rdch := my.rdch unrdch := my.unrdch lbufptr := 1 lbuf%0 := 0 r := do.parse(isname) rdch := sys.rdch unrdch := sys.unrdch result2 := err.bad.parse RESULTIS r $) result2 := err.not.initialised RESULTIS FALSE exit.l: rdch := sys.rdch unrdch := sys.unrdch RESULTIS FALSE $)