*
         ERROR,*   'BASIC SYSTEM PROCEDURES ****'
*
*    DEFINE MASKS USED BY PROCEDURES
*
         DO1      TCOR(MASKS,S:UND)
         SREF     MASKS
*
CSTMAD   EQU      MASKS+17
CSTMAP   EQU      MASKS+24
CSTMBY   EQU      MASKS+08
CSTMHW   EQU      MASKS+16
CSTMF    EQU      MASKS
*
*********************************************
* THESE ARE TO BE USED WITH SHIFT OPERATIONS
*
LEFT     FNAME    1
RIGHT    FNAME    -1
         PROC
         PEND     AF*NAME
*
*************************************************
*
*    DEFINE VALUES TO ACCESS ITEM LISTS
*
*
I          EQU       2
P          EQU       3,1
D          EQU       3,1
L          EQU       3,2
M          EQU       3,2
A          EQU       4
*
         PAGE
*******************    REGISTERS  EQUIVALENCES  ************************
*
R0         EQU       0
R1         EQU       1
R2         EQU       2
R3         EQU       3
R4         EQU       4
R5         EQU       5
R6         EQU       6
R7         EQU       7
R8         EQU       8
R9         EQU       9
R10        EQU       10
R11        EQU       11
R12        EQU       12
R13        EQU       13
R14        EQU       14
R15        EQU       15
*
********************     REGISTERS  EQUIVALENCES (BPM CONVENTIONS) *****
*
SR1        EQU       8
SR2        EQU       9
SR3        EQU       10
SR4        EQU       11
D1         EQU       12
D2         EQU       13
D3         EQU       14
D4         EQU       15
           PAGE
           SPACE     3
************************************************************************
*
*
*        STANDARD PROCEDURES FOR TP UNDER CP-V
*
*
************************************************************************
          PAGE
           OPEN      Z,A,X,ADR,TSH,TOP,AST,MESS1,TOC,TYP
          OPEN      MESS2,MESS3,MESS4,MESS5,MESS6,MESS7,MESS8
          OPEN      MESS9,MESS10,TOF,USER1,USEMESS3,R
          OPEN      MESS11,MESS12,MESS13
           OPEN      REGPERM,CONFLICT1,CONFLICT2
           OPEN      CONFLICT3
           OPEN      TYPE2
           OPEN      CALAD,GENM,GENA
         OPEN CDWORD#,CWORD#,CHWORD#,CBYTE#,CADR#,CFIELD#
         OPEN LDW#,LWORD#,LHW#,LBYTE#,LADR#,LFIELD#
         OPEN SDW#,SWORD#,SHW#,SBYTE#,SADR#,SFIELD#
         OPEN TBIT#,SBIT#,RBIT#,IBIT#,MTWORD#,MTHWORD#,MTBYTE#
*
A          SET       0
R          SET       0
X          SET       0
ADR        SET       0
USER1     SET       0
TSH        EQU       31,7,15,31,31
TOP        EQU       X'32',X'72',X'52',X'32',X'32',X'47',X'32',X'45'
TOF      EQU      X'52',X'55',X'72',X'75',X'12',X'15',X'73',X'53',X'33';
                 ,X'71',X'51',X'31',X'11',,X'52'
MESS1      EQU       'FIELD TOO LARGE'
MESS2     EQU       'TYPE CONFLICT'
MESS3     EQU       'WORK REG NOT USED'
MESS4     EQU       'WORK REG NEEDED. 7 USED'
MESS5     EQU       'DIRECT AD NOT ALLOWED'
MESS6     EQU       'L(3) NOT A LIST'
MESS7     EQU       'BIT POS GT 31'
MESS8     EQU       'ODD REGISTER USED'
MESS9      EQU       'CONFLICT. REG X ALREADY USED'
MESS10     EQU       'WARNING. X DESTROYED'
MESS11   EQU       'WARNING. BASE USED AS INDIRECT ADDR'
MESS12     EQU       'ILLEGAL CF'
MESS13     EQU       'ILLEGAL AF'
TOC        EQU       X'49',X'4B',X'48',X'4B'
TYP        EQU       6,6,6,6,5,5,5,4,4,4
TYPE2     EQU       2,2,3,3,0,0,3,2,1,3,2,1,0
*
********************    CALCULATE ADDRESS PARAMETERS PROCEDURE (WORK) **
*
*
*        CALLING SEQUENCE :
*                  CALAD,R,X  NUM(AF),AF(2)
*
* REGPERM=1 SIGNIFIES THE CONTENTS OF R MAY BE DESTROYED
* USER1=1 SIGNIFIES THE MACRO USES R AND R+1 (REGISTER PAIR)
* CALAD IS THE PROCEDURE WHICH DECODES THE COMMAND AND
* ADDRESS PARTS OF THE MACRO-INSTRUCTION. THE GENERAL
* SYNTAX OF THE MACRO IS:
*
*                 MACRONAME,R,X1   IDENTIFIER,*ADDRESS|*REGISTER|X2
*
* X1, ADDRESS, AND REGISTER MAY BE OMITTED OR MAY HAVE
* VARIOUS FORMS.
* OUTPUT FROM CALAD IS THE FOLLOWING:
*
*    X CONTAINS THE NUMBER OF THE INDEX TO USE (ZERO IF NONE)
*    R CONTAINS THE NUMBER OF THE REGISTER TO USE
*    ADR CONTAINS THE TYPE OF ADDRESSING, NAMELY
*       1) ADR=2   INDEXED
*       2) ADR=4   ABSOLUTE
*       3) ADR=-1  IF BASE+DISPLACEMENT WITH DISPLACEMENT=0,
*                  WHICH MEANS THE ADDR IS *BASE DIRECTLY.
*
*    AST=1 IF *BASE, OTHERWISE ZERO
*    CONFLICT1=1 IF X=R AND REGPERM IS SET
*    CONFLICT2=1 IF X=R OR R|1 (FOR USER1=1) AND REGPERM IS NOT SET
*
            PAGE
*
CALAD      CNAME
           PROC
USEMESS3  SET       CF(3)~=0
AST        SET       0
R          SET       CF(2)
           DO        AF(1)=1
          ERROR,1,NUM(Z)<4    MESS5
X          SET       0
ADR        SET       4
           ELSE
         DO       AFA(2)
          DO        Z(2)=0
ADR        SET       -1
X          SET       0
AST        SET       1
           ELSE
ADR        SET       2
           DO       CF(3)=0
           DO        REGPERM&(R<8)&(R~=0)
X          SET       R
           ELSE
           ERROR,1,1 MESS4
X          SET       7
           FIN
           ELSE
USEMESS3  SET       0
X          SET       CF(3)
           FIN
         GEN,8,4,3,17  X'32',X,0,AF(2)
           FIN
           ELSE
ADR        SET       2
X          SET       AF(2)
          ERROR,*,(X=R)&REGPERM&(X~=0)   MESS10
           FIN
           FIN
         ERROR,*,USEMESS3   MESS3
CONFLICT1  SET       (X=R)&REGPERM&(X~=0)
CONFLICT2  SET   ((X=R)|(X=(R|1)))&~REGPERM&(X~=0)
CONFLICT3  SET       (X=R)&~REGPERM&(X~=0)
           PEND
*
*
********************    GENERATE MASK PROCEDURE   (WORK)  **************
*
*
* GENM SETS THE VALUE OF A BIT MASK. THE BIT POSITION IS THE
* 1ST ARGUMENT, THE 2ND ARGUMENT INDICATES WHETHER THE MASK
* IS POSITIVE OR NEGATIVE (I.E. BIT ON OR OFF).  GENM IS USED
* WHEN THE BIT POSITION IS >12, AND WE CAN USE   LI,R MASK.
* (INSTEAD OF LW,R  MASK:TABLE+BIT,POS ).
*
GENM       FNAME
           PROC
          LOCAL     Z
           ERROR,1,AF(1)>31  MESS7
Z          SET       1**(31-AF(1))
           DO1       AF(2)
Z          SET       ~Z&X'FFFFF'
          PEND      Z
*
********************  GENERATE CONDITIONAL ADDRESS PROCEDURE (WORK)  ***
*
*
* IF THE 5TH PARAMETER OF GENA IS ZERO, THE GENERATED ADDRESS
* IS THE 6TH PARAMETER,  OTHERWISE IT IS THE 7TH. PARAMETERS
* 1,2,3, AND 4 ARE RESPECTIVELY, THE INDIRECT BIT, THE OP CODE,
* THE REGISTER, AND THE INDEX.
*
*
GENA       CNAME
           PROC
           GEN,1,7,4,3,17  AF(1),AF(2),AF(3),AF(4),AF(6+AF(5))
           PEND
*
******************** BIT MANIPULATION PROCEDURE  ***********************
*
SBIT       CNAME     1
RBIT       CNAME     2
IBIT       CNAME     3
TBIT       CNAME     4
SBIT#    FNAME     1
RBIT#    FNAME     2
IBIT#    FNAME     3
TBIT#    FNAME     4
           PROC
         ERROR,1,(NUM(CF)<2)|(NUM(CF)>3)   MESS12
         ERROR,1,(NUM(AF)<1)|(NUM(AF)>2)   MESS13
           LOCAL     NMERR,1G,2G,3G,4G
USER1      SET       0
REGPERM    SET       NAME=4
*
*
Z          SET       S:IFR(AF(1))
         GOTO,TCOR(Z,S:LIST)=0     4G
           GOTO,TYP(NAME)~=Z(1)     NMERR
          ERROR,1,NUM(Z(3))~=2     MESS6
           BOUND     4
LF         RES       0
           CALAD,CF(2),CF(3)   NUM(AF),AF(2)
           GOTO,CONFLICT3  2G
           GOTO,CONFLICT1  3G
          DO        Z(3,1)>12
*
* GENERATE THE MASK IN R (NEGATIVE IF RBIT).
*
           GEN,8,4,20  X'22',R,GENM(Z(3,1),NAME=2)
           ELSE
         GENA     0,X'32',R,0,NAME=2,Z(3,2),NB31TO0+32-Z(3,1)
           FIN
*
* GENERATE THE OPERATION. THE INDEX EXPRESSION FROM TOC INDICATES
* IF  :    NORMAL CASE  -  SBIT  USES     OR,R ELEMENT
*                          RBIT           AND,R ELEMENT
*                          IBIT           EOR,R ELEMENT
*                          TBIT           AND,R ELEMENT
*          SBIT CASE WITH AN ODD REG:     STS   (EQUIVALENT TO 'OR')
*
           GENA      AST,TOC(NAME)-2*(R&1&(NAME=1)),;
                         R,X,(ADR>0),AF(2),Z(ADR)
*
* THE ABOVE EXPRESSION IMPLIES THAT, IF THIS IS NOT A TBIT OR AN
* SBIT WITH AN ODD REGISTER, WE NOW MUST STORE THE RESULT.
*
           DO1       ((NAME=4)|R&1&(NAME=1))||1
           GENA      AST,X'35',R,X,(ADR>0),AF(2),Z(ADR)
           GOTO,1    1G
*
* SPECIAL CASE : R=X (PERMITTED FOR TBIT ONLY)
*           WE GENERATE    LW,R   ELEMENT,R
*                          AND,R  MASK
*
3G         GENA      AST,X'32',R,X,ADR>0,AF(2),Z(ADR)
           GEN,8,4,3,17  X'4B',R,0,Z(3,2)
           GOTO      1G
NMERR     ERROR,1,1   MESS2
           GOTO      1G
2G         ERROR,1,1   MESS9
          GOTO    1G
4G        ERROR,1,1   MESS13
1G         PEND
*
********************    FIELD MANIPULATION PROCEDURE *******************
*
SFIELD     CNAME     5
LFIELD     CNAME     6
CFIELD     CNAME     7
SFIELD#  FNAME     5
LFIELD#  FNAME     6
CFIELD#  FNAME     7
           PROC
         ERROR,1,(NUM(CF)<2)|(NUM(CF)>3)   MESS12
         ERROR,1,(NUM(AF)<1)|(NUM(AF)>2)   MESS13
           OPEN      P,N
           LOCAL     NMERR,1G,2G,4G
REGPERM    SET       NAME=6
Z          SET       S:IFR(AF(1))
USER1     SET       NAME&1
         GOTO,TCOR(Z,S:LIST)=0    4G
           GOTO,TYP(NAME)~=Z(1)     NMERR
          ERROR,1,NUM(Z(3))~=2    MESS6
         BOUND    4
LF         RES       0
           CALAD,CF(2),CF(3)   NUM(AF),AF(2)
           GOTO,CONFLICT2   2G
N         SET       Z(3,2)
P         SET       Z(3,1)
         GOTO,P<32&P>-1&N<20&N>0  1G
         ERROR,1,1   MESS1
         DO1      P<0
P        SET      0
         DO1      P>31
P        SET      31
         DO1      (P-N)<-1
N        SET      P+1
         DO1      N>19
N        SET      19
1G       SET      0
          DO        NAME=5|NAME=7
*
* IF SFIELD, GENERATION OF  LI,R|1  MASK   (RIGHT JUSTIFIED)
*                           SLD,R   VALUE  IF FIELD NOT RT JUSTIFIED
*                           STS,R   ELEMENT
*
* NOTE THAT R IS NOT RIGHT JUSTIFIED AT THE COMPLETION OF THE
* PROCEDURE (I.E. R IS NOT MAINTAINED).
*
           ERROR,0,R&1  MESS8
           GEN,8,4,20  X'22',R|1,X'7FFFF'**(N-19)
           DO1       (31-P)>0
           GEN,8,4,13,7  X'25',R,2,31-P
           GENA      AST,TOP(NAME+1),R,X,ADR>0,AF(2),Z(ADR)
           ELSE
*
* IF LFIELD, THE PROCEDURE IS MORE COMPLEX.
* A=1 IF INDEX > 0, OTHERWISE A=2+P/8. THIS IS BECAUSE IN
* THE 1ST CASE WE GENERATE AN LW (BECAUSE THE INDEX CONTAINS
* A WORD DISPLACEMENT).  IN THE 2ND CASE, AN LB, LH, OR LW
* DEPENDING ON WHETHER THE FIELD IS IN THE 1ST BYTE, 1ST HW,
* OF THE WORD OR NOT.
*
* GENERATION OF A SHIFT FOLLOWS, IF THE FIELD IS NOT RIGHT
* JUSTIFIED, FOLLOWED BY ANY NECESSARY MASKING.
*
A          SET       (X=0)+1+P/8*(X=0)
           GENA      AST,TOP(A),R,X,ADR>0,AF(2),Z(ADR)
           DO1      (TSH(A)-P)~=0
           GEN,8,4,13,7  X'25',R,0,P-TSH(A)
         GEN,8,4,3,17  X'4B',R,0,CSTMF+N
           FIN
           GOTO,1  1G
NMERR     ERROR,1,1   MESS2
           GOTO      1G
2G         ERROR,1,1  MESS9
         GOTO     1G
4G       ERROR,1,1   MESS13
1G         CLOSE     N,P
           PEND
*
********************    ADDRESS  MANIPULATION PROCEDURE  ***************
*
SADR       CNAME     7
LADR       CNAME     8
CADR       CNAME     9
SADR#    FNAME     7
LADR#    FNAME     8
CADR#    FNAME     9
           PROC
         ERROR,1,(NUM(CF)<2)|(NUM(CF)>3)   MESS12
         ERROR,1,(NUM(AF)<1)|(NUM(AF)>2)   MESS13
*
* SADR AND LADR : IN THE CASE OF AN ADDRESS FIELD WHICH IS
* DEFINED IN THE LEFT BYTES OF A WORD (I.E. ELEMENT 3 OF THE
* LIST = 0).
*        WE GENERATE : FOR  SADR   LI,R|1  MASK
*                                  SLD,R   8   (OPTIONALLY)
*                                  STS,R   ELEMENT
*                      FOR  LADR   LW,R    ELEMENT
*                                  SLS,R   -8   (OPTIONALLY)
*                                  AND,R   MASK
*
           LOCAL     NMERR,1G,2G,4G
USER1     SET       NAME&1
REGPERM    SET       NAME=8
Z          SET       S:IFR(AF(1))
         GOTO,TCOR(Z,S:LIST)=0   4G
           GOTO,TYP(NAME+1)~=Z(1) NMERR
           BOUND     4
LF         RES       0
           CALAD,CF(2),CF(3)   NUM(AF),AF(2)
           GOTO,CONFLICT2   2G
           DO        NAME=7|NAME=9
           ERROR,0,R&1  MESS8
           GEN,8,4,3,17  X'32',R|1,0,CSTMAP
          DO1       Z(3)=0
           GEN,8,4,13,7  X'25',R,2,8
           FIN
           GENA      AST,TOP(NAME-1),R,X,ADR>0,AF(2),Z(ADR)
           DO        NAME=8
          DO1       Z(3)=0
           GEN,8,4,13,7  X'25',R,0,-8
           GEN,8,4,3,17  X'4B',R,0,CSTMAP
           FIN
           GOTO,1  1G
NMERR     ERROR,1,1   MESS2
           GOTO      1G
2G         ERROR,1,1  MESS9
          GOTO    1G
4G        ERROR,1,1   MESS13
1G         PEND
*
********  BYTE, HALFWORD & DOUBLEWORD MANIPULATION PROCEDURE  ********
*
LHW      CNAME     1
SHW      CNAME     2
LBYTE    CNAME     3
SBYTE    CNAME     4
LDW      CNAME     5
SDW      CNAME     6
MTBYTE   CNAME     7
MTHWORD  CNAME     8
CBYTE    CNAME     10
CHWORD   CNAME     11
CDWORD   CNAME     13
LHW#     FNAME     1
SHW#     FNAME     2
LBYTE#   FNAME     3
SBYTE#   FNAME     4
LDW#     FNAME     5
SDW#     FNAME     6
MTBYTE#  FNAME     7
MTHWORD# FNAME     8
CBYTE#   FNAME     10
CHWORD#  FNAME     11
CDWORD#  FNAME     13
           PROC
         ERROR,1,(NUM(CF)<2)|(NUM(CF)>3)   MESS12
         ERROR,1,(NUM(AF)<1)|(NUM(AF)>2)   MESS13
*
* HERE WE DO NOT USE CALAD, BECAUSE THE INDEX IS NOT
* A DISPLACEMENT WITHIN THE WORD, BUT A DISPLACEMENT FROM
* THE BEGINNING OF THE TABLE.  THEREFORE, EVEN IF THE BASE
* IS AN INDEX, IT WILL STILL BE USED AS *BASE.
*
         LOCAL     NMERR,1G,2G,3G,4G
X        SET       0
Z          SET       S:IFR(AF(1))
         GOTO,TCOR(Z,S:LIST)=0    4G
           GOTO,TYPE2(NAME)~=Z(1)   NMERR
         BOUND    4
LF       RES       0
REGPERM  SET      NAME=1|NAME=3|NAME=5
R        SET      CF(2)
         ERROR,1,(NUM(AF)=1)&(NUM(Z)<4)   MESS5
           DO    (NUM(AF)=1)&(Z(3)=0)|(NUM(AF)=2)&(Z(2)=0)
X        SET       0
         ERROR,*,CF(3)~=0   MESS3
         ELSE
         GOTO,(NUM(AF)=1&Z(1)=0)    3G
         DO       CF(3)=0
         DO       (R<8)&(R~=0)&REGPERM
X        SET      R
         ELSE
         GOTO,NUM(AF)=1     2G
         ERROR,1,1  MESS4
X        SET      7
         FIN
         ELSE
X        SET      CF(3)
         FIN
         FIN
*
* GENERATION  OF :     LI,X  DISPLACEMENT (OPTIONALLY)
*                      LB,R OR LH,R OR LD,R  ELEMENT,INDEXED OR NOT
*
AST      SET      NUM(AF)=2
         DO        X~=0
A         SET      S:UFV(AF(2))
          ERROR,1,X=A   MESS9
         ERROR,*,(A=R)&REGPERM    MESS10
         GEN,8,4,20  X'22',X,Z(3-AST)
         FIN
         GENA      AST,TOF(NAME),R,X,AST,Z(4),AF(2)
         GOTO      1G
*
* EXTRA SPECIAL CASE ...ETC...
*
* IN CASE YOU WONDER WHAT ALL THIS EXTRA CODE IS FOR
* THE READER WISHING TO UNDERSTAND THE FOLLOWING PROCEDURE
* SHOULD NOTE THAT THESE CONDITIONS ARE PRESENT:
*
*        1) THE DISPLACEMENT IS NOT ZERO
*        2) THE WORK INDEX IS MISSING
*        3) THE OPERATION IS A LOAD
*        4) R IS NOT AN INDEX
*        5) IT CONCERNS AN ABSOLUTE ADDRESS
*        6) THE PROGRAMMER HAS BEEN
*                 A) FORGETFUL
*                 B) LUCKY-AS IT WORKS
*
* GENERATION OF    LW,R  ELEMENT
*                 SLS,R  VALUE     (FOR BYTE OPERATIONS)
*                 AND,R  BYTE:MASK OR HW:MASK
*
2G       SET      0
         GEN,8,4,3,17 X'32',CF(2),0,Z(4)
           DO1      (Z(3)<3)&(NAME>2)
           GEN,8,4,3,17  X'25',CF(2),0,(-8*(3-Z(3)))&X'7F'
         GENA      0,X'4B',CF(2),0,NAME>2,CSTMHW,CSTMBY
         GOTO      1G
* LDW OR SDW FOR AN ABSOLUTE ADDRESS
* GENERATION OF        LD,R OR STD,R   ELEMENT
3G       ERROR,*,CF(3)~=0   MESS3
         GENA      0,TOF(NAME),CF(2),0,0,Z(4),Z(4)
         GOTO      1G
NMERR    ERROR,1,1   MESS2
         GOTO     1G
4G       ERROR,1,1   MESS13
1G         PEND
*
         OPEN      OPCODE
OPCODE   EQU       X'32',X'35',X'31',X'33'
*
LWORD    CNAME     1
SWORD    CNAME     2
CWORD    CNAME     3
MTWORD   CNAME     4
LWORD#   FNAME     1
SWORD#   FNAME     2
CWORD#   FNAME     3
MTWORD#  FNAME     4
         PROC
         ERROR,1,(NUM(CF)<2)|(NUM(CF)>3)   MESS12
         ERROR,1,(NUM(AF)<1)|(NUM(AF)>2)   MESS13
         LOCAL     NMERR,1G,4G
REGPERM  SET       NAME=1
Z        SET       S:IFR(AF(1))
         GOTO,TCOR(Z,S:LIST)=0   4G
         GOTO,Z(1)~=1  NMERR
         BOUND     4
LF       RES       0
         CALAD,CF(2),CF(3)   NUM(AF),AF(2)
         GENA      AST,OPCODE(NAME),R,X,ADR>0,AF(2),Z(ADR)
         GOTO      1G
NMERR    ERROR,1,1  MESS2
         GOTO     1G
4G       ERROR,1,1   MESS13
1G       PEND
         CLOSE     OPCODE
*
*
           CLOSE     Z,A,X,ADR,TSH,TOP,AST,MESS1,TOC,TYP
          CLOSE     MESS2,MESS3,MESS4,MESS5,MESS6,MESS7,MESS8
           CLOSE     MESS9,MESS10,TOF,USER1,USEMESS3,R
           CLOSE     REGPERM,CONFLICT1,CONFLICT2
           CLOSE     CONFLICT3
           CLOSE     TYPE2
           CLOSE     CALAD,GENM,GENA
*
           PAGE
*
* THESE PROCEDURES ARE DESIGNED TO GENERATE THE SYMBOLIC
* ADDRESSING LISTS OF THE TP TABLES BASED ON STANDARD
* CONVENTIONS
*
*
           OPEN      ADBASE,X,LIST,I,J
*
*******************  TABLE ADDRESSING MODE
*
ADMODE     CNAME
           PROC
X          SET       SCOR(AF(1,1),DIR)
           DO        X=1
ADBASE     SET       AF(1,2)
           FIN
           PEND
*
*
*******************  TYPES WORD AND DOUBLEWORD
*
DWORD      CNAME     0
WORD       CNAME     1
           PROC
LIST       SET       NAME,AF(1),-1
           DO        X=1
I          SET       1+(NAME=0)
LF         EQU       LIST,ADBASE+I*AF(1)
           ELSE
LF         EQU       LIST
           FIN
           PEND
*
*******************  TYPES HALFWORD AND BYTE
*
HWORD      CNAME     2
BYTE       CNAME     3
           PROC
I          SET       4-2*(NAME=2)
J          SET       (AF(1)+1*(AF(1)<0))/I-1*(AF(1)<0)
LIST       SET       NAME,AF(1),AF(1)-J*I
           DO        X=1
LF         EQU       LIST,ADBASE+J
           ELSE
LF         EQU       LIST
           FIN
           PEND
*
*******************  TYPES ADDRESS, FIELD AND ZONE
*
ADDR       CNAME     4
FIELD      CNAME     5
ZONE       CNAME     7
           PROC
LIST       SET       NAME,AF(1),(AF(2))
           DO        X=1
LF         EQU       LIST,ADBASE+AF(1)
           ELSE
LF         EQU       LIST
           FIN
           PEND
*
*******************  TYPE BIT
*
BIT        CNAME     6
           PROC
LIST     SET      NAME,AF(1),(AF(2),BT31TO0+32-AF(2))
           DO        X=1
LF         EQU       LIST,ADBASE+AF(1)
           ELSE
LF         EQU       LIST
           FIN
           PEND
*
******************   TYPE  STRING
*
STRING   CNAME     8
         PROC
LIST     SET       NAME,AF(1),AF(2)
         DO        X=1
LF       EQU       LIST,ADBASE
         ELSE
LF       EQU       LIST
         FIN
         PEND
*
           CLOSE     ADBASE,X,LIST,I,J
          OPEN      ITEM,TYPE,ERR,S:T,G1
*
*   THIS FUNCTION GENERATES THE CODE FOR THE PARTICULAR
*   COMMAND REQUESTED IN THE FOLLOWING GENERALIZED PROCEDURES.
*
S:T      FNAME
         PROC
         SET,CF(2),CF(3)  AF(AF(1)+2)
         PEND
         PAGE                                                           IRBT0012
***************************************************************
*
*    THE FOLLOWING PROCEDURES CALL ON THE TP PROCS
*    AND ALLOW USE OF THE TABLE DEFINITIONS WITHOUT
*    REGARD TO THE SIZE OR TYPE OF THE ITEM.
*
*    THE GENERAL FORMAT IS:
*
*    (LF)       MACRONAME,R(,RX)   ITEM(,X2|*REGISTER|*ADDRESS)
*
*
*    R AND RU1 ARE USED FOR DW, ADDR, AND FIELD ITEMS IF REQUIRED.
*
*
*****************************************************************
*
*    GENERATE ERROR MESSAGE FOR BIT ITEMS
*
ERR      FNAME
         PROC
         ERROR,1,1  'INVALID OPERATION ON A BIT ITEM'
         PEND
*
C        CNAME   1
GET      CNAME   2
L        CNAME   2
ST       CNAME   3
SETI     CNAME   4
RESETI   CNAME   5
T        CNAME   6
         PROC
ITEM     SET     AF(1)
         LOCAL    G1,G2,G3,G4,G5,G6,G7
TYPE     SET      TCOR(ITEM,S:LIST)=0
         ERROR,1,TYPE   'ILLEGAL AF'
         GOTO,TYPE  G1
TYPE     SET     ITEM(1)
         BOUND 4
LF       EQU      %
       DO        TYPE<7
         GOTO,NAME    G2,G3,G4,G5,G6,G7
G2       SET      0
         SET,CF(2),CF(3) S:T(TYPE,CDWORD#(AF),CWORD#(AF),CHWORD#(AF),;
             CBYTE#(AF),CADR#(AF),CFIELD#(AF),ERR)
         GOTO     G1
*
G3       SET      0
         SET,CF(2),CF(3)  S:T(TYPE,LDW#(AF),LWORD#(AF),LHW#(AF),;
             LBYTE#(AF),LADR#(AF),LFIELD#(AF),TBIT#(AF))
         GOTO     G1
*
G4       SET      0
         SET,CF(2),CF(3)  S:T(TYPE,SDW#(AF),SWORD#(AF),SHW#(AF),;
             SBYTE#(AF),SADR#(AF),SFIELD#(AF),ERR)
         GOTO     G1
*
G5       SET      0
         DO       TYPE<6
         GEN,8,4,20   X'22',CF(2),-1
         DO1      (CF(2)||1)&(TYPE=0)
         GEN,8,4,20   X'22',CF(2)+1,-1
         FIN
         SET,CF(2),CF(3)  S:T(TYPE,SDW#(AF),SWORD#(AF),SHW#(AF),;
             SBYTE#(AF),SADR#(AF),SFIELD#(AF),SBIT#(AF))
         GOTO     G1
*
G6       SET      0
         DO       TYPE<6
         GEN,8,4,20   X'22',CF(2),0
         DO1     (CF(2)||1)&(TYPE=0)
         GEN,8,4,20   X'22',CF(2)+1,0
         FIN
         SET,CF(2),CF(3)  S:T(TYPE,SDW#(AF),SWORD#(AF),SHW#(AF),;
             SBYTE#(AF),SADR#(AF),SFIELD#(AF),RBIT#(AF))
         GOTO     G1
*
G7       SET      0
         SET,CF(2),CF(3)  S:T(TYPE,LDW#(AF),MTWORD#(AF),MTHWORD#(AF),;
             MTBYTE#(AF),LADR#(AF),LFIELD#(AF),TBIT#(AF))
         GOTO     G1
         ELSE
         DO     TYPE=7|TYPE=8
         ERROR,7,1   'ZONE AND STRING NOT IMPLEMENTED'
         ELSE
         ERROR,1,1   'ILLEGAL AF'
         FIN
         FIN
G1       PEND
         CLOSE     ITEM,TYPE,ERR,S:T,G1
         CLOSE  CDWORD#,CWORD#,CHWORD#,CBYTE#,CADR#,CFIELD#
         CLOSE  LDW#,LWORD#,LHW#,LBYTE#,LADR#,LFIELD#
         CLOSE  SDW#,SWORD#,SHW#,SBYTE#,SADR#,SFIELD#
         CLOSE  TBIT#,SBIT#,RBIT#,IBIT#
         CLOSE  MTWORD#,MTHWORD#,MTBYTE#
         CLOSE    MESS11,MESS12,MESS13
*
         OPEN     USEREF,G1,J
USEREF   SET      0
*
*   THESE PROCEDURES GENERATE THE NECESSARY REFS OR TABLES  FOR
*   BT31TO0, NB31TO0, AND MASKS IF THEY ARE NOT ALREADY
*   REFED.  NOTE:  THEY MAY OR MAY NOT BE REFED
*   IN  'SYSTEM  UTS'.
*
GENREFS  CNAME    1
GENTABS  CNAME    2
         PROC
         LOCAL    J,G1
         GOTO,USEREF   G1
USEREF   SET      1
         DO       NAME=1
         ERROR,*,TCOR(BT31TO0,S:EXT)=0   ;
 '                                              REF      BT31TO0'
         DO1      TCOR(BT31TO0,S:EXT)=0
         REF      BT31TO0
         ERROR,*,TCOR(NB31TO0,S:EXT)=0    ;
 '                                              REF      NB31TO0'
         DO1      TCOR(NB31TO0,S:EXT)=0
         REF      NB31TO0
         ERROR,*,TCOR(MASKS,S:EXT)=0      ;
 '                                              REF      MASKS'
         DO1      TCOR(MASKS,S:EXT)=0
         REF      MASKS
         FIN
         DO       NAME=2
         DEF      BT31TO0,NB31TO0,MASKS
         ERROR,*     ;
 '                                              DEF      BT31TO0'
         ERROR,*     ;
 '                                              DEF      NB31TO0'
         ERROR,*     ;
 '                                              DEF      MASKS'
         BOUND    4
BT31TO0  EQU      %-1
         ERROR,*     ;
 '                                     BT31TO0  EQU      %-1'
J        DO       32
         DATA     1**(J-1)
         FIN
NB31TO0  EQU      %-1
         ERROR,*     ;
 '                                     NB31TO0  EQU      %-1'
J        DO       32
         DATA     X'FFFFFFFF'-1**(J-1)
         FIN
MASKS    EQU      %-1
         ERROR,*     ;
 '                                     MASKS    EQU      %-1'
J        DO       32
         DATA     -1+1**J
         FIN
