From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- unix/gdev/m70vms/README | 68 ++++++++++++++++++++++++++++++++++++++++++ unix/gdev/m70vms/fcbu.inc | 6 ++++ unix/gdev/m70vms/m70.h | 30 +++++++++++++++++++ unix/gdev/m70vms/m70cls.f | 26 ++++++++++++++++ unix/gdev/m70vms/m70get.f | 43 +++++++++++++++++++++++++++ unix/gdev/m70vms/m70io.f | 75 +++++++++++++++++++++++++++++++++++++++++++++++ unix/gdev/m70vms/m70mcl.f | 35 ++++++++++++++++++++++ unix/gdev/m70vms/m70opn.f | 41 ++++++++++++++++++++++++++ unix/gdev/m70vms/m70rel.f | 19 ++++++++++++ unix/gdev/m70vms/m70wt.f | 44 +++++++++++++++++++++++++++ unix/gdev/m70vms/m70wti.f | 46 +++++++++++++++++++++++++++++ unix/gdev/m70vms/mkpkg | 29 ++++++++++++++++++ unix/gdev/m70vms/zclm70.x | 24 +++++++++++++++ unix/gdev/m70vms/zopm70.x | 59 +++++++++++++++++++++++++++++++++++++ unix/gdev/m70vms/zrdm70.x | 36 +++++++++++++++++++++++ unix/gdev/m70vms/zstm70.x | 28 ++++++++++++++++++ unix/gdev/m70vms/zwrm70.x | 36 +++++++++++++++++++++++ unix/gdev/m70vms/zwtm70.x | 44 +++++++++++++++++++++++++++ 18 files changed, 689 insertions(+) create mode 100644 unix/gdev/m70vms/README create mode 100644 unix/gdev/m70vms/fcbu.inc create mode 100644 unix/gdev/m70vms/m70.h create mode 100644 unix/gdev/m70vms/m70cls.f create mode 100644 unix/gdev/m70vms/m70get.f create mode 100644 unix/gdev/m70vms/m70io.f create mode 100644 unix/gdev/m70vms/m70mcl.f create mode 100644 unix/gdev/m70vms/m70opn.f create mode 100644 unix/gdev/m70vms/m70rel.f create mode 100644 unix/gdev/m70vms/m70wt.f create mode 100644 unix/gdev/m70vms/m70wti.f create mode 100644 unix/gdev/m70vms/mkpkg create mode 100644 unix/gdev/m70vms/zclm70.x create mode 100644 unix/gdev/m70vms/zopm70.x create mode 100644 unix/gdev/m70vms/zrdm70.x create mode 100644 unix/gdev/m70vms/zstm70.x create mode 100644 unix/gdev/m70vms/zwrm70.x create mode 100644 unix/gdev/m70vms/zwtm70.x (limited to 'unix/gdev/m70vms') diff --git a/unix/gdev/m70vms/README b/unix/gdev/m70vms/README new file mode 100644 index 00000000..23a06824 --- /dev/null +++ b/unix/gdev/m70vms/README @@ -0,0 +1,68 @@ +VMS IRAF/FIO device driver for the IIS Model 70 +(will probably also work for the model 75). 11/85 dct +---------------------------------------------------------------------- + +This directory contains the IRAF/FIO driver subroutines for the IIS Model 70 +image display on VMS. This directory is self contained; no external code is +required other than the VMS/IIS device driver itself. The code should be +portable to any VMS system. + + +Driver Procedures: + + zopm70 -- open + allocate + zclm70 -- close + deallocate + zrdm70 -- asynchronous binary read + zwrm70 -- asynchronous binary write + zwtm70 -- wait for i/o completion, return status + zstm70 -- get device status + + +On a UNIX system the ordinary binary file driver (ZFIOBF) may be used for these +functions. This might work on VMS too, but the IRAF/VMS binary file driver is +complicated and uses RMS, so I did not bother to try. This driver uses a +modified version local KPNO IIS library, which I suppose came originally from +IIS corp. The interface procedures are written in VMS Fortran and make direct +calls to the VMS system services. The original library has been modified to +convert all the names to the prefix "m70", and to remove all Fortran i/o. + + +VMS/IIS Interface Procedures: + + m70get (fcb, error) # open+allocate+mclear + m70rel (fcb) # close+deallocate + m70opn (fcb, error) # open + m70cls (fcb) # close + m70mcl (fcb, error) # master clear + + m70io (fcb, data, count, read, opcd, iosb, error) + m70wt (fcb, bfnum, bfcnt, iosb, error) + m70wti (fcb, func, time, button, x, y) + + +M70IO: I/O between M70 and a VAX. + + fcb function communications block. + data input/output buffer. + count number of words to read/write. + read 0 -> write, 1 -> read. + opcd :: 0 -> qio with efn = 1 and wait for completion + 1 -> qio with efn = 2 + 2 -> qio with efn = 3 + iosb I/O status quadword + error :: -1 => display not available + 0 => success + 1 => time/out + 2 => invalid or non-responding device + 1000 > machine dependent error code + + +M70WT: Wait for i/o. + + fcb function communication block. + bfnum used to determine event flag to wait for + bfcnt number of words in buffer. should be -1 indicating + i/o pending. reset to zero when i/o completed. + iosb i/o status block + error 0 success, -1 not acquired, 1 timeout, + 2 invalid device, 1000+n system dep. error diff --git a/unix/gdev/m70vms/fcbu.inc b/unix/gdev/m70vms/fcbu.inc new file mode 100644 index 00000000..54f23244 --- /dev/null +++ b/unix/gdev/m70vms/fcbu.inc @@ -0,0 +1,6 @@ +c +c vax offsets for display.for and termio.for +c + parameter fcb_u_spool = 21 + parameter fcb_u_m70_chan = 19 + parameter fcb_u_m70_name = 17 diff --git a/unix/gdev/m70vms/m70.h b/unix/gdev/m70vms/m70.h new file mode 100644 index 00000000..16b4c938 --- /dev/null +++ b/unix/gdev/m70vms/m70.h @@ -0,0 +1,30 @@ +# Definitions for the VMS/IIS device driver. + +define IIS_READ 1 # read function code +define IIS_WRITE 0 # write function code +define IIS_INACTIVE 2 # no i/o in progress + +define EFN EFN2 # EFN to use for i/o +define EFN1W 0 # efn #1, wait for completion +define EFN2 1 # efn #2, no wait for completion +define EFN3 2 # efn #3, no wait for completion + +# Function control block structure for IIS. The first part of the structure +# is filled in by VMS at open time; all we need to know is the offset of the +# device name. We use the latter part of the buffer for our own internal +# variables. + +define LEN_FCB 28 +define FCB_U_NAME Mems[($1)+16+($2)-1] +define FCB_IOSB Mems[($1)+20+($2)-1] +define FCB_KCHAN Mems[($1)+24] # NULL if on local node, else remote +define FCB_STATUS Mems[($1)+25] # channel status (r, w, err) +define FCB_NBYTES Mems[($1)+26] # nbytes last transfer +define FCB_EFN Mems[($1)+27] # event flag used for transfer + +# IIS device status words. + +define IIS_FILSIZE (512 * 512 * SZB_CHAR) +define IIS_BLKSIZE 1024 +define IIS_OPTBUFSIZE (512 * SZB_CHAR) +define IIS_MAXBUFSIZE 32768 diff --git a/unix/gdev/m70vms/m70cls.f b/unix/gdev/m70vms/m70cls.f new file mode 100644 index 00000000..9eb2fcd3 --- /dev/null +++ b/unix/gdev/m70vms/m70cls.f @@ -0,0 +1,26 @@ + subroutine m70cls (fcb) +c +c Routine to close model 70 display +c + integer fcb(*) + include 'fcbu.inc' +c + integer*4 sys$dassgn, chan, junk + integer*2 chan2(2) + equivalence (chan, chan2) +c +c call wtexec (fcb) +c + chan2(1) = fcb(fcb_u_m70_chan) + chan2(2) = fcb(fcb_u_m70_chan+1) +c +c if (chan.ne.0) call lib$signal (%val(sys$dassgn (%val(chan)))) + if (chan.ne.0) then + junk = sys$dassgn (%val(chan)) + endif +c + fcb(fcb_u_m70_chan) = 0 + fcb(fcb_u_m70_chan+1) = 0 +c + return + end diff --git a/unix/gdev/m70vms/m70get.f b/unix/gdev/m70vms/m70get.f new file mode 100644 index 00000000..c9d0b1c2 --- /dev/null +++ b/unix/gdev/m70vms/m70get.f @@ -0,0 +1,43 @@ + subroutine m70get (fcb, error) +c +c Routine to get (allocate) the model 70 +c +c arguments: +c +c fcb function communications block +c +c error -2 => device already allocated +c -1 => m70 not acquired +c 0 => success +c 1 => timeout +c 2 => invalid device or powerfail +c >=1000 machine dependent error number +c + integer fcb(*), error +c + include 'fcbu.inc' + external ss$_normal, ss$_devalloc + integer*4 len,status, sys$alloc + integer*2 nam2(2), stat + byte nam(4) + character name*4, result*8 + equivalence (nam2, nam), (name, nam), (status, stat) +c + nam2(1) = fcb(fcb_u_m70_name) + nam2(2) = fcb(fcb_u_m70_name+1) +c + status = sys$alloc (name, len, result,) + if (status.ne.%loc(ss$_normal)) then + if (status .eq. %loc(ss$_devalloc)) then + error = -2 + else + error = 1000 + stat + endif + else + call m70opn (fcb, error) + if (error .ne. 0) return + call m70mcl (fcb, error) + endif +c + return + end 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 diff --git a/unix/gdev/m70vms/m70mcl.f b/unix/gdev/m70vms/m70mcl.f new file mode 100644 index 00000000..c9fb5c98 --- /dev/null +++ b/unix/gdev/m70vms/m70mcl.f @@ -0,0 +1,35 @@ + subroutine m70mcl (fcb, error) +c +c master clear model 70 +c + integer fcb(*), error +c + include 'fcbu.inc' + external io$_rewind, ss$_normal + integer*4 status, iosb(2), chan, sys$qiow + integer*2 chan2(2), iostat, stat + equivalence (chan, chan2), (iosb, iostat) + equivalence (status, stat) + external ss$_timeout, ss$_powerfail +c + chan2(1) = fcb(fcb_u_m70_chan) + chan2(2) = fcb(fcb_u_m70_chan+1) +c + status = sys$qiow (, %val(chan), io$_rewind, iosb,,,,,,,,) + if (status) then + if (iosb(1)) then + error = 0 + else + status = lib$match_cond (iosb, ss$_timeout, ss$_powerfail) + if (status .eq. 0) then + error = 1000 + iostat + else + error = status + endif + endif + else + error = 1000 + stat + endif +c + return + end diff --git a/unix/gdev/m70vms/m70opn.f b/unix/gdev/m70vms/m70opn.f new file mode 100644 index 00000000..4bb91b3a --- /dev/null +++ b/unix/gdev/m70vms/m70opn.f @@ -0,0 +1,41 @@ + subroutine m70opn (FCB, error) +C +c Routine to open model 70 +c +c Error is returned as: +c -1 = display open +c 0 = OK +c 1 = timeout +c 2 = invalid or non-responding device +c >= 1000 : machine dependent error number +c + integer fcb(*), error + include 'fcbu.inc' +C + integer*4 sys$assign, chan, status + integer*2 chan2(2), name2(2), stat(2) + byte name1(4) + character*4 m70 + equivalence (chan, chan2), (status, stat(1)) + equivalence (name1, name2), (name1, m70) +C + name2(1) = fcb(fcb_u_m70_name) + name2(2) = fcb(fcb_u_m70_name+1) + chan2(1) = fcb(fcb_u_m70_chan) + chan2(2) = fcb(fcb_u_m70_chan+1) +c + if (chan.eq.0) then + status = sys$assign ('_'//m70//':', chan,,) + if (status) then + fcb(fcb_u_m70_chan) = chan2(1) + fcb(fcb_u_m70_chan+1) = chan2(2) + error = 0 + else + error = 1000 + stat(1) + endif + else + error = -1 + endif +c + return + end diff --git a/unix/gdev/m70vms/m70rel.f b/unix/gdev/m70vms/m70rel.f new file mode 100644 index 00000000..7b686d10 --- /dev/null +++ b/unix/gdev/m70vms/m70rel.f @@ -0,0 +1,19 @@ + subroutine m70rel (fcb) +c +c routine to release(DEALLOCATE) the model 70 +c + integer fcb(*) +c + include 'fcbu.inc' + integer*2 dev2(2) + byte dev(4) + character*4 m70 + equivalence (dev2,dev), (m70,dev) +c + call m70cls (fcb) + dev2(1) = fcb(fcb_u_m70_name) + dev2(2) = fcb(fcb_u_m70_name+1) + call sys$dalloc ('_'//m70//':',) +c + return + end diff --git a/unix/gdev/m70vms/m70wt.f b/unix/gdev/m70vms/m70wt.f new file mode 100644 index 00000000..715a1c68 --- /dev/null +++ b/unix/gdev/m70vms/m70wt.f @@ -0,0 +1,44 @@ + subroutine m70wt (fcb, bfnum, bfcnt, iosb, error) +c +c routine to wait for completion of buffer write on pdp-11's +c +c fcb function communication block. +c bfnum used to determine event flag to wait for +c bfcnt number of words in buffer. should be -1 indicating +c i/o pending. reset to zero when i/o completed. +c iosb i/o status block +c error 0 success, -1 not acquired, 1 timeout, +c 2 invalid device, 1000+n system dep. error +c + integer fcb(*) + integer bfnum, bfcnt, error + integer*4 iosb(2), status + integer*2 stat(2) +c + integer*4 sys$waitfr + equivalence (status, stat(1)) + external ss$_timeout, ss$_powerfail +c +c is this wait required? +c + error = 0 + if (bfcnt .ge. 0) return +c + status = sys$waitfr (%val(bfnum+1)) + if (status) then + bfcnt = 0 + if (.not. iosb(1)) then + 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 +c + return + end diff --git a/unix/gdev/m70vms/m70wti.f b/unix/gdev/m70vms/m70wti.f new file mode 100644 index 00000000..0aabd1fd --- /dev/null +++ b/unix/gdev/m70vms/m70wti.f @@ -0,0 +1,46 @@ + subroutine m70wti (fcb, func, time, button, x, y) +c +c This routine waits for the appropriate interupt from the +c Unibus M70 interface card, then returns button and cursor +c information. +c +c +c parameter descriptions: +c +c fcb is a system info. array. +c +c func is interpreted: +c 0 ==> wait for button push. +c 1 ==> wait for cursor move. +c 2 ==> wait for button push or cursor move. +c + integer fcb(*), func, time, button, x, y +c + include 'fcbu.inc' + external io$_rewindoff + integer*4 sys$qiow, mask, chan, iosb(2) + integer*2 chan2(2) + equivalence (chan, chan2) +c + chan2(1) = fcb(fcb_u_m70_chan) ! get M70 channel + chan2(2) = fcb(fcb_u_m70_chan+1) +c + if (func.eq.0) then + mask = '0400'x ! wait for button + elseif (func.eq.1) then + mask = '0800'x ! wait for trackball + elseif (func.eq.2) then + mask = '0C00'x ! wait for button or trackball + else + mask = '0C00'x + endif +c + status = sys$qiow (, %val(chan), io$_rewindoff, + 1 iosb,,,%val(mask),,,,,) +c +c Get button word and X-Y position of cursor +c + call rbutn (fcb, button, x, y) +c + return + end diff --git a/unix/gdev/m70vms/mkpkg b/unix/gdev/m70vms/mkpkg new file mode 100644 index 00000000..976cc1e4 --- /dev/null +++ b/unix/gdev/m70vms/mkpkg @@ -0,0 +1,29 @@ +# Makelib for the VMS version of the IIS driver. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + @(i2) + zclm70.x m70.h + zopm70.x m70.h + zrdm70.x m70.h + zstm70.x m70.h + zwrm70.x m70.h + zwtm70.x m70.h + ; + +i2: # Compile the VMS/Fortran IIS i/o routines with the VMS /NOI4 option. + $set XFLAGS = "-c -O -i2" + + m70cls.f fcbu.inc + m70get.f fcbu.inc + m70io.f fcbu.inc + m70mcl.f fcbu.inc + m70opn.f fcbu.inc + m70rel.f fcbu.inc + m70wt.f + m70wti.f fcbu.inc + ; diff --git a/unix/gdev/m70vms/zclm70.x b/unix/gdev/m70vms/zclm70.x new file mode 100644 index 00000000..a7ebb8f7 --- /dev/null +++ b/unix/gdev/m70vms/zclm70.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "m70.h" + +# ZCLM70 -- Close and deallocate the IIS. + +procedure zclm70 (chan, status) + +int chan # FCB pointer for device +int status +pointer fcb + +begin + fcb = chan + if (FCB_KCHAN(fcb) == NULL) { + call zwtm70 (chan, status) + call m70rel (Mems[fcb]) + } else + call zclsbf (FCB_KCHAN(fcb), status) + + call mfree (fcb, TY_SHORT) +end diff --git a/unix/gdev/m70vms/zopm70.x b/unix/gdev/m70vms/zopm70.x new file mode 100644 index 00000000..f338dbe7 --- /dev/null +++ b/unix/gdev/m70vms/zopm70.x @@ -0,0 +1,59 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "m70.h" + +# ZOPM70 -- Open the IIS for binary file i/o. The device will be automatically +# allocated if necessary. + +procedure zopm70 (device, mode, chan) + +char device[ARB] # packed VMS device name +int mode # access mode +int chan # receives device channel + +pointer fcb +int kchan +char upkdev[SZ_FNAME] +int ki_connect() + +short ier +% character m70*4 +% integer*2 namw(2) +% equivalence (m70, namw) + +begin + call calloc (fcb, LEN_FCB, TY_SHORT) + + # Use the binary file driver if the device resides on a remote node. + # This precludes remote access to a VMS hosted IIS at present. + + if (ki_connect (device) != NULL) { + call zopnbf (device, mode, kchan) + if (kchan != ERR) + FCB_KCHAN(fcb) = kchan + } else { + # Load string descriptor for device name into FCB. + call strupk (device, upkdev, SZ_FNAME) +% call f77pak (upkdev, m70, 4) + + FCB_U_NAME(fcb,1) = namw[1] + FCB_U_NAME(fcb,2) = namw[2] + FCB_KCHAN(fcb) = NULL + FCB_STATUS(fcb) = IIS_INACTIVE + FCB_NBYTES(fcb) = 0 + + # Allocate and open the device. + call m70get (Mems[fcb], ier) + kchan = ier + if (kchan != 0) + kchan = ERR + } + + if (kchan < 0) { + call mfree (fcb, TY_SHORT) + chan = ERR + } else + chan = fcb +end diff --git a/unix/gdev/m70vms/zrdm70.x b/unix/gdev/m70vms/zrdm70.x new file mode 100644 index 00000000..2bf726ab --- /dev/null +++ b/unix/gdev/m70vms/zrdm70.x @@ -0,0 +1,36 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "m70.h" + +# ZRDM70 -- Initiate an asynchronous read from the IIS. + +procedure zrdm70 (chan, buf, nbytes, offset) + +int chan # FCB pointer for device +char buf[ARB] # output buffer +int nbytes # number of bytes to read +long offset # not used for this device + +pointer fcb +short rwflag, opcd, nwords, ier +data rwflag /IIS_READ/, opcd /EFN/ + +begin + fcb = chan + if (FCB_KCHAN(fcb) == NULL) { + nwords = nbytes / (SZ_SHORT * SZB_CHAR) + call m70io (Mems[fcb], buf, nwords, rwflag, opcd, FCB_IOSB(fcb,1), + ier) + + FCB_NBYTES(fcb) = nbytes + FCB_EFN(fcb) = opcd + + if (ier != 0) + FCB_STATUS(fcb) = ERR + else + FCB_STATUS(fcb) = IIS_READ + } else + call zardbf (FCB_KCHAN(fcb), buf, nbytes, offset) +end diff --git a/unix/gdev/m70vms/zstm70.x b/unix/gdev/m70vms/zstm70.x new file mode 100644 index 00000000..2b790dfa --- /dev/null +++ b/unix/gdev/m70vms/zstm70.x @@ -0,0 +1,28 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "m70.h" + +# ZSTM70 -- Return device status for the IIS. + +procedure zstm70 (chan, what, lvalue) + +int chan # FCB pointer for device +int what # status parameter +long lvalue + +begin + switch (what) { + case FSTT_FILSIZE: + lvalue = IIS_FILSIZE + case FSTT_BLKSIZE: + lvalue = IIS_BLKSIZE + case FSTT_OPTBUFSIZE: + lvalue = IIS_OPTBUFSIZE + case FSTT_MAXBUFSIZE: + lvalue = IIS_MAXBUFSIZE + default: + lvalue = ERR + } +end diff --git a/unix/gdev/m70vms/zwrm70.x b/unix/gdev/m70vms/zwrm70.x new file mode 100644 index 00000000..7cc1ef8a --- /dev/null +++ b/unix/gdev/m70vms/zwrm70.x @@ -0,0 +1,36 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "m70.h" + +# ZWRM70 -- Initiate an asynchronous write to the IIS. + +procedure zwrm70 (chan, buf, nbytes, offset) + +int chan # FCB pointer for device +char buf[ARB] # input buffer +int nbytes # number of bytes to write +long offset # not used for this device + +pointer fcb +short rwflag, opcd, nwords, ier +data rwflag /IIS_WRITE/, opcd /EFN/ + +begin + fcb = chan + if (FCB_KCHAN(fcb) == NULL) { + nwords = nbytes / (SZ_SHORT * SZB_CHAR) + call m70io (Mems[fcb], buf, nwords, rwflag, opcd, FCB_IOSB(fcb,1), + ier) + + FCB_NBYTES(fcb) = nbytes + FCB_EFN(fcb) = opcd + + if (ier != 0) + FCB_STATUS(fcb) = ERR + else + FCB_STATUS(fcb) = IIS_WRITE + } else + call zawrbf (FCB_KCHAN(fcb), buf, nbytes, offset) +end diff --git a/unix/gdev/m70vms/zwtm70.x b/unix/gdev/m70vms/zwtm70.x new file mode 100644 index 00000000..69ab39da --- /dev/null +++ b/unix/gdev/m70vms/zwtm70.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "m70.h" + +# ZWTM70 -- Wait for i/o completion and return the number of bytes read or +# written or ERR. Repetitive calls return the same value. + +procedure zwtm70 (chan, status) + +int chan # FCB pointer for device +int status # nbytes transferred or ERR + +pointer fcb +short bfnum, bufcnt, ier + +begin + fcb = chan + + if (FCB_KCHAN(fcb) == NULL) { + switch (FCB_STATUS(fcb)) { + case ERR: + status = ERR + case IIS_INACTIVE: + status = FCB_NBYTES(fcb) + + default: + bfcnt = -1 # m70wt is a nop if we don't do this + bfnum = FCB_EFN(fcb) + + call m70wt (Mems[fcb], bfnum, bfcnt, FCB_IOSB(fcb,1), ier) + + if (ier != 0) + status = ERR + else + status = FCB_NBYTES(fcb) + + FCB_STATUS(fcb) = IIS_INACTIVE + } + + } else + call zawtbf (FCB_KCHAN(fcb), status) +end -- cgit