Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/getitm.mac
There are 21 other files named getitm.mac in the archive. Click here to see a list.
; UPD ID= 1587 on 5/14/84 at 10:03 AM by HOFFMAN                        
TITLE	GETITM FOR COBOL V13
SUBTTL	GET NEXT SOURCE WORD	AL BLACKINGTON/CAM/SEB/DMN/JEH

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P,UUOSYM
	%%P==:%%P
	MCS==:MCS
	DBMS==:DBMS

IFN TOPS20,<SEARCH	MONSYM,MACSYM>

	ENTRY GETITM	;GET NEXT WORD A DETERMINE TYPE
	ENTRY GETKAR	;GET NEXT CHARACTER FOR A WORD OR NUMERIC LITERAL.
	ENTRY GETCH	;GET NEXT CHARACTER FOR A NON-NUMERIC LITERAL.
	ENTRY GETFCH	;GET VERY FIRST CHARACTER IN THE SOURCE FILE.
	ENTRY GETWRD	;GET NEXT WORD OR LITERAL FROM SOURCE
	ENTRY FINSKP	;COMPLETE SKIPPING OF PARAGRAPH
	ENTRY SKPSRC	;READ ONE SOURCE CHARACTER
	ENTRY PUTCRF	;PUT ITEM INTO CREF FILE

	INTERN	GETSRC	;[702]
	INTERN	SKPPGF,END2
	INTERN	FLG.LI,FLG.HI,FLG.H,FLG.NS.FLG.VX	;FIPS FLAGGER ROUTINES

IFE TOPS20,<
	INTERN	GETLB9	;[1023]
>
IFN TOPS20,<
	EXTERN	RITCRF,CLSCRF,CLZLIB
>
TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
SALL
;EDITS
;NAME	DATE		COMMENTS

;V13*****************
;JEH	11-MAY-84	[1525] Allow use of 'STR:filnam.ext[P,PN] to specify
;				library file in COPY statement
;JEH	04-May-84	[1524] Don't increment byte pointer into SRCBH before
;				storing it in RPLBH+1 for copy replacing

;V12B****************
;DMN	22-Apr-83	[1463] Fix COPY REPLACING when BY and == are not on same line.
;DMN	 7-Dec-82	[1440] COPY REPLACING loses terminal period if replacing a numeric literal.
;SMI	17-Sep-82	[1406] COPY REPLACING does not work if continued in A margin.
;RLF	 2-Jul-82	[1372] COPY REPLACING does not know == are missing after
;				BY for pseudo-text.
;RJD	23-Feb-82	[1342] Handle D in continuation column when scanning for end of literal
;WTK	30-Sep-81	[1314] Continuation character after "(" gives bad subscript.
;JSM	24-Sep-81	[1310] Compiler forgets first of two LIB devices.

;V12A****************
;V12A****************
;JSM	14-Apr-81	[1125] *** NOT INCLUDED, HAS BAD SIDE EFFECTS ***
;			COPY REPLACING gives spurious warnings when numeric replacement
;			precedes end of statement in DATA DIVISION.
;JEH	04-Mar-81	[1122] Save AC6 when opening second source file.
;JSM	24-Oct-80	[1065] With COPY REPLACING, check for end of library member.
;JSM	24-Oct-80	[1064] With COPY REPLACING don't split a line if the
;			       only input characters left are "." and line-feed.
;JSM	24-Oct-80	[1063] Special handling for paragraph names and
;			       01 level numbers with COPY REPLACING.
;DAW	18-JUL-80	[1036] FIX PRINTING OF SPECIAL CHARS IN THE LISTING
;DMN	29-MAY-80	[1023] FIX VARIOUS PROBLEMS WITH PICTURES  IN COPY REPLACING.
;DMN	20-MAY-80	[1022] FIX PROBLEM OF MISSING CHARACTER ON LISTING FILE IN COPY REPLACING.
;DMN	13-MAY-80	[1020] FIX LINE TOO LONG PROBLEM IN COPY REPLACING.
;DMN	25-APR-80	[1015] USE THE CORRECT RIGHT MARGIN ON COPY REPLACING.
;DMN	22-APR-80	[1013] FIX LOOP IF MISSING == ON COPY REPLACING.
;DMN	26-MAR-80	[1001] MAKE ALL "LITERAL" WORK IN COPY REPLACING.

;V12*****************
;DMN	21-AUG-79	[726] FIX COPY REPLACING WHEN MULTIPLE OF SIX CHARS.
;DMN	30-APR-79	[704] FIX MULTIPLE COPY REPLACING ORDERING BUG.
;DMN	30-APR-79	[702] MAKE GETSRC A GLOBAL SYMBOL FOR DATE-COMPILED.
;DMN	 9-MAR-79	[657] FIX PROBLEM WITH LOOKAHEAD IN COPY REPLACING INTEGER.
;DMN	 6-MAR-79	[655] CHECK FOR PREMATURE EOF ON LIBRARY FILE
;DMN	18-DEC-78	[620] STORE SEQ. NO. CORRECTLY FOR DATE-COMPILED PARAGRAPH.
;DMN	15-DEC-78	[617] *** NOT USED ***
;DMN	 9-NOV-78	[***] FIX INFINITE LOOP IF TERMINAL == IS IN A-MARGIN
;DMN	19-SEP-78	[557] FIX VARIOUS COPY REPLACING BUGS

;V11*****************
;DMN			REWROTE COPY VERB

;V10*****************
;EHM	10-JAN-77	[526] IGNORE EDITS PAGE MARKS SO CONTINUATION WORKS
;EHM	02-JUN-77	[477] DO BETTER RECOVERY WHEN LIBARY NOT FOUND
;MDL	20-APR-77	[470] BE MORE AWARE WHEN "DECIMAL-POINT IS COMMA"
;DPL	09-DEC-76	[453] MAKE /S WORK FOR DBMS
;SSC	3-5-75		PUT 6A EDIT %316 DIRECTLY INTO V10
;********************

; EDIT 367 FIX THE MISSING OF LISTING OF ".", "," OR ";" THAT IS IN A LIBARY
; EDIT 364 DBMS FIX - MAKE ONLY ONE CALL TO DBGETF BECAUSE ONLY ONE
;	   INVOKE STATEMENT ALLOWED.
; EDIT 354 FIX TO HANDLE SOURCE CHAR COUNTER.
; EDIT 352 "I/O TO UNASSIGN " PROBLEM WHILE ATTEMPTING TO READ LIBRARY
;	   FILE IF "COPY" IS LAST COBOL STATEMENT IN SOURCE FILE.
; EDIT 323 ALLOW "ALL" TO BE USED AS A DEVICE IN A "SELECT" STATEMENT
; EDIT 275 RECOVER PROPERLY UPON RETURN FROM LIBARY FILE
; EDIT 213 DO NOT ALLOW COPY WITHIN A LIBARY; IF LITERAL TOO LONG, GIVE ERROR MSG ONLY ONCE
; EDIT 156 FIXES COMMENT PROBLEM ON FIRST LINE OF A LIBRARY INPUT
; EDIT 150 RESET SEARCH SWITCH WASERC FOR SAVED ITEM
GETITM:	TSWF	FPERWD		;GET PERIOD AND LAST WORD?
	JRST	[PUSHJ	PP,GETWRD	;YES, GET PERIOD
		JRST	GITM1A]		;BUT DON'T CHECK FOR REPLACING
	TSWF	FREGWD		;NO--REGET PREVIOUS WORD?
	JRST	GETWRD		;YES--DO SO, AND RETURN

	SKIPE	W2,SAVEWD+1	;ANYTHING SAVED?
	JRST	GITM20		;YES

	PUSHJ	PP,GETWRD	;GET NEXT WORD
GITM1C:	TSWF	FRLIB		;[557] READING FROM LIBRARY?
	TSWF	FCOPY		;YES, BUT REPLACING?
	JRST	GITM1A		;NO
	SKIPE	RPLCNT		;ANY REPLACEMENTS?
	JRST	RPLTST		;YES, SEE IF THIS IS ONE
GITM1A:	TLNN	W1,GWLIT	;LITERAL?
	TLNN	W1,GWRESV	;NO--RESERVED WORD?
	JRST	GTITM3		;NO

	LDB	CT,GWVAL	;YES--FIGURATIVE CONSTANT?
	CAIL	CT,700
	CAILE	CT,707
	JRST	GTITM2		;NO
	CAIN	CT,ALL.		;MAYBE--"ALL"?
	JRST	GITM30		;YES
	SKIPE	FLGSW		;FIPS FLAGGER?
	PUSHJ	PP,GITM3B	;YES, SEE IF LEGAL FIG-CON
	MOVEI	CT,FIGCN.	;IT IS A FIGURATIVE CONSTANT
	TLO	W1,GWFIGC

GTITM2:	SETZM	WASERC		;ASSUME IT WAS NOT 'SEARCH'
	CAIN	CT,SEARC.	;IS IT 'SEARCH'?
	SETOM	WASERC		;YES--SET FLAG

	LDB	TE,GWCP		;GET CHARACTER POSITION
	CAIGE	TE,^D12		;IN A-MARGIN?
	IORI	CT,AMRGN.	;YES--SET FLAG
	MOVEM	CT,ITEMCT
	CAIE	CT,COPY.	; [213] "COPY" ?
	CAIN	CT,COPY.+AMRGN.	; [213] POSSIBLY WITHIN A-MARGIN
	CAIA			; [213] YES
	POPJ	PP,		;RETURN
	TSWT	FRLIB		; [213] ARE WE WITHN A LIBARY ROUTINE?
	JRST	CPYLIB		;GO HANDLE COPY
	MOVEI	DW,E.492	; [213] COPY WITHIN A LIBARY ILLEGAL
	PUSHJ	PP,FATAL	; [213]
GITM2B:	PUSHJ	PP,GETWRD	; [213] GET NEXT WORD
	HLRZM	W1,TA		; [213] MOVE FOR TESTING
	CAIE	TA,PERWD	; [213] IF PERIOD
	CAIN	TA,ENDIT	; [213] OR END OF SOURCE
	JRST	GITM1A		; [213] DONE-GO ON
	TSWT	FCOPY!FRLIB	; [213] OR IF NO LONGER IN LIBARY
	JRST	GITM1A		; [213] DONE- GO ON
	JRST	GITM2B		; [213] KEEP SEARCHING


;NOT A RESERVED WORD

GTITM3:	TLNE	W1,GWLIT	;IS IT A LITERAL?
	JRST	GITM10		;YES

	SKIPE	CREFSW		;IF WE ARE CREFFING,
	PUSHJ	PP,PTCRF0	;  WRITE OUT CREF ITEM

	TLNE	W1,GWNOT	;NO--IN NAMTAB?
	JRST	GITM3A		;NO

	HRRZ	CT,(TA)		;YES
	JUMPN	CT,GTITM4	;DEFINED?
GITM3A:	SKIPE	FLGSW		;FIPS FLAGGER?
	PUSHJ	PP,[LDB	CT,[POINT 6,NAMWRD,5]	;YES, GET FIRST CHAR. OF NAME
		CAIL	CT,'A'		;SEE IF ALPHABETIC
		CAILE	CT,'Z'
		PUSHJ	PP,FLG.HI	;NO, FLAG IT
		POPJ	PP,]
	MOVEI	CT,USERN.	;NO
	JRST	GTITM2		;RETURN

GITM3B:	PUSH	PP,CH		;GET AN ACC
	MOVE	CH,NAMWRD	;GET ACTUAL NAME
	CAME	CH,[SIXBIT /ZERO/]
	CAMN	CH,[SIXBIT /SPACE/]
	JRST	GITM3D		;THESE ARE LOW LEVEL
	CAMN	CH,[SIXBIT /QUOTE/]
	JRST	GITM3D		;SO IS THIS
	CAME	CH,[SIXBIT /HIGH-V/]
	CAMN	CH,[SIXBIT /LOW-VA/]
	SKIPA	CH,NAMWRD+1	;THESE ARE POSSIBLE
	JRST	GITM3C		;NOTHING ELSE IS
	CAME	CH,[SIXBIT /ALUE/]
	CAMN	CH,[SIXBIT /LUE/]
	JRST	GITM3D		;THESE ARE LOW LEVEL
GITM3C:	PUSHJ	PP,FLG.HI	;WARN USER
GITM3D:	POP	PP,CH
	POPJ	PP,
;IT IS A DEFINED USER WORD

GTITM4:	PUSH	PP,TA
	SKIPE	FLGSW		;FIPS FLAGGER?
	PUSHJ	PP,[LDB	CT,[POINT 6,NAMWRD,5]	;YES, GET FIRST CHAR. OF NAME
		CAIL	CT,'A'		;SEE IF ALPHABETIC
		CAILE	CT,'Z'
		PUSHJ	PP,FLG.HI	;NO, FLAG IT
		POPJ	PP,]
	MOVE	TA,0(TA)	;GET TABLE LINK
	LDB	CT,[POINT 3,TA,20]	;GET CODE
	EXCH	DT,0(PP)	;SAVE DT, DT_NAMTAB ADDRESS
	JUMPE	CT,GITM12	;IF CODE ZERO, SPECIAL
	PUSHJ	PP,LNKSET	;GET TABLE ADDRESS INTO TA
GITM4B:	EXCH	TA,DT		;DT_TABLE ADDRESS, TA_NAMTAB ADDRESS

	MOVE	CT,CODTAB(CT)

	CAIN	CT,MNEMO.	;MNEMONIC?
	JRST	GTITM9		;YES

GITM4A:	POP	PP,DT		;RESTORE DT
	JRST	GTITM2		;RETURN


;CODE TABLE FOR USER NAMES

CODTAB:	FILEN.	;FILTAB
	DATAN.	;DATAB
	CONDI.	;CONTAB
	0	;INVALID
	PRONM.	;PROTAB
	EXTNA.	;EXTAB
	0	;INVALID
	MNEMO.	;MNETAB
;MNEMONIC NAME
GTITM9:	MOVE	TE,1(DT)
	TLNN	TE,MTCONS	;DEVICE-NAME?
	MOVEI	CT,SPECN.	;NO
	TLNE	TE,MTALPA	;ALPHABET-NAME?
	MOVEI	CT,ALPBN.	;YES
	TLNE	TE,MTSYMB	;SYMBOLIC-CHARACTER?
	MOVEI	CT,SYCHN.	;YES
	JRST	GITM4A		;RETURN

;IT IS A LITERAL
GITM10:	TLNE	W1,GWNLIT	;NUMERIC?
	JRST	GITM11		;YES
	MOVEI	CT,LITER.	;NO
	JRST	GTITM2

GITM11:	MOVEI	CT,INTGR.
	TLNE	W1,GWDP		;DECIMAL-POINT?
	AOJA	CT,GTITM2	;YES
	JRST	GTITM2		;NO--INTEGER

;ITEM IS CODE ZERO.
;IT IS EITHER A FILE-NAME OR A REPORT-NAME.

GITM12:	MOVE	TE,FILNXT	;GET SIZE OF
	SUB	TE,FILLOC	;  FILTAB
	CAILE	TA,(TE)		;IS ITEM WITHIN FILTAB?
	JRST	GITM13		;NO

	ADD	TA,FILLOC	;MAYBE--GET ABSOLUTE ADDRESS
	LDB	TE,FI.NAM##	;GET FILTAB'S NAMTAB LINK
	HLRZ	TD,DT		;GET RELATIVE NAMTAB ADDRESS
	CAIN	TE,(TD)		;IS IT SAME AS THIS ONE?
	JRST	GITM4B		;YES

GITM13:
IFN MCS,<
	MOVE	TA,(DT)		;GET TABLE LINK FROM NAMTAB
	MOVE	TE,CDNXT
	SUB	TE,CDLOC	;IS THIS WITHIN CDTAB?
	CAILE	TA,(TE)
	JRST	GTM13A		;NO
	ADD	TA,CDLOC
	LDB	TE,CD.NAM##
	HLRZ	TD,DT
	CAIN	TE,(TD)
	SKIPA	CT,[CDNAM.]	;CD-NAME CODE
GTM13A:>
	MOVEI	CT,RPNAM.	;REPORT-NAME CODE
	MOVE	TA,DT		;TA_NAMTAB ADDRESS
	JRST	GITM4A
;SOMETHING WAS SAVED AT A PREVIOUS TIME, BY "FPERWD".

GITM20:	MOVE	W1,SAVEWD
	MOVE	CT,SAVEWD+2
	MOVEM	CT,ITEMCT

	SETZM	SAVEWD+1
	LDB	CP,GWCP
	LDB	LN,GWLN

	TSWF	FEOF		;END OF SOURCE?
	JRST	GITM21		;YES

	TLNE	W1,GWLIT	;WAS IT A LITERAL?
	POPJ	PP,		;YES

	TLZ	W1,GWNOT	;NO--GO LOOK IN NAMTAB
	PUSHJ	PP,TRYNAM
	  TLOA	W1,GWNOT
	HRR	W1,0(TA)
	TRZ	CT,AMRGN.	;[150] RESET A-MARGIN SW
	JRST	GTITM2		;CHECK FOR SEARCH AND POSSIBLY RESET A-MARGIN SWITCH


GITM21:	MOVSI	W1,ENDIT	;RETURN AN "END OF PROG"
	LDB	CT,GWVAL
	POPJ	PP,
;THE WORD "ALL" WAS SEEN

GITM30:	MOVE	TA,PHASEN	; [323] GET CURRENT PHASE
	CAIN	TA,"B"		; [323] IF IN PHASE B (ENV DIVISION)
	JRST	GTITM2		; [323]	ALLOW IT- WE MAY BE IN SELECT
	SKIPE	WASERC		;WAS PREVIOUS WORD 'SEARCH'?
	JRST	GTITM2		;YES--THEN NO LITERAL IS COMING
	HRRZ	TA,OPRTR+1	;GET OPRTR CODE
IFN DBMS,<
	CAIN	TA,46		; USING OPERATOR?
	JRST	GTITM2		;YES, "ALL" IS OK HERE
	CAIE	TA,63		;IS IT OPEN OR CLOSE?
	CAIN	TA,62
	JRST	GTITM2		;YES, "ALL" IS OK HERE.
	CAIN	TA,122		;"DELETE" COMMAND IS OK TOO.
	JRST	GTITM2
>
	CAIN	TA,UDELIM	;ALSO IN "UNSTRING"
	JRST	GTITM2
	CAIN	TA,17		;[*DMN*] ALSO USE FOR DEBUGGING IS OK
	JRST	GTITM2
	SKIPE	FLGSW		;FIPS FLAGGER?
	CAIN	TA,42		;YES, BUT NOT FOR INSPECT
	CAIA
	PUSHJ	PP,GITM3B	;FLAG ALL AS ILLEGAL

;[1001] ENTER HERE FROM COPY REPLACING TEST IF "ALL FLAG" IS ON

GITM34:	PUSHJ	PP,GETWRD	;[1001] GET NEXT WORD
	TLNN	W1,GWLIT	;LITERAL?
	TLNN	W1,GWRESV	;NO--IS NEW WORD RESERVED?
	JRST	GITM35		;NO

	LDB	CT,GWVAL	;IS NEW WORD A FIG. CONST.?
	CAIL	CT,700
	CAILE	CT,707
	JRST	GITM33		;NO--ERROR

	CAIN	CT,ALL.		;MAYBE--"ALL" AGAIN?
	JRST	GITM33		;YES--ERROR

	MOVEI	CT,FIGCN.	;NO--IT IS A FIG. CONST.
	TLOA	W1,GWFIGC!GWALL	;[557]
GITM35:	TLO	W1,GWALL	;[557] NO--SET "ALL" FLAG
	JRST	GITM1C		;[557] RETURN TO SET UP "CT" AND CHECK REPLACING

;ERROR WITH "ALL"

GITM33:	MOVEI	DW,E.273
	PUSHJ	PP,FATAL
	JRST	GITM1A
;PUT ITEM ONTO CREF FILE

PUTCRF:	SKIPN	CREFSW		;IF NO CREF FILE,
	POPJ	PP,		;  FORGET IT

PTCRF0:	MOVE	TE,[POINT 6,NAMWRD]

PTCRF1:	MOVE	TD,[POINT 6,CH]
PTCRF2:	ILDB	TC,TE
	CAIN	TC,':'
	MOVEI	TC,'-'
	CAIN	TC,';'
	MOVEI	TC,'.'
	IDPB	TC,TD
	TLNE	TD,770000
	JRST	PTCRF2

	SOSG	CRFBHO+2
	PUSHJ	PP,RITCRF
	IDPB	CH,CRFBHO+1

	CAME	TE,[POINT 6,NAMWRD+4,35]
	JRST	PTCRF1

	MOVE	CH,W2
	TLZ	CH,377774
	SOSG	CRFBHO+2
	PUSHJ	PP,RITCRF
	IDPB	CH,CRFBHO+1
	POPJ	PP,

IFE TOPS20,<
RITCRF:	OUT	CRF,
	  POPJ	PP,
	MOVEI	CH,CRFDEV
	JRST	DEVDED
>
;SCAN THE NEXT WORD.
;SET UP WORD DESCRIPTORS.

GETWRD:	SETZM	SAVECH
	TSWFZ	FPERWD;		;RETURN A PERIOD AND A WORD?
	JRST	TESTWD		;YES
	TSWFZ	FREGWD;		;NO--RETURN SAME WORD?
	JRST	REGWRD		;YES
	TSWFZ	FGTPER;		;RETURN A PERIOD?
	JRST	SETPER		;YES
	TSWFZ	FGTMIN;		;NO--RETURN A "-"?
	JRST	SETMIN		;YES

	SETZM	SAVEWD+1	;INSURE NOTHING SAVED
	SETZM	NAMWRD		;CLEAR NAMWRD
	MOVE	TA,[XWD NAMWRD,NAMWRD+1]
	BLT	TA,NAMWRD+4

	TSWF	FRTST		;SEARCHING FOR REPLACEMENT TEXT
	SETZM	L2BH0		;YES, CLEAR SO WE KNOW IF GETKAR SAVED LAST BLANK
	SETZM	R3BH0		;...

	SWOFF	FLETTR!FALIT	;TURN OFF "ALPHA" FLAGS
	JRST	GTWD1B
;SCAN THE NEXT WORD  (CONT'D).
;INITIALIZE.

GETWD1:	TSWTZ	FNEEDS		;TURN OFF "SPACE NEEDED"
	JRST	GTWD1B
	DMOVEM	LN,SAVBLN

GTWD1B:	TSWF	FEOF;		;END-OF-FILE?
	JRST	SETEND		;YES
	TSWFZ	FECOPY		;ANY LIBRARY TO FINISH UP?
	PUSHJ	PP,ENDCPY	;YES--DO SO

GTWD1Z:	PUSHJ	PP,GETCH	;[1314] GET NEXT CHARACTER
	CAIE	CH,"-"		;[1314] MAKE SURE WEARE NOT
	JRST	GTWD1Y		;[1314] LOOKING AT A
	CAIN	CP,7		;[1314] CONTINUATION CHARACTER
	JRST	GTWD1Z		;[1314]
GTWD1Y:	TSWF	FRTST		;[557] JUST DOING REPLACEMENT TEST?
	JRST	[SKIPGE	LIBBH+2		;[557] YES, BUT IS LIBRARY DONE?
		POPJ	PP,		;[557] YES, JUST GIVE UP
		JRST	.+1]		;[557] NO
	CAIE	CH," "
	CAIN	CH,$HT
	JRST	GETWD1

	DMOVEM	LN,WORDLN
	SWOFF	FNEEDS;

	MOVE	TE,SAVBLN
	JUMPE	TE,GTWD1C
	MOVEM	TE,BLNKLN
	MOVE	TE,SAVBCP
	MOVEM	TE,BLNKCP

GTWD1C:	MOVE	CT,INPTCP
	MOVEM	CT,INPTST

	TSWT	FRTST		;[1576] ARE WE READING FOR REPLACEMENT TEST?
	JRST	GTW1CC		;[1576] NO
	DMOVE	W1,LIBBH+1	;[1576] STORE LIB FILE BUFFER HDR
	DMOVEM	W1,ENDTKN##+1	;[1576]  AT THE POINT WHERE THE TOKEN STARTS,
	MOVE	CT,RPLBLK	;[1576]  NOT AT WHERE THE SCAN FOR THE TOKEN
	MOVEM	CT,ENDTKN	;[1576]  STARTS, COULD BE POINTING TO COMMENT
	SKIPE	TKNBH+1		;[1576] HAS THE FIRST TOKEN IN REPLACEMENT
	JRST	GTW1CC		;[1576]  STRING BEEN STORED?

GTW1CD: MOVEM	CT,TKNBH##	;[1576] NO
	DMOVEM	W1,TKNBH+1	;[1576]

GTW1CC:	SETZB	CT,LC		;[1576] CLEAR COUNTERS
	SETZM	SAVBLN
	DMOVE	PB,[POINT 7,LITVAL
		    POINT 6,NAMWRD]
	SETZB	W1,W2
	SETZM	NOCONT		;SET "CONTINUATIONS LEGAL" INDICATION

	TSWF	FCOPY		;ARE WE COPYING
	SKIPN	EOLKAR		;YES--END-OF-LINE TO GO OUT?
	JRST	GETWD2		;NO

	SWON	FREGCH		;YES--SET "REGET CHARACTER"
	MOVE	CH,EOLKAR
	PUSHJ	PP,PUTCPY
	PUSHJ	PP,GETSRC
;FIRST NON-BLANK CHARACTER SEEN
GETWD2:	CAIL	CH,141		;CONVERT LC TO UC
	CAILE	CH,172
	JRST	.+2		;NOT LC
	TRZ	CH,40
	CAIG	CH,"Z"		;LETTER?
	CAIGE	CH,"A"
	JRST	GETWD5		;NO

	TLNE	W1,GWLIT	;YES--IS THIS A LITERAL?
	JRST	GTWD5A		;YES--ERROR

GETWD3:	SWON	FLETTR;		;NO--SET FLETTR
GTWD3A:	CAIGE	CT,^D30		;30 CHARACTERS YET?
	AOJA	CT,GTWD3B	;NO--INCREMENT AND JUMP

	MOVEI	DW,E.55		;YES
	CAIN	CT,^D30		;HAVE WE PUT OUT DIAG?
	PUSHJ	PP,WARN		;NO--PUT IT OUT
	AOJA	CT,GETWD4

GTWD3B:	IDPB	CH,PB
	CAIN	CH,"-"		;IS IT "-"?
	MOVEI	CH,":"		;YES--SUBSTITUTE ":"
	SUBI	CH,40		;CONVERT TO SIXBIT
	IDPB	CH,PA		;STASH IT

GETWD4:	PUSHJ	PP,GETKAR	;GET NEXT CHARACTER
	JRST	GETWD2

GETWD5:	CAIN	CH,"_"		;ALLOW UNDER_SCORE
	JRST	GTWD5C		;AS EQUIVALENT TO HYPHEN
	CAIG	CH,"9"		;NOT LETTER--DIGIT?
	CAIGE	CH,"0"
	JRST	GTWD10		;NO

GTWD5B:	AOJA	LC,GTWD3A	;YES--STASH IT

GTWD5A:	MOVEI	DW,E.76
	PUSHJ	PP,FATAL
	JRST	GETWD4

GTWD5C:	SKIPE	FLGSW		;ARE WE CHECKING FIPS FLAGGER?
	PUSHJ	PP,FLG.VX	;YES, FLAG AT VAX LEVEL
	MOVEI	CH,"-"		;CONVERT TO HYPHEN
	AOJA	LC,GTWD3A	;STASH IT
;TRY FOR NON-NUMERIC LITERAL

GETWD6:	CAIN	CH,$QT		;QUOTE?
	JRST	GTWD6A
	CAIE	CH,"'"
	JRST	GTWD11		;NO

GTWD6A:	JUMPE	CT,GTWD6C	;YES--ANYTHING SEEN?
	SWON	FREGCH;		;YES--SET "REGET CHARACTER"
	JRST	ENDWRD		;FINISH UP

GTWD6C:	TLO	W1,GWLIT	;TURN ON "LITERAL" FLAG
	SWON	FLETTR!FALIT;	;TURN ON "ALPHA" FLAGS
	MOVEM	CH,TERMQ	;SAVE DELIMITER

GETWD7:	PUSHJ	PP,GETCH	;GET NEXT CHARACTER
	MOVE	TE,SRCCOL	;COLUMN 7?
	CAIN	TE,7
	JRST	GETWD9		;YES

	CAMN	CH,TERMQ	;NO--CLOSING QUOTE?
	JRST	GETWD8		;YES

GTWD7A:	CAIGE	CT,MAXLIT	; [213] NO--TOO BIG?
	AOJA	CT,GTWD7B	;NO--INCREMENT AND JUMP

	MOVEI	DW,E.56		;YES
	CAIN	CT,MAXLIT	;HAVE WE PUT OUT DIAG?
	PUSHJ	PP,FATAL	;NO--PUT IT OUT
	AOJA	CT,GETWD7	; [213] COUNT UP OVERSIZED LITERAL

GTWD7B:
IFN ANS82,<
	SKIPN	FLGSW		;DO WE NEED FIPS FLAGGER?
	JRST	GTWD7C		;NO, BYPASS THIS TEST
	CAIN	CT,MXLT74+1	;IS IT TOO BIG FOR 74 STANDARD?
	PUSHJ	PP,FLG.8	;YES, TEST AT 82 LEVEL
	CAIN	CT,MXLT82+1	;IS IT TOO BIG FOR 82 STANDARD?
	PUSHJ	PP,FLG.VX	;YES, FLAG AT VAX LEVEL
GTWD7C:>
	CAIGE	CH,140
	CAIGE	CH,40
	TLO	W1,GWASCI
	IDPB	CH,PB
	JRST	GETWD7
;CLOSING QUOTE FOUND

GETWD8:	PUSHJ	PP,GETCH	;LOOK AHEAD
	MOVE	TE,SRCCOL	;COLUMN 7?
	CAIN	TE,7
GTWD8X:	CAIE	CH,"-"		;HYPHEN?
	JRST	GTWD8A		;NO
GTWD8Z:	PUSHJ	PP,GETCH	;GET NEXT CHARACTER
	MOVE	TE,SRCCOL	;COLUMN 7 AGAIN?
	CAIN	TE,7
	JRST	GTWD8X		;YES
	CAIE	CH,$HT		;NO--TAB?
	CAIN	CH," "		;NO--SPACE?
	JRST	GTWD8Z		;YES--LOOP
	CAMN	CH,TERMQ	;FIRST CHAR A QUOTE
	JRST	GETWD8		;YES, GET RID OF IT [SEE NC215]

GTWD8A:	CAMN	CH,TERMQ	;IS IT 2 CONSECUTIVE QUOTES?
	JRST	GTWD7A		;YES, PASS ONE
	SWON	FREGCH		;NO, SET REGET CHAR
	MOVE	CH,TERMQ	;JUST INCASE
	CAILE	CT,MAXLIT	; [213] LIMIT LITERAL SIZE
	MOVEI	CT,MAXLIT	; [213] TO 120 OR 256 CHARS
	SWOFF	FALIT		;CLOSING QUOTE SEEN
	DMOVEM	LN,SAVBLN	;UPDATE PTRS TO END OF LITERAL
	PUSHJ	PP,GTWD18
	MOVEM	CT,TKNSIZ	;[1576]
	AOS	TKNSIZ		;[1576] ADD 2 FOR
	AOS	TKNSIZ		;[1576]  OPEN AND CLOSE QUOTES
	JRST	ENDLIT
;CONTINUATION COLUMN WHEN SCANNING NON-NUMERIC LITERAL

GETWD9:	CAIE	CH," "		;SPACE?
	JRST	GTWD9B		;NO
	DMOVE	LN,WORDLN
	MOVEI	DW,E.70		;YES--ERROR
GTWD9A:	PUSHJ	PP,FATAL
	JRST	ENDWRD

GTWD9B:	CAIN	CH,"-"		;HYPHEN?
	JRST	GTWD9C		;YES
	MOVEI	DW,E.73		;NO--ERROR
	JRST	GTWD9A		;QUIT

GTWD9C:	PUSHJ	PP,GETCH	;GET NEXT CHARACTER
	MOVE	TE,SRCCOL	;COLUMN 7 AGAIN?
	CAIN	TE,7
	JRST	GETWD9		;YES

	CAIE	CH,$HT		;NO--TAB?
	CAIN	CH," "		;NO--SPACE?
	JRST	GTWD9C		;YES--LOOP
	CAMN	CH,TERMQ	;NO--QUOTE?
	JRST	GETWD7		;YES--EVERYTHING OK
	PUSH	PP,CH
	MOVEI	DW,E.71		;NO--WARN HIM
	PUSHJ	PP,WARN
	POP	PP,CH
	JRST	GTWD7A		;GO STASH IT
;TRY A SPACE OR TAB

GTWD10:	CAIE	CH," "	
	CAIN	CH,$HT
	JRST	ENDWRD		;YES--IT IS A SPACE OR A TAB
	DMOVEM	LN,SAVLN1	;SAVE LINE NUMBER AND CHARACTER POSITION
	MOVEM	CH,SAVECH	;	AND CHARACTER

;TRY A HYPHEN

	CAIE	CH,"-"		;HYPHEN?
	JRST	GETWD6		;NO

	JUMPE	CT,GTW10C	;YES--FIRST CHARACTER?
	PUSHJ	PP,GETKAR	;NO--GET NEXT ONE
	CAIN	CH," "		;SPACE?
	JRST	GTW10A		;YES

	SWON	FREGCH;		;NO--SET "REGET CHARACTER"
	TLNE	W1,GWSIGN!GWDP	;IS IT A SIGNED LITERAL?
	JRST	GTW10D		;YES--ERROR

	MOVEI	CH,"-"		;GET HYPHEN BACK
	TLO	W1,GWHYF	;TURN ON "THERE IS A HYPHEN"
	JRST	GETWD3

;SPACE AFTER "-"

GTW10A:	TSWT	FARITH		;EXPRESSION?
	JRST	GW10AA		;NO
	SWON	FGTMIN;		;YES--SET "REGET MINUS"
	JRST	ENDWRD

GW10AA:	DMOVE	LN,SAVLN1
	MOVEI	DW,E.54		;NOT EXPRESSION--ERROR
	PUSHJ	PP,FATAL
	JRST	ENDWRD
;INPUT CHARACTER IS A HYPHEN  (CONT'D)

;WORD STARTED WITH A HYPHEN

;HAS TO BE A LITERAL

GTW10C:	IDPB	CH,PB
	TLO	W1,GWLIT!GWSIGN
	AOJA	CT,GETWD4


;IMPROPER LITERAL--SIGN AFTER EITHER SIGN OR DECIMAL POINT

GTW10D:	DMOVE	LN,SAVLN1
	MOVEI	DW,E.76
	PUSHJ	PP,FATAL
	JRST	GETWD4
;TRY A PERIOD

GTWD11:	CAIE	CH,"."		;PERIOD?
	JRST	GTWD12		;NO

	TSWT	FLETTR;		;ANY LETTERS SO FAR?
	CAME	CH,DCPNT.	;NO--ALSO DECIMAL POINT?
	JRST	GTW11C		;NO

	SKIPGE	RPLBH+0		;SEARCHING FOR REPLACEMENTS?
	PUSHJ	PP,SVPKAR	;YES, SAVE LOC OF PERIOD
	SKIPE	TERSCN		;[657] SHOULD WE TERMINATE SCAN NOW?
	JRST	[CAME	CH,TERSCN	;[657] MAKE SURE ITS WHAT WE EXPECTED
		JRST	.+1		;[657] SOME SORT OF ERROR
		MOVEI	CH," "		;[657] RETURN A SPACE
		SETZM	TERSCN		;[657] ONLY DO IT ONCE
		JRST	.+2]		;[657] BUT DON'T READ NEXT CHARACTER
	PUSHJ	PP,GETKAR	;YES
	JUMPE	CT,GTW11H	;WAS DECIMAL POINT THE FIRST CHARACTER?
	CAIG	CH,"9"		;NO--IS THIS A DIGIT?
	CAIGE	CH,"0"
	JRST	GTW11B		;NO

GTW11A:	TLOE	W1,GWDP		;YES--SET "DECIMAL-POINT" INDICATION
	JRST	GTW11G		;ALREADY SET--ERROR

	TLO	W1,GWLIT
	MOVEI	TC,"."
	IDPB	TC,PB		;STASH PERIOD
	SETZM	SAVECH
	AOJA	CT,GTWD5B	;KICK UP COUNT--GO TO LITERAL

GTW11B:	SWON	FGTPER;
	CAIE	CH," "		;IS IT A SPACE?	
	JRST	GTW11F		;NO--ERROR
	TSWF	FRLIB		;[657] READING FROM LIBRARY?
	TSWF	FCOPY		;[657] YES, BUT REPLACING?
	JRST	GTW11D		;[657] NO NEED FOR SPECIAL CHECK
	SKIPE	RPLCNT		;[657] ANY POSSIBILITY OF REPLACEMENTS?
	TSWT	FRTST		;[657] YES, BUT ARE WE ON THE REAL READ PASS
	JRST	GTW11D		;[657] NO NEED FOR SPECIAL CHECK
	MOVEI	CP,"."		;[657] YES
	MOVEM	CP,TERSCN	;[657] SET FLAG TO STOP ON READ SCAN
	JRST	GTW11D		;[657] AND CONTINUE

GTW11C:	SWON	FGTPER!FNEEDS;	;SET "GET A PERIOD" AND "SPACE NEEDED"

GTW11D:	DMOVE	LN,SAVLN1
	JUMPN	CT,ENDWRD	;ANYTHING SO FAR?
	JRST	GETWRD
;FIRST CHARACTER WAS DECIMAL POINT

GTW11H:	CAIE	CH," "		;WAS IT FOLLOWED BY A SPACE?
	JRST	GTW11J		;NO--MUST BE A LITERAL
	SWON	FGTPER;		;YES--WARN HIM
	JRST	GTW11D

GTW11J:	TLO	W1,GWLIT!GWDP
	SWON	FREGCH;
	MOVEI	CH,"."
	IDPB	CH,PB
	SETZM	SAVECH
	AOJA	CT,GETWD4

GTW11F:	JUMPN	CT,GTW11E	;ANYTHING BEFORE THE PERIOD?
	SWON	FNEEDS;		;NO--SET "SPACE REQUIRED"
	JRST	GTW11D

GTW11E:	MOVEI	DW,E.76
	PUSHJ	PP,FATAL
	JRST	GTW11D

;TWO DECIMAL POINTS IN LITERAL

GTW11G:	PUSH	PP,CH
	MOVEI	DW,E.77
	DMOVE	LN,SAVLN1
	PUSHJ	PP,FATAL
	POP	PP,CH
	JRST	GTWD3A
;TRY COMMA AND SEMI-COLON

GTWD12:	CAIE	CH,","		;IS IT A COMMA?
	JRST	GTW12B		;NO
	CAME	CH,DCPNT.	;YES--ALSO DECIMAL POINT?
	JRST	GTW12C		;NO

	TSWF	FLETTR		;[470] YES, ALL DIGITS SO FAR?
	JRST	GTW12C		;[470] NO, MUST BE LITERAL OR DATA NAME
	PUSHJ	PP,GETKAR	;YES--LOOK AT NEXT CHARACTER
	CAIG	CH,"9"		;DIGIT?
	CAIGE	CH,"0"
	JRST	GTW12D
	JRST	GTW11A		;YES--TREAT AS DECIMAL POINT

GTW12B:	CAIE	CH,";"		;SEMI-COLON?
	JRST	GTWD13		;NO
GTW12C:	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	PUSHJ	PP,FLG.HI	;YES, TEST AT HIGH-INTERMEDIATE LEVEL
	PUSHJ	PP,GETKAR
GTW12D:	CAIE	CH," "
	SWON	FREGCH;
	JRST	GTW11D

;TRY PLUS

GTWD13:	CAIE	CH,"+"		;NO--IS IT "+"?
	JRST	GTWD14		;NO

	JUMPE	CT,GTW10C	;YES--FIRST CHARACTER?

	MOVEI	DW,E.620	;PROBABLY AN ERROR
	PUSHJ	PP,WARN
	MOVEI	CH,"+"		;RELOAD CHARACTER
	SWON	FREGCH;
	JRST	ENDWRD
;TRY SPECIAL CHARACTERS

GTWD14:	JUMPE	CT,GTWD15	;FIRST CHARACTER?
	SWON	FREGCH;		;NO--SET "REGET CHARACTER"
	JRST	ENDWRD

GTWD15:	CAIE	CH,"*"		;CHECK FOR "*"
	JRST	GTW15A		;NO

	MOVSI	W1,MULWD	;YES--IS NEXT "*" ALSO?
	PUSHJ	PP,GETKAR
	CAIN	CH,"*"
	JRST	GTW15D		;YES--IT'S "**"

	SWON	FREGCH;		;NO
	CAIN	CH," "		;IS NEXT CHARACTER SPACE?
	JRST	SETPN0		;YES
	JRST	GTW17A		;NO

GTW15D:	MOVSI	W1,EXPWD
	JRST	GTW17A

GTW15A:	MOVEI	W1,0
	CAIN	CH,"-"
	MOVSI	W1,MINWD
	CAIN	CH,"+"
	MOVSI	W1,PLUSWD
	CAIN	CH,"("
	MOVSI	W1,LPARWD
	CAIN	CH,":"
	MOVSI	W1,COLNWD
	JUMPN	W1,SETPN0

	MOVE	TA,PUNPTR
GTW15B:	HRRZ	TB,0(TA)
	CAMN	CH,TB
	JRST	GTWD17
	AOBJN	TA,GTW15B

;BAD CHARACTER

	MOVEI	DW,E.57		;PUT OUT DIAG
	PUSHJ	PP,FATAL
	JUMPE	CT,GETWRD	;ANTHING SO FAR?
	JRST	ENDWRD		;YES--FINISH UP
;A SPECIAL CHARACTER WAS SEEN. CHECK FOR FOLLOWING PUNCTUATION.

GTWD17:	HLLZ	W1,0(TA)
GTW17A:	PUSHJ	PP,SETPN0

	PUSH	PP,LN
	PUSH	PP,CP
	PUSHJ	PP,GTWD18
	POP	PP,CP
	POP	PP,LN
	POPJ	PP,

GTWD18:	SETZM	SAVECH
	PUSHJ	PP,GETKAR	;GET NEXT CHARACTER
	CAIN	CH," "		;SPACE?
	POPJ	PP,		;YES
	CAIN	CH,"."		;NO--PERIOD?
	SWON	FGTPER!FNEEDS	;YES--SET FLAGS
	CAIE	CH,";"		;SEMICOLON OR
	CAIN	CH,","		;COMMA?
	SWON	FNEEDS		;YES--SET "SPACE NEEDED"

	TSWT	FNEEDS		;ANY PUNCTUATION SEEN?
	JRST	REGLST		;NO, CHARACTER NOT PUNCTUATION--GET IT NEXT TIME
	MOVEM	CH,SAVECH	;YES--SAVE IT
	DMOVEM	LN,SAVLN1	;SAVE LOCATION
	POPJ	PP,

;RETURN A PERIOD
TESTWD:	TSWTZ	FREGWD;		;ALSO "REGET WORD"?
	JRST	TSTWD1		;NO--SIMPLY RETURN A PERIOD

	DMOVEM	W1,SAVEWD	;SAVE THAT WORD
	MOVE	CT,ITEMCT
	MOVEM	CT,SAVEWD+2

TSTWD1:	MOVSI	W1,PERWD
	POPJ	PP,
;PUNCTUATION OF SOME KIND

SETPN0:	DMOVE	LN,SAVLN1
	SKIPE	FLGSW		;FIPS FLAGGER?
	CAIN	CH,"."		;YES, BUT PERIOD IS LEGAL
	JRST	SETPN2		;NO
	CAIE	CH,"("		;LEFT PAREN IS LEGAL
	CAIN	CH,")"		;SO IS RIGHT PAREN
	JRST	SETPN2
	PUSHJ	PP,FLG.HI	;FLAG ALL OTHERS BELOW HIGH-INTERMEDIATE LEVEL
SETPN1:	DMOVE	LN,SAVLN1
SETPN2:	DPB	LN,GWLN
	DPB	CP,GWCP
	DMOVEM	LN,WORDLN
	POPJ	PP,		;RETURN

SETPLS:	MOVSI	W1,PLUSWD	;PLUS
	MOVEI	CH,"+"
	JRST	SETPN0

SETMIN:	MOVSI	W1,MINWD	;MINUS
	MOVEI	CH,"-"
	JRST	SETPN0

SETPER:	MOVSI	W1,PERWD	;PERIOD
	MOVEI	CH,"."
	JRST	SETPN1
;END-OF-FILE HAD BEEN SEEN BEFORE

SETEND:	MOVSI	W1,ENDIT
	MOVE	LN,SAVELN
	MOVEI	CP,7
	JRST	SETPN2


;REGET SAME WORD

REGWRD:	MOVE	CT,ITEMCT
	TLNE	W1,GWLIT	;LITERAL?
	POPJ	PP,		;YES--RETURN

	TLZ	W1,GWNOT
	PUSHJ	PP,TRYNAM	;NO--GET NAMTAB ENTRY
	  TLOA	W1,GWNOT	;THERE ISN'T ONE
	HRR	W1,0(TA)
	POPJ	PP,
;WORD HAS BEEN SCANNED

ENDWRD: MOVEM	CT,TKNSIZ##	;[1576] Store token size
	TLNE	W1,GWLIT	;LITERAL?
	JRST	ENDLIT		;YES
	TSWF	FLETTR;		;NO--ALL DIGITS?
	JRST	ENDWR0		;NO
	CAIG	CT,^D18		;YES, BUT IS IT TOO BIG 
	JRST	ENDLIT		;NO
	SWON	FLETTR		;YES, MAKE IT A USER-NAME

ENDWR0:	PUSHJ	PP,TRYNAM	;FIND WORD IN NAMTAB
	  JRST	ENDWD2		;NOT FOUND
	MOVE	TB,0(TA)	;GET FLAG WORD
	LDB	TD,NAMVAL	;GET RESERVED WORD VALUE OR CPYTAB POINTER
	TLNN	TB,NAMRSV/1000000; RESERVED WORD?
	JRST	ENDWD4		;NO
	DPB	TD,GWVAL	;YES--SET VALUE IN W1
	TLO	W1,GWRESV	;SET "RESERVED" FLAG

ENDWD4:	HRR	W1,TB		;GET TABLE ADDRESS
	HLRZ	TB,TA		;SET NAMTAB POINTER
	DPB	TB,GWNAMP

ENDWD1:	DMOVE	LN,WORDLN	;SET "LN" & "CP"
	DPB	LN,GWLN
	DPB	CP,GWCP
	POPJ	PP,		;RETURN

ENDWD2:	TLO	W1,GWNOT
	JRST	ENDWD1
;LITERAL HAS BEEN SCANNED

ENDLIT:	TLO	W1,GWLIT	;SET "LITERAL" FLAG
	PUSH	PP,CT
	PUSH	PP,CT+1		;GET 2 ACCS
	JUMPE	CT,[SETZM LITVAL	;NUL LITERAL SO CLEAR VALUE
		JRST	ENDL1B]
	IDIVI	CT,5		;GET NO. OF WORDS
	JUMPE	CT+1,ENDL1B	;NO REMAINDER
	MOVE	CT+1,[BYTE (7) 177
		BYTE	(7) 177,177
		BYTE	(7) 177,177,177
		BYTE	(7) 177,177,177,177]-1(CT+1)
	ANDM	CT+1,LITVAL(CT)
ENDL1B:	POP	PP,CT+1
	POP	PP,CT
	TSWT	FLETTR;		;NON-NUMERIC?
	JRST	ENDL2		;NO
ENDL1:	DPB	CT,GWVAL	;SET SIZE
	JRST	ENDWD1

ENDL2:	JUMPE	LC,ENDL3	;ANY SIZE?
	TLO	W1,GWNLIT	;YES--SET "NUMERIC" FLAG
	CAIG	LC,^D18		;TOO BIG?
	JRST	ENDL1

	MOVEI	DW,E.56		;YES--PUT OUT DIAG
	PUSHJ	PP,FATAL
	MOVEI	CT,^D18		;REDUCE SIZE
	JRST	ENDL1

ENDL3:	LDB	CH,[POINT 7,LITVAL,6];NO SIZE--IS IT "+"?
	CAIE	CH,"+"
	JRST	SETMIN		;NO--MUST BE "-"
	JRST	SETPLS		;YES
;GET A CHARACTER FOR A WORD OR NUMERIC LITERAL.

;IF A SPACE IS SEEN, THE REMAINDER OF THE LINE IS SCANNED. IF NOTHING
;	IS LEFT ON THE LINE, THE CONTINUATION COLUMN OF THE NEXT LINE
;	IS CHECKED.  IF HYPHEN, THAT LINE IS SCANNED UNTIL A NON-BLANK
;	CHARACTER IS FOUND.

;IF THERE IS NO CONTINUATION, AND A SPACE IS FOUND, THE SPACE IS RETURNED.
;IF THERE IS A CONTINUATION, THE FIRST NON-SPACE ON THE LINE IS RETURNED.

GETKAR:	PUSHJ	PP,GETK9

	CAIN	TE,7		;IS IT CONTINUATION COLUMN?
	JRST	GETK2		;YES
	CAIE	CH," "
	JRST	GETK4A
	DMOVEM	LN,SAVBLN	;SAVE LOCATION OF THE BLANK
	TSWF	FRTST		;SEARCHING FOR REPLACEMENT MATCH?
	PUSHJ	PP,SVLKAR	;YES
	SKIPGE	RPLBH+0		;SPECIAL IF READING SRC FOR REPLACEMENT
	JRST	SVSKAR		;YES

GETK1:	PUSHJ	PP,GETK9	;YES--GET NEXT CHARACTER
	CAIN	TE,7		;IS IT CONTINUATION COLUMN?
	JRST	GETK2		;YES

	CAIN	CH," "		;NO--IS IT SPACE?
	JRST	GETK1		;YES--CONTINUE SCANNING

	MOVEI	CH," "		;RETURN A SPACE
REGLST:	SWON	FREGCH;		;NO--SET "REGET CHARACTER" FLAG
	POPJ	PP,

SVSKAR:	MOVE	CH,SRCBH+1	;SAVE BYTE PTR AND COUNT
	MOVEM	CH,R3BH1
	MOVE	CH,SRCBH+2
	MOVEM	CH,R3BH2
	MOVE	CH,SRCBFC
	MOVEM	CH,R3BH0	;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
	MOVE	CH,SAVECP
	MOVEM	CH,R3CPO	;OUTPUT CHAR. POS.
	MOVE	CH,INPTCP
	MOVEM	CH,R3CPI	;INPUT CHAR. POS.
	JRST	GETK1		;NOW GO ON
SVPKAR:	MOVE	CH,SRCBH+1	;SAVE BYTE PTR AND COUNT
	MOVEM	CH,R4BH1
	MOVE	CH,SRCBH+2
	MOVEM	CH,R4BH2
	MOVE	CH,SRCBFC
	MOVEM	CH,R4BH0	;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
	MOVE	CH,SAVECP
	MOVEM	CH,R4CPO	;OUTPUT CHAR. POS.
	MOVE	CH,INPTCP
	MOVEM	CH,R4CPI	;INPUT CHAR. POS.
	POPJ	PP,

SVLKAR:	MOVE	CH,RPLBLK	
	MOVEM	CH,L2BH0	;SAVE CURRENT LIBRARY BLOCK #
	MOVE	CH,LIBBH+1
	ADD	CH,[070000,,0]
	SKIPGE	CH
	SUB	CH,[430000,,1]
	MOVEM	CH,L2BH1	;BACKUP OVER THIS CHAR AND SAVE BYTE PTR.
	MOVE	CH,LIBBH+2
	ADDI	CH,1
	MOVEM	CH,L2BH2	;CHAR. COUNT
	MOVE	CH,SAVECP
	MOVEM	CH,L2CPO	;OUTPUT CHAR. POS.
	MOVE	CH,INPTCP
	MOVEM	CH,L2CPI	;INPUT CHAR. POS.
	POPJ	PP,
;GET A CHARACTER FOR WORD OR NUMERIC LITERAL (CONT'D).

;CONTINUATION COLUMN SEEN.

GETK2:	CAIN	CH," "		;IS CONTINUATION COLUMN  A SPACE?
	JRST	GETK6		;YES--RETURN
	CAIE	CH,"D"		;[1342] A DEBUG LINE?
	CAIN	CH,"d"		;[1342]
	TRNA			;[1342]
	JRST	GETK2A		;[1342] NO--CHECK FOR HYPHEN
	MOVEI	CH," "		;[1342] REPLACE WITH A SPACE
	JRST	GETK6		;[1342] AND RETURN
GETK2A:	CAIE	CH,"-"		;IS CONTINUATION COLUMN A HYPHEN?
	JRST	GETK5		;NO--ERROR
	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	PUSHJ	PP,FLG.HI	;YES, TEST AT HIGH-INTERMEDIATE LEVEL

GETK4:	PUSHJ	PP,GETK9	;YES--SCAN THIS NEW LINE
	CAIN	TE,7		;CONTINUATION COLUMN AGAIN?
	JRST	GETK2		;YES

	CAIN	CH," "		;NO--STIL SPACE?
	JRST	GETK4		;YES--LOOP
	SETZM	SAVBLN		;NO--CLEAR "SAVBLN"

GETK4A:	SETZM	NOCONT
	POPJ	PP,		;RETURN

GETK5:	MOVEI	DW,E.73		;CONTINUATION NOT SPACE OR HYPHEN
	PUSHJ	PP,FATAL
	MOVEI	CH," "
GETK6:	SETOM	NOCONT
	POPJ	PP,


GETK9:	PUSHJ	PP,GETCH
	MOVE	TE,SRCCOL	;REMEMBER SOURCE COLUMN
	TSWF	FEOF;
	POPJ	PP,

	CAIN	CH,$HT
	MOVEI	CH," "
	CAIL	CH,140
	SUBI	CH,40
	POPJ	PP,
;GET THE NEXT CHARACTER FROM THE SOURCE LINE, EVEN IF SPACE.

GETCH:	MOVE	CP,SAVECP	;RESET CHARACTER POSITION
	TSWF	FREGCH;		;RE-GET SAME CHARACTER?
	JRST	GETCH5		;YES
	AOS	CH,INPTCP
	TSWF	FSEQ;		;SEQUENCED INPUT?
	JRST	GETCH3		;YES

	CAIL	CP,CPMAXN	;NO, TOO MANY CHARACTERS?
	JRST	GETCH1		;YES

;STILL SOME SOURCE ON THIS LINE
GETCH5:	PUSHJ	PP,GETSRC	;GET NEXT CHARACTER
	CAIE	CH,$LF		;END OF LINE?
	CAIN	CH,$FF
	JRST	FINLIN		;YES

GETCH6:	MOVE	TE,INPTCP	;[354] SAVE SOURCE COLUMN
	MOVEM	TE,SRCCOL	; [354]
	CAIN	CH,$HT		;IS IT A TAB?
	JRST	GTCH10		;YES

;CHARACTER OK--LEAVE
GETCH9:	MOVE	LN,SAVELN	;GET CURRENT LINE
	POPJ	PP,		;LEAVE

;END OF SOURCE LINE--TOO MANY CHARACTERS
GETCH1:	MOVE	LN,SAVELN
	MOVEI	DW,E.82
	TSWT	FNOCPY		;NO ERROR IF NOT LISTING
	PUSHJ	PP,FATAL
	MOVE	CP,SAVECP

GETCH2:	PUSHJ	PP,GETSRC	;GET NEXT ONE
	CAIE	CH,$LF		;END OF LINE?
	CAIN	CH,$FF
	JRST	FINLIN		;YES
	JRST	GETCH2		;NO--LOOP

;SEQUENCED INPUT
GETCH3:	CAIGE	CH,^D73		;NO--COLUMN 72 BEEN PASSED YET?
	JRST	GETCH5		;NO

GETCH7:	CAIE	CP,^D81		;Yes, but are we outside the comment area?
	JRST	GETCH8		;Not for the first time
	MOVEI	DW,E.82
	TSWT	FNOCPY		;Yes, but no error if not listing
	PUSHJ	PP,FATAL
GETCH8:	PUSHJ	PP,GETSRC	;IGNORE REST OF LINE
	CAIE	CH,$LF
	CAIN	CH,$FF
	JRST	FINLIN
	JRST	GETCH7
;INPUT CHARACTER WAS TAB--BUMP INPTCP

GTCH10:	MOVE	CH,INPTCP
	ADDI	CH,1		;IT ALWAYS POINTS AT PREVIOUS CHARACTER
	IORI	CH,7
	SUBI	CH,1
	MOVEM	CH,INPTCP
	MOVEI	CH,$HT
	JRST	GETCH9


;END OF SOURCE LINE--PRINTER CONTROL HAS BEEN SEEN

FINLIN:	TSWT	FNOCPY		;IGNORE EOL IF NOT COPYING TO CPYFIL
	MOVEM	CH,EOLKAR
	PUSHJ	PP,PUTCIF

	TSWT	FRLIB		;READING LIBRARY?
	TSWT	FEOF		;NO--END OF INPUT?
	JRST	GETSEQ		;NO--START NEW LINE

;END OF SOURCE

	MOVEI	CH," "		;RETURN A SPACE
	MOVEI	CP,7		;	FOR COLUMN 7
	AOS	SAVELN		;KICK UP LINE COUNT
	JRST	GETCH9		;LEAVE
;PARAGRAPH HAS BEEN DELETED AND FIRST CHARACTER OF NEXT PARAGRAPH NAME SEEN.
;PUT OUT THAT FIRST CHARACTER.

FINSKP:	SWOFF	FNOCPY;
	MOVEI	CH,$LF
	PUSHJ	PP,PUTCPY
	TSWF	FEOF;
	POPJ	PP,

FINSK3:	MOVEI	CH,1(CP)
	CAML	CH,INPTCP
	JRST	FINSK4
	MOVEI	CH," "
	PUSHJ	PP,PUTCPY
	JRST	FINSK3

FINSK4:	SWON	FREGCH;		;TURN ON "REGET CHARACTER"
IFN DBMS,<
	SKIPE	FINVOK
	JRST	FINSK5		;DBMS
>
	LDB	CH,SRCBH+1	;PUT OUT LAST CHARACTER
	JRST	PUTCPY		;   AND RETURN

IFN DBMS,<
FINSK5:	LDB	CH,DBBUFH+1	;PUT OUT LAST CHARACTER
	JRST	PUTCPY		;   AND RETURN
>
;GET THE VERY FIRST CHARACTER FROM THE SOURCE FILE

GETFCH:	SETZM	SAVELN		;SET LINE COUNT TO ZERO
	SETOM	NOCONT
	MOVEI	CH,$FF
	PUSHJ	PP,PUTFEL
	SETZM	EOLKAR
	SETZM	SEQIN

;START A NEW SOURCE LINE

GETSEQ:	SETZM	SAVECP		;STARTING AT COLUMN 1
	TSWF	FSEQ		;SEQUENCED INPUT?
	JRST	GETSQ7		;YES

	PUSHJ	PP,GETSRC	;GET A CHARACTER
	CAIN	CH,$LF		;[526] END OF
	JRST	GETSQ4		;YES
	CAIN	CH,$FF		;[526] FORM FEED ON FIRST CHAR SPECIAL
	JRST	GTSQ6B		;[526] IGNORE SO CONTINUATION WORKS

IFN DBMS,<
	SKIPE	FINVOK
	SKIPA	TD,@DBBUFH+1
>
	MOVE	TD,@SRCBH+1	;NO--IS IT
	TSWF	FRLIB		;READING FROM LIBRARY?
	MOVE	TD,@LIBBH+1	;YES
	TRNN	TD,1		;  A SEQUENCE NUMBER?
	JRST	GETSQ9		;NO
	CAMN	TD,[<ASCII/     />+1]	;[526] IS THIS AN EDITS PAGE MARK
	JRST	GETSQ6		;[526] YES HANDLE SEPARATELY
	MOVEI	TD,6		;[526] NO REGULAR SEQUENCE NUMBER
	JRST	GETSQ8

GETSQ2:	CAIE	CH,"-"		;CONTINUATION?
	JRST	GETSQ3		;NO
	SKIPE	NOIDHY##		;ARE THEY ALLOWED HERE
	JRST	[MOVEI	DW,E.700	;NOT IN ID, GIVE ERROR
		PUSHJ	PP,FATAL
		MOVEI	CH,"-"		;PUT HYPHEN BACK
		JRST	GETSQ5]		;AND CONTINUE
	SKIPN	NOCONT		;YES--ARE THEY LEGAL?
	JRST	GETSQ5		;YES

	MOVE	LN,SAVELN	;NO--
	MOVEI	DW,E.279	;  PUT OUT
	PUSHJ	PP,FATAL	;  DIAG
	MOVEI	CH," "		;REPLACE WITH SPACE

GETSQ3:	CAIE	CH," "		;SPACE OR
	CAIN	CH,$HT		;  TAB?
	JRST	GETSQ5		;YES
	CAIN	CH,"*"		;NO--COMMENT?
	JRST	GTSQ10		;YES
	CAIN	CH,"/"		;SLASH
	JRST	GTSQ13		;YES
	TSWF	FSEQ		;SEQUENCED INPUT?
	JRST	GTSQ3A		;YES
	CAIE	CH,"\"		;LOOK FOR \D
	JRST	GETSQ4		;NOT
	PUSHJ	PP,GETSRC	;GET NEXT CHARACTER
GTSQ3A:	CAIE	CH,"D"		;DEBUG
	CAIN	CH,"d"
	JRST	GTSQ14		;YES

GETSQ4:	MOVE	CH,RPLFLG	;GET DEFERED FLAGS ALSO
	TSWT	FEOF!FECOPY	;END OF FILE OR END OF COPY?
	TLNE	CH,(FECOPY)	;REALLY FINISHED WITH LIBRARY ITSELF?
	CAIA			;YES, DON'T REGET LAST CHAR.
	SWON	FREGCH		;NO--REGET LATER
GTSQ4A:	MOVEI	CH," "		;REPLACE WITH SPACE

GETSQ5:	MOVEI	CP,7		;RESET CP AND
	MOVEM	CP,INPTCP	;  INPUT COLUMN NUMBER
	TSWTZ	FNCOFF		;WAS FNOCPY TURNED OFF AT FINLIN?
	JRST	GETCH6		;NO
	SWON	FNOCPY		;YES, TURN IT BACK ON NOW
	SWON	FNEEDS		;ALSO REQUEST A DUMMY PERIOD
	JRST	GETCH6		;LEAVE

;	[526]COME HERE TO HANDLE EDITS PAGE MARKS
GETSQ6:	MOVEI	TD,7		;[526] 5 BLANKS CR FF (GETSRC GOBBLES NULS)

GTSQ6A:	PUSHJ	PP,GETSRC	;[526] GET THE NEXT CHARACTER
	CAIE	CH,$FF		;[526] DID WE GET THE FORM FEED YET?
	SOJG	TD,GTSQ6A	;[526] NO  LOOP BACK FOR MORE
GTSQ6B:	PUSHJ	PP,PUTCPY	;[526] PUT OUT THE FORM FEED
	JRST	GETSEQ		;[526] GO BACK FOR NEXT LINE
;START A NEW SOURCE LINE (CONT'D)

;SEQUENCED INPUT -- COPY COLUMNS 1-6, GET COLUMN 7

GETSQ7:	MOVEI	TD,7

GETSQ8:	SETOM	SEQIN

GTSQ8A:	PUSHJ	PP,GETSRC
	CAIE	CH,$LF
	CAIN	CH,$FF
	JRST	GETSQ4
	SOJG	TD,GTSQ8A
	JRST	GETSQ2

;PUT OUT 6 SPACES IN PLACE OF SEQUENCE NUMBER

GETSQ9:	TSWF	FNOCPY		;IGNORE IF NOT OUTPUTING TO CPYFIL
	JRST	GETSQ2

	MOVE	TE,CH		;SAVE CH
	MOVEI	CH," "		;REPLACE THAT SOURCE CHARACTER
	DPB	CH,CPYBHO+1	;  WITH SPACE
	MOVEI	TD,5
	PUSHJ	PP,PUTCPY
	SOJG	TD,.-1

	MOVE	CH,TE		;RESTORE CH
	PUSHJ	PP,PUTCPY
	JRST	GETSQ2

;"/" IN COLUMN 7

GTSQ13:	LDB	CH,$LFPTR	;SEE IF LINE TERMINATOR WAS FF
	CAIE	CH,$FF		; IF SO LEAVE IT ALONE
	MOVEI	CH,$VT		;OTHERWISE REPLACE LF BY VT TO SIGNAL "/" IN COL 7.
	DPB	CH,$LFPTR	;IN BUFFER
	MOVEI	CH,"/"		;PUT SLASH BACK
	JRST	GTSQ10		;AND MAKE A COMMENT
;HERE WITH D IN COLUMN 7

GTSQ14:	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	PUSHJ	PP,FLG.LI	;YES, TEST AT LOW-INTERMEDIATE LEVEL
GTSQ15:	SKIPN	DEBSW		;DEBUG ON?
	TSWF	FRTST		;NO, BUT ARE WE JUST DOING REPLACEMENT CHECK?
	JRST	GTSQ4A		;YES, COMPILE THIS LINE
				;NO, JUST MAKE A COMMENT

;"*" IN COLUMN 7

GTSQ10:	SETOM	NOCONT
GTSQ11:	PUSHJ	PP,GETSRC
	CAIE	CH,$LF
	CAIN	CH,$FF
	JRST	GETSQ4
	JRST	GTSQ11
;GET A CHARACTER FROM THE SOURCE FILE BUFFER

GETSRC:	TSWF	FECOPY;
	JRST	GTBLNK

	TSWF	FRLIB		;DO WE READ LIBFIL?
	JRST	GETLIB

	TSWF	FEOF;		;END OF FILE?
	JRST	GTBLNK		;YES

IFE TOPS20,<
	SKIPN	SRCDEV		;[352] ANY MORE IN SOURCE FILES?
	JRST	GTSR3A		;[352] NO MORE SOURCE ANYWHERE
>

IFN DBMS,<
	SKIPE	FINVOK		;ARE WE IN INVOKE?
	JRST	IN.GET
	>

	TSWFZ	FREGCH;		;REGET PREVIOUS CHARACTER?
	JRST	REGETS		;YES

	SOSG	SRCBH+2
	JRST	GETSR3

GETSR0:	ILDB	CH,SRCBH+1
GETSL:	CAIGE	CH,40		;CONTROL CHARACTER?
	JRST	GETSR2		;YES
	CAIL	CH,140		;NO--SIXBIT CHARACTER?
	JRST	GETSR1
	JRST	PUTCIF

;REGET PREVIOUS CHARACTER

REGETS:	LDB	CH,SRCBH+1
	POPJ	PP,
;SPECIAL CHARACTER PROCESSING

;CHARACTERS ABOVE CODE 137
;[1036] RUBOUT GETS CONVERTED TO SPACE, ALL OTHERS GET PRINTED

GETSR1:	CAIE	CH,177		;[1036] SKIP IF RUBOUT
	JRST	PUTCIF		;[1036] NO, JUST PUT IN CPY FILE AS IS

GTSR1B:	PUSH	PP,CH		;SAVE CHARACTER
	MOVEI	CH," "		;PUT SPACE IN CPYFIL
GTSR1D:	PUSHJ	PP,PUTCIF
	POP	PP,CH		;RESTORE CHARACTER
	POPJ	PP,		;RETURN


IFN DBMS,<
IN.GET:	TSWFZ	FREGCH		;REGET CHARACTER?
	JRST	DB.GET		;YES
IN.GT2:	SOSGE	DBBUFH+2	;MORE CHARACTERS?
	JRST	IN.INP		;NO, GET ANOTHER BUFFER
	ILDB	CH,DBBUFH+1	;GET CHARACTER
	JRST	GETSL		;RETURN AS NORMAL
IN.INP:
IFE TOPS20,<
	IN	DBCHAN,
	  JRST	IN.GT2		;INPUT OK
	GETSTS	DBCHAN,CH	;INPUT ERROR
	TRNN	CH,IO.ERR	;ERRORS?
	JRST	IN.EOF		;NO, END-OF-FILE
	MOVEI	CH,DBDEV	;YES, SET UP FOR ABORT
	MOVSI	TA,'DSK'
	MOVEM	TA,DBDEV
	JRST	DEVDED
>
IFN TOPS20,<
	PUSHJ	PP,GETDBS##	;GET NEXT BUFFER
	  JRST	IN.EOF		;EOF
	JRST	IN.GT2		;OK
>
IN.EOF:	SETZM	FINVOK		;CLEAR INVOKE FLAG
IFE TOPS20,<
	SETZM	DBBLCK		;[316]
	RENAME	DBCHAN,DBBLCK	;[316]
	CLOSE	DBCHAN,		;NOT REALLY NECESSARY
	RELEASE	DBCHAN,
>
IFN TOPS20,<
	PUSHJ	PP,CLZDBS##	;CLOSE DBMS INVOKE FILE
>
	MOVEI	CH,$LF		;RETURN LINE-FEED
	SKIPE	DBONLY		;[453] WAS /S ON BEFORE?
	SWON	FSEQ		;[453] YES--TURN IT BACK ON
	SETZM	DBONLY		;[453] AND TURN THIS OFF
	POPJ	PP,		;RETURN LIKE NOTHING HAPPENED!!

DB.GET:	LDB	CH,DBBUFH+1
	POPJ	PP,

>
;SPECIAL CHARACTER PROCESSING  (CONT'D)

;CHARACTERS BELOW CODE 040

GETSR2:	JUMPE	CH,GETSRC	;IGNORE NULLS
	CAIE	CH,$CR		;	AND CARRIAGE-RETURNS
	CAIN	CH,$CZ		;	AND END-FILES
	JRST	GETSRC

	CAIE	CH,$HT		;TAB?
	JRST	GTSR2B		;NO

	MOVEI	CH," "		;YES--REPLACE WITH SPACE
	PUSHJ	PP,GTSR2D
	MOVEI	CH,$HT

	JRST	PUTCIF

GTSR2B:	CAIE	CH,$LF		;LINE-FEED?
	CAIN	CH,$FF		;NO--FORM-FEED?
	POPJ	PP,		;YES--RETURN

	CAIG	CH,$DC4		;NO--OTHER PRINTER CONTROL?
	CAIGE	CH,$DLE
	CAIN	CH,$VT
	JRST	GTSR2C
	PUSH	PP,CH		;YES
	MOVEI	CH,"^"
	PUSHJ	PP,PUTCIF
	MOVE	CH,(PP)
	ADDI	CH,100
	JRST	GTSR1D

GTSR2C:	MOVEI	CH,$LF		;YES--FORCE LINE-FEED
GTSR2D:	TSWF	FRLIB;
	POPJ	PP,		;[557] IF FROM LIBRARY DON'T DO ANYTHING SPECIAL
IFN DBMS,<
	SKIPN	FINVOK
	JRST	GTSR2F
	DPB	CH,DBBUFH+1
	POPJ	PP,
GTSR2F:>
	DPB	CH,SRCBH+1	;RESTORE FOR POSSIBLE REGET
	POPJ	PP,		;RETURN
;NEW BUFFER REQUIRED

GETSR3:	SKIPL	RPLBH+0		;NEED TO SAVE CURRENT BUFFER?
	JRST	GTSR3X		;NO
	PUSH	PP,TA
	PUSH	PP,TB		;SAVE ACCS
	PUSH	PP,TC
	PUSH	PP,TD		;DEFINITELY NEEDS TO BE SAVED
	PUSH	PP,TE
	MOVE	TA,RPLNXT	;GET REL LOC OF COUNT
	ADD	TA,CPYLOC	;FIX
	MOVE	TB,RPLBH+2	;GET CHAR. COUNT
	ADDM	TB,(TA)		;ADD TO WHATS ALREADY THERE
	HRRZ	TA,SRCBH+1
	HRRZ	TB,RPLBH+1
	SUBI	TA,-1(TB)	;GET SIZE IN WORDS
	PUSH	PP,TA
	HRLI	TA,CD.CPY
	PUSHJ	PP,GETENT
	HRL	TA,RPLBH+1	;FORM BLT PTR
	POP	PP,TB
	ADDI	TB,(TA)		;END OF BLT
	BLT	TA,-1(TB)	;COPY ALL WE NEED
	POP	PP,TE
	POP	PP,TD
	POP	PP,TC
	POP	PP,TB
	POP	PP,TA
GTSR3X:
IFN TOPS20,<
	AOS	SRCBFC		;ADD ONE TO BUFFER COUNT
	PUSHJ	PP,GETSRB##	;GET ANOTHER BUFFER
	  JRST	GTSR3A		;NO MORE SOURCE
	SKIPL	RPLBH+0
	JRST	GETSR0
	MOVE	CH,SRCBH+1
	MOVEM	CH,RPLBH+1
	MOVE	CH,SRCBH+2
	MOVEM	CH,RPLBH+2
	JRST	GETSR0
>
IFE TOPS20,<
	SKIPN	SRCDEV		;[352] ANY MORE SOURCE FILE CHARS??
	JRST	GTSR3A		;[352] NO CLOSE EVERYTHING OUT, WE ARE DONE.
	AOS	SRCBFC		;INCREMENT BUFFER COUNT
	IN	SRC,		;FILL BUFFER
	  JRST	[SKIPL	RPLBH+0
		JRST	GETSR0
		MOVE	CH,SRCBH+1
		ADD	CH,[440000,,1]	;ADVANCE TO NEXT WORD
		MOVEM	CH,RPLBH+1
		MOVE	CH,SRCBH+2
		MOVEM	CH,RPLBH+2
		JRST	GETSR0]
	GETSTS	SRC,CH		;ERROR--SEE IF END-FILE
	TRNE	CH,IO.ERR
	JRST	GETSR4		;NO

	RELEASE	SRC,		;RELEASE THIS DEVICE

	PUSH	PP,I1		;[1122] 
	PUSHJ	PP,STINFL	;SET UP NEXT SOURCE FILE
	POP	PP,I1		;[1122]
	SKIPE	SRCDEV		;WAS THERE ANY?
	JRST	GETSR3		;YES

;NO MORE SOURCE

	SKIPE	LIBDEV		;[352] ANY LIBRARY DEVICE?
	JRST	[SWOFF	FCOPY		;[352] YES TURN OFF COPY
		JRST	GTSR3B]		;[352] RETURN LF TO KEEP LIB DEVICE OPEN.
>

GTSR3A:	SWON	FEOF;		;SET "END-FILE" SWITCH
IFE TOPS20,<
	RELEASE	LIB,
	SKIPE	CREFSW
	CLOSE	CRF,
>
IFN TOPS20,<
	PUSHJ	PP,CLZLIB	;CLOSE ANY LIBRARY FILE
	SKIPN	CREFSW		;IF /CREF
	JRST	GTSR3B
	PUSHJ	PP,RITCRF	;OUTPUT PARTIAL BUFFER
	PUSHJ	PP,CLSCRF	;AND CLOSE FILE
>

GTSR3B:	MOVEI	CH,7		;[352]
	MOVEM	CH,SRCCOL

GTBLNK:	MOVEI	CH,$LF		;RETURN A LINE-FEED
	POPJ	PP,

IFE TOPS20,<
;ERROR ON SOURCE DEVICE

GETSR4:	MOVEI	CH,SRCDEV
	JRST	DEVDED
>
;SYNTAX SCANNER HAS DETECTED AN ERROR AND IS SKIPPING PAST DATA.
;GET NEXT SOURCE CHARACTER.

SKPSRC:	TSWFZ	FGTPER;
	JRST	SKPSR6
	TSWFZ	FGTMIN;
	JRST	SKPSR8

	TSWF	FCOPY		;ARE WE COPYING?
	JRST	SKPSR3		;YES

	TSWF	FECOPY		;HAS COPY JUST FINISHED?
	JRST	SKPSR5		;YES, CLEAN UP

	PUSHJ	PP,GETCH	;NO--GET A CHARACTER

SKPSR1:	CAIN	CH,$HT		;CHANGE TAB TO SPACE
	MOVEI	CH," "
	CAIN	CH," "
	SWOFF	FNEEDS;

SKPSR2:	TSWF	FNOCPY;
	MOVE	CP,SRCCOL
	POPJ	PP,

SKPSR3:	MOVE	CH,INPTCP
	TSWF	FREGCH;
	SUBI	CH,1
	CAMLE	CH,SAVECP
	JRST	SKPSR9

	TSWFZ	FECOPY		;SHOULD WE CLEAN UP LIBRARY?
	JRST	SKPSR5		;YES

	SKIPE	CH,EOLKAR	;NO--ANY LINE TO TERMINATE?
	PUSHJ	PP,PUTCPY	;YES--DO SO

	PUSHJ	PP,GETCH	;GET A CHARACTER

	TSWFZ	FECOPY		;DONE WITH LIBRARY NOW?
	JRST	SKPSR5		;YES
	SKIPN	EOLKAR
;[1576]	JRST	SKPSR4
	JRST	SKPSR1		;[1576] character has already been output

	PUSH	PP,CH
	MOVE	CH,EOLKAR
	PUSHJ	PP,PUTCPY
	POP	PP,CH

SKPSR4:	PUSHJ	PP,PUTCPY
	JRST	SKPSR1

SKPSR5:	PUSHJ	PP,ENDCPY
	JRST	SKPSRC

SKPSR6:	MOVEI	CH,"."
	JRST	SKPSR2

SKPSR8:	MOVEI	CH,"-"
	TSWF	FCOPY;
	PUSHJ	PP,PUTCPY
	JRST	SKPSR2

SKPSR9:	MOVEI	CH," "
	PUSHJ	PP,PUTCPY
	JRST	SKPSR3
SUBTTL	COPY VERB


COMMENT	\
	THE NEW FORMAT OF THE CPYTAB IS AS FOLLOWS:
	0				;ALWAYS 0
	NEXT REPLACEMENT	,, LENGTH OF THIS REPLACEMENT
	TYPE (LHS W1)		,, FLAG + SIZE IN WORDS
	TEXT SIXBIT FOR NAMES, ASCII FOR LITERALS
	...
	BYTE POINTER (LHS)	,, CHARACTER COUNT
	BYTE (9) SAVECP(BEFORE), INPTCP(BEFORE), SAVECP(AFTER), INPTCP(AFTER)
	REPLACEMENT TEXT IN ASCII
	...
	NEXT BLOCK
\

	CONTF==1B18		;REPLACEMENT TEST IS CONTINUED
				;EITHER QUALIFIED OR PSEUDO-TEXT
CPYLIB:	SWOFF	FRTST		;MAKE SURE ITS OFF
	SETZM	CURCPY		;RESET CPYTAB POINTERS
	SETZM	RPLCNT		;CLEAR READ COUNT
	SETZM	RPLLOC		;CLEAR POINTER TO PSEUDO-TEST
	SETZM	RPLNXT		;AND CURRENT POINTER
	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	PUSHJ	PP,FLG.LI	;YES, TEST AT LOW-INTERMEDIATE LEVEL
	MOVE	TA,CPYLOC
	MOVEM	TA,CPYNXT
	MOVEM	W2,CPYW2	;SAVE POSITION OF 'COPY' IN SOURCE
	PUSHJ	PP,GETITM	;GET LIBRARY-NAME
	TLNE	W1,GWLIT	;LITERAL?
	JRST	CPE285		;YES, ERROR
	CAIN	TYPE,PRIOD.	;ANY MODULE NAME GIVEN?
	JRST	CPE852		;NO, ERROR
	MOVE	TA,NAMWRD	;STORE 1ST 6 CHARS OF NAME
	MOVEM	TA,LIBNAM
	HLRZ	TA,NAMWRD+1	;STORE 7TH & 8TH CHARS
	ANDI	TA,777700
	HRLZM	TA,LIBNAM+1
	MOVE	TA,NAMWRD+1	;GET SECOND WORD AGAIN
	TLZ	TA,777700	;AND CHECK FOR MORE THAN 8 CHARS.
	JUMPE	TA,CPLB0	;ITS OK, 8 OR LESS
	EWARNW	E.649		;TOO MANY, WARN USER
CPLB0:	PUSHJ	PP,GETITM	;GET NEXT ITEM OF SOURCE
	CAIN	TYPE,PRIOD.	;PERIOD?
	JRST	CPLB99		;ENDED WITH PERIOD --- SET UP COPY & GO TO IT
	CAIE	TYPE,IN.	;NO, IS IT IN OR OF?
	JRST	CPLB1		;NO
	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	PUSHJ	PP,FLG.H	;YES, TEST AT HIGH LEVEL
	PUSHJ	PP,GETITM	;GET LIBRARY FILE NAME
	TLNN	W1,GWLIT	;LITERAL?
	JRST	CPLB55		;NO
	LDB	TA,GWVAL	;GET LITERAL SIZE
	MOVE	TB,[POINT 7,LITVAL]
IFE TOPS20,<
	MOVE	TC,[POINT 6,NAMWRD]
>
IFN TOPS20,<
	MOVE	TC,[POINT 7,LIBSPC]
>
CPLB51:	ILDB	TD,TB
IFE TOPS20,<
	CAIN	TD,":"		;TEST FOR DEVICE
	JRST	CPLB58		;FOUND ONE
	CAIN	TD,"."		;TEST FOR EXTENSION
	JRST	CPLB59		;FOUND ONE TO FOLLOW
>
	CAIN	TD,"["		;[PPN]?
	JRST	CPLB53		;YES
IFE TOPS20,<
	CAIL	TD,141		;IS IT LOWER CASE?
	CAILE	TD,172		;...
	JRST	.+2		;NO
	TRZA	TD,100		;CONVERT LOWER CASE TO SIXBIT
	SUBI	TD,40		;CONVERT UPPER CASE TO SIXBIT
	IDPB	TD,TC
>
IFN TOPS20,<
	IDPB	TD,TC		;PUT IN LIBSPC
>; END TOPS20
CPLB52:	SOJG	TA,CPLB51	;PUT LITERAL IN NAMWRD
IFN TOPS20,<
	SETZ	TD,		;GET A NULL
	IDPB	TD,TC		;PUT IT AFTER FILE SPEC
	JRST	CPLB56
>

;Here when library-name is not a literal.
;For TOPS-10 keep as sixbit name and extension.
;For TOPS-20 convert to Ascii name.ext

CPLB55:	HRRZ	TB,NAMWRD+1	;TEST FOR TOO MANY CHARACTERS
	SKIPE	TB
	EWARNW	E.650		;TOO MANY, WARN USER
IFN TOPS20,<
	HLLZ	TB,NAMWRD+1	;GET EXTENSION
	JUMPN	TB,CPLLIB	;IF NONE,
	MOVSI	TB,'LIB'	; DEFAULT TO .LIB
	MOVEM	TB,NAMWRD+1	;
CPLLIB:	MOVEI	TA,^D9		;SIZE OF NAME+EXT
	MOVE	TB,[POINT 6,NAMWRD]
	MOVE	TC,[POINT 7,LIBSPC##]
CPLB54:	ILDB	TD,TB
	ADDI	TD," "		;ASCII
	IDPB	TD,TC
	CAIN	TA,4		;END OF NAME?
	JRST	[MOVEI	TD,"."
		IDPB	TD,TC
		JRST	.+1]
	SOJG	TA,CPLB54
>
IFE TOPS20,<
	MOVE	TA,NAMWRD	;GET FILE NAME
	HLLZ	TB,NAMWRD+1	;AND EXTENSION
	SKIPN	TB
	MOVSI	TB,'LIB'	;IF NULL USE DEFAULT
	CAME	TA,LIBHDR	;NAME MATCH WHAT WE CURRENTLY HAVE?
	JRST	CPLB56		;NO
	CAMN	TB,LIBHDR+1	;AND EXTENSION
	JRST	CPLB0		;YES, GET NEXT ITEM
	HLRZ	TC,LIBHDR+1
	CAMN	TB,[SIXBIT /LIB/]
	JUMPE	TC,CPLB0	;'LIB' CAN MATCH NULL
CPLB56:	MOVEM	TA,LIBHDR	;STORE NEW FILE NAME
	MOVEM	TB,LIBHDR+1	;AND EXTENSION
	MOVEI	TC,IOSRCS	;GET START OF LIST
CPLB57:	HLLZ	TD,DEVEXT(TC)	;[1310] GET FILE EXTENSION BY ITSELF
	SKIPN	TD		;[1310] NULL EXTENSION?
	MOVSI	TD,'LIB'	;[1310] YES, ALLOW 'LIB' TO MATCH
	CAMN	TA,DEVFIL(TC)	;SEE IF FILE NAME MATCH
	CAME	TB,TD		;[1310] AND EXTENSION
	JRST	CPLB77		;NO
	MOVE	TD,DEVSW(TC)	;GET SWITCHES
	SOJN	TD,CPLB77	;JUMP IF NOT LIBRARY
	MOVE	TC,DEVDEV(TC)	;GET DEVICE
	JRST	CPLB88		;NOW OPEN IT
>
IFN TOPS20,<
;Test to see if new library is same as one we already have open.
CPLB56:	SKIPG	LIBJFN		;DO WE HAVE A LIBRARY JFN?
	JRST	CPLB77		;NO, SO IT CANNOT MATCH
	MOVE	TA,[POINT 7,LIBSPC]
	MOVE	TB,[POINT 7,LIBOSP##]	;OLD SPEC
CPLB59:	ILDB	TC,TA
	ILDB	TD,TB
	CAME	TD,TC
	JRST	CPLB60		;NO MATCH
	SKIPE	TC
	JUMPN	TD,CPLB59	;NOT FOUND TERMINAL NULL YET
	JRST	CPLB0		;EXACT MATCH
CPLB60:	JRST	CPLB77		;NOW OPEN NEW LIBRARY
>

IFE TOPS20,<
CPLB58:	MOVE	TC,NAMWRD	;GET DEVICE NAME
	MOVEM	TC,NAMWRD+2	;STORE IN SAFE PLACE
	SETZM	NAMWRD		;CLEAR OUT DEVICE
	SETZM	LIBPP##		;AND [PPN]
	SKIPA	TC,[POINT 6,NAMWRD]
CPLB59:	MOVE	TC,[POINT 6,NAMWRD+1]
	JRST	CPLB52		;CONTINUE WITH THE SCAN
>;END IFE TOPS20 [1525]

CPLB53:	SOJLE	TA,CPLB5X	;ERROR
	PUSHJ	PP,CPLBPP	;GET LHS
	SKIPN	TC
	HLRZ	TC,MYPPN##	;GET DEFAULT
	HRLZM	TC,LIBPP##	;[1525]
	CAIE	TD,","		;MUST BE COMMA
	JRST	CPLB5X		;ERROR
	PUSHJ	PP,CPLBPP	;GET RHS
	SKIPN	TC
	HRRZ	TC,MYPPN
	HRRM	TC,LIBPP
IFN TOPS20,<
	CAIE	TD,"]"		;[1525]
	JRST	CPLB5X		;[1525] NO SFD'S ON TOPS 20
	LDB	TE,GWVAL	;[1525] GET SIZE OF LITERAL
	MOVE	TB,[POINT 7,LITVAL]	;[1525] GET STR:
	MOVE	TC,[POINT 7,LIBSPC]	;[1525] REDEPOSIT
CPLBP2:	ILDB	TD,TB		;[1525]
	CAIN	TD,":"		;[1525]
	JRST	CPLBP3		;[1525]
	IDPB	TD,TC		;[1525]
	SOJG	TE,CPLBP2	;[1525]
	JRST	CPLB5X		;[1525] FOUND [P,PN], BUT NO STRUCTURE
CPLBP3:	PUSH	PP,T1		;[1525]
	PUSH	PP,T2		;[1525]
	PUSH	PP,T3		;[1525]
	MOVE	T1,[POINT 7,LIBSPC]	;[1525] OVERWRITE
	MOVE	T2,LIBPP##	;[1525]
	MOVE	T3,T1		;[1525]
	PPNST%			;[1525]
	 ERJMP	CPE607		;[1525] NOT A VALID [P,PN]

CPLBP4:	MOVE	TC,T1		;[1525] POINTS TO NEXT POSIT IN LIBSPC
	POP	PP,T3		;[1525] RESTORE THE AC'S
	POP	PP,T2		;[1525]
	POP	PP,T1		;[1525]
	
CPLBP5:	ILDB	TD,TB		;[1525] CONTINUING PICKING UP CHAR UNTIL "["
	CAIN	TD,"["		;[1525]
	JRST	CPLBP6		;[1525] HIT [,], FINISHED FILE NAME
	IDPB	TD,TC		;[1525]
	SOJG	TE,CPLBP5	;[1525]
	JRST	CPE285		;[1525]RESCANNED WHOLE LITERAL, NEVER FOUND "["
CPLBP6:	SETZ	TA,		;[1525]
	JRST	CPLB52		;[1525] NOW GO FIND THE FILE

>; END IFN TOPS20

IFE TOPS20,<
	CAIN	TD,"]"		;DID IT END CORRECTLY?
	JRST	CPLB55		;YES
	CAIE	TD,","		;SFD?
	JRST	CPLB5X		;NO
	MOVE	TD,[LIBPTH+.PTSFD,,LIBPTH+.PTSFD+1]
	SETZM	LIBPTH+.PTSFD
	BLT	TD,LIBPTH+.PTSFD+6	;CLEAN IT OUT
	MOVEI	TD,LIBPTH##	;SETUP SFD BLOCK POINTER
	EXCH	TD,LIBPP
	MOVEM	TD,LIBPTH+.PTPPN
	MOVE	TC,[POINT 6,LIBPTH+.PTSFD]
CPLBP2:	SOJL	TA,CPLB5X
	ILDB	TD,TB
	CAIN	TD,","		;END OF THIS FIELD?
	JRST	CPLBP3		;YES
	CAIN	TD,"]"		;END OF SFD?
	JRST	CPLB55		;YES
	CAIL	TD,141		;IS IT LOWER CASE?
	CAILE	TD,172		;...
	JRST	.+2		;NO
	TRZA	TD,100		;CONVERT LOWER CASE TO SIXBIT
	SUBI	TD,40		;CONVERT UPPER CASE TO SIXBIT
	IDPB	TD,TC
	JRST	CPLBP2

CPLBP3:	HRLI	TC,(POINT 6,)	;START AGAIN
	AOJA	TC,CPLBP2	;ON NEXT WORD
>

CPLB5X:
IFE TOPS20,<
	OUTSTR	[ASCIZ /%Illegal file specification for /]	;[1525]
	PUSHJ	PP,STLB30
	OUTSTR	[ASCIZ / - continuing
/]
>
IFN TOPS20,<
	PUSH	PP,T1
	HRROI	T1,[ASCIZ /%Illegal file specification for /]	;[1525]
	PSOUT%
	PUSHJ	PP,STLB30
	HRROI	T1,[ASCIZ / - continuing
/]
	PSOUT%
	POP	PP,T1
>
	JRST	CPLB55		;AND CONTINUE

CPLBPP:	SETZ	TC,
CPLBP1:	SOJL	TA,CPLB5X	;ERROR IF WE RUN OUT OF DIGITS
	ILDB	TD,TB
	CAIL	TD,"0"		;TEST FOR DIGIT (RADIX 8)
	CAILE	TD,"7"
	POPJ	PP,		;NO, RETURN
	LSH	TC,3
	IORI	TC,-"0"(TD)	;BUILT NUMBER
	JRST	CPLBP1
IFE TOPS20,<
CPLB77:	ADDI	TC,DEVSIZ	;INCREMENT TO NEXT
	CAIGE	TC,SRCEND	;ALL DONE?
	JRST	CPLB57		;NOT YET
	SKIPN	TC,NAMWRD+2	;DID USER SUPPLY A DEVICE?
	MOVSI	TC,'DSK'	;NO, ASSUME DSK
CPLB88:	MOVEM	TC,LIBDEV	;SET IT UP
	MOVEM	TC,LIBDV##	;SAVE FOR ERROR MESSAGE
	CLOSE	LIB,		;INCASE ITS OPEN
	MOVSI	TA,(1B0)	;VIRGIN RING BIT
	IORM	TA,LIBBH	;WHAT WE WANT IT TO BE
	PUSH	PP,LIBBH	;SAVE BUFFER HEADER
	MOVEI	TA,700
	HRLZM	TA,LIBBH+1	;SETUP NO POINTER
	PUSH	PP,DA
	PUSH	PP,DC
	PUSH	PP,I0
	PUSH	PP,I1
	PUSH	PP,I2
	PUSH	PP,I3
	PUSH	PP,I4
	MOVEI	DA,LIBDEV
	SETZ	I1,
	MOVEI	I3,DEVBH(DA)
	MOVEI	DC,LIB
	PUSHJ	PP,OPENIT
	LOOKUP	LIB,I1
	  SETZM	LIBDEV		;FAILED
	POP	PP,I4
	POP	PP,I3
	POP	PP,I2
	POP	PP,I1
	POP	PP,I0
	POP	PP,DC
	POP	PP,DA
	POP	PP,LIBBH
>
IFN TOPS20,<
CPLB77:	PUSHJ	PP,OPNLIB##	;GET NEW LIBRARY
>
	JRST	CPLB0		;SEE WHATS NEXT
CPLB1:	CAIE	TYPE,REPLA.	;IS IT 'REPLACING'?
	JRST	CPE286		;NO, ERROR
	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	PUSHJ	PP,FLG.H	;YES, TEST AT HIGH LEVEL
CPLB2:	AOS	RPLCNT		;COUNT ONE MORE
	MOVE	TA,[CD.CPY,,1]	;GET 1 WORD FOR HEADER
	PUSHJ	PP,GETENT
	SKIPN	TB,RPLLOC	;FIRST TIME
	JRST	.+3
	ADD	TB,CPYLOC	;GET ADDRESS
	HLRM	TA,(TB)		;LINK IN
	HLRZM	TA,RPLLOC	;ADVANCE POINTER
	PUSHJ	PP,GETITM	;GET ITEM AFTER 'REPLACING'
	CAIE	TYPE,EQUAL.	;[1406] IS ITEM AN '='?
	CAIN	TYPE,EQUAL.+AMRGN.	;[1406] POSSIBLY IN A-MARGIN?
	TRNA			;[1406] YES, CONTINUE
	JRST	CPLB21		;NO
	CAIE	CH,"="		;LOOK AHEAD AND CHECK NEXT DELIMITER  FOR ==
	JRST	CPLB21		;ITS NOT
	PUSHJ	PP,GETITM	;GET RID OF ==
	CAIE	TYPE,EQUAL.	;[1406]
	CAIN	TYPE,EQUAL.+AMRGN.	;[1406]
	JRST	CPLB20
	EWARNW	E.605		;[557] '==' PSEUDO-TEXT DELIMITERS INCORRECT
	JRST	CPYERR		;[557] 

CPLB19:	PUSHJ	PP,PSTWRI	;WRITE ITEM
CPLB20:	CAIE	TYPE,PIC.+AMRGN. ;[1576]
	CAIN	TYPE,PIC.	;PICTURE IS SPECIAL
	PUSHJ	PP,PSTPIC
	PUSHJ	PP,GETITM	;GET NEXT ITEM
	CAIE	TYPE,ENDIT.	;[1372] IS THIS THE END-OF-FILE?
	CAIN	TYPE,ENDIT.+AMRGN.	;[1372]
	JRST	CPB36A		;[1372] YES, SOMETHING IS WRONG.
	TLNE	W1,GWRESV	;RESERVED
	CAIE	TYPE,EQUAL.	;=
	JRST	CPLB19		;NO
	CAIE	CH,"="		;==
	JRST	CPLB19		;NO
	PUSHJ	PP,GETITM	;YES, GET IT
	HRRZ	TA,CPYLOC
	ADD	TA,RPLNXW	;GET START OF LAST BLOCK
	MOVEI	TB,CONTF
	ANDCAM	TB,(TA)		;LAST ONE IS NOT CONTINUED
	PUSHJ	PP,GETITM	;GET NEXT ITEM
	CAIN	TYPE,BY.	;BETTER BE BY
	JRST	CPLB27		;DONE
CPE124:	EWARNW	E.124		;''BY' EXPECTED'
	JRST	CPYERR		;SKIP TO NEXT PARAGRAPH
;HERE IF NOT PSEUDO-TEXT

CPLB21:	TLNE	W1,GWLIT	;LITERAL
	JRST	CPLB22		;YES
	MOVSI	TA,-5		;MAX. WORD SIZE
	SKIPE	NAMWRD(TA)	;COUNT NO. OF WORDS
	AOBJN	TA,.-1		; WITH THIS LOOP
	AOJA	TA,CPLB23	;SIZE + 1 FOR COUNT

CPLB22:	LDB	TB,GWVAL	;GET LIT COUNT
	ADDI	TB,4
	IDIVI	TB,5
	MOVEI	TA,1(TB)	;GET SIZE + 1 FOR COUNT
CPLB23:	HRRI	W1,-1(TA)	;SIZE
	HRLI	TA,CD.CPY	
	PUSHJ	PP,GETENT	;GET SPACE
	MOVEM	W1,0(TA)	;STORE FLAG ,, SIZE
	HLRZM	TA,RPLNXW	;INCASE WE NEED TO QUALIFY IT
	HRLI	TB,NAMWRD
	TLNE	W1,GWLIT
	HRLI	TB,LITVAL	;EITHER NAME OR LIT
	HRRI	TB,1(TA)	;BLT PTR
	ADDI	TA,(W1)
	BLT	TB,(TA)		;COPY IT
	PUSHJ	PP,GETITM	;WHAT'S NEXT
	CAIN	TYPE,BY.	;THE WORD 'BY'?
	JRST	CPLB27		;YES
	CAIE	TYPE,IN.	;IN OR OF?
	JRST	CPE124		;NOT THERE, TOO BAD
	MOVE	TA,RPLNXW	;GET LAST SUB-ITEM
	ADD	TA,CPYLOC
	MOVEI	TB,CONTF	;FLAG
	IORM	TB,(TA)		;MARK IT
	PUSHJ	PP,GETITM	;GET QUALIFYING NAME
	JRST	CPLB21		;TRY AGAIN
CPLB27:	MOVE	TA,[CD.CPY,,2]
	PUSHJ	PP,GETENT	;GET SPACE FOR BYTE POINTER
	HLRZM	TA,RPLNXT	;SAVE INDEX
IFE TOPS20,<
	MOVE	CH,SRCBH+1	;GET SOURCE BYTE POINTER
	ADD	CH,[070000,,0]	;BACKUP BYTE POINTER
	SKIPGE	CH		;OK, IN SAME WORD
	SUB	CH,[430000,,1]	;BACKUP TO NEXT WORD
>
IFN TOPS20,<
	SETO	CH,
	ADJBP	CH,SRCBH+1	;BACKUP 1 BYTE
>
	HLLZM	CH,(TA)		;INITIAL PTR,,COUNT
	MOVEM	CH,RPLBH+1	;SAVE IT
	MOVE	CH,SRCBH+2
	ADDI	CH,1		;BACKUP COUNT ALSO
	MOVEM	CH,RPLBH+2	;SAVE IT
	MOVE	CH,SAVECP
	SUBI	CH,1		;POINT TO THIS NOT NEXT
	MOVEM	CH,R1CPO	;OUTPUT CHAR. POS.
	MOVE	CH,INPTCP
	SUBI	CH,1		;POINT TO THIS NOT NEXT
	MOVEM	CH,R1CPI	;INPUT CHAR. POS.
	SETOM	RPLBH+0		;SET FLAG FOR GETSR3
	PUSHJ	PP,GETITM	;NEXT ITEM
	TLNE	W1,GWRESV
	CAIE	TYPE,EQUAL.	;LOOK FOR =
	JRST	CPLB40		;NO
	CAIE	CH,"="		;LOOK FOR PSEUDO-TEXT
	JRST	CPLB40		;NO, NEEDS ==
	MOVE	CH,SAVECP
	MOVEM	CH,R1CPO	;OUTPUT CHAR. POS.
	MOVE	CH,SAVELN	;[1013] SAVE LINE # ALSO
	MOVEM	CH,R1LNO##	;[1013] IN CASE MISSING ENDING ==
	MOVE	CH,INPTCP
	MOVEM	CH,R1CPI	;INPUT CHAR. POS.
	PUSHJ	PP,GETITM	;GET RID OF ==
	PUSHJ	PP,GETITM	;GET NEXT
	TLNE	W1,GWRESV
	CAIE	TYPE,EQUAL.	;LOOK FOR =
	JRST	CPLB34		;NO
	CAIE	CH,"="		;LOOK FOR PSEUDO-TEXT END
	JRST	CPLB34		;NO, NEEDS ==
				;NOW WE HAVE NULL REPLACEMENT
	MOVE	CH,R1CPO	;MAKE BEFORE
	MOVEM	CH,R2CPO	;= AFTER
	MOVE	CH,R1CPI
	MOVEM	CH,R2CPI
	MOVE	CH,RPLBH+2	;GET PREV. COUNT
	PUSH	PP,SRCBH+2	;SAVE CURRENT
	MOVEM	CH,SRCBH+2	;SO WE CAN SAVE NO WORDS
	PUSHJ	PP,CPYSRC	;JUST SETUP HEADERS
	POP	PP,SRCBH+2	;GET CHAR COUNT BACK
	PUSHJ	PP,GETITM	;BYPASS ==
	PUSHJ	PP,GETITM	;GET WHAT FOLLOWS
	JRST	CPLB45		;AND CONTINUE
CPLB33:	PUSHJ	PP,GETITM	;GET NEXT
CPLB34:	TLNN	W1,GWRESV	;[***] IS IT A RESERVED WORD?
	JRST	CPLB33		;[***] NO, SO IT CANNOT BE ==
	CAIE	TYPE,ENDIT.	;[1013] END-OF-FILE?
	CAIN	TYPE,ENDIT.+AMRGN.	;[1013]
	JRST	CPLB36		;[1013] YES, GIVE ERROR
	CAIE	TYPE,EQUAL.	;LOOK FOR =
	CAIN	TYPE,EQUAL.+AMRGN.	;[***] POSSIBLY IN A-MARGIN
	CAIE	CH,"="		;LOOK FOR PSEUDO-TEXT END
	JRST	CPLB33		;NO, NEEDS ==
	MOVE	CH,SAVECP
	MOVEM	CH,R2CPO	;OUTPUT CHAR. POS.
	MOVE	CH,INPTCP
	MOVEM	CH,R2CPI	;INPUT CHAR. POS.
	MOVEI	TB,2
	ADDM	TB,SRCBH+2	;DON'T COUNT ==
	PUSHJ	PP,CPYSRC	;COPY UP TO ==
	MOVNI	TB,2
	ADDM	TB,SRCBH+2
	MOVE	TA,RPLNXT	;ALSO REMOVE FIRST ==
	ADD	TA,CPYLOC
	HLLZ	TB,(TA)
	HRRI	TB,2(TA)	;FORM BYTE PTR
	SETZ	TC,
CPLB35:	ILDB	CH,TB		;[1463] MAKE SURE WE ARE POSITIONED AT FIRST "="
	DPB	TC,TB		;[1463] CLEAR CHAR IN ANY CASE
	CAIE	CH,"="		;[1463] GOT THERE YET?
	JRST	CPLB35		;[1463] NO
	IDPB	TC,TB		;[1463] YES, REPLACE 2ND = BY NULL
	PUSHJ	PP,GETITM	;BYPASS ==
	PUSHJ	PP,GETITM	;GET WHAT FOLLOWS ==
	JRST	CPLB45

CPLB36:	DMOVE	LN,R1LNO	;[1013] GET LN & CP OF INITIAL ==
CPB36A:	MOVEI	DW,E.633	;[1372] [1013] TELL USER ABOUT MISSING ==
	JRST	FATAL		;[1013]
CPLB37:	AOSA	PARCNT		;COUNT ONE MORE "("
CPLB38:	SOS	PARCNT		;COUNT ONE LESS ")"
	JRST	CPLB40

CPLB39:	PUSHJ	PP,GETITM	;GET NEXT ITEM

CPLB40:	SKIPE	R3BH0		;DID WE GET TO GETKAR?
	JRST	CPLB46		;YES, JUST USE UP TO FIRST SPACE
	MOVE	CH,SRCBH+1	;SAVE BYTE PTR AND COUNT
	MOVEM	CH,R2BH1
	MOVE	CH,SRCBH+2
	MOVEM	CH,R2BH2
	MOVE	CH,SRCBFC
	MOVEM	CH,R2BH0	;SAVE BUFFER COUNT (SO WE CAN TELL IF IT CHANGES)
	MOVE	CH,SAVECP
	MOVEM	CH,R2CPO	;OUTPUT CHAR. POS.
	MOVE	CH,INPTCP
	MOVEM	CH,R2CPI	;INPUT CHAR. POS.
CPLB41:	PUSHJ	PP,GETITM	;GET NEXT ITEM
	CAIN	TYPE,LPREN.	;SUBSCRIPTED?
	JRST	CPLB37		;YES
	CAIN	TYPE,RPREN.	;")"
	JRST	CPLB38		;YES, COUNT DOWN
	SKIPE	PARCNT		;IN SIDE PARENS?
	JRST	CPLB40		;YES
	CAIN	TYPE,IN.	;QUALIFIED?
	JRST	CPLB39		;GET QUALIFIER
	MOVE	TB,SRCBFC
	CAME	TB,R2BH0	;DID SRC CHANGE BUFFERS?
	JRST	CPLB50		;YES, ITS ALREADY STORED
	PUSH	PP,SRCBH+1	;SAVE CURRENT BYTE PTR AND COUNT
	PUSH	PP,SRCBH+2
	MOVE	TB,R2BH1
	MOVEM	TB,SRCBH+1	;REPLACE WITH ONE JUST AFTER ITEM
	MOVE	TB,R2BH2
	MOVEM	TB,SRCBH+2	;SO WE DON'T COPY SPACES, COMMENTS ETC.
	AOS	SRCBH+2		;REMOVE SPACE OR TERMINATOR
	SETO	TB,		;[1576] MAY HAVE BEEN A COUPLE OF TERMINATING
	ADJBP	TB,SRCBH+1	;[1576]  CHARACTERS SINCE SCAN DOESN'T
	LDB	TB,TB		;[1576]  STOP ON A LINE FEED, SO BACK UP
	CAIN	TB,$LF		;[1576]  THE POINTER AND LOOK
	AOS	SRCBH+2		;[1576]
	PUSHJ	PP,CPYSRC	;COPY SOURCE
	POP	PP,SRCBH+2
	POP	PP,SRCBH+1
CPLB45:	CAIE	TYPE,PRIOD.	;[***] PERIOD?
	CAIN	TYPE,PRIOD.+AMRGN.	;[***] POSSIBLY IN A-MARGIN
	JRST	CPLB99		;YES
	SWON	FREGWD		;REGET WORD AGAIN
	JRST	CPLB2		;MUST BE ANOTHER REPLACING CLAUSE

CPLB46:	MOVE	CH,[R3BH0,,R2BH0]	;JUST USE UP TO FIRST SPACE
	TSWF	FGTPER		;DID WE ALSO SEE A PERIOD
	HRLI	CH,R4BH0	;YES, BACKUP TO IT
	BLT	CH,R2CPI
	JRST	CPLB41
CPLB50:	SETZM	RPLBH+0		;CLEAR COPY BUFFER FLAG
	MOVE	TA,RPLNXT	;GET REL LOC OF COUNT
	ADD	TA,CPYLOC	;FIX
	HRRZ	TB,0(TA)	;GET WHAT IT WAS
	SUB	TB,R2BH2	;MINUS ORIGIN
	SUBI	TB,1		;MINUS TERMINATOR
	HRRM	TB,0(TA)	;PUT BACK AS ALL WE NEED
	MOVE	TB,R1CPO	;SAVECP BEFORE
	LSH	TB,9
	ADD	TB,R1CPI	;INPTCP BEFORE
	LSH	TB,9
	ADD	TB,R2CPO	;SAVECP AFTER
	LSH	TB,9
	ADD	TB,R2CPI	;INPTCP AFTER
	MOVEM	TB,1(TA)	;SAVE POSITION COUNTS
	JRST	CPLB45

CPLB99:	PUSHJ	PP,SETLIB	;DONE, SET UP COPY & AND GET STARTED
	MOVN	TB,RPLCNT	;NO. OF POSSIBLE REPLACEMENTS
	HRLZM	TB,RPLCNT	;FORM AOBJN PTR
	JUMPE	TB,GETITM	;NO REPLACEMENTS POSSIBLE
	SWON	FRTST!FNOCPY	;SIGNAL TO MAKE REPLACEMENT CHECK
				;AND DON'T LIST UNTIL CHECKED
	MOVEI	TB,1
	MOVEM	TB,RPLLOC	;POINT TO START
	MOVEM	TB,RPLNXT
	ADDI	TB,1		;POINT TO FIRST WORD
	MOVEM	TB,RPLNXW
	JRST	GETITM		;GET FIRST ITEM FROM COPY AND RETURN
CPYSRC:	SETZM	RPLBH+0		;CLEAR COPY BUFFER FLAG
	MOVE	TA,RPLNXT	;GET REL LOC OF COUNT
	ADD	TA,CPYLOC	;FIX
	MOVE	TB,RPLBH+2	;GET CHAR. COUNT
	SUB	TB,SRCBH+2
	ADDM	TB,(TA)		;ADD TO WHATS ALREADY THERE
	MOVE	TB,R1CPO	;SAVECP BEFORE
	LSH	TB,9
	ADD	TB,R1CPI	;INPTCP BEFORE
	LSH	TB,9
	ADD	TB,R2CPO	;SAVECP AFTER
	LSH	TB,9
	ADD	TB,R2CPI	;INPTCP AFTER
	MOVEM	TB,1(TA)	;SAVE POSITION COUNTS
	HRRZ	TA,0(TA)	;GET CHAR. COUNT
	JUMPE	TA,CPOPJ	;RETURN IF 0
	HRRZ	TA,SRCBH+1
	HRRZ	TB,RPLBH+1
	SUBI	TA,-1(TB)	;GET SIZE IN WORDS
	PUSH	PP,TA
	HRLI	TA,CD.CPY
	PUSHJ	PP,GETENT
	MOVE	TC,TA
	HRL	TC,RPLBH+1	;FORM BLT PTR
	POP	PP,TB
	ADDI	TB,(TA)		;END OF BLT
	BLT	TC,-1(TB)	;COPY ALL WE NEED
	DMOVE	TC,SRCBH+1
	DMOVEM	TC,RPLBH+1
	POPJ	PP,
PSTWRI:	TLNE	W1,GWLIT	;LITERAL?
	JRST	PSTWRL		;YES
	MOVSI	TB,-5		;MAX. SIZE 
	SKIPE	NAMWRD(TB)	;GET PART OF NAME
	AOBJN	TB,.-1		;LOOP FOR REST OF NAME
	AOJA	TB,PSTWRW	;COUNT 1 FOR HEADER

PSTWRL:	LDB	TB,GWVAL	;GET LENGTH OF LIT
	ADDI	TB,4+5		;ROUND UP
	IDIVI	TB,5		;NO. OF WORDS
PSTWRW:	HRRZ	TA,TB
	MOVE	TB,W1
	HRRI	TB,CONTF-1(TA)	;SAVE WORD COUNT MINUS HEADER + FLAG
	PUSH	PP,TB
	HRLI	TA,CD.CPY
	PUSHJ	PP,GETENT	;GET SPACE FOR LITERAL OR PSEUDO-TEXT
	POP	PP,0(TA)	;STORE TYPE,,FLAG+WORD COUNT
	HRRZ	TB,CPYLOC
	SUBI	TA,(TB)		;GET REL ADDRESS
	MOVEM	TA,RPLNXW	;SO WE CAN FIXUP THE LAST
	ADDI	TA,(TB)
	HRRZ	TB,0(TA)
	TRZ	TB,CONTF	;GET LENGTH BACK
	ADD	TB,TA
	EXCH	TA,TB		;TB ORIGIN, TA END
	ADDI	TB,1
	HRLI	TB,NAMWRD	;FROM
	TLNE	W1,GWLIT
	HRLI	TB,LITVAL
	SKIPE	PICNXT		;[557] PIC TEXT?
	HRLI	TB,PICBUF	;YES
	BLT	TB,(TA)		;MOVE LITERAL
	SETZM	PICNXT		;[557] CLEAR PIC NEXT FLAG
	POPJ	PP,

PSTPIC:	PUSHJ	PP,PSCAN
	SETOM	PICNXT		;[557] MARK AS PIC TEXT
	SETZ	W1,		;[557] CLEAR FLAGS
	TSWF	FGTPER!FREGCH	;DID WE READ-AHEAD
	DPB	W1,PICPTR	;YES, REMOVE IT
	MOVSI	TB,-7
	SKIPE	PICBUF(TB)
	AOBJN	TB,.-1
	AOJA	TB,PSTWRW
;HERE TO SEE IF CURRENT ITEM SHOULD BE REPLACED

RPLTST:	TSWF	FRTST		;CHECKING THIS WORD
	JRST	PSTRD1		;YES
	HLRZ	CT,W1
	CAIN	CT,GWRESV+PIC.	;IF THIS IS PICTURE
	JRST	GITM1A		;PASS DISCRIPTORS ALSO
	SWON	FRTST		;NO, BUT CHECK NEXT ONE
	TSWTZ	FREGCH!FGTPER	;DID WE LOOKAHEAD
	JRST	RPLTS1		;[1022] NO, SO ALL OK
	LDB	CH,LIBBH+1	;[1022] GET LAST CHAR READ IN CASE IT WAS LF
	CAIE	CH,$LF		;[1022] SO DON'T BACKUP CPYFIL (IT WASN'T WRITTEN)
	PUSHJ	PP,BKPCPY	;[1022] DELETE LAST CHARACTER OUTPUT TO CPYFIL
	PUSHJ	PP,BKPLIB	;[1022] BACKUP SOURCE IN LIBRARY BUFFER
RPLTS1:	PUSHJ	PP,RPLSAV	;[1022] SAVE ITEMS NEEDED FOR REPLACEMENT TESTING
	SWON	FNOCPY		;TURN NO COPY BACK ON
	JRST	GITM1A		;RETURN AND PROCCESS WORD

RPLSAV:	MOVE	CT,RPLBLK
	MOVEM	CT,RPLBH+0	;SAVE CURRENT BLOCK #
	MOVE	CT,LIBBH+1	;GET BYTE PTR
	MOVEM	CT,RPLBH+1	;SAVE IT
	MOVE	CT,LIBBH+2	;AND COUNT
	MOVEM	CT,RPLBH+2
	MOVE	CP,INPTCP	;SAVE INPUT CHAR. POSITION
	MOVEM	CP,RPLICP
	MOVE	CP,SAVECP	;SAVE CHAR. POSITION
	MOVEM	CP,RPLCP
	MOVE	CT,RPLBLK	;YES
	MOVEM	CT,L1BH0	;SAVE CURRENT LIBRARY BLOCK #
	MOVE	CT,LIBBH+1
	MOVEM	CT,L1BH1	;BYTE POINTER
	MOVE	CT,LIBBH+2
	MOVEM	CT,L1BH2	;CHAR. COUNT
	MOVE	CT,SAVECP
	MOVEM	CT,L1CPO	;OUTPUT CHAR. POS.
	MOVE	CT,INPTCP
	MOVEM	CT,L1CPI	;INPUT CHAR. POS.
	SETZM	TKNBH+1		;[1576] Zero ptr so will store new one
	POPJ	PP,

PSTRD1:	MOVE	CT,RPLNXW	;GET NEXT WORD POINTER
	ADD	CT,CPYLOC	;PLUS BASE
	MOVE	TE,(CT)		;GET FLAGS & SIZE
	TLNE	W1,GWLIT	;LITERAL?
	JRST	PSTRD2		;YES
	TLNE	TE,GWLIT	;NO, BUT IS TARGET?
	JRST	PSTRD8		;YES, NO MATCH
	TRNE	TE,-1-CONTF	;IS SIZE 0
	JRST	PSTRD3		;NO, OK UP TO NOW
	XOR	TE,W1		;YES, SEE IF SAME (MUST BE "." "(" OR ")")
	TLNN	TE,-1		;MATCH?
	AOJA	CT,PSTR3A	;YES, BYPASS W1 AND POINT TO BYTE PTR
	JRST	PSTRD8		;NO
PSTRD2:	XOR	TE,W1		;SAME SIZE & TYPE?
	TLNE	TE,-1^!GWALL	;[557] BUT ALLOW ALL IN EITHER LITERAL
	JRST	PSTRD8		;NO
	XOR	TE,W1		;YES, PUT SIZE BACK
PSTRD3:	ANDI	TE,37777	;WORD SIZE ONLY
	PUSH	PP,TE		;[726] SAVE WORD COUNT
	MOVN	TE,TE
	HRL	CT,TE
	ADDI	CT,1		;AOBJN PTR AT LAST
	SKIPE	PICNXT		;[557] PIC?
	TROA	W1,PICBUF	;YES
	HRRI	W1,NAMWRD
	TLNE	W1,GWLIT
	HRRI	W1,LITVAL	;FORM OTHER POINTER
	MOVE	TE,(CT)		;GET WORD
	CAME	TE,(W1)		;MATCH?
	JRST	PSTR8A		;[726] NO
	ADDI	W1,1		;INCREMENT
	AOBJN	CT,.-4		;LOOP
	POP	PP,TE		;[726] GET WORD COUNT BACK
	CAIE	TE,7		;[726] CHECKED ALL WORDS?
	TLNE	W1,GWLIT	;[726] OR A LITERAL?
	JRST	PSTR3A		;[726] YES, THAT'S A MATCH
	SKIPN	PICNXT		;[726] IF PICTURE THEN 7 WORD MAX
	CAIE	TE,5		;[726] 5 WORDS ONLY FOR DATA-ITEMS
	TRNA			;[726] NO
	JRST	PSTR3A		;[726] ITS A MATCH
	SKIPE	(W1)		;[726] NEXT WORD ZERO?
	JRST	PSTRD8		;[726] NO, NO MATCH THEN
PSTR3A:	SETZM	PICNXT		;[557] CLEAR PIC FOLLOWING FLAG
	MOVE	TE,INPTST	;GET START OF ITEM
	SKIPN	RPLCST		;FIRST TIME?
	MOVEM	TE,RPLCST	;SO WE KNOW IF IN A OR B MARGIN
	MOVE	TE,RPLNXW	;TOTAL MATCH
	ADD	TE,CPYLOC
	MOVE	TE,(TE)		;SEE IF MORE TO TEST
	TRNN	TE,CONTF
	JRST	PSTRD4		;NO
	SETZM	L2BH0		;INCASE WE DON'T GET TO GETKAR
	HLRZ	CT,TE
	ANDI	TE,377777	;YES
	ADDI	TE,1		;HEADER WORD ALSO
	ADDM	TE,RPLNXW	;INCREMENT POINTER
	SETOM	CPYRMW##	;[1023] SIGNAL WE ARE ABOUT TO READ MORE WORDS
	CAIE	CT,GWRESV+PIC.	;IS NEXT A PICTURE?
	JRST	GETITM		;NO
	PUSHJ	PP,PSCAN	;YES, GET IT
	SETOM	PICNXT		;[557] SIGNAL PICTURE
	SETZ	W1,		;[557] CLEAR FLAGS
	TSWF	FGTPER!FREGCH	;DID WE READ-AHEAD
	DPB	W1,PICPTR	;YES, REMOVE IT
	JRST	PSTRD1		;TRY IT
PSTRD4:	SWOFF	FRTST!FECOPY	;[1023] TURN OFF END-OF-FILE SEEN AND REPLACEMENT TEST IN EFFECT 
	SKIPN	NCPYSW		;OK TO OUTPUT TO CPYFIL NOW
	SWOFF	FNOCPY		;UNLESS FORBIDDEN AT A HIGHER LEVER
	PUSH	PP,W1		;[1576] NO AC'S ANYWHERE
	MOVE	W1,RPLBH+1	;[1576] WHERE SCAN FOR REPLACEABLE TOKEN STARTS
	CAME	W1,TKNBH+1	;[1576] WHERE TOKEN WAS FOUND
	MOVE	W1,L1CPO	;[1576] GET THE OUTPUT CHAR POSIT BEFORE LOOK-
	MOVEM	W1,SAVECP	;[1576]  AHEAD STARTED TO RESTORE ACTIVE VALUE
	PUSHJ	PP,WRTCMT	;[1576] WRITE OUT THE DIFFERENCE, PROB. COMMENT

	MOVE	W1,TKNSIZ	;[1576] SIZE OF LAST TOKEN SCANNED
	HLRZ	CH,TE		;[1576] GET COPY OF W1, LOOK AT FLAGS
	CAIE	CH,GWRESV.+PRIOD.	;[1576] WAS LAST MATCH FOR A PERIOD?
	SOS	W1		;[1576] SUBTRACT 1 SINCE BPTR WILL BE ADVANCED
	MOVE	CH,W1		;[1576]
	ADJBP	W1,ENDTKN+1	;[1576] POINT AT END OF LAST REPLACED TOKEN
	CAMLE	CH,ENDTKN+2	;[1576] ALL IN SAME BUFFER?
	JRST	[SUB	CH,ENDTKN+2	;[1576] NO - ADJUST BUFFER HEADER
		 AOS	ENDTKN+0	;[1576] ADVANCE BLOCK NUMBER
		 MOVNS	CH		;[1576] RESET COUNT OF UNPROCESSED
		 ADDI	CH,1200		;[1576]  CHARACTERS
		 MOVEM	CH,ENDTKN+2	;[1576]
		 SUBI	W1,200		;[1576] BACK UP BYTE POINTER
		 JRST	.+1]		;[1576]
	CAMN	W1,LIBBH+1	;[1576] IF MATCHES, NO TRAILING COMMENT, ETC.
	SETZ	W1,		;[1576]  SO ZERO THE BYTE POINTER
	MOVEM	W1,ENDTKN+1	;[1576] STORE IN BUFFER HEADER
	POP	PP,W1		;[1576] 
	HLRZ	TE,TE		;GET W1 STORED
	CAIE	TE,GWRESV.+PRIOD.	;WAS LAST MATCH FOR A PERIOD?
	JRST	PSTR4E		;NO
	SWOFF	FREGCH!FGTPER	;YES, WE WANT TO BYPASS IT
	PUSHJ	PP,SVLKAR	;GO SETUP WITH CURRENT VALUES
	IBP	L2BH1		;BUT WE WANT NEXT CHAR
	SOS	L2BH2
	AOS	L2CPO		;AND FOR CHAR. POS
	AOS	L2CPI
PSTR4E:	SETZM	PADCNT		;ASSUME NO PADDING
	MOVE	TE,(CT)		;GET BYTE PTR & COUNT
	HRRZM	TE,RPLBH+2
	HLLZM	TE,RPLBH+1	;STORE LHS OF POINTER
	SKIPN	TE,L2BH0	;DID GETKAR SETUP FIRST SPACE
	JRST	[PUSHJ	PP,SVLKAR	;NO, GO SETUP WITH CURRENT
		JRST	PSTR4A]
	TSWT	FGTPER		;YES, BUT DID WE SEE A PERIOD ALSO?
	JRST	PSTR4D		;NO
	MOVE	CH,L2BH1	;GET BYTE PTR
	ADD	CH,[070000,,0]
	SKIPGE	CH
	SUB	CH,[430000,,1]
	MOVEM	CH,L2BH1	;BACKUP 1 CHAR
	AOS	L2BH2
	SOS	L2CPO		;BACKUP CHAR. POS.
	SOS	L2CPI
PSTR4D:	CAMN	TE,RPLBLK	;YES, SAME BLOCK?
	JRST	PSTR4A		;YES
	MOVEM	TE,RPLBLK	;NO, SAVE WHAT IT WILL BE
IFE TOPS20,<
	USETI	LIB,(TE)
	IN	LIB,
PSTR4A:	  SKIPA	TE,L2BH1	;OK
	JRST	GETLB9
>
IFN TOPS20,<
	SKIPE	TE		;
	SOS	TE		;CONVERT TO WORD ADDRESS
	LSH	TE,7		;
	PUSHJ	PP,SFPLIB##	;SET FILE POINTER
	PUSHJ	PP,GETLBA##	;FILL BUFFER
PSTR4A:	MOVE	TE,L2BH1
>
	MOVEM	TE,LIBBH+1	;SET BYTE PTR
	MOVE	TE,L2BH2
	MOVEM	TE,LIBBH+2	;BYTE COUNT
	MOVE	CP,L1CPI	;GET FIRST CHAR.
	CAIE	CP,7		;START OF NEW LINE?
	JRST	PSTR4F		;NO
	MOVE	CP,RPLCST	;YES, WHICH MARGIN?
	CAIGE	CP,^D12		;"B"?
	JRST	PSTR4F		;NO
	MOVEI	CP,5
	MOVEM	CP,PADCNT
	MOVEI	CH," "
	PUSHJ	PP,PUTCPY	;OUTPUT 4 SPACES
	SOSLE	PADCNT
	JRST	.-3
	MOVEI	CP,^D12		;RESET TO "B" MARGIN
	MOVEM	CP,L1CPI
	MOVEM	CP,L1CPO
PSTR4F:	MOVE	CP,L1CPI
	MOVEM	CP,INPTCP	;RESTORE INPUT PTR
	MOVE	CP,L1CPO
	MOVEM	CP,SAVECP	;RESTORE OUTPUT (SHOULD NOT HAVE CHANGED)
	MOVE	TD,1(CT)	;[1020] GET COUNTS
	SETZ	TE,		;[1020]
	LSHC	TE,9		;[1020]
	MOVEM	TE,R1CPO	;[1020] SAVECP BEFORE
	SETZ	TE,		;[1020]
	LSHC	TE,9		;[1020]
	MOVEM	TE,R1CPI	;[1020] INPTCP BEFORE
	LSH	TD,-9		;[1020]
	HLRZM	TD,R2CPO	;[1020] SAVECP AFTER
	LSH	TD,-9		;[1020]
	ANDI	TD,777		;[1020]
	MOVEM	TD,R2CPI	;[1020] INPTCP AFTER
	MOVE	CP,R1CPO	;GET WHERE OUTPUT STARTS FOR REPLACEMENT
	ADD	CP,RPLBH+2	;WHERE IT ENDS
	CAIL	CP,CPMAXN	;[1015] WOULD LINE BE TOO LONG?
	JRST	PSTR4C		;[1015] YES, START NEW ONE
	TSWF	FSEQ		;[1015] IF SEQUENCED INPUT WORRY ABOUT RIGHT MARGIN
	CAIGE	CP,^D73		;[1015] ARE WE IN THE COMMENT FIELD?
	SKIPA	CP,SAVECP	;[1015] NO, WHERE WE ARE NOW
	JRST	PSTR4C		;YES, TOO BAD
	ADD	CP,RPLBH+2
	CAIG	CP,^D72		;WILL THAT TAKE US INTO COMMENT FIELD?
	JRST	PSTRD5		;NO, JUST REPLACE WHERE WE ARE
	TSWF	FSEQ		;[1015] IF NOT SEQUENCED THEN THE LINE IS LONGER
	JRST	PSTR4C		;[1015] SEQUENCED, TOO BAD
	CAIGE	CP,CPMAXN	;[1015] WOULD LINE STILL BE TOO LONG?
	JRST	PSTRD5		;[1015] NO
PSTR4C:	MOVE	CP,R1CPO	;GET REPL. START
	SUB	CP,SAVECP	;GET DIFF BETWEEN LIBRARY AND REPLACEMENT
	JUMPLE	CP,[MOVEI CH,$LF	;THIS COULD BE A PROBLEM IF LINE IS LONG
		PUSHJ PP,PUTCPY		;SO START NEW LINE
		MOVE	TE,R1CPI	;[557] RESET INPUT POINTER
		MOVEM	TE,INPTCP	;[557] SO WE KNOW IF IN COL 72 ETC.
		JRST	PSTR4C]		;AND PAD OUT TO WHERE REPLACEMENT TEXT IS
	MOVEM	CP,PADCNT	;STORE NO. OF PAD SPACES
PSTRD5:	SKIPN	TE,RPLBH+2	;CHAR COUNT
	JRST	PSTRD6		;JUST NULL
	ADDI	TE,5+4		;+ 1 WORD + FUDGE FACTOR FOR SAFETY
	IDIVI	TE,5
	ADDI	CT,2		;POINT TO TEXT
	HRLI	CT,PSTBUF
	MOVS	CT,CT		;BLT PTR
	HRRM	CT,RPLBH+1	;COMPLETE BYTE POINTER
	ADDI	TE,(CT)
	BLT	CT,-1(TE)	;MOVE DATA TO SAFE PLACE
PSTRD6:	SWON	FCOPY		;SIGNAL REPLACING
	SWOFF	FREGCH!FGTPER	;NOT FOR REPLACEMENT
	MOVE	CP,INPTCP
	MOVEM	CP,RPLICP
	MOVE	CP,SAVECP
	MOVEM	CP,RPLCP	;SAVE CHAR. POSITIONS
	MOVEI	TE,2		;[704] REINITIALIZE POINTER
	MOVEM	TE,RPLNXW	;[704] TO POINT TO FIRST AVAILABLE ITEM
	SETZM	TERSCN		;[657] CLEAR SINCE WE ARE NOT READING SAME SOURCE
	JRST	GETITM		;GO GET IT
PSTR8A:	POP	PP,TE		;[726] RESTORE STACK
PSTRD8:	SETZM	PICNXT		;[557] CLEAR PIC FOLLOWING FLAG
	SETZM	RPLCST		;CLEAR FIRST INPTST COUNTER
	MOVE	CT,RPLNXT	;GET BASE OF THIS TEST
	ADD	CT,CPYLOC	;FIX IN CORE
	SKIPN	CT,0(CT)	;GET OFFSET OF NEXT TEST
	JRST	PSTRD9		;NO, MORE
	MOVEM	CT,RPLNXT	;POINT TO IT
	ADDI	CT,1		;AND TO DATA ITEM
	MOVEM	CT,RPLNXW
	SKIPN	CPYRMW		;[1023] DID WE READ MULTIPLE WORDS?
	JRST	PSTRD1		;[1023] NO,TRY AGAIN
	TRNA			;[1023] YES, WE MUST BACKUP FIRST

PSTRD9:	SETZM	CPYRMW		;[1023] USE THIS TO SIGNAL FAILED TO FIND MATCH
	MOVE	TE,RPLBH+0	;GET ORIGINAL BLOCK NUMBER
	CAMN	TE,RPLBLK	;SAME AS CURRENT?
	JRST	PSTR10		;YES
	MOVEM	TE,RPLBLK	;THIS WILL SOON BE CURRENT
IFE TOPS20,<
	USETI	LIB,(TE)	;NO, RESET ON OLD BLOCK
	IN	LIB,
PSTR10:	  SKIPA	TE,RPLBH+1	;OK, GET BYTE PTR
	JRST	GETLB9		;ERROR
>
IFN TOPS20,<
	SKIPE	TE		;
	SOS	TE		;CONVERT TO WORD ADDRESS
	LSH	TE,7		;
	PUSHJ	PP,SFPLIB##	;SET FILE POINTER
	PUSHJ	PP,GETLBA##	;FILL BUFFER
PSTR10:	MOVE	TE,RPLBH+1
>
	MOVEM	TE,LIBBH+1	;RESET IT
	MOVE	TE,RPLBH+2
	MOVEM	TE,LIBBH+2	;SAME FOR COUNT
	MOVE	CP,RPLICP
	MOVEM	CP,INPTCP
	MOVE	CP,RPLCP	;RESTORE CP
	MOVEM	CP,SAVECP
	SWOFF	FREGCH!FREGWD!FGTPER!FECOPY	;[1023]
	SKIPE	CPYRMW		;[1023] ARE WE JUST RESTORING THE SOURCE?
	JRST	PSTR12		;[1023] YES, THEN WE WILL TRY TO MATCH SOME MORE
	SWOFF	FNOCPY!FRTST	;[1023] NO, RESET FLAGS SO REAL READ TAKES PLACE
	MOVE	TE,RPLLOC	;POINT TO START
	MOVEM	TE,RPLNXT
	ADDI	TE,1		;POINT TO FIRST WORD
	MOVEM	TE,RPLNXW
PSTR12:	SETZM	CPYRMW		;[1023] CLEAR COUNTER
	JUMPN	CP,PSTR11	;[1001] OK IF IN MIDDLE OF LINE
	PUSHJ	PP,GETSEQ	;WORRY ABOUT SEQ NUMBER
	SWON	FREGCH		;REGET LAST CHAR
PSTR11:	TLNE	W1,GWALL	;[1001] WAS "ALL" SEEN BEFORE CURRENT ITEM?
	JRST	GITM34		;[1001] YES, RESET FLAG AGAIN
	JRST	GETITM		;GET ITEM AGAIN
BKPLIB:	AOS	LIBBH+2		;COUNT LAST CHAR
	SOS	INPTCP
	MOVE	TE,LIBBH+1
	ADD	TE,[070000,,0]
	SKIPGE	TE
	SUB	TE,[430000,,1]
	MOVEM	TE,LIBBH+1	;BACKUP BYTE PTR
	SOS	CP,SAVECP	;BACKUP CPYFIL POSITION
	POPJ	PP,

BKPCPY:	TSWF	FNOCPY		;DID WE WRITE TO CPYFIL?
	POPJ	PP,		;NO
	AOS	CPYBHO+2	;COUNT LAST CHAR
	MOVE	TE,CPYBHO+1
	ADD	TE,[070000,,0]
	SKIPGE	TE
	SUB	TE,[430000,,1]
	MOVEM	TE,CPYBHO+1	;BACKUP BYTE PTR
	POPJ	PP,
CPE285:	EWARNW	E.285		;YES, ILLEGAL LIBRARY-NAME
	JRST	CPYERR		;SKIP REST OF PARAGRAPH

CPE286:	EWARNW	E.286		;'COPY STATMENT MUST END WITH PERIOD'
	JRST	CPYERR		;SKIP REST OF PARAGRAPH

CPE607:	POP	PP,T3		;[1525]
	POP	PP,T2		;[1525]
	POP	PP,T1		;[1525]
	EWARNW	E.607		;[1525] CAN'T TRANSLATE [P,PN]
	JRST	CPYERR		;[1525]

CPE852:	EWARNW	E.852		;'NO MODULE NAME FOUND'
	SWOFF	FNOCPY		;
	JRST	CPYER1		;DON'T SKIP NEXT SOURCE

CPYERR:	PUSHJ	PP,CLRCPY	;CLR CPYTAB AS IF COPY IS ALL FINISHED (IT IS)
	SWOFF	FNOCPY		;TURN OFF 'NO LISTING' FLAG
	TRZ	FGTPER		; DON'T GET PERIOD FROM GETITM 
	PUSHJ	PP,SKPPGF	;SKIP TO END OF PARAGRAPH
CPYER1:	PUSHJ	PP,GETITM	;GET A SOURCE ITEM
	SWON	FREGWD		;SET REGET WORD BIT
	POPJ	PP,

;SKIP TO END OF PARAGRAPH
;THE TRICK IS TO FIND A CHARACTER IN THE A-FIELD THAT IS NOT
;EITHER A SPACE, TAB, OR HYPHEN
;(ASTERISKS ARE FILTERED OUT AT A MUCH EARLIER STAGE)

SKPPGF:	PUSHJ	PP,SKPSRC	;GET NEXT SOURCE CHAR.
	CAIN	CP,7		;ALREADY AT COLUMN 7?
	JRST	ENDB		;YES, WHAT KIND OF CHAR.?
	CAIGE	CP,^D12		;IN B-FIELD?
	JRST	ENDB.2		;NO, MUST BE IN A-FIELD
ENDPAR:	PUSHJ	PP,SKPSRC	;GET CHARACTER
ENDB:	TSWF	FEOF		;END-OF-FILE?
	JRST	END2		;EOF FOUND
	CAIE	CP,7		;COLUMN 7?
	JRST	ENDPAR		;NO, GET TO NEXT LINE
	CAIE	CH," "		;YES, SPACE?
	JRST	ENDPAR		;NO, MUST BE A HYPHEN
ENDB.1:	PUSHJ	PP,SKPSRC	;GET CHARACTER
	TSWF	FEOF		;END-OF-FILE?
	JRST	END2		;YES
	CAIL	CP,^D12		;INTO B-FIELD YET?
	JRST	ENDB		;YES, SKIP REST OF LINE
ENDB.2:	CAIN	CH," "		;IS IT A SPACE?
	JRST	ENDB.1		;YES
	CAIL	CH,"a"		;ABOVE LOWER CASE A?
	MOVEI	CH,-40(CH)	;YES MOVE IT INTO THE UPPER CASE SET.
	CAIL	CH,"A"		;IS IT ALPHABETIC?
	CAILE	CH,"Z"
	JRST	ENDB		;NOT A LETTER
END2:	TRZ	SW,FREGWD+FGTPER+FNEEDS	;CLR OTHER FLAGS
	JRST	REGLST		;REGET THE LAST CHARACTER
;[1576] Write out comment preceding/following replaced token to cpyfil
WRTCMT:				;[1576]
	PUSH	PP,TE		;[1576] GET SOME AC'S
	PUSH	PP,W1		;[1576]
	PUSH	PP,W2		;[1576]
	MOVE	TE,RPLBH+0	;[1576] GET THE BLOCK NBR WHERE TEXT STARTED
	CAMN	TE,RPLBLK	;[1576] DOES IT MATCH THE CURRENT NBR?
	JRST	WTCMT2		;[1576] YES
WTCMT1:	MOVE	TE,RPLBH	;[1576] PUT IT IN TE
	PUSHJ	PP,WTSTBF	;[1576] BACK UP THE LIBRARY FILE
	AOS	RPLBH+0		;[1576] 
WTCMT2: SOSG	RPLBH+2		;[1576] DECREMENT AVAILABLE CHARACTER COUNT
	 JRST	WTCMT1		;[1576]  NO MORE, GET ANOTHER BUFFER FULL
	IBP	RPLBH+1		;[1576] ADVANCE THE BYTE POINTER
	MOVE	CH,RPLBH+1	;[1576] HAVE WE PROCESSED ALL THE CHARACTERS
	CAMN	CH,TKNBH+1	;[1576]  UP TO THE TOKEN TO BE REPLACED?
	JRST	WTCMT4		;[1576] YES
	MOVE	CH,@RPLBH+1	;[1576] NO, LOOK AT THE CONTENTS OF THE WORD
	TRNN	CH,1		;[1576] IS IT A LINE NUMBER WORD?
	JRST	WTCMT3		;[1576] NO, LIBRARY  TEXT
	JUMPL	CH,WTCMT4	;[1576] END OF PROGRAM?
	MOVNI	CH,5		;[1576] NO--JUMP OVER 5 CHARACTERS
	ADDB	CH,RPLBH+2	;[1576]
	JUMPLE	CH,WTCMT1	;[1576] JUMP IF BUFFER NOW EMPTY
	AOS	RPLBH+1		;[1576] IT ISN'T--BUMP BYTE POINTER
	MOVEI	CH,40		;[1576] PUT OUT SIX BLANKS
	MOVNI	TE,6		;[1576]
	PUSHJ	PP,PUTCPY	;[1576]
	AOJN	TE,.-1		;[1576]
	MOVE	CH,RPLBH+1	;[1576] HAS THE BYTE POINTER NOW BEEN ADVANCED
	CAMN	CH,TKNBH+1	;[1576]  TO THE TOKEN TO BE REPLACED?
	JRST	WTCMT4		;[1576] YES
	
WTCMT3:	LDB	CH,RPLBH+1	;[1576] LOAD A LIBRARY TEXT CHARACTER
	JUMPE	CH,WTCMT2	;[1576] 
	AOS	L1CPI		;[1576] ADVANCE INPUT CHAR START POSITION
	PUSHJ	PP,PUTCIF	;[1576] WRITE OUT THE CHAR. TO CPYFIL
	JRST	WTCMT2		;[1576]

WTCMT4:	MOVE	TE,SAVECP	;[1576] PUT THE NEW OUTPUT CHAR POSITION
	MOVEM	TE,L1CPO	;[1576]  IN COPY REPLACING PLACE HOLDER
	MOVE	TE,RPLBLK	;[1576] IF LIBBH+1 POINTS TO A DIFFERENT
	CAME	TE,TKNBH+0	;[1576]  BUFFER, RELOAD IT NOW
	PUSHJ	PP,WTSTBF	;[1576]
	POP	PP,W2		;[1576] RESTORE AC'S
	POP	PP,W1		;[1576]
	POP	PP,TE		;[1576]
	POPJ	PP,		;[1576]

WTSTBF:	PUSH	PP,LIBBH	;[1576] SAVE CURRENT LIB FILE BUFFER HEADER
	PUSH	PP,LIBBH+1	;[1576]
	PUSH	PP,LIBBH+2	;[1576]
IFE TOPS20,<
	USETI	LIB,(TE)	;[1576]
	IN	LIB,		;[1576]
	  SKIPA	TE,LIBBH+1	;[1576] OK
	JRST	GETLB9		;[1576] ERROR
>
IFN TOPS20,<
	SKIPE	TE		;[1576] 
	SOS	TE		;[1576] CONVERT TO WORD ADDRESS
	LSH	TE,7		;[1576]
	PUSHJ	PP,SFPLIB##	;[1576] SET FILE POINTER
	PUSHJ	PP,GETLBA##	;[1576] FILL BUFFER
>
	DMOVE	W1,LIBBH+1	;[1576] PUT THE ACTIVE BUFFER HEADER
	SKIPG	RPLBH+2		;[1576]  INTO THE REPLACEMENT BUFFER HEADER
	DMOVEM	W1,RPLBH+1	;[1576]
	POP	PP,LIBBH+2	;[1576] RESTORE THE LIB FILE'S ACTUAL HEADER
	POP	PP,LIBBH+1	;[1576]
	POP	PP,LIBBH	;[1576]
	POPJ	PP,		;[1576]
;GET A CHARACTER FROM THE LIBRARY FILE

GETLIB:	TSWF	FCOPY		;COPYING FROM REPLACEMENT BUFFER?
	JRST	GETCPY		;YES
	TSWFZ	FREGCH		;REGET A CHARACTER?
	JRST	REGETL		;YES

GETLB1:	SOSG	LIBBH+2		;NO--GET NEXT CHARACTER
	JRST	GETLB4

GETLB2:	IBP	LIBBH+1
	MOVE	CH,@LIBBH+1	;IS THIS A LINE-NUMBER WORD?
	TRNN	CH,1
	JRST	GETLB3		;NO

	JUMPL	CH,GETLB5	;END OF PROGRAM?

	MOVNI	CH,5		;NO--JUMP OVER 5 CHARACTERS
	ADDB	CH,LIBBH+2
	JUMPLE	CH,GETLB1	;JUMP IF BUFFER NOW EMPTY
	AOS	LIBBH+1		;IT ISN'T--BUMP BYTE POINTER
GETLB3:	LDB	CH,LIBBH+1
	JUMPE	CH,GETLB1
	JRST	GETSL

GETLB4:
	AOS	RPLBLK		;INCREMENT CURRENT BLOCK
IFE TOPS20,<
	IN	LIB,		;GET ANOTHER BUFFER FULL
	  JRST	GETLB2

	GETSTS	LIB,CH		;END-FILE?
	TRNE	CH,IO.ERR
	JRST	GETLB9		;NO--TROUBLE
>
IFN TOPS20,<
	PUSHJ	PP,GETLBA	;GET NEXT BUFFER
	JRST	GETLB2
>

GETLB5:	SETOM	LIBBH+2		;[557] FORCE COUNT FINISHED
	TSWF	FCOPY		;STILL DOING REPLACEMENTS
	JRST	[MOVSI	CH,(FECOPY)	;YES
		IORM	CH,RPLFLG	;MARK IT FOR AFTER COPY
		JRST	GTBLNK]		;BUT WE STILL NEED LIBRARY
	SWON	FECOPY		;SET "CLEAN UP COPY" INDICATOR
	TSWT	FRTST		;[1023] JUST DOING REPLACEMENT CHECK?
	SWOFF	FRLIB
;	SWOFF	FPERWD		;[1125] TURN OFF FLAG TO RETURN NON-EXISTENT PERIOD
	JRST	GTBLNK

REGETL:	LDB	CH,LIBBH+1
	JUMPE	CH,GETLB1
	CAIN	CH,177		;[557] JUST INCASE WE READ END OF PROGRAM -1
	MOVEI	CH," "		;[557] YES, RETURN A SPACE TO AVOID ERROR
	POPJ	PP,
;GET A CHARACTER FROM THE REPLACEMENT BUFFER

GETCPY:	TSWFZ	FREGCH		;REGET A CHARACTER?
	JRST	REGETC		;YES

GETCP0:	SOSGE	PADCNT		;[557] PADDING NEEDED?
	JRST	GETCP1		;[557] NO
	MOVEI	CH," "		;[557]
	PUSHJ	PP,PUTCPY	;[557] PAD WITH BLANKS
	AOS	INPTCP		;[557] COUNT AS INPUT CHARACTER
	JRST	GETCP0		;[557]

GETCP1:	SOSGE	RPLBH+2		;NO--GET NEXT CHARACTER
	JRST	GETCP4

	IBP	RPLBH+1
	MOVE	CH,@RPLBH+1	;IS THIS A LINE-NUMBER WORD?
	TRNN	CH,1
	JRST	GETCP3		;NO

	MOVNI	CH,5		;JUMP OVER 5 CHARACTERS
	ADDB	CH,RPLBH+2
	JUMPLE	CH,GETCP1	;JUMP IF BUFFER NOW EMPTY
	AOS	RPLBH+1		;IT ISN'T--BUMP BYTE POINTER
GETCP3:	LDB	CH,RPLBH+1
	JUMPE	CH,GETCP1
	JRST	GETSL

REGETC:	LDB	CH,RPLBH+1
	JUMPE	CH,GETCP1
	POPJ	PP,

;[1576] Have now finished replacing token. If there is a trailing comment,
;[1576] copy it now.
GETCP4:				;[1576]
	MOVE	CH,ENDTKN+1	;[1576] POINTER TO END OF REPLACED TOKENS
	JUMPE	CH,GTCP4B	;[1576] CONTINUE
	CAMN	CH,LIBBH+1	;[1576]  IF NO TRAILING DATA
	JRST	GTCP4B		;[1576]
	HRLZI	CH,ENDTKN	;[1576] COPY TRAILING BUFFER HEADER
	HRRI	CH,RPLBH	;[1576]  INTO REPLACEMENT BUFFER HEADER
	BLT	CH,RPLBH+2	;[1576]
	MOVEI	CH,1		;[1576] BACK UP LIB FILE POINTER BY ONE
	ADJBP	CH,LIBBH+1	;[1576]  AND STORE IN TKNBH+1 TO MARK
	MOVEM	CH,TKNBH+1	;[1576]  WHERE TO STOP COPY
	PUSHJ	PP,WRTCMT	;[1576] WRITE OUT TRAILING DATA
	MOVE	CH,INPTCP	;[1576] REPLACE INPUT CHAR POSITION AFTER COPY
	MOVEM	CH,L2CPI	;[1576]  WITH NEW ACTUAL COUNT FOR PADDING CALC

GTCP4B:	SWOFF	FCOPY		;[1576] TURN OFF REPLACING REQUIRED
	IOR	SW,RPLFLG	;RESTORE OLD FLAGS
	SETZM	RPLFLG
	TSWF	FECOPY		;PREVIOUSLY SEEN END OF LIBRARY?
	JRST	GETCP5		;YES
	SWOFF	FREGCH!FGTPER

;[1064] Check for "." and line-feed as only remaining characters in the
;[1064] input library member line before splitting the line in the output
;[1064] listing. We have to look ahead 2 characters.

IFN DEBUG,<
	SKIPG	LIBBH+2		;Can we look ahead?
	HALT	.		;No, give error so I can fix it.
>
	MOVE	CH,LIBBH+1	;[1064] Get byte pointer to library buffer.
	ILDB	CH,CH		;[1065] Look ahead to next character.
	CAIE	CH,"."		;[1064] Is it a "."?
	JRST	GTCP4L		;[1064] No, go on to check for split line.
IFN DEBUG,<
	MOVE	CH,LIBBH+2	;Can we look ahead
	SOSGE	CH		;2 characters?
	HALT	.		;No, give error so I can fix it.
>
	MOVE	CH,LIBBH+1	;[1064] Get byte pointer to library buffer again.
	IBP	CH		;[1064] Need to look 2 ahead now.
	ILDB	CH,CH		;[1064] Get the character 2 ahead.
	CAIE	CH,$LF		;[1064] Is the next char. a line-feed?
	JRST	GTCP4L		;NO, BREAK THE LINE IN TWO
;	JRST	[TSWF	FCLAS1		;[1125] Yes, are we processing numeric literal?
;		SWON	FPERWD		;[1125] Yes, set flag to return non-existent period
;		JRST	GETLIB]		;[1125] [1064] Go pick up a "." for list.
	MOVEI	CH,"."		;[1440] STORE PERIOD SO WE WILL STOP SCAN
	MOVEM	CH,TERSCN	;[1440]  ON PERIOD IN CASE OF NUMERIC LITERAL
	JRST	GETLIB		;[M1125] [1064] Yes, go pick up a "." for real.
				;[1064] No, go to do split-line stuff
GTCP4L:	MOVE	CP,L2CPI	;GET NEXT CHAR. POS.
	SUB	CP,INPTCP	;SEE IF IT WILL FIT ON THIS LINE
	JUMPL	CP,GTCP4Z	;NO, START NEW LINE
	JUMPE	CP,GTCP4A	;NO PROBLEM
	MOVEM	CP,PADCNT	;SAFE PLACE FOR COUNT
	MOVEI	CH," "
	PUSHJ	PP,PUTCPY	;PAD WITH BLANKS
	SOSLE	PADCNT
	JRST	.-3
GTCP4A:	MOVEI	CH,"."
	TSWF	FGTPER		;NEED PERIOD?
	PUSHJ	PP,PUTCPY	;YES, SO PUT ON CPYFIL
	LDB	CH,LIBBH+1	;GET LAST CHAR.
	TSWF	FREGCH		;NEED IT
	PUSHJ	PP,PUTCPY
	MOVE	CP,SAVECP
	ADDI	CP,1		;INPUT IS 1 AHEAD STILL
	MOVEM	CP,INPTCP
	JRST	GETLIB		;GET NEXT CHAR. FROM LIBRARY

;[1065] We have to check for end of library copy member in COPY REPLACING,
;[1065] as well as in vanilla COPY, otherwise COPY REPLACING will overflow
;[1065] into the next available library copy member.

GTCP4Z:	SKIPG	LIBBH+2		;Can we look ahead?
IFE DEBUG,<
	JFCL			;No, ignore problem for now
>
IFN DEBUG,<
	HALT	.		;No, give error so I can fix it.
>
	MOVE	CH,LIBBH+1	;[1065] Get byte pointer to library buffer.
	ILDB	CH,CH		;[1065] Look ahead to next character.
	CAIN	CH,177		;[1065] From -1 terminator word?
	JRST	GETLB5		;[1065] Yes, go put "." in output and clean up end of copy.
	MOVEI	CH,$LF		;START NEW LINE
	PUSHJ	PP,PUTCPY
	SETZM	INPTCP		;RESET INPUT POS.
	AOS	INPTCP		; TO 1
	JRST	GTCP4L		;TRY AGAIN

GETCP5:	MOVEI	CH,"."		;RETURN A PERIOD
	TSWT	FGTPER		;UNLESS PERIOD NOT NEEDED
	MOVEI	CH," "		;IN WHICH CASE RETURN SPACE
	JRST	PUTCIF		;PUT ON LISTING ALSO
;GET A LIBRARY PROGRAM.

;ENTER WITH CP SET TO PERIOD TERMINATING THE COPY CLAUSE, 
;	CPYW2 POINTING TO "COPY", AND PROGRAM-NAME IN LIBNAM.

SETLIB:	SETZM	REGKAR
	TSWTZ	FREGCH		;CHARACTER TO REGET?
	JRST	SETLB2		;NO
IFE TOPS20,<
	SKIPN	SRCDEV		;[352] ANY MORE SOURCE CHARS?
>
IFN TOPS20,<
	SKIPN	SRCJFN##
>
	JRST	SETLB2		;[352] NO, NO CHAR TO REGET EVER.
	LDB	TE,SRCBH+1	;YES--PICK IT UP
	MOVEM	TE,REGKAR
	TSWT	FSEQ		;SEQUENCED FILE?
	JRST	SETLB1		;NO
	MOVE	CP,SAVECP	;GET CHAR. POS
	CAILE	CP,^D72		;IN COMMENT FIELD
	JRST	SETLB2		;YES, JUST LEAVE CHAR ALONE
SETLB1:	MOVSI	TE,7B<^D18+5>
	ADDM	TE,CPYBHO+1
	AOS	CPYBHO+2

SETLB2:	MOVE	CP,SAVECP
	MOVEM	CP,CPYCP	;SAVE CHARACTER POSITION
IFE TOPS20,<
	SKIPN	LIBDEV		;IS THERE A LIBRARY FILE?
	JRST	STLB20		;NO--WE LOSE

	USETI	LIB,1		;GET READY TO READ ROUGH TABLE
	IN	LIB,		;READ ROUGH TABLE
	  SKIPA	TC,LIBNAM	;PICK UP LIBRARY ROUTINE NAME
	JRST	SETLBE		;[655] ERROR
	MOVE	TB,LIBNAM+1
>
IFN TOPS20,<
	SKIPG	LIBJFN		;DO WE HAVE A LIBARY FILE YET?
	PUSHJ	PP,OPNLIB	;NO, TRY DEFAULT
	SKIPG	LIBJFN##	;DO WE HAVE ONE NOW?
	JRST	STLB20		;NO LIBRARY FILE 
	SETZ	TE,		;START AT BEGINNING OF FILE
	PUSHJ	PP,SFPLIB##	;SET FILE POINTER
	PUSHJ	PP,GETLBA##	;FILL BUFFER
	DMOVE	TC,LIBNAM	;GET LIBRARY ROUTINE NAME
>
	LSHC	TC,-6
	TRZ	TB,-1
	LSH	TB,-1

IFE TOPS20,<
	MOVE	TA,LIBBH+1	;SET TA TO POINT TO ROUGH-TABLE
>
IFN TOPS20,<
	SOS	TA,LIBBH+1	;WE USE 440700 TYPE BYTE POINTER
>
	DMOVE	TE,1(TA)	;COMPARE LIBNAM TO FIRST ENTRY
	PUSHJ	PP,SETLBC
	  CAIA			;EQUAL
	  JRST	SETLB4		;GREATER
IFE TOPS20,<
	MOVEI	TE,2		;LESS, SET USETI WORD
>
IFN TOPS20,<
	MOVEI	TE,200		;LESS, SET SFPTR% WORD
>
	JRST	SETL5A

IFE TOPS20,<
SETLBE:	GETSTS	LIB,CH		;[655] GET ERROR STATUS
	TRNN	CH,IO.ERR	;[655] END-OF-FILE?
	OUTSTR	[ASCIZ	/Premature end-of-file found on library file
/]
;	JRST	GETLB9		;[655] CONTINUE WITH STANDARD ERROR MESSAGE
GETLB9:	MOVEI	CH,LIBDEV	;ERROR ON LIBRARY DEVICE
	JRST	DEVDED
>
;SEARCH  ROUGH-TABLE

SETLB4:	ADDI	TA,2
	DMOVE	TE,1(TA)
	PUSHJ	PP,SETLBC
	  JRST	SETLB5
	  JRST	SETLB4
	SKIPA	TE,0(TA)	;ITEM FOUND--GET ADDRESS

SETLB5:	MOVE	TE,2(TA)
	TLZ	TE,777700
IFE TOPS20,<
	LSH	TE,-7
	ADDI	TE,1
>

;AN APPROPRIATE ROUGH-TABLE ENTRY HAS BEEN LOCATED.

SETL5A:
IFE TOPS20,<
	USETI	LIB,(TE)	;READ IN FINE-TABLE
	IN	LIB,
	  SKIPA	TA,LIBBH+1	;SET UP AN IOWD TO FINE TABLE
	JRST	SETLBE		;[655] ERROR
>
IFN TOPS20,<
	PUSHJ	PP,SFPLIB	;SET FILE POINTER
	PUSHJ	PP,GETLBA	;GET A BUFFER FULL
	SOS	TA,LIBBH+1	;WE USE 440700 TYPE BYTE POINTER
>
	HRLI	TA,-^D64

;SEARCH THE FINE TABLE

SETLB6:	DMOVE	TE,1(TA)
	PUSHJ	PP,SETLBC
	  JRST	SETLB8
	  AOJA	TA,SETLB7
	JRST	STLB21

SETLB7:	AOBJN	TA,SETLB6
	JRST	STLB21
;PROGRAM FOUND

SETLB8:	MOVSI	TE,(FSEQ)
	AND	TE,SW		;PRESERVE STATE OF FSEQ
	MOVEM	TE,CPYFLG
	SETZM	RPLFLG		;[557] CLEAR REPLACEMENT FLAG ALSO
	SWOFF	FSEQ		;TURN IT OFF
	MOVE	TE,2(TA)
	TLZE	TE,40		;LIBRARY SEQUENCED?
	SWON	FSEQ
	TLZ	TE,777700
	LSHC	TE,-7
	ADDI	TE,1
	HRRZM	TE,RPLBLK	;STORE PTR TO CURRENT BLOCK
	HRRZM	TE,RPLBH	;PTR TO INITIAL BLOCK
IFE TOPS20,<
	USETI	LIB,(TE)
	IN	LIB,
	  AOSA	LIBBH+2
	JRST	SETLBE		;[655] ERROR
>
IFN TOPS20,<
	SKIPE	TE		;
	SOS	TE		;CONVERT BACK TO WORD ADDRESS
	LSH	TE,7
	PUSHJ	PP,SFPLIB	;SET FILE POINTER
	PUSHJ	PP,GETLBA	;GET A BUFFER FULL
	AOS	LIBBH+2		;INCREMENT COUNT BECAUSE OF WAY WE READ FILE
>
	MOVEI	TE,0
	LSHC	TE,7
	ADDM	TE,LIBBH+1
	IMULI	TE,5
	MOVNS	TE
	ADDM	TE,LIBBH+2
	SWON	FRLIB
	MOVEI	CH,$LF
SETL8A:	PUSHJ	PP,PUTCPY	;PUT LF IN CPY FILE SO LISTING LOOKS OK
	PUSHJ	PP,GETSEQ	;FORCE FIRST LIBRARY CHAR TO START ON NEW LINE.
				;ALSO, PASS OVER ANY COMMENTS
	SKIPN	RPLCNT		;ANY REPLACEMENTS TO DO?
	JRST	REGLST		;[156] NO, GET BACK THIS FIRST CHAR LATER

	TSWTZ	FREGCH		;[1022] IF FREGCH IS ON THEN MAYBE WE JUST SAW CR-LF
	JRST	SETLB9		;[1022] NO, SO ALL OK
	LDB	CH,LIBBH+1	;[1022] GET LAST CHAR READ IN CASE IT WAS LF
	CAIE	CH,$LF		;[1022] SO DON'T BACKUP CPYFIL (IT WASN'T WRITTEN)
SETLB9:	PUSHJ	PP,BKPCPY	;[1022] DELETE LAST CHARACTER OUTPUT TO CPYFIL

;[1063] When we begin a new line under COPY REPLACING usually we just
;[1063] back up one character in the library buffer and march on.
;[1063] However, with procedure division paragraph names and 01 level numbers
;[1063] there are some problems with synchronization.

	LDB	CH,LIBBH+1	;[1063] Get current char. from lib buffer
	CAIN	CH,$LF		;[1063] Is it a line-feed?
	JRST	SETL8A		;[1063] Yes, put it out to output buffer
	TSWF	FRLIB		;No, did the copy library end already?
	JRST	[PUSHJ	PP,BKPLIB	;[1063] No, back up lib buffer
		JRST	RPLSAV]		;[1063] Save required items and return
	SWOFF	FECOPY		;Cleanup the flags
	SETZM	RPLCNT		;Things work better if not replacing
	POPJ	PP,		;Just return

SETL9B:	MOVE	CT,PHASEN	;[1063] Find if we are in DATA DIVISION.
	CAIN	CT,"C"		;[1063]
	TSWF	FLETTR		;[1063] Yes, but if it contains a non-digit it is not a level number.
	PUSHJ	PP,BKPCPY	;[1063] Back up the output COPY buffer.
	PJRST	RPLSAV		;SAVE REQUIRED ITEMS AND RETURN
;GET A LIBRARY PROGRAM (CONT'D).

;ERRORS

;NO LIBRARY FILE

STLB20:
IFE TOPS20,<
	OUTSTR	[ASCIZ "%Library file "]
	PUSHJ	PP,STLB30	;PRINT DEV:FILE.EXT
	OUTSTR	[ASCIZ " not found - continuing
"]
>
IFN TOPS20,<
	PUSH	PP,T1
	HRROI	T1,[ASCIZ "%Library file "]
	PSOUT%
	MOVEI	T1,.PRIOU
	HRROI	T1,LIBSPC	;ASSUME WE HAVE ONE
	SKIPN	LIBSPC		;IF NOT TYPE DEFAULT
	HRROI	T1,[ASCIZ /LIBARY.LIB/]
	PSOUT%
	HRROI	T1,[ASCIZ " not found - continuing
"]
	PSOUT%
	POP	PP,T1
>
	MOVEI	DW,E.75
IFE TOPS20,<
	MOVE	CP,LIBHDR	;[557] GET LIBRARY NAME
	CAME	CP,['LIBARY']	;[557] JUST THE DEFAULT
>
IFN TOPS20,<
	SKIPN	LIBSPC
>
	MOVEI	DW,E.607	;[557] NO, THEREFORE WE FAILED TO FIND IT
	JRST	STLB29

;PROGRAM NOT FOUND

STLB21:
IFE TOPS20,<
	OUTSTR	[ASCIZ "%Library routine "]
>
IFN TOPS20,<
	PUSH	PP,T1
	HRROI	T1,[ASCIZ "%Library routine "]
	PSOUT%
>
	MOVE	TA,[POINT 6,LIBNAM]
STLB22:	ILDB	TE,TA		;CONVERT ALL ':' BACK TO '-'
	JUMPE	TE,STLB23	;FINISHED
	CAIE	TE,':'
	JRST	STLB22
	MOVEI	TE,'-'
	DPB	TE,TA
	JRST	STLB22

STLB23:	MOVE	TA,LIBNAM
	PUSHJ	PP,SIXOUT
	MOVE	TA,LIBNAM+1
	PUSHJ	PP,SIXOUT
IFE TOPS20,<
	OUTSTR	[ASCIZ " in "]
	PUSHJ	PP,STLB30	;PRINT DEV:FILE.EXT
	OUTSTR	[ASCIZ " not found - continuing
"]
>
IFN TOPS20,<
	HRROI	T1,[ASCIZ " in "]
	PSOUT%
	PUSHJ	PP,STLB30	;PRINT DEV:FILE.EXT
	HRROI	T1,[ASCIZ " not found - continuing
"]
	PSOUT%
	POP	PP,T1
>
	MOVEI	DW,E.74

STLB29:	MOVE	CP,CPYW2
	LDB	LN,[POINT 13,CPYW2,28]
	SWOFF	FCOPY!FRLIB	;[477] IF LIBARY NOT FOUND, CAN'T COPY
	JRST	FATAL

STLB30:
IFE TOPS20,<
	PUSH	PP,LIBDEV	;SAVE CURRENT DEVICE (USUALLY ZERO TO INDICATE ERROR)
	SKIPN	TA,LIBDV##	;GET DEVICE
	MOVSI	TA,'DSK'
	MOVEM	TA,LIBDEV	;SETUP THE CORRECT DEVICE
	MOVEI	DA,LIBDEV	;POINT TO DATA BLOCK
	PUSHJ	PP,FILOUT##	;TYPE THE FULL FILE SPEC
	POP	PP,LIBDEV
>
IFN TOPS20,<
;NOTE, ON ENTRY T1 HAS ALREADY BEEN SAVED
	PUSH	PP,T2
	PUSH	PP,T3
	MOVEI	T1,.PRIOU	;OUTPUT TO TERMINAL
	MOVE	T2,LIBJFN##
	SETZ	T3,
	JFNS%
	  ERJMP	.+1
	POP	PP,T3
	POP	PP,T2
>
	POPJ	PP,
;COMPARE LIBNAM AGAINST CONTENTS OF TE & TD.
;IF EQUAL, RETURN TO CALL + 1.
;IF LIBNAM > TE,TD RETURN TO CALL+2.
;IF LIBNAM < TE,TD RETURN TO CALL+3.

SETLBC:	LSHC	TE,-6
	TRZ	TD,-1
	LSH	TD,-1

	CAME	TC,TE
	JRST	SETLC1
	CAMN	TB,TD
	POPJ	PP,

	AOS	(PP)
	CAMG	TB,TD
	AOS	(PP)
	POPJ	PP,

SETLC1:	AOS	(PP)
	CAMG	TC,TE
	AOS	(PP)
	POPJ	PP,
;SPACE OVER UNTIL PREVIOUS SOURCE CHARACTER POSITION REACHED

ENDCPY:	SWOFF	FSEQ		;TURN OF FSEQ
	IOR	SW,CPYFLG	;PUT IT BACK THE WAY IT WAS
	MOVEI	CH,$LF
	SKIPN	SAVECP		;IF JUST STARTED NEW LINE
	MOVEI	CH," "		;DON'T PUT OUT EXTRA ONE
ENDCP1:	PUSHJ	PP,PUTCPY
	MOVEI	CH,1(CP)
	CAML	CH,CPYCP
	JRST	ENDCP2
	MOVEI	CH," "
	JRST	ENDCP1

ENDCP2:	MOVEM	CH,INPTCP	;[275] RESTORE LAST SOURCE CHAR POS BEFORE GOING TO LIBARY
	SKIPE	CH,REGKAR
	SWONS	FREGCH;
	MOVEI	CH," "
	PUSHJ	PP,PUTCPY

;CLEAR OUT CPYTAB AFTER END-OF-PROGRAM IN CPYFIL.

CLRCPY:	HRRZ	TE,CPYLOC
	HRLI	TE,1(TE)
	MOVS	TE,TE		;BUILD BLT PTR
	HRRZ	TD,CPYNXT
	BLT	TE,-1(TD)	;ZERO  ALL OF CPYTAB
	MOVE	TE,CPYLOC	;YES--RESET CPYNXT
	MOVEM	TE,CPYNXT
	SWOFF	FCOPY!FECOPY!FRLIB	;TURN OFF "WE ARE COPYING"
	POPJ	PP,		;RETURN
SUBTTL	FIPS FLAGGER TESTS

FLG.LI:	PUSH	PP,CH		;SAVE THE CHAR. (COULD BE UPPER OR LOWER CASE)
	PUSH	PP,TA		;ACC TO CONTAIN THE LEVEL FLAG
	MOVEI	TA,%LV.LI	;GET FLAG LEVEL OF LOW-INTERMEDIATE
	JRST	FLG.X		;MAKE THE TEST

FLG.HI:	PUSH	PP,CH		;SAVE THE CHAR. (, OR ;)
	PUSH	PP,TA		;ACC TO CONTAIN THE LEVEL FLAG
	MOVEI	TA,%LV.HI	;GET FLAG LEVEL OF HIGH-INTERMEDIATE
	JRST	FLG.X		;MAKE THE TEST

FLG.H:	PUSH	PP,CH		;SAVE THE CHAR. (COULD BE UPPER OR LOWER CASE)
	PUSH	PP,TA		;ACC TO CONTAIN THE LEVEL FLAG
	MOVEI	TA,%LV.H	;GET FLAG LEVEL OF HIGH
FLG.X:	ANDCM	TA,FLGSW	;CLEAR THE BITS WE ALLOW
	SKIPE	TA		;IS THIS WITHIN LIMITS?
	PUSHJ	PP,FLG.ES##	;NO
	POP	PP,TA
	POP	PP,CH
	POPJ	PP,

FLG.NS:	PUSH	PP,CH		;SAVE THE CHAR.
	PUSH	PP,TA		;ACC TO CONTAIN THE LEVEL FLAG
	MOVEI	TA,%LV.NS	;GET FLAG LEVEL OF NON-STANDARD
	JRST	FLG.X		;MAKE THE TEST

FLG.8:	PUSH	PP,CH		;SAVE THE CHAR.
	PUSH	PP,TA		;ACC TO CONTAIN THE LEVEL FLAG
	MOVEI	TA,%LV.8	;GET FLAG LEVEL OF ANS-8x COMPATABILITY
	JRST	FLG.X		;MAKE THE TEST

FLG.VX:	PUSH	PP,CH		;SAVE THE CHAR.
	PUSH	PP,TA		;ACC TO CONTAIN THE LEVEL FLAG
	MOVEI	TA,%LV.VX	;GET FLAG LEVEL OF VAX COMPATABILITY NON-STANDARD
	JRST	FLG.X		;MAKE THE TEST
SUBTTL	EXTERNALS

IFE TOPS20,<
EXTERN	DEVDED,CRFDEV,LIBDEV,LIBHDR,SRCDEV,SRCEND,STINFL,OPENIT,CPYBHO,CRFBHO
EXTERN	IOSRCS,DEVFIL,DEVDEV,DEVEXT,DEVSW,DEVSIZ
EXTERN	DEVBH
>
IFN TOPS20,<
EXTERN	CPYBH,CRFBH
SYN CPYBH,CPYBHO
SYN CRFBH,CRFBHO
>
EXTERN	FATAL,WARN,TRYNAM
EXTERN	PUTCPY,PUTCIF,PUTFEL,SIXOUT,LNKSET
EXTERN	CURCPY,LIBBH,LIBNAM
EXTERN	RPLCNT,RPLLOC,RPLNXT
EXTERN	GETENT,PHASEN,OPRTR,DCPNT.
EXTERN	PSCAN,PICBUF,PICPTR
EXTERN	SRCBH,CREFSW,CPMAXN
EXTERN	SEQIN
EXTERN	WASERC,PUNPTR,PLUSWD,MINWD,MULWD,LPARWD,EXPWD,PERWD,ENDIT
EXTERN	COLNWD
EXTERN	NAMWRD,LITVAL,NAMVAL,FILLOC,FILNXT
EXTERN	GWNAMP,GWVAL,GWLN,GWCP
EXTERN	CPOPJ,CPOPJ1
IFN DBMS,<
EXTERN	FINVOK,DBBUFH,DBONLY
IFE TOPS20,<
EXTERN	DBDEV,DBBLCK
>>
IFN MCS,<
EXTERN	CDLOC,CDNXT
>
EXTERN	NOIDHY,DEBSW
EXTERN	$LFPTR
;EXTERNAL DATA LOCATIONS OF INTEREST DURING COPY AND REPLACING

EXTERN	CPYLOC		;FIRST WORD OF COPY TABLE
EXTERN	CPYNXT		;NEXT FREE WORD IN COPY TABLE
EXTERN	CPYFLG		;STORE STATUS OF FLAGS BEFORE COPY
EXTERN	CPYCP		;CHARACTER POSITION OF WORD FOLLOWING COPY STATEMENT
EXTERN	CPYW2		;SAVE "W2" DURING COPY
EXTERN	EOLKAR		;END-OF-LINE CHARACTER FOR LAST LINE
EXTERN	ITEMCT		;TO SAVE "CT"

EXTERN	BLNKLN		;LINE NUMBER OF FIRST OF A SERIRS OF BLANKS
EXTERN	BLNKCP		;CHARACTER POSITION OF FIRST OF A SERIES OF BLANKS
EXTERN	SAVBCP		;TO SAVE BLNKCP
EXTERN	SAVBLN		;TO SAVE BLNKLN
EXTERN	SRCCOL		;INPUT COLUMN (SAME AS INPTCP UNLESS TABS)
EXTERN	INPTCP		;INPUT CHARACTER POSITION FOR SEQUENCED SOURCE
EXTERN	INPTST		;FIRST INPUT CHARACTER POSITION FOR ITEM
EXTERN	TERMQ		;CHARACTER DELIMITING ALPHA LITERAL
EXTERN	NOCONT		;IF -1, THEN CONTINUATION CARDS ARE ILLEGAL
EXTERN	NCPYSW		;IF -1, OUTPUT TO CPYFIL IS FORBIDDEN
EXTERN	PADCNT		;NO. OF SPACES NEEDED TO LINE UP COPY REPLACEMENT
EXTERN	PARCNT		;NO. OF PARENS SEEN DURING REPLACEMENT TEST
EXTERN	PICNXT		;[557] -1 WHEN NEXT DATUM IS, OR COULD BE, A PICTURE STRING
EXTERN	REGKAR		;A CHARACTER FROM SRCFIL, SAVED UPON ENTERING SETLIB
EXTERN	RPLFLG		;FLAGS STORED BEFORE COPY REPLACING
EXTERN	RPLLOC		;POINTER TO START OF REPLACEMENT LIST
EXTERN	RPLNXT		;POINTER TO NEXT REPLACEMENT ITEM
EXTERN	RPLNXW		;POINTER TO NEXT REPLACEMENT WORD
EXTERN	RPLCNT		;COUNT OF REPLACEMENTS
EXTERN	RPLBH		;REPLACEMENT "BUFFER HEADER" INFO
EXTERN	RPLCP		;STORE "CP" SO WE CAN BACK UP
EXTERN	RPLICP		;DITTO FOR "INPTCP"
EXTERN	RPLCST		;"INPTST" STORED ON FIRST REPLACEMENT
EXTERN	RPLBLK		;CURRENT LIBRARY BLOCK NUMBER
EXTERN	PSTBUF		;STORE PSEUDO-TEXT
EXTERN	SRCBFC		;BLOCK NUMBER OF INPUT SOURCE BUFFER
EXTERN	TERSCN		;[657] IF NON-ZERO TERMINATE SCAN IF CURRENT CHAR. MATCHES CONTENTS

EXTERN	SAVECH		;TERMINATING PUNCTUATION OF A WORD
EXTERN	SAVECP		;"CP" SAVED IN "GETCH"
EXTERN	SAVELN		;"LN" SAVED IN "GETCH"
EXTERN	SAVCP1		;"CP" SAVED IN "GETWRD"
EXTERN	SAVLN1		;"LN" SAVED IN "GETWRD"
EXTERN	SAVEWD		;TO SAVE "W1" & "W2"
EXTERN	WORDCP		;"CP" FOR FIRST CHARACTER OF DATUM
EXTERN	WORDLN		;"LN" FOR FIRST CHARCHTER OF DATAUM
;ITEMS TO BE SAVED BEFORE REPLACEMENT TEST (AT RPLSAV)
EXTERN	L1BH0		;RPLBLK
EXTERN	L1BH1		;LIBBH+1
EXTERN	L1BH2		;LIBBH+2
EXTERN	L1CPI		;INPTCP
EXTERN	L1CPO		;SAVECP

;ITEMS TO BE SETUP ON FIRST BLANK ON LINE (AT SVLKAR)
EXTERN	L2BH0		;RPLBLK
EXTERN	L2BH1		;LIBBH+1
EXTERN	L2BH2		;LIBBH+2
EXTERN	L2CPI		;INPTCP
EXTERN	L2CPO		;SAVECP

EXTERN	R1CPO
EXTERN	R1CPI

;ITEMS TO BE STORED JUST AFTER DATUM (AT CPLB40)
EXTERN	R2BH0
EXTERN	R2BH1
EXTERN	R2BH2
EXTERN	R2CPO
EXTERN	R2CPI

;ITEMS TO BE SAVED AT (SVSKAR)
EXTERN	R3BH0
EXTERN	R3BH1
EXTERN	R3BH2
EXTERN	R3CPO
EXTERN	R3CPI

;ITEMS TO BE SAVED AT (SVPKAR)
EXTERN	R4BH0
EXTERN	R4BH1
EXTERN	R4BH2
EXTERN	R4CPI
EXTERN	R4CPO


	END