PROCEDURE backupsyl;

      BEGIN (* backupsyl *)
      stgstack[topofstack].stgposition := lastcup;
      END (*backupsyl*);

    (* 2---------------2 *)

    PROCEDURE gettoken;

      VAR
        i  : integer;

      BEGIN (* gettoken *)
      WITH syl DO BEGIN

        IF extensions THEN BEGIN (* PascalP dependant code. *)
          lin[1] := ' '; moveto(lin[2], lin[1], alfalen); END
        ELSE (* Standard Pascal code *)
          FOR i := 1 TO succ(alfalen) DO lin[i] := ' ';

        len := 0;
        WITH stgstack[topofstack] DO BEGIN
          lastcup := stgposition;
          IF stgposition < 1 THEN
            writeln(' Empty token. TopOfStack = ',topofstack)
          ELSE IF stgposition < stgend THEN BEGIN
            IF topofstack = 0 THEN
              starttoken := lastcup;
            IF (stgtable[stgposition] = ' ') AND sigbl THEN
              WHILE (stgposition < stgend) AND
                    (stgtable[stgposition] = ' ') DO BEGIN
                len := succ(len);   lin[len] := ' ';
                stgposition := succ(stgposition); END
            ELSE BEGIN
 
              IF extensions THEN BEGIN (* PascalP dependant code. *)
                i := scanwhile(' ', stgtable[stgposition],
                          (* for *) stgend - stgposition);
                IF i > 0 THEN stgposition := pred(stgposition + i)
                ELSE stgposition := stgend; END
              ELSE  (* Standard Pascal code *)
                WHILE (stgposition < stgend) AND
                      (stgtable[stgposition] = ' ') DO
                  stgposition := succ(stgposition);

              stgtable[stgend] := ' ';
              lastcup := stgposition;
              IF topofstack = 0 THEN starttoken := stgposition;

              IF extensions THEN BEGIN  (* PascalP dependant code. *)
                i := pred(scanfor(' ', stgtable[stgposition], linlen));
                IF i > 0 THEN
                  moveto(lin[succ(len)], stgtable[stgposition], i);
                len := len + i; stgposition := stgposition + i; END
              ELSE (* Standard Pascal code *)
                WHILE (stgtable[stgposition] <> ' ') DO BEGIN 
                  len := succ(len);
                  lin[len] := stgtable[stgposition];
                  stgposition := succ(stgposition); END;

              END
            END;
          END;
        END;
      END (* gettoken *);

    (* 2---------------2 *)

    PROCEDURE getalfafromsyl(startat: integer; VAR a: alfa);

      VAR
        i, j  : integer;

      BEGIN (* getalfafromsyl *)
      a := alfablanks;
      WITH syl DO BEGIN
        j := startat; i := 0;
        REPEAT
          i := succ(i);
          a[i] := forceuppercase(lin[j]);
          j := succ(j);
        UNTIL (i = alfalen) OR (j > len); END;
      END (* getalfafromsyl *);

    (* 2---------------2 *)

    PROCEDURE lookupmac;

      VAR
        l    : alfa;
        t    : pmac;
        done : boolean;

      (* 3---------------3 *)

      PROCEDURE expmacro(t: pmac);

        VAR
          savpmac : pmac;
          savend  : integer;
          n       : 0..maxparms;

        BEGIN (* expmacro *)
        (* !!! DO this WITH a stack oriented allocation *)
        (* using stgmarker *)
        savpmac := t;
        IF t ^.np < maxparms THEN (* scan parms *)
          FOR n := t ^.np DOWNTO 1 DO BEGIN
            t := t ^.ma (* parm macro *);
            WITH t ^, stgstack[topofstack]  DO BEGIN
              savend := stgend;
              gettoken;
              stgend := stgposition;
              stacktomacro(lastcup, macrobegin, macroend);
              stgend := savend; END;
            END
        ELSE BEGIN (* rest OF line is parm *)
          t := t ^.ma;
          WITH t^, stgstack[topofstack] DO BEGIN
            stacktomacro(stgposition, macrobegin, macroend);
            stgposition := stgend; END;
          END;
        pushtext(savpmac);
        END (* expmacro *);

      (* 3---------------3 *)

      BEGIN (* lookupmacro *)
      getalfafromsyl(2, l);
      notmacro := true; t := maclstp; done := t = NIL;
      WHILE NOT done DO BEGIN
        IF l =  t^.nm THEN BEGIN
          done := true; notmacro := false;
          IF t^.on THEN
            error(9)  (* recursive macro call TO *)
          ELSE expmacro(t); END
        ELSE BEGIN
          t := t^.ma; done := t = NIL; END;
        END;
      END (* lookupmac *);

    (* 2---------------2 *)

    PROCEDURE getmacsym;

      BEGIN (* getmacsym *)
      gettoken;
      WHILE (syl.len = 0) AND (topofstack > 0) DO BEGIN
        (* !!! recover stack string space here *)
        IF stgstack[topofstack].stgbegin = succ(stgmarker) THEN
          stgmarker := stgstack[topofstack].stgend;
        topofstack := pred(topofstack);
        gettoken; END;
      END (* getmacsym *);

    (* 2---------------2 *)

    PROCEDURE getsym;

      VAR
        lineindex : integer;
        actuallen : integer;
        hash      : integer;
        fstlet,
        lstlet    : char;
        pin       : alfa;

      BEGIN (* getsym *)
      WITH syl DO BEGIN
        REPEAT
          getmacsym; notmacro := true;
          IF lin[1] = macchr THEN
            IF len > 1 THEN lookupmac;
        UNTIL notmacro;
        IF len = 0 THEN symtype := none
        ELSE IF (lin[1] = cmdchr) THEN BEGIN
          IF len = 1 THEN error(56) (* lone period *)
          ELSE IF (lin[2] IN ['0'..'9']) THEN symtype := word
          ELSE BEGIN
            symtype := command; cmdtype := notcmd;
            yes :=
                 ((len > 3) AND (forceuppercase(lin[2]) = 'N') AND
                 (forceuppercase(lin[3]) = 'O')) = false;
            getalfafromsyl(4 - 2 * ord(yes), pin);
            cmds[notcmd] := pin;
            actuallen := 10 - 5 * ord(pin[6] = ' ');
            WHILE (actuallen > 1) AND (pin[actuallen] = ' ') DO
              actuallen := pred(actuallen);
            fstlet := pin[1]; lstlet := pin[actuallen];
            IF charcategory[lstlet] = ucletter THEN
              IF charcategory[fstlet] = ucletter THEN BEGIN
                  hash := actuallen + letperfect[fstlet] +
                                            letperfect[lstlet];
                  IF hash <= maxhash THEN
                    IF pin = cmds[perfect[hash]] THEN
                      cmdtype := perfect[hash]; END;
            IF cmdtype = notcmd THEN error(10)  (* unknown command *);
            END;
          END
        ELSE IF (syl.lin[1] = varchr) AND
                (NOT (syl.lin[2] IN [' ', '0'..'9'])) THEN
          symtype := vars
        ELSE symtype := word; END;
      END (* getsym *);

    (* 2---------------2 *)

    PROCEDURE pushsyl (* VAR asyl: line *);

      VAR
        i  : integer;

      BEGIN (* pushsyl *)
      WITH asyl DO
        IF len > 0 THEN BEGIN
          IF lin[len] <> ' ' THEN BEGIN
            len := succ(len); lin[len] := ' '; END;
          IF topofstack = stackmax THEN error(57)
          ELSE topofstack := succ(topofstack);
          WITH stgstack[topofstack] DO BEGIN
            stgbegin := succ(stgmarker - len);
            stgposition := stgbegin;
            activemacro := NIL;
            stgend := pred(stgbegin + len);
            stgmarker := pred(stgbegin);
            IF freestgindx > stgmarker THEN BEGIN
              writeln(' String table overflow. ... halting.');
              terminate; END;
            FOR i := 1 TO len DO
              stgtable[pred(stgbegin + i)] := lin[i]; END;
          END;
      END (* pushsyl *);

    (* 2---------------2 *)

    FUNCTION getexp : integer;

      VAR
        exp  : integer;
        s    : sign;

      BEGIN (* getexp *)
      getsym;
      (* !!! check FOR space *)
      getnum(s, exp);
      IF s = minus THEN exp := - exp;
      getexp := exp
      END (* getexp *);

    (* 2---------------2 *)

    PROCEDURE lookupvar;

      VAR
        t  : alfa;

      BEGIN (* lookupvar *)
      getalfafromsyl(2, t);
      vid[tv] := t; varndx := 1;
      WHILE vid[varndx] <> t DO varndx := succ(varndx);
      END (* lookupvar *);

    (* 2---------------2 *)