/* RECEIVE: Routines for reading from the console and the serial ports */ recv$module: do; declare true literally '0FFH'; declare false literally '00H'; declare port1dat literally '0F4H'; declare port1cmd literally '0F5H'; declare port2dat literally '0F6H'; declare port2cmd literally '0F7H'; declare rx$rdy literally '02H'; 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 writeonly literally '2'; declare noedit literally '0'; declare state byte; declare tries byte; declare msgnum byte; declare maxtry literally '5'; declare eol byte; declare port byte external; declare driver byte external; declare debug byte external; declare pksize literally '94'; declare packet(pksize) byte external; declare (jfn, count, status) address; declare oldtry byte; ci: procedure byte external; end ci; csts: procedure byte external; end csts; co: procedure(char)external; declare char byte; end co; print: procedure(string)external; declare string address; end print; nout: procedure(num)external; declare num address; end nout; newline: procedure external; end newline; open: procedure(jfn, file, access, mode, status) external; declare (jfn, file, access, mode, status) address; end open; write: procedure(jfn, buffer, count, status) external; declare (jfn, buffer, count, status) address; end write; close: procedure(jfn, status) external; declare (jfn, status) address; end close; exit: procedure external; end exit; getc: procedure(port) byte external; declare port byte; end getc; ctl: procedure(char) byte external; declare char byte; end ctl; spack: procedure(type, pknum, length, packet) external; declare (type, pknum, length, 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; ready: procedure (port) byte public; declare (port, status) byte; do case port; do; status = csts; end; do; status = input(port1cmd) and rx$rdy; end; do; status = input(port2cmd) and rx$rdy; end; end; return status; end ready; 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 write(jfn, .char, 1, .status); if status > 0 then do; call print(.('Write error ',null)); call nout(status); call newline; call exit; end; packet = packet + 1; i = i + 1; end; if debug then call newline; end bufemp; rinit: procedure byte; 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, .packet); if (retc <> 'S') then return state; /* here on send init received */ call rpar(.packet); call spar(.packet); call spack('Y', msgnum, 6, .packet); oldtry = tries; tries = 0; msgnum = (msgnum + 1) mod 64; return 'F'; end rinit; /* to insert dirver address infront of filename */ insert : procedure(c,length); declare (index,c,length) byte ; index = length; do while (index <> 0FFH); packet(index + 4) = packet(index); index = index - 1 ; end; packet(0) = ':'; packet(1) = 'F'; packet(2) = c ; packet(3) = ':'; length = length + 4; end insert; rfile: procedure byte; 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, .packet); if retc = 'S' then do; if (oldtry > maxtry) then return 'A'; else oldtry = oldtry + 1; if (num = msgnum - 1) then do; call spar(.packet); call spack('Y', num, 6 , .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(.packet); call newline; if len > 10 then do; call print(.('*** error **** $')); call print(.('received filename has more than 6 characters',crlf)); return('A') ; end; if (driver < 5 ) then do; do case driver; ; /* driver = 0 */ call insert('1',len); /* driver 1 */ call insert('2',len); /* driver 2 */ call insert('3',len); /* driver 3 */ call insert('4',len); /* driver 4 */ end ; end; else do; call print(.('disk driver number : 0|1|2|3|4 ',crlf)); return ('A') ; end; call open(.jfn, .packet, writeonly, noedit, .status); if status > 0 then do; call print (.('Unable to create file, error ', null)); call nout(status); call newline; return 'A'; end; 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; 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, .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(.packet); call spack('Y', num, 6, .packet); tries = 0; return state; end; else return 'A'; end; call bufemp(.packet, len); call spack('Y', msgnum, 0, 0); oldtry = tries; tries = 0; 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 close(jfn, .status); if status > 0 then call print(.(cr,lf,'Unable to close file',null)); msgnum = (msgnum + 1) mod 64; return 'F'; end; return state; end rdata; recv: procedure byte public; if debug then call print(.('Receive a file',crlf)); state = 'R'; msgnum = 0; tries = 0; oldtry = 0; 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; /* to receive a file from VAX when command GET is used */ getrecv: procedure byte public; if debug then call print(.('Receive a file',crlf)); state = 'F'; msgnum = 1; tries = 0; oldtry = 0; 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 ('W'); else return false; end; end getrecv; end recv$module;