Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/rmssym.mpr
There are 6 other files named rmssym.mpr in the archive. Click here to see a list.
SALL ;THERE IS A LOT OF MACRO EXPANSION
;****************************************************************
;* *
;* START OF RMSSYM.MPR *
;* *
;* RMS SYMBOL AND MACRO DEFINITIONS *
;* *
;****************************************************************
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979, 1986.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
; COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
; ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
; AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
; SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
; ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;
;AUTHOR: S. BLOUNT
;EDIT DATE: 22-JUN-77
;
;
; MODIFIED BY:
;
; Ron Lusk, 1-Jun-83
; 71 - Add copyright notice.
;
; 506 - Add dynamic library calls
;
; 656 (GAS, 13-Oct-86) Fix all protection XAB macros and field definitions
;
; ***** END OF REVISION HISTORY *****
;****************************************************************
;* MACRO WHICH PUTS COPYRIGHT IN .UNV FILE *
;****************************************************************
DEFINE $$$AAA,<ASCIZ\
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979, 1986.
ALL RIGHTS RESERVED.
\> ;[71]
IFNDEF RMS$DY, RMS$DY==0 ; Verbs indirect thru vector if nonzero
; $OPEN ==> PUSHJ 17,@$$OPEN
; Only usable in nonzero sections and
; from languages that permit indirect
IFNDEF RMS$DJ, RMS$DJ==0 ; Verbs call jacket routines if nonzero
; $OPEN ==> PUSHJ 17,$OPEN
IFE <RMS$DY+RMS$DJ>,<UNIVERSAL RMSINT>
IFN <RMS$DY>,<UNIVERSAL RMSIND>
IFN <RMS$DJ>,<UNIVERSAL RMSINJ>
;****************************************************************
;* MACROS TO SUPPORT RMS FIELD DEFS IN RMSSYM.MTB *
;****************************************************************
;MACRO TO CHECK INITIAL VALUES FOR SYMBOLS DURING ASSEMBLY.
; IF ANY SYMBOLS WITHIN RMS-20 MUST HAVE A CERTAIN
; VALUE OR RANGE OF VALUES, INSERT A MACRO INVOCATION
; HERE TO CHECK FOR THIS.
;
DEFINE $$ASSUME(SYMBOL,LOVALUE,HIVALUE),<
IFNB <LOVALUE>,<IFL SYMBOL-LOVALUE,<PRINTX ?'SYMBOL' HAS A VALUE WHICH IS TOO LOW>>
IFNB <HIVALUE>,<IFG SYMBOL-HIVALUE,<PRINTX ?'SYMBOL' HAS A VALUE WHICH IS TOO HIGH>>
>;END OF DEFINE
; THE MACROS S$$SC, S$$DC, AND S$$BC ARE USED TO DEFINE RMS CONSTANTS:
;
; S$$DC (NAMEA, NAMEB, VALUE) SETS NAMEA'$'NAMEB = A DECIMAL VALUE
;
; S$$BC (NAMEA, NAMEB, VALUE) SETS NAMEA'$'NAMEB = A BINARY CONSTANT
; (VALUE GIVES THE BIT TO BE TURNED ON)
;
; S$$SC (NAMEA, NAMEB, SCA, SCB) SETS NAMEA'$'NAMEB==SCA'$'SCB
;
DEFINE S$$SC (NAMEA, NAMEB, SCA, SCB) < NAMEA'$'NAMEB==SCA'$'SCB >
DEFINE S$$DC (NAMEA, NAMEB, DC) < NAMEA'$'NAMEB==^D'DC >
DEFINE S$$BC (NAMEA, NAMEB, BITNUM) < NAMEA'$'NAMEB==1B'BITNUM >
; MACRO $$FIELD DEFINES FIELDS WITHIN RMS-20 USER CONTROL BLOCKS.
; THE ARGUMENTS ARE:
;
; P - A SINGLE CHARACTER WHICH DENOTES THE BLOCK (R,F, OR X)
; N - FIELD NAME
; DA,
; DB - DA'$'DB IS THE DEFAULT VALUE
; OFF - XX$'OFF IS THE OFFSET INTO THE BLOCK
; SIZE - XX$'SIZE IS THE SIZE OF FIELD IN BITS
; POS - XX$'POS IS THE POSITION (NO. BITS REMAINING AT RIGHT OF FIELD)
; (UNU) SNFLG - XX$'ASNFLG IS THE ASSIGNMENT FLAG
; 1=INITIALIZATION MACRO IS DEFINED
; 0=CANNOT BE SET AT ASSEMBLY TIME
; (UNU) COUNT - XX$'COUNT IS THE COUNT OF FIELDS IF ARRAY FIELD
;
DEFINE $$FIELD (P,N,DA,DB,OFF,SIZE,POS,ASNFLG,COUNT) <
IF1,<
$$'P'N==DA'$'DB
F$$'N==<XX$'POS>B5 ! <XX$'SIZE>B11 ! XX$'OFF ;;BYTE PTR TO FIELD
> ;END OF IF1
> ;END OF $$FIELD
; MACRO RMSEND GENERATES AN END STATEMENT
;
DEFINE $$END < END >
; $$SYNM - SYNONYMS, THINGS BASED ON SYMBOLS DEFINED IN MTB
;
DEFINE $$SYNM<
FB$ALL==FB$GET+FB$PUT+FB$DEL+FB$UPD+FB$TRN
;;CONSISTENCY CHECKS
$$ASSUME(FB$SEQ,0) ;FILE ORG MUST BE GTR ZERO
$$ASSUME(RB$SEQ,0,0) ;RECORD ACCESS MUST START AT ZERO
$$ASSUME(XB$KEY,0,0) ;KEY XAB MUST BE FIRST
$$ASSUME(XB$STG,0,0) ;STRING DATA-TYPE SHOULD BE ZERO
> ;END $$SYNM
;****************************************************************
;* MACROS TO SUPPORT DEFINITION OF VERBS IN MTB FILE *
;****************************************************************
DEFINE $INIT< ;;SPECIAL "VERB", GENS IN-LINE CODE
PUSHJ 17,$$RMS## ;;USER PART OF RMS INITIALIZATION
.REQUIRE SYS:RMSINI ;;THE FILE THAT DOES IT
>
SYN $INIT,$RMS
DEFINE $$VINI< ;;SITUATION DEPENDENT INITS
XX$MAX==0 ;;INITIALIZE CURRENT MACRO OFFSET
>
DEFINE $$VERB (NAME),< ;;CREATE THE USER MACRO
C$'NAME==XX$MAX ;;KEEP VERB OFFSET AROUND
DEFINE $%'NAME(NAME)< ;;IMBED OS DEPENDENCIES HERE ;m600
IFE <RMS$DJ+RMS$DY>,< ;a506
IFN TOP$10,<PUSHJ 17,RMS$10##+C$'NAME> ;;ABSOLUTE LOC SINCE GETSEG
IFN TOP$20,<104B8+1000+C$'NAME> ;;THE JSYS INSTRUCTION FOR 'NAME'
> ;a506
IFN RMS$DY,<PUSHJ 17,@$$'NAME##> ;; Call dynamic library ;m600
IFN RMS$DJ,<PUSHJ 17,%$'NAME##> ;;call dynamic library ;m600
>
DEFINE $'NAME(.BLK1,.ERRAD,.BLK2),<
IFB <.BLK1>,<IF1,<PRINTX %ARGBLK ADDRESS OMITTED ON 'NAME' MACRO>>
XMOVEI 1, .BLK1
IFIDN <NAME><RENAME>,< ;;m521ff
IFB <.BLK2>,<IF1,<PRINTX %NEWFAB ADDRESS OMITTED ON RENAME MACRO>>
XMOVEI 2, .BLK2>
IFDIF <NAME><RENAME>,<
IFNB <.BLK2>,<IF1,<PRINTX %MORE THAN 2 ARGS DETECTED IN 'NAME' MACRO>>>
$%'NAME ;;DO THE RMS-20 JSYS ;;m600
IFE <RMS$DY+RMS$DJ>,<
IFNB <.ERRAD>,<JUMP 17,.ERRAD>
IFB <.ERRAD>,<JUMP 16,.+1> > ;;USER SPEC NO ERROR ROUTINE
IFN <RMS$DY+RMS$DJ>,< IFNB <.ERRAD>,<
CAIL 2,300000 ;;CHECK FOR ERROR CODE
PUSHJ 17,.ERRAD >> ;; CALL ERROR ROUTINE
;;COULD NOT USE .ERBAS HERE, MONSYM DEFINES IT TOO, AS 600000
>
XX$MAX==XX$MAX+1 ;;BUMP COUNTER OF VERBS
> ;;END OF $$VERB MACRO
DEFINE $$VEND< ;;DEFINE FIRST AND LAST RMS JSYS CODES
IF2,<
C$MAX==XX$MAX ;; FOR SYMMETRY AND EASIER TEST ;;A506
JS$MIN==1000
JS$MAX==1000+XX$MAX
OPDEF RM$MIN [104B8+1000] ;MINIMUM JSYS VALUE
OPDEF RM$MAX [104B8+1000+XX$MAX]
> ;;END OF IF2
>
;****************************************************************
;* RMS-20 ERROR AND SUCCESS CODES *
;****************************************************************
;ERROR CODE DEFINITIONS FOR RMS-20
;THERE ARE THREE TYPES OF ERROR CODES DEFINED IN THIS SECTION:
;
; 1. USER SUCCESS CODES (ALWAYS POSITIVE NON-ZERO)
;
; 2. USER ERROR CODES
;
; 3. RMS-20 INTERNAL FILE CONSISTENCY ERROR CODES
;
; THE FILE CONSISTENCY ERROR CODES ARE NOT AVAILABLE TO THE USER
; AS ASSEMBLY-TIME SYMBOLS, THEY CAN ONLY BE USED AS ARGUMENTS TO
; THE COMMON RMS-20 ERROR HANDLER.
;DEFINE BASE VALUES FOR SUCCESS AND ERROR CODES
;
.SUBAS==1000 ;SUCCESS CODES START AT 1000
.ERBAS==300000 ;ERROR CODES START AT 300000
ER$MIN=.ERBAS
.EXBAS==300500 ;FILE CONSISTENCY ERROR BASE
;DEFINE TEMPORARY COUNTERS FOR EACH ERROR CODE TYPE
;
.SUCTR==0 ;INITIALIZE COUNTER
.ERCTR==0 ;...
.EXCTR==0 ;FILE CONSIS CTR
;MACRO TO DEFINE A SUCCESS CODE
;
DEFINE $$SUC(.CODE,.MSG),<
$$CODE(.SUBAS,.SUCTR,.CODE,.MSG)
>
;MACRO TO DEFINE AN ERROR CODE
;
DEFINE $$UERR(.CODE,.MSG),<
$$CODE(.ERBAS,.ERCTR,.CODE,.MSG)
>
;MACRO TO DEFINE A USER FILE CONSISTENCY ERROR CODE
;
DEFINE $$FERR(.CODE,.MSG),<
$$CODE(.EXBAS,.EXCTR,.CODE,.MSG)
>
;MACRO TO SETUP MAX OF A CODE TYPE
;
DEFINE $$MAXC(TYP)<TYP'$MAX==.'TYP'BASE + .'TYP'CTR - 1>
;MACRO TO DEFINE ARBITRARY CODE VALUE
;
DEFINE $$CODE(..BASE,..CTR,..CODE,..MSG),<
..CODE=..BASE+..CTR ;;DEFINE SYMBOL FOR CODE
..CTR==..CTR+1 ;;BUMP COUNTER
>
;****************************************************************
;* DEFINE RMS-11 FIELDS WHICH ARE NOT SUPPORTED BY RMS-20 *
;****************************************************************
;MACRO TO DEFINE RMS-11 FIELDS WHICH ARE NOT SUPPORTED BY RMS-20
DEFINE ..BADF(PREFIX,NAME),<
DEFINE PREFIX'$'NAME(ARG)<
IF1,<PRINTX %"'PREFIX'$'NAME'" RMS-11 ONLY, IGNORED BY RMS-20>
>;;END OF DEFINE
>;;END OF ..BADF
;MACRO FOR BAD FAB FIELDS
DEFINE ..BFAB(FLDNAM),<
IRP FLDNAM,< ..BADF(F,FLDNAM) >
>
;MACRO FOR BAD RAB FIELDS
DEFINE ..BRAB(FLDNAM),<
IRP FLDNAM,< ..BADF(R,FLDNAM) >
>
;MACRO FOR BAD XAB FIELDS
DEFINE ..BXAB(FLDNAM),<
IRP FLDNAM,< ..BADF(X,FLDNAM) >
>
;RMS-11 FIELDS NOT SUPPORTED BY RMS-20:
IF1,<
..BFAB <FNS,DNA,DNS,RTV,ALQ,ANB,FSZ,LCH>
..BRAB <RHB>
..BXAB <MTH,HAL,PRG,PRJ,SYS,OWN,GRP,WLD,VOL,SBN,XBY>
>;END OF IF1
SUBTTL RMS USER MACROS
;****************************************************************
; CONTROL BLOCK INITIALIZATION
;
; DEFINE xAB$B (xABADDR)
;
; THIS MACRO BEGINS THE DEFINITION OF A xAB. A CALL TO xAB$B CAN BE FOLLOWED BY AN ARBITRARY NUMBER
; OF FIELD INITIALIZATION MACROS (x$### WHERE ### IS THE FIELD NAME).
; THE xAB$B AND x$### MACRO CALLS MUST BE FOLLOWED BY A xAB$E MACRO CALL.
;
; ARGUMENT:
; xABADDR ADDRESS OF THE xAB (OPTIONAL)
; USAGE:
; IF xABADDR PRESENT, PERFORM RUNTIME INIT.
; xAB$B(ADDR) WITH EXECUTABLE CODE
; 1 OR MORE x$xxx(value) value DOESNT HAVE TO BE L-TIME
; xAB$E
;
; IF xABADDR ABSENT, PERFORM COMPILE-TIME INIT.
; xAB$B WITH DECLARATIONS
; 0 OR MORE x$xxx(value) VALUE MUST L-TIME CONSTANT
; xAB-name: xAB$E name: can also precede xAB$b
;
; OPERATION:
; $B SETS CURR VALUE OF EACH CTL BLK FLD TO DEFAULT VALUE.
; EACH x$ MACRO OVERRIDES A DEFAULT VALUE WITH THE SPEC VALUE.
; $E ACTUALLY STORES THE VALUES IN THE CTL BLK:
; 1) IF NO FABADDR, VIA space allocation
; 2) IF FABADDR, VIA HRREI / $STORE
; THUS TO STORE THE CONTENTS OF A FIELD,
; SPECIFY X$FOO(@FIELD)
; *** SUPPORT FOR BLOCK INITIALIZATION MACROS
; $$CURR - INDIC DEFAULT VALUE APPLIES BY PURGING CANON SYMBOL
;
DEFINE $$CURR(PRE$,FLD$)<PURGE C$$'FLD$>
; $$MAPADD - CREATE SYMBOL = BASE OF CTL BLK WHEN DOING DYNAMIC INIT
;
DEFINE $$MAPADD(ADDR$,SYM$)<DEFINE SYM$<ADDR$>>
; $$NEWVAL - SET CANON SYMBOL TO VAL SPEC
;
DEFINE $$NEWVAL(FLD$,VAL$)<
DEFINE C$$'FLD$<VAL$> ;;ASSIGN THE NEW VAL
>
; $$NEWARRVAL (FIELDID,SIZORPOS)
;
; THIS MACRO REPLACES THE DEFAULT VALUE OF A SPECIFIC POSITION OR SIZE FLD
; OF A KEY DESCRIPTION XAB BY A USER SPECIFIED VALUE
;
; ARGUMENTS:
; FID$ FIELD NAME (SIZ OR POS)
; VAL$ SIZE OR POSITION SPECIFIED BY USER
;
DEFINE $$NEWARRVAL (FID$,VAL$)<
IFNB <VAL$>,<C$$'FID$==VAL$>
>
; $$SET - SET RMS CTL FIELD TO USER-SPECIFIED OR DEFAULT VALUE
; $$SET ACTU DEF BY $B MACROS DEPENDING ON STAT/DYN INIT
; THE $$CT MACROS MUST BE ON 1 LINE SO EXPANSION IS LEGAL CODE
;
; STATIC INIT:
; MACRO REFERENCE ALLOCATES AND ASSIGNS VALUE TO ALLOCATED SPACE
; DYNAMIC INIT:
; FOR EFFICIENCY, RMS ASSUMES THAT A BLOCK IS 0.
; SO $$SET ONLY SETS NON-0 DEFAULTS & FIELDS EXPLIC SET BY AN X$YYY MACRO
; $$SET CANNOT BE FED A NEGATIVE VALUE (1B0=1).
; HOWEVER $$SET(777777) DOES HAVE THE EFFECT DESIRED FOR $$SET(-1).
;
DEFINE STO$$C(FLD$)< ;;CHK IF $STORE NECES
IFDEF C$$'FLD$,< ;;USER SET THIS FIELD
<HRREI 1,> ! C$$'FLD$ ;;LOAD VAL OF SYMBOL
$STORE (1,FLD$,$$ADDR) ;;GEN MOVEM, HRxM, or DPB
>
>
DEFINE SF$$RT(FLD$)<
IFNDEF C$$'FLD$,<IFN $$F'FLD$,<C$$'FLD$==$$F'FLD$>>
STO$$C(FLD$) ;;COPY IT
> ;;END $$SET
DEFINE SF$$CT(FLD$)<IFDEF C$$'FLD$,<C$$'FLD$> IFNDEF C$$'FLD$,<$$F'FLD$>>
DEFINE SR$$RT(FLD$)<
IFNDEF C$$'FLD$,<IFN $$R'FLD$,<C$$'FLD$==$$R'FLD$>>
STO$$C(FLD$) ;;COPY IT
> ;;END $$SET
DEFINE SR$$CT(FLD$)<IFDEF C$$'FLD$,<C$$'FLD$> IFNDEF C$$'FLD$,<$$R'FLD$>>
DEFINE SX$$RT(FLD$)<
IFNDEF C$$'FLD$,<IFN $$X'FLD$,<C$$'FLD$==$$X'FLD$>>
STO$$C(FLD$) ;;COPY IT
> ;;END $$SET
DEFINE SX$$CT(FLD$)<IFDEF C$$'FLD$,<C$$'FLD$> IFNDEF C$$'FLD$,<$$X'FLD$>>
DEFINE SN$$RT(FLD$)<
IFNDEF C$$'FLD$,<IFN $$N'FLD$,<C$$'FLD$==$$N'FLD$>>
STO$$C(FLD$) ;;COPY IT
> ;;END $$SET
DEFINE SN$$CT(FLD$)<IFDEF C$$'FLD$,<C$$'FLD$> IFNDEF C$$'FLD$,<$$N'FLD$>>
DEFINE ST$$RT(FLD$)<
IFNDEF C$$'FLD$,<IFN $$T'FLD$,<C$$'FLD$==$$T'FLD$>>
STO$$C(FLD$) ;;COPY IT
> ;;END $$SET
DEFINE ST$$CT(FLD$)<IFDEF C$$'FLD$,<C$$'FLD$> IFNDEF C$$'FLD$,<$$T'FLD$>>
;****************************************************************
;* 4.2 FILE ACCESS BLOCK (FAB) DECLARATION MACROS *
;****************************************************************
DEFINE FAB$B (FABADDR)<
IFNB <FABADDR>,< ;RUN-TIME INIT
$$MAPADD (FABADDR,$$ADDR); ; WILL REFERENCE FAB VIA $$ADDR
SYN SF$$RT,$$SET
> ;;END IFNB
IFB <FABADDR>,<SYN SF$$CT,$$SET> ;;C-T INIT
$$CURR (F,BID)
$$CURR (F,BLN)
$$CURR (F,STS)
$$CURR (F,STV)
$$CURR (F,IFI)
$$CURR (F,JFN)
$$CURR (F,FAC)
$$CURR (F,SHR)
$$CURR (F,FOP)
$$CURR (F,ORG)
$$CURR (F,FNA)
$$CURR (F,RAT)
$$CURR (F,MRS)
$$CURR (F,MRN)
$$CURR (F,BSZ)
$$CURR (F,RFM)
$$CURR (F,XAB)
$$CURR (F,JNL)
$$CURR (F,BLS)
$$CURR (F,BKS)
$$CURR (F,DEV)
$$CURR (F,SDC)
$$CURR (F,CTX)
$$CURR (F,FSZ) ;![AWN]
$$CURR (F,TYP) ;![AWN]
$$CURR (F,NAM) ;![AWN]
$$CURR (F,ALQ) ;![AWN]
> ;END FAB$B
; DEFINE F$### (VALUE)
;
; THESE MACROS INITIALIZE FAB FIELD ### WHERE ### REPRESENTS THE FIELD NAME.
; CALLS TO THESE MACROS MUST BE PRECEDED BY A FAB$B MACRO CALL AND FOLLOWED BY A FAB$E CALL.
;
; ARGUMENT:
; VALUE VALUE TO SET THE FIELD TO
;
DEFINE F$JFN (VALUE) <$$NEWVAL (JFN,VALUE)>
DEFINE F$FAC (VALUE) <$$NEWVAL (FAC,VALUE)>
DEFINE F$SHR (VALUE) <$$NEWVAL (SHR,VALUE)>
DEFINE F$FOP (VALUE) <$$NEWVAL (FOP,VALUE)>
DEFINE F$ORG (VALUE) <$$NEWVAL (ORG,VALUE)>
DEFINE F$FNA (VALUE) <$$NEWVAL (FNA,VALUE)>
DEFINE F$RAT (VALUE) <$$NEWVAL (RAT,VALUE)>
DEFINE F$MRS (VALUE) <$$NEWVAL (MRS,VALUE)>
DEFINE F$MRN (VALUE) <$$NEWVAL (MRN,VALUE)>
DEFINE F$BSZ (VALUE) <$$NEWVAL (BSZ,VALUE)>
DEFINE F$RFM (VALUE) <$$NEWVAL (RFM,VALUE)>
DEFINE F$XAB (VALUE) <$$NEWVAL (XAB,VALUE)>
DEFINE F$JNL (VALUE) <$$NEWVAL (JNL,VALUE)>
DEFINE F$BLS (VALUE) <$$NEWVAL (BLS,VALUE)>
DEFINE F$BKS (VALUE) <$$NEWVAL (BKS,VALUE)>
DEFINE F$CTX (VALUE) <$$NEWVAL (CTX,VALUE)>
DEFINE F$FSZ (VALUE) <$$NEWVAL (FSZ,VALUE)> ;![AWN]
DEFINE F$ALQ (VALUE) <$$NEWVAL (ALQ,VALUE)> ;![AWN]
DEFINE F$NAM (VALUE) <$$NEWVAL (NAM,VALUE)> ;![AWN]
DEFINE F$TYP (VALUE) <$$NEWVAL (TYP,VALUE)> ;![AWN]
; DEFINE FAB$E
;
; THIS MACRO ENDS THE DEFINITION OF A FAB. A CALL TO FAB$E MUST BE PRECEDED BY A FAB$B MACRO CALL.
;
DEFINE FAB$E<
IFNDEF $$ADDR,< ;;STATIC ALLOC
<$$SET(BID)>_^D18 ! <$$SET(BLN)>
<$$SET(STS)>_^D18 ! <$$SET(STV)>
<$$SET(CTX)>
<$$SET(IFI)>_^D18 ! <$$SET(JFN)>
<$$SET(FAC)>_^D18 ! <$$SET(SHR)>
<$$SET(FOP)>_^D18 ! <$$SET(ORG)>_^D14 ! <$$SET(BSZ)>_^D8 ! <$$SET(BLS)>
<$$SET(FNA)>
<$$SET(RAT)>_^D18 ! <$$SET(MRS)>
<$$SET(MRN)>
<$$SET(FSZ)>_^D13 ! <$$SET(BKS)>_^D5 ! <$$SET(RFM)> ;![AWN]
<$$SET(JNL)>_^D18 ! <$$SET(XAB)>
<$$SET(DEV)>_^D18 ! <$$SET(SDC)>
<$$SET(TYP)>_^D18 ! <$$SET(NAM)> ;![AWN]
<$$SET(ALQ)> ;![AWN]
EXP 0,0
> ;END IFNB
IFDEF $$ADDR,<
$$SET(BID)
$$SET(BLN)
$$SET(STS)
$$SET(STV)
$$SET(IFI)
$$SET(JFN)
$$SET(FAC)
$$SET(SHR)
$$SET(FOP)
$$SET(ORG)
$$SET(FNA)
$$SET(RAT)
$$SET(MRS)
$$SET(MRN)
$$SET(BSZ)
$$SET(RFM)
$$SET(XAB)
$$SET(JNL)
$$SET(BLS)
$$SET(BKS)
$$SET(DEV)
$$SET(SDC)
$$SET(CTX)
$$SET(FSZ) ;![AWN]
$$SET(NAM) ;![AWN]
$$SET(TYP) ;![AWN]
$$SET(ALQ) ;![AWN]
PURGE $$ADDR ;;SO NEXT C/R DECIS RIGHT
> ;;IFDEF
> ;;FAB$E
;****************************************************************
;* 4.5 RECORD ACCESS BLOCK (RAB) DECLARATION MACROS *
;****************************************************************
DEFINE RAB$B (RABADDR)<
IFNB <RABADDR>,<
$$MAPADD (RABADDR,$$ADDR); ; WILL REFERENCE THE BLOCK VIA $$ADDR
SYN SR$$RT,$$SET
> ;;END IFNB
IFB <RABADDR>,<SYN SR$$CT,$$SET> ;;C-T INIT
$$CURR (R,BID)
$$CURR (R,BLN)
$$CURR (R,STS)
$$CURR (R,STV)
$$CURR (R,ISI)
$$CURR (R,FAB)
$$CURR (R,RAC)
$$CURR (R,ROP)
$$CURR (R,UBF)
$$CURR (R,RBF)
$$CURR (R,RSZ)
$$CURR (R,USZ)
$$CURR (R,RFA)
$$CURR (R,KRF)
$$CURR (R,KSZ)
$$CURR (R,KBF)
$$CURR (R,MBF)
$$CURR (R,LSN)
$$CURR (R,BKT)
$$CURR (R,PAD)
$$CURR (R,CTX)
> ;END RAB$B
DEFINE R$FAB (VALUE) < $$NEWVAL (FAB,VALUE)>
DEFINE R$RAC (VALUE) < $$NEWVAL (RAC,VALUE)>
DEFINE R$ROP (VALUE) < $$NEWVAL (ROP,VALUE)>
DEFINE R$UBF (VALUE) < $$NEWVAL (UBF,VALUE)>
DEFINE R$RBF (VALUE) < $$NEWVAL (RBF,VALUE)>
DEFINE R$RSZ (VALUE) < $$NEWVAL (RSZ,VALUE)>
DEFINE R$USZ (VALUE) < $$NEWVAL (USZ,VALUE)>
DEFINE R$KRF (VALUE) < $$NEWVAL (KRF,VALUE)>
DEFINE R$KSZ (VALUE) < $$NEWVAL (KSZ,VALUE)>
DEFINE R$KBF (VALUE) < $$NEWVAL (KBF,VALUE)>
DEFINE R$MBF (VALUE) < $$NEWVAL (MBF,VALUE)>
DEFINE R$PAD (VALUE) < $$NEWVAL (PAD,VALUE)>
DEFINE R$LSN (VALUE) < $$NEWVAL (LSN,VALUE)>
DEFINE R$CTX (VALUE) < $$NEWVAL (CTX,VALUE)>
DEFINE R$RFA (VALUE) < $$NEWVAL (RFA,VALUE)>
DEFINE R$ELS (VALUE) < $$NEWVAL (ELS,VALUE)>
; RAB DECLARATION MACROS (CONTINUED)
; DEFINE RAB$E
;
; THIS MACRO ENDS THE DEFINITION OF A RAB. A CALL TO RAB$E MUST BE PRECEDED BY A RAB$B MACRO CALL.
;
DEFINE RAB$E<
IFNDEF $$ADDR,<
<$$SET(BID)>_^D18 ! <$$SET(BLN)>
<$$SET(STS)>_^D18 ! <$$SET(STV)>
<$$SET(CTX)>
<$$SET(ISI)>_^D18 ! <$$SET(FAB)>
<$$SET(RAC)>_^D27 ! <$$SET(MBF)>_^D18 ! <$$SET(ROP)>
<$$SET(UBF)>
<$$SET(RBF)>
<$$SET(RSZ)>_^D18 ! <$$SET(USZ)>
<$$SET(RFA)>
<$$SET(KRF)>_^D27 ! <$$SET(KSZ)>_^D18 ! <$$SET(LSN)>
<$$SET(KBF)>
<$$SET(BKT)>
<$$SET(PAD)>_^D27
EXP 0,0,0
> ;IFNDEF
IFDEF $$ADDR,<
$$SET(BID)
$$SET(BLN)
$$SET(STS)
$$SET(STV)
$$SET(ISI)
$$SET(FAB)
$$SET(RAC)
$$SET(ROP)
$$SET(UBF)
$$SET(RBF)
$$SET(RSZ)
$$SET(USZ)
$$SET(RFA)
$$SET(KRF)
$$SET(KSZ)
$$SET(KBF)
$$SET(MBF)
$$SET(LSN)
$$SET(BKT)
$$SET(PAD)
$$SET(CTX)
PURGE $$ADDR ;SO NEXT C/R DECIS CORRECT
> ;IFDEF
> ;RAB$E
;****************************************************************
;* 4.4 EXTENDED ATTRIBUTES BLOCK (XAB) DECLARATION MACROS *
;****************************************************************
; DEFINE XAB$B (CODE,XABADDR)
;
; ADDITIONAL ARGUMENT:
; CODE = TYPE OF XAB:
; KEY (KEY DESCRIPTOR XAB)
; DAT (DATE XAB)
; ALL (AREA ALLOCATION XAB)
; SUM (FILE SUMMARY XAB)
; PRO (Protection XAB)
;
DEFINE XAB$B (CODE,XABADDR)<
IFNB <XABADDR>,<
$$MAPADD (XABADDR,$$ADDR) ;;WILL REFERENCE XAB VIA $$ADDR
SYN SX$$RT,$$SET
> ;;END IFNB
IFB <XABADDR>,<SYN SX$$CT,$$SET> ;;C-T INIT
;;COMMON XAB HEADER
C$$COD==XB$'CODE ;;DEFINE TEMP FOR COMPARE CHK
X$$BLN==XA$SX'CODE ;;SET CODE-DEP XAB LEN ;;M575
;;1ST CHAR ONLY (LEN XA$SX=5)
$$CURR (X,BLN) ;;A575
$$CURR (X,BID)
$$CURR (X,RS1)
$$CURR (X,NXT)
;;DATE XAB
$$CURR (X,CDT)
$$CURR (X,RDT)
$$CURR (X,EDT)
;;Protection XAB
$$CURR (X,PSY)
$$CURR (X,POW)
$$CURR (X,PGR)
$$CURR (X,PWL)
;;AREA ALLOCATION XAB
$$CURR (X,RS2)
$$CURR (X,AID)
$$CURR (X,BKZ)
;;KEY DEFINITION XAB
$$CURR (X,IFL)
$$CURR (X,DFL)
$$CURR (X,DTP)
$$CURR (X,FLG)
$$CURR (X,IAN)
$$CURR (X,DAN)
$$CURR (X,LAN)
$$CURR (X,REF)
$$CURR (X,KNM)
$$CURR (X,RX0)
$$CURR (X,RX1)
$$CURR (X,RX2)
$$CURR (X,RX3)
$$CURR (X,RX4)
$$CURR (X,RX5)
$$CURR (X,PS0)
$$CURR (X,PS1)
$$CURR (X,PS2)
$$CURR (X,PS3)
$$CURR (X,PS4)
$$CURR (X,PS5)
$$CURR (X,PS6)
$$CURR (X,PS7)
$$CURR (X,SZ0)
$$CURR (X,SZ1)
$$CURR (X,SZ2)
$$CURR (X,SZ3)
$$CURR (X,SZ4)
$$CURR (X,SZ5)
$$CURR (X,SZ6)
$$CURR (X,SZ7)
;;FILE SUMMARY XAB
$$CURR (X,RS6)
$$CURR (X,NOK)
$$CURR (X,NOA)
$$CURR (X,RS7)
$$CURR (X,RS8)
$$CURR (X,RS9)
;;CONFIGURATION XAB
;ONLY THE NXT FIELD IS SETTABLE
> ;;XAB$B
; *** MACROS TO SET INDIVIDUAL XAB FIELDS TO A SPECIFIED VALUE
; XAB HEADER
DEFINE X$NXT (VALUE)<$$NEWVAL (NXT,VALUE)>
; DATE XAB
DEFINE X$EDT (VALUE)<$$NEWVAL (EDT,VALUE)>
; Protection XAB
DEFINE X$PSY (VALUE)<$$NEWVAL (PSY,VALUE)>
DEFINE X$POW (VALUE)<$$NEWVAL (POW,VALUE)>
DEFINE X$PGR (VALUE)<$$NEWVAL (PGR,VALUE)>
DEFINE X$PWL (VALUE)<$$NEWVAL (PWL,VALUE)>
; AREA ALLOCATION XAB
DEFINE X$AID (VALUE)<$$NEWVAL (AID,VALUE)>
DEFINE X$BKZ (VALUE)<$$NEWVAL (BKZ,VALUE)>
; KEY DEFINITION XAB
DEFINE X$IFL (VALUE)<$$NEWVAL (IFL,VALUE)>
DEFINE X$DFL (VALUE)<$$NEWVAL (DFL,VALUE)>
DEFINE X$DTP (VALUE)<$$NEWVAL (DTP,VALUE)>
DEFINE X$FLG (VALUE)<$$NEWVAL (FLG,VALUE)>
DEFINE X$IAN (VALUE)<$$NEWVAL (IAN,VALUE)>
DEFINE X$DAN (VALUE)<$$NEWVAL (DAN,VALUE)>
DEFINE X$LAN (VALUE)<$$NEWVAL (LAN,VALUE)>
DEFINE X$REF (VALUE)<$$NEWVAL (REF,VALUE)>
DEFINE X$KNM (VALUE)<$$NEWVAL (KNM,VALUE)>
; THE XPOS AND XSIZ INITIALIZATION MACROS
; DIFFER FROM THE OTHERS SINCE UP TO 8 VALUES
; CAN BE SPECIFIED.
DEFINE X$POS (VAL0,VAL1,VAL2,VAL3,VAL4,VAL5,VAL6,VAL7)<
$$NEWARRVAL (PS0,VAL0)
$$NEWARRVAL (PS1,VAL1)
$$NEWARRVAL (PS2,VAL2)
$$NEWARRVAL (PS3,VAL3)
$$NEWARRVAL (PS4,VAL4)
$$NEWARRVAL (PS5,VAL5)
$$NEWARRVAL (PS6,VAL6)
$$NEWARRVAL (PS7,VAL7)
>
DEFINE X$SIZ (VAL0,VAL1,VAL2,VAL3,VAL4,VAL5,VAL6,VAL7)<
$$NEWARRVAL (SZ0,VAL0)
$$NEWARRVAL (SZ1,VAL1)
$$NEWARRVAL (SZ2,VAL2)
$$NEWARRVAL (SZ3,VAL3)
$$NEWARRVAL (SZ4,VAL4)
$$NEWARRVAL (SZ5,VAL5)
$$NEWARRVAL (SZ6,VAL6)
$$NEWARRVAL (SZ7,VAL7)
>
; XAB DECLARATION MACROS (CONTINUED)
; DEFINE XAB$E
;
; THIS MACRO ENDS THE DEFINITION OF A XAB.
; A CALL TO XAB$E MUST BE PRECEDED BY A XAB$B MACRO CALL.
;
DEFINE XAB$E<
$$NEWVAL(BLN,X$$BLN) ;;SIZE VARIES WITH SUBTYPE ;M575
IFNDEF $$ADDR,<
<$$SET(BID)>_^D18 ! <$$SET(BLN)>
<$$SET(COD)>_^D18 ! <$$SET(NXT)>
IFE <C$$COD-XB$DAT>,<
<$$SET(CDT)>
<$$SET(RDT)>
<$$SET(EDT)>
>
IFE <C$$COD-XB$PRO>,<
<$$SET(PSY)>
<$$SET(POW)>
<$$SET(PGR)>
<$$SET(PWL)>
>
IFE <C$$COD-XB$ALL>,<
<$$SET(AID)>_^D9 ! <$$SET(BKZ)>
EXP 0,0,0
>
IFE <C$$COD-XB$KEY>,<
<$$SET(DTP)>_^D18 ! <$$SET(FLG)>
<$$SET(IAN)>_^D27 ! <$$SET(DAN)>_^D18 ! <$$SET(LAN)>_^D9 ! <$$SET(REF)>
<$$SET(IFL)>_^D18 ! <$$SET(DFL)>
<$$SET(KNM)>
EXP 0,0,0,0,0
<$$SET(PS0)>_^D18 ! <$$SET(SZ0)>
<$$SET(PS1)>_^D18 ! <$$SET(SZ1)>
<$$SET(PS2)>_^D18 ! <$$SET(SZ2)>
<$$SET(PS3)>_^D18 ! <$$SET(SZ3)>
<$$SET(PS4)>_^D18 ! <$$SET(SZ4)>
<$$SET(PS5)>_^D18 ! <$$SET(SZ5)>
<$$SET(PS6)>_^D18 ! <$$SET(SZ6)>
<$$SET(PS7)>_^D18 ! <$$SET(SZ7)>
>
IFE <C$$COD-XB$SUM>,<
<$$SET(NOK)>_^D9 ! <$$SET(NOA)>
EXP 0,0,0
>
IFE <C$$COD-XB$CFG>,<
EXP 0,0,0,0,0,0
>
>
IFDEF $$ADDR,<
;; remove $mapadd ;d552
; STORE COMMON HEADER FOR ALL XAB TYPES
$$SET(BID)
$$SET(RS1)
$$SET(COD)
$$SET(NXT)
; STORE REST OF XAB DEPENDING ON IT'S TYPE
IFE <C$$COD-XB$DAT>,<
$$SET(BLN)
$$SET(CDT)
$$SET(RDT)
$$SET(EDT)
>
IFE <C$$COD-XB$PRO>,<
$$SET(BLN)
$$SET(PSY)
$$SET(POW)
$$SET(PGR)
$$SET(PWL)
>
IFE <C$$COD-XB$ALL>,<
$$SET(BLN)
$$SET(RS2)
$$SET(AID)
$$SET(BKZ)
>
IFE <C$$COD-XB$KEY>,<
$$SET(BLN)
$$SET(IFL)
$$SET(DFL)
$$SET(DTP)
$$SET(FLG)
$$SET(IAN)
$$SET(DAN)
$$SET(LAN)
$$SET(REF)
$$SET(KNM)
$$SET(RX0)
$$SET(RX1)
$$SET(RX2)
$$SET(RX3)
$$SET(RX4)
$$SET(RX5)
$$SET(PS0)
$$SET(PS1)
$$SET(PS2)
$$SET(PS3)
$$SET(PS4)
$$SET(PS5)
$$SET(PS6)
$$SET(PS7)
$$SET(SZ0)
$$SET(SZ1)
$$SET(SZ2)
$$SET(SZ3)
$$SET(SZ4)
$$SET(SZ5)
$$SET(SZ6)
$$SET(SZ7)
>
IFE <C$$COD-XB$SUM>,<
$$SET(BLN)
$$SET(RS6)
$$SET(NOK)
$$SET(NOA)
$$SET(RS7)
$$SET(RS8)
$$SET(RS9)
>
IFE <C$$COD-XB$CFG>,<
$$SET(BLN)
>
PURGE $$ADDR ;;SO NEXT C/R DECIS RIGHT
> ;;IFDEF
> ;;XAB$E
;****************************************************************
;* 4.7 NAM BLOCK (NAM) DECLARATION MACROS *
;****************************************************************
DEFINE NAM$B (NAMADDR)<
IFNB <NAMADDR>,<
$$MAPADD (NAMADDR,$$ADDR); ; WILL REFERENCE THE BLOCK VIA $$ADDR
SYN SN$$RT,$$SET
> ;;END IFNB
IFB <NAMADDR>,<SYN SN$$CT,$$SET> ;;C-T INIT
$$CURR (N,BID)
$$CURR (N,BLN)
$$CURR (N,ESA)
$$CURR (N,ESS)
$$CURR (N,ESL)
$$CURR (N,RLF)
$$CURR (N,NOP)
$$CURR (N,RSA)
$$CURR (N,RSL)
$$CURR (N,RSS)
$$CURR (N,FNB)
$$CURR (N,WCC)
$$CURR (N,CHA)
$$CURR (N,NDL)
$$CURR (N,DVL)
$$CURR (N,NML)
$$CURR (N,TPL)
$$CURR (N,VRL)
$$CURR (N,NDA)
$$CURR (N,DVA)
$$CURR (N,DRA)
$$CURR (N,NMA)
$$CURR (N,TPA)
$$CURR (N,VRA)
> ;END NAM$B
DEFINE N$ESA (VALUE) < $$NEWVAL (ESA,VALUE)>
DEFINE N$ESS (VALUE) < $$NEWVAL (ESS,VALUE)>
DEFINE N$RLF (VALUE) < $$NEWVAL (RLF,VALUE)>
DEFINE N$NOP (VALUE) < $$NEWVAL (NOP,VALUE)>
DEFINE N$RSA (VALUE) < $$NEWVAL (RSA,VALUE)>
DEFINE N$RSS (VALUE) < $$NEWVAL (RSS,VALUE)>
; NAM DECLARATION MACROS (CONTINUED)
; DEFINE NAM$E
;
; THIS MACRO ENDS THE DEFINITION OF A NAM BLOCK
; A CALL TO NAM$E MUST BE PRECEDED BY A NAM$B MACRO CALL.
;
DEFINE NAM$E<
IFNDEF $$ADDR,<
<$$SET(BID)>_^D18 ! <$$SET(BLN)>
<$$SET(ESA)>
<$$SET(ESL)>_^D18 ! <$$SET(ESS)>
<$$SET(NOP)>_^D18 ! <$$SET(RLF)>
<$$SET(RSA)>
<$$SET(RSL)>_^D18 ! <$$SET(RSS)>
<$$SET(FNB)>
<$$SET(WCC)>
<$$SET(DVL)>_^D27 ! <$$SET(NDL)>_^D18 ! <$$SET(CHA)>
<$$SET(VRL)>_^D27 ! <$$SET(TPL)>_^D18 ! <$$SET(NML)>_^D9 ! <$$SET(DRL)>
<$$SET(NDA)>
<$$SET(DVA)>
<$$SET(DRA)>
<$$SET(NMA)>
<$$SET(TPA)>
<$$SET(VRA)>
> ;IFNDEF
IFDEF $$ADDR,<
$$SET(BID)
$$SET(BLN)
$$SET(ESA)
$$SET(ESL)
$$SET(ESS)
$$SET(NOP)
$$SET(RLF)
$$SET(RSA)
$$SET(RSL)
$$SET(RSS)
$$SET(FNB)
$$SET(WCC)
$$SET(DVL)
$$SET(NDL)
$$SET(CHA)
$$SET(VRL)
$$SET(TPL)
$$SET(NML)
$$SET(DRL)
$$SET(NDA)
$$SET(DVA)
$$SET(DRA)
$$SET(NMA)
$$SET(TPA)
$$SET(VRA)
PURGE $$ADDR ;SO NEXT C/R DECIS CORRECT
> ;IFDEF
> ;NAM$E
;****************************************************************
;* 4.8 TYPE BLOCK (TYP) DECLARATION MACROS *
;****************************************************************
DEFINE TYP$B (TYPADDR)<
IFNB <TYPADDR>,<
$$MAPADD (TYPADDR,$$ADDR); ; WILL REFERENCE THE BLOCK VIA $$ADDR
SYN ST$$RT,$$SET
> ;;END IFNB
IFB <TYPADDR>,<SYN ST$$CT,$$SET> ;;C-T INIT
$$CURR (T,BID)
$$CURR (T,BLN)
$$CURR (T,CLA)
$$CURR (T,FDT)
$$CURR (T,FLN)
$$CURR (T,FSC)
$$CURR (T,NEX)
$$CURR (T,MOR)
> ;END RAB$B
DEFINE T$CLA (VALUE) < $$NEWVAL (CLA,VALUE)>
DEFINE T$FDT (VALUE) < $$NEWVAL (FDT,VALUE)>
DEFINE T$FLN (VALUE) < $$NEWVAL (FLN,VALUE)>
DEFINE T$FSC (VALUE) < $$NEWVAL (FSC,VALUE)>
DEFINE T$NEX (VALUE) < $$NEWVAL (NEX,VALUE)>
DEFINE T$MOR (VALUE) < $$NEWVAL (MOR,VALUE)>
; TYP DECLARATION MACROS (CONTINUED)
; DEFINE TYP$E
;
; THIS MACRO ENDS THE DEFINITION OF A TYP. A CALL TO TYP$E MUST BE PRECEDED BY A TYP$B MACRO CALL.
;
DEFINE TYP$E<
IFNDEF $$ADDR,<
<$$SET(BID)>_^D18 ! <$$SET(BLN)>
<$$SET(FDT)>_^D18 ! <$$SET(CLA)>
<$$SET(FLN)>_^D18 ! <$$SET(FDT)>
<$$SET(MOR)>_^D18 ! <$$SET(NEX)>
> ;IFNDEF
IFDEF $$ADDR,<
$$SET(BID)
$$SET(BLN)
$$SET(FDT)
$$SET(CLA)
$$SET(FLN)
$$SET(FDT)
$$SET(MOR)
$$SET(NEX)
PURGE $$ADDR ;SO NEXT C/R DECIS CORRECT
> ;IFDEF
> ;RAB$E
;****************************************************************
;* MISCELLANEOUS RMS-20 USER MACROS *
;****************************************************************
; xxx$Z - ZERO THE SPECIFIED ARGUMENT BLK
;
DEFINE FAB$Z(ADDR)< $$ZERO(ADDR,FA$LNG) >
DEFINE RAB$Z(ADDR)< $$ZERO(ADDR,RA$LNG) >
DEFINE XAB$Z(ADDR,CODE)< $$ZERO(ADDR,%NAME(XA$SX,CODE)) >
DEFINE NAM$Z(ADDR)< $$ZERO(ADDR,NA$LNG) >
DEFINE TYP$Z(ADDR)< $$ZERO(ADDR,TY$LNG) >
DEFINE $$ZERO(ADDR,LEN)<
SETZM ADDR ;;CLEAR THE 1ST WORD
MOVEI 2,ADDR ;;PREP DEST START
MOVEI 1,1(2) ;;INSURE GET RIGHT RESULT
HRLI 1,ADDR ;;SRC
BLT 1,LEN-1(2) ;;ZERO IT
>
; $RETURN - CANONICAL WAY TO RETURN FROM RMS ERROR ROUTINE
;
DEFINE $RETURN,<POPJ 17,>
; $FIELD(STR$, FLD$) - DEVELOP BYTE PTR TO ARBIT FIELD
; SUCH THAT LDB, DPB, AND PUSH X,$FIELD(A,B) HAS DESIRED EFFECT
;
DEFINE $FIELD(FLD$, STR$)<[F$$'FLD$+STR$]>
; $FETCH(AC$, FLD$, STR$) - MOVES A RMS CTL FLD INTO AC
;
; ARGUMENTS:
; AC$ = AC TO USE
; FLD$ = 3-LETTER FIELD ID
; STR$ = BASE OF STRUCTURE (EG. 0(PTR))
;
DEFINE $FETCH(AC$, FLD$, STR$)<
$$ISOL(FLD$) ;;ISOLATES PARTS OF F$$'FLD$
IFE <T$$SZ-^D18>,< ;;HALF-WORD FIELD
IFE T$$PS,< ;;RH
HRRZ AC$,T$$OF+STR$
T$$SZ==0 ;;INDIC INST GEN
>
IFE <T$$PS-^D18>,< ;;LH
HLRZ AC$,T$$OF+STR$
T$$SZ==0 ;;INDIC INST GEN
>
>
IFE <T$$SZ-^D36>,< ;;FULL-WORD FIELD
MOVE AC$,T$$OF+STR$
T$$SZ==0 ;;INDIC INST GEN
>
IFN T$$SZ,< ;;OTHER CASE
LDB AC$,[<T$$PS>B5 ! <T$$SZ>B11 ! <T$$OF+STR$>]
>
>
; $STORE(AC$, FLD$, STR$) - MOVES AC TO RMS CTL FIELD
;
; ARGUMENTS: AS FOR $FETCH
;
DEFINE $STORE(AC$, FLD$, STR$)<
$$ISOL(FLD$) ;;ISOLATES PARTS OF F$$'FLD$
IFE <T$$SZ-^D18>,< ;;HALF-WORD FIELD
IFE T$$PS,< ;;RH
HRRM AC$,T$$OF+STR$
T$$SZ==0 ;;INDIC INST GEN
>
IFE <T$$PS-^D18>,< ;;LH
HRLM AC$,T$$OF+STR$
T$$SZ==0 ;;INDIC INST GEN
>
>
IFE <T$$SZ-^D36>,< ;;FULL-WORD FIELD
MOVEM AC$,T$$OF+STR$
T$$SZ==0 ;INDIC INST GEN
>
IFN T$$SZ,< ;;OTHER CASE
DPB AC$,[<T$$PS>B5 ! <T$$SZ>B11 ! <T$$OF+STR$>]
>
>
; $$ISOL - TAKE F$$'FLD$ AND ISOL ITS CONSTITUENTS
;
DEFINE $$ISOL(FLD$)<
T$$PS==F$$'FLD$_-^D30 ;;TAKE HIGH-ORD 6 BITS
T$$SZ==<F$$'FLD$_-^D24> & 77 ;;NEXT 6 BITS
T$$OF==F$$'FLD$ & 777777 ;;RH
>
;****************************************************************
;****************** END OF RMSSYM.MPR ***********************
; FILE RMSSYM.MTB FOLLOWS.
;****************************************************************
SUBTTL DEFINITION FILE PROCESSED BY MACRO AND BLISS