“Finite Field Arithmetic.” Chapter 18A: Subroutines in Peh.

This article is part of a series of hands-on tutorials introducing FFA, or the Finite Field Arithmetic library. FFA differs from the typical "Open Sores" abomination, in that -- rather than trusting the author blindly with their lives -- prospective users are expected to read and fully understand every single line. In exactly the same manner that you would understand and pack your own parachute. The reader will assemble and test a working FFA with his own hands, and at the same time grasp the purpose of each moving part therein.


Chapter 18 consists of three parts, of which only the
first (18A) includes a vpatch; the second (18B) -- completes the discussion of the mechanisms; while the third (18C) contains worked examples of practical use. You are presently reading 18A.

You will need:

Add the above vpatches and seals to your V-set, and press to ffa_ch18_subroutines.kv.vpatch.

You should end up with the same directory structure as previously.

As of Chapter 18A, the versions of Peh and FFA are 251 and 253, respectively.

Now compile Peh:

cd ffacalc
gprbuild

But do not run it quite yet.


LibFFA per se is unchanged from the previous Chapter's, as reflected in the version numbers.

A number of significant changes have been made to the Peh instruction set of Chapter 17.

We will begin by summarizing the entire instruction set, as it currently stands in this Chapter:

Peh Instruction Set Ver. 251K
Op Description # Ins # Outs Notes
Blocks
( Enter Comment Block 0 0 All further symbols are ignored until comment block is exited; supports nesting. Results in a Warning if the Block is not closed by the end of the Tape.
) Exit Comment Block 0 0 Fatal if not currently in a comment block.
[ Enter Quote Block 0 0 All further symbols are not executed, but instead echoed verbatim until quote block is exited; supports nesting. Results in a Warning if the Block is not closed by the end of the Tape.
] Exit Quote Block 0 0 Fatal if not in a quote block.
{ Enter Conditional Block 1 0 Pop top item from data stack; if it was non-zero, execute all symbols until a matching } exits the conditional block; otherwise ignore them until same; supports nesting. Results in a Warning if the Block is not closed by the end of the Tape. Fatal if data stack is empty. The Subroutine terminator ; is prohibited in a Conditional Block.
} Exit Conditional Block 0 1 Pushes a 1 to data stack if the branch being exited had been taken, otherwise pushes a 0.
Data Stack Motion
" Dup 1 2 Push a copy of the top item to the data stack.
_ Drop 1 0 Discard the item on top of data stack
' Swap 2 2 Exchange top and second item on data stack
` Over 2 3 Push a copy of second item to data stack
Constants
. Push Zero 0 1 Push a brand-new zero to data stack
0..9, A..F, a..f Insert Hexadecimal Digit 1 1 Insert the given hexadecimal digit as the junior-most nibble into the top item on data stack. Fatal if data stack is empty. Equivalent to top := (16 × top) + Digit.
Predicates
= Equals 2 1 Push a 1 on data stack if the top and second items are bitwise-equal; otherwise 0
< Less-Than 2 1 Push a 1 on data stack if the second item is less than the top item
> Greater-Than 2 1 Push a 1 on data stack if the second item is greater than the top item
Bitwise
& Bitwise-AND 2 1 Compute bitwise-AND of the top and second item, push result on data stack.
| Bitwise-OR 2 1 Compute bitwise-OR of the top and second item, push result on data stack.
^ Bitwise-XOR 2 1 Compute bitwise-XOR of the top and second item, push result on data stack.
~ Bitwise-Complement 1 1 Compute 1s-complement negation of the top item on data stack, i.e. flip all bits of it.
U Bitwise-MUX 3 1 If top item is nonzero, a copy of the second item will be pushed to the data stack; otherwise - of the third item.
W Width-Measure 1 1 Calculate the position of the senior-most bit in the top item that equals 1 (or return 0 if there are none) and push this number to data stack.
RS Right-Shift 2 1 Shift the second item right by the number of bits given in the top item modulo the FZ bitness.
LS Left-Shift 2 1 Shift the second item left by the number of bits given in the top item modulo the FZ bitness.
Arithmetic: Basic
- Subtract 2 1 Subtract top item from second item, push result on data stack, and save borrow bit into Flag
+ Add 2 1 Add top and second item, push result to data stack, and save carry bit into Flag
O Push Overflow Flag 0 1 Push a copy of Flag, the register containing carry or borrow from the most recent arithmetic op, to the data stack
Arithmetic: Division
\ Divide with Remainder 2 2 Divide second item by top item, push quotient and then remainder on data stack; division by zero is fatal
/ Divide without Remainder 2 1 Divide second item by top item, push only quotient on data stack; division by zero is fatal
% Modulus 2 1 Divide second item by top item, push only remainder on data stack; division by zero is fatal
G Greatest Common Divisor 2 1 Find the Greatest Common Divisor of the top and second item, and push to the data stack. GCD(0,0) is conventionally defined as 0.
Arithmetic: Multiplication
* Multiply 2 2 Multiply second item and top item, push the junior half of the result on data stack, and then the senior half
R* Right-Multiply 2 1 Multiply top and second item, and push only the junior half of the product to the data stack. The "Low-Multiply" from Ch. 14B.
S Square 1 2 Square the top item, push the junior half of the result on data stack, and then the senior half
Arithmetic: Modular
MS Modular Square 2 1 Square the second item modulo the top item and push the result (necessarily fits in one FZ) to the data stack. division by zero is fatal.
M* Modular Multiplication 3 1 Multiply third item and second item, modulo the top item; push the result to data stack (necessarily fits in one FZ); division by zero is fatal
MX Modular Exponentiation 3 1 Raise third item to the power of the second item, modulo the top item, push the result to data stack (necessarily fits in one FZ); division by zero is fatal.
Arithmetic: Primes
P Perform a single shot of the Miller-Rabin Monte Carlo Primality Test on N, the second item on the data stack, using the top item as the Witness parameter for the test. Push a 1 to the data stack if N was found to be composite; or a 0, if N was not found to be composite. 2 1 If the supplied Witness does not satisfy the inequality 2 ≤ Witness ≤ N - 2 , it will be mapped via modular arithmetic to a value which satisfies it.
N ∈ {0, 1} will be pronounced composite under any Witness; N ∈ {2, 3} will be judged not composite under any Witness.
Any N which was found to be composite under any particular Witness, is in fact composite. The converse, is however, not true; see Ch. 16 discussion.
Registers
$g, $h, ... $z Data Stack to Register 1 0 Pop top item from the data stack, and assign to one of registers g ... z. The previous value of the register is discarded. Uses the currently-active Register Set.
g, h, ... z Register to Data Stack 0 1 Push the current value of selected register: g ... z to the data stack. Register retains its current value. Uses the currently-active Register Set.
I/O
# Print FZ 1 0 Pop and output top item from data stack to the standard output, in hexadecimal representation.
? Random 0 1 Fill a FZ from the active RNG and push on data stack. Takes potentially-unbounded time, depending on the machine RNG.
Control
LC Mark Left Side of Cutout 0 0 Mark the start of the optional Cutout Tape segment. When the Cutout is armed by the closing RC instruction, Subroutines defined after the LC Position, but prior to the RC, may be invoked from Positions after the RC. Subroutines defined prior to the LC Position may be invoked from Positions prior to the RC, but not from those after RC. Fatal if a RC to mark the end of the Cutout does not occur at some later point. Fatal if executed more than once in a Peh run.
RC Mark Right Side of Cutout, and Arm 0 0 Mark the end of the Cutout, and arm it. Once armed, the Cutout remains in force until Peh halts, and may not be disabled or redefined. All subsequent instructions must obey the Cutout (see LC) or will trigger fatal error. Register-access instructions, including ZR and QD, executed prior to this Position will access only the segregated Cutout Register Set. Fatal if a LC has not executed prior. Fatal if executed more than once in a Peh run.
: Enter Loop 0 0 Push a Call of type Loop, with return Position consisting of the current Tape Position, to the control stack. Overflowing the control stack is fatal.
, Conditional End Loop 1 0 Pop a Call with expected type Loop from the control stack; pop top item from data stack, and if it is non-zero then transfer control to that Call's return Position upon the next tick, i.e. performing another iteration of the Loop. Underflowing the control stack or data stack is fatal. Attempting to return from a Call of type Subroutine via this instruction is also fatal.
@ Begin Name For Subroutine Invocation / Begin or End Name for Subroutine Definition 0 0 If part of a @Name! form : Invoke a previously-defined Subroutine with given Name (see ! below.) If part of a @Name@body; form : Define a new Subroutine with given Name. Permitted characters in Name are A-Z, a-z, 0-9, - and _ . Names must be 2 or more Symbols in length. Failure to terminate the Name (in a @Name! form) or Subroutine Body (in a @Name@body; form) is fatal. Attempting to define a Subroutine inside a Subroutine or Loop is fatal. Attempting to redefine a Subroutine is fatal. The placement of the terminating ; inside a Conditional Block is fatal. The presence of any unbalanced Block operators inside a Subroutine definition is fatal. Fatal if the Subroutine Table (256 entries) is full. Fatal if occurs as the last instruction on the Tape.
! Subroutine Invocation 0 0 Push a Call with type Subroutine to the control stack, with return Position equal to the next instruction following this one. If a Name has been set via the @Name notation: attempt to look up a Subroutine with that Name in the Subroutine Table, and invoke it. If not found, fatal. If no name has been set, attempt to invoke the nearest Subroutine defined to the left of this IP and invoke it. If none exist, fatal. If this instruction is the last instruction on the Tape, fatal. Attempting to invoke a Subroutine recursively, or to invoke any Subroutine defined to the right of the current Position, is fatal. If the Invocation violates an armed Cutout, fatal. Overflowing the control stack is fatal.
; Subroutine Termination / Return 0 0 During Subroutine definition: terminates the definition. Use inside a Conditional Block is fatal. During Subroutine execution: pops a Call with expected type Subroutine from the control stack, and transfer control to that Call's return Position upon the next tick. Underflowing the control stack is fatal. Attempting to return from a Call of type Loop via this instruction is also fatal, i.e. all Loops inside a Subroutine must terminate before the Subroutine may terminate.
Halting
QY Quit with 'Yes' Verdict 0 0 Halt Peh with a Verdict of Yes. Fatal if executed inside a Loop or a Subroutine.
QN Quit with 'No' Verdict 0 0 Halt Peh with a Verdict of No.
QM Quit with 'Mu' Verdict 0 0 Halt Peh with a Verdict of Mu.
QD Quit with 'Mu' Verdict and Debug Trace 0 0 Halt Peh with a Verdict of Mu, and print debug trace, which includes the contents of the control and data stacks, the Subroutines Table, and Cutout definition if the Cutout is armed. The Register set printed will be the active one (i.e. the segregated Cutout Register Set if current Position is to the left of the end of the Cutout; otherwise the ordinary Register set.)
QE Quit with Eggog 0 0 Halt Peh and signal a catastrophic error.
Zaps
ZR Zap Registers 0 0 Reset the currently-active Register Set.
ZD Zap Data Stack 0 0 Reset data stack.
ZF Zap Overflow Flag 0 0 Reset Overflow Flag.
ZA Zap All 0 0 Reset data stack, Flag, and the currently-active Register Set.
Other
V Push the Peh and FFA version numbers to the data stack. 0 2 Kelvin Versioning is in use.
Not Yet Defined:
H Undefined 0 0 Prohibited
I Undefined 0 0 Prohibited
J Undefined 0 0 Prohibited
K Undefined 0 0 Prohibited
N Undefined 0 0 Prohibited
T Undefined 0 0 Prohibited
X Undefined 0 0 Prohibited (outside of MX)
Y Undefined 0 0 Prohibited

Please refer to this table as you read on.


The primary new feature introduced to Peh in this Chapter is the Subroutine. A Subroutine Table is provided, and holds up to 256 entries:

limits.ads:

package Limits is
 
   ............
 
   -- The exact size of the Peh Subroutine Table. This is an invariant.
   Subroutine_Table_Size  : constant Positive := 256;
 
   -- The minimum number of Symbols in a Subroutine Name. This is an invariant.
   Subr_Min_Name_Length   : constant Positive := 2;
 
end Limits;

ffa_calc.ads:

package FFA_Calc is
 
   ............
 
   -- Valid indices into the Subroutine Table:
   subtype Subroutine_Table_Range is Natural range 0 .. Subroutine_Table_Size;
   -- The 'zero' position indicates 'emptiness', as in the above.
 
   ............
 
end FFA_Calc;

Each Subroutine entry consists of a Tape Segment (see below) to represent the name of the Subroutine, and a second segment to represent its body. Prior to describing the syntax for defining or invoking Subroutines, let's review the required moving parts, including all of the necessary changes to the Chapter 17 control stack mechanism:

ffa_calc.adb:

   -- Start a Peh Machine with the given Dimensions and Tape; return a Verdict.
   function Peh_Machine(Dimensions : in Peh_Dimensions;
                        Tape       : in Peh_Tapes;
                        RNG        : in RNG_Device) return Peh_Verdicts is
 
   ............
   ............
 
      -- 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 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;
 
   ............
 
      -- 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;
 
   ............

The control stack manipulators now look like this:

ffa_calc.adb:

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

Specifically, and unlike in Chapter 17, we store not only the return position when effecting a transfer of control, but also the nature of the operation which caused the transfer. Thereby we obtain the stricter syntax (reviewed in the instruction set table at the start of this Chapter), where the ; operator may only terminate a Subroutine, while the , operator may only terminate a Loop.

Let's walk through precisely how a Subroutine comes into being. The starting point for this process is the @ operator:

ffa_calc.adb:

      -- Execute a Normal Op
      procedure Op_Normal(C : in Character) is
 
         -- Over/underflow output from certain ops
         F : Word;
 
      begin
 
         case C is
   ............
   ............
 
               -- 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 ! .
   ............
   ............
 
         end case;
 
      end Op_Normal;

For now, let's ignore invocation and focus on definition. The the @ operator, when first encountered, triggers Name Mode. This sets the "scratch" Subroutine definition tape segment tuple's Name.L ("left of name") to the next Position on the tape, which consequently must exist:

ffa_calc.adb:

      -- 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;
         -- ... Otherwise, return the immediate successor Tape Position:
         return IP + 1;
      end Next_IP_On_Tape;

Afterwards, it behaves much like the other block modes described in Chapter 4:

ffa_calc.adb:

      -- Process a Symbol
      procedure Op(C : in Character) is
      begin
 
         -- See whether we are inside a 'Block' :
   ............
   ............
         -- ... in a Comment block:
   ............
   ............
 
            -- ... in a Quote block:
   ............
   ............
 
            --- ... in a ~taken~ Conditional branch:
   ............
   ............
 
            --- ... 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;
   ............
   ............

Once Peh is in Name mode, all subsequent Symbols encountered on the Tape will be interpreted as part of a Name, until a Name Terminator -- either @ (Subroutine Definition Name Terminator) or ! (Subroutine Invocation Name Terminator) is encountered, or a prohibited Symbol (i.e. not part of the permissible set A-Z, a-z, 0-9, - and _ ) triggers a fatal error.

Observe that null (i.e. containing no Symbols) Names are prohibited.

Once the Name mode is exited by one of the two specified Name Terminator symbols, what happens next depends on which of these two Symbols was encountered.

If the Name Mode was exited by the @ operator, a new Subroutine body is expected to come next. (See below.) If instead the ! operator is encountered, we proceed into a Subroutine invocation. (Described further below.)

Let's examine the Body Mode used to complete a Subroutine definition:

ffa_calc.adb:

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

This piece may appear complicated, but is really quite simple: we advance on the Tape until a point where the ; Subroutine Terminator is executed in such a way that it does not lie inside a Comment or Quote Block. Following this, we verify that it did not occur inside a Conditional Block -- this situation triggers a fatal error, as it is undesirable for Peh Tapes to include convoluted control flow. At that point, we verify that the body of the Subroutine actually contains at least one Symbol. Afterwards, we mark the "right" of the Subroutine Body in the "scratch" Subroutine definition tape segment tuple Proposed_Sub, and proceed to internment:

ffa_calc.adb:

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

The mechanism is self-explanatory -- we ensure that no Subroutine with the proposed Name was already defined in the Subroutine Table; afterwards -- that the definition was not attempted inside of another Subroutine or a Loop; next, that the table is not filled to capacity; and finally we record Proposed_Sub into the Subroutine Table.

Here is how Lookup_Subroutine works:

ffa_calc.adb:

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

This is a quite simple routine, and will not be discussed in detail. It must be noted, however, that it is also used in the invocation mechanism. Let's now proceed to describe it:

ffa_calc.adb:

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

The various prohibitions -- we will discuss in the next Chapter, 18B. First, the reader must fully understand the two permitted forms of Subroutine invocation. The first of these, we have already seen earlier. It is the @Name! form, where we exit the Name Mode with the ! operator:

ffa_calc.adb:

      -- Process a Symbol
      procedure Op(C : in Character) is
      begin
 
   ............
 
            --- ... 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);

In this form, we attempt to invoke a Subroutine having that particular Name. If it is not found in the Subroutine Table, the Peh run terminates with a Verdict of Eggog. Otherwise, we succeed in placing the succeeding (i.e. after the !) Tape Position on the control stack:

ffa_calc.adb:

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

... and the execution of the next instruction proceeds from the Sub.Payload.L Position, i.e. from the "left-most" (i.e. first) instruction in the body of the invoked Subroutine.

If the ! Symbol is encountered outside of the Name Mode state, we instead perform the Invoke_Left_Subroutine operation:

ffa_calc.adb:

      -- Execute a Normal Op
      procedure Op_Normal(C : in Character) is
 
         -- Over/underflow output from certain ops
         F : Word;
 
      begin
 
         case C is
   ............
   ............
 
               -- '!' 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;

ffa_calc.adb:

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

Here, we simply locate the closest Subroutine definition to the left of the current Position, and invoke it. This permits a shorthand notation where a particular Subroutine is used repeatedly inside of an immediately-neighbouring one.


We return from a Subroutine using the ; operator:

ffa_calc.adb:

               -- Return from a Subroutine:
            when ';' =>
               -- Next instruction will be at the saved Return Position:
               IP_Next := Control_Pop(Subroutines);

Execution then proceeds starting with the instruction that immediately followed the invoking ! Symbol on the Tape (i.e. the Symbol which initiated the Subroutine invocation which we are returning from.)

Observe that, in order to exit from a Subroutine, all Loop states inside that Subroutine must have terminated, and all Conditional Blocks closed. The ; operator may not occur inside of a Conditional Block.


The new, stricter semantics of the control stack require a reworked Loop mechanism, slightly different from that of Chapter 17:

ffa_calc.adb:

               -----------
               -- Loops --
               -----------
 
               -- Begin Loop: Push IP (i.e. of THIS Op) to Control Stack.
            when ':' =>
               Control_Push(Call_Type => Loops, Return_IP => IP);
 
               -- 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
                  Loop_Position : Tape_Positions := Control_Pop(Loops);
                  Trigger       : WBool          := FFA_FZ_NZeroP(Stack(SP));
               begin
                  -- If Trigger is active, re-enter the Loop:
                  if Trigger = 1 then
                     IP_Next := Loop_Position;
                  end if;
               end;
               -- ... otherwise, continue normally.
               Drop;

... the exact functioning of which should at this point be clear to the reader.


Now, let's review some examples of valid Subroutine definition and invocation in Peh. Assume that all of these Tapes end with a whitespace Symbol, so that the trailing ! operations are valid :

Peh Tape Output of Tape

@foo@[foo]; @foo!

foo

@foo@[foo]; !

foo

@foo@[foo]; !!!

foofoofoo

@foo@[foo]; @bar@[bar]; !

bar

@foo@[foo]; @bar@[bar]!; !

barfoo

@foo@[foo]; @bar@[bar]@foo!; !

barfoo

And now, some invalid (i.e. leading mercilessly to an Eggog Verdict) examples:

Peh Tape Eggogology

!

No Subroutines were defined prior to this position!

@foo!

Invoked Undefined Subroutine 'foo' !

@foo

The Subroutine Name at IP: 2 is Unterminated!

@foo@

The Body of Subroutine: 'foo' is Unterminated!

@foo@;

Null Body in Subroutine: 'foo' is prohibited!

;

Control Stack Underflow!

@@[hello];

Attempted to define a nameless Subroutine!

@!

Attempted to invoke a nameless Subroutine!

@x@[x];

Proposed Name is 1 Symbols long, but the shortest permitted Name length is 2 !

And now, a few slightly more interesting invalid uses:

Peh Tape Eggogology

@foo@[foo]@bar!; @bar@[bar]; @foo!

Cannot invoke Subroutine 'bar' before the position where it is defined!

@foo@[foo]!; @foo!

No Subroutines were defined prior to this position!

@foo@[foo]@foo!; @foo!

Recursive invocation in Subroutine 'foo' is prohibited!

@foo@@bar@[bar]; !

Attempted to define Subroutine 'bar' while inside a Loop or Subroutine!

: @foo@[foo];

Attempted to define Subroutine 'foo' while inside a Loop or Subroutine!

In the next Chapter, 18B, we will discuss the rationale for the restrictive semantics of the Subroutine system; review the new Cutout mechanism; and cover the several remaining changes to Peh introduced in the 18A vpatch. Stay tuned!


~To be continued!~

This entry was written by Stanislav , posted on Friday March 29 2019 , filed under Ada, Bitcoin, Cold Air, Computation, Cryptography, FFA, Friends, Mathematics, SoftwareArchaeology, SoftwareSucks . Bookmark the permalink . Post a comment below or leave a trackback: Trackback URL.

Leave a Reply

XHTML: You can use these tags: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong> <pre lang="" line="" escaped="" highlight="">


MANDATORY: Please prove that you are human:

39 xor 71 = ?

What is the serial baud rate of the FG device ?


Answer the riddle correctly before clicking "Submit", or comment will NOT appear! Not in moderation queue, NOWHERE!