/	WPFILS  --  FILE I-O ROUTINES
/

/	048	MART	30-APRL-85	ADDED FIELD 7 BLASTR HOOK
/
/	--------- Following edits V2.0 and earlier
/
/	047	WCE	25-MAY-84	Removed old STATLN definitions
/	046	WCE	23-JAN-84	Move RPTEM1 to page where used
/	045	WJY	17-NOV-83	Read first header block back into core
/					after getting all the extensions.
/	044	WJY	29-OCT-83	Added logic to check if the correct
/					header block is already in core before
/					requesting it to be read from disk.
/					This request occurs in a RESTORE FILE
/					POINTERS call and caused problems for
/					GOTO-RULER.
/	043	WCE	31-AUG-83	Add conditionals for status line in the
/					editor to only get one block when
/					needed so that block count will go up
/					by one instead of three so that users
/					will not complain about counting.
/	042	DMB	29-AUG-83	Added function calls for GOTO-RULER
/					(also useful for GOTO-PAGE)
/	041	WCE	19-JUL-83	Modify symbol names for new prefix file
/	040	EH	06-JUL-83	Ignore GTP extensions on read only file
/	039	WCE	11-MAY-83	Make OPEN for OVERWRITE free up space
/	038	EH	18-JAN-83	Clear RPSPLT between each block
/	037	EH	16-DEC-82	Clear RPMODE prior to building desc.
/					word if writing thru ETX buffer
/	036	GJP/EH	09-DEC-82	Set hdr ptr to 1 on read-file re-init.
/	035	WJD	09-DEC-82	remove 034 attempt at power-lost fixes
/					code was altogether deleted
/	034	WJD	19-NOV-82	1200 baud & power-lost fixes
/	033	WJD	19-NOV-82	Writeout alloc. block during close
/					for SORT bugfix
/	032	EH	30-JUL-82	Modify parallel GTP structure
/	031	EH	24-JUN-82	Write alloc. blk. after alloc. req.
/	030	WJD/EH	30-MAR-82	Process print controls
/	029	WJD	23-MAR-82	G-T-P link verification
/	028	GDH	18-MAR-82	"SQUISHED TEXT" bug & general cleanup.
/	027	EH	16-MAR-82	Fix uppercase bug
/	026	EH	22-FEB-82	OH-015 PUT page counters fix. See also
/					WPEDIT '144'. (DM-387)
/	025	WJD	15-FEB-82	DM-316 (GOTO PAGE rel.)
/	024	WJD	10-FEB-82	Extn. blks. erroneously deallocated during OPEN
/	023	WJD	08-FEB-82	GOTO-PAGE header deallocation
/	022	GJP	04-FEB-82	Correct header deallocation problem
/	021	EH	27-JAN-82	Correct mode in descriptor word
/	020	EH	27-JAN-82	Fix relative paging around end of ext.
/	019	WJD	15-JAN-82	OPEN was corrupting descriptor block
/	018	WJD	07-JAN-82	STX/ETX buffer page-counters installed for REL GOTO PAGE
/	017	EH	31-DEC-81	Save mode when writing through STX
/					Fixed problem assoc.with backup through
/					hdr blocks ptrs.
/	016	WJD	21-DEC-81	REMOVED GOTO PAGE MATH RECOGNTION
/	015	GJP	15-DEC-81	WPFILS BUG DEALOCATING ASSIGNED BLOCKS
/	014	WJD	14-DEC-81	GOTO structure support of >2 extensions
/	013	EH/WJD	14-DEC-81	Inform editor of new block just read into ETX buffer
/	012	EH	11-DEC-81	Save mode of first char. in a block
/	0011	GDH/DFB	09-DEC-81	Fix to initialize block pntr(go to page)
/	010	JRF	08-DEC-81	Removed temporary CMD 9 equate in
/					 ESCTAB table.
/	009	WJD	04-DEC-81	Support offset PAGE positioning
/	008	WJD	03-DEC-81	Fix GOTO PAGE extension blocks problem
/	007	JRF	23-NOV-81	Modify ESCTAB and SPCTAB tables for
/					 handling of MATH area start and
/					 end characters.
/	0006	GDH	12-NOV-81	Bug fix to TBO overwrite 0 length files.
/	0004	GDH	 2-OCT-81	RPG to ignore GET DENSITY function.
/	002	WJD	25-OCT-81	Added V2 GOTO PAGE support routines
/	0001	GDH	26-AUG-81	Moved WPFILS to field 7.
/	X3.5	JLZ	26-JUN-80	MODIFIED PRINTER'S FILE READER TO
/					SUPPORT ENHANCED HEADERS/FOOTERS
/		TT	07-JUL-81	Removed superfluous conditionals
/	III.B	MB	1-APR-78	PUT IN SYSTEM OPTIONS
/	III-1	KEE	2/27/78 	ADD WT'S 'TD' COMMAND
/	2.7A-1	LDB	1/6/78		MODIFY FOR WT-78 7-BIT
/	2.5-1	LDB	11/11/77	MAKE IT HARDER TO CLOSE UNOPENED FILES
/	2.4D+	RTL	10/17/77	FILE SIZE BUG IN ALOC
/	2.Q-1	RLT	9/24/77		BUG IN R2OPEN FOR WT78
/	2.P	LDB	9/19/77		PUT IN SIXBIT CALLS FOR MAIN'S VERIFY
/	2.N	RLT	9/14/77		ADD UDKPRT STUFF
/	2.J	KEE	8/26/77		ADD 4-FLOPPY SUPPORT
/	2.G-1	MSB	8/9/77		GET IT FROM THE 78 PACK
/
/	USE "PAL WPFILS<WPF0,RXDCL,WPFILS"
/


/	WTFILS - WRITES OUT WPFILS & REST OF FIELD 7.

	*200
	JMP I	.+3
	JMP I	.+1
	7605
	RXLOAD
	*RXLDLS
	RXEWT=4
	RXEWT
	0
	RXQBLK=11
	RXQBLK
	.

	DLFD7;0;CDF 20;-DSFD7	/ WRITE OUT WPFILS/FIELD 7 CODE.
	0			/ STOPPER.

	FIELD 2

	HDRBUF=6000 		/ BUF ADDRS IN BUFFLD
	ETXBUF=6400
	STXBUF=7000
	PSTBUF=7400

	CDFMNU=MNCDU0
	CDFBUF=MNCDU2
	CDFMYF=CDFFIO

	CDFRPB=CDFMNU	/V2 GOTO PAGE BUFFER FIELD (2)	/A002

/********************************************************************	/A001
/********************************************************************	/A001
/*****								*****	/A001
/*****	THE LOCATIONS OF SCFPRC AND RDFSIZ ARE DEFINED IN WPF1	*****	/A001
/*****								*****	/A001
/*****		IF YOU MOVE THEM BE SURE TO UPDATE WPF1		*****	/A001
/*****								*****	/A001
/********************************************************************	/A001
/********************************************************************	/A001

	*100
SCFSPC,	0 			/ SPACE LEFT ON SCROLL DISKETTE
RDFSIZ,	0 			/ SIZE OF RDFIL FILE
M7700,	-7700			/ MINUS 7700 CONSTANT			/A021
PAGEMK,	ECNWPG-ECPMRK		/ COMPLEMENT OF NEW PAGE MINUS PAGE MK	/A032
M400,	-400			/ CONSTANT OF -400 (OCTAL)		/A025
M377,	-377			/ MINUS 377 (OCTAL) CONSTANT
M376,	-376			/ CONSATNT OF -376
M360,	-360			/ CONSTANT OF MINUS 360 OCTAL
M310,	-310			/ -210 (DEC.) PTRS. IN 1ST HDR.		/A025
M74,	-74			/ MINUS 74 CONSTANT			/A027
M16,	-16			/ -16 CONSTANT
NWPAGE,	-ECNWPG			/ COMPLEMENT OF NEW PAGE MARKER		/A032
M4,	-4			/ CONSTANT OF -4
M3,	-3			/ CONSTANT OF -3
MONE,	-1			/ MINUS ONE CONSTANT
ZERO,	0			/ 0 CONSTANT
ONE,	1			/ 1 CONSTANT
TWO,	2			/ 2 CONSTANT				/A025
THREE,	3			/ 3 CONSTANT
FOUR,	4			/ 4 CONSATNT
T16,	16			/ CONSTANT OF 16
T17,	17			/MASK BITS 8-11				/A025
T40,	40			/ CONSTANT OF 40			/A027
T360,	360			/ CONSTANT OF 360
T376,	376			/ CONSATNT OF 376
T400,	400			/CONSTANT OF 400 (OCTAL)		/A025
M100=P7700								/A028
P100=M7700								/A028

/********************************************************************** /A023
/********************************************************************** /A023
/*****								  ***** /A023
/*****				N O T E				  ***** /A023
/*****								  ***** /A023
/***** GOTO PAGE EXPECTS SCTOP TO PRECEED SCBOT WHEN CALCULATING  ***** /A023
/***** THE LOCATION TO STORE A DESCRIPTOR WORD FOR THAT BLOCK	  ***** /A023
/***** JUST WRITTEN TO DISKETTE.  THESE 2 WORDS MUST APPEAR IN	  ***** /A023
/***** CONSECUTIVE MEMORY LOCATIONS, WITH SCTOP FIRST.		  ***** /A023
/*****								  ***** /A023
/********************************************************************** /A023
/********************************************************************** /A023

SCTOP,	0	/TOP HEADER WORD POINTER				/M023
SCBOT,	0	/ BOTTOM HEADER WORD POINTER				/M022
SCBTH,	0	/ BOTTOM HEADER POINTER					/M022
SCTPH,	0	/ TOP HEADER POINTER					/M022
SCBTHT,	0	/ BOTTOM HEADER POINTER SAVE AREA			/M022
SCBOTT,	0	/ BOTTOM HEADER WORD POINTER SAVE AREA			/M022
SOMFLG,	0		/SET IF: PRINT CONTROL PROCESSED THRU STX BUF	/A030
SCOPTN,	.-.	/0=NORMAL;1=APPEND;-1=REPLACE				/A025
SCFILZ,	.-.	/DOC. FILE SIZE						/A025
NEWBLK,	0	/CURRENT G-T-P BLK #					/A029
RPTEM2,	0	/SAVE AREA						/A029
EXTNOF,	0	/POINTER TO EXTN.					/A029
EDBOTS,	0	/USED BY RPINIT TO SAVE/REPLACE CURRENT SCBOT		/M041
EDTOPS,	0	/USED BY RPINIT TO SAVE/REPLACE CURRENT SCTOP		/M041
EDHDR,	0	/USED BY RPINIT TO SAVE/REPLACE CURRENT 'ACTIVE' HDR PTR/M032
SCTPTR,	0 		/ STX BYTE OFFSET				/M032
SCEPTR,	0 		/ ETX CHAR OFFSET				/M032
PAGLIM,	0		/ SET TO 1 IF NUMBER OF PAGES IN SCROLL		/A032
			/ BUFFER = 36					/A032

SCHDRG,	XX								/M035
	DCA	SCGPVL	/GET THIS WORD					/M035
	JMS	SCGETR	/GET THE WORD OUT OF THE MAIN HDR		/M035
	ONE		/MAIN HDR ID					/M035
	SCGPVL		/AT THIS LOC.					/M035
	JMP I SCHDRG	/RETURN WITH WORD IN AC				/M035
SCHDRP,	XX
	DCA	SCGPVL
	MQA
	JMS	SCPUTR
	ONE
	SCGPVL
	JMP I	SCHDRP

SCGPVL,	0		/ AREA TO HOLD VALUE PAST			/A003

/---------------
	PAGE

	*200		/ FILEIO IS THE OLD XFIELD; BUT NOW IT RESIDES	/A001
			/  IN FIELD 7 AND IS THE DIRECT INTERFACE	/A001
			/  TO THE WPFILS ROUTINES. IF YOU MOVE THE	/A001
			/  ENTRY POINT LOCATION (XFIELX) BE SURE TO	/A001
			/  UPDATE WPCMND WITH NEW VECTOR POINTER!!!!	/A001

XFIELX,	XX
	DCA	XFILT1 	/ STASH AC.
	MQA		/ PICK UP THE CONTENTS OF THE MQ		/A039
	DCA	XFILT4	/ STASH MQ					/A039
	RDF 		/ GET CALLERS (RETURN) FIELD.
	TAD	CIDF0 	/ MAKE A RETURN CID INSTR.
	DCA	XFILT2 	/ SAVE FOR THE RETURN TO CALLER.
	TAD I	XFIELX 	/ GET AGR (INDEX INTO VECTOR TABLE).
	ISZ	XFIELX 	/ BUMP RETURN ADDRESS OVER VECTOR		/M039
	CDFMYF	 	/ MAP US.
	TAD	(XFLDTB)/ GET PTR TO ROUTINE TO CALL.
	DCA	XFILT3 	/ SAVE PTR.
	TAD I	XFILT3	/ GET ADDRESS OF ROUTINE TO CALL.
	DCA	XFILT3	/ SAVE CALLABLY.
	TAD	XFILT1 	/ GET AC BACK.
	JMS I	XFILT3	/ CALL WPFILS.
/D039	ISZ	XFIELX 	/ BUMP RETURN ADDRESS OVER VECTOR
XFILT2,	.-. 		/ MAP CALLER'S FIELD.
	JMP I	XFIELX 	/ RETURN TO CALLER.

XFILT1,	.-. 		/ AC STASHED HERE.
XFILT3,	.-. 		/ PTR THROUGH VETCOR TABLE.
XFILT4,	.-.		/ MQ STASHED HERE.				/A039

/*******************************************************************	/A039
/*******************************************************************	/A039
/*******************************************************************	/A039
/****								****	/A039
/****				NOTE				****	/A039
/****								****	/A039
/****	THE ROUTINE RPREA1 COUNTS ON THE FACT THAT THE DISK	****	/A039
/****	OPEN COMMAND IS THE FIRST ENTRY IN THE FOLLOWING TABLE	****	/A039
/****								****	/A039
/****	IF YOU CHANGE THE ORDER OF THE TABLE BY REDEFINING	****	/A039
/****	THE DEFINITIONS IN WPF1 THEN REWORK THE RPREA1 ROUTINE	****	/A039
/****								****	/A039
/*******************************************************************	/A039
/*******************************************************************	/A039
/*******************************************************************	/A039

XFLDTB,
/D039	DSKINI
	DSKOPN 		/ WPFILS ROUTINE VECTOR TABLE.			/M039
	DSKCLC 		/ MAKE SURE THAT ROUTINES ARE IN SAME ORDER
	GETSTX 		/ THAT THEY ARE LISTED IN WPF1!!!!!
	PUTSTX
	GETETX
	PUTETX
	RDINIT		/ INITIALIZE FILE (EDIT READER)
	RDNXCH		/ READ NEXT CHARACTER (EDIT READER)
	RDNXCB		/ READ NEXT BYTE (EDIT READER)
	GETST1
	PUTST1
	GETET1
	PUTET1
	SCHDRG
	SCHDRP
	RPINIT		/ MISC FUNCTIONS FOR GOTO-PAGE & GOTO-RULER	/A003
	RRSCTP		/ SET SCTOP,SCTPH				/A042

DSKOPN,	XX		/ PERFORM DISK FILE OPEN			/A039
	SMA		/ CHECK FOR AN OVER-WRITE OPERATION		/A039
	JMP	DSKOPX	/ GO DO REGULAR OPEN COMMAND			/A039
	JMS	DSKINI	/ OPEN DISK FILE FOR OVERWRITE			/A039
	JMS	DSKCLC	/ CLOSE THE FILE TO FREE UP THE SPACE		/A039
	TAD	XFILT4	/ GET THE CONTENTS OF THE MQ			/A039
	MQL		/ RESTORE THE CONTENTS OF THE MQ		/A039
	TAD	XFILT1	/ GET THE OPERATION CODE TO AC			/A039
DSKOPX,	JMS	DSKINI	/ GO DO REGULAR OPEN COMMAND			/A039
	JMP I	DSKOPN	/ GO RETURN TO CALLER				/A039

	RDNPTR=10							/A018
RDPTRB,	ZBLOCK	RDNPTR							/A018

RDFIO,	XX
	DCA	RDFQBK+RXQBLK 	/ STORE BLOCK NUMBER
	TAD I	RDFIO 		/ ++++
	DCA	RDFQBK+RXQFNC 	/ AND FUNCTION CODE
	ISZ	RDFIO
	CIFSYS 			/ ++++
	ENQUE 			/ ++++
	RDFQB 			/ QUEUE TO HANDLER
RDFIO1,	CIFSYS 			/ ++++
	JWAIT 			/ WAIT TIL DONE
	TAD	RDFQBK+RXQCOD 	/ DONE YET?
	SNA 			/ ++++
	JMP	RDFIO1 		/ LOOP IF NOT
	JMP I	RDFIO 		/ ELSE RETURN STATUS

RDFQB,	DSKQUE 			/ ++++
	0 			/ ++++
	0 			/ QUEUE HEADER
RDFQBK,	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	PSTBUF 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0

/ this routine checks to see if the character is the first one to be
/  inserted into the STX buffer.  if so, then save the mode of that
/  character

SAVSTX,	XX		/ SAVE THE CONTENTS OF THE "STX" MODE BEFORE	/A028
	DCA	TEMP1	/ SAVE INPUT AC.				/A028
	TAD	STXMOD	/ THE CHAR GETS WRITTEN OUT.			/A028
	TAD	STXMOD+1/						/A028
	DCA	STXHLD	/ SAVE IT IN A TEMP.				/A028
	TAD	TEMP1	/ RESTORE THE AC.				/A028
	JMP I	SAVSTX	/ RETURN TO CALLER.				/A028

STXHLD,	0								/A028
HLDMOD,	.-.		/CONTAINS THE MODE OF THE FIRST CHAR IN THE STX BUFFER

SAVETX,	XX		/ SAVE THE CONTENTS OF THE "ETX" MODE BEFORE	/A028
	DCA	TEMP2	/ SAVE AC.					/A028
	TAD	ETXMOD	/ THE CHAR GETS WRITTEM OUT.			/A028
	TAD	ETXMOD+1/						/A028
	DCA	ETXSAV	/ SAVE IT IN A TEMP.				/A028
	TAD	TEMP2	/ RESTORE INPUT AC.				/A028
	JMP I	SAVETX	/ RETURN TO CALLER.				/A028

TEMP1=SAVETX								/A028
TEMP2=SAVSTX								/A028

ETXSAV,	0								/A028

RPDSW1,	XX			/SAVE RETURN ADDRESS
	TAD	SCQBLK+RXQBAD	/BUFFER JUST USED FOR IO		/A012
	TAD	(-SCTB		/COMPARE TO TOP				/A012
	SNA CLA			/SKIP IF TO USE ETX			/A012
	JMP	RPDSW2		/WANT TO USE STX			/A012
	TAD	ETXSAV		/ GET LAST MODE + SHIFT/UNSHIFT BITS.	/M028
	JMP	RPDSW3	
RPDSW2,	TAD	HLDMOD		/GET MODE AND SHIFT/UNSHIFT FROM STX
RPDSW3,	TAD I	T3		/MERGE CURRENT MODE W/DESCRIPTOR	/A030
	DCA I	T3		/AND SAVE...				/A030
	JMP I	RPDSW1		/RETURN

/	THE FOLLOWING ROUTINE WAS PUT BACK IN LINE TO SAVE SPACE	/A039
/D039/ Save the current 12-bit character going into either the etx or	/A026
/D039/ the STX scroll buffer for later (PUTBYT) PAGE-MARK counting...	/A026

/D039RPSAV12,	XX		/MAKE A COPY OF 12-BIT CHARACTER	/A026
/D039	DCA	CUR12BIT	/TO BE USED AFTER XLATION		/A026
/D039	TAD	CUR12BIT	/RETURN 12-BIT CHARACTER TO CALLER	/A026
/D039	JMP I	RPSAV12		/RETURN TO CALLER			/A026

/D039CUR12BIT, 0			/CURRENT "12-BIT" CHARACTER		/A026
/---------------
	PAGE

/	ADR, DW, AND SD NEED THE HEADER OR THE FILE IN CORE ON A RDINIT UNTIL THE FIRST
/	CHARACTER IS READ.

RDINIT,	XX 			/ INIT FOR SYSFIL READING
	DCA	T1
	TAD	T1
	AND	P377 		/ INITIALIZE FILE NUMBER
	DCA	RDFQBK+RXQFNO 	/ INIT FILE NUMBER
	TAD	T1
	JMS	RDINI2 		/ ...DRIVE AND BUFFER FIELD
	JMS	RDFIO		/ DO A GET DENSITY TO ESTAB THE DEN OF THE DRIVE
	RXEDN+4000			/ GET DENSITY FUNCTION
	JMS	RDFIO 		/ ++++
	RXEGF+4000 		/ GET 1ST BLOCK NUMBER
	SMA CLA 		/ TREAT AS "NOT FOUND" IF ERROR
	TAD	RDFQBK+RXQBLK
	JMS	RDINI1 		/ INIT FOR READING
	JMS	RDGTHS 		/ GET  HDR EXTENSIONS
	JMP I	RDINIT 		/ AND RETURN

RDINI1,	XX
	DCA	RDHDRB 		/ SET HEADER BLOCK NUMBER
	AC0001			/ INITIALIZE HDR POINTER		/M036
	DCA	RDHDRP		/ TO FIRST HEADER			/M036
	AC7777 			/ ++++
	DCA	RDCHNO 		/ INIT COUNTERS
	AC7777 			/ ++++
	DCA	RDPTNO
	TAD	(SCBKOF+1) 	/ ++++
	DCA	RDPTRS 		/ AND BLK PTR
	DCA	RDMOD 		/ ++++
	DCA	RDMOD+1
	DCA	RDHDBN 		/ SHOW BUFFER EMPTY
	JMP I	RDINI1

RDNXCH,	XX 			/ READ NEXT SYSFIL INPUT CHAR
RDNXH1,	JMS	RDNXC 		/ ++++
	SNA 			/ ++++
	JMP I	RDNXCH 		/ RETURN IF NONE
	JMS	XLTASC
	JMS	GETMOD 		/ ++++
	RDMOD
	SNA 			/ ++++
	JMP	RDNXH1 		/ DON'T RETURN NULLS
	JMP I	RDNXCH

RDNXC,	XX 			/ COLLECT 1 6-BIT FROM SYSFIL
	JMS	RDNXCB
	TAD	(-77) 		/ ++++
	SNA 			/ ++++
	JMP	RDNXCX 		/ JMP IF ESCAPE
	TAD	P77
	JMP I	RDNXC 		/ ELSE RETURN SINGLE CHAR
RDNXCX,	JMS	RDNXCB
	SMA SZA 		/ ++++
	TAD	P7700 		/ SHOW IT'S AN ESCAPE
	JMP I	RDNXC

RDNXCB,	XX 			/ GETS 1 BYTE FROM SYSFIL
	CLA
	ISZ	RDCHNO 		/ ++++
	JMP	RDNXC3 		/ JUMP IF SOME LEFT IN BUF
	ISZ	RDPTNO 		/ ++++
	JMP	RDNXC2 		/ JUMP IF SOME PTRS LEFT
	TAD	(-RDNPTR) 	/ ++++
	DCA	RDPTNO 		/ INIT PTR TABLE PTRS
	TAD	(RDPTRB-1) 	/ ++++
	DCA	RDLPTR
RDNXC1,	ISZ	RDLPTR
	JMS	RDGETR 		/ COPY PTRS FROM BUF TO TABLE
	RDHDRP			/ HEADER POINTER			/A003
	RDPTRS			/ HEADER WORD POINTER			/A003
	SNA 			/ ++++
	JMP	RDNXC6 		/ JUMP IF NO MORE
	DCA I	RDLPTR 		/ ELSE STORE IN TABLE
	JMS	RDINC		/ GO INCREMENT HDR POINTERS		/A003
	ISZ	RDPTNO 		/ ++++
	JMP	RDNXC1 		/ LOOP TIL DONE
	SKP
RDNXC6,	DCA I	RDLPTR 		/ STORE END FLAG IF NO MORE
	DCA	RDHDBN 		/ SHOW BUFFER EMPTY
	TAD	(-RDNPTR) 	/ ++++
	DCA	RDPTNO 		/ REINIT PTRS
	TAD	(RDPTRB-1) 	/ ++++
	DCA	RDLPTR
RDNXC2,	ISZ	RDLPTR 		/ ++++
	TAD I	RDLPTR 		/ GET NEXT PTR
	SNA 			/ ++++
	JMP	RDNXC4 		/ QUIT IF NO MORE
	JMS	RDFIO 		/ ++++
	RXERD+4000 		/ READ NEXT BLOCK
	SPA CLA 		/ ++++
	JMP	RDNXC5 		/ JUMP IF ERROR
	TAD	(-SCHCNT) 	/ ++++
	DCA	RDCHNO 		/ INIT COUNTER AND PTR FOR CHAR COPY
RDNXC3,	TAD	RDCHNO
	TAD	(SCHCNT)
	JMS	GETBYT 		/ ++++
	PSTBUF+BOFSET 		/ GET BYTE
	SNA 			/ ++++
	JMP	RDNXCB+1 	/ SKIP NULLS
	JMP I	RDNXCB 		/ AND DO IT

RDNXC4,	JMS	RDINI1 		/ REINIT
	JMP I	RDNXCB 		/ AND RETURN

RDNXC5,				/ ERROR ON READ
	JMS	RDINI1 		/ REINIT FOR EOF NEXT TIME
	AC7777 			/ RETURN ERROR FLAG
	JMP I	RDNXCB

RDHDRP,	0		/ HEADER WORD POINTER FOR READ-ONLY	/A003
RDPTRS,	0 			/ THE CURRENT OFFSET INTO THE HEADER BLOCK
RDCHNO,	0 			/ LOOP COUNTER FOR CHAR COPY
RDPTNO,	0 			/ FILL COUNT FOR BLOCK TABLE
RDLPTR,	0 			/ PTR FOR BLOCK TABLE

RDMOD,	0 			/ MODES FOR DECODING 6-BIT
	0
/---------------
	PAGE

GETETX,	XX 			/ GET 12-BIT FROM ETX
	JMS	GETETC 		/ ++++
	SNA 			/ ++++
	JMP I	GETETX
	JMS	XLTASC
	JMS	GETMOD 		/ ++++
	ETXMOD
	SNA 			/ ++++
	JMP	GETETX+1
	JMP I	GETETX

GETSTX,	XX 			/ GET 12-BIT FROM STX
	JMS	GETSTC 		/ ++++
	SNA 			/ ++++
	JMP I	GETSTX
	JMS	XLTASC
	SPA 			/ ++++
	CML
	JMS	GETMOD 		/ ++++
	STXMOD
	SNA 			/ ++++
	JMP	GETSTX+1
	JMP I	GETSTX

XLTASC,	XX 			/ XLAT 6-BIT TO ASCII
				/ 1-73: NORMAL
				/ 74:	SHIFT
				/ 76:	UNSHIFT
				/ 7702-7777:	ESCAPE

				/ OUTPUT:
				/ -(1-6):	MODE CHANGE (L=1 IF ON)
				/ 0-200:	ASCII CHAR (L=1 IF ALPHA)

	SPA SNA 		/ ++++
	JMP	XLTAS1 		/ ESCAPE
	TAD	M74 		/ ++++
	SMA 			/ ++++
	JMP	XLTAS2 		/ SHIFT-UNSHIFT
	TAD	(74-41)
XLTAS4,	CLL CML 		/ SET LINK FOR ALPHA
	TAD	P100	 	/ CLEAR LINK IF NOT ALPHA
	JMP I	XLTASC
XLTAS1,	TAD	(100-MAXESC) 	/ ++++
	SMA 			/ ++++
	CLA 			/ CHECK FOR OK
	TAD	(MAXESC+ESCTAB) / ++++
	DCA	T1
	TAD I	T1 		/ ++++
	SPA 			/ ++++
	JMP	XLTAS3
	TAD	M100 		/ ADJUST FOR ALPHA TEST
	JMP	XLTAS4

XLTAS2,	SNA CLA 		/ ++++
	IAC
	CMA
XLTAS3,	CLL CML RAR
	JMP I	XLTASC

ESCTAB,	0 			/ NULL
	0 			/ SPACE
	-3 			/ ENTER BOLDFACE	(CMD !)
	-4 			/ EXIT BOLDFACE		(CMD ")
	-5 			/ ENTER UNDERLINE	(CMD #)
	-6 			/ EXIT UNDERLINE	(CMD $)
	11 			/ TAB			(CMD %)
	10 			/ ENTER COMPOSITE	(CMD &)
	15 			/ EXIT COMPOSITE	(CMD ')
	-13 			/ ENTER AUXILIARY	(CMD ()
	-14 			/ EXIT AUXILIARY	(CMD ))
	12 			/ END OF LINE		(CMD *)
	14 			/ END OF PAGE		(CMD +)
	-7 			/ ENTER SUPERSCRIPT	(CMD ,)
	-10 			/ EXIT SUPERSCRIPT	(CMD -)
	-11 			/ ENTER SUBSCRIPT	(CMD .)
	-12 			/ EXIT SUBSCRIPT	(CMD /)
	0			/A016
	133 			/ PRINTABLE CHARACTER "{", "["	(CMD 1)
	134 			/ PRINTABLE CHARACTER "|", "\"	(CMD 2)
	135 			/ PRINTABLE CHARACTER "}", "]"	(CMD 3)
	136 			/ PRINTABLE CHARACTER "~", "^"	(CMD 4)
	137 			/ UNDERLINE			(CMD 5)
	7 			/ LINE MODIFIED			(CMD 6)
	16 			/ RULER START			(CMD 7)
	17 			/ RULER END			(CMD 8)

	MAXESC=.-ESCTAB
	-16 			/ ERROR

GETMOD,	XX 			/ XLAT ESCAPES, ADD MODES TO ASCII
	MQL
	TAD I	GETMOD 		/ ++++
	DCA	T1 		/ T1 => PTR. TO ETX OR STX MODE WORD
	ISZ	GETMOD
	MQA
	SMA SZA 		/ ++++
	JMP	GETMD1 		/ NORMAL ASCII
	SNA 			/ ++++
	JMP I	GETMOD
	IAC
	SNA 			/ ++++
	ISZ	T1 		/ ADJUST T1 IF SHIFT-UNSHIFT CHANGE
	TAD	(MODTAB) 	/ ++++
	DCA	T2 		/ GET PTR
	TAD I	T2
	SPA 			/ ++++
	JMP I	GETMOD 		/ RETURN QUICK IF ERROR
	CMA
	AND I	T1
	SNL 			/ ++++
	TAD I	T2
	DCA I	T1 		/ SET NEW MODE
	JMP I	GETMOD
GETMD1,
	TAD I	T1 		/ ADD MODE FLAGS
	ISZ	T1		/BUMP TO SHIFT MODE
	SZL 			/ ++++
	TAD I	T1 		/ AND UNSHIFT

/PAGE-MARKERS LEAVING SCROLL BUFFER(GET) GOING INTO THE EDIT BUFFER	/A018

	DCA	T2		/SAVE THE CURRENT 12-BIT CHAR.		/A018
	TAD	T2		/REFRESH THE AC				/A018

	TAD	NWPAGE		/ IS IT A NEW-PAGE MARKER?		/M032
	SZA			/ SKIP IF: NEW-PAGE MARKER		/M032
	TAD	PAGEMK		/ IS IT A PAGE-MARKER?			/M032
	SZA CLA			/ SKIP IF: PAGE-MARKER			/A018
	JMP	RPCTEX		/ JUMP IF: NEITHER			/A018

	ISZ	T1		/ BUMP TO APPRO. PAGE-COUNTER		/A018
	AC7777			/ PAGE-MARKER LEAVING SCROLL BUFFER	/A018
	TAD I T1		/ DECR. PAGE-COUNTER ACCORDINGLY	/A018
	DCA I T1		/ UPDATE THE PAGE-COUNTER		/A018
RPCTEX,	TAD	T2		/ RETURN THE CURRENT 12-BIT CHAR.	/A018

	JMP I	GETMOD

	-1 			/ ERROR
	2000
	1400
	1000
	400
	200
	MODTAB=.
	40
/---------------
	PAGE

PUTSTX,	XX 			/ PUT 12-BIT TO STX

/D039	JMS	RPSAV12		/GO SAVE CURRENT 12 BIT CHAR.		/A026

/Save the current 12-bit char. going into either the ETX or		/M039
/STX scroll buffer for later (PUTBYT) PAGE-MARK counting...		/M039

	DCA	CUR12BIT	/MAKE A COPY OF 12-BIT CHAR.		/M039
	TAD	CUR12BIT	/TO BE USED AFTER XLATION		/M039

NXTSTX,	JMS	SAVSTX		/ SAVE THE CURRENT STX MODE.		/A028
	JMS	PUTMOD 		/ ++++
	STXMOD
	JMS	XLTCOS
	DCA	STXSV1		/PASS THE CHAR.		/A002

	JMS	PUTSTC
	TAD	CHRHLD 		/ RESCAN OR DONE (0)
	SZA 			/ SKIP IF BOTH BYTES DONE
	JMP	NXTSTX		/DO LAST BYTE OF WORD			/A026
	JMP I	PUTSTX

CUR12BIT, 0			/CURRENT "12-BIT" CHAR.			/A026

PUTETX,	XX 			/ PUT 12-BIT TO ETX

/D039	JMS	RPSAV12		/GO SAVE CURRENT 12 BIT CHAR.		/A026

/Save the current 12-bit char. going into either the ETX or		/M039
/STX scroll buffer for later (PUTBYT) PAGE-MARK counting...		/M039

	DCA	CUR12BIT	/MAKE A COPY OF 12-BIT CHAR.		/M039
	TAD	CUR12BIT	/TO BE USED AFTER XLATION		/M039

				/SECONDARY ENTRY FOR NEXT BYTE		/A026
NXTETX,	JMS	SAVETX		/ SAVE CURRENT ETX MODE SETTINGS.	/A028
	JMS	PUTMOD 		/ ++++
	ETXMOD
	CML 			/ ++++
	JMS	XLTCOS
	DCA	STXSV1		/PASS THE CHAR.		/A002

	JMS	PUTETC
	TAD	CHRHLD 		/ ++++
	SZA 			/ ++++
	JMP	NXTETX		/DO LAST BYTE OF WORD			/A026
	JMP I	PUTETX

PUTMOD,	XX 			/ CHECK FOR MODE CHANGES
	MQL 			/ CURRENT 12-BIT CHAR. INTO MQ
	MQA 			/ BACK INTO AC
	DCA	CHRHLD 		/ SAVE FOR RESCAN
	TAD I	PUTMOD 		/ ADDR. OF CURRENT MODE WORD
	DCA	T1 		/ T1 = PTR TO MODE WORD
	ISZ	PUTMOD		/BUMP TO RETURN ADDR
	MQA 			/ AC = CURRENT 12 BIT CHAR
	AND	(3600) 		/ ISOLATE MODE BITS
	CIA 			/ ++++
	TAD I	T1 		/ CHECK FOR ANY CHANGES
	SNA 			/ SKIP IF MODE CHANGE
	JMP	PUTMD1 		/ IF NONE, CHECK CASE
	DCA	T2 		/ SAVE DIFFERENCE
	TAD	(MSKTAB-1) 	/ ++++
	DCA	T3 		/ GET SEARCH PTR
	TAD	T2 		/ ++++
	BSW 			/ GET DIFFERENCE
	RTR 			/ ++++
	ISZ	T3 		/ ++++
	SMA SNL 		/ ++++
	JMP	.-3 		/ FIND FIRST CHANGE
	CLA CLL CML
	TAD I	T1 		/ ++++
	AND I	T3 		/ NEED TO CLEAR MODE?
	SZA 			/ ++++
	JMP	PUTMD2 		/ JUMP IF SO
	MQA 			/ ++++
	AND I	T3 		/ MUST NEED TO SET, THEN
	CML
PUTMD2,	MQL 			/ ++++
	MQA
	CMA 			/ ++++
	AND I	T1 		/ ++++
	SNL 			/ ++++
	MQA 			/ SET-CLEAR
	DCA I	T1 		/ STORE NEW MODE
	TAD	(TAB-1) 	/ ++++
	DCA	X1 		/ GET TAB PTR
	MQA
	TAD I	X1 		/ ++++
	SZA 			/ ++++
	JMP	.-2 		/ FIND CHANGE PATTERN
	TAD	X1 		/ ++++
	TAD	(-TABND-1) 	/ COMPTE CHANGE NUMBER
	JMP I	PUTMOD

PUTMD1,	MQA 			/ ++++
	AND	P100
	SNA CLA 		/ ++++
	JMP	PUTMD3 		/ JUMP IF NOT ALPHA
	ISZ	T1 		/ GET PTR TO UNSHIFT CODE
	MQA 			/ ++++
	AND	(40) 		/ GET UNSHIFT BIT
	CIA 			/ ++++
	TAD I	T1 		/ COMPARE WITH STORED VAL
	CLL
	SNA CLA 		/ ++++
	JMP	PUTMD4 		/ JUMP IF SAME
	MQA 			/ ++++
	AND	(40) 		/ GET NEW BIT
	SZA 			/ ++++
	CML 			/ SET LINK ACCORDINGLY
	DCA I	T1 		/ STORE NEW BIT
	CMA 			/ RETURN -1 CODE
	JMP I	PUTMOD

PUTMD3,	CLL CML
PUTMD4,	DCA	CHRHLD 		/ ++++
	MQA 			/ CLEAR RESCAN, RETURN CHAR
	JMP I	PUTMOD

CHRHLD,	.-.

TAB,	-2000
	2000-1400
	1400-1000
	1000-400
	400-200
	TABND=.

MSKTAB,	200
	1400
	2000


RDINI2,	XX
	BSW 			/ ++++
	RTR
	AND	T17 		/ ISOLATE AND SAVE DRIVE NUMBER
	DCA	RDFQBK+RXQDRV
	TAD	(CDFBUF)	/ get cdf to buffer field.		/A028
	DCA	RDFQBK+RXQBFD 	/ AND BUFFER FIELD
	JMP I	RDINI2
/---------------
	PAGE

XLTCOS,	XX
	SPA 			/ ++++
	JMP	XLTCO1 		/ JUMP IF MODE CHANGE
	AND	P177
	TAD	M100 		/ CHECK ALPHA
	SMA 			/ ++++
	JMP	XLTCO2 		/ JUMP IF ALPHA
	TAD	(100-37) 	/ ADJUST FOR COS
	SZA SMA 		/ ++++
	JMP I	XLTCOS 		/ RETURN IF OK
	TAD	(37-17) 	/ ++++
	SMA SZA 		/ ++++
	JMP	XLTCO3 		/ JUMP IF ILLEGAL

	TAD	(17-7) 		/ ++++	/D002/A016

	SPA 			/ ++++
	JMP	XLTCO3
	TAD	(SPCTAB) 	/ ELSE GET XLAT PTR
	JMP	XLTCO4 		/ AND XLATE
XLTCO3,
	CLA
	JMP I	XLTCOS

XLTCO1,	CMA RAL
	TAD	(-MAXCOS) 	/ ++++
	SMA 			/ ++++
	CLA
	TAD	(MAXCOS+COSTAB)
XLTCO4,	DCA	T1 		/ CONVERT TO PTR
	TAD I	T1
	JMP I	XLTCOS

XLTCO2,	AND	(37) 		/ ++++
	TAD	(-33)
	SMA 			/ ++++
	TAD	(7722-133+37) 	/ XLAT RESERVED CHARS
	TAD	(133-37) 	/ ADJUST
	JMP I	XLTCOS

/  make sure that there is room in this block for a 2-char.
/   ESC seq; it is no longer acceptable to split an ESC seq.
/   between 2 blocks because of the random access used by V2
/   GOTO PAGE.
/  if this is an ESC seq. and there is only 1 byte available in
/   the text buffer, send a null to fill up the buffer and cause
/   a write to disk.  then put the 2-char. ESC seq. in the next
/   block.  in this way, GOTO PAGE will never access a block con-
/   taining 1/2 of an ESC seq.

PUTETC,	XX		/ENTER W/CHAR. IN STXSV1
	TAD	SCEPTR	/GET THE ETX-BUFFER-CHAR. PTR.		/A002
	SZA CLA		/SKIP IF THIS WILL BE THE LAST BYTE	/A002
	JMP	RPETCX	/ROOM FOR 2-CHAR. ESC SEQ.		/A002

	TAD	STXSV1	/GET THE CURRENT 12-BIT WORD		/A002
	AND	P7700	/GET SET FOR				/A002
	TAD 	M7700	/COMPARE TO ESC SEQ. CHAR.		/A002
	SNA CLA		/SKIP IF NOT ESC SEQ			/M007
	JMS	PUTET1	/GO SEND NULL AS LAST BYTE		/A002

RPETCX,								/A002	

	JMS	SAVETX		/ SET EXTSAV TO CURRENT MODE SETTINGS.	/A028
	TAD	STXSV1
	AND	P77 		/ ++++
	SZA 			/ ++++
	JMS	PUTET1
	TAD	STXSV1 		/ ++++
	BSW 			/ ++++
	AND	P77 		/ ++++
	SZA 			/ ++++
	JMS	PUTET1
	JMP I	PUTETC

PUTSTC,	XX			/ENTER W/CHAR. IN STXSV1
	TAD	STXSAV 		/ ++++
	SZA 			/ ++++
	JMS	PUTST1

/ same 2-char. ESC seq. check done here...

	AC0001			/AC => 1				/A002
	TAD	SCTPTR		/ADVANCE STX BUFFER CHAR. POINTER	/A002
	TAD	(-SCHCNT	/COMPARE TO MAX. # OF BYTES		/A002
	SZA CLA			/SKIP IF THIS CHAR. WILL FILL BUFFER	/A002
	JMP	RPSTCX		/ROOM FOR A 2-CHAR. ESC SEQ.		/A002

	TAD	STXSV1	/GET THE CURRENT 12-BIT WORD			/A002
	AND	P7700	/GET SET FOR					/A002
	TAD 	M7700	/COMPARE TO ESC SEQ. CHAR.			/A002
	SNA CLA			/SKIP IF NOT ESC SEQ			/M007
	JMS	PUTST1		/GO SEND NULL AS LAST BYTE		/A002

RPSTCX,	TAD	STXSV1 							/A002
	BSW 			/ ++++
	AND	P77 		/ ++++
	SZA 			/ ++++
	JMS	PUTST1
	TAD	STXSV1 		/ ++++
	AND	P77 		/ ++++
	DCA	STXSAV
	JMP I	PUTSTC

GETETC,	XX
	JMS	GETET1
	TAD	(-77) 		/ ++++
	SZA 			/ ++++
	JMP	GETETA
	JMS	GETET1
	TAD	P7700
	SKP
GETETA,	TAD	P77
	JMP I	GETETC

GETSTC,	XX
	TAD	STXSAV 		/ ++++
	SNA 			/ ++++
	JMS	GETST1
	DCA	STXSV1
	JMS	GETST1
	TAD	(-77) 		/ ++++
	SNA 			/ ++++
	JMP	GETSA1
	TAD	P77 		/ ++++
	DCA	STXSAV
	JMP	GETSA2
GETSA1,	DCA	STXSAV
	TAD	P7700
GETSA2,	TAD	STXSV1
	JMP I	GETSTC

STXSAV,	0
STXSV1,	.-.

STXMOD,	0 			/ STX MODES
	0			/SHIFT FLAG
	0			/STX BUFFER PAGE-COUNTER		/A018
STXDES,	0			/DESCRIPTOR WORD FOR BLK BEING WRITTEN	/A030
				/OUT THROUGH STX BUFFER			/A030
/---------------
	PAGE

				/ SCINI - INIT FOR FILENO IN AC
	SCHCNT=774 		/ #CHARS IN DATA BLOCK
				/ 774 = 508 DEC.
				/ DECIMAL: 254 12-BIT CHARS = 508 6-BIT CHARS.

	BOFSET= 2 		/ OFFSET TO FIRST CHAR. WORD IN BLOCK
	SCBKOF=52 		/ OFFSET TO BLOCK PTRS IN 1ST HEADER

SCINI,	XX
	DCA	T1
	TAD	T1
	AND	P377 		/ ISOLATE DOCUMENT NUMBER
	DCA	SCQBLK+RXQFNO 	/ STORE FILE #

	TAD	T1
	BSW 			/ ++++
	RTR 			/ POSITION DRIVE NUMBER
	AND	T17		/(17) GETS DRIVE FLAGS			/M025
	DCA	SCQBLK+RXQDRV 	/ SET DRIVE FLAGS
	JMS	SCQRX		/ GO GET DENSITY TO ESTAB DENSITY OF DRIVE
	RXEDN+4000
	0

	JMS	SCQRX
	RXEGF 			/ ++++
	0
	TAD	SCQBLK+RXQBLK 	/ PICK UP BLOCK NUMBER
	SNA 			/ ++++
	JMP	SCIER1 		/ WE DID GET ONE?
	DCA	SCHDRB 		/ SAVE AS HEADER BLOCK NUMBER
	TAD	(SCHDRB) 	/ ++++
	DCA	SCHDBN 		/ READ FIRST HEADER

	JMS	SCGTWR
	CDFBUF 			/ GET FILE SIZE
	TAD I	(SCHDR+5)
	DCA	SCFILZ

	TAD	SCFILZ 		/ ++++
	TAD	M310		/GREATER THAN 210 PTRS.?		/A025
	SMA CLA 		/ ++++
	TAD I	(SCHDR+2)
	CDFMYF
	DCA	SCHDRB+1
	CDFBUF
	TAD I	(SCHDR+3)
	CDFMYF
	DCA	SCHDRB+2
	JMS	SCFLZB		/ GO SET UP TOP AND BOTTOM POINTERS	/A003
	CDFBUF
	TAD I	(SCHDR+1)
	MQL 			/ ++++
	AC2000 			/ ++++
	MQA 			/ OPEN FOR UPDATE
	DCA I	(SCHDR+1)
	AC0001
	TAD I	(SCHDR+12) 	/ INCR TIME EDITED
	SMA 			/ ++++
	DCA I	(SCHDR+12) 	/ DON'T INCR PAST 2047
	CLA
	DCA I	(SCHDR+SCBKOF+2)	/ CLEAR "DATA BLK 0" PTR
	CDFMYF
	AC0001 			/ ++++
	JMS	SCGTWR 		/ WRITE OUT HEADER
	JMS	GTHDRS		/ GO GET HEADER EXTENSIONS INTO MEMEORY	/A003
	SCBFCB			/ POINT TO THE HDR CONTROL BLOCK	/A003
	JMP	SCINX 		/ TAKE OK RETURN
SCIER1,
	IAC
SCINX,	JMP I	SCINI 		/ DONE

				/ SCWEB - WRITE END BLOCK
SCWEB,	0
	JMS	SCTPBT		/ GO SEE IF BOTTOM = TOP +1		/A003
	JMS	SCALOC 		/ YES - ALLOCATE A BLOCK BETWEEN THEM
	JMS	SCBUFI 	/ GO INITIATE BUFFER AREA FOR COS 310 COMPATIBILITY
	SCEB 			/ INIT BUF HDR FOR COS
	JMS	SCBOTP		/ GO DECREMENT BOTTOM 			/A003
	-1			/ BY 1					/A003
	JMS	SCGETR 		/ GET BLOCK NUMBER SCBOT - 1 POINTS TO
	SCBTH			/ BOTTOM HEADER POINTER			/A003
	SCBOT			/ BOTTOM HEADER WORD POINTER		/A003

	JMS	SCQRX 		/ WRITE END BUFFER TO THAT BLOCK
	RXEWT+2000 		/ ++++
	SCEB
	CLA			/ MAKE SURE OF CLEAR AC			/A037
	DCA	RPMODE		/ CLEAR MODE WORD 			/A037
	JMS	TORPDSBD	/ WRITE GTP TEXT BLK			/A032
	DCA	PAGLIM		/ CLEAR PAGE LIMIT FLAG			/A032
	JMP I	SCWEB 		/ RETURN

				/ SCWTB - WRITE TOP BLOCK
SCWTB,	0
	JMS	SCTPBT		/ CHECK IF A BLOCK IS 'TWEEN TOP AND BOTTOM/A003
	JMS	SCALOC 		/ NO - SO ALLOC ONE TO GO THERE
	JMS	SCBUFI 		/ GO INIT BUFFER AREA FOR COS 310 COMPATIBILITY
	SCTB 			/ INIT BUF HDR FOR COS
	JMS	SCTOPP		/ GO INCREMENT TOP POINTERS		/A003
	1			/ UP BY 1				/A003
	JMS	SCGETR 		/ GET THAT BLOCKNO
	SCTPH			/ TOP HEADER POINTER			/A003
	SCTOP			/ TOP HEADER WORD POINTER		/A003

	JMS	SCQRX 		/ WRITE TOP BUFFER THERE
	RXEWT+2000 		/ ++++
	SCTB
	JMS	TORPDSBD	/ WRITE GTP TEXT BLK			/A032
	DCA	PAGLIM		/ CLEAR PAGE LIMIT FLAG			/A032
	JMP I	SCWTB 		/ DONE

SCBUFI,	XX			/ INTIALIZE 1ST TWO WORDS IN BUFFER	/A003
	AC7777			/ MINUS 1 TO AC				/A003
	TAD I	SCBUFI		/ GET BUFFER ADDRESS - 1 (FOR INDEXING)	/A003
	DCA	X0		/ PUT ADDRESS INTO AUTO INDEXING AREA	/A003
	TAD	(COSCNT)	/ GET COS COMPATIBLE CHARACTER		/A003
	CDFBUF			/ CHANGE TO BUFFER FIELD		/A003
	DCA I	X0		/ STUFF COS 310 STUFF IN BUFFER		/A003
	DCA I	X0		/ ZERO SECOND BYTE OF BUFFER		/A003
	CDFMYF			/ BACK TO THIS FIELD			/A003
	ISZ	SCBUFI		/ BUMP UP TO RETURN			/A003
	JMP I	SCBUFI		/ RETURN				/A003
/---------------
	PAGE

/D047	IFNDEF	STATLN	<						/A043
/D047	/ SCALOC - ALLOCATE 3 BLOCKS BETWEEN TOP AND BOTTOM
/D047 SCALOC,	XX
/D047	AC7775 			/ GET MINUS THREE FOR LOOP CONTROL
/D047	DCA	SCALCT 		/ SET TO ALLOC 3
/D047			>	/ END IFNDEF STATLN			/A043
/D047	IFDEF	STATLN	<						/A043

	/ SCALOC - ALLOCATE 1 BLOCK BETWEEN TOP AND BOTTOM		/A043

SCALOC,	XX 								/A043
	AC7777			/ GET MINUS ONE FOR LOOP CONTROL	/A043
	DCA	SCALCT 		/ SET TO ALLOC 1			/A043

/D047			>	/ END IFDEF STATLN			/A043

	TAD	SCBTH		/ GET BOTTOM HEADER POINTER		/A003
	DCA	SCBTHS		/ SAVE BOTTOM HEADER POINTER		/A003
	TAD	SCBOT 		/ GET BOTTOM				/A003
	DCA	SCBOTS		/ SAVE BOTTOM HEADER WORD POINTER	/A003
	DCA	SCALC 		/ INIT COUNT				/A003
	JMP	SCALCD		/ GO INCREMENT AND GET BLOCK NBR	/A003

SCALC1,	JMS	SCBOTP		/ GO INCREMENT BOTTOM POINTERS		/A003
	1			/ BY ONE				/A003

SCALCD,	ISZ	SCALC		/ INREMENT THE COUNTER			/A003
	JMS	SCGETR 		/ GET BLOCK NUMBER
	SCBTH
	SCBOT
	SZA CLA 		/ IS IT END OF FILE?
	JMP	SCALC1 		/ NO - LOOK AT NEXT ONE

	TAD	SCALC 		/ GET COUNT OF HOW MANY BLOCKS 'TILL END
	CIA 			/ MAKE NEGATIVE FOR ISZ LOOP
	DCA	SCALC 		/ SAVE


/D047	IFDEF	STATLN	<						/A043

	AC0001			/ SET UP TO BUMP FILE BY ONE BLOCK	/A043

/D047			>	/ END IFDEF STATLN			/A043
/D047	IFNDEF	STATLN	<						/A043
/D047	AC0003 			/ SET UP TO BUMP FILE BY THREE BLOCKS
/D047			>	/ END IFNDEF STATLN			/A043

	TAD	SCFILZ 		/ COMPUTE NEW FILE SIZE
	DCA	SCFILZ

	JMS	SCALC2		/ GO MOVE TAIL END OF FILE 1 BLOCKS OVER/M047
	TAD	SCBTHS		/ GET BOTTOM HDR PTR UPON ENTRY		/A003
	DCA	SCBTH		/ PUT IT BACK INTO BOT HDR PTR		/A003
	TAD	SCBOTS		/ GET BOTTOM HDR WORD PTR		/A003
	DCA	SCBOT		/ BACK INTO BOT HDR WORD PTR		/A003

SCALC3,	JMS	RPALLOCATE	/ SUBROUTINE TO ALOC A BLOCK		/A030
	JMS	SCPUTR 		/ SAVE IN B
	SCBTH			/ BOTOM HDR POINTER			/A003
	SCBOT			/ BOTTOM HEADER WORD POINTER		/A003

	JMS	SCBOTP 		/ INCR BOTTOM
	1			/ BY 1					/A003
	ISZ	SCALCT 		/ ++++
	JMP	SCALC3 		/ LOOP FOR ALL
	JMP I	SCALOC		/ DONE

SCBTHS,	0			/ TO SAVE HEADER POINTER		/A003
SCBOTS,	0			/ TO SAVE HEADER WORD POINTER		/A003
SCALC,	0
SCALB,	0
SCALCT,	.-.



DSKINI,	0	/ DSKINI - TOP LEVEL INIT ROUTINE - FILENO IN AC
	DCA	SCOPTN
	DCA	RPMODE		/GOTO-PAGE-BUILT TEXT BLOCK MODE	 /M019
	JMS	CLPTRS		/CLEAR BOTH HDR-BLK-PTR TABLES		/A024
	MQA
	JMS	SCINI 		/ DO INIT OF HDR BLOCK
	SZA 			/ ++++
	JMP	DSKIN1 		/ JUMP IF ERROR
	DCA	SCTPTR
	TAD	(SCHCNT-1)
	DCA	SCEPTR
	JMS	SCQRX 		/ GET # FREE BLOCKS
	RXESP 			/ ++++
	SCHDR
	JMS	SCSPC 		/ PUT IN HDR FOR CALLER
	DCA	STXSAV 		/ INIT LOOK-AHEAD
	DCA	STXMOD 		/ ++++
	DCA	STXMOD+1
	DCA	ETXMOD 		/ ++++
	DCA	ETXMOD+1 	/ INIT MODES
	DCA	HLDMOD		/ INIT AT OPEN				/A030
	DCA	RPPCTLFL	/ INIT AT OPEN TIME			/A030

DSKIN1,	JMP I	DSKINI 		/ DONE

SCFNO,	0
	SCIST=10


/	SCSPC MOVED HERE FOR SPACE, EDIT # 045				/A045

SCSPC,	0			/ PUT # FREE BLOCKS IN HDR
	TAD	SCQBLK+RXQSPC 	/ FROM Q BLOCK
	DCA	SCFSPC
	JMP I	SCSPC


				/ SCREB - READ END BLOCK
SCREB,	0
	JMS	SCGETR 		/ GET BLOCK NUMBER BOTTOM POINTS TO
	SCBTH			/ BOTTOM HEADER POINTER			/A003
	SCBOT			/ BOTTOM HEADER WORD POINTER		/A003
	SNA 			/ IS BLOCK ZERO?
	JMP I	SCREB 		/ YES - EOF - NON-SKIP RETURN

	JMS	SCQRX 		/ DO A READ OF IT
	RXERD 			/ ++++
	SCEB
	JMS	RPRD1		/ GO READ GTP TEXT BLOCK		/A032
	JMS	SCBOTP		/ GO INCREMENT BOTTOM POINTERS		/A003
	1			/ BY 1					/A003
	ISZ	SCREB 		/ SKIP RETURN
	JMP I	SCREB
	JMP I	SCRTB 		/ NON-SKIP RETURN
				/ SCRTB - READ TOP BLOCK

SCRTB,	0
	DCA	GTFLG		/ ON ENTRY AC = (-)			/A030
				/ SET FLAG TO MINUS TO INDICATE A GETSTX/A030
	JMS	SCGETR 		/ GET BLOCK NUMBER
	SCTPH			/ TOP HEADER POINTER			/A003
	SCTOP			/ TOP HEADER WORD POINTER		/A003
	SNA 			/ ZERO BLOCK IS EOF
	JMP	NOBLK		/ MUST NOW CLEAR GTFLG WHEN NO MORE TOP	/A030
				/ BLK.  ELSE A GETETX WOULD TRIGGER A	/A030
				/ SET-UP OF HLDMOD			/A030

	JMS	SCQRX 		/ READ INTO TOP BLOCK BUFFER
	RXERD 			/ ++++
	SCTB
	JMS	RPRD1		/ GO READ GTP TEXT BLOCK		/A032
	JMS	SCTOPP 		/ DECR TOP POINTER
	-1			/ AMOUNT TO DECREMENT BY		/A003
	ISZ	SCRTB 		/ SKIP RETURN
NOBLK,	DCA	GTFLG		/ CLEAR FLAG SO GETETX WON'T SET-UP	/A030
				/ AND CORRUPT HLDMOD			/A030
	JMP I	SCRTB
/---------------
	PAGE

				/ SOME UTILITIES
SCGETR,	XX			/ GET A WORD FROM OUT OF THE HEADERS	/A003
	CLA
	TAD	SCGETR		/ GET ADDR OF ADDRESS OF HEADER PTRS	/A003
	JMS	SCGETX		/ GO GET THE WORD OUT OF THE HEADERS	/A003
	JMS	RPGETR		/ GET WORD OUT OF RPPGDS ALSO		/A002

	CDFBUF		/ CHANGE TO THE BUFFER FIELD (WHERE HEADER IS)	/A003
	TAD I	SCGTR1	/ GET THE WORD FROM THE HEADER			/A003
	CDFMYF		/ BACK TO THIS FIELD				/A003
	ISZ	SCGETR		/ BUMP PAST THE HDR PTR ADR		/A003
	ISZ	SCGETR		/ BUMP UP TO THE RETURN ADDR		/A003
	JMP I	SCGETR		/ GO BACK TO CALLER			/A003

SCPUTR,	XX		/ ROUTINE TO PUT A WORD INTO THE HEADERS	/A003
	DCA	SCPTR1	/ SAVE THE WORD TO PUT INTO THE HEADER		/A003
	TAD	SCPUTR	/ GET ADDR OF THE HDR PTR ADDR'S		/A003
	JMS	SCGETX	/ GO GET THE HEADER				/A003
	TAD	SCPTR1	/ GET THE WORD TO PUT INTO THE HEADER		/A003
	CDFBUF		/ CHANGE TO BUF FIELD (WHERE HEADER IS)		/A003
	DCA I	SCGTR1	/ PUT THE WORD INTO THE HEADER			/A003
	CDFMYF	/ BACK TO THIS FIELD					/A003

	JMS	RPPUTR		/PUT WORD INTO RPPGDS ALSO		/A002

	ISZ	SCPUTR		/ BUMP PAST PARAMS PASSED		/A003
	ISZ	SCPUTR		/ BUMP PAST PARAMS PASSED		/A003
	AC0001			/ SIGNAL THAT HEADER IS MODIFIED	/A003
	DCA	SCHDMD		/ PUT SIGNAL INTO HDR CTL BLOCK		/A003
	JMP I	SCPUTR		/ GO BACK 				/A003

SCGETX,	XX		/ ROUTINE TO SET UP FOR HEADER READ		/A003
	DCA	SCGTR1	/ SAVE ADDR OF PTR ADDRESSES			/A003
	TAD I	SCGTR1	/ GET THE HDR PTR				/A003
	DCA	SCGTR2		/ SAVE THE HDR PTR			/A003
	ISZ	SCGTR1		/ BUMP UP TO PT TO HDR WORD PTR		/A003
	TAD I	SCGTR1		/ GET HDR WORD PTR			/A003
	DCA	SCGTR1	/ SAVE IT FOR LATER USE				/A003
	JMS	SCOFST		/ GO SEE IF HEADER IS IN CORE		/A003
	SCBFCB			/ HEADER CONTROL BLOCK 			/A003
	JMP I	SCGETX		/ RETURN 				/A003
SCPTR1,	.-.
SCGTR1,	.-.		/ TO SAVE HDR WORD POINTER			/A003
SCGTR2,	0		/ TO SAVE HDR POINTER				/A003

				/ DSKCLS - TOP LEVEL CLOSE ROUTINE
DSKCLS,	0
	AC0100 			/ FORCE STXMOD=ETXMOD
	TAD	ETXMOD+1 	/ ++++
	TAD	ETXMOD 		/ MODES + SHIFT
	JMS	PUTSTX 		/ ++++
	JMS	GETSTX 		/ ++++
	CLA

/ THE LOGIC BELOW USED TO MOVE THE ETX BUFFER TO THE STX BUFFER WITH	/A028
/ OVERFLOW GOING OUT TO THE DISK & THEN NULL OUT THE REMAINDER OF THE	/A028
/ STX BUFFER & WRITE IT OUT TOO. THIS CODE WORKS FINE BUT WILL NOT	/A028
/ MAINTAIN THE EXTMOD MODE SETTINGS (SINCE EVERYTHING IS DONE IN 6-BIT	/A028
/ RATHER THAN 12 BIT MODE COPY). AS A RESULT, THE GOTO PAGE DESCRIPTOR	/A028
/ WORD WOULD NOT BE CORRECT IF AND SHIFT/ESCAPE CODES MOVED FROM THE	/A028
/ ETX BUFFER INTO THE STX BUFFER (PROBABILITY OF > 99.9 %). THEREFORE	/A028
/ THE LOGIC NOW WORKS AS FOLLOWS. IF THERE IS ENOUGH ROOM IN THE STX	/A028
/ BUFFER TO ACCOMODATE THE TEXT IN THE ETX BUFFER, THE PRIOR LOGIC IS	/A028
/ INVOKED. IF NOT THEN BOTH BUFFERS AR WRITTEN OUT ESSENCIALLY AS IS	/A028
/ (THE BUFFER IS NULLED OUT TO THE START/END OF BUFFER AS APPROPRIATE).	/A028

	TAD	STXSAV		/ SEE IF A "SAVE CHAR" EXISTS.		/A028
	SZA CLA			/ SKIP IF NO.				/A028
	AC0001			/ YES. COUNT IT.			/A028
	TAD	SCEPTR		/ ADD # OF CHARS IN STX MINUS 1.	/A028
	TAD	SCTPTR		/ ADD # OF CHARS IN ETX MINUS 1.	/A028
	TAD	(-SCHCNT+1)	/ COMPARE TO MAX # OF CHARS IN BLOCK PLUS/A028
	SMA CLA			/ BAIS. AC WILL BE <0 IF ALL CHARS FIT	/A028
				/ OR FILL BUFFER UP EXACTLY.		/A028
	JMP	DSKCL2		/ CANNOT FIT. WRITE BUFFERS AS IS.	/A028
DSKCL1,				/ MOVE ALL CHARS IN ETX BUF TO STX BUF
	TAD	SCEPTR 		/ SEE IF ALL DONE
	TAD	(-SCHCNT+1)
	SNA CLA
	JMP	DSKCL2 		/ ALL DONE MOVING
	JMS	GETET1 		/ GET 1 BYTE

	DCA	STXSV1		/SUPPLY THE CHAR.		/A002
	JMS	PUTSTC 		/ AND MOVE IT (WITH OVERFLOW TO DISK)
	JMP	DSKCL1 		/ TRY ANOTHER CHAR

DSKCL2,	TAD	STXSAV 		/ FLUSH LOOK-AHEAD, IF ANY
	SZA
DSKCL3,	JMS	PUTST1 		/ PAD WITH NULLS TO FILL
	TAD	SCTPTR 		/ IS BUFFER EMPTY (MEANING ALL OUTPUT?)
	SZA CLA 		/ ++++
	JMP	DSKCL3 		/ LOOP IF NOT

DSKCL4,	TAD	SCEPTR		/ GET ETX COUNT OF CHARS.		/A028
	TAD	(-SCHCNT+1)	/ WHEN BUFFER TOTALLY FULL WE'RE DONE.	/A028
	SNA CLA			/ SKIP IF NOT FULL YET.			/A028
	JMP	DSKCL5		/ FULL. DONE.				/A028
	JMS	PUTET1		/ NULL BALANCE OF ETX BUFFER.		/A028
	JMP	DSKCL4		/ LOOP UNTIL EXT BUFFER "MT"S		/A028

DSKCL5,	JMS	SCCLS 		/ CLOSE AT THE BLOCK LEVEL
				/ SET MODIFIED DATE-TIME IN HEADER
	CDFSYS
	TAD I	(CLOCK+4) 	/ HOUR
	BSW 			/ ++++
	TAD I	(CLOCK+3) 	/ MINUTE
	CDFBUF
	DCA I	(SCHDR+14)

	CDFSYS
	TAD I	(PAKDAT) 	/ DAY/MONTH
	CDFBUF
	DCA I	(SCHDR+10)

	CDFSYS
	TAD I	(YEAR) 		/ YEAR
	CDFBUF
	DCA I	(SCHDR+11)

	CDFMYF			/ BACK TO THIS FIELD
	AC0001
	JMS	SCGTWR		/ WRITE OUT HEADER
	JMS	WRITEOUT	/ WRITE THE ALLOCATION BLOCK		/A033
	JMP I	DSKCLS 		/ ALL DONE - RETURN TO CALLER

DSKCLC,	XX			/ VERY, VERY TOP LEVEL CLOSE ROUTINE
				/ CHECKS TO MAKE SURE A FILE WAS OPEN BEFORE IT
				/ CALLS THE REAL CLOSE ROUTINE
	CLA
	TAD	SCQBLK+RXQFNO	/ SEE IF FILE NO. IS NON-ZERO
	SNA CLA			/ IF ZERO JUST RETURN
	JMP I	DSKCLC
	JMS	DSKCLS		/ CALL REAL CLOSE
	DCA	SCQBLK+RXQFNO	/ CLEAR FILE NO.
	JMP I	DSKCLC		/ RETURN
/---------------
	PAGE

/	START AT BOTTOM OF STX-BUFFER AND WORK TOWARDS TOP

GETST1,	XX 			/ GET 1 BYTE FROM STX
	AC7777 			/ ++++
	TAD	SCTPTR 		/ BACKUP PTR
	SMA 			/ ++++
	JMP	GETSX1 		/ JUMP IF STILL OK
	JMS	SCRTB 		/ GET A NEW TOP BLOCK
	JMP	GETSX2 		/ NO MORE BLOCKS AVAILABLE

	TAD	RPPTR1		/CURRENT V2 DESC. WORD			/A018
	AND	(37		/SAVE # OF PAGES IN THIS BLK		/A018
	DCA	STXMOD+2	/INIT. STX BUFFER PAGE-COUNTER	/A018

	TAD	(SCHCNT-1) 	/ REINIT PTR
GETSX1,	DCA	SCTPTR
	TAD	SCTPTR
	JMS	GETBYT 		/ ++++
	SCTB+BOFSET
	SNA 			/ ++++
	JMP	GETST1+1 	/ IGNORE NULLS
GETSX2,	JMP I	GETST1 		/ RETURN

/	START AT TOP OF STX BUFFER AND WORK DOWN

PUTST1,	XX 			/ PUT 1 BYTE TO STX
PUTST2,	MQL
	TAD	(STXMOD+2	/POINTER TO STX BUFFER PAGE-COUNTER	/A018
	DCA	T3		/IDENTIFIES PAGE-COUNTER TO PUTBYT	/A018

	TAD	SCTPTR
	JMS	PUTBYT 		/ ++++
	SCTB+BOFSET
	ISZ	SCTPTR 		/ BUMP CHAR PTR
	TAD	SCTPTR 		/ ++++
	TAD	(-SCHCNT) 	/ STILL IN RANGE?
	SZA CLA 		/ ++++
	JMP	PUTSX1 		/ JUMP IF SO
	JMS	SCWTB 		/ ELSE OUTPUT FULL BLOCK
	CLA			/IO RESULT				/A018
	TAD	STXHLD		/ SET HLDSTX TO BE THE MODE OF THE 1ST	/A028
	DCA	HLDMOD		/ CHAR OF NEW (LAST OF OLD) BUFFER.	/A028
	DCA	SCTPTR		/CLEAR BUFFER-BYTE POINTER		/A018
	DCA	STXMOD+2	/AND STX PAGE-COUNTER			/A018

PUTSX1,	TAD	PAGLIM		/ SEE IF PAGE LIMIT FLAG IS SET		/A032
	SZA CLA			/ SKIP IF: # OF PAGES IN BLK. WITHIN 	/A032
				/          RANGE			/A032
	JMP	PUTST2		/ PAD REST OF BLK WITH NULLS		/A032
	JMP I	PUTST1 		/ AND RETURN

/	START AT TOP OF ETX BUFFER AND WORK DOWN

GETET1,	XX 			/ GET 1 BYTE FROM ETX
	CLA 			/ ++++
	TAD	SCEPTR
	TAD	(-SCHCNT+1) 	/ STILL IN RANGE?
	SZA CLA 		/ ++++
	JMP	GETEX1 		/ JUMP IF SO
	JMS	SCREB 		/ ++++
	JMP	GETEX2 		/ ELSE REFILL BUFFER

	TAD	RPPTR1		/CURRENT DESC. WORD			/A018
	AND	(37		/# OF PAGES ONLY			/A018
	DCA	ETXMOD+2	/INIT. ETX BUFFER PAGE-COUNTER	/A018
	DCA	SCEPTR 		/ RESET PTR
	SKP 			/ (SKIP ISZ INST)
GETEX1,	ISZ	SCEPTR 		/ BUMP CHAR PTR
	TAD	SCEPTR
	JMS	GETBYT 		/ ++++
	SCEB+BOFSET
	SNA 			/ ++++
	JMP	GETET1+1 	/ IGNORE NULLS
GETEX2,	JMP I	GETET1 		/ AND RETURN

/	START AT BOTTOM OF ETX BUFFER AND WORK BACK

PUTET1,	XX 			/ PUT 1 BYTE TO ETX
PUTET2,	MQL
	TAD	(ETXMOD+2	/ADDR. OF ETX BUFFER PAGE-COUNTER	/A018
	DCA	T3		/IDENTIFIES PAGE-COUNTER TO PUTBYT	/A018

	TAD	SCEPTR
	JMS	PUTBYT 		/ ++++
	SCEB+BOFSET
	AC7777 			/ ++++
	TAD	SCEPTR 		/ STILL IN RANGE?
	SMA 			/ ++++
	JMP	PUTEX1 		/ JUMP IF SO
	JMS	SCWEB 		/ ELSE OUTPUT FULL BUFFER

	CLA			/					/A018
	DCA	ETXMOD+2	/INIT. ETX BUFFER PAGE-COUNTER		/A018

	TAD	(SCHCNT-1) 	/ AND REINIT PTR
PUTEX1,	DCA	SCEPTR 		/ UPDATE PTR
	TAD	PAGLIM		/ SEE IF PAGE LIMIT FLAG IS SET		/A032
	SZA CLA			/ SKIP IF: # OF PAGES IN BLK. WITHIN 	/A032
				/          RANGE			/A032
	JMP	PUTET2		/ PAD REST OF BLK WITH NULLS		/A032
	JMP I	PUTET1 		/ AND RETURN

GETBYT,	XX
	CLL RAR
	TAD I	GETBYT
	DCA	GETBY1
	ISZ	GETBYT
	CDFBUF
	TAD I	GETBY1
	CDFMYF
	SNL 			/ ++++
	BSW
	AND	P77
	JMP I	GETBYT

PUTBYT,	XX
	CLL RAR
	TAD I	PUTBYT
	DCA	PUTBY1
	ISZ	PUTBYT
	CDFBUF
	TAD I	PUTBY1
	SNL 			/ ++++
	BSW
	AND	P7700
	MQA
	SNL 			/ ++++
	BSW
	DCA I	PUTBY1
	CDFMYF

	TAD	CUR12BIT	/CURRENT 12-BIT CHAR.			/M026
	SNA			/SKIP IF 1ST BYTE BEING STORED		/A018
	JMP	RPPUTX		/CURRENT 12-BIT CHAR. ALREADY COUNTED	/A018
	JMS	CHKPAG		/ CHECK FOR PAGE/NEW-PAGE MARKER.	/M028

RPPUTX,	DCA	CUR12BIT	/CLEAR FOR 2ND BYTE (IF ONE)		/A026
	JMP I	PUTBYT

	GETBY1=PUTBYT
	PUTBY1=GETBYT
/---------------
	PAGE

/*******************************************************************	/A003
/
/	THIS ROUTINE CLOSES THE DOCUMENT AFTER AN EDIT SESSION.		/A003
/	IT WILL FREE UP ALL UNUSED BLOCKS THAT HAVE BEEN ALLOCATED TO IT/A003
/	AND IT WILL "SQUISH" THE DOCUMENT SO THAT ALL ITS BLOCKS ARE	/A003
/	CONTIGUOUS IN THE "HI ORDER" POSTION OF ITS HEADER BLOCKS	/A003
/	IT WILL ALSO FREE UP ALL UNUSED HEADER BLOCKS AND UPDATE THE	/A003
/	HEADER BLOCKS THEMSELVES (THE IN-USE BIT TURNED OFF, THE DATES	/A003
/	AND TIMES OF THE CLOSE PUT INTO THE HEADERS, ETC)		/A003
/									/A003
/***********************************************************************/A003

SCCLS,	0			/ SCCLS - CLOSE HEADER BLOCK
	JMS	SCBOTP		/ DECREMENT BOTTOM-OF-DOCUMENT PTRS	/A003
	-1			/ THIS POINTS TO THE LAST UNUSED BLOCK	/A003
	TAD	SCBOT		/ NOW WE SAVE THE BOTTOM-OF DOC POINTERS/A003
	DCA	SCBTSV		/ SO THAT WE CAN KNOW WHEN TO STOP	/A003
	TAD	SCBTH		/ FREEING UP BLOCKS			/A003
	DCA	SCBHSV							/A003
	JMS	SCBOTP		/ REPOSITION BOT-OF-DOC PTRS TO POINT TO/A003
	1			/ NEXT BLOCK OF DOCUMENT		/A003
	JMS	SCREQ		/ GO SEE IF THERE ARE ANY BLOCKS TO FREE/A003
	SMA CLA			/ IF YES, GO DO IT			/A003
	JMP	SCCLS7		/ IF NONE, NO FREEING, NO SQUISHING	/A003
	JMS	SAVTOP		/ GO SAVE TOP POINTERS			/A003

SCCLS1,	JMS	SCTOPP		/ GO INCREMENT TOP-OF-DOC POINTERS	/A003
	1			/ POSITION TO GET BLK TO FREE OR SQUISH	/A003
	AC7777			/ GET A MINUS 1 TO DECREMENT WITH	/A003
	TAD	SCFILZ		/ DECREMENT THE FILE SIZE BY ONE	/A003
	DCA	SCFILZ		/ STORE IT FOR NEXT TIME		/A003
	JMS	SCGETR		/ GO GET BLOCK NUMBER TO FREE UP	/A003
	SCTPH								/A003
	SCTOP								/A003
	JMS	SCQRX		/ GO FREE THE BLOCK JUST GOTTEN		/A003
	RXEFR								/A003
	0								/A003
	JMS	SCREQ		/ GO SEE IF WE'RE DONE FREEING UP BLOCKS/A003
	SZA CLA			/ IF ZERO, WE'RE DONE			/A003
	JMP	SCCLS1		/ OF NPOT ZERO, GO FREE UP ANOTHER	/A003
	JMS	GETTOP		/ GO GET TOP POINTERS PREV SAVED	/A003

SCCLS2,	JMS	SCTOPP		/ GO INCREMENT TOP PTRS			/A003
	1								/A003
	JMS	SCGETR		/ GO GET A BLOCK TO SQUISH		/A003
	SCBTH								/A003
	SCBOT								/A003
	SNA 			/ CHECK IF DONE				/A003
	JMP	SCCLS6		/ 0 BLOCK NUMBER INDICATES EOF		/A003
	JMS	SCPUTR		/ GO PUT BLK NBR AT TOP-OF-DOC		/A003
	SCTPH			/ IN OREDER TO SQUISH THE FILE		/A003
	SCTOP								/A003
	JMS	SCBOTP		/ GO INCREMENT BOTTOM-OF-DOCUMENT PTRS	/A003
	1								/A003
	JMP	SCCLS2		/ GO INCREMENT TOP-OF-DOC PTRS (CONT)	/A003

				/ ALL DONE SQUISHING/FREEING		/A003
SCCLS6,	AC7777			/ END OF RPPGDS DESCRIPTORS		/A002
	DCA	RPPTR1		/ FOR WRITE TO RPPGDS			/A002
	JMS	SCPUTR		/ GO PUT OUT THE 0-BLOCK NBR INDICATING	/A003
	SCTPH			/ END OF FILE				/A003
	SCTOP								/A003
SCCLS7,	JMS	SCCLSE		/ GO FREE UP EXCESS HDR BLOCKS		/A003
	TAD	SCFILZ		/ GET FILE SIZE TO PUT INTO HEADER	/A003
	JMS	SCPUTR 		/ GO PUT THE FILE SIZE INTO HEADER 1	/A003
	ONE			/ INDICATE HEADER ONE			/A003
	THREE			/ INDICATE THE 5TH WORD OF HEADER	/A003
	JMS	SCGETR 		/ GO GET THE IN-USE BIT FROM 1ST HEADER	/A003
	ONE			/ INDICATE 1ST HEADER			/A003
	MONE			/ INDIC 0TH WORD (WHERE IN-USE BIT IS)	/A003
	AND	(1777)		/ TURN OFF IN-USE BIT			/A003
	JMS	SCPUTR 		/ GO PUT THE IN-USE BIT BACK IN HDR	/A003
	ONE			/ INDICATE 1ST HEADER			/A003
	MONE			/ INDICATE 0TH WORD (WHERE IN-USE BIT IS)/A003
	JMP I	SCCLS 		/ DONE

/***********************************************************************/A003
/									/A003
/	THIS ROUTINE WILL DETERMINE IF THE TOP-OF-DOCUMENT POINTERS	/A003
/	ARE EQUAL TO BOTTOM-OF-DOCUMENT POINTERS THAT WERE IN EFFECT	/A003
/	AT THE END OF THE EDIT SESSION. THIS ENABLES THE CLOSE ROUTINES	/A003
/	TO DETERMINE WHEN TO STOP DEALLOCATING BLOCKS THAT HAVE BEEN	/A003
/	ALLOCATED TO THE DOCUMENT AND THAT ARE NOT NEEDED. A MINUS 1	/A003
/	PASSED IN THE AC INDICATES 'NOT EQUAL' AND A 0 IN THE AC MEANS	/A003
/	THAT THEY ARE. IF EQUAL, THEN IT MEANS NO MORE BLOCKS SHOULD BE	/A003
/	DEALLOCATED.							/A003
/									/A003
/***********************************************************************/A003

SCREQ,	XX								/A003
	TAD	SCTPH		/ GET TOP HDR WORD PTR			/A003
	CIA			/ SET IT UP FOR COMPARE			/A003
	TAD	SCBHSV		/ GET SAVED BOT HDR PTR			/A003
	SZA CLA			/ IF EQUAL, GO CHECK HDR WORD PTRS	/A003
	JMP	SCNEQ		/ GO INDICATE NOT EQUAL AND RETURN	/A003
	TAD	SCTOP		/ GET TOP-OF-DOC HDR WORD PTR		/A003
	CIA			/ SET IT UP TO COMPARE			/A003
	TAD	SCBTSV		/ COMP TO SAVED HDR WORD PTR		/A003
	SNA CLA			/ IF NOT EQUAL, SO INDIC AND RETURN	/A003
	JMP I	SCREQ		/ IF EQUAL, AC 0 AND RETURN		/A003

SCNEQ,	AC7777			/ MINUS 1 TO SC=UNEQUAL CONDITION	/A003
	JMP I	SCREQ		/ GO BACK				/A003

SCBHSV,	0			/ AREA TO SAVE BOT HDR PTR		/A003
SCBTSV,	0			/ AREA TO SAVE BOT HDR WORD PTR		/A003

	SCHDR=HDRBUF
	SCEB=ETXBUF
	SCTB=STXBUF

SCQRX,	0
	DCA	SCQBLK+RXQBLK 	/ SET BLOCK NUMBER
	TAD	(CDFBUF)	/ get CDF to buffer field.		/A028
	DCA	SCQBLK+RXQBFD 	/ AND BUFFER FIELD
	TAD I	SCQRX 		/ ++++
	DCA	SCQBLK+RXQFNC 	/ AND FUNCTION
	ISZ	SCQRX
	TAD I	SCQRX 		/ ++++
	DCA	SCQBLK+RXQBAD 	/ AND BUF PTR
	ISZ	SCQRX
	CIFSYS 			/ ++++
	ENQUE 			/ ++++
	SCQUBL 			/ QUEUE Q-BLOCK

SCQRX1,	CIFSYS 			/ ++++
	JWAIT 			/ WAIT FOR EVENT
	TAD	SCQBLK+RXQCOD 	/ ARE WE DONE?
	SNA
	JMP	SCQRX1 		/ NO

	SMA 			/ ++++
	CLA 			/ RETURN - IF ERROR; 0 OTHERWISE
	JMP I	SCQRX 		/ YES

SCQUBL,	DSKQUE 			/ ++++
	0 			/ ++++
	0
SCQBLK,	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0 			/ ++++
	0

ETXMOD,	0 			/ ETX MODES
	0			/SHIFT FLAG
	0			/ETX BUFFER PAGE-COUNTER		/A018
ETXDES,	0			/DESCRIPTOR WORD FOR BLK BEING WRITTEN	/A030
				/THROUGH ETX BUFFER			/A030
/---------------
	PAGE

/				RDFIL HEADER CONTROL AREA

RDBFCB,	PSTBUF 			/ PASTE  BUFFER
RDHDBN,	0 			/ PTR TO BLK # IN PASTE BUFFER
/	THIS POINTER POINTS TO ONE OF THE FOLLOWING SEVENTEEN BLOCK NUMBERS
/	DEPENDING ON WHICH BLOCK NUMBER IS IN THE PASTE BUFFER
RDHDRB,	0 			/ FIRST HEADER BLOCK NUMBER
	0 			/ SECOND HEADER BLOCK NUMBER
	0 			/ THIRD HEADER BLOCK NUMBER
	0			/ FOURTH HEADER BLOCK NUMBER
	0			/ FIFTH HEADER BLOCK NUMBER
	0			/ SIXTH HEADER BLOCK NUMBER
	0			/ SEVENTH HEADER BLOCK NUMBER
	0			/ EIGHTH HEADER BLOCK NUMBER
	0			/ NINTH HEADER BLOCK NUMBER
	0			/ TENTH HEADER BLOCK NUMBER
	0			/ ELEVENTH HEADER BLOCK NUMBER
	0			/ TWELFTH HEADER BLOCK NUMBER
	0			/ THIRTEENTH HEADER BLOCK NUMBER
	0			/ FOURTEENTH HEADER BLOCK NUMBER
	0			/ FIFTEENTH HEADER BLOCK NUMBER
	0			/ SIXTEENTH HEADER BLOCK NUMBER
	0			/ SEVENTEENTH HEADER BBLOCK NUMBER
	0 			/ HEADER BLOCK #'S, THEN 0
	0 			/ MOD FLAG (ALWAYS 0)

RDGETR,	XX
	TAD	RDHDBN		/ CHECK TO SEE IF FIRST HEADER IN CORE	/A003
	SNA CLA			/ IF ZERO, ITS NOT IN CORE		/A003
	JMP	RDGTHD		/ GO GET 1ST HEADER INTO CORE		/A003
	JMS	TOGETR		/ GET ADDR OF PTR TO HDR IN CORE	/A030
	CIA			/ SWITCH IT FOR COMPARE			/A003
	TAD	RDHDBN		/ IS IT THE SAME (IS HDR IN CORE?)	/A003
	SZA CLA			/ IF YES, GO GET WORD PTR		/A003
	JMP	RDCKHD		/ OTHERWISE GO GET HEADER INTO CORE	/A003

RDRET,	ISZ	RDGETR		/ BUMP UP TO POINT TO HDR WORD PTR	/A003
	TAD I	RDGETR		/ GET ADDR OF HEADER WORD PTR		/A003
	DCA	RDGET1		/ STORE IT FOR INDIRECT USE		/A003
	TAD I	RDGET1		/ GET THE HEADER WORD POINTER		/A003
	TAD	(PSTBUF+2)	/ GET ADDRESS OF BUFFER + 2		/A003
	DCA	RDGET1
	CDFBUF
	TAD I	RDGET1
	CDFMYF
	JMP	RDEXI2		/ NEW EXIT POINT 			/A030

	RDGET1=T1

				/ GET NEXT HEADER INTO CORE		/A003
RDGTHD,	JMS	TOGETR		/ GET HDR POINTER, ADD IN BASE ADDR	/A030
	DCA	RDHDBN		/ PUT ADDR OF HDR IN CORE		/A003

RDGTXR,	TAD I	RDHDBN 		/ DO IO
	SNA 			/ ++++
	JMP	RDGTXZ
	JMS	RDFIO
	RXERD+4000
	SMA CLA 		/ ++++
	JMP	RDRET 		/ GOT HEADER, GO BACK			/A003
	DCA I	RDHDBN 		/ ELSE CLEAR BLOCK #
RDGTXZ,	DCA	RDHDBN 		/ AND LOADED FLAG

RDEXIT,	ISZ	RDGETR		/ BUMP UP TO RETURN			/A003
RDEXI2,	ISZ	RDGETR		/ EXIT FROM ABOVE ALSO			/A030
	JMP I	RDGETR 		/ AND RETURN 0

RDCKHD,	JMS	TOGETR		/ GET HDR PTR PLUS ADD OF HDR CTL AREA	/A030
	DCA	RDGET1		/ STORE ADDR OF HDR BLOCK NBR		/A003
	TAD I	RDGET1		/ GET HDR BLOCK NBR			/A003
	SNA CLA			/ IS THERE ONE THERE??			/A003
	JMP	RDEXIT		/ NO, GO GET OUT			/A003
	JMP	RDGTHD		/ GO GET HEADER INTO CORE		/A003

GTHDRS,	XX			/ ROUTINE TO GET HEADER BLOCK EXTENSIONS
	TAD I	GTHDRS		/ GET ADDRESS OF HDR CTL AREA		/A003
	DCA	PTR1		/ STORE IT TO INDIRECT THRU		/A003
	TAD I	PTR1		/ GET BUFFER ADDRESS			/A003
	TAD	THREE		/ POINT TO THIRD HDR BLK AREA		/A003
	DCA	PTR1		/ STORE ADDR 3RD HDR BLK		/A003
	CDFBUF								/A003
	TAD I	PTR1		/ GET 3RD HDR BLOCK NBR			/A003
	CDFMYF								/A003
	SNA CLA			/ IF NO THIRD HDR, GO BACK		/A003
	JMP	GTGOBK		/ RETURN				/A003
	TAD I	GTHDRS		/ GET ADR OF HDR CONTROL AREA
	TAD	FOUR			/ BUMP TO THIRD HDR BLK NBR	/M014
	DCA	X0		/ PUT ADR FOR AUTOINDEXING

	TAD	(RPBFCB		/TOP OF RPPGDS BLOCK-LIST		/A014
	TAD	FOUR		/PTR ABOVE 4TH ENTRY			/A104
	DCA	X1		/SAVE FOR STORE LATER			/A104

	TAD	T360		/ GET WORD WHERE EXTENSIONS ARE
	DCA	PTR1		/ PUT IT IN CALLING SEQUENCE
	TAD	M16		/ GET LOOP CONTROL (NBR OF POSS HDRS)	/A003
	DCA	PTR2		/ PUT IT SOMEWHERE FOR ISZ		/A003

	TAD I	GTHDRS		/ GET ADDR OF HDR CTL BLK		/M045
	CIA			/ COPLEMENT FOR COMAPRE			/A003
	TAD	(RDBFCB)	/ ADD IN READ FILE HDR CTL BLK		/A003
	SNA CLA			/ IF NOT READ ONLY, DO SCROLL READ	/A003
/D045	JMP	RDGTHR		/ GO READ READ ONLY HEADERS		/A003
/D045	JMS	SCGETR		/ GO GET HEADER BLOCK NBR
	TAD	(RDGETR-SCGETR)	/ GET OFFSET OF READ-ONLY FROM THE SCRL	/A045
				/   READ ROUTINE			/A045
	TAD	(SCGETR)	/ ADD ADDRESS OF SCRL READ ROUTINE	/A045
	DCA	XGETR		/ & STORE THE ADDRESS OF THE APPROPRIATE/A045
				/   SUBROUTINE FOR LATER USE

GETHDR,	JMS I	XGETR		/ GO GET HEADER BLOCK NBR		/A045
	THREE			/  THIRD HEADER WHERE BLK NBRS ARE
	PTR1			/ POINTER TO WHERE BLK NBRS ARE

GTHDCK,	SNA			/ IF NON-ZERO, THE BLOCK NBR IS PRESENT	/A003
	JMP 	GTRESH		/ IF ZERO BLK NBR, THEN ALL DONE	/M045
				/    GO GET THE FIRST HDR BACK INTO CORE/A045
	DCA I	X0		/ PUT BLK NBR INTO HDR CTL 		/A003

	TAD I	GTHDRS		/ GET ADDR OF HDR CTL BLK		/A040
	CIA			/ COPLEMENT FOR COMAPRE			/A040
	TAD	(RDBFCB)	/ ADD IN READ FILE HDR CTL BLK		/A040
	SNA CLA			/ SKIP IF: SCROLL READ 			/A040
	JMP	GTHDC1		/   READ ONLY FILE, IGNORE GTP		/A040
/
	TAD	RPPTR1		/RPPGDS WORD READ			/A014
	DCA I X1		/PUT IN RPPGDS BLOCK-LIST ALSO		/A014

GTHDC1,	ISZ	PTR1		/ POINT TO NEXT HDR BLK NBR		/A003
	ISZ	PTR2		/  ARE WE ALL DONE?			/A003
	JMP	GETHDR		/ NO- GO GET IT IF ITS THERE

GTRESH,				/ READ THE FIRST HEADER BLOCK BACK INTO	/A045
				/    CORE BEFORE EXITING		/A045
	JMS I	XGETR		/					/A045
	ONE			/ WE WANT THE 1ST HDR BLOCK		/A045
	ONE			/ ANY WORD WILL DO, ONE IS AS GOOD AS ANY/A045
	CLA			/ JUST CLEAR THE RETURN			/A045

GTGOBK,	ISZ	GTHDRS		/ BUMP TO RETURN ADDR			/A003
	JMP I	GTHDRS		/ RETURN				/A003

/	FOLLOWING CODE NO LONGER REQUIRED				/A045
/D045				/ GET HEADERS FOR READ ONLY FILES	/A003
/D045RDGTHR,	JMS	RDGETR		/ GO GET THE HEADERS			/A003
/D045	THREE			/ POINT TO THIRD HEADER			/A003
/D045	PTR1			/ HEADER WORD POINTER			/A003
/D045	JMP	GTHDCK		/ GO SEE IF MORE TO DO			/A003

PTR1,	0			/ PONTER TO WHERE THE HDR BLK NBRS ARE	/A003
PTR2,	0			/ COUNTER FOR LOOP CONTROL		/A003
	XGETR=T2		/ AREA TO SAVE ADDRESS OF THE APPROP.	/A045
				/    GET ROUTINE			/A045

TOGETR, XX								/A030
	TAD I	RDGETR		/ GET ADDR OF THE HDR PTR	    	/A030
	DCA	RDGET1		/ STORE IT FOR INDIRECT USE	    	/A030
	TAD I	RDGET1		/ GET THE HDR POINTER		    	/A030
	TAD	(RDHDBN)	/ GET ADDR OF PTR TO HDR IN CORE    	/A030
	JMP I	TOGETR		/ RETURN TO CALLER			/A030

/D045SCSPC,	0			/ PUT # FREE BLOCKS IN HDR
/D045	TAD	SCQBLK+RXQSPC 	/ FROM Q BLOCK
/D045	DCA	SCFSPC
/D045	JMP I	SCSPC
/---------------
	PAGE

SCOFST,	XX		/ ROUTINE TO SEE IF HEADER IS IN CORE		/A003
	TAD	SCGTR2	/ GET HEADER POINTER				/A003
	DCA	SCOFS4	/ STORE IT FOR INDIRECT USE			/A003
	TAD I	SCOFST	/ GET HEADER CONTROL BLOCK ADDR			/A003
	DCA	SCOFS1	/ SAVE IT					/A003
	TAD I	SCOFS1	/ GET BUFFER ADDR				/A003
	DCA	SCOFS1	/ SAVE BUFFER ADDR				/A003
	AC0001		/ 1 FOR ADDING					/A003
	TAD I	SCOFST	/ POINT TO IN-CORE HEADER BLOCK NUMBER		/A003
	DCA	SCOFS2	/ STORE FOR FUTURE USE				/A003
	TAD	(24)	/ GET DISPL TO MOD FLAG IN HDR CTL BLOCK	/A003
	TAD I	SCOFST	/ ADD IN ADDR OF HDR CTL BLOCK			/A003
	DCA	SCOFS3	/ SAVE FOR FUTURE USE				/A003
	ISZ	SCOFST	/ BUMP TO RETURN ADDRESS			/A003
	TAD I	SCOFS2	/ GET ADDRESS OF IN-CORE HDR BLOCK NBR		/A003
	CIA		/ CHANGE FOR COMPARE				/A003
	TAD	SCOFS2	/ ADD IN IN-CORE ADDRESS			/A003
	TAD I	SCOFS4	/ ADD IN HDR PTR				/A003
	SZA CLA		/ IS HEADER IN CORE				/A003
	JMP	SCCHGE	/ IF NOT, GO READ IN NEW ONE			/A003
	JMP	SCEND	/ GO ADD IN WORD POINTER AND RETURN		/A003

SCCHGE,	AC7777		/ MINUS 1 TO AC FOR CHECKING MOD FLAG		/A003
	TAD I	SCOFS3	/ ADD IN VALUE OF MOD FLAG (1 MEANS MODIFIED)	/A003
	SZA CLA		/ HAS IT BEEN MODIFIED?				/A003
	JMP   SCRDIN	/ NO, DON'T HAVE TO WRITE IT OUT/GO READ IN     /A003
	AC0001		/ SIGNAL A WRITE OPERATION			/A003
	JMS	SCGTWR	/ GO WRITE OUT THE HEADER			/A003

SCRDIN,	TAD	SCOFS2	/ GET ADDR OF IN-CORE HDR BLOCK NBR PTR		/A003
	TAD I	SCOFS4	/ ADD IN HDR PTR (AC POINTS TO NEW HDR)		/A003
	DCA I	SCOFS2	/ PUT THIS ADDR INTO HDR CTL BLOCK		/A003
	JMS	SCGTWR	/ GO READ IN NEW HEADER INTO BUFFER		/A003

SCEND,	TAD	SCGTR1	/ GET ADDR OF THE HDR WORD PTR			/A003
	DCA	SCOFS4	/ STORE IT FOR INDIRECT USE			/A003
	TAD I	SCOFS4	/ GET HDR WORD POINTER				/A003
	TAD	(SCHDR+2)	/ GET BUFFER ADDR +2 PAST COS STUFF	/A003
	DCA	SCGTR1	/ PUT ADDR INTO INDIRECT FIELD			/A003
	JMP I	SCOFST	/ RETURN					/A003

SCOFS1,	0		/ AREA TO HOLD THE BUFFER ADDRESS		/A003
SCOFS2,	0		/ AREA TO HOLD THE HDR BLOCK NBR ADDRESS	/A003
SCOFS3,	0		/ ARE TO HOLD THE MOD FLAG ADDRESS		/A003
SCOFS4,	0		/ AREA TO HOLD HDR POINTER			/A003

			/ SCROLL HEADER BUFFER CONTROL AREA
SCBFCB,	SCHDR 		/ SCROLL HEADER BUFFER ADDRESS
SCHDBN,	0 		/ POINTS TO HDR BLK NBR THAT'S IN CORE
		/ THE ABOVE POINTER IS AN ADDR TO ONE OF THE BLK NBRS BELOW
SCHDRB,	0 		/ FIRST HEADER BLOCK NUMBER
	0 		/ SECOND HEADER BLOCK NUMBER
	0 		/ THIRD HEADER BLOCK NUMBER
	0		/ FOURTH HEADER BLOCK NUMBER
	0		/ FIFTH HEADER BLOCK NUMBER
	0		/ SIXTH HEADER BLOCK NUMBER
	0		/ SEVENTH HEADER BLOCK NUMBER
	0		/ EIGHT HEADER BLOCK NUMBER
	0		/ NINTH HEADER BLOCK NUMBER
	0		/ TENTH HEADER BLOCK NUMBER
	0		/ ELEVENTH HEADER BLOCK NUMBER
	0		/ TWELFTH HEADER BLOCK NUMBER
	0		/ THIRTEENTH HEADER BLOCK NUMBER
	0		/ FOURTEENTH HEADER BLOCK NUMBER
	0		/ FIFTEENTH HEADER BLOCK NUMBER
	0		/ SIXTEENTH HEADER BLOCK NUMBER
	0		/ SEVENTEENTH HEADER BLOCK NUMBER
	0 		/ BLK #S, THEN 0
SCHDMD,	0 		/ MOD FLAG INDICATES HDR IN CORE'S BEEN MODIFIED

SCGTWR,	XX 			/ IO ROUTINE FOR SCHDR
	SNA CLA 		/ ++++
	JMP	SCGTRD 		/ JUMP IF READ
	TAD I	SCHDBN 		/ GET BLOCK #
	JMS	SCQRX
	RXEWT+2000 		/ ++++
	SCHDR 			/ DO WRITE
	JMS	RPWRT		/ WRITE GTP HDR BLK			/A032
	DCA	SCHDMD 		/ CLEAR MOD FLAG
	JMP I	SCGTWR 		/ RETURN
SCGTRD,	TAD I	SCHDBN 		/ GET BLOCK #
	SNA 			/ ++++
	JMP	SCGTAL 		/ ALLOCATE HEADER IF ZERO
	JMS	SCQRX
	RXERD 			/ ++++
	SCHDR 			/ READ BLOCK
SCGTEX,	JMS	RPREA1		/ READ GTP BLOCK		/M034	/A032
	JMP I	SCGTWR 		/ RETURN

SCGTAL,	JMS	SCQRX		/ALLOC. A BLOCK FOR HDR/EXTN		/M014
	RXEAL 			/ ++++
	0 			/ ALLOCATE BLOCK
	TAD	SCQBLK+RXQBLK
	DCA I	SCHDBN 		/ STORE BLOCK #
	JMS	SCBUFI 		/ ++++
	SCHDR 			/ INIT FIRST WORDS

/	NOTE: THE ROUTINE 'SCBUFI', WHICH INITIATES BUFFER AREAS FOR	/A015
/	COS 310 COMPATIBILITY, ALSO SETS UP THE INDEX REGISTER 'X0"	/A015
/	TO POINT TO THE AREA BEING INITIALIZED. THIS INDEX REGISTER	/A015
/	IS ALSO USED BY THE SUBSEQUENT ROUTINE 'CLRBUF' TO CLEAR OUT	/A015
/	THE HEADER BUFFERS. THE ROUTINE 'CLRBUF' DEPENDS ON INDEX	/A015
/	REGISTER 'X0' BEING THUS INITIALIZED.				/A015

	TAD	M376	/ GET NEG OF COUNT OF CHARACTERS IN BUFFER	/A015
	DCA	T1	/ PUT IT WHERE 'CLRBUF' CAN GET AT IT		/A015
	JMS	CLRBUF	/ GO CLEAR OUT REMAINDER OF HEADER BUFFER AREA	/A015
	JMP	SCGTEX	/ DO SAME FOR GTP				/A034

SAVTOP,	XX			/ ROUTINE TO SAVE TOP POINTERS		/A003
	TAD	SCTPH		/ GET TOP HEADER POINTER		/A003
	DCA	SAVTPH		/ SAVE IT				/A003
	TAD	SCTOP		/ GET TOP HEADER WORD POINTER		/A003
	DCA	SVTOP		/ SAVE IT				/A003
	JMP I	SAVTOP		/ GO BACK				/A003

GETTOP,	XX			/ ROUTINE TO GET BACK TOP POINTERS	/A003
	TAD	SAVTPH		/ GET SAVED TOP POINTERS		/A003
	DCA	SCTPH		/ RESTORE IT				/A003
	TAD	SVTOP		/ GET SAVE HDR WORD PTTR		/A003
	DCA	SCTOP		/ RESTORE IT				/A003
	JMP I	GETTOP		/ GO BACK				/A003

SAVTPH,	0								/A003
SVTOP,	0								/A003
RPEXTR,	0			/-1 => MUST ALLOC. A BLOCK FOR		/A014
/		RPPGDS EXTN., AFTER WRITTING OUT THE CURRENT ONE	/A014

/*************************************************************************
/
/	THIS ROUTINE CLEARS OUT THE BUFFER AREA WHEN WE ARE SETTING	A015
/	IT UP FOR USE AS A NEW BUFFER AREA.				A015
/									A015
/**************************************************************************

CLRBUF,									/A015
	XX								/A015
	CDFBUF								/A015

CLRBF1,	DCA I	X0	/ X0= ADDRES OF BUFFER AREA, SET UP BY SCBUFI	/A015
			/ AC= COS COMPATIBLE CHARACTER SET UUP BY SCBUFI/A015
	ISZ	T1	/ T1= COUNT OF CHARCTERS (START -377 OCTAL)	/A015
	JMP	CLRBF1	/ GO CLEAR NEXT WORD OUT TIL END		/A015
	CDFMYF								/A015
	JMP I	CLRBUF	/ RETURN, ALL DONE				/A015
/---------------
	PAGE

/*************************************************************************
/
/	SCAD16 WILL ADD OCTAL 16 TO THE DISPLACEMENT IF THE POINTERS
/	PASSED TO IT POINT TO THE HEADER EXTENSION BLOCK POINTERS
/	THAT EXIST ON THE THIRD HEADER.  THIS ENABLES THE USER TO
/	PREVENT THEM FROM BEING USED AS DOCUMENT BLOCK POINTERS.
/
/***************************************************************************
SCAD16,	XX			/ CHECK TO SEE IF 3RD HEADER
	CLA			/ CLEAR THE AC
	TAD I	SCAD16		/ GET ADDR OF HEADER POINTER
	DCA	SCAD4		/ STORE IT FOR INDIRECT USE
	ISZ	SCAD16		/ BUMP UP TO GET HEADER WORD PTR	/A003
	TAD I	SCAD16		/ GET HDR WORD PTR ADDR			/A003
	DCA	SCAD7		/ STORE IT FOR INDIRECT USE		/A003
	ISZ	SCAD16		/ BUMP UP TO DISPLACEMENT		/A003
	TAD I	SCAD4		/ GET HEADER POINTER
	TAD	M3		/ CHECK TO SEE IF IT'S THE 3RD
	SMA			/ IF NOT, GO SEE IF ITS THE 4TH
	JMP	SCAD5		/ GO SEE IF IT'S THE 4TH
	JMP	SCAD1		/ IF LESS, GET OUT IT'S O.K.
SCAD5,	SZA CLA			/ IF ITS THE 3RD, GO SEE IF ADD NEEDED
	JMP	SCAD6		/ GO SEE IF IT'S THE FOURTH
	TAD I	SCAD7		/ GET THE HDR WORD PTR
	TAD I	SCAD16		/ ADD DISPLACEMENT TO HDR WORD PTR
	TAD	M360		/ DOES IT POINT TO A HDR BLK NBR?
	SMA CLA			/ IF MINUS, THEN IT'S O.K. GET OUT
	JMP	SCAD8		/ GO SEE IF IT'S ZERO OR PLUS
	JMP	SCAD1		/ GO GET OUT
SCAD8,				/ IF GREATER THAN 0 GO ADD OCTAL 16
	TAD I	SCAD16		/ GET DISPLACEMENT
	TAD	T16		/ ADD OCTAL 16 (DECIMAL 14)
	DCA I	SCAD16		/ PUT DISPLACEMENT
	JMP	SCAD1		/ GO GET OUT
SCAD6,	TAD I	SCAD4		/ GET HEADER POINTER
	TAD	M4		/ CHECK IF IT'S THE 4TH
	SZA CLA			/ PROCESS IT IF IT IS
	JMP	SCAD1		/ GO GET OUT
	TAD I	SCAD7		/ GET HDR WORD PTR
	TAD I	SCAD16		/ GET THE DISPLACEMENT
	SMA CLA			/ DID IT GO NEGATIVE?	/C017
	JMP	SCAD1		/ GET OUT
	TAD I	SCAD16		/ GET DISPLACEMENT
	TAD	M16		/ TAKE AWAY OCTAL 16 (TO GO OVER HDR BLK NBRS)
	DCA I	SCAD16		/ PUT IT INTO CALL LIST
SCAD1,	ISZ	SCAD16		/ BUMP UP TO RETURN ADDR
	CLA			/ CLEAR AC BEFORE RETURNING		/A003
	JMP I	SCAD16		/ GO BACK
SCAD4,	0		/ FOR IDIRECTING TO HEADER POINTER	/A003
SCAD7,	0			/ FOR INDIRECTING TO HDR WORD POINTER	/A003

/*****************************************************************************
/
/	SCINC WILL INCREASE THE DOCUMENT BLOCK NUMBER POINTER BY AN AMOUNT
/	PASSED TO IT.  THIS AMOUNT CAN BE ANY INTEGRAL VALUE EITHER NEGATIVE
/	OR POSITIVE. THE CALLING SEQUENCE IS:
/				JMS	SCINC
/				PTR1		/ HEADER POINTER
/				PTR2		/ HEADER WORD POINTER
/				DISP		/ DISPLACEMENT (-1, 1, 2 ETC)
/				RETURN POINT
/	PTR1 IS THE HEADER POINTER. IT POINTS TO A HEADER (FROM 1 TO 17 DEC)
/	WHICH THE POINTER CURRENTLY POINTS TO.
/	PTR2 IS THE HEADER WORD POINTER WHICH POINTS TO THE PARTICULAR WORD
/	WITHIN THE HEADER BLOCK POINTED TO BY PTR1, AT WHICH THIS POINTER
/	PAIR CURRENTLY POINTS TO.
/	DISP IS AN INTEGER BY WHICH THE USER WISHES TO INCREMENT OR DECREMENT
/	THE POINTER PAIRS.
/******************************************************************************

SCINC,	XX			/ INCREMENT/DECREMENT POINTER
	CLA			/ CLEAR AC
	TAD I	SCINC		/ GET ADDR OF HEADER POINTER
	DCA	SCINC1		/ STORE IT FOR INDIRECT USE
	ISZ	SCINC		/ BUMP UP TO POINT TO HDRR WORD PTR
	TAD I	SCINC		/ GET ADR OF HDR WORD PTR
	DCA	SCINC2		/ STORE IT FOR INDIRECT USE
	ISZ	SCINC		/ BUMP UP TO DISPLACEMENT
	TAD I	SCINC2		/ GET HDDR WORD PTR
	TAD I	SCINC		/ ADD IN DISPLACEMENT
	ISZ	SCINC		/ BUMP UP TO RETURN ADDR
	SMA			/ IF MINUS THEN IT CROSSED HEADERS
	JMP	SCINCX		/ GO CHECK FURTHER IF +
	TAD	T376		/ ADD IN LENGTH OF HEADER
	DCA I	SCINC2		/ UPDATE HDR WORD POINTER
	AC7777			/ -1 TO AC TO DECREMENT HDR NBR
	TAD I	SCINC1		/ DECREMENT HDR POINTER
	DCA I	SCINC1		/ RETURN IT
	JMP I	SCINC		/ GO BACK
SCINCX,	SNA	/ IF PLUS, THEN IT MAY HAVE CROSSED HEADERS /A017
	JMP	SCINCY		/ GO UPDATE HDR WORD POINTER ONLY IF 0
	TAD	M376		/ SUBTRACT OUT  LENGTH OF HEADER
	SPA			/ HAS IT CROSSED THE HEADER?
	JMP	SCINCZ		/ NO, GO ADD BACK 376 AND GET OUT
	DCA I	SCINC2		/ YES, THEN UPDATE THE HDR WORD PTR
	ISZ I	SCINC1		/ BUMP UP HDR PTR
	JMP I	SCINC		/ RETURN
SCINCZ,	TAD	T376		/ ADD BACK 376 WHEN -/0
SCINCY,	DCA I	SCINC2		/ UPDATE HDR WORD PTR
	JMP I	SCINC		/ RETURN
SCINC1,	0			/ WORD TO INDIRECT TO HDR POINTER
SCINC2,	0			/ WORD TO INDIRECT TO HDR WORD PTR

/*********************************************************************/A003
/
/	THIS ROUTINE WILL INCREMENT OR DECREMENT THE POINTER PAIRS	/A003
/	FOR THE BOTTOM PAIR OF DOCUMENT POINTERS. THESE POINTER PAIRS	/A003
/	POINT TO DOCUMENT BLOCK NUMBERS THAT RESIDE IN THE HEADER 	/A003
/	BLOCK(S) OF THE DOCUMENT. THE FIRST POINTER OF THE POINTER	/A003
/	PAIR POINTS TO THE HEADER BLOCK THAT CONTAINS THE BLOCK NUMBER	/A003
/	POINTED TO BY THE POINTER PAIR. THE SECOND POINTER OF THE 	/A003
/	POINTER PAIR POINTS TO THE WORD WITHIN THE HEADER BLOCK THAT	/A003
/	THE POINTER PAIR IS POINTING TO. THERE ARE CURRENTLY 17 POSSIBLE/A003
/	HEADER BLOCKS THAT CAN BELONG TO A DOCUMENT. THE FIRST THREE	/A003
/	HEADERS CAN POTENTIALLY HOLD UP TO 701 DOCUMENT BLOCK NUMBERS.	/A003
/	THE FIRST HEADER BLOCK CAN HOLD UP TO 211 DOCUMENT BLOCK 	/A003
/	NUMBERS. THE SECOND HEADER BLOCK CAN CONTAIN UP TO 254 DOCUMENT	/A003
/	NUMBERS. THE THIRD HEADER BLOCK CAN CONTAIN UP TO 240 DOCUMENT	/A003
/	BLOCK NUMBERS.  ALL FURTHER HEADER BLOCKS CAN CONTAIN 254	/A003
/	DOCUMENT BLOCK NUMBERS. DOCUMENT BLOCK NUMBERS BEGIN AT WORD	/A003
/	44 OF THE FIRST HEADER BLOCK, CONTINUE ON THE SECOND HEADER	/A003
/	BLOCK BEGINNING AT WORD THREE AND PROCEEDING TO THE END OF THE	/A003
/	BLOCK, THEN CONTINUE ONTO THE THIRD HEADER BLOCK BEGINNING ON	/A003
/	ITS THIRD WORD AND PROCEEDING TO THE 240TH WORD OF THE BLOCK	/A003
/	THEN PROCEED TO THE 3RD WORD OF THE FOURTH HEADER BLOCK.	/A003
/	THE FIRST 43 WORDS OF THE FIRST HEADER BLOCK CONTAIN OTHER 	/A003
/	INFORMATION ABOUT THE DOCUMENT INCLUDING BLOCK POINTERS TO THE	/A003
/	SECOND AND THIRD HEADER BLOCKS. THE THIRD HEADER BLOCK HAS	/A003
/	BLOCK POINTERS TO THE 4TH THRU 17TH BLOCKS OF THE DOCUMENT IN	/A003
/	ITS 241ST THRU ITS 254TH WORD. THE FIRST 2 WORDS OF EACH BLOCK	/A003
/	ARE INITIALIZED FOR COS 310 COMPATIBILITY.			/A003
/
/***********************************************************************/A003

SCBOTP,	XX								/A003
	CLA			/ CLEAR OUT AC				/A003
	TAD I	SCBOTP		/ GET DIPLACEMENT			/A003
	DCA	BDISP		/ PUT DISPLACEMENT INTO CALL LIST	/A003
	JMS	SCAD16		/ GO SEE IF WE MUST ADD 16(OCTAL)	/A003
	SCBTH			/ PTR TO HEADER POINTER			/A003
	SCBOT			/ PTR TO HDR WORD POINTER		/A003
BDISP,	0			/ SPOT TO PASS DISPLACEMENT		/A003
	TAD	BDISP		/ GET NEW DISPLACEMENT			/A003
	DCA	BDISP2		/ PUT IT INTO CALL LIST			/A003
	JMS	SCINC		/ GO INCREMENT PTR BY DISPLACEMENT	/A003
	SCBTH			/ HEADDER POINTER			/A003
	SCBOT			/ HEADER WORD POINTER			/A003
BDISP2,	0			/ DISPLACEMENT TO INCREMENT BY		/A003
	ISZ	SCBOTP		/ BUMP TO RETURN ADDR			/A003
	JMP I	SCBOTP		/ RETURN				/A003


SCTOPP,	XX			/ INCREMENT TOP POINTERS		/A003
	CLA			/ CLEAR AC				/A003
	TAD I	SCTOPP		/ GET DISPLACEMENT			/A003
	DCA	TDISP		/ PUT IT INTO CALL LIST			/A003
	JMS	SCAD16		/ GO ADD 16(OCTAL) IF NEEDED		/A003
	SCTPH			/ HEADER POINTER			/A003

	SCTOP			/ HEADER WORD POINTER			/A003
TDISP,	0			/ PLACE FOR DISPLACEMENT		/A003
	TAD	TDISP		/ GET NEW DISPLACEMENT			/A003
	DCA	TDISP2		/ PUT IT INTO CALL LIST			/A003
	JMS	SCINC		/ GO INCREMENT PTR BY DISPLACEMENT	/A003
	SCTPH			/ HEADER POINTER			/A003
	SCTOP			/ HEADER WORD POINTER			/A003
TDISP2,	0			/ DISPLACEMENT TO INCREMENT BY		/A003
	ISZ	SCTOPP		/ BUMP UP TO RETURN ADDR		/A003
	JMP I	SCTOPP		/ RETURN 				/A003

/ during the OPEN process, clear the header block ptrs. left
/ from the previous document, or else hdr. blocks belonging
/ to a previous document may be de-allocated during the OPEN
/ of the current document....						/A024

CLPTRS,	0		/SAVE CALLER'S RETURN ADDR.			/A024
	TAD	(SCBFCB	/ADDR. OF START OF DOC. BLOCK-PTR TABLE		/A024
	DCA	X1	/POINTS AT TABLE ENTRY TO CLEAR			/A024
	TAD	(RPBFCB	/ADDR. OF START OF GOTO PAGE BLOCK-PTR TABLE	/A024
	DCA	X2	/POINTS AT TABLE ENTRY TO CLEAR			/A024

BLKINT,	DCA I X1	/CLEAR A HDR-BLK-PTR				/A024
	DCA I X2	/SAME WITH PARRELLEL GOTO PAGE STRUCTURE	/A024
	TAD	(-SCHDMD /ADDR. AT END OF TABLE
	TAD	X1	/COMPARE TO LOC. JUST CLEARED			/A024
	SZA CLA		/SKIP IF BOTH TABLES CLEARED			/A024
	JMP	BLKINT	/JUMP TO CLEAR ANOTHER ENTRY			/A024
	JMP I CLPTRS	/EXIT WITH BOTH TABLES EMPTY
/---------------
	PAGE

SCTPBT,	XX			/ ROUTINE TO DETERMINE IF BOTTOM =	/A003
	AC7777			/ GET ONE INTO AC			/A003
	DCA	SCBT3		/ PUT IT INTO CALLING LIST		/A003
	TAD	SCBOT		/ TOP + 1. GET BOT HDR PTR		/A003
	DCA	SCBOTT		/ PUT IT IN CALL LIST			/A003
	TAD	SCBTH		/ GET BOTTOM HDR PTR			/A003
	DCA	SCBTHT		/ PUT IT INTO CALL LIST			/A003
	JMS	SCAD16		/ GO SEE IF NEDDS ADD 16(OCTAL)		/A003
SCBT1,	SCBTHT			/ HDR POINTER				/A003
SCBT2,	SCBOTT				/ HDR WORD POINTER		/A003
SCBT3,	1		/  INCREMENT BOTTOM BY 1			/A003
	TAD	SCBT3		/ GET INCREMENTED INCRMENT AMT		/A003
	DCA	SCBT6		/ PUT INTO INCREMENT CALL LIST		/A003
	JMS	SCINC		/ GO INCREMENT IT			/A003
SCBT4,	SCBTHT			/ HEADER POINTER			/A003
SCBT5,	SCBOTT			/ HEADER WORD POINTER			/A003
SCBT6,	0			/ INCREMENT AMOUNT			/A003
	TAD	SCBTHT		/ GET INCR'TED HDR PTR			/A003
	CIA			/ COMPLEMENT AND INCREMENT IT		/A003
	TAD	SCTPH		/ ARE BOTTOM AND TOP EQUAL		/A003
	SZA			/ IF YES GO SEE IF WORD PTRS EQUAL	/A003
	JMP	SCTB2		/ ELSE, NOT EQUAL, 2 ISZ'S AND RETURN	/A003
	TAD	SCBOTT		/ GET HDR WORD PTR OF BOTTOM		/A003
	CIA			/ COMP AND INC IT FOR SUBTRACT		/A003
	TAD	SCTOP		/ GET TOP HDR WORD PTR AND ADD IT IN	/A003
	SNA			/ IF NOT EQUAL, 2 ISZ'S AND OUT		/A003
	JMP	SCTB1		/ IF EQUAL, GO ALLOCATE 1 ISZ AND OUT	/A003
SCTB2,	ISZ	SCTPBT		/ NORMAL RETURN - NO ALLOCATE		/A003
SCTB1,				/ ALLOCATE RETURN			/A003
	JMP I	SCTPBT		/ RETURN				/A003

/	THIS ROUTINE WILL MOVE A FILE OVER BY THREE BLOCK NUMBERS	/A003
/	SO THAT THE EDIT CAN CONTINUE TO ADD TEXT TO THE FILE		/A003

SCALC2,	XX			/ RETURN ADDRESS			/A003
	TAD	SCBTH		/ GET HDR POINTER			/A003
	DCA	SCBTHT		/ PUT HDR PTR TO NEW PTR		/A003
	TAD	SCBOT		/ GET BOTTOM HDR WORD PTR		/A003
	DCA	SCBOTT		/ PUT IT INTO NEW HDR WORD PTR		/A003

/D047	IFDEF	STATLN	<						/A043

	JMS	SCBOTP		/ GO BUMP UP POINTERS BY ONE		/A043
	1			/ NUMBER TO BUMP UP BY			/A043

/D047			>	/ END IFNDEF STATLN			/A043
/D047	IFNDEF	STATLN	<						/A043
/D047	JMS	SCBOTP		/ GO BUMP UP POINTERS BY THREE		/A003
/D047	3			/ NUMBER TO BUMP UP BY			/A003
/D047			>	/ END IFNDEF STATLN			/A043


SCALCX,	JMS	SCGETR		/ GO GET BLOCK - 1			/M047
	SCBTHT			/ HDR PTR				/A003
	SCBOTT			/ HDR WORD PTR				/A003
	JMS	SCPUTR		/ GO PUT THE BLOCK GOTTEN TO BL +3	/A003
	SCBTH			/ HDR PTR				/A003
	SCBOT			/ HDR WORD PTR				/A003
	JMS	SCBOTP		/ GO DECREMENT POINTERS			/A003
	-1			/ AMOUNT TO DECREMENT BY		/A003
	AC7777			/ MINUS 1 TO AC				/A003
	DCA	SCALCY		/ PUT DEC VALUE IN CALL LIST		/A003
	JMS	SCAD16		/ GO SEE IF WE NEED TO ADD 16(IN 3RD HDR/A003
	SCBTHT			/ HDR PTR				/A003
	SCBOTT			/ HDR WORD PTR				/A003
SCALCY,	0	
	TAD	SCALCY			/ GET DISPLACEMENT		/A003
	DCA	SCALCZ			/ PUT IT IN CALL LIST		/A003
	JMS	SCINC			/ GO INCREMENT IT		/A003
	SCBTHT				/ HDR PTR			/A003
	SCBOTT				/ HDR WORD PTR			/A003
SCALCZ,	0				/ DISPLACEMENT AMOUNT		/A003
	ISZ	SCALC			/ ARE WE DONE?			/A003
	JMP	SCALCX			/ NO GO DO IT AGAIN		/A003
	JMP I	SCALC2			/ GO BACK			/A003
/SCBTHT,	0				/ TO SAVE POINTERS	/D022
/SCBOTT,	0				/ TO SAVE POINTERS	/D022

/*********************************************************************/A003
/									/A003
/	THIS ROUTINE WILL FREE UP BLOCK NUMBERS THAT HAVE BEEN ASSIGNED	/A003
/	TO THE DOCUMENT AS HEADER EXTENSIONS. THEN IT WILL UPDATE THE 	/A003
/	HEADERS SO THAT THEY HAVE ONLY HEADERS THAT ARE USED		/A003
/									/A003
/***********************************************************************/A003

SCCLSE,	XX		/ ROUTINE TO FREE UP UNUSED HEADER BLOCKS	/A003
	JMS	PSTBOT	/GO POSITION TO BOTTON OF DOC.
	TAD	SCHDBN	/ GET TO HEADER BLOCK NUMBER POINTER		/A003
	DCA	X1	/ PUT IT INTO INDEX 1				/A003
	TAD	SCHDBN	/ GET HEADER BLOCK NMBR PTR (FOR CLEARINGSCBOTT	/A003
	DCA	X2	/ PUT CLEARER INTO INDEX 2			/A003

SCCLSF,	TAD I	X1	/ GET BLOCK NUMBER TO FREE UP			/A003
	SNA		/ IF IT ISN'T 0, THEN FREE IT			/A003
	JMP	SCCLSG	/ IF ZERO, THEN GO SEE IF DONE			/A003
	JMS	SCQRX	/ GO FREE UP THE BLOCK NUMBER			/A003
	RXEFR								/A003
	0								/A003
	AC7777		/ -1					    	/M032
	DCA	RPEXTR	/ SET TO INDICATE FREE-ING HDR BLK	    	/M032
	JMS	RPFRBK	/ GO FREE GTP HDR BLOCK				/A032
	DCA I	X2	/ CLEAR OUT HDR CONTROL BLOCK			/A003
SCCLSG,			/ SET UP TO SEE IF DONE				/A003
	TAD	(SCHDMD-2)	/ GET ADDR OF LAST ENTRY IN TABLE	/A003
	CIA		/ MAKE IT ZERO					/A003
	TAD	X1	/ GET ADDR INDEX 1 POINTS TO			/A003
	SZA CLA		/ RESULT ZERO IF DONE				/A003
	JMP	SCCLSF	/ LOOP AROUND TO NEXT ONE			/A003

/	NOW WE MUST UPDATE THE HEADERS WITH THE NEW BLOCK NUMBERS	/A003

	TAD	(SCHDRB)	/ GET ADD OF HEADER BLOCK NBR TABLE	/A003
	DCA	X1		/ PUT IT INTO INDEX 1			/A003
	TAD	T360	/ HEADER WORD POINTER FOR 3RD HDR BLOCK		/M014
	DCA	SCCLSC	/ PUTIT HERE TO ISZ IT				/A003
	TAD	M16	/ NUMBER OF HEDR EXTENSION			/M014
	DCA	SCCLST	/ PUT IT HERE TO ISZ THRU			/A003

	TAD	RPHDRB+1	/RPPGDS 2ND HDR				/A014
	DCA	RPPTR1	/SUPPLT FOR RPPGDS SCPUTR			/A014

	TAD I	X1	/ GET THE BLOCK NUMBER 2ND HDR			/A003
	JMS	SCPUTR	/ GO PUT IT INTO HDR 1				/A003
	ONE		/ INDICATE HEADER 1				/A003
	ZERO		/ INDICATE WORD 2 OF THE HEADER			/A003

	TAD	RPHDRB+2	/RPPGDS 3RD HDR				/A014
	DCA	RPPTR1	/SUPPY FOR RPPGDS SCPUTR			/A014

	TAD I	X1	/ GET 3RD HDR BLOCK NBR				/A003
	JMS	SCPUTR	/ GO PUT IT INTO HEADER				/A003
	ONE								/A003
	ONE								/A003
	TAD	SCHDRB+2	/ GET THE THIRD HEADER BLOCK NUMBER	/A022
	SNA CLA		/ HAS IT BEEN DEALLOCATED?			/A022
	JMP I	SCCLSE	/ YES, THEN WE'RE ALL DONE			/A022

SCCLSH,		/ LOOP TO DO 3RD HEADER EXTENSION HDR BLOCK NBRS	/A003

	JMS	RPEXTN	/GET RPPGDS EXTN. BLK # INTO RPPTR1		/A014
	TAD I	X1	/ GET THE 4TH, 5TH, 6TH, ETC HDDR BLCK NBR	/A003
	JMS	SCPUTR	/ GO PUT IT INTO THE 361TH, 362TH, 363RD	/A003
	THREE		/ ETC, WORD OF HEADER 3				/A003
	SCCLSC		/ HDDR WORD PTR					/A003
	ISZ	SCCLSC	/ INCREMENT THE HDR WORD POINTER		/A003
	ISZ	SCCLST	/ INCREMENT LOOP CONTROL			/A003
	JMP	SCCLSH	/ GO DO IT AGAIN AND AGAIN 'TIL DONE		/A003
SCCEXT,	JMP I	SCCLSE	/ ALL DONE, RETURN				/A003
	SCCLST=SCBOTTS		/ USED FOR LOOP CONTROL			/A003
	SCCLSC=SCBTHT		/ USED AS HDR WORD PTR FOR HDR EXTENS	/A003
/---------------
	PAGE

/***********************************************************************/A003
/
/	THIS ROUTINE POSITIONS THE HEADER POINTERS IN ORDER TO READ THE	/A003
/	FILES DURING EDITING.  THESE POINTERS ARE INITIALIZED THE WAY	/A003
/	THE USER WANTS TO EDIT THE FILE.  IF HE WANTS TO REPLACE THE	/A003
/	THE ENTIRE DOCUMENT HE PASSES A MINUS 1 IN SCOPTN. IN THIS CASE	/A003
/	THE TOP POINTERS WILL POINT TO THE FIRST BLOCK NUMBER OF THE 	/A003
/	FILE AND THE BOTTOM POINTERS WILL POINT TO THE BOTTOM (LAST)	/A003
/	BLOCK NUMBER OF THE FILE. IF THE USER WISHES TO APPEND TO THE 	/A003
/	EXISTING DOCUMENT, THEN THE TOP POINTERS WILL POINT TO THE LAST	/A003
/	BLOCK NUMBER OF THE FILE, AND THE BOTTOM POINTERS WILL POINT TO	/A003
/	THE NEXT BLOCK NUMBER (WHICH IS EMPTY). TO DO THIS, THE USER	/A003
/	PASSES A PLU 1 IN SCOPTN.  IF SCOPTN CONTAINS A ZERO, THEN 	/A003
/	NORMAL PRCESSING IS INDICATED, AND THE TOP POINTERS POINT TO	/A003
/	THE FIRST BLOCK NUMBER OF THE FILE AND THE BOTTOM POINTER POINTS/A003
/	TO THE SECOND BLOCK NUMBER OF THE FILE.				/A003
/
/***********************************************************************/A003

SCFLZB,	XX			/ RETURN ADDRESS			/A003
	TAD	SCOPTN		/ IS THIS A NORMAL EDIT RUN?		/A003
	SNA CLA			/ IF IT IS, GO PROCESS NORMAL		/A003
	JMP	SCFLNR		/ GO PROCESS NORMAL EDIT SESSION	/A003
	TAD	SCFILZ		/ GET FILE SIZE 			/A003
	SMA			/ HOW BIG IS IT? IS IT > 2048?		/A003
	JMP	SCFLZ		/ IF < 2048, THEN DON'T SPLIT IT UP	/A003
	TAD	P3777		/ IF > 2048, TAKE OUT 2047		/A003
	DCA	SCFLZ2		/ STORE REMAINDER FOR SEC LOOP CTL	/A003
	TAD	P3777		/ GET LOOP CONTROL FIRST LOOP		/A003
	DCA	SCFLZ1		/ STORE IT FOR LOOP CTL			/A003
	JMP	SCFLZO		/ GO FIND END OF DOCUMENT		/A003
SCFLNR,				/ PROCESS NOROMAL EDIT			/A003
	TAD	(SCBKOF)	/ DIPLACEMNT TO 1ST BLOCK NBR IN 1ST HDR/A003
	DCA	SCTOP		/ PUT IT INTO TOP POINTER PAIR		/A003
	TAD	SCTOP		/ GET SAME FOR BOTTOM POINTER		/A003
	DCA	SCBOT		/ INITIALIZE BOTTOM POINTER		/A003
	IAC			/ GET A ONE INTO AC			/A003
	DCA	SCTPH		/ TOP HDR PTR TO POINT TO 1ST HEADER	/A003
	IAC			/ 1 TO AC				/A003
	DCA	SCBTH		/ BOT HDR PTR SAM AS TOP		/A003
	JMP	SCFLOT		/ GO ADD ONE TO BOTTOM, AND GET OUT	/A003

SCFLZ,	DCA	SCFLZ1		/ ONLY ONE LOOP FOR SHORT FILES		/A003
	DCA	SCFLZ2		/ SECOND LOOP CTL= 0			/A003
SCFLZO,	TAD	(SCBKOF)	/ DISP TO 1ST BLK NBR IN 1ST HDR	/A003
	DCA	SCTOP		/ PUT IT IN TOP POINTER			/A003
	IAC			/ GET A 1				/A003
	DCA	SCTPH		/ TO HDR POINTER			/A003
	TAD	SCFLZ1		/ GET 1ST LOOP CTL			/A003
	SNA			/ SKIP IF THERE IS A FILE SIZE.		/A006
	JMP	SCFLX		/ IF FILE SIZE IS 0 THEN WE ARE DONE!!!	/A006
	CIA			/ MAKE IT MINUS				/A003
	DCA	SCFLZ1		/ STORE IT AGAIN			/A003

SCFLZF,	JMS	SCTOPP		/ TOP OF 1ST LOOP, GO ADD 1 TO IT	/A003
	1								/A003
	ISZ	SCFLZ1		/ 1ST LOOP CONTROL INCREMENT		/A003
	JMP	SCFLZF		/ GO DO I T AGAIN			/A003
	TAD	SCFLZ2		/ GET SECOND LOOP CTL			/A003
	SNA			/ BYPASS IF ZERO			/A003
	JMP	SCFLX		/ IF ZERO, BYPASS 2ND LOOP		/A003
	CIA			/ MAKE NEGATIVE FOR ISZ			/A003
	DCA	SCFLZ2		/ STORE FOR USE				/A003

SCFLZT,	JMS	SCTOPP		/ TOP OF 2ND LOOP, GO ADD 1 TO TOP PTRS	/A003
	1								/A003
	ISZ	SCFLZ2		/ IF ZERO, THEN WE'RE ALL DONE		/A003
	JMP	SCFLZT		/ GO ADD ANOTHER 1 IF NOT ZERO		/A003

SCFLX,	TAD	SCTOP		/ GET TOP HDR WORD POINTER		/A003
	DCA	SCBOT		/ PUT IT INTO BOTTOM PTR		/A003
	TAD	SCTPH		/ GET TOP HDR PTR			/A003
	DCA	SCBTH		/ PUT IT INTO BOTTOM HDR PTR		/A003
	TAD	SCOPTN		/ GET OPTIONS PASSED			/A003
	SMA CLA			/ IF NEGATIVE, THE RESET TOP		/A003
	JMP	SCFLOT		/ IF NOT, GO BUMP UP BOTTOM PTRS	/A003
	TAD	(SCBKOF)	/ MAKE TOP POINT TO FIRST BLK NBR	/A003
	DCA	SCTOP		/ TOP HEADER WORD POINTER		/A003
	IAC			/ GET A 1				/A003
	DCA	SCTPH		/ TOP HEADER POINTER TO POINT TO 1ST	/A003

SCFLOT,	JMS	SCBOTP		/ GO INCREMENT BOTTOM BY ONE		/A003
	1								/A003
	JMP I	SCFLZB		/ RETURN				/A003

SCFLZ1,	0			/ SPOT FOR ISZ LOOP CONTROL (1ST)	/A003
SCFLZ2,	0			/ SPOT FOR ISZ LOOP CONTROL (2ND)	/A003
	0

/	THIS ROUTINE WILL GET ALL THE HEADERS FOR A READ ONLY FILE	/A003

RDGTHS,	XX								/A003
	JMS	RDGETR		/ GO GET 2ND HEADER EXTENSION		/A003
	ONE			/ INDICATE 1ST HEADER			/A003
	ZERO			/ INDICATE 1ST HDR EXTENSION		/A003
	DCA	RDHDRB+1	/ PUT IT INTO HDR CTL BLOCK		/A003
	JMS	RDGETR		/ GO GET 2ND HEADER EXTENSION		/A003
	ONE			/ 1ST HDR AGAIN				/A003
	ONE			/ INDCATE 2ND HDR EXT			/A003
	DCA	RDHDRB+2	/ PUT IT INTO HDR CTL BLOCK		/A003
	JMS	RDGETR		/ GO GET FILE SIZE			/A003
	ONE			/ 1ST HEADER AGAIN			/A003
	THREE			/ INDICATE FILE SIZE			/A003
	DCA	RDFSIZ		/ PUT IT WHERE OTHERS CAN GET IT	/A003
	JMS	GTHDRS		/ GO GET REMAINING HEADERS		/A003
	RDBFCB			/ INDICATE READ-ONLY HDR CTL BLOCK	/A003
	JMP I	RDGTHS		/ GOBACK				/A003

/	THIS ROUTINE WILL INCREMENT THE HEADER POINTERS FOR READ-ONLY	/A003

RDINC,	XX								/A003
	AC0001			/ INDICATE SIZE OF INCREMNET		/A003
	DCA	RDINC1		/ PUT IT INTO CALL LIST			/A003
	JMS	SCAD16		/ GO SEE IF YOU NEED ADD 16 (OCTAL)	/A003
	RDHDRP			/ READ-ONLY HDR POINTER			/A003
	RDPTRS			/ READ-ONLY HDR WORD PTR		/A003
RDINC1,	0			/ AMOUNT TO INCREMENT BY		/A003
	TAD	RDINC1		/ GET AMOUNT TO INCREMENT BY		/A003
	DCA	RDINC2		/ PUT AMOUNT INTO CALL LIST		/A003
	JMS	SCINC		/ GO INCREMENT THE POINTERS		/A003
	RDHDRP			/ READ-ONLY HDR PTR			/A003
	RDPTRS			/ READ-ONLY HDR WORD PTR		/A003
RDINC2,	0			/ AMOUNT TO INCREMENT BY		/A003
	JMP I	RDINC		/ RETURN				/A003

/ THIS ROUTINE WILL SEARCH FOR THE BOTTOM OF THE DOCUMENT.
/ IT IS USED TO MAKE SURE THAT THE HEADER POINTER IN THE SCROLL
/ HEADER CONTROL BLOCK IS POINTING TO THE LAST HEADER BLOCK
/ IN THE FILE SO THAT THE DE-ALLOCATION ROUTINE WON'T DE-ALLOCATE
/ ANY HEADERS THAT BELONG TO THE FILE...

PSTBOT,	0		/SAVE CALLER'S RETURN ADDR.
	AC0001		/						/A032
	DCA	SCBTH	/START WITH 1ST HEADER				/A032
	TAD	(SCBKOF	/STARTING HEADER WORD POINTER
	DCA	SCBOT	/INTO 'BOTTOM' POINTER

PSTBO1,	JMS	SCBOTP	/GO INCREMENTT THE POINTERS
	1
	JMS	SCGETR	/GO GET A BLOCK NUMBER
	SCBTH
	SCBOT
	SZA CLA		/SKIP IF END OF BLOCK-LIST POINTERS
	JMP	PSTBO1	/LOOP UNTIL EOF FOUND
	JMP I PSTBOT	/EXIT:AT END OF FILE
/---------------
	PAGE

/***********************************************************************/a048
/ WARNING do not move this routine without changing WPf1 to reflect the 
/		address change
/******************************************************************	/a048

	*	FBHOOK		/4000					/a048	

/********************************************************************
/ BHOOK      Hook to panel page blaster
/******************************************************************** 	/a048

BHOOK,	0			/ hook return address			/a048
	DCA	BLACSV		/ save accumulator			/a048
	RDF			/ read the data field 			/a048
	TAD	CDF0		/ make a cdf instruction		/a048
	DCA	BHKEXI		/ save for return			/a048
	CDFMYF			/ set to hooks field			/a048
	TAD I	BHOOK		/ get the table entry			/a048
	MQL			/ push into MQ				/a048
 	TAD	BLACSV		/ get the ac				/a048
	ISZ	BHOOK		/ increment the return address		/a048
	CIFMNU			/ blaster is in the menu field		/a048
	IOF			/ turn the interrupts off before.. 	/a048
	JMS I	BLASTH		/ Calling blaster			/a048
	ISZ	BHOOK		/ skip return exit			/a048
BHKEXI,	0			/ CDF instruction			/a048
	JMP I	BHOOK		/ return				/a048
BLASTH,	BLASTR			/ blastr address (get from WPF1)	/a048
BLACSV,	0			/ ac save				/a048



RPPGDS=7400		/V2.0 GOTO PAGE BUFFER AREA IN FIELD 2

/  if the block just allocated and initialized was the 2nd 		/A014
/   EXTENSION block, then words 362 to 377 must be set to 0.		/A014
/   these words are new V2 extension block pointers, not text		/A014
/   block pointers.....							/A014

RPCKV2,	JMS	RPBFIN	/SET ALL BUFFER WORDS TO -1			/M031
			/EXCEPT 0 (-255), 1 (70), 2&3 (0)		/M031
	TAD	RPHDBN	/PTR. TO BLOCK JUST ALLOCATED			/A014
	CIA		/FOR COMPARE TO					/A014
	TAD	(RPHDRB+2	/2ND EXTENSION BLOCK			/A014
	SZA CLA		/SKIP IF SPECIAL V2 EXTENSION BLOCK		/A014
	JMP	RPV2EX	/IGNORE ALL OTHERS				/A014

	TAD	(RPPGDS+361	/PTR. TO WORD PRIOR TO 1ST		/A014
				/V2 EXTN BLOCK PTR WITHIN 3RD HDR.	/A014
	DCA	X3	/INTO AUTO-INDEX REG.				/A014

RPLPV2,	CDFRPB		/RPPGDS BUFFER FIELD				/A014
	DCA I X3	/INIT. V2 EXTN. POINTER				/A014
	CDFMYF		/BACK FROM RPPGDS FIELD				/A014
	TAD	X3	/POINTER TO WORD JUST INIT'D.			/A014
	CIA		/FOR COMPARE TO					/A014
	TAD	(RPPGDS+377	/END OF RPPGDS BUFFER			/A014
	SZA CLA		/SKIP IF INITIALIZATION DONE			/A014
	JMP	RPLPV2	/JUMP TO INIT. ANOTHER WORD			/A014
	
			/ NEW RETURN TO WITHIN RPREAD			/A031
RPV2EX,	JMP	REEDXT	/RETURN TO CALLER				/A031

RPEXTN,	0		/GET RPPGDS EXTN. BLK #'S 4-16			/A012
	TAD	(SCHDRB	/TOP OF DOC. HDR. BLOCK-LIST			/A012
	CIA		/FOR COMPARE TO					/A012
	TAD	X1	/PTR. TO NEXT HDR. EXTN. PTR.			/A012
	TAD	(RPHDRB	/FIND PTR TO CORRESPONDING RPPGDS PTR		/A012
	DCA	X2	/FOR INDIRECT					/A012
	TAD I X2	/GET RPPGDS EXTN BLK #				/A012
	DCA	RPPTR1	/FOR RPPGDS PART OF SCPUTR			/A102
	JMP I RPEXTN	/RETURN FOR SCPUTR OF HDR EXTN 			/A012

RPALOC,	0			/CALLER'S RETURN ADDR.			/A014
	TAD	RPALOC		/CALLER'S RETURN ADDR.			/A014
	DCA	RPREA1		/USING PREVIOUS DESIGN			/A032
	JMP	RPRDEX		/USE CURRENT LOGIC			/A014

				/ AC = 0 ON ENTRY			/A032
RPFRBK,	0			/CALLERS RETURN ADDRESSS		/A022
	TAD	(SCHDBN		/HDR BLK TO BE RELEASED			/A022
	CIA			/MAK NEG FOR OFFSET			/A022
	TAD	X1		/OFFSET INTO SCHDBN			/A022
	TAD	(RPHDBN		/GET SAME OFFSET INTO RPHDBN		/A022
	DCA	RPFRB2		/SAVE					/A022
	TAD I	RPFRB2		/SUPPLY BLOCK # TO BE FREED		/A022
	JMS	RPDSFR		/AC = BLK # (AC=0 ON RETURN)		/A022
	DCA I	RPFRB2		/CLEAR POINTER FROM TABLE		/A022

/LEAVE DEALLOCATE FLAG ON TO SIGNIFY CLOSE-OPERATION WHEN
/READING 1ST GOTO-PAGE HEADER BLOCK					/A023

RPFRB1,	JMP I	RPFRBK		/RETURN					/A022

RPFRB2,	0			/POINTER TO BLOCK TO BE FREED		/A022

/ here when writing to ETX buffer and PRINT-CONTROL char. recognized
/ on entry, AC = RPMODE word...

CHKETX,	SNA CLA		/SKIP IF END-CONTROL				/A030
	JMP	DOSTRT	/GO PROCESS START-CONTROL			/A030
	TAD	(7677	/CLEAR 'IN CONTROL-AREA' FLAG			/A030
	AND I T3	/IN THE CURRENT DESCRIPTOR			/A030
	TAD	P100	/NOW SET 'IN CONTROL-AREA'FLAG			/A030
	DCA I T3	/WITHIN THE CURRENT DESCRIPTOR WORD		/A030
	JMP	TODSBDEX /GO SET OUR OWN PRINT-CONTROL-FLAG		/A030

/This routine is entered when it's determined that a PUT to the STX
/ buffer has occurred.  more specifically, a print control char is
/ being put  - 030

CHKSTX,	TAD	(200		/CHECK TO SEE IF THIS PRINT CONTROL	/A030
	AND	RPMODE		/IS AN END PRINT CONTROL		/A030
	SNA CLA			/SKIP IF: END PRINT CONTROL		/A030

TODSBDEX,AC0100			/PRINT CONTROL WAS A START. SET		/A030
				/FLAG TO INDICATE WITHIN CONTROL AREA	/A030
	DCA	RPPCTLFL	/UPDATE CONTROL AREA FLAG		/A030

/Here when writing to STX buffer.  check flag, if on: have already
/ processed a print control char in the buffer - stop	
/ if off: process this print control char as it is the first print
/ control char in the STX buffer

CHKST1,	TAD	SOMFLG	/ CHECK THE STATE OF FLAG			/A030
	SZA CLA		/ SKIP IF: NOT ON				/A030
	JMP	DSBDEX	/ HAVE BEEN THROUGH ONCE, EXIT			/A030

CHKST2,	TAD I T3	/GET CURRENT DESCRIPTOR WORD			/A030
	AND	(7677	/CLEAR 'IN CONTROL-AREA' FLAG			/A030
	DCA I T3	/UPDATE CURRENT DESCRIPTOR WORD			/A030

/come here if writing print control char to STX buffer (and is the first
/ print control char in the buffer).  set bit5 in the descriptor to be
/ the opposite state as that of the print-control area flag.

CHKST3, TAD	RPPCTLFL	/PRINT-CONTROL AREA FLAG		/A030
	CMA			/OPPOSITE STATE				/A030
	AND	P100		/SAVE FLAG ONLY				/A030
	TAD I T3		/MERGE WITH DESC. WORD			/A030
	DCA I T3		/UPDATE DESC. WORD			/A030
	AC0001			/SET FLAG TO INDICATE THAT		/A030
	DCA	SOMFLG		/A PRINT CONTROL CHAR WAS		/A030
				/PROCESSED WITHIN THIS BUFFER		/A030
	JMP	DSBDEX		/RETURN					/A030

/The following routine entered when writing to ETX buffer and a
/ start print control char is encountered

DOSTRT,	TAD	(7677		/MASK OUT BIT 5 IN THE DESCRIPTOR	/A030
	AND I 	T3		/WORD					/A030
	DCA I	T3		/UPDATE THE DESCRIPTOR WORD		/A030
	DCA	RPPCTLFL	/CLEAR THE PRINT CONTROL AREA FLAG	/A030
				/TO INDICATE NOT IN A CONTROL AREA	/A030
	JMP	DSBDEX		/RETURN					/A030

/ This subroutine checks to see if the character just PUT was a
/  Page Marker of New Page.  If so, increment T3, then check to
/   make sure that no more than 36 Pages/New Pages are in the
/    buffer.  Only 5 bits are designated as page counters in the
/     GTP descriptor word, if the number of pages overflows 5 bits,
/      the entire descriptor word could be ruined
/
CHKPAG,	XX			/ SUBROUTINE TO CHECK FOR PAGE/NEW-PAGE	/A028
	TAD	NWPAGE		/IS IT A NEW PAGE?			/A018
	SZA			/SKIP IF SO				/A018
	TAD	PAGEMK		/IS IT A PAGE MARKER?			/A018
	SNA CLA			/ SKIP IF: NEITHER			/A032
	ISZ I	T3		/ ACCOUNT FOR PAGE IN SCROLL BUFFER	/A032
	TAD I	T3		/ GET # OF PAGES IN SCROLL BUFFER	/A032
	TAD	(-36		/ COMPARE TO MAX. # OF ALLOWABLE PGS.	/A032
	SNA CLA			/ SKIP IF: WITHIN LIMITS		/A032
	AC0001			/ AT MAX. SET FLAG IN ORDER TO PAD BUF	/A032
	DCA	PAGLIM		/ 0 = WITHIN RANGE			/A032
				/ 1 = AT MAXIMUM			/A032
	JMP I	CHKPAG		/ RETURN TO CALLER.			/A028


/---------------
	PAGE

/  here after WPFILS requested a read io
/  get the "scroll" buffer address used for the read io
/
/  IF   this is not the main document header block, then go read
/       the parrellel 'extension' block
/    ELSE   read the RPPGDS link word in the main document header
/           block
/
/  IF  the link word is empty, then this document never had a RPPGDS
/      block allocated to it.  Go allocate one and attach it to the
/      main document header block
/    ELSE   verify that the RPPGDS block linked to this document
/           is a valid up-to-date reflection of the text block content
/

/*******************************************************************	/A039
/*******************************************************************	/A039
/*******************************************************************	/A039
/****								****	/A039
/****				NOTE				****	/A039
/****								****	/A039
/****	THIS ROUTINE COUNTS ON THE FACT THAT THE DISK OPEN 	****	/A039
/****	COMMAND IS THE FIRST ENTRY IN THE XFLDTB TABLE		****	/A039
/****								****	/A039
/*******************************************************************	/A039
/*******************************************************************	/A039
/*******************************************************************	/A039


RPREA1,	XX			/SAVE CALLERS RETURN ADDRESS		/A032
	TAD	XFILT3		/GET POINTER TO WPFILS ACTIVE FUNCTION	/M039
	CIA			/NEGATE IT FOR FOLLOWING COMPARE	/A039
	TAD	XFLDTB		/COMPARE TO ADDRESS AT 'OPEN' COMMAND	/M039
	SZA CLA			/SKIP IF DOING 'OPEN'			/A034
	JMP 	RPRDEX		/SKIP VERIFICATION			/A034
	TAD	SCQBLK+RXQBLK	/DOC. HDR. BLOCK # JUST READ		/M012
	CIA			/FOR COMPARISION
	TAD	SCHDRB		/BLK# OF DOC. MAIN HEADER		/A034
	SZA CLA			/SKIP IF MAIN HEADER
	JMP	RPRDEX		/GO READ PARALLEL RPPGDS EXTN. BLOCK

/  (could be OPENing this document for the first time....)

	CDFBUF			/CHANGE TO SCROLL BUFFER FIELD
	TAD I (SCHDR+1		/2ND WORD OF DOC. HEADER		/A029
	CLL RAR			/TEST STATE OF BIT11			/A029
	SZL CLL			/SKIP IF NO G-T-P BLOCK			/A029
	JMP	RPRDDS		/GO READ THE PARELLEL RPPGDS MAIN BLOCK

	CML RAL			/GET READY TO				/A029
	DCA I (SCHDR+1		/SET BIT11 (NOW HAVE A G-T-P BLOCK)	/A029

/  this document was never used with a V2 WPS, thus, it has no
/    RPPGDS block

/  allocate a block for the main RPPGDS descriptor block

/  account for this allocation in SPCSPF

/  link the RPPGDS block to the doc. header block by storing
/    the RPPGDS block # in the 43rd (dec.) word of the header block

/  update "main RPPGDS" block # storage word with the block # returned
/    from the allocation request
/  update "current RPPGDS" block pointer with the pointer to the
/    "main RPPGDS" block # storage word

	JMS	RPALLOCATE	/GO ALLOCATE A BLOCK FOR G-T-P		/M029
	CDFBUF			/CHANGE TO BUFFER FIELD
	DCA I (SCHDR+53		/LINK RPPGDS TO DOC. HEADER
	TAD I (SCHDR+53		/GET OUR BLK# BACK
	CDFMYF			/BACK TO THIS FIELD
	DCA	RPHDRB		/COPY IN RPPGDS BLOCK TABLE

	JMS	WRITEOUT	/WRITE OUT THE ALLOCATION BLK.		/A031

RPMAIN,	TAD	(RPHDRB		/ADDR. OF MAIN RPPGDS BLOCK

RPRD2,				/ENTER HERE TO SET RPHDBN		/M030
	DCA	RPHDBN		/IS NOW THE ACTIVE RPPGDS BLOCK

/  a block has been allocated either for the main RPPGDS block,
/    or one of its' extensions.
/  initialize the RPPGDS scroll buffer (7400) to reflect this new
/    block.
/  the content of this buffer will be written when the associated
/    doc. header block is written.

	JMP	RPCKV2		/IS THIS 2ND EXTN. BLOCK?		/M031

RPRDND,				/END OF READ; RPPGDS CONTAINS NEW BLOCK
REEDXT,	JMP I	RPREA1		/RETURN TO CALLER			/M032

/  this document has a V2.n RPPGDS linked to it; meaning that it
/  it has been OPENed by a V2.n WPS system...
/
/  read the RPPGDS block into its scroll buffer (7400) and verify
/  that it contains up-to-date text block desciptors.
/
/  IF  AC = 0 after RPRDIT (verification) RPPGDS descriptors can be use
/     ELSE  RPPGDS does not contain up-to-date text block descriptors.
/           Deallocate any RPPGDS extension blocks and initialize
/           the main RPPGDS block.

RPRDDS,				/AC = NEW MAIN DESC. BLK. #		/M019
	CLA			/CLEAR AC HERE TO			/A029
	TAD I (SCHDR+53		/GET G-T-P BLOCK #			/A029
	JMS	RPRDIT		/READ/VERIFY IT
				
	MQL			/SAVE VERIFY RESULT			/A019
	TAD	NEWBLK		/GET THE NEW DESC. BLK. #		/A019
	DCA	RPHDRB		/PUT IT IN BLOCK-TABLE			/A019

RPEXT,				/GOOD BLOCK; MAKE IT THE 'CURRENT' ONE
				/WRITE-BEFORE-READ FLAG IS SET
	TAD	(RPHDRB		/ADDR OF MAIN RPPGDS BLK. IN BLOCK TABLE/M011
	DCA	RPHDBN		/MAKE MAIN RPPGDS BLOCK THE CURRENT BLOCK/M011

/ OPENING.....
/  supply RPPGDS extension block numbers, if any...

	CDFRPB			/RPPGDS BUFFER FIELD
	TAD I (RPPGDS+2		/1ST EXTN. BLOCK # OR 0
	CDFMYF			/BACK TO THIS FIELD
	DCA	RPHDRB+1	/INTO OUR CONTROL TABLE
	CDFRPB			/RPPGDS BUFFER FIELD
	TAD I (RPPGDS+3		/2ND EXTN. BLOCK # OR 0
	CDFMYF			/BACK TO THIS FIELD
	DCA	RPHDRB+2	/INTO OUR CONTROL TABLE

	MQA			/REPLACE RESULT OF VERIFY(RPRDIT)      /A019/M031

	SNA CLA			/SKIP IF ITS CORRUPTED                  /M031
	JMP	REEDXT		/GOOD MAIN-GTP BLK; EXIT		/A032
	JMS	RPDSCR		/DE-ALLOC. RPPGDS EXTN, IF ANY          /M031
	JMP	RPMAIN		/RE-INIT. MAIN RPPGDS BLOCK/            /M031

/ a document header extension block has been read.
/
/ identify which extension and determine if the RPPGDS block
/  has a parrellel extension available.
/
/ if not, allocate a block for an extension and initialize the
/  the RPPGDS scroll buffer to reflect the new block.
/  link the new extension to the RPPGDS block table and make the
/  new extension the "active" block.
/
/ if extension already present, read it into the RPPGDS scroll buffer

RPRDEX,				/HERE WHEN THE PARALLEL BLOCK IS AN EXTN.
	TAD	SCHDBN		/PTR. INTO DOC. HDR. BUFFER CONTROL AREA
	TAD	(-SCHDRB	/MINUS THE START OF THE CONTROL AREA
	TAD	(RPHDRB		/PLUS THE START OF THE RPPGDS CONTROL AREA
	DCA	EXTNOF		/= PTR. TO PARRELLEL RPPGDS BLOCK #

	TAD I EXTNOF		/GET THE BLOCK # OF THE PARRELLEL RPPGDS BLOCK
	SNA			/SKIP IF THERE IS A BLOCK # AVAILABLE
	JMP	RPALEX		/AC => 0; NO BLOCK AVAILABLE
	JMS	RPRDIT		/AC => BLK #; READ THE BLOCK
	SNA CLA			/SKIP IF RPPGDS BLOCK CORRUPTED
	JMP	RPXEX		/EXIT:PARRELLEL RPPGDS BLOCK IN BUFFER (7400)
	TAD I EXTNOF		/SUPPLY THE BLOCK #
	JMS	RPDSFR		/DE-ALLOCATED THE CORRUPTED BLOCK

/ Here to allocate a block for the RPPGDS.
/ Put the block # returned (allocated) into the appropriate
/  RPPGDS block table entry and make this block the "current"
/  current block.
/ Go and initialize our scroll buffer (7400) to reflect a new
/  unused block.

RPALEX,	JMS	RPALLOCATE	/GO ALLOCATE AN EXTN. BLOCK		/A029
	DCA I EXTNOF		/PUT IT IN RPPGDS BLK TABLE AT EXTN. ENTRY

/ A BLOCK WAS JUST ALLOCATED, SO WRITE-OUT THE ALLOCATION BLOCK		/A031
	JMS	WRITEOUT	/WRITE-OUT THE ALLOCATION BLOCK		/A031

/ supply the link to the 1st and 2nd extension blocks now...
	JMS	RPWRTH		/WRITE OUT CURRENT GTP BLK		/A034

RPLNK,	TAD	EXTNOF		/POINTER TO CURRENT TABLE ENTRY		/A034
	JMP	RPRD2		/INIT. RPPGDS EXTN. BLOCK IMAGE

RPXEX,	TAD	EXTNOF		/CONTROL TABLE ENTRY POINTER
	DCA	RPHDBN		/MAKE THIS EXTN. THE CURRENT BLOCK
	JMP	REEDXT		/EXIT:EXTN. IN BUFFER			/A032

RPALLOCATE,	XX		/GET A BLOCK FOR THIS DOC.		/A029
	JMS	RPQRX		/INTERNAL REQ. TO ALLOC. A BLOCK	/A029
	RXEAL			/FC5=ALOOCATE A BLOCK			/A029
	0			/NO BUFFER NECESSARY			/A029

	JMS	SCSPC		/UPDATE # OF FREE BLOCK ON DISKETTE	/A029
				/SPCSPF IN PAGE 0

	TAD	SCQBLK+RXQBLK	/GET THE BLK# JUST ALLOC.		/A029
	JMP I RPALLOCATE	/RETURN WITH AC = BLOCK #		/A029
/---------------
	PAGE

/ here after a block has been written.
/
/ IF THE BLOCK JUST WRITTEN WAS THE DOC. HEADER BLOCK (CLOSE),
/ WRITE THE MAIN RPPGDS BLOCK AFTER INITIALIZING APPROPRIATE
/ IDENTIFICATION WORDS
/
/  ASSUMPTION: IF THE DOC. HEADER BLOCK WAS IN THE SCROLL BUFFER
/              THEN THE PARALLEL RPPGDS BLOCK WAS CO-RESIDENT
/
RPWRTH,	XX								/A034
	TAD	RPWRTH		/GET CALLER'S RETURN ADDR.		/A034
	DCA	RPWRT		/USE IT FOR THIS RETURN			/A034
	JMP	RPWRTO		/NOW GO WRITE BLOCK			/A034

RPWRT,	XX								/A032
	TAD	SCQBLK+RXQBLK	/BLK# JUST WRITTEN
	CIA			/FOR COMPARE TO
	TAD I (SCHDRB		/DOC. HDR. BLK. #
	SZA CLA			/SKIP WITH MAIN HDR. BLK.
	JMP	RPWRTO		/GO DO PARALLEL EXTENSION BLK

/ before writting the MAIN RPPGDS block, update the identifiaction
/  words...

	CDFBUF			/BUFFER FIELD
	TAD I (SCHDR+5		/# OF BLKS. ALLOCATED TO THIS DOC.
	CDFRPB			/OUR BUFFER FIELD
	DCA I (RPPGDS+5		/UPDATE NEW DATA STRUCTURE
	CDFBUF
	TAD I (SCHDR+10		/DAY-MONTH OF LAST EDIT
	CDFRPB			/OUR BUFFER FIELD
	DCA I (RPPGDS+10	/SAME HERE
	CDFBUF
	TAD I (SCHDR+11		/LAST 2 DIGITS OF YESR
	CDFRPB			/OUR BUFFER FIELD
	DCA I (RPPGDS+11		/SAME HERE
	CDFBUF
	TAD I (SCHDR+12		/START TIME OF LAST EDIT
	CDFRPB			/OUR BUFFER FIELD
	DCA I (RPPGDS+12	/SAME HERE
	CDFMYF			/BACK TO OUR FIELD

/  now write out the buffer to update the RPPGDS MAIN block...

/  write the "current" block to disk after clearing its' modified bit

RPWRTO,				/WRITE THE RPPGDS BLOCK TO DISK
	TAD I RPHDBN		/GET THE RPPGDS BLOCK #
	JMS	RPQRX		/WRITE OUT A RPPGDS BLOCK
	RXEWT+2000		/FC 4 = WRITE/VERIFY
	RPPGDS			/BLOCK IMAGE FROM THIS BUFFER
	JMP I RPWRT		/EXIT:PARALLEL RPPGDS BLK WRITTEN	/A032

/  a descriptor word has been built (RPDSBD) depicting the
/   positioning information contained within the text block
/   just written to disk...

/ if  the scroll buffer just used was the STX buffer, then
/       use SCTOP for offset into RPPGDS for descriptor word location
/   else   use SCBOT for offset

RPDSWD,				/UPDATE RPPGDS
	0			/SAVE CALLERS RETURN ADDR.
	TAD	SCQBLK+RXQBAD	/BUFFER JUST USED FOR IO
	TAD	(-SCTB		/COMPARE TO TOP (STX)
	SZA CLA			/SKIP IF STX TO USE SCTOP
	AC0001			/WANT SCBOT FOR BOTTOM (ETX)
	TAD	(SCTOP-1	/POINT TO BLOCK OFFSET
	DCA	X3		/INIT. TO BLOCK OFFSET
	JMS	RPDSW1		/GET MODE OF CHARACTER			/A017
	TAD I	X3		/GET THE CURRENT BLOCK OFFSET
A1,	TAD	M376		/MINUS # OF WORDS IN A BLOCK  (254)
	SMA			/SKIP WITH DESCRIPTOR PTR -400
	JMP	A1		/BIG DOC., REPEAT
	TAD	T400		/CONVERT TO POSITIVE WORD OFFSET
				/AC = OFFSET TO BLOCK JUST WRITTEN
	TAD	(RPPGDS		/PLUS START OF OUR SCROLL BUFFER
	DCA	DESCOF		/DESCOF => PTR TO APPRO. DESCRIPTOR
	TAD I	T3		/GET CURRENT DESCRIPTOR WORD		/A030
	CDFRPB			/GET TO OUR BUFFER FIELD
	DCA I DESCOF		/UPDATE DESCRIPTOR WORD IN SCROLL BUFFER
	CDFMYF			/BACK TO OUR FIELD
	DCA I	T3		/CLEAR DESC. SAVE AREA FOR NEXT		/A030
	JMP I RPDSWD		/EXIT: BUFFER UPDATED; WRITE OUT

/ OUR BUFFER WHEN PARELLEL DOC. HDR. BLK. GET'S WRITTEN OUT

DESCOF,	0			/RPPGDS BUFFER DESCRIPTOR WORD OFFSET

		/RPPGDS SCROLL HEADER BUFFER CONTROL AREA:

RPBFCB,	RPPGDS	/SCROLL BUFFER ADDRESS IN FIELD 2
RPHDBN,	0	/POINTER TO CURRENT RPPGDS BLOCK IN THE BUFFER :
		/THE POINTER IS ADDR. OF ONE OF THE FOLLOWING

RPHDRB,	0	/FIRST HEADER BLOCK NUMBER
	0	/SECOND
	0	/THIRD
	0	/SO ON TO THE 17TH
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
RPHMD,	0		/TERMINATOR					/M007

WRITEOUT,
	XX			/SAVE CALLERS RETURN ADDRESS		/A031
	JMS	RPQRX		/WRITE THE ALLOCATION BLOCK		/A031
	RXERT			/FC 0					/A031
	0			/DUMMY BUFFER ADDRESS			/A031
	JMP I	WRITEOUT	/RETURN TO CALLER			/A031

CKSAME,	XX			/ROUTINE TO CHECK TO SEE IF THE DOCUMENT/A044
				/HEADER BLOCK TO BE RESTORED DURING A	/A044
				/RESTORE SYSTEM FILE POINTERS CALL IS	/A044
				/ALREADY IN CORE			/A044
	DCA	T1		/SAVE THE ONE WE WANT			/A044
	TAD	T1		/GET IT BACK AND			/A044
	CIA			/NEGATE IT				/A044
	TAD	SCHDBN		/ADD IN THE ONE WE HAVE ALREADY		/A044
	SNA CLA			/SKIP IF THEY ARE DIFFERENT		/A044
	ISZ	CKSAME		/ELSE TAKE THE SKIP RETURN TO BYPASS	/A044
				/  ..THE UNNECESSARY READ		/A044
	TAD	T1		/GET THE HDR BLK # WE WANT BACK		/A044
	DCA	SCHDBN		/& PUT IT IN AS THE CURRENT		/A044
	JMP I	CKSAME		/RETURN TO CALLER			/A044

/---------------
	PAGE

/  here to make a request for IO...
/
RPQRX,	0		/INTERNAL CALLER'S RETURN ADDR.
	CDFMYF			/HERE FOR ROOM				/A029
	DCA	SCQBLK+RXQBLK	/BLOCK #, IF THERE IS ONE
	TAD	(CDFRPB)	/ GET RPPGDS BUFFER FIELD.		/M028
	DCA	SCQBLK+RXQBFD	/SUPPLY FIELD
	TAD I RPQRX		/GET FUNCTION CODE
	DCA	SCQBLK+RXQFNC	/SUPPLY FUNCTION CODE
	ISZ	RPQRX		/BUMP TO GET BUFFER ADDR.
	TAD I RPQRX		/GET RPPGDS BUFFER ADDR.
	DCA	SCQBLK+RXQBAD	/SUPPLY BUFFER ADDR.
	ISZ	RPQRX		/BUMP TO RETURN ADDR.

	CIFSYS
	ENQUE
	SCQUBL

RPQRX1,	CIFSYS
	JWAIT
	TAD	SCQBLK+RXQCOD
	SNA
	JMP	RPQRX1
	SMA
	CLA
	JMP I RPQRX		/EXIT:IO COMPLETED

/  here only after a block has been allocated to RPPGDS
/  initialize the RPPGDS "scroll" buffer (7400) words to -1

/     initialize the first two words to imitate a standard WPS
/     "fixed" block.
/	word 0 =  -255 entries in this block
/	word 1 =  0070  (ID code )
/
/	clear the extension block pointers (words 2&3)

RPBFIN,	0		/RETURN ADDR TO CALLER
	TAD	(RPPGDS-1 /START ADDR. -1
	DCA	X3	/INIT. AUTO INDEX REG. TO RPPGDS BUFFER
	TAD	(COSCNT	/-255 VALUE FOR 1ST WORD
	CDFRPB		/GET TO OUR BUFFER FIELD
	DCA I X3	/SET 1ST WORD TO -255
	TAD	(0070	/OUR UNIQUE ID CODE
	DCA I X3	/INTO 2ND WORD
	DCA I X3	/AND CLEAR THE EXTENSION BLOCK
	DCA I X3	/POINTERS

	TAD	(7404	/NEG. 252 WORD COUNTER
	DCA	RPTEM1	/RPTEM1 => NEG. WORD COUNTER
B,	AC7777		/AC => -1
	DCA I X3	/ADVANCE PTR. AND THEN SET A WORD TO -1
	ISZ	RPTEM1	/SKIP IF ALL RPPGDS BUFFER WORDS INIT'D.
	JMP	B	/NOT DONE, SO LOOP...

	CDFMYF		/BACK TO THIS FIELD
	JMP I RPBFIN	/EXIT: RPPGDS SCROLL BUFFER INIT'D TO -1
			/EXCEPT WORD 0 (-255) AND WORD 1 (0070)
			/AND 2&3 (0)

RPTEM1,	0		/TEMP. MUST BE ON THIS PAGE			/M046

/  here to free a block pertaining to a corrupted RPPGDS

/  ON ENTRY:  AC = BLOCK # TO FREE

RPDSFR,	0		/SAVE RETURN TO CALLER
	JMS	RPQRX	/INTERNAL REQ. TO FREE A BLOCK
	RXEFR		/FC 6 = FREE A BLOCK
	0		/DUMMY
	CLA		/INSURE A CLEARED AC
	JMP I RPDSFR	/EXIT: BLOCK HAS BEEN FREED

/ here to clear all extension blocks associated with a corrupted MAIN
/  RPPGDS...

RPDSCR,	0		/RETURN ADDR.
	TAD	(RPHDRB		/START WITH THE 1ST EXTN. BLOCK
	DCA	X3		/X3 => PTR. TO BLOCK TO BE FREED
	TAD	X3		/
	DCA	X4		/X4 => PTR. TO TABLE ENTRY THAT CONTAINED FREED BLK.

RPFRDS,	TAD I X3		/GET BLOCK # TO BE FREED
	SNA			/SKIP IF THERE IS ONE
	JMP	RPENDS		/DO UNTIL PHYSICAL END OF TABLE
	JMS	RPDSFR		/GO FREE A BLOCK
	DCA I X4		/TAKE BLOCK OUT OF TABLE

RPENDS,	TAD	X3		/NEXT ENTRY TO GET BLOCK # FROM
	IAC			/					/A007
	TAD	(-RPHMD		/TEST PHYSICAL END AND NOT NULL

				/ENTRY IN CASE ENTIRE TABLE FILLED AND RPHMD
				/WORD NOT NULL...
	SZA CLA			/SKIP IF ALL BLOCKS FREED
	JMP	RPFRDS		/GO DO ANOTHER ENTRY
	JMP I RPDSCR		/EXIT:RPPGDS AND ALL EXTENSIONS FREED

/ during the CLOSE procedure, perform the same housekeeping
/  on the RPPGDS blocks that is done to the DOC. HEADER blocks...

RPGETR,	0			/CALLER'S RETURN ADDR.
	TAD	SCGTR1		/DOC. HDR. BLK. SCROLL BUFFER ADDR.
	AND	P377		/STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET
	TAD	(RPPGDS		/ADD THIS WORD OFFSET TO OUR BUFFER ADDR.
	DCA	RPGTR1		/RESULTING IN A POINTER TO THE PARRELLEL WORD

	CDFRPB			/GET THE RPPGDS DATA FIELD
	TAD I RPGTR1		/GET OUR PARRELLEL WORD
	CDFMYF			/BACK TO THIS FIELD
	DCA	RPPTR1		/AND SAVE IT FOR PUT LATER...
	JMP I RPGETR		/EXIT:RPPGDS WORD ALSO AVAILABLE

RPPUTR,	0			/CALLER'S RETURN ADDR.
	TAD	SCGTR1		/DOC. HDR. BLK. SCROLL BUFFER ADDR.
	AND	P377		/STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET
	TAD	(RPPGDS		/ADD THIS WORD OFFSET TO OUR BUFFER ADDR.
	DCA	RPGTR1		/RESULTING IN A POINTER TO THE PARRELLEL WORD
	TAD	RPPTR1		/GET RPPGDS WORD SAVED DURING GET
	CDFRPB			/RPPGDS SCROLL BUFFER FIELD
	DCA I RPGTR1		/PUT WORD IN PARRELLEL RPPGDS LOCATION
	CDFMYF			/BACK TO THIS FIELD
	JMP I RPPUTR		/EXIT:PARRELLEL RPPGDS WORD UPDATED

RPGTR1,	0			/POINTER TO PARRELLEL RPPGDS WORD
RPPTR1,	0			/PUT RPPGDS CHAR. HERE;GET RPPGDS CHAR. FROM HERE

SPCTAB,		/12 BIT SPECIALS TO 6-BIT TRANSLATION TABLE
	7727	/LINE MODIFIED		(CMD 6)
	7707	/ENTER COMPOSITE	(CMD &)
	7706	/TAB			(CMD %)
	7713	/END OF LINE		(CMD *)
	7721	/A016
	7714	/END OF PAGE		(CMD +)
	7710	/EXIT COMPOSITE		(CMD ')
	7730	/START OF A RULER	(CMD 7)
	7731	/END OF A RULER		(CMD 8)

COSTAB,		/12-BIT MODES INTO 6-BIT TRANSLATION TABLE
	74	/SHIFT
	76	/UNSHIFT
	7703	/EXIT BOLD		(CMD ")
	7702	/ENTER BOLD		(CMD !)
	7705	/EXIT UNDERLINE		(CMD $)
	7704	/ENTER UNDERLINE	(CMD #)
	7716	/EXIT SUPERSCRIPT	(CMD -)
	7715	/ENTER SUPERSCRIPT	(CMD ,)
	7720	/EXIT SUBSCRIPT		(CMD /)
	7717	/ENTER SUBSCRIPT	(CMD .)
	7712	/EXIT AUX.		(CMD ))
	7711	/ENTER AUX.		(CMD ()

	MAXCOS=.-COSTAB	/# OF MODES
	0	/END OF TABLE


/									/A042
/ WPFILS FUNCTION TO SET SCTOP,SCTPH					/A042
/ DOES NO DISK I/O							/A042
/									/A042
RRSCTP,	XX								/A042
	DCA	SCTOP							/A042
	MQA								/A042
	DCA	SCTPH							/A042
	JMP I	RRSCTP							/A042


/---------------
	PAGE

/ read the  RPPGDS block into our scroll buffer (7400)
/ then determine if the descriptor words reflect an up-to-date
/    text block content...
/
/	ON ENTRY:  AC => BLK # OF RPPGDS
/	ON EXIT :  AC => 0 WHEN RPPGDS OK
/		   AC => NOT 0 WHEN RPPGDS CORRUPTED

RPRDIT,	0		/CALLER'S RETURN ADDR.
	CDFMYF		/A032
	DCA	NEWBLK	/SAVE BLOCK # TO BE READ			/A019
	TAD	RPHDBN	/GET PTR. TO  BLOCK # THAT IS CURRENTLY ACTIVE
	SNA		/ IS IT ZERO?					/A011
	JMP	RPDORD	/ YES, DON'T WRITE OUT OLD HEADER		/A011
	DCA	TMPPTR	/FOR INDIRECT THRU THIS PAGE
	TAD I TMPPTR	/GET THE BLOCK #
	CIA		/FOR COMPARE					/A007
	TAD	NEWBLK	/ALREADY IN BUFFER?				/A007/M019
	SNA CLA		/SKIP IF NOT					/A007
	JMP I RPRDIT	/RETURN IF SO					/A007
	TAD I TMPPTR	/ACTIVE BLOCK #					/A007

	JMS	RPQRX	/GO WRITE IT TO DISK
	RXEWT+2000	/WRITE AND VERIFY F.C.
	RPPGDS		/ADDR. OF BUFFER
	CLA

RPDORD,	TAD	NEWBLK	/REPLACE BLOCK # TO BE READ		/M019
	JMS	RPQRX	/"INTERNAL" REQUEST TO READ RPPGDS BLOCK
	RXERD		/FC 3 = READ LOG. BLOCK
	RPPGDS		/PTR TO OUR SCROLL BUFFER

/ BEGIN THE VERIFICATION PROCESS:
/
/  if  this document was OPENed by a V2.n WPS then the 2nd word
/      of this block should contain the unique ID code of 0070
/     else   this block used for other than RPPGDS descriptor words

	TAD	(-0070	/NEG. RPPGDS ID CODE
	CDFRPB		/SCROLL BUFFER DF
	TAD I (RPPGDS+1	/COMPARE TO 2ND WORD OF RPPGDS BLOCK
	CDFMYF		/BACK TO THIS FIELD
	SZA		/SKIP IF THIS IS THE RPPGDS BLOCK
	JMP I RPRDIT	/AC => NOT 0 ERROR RETURN

/  if  the # of blocks allocated to this document is the same for
/      both the doc. header block and the RPPGDS block, then this
/      RPPGDS block ok
/    else   this document was used on a system that did not contain
/           V2.n GOTO PAGE software.
/	    The RPPGDS descriptor words are not the most current
/	    reflection of the text blocks within this document.

	TAD	NEWBLK		/GTP BLK # JUST READ			/A034
	CIA			/FOR COMPARES				/A034
	TAD	RPHDBN		/MAIN GTP BLK# OR 0 FOR OPENING DOC.	/A034
	SZA			/SKIP TO VERIFY MAIN GTP BLK		/A034
	TAD	NEWBLK		/SEE IF RPHDBN WAS 0 FOR OPENING	/A034
	SZA CLA			/SKIP TO VERIFY MAIN GTP BLK		/A034
	JMP I RPRDIT		/DON'T VERIFY EXTENSIONS

	CDFBUF		/SCROLL BUFFER DF
	TAD I (SCHDR+5	/# OF BLOCK ALLOCATED TO THIS DOC.
	CIA		/MAKE NEG. FOR COMPARE
	CDFRPB		/OUR BUFFER FIELD
	TAD I (RPPGDS+5	/COMPARE TO ITS RPPGDS COUNTER-PART
	CDFMYF		/BACK TO THIS FIELD
	SZA		/SKIP IF # OF BLOCK THE SAME
	JMP I RPRDIT	/ERROR EXIT: AC NOT = 0

/  if   the DAY-MONTH-YEAR of both the doc. header block and the
/       RPPGDS block match, then this document CLOSED by a V2.n
/       system.
/    else   this document used by a system not containing V2.n
/	    GOTO PAGE software.

	CDFBUF		/SCROLL BUFFER FIELD
	TAD I (SCHDR+10	/DAY-MONTH
	CIA		/MAKE NEG. FOR COMPARE
	CDFRPB		/OUR BUFFER FIELD
	TAD I (RPPGDS+10	/GET COUNTERPART
	CDFMYF		/BACK TO THIS FIELD
	SZA		/SKIP IF A MATCH
	JMP I RPRDIT	/ERROR EXIT:AC NOT = 0
	CDFBUF		/SCROLL BUFFER FIELD
	TAD I (SCHDR+11	/LAST 2 DIGITS OF YEAR VALUE
	CIA		/CONVERT TO NEG. FOR COMPARE
	CDFRPB		/OUR BUFFER FIELD
	TAD I (RPPGDS+11	/GET COUNTERPART
	CDFMYF		/BACK TO THIS FIELD
	SZA		/SKIP IF YEAR VALUES AGREE
	JMP I RPRDIT	/ERROR EXIT: AC NOT = 0

/	4)  IF THIS DOC. WAS OPENED BY A V2.0 OR LATER WPS
/	    THEN THE START TIME OF THE LAST EDIT CYCLE SHOULD BE
/	    THE SAME IN BOTH BLOCKS...

	CDFBUF		/SCROLL BUFFER FIELD
	TAD I (SCHDR+12	/START TIME OF LAST EDIT
	CIA		/NEG. VALUE FOR COMPARE
	CDFRPB		/OUR BUFFER FIELD
	TAD I (RPPGDS+12	/GET THE COUNTERPART
	CDFMYF		/BACK TO THIS FIELD
	JMP I RPRDIT	/EXIT W/AC CONTAINING RESULT

/ here after a TEXT block has been written to diskette.
/ locate the scroll buffer used and read its contents, looking
/  for repositioning information and mode.

RPSPLT,	0		/NEG. = "SPLIT" ESC SEQ.
			/ POS. = NORMAL 2 CHAR. SEQ.
			/I.E., 1277 1250 7713 3377 1477
RPENDB,	0		/BUFFER CHAR. COUNTER

RPDSBD,	0			/SAVE CALLERS' RETURN ADDR.
	AC0001			/					/A030
	DCA	TMPPTR		/FIRST-TIME THRU ETX FLAG		/A030
	DCA	SOMFLG		/CLEAR FIRST-TIME THRU STX FLAG		/A030
	TAD	M376		/SET UP A NEG. 254 WORD COUNTER		/M021
	DCA	RPENDB		/TO END DESCRIPTOR WORD BUILD

	TAD 	T3		/ DESC. BEING USED			/A030
	TAD	(-ETXDES	/IS IT ETX?				/A030
	SZA CLA			/SKIP TO PROCESS ETX BUFFER CHARS.
	TAD	T400		/BUMP TO PROCESS STX BUFFER CHARS.
	TAD	(SCEB+BOFSET-1	/INIT. BUFFER WORD POINTER
	DCA	X3		/TO WORD IMMEDIATELY BEFORE 1ST WORD

DSBDST,	TAD	RPSPLT		/GET "SPLIT" ESC SEQ. FLAG
	AND	P7700		/GET THE ESC CHAR.
	TAD	M7700		/COMPARE TO ESC CODE			/M021
	SZA CLA			/SKIP TO PROCESS "SPLIT" ESC
	JMP	DSBDWD		/JUMP TO PROCESS NORMAL WORD
	CDFBUF			/SCROLL BUFFER FIELD
	TAD I X3		/GET THE CURRENT BUFFER WORD
	CDFMYF			/BACK TO OUR FIELD
	BSW			/USE BITS 6-11 FOR "SPLIT" FLAG
	DCA	RPSPLT		/UPDATE FLAG AND MAKE A COPY OF CURRENT WORD
	TAD	RPSPLT		/GET THE CURRENT BUFFER WORD
	AND	P77		/OUR SECOND HALF OF ESC SEQ.
	TAD	P7700		/SUPPLY THE ESC. CHAR.			/M021
	JMP	DOESC+1		/GO PROCESS ESC SEQ. IN AC		/M021

DSBDWD,	CDFBUF			/SCROLL BUFFER FIELD
	TAD I X3		/GET THE CURRENT BUFFER WORD
	CDFMYF			/BACK TO THIS FIELD
	MQL			/SAVE WORD IN MQ			/A021
	ACL			/RESTORE CHAR				/A021
	AND	P7700		/GET THE ESC CHAR			/A021
	TAD	M7700		/COMPARE TO ESC CODE			/A021
	SNA			/SKIP IF NORMAL				/M021
	JMP	DOESC		/GO PROCESS ESC SEQ. IN AC
	ACL			/RESTORE CHAR				/A021
	BSW			/LOOKING FOR "SPLIT" ESC SEQ.
	DCA	RPSPLT		/IF ESC CHAR., FLAG IS NOW NEG.

DSBDEX,	ISZ	RPENDB		/BUMP BUFFER CHAR. COUNTER
	JMP	DSBDST		/READ ANOTHER BUFFER WORD
	JMS	RPDSWD		/PUT CURRENT DESCRIPTOR WORD IN RPPGDS
	DCA	RPSPLT		/CLEAR SPLIT FLAG FOR EACH BLOCK	/A038
	JMP I RPDSBD		/AND EXIT: THIS TEXT BLOCK HAS A NEW DESCRIPTOR WORD

TMPPTR,	0			/POINTER ON THIS PAGE TO ACCESS BLOCK CONTROL TABLE
/---------------
	PAGE

RPMODE,	0		/BUILD OUR OWN MODE BYTE
RPPCTLFL,	0	/PRINT-CONTROL STATE FLAG		/A030

TORPDSBD,	XX	/INIT. DESC. WORD AND BIT 5		/A030
	ISZ	T3	/BUMP TO STX/ETX DESC. WORD		/A030
	TAD	RPPCTLFL/CONTENTS OF PRINT-CONTROL FLAG		/A030
	DCA I	T3	/INIT. APPROPRIATE DESC WORD		/A030
	JMS	RPDSBD	/IDENTIFY/RECORD PERTINENT ESC 		/A030
	JMP I	TORPDSBD/CONTINUE PUT PROCESS			/A030

/ RPDESC bit assigmnents:						/M012
/
/  0  1  2  3  4  5  6  7  8  9  10  11
/  R  J  S  U  B  C  U  P  P  P  P   P
/                 A  S
/
/	when bit 'ON':
/			R  = a RULER starts in this block
/			J  = Justify
/			S  = Superscript
/			U  = Underscore
/			B  = Bold
/		    S & U  = Subscript
/		       CA  = (Print) Control Area	
/			US = Unshift
/			P  = total number of PAGES in this block
/
/ determine if this ESC sequence has to be reflected in our text
/ block descriptor word.
/
/	ON ENTRY: AC contains full 2-char. ESC Sequence...

DOESC,	ACL		/GET THE CURRENT BUFFER WORD BACK		/A021
	CIA		/MAKE POSITIVE FOR COMPARES
	TAD	(7730	/COMPARE TO START OF RULER
	SNA		/SKIP IF NOT START OF RULER
	JMP	RPSTRL	/GO INDICATE THAT THIS BLOCK HAS A RULER
	TAD	(7720-7730	/EXIT SUBSCRIPT MODE?			/A016
	SNA			/SKIP IF NOT
	JMP	RPEXSB		/GO CLEAR SUBSCRIPT MODE	/M030
	TAD	(7717-7720	/ENTER SUBSCRIPT MODE?
	SNA			/SKIP IF NOT
	JMP	RPENSB		/GO SET SUBSCRIPT MODE		/M030
	TAD	(7716-7717	/EXIT SUPERSCRIPT MODE?
	SNA			/SKIP IF NOT
	JMP	RPEXSU		/GO CLEAR SUPERSCRIPT MODE
	TAD	(7715-7716	/ENTER SUPERSCRIPT MODE?
	SNA			/SKIP IF NOT
	JMP	RPENSU		/GO SET SUPERSCRIPT MODE
	TAD	(7714-7715	/COMPARE TO END PAGE SEQUENCE
	SNA 		/SKIP IF NOT
	JMP	RPPGMK	/FLAG PAGE MARK IN DESCRIPTOR
	
/ now check for MODE....

	TAD	(7712-7714	/EXIT AUX. MODE?
	SNA			/SKIP IF NOT
	JMP	RPEXAU		/GO CLEAR AUX. BIT
	TAD	(7711-7712	/ENTER AUX. MODE?
	SNA CLA			/SKIP IF NOT
	JMP	RPENAU		/GO SET AUX. BIT
	JMP	DSBDEX		/EXIT:

/ ESC. sequence was end of page.  This type of sequence with MODE
/ equal NONE represents a NEW PAGE MARK, or, this sequence with
/ AUX. set represents a PAGE MARKER; any other mode is not applicable.

RPPGMK,	TAD	(1200	/TEST SUPER/SUB SCRIPT		/M030
	AND	RPMODE	/IN CURRENT MODE		/M030
	SZA CLA		/SKIP IF NEITHER (PAGE MARK)	/M030
	JMP	CHCNTL	/JUMP IF PRINT CONTROL INFO	/M030
	ISZ I	T3	/REFLECT PAGE MARKER		/M030
	JMP	DSBDEX	/RETURN TO NORMAL PUT PROCESS	/M030

CHCNTL,	TAD	TMPPTR	/TEST FIRST-TIME THRU ETX FLAG		/A030
	SNA CLA		/SKIP IF 1ST TIME THRU			/A030
	JMP	DSBDEX	/CONTINUE PUT PROCESS			/A030
	TAD	T3	/POINTER TO CURRENT DESC. WORD		/A030
	TAD	(-ETXDES /COMPARE TO ETX			/A030
	SZA CLA		/SKIP IF ETX BUFFER			/A030
	JMP	CHKSTX	/ PROCESS STX				/A030
	DCA	TMPPTR	/CLEAR FIRST TIME THRU FLAG		/A030
	AC0001		/					/A030
	DCA	SOMFLG	/FORCE ETX EXIT 			/A030
	TAD	(200	/END PRINT-CONTROL MASK			/A030
	AND	RPMODE	/TEST CURRENT MODE			/A030
	JMP	CHKETX	/CONTINUE TO PROCESS ETX OFF PAGE	/A030

RPSTRL,	TAD	P3777	/MAKE SURE RULER PRESENT BIT OFF
	AND I	T3	/BEFORE WE SET IT			/M030
	TAD	(4000	/SET RULER IN THIS BLOCK BIT
	DCA I	T3	/UPDATE DESCRIPTOR WORD			/M030
	JMP 	DSBDEX	/EXIT: RETURN TO NORMAL PUT-PROCESS

/ ESC sequence was EXIT SUPER/SUBSCRIPT mode....			/A012

RPEXSU,	TAD	(6777	/CLEAR SUPER-SCRIPT (1000)	/C030
	AND	RPMODE	/SAVE OTHER MODE BITS
	JMP	MODEXT	/GO UPDATE MODE AND EXIT

/ ESC sequence was ENTER SUPER/SUBSCRIPT mode....			/A012

RPENSU,	TAD	(6777	/MAKE SURE SUPER-SCRIPT BIT OFF	/C030	
	AND	RPMODE	/BEFORE WE SET IT
	TAD	(1000	/SET SUPER/SUBSCRIPT MODE BIT
	JMP	MODEXT

/ ESC sequence was EXIT AUX. mode...

RPEXAU,	TAD	(5777	/CLEAR AUX. MODE BIT (2000)
	AND	RPMODE	/SAVE OTHER MODE BITS
	JMP	MODEXT	/GO UPDATE MODE AND EXIT

/ ESC sequence was ENTER AUX. mode...

RPENAU,	TAD	(5777	/MAKE SURE AUX. MODE-ON BIT IS OFF
	AND	RPMODE	/BEFORE WE SET IT
	TAD	(2000	/SET AUX. MODE BIT
	JMP	MODEXT	/GO UPDATE MODE AND EXIT

/ ESC sequence was EXIT BOLD mode...

RPEXSB,	TAD	(7577	/CLEAR SUB-SCRIPT MODE BIT (0200)	/M030
	AND	RPMODE	/SAVE OTHER MODE BITS
	JMP	MODEXT	/GO UPDATE MODE AND EXIT

/ ESC sequence was ENTER BOLD mode...

RPENSB,	TAD	(7577	/MAKE SURE SUB-SCRIPT MODE BIT OFF	/M030
	AND	RPMODE	/BEFORE WE SET IT
	TAD	(200	/SET BOLD MODE

MODEXT,	DCA	RPMODE	/UPDATE OUR MODE WORD
	JMP	DSBDEX	/AND RETURN TO CONTINUE

RPTRS1,	XX
	DCA	SCTOP	/BACK FOR EDITOR
	TAD	EDHDR	/PREVIOUS ACTIVE HEADER BLOCK
	DCA	SCTPH	/INTO TOP HEADER POINTER
	TAD	EDHDR1	/GET ORIGINAL 'BOTTOM' HDR ID
	DCA	SCBTH	/BACK FOR EDITOR
	TAD	EDSCBK	/GET HDR BLK # THAT'S IN CORE
	JMS	CKSAME	/SEE IF WE NEED TO READ (NORMAL RETURN)		/A044
			/OR DO WE ALREADY HAVE (SKIP)			/A044
			/ ... THE CORRECT DOCUMENT HEADER BLOCK IN CORE	/A044
/D044	DCA	SCHDBN	/BACK FOR EDITOR
/note -- don't save and restore the current rppgds block in the buffer
	JMS	SCGTWR
	JMP I	RPTRS1	/RETURN

EDHDR1,	0		/USED TO SAVE/RESTORE SCBTH HDR ID
EDSCBK,	0		/USED TO SAVE/RESTORE HDR BLK # THAT'S IN CORE


/									/A042
/									/A042
/ SUBR RPTPDS -- Rapid Paging get ToP goto-page DeScriptor word		/A042
/									/A042
/ Gets GOTO-PAGE descriptor word of block currently defined by		/A042
/	top pointers SCTOP,SCTPH.					/A042
/ Probably reads appropriate GOTO-PAGE header block if it's not		/A042
/	currently loaded in the RPPGDS buffer.				/A042
/									/A042
/ CALL:									/A042
/	JMS	RPTPDS		/ GET TOP DESCRIPTOR WORD		/A042
/	/ AC = GOTO-PAGE DESCRIPTOR WORD (?FOR BLK IN STX BUFFER?)	/A042
/									/A042
/									/A042
RPTPDS,	XX								/A042
	JMS	SCGETR	/READ AN ENTRY FROM THE DOC. HEADER BLOCK
	SCTPH
	SCTOP

	AC0002		/IGNORE DOC. HEADER STUFF
			/AC := 2 TO GET PAST COS WORDS 1&2
	TAD	(RPPGDS	/OUR BUFFER STARTS HERE
	TAD	SCTOP	/PLUS THE PARELLEL DOC HEADER OFFSET
	DCA	T1	/SAVE EXTRA WORD				/A007

	CDFRPB		/GET OUR BUFFER FIELD
	TAD I T1	/						/A007
	CDFMYF		/BACK TO THIS FIELD
			/WITH DESCRIPTOR WORD IN AC....
	JMP I	RPTPDS	/EXIT						/A042


/---------------
	PAGE

/
/ This code was developed for the exclusive use of the V2
/  GOTO PAGE enhancement; it provides for 7 seperate functions:
/
/	1) when AC = -1:  Increment top ptrs; Get top G-T-P descriptor word
/	
/		permits the reading of successive "descriptor words"
/		and passes back the current descriptor word within
/		the AC for the caller (EDITOR).  The main advantage
/		of employing this method is the automatic loading
/		of sequential doc. header extension blocks and their
/		parallel RPPGDS extension blocks.
/
/	2) when AC = -2:  Save SYSTEM FILE POINTERS
/
/		Saves FILE SYSTEM POINTERS (current position within
/			GOTO-PAGE header structure), then
/		sets current position to ---TOP--- for function AC=-1.
/		If file position is to restored (function AC=-4), then
/			do not attempt to scroll to/from disk until
/			after calling function AC=-4.
/
/		Value returned to EDITOR:
/
/		AC= the current number of pages
/		    contained within the STX buffer.  This count will
/		    be used to calculate the current page being editted.
/
/	3) when AC = -3:  Get original and current top pointers
/
/		Value supplied on entry:
/
/		MQ= Pointer to 2-word save area for current SCTOP & SCTPH
/
/		Values returned to the EDITOR:
/
/		AC= the original value of SCTOP (saved by func AC=-2)
/		    (to be used to calculate the current PAGE being edited)
/		MQ= the original HDR. ID # (saved by func AC=-2)
/		CDFLP;@entry MQ = current value of SCTPH
/		CDFLP;@entry MQ = current value of SCTOP
/
/	4) when AC = -4:  Restore SYSTEM FILE POINTERS
/
/		the calculation of the total number of PAGES within
/		this document has been completed.  Before returning
/		to resume the edit session, return the FILE SYSTEM POINTERS
/		to those values saved at the start of the total PAGE
/		calculation.  It is possible that the HEADER scroll buffer
/		and the RPPGDS scroll buffer got overlaid with
/		successive extension blocks necessary to count all
/		pages within the document.  Furthurmore, SCTOP and SCBOT
/		were bumped to read successive descriptor words.
/
/	5) when AC = -5:  Get current bottom pointers
/
/		Values returned to the EDITOR:
/
/		AC= current contents of SCBOT
/		    (so that a determination can be made as to when the
/		    current block has been read.)
/		MQ= current contents of SCBTH
/
/	6) when AC = -6:  Get top G-T-P descriptor word; Increment top ptrs
/
/		Value supplied on entry:
/
/		AC= signed increment for top pointers
/		    (+- # of blocks to move; may=0)
/
/		Value returned to EDITOR:
/
/		AC= value of GOTO-PAGE descriptor word for block
/		    originally pointed to by top pointers (before
/		    they were incremented)
/
/	7) when AC = positive #:  Random-Access OPEN for scrolling
/		
/		Values supplied on entry:
/
/		AC= new SCBOT (header word pointer (offset into hdr blk))
/		MQ= new SCBTH (header block id number)
/
/		Initializes the TOP and BOTTOM pointer pairs
/		for random access of text blocks.
/		The entry AC&MQ together specify which document block
/		to open at.  After this function, ADVPTR will get characters
/		starting at the beginning of the opened block;
/		BAKPTR will get characters starting at the end of the
/		previous block.
/		(This function is used for several purposes.  Example:
/		positions the pointer pairs at the block in the
/		document containing the desired page to reposition
/		to.)
/

RPINIT,	0		/CALLER'S RETURN ADDRESS
	SPA		/SKIP TO SET UP FOR RANDOM READ
	JMP	RPDSCP	/JUMP TO TEST FURTHUR
/
/ RANDOM ACCESS OPEN
/
	DCA	SCBOT	/HDR WORD PTR INTO BOTTOM WORD PTR
	MQA		/GET THE HEADER #

	DCA	SCBTH	/PUT IN BOTTOM HEADER PTR

/ THE BOTTOM POINTERS ARE NOW SET FOR RANDOM READ

	TAD	SCBOT	/BOTTOM HDR WORD POINTER
	DCA	SCTOP	/NOW BECOMES THE TOP POINTER
	TAD	SCBTH	/GET THE BOTTOM HEADER POINTER
	DCA	SCTPH	/INTO TOP HEADER NUMBER
	JMS	SCTOPP	/GO DECR. TOP PTRS BY 1
	-1		/DECR. FACTOR

/ DEPICT AN EMPTY TEXT BUFFER...

	DCA	SCTPTR	/CLEAR STX BUFFER CHAR. POINTER
	TAD	(SCHCNT-1	/MAX. # OF BUFFER BYTES
	DCA	SCEPTR	/SET EXT BUFFER CHAR. POINTER AT MAX.

/ WHEN THE EDITOR REQUESTS A READ OF A CHAR. (LODCHR) FROM
/ AN INITIALIZED EDIT BUFFER, WPFILS WILL BE CALLED TO SUPPLY
/ A CHAR. FROM THE ETX BUFFER.  THE POINTER SET ABOVE WILL
/ RESULT IN READING A BLOCK FROM DISK INTO THE ETX BUFFER.

	AC0001		/SET Go To page FLaG TO				/A012
	DCA	GTFLG	/INDICATE A GO-TO-PAGE REQUEST			/A012
	JMP 	RPINEX	/EXIT:POINTERS ALL SET FOR RANDOM READ

GTFLG,	0		/SET TO INDICATE A GO-TO-PAGE REQUEST		/A012

RPDSCP,
	TAD	ONE	/SKIP TO READ DESCRIPTOR			/M025
	SZA 		/
	JMP	RPCNT	/JUMP TO TEST FURTHUR
/
/  the AC was -1......
/
	JMS	SCTOPP	/CLEARS AC, THEN INCR. TOP POINTER
	1		/BY 1

/D042 	JMS	SCGETR	/READ AN ENTRY FROM THE DOC. HEADER BLOCK
/D042 	SCTPH
/D042 	SCTOP
/D042
/D042 	AC0002		/IGNORE DOC. HEADER STUFF
/D042 			/AC := 2 TO GET PAST COS WORDS 1&2
/D042 	TAD	(RPPGDS	/OUR BUFFER STARTS HERE
/D042 	TAD	SCTOP	/PLUS THE PARRELLE DOC HEADER OFFSET
/D042 	DCA	T1	/SAVE EXTRA WORD				/A007
/D042
/D042 	CDFRPB		/GET OUR BUFFER FIELD
/D042 	TAD I T1	/						/A007
/D042 	CDFMYF		/BACK TO THIS FIELD
/D042 			/WITH DESCRIPTOR WORD IN AC....

	JMS	RPTPDS	/GET TOP GOTO-PAGE DESCRIPTOR WORD		/A042

	JMP	RPINEX	/EXIT


RPCNT,	TAD	ONE	/TEST FOR # OF PAGES IN STX BUFFER		/M025
	SZA 		/SKIP TO PASS THE # OF PAGES IN THE STX BUFFER
	JMP	RPTOP	/MAY BE REQUEST FOR ORIGONAL SCTOP & HDR ID#
/
/  AC was -2.....
/
	TAD	SCTOP	/SAVE POINTER TO CURRENT TOP BLOCK
	DCA	EDTOPS	/AT START OF TOTAL PAGE CALCULATION		/M041
	TAD	SCBOT	/AND CURRENT BOTTOM BLOCK POINTER
	DCA	EDBOTS							/M041
	TAD	SCTPH	/SAVE CURRENT 'TOP' HDR ID			/A020
	DCA	EDHDR							/A020
	TAD	SCBTH	/SAVE CURRENT 'BOTTOM' HDR ID			/A020
	DCA	EDHDR1							/A020
	TAD	SCHDBN	/SAVE CURRENT HDR BLK # THAT'S IN CORE		/A020
	DCA	EDSCBK							/A020

/ set-up to enable read of successive descriptor words, 		/A009
/ starting with the 1st descriptor of the 1st RPPGDS block..		/A009

	TAD	(52	/						/A009
	DCA	SCTOP	/INIT'D VALUE					/A009
	TAD	(53	/						/A009
	DCA	SCBOT	/INIT'D VALUE					/A009
	AC0001		/						/A009
	DCA	SCTPH	/1ST HEADER BLOCK ID #				/A009

	TAD	STXMOD+2	/SUPPLY THE # OF PAGE IN STX BUFFER	/A018
	JMP	RPINEX	/EXIT

/ THE FOLLOWING BLOCK IS ALL SCRAMBLED, SO I'M JUST DELETING IT		/A042
/ AND REWRITING IT (RATHER THAN ATTEMPTING TO MODIFY IT IN PLACE)	/A042

/D042 / the EDITOR wants to know when a new block has been read;	/A013
/D042 /  so that it knows it has written the previous block into	/A013
/D042 /  the edit buffer....						/A013
/D042 /  AC was - 5.......
/D042
/D042 RPBOT,	TAD	SCBOT	/AC = CURRENT SCBOT			/A013
/D042 	JMP	RPINEX	/RETURN TO CALLER				/A013
/D042
/D042 RPPTRS,	TAD	TWO	/TEST FOR SCBOT CONTENTS		/A013/M025
/D042 	SNA CLA		/SKIP IF NOT					/A013
/D042 	JMP	RPBOT	/JUMP TO SUPPLY SCBOT				/A013
/D042
/D042 /AC was -4.......
/D042
/D042 	TAD	EDBOTS	/GET ORIG. SCBOT				/M041
/D042 	DCA	SCBOT	/BACK FOR EDITOR
/D042 	TAD	EDTOPS	/SAVED SCTOP					/M041
/D042 	JMS	RPTRS1	/
/D042
/D042 RPINEX,	JMP I RPINIT	/EXIT:  RETURN TO CALLER


RPTOP,	IAC			/INCR. MINUS AC				/A042
	SZA			/SKIP IF EDITOR REQUEST FOR SCTOP	/A042
	JMP	RPPTRS		/JUMP IF NOT				/A042
									/A042
/									/A042
/ AC was -3.......							/A042
/									/A042
/	ON ENTRY:	MQ = pointer to caller's save area to		/A042
/			     pass the current SCTOP and HDR ID #	/A042
/									/A042
/	ON EXIT:	MQ = HDR ID # at START of relative page		/A042
/			     request					/A042
/									/A042
/			AC = SCTOP at START of relative page		/A042
/			     request					/A042
/									/A042
/			The CURRENT SCTOP and HDR ID # (SCTPH)		/A042
/			     are in the caller's data field		/A042
									/A042
/D042	TAD	SCTOP		/CURRENT TOP POINTER			/A042
/D042	SWP			/MQ = CURRENT TOP			/A042
	ACL			/AC = POINTER TO CALLERS SAVE AREA	/A042
	DCA	X0		/PTR TO SAVE AREA INTO X0		/A042
	TAD	SCTPH		/CURRENT HDR ID #			/A042
	CDFLP			/FIELD 5				/A042
	DCA I	X0		/SAVE CURRENT HDR ID #			/A042
/D042	ACL			/RETRIEVE CURRENT TOP POINTER		/A042
RRAER1,	IFNZRO SCTOP&7600 < ? >	/SCTOP MUST BE ON PAGE 0		/A042
				/OTHERWISE A CDFMYF IS NEEDED HERE	/A042
	TAD	SCTOP		/RETRIEVE CURRENT TOP POINTER		/A042
	DCA I	X0		/TO SAVE FOR COMPARE			/A042
	CDFMYF			/FIELD 7				/A042
									/A042
	TAD	EDHDR		/ORIG. HEADER ID #			/A042
	MQL			/INTO THE MQ				/A042
	TAD	EDTOPS		/ORIG. SCTOP				/A042
	JMP	RPINEX		/RETURN TO CALLER			/A042
									/A042
RPPTRS,	TAD	TWO							/A042
	/								/A042
	/ AC=+1 == AC WAS -4						/A042
	/ AC=0  == AC WAS -5						/A042
	/ AC=-1 == AC WAS -6						/A042
	/								/A042
	SNA								/A042
	 JMP	RPBOT	/AC WAS = -5					/A042
	SPA CLA								/A042
	 JMP	RPDSIN	/AC WAS = -6					/A042
/									/A042
/AC was -4.......							/A042
/									/A042
	TAD	EDBOTS	/GET ORIG. SCBOT				/A042
	DCA	SCBOT	/BACK FOR EDITOR				/A042
	TAD	EDTOPS	/SAVED SCTOP					/A042
	JMS	RPTRS1	/						/A042
									/A042
RPINEX,	JMP I RPINIT	/EXIT:  RETURN TO CALLER			/A042
									/A042
/									/A042
/ AC was -5 ...								/A042
/									/A042
/  the EDITOR wants to know when a new block has been read;		/A042
/  so that it knows it has written the previous block into		/A042
/  the edit buffer....							/A042
/									/A042
RPBOT,	TAD	SCBTH	/MQ = CURRENT SCBTH				/A042
	MQL								/A042
	TAD	SCBOT	/AC = CURRENT SCBOT				/A042
	JMP	RPINEX	/RETURN TO CALLER				/A042
									/A042
/									/A042
/ AC WAS = -6 ...							/A042
/									/A042
/ READ GOTO-PAGE DESCRIPTOR WORD DEFINED BY SCTOP,SCTPH;		/A042
/ THEN INCREMENT SCTOP,SCTPH BY CONTENTS OF MQ AT ENTRY.		/A042
/									/A042
RPDSIN,	ACL		/GET INCREMENT FOR SCTOP,SCTPH			/A042
	DCA	RPTPIN	/SAVE POST INCREMENT FOR SCTOP,SCTPH		/A042
	JMS	RPTPDS	/GET G-T-P TOP DESCRIPTOR WORD			/A042
	DCA	RPTPDS	/SAVE DESCRIPTOR WORD				/A042
	JMS	SCTOPP	/INCREMENT TOP POINTERS (SCTOP,SCTPH)		/A042
RPTPIN,	 .-.		/  AMOUNT TO INCREMENT (-1,0, OR +1)		/A042
	TAD	RPTPDS	/ GET ORIGINAL G-T-P DESCRIPTOR WORD		/A042
	JMP	RPINEX	/EXIT						/A042

/	if Go To page request FLaG is NOT set
/	then
/		return to caller
/	else
/		reset GTFLG
/		get pointer to appropriate descriptor
/		get the descriptor
/		retrieve the mode of the first character in the block
/		save in:  ETXMOD
/		          ETXMOD+1
/		          STXMOD
/		          STXMOD+1
/
/
RPRD1,	XX
	TAD	GTFLG		/GET THE GOTO PAGE REQUEST FLAG
	SNA			/SKIP IF G-T-P REQUEST		/M030
	JMP	RPRDEN		/EXIT
	SPA CLA			/SKIP IF GETTING ETX		/A030
	JMP	RPCLHLD		/JUMP IF GETTING STX		/A030

	TAD	(3600		/MASK TO EXTRACT MODE BITS
	AND	RPPTR1		/MASK WITH CURRENT DESC WORD		/M030
	DCA	ETXMOD		/STORE FOR LATER USE
	TAD	ETXMOD		/RETRIEVE MODE
	DCA	STXMOD		/FOR USE WHEN SCROLLING UP

	TAD	T40		/MASK TO EXTRACT SHIFT/UNSHIFT BIT
	AND	RPPTR1		/AC = SHIFT/UNSHIFT			/M030
	DCA	ETXMOD+1	/SAVE
	TAD	ETXMOD+1	/RETRIEVE
	DCA	STXMOD+1	/AND SAVE FOR SCROLL UP

	AC0100			/MASK FOR ACTIVE-CONTROL AREA		/A030
	AND	RPPTR1		/TO CURRENT DESC. WORD			/A030
	DCA	RPPCTLFL	/UPDATE FLAG ACCORDING TO BLOCK READ	/A030

RPCLHLD,TAD	(3640		/MASK TO EXTRACT MODE			/A030
	AND	RPPTR1		/FROM CURRENT DESC.			/A030
	DCA	HLDMOD		/FOR NEXT STX BLOCK TO BE WRITTEN	/A030
	DCA	GTFLG		/CLEAR G-T-P ACTIVE FLAG		/A030
RPRDEN,	JMP I	RPRD1		/RETURN TO CALLER

/D030 RPRD3,	.-.			/TEMP.
/D030 RPRD4,	.-.			/TEMP.

/ THIS BLOCK IS NEEDLESSLY AND CONFUSINGLY OUT OF SEQUENCE,		/A042
/ AND IT ALSO WASTES WORDS, SO I'M REWRITING IT AND MOVING IT		/A042
/ TO WHERE IT LOGICALLY BELONGS (WHY WASN'T IT THERE TO BEGIN WITH??)	/A042

/D042 RPTOP,	TAD	ONE		/INCR. MINUS AC			/M025
/D042 	SZA			/SKIP IF EDITOR REQUEST FOR SCTOP
/D042 	JMP	RPPTRS		/JUMP IF NOT
/D042
/D042 / AC was -3.......
/D042
/D042 /	ON ENTRY:	MQ = pointer to caller's save area to
/D042 /			     pass the current SCTOP and HDR ID #
/D042 /
/D042 /	ON EXIT:	MQ = HDR ID # at START of relative page
/D042 /			     request
/D042 /
/D042 /			AC = SCTOP at START of relative page
/D042 /			     request
/D042 /
/D042 /			The CURRENT SCTOP and HDR ID # (SCTPH)
/D042 /			     are in the caller's data field
/D042
/D042 	TAD	SCTOP		/CURRENT TOP POINTER			/A026
/D042 	SWP			/MQ = CURRENT TOP			/A030
/D042 				/AC = POINTER TO CALLERS SAVE AREA	/A030
/D042 	DCA	X0		/PTR TO SAVE AREA INTO X0
/D042 	TAD	SCTPH		/CURRENT HDR ID #			/A026
/D042 	CDFLP			/FIELD 5				/A026
/D042 	DCA I	X0		/SAVE CURRENT HDR ID #			/A026
/D042 	ACL			/RETRIEVE CURRENT TOP POINTER		/A026
/D042 	DCA I	X0		/TO SAVE FOR COMPARE			/A026
/D042 	CDFMYF			/FIELD 7				/A026
/D042
/D042 	TAD	EDHDR		/ORIG. HEADER ID #			/A009
/D042 	MQL			/INTO THE MQ				/A009
/D042 	TAD	EDTOPS		/ORIG. SCTOP				/M041
/D042 	JMP	RPINEX		/RETURN TO CALLER			/A009


/---------------
	PAGE



