;STAR:<SOURCES>MACSYM.MAC.2, 13-Mar-2006 19:40:15, Edit by SLOGIN
;[T36] Don't cross-reference generated symbols in MACSYM; suppress DDT output
; Edit= 9162 to MACSYM.MAC on 9-Mar-90 by GSCOTT
;Add ANNJE. macro to jump to "false" on JSYS error. 
; Edit= 8849 to MACSYM.MAC on 31-May-88 by RASPUZZI
;Add new mnemonics .CHDAS and .CHHYP for the '-' character.
; UPD ID= 59, RIP:<7.UTILITIES>MACSYM.MAC.5,  24-Mar-88 06:52:33 by LOMARTIRE
;More of TCO 7.1236 - Fix copyright year in MACREL
; UPD ID= 58, RIP:<7.UTILITIES>MACSYM.MAC.4,   8-Mar-88 10:56:58 by GSCOTT
;More of TCO 7.1236 - Fix copyright macro.
; UPD ID= 54, RIP:<7.UTILITIES>MACSYM.MAC.3,  19-Feb-88 18:14:29 by GSCOTT
;TCO 7.1236 - Update copyright notice.
; UPD ID= 35, RIP:<7.UTILITIES>MACSYM.MAC.2,  29-Dec-87 11:15:02 by RASPUZZI
;TCO 7.1168 - Add .CHSEM so we have semi colon mnemonic
; UPD ID= 124, SNARK:<6.1.UTILITIES>MACSYM.MAC.54,   6-May-85 20:23:19 by GROSSMAN
;TCO 6.1.1367 - Fix G1BPT to get section number into the correct place if
;using a symbolic section number.
; UPD ID= 609, SNARK:<6.UTILITIES>MACSYM.MAC.53,  16-Oct-84 09:12:47 by LOMARTIRE
;TCO 6.2243 - Fix SAVEAC so that numeric arguments produce the correct results
; UPD ID= 597, SNARK:<6.UTILITIES>MACSYM.MAC.52,  17-Sep-84 16:11:52 by PURRETTA
;Update copyright notice.
; UPD ID= 574, SNARK:<6.UTILITIES>MACSYM.MAC.51,   7-Aug-84 16:10:48 by PAETZOLD
;More of TCO 6.2132 - Add an N.B. in the structure macros about initialization
; UPD ID= 565, SNARK:<6.UTILITIES>MACSYM.MAC.50,  18-Jul-84 10:23:09 by PAETZOLD
;TCO 6.2132 - fix up ENDSTR to reuse FTSHOW words.
; UPD ID= 513, SNARK:<6.UTILITIES>MACSYM.MAC.49,  28-Mar-84 21:58:59 by MOSER
;TCO 6.1991 - REPLACE POINTR WITH ITS EXPANSION
; UPD ID= 502, SNARK:<6.UTILITIES>MACSYM.MAC.48,  15-Mar-84 09:28:06 by PAETZOLD
;Revoke edit 485.
; UPD ID= 501, SNARK:<6.UTILITIES>MACSYM.MAC.47,  11-Mar-84 16:16:36 by GROSSMAN
; CAXxx and ADDx & friends
; UPD ID= 486, SNARK:<6.UTILITIES>MACSYM.MAC.46,  20-Feb-84 22:36:22 by GROSSMAN
; Add TCO # to previous...
; UPD ID= 485, SNARK:<6.UTILITIES>MACSYM.MAC.45,  20-Feb-84 22:25:35 by GROSSMAN
; TCO 6.1974 - Purge generated labels produced by IFSKP., DO. and friends.
; UPD ID= 356, SNARK:<6.UTILITIES>MACSYM.MAC.44,   5-Oct-83 14:20:00 by MURPHY
;Remove obsolete PTLOC, PTLOCI, etc.
; UPD ID= 345, SNARK:<6.UTILITIES>MACSYM.MAC.43,  18-Aug-83 00:38:50 by GROSSMAN
; Make OWGP. work under radix ^D10.
; UPD ID= 339, SNARK:<6.UTILITIES>MACSYM.MAC.42,   8-Aug-83 08:28:19 by GROSSMAN
; More of TCO 6.1755 - Subtract P offsets from ^D36.
; UPD ID= 328, SNARK:<6.UTILITIES>MACSYM.MAC.41,   1-Aug-83 08:14:48 by GROSSMAN
;TCO 6.1755 - Re-do OWGBP generation.
; UPD ID= 326, SNARK:<6.UTILITIES>MACSYM.MAC.40,  27-Jul-83 14:33:00 by GROSSMAN
;Fix generation of 18 bit one-word globals (in .GTBCD macro)
; UPD ID= 318, SNARK:<6.UTILITIES>MACSYM.MAC.39,  11-Jul-83 08:56:07 by GRANT
;Change names of 8-bit BP macros added in UPD 306
; UPD ID= 317, SNARK:<6.UTILITIES>MACSYM.MAC.38,   8-Jul-83 15:17:29 by WEETON
;TCO 6.1715 - Add VI%DEC
; UPD ID= 306, SNARK:<6.UTILITIES>MACSYM.MAC.37,  30-Jun-83 11:15:34 by GRANT
;More TCO 6.1641 - Add macros to generate 8-bit byte pointers
; UPD ID= 300, SNARK:<6.UTILITIES>MACSYM.MAC.36,  23-Jun-83 15:20:26 by PURRETTA
;Assemble copyright under REL conditional
; UPD ID= 299, SNARK:<6.UTILITIES>MACSYM.MAC.35,  23-Jun-83 13:18:09 by MURPHY
;More - check on pass 2 only.
; UPD ID= 298, SNARK:<6.UTILITIES>MACSYM.MAC.34,  22-Jun-83 17:26:57 by PURRETTA
;TCO 6.1701 - Define copyright macros COPYRT and .CPYRT
; UPD ID= 295, SNARK:<6.UTILITIES>MACSYM.MAC.33,  15-Jun-83 11:54:51 by MURPHY
;TCO 6.1686 - Check for absolute size args in STKVAR, etc.
; UPD ID= 289, SNARK:<6.UTILITIES>MACSYM.MAC.32,  24-May-83 09:23:08 by MCINTEE
;TYPO IN PREVIOUS EDIT - NAME SHOULD BE EMSKST NOT MSKSTR !!!
; UPD ID= 288, SNARK:<6.UTILITIES>MACSYM.MAC.31,  23-May-83 10:32:53 by MURPHY
;TCO 6.1661 - EDEFST, EMSKST, etc.
; UPD ID= 279, SNARK:<6.UTILITIES>MACSYM.MAC.30,   6-May-83 14:09:24 by HALL
;TCO 6.1641 - Add new byte pointers for 7-bit ASCII strings
; UPD ID= 278, SNARK:<6.UTILITIES>MACSYM.MAC.29,   5-May-83 16:16:46 by MURPHY
;TCO 6.1647 - Anglebrackets around Y in various calls internal to LOAD, etc.
; UPD ID= 246, SNARK:<6.UTILITIES>MACSYM.MAC.28,   4-Apr-83 12:42:30 by MURPHY
;TCO 6.1514 - New flavors of ERJMP, ERCAL.  New macros IFJE. IFJN. to
; allow specification of ERJMP type.
; UPD ID= 242, SNARK:<6.UTILITIES>MACSYM.MAC.27,  25-Mar-83 16:40:06 by MURPHY
;TCO 6.1576 - Add tco number for OWGP., etc.
; UPD ID= 240, SNARK:<6.UTILITIES>MACSYM.MAC.26,  24-Mar-83 16:29:03 by MURPHY
;OWG. - Macro to construct one-word global byte pointers.
;EP., EXIND. - Macros to create extended format indirect words.
; UPD ID= 228, SNARK:<6.UTILITIES>MACSYM.MAC.25,  16-Mar-83 13:59:31 by MURPHY
;TCO 6.1551 - Fix DO., save ENDLP. definition over nesting.
; UPD ID= 223, SNARK:<6.UTILITIES>MACSYM.MAC.24,  12-Mar-83 17:33:10 by MILLER
;More TCO 6.1540
; UPD ID= 222, SNARK:<6.UTILITIES>MACSYM.MAC.23,  11-Mar-83 13:08:44 by MILLER
;TCO 6.1540. Fix .ENTER for global stack
; UPD ID= 215, SNARK:<6.UTILITIES>MACSYM.MAC.22,  28-Feb-83 07:54:49 by MCINTEE
;TCO 6.1528 - In ENDSTR, purge all intermediate macro names
; UPD ID= 197, SNARK:<6.UTILITIES>MACSYM.MAC.21,  26-Jan-83 09:31:38 by HUIZENGA
;TCO 6.1477 - INCR/DECR warning about field overflows
; UPD ID= 193, SNARK:<6.UTILITIES>MACSYM.MAC.20,  18-Jan-83 23:30:33 by MURPHY
;More 6.1468 - Now make other variables work again.
; UPD ID= 192, SNARK:<6.UTILITIES>MACSYM.MAC.20,  17-Jan-83 16:48:28 by MURPHY
;TCO 6.1468 - Make STKVAR variables work in BLCAL.
; UPD ID= 149, SNARK:<6.UTILITIES>MACSYM.MAC.19,   1-Oct-82 08:45:37 by NEUSTAEDTER
;TCO 6.1293 - fancy up SAVEAC and LOADE
; UPD ID= 122, SNARK:<6.UTILITIES>MACSYM.MAC.18,  24-Aug-82 14:46:17 by MCINTEE
;More TCO 6.1139 - BEGSTR needs LFTBT. macro
; UPD ID= 100, SNARK:<6.UTILITIES>MACSYM.MAC.17,  15-Jul-82 18:27:56 by WALLACE
;TCO 6.1188 - Make computation of MACVER use new version number symbols
; UPD ID= 91, SNARK:<6.UTILITIES>MACSYM.MAC.16,  25-Jun-82 11:45:20 by PAETZOLD
;TCO 6.1177 - Make symbol names from from edit better more unique
; UPD ID= 90, SNARK:<6.UTILITIES>MACSYM.MAC.15,  23-Jun-82 10:13:00 by PAETZOLD
;TCO 6.1175 - Add version information to MACSYM
; UPD ID= 84, SNARK:<6.UTILITIES>MACSYM.MAC.14,   9-Jun-82 18:15:13 by MURPHY
;TCO 6.1163 - MAKRM.
; UPD ID= 83, SNARK:<6.UTILITIES>MACSYM.MAC.13,   9-Jun-82 15:25:40 by WALLACE
;TCO 6.1161 - Modify AC save and stack variable facilities to work
;  with extended addressing.  Also perform general clean up for listing
;  sake.
; UPD ID= 62, SNARK:<6.UTILITIES>MACSYM.MAC.12,  26-May-82 10:36:26 by MCINTEE
;MASK. - must be on one line
; UPD ID= 58, SNARK:<6.UTILITIES>MACSYM.MAC.11,  25-May-82 16:25:13 by MCINTEE
;Add MASK. - used in BEGSTR
; UPD ID= 41, SNARK:<6.UTILITIES>MACSYM.MAC.10,  18-May-82 07:30:03 by GRANT
;TCO 6.1139 - BEGSTR, ENDSTR, LOADE
; UPD ID= 37, SNARK:<6.UTILITIES>MACSYM.MAC.9,   3-May-82 17:52:41 by MURPHY
;TCO 6.1124 - BLOCK., ENDBK.
; UPD ID= 32, SNARK:<6.UTILITIES>MACSYM.MAC.8,   5-Mar-82 10:58:39 by MCINTEE
;Add warning to STKVAR about blanks
; UPD ID= 31, SNARK:<6.UTILITIES>MACSYM.MAC.7,  22-Feb-82 17:38:19 by MURPHY
;IFJER., IFNJE. - new names for IFNES., IFESK.
;TCO 6.1061 - FORS.
; UPD ID= 26, SNARK:<6.UTILITIES>MACSYM.MAC.6,  27-Jan-82 15:57:01 by MCINTEE
;Add warning to DEFSTR about length of names !!!
; UPD ID= 20, SNARK:<6.UTILITIES>MACSYM.MAC.5,  15-Jan-82 10:43:41 by WALLACE
;TCO 5.1669 - Add Error JSERR (EJSERR) and Error JSHLT (EJSHLT) macros
;TCO 5.1666 - Add If Error Skip (IFESK.) and If No Error Skip (IFNES.) macros
; UPD ID= 13, SNARK:<6.UTILITIES>MACSYM.MAC.4,  17-Nov-81 11:57:56 by MURPHY
;Allow ANxxx. between ELSE. and ENDIF.
;ENDDO. equivalent to OD. for consistency.
; UPD ID= 12, SNARK:<6.UTILITIES>MACSYM.MAC.3,  12-Nov-81 13:42:14 by MURPHY
;FORN., FORX.
;Put file in U60:
; UPD ID= 34, SNARK:<5.UTILITIES>MACSYM.MAC.39,  18-Sep-81 13:35:40 by LEACHE
;Add comments
; UPD ID= 32, SNARK:<5.UTILITIES>MACSYM.MAC.38,  17-Sep-81 15:45:20 by MURPHY
;Fix STDAC.
; UPD ID= 28, SNARK:<5.UTILITIES>MACSYM.MAC.37,   8-Sep-81 17:38:36 by MURPHY
;Two PURGEs for ENDxx to get rid of both macro and symbol definition.
; UPD ID= 15, SNARK:<5.UTILITIES>MACSYM.MAC.36,  30-Jul-81 09:01:25 by LEACHE
;Remove unneeded ^O's from previous
; UPD ID= 13, SNARK:<5.UTILITIES>MACSYM.MAC.35,  29-Jul-81 09:22:17 by LEACHE
;Add macros MPRNTX,EPRNTX,LFIWM,GFIWM,L1BPT,L2BPT,G1BPT,G2BPT
; UPD ID= 2278, SNARK:<5.UTILITIES>MACSYM.MAC.34,  30-Jun-81 16:41:32 by MURPHY
;FIX IFXE.
; UPD ID= 2251, SNARK:<6.UTILITIES>MACSYM.MAC.14,  24-Jun-81 16:54:23 by MURPHY
;STDAC., DO.
; UPD ID= 2183, SNARK:<6.UTILITIES>MACSYM.MAC.13,  11-Jun-81 14:40:23 by MURPHY
;RENAME TQNx TO TMNx; TQNx WILL GENERATE EXACTLY ONE INSTRUCTION OR COMPLAIN
; UPD ID= 2158, SNARK:<6.UTILITIES>MACSYM.MAC.12,   9-Jun-81 15:13:39 by MURPHY
;IFXE., IFXN., IFQE., IFQN., ANDXE., ANDXN., ANDQE., ANDQN
;RESTRUCTURE IFE., IFN. ETC., ADD ELSE. CASE, ADD ANDE., ANDN., ETC.
; UPD ID= 2150, SNARK:<6.UTILITIES>MACSYM.MAC.11,   8-Jun-81 16:47:27 by MURPHY
;ANSKP., ANNSK., IFE., IFN., ETC.
; UPD ID= 2120, SNARK:<6.UTILITIES>MACSYM.MAC.9,   3-Jun-81 16:13:37 by MURPHY
;MORE ORNSK.
; UPD ID= 2052, SNARK:<6.UTILITIES>MACSYM.MAC.8,  20-May-81 17:47:33 by MURPHY
;Suppress one more generated tag in IFSKP.
; UPD ID= 2017, SNARK:<6.UTILITIES>MACSYM.MAC.7,  18-May-81 15:57:40 by MURPHY
;Alternate form of IFSKP., IFNSK.
; UPD ID= 1781, SNARK:<6.UTILITIES>MACSYM.MAC.6,   2-Apr-81 10:42:18 by HUIZENGA
;TCO 5.1275 - Explicitly define absolute value of .JBVER as octal. 20-15376.
; UPD ID= 1766, SNARK:<6.UTILITIES>MACSYM.MAC.4,  25-Mar-81 14:55:47 by MURPHY
;Suppress generated tags in IFSKP. etc.
;Provide optional variables in BLSUB.
; UPD ID= 1688, SNARK:<5.UTILITIES>MACSYM.MAC.26,  12-Mar-81 11:49:35 by GRANT
;Update Copyright
; UPD ID= 1629, SNARK:<5.UTILITIES>MACSYM.MAC.25,   2-Mar-81 14:47:00 by MURPHY
;FIX TO BLCAL.
;USE .SAC NOT CX
; UPD ID= 1592, SNARK:<5.UTILITIES>MACSYM.MAC.23,  26-Feb-81 17:52:17 by MURPHY
;MV., MVI.
; UPD ID= 1559, SNARK:<5.UTILITIES>MACSYM.MAC.22,  13-Feb-81 16:42:35 by MURPHY
;.IF, ORNSK.
; UPD ID= 1544, SNARK:<5.UTILITIES>MACSYM.MAC.21,   9-Feb-81 13:54:29 by MURPHY
;IFNSK., IFSKP.
; UPD ID= 1523, SNARK:<5.UTILITIES>MACSYM.MAC.20,   6-Feb-81 11:16:07 by MURPHY
;NAMES CHANGED TO BLCAL., BLSUB.
; UPD ID= 1513, SNARK:<5.UTILITIES>MACSYM.MAC.19,   3-Feb-81 17:40:52 by MURPHY
;ADD .IFATM, FIX BLCALL
; UPD ID= 1466, SNARK:<5.UTILITIES>MACSYM.MAC.18,  21-Jan-81 16:19:40 by MURPHY
;DITTO
; UPD ID= 1465, SNARK:<5.UTILITIES>MACSYM.MAC.17,  21-Jan-81 15:09:03 by MURPHY
;BLSUBR, BLCALL
; UPD ID= 1179, SNARK:<5.UTILITIES>MACSYM.MAC.16,  20-Oct-80 17:21:25 by MURPHY
;REVISE PREV EDIT IN DEFSTR
; UPD ID= 1165, SNARK:<5.UTILITIES>MACSYM.MAC.15,  15-Oct-80 12:08:44 by MURPHY
;EXTERN .SASET
; UPD ID= 1135, SNARK:<5.UTILITIES>MACSYM.MAC.14,   6-Oct-80 16:13:17 by MURPHY
;MAKE DEFSTR DEFINE A SYMBOL TO HOLD LOCATION INFO FOR DDT
; UPD ID= 1074, SNARK:<5.UTILITIES>MACSYM.MAC.13,  30-Sep-80 17:38:12 by MURPHY
;DITTO
; UPD ID= 1069, SNARK:<5.UTILITIES>MACSYM.MAC.12,  30-Sep-80 14:23:54 by MURPHY
;STKVAR, ACVAR
; SNARK:<5.UTILITIES>MACSYM.MAC.11,	5-Aug-80 09:07:15 by ELFSTROM
;	change "circonflex" to "circumflex"
; UPD ID= 611, SNARK:<4.1.UTILITIES>MACSYM.MAC.10,   6-Jun-80 14:36:44 by MURPHY
; UPD ID= 602, SNARK:<4.1.UTILITIES>MACSYM.MAC.9,   4-Jun-80 22:44:54 by MURPHY
;ALLOW MEMORY LOC FOR TQNN AND TQNE
; UPD ID= 470, SNARK:<4.1.UTILITIES>MACSYM.MAC.8,  23-Apr-80 17:28:36 by MURPHY
; UPD ID= 469, SNARK:<4.1.UTILITIES>MACSYM.MAC.7,  23-Apr-80 16:41:36 by MURPHY
;ADD .XCMSY - MACRO TO SUPPRESS JUNK SYMBOLS USER HEREIN
;<4.1.UTILITIES>MACSYM.MAC.6, 14-Apr-80 16:29:47, EDIT BY OSMAN
;Change FLDDB. and FLDBK. to allow \ in help message
;<4.1.UTILITIES>MACSYM.MAC.5, 12-Nov-79 08:42:58, EDIT BY OSMAN
;more 4.2570 - Purge ..V1 and ..V22 after using them
;<4.1.UTILITIES>MACSYM.MAC.4, 12-Nov-79 08:34:38, EDIT BY OSMAN
;MORE 4.2570 - Change V22 to ..V22
;<4.1.UTILITIES>MACSYM.MAC.3,  9-Nov-79 13:55:33, EDIT BY OSMAN
;tco 4.2570 - Change V1 to ..V1
;<4.1.UTILITIES>MACSYM.MAC.2, 31-Oct-79 10:37:13, EDIT BY OSMAN
;tco 4.1.1003 - Add .CHSPC
;<4.UTILITIES>MACSYM.MAC.27, 19-Oct-79 13:39:11, EDIT BY ZIMA
;TCO 4.2536 - Make JSMSG0 external to prevent "undefined" errors
;  from MACRO when attempting to use PERSTR macro.
;<4.UTILITIES>MACSYM.MAC.19,  2-Oct-79 15:05:45, EDIT BY OSMAN
;tco 4.2506 - allow BRKCH. ","
;<4.UTILITIES>MACSYM.MAC.18, 21-Sep-79 15:37:58, EDIT BY ENGEL
;UNDO MAKING RETSKP AN OPDEF
;<4.UTILITIES>MACSYM.MAC.17, 11-Sep-79 07:17:32, EDIT BY R.ACE
;TCO 4.2453 - PREFIX "symbol IS NOT DEFINED" WITH A QUESTION MARK
;<4.UTILITIES>MACSYM.MAC.16, 19-Aug-79 20:35:06, EDIT BY GILBERT
;MAKE RETSKP, JSHLT, ETC. OPDEFS FOR DDT TYPEOUT.
;<4.UTILITIES>MACSYM.MAC.15, 22-Jun-79 07:16:13, EDIT BY R.ACE
;TCO 4.2307 - CHANGE FLDDB. TO USE 0,,LST INSTEAD OF Z LST
;<4.UTILITIES>MACSYM.MAC.14, 10-Mar-79 14:01:35, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>MACSYM.MAC.13,  8-Feb-79 16:46:30, EDIT BY KIRSCHEN
;ADD ENTRY DECLARATION FOR .STKST FOR LIBRARY SEARCHING
;<4.UTILITIES>MACSYM.MAC.12,  6-Feb-79 10:59:13, EDIT BY GILBERT
;REPLACE XMOVEI -- MACRO DOESN'T KNOW ABOUT IT
;<4.UTILITIES>MACSYM.MAC.11,  5-Feb-79 00:51:10, EDIT BY GILBERT
;Remove extended addressing OPDEFs now in MACRO, change XBLT MACRO
;  to XBLT. to avoid conflict with MACRO's definition of 020000,,0.
;<4.UTILITIES>MACSYM.MAC.10, 22-Jan-79 16:29:04, EDIT BY DNEFF
;Make POINTR macro take addresses with indexing again.
;<4.UTILITIES>MACSYM.MAC.9, 22-Jan-79 13:31:23, EDIT BY DBELL
;MAKE POINTR, FLD, .RTJST, MASKB, AND MOD. IMMUNE TO STRANGE ARGUMENTS
;<4.UTILITIES>MACSYM.MAC.8, 25-Oct-78 12:22:59, EDIT BY GILBERT
;Suppress CALLRET to DDT typeout.
;<4.UTILITIES>MACSYM.MAC.7, 12-Sep-78 15:52:12, EDIT BY OSMAN
;FIX FLDBK.
;<4.UTILITIES>MACSYM.MAC.4,  6-Sep-78 16:51:29, EDIT BY OSMAN
;ADD FLDDB. AND FLDBK.
;<4.UTILITIES>MACSYM.MAC.3,  6-Sep-78 16:28:36, EDIT BY OSMAN
;CHANGE BREAK SET MACROS TO HAVE DOTS IN THEM.   ADD BRMSK.
;<4.UTILITIES>MACSYM.MAC.2,  3-Sep-78 12:35:16, EDIT BY OSMAN
;ADD MACROS FOR DEFINING 128-BIT CHARACTER BREAK MASKS

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1990.
;	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.

	SUBTTL COPYRIGHT MACROS

DEFINE COPYRT (YEAR),<
	ASCIZ /
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 'YEAR'.
ALL RIGHTS RESERVED.
/>				;[7.1236]

DEFINE .CPYRT (.YEAR),<		;;Don't assemble into .EXE
	XLIST
	LOC 0
	COPYRT .YEAR
     .IFN .,ABSOLUTE,<PRINTX ?.CPYRT, COPYRIGHT IS NOT ABSOLUTE>
     IFGE .-^O22,<PRINTX %COPYRIGHT DOESN'T FIT IN SINGLE REL BLOCK>
	RELOC
	LIST
	SALL
>

IFNDEF .MCVWH,<.MCVWH==7>	;[T36] WHO LAST CHANGED MACSYM
IFNDEF .MCVMA,<.MCVMA==7>	;MAJOR VERSION NUMBER
IFNDEF .MCVMI,<.MCVMI==0>	;MINOR VERSION NUMBER
IFNDEF .MCVED,<.MCVED==^D1022>	;[T36] EDIT NUMBER (INCREMENTED ON EACH EDIT)
MACVER==<<.MCVWH>B2!<.MCVMA>B11!<.MCVMI>B17!<.MCVED>B35>

IFNDEF REL,<REL==0>		;UNIVERSAL UNLESS OTHERWISE DECLARED
   IFE REL,<
	UNIVERSAL MACSYM	COMMON MACROS AND SYMBOLS
	.DIRECTIVE .NOBIN
   >
   IFN REL,<
	TITLE MACREL		SUPPORT CODE FOR MACSYM
	SEARCH MONSYM
	COPYRT <1990>		;[9162][7.1236]
	SALL
   >

;THE STANDARD VERSION WORD CONSTRUCTION
; VERS - PROGRAM VERSION NUMBER
; VUPDAT - PROGRAM UPDATE NUMBER (1=A, 2=B ...)
; VEDIT - PROGRAM EDIT NUMBER
; VCUST - CUSTOMER EDIT CODE (0=DEC DEVELOPMENT, 1=DEC SWS, 2-7 CUST)

DEFINE PGVER.	(VERS,VUPDAT,VEDIT,VCUST)<
	..PGV0==.		;;SAVE CURRECT LOCATION AND MODE
	.JBVER=:^O137		;;WHERE TO PUT VERSION
	LOC	.JBVER		;;PUT VERSION IN STANDARD PLACE
	BYTE	(3)VCUST(9)VERS(6)VUPDAT(18)VEDIT
	.ORG	..PGV0		;;RESTORE LOCATION AND MODE
>

;MASKS FOR THE ABOVE

VI%WHO==:7B2			;Customer edit code
VI%MAJ==:777B11			;Major version number
VI%MIN==:77B17			;Minor version/update
VI%EDN==:377777B35		;Edit number
VI%DEC==:1B18			;Decimal
;ADDED VI%XXX
	SUBTTL COMMON DEFS

;DEFINE STANDARD AC'S

DEFINE STDAC. <
F=:0
T1=:1
T2=:2
T3=:3
T4=:4
Q1=:5
Q2=:6
Q3=:7
P1=:10
P2=:11
P3=:12
P4=:13
P5=:14
P6=:15
CX=:16
P=:17
>
	SUBTTL MISC CONSTANTS

;MISC CONSTANTS

.INFIN==:377777,,777777		;PLUS INFINITY
.MINFI==:1B0			;MINUS INFINITY
.LHALF==:777777B17		;LEFT HALF
.RHALF==:777777			;RIGHT HALF
.FWORD==:-1			;FULL WORD
	SUBTTL	SYMBOLS FOR THE CONTROL CHARACTERS

.CHNUL==:000			;NULL
.CHCNA==:001
.CHCNB==:002
.CHCNC==:003
.CHCND==:004
.CHCNE==:005
.CHCNF==:006
.CHBEL==:007			;BELL
.CHBSP==:010			;BACKSPACE
.CHTAB==:011			;TAB
.CHLFD==:012			;LINE-FEED
.CHVTB==:013			;VERTICAL TAB
.CHFFD==:014			;FORM FEED
.CHCRT==:015			;CARRIAGE RETURN
.CHCNN==:016
.CHCNO==:017
.CHCNP==:020
.CHCNQ==:021
.CHCNR==:022
.CHCNS==:023
.CHCNT==:024
.CHCNU==:025
.CHCNV==:026
.CHCNW==:027
.CHCNX==:030
.CHCNY==:031
.CHCNZ==:032
.CHESC==:033			;ESCAPE
.CHCBS==:034			;CONTROL BACK SLASH
.CHCRB==:035			;CONTROL RIGHT BRACKET
.CHCCF==:036			;CONTROL CIRCUMFLEX
.CHCUN==:037			;CONTROL UNDERLINE
.CHSPC==:040			;SPACE
.CHDAS==:055			;[8849] Dash character (-)
.CHHYP==:055			;[8849] A.K.A. hyphen
.CHSEM==:073			;[7.1168] Semi-colon

.CHALT==:175			;OLD ALTMODE
.CHAL2==:176			;ALTERNATE OLD ALTMODE
.CHDEL==:177			;DELETE
	SUBTTL	HARDWARE BITS OF INTEREST TO USERS

;PC FLAGS

PC%OVF==:1B0			;OVERFLOW
PC%CY0==:1B1			;CARRY 0
PC%CY1==:1B2			;CARRY 1
PC%FOV==:1B3			;FLOATING OVERFLOW
PC%BIS==:1B4			;BYTE INCREMENT SUPPRESSION
PC%USR==:1B5			;USER MODE
PC%UIO==:1B6			;USER IOT MODE
PC%LIP==:1B7			;LAST INSTRUCTION PUBLIC
PC%AFI==:1B8			;ADDRESS FAILURE INHIBIT
PC%ATN==:3B10			;APR TRAP NUMBER
PC%FUF==:1B11			;FLOATING UNDERFLOW
PC%NDV==:1B12			;NO DIVIDE
	SUBTTL
;THE FOLLOWING MACRO MAY BE USED TO SUPPRESS CREF ENTRIES FOR
;ALL THE JUNK SYMBOLS USED INTERNALLY WITHIN MACROS IN MACSYM

DEFINE .XCMSY <
	.XCREF
	.XCRF1 <..ACT,..CSC,..CSN,..IFT,..JX1,..MSK,..MX1,..MX2>
	.XCRF1 <..NAC,..NRGS,..NS,..NV,..PST,..STKN,..STKQ,..STKR>
	.XCRF1 <..TRR,..TSA1,..TX1,..TX2,.FP,.FPAC,.NAC,.SAC,.SAV1>
	.XCRF1 <.SAV2,.SAV3,POINTR,POS,WID,..CAS1,..CNS,..CNS2>
	.XCRF1 <..DPB,..GNCS,..ICNS,..JE,..LDB,..STR0,..STR1,..STR2>
	.XCRF1 <..STR4,..TQO,..TQZ,..TSAC,..TSIZ,..TX,..TY,.ACV1,.ACV2>
	.XCRF1 <.ACV3,.CASE,.DECR0,.IF0,.INCR0,.OPST1,.OPST2,.STKV1>
	.XCRF1 <.STKV2,.STKV3,.TRV1,.TRV2,.TRV3>
	.CREF
   >


DEFINE .XCRF1 (SYMS)<
	IRP SYMS,<
	 IFDEF SYMS,< .XCREF SYMS>>>
	SUBTTL	MACROS FOR FIELD MASKS

;STANDARD MACROS

;Macro to show binary value in assembly listing.  Must be
;used as last thing in macro definition with no CR before
;closing bracket.

DEFINE SHOW. (SYM)<
	....Z=SYM>

;MACROS TO HANDLE FIELD MASKS

;COMPUTE LENGTH OF MASK, I.E. LENGTH OF LEFTMOST STRING OF ONES
;REMEMBER THAT ^L DOES 'JFFO', I.E. HAS VALUE OF FIRST ONE BIT IN WORD

;COMPUTE WIDTH OF MASK, I.E. LENGTH OF LEFTMOST STRING OF ONES

DEFINE WID(MASK)<<^L<-<<MASK>_<^L<MASK>>>-1>>>

;COMPUTE POSITION OF MASK, I.E. BIT POSITION OF RIGHTMOST ONE IN MASK

DEFINE POS(MASK)<<^L<<MASK>&<-<MASK>>>>>

;CONSTRUCT BYTE POINTER TO MASK

DEFINE POINTR(LOC,MASK)<<POINT WID(<MASK>),LOC,POS(<MASK>)>>

;PUT RIGHT-JUSTIFIED VALUE INTO FIELD SPECIFIED BY MASK

DEFINE FLD(VAL,MSK)<<<<VAL>B<POS(<MSK>)>>&<MSK>>>

;MAKE VALUE BE RIGHT JUSTIFIED IN WORD.

DEFINE .RTJST(VAL,MSK)<<<<VAL>&<MSK>>B<^D70-POS(<MSK>)>>>

;CONSTRUCT MASK FROM BIT AA TO BIT BB. I.E. MASKB 0,8 = 777B8

DEFINE MASKB(AA,BB)<<1B<<AA>-1>-1B<BB>>>

;MODULO - GIVES REMAINDER OF DEND DIVIDED BY DSOR

DEFINE MOD.(DEND,DSOR)<<<DEND>-<<DEND>/<DSOR>>*<DSOR>>>
	SUBTTL
;REPEAT WITH SUBSTITUTION OF NUMERIC INDEX

DEFINE FORN. (LOW,HIGH,ARGS,STRING,%MN1)<
  DEFINE %MN1(ARGS)<STRING>
..FORN==LOW
REPEAT HIGH-LOW+1,<
	.FORN1 (%MN1)
	..FORN=..FORN+1>
  .XCREF %MN1 >			;;[T36] 

DEFINE .FORN1 (MACN)<
	MACN (\..FORN)>

;REPEAT WITH GENERAL STRING SUBSTITUTION

DEFINE FORX. (ARGS,SYMS,STRING,%MN1)<
  DEFINE %MN1 (SYMS)<STRING>
  IRP ARGS,<
	.FORX1 %MN1,ARGS>
  .XCREF %MN1 >			;;[T36] 

  DEFINE .FORX1 (MACN,ARGS)<
	MACN ARGS>

;DO WITH NUMERIC STRING SUBSTITUTION

DEFINE FORS. (NUM,ARG,STRING)<
  DEFINE %MN1 (ARG)<STRING>
	..FORN==NUM		;;EVALUATE EXPRESSION
	.FORN1 (%MN1)>		;;TRANSLATE AND EXPAND

	SUBTTL MAKRM. - Make remote macros.

;Macro to define a set of remote macros.  You say MAKRM. (XX,YY).
;This defines macros called XX and YY and one other.
;Then, you say XX <stuff> one
;or more times to save 'stuff'.  Finally, you say YY, and that
;expands as all of the 'stuff' that you previously saved.

DEFINE MAKRM. (XX,YY,%INT)<
  DEFINE XX (STUFF)<
	%INT (<STUFF>,)>

  DEFINE %INT (NEW,OLD)<
    DEFINE XX (STUFF)<
	%INT (<STUFF>,<OLD'NEW>)>>

  DEFINE YY <
    DEFINE %INT (NEW,OLD)<OLD>
	XX ()>

  .XCREF %INT			;;[T36] 
>
	SUBTTL MOVX

;MOVX - LOAD AC WITH CONSTANT

DEFINE MOVX (AC,MSK)<
   ..MX1==MSK			;;EVAL EXPRESSION IF ANY
   .IFN ..MX1,ABSOLUTE,<
	MOVE AC,[MSK]>
   .IF ..MX1,ABSOLUTE,<
	..MX2==0		;;FLAG SAYS HAVEN'T DONE IT YET
	IFE <..MX1>B53,<
	  ..MX2==1
	  MOVEI AC,..MX1>	;;LH 0, DO AS RH
	IFE ..MX2,<		;;IF HAVEN'T DONE IT YET,
	IFE <..MX1>B17,<
	  ..MX2==1
	  MOVSI AC,(..MX1)>>	;;RH 0, DO AS LH
	IFE ..MX2,<		;;IF HAVEN'T DONE IT YET,
	IFE <<..MX1>B53-^O777777>,<
	  ..MX2==1
	  HRROI AC,<..MX1>>>	;;LH -1
	IFE ..MX2,<		;;IF HAVEN'T DONE IT YET,
	IFE <<..MX1>B17-^O777777B17>,<
	  ..MX2==1
	  HRLOI AC,(..MX1-^O777777)>> ;;RH -1
	IFE ..MX2,<		;;IF STILL HAVEN'T DONE IT,
	  MOVE AC,[..MX1]>	;;GIVE UP AND USE LITERAL
  >>

;MV., MVI. - Move from memory to memory or immediate to memory

DEFINE MV. (FROM,TOO)<
	MOVE .SAC,FROM
	MOVEM .SAC,TOO>

DEFINE MVI. (STUFF,DEST)<
	MOVX .SAC,<STUFF>
	MOVEM .SAC,DEST>
;VARIENT MNEMONICS FOR TX DEFINITIONS

DEFINE IORX (AC,MSK)<
	TXO AC,<MSK>>

DEFINE ANDX (AC,MSK)<
	TXZ AC,<^-<MSK>>>

DEFINE XORX (AC,MSK)<
	TXC AC,<MSK>>
	SUBTTL TX -- TEST MASK

;CREATE THE TX MACRO DEFINITIONS

;THIS DOUBLE IRP CAUSES ALL COMBINATIONS OF MODIFICATION AND TESTING
;TO BE DEFINED

DEFINE ..DOTX (M,T)<
	IRP M,<
	IRP T,<
	  DEFINE TX'M'T (AC,MSK)<
		..TX(M'T,AC,<MSK>)>>>>

	..DOTX (<N,O,Z,C>,<,E,N,A>) ;DO ALL DEFINITIONS
	PURGE ..DOTX

;..TX
;ALL TX MACROS JUST CALL ..TX WHICH DOES ALL THE WORK

DEFINE ..TX(MT,AC,MSK)<
   ..TX1==MSK			;;EVAL EXPRESSION IF ANY
   .IFN ..TX1,ABSOLUTE,<
	TD'MT AC,[MSK]>
   .IF ..TX1,ABSOLUTE,<		;;MASK MUST BE TESTABLE
	..TX2==0		;;FLAG SAYS HAVEN'T DONE IT YET
	IFE <..TX1&^O777777B17>,<
	  ..TX2==1		;;LH 0, DO AS RH
	  TR'MT AC,..TX1>
	IFE ..TX2,<		;;IF HAVEN'T DONE IT YET,
	IFE <..TX1&^O777777>,<
	  ..TX2==1		;;RH 0, DO AS LH
	  TL'MT AC,(..TX1)>>
	IFE ..TX2,<		;;IF HAVEN'T DONE IT YET,
	  IFE <<..TX1>B53-^O777777>,< ;;IF LH ALL ONES,
	    ..TX3 (MT,AC)>>	;;TRY Z,O,C SPECIAL CASES
	IFE ..TX2,<		;;IF HAVEN'T DONE IT YET,
	  IFE <..TX1+1>,<	;;TRY WORD ALL ONES
	    ..TX4 (MT,AC)>>
	IFE ..TX2,<		;;IF STILL HAVEN'T DONE IT,
	  TD'MT AC,[..TX1]>	;;MUST GIVE UP AND USE LITERAL
  >>
;SPECIAL CASE FOR LH ALL ONES

DEFINE ..TX3 (MT,AC)<
	IFIDN <MT><Z>,<		;;IF ZEROING WANTED
	  ..TX2==1
	  ANDI AC,^-..TX1>	;;CAN DO IT WITH ANDI
	IFIDN <MT><O>,<		;;IF SET TO ONES WANTED
	  ..TX2==1
	  ORCMI AC,^-..TX1>	;;CAN DO IT WITH IORCM
	IFIDN <MT><C>,<		;;IF COMPLEMENT WANTED
	  ..TX2==1
	  EQVI AC,^-..TX1>>	;;CAN DO IT WITH EQV

;SPECIAL CASE OF WORD ALL ONES

DEFINE ..TX4 (MT,AC)<
	IFIDN <MT><NN>,<
	  ..TX2==1
	  CAIN AC,0>		;;CAN DO FULL WORD COMPARE
	IFIDN <MT><NE>,<
	  ..TX2==1
	  CAIE AC,0>>
	SUBTTL JX -- JUMP ON MASK

;JXE -- JUMP IF MASKED BITS ARE EQUAL TO 0
;JXN -- JUMP IF MASKED BITS ARE NOT EQUAL TO 0
;JXO -- JUMP IF MASKED BITS ARE ALL ONES
;JXF -- JUMP IF MASKED BITS ARE NOT ALL ONES (FALSE)

DEFINE JXE (AC,MSK,BA)<
	..JX1==MSK		;;EVAL EXPRESSION IF ANY
	.IFN ..JX1,ABSOLUTE,<PRINTX MSK NOT ABSOLUTE
		..JX1==0>
	.IF ..JX1,ABSOLUTE,<
	.IF0 <<..JX1>-1B0>,<	;;IF MASK IS JUST B0,
		JUMPGE AC,BA>,<
	.IF0 <<..JX1>+1>,<	;;IF MASK IF FULL WORD,
	  JUMPE AC,BA>,<	;;USE GIVEN CONDITION
		TXNN (AC,..JX1)
		JRST BA>>>>

DEFINE JXN (AC,MSK,BA)<
	..JX1==MSK		;;EVAL EXPRESSION IF ANY
	.IFN ..JX1,ABSOLUTE,<PRINTX MSK NOT ABSOLUTE
		..JX1==0>
	.IF ..JX1,ABSOLUTE,<
	.IF0 <<..JX1>-1B0>,<	;;IF MASK IS JUST B0,
		JUMPL AC,BA>,<
	.IF0 <<..JX1>+1>,<	;;IF MASK IF FULL WORD,
	  JUMPN AC,BA>,<	;;USE GIVEN CONDITION
		TXNE (AC,..JX1)
		JRST BA>>>>

DEFINE JXO (AC,MSK,BA)<
	..JX1==MSK		;;EVAL EXPRESSION
	.IFN ..JX1,ABSOLUTE,<PRINTX MSK NOT ABSOLUTE
		..JX1==0>
	.IF ..JX1,ABSOLUTE,<
	.IF0 <<..JX1>-1B0>,<
		JUMPL AC,BA>,<
	..ONEB (..BT,MSK)	;;TEST MASK FOR ONLY ONE BIT ON
	.IF0 ..BT,<
	  SETCM .SAC,AC		;;GENERAL CASE, GET COMPLEMENTS OF BITS
	  JXE (.SAC,..JX1,BA)>,< ;;JUMP IF BITS WERE ORIGINALLY ONES
	    TXNE AC,..JX1	;;TEST AND JUMP
	    JRST BA>>>>

DEFINE JXF (AC,MSK,BA)<
	..JX1==MSK		;;EVAL EXPRESSION
	.IFN ..JX1,ABSOLUTE,<PRINTX MSK NOT ABSOLUTE
		..JX1==0>
	.IF ..JX1,ABSOLUTE,<
	.IF0 <<..JX1>-1B0>,<
		JUMPGE AC,BA>,<
	..ONEB (..BT,MSK)	;;TEST MASK FOR ONLY ONE BIT ON
	.IF0 ..BT,<
	  SETCM .SAC,AC		;;GENERAL CASE, GET COMPLEMENT OF BITS
	  JXN (.SAC,..JX1,BA)>,< ;;JUMP IF SOME ZEROS ORIGINALLY
	    TXNN AC,..JX1	;;TEST AND JUMP
	    JRST BA>>>>
	SUBTTL	MACSYM Definitions -- CAXxx

;GENERATE CAI OR CAM AS APPROPRIATE

DEFINE	CAX	(AC,VAL),<OP%%CA (AC,VAL,)>
DEFINE	CAXL	(AC,VAL),<OP%%CA (AC,VAL,L)>
DEFINE	CAXLE	(AC,VAL),<OP%%CA (AC,VAL,LE)>
DEFINE	CAXE	(AC,VAL),<OP%%CA (AC,VAL,E)>
DEFINE	CAXG	(AC,VAL),<OP%%CA (AC,VAL,G)>
DEFINE	CAXGE	(AC,VAL),<OP%%CA (AC,VAL,GE)>
DEFINE	CAXN	(AC,VAL),<OP%%CA (AC,VAL,N)>
DEFINE	CAXA	(AC,VAL),<OP%%CA (AC,VAL,A)>

DEFINE	OP%%CA	(AC,VALUE,CODE),<
	.XCREF
IFE	<<VALUE>_-^D18>,<
	.CREF
	CAI'CODE	AC,<VALUE>
	.XCREF
>
IFN	<<VALUE>_-^D18>,<
	.CREF
	CAM'CODE	AC,[VALUE]
	.XCREF
>
	.CREF>
;GENERATE IMMEDIATE OR MEMORY CONSTANTS

DEFINE	ADDX	(AC,VAL),<OP%%IA	(AC,VAL,ADD,SUB)>
DEFINE	SUBX	(AC,VAL),<OP%%IA	(AC,VAL,SUB,ADD)>
DEFINE	MULX	(AC,VAL),<OP%%IN	(AC,VAL,MUL)>
DEFINE	IMULX	(AC,VAL),<OP%%IN	(AC,VAL,IMUL)>
DEFINE	DIVX	(AC,VAL),<OP%%IN	(AC,VAL,DIV)>
DEFINE	IDIVX	(AC,VAL),<OP%%IN	(AC,VAL,IDIV)>

DEFINE	OP%%IA	(AC,VALUE,CODE,ALT),<
	.XCREF
	TEST%%=0
IFE	<<<VALUE>_-^D18>-^O777777>,<
IFN	<<VALUE>&^O777777>,<
	TEST%%=1
	.CREF
	ALT'I	AC,-<VALUE>
	.XCREF
>>
IFE	TEST%%,<
	OP%%IN	AC,<VALUE>,CODE
>
	PURGE	TEST%%
	.CREF>

DEFINE	OP%%IN	(AC,VALUE,CODE),<
	.XCREF
IFE	<<VALUE>_-^D18>,<
	.CREF
	CODE'I	AC,<VALUE>
	.XCREF
>
IFN	<<VALUE>_-^D18>,<
	.CREF
	CODE	AC,[VALUE]
	.XCREF
>
	.CREF>
;GENERATE IMMEDIATE OR MEMORY FOR FLOATING POINT

DEFINE	FADRX	(AC,VAL),<OP%%FP	(AC,VAL,FADR)>
DEFINE	FSBRX	(AC,VAL),<OP%%FP	(AC,VAL,FSBR)>
DEFINE	FMPRX	(AC,VAL),<OP%%FP	(AC,VAL,FMPR)>
DEFINE	FDVRX	(AC,VAL),<OP%%FP	(AC,VAL,FDVR)>

DEFINE	OP%%FP	(AC,VALUE,CODE),<
	.XCREF
IFE	<<VALUE>_^D18>,<
	.CREF
	CODE'I	AC,(VALUE)
	.XCREF
>
IFN	<<VALUE>_^D18>,<
	.CREF
	CODE	AC,[VALUE]
	.XCREF
>
	.CREF>
	SUBTTL SUBFUNCTION MACROS

;.IF0 CONDITION, ACTION IF CONDITION 0, ACTION OTHERWISE

DEFINE .IF0 (COND,THEN,ELSE)<
	..IFT==COND		;;GET LOCAL VALUE FOR CONDITION
	IFE ..IFT,<
	THEN
	..IFT==0>		;;RESTORE IN CASE CHANGED BY NESTED .IF0
	IFN ..IFT,<
	ELSE>>

;CASE (NUMBER,<FIRST,SECOND,...,NTH>)

DEFINE .CASE (NUM,LIST)<
	..CSN==NUM
	..CSC==0
	IRP LIST,<
	IFE ..CSN-..CSC,<
	  STOPI
	  ..CAS1 (LIST)>
	..CSC==..CSC+1>>

DEFINE ..CAS1 (LIST)<
	LIST>

;TEST FOR FULL WORD, RH, LH, OR ARBITRARY BYTE

DEFINE ..TSIZ (SYM,MSK)<
	SYM==3			;;ASSUME BYTE UNLESS...
	IFE <MSK>+1,<SYM=0>	;;FULL WORD IF MASK IS -1
	IFE <MSK>-^O777777,<SYM==1> ;;RH IF MASK IS 777777
	IFE <MSK>-^O777777B17,<SYM==2>> ;;LH IF MAST IS 777777,,0

;TEST FOR LOC BEING AN AC -- SET SYM TO 1 IF AC, 0 IF NOT AC

DEFINE ..TSAC (SYM,LOC)<
	SYM==0			;;ASSUME NOT AC UNLESS...
	..TSA1==<Z LOC>		;;LOOK AT LOC
	.IF ..TSA1,ABSOLUTE,<	;;SEE IF WE CAN TEST VALUE
	  IFE ..TSA1&^O777777777760,<SYM==1>> ;;AC IF VALUE IS 0-17
	>

;TEST FOR SPECIFIC NTH CHARACTER OF ARG

DEFINE ..TSNC (SYM,NTH,STR,CH)<
	SYM==0			;;ASSUME NO
	..TSA1==0		;;COUNT CHARS
	IRPC STR,<
	  ..TSA1=..TSA1+1
	  IFE ..TSA1-NTH,<
	   IFIDN <STR><CH>,<
		SYM==1>		;;YES
	   STOPI>>>

;FUNCTION TO TEST FOR MASK CONTAINING EXACTLY ONE BIT. RETURNS
;1 IFF LEFTMOST BIT AND RIGHTMOST BIT ARE SAME

DEFINE ..ONEB (SYM,MSK)<
	SYM==<<<-<MSK>>&<MSK>>&<1B<^L<MSK>>>>>

;DEFAULT SCRACH AC

.SAC=16
	SUBTTL DEFSTR -- DEFINE DATA STRUCTURE

;DEFINE DATA STRUCTURE
; NAM - NAME OF STRUCTURE AS USED IN CODE
; ****** NOTE THAT THE NAMES OF STRUCTURES USED MUST BE ******
; ****** UNIQUE IN THE FIRST 5 CHARACTERS, FOR BOTH DEFSTR & MSKSTR ******
; LOCN - ADDRESS OF DATA
; POS - POSITION OF DATA WITHIN WORD (RIGHTMOST BIT NUMBER)
; SIZ - SIZE OF DATA (IN BITS) WITHIN WORD

DEFINE DEFSTR (NAM,LOCN,POS,SIZ)<
	NAM==<-1B<POS>+1B<POS-SIZ>> ;;ASSIGN SYMBOL TO HOLD MASK
	IF1,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
	DEFINE %'NAM (OP,AC,Y,MSK)<
	$'NAM==<Z LOCN>		;;LOCATION SYMBOL FOR DDT
	OP (<AC>,LOCN''Y,MSK)>>	;;DEFINE MACRO TO HOLD LOCATION

;EXTENDED DEFSTR - REQUIRED IF LOCATION IS IN DIFFERENT SECTION

DEFINE EDEFST (NAM,LOCN,POS,SIZ)<
	NAM==<-1B<POS>+1B<POS-SIZ>> ;;ASSIGN SYMBOL TO HOLD MASK
	IF1,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
	DEFINE %'NAM (OP,AC,Y,MSK)<
	OP (<AC>,<@[EP. LOCN''Y]>,MSK)>> ;;DEFINE MACRO TO HOLD LOCATION

;ALTERNATE FORM OF DEFSTR -- TAKES MASK INSTEAD OF POS,SIZ

DEFINE MSKSTR (NAM,LOCN,MASK)<
	NAM==MASK		;;ASSIGN SYMBOL TO HOLD MASK
	IF1,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
	DEFINE %'NAM (OP,AC,Y,MSK)<
	$'NAM==<Z LOCN>		;;LOCATION SYMBOL FOR DDT
	OP (<AC>,LOCN''Y,MSK)>>	;;DEFINE MACRO TO HOLD LOCATION

DEFINE EMSKST (NAM,LOCN,MASK)<
	NAM==MASK		;;ASSIGN SYMBOL TO HOLD MASK
	IF1,<IFDEF %'NAM,<PRINTX ?NAM ALREADY DEFINED>>
	DEFINE %'NAM (OP,AC,Y,MSK)<
	OP (<AC>,<@[EP. LOCN''Y]>,MSK)>> ;;DEFINE MACRO TO HOLD LOCATION

;..STR0 - PROCESS INSTANCE OF STRUCTURE USAGE, SINGLE STRUCTURE CASE.

DEFINE ..STR0 (OP,AC,STR,Y)<
	IFNDEF STR,<PRINTX ?STR IS NOT DEFINED
	  OP (<AC>,<Y>,.FWORD)>	;;RESERVE A WORD, ASSUME WORD MASK
	IFDEF STR,<
	IFNDEF %'STR,<
	  OP (<AC>,<Y>,STR)>	;;ASSUME NO OTHER LOCN
	IFDEF %'STR,<
	  %'STR (OP,<AC>,<Y>,STR)>>> ;;DO IT
;..STR1, ..STR2, ..STR3, AND ..STR4 ARE INTERNAL MACROS FOR PROCESSING
;INSTANCES OF STRUCTURE USAGE.

DEFINE ..STR1 (OP,AC,STR,Y,CLL)<
	..NS==0			;;INIT COUNT OF STR'S
	IRP STR,<..NS=..NS+1>	;;COUNT STR'S
	IFE ..NS,<PRINTX ?EMPTY STRUCTURE LIST, OP>
	IFE ..NS-1,<		;;THE ONE CASE, CAN DO FAST
	  ..STR0 (OP,<AC>,<STR>,<Y>)>
	IFG ..NS-1,<		;;MORE THAN ONE, DO GENERAL CASE
	..ICNS			;;INIT REMOTE MACRO
	..CNS (<CLL (OP,<AC>,,>) ;;CONS ON CALL AND FIRST ARGS
	IRP STR,<		;;DO ALL NAMES IN LIST
	  IFNDEF STR,<PRINTX STR NOT DEFINED>
	  IFDEF STR,<
	  IFNDEF %'STR,<
	  ..CNS (<,STR,Y>)>	;;ASSUME NO OTHER LOCN
	  IFDEF %'STR,<
	  %'STR (..STR2,,<Y>,STR)> ;;STR MACRO WILL GIVE LOCN TO ..STR2
	  ..CNS (<)>)		;;CLOSE ARG LIST
	  ..GCNS		;;DO THIS AND PREVIOUS NAME
	  ..ICNS		;;REINIT CONS
	  ..CNS (<CLL (OP,<AC>>) ;;PUT ON FIRST ARGS
	  IFNDEF %'STR,<
	  ..CNS (<,STR,Y>)>	;;ASSUME NO OTHER LOCN
	  IFDEF %'STR,<
	  %'STR (..STR2,,<Y>,STR)>>> ;;PUT ON THIS ARG, END IRP
	..CNS (<,,)>)		;;CLOSE ARG LIST
	..GCNS>>		;;DO LAST CALL

;..STR2 -- CALLED BY ABOVE TO APPEND STRUCTURE NAME AND LOC TO ARG LIST

DEFINE ..STR2 (AA,LOC,STR)<
	..CNS (<,STR,LOC>)>	;;CONS ON NEXT ARG PAIR

;..STR3 -- CHECK FOR ALL STRUCTURES IN SAME REGISTER

DEFINE ..STR3 (OP,AC,S1,L1,S2,L2)<
	IFDIF <L1><L2>,<
	  IFNB <L1>,<
	    OP (<AC>,L1,..MSK)	;;DO ACCUMULATED STUFF
	    IFNB <L2>,<PRINTX S1 AND S2 ARE IN DIFFERENT WORDS>>
	  ..MSK==0>		;;INIT MASK
	IFNB <L2>,<
	  ..MSK=..MSK!<S2>>>

;..STR4 -- COMPARE SUCCESSIVE ITEMS, DO SEPARATE OPERATION IF
;DIFFERENT WORDS ENCOUNTERED

DEFINE ..STR4 (OP,AC,S1,L1,S2,L2)<
	IFDIF <L1><L2>,<	;;IF THIS DIFFERENT FROM PREVIOUS
	  IFNB <L1>,<
	    OP (<AC>,L1,..MSK)>	;;DO PREVIOUS
	  ..MSK==0>		;;REINIT MASK
	IFNB <L2>,<
	  ..MSK=..MSK!<S2>>>	;;ACCUMULATE MASK

;..STR5 - SAME AS ..STR4 EXCEPT GIVES EXTRA ARG IF MORE STUFF TO
;FOLLOW.

DEFINE ..STR5 (OP,AC,S1,L1,S2,L2)<
	IFDIF <L1><L2>,<	;;IF THIS DIFFERENT FROM PREVIOUS,
	  IFNB <L1>,<
	    IFNB <L2>,<		;;IF MORE TO COME,
		OP'1 (AC,L1,..MSK)> ;;DO VERSION 1
	    IFB <L2>,<		;;IF NO MORE,
		OP'2 (AC,L1,..MSK)>> ;;DO VERSION 2
	  ..MSK==0>		;;REINIT MASK
	IFNB <L2>,<
	  ..MSK=..MSK!<S2>>>	;;ACCUMULATE MASK

;'REMOTE' MACROS USED TO BUILD UP ARG LIST

;INITIALIZE CONS -- DEFINES CONS

DEFINE ..ICNS <
   DEFINE ..CNS (ARG)<
	..CNS2 <ARG>,>

   DEFINE ..CNS2 (NEW,OLD)<
	DEFINE ..CNS (ARG)<
	  ..CNS2 <ARG>,<OLD'NEW>>>
   >

;GET CONS -- EXECUTE STRING ACCUMULATED

DEFINE ..GCNS <
   DEFINE ..CNS2 (NEW,OLD)<
	  OLD>			;;MAKE ..CNS2 DO THE STUFF
	..CNS ()>		;;GET ..CNS2 CALLED WITH THE STUFF

;Structure Definition Macros
;
; Usage:
;
;	BEGSTR	XX,OFFSET,INDEX
;
;This  initializes  the  macros  to  define  offset symbols of the form
;XX.NAM; where NAM is the name of the individual field defined  by  the
;following  macro.  INDEX  specifies  an  optional  index  AC  that the
;structure will always be referenced by.
;
;	FIELD	NAME,WID,POS
;
;This  defines a field name (3 characters) which describes the field of
;width WID  and  position  POS.  POS  indicates  the  position  of  the
;rightmost  bit of the field, in decimal as for the POINT pseudo-op. If
;POS is left out, the macro will place the field in the next  available
;position  in  the word. If it doesn't fit in the word, it will start a
;new word, leaving the rest of the previous word unassigned.
;
;	FIELDM	NAME,MASK
;
;This  defines a field name just as FIELD, but with a specific mask. No
;attempt is made to reposition the field.
;
;	BIT	NAM
;
;BIT defines the next available bit in the previously defined field. In
;addition  to the normal mask XXNAM, a right justified symbol XX%NAM is
;defined which may be useful when  one  LOADs  the  flags  into  an  AC
;performs  some  operations on them (using the XX%NAM symbol) and later
;stores them. The field definition preceding the call to BIT must  have
;allocated enough room for all the BIT definitions following (up to the
;next FIELD).
;
;	FILLER	NUM
;
;FILLER  will  generate  a blank field of NUM bits. Useful for aligning
;fields.
;
;	NXTWRD	NUM
;
;NXTWRD  tells the macros that the next field definition should start a
;new word unconditionally. Giving NXTWRD NUM as an argument  will  skip
;NUM words without defining anything.
;
;	WORD	NAM,NUM
;
;This  will  define  a  single  word  (or NUM words) entry for NAM. Any
;unused bits in the previous word are left unassigned.
;
;	HWORD	NAM
;
;This  defines  a  half-word  (18  bit  field)  at  the  next available
;half-word boundary. Any unused bits in the previous half-word are left
;unassigned.
;
;	ENDSTR	NAM
;
;This  generates the symbol XX.NAM which is the length of the block. If
;NAM is omitted, XX.LEN is used.
;
;	FTSHOW
;
;This  symbol  is  a  feature  test  switch. If non-zero, the structure
;definitions will show their offsets and  masks  to  the  left  of  the
;definitions  in  a  compiled  listing.  See SHOW. macro for additional
;information and warnings.
;
;N.B.
;Data  locations  defined  by  these  macros  are  not guaranteed to be
;initialized to zero especially if FTSHOW is used.

	FTSHOW==1		;FTSHOW DEFAULTS TO TRUE


DEFINE	BEGSTR(XX,OFFSET<0>,INDEX,BEGNAM<BEG>),<
	IFN FTSHOW,..LOC==.


DEFINE	WORD(NAM,NUMB<1>),<
	IFN <..MSK>,<..OFF==..OFF+1> ;;IF THE MASK IS PARTIALLY USED, BUMP IT

	..MSK==0		;;RE-INITIALIZE THE MASK
	FIELDM(NAM,<.FWORD>)	;;DEFINE THE MASK, OFFSET AND MACRO

	..MSK==0		;;RE-INITIALIZE THE MASK
	..OFF==..OFF+NUMB	;;AND BUMP THE OFFSET

>;; END OF DEFINE WORD

DEFINE	NXTWRD(NUMB<1>),<
	..MSK==0
	..OFF=..OFF+NUMB

>;;END OF DEFINE NXTWRD

DEFINE	FILLER(NUM),<
	..FLG==POS(..MSK)
	IFE ..MSK,<..FLG==-1>
	IFG <^D<NUM>-<^D35-..FLG>>,<PRINTX ?FILL TOO BIG IN XX STRUCTURE>
	...MSK==MASK.(^D<NUM>,<..FLG+^D<NUM>>)
	IFN FTSHOW,<
	  PHASE ..OFF
	  EXP ...MSK
	>
	..MSK==..MSK!...MSK
>;;END OF DEFINE FILLER



DEFINE	HWORD(nam),<
	..FLG==0		;;HAVENT GOT ONE YET
	IFE ..MSK&.LHALF,<FIELDM(nam,.LHALF)
			  ..FLG==1>
	IFE ..FLG,<..MSK==..MSK!.LHALF
		   IFE ..MSK&.RHALF,<FIELDM(nam,.RHALF)
				     ..FLG==1>
		   IFE ..FLG,<NXTWRD
			      FIELDM(nam,.LHALF) >
		  >
>


DEFINE	FIELD(NAM,SIZ,POS),<
	..FLG==0		;;CLEAR THE "HAVE DEFINED FIELD" FLAG

	IFB <POS>,<IFB <SIZ>,<
	  ...MSK==.RTMSK(<<^-<<..MSK>>>>) ;;GET THE END OF THE CURRENT MASK
	  IFE ...MSK,<..OFF==..OFF+1 ;;IF NO BITS LEFT
	    ..MSK==0		;;USE ALL OF NEXT WORD
	    ...MSK==-1
	  >
	  FIELDM(NAM,<...MSK>)	;;IF NO SIZE, USE THE REST
	  ..FLG==-1		;;AND SAY WE HAVE ONE
	>>

	IFNB <SIZ>,<.SIZ==^D<SIZ>> ;;IF WE HAVE A SIZE, USE IT

	IFNB <POS>,<		;;HAVE A POSITION??
	  FIELDM(NAM,MASK.(.SIZ,POS)) ;;YES, MAKE THE THING
	  ..FLG==-1		;;SAY WE HAVE IT
	  ..BITS==MASK.(.SIZ,POS) ;;SET UP BITS FOR ..OLD
	>

	IFE ..FLG,<IFGE <^D<.SIZ>-^D36>,< ;;IS THIS A WORD??
	  WORD(NAM,<^D<.SIZ>/^D36>) ;;YES, DEFINE THE FIRST SECOND
	  IFN <<^D<.SIZ>-<^D<.SIZ>/^D36>*^D36>>,<	;;IS THERE MORE??
	    FIELD(...,<<^D<.SIZ>-<^D<.SIZ>/^D36>*^D36>>) ;;YES, GENERATE IT
	  >

	  ..FLG==-1		;;SET THE "HAVE IT" FLAG
	>>

	IFE ..FLG,<		;;HAVE A PLACE YET??
	  ..BITS==MASK.(^D<.SIZ>,<^D<.SIZ>-1>) ;;NO, GET A MASK

	  REPEAT <^D36-^D<.SIZ>+1>,< ;;FIND A PLACE IN THE WORD
	    IFE ..FLG,<	;;HAVE ONE YET??
	      IFE <..BITS&..MSK>,< ;;NO, THIS ONE WORK??
			..MSK==..MSK!..BITS ;;YES, SET THE MASK
		..FLG==-1 ;;AND FLAG WE HAVE ONE
	       > ;; END OF IFE <..BITS&..MSK>

	    IFE ..FLG,..BITS==..BITS_<-1> ;;MOVE OVER ONE BIT
	    >
	  >

	IFE ..FLG,<		;;HAVE A MASK YET??
	  ..BITS==MASK.(^D<.SIZ>,<^D<.SIZ>-1>) ;;NO, GET THE MASK AGAIN
	  ..OFF==..OFF+1	;;POINT TO NEXT WORD
	  ..MSK==..BITS		;;AND SET THE MASK
	>

	MSKSTR(XX''NAM,\..OFF'INDEX,..BITS) ;;DEFINE THE STRUCTURE
	XX'.'NAM==..OFF
	IFN FTSHOW,<
	  PHASE	XX'.'NAM
	  EXP	XX''NAM
	>>

	..OLD==..BITS		;;SAVE THE LAST MASK FOR BIT
	...OLD==..BITS		;; MACRO CALL

>;;END OF DEFINE FIELD

DEFINE	BIT(NAM),<
	..BITS==LFTBT.(..OLD)	;;GET THE LEFTMOST BIT (ONE I CAN USE)

	IFE ..BITS,<PRINTX ?NO ROOM FOR BIT IN LAST FIELD>

	XX'%'NAM==..BITS_<-<^D35-POS(...OLD)>> ;;MAKE RIGHT JUSTIFIED MASK
	XX'.'NAM==..OFF		;;MAKE UP LOC SYMBOL

	MSKSTR(XX''NAM,\..OFF'INDEX,..BITS) ;;DEFINE THE MASK AND MACRO
	IFN FTSHOW,<
	  PHASE ..OFF
	  EXP XX''NAM
	>

	..OLD==..OLD&<^-<..BITS>> ;;SHRINK THE MASK BY THE BIT WE USED

>;;END OF DEFINE BIT

DEFINE	FIELDM(NAM,MASK),<
	IFN MASK&..MSK,<	;;WILL THIS BYTE FIT IN THE CURRENT WORD??
	  ..MSK==0		;;NO, ADVANCE TO THE NEXT
	  ..OFF==..OFF+1
	>

	..MSK==..MSK!MASK	;;FLAG THE PART WE USED

	MSKSTR(XX''NAM,\..OFF'INDEX,MASK) ;;DEFINE IT
	XX'.'NAM==..OFF
	IFN FTSHOW,<
	  PHASE	XX'.'NAM
	  EXP	XX''NAM
	>
>;;END OF DEFINE FIELDM

DEFINE ENDSTR(LENNAM<LEN>,LSTNAM<LST>),<

	IFN ..MSK,<..OFF==..OFF+1> ;;BUMP THE OFFSET IF THERES SOME LEFT

	XX'.'LSTNAM==..OFF	;;SYMBOL FOR LAST ENTRY

	IFN FTSHOW,DEPHASE

	..LOK==..LOK+1
	IFN ..LOK,<PRINTX ? MISSING BEGSTR>

	IF2,<
	  IFDEF ...MSK,<SUPPRESS ...MSK>
	  IFDEF ..BITS,<SUPPRESS ..BITS>
	  IFDEF .SIZ,<SUPPRESS .SIZ>
	  IFDEF ..MSK,<SUPPRESS ..MSK>
	  IFDEF ..OFF,<SUPPRESS ..OFF>
	  IFDEF ..FLG,<SUPPRESS ..FLG>
	  IFDEF ..LOK,<SUPPRESS ..LOK>
	  IFDEF ..LOC,<SUPPRESS ..LOC>
	  IFDEF ..OLD,<SUPPRESS ..OLD>
	  IFDEF ...OLD,<SUPPRESS ...OLD>
	>

	IF1,<
	  IFDEF ...MSK,<.XCREF ...MSK>
	  IFDEF ..BITS,<.XCREF ..BITS>
	  IFDEF .SIZ,<.XCREF .SIZ>
	  IFDEF ..MSK,<.XCREF ..MSK>
	  IFDEF ..FLG,<.XCREF ..FLG>
	  IFDEF ..OFF,<.XCREF ..OFF>
	  IFDEF ..LOK,<.XCREF ..LOK>
	  IFDEF ..LOC,<.XCREF ..LOC>
	  IFDEF ..OLD,<.XCREF ..OLD>
	  IFDEF ...OLD,<.XCREF ...OLD>
	>

	PURGE WORD,NXTWRD,FILLER,HWORD,FIELD,BIT,FIELDM

	XX'.'LENNAM==..OFF-OFFSET
	IFN FTSHOW,<RELOC ..LOC>>

;;END OF DEFINE ENDSTR

	..MSK==0		;;INITIALIZE THE MASK
	..OFF==OFFSET		;;AND THE OFFSET
	XX'.'BEGNAM==OFFSET	;;SYMBOL FOR BEGINNING OFFSET

	IFDEF ..LOK,<IFL ..LOK,<PRINTX ? NEW BEGSTR WITHOUT ENDSTR>>

	..LOK==-1

>;;END OF DEFINE BEGSTR

;Special macros for the BEGSTR macros to use

DEFINE LFTBT.(MASK) <1_<^D35-^L<MASK>>>

DEFINE	MASK.(WID,POS),<<<<1_<WID>>-1>B<POS>>>
;;END OF DEFINE MASK.

DEFINE	.RTMSK(MASK),<
<IFE <<FILIN.(<MASK>)&<^-MASK>>>,<MASK>>!<IFN <<FILIN.(<MASK>)&<^-MASK>
>><<FILIN.(<<<RGHBT.(<<FILIN.(<MASK>)&<^-MASK>>>)>_-1>>!<RGHBT.(MASK)>)>>>>


;SPECIFIC CASES

;LOAD, STORE
; AC - AC OPERAND
; STR - STRUCTURE NAME
; Y - (OPTIONAL) ADDITIONAL SPECIFICATION OF DATA LOCATION

DEFINE LOAD (AC,STR,Y)<
	..STR0 (..LDB,AC,STR,<Y>)>

   DEFINE ..LDB (AC,LOC,MSK)<
	..TSIZ (..PST,MSK)
	.CASE ..PST,<<
		MOVE AC,LOC>,<
		HRRZ AC,LOC>,<
		HLRZ AC,LOC>,<
		LDB AC,[POINT WID(<MSK>),LOC,POS(<MSK>)]>>>

;LOADE is to LOAD as HRRE is to HRR
;LOADE is skippable, like other LOADs, at great expense in the LDB case

DEFINE LOADE (AC,STR,Y)<
	..STR0 (..LDBE,AC,STR,<Y>)>

   DEFINE ..LDBE (AC,LOC,MSK)<
	..TSIZ (..PST,MSK)
	.CASE ..PST,<<
		MOVE AC,LOC>,<
		HRRE AC,LOC>,<
		HLRE AC,LOC>,<
		JSP .SAC,[LDB AC,[POINT WID(<MSK>),LOC,POS(<MSK>)]
			  ..MSK==MASK.(WID(MSK),35)
			  TXNE AC,LFTBT.(..MSK)	;;TEST SIGN BIT OF BYTE
			  TXO AC,^-..MSK	;;NEG, ALL 1S IN REST
			  PURGE ..MSK
			  JRST (.SAC)]>>>

DEFINE STOR (AC,STR,Y)<
	..STR0 (..DPB,AC,STR,<Y>)>

   DEFINE ..DPB (AC,LOC,MSK)<
	..TSIZ (..PST,MSK)
	.CASE ..PST,<<
		MOVEM AC,LOC>,<
		HRRM AC,LOC>,<
		HRLM AC,LOC>,<
		DPB AC,[POINT WID(<MSK>),LOC,POS(<MSK>)]>>>

;SET TO ZERO

DEFINE SETZRO (STR,Y)<
	..STR1 (..TQZ,,<STR>,<Y>,..STR4)>

   DEFINE ..TQZ (AC,LOC,MSK)<
	..TSIZ (..PST,MSK)	;;SET ..PST TO CASE NUMBER
	.CASE ..PST,<<
		SETZM LOC>,<	;;FULL WORD
		HLLZS LOC>,<	;;RH
		HRRZS LOC>,<	;;LH
	  ..TSAC (..ACT,LOC)	;;SEE IF LOC IS AC
	  .IF0 ..ACT,<
		MOVX .SAC,MSK	;;NOT AC
		ANDCAM .SAC,LOC>,<
		..TX (Z,LOC,MSK)>>>>

;SET TO ONE

DEFINE SETONE (STR,Y)<
	..STR1 (..TQO,,<STR>,<Y>,..STR4)>

   DEFINE ..TQO (AC,LOC,MSK)<
	..TSIZ (..PST,MSK)
	.CASE ..PST,<<
		SETOM LOC>,<
		HLLOS LOC>,<
		HRROS LOC>,<
	  ..TSAC (..ACT,LOC)
	  .IF0 ..ACT,<
		MOVX .SAC,MSK
		IORM .SAC,LOC>,<
		..TX (O,LOC,MSK)>>>>

;SET TO COMPLEMENT

DEFINE SETCMP (STR,Y)<
	..STR1 (..TQC,,<STR>,<Y>,..STR4)>

   DEFINE ..TQC (AC,LOC,MSK)<
	..TSIZ (..PST,MSK)
	.IF0 ..PST,<		;;IF FULL WORD,
		SETCMM LOC>,<	;;CAN USE SETCMM
	  ..TSAC (..ACT,LOC)	;;OTHERWISE, CHECK FOR AC
	  .IF0 ..ACT,<
		MOVX .SAC,MSK
		XORM .SAC,LOC>,<
		..TX(C,LOC,MSK)>>>

;INCREMENT, DECREMENT FIELD

;***WARNING*** FIELD OVERFLOWS MAY OCCUR ********

DEFINE INCR (STR,Y)<
	..STR0 (.INCR0,,<STR>,<Y>)>

   DEFINE .INCR0 (AC,LOC,MSK)<
	..PST==MSK&<-MSK>	;;GET LOWEST BIT
	.IF0 ..PST-1,<
		AOS LOC>,<	;;BIT 35, CAN USE AOS
		MOVX .SAC,..PST	;;LOAD A ONE IN THE APPROPRIATE POSITION
		ADDM .SAC,LOC>>

DEFINE DECR (STR,Y)<
	..STR0 (.DECR0,,<STR>,<Y>)>

   DEFINE .DECR0 (AC,LOC,MSK)<
	..PST==MSK&<-MSK>
	.IF0 ..PST-1,<
		SOS LOC>,<	;;BIT 35, CAN USE SOS
		MOVX .SAC,-..PST ;;LOAD -1 IN APPROPRIATE POSITION
		ADDM .SAC,LOC>>

;GENERAL DEFAULT, TAKES OPCODE

DEFINE OPSTR (OP,STR,Y)<
	..STR0 (.OPST1,<OP>,<STR>,<Y>)>

   DEFINE .OPST1 (OP,LOC,MSK)<
	..TSIZ (..PST,MSK)
	.IF0 ..PST,<
		OP LOC>,<	;;FULL WORD, USE GIVEN OP DIRECTLY
		..LDB .SAC,LOC,MSK ;;OTHERWISE, GET SPECIFIED BYTE
		OP .SAC>>

DEFINE OPSTRM (OP,STR,Y)<
	..STR0 (.OPST2,<OP>,<STR>,<Y>)>

   DEFINE .OPST2 (OP,LOC,MSK)<
	..TSIZ (..PST,MSK)
	.IF0 ..PST,<
		OP LOC>,<	;;FULL WORD, USE OP DIRECTLY
		..LDB .SAC,LOC,MSK
		OP .SAC
		..DPB .SAC,LOC,MSK>>

;JUMP IF ALL FIELDS ARE 0 (ONE REGISTER AT MOST)

DEFINE JE (STR,Y,BA)<
	..STR1 (..JE,<BA>,<STR>,<Y>,..STR3)>

   DEFINE ..JE (BA,LOC,MSK)<
	..TSAC (..ACT,LOC)	;;SEE IF AC
	.IF0 ..ACT,<
	  ..TSIZ (..PST,MSK)	;;SEE WHICH CASE
	  .CASE ..PST,<<
		SKIPN LOC	;;FULL WORD, TEST IN MEMORY
		JRST BA>,<
		HRRZ .SAC,LOC	;;RIGHT HALF, GET IT
		JUMPE .SAC,BA>,<
		HLRZ .SAC,LOC	;;LEFT HALF, GET IT
		JUMPE .SAC,BA>,<
		MOVE .SAC,LOC	;;NOTA, GET WORD
		JXE (.SAC,MSK,<BA>)>>>,<
	  JXE (LOC,MSK,<BA>)>>

;JUMP IF NOT ALL FIELDS ARE 0 (ONE REGISTER AT MOST)

DEFINE JN (STR,Y,BA)<
	..STR1 (..JN,<BA>,<STR>,<Y>,..STR3)>

   DEFINE ..JN (BA,LOC,MSK)<
	..TSAC (..ACT,LOC)	;;SEE IF AC
	.IF0 ..ACT,<
	  ..TSIZ (..PST,MSK)
	  .CASE ..PST,<<
		SKIPE LOC	;;FULL WORD, TEST IN MEMORY
		JRST BA>,<
		HRRZ .SAC,LOC	;;RIGHT HALF, GET IT
		JUMPN .SAC,BA>,<
		HLRZ .SAC,LOC	;;LEFT HALF, GET IT
		JUMPN .SAC,BA>,<
		MOVE .SAC,LOC	;;NOTA, GET WORD
		JXN (.SAC,MSK,<BA>)>>>,<
	  JXN (LOC,MSK,<BA>)>>

;JOR - JUMP ON 'OR' OF ALL FIELDS

DEFINE JOR (STR,Y,BA)<
	..STR1 (..JN,<BA>,<STR>,<Y>,..STR4)>

;JNAND - JUMP ON NOT 'AND' OF ALL FIELDS

DEFINE JNAND (STR,Y,BA)<
	..STR1 (..JNA3,<BA>,<STR>,<Y>,..STR4)>

   DEFINE ..JNA3 (BA,LOC,MSK)<
	..TSAC (..ACT,LOC)
	.IF0 ..ACT,<
	  SETCM .SAC,LOC	;;NOT AC, GET COMPLEMENT OF WORD
	  JXN (.SAC,MSK,<BA>)>,<	;;JUMP IF ANY BITS ORIGINALLY OFF
	  JXF (LOC,MSK,<BA>)>>	;;DO AC CASE

;JAND - JUMP ON 'AND' OF ALL FIELDS

DEFINE JAND (STR,Y,BA,%TG)<
	..STR1 (..JAN,<%TG,<BA>>,<STR>,<Y>,..STR5)
%TG:!	.XCREF %TG >		;;[T36] 

   DEFINE ..JAN1 (BA1,BA2,LOC,MSK)<
	..JNA3 (BA1,LOC,MSK)>	;;DO JUMP NAND TO LOCAL TAG

   DEFINE ..JAN2 (BA1,BA2,LOC,MSK)<
	..TSAC (..ACT,LOC)
	.IF0 ..ACT,<
	  SETCM .SAC,LOC	;;NOT AC, GET COMPLEMENT OF WORD
	  JXE (.SAC,MSK,<BA2>)>,<	;;JUMP IF ALL BITS ORIGINALLY ONES
	  JXO (LOC,MSK,<BA2>)>> ;;DO AC CASE

;JNOR - JUMP ON NOT 'OR' OF ALL FIELDS

DEFINE JNOR (STR,Y,BA,%TG)<
	..STR1 (..JNO,<%TG,<BA>>,<STR>,<Y>,..STR5)
%TG:!	.XCREF %TG>		;;[T36] 

   DEFINE ..JNO1 (BA1,BA2,LOC,MSK)<
	..JN (BA1,LOC,MSK)>	;;DO JUMP OR TO LOCAL TAG

   DEFINE ..JNO2 (BA1,BA2,LOC,MSK)<
	..JE (<BA2>,LOC,MSK)>	;;DO JUMP NOR TO GIVEN TAG

;TEST AND MODIFY GROUP USING DEFINED STRUCTURES.  TEST-ONLY AND
;MODIFY-ONLY PROVIDED FOR COMPLETENESS.
;GENERATES EXACTLY ONE INSTRUCTION

DEFINE ..DOTY (M,T)<		;;MACRO TO DEFINE ALL CASES
	IRP M,<
	IRP T,<
	  DEFINE TQ'M'T (STR,Y)<
	    ..STR1 (..TY,M'T,<STR>,<Y>,..STR3)>>>>

	..DOTY (<N,O,Z,C>,<,E,N,A>) ;DO 16 DEFINES
	PURGE ..DOTY

;SPECIAL DEFINE FOR THE TWO CASES WHICH CAN TAKE MEMORY ARG
;*NOTE* MAY GENERATE MORE THAN ONE INSTRUCTION - CANNOT BE SKIPPED

DEFINE TMNE (STR,Y)<
	..STR1 (..TYNE,,<STR>,<Y>,..STR3)>

DEFINE ..TYNE (MT,LOC,MSK)<
	..TSAC (..ACT,LOC)	;;SEE IF LOC IS AC
	.IF0 ..ACT,<
	  ..JX1==MSK
	  .IF0 <..JX1-1B0>,<
		SKIPGE LOC>,<
	    .IF0 <..JX1+1>,<
		SKIPE LOC>,<
		MOVE .SAC,LOC
		TXNE .SAC,MSK>>>,<
		TXNE LOC,MSK>>

DEFINE TMNN (STR,Y)<
	..STR1 (..TYNN,,<STR>,<Y>,..STR3)>

DEFINE ..TYNN (MT,LOC,MSK)<
	..TSAC (..ACT,LOC)	;;SEE IF LOC IS AC
	.IF0 ..ACT,<
	  ..JX1==MSK
	  .IF0 <..JX1-1B0>,<
		SKIPL LOC>,<
	    .IF0 <..JX1+1>,<
		SKIPN LOC>,<
		MOVE .SAC,LOC
		TXNN .SAC,MSK>>>,<
		TXNN LOC,MSK>>

;ALL TY MACROS CALL ..TY AFTER INITIAL STRUCTURE PROCESSING

DEFINE ..TY (MT,LOC,MSK)<
	..TSAC (..ACT,LOC)	;;SEE IF LOC IS AC
	.IF0 ..ACT,<
		PRINTX ?TQ'MT - LOC NOT IN AC>,<
		TX'MT LOC,MSK>>
	SUBTTL BLOCK MACROS

;MACROS TO PROVIDE SOME BLOCK HANDLING OF CODE

;BLOCK., ENDBK. - Creates block within which stack variables, AC
;saving macros, etc. may be used.
;Control must flow into and out of block through BLOCK. and ENDBK. macros.
;Within block, RET or equivalent may be used to exit block.

DEFINE BLOCK. (%TGE)<
	..SVBK			;;SAVE CURRENT BLOCK
	XMOVEI .A16,%TGE	;;PUT DUMMY RETURN ON STACK
	PUSH P,.A16
  DEFINE ENDBK. <
	RET			;;POP STACK AND CONTINUE AT .+1
%TGE:!	.XCREF %TGE		;;[T36] DUMMY RETURNS COMES HERE
	.POPX>>			;;RESTORE DEFS

DEFINE ..SVBK (%SY1)<
	SYN ENDBK.,%SY1
	.PSHX <
	 SYN %SY1,ENDBK.>
	.XCREF %SY1 >		;;[T36] 

;DO. - LOOP STRUCTURE, DECLARES TOP OF LOOP
; LOOP. - JUMPS TO TOP OF LOOP
; EXIT. - EXITS LOOP
; TOP. - TAG AT TOP OF LOOP FOR JUMPS, E.G. SOJG T4,TOP.
; ENDLP. - TAG AT END OF LOOP FOR JUMPS, E.G. SOJL T4,ENDLP.

DEFINE DO. (%TGB,%TGE)<
	..SVLD			;;SAVE CURRENT BLOCK
%TGB:!	.XCREF %TGB		;;[T36] TOP OF LOOP
  DEFINE OD. <
%TGE:!	.XCREF %TGE		;;[T36] END OF LOOP
	.POPX>			;;RESTORE DEFS
  DEFINE LOOP. <
	JRST %TGB>		;;LOOP TO TOP
  DEFINE TOP. <%TGB>		;;LABEL AT TOP FOR JUMPS
  DEFINE ENDLP. <%TGE>		;;LABEL AT END FOR JUMPS
  DEFINE EXIT. <
	JRST %TGE>>		;;EXIT LOOP

DEFINE ENDDO. <
	OD.>

DEFINE ..SVLD (%SY1,%SY2,%SY3,%SY4,%SY5)<
	SYN OD.,%SY1
	SYN LOOP.,%SY2
	SYN TOP.,%SY3
	SYN EXIT.,%SY4
	SYN ENDLP.,%SY5
	.XCREF %SY1,%SY2,%SY3,%SY4,%SY5	;;[T36]	
	.PSHX <
	 SYN %SY1,OD.
	 SYN %SY2,LOOP.
	 SYN %SY3,TOP.
	 SYN %SY4,EXIT.
	 SYN %SY5,ENDLP.>
>

;IFNSK., IFSKP. - "IF NO SKIP", "IF SKIP"

;These macros cause the following code to be conditionally executed
;depending on whether the preceding instruction(s) skipped or not.
;The following code is ended with ENDIF., with ELSE. optional
;within the range.

;Note: both of these result in the same or fewer instructions than
;the use of literals to handle the same cases.
;Also, since the code is not in literals, the binary appears in the
;listing, and the code is easier to follow with DDT.
;If the preceding skip can be written in either sense, it is better
;to use IFSKP. because one fewer instructions will be generated.

;IFSKP. and IFNSK. have an alternate form where the consequence code
;is given as a macro argument.  In the normal case, no macro argument is given.

;"IF NO SKIP" CONSEQUENCE-CODE ALTERNATIVE-CODE
;If the instruction(s) preceding the macro does not skip, the 'consequence
; code' will be executed; otherwise (i.e. if the instruction skips) the
; 'alternative code' will be executed.

DEFINE IFNSK. (NSCOD,SKCOD,%TG1,%TG2)<
   IFB <NSCOD'SKCOD>,<		;;THE REGULAR FORM
	..SVDF			;;SAVE DEFINITIONS OF OUTER BLOCK
	TRNA			;;SKIP
	JRST %TG1		;;JUMP PAST CODE
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;SAVE THE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;SAVE THE END TAG
	>
   IFNB <NSCOD'SKCOD>,<		;;THE ALTERNATE FORM
	JRST %TG1		;;THE NOSKIP CASE
	SKCOD
	JRST %TG2
%TG1:!	NSCOD
%TG2:!	.XCREF %TG1,%TG2	;;[T36] 
>>

;If JSYS Error

DEFINE IFJER. (NSCOD,SKCOD,%TG1,%TG2,%TG3)<
   IFB <NSCOD'SKCOD>,<		;;THE REGULAR FORM
	..SVDF			;;SAVE DEFINITIONS OF OUTER BLOCK
	ERJMP %TG3		;;SKIP
	JRST %TG1		;;JUMP PAST CODE
%TG3:!
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;SAVE THE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;SAVE THE END TAG
	>
   IFNB <NSCOD'SKCOD>,<		;;THE ALTERNATE FORM
	ERJMP %TG1		;;THE NOSKIP CASE
	SKCOD
	JRST %TG2
%TG1:!	NSCOD
%TG2:!	.XCREF %TG1,%TG2,%TG3	;;[T36] 
>>

;VERSION OF JSYS ERROR HANDLER WHICH ALLOWS SPECIFICATION OF ERJMP TYPE.

DEFINE IFJE. (TYPE,NSCOD,SKCOD,%TG1,%TG2,%TG3)<
   IFB <NSCOD'SKCOD>,<		;;THE REGULAR FORM
	..SVDF			;;SAVE DEFINITIONS OF OUTER BLOCK
	ERJMP'TYPE %TG3		;;SKIP
	JRST %TG1		;;JUMP PAST CODE
%TG3:!
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;SAVE THE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;SAVE THE END TAG
	>
   IFNB <NSCOD'SKCOD>,<		;;THE ALTERNATE FORM
	ERJMP'TYPE %TG1		;;THE NOSKIP CASE
	SKCOD
	JRST %TG2
%TG1:!	NSCOD
%TG2:!	.XCREF %TG1,%TG2,%TG3	;;[T36] 
>>

;OBSOLETE NAME

DEFINE IFNES. (ARG1,ARG2)<
	PRINTX % IFNES. should be changed to IFJER.
	IFJER. <ARG1>,<ARG2>>


;"IF SKIP" CONSEQUENCE-CODE
;If the instruction(s) preceding the macro skips, the 'consequence
; code' will be executed.

DEFINE IFSKP. (SKCOD,%TG,%TG2)<
   IFB <SKCOD>,<		;;REGULAR FORM
	..SVDF			;;SAVE DEFINITIONS OF OUTER BLOCK
	JRST %TG
   DEFINE ..TAGF (INST,PCT)<
	INST %TG''PCT>		;;SAVE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;SAVE END TAG
	>
   IFNB <SKCOD>,<
	JRST %TG
	SKCOD
%TG:!	.XCREF %TG		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
>>

;If No JSYS Error

DEFINE IFNJE. (SKCOD,%TG,%TG2)<
   IFB <SKCOD>,<		;;REGULAR FORM
	..SVDF			;;SAVE DEFINITIONS OF OUTER BLOCK
	ERJMP %TG
   DEFINE ..TAGF (INST,PCT)<
	INST %TG''PCT>		;;SAVE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;SAVE END TAG
	>
   IFNB <SKCOD>,<
	ERJMP %TG
	SKCOD
%TG:!	.XCREF %TG		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
>>

;VERSION WHICH ALLOWS SPECIFICATION OF ERJMP TYPE

DEFINE IFJN. (TYPE,SKCOD,%TG,%TG2)<
   IFB <SKCOD>,<		;;REGULAR FORM
	..SVDF			;;SAVE DEFINITIONS OF OUTER BLOCK
	ERJMP'TYPE %TG
   DEFINE ..TAGF (INST,PCT)<
	INST %TG''PCT>		;;SAVE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;SAVE END TAG
	>
   IFNB <SKCOD>,<
	ERJMP'TYPE %TG
	SKCOD
%TG:!	.XCREF %TG		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
>>

;OBSOLETE NAME

DEFINE IFESK. (ARG)<
	PRINTX % IFESK. should be changed to IFNJE.
	IFNJE. <ARG>>

;CONDITIONALS WHICH REPRESENT JUMP CASES - I.E. AC L, LE, G, ETC.
; IF CONDITION IS SATISFIED, DO BRACKETTED CODE

DEFINE IFE. (AC,%TG1,%TG2)<
	JUMPN AC,%TG1		;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFN. (AC,%TG1,%TG2)<
	JUMPE AC,%TG1		;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFG. (AC,%TG1,%TG2)<
	JUMPLE AC,%TG1		;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFGE. (AC,%TG1,%TG2)<
	JUMPL AC,%TG1		;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFLE. (AC,%TG1,%TG2)<
	JUMPG AC,%TG1		;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFL. (AC,%TG1,%TG2)<
	JUMPGE AC,%TG1		;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFXE. (AC,MASK,%TG1,%TG2)<
	JXN AC,MASK,%TG1	;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFXN. (AC,MASK,%TG1,%TG2)<
	JXE AC,MASK,%TG1	;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFQE. (STR,Y,%TG1,%TG2)<
	JN <STR>,<Y>,%TG1	;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

DEFINE IFQN. (STR,Y,%TG1,%TG2)<
	JE <STR>,<Y>,%TG1	;;JUMP IF NOT CONDITION
	..SVDF			;;SAVE OUTER BLOCK
   DEFINE ..TAGF (INST,PCT)<
	INST %TG1''PCT>		;;DEFINE FALSE TAG
   DEFINE ..TAGE (INST,PCT)<
	INST %TG2''PCT>		;;DEFINE END TAG
	.XCREF %TG1		;;[T36] 
    IFDEF %TG2,<.XCREF %TG2>	;;[T36] Only purge if it is defined
	>

;GENERAL CASES WITHIN CONDITIONALS

;"AND SKIP"

DEFINE ANSKP. <
	..TAGF (JRST,)>		;;JUMP TO 'FALSE'

DEFINE ANNSK. <
	TRNA
	..TAGF (JRST,)>		;;JUMP TO 'FALSE'

DEFINE ANNJE. <
	..TAGF (ERJMP,)>	;;[9162] Jump to "false" on JSYS error

DEFINE ELSE. <....U>		;;UNDEFINED UNTIL BLOCK ENTERED
DEFINE ENDIF. <....U>
DEFINE ..TAGF <....U>
DEFINE ..TAGE <....U>

;"AND E" ETC.

DEFINE ANDE. (AC)<
	..TAGF (<JUMPN AC,>,)>	;;JUMP IF NOT CONDITION

DEFINE ANDN. (AC)<
	..TAGF (<JUMPE AC,>,)>	;;JUMP IF NOT CONDITION

DEFINE ANDG. (AC)<
	..TAGF (<JUMPLE AC,>,)>	;;JUMP IF NOT CONDITION

DEFINE ANDGE. (AC)<
	..TAGF (<JUMPL AC,>,)>	;;JUMP IF NOT CONDITION

DEFINE ANDLE. (AC)<
	..TAGF (<JUMPG AC,>,)>	;;JUMP IF NOT CONDITION

DEFINE ANDL. (AC)<
	..TAGF (<JUMPGE AC,>,)>	;;JUMP IF NOT CONDITION

DEFINE ANDXE. (AC,MASK)<
	..TAGF (<JXN AC,MASK,>,)> ;;JUMP IF NOT CONDITION

DEFINE ANDXN. (AC,MASK)<
	..TAGF (<JXE AC,MASK,>,)> ;;JUMP IF NOT CONDITION

DEFINE ANDQE. (STR,Y)<
	..TAGF (<JN <STR>,<Y>,>,)> ;;JUMP IF NOT CONDITION

DEFINE ANDQN. (STR,Y)<
	..TAGF (<JE <STR>,<Y>,>,)> ;;JUMP IF NOT CONDITION

;LOCAL WORKER MACROS

;THIS INITS THE DEFINITIONS OF ELSE. AND ENDIF. WHEN ENTERING A
;NEW BLOCK.

DEFINE ..INDF <
 DEFINE ELSE. <
	..TAGE (JRST,)		;;JUMP TO END
	..TAGF (,<:!>)		;;DEFINE THE FALSE TAG
	SYN ..TAGE,..TAGF	;;MAKE FALSE EQUIVALENT TO END
   DEFINE ELSE. <....U>>	;;ELSE CAN APPEAR ONCE ONLY

 DEFINE ENDIF. <
	..TAGF (,<:!>)		;;DEFINE FALSE TAG
	..RSDF>			;;RESTORE DEFINITIONS OF OUTER BLOCK
   >

;SAVE DEFINITIONS

DEFINE ..SVDF (%SY1,%SY2,%SY3,%SY4)<
	SYN ELSE.,%SY1
	SYN ENDIF.,%SY2
	SYN ..TAGF,%SY3
	SYN ..TAGE,%SY4
	.XCREF %SY1,%SY2,%SY3,%SY4	;;[T36]
	.PSHX <
	  SYN %SY1,ELSE.
	  SYN %SY2,ENDIF.
	  SYN %SY3,..TAGF
	  SYN %SY4,..TAGE>
	..INDF			;;REINIT DEFS
	      >

DEFINE ..RSDF <
	.POPX>

;MACROS TO PUSH/POP STRINGS

DEFINE .PSHX (STUFF)<
	.PSHX1 (.PSHX2,<STUFF>)>

DEFINE .PSHX1 (WCH,STUFF)<
	WCH (<STUFF>)>

DEFINE .PSHX2 (OLD)<
   DEFINE .PSHX1 (WCH,STUFF)<
	WCH (<<STUFF>,<OLD>>)>>

DEFINE .POPX <
	.PSHX1 (.POPX2)>

DEFINE .POPX2 (STUFF)<
	.POPX4 STUFF>

DEFINE .POPX4 (JUNK,STUFF)<
	.POPX3 STUFF>

DEFINE .POPX3 (TOP,REST)<
	TOP
   DEFINE .PSHX1 (WCH,STUFF)<
	WCH (<<STUFF>,<REST>>)>>
	SUBTTL CALL, RET, JSERR

   IFE REL,<
	EXTERN JSERR0,JSMSG0,JSHLT0,R,RSKP>

;CALL AND RETURN

.AC1==1				;ACS FOR JSYS ARGS
.AC2==2
.AC3==3
.A16==16			;TEMP FOR STKVAR AND TRVAR
P=17				;STACK POINTER

OPDEF CALL [PUSHJ P,0]
OPDEF RET [POPJ P,0]

;ABBREVIATION FOR  CALL, RET, RETSKP

OPDEF CALLRET [JRST]
.NODDT CALLRET

DEFINE RETSKP <JRST RSKP>

	SUBTTL

;MACRO TO PRINT MESSAGE ON TERMINAL

DEFINE TMSG ($MSG)<
	HRROI .AC1,[ASCIZ \$MSG\]
	PSOUT>

;MACRO TO OUTPUT MESSAGE TO FILE
; ASSUMES JFN ALREADY IN .AC1

DEFINE FMSG ($MSG)<
	HRROI .AC2,[ASCIZ \$MSG\]
	MOVEI .AC3,0
	SOUT>

;MACRO TO PRINT MESSAGE FOR LAST ERROR, RETURNS +1

DEFINE PERSTR ($MSG)<
   IFNB <$MSG>,<
	TMSG <$MSG>>
	CALL JSMSG0>

;MACRO TO PRINT JSYS ERROR MESSAGE, RETURNS +1 ALWAYS

OPDEF JSERR[<CALL JSERR0>]
OPDEF EJSERR[<JUMP 17,JSERR0>]	;Since MACRO couldn't handle OPDEF of an OPDEF
				;  (i.e. ERCAL) defined elsewhere, use JUMP 17,
				;  instead

;MACRO FOR FATAL JSYS ERROR, PRINTS MSG THEN HALTS

OPDEF JSHLT[<CALL JSHLT0>]
OPDEF EJSHLT[<JUMP 17,JSHLT0>]	;Since MACRO couldn't handle OPDEF of an OPDEF
				;  (i.e. ERCAL) defined elsewhere, use JUMP 17,
				;  instead

;PRINT ERROR MESSAGE IF JSYS FAILS

DEFINE ERMSG(TEXT),<
	ERJMP	[TMSG <? TEXT>
		 JSHLT]
>

;MAKE SYMBOLS EXTERN IF NOT ALREADY DEFINED

DEFINE EXT (SYM)<
   IF2,<
	IRP SYM,<
	IFNDEF SYM,<EXTERN SYM
	SUPPRE SYM>>>>

;MACRO TO ADD BREAK CHARACTER TO FOUR WORD BREAK MASK (W0., W1., W2., W3.)

DEFINE BRKCH. (%%V,V2)
<
%%FOO==%%V
	BRK0 (%%FOO,V2,0)
>

;MACRO TO REMOVE CHARACTER

DEFINE UNBRK. (%%V,V2)
<
%%FOO==%%V
	BRK0 (%%FOO,V2,1)
>

DEFINE BRK0 (%%11,V2,FLAVOR)
<	..V22==%%11
	..V1==%%11
	IFNB <V2>,<..V22==V2>
REPEAT ..V22-<%%11>+1,<	;;BRACKETS AROUND %%11 IN CASE ITS AN EXPRESSION
	%%W==..V1/^D32	;;DECIDE WHICH WORD CHARACTER GOES IN
	%%X==..V1-%%W*^D32	;;CALCULATE BIT POSITION WITHIN WORD
	IFE FLAVOR,BRKC1 \"<%%W+"0">	;;MODIFY CORRECT MASK WORD
	IFN FLAVOR,BRKC2 \"<%%W+"0">
	..V1==..V1+1
		   >
>

DEFINE BRKC1 (ARG1)
<	W'ARG1'.==W'ARG1'.!<1B<%%X>>
>

DEFINE BRKC2 (ARG1)
<	W'ARG1'.==W'ARG1'.&<-1-1B<%%X>>
>

;MACRO TO INITIALIZE 4-WORD 12-BIT CHARACTER BREAK MASK

DEFINE BRINI.(A0<0>,A1<0>,A2<0>,A3<0>)
<
W0.==A0
W1.==A1				;INITIALIZE BREAK MASK
W2.==A2
W3.==A3
>

;MACRO TO DEFINE A BREAK SET

DEFINE BRMSK. (INI0,INI1,INI2,INI3,ALLOW,DISALW)
<	BRINI. INI0,INI1,INI2,INI3	;;SET UP INITIAL MASK
	IRPC ALLOW,<	UNBRK. "ALLOW">	;;DON'T BREAK ON CHARS TO BE ALLOWED IN FIELD
	IRPC DISALW,<	BRKCH. "DISALW">	;;BREAK ON CHARACTERS NOT ALLOWED
	EXP W0.,W1.,W2.,W3.		;;STORE RESULTANT MASK IN MEMORY
>

;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK
;THIS IS THE OLD ONE, BEFORE .CMBRK EXISTED.  USE FLDBK. FOR SPECIFYING
;BREAK SETS

DEFINE FLDDB. (TYP,FLGS,DATA,HLPM,DEFM,LST)<
	..XX==<FLD(TYP,CM%FNC)>+FLGS+<0,,LST>
   IFNB <HLPM>,<..XX=CM%HPP!..XX>
   IFNB <DEFM>,<..XX=CM%DPP!..XX>
	..XX
   IFNB <DATA>,<DATA>
   IFB <DATA>,<0>
   IFNB <HLPM>,<POINT 7,[ASCIZ HLPM]>
   IFB <HLPM>,<IFNB <DEFM>,<0>>
   IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>>

;COMND - MACRO FOR BUILDING FUNCTION DESCRIPTOR BLOCK

DEFINE FLDBK. (TYP,FLGS,DATA,HLPM,DEFM,BRKADR,LST)<
	..XX==<FLD(TYP,CM%FNC)>+FLGS+<Z LST>
   IFNB <HLPM>,<..XX=CM%HPP!..XX>
   IFNB <DEFM>,<..XX=CM%DPP!..XX>
   IFNB <BRKADR>,<..XX=CM%BRK!..XX>
	..XX
   IFNB <DATA>,<DATA>
   IFB <DATA>,<0>
   IFNB <HLPM>,<POINT 7,[ASCIZ HLPM]>
   IFB <HLPM>,<IFNB <DEFM'BRKADR>,<0>>
   IFB <DEFM>,<IFNB <BRKADR>,<0>>
   IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>
   IFNB <BRKADR>,<BRKADR>
   >

;USEFUL EXTENDED ADDRESSING DEFINITIONS

OPDEF	XMOVEI [SETMI]		;EXTENDED MOVE IMMEDIATE
OPDEF	XHLLI [HLLI]		;NOT YET IN MACRO

DEFINE XBLT. (A)<
	EXTEND A,[XBLT]>
	SUBTTL SUPPORT CODE FOR JSERR

   IFN REL,<

A=1
B=2
C=3
D=4

;JSYS ERROR HANDLER
;	CALL JSERR0
; RETURNS +1: ALWAYS, CAN BE USED IN +1 RETURN OF JSYS'S

JSERR0::MOVEI A,.PRIIN
	CFIBF			;CLEAR TYPAHEAD
	MOVEI A,.PRIOU
	DOBE			;WAIT FOR PREVIOUS OUTPUT TO FINISH
	TMSG <
? JSYS ERROR: >
JSMSG0::MOVEI A,.PRIOU
	HRLOI B,.FHSLF		;SAY  THIS FORK ,, LAST ERROR
	SETZ C,
	ERSTR
	 JFCL
	 JFCL
	TMSG <
>
	RET

;FATAL JSYS ERROR - PRINT MESSAGE AND HALT
;	CALL JSHLT0
; RETURNS: NEVER

JSHLT0::CALL JSERR0		;PRINT THE MSG
JSHLT1:	HALTF
	TMSG <PROGRAM CANNOT CONTINUE
>
	JRST JSHLT1		;HALT AGAIN IF CONTINUED
   >				;END OF IFN REL,
	SUBTTL STKVAR - STACK VARIABLE FACILITY

;MACRO FOR ALLOCATING VARIABLES ON THE STACK. ITS ARGUMENT IS
;A LIST OF ITEMS.  EACH ITEM MAY BE:
; 1. A SINGLE VARIABLE WHICH WILL BE ALLOCATED ONE WORD
; 2. A VARIABLE AND SIZE PARAMETER WRITTEN AS <VAR,SIZ>.  THE
;	VARIABLE WILL BE ALLOCATED THE SPECIFIED NUMBER OF WORDS.
;RETURN FROM A SUBROUTINE USING THIS FACILITY MUST BE VIA
;RET OR RETSKP.  A DUMMY RETURN WHICH FIXES UP THE STACK IS PUT ON
;THE STACK AT THE POINT THE STKVAR IS ENCOUNTERED.
;WITHIN THE RANGE OF A STKVAR, PUSH/POP CANNOT BE USED AS THEY WILL
;CAUSE THE VARIABLES (WHICH ARE DEFINED AS RELATIVE STACK LOCATIONS)
;TO REFERENCE THE WRONG PLACE.
;**note that the SAVE macros use PUSH & POP, so STKVAR macro must occur
;  after any such in a routine.
;**also note that no blanks are allowed in the list, i.e.,
;  STKVAR <A, B, C>  will not work.
;TYPICAL USE:   STKVAR <AA,BB,<QQ,5>,ZZ>
;		ENDSV.		;END OF SCOPE OF NAMES

   IFE REL,<
	EXTERN .XSTKS,.XSTKR>

DEFINE STKVAR (ARGS)<
	..STKR==10		;;REMEMBER RADIX
	RADIX 8
	..STKN==0
	IRP ARGS,<
	  .STKV1 (ARGS)>
	JSP .A16,.XSTKS		;Call internal routine for allocation
	 EXP ..STKN		;Size of block to allocate
	RADIX ..STKR
	DEFINE ENDSV.<.ENSV1 <ARGS>>
   >

;INTERMEDIATE MACRO TO PEAL OFF ANGLEBRACKETS IF ANY

DEFINE .STKV1 (ARG)<
	.STKV2 (ARG)>

;INTERMEDIATE MACRO TO CALCULATE OFFSET AND COUNT VARIABLES

DEFINE .STKV2 (VAR,SIZ)<
	IFB <SIZ>,<..STKN==..STKN+1>
	IFNB <SIZ>,<
	...X==SIZ
	IF2,<.IFN ...X,ABSOLUTE,<PRINTX ?STKVAR VAR, SIZ is not absolute>>
	..STKN==..STKN+...X>
	..STKQ==..STKN+1
	.STKV3 (VAR,\..STKQ)>

;INNERMOST MACRO TO DEFINE VARIABLE

DEFINE .STKV3 (VAR,LOC)<
   IFDEF VAR,<.IF VAR,SYMBOL,<PRINTX STKVAR VAR ALREADY DEFINED>>
	DEFINE VAR<-^O'LOC(P)>
	$'VAR==<Z VAR>>		;SYMBOL FOR DDT

;CLEANUP NAMES

DEFINE .ENSV1 (ARGS)<
	IRP ARGS,<
	  .ENSV2 (ARGS)>>

  DEFINE .ENSV2 (ARG)<
	.ENSV3 (ARG)>

  DEFINE .ENSV3 (ARG,SIZ)<
	DEFINE ARG<....U>>

   IFN REL,<

;COMMON ENTRY AND EXIT ROUTINE FOR STACK VARIABLE

	ENTRY .STKST

;This code assumes local format stack pointers which can detect only
;  stack overflow (not stack underflow).  This code is left intact
;  because there may be old .REL files which contain a JSP to .STKST
;  instead of the new way to .XSTKS and also expect the block size
;  following the JSP to be in the form n,,n instead of just EXP n.  This
;  code is left purely for compatibility and may one day be removed.

.STKST::ADD P,0(.A16)		;BUMP STACK FOR VARIABLES USED
	JUMPGE P,STKSOV		;TEST FOR STACK OVERFLOW
STKSE1:	PUSH P,0(.A16)		;SAVE BLOCK SIZE FOR RETURN
	PUSHJ P,1(.A16)		;CONTINUE ROUTINE, EXIT TO .+1
.STKRT::JRST STKRT0		;NON-SKIP RETURN COMES HERE
	POP P,.A16		;SKIP RETURN COMES HERE-RECOVER COUNT
	SUB P,.A16		;ADJUST STACK TO REMOVE BLOCK
	AOS 0(P)		;NOW DO SKIP RETURN
	RET

STKRT0:	POP P,.A16		;RECOVER COUNT
	SUB P,.A16		;ADJUST STACK TO REMOVE BLOCK
	RET			;DO NON-SKIP RETURN

STKSOV:	SUB P,0(.A16)		;STACK OVERFLOW- UNDO ADD
	HLL .A16,0(.A16)	;SETUP TO DO MULTIPLE PUSH, GET COUNT
STKSO1:	PUSH P,[0]		;DO ONE PUSH AT A TIME, GET REGULAR
	SUB .A16,[1,,0]		; ACTION ON OVERFLOW
	TLNE .A16,777777	;COUNT DOWN TO 0?
	JRST STKSO1		;NO, KEEP PUSHING
	JRST STKSE1

;This is the new internal routine for STKVAR which can work with both
;  local and global format stack pointers because the ADJSP instruction
;  is used.  It differs from the previous code in two ways.  1) The block
;  size for the allocation is NOT duplicated in BOTH halves of the word
;  following the JSP.  2) The code does not check for stack overflow
;  because ADJSP will set TRAP 2 for us.

	ENTRY .XSTKS

.XSTKS::ADJSP P,@0(.A16)	;Adjust stack pointer for variables used
	PUSH P,0(.A16)		;Save block size for return
	PUSHJ P,1(.A16)		;Call routine and return following here
.XSTKR::IFSKP.			;Skip return comes here so
	 POP P,.A16		;  recover count,
	 MOVNS .A16		;  get size for deallocation,
	 ADJSP P,(.A16)		;  adjust stack to remove block,
	 AOS 0(P)		;  and now adjust for skip return
	ELSE.			;Now for Non-Skip return so
	 POP P,.A16		;  recover count,
	 MOVNS .A16		;  get size for deallocation,
	 ADJSP P,(.A16)		;  and adjust stack to remove block
	ENDIF.
	RET			;Now just return

   >				;END OF IFN REL,
	SUBTTL TRVAR - TRANSIENT VARIABLE FACILITY

;TRANSIENT (STACK) VARIABLE FACILITY - EQUIVALENT TO STKVAR
;EXCEPT ALLOWS VARIABLES TO BE USED WITHIN LOWER LEVEL ROUTINES
;AND AFTER OTHER THINGS HAVE BEEN PUSHED ON STACK.
;N.B. USES .FP AS FRAME POINTER - MUST NOT BE CHANGED WHILE
;VARIABLES IN USE.

.FP==15				;DEFAULT FRAME POINTER

   IFE REL,<
	EXTERN .XTRST,.XTRRT>

DEFINE TRVAR (VARS)<
	..TRR==10		;;REMEMBER CURRENT RADIX
	RADIX 8
	..NV==1			;;INIT COUNT OF STACK WORDS
	IRP VARS,<
	  .TRV1 (VARS)>		;;PROCESS LIST
	JSP .A16,.XTRST		;;ALLOCATE STACK SPACE, SETUP .FP
	 EXP ..NV-1		;Size of block to allocate
	RADIX ..TRR		;;RESTORE RADIX
	DEFINE ENDTV.<.ENSV1 <VARS>>
	>

DEFINE .TRV1 (VAR)<
	.TRV2 (VAR)>		;;PEEL OFF ANGLEBRACKETS IF ANY

DEFINE .TRV2 (NAM,SIZ)<
	.TRV3 (NAM,\..NV)	;;DEFINE VARIABLE
	IFB <SIZ>,<..NV=..NV+1>
	IFNB <SIZ>,<
	...X==SIZ
	IF2,<.IFN ...X,ABSOLUTE,<PRINTX ?TRVAR NAM, SIZ is not absolute>>
	..NV=..NV+...X>>

DEFINE .TRV3 (NAM,LOC)<
   IFDEF NAM,<.IF NAM,SYMBOL,<PRINTX TRVAR NAM ALREADY DEFINED>>
	DEFINE NAM<^O'LOC(.FP)>
	$'NAM==<Z NAM>>		;;SYMBOL FOR DDT

   IFN REL,<

;SUPPORT ROUTINE FOR TRVAR

;This code assumes local format stack pointers which can detect only
;  stack overflow (not stack underflow).  This code is left intact
;  because there may be old .REL files which contain a JSP to .TRSET
;  instead of the new way to .XTRST and also expect the block size
;  following the JSP to be in the form n,,n instead of just EXP n.  This
;  code is left purely for compatibility and may one day be removed.

.TRSET::PUSH P,.FP		;PRESERVE OLD .FP
	MOVE .FP,P		;SETUP FRAME PTR
	ADD P,0(.A16)		;ALLOCATE SPACE
	JUMPGE P,TRSOV
TRSET1:	PUSHJ P,1(.A16)		;CONTINUE ROUTINE, EXIT VIA .+1
.TRRET::JRST [	MOVEM .FP,P	;CLEAR STACK
		POP P,.FP	;RESTORE OLD .FP
		POPJ P,]
	MOVEM .FP,P		;HERE IF SKIP RETURN
	POP P,.FP
	AOS 0(P)		;PASS SKIP RETURN
	POPJ P,

TRSOV:	MOVE P,.FP		;STACK OVERFLOW, UNDO ADD
	PUSH P,.A16		;SAVE LOCAL RETURN
	HRRZ .A16,0(.A16)	;GET COUNT
	ADJSP P,-1(.A16)	;ADJUST STACK, GET TRAP HERE OR ON PUSH
	MOVE .A16,1(.FP)	;RESTORE LOCAL RETURN
	JRST TRSET1		;NOW CHARGE AHEAD


;This is the new internal routine for TRVAR which can work with both
;  local and global format stack pointers because the ADJSP instruction
;  is used.  It differs from the previous code in two ways.  1) The block
;  size for the allocation is NOT duplicated in BOTH halves of the word
;  following the JSP.  2) The code does not check for stack overflow
;  because ADJSP will set TRAP 2 for us.

.XTRST::PUSH P,.FP		;Save old frame pointer
	MOVE .FP,P		;Set up new frame pointer
	ADJSP P,@0(.A16)	;Adjust stack pointer for variables used
	PUSHJ P,1(.A16)		;Call routine and return following here
.XTRRT::IFSKP.			;Skip return comes here so
	 MOVEM .FP,P		;  deallocate space for variables,
	 POP P,.FP		;  restore old frame pointer,
	 AOS 0(P)		;  and now adjust for skip return
	ELSE.			;Now for Non-Skip return so
	 MOVEM .FP,P		;  deallocate space for variables
	 POP P,.FP		;  and restore old frame pointer
	ENDIF.
	RET			;Now just return

   >				;END OF IFN REL,
	SUBTTL ASUBR - AC SUBROUTINE

;AC SUBROUTINE - ENTRY FOR SUBROUTINE CALLED WITH 1-4 ARGS IN ACS T1-T4.
;USES .FP AS FRAME PTR LIKE TRVAR

   IFE REL,<
	EXTERN .ASSET,.ASRET>

DEFINE ASUBR (ARGS)<
	..TRR==10		;;SAVE RADIX
	RADIX 8
	..NV==1			;;INIT ARG COUNT
	IRP ARGS,<
	  .TRV1 (ARGS)>		;;DEFINE ARG SYMBOL
	IFG ..NV-5,<PRINTX ?TOO MANY ARGUMENTS: ARGS>
	JSP .A16,.ASSET		;;SETUP STACK
	RADIX ..TRR		;;RESTORE RADIX
	DEFINE ENDAS.<.ENSV1 <ARGS>>
	>


   IFN REL,<

;SUPPORT ROUTINE FOR ASUBR

.ASSET::PUSH P,.FP		;SAVE .FP
	MOVE .FP,P		;SETUP FRAME POINTER
	ADJSP P,4		;BUMP STACK
	DMOVEM A,1(.FP)	;SAVE ARGS
	DMOVEM C,3(.FP)
	PUSHJ P,0(.A16)		;CONTINUE ROUTINE
.ASRET:: JRST [	MOVEM .FP,P	;NO-SKIP RETURN, CLEAR STACK
		POP P,.FP
		POPJ P,]
	MOVEM .FP,P		;SKIP RETURN, CLEAR STZCK
	POP P,.FP
	AOS 0(P)
	POPJ P,

   >				;END OF IFN REL,
	SUBTTL SASUBR - STACKED AC SUBROUTINE

;SAME AS ABOVE EXCEPT ALSO RESTORES T1-T4 FROM STACK

   IFE REL,<
	EXTERN .SASET,.SARET>

DEFINE SASUBR (ARGS)<
	..TRR==10		;;SAVE RADIX
	RADIX 8
	..NV==1			;;INIT ARG COUNT
	IRP ARGS,<
	  .TRV1 (ARGS)>		;;DEFINE ARG SYMBOL
	IFG ..NV-5,<PRINTX ?TOO MANY ARGUMENTS: ARGS>
	JSP .A16,.SASET		;;SETUP STACK
	RADIX ..TRR		;;RESTORE RADIX
	DEFINE ENDSA.<.ENSV1 <ARGS>>
	>


   IFN REL,<

;SUPPORT ROUTINE FOR SASUBR

.SASET::PUSH P,.FP		;SAVE .FP
	MOVE .FP,P		;SETUP FRAME POINTER
	ADJSP P,4		;BUMP STACK
	DMOVEM A,1(.FP)	;SAVE ARGS
	DMOVEM C,3(.FP)
	PUSHJ P,0(.A16)		;CONTINUE ROUTINE
.SARET:: JRST [	DMOVE A,1(.FP)	;RESTORE
		DMOVE C,3(.FP)
		MOVEM .FP,P	;NO-SKIP RETURN, CLEAR STACK
		POP P,.FP
		POPJ P,]
	DMOVE A,1(.FP)		;RESTORE
	DMOVE C,3(.FP)
	MOVEM .FP,P		;SKIP RETURN, CLEAR STACK
	POP P,.FP
	AOS 0(P)
	POPJ P,

   >				;END OF IFN REL,
	SUBTTL ACVAR - AC VARIABLE FACILITY

   IFE REL,<
	EXTERN .SAV1,.SAV2,.SAV3,.SAV4,.SAV8>

.FPAC==5			;FIRST PRESERVED AC
.NPAC==10			;NUMBER OF PRESERVED ACS

DEFINE ACVAR (LIST)<
	..NAC==0		;;INIT NUMBER OF ACS USED
	IRP LIST,<
	  .ACV1 (LIST)>		;;PROCESS ITEMS
	.ACV3 (\..NAC)		;;SAVE ACS USED
	DEFINE ENDAV.<.ENAV1 <LIST>>>

DEFINE .ACV1 (ITEM)<
	.ACV2 (ITEM)>		;;PEEL OFF ANGLEBRACKETS IF ANY

DEFINE .ACV2 (NAM,SIZ)<
   IFDEF NAM,<.IF NAM,SYMBOL,<PRINTX ACVAR NAM ALREADY DEFINED>>
	NAM==.FPAC+..NAC	;;DEFINE VARIABLE
	$'NAM==NAM		;;FOR DDT
	IFB <SIZ>,<..NAC=..NAC+1>
	IFNB <SIZ>,<
	...X==SIZ
	IF2,<.IFN ...X,ABSOLUTE,<PRINTX ?ACVAR NAM, SIZ is not absolute>>
	..NAC=..NAC+...X>>

DEFINE .ACV3 (N)<
	IFG N-.NPAC,<PRINTX ?TOO MANY ACS USED>
	IFLE N-4,<
	  JSP .A16,.SAV'N>	;;SAVE ACTUAL NUMBER USED
	IFG N-4,<
	  JSP .A16,.SAV8>>	;;SAVE ALL

DEFINE .ENAV1 (ARGS)<
	IRP ARGS,<
	  .ENAV2 (ARGS)>>

  DEFINE .ENAV2 (ARG)<
	.ENAV3 (ARG)>

  DEFINE .ENAV3 (NAM,SIZ)<
	PURGE NAM,NAM
  >
	SUBTTL SAVEAC - Save AC List

;SAVEAC is a macro to generate a JSP .SAC,xxx call to an AC saving
;co-routine and to generate the routine also, if necessary.  SAVEAC
;generates the routines as literals so that MACRO will compress as
;many as possible.  SAVEAC sorts the arguments so that routines which
;save the same ACs will always look the same to MACRO.

;When the there are four or more ACs to be saved, SAVEAC assumes that
;at least two of them will be adjacent and changes from multiple
;PUSHes and POPs to and ADJSP and MOVEMs or, if possible, DMOVEMs for
;efficiency.

;If .SAC is among the ACs being saved, it is saved before the JSP
;.SAC,xxx and then restored in the co-routine literal.

;ACs may be refered to by any currently valid name and in any order.
;A given set of ACs will always be recognized if its literal code has
;been generated before or if it is a special set handled by a system
;routine.

;If an AC is mentioned more than once, it will only be saved/restored
;once.

;Provision is made for detecting standard AC sets which are handled by
;user or system routines.  The routines, if defined, must be entered
;with JSP .SAC,xxx.  For example, SAVEAC <P1,P2> will call the system
;routine .SAV2 instead of generating local code to do the same thing.
;See SPCMAC below.  By redefining the macro USRSAV, the user can
;control the tests made for standard routines.

DEFINE USRSAV,<>		;DEFAULT TO NO SPECIAL-CASE ROUTINES

DEFINE SAVEAC(ACS),<

..DONE==0
..SACC==0
..NAC==0
..MASK==0

IRP <ACS>,<
	IFG ACS-^D15,<PRINTX ?SAVEAC(ACS) IS ILLEGAL,
		      PRINTX ?SAVEAC CAN ONLY BE USED ON ACCUMULATORS>
	IFE ACS-.SAC,<..SACC==1>
	..SYAC==ACS				
	IFN ACS-.SAC,<IFE ..MASK&1B<..SYAC>,<	
		..MASK==..MASK!1B<..SYAC>	
		..NAC==..NAC+1>>
	>
IFE ..SACC,<USRSAV>		;;..DONE SET BY SPCSAV IF IT SUCCEEDS
IFE ..DONE,<
  IFLE ..SACC,<JSP .SAC,[>
  IFG ..SACC,<CALL [EXCH .SAC,(P)>
		    IFG  ..NAC-3,<DSAVAC>
		    IFLE ..NAC-3,<IFG ..NAC,<PSAVAC>>
		    PUSHJ P,(.SAC)
		      TRNA
		    AOS -..NAC-..SACC(P)
		    IFG  ..NAC-3,<DRSTAC>
		    IFLE ..NAC-3,<IFG ..NAC,<PRSTAC>>
		    IFG ..SACC,<POP P,.SAC>
		    POPJ P,]
>
PURGE ..NAC,..TNAC,..MASK,..TMSK,..SACC,..NUM,..SMSK,..DONE,..SYAC  
>;END OF DEFINE SAVEAC

;Helper macros for SAVEAC

DEFINE SPCSAV(ADDR,ACS),<
	IFE ..DONE,<
		..SMSK==0
		IRP <ACS>,<
		   ..SYAC==ACS				
		   ..SMSK==..SMSK!1B<..SYAC>>		
		IFE ..MASK-..SMSK,<JSP .SAC,ADDR
				   ..DONE==1>
	>
>;END OF SPCSAV


DEFINE DSAVAC,<
IFG ..NAC,<ADJSP P,..NAC>
..TMSK==..MASK
..TNAC==..NAC-1
REPEAT ..NAC,<
   IFN ..TMSK,<
	..NUM==^L<..TMSK>
	..TMSK==..TMSK-1B<..NUM>
	IFE ..TMSK & 1B<..NUM+1>,<
		MOVEM ..NUM,-..TNAC(P)
		..TNAC==..TNAC-1>
	IFN ..TMSK & 1B<..NUM+1>,<
		DMOVEM ..NUM,-..TNAC(P)
		..TNAC==..TNAC-2
		..TMSK==..TMSK-1B<..NUM+1>>
	>>
>;END OF DEFINE DSAVAC

DEFINE DRSTAC,<
..TMSK==..MASK
..TNAC==..NAC-1
REPEAT ..NAC,<
   IFN ..TMSK,<
	..NUM==^L<..TMSK>
	..TMSK==..TMSK-1B<..NUM>
	IFE ..TMSK & 1B<..NUM+1>,<
		MOVE ..NUM,-..TNAC(P)
		..TNAC==..TNAC-1>
	IFN ..TMSK & 1B<..NUM+1>,<
		DMOVE ..NUM,-..TNAC(P)
		..TNAC==..TNAC-2
		..TMSK==..TMSK-1B<..NUM+1>>
	>>
IFG ..NAC,<ADJSP P,-..NAC>
>;END OF DEFINE DRSTAC

DEFINE PSAVAC,<
	..TMSK==..MASK
	REPEAT ..NAC,<
		..NUM==^L<..TMSK>
		..TMSK==..TMSK-1B<..NUM>
		PUSH P,..NUM
	>
>
DEFINE PRSTAC,<
	..NUM==^D15
	REPEAT ^D16,<
		IFN ..MASK & 1B<..NUM>,<
		POP P,..NUM>
		..NUM==..NUM-1
	>
>

IFN REL,<

;STANDARD RETURNS

RSKP::	AOS 0(P)
R::	RET
   >				;END OF IFN REL,

   IFN REL,<
;SUPPORT ROUTINES FOR AC VARIABLE FACILITY

.SAV1::	PUSH P,.FPAC
	PUSHJ P,0(.A16)
	 SKIPA
	AOS -1(P)
	POP P,.FPAC
	POPJ P,

.SAV2::	PUSH P,.FPAC
	PUSH P,.FPAC+1
	PUSHJ P,0(.A16)
	 SKIPA
	AOS -2(P)
	POP P,.FPAC+1
	POP P,.FPAC
	POPJ P,

.SAV3::
.SAV4::	ADJSP P,4
	DMOVEM .FPAC,-3(P)
	DMOVEM .FPAC+2,-1(P)
	PUSHJ P,0(.A16)
	 SKIPA
	AOS -4(P)
	DMOVE .FPAC,-3(P)
	DMOVE .FPAC+2,-1(P)
	ADJSP P,-4
	POPJ P,

.SAV8::	ADJSP P,10
	DMOVEM .FPAC,-7(P)
	DMOVEM .FPAC+2,-5(P)
	DMOVEM .FPAC+4,-3(P)
	DMOVEM .FPAC+6,-1(P)
	PUSHJ P,0(.A16)
	 SKIPA
	AOS -10(P)
	DMOVE .FPAC+6,-1(P)
	DMOVE .FPAC+4,-3(P)
	DMOVE .FPAC+2,-5(P)
	DMOVE .FPAC,-7(P)
	ADJSP P,-10
	POPJ P,
   >
	SUBTTL BLSUBR - BLISS-STYLE SUBROUTINE MECHANISM

;MACROS FOR STACK-STYLE (BLISS) SUBROUTINE ENTRY
;BLSUBR DEFINE A SUBROUTINE ENTRY POINT.  IT TAKES THE LIST OF
;SYMBOLS WHICH WILL BE BOUND TO VALUES ON THE STACK AT ENTRY TO
;THE ROUTINE.  A STACK FRAME POINTER IS SETUP IN .FP AND MUST
;BE UNDISTURBED THROUGH THE ROUTINE.  OTHER MECHANISMS WHICH
;USE THE STACK (E.G. SAVEAC) CAN BE USED.
;AN OPTIONAL LIST OF VARIABLES IN THE SAME FORMAT AS FOR TRVAR CAN
;BE GIVEN TO ALLOCATE LOCAL DYNAMIC STORAGE.

;SUBROUTINES DEFINED HEREBY ARE CALLED WITH BLCALL.

   IFE REL,<
	EXTERN .ENTER>

DEFINE BLSUB. (ARGS,VARS)<	;;ARGUMENTS, LOCAL VARIABLES
	..TRR==10		;;REMEMBER CURRENT RADIX
	RADIX 8			;;SO BACKSLASH ARGS WILL WORK HEREIN
	..NA==2			;;INIT ARG COUNT
	IRP ARGS,<
	  ..NA=..NA+1>		;;COUNT ARGS
	IRP ARGS,<
	  .BLSU1(ARGS,\..NA)	;;DEFINE AN ARG
	  ..NA=..NA-1>
	..NV==1			;;SETUP TO COUNT VARIABLE STORAGE
	IRP VARS,<
	  .TRV1 (VARS)>		;;COUNT WORDS AND DEFINE SYMBOLS
  DEFINE ENDBS. <.ENBS1 <ARGS>
		.ENSV1 <VARS>> ;;SAVE SYMBOLS
	JSP .A16,.ENTER
	..NV-1,,..NV-1
	RADIX ..TRR>		;;SETUP FRAME PTR

DEFINE .BLSU1 (ARG,LOC)<
	DEFINE ARG<-^O'LOC(.FP)>
	$'ARG==<Z ARG>>

DEFINE .ENBS1 (ARGS)<
	IRP ARGS,<
   DEFINE ARGS<....U>>>

;CALL STACK-STYLE (BLISS) SUBROUTINE
;THIS MACRO TAKES THE NAME OF THE SUBROUTINE AND A LIST OF ARGUMENTS.
;EACH ARGUMENT IN THE ARG LIST IS ONE OF THE FOLLOWING:
;  1. A NORMAL EFFECTIVE ADDRESS SPECIFICATION, E.G. FOO, @FIE(X)
;  2. AN IMMEDIATE ADDRESS WRITTEN AS <.,ADR> WHERE ADR IS AN EFFECTIVE
;	ADDRESS SPECIFICATION, E.G. FOO, @FIE(X).  NOTE THAT THIS
;	ADDRESS WILL BE COMPUTED BY AN XMOVEI AT THE TIME OF THE CALL
;	SO SECTION INFORMATION WILL BE BOUND AT THAT TIME.  NOTE ALSO
;	THAT THIS FORM SHOULD *NOT* BE USED FOR A LITERAL CONSTANT
;	WHERE YOU WOULD NOT WANT THE CURRENT SECTION PUT IN THE LEFT
;	HALF.  USE [CONST] INSTEAD.  YES, THE DOT HERE IS LIKE NO-DOT IN BLISS
;	AND VICE-VERSA.
;  3. A STRUCTURE REFERENCE SPECIFICATION, E.G. AAA, <BB,(X)>.  IF
;	THE LATTER FORM IS USED, THE BRACKETS ARE REQUIRED.

DEFINE BLCAL. (NAME,ARGS)<
	..NA==0			;;INIT ARG COUNT
	IRP ARGS,<
	  .BLCL2 ARGS>		;;COMPILE PUSH
	PUSH P,[..NA+1,,..NA+1]	;;COUNT OF ARGS AND SELF
	PUSHJ P,NAME		;;JUMP TO SUBR
   >

;SEPARATE PAIRED ARGS

  DEFINE .BLCL2 (ARGS)<
	.BLCL1 ARGS>

  DEFINE .BLCL1 (ARG1,ARG2)<
	  IFIDN <ARG1><.>,<
		XMOVEI .A16,ARG2	;;IMMEDIATE ARG
		PUSH P,.A16>
	  IFDIF <ARG1><.>,<
	  .IFATM <ARG1>,.BLF4	;;SEE IF ARG IS ATOMIC
	  .BLF1==0		;;SET TO 1 WHEN WE ASSEMBLE SOMETHING
	  IFN .BLF4,<		;;SEE IF A STRUCTURE REF
	    .IF %'ARG1,MACRO,<	;;CHECK RELATED STRUCTURE SYMBOL
		.BLF1==1>	;;IS A STRUCTURE
	    IFNB <ARG2>,<
		.BLF1==1>	;;SECOND ARG IMPLIES STRUCTURE TOO
	    IFN .BLF1,<		;;'OR' OF ABOVE TWO CHECKS
		LOAD .A16,ARG1,ARG2
		PUSH P,.A16>>
	  IFE .BLF1,<		;IF WASN'T A STRUCTURE REF,
	    IFN .BLF4,<		;;IF ARG IS ATOMIC...
	     .BLF2==<<Z ARG1>&17B17>-<P>B17 ;;TRY TO GET VALUE
	      .IF .BLF2,ABSOLUTE,< ;;IF WE NOW HAVE THE VALUE
	       IFE .BLF2,<		;;SEE IF INDEXED BY P
	       .BLF1==1		;;NOTE WE DID SOMETHING
	       .BLF3==<Z ARG1>&777777
		PUSH P,.BLF3-..NA(P)>>>> ;;YES, MUST ADJUST BY PUSHES SO FAR
	  IFE .BLF1,<		;;ELSE...
		PUSH P,ARG1>>	;;PUSH ONE ARG
	  ..NA=..NA+1>

;MACRO TO SEE IF STRING IS AN ATOM, I.E. CONTAINS ONLY LEGAL SYMBOL
;CONSTITUENTS A-Z, 0-9, %, $, .
;IT IS PAINFULLY SLOW, BUT MACRO PROVIDES NO OTHER WAY
;FLAG WILL BE SET TO 1 IF STRING IS ATOM, 0 OTHERWISE

DEFINE .IFATM (S,FLG)<
	IRPC S,<
	FLG==0
	IFGE "S"-"A",<IFLE "S"-"Z",<FLG=1>> ;;SET FLG IF LETTER OK
	IFGE "S"-"0",<IFLE "S"-"9",<FLG=1>>
	IFE "S"-"%",<FLG=1>
	IFE "S"-"$",<FLG=1>
	IFE "S"-".",<FLG=1>
	IFE FLG,<STOPI>>>

   IFN REL,<
;SUPPORT CODE FOR BLSUBR

.ENTER::PUSH P,.FP
	MOVE .FP,P
	ADD P,0(.A16)		;ALLOCATE LOCAL STORAGE
	JUMPGE P,ENTOV		;JUMP IF OVERFLOW
ENTOV1:	PUSHJ P,1(.A16)
	 JRST [	MOVE P,.FP	;RESET STACK PTR
		JRST ENTX1]
	MOVE P,.FP
	AOS -1(P)		;PROPAGATE SKIP
ENTX1:	POP P,.FP
	MOVN .A16,-1(P)		;get -<n,,n>
	HRRZM .A16,-1(P)	;Store 0,,-n
	POP P,.A16		;Recover return address
	ADJSP P,@0(P)		;Clean up the stack
	JRST 0(.A16)		;RETURN

ENTOV:	MOVE P,.FP		;STACK OVERFLOW, UNDO ADD
	PUSH P,.A16		;SAVE LOCAL RETURN IN 1(.FP)
	HRRZ .A16,0(.A16)	;GET COUNT
	ADJSP P,-1(.A16)	;ALLOCATE SPACE, GET TRAP HERE OR ON PUSH
	MOVE .A16,1(.FP)	;RESTORE LOCAL RETURN
	JRST ENTOV1		;CHARGE AHEAD
   >				;END IFN REL
	SUBTTL ERROR-MESSAGE SUPPORT FOR MACROS

;Macro to print current location, macro name, and text

DEFINE MPRNTX (MNAME,TEXT)<
	  DEFINE ..MP. (LOCN,MTEXT,PTEXT)<
	    PRINTX Location 'LOCN', Macro 'MTEXT': PTEXT
	    >
	  ..MP.(\.,MNAME,<TEXT>)
	  PURGE ..MP.
	  >

;Macro to print current location and text

DEFINE EPRNTX (TEXT)<
	  DEFINE ..EP. (LOCN,PTEXT)
	    <PRINTX Location 'LOCN': PTEXT
	    >
	  ..EP.(\.,<TEXT>)
	  PURGE ..EP.
	  >
	SUBTTL MACROS TO SUPPORT EXTENDED ADDRESSING

;EP. - Build Extended Pointer (extended format indirect word).
;See format picture below.
;Allows standard syntax for indexing and indirection.
;
;	EP. @ADR(X)
;
; where
;	@ - indirection, may be omitted
;	ADR - full address including section
;	X - index, may be omitted.
;Examples:
;	EP. @FOO		;indirection only
;	EP. FOO(X)		;indexing only
;	EP. @FOO(X)		;both
;These would generally be used in literals as indirect words, e.g.
;	MOVE T1,@[EP. FOO(X)]
;No nested parentheses should be used.

DEFINE EP. (ARG)<
	..I==0
	..X==0
	MAKRM. (..CON,..GET)
	..CON <EXIND. ..I,>
	IRPC ARG,<
	  ..SC==0
	  IFE "ARG"-"@",<..I==1
			..SC=1>
	  IFE "ARG"-"(",<..CON <,>
			..SC=1
			..X==1>
	  IFE "ARG"-")",<
	    IFE ..X,<PRINTX %UNEXPECTED RIGHT PAREN IN EP. MACRO>
			..SC=1>
	  IFE ..SC,<
	   ..CON <ARG>>>
	IFE ..X,<
	  ..CON <,0>>
	..CON <
>
	..GET
   >

;Basic macro to construct EFIW with 30-bit Y.
;	EXIND. (IND,YYY,XXX)
; where
;	IND is 0 or 1
;	YYY is a 30-bit address
;	XXX is an index

DEFINE EXIND. (IND,YYY,IDX)<<<IND>B1+<IDX>B5+<YYY>>>


;	Local format indirect word
;	=================================================================
;	!1!0!    Reserved   ! I !   X   !	      ADDR		!
;	=================================================================
;	!0!1!2     	  12! 13!14   17!18			      35!



;Macro to generate local-format (instruction-format) indirect words
;Args:
;	ADDR	18-bit in-section address (indexing or indirection
;		may be specified)

;Generates Q errors on the following:
;		Bits 0-12 non-zero in ADDR

DEFINE LFIWM (ADDR)<
	..ERR.=0		;;Reset error flag
	IFN <<ADDR>&<^O<777740,,0>>>,<
	  MPRNTX(LFIWM,Bits 0 - 12 non-zero in address field: ADDR)
	  ..ERR.=1
	  >
	IFN ..ERR.,<-1,-1,-1>	;;Generate Q error
	IFE ..ERR.,<1B0!<<^O<400037,,-1>>&<ADDR>>>	;;Generate LFIW
	PURGE ..ERR.
	>

;	Global format indirect word
;	=================================================================
;	!0! I !   X   !       SEC       !	      ADDR		!
;	=================================================================
;	!0! 1 !2     5!6	      17!			      35!


;Macro to generate global-format (extended-format) indirect words
;Args:
;	SEC	12-bit section number
;	ADDR	18-bit in-section address (indexing or indirection
;		may be specified)

;Generates Q errors on the following:
;		Bits 0-12 non-zero in ADDR
;		SEC greater than 12 bits

DEFINE GFIWM (SEC,ADDR)<
	..ERR.=0		;;Reset error flag
	IFN <<SEC>&<^O<-1,,770000>>>,<
	  MPRNTX(GFIWM,Section greater than 12 bits: SEC)
	  ..ERR.=1
	  >
	IFN <<ADDR>&<^O<777740,,0>>>,<
	  MPRNTX(GFIWM,Bits 0 - 12 non-zero in address field: ADDR)
	  ..ERR.=1
	  >
	IFN ..ERR.,<-1,-1,-1>	;;Generate Q error
				;;Generate GFIW
	IFE ..ERR.,<
	  <<<ADDR>_<^O14>>&<^O<370000,,0>>!<<ADDR>&<0,,-1>>!<<SEC>_<^O22>>>>
	PURGE ..ERR.
	>

;	The following macros generate all flavors of 1 and 2-word
;	global and local byte pointers.  They are similar to the
;	POINT pseudo-op, with the following exceptions:

;	1.	The basic argument triad of (bytesize,address,byte position)
;		is maintained.  However, some of the macros will prefix
;		and-or postfix the triad with additional argument(s).
;	2.	Numeric arguments are always interpreted in the current radix.
;		Assuming the current radix is octal, note the following
;		equivalences:
;			a.  POINT 10,200,36
;			b.  L1BPT(12,200,44)
;			c.  L1BPT(^D10,200,^D36)
;	3.	Strict field-limits are enforced.  Any expression that
;		will not fit into its appropriate field will generate
;		an error message and cause a Q error.  Thus:
;		L1BPT (10,200,-1) will cause an error.  (The correct effect
;		is generated with:  L1BPT (10,200).)

;	Also, note that in those macros that generate global byte-pointers,
;	section values and address values must always be specified as distinct
;	arguments.  If address symbol FOO resolves to 377,,123456 , then it
;	would be specified in the macros as follows:
;		G2BPT(FOO_-^D18,7,FOO&777777,36)
;	Or (better):
;		FOOSEC=FOO_-^D18
;		FOOADR=FOO&777777
;		G2BPT(FOOSEC,7,FOOADR,36)

;	If runtime-generated values are needed, then any or all argument
;	fields may be assembled as zero and filled in at runtime using an
;	appropriate DPB instruction.  (G1BPT will not allow a zero bytesize
;	and will only allow a zero byte position if it is legal for that
;	particular bytesize.)



;	1-word local byte pointer
;	=================================================================
;	!   P   !   S   ! 0 ! I !   X   !	      ADDR		!
;	=================================================================
;	!0     5!6    11! 12! 13!14   17!18			      35!



;Macro to generate local, 1-word byte pointers
;Args:
;	BSIZ	Byte size
;	ADDR	18-bit address (indexing or indirection
;		may be specified)
;	BPOS	Optional byte position

;Generates Q errors on the following:
;		Bits 0-12 non-zero in ADDR
;		BSIZ or BPOS greater than 6 bits

DEFINE L1BPT (BSIZ,ADDR,BPOS)<
	.BSIZ.=BSIZ		;;Convert args to numeric
	.BPOS.=BPOS
	..ERR.=0		;;Reset error flag
	IFN <<ADDR>&<^O<777740,,0>>>,<
	  MPRNTX(L1BPT,Bits 0 - 12 non-zero in address field: ADDR)
	  ..ERR.=1
	  >
	IFN <.BSIZ.&<^O<-1,,777700>>>,<
	  MPRNTX(L1BPT,Bytesize greater than 6 bits: BSIZ)
	  ..ERR.=1
	  >
	IFN <.BPOS.&<^O<-1,,777700>>>,<
	  MPRNTX(L1BPT,Byte offset greater than 6 bits: BPOS)
	  ..ERR.=1
	  >
	;;Cause Q error
	IFN <..ERR.>,<-1,-1,-1>
	;;Generate byte pointer
	IFE <..ERR.>,<
	  IFIDN <BPOS><>,<POINT .BSIZ.,ADDR>
	  IFDIF <BPOS><>,<POINT .BSIZ.,ADDR,.BPOS.>
	  >
	PURGE ..ERR.,.BSIZ.,.BPOS.
	>



;	1-word global byte pointer
;	=================================================================
;	!     CODE    !       SEC       !	      ADDR		!
;	=================================================================
;	!0           5!6	      17!			      35!



;Macro to generate global, 1-word byte pointers
;Args:
;
;	SEC	12-bit section address
;	BSIZ	Byte size
;	ADDR	18-bit address (NO!! indexing or indirection
;		may be specified)
;	BPOS	Optional byte position

;Generates Q errors on following:
;		Illegal byte size or byte position
;		Indirection or indexing specified with ADDR
;		ADDR greater than 18 bits
;		SEC greater than 12 bits

;Legal sizes and positions are as follows:

;Size		Positions (Octal)
;6		44,36,30,22,14,6,0
;7		44,35,26,17,10,1
;8		44,34,24,14,4
;9		44,33,22,11,0
;18		44,22,0


; Define (somewhat) mnemonic symbols for the P&S field of a one-word global
; byte pointer.  These symbols have the form .Psspp where ss is the byte
; size in decimal, and pp is the byte position in decimal (just like the
; POINT pseudo-op in MACRO).  There are also a group of symbols that
; generate ILDB style pointers for word aligned data.  They are of the
; form .Pss.
;
; Example:
;
;	If AC contains the 30 bit address of a buffer, then:
;		TXO AC,.P0736
;	will generate a byte pointer that can be used for ILDB, IDPB
;	operations.  Equivalently, the symbol .P07 could have been used
;	instead.

DEFINE GENBPT (SIZ)<
..CC=45			;; Initialize the P&S field
..R=10			;; Save current radix

IRP <SIZ>,<
..PP=^D36		;; Initialize the position field

REPEAT ^O44/^D'SIZ+1,<
		RADIX 10		   ;; Make \ generate base ^D10.
		GENBP1 (SIZ,\..PP)	   ;; Generate .Psspp symbols
		GENBP2 ($,SIZ,\..PP)	   ;; Generate base ^d10 .$sp symbols
		RADIX 8			   ;; Make \ generate base 8.
		GENBP2 (%,\<^D'SIZ>,\..PP) ;; Generate base 8 .%sp symbols
		IFE ..PP-^D36,..PP=-1
		..PP=..PP+^D'SIZ
		..CC=..CC+1>
>
RADIX ..R
>

; Helper macro for GENBPT.  Generates .Psspp symbols.  Note that all numbers
; are in radix ^D10.

DEFINE GENBP1 (SIZ,POS)<
IFL SIZ-10,<
    IFL  POS-10,.P0'SIZ'0'POS==:<..CC>B5
    IFGE POS-10,.P0'SIZ'POS==:<..CC>B5
    IFE  POS-36,.P0'SIZ==:<..CC>B5
    >
IFGE SIZ-10,<
    IFL  POS-10,.P'SIZ'0'POS==:<..CC>B5
    IFGE POS-10,.P'SIZ'POS==:<..CC>B5
    IFE  POS-36,.P'SIZ==:<..CC>B5
    >
>

; Generate .% or .$ symbols for internal macro use.

DEFINE GENBP2(TYP,SIZ,POS)<.'TYP'SIZ'POS==:<..CC>B5>

lall
GENBPT (<6,8,7,9,18>) ; Generate all one-word global symbols

; ..OWGP - internal macro used by other macros to generate .% symbols.  Should
;	   be invoked using \ feature of macro arguments, and in radix 8 or 10.

DEFINE ..OWGP (SIZ,ADDR,POS)<IFE 10-8,   <.%'SIZ'POS!<ADDR>>+ 
			     IFE 10-^D10,<.$'SIZ'POS!<ADDR>>>

PURGE ..CC,..PP,GENBPT,GENBP1,GENBP2		; Get rid of extra symbols

repeat 0,<
DEFINE G1BPT (SEC,BSIZ,ADDR,BPOS<^O44>)<
	.GTBCD (BPOS,BSIZ,..ENC.)	;;GET OWGBP CODE
	IFE ..ENC.,<MPRNTX (G1BPT,<Illegal P,S combination: BPOS, BSIZ>)>
	IFN <<ADDR>&<-1,,0>>,<
	  MPRNTX (G1BPT,<Address indexed, indirect, or greater than 18 bits: ADDR>)>
	IFN <<SEC>&<^O<-1,,770000>>>,<
	  MPRNTX (G1BPT,<Section greater than 12 bits: SEC>)>
	<..ENC.>B5+<SEC>B17+<ADDR>>	;;GENERATE THE WORD
>

DEFINE G1BPT (SEC,BSIZ,ADDR,BPOS<^O44>)<<..OWGP (\<BSIZ>,<SEC,,ADDR>,\<BPOS>)>>


;ONE WORD GLOBAL - Where address includes section.
repeat 0,<
DEFINE OWGP. (SS,ADR,POS)<
	..SS==<SS>
	..PP==^O44
	IFNB <POS>,<..PP==^D35-<POS>>
	.GTBCD (..PP,..SS,..ENC)	;;GET OWGPB CODE
	IFE ..ENC,<MPRNTX (OWGP.,<Illegal P,S combination: POS, SS>)>
	<..ENC>B5+ADR>			;;GENERATE THE WORD
>

DEFINE OWGP. (SS,ADR,POS<^O44>)<<..OWGP (\<SS>,ADR,\<POS>)>>

;ONE WORD GLOBAL - Given mask as argument ala POINTR.

DEFINE OWGPR. (LOC,MASK)<OWGP. WID(MASK),LOC,POS(MASK)>

repeat 0,<
;Internal macro to convert P and S to OWGPB code.
; Accepts: PP - P value
;	   SS - S value
; Returns (sets):
;	   CD - Code
;Code set to 0 if P,S combination not recognized.

DEFINE .GTBCD (PP,SS,CD)<
	..P==PP
	..S==SS
	..C==0		;;INIT CODE
	..Q==10		;;SAVE RADIX
	RADIX ^D8
	IFE ..S-6,<
	  IFE ..P-44,<..C=45>
	  IFE ..P-36,<..C=46>
	  IFE ..P-30,<..C=47>
	  IFE ..P-22,<..C=50>
	  IFE ..P-14,<..C=51>
	  IFE ..P-06,<..C=52>
	  IFE ..P-00,<..C=53>>
	IFE ..S-10,<
	  IFE ..P-44,<..C=54>
	  IFE ..P-34,<..C=55>
	  IFE ..P-24,<..C=56>
	  IFE ..P-14,<..C=57>
	  IFE ..P-04,<..C=60>>
	IFE ..S-7,<
	  IFE ..P-44,<..C=61>
	  IFE ..P-35,<..C=62>
	  IFE ..P-26,<..C=63>
	  IFE ..P-17,<..C=64>
	  IFE ..P-10,<..C=65>
	  IFE ..P-01,<..C=66>>
	IFE ..S-11,<
	  IFE ..P-44,<..C=67>
	  IFE ..P-33,<..C=70>
	  IFE ..P-22,<..C=71>
	  IFE ..P-11,<..C=72>
	  IFE ..P-00,<..C=73>>
	IFE ..S-20,<
	  IFE ..P-44,<..C=74>
	  IFE ..P-22,<..C=75>
	  IFE ..P-00,<..C=76>>
	RADIX ..Q		;;RESTORE RADIX
	CD==..C>
>

;	2-word local byte pointer

;	!0     5!6    11! 12! 13      17!18			      35!
;	=================================================================
;	!   P   !   S   ! 1 ! Reserved  !       Available to User       !
;	=================================================================
;	!1!0!    Reserved   ! I !   X   !	      ADDR		!
;	=================================================================
;	!0!1!2     	  12! 13!14   17!18			      35!



;Macro to generate local, 2-word byte pointers
;Args:
;
;	BSIZ	Byte size
;	ADDR	18-bit address (Indexing or indirection
;		may be specified)
;	BPOS	Optional byte position
;	OPT	Optional user field available in word 1, right half

;Generates Q errors on the following:
;		Bits 0-12 non-zero in ADDR
;		Bits 0-17 non-zero in OPT
;		BSIZ or BPOS greater than 6 bits

DEFINE L2BPT(BSIZ,ADDR,BPOS,OPT<0>)<
	..ERR.=0		;;Reset error flag
	  .BSIZ.=BSIZ		;;Convert args to numeric
	  .BPOS.=BPOS
	IFN <<ADDR>&<^O<777740,,0>>>,<
	  MPRNTX(L2BPT,Bits 0 - 12 non-zero in address field: ADDR)
	  ..ERR.=1
	  >
	IFN <<OPT>&<-1,,0>>,<
	  MPRNTX(L2BPT,Bits 0-17 non-zero in optional field: OPT)
	  ..ERR.=1
	  >
	IFN <.BSIZ.&<^O<-1,,777700>>>,<
	  MPRNTX(L2BPT,Bytesize greater than 6 bits: BSIZ)
	  ..ERR.=1
	  >
	IFN <.BPOS.&<^O<-1,,777700>>>,<
	  MPRNTX(L2BPT,Byte offset greater than 6 bits: BPOS)
	  ..ERR.=1
	  >
	IFN ..ERR.,<-1,-1,-1>		;;Generate Q error
	;;Generate the byte pointer
	IFE ..ERR.,<
	  IFDIF <BPOS><>,<<<POINT .BSIZ.,OPT,.BPOS.>!1B12>&<^O<777740,,-1>>>
	  IFIDN <BPOS><>,<<<POINT .BSIZ.,OPT>!1B12>&<^O<777740,,-1>>>
	    <1B0!<<^O<400037,,-1>>&<ADDR>>>	;;Generate LFIW
	  >
	PURGE ..ERR.,.BSIZ.,.BPOS.
	>


;	2-word global byte pointer

;	!0     5!6    11! 12! 13      17!18			      35!
;	=================================================================
;	!   P   !   S   ! 1 ! Reserved  !       Available to User       !
;	=================================================================
;	!0! I !   X   !       SEC       !	      ADDR		!
;	=================================================================
;	!0! 1 !2     5!6	      17!			      35!


;Macro to generate global, 2-word byte pointers
;Args:
;	SEC	12-bit section address
;	BSIZ	Byte size
;	ADDR	18-bit address (Indexing or indirection
;		may be specified)
;	BPOS	Optional byte position
;	OPT	Optional user field available in word 1, right half

;Generates Q errors on the following:
;		SEC greater than 12 bits
;		Bits 0-12 non-zero in ADDR
;		Bits 0-17 non-zero in OPT
;		BSIZ or BPOS greater than 6 bits

DEFINE G2BPT(SEC,BSIZ,ADDR,BPOS,OPT<0>)<
	..ERR.=0		;;Reset error flag
	  .BSIZ.=BSIZ		;;Convert args to numeric
	  .BPOS.=BPOS
	IFN <<SEC>&<^O<-1,,770000>>>,<
	  MPRNTX(G2BPT,Section greater than 12 bits: SEC)
	  ..ERR.=1
	  >
	IFN <<ADDR>&<^O<777740,,0>>>,<
	  MPRNTX(G2BPT,Bits 0 - 12 non-zero in address field: ADDR)
	  ..ERR.=1
	  >
	IFN <<OPT>&<-1,,0>>,<
	  MPRNTX(G2BPT,Bits 0-17 non-zero in optional field: OPT)
	  ..ERR.=1
	  >
	IFN <.BSIZ.&<^O<-1,,777700>>>,<
	  MPRNTX(G2BPT,Bytesize greater than 6 bits: BSIZ)
	  ..ERR.=1
	  >
	IFN <.BPOS.&<^O<-1,,777700>>>,<
	  MPRNTX(G2BPT,Byte offset greater than 6 bits: BPOS)
	  ..ERR.=1
	  >
	IFN ..ERR.,<-1,-1,-1>		;;Generate Q error
	;;Generate the byte pointer
	IFE ..ERR.,<
	  IFDIF <BPOS><>,<<<POINT .BSIZ.,OPT,.BPOS.>!1B12>&<^O<777740,,-1>>>
	  IFIDN <BPOS><>,<<<POINT .BSIZ.,OPT>!1B12>&<^O<777740,,-1>>>
	    ;;Generate GFIW
	    <<<ADDR>_<^O14>>&<^O<370000,,0>>!<<ADDR>&<0,,-1>>!<<SEC>_<^O22>>>
	  >
	PURGE ..ERR.,.BSIZ.,.BPOS.
	>
	SUBTTL Byte pointers for ASCII strings
   REPEAT 0,<		;SUPERCEDED BY .Psspp

;Macros to generate 7-bit byte pointers where AC already contains an address.

;NOTE: In the case of one-word globals, AC must contain ONLY a 30-bit
;address. That is, bits 0-5 must be zero.

;PTLOCI - One word local pointer to bits 28-34 of a word. Used when AC
;	points to word preceding the one of interest. ILDB gets the byte
;	from the first 7 bits of the next word

;PTGLBI - One-word global equivalent of PTLOCI

;	Replaces HRLI AC,700

	DEFINE PTLOCI (AC)<
	HRLI AC,(POINT 7,0,35)>

LSTBYT==660000,,0
	DEFINE PTGLBI (AC)<
	TXO AC,LSTBYT>

;PTLOC - One word local pointer to 7 bits preceding a word. Used when AC
;	points to the word of interest. ILDB gets the byte
;	from the first 7 bits of the word

;PTGLB - One-word global equivalent of PTLOC

;Replaces HRLI AC,440700

	DEFINE PTLOC (AC),<
	HRLI AC,(POINT 7,0)>

FRSBYT==610000,,0
	DEFINE PTGLB (AC)<
	TXO AC,FRSBYT>
   > ;END REPEAT 0


;Macros to generate 8-bit byte pointers where AC already contains an address.

;PTLC8. - generates 8-bit local byte pointer to beginning of word

	DEFINE PTLC8. (AC),<
	HRLI AC,(POINT 8,0)>

;PTGB8. - generates 8-bit global byte pointer to beginning of word

.FR8BY==540000,,0
	DEFINE PTGB8. (AC)<
	TXO AC,.FR8BY>
	SUBTTL
LIT				;MAKE SURE LITERALS COME BEFORE END MARK
   IFN REL,<
.RLEND==:.-1			;MARK END OF CODE IN MACREL
   >
  IF2,<PURGE REL>		;FLUSH REL FROM UNIV FILE

	.XCMSY

	END		;End of MACSYM