// IfsPrintErrorInit.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified October 4, 1981  3:57 PM by Taft

get "Ifs.decl"
get "IfsSystemInfo.decl"
get "IfsDirs.decl"
get "IfsFiles.decl"
get "Streams.d"

external
[
// outgoing procedures
InitPrintError

// incoming procedures
ErrCompareKey; ErrEntryLength; UpdateRecord; OpenIFSTree
IFSOpenFile; StreamsFD; PositionPage
ReadLeaderPage; WriteLeaderPage
MyFrame; GotoLabel; Allocate; Free
Closes; Gets; Puts; Errors; IFSError
CreateStringStream

// outgoing static
errorTree

// incoming statics
primaryIFS; sysZone
]

static errorTree

manifest
[
ecRecordGenerator = 40
errorTreePages = 64
]

//----------------------------------------------------------------------------
let InitPrintError() be
//----------------------------------------------------------------------------
[
let str = IFSOpenFile("IFSErrors.Tree!1", 0, modeReadWrite, 0, lcVHighest)
if str eq 0 then
   [
   str = IFSOpenFile("IFSErrors.Tree!1", 0, modeReadWrite)
   if str eq 0 then IFSError(ecCreateEssentialFile)
   let ld = Allocate(sysZone, 1 lshift logStdPageLength)
   ReadLeaderPage(str, ld)
   ld>>ILD.type = ftBinary
   ld>>ILD.byteSize = 8
   ld>>ILD.noBackup = true
   ld>>ILD.undeletable = true
   ld>>ILD.readProt.world = false
   WriteLeaderPage(str, ld)
   Free(sysZone, ld)
   PositionPage(str, errorTreePages)
   ]
errorTree = OpenIFSTree(lv StreamsFD(str)>>FD.dr>>DR.fp, primaryIFS,
 ErrCompareKey, ErrEntryLength, true, errorTreePages)
Closes(str)

let name = "<System>IFS.Errors"
let file = IFSOpenFile(name)
if file eq 0 then IFSError(ecTridentFile, name)

let errRec = nil
let ErrorFileEOF(file) be GotoLabel(file>>ST.par2, EOF)
file>>ST.error = ErrorFileEOF
file>>ST.par2 = MyFrame()
   [
   let char = nil
   errRec = Allocate(sysZone, maxLenErrRec)
   let errorString = lv errRec>>ErrRec.errorString

   // "an unsigned decimal error number (digits only),
   // followed optionally by C, M, or L,
   // followed by <space>":
   let ifsEc = 0
      [
      char = Gets(file)
      if char ls $0 % char gr $9 break
      ifsEc = ifsEc*10 + (char-$0)
      ] repeat
   errRec>>ErrRec.ifsEc = ifsEc
   while char ne $*S do char = Gets(file)

// InitPrintError (cont'd)

   // "followed by the text of the message,
   // including carriage returns, etc.
   // followed by $$"
   let ftpEc = 0
   let es = CreateStringStream(errorString, 255)
   let dollarPending = false
   let inFTPEc = true
      [
      // if the string begins with an octal number, it's an Ftp error code
      char = Gets(file)
      if inFTPEc test char ls $0 % char gr $7
         ifso [ inFTPEc = false; if char eq $*s loop ]
         ifnot [ ftpEc = ftpEc lshift 3 + (char-$0); loop ]
      test char eq $$
         ifso test dollarPending
            ifso break
            ifnot dollarPending = true
         ifnot
            [
            if dollarPending then Puts(es, $$)
            Puts(es, char)
            dollarPending = false
            ]
      ] repeat
   Closes(es)

   // flush trailing returns
   while errorString>>STRING.char↑(errorString>>STRING.length) eq $*n do
      errorString>>STRING.length = errorString>>STRING.length-1

   // finish constructing record and insert into tree
   errRec>>ErrRec.ftpEc = ftpEc
   errRec>>ErrRec.length =
     lenErrRecHeader + errorString>>STRING.length rshift 1 +1
   UpdateRecord(errorTree, ifsEc, RecordGenerator, errRec)
   ] repeat
EOF: Free(sysZone, errRec)
Closes(file)
]

//----------------------------------------------------------------------------
and RecordGenerator(oldRec, newRec) = valof
//----------------------------------------------------------------------------
[
if oldRec ne 0 then
   [
   IFSError(ecRecordGenerator, oldRec>>ErrRec.ifsEc)  //you can proceed
   Free(sysZone, oldRec)
   ]
resultis newRec
]