*COMDECK  COMCMAC 
          CTEXT  COMCMAC - RHF APPLICATION MACRO DEFINITIONS. 
          SPACE  4
          BASE   D
  
  
*         COMMENT  COPYRIGHT CONTROL DATA CORP. 1980. 
          SPACE  4,10 
***       COMCMAC - RHF APPLICATION MACRO DEFINITIONS.
* 
*         J. G. CLARK        79/11/01.
          SPACE  4,10 
***              COMCMAC CONTAINS THE CPU COMPASS MACROS
*         USED BY THE REMOTE HOST FACILITY APPLICATIONS.
* 
*         MACRO/OPDEF NAMES 
* 
*                ACFETCH
*                ACSTORE
*                APFETCH
*                APSTORE
*                BSSN 
*                BUF
*                CADDRE 
*                CONTRLC (NOS ONLY) 
*                CSTMT
*                DEFPAR 
*                DEFPOS 
*                ERRMSG 
*                GADDR
*                LOADREQ (NOS ONLY) 
*                MACREF 
*                MXB,X  (OPDEF) 
*                MX-B,X (OPDEF) 
*                PADDRE 
*                RJL
*                SUBRL
*                #DEF#
      SPACE 4,10
  
*     COMMON   OS DEFINITIONS 
  
*IF DEF,NOSBE 
 OS$NOS   EQU    1
 OS$NOSBE EQU    0
*ENDIF
*IF -DEF,NOSBE
 OS$NOS   EQU    0
 OS$NOSBE EQU    1
*ENDIF
          SPACE  4,10 
***       BSSN - EQUENTIAL TAG DEFINITION WITHOUT RESERVING SPACE 
* 
* 
* BEGIN   BSSN   A                 BEGIN TAG DEFINITION SEQUENCE
* TAG1    BSSN   N
* .       .      .
* .       .      .
* TAGN    BSSN,N
* END     BSSN
* 
*         TO HAVE THE TAG VALUES DISPLAYED ON A LISTING A *LIST G*
*         CARD MUST BE USED BEFORE THIS MACRO IS CALLED.
* 
*         A = NUMBER TO START TAG DEFINITION AT 
*         N = NUMBER OF LOCATION RESERVED TO THIS TAG.
          SPACE  2
          PURGMAC BSSN
          MACRO  BSSN,T,N 
.1 IFC EQ,*T*BEGIN* 
.2 IFC NE,*N**
  LOC N 
.2 ELSE 1 
  LOC 0 
.3 SKIP 
.1 ENDIF
.2 IFC EQ,*T*END* 
  LOC *O
.3 SKIP 
.2 ENDIF
  IFC NE,*T**,1 
T EQU * 
  LOC *+N 
.3 ENDIF
  ENDM
          SPACE  4,10 
**        BUF - ALLOCATE BUFFER SPACE.
* 
*         BUF DEFINES STORAGE AS DEFINED FOR THE BSSN MACRO.
*         ADDITIONALLY, THE LENGTH OF THE BUFFER IS DEFINED AS
*         THE BUFFER NAME WITH AN *L* APPENDED. 
* 
*NAME     BUF    LEN
* 
*         NAME   - THE BUFFER NAME. 
*         LEN    - THE BUFFER LENGTH. 
  
  
          PURGMAC  BUF
  
          MACRO  BUF,NAME,LEN 
  MACREF BUF
 NAME EQU * 
  LOC *+LEN 
 NAME_L EQU LEN 
 BUF      ENDM
          SPACE  4,10 
**        CADDRE - COMMAND PROCESSOR ADDRESS TABLE ENTRY. 
* 
*         MACRO CADDRE IS USED TO DEFINE A TABLE OF VALUES AND
*         CORRESPONDING PROCESSOR ADDRESSES TO BE USED IN THE 
*         FTF APPLICATION LIBRARY ROUTINE *EPT*.
* 
*[NAME]   CADDRE CMND,ADDR
* 
*         TABLE ENTRY FORMAT
*  NAME   42/ /AC/CMND, 18/ ADDR
* 
*         NAME   - TABLE NAME.
*         CMND   - COMMAND MNEMONIC (*AC* QUALIFIED.) 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR SUBROUTINE. 
  
  
          PURGMAC  CADDRE 
  
 CADDRE   MACRO  CMND,ADDR
  MACREF CADDRE 
  VFD 42//AC/CMND,18/ADDR+1 
 CADDRE   ENDM
          SPACE  4,10 
**        CSTMT - CONTROL STATEMENT PROCESSOR ADDRESS.
* 
*         MACRO CSTMT IS USED TO DEFINE A TABLE OF CONTROL STATEMENT
*         NAMES AND CORRESPONDING PROCESSOR ADDRESSES.  THE TABLE 
*         FORMAT AND USE IS IDENTICAL TO THAT OF CADDRE.
* 
*[TAG]    CSTMT  NAME,ADDR
* 
*         TABLE ENTRY FORMAT
*  TAG    42/ NAME,18/ ADDR 
* 
*         ADDR   - ADDRESS OF PROCESSOR.
  
  
          PURGMAC  CSTMT
  
 CSTMT    MACRO  NAME,ADDR
  MACREF CSTMT
  VFD 42/0L_NAME,18/ADDR+1
 CSTMT    ENDM
          SPACE  4,10 
**        DEFPAR - DEFINE PARAMETER NAME, ADDRESS, AND ATTRIBUTES.
* 
*         DEFPAR DEFINES A CONTROL STATEMENT PARAMETER BY NAME.  THE
*         PARAMETER NAME CAN BE ONE OR TWO CHARACTERS.  THE MINIMUM 
*         LENGTH AND MAXIMUM LENGTH OF ALLOWED PARAMETER VALUES CAN 
*         BE SPECIFIED.  THE VALUE CAN ALSO BE CONVERTED (DXB) FROM 
*         DISPLAY CODE TO BINARY BEFORE STORING.
* 
*[NAME]   DEFPAR PNAME,[MIN],[MAX],[CONVERT]
* 
*         TABLE ENTRY FORMAT
*  NAME   12/ PNAME,1/0,6/0,1/C,11/ MIN,11/ MAX,18/ ADDR
* 
*         PNAME  - PARAMETER NAME (1 OR 2 CHARACTERS).
*         C      - CONVERT PARAMETER VALUE (0 - NO CONVERSION). 
*         MIN    - MINIMUM NUMBER OF CHARACTERS IN VALUE (0 - NO VALUE).
*         MAX    - MAXIMUM NUMBER OF CHARACTERS IN VALUE. 
*         ADDR   - ADDRESS OF PARAMETER TO STORE VALUE AT.
  
  
          PURGMAC  DEFPAR 
  
 DEFPAR   MACRO  PNAME,MIN,MAX,CONVERT
  MACREF DEFPAR 
  NOREF .7
  NOREF .8
  NOREF .9
 .1 IFC NE,*PNAME** 
 .9 MICRO 3,, PNAME 
 .1 IFC EQ,*".9"**
 .1 ELSE
  ERR A 1 OR 2 CHARACTER PARAMETER NAME MUST BE USED. 
 .1 ENDIF 
 .9 SET 1 
 .8 SET 0 
 .7 SET 0 
 .1 IFC NE,*MIN** 
 .9 SET MIN 
 .2 IFC EQ,*MAX** 
 .8 SET MIN 
 .2 ELSE
 .8 SET MAX 
 .2 ENDIF 
 .1 ELSE
 .1 IFC NE,*MAX** 
 .9 SET MAX 
 .8 SET MAX 
 .1 ENDIF 
  IFC NE,*CONVERT**,1 
 .7 SET 1 
  VFD 12/0L_PNAME,1/0,6/0,1/.7,11/.9*6-6,11/.8*6,18/PNAME 
 DEFPAR   ENDM
          SPACE  4,10 
**        DEFPOS - POSITIONAL PARMETER ATTRIBUTES DEFINITION. 
* 
*         DEFPOS DEFINES A PARAMETER BY POSITION.  THE PARAMETER MAY
*         BE REQUIRED TO FOLLOW AN EQUALS SIGN.  THE MINIMUM AND
*         MAXIMUM CHARACTER COUNT IN THE PARAMETER MAY BE SPECIFIED.
*         THE VALUE CAN BE SPECIFIED TO BE CONVERTED (DXB) FROM 
*         DISPLAY CODE TO BINARY BEFORE STORING.
* 
*[NAME]   DEFPOS PN,PNAME,[MIN],[MAX],[CONVERT] 
* 
*         TABLE ENTRY FORMAT
*  NAME   12/ -PN,1/E,1/D,5/0,1/C,11/ MIN,11/ MAX,18/ ADDR
* 
*         PN     - POSITIONAL PARAMETER POSITION NUMBER.
*         E      - PARAMETER USED AS VALUE (0 - NOT A VALUE). 
*         D      - ALLOWS PARAMETERS TO BE GREATER THAN 10 CHARACTERS 
*         C      - CONVERSION REQUIRED (0 - CONVERSION NOT REQUIRED). 
*         MIN    - MINIMUM NUMBER OF CHARACTERS REQUIRED. 
*         MAX    - MAXIMUM NUMBER OF CHARACTERS ALLOWED.
*         ADDR   - ADDRESS TO STORE PARAMETER AT. 
  
  
          PURGMAC  DEFPOS 
  
 DEFPOS   MACRO  PN,PNAME,MIN,MAX,CONVERT,DOUBLE
  MACREF DEFPOS 
  NOREF .4
  NOREF .5
  NOREF .7
  NOREF .8
 .9 MICRO 1,1, PNAME
 .1 IFC NE,*".9"*#* 
 .6 MICRO 1,, PNAME 
 .5 SET 0 
 .1 ELSE
 .6 MICRO 2,, PNAME 
 .5 SET 1 
 .1 ENDIF 
 .1 IFC NE,*MIN** 
 .8 SET MIN 
 .2 IFC NE,*MAX** 
 .7 SET MAX 
 .2 ELSE
 .7 SET MIN 
 .2 ENDIF 
 .1 ELSE
 .2 IFC NE,*MAX** 
 .7 SET MAX 
 .8 SET MAX 
 .2 ELSE
 .7 SET 0 
 .8 SET 1 
 .2 ENDIF 
 .1 ENDIF 
 .1 IFC NE,*CONVERT** 
 .4 SET 1 
 .1 ELSE
 .4 SET 0 
 .1 ENDIF 
 .1 IFC NE,*DOUBLE**
 .3 SET 1 
 .1 ELSE
 .3 SET 0 
 .1 ENDIF 
  VFD 12/-PN,1/.5,1/.3,5/0,1/.4,11/.8*6-6,11/.7*6,18/".6" 
 DEFPOS   ENDM
          SPACE  4,10 
**        ERRMSG - GENERATE ERROR MESSAGE.
* 
*         ERRMSG GENERATES ERROR MESSAGES AND PROVIDES THE
*         LENGTH OF THE MESSAGE IN CHARACTERS.  EACH MESSAGE
*         SHOULD BE TERMINATED BY A PERIOD (.) BUT ONE WILL 
*         BE PROVIDED IN IT-S ABSENCE.
* 
*MSGN     ERRMSG (ERROR MESSAGE.) 
* 
*         MSGN   - NAME ASSIGNED TO THE MESSAGE ADDRESS.
*         MSGNL  - LENGTH OF THE MESSAGE IN CHARACTERS. 
  
  
          PURGMAC  ERRMSG 
  
          MACRO  ERRMSG,TAG,P 
  MACREF ERRMSG 
  NOREF  .2 
 .1 MICRO 1,,.P.
 .2 MICCNT .1 
 .3 DECMIC .2+1 
 TAG EQU =".3"C".1".
 TAG_L EQU .2+1 
 ERRMSG   ENDM
          SPACE  4,10 
**        GADDR - GENERATE ADDRESS CONSTANT.
* 
*         GADDR GENERATES AN ADDRESS TO CONTAIN A CONSTANT IF AN
*         ADDRESS CONTAINING THE CONSTANT IS NOT ALREADY DEFINED. 
*         THE CONSTANT TO BE DEFINED SHOULD BE IN THE FORMAT AS 
*         REQUIRED BY THE *CON* PSEUDO OP.  ALL ADDRESSES FOR 
*         CONSTANTS ARE GENERATED IN THE QUALIFIED BLOCK *CONSTANT*.
* 
*         GADDR  ADDR,Q 
* 
*         ADDR   - CONSTANT TO GENERATE ADDRESS FOR.
*         Q      - QUALIFIER VALUE MAY BE DEFINED UNDER.
  
  
          PURGMAC  GADDR
  
 GADDR    MACRO  ADDR,Q 
          LOCAL  TAG
  NOREF  .6 
 .7 IF -REG,ADDR
 .9 MICRO 1,1, ADDR 
 .1 IFC NE,*".9"*=* 
 .6 IFC EQ,*".9"*/* 
 .9 MICRO 2,, ADDR
 .7 MICRO 1,,/".9"
 .6 MICCNT .7 
 .9 MICRO .6+3,, ADDR 
 .6 ELSE
 .7 MICRO 1,, Q 
 .9 MICRO 1,, ADDR
 .6 ENDIF 
 .8 MICRO 1,, "QUAL"
 .2 IF -DEF,/".8"/".9"
 .3 IF -DEF,".9"
  QUAL CONSTANT 
 .4 IF -DEF,".9"
 .5 IF DEF,/".7"/".9" 
  USE CONSTANT
 ".9" CON /".7"/".9"
  USE * 
 .4 ENDIF 
  CON ".9"
  QUAL *
 .5 ELSE
  QUAL *
  CON ADDR
 .5 ENDIF 
 .1 ELSE
 .9 MICRO 1,, ADDR
 .3 ENDIF 
 .2 ENDIF 
  CON ".9"
 .1 ENDIF 
 .7 ELSE
 TAG BSS 1
 GADDR RMT
  R= X7,ADDR
  SA7 TAG 
  RMT 
 .7 ENDIF 
 GADDR    ENDM
          SPACE  4,10 
**        MACREF - GENERATE SYMBOLIC REFERENCE TABLE LISTING
* 
*         CAUSES THE MACRO NAME TO BE LISTED IN THE SYMBOLIC
*         REFERENCE TABLE UNDER THE QUALIFIER *MACRO$*. 
* 
*         MACREF MNAME
*                MNAME - MACRO NAME FOR REFERENCE TABLE 
  
          PURGMAC MACREF
 MACREF   MACRO  N
  QUAL MACRO$ 
N SET * 
  QUAL *
  ENDM
          SPACE  4,10 
**        MXB,X - GENERATE MASK (XI) OF BJ BITS USING XK. 
* 
*         MXI    BJ,XK
* 
*         XI     - X REGISTER TO CONTAIN MASK.
*         BJ     - B REGISTER CONTAINING MASK COUNT.
*         XK     - X REGISTER TO BE DESTROYED.
* 
*         ENTRY  B1 = 1.
  
  
 MXB,X    OPDEF  I,J,K
  MACREF MXB
  MX.K 1
  AX.I X.K,B.J
  LX.K X.I,B1 
  BX.I X.K*X.I
 MXB,X    ENDM
          SPACE  4,10 
**        MX-B,X - FORM MASK (XI) OF -BJ BITS USING XK. 
* 
*         MXI    -BJ,XK 
* 
*         XI     - X REGISTER TO CONTAIN MASK.
*         BJ     - B REGISTER CONTAINING NEGATIVE MASK COUNT. 
*         XK     - X REGISTER TO BE DESTROYED.
* 
*         ENTRY  B1 = 1.
  
  
 MX-B,X   OPDEF  I,J,K
  MACREF MXB
  MX.K 1
  LX.I X.K,B.J
  LX.K X.I,B1 
  BX.I X.K*X.I
 MX-B,X   ENDM
          SPACE  4,10 
**        PADDRE - PARAMETER PROCESSOR ADDRESS TABLE ENTRY. 
* 
*         PADDRE DEFINES A TABLE OF PROTOCOL PARAMETER VALUES AND 
*         CORRESPONDING PROCESSOR ADDRESSES.  THE FORMAT AND USE
*         OF THIS MACRO IS IDENTICAL TO *CADDRE*. 
* 
*[NAME]   PADDRE PARAM,ADDR 
* 
*         TABLE ENTRY FORMAT
*  NAME   42/ /AP/PARAM,18/ ADDR
* 
*         NAME   - TABLE NAME.
*         PARAM  - PARAMETER MNEMONIC (*AP* QUALIFIED.) 
*         ADDR   - ADDRESS OF PARAMETER PROCESSOR SUBROUTINE. 
  
  
          PURGMAC  PADDRE 
  
 PADDRE   MACRO  PARAM,ADDR 
  MACREF PADDRE 
  VFD 42//AP/PARAM,18/ADDR+1
 PADDRE   ENDM
          SPACE  4,10 
**        RJL - RETURN JUMP WITH PARAMETER LIST.
* 
*         RJL PROVIDES THE COMPASS EQUIVALENT OF THE FORTRAN
*         CALL STATEMENT.  A PARAMETER LIST IS BUILT IN LINE
*         WITH THE RETURN JUMP TO THE SUBROUTINE. 
* 
*[TAG]    RJL    ADDR,P1,(P2...PN)
* 
*         ADDR   - THE SUBROUTINE ENTRY POINT.
*         P(I)   - THE ITH PARAMETER ADDRESS. 
  
  
          PURGMAC  RJL
  
 RJL      MACRO  ADDR,P1,Q
          LOCAL  TAG,TAG2 
  MACREF RJL
  NOREF .P
 .1 IFC NE,*P1**
  VFD 0/0 
 .P SET *P
  IFEQ .P,15,1
  SA1 TAG2
  IFEQ .P,60,1
  SA1 TAG2
  EQ TAG
 TAG2 GADDR P1
  IRP Q 
  GADDR Q 
  IRP 
 TAG BSS 0
 GADDR HERE 
  IFGT .P,15,2
  IFLT .P,60,1
  SA1 TAG2
 .1 ENDIF 
  RJ ADDR 
 RJL      ENDM
          SPACE  4,10 
**        SUBRL - DEFINE SUBROUTINE AND PARAMETERS. 
* 
*         SUBRL GENERATES SUBROUTINE ENTRY CODE TO STORE
*         PARAMETERS FROM A FORTRAN CALL OR COMPASS *RJL* 
*         MACRO CALL.  REGISTER A0 IS USED IN FTN CONVENTION
*         TO STORE THE PARAMETER LIST.  THE CALLER-S A0 IS
*         SAVED FOR RESTORATION UPON EXITING.  EACH PARAMETER 
*         CAN, OPTIONALLY, BE STORED.  ADDITIONALLY, MICROS 
*         ARE DEFINED FOR EACH PARAMETER WHICH IDENTIFIES 
*         THE OFFSET INTO THE PARAMETER LIST.  THE SUBROUTINE IS
*         QUALIFIED BY THE SUBROUTINE NAME. 
* 
*NAME     SUBRL  (P1,P2,P3,...,PN)
* 
*         NAME   - NAME OF SUBROUTINE.
*         PN     - PARAMETER N. 
* 
*         "PN" IS A MICRO DEFINED AS *A0+N-1* WHICH POINTS
*         TO THE PARAMETER LIST ADDRESS CONTAING THE PARAMETER
*         ADDRESS.
* 
*         IF #PN IS USED THE PARAMETER VALUE IS NOT STORED BUT THE
*         MICRO "PN" IS DEFINED AS ABOVE. 
  
  
          PURGMAC  SUBRL
  
          MACRO  SUBRL,TAG,PN 
          LOCAL  T
  MACREF SUBRL
  NOREF /TAG/.9 
  IFC EQ,*TAG**,1 
  ERR A LABEL IS REQUIRED 
  QUAL TAG
 .9 SET 0 
  IRP PN
 .7 IFC NE,*PN**
 .8 DECMIC .9 
 .1 MICRO 1,1, PN 
 .2 IFC NE,*".1"*#* 
 PN BSS 1 
 PN MICRO 1,, A0+".8"D
 .2 ELSE
 .3 MICRO 2,, PN
 ".3" MICRO 1,, A0+".8"D
 .2 ENDIF 
 .7 ENDIF 
 .9 SET .9+1
  IRP 
 T BSS 1
 TAG_X SA2 T
  SA0 X2+ 
 TAG DATA 0 
  QUAL *
 TAG EQU /TAG/TAG 
  QUAL TAG
  SX7 A0
  SA7 T 
  SA0 A1
  IRP PN
 .7 IFC NE,*PN**
 .1 MICRO 1,1, PN 
 .2 IFC NE,*".1"*#* 
  SA2 "PN"
  SA3 X2
  BX7 X3
  SA7 PN
 .2 ENDIF 
 .7 ENDIF 
  IRP 
 SUBRL    ENDM
          TITLE  COMCMAC - RHF APPLICATION PROTOCOL PROCESSOR MACROS. 
**        ACFETCH - FETCH APPLICATION COMMAND.
* 
*         ACFETCH PROVIDES THE FORTRAN LIKE CALL TO THE RHF LIBRARY 
*         ROUTINE *ACFETCH*.  FOR MORE INFORMATION ON THE PARAMETERS
*         SEE THE RHF APPLICATIONS GID. 
* 
*[TAG]    ACFETCH  BUFF,TXTL[,CMND] 
* 
*         BUFF   - HEADER WORD IMMEDIATELY PRECEDING THE TEXT AREA
*                  RECEIVED BY NETGET.
*         TXTL   - LENGTH OF TEXT BUFFER, IN CHARACTERS.
*         CMND   - ADDR FOR SAVING RETURNED COMMAND NUMBER (INTEGER). 
  
  
          PURGMAC  ACFETCH
  
 ACFETCH  MACRO  BUFF,TXTL,CMND 
  MACREF ACFETCH
  RJL =XACFETCH,BUFF,(TXTL) 
  IFC NE,*CMND**,1
  SA6 CMND
 ACFETCH  ENDM
          SPACE  4,10 
**        ACSTORE - STORE APPLICATION COMMAND.
* 
*         ACSTORE PROVIDES THE FORTRAN LIKE CALL TO THE RHF LIBRARY 
*         ROUTINE *ACSTORE*.  FOR MORE INFORMATION ON THE PARAMETERS
*         SEE THE RHF APPLICATIONS GID. 
* 
*[TAG]    ACSTORE  BUFF,CMND,BUFL 
* 
*         BUFF   - MESSAGE BUFFER TO BE NETPUT, PRECEEDED BY ONE
*                WORD (CONTAINS THE BUFFER LENGTH). 
*         CMND   - COMMAND VALUE, RIGHT JUSTIFIED.
*         BUFL   - BUFFER LENGTH IN WORDS, INCLUDING HEADER.
  
  
  
          PURGMAC  ACSTORE
  
 ACSTORE  MACRO  BUFF,CMND,BUFL 
          LOCAL  TAG,TAG2 
  MACREF ACSTORE
  NOREF .P
  VFD 0/0 
 .P SET *P
  IFEQ .P,15,1
  SA1 TAG2
  IFEQ .P,60,1
  SA1 TAG2
  EQ TAG
 TAG2 GADDR BUFF
  GADDR CMND,AC 
  GADDR BUFL
 TAG BSS 0
 GADDR HERE 
  IFGT .P,15,2
  IFLT .P,60,1
  SA1 TAG2
  RJ =XACSTORE
 ACSTORE  ENDM
          SPACE  4,10 
**        APFETCH - FETCH APPLICATION PARAMETER.
* 
*         APFETCH PROVIDES THE FORTRAN LIKE CALL TO THE RHF LIBRARY 
*         ROUTINE *APFETCH*.  FOR MORE INFORMATION ON THE PARAMETERS
*         SEE THE RHF APPLICATIONS GID. 
* 
*[TAG]    APFETCH  BUFF,ATTR,QUAL,TEXTL,TEXT
* 
*         BUFF   - BUFFER RETURNED ON NETGET, PRECEEDED BY ONE
*                WORD.
*         ATTR   - ADDRESS OF ATTRIBUTE TO BE FETCHED.
*         QUAL   - ADDRESS OF QUALIFIER TO BE FETCHED.
*         TEXTL  - TEXT LENGTH IN CHARACTERS. 
*         TEXT   - ADDRESS OF TEXT TO BE FETCHED. 
  
  
          PURGMAC  APFETCH
  
 APFETCH  MACRO  BUFF,ATTR,QUAL,TEXTL,TEXT
  MACREF APFETCH
  RJL =XAPFETCH,BUFF,(ATTR,QUAL,TEXTL,TEXT) 
 APFETCH  ENDM
          SPACE  4,10 
**        APSTORE - STORE APPLICATION PARAMETER.
* 
*         APSTORE PROVIDES THE FORTRAN LIKE CALL TO THE RHF LIBRARY 
*         ROUTINE *APSTORE*.  FOR MORE INFORMATION ON THE PARAMETERS
*         SEE THE RHF APPLICATIONS GID. 
* 
*[TAG]    APSTORE  BUFF,ATTR,QUAL,TEXTL,TEXT
* 
*         BUFF   - ADDRESS OF BUFFER TO BE NETPUT,
*                PRECEEDED BY ONE WORD. 
*         ATTR   - ADDRESS OF ATTRIBUTE TO BE STORED. 
*         QUAL   - ADDRESS OF QUALIFIER TO BE STORED. 
*         TEXTL  - TEXT LENGTH IN CHARACTERS. 
*         TEXT   - ADDRESS OF TEXT TO BE STORED.
  
  
          PURGMAC  APSTORE
  
 APSTORE  MACRO  BUFF,ATTR,QUAL,TEXTL,TEXT
          LOCAL  TAG,TAG2 
  MACREF APSTORE
  NOREF .P
  VFD 0/0 
 .P SET *P
  IFEQ .P,15,1
  SA1 TAG2
  IFEQ .P,60,1
  SA1 TAG2
  EQ TAG
 TAG2 GADDR BUFF
  GADDR ATTR,AP 
  GADDR QUAL,CONSTANT 
  GADDR TEXTL,AP
  GADDR TEXT
 TAG BSS 0
 GADDR HERE 
  IFGT .P,15,2
  IFLT .P,60,1
  SA1 TAG2
  RJ =XAPSTORE
 APSTORE  ENDM
          SPACE  4,10 
***       COMPASS/SYMPL DECLARATION MACROS
* 
*         THE #DEF# MACRO PERMITS SOURCE LINES TO CONTAIN 
*         BOTH A *COMPASS* AND A *SYMPL* DECLARATION OF A VARIABLE. 
*         COMMENTS ARE USED TO HIDE INSTRUCTIONS OF ONE LANGUAGE
*         FROM THE OTHER LANGUAGE.  IN *SYMPL*, COMMENTS ARE
*         DELIMITED BY THE (#) CHARCTER.  PERSONS MODIFYING LINES 
*         LINES WITH BOTH *COMPASS* AND *SYMPL* DECCLARATIONS SHOULD
*         ENSURE THAT THE VARIABLES IS DEFINED TO HAVE THE SAME VALUE 
*         IN BOTH LANGUAGES.
          SPACE 4 
***       #DEF# - DEFINE *SYMPL*/*COMPASS* VARIABLE 
* 
* #NAMEC  #DEF#  VALUE             #NAMES #VALUE#;
*         NAMEC = THE *COMPASS* NAME OF A VARIABLE
*         NAMES = THE *SYMPL* NAME OF THE SAME VARIABLE.
*         VALUE = THE VALUE TO BE ASSIGNED TO THE VARIABLE. 
*                 BOTH INSTANCES MUST HAVE THE SAME NUMERIC 
*                 VALUE ALTHOUGH THEIR REPRESNETATION MAY 
*                 DIFFER ( E.G. 16D VS 16 OR 32B VS O"32"). 
  
  
          PURGMAC #DEF# 
          MACRO  #DEF#,N,V
 .1 MICRO 2,,$N$
 ".1" EQU V 
 #DEF#    ENDM
          SPACE  4,10 
 NOS      IFEQ   OS$NOS 
  
  
*         DEFINE NOS/BE RA.XXX SYMBOLS IN TERMS OF THE EQUIVALENT 
*         NOS XXXR SYMBOL.
  
          SYSCOM
  
 RA.SSW   EQU    0           SENSE SWITCHES 
 RA.ARG   EQU    ARGR        FIRST CONTROL CARD ARGUMENT
 RA.PGN   EQU    PGNR        PROGRAM NAME (BITS 59 - 18)
 RA.LAPR  EQU    53B         LAST USABLE PARAMETER WORD 
 RA.ACT   EQU    ACTR        ARGUMENT COUNT (BITS 17 - 0) 
 RA.LWP   EQU    LWPR        LWA+1 ASSIGNED PROGRAM SPACE (BITS 17 - 0) 
 RA.FWP   EQU    FWPR        FWA ASSIGNED PROGRAM SPACE (BITS 17 - 0) 
 RA.JOP   EQU    JOPR        JOB ORIGIN TYPE
 RA.LDR   EQU    LDRR        *LDR* COMPLETION (BIT 29)
 RA.CCD   EQU    CCDR        CONTROL CARD (8 LOCATIONS) 
 RA.ORG   EQU    100B        PROGRAM ORIGIN 
 CONTRLC  SPACE  4,10 
***       CONTRLC - READ NEXT CONTROL CARD. 
* 
* 
*         CONTRLC STATUS,FUNCT,DAYFILE,CRACK
* 
*         ENTRY  *STATUS* = ADDRESS FOR RESPONSE WORD.
*                *FUNCT*  = *READ* OR *BKSP* OR BLANK.  IF BLANK, FUNCT 
*                           CODE IS ASSUMED ALREADY STORED IN (STATUS). 
*                *DAYFILE* = IF NONBLANK, ISSUE CARD TO DAYFILE.
*                *CRACK* = IF NONBLANK, CRACK PARAMETERS INTO RA+2 ET 
*                          SEQ. 
*         USES   X2, IF *DAYFILE* AND/OR *CRACK* SPECIFIED. 
*         CALLS  SYS=.
  
  
          PURGMAC CONTRLC 
  
 CONTRLC  MACRO  S,F,D,C
  MACREF CONTRLC
*                            SETUP STATUS WORD IF FUNCT SPECIFIED 
  IFC NE, F  ,8D
  IFC EQ, F READ ,2 
  SX6 10B 
  SKIP 4
  IFC EQ, F BKSP ,2 
  SX6 40B 
  SKIP 1
  ERR  CONTRLC - ILLEGAL FUNCTION (F) 
  R= A6,S 
*                            FORM *ACE* REQUEST 
  SX6 3RACE*4+1 
  R= X1,S 
  LX6 40D 
  BX6 X6+X1 
  IFC NE, C  ,5 
  IFC NE, D  ,2 
  SX1 3 
  SKIP 4
  R= X1,1 
  SKIP 2
  IFC NE, D  ,3 
  R= X1,2 
  LX1 24D 
  BX6 X6+X1 
*                            PROCESS SYSTEM REQUEST 
  RJ =XSYS= 
  ENDM
 LOADREQ  SPACE  4,7
***       LOADREQ - CALL SYSTEM LOADER VIA PPU. 
* 
* 
*         LOADREQ PLIST,RECALL
* 
*         ENTRY  *PLIST* = FWA OF PARAMETER LIST. 
*         CALLS  SYS=.
  
  
          PURGMAC LOADREQ 
  
 LOADREQ  MACRO  P,R,F
  MACREF LOADREQ
  IFC EQ, F  ,2 
*                            NORMAL CALL
  SYSTEM LDV,R,P
  SKIP 8D 
  SX1 P 
  IFC EQ, F DATA ,2 
*                            LOAD OVERLAY AS DATA 
  RJ =XLOD= 
  SKIP 4
  IFC EQ, F CMM ,2
*                            LOAD OVERLAY VIA CMM 
  RJ =XCMM.LDV
  SKIP 1
A ERR UNKNOWN PARAM - F 
  ENDM
          SPACE  4,10 
 NOS      ENDIF 
          SPACE  4
          BASE   *
          SPACE  4
          ENDX
