raw
ffa_ch17_peh.kv         1 ------------------------------------------------------------------------------
ffa_ch17_peh.kv         2 ------------------------------------------------------------------------------
ffa_ch17_peh.kv         3 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'.               --
ffa_ch17_peh.kv         4 --                                                                          --
ffa_ch17_peh.kv         5 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org )                      --
ffa_ch17_peh.kv         6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html     --
ffa_ch17_peh.kv         7 --                                                                          --
ffa_ch17_peh.kv         8 -- You do not have, nor can you ever acquire the right to use, copy or      --
ffa_ch17_peh.kv         9 -- distribute this software ; Should you use this software for any purpose, --
ffa_ch17_peh.kv        10 -- or copy and distribute it to anyone or in any manner, you are breaking   --
ffa_ch17_peh.kv        11 -- the laws of whatever soi-disant jurisdiction, and you promise to         --
ffa_ch17_peh.kv        12 -- continue doing so for the indefinite future. In any case, please         --
ffa_ch17_peh.kv        13 -- always : read and understand any software ; verify any PGP signatures    --
ffa_ch17_peh.kv        14 -- that you use - for any purpose.                                          --
ffa_ch17_peh.kv        15 --                                                                          --
ffa_ch17_peh.kv        16 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm .     --
ffa_ch17_peh.kv        17 ------------------------------------------------------------------------------
ffa_ch17_peh.kv        18 ------------------------------------------------------------------------------
ffa_ch17_peh.kv        19 
ffa_ch17_peh.kv        20 with OS;       use OS;
ffa_ch17_peh.kv        21 with CmdLine;  use CmdLine;
ffa_ch17_peh.kv        22 with FFA_RNG;  use FFA_RNG;
ffa_ch17_peh.kv        23 with FFA_Calc; use FFA_Calc;
ffa_ch17_peh.kv        24 
ffa_ch17_peh.kv        25 
ffa_ch17_peh.kv        26 -- This is the 'main' procedure of Peh for all Unixlike OS.
ffa_ch17_peh.kv        27 procedure Peh is
ffa_ch17_peh.kv        28    
ffa_ch17_peh.kv        29    PehDim  : Peh_Dimensions; -- Operator-specified spacetime footprint.
ffa_ch17_peh.kv        30    
ffa_ch17_peh.kv        31    RNG     : RNG_Device;     -- The selected RNG device. Peh requires a RNG.
ffa_ch17_peh.kv        32    
ffa_ch17_peh.kv        33 begin
ffa_ch17_peh.kv        34    
ffa_ch17_peh.kv        35    -- If a valid number of command line params was NOT given, print a likbez :
ffa_ch17_peh.kv        36    if Arg_Count < 5 or Arg_Count > 6 then
ffa_ch17_peh.kv        37       Eggog("Usage: ./peh WIDTH HEIGHT TAPESPACE LIFE [/dev/rng]");
ffa_ch17_peh.kv        38    end if;
ffa_ch17_peh.kv        39    
ffa_ch17_peh.kv        40    declare
ffa_ch17_peh.kv        41       Arg1 : CmdLineArg;
ffa_ch17_peh.kv        42       Arg2 : CmdLineArg;
ffa_ch17_peh.kv        43       Arg3 : CmdLineArg;
ffa_ch17_peh.kv        44       Arg4 : CmdLineArg;
ffa_ch17_peh.kv        45    begin
ffa_ch17_peh.kv        46       
ffa_ch17_peh.kv        47       -- Get commandline args:
ffa_ch17_peh.kv        48       Get_Argument(1, Arg1); -- First  mandatory arg : Width
ffa_ch17_peh.kv        49       Get_Argument(2, Arg2); -- Second mandatory arg : Height
ffa_ch17_peh.kv        50       Get_Argument(3, Arg3); -- Third  mandatory arg : TapeSpace
ffa_ch17_peh.kv        51       Get_Argument(4, Arg4); -- Fourth mandatory arg : Life
ffa_ch17_peh.kv        52       
ffa_ch17_peh.kv        53       if Arg_Count = 6 then
ffa_ch17_peh.kv        54          
ffa_ch17_peh.kv        55          -- A RNG was specified (Arg_Count includes program name itself)
ffa_ch17_peh.kv        56          declare
ffa_ch17_peh.kv        57             Arg5 : CmdLineArg;
ffa_ch17_peh.kv        58          begin
ffa_ch17_peh.kv        59             Get_Argument(5, Arg5); -- Fifth arg (optional) : RNG device
ffa_ch17_peh.kv        60             
ffa_ch17_peh.kv        61             -- Ada.Sequential_IO chokes on paths with trailing whitespace!
ffa_ch17_peh.kv        62             -- So we have to give it a trimmed path. But we can't use
ffa_ch17_peh.kv        63             -- Ada.Strings.Fixed.Trim, because it suffers from
ffa_ch17_peh.kv        64             -- SecondaryStackism-syphilis. Instead we are stuck doing this:
ffa_ch17_peh.kv        65             Init_RNG(RNG, Arg5(Arg5'First .. Len_Arg(5)));
ffa_ch17_peh.kv        66          end;
ffa_ch17_peh.kv        67          
ffa_ch17_peh.kv        68       else
ffa_ch17_peh.kv        69          
ffa_ch17_peh.kv        70          -- If RNG was NOT explicitly specified:
ffa_ch17_peh.kv        71          Init_RNG(RNG); -- Use the machine default. The '?' Op requires a RNG.
ffa_ch17_peh.kv        72          
ffa_ch17_peh.kv        73          -- Warn the operator that we are going to use the default system RNG:
ffa_ch17_peh.kv        74          Achtung("WARNING: The '?' command will use DEFAULT entropy source : "
ffa_ch17_peh.kv        75                    & Default_RNG_Path & " !");
ffa_ch17_peh.kv        76          -- Generally, you do NOT want this, outside of noob exploration/tests.
ffa_ch17_peh.kv        77          
ffa_ch17_peh.kv        78       end if;
ffa_ch17_peh.kv        79       
ffa_ch17_peh.kv        80       -- Parse the four mandatory arguments into Positives:
ffa_ch17_peh.kv        81       PehDim.Width     := Positive'Value(       Arg1 );
ffa_ch17_peh.kv        82       PehDim.Height    := Positive'Value(       Arg2 );
ffa_ch17_peh.kv        83       PehDim.TapeSpace := Peh_Tape_Range'Value( Arg3 );
ffa_ch17_peh.kv        84       PehDim.Life      := Natural'Value(        Arg4 );
ffa_ch17_peh.kv        85       
ffa_ch17_peh.kv        86    exception
ffa_ch17_peh.kv        87       
ffa_ch17_peh.kv        88       -- There was an attempt to parse garbage in the init parameters:
ffa_ch17_peh.kv        89       when others =>
ffa_ch17_peh.kv        90          Eggog("Invalid arguments!");
ffa_ch17_peh.kv        91          
ffa_ch17_peh.kv        92    end;
ffa_ch17_peh.kv        93    
ffa_ch17_peh.kv        94    -- Validate requested Peh Dimensions. If invalid, program will terminate.
ffa_ch17_peh.kv        95    Validate_Peh_Dimensions(PehDim);
ffa_ch17_peh.kv        96    
ffa_ch17_peh.kv        97    -- Read, from Unix 'standard input' , and then execute, the Tape:
ffa_ch17_peh.kv        98    declare
ffa_ch17_peh.kv        99       
ffa_ch17_peh.kv       100       -- The current Tape input symbol
ffa_ch17_peh.kv       101       Tape_Read_Char  : Character;
ffa_ch17_peh.kv       102       
ffa_ch17_peh.kv       103       -- The TapeSpace
ffa_ch17_peh.kv       104       TapeSpace       : Peh_Tapes(1 .. PehDim.TapeSpace) := (others => ' ');
ffa_ch17_peh.kv       105       
ffa_ch17_peh.kv       106       -- 'End of File' condition when reading :
ffa_ch17_peh.kv       107       EOF             : Boolean := False;
ffa_ch17_peh.kv       108       
ffa_ch17_peh.kv       109       -- Will contain the Verdict produced by the Tape:
ffa_ch17_peh.kv       110       Verdict         : Peh_Verdicts;
ffa_ch17_peh.kv       111       
ffa_ch17_peh.kv       112    begin
ffa_ch17_peh.kv       113       
ffa_ch17_peh.kv       114       -- Attempt to read the entire expected Tapespace length, and no more:
ffa_ch17_peh.kv       115       for TapePosition in TapeSpace'Range loop
ffa_ch17_peh.kv       116          
ffa_ch17_peh.kv       117          -- Attempt to receive a symbol from the standard input:
ffa_ch17_peh.kv       118          if Read_Char(Tape_Read_Char) then
ffa_ch17_peh.kv       119             
ffa_ch17_peh.kv       120             -- Save the successfully-read symbol to the TapeSpace:
ffa_ch17_peh.kv       121             TapeSpace(TapePosition) := Tape_Read_Char;
ffa_ch17_peh.kv       122             
ffa_ch17_peh.kv       123          else
ffa_ch17_peh.kv       124             
ffa_ch17_peh.kv       125             -- Got an EOF instead of a symbol:
ffa_ch17_peh.kv       126             EOF := True;
ffa_ch17_peh.kv       127             if TapePosition /= TapeSpace'Length then
ffa_ch17_peh.kv       128                Achtung("WARNING: Short Tape: Tapespace filled to position:" &
ffa_ch17_peh.kv       129                          Peh_Tape_Range'Image(TapePosition) & " of" &
ffa_ch17_peh.kv       130                          Peh_Tape_Range'Image(TapeSpace'Last) & ".");
ffa_ch17_peh.kv       131             end if;
ffa_ch17_peh.kv       132             
ffa_ch17_peh.kv       133          end if;
ffa_ch17_peh.kv       134          
ffa_ch17_peh.kv       135          exit when EOF; -- When EOF, halt reading, and proceed to execution.
ffa_ch17_peh.kv       136          
ffa_ch17_peh.kv       137       end loop;
ffa_ch17_peh.kv       138       
ffa_ch17_peh.kv       139       -- Execute Peh over the given Tape, on Peh Machine with given dimensions:
ffa_ch17_peh.kv       140       Verdict := Peh_Machine(Dimensions => PehDim,
ffa_ch17_peh.kv       141                              Tape       => TapeSpace,
ffa_ch17_peh.kv       142                              RNG        => RNG);
ffa_ch17_peh.kv       143       
ffa_ch17_peh.kv       144       -- A correctly-written Peh Tape is expected to produce a Verdict.
ffa_ch17_peh.kv       145       -- On Unix, we will give it to the caller process via the usual means:
ffa_ch17_peh.kv       146       case Verdict is
ffa_ch17_peh.kv       147          
ffa_ch17_peh.kv       148          -- Tape produced a Verdict of 'Yes' :
ffa_ch17_peh.kv       149          when Yes =>
ffa_ch17_peh.kv       150             Quit(Yes_Code);
ffa_ch17_peh.kv       151             
ffa_ch17_peh.kv       152          -- Tape produced a Verdict of 'No'  :
ffa_ch17_peh.kv       153          when No =>
ffa_ch17_peh.kv       154             Quit(No_Code);
ffa_ch17_peh.kv       155             
ffa_ch17_peh.kv       156             -- Tape ran to completion without producing any Verdict at all.
ffa_ch17_peh.kv       157             -- Outside of simple test scenarios, noob explorations, etc.,
ffa_ch17_peh.kv       158             -- this usually means that there is a logical mistake in the
ffa_ch17_peh.kv       159             -- Tape somewhere, and we will warn the operator:
ffa_ch17_peh.kv       160          when Mu =>
ffa_ch17_peh.kv       161             Achtung("WARNING: Tape terminated without a Verdict.");
ffa_ch17_peh.kv       162             Quit(Mu_Code);
ffa_ch17_peh.kv       163             
ffa_ch17_peh.kv       164       end case;
ffa_ch17_peh.kv       165       
ffa_ch17_peh.kv       166       -- If the Tape aborted on account of a fatal error condition (e.g. div0)
ffa_ch17_peh.kv       167       -- Peh will Quit(Sad_Code) (see E(..) in ffa_calc.adb .)
ffa_ch17_peh.kv       168       -- Therefore, Peh ALWAYS returns one of FOUR possible Unix return-codes:
ffa_ch17_peh.kv       169       -- -2, -1, 0, 1. (see os.ads .)
ffa_ch17_peh.kv       170       
ffa_ch17_peh.kv       171    end;
ffa_ch17_peh.kv       172    
ffa_ch17_peh.kv       173 end Peh;