diff --git a/perlblast b/perlblast
new file mode 100644
index 0000000..f3792d0
--- /dev/null
+++ b/perlblast
@@ -0,0 +1,3002 @@
+#!/usr/bin/perl
+#-w
+
+ use Tk;
+ use Tk::Listbox;
+ use Tk::LabEntry;
+ use Tk::Optionmenu;
+ use Getopt::Std;
+
+ use POSIX qw( strftime );
+ use enum qw(UNKNOWN GAL16V8 GAL18V10 GAL20V8 GAL20RA10 GAL20XV10 GAL22V10 GAL26CV12 GAL6001 GAL6002 ATF16V8B ATF22V10B ATF22V10C);
+ use enum qw(FALSE TRUE); # boolean
+ use enum qw(NONE READGAL READPES VERIFYGAL SCLKTEST WRITEGAL ERASEGAL ERASEALL BURNSECURITY CHECKPES WRITEPES VPPTEST TESTGAL); # actions
+ use enum qw(ISNONE MSG_OK MSG_ALERT MSG_WARNING MSG_ASSURE); # msg types
+ use enum qw(OFF ON); # signals, levels
+
+ use Device::ParallelPort;
+ use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep clock_gettime clock_getres clock_nanosleep clock stat lstat );
+#####################################################################################################################
+#
+# perlblast, a GAL programming utility written in Perl. By C.Schoenmakers Copyright (C) 2018
+#
+# This version uses (/dev/)parport? access to the programming hardware, thsi way you _can_ use even
+# usb<->parallel dongles but that may require some edit of drivers/usb/misc/uss720.c in your Linux source tree to
+# add the usb id (mmmm:dddd) to the table near the bottom of the uss720.c file, like
+# Bus 001 Device 033: ID 0711:0302 Magic Control Technology Corp. Parallel Port
+# in my case.
+#
+# This is a Perl-Tk implementation of GAL programming software
+# based on various work from other people
+# GALBLAST: by Manfred Winterhoff
+# atblast: http://www.bhabbott.net.nz/atfblast.html up to 2017-11-19 V0.31
+#
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+#
+#####################################################################################################################
+#
+# see also the README
+#
+# usage: perlblast [<-p port# >]
+#
+# default port is (/dev/)parport0 higher numbers are possibe
+#
+# example: perlblast -p4 uses (/dev/)parport4
+#
+#
+
+
+$geometry = "600x800";
+my %options=();
+
+$ThisVersion = "Rev: 0.4 2018-10-22 C.S.";
+
+# parport control bits
+$STROBE = 1; # 1, invert
+$LNFEED = 2; # 14, invert
+$INIT = 4; # 16
+$SELCTP = 8; # 17, invert
+# status
+$ERROR = 8; # 15
+$SELECT = 16; # 13
+$PAPOUT = 32; # 12
+$ACK = 64; # 10
+$BUSY = 128; # 11, invert
+
+# SET initial port
+$portnum = 0; # 0=parport0, 1=parport1, 2=parport2 etc
+
+### manufacturer ID
+$LATTICE = 0xA1;
+$NATIONAL = 0x8F;
+$SGSTHOMSON = 0x20;
+
+###################################################################################################################
+#
+# GAL information
+#
+###################################################################################################################
+# type,id0|id1,name,fuses,pins,rows,bits,uesrow,uesfuse,uesbytes,eraserow,eraseallrow,pesrow,pesbytes,cfgrow,config,vpp,progtime,erasetime
+# | | | | | | | | | | | | | | | | | | | |
+# | | | | | | | | | | | | | | | | | | | |
+# | | | | | | | | | | | | | | | | | | | |
+# | | | | | | | | | | | | | | +---+ | | | | |
+# | | | | | | | | | | | | | +------+ | | | | | |
+# | | | | | | | | | | | | +-----------+ | | | | | | |
+# | | | | | | | | | | | +------------------+ | | | | | | | |
+# | | | | | | | | | | +-----------------------+ | | | | ++ | ++ | |
+# | | | | | | | | | *---------------------------+ | | | | | | | | | |
+# | | | | | | | | +-----------------------------+ | | | | | | | | | | +---+
+# | | | | | | | +-------------------------------+ | | | | | | | | | | | |
+# | | | | | | +-------------------------------+ | | | | | | | | | | | | |
+# | | | | | +--------------------------------+ | | | | | | | | | | | | | |
+# | | | | +---------------------------------+ | | | | | | | | | | | | | | |
+# | | | +--------------------------+ | | | | | | | | | | | | | | | |
+# | | +-----------------------+ | | | | | | | | | | | | | | | | |
+# | +---------------------+ | | | | | | | | | | | | | | | | | |
+# +-----------------v v v v v v v v v v v v v v v v v v v v
+#
+%galinfo = (0 => [UNKNOWN, 0x00, 0x00, "unknown" , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, cfgnone , 00, 000, 000],
+ 1 => [GAL16V8, 0x00, 0x1A, "GAL16V8" , 2194, 20, 32, 64, 32, 2056, 8, 63, 54, 58, 8, 60, cfg16V8, 63, 100, 100],
+ 2 => [GAL18V10, 0x50, 0x51, "GAL18V10" , 3540, 20, 36, 96, 36, 3476, 8, 61, 60, 58, 10, 16, cfg18V10, 00, 000, 000],
+ 3 => [GAL20V8, 0x20, 0x3A, "GAL20V8" , 2706, 24, 40, 64, 40, 2568, 8, 63, 59, 58, 8, 60, cfg20V8AB, 63, 100, 100],
+ 4 => [GAL20RA10, 0x60, 0x61, "GAL20RA10", 3274, 24, 40, 80, 40, 3210, 8, 61, 60, 58, 10, 16, cfg20RA10, 00, 000, 000],
+ 5 => [GAL20XV10, 0x65, 0x66, "GAL20XV10", 1671, 24, 40, 40, 44, 1631, 5, 61, 60, 58, 5, 16 ,cfg20XV10, 00, 000, 000], #/* 4,5,6,29,36,37 macht was,38,44,46,52 CLEARALL,53 macht was,60 CLEARALL */
+ 6 => [GAL22V10, 0x48, 0x49, "GAL22V10" , 5892, 24, 44, 132, 44, 5828, 8, 61, 60, 58, 10, 16, cfg22V10 , 00, 000, 000],
+ 7 => [GAL26CV12, 0x58, 0x59, "GAL26CV12", 6432, 28, 52, 122, 52, 6368, 8, 61, 60, 58, 12, 16, cfg26CV12, 00, 000, 000],
+ 8 => [GAL6001, 0x40, 0x41, "GAL6001" , 8294, 24, 78, 75, 97, 8222, 9, 63, 62, 96, 8, 8, cfg6001, 00, 000, 000],
+ 9 => [GAL6002, 0x44, 0x44, "GAL6002" , 8330, 24, 78, 75, 97, 8258, 9, 63, 62, 96, 8, 8, cfg6002, 00, 000, 000],
+ 10 => [ATF16V8B, 0x00, 0x00," ATF16V8B" , 2194, 20, 32, 64, 32, 2056, 8, 63, 54, 58, 8, 60, cfg16V8AB, 48, 10, 100],
+ 11 => [ATF22V10B, 0x00, 0x00," ATF22V10B", 5892, 24, 44, 132, 44, 5828, 8, 61, 60, 58, 10, 16, cfg22V10 , 48, 10, 100],
+ 12 => [ATF22V10C, 0x00, 0x00," ATF22V10C", 5892, 24, 44, 132, 44, 5828, 8, 61, 60, 58, 10, 16, cfg22V10 , 48, 10, 100],
+);
+
+@cfgnone = ();
+
+@cfg16V8 = (
+ 2128,2129,2130,2131,2132,2133,2134,2135,2136,2137,2138,2139,2140,2141,2142,2143,
+ 2144,2145,2146,2147,2148,2149,2150,2151,2152,2153,2154,2155,2156,2157,2158,2159,
+ 2048,2049,2050,2051,2193,2120,2121,2122,2123,2124,2125,2126,2127,2192,2052,2053,
+ 2054,2055,2160,2161,2162,2163,2164,2165,2166,2167,2168,2169,2170,2171,2172,2173,
+ 2174,2175,2176,2177,2178,2179,2180,2181,2182,2183,2184,2185,2186,2187,2188,2189,
+ 2190,2191
+);
+
+@cfg16V8AB = (
+ 2048,2049,2050,2051,2193,2120,2121,2122,2123,2128,2129,2130,2131,2132,2133,2134,
+ 2135,2136,2137,2138,2139,2140,2141,2142,2143,2144,2145,2146,2147,2148,2149,2150,
+ 2151,2152,2153,2154,2155,2156,2157,2158,2159,2160,2161,2162,2163,2164,2165,2166,
+ 2167,2168,2169,2170,2171,2172,2173,2174,2175,2176,2177,2178,2179,2180,2181,2182,
+ 2183,2184,2185,2186,2187,2188,2189,2190,2191,2124,2125,2126,2127,2192,2052,2053,
+ 2054,2055
+);
+
+@cfg18V10 = (
+ 3457,3456,3459,3458,3461,3460,3463,3462,3465,2464,3467,3466,3469,3468,3471,3470,3473,3472,3475,3474
+);
+
+@cfg20V8 = (
+ 2640,2641,2642,2643,2644,2645,2646,2647,2648,2649,2650,2651,2652,2653,2654,2655,
+ 2656,2657,2658,2659,2660,2661,2662,2663,2664,2665,2666,2667,2668,2669,2670,2671,
+ 2560,2561,2562,2563,2705,2632,2633,2634,2635,2636,2637,2638,2639,2704,2564,2565,
+ 2566,2567,2672,2673,2674,2675,2676,2677,2678,2679,2680,2681,2682,2683,2684,2685,
+ 2686,2687,2688,2689,2690,2691,2692,2693,2694,2695,2696,2697,2698,2699,2700,2701,
+ 2702,2703
+);
+
+@cfg20V8AB = (
+ 2560,2561,2562,2563,2705,2632,2633,2634,2635,2640,2641,2642,2643,2644,2645,2646,
+ 2647,2648,2649,2650,2651,2652,2653,2654,2655,2656,2657,2658,2659,2660,2661,2662,
+ 2663,2664,2665,2666,2667,2668,2669,2670,2671,2672,2673,2674,2675,2676,2677,2678,
+ 2679,2680,2681,2682,2683,2684,2685,2686,2687,2688,2689,2690,2691,2692,2693,2694,
+ 2695,2696,2697,2698,2699,2700,2701,2702,2703,2636,2637,2638,2639,2704,2564,2565,
+ 2566,2567
+);
+
+@cfg20RA10 = (
+ 3200,3201,3202,3203,3204,3205,3206,3207,3208,3209
+);
+
+@cfg20XV10 = (
+ 1630,1628,1629,1620,1621,1622,1610,1611,1612,1613,1614,1600,1601,1602,1603,1604,
+ 1627,1626,1623,1624,1625,1619,1618,1617,1616,1615,1609,1608,1607,1606,1605
+);
+
+@cfg22V10 = (
+ 5809,5808,5811,5810,5813,5812,5815,5814,5817,5816,5819,5818,5821,5820,5823,5822,
+ 5825,5824,5827,5826
+);
+
+@cfg26CV12 = (
+ 6345,6344,6347,6346,6349,6348,6351,6350,6353,6352,6355,6354,6357,6356,6359,6358,
+ 6361,6360,6363,6362,6365,6364,6367,6366
+);
+
+@cfg6001 = (
+ 8221,8220,8179,8183,8187,8191,8195,8199,8203,8207,8211,8215,8214,8210,8206,8202,
+ 8198,8194,8190,8186,8182,8178,8216,8217,8212,8213,8208,8209,8204,8205,8200,8201,
+ 8196,8197,8192,8193,8188,8189,8184,8185,8180,8181,8156,8159,8162,8165,8168,8171,
+ 8174,8177,8154,8157,8160,8163,8166,8169,8172,8175,8176,8173,8170,8167,8164,8161,
+ 8158,8155,8218,8219
+);
+
+@cfg6002 = (
+ 8257,8256,8179,8183,8187,8191,8195,8199,8203,8207,8211,8215,8214,8210,8206,8202,
+ 8198,8194,8190,8186,8182,8178,8216,8217,8212,8213,8208,8209,8204,8205,8200,8201,
+ 8196,8197,8192,8193,8188,8189,8184,8185,8180,8181,8255,8254,8253,8252,8251,8250,
+ 8249,8248,8247,8246,8245,8244,8243,8242,8241,8240,8239,8238,8220,8221,8222,8223,
+ 8224,8225,8226,8227,8228,8229,8230,8231,8232,8233,8234,8235,8236,8237,8156,8159,
+ 8162,8165,8168,8171,8174,8177,8154,8157,8160,8163,8166,8169,8172,8175,8176,8173,
+ 8170,8167,8164,8161,8158,8155,8218,8219
+);
+
+###################################################################################################################
+my @fuses; # DUT fuses
+my @ffuses; # file fuses
+my @pes = (0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF);
+my $vpp = 0;
+my $erasetime = 0;
+my $progtime = 0;
+my $read12v = 48; # 12V
+my $galvcc = 5.0;
+
+# hardware register copies
+my $ls273shadow = 0;
+my $dacvalueshadow = 0;
+
+my $portname = "";
+my $portid = 'auto:0';
+my $portopen = -1;
+
+#================================================================================================
+#
+# create main window
+#
+#================================================================================================
+my $mw = MainWindow->new(-title => "PerlBlast", -relief => 'raised', -borderwidth => 5, -background => 'darkgrey');
+ $mw->geometry($geometry);
+ $mw->protocol('WM_DELETE_WINDOW' => \&MyExit); # called when window is closed
+
+# create window top drop down menu's
+ $mw->configure(-menu => my $menubar = $mw->Menu);
+ my $file = $menubar->cascade(-label => '~File');
+ my $galm = $menubar->cascade(-label => '~GAL');
+ my $typm = $menubar->cascade(-label => '~Type');
+ my $help = $menubar->cascade(-label => '~Help');
+#
+ $file->command(
+ -label => 'Open JEDEC',
+ -accelerator => 'Ctrl-o',
+ -underline => 0,
+ -command => \&OpenJedec,
+ );
+ $file->separator;
+ $file->command(
+ -label => 'Save JEDEC',
+ -accelerator => 'Ctrl-s',
+ -underline => 0,
+ -command => \&SaveJedec,
+ );
+ $file->separator;
+ $file->command(
+ -label => "Exit Program",
+ -accelerator => 'Ctrl-q',
+ -underline => 0,
+ -command => \&MyExit,
+ );
+#
+ $galm->command(
+ -label => 'Read GAL',
+ -command => \&ReadGal,
+ );
+ $galm->command(
+ -label => 'Write GAL',
+ -command => \&WriteGal,
+ );
+
+#
+ $help->command(-label => 'Version', -command => \&PrintVersion); ###sub {print "Version\n"});
+ $help->separator;
+ $help->command(-label => 'About', -command => \&PrintAbout); ###sub {print "$ThisVersion\n"});
+#
+# create frame to position the selections and buttons
+#
+ $tp = $mw->Frame (
+ -height => 90,
+ )->pack(-side => 'top', -fill => 'x');
+# show port, fixed for now
+ $tp->LabEntry (
+ -label => 'Port:',
+ -labelPack => [-side => 'left', -anchor => 'w'],
+ -textvariable => \$portname,
+ -font => ['courier', '12', 'bold'],
+ -width => 10,
+ -relief => 'sunken',
+ )->place(-x => 0, -y => 0);
+# show device Type: text
+ $tp->Label (
+ -text => 'Type:',
+ )->place(-x => 150, -y => 2);
+#
+# create a drop down menu
+ my $opt = $tp->Optionmenu(
+ -options => [
+ [UNKNOWN => 0], [GAL16V8=>1], [GAL18V10=>2], [GAL20V8=>3], [GAL20RA10=>4],[GAL20XV10=>5],[GAL22V10=>6],
+ [GAL26CV12=>7],[GAL6001=>8],[GAL6002=>9],[ATF16V8B=>10],[ATF22V10B=>11],[ATF22V10C=>12]
+ ],
+ -command => sub { \&SetGalParms(shift) },
+ -variable => \$galtype,
+ -textvariable => \$galname,
+ -width => 10,
+ )->place(-x => 210, -y => 0);
+#
+ $wp= $tp->Button (
+ -text => "Write PES",
+ -width => 10,
+ -command => \&WritePes,
+ )->place(-x => 330, -y => 0);
+#
+ $lj = $tp->Button (
+ -text => "Load JEDEC",
+ -width => 10,
+ -command => \&OpenJedec,
+ )->place(-x => 0, -y => 30);
+#
+ $rg = $tp->Button (
+ -text => "Read GAL",
+ -width => 10,
+ -command => \&ReadGal,
+ )->place(-x => 110, -y => 30);
+#
+ $vg = $tp->Button (
+ -text => "Verify GAL",
+ -width => 10,
+ -command => \&VerifyGal,
+ )->place( -x => 220, -y => 30);
+#
+ $se = $tp->Button (
+ -text => "SECURITY",
+ -width => 10,
+ -command => \&BurnSecurity,
+ )->place(-x => 330, -y => 30);
+#
+ $sj = $tp->Button (
+ -text => "Save JEDEC",
+ -width => 10,
+ -command => \&SaveJedec,
+ )->place( -x => 0, -y => 60);
+#
+ $wg = $tp->Button (
+ -text => "Write GAL",
+ -width => 10,
+ -command => \&WriteGal,
+ )->place(-x => 110, -y => 60);
+#
+ $eg = $tp->Button (
+ -text => "Erase GAL",
+ -width => 10,
+ -command => \&EraseGal,
+ )->place(-x => 220, -y => 60);
+#
+ $ea = $tp->Button (
+ -text => "Erase ALL",
+ -width => 10,
+ -command => \&EraseAll,
+ )->place(-x => 330, -y => 60);
+#
+# listbox for jedec file data
+#
+ $blg = $mw->Scrolled ('Listbox',
+ -scrollbars => 'se',
+ -width => 580,
+ -height => 780,
+ )-> pack(-side => 'bottom');
+
+#================================================================================================
+#
+# end of GUI definitions
+#
+# program runs through this too
+#
+#================================================================================================
+####################################################################################################
+#
+# parse command line args
+#
+####################################################################################################
+ getopts("p:", \%options);
+
+ if (defined $options{p})
+ {
+ $portnum = $options{p};
+ }
+
+ &InitAll; # put interface and variables in decent state
+
+ if (-c "/dev/".$portname)
+ {
+ if ($portname ne "")
+ {
+ ($portopen = $parport = Device::ParallelPort->new($portid)) || die "Can't open the choosen port $portname!\n";
+ }
+ }
+ else
+ {
+ printf "perlblast: device $portname does not exist!\n";
+ exit (-1); # does not return
+ }
+
+ &HardwareInit; # setup programming hardware to a known state
+
+ MainLoop();
+
+#================================================================================================
+#
+# here we start all functions
+#
+#================================================================================================
+
+# read all settings for this kind of GAL
+# and SET all the variables to the correct name
+sub SetGalParms
+{
+# type,id0|id1,name,fuses,pins,rows,bits,uesrow,uesfuse,uesbytes,eraserow,eraseallrow,pesrow,pesbytes,cfgrow,config,vpp,progtime,erasetime
+ @gal_setting = @{$galinfo{$_[0]}}; # return array
+ s{^\s+|\s+$}{}g foreach @gal_setting;
+
+ ($galtype,$galid0,$galid1,$galname,$galfuses,$galpins,$galrows,$galbits,$galuesrow,$galuesfuse,$galuesbytes,$galeraserow,$galeraseallrow,
+ $galpesrow,$galpesbytes,$galcfgrow,$galconfig,$galvpp,$galprogtime,$galerasetime) = @gal_setting; # split up array
+}
+
+#################################################################################################
+#
+# disable all buttons for now
+#
+#################################################################################################
+sub KeysOff
+{
+ $wp->configure(-state => 'disabled');
+ $lj->configure(-state => 'disabled');
+ $rg->configure(-state => 'disabled');
+ $vg->configure(-state => 'disabled');
+ $se->configure(-state => 'disabled');
+ $sj->configure(-state => 'disabled');
+ $wg->configure(-state => 'disabled');
+ $eg->configure(-state => 'disabled');
+ $ea->configure(-state => 'disabled');
+ $opt->configure(-state => 'disabled');
+}
+
+#################################################################################################
+#
+# re-enable the buttons
+#
+#################################################################################################
+sub KeysOn
+{
+ $wp->configure(-state => 'normal');
+ $lj->configure(-state => 'normal');
+ $rg->configure(-state => 'normal');
+ $vg->configure(-state => 'normal');
+ $se->configure(-state => 'normal');
+ $sj->configure(-state => 'normal');
+ $wg->configure(-state => 'normal');
+ $eg->configure(-state => 'normal');
+ $ea->configure(-state => 'normal');
+ $opt->configure(-state => 'normal');
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub ToListBox
+{
+ my $string = $_[0];
+ $blg->insert('end', $string);
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub ClrListBox
+{
+ $blg->delete(0, 'end');
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetSetup
+{
+
+ if ($portname eq "")
+ {
+ &DialogHandler(MSG_ALERT, "Can't open the given parport", 0);
+ return FALSE;
+ }
+
+ if ($galtype == UNKNOWN)
+ {
+ &DialogHandler(MSG_ALERT, "Select a GAL first", 0);
+ return FALSE;
+ }
+ return TRUE;
+}
+
+#################################################################################################
+#
+# Load the JEDEC file
+#
+#################################################################################################
+sub OpenJedec
+{
+ &LoadFile;
+}
+
+#################################################################################################
+#
+# Save a JEDEC file
+#
+#################################################################################################
+sub SaveJedec
+{
+ &SaveFile;
+}
+
+#################################################################################################
+#
+# Read GAL info from DUT
+#
+#################################################################################################
+sub ReadGal
+{
+ if (&TestProperGAL == FALSE)
+ {
+ return;
+ }
+ @fuses = &ReadGAL();
+ &FormatJEDEC;
+}
+
+#################################################################################################
+#
+# Write fusebuffer to DUT
+#
+#################################################################################################
+sub WriteGal
+{
+ if ($#fuses < 1)
+ {
+ &DialogHandler(MSG_ALERT, "Load a JEDEC fuse map first", 0);
+ return;
+ }
+ if (!&CheckJEDEC(@fuses))
+ {
+ RETURN true;
+ }
+ if (!&TestProperGAL)
+ {
+ return TRUE;
+ }
+ &WriteGAL(\@fuses);
+
+}
+
+#################################################################################################
+#
+# Erase the DUT normal fuses
+#
+#################################################################################################
+sub EraseGal
+{
+ &EraseGAL;
+}
+
+#################################################################################################
+#
+# Erase EVERYTHING from the DUT
+#
+#################################################################################################
+sub EraseAll
+{
+ &EraseALL;
+}
+
+#################################################################################################
+#
+# Write the PES bytes to the DUT
+#
+#################################################################################################
+sub WritePes
+{
+
+ $vpp = $galvpp;
+ $progtime = $galprogtime;
+ $erasetime = $galerasetime;
+
+ if (&GetSetup == FALSE)
+ {
+# return FALSE;
+ }
+ if (&DialogHandler(MSG_ASSURE, "WritePES", CHECKPES) == TRUE)
+ {
+ &WritePES;
+ }
+}
+
+#################################################################################################
+#
+# program the security fuse
+#
+#################################################################################################
+sub BurnSecurity
+{
+
+
+}
+
+#################################################################################################
+#
+# Verify the DUT with the fuse buffer
+#
+#################################################################################################
+sub VerifyGal
+{
+ if ($#fuses < 1)
+ {
+ &DialogHandler(MSG_ALERT, "Load a JEDEC fuse map first", 0);
+ return;
+ }
+ &VerifyGAL;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetPort
+{
+
+ $portid = sprintf "auto:%1d", $portnum;
+ $portname = sprintf "parport%1d", $portnum;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub PrintAbout
+{
+ &DialogHandler(MSG_ALERT, "PerlBlast. An in Perl-Tk written version of GalBlast/ATFBlast", 0);
+
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub PrintVersion
+{
+ &DialogHandler(MSG_ALERT, "$ThisVersion", 0);
+}
+
+#================================================================================================
+#
+# here the real action is done
+#
+#================================================================================================
+sub ReadGAL
+{
+ my @rfuses;
+ my $bit;
+ my $row;
+
+ if (&TurnOn(READGAL))
+ {
+ if(($galtype == GAL16V8) || ($galtype == GAL20V8))
+ {
+ # read fuse rows
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ &StrobeRow($row);
+ for ($bit = 0; $bit < $galbits; $bit++)
+ {
+ $rfuses[$galrows * $bit + $row] = &ReceiveBit;
+ }
+ }
+ # read UES
+ &StrobeRow($galuesrow);
+ for ($bit = 0; $bit < $galuesbytes * 8; $bit++)
+ {
+ $rfuses[$galuesfuse + $bit] = &ReceiveBit;
+ }
+ # read CFG
+ &StrobeRow($galcfgrow);
+ for ($bit = 0; $bit < $#{$galconfig}+1 ; $bit++)
+ {
+ if ($pes[2] == 0x1A)
+ {
+ $rfuses[$cfg16V8AB[$bit]] = &ReceiveBit;
+ }
+ elsif ($pes[2] == 0x20)
+ {
+ $rfuses[$cfg20V8[$bit]] = &ReceiveBit;
+ }
+ elsif ($pes[2] == 0x3A)
+ {
+ $rfuses[$cfg20V8AB[$bit]] = &ReceiveBit;
+ }
+ else
+ {
+ # pes[2] = 0 or pes[2] is invalid
+ $rfuses[$cfg16V8[$bit]] = &ReceiveBit;
+ }
+ }
+ }
+ elsif (($galtype == GAL6001) || ($galtype == GAL6002))
+ {
+ for ($row = 0; $row < 78; $row++)
+ {
+ &StrobeRow($row);
+ &DiscardBits(20);
+ for ($bit = 0; $bit < 11 ; $bit++)
+ {
+ $rfuses[7296 + 78 * $bit + $row] = &ReceiveBit;
+ }
+ for ($bit = 0; $bit < 64 ; $bit++)
+ {
+ $rfuses[114 * $bit + $row] = &ReceiveBit;
+ }
+ &DiscardBits(24);
+ }
+ for ($row = 0; $row < 64; $row++)
+ {
+ &SendBits(31, 0);
+ for ($bit = 0 ; $bit < 64; $bit++)
+ {
+ &SendBit($bit != $row);
+ }
+ &SendBits(24, 0);
+ &SetSDIN(OFF); #?
+ &Strobe(2);
+ for ($bit = 0; $bit < 20; $bit++)
+ {
+ $rfuses[78 + 114 * $row + $bit] = &ReceiveBit;
+ }
+ &DiscardBits(83);
+ for ($bit = 0; $bit < 16; $bit++)
+ {
+ $rfuses[98 + 114 * $row + $bit] = &ReceiveBit;
+ }
+ }
+ # read UES
+ &StrobeRow($galuesrow);
+ &DiscardBits(20);
+ for ($bit = 0; $bit < 72; $bit++)
+ {
+ $rfuses[$galuesbits + $bit] = &ReceiveBit;
+ }
+ # read CFG
+ &SetRow($galcfgrow);
+ &Strobe(2);
+ for ($bit = 0; $bit < $#{$galconfig}+1; $bit++)
+ {
+ $rfuses[@{$galconfig}[$bit]] = &ReceiveBit;
+ }
+ }
+ elsif ($galtype == ATF16V8B)
+ {
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ &StrobeRow($row);
+ for ($bit = 0; $ bit < $galbits; $bit++)
+ {
+ $rfuses[$galrows * $bit + $row] = &ReceiveBit;
+ }
+ }
+ # read UES STF16V8
+ &StrobeRow($galuesrow);
+ for ($bit = 0; $bit < $galuesbytes * 8; $bit++)
+ {
+ $rfuses[$galuesfuse + $bit] = &ReceiveBit;
+ }
+ # read CFG ATF16V8
+ &StrobeRow($galcfgrow);
+ for ($bit = 0; $bit < $#{$galconfig} + 1; $bit++)
+ {
+ $rfuses[@{$galconfig}[$bit]] = &ReceiveBit;
+ }
+ }
+ elsif (($galtype == GAL22V10) || ($galtype == ATF22V10B) || ($galtype == ATF22V10C))
+ {
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ &StrobeRow($row);
+ for ($bit = 0; $bit < $galbits; $bit++)
+ {
+ $rfuses[$galrows * $bit + $row] = &ReceiveBit;
+ }
+ &Delay(1);
+ }
+ # read UES
+ &StrobeRow($galuesrow);
+ if ($galtype != GAL22V10)
+ {
+ &DiscardBits(68); # ATF22V10X
+ }
+ for ($bit = 0; $bit < ($galuesbytes * 8); $bit++)
+ {
+ $rfuses[$galuesbits + $bit] = &ReceiveBit;
+ }
+ &Delay(1);
+ # read CFG
+ &SetRow($galcfgrow);
+ for ($bit = 0; $bit < $#{$galconfig}+1; $bit++)
+ {
+ $rfuses[@{$galconfig}[$bit]] = &ReceiveBit;
+ }
+ }
+ &GetPES;
+ &TurnOff;
+ }
+ return @rfuses;
+}
+
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub VerifyGAL
+{
+ my @vfuses = @fuses; # filled by CheckJEDEC
+ my @rfuses;
+ my $i;
+
+ if (!&TestProperGAL)
+ {
+ return TRUE;
+ }
+ @rfuses = &ReadGAL;
+
+ if ($#vfuses != $#rfuses)
+ {
+ &DialogHandler(MSG_ALERT,"Fusemap mismatch!", 0);
+ return TRUE;
+ }
+ for ($i = 0; $i < $#rfuses; $i++)
+ {
+ if ($rfuses[$i] != $vfuses[$i])
+ {
+ &DialogHandler(MSG_ALERT,"Fusemap mismatch!", 0);
+ return TRUE;
+ }
+ }
+ &DialogHandler(MSG_ALERT,"Fusemap correct match", 0);
+ return TRUE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub ReadPES
+{
+ &TurnOn(READPES);
+ &GetPES($_[0]);
+ &TurnOff;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetPES
+{
+ my $bitmask;
+ my $byte;
+
+ &StrobeRow($galpesrow);
+ if (($galtype == GAL6001) || ($galtype == GAL6002))
+ {
+ &DiscardBits(20);
+ }
+ for ($byte = 0; $byte < $galpesbytes; $byte++)
+ {
+ $pes[$byte] = 0;
+ for ($bitmask = 0x01; $bitmask <= 0x80; $bitmask <<= 1)
+ {
+ if (&ReceiveBit)
+ {
+ $pes[$byte] |= $bitmask;
+ }
+ }
+ }
+}
+
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub TestProperGAL
+{
+ my $type = 1;
+ my $galtypetmp = $galtype;
+
+ if (&GetSetup == FALSE)
+ {
+ return FALSE;
+ }
+ &ReadPES;
+#
+ if (($pes[7] eq 'F') && ($pes[5] eq '1') && ($pes[4] eq 'V') && ($pes[3] eq '1') && ($pes[2] eq '0'))
+ {
+ if ($pes[1] == 'B')
+ {
+ $galtype = ATF22V10B;
+ }
+ else
+ {
+ $galtype = ATF22V10C;
+ }
+ }
+ elsif (($pes[6] eq 'F') && ($pes[5] eq '1') && ($pes[4] eq '6') && ($pes[3] eq 'V') && ($pes[2] eq '8'))
+ {
+ $galtype = ATF16V8B;
+ }
+ elsif (($pes[2] != 0) && ($pes[2] != 0xFF))
+ {
+ for ($type = (keys %galinfo) - 1; $type; $type--)
+ {
+ &SetGalParms($type);
+ if (($pes[2] == $galid0) || ($pes[2] == $galid1))
+ {
+ goto TPG1;
+ }
+ }
+ }
+TPG1:
+#
+#
+#
+ if ($type == 0)
+ {
+ if (&DialogHandler(MSG_WARNING, "Unknown or illegal PES, continue?", 0) == FALSE)
+ {
+ $galtype = $galtypetmp;
+ return FALSE;
+ }
+ }
+ else
+ {
+ if ($type != $galtypetmp)
+ {
+ my $return = &DialogHandler(MSG_WARNING, "PES indicates a different GAL type than selected, Change to detected GAL type?", TESTGAL);
+ if ($return == FALSE)
+ {
+ return FALSE;
+ }
+ else
+ {
+ $galtype = $galtypetmp;
+ }
+ }
+ }
+ &ParsePES;
+ return TRUE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub ParsePES
+{
+ my $algo;
+ my @duration = (1,2,5,10,20,30,40,50,60,70,80,90,100,200,0,0);
+
+ $vpp = $galvpp;
+ $progtime = $galprogtime;
+ $erasetime = $galerasetime;
+
+ if (($galtype == ATF16V8B) || ($galtype == ATF22V10B) || ($galtype == ATF22V10C))
+ {
+ # already set all
+ return;
+ }
+ $algo = $pes[1] & 0x0F;
+ if ($algo == 5)
+ {
+ $erasetime = (25 << (($pes[4] >> 2) & 7))/ 2;
+ $progtime = @duration[((($pes[5] << 8) | $pes[4]) >> 5) & 0x0F];
+ $vpp = 2 *(($pes[5] >> 1) & 0x1F) + 20;
+ return;
+ }
+ else
+ {
+ if(($galtype == GAL16V8) || ($galtype == GAL20V8))
+ {
+ #
+ if ($algo == 0)
+ {
+ $vpp = 63; # 15.75V (3.75V dac)
+ return;
+ }
+ elsif ($algo == 1)
+ {
+ $vpp = 63;
+ $progtime = 80;
+ return;
+ }
+ elsif ($algo == 2)
+ {
+ $vpp = 66; # 16.5 V (4.5V dac)
+ $progtime = 10;
+ return;
+ }
+ elsif ($algo == 3)
+ {
+ $vpp = ($pes[3] == 0x8F) ? 60 : 58; # NATIONAL 15.0 or 14.5V
+ $progtime = 40;
+ return;
+ }
+ elsif ($algo == 4)
+ {
+ $vpp = 56; # 14V
+ return;
+ }
+ else
+ {
+ return;
+ }
+ }
+ else
+ {
+ $erasetime = ($pes[3] == 0x8F) ? 50 : 100; # NATIONAL
+ if ($algo == 0)
+ {
+ $vpp = 66; # 16.5V
+ $progtime = 10;
+ return;
+ }
+ elsif ($algo == 1)
+ {
+ $vpp = 63; # 15.75V
+ $progtime = 1000;
+ return;
+ }
+ elsif ($algo == 2)
+ {
+ $vpp = ($pes[3] == 0x8F) ? 60 : 58; # NATIONAL 15.0V or 14.5V
+ $progtime = 40;
+ return;
+ }
+ elsif ($algo == 3)
+ {
+ $vpp = 56; # 14V
+ $progtime = 100;
+ return;
+ }
+ }
+ }
+print "Fail: all prog settings reset!\n";
+ $erasetime = 0;
+ $progtime = 0;
+ $vpp = 0;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub WritePES
+{
+ my $byte;
+ my $bitmask;
+
+ if (&TurnOn(WRITEPES) == TRUE)
+ {
+ if(($galtype == GAL16V8) || ($galtype == GAL20V8) || ($galtype == ATF16V8B))
+ {
+ usleep(10);
+ &SetRow($galpesrow);
+ for ($byte = 0; $byte < $galpesbytes; $byte++)
+ {
+ for($bitmask = 0x01; $bitmask <= 0x80; $bitmask <<= 1)
+ {
+ &SendBit($pes[$byte] & $bitmask);
+ }
+ }
+ &SetSDIN(OFF);
+ usleep(10);
+ &Strobe($progtime);
+ usleep(10);
+ }
+ elsif (($galtype == GAL6001) || ($galtype == GAL6002))
+ {
+ &SetRow(0);
+ &SendBits( 20, 0);
+ for ($byte = 0; $byte < $galpesbytes; $byte++)
+ {
+ for ($bitmak = 0x01; $bitmsk <= 0x80; $bitmask <<= 1)
+ {
+ &SendBit($pes[$byte] & $bitmask);
+ }
+ }
+ if (($galpesbytes * 8) < $galbits)
+ {
+ &SendBits(($galbits - ($galpesbytes * 8)), 0);
+ }
+ &SendBit(ON);
+ &SendAddress(7, $galpesrow);
+ &SendBits(16, 0);
+ &SetSDIN(OFF);
+ }
+ elsif (($galtype == GAL22V10) || ($galtype == ATF22V10B) || ($galtype == ATF22V10C))
+ {
+ &SetRow(0);
+ for ($byte = 0; $byte < $galpesbytes; $byte++)
+ {
+ for ($bitmak = 0x01; $bitmsk <= 0x80; $bitmask <<= 1)
+ {
+ &SendBit($pes[$byte] & $bitmask);
+ }
+ }
+ if (($galpesbytes * 8) < $galbits)
+ {
+ &SendBits(($galbits - ($galpesbytes * 8)), 0);
+ }
+ &SetSDIN(OFF);
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF);
+ }
+ else
+ {
+ &SetRow(0);
+ usleep(10);
+ for ($byte = 0; $byte < $galpesbytes; $byte++)
+ {
+ for($bitmask = 0x01; $bitmask <= 0x80; $bitmask <<= 1)
+ {
+ SendBit($pes[$byte] & $bitmask);
+ }
+ }
+ &SetSDIN(OFF);
+ &SendAddress( 6, $galpesrow);
+ usleep(10);
+ &Strobe($progtime);
+ usleep(10);
+ }
+ &TurnOff;
+ }
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+# type,id0|id1,name,fuses,pins,rows,bits,uesrow,uesfuse,uesbytes,eraserow,eraseallrow,pesrow,pesbytes,cfgrow,config,cfgbits
+sub FormatJEDEC
+{
+ my $buffer;
+ my $fuseindex;
+ my $l;
+ my $bit;
+ my $bytes;
+ my $ch;
+
+ &ClrListBox;
+ &ToListBox(sprintf "JEDEC file for %s created on %s", $galname, strftime("%a %Y-%m-%d %k:%m:%S", localtime(time)));
+ &ToListBox(sprintf "*QP%d*QF%d*QV0*F0*G0*X0*", $galpins, $galfuses);
+
+ if (($galtype == GAL6001) || ($galtype == GAL6002))
+ {
+ for ($bit = $fuseindex = 0; $bit < $galbits; $bit++)
+ {
+ $buffer = sprintf "L%04d ", $fuseindex;
+ for ($bytes = 0; $bytes < 114; $bytes++)
+ {
+ $buffer .= sprintf "%s", ($fuses[$fuseindex++] == 1) ? '1' : '0';
+ }
+ $buffer .= "*";
+ &ToListBox($buffer);
+ }
+ for ($bit = 0; $bit < 11; $bit++)
+ {
+ $buffer = sprintf "L%04d ", $fuseindex;
+ for ($bytes = 0; $bytes < 78; $bytes++)
+ {
+ $buffer .= sprintf "%s", ($fuses[$fuseindex++] == 1) ? '1' : '0';
+ }
+ $buffer .= "*";
+ &ToListBox($buffer);
+ }
+ }
+ else
+ {
+# do FUSES
+ for ($bit = $fuseindex = 0; $bit < $galbits; $bit++)
+ {
+ $buffer = sprintf "L%04d ", $fuseindex;
+ for ($bytes = 0; $bytes < $galrows; $bytes++)
+ {
+ $buffer .= sprintf "%s", ($fuses[$fuseindex++] == 1) ? '1' : '0';
+ }
+ $buffer .= "*";
+ &ToListBox($buffer);
+ }
+ if ($fuseindex < $galuesfuse)
+ {
+ $buffer = sprintf "L%04d ", $fuseindex;
+ while ($fuseindex < $galuesfuse)
+ {
+ $buffer .= sprintf "%s", ($fuses[$fuseindex++] == 1) ? '1' : '0';
+ }
+ $buffer .= "*";
+ &ToListBox($buffer);
+ }
+# do UES
+ $buffer = sprintf "N UES";
+ for ($bytes = 0; $bytes < $galuesbytes; $bytes++)
+ {
+ $ch = 0;
+ for ($bit = 0; $bit < 8; $bit++)
+ {
+ if ($fuses[$fuseindex + (8 * $bytes) + $bit])
+ {
+ if ($galtype == ATF22V10C)
+ {
+ $ch |= (1 << (7 - $bit)); # BIG ENDIAN
+ }
+ else
+ {
+ $ch |= (1 << $bit); # LITTLE ENDIAN
+ }
+ }
+ }
+ $buffer .= sprintf " %02X", $ch;
+ }
+ $buffer .= "*";
+ &ToListBox($buffer);
+
+ $buffer = sprintf "L%04d ", $fuseindex;
+ for ($bytes = 0; $bytes < ($galuesbytes * 8); $bytes++) ##???
+ {
+ $buffer .= sprintf "%s", ($fuses[$fuseindex++] == 1) ? '1' : '0';
+ }
+ $buffer .= "*";
+ &ToListBox($buffer);
+# remainder
+ if ($fuseindex < $galfuses)
+ {
+ $buffer = sprintf "L%04d ", $fuseindex;
+ while ($fuseindex < $galfuses)
+ {
+ $buffer .= sprintf "%s", ($fuses[$fuseindex++] == 1) ? '1' : '0';
+ }
+ $buffer .= "*";
+ &ToListBox($buffer);
+ }
+# do PES
+ $buffer = sprintf "N PES";
+ for ($bit = 0; $bit < $galpesbytes; $bit++)
+ {
+ $buffer .= sprintf " %02X", $pes[$bit];
+ }
+ $buffer .= "*";
+ &ToListBox ($buffer);
+ &ToListBox ( sprintf "C%04X*", &CheckSum(\@fuses, $galfuses));
+ }
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub CheckJEDEC
+{
+ my $pos = &ParseFuseMap($_[0]);
+
+ if ($pos == length $_[0])
+ {
+ return TRUE;
+ }
+ &DialogHandler(MSG_ALERT, (sprintf "Error in JEDEC at position %d", $pos), 0);
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub ParseFuseMap
+{
+ my @fusebuf = split(/|/, $_[0]);
+ my $len = length $_[0];
+ my $i;
+ my $n;
+ my $type;
+ my $oldtype;
+ my $checksumpos = 0;
+ my $address;
+ my $pins = 0;
+ my $lastfuse = 0;
+ my $state = 0;
+ my $security = 0;
+ my $checksum = 0;
+ my $char;
+
+ for ($n = 0; $n < $len; $n++)
+ {
+ $char = $fusebuf[$n];
+ if ($char eq '*')
+ {
+ $state = 2;
+ }
+ else
+ {
+# pseudo switch
+ if ($state == 2)
+ {
+ if ($char ne ' ')
+ {
+ if ($char eq 'L')
+ {
+ $address = 0;
+ $state = 3;
+ }
+ elsif ($char eq 'F')
+ {
+ $state = 5;
+ }
+ elsif ($char eq 'Q')
+ {
+ $state = 7;
+ }
+ elsif ($char eq 'C')
+ {
+ $state = 14;
+ $checksumpos = $n;
+ goto BREAK;
+ }
+ else
+ {
+ $state = 1;
+ }
+ }
+ goto BREAK;
+ }
+ elsif ($state == 3)
+ {
+ if ($char =~ m/[^0-9]/)
+ {
+ return $n;
+ }
+ $address = $char - '0';
+ $state = 4;
+ goto BREAK;
+ }
+ elsif ($state == 4)
+ {
+ if ($char eq ' ')
+ {
+ $state = 6;
+ }
+ elsif ($char =~ m/[0-9]/)
+ {
+ $address = 10 * $address + ($char - '0');
+ }
+ else
+ {
+ return $n;
+ }
+ goto BREAK;
+ }
+ elsif ($state == 5)
+ {
+ if ($char eq ' ')
+ {
+ goto BREAK;
+ }
+ if (($char eq '0') || ($char eq '1'))
+ {
+ @fuses = {}; # empty fusemap
+ }
+ else
+ {
+ return $n;
+ }
+ $state = 1;
+ goto BREAK;
+ }
+ elsif ($state == 6)
+ {
+ if ($char eq ' ')
+ {
+ goto BREAK;
+ }
+ if (($char eq '0') || ($char eq '1'))
+ {
+ $fuses[$address++] = ($char - '0');
+ }
+ else
+ {
+ return $n;
+ }
+ goto BREAK;
+ }
+ elsif ($state == 7)
+ {
+ if ($char eq ' ')
+ {
+ goto BREAK;
+ }
+ if ($char eq 'P')
+ {
+ $pins = 0;
+ $state = 8;
+ }
+ elsif ($char eq 'F')
+ {
+ $lastfuse = 0;
+ $state = 9;
+ }
+ else
+ {
+ $state = 2;
+ }
+ goto BREAK;
+ }
+ elsif ($state == 8)
+ {
+ if ($char eq ' ')
+ {
+ goto BREAK;
+ }
+ if ($char =~ m/[^0-9]/)
+ {
+ return $n;
+ }
+ $pins = $char - '0';
+ $state = 10;
+ goto BREAK;
+ }
+ elsif ($state == 9)
+ {
+ if ($char eq ' ')
+ {
+ goto BREAK;
+ }
+ if ($char =~ m/[^0-9]/)
+ {
+ return $n;
+ }
+ $lastfuse = $char - '0';
+ $state = 11;
+ goto BREAK;
+ }
+ elsif ($state == 10)
+ {
+ if ($char =~ m/[0-9]/)
+ {
+ $pins = 10 * $pins + ($char - '0');
+ }
+ elsif ($char eq ' ')
+ {
+ $state = 12;
+ }
+ else
+ {
+ return $n;
+ }
+ goto BREAK;
+ }
+ elsif ($state == 11)
+ {
+ if ($char =~ m/[0-9]/)
+ {
+ $lastfuse = 10 * $lastfuse + ($char - '0');
+ }
+ elsif ($char eq ' ')
+ {
+ $state = 12;
+ }
+ else
+ {
+ return $n;
+ }
+ goto BREAK;
+ }
+ elsif ($state == 12)
+ {
+ if ($char ne ' ')
+ {
+ return $n;
+ }
+ goto BREAK;
+ }
+ elsif ($state == 13)
+ {
+ if ($char eq ' ')
+ {
+ goto BREAK;
+ }
+ if (($char eq '0') || ($char eq '1'))
+ {
+ $security = ($char - '0');
+ }
+ else
+ {
+ return $n;
+ }
+ $state = 1;
+ goto BREAK;
+ }
+ elsif ($state == 14)
+ {
+ if ($char eq ' ')
+ {
+ goto BREAK;
+ }
+ if ($char =~ m/[0-9]/)
+ {
+ $checksum = $char - '0';
+ }
+ elsif(((uc $char) gt 'A') && ((uc $char) le 'F'))
+ {
+ $checksum = ((uc $char) - 'A' + 10);
+ }
+ else
+ {
+ return $n;
+ }
+ $state = 15;
+ goto BREAK;
+
+ }
+ elsif ($state == 15)
+ {
+ if ($char =~ m/[0-9]/)
+ {
+ $checksum = 16 * $checksum + ($char - '0');
+ }
+ elsif(((uc $char) gt 'A') && ((uc $char) le 'F'))
+ {
+ $checksum = (16 * $checksum) + ((ord (uc $char) - 0x41) + 10);
+ }
+ elsif ($char eq ' ')
+ {
+ $state = 2;
+ }
+ else
+ {
+ return $n;
+ }
+ goto BREAK;
+ }
+BREAK:
+ }
+ }
+ if (($lastfuse) || ($pins))
+ {
+ if(($checksum) && ($checksum != &CheckSum(\@fuses, $lastfuse)))
+ {
+ if (&DialogHandler(MSG_WARNING, ("Checksum given %04X calculated %04X", $checksum, &CheckSum(\@fuses, $lastfuse)), 0) == FALSE)
+ {
+ return $checksumpos;
+ }
+ }
+ $type = 0;
+ $oldtype = $galtype;
+ for ($i = 1; $i < keys %galinfo; $i++)
+ {
+ &SetGalParms($i);
+ if ((($lastfuse == 0) || ($galfuses == $lastfuse) || (($galuesfuse == $lastfuse) && ($galuesfuse + 8 * $galuesbytes) == $galfuses))
+ && (($pins == 0) || ($galpins == $pins) || ($galpins == 24) && ($pins == 28)) )
+ {
+ if ($galtype == UNKNOWN)
+ {
+ $type = $i;
+ goto BREAK2;
+ }
+ elsif (!$type)
+ {
+ $type = $i;
+ goto BREAK2;
+ }
+ }
+ }
+BREAK2:
+ if ($oldtype != $type)
+ {
+ $galtype = $type;
+ &SetGalParms($type);
+ &DialogHandler(MSG_ALERT, "galtype has changed!! ", 0);
+ }
+ }
+ return $n;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+# Checksum(array, count) fuses
+sub CheckSum
+{
+ my @array = @{$_[0]};
+ my $count = $_[1];
+ my $sum = 0;
+ my $byte = 0;
+ my $mask = 1;
+
+ for ($i = 0; $i < $count; $i++)
+ {
+ if ($array[$i] == 1)
+ {
+ $byte |= $mask;
+ }
+ $mask = $mask << 1;
+ if ($mask > 255)
+ {
+ $sum += $byte;
+ $byte = 0;
+ $mask = 1;
+ }
+ }
+ return ($byte + $sum) & 0xFFFF;
+}
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub WriteGAL
+{
+ my @array = @{$_[0]};
+ my $row;
+ my $bit;
+
+ if (&TurnOn(WRITEGAL))
+ {
+ if(($galtype == GAL16V8) || ($galtype == GAL20V8))
+ {
+ # write fuse rows
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ &SetRow($row);
+ for ($bit = 0; $bit < $galbits; $bit++)
+ {
+ &SendBit ($array[$galrows * $bit + $row]);
+ }
+ &Strobe($progtime);
+ }
+ # write UES
+ &SetRow($galuesrow);
+ for ($bit = 0; $bit < $galuesbytes * 8; $bit++)
+ {
+ &SendBit( $array[$galuesfuse + $bit]);
+ }
+ &Strobe($progtime);
+ # write CFG
+ &SetRow($galcfgrow);
+ for ($bit = 0; $bit < $#{$galconfig}+1 ; $bit++)
+ {
+ if ($pes[2] == 0x1A)
+ {
+ &SendBit( $array[$cfg16V8AB[$bit]]);
+ }
+ elsif ($pes[2] == 0x20)
+ {
+ &SendBit( $array[$cfg20V8[$bit]]);
+ }
+ elsif ($pes[2] == 0x3A)
+ {
+ &SendBit( $array[$cfg20V8AB[$bit]]);
+ }
+ else
+ {
+ # pes[2] = 0 or pes[2] is invalid
+ &SendBit($array[$cfg16V8[$bit]]);
+ }
+ }
+ &Strobe($progtime);
+ }
+ elsif (($galtype == GAL6001) || ($galtype == GAL6002))
+ {
+ &SetRow(0);
+ for ($row = 0; $row < 78; $row++)
+ {
+ &SendBits(20, 0);
+ for ($bit = 0; $bit < 11 ; $bit++)
+ {
+ &SendBit( $array[7296 + 78 * $bit + $row] );
+ }
+ for ($bit = 0; $bit < 64 ; $bit++)
+ {
+ &SendBit( $array[114 * $bit + $row]);
+ }
+ &SendBit(1);
+ &SendAddress(7, $row);
+ &SendBits(16, 0);
+ &SetSDIN(OFF);
+ &Strobe($progtime);
+ }
+ for ($row = 0; $row < 64; $row++)
+ {
+ for ($bit = 0; $bit < 20; $bit++)
+ {
+ &SendBit ($array[78 + 114 * $row + $bit]);
+ }
+ &DiscardBits(83);
+ for ($bit = 0; $bit < 16; $bit++)
+ {
+ &SendBit ($array[98 + 114 * $row + $bit]);
+ }
+ }
+ # write UES
+ &SetRow($galuesrow);
+ &DiscardBits(20);
+ for ($bit = 0; $bit < 72; $bit++)
+ {
+ &SendBit ($array[$galuesbits + $bit]);
+ }
+ # write CFG
+ &SetRow($galcfgrow);
+ &Strobe(2);
+ for ($bit = 0; $bit < $#{$galconfig}+1; $bit++)
+ {
+ &SendBit ($array[@{$galconfig}[$bit]]);
+ }
+ }
+ elsif ($galtype == ATF16V8B)
+ {
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ &SetRow($row);
+ for ($bit = 0; $ bit < $galbits; $bit++)
+ {
+ &SendBit( $array[$galrows * $bit + $row]);
+ }
+ &Strobe($progtime);
+ }
+ # write UES STF16V8
+ &SetRow($galuesrow);
+ for ($bit = 0; $bit < $galuesbytes * 8; $bit++)
+ {
+ &SendBit( $array[$galuesfuse + $bit]);
+ }
+ &Strobe($progtime);
+ # write CFG ATF16V8
+ &SetRow($galcfgrow);
+ for ($bit = 0; $bit < $#{$galconfig} + 1; $bit++)
+ {
+ &SendBit( $array[@{$galconfig}[$bit]]);
+ }
+ &Strobe($progtime);
+ }
+ elsif (($galtype == GAL22V10) || ($galtype == ATF22V10B))
+ {
+ &SetRow(0); # RA0...RA5 low
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ for ($bit = 0; $bit < $galbits; $bit++)
+ {
+ &SendBit ($array[$galrows * $bit + $row]);
+ }
+ &SendAddress(6, $row);
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF);
+ }
+ # write UES
+ if ($galtype == ATF22V10B)
+ {
+ &SendBits(68, 1);
+ for ($bit = 0; $bit < ($galuesbytes * 8) ; $bit++)
+ {
+ &SendBit( $array[$galuesfuse + $bit]);
+ }
+ }
+ else
+ {
+ for ($bit = 0; $bit < ($galuesbytes * 8) ; $bit++)
+ {
+ &SendBit( $array[$galuesfuse + $bit]);
+ }
+ &SendBits(68, 0);
+ }
+ &SendAddress(6, $galuesrow);
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF);
+ # write CFG
+ &SetRow($galcfgrow);
+ for ($bit = 0; $bit < $#{$galconfig} + 1; $bit++)
+ {
+ &SendBit( $array[@{$galconfig}[$bit]]);
+ }
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF);
+ }
+ elsif ($galtype == ATF22V10C)
+ {
+ &SetRow(0);
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ for ($bit = 0; $bit < $galbits; $bit++)
+ {
+ &SendBit($array[$galrows * $bit + $row]);
+ }
+ &SendAddress( 6, $row);
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF);
+ }
+ # write UES
+ &SendBits(68, 1);
+ for ($bit = 0; $bit < ($galuesbytes * 8); $bit++)
+ {
+ &SendBit($array[$galuesfuse + $bit]);
+ }
+ &SendAddress( 6, $row);
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF);
+ # write CFG
+ &SetRow($galcfgrow);
+ for ($bit = 0; $bit < 19; $bit++)
+ {
+ &SendBit( $array[@{$galconfig}[$bit]]);
+ }
+ &SetSDIN($array[@{$galconfig}[19]]);
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF);
+ # disable power-down feature
+ &SetRow(0);
+ &SendAddress(6, 59);
+ &SetPV(ON);
+ &Strobe($progtime);
+ &SetPV(OFF)
+ }
+ else # default
+ {
+ &SetRow(0);
+ for ($row = 0; $row < $galrows; $row++)
+ {
+ for ($bit = 0; $bit < $galbits; $bit++)
+ {
+ &SendBit ($array[$galrows * $bit + $row]);
+ }
+ &SendAddress(6, $row);
+ &SetSDIN(OFF);
+ &Strobe($progtime);
+ }
+ # UES
+ for ($bit = 0; $bit < ($galuesbytes * 8); $bit++)
+ {
+ &SendBit($array[$galuesfuse + $bit]);
+ }
+ if (($galuesbytes * 8) < $galbits)
+ {
+ &SendBits($galbits - ($galuesbytes * 8), 0);
+ }
+ &SendAddress (6, $galuesrow);
+ &SetSDIN(OFF);
+ &Strobe($progtime);
+ # CFG
+ &SetRow($galcfgrow);
+ for ($bit = 0; $bit < $#{$galconfig} + 1; $bit++)
+ {
+ &SendBit ($array[@{$galconfig}[$bit]]);
+ }
+ &SetSDIN(OFF);
+ &Strobe($progtime);
+ }
+ &TurnOff;
+ }
+ return ;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub EraseGAL
+{
+ if (&TurnOn(ERASEGAL))
+ {
+ &Delay(2);
+ &SetRow($galeraserow);
+ &Delay(2);
+ if (($galtype == GAL16V8) || ($galtype == ATF16V8B) || ($galtype == GAL20V8))
+ {
+ &SendBit(1);
+ }
+ &Strobe($erasetime);
+ &Delay(2);
+ &TurnOff;
+ }
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub EraseALL
+{
+ if (&TurnOn(ERASEALL))
+ {
+ &Delay(2);
+ &SetRow($galeraseallrow);
+ &Delay(2);
+ if(($galtype == GAL16V8) || ($galtype == ATF16V8B) || ($galtype == GAL20V8))
+ {
+ &SendBit(1);
+ }
+ &Strobe($erasetime);
+ &Delay(2);
+ &TurnOff;
+ }
+}
+
+##############################################################################################
+#
+#
+#
+##############################################################################################
+sub StrobeRow
+{
+ my $row = $_[0];
+
+ if(($galtype == GAL16V8) || ($galtype == GAL20V8) || ($galtype == ATF16V8B))
+ {
+ &SetRow($row);
+ }
+ elsif (($galtype == GAL6001) || ($galtype == GAL6002))
+ {
+ &SetRow(0);
+ &SendBits(95,0);
+ &SendBit(1);
+ &SendAddress(7, $row);
+ &SendBits(16);
+ }
+ elsif (($galtype == GAL22V10) || ($galtype == ATF22V10B) || ($galtype == ATF22V10C))
+ {
+ &SetRow(0);
+ &SendAddress(6, $_[0]);
+ &SetSTB(ON);
+ &SetSTB(OFF);
+ &SetSDIN(OFF);
+ return;
+ }
+ else
+ {
+ &SetRow(0);
+ &SendBits($galbits, 0);
+ &SendAddress(6, $row);
+ }
+ &Strobe(2);
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub ReceiveBit
+{
+# clock bit in from SDOUT
+ &SetSDIN(OFF);
+ usleep(10);
+ my $bit = &GetSDOUT();
+ &SetSCLK(ON);
+ usleep(10);
+ &SetSCLK(OFF);
+ usleep(10);
+#print "bit: $bit\n";
+ return ($bit == TRUE) ? 1 : 0;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetSDOUT
+{
+ return &GetACK; # ack is output from DUT
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SendBit
+{
+ &SetSDIN(($_[0]) ? ON : OFF); # (bit)
+ usleep(10);
+ &SetSCLK(ON);
+ usleep(10);
+ &SetSCLK(OFF);
+ usleep(10);
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SendBits
+{
+ my $count = $_[0]; # (n, bit)
+ my $bit = $_[1];
+
+ while($count--)
+ {
+ &SendBit($bit);
+ }
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub DiscardBits
+{
+ my $count = $_[0]; # (n)
+
+ while($count--)
+ {
+ &ReceiveBit; # throw away data
+ }
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SendAddress
+{
+ my $count = $_[0]; # (n, row)
+ my $row = $_[1];
+
+ if ($galtype == ATF22V10C) # /* ATF22V10C MSb first, other 22V10 LSb first */
+ {
+ while ($count-- > 1)
+ {
+ &SendBit($row & 32);
+ $row <<= 1;
+ }
+ &SetSDIN(($row & 32) ? ON : OFF);
+ }
+ else
+ {
+ while ($count-- > 0)
+ {
+ &SendBit($row & 1);
+ $row >>= 1;
+ }
+ &SetSDIN(OFF);
+ }
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub Delay
+{
+ my $msec = $_[0];
+
+ usleep($msec * 1000);
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub Strobe()
+{
+ &Delay(1);
+ &SetSTB(ON);
+ &Delay($_[0]);
+ &SetSTB(OFF);
+ &Delay(1);
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetSTB
+{
+ SetSTROBE($_[0]); # ON / OFF
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub CheckHexEntry
+{
+ my ($val) = @_;
+ my $b_valid = ($val =~ /^[0-9A-F]{1,2}$/i)? 1: 0;
+
+ return $b_valid;
+}
+
+########################################################################################################
+#
+# load JEDEC file
+#
+########################################################################################################
+sub LoadFile
+{
+ my $types = [
+ ['JEDEC Files', ['.jed', '.JED']],
+ ['All Files', '*', ],
+ ];
+
+ my $file = $mw->getOpenFile(-filetypes => $types, -defaultextension => ".JED" );
+ &ProcessLoadFile($file) if defined $file;
+}
+
+########################################################################################################
+#
+# save JEDEC file
+#
+########################################################################################################
+sub SaveFile
+{
+ my $types = [
+ ['JEDEC Files', ['.jed', '.JED']],
+ ['All Files', '*', ],
+ ];
+
+ my $file = $mw->getSaveFile(-filetypes => $types, -defaultextension => ".JED" );
+ &ProcessSaveFile($file) if defined $file;
+}
+
+#################################################################################################
+#
+# Load a JEDEC file
+#
+#################################################################################################
+sub ProcessLoadFile
+{
+ my $filename = $_[0];
+ my @filebuf;
+ my $fusedata;
+ my $i;
+ my $ptr;
+ my $fcflag = 0;
+ my $filechecksum = 0;
+ my $listboxline;
+
+ my $oldslurp = $/;
+ local ($/); # slurp mode
+
+ &ClrListBox;
+ open (JEDECIN, "<", $filename) || ($db = $mw->DialogBox(-title => 'File not found!', -buttons => ['Ok'] ));
+# first RAW read for FILE checksum
+ while()
+ {
+ @filebuf = split ('|', $_); ##unpack "a1" x (length( $_ ) /1 ), $_;
+ for ($i = 0; $i < $#filebuf; $i++)
+ {
+ if (ord $filebuf[$i] == 0x02)
+ {
+ $fcflag = 1;
+ }
+ if ($fcflag == 1)
+ {
+ $filechecksum += ord $filebuf[$i];
+ }
+ if (ord $filebuf[$i] == 0x03)
+ {
+ $fcflag = 0;
+ }
+ }
+ }
+# now normal read to process data
+ $/ = $oldslurp;
+ seek JEDECIN, 0,0 ; # REWIND FILE
+ # now in normal mode
+ while()
+ {
+ chomp;
+ $_ =~ s/[\r\n]//g; # remove EOL
+ $fusedata .= $_;
+# display
+ &ToListBox($_);
+ }
+ close JEDECIN;
+#
+# $fusedata now holds the clean file info, now remove everything outside STX and ETX
+#
+ $ptr = index($fusedata, chr(0x02));
+ if ($ptr < 0)
+ {
+ $db = $mw->DialogBox(-title => 'Error in File', -buttons => ['Ok'] );
+ return;
+ }
+ else
+ {
+ $fusedata = substr($fusedata, $ptr+1);
+ }
+
+ $ptr = index($fusedata, chr(0x03));
+ if ($ptr < 0)
+ {
+ $db = $mw->DialogBox(-title => 'Error in File', -buttons => ['Ok'] );
+ return;
+ }
+ else
+ {
+ $fusedata = substr($fusedata, 0, $ptr);
+ }
+ @ffuses = split(/|/, $fusedata);
+ &CheckJEDEC ($fusedata);
+}
+
+#################################################################################################
+#
+# Save a JEDEC file
+#
+#################################################################################################
+sub ProcessSaveFile
+{
+ my $filename = $_[0];
+ my @elements = $blg->get(0, 'end');
+
+ if ($#elements != -1)
+ {
+ open (JEDECOUT, ">", $filename) || ($db = $mw->DialogBox(-title => 'Could not open outputfile!', -buttons => ['Ok'] ));
+
+ foreach $line (@elements)
+ {
+ printf JEDECOUT "%s\n", $line;
+ }
+ close JEDECOUT;
+ }
+ else
+ {
+ &DialogHandler(MSG_ALERT, "No data to write!, nothing done", 0);
+ }
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+# turn on DUT
+sub TurnOn
+{
+ my $mode = $_[0]; # function
+ my $writeorerase = FALSE;
+
+#print "TO: vpp= $vpp\n";
+
+ if (($mode == WRITEGAL) || ($mode == ERASEGAL) || ($mode == ERASEALL)
+ || ($mode == BURNSECURITY) || ($mode == WRITEPES) || ($mode == VPPTEST))
+ {
+ if (&DialogHandler(MSG_ASSURE, "Write DUT", $mode) == FALSE)
+ {
+ return FALSE;
+ }
+ else
+ {
+ $writeorerase = TRUE;
+ }
+ }
+
+#print "TO2: vpp= $vpp\n";
+
+ &SetVPP(0); # VPP off
+ &SetPV(OFF); # P/V- low resistor will correct for levels
+ &SetRow(0x3f); # RA0-5 High
+ &SetVCC($galvcc);# turn on VCC
+ &SetSDIN(OFF); # SDIN high
+ &SetSCLK(OFF); # SCLK low
+ &SetSTB(OFF); # STB high, outputs to H
+ &Delay(100);
+ &SetVPP(($writeorerase == TRUE) ? $vpp : $read12v);
+
+ if ($writeorerase == TRUE)
+ {
+ &SetPV(ON); # P/V- is to O1,
+ &Delay(10);
+ }
+ return TRUE; # true
+}
+
+#################################################################################################
+#
+# unpower the DUT
+#
+#################################################################################################
+# turn off DUT
+sub TurnOff
+{
+ &Delay(10);
+ &SetPV(OFF); # P/V- LOW = verify
+ &SetRow(0x3F); # RA0-5 HIGH
+ &SetSDIN(OFF); # SDIN High
+ &SetVPP(0); # VPP off
+ &Delay(2);
+ &SetVCC(0); # turn off VCC
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+# set P/V- signal level
+sub SetPV
+{
+ &SetSEL($_[0]); # ON / OFF
+}
+
+#================================================================================================
+#
+# Dialogs and other User interaction
+#
+# message types MSG_OK MSG_ALERT MSG_WARNING MSG_ASSURE
+# mode types READGAL READPES VERIFYGAL SCLKTEST WRITEGAL ERASEGAL ERASEALL BURNSECURITY WRITEPES VPPTEST TESTGAL
+#================================================================================================
+sub DialogHandler
+{
+ my $msgfunc = $_[0];
+ my $title = $_[1];
+ my $mode = $_[2];
+ my $testval = 2;
+ my $textrow1;
+ my $textrow2;
+ my $textrow3;
+ my $auxtext = "";
+ my $temptext;
+ my $lbuttontext = "OK";
+ my $rbuttontext = "Cancel";
+ my $i;
+ my @lpes;
+
+#print "msgfunc: $msgfunc mode: $mode\n";
+# fixed size and default buttons
+
+ my $dw = $mw->Toplevel(
+ -title => $title,
+ );
+
+ my $can = $dw->Button (
+ -text => $rbuttontext,
+ -width => 10,
+ -command => sub { $testval = 0; $dw->withdraw() },
+ )->pack(-side => 'right', -anchor => 's');
+
+ $dwb1 = $dw->Button (
+ -text => $lbuttontext,
+ -width => 10,
+ -command => sub { $testval = 1; $dw->withdraw() },
+ )->pack(-side => 'right', -anchor => 's');
+
+ $dwl1 = $dw->Label(
+ -text => $textrow1,
+ -just => 'left',
+ )->place(-x => 0, -y => 5);
+#-----------------------------------------------------------------------------------------------------
+#
+# Declare UI layout for Dialogs, show settings and allow for to edit (some)
+#
+#-----------------------------------------------------------------------------------------------------
+ if ($msgfunc == MSG_ASSURE)
+ {
+ $dwl2 = $dw->Label(
+ -text => $textrow2,
+ )->place(-x => 0, -y => 25);
+#
+ $dwl3 = $dw->Label(
+ -text => $textrow3,
+ )->place(-x => 0, -y => 45);
+#
+# variable items
+#
+ $dw->geometry('400x150'); # textrow1 / textrow3 / vpp:prog setting /buttons
+
+ $dwb1->configure(-text => $lbuttontext);
+
+ if (($mode == CHECKPES) || ($mode == WRITEPES) || ($mode == WRITEGAL) ||($mode == ERASEGAL) || ($mode == ERASEALL))
+ {
+ &ParsePES;
+ for ($i = 0; $i <= $#pes; $i++)
+ {
+ $lpes[$i] = sprintf "%02X", $pes[$i];
+ }
+ }
+
+ if (($mode == WRITEPES) || ($mode == WRITEGAL) || ($mode == ERASEGAL) || ($mode == ERASEALL))
+ {
+ $dle1 = $dw->LabEntry(
+ -textvariable => \$vppf,
+ -label => 'VPP: ',
+ -labelPack => [-side => 'left', -anchor => 'w'],
+ -width => 5,
+ -bg => 'white',
+ -font => ['courier', '12', 'bold'],
+ )->place(-x => 0, -y => 70);
+
+ $dle2 = $dw->LabEntry(
+ -textvariable => \$progf,
+ -label => 'Prog-Pulse ',
+ -labelPack => [-side => 'left', -anchor => 'w'],
+ -width => 3,
+ -bg => 'white',
+ -font => ['courier', '12', 'bold'],
+ )->place(-x => 160, -y => 70);
+ }
+ $dwl4 = $dw->Label(
+ -font => ['courier', '12', 'bold'],
+ -text => $auxtext,
+ )->place (-x => 0, -y => 90);
+
+ if ($mode == CHECKPES)
+ {
+ $dw->geometry('400x100');
+
+ $lbuttontext = "Write PES";
+ $dwb1->configure(-text => $lbuttontext);
+
+ for ($i = 0 ; $i <8; $i++)
+ {
+ my $wname = sprintf "\$de%1d", $i;
+ $wname = $dw->LabEntry(
+ -width => 2,
+# -textvariable => $lpes[$i],
+ -font => ['courier', '12', 'bold'],
+ -bg => 'white',
+ -validatecommand => \&CheckHexEntry,
+ -validate => 'key',
+ )->place(-x => $i * 24, -y => 20);
+ $wname->configure(-textvariable => \$lpes[$i]);
+ }
+ }
+ }
+#-----------------------------------------------------------------------------------------------------
+#
+# show a simple message to the user, return on buttonpress
+#
+#-----------------------------------------------------------------------------------------------------
+ elsif ($msgfunc == MSG_ALERT)
+ {
+ $dw->geometry('400x50');
+
+ $textrow1 = $title;
+ $can->destroy();
+ $dwl1->configure(-text => $textrow1);
+ }
+#-----------------------------------------------------------------------------------------------------
+#
+# show warning, user can preceed or abort
+#
+#-----------------------------------------------------------------------------------------------------
+ elsif ($msgfunc == MSG_WARNING)
+ {
+ $dw->geometry('500x50');
+ $textrow1 = $title;
+ $dwl1->configure(-text => $textrow1);
+
+ if ($mode == TESTGAL)
+ {
+ $lbuttontext = "Yes";
+ $rbuttontext = "No";
+ $can->configure(-text => $rbuttontext);
+ $dwb1->configure(-text => $lbuttontext);
+ }
+ }
+#
+# initial contents
+#
+ if (($mode == CHECKPES) || ($mode == WRITEPES) || ($mode == WRITEGAL) ||($mode == ERASEGAL) || ($mode == ERASEALL))
+ {
+ if (hex($lpes[3]) == $LATTICE)
+ {
+ $temptext = "Lattice";
+ }
+ elsif (hex($lpes[3]) == $NATIONAL)
+ {
+ $temptext = "National";
+ }
+ elsif (hex($lpes[3]) == $SGSTHOMSON)
+ {
+ $temptext = "ST";
+ }
+ else
+ {
+ $temptext = "Unknown";
+ }
+ }
+
+ if ($mode == CHECKPES)
+ {
+ $textrow1 = sprintf "B1 B2 B3 B4 D1 D2 D3 D4";
+ $dwl1->configure(-text => $textrow1, -just => 'left');
+ $textrow3 = sprintf "VPP=%2.2f Prog-Pulse=%dmS Erase-Pulse=%dmS", $vpp/4.0, $progtime, $erasetime;
+ $dwl3->configure(-text => $textrow3);
+ }
+ elsif (($mode == WRITEPES) || ($mode == WRITEGAL) || ($mode == ERASEGAL) || ($mode == ERASEALL))
+ {
+ $textrow1 = sprintf "%s %s %s", ($pes[1] & 0x10)?"3.3V":"5.0V", $temptext, @{$galinfo{$galtype}}[3];
+ $dwl1->configure(-text => $textrow1);
+ $textrow2 = sprintf "PES: %02s %02s %02s %02s %02s %02s %02s %02s", $lpes[0],$lpes[1],$lpes[2],$lpes[3],$lpes[4],$lpes[5],$lpes[6],$lpes[7];
+ $dwl2->configure(-text => $textrow2);
+ $textrow3 = sprintf "VPP=%2.2f Prog-Pulse=%dmS Erase-Pulse=%dmS", $vpp/4.0, $progtime, $erasetime;
+ $dwl3->configure(-text => $textrow3);
+ $vppf = sprintf "%2.2f", $vpp / 4.0;
+ $dle1->configure(-text => $vppf);
+ if (($mode == WRITEPES) || ($mode == WRITEGAL))
+ {
+ $progf = sprintf "%3d", $progtime;
+ }
+ elsif (($mode == ERASEGAL) || ($mode == ERASEALL))
+ {
+ $dle2->configure(-label => 'Erase-Pulse');
+ $progf = sprintf "%3d", $erasetime;
+ }
+ else
+ {
+ $progf = "XXX";
+ }
+ $dle2->configure(-text => $progf);
+ }
+
+ if ($mode == WRITEGAL)
+ {
+ $lbuttontext = "Write GAL";
+ $dwb1->configure(-text => $lbuttontext);
+ }
+
+ if ($mode == ERASEGAL)
+ {
+ $auxtext = "*** Erase GAL ***";
+ $dwl4->configure(-text => $auxtext);
+ $lbuttontext = "Erase GAL";
+ $dwb1->configure(-text => $lbuttontext);
+ }
+ elsif ($mode == ERASEALL)
+ {
+ $auxtext = "*** Erase WHOLE GAL, including PES! ***";
+ $dwl4->configure(-text => $auxtext);
+ $lbuttontext = "Erase ALL";
+ $dwb1->configure(-text => $lbuttontext);
+ }
+
+#
+# wait user response here and update everything in the while
+#
+ &KeysOff;
+
+ while(1){
+ $mw->update;
+
+ if (hex($lpes[3]) == $LATTICE)
+ {
+ $temptext = "Lattice";
+ }
+ elsif (hex($lpes[3]) == $NATIONAL)
+ {
+ $temptext = "National";
+ }
+ elsif (hex($lpes[3]) == $SGSTHOMSON)
+ {
+ $temptext = "ST";
+ }
+ else
+ {
+ $temptext = "Unknown";
+ }
+#
+# generic exit and delay
+#
+ if($testval != 2)
+ {
+ goto OUT;
+ }
+ usleep(10000);
+ }
+OUT:
+ if ($testval == 1)
+ {
+ if ($mode == CHECKPES)
+ {
+ for ($i = 0; $i < 8 ; $i++)
+ {
+ $pes[$i] = hex($lpes[$i]);
+ }
+ }
+ }
+ &KeysOn;
+# on success copy the data
+ return ($testval == 1) ? TRUE : FALSE;
+}
+
+#================================================================================================
+#
+# all functions that interact directly with the port hardware
+#
+#================================================================================================
+
+#################################################################################################
+#
+# set VCC voltage 0.0, 3.3 or 5.0 V
+#
+#################################################################################################
+sub SetVCC
+{
+ my $setting = $_[0]; # parameter that represents the desired voltage
+ my $portdata;
+
+# for the CSGBLAST hardware uncomment the following lines
+# $portdata = ord $parport->get_data(); # save present state
+# &SetFEED(OFF); # freezes the data settings in the hardware
+# if ($setting == 0.0)
+# {
+# $ls273shadow &= ~0xC0; # VCC (3.3 and 5) off
+# }
+# elsif ($setting == 3.3)
+# {
+# $ls273shadow &= ~0x40; # 3V3 select
+# $ls273shadow |= 0x80; #
+# }
+# elsif ($setting == 5.0)
+# {
+# $ls273shadow |= 0xC0; # 5V0 select
+# }
+# $parport->set_data(chr($ls273shadow));
+# &SetINIT(ON); # strobe 74LS273
+# &SetINIT(OFF); #
+# $parport->set_data(chr($portdata)); # restore old
+# &SetFEED(ON); # re-enable
+# for a simple ON/OFF control this is sufficient
+ &SetINIT($setting); # ON / OFF
+}
+
+#################################################################################################
+#
+# This is the modules that should be adapted to the REAL programming hardware where
+# it comes to voltage settings
+#
+#################################################################################################
+# set programming voltage
+sub SetVPP
+{
+ my $setting = $_[0]; # parameter that represents the desired voltage
+ my $portdata;
+
+ if ($portopen != -1)
+ {
+# for the CSGBLAST hardware uncomment the following lines
+# $portdata = ord $parport->get_data(); # save present state
+# &SetFEED(OFF); # freezes the data settings in the hardware
+# if ($setting == 0) # off
+# {
+# $ls273shadow &= ~0x20; # VPP off
+# $parport->set_data(chr($ls273shadow));
+# &SetINIT(ON);
+# &SetINIT(OFF); # clear 74LS273, VPP off
+# }
+# else
+# {
+# if( ($setting < $read12v) || ($setting > 68))
+# {
+## should not happen!!
+# }
+# else
+# {
+# $dacvalue = (($setting - $read12v) / 4.0) / 5.0 * 255;
+# $parport->set_data(chr($dacvalue));
+# &SetSTROBE(ON);
+# &SetSTROBE(OFF);
+# $dacvalueshadow = $dacvalue;
+# $ls273shadow |= 0x20; # VPP ON
+# $parport->set_data(chr($ls273shadow));
+# &SetINIT(ON);
+# &SetINIT(OFF); # clear 74LS273, VPP off
+# }
+# }
+# $parport->set_data(chr($portdata)); # restore old
+# &SetFEED(ON); # re-enable
+# for a simple ON/OFF control where the real voltage is controlled by user
+ if ($setting != 0)
+ {
+ &SetFEED(ON); # direct VPP on
+ }
+ else
+ {
+ &SetFEED(OFF); # direct VPP off
+ }
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub InitAll
+{
+ &SetPort;
+ &SetGalParms(UNKNOWN);
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub MyExit
+{
+ &TurnOff;
+ exit;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+# now device port is open, sync the hardware with the software
+sub HardwareInit
+{
+ &TurnOff;
+# for the CSGBLAST hardware uncomment the following lines
+# &SetFEED(ON); #
+# $parport->set_data(chr(0x7E)); # all row bits high, clock and data low
+# &SetFEED(OFF); #
+# $parport->set_data(chr(0x00)); # reset everything
+# &SetSTROBE(ON);
+# &SetStROBE(OFF): # this clears the DAC
+# &SetINIT(ON); # strobe2
+# $SetINIT(OFF): # clear the 74LS273 latch (VCC/VPP = off)
+# &SetFEED(ON); #
+# $parport->set_data(chr(0x7E)); # all row bits high, clock and data low
+}
+
+##############################################################################################
+#
+# all functions that interact with HARDWARE
+#
+########################################### data #############################################
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetSDIN
+{
+ if ($portopen != -1)
+ {
+ if ($_[0] == ON)
+ {
+ $parport->set_bit(0,1); # data high TO DUT
+ }
+ else
+ {
+ $parport->set_bit(0,0); # data low TO DUT
+ }
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetSCLK
+{
+ if ($portopen != -1)
+ {
+ if ($_[0] == ON)
+ {
+ $parport->set_bit(7,1); # clock high TO DUT
+ }
+ else
+ {
+ $parport->set_bit(7,0); # clock low TO DUT
+ }
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetRow
+{
+ if ($portopen != -1)
+ {
+ my $control = ord $parport->get_data();
+
+ if ($_[0] > 63)
+ {
+ printf STDERR "Fatal: illegal row number $_[0]!\n";
+ }
+ $inverse = $_[0] & 0x3F;
+ $control = ($control & 0x81) | ($inverse <<= 1); # keep clk and data bit
+ $parport->set_data(chr($control)); # set bit
+ }
+ return FALSE;
+}
+
+######################################## outputs ##############################################
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetSTROBE
+{
+ if ($portopen != -1)
+ {
+ my $control = ord $parport->get_control() & ~$STROBE;
+
+ if ($_[0] == ON)
+ {
+ $control |= $STROBE; # out = low
+ }
+ $parport->set_control(chr($control));
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetFEED
+{
+ if ($portopen != -1)
+ {
+ my $control = ord $parport->get_control() & ~$LNFEED;
+
+ if ($_[0] == !ON)
+ {
+ $control |= $LNFEED;
+ }
+ $parport->set_control(chr($control));
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetINIT
+{
+ if ($portopen != -1)
+ {
+ my $control = ord $parport->get_control() & ~$INIT;
+
+ if ($_[0] == ON)
+ {
+ $control |= $INIT;
+ }
+ $parport->set_control(chr($control));
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub SetSEL
+{
+ if ($portopen != -1)
+ {
+ my $control = ord $parport->get_control() & ~$SELCTP;
+
+ if ($_[0] == !ON)
+ {
+ $control |= $SELCTP; # P/V- high
+ }
+ $parport->set_control(chr($control)); # set bit
+ }
+ return FALSE;
+}
+
+########################################## inputs ##############################################
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetACK
+{
+ if ($portopen != -1)
+ {
+ my $val = ord $parport->get_status & $ACK; # get bit
+
+ return ($val != 0) ? TRUE : FALSE;
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetBUSY
+{
+ if ($portopen != -1)
+ {
+ my $val = ord $parport->get_status & $BUSY;
+
+ return ($val != 0) ? TRUE : FALSE;
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetERROR
+{
+ if ($portopen != -1)
+ {
+ my $val = ord $parport->get_status & $ERROR;
+
+ return ($val != 0) ? TRUE : FALSE;
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetPAPOUT
+{
+ if ($portopen != -1)
+ {
+ my $val = ord $parport->get_status & $PAPOUT;
+
+ return ($val != 0) ? TRUE : FALSE;
+ }
+ return FALSE;
+}
+
+#################################################################################################
+#
+#
+#
+#################################################################################################
+sub GetSELECT
+{
+ if ($portopen != -1)
+ {
+ my $val = ord $parport->get_status & $SELECT;
+
+ return ($val != 0) ? TRUE : FALSE;
+ }
+ return FALSE;
+}