*COMDECK /CRMCOM/ 
* 
* CALL CMNTXT               CMNTXT   *COMDECK CMNTXT
*CALL /CMNTXT/
*#                                                                      003200
**    CRM 1.5 IMS   COPYRIGHT CONTROL DATA SYSTEMS INC. 1994
**    CHAPTER 2     MACROS AND SYMBOLS
**    SECTION 2     CRM USER MACROS 
*X               CRM USER MACROS
*0CD  INTRODUCTION                                                      003700
*0        THIS SECTION DESCRIBES MACROS INTENDED FOR                    003800
*         CRM USERS CODING IN COMPASS. CRM I/O FOR                      003900
*         HIGHER LEVEL LANGUAGE USERS IS NORMALLY                       004000
*         HANDLED BY THE LANGUAGE OBJECT-TIME I/O                       004100
*         PACKAGE AND IS TRANSPARENT TO THE USER                        004200
*         UNLESS SOMETHING OTHER THAN THE LANGUAGE                      004300
*         DETERMINED FILE FORMAT DEFAULTS IS REQ-                       004400
*         UIRED.                                                        004500
*0        THIS SECTION CONTAINS DESCRIPTIONS OF ALL THE                 004600
*         CRM USER MACROS IN ALPHABETICAL ORDER; THE                    004700
*         ORDER OF THE COMPASS LISTING IS NOT STRICTLY                  004800
*         ALPHABETICAL. THE CRM USER MACROS, IN THE ORDER               004900
*         THEY MAY BE FOUND IN THE COMPASS LISTING, ARE 
*0                  CHECK,CLOSEL,CLOSEM,                                005100
*                   FETCH,FILE,                                         005200
*                   GET,GETL,GETP 
*                   OPENM                                               005400
*                   PUTL,PUTP                                           005500
*                   SKIPBX (X=L/P/F)                                    005600
*                   SKIPFX (X=L/P/F)                                    005700
*                   WEOR                                                005800
*0                  *MNAME* ECHO GENERATED MACROS:  
*0                   ENDFILE,REWINDM,WTMK 
*                    GETN,SEEK                                          006100
*                    DELETEM,PUT,REPLACEM.                              006200
*0        ALL MACROS HAVE THE FET/FIT ADDRESS AS THEIR FIRST PARAMETER. 
*         ALL PARAMETERS EXCEPT THE FIT ADDRESS ARE OPTIONAL, AND 
*         IF NOT SPECIFIED, THE CURRENT FIT VALUE FOR THAT PARAMETER
*         WILL BE USED. THE ONLY EXCEPTIONS ARE THE *TRM*, *SKIP*, AND
*         *POS* PARAMETERS IN MACROS  GETP, PUTP, AND PUT/DELETE/ 
*         REPLACE RESPECTIVELY. THESE PARAMETERS MUST BE EXPLICITLY 
*         STATED FOR THE DESIRED EFFECT - THE ABSENCE OR PRESENCE OF
*         *TRM*, *SKIP*, AND *POS* IN THE PREVIOUS MACRO HAVE NO
*         EFFECT ON THE OPERATION OF THE CURRENT MACRO. 
*1CD  MACRO SYNTAX
*0D   CONVENTIONS 
*0        [ ... ]             DELIMITS OPTIONAL PARAMETERS. 
*0        < ... >             DELIMIT SUBSTITUTABLE ENTITIES. 
*0        ( .../.../... )     DELIMIT A STRING OF PARAMETERS FROM 
*                             WHICH ONE MUST BE CHOSEN; E.G., (A/B/C) 
*                             MEANS CHOOSE ANY ONE OF A OR B OR C.
*0        ( ... )             CONTENTS OF ... 
*0        * ... *             DELIMITS A PARAMETER NAME EMBEDDED
*                             IN TEXT. SOMETIMES USED IN THE SAME WAY 
*                             AS QUOTE MARKS, IF THEY WERE AVAILABLE. 
*1CD  CODE GENERATION 
*0        THE CRM USER MACROS, WITH THE EXCEPTION OF
*0                  FETCH, FILE, CLOSEL, LDST.RM, STORE 
*0        GENERATE CODE AS FOLLOWS
*0        ( 1) AFTER CHECKING FOR SYNTAX ERRORS,                        006700
*              ALL NON-NULL PARAMETERS AFTER THE FIT                    006800
*              ADDRESS ARE PLACED IN X REGISTERS 2 THRU                 006900
*              6. IF THEY ARE ALREADY IN X REGISTERS AND
*              IN THIS ORDER, THEN NO WORK IS DONE;                     007100
*              THUS PARAMETERS PRESENTED IN X REGISTERS IN THE
*              ABOVE ORDER ARE SAID TO BE IN THE PREFERRED ORDER. 
*0        ( 2) THE FIT ADDRESS IS PLACED IN A0.                         007300
*              IF IT IS ALREADY IN A0, NO CODE IS GENERATED.
*0        ( 3) A SEQUENCE OF COMPASS CODE IN THE                        007400
*              FOLLOWING FORMAT IS GENERATED:                           007500
*0                  +     SB6     *+2                                   007600
*                   +     EQ      =X<FCN>$RM
*                   -     VFD     6/'?XES.RM/4,6/'?CHR.RM,18/0
*0               WHERE
*0               B6 CONTAINS THE RETURN ADDRESS 
*0               <FCN> IS A MNEMONIC INDICATING (SOMETIMES TENUOUSLY)   008100
*                THE I/O OPERATION TO BE PERFORMED,                     008200
*0               <FCN>$RM  WILL BE AN ENTRY POINT IN *CONTROL*. 
*0               '?XES.RM IS A FIELD WITH A BIT FOR EACH PARAMETER
*                BEYOND THE FIT ADDRESS, A 1 INDICATES THE PARAMETER    00
*                IN THE CORRESPONDING POSITION WAS NON-NULL AND A  0
*                INDICATES A NULL PARAMETER.
*                THE VALUE OF '?XES.RM IS SET BY THE *STX.RM* MACRO 
*                (CHAPTER 2, SECTION 1).
*0               '?CHR.RM IS SET TO  1  FOR PARTIAL GET/PUT AND TO  0 
*                FOR ALL OTHER OPERATIONS.
*#                                                                      010100
          TITLE     CHECK MACRO 
*#                                                                      010600
*1                                                                      010700
*0CD  THE CHECK MACRO                                                   010800
*0D   PURPOSE                                                           011000
*0        WAIT FOR I/O ACTIVITY ON A FILE TO CEASE.                     011100
*0D   CALLING SEQUENCE                                                  011200
*0        [TAG]     CHECK      FIT                                      011300
*0D   PARAMETERS                                                        011400
*0        TAG       -COMPASS LOCATION FIELD SYMBOL.                     011500
*         FIT       -ADDRESS OF FIT                                     011600
*0D   ACTION                                                            011700
*0        IF THE FILE WHOSE FIT ADDRESS IS <FIT> IS BUSY,               011800
*         CHECK PLACES THE CONTROL POINT IN AUTO-RECALL,                011900
*         ELSE CONTROL IS RETURNED TO THE USER. THE MACRO               012000
*         GENERATES A CALL TO THE CRM ROUTINE CHEK.RM.                  012100
*0D   REGISTERS                                                         012200
*0        ALL, A0 RETURNS WITH THE FIT ADDRESS, B1 RETURNS WITH 1       012300
*0D   OTHER CODE REQUIRED                                               012400
*0        PROGRAMS- CHEK.RM                                             012500
*         MACROS-   #SA0#, #CALL# 
*#
 CHECK    MACRO  PFIT 
          #SA0#     CHECK,PFIT
          #CALL#    CHEK
 CHECK    ENDM
          TITLE     CHECKR  MACRO 
*#
*1CD  THE CHECKR MACRO
*0D   PURPOSE 
*0        CHECK STATUS OF I/O ACTIVITY ON A FILE. 
*0D   CALLING SEQUENCE
*0        [TAG]     CHECKR    TAG1,FIT
*0D   PARAMETERS
*0        TAG       COMPASS LOCATION FIELD SYMBOL (IGNORED) 
*         TAG1      ADDRESS WHERE CONTROL IS RETURNED IF COMPLETE BIT 
*                   SET.
*         FIT       FIT ADDRESS.
*0D   ACTION
*0        IF COMPLETE BIT IS NOT SET, RETURN CONTROL TO THE CALLER
*         FOLLOWING HIS CHECKR REQUEST. IF THE COMPLETE BIT IS SET, 
*         RETURN CONTROL TO THE CALLER AT ADDRESS *TAG1*. 
*0D   REGISTERS USED
*0        ALL. UPON RETURN, A0=FIT ADDRESS, B1=1. 
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- CHKR$SQ 
*         MACROS-   FATERR,F.RM,INC.RM,OFF.RM,RCL.RM,SET.RM,
*                   #CALL#,#SA0#,STX.RM 
*#
CHECKR    MACRO     TAG,PFIT
6RM.F3    IFC       EQ,/TAG// 
4         ERR       COMPLETION ADR NOT SPECIFIED
6RM.F3    ELSE
          #SA0#     CHECKR,PFIT 
          STX.RM    (TAG) 
          #CALL#    CHKR
6RM.F3    ENDIF 
CHECKR    ENDM
          TITLE      CLOSEL   MACRO     P1
*#                                                                      013000
*1                                                                      013100
*0CD  THE CLOSEL MACRO                                                  013200
*0D   PURPOSE                                                           000100
*0        SIGNAL THE END OF USER LABEL PROCESSING AND CALL A            000110
*         CRM ROUTINE TO RETURN CONTROL TO THE APPROPRIATE
*         PLACE IN CRM, SO THAT NORMAL PROCESSING CAN CONTINUE. 
*0D   CALLING SEQUENCE                                                  000140
*0        [TAG]     CLOSEL     FIT                                      000150
*0D   PARAMETERS                                                        000160
*O        TAG       -COMPASS STATEMENT LOCATION FIELD SYMBOL.           000170
*         FIT       -ADDRESS OF FIT.                                    000180
*0D   ACTION                                                            000190
*0        CONTROL IS TRANSFERRED FROM THE USERS LABEL PROCESSING        000200
*         ROUTINE TO THE APPROPRIATE PLACE FOR CRM TO CONTINUE          000210
*         PROCESSING, DEPENDING ON WHETHER THE USER ROUTINE WAS         000220
*         ENTERED FROM OPENM OR CLOSEM AND WHETHER PD IS INPUT          000230
*         OR OUTPUT.                                                    000240
*0        IF LABEL TYPE IS NON-STANDARD AND CLOSEL WAS CALLED FROM
*         USERS END-OF-DATA ROUTINE (DX) INSTEAD OF FROM USERS LABEL
*         ROUTINE (LX), CONTROL IS RETURNED FOLLOWING MACRO CALL. 
*0D   REGISTERS                                                         000250
*0        ALL ARE USED. A0 IS RETURNED WITH THE FIT ADDRESS AND         000260
*         B1 WILL CONTAIN A 1.                                          000270
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- LAB1.SQ                                             000290
*         MACROS-   #SA0#, #CALL# 
*#                                                                      013600
 CLOSEL   MACRO     P1
          #SA0#     CLOSEL,P1 
          #CALL#    CLL 
 CLOSEL   ENDM
          TITLE      CLOSEM   MACRO     P1,P2,P3
*#                                                                      013800
*1                                                                      013900
*0CD  THE CLOSEM MACRO                                                  014000
*0D   PURPOSE 
*         (1)  TERMINATE PROCESSING ON A FILE.
*         (2)  PERFORM VOLUME SWITCHNG AND END/BEGIN VOL. PROCESSING. 
*0D   CALLING SEQUENCE
* 
*0        [TAG]     CLOSEM    FIT[,POS[,TYP]] 
*0D   PARAMETERS
*0        FIT      -ADDRESS OF FIT. 
*0        POS      -POSITIONING AT CLOSE TIME, MAY BE 
*                   R - REWIND (DEFAULT), 
*                   N - NO REWIND,
*                   U - UNLOAD. 
*0        TYP      -TYPE OF CLOSE, MAY BE 
*                   FILE (DEFAULT), 
*                   VOLUME. 
*0D   ACTION
*0        (1)  IF TYPE=FILE, FILE TERMINATION PROCESSING IS PERFORMED 
*              - BUFFER FLUSHING (PD=OUTPUT OR PD=I-O AND LOP =PUT/P).
*              - LABEL PROCESSING.
*         (2)  IF TYPE=VOLUME, VOLUME SWITCHING IS PERFORMED
*              (IF VOLUME SWITCH IS INITIATED BY A CALL TO
*              THE CLSV.RM CODE MODULE FROM THIS MACRO, IT
*              IS ALWAYS TREATED AS -SOLICITED- ) 
*              - BUFFER FLUSHING (PD=OUTPUT OR PD=I-O AND LOP = PUT/P 
*              AND C.V. NOT FORCED. A C.V. IS FORCED IF THE ES FIELD
*                CONTAINS AN UNRECOVERABLE WRITE PARITY ERROR). 
*              - LABEL PROCESSING.
*0D   REGISTERS 
*0        USES ALL REGISTERS CLAIMED BY CRM.
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- CLSV.RM (IF TYP=VOLUME) , CLSF.RM (OTHERWISE) 
* 
*         MACROS- #SA0#, SNTX.RM,STC.RM,#CALL#
*#                                                                      014400
 CLOSEM   MACRO     P1,P2,P3
          #SA0#     CLOSEM,P1 
 #.C#     SNTX.RM   P2,(,R,N,U,RET,DET,DIS),(,,,,,,)
          IFEQ      '?ERR.RM,0
#.E#      SNTX.RM   P3,(,FILE,VOLUME),(,,)
          IFC       NE, P3 VOLUME ,2
          STC.RM    CF,P2 
          #CALL#    CLOF
          IFC       EQ, P3 VOLUME ,2
          STC.RM    VF,P2 
          #CALL#    CLOV
          ENDIF 
 CLOSEM   ENDM
          TITLE     DELETE   MACRO
***                                                                ***
*                                                                    *
*                                                                    *
*     DELETEM IS GENERATED BY AN MNAME ECHO. 3RD MNAME AFTER WEOR.   *
*     ENDFILE LIKEWISE.                                              *
*                                                                    *
*                                                                    *
***                                                                ***
DELETE    MACRO     A,B,C,D,E,F 
          DELETEM   A,B,C,D,E,F 
DELETE    ENDM
          TITLE     SETFIT    MACRO     LFN 
*#
*1
*0CD  THE SETFIT MACRO
*0D   PURPOSE 
*0        FILL THE FIT FIELDS SPECIFIED BY THE FILE CARD
*         IF BFS IS NOT SPECIFIED, FILL BFS FIELD WITH
*            BUFFER SIZE TO BE ALLOCATED. 
*0D   CALLING SEQUENCE
*0        [TAG]    SETFIT     FIT 
*0D   PARAMETERS
*0        FIT      -ANY EXPRESSION GIVING THE ADDRESS OF THE FIT
*0D   ACTIONS 
*         SETS A0 TO FIT ADDRESS
*         CALLS STFT.RM WHICH CHECKS AND SETS *BFS* 
*0D   REGISTERS DESTROYED 
*0        ALL 
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- STFT.RM 
*         MACROS-   #SA0#, #CALL# 
*#
 SETFIT   MACRO     LFN 
          #SA0#     SETFIT,LFN
          #CALL#    SFIT
 SETFIT   ENDM
          TITLE      FETCH    MACRO     P1,P2,P3,XF,XM
*#                                                                      015540
*1                                                                      015550
*0CD  THE FETCH MACRO                                                   015560
*0D   PURPOSE 
*0        RETRIEVE A FIELD FROM THE FIT.
*0D   CALLING SEQUENCE
*0        [TAG]    FETCH      FIT,KEYWORD,XI[,XF[,XM]]
*                                           ==========
*0D   PARAMETERS
*0        FIT      -ANY EXPRESSION GIVING THE ADDRESS OF THE FIT. 
*         KEYWORD  -FIT FIELD MNEMONIC FOR FIT FIELD TO BE FETCHED. 
*         XI       -X REGISTER WHERE VALUE OF FIELD WILL BE RETURNED. 
*         XF       -ABSOLUTE EXPRESSION GIVING FETCH (A1-A5) REGISTER 
*                   TO BE USED. DEFAULT IS 5. 
*         XM       -ABSOLUTE EXPRESSION. MASK REGISTER (X0-X7) TO BE
*                   USED. DEFAULT IS 7. 
*0D   ACTIONS 
*0        THE REQUIRED FIT FIELD IS RETRIEVED AND PLACED IN XI. 
*         IF ITS A ONE BIT FIELD IT IS RETURNED IN THE SIGN BIT,
*         WITH GARBAGE FILL, OTHERWISE IT IS RETURNED RIGHT JUSTIFIED 
*         WITH ZERO FILL. 
*0D   REGISTERS 
*0        (1) DESTROYED 
*         A.XF,X.XF, X.XM 
*0        (2) PRESERVED 
*         ALL ELSE. 
*0D   ERRORS
*         XF NOT FETCH
* W   5 
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- NONE
*         MACROS- FC1.6RM 
*#
 FETCH    MACRO     P1,P2,P3,XF,XM
* 
*     PRODUCE AN ENTRY IN THE CROSS REFERENCE FOR KEYWORD 
* 
 >_P2_<   SET       0              DEFINE SYMBOL. 
* 
*     SET REGISTERS 
* 
#.F#      SET       XF 5
#.M#      SET       XM 7
#.ERR#    SET       0 
* 
*     CHECK INPUT 
* 
*         (1)  FIT OK 
* 
          IFC       EQ,/P1//,2
          ERR       FETCH FIT ADDRESS NOT SPECIFIED 
#.ERR#    SET       1 
* 
*         (2)  KEYWORD OK.
* 
          IF        -MIC,#_P2_#,3 
          IFC       NE,/P2/FET/,2 
          ERR       P2        FETCH ILLEGAL KEYWORD 
#.ERR#    SET       1 
* 
*         (3)  RESULT REGISTER OK.
* 
 R.6RM    IF        REG,P3
 M1       MICRO     1,1,/P3/
          IFC       NE,/"M1"/X/,2 
          ERR       P3        FETCH ILLEGAL RESULT REGISTER 
#.ERR#    SET       1 
 R.6RM    ENDIF 
          IF        -REG,P3,2 
          ERR       P3        FETCH NOT A REGISTER NAME 
#.ERR#    SET       1 
* 
*         (4)  FETCH REGISTER OK
* 
          IFGT      #.F#,5,2
          ERR       XF        FETCH     A.XF NOT LOAD REGISTER
#.ERR#    SET       1 
          IFLE      #.F#,0,2
          ERR       XF        FETCH     A.XF NOT LOAD REGISTER
#.ERR#    SET       1 
* 
* 
*         CALL MACRO TO DO REAL WORK
* 
          IFNE      #.ERR#,1,4
          IFC       EQ,/P2/FET/,2 
          S_P3      P1
          SKIP      1 
          FC1.6RM   "#_P2_#",P1,P3,#.F#,#.M#,P2 
#.ERR#    SET       1 
 FETCH    ENDM
          TITLE     FILE      MACRO 
*#
*1
*0CD  THE FILE MACRO
*0D   PURPOSE 
*0        ASSEMBLE AN FIT TABLE.
*0D   CALLING SEQUENCE
*0        [TAG]     FILE      LFN=<NAME>[,<KEYWORD>=<OPTION>] ... 
*0D   PARAMETERS
*0        <NAME>   -A LEGAL SCOPE FILE NAME.
*         <KEYWORD>-ANY OF THE ENTRIES IN THE KEYWORD TABLE.
*         <OPTION> -ANY OF THE ENTRIES CORRESPONDING TO THE KEYWORD 
*                   IN THE OPTION TABLE.
*0D   ACTION
*         ASSEMBLES AN FIT WHERE IT IS CALLED. SETS USER-DEFINED
*         PARAMETERS (<OPTIONS>), AND FILLS IN UNDEFINED FIELDS 
*         WITH DEFAULT (USUALLY 0) VALUES.
*0D   REGISTERS 
*         NONE
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- NONE
*0        MACROS-   FIL1.6RM, FIL2.6RM, FET.RM, 
*                   FILESQ (FILEWA) OR FILEIS (FILEWA,FILEAK) DEPENDING 
*                   ON THE   FO   PARAMETER 
*#
#SFX#     MICRO     1,, RM
          MACRO     FILE,TAG,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,
,P14,P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31
,,P32,P33,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44,P45,P46,P47,P48,P4
,9,P50,P51,P52,P53,P54,P55,P56,P57,P58,P59,P60,P61,P62
TAG       FIL2.6RM  (P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15,
,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25,P26,P27,P28,P29,P30,P31,P32,P33
,,P34,P35,P36,P37,P38,P39,P40,P41,P42,P43,P44,P45,P46,P47,P48,P49,P50,P5
,1,P52,P53,P54,P55,P56,P57,P58,P59,P60,P61,P62) 
 FILE     ENDM
          TITLE     FILESQ,FILEWA 
          MACROE    FILESQ,TAG,ASCII,BBH,BFS,BT,B8F,CF,CL,CM,CNF,CP,C1,D
,FC,DX,EFC,EO,ERL,EX,FF,FL,FO,FWB,HL,LA,LBL,LCR,LFN,LL,LP,LT,LX,MBL,MNB,
,MNR,MRL,MUL,NOFCP,OF,PC,PD,RB,RMK,RT,SB,SBF,SPR,TL,ULP,VF,WSA
* 
*         THE ABOVE LIST NOW CONTAINS 
*         49 PARAMETERS - NOT COUNTING TAG
*         PLEASE UPDATE THIS COMMENT IF YOU ADD OR DELETE PARAMETERS
* 
 #RM.PC#  SET       PC 76B
 #RM.MK#  SET       RMK 62B 
 TAG      FET.RM    LFN,ASCII,FWB,BFS,FF
*   WORD 10D (12B)
          VFD       24D/LBL,1/#_LCR_#,1/0,7/0,3/#_ULP_P#
          IFC       NE,/LT//,2
          VFD       2/#_LT_#
          SKIP      1 
          VFD       2/#UL#
          VFD       4/0,18/LA 
*   WORD 11 (13B) 
          VFD       24D/0,1/#_CM_#,2/#_OF_#,3/#_CF_#,2/#_VF_# 
          VFD       4/#_RT_T#,3/#_BT_T#,3/#_FO_#,18D/LX 
*   WORD 12 (14B) 
          FIL1.6RM  <FL>,FL,<MRL>,MRL,24D 
          VFD       18D/0,18D/DX
*   WORD 13 (15B) 
          VFD       1/#_NOFCP_#,1/0,2/DFC,2/EFC,9D/0,9D/ERL,1/0,1/0,3/0 
          VFD       4/0,9D/0,18D/EX 
*   WORD 14 (16B) 
          BSSZ      1 
*   WORD 15 (17B) 
          FIL1.6RM  <HL>,HL,<MNR>,MNR,24D 
          VFD       3/0,3/#_EO_#,1/0,1/0,2/0,1/#_SBF_#
M.        IFNE      #BETA#,0
          VFD       1/#_SPR_#,1/0,1/1,22D/WSA 
M.        ELSE
          VFD       1/#_SPR_#,1/0,1/1,4/0,18D/WSA 
M.        ENDIF 
*   WORD 16 (20B) 
          VFD       24D/TL
 FIF      IFNE      #_RT_T#,#RT#
          FIL1.6RM  <LL>,LL,<CL>,CL,6 
 FIF      ELSE
          VFD       6/#RM.MK# 
 FIF      ENDIF 
          VFD       6/#RM.PC#,6/MUL,18D/0 
*   WORD 17 (21B) 
          VFD       1/0,2/0,3/#_PD_#,3/0
          VFD       3/#CSET#
          VFD       1/#_B8F_#,1/#_C1_#,1/#_SB_# 
          FIL1.6RM  <LP>,LP,<CP>,CP,24D 
          VFD       1/0,1/#_CNF_#,1/#_BBH_#,18D/BFS 
*   WORD 18 (22B) 
          VFD       24D/0,6/0,30D/0 
*   WORD 19 (23B) 
          VFD       24D/MBL,6/0,30/0
*   WORD 20 (24B) 
          VFD       24D/MNB,6/0,12D/RB,18D/0
*   WORD 21 (25B) 
          VFD       36D/0,24D/0 
*   WORD 22 (26B) TO WORD 33 (41B)
          BSSZ      12D 
*   WORD 34 (42B) 
          VFD    42D/,18D/=XRM$LDC
          IFNE      #_BBH_#,0,1 
          LDSET     USE=CMM.AGR 
 FILESQ   ENDM
FILEWA    OPSYN     FILESQ
          TITLE     FILEIS,FILEDA,FILEAK
          MACROE    FILEIS,TAG,BBH,BCK,BFS,CDT,CF,CL,CP,CPA,C1,DCA,DCT,D
,FC,DFLG,DKI,DP,DX,EFC,EMK,ERL,EX,FL,FO,FWB,FWI,HL,HMB,HRL,IBL,IP,KA,KL,
,KNE,KP,KR,KT,LFN,LGX,LL,LP,MBL,MNR,MRL,NDX,NL,OF,ORG,OVF,PKA,PM,PD,RB,R
,EL,RKP,RKW,RMK,RT,SB,TL,TRC,WSA,XBS,XN 
* 
*         THE ABOVE LIST NOW CONTAINS 
*         62 PARAMETERS NOT COUNTING TAG
*         PLEASE UPDATE THIS COMMENT IF YOU ADD OR DELETE PARAMETERS
* 
 #RM.MK#  SET       RMK 62B 
 TAG      FET.RM    LFN,,FWB,BFS
*   WORD 10D (12B)
          VFD       24D/0,2/0,7/0,3/#NOP#,2/#UL#,22D/0
*   WORD 11 (13B) 
          VFD       24D/0,1/0,2/#_OF_#,3/#_CF_#,2/0,4/#_RT_T# 
          VFD       3/0,3/#_FO_#,18D/0
*   WORD 12 (14B) 
          FIL1.6RM  <FL>,FL,<MRL>,MRL,24D 
          VFD       18D/0,18D/DX
*   WORD 13 (15B) 
          VFD       2/0,2/DFC,2/EFC,9D/0,9D/ERL,1/0,1/0,3/0,4/0,9D/0
          VFD       18D/EX
*   WORD 14 (16B) 
          BSSZ      1 
*   WORD 15 (17B) 
          FIL1.6RM  <HL>,HL,<MNR>,MNR,24D 
          VFD       3/0,3/0,1/0,1/0,1/0,1/0,1/0,1/0,1/0 
FIF       IFC       EQ,/ORG// 
          VFD       1/#NEW#,4/0,18/WSA
FIF       ELSE
          VFD       1/#_ORG_#,4/0,18/WSA
FIF       ENDIF 
*   WORD 16 (20B) 
          VFD       24/TL 
 FIF      IFNE      #_RT_T#,#RT#
          FIL1.6RM  <LL>,LL,<CL>,CL,6 
 FIF      ELSE
          VFD       6/#RM.MK# 
 FIF      ENDIF 
          VFD       12/0
 FIF      IFC       EQ,/HRL// 
          VFD       1/0,1/0,7/DP,9D/0 
 FIF      ELSE
          VFD       18D/HRL 
 FIF      ENDIF 
*   WORD 17 (21B) 
          VFD       1/0,2/0,3/#_PD_#,3/0
          VFD       3/#CSET#
          VFD       1/0,1/#_C1_#,1/#_SB_# 
          FIL1.6RM  <LP>,LP,<CP>,CP,24D 
          VFD       1/0,1/0,1/#_BBH_#,18D/BFS 
*   WORD 18 (22B) 
          VFD       24D/HMB,6/0,30D/0 
*   WORD 19 (23B) 
          VFD       24D/MBL,6/NL,11D/0,1/#_DFLG_#,18D/LGX 
*   WORD 20 (24B) 
          VFD       1/#_BCK_#,1/#_PM_P_M#,6/0,22D/DCT,12D/RB,18D/PKA
*   WORD 21 (25B) 
          VFD       42/0L_XN
          IFC       NE,/XBS//,2 
          VFD       18D/XBS 
          SKIP      1 
          VFD       2/#_OVF_#,4/0,12D/KR
*   WORD 22 (26B) 
          BSSZ      1 
*   WORD 23 (27B) 
          BSSZ      1 
*   WORD 24 (30B) 
 DAEMK    IFEQ      #_FO_#,#DA# 
 DAEMK    IFC       EQ,/EMK// 
          VFD       1/#_NDX_#,1/#_KNE_#,1/#_FWI_#,3/0,30D/0,1/1,1/#_DKI_
,#
 DAEMK    ELSE
          VFD       1/#_NDX_#,1/#_KNE_#,1/#_FWI_#,3/0,30D/0,1/#_EMK_#,1/
,#_DKI_#
 DAEMK    ENDIF 
          VFD       4/0,18/KA 
*   WORD 25 (31B) 
          BSSZ      1 
*   WORD 26 (32B) 
          VFD       12D/0,18D/CDT,30D/0 
*   WORD 27 (33B) TO 30 (36B) 
          BSSZ      4 
*   WORD 31 (37B) 
          VFD       12D/RKW,4/RKP,4/KP,9D/KL,7/IP,24D/0 
*   WORD 32 (40B) 
 FIF      IFC       EQ,/KT//
          VFD       24D/IBL,6/0,3/#SKT#,3/#_REL_#,6/TRC,18D/CPA 
 FIF      ELSE
          VFD       24D/IBL,6/0,3/#_KT_KT#,3/#_REL_#,6/TRC,18D/CPA
 FIF      ENDIF 
*   WORD 33 (41B) 
          VFD       42D/0,18D/DCA 
*   WORD 34 (42B) 
          VFD       42D/,18D/=XCTRL$AA
          IFNE      #_BBH_#,0,1 
          LDSET     USE=CMM.AGR 
 FILEIS   ENDM
FILEDA    OPSYN     FILEIS
FILEAK    OPSYN     FILEIS
          TITLE     FET.RM
          MACRO     FET.RM,TAG,LFN,ASCII,FWB,BFS,FF 
*   WORD 0
          IFC       EQ,/LFN//,4 
          IFC       NE,/TAG//,2 
 TAG      VFD       42D/0L_TAG,18D/1
          SKIP      5 
          ERR       NO L F N SPECFIED 
          IFC       NE, TAG  ,2 
 TAG      VFD       42D/0L_LFN,18D/1
          SKIP      1 
 LFN      VFD       42D/0L_LFN,18D/1
* 
          IF        -DEF,##,1 
          SST 
*   WORD 1
          VFD       12D/0,5/0 
 FIF      IFC       NE,/ASCII// 
          VFD       1/1 
 FIF      ELSE
          VFD       1/0 
 FIF      ENDIF 
          VFD       5/0,1/#_FF_#,12D/0,6/#MNF#
          VFD       18D/FWB 
*   WORD 2
          VFD       42D/0,18D/FWB 
*   WORD 3
          VFD       42D/0,18D/FWB 
*   WORD 4
          VFD       42D/0,18D/FWB+BFS 
*   WORD 5
          VFD       36D/0,2/ASCII,22D/0 
*   WORD 6
          BSSZ      1 
*   WORD 7
          BSSZ      1 
*   WORD 8D (10B) 
          BSSZ      1 
*   WORD 9D (11B) 
          BSSZ      1 
 FET.RM   ENDM
          TITLE     FITDMP
 FITDMP   MACRO     FIT,ID
          LOCAL     AP,EXIT 
          IF        -DEF,[BAMLIB],2 
 [BAMLIB] SET       0 
          LDSET     LIB=BAMLIB
          IFC       EQ,/FIT//,1 
          ERR       FIT ADDRESS REQUIRED
          SX6       FIT A0
          SX7       ID 0
          SA6       AP
          SA7       AP+1
          SA1       AP
          RJ        =XFITD$RM 
          EQ        EXIT
 AP       BSSZ      3 
 EXIT     BSS       0 
 FITDMP   ENDM
          TITLE     FLUSHM MACRO
 FLUSHM   MACRO     LISTADR 
          #SA0#     FLUSHM,LISTADR
          #CALL#    FLSH
 FLUSHM   ENDM
          TITLE     GET       MACRO 
*#                                                                      000101
*1CD  THE GET MACRO 
*0D   PURPOSE 
*0        CALL I/O CODE MODULE(S) TO READ ONE USER LOGICAL RECORD.
*0D   CALLING SEQUENCE
*0        [TAG]     GET       LFN[,WSA[,RL[,(DX,EX)[,(WA,KA)[,KP[,MKL 
*                               ]]]]]]
*0D   PARAMETERS
*0        ANY OF THE PARAMETERS WSA, ... ,MKL MAY BE AN APPROPRIATE 
*         EXPRESSION OR THE CONTENTS OF ANY X-REGISTER EXCEPT X0. 
*0        TAG      -COMPASS STATEMENT TAG.
*0        LFN      -ANY EXPRESSION GIVING ADDRESS OF THE FIT. 
*                   ONE INSTRUCTION OF GENERATED CODE IS SAVED
*                   IF THIS IS -A0-.
*0        WSA      -ADDRESS OR X REGISTER CONTAINING ADDRESS OF USER-S
*                   WORK AREA WHERE LOGICAL RECORDS ARE TO BE 
*                   DELIVERED.
*0        RL       -RECORD LENGTH TO BE READ, SEE REF MAN FOR SITUATIONS
*                   WHEN THIS PARAMETER IS REQUIRED.
*0        DX        -ADDRESS OF USER END-OF-DATA EXIT (SQ FILES). 
*         EX        -ADDRESS OF USER ERROR EXIT (NON-SQ FILES). 
*0        WA        -WORD ADDRESS (WA FILES). 
*         KA        -KEY ADDRESS (IS,DA,OR AK FILES). 
*0        KP        -BEGINNING CHARACTER POSITION OF KEY (IS OR DA FILE)
*0        MKL       -MAJOR KEY LENGTH (IS FILES). 
*0        NOTE     -ALL OPTIONAL PARAMETERS DEFAULT TO THE CURRENT
*                   VALUE OF THEIR FIT FIELDS.
*0D   ACTION
*0        CODE IS GENERATED TO CALL GET.RM OR GET.<FO> IF THE *FO*
*         PARAMETER WAS SPECIFIED. GET RETRIEVES ONE RECORD AND 
*         PLACES IT IN THE WSA. 
*0        AN EXTERNAL IS GENERATED TO PUT.<BT> AND GET.<RT> (ENTRY
*         POINT IN Z.SQ, R.SQ, W.SQ, DT.SQ, OR FSU.SQ) TO ENSURE
*         THEIR LOADING IF BT AND/OR RT PARAMETERS ARE SPECIFIED. 
*0        PUT.<BT> IS AN ENTRY POINT IN BTRT.SQ WHICH DOES SOME 
*         BLOCK-TYPE-PECULIAR PROCESSING FOR GET.SQ 
*0D   REGISTERS 
*0        ALL. RETURNS A0=FIT, B1=1.                                    000140
*0D   OTHER CODE REQUIRED 
*0        MACROS-   #SA0#, STX.RM, #CALL# 
*         PROGRAMS- GET.<FO> IF FO SPECIFIED, OTHERWISE GET.RM
*#                                                                      000150
          PURGMAC    GET
 GET      MACRO     LFN,WSA,RL,XIT,ADR,KP,MKL 
          #SA0#     GET,LFN 
          STX.RM    (WSA,RL,XIT,ADR,KP,MKL) 
          #CALL#    GET 
 GET      ENDM
          TITLE     GETL      MACRO 
*#                                                                      000170
*1CD  THE GETL MACRO                                                    000180
*0D   PURPOSE                                                           000190
*0        CALL THE CRM USER LABEL PROCESSING ROUTINE GETL.SQ            000200
*         TO RETRIEVE LABELS FROM THE USERS LABEL AREA AFTER            000210
*         THEY HAVE BEEN PLACED THERE BY OPENM OR CLOSEM                000220
*         PROCESSING.                                                   000230
*0D   CALLING SEQUENCE                                                  000240
*0        [TAG]     GETL      FIT [,LA[,LBL]] 
*0D   PARAMETERS                                                        000260
*0        TAG       -COMPASS LOCATION FIELD SYMBOL.                     000270
*         LA        -ADDRESS OF USERS LABEL AREA (WHERE THE CALLER      000280
*                    EXPECTS THE LABELS TO APPEAR).                     000290
*         LBL       -LENGTH OF USERS LABEL AREA (CHARACTERS)            000300
*0D   ACTION                                                            000310
*0        CALLS GETL.SQ, WHICH MOVES LABELS FROM THE SYSTEM             000320
*         LABEL BUFFER TO THE USERS AREA. EACH TIME GETL IS CALLED,     000330
*         ONE LABEL IS MOVED.                                           000340
*0D   REGISTERS                                                         000350
*0        ALL. RETURNS A0=FIT, B1=1.                                    000360
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- NONE
*         MACROS-   GLPL.RM 
*#                                                                      000370
 GETL     MACRO     P1,P2,P3
          GLPL.RM   GTL,P1,P2,P3
 GETL     ENDM
          TITLE     GETN  MACRO 
*#
*1CD  THE GETN MACRO
*0D   PURPOSE 
*0        CALL I/O CODE MODULE(S) TO READ SEQUENTIALLY THE NEXT 
*         USER LOGICAL RECORD.
*0D   CALLING SEQUENCE
*0        [TAG]     GETN      LFN[,WSA[,EX[,KA]]] 
*0D   PARAMETERS
*0        THE PARAMETERS WSA, EX, AND KA MAY BE AN APPROPRIATE
*         EXPRESSION OR THE CONTENTS OF ANY X-REGISTER EXCEPT X0. 
*0        TAG      -COMPASS STATEMENT TAG.
*0        LFN      -ANY EXPRESSION GIVING ADDRESS OF THE FIT. 
*                   ONE INSTRUCTION OF GENERATED CODE IS SAVED
*                   IF THIS IS -A0-.
*0        WSA      -ADDRESS OR X REGISTER CONTAINING ADDRESS OF USER-S
*                   WORK AREA WHERE LOGICAL RECORDS ARE TO BE 
*                   DELIVERED.
*0        EX       -ADDRESS OF THE USERS ERROR EXIT 
*0        KA       -LOCATION TO RETURN KEY OF RECORD RETRIEVED; KEY 
*                   WORD WILL BE ALIGNED WITH STARTING CHARACTER
*                   POSITION 0 (IS ONLY). 
*0        NOTE     -ALL OPTIONAL PARAMETERS DEFAULT TO THE CURRENT
*                   VALUE OF THEIR FIT FIELDS.
*0D   ACTION
*0        RETRIEVES NEXT RECORD, PRESERVING SEQUENCE INFORMATION. 
*         FOR IS AND AK FILES, THE NEXT RECORD IS THE ONE WHOSE 
*         KEY IS NEXT IN COLLATING SEQUENCE; FOR *DA* FILES,
*         IT IS THE NEXT RECORD PHYSICALLY, WHICH IS PRETTY 
*         MUCH A RANDOM ORDER.
*0D   REGISTERS 
*0        ALL. RETURNS B1=1, A0=FIT.
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- GETN.<FO> IF FO SPECIFIED, OTHERWISE GETN.RM. 
*                   IS.RM (IS FILES) OR DA.RM (DA FILES)
*         MACROS-   #SA0#, STX.RM, #CALL#, IS.DA
*         ECHO-     MNAME 
*#
 GETN     MACRO     LFN,WSA,EX,KA 
          #SA0#     GETN,LFN
          STX.RM    (WSA,,EX,KA)
          #CALL#    GETN
 GETN     ENDM
          TITLE     GETNR MACRO 
 GETNR    MACRO     LFN,WSA,EX,KA 
          #SA0#     GETNR,LFN 
          STX.RM    (WSA,,EX,KA)
          #CALL#    GTNR
 GETNR    ENDM
          TITLE     GETP      MACRO 
*#
*1
*0CD  THE GETP MACRO
*0D   PURPOSE 
*0        RETRIEVE A PART OF A RECORD.
*0D   CALL
*0        [TAG]     GETP      FIT[,WSA[,PTL[,(DX,EX)[,,SKP]]]]
*0D   PARAMETERS
*0        FIT       -ADDRESS OF FIT.
*         WSA       -ADDRESS OF USER RECORD AREA. 
*         PTL       -PARTIAL TRANSFER LENGTH. NO. OF CHARACTERS TO
*                    READ.
*         DX        -END-OF-DATA EXIT ADDRESS (FO=SQ).
*         EX        -ERROR EXIT ADDRESS (FO=WA).
*         SKP       -NULL OR NON-NULL. IF NON-NULL, SKIPS TO THE
*                    NEXT RECORD BEFORE READING.
*0D   ACTION
*0        SETS A SYMBOL, '?CHR.RM, AND GENERATES A CALL TO
*         STX.RM MACRO. THIS CAUSES BIT 18 OF THE EQ  JUMP
*         CALLING WORD TO BE TURNED ON, WHICH INDICATES TO
*         GET.<FO> THAT THE CALL IS A GETP. GETP IS SUPPORTED ONLY ON 
*         SEQUENTIAL AND WORD ADDRESSABLE FILES.
*0        GETP RETRIEVES A PART OF A RECORD. AS MANY CHARACTERS AS
*         SPECIFIED BY (PTL). THE GETP STARTS FROM THE POSITION WHERE 
*         THE PREVIOUS GET OR GETP LEFT OFF. THIS POSITION IS NOT 
*         NECESSARILY A WORD BOUNDARY.
*0D   REGISTERS 
*0        ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE
*0        MACROS-   #SA0#, #WHICH#, STX.RM, #CALL#
*         PROGRAMS- GET.<FO> IF FO SPECIFIED, OTHERWISE GET.RM
*#
 GETP     MACRO     LFN,WSA,PTL,XIT,WA,SKP
          #SA0#     GETP,LFN
 #.C#     #WHICH#   SKP,(,SKIP,SKP),(0,1,SKP) 
          STX.RM    (WSA,,XIT,PTL,,"#.C#")
          #CALL#    GETP
GETP      ENDM
          TITLE     GETWR     MACRO 
*#
*1CD  THE GETWR MACRO 
*0D   PURPOSE 
*0        GET A SPECIFIED NUMBER OF WORDS FROM A FILE AND 
*         RETURN THEM TO A SPECIFIED WSA. 
*0D   CALL
*0        [TAG]     GETWR     FIT,WSA,MRL 
*0D   PARAMETERS
*0        FIT       FIT ADDRESS OF THE FILE 
*         WSA       WSA ADDRESS 
*         MRL       MRL (IN WORDS)
*0D   ACTION
*0        CHECK TO SEE THAT ALL THREE PARAMETERS HAVE BEEN
*         SPECIFIED.  IF SO, #SA0# IS CALLED TO PUT THE FIT 
*         ADDRESS IN A0 AND STX.RM IS CALLED TO PUT WSA IN
*         X2 AND MRL IN X3.  FINALLY, #CALL# GENERATES A
*         JUMP TO GTWR.SQ WITH B6 SET TO *+2. 
*0D   OTHER CODE
*0        MACROS-   #SA0#, #CALL#, STX.RM 
*         PROGRAMS- GETWR.SQ
*#
 GETWR    MACRO     FIT,WSA,MRL 
          #SA0#     GETWR,FIT 
          IFC       NE, WSA  ,1 
          IFC       EQ, MRL  ,1 
          ERR       THREE PARAMETERS ARE REQUIRED FOR GETWR 
          STX.RM    (WSA,MRL) 
          #CALL#    GTWR
 GETWR    ENDM
          TITLE LDST.RM MACRO 
 LDST.RM  OPSYN     NIL       ALLOW OBSOLETE MACRO CALL 
          TITLE     OPENM     MACRO 
*#
*1CD  THE OPENM MACRO 
*OD   PURPOSE 
*0        PREPARE A FILE FOR PROCESSING 
*OD   CALLING SEQUENCE
*0        [TAG]     OPENM     FIT[,PD[,POS]]
*OD   PARAMETERS
*0        FIT      -ADDRESS OF FIT. 
*0        PD       -PROCESSING DIRECTION, MAY BE
*                   INPUT,
*                   OUTPUT, 
*                   I-O.
*0        POS      -FILE POSITIONIN PRIOR TO OPENING, MAY BE
*                   R - REWIND, 
*                   N - NO REWIND,
*                   E - EXTEND. 
*0D   ACTIONS 
*0        GENERATES A CALL TO OPNM$RM.
*0        IF PD=NEW, INDICATING CREATION OF AN IS/DA FILE, THEN 
*         THE ON FIELD IS SET TO *NEW* AND PD IS SET TO *OUTPUT*. 
*         IF PD=INPUT/OUTPUT/I/O, (ON) IS SET TO *OLD*. 
*0D   REGISTERS 
*0        ALL USED. RETURNS A0=FIT, B1=1. 
*0D   OTHER CODE REQUIRED 
*         MACROS-   #SA0#, SNTX.RM, STC.RM, #CALL#, STORE 
*         PROGRAMS- OPEN.RM, PDF.RM (FILE CONTROL CARD PROCESSOR) 
*#
 OPENM    MACRO     PFIT,PPD,PFP
          #SA0#     OPENM,PFIT
#.C#      SNTX.RM   PPD,(,NEW,INPUT,OUTPUT,I-O),(,OUTPUT,INPUT,OUTPUT,IO
,)
          IFEQ      #.C#,-1,1 
P         ERR  ILLEGAL OPENM *PD* PARAMETER.. X-REG NOT ALLOWED 
 #.E#     SNTX.RM   PFP,(,R,N,E),(,R,N,E) 
          IFEQ      #.E#,-1,2 
P         ERR  ILLEGAL OPENM *OF* PARAMETER.. X-REG NOT ALLOWED 
          ELSE
          IFEQ      '?ERR.RM,0
          STC.RM    PD,"#.C#" 
          STC.RM    OF,"#.E#" 
          IFC       EQ, PPD NEW ,1
          STORE     A0,ON=NEW 
*     STORE ON=OLD IFF PPD = INPUT, OUTPUT OR I-O 
          IFGT      #.C#,1,1
          STORE     A0,ON=OLD 
          #CALL#    OPNM
          ENDIF 
 OPENM    ENDM
          TITLE     PUTL      MACRO 
*#                                                                    000095
*1CD  THE PUTL MACRO
*0D   PURPOSE 
*0        RETRIEVE A LABEL FROM THE USERS LABEL AREA (LA) AND DELIVER 
*         IT TO THE SYSTEM FOR PROCESSING.
*0D   CALL
*0        [TAG]     PUTL      FIT[,LA[,LBL]]
*0D   PARAMETERS
*0        FIT       -FIT ADDRESS. 
*         LA        -ADDRESS OF USER LABEL AREA.
*         LBL       -LENGTH (IN CHARACTERS) OF LA 
*0D   ACTION
*0        ACTION DEPENDS HEAVILY ON THE TYPE OF LABELS, PROCESSING
*         DIRECTION, AND FILE POSITION. THE REFERENCE MANUAL DESCRIBES
*         THE DETAILS. EACH PUTL WRITES ONE LABEL.
*0D   REGISTERS USED
*0        ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE
*0        MACROS-   GLPL.RM 
*         PROGRAMS- NONE
*#                                                                    000320
 PUTL     MACRO     P1,P2,P3
          GLPL.RM   PTL,P1,P2,P3
 PUTL     ENDM
          TITLE     PUTP      MACRO 
*#
*1CD  PUTP MACRO
*0D   PURPOSE 
*0        CALL THE PUT.RM PROGRAM TO WRITE A PORTION OF A RECORD. 
*0D   CALL
*0        [TAG]     PUTP      FIT[,WSA[,PTL[,(DX,EX)[,,RL[,TRM]]]]] 
*0D   PARAMETERS
*0        FIT       FIT ADDRESS.
*0        WSA       RECORD AREA ADDRESS.
*0        PTL       LENGTH OF RECORD PORTION (CHARACTERS).
*0        DX        ADDRESS OF USER END-OF-DATA ROUTINE (SQ FILES). 
*         EX        ADDRESS OF USER ERROR ROUTINE (NON-SQ FILES). 
*0        RL        TOTAL RECORD LENGTH IN CHARACTERS (REQUIRED IN
*                   SOME CASES ON THE FIRST PUTP OF A SERIES).
*0        TRM       TERM TO TERMINATE THE RECORD WITH THIS PUTP 
*0D   ACTIONS 
*0        CALLS PUT.RM WITH BIT 18 OF THE CALLING WORD SET TO INDICATE
*         A PARTIAL PUT.
*0        AN INDEFINITELY LONG S TYPE RECORD CAN BE CONSTRUCTED BY
*         A SERIES OF PUTP-S FOLLOWED BY A WEOR.
*0D   REGISTERS 
*0        RETURNS A0=FIT, B1=1. ALL OTHERS DESTROYED. 
*0D   OTHER CODE
*         PROGRAMS- PUT.<FO> IF FO SPECIFIED, OTHERWISE PUT.RM
*         MACROS-   #CALL#, #SA0#, STX.RM 
*#
 PUTP     MACRO     LFN,WSA,PTL,EX,DUMMY,RL,TRM 
          PUTP.RM   LFN,(WSA),PTL,EX,RL,TRM 
          #CALL#    PUTP
 PUTP     ENDM
          TITLE     PUTWP     MACRO 
*#
*1CD  THE PUTWP MACRO 
*0D   PURPOSE 
*0        CALL THE PUT.RM PROGRAM TO WRITE A PORTION OF A RECORD. 
*0D   CALL
*0        [TAG]     PUTWP     FIT[,WSA[,PTL[,(DX,EX)[,,RL[,TRM]]]]] 
*0D   PARAMETERS
*0        FIT       FIT ADDRESS.
*0        WSA       RECORD AREA ADDRESS.
*0        PTL       LENGTH OF RECORD PORTION (WORDS). 
*0        DX        ADDRESS OF USER END-OF-DATA ROUTINE (SQ FILES). 
*         EX        ADDRESS OF USER ERROR ROUTINE (NON-SQ FILES). 
*0        RL        TOTAL RECORD LENGTH IN CHARACTERS (REQUIRED IN SOME 
*                   CASES ON THE FIRST PUTWP IN A SERIES).
*0        TRM       PUTP (PUTWP) TERMINATE FLAG.
*0D   ACTIONS 
*0        PUTS FIT ADDRESS IN  A0, STORES PARAMETERS IN X-REGISTERS,
*         CONVERTS PTL (NOW IN X3) TO CHARACTERS AND PUTS IT IN  X3,
*         AND CALLS PUT.RM WITH BIT 18 SET TO INDICATE PARTIAL PUT. 
*0        *RL* IS REQUIRED FOR RT=U/R ON THE FIRST PUTWP. 
*0        AN INDEFINITELY LONG S-TYPE RECORD CAN BE CONSTRUCTED BY A
*         SERIES OF PUTWP-S FOLLOWED BY A WEOR. 
*0D   REGISTERS 
*0        DESTROYS X0 PLUS THOSE DESTROYED BY PUTP MACRO
*0D   OTHER CODE
*0        PROGRAMS- NONE
*         MACROS-   PUTP.RM (#SA0#,#WHICH#,STX.RM), #CALL#
*#
 PUTWP    MACRO     LFN,WSA,PTL,XIT,DUMMY,RL,TRM
          PUTP.RM   LFN,(WSA),PTL,XIT,RL,TRM
          LX0       B1,X6 
          LX6       3 
          IX6       X6+X0 
          #CALL#    PUTP
 PUTWP    ENDM
          TITLE     PUTP.RM 
 PUTP.RM  MACRO     LFN,WSA,PTL,EX,RL,TRM 
          #SA0#     PUTP,LFN
 #.C#     #WHICH#   TRM,(,TERM,TRM),(0,1,TRM) 
          STX.RM    (WSA,RL,EX,PTL,,"#.C#") 
 PUTP.RM  ENDM
          TITLE     PUTWR      MACRO
*#
*1CD  THE PUTWR MACRO 
*0D   PURPOSE 
*0        PUT A SPECIFIED NUMBER OF WORDS ONTO A FILE FROM
*         A SPECIFIED WSA.
*0D   CALL
*0        [TAG]     GETWR     FIT,WSA,RL
*0D   PARAMETERS
*0        FIT       FIT ADDRESS OF THE FILE 
*         WSA       WSA ADDRESS 
*         RL        RECORD LENGTH (IN WORDS)
*0D   ACTION
*0        CHECK TO SEE THAT ALL THREE PARAMETERS HAVE BEEN
*         SPECIFIED.  IF SO, #SA0# IS CALLED TO PUT THE FIT 
*         ADDRESS IN A0 AND STX.RM IS CALLED TO PUT WSA IN
*         X2 AND RL IN X3.  FINALLY, #CALL# GENERATES A JUMP
*         TO PTWR.SQ WITH B6 SET TO *+2.
*0D   OTHER CODE
*         PROGRAMS- PUTWR.SQ
*         MACROS-   #SA0#, #CALL#, STX.RM 
*#
 PUTWR    MACRO     FIT,WSA,RL
          #SA0#     PUTWR,FIT 
          IFC       NE, WSA  ,1 
          IFC       EQ, RL  ,1
          ERR       THREE PARAMETERS ARE REQUIRED FOR PUTWR 
          STX.RM    (WSA,RL)
          #CALL#    PTWR
 PUTWR    ENDM
          TITLE     REPLACE 
***                                                                ***
*                                                                    *
*     REPLACEM/REWINDM ARE ECHO-GENERATED. 3RD AND 1ST MNAME         *
*     AFTER WEOR.                                                    *
*                                                                    *
*     SEEK IS ECHO-GENERATED. 2ND MNAME AFTER WEOR.                  *
*                                                                    *
***                                                                ***
          PURGMAC    REPLACE
 REPLACE  MACRO     A,B,C,D,E,F,G,H 
          REPLACEM  A,B,C,D,E,F,G,H 
REPLACE   ENDM
          TITLE     RMKDEF  MACRO 
*#
*1CD  THE RMKDEF MACRO
*0D   PURPOSE 
*0        DESCRIBE A KEY FIELD TO THE MULTIPLE INDEX PROCESSOR
*         WHEN CREATING A NEW IS/DA/AK DATA FILE. 
*0D   CALL
*0        RMKDEF    FIT,KW,KP,KL[,KI[,KT[,KS[,KG[,KC[,NL[,IE[,CH]]]]]]]]
*0D   PARAMETERS
*0        FIT    = FIT ADDRESS OF THE FILE. 
*         KW     = WORD OF RECORD IN WHICH KEY STARTS (0=FIRST WORD). 
*         KP     = STARTING CHAR POSITION OF KEY (0-9). 
*         KL     = KEY LENGTH IN CHARACTERS (1-255).
*         KI=0   = IDENTIFIES SUMMARY INDEX, A RELEASE-2 FEATURE. 
*         KT     = KEY TYPE.. 0=SYMBOLIC, 1=SIGNED BINARY, 2=UNSIGNED.
*         KS     = SUBSTRUCTURE FOR PRIMARY KEY LIST IN THE INDEX.
*                    DEFAULT=U=NO DUPLICATES, I=INDEX SEQ,  F=FIFO. 
*         KG     = NO. OF CHARS IN REPEATING GROUP WHERE KEY RESIDES. 
*         KC     = NO. OF OCCURRENCES OF THE REPEATING GROUP. 
*                    0=NO REPEATING GROUPS, OR
*                        REPEATING GROUP DEFINED IN OCCURS...DEPENDING ON.
*         NL     =NULL SUPPRESS..N=NULL VALUES RECORDED,0=NOT RECORDED. 
*         IE     = INCLUDE/EXCLUDE ALT KEY VALUE IF RECORD CONTAINS 
*                    SPARSE CONTROL CHAR. DEFAULT=E=EXCLUDE,I=INCLUDE.
*         CH     = UP TO 36 CHARS THAT QUALIFY AS SPARSE CONTROL CHARS. 
*0D   ACTION
*0        ASSEMBLES PARAMETER VALUES INTO A KEYDEF WORD, AND
*         CALLS RM$MDPI WHICH ADDS THE KEYDEF TO THE INDEX FILE.
*0D   REGISTERS 
*0        ALL VOLATILE
*0D   OTHER CODE
*0        PROGRAMS- RM$MIP, RM$MFSP 
*         MACROS-   NONE
*#
 RMKDEF   MACRO  FIT,KW,KP,KL,KI,KT,KS,KG,KC,NL,IE,CH 
          LOCAL  LIST,KTV,KSV,HIT,MISS,CHC,CBP,CHP,RMT
          IF     -DEF,[BAMLIB],2
 [BAMLIB] SET    0
          LDSET  LIB=BAMLIB 
          SA1    LIST 
          RJ     =XRM$KDPT
          USE    RMT
 LIST     VFD    42D/,18D/FIT 
          VFD    42D/,18D/*+1 
          ECHO   8,P1=(KTV,KSV),P2=((S,I,U,P,),(U,I,F,)),P3=((0,1,2,3,0)
,,(0,3,7,0)),P4=(KT,KS) 
          ECHO   7,SY=(P2),SV=(P3)
          IFC    NE,/SY/P4/,4 
 P5#      MICRO  1,,/P4/
 CBP      MICCNT P5#
 P5#      OCTMIC SV,CBP 
          IFC    EQ,/"P5#"/P4/,2
 P1       SET    SV 
          STOPDUP 
          IF     -DEF,KTV,2 
          ERR    ILLEGAL KEY TYPE.    "SEQUENCE"
 KTV      SET    0
          IF     -DEF,KSV,2 
          ERR    ILLEGAL KEY SUBSTRUCTURE.    "SEQUENCE"
 KSV      SET    0
          VFD    15D/KW,4/KP,8/KL,3/0,1/KI,2/KTV,3/KSV,12D/KG,12D/KC
          IFC    NE,/IE/I/,3
 HIT      SET    1
 MISS     SET    0
          SKIP   2
 HIT      SET    0
 MISS     SET    1
          IFC    EQ,/NL/N/,2
          VFD    1/HIT
          SKIP   1
          VFD    1/MISS 
 CHM      MICRO  1,,/CH/
 CHC      MICCNT CHM
 CBP      SET    0
          DUP    36,10
 CBP      SET    CBP+1
 CHP      SET    0
          DUP    CHC,6
 CHP      SET    CHP+1
 CHM      MICRO  CHP,1,/CH/ 
          IFEQ   1R"CHM",CBP,3
          VFD    1/HIT
          STOPDUP 
          SKIP   1
          VFD    1/MISS 
          VFD    23/0 
          USE    *
          ENDM
          TITLE     RMPLOC MACRO
          MACROE    RMPLOC,TAG,PASS,REF,TYPE
 #R       MICRO     1,1, REF_X
 1.RM     IFC       EQ, PASS
 #L       MICRO     1,, GET=GET,GETP=GETP,GETN=GETN,LOF=LOF,PUT=PUT,PUTP
,=PUTP,SEEK=SEEK,[ALL]=[,CLF=[
 1.RM     ELSE
 #L       MICRO     1,, LOF=LOF 
          IRP       PASS
 #L       MICRO     1,, "#L",PASS=PASS
          IRP 
 1.RM     ENDIF 
 #F       SET       21B 
 #F       MICRO 
          IFC       GE,/TYPE/P/,2 
 #F       SET       24B 
 #F       MICRO     1,, 60D/, 
 TAG      #PL       "#L"
 RMPLOC   ENDM
  
          MACROE     #PL,TAG,CHECK,CHECKR,CLF,CLOSEM,CLOSEL,DELETE,FITDM
,P,FLUSHM,GET,GETP,GETN,GETNR,GETL,GETWR,LOF,OPENM,PUT,PUTP,PUTL,PUTWR,R
,EPLACE,REWINDM,SEEK,SETFIT,SKIPBF,SKIPBL,SKIPBP,SKIPFF,SKIPFL,SKIPFP,ST
,ART,ENDFILE,WEOR,WTMK,[ALL]
          LOCAL     T2
 TAG      BSS       1 
          ECHO      2,P1=(CHECK,CHECKR,CLOSEL,CLF,CLOSEM,CLOSEM,DELETE,F
,ITDMP,FLUSHM,GETN,GETP,GET,GETL,GETNR,GETWR,LOF,OPENM,PUTL,PUTWR,PUTP,P
,UT,REPLACE,REWINDM,SEEK,SETFIT,SKIPBF,SKIPBL,SKIPBP,SKIPFF,SKIPFL,SKIPF
,P,START,ENDFILE,WEOR,WTMK),P2=(CHEK,CHKR,CLL,CLOF,CLOF,CLOV,DLT,FITD,FL
,SH,GETN,GETP,GET,GTL,GTNR,GTWR,LOF,OPNM,PTL,PTWR,PUTP,PUT,REPL,REW,SEEK
,,SFIT,SKBF,SKBL,SKBP,SKFF,SKFL,SKFP,STRT,WEOP,WEOS,WMK)
          IFC       NE,/P1/[ALL]/,1 
          VFD       42D/0L_P2$RM,"#F"18D/="#R"P2$RM 
 T2       BSS       0 
          ORG       TAG 
          VFD       12D/#F,12D/T2-TAG-1,36D/0 
          ORG       T2
 #PL      ENDM
          TITLE     SEEK  MACRO 
*#
*1CD   THE SEEK MACRO 
*0D    PURPOSE
*0        ALLOW OVERLAP BETWEEN (USER) CP ACTIVITY AND IO ACTIVITY. 
*0D    CALL 
*0        [TAG]     SEEK      FIT[,EX[,KA[,KP[,MKL]]]]
*0D    PARAMETERS 
*0        TAG      -COMPASS LOCATION FIELD SYMBOL.
*         EX       -ERROR EXIT ADDRESS. ADDRESS OF A ROUTINE TO RECIEVE 
*                   CONTROL IN EVENT OF AN ERROR. 
*         KA     = KEY ADDRESS. 
*         KP     = BEGINNING CHARACTER POSITION OF THE KEY. 
*         MKL    = MAJOR KEY LENGTH (IN CHARACTERS).
*0D    ACTION 
*         CALLS CRM BAM/AAM INTERFACE, SEEK$RM. 
*         INITIATE BLOCK TRANSFER TO THE BUFFER -- BLOCK(S) ASSOCIATED
*         WITH THE KEY AND ULTIMATELY THE RECORD. 
*0D    REGISTERS
*         ALL. RETURNS A0=FIT, B1=1.
*0D    OTHER CODE REQUIRED
*0        PROGRAMS- SEEK.<FO> IF FO SPECIFIED, OTHERWISE SEEK.RM
*         MACROS-   #SA0#, STX.RM, #CALL# 
*#
 SEEK     MACRO     LFN,EX,KA,KP,MKL
          #SA0#     SEEK,LFN
          STX.RM    (,,EX,KA,KP,MKL)
          #CALL#    SEEK
 SEEK     ENDM
          TITLE     SKIPB L/P/F  MACROS 
*#
*1CD  THE SKIPBL MACRO
*0D   PURPOSE 
*0        POSITION A FILE BACKWARD A SPECIFIED NUMBER OF RECORDS, 
*         SECTIONS, OR PARTITIONS.
*0D   CALL
*0        [TAG]     SKIPB(L/P/F)    FIT,COUNT 
*0D   PARAMETERS
*0        TAG      -COMPASS LOCATION FIELD SYMBOL 
*0        FIT      -ADDRESS OF FIT. 
*0        COUNT    -NUMBER OF UNITS TO BE SKIPPED (DEFAULT = 0).
*0         PREVIOUS RELEASES OF BAM ALLOWED OTHER PARAMETERS [,FO[,RT]] 
*          ONLY THE FIRST IS INTERESTING, FILE ORGANIZATION.
*0        TYPE     -EOR,EOS,EOP TO SKIP RECORDS,SECTIONS, OR PARTITIONS 
*                  - FILE ORGANIZATION. 
*0D   ACTION
*0        PUT THE FIT ADDRESS INTO A0, THE SKIP COUNT INTO X2, THE
*         SKIP TYPE INTO X3, THE RETURN ADDRESS INTO B6, AND JUMP TO
*         SKBL$RM.
*0D   REGISTERS 
*0        ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE REQUIRED.
*0        PROGRAMS- SKBL$SQ,SKFL$SQ,GET$SQ,PUT$SQ(FLSH$SQ)
*         MACROS-   #SA0#, #CALL#, STX.RM 
*#
 SKIPBX   ECHO      ,SKIPXX=(SKIPBL,SKIPBP,SKIPBF),SFX=(L,P,F)
 SKIPXX   MACRO     FIT,COUNT,TYPE
          #SA0#     SKIPXX,FIT
 1.RM     IFC       EQ,/TYPE//
          STX.RM    (COUNT,#EOR#) 
 1.RM     ELSE
          IF        REG,TYPE,2
          STX.RM    (COUNT,TYPE)
 1.RM     SKIP
          IFC       NE,/TYPE/SQ/,1
          IFC       EQ,/TYPE/IS/,2
          STX.RM    (COUNT,#EOR#) 
          SKIP      1 
          STX.RM    (COUNT,#_TYPE_#)
 1.RM     ENDIF 
          #CALL#    SKB_SFX 
 SKIPXX   ENDM
 SKIPBX   ENDD
          TITLE     SKIPFX  ECHO GENERATES SKIPFL/P/F 
*#
*1CD  THE SKIPF MACROS
*0D   PURPOSE 
*0        SPACE FORWARD LOGICAL RECORDS, PHYSICAL RECORDS OR FILE-MARKS.
*0D   CALL
*0        [TAG]     SKIPF(L/P/F)    FIT,COUNT 
*0D   PARAMETERS
*0        THE PARAMETERS ARE PRECISELY THE SAME AS FOR THE SKIPB MACROS.
*0D   ACTION
*0        WHEN POSITIONED AT A RECORD, A SKIPF WITH COUNT=1, POSITIONS
*         THE FILE AT THE NEXT RECORD. GENERALLY, IF POSITIONED AT
*         RECORD M, AND SKIPPING FORWARD N, THE FILE IS POSITIONED AT 
*         RECORD M+N, UNLESS DATA EXIT CONDITION IS HIT. IN THAT CASE 
*         DX IS ENTERED AND SKIPPING STOPS. 
*0        SKIPPING FORWARD FILES LEAVES THE FILE POSITIONED AFTER 
*         THE FILE MARK (I.E, READY TO READ THE NEXT FILE). E.G., 
*         IF THERE ARE TWO SUCCESSIVE FILE-MARKS AND THE FILE IS
*         POSITIONED AT THE FIRST (OR ANYWHERE BEFORE THE FIRST,SO
*         LONG AS THERE ARE NO OTHER INTERVENING FILE-MARKS), THEN
*         A SKIPFF, COUNT=1 WILL POSITION THE FILE AT THE SECOND
*         FILE MARK.
*0D   REGISTERS 
*0        ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE REQUIRED.
*0        PROGRAMS- SKF<L/P/F>.<FO> IF FO SPECIFIED, OTHERWISE
*                   SKF<L/P/F>.RM.   ALSO PROGRAM WITH ENTRY POINT
*                   GET.<RT>
*         MACROS-   #SA0#, #CALL#, STX.RM 
*         ECHO-     SKIPFX
*#
* 
          PURGMAC   SKIPFF
* 
 SKIPFX   ECHO      ,SKIPXX=(SKIPFL,SKIPFP,SKIPFF),SFX=(L,P,F)
 SKIPXX   MACRO     FIT,COUNT,TYPE
          #SA0#     SKIPXX,FIT
 CRM      IFC       EQ,/TYPE//
          STX.RM    (COUNT,#EOR#) 
 CRM      ELSE
 CRM2     IF        REG,TYPE
          STX.RM    (COUNT,TYPE)
 CRM2     ELSE
          IFC       NE,/TYPE/SQ/,1
          IFC       EQ,/TYPE/IS/,2
          STX.RM    (COUNT,#EOR#) 
          SKIP      1 
          STX.RM    (COUNT,#_TYPE_#)
 CRM2     ENDIF 
 CRM      ENDIF 
          #CALL#    SKF_SFX 
 SKIPXX   ENDM
 SKIPFX   ENDD
          TITLE     START MACRO 
 START    MACRO     FIT,EX,KA,KP,MKL
          #SA0#     START,FIT 
          STX.RM    (,,EX,KA,KP,MKL)
          #CALL#    STRT
 START    ENDM
          TITLE     STLD.RM     MACRO 
          MACROE    STLD.RM,FO,USERT,USEBT,USE,OMIT,ORG 
 #IC      MICRO     1,,/$/
 #L       MICRO     1,, RBL$RM/EF$CRM/DF$CRM
 #S       SET       0 
 1.RM     IFC       EQ,/FO/SQ/
 #R       MICRO     1,,S_USERT_S
 2.RM     IFC       NE,/USERT/"#R"/ 
          IRP       USE 
 #I       MICRO     1,,/S/
          #W        USE,GET,GET 
          #W        USE,GETP,GET
          #W        USE,PUT,PUT 
          #W        USE,PUTP,PUT
 #I       MICRO     1,,/FO/ 
          #W        USE,SKIPBL,SKSB 
          #W        USE,SKIPFL,SKSF 
 3.RM     ENDIF 
          IRP 
 2.RM     IFC       EQ,/USERT/S/
 #I       MICRO     1,,/SQ/ 
          IRP       USE 
          #Y        USE,OPENM,OPEN
          #Y        USE,SETFIT,STFT 
          #Y        USE,CLOSEM,CLSF 
          #W        USE,REWINDM,REW 
          #Y        USE,GETL,LABL 
          #Y        USE,PUTL,LABL 
          #Y        USE,CLOSEL,LABL 
          #Y        USE,WTMK,LABL 
          #W        USE,ENDFILE,WEOX
          #W        USE,WEOR,WEOX 
          #W        USE,CHECK,CHEK
          #W        USE,CHECKR,CHEK 
          #W        USE,SKIPBF,SKIP 
          #W        USE,SKIPBP,SKIP 
          #W        USE,SKIPFF,SKIP 
          #W        USE,SKIPFP,SKIP 
          #W        USE,TGET,GPTM 
          #W        USE,TPUT,GPTM 
 3.RM     ENDIF 
          IRP 
 5.RM     SKIP
 2.RM     ENDIF 
 1.RM     ENDIF 
          IFC       LT,/FO/S/,2 
          IFC       NE,/ORG/NEW/,1
 #IC      MICRO     1,,/./
 #I       MICRO     1,,/FO/ 
 4.RM     IFC       EQ,/FO/MP/
 #L       MICRO     1,, "#L"/EXEC"#IC"MP
          IRP       USE 
          #W        USE,PUT,PUT 
          #W        USE,REPLACE,PUT 
          #W        USE,DELETE,PUT
          #W        USE,SKIPBL,SEEK 
          #W        USE,SKIPFL,SEEK 
          #W        USE,GETNR,SEEK
          #W        USE,SEEK,SEEK 
 3.RM     ENDIF 
          IRP 
 4.RM     ELSE
          IRP       USE 
          #Y        USE,OPENM,OPEN
          #Y        USE,SETFIT,STFT 
          #Y        USE,CLOSEM,CLSF 
          #W        USE,REWINDM,REW 
          #W        USE,GET,GET,1 
          #W        USE,PUT,PUT,7 
 3.RM     IFC       NE,/FO/WA/
          #W        USE,REPLACE,REPL
          #W        USE,SKIPFL,SKFL,1 
          #W        USE,SKIPBL,SKBL 
 1.RM     IFC       EQ,/FO/SQ/
          #Y        USE,GETL,LABL 
          #Y        USE,PUTL,LABL 
          #Y        USE,CLOSEL,LABL 
          #Y        USE,WTMK,LABL 
          #W        USE,ENDFILE,WEOX
          #W        USE,WEOR,WEOX 
          #W        USE,GETP,GET,1
          #W        USE,PUTP,PUT,7
          #W        USE,CHECK,CHEK
          #W        USE,CHECKR,CHEK 
          #W        USE,SKIPBF,SKIP 
          #W        USE,SKIPBP,SKIP 
          #W        USE,SKIPFF,SKIP 
          #W        USE,SKIPFP,SKIP 
          #W        USE,TGET,GPTM 
          #W        USE,TPUT,GPTM 
 1.RM     ELSE
          #W        USE,DELETE,DLT
          #W        USE,SEEK,SEEK 
          #W        USE,START,STRT
          #W        USE,GETN,GETN 
          #W        USE,GETNR,GTNR
 1.RM     ENDIF 
 3.RM     ENDIF 
          IRP 
 4.RM     IFC       NE,/FO/WA/
          IFGE      #S,7,2
          ECHO      1,RT=(USERT)
 #L       MICRO     1,, "#L"/PUT$RT 
 3.RM     IFC       EQ,/FO/SQ/
          IFGE      #S,7,2
          ECHO      1,BT=(USEBT)
 #L       MICRO     1,, "#L"/PUT$BT 
          IFNE      #S/7*7,#S,4 
          ECHO      1,BT=(USEBT)
 #L       MICRO     1,, "#L"/GET$BT 
          ECHO      1,RT=(USERT)
 #L       MICRO     1,, "#L"/GET$RT 
          ENDIF 
          #L        OMIT
 STLD.RM  ENDM
          TITLE     #Y MACRO
 #Y       MACRO     U,A,B 
          IFC       EQ,/U/A/,4
 #L       MICRO     1,, "#L"/B$RM 
          IFC       LT,/"#I"/S/,1 
 #L       MICRO     1,, "#L"/B"#IC""#I" 
 3.RM     SKIP
 #Y       ENDM
          TITLE     #W MACRO
 #W       MACRO     U,A,B,C 
          IFC       EQ,/U/A/,3
 #L       MICRO     1,, "#L"/B"#IC""#I" 
 #S       SET       C+#S
 3.RM     SKIP
 #W       ENDM
          TITLE     #L MACRO
 #L       MACRO     OMT 
          LDSET     USE="#L"
          IFC       EQ,/OMT/FDL/,1
          LDSET     OMIT=FDL.LDC/FDL.ULC
          IFC       EQ,/OMT/CMM/,1
          LDSET     OMIT=FDL.LDC/FDL.ULC/CMM.GOS/CMM.FRF/CMM.ALF/CMM.POE
,/CMM.DOE/CMM.AGR 
 #L       ENDM
          TITLE STORE MACRO 
*#
*1CD  THE STORE MACRO 
*0D   PURPOSE 
*0        STORE A FIELD INTO THE FIT. 
*0D   CALLING SEQUENCE
*0        [TAG]  STORE  LFN,KEYWORD=OPTION[,F[,S[,M]]]
*                                         ============
*0        [TAG]  STORE   XJ,KEYWORD=OPTION[,F[,S[,M]]]
*                                         ============
*0D   PARAMETERS
*0        TAG      -OPTIONAL COMPASS STATEMENT TAG
*0        LFN      -FIT ADDRESS (STATEMENT TAG OR EXTERNAL) 
*                   USUALLY THE TAG GENERATED BY THE FILE MACRO.
*0        XJ       -ANY REGISTER CONTAINING FIT ADDRESS,
*0        KEYWORD  -MNEMONIC OF FIELD TO BE STORED. 
*0        OPTION   -MNEMONIC FOR QUANTITY TO BE STORED OR 
*                   EXPRESSION CONTAINING QUANTITY TO BE STORED,
*0        F        -FETCH REGISTER TO BE USED, DEFAULT F = 5. 
*0        S        -STORE REGISTER TO BE USED, DEFAULT S = 6. 
*0        M        -MASK REGISTER TO BE USED, DEFAULT M = 7.
*0D   ACTION
*0        THE QUANTITY REPRESENTED BY -OPTION- IS STORED IN 
*         THE FIT FIELD REPRESENTED BY -KEYWORD-. 
*0D   REGISTER USE
*0    1.  PRESERVED 
*0        ALL THOSE NOT EXPLICITLY DESTROYED. 
*0    2.  DESTROYED 
*         A.F, X.F, A.S, X.S, X.M.
*0D   OTHER CODE REQUIRED 
*0    1.  MACROS
*         ST2.6RM (ST3.6RM) 
*0    2.  TEXT
*         IOTEXT (CRM USERS TEXT - THE SAME ONE ON WHICH THIS 
*         MACRO APPEARS IN NORMAL CRM INSTALLATION).
*0    3.  SUBROUTINES 
*         NONE
*#
 STORE    MACRO     P1,P2,XF,XS,XM
          NOREF     #.F#,#.S#,#.M#,#.T# 
#.F#      SET       XF 5
#.S#      SET       XS 6
#.M#      SET       XM 7
M2        MICRO     1,,=P2= 
>_"M2"_<  SET       0 
          IFLT      #.S#,6,1
          ERR IN STORE -- A.XS NOT A STORE REGISTER 
#.K#      MICRO     1,,=P2
'?CNT.RM  MICCNT    #.K#
#.V#      MICRO     '?CNT.RM+2,, P2 
          ST2.6RM   P1,"#.K#","#.V#",#.F#,#.S#,#.M# 
 STORE    ENDM
          TITLE     WEOR      MACRO 
*#
*1CD  THE WEOR MACRO
*0D   PURPOSE 
*0        RECORD *END-OF-SECTION*.
*0D   CALL
*0    [TAG]         WEOR      FIT,LVL 
*0D   PARAMETERS
*0        FIT       -FIT ADDRESS. 
*0        LVL       -LEVEL NUMBER, IF EOS ON DEVICE IS A SHORT PRU. 
*0    ACTION
*0        CALLS ROUTINE WEOS$SQ, WHICH ...
*0        (1) WRITES AN END-OF-SECTION; I.E., A ZERO LENGTH 
*             W-RECORD WITH THE FLAG BIT (58) AND DELETE BIT (57) 
*             SET, UNLESS RT"W. 
*0        (2) FLUSHES THE I/O BUFFER. 
*0        NOTE THAT FOR S-TAPES, OR RT=S, EOS IS NOT DEFINED UNLESS 
*         RT=W. HOWEVER, BLOCK IS ENDED.
*0D   REGISTERS 
*         ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE REQUIRED 
*0        MACROS-   #SA0#, STX.RM, #CALL# 
*         PROGRAMS- CONTROL 
*#
 WEOR     MACRO     P1,P2 
          #SA0#     WEOR,P1 
          STX.RM    P2
          IFC       EQ,/P2//,1
          STORE     A0,LVL=0       LVL=0 IS DEFAULT FOR WEOR
          #CALL#    WEOS$RM 
 WEOR     ENDM
          TITLE     REWINDM,ENDFILE,WTMK
***                                                                ***
*                                                                    *
*     WTMK IS ECHO-GENERATED. SEE FOLLOWING MNAME.                   *
*                                                                    *
***                                                                ***
*#
*1DC  THE REWINDM MACRO 
*0D   PURPOSE 
*0        REWIND A FILE.
*0D   CALL
*0        [TAG]     REWINDM   FIT 
*0D   PARAMETERS
*0        FIT       FIT ADDRESS.
*0D   ACTION
*0        CALLS *REW.RM* (*REW.<FO>* IF FO SPECIFIED) WHICH FLUSHES THE 
*         BUFFER (IF THE LAST OPERATION WAS AN OUTPUT) AND CALLS
*         *CIO.RM* TO ISSUE A CIO FUNCTION 50B. 
*0D   REGISTERS USED
*0        ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE REQUIRED 
*0        MACROS-   #SA0#, #CALL# 
*         PROGRAMS- REW.<FO> IF FO SPECIFIED, OTHERWISE REW.RM
*1CD  THE ENDFILE MACRO 
*0D   PURPOSE 
*0        RECORD AN END-OF-PARTITION. 
*0D   CALLING SEQUENCE
*0        [TAG]     ENDFILE   FIT 
*0D   PARAMETERS
*0        TAG       -COMPASS LOCATION FIELD SYMBOL. 
*         FIT       -FIT ADDRESS. 
*0D   ACTION
*0        CALLS ROUTINE WEOP$SQ, WHICH ...
*0        (1) WRITES AN END-OF-PARTITION; I.E., A ZERO LENGTH 
*             W-RECORD WITH THE FLAG BIT (58) SET, UNLESS RT"W. 
*0        (2) FLUSHES THE I/O BUFFER. 
*0        (3) IF RT"W, WRITES A TAPE MARK ON S-TAPES AND A
*             LEVEL 17 ON SCOPE DEVICES.
*0D   REGISTERS 
*0    ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE REQUIRED 
*0        MACROS-   #SA0#,#CALL#
*         PROGRAMS- CONTROL 
*         NOTE- ENDFILE IS GENERATED BY AN MNAME ECHO 
*1CD  THE WTMK MACRO
*0D   PURPOSE 
*0        RECORD A FILE-MARK. 
*0D   CALL
*0        [TAG]     WTMK      FIT 
*0D   PARAMETERS
*0        TAG       -COMPASS LOCATION FIELD SYMBOL
*         FIT       -ADDRESS OF FIT 
*0D   ACTION
*0        RECORDS A FILE-MARK AT THE CURRENT PHYSICAL POSITION OF THE 
*         FILE. THIS FUNCTION IS NOT INTENDED FOR USE IN CONJUNCTION
*         WITH PUT, AS IT DOES NOT PERFORM THE BUFFER FLUSHING REQUIRED 
*         TO INSURE THAT ALL DATA *PUT* BY THE USER WILL APPEAR PRIOR 
*         TO THE FILE-MARK. 
*0        IT SHOULD ONLY BE USED IN NON-STANDARD LABEL PROCESSING.
*0        A FILE MARK IS A *LEVEL-17* ON A SCOPE DEVICE, AND A TAPE-
*         MARK ON AN S/L TAPE.
*0D   REGISTERS 
*0        ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE REQUIRED 
*0        MACROS-   #SA0#, #CALL# 
*         PROGRAMS- WTMK.SQ 
*         ECHO-     MNAME 
*#
          ECHO      ,MNAME=(REWINDM,ENDFILE,WTMK),ROUT=(REW,WEOP,WMK) 
 MNAME    MACRO     LFN 
          #SA0#     MNAME,LFN 
          #CALL#    ROUT
MNAME     ENDM
          ENDD
  
          TITLE     DELETEM,PUT,REPLACEM - ECHO GENERATED MACROS
*#
*1CD  THE PUT MACRO 
*0D   PURPOSE 
*0        CALL I/O SUBPROGRAM(S) TO WRITE ONE RECORD. 
*0D   CALL
*0        [TAG]     PUT       FIT[,WSA[,RL[,(DX,EX)[,(KA,WA)[,KP[,POS 
*                               ]]]]]]
*0D   PARAMETERS
*0        TAG      -COMPASS STATEMENT TAG.
*0        LFN      -ANY EXPRESSION GIVING THE ADDRESS OF THE FIT. 
*                   ONE INSTRUCTION OF GENERATED CODE IS SAVED IF 
*                   THIS IS -A0-. 
*0        WSA      -TAG OR X REGISTER. ADDRESS OF USER WORK AREA
*                   WHICH IS THE SOURCE OF LOGICAL RECORDS. 
*0        RL       -RECORD LENGTH TO BE WRITTEN, SEE ERS FOR
*                   SITUATIONS WHEN THIS IS REQUIRED. 
*0        DX        -ADDRESS OF USER END-OF-DATA ROUTINE (SQ FILES) 
*         EX        -ADDRESS OF USER ERROR ROUTINE (NON-SQ FILES) 
*0        KA        -KEY ADDRESS (IS OR AK FILES) 
*         WA        -WORD ADDRESS (WA FILES)
*0        KP        -BCP OF KEY WITHIN WORD (IS FILES)
*0        POS       RELATIVE POSITIONING OF RECORD FOR IS FILE DUPLI- 
*                   CATE KEY PROCESSING.
*0        NOTE     -ALL OPTIONAL PARAMETERS DEFAULT TO THE CURRENT
*                   VALUE OF THEIR FIT FIELDS.
*0D   ACTION
*0        PUT ROUTINES WRITE ONE RECORD FROM THE USER *WSA* TO THE
*         I/O DEVICE. THE RECORD LENGTH IS FOUND BY CRM AS FOLLOWS. 
*0        RT = W/S/U          (RL) IN THE FIT DETERMINES THE RECORD 
*                             LENGTH. 
*0        RT = F              RECORD LENGTH IS DETERMINED BY (FL).
*0        RT = D/T/Z/R        RECORD LENGTH IS DETERMINED FROM THE
*                             CONTENT OF THE RECORD ITSELF. 
*0D   REGISTERS 
*0        ALL USED. RETURNS A0 = LFN, B1 = 1. 
*0D   OTHER CODE REQUIRED 
*0        PUT IS GENERATED BY AN *MNAME* ECHO.
*         MACROS-   #SA0#, STX.RM, #WHICH#, #CALL#
*         PROGRAMS- PUT.<FO> IF FO SPECIFIED, OTHERWISE PUT.RM
*1CD  THE REPLACE MACRO 
*0D   PURPOSE 
*0        CALL I/O CODE MODULE TO REPLACE ONE USER LOGICAL RECORD 
*0D   CALLING SEQUENCE
*0        [TAG]     REPLACE   LFN[,WSA[,RL[,EX[,KA[,KP[,POS]]]]]] 
*                                           ==
*0D   PARAMETERS
*0        ANY OF THE PARAMETERS WSA, ... ,POS MAY BE AN APPROPRIATE 
*         EXPRESSION OR THE CONTENTS OF ANY X-REGISTER EXCEPT X0. 
*0        TAG      -COMPASS STATEMENT TAG.
*0        LFN      -ANY EXPRESSION GIVING ADDRESS OF THE FIT. 
*                   ONE INSTRUCTION OF GENERATED CODE IS SAVED
*                   IF THIS IS -A0-.
*0        WSA      -ADDRESS OR X REGISTER CONTAINING ADDRESS OF USER-S
*                   WORK AREA WHERE LOGICAL RECORDS ARE TO BE 
*                   DELIVERED.
*0        RL       -RECORD LENGTH OF THE INPUT RECORD 
*0        EX       -ADDRESS OF THE USERS ERROR EXIT 
*0        KA       -ADDRESS OF KEY AREA 
*0        KP       -KEY POSITION, FROM 0 TO 9 INDICATING THE CHARACTER
*                   POSITIONS IN A CM WORD. 
*0        POS       -SPECIFIES THAT THE LAST REFERENCED (CURRENT) 
*                   RECORD WILL BE REPLACED. APPLIES ONLY WHEN
*                   DUPLICATE KEY PROCESSING IS ALLOWED.
*0        NOTE     -ALL OPTIONAL PARAMETERS DEFAULT TO THE CURRENT
*                   VALUE OF THEIR FIT FIELDS.
*0D   ACTION
*         AN EXISTING RECORD IN THE FILE IS REPLACED BY THE RECORD IN 
*         THE WORKING STORAGE AREA. 
*0D   REGISTERS USED
*0        ALL. RETURNS A0=FIT, B1=1.
*0D   OTHER CODE REQUIRED 
*0        MACROS-   #SA0#, STX.RM, #WHICH#, #CALL#
*         PROGRAMS- REPL.<FO> IF FO SPECIFIED, OTHERWISE REPL.RM
*1CD  THE DELETE MACRO
*OD   PURPOSE                                                           000100
*0        DELETE A RECORD FROM A FILE.                                  000110
*0D   CALLING SEQUENCE                                                  000120
*0        [TAG]     DELETE    FIT[,EX[,KA[,KP[,POS]]]]
*0D   PARAMETERS                                                        000140
*0        [TAG]     -COMPASS LOCATION FIELD SYMBOL.                     000150
*         EX        -ERROR EXIT ROUTINE ADDRESS.
*         KA        -KEY ADDRESS
*         KP        -KEY POSITION 
*         POS       -SPECIFIES CURRENT RECORD FOR IS FILES IN           000200
*                    DUPLICATE KEY MODE. SEE ERS FOR ALTERNATIVES.      000210
*OD   REGISTERS                                                         000220
*0        ALL USED. A0 IS RETURNED WITH THE FIT ADDRESS, B1             000230
*         WILL CONTAIN A 1.                                             000240
*0D   OTHER CODE REQUIRED                                               000250
*0        PROGRAMS- DLT.<FO> IF FO SPECIFIED, OTHERWISE DLT.RM
*         MACROS- #SA0#, #WHICH#, STX.RM, #CALL#                        000270
*#                                                                      015510
         ECHO ,MNAME=(PUT,REPLACEM,DELETEM),ARGS=((P2,P3,P4,P5,P6),(P2,P
,3,P4,P5,P6),(,,P2,P3,P4)),ROUT=(PUT,REPL,DLT),POSVALUE=((,N,P),(,C),(,C
,)) 
 MNAME    MACRO     LFN,ARGS,PPOS 
          #SA0#     MNAME,LFN 
 #.C#     #WHICH#   PPOS,(POSVALUE),(0,1,40B) 
          IFLT      #.C#,0
          ERR IN "'?MNM.RM" -- [POS] PARAMETER SPECIFIED INCORRECTLY
          ELSE
          STX.RM    (ARGS,"#.C#") 
          #CALL#    ROUT
          ENDIF 
MNAME     ENDM
          ENDD
  
          TITLE      CYX.RM 
 CYX.RM   MACRO     RR
          IBX.RM    X0,RR 
 .D       DUP       5 
          IBX.RM    "#.B#","#.B#" 
          IFEQ      "#.B#",RR,1 
 .D       STOPDUP 
 .D       ENDD
          XMT.RM    RR,X0 
 CYX.RM   ENDM
          TITLE      FC1.6RM  MACRO     TBL,WRD,FL,POS,CNV,DUMMY,P1,P3,F
*#                                                                    000110
*1CD  FC1.6RM MACRO 
*0D   PURPOSE 
*0        DO THE WORK FOR FETCH 
*0D   CALL
*         [TAG]     FC1.6RM   TBL,WRD,FL,POS,CNV,DUM,P1,P3,F,M,KEYWD
*0D   PARAMETERS
*0        TBL       TABLE TO BE FETCHED FROM (MUST BE 0 = FIT). 
*0        WRD       WORD WITHIN TABLE.
*0        FL        LENGTH OF FIELD IN BITS.
*0        POS       RIGHTMOST BIT OF FIELD (0-59 RIGHT TO LEFT).
*0        CNV       NOT USED. 
*0        DUM       NOT USED. 
*0        P1        FIT ADDRESS.
*0        P3        RESULT REGISTER (XI FROM FETCH CALL). 
*0        F         FETCH REGISTER NUMBER.
*0        M         MASK REGISTER NUMBER. 
*0        KEYWD     NOT USED. 
*0D   ACTION
*0        GENERATES IN-LINE CODE TO PICK UP THE FIELD DEFINED BY
*         PARAMETERS *TBL* THRU *POS*.
*0D   REGISTERS USED
*0        AX.F,X.M
*0D   OTHER CODE REQUIRED 
*0        NONE
*#                                                                    000400
 FC1.6RM  MACRO     TBL,WRD,FL,POS,CNV,DUMMY,P1,P3,F,M,KEYWORD
          IFGE      CNV,2,1 
4  ERR  ILLEGAL FETCH FIELD (WARNING) -- EXECUTION RISKY
* 
*     IF A ONE BIT FIELD, RETRIEVE AND SHIFT IT TO THE SIGN BIT 
*     OF THE RESULT REGISTER. 
* 
#.L#      MICRO     1,, WRD 
          IFEQ      FL,1
          SA.F      P1+"#.L#" 
          IFNE      P3,X.F,1
          B_P3      X.F 
          IFNE      POS,59D,1 
          L_P3      59D-POS 
          ELSE
* 
*     NOT A ONE BIT FIELD 
* 
          IFEQ      F,M,1 
          ERR       FETCH     LOAD AND MASK X REGISTERS SAME. 
* 
 6RM.IF2  IFNE      FL,60D
          IFGE      *P,30D,3
          SA.F      P1+"#.L#" 
          MX.M      60D-FL
          SKIP      2 
          MX.M      60D-FL
          SA.F      P1+"#.L#" 
          IFEQ      2,DUMMY,2 
          LX.M      60D-FL
          SKIP      2 
          IFNE      POS,0,1 
          AX.F      POS 
          B_P3      -X.M*X.F
 6RM.IF2  ELSE
          SA.F      P1+"#.L#" 
          IFNE      P3,X.F,1
          B_P3      X.F 
          ENDIF 
 FC1.6RM  ENDM
          TITLE     FIL1.RM   MACRO 
*#                                                                    000110
*1CD  FIL1.6RM MACRO
*0D   PURPOSE 
*0        ASSEMBLE OVERLAPPING FIELDS INTO THE FIT FOR THE *FILE* 
*         MACRO AND ISSUE A WARNING IF THEY ARE SPECIFIED IN THE CALL.
*0D   CALL
*0        [TAG]     FIL1.RM   FN,FV,GN,GV,N 
*0D   PARAMETERS
*0        FN        FIELD NAME. USED ONLY IN AN ERROR MESSAGE IF ONE
*                   IS PRODUCED. SOMETHING OF THE FORM *<KEYWORD>*. 
*0        FV        FIELD VALUE. PARAMETER PASSED DIRECTLY FROM *FILE*
*                   MACRO.
*0        GN        PARAMETER NAME OF A FIELD WHICH OVERLAPS *FN* AND 
*                   IN SAME FORM AS *FN*. 
*0        GV        *GN* FIELD VALUE AS PASSED DIRECTLY FROM THE *FILE* 
*                   MACRO.
*0        N         NUMBER OF BITS IN THE FIELD.
*0D   ACTION
*0        ASSEMBLES THE VALUE OF PARAMETER *FN* INTO THE FIT, THEN
*         CHECKS IF *GN* IS ALSO SPECIFIED. IF SO, A NON-FATAL ASSEMBLY 
*         ERROR IS GENERATED AND THE VALUE *GV* IS ASSEMBLED IN PLACE 
*         OF *FV*.
*0D   REGISTERS USED
*0        NONE
*0D   OTHER CODE
*0        NONE
*#                                                                    000360
 FIL1.6RM MACRO     FN,FV,GN,GV,N 
          IFC       NE, FV
          VFD       N/FV
          IFC       NE, GV  ,1
4         ERR IN FILE (WARNING)- FN OVERWRITES GN 
          ELSE      1 
          VFD       N/GV
          ENDIF 
 FIL1.6RM ENDM
          TITLE     FIL2.6RM
          MACRO     FIL2.6RM,TAG,P
 FO       MICRO     1,, SQ          DEFAULT  FO 
          IRP       P              SEARCH PARAM STRING FOR *FO* 
 F2.1     IFC       NE, P 
 OPTION   MICRO     1,, P 
 KEYWD    MICRO     1,,=P=         GET KEYWORD PORTION OF PARAM 
 F2.2     IFC       NE, "KEYWD" FO
          IRP                      FO NOT FOUND 
 F2.2     ENDIF 
          IFC       EQ, "KEYWD" FO ,2 
 MICLEN   MICCNT    KEYWD          FO FOUND 
 FO       MICRO     MICLEN+2,, "OPTION" 
 F2.1     ENDIF 
 PSTRING  MICRO     1,, P 
 TAG      FILE"FO"  "PSTRING" 
FIL2.6RM  ENDM
          TITLE     GLPL.RM MACRO 
*#
*1CD  GLPL.RM MACRO 
*0D   PURPOSE 
*0        CALLS MACROS TO STORE LABEL FIELDS IN FIT AND CALL A CRM
*         I/O ROUTINE 
*0D   CALL
*0        [TAG>     GLPL.RM   ROUTINE,P1,P2,P3
*0    PARAMETERS
*0        ROUTINE   CRM I/O ROUTINE TO WHICH CALL IS TO BE GENERATED. 
*0        P1        FIT ADDRESS 
*0        P2        FWA OF LABEL AREA 
*0        P3        LENGTH OF LABEL AREA
*0D   ACTION
*0        CALLS MACRO #SA0# TO LOAD FIT ADDRESS INTO A0 
*0        CALLS MACRO STC.RM TO STORE P2 (FWA OF LABEL AREA) IN FIT 
*0        CALLS MACRO STC.RM TO STORE P3 (LENGTH OF LABEL AREA) IN FIT
*0        CALLS #CALL# TO CALL THE SPECIFIED CRM I/O ROUTINE (GETL.SQ 
*0        OR PUTL.SQ) 
*0        PARAMETERS  ROUTINE  AND  P1  ARE REQUIRED
*         PARAMETERS  P2  AND  P3  ARE OPTIONAL 
*0D   REGISTERS 
*0        NONE
*0    OTHER CODE
*0        MACROS-   #SA0# , STC.RM , #CALL# 
*         PROGRAMS- ROUTINE.SQ
*#
 GLPL.RM  MACRO     ROUTINE,P1,P2,P3. 
          #SA0#     ROUTINE,P1
          STC.RM    LA,P2 
          STC.RM    LBL,P3
          #CALL#    ROUTINE 
 GLPL.RM  ENDM                 5
          TITLE      IBX.RM Z,I 
 IBX.RM   MACRO     S,RR
          XMT.RM    S,"'?.RR=RM"
 #.B#     MICRO     1,2, "'?.RR=RM" 
 '?.RR=RM MICRO 
 IBX.RM   ENDM
          TITLE      SRX.RM 
 RRF.RM   MACRO     P 
 #.N#     MICRO     2,1, P
          IFC       EQ, . "#.N#"
 #.N#     MICRO     3,, P 
 #.N#     OCTMIC    "#.N#",1 ERROR IN "'?MNM.RM" P IS MALFORMED 
 #.M#     MICRO     1,1, P
 #.M#     MICRO     1,, "#.M#""#.N#"
          ENDIF 
 RRF.RM   ENDM
          TITLE      SPA.RM 
 SPA.RM   MACRO     RR,P
 '?.RR=RM MICRO 
 #.M#     MICRO     1,,^_P_^
 .A       IF        REG,P 
 .A       IFC       GE, "#.M#" B
 #.R#     MICRO     1,, "#.R#",RR 
 '?CNT.RM MICCNT    #.M#
          IFNE      '?CNT.RM,2,1
          RRF.RM    (P) 
 #.B#     MICRO     1,2, "#.M#" 
          IFC       NE, RR "#.B#" ,3
 '?.RR=RM MICRO     1,, "#.M#"
 .B       SKIP
 .A       ELSE
          IFC       NE,^_RR_^"#.M#"^
 #.Z#     MICRO     1,,^"#.Z#",(RR,P)^
          ENDIF 
 SPA.RM   ENDM
          TITLE      USR.RM 
 USR.RM   MACRO     RR
          IFC       NE, "'?.RR=RM"
          ECHO      ,RV=("#.R#")
 #.B#     MICRO     1,2, "'?.RV=RM" 
          IFC       EQ, RR "#.B#" ,2
          STOPDUP 
          SKIP
          ENDD
          IBX.RM    RR,RR 
* CONTINUE THRU CHAIN 
          IF        MIC,'?."#.B#"=RM
          USR.RM    "#.B#"
          ENDIF 
 USR.RM   ENDM
  
 XMT.RM   MACRO     S,VALUE 
          IFC       GT, S B8
          IFC       GT, VALUE B8
          B_S       VALUE 
          ELSE      1 
          R=        S,VALUE 
 XMT.RM   ENDM
          TITLE     STX.RM, IUS.RM, IBX.RM, SRX.RM, CYX.RM
*#
*1CD  STX.RM MACRO (INCLUDING IUS.RM, IBX.RM, SRX.RM, CYX.RM) 
*0D   PURPOSE 
*0        TAKE A LIST OF ARGUMENTS AND MOVE THEM TO A FIXED SET OF
*         X REGISTERS (SEE CHAPTER 2, SECTION 2, *CODE GENERATION*).
*0D   CALL
*0        STX.RM    PS
*0D   PARAMETERS
*0        PS        PARAMETER STRING, PASSED DIRECTLY FROM A USER 
*                   MACRO CALL
*0D   ACTIONS 
*         STX.RM IS THE MAIN MACRO, IT DOES THE FOLLOWING THINGS: 
*         1.  FIRST, DETERMINE WHICH PARAMETERS ARE X REGISTERS.  THE 
*         PARAMETERS ARE GIVEN IN THE FIRST ARGUMENT TO STX.RM. 
*         CHARACTERS 2 THROUGH 7 OF MICRO #.C# ARE SET TO THE REGISTER
*         NUMBERS THAT X-REGISTERS 2 THROUGH 7 ARE SUPPOSED TO CONTAIN
*         (M IS USED WHERE THE PARAMETER IS NOT AN X REG.)  PARAMETERS
*         THAT ARE ALREADY IN PLACE ARE IGNORED.
*         2.  (IN THE SAME  ECHO  WITH ABOVE CODE)  SET TWO BIT 
*         STRINGS #.U# AND #.S# TO INDICATE WHICH X-REGS ARE USED AND 
*         WHICH ARE SET, RESPECTIVELY.  (USE IUS.RM)
*         3.  IF THERE ARE REGISTERS SET BUT NOT USED (SEE SRX.RM), 
*         THEN ISSUE A TRANSMIT INSTRUCTION (USING IBX.RM WHICH ALSO
*         CHANGES THE APPROPRIATE NUMBER IN #.C#).  SRX.RM THEN REBUILDS
*         #.U# AND #.S# AND CONDITIONALLY LOOPS (BY RECURSION). 
*         4.  NOW WE HAVE TO HANDLE CYCLIC TRANSMITS (DONE BY CYX.RM) 
*         MOVE ONE REGISTER TO X0 (WHICH IS KNOWN TO BE FREE) AND LINK
*         THROUGH #.C#, ISSUING TRANSMITS FOR OTHER REGISTERS IN LOOP.
*         WHEN YOU GET BACK TO THE START, TRANSMIT FROM X0.  THE  ECHO
*         WILL KEEP THINGS GOING IF THERE IS MORE THAN ONE CYCLE. 
*         5.  NOW SET THE PARAMETERS THAT ARE NOT X-REGS. ALSO SET UP 
*         '?XES.RM FOR #CALL#.
*0D   REGISTERS 
*         NONE
*0D   OTHER CODE
*         MACROS-  USR.RM (IBX.RM, XMT.RM), SPA.RM (RRF.RM), CYX.RM 
*#
 STX.RM   MACRO     PS
 #.R#     MICRO 
 #.Z#     MICRO 
*-----------------------------------------------------------------------
* THE FOLLOWING ONE CARD TOTALLY DETERMINES WHICH REGISTERS TO USE. 
          ECHO      ,P=(PS),RR=(X2,X3,B2,X6,B3,B5),Q=(0,1,2,3,4,5)
*-----------------------------------------------------------------------
          IFC       NE,^_P_^^ 
          SPA.RM    RR,(P)
 '?XES.RM SET       '?XES.RM+1S_Q 
          ENDIF 
          ENDD
 #.R#     MICRO     2,, "#.R#"
* HANDLE SIMPLE TRANSFERS 
          ECHO      1,RR=("#.R#") 
          USR.RM    RR
* HANDLE CYCLES 
          ECHO      ,RR=("#.R#")
          IFC       NE, "'?.RR=RM"
          CYX.RM    RR
          ENDIF 
          ENDD
* HANDLE SIMPLE EXPRESSIONS 
 #.Z#     MICRO     2,,^"#.Z#"^ 
          ECHO      1,REQ=("#.Z#")
          R=        REQ 
 STX.RM   ENDM
          TITLE      ST2.6RM  MACRO     FIT,KEYWORD,OPTION,F,S,M
*#
*1CD  ST2.6RM MACRO 
*0D   PURPOSE 
*0        CHECK *STORE* MACRO INPUT AND CALL ANOTHER MACRO (ST3.6RM)
*         WITH THE *KEYWORD* PARAMETER-S MICRO-S CHARACTER STRING.
*0D   CALL
*0        [TAG]     ST2.6RM   FIT,KEYWORD,OPTION,F,S,M
*0D   PARAMETERS
*0        FIT       ADDRESS OF FIT. 
*0        KEYWORD   A KEYWORD FOR WHICH AN IOTEXT MICRO REPRESENTING
*                   A FIT OR MCT FIELD EXISTS.
*0        OPTION    THE VALUE TO BE STORED IN THE FIELD REPRESENTED 
*                   BY *KEYWORD*. 
*0        F         NUMBER OF FETCH (A) REGISTER TO BE USED.
*0        S         NUMBER OF STORE (A) REGISTER TO BE USED.
*0        M         NUMBER OF MASK (X) REGISTER TO BE USED. 
*0D   ACTION
*0        ISSUES AN ASSEMBLY ERROR IF:  
*0        (1) *KEYWORD* IS NOT A MICRO, 
*         (2) *F* GT 5, 
*         (3) *S* LT 6, 
*         (4) *M*=*S*,
*         (5) *KEYWORD* IS NOT A LEGAL *STORE* FIELD. 
*0        CALLS *ST3.6RM*, WHICH GENERATES CODE TO DO A *STORE*.
*0D   REGISTERS 
*0        NONE
*0D   OTHER CODE
*0        MACROS-   ST3.6RM 
*#
 ST2.6RM  MACRO     FIT,KEYWORD,OPTION,F,S,M
          IF        -MIC,#_KEYWORD_#,2
          IFC       NE,/KEYWORD/FET/,1
          ERR       STORE KEYWORD ILLEGAL PARAMETER 
          IFEQ      M,F,1 
          ERR       STORE     FETCH AND MASK REGISTER CONFLICT
          IFEQ      M,S,1 
          ERR       STORE     STORE AND MASK REGISTER CONFLICT
          ST3.6RM   "#_KEYWORD_#",FIT,OPTION,KEYWORD,F,S,M
 ST2.6RM  ENDM
          TITLE      ST3.6RM  MACRO     TBL,WRX,FL,POS,CNV,ADR,FIT,OPTIO
*#
*1CD  ST3.6RM MACRO 
*0D   PURPOSE 
*0        GENERATE CODE TO STORE A FIELD IN THE FIT.
*0D   CALL
*0        [TAG]     ST3.6RM   T,W,L,P,C,A,FIT,OPTION,KEYWORD,F,S,M. 
*0D   PARAMETERS
*0        T         TABLE TO BE STORED INTO,
*                   0 - FIT,
*                   2 - MCT.
*0        W         WORD WITHIN TABLE, NUMBERED FROM 0. 
*0        L         LENGTH OF FIELD (BITS). 
*0        P         BEGINNING BIT POSITION OF FIELD.
*0        C         FETCH/STORE PERMISSION, 
*                   0 - ALL PERMISSIONS,
*                   1 - FETCH PERMISSION, 
*                   2 - STORE PERMISSION, 
*                   3 - NO PERMISSION.
*0        A         WHETHER THE KEYWORD IS AN ADDRESS OR USER-DEFINED 
*                   QUANTITY (A=1), OR HAS AN OPTION DEFINED IN THE 
*                   TABLE OF OPTION SYMBOLS (A=0).
*0        FIT       FIT ADDRESS.
*0        OPTION    VALUE TO BE STORED. 
*0        KEYWORD   KEYWORD FROM STORE MACRO. 
*0        F,S,M     FETCH, MASK AND STORE REGISTER NUMBERS. 
*                   DEFAULT VALUES ARE 5,6, AND 7 RESPECTIVELY. 
*0D   ACTION
*0        GENERATES CODE TO STORE (OPTION) INTO THE FIT OR MCT FIELD
*         REPRESENTED BY KEYWORD. E.G., FOR A SIMPLE STRAIGHT FORWARD 
*         STORE OF A FIELD WITH AN OPTION 
*0                            SX.S      #_OPTION_#
*                             SA.F      FIT+W 
*                             MX.M      60-L
*                             LX.F      60-P      ONLY IF P NE 0. 
*                             BX.S      -X.M*X.S
*                             IX.S      X.S+X.M 
*                             LX.S      P         ONLY IF P NE 0. 
*                             SA.S      A.F 
*0D   REGISTERS 
*0        USES-     AX.FS, X.M
*0D   OTHER CODE
*0D       NEEDS LIST OF KEYWORDS AND OPTIONS. 
*#
 ST3.6RM  MACRO     TBL,WRX,FL,POS,CNV,ADR,FIT,OPTION,KEYWORD,F,S,M 
*     ERROR IF CNV IS ODD 
          IFNE      CNV_&1,CNV+1,1
          ERR       ILLEGAL STORE FIELD AT ("SEQUENCE") IS FATAL. 
 EN.RM    IFEQ      2,ADR 
RM.R      IF        REG,OPTION
          IFNE      OPTION,X.S,1
          BX.S      OPTION
RM.R      ELSE
*         FOR DEFINITION OF #.V# SEE STORE MACRO
          IFC       EQ, KEYWORD PNO ,4
#.R#      MICCNT    #.V#
#.T#      MICRO     #.R#,, 000_OPTION 
          SA.F      =0R"#.T#" 
          SKIP      1 
          SA.F      =0L_OPTION
          BX.S      X.F 
RM.R      ENDIF 
          SA.F      FIT+WRX 
          MX.M      FL
          IFC       EQ, KEYWORD PNO ,1
          LX.M      FL
          BX.F      -X.M*X.F
          BX.S      X.M*X.S 
          BX.S      X.F+X.S 
          SA.S      A.F 
EN.RM     ELSE
* 
*     #.O# IS NULL UNTIL IT GETS THE REGISTER CONTAINING THE VALUE. 
#.O#      MICRO 
* 
RM.OK     IF        REG,OPTION
RM.NB     IFEQ      OPTION,X.F
*     THE OPTION CONFLICTS WITH THE FETCH--MOVE IT OUT OF THE WAY.
#.O#      MICRO     1,, X.S 
          IF        REG,FIT,2 
          IFEQ      FIT,X.S,1 
#.O#      MICRO     1,, X.M 
          B"#.O#"   OPTION
RM.OK     SKIP
RM.NB     ENDIF 
*     THE OPTION DOES NOT CONFLICT. 
          IFC       GT, OPTION X ,1 
#.O#      MICRO     1,, OPTION
RM.OK     ENDIF 
* 
*     FETCH THE WORD TO BE CHANGED. 
#.R#      MICRO     F,1, 12345
          R=        A"#.R#",FIT+WRX      ERROR MEANS BAD FETCH REG. 
* 
RM.OK     IFC       EQ, "#.O#"
#.O#      MICRO     1,, X.S 
#.R#      MICRO     S-5,1, 67 
RM.K      IFEQ      ADR 
RM.K      IF        -REG,OPTION 
#.T#      MICRO 
 #.T#     #WHICH#   KEYWORD,(KT,RT,BT,ULP,PM),(KT,T,T,P,PM) 
* 
*     OPTION IS A SYMBOLIC VALUE
          R=        X"#.R#",#_OPTION"#.T#"# 
* 
RM.K      ELSE      1 
* 
*     OPTION IS A NON-X-REGISTER OR AN EXPRESSION 
          R=        X"#.R#",OPTION
* 
RM.OK     ENDIF 
* 
RM.M      IF        DEF,"#.O#"
RM.M      IFEQ      "#.O#",X.M
* 
*     STORING FROM X.M
          MX.S      60D-FL
          IFNE      POS,,1
          LX.F      60D-POS 
          BX.M      -X.S*X.M
          BX.S      X.S*X.F 
RM.M      ELSE
* 
*     STORING FROM SOME OTHER X REGISTER
          MX.M      60D-FL
          IFNE      POS,,1
          LX.F      60D-POS 
          BX.S      -X.M*"#.O#" 
          BX.M      X.M*X.F 
RM.M      ENDIF 
          IX.S      X.S+X.M 
          IFNE      POS,0,1 
          LX.S      POS 
          SA.S      A.F 
EN.RM     ENDIF 
 ST3.6RM  ENDM
          TITLE     #SA0# MACRO MACNAME,FIT 
*#
*1CD  #SA0# MACRO 
*0D   PURPOSE 
*0        CHECK VARIOUS THINGS, AND GENERATE A
*0C       SA0       <FIT-ADDRESS> 
*0        FOR       CRM MACROS. 
*0D   CALL
*0        [TAG]     #SA0#     M,F 
*0D   PARAMETERS
*0        M         NAME OF MACRO FROM WHICH #SA0# IS BEING CALLED. 
*0        F         FIT ADDRESS.
*0D   ACTION
*0        SETS THE FOLLOWING SYMBOLS TO ZERO, SO THEY WONT TURN UP
*         UNDEFINED IN #CALL# IF *STC.RM* IS NOT CALLED 
*0C       '?XES.RM
* C       '?CHR.RM
*0D   REGISTERS 
*         A0 AND POSSIBLY B1 ARE USED.
*0D   OTHER CODE
*         NONE
*#
#SA0#     MACRO     M,F 
'?XES.RM  SET       0 
'?CHR.RM  SET       0 
'?MNM.RM  MICRO     1,, M 
'?ERR.RM  SET       0 
          IF        -DEF,B1=1,1 
          R=        B1,1
          IF        -DEF,##,1 
          SST 
          IFC       EQ, F 
'?ERR.RM  SET       1 
          ERR       M -- NO LFN SPECIFIED.
          ELSE
          IF        REG,F,1 
          IFNE      A0,F
          R=        A0,F
          ENDIF 
#SA0#     ENDM
          TITLE     SNTX.RM 
*#
*1CD  THE SNTX.RM MACRO 
*0D   PURPOSE 
*0        CHECK IF ACTUAL PARAMETERS GIVEN TO A CRM MACRO ARE PROPERLY
*         SPECIFIED, AND SET UP CONDITIONAL STORE OF PARAMETERS (WHICH
*         IS DONE WITH *STC.RM*.
*0D   CALLING SEQUENCE
*0        SYM       SNTX.RM   P,(<VALU-LIST>),(<CHAR-LIST>) 
*0D   PARAMETERS
*0        SYM       RETURNED VALUE. THIS IS RETURNED IN TWO WAYS: THE 
*                   VALUE OF A SET SYMBOL AND THE CHARACTER STRING OF 
*                   A MICRO. *SYM* WILL BE THE LOCATION FIELD OF THE
*                   SYMBOL/MICRO. 
*         P         THE ACTUAL PARAMETER NAME OF THE PARAMETER TO BE
*                   SYNTAX-CHECKED. 
*0        VALU-LIST A LIST OF PERMISSIBLE ACTUAL VALUES OF *P*. 
*0        CHAR-LIST A LIST WHOSE ELEMENTS CORRESPOND TO THOSE OF
*                   *VALU-LIST*. IF P TURNS OUT TO HAVE VALUE I OF
*                   *VALU-LIST*, THEN THE MICRO *SYM* IS THE CHARACTER
*                   STRING GIVEN BY ELEMENT I OF *CHAR-LIST*. 
*0D   ACTION
*0        CHECKS IF PARAMETER *P* IS ONE OF *VALU-LIST*. IF IT IS,
*         THE MICRO *SYM* IS THE CORRESPONDING ELEMENT OF *CHAR-LIST*;
*         ELSE AN ASSEMBLY ERROR IS PRODUCED .. 
*0        ERROR IN <MACRO> PARAMETER MAL-SPECIFICATION <PARAMETER>. 
*0        THE VALUE OF A SET SYMBOL *SYM* IS RETURNED -2 IF A PARA- 
*         METER SPECIFICATION ERROR OCCURRED. 
*     INPUT:  
*         A -- A LIST OF PERMISSIBLE VALUES, BEGINNING WITH NULL
*         B -- WHAT THEY MAP INTO 
*         E -- WHAT TO SEARCH FOR 
*     OUTPUT: 
*         C -- SET TO 
*              -2  IF NO MATCH
*         -1  IF X REGISTER 
*         0   IF FIRST (TYPICALLY NULL) OPTION
*              \1  IF MATCH FOUND 
*         C -- SET TO C-TH ITEM IN B, UNDEFINED IF C=-1 (MICRO) 
*0D   REGISTERS 
*0        NONE
*0D   OTHER CODE
*0        MACROS-   #WHICH# 
*#
          MACRO     SNTX.RM,C,E,A,B 
          NOREF     C 
C         #WHICH#   E,(A),(B) 
          IFEQ      C,-1
C         SET       -2
          IF        REG,E,3 
#.M#      MICRO     1,1, E
          IFC       EQ, "#.M#" X ,1 
C         SET       -1
          IFEQ      C,-2
       ERR IN "'?MNM.RM" PARAMETER MAL-SPECIFICATION (E)
'?ERR.RM  SET       1 
          ENDIF 
          ENDD
SNTX.RM   ENDM
          TITLE     STC.RM    MACRO 
*#
*1CD  STC.RM
*0D   PURPOSE 
*0        CONDITIONALLY STORE A VALUE IN AN FIT FIELD.
*0D   CALL
*0        [TAG]     STC.RM    FLD,VAL 
*0D   PARAMETERS
*0        TAG       COMPASS LOCATION FIELD SYMBOL.
*         FLD       NAME OF FIELD TO BE STORED. 
*         VAL       VALUE OF FIELD TO BE STORED IN *FLD*. 
*         A0        FIT ADDRESS 
*0D   ACTION
*0        IF *VAL* IS NON-NULL, A CALL TO *ST3.6RM* IS GENERATED TO 
*         STORE THE VALUE IN THE FIELD *FLD*. 
*0D   REGISTERS 
*0        USES AX567, ALL OTHERS PRESERVED. 
*0D   OTHER CODE REQUIRED 
*0        MACROS-   ST3.6RM.
*#
STC.RM    MACRO     FLD,V 
          IFC       NE, V  ,1 
          ST3.6RM   "#_FLD_#",A0,V,FLD,5,6,7
STC.RM    ENDM
          TITLE     STRG.RM MACRO PARAMETER,BS,REGISTER 
*#
*1CD  THE STRG.RM MACRO 
*0D   PURPOSE 
*0        ANALYZE A PARAMETER AND PLACE IT IN A DESIGNATED REGISTER.
*0D   CALL
*         [TAG]     STRG.RM   P,BS,RG 
*0D   PARAMETERS
*0        P         PARAMETER TO BE ANALYZED
*         BS        B OR S. WHETHER YOU WANT A B(OOLEAN) OR S(ET) TYPE
*                   INSTRUCTION GENERATED.
*         RG        REGISTER YOU WANT *P* PUT IN. 
*0D   ACTION
*0        IF *P* IS A REGISTER, BUT NOT AN X REGISTER, AN ASSEMBLY
*         TIME ERROR MESSAGE IS ISSUED, AND AN
*0C       R= RG,P 
*0        INSTRUCTION IS GENERATED. IF *P* IS AN X REGISTER, AND
*         NOT EQUAL TO *RG*, A
*0C       <BS>.RG   P 
*0        INSTRUCTION IS GENERATED, ELSE THE SAME 
*0        R= RG,P 
*0        INSTRUCTION IS GENERATED. 
*0D   REGISTERS 
*0        *RG* IS USED
*0D   OTHER CODE
*0        NONE
*#
STRG.RM   MACRO     P,BS,RG 
          IF        REG,P 
#.M#      MICRO     1,1, P
          IFC       NE, "#.M#" X ,2 
4       ERR IN "'?MNM.RM" (WARNING)- P SHOULD BE X-REG OR CONSTANT
          SKIP      3 
          IFNE      RG,P,1
          BS_RG     P 
          ELSE      2 
          IFC       NE, P  ,1 
          R=        RG,P
STRG.RM   ENDM
          TITLE     BOI.RM MACRO
 BOI.RM   MACRO     ADR 
 SYS      IFC       EQ,/"OS.NAME"/KRONOS/ 
          F.RM      FCS            GET FUNCTION CODE
          MX6       58             IGNORE MODE AND COMPLETE BITS
          BX1       X6*X1 
          SB4       #BOI# 
          ZR        X1,ADR         JUMP IF BOI HIT
 SYS      ELSE
          F.RM      RSC,2          RESIDUAL SKIP COUNT
          SET.RM    RSC,0 
          SB4       #BOI# 
          NZ        X2,ADR         JUMP IF BOI HIT
 SYS      ENDIF 
 BOI.RM   ENDM
          TITLE     #CALL#    MACRO 
*#
*1CD  #CALL# MACRO
*0D   PURPOSE 
*0        ISSUE A CALL TO A CRM I/O ROUTINE 
*0D   CALL
*0                  #CALL#    NAME
*0D   PARAMETERS
*0        NAME      NAME OF ROUTINE TO BE CALLED. SOMETHING OF THE
*                   FORM *XXX$XX* OR JUST *XX*. 
*0        '?XES.RM  MUST HAVE BEEN GENERATED BY *STX.RM*. 
*0        '?CHR.RM  MUST HAVE BEEN GENERATED BY BY #SA0# OR USER MACRO
*                   SEE CHAPTE 2 SECTION 2 (CODE GENERATION). 
*0D   ACTION
*0        A MICRO, #.D#, IS GENERATED, WHICH CONTAINS JUST THE CHAR-
*         ACTERS OF *NAME* WHICH PRECEDE THE *$*. IF *NAME* CONTAINS
*         NO *$*, IT IS JUST ALL OF THE CHARACTERS OF *NAME*. 
*         VALUE.
*0        IF #.D# AND *NAME* ARE THE SAME (I.E., IF *NAME* CONTAINS 
*         NO *$*), A JUMP OF THE FORM 
*0C       +         EQ        =X_NAME$RM
*0        IS GENERATED; ELSE A JUMP OF THE FORM 
*0C       +         EQ        =X_NAME 
*0        IS GENERATED. 
*0C       THE NEXT 12 BITS OF THE JUMP INSTRUCTION WORD ARE FILLED
*         WITH THE FOLLOWING BIT PATTERN
*0C       -         VFD       6/'?XES.RM/4,6/'?CHR.RM 
*0        IN ALL, THE PATTERN OF CODE GENERATED IS
*0                            SB6       *+2 
*                   +         EQ        =X<CRM-ROUTINE> 
*                   -         VFD       <30-BITS-OF-STUFF>
*0D   REGISTERS 
*         USE B6
*0D   OTHER CODE
*0        MACROS-   NONE
*         NOTE-     #SA0# AND STX.RM CALLS MUST PRECEDE #CALL#. 
*#
 #CALL#   MACRO     N 
          SB6       *+2 
 #.D#     MICRO     1,,$N$
          IFC       EQ, N "#.D#" ,2 
+         EQ        =X_N$RM 
          SKIP      1 
+         EQ        =X_N
-         VFD        6/'?XES.RM,24D/
#CALL#    ENDM
          TITLE     #WHICH# 
*#
*1CD  #WHICH# MACRO 
*0D   PURPOSE 
*0        DETERMINE WHICH ONE OF A LIST OF VALUES THE ACTUAL VALUE OF 
*         SOME PARAMETER IS.
*0D   CALL
*0        C         #WHICH#   P,(<LIST-1>),(<LIST-2>) 
*0D   PARAMETERS
*0        C         RETURN SYMBOL. COMES BACK AS BOTH A MICRO AND A 
*                   SET SYMBOL. 
*0        <LIST-1>  A LIST OF ACTUAL VALUES WHICH P MAY TAKE ON.
*0        <LIST-2>  A LIST OF OTHER VALUES, WHICH CORRESPONDS TO
*                   <LIST-1>. 
*0        P         PARAMETER TO BE EVALUATED.
*0D   ACTION
*0        THE ACTUAL VALUE OF *P* IS MATCHED AGAINST EACH ELEMENT 
*         OF <LIST-1>. IF A MATCH IS FOUND, THE MICRO *C* WILL BE 
*         THE CHARACTER STRING OF THE MATCHING ELEMENT OF <LIST-2>, 
*         AND SET SYMBOL *C* IS RETURNED GT 0; ELSE *C* IS SET LT 0.
*0D   REGISTERS 
*         NONE
*0D   OTHER CODE
*         NONE
*#
          MACRO     #WHICH#,C,E,A,B 
C         SET       -1
          ECHO      ,#MMM#=(A),#NNN#=(B)
C         SET       C+1 
          IFC       EQ, E #MMM# ,3
 C        MICRO     1,, #NNN# 
          STOPDUP 
          SKIP      2 
          ENDD
C         SET       -1
#WHICH#   ENDM
