/*      WORK COROUTINE FOR FILE HANDLER VERSION 2.1
        (modified for 8086 segmented Tripos,
         by adding Act.Readcode to read into code area)

*/


SECTION "WORK"


GET "libhdr"

GET "fh2hdr"

GET "manhdr"

GET "iohdr"


LET Work(Pkt) BE
$( Work.Level := Level()
   Work.Idle := FALSE
   SetArgs(Pkt)
   SWITCHON Pkt!Pkt.Type INTO
   $( DEFAULT:
         ReturnPkt(Pkt, 0, Error.ActionNotKnown)
         ENDCASE

      CASE Action.CopyObject:
// ***** alter for exclusive locks
         Trust.Lock(Arg1, Shared.Lock)
         ReturnPkt(Pkt, Get.Lock(Arg1!Lock.Key, Shared.Lock))
         ENDCASE

      CASE Action.GetBlock:
         $( let b = getblock(arg1, available)
            for i = 0 to size.block-1 do arg2!i := b!i
            returnpkt(pkt, true)
            endcase
         $)

      CASE Action.CreateObject:
         CreateObject(Pkt)
         ENDCASE

      CASE Action.LocateObject:
         LocateObject(Pkt)
         ENDCASE

      CASE Action.DeleteObject:
         DeleteObject(Pkt)
         ENDCASE

      CASE Action.RenameObject:
         RenameObject(Pkt)
         ENDCASE

      CASE Action.FindOutput:
         FindOut(Pkt)
         ENDCASE

      CASE Action.FindInput:
         FindIn(Pkt)
         ENDCASE

      CASE 'W':
      CASE Action.Write:
         WriteV(Pkt)
         ENDCASE

      CASE 'R':
      CASE Action.Read:
         ReadV(Pkt)
         ENDCASE

      CASE 'C':
      CASE Action.ReadCode:
         ReadVCode(Pkt)
         ENDCASE

      CASE Action.CloseInput:
         CloseInput(Pkt)
         ENDCASE

      CASE Action.CloseOutput:
         CloseOutput(Pkt)
         ENDCASE

      CASE Action.FreeLock:
         Trust.Lock(Arg1, Shared.Lock)
         UNLESS Arg1=0 DO Free.Lock(Arg1)
         ReturnPkt(Pkt, TRUE)
         ENDCASE

      CASE action.note:
         note.fn(packet)
         ENDCASE

      CASE action.point:
         point.fn(packet)
         ENDCASE

      CASE Action.SetMap:
         Map := Arg1
         ReturnPkt(Pkt, TRUE)
         ENDCASE

      CASE Action.Die:
         UNLESS Access.Idle & Packet.Queue=0 & Lock.Queue=0 DO
         $( ReturnPkt(Pkt, 0, Error.Busy)
            ENDCASE
         $)
         UNLESS Map=0 DO FreeVec(Map-Size.MapPrefix)
         FOR i = 1 TO !Cache DO FreeVec(Cache!i-Size.CachePrefix)
         FreeVec(Cache)
         DeleteCo(Main.Co)
         DeleteCo(Access.Co)
||       UnloadSeg(DeleteDev[DeviceId])
         ReturnPkt(Pkt, TRUE)
         CoWait(StackBase)
   $)
Continue:
   Work.Idle := TRUE
   Pkt := ResumeCo(Main.Co)
   LOOP
Fail:
   ReturnPkt(Pkt, 0, Result2)
   Work.Idle := TRUE
   Pkt := ResumeCo(Main.Co)
$) REPEAT


AND CreateObject(Pkt) BE
// ARG1 - directory lock
// ARG2 - name of new object
// ARG3 - info bits
// ARG4 - TRUE => also free directory lock
$( LET Directory.Key = Trust.Lock(Arg1, Shared.Lock)
   LET Entry.Key = DirectoryEntry(Directory.Key, Arg2)
   LET Directory.Block, Entry.Block = ?, ?
   IF Arg4 THEN Free.Lock(Arg1)

   Trust.Name(Arg2)

   UNLESS Entry.Key=0 DO
   $( LET blk = getblock(entry.key, noneedtowait)
      LET x = ?
      IF blk!b.file.secondarytype>0 DO FailPkt(Error.ObjectWrongType)
      x := delete(entry.key)
      IF HeadBlock.Lookup=Entry.Key THEN HeadBlock.Lookup := x
   $)

   WriteProtected()

   Entry.Block := ConstructHeader(Arg2,         // Name
                                  HeadBlock.Lookup, // Hash chain value
                                  -[ABS DirectorySType.Lookup+1], // S type
                                  Directory.Key, // Parent directory
                                  Arg3) // Info bits
   Entry.Key := Result2

   WriteBlock(Entry.Block, 0)
   Directory.Block := GetBlock(Directory.Key, Available)
   Put(Directory.Block, HashValue(Arg2), Entry.Key)
   Put(Directory.Block, B.File.SecondaryType,
        ABS Directory.Block!B.File.SecondaryType) // Flag as dir
   WriteBlock(Directory.Block, Entry.Key)

   ReturnPkt(Pkt, Get.Lock[Entry.Key, Exclusive.Lock])
$)


// Locate an object
AND LocateObject(Pkt) BE
// ARG1 - directory lock
// ARG2 - name of object
// ARG3 - access required, TRUE -> exclusive, shared
// ARG4 - TRUE => also free directory lock
$( LET Directory.Key = Trust.Lock(Arg1, Shared.Lock)
   LET Entry.Key = CompString(Arg2, "$")=0 -> RootKey,
      DirectoryEntry(Directory.Key, Arg2)
   LET Lock, Entry.Block = ?, ?
   IF Arg4 THEN Free.Lock(Arg1)
   IF Entry.Key=0 DO FailPkt(Result2)

   Lock := Get.Lock(Entry.Key, [Arg3 -> Exclusive.Lock, Shared.Lock])
   IF Lock=0 DO FailPkt(Result2)

   || ************** Entry.Block := GetBlock(Entry.Key, NoNeedToWait)
      Entry.Block := GetBlock(Entry.Key, Available)
   ReturnPkt(Pkt, Lock, Entry.Block!B.File.InfoBits)
$)


AND FindOut(Pkt) BE
// Open for output
// ARG1 - stream control block
// ARG2 - exclusive lock on created file
$( LET File.Key = Trust.Lock(Arg2, Exclusive.Lock)
   LET Fcb = ?
   CheckFile(File.Key, TRUE)
   WriteProtected()
   Fcb := Clear(Get.Vec[Size.Fcb-1], Size.Fcb)

   Set.Vec(Fcb, 5,
           0,           // link
           Arg2,        // lock
           Arg2!Lock.Key, // dummy first data block
           B.File.DataBase, // offset of data
           [Size.Block-B.File.DataBase]) // remaining bytes

   Fcb![Fcb.XVec+PreAllocationFactor-1] := Arg2!Lock.Key
   PreAllocate(Fcb) // allocate some data blocks

   MakeNextData(Fcb, TRUE)

   // set fields in scb
   Arg1!Scb.Func2 := FH1Write
   Arg1!Scb.Func3 := FHEndWrite
   Arg1!Scb.Arg1  := Fcb

   ReturnPkt(Pkt, Arg1)
$)


AND CheckFile(Key, IsFile) BE
|| **************** $( LET Blk = GetBlock(Key, NoNeedToWait)
$( LET Blk = GetBlock(Key, Available)
   IF Blk!B.File.SecondaryType<=0 NEQV IsFile THEN
        FailPkt(Error.ObjectWrongType)
$)


AND WriteV(Pkt) BE
$( LET Fcb, v, n = Arg1, Arg2, Arg3
   LET Len, Data = Fcb!Fcb.Len, Fcb!Fcb.DataKey
   LET offset = fcb!fcb.off
   LET ChainKey, LastKey = 0, 0
   LET Blk = ?

   TEST n>Len
   THEN
   // We have to write new data blocks
   $( v, n := v+Len, n-Len
      Len := n>[Size.Block-B.File.DataBase] ->
               [Size.Block-B.File.DataBase], n
      Blk := MakeNextData(Fcb, ChainKey\=0)
      IF ChainKey=0 DO ChainKey := Result2
      LastKey := Result2

      WriteOut(Blk, v, Len, b.data.database)
      WriteBlock(Blk, blk!cache.afterkey)

      IF n=Len DO
      $( Fcb!Fcb.Off := B.File.DataBase+Len
         n := Fcb!Fcb.Len
         Fcb!Fcb.Len := Size.Block-B.File.DataBase-Len
         BREAK
      $)
   $) REPEAT
   ELSE
   $( Fcb!Fcb.Off := Fcb!Fcb.Off+n
      Fcb!Fcb.Len := Fcb!Fcb.Len-n
   $)

      ||**********lk := GetBlock(Data, NoNeedToWait)
      Blk := GetBlock(Data, Available)
   WriteOut(Blk, Arg2, n, offset)
   IF blk!b.data.nextdatakey=0
   THEN Put(Blk, B.Data.NextDataKey, ChainKey)
        || Chain new blocks onto data chain
   WriteBlock(Blk, LastKey)

   ReturnPkt(Pkt, TRUE)
$)


AND WriteOut(Buff, v, Len, offset) BE
$( LET Size = Buff!B.Data.DataSize
   LET Base = Buff+offset
   LET Sum = 0

   FOR i = 0 TO Len-1 DO
   $( LET x, y = v!i, base!i
      Base!i := x
      Sum := Sum+x-y
   $)

   IF [offset+len-b.data.database]>size
   THEN Buff!B.Data.DataSize := offset+Len-b.data.database
   Buff!B.Data.CheckSum := Buff!B.Data.CheckSum-Sum+size-buff!b.data.datasize
$)


AND FindIn(Pkt) BE
// Open for input
// ARG1 - stream control block
// ARG2 - exclusive or shared lock on file
$( LET File.Key = Trust.Lock(Arg2, Shared.Lock)
   || **************** LET Blk = GetBlock(File.Key, NoNeedToWait)
   LET Blk = GetBlock(File.Key, Available)
   LET Fcb = ?
   CheckFile(File.Key, TRUE)
   Fcb := Clear(Get.Vec[Size.Fcb-1], Size.Fcb)

   Set.Vec(Fcb, 4,
           0,           // link
           Arg2,        // lock
           File.Key,    // dummy first data block
           B.File.DataBase)

   // Set fields in the scb
   Arg1!Scb.Func1 := FH1Read
   Arg1!Scb.Func3 := FHEndRead
   Arg1!Scb.Arg1  := Fcb

   ReturnPkt(Pkt, Arg1)
$)


AND CloseOutput(Pkt) BE
// close a file that is open for output
// ARG1 - File control block
$( LET Fcb = Arg1
   LET Seq, Ptr = Fcb!Fcb.Seq, Fcb!Fcb.XPtr
   LET File.Key = Trust.Lock(Fcb!Fcb.Lock, Exclusive.Lock)
   LET Blk = GetBlock(File.Key, Available)
   LET Extent = Blk!B.File.HighestSeq
   LET Residue = Ptr-[Fcb+Fcb.XVec]

   UNLESS extent+residue>size.hashtable
   DO
   $( FOR i = 1 TO Residue DO
           Put(Blk, [B.File.KeyVectorBase-Extent-i], Fcb![Fcb.XVec+i-1])
      Put(Blk, B.File.HighestSeq, Extent+Residue)
      WriteBlock(Blk, Ptr!-1)
   $)

   UNTIL !Ptr=0 DO
   $( FreeKey(!Ptr)
      Ptr := Ptr+1
   $)

   Free.Lock(Fcb!Fcb.Lock)
   FreeVec(Fcb)
   ReturnPkt(Pkt, TRUE)
$)


AND CloseInput(Pkt) BE
$( Trust.Lock(Arg1!Fcb.Lock, Shared.Lock)
   Free.Lock(Arg1!Fcb.Lock)
   FreeVec(Arg1)
   ReturnPkt(Pkt, TRUE)
$)


AND ReadV(Pkt) BE ReadV.generic(Pkt, 'D')

AND ReadVCode(Pkt) BE ReadV.generic(Pkt, 'C')

AND ReadV.generic(Pkt, c) BE
$( LET Fcb, v, n, seg = Arg1, Arg2, Arg3, Arg4
   LET Off, Len, Data = Fcb!Fcb.Off, Fcb!Fcb.Len, Fcb!Fcb.DataKey
   LET codesg = c='C'

   $( LET Amount = n>Len -> Len, n
      LET Blk = ?
      IF Len=0 DO
      $( IF Data=0 BREAK
         || **************** Blk := GetBlock(Data, NoNeedToWait)
         Blk := GetBlock(Data, Available)
         Data := Blk!B.Data.NextDataKey
         IF Data=0 BREAK
         || **************** Blk := GetBlock(Data, NoNeedToWait)
         Blk := GetBlock(Data, Available)
         Off, Len := B.Data.DataBase, Blk!B.Data.DataSize
         LOOP
      $)

      IF n=0 BREAK

      || **************** Blk := GetBlock(Data, NoNeedToWait)
      Blk := GetBlock(Data, Available)
      TEST codesg DO FOR i = 0 TO Amount-1 DO
                       storecode(v+i*2,seg,  [Blk+Off] !i)
      OR
      FOR i = 0 TO Amount-1 DO v!i := [Blk+Off]!i

      Len := Len-Amount
      Off := Off+Amount
      n := n-Amount
      v := v +(codesg->Amount*2, Amount)
   $) REPEAT

   Fcb!Fcb.Len := Len
   Fcb!Fcb.Off := Off
   Fcb!Fcb.DataKey := Data

   TEST Data=0
   THEN ReturnPkt(Pkt, n-Arg3, 0)
   ELSE ReturnPkt(Pkt, Arg3, 1)
$)


AND DeleteObject(Pkt) BE
// ARG1 - shared lock on directory
// ARG2 - name of object to be deleted
$( LET Directory.Key = Trust.Lock(Arg1, Shared.Lock)
   LET Entry.Key = DirectoryEntry(Directory.Key, Arg2)
   free.lock(arg1)
   Delete(Entry.Key)
   ReturnPkt(Pkt, TRUE)
$)

AND Delete(Entry.Key) = VALOF
$( LET Blk, HashChain = ?, ?
   LET Lock = Get.Lock(Entry.Key, Exclusive.Lock)

   IF Entry.Key=0 DO FailPkt(Error.ObjectNotFound)
   IF Lock=0 DO FailPkt(Result2)
   Free.Lock(Lock)
   WriteProtected()

   || **************** Blk := GetBlock(Entry.Key, NoNeedToWait)
   Blk := GetBlock(Entry.Key, Available)
   IF Blk!B.File.SecondaryType>0 DO
   $( LET Pr.Ents = 0
      FOR i = B.Dir.HashTableBase TO B.Dir.HashTableLimit
         IF Blk!i\=0 THEN Pr.Ents := Pr.Ents+1
      IF Pr.Ents>0 THEN FailPkt(Error.DirectoryNotEmpty)
   $)
   HashChain := Blk!B.File.HashChain

   Blk := GetBlock(LastBlock.Lookup, Available)
   Put(Blk, Offset.Lookup, HashChain)
   WriteBlock(Blk, 0)

   Blk := GetBlock(Entry.Key, Available)
   FOR i = 1 TO Blk!B.File.HighestSeq DO
        FreeKey(Blk![B.File.KeyVectorBase-i])
   Put(Blk, B.File.Type, T.Short+T.Deleted)
   WriteBlock(Blk, LastBlock.Lookup)
   GetBlock(Entry.Key, UntilFree)
   FreeKey(Entry.Key)
   RESULTIS HashChain
$)

AND RenameObject(Pkt) BE
// ARG1 - from directory lock
// ARG2 - from name
// ARG3 - to directory lock
// ARG4 - to name
$( let fromdir = trust.lock(arg1, shared.lock)
   let todir =   trust.lock(arg3, shared.lock)
   let samechain = fromdir=todir & hashvalue(arg2)=hashvalue(arg4)
   let fromkey, tokey = ?, ?
   let lastfrom, offsetfrom, lastto, offsetto, next, blk = ?, ?, ?, ?, ?, ?

   writeprotected()

   fromkey := directoryentry(fromdir, arg2)
   if fromkey=0 then failpkt(result2)
   $( let x = get.lock(fromkey, exclusive.lock)
      test x=0
      then failpkt(error.objectinuse)
      else free.lock(x)
   $)
   lastfrom, offsetfrom := lastblock.lookup, offset.lookup


   tokey := directoryentry(todir, arg4)
   unless tokey=0 do
   $( let x = get.lock(tokey, exclusive.lock)
      test x=0
      then failpkt(error.objectinuse)
      else free.lock(x)
   $)
   unless tokey=0 | fromkey=tokey do delete(tokey)
   tokey := directoryentry(todir, arg4)
      // LASTBLOCK.LOOKUP set to last block in overflow chain
   lastto, offsetto := lastblock.lookup, offset.lookup

   unless samechain then
   $( blk := getblock(lastto, available)
      put(blk, offsetto, fromkey)
      writeblock(blk, 0)
         // make last in 'to' chain point to 'from' header block

      blk := getblock(fromkey, available)
      next := blk!b.file.hashchain
      blk := getblock(lastfrom, available)
      put(blk, offsetfrom, next)
      writeblock(blk, lastto)
         // bypass 'from' header block on its present chain
   $)

   blk := getblock(fromkey, available)
   unless samechain then
   $( put(blk, b.file.hashchain, 0) // end of hash chain
      put(blk, b.file.parentdir, todir) // now in different directory
   $)
   for i = 0 to 15 do put(blk, b.file.filename+i, arg4!i)
                            // filename has changed also!
   writeblock(blk, [samechain -> 0, lastfrom])

   returnpkt(pkt, true)
$)

AND note.fn(pkt) BE
|| FCB in arg1
|| CB  in arg2
$( LET blk = getblock(arg1!fcb.datakey, noneedtowait)
   arg2!0 := blk!b.data.seq
   arg2!1 := arg1!fcb.off-b.data.database
   arg2!2 := 0
   returnpkt(pkt, TRUE)
$)

AND point.fn(pkt) BE
|| FCB in ARG1
|| CB  in ARG2
$( LET header.key = arg1!fcb.lock!lock.key
   LET blk = getblock(header.key, available)
   LET datakey = ![blk+b.file.keyvectorbase-arg2!0]
   LET datablk = ?

   IF datakey=0
   THEN datakey := [arg1+fcb.xptr+1]![(arg2!0-1) REM preallocationfactor]

   datablk := getblock(datakey, noneedtowait)

   UNLESS datablk!b.data.fileheaderkey=header.key &
          datablk!b.data.seq=arg2!0
   DO returnpkt(pkt, 0, error..point.error)

   arg1!fcb.datakey := datakey
   arg1!fcb.off := arg2!1+b.data.database
   arg1!fcb.len := size.block-arg1!fcb.off
   returnpkt(pkt, TRUE)
$)