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