// FtpMiscb.bcpl - miscellaneous subsystem-specific routines
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modifed February 14, 1982  5:16 PM by Boggs

get "Pup0.decl"
get "Pup1.decl"
get "PupRTP.decl"
get "FtpProt.decl"
get "Disks.d"
get "Streams.d"
get "AltoDefs.d"
get "AltoFileSys.d"

external
[
// outgoing procedures
Title; OtherPup; PrintPort
MakeNAMB; CloseLocalFile; FreePointer
SysErr; Wss; SwappedOut

// incoming procedures
CallSwat; OsFinish
Dequeue; Enqueue; Unqueue
Zero; MoveBlock; ReadCalendar
Resets; Puts; Closes; Dismiss; Block
CharWidth; GetBitPos; SetBitPos; SetFont
PutTemplate; WRITEUDT
DoubleDifference; ExtendStackCall
ExtractSubstring; Free; ReleasePBI

// incoming statics
userDsp; userSoc; userCtx; userFlag
serverDsp; serverSoc; serverCtx; serverFlag
telnetDsp; telnetSoc
ctxQ; CtxRunning; pupRT; ndbQ; ftpDisk
sysFont; sysZone; debugFlag

// outgoing statics
otherPupQ
]

static otherPupQ

manifest
[
fcOK = 0
fcAbort = 1
]

//-----------------------------------------------------------------------------------------
let Title(ctx) be
//-----------------------------------------------------------------------------------------
[
let boldFont = vec 1; boldFont = boldFont +2
boldFont!-2 = -1; boldFont!-1 = sysFont
let lastTime, now = vec 1, vec 1
let show, noshow, prevDCB = ctx!3, ctx!4, (ctx!5)>>DS.ldcb
   [
   ReadCalendar(now)
   if DoubleDifference(now, lastTime) ne 0 then
      [
      Resets(noshow)
      PutTemplate(noshow, "- $PFTP$P of 11 Oct 82",
       SetFont, boldFont, SetFont, sysFont)
      FillWithDash(180, noshow)
      WRITEUDT(noshow, 0)
      FillWithDash(360, noshow)
      let ndb = ndbQ!0
      PutTemplate(noshow, "[$O#$O#]",
       ndb>>NDB.localNet, ndb>>NDB.localHost)
      FillWithDash(490, noshow)
      PutTemplate(noshow, "$UD pages", ftpDisk>>DSK.diskKd>>KDH.freePages)
      FillWithDash(605, noshow)

      noshow>>DS.ldcb>>DCB.next = show>>DS.ldcb>>DCB.next
      prevDCB>>DCB.next = noshow>>DS.fdcb
      let temp = noshow; noshow = show; show = temp
      MoveBlock(lastTime, now, 2)
      ]
   Dismiss(20)
   if otherPupQ!0 ne 0 then
      [
      let pbi = Dequeue(otherPupQ)
      let dsp, soc, df = 0, pbi>>PBI.socket, debugFlag
      if soc eq serverSoc then
         [ dsp = serverDsp; df = serverCtx>>FtpCtx.debugFlag ]
      if soc eq userSoc then
         [ dsp = userDsp; df = userCtx>>FtpCtx.debugFlag ]
      if soc eq telnetSoc then dsp = telnetDsp
      let startByte, type = 0, 0
      switchon pbi>>PBI.pup.type into
         [
         case typeAbort:
            [
            type = "Abort"
            startByte = 3
            endcase
            ]
         case typeError:
            [
            if (soc>>RTPSoc.state eq stateAbort) % df then
               [
               type = "Error"
               startByte = 25
               ]
            endcase
            ]
         ]
      if dsp ne 0 & startByte ne 0 then
         [
         PutTemplate(dsp, "*N$S Pup from $P: ", type,
          PrintPort, lv pbi>>PBI.pup.sPort)
         for i = startByte to pbi>>PBI.pup.length - pupOvBytes do
            Puts(dsp, pbi>>PBI.pup.bytes↑i)
         ]
      ReleasePBI(pbi)
      ]

// Title (cont'd)

   if kbdAd!2 eq 177677b & (kbdAd!3 % 200b) eq 177773b then
      [
      if userFlag then
         [
         Unqueue(ctxQ, userCtx)
         FreePointer(lv userCtx>>FtpCtx.buffer)
         ]
      if serverFlag then
         [
         Unqueue(ctxQ, serverCtx)
         FreePointer(lv serverCtx>>FtpCtx.buffer)
         ]
      Dismiss(25)
      ExtendStackCall(1000, OsFinish, fcAbort)
      ]
   ] repeat
]

//-----------------------------------------------------------------------------------------
and FillWithDash(end, stream) be
//-----------------------------------------------------------------------------------------
[
if (end-GetBitPos(stream)) gr CharWidth(stream, $*S) then Puts(stream, $*S)
for i = 1 to (end-CharWidth(stream, $*S)-GetBitPos(stream))/
 CharWidth(stream, $-) do Puts(stream, $-)
SetBitPos(stream, end)
]

//-----------------------------------------------------------------------------------------
and OtherPup(pbi) be Enqueue(otherPupQ, pbi)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and FreePointer(lvPointer, p2, p3, p4, p5; numargs na) be
//-----------------------------------------------------------------------------------------
[
for i = 0 to na-1 do
   [
   let pointer = @(lv lvPointer + i)
   if @pointer ne 0 then
      [
      Free(sysZone, @pointer)
      @pointer = 0
      ]
   ]
]

//-----------------------------------------------------------------------------------------
and MakeNAMB(string) = valof
//-----------------------------------------------------------------------------------------
// Strips "<directory>" from front, and "!version" from end.
// Returns a new string.
[
let nbBegin = 1
for i = 1 to string>>String.length do
   if string>>String.char↑i eq $> then nbBegin = i+1
let nbEnd = string>>String.length
for i = string>>String.length to 1 by -1 do
   [
   let char = string>>String.char↑i
   if char ls $0 % char gr $9 then
      [ if char eq $! then nbEnd = i-1; break ]
   ]
resultis ExtractSubstring(string, nbBegin, nbEnd)
]

//-----------------------------------------------------------------------------------------
and CloseLocalFile() be
//-----------------------------------------------------------------------------------------
[
if CtxRunning>>FtpCtx.diskStream ne 0 then
   Closes(CtxRunning>>FtpCtx.diskStream)
CtxRunning>>FtpCtx.diskStream = 0
]

//-----------------------------------------------------------------------------------------
and SysErr(p1, errNo, p2, p3, p4, p5) be
//-----------------------------------------------------------------------------------------
[
let t = p1; p1 = errNo; errNo = t
(table [ 77403b; 1401b ])("Sys.Errors", lv p1)
]

//-----------------------------------------------------------------------------------------
and Wss(stream, string) be  //OS copy JUNTAed away
//-----------------------------------------------------------------------------------------
   for i = 1 to string>>String.length do
      Puts(stream, string>>String.char↑i)

//-----------------------------------------------------------------------------------------
and PrintPort(stream, port) be
//-----------------------------------------------------------------------------------------
   PutTemplate(stream, "[$UO#$UO#$EUO]", port>>Port.net, port>>Port.host,
    lv port>>Port.socket)

//-----------------------------------------------------------------------------------------
and SwappedOut() be CallSwat("Non resident procedure called")
//-----------------------------------------------------------------------------------------