/* RECEIVE: Routines for reading from the console and the serial ports */ $compact $optimize(3) recv$module: do; $include(:INC:LTKSEL.LIT) declare true literally '0FFH'; declare false literally '00H'; declare null literally '00'; declare cr literally '0DH'; declare lf literally '0AH'; declare crlf literally 'cr,lf,null'; declare myquote literally '023H'; declare chrmsk literally '07FH'; declare state byte; declare tries byte; declare msgnum byte; declare maxtry literally '5'; declare eol byte; declare debug byte external; declare iobuff(1024) byte external; declare status word external; declare pksize literally '94'; declare send$packet(pksize) byte external; declare recv$packet(pksize) byte external; declare count word; declare oldtry byte; declare byte$in dword; declare file$conn token external; declare filename structure (len byte, name(80) byte) external; declare qopen byte external; declare dummy byte; $include(:INC:USWBF.EXT) $include(:INC:UGTARG.EXT) check$error: procedure(mode) byte external; declare mode byte; end check$error; file$open: procedure(mode) external; declare mode byte; end file$open; file$close: procedure external; end file$close; co: procedure(char)external; declare char byte; end co; print: procedure(string)external; declare string pointer; end print; nout: procedure(num)external; declare num word; end nout; noutd: procedure(num)external; declare num dword; end noutd; newline: procedure external; end newline; ctl: procedure(char) byte external; declare char byte; end ctl; putc: procedure (c,conn) external; declare c byte; declare conn token; end putc; do$put: procedure (conn) external; declare conn token; end do$put; spack: procedure(type, pknum, length, packet) external; declare (type, pknum, length) byte; declare packet address; end spack; rpack: procedure(length, pknum, packet) byte external; declare (length, pknum, packet) address; end rpack; spar: procedure (a) external; declare a address; end spar; rpar: procedure (a) external; declare a address; end rpar; bufemp: procedure(packet, len); declare packet address; declare inchar based packet byte; declare (i, char, len) byte; if debug then call print(@('Writing to disk...',null)); i = 0; do while (i < len); char = inchar; if char = myquote then do; packet = packet + 1; i = i + 1; char = inchar; if (char and chrmsk) <> myquote then char = ctl(char); end; if debug then call co(char); call putc(char,file$conn); packet = packet + 1; byte$in=byte$in+1; i = i + 1; end; if debug then call newline; call do$put(file$conn); end bufemp; rinit: procedure byte public; declare (len, num, retc) byte; if tries > maxtry then return 'A'; else tries = tries + 1; if debug then call print(@('rinit...',crlf)); retc = rpack(.len, .num, .recv$packet); if (retc <> 'S') then return state; /* here on send init received */ call rpar(.recv$packet); call spar(.send$packet); call spack('Y', msgnum, 6, .send$packet); oldtry = tries; tries = 0; byte$in=0; msgnum = (msgnum + 1) mod 64; return 'F'; end rinit; rfile: procedure byte public; declare (len, num, retc) byte; if tries > maxtry then return 'A'; else tries = tries + 1; if debug then call print(@('rfile...',crlf)); retc = rpack(.len, .num, .recv$packet); if retc = 'S' then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (num = msgnum - 1) then do; call spar(.send$packet); call spack('Y', num, 6 , .send$packet); tries = 0; return state; end; else return 'A'; end; if retc = 'Z' then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (num = msgnum - 1) then do; call spack('Y', num, 0, 0); tries = 0; return state; end; else return 'A'; end; if retc = 'F' then do; if (num <> msgnum) then return 'A'; call print(@(cr,lf,'Receiving ',null)); call print(@recv$packet); call newline; if not qopen then do; dummy=DQ$SWITCH$BUFFER(@recv$packet,@status); if check$error(0) then return 'A'; dummy=DQ$GET$ARGUMENT(@filename,@status); if check$error(0) then return 'A'; call file$open(2); end; if not qopen then return 'A'; call spack('Y', msgnum, 0, 0); oldtry = tries; tries = 0; msgnum = (msgnum + 1) mod 64; return 'D'; end; if retc = 'B' then do; if (num <> msgnum) then return 'A'; call spack('Y', msgnum, 0, 0); return 'C'; end; return state; end rfile; rdata: procedure byte public; declare (num, len, retc) byte; if tries > maxtry then return 'A'; else tries = tries + 1; if debug then call print(@('rdata...',crlf)); retc = rpack(.len, .num, .recv$packet); if retc = 'D' then do; if (num <> msgnum) then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (num = msgnum - 1) then do; call spar(.send$packet); call spack('Y', num, 6, .send$packet); tries = 0; return state; end; else return 'A'; end; call bufemp(.recv$packet, len); call spack('Y', msgnum, 0, 0); oldtry = tries; tries = 0; call print(@('recieved ',null)); call noutd(byte$in); call print(@(' bytes ',cr,null)); msgnum = (msgnum + 1) mod 64; return 'D'; end; if retc = 'F' then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (num = msgnum - 1) then do; call spack('Y', num, 0, 0); tries = 0; return state; end; else return 'A'; end; if retc = 'Z' then do; if (num <> msgnum) then return 'A'; call spack('Y', msgnum, 0, 0); call file$close; msgnum = (msgnum + 1) mod 64; return 'F'; end; call spack('N', msgnum, 0, 0); return state; end rdata; recv$setup: procedure public; state = 'R'; msgnum = 0; tries = 0; oldtry = 0; end recv$setup; recv: procedure byte public; if debug then call print(@('Receive a file',crlf)); call recv$setup; do while true; if state = 'D' then state = rdata; else if state = 'F' then state = rfile; else if state = 'R' then state = rinit; else if state = 'C' then return true; else return false; end; end recv; end recv$module;