DataMuseum.dk

top - download

    Length: 5314 (0x14c2)
    Types: TextFile
    Names: »ADAROOT_UTIL_ASM«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─ ⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦24d1ddd49⟧ 
                └─⟦this⟧ 

TextFile

;    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_UTILITIES"

;
;  This assembly file contains some utility routines which are
;  shared by the sequential and tasking adaroots.
;

        .include    "^^standard_assembler_include_file"
        .include    "^^common.runtime_definitions"
        .include    "^^common.os2000_definitions"

        comp_unit  Runtime_Compunit

        .sect   ada_runtime_code,code,relocatable,alignment:=2

        .gbl.l  __delay_statement
        .gbl.a  __tcb_checksum
        .gbl.a  __atomic_add_bounded
        .gbl.a  __heap_align_value
        .gbl.a  __primitive_read
        .gbl.a  __primitive_write   
        .gbl.l  __report_fatal_error
        .gbl.l  __issue_warning;

        .ext.l  __error_path
        .ext.l  __tdlystm_indirect

        subprogram sp_rt,sp.internal,linkage.simple
__delay_statement:
        movea.l (__tdlystm_indirect,a5),a0
        jmp     (a0)
;
;       procedure Primitive_Write (Count : Natural; Buffer : System.Address);
;
        subprogram sp_rt,sp.internal,linkage.simple
__primitive_read:
        .local
        
        $count'offset   equ 4
        $buffer'offset  equ 8

        moveq.l #standard_input,d0      ; standard input
        move.l  ($count'offset,sp),d1   ; max byte count
        movea.l ($buffer'offset,sp),a0  ; buffer address
        trap    #os9_call
        .dc.w   i$read                      
        rtd     #8          
;
;       procedure Primitive_Write (Count : Natural; Buffer : System.Address);
;
        subprogram sp_rt,sp.internal,linkage.simple
__primitive_write:
        .local
        
        $count'offset   equ 4
        $buffer'offset  equ 8

        moveq.l #standard_output,d0     ; standard out
        move.l  ($count'offset,sp),d1   ; byte count
        movea.l ($buffer'offset,sp),a0  ; buffer address
        trap    #os9_call
        .dc.w   i$write                      
        rtd     #8          
;
;       procedure Report_Fatal_Warning (Id : Integer);
;
        subprogram sp_rt,sp.internal,linkage.simple
__report_fatal_error:
        .local
        
        $id'offset      equ 4

        move.w  (__error_path,a5),d0    ; get path for error messages
        move.l  ($id'offset,sp),d1      ; get error number
        ori.w   #error$code,d1          ; set high byte
        trap    #os9_call               ; make system call
        .dc.w   f$perr
        rtd     #4
;
;       procedure Issue_Warning (Id : Integer);
;
        subprogram sp_rt,sp.internal,linkage.simple
__issue_warning:
        .local
        
        $id'offset      equ 4

        move.w  (__error_path,a5),d0    ; get path for error messages
        move.l  ($id'offset,sp),d1      ; get error number
        ori.w   #warning$code,d1        ; set high byte
        trap     #os9_call              ; make system call
        .dc.w    f$perr
        rtd     #4
;
;       function Tcb_Checksum (Id : Task_Id) return Integer;
;
        subprogram sp_rt,sp.internal,linkage.simple
__tcb_checksum:
        .local
        
        $id'offset      equ 4

        move.l  ($id'offset,a7),d0
        not.l   d0
        rtd     #4
;
;       function Atomic_Add_Bounded (Result : System.Address;
;                                    Addend : Integer;
;                                    Max    : Integer) return Integer;
;
        subprogram sp_rt,sp.internal,linkage.simple
__atomic_add_bounded:
        .local

        $result'offset  equ 4
        $addend'offset  equ 8
        $max'offset     equ 12

        movea.l ($result'offset,sp),a0  ; a0 := address of result
        move.l  (a0),d0                 ; d0 := result

$retry: move.l  d0,d1
        add.l   ($addend'offset,sp),d1  ; d1 := result + addend
        bvs.b   $overflow

        cmp.l   ($max'offset,sp),d1     ; check <= Maximum 
        bgt.b   $overflow

        cas.l   d0,d1,(a0)              ; atomic assign sum to sum_ref.all 
        bne.b   $retry                  ; try again if concurrent interference
        rtd     #12                     ; d0 has result value

$overflow:
        moveq.l #0,d0
        rtd     #12
;
;       function Heap_Align (Value : Integer) return Integer;
;
        subprogram sp_rt,sp.internal,linkage.simple
__heap_align_value:
        .local
        
        $value'offset   equ 4

        move.l  ($value'offset,sp),d0   ; d0 := value 
        addq.l  #7,d0                   ; add amount
        andi.b  #16#F8#,d0
        rtd     #4

        end_subprograms
        
        .end