
                               					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   1
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

0001    !
0002    !			  COPYRIGHT (c) 1982 BY
0003    !	      MOSTEK CORPORATION, CARROLLTON TX
0004    !
0005    ! This software is furnished under a license and may be used and  copied
0006    ! only  in  accordance  with  the  terms  of  such  license and with the
0007    ! inclusion of the above copyright notice.  This software or  any  other
0008    ! copies  thereof may not be provided or otherwise made available to any
0009    ! other person.  No title to and ownership of  the  software  is  hereby
0010    ! transferred.
0011    !
0012    ! The information in this software is subject to change  without  notice
0013    ! and  should  not  be  construed  as  a commitment by MOSTEK
0014    ! CORPORATION.
0015    !
0016    ! MOSTEK assumes no responsibility for the use or  reliability  of  its
0017    ! software on equipment which is not supplied by MOSTEK.
0018    !
0019     
0020    !++
0021    ! FACILITY:
0022    !   MOSTEK CORPORATION
0023    !
0024    ! ABSTRACT: SET_TIME sets the starting time for reading the stats 
0025    !           information in the RATSNEST file.
0026    !   
0027    !
0028    ! ENVIRONMENT: VAX VMS unpriv
0029    !   
0030    !
0031    ! AUTHOR: Gary Smith, CREATION DATE: 8/23/1982
0032    !
0033    ! MODIFIED BY:
0034    !
0035    !--
0036    !
0037    ! TABLE OF CONTENTS:
0038    !
0039    !
0040    ! INCLUDE FILES: statsubs.for
0041    !
0042    !
0043    ! MACROS: none
0044    !
0045    !
0046    ! EQUATED SYMBOLS: str_len (local)
0047    !                  see statsubs.for
0048    !
0049    !
0050    ! EXTERNAL REFERENCES: SYS$BINTIM
0051    !
0052     
0053    !++
0054    ! FUNCTIONAL DESCRIPTION: SET_TIME receives from its caller the pcb
0055    !                         (parse control block) and an 16 byte variable
0056    !                         that will contain the time in DEC system format 
0057    !                         after conversion by SYS$BINTIM in CHAR form.

                               					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   2
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

0058    !
0059    !
0060    !
0061    ! FORMAL PARAMETERS: pcb      -> the parse control block
0062    !                    time     -> the converted time
0063    !                    ret_code -> return code
0064    !
0065    !
0066    !
0067    ! IMPLICIT INPUTS: none
0068    !
0069    !
0070    !
0071    ! IMPLICIT OUTPUTS: none
0072    !
0073    !
0074    !
0075    ! ROUTINE VALUE and
0076    ! COMPLETION CODES: ret_code  -> 0 success
0077    !                   ret_code  -> 1 failure
0078    !
0079    !
0080    !
0081    ! SIDE EFFECTS: none to date
0082    !
0083    !
0084    !
0085    !--
0086              SUBROUTINE SET_TIME( pcb, time, ret_code )
0087     
0088              include 'statsubs.for'
0141     
0142              parameter str_len = 5  
0143     
0144              integer pcb(30)
0145              integer SYS$BINTIM, SYS$GETMSG
0146              integer status
0147              integer ret_code
0148              integer out_unit
0149              integer i_systime(2), i_mid_nite(2), i_one_day(2)
0150              integer i_yesterday(2), i_offset(2), temp
0151     
0152              character * 16  time
0153              character * 23  time_buffer
0154              character * 23  mid_nite / '-- 00:00:00.00' /
0155              character * 23  one_day  / '1 00:00:00.00' /
0156              character * 80  msg_buffer
0157              character * 132 compress
0158     
0159              real * 8 systime, bin_mid_nite, bin_one_day, bin_yesterday
0160              real * 8 offset
0161     
0162              logical batch
0163     
0164              equivalence ( i_mid_nite, bin_mid_nite )
0165              equivalence ( i_one_day, bin_one_day )
0166              equivalence ( i_yesterday, bin_yesterday )

SET_TIME                       					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   3
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

0167              equivalence ( i_systime, systime )
0168              equivalence ( i_offset, offset )
0169     
0170              external SYS$BINTIM, SS$_NORMAL, msg_invalidtime
0171              external msg_setstart, LIB$ADDX, LIB$SUBX
0172     
0173              common / io_com / in_unit, out_unit, batch
0174     
0175     
0176    !++
0177    ! set return code to nominal success and figure what to do
0178    !--
0179     
0180              ret_code = success
0181              if ( pcb(4) .eq. 5 ) then
0182                   goto ( 100, 200, 300, 400, 500 ) pcb(6)
0183     
0184    !++
0185    ! time was "START".
0186    ! Do this by closing the nest file, opening it again, and doing a sequential
0187    ! read of the first record. 
0188    !--
0189     
0190    100            continue
0191                   call read_nest( nest_close, time, ios )
0192                   call read_nest( nest_open, time, ios )
0193                   call read_nest( seq_read, time, ios )
0194                   if ( ios .ne. success ) then
0195                        call LIB$SIGNAL( msg_setstart )
0196                   end if
0197                   goto 600
0198     
0199    !++
0200    ! time was "END". Insure the end really is the end by making the end
0201    ! the absolute latest time available.
0202    !--
0203     
0204    200            continue
0205                   time = '7FFFFFFFFFFFFFFF'
0206                   goto 600
0207     
0208    !++
0209    ! time was "YESTERDAY" when all my troubles seemed so far away...
0210    !--
0211     
0212    300            continue
0213                   status = SYS$BINTIM( mid_nite, bin_mid_nite )
0214                   status = SYS$BINTIM( one_day, bin_one_day )
0215                   status = LIB$ADDX( i_mid_nite, i_one_day, i_systime )
0216                   goto 600
0217     
0218    !++
0219    ! time was today.
0220    !--
0221     
0222    400            continue
0223                   status = SYS$BINTIM( mid_nite, i_systime )

SET_TIME                       					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   4
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

0224                   goto 600
0225     
0226    !++
0227    ! time was "TOMORROW"
0228    !--
0229     
0230    500            continue
0231                   status = SYS$BINTIM( mid_nite, bin_mid_nite )
0232                   status = SYS$BINTIM( one_day, bin_one_day )
0233                   status = LIB$SUBX( i_mid_nite, i_one_day, i_systime )
0234                   goto 600
0235    !++
0236    ! if there is an expression following the special keyword, merge it
0237    ! into the time accordingly.
0238    !--
0239     
0240    600            continue
0241                   if ( pcb(7) .eq. 5 ) then
0242                      time_buffer = compress( pcb(11) )
0243                      status = SYS$BINTIM( time_buffer, offset )
0244     
0245    !++
0246    ! if all was not ok with the off set string let them know
0247    !--
0248     
0249                      if ( status .ne. %LOC(SS$_NORMAL) ) then
0250     
0251                         call LIB$SIGNAL( msg_invalidtime, %VAL(1),
0252         .                    time_buffer(1:MK$LENGTH(time_buffer)) )
0253                         ret_code = failure
0254                         return
0255     
0256                      end if
0257     
0258    !++
0259    ! off set was OK. If the keyword was START or END, convert the charcter
0260    ! representation of the key to a its binary form so that it can be added
0261    ! or subtracted with the binary form of the delta time.
0262    !--
0263     
0264                      if ( (pcb(6) .eq. 1) .or. (pcb(6) .eq. 2) ) then
0265                         decode( 16, 610, time, err=999 ) i_systime
0266    610                  format( 2Z8 )
0267     
0268    !++
0269    ! put into funny DEC format
0270    !--
0271                         temp = i_systime(2)
0272                         i_systime(2) = i_systime(1)
0273                         i_systime(1) = temp
0274                      end if
0275     
0276     
0277    !++
0278    ! at last, merge it in
0279    !--
0280     

SET_TIME                       					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   5
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

0281                      goto ( 620, 630 ) pcb(9)
0282     
0283    620               continue                    ! was a +
0284                      call LIB$SUBX( i_systime, i_offset, i_systime )
0285                      goto 700
0286     
0287    630               continue                    ! was a -
0288                      call LIB$ADDX( i_systime, i_offset, i_systime )
0289                      goto 700
0290     
0291                   end if
0292     
0293                   goto ( 900, 900, 700, 700, 700 ) pcb(6)
0294    !++
0295    ! ELSE condition of the above.
0296    ! Reconstitute the individual character of the time into a single
0297    ! string
0298    !--
0299              else
0300     
0301                   time_buffer = compress( pcb(str_len) )
0302     
0303              end if 
0304     
0305              status = SYS$BINTIM( time_buffer, systime )
0306     
0307    !++
0308    ! if all was not ok with the input string give a msg
0309    !--
0310     
0311              if ( status .ne. %LOC(SS$_NORMAL) ) then
0312     
0313                 call LIB$SIGNAL( msg_invalidtime, %VAL(1),
0314         .                        time_buffer(1:MK$LENGTH(time_buffer)) )
0315                 ret_code = failure
0316                 return
0317     
0318              end if
0319     
0320    !++
0321    ! turn the binary form of the time into a character form
0322    !--
0323     
0324    700       continue
0325              encode ( 16, 710, time, err=999 ) systime
0326    710       format ( z16 )
0327     
0328    900       continue
0329              return
0330     
0331    !++
0332    ! error trap on encode or decode
0333    !--
0334     
0335    999       continue
0336              call LIB$SIGNAL( msg_invalidtime, %VAL(1),
0337         .         time_buffer(1:MK$LENGTH(time_buffer)) )

SET_TIME                       					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   6
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

0338              ret_code = failure
0339              return
0340              end




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  649   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  36   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 504   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD
  3 IO_COM                                  12   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                 1201


ENTRY POINTS

    Address  Type  Name                                        References

  0-00000000       SET_TIME                                       86     


VARIABLES

    Address  Type  Name                            Attributes  References

  3-00000008  L*4  BATCH                           COMM          162       173     
  2-00000020  R*8  BIN_MID_NITE                         EQUIV    159       164       213A      231A    
  2-00000018  R*8  BIN_ONE_DAY                          EQUIV    159       165       214A      232A    
  2-00000010  R*8  BIN_YESTERDAY                        EQUIV    159       166     
  3-00000000  I*4  IN_UNIT                         COMM          173     

  2-000000CC  I*4  IOS                                           191A      192A      193A      194     
  2-0000003F  CHAR MID_NITE                                      154D      213A      223A      231A    
  2-0000006D  CHAR MSG_BUFFER                                    156     
  2-00000000  R*8  OFFSET                               EQUIV    160       168       243A    
  2-00000056  CHAR ONE_DAY                                       155D      214A      232A    

  3-00000004  I*4  OUT_UNIT                        COMM          148       173     
 AP-0000000C@ I*4  RET_CODE                                       86       147       180=      253=      315=      338=    
  2-000000C4  I*4  STATUS                                        146       213=      214=      215=      223=      231=    
							         232=      233=      243=      249       305=      311     
  2-000000C0  I*4  SYS$GETMSG                                    145     
  2-00000008  R*8  SYSTIME                              EQUIV    159       167       305A      325     

  2-000000C8  I*4  TEMP                                          150       271=      273     
 AP-00000008@ CHAR TIME                                           86       152       191A      192A      193A      205=    
							         265       325     
  2-00000028  CHAR TIME_BUFFER                                   153       242=      243A      251(2)A   301=      305A    
							         313(2)A   336(2)A 

SET_TIME                       					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   7
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

ARRAYS

    Address  Type  Name          Attributes        Bytes  Dimensions       References

  2-00000020  I*4  I_MID_NITE         EQUIV           8  (2)               149       164       215A      233A    
  2-00000000  I*4  I_OFFSET           EQUIV           8  (2)               150       168       284A      288A    
  2-00000018  I*4  I_ONE_DAY          EQUIV           8  (2)               149       165       215A      233A    
  2-00000008  I*4  I_SYSTIME          EQUIV           8  (2)               149       167       215A      223A      233A    
									   265=      271       272(2)=   273=      284(2)A 
									   288(2)A 
  2-00000010  I*4  I_YESTERDAY        EQUIV           8  (2)               150       166     

 AP-00000004@ I*4  PCB                              120  (30)               86       144       181       182       241     
									   242A      264(2)    281       293       301A    


PARAMETER CONSTANTS

  Type  Name                                                   References

   I*2  EOF                                                      140#    
   I*2  EQUAL                                                    115#    
   I*2  FAILURE                                                  100#      253       315       338     
   I*2  GREATER                                                  116#    
   I*2  KEYED_READ                                               106#    

   I*2  LESS                                                     114#    
   I*4  MAXINT                                                   139#    
   I*2  MAX_CAT                                                  122#    
   I*2  MAX_ENT                                                  123#    
   R*4  MINUTES_IN_DAY                                           133#    

   R*4  MINUTES_IN_HOUR                                          130#    
   I*2  NEST_CLOSE                                               108#      191     
   I*2  NEST_OPEN                                                105#      192     
   R*4  SECONDS_IN_DAY                                           132#    
   R*4  SECONDS_IN_HOUR                                          131#    

   R*4  SECONDS_IN_MINUTE                                        129#    
   I*2  SEQ_READ                                                 107#      193     
   CHAR STANDARD_HELP_LIB                                         93        94#    
   I*2  STR_LEN                                                  142#      301     
   I*2  SUCCESS                                                   99#      180       194     



LABELS

    Address   Label                                            References

  0-0000003F  100                                                182       190#    
  0-00000069  200                                                182       204#    
  0-00000074  300                                                182       212#    
  0-0000009D  400                                                182       222#    
  0-000000AC  500                                                182       230#    

  0-000000D5  600                                                197       206       216       224       234       240#    

SET_TIME                       					20-May-1983 10:26:34	VAX-11 FORTRAN V3.2-37              Page   8
								10-May-1983 10:10:42	CAD$VOLSET:[GARY.STATS.SOURCE]SETTIME.FOR;34

  1-0000000C  610'                                               265       266#    
  0-000001A6  620                                                281       283#    
  0-000001B2  630                                                281       287#    
  0-0000023B  700                                                285       289       293(3)    324#    

  1-00000011  710'                                               325       326#    
  0-00000265  900                                                293(2)    328#    
  0-00000266  999                                                265       325       335#    


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name                                                   References

   CHAR COMPRESS                                                 157       242       301     
   I*4  LIB$ADDX                                                 171       215       288     
        LIB$SIGNAL                                               195       251       313       336     
   I*4  LIB$SUBX                                                 171       233       284     
   I*4  MK$LENGTH                                                251       313       336     

        MSG_INVALIDTIME                                          170       251A      313A      336A    
        MSG_SETSTART                                             171       195A    
        READ_NEST                                                191       192       193     
        SS$_NORMAL                                               170       249       311     
   I*4  SYS$BINTIM                                               145       170       213       214       223       231     
							         232       243       305     



  +----------------------------------------------+
  |           KEY TO REFERENCE FLAGS             |
  |   =   - Value Modified                       |
  |   #   - Defining Reference                   |
  |   A   - Actual Argument, possibly modified   |
  |   D   - Data Initialization                  |
  |  (n)  - Number of occurrences on line        |
  +----------------------------------------------+



COMMAND QUALIFIERS

  FORTRAN /DEBUG/OBJECT=OBJ:SETTIME/LIST=LIS:SETTIME/CONT=99/CROSS/NOOPT SRC:SETTIME

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(SYMBOLS,TRACEBACK)
  /STANDARD=(NOSYNTAX,NOSOURCE_FORM)
  /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP)
  /F77  /NOG_FLOATING  /I4  /NOOPTIMIZE  /WARNINGS  /NOD_LINES  /CROSS_REFERENCE  /NOMACHINE_CODE  /CONTINUATIONS=99


COMPILATION STATISTICS

  Run Time:           3.12 seconds
  Elapsed Time:       8.07 seconds
  Page Faults:        501
  Dynamic Memory:     843 pages
