NET2PRM.V18

Greg Wolodkin's .NET compiler for SYNETSIM

Copyright (C) 1990 Greg Wolodkin

[Export program between lines of "#########" into a text file and compile with QuickBASIC 4.5]

###################################################################
DECLARE SUB RefreshInputText (s$)
DECLARE SUB GetALine (a$)
DECLARE SUB StoreALine (a$)
'--------------------------------------------------------------------------
' NET2PRM.BAS  ..  a netlist compiler for use with SYNETSIM compartmental
'                  modeling software.
'
' Version 1.8      October 4, 1990
' Most recent update:
'  Version 1.8 has been modified to allow lines longer than
'  80 characters in the netlist.  Whereas this was previously
'  allowed only within the .DEFINE, .BATCH, etc. structures, it
'  can now be used within the entire netlist.  The '+' symbol
'  is used to identify any line as a continuation of the line
'  previous. v1.8X has MAXBR%=50
'
'  Version 1.7 has been corrected using 2GC as opposed to GC/2
'
'  Compatibility with SYNETSIM.33B, using GAMMA or GBAR (conductance
'  density or actual conductance) capability.
'
' Greg Wolodkin
' Bekesy Laboratory of Neurobiology
' University of Hawaii at Manoa
' Honolulu, Hawaii  96822
'
' email greg@uhunix.uhcc.Hawaii.Edu
'--------------------------------------------------------------------------
DECLARE SUB AddQuotes (G$)
DECLARE SUB CheckConnect (CON$, SW$, DP%)
DECLARE SUB CheckForTyp (code%, DP%)
DECLARE SUB CodeCount (code$, n%)
DECLARE SUB CodePointer (f$, DP%)
DECLARE SUB CountSlash (f$, n%, s%)
DECLARE SUB DEFPointer (D$, DP%)
DECLARE SUB ErrorCheck (EMSG%, FLAG%, m$)
DECLARE SUB FixText (T$)
DECLARE SUB FormatNumbers (f$)
DECLARE SUB FormFullName (CON$, SW$, cname$)
DECLARE SUB GetBatchInfo (BFID$, B%)
DECLARE SUB GetBatchSize (B%, MAXP%)
DECLARE SUB GetCaps (T$)
DECLARE SUB GetData (a$, B$, n%, D$)
DECLARE SUB GetFileNames (NETFILE$, PRMFILE$, MSTFILE$, BATFILE$, SW$)
DECLARE SUB GetFormatSize (PFID$, SHC%, HC%, HP%, MTYP%, PHD%)
DECLARE SUB GetMasterInfo (MIDD$, MPS%)
DECLARE SUB GetMasterSize (MPS%)
DECLARE SUB GetNextParm (f$, s$)
DECLARE SUB GetParentheses (f$, s$)
DECLARE SUB GetParmNames (HC%, HP%, MTYP%, PHID%)
DECLARE SUB GetTyp (MOD$, code%, TYP%)
DECLARE SUB MakeConnect (CON$, cname$, count%, DP%, CCD%, KC%)
DECLARE SUB MakeFileName (f$, L$, R$)
DECLARE SUB PRMPointer (f$, code%, DP%)
DECLARE SUB ProcessBatch (BATFILE$)
DECLARE SUB PushSwitch (f$, s$)
DECLARE SUB ReadBatch (s$)
DECLARE SUB ReadBlock (s$)
DECLARE SUB ReadDefinition (srch$)
DECLARE SUB ReadMaster (s$)
DECLARE SUB Sort (a$(), B$(), n%)
DECLARE SUB StripQuotes (G$)
DECLARE SUB StuffDefinition (DEFT$, code%)
DECLARE SUB StuffMods (MOD$, code%, ECHK%)
DECLARE SUB TotalConnect (CHAV$, CEXP$, CRET$, cname$, TARG$, SW$, n%)
DECLARE SUB Trim (G$)
DECLARE SUB WriteMaster (MPS%, TITLE$, MIDD$, PRMFILE$, MSTFILE$, MSWITCH%)
DECLARE SUB WriteToPRMfile (code%)
'--------------------------------------------------------------------------
CONST PROGID$ = "NET2PRM.BAS v1.8X 10/19/90"
CONST PRMDATA$ = "NET2PRM.CNF"            'SYNETSIM parameter configuration
CONST MSTDATA$ = "NET2MST.CNF"            ' and master file configuration.
CONST BATDATA$ = "NET2SBT.CNF"            ' and batch file information
CONST MAXBR% = 50                         'from SYNETSIM dimensions
CONST DFCOUNT% = 30                       'allow 30 .DEFINE commands
CONST NTCOUNT% = 200                      'allow 200 components in net
CONST BatchSize% = 100                    'lines of batch text allowed
CONST SPKFLG$ = "TRIGR SPIKE STIM"        'synaptic connection aliases
CONST CPALIAS$ = "CMPT SPHERE CYL"        'cmpt aliases
CONST Cmnt$ = "'"                         'choose your comment indicator
CONST ENDBATCH$ = "7"                     'marks end of .SBT file for
CONST pi = 3.1415926#                     '   synetsim.
CONST cunit = 1                           'uF per square cm
CONST LEGALBR% = 2                        'allow Y and Delta nets at most.
'--------------------------------------------------------------------------
PRINT PROGID$                         'Print header
PRINT
CALL GetFileNames(NETFILE$, PRMFILE$, MSTFILE$, BATFILE$, SW$)
'-----------------------
'--->Parameter File Info
PRINT "Searching the current directory for "; PRMDATA$; "...";
CALL GetFormatSize(PFID$, SHIC%, HIC%, HIP%, MTYP%, PHID%)
LOCATE CSRLIN, 1

'Arrays containing reference data
'--------------------------------
DIM SHARED PRM$(HIC%, HIP%)                'names of legal parameters
DIM SHARED PPRM$(MTYP%, PHID%, HIP%)       'extra data for 'TYPE=' codes
DIM SHARED COD$(HIC%)                      'names of available codes
DIM SHARED CODN%(HIC%)                     'code counter
DIM SHARED CNECT$(HIC%)                    'connection types
DIM SHARED PCNECT$(MTYP%, PHID%)           'pool connection types
DIM SHARED PTYP$(MTYP%)                    'relating codenames using
'------------------------------------------
CALL GetParmNames(HIC%, HIP%, MTYP%, PHID%)

'Arrays containing netlist info
'------------------------------
DIM SHARED cname$(MAXBR%)             'cell/cmpt names
DIM SHARED STIM$(MAXBR%)              'STIM names
DIM SHARED CYLBR$(MAXBR%)             'Names of connecting cylinders
DIM SHARED CYLGC(MAXBR%, MAXBR%)      'Conductance values for same
DIM SHARED CYLBC%(MAXBR%, LEGALBR%)   'Number of connections to a cylinder
DIM SHARED DFPRM(DFCOUNT%, HIP%)      'DEFINE'd parameters
DIM SHARED DFNAME$(DFCOUNT%)          'definition names
DIM SHARED ntname$(NTCOUNT%)          'network names and info
DIM SHARED TMPRM$(HIP%)               'temp. storage before disk
DIM SHARED NSORT$(NTCOUNT%)           'used to keep netlist order
DIM SHARED PPOS%(MAXBR%)              'used to assign pools to POOLX
DIM SHARED BATCH$(BatchSize%)         'storage of .BATCH info
DIM SHARED TXFLG$(HIC%)               'toxin flags for master file

'--->Master File Info
PRINT "Searching the current directory for "; MSTDATA$; "...           ";
CALL GetMasterSize(MPS%)
LOCATE CSRLIN, 1
'-------------------------------
DIM SHARED MNAME$(MPS%)                'master file parm names
DIM SHARED MVAL$(MPS%)                 'master file parm values
'-------------------------------
CALL GetMasterInfo(MIDD$, MPS%)

'--->SBT or .BATCH File Info
PRINT "Searching the current directory for "; BATDATA$; "...        ";
CALL GetBatchSize(HIBL%, HIBP%)      'Batch listings and batch parms
LOCATE CSRLIN, 1                     'remove .CNF filenames from
PRINT SPACE$(79);                    'screen once you know they
LOCATE CSRLIN, 1                     'exist.
'-------------------------------
DIM SHARED BNAME$(HIBL%)             'names of batch items (i.e. FREE_RUN)
DIM SHARED BPARM$(HIBL%, HIBP%)      'valid parm names and numbers
DIM SHARED BTEMP$(HIBP%)             'temp array prior to disk write
'-------------------------------
CALL GetBatchInfo(BFID$, HIBL%)
'-------------------------------
'Done with parameter info file, get netlist info.

'-->Process command line switch
IF SW$ = "" THEN
 GOTO Default
ELSE
 SW% = ASC(SW$) - 64
 ON SW% GOTO a, invalid, invalid, D
END IF

invalid:
 PRINT
 PRINT "Invalid switch /"; SW$; " in command line ignored."; CHR$(7)
 PRINT
 GOTO Default

a:
  REM Author mode.. primarily for debugging.
  DBUG% = -1
  PRINT "Debug mode is ON."
  GOTO Default

D:
 REM Change the way geometrical calculations proceed.
 REM All calculated conductances will be in mhos, not mhos/cm2.
 PRINT
 PRINT "Using SYNETSIM 3.2D format for calculated conductances."
 PRINT
 OLDVERSW% = -1

Default:
 REM Default setting is OLDVERSW%=0... Compatible with SYNETSIM 3.3.1
 REM Calculated conductances will be conductance densities, in mhos/cm2
'------------------------
REM Start of Main Program
'------------------------
PRINT "Opening netlist "; TAB(25); NETFILE$
OPEN "I", 1, NETFILE$
LINE INPUT #1, TITLE$
CALL StripQuotes(TITLE$)

'First Pass reads all data from file
cell% = 0: count% = 0
WHILE NOT EOF(1) AND find$ <> ".END"
DO                                      'Get a line from netlist
  CALL GetALine(a$)                     'ignoring comment lines
  CALL FixText(a$)                      'and blank lines
  CALL Trim(a$)
 LOOP WHILE LEFT$(a$, 1) = Cmnt$ OR a$ = ""
 srch$ = a$
 CALL GetNextParm(find$, srch$)         'get first word of line
                                        'use it to make a decision.
 IF find$ = ".DEFINE" THEN
  CALL ReadDefinition(srch$)
     
 ELSEIF find$ = ".MASTER" THEN
  MSWITCH% = -1                         'set master flag.
  IF LEFT$(srch$, 1) = "(" THEN
   CALL ReadMaster(srch$)               'and read information
  ELSE
   CALL ErrorCheck(1, -1, srch$)        'else fatal error.
  END IF

 ELSEIF find$ = ".BLOCK" THEN
  IF LEFT$(srch$, 1) = "(" THEN
   CALL ReadBlock(srch$)                'read .block information
  ELSE
   CALL ErrorCheck(1, -1, srch$)        'else fatal error.
  END IF

 ELSEIF find$ = ".BATCH" THEN
  BSWITCH% = -1                         'set batch flag.
  CALL ReadBatch(srch$)                 'and read .batch information

 ELSEIF find$ = ".END" THEN
  EMSG% = -1                            'set 'proper' ending flag.

 ELSEIF find$ = "CELL" THEN             'treat special case CELL
  CALL GetNextParm(find$, srch$)
  cell% = cell% + 1
  cell$(cell%) = find$
  cell$ = cell$(cell%)

 ELSE code% = 1                             'treat Codes
  CALL PushSwitch(find$, srch$)
  WHILE find$ <> COD$(code%)
   code% = code% + 1
   IF code% > HIC% THEN CALL ErrorCheck(2, -1, find$)
  WEND
  count% = count% + 1
  acode% = code%                            'save original code
                                            'in case of alias.

  CODN%(code%) = CODN%(code%) + 1           'increment branch count
  IF INSTR(CPALIAS$, find$) <> 0 THEN       'compartment special case
   code% = 1                                'certain aliases appear as cmpts
   CODN%(code%) = CODN%(code%) + 1          'increment cmpt count
   CODN%(acode%) = CODN%(acode%) - 1        'and decrement alias count.
   CALL CodeCount("CMPT", cmpt%)            'get compartment count
   CALL GetNextParm(find$, srch$)           'get CMPT name
   cname$(cmpt%) = cell$(cell%) + "/" + find$
   cname$ = cname$(cmpt%)                   'store in cell/CMPT format
   ntname$(count%) = cname$(cmpt%)
   IF acode% <> code% THEN                  'if it's an alias (CYL,SPHERE)
    acode$ = STR$(acode%)                   'then add !ALIAS to net info.
    CALL Trim(acode$)
    ntname$(count%) = ntname$(count%) + "!" + acode$
   END IF
  
  ELSE
   ntname$(count%) = cname$(cmpt%)
   IF COD$(acode%) = "INFCYL" THEN
    ALIAS$ = STR$(acode%)
    CALL Trim(ALIAS$)
    ntname$(count%) = ntname$(count%) + "!" + ALIAS$
   END IF

   ntname$(count%) = ntname$(count%) + "/" + find$ 'include code
   IF LEFT$(srch$, 1) = "/" THEN            'and switch, if one
    CALL GetNextParm(find$, srch$)          'was pushed earlier
    ntname$(count%) = ntname$(count%) + find$'cell/cmpt/code/switch
   END IF
  END IF

  IF COD$(code%) = "POOL" THEN
   CALL CodeCount("POOL", POOL%)             'Keep track of
   PPOS%(POOL%) = count%                     'pool locations in net
  END IF

  CALL RefreshInputText(srch$)

  IF LEFT$(srch$, 1) = "(" THEN              'no .DEFINed parms
   find$ = ""
  ELSE
   CALL GetNextParm(find$, srch$)            'DEFINition name
  END IF

  ntname$(count%) = ntname$(count%) + "|" + find$   'add DEFINition, if any
        
  CALL GetParentheses(find$, srch$)          'parm (modifications)
  CALL ErrorCheck(1, VAL(find$), B$)
  ntname$(count%) = ntname$(count%) + "|" + find$
      
  CALL GetNextParm(find$, srch$)             'first connection
  CALL Trim(find$)
  IF CNECT$(acode%) = "CMPT" AND find$ <> "" THEN
   CALL CountSlash(find$, NSL%, SP%)
   IF NSL% = 0 THEN
    find$ = cell$(cell%) + "/" + find$       'add cell name
   END IF
   IF COD$(acode%) = "CYL" THEN              'resistive network info
    CYLBR$(cmpt%) = find$                    'stored in CYLBR$
    find$ = ""                               'rather than with CYL.
   END IF
  END IF
  find$ = find$ + "|" + srch$                'second connection, if any
  CALL Trim(find$)

  ntname$(count%) = ntname$(count%) + "|" + find$       'add connections
  NSORT$(count%) = STR$(100000 + code% * 1000 + count%) 'and index

  IF COD$(acode%) = "INFCYL" THEN                 'special case alias
   a$ = ntname$(count%)
   NSORT$(count%) = STR$(102000 + count%)         'sort just after CMPTs
   ALIAS$ = NSORT$(count%)
   CALL Trim(ALIAS$)                              'add COND branch
   count% = count% + 1
   ntname$(count%) = cname$(cmpt%) + "/COND/!" + ALIAS$ + "||( )|"
   CALL CodePointer("COND", DP%)
   CODN%(DP%) = CODN%(DP%) + 1                    'increment COND count
   NSORT$(count%) = STR$(100000 + DP% * 1000 + count%)'add sorting index
  END IF
 END IF
WEND
IF EMSG% <> -1 THEN                  'warn of missing .END statement
 PRINT
 PRINT "Missing .END statement in netlist."; CHR$(7)
 PRINT
END IF
CLOSE #1                              'Done with netlist
'------------------------------------------------------------------------
' End of first pass through netlist.  Each item in netlist is stored as |
' cell/cmpt[!alias][/code/[switch]]|[defin]|[(mods)]|[cnect1]|[cnect2]  |
'------------------------------------------------------------------------
' Examine CYLBR$() to begin resolving Y networks into delta networks...
'
FOR I% = 1 TO MAXBR%         'step through compartments
 IF cname$(I%) <> "" THEN
  FOR J% = 1 TO MAXBR%       'step through connections
   IF CYLBR$(J%) = cname$(I%) THEN
    CYLBC%(I%, 0) = CYLBC%(I%, 0) + 1
    IF CYLBC%(I%, 0) > LEGALBR% THEN
     PRINT "Too many branches at compartment "; cname$(I%); CHR$(7)
     STOP
    END IF
    CYLBC%(I%, CYLBC%(I%, 0)) = J%
   END IF
  NEXT J%
 END IF
NEXT I%
' Create enough ELECTN connections for network transform
' The non-boolean negative value of GC will cause GC to be
' looked up in the array CYLGC().
FOR I% = 1 TO MAXBR%
 B% = CYLBC%(I%, 0)         'number of connections to cmpt I%
 IF B% > 0 THEN
  FOR J% = 0 TO B%
   IF J% = 0 THEN
    cal% = I%
   ELSE
    cal% = CYLBC%(I%, J%)
   END IF
   NUMEL% = B% - J%
   FOR K% = 1 TO NUMEL%
    count% = count% + 1
    CNECT$ = cname$(CYLBC%(I%, J% + K%))
    n$ = cname$(cal%) + "/ELECTN/!CYL||(GC=cylgc)|" + CNECT$
    ntname$(count%) = n$
    CALL CodePointer("ELECTN", DP%)
    CODN%(DP%) = CODN%(DP%) + 1
    NSORT$(count%) = STR$(100000 + DP% * 1000 + count%)  'add sorting index
   NEXT K%
  NEXT J%
 END IF
NEXT I%

FOR I% = 2 TO SHIC%                    'analyze Toxin Flags.
 IF (CODN%(I%) > 0 AND TXFLG$(I%) <> "BLOCK") THEN
  TXFLG$(I%) = "0"                     'unblocking net codes
 END IF                                'unless specifically BLOCKed.
NEXT I%                                'Write Master File -->
CALL WriteMaster(MPS%, TITLE$, MIDD$, PRMFILE$, MSTFILE$, MSWITCH%)

CALL Sort(NSORT$(), ntname$(), count%) 'sort net by code and net order
'-----------------------------------------------------------------------
' Second pass makes netlist connections and writes PRM file.
'-----------------------------------------------------------------------
PRINT "Writing parameter file "; TAB(25); PRMFILE$
PRINT
OPEN "O", 1, PRMFILE$                 '.PRM file
WRITE #1, TITLE$                      'As found in netlist
WRITE #1, PFID$                       'As found in PRMDATA.DAT'

code% = 0: POOL% = 0: K% = 0: GCFLAG% = -1

'Netlist info is now sorted by code number.
'Cmpt aliases fall under the heading of compartments.
'INFCYL alias is at the top of the list, with CODE=0.
'(aliases need to be evaluated first, removing !ALIAS notation
'prior to making connections to !ALIAS compartments.)

CALL CodePointer("CYL", DP%)            'remove connection field
CNECT$(DP%) = ""                        'from CYL alias for 2nd pass.
FOR I% = 1 TO count%
 IF VAL(MID$(NSORT$(I%), 3, 2)) <> code% THEN
  code% = VAL(MID$(NSORT$(I%), 3, 2))
  K% = 0
 END IF
 K% = K% + 1
 CALL CheckForTyp(code%, TYPFLG%)        'location in PTYP$, if any.
 a$ = ntname$(I%)                        'current line of netlist
 IF DBUG% THEN
  PRINT a$;                              'to examine net as it is
  LINE INPUT "", FOO$                    'compiled.. use /A switch.
 END IF
 CALL GetData(a$, C2$, 1, "/")           'cell name
 CALL GetData(a$, C3$, 2, "/")           'cmpt name|defin|(parms)...
 CALL GetData(C3$, C4$, 1, "|")          'cmpt name
 SP% = INSTR(C4$, "!")
 IF SP% = 0 THEN
  acode% = code%
 ELSE                                    'if this is an alias
  acode% = VAL(RIGHT$(C4$, LEN(C4$) - SP%))'then remove !ALIAS from cmpt
  IF COD$(acode%) = "INFCYL" THEN
   code% = acode%
  ELSE
   code% = 1                              'name, and act accordingly.
  END IF
  C4$ = LEFT$(C4$, SP% - 1)
  X$ = ntname$(I%)
  SP% = INSTR(X$, "!") - 1
  EP% = INSTR(X$, "|") - 1
  ntname$(I%) = LEFT$(X$, SP%) + RIGHT$(X$, LEN(X$) - EP%)
 END IF

 cname$ = C2$ + "/" + C4$                'name of current cell/cmpt.

 cmpt% = 1
 WHILE cname$ <> cname$(cmpt%)
  cmpt% = cmpt% + 1                      'number of current cmpt.
 WEND

 cell% = 1
 WHILE C2$ <> cell$(cell%)
  cell% = cell% + 1                      'number of current cell.
 WEND
    
 '________________ Alias Patch for ELECTN connections _______________

 IF code% > 1 AND GCFLAG% THEN       'Resolve Y-networks now
  FOR m% = 1 TO MAXBR%
   'For now, special cases...
   IF CYLBC%(m%, 0) = 0 THEN
    REM no connections
  
   ELSEIF CYLBC%(m%, 0) = 1 THEN      'Two nodes... sum resistances or
    n% = CYLBC%(m%, 1)                'take series combo of conductances.
   
    Gm = CYLGC(m%, m%): Gn = CYLGC(n%, n%)
      
    IF Gm = 0 THEN
     GCeff = Gn
    ELSEIF Gn = 0 THEN
     GCeff = Gm
    ELSE
     GCeff = Gm * Gn / (Gm + Gn)
    END IF

    CYLGC(n%, m%) = GCeff
    CYLGC(m%, n%) = GCeff

   ELSEIF CYLBC%(m%, 0) = 2 THEN
    REM DELTA Transform
    nodeA% = m%
    nodeB% = CYLBC%(m%, 1)
    nodeC% = CYLBC%(m%, 2)

    g1 = CYLGC(nodeA%, nodeA%)
    IF g1 = 0 THEN
     r1 = 0
    ELSE
     r1 = 1 / g1
    END IF

    g2 = CYLGC(nodeB%, nodeB%)
    IF g2 = 0 THEN
     r2 = 0
    ELSE
     r2 = 1 / g2
    END IF

    g3 = CYLGC(nodeC%, nodeC%)
    IF g3 = 0 THEN
     r3 = 0
    ELSE
     r3 = 1 / g3
    END IF

    Rdenom = r1 * r2 + r2 * r3 + r3 * r1
   
    gA = r1 / Rdenom
    gB = r2 / Rdenom
    gC = r3 / Rdenom
    
    CYLGC(nodeB%, nodeC%) = gA: CYLGC(nodeC%, nodeB%) = gA
    CYLGC(nodeA%, nodeC%) = gB: CYLGC(nodeC%, nodeA%) = gB
    CYLGC(nodeA%, nodeB%) = gC: CYLGC(nodeB%, nodeA%) = gC
  
   END IF
  NEXT m%
  GCFLAG% = 0
 END IF

'__________________ End Alias Patch for ELECTN _______________________

 CALL GetData(a$, DEFT$, 2, "|")         'get defin name
 CALL StuffDefinition(DEFT$, acode%)     'and load defin'd parms.

 CALL GetData(a$, MOD$, 3, "|")          'get (mod) string
 
 IF TYPFLG% > 0 THEN
  CALL GetTyp(MOD$, acode%, TYP%)

  IF DBUG% THEN
   PRINT "TYPFLG%="; TYPFLG%
   PRINT "TYP%="; TYP%
   PRINT "MOD$="; MOD$
  END IF
 END IF

 CALL StuffMods(MOD$, acode%, -1)       'and modify parm set.

 CALL GetData(a$, CHAV1$, 4, "|")       'get connection field
 CALL GetData(CNECT$(acode%), CEXP1$, 1, "|")
 IF DBUG% AND CHAV1$ <> "" THEN
  PRINT "Calling TotalConnect with CHAV$="; CHAV1$
  PRINT "                          CEXP$="; CEXP1$
  PRINT "                         CNECT$="; CNECT$(acode%)
 END IF                                 'and make connection.
 CALL TotalConnect(CHAV1$, CEXP1$, CRET1$, cname$, TARG$, SW$, 1)

 CALL GetData(a$, CHAV2$, 5, "|")       'get second connection field
 CALL GetData(CNECT$(acode%), CEXP2$, 2, "|")
 IF CEXP2$ <> "-1" THEN
  CALL TotalConnect(CHAV2$, CEXP2$, CRET2$, cname$, TARG$, SW$, 2)
 ELSE
  CRET2$ = ""                           'and make connection, if any.
 END IF
 
 '________________ Beginning of ALIAS section  ______________________
 '
 ' These codes are not recognized by synetsim, but rather they are
 ' interpreted by the compiler and transformed into synetsim codes.
 ' SPHERE and CYL are straightforward geometrical compartments, while
 ' INFCYL is a means of inserting a conductance into another compartment.
 ' The value of the conductance is equal to the input impedance of an
 ' infinite cylinder as specified in a given netlist.

 IF COD$(acode%) = "SPHERE" THEN
  diam = VAL(TMPRM$(1))                 'in um
  rhom = VAL(TMPRM$(2))                 'in ohms-cm2
  fold = VAL(TMPRM$(3))                 'dimensionless
    rp = VAL(TMPRM$(4))                 'in millivolts

  diam = diam * .0001                   'converts um to cm
    sa = pi * diam * diam * fold        'in cm2
     C = sa * cunit                     'in uF
   
    GL = sa / (rhom * .000001)         'in umho
 GAMMA = 1 / (rhom * .001)             'in mmho / cm2
     
  MOD$ = "(C=" + STR$(C) + " RP=" + STR$(rp)
  MOD$ = MOD$ + " GL=" + STR$(GL) + " GAMMA=" + STR$(GAMMA) + ")"

  CALL FormatNumbers(MOD$)
 
  CALL StuffDefinition("", code%)       'to set up tmprm array
  CALL StuffMods(MOD$, code%, 0)        'to insert calculated parms
 END IF
  
 IF COD$(acode%) = "CYL" THEN
  length = VAL(TMPRM$(2))               'in cm
    diam = VAL(TMPRM$(3))               'in cm
    rhom = VAL(TMPRM$(4))               'in ohms-cm2
    rhoi = VAL(TMPRM$(5))               'in ohms/cm
    fold = VAL(TMPRM$(6))               'dimensionless
      rp = VAL(TMPRM$(7))               'in mV

  length = length * .0001               'um to cm
    diam = diam * .0001                 'um to cm
      sa = pi * diam * fold * length    'in cm2
       C = sa * cunit                   'in uF
      gC = (pi * diam * diam) / (4! * rhoi * .000001 * length)'in umho

      GL = sa / (rhom * .000001)        'in umho
   GAMMA = 1 / (rhom * .001)            'in mmho / cm2
 
  'The array CYLGC() will be full before any ELECTN connections
  'are met by the second-pass compilation.
  CYLGC(cmpt%, cmpt%) = gC * 2          'store 1/2 resistance
  
  MOD$ = "(C=" + STR$(C) + " RP=" + STR$(rp)
  MOD$ = MOD$ + " GL=" + STR$(GL) + " GAMMA=" + STR$(GAMMA) + ")"
  
  CALL FormatNumbers(MOD$)              'Compartment parameters...
  CALL StuffDefinition("", code%)       'set up tmprm$ array
  CALL StuffMods(MOD$, code%, 0)        'and insert calculated parms.
END IF

IF COD$(acode%) = "INFCYL" THEN
    diam = VAL(TMPRM$(1))               'in cm
    rhom = VAL(TMPRM$(2))               'in ohms-cm2
    rhoi = VAL(TMPRM$(3))               'in ohms-cm
    fold = VAL(TMPRM$(4))               'dimensionless
    rp = VAL(TMPRM$(5))                 'in mV

    diam = diam * .0001                 'um to cm
    GINF = SQR((pi * pi * diam * diam * diam * fold) / (4 * rhom * rhoi))
    GINF = GINF * 1000000!              'in umho
                       
  ALIAS$ = NSORT$(I%)       'Find COND and insert conductance value GINF
  CALL Trim(ALIAS$)         'using !ALIAS notation as a guide.
  ALIAS$ = "!" + ALIAS$
  DP% = 1
  WHILE INSTR(ntname$(DP%), ALIAS$) = 0
   DP% = DP% + 1
  WEND

  SP% = INSTR(ntname$(DP%), " ")
  lh$ = LEFT$(ntname$(DP%), SP% - 1)
  rh$ = RIGHT$(ntname$(DP%), LEN(ntname$(DP%)) - SP%)
  MOD$ = "GCOND=" + STR$(GINF) + " VCOND=" + STR$(rp)
  CALL FormatNumbers(MOD$)
  ntname$(DP%) = lh$ + MOD$ + rh$
  GOTO SkipWrite                        'This alias doesn't directly
END IF                                  'write to .PRM file.

IF COD$(acode%) = "COND" THEN           'final INFCYL patch
 SP% = INSTR(ntname$(I%), "!")
 IF SP% <> 0 THEN
  CALL PRMPointer("GCOND=?", acode%, PP%)
  GINF = VAL(TMPRM$(PP%))
  gC = CYLGC(cmpt%, cmpt%)
  IF gC = 0 THEN                         'not a cylinder-type cmpt.
   Geff = GINF
  ELSE                                   'else take series combo of G's
   Geff = GINF * gC / (GINF + gC)
  END IF
  TMPRM$(PP%) = STR$(Geff)
 END IF
END IF
'___________  end of ALIAS section  ________________________________
 
' Insertion of synetsim branch numbers, compartment numbers, cell
' numbers, cell names, etc.  These are all functions of netlist
' structure, rather than functions of the individual netlist items.

 K$ = "K%=" + STR$(K%)
 CP$ = " CP%=" + STR$(cmpt%)
 CL$ = " CELL%=" + STR$(cell%)
 CLL$ = " CELL$=" + cname$
  
 IF COD$(code%) = "POOL" THEN
  CALL GetData(a$, PN$, 1, "|")
  IF INSTR(PN$, "POOL/") = 0 THEN
   PN$ = ""                     'if the pool has a switch,
  ELSE
   PN$ = RIGHT$(PN$, LEN(PN$) - INSTR(PN$, "POOL/") - 3)
  END IF                        'make that the pool name, and
  DFT$ = RIGHT$(DEFT$, LEN(DEFT$) - INSTR(DEFT$, "POOL/") - 4)
  PN$ = " XNAME$=" + DFT$ + PN$ 'attach name to POOL in PRM file.
 END IF

 POOL% = 0
 OC% = VAL(MID$(NSORT$(I%), 5, 3))
 WHILE PPOS%(POOL% + 1) < OC% AND PPOS%(POOL% + 1) <> 0
  POOL% = POOL% + 1
 WEND                           'attach pool number.
 PLP$ = " POOL%=" + STR$(POOL%)

 MOD$ = K$ + CP$ + CL$ + CLL$ + PN$ + PLP$ + " " + CRET1$ + " " + CRET2$
 CALL FormatNumbers(MOD$)
 CALL Trim(MOD$)
 MOD$ = "(" + MOD$ + ")"

 ' At this point, MOD$ contains many things.  Some are needed, and
 ' some are not.  Obviously, an ELECTN connection doesn't need or
 ' use a POOL number.  Information which is not needed is simply
 ' ignored.
 
 CALL StuffMods(MOD$, code%, 0)

 IF COD$(code%) = "ELECTN" THEN
  CALL PRMPointer("GC=?", code%, PP%)
  IF TMPRM$(PP%) = "cylgc" THEN             'GC needs to be looked up.
   CALL PRMPointer(" CHR$(34) THEN G$ = CHR$(34) + G$
 IF RIGHT$(G$, 1) <> CHR$(34) THEN G$ = G$ + CHR$(34)

END SUB

'======================================================================
'                   Subroutines used by NET2PRM.BAS 
'======================================================================
'==========================================
SUB CheckConnect (CON$, SW$, DP%) STATIC
 'Examines a connection name, isolating a
 'switch if necessary, returning the code
 'number of connection in CODE%.  Switch is
 'returned in SW$, if it exists.
 '-----------------------------------------
 SHARED DBUG%
 IF DBUG% THEN PRINT "Connection given to CheckConnect as "; CON$
 SW$ = ""
 CALL CountSlash(CON$, NSL%, SP%)
 CALL GetData(CON$, code$, NSL% + 1, "/")
 CALL CodePointer(code$, DP%)
 IF DP% = -1 THEN
  CALL PushSwitch(CON$, SW$)
  CALL CountSlash(CON$, NSL%, SP%)
  CALL GetData(CON$, code$, NSL% + 1, "/")
  CALL CodePointer(code$, DP%)
  IF DP% = -1 THEN
   m$ = "Connection error... connection reads: " + CON$ + CHR$(13)
   m$ = m$ + "No such code " + code$
   CALL ErrorCheck(10, -1, m$)
  END IF
 ELSE
  SW$ = ""
 END IF

 IF DBUG% THEN
  PRINT "Successful connection made..."
  PRINT "CODE = "; COD$(DP%)
  PRINT "Switch = "; SW$
 END IF
END SUB

'===================================
SUB CheckForTyp (code%, DP%) STATIC
 'Returns DP%=-1 if no type is
 'required.  Returns DP%=PTYP%
 '(position in PTYP$) if a type
 'designator is required.
 '(i.e. PTYP$(1)="POOL" as it
 'is the first CODE requiring a type
 'designator as of 08/06/90)
 '----------------------------------
 SHARED MTYP%
 DP% = 1: I% = 1
 WHILE (COD$(code%) <> PTYP$(I%) AND DP% > 0)
  I% = I% + 1
  IF I% > MTYP% THEN
   DP% = -1
   I% = 1
  ELSE
   DP% = I%
  END IF
 WEND

END SUB

'==========================================
SUB CodeCount (code$, n%) STATIC
 'Returns N%, the number of branches
 'of code CODE$ currently processed.
 'When called from second pass, returns
 'the number of branches in the net.
 '-----------------------------------------
 CALL CodePointer(code$, DP%)
 IF DP% > 0 THEN
  n% = CODN%(DP%)
 ELSE
  n% = -1
 END IF
END SUB

'==========================================
SUB CodePointer (f$, DP%) STATIC
 'F$ is a (supposed) code name.
 'This routine checks for F$ in COD$(),
 'returning DP% as a pointer into COD$().
 'A negative value of DP% indicates no find.
 '------------------------------------------
 SHARED HIC%
 I% = 1: DP% = 1
 WHILE f$ <> COD$(I%) AND DP% > 0
  I% = I% + 1
  IF I% > HIC% THEN
   DP% = -1: I% = 1
  ELSE
   DP% = I%
  END IF
 WEND
END SUB

'======================================================
SUB CountSlash (f$, n%, s%) STATIC
 'Count /'s in F$ and return position of last one as S%
 '-----------------------------------------------------
 n% = 0
 FOR I% = 1 TO LEN(f$)
  IF MID$(f$, I%, 1) = "/" THEN n% = n% + 1: s% = I%
 NEXT I%
END SUB

'==============================================
SUB DEFPointer (D$, DP%) STATIC
 'Looks for D$ in DFNAME()$, returns DP% as a
 'pointer into DFNAME$() and DFPRM().
 'Failure is indicated by DP%=-1.
 '---------------------------------------------
 I% = 1: DP% = 1
 WHILE D$ <> DFNAME$(I%) AND DP% > 0
  I% = I% + 1
  IF I% > VAL(DFNAME$(0)) THEN
   DP% = -1
  ELSE
   DP% = I%
  END IF
 WEND
 IF DP% = -1 THEN
  PRINT "Unknown Definition: "; D$
 END IF

 CALL ErrorCheck(6, DP%, D$)
END SUB

'=====================================
SUB ErrorCheck (EMSG%, FLAG%, m$) STATIC
 'Checks FLAG% for -1 (fatal error)
 'returns otherwise
 '------------------------------------
 IF FLAG% = -1 THEN
   ON EMSG% GOTO 1, 2, 3, 4, 5, 6, 7, 8, 9, 10

1  EMSG$ = "Format error in netlist." + CHR$(13) + m$: GOTO DoneEC
2  EMSG$ = "Invalid codename " + m$ + " in netlist.": GOTO DoneEC
3  EMSG$ = "Invalid command " + m$ + " in netlist.": GOTO DoneEC
4  EMSG$ = "Invalid code definition " + m$ + " in netlist.": GOTO DoneEC
5  EMSG$ = "Invalid parameter " + m$ + " in netlist.": GOTO DoneEC
6  EMSG$ = "Undefined label " + m$ + " in netlist.": GOTO DoneEC
7  EMSG$ = "Unmatched parentheses in netlist." + CHR$(13) + m$: GOTO DoneEC
8  EMSG$ = "No cells specified in netlist.": GOTO DoneEC
9  EMSG$ = "Missing/invalid " + m$ + " connection.": GOTO DoneEC
10 EMSG$ = m$: GOTO DoneEC

DoneEC:
   PRINT EMSG$; CHR$(7)
   CLOSE #1
   END
  END IF
END SUB

'=========================================
SUB FixText (T$) STATIC
 'Convert to upper-case and eliminate tabs
 '----------------------------------------
 FOR n% = 1 TO LEN(T$)
  m% = ASC(MID$(T$, n%, 1))
  
  IF m% > 96 AND m% < 123 THEN
   m% = m% - 32             'see lower case as upper case
  END IF
  
  IF m% = 9 THEN
   m% = 32                  'see tabs as spaces
  END IF
   
  MID$(T$, n%, 1) = CHR$(m%)
 NEXT n%
END SUB

'============================================
SUB FormatNumbers (f$) STATIC
 'removes leading spaces from numbers found
 'in parameter listings
 '-------------------------------------------
 WHILE INSTR(f$, "= ") > 0
  s% = INSTR(f$, "= ")
  f$ = LEFT$(f$, s%) + RIGHT$(f$, LEN(f$) - s% - 1)
 WEND
END SUB

'=========================================
SUB FormFullName (CON$, SW$, cname$) STATIC
 'Adds cell and cmpt names to a connection
 '----------------------------------------
 CALL CountSlash(CON$, NSL%, SP%)
 IF NSL% = 0 THEN CON$ = cname$ + "/" + CON$
 IF NSL% = 1 THEN CON$ = LEFT$(cname$, INSTR(cname$, "/")) + CON$
 CON$ = CON$ + SW$
END SUB

SUB GetALine (a$)
 'get a line from the netlist file
 'or from queue.

 SHARED queue$
 IF queue$ = "" THEN
    LINE INPUT #1, a$
    CALL FixText(a$)
 ELSE
    a$ = queue$
    queue$ = ""
 END IF

END SUB

'=========================================
SUB GetBatchInfo (BFID$, B%) STATIC
 'Look at configuration file, get info
 'on .SBT translation table.
 '----------------------------------------
 OPEN "I", 1, BATDATA$
 DO                                     'first line is file format code
  LINE INPUT #1, BFID$                  'after all comments are ignored.
  CALL Trim(BFID$)
  CALL StripQuotes(BFID$)
 LOOP WHILE (BFID$ = "" OR LEFT$(BFID$, 1) = Cmnt$)
 FOR I% = 1 TO B%
  DO
   CALL GetCaps(a$)
   CALL Trim(a$)
  LOOP WHILE LEFT$(a$, 1) = Cmnt$
  SP% = INSTR(a$, "=")
  IF SP% = 0 THEN
   PRINT "Framing error in "; BATDATA$; "."; CHR$(7)
   PRINT "Unable to process batch file."
   END
  ELSE
   B$ = LEFT$(a$, SP% - 1)
   CALL Trim(B$)
   BNAME$(I%) = B$
   a$ = RIGHT$(a$, LEN(a$) - SP%)
  END IF
  P% = 0
  DO
    P% = P% + 1
    BPARM$(I%, P%) = a$
    CALL GetCaps(a$)
    CALL Trim(a$)
  LOOP UNTIL a$ = "END"
  BPARM$(I%, 0) = STR$(P%)
 NEXT I%
 CLOSE #1
END SUB

'=========================================
SUB GetBatchSize (B%, MAXP%) STATIC
 'Look at configuration file, get size of
 'batch translation information table.
 '----------------------------------------
 OPEN "I", 1, BATDATA$
 DO                                     'first line is file format code
  LINE INPUT #1, BFID$                  'after all comments are ignored.
  CALL Trim(BFID$)
  CALL StripQuotes(BFID$)
 LOOP WHILE (BFID$ = "" OR LEFT$(BFID$, 1) = Cmnt$)
 WHILE NOT EOF(1)
  CALL GetCaps(C$)                       'Batch command name
  CALL Trim(C$)
  IF LEFT$(C$, 1) <> Cmnt$ AND C$ <> "" THEN 'If it's not a comment
   B% = B% + 1                           'count it as a command
   P% = 0
   WHILE C$ <> "END"
    CALL GetCaps(C$)
    CALL Trim(C$)
    P% = P% + 1                         'Another parameter
   WEND
   IF P% > MAXP% THEN MAXP% = P%
  END IF
 WEND
 CLOSE #1
END SUB

'==========================================
SUB GetCaps (T$) STATIC
 'Get a string from file#1, convert to caps
 '-----------------------------------------
 INPUT #1, T$
 CALL FixText(T$)
END SUB

'=====================================================
SUB GetData (a$, B$, n%, D$) STATIC
 'A$ is input to subroutine, a string to be parsed.
 'D$ is a delimiting character, usually a '|' or '/'
 'N% indicates which piece of data to extract from A$
 '   e.g. 1st, 2nd, 3rd item.
 'and B$ is the actual string in A$ which is returned.
 'This string is located between the (N%-1)th delimiter
 'and the (N%)th delimiter... the first delimiter or
 'initial character of A$ is assumed.
 '
 'This routine is non-destructive to A$.
 '-----------------------------------------------------
 Q% = 0
 f$ = a$ + D$
 FOR I% = 1 TO n%
  P% = Q% + 1
  Q% = INSTR(P%, f$, D$)
 NEXT I%
 IF Q% = 0 THEN
  B$ = "-1"
 ELSE
  B$ = MID$(f$, P%, Q% - P%)
 END IF
END SUB

'================================================================
SUB GetFileNames (NETFILE$, PRMFILE$, MSTFILE$, BATFILE$, SW$) STATIC
 'Input .NET .PRM .MST and .SBT filenames
 '---------------------------------------------------------------
 CM$ = COMMAND$
 CALL Trim(CM$)

 IF CM$ <> "" THEN                      'first remove any switches...
  CALL FixText(CM$)
  SP% = INSTR(CM$, "/")
  IF SP% > 0 THEN
   EP% = INSTR(SP%, CM$, " ")
   IF EP% = 0 THEN EP% = LEN(CM$) + 1
   SW$ = MID$(CM$, SP% + 1, EP% - SP% - 1)
   CM$ = LEFT$(CM$, SP% - 1) + RIGHT$(CM$, LEN(CM$) - EP% + 1)
  END IF
 END IF

 CALL Trim(CM$)
 IF CM$ = "" THEN                       'then pluck filenames.
  PRINT
  PRINT "Usage: net2prm netfile [prmfile] [mstfile] [sbtfile]"
  PRINT
  PRINT "  where [prmfile], [mstfile], and [sbtfile], if omitted,"
  PRINT "  default to netfile."
  PRINT
  PRINT "  Extensions, if omitted, default to:"
  PRINT "   netfile.NET  prmfile.PRM  mstfile.MST  sbtfile.SBT"
  PRINT
  PRINT "Switches:"
  PRINT
  PRINT "  /d ... compile using SYNETSIM 3.2D or earlier format"
  PRINT "         (affects calculated conductances)"
  PRINT
  PRINT "         Default is compatibility with SYNETSIM 3.3.1 or"
  PRINT "         later, using conductance densities."
  PRINT
  END
 ELSE
  f% = 0
  WHILE CM$ <> ""
   f% = f% + 1
   CALL GetNextParm(find$, CM$)
   PHILE$(f%) = find$
   CALL Trim(CM$)
  WEND

  NETFILE$ = PHILE$(1)
  SP% = INSTR(NETFILE$, ".")
  IF SP% = 0 THEN
   FIRST$ = NETFILE$
   NETFILE$ = NETFILE$ + ".NET"
  ELSE
   FIRST$ = LEFT$(NETFILE$, SP% - 1)
  END IF

  FOR I% = 2 TO 4
   IF PHILE$(I%) = "" THEN PHILE$(I%) = FIRST$
  NEXT I%

  CALL MakeFileName(PRMFILE$, PHILE$(2), ".PRM")
  CALL MakeFileName(MSTFILE$, PHILE$(3), ".MST")
  CALL MakeFileName(BATFILE$, PHILE$(4), ".SBT")
 END IF
END SUB

'=======================================================
SUB GetFormatSize (PFID$, SHC%, HC%, HP%, MTYP%, PHD%) STATIC
 'Reads from file PRMDATA$ the necessary array sizes
 'also checks for proper file format.
 '------------------------------------------------------
 'MTYP% = number of codes using the 'type=' format (i.e. POOL, POOLX)
 ' PHD% = max number of 'types' found (i.e. POOLX has 7 types)
 ' SHC% = the number of codes used by synetsim
 '  HC% = the number of total codes (including aliases) found
 '  HP% = the max number of parameters found (i.e. TRIGR has about 30)

 SHC% = 0: HC% = 0: HP% = 0: PHD% = 0: MTYP% = 0: OLDC% = 0
 OPEN "I", 1, PRMDATA$
 DO
  LINE INPUT #1, PFID$
  CALL Trim(PFID$)
  CALL StripQuotes(PFID$)
 LOOP WHILE (PFID$ = "" OR LEFT$(PFID$, 1) = Cmnt$)
 WHILE NOT EOF(1)
  CALL GetCaps(C$)                        'should be code number
  CALL Trim(C$)
  IF LEFT$(C$, 1) <> "'" THEN             'or a comment.
   C% = VAL(C$)
   IF RIGHT$(C$, 1) = "*" THEN SHC% = C%  'last code recognized by
                                          ' synetsim is marked with *.
   IF C% <> 0 THEN
    CALL GetCaps(C$)                      'get code name
    IF C% <> OLDC% THEN                   'is this a new code number?
     OLDC% = C%
     BUMP% = -1
     IF C% > HC% THEN HC% = C%            'highest code found
    ELSE
     IF BUMP% THEN
      MTYP% = MTYP% + 1                   'if it's the second occurrence
      BUMP% = 0                           'of codenumber, it must have
     END IF                               'TYPE structure.  Increment TYPE.
    END IF
    P% = -1
    DO
     CALL GetCaps(P$)                      'count parameters
     P% = P% + 1
     IF P% > HP% THEN HP% = P%             'highest param number found
     IF INSTR(P$, "=") <> 0 THEN
      D% = VAL(RIGHT$(P$, LEN(P$) - INSTR(P$, "=")))
      IF D% > PHD% THEN PHD% = D%          'highest type number found
     END IF
    LOOP WHILE P$ <> "END"
   END IF
  END IF
 WEND
 CLOSE #1
END SUB

'=========================================
SUB GetMasterInfo (MIDD$, MPS%) STATIC
 'Look at configuration file, get info
 'on .MST file format.
 '----------------------------------------
 SHARED HIC%
 FOR I% = 1 TO HIC%      'set initial conditions for toxin flags
  TXFLG$(I%) = "-1"
 NEXT I%
 OPEN "I", 1, MSTDATA$
 DO
  LINE INPUT #1, MIDD$
  CALL Trim(MIDD$)
 LOOP WHILE (MIDD$ = "" OR LEFT$(MIDD$, 1) = Cmnt$)
 FOR I% = 1 TO MPS%
  INPUT #1, a$
  MNAME$(I%) = a$
  MVAL$(I%) = "0"
  IF RIGHT$(MNAME$(I%), 4) = "FILE" THEN
   MVAL$(I%) = "NONE"
  END IF
 NEXT I%
 CLOSE #1
END SUB

'========================================
SUB GetMasterSize (MPS%) STATIC
 'Look at configuration file, get size of
 '.MST file format.
 '---------------------------------------
 OPEN "I", 1, MSTDATA$
 MPS% = -1
 DO
  LINE INPUT #1, MIDD$
  CALL Trim(MIDD$)
 LOOP WHILE (MIDD$ = "" OR LEFT$(MIDD$, 1) = Cmnt$)
 DO
  INPUT #1, a$
  MPS% = MPS% + 1
 LOOP WHILE NOT EOF(1) AND a$ <> "END"
 CLOSE #1
END SUB

'=========================================================
SUB GetNextParm (f$, s$) STATIC
 'Sub to take leftmost data from SRCH$, up to first space.
 'This routine also strips leading spaces from both SRCH$
 'and FIND$, appending a trailing space to SRCH$ if needed.
 '
 'This routine is destructive to S$, and is used to process
 'S$ piece by piece.  F$ is the latest piece, so to speak.
 '---------------------------------------------------------
 CALL Trim(s$)

 IF s$ = "" THEN
  CALL GetALine(a$)     'get another line of text from netlist  
  CALL Trim(a$)
  IF LEFT$(a$, 1) = "+" THEN
    a$ = RIGHT$(a$, LEN(a$) - 1)      'continuation line
    s$ = a$
  ELSE
    CALL StoreALine(a$)     'else put it back, so to speak.
    s$ = ""
  END IF
 END IF

 CALL Trim(s$)
 s$ = s$ + " "

 spl% = INSTR(s$, " ")
 IF spl% = 0 THEN
  f$ = ""
 ELSE
  f$ = LEFT$(s$, spl% - 1)
  s$ = RIGHT$(s$, LEN(s$) - LEN(f$) - 1)
  WHILE LEFT$(s$, 1) = " "
   s$ = RIGHT$(s$, LEN(s$) - 1)
  WEND
 END IF
 WHILE RIGHT$(s$, 1) = " "
  s$ = LEFT$(s$, LEN(s$) - 1)
 WEND
END SUB

'========================================================
SUB GetParentheses (f$, s$) STATIC
 'If leftmost data in S$ is in parentheses, it is removed
 'and placed in F$.  Otherwise, S$ is untouched and F$ is
 'null upon return.
 '-------------------------------------------------------
 CALL Trim(s$)
 IF LEFT$(s$, 1) = "(" THEN

Try.again.with.more.text:
 
  spl% = INSTR(s$, ")")
  IF spl% = 0 THEN
    CALL GetALine(a$)
    CALL Trim(a$)
    IF LEFT$(a$, 1) = "+" THEN
        a$ = RIGHT$(a$, LEN(a$) - 1)
        CALL Trim(a$)
        s$ = s$ + " " + a$
        GOTO Try.again.with.more.text
    ELSE
        CALL StoreALine(a$)
        f$ = "-1"
    END IF
  ELSE
    f$ = LEFT$(s$, spl%)
    s$ = RIGHT$(s$, LEN(s$) - spl%)
    WHILE LEFT$(s$, 1) = " "
      s$ = RIGHT$(s$, LEN(s$) - 1)
    WEND
  END IF
 ELSE
  f$ = ""
 END IF
 WHILE RIGHT$(s$, 1) = " "
  s$ = LEFT$(s$, LEN(s$) - 1)
 WEND
END SUB

'============================================
SUB GetParmNames (HC%, HP%, MTYP%, PHID%) STATIC
 'Loads codes and parameters into arrays
 'from SYNETSIM parameter format file
 '-------------------------------------------
 OPEN "I", 1, PRMDATA$
 PTYP% = 0
 DO
  LINE INPUT #1, T$
  CALL Trim(T$)
  CALL StripQuotes(T$)
 LOOP WHILE (LEFT$(T$, 1) = Cmnt$ OR T$ = "")
 WHILE NOT EOF(1)
  INPUT #1, C$
  C% = VAL(C$)
  IF C% <> 0 THEN
   CALL GetCaps(cname$)
   IF COD$(C%) = "" THEN
    COD$(C%) = cname$
    BUMP% = -1
    TYP% = 1
   ELSE
    TYP% = TYP% + 1
    IF BUMP% THEN
     PTYP% = PTYP% + 1
     FOR P% = 0 TO VAL(PRM$(C%, 0))
      PPRM$(PTYP%, 1, P%) = PRM$(C%, P%)
     NEXT P%
     PCNECT$(PTYP%, 1) = CNECT$(C%)
     BUMP% = 0
    END IF
    PTYP$(PTYP%) = cname$
    IF COD$(C%) <> cname$ THEN
     m$ = "Error: Multiple code names for code" + STR$(C%) + CHR$(13)
     m$ = m$ + "Check " + PRMDATA$ + " for errors."
     CALL ErrorCheck(10, -1, m$)
    END IF
   END IF
   P% = 1: CNECT1$ = "": CNECT2$ = ""
   CALL GetCaps(PNAME$)
   DO
    IF LEFT$(PNAME$, 5) = "TYPE=" THEN
     GTYP% = VAL(RIGHT$(PNAME$, LEN(PNAME$) - INSTR(PNAME$, "=")))
     PNAME$ = "TYPE"
     IF GTYP% <> TYP% THEN
      m$ = "Warning: Missing/invalid TYPE specifications in " + PRMDATA$ + CHR$(13)
      m$ = m$ + "Check " + PRMDATA$ + " for errors."
      CALL ErrorCheck(10, -1, m$)
     END IF
    END IF
    IF LEFT$(PNAME$, 1) = "<" THEN
     IF LEFT$(PNAME$, 2) = "<<" THEN
      CNECT2$ = "|" + RIGHT$(PNAME$, LEN(PNAME$) - 2)
     ELSE
      CNECT1$ = RIGHT$(PNAME$, LEN(PNAME$) - 1)
     END IF
     CNECT$ = CNECT1$ + CNECT2$
     IF cname$ = PTYP$(PTYP%) THEN
      PCNECT$(PTYP%, TYP%) = CNECT$
     ELSE
      CNECT$(C%) = CNECT$
     END IF
    END IF

    IF cname$ = PTYP$(PTYP%) THEN
     PPRM$(PTYP%, TYP%, P%) = PNAME$
    END IF
    PRM$(C%, P%) = PNAME$
    P% = P% + 1
    CALL GetCaps(PNAME$)
   LOOP WHILE PNAME$ <> "END"
   IF cname$ = PTYP$(PTYP%) THEN
    PPRM$(PTYP%, TYP%, 0) = STR$(P% - 1)
   END IF
   PRM$(C%, 0) = STR$(P% - 1)       'store # of prms in zero pos.
  END IF
 WEND
 CLOSE #1
END SUB

'==================================
SUB GetTyp (MOD$, code%, TYP%) STATIC
 'For higher codes requiring a type
 'designator, find type and load
 'appropriate temporary set.
 '---------------------------------
 SHARED HIP%
 CALL CheckForTyp(code%, TYPFLG%)
 CALL PRMPointer("TYPE=?", code%, PP%)
 TYP% = VAL(TMPRM$(PP%))
 IF TYP% = 0 THEN
  SP% = INSTR(MOD$, "TYPE=")
  IF SP% = 0 THEN
   m$ = "Code " + COD$(code%) + " requires a type designation."
   PRINT m$
   PRINT "Assuming TYPE=1"
   TYP% = 1
   TMPRM$(PP%) = "1"
  ELSE
   TYP% = VAL(RIGHT$(MOD$, LEN(MOD$) - SP% - 4))
  END IF
 END IF
 CNECT$(code%) = PCNECT$(TYPFLG%, TYP%)
 FOR J% = 0 TO HIP%
  PRM$(code%, J%) = PPRM$(TYPFLG%, TYP%, J%)
 NEXT J%
END SUB

'=========================================================
SUB MakeConnect (CON$, cname$, count%, DP%, CCD%, KC%) STATIC
 'General purpose sub used in making netlist connections
 'CON$ is the connection found in the netlist.
 'CNAME$ is the name of the current compartment.
 'COUNT% is an integer containing the number of net items.
 'DP% is a pointer into the netlist to be used upon return.
 'CCD% is the code number of the connection field.
 '---------------------------------------------------------
 J% = 1: KC% = 1
 DO
  SCD% = VAL(MID$(NSORT$(J%), 3, 2))
  IF SCD% = CCD% THEN
   DP% = J%
   WHILE LEFT$(ntname$(J%), LEN(CON$)) <> CON$ AND DP% > 0
    J% = J% + 1
    KC% = KC% + 1
    IF J% > count% THEN
     DP% = -1
     PRINT "Can't find connection "; CON$
     PRINT "Connection ignored."; CHR$(7)
    ELSE
     DP% = J%
    END IF
   WEND
  ELSE
   J% = J% + 1
   IF J% > count% THEN
    DP% = -1
    PRINT "Can't find connection "; CON$
    PRINT "No "; COD$(CCD%); " branches exist in net."
    PRINT "Connection ignored."; CHR$(7)
    SCD% = CCD%
   END IF
  END IF
 LOOP UNTIL CCD% = SCD%

 IF DP% > 0 THEN
  IF MID$(ntname$(DP%), LEN(CON$) + 1, 1) = "/" THEN
   PRINT "Connection to "; CON$; " is ambiguous..."; CHR$(7)
   PRINT
  END IF
END IF
END SUB

'=========================================
SUB MakeFileName (f$, L$, R$) STATIC
 'F$ is final product
 'L$ is filename with or without extension
 'R$ is default extension
 '----------------------------------------
 SP% = INSTR(L$, ".")
 IF SP% > 0 THEN
  f$ = L$
 ELSE
  f$ = L$ + R$
 END IF
END SUB

'==============================================
SUB PRMPointer (f$, code%, DP%) STATIC
 'F$ is of the form "GBAR=10.2" or PNAME$=PVAL$
 'This routine checks PNAME$ against the arrays
 'of legal parameters.
 'It returns DP% as a pointer into PRM$(),
 'and the value PVAL$ as a string in F$.
 'A negative value of DP% signals a fatal error.
 '----------------------------------------------
 I% = 1: DP% = 1
 IF INSTR(f$, "=") = 0 THEN
  DP% = -1
 ELSE
  P$ = LEFT$(f$, INSTR(f$, "=") - 1)
  f$ = RIGHT$(f$, LEN(f$) - LEN(P$) - 1)
 END IF
 WHILE P$ <> PRM$(code%, I%) AND DP% > 0
  I% = I% + 1
  IF I% > VAL(PRM$(code%, 0)) THEN
   DP% = -1: I% = 1
  ELSE
   DP% = I%
  END IF
 WEND
END SUB

'=========================================
SUB ProcessBatch (BATFILE$) STATIC
 'Interpret and write batch (.SBT) file
 '----------------------------------------
 SHARED HIBL%, HIBP%, MPS%
 OPEN "O", 3, BATFILE$
 L% = 1
 s$ = BATCH$(L%)
  CALL GetNextParm(find$, s$)             'name of batch command
  DO
   IF LEFT$(s$, 1) <> "(" THEN
    PRINT "Syntax error in .BATCH command."
    PRINT "Check netlist for errors."
    PRINT
    PRINT "S$="; s$
    END
   ELSE
    s$ = RIGHT$(s$, LEN(s$) - 1)          'remove (
    B% = 1
    WHILE find$ <> BNAME$(B%)             'check for valid item
     B% = B% + 1
     IF B% > HIBL% THEN
      PRINT "Invalid .BATCH command.  Check to see that netlist"
      PRINT "data matches with items listed in "; BATDATA$; "."; CHR$(7)
      END
     END IF
    WEND
    FOR I% = 0 TO HIBP%
     BTEMP$(I%) = BPARM$(B%, I%)          'load temp array
    NEXT I%
    'begin parsing, continue until matching parenthesis is found
    DO
     IF s$ = "" THEN
      L% = L% + 1
      s$ = BATCH$(L%)
     END IF

     CALL GetNextParm(find$, s$)
     CALL FixText(find$)

     SP% = INSTR(find$, "=")
     IF SP% = 0 THEN
      PRINT "Syntax error in .BATCH command line.  "
      PRINT "Couldn't find '=' in parameter specifications."; CHR$(7)
      END
     ELSE
      PNAME$ = LEFT$(find$, SP% - 1)
      CALL Trim(PNAME$)
      PVAL$ = RIGHT$(find$, LEN(find$) - SP%)
      IF RIGHT$(PVAL$, 1) = ")" THEN
       PVAL$ = LEFT$(PVAL$, LEN(PVAL$) - 1)
       s$ = ")" + s$
      END IF
     END IF
     P% = 1
     WHILE PNAME$ <> BTEMP$(P%)            'check for valid item
      P% = P% + 1
      IF P% > HIBP% THEN
       PRINT "Invalid .BATCH parameter "; PNAME$; ".  Check to see that netlist"
       PRINT "data matches with items listed in "; BATDATA$; "."; CHR$(7)
       END
      END IF
     WEND

     IF PNAME$ = "FLAG" THEN
      IF PVAL$ = "ON" THEN
       PVAL$ = "-1"
      ELSEIF PVAL$ = "OFF" THEN
       PVAL$ = "0"
      ELSE
       PRINT "Warning! Batch flags should be 'ON' or 'OFF' only."
       PRINT "Flag "; PVAL$; " is set to OFF."; CHR$(7)
       PRINT
       PVAL$ = "0"
      END IF

     ELSEIF PNAME$ = "CODENAME" THEN
      CALL CodePointer(PVAL$, DP%)
      CALL ErrorCheck(2, DP%, "(.BATCH) " + PVAL$)
      PVAL$ = STR$(DP%)

     ELSEIF INSTR("POOL SPKFLG CMPT", PNAME$) <> 0 THEN
      CALL TotalConnect(PVAL$, PNAME$, CRET$, "", TARG$, SW$, 0)
      DP% = INSTR(CRET$, "=")
      PVAL$ = STR$(VAL(RIGHT$(CRET$, LEN(CRET$) - DP%)))

     ELSEIF PNAME$ = "TARGET" THEN
      CALL TotalConnect(PVAL$, PNAME$, CRET$, "", TARG$, SW$, 0)
      PVAL$ = ""
      FOR I% = 1 TO 3
       DP% = INSTR(CRET$, "=")
       CRET$ = RIGHT$(CRET$, LEN(CRET$) - DP%)
       P$ = STR$(ABS(VAL(CRET$)))
       CALL Trim(P$)
       PVAL$ = PVAL$ + P$ + ","
      NEXT I%
      PVAL$ = LEFT$(PVAL$, LEN(PVAL$) - 1)

     ELSE
      REM PVAL$ represents a valid parameter in all other cases.
     END IF
     CALL Trim(PVAL$)
     BTEMP$(P%) = PVAL$
     CALL Trim(s$)
    LOOP UNTIL LEFT$(s$, 1) = ")"
    s$ = LEFT$(s$, LEN(s$) - 1)

    FOR I% = 1 TO (VAL(BTEMP$(0)) - 1)
     CALL Trim(BTEMP$(I%))
     PRINT #3, BTEMP$(I%); ",";
    NEXT I%
    PRINT #3, BTEMP$(VAL(BTEMP$(0)))
   END IF

   CALL Trim(s$)
   IF s$ = "" THEN
    L% = L% + 1
    s$ = BATCH$(L%)
   END IF

   CALL GetNextParm(find$, s$)
  LOOP UNTIL find$ = ".ENDBATCH"
  PRINT #3, ENDBATCH$
  CLOSE #3
 END SUB

'==========================================
SUB PushSwitch (f$, s$) STATIC
 'moves the /x switch from end of F$ to
 'beginning of S$, leaving F$ with a code
 'name and S$ with the switch and other
 'parameters.  If no switch exists, the
 'strings are unchanged.
 '-----------------------------------------
 CALL CountSlash(f$, n%, ssl%)
 IF n% <> 0 THEN
  s$ = RIGHT$(f$, LEN(f$) - ssl% + 1) + " " + s$
  f$ = LEFT$(f$, ssl% - 1)
 END IF
 CALL Trim(s$)
END SUB

'======================================
SUB ReadBatch (s$) STATIC
 'read .BATCH to .ENDBATCH from netlist
 'and store it in the array BATCH$
 '-------------------------------------
 SHARED MPS%, BATFILE$
 IF VAL(BATCH$(0)) = 0 THEN
  I% = 1
  WHILE MNAME$(I%) <> "BATFILE" AND I% > 0
   I% = I% + 1
   IF I% > MPS% THEN
    PRINT "Unable to find BATFILE placement in .MST configuration."
    PRINT "Writing .SBT file, omitting information from .MST file."
    PRINT CHR$(7)
    I% = -1
   END IF
  WEND
  IF I% > 0 THEN MVAL$(I%) = BATFILE$
  B% = 1
 ELSE
  B% = VAL(BATCH$(0)) + 1
 END IF
 DO
  CALL Trim(s$)
  IF s$ <> "" THEN
   IF LEFT$(s$, 1) <> Cmnt$ THEN
    BATCH$(B%) = s$
    B% = B% + 1
    IF B% > BatchSize% THEN
     PRINT ".BATCH information exceeds allowable size."
     PRINT "Increase parameter BatchSize% and recompile NET2PRM."; CHR$(7)
     END
    END IF
   END IF
  END IF
  IF EOF(1) THEN
   PRINT ".BATCH without .ENDBATCH in netlist."; CHR$(7)
   PRINT "Unable to continue compilation."
   END
  END IF
  LINE INPUT #1, s$
 LOOP UNTIL s$ = ".ENDBATCH"
 BATCH$(B%) = s$
 BATCH$(0) = STR$(B% - 1)
END SUB

'=========================================
SUB ReadBlock (s$) STATIC
 'Reads code names to be blocked from
 'master file selection.
 '----------------------------------------
 SHARED HIC%
 s$ = RIGHT$(s$, LEN(s$) - 1)
 DO
  CALL GetNextParm(f$, s$)
  code% = 2: DF% = 2
  IF RIGHT$(f$, 1) = ")" THEN
   G$ = LEFT$(f$, LEN(f$) - 1)
  ELSE
   G$ = f$
  END IF
  WHILE G$ <> COD$(code%) AND DF% > 0
   code% = code% + 1
   IF code% > HIC% THEN
    DF% = -1
   ELSE
    DF% = code%
   END IF
  WEND
  CALL ErrorCheck(2, DF%, G$)
  TXFLG$(code%) = "BLOCK"
 LOOP UNTIL RIGHT$(f$, 1) = ")"
END SUB

'=================================
SUB ReadDefinition (srch$) STATIC
 'Loads information from a .DEFINE
 'statement into the DFPRM array.
 '--------------------------------
 SHARED HIC%
 count% = VAL(DFNAME$(0)) + 1
 DFNAME$(0) = STR$(count%)
 CALL GetNextParm(find$, srch$)
 
 CALL CodePointer(find$, code%)        'Get code number
 CALL ErrorCheck(4, code%, find$)         'and make sure it's valid.
 
 CALL CheckForTyp(code%, TYPFLG%)
 IF TYPFLG% > 0 THEN
  SP% = INSTR(srch$, "TYPE=")
  IF SP% = 0 THEN
   PRINT ".DEFINE "; srch$
   PRINT
   PRINT "Error in .DEFINE statement:"
   PRINT " Codes requiring TYPE designators (i.e. POOL and POOLX)"
   PRINT " must include that TYPE designator in their .DEFINition."
   PRINT "Assuming TYPE=1"
   PRINT
   TYP% = 1
  ELSE
   TYP% = VAL(RIGHT$(srch$, LEN(srch$) - SP% - 4))
  END IF
  FOR P% = 0 TO VAL(PPRM$(TYPFLG%, TYP%, 0))
   PRM$(code%, P%) = PPRM$(TYPFLG%, TYP%, P%)
  NEXT P%
 END IF
 
 CALL GetNextParm(find$, srch$)
 
 DFNAME$(count%) = COD$(code%) + "/" + find$
 IF LEFT$(srch$, 1) <> "(" THEN CALL ErrorCheck(1, -1, a$)
 srch$ = RIGHT$(srch$, LEN(srch$) - 1)
 DO
  CALL GetNextParm(find$, srch$)
  PNAME$ = LEFT$(find$, INSTR(find$, "="))
  CALL PRMPointer(find$, (code%), PP%)
  CALL ErrorCheck(5, PP%, PNAME$)
  DFPRM(count%, PP%) = VAL(find$)

  IF srch$ = "" AND RIGHT$(find$, 1) <> ")" THEN
   LINE INPUT #1, srch$                      'get a new one
   CALL FixText(srch$)
   IF LEFT$(srch$, 1) <> "+" THEN CALL ErrorCheck(1, -1, srch$)
   DO
    srch$ = RIGHT$(srch$, LEN(srch$) - 1)
   LOOP WHILE LEFT$(srch$, 1) = " "
  END IF
 LOOP WHILE RIGHT$(find$, 1) <> ")"
 DFPRM(count%, 0) = VAL(PRM$(code%, 0))    'store # of parms in 0 pos.
END SUB

'=========================================
SUB ReadMaster (s$) STATIC
 'Loads information from a .MASTER state-
 'ment into the MVAL$ array.
 '----------------------------------------
 SHARED MPS%
 s$ = RIGHT$(s$, LEN(s$) - 1)
 DO
  CALL GetNextParm(f$, s$)
  'Find parameter name and thus number
  I% = 1: DP% = 1
  IF INSTR(f$, "=") = 0 THEN
   DP% = -1
  ELSE
   P$ = LEFT$(f$, INSTR(f$, "=") - 1)
   f$ = RIGHT$(f$, LEN(f$) - LEN(P$) - 1)
  END IF
  WHILE P$ <> MNAME$(I%) AND DP% > 0
   I% = I% + 1
   IF I% > MPS% THEN
    DP% = -1: I% = 1
   ELSE
    DP% = I%
   END IF
  WEND

  CALL ErrorCheck(9, DP%, P$)
  MVAL$(DP%) = f$
  
  IF s$ = "" AND RIGHT$(f$, 1) <> ")" THEN
   LINE INPUT #1, s$                      'get a new one
   CALL FixText(s$)
   IF LEFT$(s$, 1) <> "+" THEN CALL ErrorCheck(1, -1, s$)
   DO
    s$ = RIGHT$(s$, LEN(s$) - 1)
   LOOP WHILE LEFT$(s$, 1) = " "
  END IF
 LOOP WHILE RIGHT$(f$, 1) <> ")"
 
 MVAL$(DP%) = LEFT$(MVAL$(DP%), LEN(MVAL$(DP%)) - 1)
END SUB

SUB RefreshInputText (s$)
 'make sure that s$ is current
 '

 CALL Trim(s$)
 IF s$ = "" THEN
    CALL GetALine(a$)
    CALL Trim(a$)
    IF LEFT$(a$, 1) = "+" THEN
        a$ = RIGHT$(a$, LEN(a$) - 1)
        CALL Trim(a$)
        s$ = a$
    ELSE
        CALL StoreALine(a$)
    END IF
 END IF

END SUB

'========================================================================
' General Purpose Subroutines / Library Functions which accompany NET2PRM
'========================================================================
'===========================================
SUB Sort (a$(), B$(), n%) STATIC
 'Sort A$, keeping B$ with it.
 '------------------------------------------
 s% = n% \ 2
 DO WHILE s% > 0
  FOR I% = s% TO n% - 1
   J% = I% - s% + 1
   FOR J% = (I% - s% + 1) TO 1 STEP -s%
    FOR K% = 0 TO 1
     Q = INSTR(a$(J% + K%), "|") - 1
     IF Q = -1 THEN Q = LEN(a$(J% + K%))
     C$(K%) = LEFT$(a$(J% + K%), Q)
    NEXT K%
    IF C$(0) <= C$(1) THEN EXIT FOR
    SWAP a$(J%), a$(J% + s%)
    SWAP B$(J%), B$(J% + s%)
   NEXT J%
  NEXT I%
  s% = s% \ 2
 LOOP
END SUB

SUB StoreALine (a$)
 'take a line a$ that was removed from the netlist
 'and put it back.
 '
 SHARED queue$
 queue$ = a$
 
END SUB

'=============================
SUB StripQuotes (G$) STATIC
 'Remove quotes, if they exist
 '----------------------------
 IF LEFT$(G$, 1) = CHR$(34) THEN G$ = RIGHT$(G$, LEN(G$) - 1)
 IF RIGHT$(G$, 1) = CHR$(34) THEN G$ = LEFT$(G$, LEN(G$) - 1)

END SUB

'=======================================
SUB StuffDefinition (DEFT$, code%) STATIC
 'Put a defined set of parms into
 'the temporary array, to be
 'written to the PRM file
 '--------------------------------------
 SHARED HIP%
 
 IF DEFT$ = "" THEN
  FOR P% = 1 TO HIP%: TMPRM$(P%) = "0": NEXT P%
  TMPRM$(0) = PRM$(code%, 0)
 ELSE
  DEFT$ = COD$(code%) + "/" + DEFT$
  CALL DEFPointer(DEFT$, DP%)
  FOR P% = 0 TO DFPRM(DP%, 0)
   TMPRM$(P%) = STR$(DFPRM(DP%, P%))
  NEXT P%
 END IF
END SUB

'======================================
SUB StuffMods (MOD$, code%, ECHK%) STATIC
 'Modify tmprm parameter array with
 'the parameters in mod$
 '-------------------------------------
 IF MOD$ <> "" THEN
  MOD$ = RIGHT$(MOD$, LEN(MOD$) - 1)
  DO
   CALL GetNextParm(find$, MOD$)
   PNAME$ = LEFT$(find$, INSTR(find$, "=") - 1)
   CALL PRMPointer(find$, code%, PP%)
   IF PP% < 0 AND ECHK% THEN
    PRINT "Error in subroutine StuffMods."
    PRINT "PNAME$='"; PNAME$; "'"
    PRINT "Valid parameter names for "; COD$(code%); " are:"
    FOR J% = 1 TO VAL(PRM$(code%, 0))
     PRINT J%, PRM$(code%, J%)
     IF J% = 20 THEN
      PRINT " for more..";
      LINE INPUT "", FOO$
     END IF
    NEXT J%
    CALL ErrorCheck(10, -1, "")         'fatal error.
   END IF

   IF PP% > 0 THEN
    IF RIGHT$(find$, 1) = ")" THEN
     STUFF$ = LEFT$(find$, LEN(find$) - 1)
    ELSE
     STUFF$ = find$
    END IF
    TMPRM$(PP%) = STUFF$
   END IF
  LOOP WHILE RIGHT$(find$, 1) <> ")"
 END IF
END SUB

'==============================================================
SUB TotalConnect (CHAV$, CEXP$, CRET$, cname$, TARG$, SW$, n%) STATIC
 'This routine calls all other Connect subs.
 'It is also used for .BATCH lookups, as it finds CODE and
 'BRANCH numbers, parameter numbers for TARGETS, etc.
 'It takes care of connection field format checking, and
 'returns all necessary info in CRET$
 '-------------------------------------------------------------
 'CEXP$ = expected connection type
 'CHAV$ = connection found in netlist
 'CRET$ = the connection info returned to calling code
 'CCD%  = the code-number corresponding to the
 '        item in the connection field.
 SHARED count%
 n$ = STRING$(n%, "<")
 IF n% > 0 THEN
  T$ = "Connection "                    'called from main prog.
 ELSE
  T$ = ".BATCH label "                  'called from .BATCH processor.
 END IF
 CALL CodeCount("TRIGR", TRIG%)         'get number of TRIGRs in net.
 CALL CodeCount("SPIKE", SPIKE%)        'and number of SPIKEs.

 IF CEXP$ = "CMPT" THEN                 'CMPT connections
 CALL CountSlash(CHAV$, NSL%, SP%)
 IF NSL% = 0 THEN CHAV$ = LEFT$(cname$, INSTR(cname$, "/")) + CHAV$
  CHAV$ = CHAV$ + "|"
  CCD% = 1
  CALL MakeConnect(CHAV$, cname$, count%, DP%, CCD%, KC%)
  CRET$ = n$ + CEXP$ + "=" + STR$(KC%)

 ELSEIF CEXP$ = "SPKFLG" THEN           'SPKFLG connections
  
  IF LEFT$(CHAV$, 4) = "STIM" THEN
   HISTIM% = VAL(STIM$(0))
   STIM% = 0
   WHILE CHAV$ <> STIM$(STIM%)
    STIM% = STIM% + 1
    IF STIM% > HISTIM% THEN
     PRINT CHAV$; " assigned to SPKFLG"; TRIG% + SPIKE% + STIM%
     PRINT
     STIM$(STIM%) = CHAV$
     STIM$(0) = STR$(STIM%)
    END IF
   WEND
   KC% = TRIG% + SPIKE% + STIM%
  ELSE
   CALL CheckConnect(CHAV$, SW$, CCD%)

   IF INSTR(SPKFLG$, COD$(CCD%)) = 0 THEN
    m$ = T$ + CHAV$ + " is not a SPKFLG."
    CALL ErrorCheck(10, -1, m$)
   END IF
   
   CALL FormFullName(CHAV$, SW$, cname$)
   CALL MakeConnect(CHAV$, cname$, count%, DP%, CCD%, KC%)
   IF COD$(CCD%) = "SPIKE" THEN
    REM SPKFLG's are assigned to TRIGR first, then SPIKE.
    KC% = KC% + TRIG%
   END IF
  END IF
  CRET$ = n$ + CEXP$ + "=" + STR$(KC%)

 ELSEIF CEXP$ = "TARGET" THEN                   'Target connections
  CALL CountSlash(CHAV$, NSL%, SP%)
  CALL GetData(CHAV$, TARG$, NSL% + 1, "/")
  CHAV$ = LEFT$(CHAV$, LEN(CHAV$) - LEN(TARG$) - 1)
  CALL CheckConnect(CHAV$, SW$, CCD%)
  CALL FormFullName(CHAV$, SW$, cname$)
  CALL MakeConnect(CHAV$, cname$, count%, DP%, CCD%, KC%)
  IF TARG$ = "P" THEN
   IF COD$(CCD%) = "POOL" THEN
    CRET$ = n$ + CEXP$ + "=" + STR$(KC%) + " XBRN%=0 XPRM%=0"
   ELSE
    m$ = "Illegal modulation target: P is a reserved word."
    CALL ErrorCheck(10, -1, m$)
   END IF
  ELSE
   CALL PRMPointer(TARG$ + "=?", CCD%, PP%)
   CALL ErrorCheck(5, PP%, "target " + TARG$)
       
   NONMOD% = 0
   FOR J% = 1 TO PP% - 1
    J$ = PRM$(CCD%, J%)
    IF LEFT$(J$, 1) = "<" OR RIGHT$(J$, 1) = "%" OR INSTR(J$, "=") <> 0 THEN
     NONMOD% = NONMOD% + 1
    END IF
   NEXT J%
   PP% = PP% - NONMOD%

   CRET$ = n$ + CEXP$ + "=" + STR$(-CCD%) + " XBRN%=" + STR$(KC%) + " XPRM%=" + STR$(PP%)
   PRINT TARG$; " is targeted for ";
   IF n% > 0 THEN
    PRINT "modulation."
   ELSE
    PRINT "batch file adjustment."
   END IF
   PRINT
  END IF
 ELSEIF CEXP$ = "" THEN
  REM No Connect
  CRET$ = ""

 ELSE                                   'else it must be a regular code
  CALL CheckConnect(CHAV$, SW$, CCD%)
  CALL FormFullName(CHAV$, SW$, cname$)
  CALL MakeConnect(CHAV$, cname$, count%, DP%, CCD%, KC%)
  CRET$ = n$ + COD$(CCD%) + "=" + STR$(KC%)

 END IF
END SUB

'====================================
SUB Trim (G$) STATIC
 'removes leading and trailing spaces
 '-----------------------------------
 WHILE LEFT$(G$, 1) = " "
  G$ = RIGHT$(G$, LEN(G$) - 1)
 WEND
 WHILE RIGHT$(G$, 1) = " "
  G$ = LEFT$(G$, LEN(G$) - 1)
 WEND
END SUB

'===================================================================
SUB WriteMaster (MPS%, TITLE$, MIDD$, PRMFILE$, MSTFILE$, MSWITCH%) STATIC
 'Writes output to .MST file
 '------------------------------------------------------------------
 SHARED SHIC%
 IF MSWITCH% THEN
  PRINT "Writing master file "; TAB(25); MSTFILE$
  OPEN "O", 1, MSTFILE$
  WRITE #1, TITLE$               'Title
  WRITE #1, MIDD$                'SYNETSIM format code
  FOR I% = 1 TO MPS%
   IF MNAME$(I%) = "(TXFLGS)" THEN
    FOR J% = 2 TO SHIC%
     IF TXFLG$(J%) = "BLOCK" THEN TXFLG$(J%) = "-1"
     PRINT #1, TXFLG$(J%)
    NEXT J%
   ELSEIF MNAME$(I%) = "PRMFILE" THEN
    PRINT #1, LEFT$(PRMFILE$, INSTR(PRMFILE$, ".") - 1)
   ELSE
    PRINT #1, MVAL$(I%)
   END IF
  NEXT I%
 ELSE
  PRINT
  PRINT "Warning! No .MASTER information found in netlist."
  PRINT "         No .MST file has been written."; CHR$(7)
  PRINT
 END IF
 CLOSE #1
END SUB

'===============================
SUB WriteToPRMfile (code%) STATIC
 'Write a line to .PRM file
 '------------------------------
 PRINT #1, COD$(code%);             'print code name.
 PMS% = VAL(PRM$(code%, 0))         'number of parameters to output.
 
 'Special case for SYNAPSE with no facilitation
 IF COD$(code%) = "SYNAPSE" THEN
  CALL PRMPointer("TAUF=?", code%, PP%)
  IF VAL(TMPRM$(PP%)) = 0 THEN
   PMS% = PP%
  END IF
 END IF

 FOR P% = 1 TO PMS%
  a$ = TMPRM$(P%)
  CALL Trim(a$)
  IF INSTR(a$, "/") <> 0 THEN CALL AddQuotes(a$)
  PRINT #1, ","; a$;
 NEXT P%
 PRINT #1, ""           'CR/LF to start new line.
END SUB


###################################################################