gcc/m2/gm2-libs/RTExceptions.mod

   1 (* RTExceptions.mod runtime exception handler routines.
   2
   3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE RTExceptions ;
  28
  29 FROM ASCII IMPORT nul, nl ;
  30 FROM StrLib IMPORT StrLen ;
  31 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  32 FROM SYSTEM IMPORT ADR, THROW ;
  33 FROM libc IMPORT write, strlen ;
  34 FROM M2RTS IMPORT HALT, Halt ;
  35 FROM SysExceptions IMPORT InitExceptionHandlers ;
  36
  37 IMPORT M2EXCEPTION ;
  38
  39
  40 CONST
  41    MaxBuffer = 4096 ;
  42
  43 TYPE
  44    Handler = POINTER TO RECORD
  45                            p    : ProcedureHandler ;
  46                            n    : CARDINAL ;
  47                            right,
  48                            left,
  49                            stack: Handler ;
  50                         END ;
  51
  52    EHBlock = POINTER TO RECORD
  53                            buffer  : ARRAY [0..MaxBuffer] OF CHAR ;
  54                            number  : CARDINAL ;
  55                            handlers: Handler ;
  56                            right   : EHBlock ;
  57                         END ;
  58
  59    PtrToChar = POINTER TO CHAR ;
  60
  61
  62 VAR
  63    inException  : BOOLEAN ;
  64    freeHandler  : Handler ;
  65    freeEHB,
  66    currentEHB   : EHBlock ;
  67    currentSource: ADDRESS ;
  68
  69
  70 (*
  71    SetExceptionSource - sets the current exception source to, source.
  72 *)
  73
  74 PROCEDURE SetExceptionSource (source: ADDRESS) ;
  75 BEGIN
  76    currentSource := source
  77 END SetExceptionSource ;
  78
  79
  80 (*
  81    GetExceptionSource - returns the current exception source.
  82 *)
  83
  84 PROCEDURE GetExceptionSource () : ADDRESS ;
  85 BEGIN
  86    RETURN currentSource
  87 END GetExceptionSource ;
  88
  89
  90 (*
  91    ErrorString - writes a string to stderr.
  92 *)
  93
  94 PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
  95 VAR
  96    n: INTEGER ;
  97 BEGIN
  98    n := write(2, ADR(a), StrLen(a))
  99 END ErrorString ;
 100
 101
 102 (*
 103    findHandler -
 104 *)
 105
 106 PROCEDURE findHandler (e: EHBlock; number: CARDINAL) : Handler ;
 107 VAR
 108    h: Handler ;
 109 BEGIN
 110    h := e^.handlers^.right ;
 111    WHILE (h#e^.handlers) AND (number#h^.n) DO
 112       h := h^.right
 113    END ;
 114    IF h=e^.handlers
 115    THEN
 116       RETURN( NIL )
 117    ELSE
 118       RETURN( h )
 119    END
 120 END findHandler ;
 121
 122
 123 (*
 124    InvokeHandler - invokes the associated handler for the current
 125                    exception in the active EHB.
 126 *)
 127
 128 PROCEDURE InvokeHandler  <* noreturn *> ;
 129 VAR
 130    h: Handler ;
 131 BEGIN
 132    h := findHandler (currentEHB, currentEHB^.number) ;
 133    IF h=NIL
 134    THEN
 135       THROW (GetNumber (GetExceptionBlock ()))
 136    ELSE
 137       h^.p ;
 138       HALT
 139    END
 140 END InvokeHandler ;
 141
 142
 143 (*
 144    DefaultErrorCatch - displays the current error message in
 145                        the current exception block and then
 146                        calls HALT.
 147 *)
 148
 149 PROCEDURE DefaultErrorCatch ;
 150 VAR
 151    e: EHBlock ;
 152    n: INTEGER ;
 153 BEGIN
 154    e := GetExceptionBlock() ;
 155    n := write (2, GetTextBuffer (e), strlen (GetTextBuffer (e))) ;
 156    HALT
 157 END DefaultErrorCatch ;
 158
 159
 160 (*
 161    DoThrow - throw the exception number in the exception block.
 162 *)
 163
 164 PROCEDURE DoThrow ;
 165 BEGIN
 166    THROW (GetNumber (GetExceptionBlock ()))
 167 END DoThrow ;
 168
 169
 170 (*
 171    BaseExceptionsThrow - configures the Modula-2 exceptions to call
 172                          THROW which in turn can be caught by an
 173                          exception block.  If this is not called then
 174                          a Modula-2 exception will simply call an
 175                          error message routine and then HALT.
 176 *)
 177
 178 PROCEDURE BaseExceptionsThrow ;
 179 VAR
 180    i: M2EXCEPTION.M2Exceptions ;
 181 BEGIN
 182    FOR i := MIN(M2EXCEPTION.M2Exceptions) TO MAX(M2EXCEPTION.M2Exceptions) DO
 183       PushHandler (GetExceptionBlock (), VAL (CARDINAL, i), DoThrow)
 184    END
 185 END BaseExceptionsThrow ;
 186
 187
 188 (*
 189    addChar - adds, ch, to the current exception handler text buffer
 190              at index, i.  The index in then incremented.
 191 *)
 192
 193 PROCEDURE addChar (ch: CHAR; VAR i: CARDINAL) ;
 194 BEGIN
 195    IF (i<=MaxBuffer) AND (currentEHB#NIL)
 196    THEN
 197       currentEHB^.buffer[i] := ch ;
 198       INC(i)
 199    END
 200 END addChar ;
 201
 202
 203 (*
 204    stripPath - returns the filename from the path.
 205 *)
 206
 207 PROCEDURE stripPath (s: ADDRESS) : ADDRESS ;
 208 VAR
 209    f, p: PtrToChar ;
 210 BEGIN
 211    p := s ;
 212    f := s ;
 213    WHILE p^#nul DO
 214       IF p^='/'
 215       THEN
 216          INC(p) ;
 217          f := p
 218       ELSE
 219          INC(p)
 220       END
 221    END ;
 222    RETURN( f )
 223 END stripPath ;
 224
 225
 226 (*
 227    addFile - adds the filename determined by, s, however it strips
 228              any preceeding path.
 229 *)
 230
 231 PROCEDURE addFile (s: ADDRESS; VAR i: CARDINAL) ;
 232 VAR
 233    p: PtrToChar ;
 234 BEGIN
 235    p := stripPath(s) ;
 236    WHILE (p#NIL) AND (p^#nul) DO
 237       addChar(p^, i) ;
 238       INC(p)
 239    END
 240 END addFile ;
 241
 242
 243 (*
 244    addStr - adds a C string from address, s, into the current
 245             handler text buffer.
 246 *)
 247
 248 PROCEDURE addStr (s: ADDRESS; VAR i: CARDINAL) ;
 249 VAR
 250    p: PtrToChar ;
 251 BEGIN
 252    p := s ;
 253    WHILE (p#NIL) AND (p^#nul) DO
 254       addChar(p^, i) ;
 255       INC(p)
 256    END
 257 END addStr ;
 258
 259
 260 (*
 261    addNum - adds a number, n, to the current handler
 262             text buffer.
 263 *)
 264
 265 PROCEDURE addNum (n: CARDINAL; VAR i: CARDINAL) ;
 266 BEGIN
 267    IF n<10
 268    THEN
 269       addChar(CHR(n MOD 10 + ORD('0')), i)
 270    ELSE
 271       addNum(n DIV 10, i) ;
 272       addNum(n MOD 10, i)
 273    END
 274 END addNum ;
 275
 276
 277 (*
 278    Raise - invoke the exception handler associated with, number,
 279            in the active EHBlock.  It keeps a record of the number
 280            and message in the EHBlock for later use.
 281 *)
 282
 283 PROCEDURE Raise (number: CARDINAL;
 284                  file: ADDRESS; line: CARDINAL;
 285                  column: CARDINAL; function: ADDRESS;
 286                  message: ADDRESS) ;
 287 VAR
 288    i: CARDINAL ;
 289 BEGIN
 290    currentEHB^.number := number ;
 291    i := 0 ;
 292    addFile (file, i) ;
 293    addChar (':', i) ;
 294    addNum (line, i) ;
 295    addChar (':', i) ;
 296    addNum (column, i) ;
 297    addChar (':', i) ;
 298    addChar (' ', i) ;
 299    addChar ('I', i) ;
 300    addChar ('n', i) ;
 301    addChar (' ', i) ;
 302    addStr (function, i) ;
 303    addChar (nl, i) ;
 304    addFile (file, i) ;
 305    addChar (':', i) ;
 306    addNum (line, i) ;
 307    addChar (':', i) ;
 308    addNum (column, i) ;
 309    addChar (':', i) ;
 310    addStr (message, i) ;
 311    addChar (nl, i) ;
 312    addChar (nul, i) ;
 313    InvokeHandler
 314 END Raise ;
 315
 316
 317 (*
 318    SetExceptionBlock - sets, source, as the active EHB.
 319 *)
 320
 321 PROCEDURE SetExceptionBlock (source: EHBlock) ;
 322 BEGIN
 323    currentEHB := source
 324 END SetExceptionBlock ;
 325
 326
 327 (*
 328    GetExceptionBlock - returns the active EHB.
 329 *)
 330
 331 PROCEDURE GetExceptionBlock () : EHBlock ;
 332 BEGIN
 333    RETURN( currentEHB )
 334 END GetExceptionBlock ;
 335
 336
 337 (*
 338    GetTextBuffer - returns the address of the EHB buffer.
 339 *)
 340
 341 PROCEDURE GetTextBuffer (e: EHBlock) : ADDRESS ;
 342 BEGIN
 343    RETURN( ADR(e^.buffer) )
 344 END GetTextBuffer ;
 345
 346
 347 (*
 348    GetTextBufferSize - return the size of the EHB text buffer.
 349 *)
 350
 351 PROCEDURE GetTextBufferSize (e: EHBlock) : CARDINAL ;
 352 BEGIN
 353    RETURN SIZE(e^.buffer)
 354 END GetTextBufferSize ;
 355
 356
 357 (*
 358    GetNumber - return the exception number associated with,
 359                source.
 360 *)
 361
 362 PROCEDURE GetNumber (source: EHBlock) : CARDINAL ;
 363 BEGIN
 364    RETURN( source^.number )
 365 END GetNumber ;
 366
 367
 368 (*
 369    New - returns a new EHBlock.
 370 *)
 371
 372 PROCEDURE New () : EHBlock ;
 373 VAR
 374    e: EHBlock ;
 375 BEGIN
 376    IF freeEHB=NIL
 377    THEN
 378       NEW(e)
 379    ELSE
 380       e := freeEHB ;
 381       freeEHB := freeEHB^.right
 382    END ;
 383    RETURN( e )
 384 END New ;
 385
 386
 387 (*
 388    InitExceptionBlock - creates and returns a new exception block.
 389 *)
 390
 391 PROCEDURE InitExceptionBlock () : EHBlock ;
 392 VAR
 393    e: EHBlock ;
 394 BEGIN
 395    e := New() ;
 396    WITH e^ DO
 397       number := MAX(CARDINAL) ;
 398       handlers := NewHandler() ;   (* add the dummy onto the head *)
 399       handlers^.right := handlers ;
 400       handlers^.left := handlers ;
 401       right := e
 402    END ;
 403    RETURN( e )
 404 END InitExceptionBlock ;
 405
 406
 407 (*
 408    KillExceptionBlock - destroys the EHB, e, and all its handlers.
 409 *)
 410
 411 PROCEDURE KillExceptionBlock (e: EHBlock) : EHBlock ;
 412 BEGIN
 413    e^.handlers := KillHandlers(e^.handlers) ;
 414    e^.right := freeEHB ;
 415    freeEHB := e ;
 416    RETURN( NIL )
 417 END KillExceptionBlock ;
 418
 419
 420 (*
 421    NewHandler - returns a new handler.
 422 *)
 423
 424 PROCEDURE NewHandler () : Handler ;
 425 VAR
 426    h: Handler ;
 427 BEGIN
 428    IF freeHandler=NIL
 429    THEN
 430       NEW(h)
 431    ELSE
 432       h := freeHandler ;
 433       freeHandler := freeHandler^.right
 434    END ;
 435    RETURN( h )
 436 END NewHandler ;
 437
 438
 439 (*
 440    KillHandler - returns, NIL, and places, h, onto the free list.
 441 *)
 442
 443 PROCEDURE KillHandler (h: Handler) : Handler ;
 444 BEGIN
 445    h^.right := freeHandler ;
 446    freeHandler := h ;
 447    RETURN( NIL )
 448 END KillHandler ;
 449
 450
 451 (*
 452    KillHandlers - kills all handlers in the list.
 453 *)
 454
 455 PROCEDURE KillHandlers (h: Handler) : Handler ;
 456 BEGIN
 457    h^.left^.right := freeHandler ;
 458    freeHandler := h ;
 459    RETURN( NIL )
 460 END KillHandlers ;
 461
 462
 463 (*
 464    InitHandler -
 465 *)
 466
 467 PROCEDURE InitHandler (h: Handler; l, r, s: Handler; number: CARDINAL; proc: ProcedureHandler) : Handler ;
 468 BEGIN
 469    WITH h^ DO
 470       p := proc ;
 471       n := number ;
 472       right := r ;
 473       left := l ;
 474       stack := s
 475    END ;
 476    RETURN( h )
 477 END InitHandler ;
 478
 479
 480 (*
 481    SubHandler -
 482 *)
 483
 484 PROCEDURE SubHandler (h: Handler) ;
 485 BEGIN
 486    h^.right^.left := h^.left ;
 487    h^.left^.right := h^.right ;
 488 END SubHandler ;
 489
 490
 491 (*
 492    AddHandler - add, e, to the end of the list of handlers.
 493 *)
 494
 495 PROCEDURE AddHandler (e: EHBlock; h: Handler) ;
 496 BEGIN
 497    h^.right := e^.handlers ;
 498    h^.left := e^.handlers^.left ;
 499    e^.handlers^.left^.right := h ;
 500    e^.handlers^.left := h
 501 END AddHandler ;
 502
 503
 504 (*
 505    PushHandler - install a handler in EHB, e.
 506 *)
 507
 508 PROCEDURE PushHandler (e: EHBlock; number: CARDINAL; p: ProcedureHandler) ;
 509 VAR
 510    h, i: Handler ;
 511 BEGIN
 512    h := findHandler(e, number) ;
 513    IF h=NIL
 514    THEN
 515       i := InitHandler(NewHandler(), NIL, NIL, NIL, number, p) ;
 516    ELSE
 517       (* remove, h, *)
 518       SubHandler(h) ;
 519       (* stack it onto a new handler *)
 520       i := InitHandler(NewHandler(), NIL, NIL, h, number, p) ;
 521    END ;
 522    (* add new handler *)
 523    AddHandler(e, i)
 524 END PushHandler ;
 525
 526
 527 (*
 528    PopHandler - removes the handler associated with, number, from
 529                 EHB, e.
 530 *)
 531
 532 PROCEDURE PopHandler (e: EHBlock; number: CARDINAL) ;
 533 VAR
 534    h: Handler ;
 535 BEGIN
 536    h := findHandler(e, number) ;
 537    IF h#NIL
 538    THEN
 539       (* remove, h, *)
 540       SubHandler(h) ;
 541       IF h^.stack#NIL
 542       THEN
 543          AddHandler(e, h^.stack)
 544       END ;
 545       h := KillHandler(h)
 546    END
 547 END PopHandler ;
 548
 549
 550 (*
 551    IsInExceptionState - returns TRUE if the program is currently
 552                         in the exception state.
 553 *)
 554
 555 PROCEDURE IsInExceptionState () : BOOLEAN ;
 556 BEGIN
 557    RETURN( inException )
 558 END IsInExceptionState ;
 559
 560
 561 (*
 562    SetExceptionState - returns the current exception state and
 563                        then sets the current exception state to,
 564                        to.
 565 *)
 566
 567 PROCEDURE SetExceptionState (to: BOOLEAN) : BOOLEAN ;
 568 VAR
 569    old: BOOLEAN ;
 570 BEGIN
 571    old := inException ;
 572    inException := to ;
 573    RETURN( old )
 574 END SetExceptionState ;
 575
 576
 577 (*
 578    SwitchExceptionState - assigns, from, with the current exception
 579                           state and then assigns the current exception
 580                           to, to.
 581 *)
 582
 583 PROCEDURE SwitchExceptionState (VAR from: BOOLEAN; to: BOOLEAN) ;
 584 BEGIN
 585    from := inException ;
 586    inException := to
 587 END SwitchExceptionState ;
 588
 589
 590 (*
 591    GetBaseExceptionBlock - returns the initial language exception block
 592                            created.
 593 *)
 594
 595 PROCEDURE GetBaseExceptionBlock () : EHBlock ;
 596 BEGIN
 597    IF currentEHB=NIL
 598    THEN
 599       Halt('currentEHB has not been initialized yet',
 600            __FILE__, __FUNCTION__, __LINE__)
 601    ELSE
 602       RETURN( currentEHB )
 603    END
 604 END GetBaseExceptionBlock ;
 605
 606
 607 (*
 608    indexf - raise an index out of bounds exception.
 609 *)
 610
 611 PROCEDURE indexf (a: ADDRESS) ;
 612 BEGIN
 613    Raise(ORD(M2EXCEPTION.indexException),
 614          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 615          ADR("array index out of bounds"))
 616 END indexf ;
 617
 618
 619 (*
 620    range - raise an assignment out of range exception.
 621 *)
 622
 623 PROCEDURE range (a: ADDRESS) ;
 624 BEGIN
 625    Raise(ORD(M2EXCEPTION.rangeException),
 626          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 627          ADR("assignment out of range"))
 628 END range ;
 629
 630
 631 (*
 632    casef - raise a case selector out of range exception.
 633 *)
 634
 635 PROCEDURE casef (a: ADDRESS) ;
 636 BEGIN
 637    Raise(ORD(M2EXCEPTION.caseSelectException),
 638          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 639          ADR("case selector out of range"))
 640 END casef ;
 641
 642
 643 (*
 644    invalidloc - raise an invalid location exception.
 645 *)
 646
 647 PROCEDURE invalidloc (a: ADDRESS) ;
 648 BEGIN
 649    Raise(ORD(M2EXCEPTION.invalidLocation),
 650          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 651          ADR("invalid address referenced"))
 652 END invalidloc ;
 653
 654
 655 (*
 656    function - raise a ... function ... exception.  --fixme-- what does this exception catch?
 657 *)
 658
 659 PROCEDURE function (a: ADDRESS) ;
 660 BEGIN
 661    Raise(ORD(M2EXCEPTION.functionException),
 662          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 663          ADR("... function ... "))  (* --fixme-- what has happened ? *)
 664 END function ;
 665
 666
 667 (*
 668    wholevalue - raise an illegal whole value exception.
 669 *)
 670
 671 PROCEDURE wholevalue (a: ADDRESS) ;
 672 BEGIN
 673    Raise(ORD(M2EXCEPTION.wholeValueException),
 674          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 675          ADR("illegal whole value exception"))
 676 END wholevalue ;
 677
 678
 679 (*
 680    wholediv - raise a division by zero exception.
 681 *)
 682
 683 PROCEDURE wholediv (a: ADDRESS) ;
 684 BEGIN
 685    Raise(ORD(M2EXCEPTION.wholeDivException),
 686          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 687          ADR("illegal whole value exception"))
 688 END wholediv ;
 689
 690
 691 (*
 692    realvalue - raise an illegal real value exception.
 693 *)
 694
 695 PROCEDURE realvalue (a: ADDRESS) ;
 696 BEGIN
 697    Raise(ORD(M2EXCEPTION.realValueException),
 698          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 699          ADR("illegal real value exception"))
 700 END realvalue ;
 701
 702
 703 (*
 704    realdiv - raise a division by zero in a real number exception.
 705 *)
 706
 707 PROCEDURE realdiv (a: ADDRESS) ;
 708 BEGIN
 709    Raise(ORD(M2EXCEPTION.realDivException),
 710          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 711          ADR("real number division by zero exception"))
 712 END realdiv ;
 713
 714
 715 (*
 716    complexvalue - raise an illegal complex value exception.
 717 *)
 718
 719 PROCEDURE complexvalue (a: ADDRESS) ;
 720 BEGIN
 721    Raise(ORD(M2EXCEPTION.complexValueException),
 722          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 723          ADR("illegal complex value exception"))
 724 END complexvalue ;
 725
 726
 727 (*
 728    complexdiv - raise a division by zero in a complex number exception.
 729 *)
 730
 731 PROCEDURE complexdiv (a: ADDRESS) ;
 732 BEGIN
 733    Raise(ORD(M2EXCEPTION.complexDivException),
 734          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 735          ADR("complex number division by zero exception"))
 736 END complexdiv ;
 737
 738
 739 (*
 740    protection - raise a protection exception.
 741 *)
 742
 743 PROCEDURE protection (a: ADDRESS) ;
 744 BEGIN
 745    Raise(ORD(M2EXCEPTION.protException),
 746          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 747          ADR("protection exception"))
 748 END protection ;
 749
 750
 751 (*
 752    systemf - raise a system exception.
 753 *)
 754
 755 PROCEDURE systemf (a: ADDRESS) ;
 756 BEGIN
 757    Raise(ORD(M2EXCEPTION.sysException),
 758          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 759          ADR("system exception"))
 760 END systemf ;
 761
 762
 763 (*
 764    coroutine - raise a coroutine exception.
 765 *)
 766
 767 PROCEDURE coroutine (a: ADDRESS) ;
 768 BEGIN
 769    Raise(ORD(M2EXCEPTION.coException),
 770          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 771          ADR("coroutine exception"))
 772 END coroutine ;
 773
 774
 775 (*
 776    exception - raise a exception exception.
 777 *)
 778
 779 PROCEDURE exception (a: ADDRESS) ;
 780 BEGIN
 781    Raise(ORD(M2EXCEPTION.exException),
 782          ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
 783          ADR("exception exception"))
 784 END exception ;
 785
 786
 787 (*
 788    Init - initialises this module.
 789 *)
 790
 791 PROCEDURE Init ;
 792 BEGIN
 793    inException := FALSE ;
 794    freeHandler := NIL ;
 795    freeEHB := NIL ;
 796    currentEHB := InitExceptionBlock() ;
 797    currentSource := NIL ;
 798    BaseExceptionsThrow ;
 799    InitExceptionHandlers(indexf, range, casef, invalidloc,
 800                          function, wholevalue, wholediv,
 801                          realvalue, realdiv, complexvalue,
 802                          complexdiv, protection, systemf,
 803                          coroutine, exception)
 804 END Init ;
 805
 806
 807 (*
 808    TidyUp - deallocate memory used by this module.
 809 *)
 810
 811 PROCEDURE TidyUp ;
 812 VAR
 813    f: Handler ;
 814    e: EHBlock ;
 815 BEGIN
 816    IF currentEHB#NIL
 817    THEN
 818       currentEHB := KillExceptionBlock(currentEHB)
 819    END ;
 820    WHILE freeHandler#NIL DO
 821       f := freeHandler ;
 822       freeHandler := freeHandler^.right ;
 823       DISPOSE(f)
 824    END ;
 825    WHILE freeEHB#NIL DO
 826       e := freeEHB ;
 827       freeEHB := freeEHB^.right ;
 828       DISPOSE(e)
 829    END
 830 END TidyUp ;
 831
 832
 833 BEGIN
 834    Init
 835 FINALLY
 836    TidyUp
 837 END RTExceptions.