// TFUutils.bcpl
// Copyright Xerox Corporation 1979

//   Last modified November 22, 1980  12:40 PM by Taft

get "AltoFileSys.d"
get "Streams.d"

external
   [
//TFU -- export
   ReadToken
   BackToken
   Disambiguate
   ReadFile
   ReadDrive
   StrEq
   ReadNumber
   Switch
   Error
   RunEther
   PrintEther
   InitLog
   CloseLog
   BigDisplay
   SmallDisplay
   ReportDebugStats

//TFU -- import
   InitDisk

//GP
   SetupReadParam
   ReadParam

//Template
   PutTemplate

//OS
   MoveBlock; SetBlock
   DoubleAdd
   Wss; Wns
   Ws; Gets; Puts; Resets; keys; dsp
   StartIO
   DefaultArgs
   MyFrame; Usc; Allocate; SysErr
   OpenFile; TruncateDiskStream; Closes
   CreateDisplayStream; ShowDisplayStream

//INTERRUPT
   FindInterruptMask
   InitializeInterrupt

// incoming statics
   defaultDrive
   sysDisk
   str
   sw
   noConfirm
   sysZone

// outgoing static
   lastToken
   ]
   

static
   [
   lastToken
   backUpToken
   EtherCount
   sysDsp; myDsp; log; lenBigDisplay; displayLineCount; save335
   parsing = false
   ]

// ReadToken() returns value
// token values:
//   1 = eof on command line
//   2 = command terminator (|)
//   3 = number
//   4 = "Erase"
//   5 = ... remaining commands -- see Disambiguate, below
//   1000 = ambiguous command

//----------------------------------------------------------------------------
let ReadToken() = valof
//----------------------------------------------------------------------------
[
let backedUp = backUpToken
lastToken = valof
   [
   let a=backUpToken
   if a then
      [
      unless a eq 1 then backUpToken=0
      resultis a
      ]
   let ans=ReadParam($P,0,0,0,true)
   if ans eq -1 then
      [
      backUpToken=1
      resultis 1
      ]
   resultis Disambiguate(str)
   ]
unless backedUp do
   switchon lastToken into
      [
      case 1: case 2:
         parsing = false; Ws("*n~~~~~~~~~~*n")
         endcase
      default:
         unless parsing do Ws("*n~~~~~~~~~~*n")
         parsing = false
         Ws(str)
         if sw!0 ne 0 then PutTemplate(dsp, "/$US", sw)
         Puts(dsp, $*s)
         parsing = true
         endcase
      ]
resultis lastToken
]

//----------------------------------------------------------------------------
and BackToken() be backUpToken = lastToken
//----------------------------------------------------------------------------


//----------------------------------------------------------------------------
and Disambiguate(str) = valof
//----------------------------------------------------------------------------
// Given a string, disambiguate it from several commands, and return one.
//   returns 1000 if cannot make sense of it
[
if str>>STRING.length eq 0 then resultis false
let c=str>>STRING.char^1
if c eq $| then resultis 2   //vertical bar -- like end of file
if c ge $0 & c le $9 then resultis 3   //Number
let len=str>>STRING.length
let matchNo=nil
let matchCnt=0
for i=4 to 100 do
   [
   let s=selecton i into
      [
      case 4: "Erase"
      case 5: "Copy"
      case 6: "Delete"
      case 7: "CreateFile"
      case 8: "Directory"
      case 9: "Addresses"
      case 10: "Certify"
      case 11: "Drive"
      case 12: "Exercise"
      case 13: "Convert"
      case 14: "BadSpots"
      case 15: "ResetBadSpots"
      case 16: "Rename"
      default: 1000
      ]
   if s eq 1000 then break   //Done
   if len gr s>>STRING.length then loop
   let match=true
   for j=1 to len do
      if ((str>>STRING.char^j xor s>>STRING.char^j)&(not #40)) ne 0 then
         match=false
   if match then
      [
      matchCnt=matchCnt+1
      matchNo=i
      ]
   ]
if matchCnt eq 1 then resultis matchNo
resultis 1000
]

//----------------------------------------------------------------------------
and ReadFile(nam) = valof
//----------------------------------------------------------------------------
// Read and parse a file name for the disk name first (s: t: tn:) and
// return a pointer to the relevant "disk" object.
// Also update the name to omit the disk tag.
[
let a=ReadToken()
if a le 2 then resultis 0   //End of command ....

let colonfound=0
let len=str>>STRING.length
for i=1 to len do if str>>STRING.char^i eq $: then colonfound=i
for i=colonfound+1 to len do
   nam>>STRING.char^(i-colonfound)=str>>STRING.char^i
nam>>STRING.length=len-colonfound

if colonfound le 1 then resultis InitDisk(defaultDrive)

str>>STRING.length=colonfound-1
let drive = ReadDrive(str)
resultis selecton drive into
   [
   case -1: sysDisk
   case -2: Error("Illegal drive -- ", str)
   default: InitDisk(drive)
   ]
]

//----------------------------------------------------------------------------
and ReadDrive(str) = valof
//----------------------------------------------------------------------------
// Interprets string of the form "TPn" or "DPn".
// Returns drive number for TPn, -1 for DP0, and -2 for anything else.
[
let number = 0
let lastNonDigit = 0
for i = 1 to str>>STRING.length do
   [
   let char = str>>STRING.char^i
   test char ge $0 & char le $7
      ifso number = 8*number + (char-$0)
      ifnot [ lastNonDigit = i; number = 0 ]
   ]
str>>STRING.length = lastNonDigit
if StrEq(str, "TP") % StrEq(str, "T") then resultis number
if (StrEq(str, "DP") % StrEq(str, "S")) & number eq 0 then resultis -1
resultis -2
]
         
//----------------------------------------------------------------------------
and StrEq(a,b) = valof
//----------------------------------------------------------------------------
[
let len=a>>STRING.length
if len ne b>>STRING.length then resultis false
for i=1 to len do
   [
   let c=a>>STRING.char^i
   let d=b>>STRING.char^i
   if c gr $a & c le $z then c=c-$a+$A
   if d gr $a & d le $z then d=d-$a+$A
   if c ne d then resultis false
   ]
resultis true
]

//----------------------------------------------------------------------------
and ReadNumber(str, radix; numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -1, 10)
let n=0
for i=1 to str>>STRING.length do
   [
   let c=(str>>STRING.char^i)-$0
   if c ls 0 % c ge radix then break
   n=n*radix+c
   ]
resultis n
]

// Returns true if switch ch is in switch vector sw.

//----------------------------------------------------------------------------
and Switch(ch) = valof
//----------------------------------------------------------------------------
[
let swnum=sw!0
for i=1 to swnum do
   [
   let c=sw!i
   if c ge $a & c le $z then c=c-$a+$A
   if c eq ch then resultis true
   ]
resultis false
]

//----------------------------------------------------------------------------
and Error(a,b; numargs n) be
//----------------------------------------------------------------------------
[
Ws("Error -- ")
Ws(a)
if n ne 1 then Ws(b)
Ws("*n")
finish
]


//Stuff to run the EtherNet when disking.

//----------------------------------------------------------------------------
and RunEther() be
//----------------------------------------------------------------------------
[
static eBuf
let EtherRead() be   //Interrupt routine
   [
   @#604=300
   @#605=eBuf
   StartIO(2)      //Restart input
   EtherCount=EtherCount+1
   ]
eBuf=@#335
@#335=eBuf+400
let mask=FindInterruptMask(1)
InitializeInterrupt(eBuf+300, 100, mask, EtherRead)
@#610=0      //Promiscuous reader
@#601=mask   //Interrupt mask
]

//----------------------------------------------------------------------------
and PrintEther(s) be if @#601 ne 0 then
//----------------------------------------------------------------------------
[
if EtherCount gr 1 then
   [
   PutTemplate(s, "[read $UD packets]", EtherCount-1)
   EtherCount=0
   ]
StartIO(3)
]

//----------------------------------------------------------------------------
and ReportDebugStats() be
//----------------------------------------------------------------------------
[
let p = @#645
let s = p!3
if p ne 0 then while s ne p!4 do
   [
   if s!0 eq -1 break
   if s eq p!3 then [ BigDisplay(); Ws("*nTFS debug statistics:") ]
   PutTemplate(dsp, "*n  status: $6UO, count: $6ED", s!0, s+1)
   s = s+3
   ]
SmallDisplay()
]

//----------------------------------------------------------------------------
and InitLog() be
//----------------------------------------------------------------------------
[
lenBigDisplay = MyFrame()-@#335-5000
if Usc(lenBigDisplay, 10000) gr 0 then lenBigDisplay = 10000
sysDsp = dsp
myDsp = dsp
dsp = Allocate(sysZone, lST)
SetBlock(dsp, SysErr, lST)
dsp>>ST.puts = DisplayPuts
dsp>>ST.reset = DisplayReset
log = OpenFile("TFU.log", ksTypeWriteOnly, charItem)
TruncateDiskStream(log)
]

//----------------------------------------------------------------------------
and CloseLog() be
//----------------------------------------------------------------------------
[
SmallDisplay()
Closes(log)
]

//----------------------------------------------------------------------------
and BigDisplay() be
//----------------------------------------------------------------------------
[
if myDsp eq sysDsp then
   [
   myDsp = CreateDisplayStream(25, @#335, lenBigDisplay)
   save335 = @#335
   @#335 = @#335 + lenBigDisplay
   ShowDisplayStream(myDsp)
   displayLineCount = 0
   Wss(log, "*n*n")
   ]
]

//----------------------------------------------------------------------------
and SmallDisplay() be
//----------------------------------------------------------------------------
[
if myDsp ne sysDsp then
   [
   unless noConfirm do
      [ Wss(myDsp, "    (continue?...)"); Gets(keys) ]
   Closes(myDsp)
   @#335 = save335
   myDsp = sysDsp
   Wss(log, "*n*n")
   ]
]

//----------------------------------------------------------------------------
and DisplayPuts(nil, char) be
//----------------------------------------------------------------------------
[
if parsing then
   [ parsing = false; Ws("*n~~~~~~~~~~*n") ]
if myDsp ne sysDsp & not noConfirm do
   if char eq $*n then
      [
      displayLineCount = displayLineCount+1
      if displayLineCount eq 25 then
         [
         Wss(myDsp, "    (continue?...)"); Gets(keys)
         displayLineCount = 0
         ]
      ]
Puts(myDsp, char)
Puts(log, char)
]

//----------------------------------------------------------------------------
and DisplayReset(nil) be Resets(myDsp)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and Ws(string) be Wss(dsp, string)
//----------------------------------------------------------------------------