|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: R T
Length: 7699 (0x1e13)
Types: TextFile
Names: »RAISING_ASM«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦24d1ddd49⟧
└─⟦this⟧
; The use of this system is subject to the software license terms and
; conditions agreed upon between Rational and the Customer.
;
; Copyright 1988 by Rational.
;
; RESTRICTED RIGHTS LEGEND
;
; Use, duplication, or disclosure by the Government is subject to
; restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
; Technical Data and Computer Software clause at 52.227-7013.
;
;
; Rational
; 3320 Scott Boulevard
; Santa Clara, California 95054-3197
;
; PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
; USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
; IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
; AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
; 1976. CREATED 1988. ALL RIGHTS RESERVED.
;
;
.module "RAISING"
.include "^standard_assembler_include_file"
.include "^common.runtime_definitions"
.include "^common.os2000_definitions"
comp_unit runtime_compunit
.sect ada_runtime_code,code,relocatable,alignment:=2
.gbl.l __raise_exception
.gbl.l __propagate_exception
.gbl.l __raise_constraint_error
.gbl.l __raise_numeric_error
.gbl.l __raise_program_error
.gbl.l __raise_storage_error
.gbl.l __raise_tasking_error
.gbl.l __unelaborated_subprogram
.gbl.l __debug.raise
.gbl.l __prolog_check
.gbl.l __claim_check
.gbl.l __undefined_trap
.gbl.l __put_error_msg_and_exit
.ext.l __process_descriptor_pointer
.ext.l __runtime_entry_pointer
.ext.l __get_exception_indirect
.ext.l __set_exception_indirect
.ext.l __trace_exception
.ext.l __error_path
.ext.l __constraint_error
.ext.l __numeric_error
.ext.l __program_error
.ext.l __storage_error
.ext.l __tasking_error
no_op equ 16#4e71# ; the opcode "nop"
subprogram sp_rt,sp.internal,linkage.simple
__raise_tasking_error:
lea (__tasking_error:16,a5),a0
bra.b $move_and_raise
subprogram sp_rt,sp.internal,linkage.simple
__raise_storage_error:
lea (__storage_error:16,a5),a0
bra.b $move_and_raise
subprogram sp_rt,sp.internal,linkage.simple
__Raise_Numeric_Error:
lea (__numeric_error:16,a5),a0
bra.b $move_and_raise
subprogram sp_rt,sp.internal,linkage.simple
__unelaborated_subprogram:
__raise_program_error:
lea (__program_error:16,a5),a0
bra.b $move_and_raise
subprogram sp_rt,sp.internal,linkage.simple
__raise_constraint_error:
lea (__constraint_error:16,a5),a0
$move_and_raise:
move.l a0,d0
bra.w __raise_exception
;
; fall through to __Raise_Exception
;
subprogram sp_rt,sp.internal,linkage.simple
__raise_exception:
move.l (a7),-(a7) ; Save copy of raise pc
statement 0,0,1
move.l d0,-(a7) ; push exception id
statement 0,0,2
move.l d0,-(a7) ; push exception id
statement 0,0,3
movea.l (__Set_Exception_Indirect,a5),a0; routine to set Exception_Id
jsr (a0) ; for current context
statement 0,0,2
bsr.l __trace_exception
statement 0,0,1
; The debugger will set a breakpoint at the following NOP in order to
; intercept the raise of all exceptions. At this point, the raise PC
; must be on the top of the stack. It is only used by the debugger, so
; it is immediately thrown away when continuing beyond this point.
;
__debug.raise:
nop ; debugger breakpoint on NOP
addq.l #4,a7 ; Remove raise pc
statement 0,0,0
__propagate_exception:
.local
$search:move.l (4,a6),d0 ; get handler for current frame
bne.b handler_found ; any handler ?
$pop: unlk a6 ; no handler, so unwind frame
bra.b $search ; try next frame
handler_found:
movea.l d0,a0 ; a0 := handler address
cmpi.w #no_op,(a0) ; is it a finalization handler?
bne.b $finalize
move.l a0,-(a7) ; save handler address
statement 0,0,1
movea.l (__get_exception_indirect,a5),a0
jsr (a0) ; d0 := exception id
rts ; invoke handler
$finalize:
lea ($search:16,pc),a1 ; a1 := address of unwinder
move.l a1,(8,a6) ; replace return pc in frame
jmp (a0) ; invoke handler
;
; procedure prolog_check (amount : natural);
;
; Amount is passed in D0; This routine may alter D0, D1, and A0.
;
subprogram sp_rt,sp.internal,linkage.simple
__prolog_check:
movea.l (__process_descriptor_pointer,a5),a0
movea.l (a0),a0
add.l (art$stk_lo,a0),d0
cmp.l sp,d0
bhs.s out_of_stack
rts
;
; procedure Claim_Check (Amount : Natural);
;
; Amount is passed on the stack. This routine may not
; alter ANY registers.
;
subprogram sp_rt,sp.internal,linkage.simple
__claim_check:
move.l a0,-(sp) ; save a0
movea.l (__process_descriptor_pointer,a5),a0
movea.l (a0),a0
movea.l (art$stk_lo,a0),a0
adda.l (8,sp),a0
cmpa.l a0,sp
blo.s out_of_stack
movea.l (sp)+,a0
rtd #4
out_of_stack:
move.w (__error_path,a5),d0 ; get path for error messages
move.w #stack$request$warning,d1 ; get error number
ori.w #warning$code,d1 ; set high byte
trap #os9_call ; make system call to
.dc.w f$perr ; put error message
bra.w __raise_storage_error ; raise exception
;
; procedure undefined_trap;
;
subprogram sp_rt,sp.internal,linkage.trap
__undefined_trap:
statement 8,0,0
move.l a0, d1 ; save raise PC in d1
statement 1,0,0
movea.l a5,a0 ; get address of register save area
addq.l #8,a0 ; skip d0, d1
movem.l (a0)+,d2-d7 ; restore data registers
addq.l #8,a0 ; skip a0, a1
movem.l (a0)+,a2-a6 ; restore address registers
movea.l a1,a7 ; restore stack pointer
move.l d1,-(sp) ; push pc on stack
statement 16,0,0
clr.l -(sp) ; push null for exception name
statement 16,0,1
bsr.l __trace_exception
statement 16,0,0
move.w #unhandled$main$trap$ferror,d1; get error number
bra.w __put_error_msg_and_exit
subprogram sp_rt,sp.internal,linkage.simple
__put_error_msg_and_exit:
move.w (__error_path,a5),d0 ; get path for error messages
ori.w #error$code,d1 ; set high byte
trap #os9_call ; make system call
.dc.w f$perr ; to report error
moveq.l #some$error,d1 ; flag some error
trap #os9_call ; terminate process
.dc.w f$exit
end_subprograms
.end