|
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: ┃ M T ┃
Length: 20063 (0x4e5f)
Types: TextFile
Names: »MSQTI_OPS_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 "MESSAGE_QUEUE_TIMER_OPERATIONS"
;
; Implements the body of the Ada packages Message_Queue and Timer
;
.include "^^standard_assembler_include_file"
.include "^^common.runtime_definitions"
.include "^^common.os2000_definitions"
.include "^^common.msqti_definitions"
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
__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
movem.l d2/d3/d4/d5,-(sp)
statement 16,0,0
lea ($null_queue_name:16,pc),a0 ; queue name string
clr.l ($status'offset,sp) ; result := successful
moveq.l #local_no_channels,d0 ; qualifier flags
move.l ($max_size'offset,sp),d4 ; max message size
move.l ($max_count'offset,sp),d5 ; max number of messages
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$create,a1]) ; jump to create entry
bcs.b $error ; check for error
movea.l ($queue'offset,sp),a0 ; get pointer to id
move.w d2,(a0)+ ; upper part of id
move.l d3,(a0) ; lower part of id
$exit: movem.l (sp)+,d2/d3/d4/d5 ; restore registers
statement 0,0,0
rts
$error: move.w d1,($status'offset+2,sp) ; result := error code
bra.b $exit
$null_queue_name:
.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
__msgq$delete:
moveq.l #0,d0 ; set qualifier
bra.b $common
__msgq$delete$veremp:
move.l #q$veremp,d0 ; set qualifier
$common:move.l d2,-(sp)
statement 0,0,1
move.l d3,-(sp)
statement 0,0,2
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l ($result'offset,sp) ; result := successful
clr.l d2 ; clear upper word
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([Q$Delete, a1]) ; jump to create entry
bcc.b $return
$error: move.w d1,($result'offset+2,sp)
$return:move.l (sp)+,d3
statement 0,0,1
move.l (sp)+,d2
statement 0,0,0
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
__msgq$send$retrdy:
move.l #(Q$UsePri ! Q$RetRdy),d0 ; set qualifier
bra.b $common
__msgq$send:
move.l #q$usepri,d0 ; set qualifier
$common:movem.l d2/d3/d4/d5/d6,-(sp)
statement 0,0,5
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l ($result'offset,sp) ; result := successful
clr.l d2
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
movea.l ($buffer'offset,sp),a0 ; address of message buffer
move.l ($size'offset,sp),d4 ; message size
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$send,a1]) ; jump to create entry
bcs.b $error ; check for error
move.l d5,($handle'offset,sp) ; handle := message id
$exit: movem.l (sp)+,d2/d3/d4/d5/d6 ; restore registers
statement 0,0,0
rts
$error: clr.l ($handle'offset,sp) ; handle := null_message
move.w d1,($result'offset+2,sp) ; result := error code
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
__msgq$send$nopri:
.local
$value'offset equ 4+20
$queue'offset equ 8+20
movem.l d2/d3/d4/d5/d6,-(sp)
statement 0,0,5
moveq.l #0,d0 ; set qualifier
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l d2
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
lea.l ($value'offset,sp),a0 ; address of value
moveq.l #4,d4 ; message size = 4 bytes
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$send,a1]) ; jump to create entry
movem.l (sp)+,d2/d3/d4/d5/d6
statement 0,0,0
rtd #8
;
; procedure Wait (On_List : System.Address;
; Maximum : Wait_List_Index;
; Available : out Wait_List_Index);
;
subprogram sp_rt,sp.internal,linkage.simple
__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
movea.l (__process_descriptor_pointer,a5),a0
movea.l (a0),a0 ; get current descriptor
move.l (sp),(art$savepc,a0) ; save pc
move.l a6,(art$savefp,a0) ; save frame pointer
move.l d2,-(sp)
statement 0,0,1
move.l d3,-(sp)
statement 0,0,2
moveq.l #0,d0 ; set qualifier
movea.l ($on_list'offset,sp),a0 ; pointer to wait list
move.l ($maximum'offset,sp),d2 ; max of queues in wait list
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([Q$Wait, a1]) ; jump to create entry
clr.w ($available'offset,sp) ; clear upper word
move.w d3,($available'offset+2,sp) ; available := index
move.l (sp)+,d3 ; restore registers
statement 0,0,1
move.l (sp)+,d2
statement 0,0,0
;
; now clear debugger blocking info
;
movea.l (__process_descriptor_pointer,a5),a0
movea.l (a0),a0 ; get current descriptor
clr.l (art$savefp,a0) ; clear saved frame pointer
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
__msgq$wait$nonblk:
.local
$list'offset equ 4+8
$maximum'offset equ 8+8
$result'offset equ 12+8
$available'offset equ 16+8
move.l d2,-(sp)
statement 0,0,1
move.l d3,-(sp)
statement 0,0,2
clr.l ($result'offset,sp) ; result := successful
clr.l ($available'offset,sp) ; available := 0
move.l #q$nonblk,d0 ; set qualifier
movea.l ($list'offset,sp),a0 ; pointer to wait list
move.l ($maximum'offset,sp),d2 ; max of queues in wait list
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$wait,a1]) ; jump to create entry
bcs.b $error
move.w d3,($available'offset+2,sp) ; available := index
$exit: move.l (sp)+,d3
statement 0,0,1
move.l (sp)+,d2
statement 0,0,0
movea.l (__process_descriptor_pointer,a5),a0
movea.l (a0),a0 ; a0 := descriptor pointer
clr.l (art$savefp,a0) ; clear debugger info
rts
$error: move.w d1,($result'offset+2,sp) ; result := error code
bra.s $exit
;
; procedure Retrieve_Message (From_Queue : Id;
; To_Buffer : System.Address;
; Buffer_Size : Message_Size);
subprogram sp_rt,sp.internal,linkage.simple
__msgq$retriev:
$from_queue'offset equ 4+16
$to_buffer'offset equ 8+16
$buffer_size'offset equ 12+16
movem.l d2/d3/d4/d5,-(sp)
statement 0,0,4
movea.l ($from_queue'offset,sp),a0 ; pointer to queue id
clr.l d2 ; clear upper word
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
movea.l ($to_buffer'offset,sp),a0 ; address of message buffer
move.l ($buffer_size'offset,sp),d4 ; buffer size
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$retriev,a1]) ; jump to create entry
movem.l (sp)+,d2/d3/d4/d5 ; restore registers
statement 0,0,0
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
__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
movem.l d2/d3/d4/d5,-(sp) ; save the nonvolatile registers
statement 16,0,0
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l ($result'offset,sp) ; result := successful
clr.l d2 ; clear upper word
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
movea.l ($to_buffer'offset,sp),a0 ; address of message buffer
move.l ($buffer_size'offset,sp),d4 ; buffer size
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$retriev,a1]) ; jump to create entry
bcc.b $exit
$error: move.w d1,($result'offset+2,sp) ; result := error code
$exit: movem.l (sp)+,d2-d5
statement 0,0,0
rts
;
; procedure Remove_Message (From_Queue : Id;
; Remove_Id : Message_Id;
; Result : out Stratus);
;
subprogram sp_rt,sp.internal,linkage.simple
__msgq$remove:
.local
$queue'offset equ 4+12
$id'offset equ 8+12
$result'offset equ 12+12
movem.l d2/d3/d5,-(sp) ; save the nonvolatile
statement 0,0,3
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l ($result'offset,sp) ; result := successful
clr.l d2 ; clear upper word
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
move.l ($id'offset,sp),d5 ; id of message to remove
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$remove,a1]) ; jump to create entry
bcc.b $exit
$error: move.w d1,($result'offset+2,sp) ; result := error code
$exit: movem.l (SP)+,d2/d3/d5 ; restore registers
statement 0,0,0
rts
;
; procedure Length (Of_Queue : Id;
; Result : out Stratus;
; Count : out Queue_Length);
;
subprogram sp_rt,sp.internal,linkage.simple
__msgq$length:
.local
$queue'offset equ 4+12
$result'offset equ 8+12
$count'offset equ 12+12
movem.l d2/d3/d4,-(sp)
statement 0,0,3
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l ($result'offset,sp) ; result := successful
clr.l d2 ; clear upper word
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
movea.l (__msgq_entry_pointer,a5),a1 ; get entry table pointer
jsr ([q$length,a1]) ; jump to create entry
bcs.b $error
clr.w ($count'offset,SP) ; clear upper word
move.w d4,($count'offset+2,sp) ; count := computed
$exit: movem.l (sp)+,d2/d3/d4
statement 0,0,0
rts
$error: clr.l ($count'offset,sp) ; count := 0
move.w d1,($result'offset+2,sp) ; result := error code
bra.b $exit
;
;
; procedure Get_Associated_Data (For_Queue : Id;
; Result : out Stratus;
; Data : out Associated_Data);
;
subprogram sp_rt,sp.internal,linkage.simple
__msgq$get_associated_data:
.local
$queue'offset equ 4+12
$result'offset equ 8+12
$data'offset equ 12+12
movem.l d2/d3/d4,-(sp)
statement 0,0,3
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l ($result'offset,sp) ; result := successful
clr.l d2 ; clear upper word
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
movea.l (__MsgQ_Entry_Pointer, a5), a1 ; get entry table pointer
jsr ([Q$RQuData, a1]) ; jump to create entry
bcs.b $error
move.l d4,($data'offset,sp) ; store data
$exit: movem.l (sp)+,d2/d3/d4 ; restore registers
statement 0,0,0
rts
$error: clr.l ($data'offset,sp) ; data := 0
move.w d1,($result'offset+2,sp) ; result := error code
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
__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
movem.l d2/d3/d4,-(sp)
statement 0,0,3
move.l ($time'offset,sp),d0 ; delay time in d0
clr.l ($result'offset,sp) ; result := successful
moveq.l #$rounding_factor,d1 ; factor to round up
add.l d0,d1 ; do round
bvc.b $timeok ; ok if not overflow
move.l d0,d1 ; else get value passed
$timeok:asr.l #4,d1 ; scale duration for timer
movea.l ($queue'offset,sp),a0 ; pointer to queue id
clr.l d2 ; clear upper word
move.w (a0),d2 ; upper part of queue id
move.l (2,a0),d3 ; lower part of queue id
move.l ($signal'offset,sp),d4 ; timeout message
move.l #(Ti$Start ! Ti$OneSh),d0
trap #0
.dc.w f$peab
bcs.b $error ; check for error
move.l d0,($handle'offset,sp) ; handle := id
$exit: movem.l (sp)+,d2/d3/d4 ; restore registers
statement 0,0,0
rts
$error: clr.l ($handle'offset,sp) ; handle := 0
move.w d1,($result'offset+2,sp) ; result := error code
bra.b $exit
;
; procedure Stop (Handle : Id; Result : out Stratus);
;
subprogram sp_rt,sp.internal,linkage.simple
__timer$stop:
.local
$handle'offset equ 4
$result'offset equ 8
move.l ($handle'offset,sp),d1 ; time id
clr.l ($result'offset,sp) ; result := successful
move.l #Ti$Stop,d0
trap #0
.dc.w F$PEAB
bcc.b $return
move.w d1,($result'offset+2,sp)
$return:rts
end_subprograms
.end