diff options
Diffstat (limited to 'unix/gdev/m70vms/m70io.f')
| -rw-r--r-- | unix/gdev/m70vms/m70io.f | 75 |
1 files changed, 75 insertions, 0 deletions
diff --git a/unix/gdev/m70vms/m70io.f b/unix/gdev/m70vms/m70io.f new file mode 100644 index 00000000..cbe0418e --- /dev/null +++ b/unix/gdev/m70vms/m70io.f @@ -0,0 +1,75 @@ + subroutine m70io (fcb, data, count, read, opcd, iosb, error) +c +c Routine does io between M70 and a VAX +c +c Parameters: +c +c fcb function communications block. +c +c data input/output buffer. +c +c count number of words to read/write. +c +c read 0 -> write, 1 -> read. +c +c opcd 0 -> qio with efn = 1 and wait for completion +c 1 -> qio with efn = 2 +c 2 -> qio with efn = 3 +c +c iosb I/O status quadword +c +c error -1 => display not available +c 0 => success +c 1 => time/out +c 2 => invalid or non-responding device +c 1000 > machine dependent error code +c + integer fcb(*), data(1), count, read, opcd, error + integer*4 iosb(2) +c + include 'fcbu.inc' + external io$_writevblk, io$_readvblk, ss$_timeout, ss$_powerfail + integer*4 chan, sys$qio, sys$waitfr, func, status, l_iosb(2) + integer*2 chan2(2), stat(2) + equivalence (chan, chan2), (status, stat(1)) +c + chan2(1) = fcb(fcb_u_m70_chan) + chan2(2) = fcb(fcb_u_m70_chan+1) +c + if (read.eq.1) then + func = %loc(io$_readvblk) + else + func = %loc(io$_writevblk) + endif +c + if (opcd.eq.0) then + status = sys$qio (%val(opcd+1), %val(chan), %val(func), + 1 l_iosb,,, data, %val(2*count),,,,) + if (status) then + status = sys$waitfr (%val(1)) + if (l_iosb(1)) then + error = 0 + else + stat(1) = lib$match_cond + 1 (iosb, ss$_timeout, ss$_powerfail) + if (stat(1) .eq. 0) then + error = 1000 + iosb(1) + else + error = stat(1) + endif + endif + else + error = 1000 + stat(1) + endif + else + status = sys$qio (%val(opcd+1), %val(chan), %val(func), + 1 iosb,,, data, %val(2*count),,,,) + if (status) then + error = 0 + else + error = 1000 + stat(1) + endif + endif +c + return + end |