# -->> FILE RATDEF #========== Standard Ratfor definitions ========== define(ALPHA,10100) define(AND,38) define(andif,if) define(ARB,100) define(ATSIGN,64) define(BACKSLASH,92) define(BACKSPACE,8) define(BANG,33) define(BAR,124) define(BIGA,65) define(BIGB,66) define(BIGC,67) define(BIGD,68) define(BIGE,69) define(BIGF,70) define(BIGG,71) define(BIGH,72) define(BIGI,73) define(BIGJ,74) define(BIGK,75) define(BIGL,76) define(BIGM,77) define(BIGN,78) define(BIGO,79) define(BIGP,80) define(BIGQ,81) define(BIGR,82) define(BIGS,83) define(BIGT,84) define(BIGU,85) define(BIGV,86) define(BIGW,87) define(BIGX,88) define(BIGY,89) define(BIGZ,90) define(BLANK,32) define(CARET,94) define(COLON,58) define(COMMA,44) define(DIG0,48) define(DIG1,49) define(DIG2,50) define(DIG3,51) define(DIG4,52) define(DIG5,53) define(DIG6,54) define(DIG7,55) define(DIG8,56) define(DIG9,57) define(DIGIT,2) define(DOLLAR,36) define(DQUOTE,34) define(EOF,10003) define(EOS,10002) define(EQUALS,61) define(ERR,10001) define(ERROUT,2) define(GREATER,62) define(HUGE,30000) define(LBRACE,123) define(LBRACK,91) define(LESS,60) define(LETA,97) define(LETB,98) define(LETC,99) define(LETD,100) define(LETE,101) define(LETF,102) define(LETG,103) define(LETH,104) define(LETI,105) define(LETJ,106) define(LETK,107) define(LETL,108) define(LETM,109) define(LETN,110) define(LETO,111) define(LETP,112) define(LETQ,113) define(LETR,114) define(LETS,115) define(LETT,116) define(LETTER,1) define(LETU,117) define(LETV,118) define(LETW,119) define(LETX,120) define(LETY,121) define(LETZ,122) define(LPAREN,40) define(MAXCHARS,10) define(MAXLINE,120) # typical line length define(MAXNAME,30) # typical file name size define(MINUS,45) define(NEWLINE,10) define(NO,0) define(NOERR,0) define(NOT,126) # same as tilde define(OK,-2) define(OR,BAR) # same as BAR define(PERCENT,37) define(PERIOD,46) define(PLUS,43) define(QMARK,63) define(RBRACE,125) define(RBRACK,93) define(READ,0) define(READWRITE,2) define(RPAREN,41) define(SEMICOL,59) define(SHARP,35) define(SLASH,47) define(SQUOTE,39) define(STAR,42) define(STDIN,0) define(STDOUT,1) define(STDERR,ERROUT) define(TAB,9) define(TILDE,126) define(UNDERLINE,95) define(WRITE,1) define(YES,1) define(character,integer) define(abs,iabs) define(min,min0) define(max,max0) # handy machine-dependent parameters, change for a new machine # Data General Nova and Eclipse. define(BPI,16) # bits per integer define(BPC,8) # bits per character define(CPI,2) # characters per integer define(LIMIT,32767) # largest positive integer define(LIM1,71) # maximum exponent (power of ten) define(LIM2,-71) # minimum exponent (power of ten) define(PRECISION,7) # digits accurate in real # Data General FORTRAN IV and 5 define(open,RATOPEN) # use OPEN for DGC subroutine define(close,RATCLOSE) # use CLOSE for DGC subroutine define(exit,RATEXIT) # use EXIT for DGC subroutine define(ARB,10000) # because the one above is not big enough define(comarg,RATARG) # use COMARG for DGC subroutine define(error,RATERR) # use ERROR for DGC subroutine # Data General RDOS operating system # see also the AOS parameters -- duplicate entries must be commented out define(NULL,0) # ASCII NULL character define(CR,13) # ASCII carriage return define(FF,12) # ASCII form feed define(MAXLINE,132) define(MAXNAME,50) #define(EREOF,9) # system error for end of file condition # Data General AOS operating system # see also the RDOS parameters -- duplicate entries must be commented out define(EREOF,27) # system error for end of file condition # -->> FILE KERDEF # define parameters for remote kermit # define MAXPACK 94 # Maximum packet size define SOH 1 # Start of header define SP 32 # Ascii space define DEL 127 # Delete (rubout) define MAXTRY 5 # times to retry a packet define MYQUOTE SHARP #Quote character I will use define MYPAD 0 # number of padding characters I will use define MYPCHAR 0 # padding character I need define MYEOL CR # end of line character I need define TRUE -1 define FALSE 0 # -->> FILE KERCOM implicit integer (a-z) common /ker/ n,rpsiz,spsiz,pad,numtry,oldtry, fd,rmtinfd,rmtoutfd,state,padchar, eol,eschar,quote,filnam(MAXLINE),recpkt(MAXPACK), packet(MAXPACK),size,morefd,ibm,host, localinfd,localoutfd,speed # -->> FILE KERMIT.RF # KERMIT - This is a D.G. AOS version of a gerenal KERMIT version 1, # - it supports both local and remote mode with the connect # - feature, IBM flags is also supported. This program does # - not have all the critical function like set SET BAUD RATE # - and set PARITY because of the local area network which # - handle the conversion. This AOS-KERMIT is a simplify # - VERSION which handles all the necessary function to do # - file transfer with other KEMRIT. Credit should be given to # - Fred Brehm who installed RATFOR translator onto D.G. machines # - for RCA and it make my implemntation of AOS-KERMIT from the # - C listing found in the PROTOCOL manual much simplier. # - Permission is granted to any individual or institution to copy # - or use this program, except for explicitly commercial purpose. # # # include ratdef include mdef include kerdef include kercom define(APPEND,3) # integer resw,x,status,getlin,temp,aopen,aone,bone,a1,z1 integer atwo,findln integer flag1,flag2,flag3,flag4,flag5,flag6,flag7,flag8,flag9 integer bell # character alin(MAXLINE) character blin(MAXLINE) character dlin(MAXLINE) character slin(MAXLINE) # character apat(MAXPAT) character bpat(MAXPAT) character cpat(MAXPAT) character dpat(MAXPAT) character epat(MAXPAT) character fpat(MAXPAT) character gpat(MAXPAT) character hpat(MAXPAT) character ipat(MAXPAT) # string xrec "RECEIVE" string con "@CONSOLE" string con4 "@CON4" string con11 "@CON11" string ssend "SEND" string help "HELP" string sexit "EXIT" string quit "QUIT" string stat "STATUS" string ibmon "SET IBM ON" string ibmoff "SET IBM OFF" string helpfile "HELP_KERMIT" string value " local off # 94 ^M @con " string morefile "morefile" string sconnect "CONNECT" # call stdopen morefd=-1 state=BIGC bell='' ibm=FALSE host=TRUE aone=1 bone=1 atwo=2 # open terminal for I/O; this is the terminal one used in activiated KERMIT localinfd=aopen(con,READ) if(localinfd==ERR)call cant(con) localoutfd=aopen(con,APPEND) if(localoutfd==ERR)call cant(con) # call scopy(help,aone,apat,bone) call scopy(sexit,aone,bpat,bone) call scopy(quit,aone,cpat,bone) call scopy(stat,aone,dpat,bone) call scopy(ibmon,aone,epat,bone) call scopy(ibmoff,aone,fpat,bone) call scopy(ssend,aone,gpat,bone) call scopy(xrec,aone,hpat,bone) call scopy(sconnect,aone,ipat,bone) call scopy(value,aone,slin,bone) # # local KERMIT mode mean you are using your computer to dial out to other # system and logged into to that system in order to activated the remote # KERMIT # # remote KERMIT mode mean you are dialing in from other KERMIT and you are # to perform I/O using the line you are loggon under. call remark("Remote or Local KERMIT mode R/L ??") status=getlin(alin,localinfd) call upper(alin,blin) if(blin(1)==BIGR){ call remark("Remote kermit now in effect") rmtinfd=localinfd rmtoutfd=localoutfd } else if(blin(1)==BIGL){ host=FALSE call remark("Local kermit now in effect") call remark("9600 or 1200 Baud (9/1) ??") # pending on whether the user wants to use a 9600 or 1200 baud # line, open the respective TTY line for I/O status=getlin(alin,localinfd) if(alin(1)==DIG9){ # the value of speed let the TTYRAW and TTYCOOK routine which # TTY to turn echo on/off and lower/upper case coversion on/off speed=TRUE rmtinfd=aopen(con4,READ) if(rmtinfd==ERR)call cant(con4) rmtoutfd=aopen(con4,APPEND) if(rmtoutfd==ERR)call cant(con4) } else { speed=FALSE rmtinfd=aopen(con11,READ) if(rmtinfd==ERR)call cant(con11) rmtoutfd=aopen(con11,APPEND) if(rmtoutfd==ERR)call cant(con11) } } else { # the user didnot give the right answer, let him start from scratch call remark ("Unknown mode, try again") call exit } istat=YES while(istat==YES){ call wrseq(localoutfd,"KERMIT-AOS >",12,ier) fd=ERR # find out what the user wants to do status=getlin(alin,localinfd) # convert the line to upper case call upper(alin,blin) # the value of a1 is the starting point and z1 is the ending point # return from the findln subroutine # # the parsing done here is at the very basic level, nothing fancy # a1=1 flag1=findln(blin,apat,a1,z1) a1=1 flag2=findln(blin,bpat,a1,z1) a1=1 flag3=findln(blin,cpat,a1,z1) a1=1 flag4=findln(blin,dpat,a1,z1) a1=1 flag5=findln(blin,epat,a1,z1) a1=1 flag6=findln(blin,fpat,a1,z1) a1=1 flag7=findln(blin,gpat,a1,z1) a1=1 flag8=findln(blin,hpat,a1,z1) a1=1 flag9=findln(blin,ipat,a1,z1) # # parse the command # if(flag1==YES){ # user have type the "HELP" request, type out the help file temp=aopen(helpfile,READ) while((getlin(alin,temp)^=EOF))call putlin(alin,localoutfd) call close(temp) } else if((flag2==YES)|(flag3==YES)){ # user type "EXIT" or "QUIT", do it call remark("Kermit now terminated") call exit } else if(flag4==YES){ # user have type the "STATUS" request call remark(" PACKET ") call remark(" MODE IBM QUOTE SIZE EOL TTY SPEED STATE") call remark(" ") if(host==TRUE){ slin(1)=LETR slin(2)=LETE slin(3)=LETM slin(4)=LETO slin(5)=LETT slin(6)=LETE } else { slin(1)=BLANK slin(2)=LETL slin(3)=LETO slin(4)=LETC slin(5)=LETA slin(6)=LETL } if(ibm==TRUE){ slin(8)=LETO slin(9)=LETN slin(10)=BLANK slin(11)=BLANK } else { slin(8)=LETO slin(9)=LETF slin(10)=LETF slin(11)=BLANK } if(host==TRUE){ slin(33)=BLANK slin(34)=BLANK } else { if(speed==TRUE){ slin(33)=DIG4 slin(34)=BLANK slin(35)=BLANK slin(36)=DIG9 slin(37)=DIG6 slin(38)=DIG0 slin(39)=DIG0 slin(40)=BLANK } else { slin(33)=DIG1 slin(34)=DIG1 slin(35)=BLANK slin(36)=DIG1 slin(37)=DIG2 slin(38)=DIG0 slin(39)=DIG0 slin(40)=BLANK } } slin(41)=BLANK slin(42)=BLANK slin(43)=BLANK slin(44)=state slin(45)=BLANK slin(46)=BLANK slin(47)=NEWLINE slin(48)=EOS call putlin(slin,localoutfd) call remark(" ") } else if(flag5==YES){ # user type the "SET IBM ON" request if(host==TRUE){ # local kermit does not permit dial out to IBM system call remark("Not supported in host kermit mode") } else ibm=TRUE } else if(flag6==YES)ibm=FALSE else if(flag7==YES){ #user have type out the "SEND" request itemp=0 # filename by itself mean that send that one file # @filename mean each line in that filename is in turn # a file to the send over, it simulate the wildcard # feature of other system i.e. *.doc;*. call remark("enter filename or @filename") status=getlin(alin,localinfd) call remove(morefile) morefd=aopen(morefile,APPEND) if(alin(1)^=ATSIGN){ call putlin(alin,morefd) } else { call scopy(alin,atwo,dlin,aone) itemp=aopen(dlin,READ) if(itemp==ERR){ call remark("Source file not found") } else { while(getlin(alin,itemp)^=EOF)call putlin(alin,morefd) call close(itemp) } } call close(morefd) if(itemp^=ERR){ # if we are in local mode, wait 15 seconds sending # the first packet, this give the user time to get # back to the other kermit and issue the receive command if(host==TRUE)call wait(15,2,ier) # send those file(s) to the other KERMIT status=sendsw(x) # when done transmitted or error detected, ring the bell if(host==FALSE)call wrseq(localoutfd,bell,2,ier) if(host==FALSE)call remark(" ") if((status==TRUE)&(host==FALSE))call remark("COMPLETED") if((status^=TRUE)&(host==FALSE))call remark("FAILED") if(fd^=ERR)call close(fd) } } else if(flag8==YES){ # user have type the "RECEIVE" REQUEST status=recsw(x) # wait the bell when all files have been obtain or if # error have occurred if(host==FALSE)call wrseq(localoutfd,bell,2,ier) if(host==FALSE)call remark(" ") if((status==TRUE)&(host==FALSE))call remark("COMPLETED") if((status^=TRUE)&(host==FALSE))call remark("FAILED") if(fd^=ERR)call close(fd) } else if(flag9==YES){ # user have type the "CONNECT" request if(host==TRUE){ call remark("Connect is not supported in Host mode") } else { # put remote TTY into raw mode call ttyraw # from now on what ever the user type on the local # keyboard, transmit that char over to the other SYSTEM # and whatever is send from the SYSTEM, related it to # the local TTY, repeat until you see the CNTR-] char. call connect # put remote TTY back into cook mode call ttycook } } else call remark("Invalid command, please type HELP") } return end # # -->> FILE AOPEN.RF #aopen - open function for ratfor. # jl - 9/30/82 include the option open for append define(APPEND,3) include ratdef integer function aopen (name, mode) character name(ARB) integer mode include channel integer temp integer string(40), ch # build a proper filename in string temp=mode for (i = 1; name(i) == BLANK; i = i+1) ; # get rid of leading blanks for (j = 1; name(i) ^= EOS; i = i+1) { # copy to packed string byte(string,j) = name(i); j = j+1 } byte(string,j) = NULL # terminate with null # find a free channel number for (ch = 0; ch <= MAXCHNL; ch = ch+1) if (channel(ch) == ERR) break if (ch > MAXCHNL) ier = ERR # open the file in the proper mode else if(mode == APPEND){ call CFILW(string,2,ier) call OPEN(ch,string,0,ier) } else if (mode == READ) call OPEN (ch, string, 1, ier) else if (mode == WRITE | mode == READWRITE) { call CFILW (string, 2, ier) call OPEN (ch, string, 3, ier) } if(temp==APPEND)temp=WRITE if (ier ^= 1) { ch = ERR } else channel(ch) = temp return(ch) end # -->> FILE BUFEMP.RF # bufemp - write the data just receive into the receiving file # subroutine bufemp(buffer,len) include ratdef include kerdef include kercom # character buffer(1) integer ch,len,ctl # integer i,t ch=fd for(i=1;i> FILE BUFILL.RF # bufill - get a single character from the sending file # integer function bufill(buffer) include ratdef include kerdef include kercom # integer i,ctl,t,kgetch,buffer(1),ch # i=1 ch=fd while(kgetch(t,ch)>0){ if((tspsiz-8){ bufill=i-1 return } } if(i==1){ bufill=EOF return } bufill=i-1 return end # -->> FILE CANT.RF # cant - print cant open file message and die include ratdef subroutine cant(buf) integer buf(MAXLINE) call putlin(buf, ERROUT) call remark(": can't open.") call exit end # -->> FILE CHKIO.RF # chkio - check error return from getch, putch, flush i/o call include ratdef #EREOF DEFINED IN RATDEF subroutine chkio (fd, ier) integer fd, ier if (ier == 1 | ier == EREOF) return write (STDERR, 1) ier, fd 1 format(" *** error code ", i6, " from channel ", i6) return end # -->> FILE CLOSE.RF # close - close a file. include ratdef subroutine close (fd) integer fd include channel if (0 <= fd & fd <= MAXCHNL) { call flush (fd) call CLOSE (fd, ier) channel(fd) = ERR md(fd) = READWRITE } return end # -->> FILE CONNECT.RF # connect - read from local terminal and send to remote system # - if ibm flag is on, then send the same character to the # - local terminal, also read from the host and send to the # - local terminal # # subroutine connect include ratdef include kerdef include kercom # integer echar,t,status,ichar,kgetch,cq,cs # cs=011423k cq=010421k echar=29 # CNTR-] status=YES task kpick,id=3,pri=1 call remark(" typing CNTR-] causes return to KERMIT-AOS") while(status==YES){ t=kgetch(ichar,localinfd) if(t==0){ call remark("error in I/O using remote TTY") call tidk(3,ier) call wait(1,2,ier) call remark("returning to Kermit-AOS") call wrseq(rmtoutfd,cq,1,ier) return } if(ichar==echar){ call tidk(3,ier) call wait(1,2,ier) call remark("returning to Kermit-AOS") call wrseq(rmtoutfd,cq,1,ier) return } else { call kputch(ichar,rmtoutfd) if(ibm==TRUE)call kputch(ichar,localoutfd) } } return end # -->> FILE CTL.RF # toggle the control bit of a character # so that CNTR-A becaue A, and vice versa integer function ctl(ch) include ratdef include kerdef character ch # do a exclusive or on the control bit which is the seven th bit ctl=ixor(ch,100k) return end # -->> FILE EXIT.RF # exit - ratfor exit include ratdef subroutine exit include channel do i = 0, MAXCHNL; call flush (i) call EXIT end # -->> FILE FINDLN.RF #findln - this function will try to find the pattern within a line # - it also returns the value of where the pattern begins # - and where the pattern ends, a1 initially tells this # - subroutine where to start looking, the return value of # - a1 tells the calling program where the pattern begins # - and z1 tells the calling program where the pattern ends # - EOS is not counted in the z1 value when return to caller # # - return status of YES means find pattern # - return status of NO means unable to find pattern # include ratdef include mdef integer function findln(lin,apat,a1,z1) implicit integer (a-z) character lin(MAXLINE) character apat(MAXPAT) status=OK t1=a1 while(status==OK){ while((lin(t1)^=apat(1)&(lin(t1))^=EOS))t1=t1+1 if(lin(t1)==EOS)status=NO else { a1=t1 t2=1 t3=t1 flag=NO while((flag==NO)&(apat(t2)^=EOS)){ if(apat(t2)==lin(t1)){ t1=t1+1 t2=t2+1 } else flag=YES } if(apat(t2)==EOS){ z1=t1-1 status=YES } else t1=t3+1 } } findln=status return end # -->> FILE FLUSH.RF # flush - flush the write buffer for a file include ratdef subroutine flush(fd) integer fd include channel if (0 <= fd & fd <= MAXCHNL & channel(fd) ^= ERR) { if (md(fd) == WRITE & ic(fd) > 1) { byte(linebuf(1,fd),ic(fd)) = NULL call wrlin (fd, linebuf(1,fd), nc(fd), ier) call chkio (fd, ier) } ic(fd) = 1 nc(fd) = 0 } return end # -->> FILE GETCH.RF # getch - get a character from file fd. # NOTE - RDOS/AOS differences below include ratdef integer function getch (c, fd) integer c, fd include channel if (0 <= fd & fd <= MAXCHNL & channel(fd) ^= ERR) { if (md(fd) ^= READ) { md(fd) = READ; ic(fd) = 1; nc(fd) = 0 } repeat { if (nc(fd) < ic(fd)) { # fill the buffer. nc(fd) = 0 call rdlin (fd, linebuf(1,fd), nc(fd), ier) call chkio (fd, ier) ic(fd) = 1 } if (nc(fd) < ic(fd)) c = EOF # we must have hit eof! else { c = byte(linebuf(1,fd), ic(fd)) & 177k ic(fd) = ic(fd) + 1 # comment out next two lines if AOS, keep if RDOS # if (c == NEWLINE) c = NULL # change NEWLINE to NULL # else if (c == CR) c = NEWLINE # change CR to NEWLINE } } until (c == EOF | c ^= NULL) # get rid of null's } else c = EOF return (c) end # -->> FILE GETLIN.RF # getlin - get next line from f into line include ratdef integer function getlin(line, f) character line(MAXLINE), c, getch integer f for (getlin = 0; getch(c, f) ^= EOF; ) { if (c == 0) break if (getlin < MAXLINE - 1) { getlin = getlin + 1 line(getlin) = c } if (c == NEWLINE | c == FF) break } line(getlin+1) = EOS if (getlin == 0 & c == EOF) getlin = EOF return end # -->> FILE IBMGETLIN.RF # ibmgetlin - read a line from CMS with a SOH in it, and wait for the DC1 # # integer function ibmgetlin(buffer,ch) include ratdef include kerdef include kercom # character buffer(MAXLINE) integer ch,idc1,status,count,ibyte,t,getsoh # idc1=021k status=YES getsoh=NO count=1 while(status==YES){ #look for the SOH character while(getsoh==NO){ ibyte=0 call rdseq(ch,ibyte,1,ier) t=ishift(ibyte,-8) & 177k if(t==SOH){ getsoh=YES buffer(count)=t count=count+1 } } # look for the dc1, otherwise put everything else into buffer ibyte=0 call rdseq(ch,ibyte,1,ier) t=ishift(ibyte,-8) & 177k if(t==idc1)status=NO else { buffer(count)=t count=count+1 } } buffer(count)=EOS return end # -->> FILE ITOC.RF # itoc - convert integer int to char string in str include ratdef define(abs,iabs) integer function itoc(int, str, size) integer abs, mod integer i, int, intval, j, k, size character str(ARB) intval = abs(int) str(1) = EOS i = 1 repeat { # generate digits i = i + 1 str(i) = DIG0 + mod(intval,10) intval = intval / 10 } until (intval == 0 | i >= size) if (int < 0 & i < size) { # then sign i = i + 1 str(i) = MINUS } itoc = i - 1 for (j = 1; j < i; j = j + 1) { # then reverse k = str(i) str(i) = str(j) str(j) = k i = i - 1 } return end # -->> FILE KGETCH.RF # get a single character from a file # integer function kgetch(t,chan) integer t,chan,x,ier call rdseq(chan,x,1,ier) if(ier.ne.1)goto 100 t=ishift(x,-8).and. 177k kgetch=1 return 100 continue kgetch=0 return end # -->> FILE KPICK.RF # kpick - read a character from the host and send it to the local # - terminal port # # subroutine kpick include ratdef include kerdef include kercom integer ibyte,status,cs,cq,count character alin(MAXLINE) cs=011423k cq=010421k status=YES if(ibm==FALSE){ while(status==YES){ call rdlin(rmtinfd,alin,count,ier) call wrseq(rmtoutfd,cs,1,ier) call wrseq(localoutfd,alin,count,ier) call wrseq(rmtoutfd,cq,1,ier) } } else { while(status==YES){ call rdseq(rmtinfd,ibyte,1,ier) call wrseq(localoutfd,ibyte,1,ier) } } return end # -->> FILE KPUTCH.RF # put a single character into the receiving file # subroutine kputch(t,chan) include ratdef character t integer ch,ier,x x=ishift(t,8) call wrseq(chan,x,1,ier) if(ier.ne.1)type "error in kputch ",ier return end # -->> FILE LENGTH.RF # length - compute length of string include ratdef integer function length(str) integer str(ARB) for (length = 0; str(length+1) ^= EOS; length = length + 1) ; return end # -->> FILE OPEN.RF # open - open function for ratfor. include ratdef integer function open (name, mode) character name(ARB) integer mode include channel integer string(40), ch # build a proper filename in string for (i = 1; name(i) == BLANK; i = i+1) ; # get rid of leading blanks for (j = 1; name(i) ^= EOS; i = i+1) { # copy to packed string byte(string,j) = name(i); j = j+1 } byte(string,j) = NULL # terminate with null # find a free channel number for (ch = 0; ch <= MAXCHNL; ch = ch+1) if (channel(ch) == ERR) break if (ch > MAXCHNL) ier = ERR # open the file in the proper mode else if (mode == READ) call OPEN (ch, string, 1, ier) else if (mode == WRITE | mode == READWRITE) { call CFILW (string, 2, ier) call OPEN (ch, string, 3, ier) } if (ier ^= 1) { write (STDERR, 1) ier, ch, mode, string(1) 1 format(" open error=",i5,", ch=",i2, ", mode=",i2,", file=",s20) ch = ERR } else channel(ch) = mode return(ch) end # -->> FILE PACK.RF # pack.rf - Pack a RATFOR terminated string into a NULL terminated string. include ratdef integer function pack (rstring, string, max) character string(ARB), rstring(max) for (i = 1; i < max; i = i + 1) { BYTE(string,i) = rstring(i) if (rstring(i) == EOS) break } BYTE(string,i) = NULL return (i-1) end # -->> FILE PUTC.RF # putc - put character c to standard output file include ratdef subroutine putc(c) integer c call putch(c, STDOUT) return end # -->> FILE PUTCH.RF # putch - write a character c to file fd. # NOTE AOS/RDOS DIFFERENCE BELOW !! include ratdef subroutine putch (c, fd) integer c, fd include channel if (0 <= fd & fd <= MAXCHNL & channel(fd) ^= ERR) { if (md(fd) ^= WRITE) { # fix up pointers if last operation not WRITE md(fd) = WRITE; ic(fd) = 1; nc(fd) = 0 } if (c == NEWLINE) { # change NEWLINE to CR and flush the buffer if RDOS # insert NEWLINE and flush buffer if AOS # byte(linebuf(1,fd),ic(fd)) = CR #RDOS byte(linebuf(1,fd),ic(fd)) = NEWLINE #AOS ic(fd) = ic(fd) + 1 call flush (fd) } else { byte(linebuf(1,fd),ic(fd)) = c ic(fd) = ic(fd) + 1 if (ic(fd) > MAXLINE | c == CR) { # this causes sequential write call wrseq (fd, linebuf(1,fd), ic(fd), ier) call chkio (fd, ier) ic(fd) = 1 } else if (c == FF | c == NULL) # these cause line write call flush (fd) } } return end # -->> FILE PUTDEC.RF # putdec - put decimal integer n in field width >= w to STDOUT include ratdef subroutine putdec(n, w) integer n, w call putint(n, w, STDOUT) return end # -->> FILE PUTINT.RF # putint - write decimal integer n in field width >= w to f include ratdef subroutine putint(n, w, f) integer n, w, f character chars(MAXCHARS) integer itoc integer junk junk = itoc(n, chars, MAXCHARS) call putstr(chars, w, f) return end # -->> FILE PUTLIN.RF # putlin - put out line by repeated calls to putch include ratdef subroutine putlin(b, f) character b(ARB) integer f, i for (i = 1; b(i) ^= EOS; i = i + 1) call putch(b(i), f) return end # -->> FILE PUTSTR.RF # putstr - write string str to file f in field width >= w include ratdef subroutine putstr(str, w, f) character str(MAXLINE) integer w, f, len, i, length len = length(str) if (w >= 0) # right-justified for (i = len + 1; i <= w; i = i + 1) call putch(BLANK, f) for (i = 1; str(i) ^= EOS; i = i + 1) call putch(str(i), f) if (w < 0) # left-justified for (i = len + 1; i <= -w; i = i + 1) call putch(BLANK, f) return end # -->> FILE RDATA.RF # rdata - read a data packet from the other KEMRIT # integer function rdata(x) include ratdef include kerdef include kercom # integer num,len,status integer x,rpack,tnum # if(numtry>MAXTRY){ rdata=BIGA return } else numtry=numtry+1 # status=rpack(len,num,packet) if(host==FALSE){ call putdec(num,4) call putc(CR) call flush(STDOUT) } if(status==BIGD){ if(num!=n){ if(oldtry>MAXTRY){ rdata=BIGA return } else oldtry=oldtry+1 if(num==(n-1)){ call spar(packet) call spack(BIGY,num,6,packet) numtry=0 rdata=state return } else { rdata=BIGA return } } # write the data packet just receive into the receive file call bufemp(packet,len) tnum=n call spack(BIGY,tnum,0,0) oldtry=numtry numtry=0 n=mod((n+1),64) rdata=BIGD return } else if(status==BIGF){ if(oldtry>MAXTRY){ rdata=BIGA return } else oldtry=oldtry+1 if(num==(n-1)){ call spack(BIGY,num,0,0) numtry=0 rdata=state return } else { rdata=BIGA return } } else if(status==BIGZ){ if(num!=n){ rdata=BIGA return } tnum=n call spack(BIGY,tnum,0,0) call close(fd) n=mod((n+1),64) rdata=BIGF return } else if(status==FALSE){ rdata=state tnum=n call spack(BIGN,tnum,0,0) return } else rdata=BIGA return end # -->> FILE RECSW.RF # recsw - receive a file or a group of file from the remote system # integer function recsw(x) include ratdef include kerdef include kercom # integer x integer rdata,rfile,rinit,status status=YES state=BIGR n=0 numtry=0 eol=CR call ttyraw # if no mutli-tasking then take out the next line if(host==FALSE)task unhung, id=2, pri=255 while(status==YES){ if(state==BIGD)state=rdata(x) else if(state==BIGF)state=rfile(x) else if(state==BIGR)state=rinit(x) else if(state==BIGC){ recsw=TRUE # if no multi-tasking then take out the whole compound IF statement if(host==FALSE){ call tidk(2,ier) call wait(1,2,ier) } call ttycook return } else if(state==BIGA){ recsw=FALSE # if no multi-tasking then take out the next compound IF statement if(host==FALSE){ call tidk(2,ier) call wait(1,2,ier) } call ttycook return } } call ttycook return end # -->> FILE REMARK.RF # remark - send packed string to standard error file. include ratdef subroutine remark (string) integer string integer c for (i=1;; i=i+1) { c = byte(string,i) if (c == NULL) break call putch (c, STDERR) } call putch (NEWLINE, STDERR) return end # -->> FILE REMOVE.RF # remove - remove file name include ratdef subroutine remove(name) character name(MAXNAME) character pname(MAXNAME) integer pack, ier ier = pack (name, pname, MAXNAME) call DFILW (pname, ier) return end # -->> FILE RFILE.RF # rfile - receive the file name from the remote KERMIT integer function rfile(x) include ratdef include kerdef include kercom # integer num,len,status,rpack,x,tnum integer aone,bone,a12 character alin(MAXLINE) string receiving " Receiving " # if(numtry>MAXTRY){ rfile=BIGA return } else numtry=numtry+1 # status=rpack(len,num,packet) if(status==BIGS){ if(oldtry>MAXTRY){ rfile=BIGA return } else oldtry=oldtry+1 if(num==(n-1)){ call spar(packet) call spack(BIGY,num,6,packet) numtry=0 rfile=state return } else { rfile=BIGA return } } else if(status==BIGZ){ if(oldtry>MAXTRY){ rfile=BIGA return } else oldtry=oldtry+1 if(num==(n-1)){ call spack(BIGY,num,0,0) numtry=0 rfile=state return } else { rfile=BIGA return } } else if(status==BIGF){ if(num!=n){ rfile=BIGA return } packet(len+1)=NEWLINE packet(len+2)=EOS call verify(packet) if(host==FALSE){ aone=1 bone=1 a12=12 call scopy(receiving,aone,alin,bone) call scopy(packet,aone,alin,a12) call putlin(alin,localoutfd) call putch(NEWLINE,localoutfd) call remark(" Packet # ") } fd=aopen(packet,WRITE) if(fd==ERR){ rfile=BIGA return } tnum=n call spack(BIGY,tnum,0,0) odltry=numtry numtry=0 n=mod((N+1),64) rfile=BIGD return } else if(status==BIGB){ if(num!=n){ rfile=BIGA return } tnum=n call spack(BIGY,tnum,0,0) rfile=BIGC return } else if(status==FALSE){ rfile=state tnum=n call spack(BIGN,tnum,0,0) return } else rfile=BIGA return end # -->> FILE RINIT.RF # rinit - receive the initial packet from the remote system integer function rinit(x) include ratdef include kerdef include kercom # integer len,num,status,rpack,x,tnum if(numtry>MAXTRY){ rinit=BIGA return } else numtry=numtry+1 # status=rpack(len,num,packet) if(status==BIGS){ call rpar(packet) call spar(packet) tnum=n call spack(BIGY,tnum,6,packet) oldtry=numtry numtry=0 n=mod((n+1),64) rinit=BIGF return } else if(status==FALSE){ rinit=state tnum=n call spack(BIGN,tnum,0,0) return } else { rinit=BIGA } return end # -->> FILE RPACK.RF # rpack - receive a packet from the remote system # integer function rpack(len,num,xdata) include ratdef include kerdef include kercom # integer len,num,ch integer kgetlin character xdata(1) # integer i,count,status,unchar,j,k,idc1,t1,ibyte integer xcount,temp,mailid character chksum,t,xtype,buffer(MAXLINE) # idc1=03400k #the bell chksum=0 if(ibm==TRUE)xcount=8 else xcount=2 i=1 ch=rmtinfd while(i<=xcount){ # we are talking to CMS, get a packet, but also wait for the DC1 # before returning back to here if(ibm==TRUE)status=ibmgetlin(buffer,ch) else status=getlin(buffer,ch) # else we are not talking to CMS, just get a packet, no need to wait count=1 # skip all other character until you see a SOH which is a numeric 1 while((buffer(count)^=SOH)&(buffer(count)^=EOS))count=count+1 if(buffer(count)==SOH){ k=count+1 # get the length chksum=buffer(k) len=unchar(buffer(k))-3 k=k+1 # get the sequence of the frame packet chksum=chksum+buffer(k) num=unchar(buffer(k)) k=k+1 # get the data type xtype=buffer(k) chksum=chksum+buffer(k) k=k+1 # get the data for(j=1;j<=len;j=j+1){ xdata(j)=buffer(k) chksum=chksum+buffer(k) k=k+1 count=j } xdata(count+1)=0 t=buffer(k) # calculate the checksum of the incoming packet chksum=(chksum+(chksum&192)/64)&63 # is my checksum the same as the one send from the other KERMIT if(chksum!=unchar(t)){ rpack=FALSE return } rpack=xtype return } i=i+1 } rpack=FALSE return end # -->> FILE RPAR.RF # rpar - what are the requirement of the other KERMIT # subroutine rpar(xdata) include ratdef include kerdef include kercom # character xdata(1) integer unchar,ctl # spsiz=unchar(xdata(1)) pad=unchar(xdata(3)) padchar=ctl(xdata(4)) eol=unchar(xdata(5)) quote=xdata(6) return end # -->> FILE SBREAK.RF # sbreak - send the break packet to signify the end of the transmission # integer function sbreak(x) include ratdef include kerdef include kercom # integer num,len,rpack,status,x,tnum # if(numtry>MAXTRY){ sbreak=BIGA return } else numtry=numtry+1 # tnum=n call spack(BIGB,tnum,0,packet) status=rpack(len,num,recpkt) if(status==BIGN){ if(n!=(num-1)){ sbreak=state return } } else if(status==BIGY){ if(n!=num){ sbreak=state return } numtry=0 n=mod((n+1),64) sbreak=BIGC return } else if(status==FALSE){ sbreak=state return } else sbreak=BIGA return end # -->> FILE SCOPY.RF # scopy - copy string at from(i) to to(j) include ratdef subroutine scopy(from, i, to, j) character from(ARB), to(ARB) integer i, j, k1, k2 k2 = j for (k1 = i; from(k1) ^= EOS; k1 = k1 + 1) { to(k2) = from(k1) k2 = k2 + 1 } to(k2) = EOS return end # -->> FILE SDATA.RF # sdata - send a data packet to the other KERMIT # integer function sdata(x) include ratdef include kerdef include kercom # integer x,num,len,bufill,status,rpack,tnum if(numtry>MAXTRY){ sdata=BIGA return } else numtry=numtry+1 tnum=n call spack(BIGD,tnum,size,packet) if(host==FALSE){ call putdec(tnum,4) call putc(CR) call flush(STDOUT) } status=rpack(len,num,recpkt) # the next statements is to make sure we are not one packet ahead of other # KERMIT, it will happen if other KERMIT sends a NAK before we send the # the first SINIT packet if((status==BIGY)&(n==(num+1)))status=rpack(len,num,recpkt) if(status==BIGN){ if(n!=(num-1)){ sdata=state return } } else if(status==BIGY){ if(n!=num){ sdata=state return } numtry=0 n=mod((n+1),64) size=bufill(packet) if(size==EOF){ sdata=BIGZ return } sdata=BIGD return } else if(status==FALSE){ sdata=state return } else sdata=BIGA return end # -->> FILE SENDSW.RF # sendsw - send one or more file to the remote system # integer function sendsw(x) include ratdef include kerdef include kercom # integer x,status integer sdata,sfile,seof,sinit,sbreak state=BIGS n=0 eol=CR numtry=0 status=YES call ttyraw # if your system does not support multi-tasking then take out the next line if(host==FALSE)task unhung,id=2,pri=255 while(status==YES){ if(state==BIGD)state=sdata(x) else if(state==BIGF)state=sfile(x) else if(state==BIGZ)state=seof(x) else if(state==BIGS)state=sinit(x) else if(state==BIGB)state=sbreak(x) else if(state==BIGC){ sendsw=TRUE # if no multi-tasking then take out this whole compund if statement if(host==FALSE){ call tidk(2,ier) call wait(1,2,ier) } call ttycook return } else if(state==BIGA){ sendsw=FALSE # if no multi-tasking then take out this whole compound if statement if(host==FALSE){ call tidk(2,ier) call wait(1,2,ier) } call ttycook return } else { status=NO sendsw=FALSE # if no multi-tasking then take out this whole compound if statement if(host==FALSE){ call tidk(2,ier) call wait(1,2,ier) } } } call ttycook return end # -->> FILE SEOF.RF # seof - send an EOF packet to the remote system integer function seof(x) include ratdef include kerdef include kercom # integer num,len,status,rpack,x,tnum,temp integer xy character alin(MAXLINE) integer aone,bone if(numtry>MAXTRY){ seof=BIGA return } else numtry=numtry+1 aone=1 bone=1 tnum=n call spack(BIGZ,tnum,0,packet) status=rpack(len,num,recpkt) if(status==BIGN){ if(n!=(num-1)){ seof=state return } } else if(status==BIGY){ if(n!=num){ seof=state return } numtry=0 call close(fd) n=mod((n+1),64) temp=getlin(filnam,morefd) if(temp==EOF){ call close(morefd) seof=BIGB return } else { fd=aopen(filnam,READ) if(fd==ERR){ temp=YES while(temp==YES){ xy=getlin(alin,morefd) if(xy==EOF){ seof=BIGB call close(morefd) return } else { call scopy(alin,aone,filnam,bone) fd=aopen(filanm,READ) if(fd^=ERR)temp=NO } } seof=BIGF return } else { seof=BIGF return } } } else if(status==FALSE){ seof=state return } else seof=BIGA return end # -->> FILE SFILE.RF # sfile - send the name of the file we are about to send to the other KERMIT # integer function sfile(x) include ratdef include kerdef include kercom # integer num,len,count,rpack,bufill,x,tnum integer aone,aten,bone character alin(MAXLINE) string sending " Sending " if(host==FALSE){ aone=1 bone=1 aten=10 call scopy(sending,aone,alin,bone) call scopy(filnam,aone,alin,aten) call putlin(alin,localoutfd) call remark(" Packet # ") } if(numtry>MAXTRY){ sfile=BIGA return } else numtry=numtry+1 len=1 while(filnam(len)^=EOS)len=len+1 len=len-2 tnum=n call spack(BIGF,tnum,len,filnam) status=rpack(len,num,recpkt) if(status==BIGN){ if(n!=(num-1)){ sfile=state return } } else if(status==BIGY){ if(n!=num){ sfile=state return } numtry=0 n=mod((n+1),64) size=bufill(packet) sfile=BIGD return } else if(status==FALSE){ sfile=state return } else { sfile=BIGA return } return end # -->> FILE SINIT.RF # sinit - send a initial packet for the first connection # - stating what my parameters are # integer function sinit(x) include ratdef include kerdef include kercom # integer num,len,status,rpack,x,tnum,temp integer xy character alin(MAXLINE) integer aone,bone string morefile "MOREFILE" # if(numtry>MAXTRY){ sinit=BIGA return } else numtry=numtry+1 # aone=1 bone=1 call spar(packet) tnum=n call spack(BIGS,tnum,6,packet) status=rpack(len,num,recpkt) if(status==BIGN){ if(n!=(num-1)){ sinit=state return } } else if(status==BIGY){ if(n!=num){ sinit=state return } call rpar(recpkt) if(eol==0)eol=NEWLINE if(quote==0)quote=SHARP numtry=0 n=mod((n+1),64) morefd=aopen(morefile,READ) temp=YES while(temp==YES){ xy=getlin(alin,morefd) if(xy==EOF){ sinit=BIGA call close(morefd) return } else { call scopy(alin,aone,filnam,bone) fd=aopen(filnam,READ) if(fd^=ERR)temp=NO } } sinit=BIGF return } else if(status==FALSE){ sinit=state return } else sinit=BIGA return end # -->> FILE SPACK.RF # spack - send a packet to the other KERMIT # subroutine spack(xtype,num,len,xdata) include ratdef include kerdef include kercom character xtype,xdata(1) integer num,len,ch # integer i,ier,count,tochar character chksum,buffer(100) # #issue necessary padding ch=rmtoutfd i=1 while(i<=pad){ call kputch(padchar,ch) i=i+1 } count=1 buffer(count)=SOH count=count+1 chksum=tochar(len+3) buffer(count)=tochar(len+3) count=count+1 chksum=chksum+tochar(num) buffer(count)=tochar(num) count=count+1 chksum=chksum+xtype buffer(count)=xtype count=count+1 # for(i=1;i<=len;i=i+1){ buffer(count)=xdata(i) count=count+1 chksum=chksum+xdata(i) } chksum=(chksum+(chksum&192)/64)&63 buffer(count)=tochar(chksum) count=count+1 buffer(count)=eol buffer(count+1)=EOS count=1 ch=rmtoutfd while(buffer(count)^=EOS){ call kputch(buffer(count),ch) count=count+1 } return end # -->> FILE SPACK1.RF # spack1 subroutine spack1(xtype,num,len,xdata) include ratdef include kerdef include kercom character xtype,xdata(1) integer num,len,ch # integer i,ier,count,tochar character chksum,buffer(100) # #issue necessary padding ch=rmtoutfd i=1 while(i<=pad){ call kputch(padchar,ch) i=i+1 } count=1 buffer(count)=SOH count=count+1 chksum=tochar(len+3) buffer(count)=tochar(len+3) count=count+1 chksum=chksum+tochar(num) buffer(count)=tochar(num) count=count+1 chksum=chksum+xtype buffer(count)=xtype count=count+1 # for(i=1;i<=len;i=i+1){ buffer(count)=xdata(i) count=count+1 chksum=chksum+xdata(i) } chksum=(chksum+(chksum&192)/64)&63 buffer(count)=tochar(chksum) count=count+1 buffer(count)=eol buffer(count+1)=EOS count=1 ch=rmtoutfd while(buffer(count)^=EOS){ call kputch(buffer(count),ch) count=count+1 } return end # -->> FILE SPAR.RF # spar- let the other KERMIT know what my requirements are # subroutine spar(xdata) include ratdef include kerdef include kercom character xdata(1) # integer ctl,tochar xdata(1)=tochar(MAXPACK) xdata(2)=tochar(0) xdata(3)=tochar(MYPAD) xdata(4)=ctl(MYPCHAR) xdata(5)=tochar(MYEOL) xdata(6)=MYQUOTE return end # -->> FILE SSCOPY.RF # sscopy - copy packed null-terminated strings. subroutine sscopy (from, to) integer from(1), to(1) i = 0 repeat { I=I+1; to(i)=from(i) } until (((to(i)&177400k)==0) | ((to(i)&377k)==0)) return end # -->> FILE STDOPEN.RF # STDOPEN - open standard input, output, and error files. # # See STDIO.FX and STDSETUP.RF for documentation. # include ratdef subroutine stdopen include channel call stdio (STDIN, STDOUT, STDERR, STDCOM) call stdsetup(STDIN, STDOUT, STDERR) return end # -->> FILE STDSETUP.RF # stdsetup- setup the common block /channel/ include ratfor subroutine stdsetup (fdi, fdo, fde) integer fdi, fdo, fde include channel data channel /ERR, MAXCHNL*ERR/ data apos / 32767 / data vpos / 32767 / data nc / 0, MAXCHNL*0 / data ic / 1, MAXCHNL*1 / data md / READWRITE, MAXCHNL*READWRITE / # reserve standard channel assignments channel(STDCOM) = READ # (F)COM.CM channel(6) = WRITE # $PLT channel(10) = WRITE # $TTO(1) channel(11) = READ # $TTI(1) channel(12) = WRITE # $LPT if (fdi>=0) channel(fdi) = READ # STDIN if (fdo>=0) channel(fdo) = WRITE # STDOUT if (fde>=0) channel(fde) = WRITE # STDERR return end # -->> FILE TOCHAR.RF # convert a integer to a character # integer function tochar(ch) include ratdef include kerdef character ch # SP = 32 tochar=ch+SP return end # -->> FILE TTYCOOK.RF # ttycook - put the console that does actual I/O of packet into a cook mode # subroutine ttycook include ratdef include kerdef include kercom integer ier integer xchar(3) if(host==TRUE){ # we have in the host kermit mode, use the TTY the user is loggin under call qgchr(000000k,"@console",xchar,ier) call iset(xchar(1),0) call iset(xchar(1),1) call iclr(xchar(2),15) call qschr(000000k,"@console",xchar,ier) } else { #we are in the local kermit mode, which remote TTY is used for packet I/O if(speed==FALSE){ # turn tty with 1200 baud into raw mode call qgchr(000000k,"@con11",xchar,ier) call iset(xchar(1),0) call iset(xchar(1),1) call iclr(xchar(2),15) call qschr(000000k,"@con11",xchar,ier) } else { # turn TTY with 9600 baud into raw mode call qgchr(000000k,"@con4",xchar,ier) call iset(xchar(1),0) call iset(xchar(1),1) call iclr(xchar(2),15) call qschr(000000k,"@con4",xchar,ier) } } return end # -->> FILE TTYRAW.RF #ttyraw- put the TTY that does the actual I/O of packet into raw mode # - whihc mean no echo and do not conver lower case to upper case # subroutine ttyraw include ratdef include kerdef include kercom integer ier integer xchar(3) if(host==TRUE){ # use the TTY the user currently logon under call qgchr(000000k,"@console",xchar,ier) call iclr(xchar(1),0) call iclr(xchar(1),1) call iset(xchar(2),15) call qschr(000000k,"@console",xchar,ier) } else { # we are in local mode, which terminal is to be used if(speed==FALSE){ # use a TTY with 1200 baud call qgchr(000000k,"@con11",xchar,ier) call iclr(xchar(1),0) call iclr(xchar(1),1) call iset(xchar(2),15) call qschr(000000k,"@con11",xchar,ier) } else { # use a TTY with 9600 baud call qgchr(000000k,"@con4",xchar,ier) call iclr(xchar(1),0) call iclr(xchar(1),1) call iset(xchar(2),15) call qschr(000000k,"@con4",xchar,ier) } } return end # -->> FILE UNCHAR.RF # change a converted character back to a integer # integer function unchar(ch) include ratdef include kerdef character ch # SP = 32 unchar=ch-SP return end # -->> FILE UNHUNG.RF # unhung - during the receive and sending phase, a return carriage # - in the local kermit mode will cause a NAK send to the # - remote system # subroutine unhung include ratdef include kerdef include kercom # character alin(MAXLINE) integer tnum,status,getlin while((getlin(alin,localinfd)^=EOF)){ if((alin(1)==BIGQ)&(alin(2)==LETU))call exit call remark("Sending out a NAK for retry purpose") tnum=n call spack1(BIGN,tnum,0,0) type "just send out a NAK" } return end # -->> FILE UPPER.RF # upper - convert all lower case to upper case letter # subroutine upper(alin,blin) implicit integer (a-z) include ratdef # character alin(MAXLINE) character blin(MAXLINE) string ucase "ABCDEFGHIJKLMNOPQRSTUVWXYZ" # a1=1 while(alin(a1)^=EOS){ if((alin(a1)>96)&(alin(a1)<123)){ blin(a1)=ucase((alin(a1)-32-64)) } else blin(a1)=alin(a1) a1=a1+1 } blin(a1)=EOS return end # -->> FILE VERIFY.RF # verify - make sure the filename are valid, if not make it so # include ratdef subroutine verify(infile) character infile(MAXLINE) character outfile(MAXLINE) # integer aone,bone,temp # aone=1 bone=1 temp=1 while((infile(temp)^=NEWLINE)&(infile(temp)^=EOS)){ if((infile(temp)>64)&(infile(temp)<91)){ outfile(temp)=infile(temp) } else if((infile(temp)>47)&(infile(temp)<58)){ outfile(temp)=infile(temp) } else outfile(temp)=PERIOD temp=temp+1 } outfile(temp)=EOS call scopy(outfile,aone,infile,bone) return end