C	PROGRAM HELP.FT
C	----------------
C
C	PETER LEMKIN
C	IMAGE PROCESSING UNIT, DCBD
C	NATIONAL CANCER INSTITUTE
C	NATIONAL INSTITUTES OF HEALTH
C	9000 ROCKVILLE PIKE
C	BETHESDA, MD. 20014
C
C	FEB 9, 1977
C	JAN 21, 1977
C	JAN 20, 1977
C	JAN 19, 1977
C
C
C	INTRODUCTION
C	------------
C	HELP.FT IS A CHAINED PROGRAM USED WITH BMON2
C	IT RECEIVES ITS ARGUMENTS FROM THE CD AREA AND THE IBM1,IHGH1
C	IBM2,IHGH2, JBM, JHGH  VARIABLES IN COMMON. COMMON IS RESTORED
C	FIRST BEFORE THE FUNCTION (TO BE INSERTED INTO THE BODY) IS
C	EVALUATED. AFTER THE FUNCTION IS PERFORMED, COMMON
C	IS SAVED AND BMON2 IS CHAINED BACK TO.
C	ANY COMPUTATIONS ARE DONE, THE ARGUMENTS ARE THEN CHECKED
C
C	HELP SEARCHES BMON2.HL ON THE SYS: AND IF NOT FOUND ON THE
C	SYS: THEN ON DSKB: AND IF NOT FOUND OF DSKB: THEN SEARCHES
C	FOR DSKB:BMON2P.PU BEFORE GIVING UP.
C	A SPECIFIC COMMAND MAY BE SPECIFIED IN WHICH
C	CASE IT WILL SEARCH FOR IT AND DUMP ONLY THE TEXT
C	FROM THE START OF THE COMMAND (SYNTAX
C	CRLF&<NUMBER>. ... <COMMAND>.....
C		to
C	CRLF&<NUMBER>.
C
C	IF NO COMMAND IS SPECIFIED, THEN THE ENTIRE HELP FILE
C	IS DUMPED.
C	AND THEN DUMPS IT ON THE LPT OR TTY.
C
C	THE /L SWITCH ALSO CAUSES THE OUTPUT TO BE DUMPED ON THE PHYSICAL LPT:.
C
C	THE /C SWITCH CAUSES THE FIRST LINE OF ALL
C	<LF><DIGIT> COMBINATIONS TO BE PRINTED.
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF	LLS	6666
S	SKPDF	LSF	6661
	DIMENSION ISYM(6)
C
C	[1] INITIALIZATION
	ITABCNT=-8
	LSUCLASS=ISW(3)
	ICHAR=0
	JCHAR=0
	WRITE(1,995)
995	FORMAT('HELP 2/9/77 - 4:01PM')
	FC=TIMER(0)
C
C	DUMP ON LPT: IF /L SWITCH
	IOUTSPOOL=ISW(12)
C
C
C	[2] VERIFY COMMAND SPECS
C
C@C	***** FOR DEBUGGING****
C@	READ(1,123)(KINFILE(J),J=5,7)
C@123	FORMAT(' SEARCH FOR?=',3A2)
C@	IOUTSPOOL=0
C@C	************************
C
C
C	CVT 6-BIT TO 8-BIT
	L=1
	DO 122 I=1,3
	K=KINFILE(4+I)
S	TAD \K
S	BSW
S	AND (0077
S	TAD (-40
S	SPA
S	TAD (100 /A:Z
S	TAD (240
S	DCA \J
	ISYM(L)=J
	L=L+1
S	TAD \K
S	AND (0077
S	TAD (-40
S	SPA
S	TAD (100 /A:Z
S	TAD (240
S	DCA \J
	ISYM(L)=J
122	L=L+1
C
C
C	SET DUMP ALL SWITCH
	IDMPSW=0
	IDMPALL=ISYM
C
C
C	[3] HELP
C	PRINT THE BMON2.HL HELP FILE ON THE TTY:
C	SET SWITCH TO USE "BMON2.HL" IF IT EXISTS
	LSPUB=0
	IF(IO('SYS','BMON2','HL',1))150,203,150
150	IF(IO('DSKB','BMON2','HL',1))151,203,151
C
C	NO "BMON2.HL" SET SWITCH TO USE "BMON2H.PUB" IF IT EXISTS
151	LSUPA=1
	IF(IO('DSKB','BMON2H','PU',1))201,203,201
C
C		FAILED!
201	CONTINUE
	WRITE(1,202)
202	FORMAT(' SYS: OR DSKB: BMON2.HL NOT FOUND!')
	GOTO 998
C
C
C		SUCCEEDED!
C	READ-PRINT -LOOP
203	CONTINUE
S	JMS GETCHAR
S	DCA \ICHAR
C
C	IF /C OR SYMBOL=NULL
C		THEN PRINT IT,  GOTO [3.2]
S	TAD \LSUCLASS
S	TAD \ISYM
S	SNA CLA
S	JMP \400 /[3.2]
C
C
C	[3.1] NOT NULL, DO THE CONVOLUTON SEARCH FOR 
C		IF LSUPA 
C			THEN "LF&<DIGIT>" 
C			ELSE "LF&.S";
	IPTOP=0
C	IF ICHAR=LF
S	  TAD \ICHAR
S	  TAD (-212 /LF
S	  SZA CLA
S	  JMP \400 /NO, GO OUTPUT IT AT [3.2]
C		THEN
C		BEGIN "TEST IF DUMP ELSE EXIT"
S		  JMS GETCHAR /GET THE 2ND CHAR
S		  DCA \JCHAR
C		IF [LSUPA=0 AND ("0 LEQ JCHAR LEQ "9)] OR
C		   [LSUPA=1 AND JCHAR="."]
S		TAD \LSUPA
S		SZA CLA
S		JMP \338 /NOT ZERO

C		TEST FOR "<DIGIT>" FOR .HL FILE
S		  TAD \JCHAR
S		  TAD (-"0
S		  SPA CLA
S		  JMP \350 /NO 
S		  TAD \JCHAR
S		  TAD (-272 /"9+1
S		  SPA CLA
S		  JMP \337 /SUCCEEDED!
S		  JMP \350 /NO
C
C		  TEST IF "." FOR .PU FILE
S \338,		  TAD \JCHAR
S		  TAD (-".
S		  SZA CLA
S		  JMP \350 /FAILED
C		  TEST FOR "S"
S		  JMS GETCHAR
S		  DCA \KCHAR
S		  TAD \KCHAR
S		  TAD (-"S
S		  SZA CLA
S		  JMP \350 /FAILED
C
C
C			THEN
C			BEGIN "TEST IF TURN IT ON OR OFF"
C			IF IDMPSW=FALSE
337			IF(IDMPSW)330,310,330
C				THEN
C				BEGIN "CONVOLVE TO TURN IT ON"
310				CONTINUE
C				LINE<==(CRLF&JCHAR)&GETLINE TO CR;
C				PUSH (CRLF&JCHAR)
S				TAD (215 /CR
S				DCA \IBUF1
S				TAD \ICHAR /LF
S				DCA \IBUF1#
				IBUF1(3)=JCHAR
				IPTOP=3
C
C				IF LSUPA=1
C				  THEN
C				  IBUF1(IPTOP_IPTOP+1)_KCHAR
S				TAD \LSUPA
S				SNA CLA
S				JMP RDLINE /NO
				IPTOP=4
				IBUF1(IPTOP)=KCHAR
C
S RDLINE,			JMS GETCHAR
S				DCA \KCHAR
				IPTOP=IPTOP+1
				IBUF1(IPTOP)=KCHAR
S				TAD \KCHAR
S				TAD (-215 /CR?
S				SZA CLA
S				JMP RDLINE /NO
C				!! FALL THROUGH AFTER PUSH CR!!
C
C				IF <COMMAND>IN LINE[1 TO INF]
				DO 314 I=1,IPTOP
				DO 313 J=1,6
				KSYM=ISYM(J)
				IZ=IBUF1((I-1)+J)
C
C				IF KSYM="@" THEN QUIT
S				TAD \KSYM
S				TAD (-300 /-"@
S				SNA CLA
S				JMP \313 /OK, DONE.
C
315				IF(KSYM-IZ)314,313,314
C					THEN CONTINUE ELSE FAIL THIS SYMBOL;
313				CONTINUE
C				FALL THROUGH IF MADE IT
				GOTO 320
C
314				CONTINUE
C				FALL THROUGH IF FAILED.
				GOTO 203
C
C
C					THEN
C					BEGIN "FOUND IT"
320					CONTINUE
C					DUMPSWITCH<==TRUE;
					IDMPSW=1
C					OUTSTR(LINE);
					DO 321 I=1,IPTOP
					KCHAR=IBUF1(I)
S					TAD \KCHAR
S					JMS OUTCHAR
321					CONTINUE
C					IF /C 
C						THEN CLEAR FLAG;
					IF(LSUCLASS)322,203,322
322					IDMPSW=0
					GOTO 203
C					END "FOUND IT";
C				END "CONVOLVE TO TURN IT ON"
C
C				ELSE EXIT;
330				GOTO 998
C				END "TEST IF TURN IT ON OR OFF";
C
C		ELSE 
C		BEGIN "OUTSTR(LF&JCHAR)"
S\350,		TAD (212 /LF
S		JMS OUTCHAR
S		TAD \JCHAR
S		JMS OUTCHAR
		GOTO 203
C		END "OUTSTR(LF&JCHAR)"
C	END "TEST IF DUMP ELSE EXIT";
C
C
C	[3.2] IF (IDMPALL=0) OR (IDMPSW=TRUE)
C		THEN PRINT IT ELSE NOP;
400	CONTINUE
S	TAD \ICHAR
S	JMS OUTCHAR /IN THE AC
	GOTO 203
C
C
C	[999] RETURN
	GOTO 998
999	WRITE(1,996)
996	FORMAT('BAD HELP SPECIFICATION!')
998	FC=TIMER(1)
	CALL CHAIN('BMON2')
C
C
C
C
C	**********************************************
C	*SUBROUTINE O U T C H A R
C	**********************************************
C
C	OUTPUT CHAR IN THE AC
S	CPAGE 3
S ROUTCHAR,	JMP I OUTCHAR
S OUTCHAR,	0
C
S	DCA \IX2
C
C
C	IF (ITABCNT<==ITABCNT+1)=0   OR (IX2=ILF)
C		THEN ITABCNT<==-8;
S	ISZ \ITABCNT
S	SKP
S	JMP \500 /RESET TAB COUNT
C
	IF(IX2-ILF)501,500,501
500	ITABCNT=-8
C
C
C
501	CONTINUE
C	IF (IDMPALL=0) OR (IDMPSW=TRUE)
C		THEN PRINT IT ELSE NOP;
S	TAD \IDMPALL
S	SNA CLA
S	JMP PNTIT /PRINT IT
S	TAD \IDMPSW
S	SNA CLA
S	JMP ROUTCHAR /DO NOT PRINT IT
C
C	TEST IF WAIT OR EXIT
S	CPAGE 3
S PNTIT,	JMS TTYCTL
S	JMP \998
C
C	PRINT IT
	IOPTOP=1
S	TAD \IX2
S	TAD (-211 /TAB
S	SZA CLA
S	JMP \504 /NOT A SPACE, DO IT ONCE
C
	IOPTOP=-ITABCNT
	ITABCNT=-8
S	TAD (240
S	DCA \IX2
C
504	DO 502 IX=1,IOPTOP
S	TAD \IX2
S	TLS
S TW,	TSF
S	JMP TW
S	CLA
C
C	TEST IF USE LPT:
S	TAD \IOUTSPOOL
S	SNA CLA
S	JMP \502 /NO
S	TAD \IX2
S	LLS
S LW,	LSF
S	JMP LW
S	CLA
502	CONTINUE
C
S	JMP ROUTCHAR
C
	IX2=0
C
C	*********************************************
C	*SUBROUTINE  G E T C H A R
C	*********************************************
S	CPAGE 3
S RGETCHAR,	JMP I GETCHAR
S GETCHAR,	0 /ENTRY
C
S	CALL 0,INNC
S	AND (177
C	IF ^Z
C		THEN EXIT HELP.SV
S	TAD (-32 /^Z
S	SNA
S	JMP \998 /DONE
S	TAD (232
C
C	IF FF
C		THEN CHANGE TO LF
S	TAD (-214
S	SNA 
S	TAD (-2 /LF=FF-2
S	TAD (214
S	JMP RGETCHAR
C
C***************************************************
C	*PROCEDURE      C K O U T
C******************************************************
C
C
C	CHECK WHETHER THE OUTPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKOUT,	JMP I CKOUT
S CKOUT,	0 /ENTRY
C
C	[1] TEST IF KOUTFILE="BM"
S	TAD \KOUTFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (KOUTFILE(2) LAND '7700)=DIGIT
S	TAD \KOUTFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKOUT /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKIN,	JMP I CKIN
S CKIN,	0 /ENTRY
C
C	[1] TEST IF BMI1="BM"
S	TAD \SFILE
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[2] TEST IF (BMI1(2) LAND '7700)=DIGIT
S	TAD \SFILE#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKIN /OK.
C
C
C***************************************************
C	*PROCEDURE      C K I N 2
C******************************************************
C
C
C	CHECK WHETHER THE INPUT BM SPEC IS LEGAL ELSE GOTO 999.
S	CPAGE 3
SRCKIN2,	JMP I CKIN2
S CKIN2,	0 /ENTRY
C
C	[1] CHECK FIRST IBM1 SPEC
S	JMS CKIN
C
C
C	[2] TEST IF BMI2="BM"
S	TAD \SEXT
S	CIA
S	TAD BMTEXT
S	SZA CLA
S	JMP \999 /FAILED
C
C	[3] TEST IF (BMI2((6) LAND '7700)=DIGIT
S	TAD \SEXT#
S	BSW
S	AND (0077
S	TAD (-60 /"0"
S	SPA
S	JMP \999 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \999 /FAILED
S	JMP RCKIN2 /OK.
C
C
C	************************************************************
C	SUBROUTINE:	T T Y C T L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RTTYC,	JMP I TTYCTL
S TTYCTL,	0000	/ENTRY
C
S	KSF	/ANYTHING TYPED
S	JMP NORMAL	/NO, RETURN NORMALLY
S	KRB	/GET TYPED CHARACTER
S	AND (0177	/TAKE CARE OF PARITY PROBLEMS
S	TAD (-17	/TEST FOR CTRL/O
S	SNA	/SKIP IF NOT CTRL/O
S	JMP RTTYC	/ABORT CALLING ROUTINE (ERROR RETURN)
S	TAD (-4	/TEST FOR CTRL/S [-17-4=-23(OCTAL)]
S	SZA CLA	/SKIP IF CTRL/S
S	JMP NORMAL	/NOT CTRL/O OR CTRL/S SO RETURN NORMALLY
C
S SLEEP,KSF	/WAIT FOR CTRL/Q
S	JMP SLEEP	/KEEP WAITING
S	KRB	/READ CHARACTER
S	AND (0177
S	TAD (-17	/IS IT A CTRL/O?
S	SNA	/SKIP IF NOT
S	JMP RTTYC	/YES, ABORT
S	TAD (-2	/TEST FOR CTRL/Q (-17-2=-21 OCTAL)
S	SZA CLA	/SKIP IF SO
S	JMP SLEEP	/NOPE, KEEP SLEEPING
C
S NORMAL,INC TTYCTL	/INCREMENT RETURN ADDRESS FOR NORMAL RETURN
S	CLA	/SAFETY VALVE
S	JMP RTTYC	/RETURN
C************** P A R A M E T E R S *************
S BMTEXT,	TEXT /BM/
	END