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

(1792)