|
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: A T
Length: 96486 (0x178e6)
Types: TextFile
Names: »ADAROOT_SHARED_LIST«
└─⟦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 "ADAROOT_SHARED"
;
; This assembly file is the root of the ADA runtime support
; for an programs which may create tasks.
;
.include "^^standard_assembler_include_file"
00000000 .push_list
00000000 .pop_list
00000000 .list macro_expansion = none
.include "^^common.runtime_definitions"
;
; This number is used to check the compatibility
; of the program and the loaded shared runtime.
; The value must be incremented whenever an execution
; incompatible change is made in the runtime.
;
; Version Incompatible changes in this version
; ------- ------------------------------------
; 0 Initial release of shared runtime
;
; 1 Changed Os2000_Process_Defs to use
; special Ada work area rather than
; user accounting area.
;
; 2 Added 12 long words of spare storage
; in Runtime_Data; this will permit
; some addition of data in the shared
; runtime to be compatible.
;
; 3 1.) Rev 6 compiler
; 2.) Runtime entry point table now 16-bit
; offset from table to entry in words.
; 3.) Deleted some unnecessary shared data items.
; 4.) General cleanup
compatibility_version equ 3
;
; Amount of stack space reserved for the runtime in bytes
;
runtime$stack$cushion equ 1024
;
; Values for certain runtime error messages and warnings.
;
error$code equ 16#8000#
warning$code equ 16#8100#
elaboration$ferror equ 1
finalization$ferror equ 2
unhandled$main$trap$ferror equ 3
lib$exception$ferror equ 5
main$exception$ferror equ 6
init$trap$handler$ferror equ 37
insufficient$stack$ferror equ 44
no$runtime$ferror equ 45
rt$incompatible$ferror equ 46
task$exception$warning equ 1
heap$create$warning equ 2
stack$request$warning equ 4
;
; Values used in exit system call
;
No$Error equ 0
Some$Error equ 1
;
; Comp Unit id for all runtime units except predefined exceptions
;
runtime_compunit equ 17
;
; Comp Unit id for predefined exception
;
exception_compunit equ 1
;
; Subprogram kind for runtime suprograms
;
sp_rt equ 1
;
; Special statement numbers
;
stmt.end_prolog equ 1
stmt.begin_epilog equ 16#7FFF#
;
; Subprogram ids for debug directives within runtime
; entry points.
;
sp.internal equ 16#0_00#
sp.enum_image equ 16#1_00#
sp.enum_pos equ 16#1_01#
sp.enum_pred equ 16#1_02#
sp.enum_succ equ 16#1_03#
sp.enum_value equ 16#1_04#
sp.enum_width equ 16#1_05#
sp.int_image equ 16#1_06#
sp.int_value equ 16#1_07#
sp.int_width equ 16#1_08#
sp.allocate_collection equ 16#2_00#
sp.allocate_fixed_cell equ 16#2_01#
sp.deallocate_collection equ 16#2_02#
sp.deallocate_fixed_cell equ 16#2_03#
sp.collection_size equ 16#2_04#
sp.initialize_master equ 16#3_00#
sp.create_task equ 16#3_01#
sp.activate_offspring equ 16#3_02#
sp.notify_parent equ 16#3_03#
sp.task_end equ 16#3_04#
sp.await_dependents equ 16#3_05#
sp.task_completion equ 16#3_06#
sp.terminate_allocated_offspring equ 16#3_07#
sp.terminate_dependent_offspring equ 16#3_08#
sp.entry_call equ 16#3_09#
sp.conditional_entry_call equ 16#3_0A#
sp.timed_entry_call equ 16#3_0B#
sp.begin_accept equ 16#3_0C#
sp.end_accept equ 16#3_0D#
sp.quick_accept equ 16#3_0E#
sp.close_alternatives equ 16#3_0F#
sp.open_delay equ 16#3_10#
sp.open_entry equ 16#3_11#
sp.open_terminate equ 16#3_12#
sp.select_rendezvous equ 16#3_13#
sp.abort_multiple_tasks equ 16#3_14#
sp.check_return_task equ 16#3_15#
sp.delay_statement equ 16#3_16#
sp.entry_count equ 16#3_17#
sp.task_callable equ 16#3_18#
sp.task_stack_size equ 16#3_19#
sp.task_terminated equ 16#3_1A#
sp.raise_exception equ 16#4_00#
sp.raise_constraint_error equ 16#4_01#
sp.propagate_exception equ 16#4_02#
sp.stack_check equ 16#4_03#
sp.mantissa equ 16#5_00#
sp.large equ 16#5_01#
sp.fixed_multiply equ 16#5_02#
sp.compare_8_bit_unsigned equ 16#5_03#
sp.compare_8_bit_signed equ 16#5_04#
sp.compare_16_bit_unsigned equ 16#5_05#
sp.compare_16_bit_signed equ 16#5_06#
sp.compare_32_bit_unsigned equ 16#5_07#
sp.compare_32_bit_signed equ 16#5_08#
;
; Linkage mechanisms used in assembly routines.
;
; Identification of the mechanism in a .subprogram directive
; and information provided in .statement directives enable
; the debugger to find the return pc.
;
linkage.frame equ 16#00_00_00_00# ; return pc may be found at
; offset from frame pointer
linkage.simple equ 16#10_00_00_00# ; return pc may be found at
; offset from stack pointer
linkage.none equ 16#50_00_00_00# ; no return pc exists,
; in bottom routine
linkage.trap equ 16#60_00_00_00# ; in trap handling code
;
; Definitions for locking primitives
;
.offset 0 ; type Q_Element is
; record
00000008 element'size: ; end record;
;
; Ada task control block (TCB) definitions
;
.offset 0
00000050 tcb'size:
b.action_state.exception_pending equ 3
.include "^^common.os2000_definitions"
;
; Definitions for CCT (Communication Control Table)
;
cct_start equ 1024 ; CCT offset from window start
pi_cpt equ 88 ; Offset for pointer to CPT
;
; HSI addressing conventions
;
a32_size equ 16#02000000#;
;
; Offsets in the Configuration Parameter Table.
;
CPT_System_Time equ 0 ; Offset to system time HW pointer
CPT_Political_Time equ 4 ; Offset to political time offset
CPT_Current_Proc equ 64 ; Offset to Os9 current process pointer
CPT_MsgQ_Pointer equ 144 ; Offset to Message_Queues pointer
; points to MqGlobals control block
CPT_Ada_Runtime_Ptr equ 152 ; Offset in CPT to Ada Runtime pointer
; points to beginning of table of
; runtime entry points
;
; OS9 system call definitions
;
os9_call equ 0
;
; An OS9 system call is perform with the following sequence:
; trap #OS9_Call
; .dc.w call_code
;
; where call code is one of the following user mode calls
; or I/O calls
;
; User mode system call definitions
;
F$Exit equ 16#006#
F$Fork equ 16#003#
F$Icpt equ 16#009#
F$Julian equ 16#020#
F$Link equ 16#000#
F$PEAB equ 16#0FA#
F$PErr equ 16#00F#
F$RTE equ 16#01E#
F$SPrior equ 16#00D#
F$SRqMem equ 16#028#
F$STime equ 16#016#
F$STrap equ 16#00E#
F$Send equ 16#008#
F$Sleep equ 16#00A#
F$Time equ 16#015#
;
; OS9 I/O system call definitions
;
I$Close equ 16#08F#
I$Create equ 16#083#
I$Delete equ 16#087#
I$GetStt equ 16#08D#
I$Last equ 16#093#
I$Open equ 16#084#
I$Read equ 16#089#
I$ReadLn equ 16#08B#
I$SGetSt equ 16#092#
I$Seek equ 16#088#
I$SetStt equ 16#08E#
I$WritLn equ 16#08C#
I$Write equ 16#08A#;
;
; Access mode for Open
;
Read_Mode equ 1
Write_Mode equ 2
Execute equ 4
;
; Function codes for the I$GetStt call
;
SS_Opt equ 16#0000#
SS_Size equ 16#0002#
SS_Pos equ 16#0005#
SS_EOF equ 16#0006#
SS_DevNm equ 16#000E#
;
; Standard paths
;
Standard_Input equ 0
Standard_Output equ 1
Standard_Error equ 2
;
; I/O Error Codes
;
E$BPNum equ 16#00C9# ; bad path number
;
; OS9 trap definitions
;
T_AddErr equ 16#000C#
T_BusErr equ 16#0008#
T_IllIns equ 16#0010#
T_CHK equ 16#0018#
T_TRAPV equ 16#001C#
T_FPDivZer equ 16#00C8#
T_FPInxact equ 16#00C4#
T_FPNotNum equ 16#00D8#
T_FPOprErr equ 16#00D0#
T_FPOverFl equ 16#00D4#
T_FPUndrFl equ 16#00CC#
T_FPUnordC equ 16#00C0#
T_ZerDiv equ 16#0014#
;
; OS2000 process descriptor definitions
;
P$DefIOSiz equ 32 ; Default I/O data area size
P$NumPaths equ 32 ; Number of local paths
P$MemBlks equ 32 ; Number of separate memory blocks per process
.offset 0 ; Process descriptor
00000398 p$JobCon:
000003A8 P$AdaWrk:
000003E8 P$Last: ; Size of a process header
00000800 P$Stack: ; Top of system stack for process
00000800 P$Size: ; Size of process descriptor
;
; Values for process state (P$STATE)
;
P$SysState equ 16#80# ; Executing system state routine
P$TimSleep equ 16#40# ; Timed sleep
P$TimOut equ 16#20# ; time slice has expired
P$ImgChg equ 16#10# ; SPU/MMU protection map has changed
P$Condemn equ 16#02# ; process is condemned
P$Dead equ 16#01# ; Process has terminated
;
; Values for process queue id (P$QUEUID
;
P$QActive equ 'a' ; active process queue
P$QSleep equ 's' ; sleep queue
P$QWait equ 'w' ; Waiting queue
P$QEvent equ 'e' ; Event queue
P$QCurrnt equ '*' ; No queue, currently running
P$QDebug equ 'd' ; No queue, inactively debugging
P$QDead equ '-' ; No queue, dead process
;
; User register stack image
;
.offset 0
00000048 R$Size: ; Size of register package
;
; Status register equates
;
R$TraceBit equ 16#8000# ; Trace bit in SR word
R$SupvrBit equ 16#2000# ; Supervisor bit in SR word
R$IntMask equ 16#0700# ; Interrupt mask in SR word
R$Extend equ 16#0010# ; Extend bit
R$Negative equ 16#0008# ; Negative bit
R$Zero equ 16#0004# ; Zero bit
R$Ov equ 16#0002# ; Overflow
R$Carry equ 16#0001# ; Carry
; 68881 FPU context save area
.offset 0
comp_unit runtime_compunit
.sect ada_runtime_code,code,relocatable,alignment:=2
;
; Entry points from the elaboration code for a sequential program
;
.gbl.l _.start_sequential
.gbl.l __middle_sequential
.gbl.l _.finish_sequential
;
; Entry points from the elaboration code for a tasking program
;
.gbl.l _.start_tasking
.gbl.l __middle_tasking
.gbl.l _.finish_tasking
.gbl.l __process_exit ; called from task end
.gbl.l __undefined_trap ; referenced in module header
.gbl.l __get_fp ; return current frame pointer
.ext.l __root_finish_return
.ext.l __task_create_return
.ext.l __task_finish_return
.ext.l __rt_elaborate_indirect
.ext.l __rt_finalize_indirect
.ext.l __heap_ptr;
.ext.l __heap_size_var;
.ext.l __os_param_ptr;
.ext.l __os_param_size;
.ext.l __module_base_address
.ext.l __global_base
.ext.l __root_tcb
.ext.l __root_task_id
.ext.l __data_size_var
.ext.l __main_code_start_var
.ext.l __task_code_start_var
.ext.a __msgq_entry_pointer
.ext.a __process_descriptor_pointer
.ext.a __runtime_entry_pointer
.ext.l __report_fatal_error
.ext.l __issue_warning
.ext.l __main_handler_ferror
.ext.l __error_path
.ext.l __sequential_finalization
.ext.l __sequential_elaboration
.ext.l __tasking_elaboration
.ext.l __tasking_finalization
.ext.l __task_end
.ext.l __raise_exception
.ext.l __program_error
.ext.l __numeric_error
.ext.l __constraint_error
.ext.l __trace_exception
.ext.l __tasking_lock
.ext.l __serialization.acquire_lock
.ext.l __release_task_lock
.ext.l __set_exception
.ext.l __get_exception
.ext.l __set_exception_indirect
.ext.l __get_exception_indirect
.ext.l __abort_main_program
.ext.l __abort_main_indirect
.ext.l __sequential_delay_statement
.ext.l __tasking_delay_statement
.ext.l __tdlystm_indirect
.ext.l __sequential_signal_intercept
.ext.l __tasking_signal_intercept
.ext.l __signal_intercept_indirect
.ext.l __runtime_compatibility_value
;
; Definitions of 68881 trap enable bit assignments and rounding mode
;
bsun$enable equ 2#1000_0000_0000_0000#;
snan$enable equ 2#0100_0000_0000_0000#;
operr$enable equ 2#0010_0000_0000_0000#;
ovfl$enable equ 2#0001_0000_0000_0000#;
unfl$enable equ 2#0000_1000_0000_0000#;
dz$enable equ 2#0000_0100_0000_0000#;
inex2$enable equ 2#0000_0010_0000_0000#;
inex1$enable equ 2#0000_0001_0000_0000#;
m68881$traps equ operr$enable ! ovfl$enable ! dz$enable;
round$extended equ 2#0000_0000_0000_0000#;
round$single equ 2#0000_0000_0100_0000#;
round$double equ 2#0000_0000_1000_0000#;
round$nearest equ 2#0000_0000_0000_0000#;
round$zero equ 2#0000_0000_0001_0000#;
round$minf equ 2#0000_0000_0010_0000#;
round$pinf equ 2#0000_0000_0011_0000#;
m68881$round equ round$extended ! round$nearest
m68881$control equ m68881$traps ! m68881$round
;
; Return frame pointer one level up. Thus is A calls B which calls
; __get_fp, the value returned is the frame pointer for routine A.
;
subprogram sp_rt,sp.internal,linkage.none
.local
.align 2
00000000 __get_fp:
00000000 200E move.l a6,d0 ; get current fp
00000002 20300990 move.l (d0.l*1),d0 ; Get fp one level up
00000006 4E75 rts ; -> Done
;
\f
;
; Initial entry point from the program after fork;
; the global data pointer has already been setup
; in the unshared program code. The current process id
; has been moved from D0 to D4. Address to return
; to in the program on top of stack
;
subprogram sp_rt,sp.internal,linkage.none
00000008 _.start_sequential:
.local
00000008 41FB017000000000 lea (__sequential_elaboration,pc),a0 ; store indirection
00000010 2B88017000000000 move.l a0,(__rt_elaborate_indirect,a5) ; for runtime elab
00000018 41FB017000000000 lea (__sequential_finalization,pc),a0 ; store indirection
00000020 2B88017000000000 move.l a0,(__rt_finalize_indirect,a5) ; for runtime finalize
00000028 41FB017000000000 lea (set$current$exception,pc),a0 ; store indirection
00000030 2B88017000000000 move.l a0,(__set_exception_indirect,a5) ; for set_exception
00000038 41FB017000000000 lea (get$current$exception,pc),a0 ; store indirection
00000040 2B88017000000000 move.l a0,(__get_exception_indirect,a5) ; for get_exception
00000048 41FB017000000000 lea (__sequential_delay_statement,pc),a0 ; store indirection
00000050 2B88017000000000 move.l a0,(__tdlystm_indirect,a5) ; for delay_statement
00000058 41FB017000000000 lea (__sequential_signal_intercept,pc),a0 ; store indirection
00000060 2B88017000000000 move.l a0,(__signal_intercept_indirect,a5) ; for signal_intercept
00000068 6000 bra.b common_start
subprogram sp_rt,sp.internal,linkage.none
0000006A _.start_tasking:
.local
0000006A 41FB017000000000 lea (__tasking_elaboration,pc),a0 ; store indirection
00000072 2B88017000000000 move.l a0,(__rt_elaborate_indirect,a5) ; for runtime elab
0000007A 41FB017000000000 lea (__tasking_finalization,pc),a0 ; store indirection
00000082 2B88017000000000 move.l a0,(__rt_finalize_indirect,a5) ; for runtime finalize
0000008A 41FB017000000000 lea (__set_exception,pc),a0 ; store indirection
00000092 2B88017000000000 move.l a0,(__set_exception_indirect,a5) ; for set_exception
0000009A 41FB017000000000 lea (__get_exception,pc),a0 ; store indirection
000000A2 2B88017000000000 move.l a0,(__get_exception_indirect,a5) ; for get_exception
000000AA 41FB017000000000 lea (__tasking_delay_statement,pc),a0 ; store indirection
000000B2 2B88017000000000 move.l a0,(__tdlystm_indirect,a5) ; for delay_statement
000000BA 41FB017000000000 lea (__tasking_signal_intercept,pc),a0 ; store indirection
000000C2 2B88017000000000 move.l a0,(__signal_intercept_indirect,a5) ; for signal_intercept
000000CA 41FB017000000000 lea (__abort_main_program,pc),a0 ; store indirection
000000D2 2B88017000000000 move.l a0,(__abort_main_indirect,a5) ; for abort main
;
; setup base frame and exception handler
;
000000DA common_start:
.local
000000DA 205F movea.l (sp)+,a0 ; a0 := return pc
000000DC 49F5017000000000 lea.l (__root_tcb,a5),a4 ; compute address of root tcb
000000E4 2F0C move.l a4,-(a7) ; push root tcb ptr on the stack;
000000E6 42A7 clr.l -(a7) ; bogus return pc
000000E8 487A0000 pea (main_handler:16,pc) ; setup handler
000000EC 42A7 clr.l -(a7) ; bogus saved fp
000000EE 2C4F movea.l a7,a6 ; establish frame
000000F0 2F08 move.l a0,-(sp) ; save return pc
;
; setup the unhandled exception message
;
000000F2 3BBC0001017000000000 move.w #elaboration$ferror,(__main_handler_ferror,a5)
;
; setup info in root tcb
;
000000FC 2E35017000000000 move.l (__data_size_var,a5),d7 ; get program data area size
00000104 D3C7 adda.l d7,a1 ; compute low stack bound
00000106 29490008 move.l a1,(tcb.stack_bounds.first,a4) ; save low stack bound
0000010A 9C87 sub.l d7,d6 ; subtract data from total
0000010C 9C85 sub.l d5,d6 ; subtract param size
0000010E 2946000C move.l d6,(tcb.stack_bounds.size,a4) ; rest is stack size
00000112 41F5017000000000 lea.l (__main_code_start_var,a5),a0 ;
0000011A 29480010 move.l a0,(tcb.code_start,a4) ; save code start pointer
0000011E 29440014 move.l d4,(tcb.process_id,a4) ; save process id
00000122 2B8D017000000000 move.l a5,(__global_base,a5) ; save global base register
0000012A 2B8A017000000000 move.l a2,(__os_param_ptr,a5) ; save parameter pointer
00000132 2B85017000000000 move.l d5,(__os_param_size,a5) ; save size of command line para
ms
0000013A 2B8B017000000000 move.l a3,(__module_base_address,a5) ; save module base address
00000142 41FA0000 lea (__task_code_start:16,pc),a0 ; save code start
00000146 2B88017000000000 move.l a0,(__task_code_start_var,a5) ; for Activate_Offspring
0000014E 2B8C017000000000 move.l a4,(__root_task_id,a5) ; save ref to tcb for debugger
;
; Setup pointers from CPT to message queues and
; OS-2000 process descriptor; runtime entry table
; pointer was setup in user program at jump into
; this code.
;
;
00000156 200F move.l sp,d0 ; get current stack pointer
00000158 0280FE000000 andi.l #(-a32_size),d0 ; mask for high order bits
0000015E 223009A00458 move.l (cct_start + pi_cpt,d0),d1 ; get cpt address
00000164 243019A00090 move.l (cpt_msgq_pointer,d1),d2 ; get msgq table pointer
0000016A 2B82017000000000 move.l d2,(__msgq_entry_pointer,a5) ; store pointer
00000172 207019A00040 movea.l (cpt_current_proc,d1),a0 ; get process dscptr pointer
00000178 2B88017000000000 move.l a0,(__process_descriptor_pointer,a5)
;
; Setup Ada information in OS-2000 process descriptor
; for the current process
;
; Current registers: A4 - Current Task Id (TCB pointer
; A1 - Low stack bound for task
; A0 - Address of process desc object
;
; The runtime is compiled without stack checks, so a cushion
; of stack space must be reserved to allow the most space
; consumptive runtime call to execute.
;
00000180 2050 movea.l (a0),a0 ; get current process dsptr
00000182 214C03A8 move.l a4,(art$tsk_id,a0) ; store TCB pointer
00000186 214C03B8 move.l a4,(art$prgkey,a0) ; store TCB pointer as key
0000018A 43E90400 lea (runtime$stack$cushion,a1),a1 ; reserve stack cushion
0000018E 214903AC move.l a1,(art$stk_lo,a0) ; store stack bound
00000192 42A803B0 clr.l (art$savefp,a0) ; clear saved frame pointer
;
; Check Standard I/O paths and open if not defined
;
00000196 $check_standard_input:
00000196 303C0000 move.w #standard_input,d0 ; path number
0000019A 323C0006 move.w #ss_eof,d1 ; EOF function code
0000019E 4E40 trap #os9_call ; make status call
000001A0 008D .dc.w i$getstt
000001A2 6400 bcc.b $check_standard_output ; check for error
000001A4 B27C00C9 cmp.w #e$bpnum,d1 ; see if bad path error
000001A8 6600 bne.b $check_standard_output ; if not bad path, then ok
000001AA 41FA0000 lea ($nil_device_name:16,pc),a0 ; open nil device
000001AE 303C0001 move.w #read_mode,d0 ; file access mode
000001B2 4E40 trap #os9_call ; make open call
000001B4 0084 .dc.w i$open
000001B6 $check_standard_output:
000001B6 303C0001 move.w #standard_output,d0 ; path number
000001BA 323C0006 move.w #ss_eof,d1 ; EOF function code
000001BE 4E40 trap #os9_call ; make status call
000001C0 008D .dc.w i$getstt
000001C2 6400 bcc.b $check_standard_error ; check for error
000001C4 B27C00C9 cmp.w #e$bpnum,d1 ; see if bad path error
000001C8 6600 bne.b $check_standard_error ; if not bad path, then ok
000001CA 41FA0000 lea ($nil_device_name:16,pc),a0 ; open nil device
000001CE 303C0002 move.w #write_mode,d0 ; file access mode
000001D2 4E40 trap #os9_call ; make open call
000001D4 0084 .dc.w i$open
000001D6 $check_standard_error:
000001D6 303C0002 move.w #standard_error,d0 ; path number
000001DA 323C0006 move.w #ss_eof,d1 ; EOF function code
000001DE 4E40 trap #os9_call ; make status call
000001E0 008D .dc.w i$getstt
000001E2 6400 bcc.b $init_error_file ; check for error
000001E4 B27C00C9 cmp.w #e$bpnum,d1 ; see if bad path error
000001E8 6600 bne.b $init_error_file ; if not bad path, then ok
000001EA 41FA0000 lea.l ($nil_device_name:16,pc),a0 ; open nil device
000001EE 303C0002 move.w #write_mode,d0 ; file access mode
000001F2 4E40 trap #os9_call ; make open call
000001F4 0084 .dc.w i$open
;
; Initialize path to error message file
;
000001F6 $init_error_file:
000001F6 7001 moveq.l #read_mode,d0 ; access mode = read
000001F8 41FA0000 lea.l ($error_msg_file:16,pc),a0 ; pointer to file name
000001FC 4E40 trap #os9_call
000001FE 0084 .dc.w i$open
00000200 6400 bcc.b $got_emf ; check for errors
00000202 7000 moveq.l #0,d0 ; error, so set path to 0
00000204 $got_emf:
00000204 3B80017000000000 move.w d0,(__error_path,a5) ; save path to error file
;
; Check if user program was linked with a compatible version
; of the Ada Runtime.
;
0000020C 0C350003017000000000 cmpi.b #compatibility_version,(__runtime_compatibility_value,a5)
00000216 6700 beq.b $setup_trap_handlers ; program/runtime compatible
00000218 2F3C0000002E move.l #rt$incompatible$ferror,-(sp) ; incompatible!
0000021E 60000000 bra.w report_error_and_die ; issue message and terminate
;
; Setup trap handler and signal intercept
;
00000222 $setup_trap_handlers:
00000222 307C0000 movea.w #0,a0 ; use current stack
00000226 43FA0000 lea (trap$table:16,pc),a1 ; address of trap table
0000022A 4E40 trap #os9_call ; make system call
0000022C 000E .dc.w f$strap ; to setup trap table
0000022E 6400 bcc.b $setup_fpu ; check for errors
00000230 2F3C00000025 move.l #init$trap$handler$ferror,-(sp) ; if error then
00000236 61FF00000000 bsr.l __report_fatal_error ; issure error message
0000023C $setup_fpu:
0000023C F23C900000003400 fmove.l #m68881$control,fpcr ; enable 68881 traps and roundin
g
00000244 41FA0000 lea (__signal_intercept:16,pc),a0 ; signal interceptor
00000248 224E movea.l a6,a1 ; save a6
0000024A 2C4D movea.l a5,a6 ; ref to global data
0000024C 4E40 trap #os9_call ; install signal
0000024E 0009 .dc.w f$icpt ; intercept routine
00000250 2C49 movea.l a1,a6 ; restore a6
;
; Create heap for the program
;
00000252 2035017000000000 move.l (__Heap_Size_Var,a5),d0 ; get heap size to request
0000025A 6700 beq.b $no_heap ; if zero, don't attempt allocat
e
0000025C 4E40 trap #os9_call ; make system call to allocate m
em
0000025E 0028 .dc.w f$srqmem
00000260 6400 bcc.b $heap_created ; if no error, then have memory
00000262 2F3C00000002 move.l #heap$create$warning,-(sp) ; else give warning msg
00000268 61FF00000000 bsr.l __issue_warning ; about failure
0000026E $no_heap:
0000026E 4280 clr.l d0 ; zero heap values
00000270 2440 movea.l d0,a2 ; clear pointer to heap
00000272 2B80017000000000 move.l d0,(__heap_size_var,a5) ; clear heap size var
0000027A $heap_created:
0000027A 2B8A017000000000 move.l a2,(__heap_ptr,a5) ; store pointer to heap
00000282 4EB5017100000000 jsr ([__rt_elaborate_indirect,a5]) ; elaborate runtime
0000028A 3BBC0005017000000000 move.w #lib$exception$ferror,(__main_handler_ferror,a5)
00000294 4E75 rts
00000296 2F68302F7379732F6172745F6572 $error_msg_file: .asciz "/h0/sys/art_errmsg"
726D736700
.align
000002AA 2F6E696C00 $nil_device_name: .asciz "/nil"
.align
;
; Exception handler for unhandled exceptions
;
subprogram sp_rt,sp.internal,linkage.none
000002B0 main_handler:
.local
000002B0 4E71 nop
000002B2 0C8000000000 cmpi.l #0,d0 ; is this abort exception?
000002B8 6700 beq.b main_suicide
000002BA 3235017000000000 move.w (__main_handler_ferror,a5),d1
000002C2 2F01 move.l d1,-(sp)
000002C4 61FF00000000 bsr.l __report_fatal_error
000002CA main_suicide:
000002CA 3BBC0002017000000000 move.w #finalization$ferror,(__main_handler_ferror,a5)
000002D4 4EB5017100000000 jsr ([__rt_finalize_indirect,a5]) ; do runtime finalization
000002DC 7201 moveq #some$error,d1
000002DE 4E40 trap #os9_call
000002E0 0006 .dc.w f$exit
;
; Finish entry point from program
;
subprogram sp_rt,sp.internal,linkage.simple
000002E2 _.finish_sequential:
000002E2 _.finish_tasking:
000002E2 3BBC0002017000000000 move.w #finalization$ferror,(__main_handler_ferror,a5)
000002EC 4EB5017100000000 jsr ([__rt_finalize_indirect,a5]) ; do runtime finalization
000002F4 4E75 rts
;
; Called from the program after elaboration of library units
; but before the call to the main program.
;
subprogram sp_rt,sp.internal,linkage.simple
000002F6 __middle_sequential:
000002F6 __middle_tasking:
000002F6 3BBC0006017000000000 move.w #main$exception$ferror,(__main_handler_ferror,a5)
00000300 4E75 rts
;
\f
;
; Set and Get exception for sequential programs
;
; procedure Set_Current_Exception (Id : System.Address);
;
subprogram sp_rt,sp.internal,linkage.simple
00000302 set$current$exception:
00000302 2BAF0004017000000000 move.l (4,sp),(__root_tcb+tcb.exception_id,a5)
0000030C 4E740004 rtd #4
;
; function Get_Current_Exception return System.Address;
;
subprogram sp_rt,sp.internal,linkage.simple
00000310 get$current$exception:
00000310 2035017000000000 move.l (__root_tcb+tcb.exception_id,a5),d0
00000318 4E75 rts
;
\f
;
; This is one jump away from the entry point for the module
; that is passed to the F$Fork call whenever an Ada task is
; activated. Interesting register values at this point include:
;
; A1 - high end of our parameter area (= base of our stack)
; A7- low end of our parameter area (= high end of our data area)
; D0 - Our Os9 process id
; D6 - total memory allocation (A1 - D6 = low end our data area)
;
; Format of parameter area is defined by Tasking_Types.Fork_Parameters:
; This code address (32 bits), followed by the base address for
; global data (32 bits), followed by the address of our TCB (32 bits)
; The TCB is completely filled in, except for the Stack_Bounds field,
; which we initialize here. The Activations_In_Progress field contains
; the task's static link.
; The last object in Fork_Parameters is the address of an instance
; variable. This is zero unless the task is declared in the outer
; scope of a shared code generic, in which case it needs the IV to
; reference objects declared in the outermost scope (which go in the
; instance variable). If the Instance_Variable field of Fork_Parameters
; is non-null, then the task is expecting the IV to be passed as its
; second parameter.
;
subprogram sp_rt,sp.internal,linkage.none
0000031A __task_code_start:
.local
0000031A 266F000C movea.l (12,a7), a3 ; the instance variable
0000031E 286F0008 movea.l (8,a7),a4 ; our TCB's address
00000322 2A6F0004 movea.l (4,a7),a5 ; base address for global data
00000326 4297 clr.l (a7)
00000328 487B017000000000 pea (ada$task$exception$handler,pc) ; establish handler
00000330 42A7 clr.l -(a7) ; bogus saved fp
00000332 2C4F movea.l a7,a6 ; establish frame pointer
00000334 2F2C003C move.l (tcb.activations_in_progress,a4),-(a7) ; static link
00000338 4A8B tst.l a3 ; Is the IV null?
0000033A 67FF00000000 beq.l $push_tcb
00000340 2F0B move.l a3,-(a7) ; if not, push it on the stack
00000342 $push_tcb:
00000342 2F0C move.l a4,-(a7) ; push TCB ref on stack
00000344 2D4C000C move.l a4,(12,a6) ; Put TCB where debugger expects
it
00000348 29400014 move.l d0,(tcb.process_id,a4) ; set process id in TCB
0000034C 93C6 suba.l d6,a1 ; get low stack bound
0000034E 29490008 move.l a1,(tcb.stack_bounds.first,a4) ; set low stack bound in TCB
00000352 2946000C move.l d6,(tcb.stack_bounds.size,a4) ; set stack size in TCB
;
; Setup Ada information in OS-2000 process descriptor
; for the current process
;
; Current registers: A4 - Current Task Id (TCB pointer
; A1 - Low stack bound for task
;
; The runtime is compiled without stack checks, so a cushion
; of stack space must be reserved to allow the most space
; consumptive runtime call to execute.
;
; Also, clear parent and sibling id's in process descriptor
; so that descriptor will be reclaimed when process EXIT's.
;
00000356 2075017100000000 movea.l ([__process_descriptor_pointer,a5]),a0 ; get current descriptor
0000035E 214C03A8 move.l a4,(art$tsk_id,a0) ; store TCB pointer
00000362 43E90400 lea (runtime$stack$cushion,a1),a1 ; reserve stack cushion
00000366 214903AC move.l a1,(art$stk_lo,a0) ; store stack bound
0000036A 42A803B0 clr.l (art$savefp,a0) ; clear saved frame pointer
0000036E 43F5017000000000 lea (__root_tcb,a5),a1 ; compute root tcb addr
00000376 214903B8 move.l a1,(art$prgkey,a0) ; store as program key
0000037A 42680002 clr.w (p$pid,a0) ; clear parent id
0000037E 42680004 clr.w (p$sid,a0) ; clear sibling id
;
; Setup trap handler for process
;
00000382 307C0000 movea.w #0,a0 ; use current stack
00000386 43FB017000000000 lea (trap$table,pc),a1 ; address of trap table
0000038E 4E40 trap #os9_call ; make system call
00000390 000E .dc.w f$strap ; to setup trap table
00000392 6400 bcc.b $traps_done ; check error status
00000394 2F3C00000025 move.l #init$trap$handler$ferror,-(sp) ; if error
0000039A 61FF00000000 bsr.l __report_fatal_error ; then give error message
000003A0 $traps_done:
000003A0 F23C900000003400 fmove.l #m68881$control,fpcr ; enable 68881 traps/rounding
000003A8 41FB017000000000 lea.l (__signal_intercept,pc),a0 ; signal interceptor
000003B0 224E movea.l a6,a1 ; save a6
000003B2 2C4D movea.l a5,a6 ; ref to global data
000003B4 4E40 trap #os9_call ; install signal handler
000003B6 0009 .dc.w f$icpt
000003B8 2C49 movea.l a1,a6 ; restore a6
000003BA 4875017000000000 pea (__tasking_lock,a5) ; pass the lock
000003C2 61FF00000000 bsr.l __serialization.acquire_lock ; synchronize activation group
000003C8 61FF00000000 bsr.l __release_task_lock ; so low priority member cannot
; starve higer priority
000003CE 226EFFFC movea.l (-4,a6),a1 ; pass static link in a1
000003D2 4EF5017100000000 jmp ([__task_create_return,a5]) ; branch to user program
;
; Exception handler for an Ada task
;
subprogram sp_rt,sp.internal,linkage.simple
000003DA ada$task$exception$handler:
000003DA 4E71 nop
000003DC 4A80 tst.l d0 ; is this an abort exception
000003DE 6700 beq.b $task_suicide
000003E0 2F3C00000001 move.l #task$exception$warning,-(sp) ; unhandle exception warning
statement 0,0,1
000003E6 61FF00000000 bsr.l __issue_warning
statement 0,0,0
000003EC $task_suicide:
000003EC 61FF00000000 bsr.l __task_end ; suicide (should not return)
;
; procedure Suicide;
;
subprogram sp_rt,sp.internal,linkage.simple
000003F2 __process_exit:
000003F2 4EF5017100000000 jmp ([__task_finish_return,a5]) ; branch to user for exit
;
;
;
;
.local
000003FA trap$table:
000003FA 000C0000 $e$0: .dc.w t_adderr, program_error_trap - ($e$0 + 4);
000003FE 00080000 $e$1: .dc.w t_buserr, program_error_trap - ($e$1 + 4)
00000402 00100000 $e$2: .dc.w t_illins, program_error_trap - ($e$2 + 4)
00000406 00180000 $e$3: .dc.w t_chk, constraint_error_trap - ($e$3 + 4)
0000040A 001C0000 $e$4: .dc.w t_trapv, numeric_error_trap - ($e$4 + 4)
0000040E 00C80000 $e$5: .dc.w t_fpdivzer, numeric_error_trap - ($e$5 + 4)
00000412 00C40000 $e$6: .dc.w t_fpinxact, numeric_error_trap - ($e$6 + 4)
00000416 00D80000 $e$7: .dc.w t_fpnotnum, numeric_error_trap - ($e$7 + 4)
0000041A 00D00000 $e$8: .dc.w t_fpoprerr, numeric_error_trap - ($e$8 + 4)
0000041E 00D40000 $e$9: .dc.w t_fpoverfl, numeric_error_trap - ($e$9 + 4)
00000422 00CC0000 $e$a: .dc.w t_fpundrfl, numeric_error_trap - ($e$a + 4)
00000426 00C00000 $e$b: .dc.w t_fpunordc, numeric_error_trap - ($e$b + 4)
0000042A 00140000 $e$c: .dc.w t_zerdiv, numeric_error_trap - ($e$c +4)
0000042E FFFF .dc.w -1
;
; Unhandled trap handler
;
subprogram sp_rt,sp.internal,linkage.trap
00000430 __unexpected_trap:
00000430 __undefined_trap:
.local
statement 8,0,0 ; return pc in A0
00000430 6100 bsr.b restore_trap_registers
statement 1,0,0 ; return pc in D1
00000432 2E49 movea.l a1,a7 ; restore stack pointer
00000434 2F01 move.l d1,-(sp) ; push pc on stack
statement 16,0,0
00000436 42A7 clr.l -(sp) ; push null for exception name
statement 16,0,1
00000438 61FF00000000 bsr.l __trace_exception ; go to tracing routine
statement 16,0,0
0000043E 42A7 clr.l -(sp) ; push null for exception name
statement 16,0,1
00000440 2F3C00000003 move.l #unhandled$main$trap$ferror,-(sp)
statement 16,0,2
00000446 report_error_and_die:
00000446 61000000 bsr.w __report_fatal_error
0000044A 7201 moveq #some$error,d1
0000044C 4E40 trap #os9_call
0000044E 0006 .dc.w f$exit
;
; This subprogram restores register d2-d7/a2-a7
; from the OS2000 provided save area
;
subprogram sp_rt,sp.internal,linkage.trap
00000450 restore_trap_registers:
.local
statement 8,0,0 ; return pc in A0
00000450 2208 move.l a0, d1 ; save raise PC in d1
statement 1,0,0 ; return pc in D1
00000452 204D movea.l a5,a0 ; get address of register save area
00000454 5088 addq.l #8,a0 ; skip d0, d1
00000456 4CD800FC movem.l (a0)+,d2-d7 ; restore data registers
0000045A 5088 addq.l #8,a0 ; skip a0, a1
0000045C 4CD87C00 movem.l (a0)+,a2-a6 ; restore address registers
00000460 4E75 rts
;
; trap handler for generating Constraint_Error
;
subprogram sp_rt,sp.internal,linkage.trap
00000462 constraint_error_trap:
.local
statement 8,0,0 ; raise pc in A0
00000462 6100 bsr.b restore_trap_registers
statement 1,0,0 ; raise pc in D1
00000464 2E49 movea.l a1,a7 ; restore stack pointer
00000466 203C00000000 move.l #__constraint_error,d0
0000046C D08D add.l a5,d0
0000046E 2F01 move.l d1,-(a7) ; push return pc for "call"
statement 16,0,0
00000470 F2800000 fnop ; synchronize fpu exceptions
00000474 60FF00000000 bra.l __Raise_Exception ; raise exception
;
; trap handler for generating Program_Error
;
subprogram sp_rt,sp.internal,linkage.trap
0000047A program_error_trap:
.local
statement 8,0,0 ; raise pc in A0
0000047A 6100 bsr.b restore_trap_registers
statement 1,0,0 ; raise pc in D1
0000047C 2E49 movea.l a1,a7 ; restore stack pointer
0000047E 203C00000000 move.l #__program_error,d0
00000484 D08D add.l a5,d0
00000486 2F01 move.l d1,-(a7) ; push return pc for "call"
statement 16,0,0
00000488 F2800000 fnop ; synchronize fpu exceptions
0000048C 60FF00000000 bra.l __Raise_Exception ; raise exception
;
; trap handler for generating Numeric_Error
;
subprogram sp_rt,sp.internal,linkage.trap
00000492 numeric_error_trap:
statement 8,0,0 ; return pc in a0
00000492 6100 bsr.b restore_trap_registers
statement 1,0,0 ; raise pc in d1
00000494 2E49 movea.l a1,a7 ; restore stack pointer
00000496 203C00000000 move.l #__numeric_error,d0
0000049C D08D add.l a5,d0
0000049E 2F01 move.l d1,-(a7) ; push return pc for "call"
statement 16,0,0
000004A0 F2800000 fnop ; in case pending flt exception
000004A4 60FF00000000 bra.l __raise_exception ; raise exception
;
; trap handler for signals
;
subprogram sp_rt,sp.internal,linkage.none
000004AA __signal_intercept:
000004AA 2F0D move.l a5,-(sp) ; save a5
000004AC 2A4E movea.l a6,a5
000004AE 4280 clr.l d0
000004B0 3001 move.w d1,d0
000004B2 2F00 move.l d0,-(sp)
000004B4 2075017000000000 movea.l (__signal_intercept_indirect,a5),a0
000004BC 4E90 jsr (a0)
000004BE 2A5F movea.l (sp)+,a5 ; restore a5
000004C0 4E40 trap #os9_call
000004C2 001E .dc.w f$rte
end_subprograms
.end
Program Section Name Kind Length Patches Fixups
-------------------------------- ---- ---------- ------- -------
ADA_RUNTIME_CODE Rel 1220 19 118
DEBUG_BODY Rel 469 54 17
DEBUG_HDR_CU Rel 64 2 0
Standard include file: <none>
Object module version: 11
Assembled 6946 lines in 1:17.990 elapsed, 44.621 CPU.
5344 lines per elapsed minute.
9340 lines per CPU minute.
298 disk waits for this job.
1901532 bytes of heap used by this job.