// tspserver.bcpl Tape Server, toplevel
//
// g. krasner November 19, 1979
// last modified by Tim Diebert, June 2, 1980 10:02 AM
// to provide for new low level software
//
get "pup.decl"
get "tapes.d"
get "altodefs.d"
get "tsp.decl"

//---------------------------------------------------------------
external
//---------------------------------------------------------------
[
//From TSPDOs
DoOpenDrive; DoCloseDrive; DoReadRecord; DoWriteRecord
DoFwdSpaceRecord; DoBackSpaceRecord; DoFwdSpaceFile
DoBackSpaceFile; DoWriteEOF; DoWriteBlankTape; DoRewind
DoUnload; DoGetStatus; DoSetStatus; DoSendText; DoGetText
ReplyNo
//From ’System’
Gets; Resets; LoadRam; CallSwat; lvUserFinishProc; lvSwatContextProc
FixedLeft; Usc; AddToZone; sysZone; GetFixed; SetBLV; StartIO
Allocate; InitializeZone; Enqueue; InitializeContext; CallContextList
Block; Unqueue; Dequeue; MoveBlock; Free; Ws
//From Tapes
XMTapeImage; TapeTfsSwatProc; CloseTape
// To Tapes
TapeWaitQuiet
//From Pup
InitPupLevel1; OpenLevel1Socket; OpenRTPSocket; CreateBSPStream
BSPReadBlock; BSPWriteBlock; BSPForceOutput; ExchangePorts
ReleasePBI; CompletePup; AppendStringToPup; BSPGetMark
//From Streams
Wo; Endofs; Closes; keys
//Exported Globals
rwBlock; kbdKey; rwKey; usedidnos; useddrives; ctxQ; currentVersionString
]

//---------------------------------------------------------------
static
//---------------------------------------------------------------
[ rwBlock //shared read/write block
rwKey //key to access the block
kbdKey //key to read from operator’s kbd
usedidnos //vector of id numbers used
useddrives //vector of drives with servers
ctxQ //context queue
currentVersionString //string send with [Version] message
TapeTridentUFP //global stream object
bspSockets //vector of allocated bspSockets
serviceBlocks //vector of allocated Service Blocks
serverContexts //vector of contexts, one per instance of Server
rvSocket //global socket for rendezvouses
]

//---------------------------------------------------------------
let StartServing() be
//---------------------------------------------------------------
[
// Init the trident/tape microcode, set up code to return tasks to ROM when done.
if LoadRam(XMTapeImage ,true) ne 0 do
CallSwat("LoadRam() failed.")
TapeTridentUFP=@lvUserFinishProc
@lvUserFinishProc=TapeTridentBoot
@lvSwatContextProc=TapeTfsSwatProc
// set up server variables
let i = 0
rwKey = -1 //nobody owns rwBlock yet
kbdKey = -1 //nobody owns kbd yet
let v = vec maxServers //v is temp vector
usedidnos = v //vector of id numbers used
let v = vec maxServers //open socket for each server
bspSockets = v
let v = vec maxServers
serviceBlocks = v //allocate Service Blocks
let v = vec maxServers
serverContexts = v //and contexts
let v = vec maxDrives
useddrives = v //vector of drives with servers
for i = 0 to maxDrives-1 do useddrives!i = false //no drive with any server
currentVersionString = "Tape Server Protocol, V0.3"
Ws(currentVersionString)

// set up large sysZone region
v=FixedLeft()-2000
v = (Usc(v, muchcore) eq 1) ? muchcore, v
AddToZone(sysZone, GetFixed(v), v)
// set up rwBlock
rwBlock = Allocate(sysZone,rwBlockLength)
// Initialize BSP socket (Level 1 only)
let myZone = vec (2000*maxServers)
InitializeZone(myZone, (2000*maxServers))
let q = vec 1; ctxQ = q; ctxQ!0 = 0
InitPupLevel1(myZone,ctxQ,(5*maxServers))
rvSocket = Allocate(sysZone,lenBSPSoc)
OpenLevel1Socket(rvSocket, table[ 0; 0; tapeSocket ] ) //set up to listen at socket 44b
//Initialize globals for each Server instance
for i = 0 to maxServers-1 do
[ usedidnos!i = false //no server with any id
bspSockets!i = Allocate(sysZone,lenBSPSoc) //allocate socket block
serviceBlocks!i = Allocate(sysZone,lenService) //allocate Service block
(serviceBlocks!i)>>Service.blk = Allocate(sysZone,cmdBlockLength)
serverContexts!i = Allocate(sysZone,200) //allocate a context for Server
]
let v = vec 300
Enqueue(ctxQ, InitializeContext(v, 300, Connector))
let v = vec 300
Enqueue(ctxQ, InitializeContext(v, 300, DisConnector))
CallContextList(ctxQ!0) repeat
]

//---------------------------------------------------------------
and Connector() be
//---------------------------------------------------------------
[ Block() //let someone else have a go
let i = 0; let soc = 0 //temps
let pbi = Dequeue(lv rvSocket>>PupSoc.iQ) //get packet
unless pbi do [ loop ]
if pbi>>PBI.pup.type ne typeRFC % pbi>>PBI.pup.dPort.host eq 0 then
[ ReleasePBI(pbi); loop ]

//default net field of connection port
if pbi>>PBI.pup.bytes↑1 eq 0 then
pbi>>PBI.pup.bytes↑1 = pbi>>PBI.pup.sPort.net

//check existing sockets for duplicate entry
for i = 0 to maxServers-1 do
if usedidnos!i then //for each existing socket
[
soc = bspSockets!i
if soc ne 0 &
( (lv soc>>RTPSoc.frnPort)!0 eq (lv pbi>>PBI.pup.words)!0
& (lv soc>>RTPSoc.frnPort)!1 eq (lv pbi>>PBI.pup.words)!1
& (lv soc>>RTPSoc.frnPort)!2 eq (lv pbi>>PBI.pup.words)!2 )
& ( (lv soc>>RTPSoc.connID)!0 eq (lv pbi>>PBI.pup.id)!0
& (lv soc>>RTPSoc.connID)!1 eq (lv pbi>>PBI.pup.id)!1 )
then //at last, a duplicate
[ SendRFC(pbi, soc); loop ] //send it back
]

// find an open idnumber
let idno = -1 //id number temp
i = 0
while i ls maxServers do
[ test usedidnos!i
ifnot [ idno = i; i = maxServers+1 ]
ifso i = i+1
]
//idno is -1 if did not find one
if idno ls 0 then
[ pbi>>PBI.pup.words↑1 = 0 //did not find one, send
AppendStringToPup(pbi,3,"TapeServer full, try later") //abort
ExchangePorts(pbi) //message
CompletePup(pbi,typeAbort)
loop
]

//found open idnumber, open a BSP connection for it
let bspSoc = bspSockets!idno //use appropriate socket
OpenLevel1Socket(bspSoc, 0, lv pbi>>PBI.pup.words) //and open level 1 with pbi that came in
OpenRTPSocket(bspSoc, ctxQ, modeImmediateOpen, lv pbi>>PBI.pup.id)
SendRFC(pbi,bspSoc) //reply to its rfc with one of our own
InitializeServer(idno) //set up Service block and enqueue Server
//for this connection
] repeat

//---------------------------------------------------------------
and InitializeServer(idno) be
//---------------------------------------------------------------
[
let bspSoc = bspSockets!idno //socket already set up
let bspStr = CreateBSPStream(bspSoc)
Ws("Connnection open "); Wo(idno)
//Made connection, set up Service block and enqueue instance of Server
usedidnos!idno = true //mark this idno as being used
let ser = serviceBlocks!idno
ser>>Service.idnumber = idno //and set it up
ser>>Service.bspSoc = bspSoc
ser>>Service.bspStr = bspStr
ser>>Service.tape = false
ser>>Service.blk = false
ser>>Service.drive = -1
ser>>Service.retries = 4 //default to 4 retries
ser>>Service.speed = IPS125 //default to 125 ips
let i = serverContexts!idno //point to this context
InitializeContext(i,200,Server,1) //init context with one parameter
i!3 = ser //make parameter point to this Service block
Enqueue(ctxQ,i) //startup Server instance
]

//---------------------------------------------------------------
and SendRFC(pbi, soc) be
//---------------------------------------------------------------
[
MoveBlock(lv pbi>>PBI.pup.words, lv soc>>PupSoc.lclPort, lenPort)
ExchangePorts(pbi)
CompletePup(pbi, typeRFC, pupOvBytes+6)
]

//---------------------------------------------------------------
and DisConnector() be
//---------------------------------------------------------------
[ //Check for closed sockets, and pool their corresponding stuff
let i = 0; let v = 0
for i = 0 to maxServers - 1 do //monitor for disconnection
[ Block()
if (usedidnos!i) & ((bspSockets!i)>>BSPSoc.state ne stateOpen) then
[ //must close this used and open socket
Ws(" Connection Closed="); Wo(i)
v = serviceBlocks!i
if v>>Service.tape then CloseTape(v>>Service.tape)
if (v>>Service.drive ge 0) then useddrives!(v>>Service.drive) = false
Unqueue(ctxQ,serverContexts!i)
if rwKey eq i then rwKey = -1
if kbdKey eq i then kbdKey = -1
Closes(v>>Service.bspStr) //close this BSP stuff
usedidnos!i = false
]
]
] repeat

//---------------------------------------------------------------
and Server(Ctx) be
//---------------------------------------------------------------
[
let ser = Ctx!3 //get Service block from context
ser>>Service.blk = GetCommand(ser)
let blk = ser>>Service.blk
// get version message first
while (blk>>GMessage.type ne cmdVersion) do
[
ReplyNo(ser,noVersion)
if rwKey eq ser>>Service.idnumber then rwKey = -1
if kbdKey eq ser>>Service.idnumber then kbdKey = -1
blk = GetCommand(ser); ser>>Service.blk = blk
]
ReplyVersion(ser) //send version reply
// repeat this loop for each command, until connection is
// terminated by higher authority
let cmd = 0 //command temp
while true do
[ Block() // Let someone else have a go
blk = GetCommand(ser); ser>>Service.blk = blk
cmd = blk>>GMessage.type
switchon cmd into
[
case cmdOpenDrive: DoOpenDrive(ser); endcase
case cmdCloseDrive: DoCloseDrive(ser); endcase
case cmdReadRecord: DoReadRecord(ser); endcase
case cmdWriteRecord: DoWriteRecord(ser); endcase
case cmdFwdSpaceRecord: DoFwdSpaceRecord(ser); endcase
case cmdBackSpaceRecord: DoBackSpaceRecord(ser); endcase
case cmdFwdSpaceFile: DoFwdSpaceFile(ser); endcase
case cmdBackSpaceFile: DoBackSpaceFile(ser); endcase
case cmdWriteEOF: DoWriteEOF(ser); endcase
case cmdWriteBlankTape: DoWriteBlankTape(ser); endcase
case cmdRewind: DoRewind(ser); endcase
case cmdUnload: DoUnload(ser); endcase
case cmdGetStatus: DoGetStatus(ser); endcase
case cmdSetStatus: DoSetStatus(ser); endcase
case cmdSendText: DoSendText(ser); endcase
case cmdGetText: DoGetText(ser); endcase
default: ReplyNo(ser,noGoodMessage); endcase
]
if rwKey eq ser>>Service.idnumber then rwKey = -1 //return key
if kbdKey eq ser>>Service.idnumber then kbdKey = -1 //return key
]
]

//---------------------------------------------------------------
and GetCommand(ser) = valof
//---------------------------------------------------------------
[
let lbyt = GetNonMark(ser); let rbyt = GetNonMark(ser)
let len = rbyt + (lbyt lshift 8)
if lbyt eq -1 % rbyt eq -1 then len = 2 //bad length = 2
lbyt = GetNonMark(ser); rbyt = GetNonMark(ser)
let cmd = rbyt + (lbyt lshift 8)
if lbyt eq -1 % rbyt eq -1 then cmd = -1 //bad length = 2
let blk = ser>>Service.cmdBlock
let maxlen = cmdBlockLength
if cmd eq cmdReadRecord % cmd eq cmdWriteRecord then
[
blk = rwBlock //use rwBlock for Read/Writes
while rwKey ge 0 do Block() //wait for key
rwKey = ser>>Service.idnumber //take key
maxlen = rwBlockLength
]
if len gr maxlen then //give bad command, don’t read any more
[ cmd = -1; len = 2; Resets(ser>>Service.bspStr) ]
blk>>GMessage.length = len
blk>>GMessage.type = cmd
//get the block of data, mark bytes or otherwise just ends block,
// no change to length is made here
BSPReadBlock(ser>>Service.bspStr,lv blk>>GMessage.data,0,len+len-4)
resultis blk //return block pointer
]

//---------------------------------------------------------------
and GetNonMark(ser) = valof
//---------------------------------------------------------------
[ //get next byte, -1 if mark byte
let v = -1; let done = false
until done do
[ Block()
v = Gets(ser>>Service.bspStr)
if v eq -1 & ((ser>>Service.bspSoc)>>BSPSoc.markPending) then
[ BSPGetMark(ser>>Service.bspSoc) //dequeue this mark byte
done = true
]
if v ge 0 then done = true //got byte
]
resultis v
]

//---------------------------------------------------------------
and ReplyVersion(ser) be
//---------------------------------------------------------------
[
let blk = ser>>Service.blk //get command block
blk>>Version.type = cmdVersion
blk>>Version.versno = currentVersion
let str = currentVersionString //message for version
let i = 0
blk>>Version.length = 3 + ((str>>String.length + 2) / 2)
for i = 0 to blk>>Version.length - 4 do
[ (lv blk>>Version.verstext)!i = str!i //copy string
]
// and send block out
BSPWriteBlock(ser>>Service.bspStr,blk,0,2*blk>>Version.length)
BSPForceOutput(ser>>Service.bspSoc)
]

//---------------------------------------------------------------
and TapeTridentBoot() be
//---------------------------------------------------------------
[
SetBLV(#177776) // all but task 0 back into ROM
StartIO(#100000) // boot!
@lvUserFinishProc=TapeTridentUFP
]

//---------------------------------------------------------------
and TapeWaitQuiet() = Block()
//---------------------------------------------------------------