// Resist.bcpl -- board open/short tester -- main program and utilities

// Last modified by June 25, 1984  12:35 PM

get "Resist.decl"
get "Streams.d"
get "AltoDefs.d"
get "SysDefs.d"

external
[
// outgoing procedures
EncodeOhms; DecodeOhms; OhmsCodeTable
ReportError; PermAllocate; ExpandTemplate; ResistFinish; Confirm

// incoming procedures
InitResist; ICState; ReEstablishStream
ReadResistFile; ReadWireListFile; UnparseIC; SummarizeBadNets
CreateSymbolTable; EnumerateSymbolTable
DefineSymbol; LookupSymbol; LookupOrDefineSymbol; MustLookupSymbol
SymbolsObject; SymbolsString; ObjectsString; SymbolsType; PinsNetSymbol
DisplayIC; DisplaySingleOhms; DisplayOhms
ShowFullDisplay; FlashWindow
MeasureOhms; SignalOn; PulseChannel; Wait
DeleteFile; RenameFile; CleanupDiskStream
CreateStringStream; ConcatenateStrings; ExtractSubstring
PutTemplate; ResetLine; EraseBits; CharWidth
Ws; Wss; Gets; Puts; Resets; Closes; Endofs
Allocate; Free; AddToZone
Usc; Max; SysErr; Junta

// outgoing statics
endInitCode; permZone; version; startLocation; serialNumber; errorTolerance
maxNPins; resistSavedUFP; displayInterruptMask
resStream; exStream; wlStream; outStream
resName; outName; mustRename; stuffed; restart
stateCFA; outCFA; symbolTable; ohmsCodeTab

// incoming statics
sysZone; dsp; keys; statusDsp; lvUserFinishProc; stateStream
]

static
[
endInitCode
resStream = 0
exStream = 0
wlStream = 0
outStream = 0
serialNumber = 0
startLocation = 0
maxNPins = defaultMaxNPins
resistSavedUFP; displayInterruptMask
resName; outName; mustRename
stuffed = 1
errorTolerance = 0
lastChar; version
permZone; symbolTable
symDIP3; symMB7071H; symSpareSocket; symAUGATCG16; symUnknownNet
restart = false
stateCFA; outCFA
ohmsCodeTab
]

manifest [ normal = 0; quit = 1; ignore = 2; repeatIC = 3 ]  // command action
manifest maxPass = 5

// ---------------------------------------------------------------------------
let Resist() be
// ---------------------------------------------------------------------------
[
version = "Resist of June 25, 1984"
Junta(levDisplay, ResistAfterJunta)
]

// ---------------------------------------------------------------------------
and ResistAfterJunta() be
// ---------------------------------------------------------------------------
[
InitResist()
AddToZone(sysZone, InitResist, endInitCode-InitResist)

Ws("*nReading Resist file...")
symbolTable = CreateSymbolTable(251, permZone)
symDIP3 = LookupOrDefineSymbol(symbolTable, "DIP3", stICPackage)
symMB7071H = LookupOrDefineSymbol(symbolTable, "MB7071H", stICType)
symSpareSocket = LookupOrDefineSymbol(symbolTable, "SpareSocket", stICType)
symAUGATCG16 = LookupOrDefineSymbol(symbolTable, "AUGATCG16", stICType)
let firstIC = ReadResistFile(resStream, symbolTable)
Closes(resStream)

if exStream ne 0 then
   [
   Ws("*nReading Exceptions file...")
   ReadResistFile(exStream, symbolTable, true)
   Closes(exStream)
   ]

Ws("*nReading Wire List file...")
ReadWireListFile(wlStream, symbolTable)
Closes(wlStream)

symUnknownNet = MustLookupSymbol(symbolTable, "?")

stateStream = ReEstablishStream(stateCFA, ksTypeReadWrite, wordItem)
if restart then
   [
   Ws("*nRestoring results from interrupted test...")
   until Endofs(stateStream) do
      startLocation = ObjectsString(ICState(true, nil))
   ]

let freeWords = nil
Allocate(sysZone, 77777B, lv freeWords)
PutTemplate(dsp, "*n$D+$D free words remaining.*nReady to begin testing.",
 freeWords, permZone>>PermZone.wordsLeft)

let ic = firstIC
let firstPass = 1
if startLocation ne 0 then
   [
   let symbol = LookupSymbol(symbolTable, startLocation)
   test symbol eq 0
      ifso ReportError("Board location $S undefined", startLocation)
      ifnot
         [
         ic = SymbolsObject(symbol)
         firstPass = WhichPassForIC(ic)
         if firstPass eq 0 then firstPass = 1
         ]
   ]

ShowFullDisplay(true)
let action = nil
for pass = firstPass to maxPass do
   [
   action = DoPass(lv pass, ic)
   if action eq quit then break
   ic = firstIC
   ]

unless action eq quit do
   [
   ShowFullDisplay(false)
   Ws("*nWriting defects file...")
   Closes(stateStream)
   
   outStream = ReEstablishStream(outCFA, ksTypeWriteOnly, charItem)
   let badUnknownNets = ReportDefects(firstIC, outStream)
   SummarizeBadNets(outStream, symbolTable, InTolerance)
   if badUnknownNets ne 0 then
      PutTemplate(outStream, "*n; There are $D errors involving pins whose net names are not known.*n",
       badUnknownNets)
   Closes(outStream)
   
   if mustRename then
      [
      let backupName = ConcatenateStrings(outName, "$")
      DeleteFile(backupName)
      RenameFile(outName, backupName)
      RenameFile("Resist.temp$", outName)
      PutTemplate(dsp, "*nInput file renamed to $S.", backupName)
      Free(sysZone, backupName)
      ]
   Free(sysZone, outName)
   
   DeleteFile("Resist.state$")
   ]

@displayListHead = 0
finish
]

// ---------------------------------------------------------------------------
and DoPass(lvPass, ic) = valof
// ---------------------------------------------------------------------------
[ // repeat
let action = normal
if ic eq 0 resultis action

if WhichPassForIC(ic) eq @lvPass then
   [
   PutTemplate(statusDsp, "   Location $S ($S) $D-pin*n",
    ObjectsString(ic), SymbolsString(ic>>IC.type), ic>>IC.nPins)

   let Measure = HowToMeasure(ic)

      [ // repeat
      switchon Measure(ic) into
         [
         case $*s:
            break
         case $D:
            Measure = MeasureMultiple; endcase
         case $S:
            Measure = MeasureSingle; endcase
         case $Q:
            if Confirm() then [ action = quit; SetAllUnknown(ic); break ]
            endcase
         case $I:
            if Confirm() then [ action = ignore; SetAllUnknown(ic); break ]
            endcase
         case $L:
            [
            let location = GetString()
            if location ne 0 then
               [
               let icSymbol = LookupSymbol(symbolTable, location)
               Free(sysZone, location)
               test icSymbol eq 0 % SymbolsType(icSymbol) ne stIC
                  ifso Ws("*nBoard location not defined.")
                  ifnot
                     [
                     SetAllUnknown(ic)
                     ic = SymbolsObject(icSymbol)
                     @lvPass = WhichPassForIC(ic)
                     action = repeatIC
                     break
                     ]
               ]
            endcase
            ]
         ]
      ] repeat

   Resets(statusDsp)
   
   if action eq normal then
      [ ICState(false, ic); CleanupDiskStream(stateStream) ]
   ]

if action eq quit resultis action

unless action eq repeatIC do ic = ic>>IC.next
] repeat

// ---------------------------------------------------------------------------
and WhichPassForIC(ic) = valof
// ---------------------------------------------------------------------------
// Returns the pass during which it is appropriate to test this IC,
// or 0 if the IC should never be tested.
//	1: 16- and 14-pin DIPs, except Spare and Platforms if board is stuffed
//	2: Spare if board is stuffed
//	3: 24-pin DIPs
//	4: QIT packages
//	5: Everything else (including Platforms if board is stuffed)
[
for pinNumber = 1 to ic>>IC.nPins do
   if ic>>IC.pins^pinNumber.expectedOhmsCode ne unknownCode then
      [
      resultis ic>>IC.package eq symDIP3?
         selecton ic>>IC.nPins into
            [
            case 16:    // 16-pin DIP3
               stuffed?
                (ic>>IC.type eq symSpareSocket? 2,
                 ic>>IC.type eq symAUGATCG16? 5, 1), 1
            case 14: 1  // 14-pin DIP3
            case  2: 0  // 2-pin "DIP3"s are bypass capacitors -- don't test
            default: 5  // Oddball DIP3 (not sure this can ever happen)
            ],
         selecton ic>>IC.nPins into
            [
            case 26: 4  // QIT package
            case 24: 3  // 24-pin DIP
            case  8: 0  // SIP -- don't test
            default: 5  // Oddball, test with single probe
            ]
      ]

// All the pins of this IC have unknown resistance
resultis 0
]

// ---------------------------------------------------------------------------
and HowToMeasure(ic) =
// ---------------------------------------------------------------------------
 WhichPassForIC(ic) eq 5 % (ic>>IC.nPins eq 26 & stuffed)?
  MeasureSingle, MeasureMultiple

// ---------------------------------------------------------------------------
and MeasureMultiple(ic) = valof
// ---------------------------------------------------------------------------
[
ResetLine(statusDsp)
PutTemplate(statusDsp, "Install $S probe; press switch when ready",
 (ic>>IC.type eq symMB7071H? "QIT", "DIP"))
Resets(keys)
let probeState = 0

   [ // repeat
   let ok = true
   let allOpen = true
   for pinNumber = 1 to ic>>IC.nPins do
      [
      let pin = lv ic>>IC.pins^pinNumber
      pin>>Pin.measuredOhmsCode =
        EncodeOhms(MeasureOhms(PinChannel(ic, pinNumber)))
      ok = ok & InTolerance(pin)
      allOpen = allOpen & pin>>Pin.measuredOhmsCode eq openCode
      ]
   DisplayIC(ic, InTolerance)
   DisplaySingleOhms(MeasureOhms(chanSingle))
   probeState = selecton probeState into
      [
      case 0: allOpen? 1, 0
      case 1: allOpen? 1, 2
      case 2: 2
      ]
   SignalOn(probeState eq 2 & not ok)
   ] repeatuntil CheckKeys()

SignalOn(false)
resultis lastChar  // returned by CheckKeys
]

// ---------------------------------------------------------------------------
and PinChannel(ic, pinNumber) =
// ---------------------------------------------------------------------------
   (chanPin1-1) + selecton ic>>IC.nPins into
      [
      case 14: pinNumber ls 8? pinNumber, pinNumber+2
      case 26: pinNumber le 24? pinNumber, 24
      default: pinNumber
      ]

// ---------------------------------------------------------------------------
and MeasureSingle(ic) = valof
// ---------------------------------------------------------------------------
[
let nPins = ic>>IC.nPins
for pinNumber = 1 to nPins do
   [
   ResetLine(statusDsp)
   PutTemplate(statusDsp,
    "Install single probe on pin $D and press switch", pinNumber)
   Resets(keys)

      [ // repeat
      let pin = lv ic>>IC.pins^pinNumber
      pin>>Pin.measuredOhmsCode =
        EncodeOhms(MeasureOhms(chanSingle))
      ic>>IC.nPins = pinNumber
      DisplayIC(ic, InTolerance)
      ic>>IC.nPins = nPins
      DisplaySingleOhms(MeasureOhms(chanSingle))
      SignalOn(not InTolerance(pin))

      // for current tracer, pulse the channel for 100 ms and then
      // leave it off for 100 ms.
      PulseChannel(chanSingle, 100/17)
      Wait(100/17)
      ] repeatuntil CheckKeys()

   switchon lastChar into
      [
      case $*s:
         endcase
      case $B:  // Back up
         if pinNumber gr 1 then pinNumber = pinNumber-2  // +1 in for loop
         endcase
      default:
         break
      ]
   ]

SignalOn(false)
if lastChar eq $*s then
   [
   ResetLine(statusDsp)
   Wss(statusDsp, "Press switch when ready for next IC.")
   Resets(keys)
   until CheckKeys() do loop
   ]

resultis lastChar
]

// ---------------------------------------------------------------------------
and InTolerance(pin) = valof
// ---------------------------------------------------------------------------
[
if pin>>Pin.expectedOhmsCode eq unknownCode resultis true
let exp = DecodeOhms(pin>>Pin.expectedOhmsCode)
let diff = DecodeOhms(pin>>Pin.measuredOhmsCode) - exp
diff = Max(diff, -diff)  // Abs(diff)
resultis diff le (errorTolerance*
 (exp ls 33? 33, exp) + 50)/100
]

// ---------------------------------------------------------------------------
and ReportDefects(firstIC, stream) = valof
// ---------------------------------------------------------------------------
// Returns the number of pins that are out-of-tolerance and connected
// to net "?".
[
let badUnknownNets = 0
while firstIC ne 0 do
   [
   CheckForDefect(firstIC, stream, lv badUnknownNets)
   firstIC = firstIC>>IC.next
   ]
resultis badUnknownNets
]

// ---------------------------------------------------------------------------
and CheckForDefect(ic, stream, lvBadUnknownNets) be
// ---------------------------------------------------------------------------
[
let firstError = true
for pinNumber = 1 to ic>>IC.nPins do
   [
   let pin = lv ic>>IC.pins^pinNumber
   unless pin>>Pin.measuredOhmsCode eq unknownCode % InTolerance(pin) do
      [
      if firstError then
         [ Puts(stream, $*n); UnparseIC(stream, ic) ]
      firstError = false
      PutTemplate(stream, "; Pin $2D expected resistance: ", pinNumber)
      DisplayOhms(stream, DecodeOhms(pin>>Pin.expectedOhmsCode))
      Wss(stream, ", measured: ")
      DisplayOhms(stream, DecodeOhms(pin>>Pin.measuredOhmsCode))
      let symPin = PinsNetSymbol(pin)
      PutTemplate(stream, ".  Net $S*n", SymbolsString(symPin))
      if symPin eq symUnknownNet then @lvBadUnknownNets = @lvBadUnknownNets+1
      ]
   ]
]

// ---------------------------------------------------------------------------
and SetAllUnknown(ic) be
// ---------------------------------------------------------------------------
   for pinNumber = 1 to ic>>IC.nPins do
      ic>>IC.pins^pinNumber.measuredOhmsCode = unknownCode

// ---------------------------------------------------------------------------
and CheckKeys() = valof
// ---------------------------------------------------------------------------
// Returns true if a key has been struck or the switch depressed.
// Stores the character into lastChar (depressed switch => $*s)
[ // repeat
if Endofs(keys) resultis false
lastChar = Gets(keys)
if lastChar ge $a & lastChar le $z then lastChar = lastChar - ($a-$A)
switchon lastChar into
   [
   case $D:
      Ws("*nDIP probe"); endcase
   case $S:
      Ws("*nSingle probe"); endcase
   case $B:
      Ws("*nBack up"); endcase
   case $I:
      Ws("*nIgnore this IC"); endcase
   case $L:
      Ws("*nLocation: "); endcase
   case $Q:
      Ws("*nQuit"); endcase
   case $*s:
      endcase
   default:
      FlashWindow(dsp)
   case $?:
      Ws("*n? Depress switch or strike space bar to advance .")
      Ws("*nCommands are:")
      Ws("*nDIP probe, Single probe, Back up, Ignore IC, Location, Quit.")
      loop
   ]
resultis true
] repeat

// ---------------------------------------------------------------------------
and GetString() = valof
// ---------------------------------------------------------------------------
[
let string = vec 127
let length = 0

   [ // repeat
   let char = Gets(keys)
   switchon char into
      [
      case $*001:
      case $*010:
         if length gr 0 then
            [
            EraseBits(dsp, -CharWidth(dsp, string>>String.char^length))
            length = length-1
            ]
         endcase
      case $*n:
      case $*033:
         break
      case $*177:
         Ws(" XXX")
         resultis 0
      default:
         unless length eq 255 do
            [
            length = length+1
            string>>String.char^length = char
            Puts(dsp, char)
            ]
         endcase
      ]
   ] repeat

string>>String.length = length
resultis ExtractSubstring(string)
]

// ---------------------------------------------------------------------------
and Confirm() = valof
// ---------------------------------------------------------------------------
[
Ws(" [Confirm] ")
switchon Gets(keys) into
   [
   case $Y: case $y: case $*n:
      Ws("yes"); resultis true
   case $N: case $n: case $*177:
      Ws("no"); resultis false
   default:
      FlashWindow(dsp); Resets(keys); endcase
   ] repeat
]

// ---------------------------------------------------------------------------
and ReportError(template, arg1, arg2, arg3, arg4, arg5) be
// ---------------------------------------------------------------------------
[
Ws("*n")
PutTemplate(dsp, template, arg1, arg2, arg3, arg4, arg5)
Ws("   (more?...)")
Resets(keys)
Gets(keys)
Resets(dsp)
]

//----------------------------------------------------------------------------
and PermAllocate(zone, words) = valof
//----------------------------------------------------------------------------
[ // repeat
if words gr zone>>PermZone.threshold then
   resultis Allocate(zone>>PermZone.underlyingZone, words)
if words gr zone>>PermZone.wordsLeft then
   [
   zone>>PermZone.currentBlock =
    Allocate(zone>>PermZone.underlyingZone, permIncrement, true)
   if zone>>PermZone.currentBlock eq 0 then
      // If failed to allocate, do all future allocations directly from zone
      [ zone>>PermZone.threshold = 0; loop ]
   zone>>PermZone.wordsLeft = permIncrement
   ]
let result = zone>>PermZone.currentBlock
zone>>PermZone.currentBlock = zone>>PermZone.currentBlock + words
zone>>PermZone.wordsLeft = zone>>PermZone.wordsLeft - words
resultis result
] repeat

//----------------------------------------------------------------------------
and ExpandTemplate(template, arg1, arg2, arg3, arg4, arg5) = valof
//----------------------------------------------------------------------------
[
let string = vec 127
let ss = CreateStringStream(string, 255)
PutTemplate(ss, template, arg1, arg2, arg3, arg4, arg5)
Closes(ss)
resultis ExtractSubstring(string)
]

//----------------------------------------------------------------------------
and ResistFinish() be
//----------------------------------------------------------------------------
[
@displayInterrupt = @displayInterrupt & not displayInterruptMask
@lvUserFinishProc = resistSavedUFP
]

//----------------------------------------------------------------------------
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 EncodeOhms(ohms) = valof
//----------------------------------------------------------------------------
[
switchon ohms into
  [
  case unknown: resultis unknownCode
  case open: resultis openCode
  default:
    [
    if ohms ge ohmsCodeTab!31 then resultis openCode
    let power = 0
    let mantissa = 2*(50+Max(ohms, 0))
    while mantissa ls ohmsCodeTab!31 do
      [
      power = power+1
      mantissa = mantissa+mantissa
      ]
    for i = 0 to 31 do
      if mantissa ge ohmsCodeTab!i then resultis 32*power+i
    ]
  ]
]

//----------------------------------------------------------------------------
and DecodeOhms(ohmsCode) = valof
//----------------------------------------------------------------------------
[
switchon ohmsCode into
  [
  case unknownCode: resultis unknown
  case openCode: resultis open
  default: resultis Max(0, ((((ohmsCodeTab!(ohmsCode & 37B)) rshift
    (ohmsCode rshift 5))+1)/2)-50)
  ]
]

//----------------------------------------------------------------------------
and OhmsCodeTable() = valof
//----------------------------------------------------------------------------
[
resultis table [
  10080;9864;9652;9446;9243;9045;8852;8662;8476;8294;8117;7943;7773
  7606;7443;7284;7128;6975;6825;6679;6536;6396;6258;6125;5994;5865
  5739;5616;5496;5378;5263;5150 ]
//   (4990+50)*2^(1-i/32)
]