c ****************************************************** c * * c * Copyright, (C) Honeywell Limited, 1983 * c * * c * Copyright (c) 1972 by Massachusetts Institute of * c * Technology and Honeywell Information Systems, Inc. * c * * c ****************************************************** %global no_auto_zero; c ======================================= c program for self-documentation c c Written: 06/06/79 by Paul E. Smee c c Modified: c ======================================= subroutine fort_parm_math external ioa_ (descriptors) external version character*4 version call ioa_ ("fort_parameter_math version^x^a", version (0)) stop end c ======================================== c version number function just for fun c c Written: 06/06/79 by Paul E. Smee c c Modified: c ======================================== character*4 function version (i) version = "1" return end %options ckmpy, round; c ======================================== c function to perform compile-time FORTRAN math resulting in integer value, c and rounded conversions to integer c c Written: 06/06/79 by Paul E. Smee c c Modified: c Jan 1, 84: Return error code -3 if an overflow is encountered c when converting from real or dp to integer. c ======================================== function to_i_round (i_dum) integer to_i_round integer conv_r_to_i_round, conv_dp_to_i_round, conv_cp_to_i_round, binop_i_i_round integer i_dum, i1, i2 real r0 double precision d0 complex c0 integer op_id integer error_code_1, error_code_2 entry conv_r_to_i_round (r0, error_code_1) if (r0 .ge. 34359738368d0) then error_code_1 = -3 to_i_round = 34359738367 goto 9999 endif if (r0 .le. -34359738368d0) then error_code_1 = -3 to_i_round = -34359738367 goto 9999 endif to_i_round = r0 goto 9999 entry conv_dp_to_i_round (d0, error_code_1) if (d0 .ge. 34359738368d0) then error_code_1 = -3 to_i_round = 34359738367 goto 9999 endif if (d0 .le. -34359738368d0) then error_code_1 = -3 to_i_round = -34359738367 goto 9999 endif to_i_round = d0 goto 9999 entry conv_cp_to_i_round (c0, error_code_1) to_i_round = c0 goto 9999 entry binop_i_i_round (op_id, i1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050, 1060), op_id 1010 to_i_round = i1 + i2 goto 9999 1020 to_i_round = i1 - i2 goto 9999 1030 to_i_round = i1 * i2 goto 9999 1040 to_i_round = i1 / i2 goto 9999 1050 to_i_round = i1 ** i2 goto 9999 1060 to_i_round = - i1 goto 9999 9999 continue return end %options ckmpy, truncate; c ======================================== c function to perform compile-time FORTRAN math resulting in integer value, c and truncd conversions to integer c c Written: 06/27/79 by Paul E. Smee c c Modified: c ======================================== function to_i_trunc (i_dum) integer to_i_trunc integer conv_r_to_i_trunc, conv_dp_to_i_trunc, conv_cp_to_i_trunc, binop_i_i_trunc integer i_dum, i1, i2 real r0 double precision d0 complex c0 integer op_id integer error_code_1, error_code_2 entry conv_r_to_i_trunc (r0, error_code_1) to_i_trunc = r0 goto 9999 entry conv_dp_to_i_trunc (d0, error_code_1) to_i_trunc = d0 goto 9999 entry conv_cp_to_i_trunc (c0, error_code_1) to_i_trunc = c0 goto 9999 entry binop_i_i_trunc (op_id, i1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050, 1060), op_id 1010 to_i_trunc = i1 + i2 goto 9999 1020 to_i_trunc = i1 - i2 goto 9999 1030 to_i_trunc = i1 * i2 goto 9999 1040 to_i_trunc = i1 / i2 goto 9999 1050 to_i_trunc = i1 ** i2 goto 9999 1060 to_i_trunc = - i1 goto 9999 9999 continue return end %options round; c ======================================== c function to perform compile-time FORTRAN math resulting in real values, rounded c c Written: 06/06/79 by Paul E. Smee c c Modified: c ======================================== function to_r_round (r_dum) real to_r_round real conv_i_to_r_round, conv_dp_to_r_round, conv_cp_to_r_round real binop_r_i_round, binop_r_r_round, binop_i_r_round integer i0, i1, i2 real r_dum, r1, r2 double precision d0 complex c0 integer op_id integer error_code_1, error_code_2 entry conv_i_to_r_round (i0, error_code_1) to_r_round = i0 goto 9999 entry conv_dp_to_r_round (d0, error_code_1) to_r_round = d0 goto 9999 entry conv_cp_to_r_round (c0, error_code_1) to_r_round = c0 goto 9999 entry binop_r_i_round (op_id, r1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050), op_id 1010 to_r_round = r1 + i2 goto 9999 1020 to_r_round = r1 - i2 goto 9999 1030 to_r_round = r1 * i2 goto 9999 1040 to_r_round = r1 / i2 goto 9999 1050 to_r_round = r1 ** i2 goto 9999 entry binop_r_r_round (op_id, r1, r2, error_code_2) goto (2010, 2020, 2030, 2040, 2050, 2060), op_id 2010 to_r_round = r1 + r2 goto 9999 2020 to_r_round = r1 - r2 goto 9999 2030 to_r_round = r1 * r2 goto 9999 2040 to_r_round = r1 / r2 goto 9999 2050 to_r_round = r1 ** r2 goto 9999 2060 to_r_round = - r1 goto 9999 entry binop_i_r_round (op_id, i1, r2, error_code_2) goto (3010, 3020, 3030, 3040, 3050), op_id 3010 to_r_round = i1 + r2 goto 9999 3020 to_r_round = i1 - r2 goto 9999 3030 to_r_round = i1 * r2 goto 9999 3040 to_r_round = i1 / r2 goto 9999 3050 to_r_round = i1 ** r2 goto 9999 9999 continue return end %options truncate; c ======================================== c function to perform compile-time FORTRAN math resulting in real values, truncd c c Written: 06/06/79 by Paul E. Smee c c Modified: c ======================================== function to_r_trunc (r_dum) real to_r_trunc real conv_i_to_r_trunc, conv_dp_to_r_trunc, conv_cp_to_r_trunc real binop_r_i_trunc, binop_r_r_trunc, binop_i_r_trunc integer i0, i1, i2 real r_dum, r1, r2 double precision d0 complex c0 integer op_id integer error_code_1, error_code_2 entry conv_i_to_r_trunc (i0, error_code_1) to_r_trunc = i0 goto 9999 entry conv_dp_to_r_trunc (d0, error_code_1) to_r_trunc = d0 goto 9999 entry conv_cp_to_r_trunc (c0, error_code_1) to_r_trunc = c0 goto 9999 entry binop_r_i_trunc (op_id, r1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050), op_id 1010 to_r_trunc = r1 + i2 goto 9999 1020 to_r_trunc = r1 - i2 goto 9999 1030 to_r_trunc = r1 * i2 goto 9999 1040 to_r_trunc = r1 / i2 goto 9999 1050 to_r_trunc = r1 ** i2 goto 9999 entry binop_r_r_trunc (op_id, r1, r2, error_code_2) goto (2010, 2020, 2030, 2040, 2050, 2060), op_id 2010 to_r_trunc = r1 + r2 goto 9999 2020 to_r_trunc = r1 - r2 goto 9999 2030 to_r_trunc = r1 * r2 goto 9999 2040 to_r_trunc = r1 / r2 goto 9999 2050 to_r_trunc = r1 ** r2 goto 9999 2060 to_r_trunc = - r1 goto 9999 entry binop_i_r_trunc (op_id, i1, r2, error_code_2) goto (3010, 3020, 3030, 3040, 3050), op_id 3010 to_r_trunc = i1 + r2 goto 9999 3020 to_r_trunc = i1 - r2 goto 9999 3030 to_r_trunc = i1 * r2 goto 9999 3040 to_r_trunc = i1 / r2 goto 9999 3050 to_r_trunc = i1 ** r2 goto 9999 9999 continue return end %options round; c ======================================== c function to perform compile-time FORTRAN math resulting in dp values, rounded c c Written: 06/06/79 by Paul E. Smee c c Modified: c ======================================== function to_dp_round (d_dum) double precision to_dp_round double precision conv_i_to_dp_round, conv_r_to_dp_round, conv_cp_to_dp_round double precision binop_dp_i_round, binop_dp_r_round, binop_dp_dp_round double precision binop_r_dp_round, binop_i_dp_round integer i0, i1, i2 real r0, r1, r2 double precision d_dum, d1, d2 complex c0 integer op_id integer error_code_1, error_code_2 entry conv_i_to_dp_round (i0, error_code_1) to_dp_round = i0 goto 9999 entry conv_r_to_dp_round (r0, error_code_1) to_dp_round = r0 goto 9999 entry conv_cp_to_dp_round (c0, error_code_1) to_dp_round = c0 goto 9999 entry binop_dp_i_round (op_id, d1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050), op_id 1010 to_dp_round = d1 + i2 goto 9999 1020 to_dp_round = d1 - i2 goto 9999 1030 to_dp_round = d1 * i2 goto 9999 1040 to_dp_round = d1 / i2 goto 9999 1050 to_dp_round = d1 ** i2 goto 9999 entry binop_dp_r_round (op_id, d1, r2, error_code_2) goto (2010, 2020, 2030, 2040, 2050), op_id 2010 to_dp_round = d1 + r2 goto 9999 2020 to_dp_round = d1 - r2 goto 9999 2030 to_dp_round = d1 * r2 goto 9999 2040 to_dp_round = d1 / r2 goto 9999 2050 to_dp_round = d1 ** r2 goto 9999 entry binop_dp_dp_round (op_id, d1, d2, error_code_2) goto (3010, 3020, 3030, 3040, 3050, 3060), op_id 3010 to_dp_round = d1 + d2 goto 9999 3020 to_dp_round = d1 - d2 goto 9999 3030 to_dp_round = d1 * d2 goto 9999 3040 to_dp_round = d1 / d2 goto 9999 3050 to_dp_round = d1 ** d2 goto 9999 3060 to_dp_round = - d1 goto 9999 entry binop_r_dp_round (op_id, r1, d2, error_code_2) goto (4010, 4020, 4030, 4040, 4050), op_id 4010 to_dp_round = r1 + d2 goto 9999 4020 to_dp_round = r1 - d2 goto 9999 4030 to_dp_round = r1 * d2 goto 9999 4040 to_dp_round = r1 / d2 goto 9999 4050 to_dp_round = r1 ** d2 goto 9999 entry binop_i_dp_round (op_id, i1, d2, error_code_2) goto (5010, 5020, 5030, 5040, 5050), op_id 5010 to_dp_round = i1 + d2 goto 9999 5020 to_dp_round = i1 - d2 goto 9999 5030 to_dp_round = i1 * d2 goto 9999 5040 to_dp_round = i1 / d2 goto 9999 5050 to_dp_round = i1 ** d2 goto 9999 9999 continue return end %options truncate; c ======================================== c function to perform compile-time FORTRAN math resulting in dp values, truncd c c Written: 06/06/79 by Paul E. Smee c c Modified: c ======================================== function to_dp_trunc (d_dum) double precision to_dp_trunc double precision conv_i_to_dp_trunc, conv_r_to_dp_trunc, conv_cp_to_dp_trunc double precision binop_dp_i_trunc, binop_dp_r_trunc, binop_dp_dp_trunc double precision binop_r_dp_trunc, binop_i_dp_trunc integer i0, i1, i2 real r0, r1, r2 double precision d_dum, d1, d2 complex c0 integer op_id integer error_code_1, error_code_2 entry conv_i_to_dp_trunc (i0, error_code_1) to_dp_trunc = i0 goto 9999 entry conv_r_to_dp_trunc (r0, error_code_1) to_dp_trunc = r0 goto 9999 entry conv_cp_to_dp_trunc (c0, error_code_1) to_dp_trunc = c0 goto 9999 entry binop_dp_i_trunc (op_id, d1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050), op_id 1010 to_dp_trunc = d1 + i2 goto 9999 1020 to_dp_trunc = d1 - i2 goto 9999 1030 to_dp_trunc = d1 * i2 goto 9999 1040 to_dp_trunc = d1 / i2 goto 9999 1050 to_dp_trunc = d1 ** i2 goto 9999 entry binop_dp_r_trunc (op_id, d1, r2, error_code_2) goto (2010, 2020, 2030, 2040, 2050), op_id 2010 to_dp_trunc = d1 + r2 goto 9999 2020 to_dp_trunc = d1 - r2 goto 9999 2030 to_dp_trunc = d1 * r2 goto 9999 2040 to_dp_trunc = d1 / r2 goto 9999 2050 to_dp_trunc = d1 ** r2 goto 9999 entry binop_dp_dp_trunc (op_id, d1, d2, error_code_2) goto (3010, 3020, 3030, 3040, 3050, 3060), op_id 3010 to_dp_trunc = d1 + d2 goto 9999 3020 to_dp_trunc = d1 - d2 goto 9999 3030 to_dp_trunc = d1 * d2 goto 9999 3040 to_dp_trunc = d1 / d2 goto 9999 3050 to_dp_trunc = d1 ** d2 goto 9999 3060 to_dp_trunc = - d1 goto 9999 entry binop_r_dp_trunc (op_id, r1, d2, error_code_2) goto (4010, 4020, 4030, 4040, 4050), op_id 4010 to_dp_trunc = r1 + d2 goto 9999 4020 to_dp_trunc = r1 - d2 goto 9999 4030 to_dp_trunc = r1 * d2 goto 9999 4040 to_dp_trunc = r1 / d2 goto 9999 4050 to_dp_trunc = r1 ** d2 goto 9999 entry binop_i_dp_trunc (op_id, i1, d2, error_code_2) goto (5010, 5020, 5030, 5040, 5050), op_id 5010 to_dp_trunc = i1 + d2 goto 9999 5020 to_dp_trunc = i1 - d2 goto 9999 5030 to_dp_trunc = i1 * d2 goto 9999 5040 to_dp_trunc = i1 / d2 goto 9999 5050 to_dp_trunc = i1 ** d2 goto 9999 9999 continue return end %options round; c ======================================== c function to perform compile-time FORTRAN math resulting in complex value, rounded c c Written: 06/07/79 by Paul E. Smee c c Modified: c ======================================== function to_cp_round (c_dum) complex to_cp_round complex conv_i_to_cp_round, conv_r_to_cp_round, conv_dp_to_cp_round complex binop_cp_i_round, binop_cp_r_round, binop_cp_dp_round complex binop_cp_cp_round, binop_dp_cp_round, binop_r_cp_round complex binop_i_cp_round integer i0, i1, i2 real r0, r1, r2 double precision d0, d1, d2 complex c_dum, c1, c2 integer op_id integer error_code_1, error_code_2 entry conv_i_to_cp_round (i0, error_code_1) to_cp_round = i0 goto 9999 entry conv_r_to_cp_round (r0, error_code_1) to_cp_round = r0 goto 9999 entry conv_dp_to_cp_round (d0, error_code_1) to_cp_round = d0 goto 9999 entry binop_cp_i_round (op_id, c1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050), op_id 1010 to_cp_round = c1 + i2 goto 9999 1020 to_cp_round = c1 - i2 goto 9999 1030 to_cp_round = c1 * i2 goto 9999 1040 to_cp_round = c1 / i2 goto 9999 1050 to_cp_round = c1 ** i2 goto 9999 entry binop_cp_r_round (op_id, c1, r2, error_code_2) goto (2010, 2020, 2030, 2040, 2050), op_id 2010 to_cp_round = c1 + r2 goto 9999 2020 to_cp_round = c1 - r2 goto 9999 2030 to_cp_round = c1 * r2 goto 9999 2040 to_cp_round = c1 / r2 goto 9999 2050 to_cp_round = c1 ** r2 goto 9999 entry binop_cp_dp_round (op_id, c1, d2, error_code_2) goto (3010, 3020, 3030, 3040, 3050), op_id 3010 to_cp_round = c1 + d2 goto 9999 3020 to_cp_round = c1 - d2 goto 9999 3030 to_cp_round = c1 * d2 goto 9999 3040 to_cp_round = c1 / d2 goto 9999 3050 to_cp_round = c1 ** d2 goto 9999 entry binop_cp_cp_round (op_id, c1, c2, error_code_2) goto (4010, 4020, 4030, 4040, 4050, 4060), op_id 4010 to_cp_round = c1 + c2 goto 9999 4020 to_cp_round = c1 - c2 goto 9999 4030 to_cp_round = c1 * c2 goto 9999 4040 to_cp_round = c1 / c2 goto 9999 4050 to_cp_round = c1 ** c2 goto 9999 4060 to_cp_round = - c1 goto 9999 entry binop_dp_cp_round (op_id, d1, c2, error_code_2) goto (5010, 5020, 5030, 5040, 5050), op_id 5010 to_cp_round = d1 + c2 goto 9999 5020 to_cp_round = d1 - c2 goto 9999 5030 to_cp_round = d1 * c2 goto 9999 5040 to_cp_round = d1 / c2 goto 9999 5050 to_cp_round = d1 ** c2 goto 9999 entry binop_r_cp_round (op_id, r1, c2, error_code_2) goto (6010, 6020, 6030, 6040, 6050), op_id 6010 to_cp_round = r1 + c2 goto 9999 6020 to_cp_round = r1 - c2 goto 9999 6030 to_cp_round = r1 * c2 goto 9999 6040 to_cp_round = r1 / c2 goto 9999 6050 to_cp_round = r1 ** c2 goto 9999 entry binop_i_cp_round (op_id, i1, c2, error_code_2) goto (7010, 7020, 7030, 7040, 7050), op_id 7010 to_cp_round = i1 + c2 goto 9999 7020 to_cp_round = i1 - c2 goto 9999 7030 to_cp_round = i1 * c2 goto 9999 7040 to_cp_round = i1 / c2 goto 9999 7050 to_cp_round = i1 ** c2 goto 9999 9999 continue return end %options truncate; c ======================================== c function to perform compile-time FORTRAN math resulting in complex value, truncd c c Written: 06/07/79 by Paul E. Smee c c Modified: c ======================================== function to_cp_trunc (c_dum) complex to_cp_trunc complex conv_i_to_cp_trunc, conv_r_to_cp_trunc, conv_dp_to_cp_trunc complex binop_cp_i_trunc, binop_cp_r_trunc, binop_cp_dp_trunc complex binop_cp_cp_trunc, binop_dp_cp_trunc, binop_r_cp_trunc complex binop_i_cp_trunc integer i0, i1, i2 real r0, r1, r2 double precision d0, d1, d2 complex c_dum, c1, c2 integer op_id integer error_code_1, error_code_2 entry conv_i_to_cp_trunc (i0, error_code_1) to_cp_trunc = i0 goto 9999 entry conv_r_to_cp_trunc (r0, error_code_1) to_cp_trunc = r0 goto 9999 entry conv_dp_to_cp_trunc (d0, error_code_1) to_cp_trunc = d0 goto 9999 entry binop_cp_i_trunc (op_id, c1, i2, error_code_2) goto (1010, 1020, 1030, 1040, 1050), op_id 1010 to_cp_trunc = c1 + i2 goto 9999 1020 to_cp_trunc = c1 - i2 goto 9999 1030 to_cp_trunc = c1 * i2 goto 9999 1040 to_cp_trunc = c1 / i2 goto 9999 1050 to_cp_trunc = c1 ** i2 goto 9999 entry binop_cp_r_trunc (op_id, c1, r2, error_code_2) goto (2010, 2020, 2030, 2040, 2050), op_id 2010 to_cp_trunc = c1 + r2 goto 9999 2020 to_cp_trunc = c1 - r2 goto 9999 2030 to_cp_trunc = c1 * r2 goto 9999 2040 to_cp_trunc = c1 / r2 goto 9999 2050 to_cp_trunc = c1 ** r2 goto 9999 entry binop_cp_dp_trunc (op_id, c1, d2, error_code_2) goto (3010, 3020, 3030, 3040, 3050), op_id 3010 to_cp_trunc = c1 + d2 goto 9999 3020 to_cp_trunc = c1 - d2 goto 9999 3030 to_cp_trunc = c1 * d2 goto 9999 3040 to_cp_trunc = c1 / d2 goto 9999 3050 to_cp_trunc = c1 ** d2 goto 9999 entry binop_cp_cp_trunc (op_id, c1, c2, error_code_2) goto (4010, 4020, 4030, 4040, 4050, 4060), op_id 4010 to_cp_trunc = c1 + c2 goto 9999 4020 to_cp_trunc = c1 - c2 goto 9999 4030 to_cp_trunc = c1 * c2 goto 9999 4040 to_cp_trunc = c1 / c2 goto 9999 4050 to_cp_trunc = c1 ** c2 goto 9999 4060 to_cp_trunc = - c1 goto 9999 entry binop_dp_cp_trunc (op_id, d1, c2, error_code_2) goto (5010, 5020, 5030, 5040, 5050), op_id 5010 to_cp_trunc = d1 + c2 goto 9999 5020 to_cp_trunc = d1 - c2 goto 9999 5030 to_cp_trunc = d1 * c2 goto 9999 5040 to_cp_trunc = d1 / c2 goto 9999 5050 to_cp_trunc = d1 ** c2 goto 9999 entry binop_r_cp_trunc (op_id, r1, c2, error_code_2) goto (6010, 6020, 6030, 6040, 6050), op_id 6010 to_cp_trunc = r1 + c2 goto 9999 6020 to_cp_trunc = r1 - c2 goto 9999 6030 to_cp_trunc = r1 * c2 goto 9999 6040 to_cp_trunc = r1 / c2 goto 9999 6050 to_cp_trunc = r1 ** c2 goto 9999 entry binop_i_cp_trunc (op_id, i1, c2, error_code_2) goto (7010, 7020, 7030, 7040, 7050), op_id 7010 to_cp_trunc = i1 + c2 goto 9999 7020 to_cp_trunc = i1 - c2 goto 9999 7030 to_cp_trunc = i1 * c2 goto 9999 7040 to_cp_trunc = i1 / c2 goto 9999 7050 to_cp_trunc = i1 ** c2 goto 9999 9999 continue return end %options round; c ======================================== c function to perform compile-time FORTRAN comparisons c c Written: 06/25/79 by Paul E. Smee c c Modified: c ======================================== function to_log (l_dum) logical to_log logical comp_i_i, comp_i_r, comp_i_dp logical comp_r_i, comp_r_r, comp_r_dp logical comp_dp_i, comp_dp_r, comp_dp_dp logical comp_cp_cp, comp_lg_lg, comp_ch_ch integer i1, i2 real r1, r2 double precision d1, d2 complex c1, c2 logical l_dum, l1, l2 character*8 ch1, ch2 integer op_id integer error_code_1, error_code_2 entry comp_i_i (op_id, i1, i2, error_code_2) goto (110, 120, 130, 140, 150, 160), op_id - 7 110 to_log = i1 .lt. i2 goto 9999 120 to_log = i1 .le.i2 goto 9999 130 to_log = i1 .eq. i2 goto 9999 140 to_log = i1 .ne. i2 goto 9999 150 to_log = i1 .ge. i2 goto 9999 160 to_log = i1 .gt. i2 goto 9999 entry comp_i_r (op_id, i1, r2, error_code_2) goto (210, 220, 230, 240, 250, 260), op_id - 7 210 to_log = i1 .lt. r2 goto 9999 220 to_log = i1 .le. r2 goto 9999 230 to_log = i1 .eq. r2 goto 9999 240 to_log = i1 .ne. r2 goto 9999 250 to_log = i1 .ge. r2 goto 9999 260 to_log = i1 .gt. r2 goto 9999 entry comp_i_dp (op_id, i1, d2, error_code_2) goto (310, 320, 330, 340, 350, 360), op_id - 7 310 to_log = i1 .lt. d2 goto 9999 320 to_log = i1 .le. d2 goto 9999 330 to_log = i1 .eq. d2 goto 9999 340 to_log = i1 .ne. d2 goto 9999 350 to_log = i1 .ge. d2 goto 9999 360 to_log = i1 .gt. d2 goto 9999 entry comp_r_i (op_id, r1, i2, error_code_2) goto (510, 520, 530, 540, 550, 560), op_id - 7 510 to_log = r1 .lt. i2 goto 9999 520 to_log = r1 .le. i2 goto 9999 530 to_log = r1 .eq. i2 goto 9999 540 to_log = r1 .ne. i2 goto 9999 550 to_log = r1 .ge. i2 goto 9999 560 to_log = r1 .gt. i2 goto 9999 entry comp_r_r (op_id, r1, r2, error_code_2) goto (610, 620, 630, 640, 650, 660), op_id - 7 610 to_log = r1 .lt. r2 goto 9999 620 to_log = r1 .le. r2 goto 9999 630 to_log = r1 .eq. r2 goto 9999 640 to_log = r1 .ne. r2 goto 9999 650 to_log = r1 .ge. r2 goto 9999 660 to_log = r1 .gt. r2 goto 9999 entry comp_r_dp (op_id, r1, d2, error_code_2) goto (710, 720, 730, 740, 750, 760), op_id - 7 710 to_log = r1 .lt. d2 goto 9999 720 to_log = r1 .le. d2 goto 9999 730 to_log = r1 .eq. d2 goto 9999 740 to_log = r1 .ne. d2 goto 9999 750 to_log = r1 .ge. d2 goto 9999 760 to_log = r1 .gt. d2 goto 9999 entry comp_dp_i (op_id, d1, i2, error_code_2) goto (910, 920, 930, 940, 950, 960), op_id - 7 910 to_log = d1 .lt. i2 goto 9999 920 to_log = d1 .le. i2 goto 9999 930 to_log = d1 .eq. i2 goto 9999 940 to_log = d1 .ne. i2 goto 9999 950 to_log = d1 .ge. i2 goto 9999 960 to_log = d1 .gt. i2 goto 9999 entry comp_dp_r (op_id, d1, r2, error_code_2) goto (1010, 1020, 1030, 1040, 1050, 1060), op_id - 7 1010 to_log = d1 .lt. r2 goto 9999 1020 to_log = d1 .le. r2 goto 9999 1030 to_log = d1 .eq. r2 goto 9999 1040 to_log = d1 .ne. r2 goto 9999 1050 to_log = d1 .ge. r2 goto 9999 1060 to_log = d1 .gt. r2 goto 9999 entry comp_dp_dp (op_id, d1, d2, error_code_2) goto (1110, 1120, 1130, 1140, 1150, 1160), op_id - 7 1110 to_log = d1 .lt. d2 goto 9999 1120 to_log = d1 .le. d2 goto 9999 1130 to_log = d1 .eq. d2 goto 9999 1140 to_log = d1 .ne. d2 goto 9999 1150 to_log = d1 .ge. d2 goto 9999 1160 to_log = d1 .gt. d2 goto 9999 entry comp_cp_cp (op_id, c1, c2, error_code_2) goto (1630, 1640), op_id - 9 error_code_2 = - 1 goto 9999 1630 to_log = c1 .eq. c2 goto 9999 1640 to_log = c1 .ne. c2 goto 9999 entry comp_lg_lg (op_id, l1, l2, error_code_2) goto (2530, 2540), op_id - 9 error_code_2 = - 1 goto 9999 2530 to_log = l1 .eq. l2 goto 9999 2540 to_log = l1 .ne. l2 goto 9999 entry comp_ch_ch (op_id, ch1, ch2, error_code_2) goto (3610, 3620, 3630, 3640, 3650, 3660), op_id - 7 3610 to_log = ch1 .lt. ch2 goto 9999 3620 to_log = ch1 .le. ch2 goto 9999 3630 to_log = ch1 .eq. ch2 goto 9999 3640 to_log = ch1 .ne. ch2 goto 9999 3650 to_log = ch1 .ge. ch2 goto 9999 3660 to_log = ch1 .gt. ch2 goto 9999 9999 continue return end %options truncate; c ======================================== c Miscellaneous "do-nothing" entries c c Written: 06/29/79 by Paul E. Smee c c Modified: c ======================================== function misc_ops (ch_dum) character*8 misc_ops character*8 bad_data_types, binop_ch_ch, binop_lg_lg character*8 binop_no_op, unary_no_op, conv_ch_to_ch character*8 unary_bad_data character*8 ch0, ch1, ch2, ch_dum integer op_id integer error_code_1, error_code_2 entry bad_data_types (op_id, ch1, ch2, error_code_2) error_code_2 = -1 misc_ops = ch1 return entry unary_bad_data (ch0, error_code_1) error_code_1 = -1 misc_ops = ch0 return entry binop_ch_ch (op_id, ch1, ch2, error_code_2) error_code_2 = -2 misc_ops = ch1 return entry binop_lg_lg (op_id, ch1, ch2, error_code_2) error_code_2 = -2 misc_ops = ch1 return entry binop_no_op (op_id, ch1, ch2, error_code_2) misc_ops = ch1 return entry unary_no_op (ch0, error_code_1) misc_ops = ch0 return entry conv_ch_to_ch (ch0, error_code_1) misc_ops = ch0 return end c c c ----------------------------------------------------------- c c c c Historical Background c c This edition of the Multics software materials and documentation is provided and donated c to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. c as a contribution to computer science knowledge. c This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, c Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull c and Bull HN Information Systems Inc. to the development of this operating system. c Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), c renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership c of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for c managing computer hardware properly and for executing programs. Many subsequent operating systems c incorporated Multics principles. c Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., c as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . c c ----------------------------------------------------------- c c Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without c fee is hereby granted,provided that the below copyright notice and historical background appear in all copies c and that both the copyright notice and historical background and this permission notice appear in supporting c documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining c to distribution of the programs without specific prior written permission. c Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. c Copyright 2006 by Bull HN Information Systems Inc. c Copyright 2006 by Bull SAS c All Rights Reserved c c