(1 . 4)(1 . 4)
------------------------------------------------------------------------------
-----------------------------------------------------------------------------
------------------------------------------------------------------------------
-- This file is part of 'Finite Field Arithmetic', aka 'FFA'.               --
--                                                                          --
(79 . 123)(79 . 253)
      -- After an Op, will contain position of NEXT op (if = to IP -> halt)
      IP_Next       : Tape_Positions;
      
      -- Types of Entry for the Control Stack:
      type Call_Types is (Invalid, Subroutines, Loops);
      
      -- Control Stack Entries:
      type Call is
         record
            Why : Call_Types := Invalid; -- Which call type?
            Ret : Tape_Positions;        -- The IP we must return to after it
         end record;
      
      -- Control Stack; permits bidirectional motion across the Tape:
      Control_Stack : array(ControlStack_Range) of Tape_Positions
        := (others => Tape_Positions'First);
      Control_Stack : array(ControlStack_Range) of Call;
      
      -- Current top of the Control Stack:
      CSP           : ControlStack_Range := ControlStack_Range'First;
      
      -- A Segment represents a particular section of Tape, for certain uses.
      type Segment is
         record
            -- The Tape Position of the FIRST Symbol on the Segment:
            L : Tape_Positions := Tape'First; -- Default: start of the Tape.
            
            -- The Tape Position of the LAST Symbol on the Segment:
            R : Tape_Positions := Tape'Last;  -- Default: end of the Tape.
         end record;
      
      -- Subtypes of Segment:
      subtype Sub_Names  is Segment; -- Subroutine Names
      subtype Sub_Bodies is Segment; -- Subroutine Bodies
      subtype Cutouts    is Segment; -- Cutout (see Ch.18 discussion)
      
      -- Represents a Subroutine defined on this Tape:
      type Sub_Def is
         record
            Name    : Sub_Names;  -- Name of the Subroutine.
            Payload : Sub_Bodies; -- Body of the Subroutine.
         end record;
      
      -- Subroutine Table. Once defined, Subs may not be erased or altered.
      Subs          : array(Subroutine_Table_Range) of Sub_Def;
      
      -- Position of the most recently-defined Subroutine in Subs :
      STP           : Subroutine_Table_Range := Subs'First;
      
      -- Registers:
      subtype RegNames is Character range 'g' .. 'z';
      type RegTables is array(RegNames range <>) of FZ(1 .. Wordness);
      
      -- Ordinary Register Set (accessed if no Cutout, or when ABOVE it)
      Registers     : RegTables(RegNames'Range);
      
      -- Carry/Borrow Flag:
      -- 'Cutout' Register Set (accessed only if IP is IN or BELOW the Cutout)
      CO_Registers  : RegTables(RegNames'Range);
      
      -- Carry/Borrow Flag set by certain arithmetical Ops:
      Flag          : WBool        := 0;
      
      -- Odometer:
      Ticks         : Natural      := 0;
      
      -- The current levels of the three types of nestedness:
      -- The current levels of the three types of nestable Block:
      QuoteLevel    : Natural      := 0;
      CommLevel     : Natural      := 0;
      CondLevel     : Natural      := 0;
      
      -- Whether we are currently inside a Proposed Subroutine Name:
      SubNameMode   : Boolean      := False;
      
      -- Whether we are currently inside a Proposed Subroutine Body:
      SubBodyMode   : Boolean      := False;
      
      -- Current levels of nestable Blocks when reading a Subroutine Body:
      SubQuoteLevel : Natural      := 0;
      SubCommLevel  : Natural      := 0;
      SubCondLevel  : Natural      := 0;
      
      -- Scratch for a Subroutine being proposed for lookup or internment:
      Proposed_Sub  : Sub_Def;
      
      -- 'Cutout' Tape Segment. (See Ch.18 discussion re: when and how to use.)
      -- If the Cutout is armed, it stays armed until Peh halts.
      Cutout_Begun  : Boolean      := False;
      Cutout_Armed  : Boolean      := False;
      Cutout        : Cutouts;
      
      -- Prefixed Operators
      PrevC         : Character    := ' ';
      HavePrefix    : Boolean      := False;
      
      -- Current Verdict. We run while 'Mu', tape remains, and Ticks under max.
      -- Current Verdict. We run while 'Mu', Tape remains, and Ticks under max.
      Verdict       : Peh_Verdicts := Mu;
      --------------------------------------------------------
      
      
      -- Determine whether we have reached the given limit of Life:
      function Exhausted_Life return Boolean is
         -- If Life = 0, we are in "immortal" mode. Otherwise mortal:
         MustDie : Boolean := 
           (Dimensions.Life /= 0) and (Ticks = Dimensions.Life);
      ------------
      -- Cutout --
      ------------
      
      -- Find whether Cutout would prohibit move from current IP to the given :
      function Cutout_Prohibits(Position : in Tape_Positions) return Boolean is
      begin
         if MustDie then
            Achtung("WARNING: Exhausted Life ("
                      & Natural'Image(Ticks) & " ticks )");
         end if;
         return MustDie;
      end Exhausted_Life;
         return Cutout_Armed and IP > Cutout.R and Position < Cutout.L;
      end Cutout_Prohibits;
      
      
      -- Find whether given a Tape Position lies inside an armed Cutout:
      function In_Cutout(Position : in Tape_Positions) return Boolean is
      begin
         return Cutout_Armed and Position in Cutout.L .. Cutout.R;
      end In_Cutout;
      
      
      -- Determine whether to use the Cutout Registers at the current position:
      function Use_CO_Registers return Boolean is
      begin
         -- If we are either BELOW or INSIDE armed Cutout : we use only the
         -- CO_Registers alternative register file. Otherwise: use Registers.
         return Cutout_Armed and IP <= Cutout.R;
      end Use_CO_Registers;
      
      
      ----------
      -- Zaps --
      ----------
      
      -- Clear all state, other than blocks, Control Stack, Tape and Verdict:
      procedure Zap is
      -- Zero the Data Stack and reset the SP:
      procedure Zap_Data_Stack is
      begin
         -- Clear the Data Stack:
         for i in Stack'Range loop
            FFA_FZ_Clear(Stack(i));
         end loop;
         -- Set SP to bottom:
         SP            := Stack_Positions'First;
         -- Clear all Registers:
         SP := Stack_Positions'First;
      end Zap_Data_Stack;
      
      
      -- Zero all Registers (Ordinary set) :
      procedure Zap_Ordinary_Registers is
      begin
         for r in RegNames'Range loop
            FFA_FZ_Clear(Registers(r));
         end loop;
         -- Clear Overflow flag:
         Flag          := 0;
         -- Clear prefix:
         HavePrefix    := False;
         PrevC         := ' ';
      end Zap;
      end Zap_Ordinary_Registers;
      
      
      -- Zero all Registers (Cutout set) :
      procedure Zap_Cutout_Registers is
      begin
         for r in RegNames'Range loop
            FFA_FZ_Clear(CO_Registers(r));
         end loop;
      end Zap_Cutout_Registers;
      
      
      -- Zero all Registers in the currently-active Register Set:
      procedure Zap_Registers is
      begin
         if Use_CO_Registers then
            Zap_Cutout_Registers;
         else
            Zap_Ordinary_Registers;
         end if;
      end Zap_Registers;

      
      -- Zero the Overflow Flag:
      procedure Zap_Flag is
      begin
         Flag := 0;
      end Zap_Flag;
      
      
      -- NO effect on Blocks, Control Stack, Tape, Verdict, Cutout, Subroutines
      procedure Zap_Master is
      begin
         Zap_Data_Stack;
         Zap_Registers;
         Zap_Flag;
      end Zap_Master;
      
      
      -- Report a fatal error condition at the current symbol.
      -----------
      -- Eggog --
      -----------
      
      -- Report a fatal error condition at the current Symbol.
      -- On Unixlikes, this will also end the process and return control to OS.
      procedure E(S : in String) is
      begin
         Zap; -- Jettison all resettable state!
         Zap_Master; -- Jettison all resettable state!
         Eggog("FATAL: Tick:" & Natural'Image(Ticks) &
                 " IP:" & Tape_Positions'Image(IP) & " : " & S);
                 ", IP:" & Tape_Positions'Image(IP) & 
                 ", Symbol: '" & Tape(IP) & "'" & " : " & S);
      end E;
      
      
      -------------------
      -- Control Stack --
      -------------------
      -----------
      -- Walls --
      -----------
      
      -- Push a given Tape Position to the Control Stack:
      procedure Control_Push(Position : in Tape_Positions) is
      -- Determine whether we are currently at the last Symbol on the Tape:
      function Last_Tape_Symbol return Boolean is
      begin
         -- First, test for Overflow of Control Stack:
         if CSP = Control_Stack'Last then
            E("Control Stack Overflow!");
         return IP = Tape_Positions'Last;
      end Last_Tape_Symbol;
      
      
      -- Certain Ops are NOT permitted to occur as the final Op on a Tape:
      function Next_IP_On_Tape return Tape_Positions is
      begin
         -- Check if we are in fact on the last Symbol of the Tape:
         if Last_Tape_Symbol then
            E("This Op requires a succeeding Tape Position, "
             & "but it is at the end of the Tape!");
         end if;
         
         -- Push given Tape Position to Control Stack:
         CSP                := CSP + 1;
         Control_Stack(CSP) := Position;
      end Control_Push;
         -- ... Otherwise, return the immediate successor Tape Position:
         return IP + 1;
      end Next_IP_On_Tape;
      
      
      -- Pop a Tape Position from the Control Stack:
      function Control_Pop return Tape_Positions is
         Position : Tape_Positions;
      -- Determine whether we have reached the given limit of Life:
      function Exhausted_Life return Boolean is
         -- If Life = 0, we are in "immortal" mode. Otherwise mortal:
         MustDie : Boolean := 
           (Dimensions.Life /= 0) and (Ticks = Dimensions.Life);
      begin
         -- First, test for Underflow of Control Stack:
         if CSP = Control_Stack'First then
            E("Control Stack Underflow!");
         if MustDie then
            Achtung("WARNING: Exhausted Life ("
                      & Natural'Image(Ticks) & " ticks )");
         end if;
         
         -- Pop a Tape Position from Control Stack:
         Position           := Control_Stack(CSP);
         Control_Stack(CSP) := Tape_Positions'First;
         CSP                := CSP - 1;
         return Position;
      end Control_Pop;
         return MustDie;
      end Exhausted_Life;
      
      
      ----------------
      -- Data Stack --
      ----------------
      
      -- Move SP up
      -- Determine whether the Data Stack is Not Empty:
      function Data_Stack_Not_Empty return Boolean is
      begin
         return SP /= Stack'First;
      end Data_Stack_Not_Empty;
      
      
      -- Raise the SP up by one:
      procedure Push is
      begin
         if SP = Stack_Positions'Last then
(206 . 7)(336 . 7)
      end Push;
      
      
      -- Discard the top of the stack
      -- Discard the Top of the Data Stack:
      procedure Drop is
      begin
         FFA_FZ_Clear(Stack(SP));
(214 . 7)(344 . 7)
      end Drop;
      
      
      -- Check if stack has the necessary N items
      -- Check whether the Data Stack has the necessary N items:
      procedure Want(N : in Positive) is
      begin
         if SP < N then
(223 . 16)(353 . 11)
      end Want;
      
      
      -- Ensure that a divisor is not zero
      procedure MustNotZero(D : in FZ) is
      begin
         if FFA_FZ_ZeroP(D) = 1 then
            E("Division by Zero!");
         end if;
      end MustNotZero;
      
      ---------
      -- I/O --
      ---------
      
      -- Slide a new hex digit into the FZ on top of stack
      -- Slide a new hex digit into the FZ on top of the Data Stack
      procedure Ins_Hex_Digit(Digit : in Nibble) is
         Overflow : WBool := 0;
      begin
(260 . 9)(385 . 24)
      end Print_FZ;
      
      
      -- Print a Debug Trace (used in 'QD')
      ------------------
      -- Debug Traces --
      ------------------
      
      -- Print the bounds of a Tape Segment for Debug:
      procedure Print_Segment(S : in Segment) is
      begin
         Write_String("(" & Tape_Positions'Image(S.L) &
                        "," & Tape_Positions'Image(S.R) & " )");
      end Print_Segment;
      
      
      -- Print a Debug Trace (used in 'QD') :
      procedure Print_Trace is
      begin
         -- For clarity in cases where the Tape has already produced output:
         Write_Newline;
         
         -- Print Data Stack Trace:
         Write_String("Data Stack:");
         Write_Newline;
(275 . 20)(415 . 77)
         Write_String("Control Stack:");
         Write_Newline;
         for i in reverse Control_Stack'First + 1 .. CSP loop
            Write_String("   " & ControlStack_Range'Image(i) & " :"
                           & Tape_Positions'Image(Control_Stack(i)));
            Write_String("   " & ControlStack_Range'Image(i) & " :");
            Write_String(" Return IP:"
                           & Stack_Positions'Image(Control_Stack(i).Ret));
            Write_String(" Call Type: ");
            case Control_Stack(i).Why is
               when Subroutines =>
                  Write_String("Subroutine");
               when Loops =>
                  Write_String("Loop");
               when others =>
                  Write_String("INVALID");
            end case;
            Write_Newline;
         end loop;
         
         -- Print All Registers:
         Write_String("Registers:");
         Write_Newline;
         -- We will not print the Cutout Register Set unless it is active:
         for r in RegNames'Range loop
            Write_String("    " & r & " : ");
            Print_FZ(Registers(r));
            if Use_CO_Registers then
               -- If the Cutout Register Set is currently active:
               Write_String(" (C)" & r & " : ");
               Print_FZ(CO_Registers(r));
            else
               -- If the Ordinary Register Set is currently active:
               Write_String("    " & r & " : ");
               Print_FZ(Registers(r));
            end if;
         end loop;
         
         -- Print Ticks and IP:
         -- Print Subroutine Table:
         Write_String("Subroutines:");
         Write_Newline;
         -- Walk the Subroutine Table from first to last valid entry:
         for i in Subs'First + 1 .. STP loop
            declare
               -- The current Sub in the Subroutine Table being examined:
               S      : Sub_Def := Subs(i);
               -- The Name of the current Sub:
               S_Name : String  := String(Tape(S.Name.L .. S.Name.R));
            begin
               Write_String("   " & Subroutine_Table_Range'Image(i)
                              & " : '" & S_Name & "' ");
               Print_Segment(S.Payload);
               if Cutout_Armed then
                  -- Indicate whether Sub is uncallable here because of Cutout:
                  if Cutout_Prohibits(S.Payload.L) then
                     Write_String(" (Guarded)");
                  -- Indicate whether Sub lies INSIDE the Cutout:
                  elsif In_Cutout(S.Payload.R) then
                     Write_String(" (Cutout)");
                  end if;
               end if;
               Write_Newline;
            end;
         end loop;
         
         Write_String("Cutout: ");
         -- Print Cutout bounds, if Cutout is armed:
         if Cutout_Armed then
            Write_String("Armed: ");
            Print_Segment(Cutout);
         else
            Write_String("NONE");
         end if;
         Write_Newline;
         
         -- Print Overflow-Flag, Ticks and IP:
         Write_String("Flag  :" & WBool'Image(Flag));
         Write_Newline;
         Write_String("Ticks :" & Natural'Image(Ticks));
         Write_Newline;
         Write_String("IP    :" & Tape_Positions'Image(IP));
(296 . 45)(493 . 251)
      end Print_Trace;
      
      
      -------------------
      -- Control Stack --
      -------------------
      
      -- Determine whether the Control Stack is Not Empty:
      function Control_Stack_Not_Empty return Boolean is
      begin
         return CSP /= Control_Stack'First;
      end Control_Stack_Not_Empty;
      
      
      -- Construct a Call and push it to the Control Stack:
      procedure Control_Push(Call_Type : in Call_Types;
                             Return_IP : in Tape_Positions) is
      begin
         -- First, test for Overflow of Control Stack:
         if CSP = Control_Stack'Last then
            E("Control Stack Overflow!");
         end if;
         -- Push a Call with given parameters to the Control Stack:
         CSP                := CSP + 1;
         Control_Stack(CSP) := (Why => Call_Type, Ret => Return_IP);
      end Control_Push;
      
      
      -- Pop an IP from the Control Stack, and verify expected Call Type:
      function Control_Pop(Expected_Type : in Call_Types)
                          return Tape_Positions is
         C : Call;
      begin
         -- First, test for Underflow of Control Stack:
         if CSP = Control_Stack'First then
            E("Control Stack Underflow!");
         end if;
         -- Pop from Control Stack:
         C                      := Control_Stack(CSP);
         Control_Stack(CSP).Why := Invalid;
         CSP                    := CSP - 1;
         -- Now, see whether it was NOT the expected type. If so, eggog:
         if C.Why /= Expected_Type then
            declare
               CT : constant array(Call_Types) of String(1 .. 10)
                 := (" INVALID  ", "Subroutine", "Loop state");
            begin
               E("Currently in a " & CT(C.Why) & "; but this Op exits a "
                   & CT(Expected_Type) & " !");
            end;
         end if;
         -- ... The Call was of the expected type, so return it:
         return C.Ret;
      end Control_Pop;
      
      
      -----------------
      -- Subroutines --
      -----------------
      
      -- Find Subroutine with supplied Name in Subroutine Table, if it exists:
      function Lookup_Subroutine(Name : in Sub_Names)
                                return Subroutine_Table_Range is
         -- Number of Symbols in the Name of the current Proposed Subroutine:
         Sub_Name_Length : Positive := 1 + Name.R - Name.L;
      begin
         -- Enforce minimum Subroutine Name length:
         if Sub_Name_Length < Subr_Min_Name_Length then
            E("Proposed Name is" & Positive'Image(Sub_Name_Length) &
                " Symbols long, but the shortest permitted Name length is" &
                Positive'Image(Subr_Min_Name_Length) & " !");
         end if;
         -- Walk the Subroutine Table from first to last valid entry:
         for i in Subs'First + 1 .. STP loop
            declare
               -- The current Sub in the Subroutine Table being examined:
               S             : Sub_Def := Subs(i);
               -- Number of Symbols in the Name of S:
               S_Name_Length : Positive := 1 + S.Name.R - S.Name.L;
            begin
               -- If the lengths of the Names match:
               if Sub_Name_Length = S_Name_Length then
                  -- If the two Names are actually equal:
                  if Tape(Name.L .. Name.R) = Tape(S.Name.L .. S.Name.R) then
                     return i; -- Return the table index of the located Sub
                  end if;
               end if;
            end;
         end loop;
         -- Name was not found in Subroutine Table; return the zero position:
         return Subs'First;
      end Lookup_Subroutine;
      
      
      -- Attempt to intern the given Subroutine into the Subroutines Table:
      procedure Intern_Subroutine(Sub : in Sub_Def) is
         -- Position of the current Proposed Sub in Sub Table:
         Index  : Subroutine_Table_Range := Lookup_Subroutine(Sub.Name);
         -- To DEFINE a Sub, it must NOT have existed in Sub Table.
         
         -- Name of the Proposed Sub (for eggogs) :
         S_Name : String := String(Tape(Sub.Name.L .. Sub.Name.R));
      begin
         -- If a Sub with this Name already exists, eggog:
         if Index /= Subs'First then
            E("Attempted to redefine Subroutine '" & S_Name & "' !");
         end if;
         -- Definitions are prohibited inside Loops or Sub calls:
         if Control_Stack_Not_Empty then
            E("Attempted to define Subroutine '" 
                & S_Name & "' while inside a Loop or Subroutine!");
         end if;
         -- If the Subroutine Table is full, eggog:
         if STP = Subs'Last then
            E("Cannot define the Subroutine '" & S_Name
                & ": the Subroutine Table is Full!");
         end if;
         -- Finally, intern the Proposed Subroutine into the Sub Table:
         STP       := STP + 1;
         Subs(STP) := Sub;
      end Intern_Subroutine;
      
      
      -- Invoke a given Subroutine:
      procedure Invoke_Subroutine(Sub : in Sub_Def) is
      begin
         -- Push the Call to Control Stack:
         Control_Push(Call_Type => Subroutines, Return_IP => Next_IP_On_Tape);
         -- Next instruction will be the first Symbol of the Sub's Body:
         IP_Next := Sub.Payload.L;
      end Invoke_Subroutine;
      
      
      -- Attempt to invoke a Subroutine with the supplied name:
      procedure Invoke_Named_Subroutine(Name : in Sub_Names) is
         -- Position of the current Proposed Sub in Sub Table:
         Index  : Subroutine_Table_Range := Lookup_Subroutine(Name);
         -- To invoke a Sub, it MUST exist in the Sub Table.
         
         -- Name of the Proposed Sub (for eggogs) :
         S_Name : String := String(Tape(Name.L .. Name.R));
      begin
         -- If no defined Subroutine has this Name, eggog:
         if Index = Subs'First then
            E("Invoked Undefined Subroutine '" & S_Name & "' !");
         end if;
         -- Otherwise, proceed to the invocation:
         declare
            -- The Sub Table Entry we successfully looked up:
            Sub : Sub_Def := Subs(Index);
         begin
            -- Recursion is prohibited in Peh Tapes. Detect it:
            if IP in Sub.Payload.L .. Sub.Payload.R then
               E("Recursive invocation in Subroutine '" 
                   & S_Name & "' is prohibited!");
            end if;
            -- Prohibit Subroutines whose definitions end AFTER the current IP:
            if IP < Sub.Payload.R then
               E("Cannot invoke Subroutine '" & S_Name &
                   "' before the position where it is defined!");
            end if;
            -- Proceed to invoke the Subroutine:
            Invoke_Subroutine(Sub);
         end;
      end Invoke_Named_Subroutine;
      
      
      -- Invoke the nearest Subroutine defined to the LEFT of the current IP:
      procedure Invoke_Left_Subroutine is
         -- Position of the Subroutine to be invoked (Subs'First if none)
         Index : Subroutine_Table_Range := Subs'First;
      begin
         -- Find the nearest invocable Sub (i.e. to the LEFT of current IP) :
         -- Walk starting from the LAST Sub in Subs, down to the FIRST:
         for i in reverse Subs'First + 1 .. STP loop
            -- If a Sub's definition ended PRIOR TO the current IP:
            if Subs(i).Payload.R < IP then
               -- Save that Sub's table index:
               Index := i;
               -- If we found a Sub that met the condition, stop walking:
               exit when Index /= Subs'First;
            end if;
         end loop;
         -- If no Subs have been defined prior to current IP, then eggog:
         if Index = Subs'First then
            E("No Subroutines were defined prior to this position!");
         end if;
         -- Proceed to invoke the selected Sub:
         Invoke_Subroutine(Subs(Index));
      end Invoke_Left_Subroutine;
      
      
      ---------
      -- Peh --
      ---------
      
      -- For all Ops which entail Division: ensure that a Divisor is not zero:
      procedure MustNotZero(D : in FZ) is
      begin
         if FFA_FZ_ZeroP(D) = 1 then
            E("Division by Zero!");
         end if;
      end MustNotZero;
      
      ------------------------------------------------------------------------
      
      -- Execute a Normal Op
      procedure Op_Normal(C : in Character) is
         
         -- Over/underflow output from certain ops
         F : Word;
         

      begin
         
         case C is
            
            --------------
            -- Stickies --
            --------------
            -- Enter Commented
            ------------
            -- Blocks --
            ------------
            
            -- Enter Comment Block: Symbols will be ignored until matching ')'
            when '(' =>
               CommLevel := 1;
               
               -- Exit Commented (but we aren't in it!)
               -- Exit a Comment Block (but if we're here, we aren't in one!)
            when ')' =>
               E("Mismatched close-comment parenthesis !");
               
               -- Enter Quoted
               -- Enter a Quote Block: Symbols will print until matching ']'
            when '[' =>
               QuoteLevel := 1;
               
               -- Exit Quoted (but we aren't in it!)
               -- Exit a Quote Block (but if we're here, we aren't in one!)
            when ']' =>
               E("Mismatched close-quote bracket !");
               
               -- Enter a ~taken~ Conditional branch:
               -- Enter a Conditional branch:
            when '{' =>
               Want(1);
               if FFA_FZ_ZeroP(Stack(SP)) = 1 then
                  -- Enter a 'taken' branch.
                  -- All subsequent Symbols will be ignored until matching '}'.
                  CondLevel := 1;
               end if;
               Drop;
               
               -- Exit from a ~non-taken~ Conditional branch:
               -- ... we push a 0, to suppress the 'else' clause
               -- ... we push a 0, to suppress the 'else' clause:
            when '}' =>
               Push;
               FFA_WBool_To_FZ(0, Stack(SP));
(362 . 8)(765 . 13)
               -- Fetch from Register --
               -------------------------
            when 'g' .. 'z' =>
               -- Put value of Register on stack
               Push;
               Stack(SP) := Registers(C); -- Put value of Register on stack
               if Use_CO_Registers then
                  Stack(SP) := CO_Registers(C); -- use Cutout Register set
               else
                  Stack(SP) := Registers(C);    -- use ordinary set
               end if;
               
               ------------------
               -- Stack Motion --
(580 . 10)(988 . 6)
               Print_FZ(Stack(SP));
               Drop;
               
               -- Zap (reset all resettables)
            when 'Z' =>
               Zap;
               
               -- Put the Peh Program Version on the stack,
               -- followed by FFA Program Version.
            when 'V' =>
(626 . 6)(1030 . 8)
            when
              'Q' -- 'Quit...'
              |
              'Z' -- 'Zap...'
              |
              'L' -- 'Left...'
              |
              'R' -- 'Right...'
(636 . 37)(1042 . 62)
              =>
               HavePrefix := True;
               
               -------------------
               -- Control Stack --
               -------------------
               -----------
               -- Loops --
               -----------
               
               -- Push current IP (i.e. of THIS Op) to Control Stack.
               -- Begin Loop: Push IP (i.e. of THIS Op) to Control Stack.
            when ':' =>
               Control_Push(IP);
               Control_Push(Call_Type => Loops, Return_IP => IP);
               
               -- Conditional Return: Pop top of Stack, and...
               -- Conditional End Loop: Pop top of Stack, and...
               -- ... if ZERO:    simply discard the top of the Control Stack.
               -- ... if NONZERO: pop top of Control Stack and make it next IP.
            when ',' =>
               Want(1);
               declare
                  Position : Tape_Positions := Control_Pop;
                  Loop_Position : Tape_Positions := Control_Pop(Loops);
                  Trigger       : WBool          := FFA_FZ_NZeroP(Stack(SP));
               begin
                  if FFA_FZ_NZeroP(Stack(SP)) = 1 then
                     IP_Next := Position;
                  -- If Trigger is active, re-enter the Loop:
                  if Trigger = 1 then
                     IP_Next := Loop_Position;
                  end if;
               end;
               -- ... otherwise, continue normally.
               Drop;
               
               -- UNconditional Return: Control Stack top popped into IP_Next.
               -----------------
               -- Subroutines --
               -----------------
               
               -- Return from a Subroutine:
            when ';' =>
               IP_Next := Control_Pop;
               -- Next instruction will be at the saved Return Position:
               IP_Next := Control_Pop(Subroutines);
               
               -- Indicate the start of a Subroutine Name, e.g. @SubName
               -- ... if DEFINING  a NEW   Subroutine: is followed by @body;
               -- ... if INVOKING EXISTING Subroutine: is followed by !
            when '@' =>
               -- Save the NEXT IP as the first Symbol of the proposed Name:
               Proposed_Sub.Name.L := Next_IP_On_Tape;
               -- Enter the Name mode:
               SubNameMode         := True;
               -- We will remain in Name mode until we see a @ or ! .
               
               -- '!' invokes a previously-defined Subroutine:
               -- ... If found after @Name was given, the syntax is: @SubName!
               -- ... If found in THIS context, with no @Name , then invokes
               --     the nearest Subroutine defined to the LEFT of this IP.
               -- NO Sub defined to the RIGHT of the current IP may be invoked.
            when '!' =>
               Invoke_Left_Subroutine;
               
               ---------------------------------------------------------
               -- Reserved Ops, i.e. ones we have not defined yet:    --
               ---------------------------------------------------------
            when '!' | '@' |
                 'H' | 'I' | 'J' | 'K' | 'N' | 'T' | 'X' | 'Y' =>
            when 'H' | 'I' | 'J' | 'K' | 'N' | 'T' | 'X' | 'Y' =>
               
               E("This Operator is not defined yet: " & C);
               ---------------------------------------------------------
(675 . 7)(1106 . 8)
               -- NOPs --
               ----------
               
               -- Unprintables and spaces DO NOTHING:
               -- Unprintables and spaces DO NOTHING.
               -- (However: they occupy space, consume Life, clear Prefix.)
            when others =>
               null;
               
(683 . 6)(1115 . 7)
         
      end Op_Normal;
      
      ------------------------------------------------------------------------
      
      -- Execute a Prefixed Op
      procedure Op_Prefixed(Prefix : in Character;
(691 . 7)(1124 . 7)
         -- Report an attempt to execute an undefined Prefix Op:
         procedure Undefined_Prefix_Op is
         begin
            E("Undefined Prefix Op: " & Prefix & O);
            E("Undefined Prefix Op: '" & Prefix & O & "'");
         end Undefined_Prefix_Op;
         
      begin
(700 . 7)(1133 . 7)
         case Prefix is
            
            ---------------------------------------------------------
            -- Quit...
            -- Quit... (See Ch. 17 discussion)
            when 'Q' =>
               
               -- .. Quit how?
(708 . 6)(1141 . 11)
                  
                  -- ... with a 'Yes' Verdict:
                  when 'Y' =>
                     -- Prohibited from within a loop or Subroutine:
                     if Control_Stack_Not_Empty then
                        E("Attempted to proclaim a 'Yes' Verdict" &
                            " inside a Loop or Subroutine!");
                     end if;
                     Verdict := Yes;
                     
                  -- ... with a 'No' Verdict:
(748 . 6)(1186 . 35)
               end case;
               
            ---------------------------------------------------------
            -- Zap...
            when 'Z' =>
               
               -- .. Zap what?
               case O is
                  
                  -- ... Registers:
                  when 'R' =>
                     -- If in Cutout, will zap only Cutout set of regs
                     Zap_Registers;
                     
                  -- ... Data Stack:
                  when 'D' =>
                     Zap_Data_Stack;
                     
                  -- ... Overflow Flag:
                  when 'F' =>
                     Zap_Flag;
                     
                  -- ... All Zappable State:
                  when 'A' =>
                     Zap_Master;
                     
                  when others =>
                     Undefined_Prefix_Op;
                     
               end case;
               
            ---------------------------------------------------------
            -- Write into Register...
            when '$' =>
               
(758 . 7)(1225 . 11)
               
               -- Selected Register exists; move top FZ on stack into it:
               Want(1);
               Registers(O) := Stack(SP);
               if Use_CO_Registers then
                  CO_Registers(O) := Stack(SP); -- use Cutout Register set
               else
                  Registers(O)    := Stack(SP); -- use ordinary set
               end if;
               Drop;
            
            ---------------------------------------------------------
(786 . 6)(1257 . 29)
                  when 'R' =>
                     E("Left-Rotate not yet defined!");
                     
                  -- ... 'Cutout' :
                  -- Mark the LEFT SIDE of the 'Cutout' Tape segment;
                  -- The Tape IN OR PRIOR to it will retain the ability to
                  -- move directly into points PRIOR to THIS position
                  -- on the Tape (i.e. where THIS Op had executed).
                  -- Ops on Tape AFTER 'RC' mark can move INTO Cutout,
                  -- but NOT directly into any position PRIOR to it.
                  -- If 'LC' is executed, a 'RC' MUST occur before Tape end.
                  -- FATAL if a 'LC' or 'RC' Op had previously executed.
                  when 'C' =>
                     -- Eggog if we have ALREADY begun the Cutout somewhere:
                     if Cutout_Begun then
                        E("'LC' Op may only execute ONCE on a Tape!");
                     end if;
                     -- Cutout defs are prohibited inside loops or Sub calls:
                     if Control_Stack_Not_Empty then
                        E("Attempted to execute 'LC' (Left-Cutout)" &
                            " inside a Loop or Subroutine!");
                     end if;
                     -- Set the START of the Cutout, and mark it 'begun':
                     Cutout_Begun := True;
                     Cutout.L     := IP;
                     
                  -- ... Unknown (Eggog):
                  when others =>
                     Undefined_Prefix_Op;
(824 . 6)(1318 . 30)
                                         XY => Stack(SP - 1));
                     Drop;
                     
                  -- ... 'Cutout' :
                  -- Mark the RIGHT SIDE of the 'Cutout' Tape segment that
                  -- began with 'LC', and permanently arms the Cutout.
                  -- After THIS position, no IP_Next may be set which
                  -- directly transfers control to a point PRIOR to 'LC'.
                  -- FATAL if no 'LC' had executed to mark the LEFT SIDE.
                  when 'C' =>
                     -- Eggog if we never marked the beginning with 'LC':
                     if not Cutout_Begun then
                        E("'RC' Op found, but no there was no prior 'LC' !");
                     end if;
                     -- Eggog if we have already armed the Cutout:
                     if Cutout_Armed then
                        E("'RC' Op found, but the Cutout is already armed!");
                     end if;
                     -- Cutout defs are prohibited inside loops or Sub calls:
                     if Control_Stack_Not_Empty then
                        E("Attempted to execute 'RC' (Right-Cutout)" &
                            " inside a Loop or Subroutine!");
                     end if;
                     -- Otherwise proceed to complete and arm the Cutout:
                     Cutout.R     := IP;
                     Cutout_Armed := True;
                     
                  -- ... Unknown (Eggog):
                  when others =>
                     Undefined_Prefix_Op;
(881 . 11)(1399 . 13)
         
      end Op_Prefixed;
      
      ------------------------------------------------------------------------
      
      -- Process a Symbol
      procedure Op(C : in Character) is
      begin
         -- First, see whether we are in a state of nestedness:
         
         -- See whether we are inside a 'Block' :
         
         -- ... in a Comment block:
         if CommLevel > 0 then
(929 . 10)(1449 . 136)
                  
               when '{' =>   -- Add a nesting level:
                  CondLevel := CondLevel + 1;
                  
               when others =>
                  null; -- Other symbols have no effect on the level
            end case;
            
            --- ... in a proposed Subroutine Name:
         elsif SubNameMode then
            case C is
               
               -- Attempt to INVOKE the named Subroutine:
               when '!' =>
                  -- Detect attempt to invoke a Sub with no Name:
                  if IP = Proposed_Sub.Name.L then
                     E("Attempted to invoke a nameless Subroutine!");
                  end if;
                  -- Exit the Name mode:
                  SubNameMode := False;
                  -- Attempt to invoke the subroutine:
                  Invoke_Named_Subroutine(Proposed_Sub.Name);
                  
               -- Attempt to read a body for a Subroutine Definition:
               when '@' =>
                  -- Detect attempt to define a Sub with no Name:
                  if IP = Proposed_Sub.Name.L then
                     E("Attempted to define a nameless Subroutine!");
                  end if;
                  -- Save the NEXT IP as the beginning of the proposed Body:
                  Proposed_Sub.Payload.L := Next_IP_On_Tape;
                  -- Exit the Name mode:
                  SubNameMode            := False;
                  -- Enter Sub Body mode:
                  SubBodyMode            := True;
                  
               -- Any permissible Symbol in a Subroutine Name:
               when '0' .. '9' | 'A' .. 'Z' | 'a' .. 'z' | '-' | '_'  =>
                  -- Save IP as the potential end of the proposed Sub Name:
                  Proposed_Sub.Name.R := IP;
                  
               when others =>
                  E("Symbol '" & C & "' is prohibited in a Subroutine Name !");
            end case;
            
            --- ... in a proposed Subroutine Body:
         elsif SubBodyMode then
            declare
               -- Name of Proposed Subroutine (for eggogs) :
               Name : String
                 := String(Tape(Proposed_Sub.Name.L .. Proposed_Sub.Name.R));
            begin
               case C is
                  -- Subroutine Terminator:
                  when ';' =>
                     -- Only takes effect if NOT in a Comment or Quote Block:
                     if SubCommLevel = 0 and SubQuoteLevel = 0 then
                        if SubCondLevel /= 0 then
                           E("Conditional Return in Subroutine: '"
                               & Name & "' is Prohibited!" &
                               " (Please check for unbalanced '{'.)'");
                        end if;
                        -- Now, Sub-Comm, Quote, and Cond levels are 0.
                        -- The ';' becomes last Symbol of the new Sub's Body.
                        -- Test for attempt to define a Sub with a null Body:
                        if IP = Proposed_Sub.Payload.L then
                           E("Null Body in Subroutine: '" & Name 
                               & "' is prohibited!");
                        end if;
                        -- Exit Body mode, and intern this new Sub definition:
                        Proposed_Sub.Payload.R := IP;
                        -- Exit the Sub Body mode:
                        SubBodyMode            := False;
                        -- Attempt to intern the Proposed Subroutine:
                        Intern_Subroutine(Proposed_Sub);
                     end if;
                     
                     -- Begin-Comment inside a Subroutine Body:
                  when '(' =>
                     SubCommLevel := SubCommLevel + 1;
                     
                     -- End-Comment inside a Subroutine Body:
                  when ')' =>
                     -- If cannot drop Sub Comment level:
                     if SubCommLevel = 0 then
                        E("Unbalanced ')' in Body of Subroutine: '"
                            & Name & "' !");
                     end if;
                     SubCommLevel := SubCommLevel - 1;
                     
                     -- Begin-Quote inside a Subroutine Body:
                  when '[' =>
                     -- Ignore if Commented:
                     if SubCommLevel = 0 then
                        SubQuoteLevel := SubQuoteLevel + 1;
                     end if;
                     
                     -- End-Quote inside a Subroutine Body:
                  when ']' =>
                     -- Ignore if Commented:
                     if SubCommLevel = 0 then
                        -- If cannot drop Sub Quote level:
                        if SubQuoteLevel = 0 then
                           E("Unbalanced ']' in Body of Subroutine: '"
                               & Name & "' !");
                        end if;
                        SubQuoteLevel := SubQuoteLevel - 1;
                     end if;
                     
                     -- Begin-Conditional inside a Subroutine Body:
                  when '{' =>
                     -- Ignore if Commented or Quoted:
                     if SubCommLevel = 0 and SubQuoteLevel = 0 then
                        SubCondLevel := SubCondLevel + 1;
                     end if;
                     
                     -- End-Conditional inside a Subroutine Body:
                  when '}' =>
                     -- Ignore if Commented or Quoted:
                     if SubCommLevel = 0 and SubQuoteLevel = 0 then
                        -- If cannot drop Sub Conditional level:
                        if SubCondLevel = 0 then
                           E("Unbalanced '}' in Body of Subroutine: '"
                               & Name & "' !");
                        end if;
                        SubCondLevel := SubCondLevel - 1;
                     end if;
                     
                     -- All other Symbols have no special effect in Sub Body :
                  when others =>
                     null; -- Stay in Body mode until we see the ';'.
               end case;
            end;
            --- ... if in a prefixed op:
         elsif HavePrefix then
            
(945 . 16)(1591 . 22)
         else
            -- This is a Normal Op, so proceed with the normal rules.
            Op_Normal(C);
            
         end if;
         
         -- In all cases, save the current symbol as possible prefix:
         -- In all cases, save the current Symbol as possible prefix:
         PrevC := C;
         
      end Op;
      
      -----------------------------
      -- Start of Tape Execution --
      -----------------------------
      
   begin
      -- Reset all resettable state:
      Zap;
      Zap_Master;
      Zap_Cutout_Registers;
      
      -- Execution begins with the first Op on the Tape:
      IP := Tape_Positions'First;
(962 . 7)(1614 . 7)
      loop
         
         -- If current Op is NOT the last Op on the Tape:
         if IP /= Tape_Positions'Last then
         if not Last_Tape_Symbol then
            
            -- ... then default successor of the current Op is the next one:
            IP_Next := IP + 1;
(986 . 12)(1638 . 45)
           IP_Next  = IP or -- Reached the end of the Tape, or...
           Exhausted_Life;  -- Exhausted Life.
         
         -- If the Cutout has been armed on this Tape, then enforce it:
         if Cutout_Prohibits(IP_Next) then
            E("Attempted movement to IP:" & Tape_Positions'Image(IP_Next) &
                " violates the Cutout!");
         end if;
         
         -- We did not halt yet, so select the IP of the next Op to fetch:
         IP := IP_Next;
         
      end loop;
      
      -- Warn operator about any unclosed blocks:
      -- At this point, the Tape has halted.
      
      ------------------------------------------------------------------
      -- The following types of Unclosed Blocks trigger a Eggog Verdict:
      
      -- Unclosed Subroutine Name at Tape's End:
      if SubNameMode then
         E("The Subroutine Name at IP:"
             & Tape_Positions'Image(Proposed_Sub.Name.L)
             & " is Unterminated!");
      end if;
      
      -- Unclosed Subroutine Body at Tape's End:
      if SubBodyMode then
         E("The Body of Subroutine: '" 
             & String(Tape(Proposed_Sub.Name.L .. Proposed_Sub.Name.R)) 
             & "' is Unterminated!");
      end if;
      
      -- Unclosed Cutout:
      if Cutout_Begun and not Cutout_Armed then
         E("The Cutout declaration 'LC' at IP:"
             & Tape_Positions'Image(Cutout.L) & " is Unterminated!");
      end if;
      
      ------------------------------------------------------------------
      -- The following types of Unclosed Blocks trigger a Warning:
      
      if CommLevel > 0 then
         Achtung("WARNING: Tape terminated with an unclosed Comment!");
      end if;
(1004 . 16)(1689 . 27)
         Achtung("WARNING: Tape terminated with an unclosed Conditional!");
      end if;
      
      ------------------------------------------------------------------
      -- Non-empty stacks, after Tape has halted, also trigger a Warning:
      
      -- Warn operator if we terminated with a non-empty Control Stack.
      -- This situation ought to be considered poor style in a Peh Tape;
      -- for clarity, Verdicts should be returned from a place near
      -- the visually-apparent end of a Tape. However, this is not mandatory.
      if CSP /= Control_Stack'First then
         Achtung("WARNING: Tape terminated with a non-empty Control Stack!");
      if Control_Stack_Not_Empty then
         Achtung("WARNING: Tape terminated inside a Loop or Subroutine!");
      end if;
      
      -- We're done with the Tape, so clear the state:
      Zap;
      -- Warn operator if we terminated with a non-empty Data Stack:
      if Data_Stack_Not_Empty then
         Achtung("WARNING: Tape terminated with a non-empty Data Stack!");
      end if;
      
      ------------------------------------------------------------------
      
      -- We're done with the Tape and any Warnings, so clear the state:
      Zap_Master;
      Zap_Cutout_Registers;
      
      -- Return the Verdict:
      return Verdict;