Google
 

Trailing-Edge - PDP-10 Archives - BB-JR93N-BB_1990 - 10,7/rms10/rmssrc/rmsmac.mac
There are 11 other files named rmsmac.mac in the archive. Click here to see a list.
UNIVERSAL RMSMAC
SUBTTL	SXB, SSC

;COPYRIGHT (C) 1977,1982,1988 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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 WHICH IS NOT SUPPLIED BY DIGITAL.



;THIS FILE CONTAINS ALL MACRO AND SYMBOL DECLARATIONS COMMON TO THE RMS PRODUCT.

;THE FORMAT OF A SOURCE-CODE MODULE IS AS FOLLOWS
;	TITLE MODULE-NAME
;	SEARCH RMSMAC
;	$PROLOG [COMPONENT]		(EG. $PROLOG (FDL))
;	MODULE-WIDE DECLARATIONS
;	$PROC ... $ENDPROC
;	[MORE PROCEDURES]
;	[MODULE-WIDE UTILITIES]
;	END

; $PROLOG - ESTABLISH COMPONENT IDENTITY
;
DEFINE $PROLOG(PREF$<RMS>)<			;;SEARCHES LOCAL UNV, AND INITS MODULE PARAMS
  SALL					;;SUPPRESS MACRO EXPANSIONS TO AVOID CLUTTERING LISTING
  $ND(TOP$10,0)				;;PRESUME NO TOP$10 DEPS
  $ND(TOP$20,0)				;;DITTO TOP$20
  IFN TOP$10,<SEARCH UUOSYM>		;;DEP, SO GO APPROP SYMBOLS
  IFN TOP$20,<SEARCH MONSYM>		;;DITTO TOP$20
  IFDIF <RMS><PREF$>,<SEARCH PREF$'SYM>	;;IF PART OF A COMPONENT, SEARCH ITS UNIVERSAL FILE
  DEFINE $$CPON(DUM$)<PREF$>		;;MAKE COMPON NAME AVAIL
  DEFINE $CPERR<$'PREF$'ERR>		;; PRESUME THERE IS ERR MACRO
  IFIDN <RMS><PREF$>,<DEFINE $CPERR<>>	;;DONT PUT $RMSERR OUT TWICE
  IFNDEF $'PREF$'ERR,<DEFINE $CPERR<>>	;;DONT REQUIRE COMPON ERR FILE
  $ND(U$GREG,CF)			;;IN CASE THIS COMPON HAS NO ADDIT GREGS OF ITS OWN
;;$ND(H$LOC,SZ%FH)			;;SET HIGH-WATER MARK FOR LOCALS IN PASS 1
  $ND(H$LREG,U$TREG)			;;DITTO FOR LREG'S
;;IF2,<H$LOC==H$LOC+H$LREG-U$TREG>	;;REFLECT ACCUM OF AC SAVE-SLOTS DURING P.1
  H$NEST==0				;;SO FOR $$HW(NEST) WILL WORK
  P$LLEV==0				;;INDICS CURR LEVEL OF LOCALS' SCOPE
  P$RLEV==0				;;INDICS CURR LEVEL OF ROUTINE RECURSION
  P$SCOPE==0				;;CNT OF NUMBER OF TOP-LEVEL SCOPES
  P$LOC==H$LREG-U$TREG+SZ%FH		;;LOCALS START AFTER SAVE-SLOTS FOR LREGS & FH
  P$ARG==0				;;INDIC HAVE SEEN NO PROC-LEVEL ARGS AS YET
  P$SREG==U$TREG			;;ALSO NO PERM REGS HAVE BEEN SAVED AS YET
  P$LREG==U$TREG			;;HIGHEST TREG INDICS NO LREGS AS YET
					;;CF WILL DO AS LOWEST GREG
  P$UTIL==10				;;DRIVES UNIQUE LABEL GENERATION FOR
					;;RETURNS FROM UTILS THAT SAVE REGS
  P$CASE==0				;;FOR CASE MACROS
  P$IF==0				;;FOR UNIQUE (NO)SKIP/JUMP/IFX LABELS
>
SUBTTL	TABLE OF CONTENTS FOR RMSMAC

SUBTTL	RMS REVISION HISTORY

; EACH MODULE ALSO CONTAINS A MORE COMPLETE EXPLANATION OF THE
; NATURE AND REASON FOR EACH INDIVIDUAL EDIT.
; EACH EDIT WHICH IS MADE TO RMS-20 SHOULD BE ASSIGNED
; TWO NUMBERS -- A PRODUCT EDIT NUMBER AND A LOCAL EDIT
; NUMBER. THE PRODUCT EDIT NUMBER IS ASSIGNED FROM THE LIST
; BELOW. THE LOCAL EDIT NUMBER IS ASSIGNED FROM THE ROUTINE
; IN WHICH THE EDIT WAS MADE.
; NOTE THAT PRIOR TO THE RELEASE OF RMS-20 VERSION 2, EACH
; MODULE HAD A NUMBERING SCHEME FOR ITS OWN EDITS WHICH BEGAN
; AT 1 AND WENT UP. THUS, IF A SPECIFIC MODULE
; DOES NOT HAVE A PRODUCT EDIT NUMBER (OR EVEN A COLUMN FOR IT),
; THAT MODULE HAS NOT HAD ANY EDITS SINCE THE RELEASE OF VERSION 2.

REPEAT 0,<

PRODUCT
EDIT	DATE		WHO	MODULE(ROUTINE)		COMMENT
====	====		===	===============		=======

[VERSION 1-A]

[VERSION 2]
1	4-OCT-77	SEB	RMSCNC (DCNTRAB)	CBD NOT SET UP
2	12-OCT-77	SEB	RMSCNC (DCNTRAB)	USE RST, NOT RABISI FIELD
3	18-OCT-77	SEB	EXTEND.REQ		TAKE TRANS TABLE OUT OF REQ FILE
				RMSDTP (-)		ADD TABLE TO RMSDTP AND CHANGE TO RMSTAB
4	22-DEC-77	SEB	RMSTAB			MAKE ^Z,ESC ABORT CHARS
5	5-JAN-78	SEB	RMSFNX(FBYKEY)		ADD ".J" INTO RECORDPTR
6	26-JAN-78	SEB	RMSSDR(DOSIDR)		FIX FREESPACE CHECK
							TO COMPUTE SIDRELEMENT
7	27-JAN-78	EGM	RMSCLS($CLOSE)		USE CORRECT LINK TO NEXT
							RST WHEN DEALLOCATING
10	28-Feb-78	JMT	RMSSYM.BPR		Fix macros with last
				RMSSYM.BPS		symbol prefixed by a ?
				HEADER.REQ		by adding a space before
							the $.

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

PRODUCT	  MODULE	 SPR
 EDIT	NAME & EDIT	 QAR	(WHO, DATE) DESCRIPTION
======	===========	=====	=======================

11	*ALL*			(EGM, 3-APR-78) ADD NEW REVISION HISTORY TO
				ALL MODULES, FLIP HISTORIES THAT RUN FROM
				BOTTOM TO TOP, ADD GLOBAL BINDS TO ALL BLISS
				MODULES, MAKE SURE AUTHOR, EDIT DATE, AND
				COPYRIGHTS APPEAR IN ALL MODULES.
12	RMSSDR(8)	11439	(EGM, 3-APR-78) ALTERNATE KEY ROOT BUCKET
	RMSSPT(22)		IS INCORRECT CAUSING VALID FIND'S/GET'S TO
				FAIL. (RST KEYBUFFER NOT BEING UPDATED AFTER
				A SIDR BUCKET SPLIT.)
13	RMSBUF(5)		(EGM, 5-APR-78) NO SYMPTOM, BUT CODE IS WRONG
				IN PLACES (MISSING FETCH OPERATOR '.').
	RMSMSC(8)		NO FUNCTIONAL PROBLEM, BUT INDEX KEYS CONTAIN
				EXTRA BITS (NOT PART OF THE KEY, IE. BIT 35)
	MACROS(27)		NO SYMPTOM, BUT MACRO CLEAR HAS CODE MISSING
				FETCH OPERATOR.

14	RMSFSM(2)	11723	(EGM, 6-JUL-78) GMEM INCORRECTLY FAILS
				WITH ERROR MSGLINK ONCE CORE BECOMES
				FRAGMENTED.

15	RMSSPT(23)	11982	(EGM, 26-JUL-78) A PUT TO AN INDEXED
				FILE THAT HAS ALTERNATE KEYS WITH
				DUPLICATES CAN DESTROY BUCKET HEADERS
				AND PRODUCE ERROR ER$UDF.

16	RMSFND(11)	11856	(EGM, 27-JUL-78) A GET FROM A SEQUENTIAL
				FILE CAN PRODUCE AN ILLEGAL MEMORY READ
				IF THE LAST RECORD IN THE FILE ENDS IN
				THE LAST WORD OF THE LAST PAGE.

17	RMSOPN(19)	XXXXX	(EGM, 1-AUG-78) THE BYTE COUNT FOR A
				STREAM FILE WILL BE 5 TIMES GREATER THAN
				THE ACTUAL NUMBER OF BYTES IN THE FILE.

20	RMSFND(12)	12112	(EGM, 7-SEP-78) A DELETE OF AN INDEXED RECORD
				CAN FIND THE DELETE FLAG ALREADY SET BECAUSE
				OF RACE PROBLEMS IN THE FIND RECORD FLOW. THE
				PROBLEM OCCURS BETWEEN THE TIME THE RECORD IS
				FOUND AND IT IS LOCKED.

21	RMSOPN(20)	XXXXX	(EGM, 23-MAR-79) **** REFER TO EDIT 17 ****
				STREAM FILES CAN NO LONGER BE OPENED FOR OUTPUT
				ON DEVICE TTY:, SINCE A CHFDB IS BEING DONE ON
				A CREATE.

22	RMSLIB		13341	(SSC,OCT-80) FIX CLEAR MACRO TO HANDLE 1 WD BLKS

23	RMSSPT		13449	(SSC,OCT-80) FIX COMPRESS/SPLIT
				WHEN INSUFFICIENT ROOM COMPRESSED TO AVOID SPLIT

24			14172	SUPERSEDED BY DEVEL WORK TO RMSOPN

25	RMSIDX		14628	(SSC,OCT-80) SET DUPFLAG EVEN THO RRV PAGE INTERVENES

26-40				MISCEL DEVELOPMENT

41	RMSOSM		QAR	FIND FILE ON DSK: WHEN IT SFD

42	CPASCN		QAR	HANDLE ESCAPE AT END OF SELF-ENDING TOKEN (EG. QUOTED STRING)

43	CPASCN		QAR	DONT USE DEFAULT STRING WHEN BAD TOKEN AS OPPOSED TO NULL TOKEN

44	RMSGET/MSC/LIB	QAR	CREATE RSTRPSIDR. TENTATIVE SIDRELEM AFTER $FIND

45	UTLACT		QAR	ELIM AMBIG THAT MADE "CHANGE" THINK PROLOG BLK WAS RRV

46	RMSFIL		COBOL	DONT USE RST WHEN SETTING EOF OF IDX FILE
			GROUP	CONTAINING JUST PROLOG.

47	UTLVFY		QAR	SPURIOUS DUP KEY MSG FOR DELETED DUPS

50	RMSERR		QAR	PREVENT NON-BUG MONITOR ERR FROM DISPLAYING
				INTERNAL ERROR MSG

51	RMSSPT		QAR	RMS INTERNAL ERR CAUSED BY NEWINNEWFLAG SET WHEN
				WHEN NEW REALLY IN OLD (BUG SHOWS ONLY IF SEQ $PUT)
52	RMSOSM		QAR	ALLOW USER TO RECOV FROM "MORE DSK SPACE NEEDED"

************ Release of RMS-36 version 1.0 **************

PRODUCT	  MODULE	 SPR
 EDIT	NAME & EDIT	 QAR	(WHO, DATE) DESCRIPTION
======	===========	=====	=======================


53	RMSOSM		HOT	RMSTACK incorrectly signed as local variable,
				causing RMS to write to sharable page.

54	RMSSPT(24)	20-17022
				(RLUSK, 24-Dec-81) COMPRESS not updating
				DUPLICATES flag in record descriptor after
				compressing bucket.

55	RMSERR(16)	20-16698
				(RLUSK, 30-Dec-81) REMOVRECORD using
                                SDATABKT to search for record which may
                                not be in bucket specified; use POSRFA
                                instead to find bucket and record.

56	RMSASC(8)	SWE (MBROWN)
				(DAW, 12-Jan-81) In an LSA file, a word
				of nulls is allowed before the LSN if the
				LSN would be in a separate TOPS-10 buffer
				than the following TAB. Instead of giving
				error while reading, just skip the word.

57	RMSUPD(6)	20-17231
				(RLUSK, 28-Jan-82) In updating an indexed
                                file when duplicates are not allowed,
                                DOUPDIDX calls FOLLOWPATH, allocating a
                                buffer, and never freeing that buffer.
                                This can eventually cause overflow of the
                                user count in the buffer descriptor and
                                yields a RMSBNA error, "Buffer not
                                allocated".  Cure by releasing the bucket
                                after checking for duplicates.

60	RMSDSP(3)	SWE (MBROWN)
				(DAW, 1-Feb-82) Preserve user's registers
				3 and 4, return STS in register 2.

************ Release of RMS-10 version 1.1 **************
******************** TOPS-10 ONLY **************************

PRODUCT	  MODULE	 SPR
 EDIT	NAME & EDIT	 QAR	(WHO, DATE) DESCRIPTION
======	===========	=====	=======================

100	 RMSCLS		Dev	(RMT, 10/22/85) Make all occurrences
	 RMSCNC			of EXTERNAL and EXTERNAL ROUTINE match
	 RMSDEL			so that RMS will compile.  BLISS V4 does
	 RMSDIS			not accept these as interchangeable.
	 RMSDSI			Also, rewrite macro linkage routines in 
	 RMSERR			RMSLIB to work with BLISS V4.
	 RMSFIL
 	 RMSFLS
 	 RMSFND RMSFNX RMSFRE RMSFSM 
	 RMSGET RMSIDX RMSIO  RMSIXM
 	 RMSLIB RMSMSC RMSOPN RMSPUT
 	 RMSQUE RMSSDR RMSSPT RMSTRN
	 RMSUDM RMSUDR RMSUPD UTLIO
 	 UTLMSC UTLVFY

101	 All		Dev	(SG, 12/2/85) Update Copyrights.

102	 RMSINI		Dev	(RMT, 12/2/85) Take out hard-coded checks
	 RMSFSM			for RMS$$G at 643000 in the free storage 
	 RMS1S1.LNK		manager.  Move RMS$$G up to accommodate
				more symbols from BLISS V4 code.

103	 RMSPUT		Dev	(RMT, 12/2/85) Make sure RMS only does 
				deferred writing when asked to do so.

104	 RMSDSP		Dev	(RMT, 12/2/85) Do not use AC17 as BLT 
				pointer. PSI interrupts can trash the
				stack pointer.

105	 RMSDSP		Dev	(RMT, 12/2/85) Don't overwrite program's
				version number in JOBDAT.

106	 RMSOPN		Dev	(RMT, 12/2/85) Don't clobber other bits in 
				the RIB status word when setting RP$RMS.

107	 RMSOSB		10-32354
				(RMT, 12/2/85) TOPS-10 code in PAGOUT
				incorrectly calculates size of block for 
				output, giving positive value in left half
				of IOWD.  This gives an address check and
				illegal address in UUO message. V3 Edit 64.

110	UTLCMD		Dev	(RMT, 1/23/86) Search CMDPAR before $PROLOG.
	UTLTOP
	RMSDSP

111	UTLVFY		Dev	(WXD, 3/26/86) Incorporate RMS development
				edit 454 to fix VERIFY problem with scanning
				empty buckets.

112	RMSOSB		Dev	(WXD, 3/28/86) When paging in a file, clear
				all pages rather than just a single page.

113	UTLVFY		Dev	(WXD, 3/31/86) Fix bug in UNCLUTTER that writes
				an RFA over a secondary index id.

114	RMSOPN		Dev	(WXD, 4/2/86) RIBSTS revisited.

115	RMSMAC		Dev	(WXD, 4/2/86) .NODDT any OPDEF'd symbols.

116	RMSVER		Dev	(WXD, 4/2/86) Create new module to set version
				number of RMS.EXE and RMSCOB.EXE.

117	RMSSPT		10-35371 (asp, 10/7/86) Edit 54 (in COMPRESS) does
				 not correctly check for duplicates as was
				 intended.  Apply RL fix M460 12-Mar-84.

120	RMSOPN		10-35646 (asp, 12/6/86) In routine OFILE fix RENAME
				block length and .FILOP argblk size.

121	RMSOPN		10-35025 (asp, 4/13/87) In routine OFILE release
				channel if open fails.

122	RMSOPN		10-35723 (asp, 8/12/87) In routine OFILE (again).
				Do lookup before open to avoid wipe of
				ABU (Always Backup) bit.

123	RMSOTS			(asp, 1/28/88) Remove SEARCH of MONSYM,MACSYM.
				Change build file from RMS10B to RMS10. Embed
				.LNK files and use MAKLIB

124	UTLVFY		10-35306 (SMW, 9/29/88) UNCLUTTER/VERIFY bombs:
	RMSUDR		10-35629 CHKDUP in RMSUDR returned ER$DUP for NO DUPS
	RMSUPD			 keys when called by SIDRSCAN in UTLVFY.  This
				 caused massive confusion which was compounded
				 by edit 113 which apparently was put in to fix
				 this problem.  While tracking this
				 down, found missing argument to movewords in
				 RMSUPD, missing dot in UTLVFY, edit 442 to
				 CHKDUP from RMS-20 was not applied, and CHKDUP
				 was looking at a wrong bit.  Also, fixed some
				 code under DBUG switch.
				 Goes with RMS-20 edit 671.

125	RMSSPT		10-36171 (SMW, 11/12/88) In COMPRESS, check first for
				 end of bucket (page) so the check for RRV
				 flag doesn't try to touch a possibly
				 non existent page.
				 Goes with RMS-20 edit 673.

 126	UTLENV		20-20998A (SMW, 1/11/89) RMSUTL was not checking for
	UTLTOP			 DEFINEing a bucket size greater than 7.  Since
	UTLSYM			 the buffer descriptor only has a 3 bit field
	RMSOPN			 for bucket size and uses a bucket size of zero
				 as a flag for unused buffer, this caused
				 PUTBUF errors when the file was used if a
				 multiple of 8 was given as the bucket size.
				 $CREATE was not checking the bucket size for
				 the default area.  Make it do so.  For better
				 errors, also check while parsing the DEFINE
				 command.
				 Goes with RMS-20 edit 674.

	***** END OF REVISION HISTORY *****
>;END OF REPEAT 0

SUBTTL	DATA DECLARATIVE MACROS (FOR ALLOCATING & INITIALIZING MEMORY)

;$ARRAY - ALLOCATE A TABLE THAT WILL BE ADDRESSED BY SUBSCRIPT (IE. INDEX REGISTER)
DEFINE $ARRAY(NAME$,LOWER$,UPPER$,VAL$<0>)< ;;THE ARRAY NAME AND BOUNDS
  NAME$==.-LOWER$			;;"ALIGN" REF TO 1ST ELEM OF ARRAY
  T$ST==.				;;FOR TEST BELOW OF HOW MANY WORDS ALLOC
  T$SIZ==UPPER$-LOWER$+1		;;AMT OF STORAGE TO ALLOC

  XLIST
  REPEAT T$SIZ,<			;;GIVE THE ELEMS OF ARRAY INIT VALS
    IRP VAL$,<				;;GEN IT WORD BY WORD
      IFL .-T$ST-T$SIZ,<VAL$>		;;DO IT UNTIL ARRAY SPACE EXHAUSTED
    >
  >
  LIST
>

; $DATA - ALLOCATE A DATA BLOCK FROM STORAGE
;
DEFINE $DATA(NAME$,SIZ$<1>,VAL$<0>)<	;;ALLOC SIZ$ WORDS AT CURR LOC AND LABEL THEM WITH NAME$
  NAME$: VAL$				;;OFF OF .PSECT IMPURE
  T$=.-NAME$				;;SEE WHAT HAS BEEN USED UP
  XLIST
  REPEAT SIZ$-T$,<0>			;;ALLOC THE RESIDUE IF ANY
  LIST
>

; $GDATA - ALLOCATE A GLOBAL DATA STORAGE BLOCK
;
DEFINE $GDATA(NAME$,SIZ$<1>,VAL$<0>)<	;;ALLOC SIZ$ WORDS AT CURR LOC AND LABEL THEM WITH NAME$
  NAME$:: VAL$				;;OFF OF .PSECT IMPURE
  T$=.-NAME$				;;SEE WHAT HAS BEEN USED UP
  XLIST
  REPEAT SIZ$-T$,<0>			;;ALLOC THE RESIDUE IF ANY
  LIST
>

; $IMPURE - CONTINUE GENERATION OF IMPURE PSECT
;
;DEFINE $IMPURE<.PSECT IMPURE,100000>
DEFINE $IMPURE<			;;DO THIS WAY BECAUSE OF MACRO-53 RESTRICTIONS
  P$IMPURE==1				;;TELL $PURE
  TWOSEG U$PURE				;;MAKE PLENTY OF ROOM
  RELOC 0				;;START THE IMPURE "SEGMENT"
>

; $INIT - INITIALIZE A $BLOCK OF STORAGE
;
; (EXAMPLE)	$INIT(LT,L1)		;;A LOGICAL TERMINAL, L1 OPTIONAL BY THE WAY
;		 $SET(LT.TYPE,SYM%LT)	;;OR SETN, WHICH WOULD SET L1.TYPE==.
;		$ENDINIT		;;THE OTHER FIELDS ARE SET TO 0
;
DEFINE $INIT(STRUC$,OCC$,XOFFS$<0>)<	;;INITIALIZE AN OCCURRENCE OF A DATA STRUCTURE
  DEFINE $$XOFF<XOFFS$>			;;FOR DURING $SETS TO STRUCTS THAT DONT ST AT 0
  IFNB <OCC$>,<OCC$:>			;;OCC$ LABELS THE OCC OF THE STRUCTURE
  DEFINE $$OCC(X$)<OCC$'X$>		;;IN CASE THE CODER WISHES TO NAME INDIV FIELDS
  T$==0					;;INITIALIZE THE MACROS
  P$SIZE==SZ%'STRUC$			;;NEEDED BY $ENDINIT
  REPEAT SZ%'STRUC$,<
    %PURGE(V$$,\T$)			;;PLAY SAFE, KEEP SYMBOL TABLE CLEAN
    %ID(V$$,\T$)==0			;;UNSPEC FIELDS WILL BE SET TO ZERO
    T$==T$+1				;;INIT THE MACRO FOR NEXT WORD
  >
>

; $ENDINIT - GENERATE THE CONTENTS OF THE STORAGE $BLOCK
;
DEFINE $ENDINIT<			;;ACTUALLY GENERATE THE OCC OF THE DATA STRUCT
  T$EI==0				;;INIT FOR LOOP
  T$ADDR==.				;;CALC HOW MANY WORDS ACTUALLY USED
  REPEAT P$SIZE,<
    IFG P$SIZE-T$EI,<			;;THIS MACRO WILL EXPAND TO THE INITIAL DATA
      %ID(V$$,\T$EI)			;;IF V%ID IS A MACRO, IT MAY ALLOOC MORE THAN 1 WORD
      T$EI==.-T$ADDR			;;INCR BY HOW MUCH ALLOC
    >
  >
>


; $MSET - MASK VERSION OF $SET
;
DEFINE $MSET(WORD$,MASK$,VAL$)<		;;SET PARTIC FIELD IN WORD$ TO VAL$ USING MASK$
  T$1==WORD$				;;IN CASE ITS AN EXPRESSION
  T$==%ID(V$$,\T$1)			;;SAVE CURR VAL FOR MERGING WITH NEW 1
  T$2==$MSETI(MASK$,VAL$)		;;GET EXISTING VAL OF THIS WORD
  %ID(V$$,\T$1)==T$!T$2			;;DO THE MERGE
>

; $PTS - ALLOCATE A BYTE PTR TO SPECIFIED STRING
;
DEFINE $PTS(STR$)<<POINT 7,[ASCIZ\STR$\]>> ;;ENCL IN ANGLE-BRACKETS SO 1 VAL

; $PURE - CONTINUE GENERATION OF PURE PSECT
;
;DEFINE $PURE<.PSECT PURE,140>
DEFINE $PURE<				;;DO THIS WAY FOR NOW
  IFNDEF P$IMPUR,<TWOSEG U$PURE>	;;INDIC A PURE SEGMENT
  RELOC U$PURE				;;AND START IT UP
>

; $SET - SET A VALUE INTO A FIELD WITHIN A STRUCTURE
;
DEFINE $SET(NAM$,VAL$)<			;;GIVE THE FIELD NAM$ THE VALUE VAL$
  $$SETUP(NAM$-<$$XOFF>)		;;GET LOCATION DATA ON THE FIELD, ADJUSTING FOR NON-0 ST PT
  IFE T$BITS,<			;;INDICS A BYTES FIELD
    %PURGE(V$$,\T$ADDR)			;;PLAY SAFE, KEEP SYMBOL TABLE CLEAN
    %MACRO(V$$,\T$ADDR)<VAL$>		;;CONSTRUCT A MACRO FOR USE AT $ENDINIT
  >
  IFN T$BITS,<			;;A NORMAL FIXED LENGTH FIELD
    T$==%ID(V$$,\T$ADDR)		;;CREATE A TEMP TO MAKE THINGS MORE READABLE
    %ID(V$$,\T$ADDR)==T$!<VAL$>B<^D35-T$POS> ;;ENCODE THE VALUE IN A MACRO
  >					;;SUCH THAT EACH VALUE IS OR-ED IN V%ID
>

; $SETN - SET A VAL IN A STRUCT & DEFINE A SYMBOL TO DIRECTLY REF IT
;
DEFINE $SETN(NAM$,VAL$,DIR$)<		;;SAME AS $SET EXCEPT THAT THIS OCC OF FIELD WILL BE NAMED
  $SET(NAM$,VAL$)			;;DO THE REAL WORK
  IFNB <DIR$>,<DIR$==.+T$ADDR>		;;CREATE THE DIRECT REF SYMBOL
  IFB <DIR$>,<				;;CONSTRUCT STRUCT.SUF FROM $INIT ARG & NAM$
    DEFINE $$SUF<>			;;INIT THE SUFFIX MACRO
    T$==0				;;WILL BE SET TO 1 WHEN DOT SEEN
    IRPC NAM$,<				;;FIND THE . VIA NITTY GRITTY
      IFIDN <.><NAM$>,<T$==1>		;;DENOTE THAT A DOT HAS BEEN FOUND
      IFN T$,<				;;HAVE PASSED DOT
	DEFINE $$T<$$SUF>		;;CREATE A TEMP MACRO SO $$SUF NOT RECURS
	DEFINE $$SUF<$$T'NAM$>		;;BUILD IT UP CHAR BY CHAR
      >
    >					;;END IRPC
    $$OCC($$SUF)==.+T$ADDR		;;CREATE SYMBOL BY DEFAULT FOR THIS FIELD
  >
>
SUBTTL	DATA DECLARATIVE MACROS (FOR REGISTERS AND VALUES)

; $BPPOS - # OF BITS TO RIGHT OF RMOST BIT IN NAM$
;
DEFINE $BPPOS(NAM$)<<NAM$>_-^D30>

; $GREG - DEFINE GLOBAL PRESERVED AC
;
DEFINE $GREG(NAME$,NUM$)<		;;DECLARES A GLOBAL PRESERVED AC... DEFINED THRUOUT COMPONENT
  IFNDEF U$GREG,<U$GREG==NUM$>		;;ANY GREG'S SHOULD GO IN A COMPONENT'S UNV FILE
  NAME$==NUM$				;;ASSIGN THE NAME TO A PARTIC REG
  $$RINRANGE(NAME$,6,14)		;;BEING ASSIGNED A VALID VALUE?
  IFL NUM$-U$GREG,<U$GREG==NUM$>	;;SO CAN VERIFY THAT GREGS WONT OVERLAP LREGS
>

; $LEN - COMPUTE LENGTH OF STRING
;
DEFINE $LEN(STR$,NAME$<P$LEN>)<		;;DETERM NUM OF CHARS IN STRING
  NAME$==0				;;START WITH NONE OBV
  IRPC STR$,<NAME$==NAME$+1>		;;COUNT THEM 1 BY 1
>

; $LREG - DEFINE A LOCAL-REGISTER SYMBOL
;
DEFINE $LREG(NAME$)<			;;ASSIGN NEXT LREG IN SEQ
  P$LREG==P$LREG+1			;;INCR CURR HIGH LREG
  IFGE P$LREG-U$GREG,<PRINTX ?GREGS OVERLAP LREGS>
  NAME$==P$LREG				;;DONE
>

; $$MPOS - DETS BIT NUMBER OF 1ST 0 TO RIGHT OF MASK
;
DEFINE $$MPOS(MASK$)<^L<<-1_-<^L<MASK$>>^!<MASK$>>>>

; $MSETI - SAME AS $SETI EXCEPT THAT IT IS DRIVEN BY A MASK RATHER THAN A BP
;
; ??? DEFINE $MSETI(MASK$,VAL$<1>)< <VAL$>B<$$MPOS(MASK$)-1> >
DEFINE $MSETI(MASK$,VAL$<1>)< <<VAL$>_<WHOLE-<$$MPOS(MASK$)>>> >

; $ND - DEFINE A SYMBOL IF IT IS NOT ALREADY DEFINED
;
DEFINE $ND(SYM$,VAL$)<IFNDEF SYM$,<SYM$==VAL$>>

; $OFFS - ISOLATE OFFSET COMPONENT OF FIELD DESCRIPTOR
;
DEFINE $OFFS(NAM$)<RHMASK&NAM$>		;;OFFSET IS JUST 18 BITS

; $POS - POSIT OF NAM$ IN SENSE OF B<NUM>, EG. $POS(FIELD FROM B0 TO B8)=8
;
DEFINE $POS(NAM$)<WHOLE-1-<<NAM$>_-^D30>>	;;LEFTMOST 6 BITS

; $REG - DEFINE A SYMBOLIC NAME FOR A REGISTER
;
DEFINE $REG(NAME$,NUM$)<		;;CREATE A SYMBOLIC NAME FOR A REGISTER (POSSIBLY A SYNONYM)
  NAME$==NUM$
  $$RINRANGE(NAME$,0,17)		;;BEING ASSIGNED A VALID VALUE?
>

; $$RINRANGE - (INTERNAL) CHECK RANGE OF REGISTER SYMBOL
;
DEFINE $$RINRANGE(NAME$,LOW$,HI$)<	;;IS THIS SYMBOL IN RANGE LOW$ TO HI$
  IFL NAME$-LOW$,<PRINTX ?REGISTER NAME$ IS OUT OF RANGE>
  IFG NAME$-HI$,<PRINXT ?REGISTER NAME$ IS OUT OF RANGE>
>


; $SETI - IMMEDIATE $SET: CREATE A PROPERLY ALIGNED FIELD VALUE (NO OUT-OF-BOUNDS CHK MADE)
;
; FOR EXAMPLE: TXNE 1,$SETI(AA.BB) IS THE RIGHT WAY TO ADDRESS A 1-BIT FIELD
;
DEFINE $SETI(NAM$,VAL$<1>)< <VAL$>B<$POS(NAM$)> >

; $SYPRM - CREATE A COMMON SYMBOL FOR 10/20
;
;DEFINE $SYPRM(SYM$,V10$,V20$)<>	;;CREATE A COMMON SYMBOL FOR A FIELD (EG. IPCF) USED ON BOTH 10 AND 20

SUBTTL	DATA DECLARATIVE MACROS (FOR STRUCTURES)

; $ALIGN - DCL A SUBSTRUCTURE WITHIN A $BLOCK
;
DEFINE $ALIGN(NAM$,SIZ$<1>)<		;;NAME THE SUBSTRUCT & STATE ITS SIZE IN WORDS
  $WORD(NAM$,0)				;;ALIGN AT NEXT WORD AND CREATE OFFS FOR STRUCT SYM
  P$ALIGN==SIZ$+NAM$			;;FOR $ENDAL TO CHK
>
DEFINE $ENDAL<				;;TERMINATE A SUBSTRUCTURE
  $WORD(T$ALN,0)			;;ALIGN AGAIN
  IFG P$OFFS-P$ALIGN,<PRINTX ?SUBSTRUCTURE EXCEEDS BOUNDS>
  P$OFFS=P$ALIGN			;;FOR ALIGN SIZ$ LARGER THAN THAT USED
>

; $$BINRANGE - (INTERNAL) MACRO USED TO CHECK RANGE OF FIELD VALUES
;
DEFINE $$BINRANGE(NAM$,BITS$)<		;;USED TO VERIFY ARG TO USER MACRO
  T$BITS==BITS$				;;MAKE IT GEN AVAIL
  IFG BITS$-WHOLE,<PRINTX ?BYTE SIZE OF NAM$ LARGER THAN A WORD>
  IFLE BITS$,<PRINTX ?BYTE SIZE OF NAM$ LE 0>
>

; $BLOCK - INITIALIZE A DATA STRUCTURE DECLARATION
;
DEFINE $BLOCK(NAM$,XOFFS$<0>)<		;;INITS DCL FOR A DATA STRUCTURE
  P$MXOFF==0				;;KEEP TRACK OF LARGEST TEMPLATE
  P$TYPE==0				;;START OF NEW GROUP OF CASES
  P$FXOFF==0				;;PRESUME NO VAR LEN FIELDS WILL FOLLOW
  P$POS==WHOLE				;;ALWAYS WORD ALIGN A NEW BLK
  P$IXOFF==XOFFS$			;;KEEP INIT OFFSET AROUND
  P$OFFS==XOFFS$			;;MAKE 1ST WORD OF STRUCTURE THE (XOFF$)TH
  DEFINE $$MAX(X$)<MX%'NAM$==X$>	;;BASICALLY FOR CASES STATEMENT
  DEFINE $$SIZ(X$)<SZ%'NAM$==X$>	;;MAKE DEFAULT FOR SYM CONTAINING SIZE OF STRUCT, A FUNCT OF ITS NAME
>

; $EOB - TERMINATE DECLARATION OF DATA STRUCTURE
;
DEFINE $EOB(MYSIZ$)<			;;CLEANS UP THE DECLARATION OF THE DATA BLK
  IFN P$FXOFF,<				;;ANY STUFF PAST END OF VAR LEN FIELDS?
    IFN P$OFFS-P$FXOFF,<PRINTX ?NON-VARIABLE FIELD FOLLOWS VARIABLE LENGTH FIELDS>
    P$OFFS=P$FXOFF			;;LET THE SIZE SYMBOL INDIC LEN OF FIXED PART OF BLK
  >
  T$BITS==WHOLE				;;GET PAST LAST ALLOC BYTE TO DET ACTU BLKSIZ
  $$IBP(1)				;;NOW DO IT
  $$MAX(P$OFFS-P$IXOFF-1)		;;PRESERVE THE LARGEST OFFSET USED
  $$SIZ(P$OFFS-P$IXOFF)			;;ALWAYS USE THE DEFAULT SYMBOL FOR SIZE OF BLK
  IFNB <MYSIZ$>,<
    IFN P$MXOFF,<P$OFFS==P$MXOFF>	;;SET TO LARGEST TEMPLATE
    MYSIZ$==P$OFFS-P$IXOFF		;;DONT USE DEFAULT...THE CALL CONTAINS A NAME TO USE
  >
>


; $BYTE - DECLARE A BYTE FIELD AT CURRENT LOCATION IN DATA STRUC.
;
DEFINE $BYTE(NAM$,BITS$)<		;;DCL A BYTE AT THE CURR OFFSET IN THE BLOCK
					;;A BYTE IS DECLARED SUCH THAT THE SYMBOL CANNOT BE USED IN A WORD INSTR...
					;;MACRO WILL GIVE A Q ERROR BECAUSE THE POS/SIZ
					;;OF THE BYTE ARE IN THE SYM'S LEFT HALF
  IFDIF <BITS$><REST>,<T$BITS==BITS$>	;;MAKE THIS VALUE UPDATABLE
  IFIDN <BITS$><REST>,<T$BITS==P$POS>	;;THE "REST" SPECIAL CASE
  $$BINRANGE(NAM$,T$BITS)		;;WAS THE SPECIFIED ARG VALID
  $$IBP(1)				;;POSITION TO THE SPECIFIED BYTE
  $$SETSYM(NAM$)			;;ASSIGN NAM$ THE 36-BIT VALUE THAT WILL BE USED TO REF IT
>

; $BYTES - DECLARE A SERIES OF BYTES IN CURRENT DATA STRUCTURE
;
DEFINE $BYTES(NAM$,BITS$,COUNT$)<	;;DCL A BYTE STRING
					;;A BYTE STRING DIFS FROM A BYTE IN THAT
					;;IT IS REFFED WITH ILDB (AS OPPOSED TO LDB)
					;;IE. NAM$ WILL POS=LEFT RATHER THAN POS=LEFT-BITS$
  IFN P$POS-WHOLE,<P$OFFS=P$OFFS+1>	;;WORD ALIGN ARRAYS FOR NOW
  P$POS==WHOLE				;;IE. LEFT JUSTIFY
  $$BINRANGE(NAM$,BITS$)		;;VERIFY INPUT ARG
  NAM$==P$OFFS				;;SET THE SAME WAY AS FOR $WORD
  IFLE COUNT$,<
    P$OFFS==P$OFFS+1			;;INCL IN FIXED SIZE THE 1ST WORD OF VARLEN FIELD
    P$FXOFF==P$OFFS			;;DENOTE HERE AS WHERE FIXEDNESS STOPS
  >					;;0 = TOTALLY VARIABLE/-N = MAX OF N CHARS
  IFG COUNT$,<
    $$IBP(COUNT$)			;;BUMP IT PAST THE BYTE STRING
    P$POS==0				;;FORCE REST OF LAST WD TO BE UNAVAIL TO OTH FLD
  >
>

; $HALF - DECLARE A HALF-WORD FIELD
;
DEFINE $HALF(NAM$),<
	$BYTE(NAM$,^D18)		;;DEFINE AN 18-BIT FIELD
>

; $$IBP - (INTERNAL) INCREMENT PTR INTO CURRENT DATA STRUC.
;
DEFINE $$IBP(COUNT$)<			;;INCR CONCEP PTR INTO THE CURR DATA BLK
  REPEAT COUNT$,<			;;INCR THE SPEC NUMBER OF TIMES
    P$POS==P$POS-T$BITS			;;MOVE THE POS TO THE RIGHT BY THE BYTE SIZE
    IFL P$POS,<				;;ENTER IFL IF HAVE FALLEN OFF RIGHT END OF WORD
      P$POS==WHOLE-T$BITS		;;RESET TO LEFT END & GET TO RIGHT OF DESIRED BYTE
      P$OFFS==P$OFFS+1			;;AND GO TO NEXT WORD
    >
  >
>

; $LOCALS - DECLARE LOCAL STORAGE FOR A ROUTINE
;
DEFINE $LOCALS<				;;DECLARE VARIABLES THAT WILL BE REFFED OFF THE STACK (USING CF)
  $BLOCK(L,P$LOC)			;;APPEND THESE NEW LOCALS TO END OF STACK (DENOTED BY P$LOC)
					;;LOCAL SYMBOLS SHOULD ALWAYS BE INDEXED BY (CF)
					;;...EXCEPT BEFOR PROC ARGS DECODED -- & THEN BY (P)
>
DEFINE $ENDLOC<				;;BETWEEN $L/$ENDL JUST PUT $BYTE(S) AND $WORDS AS USUAL
  $EOB					;;END STRUCTURE & SET INCR SZ%L
  P$LOC==P$LOC+SZ%L			;;...& P$LOC, THE TOTAL # OF $LOCAL WORDS
>

; $$SETSYM - (INTERNAL) CREATE SYMBOL FOR FIELD
;
DEFINE $$SETSYM(NAM$)<
  NAM$==<P$POS>B5!<T$BITS>B11!P$OFFS	;;CREATE 36-BIT SYMBOL THAT WILL IDENT A FIELD
  $$MAX(P$OFFS)				;;TENTA SET HI OFFSET
>

; $TEMPLATE - DECLARE TEMPLATE OF PORTION OF DATA STRUCTURE
;
DEFINE $TEMPLATE(TYPE$,TCSIZ$)<		;;ENABLES MULTIPLE OVERLAYS OF (THE REMAINDER OF) A DATA BLK
  IFG P$TYPE,<
    $EOB				;;GIVE EACH INDIV TEMPLATE A SIZE
    IFG P$OFFS-P$MXOFF,<P$MXOFF==P$OFFS> ;;KEEP TRACK OF LARGEST TEMPLATE
    P$OFFS==P$TPOFF			;;2ND OR LATER TEMPLATE, JUST RESET FIELD OFFSET
    P$POS==P$TPPOS			;;RESTOR BYTE INFO ALSO
  >
  IFE P$TYPE,<
    P$TPOFF==P$OFFS			;;INIT 1ST TIME
    P$TPPOS==P$POS			;;SAVE BYTE INFO ALSO
  >
  IFNB <TCSIZ$>,<			;;GIVING EACH TEMPLATE A SIZE?
    DEFINE $$MAX(X$)<MX%'TCSIZ$==X$>	;;YES, SETUP MAX SYMBOL
    DEFINE $$SIZ(X$)<SZ%'TCSIZ$==X$>	;;... AND NOW THE #-OF-WORDS SYMBOL
  >
  TYPE$==P$TYPE				;;SET THE USER SYMBOL THAT INDICATES WHICH TEMPLATE APPLIES
  MX%'TYPE$==P$TYPE			;;KEEP TRACK OF LARGEST DEFINED (KLUDGE: TYPE$ SHOULD START WITH 3 DESIRED CHARS)
  P$TYPE==P$TYPE+1			;;PREPARE FOR NEXT $TEMPL
>

; $WORD - DECLARE A WORD FIELD AT CURRENT LOCATION IN DATA STRUC.
;
DEFINE $WORD(NAM$,SIZ$<1>)<		;;DCL 1 OR MORE WORDS IN THE BLOCK
  IFL SIZ$,<PRINTX ?INVALID SIZE FOR NAM$>
  IFN P$POS-WHOLE,<P$OFFS==P$OFFS+1>	;;DONT OVERWRITE PARTIALLY USED WORD
  P$POS==WHOLE				;;NOTE THAT NEXT FIELD WILL START AT WORD BOUNDARY
  $$MAX(P$OFFS)				;;TENTA SET HI OFFSET
  NAM$==P$OFFS				;;PLACE THIS FIELD AT CURR OFFSET
  P$OFFS==P$OFFS+SIZ$			;;UPDATE CURR OFFSET BY NUM WDS IN THIS FIELD
>

SUBTTL	FIELD MANIPULATING MACROS

;NOTE THAT LOAD AND STOR ARE NOOPS IF AC$==FIELD$.
;FIELDS MAY BE ANY SUBSET OF @RELOC+OFFSET(INDEX).
;
;IMMEDIATE VALUES ARE DISTINGUISHED FROM REGISTERS BY THE "I" MACRO:
;$INCR 1,I 2 ADDS 2 TO AC1     $INCR 1,2 ADDS AC2 TO AC1.
;HOWEVER NEGATIVE IMMEDIATE VALUES (OR NEG OFFSETS) MUST BE MASKED BY 777777
;BEFORE THEY CAN BE USED IN THESE MACROS.
;
;LITERALS SHOULD BE PROCESSED BY THE "X" MODIFIER, VIA THE PRECODED MACROS $COPX/LOADX
;OR BY THE COMPOUND OPERATOR <LIT,X> (EG. LOAD 1,<1B17,X>==LOADX 1,1B17).
;
;IMPORTANT NOTE: THE DEFAULT WORK REGISTER FOR ALL FIELD MANIPULATING MACROS IS "AP".
;		 THUS ARGUMENT DECODING THAT USES $COP* (AND THE OTHERS) SHOULD
;		 SPECIFY AN EXPLICIT WORK REGISTER, OTHERWISE AP WILL BE CLOBBERED.
;IMPORTANT NOTE: THE WORK REGISTER SHOULD NOT BE USED IN SUBSEQUENT INSTRUCTIONS
;		 UNLESS IT WAS EXPLICITLY SPECIFIED IN THE FIELD-MANIP MACRO.


; ADR2PG - CONVERTS AN ADDRESS TO A PAGE NUMBER
;
DEFINE ADR2PG(AC$)<LSH AC$,-9>			;DIVIDE BY 512

; $$COPY - (INTERNAL) DO A 1-DIRECTION COPY (IE. EITHER AC TO MEM OR MEM TO AC)
;
DEFINE $$COPY(AC$,FIELD$)<		;;THE EITHER-DIR COPY, DRIVEN BY THE $$INST DONE ALREADY
  $$SETUP(<FIELD$>)			;;GET THE CHARACTERISTICS OF THE FIELD
  %IFI T$CASE,<$$IEXP(MOVEI AC$)>	;;SPECIAL IS IMMEDIATE SOURCE
  %IFWM T$CASE,<$$IEXP($$WH AC$)>	;;THE WHOLE WORD CASE
  %IFAC T$CASE,<IFN AC$-FIELD$,<$$WH AC$,FIELD$>>
					;;BYPASS COPY ONLY IF SOURCE/DEST SAME
  %IFOTH T$CASE,<$$ARB AC$,[FIELD$]>	;;NOT AN ALIGNED HALF WORD EITHER
  %IFRH T$CASE,<$$IEXP($$RH AC$)>
  %IFLH T$CASE,<$$IEXP($$LH AC$)>
>

; $COPC - COPY A CHAR FROM SOURCE TO DESTBP
;
DEFINE $COPC(DEST$,SOURC$,AC$<AP>)<	;;CHAR TO BYTE STRING VIA BP
  LOAD	(AC$,<SOURC$>)			;;MAKE IT ACCESSIBLE
  DC	AC$,DEST$			;;STORE IT AWAY (IDPB)
>

; $COPX/$COPY - COPY DATA FROM SOURCE TO DESTINATION
;
DEFINE $COPX(DEST$,SOURC$,AC$<AP>)<	;;COPY FROM LITERAL TO ANY FIELD
  LOADX	(AC$,<SOURC$>)			;;GET SOURCE INTO REG
  STOR	(AC$,DEST$)			;;PUT IT AWAY
>
DEFINE $COPY(DEST$,SOURC$,AC$<AP>)<	;;COPY FROM ANY FIELD TO ANY OTHER FIELD
  LOAD	(AC$,<SOURC$>)			;;GET SOURCE INTO REG
  STOR	(AC$,DEST$)			;;PUT IT AWAY
>

; FLAGLD - LOADS A SPECIF FLAG FROM A FIELD
;
DEFINE FLAGLD(AC$,FIELD$,FLAG$)<	;;INTO AC$ FROM FIELD$ THE FLAG FLAG$
  T$2==FIELD$				;;GET THE FIELD SPEC
  T$2==T$2 & U$EA			;;ISOL EFFECTIVE ADDR
  T$1==$$MPOS($SETI(FIELD$,FLAG$))	;;GIVES # OF BIT TO RIGHT OF MASK
  T$1==WHOLE-T$1			;;NOW HOW FAR FIELD FROM RIGHT OF WD
  LDB AC$,[EXP <T$1>B5!1B11!T$2]	;;BYTE PTR TO THE SPECIF FLAG
>

; $FLAG* - OPERATIONS TO MANIPULATE FLAGS WITHIN AN ARBIT FIELD
;	$FLAGZ - 0 THE SPEC FLAGS
;	$FLAGO - SET THE SPEC FLAGS TO 1
;	$FLAGC - COMPLEMENT THE SPEC FLAGS
;
DEFINE $FLAGC(FIELD$,FLAG$,AC$<TAP>)<	;;COMPLEM FLAG$ WITHIN FIELD$
  $$FLAG(FIELD$,FLAG$,AC$,XORM)
>
DEFINE $FLAGO(FIELD$,FLAG$,AC$<TAP>)<	;;TURN ON FLAG$ WITHIN FIELD$
  $$FLAG(FIELD$,FLAG$,AC$,IORM)
>
DEFINE $FLAGZ(FIELD$,FLAG$,AC$<TAP>)<	;;ZERO FLAG$
  $$FLAG(FIELD$,FLAG$,AC$,ANDCAM)
>
DEFINE $$FLAG(FIELD$,FLAG$,AC$,INST$)<
  T$GLOB==FIELD$			;;CREATE SIMPLE FLD
  .IF T$GLOB,GLOBAL,<LOADX AC$,FLAG$>	;;ASSUME WHOLE WORD
  .IFN T$GLOB,GLOBAL,<LOADX AC$,$SETI(FIELD$,FLAG$)>
					;;ALIGN AND LOAD FLAGS
  INST$ AC$,EAMASK&FIELD$		;;DO THE DESIRED OPERATION
  PURGE T$GLOB			;;BE CLEAN ABOUT IT
>

; I - DEFINE IMMEDIATE BIT FOR INSTRUCTION (SEE SUBTTL COMMENT)
;
DEFINE I<1B12!>				;;INDICATE THAT FIELD IS IMMED VALUE, USAGE IS I(FIELD) OR I FIELD

; $$IEXP - (INTERNAL) GENERATES AN INSTRUCTION FROM EXPRESSION
;
DEFINE $$IEXP(INST$,EA$<T$ADDR>)<<INST$,>!<EA$>> ;; OR THE PARTS TOGETHER

; $INCR - INCREMENT THE CONTENTS OF A SINGLE FIELD
;
; AC$ SHOULD NOT BE TF.
; ALSO IMMED VALS ARE ASSUMED NEGATIVE IF B18 IS ON, BUT
; THE IMMED VAL MUST BE KNOWN TO BE SMALLER THAN THE VALUE IN FIELD$
;
DEFINE $INCR(FIELD$,INCR$,AC$)<		;;F$=F$+I$, AC$ WILL ALSO CONTAIN THE RESULT (DEFAULT=T1)
					;;IF 2 REGS ARE USED, TF WILL ALWAYS BE 2ND REG
  $$SETUP(FIELD$)			;;DETERM WHICH CASE APPLIES
  T$FC==T$CASE				;;PRESERVE IT
  T$FAD==T$ADDR			;;PRESERVE T$ADDR FOR FIELD$
  IFNB <AC$>,<T$AC==AC$>		;;PUT AC$ IN ACCESSIBLE LOC
  IFB <AC$>,<
    T$AC==AP				;;THE DEFAULT
    %IFAC T$FC,<T$AC==T$ADDR>		;;CHECK SPECIAL CASE THAT DESTINATION IS REG
  >
  $$SETUP(<INCR$>)
  T$IC==T$CASE				;;DITTO
  T$IAD==T$ADDR			;;KEEP ADDR FOR INCREM
  %IFI T$FC,<PRINTX ?DESTINATION OF INCR AN IMMEDIATE VALUE>
  %IFWM T$FC,<				;;FULL WORD DESTINATION
    %IFI T$IC,<				;;IMMEDIATE VALUE FOR INCR
      IFE T$IAD-1,<$$IEXP(AOS T$AC,T$FAD)> ;;ADD 1 IS A SPECIAL CASE
      IFN T$IAD-1,<
	$$IEXP(HRREI T$AC,T$IAD)	;;PREPARE TO ADD IT TO DEST
	$$IEXP(ADDB T$AC,T$FAD)		;;FINISH UP
      >
    >					;;END WORD=WORD+IMMED
    %IFNI T$IC,<			;;WORD=WORD+NOTIMMED
      LOAD(T$AC,INCR$)			;;GET READY TO ADD IT TO DEST
      $$IEXP(ADDB T$AC,T$FAD)		;;FINISH UP
    >
  >					;;END OF DEST IS WORD
  %IFNW T$FC,<				;;DESTINATION IS NOT A WORD
    LOAD T$AC,FIELD$			;;MAKE IT ACCESSIBLE
    %IFI T$IC,<				;;IS 2ND OPR IMMED VAL?
      IFE T$IC&1B18,<$$IEXP(ADDI T$AC,T$IAD)> ;;IF IMMED OPD POSIT, JUST DO ADDI
      IFN T$IC&1B18,<			;;NEGATIVE IMMED OPR
	IFN 17B17&T$IC,<PRINTX ?CANT HANDLE NEGATIVE INDEXED IMMEDIATE OPD IN INCR>
	$$IEXP(MOVEI T$AC,T$IAD(T$AC))	;;MOVEI HANDLES OVFLOW TO B17 CORRECTLY
      >
    >
    %IFWM T$IC,<$$IEXP(ADD T$AC,T$IAD)>	;;DITTO
    %IFAC T$IC,<ADD T$AC,INCR$>		;;IN THIS CIRCUMSTANCE, AC IS SAME AS WORD IN MEM
    %IFBYT T$IC,<
      LOAD TF,INCR$			;;MAKE INCR$ ACCESSIBLE
      ADD T$AC,TF
    >
    STOR T$AC,FIELD$			;;FINISH UP, PUT RESULT IN DEST
  >
>


; $$INST, $$WH, $$ARB, $$RH, $$LH - (INTERNAL) SUPPORT MACROS FOR COPY
;
DEFINE $$INST(WHOLE$,ARB$,RH$,LH$)<	;;THE WAY IN WHICH $$COPY IS PARAMETERIZED
  DEFINE $$WH<WHOLE$ >
  DEFINE $$ARB<ARB$ >
  DEFINE $$RH<RH$ >
  DEFINE $$LH<LH$ >
>

; LOAD - FETCH CONTENTS OF FIELD IN DATA STRUCTURE
;
DEFINE LOAD(AC$,FIELD$,X$)<		;;FIELD$ MUST BE SUBSET OF @RELOC+FIELD(REG)
  IFIDN <X$><X>,<LOADX(AC$,FIELD$)>	;;SOURCE IS A LITERAL
  IFB <X$>,<				;;THE USUAL CASE
    $$INST(MOVE,LDB,HRRZ,HLRZ)		;;ARGS TO GENERIC MACRO
    $$COPY(AC$,<FIELD$>)		;;DO THE WORK
  >
>

; LOADX - MOVE A LITERAL INTO AN AC IN OPTIMAL FASHION
;
DEFINE LOADX(AC$,LIT$)<
  DEFINE %IFNO<IFE .-T$ADDR>		;;SHORTHAND TO FACIL GEN JUST ONCE
  T$==LIT$				;;GET CHARAC IN PLACE CAN CTL
  .IFN T$,ABSOLUTE,<MOVE AC$,[LIT$]>	;;RELOCATABLE LITERAL
  .IF T$,ABSOLUTE,<			;;THE NORMAL CASE
    T$ADDR==.				;;BASIS FOR %IFNO
    T$R==RHMASK&T$			;;DETERM IF HALF-WORD SYMBOL
    T$L==LHMASK&T$			;;CHK OTHER HALF
    IFE T$R,<MOVSI AC$,(T$L)>		;;LEFT-HALF FIELD
    %IFNO,<IFE T$L,<MOVEI AC$,T$R>>	;;RIGHT-HALF FIELD
    %IFNO,<IFE <T$L_-HALF>-777777,<HRROI AC$,T$R>> ;;LEFT SIDE IS A SPEC CASE
    %IFNO,<IFE T$R-777777,<HRLOI AC$,(T$L)>> ;;RIGHT SIDE SPECIAL

    %IFNO,<MOVE AC$,[LIT$]>		;;NOTHING ELSE WORKED, SO JUST USE THIS
  >
>

; $$M2BP - (INTERNAL) CONVERTS MASK TO BYTE PTR, USING THE SYMBOL P$BP
;
DEFINE $$M2BP(MASK$,BASE$)<		;;FROM MLOAD OR MSTOR
  P$OFFS==BASE$				;;FINISH SETUP
;;.IF P$OFFS,LOCAL,<P$OFFS==P$OFFS&U$EA> ;;MAY BE BYTE FLD IF SYM LOCAL
  T$R=$$MPOS(MASK$)			;;HAVE 1+BIT POS OF RIGHT MOST 1 IN MASK
  T$L==^L<MASK$>			;;HAVE BIT POS OF LEFT MOST 1
  T$BITS==T$R-T$L			;;# OF 1'S IN MASK
  P$POS==WHOLE-T$R			;;P$POS = # OF BITS FROM RIGHT END OF WORD
  $$SETSYM(P$BP)			;;DONE
>

; MLOAD - DOES A LOAD FOR A SYMBOL DEFINED WITH A BIT MASK
;	GENERATES INSTRUC AC$,BASE$ WHERE INSTRUC IS FUNCTION OF MASK$
;	AND BASE$ LOCATES THE WORD CONTAINING THE DATA
;
DEFINE MLOAD(AC$,MASK$,BASE$)<		;;BASE AND MASK MUST BE SEPARATE CAUSE MASK MAY BE IN RH
  $$M2BP(MASK$,BASE$)			;;SETS BYTE DATA FOR MONITOR SYMBOL
  LOAD(AC$,P$BP)			;;PUT OUT APPROP INST
>

; MSTOR - DOES A STOR FOR A SYMBOL DEFINED WITH A BIT MASK
;
DEFINE MSTOR(AC$,MASK$,BASE$)<		;;BASE AND MASK MUST BE SEPARATE CAUSE MASK MAY BE IN RH
  $$M2BP(MASK$,BASE$)			;;SETS BYTE DATA FOR MONITOR SYMBOL
  STOR(AC$,P$BP)			;;PUT OUT APPROP INST
>

; PG2ADR - CONVERTS A PAGE NUMBER TO AN ADDRESS
;
DEFINE PG2ADR(AC$)<LSH AC$,9>			;MULT BY 512

; STOR - STORE CONTENTS OF AC INTO FIELD IN DATA STRUCTURE
;
DEFINE STOR(AC$,FIELD$)<
  $$INST(MOVEM,DPB,HRRM,HRLM)		;;ARGS TO GENERIC MACRO
  $$COPY(AC$,FIELD$)			;;DO THE WORK
>

; $PUSH - STACK A SEQUENCE OF ITEMS
;
DEFINE	$PUSH(REG$,LIST$)<
  IRP LIST$,<PUSH REG$,LIST$>
>

; $POP - UNSTACK A SEQUENCE OF ITEMS
;
DEFINE	$POP(REG$,LIST$)<
  IRP LIST$,<POP REG$,LIST$>
>

;$ZERO - CLEAR THE CONTENTS OF A FIELD
;
DEFINE $ZERO(FIELD$,AC$<AP>)<		;;ZERO THIS FIELD AND AC$
  $$SETUP(FIELD$)			;;DETERM IF ODD-SIZE BYTE
  %IFOTH T$CASE,<SETZM AC$>		;;MUST HANDLE OFF-SIZE BYTE THIS WAY
  $$INST(SETZB,DPB,HLLZS,HRRZS)		;;THE ACTUAL ZEROING INSTRUCT
  $$COPY(AC$,FIELD$)			;;DO IT
>

SUBTTL	FLOW OF CONTROL MACROS

; CASES - DISPATCH INTO A BRANCH TABLE
;
; (EXAMPLE)	CASES AC,SYM%MAX
;$CASE(0)	FAILURE PATH USUALLY
;$CASE(SYM%LT)	CASE FOR LOGICAL TERMINALS
;			:
;			:
;		JRST L$CASX
;$CASE(*)	OTHER CASES, ETC.
;$CASF		"ABORT" PROBABLY, $CASF GENERATES ALL THE UNSPEC $CASES
;$CASX		COMMON EXIT CODE
;
DEFINE CASES(AC$,MAX$,INST$<JRST >)<	;;BRANCH TO A DISPATCH VECTOR OFF OF AC$
  P$CASE==P$CASE+1			;;IN CASE MULTIPLE CASE STATS IN PROG,
  P$MAXC==0				;;...OTHERWISE WOULDNT HAVE UNIQUE LABELS
  SKIPL AC$				;;LT 0 ILLEGAL
  CAILE AC$,MAX$			;;GTR THAN MAX ILLEG
  ERRI	(CVO)				;;CASE-VALUE OUT OF RANGE
  INST$ @[				;;DO THE DISPATCH
  REPEAT MAX$+1,<			;;THE LABEL GENERATING LOOP
    L$CASE(P$MAXC)			;;THE DISPATCH, USING LABELS CREATED BY $CASE
    P$MAXC==P$MAXC+1			;;KEEP LABELS UNIQUE
  >
  ](AC$)				;;THE AC GUIDES THE DISPATCH
>

; $CASE - DEFINE THE START OF A CASE
;
DEFINE $CASE(CASE$)<L$CASE(CASE$):>	;;THE LABEL THAT INHERENTLY IDENTIFIES THE CASE

; $CASF - GENERATE ALL THE CASES NOT EXPLICITLY SPECIFIED
;
DEFINE $CASF<				;;ASSUMPTION IS THAT THESE ARE FAILURE CASES
  T$==0					;;START WITH (0)TH CASE
  DEFINE L$$CAS(C$,CN$,L$,LN$)<IFNDEF C$'CN$'L$'LN$> ;BOO
  REPEAT P$MAXC,<			;;GO THRU THEM ALL, GENERATING THE UNDEF 1'S
    L$$CAS(C,\P$CASE,L,\T$),<L$CASE(T$)=.> ;;SET THE UNDEF 1'S TO CURR PC
    T$==T$+1				;;TRY THE NEXT CASE
  >
>

; $CASX - DEFINE A COMMON EXIT FOR A SET OF CASES
;
DEFINE $CASX<L$CASX(0):>		;;GENERATES A UNIQUE LABEL



; $ENDIF - TERMINATE CONDITIONAL CODE SEQUENCE
;
; (EXAMPLE)	TEST INSTRUCTION	;;EG. CAMN
;		[$SKIP INSTRUCTIONS]	;;MUST BE FIRST IF PRESENT
;		[$NOSKIP INSTRUCTIONS]	;;MUST BE 2ND IF BOTH PRESENT
;		$$ENDIF			;;GENS L$IFX (& CLEANS UP)
;
;  OR		JUMP? ANY,L$JUMP/L$IFX	;;JUMP TO TRUE CODE OR END OF IF
;		THE "NO-JUMP" INSTRUCTIONS
;		[EG. END IN JRST L$IFX]	;;IF EXPLIC "JUMP" CODE
;		[$JUMP INSTRUCTIONS]	;;DEFINES L$JUMP
;		$ENDIF			;;DITTO ABOVE
;
DEFINE $ENDIF(N$<0>)<			;;SIGNALS END OF CONDITIONALLY EXECUTED CODE & LEV OF NESTING
  $$LAB(N,\<P$IF+N$>),<L$NOSK(N$):>	;;IF NO NOSKIP L$NOSK=L$IFX
  $$LAB(B,\<P$IF+N$>),<L$JUMP(N$):>	;;IF NO $JUMP, L$JUMP==L$IFX
  L$IFX(N$):				;;IF EXIT LABEL
  P$NEST==N$				;;PUT IN PROPER PLACE
  $$HW(NEST)				;;NESTING TO A HIGHER LEVEL?
  IFE P$NEST,<				;;BACK OUT AT TOP LEVEL
    P$IF==P$IF+H$NEST+1			;;START NEXT GROUP OF LABELS AFTER HIGHEST NEST
    H$NEST==0				;;NOTE STARTING OVER
  >
>


; $$LAB - (INTERNAL) TESTS SWITCH VARIABLES FOR SUPPORT OF $ENDIF
;
DEFINE $$LAB(ROOT$,N$)<IFNDEF P$'ROOT$'N$>

; MACRO - CALL CODE GENERATING MACRO AS A SUBROUTINE
;
DEFINE MACRO(ARG$)<			;; TRIVIAL STUFF SHOULD BE INLINE
  PUSHJ	P,[ARG$				;; MAKE A CALL TO THE MACRO WHICH
	   POPJ	P,]			;; IS EMBEDDED IN A LITERAL
>

; L$CASE, L$CASX - LABELS GENERATED TO SUPPORT $CASE & $CASX
DEFINE L$CASE(CASE$)<%ID(C,\P$CASE,L,\<CASE$>)>
DEFINE L$CASX(X$)<%ID(L.C,\P$CASE)>		;;UNIQUE LABEL THAT MAY BE DEFINED AFTER LAST $CASE PER CASES

; L$NOSK, L$SKIP, L$IFX, L$JUMP - GENERATE LABELS FOR CONDITIONAL CODE
;
DEFINE L$NOSK(N$<0>)<%ID(L.E,\<P$IF+N$>)>	;;UNIQUE LABEL FOR AN ELSE
DEFINE L$IFX(N$<0>)<%ID(L.X,\<P$IF+N$>)>	;;UNIQUE LABEL FOR END OF CONDITIONAL CODE
DEFINE L$SKIP(N$<0>)<%ID(L.T,\<P$IF+N$>)>	;;DITTO SKIP
SYN L$SKIP,L$JUMP				;;BOTH TRUE CASES

; $$NOSK - (INTERNAL) BEGIN ALTERNATE CODE SEQUENCE
;
DEFINE $$NOSK(N$)<			;;USED FOR NON-SKIP PATH
  %ID(P$N,\<P$IF+N$>)==1		;;NOTE ITS USE
  $$LAB(B,\<P$IF+N$>),<
    JRST L$NOSK(N$)			;;IF NO SKIP, CREATE ITS PROLOG
    JRST L$IFX(N$)			;;THE CONSTRUCTED "$SKIP"
  >
  L$NOSK(N$):				;;WHERE THE ELSE CODE STARTS
>
DEFINE $NOSKIP<$$NOSK(0)>		;;TOP-LEVEL BRANCH
DEFINE $NOSK1<$$NOSK(1)>		;;1-LEVEL NESTING
DEFINE $NOSK2<$$NOSK(2)>		;;2ND NESTED BRANCH
DEFINE $NOSK3<$$NOSK(3)>		;;3RD NESTED BRACH
DEFINE $NOSK4<$$NOSK(4)>		;;4TH NESTED BRACH
DEFINE $NOSK5<$$NOSK(5)>		;;5TH NESTED BRACH
DEFINE $NOSK6<$$NOSK(6)>		;;6TH NESTED BRACH
DEFINE $NOSK7<$$NOSK(7)>		;;7TH NESTED BRACH

; $$SK - (INTERNAL) BEGIN PRIMARY CODE SEQUENCE
;
DEFINE $$SK(N$)<			;;USED FOR SKIP PATH
  %ID(P$B,\<P$IF+N$>)==1		;;NOTE ITS USE
  JRST L$NOSK(N$)			;;HOP OVER THE $SKIP CODE
  L$SKIP(N$):				;;LABEL PROB NEVER REFFED
>
DEFINE $SKIP<$$SK(0)>			;;TOP-LEVEL BRANCH
DEFINE $SKIP1<$$SK(1)>			;;1-LEVEL NESTING
DEFINE $SKIP2<$$SK(2)>			;;2ND NESTED BRANCH
DEFINE $SKIP3<$$SK(3)>			;;3RD NESTED BRACH
DEFINE $SKIP4<$$SK(4)>			;;4TH NESTED BRACH
DEFINE $SKIP5<$$SK(5)>			;;5TH NESTED BRACH
DEFINE $SKIP6<$$SK(6)>			;;6TH NESTED BRACH
DEFINE $SKIP7<$$SK(7)>			;;7TH NESTED BRACH

; $$JUMP - BEGIN PRIMARY CODE SEQUENCE
;
DEFINE $$JUMP(N$)<			;;USED FOR JUMP PATH
  %ID(P$B,\<P$IF+N$>)==1		;;NOTE ITS USE
  L$JUMP(N$):				;;PROBABLY USED ONLY IN JUMP INSTRUCTIONS
>
DEFINE $JUMP<$$JUMP(0)>			;;TOP-LEVEL BRANCH
DEFINE $JUMP1<$$JUMP(1)>		;;1-LEVEL NESTING
DEFINE $JUMP2<$$JUMP(2)>		;;2ND NESTED BRANCH
DEFINE $JUMP3<$$JUMP(3)>		;;3RD NESTED BRACH
DEFINE $JUMP4<$$JUMP(4)>		;;4TH NESTED BRACH
DEFINE $JUMP5<$$JUMP(5)>		;;5TH NESTED BRACH
DEFINE $JUMP6<$$JUMP(6)>		;;6TH NESTED BRACH
DEFINE $JUMP7<$$JUMP(7)>		;;7TH NESTED BRACH

; $$TX - (INTERNAL) SUPPORT MACRO FOR TX PSEUDO-INSTRUCTION
;
DEFINE $$TX(TYPE$,AC$,BITS$)<		;;THE TX PSEUDO-INSTRUCTIONS
  T$B==BITS$				;;GET A TEMP
  .IF T$B,ABSOLUTE,<IFE T$B,<PRINTX ?ZERO MASK IN TX MACRO>>
  T$L==RHMASK&T$B			;;PREPARE FOR TESTS
  T$R==LHMASK&T$B			;;DITTO
  IFE T$L,<TL'TYPE$ AC$,(T$B)>		;;LEFT HAND SIDE BITS
  IFE T$R,<TR'TYPE$ AC$,T$B>		;;RIGHT HAND SIDE BITS
  IFN T$L,<IFN T$R,<TD'TYPE$ AC$,[T$B]>> ;;IN BOTH SIDES
>

; $$TXGEN - (INTERNAL) MACRO TO GEN THE ACTUAL TX MACROS
;
DEFINE $$TXGEN(MASK$,TEST$)<		;;GENERATE THE ACTUAL MACROS
  IRP MASK$,<IRP TEST$,<		;;TWO-LEVEL LOOP
    DEFINE TX'MASK$'TEST$(AC$,BITS$)<	;;THE USER-SEEN MACRO
      $$TX(MASK$'TEST$,AC$,BITS$)
    >
  >>					;;END 2-LEVEL LOOP
>
$$TXGEN(<N,O,Z,C>,<,E,N,A>)		;;PUT THEM OUT

SUBTTL	MESSAGE MANAGEMENT MACROS

; DC$MES - GLOBAL SYMBOLS NEEDED BY RMSMES
;
;	DEFINE DCL$GL AS APPROP IN MODULE WHERE GLOBAL STORAGE IS ALLOC
;
DEFINE DC$MES<
  DCL$GL(    OV.CAS,	1)
  DCL$GL(    OV.DSIG,	1)
  DCL$GL(    OV.ACT,	1)
  DCL$GL(    OV.LEFT,	1)
  DCL$GL(    TXT$CC,	1)
>

; $$C - CAUSES MSG OUTPUTTER TO POSITION THE NEXT OUTPUT AT THE SPECIFIED COL
;
;	USAGE IS $$C N   /  FOR EXAMPLE $FMT(ABC,$$C 10,XYZ) WOULD CAUSE
;	ABC       XYZ
;
DEFINE $$C(COL$)<-^D<COL$+CA%IVCOL>>		;;A "CASE" WITH MAGNITUDE GTR CA%IVCOL IS HANDLED AS COLUMN ACTION

; $ERR - CALL TX$TOUT TO DISPLAY A MESSAGE
;
DEFINE $ERR(MSG$,REACT$)<		;;CALL ARGUMENTS AND LABEL
  $CALL TX$TOUT,<MSG$>			;;DO THE CALL
  IFNB <REACT$>,<JRST REACT$>		;;RESUME EXEC AT DESIRED ADDR
>

; $FMT - FMT STAT FOR ENTIRE LINE
;
DEFINE $FMT(MNAME$,FMT$)<		;;SEE $$FMT
  XLIST
  $$FMT(MNAME$,<FMT$>)			;;TRANS PASS ARGS
  IFNDEF $$FTX,<EXP -CA%EXIT>		;;GIVE EXPLIC END WORD
  IFDEF $$FTX,<				;;UNPROC STRING?
    $$FTX					;;YES, PUT IT OUT
    PURGE $$FTX				;;GET RID OF IT
  >
  LIST
>

; $$FMT - BUILDS THE DESCRIPTION OF A WARNING/ERROR/MESSAGE
;
DEFINE $$FMT(MNAME$,FMT$)<		;;THE NAME/LABEL FOR FMT STAT & THE FMT
  IFNB <MNAME$>,<MNAME$::>		;;MAKE IT DIRECTLY REFFABLE
  IRP FMT$,<				;;GET EACH SUB-FIELD FROM FORMAT STAT
    T$CTL==0				;;INDICS IF TEXT OR FORMAT CODE
    IFDEF $$FTX,<			;;UNPROC STRING?
      [$$FTX]				;;YES, PUT IT OUT
      PURGE $$FTX			;;GET RID OF IT
    >
    IRPC FMT$,<
      IFIDN <$><FMT$>,<			;;$$ SPECIAL CASE
	IFL T$CTL,<T$CTL==1>		;;YES, 2ND TIME THRU
	IFE T$CTL,<T$CTL==-1>		;;NO, FORCE 2ND PASS THRU
      >
      IFDIF <$><FMT$>,<T$CTL==0>	;;HANDLE CASE OF $ FOLLOWED BY NOT $
      IFIDN <-><FMT$>,<T$CTL==1>	;;FMT CODE STARTS WITH MINUS SIGN
      IFGE T$CTL,<STOPI>		;;CAN ONLY BE 1ST CHAR
    >
    IFN T$CTL,<FMT$>			;;PUT OUT THE FMT CODE
    IFE T$CTL,<DEFINE $$FTX<ASCIZ\FMT$\>> ;;SAVE TEXT
  >
>

SYN $ERR,$MSG				;;HAVE SYNONYMS TO DOCUMENT WHY THE MSG IS PUT OUT

SYN $ERR,$WARN

; $MCASE - DENOTES START OF CODE TO PROCESS & CREATES THE CASE'S ID
;
DEFINE $MCASE(NAM$)<			;;NAM$ OUGHT TO BE OF FORM CC%---
  NAM$==P$GC+CA%CCA			;;MAKE IT OFFICIAL
  $CASE(P$GC)				;;DEFINE THE LABEL
  P$GC==P$GC+1				;;PREPARE FOR NEXT 1
>

; $MSCOPE - RECEIVES THE PUSHJ FROM MSG OUTPUTTER & DISPATCHES IT APPROPRIATELY
;
DEFINE $MSCOPE(LREGS$)<			;;THIS DISPATCH MAY NOT BE A LITERAL
  P$GC==0				;;DRIVES $MCASE
  $SCOPE (COMPON-SPECIF CASES)		;;CREATE THE CASE-COMMON SCOPE
  $LREG	(CAP)				;;CURR ARG PTR
  IRP LREGS$,<$LREG(LREGS$)>		;;PUT OUT A REG DCL
  $PROC	(C.CASES,<IDXCAS,ARGCAS>)	;;ALL THE NECES INFO
  MOVE T1,@IDXCAS(AP)			;MATER THE INDEX
  MOVE CAP,@ARGCAS(AP)			;MATER THE CURR ARG PTR
  $ENDARG
  CASES T1,MX%CCA-1			;;DO THE DISPATCH (EACH CASE SHOULD END IN "RETURN")
>
DEFINE $ENDMS<				;;END THE $MSCOPE
  $ENDPROC				;;END THE C-S CASES
  $ENDSCOPE				;;...AND THEIR DCL CONTEXT
>

DEFINE NOCR<1B12+>			;;"DATA TYPE" OF MSG IS NO TRAILING CRLF

; $TYPE - TYPE AN ALL-TEXT MSG
;
DEFINE $TYPE(TXT$)<$CALLB TX$TOUT,<[RM$ASZ],[ASCIZ/TXT$/]>>

EXTERN RM$ASZ,TX$TOUT

; $$N - NUMeric field BLANK PADDED TO explic field size, usage anal to $$C
; $$Z - NUMeric field ZERO PADDED TO explic field size, usage anal to $$C
;
DEFINE $$N(NUM$)<-^D<NUM$+CA%IVNUM>>
DEFINE $$Z(NUM$)<-^D<NUM$+CA%ZVNUM>>

$BLOCK	(CA)				;THE FORMAT CODE CASES
MX%CCA==10				;MAX # OF COMPON SPECIFIC CASES
  $WORD	(CA%EXIT)			;AUTO CALLED AT END OF FMT PROCESSING
  $WORD	(CA%ASZ)			;SPECIFY THIS TO OUTPUT AN ASCIZ STRING
  $WORD	(CA%CMA)			;OUTPUT A COMMA
  $WORD	(CA%CRLF)			;OUTPUT A CRLF
  $WORD (CA%DIR)			;OUTPUT A DIRECTORY STRING
  $WORD	(CA%DT)				;DATE & TIME
  $WORD	(CA%DTD)			;DATE ONLY
  $WORD	(CA%DTT)			;TIME ONLY
  $WORD	(CA%FIL)			;FILE NAME IS TO BE OUTPUT
  $WORD	(CA%JSE)			;JSYS ERROR: PUTS OUT ERSTR IF TCS.EC LT 0
  $WORD (CA%MIN)			;OUTPUT A MINUS SIGN
  $WORD	(CA%NUM)			;UNPADDED NUMERIC FIELD
  $WORD	(CA%PNUM)			;PADDED NUMERIC (2 ARGS: # OF CHARS IN FIELD, THE NUMBER)
  $WORD	(CA%OCT)			;OCTAL NUM WITH LEADING 0'S STRIPPED
  $WORD	(CA%NOCR)			;SUPPRESS TERMINATING CRLF
  $WORD	(CA%SIX)			;A SIXBIT WORD
  $WORD	(CA%STP)			;STRING PTR
  $WORD	(CA%TCE)			;TCS ERROR STATUS MSG
  $WORD	(CA%VARY)			;VARYING STRING
  $WORD	(CA%JSM)			;JUST MSG ASSOC WITH JSYS
  $WORD	(CA%R50)			;RADIX50 WORD
  $WORD	(CA%RFA)			;AN RFA: P#/ID#
  $WORD	(CA%FLO)			;SING PREC FLO NUM
  $WORD	(CA%CCA,MX%CCA)			;THESE CASES CAN BE DIF PER COMPONENT
$EOB
CA%IVCOL==^D100				;cases less than -100 are cols
CA%IVNUM==^D300				;cases ltl -300 are padded nums
CA%ZVNUM==^D340				;DITTO -340 & 0 PADDED

SUBTTL	ONCE-ONLY CODE

;THESE MACROS WOULD BE PLACED IN 1 MODULE PER COMPONENT.
;THEY RESPECTIVELY GENERATE THE ENTRY AND EXIT SEQUENCE FOR EXTERNAL ROUTINE CALLS
;
;PRESUMABLY ONE WOULD PLACE THEM IN THE TOP LEVEL MODULE IN A COMPONENT.
;
;ALSO, NOTE THAT THEY ARE DRIVEN BY THE NUMBER OF GREGS, AND THAT CONVERS<ELY
;ANY AND ALL GREGS FOR A COMPONENT MUST BE DEFINED IN ITS SYM FILE.

; $PRENT - COMMON-CODE FOR $PROC ENTRY SEQUENCE
;
DEFINE $PRENT<				;;THIS CODE SHOULD APPEAR ONCE IN A COMPONENT
  T$==U$SYS-1				;;START 1 LOWER THAN LOWEST GREG
  REPEAT U$SYS-U$TREG-1,<		;;JUST COVER THE MODULE REGS
    %ID(EN..,\<T$-U$TREG>)::		;;ENT.N MEANS SAVE N LREGS
    MOVEM T$,T$-U$TREG-1+SZ%FH(P)	;;THE SAVING INST (1ST LREG AT SZ%FH(P))
    T$==T$-1				;;DO DOWNWARDS SO CAN JSP TO RIGHT START PT
  >
  EN..0::				;;LOC THAT SAVES NO REGS
  MOVEM CF,FH.OCF(P)			;;CF ALWAYS GOES HERE
  HRLZM TF,FH.UNW(P)			;;SET ENTRY ADDR & DEFAULT TO NO ERR HANDLER
  JRST	@TF				;;RETURN TO INLINE CODE
  SV0..5::				;;THE TEMP ACS
  EXCH TF,0(P)
  PUSH P,T1
  PUSH P,T2
  PUSH P,T3
  PUSH P,T4
  PUSH P,T5
  PUSH P,TF
  MOVE TF,-6(P)
  POPJ P,
  RS5..0::				;;RESTOR THE TEMPS
  POP P,TF
  POP P,T5
  POP P,T4
  POP P,T3
  POP P,T2
  POP P,T1
  EXCH TF,0(P)
  POPJ P,
>


; $PREXIT - COMMON-CODE FOR $PROC EXIT SEQUENCE
;
DEFINE $PREXIT<				;;INVERSE OF $PRENT
  T$==0					;;INIT FOR LOOP
  XF..10::TDZA TF,TF			;;THE NOLOCALS SPECIAL CASE
  XT..10::SETOM TF			;;DITTO FOR TRUE
  EX..10::POPJ P,			;;DITTO FOR NO CARE
  REPEAT U$SYS-U$TREG,<		;;DO THE RETT/RETF STUFF
    %ID(XF..,\T$)::TDZA TF,TF		;;FALSE: TF=0
    %ID(XT..,\T$)::SETOM TF		;;TRUE: TF=-1
    JRST %ID(EX..,\T$)			;;MERGE WITH "POP" CODE AT RIGHT PT
    T$==T$+1				;;DO NEXT ONE
  >
  T$==U$SYS-1				;;START 1 LOWER THAN LOWEST GREG
  REPEAT U$SYS-U$TREG-1,<		;;JUST COVER THE MODULE REGS
    %ID(EX..,\<T$-U$TREG>)::		;;EX.N MEANS RESTORE N LREGS
    MOVE T$,T$-U$TREG-1+SZ%FH(CF)	;;THE RESTORING INST
    T$==T$-1				;;DO DOWNWARDS SO CAN JRST TO RIGHT START PT
  >
  EX..0::				;;LOC THAT SAVES NO REGS
  MOVE P,CF				;;HOP BACK OVER EVERYTHING
  MOVE CF,FH.OCF(P)			;;ALWAYS AT SAME PLACE ON STACK
  POPJ P,				;;RETURN TO CALLER
>

; $PRLABEL - EXTERNS FOR ALL THE ENTRY/EXIT SYMBOLS
;		(NOT USED EXCEPT ONCE AT END OF RMSMAC)
DEFINE $PRLABEL(HI$)<			;;GEN LABELS FOR 0 THRU HI$
  T$==0					;;START PT
  REPEAT HI$+1,<			;;DO IT
    %ID(EXTERN EN..,\T$)		;;ENTRY
    %ID(EXTERN EX..,\T$)		;;PRIMARY EXIT
    %ID(EXTERN XT..,\T$)		;;TRUE EXIT
    %ID(EXTERN XF..,\T$)		;;FALSE EXIT
    T$==T$+1				;;DO NEXT GROUP
  >
>

; $VERS - UNIFORMLY SETS VERSION NUMBER OF A COMPONENT,
;	  SHOULD BE PLACED IN END STAT OF TOP-LEVEL MODULE IN EACH COMPON.
;
DEFINE $VERS<				;;SET THE COMMON VERSION NUMBER FOR PROG
  VR%CUS==0				;;PROBABLY ALWAYS 0
  VR%VERS==1				;;MAJOR RELEASE CYCLE
  VR%MAINT==1				;;EG. ==1 WOULD IMPLY VERSION 1A
  VR%EDIT==126				;;UPDATED EACH TIME PUBLISHED PATCHED
  BYTE (3)VR%CUS(9)VR%VERS(6)VR%MAINT(18)VR%EDIT
>
SUBTTL	PROCEDURAL CONTROL MACROS

;THE FORMAT OF A PROCEDURE IS AS FOLLOWS
;	$SCOPE (TITLE)
;	COMMENT DESCRIBING IT
;	[$LREGS]
;	[$LOCALS]
;	$PROC
;	THE CODE FOR THIS $PROC
;	[ENCOMPASSED SCOPES, PROCEDURES, & UTILS]
;	$ENDPROC
;	[MORE $PROC ... $ENDPROCS]
;	[ANY $UTIL ... $ENDUTILS]
;	$ENDSCOPE
;
;	[MORE $SCOPE ... $ENDSCOPES]
;A SCOPE MERELY DEFINES A SCOPE OF NAMES.
;A PROC DEFINES AN INDIVIDUAL CALLABLE ROUTINE.
;A UTIL DEFINES AN INTERNAL ROUTINE: IT SHARES THE SCOPES OF ANY $PROCS
;THAT PRECEDE IT. IN PARTICULAR IT MAY BE CALLED BY ANY $PROC (OR $UTIL)
;THAT IS ENCOMPASSED BY ITS IMMEDIATELY ENCOMPASSING SCOPE.


; DEFINE BEGINNING OF BLISS CALLED PROCEDURE
;
DEFINE $BLISS(NAME$,ARGS$)<
  $$DECODE				;;MAKE SURE PREV GUY PROPERLY DONE
  P$ARG==0				;;INIT ARG OFFSET
  IRP ARGS$,<
	ARGS$=P$ARG			;;SET INDEX
	P$ARG==P$ARG+1			;;MOVE TO NEXT ARG
  >
  IRP ARGS$,<ARGS$==RHMASK&<ARGS$-P$ARG>>	;;MAKE ARG SYMBOLICALLY REFFABLE
					;;ARGS$ MUST BE HALF WD SO THAT ARGS$(X)
					;;DOESNT EVAL TO X-1,,ARGS$
  $$PROC(NAME$)				;;DO ALL THE COMMON STUFF
>

; $CALLB - INVOKE A ROUTINE USING BLISS CALLING CONVENTION
;
;	NAME$ = ROUTINE NAME
;	ARGS$ = ARG LIST
;	PUTED$ = NON-0 IF COMPUTED ROUTINE ADDR
;
DEFINE $CALLB(NAME$,ARGS$,PUTED$<0>)<	;;INVERSE OF AN $PROC OR $UTIL
  IFNB <ARGS$>,<			;;BUILD ARG LIST (BY REF OFF OF AP)
    T$ARG==0				;;SETUP FOR LOOP
    IRP ARGS$,<
	T$ARG==T$ARG+1			;;SO CNT WILL BE DEFINED WHEN LITERAL IS PUT OUT
	PUSH P,ARGS$			;;PUSH CURR ARG
    >
  >
  IFE PUTED$,<IF2,<			;;NOT COMPUTED & AFT DEF
    IFNDEF NAME$,<EXTERN NAME$>		;;YES, SO MAKE DEFINED
  >>
  PUSHJ P,NAME$
  IFNB <ARGS$>,<ADJSP P,-T$ARG>		;;UNPUSH THE ARGS
>

; $CALL - INVOKE A SUBROUTINE
;
DEFINE $CALL(NAME$,ARGS$,PUTED$<0>)<	;;INVERSE OF AN $PROC OR $UTIL
  IFE PUTED$,<IF2,<			;;NOT COMPUTED & AFT DEF
    IFNDEF NAME$,<EXTERN NAME$>		;;YES, SO MAKE DEFINED
  >>
  IFNB <ARGS$>,<			;;BUILD ARG LIST (BY REF OFF OF AP)
    T$ARG==0				;;SETUP FOR LOOP
    IRP ARGS$,<T$ARG==T$ARG+1>		;;SO CNT WILL BE DEFINED WHEN LITERAL IS PUT OUT
    T$AP==[-T$ARG,,0			;;THE ARG CNT EVENTUALLY
    IRP ARGS$,<ARGS$>]			;;THE ACTUAL ARG PTRS IN THE LITERAL
    MOVEI AP,T$AP+1			;;PT AT 1ST ARG, NOT ARG CNT
  >
  PUSHJ P,NAME$
>

; $$DECODE - (INTERNAL) CHECK IF ARGS HAVE BEEN DECODED CORRECTLY
;
DEFINE $$DECODE<			;;CHECK IF REQUIRED $ENDARG WAS DONE
  IFG P$ARG,<PRINTX ?"ENDARG" MACRO NOT SPECIFIED FOR ABOVE PROC>
>

; $$DHW - (INTERNAL) INIT A HIGH WATER MARK FOR A CONSTRUCTED SYMBOL
;
DEFINE $$DHW(SC$,LR$)<IFNDEF H$'LR$'S'SC$,<H$'LR$'S'SC$==P$LREG>>

; $ENDARG - MUST BE SPECIFIED AFTER ARGS OF $PROC HAVE BEEN DECODED
;
DEFINE $ENDARG<				;;INDICS ARGS HAVE BEEN DECODED & FINS CONTEXT SETUP
  IFNDEF P$CF,<IFG P$ARG,<		;;NOOP IF NO CONTEXT TO SAVE OR ALREADY DONE IN NO ARGS CASE
    MOVEM P,CF				;;SETUP CURR FRAME PTR
    ADJSP P,P$LOC-1			;;ADJUST THE STACK PTR, -1 CAUSE PUSHJ ADDS 1 AUTO
  >>
  $OKARG				;;INDIC $ENDARG WAS NOT ACCID OMITTED
					;;NOTE, HOWEVER THAT SUPERF $ENDARGS ARE PERMITTED
>


; $ENTRY - CREATES A 2NDARY ENTRY PT TO A $PROC OR $UTIL
;
DEFINE $ENTRY(NAME$,ARGS$)<		;;SAME ARGS AS FOR $PROC AND $UTIL
  IFE P$RLEV,<$PROC(NAME$,<ARGS$>)>	;;MEANS A $PROC CONTEXT
  IFG P$RLEV,<$$UTEN(NAME$,<ARGS$>)>	;;MEANS A $UTIL CONTEXT
>

; $MAIN - DECLARE TOP LEVEL ENTRY POINT IN A COMPONENT
;
DEFINE $MAIN(NAME$,EH$,STACK$)<		;;PUT OUT TOP LEVEL ENTRY SEQ
  XLIST
  P$PROC==P$PROC+1			;;BUMP CNT OF # OF PROCS SEEN THIS SCOPE
  P$LROWN==P$PROC			;;ENCOMPASSED UTILS WILL BUMP THIS PROC'S REG CNT
  $$DHW(\P$SCOPE,\P$LROWN)		;;GIVE INIT VAL TO HW VAL
  P$SREG==P$LREG			;;BY DEF, IT SAVES ALL LREGS
  $$HW(LREG)				;;GET HIGH-WATER MARK FOR LREG IN $PROC TOO
  $PRENT					;;COMMON SAVE SEQ
  $PREXIT					;;COMMON EXIT SEQ
  $ERRV					;;PUT OUT DISPATCH VECTOR
  $ERRT					;;TRAP NAME/TEXT VECTOR
  IFNB <NAME$>,<			;;GEN ENTRY PT TOO?
  NAME$:				;;THE ACTUAL ENTRY POINT
  MOVE P,[STACK$]			;;SETUP STACK PTR
  SETZM FH.OCF(P)			;;INDIC THAT THERE IS NO OLD CF
  P$ARG==1				;;FORCE $ENDARG TO WORK
  $ENDARG				;;ADJUST STACK PTR
  $EH(EH$)				;;SETUP THE TOP-LEVEL ERR-HANDLER
  >
  LIST
>
DEFINE $ENDMAIN(DUMMY$)<		;;DEFINE $ENDMAIN
  $ENDPROC
>

; $NOCF - SUPPRESS USE OF CF FOR SMALL HIGH PERFORMANCE ROUTINES
; NOTE THAT "ABORT" IS INCOMPAT WITH SUPPRESSED CF
;
DEFINE $NOCF<				;;APPLIC ONLY IF LREGS OR LOCALS DONT DEMAND CF
  T$==P$LOC-SZ%FH			;;GET LOCALS INFO, ELIMIN FRAM HDR
  IF2,<T$==T$-<H$LREG-U$TREG>>		;;MAKE IT WELL DEFINED, ELIM PASS DEPENDS
  IFE T$+P$LREG-U$TREG,<P$CF==1>	;;SUPPRESSION OK P$CF DEFINED HERE
>

; $OKARG - ALLOWS MERGES OF ENTRY PTS TO OMIT $ENDARG
;
DEFINE $OKARG<P$ARG==0>			;;MAKES $$DECODE HAPPY

; $$PROC - COMMON STUFF TO DECLARE A PROCEDURE
;
DEFINE $$PROC(NAME$)<
  XLIST
  P$PROC==P$PROC+1			;;BUMP CNT OF # OF PROCS SEEN THIS SCOPE
  P$LROWN==P$PROC			;;ENCOMPASSED UTILS WILL BUMP THIS PROC'S REG CNT
  DEFINE $$DHW(SC$,LR$)<IFNDEF H$'LR$'S'SC$,<H$'LR$'S'SC$==P$LREG>>
  $$DHW(\P$SCOPE,\P$LROWN)		;;GIVE INIT VAL TO HW VAL
  P$SREG==P$LREG			;;BY DEF, IT SAVES ALL LREGS
  $$HW(LREG)				;;GET HIGH-WATER MARK FOR LREG IN $PROC TOO
  ENTRY NAME$				;;SO IT WILL SATISFY A /SEARCH
  NAME$::				;;THE ACTUAL ENTRY POINT
  $$SAVE				;;SETUP THIS GUY'S ENVIR
  LIST
>

; $PROC - DECLARE ENTRY POINT AND ARGS FOR A PROCEDURE
;
DEFINE $PROC(NAME$,ARGS$)<		;;DCLS A ENTRY POINT AND ITS ARG LIST
  $$DECODE				;;MAKE SURE PREV GUY PROPERLY DONE
  P$ARG==0				;;BUILD UP ARG SYMBOLS
  IFNB <ARGS$>,<IRP ARGS$,<
    ARGS$==P$ARG			;;THE ACTU ASSIGNMENT
    P$ARG==P$ARG+1			;;PREPARE FOR NEXT
  >>
  $$PROC(NAME$)				;;DO COMMON STUFF
>
DEFINE $ENDPROC(DUMMY$)<		;;TERMINATE PROC CONTEXT
  P$LROWN==0				;;RESUME TIEING REGS TO TOP-LEVEL UTILS
>

; $$SAVE - (INTERNAL) GENERATE CODE TO SAVE AC'S
;
DEFINE $$SAVE<				;;GENERATE THE INLINE CODE TO SAVE MODULE REGS
  IFNDEF P$CF,<				;;ONLY GO TO COMMON SAVE CODE IF SOMETHING TO SAVE
    P$P==%ID(H$,0,S,\P$SCOPE)		;;PREPARE TO DETERM MAX REG ASSOC TO THIS PROC
    IFG %ID(H$,\P$LROWN,S,\P$SCOPE)-P$P, <P$P==%ID(H$,\P$LROWN,S,\P$SCOPE)>
    P$P==P$P-U$TREG			;;NUM OF REGS IN ITS CONTEXT
    DEFINE L$$RET(LAB$)<%ID(LAB$,\P$P)>	;;SETUP MACRO THAT DRIVES "RETURN" MACROS
    JSP TF,%ID(EN..,\P$P)		;;BOP TO COMMON CODE TO DO IT
    IFE P$ARG,<
      P$ARG==1				;;KLUDGY WAY TO FORCE $ENDARG TO DO ITS THING
      $ENDARG				;;IF NO ARGS, PUT OUT END OF SAVE SEQ NOW
    >					;;IN SAME WAY CODER WOULD DO IT
  >
  IFDEF P$CF,<
    PURGE P$CF				;;MAKE SLATE CLEAN FOR NEXT PROC
    DEFINE L$$RET(LAB$)<LAB$'10>	;;THE NO CF CASE
    $OKARG				;;ENDARG INHER UNNEC IF NO CALLER CONTEXT TO SAVE
  >
>

; $SCOPE - DECLARE BEGINNING OF SCOPE OF FOLLOWING LREGS AND LOCALS
;
DEFINE $SCOPE(PURP$)<			;;DENOTES BEGIN OF SCOPE OF THE LOCALS FOLLOWING AND STATES ITS NATURE
					;;LREGS AND LOCALS IF ANY SHOULD FOLLOW IT
  %SAVE(L,LREG)				;;SAVE STATE OF LREGS IN ENCOMPASSING LEVEL
  %SAVE(L,LOC)				;;DITTO TOTAL LOCALS
					;;...BUT NOTE THAT EXISTING VALS ARE BASIS FOR VALS AT NEW LEVEL
  IFE P$LLEV,<				;;TOP-LEVEL SCOPE?
    P$SCOPE==P$SCOPE+1			;;YES, SO BUMP CNT OF TOP-LEVEL SCOPES
    P$PROC==0				;;PROCS ARE CNTED PER SCOPE
    $$DHW(\P$SCOPE,0)			;;THE HW MARK FOR THE TOP-LEVEL UTILS
  >
  P$LLEV==P$LLEV+1			;;BUMP RECURSION LEVEL
>
DEFINE $ENDSCOPE(DUMMY$)<
  P$LLEV==P$LLEV-1			;;BACK OUT A LEVEL
  %RESTORE(L,LOC)			;;GO BACK TO ENCOMP LEVEL
  %RESTORE(L,LREG)			;;DITTO
  IFG P$SREG-P$LREG,<P$SREG==P$LREG>	;;DONT KEEP VALUE SREG IF INCR BY ENDED SCOPE
>

; TSAVE, TPOP - SAVE/RESTORE THE TEMPORARY AC'S
;
DEFINE TSAVE<PUSHJ P,SV0..5>		;;SAVE THE TEMP REGS
DEFINE TPOP<PUSHJ P,RS5..0>		;;RESTOR THEM

; $UTIL - DECLARE A LOCAL ROUTINE AND ITS ARGS
;
DEFINE $UTIL(NAME$,ARGS$)<		;;DECLARES A LOCAL ENTRY POINT
  P$UTIL==P$UTIL+1			;;INDIC HAVE SEEN ANOTHER
  IFG P$LREG-%ID(H$,\P$LROWN,S,\P$SCOPE), <%ID(H$,\P$LROWN,S,\P$SCOPE)==P$LREG)>
					;;SET MAX LREG FOR ENCOMPASSING PROC
  $$HW(LREG)				;;GET HIGH-WATER MARK FOR LREG
;;$$HW(LOC)				;;CHECK IF NEW HIGH-WATER MARK FOR LOCALS
  P$RNEW==P$LREG-P$SREG			;;MAKE ANY ADDIT REG SCOPE EASY TO PLAY WITH
  IFE P$RNEW,<DEFINE L$$RET(LAB$)<LAB$'10>> ;;JUST JRST TO PRECODED QUICKIE EXIT SEQ
  IFG P$RNEW,<				;;...UNLESS SOMETHING TO RESTORE
    DEFINE L$$RET(LAB$)<%ID(LAB$,\P$UTIL)> ;;GEN REFERENCES AUTO WITH THIS
    %ID(XF..,\P$UTIL):TDZA TF,TF	;;FAILURE PATH
    %ID(XT..,\P$UTIL):SETOM TF		;;SUCCESS PATH
    %ID(EX..,\P$UTIL):			;;THE TF-LESS CASE
    T$==P$LREG				;;POP FROM HIGHEST DOWN
    REPEAT P$RNEW,<				;;NOW GEN THEM
      POP P,T$				;;POP A REG
      T$==T$-1				;;POP NEXT LOWER
    >
  POPJ P,				;;DONT FALL THRU!
  >
  $$UTEN(NAME$,<ARGS$>)			;;DO THE STUFF THAT IS ENTRY SPECIFIC
  %SAVE(R,SREG)				;;SAVE P$SREG WITH RESPECT TO ROUTINE LEVEL
  P$RLEV==P$RLEV+1			;;BUMP THE ROUTINE LEVEL
  P$SREG==P$LREG			;;SO THAT ENCOMPASSED UTIL (IF ANY) WONT SAVE THEM ALSO
>
DEFINE $ENDUTIL(DUMMY$)<		;;RESET THE ROUTINE-LEVEL
  P$RNEW==1				;;GUARD AGAINST RETURN IN CODE AFTER $ENDUTIL (PREV GEN OF POPJ)
  P$RLEV==P$RLEV-1			;;DONE
  %RESTOR(R,SREG)			;;GO BACK THE OLD CONTEXT
>
DEFINE $$UTEN(NAME$,ARGS$)<		;;SAME AS FOR $UTIL, $PROC, $ENTRY
  NAME$:				;;THE ACTUAL ENTRY POINT
  IFG P$RNEW,<				;;ADDIT SCOPE SINCE LAST $PROC OR $UTIL
    T$==P$LREG-P$RNEW+1			;;INIT PUSH
    REPEAT P$RNEW,<			;;SO SAVE THESE REGS EXPLIC
      PUSH P,T$				;;START WITH ONE HIGHER THAN LAST SAVED
      T$==T$+1				;;TRY ANOTHER
    >
  >
  $$DECODE				;;MAKE SURE PREV GUY PROPERLY DONE
  T$ARG==0				;;BUILD UP ARG SYMBOLS
  IFNB <ARGS$>,<IRP ARGS$,<
    ARGS$==T$ARG			;;THE ACTU ASSIGNMENT
    T$ARG==T$ARG+1			;;PREPARE FOR NEXT
  >>
>

SUBTTL	PROCEDURE EXITING MACROS

; ABORT - IGNORES CURRENT CONTEXT AND RETURNS TO CALLER OF EXTERNAL PROC
;
DEFINE ABORT<JRST L$ABORT>		;;USE THE STANDARD LABEL

; A PROCEDURE CAN MAKE ITSELF A TRAP HANDLER THRU THE $EH MACRO
; & DYNAMICALLY INFERIOR PROCEDURES THAT SIGNAL A TRAP WILL RETURN
; DIRECTLY TO IT.
;
; IF THE TRAP IS DEFINED VIA H$GO, THE ERROR WILL "GO TO" THE HANDLER ADDRESS
; IN THE APPROP PROC.
; IF THE TRAP IS DEFINE VIA H$RET, THE ERROR WILL RETF TO THE INST FOLLOWING
; THE $CALL IN THE HANDLER PROC THAT LED TO THE TRAP.H

; ER* - GROUP OF MACROS TO SIGNAL TRAPS
; ERRC - SIGNAL & SET ERR CODE
; ERRI - SIGNAL INTERNAL ERROR, SET ERR CODE, & OPT SAVE A MSG
; ERRU - SIGNAL USER ERROR, SET ERR CODE, & SAVE A MSG
; ARGUMENTS:
;	ERR$ = NAME OF TRAP
;	MSG$ = FMT STATEMENT ARGS TO USE TO GEN CA%TCE MSG
;	TR$ = TRANSFER MECH (USUALLY PUSHJ P,)
;
DEFINE ERC(ERR$,MSG$)<ERRI(ERR$,<MSG$>,ERCAL)> ;;DO JSYS ERCAL
DEFINE ERCU(ERR$,MSG$)<ERRU(ERR$,<MSG$>,ERCAL)> ;;DO JSYS ERCAL
DEFINE $ERRC(ERR$)<EC%'ERR$>		;;HOW REFFED IN TESTS
DEFINE ERRC(ERR$,TR$<CALL>)<		;;JUST SIGNAL A CODE
  TR$ EH.'ERR$				;;DO IT
>
DEFINE ERRI(ERR$,MSG$,TR$<CALL>)<	;;PROCESS A TRAP
  IFB <MSG$>,<TR$ EH.'ERR$>		;;CALL THE SPECIFIED ERR HANDLER
  IFNB <MSG$>,<				;;USER SUPPLIED INFO
    TR$ [				;;CREATE ROOM TO PROC IT
      $CALLB TX$TOUT,<[$$CPON(0)'ERR$],MSG$> ;;USER-SPEC MSG
      JRST EH.'ERR$			;;DO THE PUSHJ
    ]					;;TERM THE PUSHJ
  >
>
DEFINE ERRU(ERR$,MSG$,TR$<CALL>)<	;;PROCESS A TRAP
  TR$ [					;;CREATE ROOM TO PROC IT
  IFB <MSG$>,<$CALLB TX$TOUT,<[$$CPON(0)'ERR$]>> ;PUT OUT MSG
  IFNB <MSG$>,<$CALLB TX$TOUT,<[$$CPON(0)'ERR$],MSG$>> ;;USER-SPEC ARGS
  JRST EH.'ERR$]			;;DO THE PUSHJ
>
DEFINE L$ERRC(ERR$)<[ERRC(ERR$)]>	;;GEN ERRC FROM JUMP
DEFINE L$ERRI(ERR$,MSG$)<[ERRI(ERR$,<MSG$>)]> ;;GEN ERRI FROM JUMP
DEFINE L$ERRU(ERR$,MSG$)<[ERRU(ERR$,<MSG$>)]> ;;GEN ERRU FROM JUMP
DEFINE L$UNW<TRAP.U##>			;;JUST UNWIND, NO ERR CODE
DEFINE UNWIND<PUSHJ P,TRAP.U##>		;;DITTO

; $ERRD - DEFINE SYSERR ERR CODES, SHOULD APPEAR IMMED BEFORE $EHVEC IN UNV FILE
;
DEFINE $ERRD(CP$<RM$>,IV$<0>)<		;;CAUSES DEF OF ERR CODES
  P$TRAP==-1				;;DEFINE CASE
  U$ERR==IV$				;;DEFAULT IV$ IS APPROP FOR MAJ COMPON
  DEFINE H$GO(ERR$,DUM$)<		;;SET EACH SYMBOL
    EXTERN EH.'ERR$,CP$''ERR$		;;MAKE EXTERN DEF AVAIL IF NECES
    U$ERR==U$ERR+1			;;ALLOC NEXT CODE
    $ERRC(ERR$)==U$ERR			;;ASSIGN IT
  >
  SYN H$GO,H$RET			;;PUT SYS ERRS & USER ERRS IN SAME VEC
>
DEFINE $ERRT<				;;VECTOR OF ERR TEXT CODES
  P$TRAP==0				;;TEXT MESSAGES CASE
  DEFINE H$GO(ERR$,FMT$)<
    IFB <FMT$>,<XWD ''ERR$'',RM$'ERR$> ;;DISPATCH ERR FOR TRAP
    IFNB <FMT$>,<XWD ''ERR$'',FMT$>	;;USE REQUESTED FMT
  >
  SYN H$GO,H$RET			;;PUT SYS ERRS & USER ERRS IN SAME VEC
  TXFIRST: $RMSERR			;;PUT OUT ERRS ASSOC WITH RMSLIB
  TX.0:: XWD 'NME',RM$NME##		;;RMSLIB ERRS LT 0, COMPON ERRS GT 0
					;;REFFED BY MSG OUTPUTTER (NO MSG SET UP FOR ERROR)
  DEFINE H$GO(ERR$,FMT$)<
    IFB <FMT$>,<XWD ''ERR$'',$$CPON(0)'ERR$> ;;DISPATCH ERR FOR TRAP
    IFNB <FMT$>,<XWD ''ERR$'',FMT$>	;;USE REQUESTED FMT
  >
  SYN H$GO,H$RET			;;PUT SYS ERRS & USER ERRS IN SAME VEC
  $CPERR
>
DEFINE $ERRV<				;;DISPAT VEC ENTRY
  P$TRAP==1				;;DISP VECTOR CASE
  DEFINE H$GO(ERR$,DUM$)<
    EH.'ERR$::PUSHJ P,TRAP.H-2		;;DISPATCH ERR FOR TRAP
  >
  DEFINE H$RET(ERR$,DUM$)<
    EH.'ERR$::PUSHJ P,TRAP.H-1		;;DISPATCH ERR FOR USER ERR
    EC%==$ERRC(ERR$)			;;CAUSE SYMBOL TO BE AVAIL
  >
  EHFIRST: $RMSERR			;;PUT OUT ERRS ASSOC WITH RMSLIB
  EH.0:: 0				;;RMSLIB ERRS LT 0, COMPON ERRS GT 0
  EH.1:: $CPERR				;;REFFED BY RMSERR
>

; $EH - SETS UP AN ERROR HANDLER FOR ALL CODE DYNAMICALLY ENCOMPASSED BY THIS PROC
;
;	$EH(0) TURNS OFF ERR HANDLER
;
DEFINE $EH(LABEL$,AC$<TAP>)<
  IFNB <LABEL$>,<
    MOVEI AC$,LABEL$			;;PREPARE TO PUT ERR HANDLER START ADDR ON STK
    STOR AC$,FH.EH(CF)			;;DONE
  >
  IFB <LABEL$>,<HLLOS FH.UNW(CF)>	;;HANDLE ONLY ERRU'S AT THIS LEVEL
>

; L$ABORT - LABEL TO RETURN DIRECTLY TO CALLER OF EXTERNAL PROCEDURE
DEFINE L$ABORT<ABORT.>		;;GO DIRECTLY TO PROC EXIT CODE AND DO A RETF

; L$RET, L$RETT, L$RETF, L$RETV - DECLARE RETURN LABELS
;
DEFINE L$RET<L$$RET(EX..)>		;;LABEL OF LOCATION THAT WILL DO PROPER RETURN
DEFINE L$RETT<L$$RET(XT..)>		;;DITTO FOR RETT
DEFINE L$RETF<L$$RET(XF..)>		;;DITTO FOR RETF
DEFINE L$RETV(WITH$)<[			;;SETUP VALUE REG AND RETURN
  $$RVAL(<WITH$>)				;;SETUP THE RETVALS (LEFTMOST=AC1)
  $$RET(EX..)]				;;THE RETURN
>
DEFINE L$RVAT(WITH$)<[			;;AFTER SETTING VREG(S), DO A RETT THIS TIME
  $$RVAL(<WITH$>)				;;SETUP THE RETVALS (LEFTMOST=AC1)
  $$RET(XT..)]
>
DEFINE L$RVAF(WITH$)<[			;;AFTER SETTING VREG(S), DO A RETF THIS TIME
  $$RVAL(<WITH$>)				;;SETUP THE RETVALS (LEFTMOST=AC1)
  $$RET(XF..)]
>
SYN	L$RETV,V$RET
SYN	L$RVAT,V$RETT
SYN	L$RVAF,V$RETF

; RETURN - RETURN FROM ROUTINE WITH VALUE
;
DEFINE RETURN(WITH$)<			;;RESTORES LREGS AND DOES NOT SET TF
  IFB <WITH$>,<$$RET(EX..)>		;;SIMPLE CASE, "EASILY" 1 INSTRUCT
  IFNB <WITH$>,<			;;STORE A VALUE AWAY 1ST
    JRST [$$RVAL(<WITH$>)			;;SETUP THE RETVALS (LEFTMOST=AC1)
    $$RET(EX..)]			;;NOW RESTORE THE CALLER'S ENVIR
  >
>

; RETT - RETURN FROM ROUTINE WITH "TRUE"
;
DEFINE RETT(WITH$)<			;;DITTO AND SETS TF TO TRUE
  IFB <WITH$>,<$$RET(XT..)>		;;SIMPLE CASE, "EASILY" 1 INSTRUCT
  IFNB <WITH$>,<			;;STORE A VALUE AWAY 1ST
    JRST [$$RVAL(<WITH$>)			;;SETUP THE RETVALS (LEFTMOST=AC1)
    $$RET(XT..)]			;;NOW RESTORE THE CALLER'S ENVIR
  >
>

; RETF - RETURN FROM ROUTINE WITH "FALSE" STATUS
;
DEFINE RETF(WITH$)<			;;DITTO AND SETS TF TO FALS
  IFB <WITH$>,<$$RET(XF..)>		;;SIMPLE CASE, "EASILY" 1 INSTRUCT
  IFNB <WITH$>,<			;;STORE A VALUE AWAY 1ST
    JRST [$$RVAL(<WITH$>)			;;SETUP THE RETVALS (LEFTMOST=AC1)
    $$RET(XF..)]			;;NOW RESTORE THE CALLER'S ENVIR
  >
>

; $$RET - (INTERNAL) GENERATE RETURNING INSTRUCTION
;
DEFINE $$RET(LAB$)<			;;LAB$ CTLS SUCC/FAIL/OR PLAIN RETURN
  T$POPJ==0				;;PRESUME DEFAULT
  IFG P$RLEV,<IFE P$RNEW,<IFIDN <LAB$><EX..>,< ;;IF UTIL THEN IF NO REGS SAVED THEN IF PLAIN RET
    T$POPJ==1				;;DO THE OPT
    POPJ P,
  >>>
  IFE T$POPJ,<JRST L$$RET(LAB$)>	;;GENERATE THE RETURNING INSTRUCTION
>

; $$RVAL - (INTERNAL) GEN CODE TO SETUP THE VREGS
;
DEFINE $$RVAL(WITH$)<			;;CAN BE MULTIPLE VALS
  T$VREG==0
  IRP WITH$,<				;;GO THRU EACH ONE
    T$VREG==T$VREG+1			;;NEXT REG
    LOAD T$VREG,WITH$			;;THE SETUP
  >
>

SUBTTL	$$MACROS USED BY MORE THAN 1 SECTION OF MACROS

; $$HW - (INTERNAL) EXTEND A HIGH-WATER MARK IF NECESSARY
;
DEFINE $$HW(SUF$)<IFL H$'SUF$-P$'SUF$,<H$'SUF$==P$'SUF$>>


; $$SETUP - (INTERNAL) DECODE SYMBOL WHICH IDENTIFIES THE FIELD
;
DEFINE $$SETUP(FIELD$)<			;;DECODE THE 36-BIT SYMBOL THAT IDENTIFIES THE FIELD
					;;FORMAT==PPBBIA,,AAAAAA
  T$POS==FIELD$				;;ISOLATE POSITION BITS
  T$POS=T$POS_-^D30
  T$BITS==FIELD$			;;ISOLATE BYTE SIZE
  T$BITS==<T$BITS_-^D24>&77
  T$ADDR==FIELD$			;;ISOLATE EFFECTIVE ADDR
  .IF T$BITS,GLOBAL,<T$BITS==WHOLE>	;;MAP UNRESOLVABLE SYM (IE. EXTERN) TO FULL WORD FIELD
  IFE T$BITS-WHOLE,<			;;A FULL WORD BYTE AS OPPOSED TO $WORD
    T$BITS==0				;;SET TO DEFINED VALUE
    T$POS==0				;;DITTO
  >
  IFE T$BITS,<$$SETW(<FIELD$>)>		;;SPEED COMPILATION, WONT BE SCANNED UNLESS IFE ENTERED
  IFN T$BITS,<$$SETB>			;;LH, RH, OR ODD
  T$ADDR==T$ADDR & U$EA			;;ONLY NOW POTENT MAKE IT INTO POLISH EXPR
>
DEFINE $$SETW(FIELD$)<			;;WORD CASE
    T$CASE==-1				;;TENTATIVELY DENOTE FULL WORD
    T$==FIELD$				;;CHK FOR IMMED VALUE
    IFN T$ & 1B12,<T$CASE==T$ADDR>	;;LET T$CASE GE 0 DENOTE IMMED VALUE
    IFL T$CASE,<			;;CHK IF THE FULL WORD IS A REGISTER
      .IF T$ADDR,ABSOLUTE,<		;;IF RELOCATABLE SYM, OBV NOT REGISTER
	IFGE T$ADDR,<IFLE T$ADDR-17,<T$CASE==-2>>
      >
    >
>
DEFINE $$SETB<			;;BYTE CASE
    T$CASE==-5				;;PRESUME ODD SIZE BYTE
    IFE T$BITS-HALF,<			;;COULD BE LH OR RH, CHK IF ALIGNED
      IFE T$POS,<T$CASE==-4>		;;RIGHT HALF
      IFE T$POS-HALF,<T$CASE==-3>	;;LEFT HALF
    >
>

SUBTTL	CREATE PSEUDO-OPS

;A PSEUDO-OP DIFFERS FROM A $$ MACRO IN THAT IT IS IN EFFECT
;AN EXTENSION TO THE COMPILE-TIME TOOLS OF MACRO
;IE. IT IS ANALOGOUS TO IFN, BLOCK, ETC.

; %ID - (INTERNAL) MAKE BACKSLASH OPER EASY TO USE, EG %ID(\1)==1
;
DEFINE %ID(A$,B$,C$,D$)<A$'B$'C$'D$>	;;FOR BUILDING SYMBOLS INVOLVING \ OPR

; %IFDOT - (INTERNAL) CHECK FOR EXTERNAL SYMBOL NAME
;
DEFINE %IFDOT(NAME$)<			;;IF THIS IS DOTTED SYMBOL, IT MAY BE EXTERNAL
  T$==0
  IRPC NAME$,<IFIDN <.><NAME$>,<	;;CHK FOR THE DOT
    T$==1				;;NOTE THAT A DOT HAS BEEN SEEN
    STOPI				;;TERMINATE CHK LOOP
  >>
  IFN T$>				;;BECAUSE THIS IS PSEUDO-OP, TERMINATE IT THIS WAY

; %IFI - (INTERNAL) CHECK FOR IMMEDIATE VALUE
;
DEFINE %IFI(CASE$)<IFGE CASE$>		;;IS THE FIELD AN IMMEDIATE VALUE

; %IF** - (INTERNAL) MACROS TO CHECK FOR LOCATION OF ARGUMENT
;
DEFINE %IFNI(CASE$)<IFL CASE$>		;;IS THE FIELD ANY KIND OF MEM LOC
DEFINE %IFWM(CASE$)<IFE CASE$+1>		;;IS THE FIELD A WORD IN MEMORY
DEFINE %IFAC(CASE$)<IFE CASE$+2>	;;IS THE FIELD AN AC
DEFINE %IFW(CASE$)<IFG CASE$+2>		;;NOT %IFNW
DEFINE %IFNW(CASE$)<IFLE CASE$+2>	;;IS THE FIELD A BYTE OR AC
DEFINE %IFBYT(CASE$)<IFLE CASE$+3>	;;IS THE FIELD A BYTE (IE. A HALF WORD OR ODD FIELD)
DEFINE %IFLH(CASE$)<IFE CASE$+3>	;;IS THE FIELD THE LH OF A WORD
DEFINE %IFRH(CASE$)<IFE CASE$+4>	;;IS THE FIELD THE RH OF A WORD
DEFINE %IFOTH(CASE$)<IFE CASE$+5>	;;IS THE FIELD AN "ODD" SIZE BYTE

DEFINE %MACRO(NM$,IDX$)<DEFINE NM$'IDX$>;;PSEUDO-OP FOR DEFINING A MACRO NAME ON FLY

DEFINE %PURGE(NM$,IDX$)<PURGE NM$'IDX$>	;;DITTO FOR A PURGE

DEFINE %RESTOR(PDL$,NAM$)<		;;RESTORE A PREV SAVED FIELD
  P$'NAM$==%ID(P,\<P$'PDL$'LEV>,$,NAM$)	;;COPY LEV-DEPENDENT SYM TO CURR VAL
>
DEFINE %SAVE(PDL$,NAM$)<		;;SAVE A FIELD FROM AN ENCOMPASSING LEVEL
  %ID(P,\<P$'PDL$'LEV>,$,NAM$)==P$'NAM$	;;SAVE REG CONTEXT OF ENCOMPASSING ROUTINE
>

	SUBTTL	REGISTER DECLARATIONS

;;;	SYSTEM-WIDE REGISTER DEFINITIONS
$REG	(TF,0)				;SUBPROGRAM TRUE/FALSE RETURN REGISTER
$REG	(T1,1)				;REG 1 THRU 5 ARE TEMP REGISTERS
					; (I.E., NOT SAVED ACROSS CALL)
					;REG 1 IS ALSO THE PRIMARY RETURN-VALUE REGISTER
$REG	(T2,2)				;TEMPORARY REGISTER
$REG	(T3,3)				;TEMPORARY REGISTER
$REG	(T4,4)				;TEMPORARY REGISTER
$REG	(T5,5)				;TEMPORARY REGISTER
$REG	(CF,15)				;CURRENT FRAME PTR, USED TO SUPPORT $LOCALS
$REG	(AP,16)				;ARGUMENT REGISTER
$REG	(TAP,AP)			;FOR USING AP AS TEMP
$REG	(P,17)				;STACK PTR

SUBTTL	MISCELLANEOUS SYMBOLS USED BY ALL COMPONENTS

; OPDEFS
OPDEF CALL  [PUSHJ P,]
OPDEF GOTO  [JRST]
OPDEF JUMPT [JUMPL TF,]			;STANDARD ACCESS MECHS FOR TF
OPDEF JUMPF [JUMPGE TF,]
OPDEF RET   [POPJ P,]
OPDEF SKIPT [SKIPL TF]
OPDEF SKIPF [SKIPGE TF]
OPDEF LC    [ILDB]			;LOAD CHAR
OPDEF DC    [IDPB]			;DEPOSIT CHAR
.NODDT CALL,GOTO,JUMPT,JUMPF,RET,SKIPT,SKIPF,LC,DC

; INVISIBLE SYMBOLS NEEDED WHEN MACROS ARE USED
$PRLABEL(10)				;ALL THE EXTERNS FOR THE ENTRY/EXIT SEQS
EXTERN SV0..5,RS5..0			;LABELS FOR SAVING & RESTORING TEMP ACS
EXTERN ABORT.,TRAP.H			;LABELS TO SUPPORT EXCEPTIONAL ERRS
U$EA=1B12-1				;MASK FOR EFFECTIVE ADDRESS
U$PURE==400000				;FOR NOW, USE TWOSEG & START HERE
U$TREG==T5				;HIGHEST TEMP REG
U$SYS==15				;DRIVES $PRENT/$PREXIT

; TO FACILITATE USE OF RMSMAC
WHOLE==^D36				;BITS IN A WORD
HALF==^D18				;HALF-WORD SIZE
QTR==^D9				;1/4 OF A WORD
ASC==7					;STANDARD BYTE SIZE
AS%BPW==5				;ASCII CHARS/WORD
AS%BYT==7				;BITS/ASCII CHAR
EAMASK==1B12-1				;ALL THE BITS IN AN EFFECTIVE ADDR
RHMASK==777777				;RHMASK&SYMBOL = 18 BIT FIELD
LHMASK==777777,,000000			;LEFT-HALF MASK

; STACK FRAME HEADER
$BLOCK	(FH)				;FRAME HDR
 $WORD	(FH.RET)			;RETURN ADDRESS
 $WORD	(FH.OCF)			;THE OLD CURR-FRAME PTR
 $ALIGN	(FH.UNW)			;INFO NEEDED TO SUPPORT STACK UNWINDING
  $BYTE	(FH.ENT,HALF)			;ADDR PAST THE JSP TO ENTRY CODE
  $BYTE	(FH.EH,HALF)			;ERR-HANDLER: 0=PASS THRU, -1=TREAT AS UNEXCEPTIONAL ERR
					;   IF NOT -1/0 IS TREATED AS ADDR OF ERR HANDLER
 $ENDAL
$EOB

; COMMON WORD FORMATS
$BLOCK	(ARG)				;ARGUMENT WORD IN ARG BLOCK
 $BYTE	(ARG.X,1)			;INSTRUCTION FORMAT OR EXTENDED FORMAT (=0)
 $BYTE	(ARG.UN,8)			;MUST BE ZERO
 $BYTE	(ARG.TYP,4)			;ARG TYPE, MAY CHANGE IN FUTURE
 $BYTE	(ARG.EA,^D23)			;EFFECTIVE ADDR OF ARGUMENT
$EOB

$BLOCK	(BP)				;BYTE PTR
 $BYTE	(BP.POS,6)			;POSITION OF BYTE WITHIN ITS WORD
 $BYTE	(BP.SIZ,6)			;# OF BITS IN IT
 $BYTE	(BP.XTN,1)			;EXTENDED IF ON
 $BYTE	(BP.EA,^D23)			;EFFECTIVE ADDRESS
$EOB

$BLOCK	(INS)				;INSTRUCTION FORMAT
 $BYTE	(INS.OPC,9)			;OP CODE
 $BYTE	(INS.AC,4)			;THE AC FIELD
 $BYTE	(INS.IND,1)			;INDIRECT BIT
 $BYTE	(INS.IX,4)			;INDEX REGISTER
$TEMPLATE(INS.1)
 $BYTE	(INS.MEM,HALF)			;MEMORY LOCATION
$TEMPLATE(INS.2)
 $BYTE	(INS.PAG,9)			;PAGE
 $BYTE	(INS.OFF,9)			;PAGE OFFSET
$EOB

; $RMSERR - REFFED HERE AND IN EACH componERR.MAC VIA $ERRV
;
; $ERRD						;SAYS DEFINE ERROR CODES
; $RMSERR					;DOES IT (SHOULD APPEAP HERE)
;
DEFINE $RMSERR<					;;$ERRD OR $ERRV MUST PRECEDE
  H$RET	(NIF,0)					;;NUMBER IMPROP FORMATTED
  H$RET	(SXD,0)					;;SIZE EXHAUSTED FOR WHOLE NUM PART OF FIELD
  H$RET	(TE1,0)					;;RESERVED
  H$GO	(TE2,0)					;;RESERVED
  H$GO	(TE3,0)					;;RESERVED
  H$GO	(TE4,0)					;;RESERVED
  H$GO	(ARG)					;;BAD ARG TO ROUTINE
  H$GO	(COP)					;;STRING COPY PROBLEM
  H$GO	(CVO)					;;CASE-VALUE OUT-OF-BNDS
  H$GO	(FRE)					;;FORM READ ERROR
  H$GO	(FWE)					;;FORM WRITE ERROR
  H$GO	(FPE)					;;FORM PAGE ERROR
  H$GO	(FRO)					;;FORM ROOT ERROR
  H$GO	(MBO)					;;FREE BLOCKS OVERLAP
  H$GO	(MDI)					;;M.QALC DESC INCONSIS
  H$GO	(MMI)					;;MEM MGR INIT ERROR
  H$GO	(MMX)					;;FREE MEM EXHAUSTED (OR PROB WHILE TRYING TO GET MEM)
  H$GO	(MPX)					;;PRIVATE LIST EXHAUSTED
  H$GO	(MSZ)					;;ILLEGAL SIZE ARG
  H$GO	(OAL)					;;TEXT OUTPUT ARG ERROR
  H$GO	(OOP)					;;TEXT OUTPUT, CANT OPEN FILE
  H$GO	(OST)					;;TEXT OUTPUT STACK ERROR
  H$GO	(OWE)					;;TEXT OUTPUT WRITE ERROR
  H$GO	(TAL)					;;SYMTAB ARG ERR
>

IF1,<T%ERR==0>					;;1ST PASS SETS LENGTH OF VECTOR
$ERRD(RM$,T%ERR)				;;PREPARE TO PUT OUT ERR CODE DEFS
$RMSERR						;;DO IT
T%ERR==-U$ERR-1					;;CAUSES LAST TCSERR TO GET VAL OF -1

END					;OF RMSMAC