SUBROUTINE LRPSUB
C
C
C	PETER LEMKIN, GERSON GROSFELD
C	NATIONAL CANCER INSTITUTE, DCBD, IPU
C	NATIONAL INSTITUTES OF HEALTH
C	BETHESDA, MD 20014
C
C	OCTOBER 13, 1975
C	REWRITTEN NOVEMBER 6, 1975	G. GROSFELD
C	REVISED NOVEMBER 10, 1975	G. GROSFELD
C	REVISED NOVEMBER 11, 1975	G. GROSFELD
C	REVISED NOVEMBER 17, 1975	G. GROSFELD
C	REVISED NOVEMBER 18, 1975	G. GROSFELD
C	REVISED NOVEMBER 20, 1975	G. GROSFELD
C	REVISED NOVEMBER 21, 1975	G. GROSFELD
C	REVISED FEBRUARY 20, 1976	G. GROSFELD
C	REVISED MARCH 4, 1976		G. GROSFELD
C	REVISED APRIL 14, 1976		G. GROSFELD
C	REVISED MAY 12, 1976		G. GROSFELD
C	REVISED MAY 18, 1976		G. GROSFELD
C
C
C
	COMMON INHAND,ISTBLK,IBLOCK,IBEGIN,IEND,IBUF,ISW,PNAME
	DIMENSION IBUF(256),ISW(36),PNAME(2)
C
	DIMENSION IA(136)
C
C
S	OPDEF BSW 7002
S	OPDEF MQL 7421
S	OPDEF MQA 7501
C
C
C
C	SET UP SWITCHES LOCALLY FROM COMMON
	ISWF=ISW(6)
	ISWI=ISW(9)
	ISWN=ISW(14)
	ISWP=ISW(16)
	ISWS=ISW(19)
C
C
C
CC	RESET COUNTERS
	ICOUNT=384
	KPAGE=1
	FLINE=0.0
	LPAGE=0
	LISTSW=0
	IFFWAIT=100
	JPAGE=0
C
C
C
C
C
	IEOF=0
	IW1=0
	IW2=0
	IW3=0
	KFF=0
C	THESE VALUES GIVE THE PAGE SIZE FOR THE LP08 PRINTER AND DECWRITER
C	ANOTHER DEVICE MAY REQUIRE A DIFFERENT PAGE SIZE (# LINE/PAGE)
	ISPACE=0
	IPAGESIZE=55
	IEXTRACRLFS=8
S	TAD (4040
S	DCA \ISPACE
C
C
S	JMS DATE
C
S	TAD \ISWP	/PAGE SWITCH ON?
S	SZA CLA		/SKIP IF NOT
S	JMS PAGER
C
S	TAD \LISTSW
S	SZA CLA
S	JMP \10
C
C
S	JMS NULLS
	WRITE(4,987)PNAME,IMO,IDAY,IYR,KPAGE
C
C
C
C	  LINE READ AND PROCESS LOOP 
C---------------------------------------------------------------------
C
C
10	CONTINUE
	LPAGE=LPAGE+1
	FLINE=FLINE+1.0
	ISTARSW=0
S	INC \JPAGE
S	TAD \JPAGE
S	MQL /LOAD LINE REGISTER
S	CLA
C
C	RESET CHARACTER COUNTER/LINE
	N=0
C
C	RESET BUFFER POINTER
S	CLA CMA
S	TAD PIA /AUTO POINTER
S	DCA 16
C
C	GET CHARACTER LOOP
1111	CONTINUE
S 	JMS GETC
S	DCA 6
C
C
C		[10.1] TEST IEOF FLAG WHICH  IS SET BY GETC TO 
C		-1  ON SEEING A ^Z
		IF(IEOF)46,45,46
C
C		EOF DETECTED, CLOSE OUTPUT DEVICE BEFORE EXIT
46		IEXTRACRLF=IEXTRACRLF+1
S  		JMS FF /FINSIH OFF THE CURRENT PAGE
C
C
		RETURN
C
C
C		NO EOF DETECTED, CONTINUE.
S \45,		TAD 6
S		TAD (-215 /TEST FOR CR
S		SNA CLA
S		JMP YESCR
C
C		TEST FOR LF (THEN DO CRLF)
S		TAD (-212 /LF
S		TAD 6
S		SNA CLA
S		JMP NULLCR /LINES WITH NO CR
C
C
C			[10.1.1] TEST FOR FORM FEED, IF (FF AND /F)
C			THEN REPAGE WITH A HEADER
S			TAD 6
S			TAD (-214 /FF
S			SZA CLA
S			JMP TABCHK /NOT A FF, CONTINUE
C
C
C			[10.1.2] YES A FF, NOW CHECK IF NO /F
C			FLAG IS ON THEN TEST IF *LSON
			LPAGE=LPAGE-1
			FLINE=FLINE-1.
			IF(1-ISWF)47,1111,47
47			IF(KFF)10,99,10
C
C
C		[10.2] CHECK FOR TAB, THEN CONVERT TO SPACES
S TABCHK,	TAD 6
S	TAD (-211 /TAB
S	SZA CLA
S	JMP PUSHCHAR /NOT A TAB, GO PUSH IT
C
C
C		[10.2.1] A TAB, MAP IT INTO
C		  (8-REMAINDER(N/8)) SPACES
S		TAD \N
S		CLL RAR /DIVIDE BY 8
S		CLL RAR
S		CLL RAR
S		CLL RTL
S		RAL /MULTIPLY BY 8
S		CIA /N-(N/8)*8
S		TAD \N /GET REMAINDER
S		CIA /NEGATE THE REMAINDER
S		TAD (10 /8
S		SNA /TEST IF NONE THEN ADD 8
S		TAD (10
S		DCA \NSPACES
C
C
C		[10.2.2] RESTORE THE LINE COUNTER IN THE MQ DISPLAY
S		TAD \JPAGE
S		MQL
S		CLA
C
C
C		[10.2.3] PUSH THE REQUIRED NUMBER OF SPACES
		DO 222 M=1,NSPACES
S		INC \N
S		NOP
S		TAD (240 /SPACE
S		DCA I 16 /PUSH INTO IA(.)
222		CONTINUE
		GOTO 1111
C
C
C
C	[10.3] PUSH CHAR ON IA
S PUSHCHAR,	TAD 6
S	DCA I 16
S	INC \N
S	NOP
C
C
C
C		[10.3.1] IF NO "/I" THEN CHECK FOR *, AND SAVE
C		SET PTR TO N.
		IF(ISWI)1111,1112,1111
S\1112,		TAD 6
S		TAD (-"*
S		SZA CLA
S		JMP \1111
C		YES, SAVE THE VALUE OF N
		ISTARSW=N
		GOTO 1111
C
C
C		[10.3.2] GET THE LF AFTER CR AND IGNORE IT.
C		TRASH THE LF AFTER THE CR
S YESCR,	JMS GETC
S		CLA
C
C
C		[10.3.3] CHECK FOR NULL LINE
S NULLCR, NOP
C
C
C	[10.4] CHECK FOR *LSON, *LSOF - EDITING SWITCHES IN
C	THE INPUT TEXT.
C	IF PTR("*") >0 THEN LOOK FOR SWITCHES ELSE CONTINUE.
	IF(ISTARSW)52,52,521
C
C
C		[10.4.1] LOOK AHEAD 4 SYMBOLS THEN PATTERN MATCH
521		IL=IA(ISTARSW+1)
		IS=IA(ISTARSW+2)
		IO=IA(ISTARSW+3)
		IOPR=IA(ISTARSW+4)
S		TAD \IL
S		TAD (-"L
S		SZA CLA
S		JMP \52 /NO
S		TAD \IS
S		TAD (-"S
S		SZA CLA
S		JMP \52
S		TAD \IO
S		TAD (-"O
S		SZA CLA
S		JMP \52
C
C
C	[10.4.2] PRE-PATTERN "*LSO" FOUND, NOW
C		TEST FOR "N" OR "F" AND TURN LISTING ON OR OFF
C		IF FOUND.
S		TAD \IOPR
S		TAD (-"N
S		SZA CLA
S		JMP CHKF /NOT  *LSON
C
C		YES, RESTORE THE LIST SWITCH AS TRUE
		LISTSW=0
S REPAGE,		JMS FF /REPAGINATE NOW
		LPAGE=IPAGESIZE
		GOTO 53
C
C		CHECK FOR *LSOF
S CHKF,		TAD \IOPR
S		TAD (-"F
S		SZA CLA
S		JMP \52 /NOT A *LSOF
		LISTSW=-1
C		PRINT THE *LSOF AS THE LAST THING PRINTED
		GOTO 522
C
C
C
C	[10.5]TEST IF PRINT THE LINE.
52	IF(LISTSW)53,522,53
C
C
C		[10.5.1] YES, PRINT LINE - TEST IF "/N" TO NOT
C		PRINT LINE NUMBERS.
522	KFF=0
		IF(ISWN)523,1522,523
C
C
C		[10.5.2] PRINT LINE NUMBERS, TEST IF THE 1ST LINE 
C		OF A NEW PAGE, PRINT AN EXTRA LEADING SPACE
C		ON PRINTING THE LINE NUMBERS.
1522		WRITE(4,197)FLINE,ISPACE,
197		FORMAT(1X,F6.0,A2)
C
C
C	[10.6] PRINT THE LINE "IA[1:N]&CRLF;
523	DO 543 I=1,N
S	CLA CMA
S	TAD \I
S	TAD PIA
S	DCA 6
S	TAD I 6
S	JMS OUT /PRINT IT
543	CONTINUE
C
S CRLF,	TAD (215
S	JMS OUT
S	TAD (212
S	JMS OUT
C
C
C	[10.7] TEST IF  PAGINATE
53	IF(LPAGE-IPAGESIZE)10,99,99
C
C	PRINT THE PAGE # AS  WELL
99	KPAGE=KPAGE+1
C
S	TAD \ISWP	/PAGE SWITCH ON?
S	SZA CLA		/IF NOT, SKIP NEXT INSTRUCTION
S	JMS PAGER
C
C
	IF(IEOF)46,535,46
S \535, JMS FF
S	TAD \LISTSW	/SEE IF PRINTING DISABLED
S	SZA CLA		/SKIP IF NOT
S	JMP \10		/NOT YET, DON'T PRINT HEADER
S	JMS NULLS
	WRITE(4,987)PNAME,IMO,IDAY,IYR,KPAGE
987	FORMAT(6X,A6,'.',A2,15X,I2,'/',I2,'/7',I1,20X,'PAGE ',I4,//)
C	DONE WITH PAGE, CONTINUE READ-PRINT-LOOP , GOTO [10];
	GOTO 10
C
C
C	POINTERS
C	--------
S PIBUF,\IBUF		/INPUT BUFFER IN COMMON
S PIA,\IA		/LINE BUFFER
C
C
C	***************************
C	***SUBROUTINE O U T   ***
C	***************************
C	SEND A CHARACTER ON THE SELECTED I/O DEVICE
C	THE I/O DEVICE IS DEFINED AT SETUP TIME.
S	CPAGE 24
S OUT,  0
S OUT1,	AND (0377
S	TAD (1400	/SET UP OUTPUT CHANNEL
S	DCA HOLDER
S	TAD \LISTSW	/SEE IF PRINT-DISABLED
S	SZA CLA		/SKIP IF NOT
S	JMP I OUT	/NO PRINTING; RETURN
S	TAD HOLDER	/LOAD OUTPUT
S	CALL 0,GENIO
S	CLA
C
C	CHECK FOR CONTROL/C
S	KSF
S	JMP I OUT
S	KRB
S	AND (177
S	TAD (-003
S	SZA CLA
S	JMP I OUT
	CALL EXIT
C
S HOLDER,0000	/STORAGE LOCATION
C
C
C
C	*******************
C	***SUBROUTINE FF***
C	*******************
C	OUTPUT  A FORM FEED AND WAIT
S	CPAGE 3
S RFF, JMP I FF
S FF,	0 /ENTRY
S	CLA
S	TAD \ISWS /TEST IF /S
S	SNA CLA
S	JMP FFF /NO - DO THE REAL THING
C
C	SIMULATE A FF WITH CRLF'S
	NCRLF=(IPAGESIZE-LPAGE)+IEXTRACRLFS
C
	DO 1414 IDOCRLF=1,NCRLF
S	TAD (215
S	JMS OUT
S	TAD (212 
S	JMS OUT
1414	CONTINUE
	LPAGE=0
	KFF=1
S	JMP RFF /RETURN
C
S FFF,	TAD (214 /DO A FORM FEED
S	JMS OUT
	LPAGE=0
	KFF=1
S	JMP RFF
C
C
C
C
C	********************
C	****SUBROUTINE R****
C	********************
C	READ  THE NEXT BLOCK INTO COMMON ARRAY IBUF(256)
C	THE CURRENT BLOCK # IN IN IBLOCK. THE STARTING BLOCK
C	NUMBER WAS DEFINED AT SETDEV IN \ISTBLK.
C
C       R.1 READ ONE BLOCK FROM THE FILE INTO IBUF.
S	CPAGE 3
S RR,	JMP I R
S R,	0 /ENTRY
C
C	GET BLOCK ADDRESS
S	CLA
S	TAD \ISTBLK
S	DCA \KKK
	IBN=KKK+IBLOCK-1
C
S	TAD PIBUF
S       DCA CARG2
C
S       TAD \IBN  /START BLOCK NO.
S       DCA CARG3
S       TAD \INHAND / DSK ENTRY POINT
S       DCA 6
C
S       CLA
S       CPAGE 6
S       6202 /CIF 00 /HANDLER IN FIELD 0
S       JMS I 6
SCARG1,	0210 /FUNCTION WORD. ONE BLOCK READ.
SCARG2, 0
SCARG3, 0
S	JMP \511 /ERROR
C
C	INCREMENT FOR NEXT TIME
	IBLOCK=IBLOCK+1
S	JMP RR
C
C
C
C       R.2 DATA READ ERROR.
S\511,	CLA
	WRITE(1,512)PNAME,IBLOCK
512     FORMAT('READ ERROR - FILE: ',A6,'.',A2,', BLOCK#=',I5)
	CALL EXIT
C
C       ***************
C       SUBROUTINE GETC
C       ***************
C
C	GET THE NEXT INPUT CHARACTER.
C	GETS A NEW INPUT BUFFER WHEN NEEDED. GETS AND TESTS EACH
C	CHARACTER FOR CONTROL/Z (SETS FLAG IF FOUND) THEN RETURNS
C	THE CHARACTER IN THE AC.
S	CPAGE 3
S RGETC,	JMP I GETC
S GETC,	0
	IF(ICOUNT-384)800,801,801
S\801,	JMS R /GET NEW BUFFER
	ICOUNT=0
	KOUNT=-3
C
C	SET UP THE I/O BUFFER AUTOINDEX POINTER
S	CLA CMA /-1
S	TAD PIBUF /IBUF IN COMMON
S	DCA 15
C
C	INCREMENT THE CHARACTER COUNTER
C	THE FOLLOWING IS FALL THROUGH CODE TO DECODE THE INPUT BUFFER
800	ICOUNT=ICOUNT+1
C	GET NEXT BYTE
S	ISZ \KOUNT
S	JMP W1W2 /NOT W3
C	YES W3, RESET KOUNT
	KOUNT=-3
C
C	MAKE W3 FROM W1, W2
S	TAD \IW1
S	RTR
S	RTR
S	AND (0360
S	DCA \IW3
S	TAD \IW2
S	RTL
S	RTL
S	RAL
S	AND (0017
S	TAD \IW3
S	DCA \IW3
S	TAD \IW3
S	JMP TESTZ
C
C	IT WAS W1 OR W2
SW1W2,	TAD \KOUNT
S	TAD (1 /WILL BE 2 FOR W1
S	SZA CLA
S	JMP DOW1 /DO W1
C
C	STORE IN W2
S	TAD I 15
S	DCA \IW2
S	TAD \IW2
S	JMP TESTZ
C
C	STORE IN W1
S DOW1,	TAD I 15
S	DCA \IW1
S	TAD \IW1
C
C	TEST IF CONTROL/Z
S TESTZ,	AND (0377
C
S	TAD (-232 /CONTROL /Z
S	SNA
S	JMP \804 /YES
S	TAD (232 /NO
S	JMP RGETC
804	IEOF=-1
S	JMP RGETC
C
C	************************
C	****SUBROUTINE DATE*****
C	************************
C	RETURNS THE  OS/8 WORD  IN INTEGER  FORMAT.
C	THIS ROUTINE WAS BORROWED FROM THE OS/8 SYSTEM
C	SUPPORT MANUAL.
C
C
C	ARGUMENTS
C	----------
C	1. IMO -  THE MONTH AS AN INTEGER 0 TO  12 DECIMAL
C	2. IDAY - THE DAY AS AN INTEGER FROM 0 TO 31 DECIMAL
C	3. IYR -  THE YEAR AS AN INTEGER 0 TO  9.
C
S	CPAGE 3
S RDATE,	JMP I DATE
S DATE,	0	/ENTRY
	IYR=0
	IDAY=0
	IMO=0
S	TAD I (7666
S	DCA 6 /TEMPORARY STORAGE
S	TAD 6 /TEMPORARY STORAGE
S	AND (7
S	DCA	\IYR
S	TAD 6 /TEMPORARY STORAGE
S	RAR;RTR
S	AND (37
S	DCA \IDAY
S	TAD 6 /TEMPORARY STORAGE
S	RAL;RTL;RTL
S	AND (17
S	DCA \IMO
C
C	IF IYR=0
C		THEN IYR=8
S	TAD \IYR
S	SNA
S	TAD (D8
S	DCA \IYR
C
C
S	JMP RDATE
C	****************
C	SUBROUTINE NULLS
C	****************
C
C	THIS SUBROUTINE PRINTS NULLS (SPACES) WITHOUT A
C	LINE FEED TO ACT AS FILL CHARACTERS FOLLOWING A
C	FORM FEED TO PROTECT THE PAGE HEADER WHICH IS
C	SOMETIMES LOST AFTER FULL-PAGE FORM FEEDS.
C
C
S	CPAGE 3
S RNULLS,JMP I NULLS
S NULLS, 0000		/ENTRY
C
	DO 650 I=1,3
	DO 625 J=1,65
S	CLA		/NULL CHARACTER 000
S	JMS OUT		/PRINT IT OUT
625	CONTINUE
S	TAD (215	/CARRIAGE RETURN (NO LINE FEED)
S	JMS OUT		/SEND IT OUT
650	CONTINUE
C
S	JMP RNULLS
C
C
C

C	****************
C	SUBROUTINE PAGER
C	****************
C
C	TEMPORARY ROUTINE TO FACILITATE SPECIFIC PAGE PRINTINT
C
C	G. GROSFELD  11/17/75
C
C	(TO BE DONE PROPERLY AT SOME FUTURE DATE)
C
S	CPAGE 3
S RPAGER,JMP I PAGER
S PAGER,0000		/ENTRY
S	CLA
S	TAD \IBEGIN 	/GET FIRST PAGE DESIRED
S	CIA		/NEGATE
S	TAD \KPAGE	/ADD CURRENT PAGE NUMBER
S	SPC		/IF RESULT >=0, THEN OK
S	JMP IDLE	/ELSE NOT
S	TAD \KPAGE	/GET CURRENT PAGE AGAIN
S	CIA		/NEGATE
S	TAD \IEND	/ADD LAST PAGE DESIRED (FROM COMMON)
S	SPC		/IF RESULT>=0 THEN OK
S IDLE,	IAC		/ELSE, SET UP NON-PRINT SWITCH
S	DCA \LISTSW
S	JMP RPAGER	/RETURN
C
C
C
	END