/*****************************************************************************\
*                           Systems Research Group                            *
*******************************************************************************


                ########   ######   ##        ########  #######  
                ########  ########  ##        ########  ######## 
                ##        ##        ##           ##     ##    ## 
                ######    #######   ##           ##     #######  
                ##              ##  ##           ##     ##    ## 
                ##              ##  ##           ##     ##    ## 
                ##        ########  ########  ########  ######## 
                ##         ######   ########  ########  #######  


*******************************************************************************
*   I. D. Wilson           Last Modified   -   IDW   -   06/10/84             *
\*****************************************************************************/




SECTION "FSLIB"



GET "LIBHDR"
GET "RINGHDR"
GET "bcpl.fshdr"



//   File Server Library, originally due to Brian Knight.
//   ----------------------------------------------------
//
//Modifications:
//   18/05/82 by IDW:   Potential infinite recursion in "fs.close" removed
//   08/10/82 by IDW:   FS.READ.FILE.SIZE added
//   12/01/83 by IDW:   Protocol change for Bridge
//   16/02/83 by IDW:   FSLIB.INITIALIZE changed to task string argument
//                      of the file server it has to use.
//   26/09/84 by IDW:   Changed to use Z80 SSP library




LET fslib.initialize( puid ) = VALOF
$(
    // TRUE iff OK

    fs.sspcb      :=  0
    fs.fileserve  :=  fs.find.fileserver( puid )

    IF  fs.fileserve = 0  THEN  RESULTIS  FALSE

    fs.sspcb      :=  sspopen( fs.fileserve, max.tx.size, max.rx.size )
    
    IF  fs.sspcb = 0  THEN
    $(
        freevec( fs.fileserve )
        
        fs.fileserve  :=  0
        
        RESULTIS  FALSE
    $)

    RESULTIS  TRUE
$)



AND fs.find.fileserver( puid )  =  VALOF
$(
//  Call the packserver to find out the name of the fileserver on which
//  this puid resides.
//
//  N.B.  16 bit specific!

    LET fileserve  =  0

    LET rxblock    =  VEC 20 
    LET txblock    =  VEC  7 

    //  Copy the puid into the SSP request block.

    FOR  i = 0  TO  3  DO  put2bytes( txblock, bb.ssp.args+i, puid!i )
    
    txblock!bb.ssp.length  :=  7
    rxblock!bb.ssp.length  :=  20
    
    TEST  ssp( "PUID.LOCATE", txblock, rxblock )  THEN
    $(
        //  We have succeeded in looking up the puid, so we can return
        //  a pointer to the string representing the name.

        LET string  =  rxblock + bb.ssp.args + 5
        LET length  =  string % 0

        fileserve  :=  getvec( length/bytesperword )
        
        IF  fileserve = 0  THEN  RESULTIS  0
        
        FOR  i = 0  TO  length  DO  fileserve % i  :=  string % i
        
        RESULTIS  fileserve
    $)
    ELSE  RESULTIS  0
$)



AND fs.retrieve(uid, slot, result.puid) = VALOF
    $(
    // Retrieve the PUID retained at offset SLOT in the index
    // referred to by UID (which may be a PUID or a TUID).
    // Copy the puid into the supplied vector.
    // Result is TRUE if the retrieve works, FALSE otherwise.
    // If the index slot is empty, then the result PUID will be all zero.

    LET reply.buff  =  VEC retrieve.reply.size

    TEST fs.command(reply.buff, retrieve.reply.size, fs.op.retrieve, 6,
                    uid!0, uid!1, uid!2, uid!3, 0, slot)
    THEN
      $( // Successful retrieve
      FOR i=0 TO wordupb.uid
      DO result.puid!i := get2bytes(reply.buff, fsbb.args+i)
      RESULTIS TRUE
      $)
    ELSE RESULTIS FALSE // Retrieve failed
    $)



AND fs.ensure(tuid) = VALOF
    $(
    // Ensure that all updates done under TUID are written to disc

    LET reply.buff  =  VEC fsbb.args

    RESULTIS fs.command(reply.buff, fsbb.args, fs.op.ensure, 5,
                        tuid!0, tuid!1, tuid!2, tuid!3, TRUE)
    $)



AND fs.retain(uid, slot, puid) = VALOF
    $(
    // Retain PUID at offset SLOT in index PUID

    LET reply.buff  =  VEC fsbb.args

    RESULTIS fs.command(reply.buff, fsbb.args, fs.op.retain, 10,
                        uid!0, uid!1, uid!2, uid!3,
                        0, slot,
                        puid!0, puid!1, puid!2, puid!3)
    $)



AND fs.create.index(uid, slot, reply.puid) = VALOF
    $(
    // Create a new index at offset SLOT in the index UID,
    // returning its puid in REPLY.PUID.

    LET reply.buff  =  VEC fsbb.args+4

    TEST fs.command(reply.buff, fsbb.args+4, fs.op.ci, 8,
                    uid!0, uid!1, uid!2, uid!3,
                    0, slot,
                    0, 1000)  // 1000 slots
    THEN
      $(
      // Successful creation
      FOR i=0 TO wordupb.uid
      DO reply.puid!i := get2bytes(reply.buff, fsbb.args+i)

      RESULTIS TRUE
      $)
    ELSE RESULTIS FALSE
    $)



AND fs.open(puid, for.writing, tuid.vec, wait.until.free) = VALOF
    $(
    // Get a lock in the fileserver by calling the fileserver OPEN
    // function on PUID.

    LET reply.buff  =  VEC open.reply.size

    TEST  fs.command(reply.buff, open.reply.size, fs.op.open, 5,
                     puid!0, puid!1, puid!2, puid!3,
                     for.writing )
    THEN
      $( // Successful OPEN
      FOR i=0 TO wordupb.uid
      DO tuid.vec!i := get2bytes(reply.buff, fsbb.args+i)

      RESULTIS TRUE
      $)

    ELSE  RESULTIS  FALSE
    $)



AND fs.close(tuid, do.updates) = VALOF
    $(
    // Free a fileserver lock by calling CLOSE on the tuid.
    // If DO.UPDATES is TRUE, then all the changes made to a special
    // file while it was open should be committed.  This is done
    // by calling ENSURE before closing; this is better than just
    // closing, as ENSURE is a repeatable operation, while CLOSE is not.
    //
    // If it succeeds: result is TRUE, RESULT2 on entry is preserved.
    // If it fails:   result is FALSE, RESULT2 is the error code.

    LET res  = ?
    LET r2    = result2

    TEST do.updates
    THEN
      $(
      res  :=   fs.ensure(tuid)

      TEST res
      THEN
        $(
        res  :=  fs.raw.close(tuid, TRUE)
        IF NOT res THEN r2 := result2
        $)
      ELSE fs.raw.close(tuid, FALSE) // Already failed so ignore rc here
      $)
    ELSE
      $(
      res  :=  fs.raw.close(tuid, do.updates)
      IF NOT res THEN r2 := result2
      $)

    result2  :=  r2 // Error code or original result2
    RESULTIS res
    $)



AND fs.raw.close(tuid, do.updates)  = VALOF
    $(
    // Free a fileserver lock by calling CLOSE on the tuid.
    // DO.UPDATES specifies whether or not the updates should be done
    // (on a fileserver special file).
    // Preserves RESULT2

    LET reply.buff = VEC close.reply.size
    LET r2         = result2
    LET res        = ?

    res := fs.command(reply.buff, close.reply.size, fs.op.close, 5,
                      tuid!0, tuid!1, tuid!2, tuid!3,
                      do.updates)

    result2     := r2
    RESULTIS res
    $)



AND fs.read(uid, buff, bytesize, offsetv) = VALOF
    $(
    // Do an SSP read or a full read, depending on the transfer size.

    IF bytesize=0 THEN RESULTIS TRUE // Nothing to do

    RESULTIS [(bytesize <= max.ssp.transfer.bytes) ->
              fs.ssp.read, fs.full.read]   (uid, buff, bytesize, offsetv)
    $)



AND fs.ssp.read(uid, buff, bytesize, offsetv) = VALOF
    $(
    // Read BYTESIZE bytes into BUFF from the 32 bit offset OFFSETV from
    // the file UID, using the SSP read mechanism.

    LET reply.buff      = getvec( bytesize/bytesperword + fsbb.args + 2 )
    LET res             = ?
    LET dibytesize      = bytesize / bytesperringword

    IF  reply.buff = 0  THEN  RESULTIS  FALSE

    res := fs.command(reply.buff, fsbb.args+2+dibytesize, fs.op.ssp.read, 8,
                      uid!0, uid!1, uid!2, uid!3,
                      offsetv!0, offsetv!1,
                      0, dibytesize)

    IF  res  THEN
        blockcopydibytes(reply.buff, fsbb.args+2, buff, 0, dibytesize)

    freevec( reply.buff )

    RESULTIS  res
    $)



AND fs.full.read(uid, buff, bytesize, offsetv)  =  FALSE



AND fs.write(uid, buff, bytesize, offsetv) =

    // Do an SSP write or normal write, depending on the transfer size.

    [(bytesize <= max.ssp.transfer.bytes) ->
                  fs.ssp.write, fs.full.write] (uid, buff, bytesize, offsetv)



AND fs.ssp.write(uid, buff, bytesize, offsetv) = VALOF
    $(
    // Write SIZE words from BUFF to offset OFFSETV in file UID,
    // using the SSP write mechanism.

    LET tx.buff         = getvec( bytesize/bytesperword + fsbb.args + 6 )
    LET res             = 0
    LET tag             = nexttag()
    LET reply.buff      = VEC fsbb.args+2
    LET dibytesize      = bytesize / bytesperringword

    IF  tx.buff = 0  THEN  RESULTIS  FALSE

    set.dibytevec(tx.buff, 10, 0, 0, fs.op.ssp.write, tag,
                  uid!0, uid!1, uid!2, uid!3, offsetv!0, offsetv!1)

    blockcopydibytes(buff, 0, tx.buff, fsbb.args+6, dibytesize )

    res  :=  dossp( tx.buff, fsbb.args+6+dibytesize, reply.buff, fsbb.args+2 )

    freevec( tx.buff )

    RESULTIS  res        
    $)



AND fs.full.write(uid, buff, bytesize, offsetv)  =  FALSE



AND fs.create.file(uid, slot, special, reply.puid) = VALOF
    $(
    // Create a fileserver file at offset SLOT in index UID.
    // Make it a special file iff SPECIAL is TRUE.
    // Success -> result TRUE, PUID of new file in vector REPLY.PUID.
    // Failure -> result FALSE
    //
    // The file is created with very large size, and uninitialized value -1.

    LET reply.buff      = VEC createfile.reply.size

    TEST fs.command(reply.buff, createfile.reply.size, fs.op.createfile, 10,
                    uid!0, uid!1, uid!2, uid!3,   // Index uid
                    0, slot,                      // Offset
                    #X00D9, #X6C00,               // Maximum file size
                    uninitialized.file.value,     // Uninitialized value
                    special)
    THEN
      $(
      FOR i=0 TO wordupb.uid
      DO reply.puid!i := get2bytes(reply.buff, fsbb.args+i)

      RESULTIS TRUE
      $)
    ELSE RESULTIS FALSE
    $)



AND fs.delete(index.puid, slot) = VALOF
    $(
    // Delete the entry at offset SLOT in the index INDEX.UID.

    LET reply.buff      = VEC delete.reply.size

    RESULTIS fs.command(reply.buff, delete.reply.size, fs.op.delete, 6,
                        index.puid!0, index.puid!1, index.puid!2, index.puid!3,
                        0, slot)
    $)



AND fs.read.file.size(file.puid, resvec) = VALOF
    $(
    // Read the size of the file.
    // Result is TRUE iff it works, HWM in RESVEC

    LET reply.buff      = VEC hwm.reply.size
    LET res             = fs.command(reply.buff, hwm.reply.size, fs.op.rfs, 4,
                          file.puid!0, file.puid!1, file.puid!2, file.puid!3)
    LET hwm.ls          = get2bytes(reply.buff, fsbb.args+1) // LS word only
    LET hwm.ms          = get2bytes(reply.buff, fsbb.args+0)

    IF NOT res THEN RESULTIS res // Failed

    resvec!0  :=  hwm.ms
    resvec!1  :=  hwm.ls

    RESULTIS  res
    $)



AND fs.read.file.hwm(file.puid, resvec) = VALOF
    $(
    // Read the high water mark of the file.
    // Result is TRUE iff it works, HWM in RESVEC

    LET reply.buff      = VEC hwm.reply.size
    LET res             = fs.command(reply.buff, hwm.reply.size, fs.op.rfhwm, 4,
                          file.puid!0, file.puid!1, file.puid!2, file.puid!3)
    LET hwm.ls          = get2bytes(reply.buff, fsbb.args+1) // LS word only
    LET hwm.ms          = get2bytes(reply.buff, fsbb.args+0)

    IF NOT res THEN RESULTIS res // Failed

    resvec!0  :=  hwm.ms
    resvec!1  :=  hwm.ls

    RESULTIS  res
    $)



AND fs.command(reply.buff, reply.buff.size, operation, num.args,
               a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = VALOF
    $(
    // Do a fileserver command, putting the reply in the supplied vector.
    // REPLY.BUFF.SIZE is the number of dibytes in the reply vector.
    // OPERATION is the fileserver operation code.
    // NUM.ARGS is the number of 16-bit argument words to send; these are
    // given in A1 onwards.

    LET tx.buff         = VEC tx.buff.upb
    LET tag             = nexttag()
    LET time1           = ?

    set.dibytevec(tx.buff, tx.buff.upb, 0, 0, operation, tag,
                  a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)

    RESULTIS  dossp( tx.buff, fsbb.args+num.args, reply.buff, reply.buff.size )
    $)



AND dossp( tx.buff, tx.size, rx.buff, rx.size )  =  VALOF
$(
//  Send an SSP, and wait for its reply.

    tx.buff!bb.ssp.length  :=  tx.size - bb.ssp.type
    rx.buff!bb.ssp.length  :=  rx.size - bb.ssp.type
  
retry:
    sspnport( fs.sspcb )
    sendssp( fs.sspcb, tx.buff, rx.buff )

    $(  //  Loop to wait for the reply to come back.
    
        LET rc  =  testssp( fs.sspcb )
        LET r2  =  result2

        SWITCHON  rc  INTO
        $(
            CASE 0  :  //  Success.  The operation has completed, and so we
                       //  can return the result to the user.
                       
                       result2  :=  get2bytes( rx.buff, bb.ssp.rc )

                       RESULTIS  TRUE
                       
            CASE 11 :
            CASE 12 :  //  We should wait for a bit, and then retry
                       //  the operation.
                       
                       FOR  i = 1  TO  5000  DO  nextco()
                       
                       rfshssp( fs.sspcb, fs.fileserve )
                       
                       GOTO  retry
                       

            CASE 13 :  RESULTIS  FALSE


            CASE 14 :  //  Error return code.  Look to see if the return code
                       //  is one of the #XFxxx type, and if it is, retry the
                       //  operation.
                       
                       IF  (result2 & #XF000) = #XF000  THEN  GOTO  retry
            
                       RESULTIS  FALSE
                       
                       
            DEFAULT :  //  Any others can be ignored until something more
                       //  interesting comes along.
                       
                       nextco()
        $)
    $)
    REPEAT
$)



AND fs.explain.rc(returncode) BE
    $(
    // Call the fileserver to get a text explanation of one of its
    // return codes.
    // This routine does nothing if the global flag FS.RC.MESSAGES.ON
    // is FALSE.

    LET reply.buff = VEC ex.reply.size

    writef("****** Fileserver rc %x4: ", returncode)

    TEST fs.command(reply.buff, ex.reply.size, fs.op.explain, 1, returncode)
    THEN FOR i=1 TO byteget(reply.buff, fsbb.args*bytesperringword + 0)
         DO wrch( byteget(reply.buff, fsbb.args*bytesperringword + i) )
    ELSE writes("EXPLAIN failed")

    newline()
    $)



AND nexttag() = VALOF
    $( // Allocate the next 16 bit tag
    global.tag := (global.tag+1) & #XFFFF
    RESULTIS global.tag
    $)



AND set.dibytevec(v, n, a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14) BE
    $( // Set fields 0 to n-1 of dibyte vector V from A1 upwards
    FOR i=0 TO n-1 DO put2bytes(v, bb.ssp.type+i, [@a1]!i)
    $)



AND blockcopydibytes(frombuff, fboffset, tobuff, tboffset, n) BE
    $(
    // Copy N dibytes from dibyte offset FBOFFSET in vector FROMBUFF
    // to offset TBOFFSET in vector TOBUFF.
    // Replace by machine code for speed.

    FOR i=0 TO n-1
    DO put2bytes(tobuff, tboffset+i, get2bytes[frombuff, fboffset+i] )
    $)


