-- 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