Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/comp/simmac.old
There is 1 other file named simmac.old in the archive. Click here to see a list.
00100	;<ENDERIN>SIMMAC.MAC.14, 12-Jan-77 17:30:18, Edit by ENDERIN
00200	;	UNIVERSAL SIMMAC MACRO LIBRARY
00300	
00400	
00500	Comment ;
00600	
00700	Authors:	Stefan Arnborg
00800			Olof Bjoerner
00900			Claes Wihlborg
01000	
01100	Purpose:	This file contains definitions common
01200			to the SIMULA system.
01300	
01400	Version:	4A [03 10 06,04 07 00,12 20 11,13 00 12,14 22 12,14 22 15,
01500			    40,104,136,140,170,217,221,225,247,253,255,260,262,274,275,277,300,306,310]
01600	
01700	Contents:	1. Assembly constants ......... 2
01800			2. Macro library .............. 3
01900			   Stack macros ............... 3
02000			   Queue macros ............... 4
02100			   Conditional macros ......... 5
02200			   BEGIN, ENDD macros ......... 6
02300			   Miscellaneous macros ....... 6-1
02400			   Switch (flag) macros ....... 7
02500			   Subroutine linkage ......... 8
02600			   Record, field macros ....... 9
02700			    LF, SF, WLF, WSF, ZF, SETF  9
02800			    DF (Define Field) ......... 10
02900			    DR (Define Record) ........ 10
03000			    Record discrimination ..... 11
03100			   REServed WorDs macro ....... 12
03200			   SYStem IDentifiers (SYSID) . 13
03300			   SYMBOL macro ............... 14
03400			   SWAPPA(SS) macro ........... 17
03500			   Type codes, declaration fields 18
03600			   DF1 and PASS2 fields ....... 19
03700			3. Global switch definitions .. 20
03800			4. Register assignments ....... 25
03900			5. Operator definitions ....... 26
04000			6. Macros for defining versions 28
04100	;
04200	
04300	IF2,<	PRINTX Update: 310	18-July-1978 12:40/LE
04400	IFDEF .DIRECTIVE,<.DIRECTIVE .NOBIN>;[221]
04500	>
04600	
04700		SALL
     
00100		SUBTTL	Assembly constants
00200	
00300	;	**********************
00400	;	* Assembly constants *
00500	;	**********************
00600	
00700	IFNDEF QSYS,<QSYS==1>		;QSYS   == 1 Means version on SYS area
00800	IFNDEF QDEC20,<QDEC20==0>	;[225] QDEC20 == 1 means TOPS-20 version
00900	IFNDEF QDEBUG,<QDEBUG==0>	;QDEBUG == 1 means DEBUG, not production mode
01000	IFNDEF QERIMP,<QERIMP==1>	;QERIMP == 1 means errors implemented
01100	IFNDEF QSADEA,<QSADEA==1>	;SPECIAL DEALLOCATION ON BLOCK EXIT ETC
01200	IFNDEF QSASTE,<QSASTE==1>	;QSASTE == 1 MEANS ALLOCATION IN STEPS
01300	IFNDEF QTIMER,<QTIMER==0>	;QTIMER == 1 MEANS EXPAND TIMER MACRO
01400	IFNDEF QTRACE,<QTRACE==0>	;QTRACE == 1 MEANS INCLUDE TRACE FACILITIES
01500	IFE QSYS,<QSYSDEV==SIXBIT/DSK/>
01600	IFN QSYS,<QSYSDEV==SIXBIT/SYS/>
01700	DEFINE TOPS20<IFN QDEC20>;[247]
01800	DEFINE TOPS10<IFE QDEC20>;[247]
01900	
02000				;[247]
02100		IFNDEF QKI10,<
02200		 IFNDEF .CPU.,<QKI10==<QKA10==<QKL10==0>>+1>
02300		 IFDEF .CPU.,<
02400			QKA10==<QKI10==<QKL10==0>>
02500			IFL <.CPU.-2>,<PRINTX *** Illegal CPU! ***>
02600			IFE <.CPU.-2>,<QKA10==1>
02700			IFG <.CPU.-2>,<QKI10==1>
02800			IFG <.CPU.-3>,<QKL10==1>
02900			>
03000		>
03100	
03200	DEFINE	KL10<IFN QKL10>;[247]
03300	DEFINE	KI10<IFN QKI10>;[247]
03400	DEFINE	KA10<IFN QKA10>;[247]
03500	
03600	;	PROCESSOR CODE WORD IN NAME BLOCK IN REL FILE
03700	;	IN THIS INSTALLATION SIMULA = OCTAL 15 DETERMINED
03800	;	IN LINK-10 LNKPAR PROCESSORS MACRO
03900	IFNDEF	QSIMREL,<IFN QKI10,<QSIMREL==020015,,0>
04000			IFN QKA10,<QSIMREL==010015,,0>
04100			>
04200	
04300	;[130012] External classes and procedures:
04400	;  Standard library name, system library device (may be changed to SIM later?)
04500		QEXLIB==SIXBIT/LIBSIM/
04600		QEXDEV==SIXBIT/SYS/
04700	
04800	;	SET INSTALLATION DEPENDENT PPN TO 0 IN SYS VERSION
04900	;	OR IF NOT DEFINED IN TEST VERSION (I.E. OWN AS DEFAULT)
05000	IFNDEF QERPPN,<	QERPPN==0>	;;SIMERR.ERR
05100	IFNDEF QHEPPN,<	QHEPPN==0>	;;HELP FILES SIMCOM AND SIMRTS
05200	IFNDEF QP1PPN,<	QP1PPN==0>	;;SIMULA (PASS1)
05300	IFNDEF QP2PPN,<	QP2PPN==0>	;;SIMP2  (PASS2)
05400	IFNDEF QP3PPN,<	QP3PPN==0>	;;SIMP3  (PASS3)
05500	IFNDEF QRTPPN,<	QRTPPN==0>	;;SIMRTS (RUN TIME SYSTEM)
05600	IFNDEF QDEPPN,<	QDEPPN==0>	;;SIMDDT (DEBUG SYSTEM)
05700	
05800	
05900	;	STANDARD CHANNEL NAMES
06000	;	THE CHANNEL NUMBER MUST NOT BE CHANGED WITHOUT CHANGING
06100	;	THE MACRO CALL DCHSW IN SIMMAC AND CONSTANT TABLE T3FINA IN MODULE T3(PASS 3)
06200	
06300		QCHTTY==0
06400		QCHSRC==1
06500		QCHEXT==2
06600		QCHLS1==3
06700		QCHIC1==4
06800		QCHDF1==5
06900		QCHZSE==6
07000		QCHREL==7
07100		QCHATR==10
07200		QCHXRF==11
07300		QCHIC2==12
07400		QCHLST==13
07500		QCHDEB==14
07600		QCHERR==15
07700		QCHIC3==QCHREL
07800		QCHLS3==QCHLST
07900		QCHTRC==16
08000		QCHCOM==17
08100	
08200	
08300	;  NON-PRINTABLE CHARACTERS:
08400	
08500		QNUL==000	;NULL
08600		QEOT==004	;END-OF-FILE SYMBOL
08700		QHT==011	;HORIZONTAL TAB
08800		QLF==012	;LINE FEED
08900		QVT==013	;VERTICAL TAB
09000		QFF==014	;FORM FEED
09100		QCR==015	;CARRIAGE RETURN
09200		QALTMODE==033	;ALTMODE
09300		QDEL==177	;DELETE
09400	
09500	;  BUFFER SIZES:
09600	
09700		QBUFS==203	;DISK BUFFER SIZE
09800		QSTSIZ==1200	;NO OF WORDS IN PUSH DOWN STACK
09900		QSTLL==7	;LENGTH OF YDPD-LEVEL
10000		QZSELE==6000	;INITIAL SIZE OF ZSE
10100		QDC1LE==1000	;INITIAL SIZE OF DC1
10200	
10300	;IF QE3D OR QE3M IS CHANGED DO
10400	;	-RECOMPILE LOWSEG
10500	;	-RECOMPILE O3.MAC DEBUG VERSION
10600	;	-CHANGE VALUE OF QE3D AND QE3M AND LENGTH OF CORRESPONDING LIST IN SUTERR.CBL
10700	
10800		QE3D==700	;LENGTH OF YE3D
10900		QE3M==700	;LENGTH OF YE3M
11000		QBEG==120	;LENGTH OF PUSHDOWN STACK BEGIN NUMBER
11100		QLDM==^D150	;LENGTH OF ZDM
11200	
11300	
11400		QMAXDIS=^D32	;MAX DISPLAY SIZE	;[12 20 11]
11500	
11600	
11700	;	ACCUMULATORS FOR RTS 
11800	;	THESE ARE ALLOCATED BY THE COMPILER
11900	
12000		XWAC1==3
12100		XWAC2==XWAC1+1
12200		XWAC3==XWAC2+1
12300		XWAC4==XWAC3+1
12400		XWAC5==XWAC4+1
12500		XWAC6==XWAC5+1
12600		XWAC7==XWAC6+1
12700		XWACL==14
12800	IFL	<XWAC7-XWACL>,<XWAC10==XWAC7+1>
12900	IFL	<XWAC10-XWACL>,<XWAC11==XWAC10+1>
13000	
13100	;	QNAC IS NUMBER OF ACCUMULATORS  AND ALSO SIZE OF PSEUDOREGISTER STACK
13200	
13300		QNAC==<XWACL-XWAC1+1>
13400	
13500		QHASHM==13045647327
13600	
13700	
13800	IFN QDEC20,<;[225]
13900	DEFINE DIRST%<XEC DIRST.##>
14000	DEFINE PPNST%<XEC PPNST.##>
14100	DEFINE STPPN%<XEC STPPN.##>
14200	>
     
00100		SUBTTL	STACK MACROS
00200		
00300	;			*****************
00400	;			* MACRO LIBRARY *
00500	;			*****************
00600	
00700	
00800	;			STACK HANDLING
00900	;			==============
01000	;
01100	;
01200	; Stack creation: GETSTACK a,h
01300	;		  a=stackname, one letter
01400	;		  h=halfword if given, otherwise full word
01500	; This macro defines one stack, the operations on the stack
01600	; and the assembly-time variables necessary
01700	;
01800	; Insertion in stack:   aPUSH W  or  aPUSH LH,RH
01900	;
02000	; deletion from stack:	aPOP  W  or  aPOP  LH,RH
02100	; Arguments are optional
02200	;
02300	; Valuable assembly-time variables:
02400	;	aSSIZE	(Number of elements in stack
02500	;	aTOP	(Top element in stack
02600	;	aTOPL	(Top left halfword in stack
02700	;	aTOPR	(Top right halfword in stack
02800	;
02900	;
03000	;
03100	IF2,<
03200	
03300	DEFINE GETSTACK (A,H)<
03400		.XCREF
03500		X=-1
03600		IRPC A,<
03700		X=X+1>
03800		IFN X,<$$E(<Stack name a not one letter>)>
03900		IFE X,<
04000	IF1,<	IFDEF A'SSIZE,<$$E(<Double decl. of stack a>)>>
04100		A'SSIZE=0	
04200		IFB <H>,<A'TOP=0>	
04300		IFNB <H>,<A'TOPL=0	
04400		A'TOPR=0>	
04500		IFB <H>,<
04600	DEFINE  A'PUSH (D)<
04700		IFE  A'SSIZE -7777,<$$E(<Overflow in stack a>)>
04800		A'SSIZE=A'SSIZE+1
04900		$$C(A,\A'SSIZE,$)=A'TOP
05000		A'TOP=D
05100	>>
05200		IFNB <H>,<
05300	DEFINE  A'PUSH (D,E)<
05400		IFE  A'SSIZE-7777,<$$E(<Overflow in stack a>)>
05500		A'SSIZE=A'SSIZE+1
05600		$$C(A,\A'SSIZE,$)=A'TOPL*1000000+A'TOPR
05700		A'TOPL=D
05800		A'TOPR=E
05900	>>
06000		IFB <H>,<
06100	DEFINE  A'POP(D)<
06200		IFE  A'SSIZE,<$$E(<Underflow in stack a>)>
06300		IFG A'SSIZE,<
06400		IFNB <D>,<D=A'TOP>
06500		A'TOP=$$C(A,\A'SSIZE,$)
06600		$$$P(A,\A'SSIZE,$)
06700		A'SSIZE=A'SSIZE-1
06800	>>>
06900		IFNB <H>,<
07000	DEFINE  A'POP (D,E)<
07100		IFE  A'SSIZE,<$$E(<Underflow in stack a>)>
07200		IFG A'SSIZE,<
07300		IFNB <D>,<D=A'TOPL>
07400		IFNB <E>,<E=A'TOPR>
07500		A'TOPL=$$C(A,\A'SSIZE,$)/1000000
07600		A'TOPR=$$C(A,\A'SSIZE,$)&777777
07700		$$$P(A,\A'SSIZE,$)
07800		A'SSIZE=A'SSIZE-1
07900	>>>
08000	>
08100	.CREF
08200	>
     
00100		SUBTTL	QUEUE MACROS
00200	;
00300	;			QUEUE HANDLING
00400	;			==============
00500	;
00600	;
00700	; Queue creation: GETQUE a,h
00800	;  		  a=queuename, one letter
00900	;		  h=halfword if given, otherwise full word
01000	; This macro defines one queue, the operations on the queue
01100	; and the assembly time variables necessary
01200	;
01300	; Insertion in queue:  aINQ  W  or aINQ  LH,RH
01400	;
01500	; Deletion from queue: aOUTQ W  or aOUTQ LH,RH
01600	; Arguments are optional
01700	;
01800	; Valuable assembly time variables:
01900	;	aQSIZE  (Number of elements in queue
02000	;	aHEAD	(First element in queue
02100	;	aHEADL	(First left halfword in queue
02200	;	aHEADR	(First right halfword in queue
02300	;
02400	;
02500	;
02600	DEFINE  GETQUE (A,H)<
02700		.XCREF
02800		X=-1
02900		IRPC A,<
03000		X=X+1>
03100		IFN X,<$$E(<Queue name a not one letter>)>
03200	IF1,<	IFDEF A'QSIZE,<$$E(<Double decl. of queue a>)>>
03300		$$Q'A'H=0
03400		$$Q'A'T=0
03500		A'QSIZE=0
03600		IFB <H>,<
03700	DEFINE  A'OUTQ(W)<
03800		IFE A'QSIZE,<$$E(<Underflow in queue a>)>
03900		IFNB <W>,<W=A'HEAD>
04000		A'QSIZE=A'QSIZE-1
04100		$$$P(A,\$$Q'A'H,%)
04200		$$Q'A'H=<$$Q'A'H+1>&7777
04300		IFN A'QSIZE,<A'HEAD=$$C(A,\$$Q'A'H,%)>
04400	>
04500	DEFINE  A'INQ(W)<
04600		IFE A'QSIZE-7777,<$$E(<Overflow in queue a>)>
04700		$$C(A,\$$Q'A'T,%)=W
04800		IFE A'QSIZE,<A'HEAD=W>
04900		A'QSIZE=A'QSIZE+1
05000		$$Q'A'T=<$$Q'A'T+1>&7777
05100	>
05200	>
05300		IFNB <H>,<
05400	DEFINE  A'OUTQ(L,R)<
05500		IFE A'QSIZE,<$$E(<Underflow in queue a>)>
05600		IFNB <L>,<L=A'HEADL>
05700		IFNB <R>,<R=A'HEADR>
05800		A'QSIZE=A'QSIZE-1
05900		$$$P(A,\$$Q'A'H,%)
06000		$$Q'A'H=<$$Q'A'H+1>&7777
06100		IFN A'QSIZE,<A'HEADL=$$C(A,\$$Q'A'H,%)/1000000
06200			A'HEADR=$$C(A,\$$Q'A'H,%)&777777>
06300	>
06400	DEFINE  A'INQ(L,R)<
06500		IFE A'QSIZE-7777,<$$E(<Overflow in queue a>)>
06600		$$C(A,\$$Q'A'T,%)=L*1000000+R
06700		IFE A'QSIZE,<A'HEADL=L
06800		A'HEADR=R>
06900		A'QSIZE=A'QSIZE+1
07000		$$Q'A'T=<$$Q'A'T+1>&7777
07100	>
07200	>
07300	.CREF
07400	>
     
00100		SUBTTL	COND MACROS
00200	;
00300	;			CONDITIONAL STATEMENTS
00400	;			======================
00500	;
00600	;
00700	DEFINE IF<
00800		.XCREF
00900		$$C($$,\<$$BSP>)==$$BST
01000		$$C($$,\<$$BSP+1>)==$$LT
01100		$$C($$,\<$$BSP+2>)==$$LF
01200		$$C($$,\<$$BSP+3>)==$$LE
01300		$$BSP==$$BSP+4
01400		$$BST==1
01500		$$LT==$$L
01600		$$LF==$$L+1
01700		$$L==$$L+2
01800		$$$IF
01900		.CREF
02000	>
02100	DEFINE THEN<
02200		.XCREF
02300		IFN $$BST-1,<$$E(<Illegal then>)>
02400		$$$THEN
02500		$$C(L,\$$LT):$$BST==5
02600		.CREF
02700	>
02800	DEFINE ELSE<
02900		.XCREF
03000		IFN $$BST-5,<$$E(<Illegal else>)>
03100		$$LE==$$L
03200		$$L==$$L+1
03300		GOTO $$C(L,\$$LE)-$$RELO($$BAS)
03400		$$C(L,\$$LF): $$BST==6
03500		.CREF
03600	>
03700	DEFINE FI<
03800		.XCREF
03900		IFN<$$BST-5>*<$$BST-6>,<$$E(<Illegal fi>)>
04000		IFE $$BST-5,<
04100		$$C(L,\$$LF):>
04200		IFE $$BST-6,<
04300		$$C(L,\$$LE): $$$P2(L,\$$LE)>
04400		$$$P2(L,\$$LT)
04500		$$$P2(L,\$$LF)
04600		$$BSP==$$BSP-4
04700		$$BST==$$C($$,\<$$BSP>)
04800		$$LT==$$C($$,\<$$BSP+1>)
04900		$$LF==$$C($$,\<$$BSP+2>)
05000		$$LE==$$C($$,\<$$BSP+3>)
05100		.CREF
05200	>
05300	;
05400	;
05500	DEFINE WHILE<
05600		.XCREF
05700		$$C($$,\<$$BSP>)==$$BST
05800		$$C($$,\<$$BSP+1>)==$$LT
05900		$$C($$,\<$$BSP+2>)==$$LF
06000		$$C($$,\<$$BSP+3>)==$$LE
06100		$$BSP==$$BSP+4
06200		$$BST==2
06300		$$LT==$$L
06400		$$LF==$$L+1
06500		$$LE==$$L+2
06600		$$L==$$L+3
06700		$$C(L,\$$LE): $$$WHILE
06800		.CREF
06900	>
07000	DEFINE DO<
07100		.XCREF
07200		IFN $$BST-2,<$$E(<Illegal do>)>
07300		$$$DO
07400		$$C(L,\$$LT): $$BST==7
07500		.CREF
07600	>
07700	DEFINE OD<
07800		.XCREF
07900		IFN $$BST-7,<$$E(<Illegal od>)>
08000		GOTO $$C(L,\$$LE)-$$RELO($$BAS)
08100		$$C(L,\$$LF): $$BSP==$$BSP-4
08200		$$$P2(L,\$$LT)
08300		$$$P2(L,\$$LF)
08400		$$$P2(L,\$$LE)
08500		$$BST==$$C($$,\<$$BSP>)
08600		$$LT==$$C($$,\<$$BSP+1>)
08700		$$LF==$$C($$,\<$$BSP+2>)
08800		$$LE==$$C($$,\<$$BSP+3>)
08900		.CREF
09000	>
09100	;
09200	;
09300	DEFINE LOOP<
09400		.XCREF
09500		$$C($$,\<$$BSP>)==$$BST
09600		$$C($$,\<$$BSP+1>)==$$LT
09700		$$C($$,\<$$BSP+2>)==$$LF
09800		$$BSP==$$BSP+3
09900		$$LT==$$L
10000		$$LF==$$L+1
10100		$$L==$$L+2
10200		$$C(L,\$$LT): $$BST==10
10300		.CREF
10400	>
10500	DEFINE AS<
10600		.XCREF
10700		IFN $$BST-10,<$$E(<Illegal as>)>
10800		$$BST==3
10900		$$$AS
11000		.CREF
11100	>
11200	DEFINE SA<
11300		.XCREF
11400		IFN $$BST-3,<$$E(<Illegal sa>)>
11500		$$$SA
11600		$$C(L,\$$LF): $$BSP==$$BSP-3
11700		$$$P2(L,\$$LT)
11800		$$$P2(L,\$$LF)
11900		$$BST==$$C($$,\<$$BSP>)
12000		$$LT==$$C($$,\<$$BSP+1>)
12100		$$LF==$$C($$,\<$$BSP+2>)
12200		.CREF
12300	>
12400	;
12500	;
12600	DEFINE GOIF<
12700		.XCREF
12800		$$C($$,\<$$BSP>)==$$BST
12900		$$C($$,\<$$BSP+1>)==$$LT
13000		$$C($$,\<$$BSP+2>)==$$LF
13100		$$BSP==$$BSP+3
13200		$$LT==$$L
13300		$$LF==$$L+1
13400		$$L==$$L+2
13500		$$BST==4
13600		$$$GOIF
13700		.CREF
13800	>
13900	DEFINE TO(A)<
14000		.XCREF
14100		IFN $$BST-4,<$$E(<Illegal to>)>
14200		$$$TO
14300		$$C(L,\$$LT): $$BSP==$$BSP-3
14400		GOTO A
14500		$$C(L,\$$LF):
14600		$$$P2(L,\$$LT)
14700		$$$P2(L,\$$LF)
14800		$$BST==$$C($$,\<$$BSP>)
14900		$$LT==$$C($$,\<$$BSP+1>)
15000		$$LF==$$C($$,\<$$BSP+2>)
15100		.CREF
15200	>
15300	;
15400	;
15500	DEFINE TRUE<$$C(L,\$$LT)-$$RELO($$BAS)>
15600	DEFINE FALSE<$$C(L,\$$LF)-$$RELO($$BAS)>
15700	
15800	
15900	;	EMPTY MACROS:
16000	
16100	DEFINE $$$IF<>
16200	DEFINE $$$THEN<>
16300	DEFINE $$$WHILE<>
16400	DEFINE $$$DO<>
16500	DEFINE $$$AS<>
16600	DEFINE $$$SA<>
16700	DEFINE $$$GOIF<>
16800	DEFINE $$$TO<>
16900	
17000	
17100	;	INITIATING MACRO:
17200	
17300	DEFINE MACINIT=<
17400		SEARCH	UUOSYM;;[247]
17500	IFN QDEC20,<SEARCH MONSYM>;;[225]
17600		IF1,<ED$$MX==0>
17700		DEFINE EDIT(n)<;;[255]
17800		ED'n==n
17900		IF1,<
18000		IFG <n-ED$$MX>,<ED$$MX==n>
18100		>>
18200		IF2,<
18300		DEFINE $$ped(n)<PRINTX Edit: n>
18400		     IFN ED$$MX,<$$ped(\ED$$MX)>
18500		     PURGE $$ped,ED$$MX
18600		>
18700		.XCREF
18800		$$L==20
18900		.CREF
19000	>
     
00100		SUBTTL	BLOCK MACROS
00200	
00300	;	BEGIN - ENDD
00400	;	============
00500	
00600	
00700	DEFINE BEGIN<
00800	.XCREF
00900	$$C($$,\<$$BSP>)==$$BST
01000	$$C($$,\<$$BSP+1>)==$$L1
01100	$$C($$,\<$$BSP+2>)==$$L2
01200	$$C($$,\<$$BSP+3>)==$$L3
01300	$$C($$,\<$$BSP+4>)==$$L4
01400	$$C($$,\<$$BSP+5>)==$$L5
01500	$$C($$,\<$$BSP+6>)==$$L6
01600	$$C($$,\<$$BSP+7>)==$$L7
01700	$$C($$,\<$$BSP+10>)==$$L8
01800	$$C($$,\<$$BSP+11>)==$$L9
01900	$$C($$,\<$$BSP+12>)==$$L10
02000	$$BST==11
02100	$$BSP==$$BSP+13
02200	$$L1==$$L+1
02300	$$L2==$$L+2
02400	$$L3==$$L+3
02500	$$L4==$$L+4
02600	$$L5==$$L+5
02700	$$L6==$$L+6
02800	$$L7==$$L+7
02900	$$L8==$$L+10
03000	$$L9==$$L+11
03100	$$L10==$$L
03200	$$L==$$L+12
03300	.CREF
03400	>
03500	DEFINE ENDD<
03600	.XCREF
03700	IFN $$BST-11,<$$E(<Illegal endd>)>
03800	$$BSP==$$BSP-13
03900	$$$PD2(L,\$$L1)
04000	$$$PD2(L,\$$L2)
04100	$$$PD2(L,\$$L3)
04200	$$$PD2(L,\$$L4)
04300	$$$PD2(L,\$$L5)
04400	$$$PD2(L,\$$L6)
04500	$$$PD2(L,\$$L7)
04600	$$$PD2(L,\$$L8)
04700	$$$PD2(L,\$$L9)
04800	$$$PD2(L,\$$L10)
04900	$$BST==$$C($$,\$$BSP)
05000	$$L1==$$C($$,\<$$BSP+1>)
05100	$$L2==$$C($$,\<$$BSP+2>)
05200	$$L3==$$C($$,\<$$BSP+3>)
05300	$$L4==$$C($$,\<$$BSP+4>)
05400	$$L5==$$C($$,\<$$BSP+5>)
05500	$$L6==$$C($$,\<$$BSP+6>)
05600	$$L7==$$C($$,\<$$BSP+7>)
05700	$$L8==$$C($$,\<$$BSP+10>)
05800	$$L9==$$C($$,\<$$BSP+11>)
05900	$$L10==$$C($$,\<$$BSP+12>)
06000	.CREF
06100	>
06200	;
06300	;
06400	;
06500	;			MISCELLANEOUS
06600	;			=============
06700	;
06800	;
06900	DEFINE $$C(A,B,C)<A'B'C'>
07000	;
07100	;
07200	DEFINE X(A)<IRP A,<
07300	$$L'A==0
07400	DEFINE L'A(B)<$$C(L,\$$L'A)>>>
07500	X <1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19>
07600	$$L==20
07700	;
07800	;
07900	DEFINE $$E(A)<IF1,<PRINTX *** ERROR: A ***>>
08000	;
08100	;
08200	DEFINE	$$$P(A,B,C)<
08300		PURGE A'B'C>
08400	
08500	DEFINE	$$$P2(A,B)<
08600		IF2,<PURGE A'B>>
08700	
08800	DEFINE	$$$PD2(A,B)<
08900		IFDEF A'B,<IF2,<PURGE A'B>>>
09000	;
09100	;
09200	$$BST==0
09300	$$BSP==0
09400	$$LT==0
09500	$$LF==0
09600	$$LE==0
09700	DEFINE $$RELO(A)<0>		;USED IN SIMDDT WHERE RELOCATABLE
09800					;ADDRESSES CAN  NOT BE USED
09900					;$$RELO==MODULE START
10000	$$BAS==0			;$$BAS==BASE ACCUMULATOR
10100	;
10200	;
10300	DEFINE RNAME(NEW,OLD)
10400	<.K==0
10500	IRP NEW <.K==.K+1>
10600	RENAM1 <1,2,3,4,5,6,7,10,11,12,13,14,15,16,17>,<NEW>,<OLD>
10700	>
10800	
10900	DEFINE RENAM1(LOOP,NEW,OLD)
11000	<IRP LOOP <IFE <LOOP-.K>,<STOPI>
11100		   .I==0
11200		   IRP OLD <.I==.I+1
11300			    IFE <.I-LOOP>,<STOPI
11400					   .C==OLD>
11500			   >
11600		   .I==0
11700		   IRP NEW <.I==.I+1
11800			    IFE <.I-LOOP>,<STOPI
11900					   NEW==.C>
12000			   >
12100		  >
12200	PURGE OLD
12300	>
12400	DEFINE	ZEROCHECK(L)=<
12500		ASSERT<IRP	L <
12600			IFN	<L>,<CFAIL	ZEROCHECK FAILURE>
12700			>
12800		>
12900	>
     
00100		SUBTTL	SWITCH MACROS
00200	
00300	;		SWITCH HANDLING MACROS
00400	;		======================
00500	
00600		
00700	
00800	COMMENT ;
00900	
01000		DSW, SETON, SETOFF, IFON AND IFOFF
01100		DEFINE MACROS FOR SETTING, RESETTING AND TESTING A SWITCH.
01200		A SWITCH MAY BE EITHER A SINGLE BIT OR A WORD.
01300		A SWITCH IS SAID TO BE ON IF IT IS ALL ONES AND OFF
01400		IF IT IS ZERO.
01500	
01600	
01700	
01800		DEFINE SWITCH MACRO:
01900	
02000		ARGUMENTS:	W   WORD NAME
02100				F   BIT NAME
02200				N   BIT NUMBER (DECIMAL)
02300				XB  BASE REGISTER (OPTIONAL)
02400	
02500		IF THE SWITCH IS A SINGLE BIT THEN
02600		THE FOLLOWING IS DEFINED:
02700				VF  A BIT MASK
02800				CF  THE COMPLEMENT OF VF
02900	;
03000	
03100	DEFINE DSW (F,W,N,XB)=<
03200	
03300	IFL <^D36-^D'N>,<$$E(<TOO BIG BIT NO>)>
03400	IFE ^D36-^D'N,<
03500	 IFB <XB>,<DEFINE F(ACC)=<
03600		IFE <%OP%-2>,<$$E(<ILL SWITCH NAME>)>
03700		IFN <%OP%-2>,<
03800		 IFE <%OP%-3>,<%OP3 777777>
03900		 IFE <%OP%-4>,<%OP3>
04000		 IFL <%OP%-2>,<%OP4 W(ACC)>
04100				%OP%==2>>>
04200	 IFNB <XB>,<DEFINE F=<
04300		IFE <%OP%-2>,<$$E(<ILL SWITCH NAME>)>
04400		IFN <%OP%-2>,<
04500		 IFE <%OP%-3>,<%OP3 XB,777777>
04600		 IFE <%OP%-4>,<%OP3 XB,>
04700		 IFL <%OP%-2>,<%OP4 W(XB)>
04800			     %OP%==2>>>>
04900	IFGE	^D35-^D'N,<
05000		V'F==1B'N
05100	IFE	^D'N,<
05200		C'F==377777777777>
05300	IFN	^D'N,<
05400		C'F==-1*V'F-1>
05500	IFGE ^D17-^D'N,<
05600		C'F==C'F_-^D18
05700		V'F==V'F_-^D18>
05800	
05900	DEFINE	$$TES1(X,Y,Z)<
06000	
06100	IFGE	^D17-^D'N,<
06200	IFB <Z>,<DEFINE F(ACC)<
06300	IFE <%OP%-1>,<%OP1 Y>
06400	IFE %OP%,<%OP1 X>
06500	IFE <%OP%-2>,<$$E(<ILL SWITCH NAME>)>
06600	IFGE <%OP%-3>,<IFB <ACC>,<%OP1 Y>
06700		IFNB <ACC>,<%OP1 ACC,Y>>
06800	IFL<%OP%-2>,<%OP3 W(ACC)>
06900	%OP%==2>>
07000	IFNB <Z>,<DEFINE F=<
07100	IFE <%OP%-1>,<%OP1 Y>
07200	IFE %OP%,<%OP1 X>
07300	IFE <%OP%-2>,<$$E(<ILL SWITCH NAME>)>
07400	IFGE <%OP%-3>,<%OP1 Z,Y>
07500	IFL <%OP%-2>,<%OP3 W(Z)>
07600	%OP%==2>>>
07700	
07800	IFL ^D17-^D'N,<
07900	IFB <XB>,<DEFINE F(ACC)<
08000	IFE %OP%-1,<%OP2 Y>
08100	IFE %OP%,<%OP2 X>
08200	IFE <%OP%-2>,<$$E(<ILL SWITCH NAME>)>
08300	IFGE <%OP%-3>,<IFB <ACC>,<%OP2 Y>
08400		IFNB <ACC>,<%OP2 ACC,Y>>
08500	IFL <%OP%-2>,<%OP3 W(ACC)>
08600	%OP%==2>>
08700	IFNB <XB>,<DEFINE F=<
08800	IFE <%OP%-1>,<%OP2 Y>
08900	IFE %OP%,<%OP2 X>
09000	IFE <%OP%-2>,<$$E(<ILL SWITCH NAME>)>
09100	IFGE <%OP%-3>,<%OP2 Z,Y>
09200	IFL <%OP%-2>,<%OP3 W(Z)>
09300	%OP%==2>>
09400	>
09500	>
09600		$$TES1(\C'F,\V'F,XB)
09700		PURGE V'F,C'F
09800	>
09900	>
10000	
10100	
10200	;	OPCODE MACROS:
10300	
10400		DEFINE SETOFF<
10500		.XCREF
10600		OPDEF		%OP1	[HRLOI]
10700		OPDEF	      %OP2	[HRROI]
10800		OPDEF	      %OP3	[ANDM]
10900		OPDEF		%OP4	[SETZM]
11000			%OP%==0
11100		.CREF
11200	>
11300	
11400		DEFINE SETON <
11500		.XCREF
11600		OPDEF	%OP1	[HRLZI]
11700		OPDEF	      %OP2	[MOVEI]
11800		OPDEF	      %OP3	[IORM]
11900		OPDEF		%OP4	[SETOM]
12000			%OP%==1
12100		.CREF
12200	>
12300	
12400		DEFINE IFON  <
12500		.XCREF
12600		OPDEF	%OP1	[HRLZI]
12700		OPDEF	      %OP2	[MOVEI]
12800		OPDEF	      %OP3	[TDNE]
12900		OPDEF		%OP4	[SKIPE]
13000			%OP%==1
13100		.CREF
13200	>
13300	
13400		DEFINE IFOFF <
13500		.XCREF
13600		OPDEF	%OP1	[HRLZI]
13700		OPDEF	      %OP2	[MOVEI]
13800		OPDEF	      %OP3	[TDNN]
13900		OPDEF		%OP4	[SKIPN]
14000		%OP%==1
14100		.CREF
14200	>
14300	
14400	DEFINE IFONA<
14500		.XCREF
14600		      %OP%==3
14700		OPDEF	      %OP1	[TLNE ]
14800		OPDEF	      %OP2	[TRNE ]
14900		OPDEF	      %OP3	[CAIE ]
15000		.CREF
15100	>
15200	
15300	DEFINE IFOFFA<
15400		.XCREF
15500		      %OP%==3
15600		OPDEF	      %OP1	[TLNN ]
15700		OPDEF	      %OP2	[TRNN ]
15800		OPDEF	      %OP3	[CAIN ]
15900		.CREF
16000	>
16100	DEFINE SETONA<
16200		.XCREF
16300		      %OP%==3
16400		OPDEF	      %OP1	[TLO]
16500		OPDEF	      %OP2	[TRO]
16600		OPDEF	      %OP3	[SETO]
16700		.CREF
16800	>
16900	
17000	DEFINE SETOFA<
17100		.XCREF
17200		      %OP%==4
17300		OPDEF	      %OP1	[TLZ]
17400		OPDEF	      %OP2	[TRZ]
17500		OPDEF	      %OP3	[SETZ]
17600		.CREF
17700	>
     
00100		SUBTTL	SUBROUTINE LINKAGE MACROS
00200	
00300	
00400	;		SUBROUTINE LINKAGE MACROS
00500	;		=========================
00600	
00700		GETSTACK P
00800		GETSTACK R
00900		GETSTACK E
01000		GETSTACK S
01100	
01200	DEFINE	$$KILL	(P1)=<PURGE %.%'P1>
01300	
01400	DEFINE	$$HELP	(P1,P2)=<
01500	.CREF
01600	DEFINE P1=<%.%'P2(XPDP)>
01700	.XCREF>
01800	
01900	
02000	DEFINE	EXEC	(L,X)=<
02100	 .XCREF
02200	 IFNB <X>,<
02300		 $$LOOP==0
02400	 IRP X,<
02500		 $$LOOP==$$LOOP-1
02600		.CREF
02700		 STACK	X
02800		.XCREF>
02900	>
03000		.CREF
03100		 XEC	L ;;[221]
03200		.XCREF
03300	 IFDEF $$LOOP,<
03400		 SUB	XPDP, [XWD -$$LOOP,-$$LOOP]
03500		 PURGE	$$LOOP>
03600	.CREF
03700	>
03800	
03900	DEFINE	PROC	(X)=<
04000	.XCREF
04100	IFDEF $$NO,<$$E(<DOUBLE PROC>)>
04200	IFDEF $$TEMP,<PURGE $$TEMP>
04300	IFNDEF $$NO,<
04400	BEGIN
04500	.XCREF
04600		 $$NO==0
04700	IRP X,<
04800		 $$NO==$$NO-1>
04900		 $$NR==-$$NO
05000	IRP X,<
05100		 %.%==-$$NO
05200		 PPUSH	%.%
05300		 $$C(%.%,\%.%)==$$NO
05400		 $$HELP(X,\%.%)
05500		 $$NO==$$NO+1>>
05600	.CREF
05700	>
05800	
05900	DEFINE	SAVE	(X)<
06000	.XCREF
06100	IFDEF $$NO,<
06200	IFDEF $$SNOX,<
06300		 $$E(<DOUBLE SAVE ILLEGAL>)>
06400	IFNDEF $$SNOX,<
06500		 $$SNOX==0
06600		$$TEMP==0
06700	IRP X,<
06800		 $$SNOX==$$SNOX+1
06900		 SPUSH 	X
07000		.CREF
07100		 STACK	X
07200		.XCREF>
07300	REPEAT $$NR,<
07400		 PPOP	$$TEMP
07500		 EPUSH	$$TEMP
07600		 $$C(%.%,\$$TEMP)==-$$TEMP-$$SNOX>>>
07700	IFNDEF $$NO,<
07800		 $$SNOY==0
07900	 IRP X,<
08000		 SPUSH X
08100		 $$SNOY==$$SNOY+1
08200		.CREF
08300		 STACK X
08400		.XCREF>>
08500	.CREF
08600	>
08700	
08800	DEFINE	RETURN=<
08900		.XCREF
09000		RESTORE
09100		 POPJ XPDP,
09200		.CREF
09300	>
09400	
09500	DEFINE RESTORE=<
09600	 IFDEF $$NO,<
09700	  IFDEF $$SNOX,<
09800	   REPEAT $$SNOX,<
09900		SPOP	$$TEMP
10000		RPUSH	$$TEMP
10100		UNSTK	$$TEMP
10200	   >
10300	   REPEAT $$SNOX,<
10400		RPOP	$$TEMP
10500		SPUSH	$$TEMP
10600	   >
10700	  >
10800	 >
10900	 IFNDEF $$NO,<
11000	  IFDEF $$SNOY,<
11100	   REPEAT $$SNOY,<
11200		SPOP	$$TEMP
11300		RPUSH	$$TEMP
11400		UNSTK	$$TEMP
11500	   >
11600	   REPEAT $$SNOY,<
11700		RPOP	$$TEMP
11800		SPUSH	$$TEMP
11900	   >
12000	  >
12100	 >
12200	>
12300	
12400	DEFINE	EPROC=<
12500	 .XCREF
12600	 IFDEF $$SNOY,<PURGE $$SNOY>
12700	 IFNDEF $$NO,<$$E(<ILLEGAL EPROC>)>
12800	 IFDEF $$NO,<			;;IF PROC WAS DONE
12900		 $$T1==0
13000		 PURGE	$$NO		;;FLAG EPROC DONE
13100	 REPEAT $$NR,<
13200	IFDEF $$TEMP,<EPOP $$T1>
13300	IFNDEF $$TEMP,<PPOP $$T1>
13400		 $$KILL	(\$$T1)>	;;KILL ALL CONSTANTS OF TYPE %.%
13500		 PURGE	$$NR
13600	 IFDEF $$TEMP,<			;;IF SAVE WAS DONE
13700		 PURGE	$$SNOX
13800		 PURGE	$$TEMP>
13900		 PURGE $$T1
14000		 ENDD>>
     
00100		SUBTTL	RECORD AND FIELD HANDLING MACROS
00200	
00300	;	RECORD - FIELD MACROS
00400	;	=====================
00500	
00600	
00700	; DEFINE FIELD ACCESS MACROS
00800	;
00900	; LOAD FIELD ZF OF THE RECORD POINTED TO BY XB
01000	; TO XT WITH THE MACRO CALL:
01100	;	LF(XT) ZF(XB)
01200	DEFINE LF(XT,A,B)=<
01300	OPDEF $L [HLRZ XT,]
01400	OPDEF $R [HRRZ XT,]
01500	OPDEF $F [MOVE XT,]
01600	OPDEF $B [LDB XT,]
01700	$$USE==1
01800	IFNB <A>,<
01900	IFNB <B>,<A,B>
02000	IFB <B>,<A>
02100	>
02200	>
02300	; SF IS THE REVERSE OF LF, I.E. STORES THE VALUE IN XS
02400	; INTO THE FIELD ZF OF THE RECORD AT XB WITH:
02500	;	SF(XS) ZF(XB)
02600	DEFINE SF(XT,A,B)=<
02700	OPDEF $L [HRLM XT,]
02800	OPDEF $R [HRRM XT,]
02900	OPDEF $F [MOVEM XT,]
03000	OPDEF $B [DPB XT,]
03100	$$USE==1
03200	IFNB <A>,<
03300	IFNB <B>,<A,B>
03400	IFB <B>,<A>
03500	>
03600	>
03700	; WLF LOADS AN ENTIRE WORD CONTAINING A FIELD
03800	; XT,XB AND FIELD NAME OCCUR AS FOR LF AND SF
03900	;
04000	DEFINE WLF(XT)=<
04100	$$USE==0
04200	OPDEF $F [MOVE XT,]
04300	>
04400	; WSF STORES XT IN A WORD CONTAINING THE SPECIFIED FIELD BASED BY XB:
04500	;	WSF (XT) ZF(XB)
04600	DEFINE WSF(XT)=<
04700	$$USE==0
04800	OPDEF $F [MOVEM XT,]
04900	>
05000	DEFINE	ZF(A,B)	<
05100	OPDEF	$L	[HRRZS]
05200	OPDEF	$R	[HLLZS]
05300	OPDEF	$F	[SETZM]
05400	PURGE	$B,$B
05500	$$USE==1
05600	IFNB <A>,<
05700		IFNB <B>,<A,B>
05800		IFB  <B>,<A>
05900		>
06000	>
06100	DEFINE SETF(QVAL)=<
06200	$$$VAL=QVAL
06300	SF()
06400	$$USE=3
06500	>
06600	DEFINE	OFFSET(A)<<$'A>&777777>
06700	DEFINE SIZE(Q,Z)=<
06800	Q=<<<$'Z>B59>&77>
06900	>
07000	
07100	; [247] LFE (from SIMRPA) loads a fullword or a halfword with sign extension.
07200	; Otherwise identical to LF, but cannot be used when a byte pointer is required.
07300	
07400	DEFINE LFE(xt,a,b)<
07500		OPDEF $L [HLRE xt,]
07600		OPDEF $R [HRRE xt,]
07700		OPDEF $F [MOVE xt,]
07800		PURGE $B,$B
07900		$$USE==1
08000		IFNB <a>,<
08100		 IFNB <b>,<a,b>
08200		 IFB  <b>,<a>
08300		>
08400	>
     
00100	; INTERNAL USE ONLY
00200	; FIELD DEFINITION MACRO
00300	DEFINE DF(F,W,S,P)=<
00400	$$DEF==0
00500	IFE <^D'S-^D36>,<DEFINE F(XB,O)=
00600	<$%W==W
00700	IFNB <O>,<$%W==W+<O>
00800	>
00900	IFE <$$USE-3>,<LI $$$VAL
01000	$$USE==1>
01100	$F $%W(XB)>
01200	$$DEF==1>
01300	IFE <^D'S-^D18>,<IFE <^D'P-^D17>,
01400	<;; LEFT HW
01500	DEFINE F(XB,O)=<
01600	$%W==W
01700	IFNB <O>,<$%W==W+<O>>
01800	IFE <$$USE-3>,<LI $$$VAL
01900	$$USE==1>
02000	IFE $$USE,<$F $%W(XB)>
02100	IFE <$$USE-1>,<$L $%W(XB)>
02200	IFE <$$USE-2>,<PRINTX OPD-OPR NESTING ERROR>
02300	$$USE==2>
02400	$$DEF==1>
02500	IFE <^D'P-^D35>,
02600	<DEFINE F(XB,O)=<
02700	$%W==W
02800	IFNB <O>,<$%W==W+<O>>
02900	IFE <$$USE-3>,<LI $$$VAL
03000	$$USE==1>
03100	IFE $$USE,<$F $%W(XB)>
03200	IFE <$$USE-1>,<$R $%W(XB)>
03300	IFE <$$USE-2>,<PRINTX OPD-OPR NESTING ERROR>
03400	$$USE==2>
03500	$$DEF==1>
03600	>
03700	IFE $$DEF,<
03800	DEFINE F(XB,O)=<
03900	$%W==W
04000	IFNB <O>,<$%W==W+<O>>
04100	IFE <$$USE-3>,<LI $$$VAL
04200	$$USE==1>
04300	IFE $$USE,<$F $%W(XB)>
04400	IFE <$$USE-1>,<$B [$'F O(XB)]-$$RELO($$BAS)>
04500	IFE <$$USE-2>,<PRINTX INVALID USE OF FIELD>
04600	$$USE==2>
04700	$$DEF==1>
04800	OPDEF $'F [POINT S,W,P]
04900	$'F==$'F
05000	%'F==^D'P
05100	IFE <^D'S-1>,<DSW (F,W,P)>
05200	>
05300	; RECORD DEFINITION
05400	DEFINE DR(ZR,S,TF,TV)=<
05500	ZR'%S==S
05600	ZR'%V==TV
05700	DEFINE ZR'%F=<TF>
05800	>
     
00100	; RECORD TEST MACROS
00200	; SKIP IF XB POINTS TO ZR TYPE RECORD
00300	DEFINE WHEN(XB,ZR,O)=<
00400	IFEQF XB,ZR'%F,ZR'%V,O>
00500	DEFINE WHENNOT(XB,ZR,O)=<
00600	IFNEQF XB,ZR'%F,ZR'%V,O>
00700	DEFINE IFEQF(XB,ZF,QV,O)=<
00800	LF() ZF(XB,O)
00900	CAIN QV
01000	>
01100	DEFINE IFNEQF(XB,ZF,QV,O)=<
01200	LF() ZF(XB,O)
01300	CAIE QV
01400	>
01500	DEFINE STEP(XB,ZR,XC)=<
01600	 $%X==XB
01700	 IFNB <XC>,<$%X==XC>
01800	 LI $%X,ZR'%S(XB)
01900	>
02000	DEFINE SSTEP(XB,ZR)=<
02100		ADD	XB,[XWD	ZR'%S,ZR'%S]>
02200	DEFINE STEPJ(XB,ZR,LAB)=<
02300	IFE <ZR'%S-1>,< AOBJN XB,LAB>
02400	IFN <ZR'%S-1>,<ADD XB,[XWD ZR'%S,ZR'%S]
02500	 JUMPL XB,LAB>
02600	>
02700	DEFINE CFAIL(MSG)=
02800	<PRINTX MSG>
02900	IFN QDEBUG,<
03000	DEFINE RFAIL(MSG)=
03100	< RFAI [ASCIZ/MSG/]>
03200	DEFINE ASSERT(B)=<
03300	B
03400	>
03500	>
03600	IFE QDEBUG,<DEFINE ASSERT(B)=<>
03700	DEFINE RFAIL(M)=<RFAI 0
03800	>
03900	>
04000	DEFINE SCALAR(B)=<
04100	%%%%%1==0
04200	IRP B,<
04300	B==%%%%%1
04400	%%%%%1==<%%%%%1+1>>>
     
00100		SUBTTL	RESERVED WORDS DECLARATION MACROS
00200	DEFINE RESWORD<
00300		.XCREF
00400		RESW$	BEGIN,,Z1RWBM	;;RESERVED WORD,NAME OF SYMBOL(ADD %),SWITCHES
00500		RESW$	END ,,Z1RWBE+Z1RWBM
00600		RESW$	IF 
00700		RESW$	THEN 
00800		RESW$	INTEGER,INT 
00900		RESW$	REF 
01000		RESW$	DO 
01100		RESW$	PROCEDURE,PROC 
01200		RESW$	NEW
01300		RESW$	ACTIVATE,ACTIV
01400		RESW$	AFTER 
01500		RESW$	AND 
01600		RESW$	ARRAY 
01700		RESW$	AT 
01800		RESW$	BEFORE,BEFOR
01900		RESW$	BOOLEAN,BOOL
02000		RESW$	CHARACTER,CHAR
02100		RESW$	CLASS 
02200		RESW$	COMMENT,COMM,Z1RWBM
02300		RESW$	DELAY 
02400		RESW$	ELSE,,Z1RWBE 
02500		RESW$	EQ 
02600		RESW$	EQV 
02700		RESW$	EXTERNAL,EXT 
02800		RESW$	FALSE 
02900		RESW$	FOR 
03000		RESW$	GE,NLESS 
03100		RESW$	GO,,Z1RWBM 
03200		RESW$	GOTO,,Z1RWBE 
03300		RESW$	GT,GRT 
03400		RESW$	HIDDEN,HIDDE
03500		RESW$	IMP 
03600		RESW$	IN 
03700		RESW$	INNER 
03800		RESW$	INSPECT,INSPE 
03900		RESW$	IS 
04000		RESW$	LABEL 
04100		RESW$	LE,NGRT 
04200		RESW$	LONG 
04300		RESW$	LT,LESS 
04400		RESW$	NAME 
04500		RESW$	NE,NEQ 
04600		RESW$	NONE 
04700		RESW$	NOT 
04800		RESW$	NOTEXT,NOTEX 
04900		RESW$	OR 
05000		RESW$	OPTIONS,OPT,Z1RWBM
05100		RESW$	OTHERWISE,OTHER,Z1RWBE
05200		RESW$	PRIOR 
05300		RESW$	PROTECTED,PROTE
05400		RESW$	QUA 
05500		RESW$	REACTIVATE,REACT 
05600		RESW$	REAL
05700		RESW$	SHORT 
05800		RESW$	STEP 
05900		RESW$	SWITCH,SWIT 
06000		RESW$	TEXT 
06100		RESW$	THIS 
06200		RESW$	TO,,Z1RWBM 
06300		RESW$	TRUE 
06400		RESW$	UNTIL 
06500		RESW$	VALUE 
06600		RESW$	VIRTUAL,VIRT 
06700		RESW$	WHEN,,Z1RWBE 
06800		RESW$	WHILE 
06900		.CREF
07000	>
07100	; BIT SWITCHES USED IN CREATION OF Z1RW
07200	Z1RWBE==1B18		;BIT 0 DELIMITS END COMMENT OR  PRODUCES WARNING
07300	Z1RWBM==1B19		;BIT 1 MARKED,KEYWORD TO BE RECOGNIZED BY LSI
07400	
07500		QNRESW==0
07600	DEFINE RESW$(A,B,C)<
07700		QNRESW==QNRESW+1>
07800		RESWORD
     
00100		SUBTTL	SYSTEM IDENTIFIERS MACRO
00200	
00300	DEFINE	SYSID<
00400		RESW$	NUMBER:1,NO1
00500		RESW$	NUMBER:2,NO2
00600		RESW$	NUMBER:3,NO3
00700		RESW$	NUMBER:4,NO4
00800		RESW$	FILE.,FIL
00900		RESW$	INFILE,INF
01000		RESW$	OUTFILE,UTF
01100		RESW$	DIRECTFILE,DIF
01200		RESW$	PRINTFILE,PRF
01300		RESW$	SIMSET,SET
01400		RESW$	SIMULATION,SIM
01500		RESW$	LINKAGE,LKA
01600		RESW$	LINK,LIN
01700		RESW$	HEAD,HED
01800		RESW$	PROCESS,PRO
01900		RESW$	SYSIN,SIN
02000		RESW$	SYSOUT,SUT
02100		RESW$	TEXT.,TXT
02200	>
02300	
02400	DEFINE RESW$(A,B)<
02500		QID'B=QNSYSID
02600		QNSYSID==QNSYSID+1
02700	>
02800	
02900		QNSYSID==2000
03000		SYSID
03100		QNSYSID==QNSYSID-2000
     
00100		SUBTTL	SYMBOL DECLARATION MACROS
00200	
00300	
00400	;	SYMBOL DECLARATION
00500	;	==================
00600	
00700	
00800	
00900	REPEAT 0,<
01000	
01100	THIS UNIVERSAL DEFINES SYMBOLS FROM LEXICAL SCANNER TO 
01200	SYNTAX RECOGNITION AND THE SYMBOLS IN IC1, AS WELL AS SYMBOLS ONLY USED IN PASS 2 ZNS NODES.
01300	
01400	THE SYMBOLS ARE DECLARED IN THE MACRO SYMBOL AS ARGUMENT TO THE
01500	MACRO SYMBX.THE ARGUMENTS ARE:
01600		NAME		THE SYMBOL-NAME IS %'NAME
01700		BIT MASK	BIT 1 FROM LEXICAL SCANNER
01800				BIT 2 IN IC1
01900				BIT 3 IN ZNS NODES ONLY
02000		CLASS		SYMBT1 OPERATORS
02100				SYMBT2 CONTROL ACTIONS
02200				SYMBT3 OPERANDS
02300				SYMBT4 DECLARATIONS
02400				SYMBT5 AUXILARY FROM LS
02500		VALUE		NUMBER OF HALFWORDS
02600	
02700	THE LIMITS OF THE DIFFERENT CLASSES ARE NAMED SYMBL9.
02800	SYMBL3 IS 1 LESS THE LOWEST ELEMENT IN SYMBT3
02900	AND 1 GREATER THE HIGHEST ELEMENT IN SYMBT2.
03000	
03100	
03200	THE SYMBOLS CAN BE ACCESSED THRU THE MACRO SYMB.
03300	THE ARGUMENTS TO SYMB ARE:
03400		BIT MASK	SAME AS IN SYMBOL
03500		ORDER		0= ALPHABETIC ORDER
03600				1= NUMERIC ORDER
03700		NAME		NAME OF MACRO TO BE CALLED. THE
03800	ARGUMENTS TO THIS MACRO ARE:
03900		NAME		OF SYMBOL WITHOUT LEADING %
04000		VALUE		OF SYMBOL
04100		NUMBER		OF VALUES
04200		SPELLING 	OF SYMBOL
04300	>
04400	
04500	DEFINE SYMBOL<
04600		.XCREF
04700		SYMBX	ACTIV,3,SYMBT1,1,ACTIVATE
04800		SYMBX	ADEC,2,SYMBT1
04900		SYMBX	AFTER,1,SYMBT5,,AFTER
05000		SYMBX	AND,3,24,,AND
05100		SYMBX	ARRAY,1,SYMBT4,,ARRAY
05200		SYMBX	AT,1,SYMBT5,,AT
05300		SYMBX	BBLK,2,SYMBT2
05400		SYMBX	BECOM,3,SYMBT1,,<:=>
05500		SYMBX	BEFOR,1,SYMBT5,,BEFORE
05600		SYMBX	BEGCL,2,SYMBT1,,BEGCL
05700		SYMBX	BEGIN,1,SYMBT5,,BEGIN
05800		SYMBX	BEGPB,2,SYMBT1,,BEGPB
05900		SYMBX	BEGPR,2,SYMBT1,,BEGPRO
06000		SYMBX	BOOL,1,SYMBT4,,BOOLEAN
06100		SYMBX	BOUND,2,SYMBT1,,ARRAYBND
06200		SYMBX	BPROG,2,SYMBT2
06300		SYMBX	CHAR,1,SYMBT4,,CHARACTER
06400		SYMBX	CLASS,1,SYMBT4,,CLASS
06500		SYMBX	COLON,1,SYMBT5,,<:>
06600		SYMBX	COMM,1,SYMBT5
06700		SYMBX	COMMA,1,36,,<,>
06800		SYMBX	CONC,3,SYMBT3,1,CONSTANT
06900		SYMBX	CONI,3,SYMBT3,2,CONSTANT
07000		SYMBX	CONLR,3,SYMBT3,4,CONSTANT
07100		SYMBX	CONR,3,SYMBT3,2,CONSTANT
07200		SYMBX	CONT,3,SYMBT3,2,CONSTANT
07300		SYMBX	CONVE,4,SYMBT1,,CONV
07400		SYMBX	CVBE,2,SYMBT1,,<:=>
07500		SYMBX	CVDE,2,SYMBT1,,<:->
07600		SYMBX	DEBUG,3,SYMBT2,1
07700		SYMBX	DELAY,1,SYMBT5,,DELAY
07800		SYMBX	DELOP,2,0
07900		SYMBX	DENOT,3,SYMBT1,,<:->
08000		SYMBX	DEQ,3,17,,<==>
08100		SYMBX	DIV,3,3,,</>
08200		SYMBX	DO,3,SYMBT2,,DO
08300		SYMBX	DOT,3,33,,<.>
08400		SYMBX	EBLK,2,SYMBT2
08500		SYMBX	EDCL,2,SYMBT2
08600		SYMBX	EDPB,2,SYMBT2
08700		SYMBX	ELSE,1,SYMBT5,,ELSE
08800		SYMBX	END,1,SYMBT5,,END
08900		SYMBX	ENDCL,2,SYMBT2
09000		SYMBX	ENDDO,2,SYMBT2
09100		SYMBX	ENDFO,2,SYMBT2
09200		SYMBX	ENDPR,2,SYMBT2
09300		SYMBX	EOF,1,SYMBT5
09400		SYMBX	EPROG,2,SYMBT2
09500		SYMBX	EQ,3,13,,<=&@(EQ)>
09600		SYMBX	EQV,3,27,,EQV
09700		SYMBX	ERROR,2,SYMBT2
09800		SYMBX	EXT,1,SYMBT4,,EXTERNAL
09900		SYMBX	FALSE,3,SYMBT3,,FALSE
10000		SYMBX	FIX,2,SYMBT2,1
10100		SYMBX	FOR,1,SYMBT5,,FOR
10200		SYMBX	FORDO,2,SYMBT2
10300		SYMBX	FORSI,2,SYMBT1,,<:=/:->
10400		SYMBX	FORST,2,SYMBT1,,<STEP/UNTIL>
10500		SYMBX	FORWH,2,SYMBT1,,WHILE
10600		SYMBX	GO,1,SYMBT5,,GO
10700		SYMBX	GOTO,3,SYMBT1,,GOTO
10800		SYMBX	GRT,3,14,,<&^&@(GT)>
10900		SYMBX	HIDDE,1,SYMBT5,,HIDDEN
11000		SYMBX	IDIV,3,4,,<//>
11100		SYMBX	IENDC,2,SYMBT2
11200		SYMBX	IF,1,SYMBT5,,IF
11300		SYMBX	IFEX,2,SYMBT1,,ELSE
11400		SYMBX	IFEX1,4,SYMBT1,,IF
11500		SYMBX	IFST,2,SYMBT1,1,<IF>
11600		SYMBX	IFTRE,2,SYMBT1,1,<IF>
11700		SYMBX	IFTRU,2,SYMBT1,,<IF>
11800		SYMBX	IMP,3,26,,IMP
11900		SYMBX	IN,3,22,,IN
12000		SYMBX	INNER,3,SYMBT2,,INNER
12100		SYMBX	INSPE,3,SYMBT1,1,INSPECT
12200		SYMBX	INT,1,SYMBT4,,INTEGER
12300		SYMBX	IS,3,21,,IS
12400		SYMBX	JUMP,2,SYMBT2,1
12500		SYMBX	LABEL,1,SYMBT5,,LABEL
12600		SYMBX	LB,3,SYMBT3,,<[>
12700		SYMBX	LESS,3,11,,<&\&@(LT)>
12800		SYMBX	LONG,1,SYMBT4,,LONG
12900		SYMBX	LP,3,SYMBT3,,<(>
13000		SYMBX	MINUS,3,7,,<->
13100		SYMBX	MOCEB,4,SYMBT1,<:=>
13200		SYMBX	MULT,3,2,,<*>
13300		SYMBX	NAME,1,SYMBT5,,NAME
13400		SYMBX	NDEQ,3,20,,<=/=>
13500		SYMBX	NEQ,3,16,,<\=&@(NE)>
13600		SYMBX	NEW,3,31,,NEW
13700		SYMBX	NGRT,3,12,,<&\=&@(LE)>
13800		SYMBX	NLESS,3,15,,<&^=&@(GE)>
13900		SYMBX	NONE,3,SYMBT3,,NONE
14000		SYMBX	NOT,3,23,,<\&@(NOT)>
14100		SYMBX	NOTEX,3,SYMBT3,,NOTEXT
14200		SYMBX	NOTHR,2,SYMBT2
14300		SYMBX	OPT,3,SYMBT2,1
14400		SYMBX	OR,3,25,,OR
14500		SYMBX	OTHER,3,SYMBT2,,OTHERWISE
14600		SYMBX	PAREN,2,SYMBT1,,PARENTHESIS
14700		SYMBX	PARM,4,SYMBT1
14800		SYMBX	PCALL,4,SYMBT1
14900		SYMBX	PBEND,2,SYMBT2
15000		SYMBX	PLUS,3,5,,<+>
15100		SYMBX	POW,3,1,,<**>
15200		SYMBX	PRIOR,1,SYMBT5,,PRIOR
15300		SYMBX	PROC,1,SYMBT4,,PROCEDURE
15400		SYMBX	PROTE,1,SYMBT5,,PROTECTED
15500		SYMBX	PURGE,2,SYMBT2
15600		SYMBX	QUA,3,32,,QUA
15700		SYMBX	QUAL,4,SYMBT1,,QUALIF
15800		SYMBX	RB,1,34,,<]>
15900		SYMBX	REACT,1,SYMBT5,,REACTIVATE
16000		SYMBX	REAL,1,SYMBT4,,REAL
16100		SYMBX	REF,1,SYMBT4,,REF
16200		SYMBX	RP,3,35,,<)>
16300		SYMBX	SEMIC,3,SYMBT5,,<;>
16400		SYMBX	SHORT,1,SYMBT4,,SHORT
16500		SYMBX	STEP,1,SYMBT5,,STEP
16600		SYMBX	SWEL,2,SYMBT1,,SWITCHELEM
16700		SYMBX	SWEND,2,SYMBT2
16800		SYMBX	SWIT,1,SYMBT4,,SWITCH
16900		SYMBX	SWITC,2,SYMBT1
17000		SYMBX	TEXT,1,SYMBT4,,TEXT
17100		SYMBX	THEN,1,SYMBT5,,THEN
17200		SYMBX	THIS,3,30,,THIS
17300		SYMBX	TO,1,SYMBT5,,TO
17400		SYMBX	TONED,4,SYMBT1
17500		SYMBX	TRUE,3,SYMBT3,,TRUE
17600		SYMBX	UDEF,2,SYMBT3
17700		SYMBX	UNMIN,2,10,,<->
17800		SYMBX	UNTIL,1,SYMBT5,,UNTIL
17900		SYMBX	UPLUS,2,6,,<+>
18000		SYMBX	VALUE,1,SYMBT5,,VALUE
18100		SYMBX	VIRT,1,SYMBT5,,VIRTUAL
18200		SYMBX	WHEDO,2,SYMBT1,,WHEN
18300		SYMBX	WHEN,1,SYMBT5,,WHEN
18400		SYMBX	WHILE,3,SYMBT1,1,WHILE
18500		.CREF
18600		>
18700		SYMBT1==-1
18800		SYMBT2==-2
18900		SYMBT3==-3
19000		SYMBT4==-4
19100		SYMBT5==-5
19200		SYMBL0==0
19300		SYMBL1==0
19400		SYMBL2==0
19500		SYMBL3==0
19600		SYMBL4==0
19700		SYMBL5==0
19800		SYMBL6==0
19900		
     
00100		DEFINE SYMBX(A,B,C,D,E)<
00200		IFG C,<IFG C-SYMBL1,<SYMBL1==C>>
00300		IFE C+1,<SYMBL2==SYMBL2+1>
00400		IFE C+2,<SYMBL3==SYMBL3+1>
00500		IFE C+3,<SYMBL4==SYMBL4+1>
00600		IFE C+4,<SYMBL5==SYMBL5+1>
00700		IFE C+5,<SYMBL6==SYMBL6+1>
00800		>
00900		SYMBOL
01000		SYMBL1==SYMBL1+1
01100		SYMBL2==SYMBL2+SYMBL1+1
01200		SYMBL3==SYMBL3+SYMBL2+1
01300		SYMBL4==SYMBL4+SYMBL3+1
01400		SYMBL5==SYMBL5+SYMBL4+1
01500		SYMBL6==SYMBL6+SYMBL5+1
     
00100	DEFINE SYMB(A,B,C)<
00200		SYMBT1==SYMBL1+1
00300		SYMBT2==SYMBL2+1
00400		SYMBT3==SYMBL3+1
00500		SYMBT4==SYMBL4+1
00600		SYMBT5==SYMBL5+1
00700		IFE B,<
00800	DEFINE SYMBX(M,N,O,P,Q)<
00900		IFN N&A,<C(M,\O,P,<Q>)>
01000		IFE O-SYMBT1,<SYMBT1==SYMBT1+1>
01100		IFE O-SYMBT2,<SYMBT2==SYMBT2+1>
01200		IFE O-SYMBT3,<SYMBT3==SYMBT3+1>
01300		IFE O-SYMBT4,<SYMBT4==SYMBT4+1>
01400		IFE O-SYMBT5,<SYMBT5==SYMBT5+1>
01500		>
01600		SYMBOL
01700		>
01800		IFN B,<
01900	DEFINE SYMBX(M,N,O,P,Q)<
02000		IFL O-SYMBL1,<
02100		IFN N&A,<
02200		DEFINE SYMB'O<C(M,\O,P,<Q>)>>>>
02300		SYMBOL
02400		DEFINE SYMBZ(F)<
02500		IFDEF SYMB'F,<SYMB'F>>
02600		SYMBY==-1
02700		REPEAT SYMBL1,<
02800		SYMBY==SYMBY+1
02900		SYMBZ(\SYMBY)>
03000	DEFINE SYMBZ(F)<
03100	DEFINE SYMBX(M,N,O,P,Q)<
03200		IFE O-SYMBT'F,<
03300		IFN N&A,<C(M,\O,P,<Q>)>
03400		SYMBT'F==SYMBT'F+1>>
03500		SYMBOL>
03600		SYMBZ 1
03700		SYMBZ 2
03800		SYMBZ 3
03900		SYMBZ 4
04000		SYMBZ 5
04100		>
04200		>
04300	DEFINE	SYMBXX(A,B,C,D)<
04400		%'A=B>
04500		SYMB	7,0,SYMBXX
     
00100	IFE QDEC20,<;;[225] DEC20 prefers single segment programs
00200		SUBTTL	MACRO FOR EXCHANGE OF HIGH SEGMENT
00300	
00400	;ARGUMENTS:
00500	;		NAME = NAME OF HIGH SEGMENT FILE
00600	;		WNAME= WORK NAME OF HIGH SEGMENT
00700	;		INCR = TRANSFER SHOULD BE TO ENTRY+INCR
00800	;		PPN  = PROJECT-PROGRAMMER NUMBER WHERE TO FIND NEW HIGH SEGMENT
00900	;
01000	;AT ENTRY X3 SHOULD BE LOADED WITH [ XWD 1,<TOP OF LOW SEGMENT> ]
01100	;IF NO LOW SEGMENT CHANGES WITH [ XWD 1,0 ]
01200	
01300	;[172] Take following passes from same DSK area as Pass 1 in SYS version
01400	DEFINE SWAPPA(NAME,WNAME,INCR,PPN)<
01500	DEFINE RL(LAB)<LAB-L2()+Y3SWAP>
01600	EXTERN	Y3SWAP
01700	BEGIN
01800		HLLZS	.JBREN##
01900		HLLZS	.JBSA##
02000		L	X2,[XWD L2(),Y3SWAP]
02100		BLT	X2,RL(L9())
02200		GOTO	RL(L2())
02300	L2():!	CORE	X3,
02400		HALT
02500	IFN QSYS,<
02600		IFNDEF YP1DEV,<EXTERN YP1DEV,YP1PPN>
02700		L	YP1DEV
02800		ST	RL(L4())
02900		L	YP1PPN
03000		ST	RL(L4())+4
03100	>
03200		LI	X1,RL(L4())
03300		GETSEG	X1,
03400		SKIPA
03500		GOTO	RL(L3())
03600		LI	X1,RL(L5())
03700		GETSEG	X1,
03800		HALT
03900	L3():!	BRANCH	400011+INCR ;;[260]
04000	
04100	L4():!	SIXBIT'DSK'
04200		IFE QSYS,<SIXBIT/WNAME/>
04300		IFN QSYS,<SIXBIT/NAME/>
04400		Z
04500		Z
04600		Z
04700		Z
04800	L5():!	EXP	QSYSDEV
04900		SIXBIT/NAME/
05000		Z
05100		Z
05200		EXP	PPN
05300		Z
05400	L9():!
05500	ENDD
05600	>
05700	>
     
00100		SUBTTL	TYPE CODES AND DECLARATION FILE FIELDS
00200	
00300	; TYPE CODES
00400	SCALAR <QUNDEF,QINTEGER,QREAL,QLREAL,QCHARACTER,QBOOLEAN,QTEXT,QREF,QLABEL,QNOTYPE,QRLREA>
00500	
00600	; KIND CODES
00700	SCALAR <QUNDEF,QSIMPLE,QARRAY,QPROCEDURE,QCLASS>
00800	
00900	; MODE CODES
01000	SCALAR <QDECLARED,QVALUE,QNAME,QREFER,QVIRTUAL,SPARE,QHDN,QNHDN>
01100	
01200	; DECLARATION STACK RECORD TAG VALUES (SPARSE REPRESENTATION)
01300	SCALAR <QZQU,QZHB,QZHE>
01400	; BLOCK TYPE CODES IN ZHE AND ZHB RECORDS
01500	SCALAR <QFOR,QRBLOCK,QUBLOCK,QPROCB,QPBLOCK,QCLASB,QINSPEC,QPROTO,QEBLOC,QCEXT,QPEXT,QMEXT,QFEXT,QSYSCL>
01600		QQUACH==QPROTO
01700	
01800	;PARAMETER DESCRIPTOR TYPE CODES IN ZFL RECORD
01900	SCALAR	<QDTVSI,QDTSIM,QDTFNM,QDTDYN,QDTCON,QDTICO,Q,QDTEXP>
02000	
02100	; RELOCATION VALUES USED TO INDEX THE 
02200	; RELOCATION COUNTER TABLE. THEIR VALUES MUST REFLECT THE ORDER OF THE RELOCATION COUNTER TABLE IN LOWSEG.
02300	SCALAR	<QNOREL,QRELCN,QRELCD,QRELPT,QRELLT,QRELST,QRELID,QRELI2>
02400	
02500	;[14 22 12] DEFINE ZQUSNR CODE.  DEFINITION MOVED FROM SYS1.MAC
02600	DEFINE SC(B)=<
02700	%%%%%1==0
02800	IRP B,<
02900	SYS'B==%%%%%1
03000	%%%%%1==<%%%%%1+1>>>
03100	
03200	SC<CL,MA,PR,TX,I1,I2,I3,I4,I5,I6,I7,I8,I9,K1,K2,K3,K4,K5,K6,K7,K8,K9,L1,L2,L3,L4,L5,L6,L7,L8,L9,M1>
03300	
     
00100		SUBTTL	DEFINITIONS OF DF1 AND PASS 2 FIELDS
00200	
00300	DF ZDETYP,0,3,2
00400	DF ZDELNK,2,18,35
00500	
00600	DF ZQUGLO,0,1,3
00700	DF ZQUEXT,0,1,4
00800	DF ZQULEN,0,1,5
00900	DF ZQUIS,0,1,5
01000	DF ZQUIB,0,1,6
01100	DF ZQUTPT,0,1,6		;[40]
01200	DF ZQUSYS,0,1,7
01300	DF ZQUHID,0,1,13	;[40] TOGETHER WITH BIT 12
01400	DF ZQUNOT,0,1,14	;[40]
01500	DF ZQUTYP,0,4,11
01600	DF ZQUMOD,0,3,14
01700	DF ZQUKND,0,3,17
01800	DF ZQUTMK,0,10,17
01900	DF ZQUSTM,0,11,17
02000	DF ZQUZHE,0,18,35
02100	DF ZQUTEM,0,18,35
02200	
02300	DF ZQUFIX,1,18,17
02400	DF ZQUIVA,1,1,0		;[40]
02500	DF ZQUNSB,1,5,5
02600	DF ZQULID,1,12,17
02700	DF ZQUIND,1,18,35
02800	
02900	DF ZQUUSE,2,1,0		;[140]
03000	DF ZQUZQU,2,18,17
03100	DF ZQUQID,2,18,17
03200	DF ZQUZB,2,18,35
03300	
03400	DF ZQUNAC,3,3,2
03500	DF ZQUPR,3,1,3
03600	DF ZQUGB,3,1,4
03700	DF ZQUIO,3,1,5
03800	DF ZQULO,3,1,6
03900	DF ZQUQIK,3,1,7		;[040700] Quicker call of this MACRO-10 procedure
04000	DF ZQUPTD,3,1,8		;[40]
04100	DF ZQUDD,3,1,9		;[136]
04200	DF ZQUSNR,3,8,17	;[040700] Leave some bits here for later possible use
04300	DF ZQULNE,3,18,35
04400	
04500	DF ZQUUNR,4,36,35
04600	
04700	
04800	DF ZHETYP,0,3,5
04900	DF ZHENOI,0,1,11
05000	DF ZHESOL,0,6,17
05100	DF ZHEDLV,0,18,35
05200	
05300	DF ZHEEBL,1,5,4
05400	DF ZHELEN,1,10,14
05500	DF ZHEBNM,1,9,23
05600	DF ZHEFIX,1,12,35
05700	
05800	DF ZHEOID,0,12,17
05900	DF ZHELID,0,18,35
06000	DF ZHEUNR,1,36,35
06100	
06200	
06300	DF ZHBXID,2,18,17
06400	DF ZHBZQU,2,18,17
06500	DF ZHBZE,2,18,35
06600	DF ZHBZHB,2,18,35
06700	
06800	DF ZHBDEV,3,11,12
06900	DF ZHBNRP,3,8,7
07000	DF ZHBVRT,3,8,15
07100	DF ZHBSBL,3,5,20
07200	DF ZHBSTD,3,5,25
07300	DF ZHBSZD,3,5,30
07400	DF ZHBUPF,3,1,31
07500	 DF ZHBMFO,3,3,33	;;[040700] Non-zero for MACRO-10 or FORTRAN procedure
07600		;;[040700] Values of ZHBMFO field:
07700		QEXMAC=1	;; MACRO-10, standard procedure call
07800		QEXMQI=2	;; MACRO-10, quick calling sequence
07900		QEXFOR=4	;; FORTRAN-10
08000		QEXF40=5	;; Old FORTRAN (F40)
08100	;[040700] DF ZHBFOR,3,1,31
08200	DF ZHBBLV,3,1,32
08300	;[040700] DF ZHBF40,3,1,32
08400	DF ZHBLOC,3,1,33
08500	;[040700] DF ZHBMAC,3,1,33
08600	DF ZHBKDP,3,1,34
08700	DF ZHBNCK,3,1,34
08800	DF ZHBEXT,3,1,35
08900	
09000	DF ZHBUNR,4,36,35
09100	DF ZHBPPN,4,36,35
09200	
09300	
09400	
09500	DF ZQQLNK,0,18,17
09600	DF ZQQFIX,0,18,35
09700	DF ZQQUNR,1,36,35
09800	
09900	
10000	
10100	; DF1 AND PASS 2 RECORDS
10200	DR ZQU,4,ZDETYP,1B<^d33+QZQU>
10300	DR ZHE,2,ZDETYP,1B<^d33+QZHE>
10400	DR ZHB,5,ZDETYP,1B<^d33+QZHB>
10500	; DSW NCODE TO STOP CODE GENERATION
10600	QO2LIS==200	; SIZE OF LITERAL TABLE
10700	QLOWID==^D1024	; FIRST LEXICAL ID NUMBER ASSIGNED
10800	QFTFX==140	; FIRST FIXUP NUMBER ASSIGNED BY PASS 1
     
00100		SUBTTL	SWITCH DECLARATIONS
00200	
00300	
00400	;	COMPILER SWITCH SWITCHES
00500	;	========================
00600	
00700	
00800		DSW	(YSWD,YSWITCH,34)
00900		DSW	(YSWI,YSWITCH,33)
01000		DSW	(YSWR,YSWITCH,32)
01100		DSW	(YSWY,YSWITCH,31)
01200		DSW	(YSWA,YSWITCH,30)
01300		DSW	(YSWQ,YSWITCH,28)
01400		DSW	(YSWW,YSWITCH,27)
01500		DSW	(YSWS,YSWITCH,26)	;[13] Set by any search list change
01600		DSW	(YSWCZ,YSWITCH,25)	;[220] CONTROL-Z SWITCH
01700		DSW	(YSWCM,YSWITCH,0)
01800		DSW	(YI1CCL,YSWITCH,1)
01900		DSW	(YDMF,YSWITCH,2)
02000		DSW	(YDMFE,YSWITCH,3)
02100		DSW	(YSWTRM,YSWITCH,4)
02200		DSW	(YSWP1,YSWITCH,5)
02300		DSW	(YSWLST,YSWITCH,6)
02400		DSW	(YSWCOM,YSWITCH,7)	;ON IF COMMAND FILE IN THIS COMPILATION
02500		DSW	(YSWLPT,YSWITCH,8)	;ON IF /LIST FROM COMPIL
02600		DSW	(YSWNFC,YSWITCH,9)	;OFF IF FIRST COMPILATION
02700		DSW	(YTRSW,YTRPAS,36)
02800	
02900	;  MASKS FOR A,M,Q AND W
03000	;  THESE MASKS ARE USED AS OPERANDS TO THE $OPT OPERATOR IN IC1
03100	
03200		QSWA==1B30
03300		QSWQ==1B28
03400		QSWW==1B27
03500	
03600	;SWITCHES SHOWING DEFAULT VALUES OF COMMAND SWITCHES
03700	;SWITCH ON DENOTES DEFAULT ON, OFF DENOTES DEFAULT OFF (- BEFORE SWITCH)
03800	
03900		DSW	(YSWDA,YSWDEF,0)
04000		DSW	(YSWDD,YSWDEF,1)
04100		DSW	(YSWDE,YSWDEF,2)
04200		DSW	(YSWDI,YSWDEF,3)
04300		DSW	(YSWDQ,YSWDEF,4)
04400		DSW	(YSWDR,YSWDEF,5)
04500		DSW	(YSWDW,YSWDEF,6)
04600		DSW	(YSWDS,YSWDEF,7)	;[13,,12]
04700	
04800	;SWITCHES SHOWING WHICH COMPILE SWITCHES HAVE BEEN CHANGED DURING COMPILATION
04900	;SWITCH ON DENOTES CHANGE FROM DEFAULT
05000	
05100		DSW	(YSWCA,YSWCHA,0)
05200		DSW	(YSWCD,YSWCHA,1)
05300		DSW	(YSWCE,YSWCHA,2)
05400		DSW	(YSWCI,YSWCHA,3)
05500		DSW	(YSWCQ,YSWCHA,4)
05600		DSW	(YSWCR,YSWCHA,5)
05700		DSW	(YSWCW,YSWCHA,6)
05800		DSW	(YSWCS,YSWCHA,7)	;[13,,12]
05900	
06000	
06100		QNSWCH==7+1	;[13,,12] Number of switches involved
06200	;WARNING: THE POSITION AND ORDER OF THESE SWITCHES
06300	;ARE CRITICAL FOR MODULE T3 IN PASS 3!!
06400	
06500	;DEFAULT VALUES (1 DEFAULT=ON, 0 DEFAULT=OFF)
06600	
06700		QSWAD==1
06800		QSWDD==1
06900		QSWED==0
07000		QSWID==1
07100		QSWQD==1
07200		QSWRD==0
07300		QSWWD==1
07400		QSWSD==0	;[13,,12] 1 means some change (e g /-S)
07500	
07600		QSWDEF==<QSWAD>B0+<QSWDD>B1+<QSWED>B2+<QSWID>B3+<QSWQD>B4+<QSWRD>B5+<QSWWD>B6
07700		QSWDEF==<QSWDEF+<QSWSD>B7>_-^D18	;[13,,12]
07800	
07900		
08000	; MACROS FOR CREATION OF FILE OPEN SWITCHES:
08100	
08200	DEFINE DCHSW(NAME)=<
08300	 DEFINE X(NAM,NUMBER)=<
08400		RADIX	8
08500		DSW	(NAM,Y3OPEN,NUMBER)
08600	 >
08700	 DEFINE Y(P1,P2)=<SYN P1,YOP'P2>
08800		QOPNO==^D35
08900	 IRP NAME,<
09000		RADIX	10
09100		X	(YOP'NAME,\<35-QCH'NAME>)
09200		RADIX	10
09300		X	(YPO'NAME,\<17-QCH'NAME>)
09400		Y	(YOP'NAME,\QOPNO)
09500		QOPNO=QOPNO-1
09600	 >
09700	>;END OF DCHSW
09800	
09900	;THE ORDER BETWEEN THE ARGUMENTS IS SIGNIFICANT
10000	;EACH ARG CORRESPONDS TO  CHANNEL QCH'ARG AND ARG NR I CORRESPONDS TO CHANNEL I
10100	DCHSW(<TTY,SRC,EXT,LS1,IC1,DF1,ZSE,REL,ATR,XRF,IC2,LST,DEB,ERR,TRC>)
     
00100	;	DEFINITION OF LS1 RECORD 4 PROTOTYPE
00200	;	------------------------------------
00300	
00400		DEFINE LS1INIT=<
00500		DF	(ZLEID,ZLEREC,7,6)	;IDENTIFIER FIELD = "I"
00600		DF	(ZLEIND,ZLEREC,8,16)	;BREAK CHARACTER COMBINATION INDICATOR
00700		DSW	(ZLESRC,ZLEREC,7)	;ON IF LINE NUMBER IN SOURCE LINE
00800		DSW	(ZLEOK,ZLEREC,8)	;ON IF SOURCE LINE NUMBER CAN BE USED IN LISTING
00900		DSW	(ZLEBIT,ZLEREC,17)	;RECORD INDICATOR = 1
01000			;SYMBOLIC NAMES ON ZLEIND VALUES  ;[14 22 15] Now defined in LC
01100		>
01200	
01300	
01400	IFN QDEC20,<;[225] DEFINE FILE INFO AREA FOR DEC-20 HANDLING OF FILES
01500	 DR ZLF,3	;LIMITS
01600	 DF ZLFFCP,0,36,35 ;First core page no
01700	 DF ZLFFFP,1,36,35	;First file page (corresponding)
01800	 DF ZLFNPA,2,36,35	;Number of pages in core area
01900	>
02000	
02100	
02200	;;; MACROS FOR LOOKUP AND ENTER
02300	;   Only to be used for files which are handled by PMAP on the 20
02400	
02500	IFE QDEC20,<
02600	DEFINE LOKUPF(F)<LOOKUP QCH'F,YEL'F>
02700	DEFINE ENTERF(F)<ENTER  QCH'F,YEL'F>
02800	>
02900	
03000	IFN QDEC20,<
03100	DEFINE LOKUPF(F)<
03200		LI	X1,YEL'F
03300		IF2,<IFNDEF O1JFNI,<EXTERN O1JFNI>>
03400		XEC	O1JFNI
03500	>
03600	DEFINE ENTERF(F)<
03700		LI	X1,YEL'F
03800		IF2,<IFNDEF O1JFNO,<EXTERN O1JFNO>>
03900		XEC	O1JFNO
04000	>
04100	>
     
00100		SUBTTL	TIMING MACRO
00200	
00300	;THE MACRO TIMER WILL OUTPUT THE TIME SPENT SINCE THE
00400	;LAST TIME IT WAS CALLED. IF NO MESSAGE IS GIVEN THERE
00500	;IS NO OUTPUT, ELSE THE MESSAGE FOLLOWED BY THE TIME
00600	;FOLLOWED BY "MILLISECONDS" IS OUTPUTTED.
00700	
00800	
00900	DEFINE TIMER(MESSAGE)<
01000	IFN QTIMER,<
01100		STACK	X0
01200		STACK	X1
01300		STACK	X2
01400		LI	X1,0
01500		RUNTIM	X1,
01600		SUB	X1,YTIMER##
01700		ADDM	X1,YTIMER
01800		IFNB<MESSAGE>,<
01900			OUTSTR	[ASCIZ/
02000	MESSAGE  /]
02100			LSH	X1,25
02200			LI	X2,5
02300			LOOP
02400				LI	X0,0
02500				LSHC	X0,3
02600				ADDI	X0,60
02700				OUTCHR
02800			AS
02900				SOJG	X2,TRUE
03000			SA
03100			OUTSTR	[ASCIZ/  MILLISECONDS
03200	/]
03300			>
03400		UNSTK	X2
03500		UNSTK	X1
03600		UNSTK	X0
03700	>
03800	>
     
00100		SUBTTL	MACRO FOR SETTING UP I/O BUFFERS
00200	
00300	DEFINE	SETBUF(FIL,BUFFER,SIZE)<
00400		EXTERN	YBUFR'BUFFER,YBH'FIL
00500		L	[XWD QBUFS-2,YBUFR'BUFFER+1+QBUFS+1]
00600		ST	YBUFR'BUFFER+1
00700		HRRI	YBUFR'BUFFER+1
00800		ST	YBUFR'BUFFER+1+QBUFS+1
00900		HRLI	400K
01000		IFB<SIZE>,<ST YBH'FIL>
01100		IFNB<SIZE>,<MOVSI X1,(^D'SIZE'B11)
01200			STD	YBH'FIL>
01300	>
     
00100		SUBTTL	RECORD DUMP MACRO
00200	
00300	;	DEFINE RECORD DUMP
00400	;	==================
00500	
00600	DEFINE	DRD(R,F)
00700	<	PROC
00800	.'R::	SAVE	<X2,X3,X4,X5>
00900		OUTSTR	[ASCIZ/            =====
01000	RECORD TYPE R AT ADDRESS /]
01100		LI	X3,22
01200		MOVE	X4,X1
01300		EXEC	L2
01400		OUTSTR	[ASCIZ/
01500	            =====
01600	
01700	/]
01800		IRP F	<	OUTSTR	[ASCIZ/F/]
01900				OUTCHR	["="]
02000				SIZE	(QSZ,F)
02100				IFE	<QSZ-1>,<LI	X4,"0"
02200						 IFON	F(X1)
02300						 LI	X4,"1"
02400						 OUTCHR	X4
02500						>
02600				IFN	<QSZ-1>,<LI	X3,QSZ
02700						 LF	(X4) F(X1)
02800						 EXEC	L2
02900						>
03000				OUTSTR	[ASCIZ/
03100	/]
03200	>
03300		OUTSTR	[ASCIZ/
03400	/]
03500		RETURN
03600	DEFINE	R	<EXEC .'R>
03700	L2():	SETZ	X2,0
03800		DIVI	X2,3
03900		SKIPE	X3
04000		AOJ	X2,0
04100		MOVN	X3,X2
04200		IMULI	X3,3
04300		ROT	X4,(X3)
04400	L3():	SETZ	X5,0
04500		ROTC	X4,3
04600		ADDI	X5,"0"
04700		OUTCHR	X5
04800		DECR	X2,L3
04900		POPJ	XPDP,0
05000		EPROC
05100	>
     
00100		SUBTTL	REGISTER ASSIGNMENTS
00200	
00300	
00400	;		************************
00500	;		* REGISTER ASSIGNMENTS *
00600	;		************************
00700	
00800	
00900		X0==0
01000		X1==1
01100		X2==2
01200		X3==3
01300		X4==4
01400		X5==5
01500		X6==6
01600		X7==7
01700		X10==10
01800		X11==11
01900		X12==12
02000		X13==13
02100		X14==14
02200		X15==15
02300		X16==16
02400		XPDP==17
02500	
     
00100		SUBTTL	OPERATOR DEFINITIONS
00200	
00300	
00400	;	************************
00500	;	* OPERATOR DEFINITIONS *
00600	;	************************
00700	
00800	
00900		OPDEF	GOTO	[JRST]
01000		OPDEF	BRANCH	[JRST]
01100		OPDEF	INCR	[AOBJN]
01200		OPDEF	DECR	[SOJG]
01300		OPDEF	L	[MOVE]
01400		OPDEF	LI	[MOVEI]
01500		OPDEF	ST	[MOVEM]
01600		OPDEF	NOP	[JFCL]
01700		OPDEF	STACK	[PUSH XPDP,]
01800		OPDEF	UNSTK	[POP XPDP,]
01900	OPDEF	XEC	[PUSHJ	XPDP,]	;[221]
02000	OPDEF	RET	[POPJ	XPDP,]	;[221]
02100	
02200	DEFINE %%CJMP(X)<
02300	IRP X,<
02400		OPDEF	GOTO'X	[JUMP'X]
02500		OPDEF	BRAN'X	[JUMP'X]>>
02600	
02700		%%CJMP(<L,E,LE,GE,N,G>)
02800	
02900	IFN QKI10,<
03000		OPDEF	LD	[DMOVE]
03100		OPDEF	STD	[DMOVEM]
03200		DEFINE KA10WARNING=<>
03300	>
03400	
03500	IFN QKA10,<
03600	DEFINE KA10WARNING=<
03700		PRINTX	KI10 DEPENDENT CODE
03800		>
03900	DEFINE LD (A,B)=<
04000		L	A,B
04100		L	A+1,1+B
04200	>
04300	DEFINE STD(A,B)=<
04400		ST	A,B
04500		ST	A+1,1+B
04600	>>
04700	
04800	QUUO==1
04900	DEFINE X(E)=
05000	<IFNB<E>,
05100	<Q'E==%%%%%1
05200	OPDEF	E	[<%%%%%1>B8]>
05300	%%%%%1==%%%%%1+1
05400	>
05500	
05600	DEFINE UUOS(E)
05700	<%%%%%1==QUUO
05800		IRP  E<X(E)>
05900	>
06000	
06100		DEFINE	UUOSET=<
06200	UUOS	<ERRT,,ERRI3,ERRI2,ERRI1,ERR,ERRLI,WARN,ERRR,ERR1,ERR2,FATA,SEV,SEV1,SEV2,RFAI>;ORDER SIGNIFICANT
06300	>
06400		UUOSET
06500	
06600	
06700	;ERROR TYPES:
06800	;===========
06900	
07000	QE==0
07100	QT==1
07200	QW==2
07300	
07400	;ERROR START NUMBERS:
07500	;===================
07600	
07700	;START NUMBER OF ERRORMESSAGES IN THE COMPILER OF A CERTAIN TYPE AND PASS
07800	;END NUMBER IS ONE NUMBER LESS THAN START OF NEXT INTERVAL
07900	
08000	Q1.WAR==1		;LOWEST WARNING MESSAGE NUMBER PASS1
08100	Q1.ERR==60		;LOWEST ERROR MESSAGE NUMBER PASS 1
08200	Q1.TER==240		;LOWEST TERMINATION MESSAGE NUMBER PASS 1
08300	Q2.WAR==300		;LOWEST WARNING MESSAGE NUMBER PASS 2
08400	Q2.ERR==330		;LOWEST ERROR MESSAGE NUMBER PASS 2
08500	Q2.TER==460		;LOWEST TERMINATION MESSAGE NUMBER PASS 2
08600	Q3.WAR==500		;LOWEST WARNING MESSAGE PASS 3
08700	Q3.ERR==530		;LOWEST ERROR MESSAGE PASS 3
08800	Q3.TER==560		;LOWEST TERMINATION MESSAGE PASS 3
08900	Q.OFL==567	;ERROR NUMBER FOR STACK OVERFLOW, COMMON TO ALL 3 PASSES
09000	Q.UFL==566	;ERROR NUMBER FOR STACK UNDERFLOW, COMMON TO ALL 3 PASSES
09100	Q.TER==570	;START NUMBER OF ERRORS COMMON  TO ALL 3 PASSES
09200	
09300	;MACRO TO CLEAR ^O
09400	;=================
09500	
09600	DEFINE	CLEARO	<
09700		SKPINC
09800		NOP
09900	>
     
00100		>;END OF IF1
     
00100		SUBTTL	Macros for defining versions
00200	
00300	;		*********************************
00400	;		* MACROS FOR DEFINING VERSIONS. *
00500	;		*********************************
00600	
00700	
00800	DEFINE	CTITLE	(module,a,b)	<;;[104]
00900		TITLE	module     DECsystem-10/20 SIMULA COMPILER %4A(310)  >
01000	DEFINE	CUNIV	(module,a,b)	<;;[104]
01100		IFDEF .DIRECTIVE,<.DIRECTIVE .NOBIN>
01200		UNIVERSAL module     DECsystem-10/20 SIMULA COMPILER %4A(310)  >
01300			COMMENT /EXAMPLE			     %3AM(777)-5  
01400								     VMM  E   W
01500				CTITLE is used by modules of the compiler.
01600				V = Main version (should be same as RTS main version).
01700				MM= Minor version.
01800				E = Edit level.
01900				W = Who made the last update.
02000				/
02100	
02200		CUNIV(SIMMAC)
02300	
02400	
02500	 
02600	DEFINE	RTITLE	(module,a,b)	<;;[104]
02700		TITLE	module     DECsystem-10/20 SIMULA RTS %4A(310)  >
02800	;;		RTITLE is used by modules of the Run Time System.
02900	DEFINE	RUNIV	(module,a,b)	<;;[104]
03000		IFDEF .DIRECTIVE,<.DIRECTIVE .NOBIN>
03100		UNIVERSAL	module     DECsystem-10/20 SIMULA RTS %4A(310)  >
03200	
03300		VERCOM=< BYTE (3) 0 (9)     4 (6)   1 (18)  310  >
03400			COMMENT /EXAMPLE
03500		         BYTE (3) 5 (9)     3 (6)  47 (18)  777
03600		                 WHO   VERSION   MINOR      E
03700			VERCOM is used by compiler passes to set .JBVER.
03800			This is done in the modules I1,I2,I3.  Same legend as CTITLE.
03900			/
04000	
04100		VERRTS=VERCOM
04200			COMMENT /
04300			VERRTS is used by the RTS to set .JBVER.  This
04400			is done in the module SIMRTS.  Same legend
04500			as RTITLE.
04600			/
04700	
     
00100		END