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: ┃ C T

⟦9278aa5f9⟧ TextFile

    Length: 6045 (0x179d)
    Types: TextFile
    Names: »CALENDAR_OPS_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 "CALENDAR_OPERATIONS"

;
;    Implements the body of the Ada package Calendar.Imports
;

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

        comp_unit  runtime_compunit

        .sect predefined_code,relocatable,code,readonly,concatenate,alignment:=2

        .gbl.l _art_f$time$ticks
        .gbl.l _art_f$julian$jan_1_1901
        .gbl.l __get_political_time

        julian$with$ticks    equ 3;

;   procedure Get_Tick_Rate (Ticks_Per_Second : out Integer;
;                            Status           : out Integer);
;                       
        subprogram sp_rt,sp.internal,linkage.simple
_art_f$time$ticks:
        .local

        $ticks  equ 4+8
        $status equ 8+8

        movem.l d2-d3,-(sp)
        statement 0,0,2

        move.w  #julian$with$ticks,d0   ; set the format code
        trap    #os9_call               ; trap to get time
        .dc.w   f$time

        bcc.b   $store

$error: move.l   d1,($status,sp)        ; error status
        bra.b    $return

$store: clr.w   d3                      ; clear d3 low word
        swap.w  d3                      ; get tick rate
        move.l  d3,($ticks,sp)          ; store tick rate 
        clr.l   ($status,sp)            ; successful status

$return:movem.l (sp)+,d2-d3             ; restore registers
        statement 0,0,0
        rts
;    
;   procedure Get_Jan_1_1901 (Ticks_Per_Second : out Integer;
;                            Status            : out Integer);
;                       
        subprogram sp_rt,sp.internal,linkage.simple
_art_f$julian$jan_1_1901:
        .local

        $ticks  equ 4
        $status equ 8

        jan_1_1901      equ (1901 * (2 ** 16)) + (2**8) + 1

        moveq.l #0,d0                   ; hour/minute/second
        move.l  #jan_1_1901,d1          ; year/month/day

        trap    #os9_call               ; trap to get Julian date
        .dc.w   f$julian

        bcs.b   $error

        move.l  d1,($ticks,sp)          ; store Julian date 
        clr.l   ($status,sp)            ; successful status
        rts

$error: move.l  d1,($status,sp)         ; error status
        rts
;
;
;   procedure Get_Political_Time (Seconds : out Integer;
;                                 Ticks : out Tick_Id;
;                                 Base_Year : out Year_Number);
;   --
;   -- Return time as a offset in Seconds from the Base_Year and ticks.
;   -- Base_Year is in the range 1901 .. 2099 and is = 1 mod 4.  The
;   -- tick rate is 1/8192; Duration'Delta is 1/16384, so the value
;   -- from the hardware register must be appropriately scaled.
;                       
        subprogram sp_rt,sp.internal,linkage.simple
__get_political_time:
        .local

        $seconds        equ 8
        $ticks          equ 12
        $year           equ 16

        max_days       equ 364 * 24 * 60 * 60;       
        max_hours      equ 23 * 60 * 60;
        max_minutes    equ 59 * 60;
        max_seconds    equ max_days + max_hours + max_minutes + 59;    
        max_ticks      equ 32766;
        max_year       equ 2099;

        move.l   d2,-(sp)               ; save nonvolatile register
        statement 0,0,1

        move.l  sp,d0                   ; get current stack pointer
        and.l   #(-a32_size),d0         ; mask for high order bits
        movea.l (cct_start+pi_cpt,d0),a0; get CPT address

        movea.l (a0)+,a1                ; get timer register address
        movea.l (a0),a0                 ; get political time offset

        addq.l  #4,a1                   ; point to second word of time
    
$read_time:
        move.l  (a1),d1                 ; get fraction of seconds
        bcs.b   $error                  ; if carry then hw problem
        move.l  (-4,a1),d2              ; get seconds
        cmp.l   (a1),d1                 ; check if fractions has changed
        bne.b   $read_time              ; if changed, then try again
    
$have_time:
        bclr.l  #31,d2                  ; clear high bit of seconds
        lsl.w   #3,d1                   ; shift fraction for add
        move.l  (a0)+,d0                ; get seconds of poltime offset
        add.w   (a0)+,d1                ; add fraction of poltime offset
        addx.l  d0,d2                   ; add seconds extended
        bvs.b   $error                  ; error if overflow
        move.w  (a0),d0                 ; get base year
        bra.s   $store

$error: move.l  #max_year,d0            ; set error base year
        move.l  #max_ticks,d1           ; set error ticks
        move.l  #max_seconds,d2         ; set error seconds

$store: move.l  d2,($seconds,sp)        ; store seconds
        clr.l   ($ticks,sp)             ; clear tick longword
        lsr.w   #2,d1                   ; shift fraction 
        move.w  d1,($ticks+2,sp)        ; store ticks
        clr.l   ($year,sp)              ; clear base year longword
        move.w  d0,($year+2,sp)         ; store base year

$return:move.l  (sp)+,d2                      ; restore registers
        statement 0,0,0
        rts

        end_subprograms

        .end