Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0050/itb.for
There is 1 other file named itb.for in the archive. Click here to see a list.
      FUNCTION ITBPUT(JOLD,JNEW,JKIND,JSHIFT,IBASE)
C
C     ROUTINE TO PROVIDE INCLUSIVE OR, ADDITION
C     AND SUBTRACTION OPERATORS FOR TBLTRN
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     JOLD   = CURRENT VALUE OF LOCATION TO RECEIVE JNEW
C     JNEW   = VALUE TO BE APPENDED TO JOLD
C     JKIND  = TYPE OF OPERATION
C            = 0, EXCLUSIVE OR
C            = 1, AND
C            = 2, ADDITION
C            = 3, SUBTRACTION
C            = 4, INCLUSIVE OR
C     JSHIFT = NUMBER OF BYTES TO SHIFT
C              (POSITIVE IS SHIFT TO LEFT)
C     IBASE  = BASE IN WHICH SHIFT EXPRESSED (BYTE SIZE)
C
C     PERFORM SHIFT
      IF(JSHIFT.EQ.0)GO TO 3
      IF(IBASE.EQ.2)GO TO 2
      IF(JSHIFT.GT.0)GO TO 1
      INEW=-JSHIFT
      INEW=JNEW/(IBASE**INEW)
      GO TO 4
    1 INEW=JNEW*(IBASE**JSHIFT)
      GO TO 4
    2 INEW=ITBMOV(JNEW,JSHIFT)
      GO TO 4
    3 INEW=JNEW
C
C     PERFORM INDICATED OPERATION
    4 IF(JKIND.EQ.0)GO TO 5
      GO TO(6,7,8,9),JKIND
    5 ITBPUT=ITBXOR(JOLD,INEW)
      GO TO 10
    6 ITBPUT=ITBAND(JOLD,INEW)
      GO TO 10
    7 ITBPUT=JOLD+INEW
      GO TO 10
    8 ITBPUT=JOLD-INEW
      GO TO 10
    9 ITBPUT=ITBOR(JOLD,INEW)
   10 RETURN
      END
      FUNCTION ITBXOR(I,J)
C
C     MACHINE DEPENDENT ROUTINE FOR TBLTRN
C
C     RETURNS EXCLUSIVE OR OF 2 ARGUMENTS
C
      ITBXOR=I.XOR.J
      RETURN
      END
      FUNCTION ITBAND(I,J)
C
C     MACHINE DEPENDENT ROUTINE FOR TBLTRN
C
C     RETURNS AND OF 2 ARGUMENTS
C
      ITBAND=I.AND.J
      RETURN
      END
      FUNCTION ITBOR(I,J)
C
C     MACHINE DEPENDENT ROUTINE FOR TBLTRN
C
C     RETURNS INCLUSIVE OR OF 2 ARGUMENTS
C
      ITBOR=I.OR.J
      RETURN
      END
      FUNCTION ITBSIN(I)
C
C     MACHINE DEPENDENT ROUTINE FOR TBLTRN
C
C     RETURNS SIGN BIT ON AND ALL OTHER BITS ZEROED
C
      ITBSIN="400000000000
      RETURN
      END