/* 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)
$)