GET ".ECCE-HDR"
GET ".SFO-HDR/3/S"

/***************************************************************************
*                                                                          *
*         I/O Routines for record level input/output.                      *
*                                                                          *
*  The routines provided are:                                              *
*                                                                          *
*         FIND_ARG(argument name, access, page_size, buffer, options)      *
*         OPEN(analysed filespec, access, page_size, buffer, options)      *
*         FGET(stream pointer, maximum length, buffer)                     *
*         FPUT(stream pointer, buffer)                                     *
*         FSEEK(stream pointer, block, record within block)                *
*                                                                          *
***************************************************************************/



MANIFEST {sfoblock
sfo.block = 0
sfo.res1 = 1
sfo.res2 = 2
sfo.res3 = 3
sfo.firstrec = 4
}sfoblock

MANIFEST {sforecord
sfo.reclen=0
}sforecord

MANIFEST { 
page_bsz = page_csz*bytesperword
}
                                     
MANIFEST { 
chain = 0              // pointer to next free stream descriptor.
thispage = 1           // page number within file (starting from zero).
thisrec = 2            // start of current record in block (word offset).
thispos = 3            // current byte offset within record.
access = 4             // access requested on open.
options = 5            // special options (e.g force write each record).
errcode = 6            // error code detected on stream.
buff_base = 7          // base address of block buffer.
buffer = 8             // address of current page buffer.
stream = 9             // BCPL library stream number allocated.
block_pages = 10       // number of pages per block.
page_offset = 11       // Page number within block (0 to block_pages-1)
file_size = 12         // size of file in pages.
io_proc = 13           // procedure to execute get/put on stream.
mode = 14              // open mode (e.g. direct or serial)
}

STATIC { 
numstreams=0
streamtable=0
free_chain = 0
}

LET directio(stream,block,buffer,length,read) = VALOF
/* The routine to do the biz for direct page type reads and
   writes. If all is well the answer should be zero. If a fail
   occurs then the error code is returned. If the file is not open
   for direct IO then the result is -2 but the E4FAILCODE is set
   to -2. 
*/
  $( 
   LET devtab=stream*str.entrysize+devtable
   AND par = vec 7
   AND readfail = 0
   FOR i=0 TO 7 par!I :=0
   par!0, par!1, par!2, par!3, par!4 :=
     devtab+str.rtn,block, rtnlist+2,
     buffer, length 
     e4failcode := extracode(sdfs,(read->26,30),par)
    RESULTIS e4failcode=0 -> par!4, -1        // return -1 if failed
  $)                                         // otherwise length

AND readrec(buffer,length,term, st) = VALOF
$( LET par = VEC 7
   LET strm = st!stream
   LET readfail = 0
   AND devtab = strm*str.entrysize+devtable

   par!0:=devtab + str.rtn          // pointer to rtn
   par!2:=rtnlist+2                 // pointer to seg. rtn
   par!3:=buffer+1                  // base of buffer
   par!4:=length                    // maximum transfer length
   par!5:=parity(term)              // set read to max length or this terminator
   par!7:=1                         // specify unpacked transfer

   RESULT2 :=extracode(iop,2,par)   // do a getblock
   UNLESS result2 = 0 RESULTIS errorvalue // error then exit

   RESULT2 := extracode(wait,wait.on.transfer,devtab!str.rtn) // wait for it
 
   IF result2 = 0 then result2 := ExtracodeResults!R.B

   if result2=eoffound1 LOGAND par!6 > 0 THEN result2 := 0

   buffer!0:=par!6                  // save the transfer length
  
   RESULTIS result2 = 0 -> 0, errorvalue
$)

AND writerec(buffer, st) = VALOF
$( LET par=vec 7
   LET strm = st!stream
   LET writefail = 0
   AND devtab=strm*str.entrysize+devtable

   par!0:=devtab + str.rtn
   par!2:=rtnlist+2
   par!3:=buffer+1
   par!4:=buffer!0                  // this is the transfer length
   par!5:=#x0100                    // specifies fixed length txfer
   par!7:=1

   result2 := extracode(iop,6,par)  // perform the putblock
   UNLESS result2 = 0 RESULTIS errorvalue

   result2 := extracode(wait,wait.on.transfer,devtab!str.rtn)
 
   IF result2 = 0 THEN result2 := extracodeResults!R.b
   RESULTIS result2 = 0 -> 0, errorvalue
$)

AND init.sfo(nstreams,buffers) BE
/* 'nstreams' is the maximum number of streams that may be simulaneously
    open.  Buffers is the space for the required stream table of size:
    nstreams*sfo+maxstreamno.st.entrysize.
*/
{1 numstreams:=nstreams
   streamtable:=buffers
   FOR i=0 TO maxstreamno-1 DO streamtable!i := 0
   free_chain := 0
 { LET next = buffers+maxstreamno
   FOR i=0 TO nstreams-1 DO
   {  !next := free_chain
      free_chain := next
      next +:= sfo.entrysize
   }
}1

AND find.free.st() = VALOF
{1 IF free_chain = 0 RESULTIS errorvalue
 { LET st = free_chain
   free_chain := !free_chain
   RESULTIS st
}1

AND free.st(st) BE
{1 !st := free_chain
   free_chain := st
}1
 
AND init_page(st) BE 
{1 LET buff=st!buffer
   FOR i=sfo.res1 TO sfo.firstrec DO buff!i:=0
   buff!0:=-2   // mark as last block.
   st!thisrec:=sfo.firstrec
}1
 
AND put_block(st, pages) = VALOF 
{1 LET start_page = st!thispage - st!page_offset

   st!buffer := st!buff_base
   IF directio(st!stream,start_page,st!buffer,pages*page_csz,FALSE) < 0 THEN
   {  LET ext_size = st!thispage>>3

      IF ext_size < st!block_pages
      THEN ext_size := st!block_pages

      extendfile(st!stream,st!thispage+1+(ext_size<8 -> 8, ext_size))
      UNLESS E4failcode = 0 &
             directio(st!stream,start_page,st!buffer,pages*page_csz,FALSE) = 0 DO
      {  st!errcode := E4failcode
         RESULTIS E4failcode
      }
   }
   RESULTIS 0
}1

AND put_page(st) = VALOF
{1 TEST (st!page_offset+1) = st!block_pages THEN 
   {  UNLESS put_block(st,st!block_pages) = 0 RESULTIS st!errcode
      st!page_offset := 0
   }
   ELSE
   {  st!buffer +:= page_csz 
      st!page_offset +:= 1
   }
   st!thispage +:= 1
   RESULTIS 0
}1

AND get_next_block(st) = VALOF
{1 LET pages = st!thispage+st!block_pages > st!file_size -> 
                  st!file_size-st!thispage,
                     st!block_pages

   st!buffer := st!buff_base
   IF directio(st!stream,st!thispage,st!buffer,pages*page_csz,TRUE) < 0 THEN
   {  st!errcode := E4failcode
      RESULTIS errorvalue
   }
   st!page_offset := 0
   RESULTIS 0
}1

AND get_next_page(st) = VALOF
{1 st!thispage +:= 1
   st!page_offset +:= 1
   IF st!thispage = st!file_size THEN
   {  st!errcode := eoffound2
      RESULTIS eoffound2
   }
   TEST st!page_offset = st!block_pages THEN
      UNLESS get_next_block(st) = 0 RESULTIS st!errcode
   ELSE st!buffer +:= page_csz
   st!thispos := 0
   st!thisrec := sfo.firstrec
   RESULTIS 0
}1
 
AND close(strm) = VALOF
{1 
   LET st = streamtable!strm
   IF st=0 stop(#XBAD1)   
{ LET nblocks=0
   IF st!mode = file.direct THEN
      UNLESS st!access<4 | st!errcode \= 0 DO
      {  extendfile(st!stream,st!thispage+1) // adjust to actual size 
         put_block(st, st!page_offset + 1)
         nblocks:=st!thispage+1
      }
   TEST st!mode = file.serial THEN
      TEST st!access<4 THEN
      {  selectinput(st!stream)
         endread()
      }
      ELSE 
      {  selectoutput(st!stream)
         endwrite()
      }
   ELSE IF st!mode = file.direct THEN
      closedirect(st!stream)
   free.st(st)
   streamtable!strm := 0
   RESULTIS nblocks
}1

AND null_in(p1,p2,p3,p4) = VALOF RESULTIS eoffound2 

AND null_out(p1,p2) = VALOF RESULTIS 0
 
AND sfo.put(userbuff, st) = VALOF
{1 LET len = !userbuff
   LET reclen=(len+3)>>1  // length in words.
   LET buff=st!buffer
   LET recptr = st!thisrec

   UNLESS st!errcode=0 DO
   {  E4failcode := st!errcode
      RESULTIS errorvalue
   }

   userbuff+:=1
   IF recptr+reclen>page_csz THEN
   {  buff!sfo.block := -1
      UNLESS put_page(st)=0 RESULTIS errorvalue
      init_page(st)
      recptr := st!thisrec
      buff := st!buffer
   }
   buff!recptr:=len+2
 { LET record = buff+recptr+1  // start of information within record.
   IF (len & 1) \= 0 THEN userbuff!len:=0
   FOR i=record TO ((len-1)/2)+record DO 
   {  !i := (parity(userbuff!0)<<8)+parity(userbuff!1)
      userbuff +:= 2 
   }
   st!thisrec+:=reclen
   UNLESS recptr+reclen = page_csz
   DO buff!(st!thisrec) := 0  // mark as end of block.
   RESULTIS st!options=1 -> (put_block(st, 1)=0 -> 0, errorvalue), 0
}1
 
AND sfo.get(userbuff, maxlen, term, st) = VALOF
{1 LET userpos=1
   {  LET buff=st!buffer
      LET len = ?
      LET reclen = ?
      LET recptr = st!thisrec
      
   UNLESS st!errcode=0 DO 
   {  E4failcode := st!errcode
      RESULTIS errorvalue
   }

   IF buff!recptr<=0 |
      recptr>=page_csz THEN
   {  UNLESS buff!sfo.block = -1 DO 
      {  st!errcode:=eoffound2
         !userbuff:=userpos - 1
         E4failcode := (userpos=1 -> eoffound2, eoffound1)
         RESULTIS errorvalue
      }
      get_next_page(st)
      LOOP
   }
   len:=buff!recptr           // length including itsself.
   reclen:=(len+1)>>1
   IF (reclen+recptr-1)>=page_csz
   THEN                              
   {  st!errcode:=eoffound2
      E4failcode := eoffound2
      RESULTIS errorvalue
   }

   len -:= 2
   userbuff!0 := len
   userbuff +:= 1
 { LET userlen = len > maxlen -> maxlen/2 , reclen-1
   LET record = buff+recptr+1
   FOR i = record TO record+userlen DO
   {  !userbuff := (!i >> 8) & #X7F
      userbuff!1 := !i & #X7F
      userbuff +:= 2
   }
   IF len > maxlen THEN
   {  E4failcode := sfo.toolong
      RESULTIS errorvalue
   }
 }
   st!thisrec+:=reclen
   RESULTIS 0
   } REPEAT
}1

AND open(fspec, acc, pages, buff, opt) = VALOF
{1 UNLESS fspec%0 = 0 RESULTIS errorvalue
 { LET ftype = fspec!2 & #XFF
   LET open_mode = file.serial
   LET labelled = 0
   LET proc = VALOF SWITCHON ftype INTO
   {  CASE 7:       // create filespec
         labelled := 2
      CASE 0:       // open filespec
         open_mode := file.direct
         RESULTIS acc<4 -> sfo.get, sfo.put

      CASE 3: CASE 5: CASE 6:  // default (**), merge (*M) and peripheral.
         RESULTIS acc<4 -> readrec, writerec

      CASE 4:   // null spec (*N)
         open_mode := file.null
         RESULTIS acc<4 -> null_in, null_out

      DEFAULT: RESULTIS errorvalue
   }
   IF proc = errorvalue RESULTIS errorvalue
 { LET strm = openfile(fspec, acc, TRUE, open_mode, labelled)
   IF strm = errorvalue RESULTIS errorvalue
 { LET st = find.free.st()
   IF st < 0 RESULTIS errorvalue

 { LET dtab=strm*str.entrysize+devtable
   st!file_size := dtab!str.filesize

   st!io_proc := proc
   st!stream, st!options := strm, opt
   st!errcode, st!access := 0, acc
   st!buffer, st!block_pages := buff, pages
   st!buff_base := buff
   st!mode := open_mode
   streamtable!strm := st

   UNLESS open_mode = file.direct RESULTIS strm

   TEST acc < 4 THEN
   {  st!thispage := 0
      IF get_next_block(st) = errorvalue
      THEN RESULTIS errorvalue
      st!thispos := 0
      st!thisrec := sfo.firstrec
   }
   ELSE
   {  st!thispage := 0
      st!page_offset := 0
      init_page(st)
   }
   RESULTIS strm
}1

AND fget(strm,buff,len,term) = VALOF
{1 
   LET st = streamtable!strm
   IF st=0 | st!access >= 4 stop(#XBAD1) 
{ LET proc = st!io_proc
   RESULTIS proc(buff,len,term,st)
}1

AND fput(strm ,buff) = VALOF
{1 
   LET st = streamtable!strm
   IF st=0 | st!access < 4 stop(#XBAD1) 
{ LET proc = st!io_proc
   RESULTIS proc(buff,st) 
}1

AND seek_next(strm) = VALOF
{1 
   LET st = streamtable!strm
   IF st=0 stop(#XBAD1)
{ LET buff = ?
   LET recptr = ?

   {  buff := st!buffer
      recptr := st!thisrec
      UNLESS buff!recptr<=0 |
             recptr>=page_csz BREAK
      UNLESS buff!sfo.block = -1 RESULTIS errorvalue
      get_next_page(st)
   } REPEAT

 { LET reclen = (buff!recptr+1) >> 1
   IF (reclen+recptr-1) >= page_csz RESULTIS errorvalue

   st!thisrec +:= reclen
   st!thispos := 0
   RESULTIS buff!recptr-2       // length of data.
}1

AND seek_last(strm) = VALOF
{1 
   LET st = streamtable!strm
   IF st=0 stop(#XBAD1)
{ LET buff = ?
   LET recptr = st!thisrec

   IF recptr = sfo.firstrec THEN
   {  IF st!thispage=0 RESULTIS errorvalue
      TEST st!page_offset=0 THEN
      {  LET start_page = st!thispage - st!block_pages

         st!thispage -:= 1
         st!buffer := st!buff_base
         IF directio(st!stream,start_page, st!buffer,
                     st!block_pages*page_csz, TRUE) = errorvalue
         RESULTIS errorvalue 
         st!page_offset := st!block_pages-1
      }
      ELSE
      {  st!thispage -:= 1
         st!page_offset -:= 1
         st!buffer -:= page_csz
      }
      recptr := 0
   }

   buff := st!buffer
   {  LET last = sfo.firstrec
      {  LET reclen = (buff!last+1) >> 1
         
         IF last+reclen = recptr | 
            last+reclen >= page_csz |
            buff!(last+reclen) = 0 THEN 
         {  st!thisrec := last
            BREAK
         }
         last +:= reclen
      } REPEAT
   }
   st!thispos:=0
   RESULTIS 0
}1

AND seek_page(strm,page) = VALOF
{1 
   LET st = streamtable!strm
   IF st=0 stop(#XBAD1)
   IF page<0 | page>st!file_size RESULTIS errorvalue
 { LET first_page = (page/st!block_pages)*st!block_pages

   UNLESS first_page<st!thispage<first_page+st!block_pages DO
   {  LET pages = first_page+st!block_pages > st!file_size ->
                    st!file_size-first_page, st!block_pages

      IF directio(st!stream,first_page,st!buffer,pages*page_csz,TRUE) < 0
      THEN RESULTIS errorvalue
   }
   st!thispage := page
   st!page_offset := page - first_page
   st!thisrec := sfo.firstrec
   st!thispos := 0
   st!buffer := st!buff_base + (st!page_offset*page_csz)
   RESULTIS 0
}1