h36042
s 00002/00002/00321
d D 1.2 83/03/18 14:52:16 mjb 2 1
c 
e
s 00323/00000/00000
d D 1.1 83/03/18 13:18:58 tes 1 0
c date and time created 83/03/18 13:18:58 by tes
e
u
4
U
t
T
I 1
block data fcbblk

include(`fcbcom')

data fcbsta /-1/
end

integer function gdopen (name, type)
SHORTINT name(1)
integer type

integer fd
SHORTINT chekfd, fcbini
SHORTINT i, CPM

include(`fcbcom')

if (fcbsta != 0) {

   # initialize mode for each fcb block
   fcbsta = 0
   for (fd=1; fd<=MAXFILE; fd=fd+1)
      mode(fd) = 0
   }

for (fd=1; fd<=MAXFILE; fd=fd+1)
   if (mode(fd) == 0)
      break       
if (fd > MAXFILE) return (ExNOFCB)

i = chekfd (fd)
if (fcbini (name, fcbs(fcbp)) != 0) return (ExBADNAM)

if (type != 1 & type != 4) {

   # ascii read */
   # ascii read/write */
   # binary read */
   # binary read/write */
D 2
   if (CPM(OPNFIL, fcbs(fcbp)) == 255) {
E 2
I 2
   if (CPM(OPNFIL, fcbs(fcbp)) < 0) {
E 2
      return (ExNOFILE)
      }
   bufcnt(fp) = 128    # initialize for read on next request
   }
else {
   # ascii write (assume create) */
   # binary write */
   i = CPM (DELFIL, fcbs (fcbp))
D 2
   if (CPM (MAKFIL, fcbs (fcbp)) == 255) {
E 2
I 2
   if (CPM (MAKFIL, fcbs (fcbp)) < 0) {
E 2
      return (ExNOFILE)
      }
   bufcnt(fp) = 0
   call czbufr (fcbbfr(bp))
   }

mode(fp) = type + 1   # add one so we can determine that the
                       # file is open, otherwise mode is 0 
return (fp)
end

integer function gdclos (fd)
integer fd

integer wrtrec
SHORTINT chekfd, CPM, i

include(`fcbcom')

   if (chekfd (fd) != 0) return (-1)

   if (mode(fp) > 1 & mode(fp) != 4) { # update write and read/write only 
      if (wrtrec (fd, fcbbfr(bp), 128) <= 0) { # update current buffer 
	 return (-2)
	 }
      }
   i = CPM (CLSFIL, fcbs(fcbp))
   mode(fp) = 0

   return (0)
end

integer function gdread (fd, buffer, length)
integer fd, length
SHORTINT buffer(1)

integer i, rdrcrd, used, count
SHORTINT chekfd, ichar

include(`fcbcom')
 

if (chekfd (fd) != 0) return (-1)

count = bufcnt(fp)
for (used = 0; used < length; used=used+1) {
   if (count > 127) {
      if (rdrcrd (fd, fcbbfr(bp), 128) <= 0) {
	 break
	 }
      count = 0
      }
   i = bp + count
   ichar = fcbbfr(i)
   if (mode(fp) <= 3) {    # check for an ascii file
      if (ichar == 26) {   # check for a control Z, end of ascii file
         count = 128   # set counter to end of record
	 break
	 }
      }
   buffer(used+1) = ichar
   count = count + 1
   }

bufcnt(fp) = count
      
return (used)
end

integer function rdrcrd (fd, buffer, length)
integer fd, length
SHORTINT buffer(1)

integer gt2byt, used
SHORTINT i, chekfd, CPM, SETDMA
 
include(`fcbcom')
 

if (chekfd (fd) != 0) return (1)

for (used = 0; used < length; used=used+128) {
   i = SETDMA (buffer(used+1))
   if (CPM(READ, fcbs(fcbp)) != 0 )
      break
   call pt2byt (gt2byt (fcbs(fcbp+FxRECORD))+1, fcbs(fcbp+FxRECORD))
   }

return (used)
end
 
integer function gdwrit (fd, buffer, length)
integer fd, length
SHORTINT buffer(1)

integer i, count, used, wrtrec
SHORTINT chekfd

include(`fcbcom')
 
   if (chekfd (fd) != 0) return (-1)

   count = bufcnt(fp)
   for (used = 0; used < length; used=used+1) {
      if (count > 127) {
         if (wrtrec (fd, fcbbfr(bp), 128) <= 0) {
	    break
	    }
	 count = 0
	 call czbufr (fcbbfr(bp))
         }
      i = bp + count
      fcbbfr(i) = buffer(used+1) 
      count = count + 1
      }
   bufcnt(fp) = count
      
return (used)
end

integer function wrtrec (fd, buffer, length)
integer fd, length
SHORTINT buffer(1)

integer gt2byt, used
SHORTINT temp, chekfd, CPM, SETDMA

include(`fcbcom')
 
 
   if (chekfd (fd) != 0) return (-1)

   for (used = 0; used<length; used=used+128) {
      temp = SETDMA (buffer(used+1))
      if (CPM(WRITE, fcbs(fcbp)) != 0 )
         break
      call pt2byt (gt2byt (fcbs(fcbp+FxRECORD))+1, fcbs(fcbp+FxRECORD))
      }

return (used)
end
 
integer function gdseek (fd, sector, offset)
integer fd, sector, offset

integer rdrcrd, wrtrec
SHORTINT chekfd

include(`fcbcom')
 

   if (chekfd (fd) != 0) return (1)

   if (mode(fp) == 1 | mode(fp) == 4) {   # read 
      call pt2byt (sector, fcbs(fcbp+FxRECORD))
      if (rdrcrd (fd, fcbbfr(bp), 128) <= 0) {
         return (-2)
         }
      }
   else {   # write or read/write
      if (wrtrec (fd, fcbbfr(bp), 128) <= 0) { # update current buffer
	 return (-2)
	 }
      call pt2byt (sector, fcbs(fcbp+FxRECORD))
      if (rdrcrd (fd, fcbbfr(bp), 128) <= 0) { # position to new sector
         return (-2)
         }
      }
   fcbs(fcbp+FxOVERFL) = 0
   bufcnt(fp) = offset

return (0)
end
 
integer function gdsize(fd)
integer fd

integer i, gt2byt
SHORTINT chekfd, CPM

include(`fcbcom')

 
   if (chekfd (fd) != 0) return (-1)

   i = CPM(FILSIZ, fcbs(fcbp))
   i = FxRECORD + 1

return (gt2byt (fcbs(i)))
end
 
integer function gddelt (name)
SHORTINT name(1)

SHORTINT i, fcbini
SHORTINT CPM, delfcb(36)
 
   i = fcbini (name, delfcb)
   i = CPM (DELFIL, delfcb)

return (0)
end
 
SHORTINT function chekfd (fd)
integer fd

include(`fcbcom')

   if (fd > 0 & fd <= MAXFILE) {
      fp = fd
      fcbp = (fp-1)*36 + 1
      bp = (fp-1)*128 + 1
      if (mode(fp) > 0) {
         return (0)
         }
      }
   return (-1)
end

subroutine czbufr (buffer)
SHORTINT buffer(1)

integer i

   do i=1, 128 { buffer(i) = SUB }

return
end

SHORTINT function fcbini (name, fcb)
SHORTINT name, fcb(1)

SHORTINT i, fparse

   do i=1, 36
      fcb(i) = NUL
   
   do i=10, 12
      fcb(i) = BLANK

   fcbini = fparse (name, fcb)

return
end

integer function gt2byt (bytstr)
SHORTINT bytstr(1)

integer temp
SHORTINT bytes(2)

equivalence (bytes(1), temp)

bytes(1) = bytstr(1)
bytes(2) = bytstr(2)

return (temp)
end

subroutine pt2byt (kint, bytstr)
integer kint
SHORTINT bytstr(1)

integer temp
SHORTINT bytes(2)

equivalence (bytes(1), temp)

temp = kint
bytstr(1) = bytes(1)
bytstr(2) = bytes(2)

return
end
E 1
