marte_non_local_jump/non_local_jump_test.adb

   1 ------------------------------------------------------------------------------\r
   2 --  ------------------         M a R T E   O S         -------------------  --\r
   3 ------------------------------------------------------------------------------\r
   4 --                                                             {MARTE_VERSION}\r
   5 --\r
   6 --                      'N o n _ L o c a l _ J u m p'\r
   7 --\r
   8 --                                  Spec\r
   9 --\r
  10 --  File 'non_local_jump.ads'                                          By MAR\r
  11 --\r
  12 --  Non-local jumps for preempted tasks.\r
  13 --\r
  14 --  IMPORTANT: it must be compiled without any optimization!!\r
  15 --\r
  16 --  {MARTE_COPYRIGHT}\r
  17 --\r
  18 ------------------------------------------------------------------------------\r
  19 --  {<MAR}\r
  20 --\r
  21 --  02-08-07:version operativa.\r
  22 --\r
  23 --  {MAR>} -------------------------------------------------------------------\r
  24 pragma Task_Dispatching_Policy (FIFO_Within_Priorities);\r
  25 with Text_IO; use Text_IO;\r
  26 with Ada.Unchecked_Conversion;\r
  27 with System;\r
  28 with Marte.Integer_Types; use Marte.Integer_Types;\r
  29 with Marte.HAL.Processor_Registers;\r
  30 with Non_Local_Jump;\r
  31 with System.Machine_Code; use System.Machine_Code;\r
  32 with Execution_Load;\r
  33 \r
  34 procedure Non_Local_Jump_Test is\r
  35 \r
  36    --pragma Linker_Options("eat_20.o");\r
  37 \r
  38    --procedure Eat_20;\r
  39    --pragma Import (C, Eat_20, "eat_20");\r
  40 \r
  41    pragma Priority (10);\r
  42 \r
  43    --  package PR renames Processor_Registers;\r
  44    package PR renames Non_Local_Jump;\r
  45 \r
  46    Cont : Integer := 0;\r
  47    pragma Volatile (Cont);\r
  48 \r
  49    TCB : System.Address := System.Null_Address;\r
  50    pragma Volatile (TCB);\r
  51 \r
  52    function Pthread_Self return System.Address;\r
  53    pragma Import (C, Pthread_Self, "pthread_self");\r
  54 \r
  55    Jmp_Buff : aliased PR.Jmp_Context;\r
  56    pragma Volatile (Jmp_Buff);\r
  57 \r
  58    procedure Por_Fastidiar2 (C : Integer) is\r
  59    begin\r
  60       loop\r
  61 \r
  62          Put_Line (Integer'Image (C));\r
  63          Execution_Load.Eat (20.0);\r
  64          --for I in 1 .. 20_000_000 loop\r
  65          --   null;\r
  66          --end loop;\r
  67       end loop;\r
  68    end Por_Fastidiar2;\r
  69 \r
  70    procedure Por_Fastidiar1 (C : Integer) is\r
  71    begin\r
  72       Por_Fastidiar2 (C);\r
  73    end Por_Fastidiar1;\r
  74 \r
  75    --  tarea q se cambia su dirección de retorno\r
  76    task Saltarina is\r
  77       pragma Priority (5);\r
  78    end Saltarina;\r
  79 \r
  80    task body Saltarina is\r
  81    begin\r
  82       Put_Line ("hola2");\r
  83       TCB := Pthread_Self;\r
  84       loop\r
  85          PR.Save_Context(Jmp_Buff'Access);\r
  86          --  Asm ("int $3", No_Output_Operands, No_Input_Operands, "", True);\r
  87          if PR.After_Jump (Jmp_Buff'Access) = 1 then\r
  88             Put_Line ("---After Jump---");\r
  89          else\r
  90             Put_Line ("---Not After Jump 1---");\r
  91             Por_Fastidiar1 (Cont);\r
  92             Put_Line ("---Not After Jump 2---");\r
  93          end if;\r
  94          Cont := Cont + 1;\r
  95          Put_Line(" Cont:" & Integer'Image (Cont));\r
  96       end loop;\r
  97 \r
  98    exception\r
  99       when E:others =>\r
 100          Put_Line ("Exception in Saltarina");\r
 101    end Saltarina;\r
 102 \r
 103 begin\r
 104    loop\r
 105       delay 2.0;\r
 106       exit when Cont >= 5;\r
 107 \r
 108       Put_Line ("Antes de cambiar retorno 3");\r
 109       PR.Restore_Context (TCB, Jmp_Buff'Access);\r
 110       Put_Line ("Desp de cambiar retorno 3");\r
 111       --delay 1000000.0;\r
 112    end loop;\r
 113    Put_Line (Integer'Image (Jmp_Buff'Size/8));\r
 114 \r
 115 end Non_Local_Jump_Test;\r