define (error=1)# error lun define (sy=2) # output file lun define (rem=3) # remote computer lun define (null=0) # "0 define (soh=1) # "1 define (eot=4) # "4 define (enq=5) # "5 define (ack=6) # "6 define (bel=7) # "7 define (bs=8) # "10 define (lf=10) # "12 define (so=14) # "16 define (esc=27) # "33 define (space=' ') define (oct077=63) # "77 define (oct100=64) # "100 define (oct200=128) # "200 define (transmissionlength=516) # maximum length of transmitted data lines # RECEIV - main routine of receive task, Cadnet V 2.0 # # This program is the receiving section for CADNET. It can handle varible # record length files of the 'list' type, and fixed record length files. # program receiv byte line (transmissionlength), fname (29) logical*1 image integer*2 iarray (18) byte tsknam (6) common /task/ tsknam % data idot /3r.../ data fname (29) /0/ # Attach the devices used by Cadnet call assign (sy, 'SY0:') # output lun call assign (sy) # close the unit call assign (error, 'TI:') # error message lun call ttatt (0, rem, istat) # attach to term if (istat != 0) # attach error { write (error, 102) tsknam call exst (4) } # Find our task name for error messages call gettsk (iarray, ids) # get task name if (iarray (1) == idot) iarray (1) = 0 # delete leading '...'s if (iarray (2) == idot) iarray (2) = 0 # delete trailing '...'s call r50asc (6, iarray, tsknam) # convert to ascii do i = 1, 6 # eliminate blanks if (tsknam (i) == ' ') tsknam (i) = 0 # Process files being transmitted repeat { # Open output file call rinit (fname, len, image, nsize) # Move the lines of the file repeat { # read the line from the remote computer call retln (line, linlen, ids) if (ids == 1) # check for end of file break # write line to output file if (image) { # fixed record write call fxwrt (line, linlen, ids) if (ids < 0) # check for transmission error goto 9 } else { # varible record write if (linlen == 0) write (sy, 100, err=9) else if (linlen > 0) write (sy, 100, err=9) (line (i), i = 1,linlen) } } # End of file. close output file and loop for next file. if (image) call fxcls else call close (sy) # Write error section if (.false.) { 9 write (error, 101) tsknam, (fname (i), i = 1, len) write (rem, 100) soh call close (sy) # close file } } 100 format (134a1) 101 format (x, 6a1, ' -- Unable to write to output file ', 28a1) 102 format (x, 6a1, ' -- Unable to attach to remote. Aborting task.') end # RINIT - initialize file handling for receive task, CADNET V 2.0. # # Calling Sequence: # call rinit (fname, len, image, nsize) # # Where: # fname - byte array into which the filespec is placed # len - length of string fname # image - flag: .true. if file is in image mode # nsize - record length of target file (0 if variable length) # # This subroutine handles the communication initialization # sequence. It determines the file name, its length, # type of file, and record length for fixed length files. # # The format of an init sequence is: # # # # subroutine rinit (fname, len, image, nsize) byte fname (28) integer*2 len logical*1 image integer*2 nsize byte tsknam (6) common /task/ tsknam integer*2 icount byte line (transmissionlength) # common /buffer/ icnt, line define (lfpos=1) define (ackpos=2) define (fnlenpos=3) define (reclenpos=4) define (fnpos=6) # Clear file name do i = 1, 28 fname (i) = null # Wait for a valid init sequence, then process it. repeat { call readln (line, icount) # Reject if not a valid init sequence, go back and wait for another if ((icount <= 5) \ (line (lfpos) != lf) \ (line (ackpos) != ack)) { write (rem, 101) next } # Decode init sequence for file name length, reject if invalid len = line (fnlenpos) - oct100 if (icount != len + fnpos - 1) # verify file name length { write (rem, 101) next } # Decode for record length. If zero output file will be varible length. ihigh = line (reclenpos) # high order octal digits low = line (reclenpos + 1) # low order octal digits nsize = (ihigh - oct100) * oct100 + (low - oct100) # Move file name to fname do j = 1, len fname (j) = line (j + fnpos - 1) # Decide if output file will be fixed length image = nsize != 0 # Compute and send response to remote computer ihigh = icount / oct100 + oct100 low = (icount & oct077) + oct100 write (rem, 100) ihigh, low # Open output file if (image) # fixed length { call opener (fname, len, nsize, ids) if (ids < 0) goto 9 } else # varible length open (unit=sy, name=fname, type='new', err=9, carriagecontrol='list') # Open error section if (.false.) { 9 write (error, 8) tsknam, (fname (i), i = 1, len) 8 format (' ', 6a1, ' -- Unable to open output file ', 28a1) write (rem, 100) soh } return } 100 format (x, 2a1) # 101 format (2x) # end # RETLN - retreive a logical record from the remote computer. # for receive task, Cadnet V 2.0. # # Calling Sequence: # call retln (filine, linlen, ids) # # Where: # filine - logical record received from the remote computer # linlen - length of logical record # ids - status code: 0 => all ok # > 0 => end of file # < 0 => transmission error # # Notes: # Logical records are transmitted as one or more data lines. Each data # line has up to 40 characters, which may be either normal characters or # special character subsequences. # # There are several different formats for data lines transmitted from # the remote computer. All of the following formats list the transmitted # sequence first, then the response string sent back to the remote. # # A data line which does not contain the end of the logical record: # [line data] # # A data line which does contain the end of the logical record: # [line data] # [logical record length] # A logical record of length 0: # # [logical record length] # An end-of-file: # # # # The CR is stripped off by the QIO # # Logical record length is coded the same way as the record length in the # initialization sequence. # subroutine retln (filine, linlen, ids) byte filine (512) integer*2 linlen, ids integer*2 offset logical*1 contin byte tsknam (6) common /task/ tsknam integer*2 icount byte line (transmissionlength) # common /buffer/ icnt, line i=1 # pointer in filine ids=0 # clear status code linlen=0 # clear length of line offset=0 # used to compute control characters # Process data lines received from the remote until a logical record has # been received. repeat { call readln (line, icount) # Check if data line contains end of logical record. if (line (icount) == so) { contin = .true. # set no end of logical record icount = icount - 1 # delete so from line } else contin = .false. # end of logical record # Check if data line is some other special case if (line (2) == null) # check for null line break if (line (1) != lf) # check for bad line goto 200 if (line (2) == eot) { # End of file: send response string, return ids = 1 write (rem, 100) eot return } # Move data from line to filine, interpreting all subsequences. do j = 2, icount { if (line (j) < space) # start of control subsequence { if (line (j) == enq) # Control char offset=1 if (line (j) == bel) # Negative char, bit 6 set offset=-1 if (line (j) == bs) # Negative char, bit 6 clear offset=-2 if (offset == 0) # this is an error condition goto 200 } else # end of control subseq. or normal char { # Interpret transmitted characters. if (offset == 1) # Control char filine (i)= line (j) & oct077 if (offset == -1) # Negative character, bit 6 set filine (i)= line (j) \ oct200 if (offset == -2) # Negative character, bit 6 clr filine (i)= (line (j) & oct077) \ oct200 if (offset == 0) # Normal character filine (i)= line (j) offset = 0 # clear offset i = i + 1 # increment pointer } } # Transmit this value if line is not finished if (contin) write (rem, 100) (icount & oct077) \ oct100 } until (! contin) # Prepare end of line response num = (icount & oct077) \ oct100 linlen = i - 1 # compute length of line ihigh = linlen / oct100 + oct100 low = (linlen & oct077) \ oct100 write (rem, 100) num, ihigh, low return # Error in data line transmission from remote: give error message, simulate eof 200 continue write (error, 101) tsknam write (rem, 100) soh ids = 1 return 100 format (x, 4a1) 101 format (' ', 6a1, ' - Transmission error. Aborting communication.') end # READLN - read a data line from the remote computer. # for receive task, CADNET V 3.0 # # Calling Sequence: # call readln (line, icount) # # Where: # line - string containing all the characters in the data line # icount - length of data line, including leading LF. # # subroutine readln (line, icount) byte line (transmissionlength) integer*2 icount integer*2 ttpar (6), ttios (2), istat, addr, ttdsw, iofcn # include [100,3]ttcomm # Issue the read iofcn = 4352 # "10400 call getadr (addr, line) ttpar (1) = addr ttpar (2) = transmissionlength istat = 0 ttios (1) = 1 call wtqio (iofcn, rem, rem, , ttios, ttpar, ttdsw) # call ttrvb (0, rem, line, transmissionlength, istat) # Check for errors if (istat == 0) # all ok { icount = ttios (2) return } else if (istat == 1) # directive error { write (error, 1) tsknam write (rem, 3) soh call exst (4) } else if (istat == 2) # i/o error { write (error, 2) tsknam write (rem, 3) soh call exst (4) } 1 format (' ', 6a1, ' - Directive error in readln. Aborting receive task.') 2 format (' ', 6a1, ' - I/O error in readln. Aborting receive task.') 3 format (x, a1) end