// DDTapeServer.bcpl -- Dual Density Tape Server, toplevel
// last modified by Tim Diebert, December 15, 1981 9:44 AM
//
get "Pup.decl"
get "DDTapes.d"
get "AltoDefs.d"
get "DDTapeServer.decl"

//---------------------------------------------------------------
external
//---------------------------------------------------------------
[

//From DDTapeServerDOs
DoOpenDrive; DoCloseDrive; DoReadRecord; DoWriteRecord
DoFwdSpaceRecord; DoBackSpaceRecord; DoFwdSpaceFile
DoBackSpaceFile; DoWriteEOF; DoWriteBlankTape; DoRewind
DoUnload; DoGetStatus; DoSetStatus; DoSendText; DoGetText
ReplyNo

//From DDTapeServerDispUtil
InitDisplay; DWs; DWo; MonitorKeys

//From ’System’
Gets; Resets; LoadRam; CallSwat; lvUserFinishProc; lvSwatContextProc
FixedLeft; Usc; AddToZone; sysZone; GetFixed; SetBLV; StartIO
Allocate; InitializeZone; Enqueue; InitializeContext; CallContextList
Block; Dismiss; Unqueue; Dequeue; MoveBlock; Free; Ws; InitBcplRuntime; SetEndCode

// To Tapes
TapeWaitQuiet

//From Pup
InitPupLevel1; SetAllocation; dPSIB; OpenLevel1Socket; OpenRTPSocket; CreateBSPStream
BSPReadBlock; BSPWriteBlock; BSPForceOutput; ExchangePorts
ReleasePBI; CompletePup; AppendStringToPup; BSPGetMark; PupChecksum

//From Streams
Wo; Endofs; Closes; keys

//Exported Globals
rwBlock; kbdKey; rwKey; usedidnos; useddrives; ctxQ; currentVersionString
numConnections; spyZone
]

//---------------------------------------------------------------
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
numConnections //Number of open connections
spyZone //symbol area for spy
]

//---------------------------------------------------------------
let StartServing() be
//---------------------------------------------------------------
[
// Init the trident/tape microcode, set up code to return tasks to ROM when done.
unless InitializeDDTape() do
CallSwat("InitializeDDTape() failed.")
SetEndCode(InitializeDDTape)
InitBcplRuntime()
InitDisplay()
TapeTridentUFP=@lvUserFinishProc
@lvUserFinishProc=TapeTridentBoot
@lvSwatContextProc=TapeTfsSwatProc

// set up server variables
let i = 0
numConnections = 0 // reset number of open connections
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"
DWs(" DDTapeServer of December 15, 1981 9:44 AM ")
DWs(currentVersionString)

// set up large sysZone region
v=FixedLeft() - 2000
v = (Usc(v, muchcore) eq 1) ? muchcore, v
AddToZone(sysZone, GetFixed(v), v)
spyZone = Allocate(sysZone, #1200, false, true)

// set up rwBlock
rwBlock = Allocate(sysZone, rwBlockLength / 2)

// Initialize BSP socket (Level 1 only)
let myZone = vec (4000 * maxServers)
InitializeZone(myZone, (4000 * maxServers))
let q = vec 1
ctxQ = q
ctxQ!0 = 0
InitPupLevel1(myZone, ctxQ, (10 * maxServers))
let dSoc = dPSIB - offset PupSoc.psib / 16
SetAllocation(dSoc, (10 * maxServers) / maxServers,
(10 * maxServers) / maxServers - 1,
(10 * maxServers) / maxServers - 1)
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.cmdBlock = Allocate(sysZone, cmdBlockLength)
serverContexts!i = Allocate(sysZone, 300) //allocate a context for Server
]

let v = vec 400
Enqueue(ctxQ, InitializeContext(v, 400, Connector))
let v = vec 400
Enqueue(ctxQ, InitializeContext(v, 400, DisConnector))
let v = vec 400
Enqueue(ctxQ, InitializeContext(v, 400, MonitorKeys))
PupChecksum = UPupChecksum

CallContextList(ctxQ!0) repeat // start the mess up
]

//---------------------------------------------------------------
and Connector() be
//---------------------------------------------------------------
[
Dismiss(100) //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
let duplicate = valof
[
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)
resultis true //send it back
]
]
resultis false
]

if duplicate then loop

// 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)
DWs("*NConnnection open with ")
DWo(bspSoc>>BSPSoc.frnPort.net)
DWs("#"); DWo(bspSoc>>BSPSoc.frnPort.host)
DWs("# using id number ")
DWo(idno)
numConnections = numConnections + 1

//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
let i = serverContexts!idno //point to this context
InitializeContext(i, 300, 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
[
Dismiss(25)
if (usedidnos!i) & ((bspSockets!i)>>BSPSoc.state ne stateOpen) then
[ //must close this used and open socket
let bspSoc = bspSockets!i
DWs("*nConnection closed with ")
DWo(bspSoc>>BSPSoc.frnPort.net)
DWs("#")
DWo(bspSoc>>BSPSoc.frnPort.host)
DWs("# using id number ")
DWo(i)
numConnections = numConnections - 1
v = serviceBlocks!i
if v>>Service.tape then CloseDDTape(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
//---------------------------------------------------------------
[
(table [ #61010; #1401])(#177776, #22) // all but task 0 back into ROM
StartIO(#100000) // boot!
@lvUserFinishProc=TapeTridentUFP
]

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