; SYSOVL - CLONE OVERLAY FOR SYS COMMAND
; LAST EDIT:	11-NOV-81
;
.NLIST
.LIST	TTM
.NLIST	BEX
.TITLE	SYSOVL
.LIST
;
;
; CLONE SYSTEM INFORMATION COMMANDS
;
MAXLIN=80.	;MAXIMUM PAGE WIDTH
SPACH=40
CR=15
LF=12
TAB=11
;
;
; SYSLST - LIST CLONE SYSTEM STATUS
;
; INPUT:	NONE
; REGISTERS DESTROYED:	R0,R1,R2
;
SYSLST::MOV	R3,-(SP)
	MOV	PROCLH,R0	;START THE PROCESS LIST
1$:	CMP	R0,#PROCLH	;END OF LIST
	BEQ	SYSDON
	MOV	R0,-(SP)	;SAVE PROCESS ITEM
	MOV	PL.TI(R0),DCODE	;SET TI NAME
	MOV	PL.TI+2(R0),R1	;GET BINARY UNIT
	MOV	#DCODE+2,R0
	CALL	CBT2OD		;CONVERT BINARY TO 2 OCTAL DIGITS
	MOV	#SYMES1,R2	;PRINT START OF PROCESS LINE
	CALL	OUTP
	MOV	(SP),R0		;RESTORE PROCESS
	MOV	PL.FLG(R0),R1	;NOW CONVERT PROCESS FLAGS
	MOV	#VALBUF,R0
	MOV	#PFLGTB,R2
	CALL	GETBIT
	CLRB	(R0)
	MOV	#VALBUF,R2
	CALL	OUTC		;PRINT PROCESS FLAGS
;
	MOV	(SP),R1		;FORM STREAM LIST ADDRESS
	ADD	#PL.SLH,R1	;GET STREAM LIST HEAD
	MOV	R1,-(SP)	;AND SAVE IT
	MOV	(R1),R1		;FIRST STREAM ITEM
	BEQ	10$		;SKIP IF NOTHING THERE
2$:	CMP	R1,(SP)		;END OF STREAM LIST ?
	BEQ	10$		;QUIT IF SO
	MOV	R1,-(SP)	;SAVE STREAM POINTER
	TST	SL.REG(R1)	;TASK STREAM
	BNE	3$
	MOV	#"CL,NCODE	;SET STREAM NAME TO 'CLONE'
	MOV	#"ON,NCODE+2
	MOV	#"E ,NCODE+4
	BR	4$
3$:	MOV	#NCODE,R0	;OUTPUT STRING ADDRESS
	MOV	SL.TSK(R1),R1	;FIRST RAD50 WORD
	CALL	$C5TA
	MOV	(SP),R1		;RESTORE STREAM ITEM
	MOV	SL.TSK+2(R1),R1	;SECOND RAD50 WORD
	CALL	$C5TA
4$:	MOV	(SP),R1
	MOV	SL.STA(R1),R3	;GET STREAM STATUS
	BIT	#FG.BRK,SL.FLG(R1);BUT IS STREAM IN BREAKIN
	BEQ	5$
	MOV	SL.BST(R1),R3	;IF SO GET SAVED STATUS
5$:	MOV	#SCODE,R0	;BUFFER FOR STATUS
	MOV	R3,R1		;STATUS CODE VALUE
	MOV	#STATTB,R2	;STREAM STATUS TABLE
	CALL	GETFLG		;GET STATUS MNEMONIC
	MOV	#SYMES2,R2	;OUTPUT START OF STREAM LINE
	CALL	OUTP
	MOV	#VALBUF,R0	;BUFFER FOR STREAM FLAGS
	MOV	(SP),R1		;RESTORE STREAM
	MOV	SL.FLG(R1),R1
	MOV	#SFLGTB,R2	;GET STREAM FLAGS TABLE
	CALL	GETBIT		;GET BIT MNEMONICS
	CLRB	(R0)
	MOV	#VALBUF,R2	;OUTPUT FLAGS
	CALL	OUTC
;
	MOV	(SP)+,R1	;POP STREAM POINTER
	MOV	SL.FWD(R1),R1	;NEXT STREAM
	BR	2$
; END OF STREAM LIST SCAN
10$:	ADD	#2,SP		;POP STREAM LISTHEAD
	MOV	(SP)+,R0	;RESTORE PROCESS LIST POINTER
	MOV	PL.FWD(R0),R0	;NEXT PROCESS
	BR	1$
; END OF PROCESS LIST
;
; NOW PRINT AVAILABLE POOL SPACE
;
SYSDON:	MOV	#NULL,R2	;OUTPUT A BLANK LINE
	CALL	OUT
	CALL	CHKSP		;GET AVAILABLE SPACE
	MOV	#SYNUM1,R0
	MOV	R3,R1		;GET TOTAL SPACE
	MOV	#23012,R2	;SET CONTROL FLAGS
				;BASE 10.=12
				;+ LEADING ZEROS=1000
				;+ ZERO TO BLANK CONVERSION=2000
				;+ 4 DIGIT FIELD=20000
	CALL	$CBTA		;CONVERT BINARY TO ASCII
	MOV	#SYNUM2,R0
	MOV	R4,R1		;GET LARGEST HOLE
	MOV	#23012,R2
	CALL	$CBTA
	MOV	#SYMES4,R2	;PRINT FREE SPACE MESSAGE
	CALL	OUT
;
; NOW OUTPUT WORDS OF STACK IN USE
	CALL	STKUSE		;GET STACK USAGE IN R3
	MOV	R3,R1		;AND COPY
	MOV	#SYNUM3,R0	;POINT TO CONVERSION BUFFER
	CLR	R2		;NO LEADING ZEROS
	CALL	$CBDSG		;CONVERT TO DECIMAL
	CLRB	(R0)		;TERMINATE STRING
	MOV	#SYMES5,R2
	CALL	OUT		;PRINT FREE STACK SPACE
	MOV	#NULL,R2
	CALL	OUT		;AND A BLANK LINE
	MOV	(SP)+,R3
	RETURN
;
; LOCAL ROUTINE TO GET A MNEMONIC ASSOCIATED WITH A VALUE
;
; INPUT:	R0 -	OUTPUT BUFFER ADDRESS
;		R1 -	FLAG VALUE
;		R2 -	FLAG TABLE ADDRESS
; OUTPUT:	R0 UPDATED
;
GETFLG:	TST	2(R2)		;END OF TABLE ?
	BEQ	2$
	CMP	(R2)+,R1	;IS THIS THE VALUE ?
	BEQ	1$		;YES IT IS
	TST	(R2)+		;SKIP NAME
	BR	GETFLG
1$:	MOV	(R2),R1		;GET RAD50 NAME
	CALL	$C5TA		;GET ASCII VALUE
	BR	3$
2$:	MOVB	#'?,(R0)	;UNDEFINED FLAG
	MOVB	(R0)+,(R0)
	MOVB	(R0)+,(R0)+
3$:	MOVB	#' ,(R0)+
	RETURN
;
;
; GETBIT GET MNOMONIC ASSOCIATED WITH BITS IN A FLAGS WORD
;
; INPUT:	R0 -	OUTPUT BUFFER ADDRESS
;		R1 -	FLAGS WORD VALUE
;		R2 -	FLAG TABLE ADDRESS
;
GETBIT:	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	#1,R3		;INIT MASK BIT
1$:	MOV	2(SP),R1	;GET FLAGS WORD
	BIT	R3,R1		;IS BIT SET
	BEQ	2$		;SKIP IF NOT
	COM	R3		;ISOLATE BIT
	BIC	R3,R1
	COM	R3
	MOV	(SP),R2		;GET FLAG TABLE
	CALL	GETFLG		;GET MNOMONIC
2$:	ASL	R3		;ON TO NEXT BIT
	BCC	1$		;BRANCH IF ANY LEFT
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RETURN
;
;
; THE MACRO FLGDEF DEFINES THE MNONIC ASSOCIATED WITH A VALUE
;
.MACRO	FLGDEF	VAL,SYM
.WORD	VAL
.RAD50	/SYM/
.ENDM
;
; PROCESS FLAGS TABLE
PFLGTB:	FLGDEF	PF.WTI,WTI
	FLGDEF	PF.WTO,WTO
	FLGDEF	PF.EXT,EXT
	FLGDEF	PF.TRA,TRA
	FLGDEF	PF.LOG,LOG
	.WORD	0,0
;
; STREAM FLAGS TABLE
SFLGTB:	FLGDEF	FG.BRK,BRK
	FLGDEF	FG.STP,STP
	FLGDEF	FG.MCR,MCR
	FLGDEF	FG.SRQ,SRQ
	FLGDEF	FG.TXT,TXT
	.WORD	0,0
;
; STREAM STATUS TABLE
STATTB:	FLGDEF	TS.RUN,RUN
	FLGDEF	TS.WCM,WCM
	FLGDEF	TS.WRQ,WRQ
	FLGDEF	TS.TSK,TSK
	FLGDEF	TS.RDY,RDY
	FLGDEF	TS.RPY,RPY
	FLGDEF	TS.EOJ,EOJ
	FLGDEF	TS.GET,GET
	FLGDEF	TS.OUT,OUT
	FLGDEF	TS.SPD,SPD
	FLGDEF	TS.EXT,EXT
	FLGDEF	TS.MCR,MCR
	FLGDEF	TS.PAS,PAS
	.WORD	0,0
;
;
;
SYMES1:
DCODE:	.ASCIZ	/TT00:   FLAGS: /
	.EVEN
;
SYMES2:	.ASCII	<TAB><SPACH>
NCODE:	.BLKB	6
	.ASCII	/  STATUS: /
SCODE:	.ASCIZ	/       FLAGS: /
	.EVEN
SYMES4:	.ASCII	/TOTAL AVAILABLE SPACE: /
SYNUM1:	.ASCII	/####      /
	.ASCII	/LARGEST FREE ELEMENT: /
SYNUM2:	.ASCII	/####/
	.BYTE	0
SYMES5:	.ASCII	/WORDS OF STACK IN USE: /
SYNUM3:	.ASCII	/     /
	.EVEN
;
;
.PAGE
; STKLST - LIST ALL CURRENTLY DEFINED VARIABLES
;
; REGISTERS DESTROYED:	R0,R1,R2
;
STKLST::MOV	R3,-(SP)
	MOV	#NULL,R2
	CALL	OUT
	MOV	STREAM,R1
	MOV	SL.LEV(R1),LEV	;GET LEXICAL LEVEL
	DEC	LEV		;MAKE BOTTOM LEVEL ZERO
	MOV	BLOCKP,STKP	;GET STACK POINTER
	MOV	SL.STB+4(R1),STBP ;GET SYMBOL TABLE POINTER
	CLR	LINP		;SET OUTPUT LINE POINTER
1$:	MOV	#LEVMES,R0	;CONVERSION BUFFER
	MOV	LEV,R1		;GET CURRENT LEVEL
	CLR	R2		;NO LEADING ZEROS
	CALL	$CBDSG		;CONVERT BINARY TO DECIMAL SIGNED
	MOVB	#LF,(R0)+
	MOVB	#CR,(R0)+
	CLRB	(R0)+		;TERMINATE STRING
	MOV	#STKMS1,R2
	CALL	OUT0
2$:	MOV	STKP,R0		;GET CURRENT STACK FRAME
	CMP	SF.STB(R0),STBP	;END OF THIS SYMBOL TABLE RANGE
	BNE	3$		;SKIP IF NOT
	TST	LINP		;ANYTHING ON LINE TO OUTPUT
	BEQ	22$
	MOV	#CRLF,R2
	CALL	OUT0
	CLR	LINP
22$:	MOV	SF.BKW(R0),STKP	;ELSE GET NEXT STACK LEVEL
	BEQ	STKDON		;BREAK IF AT BOTTOM
	DEC	LEV		;DECREMENT LEXICAL LEVEL
	BR	1$		;AND ROUND AGAIN
3$:	MOV	STBP,R2		;GET TABLE POINTER
	TST	(R2)		;END OF TABLE ?
	BEQ	STKDON
	CMP	(R2),#-1	;SEGMENT LINKAGE ?
	BNE	4$
	MOV	2(R2),STBP	;GET NEXT SEGMENT
	BR	2$
;
; OUTPUT NAMES AND VALUES IN 4 COLUMNS.
4$:	MOV	(R2)+,R0	;GET VALUE AND POINT TO NAME
	MOV	#VALBUF,R3	;GET OUTPUT BUFFER POINTER
	CMP	R0,(R0)		;IS THIS AN INDIRECT REFERANCE
	BEQ	5$		;SKIP IF NOT
	CALL	DEREF		;ELSE DEREFERANCE
	MOVB	#'@,(R3)+	;STORE INDIRECTION FLAG
5$:	MOVB	(R2)+,(R3)+	;COPY VARIABLE NAME
	BNE	5$
	INC	R2		;ROUND TO EVEN BYTE
	BIC	#1,R2
	DEC	R3		;BACKSPACE OVER EOS
	MOV	R2,STBP		;UPDATE STB POINTER
	CMP	6(R0),#M.UDF	;UNDEFINED VARIABLE
	BEQ	8$		;NO VALUE IF SO
	MOVB	#'=,(R3)+	;PUSH '=' INTO BUFFER
	MOV	6(R0),-(SP)	;SAVE MODE OF VALUE
	MOV	#M.STR,R1	;CONVERT TO STRING
	CALL	CONVRT
	MOV	(SP)+,R1	;GET BACK MODE
	CMP	R1,#M.STR	;IS VALUE A STRING
	BNE	6$
	MOVB	#'',(R3)+	;IF SO QUOTE IT
6$:	MOV	R0,R2		;POINT TO VALUE ITEM
	ADD	#10,R2		;SKIP HEADER
7$:	CMP	R3,#VBUFE	;END OF BUFFER
	BHIS	75$		;BREAK IF SO
	MOVB	(R2)+,(R3)+	;COPY STRING VALUE
	BNE	7$
	DEC	R3		;BACKSPACE OVER TERMINATOR
	CMP	R1,#M.STR	;IS IT STRING MODE
	BNE	75$
	MOVB	#'',(R3)+	;ADD TRAILING QUOTE
75$:	CALL	VOIDSP		;AND RELEASE ITEM
;
; ATTEPMT TO OUTPUT ANOTHER FIELD ON THE SAME LINE
8$:	CMP	LINP,#COL4	;ALREADY BEYOND COLUMN 4 ?
	BGT	88$
	MOV	R3,R2		;GET STRING LENGTH
	SUB	#VALBUF,R2
	ADD	LINP,R2		;GET END OF LINE
	CMP	R2,#MAXLIN	;TOO LONG ?
	BLE	9$
88$:	MOV	#CRLF,R2	;OUTPUT A NEWLINE
	CALL	OUT0		;TERMINATE LINE
	CLR	LINP		;RESET POINTER
	MOV	R3,R2
	SUB	#VALBUF,R2
;
; PAD OUT TO NEXT COLUMN WITH SPACES
; UNLESS IN COLUMN 4.
9$:	CMP	R2,#COL4
	BGE	10$
	CMP	R3,#TAB1
	BEQ	10$
	CMP	R3,#TAB2
	BEQ	10$
	CMP	R3,#TAB3
	BHIS	10$
	MOVB	#' ,(R3)+	;ADD TRAILING SPACES
	BR	9$
10$:	CLRB	(R3)		;TERMINATE STRING
	SUB	#VALBUF,R3	;GET LENGTH
	ADD	R3,LINP		;SET POINTER
	MOV	#VALBUF,R2	;POINT TO BUFFER
	CALL	OUT0		;OUTPUT STRING
	JMP	2$		;AND BACK FOR MORE
;
STKDON:	TST	LINP		;ANYTHING TO OUTPUT
	BEQ	1$
	MOV	#CRLF,R2
	CALL	OUT0
1$:	CALLR	SYSDON		;GO PRINT SPACE AND STACK
;
LEV:	.WORD	0
STKP:	.WORD	0
STBP:	.WORD	0
LINP:	.WORD	0
;
VALBUF:	.BLKB	MAXLIN+2
VBUFE=VALBUF+MAXLIN
TAB1=VALBUF+<MAXLIN/4>
TAB2=TAB1+<MAXLIN/4>
TAB3=TAB2+<MAXLIN/4>
COL4=TAB3-VALBUF
;
STKMS1:	.ASCII	<CR><LF>/STACK LEVEL /
LEVMES:	.ASCII	/       /
NULL:	.BYTE	0
CRLF:	.BYTE	CR,LF,0
	.EVEN
;
	.END