//   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()
//---------------------------------------------------------------
(635)

(1792)