//routeCorrect.bcpl

// Takes a pass through the old wirelist file and deletes old nets that are not
// duplicated in the new wirelist, and marks new nets for skipping by the
// router.

// last modified by E. McCreight, June 19, 1979 9:27 PM

get "route.defs"

external
[
ReadBlock
WriteBlock
]

manifest [ maxpins = 100 ]

static [ oldictype; deletePosFile = empty; netPerm ]

structure pin:
[
next word
icinst word
pinNo word
sperge word
originalOrder word
]

let CorrelateOldAndNew() be
[
char = used
copyComments = false
deletePosFile = GetFile("route.dpf")
TruncateDiskStream(deletePosFile)
while GetValidChar(OldWlFile) ne $@ do ReadOldICLine(OldWlFile)
SetupNetPerm()

until char eq $*n do char = Gets(OldWlFile)
char = used
while GetValidChar(OldWlFile) ne filegone do ReadOldNet(OldWlFile)
Free(SilZone, netPerm)
TruncateDiskStream(deletePosFile)
Closes(deletePosFile)
deletePosFile = empty
]

and ReadOldICLine(ins) be
[
WeAre(doingCorrection)
let boardloc = vec 20
let attributes = vec 10
ReadNetName(ins, boardloc, attributes, empty, colonMask%atsignMask)
char = used
NormalizeBoardLoc(boardloc)
oldictype = ReadICType(ins)
let newInst = TryFindingNamee(boardloc, typeIcinst)
if newInst eq empty % newInst>>icinst.ictype ne oldictype then
DefineNamee(boardloc, typeOldinst, OldInst)
]

and OldInst(oldinst) be
[
oldinst>>oldinst.ictype = oldictype
]

and ReadOldNet(ins) be
[
static [ CALIBRATE = 0; DISCONNECT = 0 ]

WeAre(doingCorrection)
GetValidChar(ins)
let beginFilePos = vec 2
FilePos(ins, beginFilePos)
beginFilePos!1 = beginFilePos!1-1 // back up to account for the character in char
if beginFilePos!1 eq -1 then beginFilePos!0 = beginFilePos!0-1

if CALIBRATE eq 0 then CALIBRATE = DefineName("CALIBRATE")
if DISCONNECT eq 0 then DISCONNECT = DefineName("DISCONNECT")
let netname = vec 30
let attributes = vec 10
unless ReadNetName(ins, netname, attributes, empty, colonMask) do return
char = used // skip the colon
let name = TryFindingName(netname)
if name eq CALIBRATE then [ SkipNet(ins); return ]
if name eq DISCONNECT then [ ReadDisconnectedPins(ins); return ]

unless WillDefinitelyBeWired(ins) do
[ // put it in the delete file for possible later processing
WriteBlock(deletePosFile, beginFilePos, 2)
]
]

and WillDefinitelyBeWired(ins) = valof
[
let oldpinset = empty
let newpinset = empty
let inOldButNotNew = empty
let inNewButNotOld = empty
let result = WDBW(ins, lv oldpinset, lv newpinset, lv inOldButNotNew,
lv inNewButNotOld)
FreePinSet(lv oldpinset)
FreePinSet(lv newpinset)
FreePinSet(lv inOldButNotNew)
FreePinSet(lv inNewButNotOld)
resultis result
]

and WDBW(ins, pold, pnew, poldnotnew, pnewnotold) = valof
[
until char eq $*n do [ char = used; GetValidChar(ins) ]
char = used

while AddWLPinToPinSet(ins, pold) do [ ]

SortPinSet(pold)

let minSpergePin = @pold
let net = FindNetWithThisPin(minSpergePin>>pin.sperge)

if net eq empty then
[ // not exact match.. try it w/o terminators in old net
while minSpergePin ne empty &
IsTerminator(minSpergePin) do
minSpergePin = minSpergePin>>pin.next

if minSpergePin eq empty do resultis false

net = FindNetWithThisPin(minSpergePin>>pin.sperge)
]

if net eq empty then resultis false

if net>>net.isSame then
[
let x,y = nil,nil
GetPinCoord(minSpergePin>>pin.icinst, minSpergePin>>pin.pinNo, lv x, lv y)
Serious("*nPin {$D,$D} in two nets in .WL file", x, y)
resultis false
]

// if the new net and the old one match exactly, all is wonderful
//
(except if the new net is an unterminated Ecl net). If not,
// then all is wonderful only in the rather complex (but vitally important)
// case that
// 1) the new net has some Ecl, has no termination, and will need some
// 2) the old net is the same, except for terminators, and
// 3) the old net’s terminators can be wired into the new net, and
// 4) if the new net has subnets, the old net conforms to them

BuildPinsetFromNet(net, pnew)
SortPinSet(pnew)

if net>>net.clusterList ne empty then
unless SubnetsConform(net, @pold, @pnew) do resultis false

FindDifferences(@pold, @pnew, poldnotnew, pnewnotold)
if @pnewnotold ne empty then resultis false

// Should terminator additions be permitted? Check the new
// net. It should have some Ecl and no terminators and a
// willingness to accept terminators.

let anyEcl, anyOutput, anyTerminators = false,false,false
let pin = @pnew
while pin ne empty do
[
if IsTerminator(pin) then anyTerminators = true
if IsEcl(pin) then anyEcl = true
if IsOutput(pin) then anyOutput = true
pin = pin>>pin.next
]

// Should have terminators if and only if new net is unterminated Ecl.

unless (@poldnotnew eq empty) eq
((net>>net.dontTerminate ne 0) %
anyTerminators % not anyEcl % not anyOutput) do
resultis false

// see whether all additions are terminators and if so whether
// all can be made successfully

let pin = @poldnotnew
while pin ne empty do
[
unless IsTerminator(pin) do resultis false
let oldicinst = pin>>pin.icinst
let boardloc = FindNameesString(oldicinst)
let icinst = TryFindingNamee(boardloc, typeIcinst)
test icinst eq empty
ifso if TryInserting(boardloc, Icclass(oldicinst), true) ne 0 then
resultis false
ifnot if (icinst>>icinst.ictype ne oldicinst>>icinst.ictype) %
(icinst>>icinst.pin↑(pin>>pin.pinNo) ne empty) then resultis false
pin = pin>>pin.next
]

// the terminator additions can be made successfully.

pin = @poldnotnew
while pin ne empty do
[
static [ oldType ]
unless IsTerminator(pin) do resultis false
let oldicinst = pin>>pin.icinst
let boardloc = FindNameesString(oldicinst)
oldType = oldicinst>>icinst.ictype

let NewFormerTerm(icinst) be
[
unless TryInserting(FindNameesString(icinst), Icclass(oldType)) eq 0 do
CallSwat("Can’t reinstall old IC")
NewICInst(icinst, oldType)
]

let icinst = DefineNamee(boardloc, typeIcinst, NewFormerTerm,
Npins(oldicinst)-1)
AddNewPinToSet(pnew, icinst, pin>>pin.pinNo)
pin = pin>>pin.next
]

// re-sort the new pin set according to the reverse order of the old set

SortPinSet(pnew)
let newpin = @pnew
let oldpin = @pold
while newpin ne empty do
[
if newpin>>pin.sperge ne oldpin>>pin.sperge then CallSwat()
newpin>>pin.sperge = -(oldpin>>pin.originalOrder)
newpin = newpin>>pin.next
oldpin = oldpin>>pin.next
]
SortPinSet(pnew)
net>>net.pinList = lv FindNameesName(net)>>name.mark
newpin = @pnew
while newpin ne empty do
[
let pin = lv (newpin>>pin.icinst)>>icinst.pin↑(newpin>>pin.pinNo)
@pin = net>>net.pinList
net>>net.pinList = pin
newpin = newpin>>pin.next
]
net>>net.isSame = true
net>>net.hasBeenRouted = true
resultis true
]

and IsTerminator(pin) = PinAttributes(pin)<<pinattributes.isTerminator

and IsEcl(pin) = PinAttributes(pin)<<pinattributes.isEcl

and IsOutput(pin) = PinAttributes(pin)<<pinattributes.isOutput%
Icclass(pin>>pin.icinst)>>icclass.isConnector

and PinAttributes(pin) =(Icclass(pin>>pin.icinst)>>icclass.PinAttributes)(
pin>>pin.icinst, pin>>pin.pinNo)

and AddWLPinToPinSet(ins, pinset) = valof
[
let pinstring = vec 20
pinstring>>str.length = 0
let x,y = 0,0
let numCRs = 0
while GetValidChar(ins) ne filegone do
[
if char eq $*n then
[
numCRs = numCRs+1
char = used
if numCRs ge 2 then break
loop
]
numCRs = 0
if char eq ${ then
[
char = used // get rid of {
x = 0
until GetValidChar(ins) eq $, do
[
x = 10*x+char-$0
char = used
]
char = used // get rid of ,
y = 0
until GetValidChar(ins) eq $} do
[
y = 10*y+char-$0
char = used
]
char = used // get rid of }
break
]
if char ne $*s then AppendC(pinstring,char)
char = used
]

if pinstring>>str.length gr 0 then
[
let boardloc = vec 20
let pinNo,modifier = nil,nil
ParsePin(pinstring,boardloc,lv pinNo, lv modifier)
let icinst = TryFindingNamee(boardloc, typeOldinst)
if icinst eq empty then icinst = MustFindNamee(boardloc, typeIcinst)
AddPinToSet(pinset, icinst, pinNo, x, y)
]

resultis numCRs ls 2 & char ne filegone
]

and BuildPinsetFromNet(net, pinset) be
[
FreePinSet(pinset)
let pin = net>>net.pinList
while @pin ne mark do
[
let pinNo = 1
let icinst = pin-offset icinst.pin↑1/16
while icinst>>icinst.type ne typeIcinst do
[
icinst = icinst-1
pinNo = pinNo+1
]
AddNewPinToSet(pinset, icinst, pinNo)
pin = @pin
]
]

and AddNewPinToSet(pinset, icinst, pinNo) be
[
static [ wireLevel = -1 ]
if wireLevel ls 0 then
[
let level = 0
let wire = false
until wire do
[
level = level+1
LevelTransform(level, 0, 0, 0, 0, 0, 0, lv wire)
]
wireLevel = level
]

let x,y = nil,nil
GetPinCoord(icinst, pinNo, lv x, lv y)
LevelTransform(wireLevel, x, y, lv x, lv y) // transformed as
// it would be output to .WL file.
AddPinToSet(pinset, icinst, pinNo, x, y)
]

and AddPinToSet(pinset, icinst, pinNo, x, y) be
[
let pin = Allocate(SilZone, size pin/16)
pin>>pin.icinst = icinst
pin>>pin.pinNo = pinNo
pin>>pin.sperge = Sperge(x, y)
pin>>pin.next = @pinset
@pinset = pin
let cpin = pin>>pin.next
pin>>pin.originalOrder = cpin eq empty? 1, cpin>>pin.originalOrder+1
]

and CopyPin(oldpin, pinset) be
[
let pin = Allocate(SilZone, size pin/16)
MoveBlock(pin, oldpin, size pin/16)
pin>>pin.next = @pinset
@pinset = pin
]

and FreePinSet(pinset) be
[
while @pinset ne empty do
[
let pin = @pinset
@pinset = pin>>pin.next
Free(SilZone, pin)
]
]

and SubnetsConform(net, oldpin, newpin) = valof
[
let newClusterBaseVec = vec 50
newClusterBaseVec!0 = 49
ComputeClusters(newClusterBaseVec, net)
let nClusters = newClusterBaseVec!0

let oldMin, oldMax = vec 50, vec 50
SetBlock(lv (oldMin!1), infinity, nClusters)
SetBlock(lv (oldMax!1), 0, nClusters)

while newpin ne empty do
[
while oldpin ne empty & Usc(newpin>>pin.sperge, oldpin>>pin.sperge) gr 0 do
[
oldpin = oldpin>>pin.next
]
if oldpin eq empty then break
if newpin>>pin.sperge eq oldpin>>pin.sperge then
[
// new pin same as old pin. Find new pin’s cluster.

let newCluster = 1
while newCluster ls newClusterBaseVec!0 &
newpin>>pin.originalOrder ge newClusterBaseVec!(newCluster+1) do
newCluster = newCluster+1

let oldOrder = oldpin>>pin.originalOrder
if oldOrder ls oldMin!newCluster do oldMin!newCluster = oldOrder
if oldOrder gr oldMax!newCluster do oldMax!newCluster = oldOrder
]
newpin = newpin>>pin.next
]

for i=1 to nClusters-1 do
[
if oldMax!i ge oldMin!(i+1) then resultis false
if oldMin!(i+1) eq infinity then oldMax!(i+1)=oldMax!i
]

resultis true
]

and FindDifferences(oldpin, newpin, poldnotnew, pnewnotold) be
[
while oldpin ne empty % newpin ne empty do
[
let useOld = oldpin ne empty
let useNew = newpin ne empty

if useOld & useNew then
[
let direction = Usc(newpin>>pin.sperge, oldpin>>pin.sperge)
if direction ne 0 then test direction gr 0
ifso useNew = false
ifnot useOld = false
]

if useOld then
[
unless useNew do CopyPin(oldpin, poldnotnew)
oldpin = oldpin>>pin.next
]

if useNew then
[
unless useOld do CopyPin(newpin, pnewnotold)
newpin = newpin>>pin.next
]
]
]

and SortPinSet(pinset) be
[ // sort by sperged coordinate field
let nelements = 0
let pin = @pinset
let perm = vec 100
until pin eq empty do
[
nelements = nelements+1
perm>>permutation.element↑nelements = pin
pin = pin>>pin.next
]
perm>>permutation.nelements = nelements

let ComparePinsetSperges(p1, p2) = Usc(p1>>pin.sperge, p2>>pin.sperge)
Sort(perm, ComparePinsetSperges)

if nelements gr 1 then for i=1 to nelements-1 do
(perm>>permutation.element↑i)>>pin.next = perm>>permutation.element↑(i+1)
if nelements gr 0 then
[
@pinset = perm>>permutation.element↑1
(perm>>permutation.element↑nelements)>>pin.next = empty
]
]

and SetupNetPerm() be
[
nitems = 0
MapNamees(typeNet, Count)
netPerm = Allocate(SilZone, nitems+1)
netPerm>>permutation.nelements = 0
MapNamees(typeNet, AddToNetPerm)
Sort(netPerm, CompareNetMinSperges)
]

and AddToNetPerm(net) be
[
if net>>net.isTraceWired then return
if net>>net.minSperge eq -1 then ComputeMinSperge(net)
let nelements = netPerm>>permutation.nelements+1
netPerm>>permutation.nelements = nelements
netPerm>>permutation.element↑nelements = net
]

and CompareNetMinSperges(n1, n2) = Usc(n1>>net.minSperge, n2>>net.minSperge)

and ComputeMinSperge(net) be
[
let minSperge = -1
let pin = net>>net.pinList
let x,y = nil,nil
while @pin ne mark do
[
GetPinCoord(0, pin, lv x, lv y)
let sperge = Sperge(x,y)
if Usc(sperge, minSperge) ls 0 then minSperge = sperge
pin = @pin
]
net>>net.minSperge = minSperge
]

and FindNetWithThisPin(sperge) = valof
[
let i = BinSearch(sperge, 1, netPerm>>permutation.nelements+1, MinSpergeCompare)
if i gr netPerm>>permutation.nelements then resultis empty
resultis MinSpergeCompare(sperge, i) eq 0?
netPerm>>permutation.element↑i, empty
]

and MinSpergeCompare(sperge, index) =
Usc(sperge, (netPerm>>permutation.element↑index)>>net.minSperge)

and SkipNet(ins) be
[
let numCRs = 0
while numCRs ls 2 do
[
if GetValidChar(ins) eq $*n then
[
numCRs = numCRs+1
char = used
loop
]
numCRs = 0
char = used
]
]

and CorrelateRemaining() be
[
if OldWlFile eq empty then OldWlFile = GetFile(wlOldFileName)
if deletePosFile eq empty then deletePosFile = GetFile("route.dpf")
Resets(deletePosFile)
SetupNetPerm()

let readPos = vec 2
FilePos(deletePosFile, readPos)
let writePos = vec 2
FilePos(deletePosFile, writePos)

until Endofs(deletePosFile) do
[
WeAre(doingCorrection)

let owlFilePos = vec 2
ReadBlock(deletePosFile, owlFilePos, 2)
FilePos(deletePosFile, readPos)
SetFilePos(OldWlFile, owlFilePos)

char = used
let oldname = vec 30
let attributes = vec 10
ReadNetName(OldWlFile, oldname, attributes, empty, colonMask)
unless WillDefinitelyBeWired(OldWlFile) do
[
SetFilePos(deletePosFile, writePos)
WriteBlock(deletePosFile, owlFilePos, 2)
FilePos(deletePosFile, writePos)
SetFilePos(deletePosFile, readPos)
]
]
Free(SilZone, netPerm)
Closes(OldWlFile)
OldWlFile = empty
SetFilePos(deletePosFile, writePos)
TruncateDiskStream(deletePosFile)
Closes(deletePosFile)
deletePosFile = empty
]


and ReadDisconnectedPins(ins) be
[
until char eq $*n do [ char = used; GetValidChar(ins) ]
char = used

let pin = empty
while AddWLPinToPinSet(ins, lv pin) do
[
let icclass = Icclass(pin>>pin.icinst)
let pinNo = pin>>pin.pinNo
SetBit(icclass>>icclass.oldCutPins, pinNo, 1)
if GetBit(icclass>>icclass.cutPins, pinNo) eq 0 then
[
let x,y,info = nil,nil,nil
unless (icclass>>icclass.PinOffset)(icclass, pinNo, lv x, lv y, lv info) eq
absolute do CallSwat()
if info<<info.reconnect eq 0 then // can’t reconnect it
SetBit(icclass>>icclass.cutPins, pinNo, 1)
]
FreePinSet(lv pin)
]
]