From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001
From: Joseph Hunkeler <jhunkeler@gmail.com>
Date: Wed, 8 Jul 2015 20:46:52 -0400
Subject: Initial commit

---
 unix/gdev/m70vms/m70get.f | 43 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)
 create mode 100644 unix/gdev/m70vms/m70get.f

(limited to 'unix/gdev/m70vms/m70get.f')

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
-- 
cgit