C	PROGRAM BMON2.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	MAY 31, 1978 /CHANGE BMAX3 FOR SHOWHIST FN.
C	MAY 22, 1978 /CHANGE LAPLACIAN SO /A SWITCH
C	MAY 16, 1978 /CHANGE LAPLACIAN
C	DEC 6, 1977
C	NOV 22, 1977
C	NOV 14, 1977
C	NOV 8, 1977
C	NOV 7, 1977 /NEW BMIO AND CHANGES TO BMAXi PKGS
C	NOV 4, 1977
C	SEPT 2, 1977
C	JULY 26, 1977
C	JULY 11, 1977 /FIXED PARAMTERS /N AND LENS#
C	JUNE 16, 1977
C	JUNE 7, 1977 /CHANGED BMAP2 PUC COMP.
C	JUNE 2, 1977
C	MAY 27, 1977
C	MAY 26, 1977
C	MAY 23, 1977
C	MAY 20, 1977
C	MAY 4, 1977
C	APRIL 26, 1977
C	MARCH 31, 1977
C	MARCH 5, 1977
C	FEB 25, 1977
C	FEB 14, 1977
C	FEB 13, 1977
C	FEB 7, 1977
C	FEB 4, 1977
C	JAN 30, 1977 /FIXED NULL CMD
C	JAN 23, 1977
C	JAN 21, 1977
C	JAN 20, 1977
C	NOV 16, 1976
C	NOV 15, 1976
C	NOV 3, 1976
C	NOV 2, 1976
C	NOV 1, 1976
C	OCT 21, 1976
C	OCT 19, 1976
C	OCT 18, 1976
C	OCT 15, 1976
C	OCT 14, 1976
C	OCT 8, 1976
C	OCT 7, 1976
C	OCT 6, 1976
C	OCT 5, 1975
C	OCT 1, 1976
C	SEPT 30, 1976
C	SEPT 28, 1976
C	SEPT 23, 1976
C	SEPT 22, 1976
C	SEPT 20, 1976
C	SEPT 19, 1976
C	SEPT 17, 1976
C	SEPT 16, 1976
C	SEPT 15, 1976
C	SEPT 14, 1976
C	SEPT 13, 1976
C	SEPT 11, 1976
C	SEPT 10, 1976
C	SEPT 9, 1976
C	SEPT 8, 1976
C	SEPT 7, 1976
C	SEPT 3, 1976
C	SEPT 2, 1976
C	SEPT 1, 1976
C	AUG 31, 1976
C	AUG 30, 1976
C	AUG 28, 1976
C	AUG 27, 1976
C	AUG 26, 1976 - MODIFIED FROM BMON1
C
C
C
C	INTRODUCTION
C	------------
C	BMON2 is the DDTG chained program monitor for the Buffer
C	Memories on the RTPP. It services the teletype, stage, and
C	control desk command and frame and scale keys. Teletype
C	input is via the OS/8 command decoder which implies
C	that BMON2 may be run under OS8 BATCH.
C
C	The buffer memories may be posted, unposted, loaded with QMT
C	images and moved around the QMT screen. The buffer memory
C	data may be processed with the results of operations on the
C	memories being stored in the buffer memories. Some
C	of the support operations (QMT, READ, WRITE) are performed
C	by requesting that operation be performed by DDTG.
C
C	BMON2 is derived from an earlier buffer memory monitor
C	program called BMON1 by P. Lemkin and G. Grosfeld.
C
C	See BMON2.HL for documentation on using BMON2. See BMON2.BI
C	for the batch file to compile and build the system.
C
C	OPDEFS
C	------
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
S	OPDEF	QPROG2	6371
S	OPDEF	QPROG7	6433
C
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C       Analogue to Digital 16  channel  converter
C       (DEC  AD8-ea/AM8-ea)  with an input voltage
C       range of +/- 1 volt, 0-30 KHZ bandwidth, 10
C       bit resolution, 200 nsec. apperature time.
S       OPDEF ADCL 6530 /Clear AD done and timing error flags.
C                        Clear enable, mux and status register.
S       OPDEF ADLM 6531 /LOAD mux register from AC[8:11],
C                        clear AC.
S       OPDEF ADST 6532 /CLear AD done and timing error flags.
C                        Start AD converter. Channel to
C                        be converted is to be determined by
C                        mux register.
S       OPDEF ADRB 6533 /CLear AD done flag. Contents of
C                        AD buffer ==>ac[0:11].
S       SKPDF ADSK 6534 /SKIp next instruction if AD done=1.
C                        Do not clear flag.
C@S       SKPDF ADSE 6535 /Skip next instruction if 
C                       timing error=1.
C                        Do not clear flag.
C@S       OPDEF ADLE 6536 /LOad enable register from AC[2:5].
C@S       OPDEF ADRS 6537 /REAd AD status/enable register and
C                        mux into AC[0:11].
C
C       A/D Status register
C        Bit     function
C        ----    --------
C       0       Conversion done
C       1       error
C       2       done interrupt enable
C       3       error interrupt enable
C       4       external start enable
C       5       auto increment enable
C       6-7     not used
C       8-11    contents of mux register
C
C
C
C
C
	DIMENSION MM(3)
	EQUIVALENCE (FM,MM(1))
C
C	[0.0] INITIALIZE
S	KRB /CLEAR OUT THE BUFFER
S	CLA
C
C	CODE TO DEFINE THE DUMMY VARIABLE "BATCH" FOR BATCH MODE DET.
C
	WRITE(1,1999)
1999	FORMAT('BMON2 5/31/78 - 1:11PM. HELP FOR INFO.')
	K=0
	MEM=0
	IBYTE=0
C
C
C
C	[0.1] READ COMMON BACK INTO CORE
	CALL BSCOMMON(0)
C	TURN OFF THE DDTG "$EX" SWITCH
	INSPOOL=0
C
C	LOAD DETB,C FROM COMMON
	DO 1065 IY=7,8
	IA=MDPDATA(7,IY)
	I=IY-7
S	TAD \I
S	TAD (6420 /DETB
S	DCA LODET
S	TAD \IA
S LODET,	0 /DETB OR DETC
1065	CONTINUE
C
C	INIT THE SPOOLER IF ON ELSE RESET TO 0;
	KOUTFILE=0
C
S	CLA CMA
S	TAD \IOUTSPOOL
S	SZA CLA
S	JMP \99 /SET TO 1
C
C	OPENFILE
C	DO NOT DO OCLOSE SINCE NEVERED OOPENED
	IOUTSPOOL=0
	KOUTFILE=0
	IP=60
S	JMS BMSERVE
	GOTO 100
C
C	ZERO SPOOLER SW
99	IOUTSPOOL=0
	GOTO 100
C
C
C
S	DUMMY BATCH
S	CPAGE 2
S BATCH,	6201
S	7777
C
C
C
C	[0.2] BAD BM SPECIFICATION, IGNORE LAST COMMAND AND RESTART
S \199,	CLA
	WRITE(1,1001)
1001	FORMAT('? BM SPEC!')
C
C
C
C	[1] POLLING LOOP
100	CALL CLOCK
C	TURN OFF "PRINT CMD KEY ASSIGNMENT " SWITCH
	ISWTOP=0
C
C
C	[1.1] INITIALIZATION FOR EACH PASS OF LOOP
	IYLINE=-1000
C	NOTE: SFILE IS THE PRINT NAME OF BMI1 AND SEXT IS PRINT NAME OF BMI2
	SFILE=0
	SEXT=0
	IBM1=0
	IHGH1=0
	IBM2=0
	IHGH2=0
	JBM=0
	JHGH=0
	IP=0
S	6437 /LFBW2 /ZERO CMD LIGHTS
C
C
C	[1.2] CHECK FOR MOTOR SERVICE REQUEST
	CALL MANUAL
C
C
C
C	[1.3] CHECK FOR CONTROL/C AND THEN EXIT 
C	TEST IF  GET INPUT FROM BATCH VIA THE CD
S	TAD I BATCH
S	AND (2000 /BATCH ACTIVE BIT
S	SZA CLA
S	JMP \116 /YES, GO CALL THE CD
C
C	NO, GET IT FROM THE TTY:.
S	KSF
S	JMP \111 /NO
S	KRS
S	AND (177
S	TAD (-3 /CTROL/C
S	SZA CLA
S	JMP \101 /NO
C	SAVE DDTG COMMON BEFORE EXIT
C	FIRST CLEAR THE SPOOLER SWITCH
S\1997,	TAD \IOUTSPOOL /IF OPEN, THEN CLOSE IT FIRST
S	SNA CLA
S	JMP \1996 /NOT OPENED
	CALL OCLOSE
C
1996	IOUTSPOOL=0
	CALL BSCOMMON(1)
	CALL EXIT
C
C
C	[1.3.1] CHECK WHETHER COMMAND KEY WAS PRESSED,
C	IF SO, GO INTERPRET THE PREVIOUSLY SAVED COMMAND LINE
C	IN LSAVE[COMMAND#,1:40].
S \111,	CLA CMA /TEST IF SOFTWARE 8E THEN IGNORE CMD KEYS
S	DISP2
S	SNA CLA /SKIP IF SOFTWARE 8E
S	6342 /FBW2
S	SNA
S	JMP \100 /NO
S	DCA \I
S	TAD \I /TURN ON LIGHT
S	6437 /LFBW2
C
C	CMD KEY PRESSED, FIND WHICH ONE
C
	DO 112 IP=1,12
S	TAD \I
S	CLL RAL
S	DCA \I
S	SZL
S	JMP \101 /OK, DO COMMAND # IP
112	CONTINUE
C	FAILED, FORGET IT
	GOTO 100
C
C
C	[1.4] GO SERVICE THE COMMAND BEING ENTERED
101	IF(IP)115,116,115
C
C	NO, GO GET COMMAND FROM COMMAND DECODER INPUT
116	CALL BCDSPEC
S	KRB /CLEAR OUT BUFFER
S	CLA
C
C	TEST FOR /S SWITCH
	IP=ISW(19)
S	TAD \IP
S	SNA CLA
S	JMP \114 /YES, /S SWITCH
C
C
C	YES, SAVE KOUT(DEV,FILE), KIN(DEV,FILE),ISW IN KSAV(IP,*)
C	COPY THE =N VALUE AND TEST IF 0 < N < 13
	IP=MCD(39)+1
	IF(IP)123,123,124
C
C	NO, ERROR
123	WRITE(1,126)
126	FORMAT('? =N ')
	GOTO 100
C
S\124,	TAD \IP
S	TAD (-D13
S	SMA CLA
S	JMP \123 /ERROR
C
C	ZERO /S
	ISW(19)=0
C
	DO 121 I=1,71
121	LSAVE(IP,I)=ICNUM(I)
	GOTO 100
C
C	RESTORE KOUT(DEV,FILE), KIN(DEV,FILE),ISW FROM LSAV(IP,*)
115	DO 122 I=1,71
122	ICNUM(I)=LSAVE(IP,I)
C
C	IF NOT (/O) THEN PRINT THE COMMAND BEFORE EXECUTE IT
	IZ=ISW(15)
S	TAD \IZ
S	SZA CLA
S	JMP \114
C	YES, TURN ON PRINT SWITCH
	ISWTOP=IP
C
C
C	TEST IF USED GENSYM IN  ANY OF THE INPUT OR OUTPUT FILESPECS.
114	CONTINUE
	IVAL=4
	CALL BMAX7
C
C
C	[1.4.1] TEST FOR OUTPUT DEVICE
	CURSYM='NIL   '
S	TAD \KOUTFILE
S	CIA
S	TAD (0215 /"BM"
S	SZA CLA
S	JMP \102 /NO OUTPUT BM
C
C	GET THE BM# AND BYTE
S	TAD \KOUTFILE#
S	BSW
S	AND (0007
S	DCA \JBM
S	TAD \KOUTFILE#
S	AND (0077
S	TAD (-D8 /"@H"
S	SNA CLA
S	IAC
S	DCA \JHGH
C
C
C	[1.4.2] TEST IF INPUT BMS
102	IP=1
C
C	SET THE A/D POT POINTER 
	IY1=0
	DO 103 I=1,5
	DO 109 IY2=1,3
C
C	COMPUTE: K=((I-1)*4)+IY2
S	CLA CMA
S	TAD \I
S	CLL RAL; CLL RAL /MULT BY 4
S	TAD \IY2
S	DCA \K
C	
109	MM(IY2)=KINFILE(K)
C
S	TAD \MM /MM(1)
S	TAD (-0215 /"BM"
S	SNA CLA
S	JMP \106 /YES, IS BM
C
C	[1.4.2.1] TEST IF ICNUM MAPPED NAMES "Pi", "FBWi", "KPD"
C	TEST IF USE A/DS
C	TEST IF "P<DIGIT>"
S\1706,	TAD \MM
S	AND (7700
S	TAD (-2000 /P
S	SNA CLA
S	JMP \1707 /YES "Pi"
C
C	TEST IF "QRi"
S	TAD \MM
S	TAD (-2122 /"QR"
S	SZA CLA
S	JMP FBTST /NO
C	YES, GET INDEX LETTER OF Q-REGISTER
S	TAD \MM#
S	BSW
S	AND (37
S	TAD (-D27
S	SMA
S	CLA CMA /LOAD QR Z
S	TAD (D27
S	DCA \K
	K=ITMPSTK(K)
C	GO STORE IT IN COMMON
	GOTO 1708
C
C	TEST IF "FBWi"
S FBTST, TAD \MM
S	TAD (-0602 /"FB"
S	SZA CLA 
S	JMP \1709 /NO
C
S	TAD \MM#
S	AND (7700
S	BSW
S	TAD (-D23 /"W"
S	SZA CLA
S	JMP \1709 /NO
C
C	YES, GET SWITCH NUMBER 
S	CLA CMA /-1
S	TAD \MM#
S	AND (0007
S	TAD (6341 /FBW1
S	DCA DOFBW
S DOFBW, 0 /FBWi
S	DCA \K
C	GO STORE IN ICNUM
	GOTO 1708
C
C
C	TEST IF "KPD"
S \1709,	TAD \MM
S	TAD (-1320 /"KP"
S	SZA CLA
S	JMP \1111 /NO
S	TAD \MM#
S	TAD (-0400 /"D@"
S	SZA CLA
S	JMP \1111 /NO
C
C	YES, GET KPD DATA AND CVT TO DECIMAL FROM BCD
S	TAD (207 /BELL
S	TLS
S	CLA
S	CPAGE 2
S WKPD,	6313 /SKPKPD
S	JMP WKPD
S	6353 /RKYPDL
S	DCA \K
S	6340 /RKYPDH
S	CLA
	K=IBCD(K,1)
C	STORE IN ICNUM
	GOTO 1708
C
C
C	POSSIBLE "Pi" GO
C	CHECK IF <DIGIT>0:7
S\1707,	TAD \MM
S	AND (77
S	TAD (-60
S	MQL
S	MQA
S	SPA CLA
S	JMP \1111 /NO
C	YES,
S	MQA
S	TAD (-D8
S	SMA CLA
S	JMP \1111 /NO
C
C	YES, GO GET THE A/D
C
C       [AD.1] SET UP THE CHANNEL WHICH IS PASSED VIA THE MQ
S       ADCL
S	MQA
S       AND (0007 /ONLY 0 TO 17
S	TAD (10 /CHANNELS 0:10
S       ADLM /LOAD THE MUX SELECTOR
C
C
C       [AD.2] START THE A/D
S       ADST
S ADFIN,ADSK
S       JMP ADFIN /NOT FINISHED.
C
C
C       [AD.3] GET THE DATA 
S       ADRB
S	TAD (1000 /ADD +512 SO -1 TO +1 VDC ==>[0:1777]
S	CLL RAR/ DIVIDE BY 2 SO 0:511
S	DCA \K
1708	IY1=IY1+1
	ICNUM(IY1)=K
	GOTO 103
C
C	TEST FOR OPR AND PUT INTO CURSYM
S\1111,	TAD \MM
S	SNA CLA /DON'T DO IT IF NULL
S	JMP \103 /=0
C
C	ONLY SAVE IF CURSYM="NIL "
S	TAD \CURSYM
S	CIA
S	TAD (1611/"NI"
S	SZA CLA
S	JMP \103 /NO
C
S	TAD \CURSYM#
S	CIA
S	TAD (1440/L<SPACE>
S	SZA CLA
S	JMP \103
C	YES, SAVE OPR FOR LATER ANALYSIS
	CURSYM=FM
	GOTO 103
C
C
C	YES, BM, TEST IF 3RD IN WHICH CASE FORGET IT
S \106,	TAD \IP
S	TAD (-2
S	SNA
S	JMP \105 /=2
S	SMA CLA
S	JMP \103 / >2
C
C	1ST BM SPEC
S	TAD \MM#
S	BSW
S	AND (0007
S	DCA \IBM1
S	TAD \MM#
S	AND (0077
S	TAD (-D8 /"@H"
S	SNA CLA
S	IAC
S	DCA \IHGH1
C	REMEMBER THE BM NAME
S	TAD \MM
S	DCA \SFILE
S	TAD \MM#
S	DCA \SFILE#
	IP=2
	GOTO 103
C
C
C
C	2ND BM SPEC
S \105,	TAD \MM#
S	BSW
S	AND (0007
S	DCA \IBM2
S	TAD \MM#
S	AND (0077
S	TAD (-D8 /"@H"
S	SNA CLA
S	IAC
S	DCA \IHGH2
C	REMEMBER THE BM NAME
S	TAD \MM
S	DCA \SEXT
S	TAD \MM#
S	DCA \SEXT#
	IP=3
103	CONTINUE
C
C	[1.4.3] TEST IF PRINT CMD IF FROM CMD KEYS
C		THEN  CHECK IF CURSYM IS VALID, ELSE ERROR
S\181,	TAD \ISWTOP
S	SNA
S	JMP \183 /NO PRINTING
S	DCA \IZ /SAVE NUMBER TO BE PRINTED
	IVAL=12
	CALL BMAX2
C
C
C	[1.4.4] LOOKUP THE OPERATOR
C	IF CURSYM=NULL
C		THEN FAIL ELSE CONTINUE SEARCH;
S\183,	TAD \CURSYM
S	TAD (-1611 /"NI"
S	SZA CLA
S	JMP \184 /NOT "NI"
C
S	TAD \CURSYM#
S	TAD (-1440 /"L "
S	SNA CLA
S	JMP \185 /FAILED
C
C	CONTINUE SEARCH
184	IP=FINDOPR(CURSYM)
C
S	TAD \IP
S	SZA CLA
S	JMP \110 /NON-ZERO
C
C	TEST IF IT IS A SAVE FILE. SETUP TO DO CHAIN
	IP=-1
	CALL BSEARCH
S	CLA IAC
S	TAD \IP /IS SET TO 0 IF NOT FOUND
S	SNA CLA
S	JMP \110 /SUCCEEDED
C
C
C	FAILED, PRINT MSG
185	WRITE(1,108)CURSYM
108	FORMAT('? ',A6,' CMD.')
	GOTO 100
C
C
C
C	[1.4.5] SERVICE OPERATOR
110	FA=TIMER(0)
S	JMS BMSERVE
	FA=TIMER(1)
C
C
C	[1.4.6] IF /P THEN DO "PARAMETERS/P" 
	K=ISW(16)
S	TAD \K
S	SNA CLA
S	JMP \100
C
	IVAL=1
	CALL BMAX6
	GOTO 100
C
C
C	*****************************************************************
C	*    SUBROUTINE     B M S E R V E                         *
C	*****************************************************************
C	SERVICE THE COMMAND
S	CPAGE 3
S RBMSERVE,	JMP I BMSERVE /RETURN
S BMSERVE,	0 /ENTRY
C
C
C
C
C
C		[1] COMPUTE IBM1 BIT PATTERNS
C
C	CHECK WHETHER /A THEN SET ALL BITS
	IMA=15
	IMB=15
S	TAD \ISW /A SWITCH
S	SZA CLA
S	JMP \139 /YES, SET ALL BITS
C
C
C	NO, SELECT BITS
		IMA=0
		IMB=0
		I=IBM1+1
		GOTO(130,131,132,133,134,135,136,137),I
C
130		IMA=8
		GOTO 139
131		IMA=4
		GOTO 139
132		IMA=2
		GOTO 139
133		IMA=1
		GOTO 139
134		IMB=8
		GOTO 139
135		IMB=4
		GOTO 139
136		IMB=2
		GOTO 139
137		IMB=1
C
139		CONTINUE
C
C
C
C
C		[2] SET GRAY/DET VID BITS IF /B SWITCH=1
S		TAD \ISW#  / "/B" SWITCH
S		AND (0001
S		SNA CLA
S		JMP \150 /NO
C		YES, SET UP BITS
S		TAD \IMA	/GET MEM NUMBER OF "SOURCE"
S		CLL RTL;RTL	/MOVE BITS 8-11 TO 4-7
S		TAD \IMA	/ADD ON BITS 8-11
S		DCA \IMA	/FORM NEW WORD
S		TAD \IMB	/REPEAT FOR GROUP B....
S		CLL RTL;RTL
S		TAD \IMB
S		DCA \IMB	/...FORM NEW WORD
C
C		[3] SET IB HIGH BYTE WORDS
S\150,		TAD \IHGH1
S		SNA CLA
S		JMP \170 /NO
C
S		TAD \IMA	/GET MEM NUMBER OF "SOURCE"
S		AND (0017	/ONLY KEEP MEM NUMBER
S		CLL RTR; RTR; RAR /MOVE BITS 8-11 TO 0-3
S		TAD \IMA	/ADD ON BITS 4-11
S		DCA \IMA	/FORM FINAL WORD
S		TAD \IMB	/REPEAT FOR GROUP B...
S		AND (0017
S		CLL RTR; RTR; RAR
S		TAD \IMB
S		DCA \IMB	/...SAVE
C
C
C
C
C
C		[4] SET SCALE FACTOR
C
170		INUMERATOR=0
		IDENOMINATOR=0
S		TAD \ICNUM /1ST NUMBER	
S		AND (3777	/BITS 1-11 (+ ONLY)
S		SNA
S		IAC		/MAKE SURE AT LEAST 1
S		DCA \INUMERATOR	/STUFF IT
S		TAD \ICNUM# /2ND NUMBER
S		AND (3777	/SAME TRICKS...
S		SNA
S		IAC
S		DCA \IDENOMINATOR /...STUFF IT.
C@@@@		SCALE=FLOAT(INUMERATOR)/FLOAT(IDENOMINATOR)
C
C
C	[5] GET COMPUTING WINDOW (KX1,KX2,KY1,KY2)
C	DEFINED BY F&S OVER BMI1.
	IVAL=2
	CALL BMAX3
C
C
C	[5.1] IF IP=-1
C		THEN CALL CHAIN(CURSYM)
C		ELSE DISPATCH GOTO(...),IP
S	CLA IAC
S	TAD \IP
S	SZA CLA
S	JMP \171 /DO GOTO(...),IP
C
C	GO CHAIN
	IVAL=16
	CALL BMAX2
C
C
C
C	[6] DISPATCH, VALIDATE THE OPERATOR NUMBER
171	GOTO(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22
     1,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43
     2,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63),IP
C
C	***********************************************************
C	*  D I S P A T C H E D     O P E R A T O R S        *
C	***********************************************************

C
C
C	[1]      /GET???/
C	IF /A THEN DON'T TEST
S \1,	TAD \ISW
S	SNA CLA
S	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CHKMVSW /CHECK /M, /V
	IVAL=1
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[2]      /POST??/
C	IF /A THEN DON'T TEST
S \2,	TAD \ISW
S	SNA CLA
S	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CHKMVSW /CHECK /M, /V
	IVAL=2
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[3]      /UNPOST/
C	IF /A THEN DON'T TEST
S \3,	TAD \ISW
S	SNA CLA
S	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CHKMVSW /CHECK /M, /V
	IVAL=3
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[4]      /POSXY?/
S \4,	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=4
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[5]      /POSFSX/
S \5,	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=5
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[6]      /SETFS?/
6	IVAL=6
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[7]      /ALL384?/
7	IVAL=10
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[8]      /STDBM?/
8	IVAL=11
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[9]      /SETFSB/
S \9,	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=7
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[10]      /WRITE?/
C	ASSIGN THE OPR <=="XMITBM" AND CHAIN FORCE A SEARCH-CHAIN
10	CURSYM='XMITBM'
C	CHAIN AT [1.4.4]
	GOTO 184
C
C
C	[11]      /READ??/
C	ASSIGN THE OPR <=="XMITBM" AND CHAIN FORCE A SEARCH-CHAIN
11	CURSYM='XMITBM'
C	CHAIN AT [1.4.4]
	GOTO 184
C
C
C	[12]      /CMDKEY/
12	IZ=0
	IVAL=12
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[13]      /SETGEN/
13	IVAL=13
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[14]      /INIT??/
14	IVAL=14
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[15]      /COLOR?/
S \15,	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=1
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[16]      /COPY??/
S \16,	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=2
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[17]      /COMPLE/
S \17,	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=3
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[18]      /HIST??/
S \18,	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=1
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[19]      /CONTRA/
S \19,	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=17
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[20]      /SLICE?/
S \20,	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=16
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[21]      /LAPLAC/
21	IVAL=7
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[22]      /AVG8??/
S \22,	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=4
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[23]      /GRAD4??/
S \23,	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=8
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[24]      /EVAL??/
24	IVAL=5
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[25]      /GRAYBA/
S \25,	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=6
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[26]      /TEXT??/
S \26,	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=4
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[27]      /GRID??/
S \27,	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=5
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[28]      /GRAPHP/
S \28,	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=6
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[29]      /ZERO??/
29	ICNUM=0
	GOTO 15
C
C
C	[30]      /PARAME/
30	IVAL=1
	CALL BMAX6
C	RETURN W/O TESTING /P
	ET=TIMER(1)
	GOTO 100
C
C
C	[31]	/SAVCMD/
31	IVAL=7
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[32] 	/RSTCMD/
32	IVAL=8
	CALL BMAX1
S	JMP RBMSERVE
C
C
C	[33] 	/SCALE?/
S \33,	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=18
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[34] 	/LOADQR/
34	IVAL=17
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[35] 	/DELSQP/
S \35,	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=4
	CALL BMAX5
S	JMP RBMSERVE
C
C
C	[36] 	/ADD???/
S \36,	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=1
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[37] 	/SUB???/
S \37,	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=2
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[38] 	/MUL???/
38	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=3
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[39] 	/DIV???/
39	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=4
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[40] 	/AND???/
40	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=5
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[41] 	/OR????/
41	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=6
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[42] 	/MAX???/
42	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=7
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[43] 	/MIN???/
43	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=8
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[44] 	/DIFF??/
44	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1,IBM2
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=9
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[45] 	/SETFSR/
S \45,	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=2
	CALL BMAX7
S	JMP RBMSERVE
C
C
C	[46] /FILLPI/
46	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=10
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[47] /CIRCLE/
47	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=11
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[48] /RECTAN/
48	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=12
	CALL BMAX4
S	JMP RBMSERVE
C
C	[49] /WHITEN/
49	CONTINUE
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=13
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[50] /SHIFT?/
50	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1
S	JMS CKOUT /TEST FOR LEGAL JBM
	IVAL=14
	CALL BMAX4
S	JMP RBMSERVE
C
C
C	[51] /AREA??/
51	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=1
	CALL BMAX5
S	JMP RBMSERVE
C
C
C	[52] /DENSITY/
52	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=2
	CALL BMAX5
S	JMP RBMSERVE
C
C
C	[53] /PERIME/
53	CONTINUE
S	JMS CKIN /TEST FOR LEGAL IBM1
	IVAL=3
	CALL BMAX5
S	JMP RBMSERVE
C
C
C	[54] /EDGE??/
54	CONTINUE
S	JMS CKOUT
S	JMS CKIN
	IVAL=3
	CALL BMAX3
S	JMP RBMSERVE
C
C
C	[55] /EXIT??/
55	CONTINUE
C	EXIT AT [1.3]
	GOTO 1997
C
C
C	[56] /LOADTH/
56	CONTINUE
	IVAL=3
	CALL BMAX6
S	JMP RBMSERVE
C
C
C	[57] /QDATA?/
57	CONTINUE
	IVAL=1
	CALL BMAX9
S	JMP RBMSERVE
C
C
C	[58] /BATCH?/
58	CONTINUE
	IVAL=15
	CALL BMAX2
S	JMP RBMSERVE
C
C
C	[59] /SETIOT/
59	CONTINUE
	IVAL=9
	CALL BMAX1
S	JMP RBMSERVE
C
C
C
C
C	[60] /OPENFI/
C	OPEN THE FILE SPECIFIED IN THE OUTPUT SPEC
C	IF NO OUTPUT FILE IS SPECIFIED, THEN OPEN UP THE LPT:
C	IF THE SPOOLER IS ALREADY OPEN, THEN CLOSE IT BEFORE OPENING IT AGAIN
60	IVAL=1
	CALL BMAX7
S	JMP RBMSERVE
C
C
C	[61] /CLOSEF/
C	CLOSE THE FILE IF OPENED
61	CONTINUE
S	TAD \IOUTSPOOL
S	SNA CLA
S	JMP RBMSERVE /NOP
C
	IOUTSPOOL=0
	CALL OCLOSE
S	JMP RBMSERVE
C
C
C	[62] /NOBATC/
62	CONTINUE
S	TAD I BATCH
S	AND (5777 /TURN OFF BATCH ON BIT
S	DCA I BATCH
S	JMP RBMSERVE
C
C
C	[63] /SHOWHI/
63	CONTINUE
	IVAL=9
	CALL BMAX3
S	JMP RBMSERVE
C***************************************************
C	*PROCEDURE      C K O U T
C******************************************************
C
C
C	CHECK WHETHER THE OUTPUT BM SPEC IS LEGAL ELSE GOTO 199.
S	CPAGE 3
SRCKOUT,	JMP I CKOUT
S CKOUT,	0 /ENTRY
C
C	[1] TEST IF KOUTFILE="BM"
S	CLA
S	TAD \KOUTFILE
S	TAD (-0215
S	SZA CLA
S	JMP \199 /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 \199 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \199 /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 199.
S	CPAGE 3
SRCKIN,	JMP I CKIN
S CKIN,	0 /ENTRY
C
C	[1] TEST IF BMI1="BM"
S	CLA
S	TAD \SFILE
S	TAD (-0215
S	SZA CLA
S	JMP \199 /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 \199 /NO, FAILED
S	TAD (-D8 /"7" TEST
S	SMA CLA
S	JMP \199 /FAILED
S	JMP RCKIN /OK.
C
C
C***************************************************
C	*PROCEDURE      C H K M V S W I T C H E S
C******************************************************
C
C
C	CHECK IF /M OR /V SWITCHES AND ACT ON THEM.
S	CPAGE 3
SRCHKMVSW,	JMP I CHKMVSW
S CHKMVSW,	0 /ENTRY
C
C	TEST FOR /M AND /V AND TOGGLE THE QPROG2-7 STATUS
	I=ISW(13)
S	TAD \I /IF /M THEN SET TO MASK&F-S MODE
S	SNA CLA
S	JMP NOTMSW
C
C	SET  MASK STATUS TO VF&BM
S	TAD (0020 /6:9=0100 TO SELECT VF&MBMF
S	QPROG2
C
C	GET STATUS OF QPROG7 FROM COMMON VAR: IFILTOP
S	TAD \IFILTOP
S	AND (1774
S	TAD (6000 /GET LIVE FRAME FROM QPROG2 ABOVE
S	DCA \IFILTOP
S	TAD \IFILTOP
S	QPROG7
C
S NOTMSW,	CLA
	I=ISW(22)
S	TAD \I
S	SNA CLA
S	JMP RCHKMVSW /NO
S	QPROG2
C
C	CLEAR BITS FROM COMMON SAVE OF QPROG7
S	TAD \IFILTOP
S	AND (1774
S	DCA \IFILTOP
S	TAD \IFILTOP
S	QPROG7 /YES, /V SO CLEARN REGISTERS
C
S	JMP RCHKMVSW /OK.
C
C
C************** P A R A M E T E R S *************
S PKINFILE,	\KINFILE
	END