ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41

TABLE OF CONTENTS



    32-   16	ERROR REPORTING ROUTINES

    33-   83	ERROR FIXER ROUTINE

    34-  107	TITLE DIRECTIVE

    35-  148	IDENT DIRECTIVE

    35-  179	END DIRECTIVE

    36-  204	ENABLE/DISABLE ROUTINES

    37-  250	LIST/NLIST ROUTINES

    38-  305	SUBTITLE ROUTINE

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 26





      1						.IDENT	\X03.11\

      2					;

      3					; COPYRIGHT (C) 1977, 1978

      4					; DIGITAL EQUIPMENT CORPORATION, MAYNARD MASSACHUSETTS 01754

      5					;

      6					; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ON A SINGLE

      7					; COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION OF THE

      8					; ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER COPIES THEREOF,

      9					; MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON

     10					; EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE

     11					; TERMS.  TITLE TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES

     12					; REMAIN IN DEC.

     13					;

     14					; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE

     15					; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT

     16					; CORPORATION.

     17					;

     18					; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS

     19					; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

     20					;

     21

     22					;++

     23					; FACILITY:	VAX-11 MACRO OBJECT MODULE LIBRARY "MAR.OLB"

     24					;

     25					; ABSTRACT:	THIS MODULE IS PART OF THE VAX-11 MACRO ASSEMBLER, ITS DESCRIPTION

     26					;		IS ON THE FOLLOWING PAGE.

     27					;

     28					;

     29					; ENVIRNOMENT:	VAX-11 MACRO RUNS ON ANY VAX-11 WITH COMPATIBILITY MODE, UNDER

     30					;		THE CME (COMPATIBILITY MODE EMULATOR) OF VAX/VMS OR ON A PDP-11

     31					;		WITH EXTENDED INSTRUCTIONS UNDER RSX-11/M.

     32					;

     33					; AUTHOR:	STEVE POULSEN, CREATION DATE:  22-JUL-76

     34					;		DALE A. ROEDGER, 10-JAN-77 - 19-DEC-77

     35					;		DAVE N. CUTLER

     36					;		BENN L. SCHREIBER

     37					;

     38					; MODIFIED BY:

     39					;

     40					;--

     41					.IF NDF $DATA$

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 32





      1					.TITLE	ACTONE	ONCE ONLY ROUTINES

      2	000000				.PSECT	ACTONE

      3

      4					.MCALL	PUT$S			; SBTTL ROUTINE DOES A 'PUT$S' TO THE LISTING

      5

      6					.GLOBL	ERRMRS,	ERRDOL,	ERRMST,	ERRREF,	ERRASN,	ERRIIF,	ERRDAR,	ERRADR

      7					.GLOBL	ERRCHA,	ERRBLK,	ERREXP,	ERRBRF

      8					.GLOBL	TITLE,	IDENT,	ENDPRG,	ENABL,	DSABL,	LIST,	NLIST,	SBTTL

      9

     10					;++

     11					;

     12					; THIS FILE CONTAINS THOSE ACTION ROUTINES THAT ARE NOT NORMALLY NEEDED DURING

     13					; THE ASSEMBLY PROCESS MORE THAT ONCE.

     14					;

     15					;--

     16					.SBTTL	ERROR REPORTING ROUTINES

     17		000006 			M.RRIND	= 6			; REGISTER INDIRECT MODE, USED FOR ERROR FIX-UP

     18

     19

     20	000000				ERRMRS:	;(DBG)			; MARS_TEXT = ERR01

     21	000000					OUT	#I.CHKL				; ALIGN LISTING

     22	000010					CALL	ERORPX,#MRSERR			; UNRECOGNIZED STATEMENT

     23	000020					GOTO	COMERR				; BRANCH TO COMMON POINT

     24

     25	000022				ERRDOL:				; STATEMENT = DIRECTIVE ERR02

     26	000022					CALL	ERORPT,#DIRERR			; DIRECTIVE SYNTAX

     27	000032					GOTO	COMERR				;

     28

     29	000034				ERRMST:				; MACHINE_STAT = MACHINE_INST ERR03

     30	000034					CALL	ERORPT,#MSTERR			; MACHINE INSTRUCTION SYNTAX

     31	000044					GOTO	COMERR				;

     32

     33	000046				ERRREF:				; OPERANDS = OPERANDS ERR04

     34									; REF = ERR06

     35	000046					CALL	ERORPT,#REFERR			; OPERAND SYNTAX

     36	000056					CALL	ERRFIX				; SKIP TO NEXT OPERAND FIELD

     37	000062					RETURN					;

     38

     39	000064				ERRASN:				; ASSIGNMENT = ASSIGN_HEAD ERR02

     40	000064					CALL	ERORPT,#ASNERR			; ASSIGNMENT SYNTAX

     41	000074					GOTO	COMERR				;

     42

     43	000076				ERRIIF:				; IIF_STAT = IIF_HEAD ERR03

     44	000076					CALL	ERORPT,#ILGIIF			; MISSING COMMA IN ".IIF"

     45	000106					RETURN					;

     46

     47	000110				ERRDAR:				; DATA_LIST = DATA_ARGS ERR04

     48									; DATA_ARGS = DATA_LIST DSQOPN EXPR ERR04

     49	000110					CALL	ERORPT,#DLSYNR			; DATA LIST SYNTAX

     50	000120					RETURN					;

     51

     52	000122				ERRADR:				; ADDR_LIST = ADDR_LIST ERR04

     53									; ADDR_STAT = ADDR_TYPE

     54	000122					CALL ERORPT,#ADLISY			; ADDRESS LIST SYNTAX

     55	000132					RETURN					;

     56

     57	000134				ERRCHA:				; CHAR_ARGS = CHAR_ARGS ERR06

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 32-1

ERROR REPORTING ROUTINES



     58	000134					CALL	ERORPT,#ILCHRG			; ASCII CHARACTER ARGUMENT

     59	000144					RETURN					;

     60

     61	000146				ERRBLK:				; BLOCK_STAT = BLOCK_TYPE ERR03

     62	000146					CALL	ERORPT,#BLKERR			; BLOCK DIRECTIVE SYNTAX

     63	000156					RETURN					;

     64

     65	000160				ERREXP:				; EXPRESSION ERROR !!

     66	000160					CALL	ERORPT,#EXPERR			; EXPRESSION SYNTAX

     67	000170					CALL	ERRFIX				; TRY TO SAVLAGE LINE

     68	000174					RETURN					;

     69

     70	000176				ERRBRF:				; BASIC_REF =DOPN ERR01

     71									; BASIC_REF = DAT RRREG

     72	000176					CALL ERORPT,#BRFERR			; REGISTER OPERAND SYNTAX

     73	000206					LET MODE := #M.RRIND			; INDIRECT REGISTER

     74	000214					LET REG  := #0				; DEFAULT "R0"

     75	000220					INCRPC	#1				; COUNT ONE BYTE

     76	000232					CALL	ERRFIX				; SKIP TO NEXT OPERAND FIELD

     77	000236					RETURN

     78

     79

     80	000240	012767 	000015 	000000G	COMERR:	MOV	#CR,CHAR			; FORCE READING OF NEW LINE

     81	000246					RETURN					;

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 33

ERROR FIXER ROUTINE



     83					.SBTTL	ERROR FIXER ROUTINE

     84					;++

     85					;

     86					; THIS ROUTINE SCANS TO THE END OF THE LINE OR TO THE NEXT COMMA.

     87					; THIS HELPS PREVENT MULTIPLE ERROR MESSAGES PER LINE WHEN THE

     88					; USER HAS AN OPERAND SYNTAX ERROR

     89					;

     90					;--

     91

     92	000250				ERRFIX::;(DBG)

     93	000250				    IF OPRND IS TRUE THEN			; IN OPERAND FIELD?

     94	000256					WHILE CHAR NE #CR AND CHAR NE #COMMA	; SKIP TO NEXT ARGUMENT

     95	000276					    CALL GETCHR				; SCAN FOR DELIMITER

     96	000302					END;W

     97	000304					IF CHAR EQ #CR THEN			; CR?

     98	000314					    LET OPRND	:= FALSE		; NOT IN OPERAND FIELD

     99	000320					    LET BOL	:= TRUE			; SET BEGINNING OF LINE

    100	000326					END

    101	000326				    END;IF

    102	000326				    RETURN

    103

    104

    105

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 34

TITLE DIRECTIVE



    107					.SBTTL	TITLE DIRECTIVE

    108					;++

    109					;

    110					;--

    111

    112	000330				TITLE:				; DIRECTIVE = KTITLE

    113	000330					CALL SYMSCN				; SCAN NAME

    114	000334					IF R3 IS NE THEN			; TITLE NAME SUPPLIED

    115	000340					    LET TITLEP	:= FREEPT		; POINT TO TITLE BLOCK

    116	000346					    LET FREEPT	:= R3			; ALLOCATE TITLE BLOCK

    117	000352					    LET R0	:= #LPTHD1		; POINT TO HEADER BUFFER

    118	000356					    LET R2	:= TITLEP + #SYMCHRS	; START OF TITLE

    119	000366					    LET R3	:= #16. - R1		; HOW MANY BLANKS TO FILL IN

    120	000374					    REPEAT THRU R1			; COPY TITLE INTO HEADER BUFFER

    121	000374						LET (R0)+ :B= (R2)+		;

    122	000376					    END;R

    123	000400					    REPEAT THRU R3			; BLANK FILL REST OF TITLE SPACE

    124	000400						LET (R0)+ :B= #SPACE		;

    125	000404					    END;R

    126	000406					    SPNOR				; SKIP SPACES

    127	000412					    LET R2	:= #LPTHD2		; BUFFER FOR REST OF TITLE LINE

    128	000416					    REPEAT THRU R1 := #47.

    129	000422						LET (R2)+  :B= #SPACE		; BLANK FILL TITLE SUB-STRING

    130	000426					    END;R

    131	000430					    LET R2	:= #LPTHD2		; POINT TO BUFFER AGAIN

    132	000434					    LET R1	:= LINELN + #LINEBF+2 - LINEPT ; LENGTH OF TITLE SUB-STRING

    133	000450					    IF RESULT IS GT THEN		; IF ANY

    134	000452						IF R1 GT #47. THEN LET R1 := #47. ; COPY 47 CHARS MAX.

    135	000464						LET TITTXT := R1		; SAVE LENGTH OF TITLE TEXT

    136	000470						LET R0	   := LINEPT - #2	; POINT TO FIRST CHARACTER

    137	000500						REPEAT THRU R1			; COPY REST OF LINE

    138	000500						    IFB (R0) EQ #TAB THEN	; IS CHARACTER A "TAB"

    139	000506							LET (R0) :B= #SPACE	; CONVERT TABS TO SPACES

    140	000512						    END;IF

    141	000512						    LET (R2)+ :B= (R0)+		; STORE IN HEADER BUFFER

    142	000514						END;R

    143	000516						LET CHAR := #CR			; FORCE READING OF NEW LINE

    144	000524					    END;IF

    145	000524					END;IF

    146	000524					RETURN

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 35

IDENT DIRECTIVE



    148					.SBTTL	IDENT DIRECTIVE

    149					;++

    150					;

    151					;--

    152

    153	000526				IDENT:				; DIRECTIVE = KIDENT

    154	000526					SPNOR					; SCAN TO DELIMITER

    155	000532					IF CHAR NE #CR THEN			; THERE IS AN IDENT STRING

    156	000542					    LET IDENTP	:= FREEPT		; POINT TO IDENT

    157	000550					    LET R2	:= FREEPT		; WHERE TO PUT IDENT

    158	000554					    LET R3	:= CHAR			; SAVE DELIMITER

    159	000560					    LET (R2)+	:B= 0			; CLEAR LENGTH

    160	000562					    CALL GETCHR				; PICK UP FIRST CHAR OF IDENT

    161	000566					    WHILE R0 NE R3 AND R0 NE #CR	; STRING NOT ENDED

    162	000600						LET (R2)+ :B= R0		; STORE CHARACTER

    163	000602						CALL GETCHR			; PICK UP NEXT CHARACTER

    164	000606					    END;W

    165	000610					    LET R2	:= R2 -1		; DON'T COUNT LENGTH BYTE

    166	000612					    LET R0	:= R2 - IDENTP		; CALCULATE STRING LENGTH

    167	000620					    IF R0 GT #15. THEN LET R0 := #15.	; MAXIMUM IDENT LENGTH IS 15 CHARS

    168	000632					    LET @IDENTP	:B= R0			; STORE LENGTH OF STRING

    169	000636					    LET FREEPT	:= FREEPT + R0 + #2 OFF.BY #1 ; ROUND TO NEXT WORD

    170	000656					    IF CHAR EQ #CR THEN			; STRING NOT TERMINATED?

    171	000666						CALL ERORPT,#UNTERM		;

    172	000676					    ELSE

    173	000700						LET CHAR := #CR			; TREAT AS END OF LINE

    174	000706					    END;IF

    175	000706					END;IF

    176	000706					RETURN

    177

    178

    179					.SBTTL	END DIRECTIVE

    180					;++

    181					;

    182					;--

    183

    184	000710				ENDPRG:				; DIRECTIVE = KEND

    185	000710					CALL SYMSCN				; CHECK FOR TRANSFER ADDR

    186	000714					IF R3 IS NE THEN			; THERE IS A SYMBOL

    187	000720					    CALL SRCUST				; SEARCH USER SYMBOL TABLE

    188	000724					    IF R2 IS EQ THEN			; NOT FOUND?

    189	000730						CALL ERORLN,#UNDFTR		; UNDEFINED TRANSFER ADDRESS

    190	000740					    ELSE

    191	000742						LET TRNSFR	:= R2		; POINT TO TRANSFER SYM

    192	000746					    END

    193	000746					ELSE

    194	000750					    IF CHAR NE #CR THEN			; DON'T ALLOW GARBAGE THERE

    195	000760						CALL ERORLN,#DIRERR		; ONLY SYMBOL OR CR IS GOOD

    196	000770					    END

    197	000770					END

    198	000770					IF IFLVL IS GT THEN			; UNTERMINATED IF STATEMENTS

    199	000776					    CALL ERORLN,#UNTCND			;

    200	001006					END

    201	001006					CALL	SETPC				; UPDATE PC

    202	001012	000167 	000000G			JMP	XXXEND			;END OF PASS 1

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 36

ENABLE/DISABLE ROUTINES



    204					.SBTTL	ENABLE/DISABLE ROUTINES

    205					;++

    206					;

    207					; THIS CODE HANDLES THE .ENABL AND .DSABL DIRECTIVES.  THE RESULT OF

    208					; THE DIRECTIVES IS THAT INTERMEDIATE CODE IS GENERATED WHICH PATCHES

    209					; THE ENABLE/DISABLE BLOCKS DURING PASS 2 AS WELL AS PATCHING THEM

    210					; ON PASS 1.

    211					;

    212					;--

    213

    214	001016				ENABL:				; DIRECTIVE = KENABL

    215	001016					LET DATPTR	:= #-1			; ENABLE THE OPTIONS

    216	001024					GOTO ENADSA				; CHANGE THE FLAG

    217

    218	001026				DSABL:				; DIRECTIVE = KDSABL

    219	001026					LET DATPTR	:= #0			; DISABLE THE OPTIONS

    220	001032				ENADSA:	PUSH R4					; SAVE R4

    221	001034					REPEAT					; SCAN ALL OPTIONS

    222	001034					    CALL SYMSCN				; SCAN FOR NEXT OPTION

    223	001040					    IF R3 IS EQ THEN LEAVE		; ALL DONE

    224	001044					    LET ENABLS	:= #EN.PNC		; POINT TO ENABLE NAMES

    225	001052					    LET R2	:= #ENABLS		; POINT TO LIST

    226	001056					    LET INSERT	:= FALSE		; DON'T ADD IF NOT FOUND

    227	001062					    CALL FINDSYM			; LOOK FOR OPTION

    228	001066					    IF R2 IS EQ THEN			; NOT FOUND

    229	001072						CALL ERORLN,#NTLGEN		; NOT A LEGAL OPTION

    230	001102					    ELSE

    231	001104						IF R2 EQ #EN.LSB THEN		; IS OPTION "LSB"?

    232	001112						    IF DATPTR IS NE THEN	; ENABLING?

    233	001120							LET LSB := LSB +1	; CREATE NEW LSB

    234	001124						    END

    235	001124						END

    236	001124						IF SYMFLAG(R2) OFF.IN CMDFLG THEN ; WAS OPTION IN COMMAND STRING ?

    237	001134						    LET R2	:= R2 + #SYMVL2	; POINT TO OPTION FLAG

    238	001140						    LET (R2)	:= DATPTR	; SET/CLEAR OPTION

    239	001144						    OUT #I.FLAG,<DATPTR,R2>	; SET/CLEAR ON PASS 2

    240	001162						END				;

    241	001162					    END

    242	001162					    SPNOR

    243	001166					    IF CHAR EQ #COMMA THEN		; COMMA?

    244	001176						CALL GETCHR			; SKIP OVER IT

    245	001202					    END

    246	001202					END;R

    247	001204					POP R4					; RESTORE R4

    248	001206					RETURN					;

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 37

LIST/NLIST ROUTINES



    250					.SBTTL	LIST/NLIST ROUTINES

    251					;++

    252					;

    253					; THESE ROUTINES HANDLE THE .LIST AND .NLIST DIRECTIVES.  WHEN ARGUMENTS

    254					; ARE SPECIFIED, THE APPROPRIATE FLAGS ARE SET, AND CODE IS GENERATED

    255					; TO TELL THE SECOND PASS THAT THE FLAGS CHANGED.

    256					;

    257					;--

    258

    259	001210				LIST:				; DIRECTIVE = KLIST

    260	001210					LET DATPTR	:= #-1			; SET ANY FLAGS

    261	001216					LET DATRPT	:= #1			; INCREMENT LEVEL

    262	001224					GOTO LISTSC				; SCAN LISTING ARGS

    263

    264	001226				NLIST:				; DIRECTIVE = KNLIST

    265	001226					LET DATPTR	:= #0			; CLEAR ANY FLAGS

    266	001232					LET DATRPT	:= #-1			; DECREMENT LEVEL

    267	001240					GOTO LISTSC				; SCAN LISTING ARGS

    268

    269					;

    270					;

    271					; SCAN LISTING DIRECTIVES ON LINE

    272					;

    273

    274	001242				LISTSC:	PUSH R4					; SAVE R4

    275	001244					CALL SYMSCN				; LOOK FOR ARG

    276	001250					IF R3 IS EQ THEN			; NONE FOUND

    277	001254					    LET LISTLV	:= LISTLV + DATRPT	; INCREMENT LEVEL

    278	001262					    OUT #I.FLAG,<LISTLV,#LISTLV>	; TELL PASS 2 THE LEVEL

    279	001302					    OUT #I.FLAG,<#1,#LISTIT>		; SET ".LIST/.NLIST" FLAG

    280	001322					ELSE

    281	001324					    REPEAT				; ONCE PER ARG

    282	001324						LET LISTDR	:= #LS.LST	; POINT TO LISTING NAMES

    283	001332						LET R2		:= #LISTDR	; POINT TO LISTING DIRECTIVE LIST

    284	001336						LET INSERT	:= FALSE	; DON'T ADD ANY NEW ONES

    285	001342						CALL FINDSYM			; LOOK FOR DIRECTIVE

    286	001346						IF R2 IS EQ THEN		; FOUND?

    287	001352						    CALL ERORLN,#NTLDIR		; NOT LEGAL LISTING DIRECTIVE

    288	001362						ELSE

    289	001364						    IF SYMFLAG(R2) OFF.IN CMDFLG THEN	; OPTION NOT IN COMMAND LINE

    290	001374							LET R2	 := R2 + #SYMVL2	; POINT TO FLAG

    291	001400							LET (R2) := DATPTR		; SET THE FLAG

    292	001404							OUT #I.FLAG,<DATPTR,R2>		; TELL PASS2

    293	001422						    END					;

    294	001422						END

    295	001422						SPNOR				; SKIP BLANKS

    296	001426						IF CHAR EQ #COMMA THEN		; COMMA?

    297	001436						    CALL GETCHR			; YES, SKIP OVER IT

    298	001442						END

    299	001442						CALL SYMSCN			; GET NEXT SYMBOL

    300	001446					    UNTIL R3 IS EQ			; UNTIL END OF LIST

    301	001452					END

    302	001452					POP		R4			; RESTORE R4

    303	001454					RETURN

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 38

SUBTITLE ROUTINE



    305					.SBTTL	SUBTITLE ROUTINE

    306					;++

    307					;

    308					; A SUBTITLE IS COPIED INTO THE INTERMEDIATE CODE SO THAT ON THE

    309					; SECOND PASS, THE CODE CAN BE PLACED IN THE SUBTITLE BUFFER.

    310					;

    311					;--

    312

    313	001456				SBTTL:				; DIRECTIVE = KSBTTL

    314	001456					LET R0	:= #LINEBF+2 + LINELN - LINEPT	; CALCULATE SBTTL LENGTH

    315	001472					IF R0 IS LE THEN LET R0 := 0

    316	001500					IF R0 HIS #47. THEN LET R0 := #47.	; CHECK MAX LENGTH

    317	001512					LET SBTTLN	:= R0			; SAVE LENGTH

    318	001516					LET R1		:= R0 + FRMPTR		; CHECK IF ROOM IN BUFFER

    319	001524					IF R1 HI #FRMWRN THEN			; NO ROOM

    320	001532					    CALL WRTFRM				; DUMP BUFFER

    321	001536					END

    322	001536					LET R1		:= FRMPTR		; POINT TO BUFFER

    323	001542					LET R0		:= SBTTLN		; RESTORE LENGTH

    324	001546					LET R2		:= LINEPT - #2		; INPUT POINTER

    325	001556					LET R3		:= R0 + #5 OFF.BY #1	; FRAME SIZE (ROUNDED)

    326	001570					LET (R1)+	:B= R3			; PUT FRAME SIZE IN BUFFER

    327	001572					LET (R1)+	:B= #I.SBTTL		; INTERMEDIATE COMMAND

    328	001576					LET (R1)+	:= R0			; SBTTL LINE LENGTH

    329	001600					LET FRMPTR	:= FRMPTR + R3		; UPDATE FRAME POINTER

    330	001604					LET R3		:= #LINEBF		; NEED TO COPY SBTTL FOR T.O.C.

    331	001610					IF R0 IS GT THEN			; CHECK SIZE

    332	001614					    REPEAT THRU R0			; ONCE PER CHAR

    333	001614						LET (R3)+ :B= (R2)		; COPY TO T.O.C. BUFFER

    334	001616						IFB (R2) EQ #TAB THEN LET (R2) :B= #SPACE ; CONVERT TABS TO SPACES

    335	001630						LET (R1)+ :B= (R2)+		; COPY TO INTERMEDIATE CODE BUFFER

    336	001632					    END;R

    337	001634					END;IF

    338	001634					IF LSTXST IS TRUE THEN			; WE NEED A TABLE OF CONTENTS

    339	001642					    IF TOCFLG IS FALSE THEN		; FIRST SBTTL?

    340	001650						LET TOCFLG := TRUE		; ONLY ONE HEADER

    341	001656						LET LPTCT  := #LPTLEN-3		; SET LINE COUNT

    342	001664						PUT$S	#LSTBLK,#LPTHDR,#LPTHDX-LPTHDR ; LISTING HEADER

    343	001710						PUT$S	#LSTBLK,#SBTLB1,#20.	; "TABLE OF CONTENTS"

    344	001734						PUT$S	#LSTBLK,#LPTHDR,#0	; BLANK LINE

    345	001756					    END;IF

    346	001756					    LET R3	:= #LINEBF-16.		; POINT TO LEFT END OF LINE

    347	001762					    LET (R3)+	:B= #SPACE		; INSERT 3 SPACES

    348	001766					    LET (R3)+	:B= #SPACE		;

    349	001772					    LET (R3)+	:B= #SPACE		;

    350	001776					    LET (R3)+	:B= #'(			; LEFT PARENTHESIS

    351	002002					    LPUSH  SRCPAG,#0			; STACK SOURCE PAGE NUMBER

    352	002022					    CALL   DECLR			; OUTPUT PAGE NO.

    353	002026					    LET (R3)+	:B= #')			; RIGHT PARENTHESIS

    354	002032					    REPEAT				; ZERO UP TO "LINEBF"

    355	002032						LET (R3)+ :B= #SPACE		;

    356	002036					    UNTIL R3 EQ #LINEBF			;

    357	002044					    IFB #R.SEQ EQ F.RTYP+VAXBLK THEN	; "SOS" FILE?

    358	002054						LET R3	:= F.SEQN+VAXBLK	; GET SEQUENCE LINE NUMBER

    359	002060					    ELSE

    360	002062						LET R3	:= LINENM		; GET LINE NUMBER

    361	002066					    END;IF

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 38-1

SUBTITLE ROUTINE



    362	002066					    CALL   SBTDEC			; OUTPUT LINE NUMBER

    363	002072					    LET SBTTLN	:= SBTTLN + #16.	; MAKE LENGTH CORRECT

    364	002100					    PUT$S	#LSTBLK,#LINEBF-16.,SBTTLN ; WRITE SBTTL INTO LISTING

    365	002124					    LET LPTCT	:= LPTCT -1		; COUNT LINE

    366	002130					    IF RESULT IS EQ THEN LET TOCFLG := FALSE ; NEED NEW HEADER NEXT TIME

    367	002136					END;IF

    368	002136					LET CHAR	:= #CR			; FORCE READING OF NEW LINE

    369	002144					RETURN

    370

    371

    372	002146				SBTDEC:					; PUT NUMBER IN R3 INTO "LSTLCT"

    373	002146					LET R1		:= #LINEBF-2		; LOAD OUTPUT POINTER

    374	002152					REPEAT THRU R0	:= #5			; LOOP FIVE TIMES MAX.

    375	002156					    LET R2	:= 0			; CLEAR R2

    376	002160	071227 	000012 			    DIV #10.,R2				; REMAINDER GOES TO R3

    377	002164					    LET R3	:= R3 + #'0		; CONVERT DIGIT TO ASCII

    378	002170					    LET -(R1)	:B= R3			; STORE CHARACTER IN BUFFER

    379	002172					    LET R3	:= R2			; WRITE QUOTIENT INTO DIVIDEND

    380	002174					    IF RESULT IS EQ THEN LEAVE		; EXIT IF QUOTIENT IS ZERO

    381	002176					END;R

    382	002200					RETURN

    383

    384		000001 			.END

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 38-2

SYMBOL TABLE



ADLISY= ****** GX	ERRMST  000034RG    002	LPTHDR= ****** GX	MRSERR= ****** GX	S.ASN = 000200

ASNERR= ****** GX	ERRREF  000046RG    002	LPTHDX= ****** GX	MSTERR= ****** GX	S.DBG = 002000

A3    = 000000   	EXPERR= ****** GX	LPTHD1= ****** GX	M.ARGC= 000014   	S.DF  = 100000

BLKERR= ****** GX	E0      000304R     002	LPTHD2= ****** GX	M.ARGS= 000016   	S.EPT = 000100

BLNK  = 000040   	E1      000400R     002	LPTLEN= 000074   	M.END = 000012   	S.EXTN= 010000

BOL   = ****** GX	E10     001634R     002	LSB   = ****** GX	M.GETL= 000004   	S.GLOB= 020000

BRFERR= ****** GX	E11     002044R     002	LSTBLK= ****** GX	M.IFLV= 000006   	S.LOCL= 001000

B0      000256R     002	E12     002200R     002	LSTXST= ****** GX	M.IFVL= 000010   	S.ODBG= 000040

B1      000374R     002	E2      000406R     002	LS.LST= ****** GX	M.LINK= 000000   	S.REF = 000400

B10     001614R     002	E3      000430R     002	L0      000326R     002	M.NXTL= 000002   	S.TKMS= 000377

B11     002032R     002	E4      000516R     002	L1      000304R     002	M.RRIN= 000006   	S.WEAK= 040000

B12     002156R     002	E5      000610R     002	L10     000610R     002	NLIST   001226RG    002	TAB   = 000011

B2      000400R     002	E6      001204R     002	L11     000632R     002	NTLDIR= ****** GX	TITLE   000330RG    002

B3      000422R     002	E7      001452R     002	L12     000700R     002	NTLGEN= ****** GX	TITLEP= ****** GX

B4      000500R     002	FF    = 000014   	L13     000706R     002	OPRND = ****** GX	TITTXT= ****** GX

B5      000566R     002	FINDSY= ****** GX	L14     000750R     002	OUTFRA= ****** GX	TOCFLG= ****** GX

B6      001034R     002	FREEPT= ****** GX	L15     000742R     002	PAR$$$= 000027   	TRNSFR= ****** GX

B7      001324R     002	FRMPTR= ****** GX	L16     000746R     002	PC1   = ****** GX	TYPS0 = 000006

CHAR  = ****** GX	FRMWRN= ****** GX	L17     000770R     002	PC2   = ****** GX	TYPS1 = 000000

CMDFLG= ****** GX	F.NRBD= ****** GX	L2      000326R     002	PSECCH= 000020   	TYPS2 = 000000

CNT   = 000006   	F.RTYP= ****** GX	L20     000770R     002	PSECOP= 000016   	TYPS3 = 000000

COMERR  000240R     002	F.SEQN= ****** GX	L21     001006R     002	PSECV1= 000012   	UNDFTR= ****** GX

COMMA = 000054   	GETCHR= ****** GX	L22     001104R     002	PSECV2= 000014   	UNTCND= ****** GX

CR    = 000015   	IDENT   000526RG    002	L23     001162R     002	REFERR= ****** GX	UNTERM= ****** GX

DATPTR= ****** GX	IDENTP= ****** GX	L24     001124R     002	REG   = ****** GX	VAXBLK= ****** GX

DATRPT= ****** GX	IFLVL = ****** GX	L25     001124R     002	RGTANG= 000076   	V1STAC= ****** GX

DECLR = ****** GX	IIII  = 177777   	L26     001162R     002	RTNVAL=%000000   	V2STAC= ****** GX

DIRERR= ****** GX	ILCHRG= ****** GX	L27     001202R     002	R.SEQ = ****** GX	WRTFRM= ****** GX

DLSYNR= ****** GX	ILGIIF= ****** GX	L3      000524R     002	R6    =%000006   	XXXEND= ****** GX

DSABL   001026RG    002	INSERT= ****** GX	L30     001324R     002	R7    =%000007   	$DIDDO= 000000

ENABL   001016RG    002	I.CHKL= ****** GX	L31     001452R     002	SBTDEC  002146R     002	$E$   = 000001

ENABLS= ****** GX	I.FLAG= ****** GX	L32     001364R     002	SBTLB1= ****** GX	$F$   = 000000

ENADSA  001032R     002	I.SBTT= ****** GX	L33     001422R     002	SBTTL   001456RG    002	$I$   = 000001

ENDPRG  000710RG    002	LBLS0 = 000012   	L34     001422R     002	SBTTLN= ****** GX	$K$   = 000012

EN.LSB= ****** GX	LBLS1 = 000052   	L35     001442R     002	SEMI  = 000073   	$L    = 000013

EN.PNC= ****** GX	LBLS2 = 000043   	L37     001500R     002	SETPC = ****** GX	$LL   = 000011

ERORLN= ****** GX	LBLS3 = 000034   	L4      000524R     002	SKIPSP= ****** GX	$L$   = 000000

ERORPT= ****** GX	LF    = 000012   	L40     001512R     002	SPACE = 000040   	$O$   = 000000

ERORPX= ****** GX	LFTANG= 000074   	L41     001536R     002	SRCPAG= ****** GX	$R    = 177777

ERRADR  000122RG    002	LINEBF= ****** GX	L42     001634R     002	SRCUST= ****** GX	$T    = 000052

ERRASN  000064RG    002	LINELN= ****** GX	L43     001630R     002	SYMCHR= 000012   	$T1   = 000006

ERRBLK  000146RG    002	LINENM= ****** GX	L44     002136R     002	SYMFLA= 000002   	$T2   = 000012

ERRBRF  000176RG    002	LINEPT= ****** GX	L45     001756R     002	SYMLEN= 000011   	$Y$   = 000000

ERRCHA  000134RG    002	LIST    001210RG    002	L47     002062R     002	SYMLIN= 000000   	$Z$   = 000000

ERRDAR  000110RG    002	LISTDR= ****** GX	L5      000464R     002	SYMMAX= 000017   	$$S   = 000000

ERRDOL  000022RG    002	LISTIT= ****** GX	L50     002066R     002	SYMSCN= ****** GX	$$T   = 000051

ERREXP  000160RG    002	LISTLV= ****** GX	L51     002136R     002	SYMSEG= 000010   	$$TT  = 000052

ERRFIX  000250RG    002	LISTSC  001242R     002	L6      000512R     002	SYMVL1= 000004   	.PUTSQ= ****** G

ERRIIF  000076RG    002	LOWCAS= 000140   	L7      000706R     002	SYMVL2= 000006   	.$T   = 000001

ERRMRS  000000RG    002	LPTCT = ****** GX	MODE  = ****** GX	S.ABS = 004000



. ABS.	000000	   000

      	000000	   001

ACTONE	002202	   002

ERRORS DETECTED:  0



VIRTUAL MEMORY USED:  12881 WORDS  ( 51 PAGES)

DYNAMIC MEMORY:  14388 WORDS  ( 55 PAGES)

ACTONE	ONCE ONLY ROUTINES	MACRO M1110  21-AUG-78 22:41  PAGE 38-3

SYMBOL TABLE



ELAPSED TIME:  00:03:43

OBJ$:ACTONE,LIS$:ACTONE/-SP=SRC$:MD,COMMON,ACTONE

