-- File: [Cherry]<Thyme>System>C03>spInput.mesa
-- Last editted by:
-- S. Chen, February 12, 1984  7:57 PM
-- Wilhelm April 6, 1982  9:59 AM, reformated by Barth and stored under
--   [Cherry]<Barth>Thyme>1.97> .
DIRECTORY spGlobals, spModelDefs, AltoDefs, CWF, Real, AbsAllocDefs;
spInput:  PROGRAM
  IMPORTS spGlobals, CWF, Real, AbsAllocDefs
  EXPORTS spGlobals, spModelDefs =
  BEGIN
    OPEN spGlobals;

    printString:  STRING = [256];

    gndNodeName:  PUBLIC namePtr;
    undefNode:    namePtr;

    cktRoot:     PUBLIC circuitNamePtr ← NIL;
    currentCkt:  circuitNamePtr ← NIL;


    ModelTablePtr:  TYPE = LONG POINTER TO ModelTableBlk;
    ModelTableBlk:  TYPE = RECORD[next:        ModelTablePtr,
                                  name:        LONG STRING,
                                  proc:        spGlobals.model,
                                  numArgs:     CARDINAL,
                                  numParms,
                                  numResults:  CARDINAL];
    ModelTable:  ModelTablePtr ← NIL;

    FuncTablePtr:  TYPE = LONG POINTER TO FuncTableBlk;
    FuncTableBlk:  TYPE = RECORD[next:      FuncTablePtr,
                                 name:      LONG STRING,
                                 proc:      spGlobals.function,
                                 numArgs:   CARDINAL,
                                 numParms:  CARDINAL];
    FuncTable:  FuncTablePtr ← NIL;

    EnterModels:  PUBLIC PROCEDURE[name:        LONG STRING,
                                   proc:        model,
                                   numArgs:     CARDINAL,
                                   numParms,
                                   numResults:  CARDINAL] =
      BEGIN
        new:  ModelTablePtr;

        new ← AbsAllocDefs.Allocate[SIZE[ModelTableBlk]];
        new↑ ← [ModelTable, name, proc, numArgs, numParms, numResults];
        ModelTable ← new
      END;

    EnterFunctions:  PUBLIC PROCEDURE[name:      LONG STRING,
                                      proc:      function,
                                      numArgs:   CARDINAL,
                                      numParms:  CARDINAL] =
      BEGIN
        new:  FuncTablePtr;

        new ← AbsAllocDefs.Allocate[SIZE[FuncTableBlk]];
        new↑ ← [FuncTable, name, proc, numArgs, numParms];
        FuncTable ← new
      END;

    findModel:  PROCEDURE[name:  LONG STRING]
                  RETURNS[model, CARDINAL, CARDINAL, CARDINAL] =
      BEGIN
        m:  ModelTablePtr;

        FOR m ← ModelTable, m↑.next UNTIL m = NIL DO
          IF LongEqualStrings[m↑.name, name] THEN 
            RETURN[m↑.proc, m↑.numArgs, m↑.numParms, m↑.numResults]
        ENDLOOP;
        error[501, FALSE];
        RETURN[NIL, 0, 0, 0]
      END;

    findFunc:  PROCEDURE[name:  LONG STRING]
                 RETURNS[function, CARDINAL, CARDINAL] =
      BEGIN
        f:  FuncTablePtr;

        FOR f ← FuncTable, f↑.next UNTIL f = NIL DO
          IF LongEqualStrings[f↑.name, name] THEN
            RETURN[f↑.proc, f↑.numArgs, f↑.numParms]
        ENDLOOP;
        error[502, FALSE];
        RETURN[NIL, 0, 0]
      END;


    enterName:  PROCEDURE RETURNS[newNamePtr:  namePtr] =
      BEGIN
        ns:  LONG STRING;

        newNamePtr ← searchName[newString, TRUE];
        IF newNamePtr = NIL THEN
          BEGIN
            newNamePtr ← makeName[currentCkt↑.names];
            ns ← makeLongString[newString.length];
            LongStringGetsString[ns, newString];
            newNamePtr↑.name ← ns;
            currentCkt↑.names ← newNamePtr
          END
        ELSE error[250];
        RETURN[newNamePtr]
      END;

    searchName:  PROCEDURE[n:  LONG STRING, oneLevel:  BOOLEAN]
                   RETURNS[np:  namePtr ← NIL] =
      BEGIN
        ckt:  circuitNamePtr ← currentCkt;
        lastName:  namePtr;

        UNTIL ckt = NIL DO
          np ← ckt↑.names;
          lastName ← NIL;
          UNTIL np = NIL DO
            IF LongEqualStrings[n, np↑.name] THEN GOTO found;
            lastName ← np;
            np ← np↑.srchLink
          ENDLOOP;
          IF oneLevel THEN EXIT;
          ckt ← ckt↑.father
        REPEAT
          found =>
            IF lastName # NIL THEN
              BEGIN
                lastName↑.srchLink ← np↑.srchLink;
                np↑.srchLink ← ckt↑.names;
                ckt↑.names ← np
              END
        ENDLOOP
      END;


    getNames:  PROCEDURE[new:  BOOLEAN] RETURNS[names:      namePtr ← NIL,
                                                nameCount:  CARDINAL ← 0] =
      BEGIN
        nPtr:  namePtr;

        UNTIL item # name DO
          nPtr ← IF new THEN enterName[] ELSE searchName[newString, TRUE];
          IF nPtr # NIL THEN
            BEGIN
              nPtr↑.nextName ← names;
              names ← nPtr
            END;
          nameCount ← nameCount + 1;
          next[];
          IF item # comma THEN EXIT ELSE next[];
          IF item # name THEN error[208]
        ENDLOOP
      END;

    getName:  PROCEDURE[new:  BOOLEAN] RETURNS[nPtr:  namePtr ← NIL] =
      BEGIN
        IF item # name THEN error[208]
        ELSE
          nPtr ← IF new THEN enterName[] ELSE searchName[newString, FALSE];
        IF nPtr = NIL THEN error[251];
        next[]
      END;

    variable:  PUBLIC PROCEDURE[context:  circuitNamePtr]
                        RETURNS[nPtr:  namePtr ← NIL] =
      BEGIN
        oldContext:  circuitNamePtr;

        IF context # NIL THEN
          BEGIN
            oldContext ← currentCkt;
            currentCkt ← context;
            nPtr ← searchName[newString, TRUE];
            currentCkt ← oldContext
          END
        ELSE nPtr ← searchName[newString, FALSE];
        IF nPtr = NIL THEN error[252]
        ELSE
          IF nPtr↑.nType # parmName AND
             nPtr↑.nType # nodeName AND
             nPtr↑.nType # conName  THEN error[221];
        next[]
      END;

    findNode:  PROCEDURE RETURNS[n:  namePtr ← undefNode] =
      BEGIN
        nName:  namePtr;

        nName ← getName[FALSE];
        IF nName # NIL THEN
          IF nName↑.nType # nodeName AND
             nName↑.nType # conName THEN error[222]
          ELSE n ← nName
      END;

    getFunction:  PROCEDURE[na, np: CARDINAL]
                    RETURNS[args:    argNames ← NIL,
                            actual:  expressionPtr ← NIL] =
      BEGIN
        index,
        index2:   CARDINAL ← 0;
        aname:    namePtr;
        newExpr:  expressionPtr;

        IF item = leftB THEN
          BEGIN
            next[];
            IF na > 0 THEN
              BEGIN
                args ← makeArgNames[na];
                UNTIL index = na DO
                  aname ← getName[FALSE];
                  args[index] ← aname;
                  IF aname # NIL THEN
                    IF aname↑.nType # conName AND
                       aname↑.nType # nodeName THEN error[222];
                  IF item = quote THEN
                    BEGIN
                      next[];
                      error[299]
                    END;
                  index ← index + 1;
                  IF item = comma THEN next[] ELSE EXIT
                ENDLOOP
              END;
            IF na = 0 OR item = vertical THEN
              BEGIN
                IF item = vertical THEN next[];
                UNTIL index2 = np DO
                  newExpr ← expression[];
                  newExpr↑.nextExpression ← actual;
                  actual ← newExpr;
                  index2 ← index2 + 1;
                  IF item = comma THEN next[] ELSE EXIT
                ENDLOOP
              END;
            IF item = rightB THEN next[] ELSE error[202,, TRUE]
          END;
        IF index # na THEN error[231];
        IF index2 # np THEN error[232]
      END;
              

    controlFunc:  PROCEDURE[b:  branchNamePtr] =
      BEGIN
        nptr:  namePtr;
        f:  functionNamePtr;
        na, np: CARDINAL;

        next[];
        IF item = name THEN
          BEGIN
            nptr ← searchName[newString, FALSE];
            IF nptr = NIL THEN
              BEGIN
                f ← LOOPHOLE[makeName[NIL]];
                f↑.forms ← functionName[,,,,];
                [f↑.functionProc, na, np] ← findFunc[newString];
                next[];
                f↑.branch ← b;
                b↑.controller ← f;
                [f↑.funcArgs, f↑.funcParms] ← getFunction[na, np];
                f↑.funcArgVec ← makeArgList[na]
              END
            ELSE
              WITH n:  nptr↑ SELECT FROM
                modelName =>
                  BEGIN
                    b↑.controller ← nptr;
                    next[];
                    IF item = leftB THEN next[] ELSE error[201,, TRUE];
                    IF item = number THEN
                      BEGIN
                        b↑.modelIndex ← Real.FixC[value];
                        IF value >= LENGTH[n.modelResults] THEN
                          error[233];
                        next[]
                      END
                    ELSE error[209];
                    IF item = rightB THEN next[] ELSE error[202,, TRUE]
                  END
              ENDCASE => error[223]
          END
        ELSE error[208]
      END;

    enterBranches:  PROCEDURE[bName:  branchNamePtr, key:  keys] =
      BEGIN
        pNode, nNode:  namePtr;
        kind:  elements;

        IF item = leftB THEN next[] ELSE error[201,, TRUE];
        pNode ← findNode[];
        IF item = comma THEN next[] ELSE error[200,, TRUE];
        nNode ← findNode[];
        IF item = rightB THEN next[] ELSE error[202,, TRUE];
        SELECT key FROM
          resKey => kind ← resistor;
          capKey => kind ← capacitor;
          indKey => kind ← inductor;
          vsKey  => kind ← vSource;
          isKey  => kind ← iSource
        ENDCASE => error[224, TRUE];
        IF pNode = nNode THEN error[241];
        IF bName # NIL THEN
           bName↑.forms ← branchName[kind, pNode, nNode, NIL, 0, NIL];

        IF item = equal THEN
          BEGIN
            next[];
            bName↑.valExpr ← expression[]
          END
        ELSE
          IF item = leftArrow THEN controlFunc[bName]
          ELSE error[205];
      END;

    enterModel:  PROCEDURE[mName:  modelNamePtr] =
      BEGIN
        na, np, nr:  CARDINAL;

        IF item = leftArrow THEN next[] ELSE error[210];
        IF item = name THEN
          BEGIN
            mName↑.forms ← modelName[,,,,,];
            [mName↑.modelProc, na, np, nr] ← findModel[newString];
            next[];
            [mName↑.modelArgs, mName↑.modelParms] ← getFunction[na, np];
            mName↑.modelResults ← makeArgList[nr];
            mName↑.modelArgVec  ← makeArgList[na];
            mName↑.modelOldArgVec  ← makeArgList[na];
          END
        ELSE error[208]
      END;

    circuitError:  PROCEDURE RETURNS[STRING] =
      BEGIN
        oldProc:  PROCEDURE[CHARACTER];

        printString.length ← 0;
        oldProc ← CWF.WriteToString[printString];
        printCircuitTree[currentCkt];
        [] ← CWF.SetWriteProcedure[oldProc];
        RETURN[printString]
      END;

    printCircuitTree:  PROCEDURE[c:  circuitNamePtr] =
      BEGIN
        IF c # NIL AND c↑.father # NIL THEN
          BEGIN
            printCircuitTree[c↑.father];
            CWF.WF1["%s.", c↑.name]
          END
      END;

    getNewParameters:  PROCEDURE RETURNS[plist:  parmNamePtr ← NIL,
                                         nparms:  CARDINAL ← 0] =
      BEGIN
        n:  namePtr;

        IF item = vertical THEN next[];
        UNTIL item # name DO
          n ← enterName[];
          next[];
          nparms ← nparms + 1;
          IF item = leftArrow THEN
            BEGIN
              ENABLE
                ErrorSignal =>
                  BEGIN
                    ErrorStrings[error, circuitError[], s];
                    n.forms ← parmName[FALSE, 0.0, plist];
                    GOTO badEnd
                  END;
                  
              next[];
              n.forms ← parmName[TRUE, eval[expression[]], plist]
            EXITS
              badEnd => NULL
            END
          ELSE n.forms ← parmName[FALSE, 0.0, plist];
          plist ← LOOPHOLE[n];
          IF item = comma THEN next[] ELSE EXIT;
          IF item # name THEN error[208]
        ENDLOOP;
      END;

    defineCircuit:  PROCEDURE[names:  namePtr, root:  BOOLEAN] =
      BEGIN
        exp:  expressionPtr;

        names↑.forms ← circuitName[NIL, NIL, 0, NIL, currentCkt, NIL];
        currentCkt ← LOOPHOLE[names];
        IF root THEN
          BEGIN
            cktRoot ← currentCkt;
            newString ← "Undefined";
            undefNode ← enterName[];
            undefNode↑.forms ← nodeName[];
            currentCkt↑.names ← NIL; 
            newString ← "Gnd";
            gndNodeName ← enterName[];
            gndNodeName↑.forms ← nodeName[];
            next[]
          END;
        IF item = leftB THEN
          BEGIN
            next[];
            IF ~root AND item # vertical THEN
              BEGIN
                [names, currentCkt↑.conCount] ← getNames[TRUE];
                currentCkt↑.fakeNodes ← names;
                UNTIL names = NIL DO
                  names↑.forms ← conName[];
                  names ← names↑.nextName
                ENDLOOP
              END;
            IF root OR item = vertical THEN
              [currentCkt↑.parms,] ← getNewParameters[];
            IF item = rightB THEN next[] ELSE error[202,, TRUE]
          END;
        IF item = name AND searchKey[] = assertsKey THEN
          BEGIN
            next[];
            IF item = leftB THEN
              BEGIN
                next[];
                DO
                  exp ← expression[];
                  exp↑.nextExpression ← currentCkt↑.assertions;
                  currentCkt↑.assertions ← exp;
                  IF item = comma THEN next[] ELSE EXIT
                ENDLOOP;
                IF item = rightB THEN next[] ELSE error[202,, TRUE]
              END
            ELSE error[201]
          END;
        IF item = equal THEN next[] ELSE error[205, TRUE, TRUE];
        IF item = leftC THEN next[] ELSE error[203, TRUE, FALSE];
        DO
          IF item = name THEN enterDefinition[];
          IF item = rightC OR item = eof THEN EXIT;
          IF item = semi THEN next[] ELSE error[206, TRUE, FALSE]
        ENDLOOP;
        currentCkt ←
 currentCkt↑.father;
        next[]
      END;

    getActualParameters:  PROCEDURE[ckt:  circuitNamePtr]
                            RETURNS[apList:  expressionPtr ← NIL] =
      BEGIN
        e:  expressionPtr;

        IF item = vertical THEN next[];
        DO
          IF item # name THEN GOTO nameErr;
          e ← assignExpr[ckt];
          e↑.nextExpression ← apList;
          apList ← e;
          IF item = comma THEN next[] ELSE EXIT
        REPEAT
          nameErr => error[208]
        ENDLOOP
      END;

    defCktInstance:  PROCEDURE[cn:  LONG STRING, iName:  namePtr] =
      BEGIN
        cktName:  namePtr;
        n:  namePtr;
        cons:  conLinkPtr ← NIL;
        cCnt:  CARDINAL ← 0;
        noConnections:  BOOLEAN;
        actuals:  expressionPtr ← NIL;

        cktName ← searchName[cn, FALSE];
        IF cktName # NIL THEN
          WITH c:  cktName↑ SELECT FROM
            circuitName =>
              BEGIN
                IF item = leftB THEN
                  BEGIN
                    next[];
                    noConnections ← c.conCount = 0;
                    IF ~noConnections THEN
                      WHILE item = name DO
                        n ← findNode[];
                        cons ← makeConLink[cons, n];
                        cCnt ← cCnt + 1;
                        IF item = comma THEN next[] ELSE EXIT
                      ENDLOOP;
                    IF noConnections OR item = vertical THEN
                        actuals ← getActualParameters[@c];
                    IF item = rightB THEN next[] ELSE error[202,, TRUE]
                  END;
                IF cCnt # c.conCount THEN error[260];
                iName↑.forms ← cktInstance[@c, cons, actuals] 
              END
          ENDCASE => error[225, TRUE]
        ELSE error[251, TRUE]
      END;

    enterDefinition:  PROCEDURE =
      BEGIN
        key:  keys;
        nameCount:  CARDINAL;
        names:  namePtr;
        s:  STRING = [256];
        explodeExpr:  expressionPtr ← NIL;

        [names, nameCount] ← getNames[TRUE];
        IF names = NIL THEN error[208];
        IF item # colon THEN error[207,, TRUE] ELSE next[];
        IF item = leftP THEN
          BEGIN
            explodeExpr ← expression[];
            IF names # NIL THEN names↑.expExpr ← explodeExpr;
            IF item # implies THEN error[215,, TRUE] ELSE next[]
          END;
        IF item = name THEN
          BEGIN
            key ← searchKey[];
            LongStringGetsString[s, newString];
            next[];
            IF key # nodeKey AND nameCount # 1 THEN error[261];
            SELECT key FROM
              nodeKey => 
                BEGIN 
                  IF names↑.expExpr # NIL THEN error[253];
                  UNTIL names = NIL DO 
                    names↑.forms ← nodeName[]; 
                    names ← names↑.nextName 
                  ENDLOOP; 
                END;
              resKey, capKey, indKey, vsKey, isKey => 
                enterBranches[LOOPHOLE[names], key];
              circuitKey =>
                BEGIN 
                  IF names↑.expExpr # NIL THEN error[253];
                  defineCircuit[names, FALSE];
                END;
              modelKey =>
                BEGIN 
                  IF names↑.expExpr # NIL THEN error[253];
                  enterModel[LOOPHOLE[names]]
                END;
            ENDCASE =>
              defCktInstance[s, names]
          END
        ELSE error[208, TRUE]
      END;

    input: PUBLIC PROCEDURE =
      BEGIN
        n:  namePtr;

        IF item # name OR searchKey[] # circuitKey THEN error[225];
        n ← makeName[NIL];
        n↑.name ← "Main Circuit";
        defineCircuit[n, TRUE]
      END;

    levelSpace:  PROCEDURE[level:  CARDINAL] =
      BEGIN
        UNTIL level = 0 DO
          CWF.WF0["   "];
          level ← level - 1
        ENDLOOP
      END;

    output:  PUBLIC PROCEDURE[ckt:  circuitNamePtr, level:  CARDINAL] =
      BEGIN
        cLink:  conLinkPtr;
        np:  namePtr;

        np ← ckt↑.names;
        UNTIL np = NIL DO
          levelSpace[level];
          CWF.WF1["%s", np↑.name];
          WITH n:  np↑ SELECT FROM
            nodeName => NULL;
            branchName =>
              BEGIN
                CWF.WF2[":  branch[%s, %s]",
                        n.posNode↑.name,
                        n.negNode↑.name]
              END;
            circuitName =>
              BEGIN
                CWF.WF0[":  circuit.*n"];
                output[@n, level + 1]
              END;
            conName => NULL;
            parmName =>
              BEGIN
                CWF.WF0[":  parameter"];
                IF n.default THEN CWF.WF1[" ← %13.5f", @n.dfltValue]
              END;
            cktInstance =>
              BEGIN
                CWF.WF1[":  %s[", n.of↑.name];
                cLink ← n.connections;
                UNTIL cLink = NIL DO
                  CWF.WF1["%s", cLink↑.namedNode↑.name];
                  cLink ← cLink↑.nextLink;
                  IF cLink # NIL THEN CWF.WF0[", "]
                ENDLOOP;
                CWF.WFC[']]
              END
          ENDCASE;
          np ← np↑.srchLink;
          CWF.WF0[".*n"]
        ENDLOOP
      END;
  END.
2/12/84:- 
  original: [Cherry]<Thyme>System>CSIM02>spInput.mesa
  modified to support oldArgVector