/* SEND MODULE: this module handles all sending of data between the */ /* host and RMX system */ $compact $optimize(3) send$module: do; $INCLUDE(:INC:LTKSEL.LIT) $INCLUDE(:INC:UREAD.EXT) $INCLUDE(:INC:UWRITE.EXT) $INCLUDE(:INC:UDCTIM.EXT) $INCLUDE(:INC:NSLEEP.EXT) /* here are some global declarations for the communication module */ declare true literally '0FFH'; declare false literally '00H'; declare chrmsk literally '07FH'; declare maxtry literally '05'; declare space literally '020H'; declare cr literally '0DH'; declare lf literally '0AH'; declare null literally '00H'; declare crlf literally 'cr,lf,null'; declare eofl literally '0'; declare delete literally '07FH'; declare send$delay byte external; declare send$eol byte external; declare send$paclen byte external; declare send$padchar byte external; declare send$padding byte external; declare send$pause byte external; declare send$quote byte external; declare send$start byte external; declare send$time byte external; declare readonly literally '1'; declare writeonly literally '2'; declare rdwr literally '3'; declare noedit literally '0'; declare pksize literally '94'; declare send$packet(pksize) byte public; /* buffer for packets */ declare recv$packet(pksize) byte public; /* buffer for packets */ declare send_delay word; declare state byte; /* FSM last state */ declare msgnum byte; /* message number */ declare tries byte; /* max number of retries */ declare numpads byte; /* how many pads to send */ declare padchar byte; /* the present pad character */ declare eol byte; /* the present eol character */ declare quote byte; /* the present quote character */ declare timeint byte; /* the present time out */ declare spsize byte; /* the present packet size */ declare pklen word; declare (j,count) word initial (0,0); declare (k,cnt) word initial (0,0); declare buflen literally '128'; declare inbuf (buflen) byte; declare outbuf(buflen) byte; declare outlen word initial (0); declare (in$conn,out$conn) token external; declare (ci$conn,co$conn) token external; declare status word external; declare debug byte external; declare file$conn token external; declare iobuff(1024) byte external; declare file$len (2) word external; declare byte$out dword; declare byte$tot dword at (@file$len); declare frac$tot word; declare filename structure (len byte, name(80) byte) external; declare wait$time byte public; declare system$end$time dword public; declare time$buffer structure (system$time dword, date(8) byte, time(8) byte); /* here are the subroutines */ check$error: procedure (fatal) byte external; declare fatal byte; end check$error; co: procedure(char) external; declare char byte; end co; prints: procedure(msg) external; declare msg pointer; end prints; print: procedure(string) external; declare string pointer; end print; nout: procedure(n) external; declare n word; end nout; noutd: procedure(n) external; declare n dword; end noutd; file$open: procedure (mode) external; declare mode byte; end file$open; newline: procedure external; end newline; /* TOCHAR: takes a character and converts it to a printable character */ /* by adding a space */ tochar: procedure(char) byte public; declare char byte; return (char + space); end tochar; /* UNCHAR: undoes 'tochar' */ unchar: procedure(char) byte public; declare char byte; return (char - space); end unchar; /* CTL: this routine takes a character and toggles the control bit */ /* (ie. ^A becomes A and A becomes ^A). */ ctl: procedure(char) byte public; declare char byte; declare cntrlbit literally '040H'; return (char xor cntrlbit); end ctl; getc: procedure (conn) byte public; declare conn token; if debug then call print(@('Entering getc...',crlf)); k=k+1; loop: if k>=cnt then do; cnt=DQ$READ(conn,@inbuf,buflen,@status); if check$error(0) then wait$time = 0; k=0; if debug then call print(@('back from reading...',crlf)); if cnt=0 then call chk$time; if wait$time=0 then return 0; if debug then call print(@('looping back to read again',crlf)); goto loop; end; return inbuf(k); end getc; putc: procedure (c, conn) public; declare c byte; declare conn token; outbuf(outlen)=c; outlen=outlen+1; if outlen>=buflen then call do$put(conn); end putc; do$put: procedure (conn) public; declare conn token; if outlen>0 then do; call DQ$WRITE(conn,@outbuf,outlen,@status); if check$error(0) then return; outlen=0; end; end do$put; set$end$time: procedure (wait) public; declare wait byte; time$buffer.system$time=0; call DQ$DECODE$TIME(@time$buffer,@status); if check$error(1) then return; wait$time=wait; system$end$time=time$buffer.system$time + double(double(wait)); if debug then do; call print(@('wait_time=',null)); call nout(wait$time); call print(@(' from end_time=',null)); call noutd(system$end$time); call print(@(' and now_time=',null)); call noutd(time$buffer.system$time); call newline; end; end set$end$time; chk$time: procedure public; if debug then call print(@(' enter chk_time...',crlf)); call RQ$SLEEP(10,@status); /* add wait a little? */ if check$error(1) then return; time$buffer.system$time=0; call DQ$DECODE$TIME(@time$buffer,@status); if check$error(1) then return; if time$buffer.system$time>system$end$time then wait$time=0; else wait$time=system$end$time-time$buffer.system$time; if debug then do; call print(@('wait_time=',null)); call nout(wait$time); call print(@(' from end_time=',null)); call noutd(system$end$time); call print(@(' and now_time=',null)); call noutd(time$buffer.system$time); call newline; end; return; end chk$time; spar: procedure (a) public; declare a address; declare b based a byte; b = tochar(send$paclen); /* set up header */ a = a + 1; b = tochar(send$time); a = a + 1; b = tochar(send$padding); a = a + 1; b = ctl(send$padchar); a = a + 1; b = tochar(send$eol); a = a + 1; b = send$quote; end spar; rpar: procedure (addr) public; declare addr address; declare item based addr byte; spsize = unchar(item); /* isn't plm wonderful? */ addr = addr + 1; timeint = unchar(item); addr = addr + 1; numpads = unchar(item); addr = addr + 1; padchar = ctl(item); addr = addr + 1; eol = unchar(item); addr = addr + 1; quote = item; end rpar; bufill: procedure (packet) byte; declare packet address; declare (pp, maxpp) address; declare done byte; declare chr based pp byte; declare i word; done = false; pp = packet; maxpp = pp + spsize - 8; do while not done; if j>=count then do; count = DQ$READ(file$conn,@iobuff,512,@status); if status > 0 then do; call print(@('Error reading file',crlf)); if check$error(0) then return 0; end; if count = 0 then done = true; j=0; end; else do; do i=j to count-1; if ((iobuff(i) and chrmsk) < space) or ((iobuff(i) and chrmsk) = delete) then do; chr = quote; pp = pp + 1; chr = ctl(iobuff(i)); end; else if (iobuff(i) and chrmsk) = quote then do; chr = quote; pp = pp + 1; chr = iobuff(i); end; else chr = iobuff(i); pp = pp + 1; byte$out=byte$out+1; if pp >= maxpp then do; j = i+1; return (pp-packet); end; end; j=count+1; end; end; return (pp - packet); end bufill; /* SPACK: this routine sends a packet of data to the host, it takes */ /* four parameters, the type of packet, message number, packet length */ /* and a pointer to a buffer containing what is to be output. It does */ /* not return a value. */ spack: procedure(type, pknum, length, packet) public; declare (type, pknum, length) byte; declare packet address; declare char based packet byte; declare (i, chksum) byte; if debug then do; call print(@('Sending packet ',null)); call nout(pknum); call newline; end; i = 1; /* do padding */ do while (i <= numpads); call putc(padchar, out$conn); i = i + 1; end; chksum = 0; /* send the packet header */ call putc(send$start, out$conn); /* send packet marker (soh) */ if debug then call co('s'); i = tochar(length + 3); chksum = i; call putc(i, out$conn); /* send character count */ if debug then call co('c'); i = tochar(pknum); chksum = chksum + i; /* add in packet number */ call putc(i, out$conn); /* send packet number */ if debug then call co('n'); chksum = chksum + type; /* add in packet type */ call putc(type, out$conn); /* send the packet type */ if debug then call co(type); /* now send the data */ do i = 1 to length; chksum = chksum + char; call putc(char, out$conn); if debug then call co(char); packet = packet + 1; end; /* check sum generation */ chksum = ((chksum + (chksum and 192) / 64) and 63); chksum = tochar(chksum); call putc(chksum, out$conn); /* send the chksum */ if debug then call co('c'); call putc(eol, out$conn); /* terminate the packet */ if debug then do; call co('e'); call newline; end; call do$put(out$conn); end spack; /* RPACK: this routine receives a packet from the host. It takes three */ /* parameters: the address of where to put the length of the packet, */ /* the address of where to put the packet number and the address of the */ /* buffer to recieve the data. It returns true for a positive reply or */ /* false for a NEGative reply. */ rpack: procedure(length, pknum, packet) byte public; declare (length, pknum, packet, pkptr) address; declare len based length byte; declare num based pknum byte; declare pk based pkptr byte; declare (i, index, chksum, hischksum, type, inchar, msglen) byte; declare buffer(128) byte; if debug then call print(@('rpack | ',null)); inchar = 0; /* wait for a header */ call set$end$time(send$time); do while inchar <> send$start; inchar = getc(in$conn); if wait$time=0 then return 'N'; end; index = 0; call set$end$time(send$time); inchar = getc(in$conn); if wait$time=0 then return 'N'; do while (inchar <> send$eol); buffer(index) = inchar; index = index + 1; inchar = getc(in$conn); if wait$time=0 then return 'N'; end; buffer(index) = null; if debug then do; call print(@('Received packet: [',null)); call print(@buffer); call print(@(']',cr,lf,'Length of message: ',null)); end; msglen = index - 1; if debug then do; call nout(msglen); call newline; call print(@('Length field: ',null)); call nout(buffer(0)); call co('_'); end; len = unchar(buffer(0)-3); if debug then do; call nout(len); call print(@(cr,lf,'Message number: ',null)); call nout(buffer(1)); call co('_'); end; num = unchar(buffer(1)); if debug then do; call nout(num); call print(@(cr,lf,'Type: ',null)); end; type = buffer(2); if debug then do; call co(type); call newline; end; /* debug */ pkptr = packet; chksum = buffer(0) + buffer(1) + buffer(2); i = 3; /* index of first data character */ do while (i < msglen); chksum = (pk := buffer(i)) + chksum; pkptr = pkptr+1; i = i + 1; end; pk = null; /* terminate with null for printing */ pkptr = packet; chksum = (chksum + ((chksum and 192) / 64)) and 63; if debug then do; call print(@('His checksum: ',null)); call nout(buffer(msglen)); call co('_'); end; /* debug */ hischksum = unchar(buffer(msglen)); if debug then do; call nout(hischksum); call print(@(cr,lf,'Our checksum: ',null)); call nout(chksum); call newline; end; /* debug */ if chksum = hischksum then do; if debug then call co('.'); if type='E' then do; if len>0 then call print(@pk); end; return type; end; call print(@('Bad checksum received', crlf)); len=0; return 'E'; end rpack; /* SDATA: this routine sends the data from the buffer area to the host. */ /* It takes no parameters but returns the next state depending on the */ /* type of acknowledgement. */ sdata: procedure byte; declare (num, length, retc) byte; if debug then call print(@('sdata...',crlf)); if tries > maxtry then return 'A'; else tries = tries + 1; call spack('D', msgnum, pklen, .send$packet); retc = rpack(.length, .num, .recv$packet); if (retc = 'N') then return state; if (retc <> 'Y') then return 'A'; /* here when good acknowledgement */ tries = 0; msgnum = (msgnum + 1) mod 64; pklen = bufill(.send$packet); frac$tot=(byte$out*100)/byte$tot; call print(@('output ',null)); call noutd(byte$out); call print(@(' bytes = ',null)); call nout(frac$tot); call print(@('%',cr,null)); if pklen > 0 then return 'D'; else return 'Z'; end sdata; /* SFILE: this routine sends a packet to the host which contains the */ /* filename of the file being sent so that the file can be created at */ /* the host end. It returns a new state depending on the nature of the */ /* the hosts acknowledgement. */ sfile: procedure byte; declare (num, length, retc) byte; declare fnptr address; declare fnindex based fnptr byte; if debug then call print(@('sfile...',crlf)); if tries > maxtry then return 'A'; else tries = tries + 1; if debug then call print(@(cr,lf,'Filename is: ',null)); call prints(@filename); call newline; if debug then do; call print(@(cr,lf,'length is: ',null)); call nout(length); call newline; end; /* debug */ call spack('F', msgnum, filename.len,.filename.name); retc = rpack(.length, .num, .recv$packet); if (retc = 'N') then return state; if (retc <> 'Y') then return 'A'; /* here on valid acknowledgement */ tries = 0; msgnum = (msgnum + 1) mod 64; pklen = bufill(.send$packet); if debug then call nout(pklen); if debug then call newline; if pklen > 0 then return 'D'; else return 'Z'; end sfile; /* SEOF: this routine is used when eof is detected, it closes up and */ /* returns the new state as usual. */ seof: procedure byte; declare (num, length, retc) byte; if debug then call print(@('seof...',crlf)); if tries > maxtry then return 'A'; else tries = tries + 1; call spack('Z', msgnum, 0, .send$packet); retc = rpack(.length, .num, .recv$packet); if (retc = 'N') then return state; if (retc <> 'Y') then return 'A'; /* here on valid acknowledgement */ byte$out=0; tries = 0; /* here is where you open next file if wildcard spec. */ filename.len=0; msgnum = (msgnum + 1) mod 64; if filename.len=0 then return 'B'; else do; call file$open(1); return 'S'; end; end seof; /* SINIT: this routine does initialisations and opens the file to be */ /* send, it returns a new state depending on the outcome of trying to */ /* open the file. */ sinit: procedure byte; declare (len, num, retc) byte; call print(@(cr,lf,'Sending ',null)); if tries > maxtry then return 'A'; else tries = tries + 1; call spar(.send$packet); call spack('S', msgnum, 6, .send$packet); /* send start packet */ retc = rpack(.len, .num, .recv$packet); if (retc = 'N') then return state; if (retc <> 'Y') then return 'A'; /* here on valid acknowledgement */ call rpar(.recv$packet); if eol = 0 then eol = send$eol; if quote = 0 then quote = send$quote; byte$out=0; tries = 0; msgnum = (msgnum + 1) mod 64; return 'F'; end sinit; /* SBREAK: this module breaks the flow of control at the end of a */ /* transmission and allows the send routine to terminate by returning */ /* either a successful or failure condition to the main kermit routine. */ sbreak: procedure byte public; declare (num, length, retc) byte; if debug then call print(@('sbreak...',crlf)); if tries > maxtry then return 'A'; else tries = tries + 1; call spack('B', msgnum, 0, .send$packet); retc = rpack(.length, .num, .recv$packet); if (retc = 'N') then return state; if (retc <> 'Y') then return 'A'; /* we only get here if we received a valid acknowledgement */ tries = 0; msgnum = (msgnum + 1) mod 64; return 'C'; end sbreak; /* serror: this module sends an error packet to abort the transmittion */ serror: procedure byte; declare (num, length, retc) byte; if debug then call print(@('serror...',crlf)); if tries > maxtry then return 'A'; else tries = tries + 1; call spack('B', msgnum, 0, .send$packet); retc = rpack(.length, .num, .recv$packet); if (retc = 'N') then return state; if (retc <> 'Y') then return 'A'; /* we only get here if we received a valid acknowledgement */ tries = 0; msgnum = (msgnum + 1) mod 64; return 'A'; end serror; send$setup: procedure public; msgnum = 0; tries = 0; spsize = send$paclen; timeint = send$time; numpads = send$padding; padchar = send$padchar; eol = send$eol; quote = send$quote; end send$setup; /* SEND: here's the main code for the send command, it's a FSM for */ /* sending files. The main loop calles various routines until it */ /* finishes or an error occurs; this is signified by a true or false */ /* result being returned to the main 'kermit' routine. */ send: procedure byte public; state = 'S'; /* start in Send-Init state */ call send$setup; send_delay=double(send$delay)*100; if co$conn=out$conn then call RQ$SLEEP(send_delay,@status); do while true; if debug then do; call print(@('state : ',null)); call co(state); call newline; end; if state = 'D' then state = sdata; else if state = 'F' then state = sfile; else if state = 'Z' then state = seof; else if state = 'S' then state = sinit; else if state = 'B' then state = sbreak; else if state = 'C' then return true; else if state = 'A' then return false; else if state = 'E' then return false; else return false; end; end send; end send$module;