20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 1 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0001 SUBROUTINE ADDA_SLEEP( OPTION, ISETEFN, IDV ) 0002 C 0003 C ************************************************************************** 0004 C ** PROGRAM AUTHOR: WILLIAM BAKER 0005 C 0006 C ** PROGRAM DESCRIPTION: PLACES PROGRAM IN WAIT STATE TILL READY TO START. 0007 C ** PROGRAM STARTS UPON EVENT FLAG BEING SET. 0008 C 0009 C ** SLEEP 0010 C ----------------------- 0011 C 0012 C ** DECLARE LOCAL VARIABLES NEEDED BY PROGRAM 0013 C 0014 CHARACTER*11 ADDA_START 0015 C 0016 INTEGER*2 AD_CHAN 0017 INTEGER*4 OPTION, AD_LUN, STATUS, ISETEFN, IEFN, CEFN, EFN_MASK 0018 C 0019 C ** DECLARE SYSTEM SERVICE FUNCTIONS AS BEING INTEGER FUNCTIONS. 0020 C 0021 INTEGER*4 SYS$CREMBX, SYS$DELMBX, SYS$DASSGN, SYS$SETEF 0022 INTEGER*4 SYS$ASCEFC, SYS$DACEFC, SYS$READEF, SYS$CLREF 0023 C 0024 C ** DECLARE PARAMETERS FOR DETERMINING IF EVENT FLAG WAS SET. 0025 C 0026 PARAMETER SS$_WASCLR = '00000001'X 0027 PARAMETER SS$_WASSET = '00000009'X 0028 C 0029 C ** DEFINE EVENT FLAG WE ARE WAITING FOR. 0030 C 0031 IEFN = 80 + IDV - 1 0032 C 0033 C ** READ EVENT FLAG CURRENT STATE. 0034 C 0035 STATUS = SYS$READEF( %VAL(IEFN), EFN_MASK ) 0036 ISETEFN = STATUS 0037 C 0038 C ** CHECK IF EVENT FLAG IS CLEAR. 0039 C 0040 IF (STATUS .EQ. SS$_WASCLR) THEN 0041 C 0042 C ** IF CLEAR, THEN RETURNING TO CALLING PROGRAM. 0043 C 0044 RETURN 0045 C 0046 C ** IF NOT CLEAR, AND NOT SET, THEN CHECKING STATUS OF EVENT FLAG READ. 0047 C 0048 ELSE IF (STATUS .NE. SS$_WASSET) THEN 0049 CALL LIB$SIGNAL(%VAL(STATUS)) 0050 ENDIF 0051 C 0052 C ** CLEAR THE EVENT FLAG. 0053 C 0054 STATUS = SYS$CLREF( %VAL(IEFN) ) 0055 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0056 C 0057 C ** DEFINE THE MAILBOX USED BY THE DEVICE BEING CONTROLLED. ADDA_SLEEP 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 2 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0058 C 0059 IF (IDV .EQ. 1) THEN 0060 ADDA_START = 'ADDA_START1' 0061 ELSE IF (IDV .EQ. 2) THEN 0062 ADDA_START = 'ADDA_START2' 0063 ENDIF 0064 C 0065 C ** CREATE LINK TO MAILBOX. 0066 C 0067 STATUS = SYS$CREMBX( %VAL(1), AD_CHAN, , , , , ADDA_START ) 0068 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0069 C 0070 C ** DEFINE THE MAILBOX'S LOGICAL UNIT NUMBER. 0071 C 0072 AD_LUN = 100 + IDV - 1 0073 C 0074 C ** OPEN LINK TO MAILBOX. 0075 C 0076 OPEN( UNIT = AD_LUN, FILE=ADDA_START, 0077 & CARRIAGECONTROL = 'LIST', STATUS = 'NEW' ) 0078 C 0079 C ** SET EVENT FLAG. TELL PROGRAM THAT SET EVENT FLAG, WE'RE READY TO READ 0080 C ** TO READ THE DATA TO BE PASSED TO THIS PROGRAM. 0081 C 0082 IEFN = 81 + IDV + 1 0083 STATUS = SYS$SETEF( %VAL(IEFN) ) 0084 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0085 C 0086 TYPE *, 'OPEN CHANNEL ON MAILBOX (SLEEP), READY TO READ COMMAND...' 0087 C 0088 C ** READ INFORMATION IN MAILBOX. 0089 C 0090 READ(AD_LUN,50) OPTION 0091 50 FORMAT(I1) 0092 C 0093 TYPE *, 'MAILBOX (SLEEP) READ, VALUE = ',OPTION 0094 C 0095 C ** CLOSE THE MAILBOX. 0096 C 0097 CLOSE(UNIT=AD_LUN) 0098 C 0099 C ** DELETE THE MAILBOX. 0100 C 0101 STATUS = SYS$DELMBX( %VAL(AD_CHAN) ) 0102 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0103 C 0104 C ** DEASSIGN CHANNEL TO MAILBOX. 0105 C 0106 STATUS = SYS$DASSGN( %VAL(AD_CHAN) ) 0107 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0108 C 0109 C ** CLEAR EVENT FLAG USED TO TRIGGER ROUTINE. 0110 C 0111 STATUS = SYS$CLREF( %VAL(IEFN) ) 0112 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0113 C 0114 RETURN ADDA_SLEEP 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 3 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0115 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 449 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 112 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 252 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 813 ENTRY POINTS Address Type Name 0-00000000 ADDA_SLEEP VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000000 CHAR ADDA_START 2-0000000C I*2 AD_CHAN 2-00000010 I*4 AD_LUN 2-0000001C I*4 CEFN 2-00000020 I*4 EFN_MASK AP-0000000C@ I*4 IDV 2-00000018 I*4 IEFN AP-00000008@ I*4 ISETEFN AP-00000004@ I*4 OPTION 2-00000014 I*4 STATUS 2-00000024 I*4 SYS$ASCEFC 2-00000028 I*4 SYS$DACEFC LABELS Address Label 1-00000057 50' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name FOR$CLOSE FOR$OPEN LIB$SIGNAL I*4 SYS$CLREF I*4 SYS$CREMBX I*4 SYS$DASSGN I*4 SYS$DELMBX I*4 SYS$READEF I*4 SYS$SETEF 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 4 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0002 SUBROUTINE FILE_DATA( DEVICE, AD_DEV, PRV_PNTR, OPTION ) 0003 C 0004 C ************************************************************************** 0005 C ** PROGRAM AUTHOR: WILLIAM BAKER 0006 C 0007 C ** PROGRAM DESCRIPTION: TELLS FILE MANAGER PROGRAM TO COPY AND SAVE DATA. 0008 C ** 0009 C 0010 C ** FILE_DATA 0011 C ----------------------- 0012 C 0013 C ** DECLARES LOCAL VARIABLES NEEDED BY PROGRAM. 0014 C 0015 INTEGER*4 OPTION, AD_LUN, STATUS, AD_DEV, PRV_PNTR, IEFN, CEFN 0016 CHARACTER ADDA_FILE*10, DEVICE*4 0017 C 0018 C ** MAKES SYSTEM SERVICE FUNCTIONS INTEGERS. 0019 C 0020 INTEGER*4 SYS$WAITFR, SYS$CLREF, SYS$ASCEFC, SYS$DACEFC 0021 C 0022 C ** DECLARES EVENT FLAG CLUSTER TO BE USED. 0023 C 0024 CEFN = 96 0025 C 0026 C ** DECLARES EVENT FLAG TO BE SET WITHIN THE CLUSTER. 0027 C 0028 IEFN = 110 + AD_DEV - 1 0029 C 0030 C ** DECLARES THE LOGICAL UNIT NUMBER USED TO PASS DATA VIA MAILBOX. 0031 C 0032 AD_LUN = 90 + AD_DEV - 1 0033 C 0034 C ** DECLARES NAME OF MAILBOX TO BE USED. 0035 C 0036 ADDA_FILE = DEVICE//'_FILER' 0037 C 0038 C ** OPENS THE MAILBOX FOR WRITE. 0039 C 0040 OPEN( UNIT = AD_LUN, FILE=ADDA_FILE, 0041 & CARRIAGECONTROL = 'LIST', STATUS = 'OLD' ) 0042 C 0043 C ** WRITES DATA TO MAILBOX. 0044 C 0045 WRITE(AD_LUN,50) PRV_PNTR, OPTION 0046 50 FORMAT(2I2) 0047 C 0048 C ** CLOSES MAILBOX LINK. 0049 C 0050 CLOSE(UNIT=AD_LUN) 0051 C 0052 C ** ASSOCIATES WITH EVENT FLAG CLUSTER 0053 C 0054 STATUS = SYS$ASCEFC( %VAL(CEFN), 'ADDA_FINISH', , ) 0055 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0056 C 0057 C ** WAITS FOR EVENT FLAG TO BE SET BY THE FILER. FILE_DATA 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 5 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0058 C 0059 STATUS = SYS$WAITFR( %VAL(IEFN) ) 0060 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0061 C 0062 C ** DISASSOCIATES FROM CLUSTER. 0063 C 0064 STATUS = SYS$DACEFC( %VAL(CEFN) ) 0065 IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 0066 C 0067 RETURN 0068 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 229 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 23 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 160 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 412 ENTRY POINTS Address Type Name 0-00000000 FILE_DATA VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000000 CHAR ADDA_FILE AP-00000008@ I*4 AD_DEV 2-0000000C I*4 AD_LUN 2-00000018 I*4 CEFN AP-00000004@ CHAR DEVICE 2-00000014 I*4 IEFN AP-00000010@ I*4 OPTION AP-0000000C@ I*4 PRV_PNTR 2-00000010 I*4 STATUS 2-0000001C I*4 SYS$CLREF LABELS Address Label 1-0000000C 50' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name Type Name Type Name Type Name FOR$CLOSE FOR$OPEN LIB$SIGNAL I*4 SYS$ASCEFC I*4 SYS$DACEFC I*4 SYS$WAITFR 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 6 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0002 SUBROUTINE WAITABIT( SECS ) 0003 C 0004 C ************************************************************************** 0005 C ** PROGRAM AUTHOR: WILLIAM BAKER 0006 C 0007 C ** PROGRAM DESCRIPTION: TELLS PROGRAM TO WAIT SOME PRE-DETERMINED PERIOD 0008 C ** OF TIME, THEN WAKE UP AND CONTINUE OPERATION. 0009 C 0010 C ** WAITABIT 0011 C ----------------------- 0012 C 0013 C ** DECLARES LOCAL VARIABLES NEEDED BY PROGRAM. 0014 C 0015 REAL*4 SECS, RSEC 0016 INTEGER*4 STATUS_H, DELTA(2), TIMER_EF 0017 CHARACTER SECONDS*5, MINUTE*2 0018 C 0019 C ** MOVES PASSED VALUE INTO LOCAL VARIABLE. 0020 C 0021 RSEC = SECS 0022 C 0023 C ** BEGINS PARSING NUMBER OF SECONDS INTO A CHARACTER STRING. 0024 C 0025 IF (RSEC .LT. 1.0) THEN 0026 C 0027 C ** ENCODES THE STRING FOR LESS THAN 1 SECOND WAIT INTERVAL. 0028 C 0029 ENCODE(4,8000,SECONDS) RSEC 0030 8000 FORMAT(F4.2) 0031 C 0032 C ** CONVERTS TIME STRING INTO A BINARY TIME NUMBER. 0033 C 0034 STATUS_H = SYS$BINTIM('0 00:00:'//SECONDS,DELTA) 0035 ELSE IF (RSEC .LT. 60.0) THEN 0036 C 0037 C ** ENCODES THE STRING FOR LESS THAN 1 MINUTE WAIT INTERVAL. 0038 C 0039 ENCODE(5,8010,SECONDS) RSEC 0040 8010 FORMAT(F5.2) 0041 C 0042 C ** CONVERTS TIME STRING INTO A BINARY TIME NUMBER. 0043 C 0044 STATUS_H = SYS$BINTIM('0 00:00:'//SECONDS,DELTA) 0045 ELSE 0046 C 0047 C ** IF INTERVAL MORE THAN A MINUTE, WE WORK OUT MINUTES, THEN SECONDS. 0048 C 0049 IMINUTE = RSEC/60 0050 RSEC = RSEC - (IMINUTE * 60.0) 0051 C 0052 C ** ENCODE THE NUMBER OF SECONDS. 0053 C 0054 ENCODE(5,8020,SECONDS) RSEC 0055 8020 FORMAT(F5.2) 0056 C 0057 C ** ENCODE THE NUMBER OF MINUTES. WAITABIT 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 7 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0058 C 0059 ENCODE(2,8030,MINUTE) IMINUTE 0060 8030 FORMAT(I2) 0061 C 0062 C ** CONVERTS TIME STRING TO BINARY TIME NUMBER. 0063 C 0064 STATUS_H = SYS$BINTIM('0 00:'//MINUTE//':'//SECONDS,DELTA) 0065 ENDIF 0066 C 0067 C ** TELLS PROGRAM TO MAKE TIME NUMBER A DELTA TIME INTERVAL. 0068 C 0069 DELTA(1) = - DELTA(1) 0070 DELTA(2) = - DELTA(2) 0071 C 0072 C ** TELLS SYSTEM TO SET EVENT FLAG AFTER A DELTA TIME INTERVAL. 0073 C 0074 STATUS_H = SYS$SETIMR(%VAL(TIMER_EF),DELTA,,) 0075 C 0076 C ** WAITS FOR EVENT FLAG TO BE SET BY SYSTEM. 0077 C 0078 STATUS_H = SYS$WAITFR(%VAL(TIMER_EF)) 0079 C 0080 RETURN 0081 END PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 377 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 20 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 120 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 517 ENTRY POINTS Address Type Name 0-00000000 WAITABIT VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-0000001C I*4 IMINUTE 2-0000000D CHAR MINUTE 2-00000010 R*4 RSEC 2-00000008 CHAR SECONDS AP-00000004@ R*4 SECS 2-00000014 I*4 STATUS_H 2-00000018 I*4 TIMER_EF WAITABIT 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 8 01 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 ARRAYS Address Type Name Bytes Dimensions 2-00000000 I*4 DELTA 8 (2) LABELS Address Label Address Label Address Label Address Label 1-00000000 8000' 1-00000004 8010' 1-00000008 8020' 1-0000000C 8030' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name R*4 SYS$BINTIM R*4 SYS$SETIMR R*4 SYS$WAITFR 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 9 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 0002 SUBROUTINE WAITFLAG( IDV ) 0003 C 0004 C 0005 C ************************************************************************** 0006 C ** PROGRAM AUTHOR: WILLIAM BAKER 0007 C 0008 C ** PROGRAM DESCRIPTION: TELLS PROGRAM TO WAIT TILL AN EVENT FLAG IS SET. 0009 C 0010 C ** WAITFLAG: 0011 C ----------------------- 0012 C 0013 C ** DECLARES LOCAL VARIABLES NEEDED BY PROGRAM. 0014 C 0015 INTEGER*4 STATUS_W, IDV, IEFN, SYS$WAITFR, CEFN 0016 INTEGER*4 SYS$ASCEFC, SYS$DACEFC, SYS$CLREF 0017 C 0018 C ** DEFINES AN EVENT FLAG TO WAIT FOR BASED UPON DEVICE NUMBER. 0019 C 0020 IEFN = 70 + IDV - 1 0021 C 0022 C ** WAIT FOR THE EVENT FLAG TO BE SET BY ANOTHER ROUTINE. 0023 C 0024 STATUS_W = SYS$WAITFR( %VAL(IEFN) ) 0025 IF (.NOT. STATUS_W) CALL LIB$SIGNAL( %VAL( STATUS_W )) 0026 C 0027 C ** CLEAR THE EVENT FLAG SET. 0028 C 0029 C STATUS_W = SYS$CLREF( %VAL(IEFN) ) 0030 C IF (.NOT. STATUS_W) CALL LIB$SIGNAL( %VAL( STATUS_W )) 0031 C 0032 RETURN 0033 END WAITFLAG 20-Nov-1990 18:07:27 VAX FORTRAN V5.4-79 Page 10 01 4-Jun-1990 09:40:01 LIB4:[ADDASYS.SOURCE]ADDA_MBXS.FOR;5 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 51 PIC CON REL LCL SHR EXE RD NOWRT LONG 2 $LOCAL 40 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 91 ENTRY POINTS Address Type Name 0-00000000 WAITFLAG VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000008 I*4 CEFN AP-00000004@ I*4 IDV 2-00000004 I*4 IEFN 2-00000000 I*4 STATUS_W 2-0000000C I*4 SYS$ASCEFC 2-00000014 I*4 SYS$CLREF 2-00000010 I*4 SYS$DACEFC FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name LIB$SIGNAL I*4 SYS$WAITFR COMMAND QUALIFIERS FOR/LIS/NOOPT/EXTEND ADDA_MBXS /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /EXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /NOOPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=LIB4:[ADDASYS.SOURCE]ADDA_MBXS.LIS;22 /OBJECT=LIB4:[ADDASYS.SOURCE]ADDA_MBXS.OBJ;1 COMPILATION STATISTICS Run Time: 4.18 seconds Elapsed Time: 5.88 seconds Page Faults: 731 Dynamic Memory: 504 pages