// BFSTest.bcpl -- Basic File System test program
// Copyright Xerox Corporation 1979, 1982
// Last modified March 28, 1982 3:46 PM by Boggs
get "SysInternals.d"
get "AltoFileSys.d"
get "AltoDefs.d"
get "Streams.d"
get "Disks.d"
get "BFS.d"
external
[
// outgoing procedures
AfterJunta; MyIdle; SysErr
GetString; GetNumber; Confirm
Ws; Wss; Ding; UpdateTitle
// incoming procedures from OS and packages
Puts; Gets; Resets; Allocate; Free; AddToZone
EraseBits; CharWidth; InvertLine; GetLinePos; SetBitPos
CreateKeywordTable; EnumerateKeywordTable
InsertKeyword; LookupKeyword
ExtractSubstring; CopyString
PutTemplate; DefaultArgs
// incoming procedures from other BFSTest modules
BeforeJuntaInit; AfterJuntaInit
Exercise; Certify; Erase; CreateFile
// incoming statics
lvUserFinishProc
keys; dsp; sysZone; eng; title
]
static [ savedUFP; kbdKT ]
manifest
[
editAppend = 0
editEcho = 1
editReplace = 2
]
structure String [ length byte; char↑1,1 byte ]
//----------------------------------------------------------------------------
let BFSTest() be BeforeJuntaInit()
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and AfterJunta() be
//----------------------------------------------------------------------------
[
AfterJuntaInit()
AddToZone(sysZone, BeforeJuntaInit, sysZone-BeforeJuntaInit)
savedUFP = @lvUserFinishProc; @lvUserFinishProc = MyFinishProc
Command() //never returns
]
//----------------------------------------------------------------------------
and MyFinishProc() be
//----------------------------------------------------------------------------
[
@activeInterrupts = @activeInterrupts & not kbInterruptBit
@displayInterrupt = @displayInterrupt & not kbInterruptBit
@displayListHead = 0; for i = 0 to 30000 loop
@lvUserFinishProc = savedUFP
]
//----------------------------------------------------------------------------
and SysErr(p1, errNo, p2, p3, p4, p5) be
//----------------------------------------------------------------------------
[
let temp = p1; p1 = errNo; errNo = temp
(table [ 77403b; 1401b ])("Sys.Errors", lv p1)
]
//----------------------------------------------------------------------------
and MyIdle() be
//----------------------------------------------------------------------------
[
let MulDiv = table
[
055001B // sta 3 savedPC,2
155000B // mov 2 3
111000B // mov 0 2
102460B // mkzero 0 0
061020B // mul
031403B // lda 2 3 3
061021B // div
077400B // Swat
121000B // mov 1 0
171000B // mov 3 2
035001B // lda 3 savedPC,2
001401B // jmp 1,3
]
@mouseX = 200 + 200*diskAddress>>DA.disk
@mouseY = diskAddress>>DA.track ls 0? 0,
20 + MulDiv(808-40-16, diskAddress>>DA.track, 406)
]
//----------------------------------------------------------------------------
and Command() be
//----------------------------------------------------------------------------
[
kbdKT = CreateKeywordTable(7, 1)
InsertKeyword(kbdKT, "Certify")!0 = Certify
InsertKeyword(kbdKT, "CreateFile")!0 = CreateFile
InsertKeyword(kbdKT, "Erase")!0 = Erase
InsertKeyword(kbdKT, "Exercise")!0 = Exercise
InsertKeyword(kbdKT, "Help")!0 = Help
if eng gr 3 then InsertKeyword(kbdKT, "Partition")!0 = Partition
InsertKeyword(kbdKT, "Quit")!0 = Quit
[
Ws("*N**")
let key = 0
[
key = GetString(0, key, editEcho+editAppend, CmdList)
if key eq 0 break
let tableKey = nil
let kte = LookupKeyword(kbdKT, key, lv tableKey)
if kte eq 0 then [ Ding(dsp); loop ]
for i = key>>String.length+1 to tableKey>>String.length do
Puts(dsp, tableKey>>String.char↑i)
Free(sysZone, key)
(kte!0)() //execute command
break
] repeat
] repeat
]
//----------------------------------------------------------------------------
and CmdList() be
//----------------------------------------------------------------------------
[
Ws("? one of the following:*N")
let count = 0
EnumerateKeywordTable(kbdKT, PrintCmd, lv count)
if count ne 0 then Puts(dsp, $*N)
Puts(dsp, $**)
]
//----------------------------------------------------------------------------
and PrintCmd(kte, kt, key, lvCount) be
//----------------------------------------------------------------------------
[
unless @lvCount eq 0 do Ws(", ")
Ws(key)
test @lvCount eq 5
ifso [ @lvCount = 0; Puts(dsp, $*N) ]
ifnot @lvCount = @lvCount +1
]
//----------------------------------------------------------------------------
and Quit() be finish
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and Help() be
//----------------------------------------------------------------------------
[
Ws("*NThis is the Basic File System (BFS) test and utility program.")
Ws("*NWARNING: several commands can destroy the contents of disks.")
Ws("*NIf you don't know what you are doing, you should QUIT now.")
]
//----------------------------------------------------------------------------
and Partition() be
//----------------------------------------------------------------------------
[
let currentPartition = (table [ 61037b; 1401b ])(0)
let newPartition = GetNumber(" number: ", currentPartition)
let result = (table [ 61037b; 1401b ])(newPartition)
if currentPartition ne newPartition then UpdateTitle()
]
//----------------------------------------------------------------------------
and UpdateTitle() be
//----------------------------------------------------------------------------
[
Resets(title)
InvertLine(title, GetLinePos(title))
Wss(title, "BFSTest of May 6, 1982 6:21 PM")
if eng gr 3 then
[
SetBitPos(title, 400)
PutTemplate(title, "Partition $D", (table [ 61037b; 1401b ])(0))
]
]
//----------------------------------------------------------------------------
and GetString(prompt, def, mode, question; numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, 0, 0, 0, editEcho+editReplace, 0)
let echo = (mode & editEcho) ne 0
let replace = (mode & editReplace) ne 0
if prompt then Ws(prompt)
let string, count = vec 128, 0
if def then
[
count = def>>String.length
CopyString(string, def)
if echo & replace then Ws(def)
Free(sysZone, def)
]
[
let char = Gets(keys)
switchon char into
[
case $*001: case $*010:
[
replace = false
if count ne 0 then
[
if echo ne 0 then
EraseBits(dsp, -CharWidth(dsp, string>>String.char↑count))
count = count -1
]
endcase
]
case $*S: case $*N: case $*033: break
case $?:
[
if count eq 0 & question ne 0 then
[ question(); if prompt then Ws(prompt) ]
endcase
]
case $*177:
[ Ws(" XXX"); resultis 0 ]
default:
[
if char eq $*027 % replace then
[
if echo then for i = count to 1 by -1 do
EraseBits(dsp, -CharWidth(dsp, string>>String.char↑i))
count, replace = 0, false
]
if char ge $*S & char le $*177 then
[
count = count +1
string>>String.char↑count = char
if echo then Puts(dsp, char)
]
endcase
]
]
] repeat
if count eq 0 resultis 0
string>>String.length = count
resultis ExtractSubstring(string)
]
//----------------------------------------------------------------------------
and GetNumber(prompt, def, radix; numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, 0, 0, 0, 10)
if prompt then Ws(prompt)
if na gr 1 then PutTemplate(dsp, "$D", def)
let number = def
let digitTyped = na gr 1
[
let char = Gets(keys)
switchon char into
[
case $*N: case $*S: case $*033:
[ if digitTyped resultis number; endcase ]
case $*177:
[ Ws(" XXX"); resultis 0 ]
case $0 to $9:
[
if na gr 1 then
[
na = 0
while number ne 0 do
[
EraseBits(dsp, -CharWidth(dsp, (number rem radix)+$0))
number = number/radix
]
]
number = number*radix + char-$0
Puts(dsp, char)
digitTyped = true
endcase
]
case $*001: case $*010:
[
na = 0
if number ne 0 then
EraseBits(dsp, -CharWidth(dsp, (number rem radix)+$0))
number = number/radix
endcase
]
]
] repeat
]
//----------------------------------------------------------------------------
and Confirm(prompt) = valof
//----------------------------------------------------------------------------
[
Ws(prompt)
switchon Gets(keys) into
[
case $Y: case $y: case $*N:
[ Ws("Yes"); resultis true ]
case $N: case $n: case $*177:
[ Ws("No"); resultis false ]
case $?:
[ Ws("Y, y, <cr>, or N, n, <del>"); loop ]
default:
[ Ding(dsp); endcase ]
] repeat
]
//----------------------------------------------------------------------------
and Wss(stream, string) be
//----------------------------------------------------------------------------
for i = 1 to string>>String.length do
Puts(stream, string>>String.char↑i)
//----------------------------------------------------------------------------
and Ws(string) be Wss(dsp, string)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and Ding(stream) be
//----------------------------------------------------------------------------
[
let dcb = stream>>DS.fdcb
[
dcb>>DCB.background = not dcb>>DCB.background
dcb = dcb>>DCB.next
if dcb eq stream>>DS.ldcb break
] repeat
for i = 0 to 32000 loop
let dcb = stream>>DS.fdcb
[
dcb>>DCB.background = not dcb>>DCB.background
dcb = dcb>>DCB.next
if dcb eq stream>>DS.ldcb break
] repeat
]