         Edinburgh IMP77 Compiler - Version 8.4

    1  
    2  !*   Title      :  XII 
    3  !*   Version    :  I
    4  !*   Date       :  29 June 1984
    5  !*   Description:  Tests the ability to raise events within a program
    6  !*                 both in the standard procedures etc and by the user.
    7  
    8  
    9  %Begin
   10     %Switch   Trap (0 : 15)
   11     %Integer  Sub
   12  
   13  %owninteger failures=0
   14  
   15  %routine pass
   16    printstring("Pass: ")
   17  %end
   18  %routine fail
   19    printstring("FAIL: ")
   20    failures = failures+1
   21  %end
   22  
   23     %On %Event 0, 10, 13, 15 %Start
   24  
   25         Sub = Event_Sub {Event}
   26         -> Trap (Event_Event)
   27   
   28         Trap(10):     { Trap an event raised inside a %On block
   29                       { Raised inside local routine 'Eventful'.
   30   
   31         %If Sub = 116 %c
   32+            %then Print String ("Trapped an event inside an %ON block")  %c
   33+            %else Print String ("Error in _Sub Event field for event 10")
   34         New Line
   35         -> Resume2
   36  
   37         Trap(15):     { Trapping events inside routines.
   38   
   39         Print String ("Trapped event inside a ")
   40         %If Sub = 115 %then %Start
   41             Print String ("local routine.")
   42             New Line
   43             %If Event_Info{Extra} = 20 %then pass %else fail
   44             Print String ("Event_Extra field correctly assigned.")
   45             New Line
   46             -> Resume3
   47         %Finish %else %if Sub = 118 %then %start
   48             Print String ("nested, deeply recursed routine.")
   49             New Line
   50             -> Resume4
   51         %Finish
   52  
   53         TRAP(*):
   54            Print String("FAIL: Unexpected event")
   55            write(event_event,1);  newline
   56            %stop
   57      %Finish
   58  
   59  
   60     %Routine  Test Standard Events
   61  
   62         !*  This routine forces the standard events to be raised to
   63         !*  test their validity.
   64  
   65         %Label   Catch
   66  
   67         %Integer J
   68         %Integer K
   69         %Integer C
   70         %Integer A
   71  
   72         %Integer Start = 0
   73   
   74         %Integer Zero = 0
   75         %Integer Minus = -1
   76         %Integer Unassigned
   77  
   78         %String(255) S, T
   79  
   80         %Switch  EN (0 : 100)    { Event Number = Event * 10 + Sub
   81  
   82  
   83         %On %Event 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10  %Start
   84  
   85             Select Output ({1}0) %if K = 90   { Revert back to old stream.
   86  
   87             %If Event_Event = K // 10 %and Event_Sub {Event} = Rem (K, 10) %Start
   88                Print String ("Successfully trapped:  Event =")
   89                Write (K // 10, 1)
   90                Print String ("   Sub =")
   91                Write (Rem (K, 10), 1)
   92                New Line
   93             %finish %else %start
   94                Print String ("Should have trapped:  Event =")
   95                Write (K // 10, 1)
   96                Print String ("   Sub =")
   97                Write (Rem (K, 10), 1)
   98                New Line
   99                Print String ("Instead trapped:  Event =")
  100                Write (Event_Event, 1)
  101                Print String ("   Sub =")
  102                Write (Event_Sub {Event}, 1)
  103                New Line
  104            %Finish
  105            Start = K + 1
  106  
  107         %Finish
  108  
  109  
  110          %For K = Start, 1, 100 %cycle
  111          
  112  write(k,1);newline
  113             -> EN(K)
  114  
  115        
  116             EN(0):   { Normal Termination by the %STOP Instruction.
  117  
  118                      %Stop
  119                      -> Catch
?access
  120  
  121  
  122  
  123             EN(11):  { Integer Overflow
  124  
  125                      J = 2147483600       { Two to the power of 32.
  126                      C = J * 3
  127                      -> Catch
  128  
  129  
  130  
  131             EN(13):  { String Overflow.
  132  
  133                      S = "1234567890"
  134                      T = ""
  135                      T = T . S  %for J = 1, 1, 30
  136                      -> Catch
  137  
  138  
  139             EN(14):  { Division by zero.
  140  
  141                      J = Minus // Zero
  142                      -> Catch
  143  
  144  
  145   
  146          EN(21):  { Store Space Exhausted
  147  
  148                   %Begin
  149                      %Integer %Array Temp (1 : 10000000)
  150  
  151                      J = 10000000
  152                      Temp (J) = 1 
  153                    %End
  154                    -> Catch
  155  
  156  
  157          
  158          EN(33):   { Failure to open a file.
  159  
  160                    Open Input (2, "ZZZZZ.ZZZ")   { Non-existent?
  161                    -> Catch
  162  
  163  
  164  
  165          EN(41):   { Non-numeric char for numeric input.
  166  
  167                    Open Input (2, "Char.dat")
  168                    Select Input (2)
  169                    Read (J)
  170                    -> Catch
  171  
  172  
  173          
  174          EN(51):   { Inconsistent combination of values for %For loop.
  175  
  176                    J = 0
  177                    A = 0
  178                    %For C = 2, 1, J %cycle
  179                       A = A + 1 
  180                       %Exit %if A = 10   { Break an infinite loop.
  181                    %Repeat
  182                    -> Catch
  183  
  184  
  185  
  186  
  187          EN(52):   { Illegal exponent for exponentiation.
  188  
  189                    J = -4
  190                    C = 2 ^^ J
  191                    -> Catch
  192  
  193  
  194  
  195          EN(53):   { Upper bound less than lower in array declaration.
  196  
  197                    J = 20
  198                    %Begin
  199                       %Integer %Array  Temp (40 : J)
  200    
  201                       J = 35
  202                       Temp(J) = 10
  203                    %End
  204                    -> Catch
  205  
  206  
  207  
  208          EN(54):   { First index greater than second for SUB STRING.
  209  
  210                    S = "1234567890"
  211                    J = 20
  212                    S = Sub String (S, J, 5)
  213                    -> Catch
  214  
  215  
  216  
  217          EN(62):   { Array index out of bounds.
  218  
  219                    J = 20
  220                    %Begin
  221                       %Integer %Array  Temp (0 : J)
  222  
  223                       Temp (J + 5) = 29
  224                    %End
  225                    -> Catch
  226  
  227  
  228  
  229  
  230  
  231          EN(65):   { CHAR NO index out of range 1 to max string length.
  232  
  233                    S = "1234567890"
  234                    J = 20
  235                    C = Char No (S, J)
  236                    -> Catch
  237  
  238  
  239  
  240          EN(66):   { Value out of range for TO STRING.
  241  
  242                    S = To String (Minus)
  243                    -> Catch
  244  
  245  
  246  
  247          EN(67):   { Value out of range of OPEN and SELECT.
  248  
  249                    SELECT INPUT (20)
  250                    -> Catch
  251  
  252  
  253  
  254          EN(70):   { String Resolution error.
  255  
  256                    S = "ABCD"
  257                    S -> S.("EFGH")
  258                    -> Catch
  259  
  260  
  261  
  262          EN(81):   { Unassigned variable.
  263  
  264                    J = Unassigned
  265                    -> Catch
  266  
  267  
  268  
  269          EN(90):   { End of Input
  270  
  271                    Open Output (2, "Null.dat")
  272                    Select Output (2)
  273                    Close Output
  274                    Open Input (2, "Null.dat")
  275                    Select Input (2)
  276                    Read (J)
  277                    -> Catch
  278  
  279   
  280          
  281             Catch:  Print String ("FAILED to trap:  Event =")
  282                     Write (K // 10, 1)
  283                     Print String ("   Sub =")
  284                     Write (Rem (K, 10), 1)
  285                     New Line
  286  
  287   
  288             EN(*):
  289  
  290          %Repeat
  291          
  292  
  293      %End   { of Test Standard Events
  294          
  295  
  296  
  297     %Routine  Eventful (%Integer Trap)
  298  
  299         !*  Tests the trapping of events within a routine block.
  300         !*  Does the control fall through the bottom of the %On
  301         !*  block?  If a trap is not present will control be passed
  302         !*  to the parent block?
  303  
  304         %Integer E = 14
  305   
  306         %On %Event 14 %Start
  307            %Signal %Event 10, 116 %if E = 14 %and Trap = 1
  308            E = E + 1
  309         %Finish
  310  
  311         %Signal %Event 14  %if E = 14       
  312         %Signal %Event 15, 115, 20        { Test the _Extra field.
  313  
  314     %End  { of Eventful
  315  
  316  
  317  
  318  
  319  
  320     !*   The following set of routines test various aspects of 
  321     !*  procedures.  Firstly, it checks whether routines nested
  322     !*  to depth four can be handled.  Then it checks %Routine %Specs
  323     !*  and mutual recursion.  Finally, at a very deep recursion and
  324     !*  level of nesting, the signalling of an event.  This severe 
  325     !*  test checks the possibility of stack corruption and automatic
  326     !*  %Return from a great, complex depth.
  327  
  328  
  329     %Routine %Spec  Inc (%Integer D)
  330  
  331  
  332     %Routine  Inc2 (%Integer D)
  333   
  334         %Routine  Inc3 (%Integer D)
  335  
  336             %Routine  Inc4 (%Integer D)
  337    
  338                 %Routine  Inc5 (%Integer D)
  339  
  340                     %If D > 400 %then %Start
  341                        %Signal %Event 15, 118
  342                        Print String ("FAIL: To raise a deep event.")
?access
  343                        New Line
  344                        %Return
  345                     %Finish
  346                     Inc (D+1)    { Mutual Recursion.
  347  
  348                 %End  { of Inc5
  349  
  350                 Inc5 (D+1)
  351  
  352             %End  { of Inc4
  353  
  354             Inc4 (D+1)
  355  
  356         %End  { of Inc3
  357  
  358         Inc3 (D+1)
  359  
  360     %End  { of Inc2
  361                     
  362  
  363  
  364  
  365     %Routine  Inc (%Integer D)
  366   
  367         Inc2 (D+1)
  368  
  369     %End  { of Inc
  370  
  371  
  372  
  373     %if cliparam = "" %start
  374       Open Output (1, "/tmp/EVENTS.out")
  375     %else
  376       print string("Writing to ".cliparam); newline
  377       Open Output (1, cliparam)
  378     %finish
  379     Select Output (1)
  380  
  381     New Lines (3)
  382     
  383     Print String ("Test the Ability to Raise Standard Events"); New Line
  384     Print String ("-----------------------------------------")
  385     New Lines (2)
  386  
  387     Test Standard Events
  388  
  389     New Lines (2)
  390  
  391               Eventful(1)
  392     Resume2:  Eventful(0)
  393     Resume3:  Inc (1)
  394     Resume4:  
  395               Print String ("Returned from a depth correctly.")
  396               New Lines (2)
  397  
  398  select output(0)
  399  write(failures,1);  printstring(" failure(s)");  newline
  400  
  401  %End %of %Program

  206 Statements compiled
