mim/development/mim/vaxc/double-int.mud

   1 <PUT-DECL DFLOAT '<<PRIMTYPE UVECTOR> [2 FIX]>>
   2
   3 <DEFINE DFLOAT (OPER "TUPLE" ARGS "AUX" (NARGS <LENGTH .ARGS>) RES)
   4   #DECL ((OPER) ATOM (ARGS) <TUPLE <OR FLOAT DFLOAT> [REST DFLOAT]>)
   5   <COND (<OR <==? .OPER ADD>
   6              <==? .OPER MUL>
   7              <==? .OPER SUB>
   8              <==? .OPER DIV>>
   9          <COND (<OR <L? .NARGS 2>
  10                     <G? .NARGS 3>>
  11                 <ERROR WRONG-NUMBER-OF-ARGS!-ERRORS DOUBLE .OPER>)
  12                (T
  13                 <COND (<==? .NARGS 2>
  14                        <SET RES <2 .ARGS>>)
  15                       (T
  16                        <SET RES <3 .ARGS>>)>
  17                 <COND
  18                  (<==? .OPER ADD>
  19                   <CALL DOUBLE ADD <1 .ARGS> <2 .ARGS> .RES>)
  20                  (<==? .OPER MUL>
  21                   <CALL DOUBLE MUL <1 .ARGS> <2 .ARGS> .RES>)
  22                  (<==? .OPER SUB>
  23                   <CALL DOUBLE SUB <1 .ARGS> <2 .ARGS> .RES>)
  24                  (<==? .OPER DIV>
  25                   <CALL DOUBLE DIV <1 .ARGS> <2 .ARGS> .RES>)>
  26                 .RES)>)
  27         (<OR <==? .OPER G?>
  28              <==? .OPER =?>
  29              <==? .OPER L?>>
  30          <COND (<N==? .NARGS 2>
  31                 <ERROR WRONG-NUMBER-OF-ARGS!-ERRORS DOUBLE .OPER>)
  32                (T
  33                 <COND
  34                  (<==? .OPER G?>
  35                   <CALL DOUBLE G? <1 .ARGS> <2 .ARGS>>)
  36                  (<==? .OPER =?>
  37                   <CALL DOUBLE =? <1 .ARGS> <2 .ARGS>>)
  38                  (<==? .OPER L?>
  39                   <CALL DOUBLE L? <1 .ARGS> <2 .ARGS>>)>)>)
  40         (<==? .OPER DOUBLE-TO-SINGLE>
  41          <COND (<N==? .NARGS 1>
  42                 <ERROR WRONG-NUMBER-OF-ARGS!-ERRORS DOUBLE .OPER>)
  43                (T
  44                 <CALL DOUBLE DOUBLE-TO-SINGLE <1 .ARGS>>)>)
  45         (<==? .OPER SINGLE-TO-DOUBLE>
  46          <COND (<OR <L? .NARGS 1>
  47                     <G? .NARGS 2>>
  48                 <ERROR WRONG-NUMBER-OF-ARGS!-ERRORS DOUBLE .OPER>)
  49                (T
  50                 <COND (<==? .NARGS 2>
  51                        <CALL DOUBLE SINGLE-TO-DOUBLE <1 .ARGS>
  52                              <SET RES <2 .ARGS>>>)
  53                       (T
  54                        <CALL DOUBLE SINGLE-TO-DOUBLE <1 .ARGS>
  55                              <SET RES <IUVECTOR 2>>>)>
  56                 .RES)>)>>