c blkio - subroutines for block read and write from disk c creblk - create file for block i/o subroutine creblk(unit,name,nblk,status) integer unit,status,nblk,chan(8) integer defext(4),area(39) byte name(1) external len common/cblkio/chan,area if(.not.((unit.lt.1).or.(unit.gt.8)))goto 23000 c check unit in range status=-100 goto 23001 c else 23000 continue call trim(name) if(.not.(len(name).eq.0))goto 23002 status=-200 goto 23003 c else 23002 continue c check name and extension i=icsi(area,defext,name,,0) if(.not.(i.ne.0))goto 23004 status=-300-i goto 23005 c else 23004 continue c get a channel chan(unit)=igetc() if(.not.(chan(unit) .lt. 0))goto 23006 status=-400 goto 23007 c else 23006 continue c fetch the handler i=ifetch(area(16)) if(.not.(i.ne.0))goto 23008 status=-500-i goto 23009 c else 23008 continue c open the file i=ienter(chan(unit),area(16),nblk) if(.not.(i.lt.0))goto 23010 status=-600+i goto 23011 c else 23010 continue status=0 23011 continue 23009 continue 23007 continue 23005 continue 23003 continue 23001 continue if(.not.(status.lt.0))goto 23012 return c make the file size permanent by writing to the file and closing it 23012 continue i=iwritw(1,idummy,nblk-1,chan(unit)) if(.not.(i.lt.1))goto 23014 status=-700+i 23014 continue call closec(chan(unit)) c open the file again before returning status=lookup(chan(unit),area(16),nblk) return end c opnblk - open file for block i/o subroutine opnblk(unit,name,status) integer unit,status,nblk,chan(8) integer defext(4),area(39) byte name(1) external len common/cblkio/chan,area if(.not.((unit.lt.1).or.(unit.gt.8)))goto 23016 c check unit in range status=-100 goto 23017 c else 23016 continue call trim(name) if(.not.(len(name).eq.0))goto 23018 status=-200 goto 23019 c else 23018 continue c check name and extension i=icsi(area,defext,name,,0) if(.not.(i.ne.0))goto 23020 status=-300-i goto 23021 c else 23020 continue c get a channel chan(unit)=igetc() if(.not.(chan(unit) .lt. 0))goto 23022 status=-400 goto 23023 c else 23022 continue c fetch the handler i=ifetch(area(16)) if(.not.(i.ne.0))goto 23024 status=-500-i goto 23025 c else 23024 continue c open the file status=lookup(chan(unit),area(16),nblk) 23025 continue 23023 continue 23021 continue 23019 continue 23017 continue return end c wrblk - write to file in block mode subroutine wrblk(unit,iblk,buf,nblk,status) integer unit,iblk,buf(1),nblk,status,chan(8),wcnt common/cblkio/chan,area c status = n Normal return if "n" equals number of words requested. c = -1 Attempt to write past end of file. c = -2 Hardware error. c = -3 Channel not open. wcnt=nblk*256 status=iwritw(wcnt,buf,iblk,chan(unit)) return end c read from file in block mode subroutine rdblk(unit,iblk,buf,nblk,status) integer unit,iblk,buf(1),nblk,status,chan(8),wcnt common/cblkio/chan,area c status = n Normal return if "n" equals number of words requested. c = -1 Attempt to read past end of file. c = -2 Hardware error. c = -3 Channel not open. wcnt=nblk*256 status=ireadw(wcnt,buf,iblk,chan(unit)) return end c close a block i/o file subroutine clsblk(unit,status) integer unit,status,chan(8) common/cblkio/chan,area c status = 0 Normal return c = 1 Specified channel is currently not allocated call closec(chan(unit)) status=ifreec(chan(unit)) return end