.TITLE	BASBRO
;
; PROGRAM TO KEEP A "BIG BROTHER" EYE ON BASIC INTERPRETERS
; CALL: MCR>BRO <CR>
;
	.MCALL	QIOW$	DIR$	EXIT$S	GMCR$
$PSW	=-2
	.MACRO	.INH0
	MOV	$PSW,-(SP)
	BIS	#140,$PSW
	.ENDM	.INH0
;
MCRDPB:	GMCR$
QIODPB:	QIOW$	IO.RPR,1,1,,IOST,,<INBUF,80.,,NAM,NAMEN-NAM>
IOST:	.BLKW	2
INBUF:	.BLKB	80.
NAM:	.ASCII	<15><12>/3 LETTER TASK NAME: /
NAMEN:
TIPR:	.ASCII	<15><12>/TI = TT/
TIPREN:
	.EVEN
RAD...:	.RAD50	/.../
RADNAM:	.WORD	0
TINUM:	.WORD	0
BATFLG:	.WORD	0
QIOM01:	QIOW$	IO.WVB,1,1,,IOST,,<MESS01,0,40>
QIOM02:	QIOW$	IO.WVB,1,1,,IOST,,<MESS02,0,40>
QIOM03:	QIOW$	IO.WVB,1,1,,IOST,,<MESS03,0,40>
MESS01:	.ASCII	/CURRENT PROGRAM FILE: /
BUFF01:	.BLKB	30.
MESS02:	.ASCII	/CURRENT LINE, STATEMENT: /
BUFF02:	.BLKB	14.
MESS03:	.ASCII	/CURRENT FREE SPACE (BYTES) /
BUFF03:	.BLKB	6
	.EVEN
;
; FOLLOWING BUFFERS FOR RETRIEVING DATA FROM BASIC TASK
;
DATSIZ=50
PRGNAM:	.BLKW	5	;PROGRAM NAME
DATBAS:	.BLKW	DATSIZ	;OTHER MISCELLANEOUS DATA
;
	.ENABL	LSB
START:	DIR$	#MCRDPB		;CHECK ON MCR COMMAND LINE
	MOV	@#$DSW,R1	;CHAR COUNT -> R1
	CMP	R1,#4		;MORE THAN JUST TASK NAME?
	BLT	BASBRO		;IF SO, GET COMMAND REGULAR WAY
	MOV	#MCRDPB+G.MCRB,R0 ; ADDRESS OF BUFFER -> R0
14$:	CMPB	(R0)+,#40	;LOOK FOR SPACE
	BEQ	15$		;IF WE FOUND IT, BRANCH INTO REST OF CODE
	SOB	R1,14$
	BR	BASBRO		;IF FINISHED LOOP, MISTAKE: GET LINE FROM TI
BASBRO:	MOV	#NAM,QIODPB+Q.IOPL+6	;SET UP FOR PROMPT
	MOV	#NAMEN-NAM,QIODPB+Q.IOPL+10
	DIR$	#QIODPB
	TST	IOST	;DID IT GO OK?
	BGE	10$
	JMP	9$
10$:	TST	IOST+2		;CR ONLY?
	BGT	12$		;IF NOT, DO REGULAR PROCESSING
	TST	TINUM		;SOMETHING ALREADY SET?
	BEQ	BASBRO		;IF NOT, RE-PROMPT
	MOV	TINUM,R0	;GET PUD IN R0
	BR	41$		;AND SKIP SOME CODE
12$:	MOV	#INBUF,R0	;GET INPUT BUFFER ADDRESS -> R0
15$:	CLR	R1		;GET SET TO CONVERT NAME INTO
	JSR	PC,$CAT5	;RAD-50
	MOV	R1,RADNAM	;STORE AWAY 3 LETTER RAD50 WORD
	CLR	BATFLG		;CLEAR THE FLAG FOR BATCH VERSION
	CMPB	(R0)+,#',	;DO WE HAVE COMMA?
	BEQ	13$		;IF SO, SKIP NEXT PROMPT
	MOV	#TIPR,QIODPB+Q.IOPL+6	;SET UP FOR ANOTHER PROMPT
	MOV	#TIPREN-TIPR,QIODPB+Q.IOPL+10
1$:	DIR$	#QIODPB
	TST	IOST
	BGE	11$		;IF OK, BRANCH AROUND
	JMP	9$
11$:	MOV	#INBUF,R0	;CHECK THIS INPUT STRING
13$:	MOV	R0,R1		;COPY BUFFER ADDRESS
	CMP	R0,#QIODPB	;CHECK FOR MCR COMMAND LINE
	BLO	16$		;IF SO, SKIP PUTTING TERMINATOR
	ADD	IOST+2,R1	;MAKE R1 POINT TO FIRST FREE POSITION
	MOVB	#':,(R1)	;JUST MAKE SURE IT'S TERMINATED
16$:
	CMPB	(R0),#'B	;IS IT BATCH?
	BNE	18$		;IF NOT, DO REGULAR NUMBER
	INC	BATFLG		;SET BATCH FLAG
	CLR	TINUM		;IF BATCH MAKE SURE UNIT ZERO FOR NOW
	BR	19$		;AND SKIP NUMBER CONVERSION
18$:	JSR	PC,$COTB	;AND GET BINARY NUMBER IN R1
	MOV	R1,TINUM	;SAVE IT
;
; SCAN PUDS
;
19$:
	MOV	.PUDBA,R0	;START -> R0
	MOV	.PUDEA,R1	;END   -> R1
	MOV	#"TT,R2		;NAME  -> R2
	MOV	TINUM,R3	;NUM   -> R3
	TST	BATFLG		;LOOKING FOR BATCH TASK??
	BEQ	2$		;IF NOT, ALL IS OK (BRANCH)
	MOV	#"BA,R2		;ELSE LOOK FOR BATCH PUD
2$:	CMP	R0,R1		;PAST END?
	BHIS	1$		;IF SO, NOT THERE -> RE-PROMPT
	CMP	R2,(R0)		;NAME MATCH?
	BNE	3$		;IF NOT, GO AROUND AGAIN
	CMPB	R3,2(R0)	;UNIT MATCH?
	BEQ	4$		;IF SO, WE HAVE IT
3$:	ADD	#U.SZ,R0	;TRY ANOTHER ONE
	BR	2$
4$:	MOV	R0,TINUM	;SAVE PUD ADDRESS
41$:	MOV	R0,R2		;ALSO IN REGISTER FOR SPEED
	.INH0			;NO TASK SWITCHING WHILE
	MOV	.ATLLH,R0	;WE'RE MESSING AROUND WITH ATL
	MOV	R0,R1		;COPY START -> R1
5$:	MOV	(R0),R0		;POINT TO NEXT ENTRY
	CMP	R0,R1		;BACK AT END OF CHAIN
	BNE	51$		;IF NOT, THERE'S STILL HOPE
	JSR	PC,..ENB0	;ELSE ENABLE TASK SWITCHING
	BR	BASBRO		;AND START OVER AGAIN
51$:	CMP	R2,A.TI(R0)	;TI MATCH?
	BNE	5$		;IF NOT, BRANCH
	MOV	A.TD(R0),R3	;STD ADDRESS -> R3
	CMP	RAD...,(R3)+	;CHECK OUT 1ST PART
	BNE	5$
	CMP	RADNAM,(R3)+	;THEN 2ND
	BNE	5$		;IF NO MATCH, TRY AGAIN
	CMPB	A.TS(R0),#TS.RUN ;SEE IF IN LEGIT STATUS RANGE
	BLO	5$		;IF NOT, TRY AGAIN
	CMPB	A.TS(R0),#TS.WF4
	BHI	5$
;
; WE'VE FOUND IT (ADDRESS OF ATL ENTRY IN R0)
;
	MOV	#77606,-(SP)	;FIRST MAP
	MOV	A.HA(R0),-(SP)	;INTO TASK
	JSR	PC,..SPD3	;HEADER
	MOV	#60000,R2	;THEN MAP INTO
	MOV	H.PA0(R2),(SP)	;START OF BASIC
	MOV	H.PD0(R2),2(SP)	;TASK ITSELF
	JSR	PC,..SPD3
;
; NOW WE'VE MAPPED INTO FIRST 4K OR LESS OF TASK
;
	MOV	#PRGNAM,R1	;SET UP FOR NAME XFER
	MOV	#COMFNB+60000+N.FNAM,R2
	MOV	#5,R3		;FIVE WORDS TO XFER
6$:	MOV	(R2)+,(R1)+
	SOB	R3,6$
	MOV	#DATBAS,R1	;START OF MISCELLANEOUS POINTERS ETC.
	MOV	#WORK+60000,R2
	MOV	#DATSIZ,R3
7$:	MOV	(R2)+,(R1)+	;MOVE IT ALL IN
	SOB	R3,7$
;
; NOW WE'VE GOT DATA
;
	ADD	#4,SP		;GET RID OF PAR/PDR
	JSR	PC,..ENB0	;RE-ENABLE TASK SWITCHING
	MOV	#BUFF01,R0
	MOV	#PRGNAM,R3	;GET SET TO CONVERT
	MOV	#3,R4		;PROGRAM FILE NAME
8$:	MOV	(R3)+,R1
	JSR	PC,$C5TA
	SOB	R4,8$
	MOVB	#'.,(R0)+	;PUT IN DELIMITER FOR EXT
	MOV	(R3)+,R1	;RAD50 EXT -> R1
	JSR	PC,$C5TA	;CONVERT IT
	MOVB	#';,(R0)+	;DELIMIT VERSION NUMBER
	MOV	(R3)+,R1	;BINARY VERSION # -> R1
	CLR	R2		;NO LEADING ZEROES
	JSR	PC,$CBOMG	;CONVERT IT TO ASCII
	SUB	#MESS01,R0	;CALC TOTAL STRING LEN -> R0
	MOV	R0,QIOM01+Q.IOPL+2 ;SET LEN OF OUTPUT
	DIR$	#QIOM01		;PRINT IT
	MOV	#DATBAS-WORK,R4	;ESTABLISH BASE ADDRESS TO OFFSET FROM
	MOV	#BUFF02,R0	;ADDRESS OF NEXT BUFFER -> R0
	MOV	LINENO(R4),R1	;GET LINE NUMBER -> R1
	CLR	R2		;NO LEADING ZEROES
	JSR	PC,$CBDMG	;CONVERT IT (DECIMAL)
	MOVB	#',,(R0)+	;PUT IN COMMA
	MOVB	#40,(R0)+	;AND SPACE
	MOV	STCOUN(R4),R1	;NOW STATEMENT WITHIN LINE
	JSR	PC,$CBDMG
	SUB	#MESS02,R0	;LEN OF MESSAGE -> R0
	MOV	R0,QIOM02+Q.IOPL+2 ;SET LENGTH
	DIR$	#QIOM02		;PRINT IT
	MOV	STGOSB(R4),R1	;CALCULATE TOTAL BYTES LEFT
	SUB	ENUDAT(R4),R1	;IN R1
	BNE	17$		;IF NON-ZERO, OK SO BRANCH
	MOV	BOLNHD(R4),R1	;IF ZERO, CALCULATE IN DIFFERENT WAY
	SUB	ENDTXT(R4),R1	;(WE ASSUME BASIC IS IN IMMEDIATE MODE)
17$:	MOV	#BUFF03,R0	;ADDRESS OF BUFFER
	JSR	PC,$CBDMG	;CONVERT TO ASCII
	SUB	#MESS03,R0	;R0 HAS LENGTH OF LINE
	MOV	R0,QIOM03+Q.IOPL+2	;PUT IN DPB
	DIR$	#QIOM03
	JMP	BASBRO		;GO AROUND AGAIN
9$:	EXIT$S			;QUICK EXIT FOR NOW
	.END	START