// SCI.bcpl -- Translates Route output to SCI input format and writes a tape.
// Last modified April 28, 1983  7:33 PM by Boggs

get "SCI.decl"
get "Streams.d"

external
[
// outgoing procedure -- SCI
TSP

// incoming procedures -- SCI
WLFile; OtherFile
ReadToken; OutPut; FlushBlock

// incoming procedures -- packages
InitializeContext; Block; CallContextList
ExtractSubstring; ConcatenateStrings
InitPupLevel1; GetPartner; Enqueue; PutTemplate; ByteBlt
OpenLevel1Socket; OpenRTPSocket; CreateBSPStream
BSPWriteBlock; BSPReadBlock; BSPForceOutput

// incoming procedures -- OS
OpenFile; Closes; Puts; Gets
InitializeZone; AddToZone; Allocate; Free
Noop; CallSwat; MyFrame; Wss

// outgoing statics
lf; in; out; cpuType
token; board; numBlocks
block; blockCnt; record; recordCnt

// incoming statics -- OS
sysZone; dsp; keys
lvSysZone; lvIdle; lvUserFinishProc

// incoming statics -- Pup package
offsetBSPStr; lBSPSoc
]

manifest stackLimit = 335b

static
[
lf; in; out; cpuType
token; board; numBlocks
block; blockCnt; record; recordCnt

ts; savedUFP; versionText
]

//----------------------------------------------------------------------------------------
let SCI() be
//----------------------------------------------------------------------------------------
[
versionText = "SCI of April 28, 1983"
Wss(dsp, versionText)

savedUFP = @lvUserFinishProc; @lvUserFinishProc = FinishProc

// free storage
let freeBegin = @stackLimit
let freeEnd = MyFrame() -2000
let length = freeEnd-freeBegin
if length ugr 77776b then length = 77776b
@stackLimit = freeBegin + length
sysZone = InitializeZone(freeBegin, length)
@lvSysZone = sysZone

token = Allocate(sysZone, 128)		// input is parsed into tokens
record = Allocate(sysZone, 128)		// tokens are packed into records
block = Allocate(sysZone, 2048)		// records are packed into blocks

// get board name
in = keys
   [
   Wss(dsp, "*NBoard name (e.g. DCCP-rev-H (no extension)): ")
   ReadToken()
   ] repeatuntil token>>String.length ne 0
board = ExtractSubstring(token)

// open listing file
let lfName = ConcatenateStrings(token, ".ls")
lf = OpenFile(lfName, ksTypeWriteOnly, charItem)
if lf eq 0 then CallSwat("Failed to open listing file")
PutTemplate(dsp, "*NListing to file $S", lfName)
Free(sysZone, lfName)

let ctxQ = vec 1; ctxQ!0 = 0
@lvIdle = Block
InitPupLevel1(sysZone, ctxQ, 10)
Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 1000), 1000, MainCtx))
CallContextList(ctxQ!0) repeat  //forever
]

//----------------------------------------------------------------------------------------
and FinishProc() be
//----------------------------------------------------------------------------------------
[
if lf ne 0 then Closes(lf)
@lvIdle = Noop
@lvUserFinishProc = savedUFP
]

//----------------------------------------------------------------------------------------
and MainCtx() be  //a context
//----------------------------------------------------------------------------------------
[
// open tape
let port = vec 3
   [
   Wss(dsp, "*NTape server name (<DEL> => no tape): ")
   ReadToken()
   test token>>String.length eq 0
      ifso [ port = 0; break ]
      ifnot if GetPartner(token, dsp, port, 0, tapeSocket) break
   ] repeat
if port ne 0 then
   [
   Wss(dsp, "*NVAX or PRIME format (V or P): ")
   cpuType = Gets(keys) & 137b; Puts(dsp, cpuType)
   let soc = Allocate(sysZone, lBSPSoc)
   OpenLevel1Socket(soc, 0, port)
   if OpenRTPSocket(soc) then ts = CreateBSPStream(soc)
   ]

// initialize the tape
TSP(cmdVersion, 1, versionText)
if ts ne 0 then
   [
   Wss(dsp, "*NTape unit number: ")
   ReadToken()
   let unit = token>>String.char^1 - $0
   if token>>String.length eq 1 & unit ge 0 & unit le 1 then
      [ TSP(cmdOpenDrive, unit, ""); break ]
   ] repeat
TSP(cmdSetStatus, 1, 1600)

let v1 = "VOL1SCI                              D%C          1                            3"
let h1 = "HDR1SCI.DAT          SCI   00010001000100 83000 00000 000000DECFILE11A          "
let h2 = "HDR2D0204800079                     A             00                            "
let h3 = "HDR3004B010200000000000100000000000000000000000000000000000000000000            "
if cpuType eq $V then  //write ANSI header labels
   [
   TSP(cmdWriteRecord, v1, 1, 80)
   TSP(cmdWriteRecord, h1, 1, 80)
   TSP(cmdWriteRecord, h2, 1, 80)
   TSP(cmdWriteRecord, h3, 1, 80)
   TSP(cmdWriteEOF)
   ]

// do the work
out = lv OutPut - offset ST.puts/16
WLFile()
OtherFile()
FlushBlock()

if cpuType eq $V then  //write ANSI trailer labels
   [
   TSP(cmdWriteEOF)
   ByteBlt(h1, 1, "EOF", 1, 3)
   ByteBlt(h2, 1, "EOF", 1, 3)
   ByteBlt(h3, 1, "EOF", 1, 3)
   h1>>String.char^59 = numBlocks/10 +$0
   h1>>String.char^60 = numBlocks rem 10 +$0
   TSP(cmdWriteRecord, h1, 1, 80)
   TSP(cmdWriteRecord, h2, 1, 80)
   TSP(cmdWriteRecord, h3, 1, 80)
   ]

TSP(cmdWriteEOF)
TSP(cmdWriteEOF)
TSP(cmdUnload)
TSP(cmdCloseDrive)
if ts ne 0 then Closes(ts)
finish
]

//----------------------------------------------------------------------------------------
and TSP(cmd, arg0, arg1, arg2, arg3; numargs na) = valof
//----------------------------------------------------------------------------------------
// Tape Server Protocol
[
if ts eq 0 resultis true

// send command
let msg = vec 10; msg!0 = 2; msg!1 = cmd
switchon cmd into
   [
   case cmdRewind: case cmdUnload: case cmdCloseDrive: case cmdWriteEOF:
      [
      BSPWriteBlock(ts, msg, 0, 4)
      endcase
      ]
   case cmdVersion: case cmdOpenDrive:
      [
      let sl = arg1>>String.length rshift 1 +1
      msg!0 = 3 + sl
      msg!2 = arg0
      BSPWriteBlock(ts, msg, 0, 6)
      BSPWriteBlock(ts, arg1, 0, sl lshift 1)
      endcase
      ]
   case cmdWriteRecord:
      [
      msg!0 = 3 + arg2 rshift 1
      msg!2 = arg2
      BSPWriteBlock(ts, msg, 0, 6)
      BSPWriteBlock(ts, arg0, arg1, arg2)
      endcase
      ]
   case cmdSetStatus:
      [
      msg!0 = 4
      msg!2 = arg0
      msg!3 = arg1
      BSPWriteBlock(ts, msg, 0, 8)
      endcase
      ]
   default: CallSwat("TSP: unknown command")
   ]
BSPForceOutput(ts-offsetBSPStr)

// get response
let yesNo = vec (4 + 128)  //length+type+code+status+string
BSPReadBlock(ts, yesNo, 0, 2)
BSPReadBlock(ts, yesNo+1, 0, (yesNo!0-1) lshift 1)

if cmd eq cmdVersion then
   [
   if yesNo!1 ne cmdVersion % yesNo!2 ne 0 then CallSwat("TSP version incompatible")
   PutTemplate(dsp, "*N$S", yesNo+3)
   resultis true
   ]
if yesNo!1 eq cmdYes resultis true
if yesNo!1 eq cmdNo then
   PutTemplate(dsp, "*N[No] cmd $O cause $O status $O $S", cmd, yesNo!2, yesNo!3, yesNo+4)
resultis false
]