C+ C These subroutines are a start at making it easier to migrate between C RSX and VAX. Often RSX programs call on executive services which C are inappropriate or not otherwise applicable to our VAX. To C allow for this to hapen, one easy way is to create either dummy VAX C routines to bypass those differences, or to map the calls into appropriate C VAX routines C C- SUBROUTINE RECEIV(IDMY1,IDMY2,IDMY3,IDS) IDS=-1 ! Show recieve data failed RETURN ! END SUBROUTINE SPAWN(RTASK,IUGC,IUMC,IEFN,IAST,IESB,IPARM, - ICMLIN,ICMLEN,IUNIT,IDNAM,IDS) IDS=1 RETURN END C C --------------------------------------------------------------------- C SUBROUTINE WAIT(Itime_magnitude, Itime_unit, Ids) C+ C -- Dummy up the RSX11M CALL WAIT subroutine C C CALL WAIT (Itime_magnitude,Itime_unit [,Ids]) C C where Itime_magnitude = I*2 interval C Itime_unit = 0 -> tics (force to 100 tics/sec) C 1 -> Milliseconds C 2 -> Seconds C 3 -> Minutes C 4 -> Hours C C Ids = 1 -> Success C = -93 -> Invalid time parameter (IE.ITI) C C Event Flag 0 is used for the wait C C VMS keeps its internal timer in 100 nsec units. To initiate a C wait, a quadword containing the negative number of units to C wait is passed in the VMS service call SYS$SETIMR. This routine C requires the quadword math routines in QUADMATH.MAR. C C Written by: James G. Downward 25-Apr-82 C KMS Fusion, Inc C P.O. Box 1567 C Ann Arbor, Mich. 48104 C C- INTEGER*2 Itime_magnitude,Itime_unit,Istatus INTEGER*2 Ihundredths,Iseconds,Iminutes,Ihours INTEGER*4 Iconstant_Quad(2),Ivalue_Quad(2) INTEGER*4 Itimer(2) ! INTEGER*4 SYS$SETIMR,SYS$CLREF,SYS$WAITFR! INTEGER*4 Ists,Iefn INCLUDE 'SYS$SYSDISK:[SYSLIB]SSDEF.FOR/NOLIST' ! PARAMETER IE_ITI=-93 ! Invalid time parameters CALL ARGCNT(Number_of_Arguments) ! See if IDS is present Istatus=IE_ITI ! Assume will fail IF (Itime_unit.LT.0 .OR. ! See if valid time unit - Itime_unit.GT.4) GOTO 100! If not,exit with bad status C C -- Convert the input time into 100 nsec units C C -- First to Milliseconds C IF (Itime_unit.EQ.0) THEN ! If tics (100 tics/sec) Iconstant_quad(1) = 10 ! convert to milliseconds ELSE IF(Itime_unit.EQ.1) THEN ! If Milliseconds Iconstant_quad(1) = 1 ! convert to milliseconds ELSE IF(Itime_unit.EQ.2) THEN ! If seconds Iconstant_quad(1) = 1000 ! convert to miliseconds ELSE IF(Itime_unit.EQ.3) THEN ! If minutes Iconstant_quad(1) = 60000 ! convert to miliseconds ELSE IF(Itime_unit.EQ.4) THEN ! If Hours Iconstant_quad(1) = 1440000 ! convert to miliseconds END IF ! Iconstant_quad(2)=0 ! Be sure is always zero Ivalue_Quad(1) = Itime_magnitude ! Set magnitude in quadword Ivalue_Quad(2) = 0 ! Be sure is always zero CALL EMUL(Iconstant_quad,Ivalue_Quad,Ivalue_quad) ! cnvt to msec Iconstant_Quad(1)=10000 ! To convert to 100 nsec tics Iconstant_quad(2)= 0 ! Be sure is zero CALL EMUL(Iconstant_Quad,Ivalue_Quad,Itimer(1)) ! multiply CALL SUBQUAD(0,Itimer(1),Itimer(1)) ! Make negative Ists=SYS$CLREF(%VAL(0)) ! Clear the event flag Ists=SYS$SETIMR(%VAL(0),Itimer(1),,) ! Go set the timer IF(Ists.EQ.SS$_NORMAL) THEN ! If call to SETIMR ok then Ists=SYS$WAITFR(%VAL(0)) ! Wait until flag set IF(Ists.EQ.SS$_NORMAL) THEN ! If $NORMAL return RSX IS.SUC Istatus=Ists ! Show success (=1) END IF ! END IF ! 100 IF (Number_of_Arguments .EQ. 3) Ids = Istatus ! Xfer status of wait RETURN END C C ------------------------------------------------------------------- C SUBROUTINE GETMCR (Lbuf,Ids) C C -- Dummy up the call to GETMCR C C CALL GETMCR (LBUF [,IDS]) C C Where LBUF is an 80 byte array to receive command line C IDS is the directive status C +n Number of bytes transfered (less terminator) C but a is at the end of the buffer C -80 If no command line present (corresponds to C RSX IE.AST C C CHARACTER*84 Command LOGICAL*1 LBUF(80) CHARACTER*1 Carriage_Return INTEGER*2 Ids INTEGER*2 Iaddr(1) INTEGER*4 Istatus INTEGER*4 Outlength INTEGER*4 LIB$GET_FOREIGN EXTERNAL LIB$GET_FOREIGN DATA Carriage_Return /"15/ ! Set Carriage Return DATA IE_AST /-80/ ! Error if no command line CALL GETADR(IADDR,IDS) ! Find out if IDS present ! if not, IADDR(1) = 0 Command=' ' ! Blank fill Length=IE_AST ! Assume no command C TYPE * ,'IADDR(1)=',IADDR(1) ! ISTATUS=LIB$GET_FOREIGN(Command(5:),,Outlength) IF(Outlength.EQ.0) GOTO 10 ! No Command line, show it Command(1:4)='VAX ' ! Set in prefix Length=Outlength+4 ! The true length (incl ) IF(Length.GT.79) Length=79 ! Never can be longer Last=Length+1 ! Make last char in buf Command(Last:Last)=Carriage_Return ! Tack on a CR at buffer end 10 IF(IADDR(1).NE.0) IDS=Length ! Set in correct length or ! IE_AST error code DO 20,I=1,IDS+1 ! The final transfer 20 LBUF(I)=ICHAR(Command(I:I)) ! C TYPE *,'OUTLENGTH=',Length RETURN END