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