//MFTP.bcpl
// Mag Tape Utility
// for ethernet use
// April 28, 1980 12:58 PM
// Last modified by Tim Diebert, June 9, 1980 10:46 AM
get "Pup.decl"
get "TSP.decl"
get "Tapes.d"
external
[
InitPupLevel1; OpenLevel1Socket; CloseLevel1Socket; SetAllocation
OpenRTPSocket; CreateBSPStream; GetPartner
BSPForceOutput; BSPGetMark; BSPPutMark; BSPWriteBlock
InitializeContext; CallContextList; Block; Enqueue; Unqueue
InitializeZone; CreateDisplayStream; ShowDisplayStream
Gets; Puts; Closes; Endofs; Ws; Wss; Wo; Wos; EraseBits; CharWidth
keys; dsp; OpenFile; WriteBlock; ReadBlock; CallSwat
]
static
[
myDsp; bspSoc; bspStr; ctxQ; tspBuffer; file; blk; status; error
]
let Mftp() be // initialization
[
Ws("*n MFTP, Magtape File Transfer Program, version 1.2, June 9, 1980")
let myZone = vec 10000; InitializeZone(myZone, 10000)
let q = vec 1; ctxQ = q; ctxQ!0 = 0
InitPupLevel1(myZone,ctxQ,5)
let v = vec 300
blk = v
let v = vec 1040
tspBuffer = v
let v = vec 9000
myDsp = CreateDisplayStream(40, v, 9000)
ShowDisplayStream(myDsp)
let v = vec 3000
Enqueue(ctxQ, InitializeContext(v, 3000, TopLevel))
CallContextList(ctxQ!0) repeat
]
and TopLevel() be // top-level process
[
Wss(myDsp,"*nConnect to (CR to exit program): ")
let name = vec 127; GetString(name)
if name>>String.length eq 0 then finish
let frnPort = vec lenPort
unless GetPartner(name, dsp, frnPort, 0, tapeSocket) do loop
let v = vec lenBSPSoc; bspSoc = v
OpenLevel1Socket(bspSoc, 0, frnPort)
unless OpenRTPSocket(bspSoc, ctxQ) do
[
Wss(myDsp,"*nFailed to connect")
CloseLevel1Socket(bspSoc)
loop
]
Wss(myDsp,"*nOpen!")
bspStr = CreateBSPStream(bspSoc)
let keysToNetCtx = vec 2000
Enqueue(ctxQ, InitializeContext(keysToNetCtx, 2000, KeysToNet))
Block () repeatuntil bspSoc>>BSPSoc.state ne stateOpen %
@#177035 eq #177775 //second blank key pressed
Unqueue(ctxQ, keysToNetCtx)
Closes(bspStr)
Wss(myDsp,"*nConnection Closed!")
] repeat
and KeysToNet() be
[
//Establish connection, open drive, then
// wait for key, r
VersionCommand(); GetReply()
OpenCommand(); GetReply()
let fname = vec 127
while true do
[
error = false
Wss(myDsp,"*nCommand (? for help): "); let char = GetKeys()
switchon char into
[
case $c:
[
Wss(myDsp," Close Connection")
CloseConnection()
endcase
]
case $r:
[
Wss(myDsp," Read file, filename? ")
Block()
GetString(fname)
file = OpenFile(fname)
unless file do [
Wss(myDsp," file system error ")
endcase
]
let done = false
let recordCount = 0
until done % error do
[ //get and print blocks until eof or error
ReadRecordCommand()
done = ReadReply()
recordCount = recordCount + 1
]
test error
ifso Wss(myDsp,"Read error")
ifnot
[
Wss(myDsp," ")
Wos(myDsp,recordCount-1)
Wss(myDsp, " records read")
]
Closes(file); endcase
]
case $w:
[
Wss(myDsp," Write file, filename? ")
Block()
GetString(fname)
file = OpenFile(fname,ksTypeReadOnly,wordItem)
unless file do
[
Wss(myDsp," file does not exist")
endcase
]
Wss(myDsp,"*nRecord size in bytes (1024) ")
let rsize = GetNumber()
if rsize eq 0 then
[
Wss(myDsp, " used 1024")
rsize = 1024
]
if rsize gr 2048 then
[
Wss(myDsp, " used 2048")
rsize = 2048
]
let recordCount = 0
until Endofs(file) % error do
[ //get and print blocks until eof or error
WriteRecordCommand(file,rsize)
WriteReply()
recordCount = recordCount + 1
]
test error
ifso
[
Wss(myDsp,"Error on Write")
]
ifnot
[
EOFCommand(); WriteReply()
Wos(myDsp,recordCount)
Wss(myDsp, " records written")
]
Closes(file); endcase
]
case $f:
[
Wss(myDsp," Fwd skip file, how many: ")
let n = GetNumber(); if n eq 0 then
[
Wss(myDsp, "1")
n = 1
]
status = 0
until (n eq 0) % error % status<<Status.EOT do
[
n = n-1
FileFwdCommand()
GetYesNo()
if error then
[
test status<<Status.EOT
ifso Wss(myDsp, "can't skip past EOT")
ifnot Wss(myDsp, "error in skip")
]
]
endcase
]
case $b:
[
Wss(myDsp," Back skip file, how many: ")
let n = GetNumber(); if n eq 0 then
[
Wss(myDsp, "1")
n = 1
]
status = 0
until (n eq 0) % error % status<<Status.BOT do
[
n = n-1
FileBackCommand()
GetYesNo()
if error then Wss(myDsp, "error in skip")
if status<<Status.BOT then Wss(myDsp, " At beginning of tape")
]
endcase
]
case $u:
[
Wss(myDsp," Rewind")
RewindCommand()
GetReply()
endcase
]
case $?:
[
Wss(myDsp,"*nc=Close, r=Read file, w=Write file, f=Fwd skip file, b=Back skip file, u=Rewind")
endcase
]
default:
[
Wss(myDsp," Bad command")
endcase
]
]
]
]
and GetReply() be
[ //get block
let b = 0; let hi = GetFromBsp() lshift 8
let len = hi + GetFromBsp()
tspBuffer!0 = len
for b = 1 to len-1 do
[
hi = GetFromBsp() lshift 8
tspBuffer!b = hi + GetFromBsp()
]
]
and GetFromBsp() = valof
[
let c = -1
until c ge 0 do
[
Block()
c = Gets(bspStr)
]
resultis c
]
and ReadReply() = valof
[ //get block and if not error or eof, print data
GetReply() //fill block
status = tspBuffer>>HereIsRecord.endingStatus
let i = status & #374 //error bits
if i then error = true //error
if status<<Status.EOF then resultis true //EOF
if status<<Status.EOT then error = true //EOT
unless status<<Status.RDY then error = true //not ready
unless status<<Status.ONL then error = true //not on line
let len = tspBuffer>>HereIsRecord.recordLength
WriteBlock(file,lv tspBuffer>>HereIsRecord.record,(len+1)/2)
resultis false //not done
]
and WriteReply() = valof
[ //get block and if not error or eof, return false
//result=done
GetReply() //fill block
status = tspBuffer>>YesNo.code
let i = status & #374 //error bits
if i then error = true //error
if status<<Status.EOF then error = true //EOF
if status<<Status.EOT then error = true //EOT
unless status<<Status.RDY then error = true //not ready
unless status<<Status.ONL then error = true //not on line
resultis false //not done
]
and GetYesNo() be
[
GetReply() //only check error, not EOF, EOT, or BOT
status = tspBuffer>>YesNo.code
let i = status & #374 //error bits
if i then error = true //error
unless status<<Status.RDY then error = true //not ready
unless status<<Status.ONL then error = true //not on line
]
and VersionCommand() be
[ //send [Version] block
blk>>Version.type = cmdVersion //type field
blk>>Version.versno = 0 //version numeric
let str = "Version 1.0 Tape Server Protocol"
let len = 3 + ((str>>String.length + 2) / 2)
blk>>Version.length = len
let i = 0
for i = 0 to len-4 do
[
(lv blk>>Version.verstext)!i = str!i //add text in
]
BSPWriteBlock(bspStr,blk,0,2*len) //send this block
BSPForceOutput(bspSoc) //now
]
and OpenCommand() be
[ //send [OpenDrive] block
blk>>OpenDrive.type = cmdOpenDrive //type field
blk>>OpenDrive.driveNumber = 0 //drive 0
let str = "Glenn"
let len = 3 + ((str>>String.length + 2) / 2)
blk>>OpenDrive.length = len
let i = 0
for i = 0 to len-4 do
[
(lv blk>>OpenDrive.userID)!i = str!i //add text in
]
BSPWriteBlock(bspStr,blk,0,2*len) //send this block
BSPForceOutput(bspSoc) //now
]
and CloseCommand() be
[ //send [CloseDrive] block
blk>>CloseDrive.type = cmdCloseDrive //type field
blk>>CloseDrive.length = 2 //this is whole message
BSPWriteBlock(bspStr,blk,0,4) //send this block
BSPForceOutput(bspSoc) //now
]
and EOFCommand() be
[ //send [WriteEOF] block
blk>>WriteEndOfFile.type = cmdWriteEOF //type field
blk>>WriteEndOfFile.length = 2 //this is whole message
BSPWriteBlock(bspStr,blk,0,4) //send this block
BSPForceOutput(bspSoc) //now
]
and RewindCommand() be
[ //send [Rewind] block
blk>>Rewind.type = cmdRewind //type field
blk>>Rewind.length = 2 //this is whole message
BSPWriteBlock(bspStr,blk,0,4) //send this block
BSPForceOutput(bspSoc) //now
]
and ReadRecordCommand() be
[ //send [ReadRecord] block
Wss(myDsp, ".")
blk>>ReadRecord.type = cmdReadRecord //type field
blk>>ReadRecord.length = 2 //this is whole message
BSPWriteBlock(bspStr,blk,0,4) //send this block
BSPForceOutput(bspSoc) //now
]
and WriteRecordCommand(file,rsize) be
[ //send [WriteRecord] block
Wss(myDsp, ".")
tspBuffer>>WriteRecord.type = cmdWriteRecord //type field
let len = ReadBlock(file, lv tspBuffer>>WriteRecord.record,rsize/2)
tspBuffer>>WriteRecord.length = len+3
tspBuffer>>WriteRecord.recordLength = 2*len
BSPWriteBlock(bspStr,tspBuffer,0,6+2*len) //send this block
BSPForceOutput(bspSoc) //now
]
and FileFwdCommand() be
[ //send [FwdSpaceFile] block
blk>>FwdSpaceFile.type = cmdFwdSpaceFile //type field
blk>>FwdSpaceFile.length = 2 //this is whole message
BSPWriteBlock(bspStr,blk,0,4) //send this block
BSPForceOutput(bspSoc) //now
]
and FileBackCommand() be
[ //send [BackSpaceFile] block
blk>>BackSpaceFile.type = cmdBackSpaceFile //type field
blk>>BackSpaceFile.length = 2 //this is whole message
BSPWriteBlock(bspStr,blk,0,4) //send this block
BSPForceOutput(bspSoc) //now
]
and CloseConnection() be
[ Closes(bspStr)
]
and GetKeys() = valof
[
while Endofs(keys) do Block()
resultis Gets(keys)
]
and GetString(string) be
[
let i = 1
while i le 255 do
[
let char = GetKeys()
switchon char into
[
case 127:
[
i = 1
Wss(myDsp,"XXX*n")
endcase //del
]
case $*n:
[
string>>String.length = i-1
return
endcase //cr
]
case 8:
[
if i gr 1 then //backspace
[
i = i - 1
EraseBits(myDsp, -CharWidth(myDsp, string>>String.char↑i))
]
endcase
]
default:
[
string>>String.char↑i = char
Puts(myDsp, char)
i = i + 1
endcase
]
]
]
]
and GetNumber() = valof
[
let s = vec 127 //string
let d = 0 //digit
let n = -1
while n ls 0 do
[
n = 0
GetString(s)
let i = 0
while (i ls s>>String.length) & (n ge 0) do
[
i = i+1
n = n * 10 //new digit
d = (s>>String.char↑i) - 48
n = n + d
if (d ls 0) % (d gr 9) then n = -1
]
if n ls 0 then
[
Wss(myDsp," Bad number*n")
n = 0
]
]
resultis n
]