*COMDECK COM1 
* **********************************************************************000110
*                                                                       000120
*         COPYRIGHT CONTROL DATA CORP. 1971, 1975, 1976, 1977, 1978 
*         COPYRIGHT CONTROL DATA CORP. 1979, 1980, 1981, 1982.
*                                                                       000140
* **********************************************************************000150
 COM1     CTEXT  COMMON DECK COM-1
          LIST   -R,-N
          SPACE  4
**    COM-1  -  PRIMARY COMMON DECK FOR THE 8-BIT PACKAGE 
* 
*     THIS DECK IS DIRECTLY OR INDIRECTLY CALLED INTO EVERY ROUTINE IN
*     THE PACKAGE, WITH THE EXCEPTION OF THE TABLE-ONLY DECKS.  WHERE 
*     THE COMMON DECK COM2  IS USED, A SEPARATE CALL OF COM1 IS NOT 
*     NECESSARY, SINCE COM2 CALLS COM1. 
* 
*     LISTING OF COM1 IS CONTROLLED BY THE X(CTEXT) LIST OPTION.
          SPACE  4,4
****  ASSEMBLY PARAMETERS (MACHINE DEPENDENT) 
* 
 I8.CMU   SET    0           COMPARE-MOVE UNIT CODE   0=OFF, 1=ON 
 I8.IMU   SET    0           INTEGER MULTIPLY UNIT    0=NO , 1=YES
 I8.IMU   SET 1                                                         TB8   47
****
          SPACE  4
**    MACROS OF USE TO ALL ROUTINES...
 DIVIDE   SPACE  4,21                                                   000180
**    IXX/X,Q -OPCODE MACRO TO DO SMALL INTEGER DIVIDES 
*                                                                       000210
*         IXI    XJ/XK,Q                                                000220
*                                                                       000230
*         XI     = RESULT REGISTER                                      000240
*         XJ     = SOURCE REGISTER, J MAY EQUAL I 
*         XK     = TEMPORARY REGISTER, WILL HOLD Q (EXCEPT WHEN Q=8)    000260
*                  K MUST BE DIFFERENT FROM BOTH I AND J
*         B1     = 1
*                                                                       000270
*         Q      = INTEGER DIVISOR.  VALUES OF 3,5,6,8,10,12,15,48,60   000280
*                                    ARE ALLOWED.                       000290
*                                                                       000300
*         THE MAXIMUM RANGE FOR EACH DIVISOR IS GIVEN BELOW..           000310
*                                                                       000320
*         DIVISOR   RANGE               DIVISOR   RANGE                 000330
*            3      131071                10      524286                000340
*            5      262143                12      524284                000350
*            6      262142                15       74908                000360
*            8      2**48 - 1             48     2097136                000370
*           60      299632                                              000380
*          100      174729                                              000390
* **                                                                    000410
          PURGDEF IXX/X,Q                                               000420
*                                                                       000430
 IXX/X,Q  OPDEF  I,J,K,Q                                                000440
 ..1      IFEQ   Q,3                                                    000450
          IDIV   I,J,K,0,125253B,17D                                    000460
 ..1      ELSE                                                          000470
 ..1      IFEQ   Q,5                                                    000480
          IDIV   I,J,K,0,146315B,18D                                    000490
 ..1      ELSE                                                          000500
 ..1      IFEQ   Q,6                                                    000510
          IDIV   I,J,K,1,125253B,17D                                    000520
 ..1      ELSE                                                          000530
 ..1      IFEQ   Q,8                                                    000540
          IFNE   I,J,1                                                  000550
          BX.I   X.J                                                    000560
          AX.I   3                                                      000570
 ..11     SKIP                                                          000580
 ..1      ELSE                                                          000590
 ..1      IFEQ   Q,10                                                   000600
          IDIV   I,J,K,1,146315B,18D                                    000610
 ..1      ELSE                                                          000620
 ..1      IFEQ   Q,12                                                   000630
          IDIV   I,J,K,2,125253B,17D                                    000640
 ..1      ELSE                                                          000650
 ..1      IFEQ   Q,15                                                   000660
          IDIV   I,J,K,0,104211B,19D                                    000670
 ..1      ELSE                                                          000680
 ..1      IFEQ   Q,48                                                   000690
          IDIV   I,J,K,4,125253B,17D                                    000700
 ..1      ELSE                                                          000710
 ..1      IFEQ   Q,60                                                   000720
          IDIV   I,J,K,2,104211B,19D                                    000730
 ..1      ELSE                                                          000740
 ..1      IFEQ   Q,100                                                  000750
          IDIV   I,J,K,2,012173B,17D                                    0002   5
 ..1      ELSE                                                          000770
          ERR    INTEGER DIVIDE WITH UNKNOWN COEFFICIENT                000780
 ..1      ENDIF                                                         000790
 ..11     ENDIF                                                         000800
          ENDM                                                          000810
*                                                                       000820
**    IDIV  -AUXILIARY MACRO FOR INTEGER DIVISION 
*                                                                       000840
 IDIV     MACRO  I,J,K,S1,Q,S2                                          000850
          IFEQ   J,K,1
          ERR    XJ AND XK REGISTERS MUST BE DIFFERENT
 ..3      IFEQ   S1,0 
          SX.K   Q
          IX.I   X.J*X.K
 ..3      ELSE
          IFEQ   I,K,1
          ERR    XI AND XK REGISTERS MUST BE DIFFERENT
 ..4      IFEQ   *P,*P/30D*30D
          SX.K   Q
 ..5      IFEQ   S1,1 
          AX.I   B1,X.J 
 ..5      ELSE
          IFNE   I,J,1
          BX.I   X.J
          AX.I   S1 
 ..5      ENDIF 
 ..4      ELSE
 ..5      IFEQ   S1,1 
          AX.I   B1,X.J 
          SX.K   Q
 ..5      ELSE
 ..6      IFEQ   I,J
          AX.I   S1 
          SX.K   Q
 ..6      ELSE
          BX.I   X.J
          SX.K   Q
          AX.I   S1 
 ..6      ENDIF 
 ..5      ENDIF 
 ..4      ENDIF 
          IX.I   X.I*X.K
 ..3      ENDIF 
          AX.I   S2                                                     000980
 ..11     SKIP                                                          000990
          ENDM                                                          001000
*                                                                       001010
 IMUL     SPACE  2,2
**    IMUL  - INTEGER MULTIPLY OP CODE (IXX*X)
*             ASSEMBLED UNDER CONTROL OF ASSEMBLY PARAMETER I8.IMU
* **                                                                    001060
          PURGDEF IXX*X 
*                                                                       001080
 IMUL     IFEQ   I8.IMU,0                                               TB8   50
*                                                                       TB8   51
 IXX*X    OPDEF  I,J,K                                                  001090
          PX.J   X.J                                                    001100
          IFNE   J,K,1                                                  001110
          PX.K   X.K                                                    001120
          DX.I   X.J*X.K                                                001130
          IFNE   I,J,1                                                  001150
          UX.J   X.J                                                    001160
          IFNE   I,K,2                                                  001170
          IFNE   J,K,1                                                  001180
          UX.K   X.K                                                    001190
          UX.I   X.I
          ENDM                                                          001200
*                                                                       001210
 IMUL     ELSE                                                          TB8   53
*                                                                       TB8   54
 IXX*X    CPSYN  DXX*X       EQUATE TO DOUBLE-PRECISION MULTIPLY        TB8   55
 IMUL     ENDIF 
 EQU      SPACE  2,2
**    EQU  - REPLACE EQU PSEUDO OPERATION TO ALLOW REMOTE EQUS
* **                                                                    001260
          PURGMAC EQU 
*                                                                       001280
          MACRO  EQU,L,Q                                                001290
 .5       IF     -DEF,Q                                                 001300
          RMT                                                           001310
 L = Q                                                                  001320
          RMT                                                           001330
 .5       ELSE                                                          001340
 L = Q                                                                  001350
 .5       ENDIF                                                         001360
          ENDM                                                          001370
 ENTRY    SPACE  2,2
**    E  - MACRO TO PRODUCE ENTRY/EXT LINKAGE STATEMENTS
*          IF THE ADDRESS SYMBOL IS DEFINED, AN "ENTRY" LINE IS PRODUCED
*          OTHERWISE AN "EXT" LINE IS PRODUCED. 
* **                                                                    001420
 TEXX     SET    0
*                                                                       001440
          MACRO  E,L,Q
 .2       IF     DEF,Q
 ENTRY    RMT 
 L = Q
          ENTRY  L
 ENTRY    RMT 
 .2       ELSE
 EXT      RMT 
          EXT    L
 Q = L
 EXT      RMT 
 .2       ENDIF 
          ENDM
 SYMBOL   SPACE  2,2
**    SYMBOL  - INVENT A NEW (UNIQUE) SYMBOL, ASSIGN TO A MICRO 
*                                                                       003100
          MACRO  SYMBOL,L                                               003110
          LOCAL  X                                                      003120
 L        MICRO  1,,*_X_*                                               003130
          ENDM                                                          003140
          SPACE  4
****  PARAMETERIZED CONSTANT AREA 
* 
* ERROR TYPES 
* 
 E.PAR    =      0           PARAMETER
 E.SCN    =      1           SCAN 
 E.TST    =      2           TEST 
 E.CON    =      3           CONVERT
 E.IO     =      4           I-O
          SPACE  2                                                      001980
*                                                                       001990
* HEXADECIMAL CONSTANTS                                                 002000
*                                                                       002010
 X20      =      040B                                                   002020
 X2D      =      055B 
 X30      =      060B                                                   002030
 X40      =      100B                                                   002040
 XF0      =      360B                                                   002050
 XFF      =      377B                                                   002060
          SPACE  2                                                      002070
*                                                                       002080
* CHARACTER SET CONSTANTS                                               002090
*                                                                       002100
 SPACE.C  =      X40         EBCDIC                                     002110
 SPACE.A  =      X20         ASCII                                      002120
 SPACE.X  =      1R          DISPLAY                                    002130
 SPACE.P  =      0           PUNCH                                      002140
*                                                                       002150
 ZERO.C   =      XF0         EBCDIC                                     002160
 ZERO.A   =      X30         ASCII                                      002170
 ZERO.X   =      1R0         DISPLAY                                    002180
 ZERO.P   =      1000B       PUNCH                                      002190
* 
 ONE.P    =      0400B       PUNCH
* 
 MINUS.A  =      X2D         ASCII
*                                                                       002200
 SIZE.C   =      12          EBCDIC - INTERNAL                          002210
 SIZE.A   =      12          ASCII - INTERNAL                           002220
 SIZE.X   =      6           DISPLAY                                    002230
 SIZE.P   =      12          PUNCH                                      002240
****
 ENTRY1   SPACE  4,4
 E        RMT 
          LIST   *
 ENTRY    HERE
          CTEXT 
 EXT      HERE
          ENDX
 E        RMT 
* 
****  THE FOLLOWING ENTRY POINTS ARE KNOWN TO ROUTINES CALLING COM1 
* 
          RMT                                                           003370
          LIST   -L,-R
 XMOVE    E      XMOVE
 XCOMP    E      XCOMP
 XPACK    E      XPACK
 XPAND    E      XPAND
 T8.ERR   E      ERR.CON
 T8.ERRI  E      ERR.IO 
 T8.HXTB  E      HEXTAB 
 T8.6TAB  E      SIXTAB 
 T8.NXBT  E      NXBITS 
 D.BDP    E      BDPTAB 
 T8.TDCK  E      TDCRACK
* 
 T8.CMAX  E      C.MAXSZ
 T8.EFIL  E      H.ERFIL
 T8.CNVT  E      T.CNVT 
 T8.RXTA  E      TR.XTOA
 T8.RXTC  E      TR.XTOC
 T8.RATX  E      TR.ATOX
 T8.RATC  E      TR.ATOC
 T8.RCTX  E      TR.CTOX
 T8.RCTA  E      TR.CTOA
 T8.RCTP  E      TR.CTOP
 T8.RPTC  E      TR.PTOC
 T8.RBTA  E      TR.BTOA
 T8.RBTC  E      TR.BTOC
 T8.RBTP  E      TR.BTOP
 T8.RBTX  E      TR.BTOX
 T8.XATP  E      TX.ATOP
 T8.XCTP  E      TX.CTOP
 T8.XXTP  E      TX.XTOP
 T8.A0    E      T.A0 
 T8.COB   E      T.COB
 T8.EENT  E      T.EENT 
 T8.EMSG  E      T.EMSG 
 T8.ENTR  E      T.ENTRY
 T8.EXL1  E      T.EXL1 
 T8.EXL2  E      T.EXL2 
 T8.FIT   E      T.FIT
 T8.LEN1  E      T.LEN1 
 T8.LEN2  E      T.LEN2 
 T8.POS1  E      T.POS1 
 T8.POS   E      T.POS
 T8.POS2  E      T.POS2 
 T8.SVA0  E      T.SAVEA0 
 T8.SRC1  E      T.SRC1 
 T8.SRC2  E      T.SRC2 
 T8.STAT  E      T.STAT 
 T8.STTS  E      T.STATUS 
 T8.S1    E      T.S1 
 T8.S2    E      T.S2 
 T8.XY    E      T.XY 
****
          IF     -DEF,T8.COM2,1 
 E        HERE
          RMT 
*                                                                       003310
          TITLE 
          LIST   R
          ENDX
