Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/getitm.mac
There are 21 other files named getitm.mac in the archive. Click here to see a list.
; UPD ID= 3571 on 6/9/81 at 11:53 AM by NIXON                           
TITLE	GETITM FOR COBOL-68 & COBOL-74
SUBTTL	GET NEXT SOURCE WORD	AL BLACKINGTON/CAM/SEB/DMN



;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, 1981 BY DIGITAL EQUIPMENT CORPORATION


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


	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	GETLB9	;[1023]
	INTERN	SKPPGF,END2
IFN ANS74,<
	INTERN	FLG.LI,FLG.HI,FLG.H,FLG.NS	;FIPS FLAGGER ROUTINES
>

TWOSEG
RELOC	400000
SALL
;EDITS
;NAME	DATE		COMMENTS

;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
IFN ANS74,<
	SKIPE	FLGSW		;FIPS FLAGGER?
	PUSHJ	PP,GITM3B	;YES, SEE IF LEGAL FIG-CON
>
IFN ANS68,<
	CAIN	CT,TALLY	;NO--TALLY?
	JRST	GTITM5		;YES
>
IFN FT68274,<
	CAIN	CT,TODAY
	EWARNW	E.775
>
	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:
IFN ANS74,<
	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

IFN ANS74,<
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
IFN ANS74,<
	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,DATAN.	;DATAB?
	JRST	GITM4A		;YES

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

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


IFN ANS68,<;TALLY
GTITM5:	MOVEI	CT,DATAN.	;PRETEND IT'S A DATA-NAME
	TLO	W1,GWFIGC	;BUT TURN ON "FIG. CONST." ANYWAY
IFN FT68274,<
	SETZM	CVTTLY##	;SIGNAL TALLY IS REQUIRED
>
	JRST	GTITM2
>

;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)	;DEVICE-NAME?
	TLNN	TE,MTCONS
	MOVEI	CT,SPECN.	;NO
	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,[POINT 15,0(TA),17]; 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!TCS,<
	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,[POINT 15,0(TA),17]
	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
IFN  ANS74,<
	CAIN	TA,66		;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,PTCRF9
	IDPB	CH,CRFBHO+1

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

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

	POPJ	PP,

PTCRF9:	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
IFN FT68274,<
	SETZM	CVTRWM		;THIS IS A NEW WORD NOW
>
	JRST	GTWD1B
;SCAN THE NEXT WORD  (CONT'D).
;INITIALIZE.

GETWD1:	TSWTZ	FNEEDS		;TURN OFF "SPACE NEEDED"
	JRST	GTWD1B
IFN BIS,<
	DMOVEM	LN,SAVBLN
>
IFE BIS,<
	MOVEM	LN,SAVBLN
	MOVEM	CP,SAVBCP
>

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

	PUSHJ	PP,GETCH	;GET NEXT CHARACTER

	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

IFN BIS,<
	DMOVEM	LN,WORDLN
>
IFE BIS,<
	MOVEM	LN,WORDLN
	MOVEM	CP,WORDCP
>
	SWOFF	FNEEDS;

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

GTWD1C:	MOVE	CT,INPTCP
	MOVEM	CT,INPTST

	SETZB	CT,LC		;CLEAR COUNTERS
	SETZM	SAVBLN
IFN BIS,<
	DMOVE	PB,[POINT 7,LITVAL
		    POINT 6,NAMWRD]
>
IFE BIS,<
	MOVE	PB,[POINT 7,LITVAL]
	MOVE	PA,[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:	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
;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,^D120	; [213] NO--TOO BIG?
	AOJA	CT,GTWD7B	;NO--INCREMENT AND JUMP

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

GTWD7B:	CAIGE	CH,140
	CAIGE	CH,40
	TLO	W1,GWASCI
	IDPB	CH,PB
	JRST	GETWD7
;CLOSING QUOTE FOUND

GETWD8:
IFN ANS74,<
	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,^D120	; [213] LIMIT LITERAL SIZE
	MOVEI	CT,^D120	; [213] TO 120 CHARS
	SWOFF	FALIT		;CLOSING QUOTE SEEN
IFN BIS,<
	DMOVEM	LN,SAVBLN	;UPDATE PTRS TO END OF LITERAL
>
IFE BIS,<
	MOVEM	LN,SAVBLN	;UPDATE PTRS TO END OF LITERAL
	MOVEM	CP,SAVBCP
>
	PUSHJ	PP,GTWD18
	JRST	ENDLIT
;CONTINUATION COLUMN WHEN SCANNING NON-NUMERIC LITERAL

GETWD9:	CAIE	CH," "		;SPACE?
	JRST	GTWD9B		;NO
IFN BIS,<
	DMOVE	LN,WORDLN
>
IFE BIS,<
	MOVE	LN,WORDLN
	MOVE	CP,WORDCP
>
	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
IFN BIS,<
	DMOVEM	LN,SAVLN1	;SAVE LINE NUMBER AND CHARACTER POSITION
>
IFE BIS,<
	MOVEM	LN,SAVLN1	;SAVE LINE NUMBER AND
	MOVEM	CP,SAVCP1	;	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:
IFN BIS,<
	DMOVE	LN,SAVLN1
>
IFE BIS,<
	MOVE	LN,SAVLN1
	MOVE	CP,SAVCP1
>
	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:
IFN BIS,<
	DMOVE	LN,SAVLN1
>
IFE BIS,<
	MOVE	LN,SAVLN1
	MOVE	CP,SAVCP1
>
	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:
IFN BIS,<
	DMOVE	LN,SAVLN1
>
IFE BIS,<
	MOVE	LN,SAVLN1
	MOVE	CP,SAVCP1
>
	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
IFN BIS,<
	DMOVE	LN,SAVLN1
>
IFE BIS,<
	MOVE	LN,SAVLN1
	MOVE	CP,SAVCP1
>
	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:
IFN ANS74,<
	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
	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
IFN BIS,<
	DMOVEM	LN,SAVLN1	;SAVE LOCATION
>
IFE BIS,<
	MOVEM	LN,SAVLN1	;SAVE
	MOVEM	CP,SAVCP1	;  LOCATION
>
	POPJ	PP,

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

IFN BIS,<
	DMOVEM	W1,SAVEWD	;SAVE THAT WORD
>
IFE BIS,<
	MOVEM	W1,SAVEWD	;SAVE THAT WORD
	MOVEM	W2,SAVEWD+1
>
	MOVE	CT,ITEMCT
	MOVEM	CT,SAVEWD+2

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

SETPN0:
IFN ANS74,<
 IFN BIS,<
	DMOVE	LN,SAVLN1
 >
 IFE BIS,<
	MOVE	LN,SAVLN1
	MOVE	CP,SAVCP1
 >
	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:
IFN BIS,<
	DMOVE	LN,SAVLN1
>
IFE BIS,<
	MOVE	LN,SAVLN1
	MOVE	CP,SAVCP1
>
SETPN2:	DPB	LN,GWLN
	DPB	CP,GWCP
IFN BIS,<
	DMOVEM	LN,WORDLN
>
IFE BIS,<
	MOVEM	LN,WORDLN
	MOVEM	CP,WORDCP
>
	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:	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:
IFN FT68274,<
	PUSHJ	PP,CVT74	;SEE IF ITS A NEW COBOL-74 RESERVED WORD
>
	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:
IFN BIS,<
	DMOVE	LN,WORDLN	;SET "LN" & "CP"
>
IFE BIS,<
	MOVE	LN,WORDLN	;SET "LN"
	MOVE	CP,WORDCP	;SET "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
IFN FT68274,<
	PUSHJ	PP,CVTSBP	;SAVE POINTER TO CVT LINE BUFFER
>
	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
IFN BIS,<
	DMOVEM	LN,SAVBLN	;SAVE LOCATION OF THE BLANK
>
IFE BIS,<
	MOVEM	LN,SAVBLN	;SAVE LOCATION OF THE BLANK
	MOVEM	CP,SAVBCP
>
	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,"-"		;IS CONTINUATION COLUMN A HYPHEN?
	JRST	GETK5		;NO--ERROR
IFN ANS74,<
	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

	CAIGE	CP,CPMAXN	;NO, TOO MANY CHARACTERS?
	JRST	GETCH5		;NO

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

GETCH1:	PUSHJ	PP,GETSRC	;GET NEXT ONE
	CAIE	CH,$LF		;END OF LINE?
	CAIN	CH,$FF
	JRST	FINLIN		;YES
	JRST	GETCH1		;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

;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
;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,<
	SKIPN	FINVOK
	JRST	.+3
	LDB	CH,DBBUFH+1
	SKIPA
	>
	LDB	CH,SRCBH+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
IFN FT68274,<
	PUSHJ	PP,CVTICL	;INITIALIZE CONVERSION LINE BUFFER
	JRST	GETSQ1
>

;START A NEW SOURCE LINE

GETSEQ:
IFN FT68274,<
	PUSHJ	PP,CVTOAL	;OUTPUT A LINE TO CVT FILE
GETSQ1:>
	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
IFN FT68274,<
	MOVEM	TD,CVTLBF	;STORE SEQ NUMBER (I.E. BIT 35)
>
	MOVEI	TD,6		;[526] NO REGULAR SEQUENCE NUMBER
	JRST	GETSQ8

GETSQ2:	CAIE	CH,"-"		;CONTINUATION?
	JRST	GETSQ3		;NO
IFN ANS74!FT68274,<
	SKIPE	NOIDHY##		;ARE THEY ALLOWED HERE
	JRST	[MOVEI	DW,E.700	;NOT IN ID, GIVE ERROR
IFE FT68274,<
		PUSHJ	PP,FATAL
>
IFN FT68274,<
		PUSHJ	PP,WARN
>
		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
IFN ANS74,<
	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

IFN ANS74,<
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

	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:
IFN FT68274,<
	JUMPE	CH,GETSL0	;IGNORE NULS
	SOSGE	CVTBFC##	;MAKE SURE THERE IS ROOM IN LINE BUFFER
	JRST	[OUTSTR	[ASCIZ	/68274 - source line too long to convert/]
		JRST	GETSL0]
	IDPB	CH,CVTBFP##	;STORE CURRENT CHARACTER
GETSL0:>
	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
	SOSGE	DBBUFH+2	;MORE CHARACTERS?
	JRST	IN.INP		;NO, GET ANOTHER BUFFER
IN.GT2:	ILDB	CH,DBBUFH+1	;GET CHARACTER
	JRST	GETSL		;RETURN AS NORMAL
IN.INP:	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

IN.EOF:	SETZM	FINVOK		;CLEAR INVOKE FLAG
	SETZM	DBBLCK		;[316]
	RENAME	DBCHAN,DBBLCK	;[316]
	CLOSE	DBCHAN,		;NOT REALLY NECESSARY
	RELEASE	DBCHAN,
	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:	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
	RELEASE	LIB,
	SKIPE	CREFSW
	CLOSE	CRF,
GTSR3B:	MOVEI	CH,7		;[352]
	MOVEM	CH,SRCCOL
				;RETURN A LINE-FEED

GTBLNK:	MOVEI	CH,$LF
	POPJ	PP,


;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
	JRST	SKPSR4

	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
IFN ANS74,<
	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	PUSHJ	PP,FLG.LI	;YES, TEST AT LOW-INTERMEDIATE LEVEL
>
IFN FT68274,<
	PUSHJ	PP,CVTCTC	;TURN COPY INTO COMMENT
>
	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
	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
IFN ANS74,<
	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]
	MOVE	TC,[POINT 6,NAMWRD]
CPLB51:	ILDB	TD,TB
	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
	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
CPLB52:	SOJG	TA,CPLB51	;PUT LITERAL IN NAMWRD

CPLB55:	HRRZ	TB,NAMWRD+1	;TEST FOR TOO MANY CHARACTERS
	SKIPE	TB
	EWARNW	E.650		;TOO MANY, WARN USER
	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:	CAMN	TA,DEVFIL(TC)	;SEE IF FILE NAME MATCH
	CAME	TB,DEVEXT(TC)	;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

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

CPLB53:	SOJLE	TA,CPLB5X	;ERROR
	PUSHJ	PP,CPLBPP	;GET LHS
	SKIPN	TC
	HLRZ	TC,MYPPN##	;GET DEFAULT
	HRLZM	TC,LIBPP
	CAIE	TD,","		;MUST BE COMMA
	JRST	CPLB5X		;ERROR
	PUSHJ	PP,CPLBPP	;GET RHS
	SKIPN	TC
	HRRZ	TC,MYPPN
	HRRM	TC,LIBPP
	CAIN	TD,"]"		;DID IT END CORRECTLY?
	JRST	CPLB55		;YES
IFE TOPS20,<
	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:	OUTSTR	[ASCIZ /%Illegal file speciffication for /]
	PUSHJ	PP,STLB30
	OUTSTR	[ASCIZ / - continuing
/]
	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
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
	JRST	CPLB0		;SEE WHATS NEXT
CPLB1:	CAIE	TYPE,REPLA.	;IS IT 'REPLACING'?
	JRST	CPE286		;NO, ERROR
IFN ANS74,<
	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'
	TLNE	W1,GWRESV	;RESERVED WORD?
	CAIE	TYPE,EQUAL.	;YES, =
	JRST	CPLB21		;NO
	CAIE	CH,"="		;LOOK AHEAD AND CHECK NEXT DELIMITER  FOR ==
	JRST	CPLB21		;ITS NOT
	PUSHJ	PP,GETITM	;GET RID OF ==
	CAIN	TYPE,EQUAL.
	JRST	CPLB20
	EWARNW	E.605		;[557] '==' PSEUDO-TEXT DELIMITERS INCORRECT
	JRST	CPYERR		;[557] 

CPLB19:	PUSHJ	PP,PSTWRI	;WRITE ITEM
CPLB20:	CAIN	TYPE,PIC.	;PICTURE IS SPECIAL
	PUSHJ	PP,PSTPIC
	PUSHJ	PP,GETITM	;GET NEXT ITEM
	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,
	IDPB	TC,TB		;REPLACE = BY NULL
	IDPB	TC,TB
	PUSHJ	PP,GETITM	;BYPASS ==
	PUSHJ	PP,GETITM	;GET WHAT FOLLOWS ==
	JRST	CPLB45

CPLB36:
IFN BIS,<
	DMOVE	LN,R1LNO	;[1013] GET LN & CP OF INITIAL ==
>
IFE BIS,<
	MOVE	LN,R1LNO	;[1013] GET LINE NUMBER
	MOVE	CP,R1CPO	;[1013] AND CP OF INITIAL ==
>
	MOVEI	DW,E.633	;[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
	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
IFN BIS,<
	DMOVE	TC,SRCBH+1
	DMOVEM	TC,RPLBH+1
>
IFE BIS,<
	MOVE	TC,SRCBH+1
	MOVE	TB,SRCBH+2
	MOVEM	TC,RPLBH+1
	MOVEM	TB,RPLBH+2
>
	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.
	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
	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
	USETI	LIB,(TE)
	IN	LIB,
PSTR4A:	  SKIPA	TE,L2BH1	;OK
	JRST	GETLB9
	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
	USETI	LIB,(TE)	;NO, RESET ON OLD BLOCK
	IN	LIB,
PSTR10:	  SKIPA	TE,RPLBH+1	;OK, GET BYTE PTR
	JRST	GETLB9		;ERROR
	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

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
	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
;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
IFN FT68274,<
	CAIE	CH,$LF		;THERE ARE NO CARRIAGE-RETURNS IN LIB FILE
	CAIN	CH,$FF		;SO CHECK FOR LINE-FEED & FORM-FEED
	CAIA			;YES
	JRST	GETSL		;NO
	PUSH	PP,CH		;YES, SAVE IT
	LDB	CH,CVTBFP	;GET LAST CHAR
	CAIN	CH,$CR		;JUST IN CASE IT WAS
	JRST	GETLB6		;IT WAS
	MOVEI	CH,$CR
	SOSL	CVTBFC		;IF THIS FAILS SO WILL $LF
	IDPB	CH,CVTBFP	;STORE $CR
GETLB6:	POP	PP,CH		;RESTORE $LF OR $FF
>
	JRST	GETSL

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

	GETSTS	LIB,CH		;END-FILE?
	TRNE	CH,IO.ERR
	JRST	GETLB9		;NO--TROUBLE

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

GETLB9:	MOVEI	CH,LIBDEV	;ERROR ON LIBRARY DEVICE
	JRST	DEVDED

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,

GETCP4:	SWOFF	FCOPY		;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.
	CAIN	CH,$LF		;[1064] Is the next char. a line-feed?
;	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.
	 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

	SKIPN	SRCDEV		;[352] ANY MORE SOURCE CHARS?
	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
IFN FT68274,<
	PUSHJ	PP,CVTCRL	;ADD CR-LF TO CURRENT LINE
	PUSHJ	PP,CVTOAL	;OUTPUT LINE CONTAINING COPY VERB
	PUSHJ	PP,CVTDPL	;REALLY PUT IT OUT
	MOVE	TD,[POINT 7,CPLCV1]	;COPY MESSAGE
	PUSHJ	PP,CVTTPL	;TO PREVIOUS LINE BUFFER
	MOVE	TD,CVTPLB	;SEE IF SOS LINE NO.
	TRNN	TD,1
	SETZ	TD,		;NO
	MOVEM	TD,CVTSEQ##	;STORE SEQ NO. OR ZERO
	SETZM	CVTCCF		;STOP COMMENTING THIS
	SETZM	CVTCAL		; AND ALL FUTURE LINES
>
	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
	LSHC	TC,-6
	TRZ	TB,-1
	LSH	TB,-1

	MOVE	TA,LIBBH+1	;SET TA TO POINT TO ROUGH-TABLE
IFN BIS,<
	DMOVE	TE,1(TA)	;COMPARE LIBNAM TO FIRST ENTRY
>
IFE BIS,<
	MOVE	TE,1(TA)	;COMPARE LIBNAM TO FIRST ENTRY
	MOVE	TD,2(TA)
>
	PUSHJ	PP,SETLBC
	  CAIA			;EQUAL
	  JRST	SETLB4		;GREATER
	MOVEI	TE,2		;LESS
	JRST	SETL5A

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
;SEARCH  ROUGH-TABLE

SETLB4:	ADDI	TA,2
IFN BIS,<
	DMOVE	TE,1(TA)
>
IFE BIS,<
	MOVE	TE,1(TA)
	MOVE	TD,2(TA)
>
	PUSHJ	PP,SETLBC
	  JRST	SETLB5
	  JRST	SETLB4
	SKIPA	TE,0(TA)	;ITEM FOUND--GET ADDRESS

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

;AN APPROPRIATE ROUGH-TABLE ENTRY HAS BEEN LOCATED.

SETL5A:	USETI	LIB,(TE)	;READ IN FINE-TABLE
	IN	LIB,
	  SKIPA	TA,LIBBH+1	;SET UP AN IOWD TO FINE TABLE
	JRST	SETLBE		;[655] ERROR
	HRLI	TA,-^D64

;SEARCH THE FINE TABLE

SETLB6:
IFN BIS,<
	DMOVE	TE,1(TA)
>
IFE BIS,<
	MOVE	TE,1(TA)
	MOVE	TD,2(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
	USETI	LIB,(TE)
	IN	LIB,
	  AOSA	LIBBH+2
	JRST	SETLBE		;[655] ERROR
	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:	OUTSTR	[ASCIZ "%Library file "]
	PUSHJ	PP,STLB30	;PRINT DEV:FILE.EXT
	OUTSTR	[ASCIZ " not found - continuing
"]
	MOVEI	DW,E.75
	MOVE	CP,LIBHDR	;[557] GET LIBRARY NAME
	CAME	CP,['LIBARY']	;[557] JUST THE DEFAULT
	MOVEI	DW,E.607	;[557] NO, THEREFORE WE FAILED TO FIND IT
	JRST	STLB29

;PROGRAM NOT FOUND

STLB21:	OUTSTR	[ASCIZ "%Library routine "]
	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
	OUTSTR	[ASCIZ " in "]
	PUSHJ	PP,STLB30	;PRINT DEV:FILE.EXT
	OUTSTR	[ASCIZ " not found - continuing
"]
	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:	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
	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"
IFN FT68274,<
	PUSHJ	PP,CVTDPL	;DUMP LINE CONTAINING COPY TEXT
	SKIPN	TE,CVTSEQ	;DO WE NEED TO FAKE UP A SOS LINE NO.?
	JRST	CLRCPZ		;NO
	MOVEM	TE,CVTPLB	;STORE NO.
	MOVSI	TE,(ASCII /	/)
	MOVEM	TE,CVTPLB+1	;ALSO TAB AS SIXTH CHAR
CLRCPZ:	MOVE	TD,[POINT 7,CPLCV2]	;COPY MESSAGE
	PUSHJ	PP,CVTTPL	;TO PREVIOUS LINE BUFFER
	SETOM	CVTCPF		;MAKE A COMMENT
	SETZM	CVTSEQ		;TURN OFF GENERATING SOS LINE NUMBERS
>
	POPJ	PP,		;RETURN

IFN FT68274,<
CPLCV1:	ASCIZ	/***** Start of copy library text *****
/

CPLCV2:	ASCIZ	/***** End of copy library text *****  
/
>
SUBTTL	FIPS FLAGGER TESTS

IFN ANS74,<
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
>
SUBTTL	CONVERSION OF COBOL-68 TO COBOL-74 SUBROUTINES

IFN FT68274,<

INTERN	CVTICL,CVTCCL,CVTDPL,CVTDCW,CVTSBP,CVTCTC,CVTUTC,CVTVTC,CVTRCW,CVTBCW,CVTACW,CVTICW,CVTTPL

;OUTPUT THE LINE IN THE PREVIOUS BUFFER
;COPY THE CURRENT BUFFER TO PREVIOUS AND INIT THE BUFFER

CVTOAL:	SKIPE	CVTPLB##	;ANYTHING IN LAST LINE BUFFER
	PUSHJ	PP,CVTDPL	;YES, DUMP PREVIOUS LINE
	PUSHJ	PP,CVTCCL	;COPY CURRENT LINE TO PREVIOUS LINE
	SKIPE	CVTCAL##	;ARE ALL LINES COMMENTS?
	SETOM	CVTCCF##	;YES
;	JRST	CVTICL		;INITIALIZE CONVERSION LINE BUFFER

;INITIALIZE CURRENT LINE BUFFER

CVTICL:	MOVEI	TD,^D132	;INITIALIZE LINE BUFFER
	MOVEM	TD,CVTBFC##
	MOVE	TD,[POINT 7,CVTLBF##]
	MOVEM	TD,CVTBFP##
	POPJ	PP,

;ADD CR-LF TO CURRENT LINE.

CVTCRL:	MOVEI	CH,$CR		;ADD CR-LF TO CURRENT LINE
	SOSL	CVTBFC
	IDPB	CH,CVTBFP
	MOVEI	CH,$LF
	SOSL	CVTBFC
	IDPB	CH,CVTBFP
	POPJ	PP,

;COPY CURRENT LINE BUFFER TO PREVIOUS LINE BUFFER

CVTCCL:	SETZ	TD,
	IDPB	TD,CVTBFP	;MAKE SURE LINE ENDS IN NULL
	MOVE	TD,[CVTLBF,,CVTPLB]
	BLT	TD,CVTPLB##+CVTLBZ##-1
	MOVE	TD,[CVTLBF,,CVTLBF+1]
	SETZM	CVTLBF
	BLT	TD,CVTLBF+CVTLBZ-1	;CLEAR LINE BUFFER
	SETOM	CVTPLF##	;SIGNAL PREVIOUS LINE HAS VALID DATA
	MOVE	TD,CVTCCF##	;COPY CURRENT COMMENT FLAG
	MOVEM	TD,CVTCPF##	;TO PREVIOUS LINE
	SETZM	CVTCCF
	MOVE	TD,CVTCXC##	;COPY EXTRA CHARACTER COUNT
	MOVEM	TD,CVTPXC##
	SETZM	CVTCXC
	SKIPN	CVTXLC##	;DO WE NEED TO GENERATE EXTRA LINES?
	POPJ	PP,		;NO
	PUSHJ	PP,CVTDPL	;YES, MAKE ROOM FOR IT
	MOVE	TD,CVTXLC	;GET CODE
	SETZM	CVTXLC		;ONLY ONCE PER SETTING
	JRST	@[CVTWSL]-1(TD)	;DISPATCH

CVTWSL:	MOVEM	LN,CVTTLY	;LINE NUMBER OF GENERATED TALLY
	SOS	CVTTLY		;BACKUP TO POINT TO WORKING-STORAGE
	MOVE	TD,[POINT 7,CVTWSM]
	PJRST	CVTTPL		;COPY TEXT TO PREVIOUS LINE

CVTWSM:	ASCIZ	/01	TALLY	PIC S9(5).
/

;HERE TO COPY TEXT POINTED TO BT TD INTO PREVIOUS LINE BUFFER

CVTTPL:	PUSH	PP,CH
	TSWF	FSEQ		;/S SEQ NO.?
	JRST	CVTTP2		;YES
	MOVE	TE,CVTPLB	;SEE IF SOS SEQ. NO.
	TRNE	TE,1
	JRST	CVTTP3		;YES
	SKIPA	TE,[POINT 7,CVTPLB]
CVTTP1:	IDPB	CH,TE
CVTTP6:	ILDB	CH,TD
	JUMPN	CH,.-2
	IDPB	CH,TE		;STORE 1 NULL TO END LINE
	POP	PP,CH
	POPJ	PP,

CVTTP2:	MOVE	TE,[ASCII /     /]	;WE NEED 6 BLANKS, FIVE ARE HERE
	MOVEM	TE,CVTPLB	;STORE THE LINE NO.
	MOVE	TE,[POINT 7,CVTPLB+1]
	MOVEI	CH," "		;HERE IS NO. 6
	IDPB	CH,TE
	MOVE	CH,TD		;SEE IF WE WANT AREA "A" OR "B"
	ILDB	CH,CH		;GET FIRST CHAR OF TEXT LINE
	CAIN	CH,"*"		;IS IT A COMMENT LINE
	JRST	CVTTP6		;YES, START IN COL 7.
	CAIE	CH,$HT		;AREA "B" IF TAB
	JRST	CVTTP5		;AREA "A"
	MOVE	CH,[ASCII /     /]	;5 MORE SPACES
	MOVEM	CH,CVTPLB+1	;COL 6 THRU COL 10
	IBP	TD		;BYPASS TAB
	MOVE	TE,[POINT 7,CVTPLB+2]
CVTTP5:	MOVEI	CH," "		;HERE IS COL 7 OR 11
	JRST	CVTTP1

CVTTP3:	PUSH	PP,TD
	PUSHJ	PP,ASCIAD	;CREATE A NEW LINE NO.
	POP	PP,TD
CVTTP4:	MOVEM	TE,CVTPLB	;STORE THE LINE NO.
	MOVE	TE,[POINT 7,CVTPLB+1]
	MOVEI	CH,$HT		;HERE IS THE SIXTH CHAR.
	JRST	CVTTP1

;REPLICATE CURRENT LINE BUFFER IN PREVIOUS LINE BUFFER

CVTRCP:	MOVE	TD,[CVTLBF,,CVTPLB]
	BLT	TD,CVTPLB##+CVTLBZ##-1
	MOVE	TD,CVTSCP	;CREATE A BYTE POINTER TO PREVIOUS BUFFER
	JRST	CVTRPL

CVTRCL:	MOVE	TD,[CVTLBF,,CVTPLB]
	BLT	TD,CVTPLB##+CVTLBZ##-1
	MOVE	TD,CVTBFP	;CREATE A BYTE POINTER TO PREVIOUS BUFFER
CVTRPL:	PUSHJ	PP,CVTEPl	;Make sure line ends correctly
	SETOM	CVTPLF##	;SIGNAL PREVIOUS LINE HAS VALID DATA
	MOVE	TD,CVTCCF##	;COPY CURRENT COMMENT FLAG
	MOVEM	TD,CVTCPF##	;TO PREVIOUS LINE
	MOVE	TD,CVTCXC##	;COPY EXTRA CHARACTER COUNT
	MOVEM	TD,CVTPXC##
	POPJ	PP,		;NO

;DUMP PREVIOUS LINE BUFFER TO CVT FILE

CVTDPL:	SKIPN	CVTPLF		;ANYTHING THERE?
	POPJ	PP,		;NO
	PUSH	PP,CH
	MOVE	TD,[POINT 7,CVTPLB]
	MOVE	CH,CVTPLB	;GET FIRST WORD
	TRNE	CH,1		;IN CASE SOS LINE NUMBERS
	JRST	CVTDP1		;YES, WORRY ABOUT BIT 35
	SKIPE	CVTSEQ		;DO WE NEED TO ADD SOS LINE NUMBERS?
	PUSHJ	PP,CVTDP7	;YES
	SKIPN	CVTCPF		;DO WE NEED TO COMMENT IT?
	JRST	CVTDP3		;NO
	TSWT	FSEQ		;/S SEQUENCED?
	JRST	CVTDP2		;NO
	LDB	CH,[POINT 7,CVTPLB+1,13]	;GET COL 7
	CAIE	CH,"*"		;ALREADY A COMMENT
	CAIN	CH,"/"		;...
	JRST	CVTDP3		;YES
	MOVEI	CH,"*"		;NO
	DPB	CH,[POINT 7,CVTPLB+1,13]
	JRST	CVTDP3		;IT IS NOW

CVTDP1:	SKIPN	TE,CVTSEQ	;DO WE NEED TO GENERATE LINE NO.?
	JRST	CVTDP9		;NO
	PUSHJ	PP,ASCIAD	;YES, ADD 1 TO CURRENT
	MOVEM	TE,CVTSEQ	;AND STORE IT
	MOVEM	TE,CVTPLB	;ALSO CHANGE CURRENT
	MOVE	CH,TE
CVTDP9:	PUSHJ	PP,CVTDCH	;MAKE SURE THERE IS ROOM FOR NEXT WORD
	MOVEM	CH,@BINBH+1	;NOW STORE FULL WORD
	MOVE	TD,[POINT 7,CVTPLB+1]
REPEAT 4,<
	IBP	BINBH+1
	SOS	BINBH+2
>
	ILDB	CH,TD		;GET CHAR AFTER LINE NUMBER
	PUSHJ	PP,CVTDCH	;STORE ALSO
	SKIPN	CVTCPF		;DO WE NEED TO COMMENT IT?
	JRST	CVTDP3		;NO
CVTDP2:	MOVE	CH,TD		;COPY POINTER TO FIRST CHAR
	ILDB	CH,CH		;GET FIRST CHAR
	CAIE	CH,"*"		;IS IT ALREADY A COMMENT LINE?
	SKIPA	CH,["*"]	;NO, PUT OUT A COMMENT FIRST
CVTDP3:	ILDB	CH,TD
	JUMPE	CH,CVTDP4	;COPY UNTIL TERMINAL NULL IS FOUND
	PUSHJ	PP,CVTDCH	;DUMP CHARACTER
	JRST	CVTDP3

CVTDCH:	SOSGE	BINBH##+2	;USUAL LOOP
	JRST	CVTDPW		;BUFFER FULL
	IDPB	CH,BINBH+1
	POPJ	PP,

CVTDPW:	OUT	BIN,
	  JRST	CVTDCH		;OK
	MOVEI	CH,BINDEV##
	JRST	DEVDED##

CVTDP4:	SKIPN	TD,CVTSEQ	;ALWAYS IF WE GENERATED SOS LINE NUMBERS
	MOVE	TD,CVTPLB	;GET FIRST WORD
	TRNN	TD,1		;SOS LINE NUMBERS?
	JRST	CVTDP6		;NO
	SETZ	CH,
CVTDP5:	MOVE	TD,BINBH+1
	TLNN	TD,760000	;ON LAST BYTE IN WORD?
	JRST	CVTDP6		;YES
	PUSHJ	PP,CVTDCH	;NOT YET
	JRST	CVTDP5

CVTDP6:	POP	PP,CH
	POPJ	PP,

;HERE TO ADD SOS LINE NUMBER TO LIBRARY SOURCE

CVTDP7:	MOVE	TE,CVTSEQ	;GET CURRENT LINE NO.
	PUSHJ	PP,ASCIAD	;ADD 1 TO IT
	MOVEM	TE,CVTSEQ	;AND STORE IT
	MOVE	CH,TE
	PUSHJ	PP,CVTDCH	;MAKE SURE THERE IS ROOM FOR NEXT WORD
	MOVEM	CH,@BINBH+1	;NOW STORE FULL WORD
	AOS	BINBH+1		;ACCOUNT FOR LINE NUMBER
	MOVNI	TE,5		;AND FIVE CHARS.
	ADDB	TE,BINBH+2	;WE HAVE NOW ACCOUNTED FOR ALL SIX CHARS.
	MOVE	TD,[POINT 7,CVTPLB]
	MOVEI	CH,$HT		;GET SIXTH CHAR
	JUMPL	TE,CVTDCH	;BUFFER IS EMPTY, DUMP AND RETURN
	DPB	CH,BINBH+1	;DUMP THE CHAR
	POPJ	PP,		;AND RETURN

;HERE TO DELETE CURRENT WORD (IN NAMWRD) FROM CVT FILE

	INTER.	CV3.
CV3.:				;DELETE THE CURRENT WORD

CVTDCW:	LDB 	TE,CVTBFP	;GET CURRENT CHAR
	MOVE	TC,CVTSCP	;POINTER TO START OF WORD TO DELETE
	DPB	TE,TC		;STORE OVER FIRST CHAR
	MOVEI	TD," "		;NOW FILL WITH SPACES
	ILDB	TE,TC
	DPB	TD,TC		;STORE OVER
	JUMPN	TE,.-2		;NOT YET DONE
	MOVE	TE,CVTSCP	;POINTER TO START OF WORD DELETED
	MOVEM 	TE,CVTBFP	;MAKE IT CURRENT POINTER
	MOVEM	TE,CVTSNP	;AND MOVE NEXT WORD POINTER BACK ALSO
	POPJ	PP,

;HERE TO SAVE POINTER TO CURRENT CHAR IN CVT BUFFER

CVTSBP:	PUSH	PP,CVTSNP##	;GET POINTER TO NEXT WORD FROM LAST TIME
	POP	PP,CVTSCP##	;SAVE IT AS NOW CURRENT
	PUSH	PP,CVTBFP##	;GET POINTER
	POP	PP,CVTSNP	;SAVE IT FOR NEXT TIME
	POPJ	PP,
;HERE TO REPLACE THE CURRENT WORD WITH SOMETHING ELSE
;TA = ADDRESS OF STRING TO BE REPLACED
;TB = ADDRESS OF STRING TO REPLACE IT

CVTRCW:	HRLI	TA,(POINT 7,)	;FORM BYTE POINTER
	HRLI	TB,(POINT 7,)
	PUSHJ	PP,CVTCCW	;SEE WHICH LINE CURRENT WORD IS IN
	  JRST	CVTRWP		;ITS IN PREVIOUS LINE
	ILDB	TD,TA		;GET FIRST CHARACTER TO REPLACE
	SKIPA	TC,CVTSCP##	;GET POINTER TO CURRENT WORD IN CVT BUFFER
CVTRC1:	IBP	TC		;ADVANCE TO NEXT BYTE
	LDB	TE,TC		;MAKE SURE WE'RE WHERE WE SHOULD BE
	JUMPE	TE,CVTRC7	;SHOULD NEVER HAPPEN
	CAIE	TE,(TD)
	CAIN	TE,"a"-"A"(TD)	;JUST TO BE SAFE
	TRNA			;OK
	JRST	CVTRC1		;NOT YET
	ILDB	TE,TB
	DPB	TE,TC		;REPLACE FIRST CHAR
CVTRC2:	ILDB	TE,TA		;ANYTHING LEFT IN SOURCE
	JUMPE	TE,CVTRC3	;NO
	ILDB	TE,TB		;GET REPLACEMENT CHARACTER
	JUMPE	TE,[HALT]	;SMALLER
	IDPB	TE,TC
	JRST	CVTRC2		;LOOP FOR EQUAL LENGTH PART

;HERE TO INSERT SOMETHING BEFORE THE CURRENT WORD
;BASICALY THE SAME AS CVTRCW
;TA = ADDRESS OF STRING OF CURRENT WORD
;TB = ADDRESS OF STRING TO INSERT

CVTBCW:	HRLI	TA,(POINT 7,)	;FORM BYTE POINTER
	HRLI	TB,(POINT 7,)
	PUSHJ	PP,CVTCCW	;SEE WHICH LINE CURRENT WORD IS IN
	  JRST	CVTRWP		;ITS IN PREVIOUS LINE
	ILDB	TD,TA		;GET FIRST CHARACTER TO REPLACE
	SKIPA	TC,CVTSCP##	;GET POINTER TO CURRENT WORD IN CVT BUFFER
CVTBC1:	IBP	TC		;ADVANCE TO NEXT BYTE
	LDB	TE,TC		;MAKE SURE WE'RE WHERE WE SHOULD BE
	JUMPE	TE,CVTRC7	;SHOULD NEVER HAPPEN
	CAIE	TE,(TD)
	CAIN	TE,"a"-"A"(TD)	;JUST TO BE SAFE
	JRST	CVTRC3		;OK, WE'RE POINTING AT CURRENT WORD
	JRST	CVTBC1		;NOT YET

;HERE TO INSERT SOMETHING AFTER THE CURRENT WORD
;TA = UNDEFINED
;TB = ADDRESS OF STRING TO INSERT

CVTACW:	HRLI	TB,(POINT 7,)
	SKIPA	TC,CVTSNP##	;GET POINTER TO NEXT WORD IN CVT BUFFER
CVTAC1:	IBP	TC		;ADVANCE TO NEXT BYTE
CVTAC2:	LDB	TE,TC		;MAKE SURE WE'RE WHERE WE SHOULD BE
	JUMPE	TE,CVTRC7	;SHOULD NEVER HAPPEN
	CAIN	TE," "		;SHOULD NOT BE A BLANK
	JRST	CVTAC1		;NOT YET
REPEAT 0,<
	PUSH	PP,TE		;SAVE FIRST CHAR OF NEXT WORD
	ILDB	TE,TB		;GET FIRST REPLACEMENT CHAR
	DPB	TE,TC		;STORE OVER FIRST CHAR
	PUSHJ	PP,CVTRC3	;INSERT NEW WORDS
	POP	PP,TE		;GET BACK FIRST CHARACTER
	SOS	CVTBFC		;COUNT ONE FOR IT
	IDPB	TE,CVTBFP	;STORE IT AFTER INSERTED TEXT
	IBP	CVTSNP		;INCREMENT START OF NEXT WORD
	AOS	CVTCXC
	POPJ	PP,
>
REPEAT 4,<IBP	TC>		;ADVANCE 4 BYTES
	SOJA	TC,CVTRC3	;BACKUP 1 WORD, I.E. BACKUP 1 BYTE

;HERE TO INSERT SOMETHING AT CURRENT WORD WHERE WE DON'T KNOW WHAT CURRENT WORD IS.
;IF CURRENT CHAR.  IS A PERIOD THEN INSERT BEFORE IT I.E. AFTER CURRENT WORD..
;IF IT IS SOMETHING ELSE THEN INSERT BEFORE CURRENT WORD.
;Enter with TB = address of text to insert

CVTICW:	LDB	TE,CVTBFP	;GET LAST CHAR STORED
	CAIN	TE,"."		;WAS IT A PERIOD?
	JRST	CVTACW		;YES, STORE AFTER CURRENT WORD
	HRLI	TB,(POINT 7,)	;Complete byte pointer
	PUSHJ	PP,CVTCCW	;SEE WHICH LINE ITS IN
	  JRST	CVTIPl		;Its in previous line
	MOVE	TC,CVTSCP	;POINT TO CURRENT WORD
	JRST	CVTAC2		;INSERT BEFORE THIS WORD

CVTIPl:	MOVE	TC,CVTSCP	;POINT TO CURRENT WORD
	SUBI	TC,CVTLBF-CVTPLB	;Backup to previous line
REPEAT 4,<IBP	TC>		;ADVANCE 4 BYTES
	SOJA	TC,CVTRw3	;BACKUP 1 WORD, I.E. BACKUP 1 BYTE
CVTRC3:	MOVE	TA,TC		;COPY STORE PTR TO SAFER PLACE
	MOVE	TC,TB		;GET COPY OF REPLACEMENT PTR
	SETZ	TD,		;USE TO COUNT CHAR LEFT
CVTRC4:	ILDB	TE,TC		;GET NEXT REPLACEMENT
	SKIPE	TE		;ALL DONE
	AOJA	TD,CVTRC4	;COUNT IT
	ADDM	TD,CVTCXC##	;ADD IN EXTRA CHARACTERS
	IDIVI	TD,5		;SEE HOW MANY WORDS
	SKIPE	TC
	ADDI	TD,1		;COUNT PARTIAL WORD
	HRRM	TD,RVBLT##	;SET UP REVERSE BLT
	MOVEI	TE,CVTLBF+CVTLBZ-1
	SUBI	TE,(TA)
	SUBI	TE,(TD)		;N-1 WORDS TO MOVE
	TLO	TE,400000(TE)	;N-1+400000 IN LHS
	HRRI	TE,CVTLBF+CVTLBZ-1
	SUBI	TE,(TD)		;LAST ADDRESS IN SOURCE TO MOVE
	PUSHJ	PP,RVBLT##	;GO DO IT
	SKIPE	TC
	SUBI	TD,1		;BACK UP TO NO. OF FULL WORDS
	ADDM	TD,CVTBFP	;POINTER TO END OF WORD WILL CHANGE
	ADDM	TD,CVTSNP	;POINTER TO NEXT WORD WILL ALSO HAVE MOVED
	SKIPN	TE,TC		;GET REMAINDER
	JRST	CVTRC6		;NONE
	IBP	CVTBFP
	IBP	CVTSNP
	SOJG	TE,.-2		;ADJUST FOR PARTIAL WORD
;NOW WE HAVE TO MOVE LEFTWARDS
	MOVE	TE,TC		;GET REMAINDER AGAIN
	MOVE	TC,TA		;POINTER TO LAST GOOD CHAR
	ADDI	TC,1(TD)	;BUT ITS BEEN MOVED
	ADD	TD,TA
	IBP	TD		;INCREMENT STORE POINTER
	SOJG	TE,.-1
CVTRC5:	ILDB	TE,TC		;GET A GOOD CHARACTER
	IDPB	TE,TD		;STORE OVER JUNK
	JUMPN	TE,CVTRC5	;LOOP TIL NULL STORED
	JRST	CVTRC6

;NOW CONTINUE THE STORE
	IDPB	TE,TA
CVTRC6:	ILDB	TE,TB
	JUMPN	TE,.-2		;STOP ON ZERO
	POPJ	PP,

CVTRC7:	HALT	.

;HERE TO CHECK WHICH LINE BUFFER CVTSCP POINTS TO
;Returns
;	.+1	;Previous line
;	.+2	;Current line

CVTCCW:	HRRZ	TC,CVTSCP	;FIRST CHECK TO SEE IF WORD IS IN 
	HRRZ	TD,CVTBFP	; CURRENT LINE OR PREVIOUS
	CAMLE	TC,TD		; WHICH CAN HAPPEN IF DELIMITER IS ON NEXT LINE
	POPJ	PP,		;ITS IN PREVIOUS LINE
	CAME	TC,TD		;JUST INCASE THEY ARE EQUAL (A VERY SMALL WORD?)
	JRST	CPOPJ1		;NO, DEFINITELY IN CURRENT BUFFER
	HLRZ	TC,CVTSCP	;I DOUBT IF THIS TEST IS NECESSARY
	HLRZ	TD,CVTBFP
	CAML	TC,TD		;BYTE POINTERS DECREASE
	AOS	(PP)
	POPJ	PP,
;HERE IF THE CURRENT WORD IS IN THE PREVIOUS LINE
;THIS HAPPENS WHEN WE SCAN AHEAD TO FIND THE DELIMITER

CVTRWP:	LDB	TE,[POINT 7,CVTPLB,6]
	CAIE	TE,"*"		;IF LINE IS A COMMENT
	CAIN	TE,"/"		; OF EITHER KIND
	JRST	CVTRW6		;THEN WORD CANNOT BE IN PREVIOUS LINE
	MOVE	TC,CVTSCP##	;GET POINTER TO CURRENT WORD IN CVT BUFFER
	SUBI	TC,CVTLBF-CVTPLB	;ADJUST TO POINT TO PREVIOUS BUFFER
	MOVE	TD,TA		;INCASE WE HAVE TO BACKUP
	ILDB	TD,TD		;GET FIRST CHARACTER TO REPLACE
	TRNA
CVTRW1:	IBP	TC		;ADVANCE TO NEXT BYTE
	LDB	TE,TC		;MAKE SURE WE'RE WHERE WE SHOULD BE
	JUMPE	TE,CVTRW6	;WE HAVE REACHED THE END-OF-LINE
	CAIE	TE,(TD)
	CAIN	TE,"a"-"A"(TD)	;JUST TO BE SAFE
	TRNA			;OK
	JRST	CVTRW1		;NOT YET
	IBP	TA		;ACCOUNT FOR FIRST CHARACTER WE READ
	ILDB	TE,TB
	DPB	TE,TC		;REPLACE FIRST CHAR
CVTRW2:	ILDB	TE,TA		;ANYTHING LEFT IN SOURCE
	JUMPE	TE,CVTRW3	;NO
	ILDB	TE,TB		;GET REPLACEMENT CHARACTER
	JUMPE	TE,[HALT]	;SMALLER
	IDPB	TE,TC
	JRST	CVTRW2		;LOOP FOR EQUAL LENGTH PART

CVTRW3:	MOVE	TA,TC		;COPY STORE PTR TO SAFER PLACE
	MOVE	TC,TB		;GET COPY OF REPLACEMENT PTR
	SETZ	TD,		;USE TO COUNT CHAR LEFT
CVTRW4:	ILDB	TE,TC		;GET NEXT REPLACEMENT
	SKIPE	TE		;ALL DONE
	AOJA	TD,CVTRW4	;COUNT IT
	ADDM	TD,CVTPXC##	;ADD IN EXTRA CHARACTERS
	IDIVI	TD,5		;SEE HOW MANY WORDS
	SKIPE	TC
	ADDI	TD,1		;COUNT PARTIAL WORD
	HRRM	TD,RVBLT	;SET UP REVERSE BLT
	MOVEI	TE,CVTPLB+CVTLBZ-1
	SUBI	TE,(TA)
	SUBI	TE,(TD)		;N-1 WORDS TO MOVE
	TLO	TE,400000(TE)	;N-1+400000 IN LHS
	HRRI	TE,CVTPLB+CVTLBZ-1
	SUBI	TE,(TD)		;LAST ADDRESS IN SOURCE TO MOVE
	PUSHJ	PP,RVBLT	;GO DO IT
	SKIPE	TC
	SUBI	TD,1		;BACK UP TO NO. OF FULL WORDS
	JUMPE	TC,CVTRC6	;JUMP IF NO REMAINDER
;NOW WE HAVE TO MOVE LEFTWARDS
	MOVE	TC,TA		;POINTER TO LAST GOOD CHAR
	ADDI	TC,1(TD)	;BUT ITS BEEN MOVED
	ADD	TD,TA
	IBP	TD		;INCREMENT STORE POINTER
	SOJG	TE,.-1
CVTRW5:	ILDB	TE,TC		;GET A GOOD CHARACTER
	IDPB	TE,TD		;STORE OVER JUNK
	JUMPN	TE,CVTRW5	;LOOP TIL NULL STORED
	JRST	CVTRC6

CVTRW6:	MOVE	TE,[POINT 7,CVTLBF,6]
	MOVEM	TE,CVTSCP	;LDB POINTER TO START OF CURRENT LINE
	JRST	CVTRCW		;TRY AGAIN
;HERE TO TURN CURRENT CLAUSE INTO A COMMENT
;IF THE FIRST PART OF THE LINE IS NOT ALL SPACES OR TABS OUTPUT IT AND START A NEW LINE

	INTER.	CV0.
CV0.:				;TURN THIS CLAUSE INTO A COMMENT

CVTCTC:	PUSHJ	PP,CVTCCW	;SEE WHICH LINE BUFFER TO USE
	  JRST	CVTCT4		;POINTS TO PREVIOUS LINE
	SETOM	CVTCAL		;MAKE ALL LINES A COMMENT
	SKIPE	CVTCCF		;IS LINE ALREADY A COMMENT?
	POPJ	PP,		;YES, DO NOTHING EXTRA
	MOVE	TE,CVTLBF	;TEST FOR SOS LINE NUMBER
	TRNN	TE,1
	TSWF	FSEQ		;OR /S
	SKIPA	TD,[POINT 7,CVTLBF+1,6]	;YES
	MOVE	TD,[POINT 7,CVTLBF]	;NO, POINT TO START OF BUFFER
CVTCT1:	ILDB	TE,TD		;GET STORED CHAR
	CAMN	TD,CVTSCP	;ARE WE AT START OF CLAUSE
	JRST	CVTCT7		;YES
	CAIE	TE," "		;ALLOW SPACE
	CAIN	TE,$HT		;AND TAB ONLY
	JRST	CVTCT1		;OK
	PUSHJ	PP,CVTDPL	;DUMP PREVIOUS LINE
	PUSH	PP,CVTBFP	;SAVE CURRENT BP AS CVTCCL WILL INCREMENT IT
	PUSHJ	PP,CVTCCL	;COPY THIS LINE TO PREVIOUS
	POP	PP,CVTBFP	;RESTORE IT TO BEFORE TRRMINAL NULL
	MOVE	TD,[CVTPLB,,CVTLBF]
	BLT	TD,CVTLBF+CVTLBZ-1	;COPY IT BACK
	MOVE	TD,CVTSCP	;GET POINTER TO CURRENT WORD IN CVT BUFFER
	PUSHJ	PP,CVTEPL	;Make sure it ends correctly
	MOVE	TD,[POINT 7,CVTLBF]	;POINT TO START OF BUFFER
	MOVE	TE,CVTLBF	;SEE IF SOS LINE NUMBER
	TRNN	TE,1
	JRST	CVTCT3		;ITS NOT
	PUSHJ	PP,ASCIAD	;GENERATE NEW LINE NO.
	MOVEM	TE,CVTLBF	;STORE IT
	MOVE	TD,[POINT 7,CVTLBF+1,6]
CVTCT3:	ILDB	TE,TD		;ADVANCE TO NEXT BYTE
	CAMN	TD,CVTSCP	;ARE WE AT START OF CLAUSE
	JRST	CVTCT7		;YES
	CAIE	TE,$HT		;LEAVE TAB ALONE
	MOVEI	TE," "		;OTHERWISE TURN INTO SPACE
	DPB	TE,TD
	JRST	CVTCT3

CVTCT4:	MOVE	TD,CVTSCP##	;GET POINTER TO CURRENT WORD IN CVT BUFFER
	SUBI	TD,CVTLBF-CVTPLB	;ADJUST TO POINT TO PREVIOUS BUFFER
CVTCT5:	ILDB	TE,TD		;SEE IF ALL WE HAVE IS END OF LINE
	JUMPE	TE,CVTCT6	;LINE TERMINATES ON NULL
	CAIE	TE," "		;IGNORE SPACE
	CAIN	TE,$HT		;TAB
	JRST	CVTCT5
	CAIE	TE,","		;COMMA
	CAIN	TE,";"		;SEMI-COLON
	JRST	CVTCT5
	CAIE	TE,$CR		;LOOK FOR END-OF-LINE
	CAIN	TE,$LF
	JRST	CVTCT6		;FOUND IT
	HALT	.
CVTCT6:	MOVE	TE,[POINT 7,CVTLBF]
	MOVEM	TE,CVTSCP	;BACK UP TO START OF LINE
	SETOM	CVTCAL		;MAKE ALL LINES A COMMENT
CVTCT7:	SETOM	CVTCCF		;TURN CURRENT LINE INTO A COMMENT
	POPJ	PP,

;Here to add <cr-lf-nul> to end of previous buffer
;Enter with byte pointer to current buffer in TD

CVTEPL:	SUBI	TD,CVTLBF-CVTPLB	;ADJUST TO POINT TO PREVIOUS BUFFER
	MOVEI	TE,$CR		;REMOVE THE CURRENT WORD FROM PREV BUFFER
	DPB	TE,TD		; BY STORING <CR-LF-NUL>
	MOVEI	TE,$LF		;  OVER FIRST CHAR OF IT
	IDPB	TE,TD
	SETZ	TE,
	IDPB	TE,TD
	POPJ	PP,
;HERE TO TURN CURRENT CLAUSE BACK INTO A REAL STATEMENT AFTER CVTCTC CALLED
;IF THE FIRST PART OF THE LINE IS NOT ALL SPACES OR TABS OUTPUT IT AND START A NEW LINE

	INTER.	CV1.
CV1.:				;STOP COMMENTING THIS CLAUSE

CVTUTC:	SETZM	CVTCAL		;STOP COMMENTING
	SKIPN	CVTCCF		;IF CURRENT LINE ISN'T A COMMENT
	POPJ	PP,		;JUST RETURN
	MOVE	TE,CVTLBF	;SEE IF SOS LINE NO.
	TRNN	TE,1
	TSWF	FSEQ		;OR /S
	SKIPA	TD,[POINT 7,CVTLBF+1,6]	;POINT TO COL. 7
	MOVE	TD,[POINT 7,CVTLBF]	;POINT TO START OF BUFFER
CVTUT1:	ILDB	TE,TD		;GET STORED CHAR
	CAMN	TD,CVTSCP	;ARE WE AT START OF CLAUSE
	JRST	CVTUT3		;YES
	CAIE	TE," "		;ALLOW SPACE
	CAIN	TE,$HT		;AND TAB ONLY
	JRST	CVTUT1		;OK
	JUMPE	TE,CVTUT3	;STOP ON NUL, IT MUST BE THE END
	PUSHJ	PP,CVTDPL	;DUMP PREVIOUS LINE
	PUSHJ	PP,CVTRCL	;COPY THIS LINE TO PREVIOUS
	MOVE	TD,[POINT 7,CVTLBF]	;POINT TO START OF BUFFER
	MOVE	TE,CVTLBF	;SEE IF SOS LINE NUMBER
	TRNN	TE,1
	JRST	CVTUT2		;ITS NOT
	PUSHJ	PP,ASCIAD	;GENERATE NEW LINE NO.
	MOVEM	TE,CVTLBF	;STORE IT
	MOVE	TD,[POINT 7,CVTLBF+1,6]
CVTUT2:	ILDB	TE,TD		;ADVANCE TO NEXT BYTE
	CAMN	TD,CVTBFP	;ARE WE AT END OF CLAUSE
	JRST	CVTUT3		;YES
	JUMPE	TE,CVTUT3	;STOP ON NUL, IT MUST BE THE END
	CAIE	TE,$HT		;LEAVE TAB ALONE
	MOVEI	TE," "		;OTHERWISE TURN INTO SPACE
	DPB	TE,TD
	JRST	CVTUT2

CVTUT3:	SETZM	CVTCCF		;MAKE SURE CURRENT LINE ISN'T A COMMENT
	POPJ	PP,
	INTER.	CV2.
CV2.:				;STOP COMMENTING THIS CLAUSE

CVTVTC:	SETZM	CVTCAL		;STOP COMMENTING
	SKIPN	CVTCCF		;IF CURRENT LINE ISN'T A COMMENT
	POPJ	PP,		;JUST RETURN
	MOVE	TE,CVTLBF	;SEE IF SOS LINE NO.
	TRNN	TE,1
	TSWF	FSEQ		;OR /S
	SKIPA	TD,[POINT 7,CVTLBF+1,6]	;POINT TO COL. 7
	MOVE	TD,[POINT 7,CVTLBF]	;POINT TO START OF BUFFER
CVTVT1:	ILDB	TE,TD		;GET STORED CHAR
	CAMN	TD,CVTSCP	;ARE WE AT START OF CLAUSE
	JRST	CVTUT3		;YES
	CAIE	TE," "		;ALLOW SPACE
	CAIN	TE,$HT		;AND TAB ONLY
	JRST	CVTVT1		;OK
	JUMPE	TE,CVTUT3	;STOP ON NUL, IT MUST BE THE END
	PUSHJ	PP,CVTDPL	;DUMP PREVIOUS LINE
	PUSHJ	PP,CVTRCP	;COPY THIS LINE TO PREVIOUS
	MOVE	TD,[POINT 7,CVTLBF]	;POINT TO START OF BUFFER
	MOVE	TE,CVTLBF	;SEE IF SOS LINE NUMBER
	TRNN	TE,1
	JRST	CVTVT2		;ITS NOT
	PUSHJ	PP,ASCIAD	;GENERATE NEW LINE NO.
	MOVEM	TE,CVTLBF	;STORE IT
	MOVE	TD,[POINT 7,CVTLBF+1,6]
CVTVT2:	ILDB	TE,TD		;ADVANCE TO NEXT BYTE
	CAMN	TD,CVTSCP	;ARE WE AT END OF CLAUSE
	JRST	CVTUT3		;YES
	JUMPE	TE,CVTUT3	;STOP ON NUL, IT MUST BE THE END
	CAIE	TE,$HT		;LEAVE TAB ALONE
	MOVEI	TE," "		;OTHERWISE TURN INTO SPACE
	DPB	TE,TD
	JRST	CVTVT2
;ADD TWO ASCII NUMBER TO GENERATE NEW SOS LINE NUMBER

ASCIAD:	MOVE	TD,[ASCII /00001/]
	AND	TD,K2A		;CONVERT TO NUMBERS
	IOR	TE,K4A		;MAKE SURE THIS IS IN DIGIT FORM
	ADD	TE,K1A		;GET EACH DIGIT IN RANGE 166 TO 177 FOR CARRY
	ADD	TD,TE		;SUM
	AND	TD,K3A		;GET RID OF 100 BITS IF THERE
	MOVE	TE,K4A		;FIND OUT WHICH ONES NEED SUBTRACTING
	AND	TE,TD
	ASH	TE,-3		;CONVIENIENTLY THEY NEED 6 SUBTRACTED
	SUBM	TD,TE		;SO DO IT
	IOR	TE,K4A		;AND RECONVERT TO DIGITS
	POPJ	PP,

K1A:	BYTE	(7) 106,106,106,106,106
K2A:	BYTE	(7) 17,17,17,17,17
K3A:	BYTE	(7) 77,77,77,77,77
K4A:	<ASCII /00000/>!1
;CHECK FOR NEW COBOL-74 RESERVED WORDS

CVT74:	SKIPE	CVTRWM##	;HAS THIS WORD ALREADY BEEN MODIFIED?
	POPJ	PP,		;YES
	PUSHJ	PP,CVTSBP	;SAVE POINTER TO CVT LINE BUFFER
	MOVSI	TE,-RWTBLN	;GET AOBJN WORD
	MOVE	TD,NAMWRD	;GET FIRST WORD OF NAME
RWLOOP:	CAMN	TD,RWTBL1(TE)	;CHECK AGAINST FIRST WORD
	JRST	RWTST		;FIRST WORD MATCHES
	AOBJN	TE,RWLOOP	;FAILED, TRY NEXT WORD
	POPJ	PP,		;ALL DONE, NO LUCK

RWTST:	CAMN	TD,[SIXBIT /LINAGE/]	;LINAGE AND LINAGE-COUNTER HAVE SAME FIRST WORD
	JRST	[SKIPN	NAMWRD+1	;CHECK FOR JUST LINAGE
		JRST	RWFND		;GOT IT
		JRST	.+1]		;NO TRY NORMAL TEST LOOP
	MOVE	TD,NAMWRD+1
	CAME	TD,RWTBL2(TE)	;TRY NEXT WORD
	POPJ	PP,		;NO, FAILED
	MOVE	TD,NAMWRD+2	;SOME WORD ARE MORE THAN 12 CHARACTERS
	CAME	TD,RWTBL3(TE)
	POPJ	PP,		;FAILED THIS TEST
RWFND:	SETOM	CVTRWM		;SIGNAL WE'VE FLAGGED IT ONCE AND
	EWARNJ	E.777		;TELL USER ITS A RESERVED WORD IN 74

DEFINE RESWRD <
XX	ALSO			;;ALSO
XX	BOTTOM			;;BOTTOM
XX	CHARAC,TER		;;CHARACTER
XX	CODE:S,ET		;;CODE-SET
XX	COLLAT,ING		;;COLLATING
XX	COMP:2			;;COMP-2
XX	COMPUT,ATIONA,L:2	;;COMP-2
XX	DAY			;;DAY
XX	DEBUGG,ING		;;DEBUGGING
XX	DUPLIC,ATES		;;DUPLICATES
XX	DYNAMI,C		;;DYNAMIC
XX	END:OF,:PAGE		;;END-OF-PAGE
XX	EOP			;;EOP
XX	EXCEPT,ION		;;EXCEPTION
XX	INSPEC,T		;;INSPECT
;;XX	LINAGE			;;LINAGE
XX	LINAGE,:COUNT,ER	;;LINAGE-COUNTER
XX	NATIVE			;;NATIVE
XX	ORGANI,ZATION		;;ORGANIZATION
XX	PRINTI,NG		;;PRINTING
XX	PROCED,URES		;;PROCEDURES
XX	REFERE,NCES		;;REFERENCES
XX	REMOVA,L		;;REMOVAL
XX	RMS			;;RMS
XX	SEPARA,TE		;;SEPARATE
XX	SORT:M,ERGE		;;SORT-MERGE
XX	STANDA,RD:1		;;STANDARD-1
XX	START			;;START
XX	TOP			;;TOP
XX	TRAILI,NG		;;TRAILING
>

DEFINE XX(A,B,C)<
	SIXBIT	/A/
>

RWTBL1:	RESWRD			;FIRST SIX CHARS OF WORD

RWTBLN==.-RWTBL1		;LENGTH OF TABLE

DEFINE XX(A,B,C)<
	SIXBIT	/B/
>

RWTBL2:	RESWRD			;SECOND SIX CHAR OF WORD

DEFINE XX(A,B,C)<
	SIXBIT	/C/
>

RWTBL3:	RESWRD			;THIRD (AND FINAL) SIX CHARS OF WORD
>
SUBTTL	EXTERNALS

EXTERN	FATAL,WARN,DEVDED,STINFL,TRYNAM
EXTERN	PUTCPY,PUTCIF,PUTFEL,SIXOUT,LNKSET
EXTERN	CURCPY,CPYBHO,LIBHDR,LIBBH,LIBDEV,LIBNAM
EXTERN	RPLCNT,RPLLOC,RPLNXT
EXTERN	IOSRCS,DEVFIL,DEVDEV,DEVEXT,DEVSW,DEVSIZ,SRCEND
EXTERN	GETENT,PHASEN,OPRTR,DCPNT.
EXTERN	DEVBH,OPENIT
EXTERN	PSCAN,PICBUF,PICPTR
EXTERN	SRCBH,SRCDEV,CRFBHO,CRFDEV,CREFSW,CPMAXN
EXTERN	SEQIN
EXTERN	WASERC,PUNPTR,PLUSWD,MINWD,MULWD,LPARWD,EXPWD,PERWD,ENDIT
EXTERN	NAMWRD,LITVAL,NAMVAL,FILLOC,FILNXT
EXTERN	GWNAMP,GWVAL,GWLN,GWCP
EXTERN	CPOPJ,CPOPJ1
IFN DBMS,<
EXTERN	FINVOK,DBBUFH,DBDEV,DBBLCK,DBONLY
>
IFN MCS!TCS,<
EXTERN	CDLOC,CDNXT
>
IFN ANS74,<
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