From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CUSPIF.TN.CORNELL.EDU::BRIAN.T.CARCICH" 15-AUG-1989 11:15
To:	MRGATE::"ARISIA::EVERHART"
Subj:	This is what i'll be posting to info-vax as my additions to tar - v5rtl.for/.mar, lowercase.dif, tar.cld

Message-Id:  <8908151502.AA00897@crdgw1.ge.com>
Date: 15 Aug 1989 11:01:17 EST
From: Brian.T.Carcich@CUSPIF.TN.CORNELL.EDU
To: everhart@arisia.decnet
Subject: This is what i'll be posting to info-vax as my additions to tar - v5rtl.for/.mar, lowercase.dif, tar.cld
X-Vms-Original-To: INET%"everhart%arisia.decnet@crd.ge.com"


$ ! THIS IS THE LAST PART OF A REDISTRIBUTION OF TIM COOK'S TAR PACKAGE.
$ !=====================================================================
$ !=                                                                   =
$ != PLEASE NOTE THAT THIS IS NOT TO BE ADDED TO THE 10 VMS_SHARE PARTS=
$ !=                                                                   =
$ !=====================================================================
$ ! PLEASE EXCUSE ME FOR NOT USING VMS_SHARE TO DISTRIBUTE IT, BUT IT'S SUCH
$ ! A MISH-MASH OF THINGS THAT THIS SEEMS QUICKER.
$ ! IT CONTAINS MAINLY GARBAGE COLLECTION OF ADDITIONS AND/OR MODIFICATIONS
$ ! TO WHAT I RECEIVED IN THE ORIGINAL 10 PART DISTRIBUTION.
$ ! WHEN I USED DIFFERENCES, IF THE ORIGINAL FILE IS A.B, THE NEW FILE
$ ! IN THE DIFF OUTPUT IS A.BNEW, THE OLD FILE IN THE DIFF OUTPUT IS A.BORIG.
$ !
$ !SUMMARY - EACH SECTION IS DIVIDED BY "$ !" + 69 "="'S AS IN THE NEXT LINE:
$ !=====================================================================
$ !
$ !   I)  A TAR.CLD FILE FOR DEFINING THE TAR COMMAND
$ !          - DEVELOPED FROM THE TAR.HLP
$ !          - @ THIS MESSAGE AS A .COM (W/O MAIL HEADER) TO CREATE TAR.CLD
$ !                    AND TAR.FOR (BELOW)
$ !
$ !  II)  A DUMY.FOR FILE FOR VMS V4 USAGE
$ !          - PROVIDES VMS V5-EQUIVALENT RUN-TIME LIBRARY ROUTINES FOR
$ !                   THIS TAR PACKAGE ONLY - SEE THE CAVEATS IN THE COMMENTS
$ !                   =====================
$ !          - THIS MOD IS NOT REQUIRED FOR VMS V5 USAGE
$ !          - DEVELOPED FROM READING THE SOURCE
$ !          - @ THIS MESSAGE AS A .COM (W/O MAIL HEADER) TO CREATE TAR.FOR
$ !                    AND TAR.CLD (ABOVE)
$ !          - JUST COMPILE IT AND ADD ",DUMY.OBJ" TO THE TAR LINK COMMAND
$ !              P1 LIST IN BUILD_TAR.COM.
$ !          - IF YOU FEEL I SHOULD APOLOGISE BECAUSE IT'S IN FORTRAN, HA!
$ !          - IF YOU DON'T HAVE A FORTRAN COMPILER, I _am_ SORRY, AND I HAVE 
$ !               PROVIDED THE MACHINE CODE FROM "FOR/MACH/LIS" AS THE LAST 
$ !               ITEM IN THIS PART OF THE DISTRIBUTION (SEE BELOW).
$ !
$ ! III)  A DIFFERENCES OUTPUT FOR THE TAR.PAS SOURCE FILE FOR VMS V4 USAGE
$ !          - ADDED LIB$K_DELTA_SECONDS (PRESUMABLY IT'S IN SOME .MLB
$ !                                       IN VMS V5)
$ !          - THIS MOD IS NOT REQUIRED FOR VMS V5 USAGE
$ !          - OPENING & CLOSING CURLY BRACES (I.E. PASCAL COMMENT DELIMITERS)
$ !             ARE FOLLOWED & PRECEDED BY "CMNT" AS AN AID TO ANYONE WHO
$ !             GETS THIS FILE WITH MUNGED CURLY BRACES.  I DIDN'T DO ANYTHING
$ !             FOR SQUARE BRACKETS
$ !
$ !  IV)  A DIFFERENCES OUTPUT FOR THE TAR_LIST.PAS SOURCE FILE
$ !          - ADDED CODE TO STRIP QUOTES OFF OF THE FILE-LIST PARAMETER
$ !            FROM COMMAND LINE FOR CASE-SENSITIVE FILE SELECTION.
$ !            I SUSPECT THAT I AM MISSING SOMETHING AND THAT THIS CAN BE 
$ !            DONE MUCH MORE SIMPLY THAN THIS, BUT THIS WORKED FOR ME.
$ !          - OPENING & CLOSING CURLY BRACES (I.E. PASCAL COMMENT DELIMITERS)
$ !             ARE FOLLOWED & PRECEDED BY "CMNT" AS AN AID TO ANYONE WHO
$ !             GETS THIS FILE WITH MUNGED CURLY BRACES.  I DIDN'T DO ANYTHING
$ !             FOR SQUARE BRACKETS
$ !
$ !   V)  A DIFFERENCES OUTPUT FOR THE TAR_EXTRACT.PAS SOURCE FILE
$ !          - SEE TAR_LIST NOTE ABOVE
$ !          - OPENING & CLOSING CURLY BRACES (I.E. PASCAL COMMENT DELIMITERS)
$ !             ARE FOLLOWED & PRECEDED BY "CMNT" AS AN AID TO ANYONE WHO
$ !             GETS THIS FILE WITH MUNGED CURLY BRACES.  I DIDN'T DO ANYTHING
$ !             FOR SQUARE BRACKETS
$ !
$ !  VI)  A MACRO .MAR LISTING FOR DUMY.FOR (ABOVE) FOR PEOPLE W/O A
$ !        FORTRAN COMPILER.  JUST "$ @THISMESSAGE MAR" TO CREATE THE .MAR, 
$ !               AND "$ MACRO DUMY" TO COMPILE THE .OBJ, AND ADD ",DUMY.OBJ"
$ !               TO THE LINK COMMAND P1 LIST IN BUILD_TAR.COM.
$ !
$ CREATE="CREATE"
$ EXIT="EXIT"
$ IF="IF"
$ !
$ IF "''P1'" .EQS. "MAR" THEN $ GOTO MAR
$ !
$ !=====================================================================
$ ! HERE IS THE TAR.CLD FILE THAT I DEVELOPED FOR TIM COOK'S TAR PROGRAM
$ !
$ CREATE/log TAR.CLD
define type options
  keyword append
  keyword extract
  keyword list, syntax=syntax_tar_list
  keyword write

define type maps
  keyword prefix, default
  keyword absolute
  keyword root

Define Verb TAR
  Image disk:[carcich.netware.eunuchs.tar.tar10]tar
  Parameter P1, Label = option, prompt="Option (Append,Extract,List,Write)", 
        value(required,type=options)
  Parameter P2, Label = filespec, prompt="Filespec to select for/from TAR",
        value(required,type=$file)
  Qualifier ARCHIVE, value(type=$file,default="TAR_ARCHIVE"), default
  Qualifier confirm
  Qualifier MAP_MODE, value (type=maps), default
  Qualifier OUTPUT, Value(type=$file,default="SYS$OUTPUT"), default
  qualifier scan, negatable
  qualifier full


  disallow  map_mode and option.extract

  disallow  scan and option.extract

  disallow  full and option.append
  disallow  full and option.extract
  disallow  full and option.write


Define syntax syntax_tar_list
  Image disk:[carcich.netware.eunuchs.tar.tar10]tar
  Parameter P1, Label = option, 
        value(type=options)
  Parameter P2, Label = filespec, 
        value(type=$file,default="*"), default
  Qualifier ARCHIVE, value(type=$file,default="TAR_ARCHIVE"), default
  qualifier FULL, negatable, default
  Qualifier OUTPUT, Value(type=$file,default="SYS$OUTPUT"), default
  Qualifier confirm
  Qualifier MAP_MODE, value (type=maps)
  qualifier scan, negatable

  disallow  confirm and option.list

  disallow  map_mode and option.list

  disallow  scan and option.list
$ !
$ !=====================================================================
$ !
$ CREATE/log DUMY.FOR
c
c pseudo VMS V4 RTL routines for Tim Cook's TAR package
c
c Submitted by: Brian Carcich, Galileo Project, 
c               Center for Radiophysics and Space Research,
c               Cornell University, Ithaca, NY, USA
c
c Operating System: VAX/VMS V4.? or higher (tested on VMS 4.5)
c Source Language: FORTRAN (What can I say?  I'm an engineer!)
c Memory Required: Not a lot.
c Keywords: TAR, tape, archive, UNIX, VMS Version 4
c
c CAVEAT:  THESE ROUTINES WERE WRITTEN TO SUPPORT TIM COOK'S TAR PROGRAM 
c          ONLY; NO VMS V5 MANUALS WERE CONSULTED (NO V4 MANUALS EITHER,
c          FOR THAT MATTER).  ONLY THE TAR CODE WAS EXAMINED TO MAKE MY BEST
c          GUESS AS TO WHAT THE TAR CODE WANTED THE RTLR's TO DO.
c          IN PARTICULAR LIB$CVT_FROM_INTERNAL_TIME ESSENTIALLY IGNORES ITS
c          FIRST ARGUMENT WHICH SEEMS TO BE A CONVERSION-TYPE SPECIFIER.
c          I.E. THIS LIB$CVT_FROM_INTERNAL_TIME() ONLY DOES ONE TYPE OF 
c          CONVERSION WHEN IT SEEMS THE REAL VMS V5 RTLR IS MEANT TO DO MANY.
c
c          IN ADDITION TO THESE FUNCTIONS, YOU NEED TO MODIFY TAR.PAS AS
c          FOLLOWS TO DEFINE THAT ARGUMENT (LIB$K_DELTA_SECONDS) TO PASS TO 
c          LIB$CVT_FROM_INTERNAL_TIME:
C
C FILE:  TAR.PAS
C ==============
C ...
C   FUNCTION VMS_to_UNIX_time ( ...
C      VAR ...
C         LIB$K_DELTA_SECONDS : unsigned ;    {CMNT btc fixup for vms v4 CMNT}
C
C          THE VALUE DOES NOT MATTER BECAUSE LIB$CVT_FROM_INTERNAL_TIME ONLY
C          DOES ONE TYPE OF CONVERSION.
C
C          IN GENERAL THESE ROUTINES RETURN EITHER 1 FOR SUCCESS OR 4 FOR
C          FAILURE (I KNOW I SHOULD HAVE USED SS$NORMAL FOR SUCCESS ) UNLESS 
C          THEY CAN RETURN A CODE FROM ANOTHER RLTR OR SYSTEM SERVICE.
c***********************************************************************
C FUNCTION:  LIB$CVT_VECTIM (POOR MAN'S VMS V5 RTL ROUTINE)
C PURPOSE:  CONVERT FROM VECTOR TIME (7 BY I*2) TO QUADWORD BINTIM
C APPLICATION:  FOR USE WITH TIM COOK'S TAR PACKAGE IN VMS V4.X ***ONLY***
C
        integer*4 function lib$cvt_vectim( i, j)
        IMPLICIT NONE
        integer*4 j(2)                !out:  bintim
        integer*2 i(7)                !in:  numtim
        INTEGER*4 IYEAR, IMONTH,IDAY, IHOUR, IMINUTE, ISECOND
     &                        , ICENTISECOND
        parameter ( iyear=1 )
        parameter ( imonth=2 )
        parameter ( iday=3 )
        parameter ( ihour=4 )
        parameter ( iminute=5 )
        parameter ( isecond=6 )
        parameter ( icentisecond=7 )
        character*3 mon(12) /
     &                'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',
     &                'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' /
c                              123456789012345678901234567890
C
C PROBABLY SHOULD FORCE ASCTIM NON-VOLATILE TO PRESERVE "-"'S
        character*23 asctim / 'dd-mmm-yyyy hh:mm:ss.cc' /
        integer*4 sys$bintim
c
        write( asctim( 1:2), fmt='(i2.2)') i(iday)
        write( asctim( 4:6), fmt='(a3)') mon(i(imonth))
        write( asctim( 8:11), fmt='(i4.4)') i(iyear)
        write( asctim( 13:14 ), fmt='( i2.2 )') i( ihour )
        write( asctim( 16:17 ), fmt='( i2.2 )') i( iminute )
        write( asctim( 19:20 ), fmt='( i2.2 )') i( isecond )
        write( asctim( 22:23 ), fmt='( i2.2 )') i( icentisecond )
        lib$cvt_vectim = sys$bintim( asctim, j)
        return
        end
C***********************************************************************
C FUNCTION:  LIB$SUB_TIMES (POOR MAN'S VMS V5 RTL ROUTINE)
C PURPOSE:  SUBTRACT TWO ABSOLUTE SYSTEM TIMES TO GET A DELTA SYSTEM TIME
C APPLICATION:  FOR USE WITH TIM COOK'S TAR PACKAGE IN VMS V4.X ***ONLY***
c
        integer*4 function lib$sub_times( i, j, k)
        IMPLICIT NONE
        integer*2 i21, i22, i2
        integer*2 i(4), j(4), k(4)        !INPUT T2, T1; OUTPUT (T2-T1)
        integer*4 i41, i42, i4, i4c /'00010000'x/
        equivalence ( i41, i21), ( i42, i22), ( i4, i2)
        logical*4 carry
        INTEGER*4 ICOU
D
D        character*25 timch
D        integer*2 timlen
D        INTEGER*4 SYS$ASCTIM
c***********************************************************************
d        call sys$asctim( timlen, timch, i, 0)
d        type *, timch(:timlen)
d        call sys$asctim( timlen, timch, j, 0)
d        type *, timch(:timlen)
D
        i41=0
        i42=0
        i4=0
C
C PERFORM DIGIT SUBTRACTION BASE 2**16 USING I*4'S TO PREVENT OVERFLOW AND
C SIMULATE UNSIGNED ARITHMETIC
C
        carry = .false.         !INITIALIZE CARRY FLAG CLEAR
        do icou=1,4
          i22=i(icou)           !I*2 TO I*2/I*4 EQUIVALENCE (ZEXT IS SAME)
          i21=j(icou)
          if ( carry) i42=i42-1 !ADJUST FOR CARRY OF PREVIOUS DIGIT
          i4 = i42 - i41        !HERE'S THE BEEF!
C
          if ( i4 .lt. 0) then  !CARRY:  FORCE 'DIGIT' >0; SET FLAG 
            carry = .true.
C
            i4=i4+i4c
          else                  !NO CARRY: CLEAR FLAG
            carry = .false.
          endif
C
          k(icou) =i2           !SAVE I*2 RESULT
        enddo
C
C ERROR ON NEGATIVE RESULT
        if ( carry) then
          lib$sub_times = 4
        else
C
C SET SIGN BIT ON QUADWORD OUTPUT TO INDICATE DELTA TIME
          if ( k(1) .ne. '8000'x) then
            k(1)=-k(1)
          else
            k(1)='8000'x
          endif
          k(2)=.not.k(2)
          k(3)=.not.k(3)
          k(4)=.not.k(4)
C
          lib$sub_times = 1
D
d        call sys$asctim( timlen, timch, k, 0)
d        type *, timch(:timlen)
D
        endif
        return
        end
C***********************************************************************
c FUNCTION:  LIB$CVT_FROM_INTERNAL_TIME (POOR MAN'S VMS V5 RTL ROUTINE)
c PURPOSE:  convert BINTIM to delta seconds (assume i=lib$k_delta_seconds)
C APPLICATION:  FOR USE WITH TIM COOK'S TAR PACKAGE IN VMS V4.X ***ONLY***
c
        integer*4 function LIB$CVT_FROM_INTERNAL_TIME ( i, j, kk)
        IMPLICIT NONE
        integer*2 kk(4), k(4)     !INPUT AND LOCAL DELTA QUAD TIME
        integer*4 i, j, k4(2)     !I IS IGNORED, J IS OUTPUT DELTA SECONDS
        equivalence ( k, k4)      !
        real*8 jr                 !LOCAL DELTA SECONDS, R*4 IS PROBABLY ENOUGH,
        REAL*8 scale              !                USE R*8 ANYWAY
        parameter ( scale = 1D7 )       !100ns-ticks / s
c
c INPUT delta time must look negative
c
        if ( kk(4) .ge. 0) then
          lib$cvt_from_internal_time = 4
          return
        endif
c
c convert (-) delta TWO'S COMPLEMENT QUAD to (+) delta QUAD
c
        if ( kk(1) .ne. '8000'x) then
          k(1)=-kk(1)
        else
          k(1)='8000'x
        endif
        k(2)=.not.kk(2)
        k(3)=.not.kk(3)
        k(4)=.not.kk(4)
c
c high order longword must scale to 0, calculate scaled remainder
c
        if ( DBLE( k4(2)) .gt. scale) then
          lib$cvt_from_internal_time = 4
          return
        endif
        jr = ( (2D0 **32) *k4(2)) / scale
c
c if necessary, add in scaled low-order-high/sign-bit and mask it out
c
        if ( k4(1) .lt. 0) then
          jr = ( (2D0**31) / scale ) + jr
          k4(1) = k4(1) .and. '7FFFFFFF'x
        endif
c
c add in rest of low order and convert to i*4 result
c
        j = ( k4(1) / scale) + jr
c
        lib$cvt_from_internal_time = 1
        return
        end
$ !
$ !=====================================================================
$ !
$ EXIT
$ !
$ !=====================================================================
$ !
$ ! DIFFERENCES BETWEEN TIM COOK'S TAR.PAS AND THE ONE NEEDED TO RUN
$ ! ON VMS V4:
$ !
************
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR.PASNEW;1
  492           LIB$K_DELTA_SECONDS : unsigned ;{CMNT btc fixup for vms v4 CMNT}
  493   
******
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR.PASORIG;2
  492   
************

Number of difference sections found: 1
Number of difference records found: 1

DIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]A.A;1-
    DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR.PASNEW;1-
    DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR.PASORIG;2

$ !
$ !=====================================================================
$ !
$ ! DIFFERENCES BETWEEN TIM COOK'S TAR_LIS.PAS AND THE ONE NEEDED TO 
$ ! PASS LOWERCASE FILE-SPEC LISTS TO "$ TAR LIST"
$ !
************
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR_LIST.PASNEW;6
   35           local_list_filespec : medium_string ;{CMNTbtcarcich@cornellCMNT}
   36   
******
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR_LIST.PASORIG;1
   35   
************

************
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR_LIST.PASNEW;6
   55               lfn1 : integer ;
   56   
   57            BEGIN
   58   
   59   {CMNTbtcarcich@cornellCMNT}
   60   local_list_filespec := list_filespec ;
   61   lfn1 := length( list_filespec) ;
   62   IF lfn1 > 2 THEN
   63     IF list_filespec[1] = '"' THEN
   64       IF list_filespec[lfn1] = '"' THEN
   65         local_list_filespec := substr( list_filespec, 2, lfn1-2) ;
   66   
   67               IF success (STR$MATCH_WILD (file_spec, local_list_filespec))
   68   
   69   {CMNTbtcarcich@cornell
   70               IF success (selected (file_spec, local_list_filespec))
   71   CMNT}
   72   
   73               THEN WITH header_record DO BEGIN
******
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR_LIST.PASORIG;1
   54   
   55            BEGIN
   56               IF success (STR$MATCH_WILD (file_spec, list_filespec))
   57               THEN WITH header_record DO BEGIN
************

Number of difference sections found: 2
Number of difference records found: 19

DIFFERENCES /IGNORE=()/MERGED=1-
    DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR_LIST.PASNEW;6-
    DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR_LIST.PASORIG;1

$ !
$ !=====================================================================
$ !
$ ! DIFFERENCES BETWEEN TIM COOK'S TAR_EXTRACT.PAS AND THE ONE NEEDED TO 
$ ! PASS LOWERCASE FILE-SPEC LISTS TO "$ TAR LIST"
$ !

************
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR_EXTRACT.PASNEW;1
  165          local_extract_filespec:medium_string; {CMNTbtcarcich@cornellCMNT}
  166   
  167   
******
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR_EXTRACT.PASORIG;1
  165   
************

************
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR_EXTRACT.PASNEW;1
  296   
  297   {CMNTbtcarcich@cornell
  298                  IF selected (file_spec, extract_filespec) THEN
  299   btcarcich@cornellCMNT}
  300   
  301   local_extract_filespec := extract_filespec ;
  302   IF n1 > 2 THEN 
  303     IF extract_filespec[1] = '"' THEN
  304       IF extract_filespec[n1] = '"' THEN
  305         local_extract_filespec := substr( extract_filespec, 2, (n1-2)) ;
  306   
  307                  IF selected (file_spec, local_extract_filespec) THEN
  308   
  309                     IF confirm_operation (option, file_spec,
******
File DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR_EXTRACT.PASORIG;1
  294                  IF selected (file_spec, extract_filespec) THEN
  295                     IF confirm_operation (option, file_spec,
************

Number of difference sections found: 2
Number of difference records found: 15

DIFFERENCES /IGNORE=()/MERGED=1-
    DISK:[CARCICH.NETWARE.EUNUCHS.TAR.DISTR]TAR_EXTRACT.PASNEW;1-
    DISK:[CARCICH.NETWARE.EUNUCHS.TAR.TAR10]TAR_EXTRACT.PASORIG;1
$ !
$ !=====================================================================
$ !
$ ! here is the macro source for the pseudo-vms-v5 runtime library routines
$ !
$ ! although I have set this up as a CREATE from sys$input, an $EXIT above
$ ! means you will never get here unless you "$ @THISMESSAGE MAR"
$ !
$ ! to make the .exe truly shareable-image-independent, you may have to replace
$ ! the for$ calls with transfer vector calls.  here are the ones that worked
$ ! for me on vms v4.5:  
$ !
$ !     CALLS   #2, FOR$WRITE_IF  replaced with  calls   #2, lib_out_item+^x7fb
$ !     CALLS   #1, FOR$IO_W_R    replaced with  CALLS   #1, lib_out_item+^x7ef
$ !     CALLS   #0, FOR$IO_END    replaced with  CALLS   #0, lib_out_item+^x7f7
$ !     CALLS   #1, FOR$IO_T_DS   replaced with  CALLS   #0, lib_out_item+^x7f3
$ !
$ ! I think just relinking from .obj files or recompiling and relinking from 
$ ! source should be sufficient for moving tar between versions of vms.
$ !
$ ! here are the types of warnings you get when linking the .obj from this 
$ ! dumy.mar.  the SHRSYMREF occurred about 20 times, the TRUNC and TRUNCDAT
$ ! about 5 times.
$ !
$ !  %LINK-W-SHRSYMREF, reference to symbol FOR$IO_END is not position 
$ !                                                                 independent
$ !          in psect $CODE1 offset %X000001D7
$ !          in module LIB$CVT_FROM_INTERNAL_TIME file dumy.obj
$ !
$ !  %LINK-W-TRUNC, truncation error in psect $CODE2 offset %X000000B3
$ !          in module LIB$CVT_FROM_INTERNAL_TIME file dumy.obj
$ !
$ !  -LINK-W-TRUNCDAT, computed value is %X0000BFAC
$ !          value written is %XFFFFBFAC at location %X0000C05F
$ !
$MAR:
$ create/log dumy.mar
$DECK
;
; pseudo VMS V4 RTL routines for Tim Cook's TAR package
;
; Submitted by: Brian Carcich, Galileo Project, 
;               Center for Radiophysics and Space Research,
;               Cornell University, Ithaca, NY, USA
;
; Operating System: VAX/VMS V4.? or higher (tested on VMS 4.5)
; Source Language: MACRO 
;            (actually interpreted from FORTRAN/LIST/MACHINE_CODE output)
; Memory Required: Not a lot.
; Keywords: TAR, tape, archive, UNIX, VMS Version 4
;
; CAVEAT:  THESE ROUTINES WERE WRITTEN TO SUPPORT TIM COOK'S TAR PROGRAM 
;          ONLY; NO VMS V5 MANUALS WERE CONSULTED (NO V4 MANUALS EITHER,
;          FOR THAT MATTER).  ONLY THE TAR CODE WAS EXAMINED TO MAKE MY BEST
;          GUESS AS TO WHAT THE TAR CODE WANTED THE RTLR's TO DO.
;          IN PARTICULAR LIB$CVT_FROM_INTERNAL_TIME ESSENTIALLY IGNORES ITS
;          FIRST ARGUMENT WHICH SEEMS TO BE A CONVERSION-TYPE SPECIFIER.
;          I.E. THIS LIB$CVT_FROM_INTERNAL_TIME() ONLY DOES ONE TYPE OF 
;          CONVERSION WHEN IT SEEMS THE REAL VMS V5 RTLR IS MEANT TO DO MANY.
;
;          IN ADDITION TO THESE FUNCTIONS, YOU NEED TO MODIFY TAR.PAS AS
;          FOLLOWS TO DEFINE THAT ARGUMENT (LIB$K_DELTA_SECONDS) TO PASS TO 
;          LIB$CVT_FROM_INTERNAL_TIME:
;
; FILE:  TAR.PAS
; ==============
; ...
;   FUNCTION VMS_to_UNIX_time ( ...
;      VAR ...
;         LIB$K_DELTA_SECONDS : unsigned ;     {CMNT btc fixup for vms v4 CMNT}
;
;          THE VALUE DOES NOT MATTER BECAUSE LIB$CVT_FROM_INTERNAL_TIME ONLY
;          DOES ONE TYPE OF CONVERSION.
;
;          IN GENERAL THESE ROUTINES RETURN EITHER 1 FOR SUCCESS OR 4 FOR
;          FAILURE (I KNOW I SHOULD HAVE USED SS$NORMAL FOR SUCCESS ) UNLESS 
;          THEY CAN RETURN A CODE FROM ANOTHER RLTR OR SYSTEM SERVICE.
;***********************************************************************
; FUNCTION:  LIB$CVT_VECTIM (POOR MAN'S VMS V5 RTL ROUTINE)
; PURPOSE:  CONVERT FROM VECTOR TIME (7 BY I*2) TO QUADWORD BINTIM
; APPLICATION:  FOR USE WITH TIM COOK'S TAR PACKAGE IN VMS V4.X ***ONLY***
;
	.TITLE	LIB$CVT_VECTIM

	.PSECT	$pdata,PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG
lib1l$1:
	.BYTE	^X1B,^X02,^X02,^X04
lib1l$2:
	.BYTE	^X15,^X03,^X04
lib1l$3:
	.BYTE	^X1B,^X04,^X04,^X04
lib1l$4:
	.BYTE	^X1B,^X02,^X02,^X04

;	.PSECT	$pdata1,PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG
ilib1 = ^x04
jlib1 = ^x08

	.PSECT	$local1,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG
$local1:
MON:
	.BYTE	^X4A,^X41,^X4E
	.BYTE	^X46,^X45,^X42
	.BYTE	^X4D,^X41,^X52
	.BYTE	^X41,^X50,^X52
	.BYTE	^X4D,^X41,^X59
	.BYTE	^X4A,^X55,^X4E
	.BYTE	^X4A,^X55,^X4C
	.BYTE	^X41,^X55,^X47
	.BYTE	^X53,^X45,^X50
	.BYTE	^X4F,^X43,^X54
	.BYTE	^X4E,^X4F,^X56
	.BYTE	^X44,^X45,^X43
ASCTIM:
	.BYTE	^X64,^X64,^X2D,^X6D,^X6D,^X6D,^X2D,^X79
	.BYTE	^X79,^X79,^X79,^X20,^X68,^X68,^X3A,^X6D
	.BYTE	^X6D,^X3A,^X73,^X73,^X2E,^X63,^X63

	.BYTE	^x0,^x0,^x0,^x0,^x0		;FILLER

	.LONG	^X04070002
	.LONG	^X00000000
	.LONG	^X01200000,^X0000000E
	.LONG	^X00000000
	.LONG	^X04080004
	.LONG	^X00000000
	.LONG	^X01200000,^X00000008
	.LONG	^X00000000
	.LONG	^X010E0017
	.ADDRESS	ASCTIM
	.LONG	^X010E0000
	.LONG	^X00000000
	.LONG	^X010E0000
	.LONG	^X00000000
	.LONG	^X00000002
	.ADDRESS	$local1+^X68
	.LONG	^X00000000

	.PSECT	$code1,PIC,CON, REL ,LCL   ,SHR   ,EXE   ,RD ,NOWRT ,LONG

							    ; 0034
;LIB$CVT_VECTIM::
	.entry	lib$cvt_vectim,^M<IV,R3,R11>
	MOVAL	$local1+^X40, R11
	MOVL	b^Ilib1(ap), ^X4(R11)
	SUBL3	#2, b^Ilib1(ap), ^X10(R11)
	MOVL	b^Jlib1(ap), ^X18(R11)
	SUBL3	#4, b^Jlib1(ap), ^X24(R11)
							    ; 0056
	PUSHAL	lib1l$1
	INDEX	#1, #1, #2, #1, #0, R0
	DECL	R0
	SUBL3	R0, #2, R1
	MOVAW	@^X10(R11), R3
	MOVW	R1, ^X30(R11)
	MOVAB	ASCTIM-$local1-^x40(R11)[R0], ^X34(R11)
	PUSHAB	^X30(R11)
	CALLS	#2, FOR$WRITE_IF
	PUSHAW	6(R3)
	CALLS	#1, FOR$IO_W_R
	CALLS	#0, FOR$IO_END
							    ; 0057
	PUSHAL	lib1l$2
	INDEX	#4, #1, #6, #1, #0, R0
	DECL	R0
	SUBL3	R0, #6, R1
	MOVW	R1, ^X30(R11)
	MOVAB	ASCTIM-$local1-^x40(R11)[R0], ^X34(R11)
	PUSHAB	^X30(R11)
	CALLS	#2, FOR$WRITE_IF
	CVTWL	4(R3), R0
	MULL2	#3, R0
	MOVW	#3, ^X38(R11)
	INDEX	R0, #3, #36, #1, #0, R0
	MOVAB	MON-3-$local1-^x40(R11)[R0], ^X3C(R11)
	PUSHAB	^X38(R11)
	CALLS	#1, FOR$IO_T_DS
	CALLS	#0, FOR$IO_END
							    ; 0058
	PUSHAL	lib1l$3
	INDEX	#8, #1, #11, #1, #0, R0
	DECL	R0
	SUBL3	R0, #11, R1
	MOVW	R1, ^X38(R11)
	MOVAB	ASCTIM-$local1-^x40(R11)[R0], ^X3C(R11)
	PUSHAB	^X38(R11)
	CALLS	#2, FOR$WRITE_IF
	PUSHAW	2(R3)
	CALLS	#1, FOR$IO_W_R
	CALLS	#0, FOR$IO_END
							    ; 0059
	PUSHAL	lib1l$4
	INDEX	#13, #1, #14, #1, #0, R0
	DECL	R0
	SUBL3	R0, #14, R1
	MOVW	R1, ^X38(R11)
	MOVAB	ASCTIM-$local1-^x40(R11)[R0], ^X3C(R11)
	PUSHAB	^X38(R11)
	CALLS	#2, FOR$WRITE_IF
	PUSHAW	8(R3)
	CALLS	#1, FOR$IO_W_R
	CALLS	#0, FOR$IO_END
							    ; 0060
	PUSHAL	lib1l$4
	INDEX	#16, #1, #17, #1, #0, R0
	DECL	R0
	SUBL3	R0, #17, R1
	MOVW	R1, ^X38(R11)
	MOVAB	ASCTIM-$local1-^x40(R11)[R0], ^X3C(R11)
	PUSHAB	^X38(R11)
	CALLS	#2, FOR$WRITE_IF
	PUSHAW	10(R3)
	CALLS	#1, FOR$IO_W_R
	CALLS	#0, FOR$IO_END
							    ; 0061
	PUSHAL	lib1l$4
	INDEX	#19, #1, #20, #1, #0, R0
	DECL	R0
	SUBL3	R0, #20, R1
	MOVW	R1, ^X38(R11)
	MOVAB	ASCTIM-$local1-^x40(R11)[R0], ^X3C(R11)
	PUSHAB	^X38(R11)
	CALLS	#2, FOR$WRITE_IF
	PUSHAW	12(R3)
	CALLS	#1, FOR$IO_W_R
	CALLS	#0, FOR$IO_END
							    ; 0062
	PUSHAL	lib1l$4
	INDEX	#22, #1, #23, #1, #0, R0
	DECL	R0
	SUBL3	R0, #23, R1
	MOVW	R1, ^X38(R11)
	MOVAB	ASCTIM-$local1-^x40(R11)[R0], ^X3C(R11)
	PUSHAB	^X38(R11)
	CALLS	#2, FOR$WRITE_IF
	PUSHAW	14(R3)
	CALLS	#1, FOR$IO_W_R
	CALLS	#0, FOR$IO_END
							    ; 0064
	MOVAL	@b^Jlib1(ap), ^X48(R11)
	CALLG	^X40(R11), SYS$BINTIM
	RET	
;	.END

;***********************************************************************
; FUNCTION:  LIB$SUB_TIMES (POOR MAN'S VMS V5 RTL ROUTINE)
; PURPOSE:  SUBTRACT TWO ABSOLUTE SYSTEM TIMES TO GET A DELTA SYSTEM TIME
; APPLICATION:  FOR USE WITH TIM COOK'S TAR PACKAGE IN VMS V4.X ***ONLY***
;
	.TITLE	LIB$SUB_TIMES

;	.PSECT	$pdata2,PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG
ilib2 = ^x04
jlib2 = ^x08
klib2 = ^x0c

	.PSECT	$local2,PIC ,CON ,REL ,LCL ,NOSHR ,NOEXE   ,RD   ,WRT ,LONG
$local2:
I2:
I4:
	.long	^x0
I22:
I42:
	.long	^x0
I21:
I41:
	.long	^x0

	.LONG	^X0		;FILLER

I4C:
	.LONG	^X00010000

	.LONG	^X04070002
	.LONG	^X00000000
	.LONG	^X01200000,^X00000008
	.LONG	^X00000000
	.LONG	^X04070002
	.LONG	^X00000000
	.LONG	^X01200000,^X00000008
	.LONG	^X00000000
	.LONG	^X04070002
	.LONG	^X00000000
	.LONG	^X01200000,^X00000008
	.LONG	^X00000000

	.PSECT	$code2  ,PIC ,CON ,REL ,LCL   ,SHR   ,EXE   ,RD ,NOWRT ,LONG

							    ; 0006
;LIB$SUB_TIMES::
	.entry	lib$sub_times,^M<IV,R2,R3,R4,R5,R11>
	MOVAL	$local2+^X10, R11
	MOVL	b^Ilib2(ap), ^X08(R11)
	SUBL3	#2, b^Ilib2(ap), ^X14(R11)
	MOVL	b^Jlib2(ap), ^X1C(R11)
	SUBL3	#2, b^Jlib2(ap), ^X28(R11)
	MOVL	b^Klib2(ap), ^X30(R11)
	SUBL3	#2, b^Klib2(ap), ^X3C(R11)
	MOVL	I4C-$local2-^x10(R11), R0
							    ; 0024
	CLRL	I41-$local2-^x10(R11)
							    ; 0025
	CLRL	I42-$local2-^x10(R11)
							    ; 0026
	CLRL	I4-$local2-^x10(R11)
							    ; 0031
	CLRL	R1
							    ; 0032
	MOVL	#1, R2
	MOVAW	@^X3C(R11), R3
	MOVAW	@^X28(R11), R4
	MOVAW	@^X14(R11), R5
	NOP
lib2l$1:
							    ; 0033
	INDEX	R2, #1, #4, #1, #0, R2
	MOVW	(R5)[R2], I22-$local2-^x10(R11)
							    ; 0034
	INDEX	R2, #1, #4, #1, #0, R2
	MOVW	(R4)[R2], I21-$local2-^x10(R11)
							    ; 0035
	BLBC	R1, lib2l$2
	DECL	I42-$local2-^x10(R11)
lib2l$2:
							    ; 0036
	SUBL3	I41-$local2-^x10(R11), I42-$local2-^x10(r11), I4-$local2-^x10(r11)
							    ; 0038
	BGEQ	lib2l$3
							    ; 0039
	MNEGL	#1, R1
							    ; 0041
	ADDL2	R0, I4-$local2-^x10(r11)
							    ; 0042
	BRB	lib2l$4
lib2l$3:
							    ; 0043
	CLRL	R1
							    ; 0044
lib2l$4:
							    ; 0046
	INDEX	R2, #1, #4, #1, #0, R2
	MOVW	I2-$local2-^x10(r11), (R3)[R2]
							    ; 0047
	AOBLEQ	#4, R2, lib2l$1
							    ; 0050
	BLBC	R1, lib2l$5
							    ; 0051
	MOVL	#4, LIB$SUB_TIMES(r11)
							    ; 0052
	BRB	lib2l$8
	NOP
lib2l$5:
							    ; 0055
	CMPW	2(R3), #32768
	BEQL	lib2l$6
							    ; 0056
	MNEGW	2(R3), 2(R3)
							    ; 0057
	BRB	lib2l$7
	NOP
lib2l$6:
							    ; 0058
	MOVW	#32768, 2(R3)
							    ; 0059
lib2l$7:
							    ; 0060
	MCOMW	4(R3), 4(R3)
							    ; 0061
	MCOMW	6(R3), 6(R3)
							    ; 0062
	MCOMW	8(R3), 8(R3)
							    ; 0064
	MOVL	#1, LIB$SUB_TIMES(r11)
							    ; 0069
lib2l$8:
							    ; 0070
	MOVL	R0, I4C-$local2-^x10(r11)
	MOVL	LIB$SUB_TIMES(r11), R0
	RET	
;	.END

;***********************************************************************
; FUNCTION:  LIB$CVT_FROM_INTERNAL_TIME (POOR MAN'S VMS V5 RTL ROUTINE)
; PURPOSE:  convert BINTIM to delta seconds (assume i=lib$k_delta_seconds)
; APPLICATION:  FOR USE WITH TIM COOK'S TAR PACKAGE IN VMS V4.X ***ONLY***
;
	.TITLE	LIB$CVT_FROM_INTERNAL_TIME

;	.PSECT	$pdata3,PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG
ilib3 = ^x04
jlib3 = ^x08
kklib3 = ^x0c

	.PSECT	$local3, PIC ,CON ,REL ,LCL ,NOSHR ,NOEXE   ,RD   ,WRT ,LONG
$local3:
K4:
K:
	.LONG	^X0, ^x0, ^x0

	.LONG	^X04070002
	.LONG	^X00000000
	.LONG	^X01200000,^X00000008
	.LONG	^X00000000

	.PSECT	$code3, PIC ,CON ,REL ,LCL   ,SHR   ,EXE   ,RD ,NOWRT ,LONG

							    ; 0006
;LIB$CVT_FROM_INTERNAL_TIME::
	.entry	lib$cvt_from_internal_time,^M<IV,R2,R3,R4,R11>
	MOVAL	$local3+^XC, R11
	MOVL	b^KKlib3(ap), ^X04(R11)
	SUBL3	#2, b^KKlib3(ap), ^X10(R11)
							    ; 0017
	MOVAW	@^X10(R11), R1
	TSTW	8(R1)
	BLSS	lib3$l1
							    ; 0019
	MOVL	#4, R0
	RET	
							    ; 0020
	NOP
	NOP
	NOP
lib3$l1:
							    ; 0024
	CMPW	2(R1), #32768
	BEQL	lib3$l2
							    ; 0025
	MNEGW	2(R1), K-$local3-^xc(r11)
							    ; 0026
	BRB	lib3$l3
	NOP
lib3$l2:
							    ; 0027
	MOVW	#32768, K-$local3-^xc(r11)
							    ; 0028
lib3$l3:
							    ; 0029
	MCOMW	4(R1), K+2-$local3-^xc(r11)
							    ; 0030
	MCOMW	6(R1), K+4-$local3-^xc(r11)
							    ; 0031
	MCOMW	8(R1), K+6-$local3-^xc(r11)
							    ; 0035
	CVTLD	K4+4-$local3-^xc(r11), R1
	CMPD	R1, #^X96804C18
	BLEQ	lib3$l4
							    ; 0037
	MOVL	#4, R0
	RET	
							    ; 0038
	NOP
	NOP
lib3$l4:
							    ; 0039
	MULD2	#^X5080, R1
	DIVD2	#^X96804C18, R1
							    ; 0043
	TSTL	K4-$local3-^xc(r11)
	BGEQ	lib3$l5
							    ; 0044
	ADDD2	#^X7A43D5E5BF944456, R1
							    ; 0045
	BICL2	#^X80000000, K4-$local3-^xc(r11)
							    ; 0046
lib3$l5:
							    ; 0050
	CVTLD	K4-$local3-^xc(r11), R3
	DIVD2	#^X96804C18, R3
	ADDD2	R1, R3
	CVTDL	R3, @b^Jlib3(ap)
							    ; 0053
	MOVL	#1, R0
	RET	
	.END
$EOD
$ !
