*DECK     DBL 
          IDENT  P.DBL
          B1=1
          ENTRY  P.DADD 
          ENTRY  P.DDIV 
          ENTRY  P.DMUL 
          ENTRY  P.DSUB 
 DBL      SPACE  4,10 
 DBL      TITLE  DBL - DOUBLE PRECISION ROUTINES. 
          COMMENT PASCAL 6000 DOUBLE PRECISION ROUTINES.
          COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. 
 DBL      SPACE  4,10 
***       DBL - DOUBLE PRECISION ROUTINES.
*         J. P. STRAIT.      78/10/08.
* BRING DOCUMENTATION UP TO CODING STANDARDS. 
 DADD     SPACE  4,10 
***       P.DADD - DOUBLE PRECISION ADD.
* 
*         TYPE DOUBLE = RECORD UPPER:REAL; LOWER:REAL END;
*         PROCEDURE (*$E'P.DADD'*) DADD(VAR R:DOUBLE; A,B:DOUBLE);
* 
*         ENTRY  (B1) = 1.
*                (X0) = ADDRESS OF R. 
*                (X1) = ADDRESS OF A. 
*                (X2) = ADDRESS OF B. 
* 
*         EXIT   R := A + B IN DOUBLE PRECISION.
* 
*         USES   A - 2, 3, 4, 5, 6, 7.
*                B - NONE.
*                X - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  NONE.
* 
*         MACROS NONE.
  
  
 P.DADD   PS                 ENTRY/EXIT 
          SA4    X2          B.UPPER
          SA2    X1          A.UPPER
          SA5    A4+B1       B.LOWER
          SA3    A2+B1       A.LOWER
          FX1    X2+X4
          FX7    X3+X5
          DX6    X2+X4
          FX7    X6+X7
          FX6    X1+X7
          NX2    X6 
          DX7    X1+X7
          NX1    X7 
          FX6    X2+X1
          DX7    X2+X1
          SA6    X0          SET R.UPPER
          SA7    X0+B1       SET R.LOWER
          EQ     P.DADD      RETURN 
 DDIV     SPACE  4,10 
***       P.DDIV - DOUBLE PRECISION DIVIDE. 
* 
*         TYPE DOUBLE = RECORD UPPER:REAL; LOWER:REAL END;
*         PROCEDURE (*$E'P.DDIV'*) DDIV(VAR R:DOUBLE; A,B:DOUBLE);
* 
*         ENTRY  (B1) = 1.
*                (X0) = ADDRESS OF R. 
*                (X1) = ADDRESS OF A. 
*                (X2) = ADDRESS OF B. 
* 
*         EXIT   R := A / B IN DOUBLE PRECISION.
* 
*         USES   A - 2, 3, 4, 5, 6, 7.
*                B - NONE.
*                X - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  NONE.
* 
*         MACROS NONE.
  
  
 P.DDIV   PS                 ENTRY/EXIT 
          SA4    X2          B.UPPER
          SA2    X1          A.UPPER
          SA5    A4+B1       B.LOWER
          SA3    A2+B1       A.LOWER
          FX1    X2/X4
          FX6    X1*X4
          FX7    X2-X6
          DX6    X2-X6
          NX7    X7 
          FX6    X7+X6
          DX7    X1*X4
          FX2    X1*X5
          FX6    X6+X3
          FX6    X6-X7
          FX6    X6-X2
          FX2    X6/X4
          FX6    X1+X2
          DX7    X1+X2
          NX1    X6 
          FX6    X1+X7
          DX7    X1+X7
          SA6    X0          SET R.UPPER
          SA7    X0+1        SET R.LOWER
          EQ     P.DDIV      RETURN 
 DMUL     SPACE  4,10 
***       P.DMUL - DOUBLE PRECISION MULTIPLY. 
* 
*         TYPE DOUBLE = RECORD UPPER:REAL; LOWER:REAL END;
*         PROCEDURE (*$E'P.DMUL'*) DMUL(VAR R:DOUBLE; A,B:DOUBLE);
* 
*         ENTRY  (B1) = 1.
*                (X0) = ADDRESS OF R. 
*                (X1) = ADDRESS OF A. 
*                (X2) = ADDRESS OF B. 
* 
*         EXIT   R := A * B IN DOUBLE PRECISION.
* 
*         USES   A - 2, 3, 4, 5, 6, 7.
*                B - NONE.
*                X - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  NONE.
* 
*         MACROS NONE.
  
  
 P.DMUL   PS                 ENTRY/EXIT 
          SA4    X2          B.UPPER
          SA2    X1          A.UPPER
          SA5    A4+B1       B.LOWER
          SA3    A2+B1       A.LOWER
          FX1    X2*X5
          FX7    X3*X4
          FX1    X1+X7
          DX7    X2*X4
          FX6    X2*X4
          FX1    X1+X7
          DX7    X1+X6
          FX6    X1+X6
          SA6    X0          SET R.UPPER
          SA7    X0+B1       SET R.LOWER
          EQ     P.DMUL      RETURN 
 DSUB     SPACE  4,10 
***       P.DSUB - DOUBLE PRECISION SUBTRACT. 
* 
*         TYPE DOUBLE = RECORD UPPER:REAL; LOWER:REAL END;
*         PROCEDURE (*$E'P.DSUB'*) DSUB(VAR R:DOUBLE; A,B:DOUBLE);
* 
*         ENTRY  (B1) = 1.
*                (X0) = ADDRESS OF R. 
*                (X1) = ADDRESS OF A. 
*                (X2) = ADDRESS OF B. 
* 
*         EXIT   R := A - B IN DOUBLE PRECISION.
* 
*         USES   A - 2, 3, 4, 5, 6, 7.
*                B - NONE.
*                X - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  NONE.
* 
*         MACROS NONE.
  
  
 P.DSUB   PS                 ENTRY/EXIT 
          SA4    X2          B.UPPER
          SA2    X1          A.UPPER
          SA5    A4+B1       B.LOWER
          SA3    A2+B1       A.LOWER
          FX1    X2-X4
          FX7    X3-X5
          DX6    X2-X4
          FX7    X6+X7
          FX6    X1+X7
          NX2    X6 
          DX7    X1+X7
          NX1    X7 
          FX6    X2+X1
          DX7    X2+X1
          SA6    X0          SET R.UPPER
          SA7    X0+B1       SET R.LOWER
          EQ     P.DSUB      RETURN 
          SPACE  4
          END 
