|
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 - downloadIndex: ┃ O T ┃
Length: 58180 (0xe344)
Types: TextFile
Names: »OS2000_INTERNALS_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 "OS2000_INTERNALS"
;
; Implements operations which depend on the location and
; organization of OS-9 and OS2000 internal data structures.
;
.include "^^standard_assembler_include_file"
00000000 .push_list
00000000 .pop_list
00000000 .list macro_expansion = none
.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
.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
comp_unit runtime_compunit
.sect ada_runtime_code,code,relocatable,alignment:=2
.gbl.a __get_current_task_id
.gbl.a __verify_stack
.gbl.a __fork_process
.gbl.a __current_process_id
.gbl.a __current_process_priority
.gbl.a __set_process_priority
.gbl.l __serialization.acquire_lock
.gbl.l __serialization.release_lock
.gbl.l __release_task_lock
.ext.a __process_descriptor_pointer
.ext.a __tasking_lock
.ext.a __report_fatal_error;
.ext.l __abort_main_indirect
.ext.b __abort_main_flag
;
; function Get_Current_Task_Id return Task_Id;
;
subprogram sp_rt,sp.internal,linkage.simple
00000000 __get_current_task_id:
00000000 2075017000000000 movea.l (__process_descriptor_pointer,a5),A0
00000008 2050 movea.l (a0),a0
0000000A 202803A8 move.l (art$tsk_id,a0),d0
0000000E 4E75 rts
;
; function Current_Process_Id return Integer;
;
subprogram sp_rt,sp.internal,linkage.simple
00000010 __current_process_id:
00000010 7000 moveq.l #0,d0
00000012 2075017000000000 movea.l (__process_descriptor_pointer,a5),a0
0000001A 2050 movea.l (a0),a0
0000001C 3010 move.w (p$id,a0),d0
0000001E 4E75 rts
;
; function Current_Priority return Integer;
;
subprogram sp_rt,sp.internal,linkage.simple
00000020 __current_process_priority:
statement 0,0,0
00000020 7000 moveq.l #0,D0
00000022 2075017000000000 movea.l (__process_descriptor_pointer,a5),a0
0000002A 2050 movea.l (a0),a0
0000002C 30280018 move.w (p$prior,a0),d0
00000030 4E75 rts
;
; procedure Fork (Parameter_Ref : System.Address;
; Parameter_Size : Integer;
; Priority : Integer;
; Memory_Size : Integer;
; Result : out Status);
;
subprogram sp_rt,sp.internal,linkage.simple
00000032 __Fork_Process:
.local
$param_ref'offset equ 4+20
$param_size'offset equ 8+20
$priority'offset equ 12+20
$memory_size'offset equ 16+20
$status'offset equ 20+20
00000032 48E73C20 movem.l d2/d3/d4/d5/a2,-(a7)
statement 20,0,0
00000036 7000 moveq.l #0,d0 ; module type/revision
00000038 222F0024 move.l ($memory_size'offset,sp),d1 ; memory size
0000003C 068100000400 addi.l #runtime$stack$cushion,d1 ; add cushion to mem size
00000042 242F001C move.l ($param_size'offset,sp),d2 ; parameter size
00000046 42AF0028 clr.l ($status'offset,sp) ; successful status
0000004A 7604 moveq.l #4,d3 ; I/O paths
0000004C 282F0020 move.l ($priority'offset,sp),d4 ; priority
00000050 41FA0000 lea (_ada_task_module_name:16,pc),a0; module name
00000054 226F0018 movea.l ($param_ref'offset,sp),a1 ; parameter address
00000058 $save_child_id:
00000058 2475017000000000 movea.l (__process_descriptor_pointer,a5),a2
00000060 2452 movea.l (a2),a2
00000062 2A2A0006 move.l (p$cid,a2),d5 ; save value of child id
00000066 4E40 trap #os9_call
00000068 0003 .dc.w f$fork
0000006A 6500 bcs.b $error
0000006C $restore_child_id:
0000006C 25450006 move.l d5,(p$cid,a2) ; restore value of child id
00000070 4CDF043C $done: movem.l (a7)+,d2/d3/d4/d5/a2
statement 0,0,0
00000074 4E75 rts
00000076 2F410028 $error: move.l d1, ($status'offset,sp) ; error status
0000007A 60F4 bra.b $done
0000007C _ada_task_module_name:
0000007C 4144415F5441534B00 .asciz "ADA_TASK"
;
; procedure Set_Priority (Process_Id : Integer; Priority : Integer);
;
subprogram sp_rt,sp.internal,linkage.simple
00000086 __Set_Process_Priority:
.local
$process_id'offset equ 4
$priority'offset equ 8
00000086 202F0004 move.l ($process_id'offset,sp),d0
0000008A 222F0008 move.l ($priority'offset,sp),d1
0000008E 4E40 trap #os9_call
00000090 000D .dc.w f$sprior
00000092 4E740008 rtd #8
;
; function Acquire_Lock (The_Lock : Lock) return Task_Id is
; Item : Q_Element;
; begin
; Item.Key := Get_Current_Task_Id;
; if Tasking_Lock.Key = Null_Id then \
; Tasking_Lock.Key := Item.Key; \
; Tasking_Lock.Next := null; \
; return True; - Atomic
; else /
; Item.Next := Tasking_Lock.Next; /
; Tasking_Lock.Next := Item; /
;
; while Tasking_Lock.Key /= Item.Key loop
; Sleep (Some_Amount); -- awakened either by release signal
; -- or delay expiration;
; end loop;
; end if;
; end Acquire;
;
;
subprogram sp_rt,sp.internal,linkage.simple
00000096 __serialization.acquire_lock:
.local
$lock'offset equ 4+4
$allocate_size equ element'size;
00000096 2F03 move.l d3,-(SP) ; save d3
statement 0,0,1
00000098 206F0008 movea.l ($lock'offset,sp),a0 ; get address of The_Lock
0000009C 2275017000000000 movea.l (__process_descriptor_pointer,a5),a1
000000A4 2251 movea.l (a1),a1
000000A6 262903A8 move.l (art$tsk_id,a1),d3 ; fetch current task id
000000AA 2F03 move.l d3,-(SP) ; Element.Key := Get_Current_Task_Id
statement 0,0,2
000000AC 598F subq.l #4,sp ; Element.Next uninitialized
statement 0,0,3
000000AE 2248 movea.l a0, a1 ; The_Lock'Address is in A0
000000B0 5889 addq.l #element.key,a1 ; The_Lock.Key'Address
000000B2 7200 $retry: moveq.l #0,d1
000000B4 0ED100C1 cas.l d1,d3,(a1) ; if The_Lock.Key = 0 then
; The_Lock.Key := The_Element.Key;
000000B8 6600 bne.b $failed ; if Key /= 0 then failed
000000BA 20280004 $done: move.l (element.key,a0),d0 ; get The_Lock.Key
000000BE 508F addq.l #$allocate_size,sp ; pop local queue element
statement 0,0,1
000000C0 261F move.l (sp)+,d3 ; restore d3
statement 0,0,0
000000C2 4E740004 rtd #4
000000C6 2010 $failed:move.l (a0),d0 ; get The_Lock.Next
000000C8 2E80 move.l d0,(sp) ; Item.Next := Lock.Next
000000CA 260F move.l SP,d3 ; The_Element.Next'Address
000000CC 0EFC80C09041 cas2.l d0:d1,d3:d1,(a0):(a1) ; if Lock unchanged then
; Lock.Next := Item and
000000D2 6700 beq.b $sleep ; if equal then properly enqueued
; else concurrent interference,
000000D4 262F0004 move.l (Element.Key,SP),d3 ; so get The_Element.Key
000000D8 60D8 bra.b $retry ; and try again to enqueue
;
; Didn't get lock, so sleep until become head of queue
; and lock is released. Don't sleep indefinitely, because
; OS-9 signals are lost (not queued) if receiver is not
; already sleeping when signal is sent. This introduces
; a race condition.
;
000000DA 203C80000004 $sleep: move.l #-2147483644,d0 ; sleep time
000000E0 4E40 trap #os9_call ; do system call
000000E2 000A .dc.w f$sleep
000000E4 20280004 move.l (element.key,a0),d0 ; get the_Lock.Key
000000E8 B0AF0004 cmp.l (element.key,sp),d0 ; compare to The_Element.Key
000000EC 67CC beq.b $done ; if equal then got the lock
000000EE 60EA bra.b $sleep ; else try again
;
; procedure Release_Task_Lock
;
subprogram sp_rt,sp.internal,linkage.simple
000000F0 __release_task_lock:
000000F0 08350000017000000000 btst.b #0,(__abort_main_flag,a5) ; test for main program abort
000000FA 6700 beq.b $release
000000FC 2075017000000000 movea.l (__abort_main_indirect,a5),a0
00000104 4E90 jsr (a0)
00000106 $release:
00000106 4875017000000000 pea (__Tasking_Lock,a5) ; get address of Tasking_Lock
0000010E 6100 bsr.b __serialization.release_lock
00000110 4E75 rts
;
; procedure Release_Lock (The_Lock : Address);
;
subprogram sp_rt,sp.internal,linkage.simple
00000112 __Serialization.Release_Lock:
.local
$lock'offset equ 4
00000112 206F0004 movea.l ($lock'offset,sp),a0 ; get address of The_Lock
00000116 2248 movea.l a0,a1
00000118 5889 addq.l #Element.Key,a1 ; Lock.Key'Address
0000011A 2211 move.l (a1),d1 ; Lock.Key
0000011C 7000 moveq.l #0,d0 ; null, null id
0000011E 0EFC80009001 cas2.l d0:d1,d0:d0,(a0):(a1) ; if Lock.Next = null and
; Lock.Key = Lock.Key then
; Lock.Next := null; and
; Lock.Key := null id;
00000124 6600 bne.b $waiters ;
00000126 4E740004 rtd #4 ; released the lock, no waiters
0000012A $waiters:
0000012A 48E73010 movem.l d2/d3/a3,-(a7)
statement 0,0,3
0000012E 2640 $retry: movea.l d0, a3 ; Lock.Next
00000130 2413 move.l (a3), d2 ; Lock.Next.Next
00000132 262B0004 move.l (Element.Key,a3), d3 ; Lock.Next.Key
00000136 0EFC808090C1 cas2.l d0:d1,d2:d3,(a0):(a1) ; if Lock unchanged then
; Lock.Next := Lock.Next.Next;
; Lock.Key := Lock.Next.Key;
0000013C 66F0 bne.b $Retry ; concurrent interference
0000013E 2043 movea.l d3,a0 ; get The_Lock.Key
00000140 4CDF080C movem.l (a7)+,d2/d3/a3 ; restore d2, d3, and a3
statement 0,0,0
00000144 7201 moveq.l #1,d1 ; wakeup signal
00000146 20280014 move.l (tcb.process_id,a0),d0 ; get The_Lock.Key.Process_Id
0000014A 4E40 trap #os9_call ; do system call
0000014C 0008 .dc.w f$send
0000014E 4E740004 rtd #4
;
; procedure Verify_Stack;
;
; Verify that the current stack pointer does not
; exceed the limits for the process; if it does
; then issue an error message and die. This routine
; is called only from runtime routines which do not
; do normal stack checking, but must be able to execute
; in order to insure correct program semantics.
;
subprogram sp_rt,sp.internal,linkage.simple
00000152 __verify_stack:
.local
00000152 220F move.l sp,d1 ; get current stack pointer
00000154 068100000400 addi.l #runtime$stack$cushion,d1 ; give back cushion for runtime
0000015A 6500 blo.s $failed ; wraps around past zero
0000015C 2075017000000000 movea.l (__process_descriptor_pointer,a5),a0
00000164 2050 movea.l (a0),a0 ; get descriptor ptr
00000166 B2A803AC cmp.l (art$stk_lo,a0),d1 ; compare to low bound
0000016A 6500 blo.s $failed ; past low bound
0000016C 4E75 rts
0000016E $failed:
0000016E 2F3C0000002C move.l #insufficient$stack$ferror,-(sp); push fatal error value
00000174 61FF00000000 bsr.l __report_fatal_error ; give error message
0000017A 7001 moveq.l #some$error,d0 ; return status
0000017C 4E40 trap #os9_call
0000017E 0006 .dc.w f$exit
end_subprograms
.end
Program Section Name Kind Length Patches Fixups
-------------------------------- ---- ---------- ------- -------
ADA_RUNTIME_CODE Rel 384 8 20
DEBUG_BODY Rel 243 28 9
DEBUG_HDR_CU Rel 40 2 0
Standard include file: <none>
Object module version: 11
Assembled 3983 lines in 34.053 elapsed, 25.852 CPU.
7018 lines per elapsed minute.
9244 lines per CPU minute.
70 disk waits for this job.
1118881 bytes of heap used by this job.