#!/bin/sh
# SPDX-FileCopyrightText: 2014, 2015, 2020 Efabless Corporation
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
# SPDX-License-Identifier: Apache-2.0
# Copyright (C) 2014, 2015, 2020 efabless Corporation. All Rights Reserved.
# send a very-first -T FILE to magic's startup, hide all other args from magic-startup
# for-bash\
  export _M0= ;\
  for i in "$@" ; do _M0="$_M0${_M0:+ }\"${i//\"/\\\"}\""; done ;\
  case "$1" in -T) tch="$2"; shift; shift; _MARGS="$*" exec magic -dnull -noconsole -T "$tch" <"$0" ;; esac
# hide next line from magic(tclsh):\
_MARGS="$*" exec magic -dnull -noconsole <"$0"
#
# magicDRC: run magic-DRC in batch on a GDS file, tabulate/pareto the error counts.
# 
# rb@ef 2014-08-28 author
# rb 2020-02-19 embed some library functions, to standalone from efabless-opengalaxy env, test via magic-8.2.188
#
# todo: support "-" as GDS file arg, to mean GDS from stdin
#

set ::Prog "magicGdrc"
set argv  [eval "list $env(_M0)"] ;# orig. mix of native plus custom args, for logging all args to script
# set argv [split $env(_MARGS)]   ;# (currently unused)

proc usage {args} {
    if {[llength $args] > 0} {
	puts "ERROR: ${::Prog}: [join $args]"
    }
    puts {usage: [ -T techfilePath ] [-S <drcStyleName>]  [-I <cifIStyleName>] [-km FILE_NAME] [-l FILE_NAME] [-L FILE_NAME] gdsFileName [topCellName]}
    puts "  -T if given, must be very first"
    puts "  -S if given, changes from techfile's default/1st drc style (perhaps \"drc(fast)\") to named style, for example: -S \"drc(full)\""
    puts "  -I if given, changes from techfile's default/1st cifinput style (perhaps \"vendorimport\" or \"import(exact)\") to named style, for example: -I \"import(magic)\""
    puts "  -path-sub do 'gds path    subcell yes' (default:no). Make unique subcell for each path: cut #tiles cost of angles."
    puts "  -poly-sub do 'gds polygon subcell yes' (default:no). Make unique subcell for each polygon: cut #tiles cost of angles."
# gds polygon subcell [yes|no]
    puts "  -pps  Short hand, equivalent to giving both: -path-sub -poly-sub"
    puts ""
    puts "  Error tabulation: By default (slowest, most detail): Report table of counts-by-errorString for all cells."
    puts "  Stdout logs a pareto of error-type by count unless disabled for some/all cells by below; topcell last."
    puts "  -tt Table of counts-by-errorString for ONLY topcell; and just lumped total error count per subcell."
    puts "  -tc Just lumped error counts per cell including topcell (fastest, least detail)."
    puts "  Cells NOT tabulating count-by-errorString can't appear in other output error files: feedback(*.drtcl), -l, -km."
    puts "  For lumped error counts, overlapped error shapes from unique error-types are merged further reducing count."
    puts ""
    puts "  cell-type +--    (default)     --+--  option -tt      --+--   option -tc"
    puts "    subcell | count-by-errorString |   lumped-error-count | lumped-error-count"
    puts "    topcell | count-by-errorString | count-by-errorString | lumped-error-count"
    puts ""
    puts "  -km if given, write to FILE_NAME EVERY individual error bbox (MICRONS) in klayout Marker database(XML) format (suggest *.lyrdb)"
    puts "  -l if given, enumerates EVERY individual error bbox (MICRONS) to FILE_NAME, emulates $::CAD_ROOT/magic/tcl/drc.tcl"
    puts "  -L same as -l above, but outputs bbox-es in LAMBDA coordinates, not microns"
    puts "  -nf  Do NOT write *.drtcl per-cell feedback files. Can be source-ed in magic and step thru: feedback find."
    puts ""
    puts "  NOTES: Without explicit tech-file option: the ./.magicrc or ./magic_setup and ~/.magicrc may load a default tech-file."
    puts "  Therefore the tech-file used CAN depend on whether your CWD is ~/design/<CURRENT_DESIGN>/mag when running this script."
    puts "  Since no *.mag are loaded by this script: the cell search path defined by any init files has no impact."
    puts "  Since about 8.3.68, magic may generate error-type \"See error definition in the subcell\". There typically are"
    puts "  redundancies of errors across the hierarchy anyway (but with tech-file err-strings), this seems another form."
    puts ""
    puts "example, just list all styles: by causing an error which provokes usage report:"
    puts "    magicGdrc -T /ef/tech/XFAB/EFXH035B/libs.tech/magic/current/EFXH035B.tech"
    puts "example, same but run in a ~/design/*/mag/ dir, so techfile set by ./.magicrc (else magic's builtin minimum.tech):"
    puts "    magicGdrc"
    puts "example, run GDS drc, explicit: tech, cif-istyle, drc-style:"
    puts "    magicGdrc -T /ef/tech/SW/EFS8A/libs.tech/magic/current/EFS8A.tech -I vendorimport -S 'drc(full)' /tmp/mytop.gds mytopcell"
    puts "example, run GDS drc, default tech & styles, write klayout marker database, no per-cell *.drtcl feedback files:"
    puts "    magicGdrc -km /tmp/mytop.lyrdb -nf /tmp/mytop.gds mytopcell"
    puts "example, same but make subcells for paths & polygons"
    puts "    magicGdrc -km /tmp/mytop.lyrdb -nf -pps /tmp/mytop.gds mytopcell"
    puts "example, run GDS drc, no feedback (*.drtcl), only lumped/merged err-count for all cells"
    puts "    magicGdrc -tc /tmp/mytop.gds mytopcell"
    puts "example, run GDS drc, no feedback (*.drtcl), lumped/merged err-count for subcells, detail errors for topcell"
    puts "    magicGdrc -nf -tt /tmp/mytop.gds mytopcell"
    puts ""

    reportTechFile
    reportAllStyles
    puts ""

    if {[llength $args] > 0} {
	puts "ERROR: ${::Prog}: [join $args]"
    }
}
proc gdsChk {file} {
    foreach suffix {"" ".gds" ".gds2" ".strm"} {
	if {[file readable "${file}${suffix}"]} {return 1}
    }
    puts "ERROR: ${::Prog}: Cannot open (as-is or with .gds, .gds2, or .strm) to read GDS-II stream from: $file"
    exit 1
}

proc reportTechFile {} {
    puts "${::Prog}: tech-name: [tech name] -version: [tech version] -filename: [tech filename] -lambda [tech lambda]"
}

# query currently loaded tech-file for styles the user might need for -I -S options
# Suggest a bad tech-file if none are found or errors thrown.
# Used after finding error in -I -S options, and probably should add it to the usage.
proc reportAllStyles {} {
    set errs {}
    if {[catch {set allstyle [cif listall istyle]} msg]} {
	lappend errs "ERROR: ${::Prog}: bad tech-file? failed to 'cif listall istyle', $msg"
    } elseif {$allstyle == {}} {
	lappend errs "ERROR: ${::Prog}: bad tech-file? no cifinput styles found by 'cif listall istyle'"
    } else {
	puts "info: ${::Prog}: cifinput styles available: $allstyle"
    }
    if {[catch {set allstyle [drc listall style]} msg]} {
	lappend errs "ERROR: ${::Prog}: bad tech-file? failed to 'drc listall style', $msg"
    } elseif {$allstyle == {}} {
	lappend errs "ERROR: ${::Prog}: bad tech-file? no drc styles found by 'drc listall style'"
    } else {
	puts "info: ${::Prog}: drc styles available: $allstyle"
    }
    if {$errs != {}} {

    }
    return [llength $errs]
}

# optionally hardcode library proc-s (part of site-wide extensions - always available - in context of efabless/open-galaxy)
# This is to make the script more standalone from efabless environment; but these capabilities should be native to magic.

if {[info command unbounds] == {}} {
    puts "${::Prog}: hardcoding library proc-s..."
# Replacement for 'cellname list exists CELLNAME', to fix ambiguity for cell "0".
# For cell "0" test for membership in 'cellname list allcells'.
#
# Instead of returning 0 for (non-existent) and cellname for exists,
# returns regular 0/1 instead for non-existent/exists.
#
# Therefore NOT direct replacement for uses of 'cellname list exists CELL'.
# Requires code changes.
proc cellnameExists {cell} {
    expr {$cell ne "0" && [cellname list exists $cell] eq $cell ||
	  $cell eq "0" && [lsearch -exact [cellname list allcells] $cell] > -1}
}

# Walk allcells to get/return list of cellNames that are unbound.
# Only use this after: 'select top cell; expand' to expand whole hierarchy.
#
# foreach CELL in 'cellname list allcells':
#   if flags says available : it's Bound, goto next cell.
#   if filepath is "default", try to expand the cell.
#   if still "default"**: cell made by "cellname create", never saved, goto next.
#   if filepath is CELL.mag, check for "available" flags, if none: Unbound.
#   else cell is bound.
#   **: should never get there
proc unbounds {} {
    set allcells [cellname list allcells]
    # filter (UNNAMED)
    set allcells [lsearch -exact -not -all -inline $allcells "(UNNAMED)"]
    # set nbrAllCells [llength $allcells]
    set ercell {}
    foreach cell $allcells {
	# filter (without recording as skipped) non-existent cells.
	if {![cellnameExists $cell]} { continue }

	# filepath = "default": unexpanded (not loaded from disk),
	# or created in-mem and never saved (is writable already
	# though flags won't say so): skip both.
	# TODO: use a combo of filepath & flags likely can detect created in-mem
	set tmppath [cellname list filepath $cell]
	if {$tmppath eq "default"} {
	    lappend skipped $cell
	    continue
	}

	# flags not meaningful, until expanded or expand attempted.
	# After expand attempt (filepath != "default"), and flags
	# can now be used to determine cell unbound: not available.
	set flags   [cellname list flags    $cell]
	if {[lsearch -exact $flags available] < 0} {
	    lappend ercell $cell
	    continue
	}
    }
    set ercell ;# return list of unbound cells, if any
}
}

# without top-level proc around bulk of script, intermediate error statements don't abort script.
proc main {argv} {

set mlen [llength $argv]

# process name-value pair options, if any
set nbrErr 0
set ndx 0
set max [llength $argv]
set extTechOpt {} ;# -T ... but not used here
set enumFilel  {} ;# -l ... enum output file
set enumFileL  {} ;# -L ... enum output file
set enumFileKm {} ;# -km ... enum output file
set variant {}    ;# -S ... non-default drc style
set istyle  {}    ;# -I ... non-default cifinput style
set doFeedback 1  ;# -nf sets to 0: Do not write *.drtcl per-cell feedback files.
set pathSub 0     ;# -path-sub ... do 'gds path    subcell yes'
set polySub 0     ;# -poly-sub ... do 'gds polygon subcell yes'
set subcellTab 1  ;# -tt, -tc both turn OFF subcell count-by-error report
set topcellTab 1  ;#      -tc     turns OFF topcell count-by-error report
set flatten 0
while {$ndx < $max && [string match "-*" [lindex $argv $ndx]]} {
    set opt [lindex $argv $ndx]
    incr ndx
    switch -exact -- $opt {
	-T {
	    if {$ndx != 1} {
		usage "-T option must very 1st (here was #$ndx)"
		exit 1
	    }
	    if {$ndx == $max} {
		usage "missing tech-file argument for -T option"
		exit 1
	    }
	    set extTechOpt [lindex $argv $ndx] ;# unused
	    incr ndx
	}
	-S {
	    if {$ndx == $max} {
		usage "missing drcStyle argument for -S option"
		exit 1
	    }
	    set variant [lindex $argv $ndx]
	    incr ndx
	}
	-I {
	    if {$ndx == $max} {
		usage "missing cifinput-style argument for -I option"
		exit 1
	    }
	    set istyle [lindex $argv $ndx]
	    incr ndx
	}
	-F        { set flatten     1}
	-nf       { set doFeedback 0 }
	-path-sub { set pathSub     1}
	-poly-sub { set polySub     1}
	-pps      { set pathSub     1; set polySub     1}
	-tt       { set subcellTab 0 ; set topcellTab  1}
	-tc       { set subcellTab 0 ; set topcellTab 0 }
	-km {
	    if {$ndx == $max} {
		usage "missing outputFile argument for -km option"
		exit 1
	    }
	    set enumFileKm [lindex $argv $ndx]
	    incr ndx
	}
	-l {
	    if {$ndx == $max} {
		usage "missing outputFile argument for -l option"
		exit 1
	    }
	    set enumFilel [lindex $argv $ndx]
	    incr ndx
	    if {[catch {set enumOut [open $enumFilel w]} msg]} {
		error "ERROR: ${::Prog}: failed to open-for-write '$enumFilel' threw error, $msg"
	    }
	    puts "${::Prog}: enumerating each error bbox to: $enumFilel"
	}
	-L {
	    if {$ndx == $max} {
		usage "missing outputFile argument for -L option"
		exit 1
	    }
	    set enumFileL [lindex $argv $ndx]
	    incr ndx
	    if {[catch {set enumOutL [open $enumFileL w]} msg]} {
		error "ERROR: ${::Prog}: failed to open-for-write '$enumFileL' threw error, $msg"
	    }
	    puts "${::Prog}: enumerating each error bbox to: $enumFileL"
	}
	default {
	    usage "unknown option: $opt"
	    exit 1
	}
    }
}

if {$ndx == $max} {
    usage {Insufficient number of arguments, need gdsFileName [topCellName]}
    exit 1
}

set gdsf [lindex $argv $ndx] ; incr ndx
set topc {}
set topcStr "(AUTO)"
if {$ndx < $max} {
    set topc [lindex $argv $ndx] ; incr ndx
    set topcStr $topc
}
# error if extra options (not understood, something is wrong):
if {$ndx < $max} {
    error "ERROR: ${::Prog}: after gdsFile=\"$gdsf\", topcell=\"$topc\" found unsupported extra arguments: [lrange $argv $ndx end]"
}
# ndx no longer used for argv position from here

gdsChk $gdsf

# warning on combo of -tc & -km. If -km ok, open its output file.
if {$enumFileKm ne {}} {
    if {! $topcellTab} {
	    puts "WARNING: ${::Prog}: with -tc cannot (-km) write klayout-marker-db"
    } else {	
	if {[catch {set enumOutKm [open $enumFileKm w]} msg]} {
	    error "ERROR: ${::Prog}: failed to open-for-write '$enumFileKm' threw error, $msg"
	}
	puts "${::Prog}: enumerating each error bbox to: $enumFileKm"
    }
}

# write a line with timestamp and all arguments to stdout (log)
# (magic renames the TCL clock command)
set clockp clock
if {[info command $clockp] == {} && [info command orig_clock] != {}} {
    set clockp orig_clock
}
set nowSec [$clockp seconds]
set timestamp [$clockp format $nowSec -format "%Y-%m-%d.%T.%Z"]
# TODO: quote logged argv here as needed so it's machine readable for replay purposes.
puts "${::Prog}: timestamp: $timestamp, arguments: $argv"

# just Manhattan is default, turn on euclidean, and log new mode
drc euclidean on
drc euclidean

# 8.1.83 this worked:
#    drc off; gds drccheck no;  gds read ... ; load topcell; select top cell; expand; drc check; drc update; drc listall count
# By 8.2.64, that fails, the 'drc listall count' reports errors only in the top-cell, no subcells.
# 8.1.83 & 8.2.193 this works (gds drccheck defaults to on anyway):
#    drc off; gds drccheck yes; gds read ... ; load topcell; select top cell; expand; drc check; drc update; drc listall count
#
# But are we properly avoiding redundant drc runs?
#
# turn off background checker. We'll invoke checks explicitly.
drc off
gds drccheck yes
puts "drc status (whether background checking enabled) is: [drc status]"
puts "gds drccheck (whether gds-read marks new cells as need-drc) is: [gds drccheck]"

# set user's drc style; set user's cifinput istyle
# These are back-to-back without intervening status messages.
# If both wrong their errors are back-to-back.
set res {}
set res [drc list style]
if {$variant != {}} {
    set allstyle [drc listall style]
    set ndx [lsearch -exact $allstyle $variant]
    if {$ndx < 0} {
	puts "ERROR: ${::Prog}: drc style '$variant' not one of those available: $allstyle"
	incr nbrErr
    } else {
	set res [drc list style $variant]
    }
}
set res2 [cif list istyle]
if {$istyle != {}} {
    set allstyle [cif listall istyle]
    set ndx [lsearch -exact $allstyle $istyle]
    if {$ndx < 0} {
	puts "ERROR: ${::Prog}: istyle '$istyle' not one of those available: $allstyle"
	incr nbrErr
    } else {
	set res2 [cif istyle $istyle]
    }
}
if {$res != {}} {
    puts "drc style reports:\n$res"
}
if {$res2 != {}} {
    puts "cif istyle reports:\n$res2"
}

# gds {path,polygon} subcell yes
if         {$pathSub != 0} { gds    path subcells yes }
puts "gds    path subcells: [gds    path subcells]"
if      {$polySub != 0}    { gds polygon subcells yes }
puts "gds polygon subcells: [gds polygon subcells]"

# todo: this catch never happens. Need nicer error check of 'gds read' somehow. Can check for zero-sized file?
# if use /dev/null for example, it prints its own error message, but no throw, no useful return value.
puts         "doing: gds read $gdsf ..."
if {[catch {set res [gds read $gdsf]} msg]} {
    puts "ERROR: ${::Prog}: 'gds read $gdsf' threw error, $msg"
    incr nbrErr
}
# nothing useful:
# puts "gds-read res: $res"

set topcells [cellname list top]
set allcells [cellname list allcells]
# puts "cellname-list-top from GDS is: $topcells"
# puts "cellname-list-allcells from GDS are: $allcells"
# filter (UNNAMED)
set topcells [lsearch -exact -not -all -inline $topcells "(UNNAMED)"]
set allcells [lsearch -exact -not -all -inline $allcells "(UNNAMED)"]
set nbrAllCells [llength $allcells]

if {$topcells == {}} {
    puts "ERROR: ${::Prog}: GDS-read did not report any useful cell name(s) found."
    incr nbrErr
}

if {$nbrErr > 0} {
    return $nbrErr ;# outside of main, we print termination with errors message
}

if {$topc == {}} {
    # try and infer topcell from cellname-list-top.
    # presume its list of cells not placed anywhere else.
    # todo: test with "library" GDS having more than one topcell
    # here we just take the last entry
    set topc [lindex $topcells end]
    set topcStr $topc
    puts "WARNING: auto-picked top-cell \"$topc\"; the topcells inferred from GDS are: $topcells"
} else {
    # verify input topc argument exists in GDS read result
    set ndx [lsearch -exact $allcells $topc]
    if {$ndx < 0} {
	puts "ERROR: ${::Prog}: top-cell name: $topc, not found in GDS"
	puts "info: top cells inferred from GDS are: $topcells"
	puts "info: all cells inferred from GDS are: $allcells"
	return [incr nbrErr] ;# outside of main, we print termination with errors message
    }
}

puts "${::Prog}: running drc on -gds: $gdsf -topcell: $topcStr"
reportTechFile

# todo: need to error check load command somehow (no useful return value).
# it can fail with error message (in log) like:
#   File dne.mag couldn't be found
#   Creating new cell
if {[catch {set res [load $topc]} msg]} {
    puts "ERROR: ${::Prog}: 'load $topc' threw error (maybe cellName not found in GDS?), $msg"
    return [incr nbrErr] ;# outside of main, we print termination with errors message
}
# nothing useful:
# puts "load $topc res: $res"

if {$flatten} {
    # delete (UNNAMED) if any.
    set trg "(UNNAMED)"
    if {[cellnameExists $trg]} {cellname delete $trg}

    # rename top cell to (UNNAMED)
    cellname rename $topc $trg

    # now Edit Cell contents are original top cell, but under name (UNNAMED)
    # flatten Edit-Cell into original top cell name
    puts "${::Prog}: flattening..."
    flatten $topc

    # load and edit new version of top cell
    load $topc

    # crude way even in batch to determine the "current" cell; perhaps not yet the "Edit" cell
    # WARNING, if topcell locked elsewhere or not writable, it can't become the "Edit" cell.
    set topcw [cellname list window]
    if {$topcw ne $topc} {
	puts "ERROR: ${::Prog}: assertion failed, post-flatten, $topc, is not the current cell, 'cellname list window'=$topcw"
	return [incr nbrErr] ;# outside of main, we print termination with errors message
    }

    # should not be necessary:
    select top cell
    edit

    # crude way even in batch to determine the "current" cell; perhaps not yet the "Edit" cell
    # WARNING, if topcell locked elsewhere or not writable, it can't become the "Edit" cell.
    set topcw [cellname list window]
    if {$topcw ne $topc} {
	puts "ERROR: ${::Prog}: assertion-2 failed, post-flatten, $topc, is not the current cell, 'cellname list window'=$topcw"
	return [incr nbrErr] ;# outside of main, we print termination with errors message
    }
}

# Erase all preexisting *.drtcl first. Else when cell transitions from
# dirty in previous run (leaving *.drtcl), to clean, the old *.drtcl
# remains.
# TODO: only delete *.drtcl of cells in 'cellname list allcells'?
if {$doFeedback} {
    set files [glob -nocomplain -types {f} -- ./*.drtcl]
    if {$flatten} {
	# only delete topcell's .drtcl in flatten mode, if there is one
	set files [lsearch -all -inline -exact $files ./$topc.drtcl]
    }
    if {$files != {}} {
	# TODO: detect/report failure details better here?
	puts "${::Prog}: deleting preexisting *.drtcl"
	set msg {}
	set delfail [catch {eval {file delete} $files} msg]
	set files [glob -nocomplain -types {f} -- ./*.drtcl]
	if {$delfail || $files != {}} {
	    puts "ERROR: ${::Prog}: failed to clean old ./*.drtcl files. $msg"
	    incr nbrErr
	}
    }
}

# 1st "select top cell": without it drc-list-count is blank, and error count reduced.
select top cell

set bbox0 [view bbox]
set outScale [cif scale out]

# set bbox1 [view bbox]

# "select top cell" and box [view bbox] should be equivalent in
# placing a box around whole cell extent.
# The box cmd ALSO prints lambda and micron user-friendly box data,
# but it prints microns with not enough resolution,
# (and no option to disable that flawed print out).
#
# todo: emulate box output in full, except for higher resolution,
# here we only scale/print the overall bbox in microns.
set bbs {}
foreach oord $bbox0 {
    lappend bbs [format "%.3f" [expr {$outScale * $oord}]]
}
puts "info: outScale: [format "%.6f" $outScale], view-bbox: $bbox0"
puts "info: Root cell box: ([lindex $bbs 0]  [lindex $bbs 1]), ([lindex $bbs 2]  [lindex $bbs 3])"

drc check
drc catchup
drc statistics
drc rulestats
# puts "doing plain: drc count"
drc count

# 2nd select top cell needed else error count may be reduced (why? bbox does not change due to DRC)
select top cell

set celllist        [drc listall count]
set drcListCountTot [drc list count total]
# puts stdout "(drc listall count)       is << " nonewline; puts stdout [list $celllist]                 nonewline; puts " >>"
# puts stdout "(drc list count)          is << " nonewline; puts stdout [list [drc list count]]          nonewline; puts " >>"
# puts stdout "(drc list    count total) is << " nonewline; puts stdout [list $drcListCountTot]          nonewline; puts " >>"
# puts stdout "(drc listall count total) is << " nonewline; puts stdout [list [drc listall count total]] nonewline; puts " >>"
# puts stdout "(drc list why)            is << " nonewline; puts stdout [list [drc list why]]            nonewline; puts " >>"
# puts stdout "(drc listall why)         is << " nonewline; puts stdout [list [drc listall why]]         nonewline; puts " >>"

set bbox2 [view bbox]
if {$bbox2 != $bbox0} {
    set bbs {}
    foreach oord $bbox2 {
	lappend bbs [format "%.3f" [expr {$outScale * $oord}]]
    }
    puts "info: outScale: [format "%.6f" $outScale], view-bbox: $bbox2"
    puts "info: Root cell box2: ([lindex $bbs 0]  [lindex $bbs 1]), ([lindex $bbs 2]  [lindex $bbs 3])"
}


# canonicalize order of celllist, move topc to last (if present whatsoever).
# force our own artificial entry for topc (zero errors) if not present (was clean)
# puts "celllist before: $celllist"
set nbrErrCells [llength $celllist]
set topcPair [lsearch           -inline -index 0 -exact $celllist $topc]
set celllist [lsearch -not -all -inline -index 0 -exact $celllist $topc]
set celllist [lsort -index 0 -dictionary $celllist]
if {$topcPair == {}} {
    # puts "info: ${::Prog}: $topc clean, forcing celllist entry for it"
    set topcPair [list $topc 0]
}
lappend celllist $topcPair
# puts stdout "adjusted celllist(drc list count) is << " nonewline; puts stdout $celllist nonewline; puts " >>"

array set kmErr2catNm {}
array set kmErr2catDesc {}
array set kmCell2item {}
if {$celllist != {} && [info exists enumOutKm]} {
    # Header example of .lyrdb klayout Marker format
    # <?xml version="1.0" encoding="utf-8"?>
    # <report-database>
    # <description>Diff of 'x.gds, Cell RINGO' vs. 'x.gds[1], Cell INV2'</description>
    # <original-file/>
    # <generator/>
    # <top-cell>RINGO</top-cell>
    # <tags>
    # <tag>
    # <name>red</name>
    # <description>Red flag</description>
    # </tag>
    # ... 
    # </tags>

    puts $enumOutKm {<?xml version="1.0" encoding="utf-8"?><report-database>}
    puts $enumOutKm "<description>$topc DRC timestamp: $timestamp, arguments: $argv</description>"
    puts $enumOutKm {<original-file/><generator/>}
    puts $enumOutKm "<top-cell>$topc</top-cell>"
    puts $enumOutKm {<tags/>}
    puts $enumOutKm {<cells>}

    # multiple <cells>...</cells> sections do accumulate, but cells and categories need
    # to be defined before use in an item (specific error), and we know cell names here,
    # so declare all cells to klayout here.
    #
    # Cell-specific header of klayout marker file
    #  <cell>
    #   <name>CELLNAME1</name>
    #   <variant>1</variant>               (don't need)
    #  </cell>
    #
    foreach pair $celllist {
	set acell [lindex $pair 0]

	# for -tt, no subcell error-detail: don't write subcells in <cells>...</cells> section.
	if {$acell ne $topc && ! $subcellTab} { continue }

	puts $enumOutKm "  <cell><name>$acell</name></cell>"
	set kmCell2item($acell) {}
    }
    puts $enumOutKm {</cells>}
}

# loop over celllist
set gtotal 0
set gcells 0
set lumpedHeader 0
foreach pair $celllist {
    set acell [lindex $pair 0]
    set acount [lindex $pair 1]

    if {$acell ne $topc && ! $subcellTab} {
	if {! $lumpedHeader} {
	    puts "--- #err|cell, lumped total counts"
	    set lumpedHeader 1
	}
	puts "[format {%8d} $acount] $acell"
	incr gcells
	incr gtotal $acount
	continue
    }
    if {$acell eq $topc && ! $topcellTab} {
	if {! $lumpedHeader} {
	    puts "--- #err|cell, lumped total counts"
	    set lumpedHeader 1
	}
	puts "[format {%8d} $acount] $acell"
	incr gcells
	incr gtotal $acount
	continue
    }
    puts ""

    # todo: need useful error check of load command
    if {[catch {set res [load $acell]} msg]} {
	puts "ERROR: ${::Prog}: 'load $acell' threw error, $msg"
	return [incr nbrErr] ;# outside of main, we print termination with errors message
    }

    # instead use quiet version for per-cell selects
    select top cell

    set drcListCountTot [drc listall count total]

    # enumerate errors under box, plain "drc why" only reports unique types, no quantities
    # as-yet-undocumented "drc listall why" will give: {errStr1 {errBox1 ...} errStr2 {errBox1 ...} ... }
    set pareto {}
    set total 0
    set enumTotal 0
    set types 0
    set typeDup 0
    set dups 0

    set fbOut {}
    if {$acount != 0} {
	# file path for feedback, keep in CWD
	if {$doFeedback && $fbOut == {}} {
	    set fbOut "./$acell.drtcl"
	    if {![file writable $fbOut] &&
		([file exists $fbOut] || ![file writable [file dir $fbOut]])} {
		puts stderr "ERROR: ${::Prog}: feedback output not writable, $fbOut"
		incr nbrErr
		set fbOut {}
	    } elseif {[catch {set outfb [open $fbOut w]} msg]} {
		puts stderr "ERROR: ${::Prog}: failed to truncate previous feedback output, $fbOut : $msg"
		incr nbrErr
		set fbOut {}
	    }
	}

	foreach {str boxes} [drc listall why] {
	    # sort errors
	    set boxes [lsort -dictionary $boxes]
	    # for our pareto, gather data
	    set this [llength $boxes]
	    incr total $this
	    incr types
	    lappend pareto [list $this $str]

	    # for enumOut, emulate formatting of $CAD_ROOT/magic/tcl/drc.tcl, which is
	    # not tk pure: fails with complaint about winfo
	    # note: we walk these errors also in order to count/report stats on duplicates, even if not outputing enumerations
	    if {[info exists enumOut]} {
		if {$types == 1} {
		    puts $enumOut "[join $pair]\n----------------------------------------"
		}
		puts $enumOut "${str}\n----------------------------------------"
	    }
	    if {[info exists enumOutL]} {
		if {$types == 1} {
		    puts $enumOutL "[join $pair]\n----------------------------------------"
		}
		puts $enumOutL "${str}\n----------------------------------------"
	    }
	    if {[info exists enumOutKm]} {
		# category names must be declared all together up front before use in items
		# so we only store their names (error strings) and error detail (items)
		# to dump after all cells and errors are processed.
		# TODO: Only quote catName in item if embeds dot, instead of full-time
		# TODO: test klayout handles literal (non-entity) single-quote in double-quoted name
		set strKmNm   $str
		set strKmDesc $str
		regsub -all -- {&} $strKmDesc {\&amp;} strKmDesc  ;# perhaps not needed; just in case
		regsub -all -- {<} $strKmDesc {\&lt;}  strKmDesc  ;# description does not have such bug, so use correct entity
		regsub -all -- {>} $strKmDesc {\&gt;}  strKmDesc  ;# perhaps not needed; just in case
		regsub -all -- {&}  $strKmNm  {-and-} strKmNm    ;# perhaps not needed; just in case
		regsub -all -- {>}  $strKmNm  {-gt-}  strKmNm    ;# perhaps not needed; just in case
		regsub -all -- {<}  $strKmNm  {-lt-}  strKmNm    ;# catName klayout bug: info win truncates at '<' as &lt; entity
		regsub -all -- "\"" $strKmNm  {'}     strKmNm    ;# we dqoute each catNm in item, so change embedded double to single
		set kmErr2catNm($str)   $strKmNm
		set kmErr2catDesc($str) $strKmDesc
		#
		# example klayout Marker format, header of one item (one error instance)
		#  <item>
		#   <tags/>               (don't need?)
		#   <image/>               (don't need?)
		#   <category>'DRC-MSG-STR'</category>       (cat1.cat2 path delimit by dot: names with dot need single|double quotes)
		#   <cell>RINGO:1</cell>                     (don't need :N variant suffix)
		#   <visited>false</visited>                  (optional? start with false?)
		#   <multiplicity>1</multiplicity>           (not boolean, if error "represents" more that are NOT enumerated)
		#   <values> ... </values>
		#  </item>

		set itemStr "<item><category>\"$strKmNm\"</category><cell>$acell</cell><values>"
	    }
	    set lastq {}
	    set thisDup 0
	    foreach quad $boxes {
		set quadUM {}
		set kmBoxUM {}
		foreach coord $quad {
		    set valum [expr {$coord * $outScale}]
		    set valumf [format "%.3f" $valum]
		    lappend quadUM "${valumf}um"
		    lappend kmBoxUM ${valumf}
		}
		set dup [expr {$quad == $lastq}]
		incr thisDup $dup
		set line $quadUM
		if {[info exists enumOut]} {
		    if {$dup} {
			puts $enumOut "[join $line] #dup"
		    } else {
			puts $enumOut [join $line]
		    }
		}
		if {[info exists enumOutL]} {
		    if {$dup} {
			puts $enumOutL "$quad #dup"
		    } else {
			puts $enumOutL $quad
		    }
		}
		if {[info exists enumOutKm]} {
		    #    <value>text: 'item: polygon'</value>                          (text is optional? Repeat the box coordinates here in um?)
		    #    <value>polygon: (1.4,1.8;-1.4,1.8;-1.4,3.8;1.4,3.8)</value>
		    #    <value>box: (1.4,1.8;-1.4,3.8)</value>
		    #   </values>
		    set kmItem $itemStr
		    append kmItem " <value>box: ([lindex $kmBoxUM 0],[lindex $kmBoxUM 1];[lindex $kmBoxUM 2],[lindex $kmBoxUM 3])</value>"
		    if {$dup} {
			append kmItem " <value>text: 'dup'</value>"
		    }
		    append kmItem " </values></item>"
		    lappend kmCell2item($acell) $kmItem
		}
		if {$fbOut != {}} {
		    set line [join $quadUM]
		    regsub -all -- "(\[\[\"\$\\\\])" $str {\\\1} strdq
		    puts $outfb "[concat box $line]"                nonewline
		    puts $outfb " ; feedback add \"$strdq\" medium" nonewline
		    if {$dup} {
			puts $outfb " ;#dup"
		    } else {
			puts $outfb ""
		    }
		}

		incr enumTotal
		set lastq $quad
	    }
	    if {$thisDup} {
		incr typeDup
		incr dups $thisDup
	    }
	    if {[info exists enumOut]} {
		puts $enumOut "----------------------------------------\n"
	    }
	    if {[info exists enumOutL]} {
		puts $enumOutL "----------------------------------------\n"
	    }
	}
    }

    if {$fbOut != {}} {
	close $outfb
	set outfb {}
    }

    set pareto [lsort -integer -decreasing -index 0 $pareto]
    if {$total > 0} {
	puts "--- #err|description, table for cell: $acell"
    }
    foreach pair $pareto {
	puts "[format {%8d} [lindex $pair 0]] [lindex $pair 1]"
    }
    if {$typeDup} {
	puts "[format {%8d} $dups] total duplicate error(s) among $typeDup error type(s), cell: $acell"
    }
    puts "[format {%8d} $total] total error(s) among $types error type(s), cell: $acell"
    # add to grand-totals
    incr gcells
    incr gtotal $total

    # always compare the total from the enum to the pareto as error check
    if {$total != $enumTotal} {
	puts "ERROR: ${::Prog}: cell: $acell, internal error, pareto vs enum count mismatch: $total != $enumTotal"
	incr nbrErr
    }
    # wish to compare the drc-list-count-total to the pareto total.
    # Per te 2014-08-27 : it is not an error.
    if {$total != $drcListCountTot} {
	# puts "info: ${::Prog}: cell: $acell, drc-list-count-total vs drc-listall-why mismatch {drc list count total} gave $drcListCountTot, but {drc listall why} gave $total"
    }
}

# grand totals
puts "[format {%8d} $nbrErrCells] of $nbrAllCells cell(s) report error(s)"
puts "[format {%8d} $gtotal] grand-total error(s) across $gcells cell(s)"

if {[info exists enumOut]} {
    close $enumOut
}
if {[info exists enumOutL]} {
    close $enumOutL
}
if {[info exists enumOutKm]} {
    # declare all category names and descriptions, note '<' in name vs description are represented differently
    #
    # <categories><category><name>layerN width -lt- 1.0um</name>
    # <description>layerN width &lt; 1.0um</description></category>
    # <category> ... </category></categories>
    #
    puts $enumOutKm "<categories>"
    foreach errStr [array names kmErr2catNm] {
	set nm   $kmErr2catNm($errStr)
	set desc $kmErr2catDesc($errStr)
	puts $enumOutKm "  <category><name>$nm</name><description>$desc</description></category>"
    }
    puts $enumOutKm "</categories>"

    # dump all items (after all cells and all categories have been defined up front)
    puts $enumOutKm "<items>"
    foreach {acell items} [array get kmCell2item] {
	foreach item $items {
	    puts $enumOutKm $item
	}
    }
    puts $enumOutKm "</items>"

    # footer example .lyrdb klayout Marker file
    # </report-database>
    puts $enumOutKm {</report-database>}
    close $enumOutKm
}
# todo: implement super-pareto, ranked table of SUM of all DRC errs/counts from ALL cells.
# (It still would not reflect as-if-flat hierarchical expansion due to repetition of instances).

set nbrErr ;# return value
} ;# end main

# non-zero exit-status on errors, either if thrown by main, or counted and returned by main
set nbrErr 0
if {[catch {set nbrErr [main $argv]} msg]} {
    puts stderr $msg
    set nbrErr 1
} elseif {$nbrErr > 0} {
    puts "ERROR: ${::Prog}: script terminated with errors reported above."
}
exit $nbrErr

# for emacs syntax-mode:
# Local Variables:
# mode:tcl
# End: