DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ S T

⟦78a12fe11⟧ TextFile

    Length: 5796 (0x16a4)
    Types: TextFile
    Names: »SEMAPHORE_ASM«

Derivation

└─⟦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 "SEMAPHORE"

;
;    Implements operations which depend on the location and
;    organization of OS-9 and OS2000 internal data structures. 
;    
;    THIS CODE IS HIGHLY DEPENDENT ON UNDOCUMENTED ASPECTS OF OS-9
;    CURRENTLY WORKS WITH OS-9 REV 2.1;
;

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

        comp_unit  runtime_compunit

        .sect   predefined_code,code,relocatable,alignment:=2
    
        .gbl.l  __semaphore_acquire
        .gbl.l  __semaphore_release
        .ext.a  __process_descriptor_pointer

;
;    procedure Acquire (The_Lock : in out Lock);
;
        subprogram sp_rt,sp.internal,linkage.simple
__semaphore_acquire:
        .local
        
        $lock'offset    equ 4+4

        move.l  d3,-(sp)
        statement 0,0,1

        movea.l ($lock'offset,sp),a0    ; get address of The_Lock
        movea.l ([__process_descriptor_pointer,a5]),a1
        move.l  (art$tsk_id,a1),d3      ; fetch current task id
        move.l  d3,-(sp)                ; Element.Key  := Get_Current_Task_Id
        statement 0,0,2
        subq.l  #4,sp                   ; Element.Next uninitialized 
        statement 0,0,3

        movea.l a0,a1                   ; The_Lock'Address is in A0 
        addq.l  #element.key,a1         ; The_Lock.Key'Address

$retry: moveq.l #0,d1                   ; null
        cas.l   d1,d3,(a1)              ; if The_Lock.Key = 0 then
                                        ;     The_Lock.Key  := The_Element.Key;
        bne.b   $failed                 ; if Key /= 0 then failed

$acquired:                              ; else succeeded
        move.l  (element.key,a0),d0     ; get The_Lock.Key
        addq.l  #8,sp                   ; restore stack
        statement 0,0,1
        move.l  (sp)+,d3                ; restore d3
        statement 0,0,0
        rtd     #4

$failed:move.l  (a0),d0                 ; get The_Lock.Next
        move.l  d0,(sp)                 ; Item.Next := Lock.Next

        move.l  sp,d3                   ; The_Element.Next'Address
        cas2.l  d0:d1,d3:d1,(a0):(a1)   ; if Lock unchanged then
                                        ;     Lock.Next := Item and
        beq.b   $sleep                  ; if equal then properly enqueued 
                                        ; else concurrent interference,
        move.l  (element.key,sp),d3     ; so get The_Element.Key
        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.
;

$sleep: move.l  #-2147483644,d0         ; sleep time
        trap    #os9_call               ; do system call
        .dc.w   f$sleep
    
        move.l  (element.key,a0),d0     ; get The_Lock.Key
        cmp.l   (element.key,sp),d0     ; compare to The_Element.Key
        beq.b   $acquired               ; if equal then got the lock
        bra.b   $sleep                  ; else try again 
;
;    procedure Release (The_Lock : in out Lock);
;
        subprogram sp_rt,sp.internal,linkage.simple
__semaphore_release:
        .local

        $lock'offset    equ 4

        movea.l ($lock'offset,sp),a0    ; get address of The_Lock
        movea.l a0,a1                   ; in a1, too
        addq.l  #Element.Key,a1         ; Lock.Key'Address
        move.l  (a1),d1                 ; Lock.Key
        moveq   #0,d0                   ; null, null id
        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; 
        bne.b   $waiters
        rtd     #4                      ; released the lock, no waiters

$waiters:
        movem.l d2/d3/a3,-(a7)
        statement 0,0,3

$retry: movea.l d0,a3                   ; Lock.Next
        move.l  (a3),d2                 ; Lock.Next.Next
        move.l  (Element.Key,a3),d3     ; Lock.Next.Key 
        cas2.l  d0:d1,d2:d3,(a0):(a1)   ; if Lock unchanged then
                                        ;     Lock.Next := Lock.Next.Next;
                                        ;     Lock.Key  := Lock.Next.Key;
        bne.b   $retry                  ; concurrent interference

        movea.l d3,a0                   ; get The_Lock.Key
        movem.l (a7)+,d2/d3/a3
        statement 0,0,0

        moveq.l #1,d1                   ; wakeup signal
        move.l  (Tcb.Process_Id,a0),d0  ; get The_Lock.Key.Process_Id
        trap    #OS9_Call                     ; do system call
        .dc.w   F$Send              
        rtd     #4

        end_subprograms

        .end