Google
 

Trailing-Edge - PDP-10 Archives - BB-JF18A-BM - sources/rms/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) DIGITAL EQUIPMENT CORPORATION 1977, 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.
;



;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

;Datatypes defined
;** Warning: These symbol values may change..
;[455] ** If they do, change the DTP$K_xxx symbols in RMSLIB.R36 as well!
;[455] These are used by RMSUTL and RMSM2
;
DT%SIX==0		;SIXBIT data type
DT%ASC==1		;ASCII data type
DT%EBC==2		;EBCDIC data type
DT%PAC==3		;PACKED decimal datatype	;A411
DT%IN4==4		;INTEGER datatype		;A411
DT%FL1==5		;FLOAT datatype			;A411
DT%FL2==6		;DOUBLE FLOAT datatype		;A411
DT%GFL==7		;GFLOAT datatype		;A411
DT%IN8==^D8		;DOUBLE INTEGER datatype	;A411
DT%AS8==^D9		;8-bit ASCII			;A411
DT%UN4==^D10		;Unsigned Integer		;A411

; $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,MACTEN	;;DEP, SO GO APPROP SYMBOLS	  ;m572
	      .ERMAX==0			;;				  ;a572
	      IFIW==:1B0>		;;				  ;a572
  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.

61	RMSOPN(21)	20-17312
				(RLUSK, 24-Feb-82) Repeated $OPENs on
				a locked file can use up memory,
				because space for an FST is allocated
				and never freed.

62	RMSIDX(14)	20-17341
				(RLUSK, 28-May-82) When doing a search,
				a SIXBIT key "ABC" will be lexicographically
				less than " BC", because a signed
				comparison is done, so the first key appears
				negative and the other positive.  This is
				causing all sorts of havoc.  Use an unsigned
				comparison in SINDEXBKT.

63	UTLUSE(1)	20-17546
				(MBOUCHER, 2-Jun-82) RMSUTL fails with "?RMSOSE
				JSYS 56 Failed" error when executing the RMSUTL
				command "SET INDEX n BUCKET x" when the bucket 
				at page x is the root of index n.

64	RMSOSB(2)	10-32354
				(RLUSK, 4-Jun-82) 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.

65	RMSASC(9)	None
				(RLUSK, 14-Apr-83) Edit 56 does not
				correctly handle a word of nulls
				occurring in a Line-Sequenced ASCII
				file.  It does not allow for a word of
				nulls preceding a pagemark, nor does
				it correctly handle a null word before
				an LSN; rather than bump the pointer
				by one word (as should be expected in
				most cases) it gratuitously reads in a
				new buffer, disposing of up to 3
				blocks of data in a single stroke.
				The routine logic is so flawed, then,
				that it was rewritten.
66	RMSEVC(1)	None
	RMSDSP(4)		(RL, 19-Apr-83) With the release of
				LINK v5.1, the /START switch no longer
				accepts a value whose left half is the
				length of the entry vector and whose
				right half is the address of the entry
				vector.  Definition of an entry vector
				must, therefore, be by a MACRO-written
				REL block.  RMSEVC has been written to
				generate the entry vector entry for
				RMS; the entry vector entry is not
				desired for RMS.REL, for that would
				overwrite the user's start address.

	***** END OF REVISION HISTORY *****
	***** Start Version 2 Development *****

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

300	RMSLIB(300)	XXXXX	(DAW,19-Jan-82) Fixup sources so DBUG=1
	RMSFIL(300)		will compile with no errors.
	RMSOSB(300)
	RMSDSI(300)
	RMSDMP(300)
	RMSFNX(300)

301	*ALL*		XXXXX	Support extended addressing.

302	RMSTAB(300)	XXXXX	Support new DEC standard for stream files:
				ESC and CTRL/Z are no longer break characters.

303	RMSFND(300)	XXXXX	Fix Get for Relative files to advance NRP
				pointer properly.

400	*ALL*		XXXXX	(RL,22-Apr-83) Clean up BLISS code.

401	RMSRSU(401)	XXXXX	(RL,1-May-83) Fix CBD initialization

402	RMSERR(1)	XXXXX	(RL,6-May-83) Stop printing messages to
	RMSOSM(401)		the terminal when an error occurs, especially
	RMSSYM.MTB(1)		the quota exceeded error from OKCREATE.  Add
				a new error code, ER$EXT (RMS$_EXT), File
				extend error; return the JSYS error in the
				STV field.

403	RMSASC,RMSFND,		(AWN,Apr-83) Add RFA $GETs to stream/LSA files,
	RMSOPN,RMSRSU		fix LPT: output, add write-before-advancing,
				write-after-advancing options.

404	RMSCNC(401)		(RL,10-May-83) Add COBOTS SMU support: when
	RMSDSI(401)		SMU is set, do no locking and return number
	RMSFND(1)		of page containing record on relative $FIND.
	RMSOPN(3)

405	RMSFNX			(RL,11-May-83) Fix typo in FBYKEY; extra dot
				in XCOPY macro call.

406	RMSLIB,RMSEXT,RMSREQ	(RL,12-May-83) Remove external declarations
				from RMSLIB, and put them in RMSEXT.R36.
				Change RMSREQ to declare RMSEXT as a library.

407	RMSLIB,RMSUPD,RMSMSC	(RL,24-May-83) Make CKEYUU use global pointers
				when comparing things in the RMS section with
				things in a user section.  Make DOUPDIDX pass
				a global address to CKEYUU if one is not given,
				and make UPDUDR and UPDSQR use an XBLT for
				copying things 	in nonzero sections.  Finally,
				put new macros into RMSLIB to support all
				these good things.

410	RMSERR			(RL,1-Jun-83) REMOVRECORD (in RMSERR) calls
				DELUDR (in RMSUDR) with 3 arguments, when
				DELUDR only takes 2.  Thus, DELUDR never
				quite gets hold of the correct record to
				delete.

411	RMSDSI,RMSERR,RMSLIB,	(AWN,6-Jun-83) Implement non-display keys
	RMSMSC,RMSSYM,RMSTAB,	PAC,IN4,IN8,FL1,FL2,GFL,AS8,UN4
	RMSM2

412	RMSIDX			(RL,20-Jun-83) An error in parameter binding
				in GTNBKT caused a bucket to be locked when
				it was not supposed to be locked.

413	RMSMSC			(RL,23-Jun-83) Because byte-pointers were not
				cleared before their fields were initialized
				(in CKEYUU), the cruft left behind caused
				equal keys to appear unequal, causing problems
				on $UPDATEs.

414	RMSOPN			(RL,24-Jun-83) Missing parentheses in IF
				statement caused section of code to be
				"optimized" out of DOOPEN.

415	RMSSDR			(RL,5-Jul-83) Call to MOVEKEY from PUTSIDR
				did not pass 30-bit address when needed.
				Thus, the user's secondary key was ignored.

416	RMSGET,RMSPUT,RMSUPD	(RL,7-Jul-83) Calls to MOVERECORD from
				GETREC and UPDSQR did not pass 30-bit address
				when it was needed.  PUTREC needed some
				cleanup around the MOVERECORD call.

417	RMSFIL			(RL,8-Jul-83) A PMAP in PAGIN fails because
				the caller, DOKEYBLOCKS, has incorrectly
				set up the global destination page, zB.,
				passing 2,,666 rather than 0,,2666.  Fix
				the page calculation expressions to shift
				the section number down where it belongs.

420	RMSFND			(RL,8-Jul-83) Make user's key buffer address
				global before trying to fetch from it, in
				FINDREL.

421	RMSUPD			(RL,20-Jul-83) Allow changing the record
				size on $UPDATE, when the record is
				variable-length in a relative file, and
				the new length is less than the maximum
				record size.

422	RMSUPD			(RL,25-Jul-83) In DOUPDIDX, when RMS checks
				for duplicates on a key that has changed,
				the MOVEBKTDESC macro is called with a
				fetched value as an argument; it treats
				this dotted name as a regular name, which
				makes a dotted structure reference in the
				macro cause an illegal read.  BIND the
				fetched value to a name, and pass that
				name instead.

423	UTL???			(RL,26-Jul-83) All UTL??? modules cleaned
				up and compiling/assembling normally.
				Module UTLEXT has been created to contain
				all external references.

424	RMSEVC			(AN,20-Sep-83) Move spare copyright to loseg.
				It is only needed for the REL file.

425	RMSLIB			(RL,27-Sep-83) CKEYUU is unwittingly zeroing
				a non-preserved register used by DOUPDIDX.
				CSTRINGLE_EA uses AC12 without explicitly
				naming it (by using a DMOVEM) and BLISS 
				assumes the AC is safe.  Explicitly zero
				AC7 and AC12 when safe to do so.

426	RMSLIB			(RL,28-Sep-83) Make TRACE and RMSENTRY use
    				conditional compilation (under DBUG) to
				avoid checking the debugging flags when not
				needed.

427	RMSDSI			(AN,5-Oct-83) SETKDB should not touch the KSDs
				as they are mapped R/O to the file.

430	UTLACT			(RL, 10-Oct-83) Open sequential and relative
    	UTLCMD			files with RMSUTL; disallow use of FIX, 
	UTLENV			UNCLUTTER and VERIFY commands with sequential
	UTLIO			and relative files; get the file prologue
	UTLMSC			correctly in BK$PROL; undefine some conversion
	UTLTOP			tables which are now in RMSM2.MAC; and fix
	UTLUSE			a memory manager bug.

431	UTLCMD			(RL, 13-Oct-83) Check that file is open
	UTLSYM			for commands which need open file, and
				set up record-to-use clause tables based
				on file organization.

432	UTLCMD			(RL, 19-Oct-83) Make changes to allow
	UTLENV			DEFINE command for relative and sequential
	UTLSYM			files.  Also, fix the initialization code
	UTLUSE			for non-indexed files.

433	UTLCMD			(AN, 31-Oct-83) Add new datatypes to RMSUTL
	UTLACT
	UTLENV
	RMSFLO
	RMSCNV

434	UTLCMD			(RL, 31-Oct-83) Fix seq/rel files in RMSUTL
	UTLACT			(AN installed)
	UTLUSE
	UTLTOP

435	UTLCMD			(1-Nov-83) Fix RMSUTL error messages
	UTLTOP			and report file default

436	UTLCMD			(4-Nov-83) Data-type check off-by-one

437	UTLMSC			(2-Dec-83) Initialize un-inited register
					   flagged by new BLISS compiler.
440	UTLTOP			(2-DEC-83) Fix more RMSUTL error messages.

441	RMSASC,RMSEXT		(8-Dec-83) The MOVST in GETASCII will insert
				nulls into a record if the record has leading
				nulls and crosses a page boundary.

442	RMSUDR			(13-Dec-83) CHKDUP was erroneously marking
				records inserted before a deleted record as
				duplicate records.  This corrupted the index.

443	RMSQUE			(13-Dec-83) FILEQ was not creating separate
				queue request blocks for UPD and DEL access.

444	RMSOPN			(20-Dec-83) Because RMS always opens files
				thawed, it is impossible to type or otherwise
				non-RMS open a file which RMS is only reading.
				Open the file Read-Unrestricted (OF%RDU) if
				RMS is only reading.

445	RMSASC			(20-Dec-83) After an RTB error, the code from
				edit 441 reads to EOF, rather than just to the
				end of record.  Check MOVEFLAG when checking
				buffer space left.

446	RMSINI			(21-Dec-83) Currently, RMSINI maps UDDT.EXE in
				whenever it maps XRMS into a non-zero section.
				Instead, map DDT in only when DDT exists
				in the user's section already.

447	RMSINI			(21-Dec-83) Define RMSSEC (in RMSINI) to be
				a global and allow the user to change it
				to specify that RMS is to be loaded into
				a specific non-zero section, rather than the
				first free section.

450	RMSDSP,RMSGLB		(RL,13-Jan-84) PA1050 keeps trapping RMS's page
				creations.  Turn off the non-existent page
				interrupt channel with a DIC% when entering
				RMS, and restore the original status when
				leaving RMS.  NOTE: Allow the user program
				to disable this feature with the $NOMESSAGE
				JSYS, which does nothing now.

451	RMSGLB,RMSFSM		(RL,18-Jan-84) COBOL SMU requires COBOL to
	RMSINI,RMS2X2.LNK	perform two $CONNECTs on each file, which
				doubles the buffer space used by each file.
				XRMS at 600000 does not have enough free
				memory to allow COBOL to open 8 files, 
				much less the ANSI maximum 16 files.  Ergo,
				make RMS2X2.LNK from RMS2S2.LNK and load
				XRMS.EXE at 400000.  Then, increase the
				page table size in RMSGLB to cover the added
				space.  Finally, remove the crock code in
				RMSFSM which caused RMS to call FUNCT. when
				RMS was loaded below 600000.


452	RMSUSR			(RL,24-Jan-84) Add ELS parameter to $RAB macros.


453	RMSOSB			(RL,24-Jan-84) If SIN or SOUT wins a "Quota
				exceeded" or "Disk full" error, make IOERROR
				return ER$EXT.

454	UTLVFY		Q345004	(RL,30-Jan-84) If a file contains a data
				bucket in which all entries are deleted,
				a VERIFY (with file opened for output) or
				UNCLUTTER of that file will produce an 
				error message warning that "Bucket n points
				at bucket x but succeeding index entry does
				not."  This happens because the final tests
				of bucket consistency are performed against
				the last bucket, if one exists; the last
				bucket, however, is "refetched" using the
				highest key found in the file.  If the 
				previous bucket contained no data, the
				bucket BEFORE that one is fetched, and
				all sorts of evils arise.  Thus, if we find
				a bucket with all entries deleted and 
				expunged, do not leave a previous-bucket
				pointer around for the next bucket to make
				an erroneous consistency check with.

455	RMS2U2.LNK	Q345008	(RL,2-Feb-84) Clean all references to RMSMES
	RMSLIB.R36		out of RMSUTL, and change all calls to TX$TOUT
	RMSM2			and TX$APP to use TX$OUT and TX$RPT in RMSM2.
	RMSMAC			Change UTLxxx modules to determine key type
	UTLACT			and to pass correct key or record datatype
	UTLENV			information to RMSM2 when the ^S control code
	UTLEXT			is used.  Use other codes when possible.
	UTLMSC			Change all RMSMES format statements to control
	UTLSYM			strings for RMSM2.  Modify RMSM2 to put out
	UTLTOP			any type of RMS key when called with the ^S
	UTLUSE			control code.  Finally, fix a bug in UTLUSE
	UTLVFY			which was fixed in maintenance long ago (see
				edit 63).  

456	RMSM2			(RL,6-Feb-84) TXURFA writes RFAs backwards.

457	RMSASC			(RL,23-Feb-84) The record reading loop in
				GETASC subtracts 1 from the remaining buffer
				space and then checks to see if it is LEQ 0.
				This should be "LSS 0".

460	RMSSPT			(RL,12-Mar-84) Edit 54 (in COMPRESS) does not
				correctly check for duplicates as was intended.

461	RMSFRE			(RL,8-May-84) Fix $FREE to setup the FST
    				correctly on entrance.

462	RMSUSR			(RL,12-Jul-84) Fix reference to XABALL$K_BID
				in $XABALL_INIT; should be XAB$K_BID.
; Version 3

501	RMSGET,RMSPUT,RMSOPN	(AN, May-84) Put in Remote File Access Code.
	RMSCNC,RMSUSR,RMSSYS
	RMSSYM,RMSEXT,RMSRRE,
	RMSROP,RMSDAP,RMSDSB,
	RMSRCO

502	RMSOPN,RMSCLS,RMSGET	(AN, Jun-84) Use new-style names

503	RMSRDW			(AN, Jun-84) Implement Page Mode

504	RMSIMA,RMSOPN,RMSGLB	(AN, Jul-84) Implement Image Mode
	RMSDSI,RMSERR,RMSFND,
	RMSOSB,RMSUAR,RMSIO,
	RMSGET,RMSPUT,RMSEXT,
	RMSLIB,RMSSYS,RMSUSR,
	DAP
	
505	RMSSYM,DEBCMD,DEBTOP,	(AN, Jul-84) Support RMSDEB
	DEBCMD,DEBACT,DEBSYM

506	RMSDYN,RMSJCK,RMSZER,	(AN, Aug-84) Implement dynamic library call
	

507	RMSDIR,RMSD20,RMSNXF,	(AN, Sep-Oct-84) Implement $Parse and $Search

510	DEBACT,DEBCMD,DEBTOP,	(AN, Sep-84) RMSDEB supports $Parse and $Search
	RMSSYM,DEBSYM,RMSM2

511	RMSRRE			(AN, 11-Oct-84) Fix VMS Ascii

512	DAPTRA, DAPSAI		(AN, 11-Oct-84) Work around XPORT ext addr bug.

513	DAP, RMSROP		(AN, Oct-84) Make $Display display
	RMSSYS				     the right things

514	RMSD20			(AN, 30-Oct-84) Use MapCodes for all GTJFN errs

515	DAP			(AN, 5-Nov-84) Use COD of XAB, not BID

516	RMSD20			(AN, 5-Nov-84) Ext addr fix (put in UADDR call)

517	RMSUAR			(AN, 6-Nov-84) 0 pointer should stay 0

520     RMSUSR                  (AN, 8-Nov-84) Add NAM$V_SRCHFILL,
	                                       NAM$K_MAXRSS,
        	                               NAM$K_MAXESS

521	RMSDSP,RMSSYM.MPR	(AN, 12-Nov-84) $Rename not compatable
	RMSUSR,RMSZDS,RMSDYN
	RMSRRE

522	RMSDIR			(AN, 12-Nov-84) Remove EXTERNAL R$List

523	RMSUSR			(AN, 14-Nov-84) Fix Fab$v_Ftn typo

524	RMSOPN,RMSGET,RMSFND	(AN, 15-Nov-84) Add FFF call & FFFINT
	RMSCLS,RMSCNC,RMSUIN

525	RMSDSP			(AN, 19-Nov-84) Make XRMS stack global

526	DAPERR			(AN, 3-Dec-84) DAPERR does not need RMSREQ,
					       and DIU needs to use DAPERR.

527	RMSD20			(AN, 5-Dec-84) Return resultant on $RENAME.

530	RMSOSB			(AN, 7-Dec-84) Fix EOF calculation

531	RMSOPN			(AN, 7-Dec-84) Return right error for
					       output-only device
532	RMSMSC			(RL, 12-Dec-84) Extended addr enhancement for
						RMSLOD

533	DAP, RMSROP, FALDAP	(AN, 12-Dec-84) CRC checking
	RMSRRE

534	DAPT20, FALDAP		(AN, 12-Dec-84) Mount private strs (FAL)

535	RMSD20			(AN, 13-Dec-84) Correct Nam$v_Cha setting

536	RMSRSU, DEBCMD, DEBACT  (AN, 14-Dec-84) RAC=TRA,BFT,BLK

537	RMSRDW			(AN, 14-Dec-84) Ext Addr fix

540	RMSMSC			(RL, 18-Dec-84) Ext Addr fixe

541	FALDO, FALDAP, DAP	(AN, 21-Dec-84) FAL in page mode
	RMSRRE

542	RMSD20			(AN, 21-Dec-84) CHA bits on first $Search

543	FALDAP, DAP		(AN, 21-dec-84) fal bug 

544	RMSLIB,DAP,RMSDIR	(AN,27-Dec-84) seqadr should include RAC=TRA
	RMSD20				       $parse ext addr bug

545	DAP, FALDAP, RMSROP	(AN,3-Jan-85) Fix Dap protocol errors w/ VMS
	RMSDIR

546	RMSROP, DAP, RMSDIR     (AN, 11-Jan-85) Fix resultant & expanded for
						remote

547	RMSDIR, RMSD20, RMSERS  (AN, 11-Jan-85) Fix $Erase & $Rename
	RMSDPO, RMSCLS, RMSROP

550	RMSDSI, RMSEXT, RMSOPN,	(RL, 14-Jan-85) Fix to make
	RMSUIN			FFF calling work:
				DSI : 	use ORG = none for non-RMS files,
					based on file class rather than
					on the record format;
				EXT :	add R$NULL declaration;
				OPN : 	pass FST in FAB, etc., when
					calling F$OPEN;
				UIN :	declare a LINKAGE for $FFFINT in
					order to access register arguments.

551	RMSUSR			(RL, 15-Jan-85) Changes to RMSUSR to
				make FFF compile cleanly.  Add $FFFINT
				calling macro, etc.


552	RMSSYM.MPR		(AN, 15-Jan-85) Fix ancient bug in runtime
				initialization of XABs from MACRO

553	RMSDIS			(AN, 16-Jan-85) When setting up Config XAB
	RMSUSR,RMSSYM.MTB	for local files, do not step on the header
				and make the cfg defs agree with each other

554	DEBACT,DEBCMD		(AN,17-Jan-85) Make RMSDEB support CFG
	RMSUSR			and fix error in its definition

555     FALDAP,DAP,RMSRRE	(AN,28-Jan-85) Fix rsz and $Find
	RMSFND

556	RMSUIN			(RL,30-Jan-85) Preserve ACs 3, 4, 5 in 
				FFFINT linkage, to mimic JSYS linkage for
				RMS calls.

557	RMSCNC, RMSRRE, FALDAP, (AN,7-Feb-85) Fix multistream, $truncate
	FALDO,  RMSRCO, RMSTRN, and $Delete, and add some error codes
	RMSDEL, DAP.REQ,DAPERR

560	FALDAP, RMSROP		(AN,7-Feb-85) Refine datatype default further

561	FALDAP, DAP, RMSRRE	(AN,14-Feb-85) Fix CRC, RFA, and RSZ errors

562	UTLTOP, UTLSET		(RL,6-Mar-85) Create UTLSET.B36 with routine
				UTLSET (called from RMSUTL in UTLTOP).  This
				routine merges RMS-SINGLE-SECTION.EXE into
				the RMSUTL image and saves the RMS entry
				vector address; it also sets up PDVs and a
				few other things.  One then SAVEs the file.
				On subsequent runs, UTLSET sets up the RMS
				entry vector with the SDVEC% JSYS.

				This avoids the problems arising from RMS's
				move into a non-zero section.  RMSUTL needs
				RMS in section zero, and this puts the code
				together without collision between global
				symbols.

563	RMSUSR			(RL,28-Mar-85) Add TYP block classes for 
				FFF files to RMSUSR; they were previously
				only in FFFUSR.R36.

564	BRMS20.CTL		(RL,1-Apr-85) Update BRMS20.CTL to add
				UTLSET to RMSUTL, build FFF dynamic library.

565	RMSCLS, RMSCNC, RMSFND	(RL,5-Apr-85) Return the STV value from
	RMSGET, RMSOPN		calls to the FFF routines.

566	RMSDIR, RMSOPN, DAP	(AN,5-Apr-85) Fix wildcard error recovery
	RMSSYS, RMSROP, RMSRRE  and map Record formats SCR & SLR into STM
	RMSD20, RMSUSR

567	RMSRSU			(AN,18-Jun-85) Allow relative access
			        to fixed sequential files
				and clear RSL in NAM block on errors

570	FALDAP			(AN,23-Jul-85) Fix Directory list to VMS

571	RMSROP,DAP		(AN,6-Aug-85) Recompute MRS to 8-bit systems
				and request 3-part name if supported
				and try to parse remote spec if not.
572	RMSCLS,RMSCNC,RMSM2,	(AN,19-Sep-85) Merge in TOPS-10 changes
	RMSDIR,RMSDIS,RMSDSP,	where practical
	RMSEXT,RMSFFF,RMSGLB,
	RMSIMA,RMSINI,RMSIO,
	RMSLIB,RMSM11,RMSMAC,
	RMSMSC,RMSOSM,RMSPUT,
	RMSQUE,RMSRDW,RMSREQ,
	RMSROP,RMSRRE,RMSSYS,
	RMSUSR,DAP,DAPSAI,
	DAPTRA,FFFISA,FFFJCK,
	FFFOPN,FFFWIN,
	BLISSNET.REQ

573	RMSROP,FALDAP,DAP	(AN, 11-Oct-85) Fix extended attributes.
	RMSSYM.MTB		Add NA$MXE and NA$MXR to require file
	RMSSYM.MPR		Fix NAM$E and XAB$B CFG

574	RMSROP,FALDAP,DAP	(AN, 17-Oct-85) Fix return attributes more
	RMSIMA,RMSASC,		Fix EOF checking & non-7-bit Ascii
	RMSSYM.MPR		Fix TYP$E
575     RMSSYM,DAPSAI		Fix JFN problem and CFG$B,CFG$E, move nam$v_nod

576	RMSUSR.R36		(asp, 29-Oct-85) Add rfa to RAB_STORE keywords

577	DAP    DAPERR DAPSAI	(an, 1-Nov-85) Implement R/W Image Mode by RFA.
	FALDAP RMSASC RMSD20	Work around GTJFN bug (SUP not enforced).
	RMSDIR RMSERR RMSFLS	Work around PRO bug
	RMSFND RMSGET RMSIMA	Update RMSDEB.
	RMSOPN RMSRDW RMSROP
	RMSRRE DEBACT DEBTOP

600	RMSDIR DAPSAI DAP	(AN, 27-Nov-85) Fix $Parse
	RMSROP FALDAP		Prevent Datatype skew

601	DAPERR DAP.REQ		(AN, Jan-86) Add missing error codes to 
	FALDAP			translation routines

602	RMSRRE			(AN, Jan-86) Fix $Update

603	FALDAP			(AN, 20-Jan-86) Don't send extra attrs to VAX
				on Directory-List function

604	RMSDIR			(TGS, 14-Feb-86) Fix 'Bad JFN' bug: Don't
				return JFN to FAB during $PARSE iff file
				file is remote OR JFN is parse-only. 
				Partially supplanted by edit 615.

605	DAP,FALDAP,DAP.REQ	(AN, 27-Jan-86) Handle oversize VMS RFA's

606	DAP,FALDAP		(AN, 31-Jan-86) Fix IMR with more UAPointer()s
			 	Fix TOPS10 datatype skew problem.
				and make BSZ an input to $Open so programs get
				bytes delivered the way they expect.

607	RMSOPN,RMSROP,RMSERR	(TGS, 19-Feb-86) Prevent creation of dummy
				files on OFP $PARSE followed by $OPEN, and
				failing $CREATE of indexed file.  Reset DAP
				function code to Create for remote CIF.

610	DAP,FALDAP,RMSDIS	(TGS, 7-Mar-86) Rewrite DAP extended key
	RMSLIB			XAB attributes so remote $CREATE works (also
				added DAP KNM handling).  If delete-on-close
				and CRC-checking have been set during Access-
				complete-close, do not compare checksums.
				Fix directory/list from VMS when RMS thinks
				the local file is LSA.

611	FALDAP			(TGS, 24-Mar-86) Find lost RFAs, which weren't
				getting returned in STATUS messages, and were
				getting ignored in D$GCTL.

612	DAP.REQ			(TGS, 25-Mar-86) Increased DAP$k_Buffer_Size
				to 8192 (20000 octal)

613	RMSUSR.R36,DAP.B36,	(SC, 27-Mar-86) Added DIL8 type class to
	RMSOPN.B36,RMSRRE.B36,	provide support for DIL formatted 8-bit
	RMSSYM.MTB		records generated (only) by DIU)

614	RMSTRN,RMSOSB		(TGS, 1-Apr-86) BLK-mode $TRUNCATE.
	RMSRDW

615	RMSDIR,RMSOSB		(TGS, 14-Apr-86) Always release a SynChk
				JFN, and do not return it to the user's FAB.
				This is not overridden by DRJ.

616	RMSFNX,RMSUPD		(TGS, 30-Apr-86) "Bad KSZ/RSZ" bug on remote
				indexed $GET/$UPDATE.

617	DAP			(TGS, 30-Apr-86) Old typo kdb$h psyched
				out an oversmart macro, silently broke
				secondary DUP/CHG attributes.

620	DAP,FALDAP		(TGS, 1-May-86) Indexed $GETs/$PUTs brain-
				damaged in various ways

621	RMSOPN			(TGS, 4-Jun-86) FOP=SUP ignored on $CREATE
				if file already exists and CIF is not set.

622	RMSTRN			(TGS, 4-Jun-86) Old V2 bug truncating large
				sequential files: the page count calaculation
				goes negative, PMAP% fails.

623	DAP			(TGS, 9-Jun-86) Fix remote keyed $GET.

624	RMSRRE			(TGS, 10-Jun-86) Don't require fixed-length
				remote $GET user buffers to be an even
				number of words.

625	RMSD20			(GAS, 10-Jun-86) Dot bug caused low memory to 
				be trashed at the RNAMF in RL$RENAME.

626	RMSUSR			(GAS, 12-Jun-86) Add FAB picture; fix NAM
				picture; NAM$M_PWD and NAM$M_SYNCHK were
				defined wrong; XABPRO masks defined wrong.

627	RMSROP			(TGS, 11-Jun-86) Always request KEY display
				on remote indexed $Open if partner supports
				it.

630	FALDAP,DAPSUB		(TGS, 12-Jun-86) Processing remote key
				fields on $Get no longer assumes the 
				indexed dtp is unchanged from a previous
				$Get.

631	RMSD20			(TGS, 13,Jun-86) Set GJ%FOU, not %NEW, on
				$Rename's newfab JFN.

632	DAP.REQ,FALDAP		(TGS, 16-Jun-86) Add some more RMS-to-DAP
				error code conversions so normal errors
				are not signalled as DPE's.

633	FALDAP			(GAS, 17-Jun-86) Make wild deletes work for
				PDP-11 system access to RMSFAL.

634	DEBCMD			(asp, 17-Jun-86) Re-order TYP class values
				so RMSDEB can have BYT mode.

635	FALDAP			(GAS 20-Jun-86) Fix FALDAP so that filenames
				of the form "FILE.TYPE;0" don't confuse RMSFAL.
				Also make renames work from VMS and RSX.

636	DAP.REQ, DAP.B36	(GAS 25-Jun-86) Allow RSTS to read a STM file.

637	DAP, RMSROP,		(GAS 25-Jun-86) Return config XAB to user as 
	FALDO, FALTOP		soon as we read one from the link.

640	RMSROP			(TGS, 26-Jun-86) Fix Internal RMS error
				on explicit $Close after $Parse/$Search
				loop.  If no explicit $Open, return IFI.

641	DAP			(TGS, 26-Jun-86) If Dap$k_Nametype_Nam
				is received without preceeding volume
				and directory NAME messages, eat message.

642	RMSMSC			(TGS, 27-Jun-86) Old extended addressing
				bug in MOVEKEY was randomly shuffling
				user-section memory before a string
				copy.

643	FALDAP			(GAS 27-Jun-86) Always  return main  attributes
				even though access msg didnt say to if it is  a
				OPEN, CREATE, or SUBMIT message (used by RT11),
				and don't put extra  acks in directory list  if
				talking pre v7 DAP.

644	RMSROP			(GAS 27-Jun-86) Don't forget third argument to
				DAP$GET_CONFIG.  Lost edit(?)

645	RMSROP, DAP		(GAS 27-Jun-86) If image mode to another 36 bit
				system running old FALs, set block size 512 and
				byte  size  36  and  undefined  record  format.
				Work on image mode for TOPS-10 systems.

646	RMSCLS			(TGS, 9-Jul-86) Clear RAB pntr on $Close

647	DAP, FALDAP, RMSUSR	(GAS, 12-Jul-86) Fix image reads from TOPS-10
				NFT (he does SEQ image access).  When reading
				an attributes message, default the datatype to
				IMAGE, and if image from a LCG machine default
				the BSZ to 36 and MRS to 512 if they weren't
				given.  Also fix FAB picture in RMSUSR.


650 	RMSDIR			(GAS, 17-Jul-86) DAP$SEARCH didn't update the
				NAM block lengths and pointers properly for 
				remote files breaking DIU's directory command
				and wildcards to/from remotes.

651	RMSDIR			(GAS, 17-Jul-86) DAP$SEARCH and DAP$MERGE 
				didn't stop on a null causing it not to work
				sometimes and in particular on TOPS-10 
				filenames.

652	DAP			(GAS, 25-Jul-86)  If we are talking to an old 
				non-RMS TOPS-20 program then add two to the MRS
				if the RFM is STM and default the FOP to SUP if
				none specified.  This makes DIT (DIL) work.

>;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$)>
>

; $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
   IFIW 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)
>

;DC$MS2 - GLOBAL SYMBOLS NEEDED BY RMSM2

DEFINE DC$MS2,<
DCL$GL	(   NOCRFL,	1)	;Set to -1 if no crlf should be appended to string
DCL$GL	(   NOOUTF,	1)	;Set to -1 if string is continued, don't output
DCL$GL	(   STRBP,	1)	;BP to arg ASCIZ string
DCL$GL	(   NARGS,	1)	;Number of args (besides the string itself).
DCL$GL	(   TEMPBP,	1)	;Temporary BP
DCL$GL	(   TEMPCC,	1)	; and temporary count
DCL$GL	(   RETAD,	1)	;Return address to routine
DCL$GL	(   TTYBP,	1)	;TTY byte ptr
DCL$GL	(   TTYCC,	1)	;TTY char count
DCL$GL	(   ALTBFP,	1)	;Alternate buffer pointer
DCL$GL	(   ALTCC,	1)	;Alternate char count
DCL$GL	(   DSTBP,	1)	;Bp to dest. buffer
DCL$GL	(   DSTCC,	1)	;# chars left in dest. buffer
DCL$GL	(   OUTBUF,	^D100)	;Output string buffer
DCL$GL	(   TEMPBF,	^D20)	;Temp buffer for dates, MOVST
DCL$GL	(   ALTOUT,	1)	;-1 if TX$RPT called
DCL$GL	(   ALTBCC,	1)	;Address of user's BP, CC
DCL$GL	(   BUFDMP,	1)	;User's routine to dump buffer
DCL$GL	(   BUFINT,	1)	;Addr of user's routine to init buffer
DCL$GL	(   SVT34,	2)	;Some saved acs
DCL$GL	(   SVT56,	2)
>

;
; $ERR - CALL TX$OUT TO DISPLAY A MESSAGE
;
DEFINE $ERR(MSG$,REACT$)<		;;CALL ARGUMENTS AND LABEL
  $CALL TX$OUT,<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
  >
>

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

EXTERN RM$ASZ,TX$TOUT
$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 CONVERSELY
;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.
;	  Remember to change RMS$VER and VR%EDIT 

RMS$VER==300,,652		; USED BY DYNAMIC LIBRARY PDV SETUP
				; THIS & BELOW SHOULD AGREE
DEFINE $VERS<				;;SET THE COMMON VERSION NUMBER FOR PROG
  VR%CUS==0				;;PROBABLY ALWAYS 0
  VR%VERS==3				;;MAJOR RELEASE CYCLE
  VR%MAINT==0				;;EG. ==1 WOULD IMPLY VERSION 1.1
  VR%EDIT==652				;;UPDATED EACH PUBLISHED PATCH
  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$OUT,<MSG$,[$$CPON(0)'ERR$]> ;;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$OUT,<[$$CPON(0)'ERR$]>> ;PUT OUT MSG
  IFNB <MSG$>,<$CALLB TX$OUT,<MSG$,[$$CPON(0)'ERR$]>> ;;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]

; 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