|
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: M T
Length: 106550 (0x1a036)
Types: TextFile
Names: »MSQTI_OPS_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 "MESSAGE_QUEUE_TIMER_OPERATIONS"
;
; Implements the body of the Ada packages Message_Queue and Timer
;
.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
.include "^^common.msqti_definitions"
;
; This assembly file defines the values for invoking
; Message_Queues and Timer operations.
;
;
; Service call names definitions
;
; These names are used in the low level assembler interface to address
; the Message Queue Services via the Message_Qeueue_Globals address in
; register a1.l.
;
; Example: jsr ([Q$Send,a1])
;
Q$Base set 4
Q$Create equ -Q$Base ;'Create_Queue'.
;*
Q$Base set Q$Base+4
Q$Delete equ -Q$Base ;'Delete_Queue'.
;*
Q$Base set Q$Base+4
Q$Find equ -Q$Base ;'Find_Queue'.
;*
Q$Base set Q$Base+4
Q$Length equ -Q$Base ;'Length_of_Queue'.
;*
Q$Base set Q$Base+4
Q$Assign equ -Q$Base ;'Assign_Channel'.
;*
Q$Base set Q$Base+4
Q$Deass equ -Q$Base ;'Deassign_Channel'.
;*
Q$Base set Q$Base+4
Q$NewQAddr equ -Q$Base ;'New_Queue_address'.
;*
Q$Base set Q$Base+4
Q$NewCAddr equ -Q$Base ;'New_Channel_Address'.
;*
Q$Base set Q$Base+4
Q$Send equ -Q$Base ;'Send_Message'.
;*
Q$Base set Q$Base+4
Q$Reserve equ -Q$Base ;'Reserve_Message_Slot'.
;*
Q$Base set Q$Base+4
Q$UnRes equ -Q$Base ;'Return_Reserved_Message_Slot'.
;*
Q$Base set Q$Base+4
Q$Remove equ -Q$Base ;'Remove_Message'.
;*
Q$Base set Q$Base+4
Q$Retriev equ -Q$Base ;'Retrieve_Message'.
;*
Q$Base set Q$Base+4
Q$RetChan equ -Q$Base ;'Retrieve_Message_from_Channel'.
;*
Q$Base set Q$Base+4
Q$Wait equ -Q$Base ;'Wait_for_Queues'.
;*
Q$Base set Q$Base+4
Q$RQuData equ -Q$Base ;'Read_User's_Queue_Data'.
;*
Q$Base set Q$Base+4
Q$WQuData equ -Q$Base ;'Write_User's_Queue_Data'.
\f
;*******************************************************************************
;* *
;* Message Queue Services return codes. *
;* *
;* These codes are returned from the Message Queues Services in register *
;* d1.w along with a Carry condition code. *
;* *
;*******************************************************************************
;*
;*******************************************************************************
;* *
;* Common error codes. *
;* *
;*******************************************************************************
;*
Q$IllQue equ 11 + 16#1000#; 'Illegal queue address'.
Q$IllPar equ 12 + 16#1000#; 'Illegal parameter'.
Q$InitErr equ 13 + 16#1000#; 'Initiation error'.
Q$IllCha equ 14 + 16#1000#; 'Illegal channel address'.
Q$NoMess equ 15 + 16#1000#; 'No message for at retrieve or remove'.
Q$NotAcc equ 16 + 16#1000#; 'The specified queue was not accessible
;* due to a persistent mutual exclusion
;* lock'.
Q$ToMany equ 17 + 16#1000#; 'The maximum number of the specified
;* resource type is already allocated'.
Q$InFail equ 18 + 16#1000#; 'Initiation failure'.
;*
;*******************************************************************************
;* *
;* Send_Message specific error codes. *
;* *
;*******************************************************************************
;*
Q$Full equ 20 + 16#1000#; 'The maximum number of messages for
;* this channel already in the queue or
;* no reserved slot when sending with
;* qualifier Q$UseRes.
Q$NoWait equ 21 + 16#1000#; 'No waiter ready'.
Q$TooBig equ 22 + 16#1000#; 'Message too big'.
;*
\f
;*******************************************************************************
;* *
;* Retrieve_Message specific error codes. *
;* *
;*******************************************************************************
;*
Q$TooSmal equ 31 + 16#1000#; 'Retriever buffer not big enough to
;* hold the maximum size message'.
;*
;*******************************************************************************
;* *
;* Wait_for_Queues specific error codes. *
;* *
;*******************************************************************************
;*
Q$MulWait equ 41 + 16#1000#; 'Concurrent wait on the queue'.
Q$EmpWs equ 42 + 16#1000#; 'Empty wait set'.
Q$QuesEmp equ 43 + 16#1000#; 'All queues empty' when qualifier
;* Q$NonBlk was set.
Q$QueDel equ 44 + 16#1000#; 'A queue was deleted while currently
;* waiting for it'.
;*
;*******************************************************************************
; *
;* Create_Queue specific error codes. *
;* *
;*******************************************************************************
;*
Q$DubDef equ 51 + 16#1000#; 'Multiply defined queue'.
Q$QueSiz equ 52 + 16#1000#; 'Not enough resources (ram, too many
;* queues created etc.) for queue'.
;*
;*******************************************************************************
*
;* *
;* Delete_Queue specific error codes. *
;* *
;*******************************************************************************
;*
Q$NotEmp equ 61 + 16#1000#; 'Queue not empty'.
\f
;*******************************************************************************
;* *
;* Assign_Channel specific error codes. *
;* *
;*******************************************************************************
;*
Q$ChaSiz equ 71 + 16#1000#; 'Not enough resources (ram etc. ) for
;* the channel'.
;*******************************************************************************
;* *
;* Reserve/ Unreserve_Slot specific error codes. *
;* *
;*******************************************************************************
;
Q$TooFew equ 81 + 16#1000#; 'The common or reserve slot list for
; the specified channel is empty'.
;
; Message Queue Services qualifiers
;
; These codes are set in register d1.w (one or many) at the calls
; of those services which take qualifiers.
;
;
; Common qualifier codes.
*
;
Q$NoQual equ 0 ; No qualifiers.
Q$UseCha equ 16#8000# ; Use the channel specification for
Q$UseChaB equ 15 ; this service.
;
; Create_Queue service specific qualifiers
;
Q$NodWid equ 16#4000# ; Create this queue for node wide
Q$NodWidB equ 14 ; accessibility.
;
; Delete_Queue service specific qualifiers
;
Q$VerEmp equ 16#8000# ; Verify that queue is empty before
Q$VerEmpB equ 15 ; deletion and return Q$NotEmp if not.
;
; Send_Message service specific qualifiers
;
Q$UsePri equ 16#4000# ; Invoke the senders process priority
Q$UsePriB equ 14 ; on any waiter on this queue if the
; waiter has lower priority.
Q$RetRdy equ 16#2000# ; Deliver message only if a waiter is
Q$RetRdyB equ 13 ; currently waiting for the queue.
Q$UseRes equ 16#1000# ; Use a reserved slot for this message.
Q$UseResB equ 12
;
; Wait_for_Queues service specific qualifiers
;
Q$NonBlk equ 16#8000# ; Return with status Q$QuesEmp if all
Q$NonBlkB equ 15 ; awaited queues are empty.
;
; Wait_Set flag field specific qualifiers
;
Q$SkpQue equ 16#8000# ; Skip this queue when forming the
Q$SkpQueB equ 15 ; set of awaited queues for this
; wait service call
Q$UserF1 equ 16#0001# ; User flag 1.
Q$UserF1B equ 0
Q$UserF2 equ 16#0002# ; User flag 2.
Q$UserF2B equ 1
Q$UserF3 equ 16#0003# ; User flag 3.
Q$UserF3B equ 2
Q$UserF4 equ 16#0004# ; User flag 4.
Q$UserF4B equ 3
Q$UserF5 equ 16#0005# ; User flag 5.
Q$UserF5B equ 4
Q$UserF6 equ 16#0006# ; User flag 6.
Q$UserF6B equ 5
Q$UserF7 equ 16#0007# ; User flag 7.
Q$UserF7B equ 6
Q$UserF8 equ 16#0008# ; User flag 8.
Q$UserF8B equ 7
;
; Timer calls
;
Ti$Start equ 16#0001#;
Ti$Stop equ 16#0002#;
;
; Modifiers to Timer calls
;
Ti$OneSh equ 16#20000000# ; Start a one-shot timer
Ti$Cycl equ 16#40000000# ; Start a cyclic timer
Ti$Driv equ 16#FFFFFFFF# ; Start a timer used by a driver
;
; Timer error codes
;
Ti$NoFrTe equ 16#0000200A#
Ti$IllTT equ 16#0000200C#
Ti$DelTL equ 16#0000200B#
Ti$NoFrQS equ 16#0000200D#
Ti$BTmrID equ 16#00002014#
;
comp_unit runtime_compunit
.sect ada_runtime_code,code,relocatable,alignment:=2
.gbl.l __msgq$create
.gbl.l __msgq$delete
.gbl.l __msgq$delete$veremp
.gbl.l __msgq$send
.gbl.l __msgq$send$retrdy
.gbl.l __msgq$send$nopri
.gbl.l __msgq$wait
.gbl.l __msgq$wait$nonblk
.gbl.l __msgq$retriev
.gbl.l __msgq$retriev_if_available
.gbl.l __msgq$remove
.gbl.l __msgq$length
.gbl.l __msgq$get_associated_data
.gbl.l __timer$start
.gbl.l __timer$stop
.ext.l __msgq_entry_pointer
.ext.l __process_descriptor_pointer
;
; Have to a pointer to the table of entry points for
; message queue operations in __MsgQ_Entry_Pointer.
; Calls to the services are performed by
;
; movea.l (__MsgQ_Entry_Pointer, a5), a1
; jsr ([Q$service, a1])
;
Local_No_Channels equ 0;
;
; procedure Create (Max_Message_Size : Message_Size;
; Max_Message_Count : Queue_Length;
; Result : out Stratus;
; New_Queue : out Id);
;
subprogram sp_rt,sp.internal,linkage.simple
00000000 __msgq$create:
.local
$max_size'offset equ 4+16
$max_count'offset equ 8+16
$status'offset equ 12+16
$queue'offset equ 16+16
statement 0,0,0
00000000 48E73C00 movem.l d2/d3/d4/d5,-(sp)
statement 16,0,0
00000004 41FA0000 lea ($null_queue_name:16,pc),a0 ; queue name string
00000008 42AF001C clr.l ($status'offset,sp) ; result := successful
0000000C 7000 moveq.l #local_no_channels,d0 ; qualifier flags
0000000E 282F0014 move.l ($max_size'offset,sp),d4 ; max message size
00000012 2A2F0018 move.l ($max_count'offset,sp),d5 ; max number of messages
00000016 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
0000001E 4EB10161FFFC jsr ([q$create,a1]) ; jump to create entry
00000024 6500 bcs.b $error ; check for error
00000026 206F0020 movea.l ($queue'offset,sp),a0 ; get pointer to id
0000002A 30C2 move.w d2,(a0)+ ; upper part of id
0000002C 2083 move.l d3,(a0) ; lower part of id
0000002E 4CDF003C $exit: movem.l (sp)+,d2/d3/d4/d5 ; restore registers
statement 0,0,0
00000032 4E75 rts
00000034 3F41001E $error: move.w d1,($status'offset+2,sp) ; result := error code
00000038 60F4 bra.b $exit
0000003A $null_queue_name:
0000003A 00 .asciz ""
.align
;
; procedure Delete (Queue : Id;
; Result : out Stratus);
;
; procedure Delete_If_Empty (Queue : Id;
; Result : out Stratus);
;
subprogram sp_rt,sp.internal,linkage.simple
.local
$queue'offset equ 4+8
$result'offset equ 8+8
0000003C __msgq$delete:
0000003C 7000 moveq.l #0,d0 ; set qualifier
0000003E 6000 bra.b $common
00000040 __msgq$delete$veremp:
00000040 203C00008000 move.l #q$veremp,d0 ; set qualifier
00000046 2F02 $common:move.l d2,-(sp)
statement 0,0,1
00000048 2F03 move.l d3,-(sp)
statement 0,0,2
0000004A 206F000C movea.l ($queue'offset,sp),a0 ; pointer to queue id
0000004E 42AF0010 clr.l ($result'offset,sp) ; result := successful
00000052 4282 clr.l d2 ; clear upper word
00000054 3410 move.w (a0),d2 ; upper part of queue id
00000056 26280002 move.l (2,a0),d3 ; lower part of queue id
0000005A 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
00000062 4EB10161FFF8 jsr ([Q$Delete, a1]) ; jump to create entry
00000068 6400 bcc.b $return
0000006A 3F410012 $error: move.w d1,($result'offset+2,sp)
0000006E 261F $return:move.l (sp)+,d3
statement 0,0,1
00000070 241F move.l (sp)+,d2
statement 0,0,0
00000072 4E75 rts
;
; procedure Send (Buffer : System.Address;
; Size : Message_Size;
; Queue : Id;
; Result : out Stratus;
; Handle : out Message_Id);
;
;
; procedure Conditional_Send (Buffer : System.Address;
; Size : Message_Size;
; To_Queue : Id;
; Result : out Stratus;
; Handle : out Message_Id);
;
subprogram sp_rt,sp.internal,linkage.simple
.local
$buffer'offset equ 4+20
$size'offset equ 8+20
$queue'offset equ 12+20
$result'offset equ 16+20
$handle'offset equ 20+20
00000074 __msgq$send$retrdy:
00000074 203C00006000 move.l #(Q$UsePri ! Q$RetRdy),d0 ; set qualifier
0000007A 6000 bra.b $common
0000007C __msgq$send:
0000007C 203C00004000 move.l #q$usepri,d0 ; set qualifier
00000082 48E73E00 $common:movem.l d2/d3/d4/d5/d6,-(sp)
statement 0,0,5
00000086 206F0020 movea.l ($queue'offset,sp),a0 ; pointer to queue id
0000008A 42AF0024 clr.l ($result'offset,sp) ; result := successful
0000008E 4282 clr.l d2
00000090 3410 move.w (a0),d2 ; upper part of queue id
00000092 26280002 move.l (2,a0),d3 ; lower part of queue id
00000096 206F0018 movea.l ($buffer'offset,sp),a0 ; address of message buffer
0000009A 282F001C move.l ($size'offset,sp),d4 ; message size
0000009E 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
000000A6 4EB10161FFDC jsr ([q$send,a1]) ; jump to create entry
000000AC 6500 bcs.b $error ; check for error
000000AE 2F450028 move.l d5,($handle'offset,sp) ; handle := message id
000000B2 4CDF007C $exit: movem.l (sp)+,d2/d3/d4/d5/d6 ; restore registers
statement 0,0,0
000000B6 4E75 rts
000000B8 42AF0028 $error: clr.l ($handle'offset,sp) ; handle := null_message
000000BC 3F410026 move.w d1,($result'offset+2,sp) ; result := error code
000000C0 60F0 bra.b $exit
;
; procedure Send_Without_Priority (Value : Integer;
; Queue : Id);
;
; -- special purpose send for the reply queue
;
subprogram sp_rt,sp.internal,linkage.simple
000000C2 __msgq$send$nopri:
.local
$value'offset equ 4+20
$queue'offset equ 8+20
000000C2 48E73E00 movem.l d2/d3/d4/d5/d6,-(sp)
statement 0,0,5
000000C6 7000 moveq.l #0,d0 ; set qualifier
000000C8 206F001C movea.l ($queue'offset,sp),a0 ; pointer to queue id
000000CC 4282 clr.l d2
000000CE 3410 move.w (a0),d2 ; upper part of queue id
000000D0 26280002 move.l (2,a0),d3 ; lower part of queue id
000000D4 41EF0018 lea.l ($value'offset,sp),a0 ; address of value
000000D8 7804 moveq.l #4,d4 ; message size = 4 bytes
000000DA 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
000000E2 4EB10161FFDC jsr ([q$send,a1]) ; jump to create entry
000000E8 4CDF007C movem.l (sp)+,d2/d3/d4/d5/d6
statement 0,0,0
000000EC 4E740008 rtd #8
;
; procedure Wait (On_List : System.Address;
; Maximum : Wait_List_Index;
; Available : out Wait_List_Index);
;
subprogram sp_rt,sp.internal,linkage.simple
000000F0 __msgq$wait:
.local
$on_list'offset equ 4+8
$maximum'offset equ 8+8
$available'offset equ 12+8
; -- prior to blocking in message queue, save the
; -- frame pointer and pc for the debugger
000000F0 2075017000000000 movea.l (__process_descriptor_pointer,a5),a0
000000F8 2050 movea.l (a0),a0 ; get current descriptor
000000FA 215703B4 move.l (sp),(art$savepc,a0) ; save pc
000000FE 214E03B0 move.l a6,(art$savefp,a0) ; save frame pointer
00000102 2F02 move.l d2,-(sp)
statement 0,0,1
00000104 2F03 move.l d3,-(sp)
statement 0,0,2
00000106 7000 moveq.l #0,d0 ; set qualifier
00000108 206F000C movea.l ($on_list'offset,sp),a0 ; pointer to wait list
0000010C 242F0010 move.l ($maximum'offset,sp),d2 ; max of queues in wait list
00000110 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
00000118 4EB10161FFC4 jsr ([Q$Wait, a1]) ; jump to create entry
0000011E 426F0014 clr.w ($available'offset,sp) ; clear upper word
00000122 3F430016 move.w d3,($available'offset+2,sp) ; available := index
00000126 261F move.l (sp)+,d3 ; restore registers
statement 0,0,1
00000128 241F move.l (sp)+,d2
statement 0,0,0
;
; now clear debugger blocking info
;
0000012A 2075017000000000 movea.l (__process_descriptor_pointer,a5),a0
00000132 2050 movea.l (a0),a0 ; get current descriptor
00000134 42A803B0 clr.l (art$savefp,a0) ; clear saved frame pointer
00000138 4E75 rts
;
; procedure Wait_Nonblocking (On_List : System.Address;
; Maximum : Wait_List_Index;
; Result : out Stratus;
; Available : out Wait_List_Index);
;
subprogram sp_rt,sp.internal,linkage.simple
0000013A __msgq$wait$nonblk:
.local
$list'offset equ 4+8
$maximum'offset equ 8+8
$result'offset equ 12+8
$available'offset equ 16+8
0000013A 2F02 move.l d2,-(sp)
statement 0,0,1
0000013C 2F03 move.l d3,-(sp)
statement 0,0,2
0000013E 42AF0014 clr.l ($result'offset,sp) ; result := successful
00000142 42AF0018 clr.l ($available'offset,sp) ; available := 0
00000146 203C00008000 move.l #q$nonblk,d0 ; set qualifier
0000014C 206F000C movea.l ($list'offset,sp),a0 ; pointer to wait list
00000150 242F0010 move.l ($maximum'offset,sp),d2 ; max of queues in wait list
00000154 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
0000015C 4EB10161FFC4 jsr ([q$wait,a1]) ; jump to create entry
00000162 6500 bcs.b $error
00000164 3F43001A move.w d3,($available'offset+2,sp) ; available := index
00000168 261F $exit: move.l (sp)+,d3
statement 0,0,1
0000016A 241F move.l (sp)+,d2
statement 0,0,0
0000016C 2075017000000000 movea.l (__process_descriptor_pointer,a5),a0
00000174 2050 movea.l (a0),a0 ; a0 := descriptor pointer
00000176 42A803B0 clr.l (art$savefp,a0) ; clear debugger info
0000017A 4E75 rts
0000017C 3F410016 $error: move.w d1,($result'offset+2,sp) ; result := error code
00000180 60E6 bra.s $exit
;
; procedure Retrieve_Message (From_Queue : Id;
; To_Buffer : System.Address;
; Buffer_Size : Message_Size);
subprogram sp_rt,sp.internal,linkage.simple
00000182 __msgq$retriev:
$from_queue'offset equ 4+16
$to_buffer'offset equ 8+16
$buffer_size'offset equ 12+16
00000182 48E73C00 movem.l d2/d3/d4/d5,-(sp)
statement 0,0,4
00000186 206F0014 movea.l ($from_queue'offset,sp),a0 ; pointer to queue id
0000018A 4282 clr.l d2 ; clear upper word
0000018C 3410 move.w (a0),d2 ; upper part of queue id
0000018E 26280002 move.l (2,a0),d3 ; lower part of queue id
00000192 206F0018 movea.l ($to_buffer'offset,sp),a0 ; address of message buffer
00000196 282F001C move.l ($buffer_size'offset,sp),d4 ; buffer size
0000019A 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
000001A2 4EB10161FFCC jsr ([q$retriev,a1]) ; jump to create entry
000001A8 4CDF003C movem.l (sp)+,d2/d3/d4/d5 ; restore registers
statement 0,0,0
000001AC 4E74000C rtd #12
;
; procedure Retrieve_If_Available (From_Queue : Id;
; To_Buffer : System.Address;
; Buffer_Size : Message_Size;
; Result : out Stratus);
;
subprogram sp_rt,sp.internal,linkage.simple
000001B0 __msgq$retriev_if_available:
.local
$queue'offset equ 4+16
$to_buffer'offset equ 8+16
$buffer_size'offset equ 12+16
$result'offset equ 16+16
000001B0 48E73C00 movem.l d2/d3/d4/d5,-(sp) ; save the nonvolatile registers
statement 16,0,0
000001B4 206F0014 movea.l ($queue'offset,sp),a0 ; pointer to queue id
000001B8 42AF0020 clr.l ($result'offset,sp) ; result := successful
000001BC 4282 clr.l d2 ; clear upper word
000001BE 3410 move.w (a0),d2 ; upper part of queue id
000001C0 26280002 move.l (2,a0),d3 ; lower part of queue id
000001C4 206F0018 movea.l ($to_buffer'offset,sp),a0 ; address of message buffer
000001C8 282F001C move.l ($buffer_size'offset,sp),d4 ; buffer size
000001CC 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
000001D4 4EB10161FFCC jsr ([q$retriev,a1]) ; jump to create entry
000001DA 6400 bcc.b $exit
000001DC 3F410022 $error: move.w d1,($result'offset+2,sp) ; result := error code
000001E0 4CDF003C $exit: movem.l (sp)+,d2-d5
statement 0,0,0
000001E4 4E75 rts
;
; procedure Remove_Message (From_Queue : Id;
; Remove_Id : Message_Id;
; Result : out Stratus);
;
subprogram sp_rt,sp.internal,linkage.simple
000001E6 __msgq$remove:
.local
$queue'offset equ 4+12
$id'offset equ 8+12
$result'offset equ 12+12
000001E6 48E73400 movem.l d2/d3/d5,-(sp) ; save the nonvolatile
statement 0,0,3
000001EA 206F0010 movea.l ($queue'offset,sp),a0 ; pointer to queue id
000001EE 42AF0018 clr.l ($result'offset,sp) ; result := successful
000001F2 4282 clr.l d2 ; clear upper word
000001F4 3410 move.w (a0),d2 ; upper part of queue id
000001F6 26280002 move.l (2,a0),d3 ; lower part of queue id
000001FA 2A2F0014 move.l ($id'offset,sp),d5 ; id of message to remove
000001FE 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
00000206 4EB10161FFD0 jsr ([q$remove,a1]) ; jump to create entry
0000020C 6400 bcc.b $exit
0000020E 3F41001A $error: move.w d1,($result'offset+2,sp) ; result := error code
00000212 4CDF002C $exit: movem.l (SP)+,d2/d3/d5 ; restore registers
statement 0,0,0
00000216 4E75 rts
;
; procedure Length (Of_Queue : Id;
; Result : out Stratus;
; Count : out Queue_Length);
;
subprogram sp_rt,sp.internal,linkage.simple
00000218 __msgq$length:
.local
$queue'offset equ 4+12
$result'offset equ 8+12
$count'offset equ 12+12
00000218 48E73800 movem.l d2/d3/d4,-(sp)
statement 0,0,3
0000021C 206F0010 movea.l ($queue'offset,sp),a0 ; pointer to queue id
00000220 42AF0014 clr.l ($result'offset,sp) ; result := successful
00000224 4282 clr.l d2 ; clear upper word
00000226 3410 move.w (a0),d2 ; upper part of queue id
00000228 26280002 move.l (2,a0),d3 ; lower part of queue id
0000022C 2275017000000000 movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
00000234 4EB10161FFF0 jsr ([q$length,a1]) ; jump to create entry
0000023A 6500 bcs.b $error
0000023C 426F0018 clr.w ($count'offset,SP) ; clear upper word
00000240 3F44001A move.w d4,($count'offset+2,sp) ; count := computed
00000244 4CDF001C $exit: movem.l (sp)+,d2/d3/d4
statement 0,0,0
00000248 4E75 rts
0000024A 42AF0018 $error: clr.l ($count'offset,sp) ; count := 0
0000024E 3F410016 move.w d1,($result'offset+2,sp) ; result := error code
00000252 60F0 bra.b $exit
;
;
; procedure Get_Associated_Data (For_Queue : Id;
; Result : out Stratus;
; Data : out Associated_Data);
;
subprogram sp_rt,sp.internal,linkage.simple
00000254 __msgq$get_associated_data:
.local
$queue'offset equ 4+12
$result'offset equ 8+12
$data'offset equ 12+12
00000254 48E73800 movem.l d2/d3/d4,-(sp)
statement 0,0,3
00000258 206F0010 movea.l ($queue'offset,sp),a0 ; pointer to queue id
0000025C 42AF0014 clr.l ($result'offset,sp) ; result := successful
00000260 4282 clr.l d2 ; clear upper word
00000262 3410 move.w (a0),d2 ; upper part of queue id
00000264 26280002 move.l (2,a0),d3 ; lower part of queue id
00000268 2275017000000000 movea.l (__MsgQ_Entry_Pointer, a5), a1 ; get entry table pointer
00000270 4EB10161FFC0 jsr ([Q$RQuData, a1]) ; jump to create entry
00000276 6500 bcs.b $error
00000278 2F440018 move.l d4,($data'offset,sp) ; store data
0000027C 4CDF001C $exit: movem.l (sp)+,d2/d3/d4 ; restore registers
statement 0,0,0
00000280 4E75 rts
00000282 42AF0018 $error: clr.l ($data'offset,sp) ; data := 0
00000286 3F410016 move.w d1,($result'offset+2,sp) ; result := error code
0000028A 60F0 bra.b $exit
;
; procedure Start (Time : Delay_Time;
; Queue : Message_Queue.Id;
; Signal : Timeout_Message;
; Result : out Stratus;
; Handle : out Id);
;
subprogram sp_rt,sp.internal,linkage.simple
0000028C __timer$start:
.local
$rounding_factor equ 15
$time'offset equ 4+12
$queue'offset equ 8+12
$signal'offset equ 12+12
$result'offset equ 16+12
$handle'offset equ 20+12
0000028C 48E73800 movem.l d2/d3/d4,-(sp)
statement 0,0,3
00000290 202F0010 move.l ($time'offset,sp),d0 ; delay time in d0
00000294 42AF001C clr.l ($result'offset,sp) ; result := successful
00000298 720F moveq.l #$rounding_factor,d1 ; factor to round up
0000029A D280 add.l d0,d1 ; do round
0000029C 6800 bvc.b $timeok ; ok if not overflow
0000029E 2200 move.l d0,d1 ; else get value passed
000002A0 E881 $timeok:asr.l #4,d1 ; scale duration for timer
000002A2 206F0014 movea.l ($queue'offset,sp),a0 ; pointer to queue id
000002A6 4282 clr.l d2 ; clear upper word
000002A8 3410 move.w (a0),d2 ; upper part of queue id
000002AA 26280002 move.l (2,a0),d3 ; lower part of queue id
000002AE 282F0018 move.l ($signal'offset,sp),d4 ; timeout message
000002B2 203C20000001 move.l #(Ti$Start ! Ti$OneSh),d0
000002B8 4E40 trap #0
000002BA 00FA .dc.w f$peab
000002BC 6500 bcs.b $error ; check for error
000002BE 2F400020 move.l d0,($handle'offset,sp) ; handle := id
000002C2 4CDF001C $exit: movem.l (sp)+,d2/d3/d4 ; restore registers
statement 0,0,0
000002C6 4E75 rts
000002C8 42AF0020 $error: clr.l ($handle'offset,sp) ; handle := 0
000002CC 3F41001E move.w d1,($result'offset+2,sp) ; result := error code
000002D0 60F0 bra.b $exit
;
; procedure Stop (Handle : Id; Result : out Stratus);
;
subprogram sp_rt,sp.internal,linkage.simple
000002D2 __timer$stop:
.local
$handle'offset equ 4
$result'offset equ 8
000002D2 222F0004 move.l ($handle'offset,sp),d1 ; time id
000002D6 42AF0008 clr.l ($result'offset,sp) ; result := successful
000002DA 203C00000002 move.l #Ti$Stop,d0
000002E0 4E40 trap #0
000002E2 00FA .dc.w F$PEAB
000002E4 6400 bcc.b $return
000002E6 3F41000A move.w d1,($result'offset+2,sp)
000002EA 4E75 $return:rts
end_subprograms
.end
Program Section Name Kind Length Patches Fixups
-------------------------------- ---- ---------- ------- -------
ADA_RUNTIME_CODE Rel 748 14 27
DEBUG_BODY Rel 500 57 13
DEBUG_HDR_CU Rel 52 2 0
Standard include file: <none>
Object module version: 11
Assembled 6808 lines in 54.512 elapsed, 43.313 CPU.
7493 lines per elapsed minute.
9431 lines per CPU minute.
62 disk waits for this job.
1941489 bytes of heap used by this job.