// 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
]