*DECK CGENTXT 
          IDENT CGENTXT 
          SST 
          STEXT 
          NOREF  #STATNUM,#GLOBNUM,OBJNUM,#T1 
          NOREF  I#,MACNUM,MACOFF 
          SPACE  2
 #        OPSYN  NIL
          SPACE  2
*CALL DEF 
*CALL M$
*CALL W$
  
**        STATUS -  DECLARE NAME OF STATUS LIST 
* 
*         STATUS  <STATUS NAME> 
  
  
          PURGMAC  STATUS 
 STATUS   MACRO  STATNAME 
          IFC    EQ,*STATNAME*FIXED*
 FIXFLAG  SET    1
          ELSE
 FIXFLAG  SET    0
          ENDIF 
 #STATNUM SET    0
 STATUS   ENDM
  
 FIXEDOFF EQU    100000B
          NOREF  FIXEDOFF 
  
  
  
**        , -  DEFINE A STATUS CONSTANT 
* 
*              ,  <MNEMONIC>
* 
*         EQUATES THE COMPASS SYMBOL /STATNAME/MNEMONIC TO THE
*           ORDINAL IN THE STATUS LIST. 
* 
*         NOTE-  THE MACRO *,* CAN BE DEFINED ONLY ONCE SINCE IT IS 
*           THE ONLY MACRO THAT CANNOT BE PURGED  (SINCE IT IS THE
*           CHARACTER DELIMITING MACRO NAMES ON THE *PURGMAC* CARD).
*           THE MACRO *COMMA* ACTUALLY DOES THE WORK. 
  
  
1         IF     -DEF,#COMMA
 ,        MACRO  MNEMONIC 
          COMMA  MNEMONIC 
 ,        ENDM
 #COMMA   EQU    0
1         ENDIF 
  
          PURGMAC  COMMA
 COMMA    MACRO  MNEMONIC 
 #STATNUM SET    #STATNUM+1 
          IFEQ   FIXFLAG,1
 MNEMONIC EQU    #STATNUM+FIXEDOFF
          ELSE
 MNEMONIC EQU    #STATNUM 
          ENDIF 
 COMMA    ENDM
  
  
  
  
**        ; -  TERMINATE A STATUS LIST
* 
*         ;  #MAXVAL# 
* 
*         DROPS QUALIFICATION OF SYMBOLS. 
*         SYMBOL /STATNAME/#STATNUM IS THE VALUE OF THE LAST SYMBOL,
*           IF ANYONE IS INTERESTED.
  
  
 ;        MACRO  QHIVALQ
          IFC    NE,*QHIVALQ* * 
 M2       MICRO  1,,QHIVALQ 
          ERRPL  #STATNUM-"M2"-1
          ENDIF 
 ;        ENDM
  
  
          STATUS  COMMAND 
*CALL COMMANDS
          STATUS SUBCOM 
*CALL SUBCOMS 
          STATUS FUNCTION 
*CALL FUNCTIONS 
*CALL FIXED 
          STATUS SETSY
*CALL SETSYS
*CALL EXTDEFS 
  
**        GLOBSY -  DEFINE A GLOBAL *SETSY* REFERENCE 
* 
*         GLOBSY (MOD,REG) [,VAL] 
  
  
 GLOBSY   MACRO  P1,VAL 
          .GLOBREF  P1,VAL
          IF     -DEF,"GLOBREF",4 
 "GLOBREF" EQU   #GLOBNUM 
 #GLOBNUM SET    #GLOBNUM+1 
 GLOBSY   ENDM
  
 #GLOBNUM SET    128
  
  
  
  
**        .GLOBREF -  CREATE SYMBOL FOR GLOBAL *SETSY* REFERENCE
* 
*         .GLOBREF  MOD,REG,VAL 
* 
*      DOES-
*         SETS "GLOBREF" TO THE SYMBOL. 
  
  
 .GLOBREF MACRO  MOD,REG,VAL
*  ASSUME NO VAL
 #T1      SET    0
          IFC    NE, VAL  ,5
 #T1      SET    13 
          IFC    LE, VAL Z ,3 
          IFGE   VAL,FIXEDOFF,2 
 M3       DECMIC VAL-FIXEDOFF,2 
          SKIP   1
 M3       DECMIC VAL+500,3
 M1       MICRO  #T1+MOD,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ
          IFGE   REG,FIXEDOFF,2 
 M2       OCTMIC REG-FIXEDOFF,3 
          SKIP   1
 M2       OCTMIC REG,3
 GLOBREF  MICRO  1,, @"M1""M2""M3"
 .GLOBREF ENDM
  
*CALL     GLOBSYS 
  
  
  
  
**        ADDZ -  SET RESULT = (OPERAND1 + OPERAND2)
* 
*         ADDZ   OPERAND1,OPERAND2,RESULT 
* 
*         COMPUTES FUNCTION1 + FUNCTION2
*           AND STORES THE RESULT ACCORDING TO FUNCTION3. 
  
  
 ADDZ     MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/ADDZ,"F1","F2","R" 
 ADDZ     ENDM
  
  
  
  
**        ANDIF -  "AND" CONDITION USED WITH *IFTHEN* 
* 
*         IFTHEN <CONDITION>
*          ANDIF <CONDITION>
*           STMT
*           ... 
*           ENDIFZ
* 
*     OR  IFTHEN <CONDITION>
*          ANDIF <CONDITION>
*           STMT
*           ... 
*         ELSEZ 
*           STMT
*           ... 
*           ENDIFZ
  
  
 ANDIF    MACRO  CONDTION 
*      SET "OP", "F1" AND "F2"
          .COND  CONDTION 
*      NEGATE THE RELATION   (*IFVALXX* DEFINED AFTER *IFTHEN* MACRO) 
 OP       MICRO  2*IFVAL"OP"+1,2, NEGELEGTLTEQ
*      SET "ADDR" AND "LINKACT" 
 #SHORTJP SET    1
          .ADDR  '?IF"#IFLABEL" 
 #SHORTJP SET    0
          VFD    W$C/IFZ"OP","F1","F2","ADDR" 
"LINKACT" 
 ANDIF    ENDM
  
  
  
  
**        ANDZ -  SET RESULT = (OPERAND1 .AND. OPERAND2)
* 
*         ANDZ   OPERAND1,OPERAND2,RESULT 
* 
*         SETS RESULT = (OPERAND1 .AND. OPERAND2) 
  
  
 ANDZ     MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/ANDZ,"F1","F2","R" 
 ANDZ     ENDM
  
  
  
  
**        BRANCH -  START INTERPRETING AT A SPECIFIED LOCATION
* 
*         BRANCH LABEL
* 
*         CAUSES CODE INTERPRETATION TO START AT *LABEL*. 
  
  
 BRANCH   MACRO  NAME 
          .ADDR  NAME 
          VFD    W$C/BRANCH,"ADDR"
"LINKACT" 
 BRANCH   ENDM
  
  
  
  
**        CALLZ -  SAVE RETURN AND START INTERPRETING AS SPECIFIED
* 
*         CALLZ  LABEL
* 
*         CAUSES THE CURRENT INTERPRETIVE ADDRESS+1 TO BE STORED IN 
*           THE RETURN BRANCH STACK,  AND INTERPRETATION TO CONTINUE
*           AT *LABEL*. 
*         WHEN A *RETURN* COMMAND IS EXECUTED,  INTERPRETATION
*           WILL CONTINUE FOLLOWING THE *CALLZ*.
  
  
 CALLZ    MACRO  NAME 
*      SET "ADDR" AND "LINKACT" TO REFER TO SPECIFIED ADDRESS 
          .ADDR  NAME 
          VFD    W$C/CALLZ,"ADDR" 
"LINKACT" 
 CALLZ    ENDM
  
  
  
  
**        CASE -  SPECIFY A CASE FOR *GOTOCASE* 
* 
*         GOTOCASE  FUNCTION
*           CASE   VALUE,ADDR 
*           ...    ...
*           CASE   VALUE,ADDR 
*           ENDCASE 
  
  
 CASE     MACRO  VALUE,NAME 
          VFD    12/VALUE,18/=X_NAME
 CASE     ENDM
  
  
  
  
**        CONP -  SPECIFY A CONSTANT PARAMETER FOR OBJECT MACRO 
* 
*         GENM   ...
*           ... 
*           CONP  ... 
* 
  
  
 CONP     MACRO  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16 
          .CONST P1 
          VFD    "CONST"
 #NCONP   SET    #NCONP+1 
          IFC    NE, P2  ,1 
          CONP   (P2),(P3),(P4),(P5),(P6),(P7),(P8),(P9),(P10),(P11),(P1
,2)(P13),(P14),(P15),(P16)
 CONP     ENDM
  
  
  
  
**        CONSTANT -  ALLOW REFERENCE TO A LARGE CONSTANT 
* 
*         CONSTANT  VALUE 
  
  
          MACRO  CONSTANT,LOC,VALUE 
          USE    CONST
          QUAL   CONST
 LOC      BSS    0
          QUAL   *
 LOC      CON    VALUE
          USE    *
 CONSTANT ENDM
  
  
  
  
**        EGO -  DEFINE A LABEL WITH DEBUG CAPABILITIES 
* 
* NAME    EGO    LEVEL
* 
*         CODE GENERATION IS FORCED UPPER.
*         THE SYMBOL *NAME* IS THEN EQUATED TO THE CURRENT LOCATION.
*         THE LOCATION OF THE *MODULE* COMMAND (AT THE BEGINNING
*           OF THE MODULE) IS REFERENCED BOTH FOR *SETSY* REFERENCES
*           AND FOR MNEMONIC DEBUG OUTPUT.
  
  
1         IFEQ   DEBUGC,1    IF EGO NAME ASSEMBLED
  
          MACRO  EGO,NAME,LEVEL 
          .FORCEUP
 NAME     EQU    *
 M1       MICRO  1,, NAME 
 #T1      MICCNT M1 
 #T2      SET    6*#T1
          VFD    W$C/SUBCOM,W$SUBCOM/EGO,18/.MODULE.,4/LEVEL,4/#T1,#T2/0
,L_NAME 
 EGO      ENDM
  
1         ELSE               IF EGO NAME IS NOT ASSEMBLED 
  
          MACRO  EGO,NAME,LEVEL 
          .FORCEUP
 NAME     EQU    *
*  BELOW ADDRESS IS ENTIRELY IN ONE WORD BECAUSE W$C+W$SUBCOM+18 @ 60 
*  AND *EGO* ALWAYS STARTS A NEW WORD.
          VFD    W$C/SUBCOM,W$SUBCOM/EGO,18/.MODULE.
 EGO      ENDM
  
1         ENDIF 
  
  
  
  
**        ELSEZ -  REVERSE EFFECT OF PREVIOUS *IFTHEN*
* 
*         IFTHEN <CONDITION>
*           STMT
*           ... 
*         ELSEZ 
*           STMT
*           ... 
*           ENDIFZ
  
  
 ELSEZ    MACRO 
*      JUMP AROUND CODE FOLLOWING THE *ELSEZ* 
 #IFLABEL SET    #IFLABEL+1 
 #IFLABEL DECMIC #IFLABEL,4 
 #SHORTJP SET    1
          BRANCH '?IF"#IFLABEL" 
 #SHORTJP SET    0
*      PROVIDE LABEL FOR FAILURE OF CONDITION 
 M1       DECMIC #IFLABEL-1,4 
 '?IF"M1" LABEL 
 ELSEZ    ENDM
  
  
  
  
**        ENDCASE -  TERMINATE A *GOTOCASE* SEQUENCE
* 
*         GOTOCASE  FUNCTION
*           CASE   VALUE,ADDRESS
*           ... 
*           CASE   VALUE,ADDRESS
*           ENDCASE 
  
  
 ENDCASE  MACRO  NAME 
          LOCAL  NEXT 
          IFC    NE, NAME  ,2 
          VFD    12/7777B,18/NAME 
          SKIP   2
          VFD    12/7777B,18/NEXT 
 NEXT     LABEL 
 ENDCASE  ENDM
  
  
  
  
**        ENDG -  TERMINATE AN OBJECT MACRO GENERATION CALL 
* 
*         "GENM" = MACRO NUMBER 
* 
*         GENM   ...
*           ... 
*           ENDG
  
  
 ENDG     MACRO 
          ERRNZ  #NCONP"GENM"-#NCONP
          ERRNZ  #NREGP"GENM"-#NREGP
          ERRNZ  #NSYMP"GENM"-#NSYMP
 ENDG     ENDM
  
  
  
  
**        ENDIFZ -  TERMINATE AN *IFTHEN* SEQUENCE
  
*         IFTHEN <CONDITION>
*           STMT
*           ... 
*           ENDIFZ
* 
*     OR  IFTHEN <CONDITION>
*           STMT
*           ... 
*         ELSEZ 
*           STMT
*           ... 
*           ENDIFZ
  
  
 ENDIFZ   MACRO 
*      GENERATE LABEL FROM PREVIOUS *IFTHEN* OR *ELSEZ* 
 '?IF"#IFLABEL"  LABEL
 ENDIFZ   ENDM
  
  
  
  
**        EQZ -  SET RESULT = (OPERAND1 .EQ. OPERAND2)
* 
*         EQZ    OPERAND1,OPERAND2,RESULT 
* 
*         IF OPERAND1 EQUALS OPERAND2,
*           STORES THE VALUE 1 INTO RESULT. 
*         IF OPERAND1 IS NOT EQUAL TO OPERAND2, 
*           STORES THE VALUE 0 INTO THE RESULT. 
  
  
 EQZ      MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/SUBCOM,W$SUBCOM/EQZ,"F1","F2","R"
 EQZ      ENDM
  
  
  
  
**        ERROR -  WRITE OUT AN ERROR MESSAGE 
* 
*         ERROR  NUMBER 
* 
*         WRITES OUT: 
* 
*  ***** ERROR NUMBER (NUMBER) IN MODULE (MODULE) AT LOCATION (LOCATION)
  
  
 ERROR    MACRO  NUMBER 
          VFD    W$C/SUBCOM,W$SUBCOM/ERROR,15/NUMBER
 ERROR    ENDM
  
  
  
  
**        EXECUTE -  EXECUTE A SUBROUTINE WITHOUT PARAMETERS
* 
*         EXECUTE  LABEL
* 
*         THE INTERPRETER CALLS THE ROUTINE AT *LABEL* WITH 
*           AN *RJ* INSTRUCTION.
*         INTERPRETIVE CONTROL RESUMES FOLLOWING THE *EXECUTE*
*           AFTER RETURN FROM THE EXECUTED SUBROUTINE.
  
1         IFEQ   DEBUGC,1    IF GENERAL DEBUG 
  
 EXECUTE  MACRO  LABEL
 M1       MICRO  1,, LABEL
 #T1      MICCNT M1 
 #T2      SET    6*#T1
          VFD    W$C/EXECUTE,1/1
          IFGE   $,17,2 
          VFD    18/=X_LABEL
          SKIP   1
          VFD    $/-0,1/-0,18/=X_LABEL
          VFD    4/#T1,#T2/0L_LABEL 
 EXECUTE  ENDM
  
1         ELSE
  
 EXECUTE  MACRO  LABEL
          VFD    W$C/EXECUTE,1/1
          IFGE   $,17,2 
          VFD    18/=X_LABEL
          SKIP   1
          VFD    $/-0,1/-0,18/=X_LABEL
 EXECUTE  ENDM
  
1         ENDIF 
  
  
  
  
**        GEN -  GENERATE AN OBJECT INSTRUCTION 
* 
*         GEN    INSTR,P1,P2,...
* 
*         GENERATES AN OBJECT INSTRUCTION ACCORDING TO THE CLASS
*           OF THE INSTRUCTION AND THE PARAMETERS.
  
  
 GEN      MACRO  INSTR,P1,P2,P3,P4,P5,P6,P7 
 T1       DECMIC INSTR
 M1       DECMIC CLS."T1" 
          .GEN"M1"  INSTR,(P1),(P2),(P3),(P4),(P5),(P6),(P7)
 GEN      ENDM
  
  
  
  
**        GENLP 
  
  
 GENLP    MACRO  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15 
          LOCAL  NPARMS 
          VFD    W$C/GENLP,4/NPARMS 
 #NREGP   SET    0
          REGP   P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15 
 NPARMS   EQU    #NREGP 
 GENLP    ENDM
  
  
  
  
**        GENM -  GENERATE AN OBJECT MACRO GENERATION SEQUENCE
* 
*         GENM   ...
*           ... 
*           ENDG
  
  
 GENM     MACRO  MACNO,SYMPARMS,REGPARMS,CONPARMS 
 GENM     DECMIC MACNO-MACOFF,2 
          VFD    W$C/GENM,12/MACNO,4/#NSYMP"GENM",4/#NREGP"GENM",4/#NCON
,P"GENM"
 #GENM    SET    60**-60*.CODE.+$ 
 #NCONP   SET    0
 #NREGP   SET    0
 #NSYMP   SET    0
          IFC    NE, SYMPARMS  ,1 
          SYMP   SYMPARMS 
          IFC    NE, REGPARMS  ,1 
          REGP   REGPARMS 
          IFC    NE, CONPARMS  ,1 
          CONP   CONPARMS 
          IFNE   60**-60*.CODE.+$,#GENM,1 
          ENDG
 GENM     ENDM
  
  
  
  
**        GENOBJ -  GENERATE OBJ INSTRUCTION FOR ASSEMBLER
  
*         I_N AND O_N ARE FUNCTIONS RETURNING A VIRTUAL REGISTER NUMBER.
* 
*         GENOBJ N=ROUTINE,I=(I1,I2,I3,...),O=(O1,O2,O3,...)
*     OR  GENOBJ N=(ROUTINE,FIX),...
  
  
 GENOBJ   MACROE N,I,O
*      SET "OBJNAME" TO (POSSIBLY VARIABLE) OBJECT NAME,  AND 
*      SET "M2" TO PRIMARY OBJECT NAME (NUMBER) 
          .PARSE N
 #T1      SET    0
          IFNE   #BREG"M2",0,1
 #T1      SET    1
          VFD    W$C/GENOBJ,"OBJNAME",1/#T1,4/#IREG"M2",4/#OREG"M2" 
 #NREGP   SET    0
          IFNE   #IREG"M2",0,1
          REGP   I
*      "M2" IS PRESERVED BY REGP
          ERRNZ  #IREG"M2"-#NREGP                "SEQUENCE" 
 #NREGP   SET    0
          IFNE   #OREG"M2",0,1
          REGP   O
          ERRNZ  #OREG"M2"-#NREGP                "SEQUENCE" 
 GENOBJ   ENDM
  
  
  
  
**        GENVFD -  GENERATE VFD INSTRUCTION FOR ASSEBLER 
* 
*         NBITS = FUNCTION RETURNING BIT COUNT. 
*         VALUE = FUNCTION RETURNING VALUE. 
* 
*         GENVFD (NBITS,VALUE),(NBITS,VALUE),...
  
  
 GENVFD   MACRO  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10 
          LOCAL  NPAIRS 
 #PAIRCNT SET    0
          VFD    W$C/GENVFD,W$VFD/NPAIRS
          .GENVFD  P1,(P2),(P3),(P4),(P5),(P6),(P7),(P8),(P9),(P10) 
 NPAIRS   EQU    #PAIRCNT 
 GENVFD   ENDM
  
  
  
  
**        GEZ -  STORE RESULTS OF (OPERAND1 .GE. OPERAND2)
* 
*         GEZ    OPERAND1,OPERAND2,RESULT 
* 
*         IF OPERAND1 \ OPERAND2, 
*           STORES THE VALUE 1 INTO RESULT. 
*         IF OPERAND1 < OPERAND2, 
*           STORES THE VALUE 0 INTO RESULT. 
  
  
 GEZ      MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   F,RESULT 
          VFD    W$C/SUBCOM,W$SUBCOM/GEZ,"F1","F2","R"
 GEZ      ENDM
  
  
  
  
**        GOTOCASE -  BRANCH ACCORDING TO VALUE OF FUNCTION 
* 
*         GOTOCASE  FUNCTION
*           CASE   VALUE,LABEL
*           ... 
*           CASE   VALUE,LABEL
*           ENDCASE (LABEL) 
* 
*         IF THE FUNCTION VALUE IS EQUAL TO ONE OF THE *CASE* VALUES, 
*           AN IMPLICIT *BRANCH* IS MADE TO THE ASSOCIATED *LABEL*. 
*         IF THE FUNCTION VALUE IS NOT EQUAL TO ANY OF THE *CASE* VALUES
*           AN IMPLICIT *BRANCH* IS MADE TO THE *LABEL* ON THE ENDCASE* 
*           STATEMENT.
*         IF THE *LABEL* IS OMITTED FROM THE *ENDCASE* STATEMENT, 
*           THE NEXT COMMAND IS INTERPRETED.
  
  
 GOTOCASE MACRO  FUNCTION 
          .ARG   F,FUNCTION 
          VFD    W$C/GOTOCASE,"F" 
          VFD    1/1
          BSS    0
 GOTOCASE ENDM
  
  
  
  
**        GTZ -  SET RESULT = (OPERAND1 .GT. OPERAND2)
* 
*         GTZ    OPERAND1,OPERAND2,RESULT 
* 
*         IF OPERAND1 > OPERAND2, 
*           STORES THE VALUE 1 INTO RESULT. 
*         IF OPERAND1 @ OPERAND2, 
*           STORES THE VALUE 0 INTO RESULT. 
  
  
 GTZ      MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/SUBCOM,W$SUBCOM/GTZ,"F1","F2","R"
 GTZ      ENDM
  
  
  
  
**        IFTHEN -  IF CONDITION IS TRUE THEN EXECUTE STATMENTS 
* 
*         IFTHEN <CONDITION>
*           STMT
*           ... 
*           ENDIFZ
  
*     OR  IFTHEN <CONDITION>
*           STMT
*           ... 
*         ELSEZ 
*           STMT
*           ... 
*           ENDIFZ
  
  
 IFTHEN   MACRO  CONDTION 
*      SET "F1", "OP" AND "F2"
          .COND  CONDTION 
*      NEGATE THE RELATION
 OP       MICRO  2*IFVAL"OP"+1,2, NEGELEGTLTEQ
*      CREATE THE NEXT *IF* LABEL 
 #IFLABEL SET    #IFLABEL+1 
 #IFLABEL DECMIC #IFLABEL,4 
*      SET "ADDR" AND "LINKACT" TO REFER TO THE NEXT *IF* LABEL 
 #SHORTJP SET    1
          .ADDR  '?IF"#IFLABEL" 
 #SHORTJP SET    0
          VFD    W$C/IFZ"OP","F1","F2","ADDR" 
"LINKACT" 
 IFTHEN   ENDM
  
 IFVALEQ  EQU    0
 IFVALLT  EQU    1
 IFVALGT  EQU    2
 IFVALLE  EQU    3
 IFVALGE  EQU    4
 IFVALNE  EQU    5
  
  
  
  
**        IFZ -  BRANCH IF RELATION IS TRUE 
* 
*         IFZ    (FUNCTION1,OP,FUNCTION2),LABEL 
* 
*     OR  IFZ    FUNCTION1,LABEL
* 
*         OP = EQ, NE, GT, LT, GE, OR LE
* 
*         IF THE RELATION IS TRUE  (I.E. 1),
*           INTERPRETATION STARTS AT *LABEL*. 
*         IF THE RELATION IS NOT TRUE  (I.E. 0),
*           THE NEXT COMMAND IS INTERPRETED.
* 
*         FOR THE SECOND CALLING FORM,  THE BELOW IS ASSUMED: 
*           OP = NE 
*           FUNCTION2 = K0
  
  
 IFZ      MACRO  CONDTION,NAME
*      SET "F1", "OP", AND "F2" 
          .COND  CONDTION 
*      SET "ADDR" AND "LINKACT" TO REFER TO THE JUMP ADDRESS
          .ADDR  NAME 
          VFD    W$C/IFZ"OP","F1","F2","ADDR" 
"LINKACT" 
 IFZ      ENDM
  
  
  
  
**        KNIL -  ALLOW A LOCAL SYMBOL TO BE EXTERNALLY LINKED
* 
* LABEL1  KNIL   LABEL2 
* 
*         *LABEL1* IS THE LOCAL SYMBOL. 
*         REFERENCES OUTSIDE THE MODULE WILL BE TO *LABEL2*.
*         *LABEL1* MAY BE THE SAME AS *LABEL2*. 
  
  
          MACRO  KNIL,LABEL1,LABEL2 
*      USE *RMT* SO LABEL1 WILL BE DEFINED
          RMT 
          ENTRY  LABEL2 
 LABEL2   EQU    LABEL1 
          RMT 
 KNIL     ENDM
  
  
  
  
**        LABEL -  DEFINE A LABEL 
* 
* NAME    LABEL 
* 
*         THIS COMMAND ALWAYS STARTS ON A WORD BOUNDARY.
*         SYMBOL *NAME* IS EQUATED TO THIS WORD.
  
  
          PURGMAC  LABEL     FET *LABEL* MACRO IN SYSTEXT 
DEBUGB    IFEQ   DEBUGB,1    IF *LABEL* CODE HAS *EGO*
          MACRO  LABEL,NAME 
          .FORCEUP
 NAME     EGO    0
 LABEL    ENDM
DEBUGB    ELSE               IF *LABEL* CODE DOES NOT HAVE *EGO*
          MACRO  LABEL,NAME 
          .FORCEUP
 NAME     EQU    *
 LABEL    ENDM
DEBUGB    ENDIF 
  
  
  
  
**        LEZ -  SET RESULT = (OPERAND1 .LE. OPERAND2)
* 
*         LEZ    OPERAND1,OPERAND2,RESULT 
* 
*         IF OPERAND1 @ OPERAND2, 
*           STORES THE VALUE 1 INTO RESULT. 
*         IF OPERAND1 > OPERAND2, 
*           STORES THE VALUE 0 INTO RESULT. 
  
  
 LEZ      MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/SUBCOM,W$SUBCOM/LEZ,"F1","F2","R"
 LEZ      ENDM
  
  
  
  
**        LINK -  LINK A LOCAL SYMBOL TO AN EXTERNAL SYMBOL 
* 
* LABEL1  LINK   LABEL2 
* 
*         REFERENCES TO LOCAL SYMBOL *LABEL1* WILL ACTUALLY BE TO 
*           THE EXTERNAL SYMBOL *LABEL2*. 
  
  
          MACRO  LINK,LABEL1,LABEL2 
*      TELL *.ADDR* ABOUT *LABEL1*
          QUAL   LINK 
 LABEL1   EQU    0
          QUAL   *
          EXT    LABEL2 
 LABEL1   EQU    LABEL2 
 LINK     ENDM
  
  
  
  
**        LISTSEC -  CONDITIONALLY LIST A SECTION OF A LARGE PROGRAM
* 
*         LISTSEC  NAME1
*         ... 
*         LISTSEC  NAME2
*         ... 
*         LISTSEC  *
* 
*         LISTING IS CONTROLLED BY THE *PC* PARAMETER ON THE COMPASS
*         CONTROL CARD: 
* 
*         PC OMITTED         MEANS EVERYTHING WILL BE LISTED
*         PC=NAME            MEANS ONLY LEST SECTION NAME WILL BE LISTED
*         PC=$NAME1,NAME2$   MEANS ONLY LIST SECTIONS NAME1, NAME2, ETC.
*                              WILL BE LISTED.
* 
*         METHOD-  THE FIRST CALL OF *LISTSEC* ANALYZES THE *PCOMMENT*
*         MICRO CREATED BY THE *PC* PARAMETER AND GENERATES AN
*         EFFICIENT MACRO DEFINITION ACCORDINGLY. 
  
  
 LISTSEC  MACRO  NAM
          PURGMAC  LISTSEC
          NOREF  #LIST
1         IFC    EQ,*"PCOMMENT"*                              * 
 LISTSEC  OPSYN  NIL
1         ELSE
*      STRIP BLANKS FROM "PCOMMENT" 
 PCOMMENT MICRO  1,, "PCOMMENT" 
2         ECHO   ,I=(2,3,4,5,6),N=("PCOMMENT",*,*,*,*,*)
          IFC    NE, N * ,2 
 STMT_I   MICRO  1,,'          IFC    NE, NAME N ,I_' 
          SKIP   1
 STMT_I   MICRO  1,, *
2         ENDD
          .LISTSEC  ("STMT2"),("STMT3"),("STMT4"),("STMT5"),("STMT6") 
          LISTSEC  NAM
1         ENDIF 
 LISTSEC  ENDM
  
  
  
  
**        LSHIFT -  LEFT-SHIFT A FIXED CELL 
* 
*         LSHIFT FIX,N
* 
* 
*         SHIFTS LEFT FIXED CELL *FIX* BY *N* BITS. 
*         *N* MAY NOT BE NEGATIVE.
  
  
 LSHIFT   MACRO  FIX,N
          VFD    W$C/SUBCOM,W$SUBCOM/LSHIFT,W$FIXED/FIX-FIXEDOFF,6/N
 LSHIFT   ENDM
  
  
  
  
**        LTZ -  SET RESULT = (OPERAND1 .LT. OPERAND2)
* 
*         LTZ    OPERAND1,OPERAND2,RESULT 
* 
*         IF OPERAND1 < OPERAND2, 
*           STORES THE VALUE 1 INTO RESULT. 
*         IF OPERAND1 \ OPERAND2, 
*           STORES THE VALUE 0 INTO RESULT. 
  
  
 LTZ      MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/SUBCOM,W$SUBCOM/LTZ,"F1","F2","R"
 LTZ      ENDM
  
  
  
  
**        MAXZ -  SET RESULT = MAXIMUM(OPERAND1, OPERAND2)
* 
*         MAXZ   OPERAND1,OPERAND2,RESULT 
* 
*         STORES THE LARGER OF OPERAND1 AND OPERAND2 INTO RESULT. 
  
  
 MAXZ     MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/MAXZ,"F1","F2","R" 
 MAXZ     ENDM
  
  
  
  
**        MINZ -  SET RESULT = MINIMUM(OPERAND1, OPERAND2)
* 
*         MINZ   OPERAND1,OPERAND2,RESULT 
* 
*         SETS RESULT TO THE SMALLER OF OPERAND1 AND OPERAND2.
  
  
 MINZ     OPSYN  ANDZ 
  
  
  
  
**        MODULE -  DECLARE A MODULE
* 
* NAME    MODULE
* 
*         DECLARES THE BEGINNING OF A *CGEN* MODULE.
*         SAVES THE NAME FOR *DUMP*, *ERROR*$ AND *SETSY* REFERENCES. 
*         TURNS OFF CROSS-REFERENCING OF CERTAIN SYMBOLS. 
  
  
          MACRO  MODULE,NAME
*      ENSURE THAT *SETSY* DEFINITIONS WILL FOLLOW *MODULE* 
          USE    MODULE 
 .MODULE. CON    10H_NAME 
          USE    SETSY
          USE    CONST
          USE    CODE 
 .CODE.   BSS    0
*      INITIALIZE LABEL NUMBER FOR *IFTHEN*, *ELSEZ*, *ENDIFZ*
 #IFLABEL SET    0
 #SHORTJP SET    0
*      TURN OFF CROSS-REFERENCING OF SOME SYMBOLS 
    NOREF #T1,#F,#FI,#F1,#F2,#F3,#R,#RI,#R1,#R2,#R3,#NREGP,#NSYMP,#NCONP
    NOREF #FJ,#FK,#RJ,#RK,#T2,#T3,#T4 
    NOREF .MODULE.,#GENM,#IFLABEL,#MOD,#NCOMP,#REG,#TAB 
          NOREF  K0,K1,K10,K60
    NOREF W$BACKJP,W$CASE,W$FRWDJP,W$OBJNAM,W$OPNAME,W$SETSY,W$SHRTJP 
    NOREF W$SUBCOM,#SHORTJP 
          NOREF  #P1,#P2
          NOREF  #LAB2
          NOREF  W$C,W$FUNC,W$FIXED 
 MODULE   ENDM
  
  
  
  
**        MOVEZ -  SET RESULT = SOURCE VALUE
* 
*         MOVEZ  OPERAND1,OPERAND2
* 
*         THE VALUE GENERATED ACCORDING TO *OPERAND1* 
*           IS STORED ACCORDING TO *OPERAND2*.
  
  
 MOVEZ    MACRO  SOURCE,RESULT
          .ARG   F1,SOURCE
          .ARG   R,RESULT 
          VFD    W$C/MOVEZ,"F1","R" 
 MOVEZ    ENDM
  
  
  
  
**        MULTZ -  SET RESULT = (OPERAND1 * OPERAND2) 
* 
*         MULTZ  OPERAND1,OPERAND2,RESULT 
* 
*         STORES (OPERAND1 * OPERAND2) INTO RESULT. 
  
  
 MULTZ    MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/MULTZ,"F1","F2","R"
 MULTZ    ENDM
  
  
  
  
**        NEZ -  SET RESULT = (OPERAND1 .NE. OPERAND2)
* 
*         NEZ    OPERAND1,OPERAND2,RESULT 
* 
*         IF OPERAND1 " OPERAND2, 
*           STORES THE VALUE 1 INTO RESULT. 
*         IF OPERAND1 = OPERAND2, 
*           STORES THE VALUE 0 INTO RESULT. 
  
  
 NEZ      MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/SUBCOM,W$SUBCOM/NEZ,"F1","F2","R"
 NEZ      ENDM
  
  
  
  
**        NOTE -  PUT A COMMENT NOTE IN THE OBJECT LISTING
* 
*         NOTE   XXX
* 
*         XXX = 0 - 8 CHARACTERS
  
  
DEBUGA    IFEQ   DEBUGA,1    IF *NOTE* CODE IS ASSEMBLED
  
 NOTE     MACRO  XXX
          VFD    W$C/SUBCOM,W$SUBCOM/NOTE,48/8H_XXX 
 NOTE     ENDM
  
DEBUGA    ELSE               IF *NOTE* CODE IS NOT ASSEMBLED
  
 NOTE     OPSYN  NIL
  
DEBUGA    ENDIF 
  
  
  
  
**        NOTZ -  BRANCH IF RELATION IS NOT TRUE
* 
*         NOTZ   (OPERAND1,OP,OPERAND2),LABEL 
* 
*     OR  NOTZ   OPERAND1,LABEL 
* 
*         OP = EQ, NE, GT, LT, GE, OR LE
* 
*         IF THE RELATION IS NOT TRUE,
*           INTERPRETATION STARTS AT *LABEL*. 
*         IF THE RELATION IS TRUE,
*           THE NEXT COMMAND IS INTERPRETED.
* 
*         FOR THE SECOND CALLING FORM,  THE BELOW IS ASSUMED: 
*           OP = NE 
*           OPERAND2 = K0 
  
  
 NOTZ     MACRO  CONDTION,NAME
*      SET "F1", "OP", AND "F2" 
          .COND  CONDTION 
*      NEGATE THE CONDITION 
 OP       MICRO  2*IFVAL"OP"+1,2, NEGELEGTLTEQ
*      SET "ADDR" 
          .ADDR  NAME 
          VFD    W$C/IFZ"OP","F1","F2","ADDR" 
"LINKACT" 
 NOTZ     ENDM
  
  
  
  
**        ONERROR -  SET RECOVERY POINT FROM AN ERROR 
* 
*         ONERROR  LABEL
* 
*         THIS COMMAND CAUSES THE LABEL ADDRESS TO BE ADDED TO THE
*           RETURN BRANCH STACK WITH A TYPE OF *ONERROR*. 
*         ANY *ERROR* COMMANDS WHICH SUBSEQUENTLY OCCUR WILL BRANCH 
*           TO THE LABEL (UNLESS THE RETURN BRANCH STACK IS CLEARED TO
*           A LEVEL BELOW THE *ONERROR* ENTRY DUE TO *RETURN* COMMANDS. 
  
  
 ONERROR  OPSYN  ERR
  
  
  
  
**        ORZ -  SET RESULT = (OPERAND1 .OR. OPERAND2)
* 
*         ORZ    OPERAND1,OPERAND2,RESULT 
* 
*         IF OPERAND1 = 1 OR IF OPERAND2 = 1, 
*           STORES THE VALUE 1 INTO RESULT. 
*         IF OPERAND1 = 0 AND IF OPERAND2 = 0,
*           STORES THE VALUE 0 INTO RESULT. 
  
  
 ORZ      OPSYN  MAXZ 
  
  
  
  
**        POP -  POP AN ENTRY FROM SAVE STACK 
* 
*         POP    FIX1, ... ,FIX_N 
* 
*         POPS THE SAVE STACK INTO FIXED CELLS FIX1, ..., FIX_N.
*         THE PARAMETERS FOR *POP* MUST BE EXACTLY THE SAVE AS THE
*           CORRESPONDING *PUSH* COMMAND. 
*         1 @ N @ 6 
  
  
          IFGE   W$C+6*W$FIXED+6,60,1 
          ERR    MUST REDUCE MAXIMUM NUMBER OF PUSH/POP PARAMETERS
  
 POP      MACRO  P1,P2,P3,P4,P5,P6
 M1       MICRO  1,, W$FIXED/P1-FIXEDOFF,1/0
          .POP   P2,P3,P4,P5,P6 
          VFD    W$C/SUBCOM,W$SUBCOM/POP,"M1" 
 POP      ENDM
  
  
  
  
**        PUSH  -  PUSH DOWN AN ENTRY IN THE SAVE STACK 
* 
*         PUSH   FIX1, ..., FIX_N 
* 
*         SAVES FIXED CELLS FIX1, ..., FIX_N IN A PUSH-DOWN STACK.
*         1 @ N @ 6 
  
  
 PUSH     MACRO  P1,P2,P3,P4,P5,P6
 M1       MICRO  1,, W$FIXED/P1-FIXEDOFF
          .PUSH  P2,P3,P4,P5,P6 
          VFD    W$C/SUBCOM,W$SUBCOM/PUSH,"M1",1/0
 PUSH     ENDM
  
  
  
  
**        QUOTZ -  SET RESULT = (OPERAND1 / OPERAND2) 
* 
*         QUOTZ  OPERAND1,OPERAND2,RESULT 
*         SETS RESULT = OPERAND1 / OPERAND2.
  
  
 QUOTZ    MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/QUOTZ,"F1","F2","R"
 QUOTZ    ENDM
  
  
  
  
**        REGP -  SPECIFY REGISTER PARAMETER TO OBJECT MACRO CALL 
  
  
 REGP     MACRO  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16 
          .ARG   R,P1 
          VFD    "R"
 #NREGP   SET    #NREGP+1 
          IFC    NE, P2  ,1 
          REGP   (P2),(P3),(P4),(P5),(P6),(P7),(P8),(P9),(P10),(P11),(P1
,2),(P13),(P14),(P15),(P16) 
 REGP     ENDM
  
  
  
  
**        REMZ -  SET RESULT = REMAINDER OF (OPERAND1 / OPERAND2) 
* 
*         REMZ   OPERAND1,OPERAND2,RESULT 
* 
*         SETS RESULT = REMAINDER OF (OPERAND1 / OPERAND2). 
*           ALWAYS,  0 @ RESULT < OPERAND2,  EVEN IF OPERAND1 < 0.
  
  
 REMZ     MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/REMZ,"F1","F2","R" 
 REMZ     ENDM
  
  
  
  
**        RETURN -  RETURN FROM AN INTERPRETIVE SUBROUTINE
* 
*         RETURN
* 
*         CAUSE INTERPRETATION TO RESUME JUST FOLLOWING THE LAST
*           EXECUTED *CALLZ* COMMAND. 
  
  
          PURGMAC  RETURN 
 RETURN   MACRO 
          VFD    W$C/RETURNZ
 RETURN   ENDM
  
  
  
  
**        SETSY -  ALLOW REFERENCES TO A SYMBOLIC ADDRESS 
* 
*         FORMAT 1: 
* 
*         FORMAT 2: 
*         SETSY  (MOD,REG)[,FUNCTION] 
* 
*         FORMAT 3: 
*         SETSY  TABLE[,MOD],REG[,FUNCTION] 
  
  
          MACRO  SETSY,NAME,P1,VAL
          .GLOBREF  P1,VAL
          IF     DEF,"GLOBREF",5
          QUAL   SETSY
 NAME     EQU    "GLOBREF"
          QUAL   *
 NAME     MICRO  1,, "GLOBREF"
          SKIP   1
 NAME     .SETSY P1,VAL 
 SETSY    ENDM
  
  
  
  
**        STOP -  STOP CGEN INTERPRETATION FOR THIS VERB
* 
*         STOP
  
  
 STOP     MACRO 
          VFD    W$C/SUBCOM,W$SUBCOM/STOPZ
 STOP     ENDM
  
  
  
  
**        SUBZ -  SET RESULT = (OPERAND1 - OPERAND2)
* 
*         SUBZ   OPERAND1,OPERAND2,RESULT 
* 
*         SETS RESULT = (OPERAND1 - OPERAND2).
  
  
 SUBZ     MACRO  OPERAND1,OPERAND2,RESULT 
          .ARG   F1,OPERAND1
          .ARG   F2,OPERAND2
          .ARG   R,RESULT 
          VFD    W$C/SUBZ,"F1","F2","R" 
 SUBZ     ENDM
  
  
  
  
**        SYMP -  SPECIFY SYMBOLIC PARAMETER TO OBJECT MACRO CALL 
* 
*         SYMP   P1,P2,...
* 
*         GENERATES PARAMETERS FOR *GENM*.
  
  
 SYMP     MACRO  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,P16 
          .CONST P1 
          VFD    "CONST"
 #NSYMP   SET    #NSYMP+1 
          IFC    NE, P2  ,1 
          SYMP   (P2),(P3),(P4),(P5),(P6),(P7),(P8),(P9),(P10),(P11),(P1
,2),(P13),(P14),(P15),(P16) 
 SYMP     ENDM
  
  
  
  
**        =SETSY -  EQUATE A SYMBOL WITH A *SETSY* SYMBOL 
* 
* ALIAS   =SETSY ACTUAL 
  
          MACRO  =SETSY,ALIAS,ACTUAL
          QUAL   SETSY
 ALIAS    EQU    ACTUAL 
          QUAL   *
 =SETSY   ENDM
  
  
  
  
**        .ADDR -  CREATE SPECIFICATION OF AN ADDRESS REFERENCE 
* 
*         .ADDR  LABEL
* 
  
  
 .ADDR    MACRO  NAME 
          IFC    EQ, NAME RETURN ,2 
          .ADDR2
          SKIP   9
          IF     -DEF,#BIGPROG,6
          IF     -DEF,/LINK/NAME,5
*  LOCAL=SHORT ADDRESS REFERENCE
          ERRPL  NAME-.MODULE.-M$JUMP-1                   "SEQUENCE"
          ERRZR  NAME-.MODULE.
 ADDR     MICRO  1,, 1/0,W$JUMP/NAME-.MODULE. 
 LINKACT  MICRO  1,,'*' 
          SKIP   2
*  GLOBAL/LONG ADDRESS REFERENCE
 ADDR     MICRO  1,, 1/1
 LINKACT  MICRO  1,,(  .ADDR1 NAME (
.ADDR     ENDM
  
 .ADDR1   MACRO  NAME 
          IFGE   $,17,2 
          VFD    18/NAME
          SKIP   1
          VFD    $/-0,1/-0,18/NAME
 .ADDR1   ENDM
  
 .ADDR2   MACRO 
*  SPECIFY *RETURN* 
 ADDR     MICRO  1,, 1/0,W$JUMP/0 
 LINKACT  MICRO  1,,'*' 
 .ADDR2   ENDM
  
  
  
  
**        .ARG -  CREATE SPECIFICATION OF A FIXED OR FUNCTION REFERENCE 
* 
*         .ARG   F,ARG
* 
*         IF *ARG* IS A FIXED REFERENCE (OR AN INTEGER CONSTANT WITH
*           THE VALUE 0, 1, 10 OR 60),  A SPECIFICATION OF
*           "1/0,W$FIXED//FIXED/ARG" IS CREATED.
*         OTHERWISE A FUNCTION REFERENCE IS CREATED 
*           (POSSIBLY TO (EQUALS,INTEGER) ).
  
  
 .ARG     MACRO  X,P1,P2
          IFC    EQ, P2  ,2 
          .ARG1  X,P1 
          SKIP   1
          .ARG2  X,P1,P2
 .ARG     ENDM
  
 .ARG1    MACRO  X,P1 
          IFC    EQ, P1  ,2 
 X        MICRO  1,, 1/0,W$FIXED/K0-FIXEDOFF
          SKIP   1
          .ARG11 X,P1 
 .ARG1    ENDM
  
 .ARG11   MACRO  X,P1 
          IF     DEF,/CONST/P1,2
 X        MICRO  1,, 1/1,W$FUNC/CONSTOF,W$SETSY/P1-.MODULE. 
1         SKIP
          IF REG,P1,2 
 X        MICRO  1,, 1/1,W$FUNC/EQUALS,W$FIXED/#REG_P1
1         SKIP
          IFGE   P1,FIXEDOFF,2
 X        MICRO  1,, 1/0,W$FIXED/P1-FIXEDOFF
1         SKIP
 #M1      MICRO  1,8, K_P1
          IF     DEF,"#M1",3
          IFGE   "#M1",FIXEDOFF,2 
 X        MICRO  1,, 1/0,W$FIXED/"#M1"-FIXEDOFF 
1         SKIP
          IFLE   P1,REGMAX-FIXEDOFF,2 
 X        MICRO  1,, 1/0,W$FIXED/P1 
1         SKIP
X         MICRO  1,, 1/1,W$FUNC/EQUALS,W$FIXED/P1 
1         ENDIF 
 .ARG11   ENDM
  
 .ARG2    MACRO  X,P1,P2
          IFC    EQ, P1 EQUALS ,2 
          .ARG21 X,P2 
1         SKIP
          IFC    EQ, P1 VREFOF ,2 
 X        MICRO  1,, 1/0,W$FIXED/P2-FIXEDOFF
1         SKIP
          IFGE   P2,FIXEDOFF,2
 X        MICRO  1,, 1/1,W$FUNC/P1,W$FIXED/P2-FIXEDOFF
          SKIP   1
X         MICRO  1,, 1/1,W$FUNC/P1,W$FIXED/P2 
1         ENDIF 
 .ARG2    ENDM
  
  
.ARG21    MACRO  X,P2 
          IFGE   P2,FIXEDOFF,2
 X        MICRO  1,, 1/0,W$FIXED/P2-FIXEDOFF
1         SKIP
          IFLE   P2,REGMAX-FIXEDOFF,2 
 X        MICRO  1,, 1/0,W$FIXED/P2 
1         SKIP
 X        MICRO  1,, 1/1,W$FUNC//FUNCTION/EQUALS,W$FIXED/P2 
 .ARG21   ENDM
  
  
          ECHO   1,N=(0,1,2,3,4,5,6,7)
 #REGB_N  EQU    8+N
          ECHO   1,N=(0,1,2,3,4,5,6,7)
 #REGX_N  EQU    16+N 
          ECHO   1,N=(0,1,2,3,4,5,6,7)
 #REGA_N  EQU    32+N 
  
  
  
  
**        .CHKFUNC -  CHECK WHETHER A PARAMETER IS A FUNCTION 
* 
*         .CHKFUNC  P 
*         IF P CONSISTS OF TWO PARAMETERS  (E.G. (A,B) ), 
*           SETS #T1 = 1. 
*         IF P CONSISTS OF ONLY ONE PARAMETER,
*           SETS #T1 = 0. 
  
  
 .CHKFUNC MACRO  P1,P2
 #T1      SET    0
          IFC    NE, P2  ,1 
 #T1      SET    1
 .CHKFUNC ENDM
  
  
  
  
**        .COND -  CREATE SPECIFICATIONS FOR A CONDITION
* 
*         .COND  (OPERAND1,REL,OPERAND2)
* 
*     OR  .COND  OPERAND1 
* 
*         REL = GT, GE, EQ, LE, LT, NE
* 
*         FOR THE SECOND FORM,  THE BELOW IS ASSUMED: 
*           REL = NE
*           OPERAND2 = K0 
  
  
 .COND    MACRO  OPERAND1,REL,OPERAND2
1         IFC    NE, OPERAND2 
*      THREE-PART RELATIONAL FORM 
          .ARG   F1,OPERAND1
 OP       MICRO  1,, REL
          .ARG   F2,OPERAND2
1         ELSE
*      SINGLE FUNCTION
          .ARG   F1,OPERAND1,REL
 OP       MICRO  1,, NE 
 F2       MICRO  1,, 1/0,W$FIXED/K0-FIXEDOFF
1         ENDIF 
 .COND    ENDM
  
  
  
  
**        .CONST -  REFERENCE A FUNCTION, SYMBOL, OR LARGE CONSTANT 
* 
*         .CONST P
* 
*         SETS "CONST" TO THE *VFD* SPECIFICATION OF THE REFERENCE. 
*         EXPLICIT OR IMPLICIT *SETSY* REFERENCES ARE ALLOWED.
*         ONLY EXPLICIT *CONSTANT* REFERENCES ARE ALLOWED.
  
  
 .CONST   MACRO  P1,P2,P3,P4
          LOCAL  SYMADDR
*      THIS LOCAL SYMBOL WILL NOT BE CLUTTERING UP THE SYMBOL TABLE 
*      BECAUSE IT IS USED ONLY FOR IMPLICIT *SETSY* FORMS 
          IFC    EQ, P1  ,2 
*      NO PARAMETERS,  ASSUME K0
 CONST    MICRO  1,, 1/0,W$FIXED/K0-FIXEDOFF
1         SKIP
 M1       MICRO  1,1, P1
          IFC    GE, "M1" 0 ,3
          IFC    LE, "M1" - ,2
*      CONSTANT 
          .CONST1  P1 
1         SKIP
          .CHKFUNC  P1
          IFEQ   #T1,0,2
          IFC    EQ, P3_P4  ,1
          SKIP   3
*      IMPLICIT *SETSY* REFERENCE 
*      (E.G.  ((A,B))  OR  ((A,B),C) )
*      (BUT NOT  A  OR  (A,B) ) 
 SYMADDR  SETSY  (P1),(P2)
 CONST    MICRO  1,, 1/1,W$FUNC/SETSYOF,W$SETSY/"SYMADDR" 
1         SKIP
          IF     DEF,/SETSY/P1,5
*      EXPLICIT *SETSY* REFERENCE 
          IF     ABS,/SETSY/P1,2
*      (EXPLICIT *SETSY* REFERENCED A GLOBAL DEFINITION)
 CONST    MICRO  1,, 1/1,W$FUNC/SETSYOF,W$FIXED//SETSY/P1 
          SKIP   1
*      (EXPLICIT *SETSY* REFERENCED A LOCAL DEFINITION) 
 CONST    MICRO  1,, 1/1,W$FUNC/SETSYOF,W$SETSY//SETSY/P1-.MODULE.
1         SKIP
          IF     DEF,/CONST/P1,2
*      EXPLICIT *CONSTANT* REFERENCE
 CONST    MICRO  1,, 1/1,W$FUNC/CONSTOF,W$SETSY//CONST/P1-.MODULE.
,ULE. 
1         SKIP
*      MUST BE NORMAL FUNCTION REFERENCE
          .ARG   C1,P1,P2 
 CONST    MICRO  1,, "C1" 
1         ENDIF 
 .CONST   ENDM
  
 .CONST1  MACRO  P1 
          LOCAL  LABL 
          IFC    LE, "M1" 9 ,10 
*      CONSTANT IS UNSIGNED 
 M1       DECMIC P1 
          IF     DEF,K"M1",3
          IFGE   K"M1",FIXEDOFF,2 
 CONST    MICRO  1,, 1/0,W$FIXED/K"M1"-FIXEDOFF 
          SKIP   7
*      (CANNOT USE P1 DIRECTLY BECAUSE OF POSSIBLE ASSEMBLY ERROR)
 #T1      MICCNT M1 
          IFLE   #T1,3,3
          IFLE   P1,M$FIXED,2 
*      CONSTANT CAN BE SPECIFIED IN *EQUALS* FUNCTION 
 CONST    MICRO  1,, 1/1,W$FUNC/EQUALS,W$FIXED/P1 
          SKIP   2
*      CONSTANT IS EITHER SIGNED OR TOO BIG 
 LABL     CONSTANT  P1
 CONST    MICRO  1,, 1/1,W$FUNC/CONSTOF,W$SETSY/LABL-.MODULE. 
 .CONST1  ENDM
  
  
  
  
**        FORCEUP -  FORCE UPPER
* 
*         .FORCEUP
* 
*         CAUSES INTERPRETATION TO CONTINUE FROM THE NEXT WORD BOUNDARY 
  
  
 .FORCEUP MACRO 
          IFNE   *P,60,3
          VFD    W$C/FORCEUP
          IFNE   *P,60,1
          VFD    *P/-0
 .FORCEUP ENDM
  
  
  
  
**        .GENVFD -  GENERATE CODE FOR *VFD* FIELDS 
* 
*         .GENVFD  NBITS,VALUE,(P2),(P3),(P4),... 
* 
*         GENERATES CODE FOR EACH FIELD.
*         SETS #PAIRCNT TO TOTAL NUMBER OF PAIRS. 
  
  
 .GENVFD  MACRO  NBITS,VALUE,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11
          .ARG   F1,NBITS 
*      SET "CONST" TO VALUE 
          .CONST VALUE
          VFD    "F1","CONST" 
 #PAIRCNT SET    #PAIRCNT+1 
          IFC    NE,^_P2_^^,1 
          .GENVFD  P2,(P3),(P4),(P5),(P6),(P7),(P8),(P9),(P10),(P11)
 .GENVFD  ENDM
  
  
  
**        .GEN1 -  GENERATE CODE FOR A CLASS 1 MACHINE INSTRUCTION
* 
*         .GEN1  OPNAME,REGI,REGJ,REGK
* 
*         CAUSES THE INDICATED INSTRUCTION TO BE GENERATED
  
  
 .GEN1    MACRO  OPNAM,REGI,REGJ,REGK 
          .VREGOF  F1,REGI
          .VREG  F2,REGJ
          .VREG  F3,REGK
          VFD    W$C/GEN1,W$OPNAME/OPNAM,"F2","F3","F1" 
 .GEN1    ENDM
  
  
  
  
**        .GEN2 -  GENERATE CODE FOR A CLASS 2 MACHINE INSTRUCTION
* 
*         .GEN2  OPNAME,REGI,X
* 
*         CAUSES THE INDICATED INSTRUCTION TO BE GENERATED. 
  
  
 .GEN2    MACRO  OPNAM,REGI,X 
          .VREGOF  F1,REGI
          .ARG   F2,X 
          VFD    W$C/GEN2,W$OPNAME/OPNAM,"F1","F2"
 .GEN2    ENDM
  
  
  
  
**        .GEN3 -  GENERATE CODE FOR A CLASS 3 MACHINE INSTRUCTION
* 
*         .GEN3  REGI,REGJ,ADDR 
* 
*     OR  .GEN3  REGI,ADDR
* 
*         CAUSES THE INDICATED MACHINE INSTRUCTION TO BE GENERATED. 
  
  
 .GEN3    MACRO  OPNAM,REGI,P2,P3 
          .VREG  F1,REGI
1         IFC    NE,^^_P3_^ 
          .VREG  F2,P2
*      SET "CONST"
          .CONST P3 
1         ELSE
          .VREG  F2 
*      SET "CONST"
          .CONST P2 
1         ENDIF 
          VFD    W$C/GEN3,W$OPNAME/OPNAM,"F2","F1","CONST"
 .GEN3    ENDM
  
  
  
  
**        .GEN4 -  GENERATE CODE FOR A CLASS 4 MACHINE INSTRUCTION
* 
*         .GEN4  OPNAME,ADDR
* 
*         CAUSES THE INDICATED MACHINE INSTRUCTION TO BE GENERATED. 
  
  
 .GEN4    MACRO  OPNAM,ADDR 
*      SET "CONST"
          .CONST ADDR 
          VFD    W$C/GEN4,W$OPNAME/OPNAM,"CONST"
 .GEN4    ENDM
  
  
  
  
**        .GEN5 -  GENERATE CODE FOR A CLASS 5 MACHINE INSTRUCTION
* 
*         .GEN5  OPNAM,LEN,ADDR1,BCP1,ADDR2,BCP2,REGX0,REGA0
* 
*         CAUSES CODE TO BE GENERATED FOR THE INDICATED BDP INSTRUCTION.
  
  
 .GEN5    MACRO  OPNAM,LEN,ADDR1,BCP1,ADDR2,BCP2,REGX0,REGA0
          .ARG   L,LEN
          .CONST ADDR1
 CONST1   MICRO  1,, "CONST"
          .ARG   B1,BCP1
          .CONST ADDR2
          .ARG   B2,BCP2
          .ARG   X0,REGX0 
          .ARG   A0,REGA0 
          VFD    W$C/GEN5,W$OPNAME/OPNAM-NO$,"X0","A0","L","CONST1","B1"
,,"CONST","B2"
 .GEN5    ENDM
  
  
  
  
**        .LISTSEC -  GENERATE A REAL *LISTSEC* MACRO DEFINITION
* 
*         .LISTSEC  ("STMT2"),("STMT3"),("STMT4"),("STMT5"),("STMT6") 
  
  
 .LISTSEC MACRO  S2,S3,S4,S5,S6 
 LISTSEC  MACRO  NAME 
1         IFC    NE, NAME * 
*  IF (LIST -L) FROM THE PREVIOUS *LISTSEC*, RESET WITH (LIST *)
          IFEQ   #LIST,0,2
          LIST   *
 #LIST    SET    1
S6
S5
S4
S3
S2
 #LIST    SET    0
          LIST   -L,-R       NAME 
1         ELSE
          IFEQ   #LIST,0,1
          LIST   *
1         ENDIF 
 LISTSEC  ENDM
 #LIST    SET    1
 .LISTSEC ENDM
  
  
  
  
**        .PARSE -  PARSE AN OBJECT-TIME ROUTINE NAME 
* 
*         .PARSE NAME 
* 
*                NAME = <OBJECT-TIME ROUTINE NAME>,  OR 
*                       (<OBJECT-TIME ROUTINE NAME>,<FIXED CELL>) 
* 
*         SETS "OBJNAME" = REFERENCE TO OBJECT-TIME ROUTINE.
*         SETS "M2" = 3-DIGIT OBJECT-TIME ROUTINE NUMBER. 
  
  
 .PARSE   MACRO  P1,P2
          IFC    EQ, P2  ,2 
 OBJNAME  MICRO  1,, W$OBJNAM/P1,1/0
          SKIP   1
 OBJNAME  MICRO  1,, W$OBJNAM/P1,1/1,W$FIXED/P2-FIXEDOFF
 M2       DECMIC P1,3 
 .PARSE   ENDM
  
  
  
  
**        .POP -  SET "M1" TO FIXEDCELL PARAMTERS IN REVERSE ORDER
* 
*         .POP   P2,P3,P4,P5,P6,P7,P8 
  
  
 .POP     MACRO  P2,P3,P4,P5,P6,P7,P8 
          IFC    NE, P2  ,2 
 M1       MICRO  1,, W$FIXED/P2-FIXEDOFF,1/1,"M1" 
          .POP   P3,P4,P5,P6,P7,P8
 .POP     ENDM
  
  
  
  
**        .PUSH -  SET "M1" TO FIXED CELL PARAMETERS
* 
*         .PUSH  P2,P3,P4,P5,P6,P7,P8 
  
  
 .PUSH    MACRO  P2,P3,P4,P5,P6,P7,P8 
          IFC    NE, P2  ,2 
 M1       MICRO  1,, "M1",1/1,W$FIXED/P2-FIXEDOFF 
          .PUSH  P3,P4,P5,P6,P7,P8
 .PUSH    ENDM
  
  
  
**        .SETSY -  GENERATE A *SETSY* REFERENCE LOCAL TO THE MODULE
* 
* NAME    .SETSY MOD,REG [,VAL] 
  
  
          MACRO  .SETSY,NAME,MOD,REG,VAL
          IFC    NE, VAL  ,4
          IFC    LE, VAL Z ,3 
          IFGE   VAL,FIXEDOFF,2 
 M2       MICRO  1,, 1/1,18/VAL-FIXEDOFF
          SKIP   1
 M2       MICRO  1,, 1/0,18/VAL 
          IFGE   REG,FIXEDOFF,2 
 M1       MICRO  1,, 12/MOD,18/REG-FIXEDOFF 
          SKIP   1
 M1       MICRO  1,, 12/MOD,18/REG
          QUAL   SETSY
          USE    SETSY
 NAME     VFD    "M1",11/0,"M2" 
          USE    *
          QUAL   *
 NAME     MICRO  1,, /SETSY/NAME-.MODULE. 
 .SETSY   ENDM
  
  
  
  
**        .VREG -  GENERATE SHORT FORM FOR VREG_N 
* 
*      DOES:  
*         IF PARAMETER IS A FIXED CELL IN THE CORRECT RANGE,
*         THE SHORT FORM OF (5/N) WILL BE GENERATED,
*         ELSE A LONG FORM OF (5/0,FUNCTION) WILL BE GENERATED. 
  
 .VREG    MACRO  MIC,P1,P2
          IFC    EQ, P2  ,6 
          IFC    NE, P1  ,5 
          IFGE   P1,FIXEDOFF,4
          IFGE   P1,VREGB0,3
          IFLE   P1,VREGB0+30,2 
 MIC      MICRO  1,, 5/P1-VREGB0+1
          SKIP   5
          IFC    EQ, P1  ,2 
 MIC      MICRO  1,, 5/1
          SKIP   2
          .ARG   .VREG,P1,P2
 MIC      MICRO  1,, 5/0,".VREG"
 .VREG    ENDM
  
  
  
  
**        .VREGOF -  GENERATE SHORT FORM FOR (VREGOF,VREG_N)
* 
*      DOES:  
*         IF FUNCTION IS *VREGOF* AND ARGUMENT IS A FIXED CELL
*         IN THE CORRECT RANGE, 
*         THE SHORT FORM OF (5/N) WILL BE GENRATED, 
*         ELSE A LONG FORM OF (5/0,FUNCTION) WILL BE GENERATED. 
  
  
 .VREGOF  MACRO  MIC,P1,P2
          IFC    EQ, P1 VREGOF ,6 
          IFC    NE, P2  ,5 
          IFGE   P2,FIXEDOFF,4
          IFGE   P2,VREGB0,3
          IFLE   P2,VREGB0+30,2 
 MIC      MICRO  1,, 5/P2-VREGB0+1
          SKIP   2
          .ARG   .VREG,P1,P2
 MIC      MICRO  1,, 5/0,".VREG"
 .VREGOF  ENDM
  
  
  
  
          SPACE  2
          PURGMAC  DEF
 DEF      MACRO  NAME 
 M1       MICRO  1,8, NAME
 "M1"     BSS    1
          ENDM
          SPACE  3
 CONTROL  OPSYN  NIL
*CALL GTEXT 
*CALL DNATVALS
          PURGMAC  STATUS 
*CALL OPMACS
*CALL OPNAMES 
*CALL DUPMACS 
*CALL OBJDEFS 
*CALL RESERVE 
*CALL INSTBLK 
*CALL MACDEFS 
*CALL REGTYPE 
          END 
