(*
    Title:       TrapHandler - Implementation

    Author:      Mick Jordan + Bodges by Keith Rautenbach
    Cambridge University Computer Laboratory
    
    NS16K/Tiny Kernel version
*)

(* $T-, $R- *)

IMPLEMENTATION MODULE TrapHandler;
FROM SYSTEM IMPORT ADDRESS, WORD, TKCALL, ADR;
FROM SYSTEM IMPORT REGISTER ; (* Keith's Addition *)
FROM TKCalls IMPORT TKstring, TKnewl, TKexitProgram, TKbyte;

VAR
    m2s: ARRAY [0 .. 25] OF CHAR;

PROCEDURE Trap(n: CARDINAL);
    VAR
        s: ARRAY [0 .. 30] OF CHAR;
        rc: INTEGER;
        PcPtr, ModPtr, PBPtr  : ADDRESS ; (* Keith's Addition *)
        Pc,    Mod,    PB     : ADDRESS ; (* Keith's Addition *)
    BEGIN
        CASE n OF
          AllocateTrap: s := "ALLOCATE (NEW) failed";
        | DeAllocateTrap: s := "DEALLOCATE (DISPOSE) error";
        | CaseTrap: s := "CASE index out of range";
        | AssignTrap: s := "Assigned value out of range";
        | IndexTrap: s := "Array index out of range";
        | ReturnTrap: s := "missing RETURN in function";
        | HaltTrap: s := "HALT";
        ELSE s := "undecoded";
        END (* case *);
        
        rc := TKCALL(TKbyte, 3, 4);                      (* Keith's Addition *)
        rc := TKCALL(TKstring, ADR(m2s), Length(m2s)); 
        rc := TKCALL(TKstring, ADR(s), Length(s));
        rc := TKCALL(TKnewl);
        PcPtr := ADDRESS( REGISTER( 9 ) + 4 ) ;          (* Keith's Addition *)
        ModPtr := ADDRESS( REGISTER( 9 ) + 8 ) ;         (* Keith's Addition *)
        Pc := ADDRESS( PcPtr^ ) ;                        (* Keith's Addition *)
        Mod := ADDRESS( ModPtr^ ) MOD ( 64*1024 ) ;      (* Keith's Addition *)
        rc := TKCALL(TKnewl);                            (* Keith's Addition *)
        KeithString( "MOD:PC = " ) ;                     (* Keith's Addition *)
        KeithHexNum( CARDINAL( Mod ) ) ;                 (* Keith's Addition *)
        KeithString( ":0" ) ;                            (* Keith's Addition *)
        KeithHexNum( CARDINAL( Pc ) ) ;                  (* Keith's Addition *)
        KeithString( " =+" ) ;                           (* Keith's Addition *)
        PBPtr := Mod + 8 ;                               (* Keith's Addition *)
        PB := ADDRESS( PBPtr^ ) ;                        (* Keith's Addition *)
        KeithHexNum( CARDINAL( Pc ) - CARDINAL( PB ) ) ; (* Keith's Addition *)
        rc := TKCALL(TKnewl);                            (* Keith's Addition *)
        rc := TKCALL(TKexitProgram);
    END Trap;



(* Keith's Addition *)
PROCEDURE KeithString(Str : ARRAY OF CHAR ) ;
VAR
   Junk               : INTEGER ;
BEGIN
   Junk := TKCALL( TKstring , ADR( Str ) , Length( Str ) ) ;
END KeithString ;


(* Keith's Addition *)
PROCEDURE KeithHexNum( Num : CARDINAL ) ;
VAR
   Digit               : [ 0..15 ] ;
   Ch                  : CARDINAL ;
   Junk                : INTEGER ;
BEGIN
   IF Num >= 16 THEN
      KeithHexNum( Num DIV 16 ) ;
   END (* if *) ;
   Digit := Num MOD 16 ;
   IF Digit >= 10 THEN
      Ch := Digit + ORD( 'A' ) - 10 ;
   ELSE
      Ch := Digit + ORD( '0' ) ;
   END (* if *) ;
   Junk := TKCALL( 1 , Ch ) ;
END KeithHexNum ;




PROCEDURE Length(VAR s: ARRAY OF CHAR): CARDINAL;
    VAR
        i: CARDINAL;
    BEGIN
        i := 0;
        WHILE (i <= HIGH(s)) AND (s[i] # 0C) DO
            INC(i);
        END (* while *);
        RETURN i;
    END Length;
BEGIN
    m2s := "Modula-2 run-time trap - ";
END TrapHandler.