*DECK EVALCFN 
          IDENT  EVALCFN
          COMMENT EVALUATE COMPASS FUNCTION 
* 
*         EVALCFN - EVALUATE COMPASS FUNCTION 
* 
*         INPUT 
*                X.GET - ADDRESS OF FUNCTION
*                /INT/VARG - VALUE OF ARGUMENT
*                /INT/ARG - ACTUAL ARGUMENT 
*         OUTPUT
*                X.TMP - FUNCTION VALUE 
          SST 
 I#       SET    1
*CALL OPMACS
          PURGMAC  ;
 ;        MACRO  ARG
 ARG      EQU    I# 
          ENDM
          QUAL   FNAME
 I#       SET    1
*CALL FUNCTIONS 
          QUAL   *
          EJECT 
*CALL CGENREGS
          EJECT 
 DEF      MACRO  P1,P2,P3 
 M1       MICRO  4,, P1 
 MNAME    MICRO  1,,#"M1" 
 MCNT     MICCNT MNAME
 M2       MICRO  MCNT+2,, "M1"
 M3       MICRO  1,1, "M2"
          IFC    EQ,*U*"M3"*
 WORD     MICRO  3,, "M2" 
 LEN      MICRO  1,,)P3 
 #"MNAME"# MICRO  1,,/0,"WORD","LEN",60-P2-"LEN",0,0/ 
          ENDIF 
          ENDM
  
 .FETCH   OPSYN  FETCH
          PURGMAC FETCH 
 FETCH    MACRO  P1,P2,P3 
          .FETCH P1,P2,P3,LOD,STO 
          ENDM
  
 DEFINE   MACRO  ARG
 M1       MICRO  1,,#_ARG 
 M2       MICCNT   M1 
 M4       MICRO  M2+1,, ARG 
 M3       MICRO  1,,"M4"
 "M1"     EQU     "M3"
          ENDM
  
 SETAFIX  MACRO 
          SA.LOD /INT/VARG
          SX.GET RG$SIZE
          IX.LOD X.LOD*X.GET
          SA.FIX X.LOD+REGTAB 
          ENDM
  
 CFUNC    MACRO  NAME 
          ORG    CFUNCS+/FNAME/NAME 
          VFD    60//FCODE/NAME 
          USE    *
          ENDM
  
*CALL REGDEFS 
  
          USE    /REGTABL/
 REGTAB   BSS    RG$SIZE*RG$LIM+RG$SIZE 
          USE    *
          ENTRY  CFUNCS 
          USE    COMPFN 
 CFUNCS   BSSZ   /FNAME/#M$FUNC#
          USE    *
          EJECT 
          ENTRY  EVALCFN
 EVALCFN  DATA   0
          SB.TMP X.GET
          JP     B.TMP
          SPACE  3
          QUAL   FCODE
          CFUNC  ABSVALOF 
 ABSVALOF BSS    0           ABSOLUTE VALUE 
          SA.LOD /INT/VARG
          BX.TMP X.LOD
          AX.TMP 59 
          BX.TMP X.TMP-X.LOD
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH1 
 ARITH1   BSS    0           CHARPOS+ITMLEN 
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          FETCH  A.FIX,ITMLEN,X.GET 
          IX.TMP X.TMP+X.GET
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH2 
 ARITH2   BSS    0           6 * CHARPOS
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          BX.GET X.TMP
          LX.GET 1
          IX.TMP X.TMP+X.GET
          LX.TMP 1
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH3 
 ARITH3   BSS    0           6 * ITMLEN 
          SETAFIX 
          FETCH  A.FIX,ITMLEN,X.GET 
          BX.TMP X.GET
          LX.GET 1
          IX.TMP X.GET+X.TMP
          LX.TMP 1
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH5 
 ARITH5   BSS    0           10 - CHARPOS + ITMLEN
          SETAFIX 
          FETCH  A.FIX,ITMLEN,X.TMP 
          FETCH  A.FIX,CHRPOS,X.GET 
          SX.STO 10 
          IX.LOD X.STO+X.TMP
          IX.TMP X.LOD-X.GET
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH6 
 ARITH6   BSS    0           10 - CHARPOS 
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.GET 
          SX.LOD 10 
          IX.TMP X.LOD-X.GET
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH7 
 ARITH7   BSS    0           60 - 6*FIXED 
          SA.LOD /INT/VARG
          BX.GET X.LOD
          LX.GET 1
          IX.TMP X.GET+X.LOD
          LX.TMP 1
          SX.GET B..60
          IX.TMP X.GET-X.TMP
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH8 
 ARITH8   BSS    0           6*FIXED
          SA.LOD /INT/VARG
          BX.GET X.LOD
          LX.GET 1
          IX.TMP X.GET+X.LOD
          LX.TMP 1
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH9 
 ARITH9   BSS    0
          SA.LOD /INT/VARG
          SX.TMP B..60
          PX.STO X.LOD,B..0 
          PX.GET X.TMP,B..0 
          NX.STO X.STO,B..0 
          NX.GET X.GET,B..0 
          FX.STO X.STO/X.GET       VARG/60
          UX.GET X.STO,B.SCR
          LX.STO B.SCR,X.GET
          IX.TMP X.TMP*X.STO       (VARG/60)*60 
          IX.TMP X.LOD-X.TMP       VARG - (VARG/60)*60
          PL     X.LOD,EVALCFN
          SX.GET B..60
          IX.TMP X.TMP+X.GET       VARG - (VARG/60)*60 + 60 
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH10
 ARITH10  BSS    0           6*(CHARPOS+ITMLEN) 
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          FETCH  A.FIX,ITMLEN,X.GET 
          IX.TMP X.TMP+X.GET
          BX.GET X.TMP
          LX.TMP 1
          IX.TMP X.TMP+X.GET
          LX.TMP 1
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH11
 ARITH11  BSS    0                 60 - FIXED 
          SX.GET B..60
          SA.LOD /INT/VARG
          IX.TMP X.GET-X.LOD
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH12
 ARITH12  BSS    0           CHARPOS + ITMLEN - 10
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          FETCH  A.FIX,ITMLEN,X.GET 
          SX.STO 10 
          IX.GET X.TMP+X.GET
          IX.TMP X.GET-X.STO
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH13
 ARITH13  BSS    0           6*(CHARPOS + ITMLEN ) - 60 
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          FETCH  A.FIX,ITMLEN,X.GET 
          IX.TMP X.TMP+X.GET
          BX.GET X.TMP
          LX.GET 1
          IX.TMP X.GET+X.TMP
          LX.TMP 1
          SX.STO B..60
          IX.TMP X.TMP-X.STO
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH14
 ARITH14  BSS    0           CHARPOS + ITMLEN - 20
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          FETCH  A.GET,ITMLEN,X.GET 
          SX.STO 20 
          IX.GET X.TMP+X.GET
          IX.TMP X.GET-X.STO
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH15
 ARITH15  BSS    0                 120 - 6*FIXED
          SA.LOD /INT/VARG
          BX.GET X.LOD
          LX.GET 1
          IX.TMP X.GET+X.LOD
          LX.TMP 1
          SX.GET 120
          IX.TMP X.GET-X.TMP
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH16
 ARITH16  BSS    0           6*(CHARPOS + ITMLEN) - 120 
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          FETCH  A.FIX,ITMLEN,X.GET 
          IX.TMP X.TMP+X.GET
          BX.LOD X.TMP
          LX.LOD 1
          IX.TMP X.LOD+X.TMP
          LX.TMP 1
          SX.GET 120
          IX.TMP X.TMP-X.GET
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH17
 ARITH17  BSS    0           FIXED MOD 10 
          SA.LOD /INT/VARG
          PX.GET X.LOD,B..0 
          NX.STO X.GET,B..0 
          SX.GET 10 
          PX.TMP X.GET,B..0 
          NX.TMP X.TMP,B..0 
          FX.STO X.STO/X.TMP
          UX.STO X.STO,B.SCR
          LX.STO X.STO,B.SCR
          IX.GET X.GET*X.STO
          IX.TMP X.LOD-X.GET
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH18
 ARITH18  BSS    0           6*(FIXED MOD 10) 
          SA.LOD /INT/VARG
          PX.GET X.LOD,B..0 
          NX.STO X.GET,B..0 
          SX.GET 10 
          PX.TMP X.GET,B..0 
          NX.TMP X.TMP,B..0 
          FX.STO X.STO/X.TMP
          UX.STO X.STO,B.SCR
          LX.STO X.STO,B.SCR
          IX.GET X.GET*X.STO
          IX.TMP X.LOD-X.GET
          BX.GET X.TMP
          LX.GET 1
          IX.TMP X.GET+X.TMP
          LX.TMP 1
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH19
 ARITH19  BSS    0           60 - 6*(FIXED MOD10) 
          SA.LOD /INT/VARG
          PX.GET X.LOD,B..0 
          NX.STO X.GET,B..0 
          SX.GET 10 
          PX.TMP X.GET,B..0 
          NX.TMP X.TMP,B..0 
          FX.STO X.STO/X.TMP
          UX.STO X.STO,B.SCR
          LX.STO X.STO,B.SCR
          IX.GET X.GET*X.STO
          IX.TMP X.LOD-X.GET
          BX.GET X.TMP
          LX.GET 1
          IX.TMP X.GET+X.TMP
          LX.TMP 1
          SX.GET B..60
          IX.TMP X.GET-X.TMP
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH21
 ARITH21  BSS    0           (F1XED-1 MOD 10) + 1 
          SA.LOD /INT/VARG
          SX.GET B..1 
          IX.LOD X.LOD-X.GET
          PX.GET X.LOD,B..0 
          NX.STO X.GET,B..0 
          SX.GET 10 
          PX.TMP X.GET,B..0 
          NX.TMP X.TMP,B..0 
          FX.STO X.STO/X.TMP
          UX.STO X.STO,B.SCR
          LX.STO X.STO,B.SCR
          IX.GET X.GET*X.STO
          IX.TMP X.LOD-X.GET
          SX.GET B..1 
          IX.TMP X.TMP+X.GET
          EQ     EVALCFN
          SPACE  3
          CFUNC  ARITH22
 ARITH22  BSS    0           (FIXED + 9)/10 
          SA.LOD /INT/VARG
          SX.GET 9
          IX.LOD X.LOD+X.GET
          PX.TMP X.LOD,B..0 
          NX.LOD X.TMP,B..0 
          SX.GET 10 
          PX.TMP X.GET,B..0 
          NX.GET X.TMP,B..0 
          FX.TMP X.LOD/X.GET
          UX.GET X.TMP,B.SCR
          LX.TMP B.SCR,X.GET
          EQ     EVALCFN
          SPACE  3
          CFUNC  BCPOF
 BCPOF    BSS    0           BCP
          SETAFIX 
          FETCH  A.FIX,CHRPOS,X.TMP 
          EQ     EVALCFN
          SPACE  3
          CFUNC  BYTLENOF 
 BYTLENOF BSS    0           BYTE LENGTH
          SETAFIX 
          FETCH  A.FIX,ITMLEN,X.TMP 
          EQ     EVALCFN
          SPACE  3
          CFUNC  EQUALS 
 EQUALS   BSS    0
          SA.TMP /INT/ARG 
          EQ     EVALCFN
          SPACE  3
          CFUNC  NUMLENOF 
 NUMLENOF BSS    0           NUMERIC LENGTH 
          SETAFIX 
          FETCH  A.FIX,NUMLEN,X.TMP 
          EQ     EVALCFN
          SPACE  3
          CFUNC  SHL30OF
 SHL30OF  BSS    0           FIXED SHIFTED LEFT 30
          SA.TMP /INT/VARG
          LX.TMP 30 
          EQ     EVALCFN
          SPACE  3
          CFUNC  TREGOF 
 TREGOF   BSS    0           REGISTER NUMBER
          SETAFIX 
          FETCH  A.FIX,TREG,X.TMP 
          EQ     EVALCFN
          SPACE  3
          CFUNC  TREGP1OF 
 TREGP1OF BSS    0           REGISTER NUMBER + 1
          SETAFIX 
          FETCH  A.FIX,TREG,X.TMP 
          SX.TMP X.TMP+B..1 
          EQ     EVALCFN
          SPACE  3
          CFUNC  TYPEOF 
 TYPEOF   BSS    0           TYPE 
          SETAFIX 
          FETCH  A.FIX,TYPE,X.TMP 
          EQ     EVALCFN
          SPACE  3
          CFUNC  VREGP1OF 
 VREGP1OF BSS    0           FIXED + 1
          SA.LOD /INT/VARG
          SX.TMP X.LOD+B..1 
          EQ     EVALCFN
          EJECT 
**        /INT/ -  DEFINE - /INT/ SYMBOLS 
* 
* 
  
  
 #        OPSYN  NIL
  
 COMMON   OPSYN  NIL
  
 BEGIN    OPSYN  NIL
  
 BASED    MACRO 
          BSS    1
 BASED    ENDM
  
          PURGMAC  ITEM 
 ITEM     MACRO  INTNAME
          IFC    NE, INTNAME COMMANDWORD ,5 
 M1       MICRO  1,4, INTNAME 
          IFC    NE, "M1" INT$ ,1 
          ERR    ILLEGAL INT$ ITEM (INTNAME)   "SEQUENCE" 
 M1       MICRO  5,8,/INTNAME       / 
 "M1"           BSS    1
          ENDM
  
 .END     OPSYN  END
 END      OPSYN  NIL
  
  
  
  
          USE    /INTCOM/ 
          QUAL   INT
          LIST   X,G
*CALL INT$
  
          LIST   *
          QUAL   *
          USE    *
  
          PURGMAC  END
 END      OPSYN  .END 
          PURGMAC  #,COMMAN,BEGIN,BASED,ITEM,.END 
          END 
