	.TITLE	SHOW - SHOW COMMAND EXECUTION
	.IDENT	'V03-000'
 
;
; SHOW INFORMATION DCLS COMMAND EXECUTION
;
;	SHOW DAYTIME
;	SHOW DIRECTORY
;	SHOW LOGICAL NAME EQUIVALENCES
;	SHOW PROTECTION
;	SHOW STATUS
;	SHOW DISK QUOTA AND USAGE
;
; D. N. CUTLER 15-APR-77
;
; MODIFIED BY:
;
;	V03-000	MTR0001		Mike Rhodes	17-Mar-1982
;		Fix continuation if .ASCID string defined at FAO_STRING:.
;
;	V009	TMH0009		Tim Halvorsen	27-Aug-1981
;		Fix processing of SHOW qualifiers so that unknown
;		qualifiers (like those which have been invalidated
;		due to a syntax change) are ignored.
;
;	V008	TMH0008		Tim Halvorsen	13-Jun-1981
;		Use new format of string symbol table entry,
;		a word-counted string rather than a byte-counted
;		string.
;
;	V007	TMH0007		Tim Halvorsen	28-May-1981
;		Change SHOW TRANSLATION to print "." for all
;		nonprintable characters in the equivalence string.
;
;	V006	TMH0006		Tim Halvorsen	15-Apr-1981
;		Fix SHOW SYMBOL display so that asterisk is
;		shown in the correct place.
;
;	V005	TMH0005		Tim Halvorsen	01-Apr-1981
;		In SHOW SYMBOL, display strings in double quotes.
;
;	V004	TMH0004		Tim Halvorsen	22-Mar-1981
;		Do not compress quotes from symbol names in SHOW
;		SYMBOL and SHOW TRANSLATION, since it is now being
;		done automatically by value parsing.
;
;	V003	TMH0003		Tim Halvorsen	15-Mar-1981
;		Do not change $STATUS on SHOW SYMBOL
;
;	V002	TMH0002		Tim Halvorsen	15-Feb-1981
;		Use R10 rather than FP as WRK address.
;		Rename SYM_B_NESTLEVEL to SYM_B_NONUNIQUE
;		Show binary as well as string symbols.
;		Process qualifiers which appear after the parameter
;		on SHOW SYMBOL (e.g. SHOW SYMBOL A/LOCAL)
;
;	V001	TMH0001		Tim Halvorsen	02-Sep-1980
;		Use WRK_L_RSLNXT rather than global register R10.
;		Use MDL structures and remove macro references.
;---

;
; MACRO LIBRARY CALLS
;
 
	PRCDEF				;DEFINE PROCESS WORK AREA
	WRKDEF				;DEFINE COMMAND WORK AREA
	PTRDEF				;DEFINE RESULT PARSE DESCRIPTOR FORMAT
	SYMDEF				;DEFINE SYMBOL ENTRY OFFSETS
	$CLIMSGDEF			;DEFINE ERROR/STATUS VALUES
	$LOGDEF				;DEFINE LOG OFFSETS
	$SSDEF				;DEFINE SYSTEM STATUS VALUES
	$JPIDEF				;GET JOB PROCESS INFORMATION DEFINITIONS
	$CLIDEFQUALSHOW			;DEFINE SHOW QUALIFIER NUMBERS
;
; Define system structures used
;
	$DQFDEF				; format of disk quota file record
	$FIBDEF				; format of FIB (ACP interface block)
 
;
; LOCAL DATA
;
 
	.PSECT	DCL$ZCODE,BYTE,RD,NOWRT
ACCESS:					;ALLOWED ACCESS DESIGNATORS
	.ASCII	/RWED/			;
LOGICALMSG:
	.ASCIC	'  !AS = "!AF"  !AC'
STRINGMSG:				;TABLE DISPLAY CONTROL STRING
	.ASCIC	'  !AS!AC!AS = "!AS"'
BINARYMSG:
	.ASCIC	'  !AS!AC!AS = !SL   Hex = !-!XL  Octal = !-!OW'
NOACCESS:				;NO ACCESS ALLOWED DESIGNATOR
	.ASCII	/NO ACCESS/		;
NOACCESSEND:				;
PROTECTMSG:				;DEFAULT PROTECTION CONTROL STRING
	.ASCII	/  SYSTEM=!AD, OWNER=!AD, GROUP=!AD, WORLD=!AD/ ;
PROTECTEND:				;
STATUS_MSG:				;
	.ASCII	-			;
	&  Status on  !%D!_ Elapsed CPU :!%D&;
	.ASCII	-			;
	&!/  Buff. I/O :!9UL    Cur. ws. :   !5UW!_Open files :     !5UW&;
	.ASCII	-			;
	&!/  Dir. I/O : !9UL    Phys. Mem. : !5UW!_Page Faults :!9UL&;
STATUS_END:				;
LOG_NAME_TABLE:				;OFFSETS TO TEXT STRINGS
	.BYTE	TEXT_T_UNDEF- .		;AS SELF RELATIVE DISPLACEMENTS
	.BYTE	TEXT_T_SYSTEM- .	;
	.BYTE	TEXT_T_GROUP- .		;
	.BYTE	TEXT_T_PROCESS- .	;
TEXT_T_NUMERIC:
	.ASCIC	'(numeric)'
TEXT_T_STRING:
	.ASCIC	'(string)'
TEXT_T_UNDEF:				;
	.ASCIC	/(undefined)/		;
TEXT_T_SYSTEM:				;
	.ASCIC	/(system)/		;
TEXT_T_GROUP:				;
	.ASCIC	/(group)/		;
TEXT_T_PROCESS:				;
	.ASCIC	/(process)/		;
TEXT_T_NULLSTR:				;NULL STRING (COUNTED & DESCRIPTOR)
	.LONG	0			;
JPI_CODES:				;LIST OF JPI ITEM CODES
FAO_CPUTIM=<.-JPI_CODES>*2		;FOR SHOW STATUS
	.WORD	JPI$_CPUTIM		;
	.WORD	JPI$_BUFIO		;
FAO_WSSIZE=<.-JPI_CODES>*2		;
	.WORD	JPI$_WSSIZE		;
	FAO_FILLM=<.-JPI_CODES>*2	;
	.WORD	JPI$_FILLM		;
	.WORD	JPI$_DIRIO		;
FAO_GPGCNT=<.-JPI_CODES>*2		;
	.WORD	JPI$_GPGCNT		;
	.WORD	JPI$_PAGEFLTS		;
FAO_FILCNT=<.-JPI_CODES>*2		;
FAO_Q_CPU=FAO_FILCNT			;USE THIS LOCATION TWICE
	.WORD	JPI$_FILCNT		;
FAO_PPGCNT=<.-JPI_CODES>*2		;
	.WORD	JPI$_PPGCNT		;
JPI_ARGS = <.-JPI_CODES>/2		;COMPUTE NUMBER OF JPI CODES

	.SBTTL	SHOW DIRECTORY
;+
; DCL$SHOWDIR - SHOW DIRECTORY
;
; THIS ROUTINE IS CALLED AS AN INTERNAL COMMAND TO EXECUTE THE SHOW DIRECTORY
; DCLS COMMAND.
;
; INPUTS:
;
;	R8 = ADDRESS OF SCRATCH BUFFER DESCRIPTOR.
;	R9 = ADDRESS OF SCRATCH STACK.
;	R10 = BASE ADDRESS OF COMMAND WORK AREA.
;	R11 = BASE ADDRESS OF PROCESS WORK AREA.
;
; OUTPUTS:
;
;	THE CURRENT DEFAULT DIRECTORY IS WRITTEN TO THE OUTPUT STREAM.
;-
 
DCL$SHOWDEF::				;SHOW DEVICE AND DIRECTORY INFORMATION
	ADDL	#2,4(R8)		;MAKE ROOM FOR LEADING SPACES
	MOVAB	W^DCL$T_DSKNAM,R1	;ADDRESS OF DISK NAME COUNTED STRING
	MOVZBL	(R1)+,R0		;GET QUAD WORD DESCRIPTOR
	PUSHR	#^M<R0,R1>		;PUT QUAD WORD DESCRIPTOR IN STACK
	CLRQ	-(SP)			;FIRST TWO ARGS ARE ZERO
	CLRL	-(SP)			;ALSO THIRD IS ZERO
	PUSHAQ	(R8)			;ADDRESS OF BUFFER DESCRIPTOR
	PUSHAW	(R8)			;PLACE TO RESTORE LENGTH
	PUSHAQ	20(SP)			;ADDRESS OF DESCRIPTOR IN STACK
	CALLS	#8,@#SYS$TRNLOG		;TRANSLATE AND CLEAR THE STACK
	ADDL3	(R8)+,(R8),R2		;FIND FIRST BYTE AFTER DEVICE NAME
	MOVAB	@#PIO$GT_DDSTRING,R1	;GET ADDRESS OF DEFAULT DIRECTORY STRING
	MOVZBL	(R1)+,R0		;GET LENGTH OF DEFAULT DIRECTORY STRING
	MOVC	R0,(R1),(R2)		;INSERT DEFAULT DIRECTORY STRING
	MOVL	(R8),R2			;POINT AT START OF DEVICE NAME
	MOVW	#^A/  /,-(R2)		;INSERT LEADER FOR NEATNESS
	SUBL3	R2,R3,R1		;FIND LENGTH OF STRING
	BRW	EXTMSG			;

	.SBTTL	SHOW LOGICAL NAME EQUIVALENCES
;+
; DCL$SHOWTRAN - SHOW LOGICAL NAME TRANSLATION
;
; THIS ROUTINE IS CALLED AS AN INTERNAL COMMAND TO EXECUTE THE SHOW LOGICAL
; NAME EQUIVALENCES DCLS COMMAND.
;
; INPUTS:
;
;	R8 = ADDRESS OF SCRATCH BUFFER DESCRIPTOR.
;	R9 = ADDRESS OF SCRATCH STACK.
;	R10 = BASE ADDRESS OF COMMAND WORK AREA.
;	R11 = BASE ADDRESS OF PROCESS WORK AREA.
;
; OUTPUTS:
;
;	THE SPECIFIED LOGICAL NAME EQUIVALENCE FROM THE PROCESS 
;	LOGICAL NAME TABLE IS WRITTEN TO THE OUTPUT STREAM.
;-
 
DCL$SHOWTRAN::				;SHOW THE TRANSLATION FOR A NAME
	ADDL	#PTR_C_LENGTH,WRK_L_RSLNXT(R10)	;SKIP OPTION NAME
	BSBW	DCL$GETDVAL		;SEPARATE DESCRIPTOR
	CLRL	-(R9)			;RESERVE LOCATION FOR RESULTANT TABLE
	MOVQ	R1,-(R9)		;SAVE STRING DESCRIPTOR
	ADDL3	#LOG$C_NAMLENGTH+5,4(R8),-(R9) ;BUILD EQUIV NAME DESCRIPTOR
	MOVZBL	#LOG$C_NAMLENGTH-1,-(R9) ;
	$TRNLOG_S 8(R9),(R9),(R9),16(R9) ;TRANSLATE LOGICAL NAME IN ANY TABLE
	MOVZBL	16(R9),R1		;GET RESULTANT TABLE
	INCL	R1			;INDEX INTO TEXT TABLE
	CMPL	R0,#SS$_NORMAL		;TEST FOR SUCCESSFUL TRANSLATION
	BEQL	10$			;BRANCH IF SUCCESS
	CLRL	(R9)			;ELSE CLEAR BYTE COUNT OF RESULTANT STRING
	CLRL	R1			;AND SAY NAME IS UNDEFINED
10$:	MOVAB	LOG_NAME_TABLE[R1],R0	;GET ADDRESS OF OFFSET TO TEXT
	MOVZBL	(R0),R1			;GET OFFSET
	ADDL	R0,R1			;GET ADDRESS OF ASCIC TEXT
	MOVAB	8(R9),R5		;GET ADDRESS OF NAME DESCRIPTOR
	MOVAB	(R9),R2			;GET ADDRESS OF EQUIV DESCRIPTOR
	TSTL	(R2)			;ZERO LENGTH EQUIV?
	BEQL	20$			;IF EQL YES
	CMPB	#27,@4(R2)		;FIRST CHARACTER ESCAPE?
	BNEQ	20$			;IF NEQ NO
	ADDL	#4,4(R2)		;POINT PAST EQUIV HEADER
	SUBL	#4,(R2)			;REDUCE LENGTH OF EQUIV BY HEADER
	BGEQ	20$			;IF GEQ OKAY
	CLRL	(R2)			;CLEAR EQUIV LENGTH
20$:	MOVAB	LOGICALMSG,R4		;GET ADDRESS OF ASCIC FAO STRING
	MOVZBL	(R4)+,R3		;MAKE INTO DESCRIPTOR
	MOVQ	R3,-(R9)		;PUSH ONTO STACK
	MOVQ	(R2),R2			;PICK UP LENGTH/ADDRESS OF EQUIV STRING
	$FAO_S	(R9),(R8),(R8),R5,R2,R3,R1 ;FORMAT OUTPUT MESSAGE
	MOVQ	(R8),R1			;GET OUTPUT MESSAGE PARAMETERS
	BRW	EXTMSG			;OUTPUT MESSAGE

	.SBTTL	SHOW PROTECTION
;+
; DCL$SHOWPROT - SHOW PROTECTION
;
; THIS ROUTINE IS CALLED AS AN INTERNAL COMMAND TO EXECUTE THE SHOW PROTECTION
; DCLS COMMAND.
;
; INPUTS:
;
;	R8 = ADDRESS OF SCRATCH BUFFER DESCRIPTOR.
;	R9 = ADDRESS OF SCRATCH STACK.
;	R10 = BASE ADDRESS OF COMMAND WORK AREA.
;	R11 = BASE ADDRESS OF PROCESS WORK AREA.
;
; OUTPUTS:
;
;	THE CURRENT DEFAULT PROTECTION IS CONVERTED TO ASCII AND WRITTEN TO
;	THE OUTPUT STREAM.
;-
 
DCL$SHOWPROT::				;SHOW PROTECTION INFORMATION
	MOVZWL	@#PIO$GW_DFPROT,R0	;GET DEFAULT PROTECTION
	MOVZBL	#12,R7			;SET OUTER LOOP INDEX
10$:	CLRL	-(SP)			;ALLOCATE SPACE FOR ACCESS DESIGNATORS
	MOVAB	NOACCESS,-(R9)		;ASSUME NO ACCESS ALLOWED
	MOVZBL	#NOACCESSEND-NOACCESS,-(R9) ;
	EXTZV	R7,#4,R0,R1		;EXTRACT NEXT PROTECTION FIELD
	MCOML	R1,R2			;COMPLEMENT PROTECTION FIELD
	BITL	#^XF,R2			;ALL ACCESS DENIED?
	BEQL	40$			;IF EQL YES
	CLRL	R6			;CLEAR INNER LOOP INDEX
	MOVAB	(SP),4(R9)		;SET ADDRESS OF ACCESS DESIGNATORS
	CLRL	(R9)			;CLEAR COUNT OF ACCESS DESIGNATORS
20$:	BBS	R6,R1,30$		;IF SET, ACCESS DENIED
	MOVB	ACCESS[R6],@(R9)[SP]	;INSERT ACCESS DESIGNATOR
	INCL	(R9)			;INCREMENT COUNT OF ACCESS DESIGNATORS
30$:	AOBLSS	#4,R6,20$		;ANY MORE TO CHECK?
40$:	ACBB	#0,#-4,R7,10$		;ANY MORE FIELDS TO CHECK?
	PUSHAB	PROTECTMSG		;BUILD FORMAT CONTROL STRING DESCRIPTOR
	PUSHL	#PROTECTEND-PROTECTMSG	;
	MOVL	SP,R0			;COPY ADDRESS OF CONTROL STRING DESCRIPTOR
	$FAOL_S	(R0),(R8),(R8),(R9)	;FORMAT PROTECTION MESSAGE
	MOVQ	(R8),R1			;RETRIEVE OUTPUT MESSAGE PARAMETERS
	ADDL	#6*4,SP			;CLEAN STACK
	BRW	EXTMSG			;

	.SBTTL	SHOW SYMBOL TABLE ENTRIES
;+
; DCL$SHOWSYMBOL - SHOW SYMBOL TABLE ENTRIES
;
; THIS ROUTINE IS CALLED AS AN INTERNAL COMMAND TO EXECUTE THE SHOW SYMBOL
; TABLE ENTRIES DCLS COMMAND.
;
; INPUTS:
;
;	R8 = ADDRESS OF SCRATCH BUFFER DESCRIPTOR.
;	R9 = ADDRESS OF SCRATCH STACK.
;	R10 = BASE ADDRESS OF COMMAND WORK AREA.
;	R11 = BASE ADDRESS OF PROCESS WORK AREA.
;
; OUTPUTS:
;
;	THE SPECIFIED SYMBOL TABLE ENTRY OR ALL SYMBOL TABLE ENTRIES FROM
;	EITHER THE LOCAL OR GLOBAL SYMBOL TABLE ARE WRITTEN TO THE OUTPUT
;	STREAM.
;-
 
DCL$SHOWSYMBL::				;SHOW SYMBOL TABLE ENTRIES
	SETBIT	WRK_V_NOSTAT,WRK_W_FLAGS(R10) ;DO NOT CHANGE $STATUS ON SUCCESS
	ADDL	#PTR_C_LENGTH,WRK_L_RSLNXT(R10)	;SKIP PAST OPTION DESCRIPTOR
	CLRL	-(SP)			;ZERO TABLE LISTHEAD ADDRESS
	CLRQ	R6			;ZERO DESCRIPTOR OF SYMBOL NAME
10$:	BSBW	DCL$GETDVAL		;GET NEXT DESCRIPTOR VALUE
	CMPB	#PTR_K_ENDLINE,R5	;END OF LINE?
	BEQL	30$			;BRANCH IF SO
	CMPB	#PTR_K_PARAMETR,R5	;PARAMETER?
	BNEQ	25$			;BRANCH IF QUALIFIER
	MOVQ	R1,R6			;SAVE DESCRIPTOR OF SYMBOL NAME
	BRB	10$
25$:	CMPB	R1,#CLI$K_SHSY_GLOB	;/GLOBAL?
	BEQL	20$			;BRANCH IF SO
	CMPB	R1,#CLI$K_SHSY_LOCA	;/LOCAL?
	BNEQ	10$			;IF NOT, IGNORE IT
	MOVAQ	PRC_Q_LOCAL(R11),(SP)	;SET ADDRESS OF LOCAL SYMBOL TABLE
	BRB	10$			;
20$:	MOVAQ	PRC_Q_GLOBAL(R11),(SP)	;SET ADDRESS OF GLOBAL SYMBOL TABLE
	BRB	10$			;
30$:	MOVQ	R6,R1			;GET DESCRIPTOR OF SYMBOL NAME (IF ANY)
	POPL	R6			;GET ADDRESS OF SYMBOL TABLE LISTHEAD
	TSTL	R1			;ANY SYMBOL NAME SPECIFIED?
	BNEQ	40$			;IF SO, DISPLAY IT
					;OTHERWISE, ASSUME /ALL

;
; DISPLAY ALL SYMBOL ENTRIES
;
 
	TSTL	R6			;ANY SYMBOL TABLE SPECIFIED?
	BNEQ	32$			;BR IF TABLE ADDRESS PRESENT
	MOVAQ	PRC_Q_LOCAL(R11),R6	;ASSUME /LOCAL
32$:	MOVL	R6,AP			;COPY ADDRESS OF NAME TABLE LISTHEAD
36$:	MOVL	(R6),R6			;GET ADDRESS OF NEXT ENTRY
	CMPL	R6,AP			;END OF TABLE?
	BEQL	38$			;IF EQL YES
	PUSHL	(R8)			;SAVE SIZE OF SCRATCH BUFFER
	PUSHR	#^M<R6,R9>		;SAVE REGISTERS
	MOVL	R6,R3			;COPY SYMBOL POINTER
	BSBB	DISPSYMB		;FORMAT AND OUTPUT ENTRY
	POPR	#^M<R6,R9>		;RESTORE REGISTERS
	MOVL	(SP)+,(R8)		;RESET SCRATCH BUFFER DESCRIPTOR SIZE
	BRB	36$			;
38$:	RSB				;
 
;
; DISPLAY SPECIFIED SYMBOL VALUE
;
 
40$:	MOVQ	R1,-(R9)		;SAVE SYMBOL ENTRY DESCRIPTOR
	CLRQ	-(R9)			;GUESS AT UNDEFINED
	MOVL	R6,R0			;GET ADDRESS OF SYMBOL TABLE LISTHEAD
	BNEQ	50$			;IF NEQ SPECIFIC
	BSBW	DCL$SEARCH		;SEARCH ALL LOCAL AND GLOBAL SYMBOL TABLES
	BRB	60$			;
50$:	BSBW	DCL$SEARCHT		;SEARCH SPECIFIC SYMBOL TABLE
60$:	BLBS	R0,DISPSYMB		;BRANCH IF FOUND
	ERRMSG	UNDSYM			;OUTPUT UNDEFINED SYMBOL MESSAGE
	STATUS	NORMAL			;RETURN SUCCESSFUL
	RSB

;+
; DISPSYMB - DISPLAY THE VALUE OF A GIVEN SYMBOL
;
; INPUTS:
;
;	R3 = ADDRESS OF SYMBOL TABLE ENTRY
;-
DISPSYMB:				;FORMAT A SYMBOL
	MOVAB	SYM_T_SYMBOL(R3),R2	;POINT TO SYMBOL NAME
	MOVZBL	(R2)+,R1		;GET NAME LENGTH
	MOVQ	R1,-(R9)		;BUILD NAME DESCRIPTOR
	MOVL	R9,R7			;COPY SCRATCH STACK POINTER
	MOVQ	R1,-(R9)		;BUILD NAME DESCRIPTOR AGAIN
	MOVZBL	SYM_B_NONUNIQUE(R3),(R7) ;SET LENGTH OF REMAINDER
	BEQL	DISPNORSYM		;IF EQL NOT ABBREVIATED
	SUBB	SYM_B_NONUNIQUE(R3),(R9) ;SHORTEN NAME TO ONLY UNIQUE PART
	ADDL	(R9),4(R7)		;SKIP UNQIUE PART IN REMAINDER
	MOVAB	W^DCL$GT_SYMABR,R4	;SET THE ABBREVIATION FLAG
	BRB	DISPABR			;
;
; R3 = ADDRESS OF SYMBOL TABLE ENTRY
; (R9) = DESCRIPTOR OF UNIQUE PORTION OF SYMBOL NAME
;
DISPNORSYM:				;DISPLAY SYMBOL W/ NO ABBREVIATION
	MOVAB	TEXT_T_NULLSTR,R4	;WRITE NULL AS NONUNIQUE DELIMITER
	MOVL	R4,R7			;WRITE NULL AS NONUNIQUE PORTION
;
; R3 = ADDRESS OF SYMBOL TABLE ENTRY
; R4 = ADDRESS OF ASCIC STRING BETWEEN UNIQUE AND NON-UNIQUE PORTIONS OF NAME
; R7 = ADDRESS OF DESCRIPTOR OF NONUNIQUE PORTION OF SYMBOL NAME
; (R9) = DESCRIPTOR OF UNIQUE PORTION OF SYMBOL NAME
;
DISPABR:				;DISPLAY W/ ABBREVIATION
	MOVL	R9,R5			;GET ADDRESS OF NAME DESCRIPTOR
	MOVZBL	SYM_T_SYMBOL(R3),R1	;GET LENGTH OF SYMBOL NAME
	MOVAB	SYM_T_SYMBOL+1(R3)[R1],R1 ;GET ADDRESS OF SYMBOL VALUE
	CMPB	SYM_B_TYPE(R3),#SYM_K_BINARY ;IS SYMBOL A STRING VALUE?
	BNEQ	10$			;BRANCH IF SO
	MOVL	(R1),R2			;GET BINARY VALUE
	MOVAB	BINARYMSG,R1		;DESCRIBE SYMBOL AS BINARY
	BRB	50$
10$:	MOVZWL	(R1)+,R0		;CONSTRUCT DESCRIPTOR OF STRING VALUE
	MOVQ	R0,-(R9)		;PUSH DESCRIPTOR ONTO STACK
	MOVL	R9,R2			;GET ADDRESS OF EQUIV DESCRIPTOR
	MOVAB	STRINGMSG,R1		;DESCRIBE SYMBOL AS A STRING
50$:	MOVZBL	(R1)+,R0		;MAKE INTO DESCRIPTOR
	MOVQ	R0,-(R9)		;AND PUSH ONTO STACK
	$FAO_S	(R9),(R8),(R8),R5,R4,R7,R2 ;FORMAT OUTPUT MESSAGE
	MOVQ	(R8),R1			;GET OUTPUT MESSAGE PARAMETERS
	BRW	EXTMSG			;OUTPUT MESSAGE

	.SBTTL	SHOW STATUS
;+
; DCL$SHOWSTAT - SHOW STATUS
;
; THIS ROUTINE IS CALLED AS AN INTERNAL COMMAND TO EXECUTE THE SHOW STATUS
; DCLS COMMAND.
;
; INPUTS:
;
;	R8 = ADDRESS OF SCRATCH BUFFER DESCRIPTOR.
;	R9 = ADDRESS OF SCRATCH STACK.
;	R10 = BASE ADDRESS OF COMMAND WORK AREA.
;	R11 = BASE ADDRESS OF PROCESS WORK AREA.
;
; OUTPUTS:
;
;	 VALUES CHARACTERIZING THE CURRENT PROCESS'S STATUS
;	ARE FORMATTED AND WRITTEN TO THE OUTPUT STREAM.
;
; SIDE EFFECTS:
;
;	THIS ROUTINE IS USING THE COMMAND BUFFER INSTEAD OF THE SCRATCH BUFFER
;	(THE LATTER IS USED AS SCRATCH STACK)
;-
 
DCL$SHOWSTAT::

;
; BUILD DESCRIPTOR OF EXPANSION BUFFER
;

	MOVL	4(R8),R8		;BUILD DESCRIPTOR TO EXPANSION BUFFER
					;IN SCRATCH BUFFER
	MOVZWL	#WRK_C_CMDBUFSIZ,(R8)	;LENGTH OF BUFFER
	MOVAL	WRK_G_BUFFER(R10),4(R8)	;POINTER TO START OF EXPANSION BUFFER

;
; INITIALIZE POINTERS AND INDEXES
;

 	MOVL	4(R8),R0		;POINTER TO SCRATCH BUFFER
	CLRL	R1			;INDEX INTO JPI RESULTANT LIST
	SUBL	#JPI_ARGS*4,R9		;ALLOCATE JPI RESULTANT LIST

;
; CONSTRUCT LIST OF JPI ITEM DESCRIPTOR BLOCKS IN SCRATCH BUFFER
;

10$:	MOVW	#4,(R0)+		;LENGTH OF RESULT (=LONGWORD)
	MOVW	JPI_CODES[R1],(R0)+	;JPI CODE
	MOVAL	(R9)[R1],(R0)+		;POINTER TO RESULT BUFFER (=LONGWORD)
	CLRL	(R0)+			;NO NEED FOR RESULTANT LENGTH
	AOBLEQ	#JPI_ARGS-1,R1,10$	;REPEAT FOR EACH ITEM IN LIST
	CLRL	(R0)			;END ITEM LIST

;
; GET JOB PROCESS PARAMETERS
;

	$GETJPI_S	ITMLST=@4(R8)	;

;
; PERFORM SOME ARITHMETIC ON VALUES OBTAINED
;

	SUBL	FAO_FILCNT(R9),FAO_FILLM(R9) ;COMPUTE COUNT OF OPEN FILES
	ADDL	FAO_PPGCNT(R9),FAO_GPGCNT(R9) ;COMPUTE TOTAL PHYSICAL MEMORY OCCUPIED
	EMUL	#-100000,FAO_CPUTIM(R9),- ;CALCULATE TIME IN 100NS UNITS
		#0,FAO_Q_CPU(R9)	;
	MOVAL	FAO_Q_CPU(R9),FAO_CPUTIM(R9) ;REPLACE BY POINTER TO QUADWORD
	CLRL	-(R9)			;INSERT SYSTEM TIME AND DATE AT TOP

;
; FORMAT AND PRINT INFORMATION
;

	PUSHAB	STATUS_MSG		;FAO MESSAGE TEXT
	MOVZBL	#STATUS_END-STATUS_MSG,-(SP) ;LENGTH OF MESSAGE
	MOVL	SP,R0			;
	$FAOL_S	(R0),(R8),(R8),(R9)	;BUILD MESSAGE IN SCRATCH BUFFER
	MOVQ	(R8),R1			;DESCRIPTOR OF MESSAGE
	ADDL	#2*4,SP			;CLEAN STACK
	BRW	EXTMSG			;GO OUTPUT MESSAGE


	.SBTTL	SHOW DAYTIME
;+
; DCL$SHOWTIME - SHOW DAYTIME
;
; THIS ROUTINE IS CALLED AS AN INTERNAL COMMAND TO EXECUTE THE SHOW DAYTIME
; DCLS COMMAND.
;
; INPUTS:
;
;	R8 = ADDRESS OF SCRATCH BUFFER DESCRIPTOR.
;	R9 = ADDRESS OF SCRATCH STACK.
;	R10 = BASE ADDRESS OF COMMAND WORK AREA.
;	R11 = BASE ADDRESS OF PROCESS WORK AREA.
;
; OUTPUTS:
;
;	THE CURRENT TIME AND DATE ARE CONVERTED TO ASCII AND WRITTEN TO THE
;	OUTPUT STREAM.
;-
 
DCL$SHOWTIME::				;SHOW TIME AND DATE INFORMATION
	MOVL	4(R8),R2		;GET ADDRESS OF SCRATCH BUFFER
	MOVW	#^A/  /,(R2)		;INSERT LEADING BLANKS
	ADDL	#2,4(R8)		;POINT PAST LEADING BLANKS
	$ASCTIM_S ,(R8)			;CONVERT CURRENT TIME TO ASCII
	MOVZWL	#22,R1			;SET LENGTH OF OUTPUT MESSAGE
EXTMSG:	BSBW	DCL$MSGOUT		;OUTPUT MESSAGE TEXT
	STATUS	NORMAL			;SET NORMAL COMPLETION STATUS
	RSB				;

	.SBTTL	SHOW DISK QUOTA
;++
; DCL$SHOWQUOTA - SHOW DISK QUOTA
;
;	THIS ROUTINE ASSIGNS A CHANNEL TO THE SPECIFIED DISK AND EXAMINES
;	THIS QUOTA FILE ENTRY BELONGING TO THE PROCESS' UIC, AND OUTPUTS
;	THE FORMATTED RESULT TO SYS$OUTPUT.
;
; INPUTS:
;
;	R8 = ADDRESS OF SCRATCH BUFFER DESCRIPTOR.
;	R9 = ADDRESS OF SCRATCH STACK.
;	R10 = BASE ADDRESS OF COMMAND WORK AREA.
;	R11 = BASE ADDRESS OF PROCESS WORK AREA.
;
; OUTPUTS:
;
;	VALUES FOR SPECIFIED OR DEFAULT DISK QUOTA ARE FORMATTED AND
;	WRITTEN TO THE OUTPUT STREAM.
;--

;
; LOCAL STACK USAGE
;
	.PSECT	DCL$ABS,ABS

UIC_LIST:	.BLKL	3		; GETJPI item list to read UIC
IO_STATUS:	.BLKQ	1		; I/O status block
FIB:		.BLKB	FIB$C_LENGTH	; FIB for ACP function
FIB_DESC:	.BLKQ	1		; descriptor for FIB
RECORD_DESC:	.BLKQ	1		; quota record buffer descriptor
					; re-use for FAO string descriptor
QUOTA_RECORD:	.BLKB	DQF$C_LENGTH	; quota record buffer
CHANNEL:	.BLKL	1		; channel number
DEVNAM_DESC:	.BLKQ	1		; device name descriptor
DEVNAM:		.BLKB	32		; device name buffer
IMPURE_SIZE:

;
; FAO control strings
;
	.PSECT	DCL$ZCODE

					; NOTE - ONLY SINGLE BYTE UIC FIELDS

FAO_STRING:	.ASCIC	'  User [!OB,!OB] has !SL blocks used, !SL !AC,'-
'!/  of !SL authorized and permitted overdraft of !SL blocks on !AS'
AVAIL:	.ASCIC	/available/
OVER:	.ASCIC	/OVERDRAWN/

DCL$SHOWQUOTA::
	ASSUME	IMPURE_SIZE LE <WRK_C_MSGBUFSIZ*2> ;MAKE SURE SCRATCH STACK BIG ENOUGH
	MOVAB	-IMPURE_SIZE(R9),R9		;ALLOCATE LOCAL STACK STORAGE
	MOVC5	#0,(R9),#0,#IMPURE_SIZE,(R9)	;INITIALLY ZERO
	MOVL	#DQF$C_LENGTH,RECORD_DESC(R9)	;SET QUOTA RECORD
	MOVAB	QUOTA_RECORD(R9),RECORD_DESC+4(R9) ;DESCRIPTOR
	MOVL	#FIB$C_LENGTH,FIB_DESC(R9)	;AND DESCRIPTOR FOR ACP
	MOVAB	FIB(R9),FIB_DESC+4(R9)		;FUNCTION
	CLRL	-(SP)				;ASSUME NO UIC SPECIFIED
;
; GET NEXT TOKEN
;
10$:
	BSBW	DCL$GETDVAL		;GET NEXT RESULT PARSE DESCRIPTOR
20$:
	CMPB	#PTR_K_ENDLINE,R5	;END OF LINE?
	BEQL	100$			;IF EQL YES
	CMPB	#PTR_K_COMDQUAL,R5	;COMMAND QUALIFIER?
	BNEQ	10$			;IF NEQ NO, IGNORE IT
;
; PARSE DISK NAME QUALIFIER VALUE
;
	CMPB	#CLI$K_SHQO_DISK,R1	;DISK QUALIFIER?
	BNEQ	40$			;IF NEQ NO
	BSBW	DCL$GETDVAL		;ATTEMPT TO GET VALUE
	CMPB	#PTR_K_QUALVALU,R5	;IS IT A VALUE DESCRIPTOR
	BNEQ	20$			;IF NEQ NO
	MOVQ	R1,DEVNAM_DESC(R9)	;STORE DEVICE DESCRIPTOR
	BRB	10$			;AND GO AGAIN
;
; PARSE UIC QUALIFIER VALUE
;
40$:
	CMPB	#CLI$K_SHQO_USER,R1	;USER QUALIFIER?
	BNEQ	10$			;IF NEQ NO, IGNORE IT
	BSBW	DCL$GETDVAL		;ATTEMPT TO GET VALUE
	CMPB	#PTR_K_QUALVALU,R5	;QUALIFIER VALUE?
	BNEQ	20$			;GO TRY SOMETHING ELSE
	INCL	(SP)			;FLAG UIC WAS SPECIFIED
	MOVL	R2,R5			;SAVE ADDRESS OF UIC STRING
	CMPB	#^A/[/,(R5)		;LEADING DELIMITER BRACKET?
	BNEQ	70$			;IF NEQ NO
	BSBW	DCL$CVTUIC		;CONVERT GROUP NUMBER
	CMPB	#^A/,/,(R5)		;FOLLOWED BY COMMA?
	BNEQ	70$			;IF NEQ NO
	MOVW	R0,QUOTA_RECORD+DQF$L_UIC+2(R9);SAVE GROUP NUMBER
	BSBW	DCL$CVTUIC		;CONVERT MEMBER NUMBER
	CMPB	#^A/]/,(R5)		;TRAILING BRACKET?
	BEQL	80$			;IF EQL YES
70$:
	TSTL	(SP)+			;CLEAN INDICATOR FROM STACK
	STATUS	INVUIC			;UIC SYNTAX ERROR
	BRW	99$			;EXIT WITH ERROR
80$:
	MOVW	R0,QUOTA_RECORD+DQF$L_UIC(R9);SAVE UIC MEMBER NUMBER
	BRW	10$			;GO FOR ANOTHER RESULT PARSE PIECE
;
; IF NO UIC SPECIFIED ON COMMAND, GET CURRENT PROCESS UIC
;
100$:
	TSTL	(SP)+			;WAS UIC SPECIFIED?
	BNEQ	110$			;IF NEQ YES
	MOVL	#4+<JPI$_UIC@16>,UIC_LIST(R9);SET UP GETJPI FOR
	MOVAB	QUOTA_RECORD+DQF$L_UIC(R9),UIC_LIST+4(R9) ;FOR GETTING UIC
	$GETJPI_S	ITMLST = UIC_LIST(R9);GET THIS PROCESS UIC
;
; IF NO DISK NAME SPECIFIED ON COMMAND, TRANSLATE SYS$DISK TO GET CURRENT
; DEFAULT DISK NAME
;
110$:
	MOVAB	DEVNAM_DESC(R9),R2	;GET ADDRESS OF DEVICE DESCRIPTOR
	TSTW	(R2)			;DEVICE SPECIFIED?
	BNEQ	115$			;IF NEQ YES
	MOVL	#32,(R2)		;SET CHARACTER DESCRIPTOR
	MOVAB	DEVNAM(R9),4(R2)	;FOR TRANSLATION OF SYS$DISK
	MOVAB	W^DCL$T_DSKNAM,R1	;ADDRESS OF DISK NAME COUNTED STRING
	MOVZBL	(R1)+,R0		;GET QUAD WORD DESCRIPTOR
	PUSHR	#^M<R0,R1>		;PUT QUAD WORD DESCRIPTOR IN STACK
	CLRQ	-(SP)			;FIRST TWO ARGS ARE ZERO
	CLRL	-(SP)			;ALSO THIRD IS ZERO
	PUSHAQ	(R2)			;ADDRESS OF BUFFER DESCRIPTOR
	PUSHAW	(R2)			;PLACE TO RESTORE LENGTH
	PUSHAQ	20(SP)			;ADDRESS OF DESCRIPTOR IN STACK
	CALLS	#8,@#SYS$TRNLOG		;TRANSLATE AND CLEAR THE STACK
	BLBS	R0,115$			;IF LBS SUCCESSFUL
	BRW	99$			;ELSE EXIT WITH ERROR
115$:
	ADDL3	(R2),4(R2),R3		;GET ADDRESS OF LAST CHARACTER
	CMPB	#^A/:/,-(R3)		;OF DEVICE. IS IT COLON?
	BNEQ	117$			;IF NEQ NO
	DECL	(R2)			;DISCOUNT TRAILING COLON
;
; ASSIGN A CHANNEL TO THE DISK AND GET DISK QUOTA RECORD FROM ACP
;
117$:
	$ASSIGN_S	DEVNAM = (R2),-	;ASSIGN A CHANNEL TO SPECIFIED
			CHAN   = CHANNEL(R9)	;DEVICE
	BLBS	R0,120$			;IF LBS SUCCESSFUL
	BRW	99$			;ELSE EXIT WITH ERROR
120$:
					; issue ACP function to read quota record
	MOVW	#FIB$C_EXA_QUOTA,FIB+FIB$W_CNTRLFUNC(R9)
	MOVAB	RECORD_DESC(R9),R0
	$QIOW_S		CHAN   = CHANNEL(R9),-
			FUNC   = #IO$_ACPCONTROL,-
			IOSB   = IO_STATUS(R9),-
			P1     = FIB_DESC(R9),-
			P2     = R0,-
			P4     = R0
	BLBC	R0,98$
	MOVZWL	IO_STATUS(R9),R0	;get I/O status and check it
	BLBC	R0,98$
;
; FORMAT THE INFO AND DISPLAY IT
;
	MOVAB	DEVNAM_DESC(R9),R0	;get address of dev. name descriptor
	MOVAB	FAO_STRING,R1		;point to FAO string
	MOVZBL	(R1)+,RECORD_DESC(R9)	;set its length
	MOVL	R1,RECORD_DESC+4(R9)		;and address
	MOVL	QUOTA_RECORD+DQF$L_USAGE(R9),R1	;GET BLOCKS IN USE
	MOVL	QUOTA_RECORD+DQF$L_PERMQUOTA(R9),R2 ;AND PERMANENT QUOTA
	MOVAB	AVAIL,R4			;ASSUME NOT OVERDRAWN
	SUBL3	R1,R2,R3			;COMPUTE NUMBER REMAINING
	BGEQ	130$				;IF GEQ THEN NOT OVERDRAWN
	MNEGL	R3,R3				;MAKE OVERDRAFT POSITIVE
	MOVAB	OVER,R4				;SET KEYWORD ADDRESS
130$:
	MOVL	QUOTA_RECORD+DQF$L_OVERDRAFT(R9),R5 ;get overdraft limit
					;call FAO to build the message
	$FAO_S	CTRSTR = RECORD_DESC(R9),-
		OUTLEN = (R8),-
		OUTBUF = (R8),-
		P1     = QUOTA_RECORD+DQF$L_UIC+2(R9),-
		P2     = QUOTA_RECORD+DQF$L_UIC(R9),-
		P3     = R1,-			;BLOCKS USED
		P4     = R3,-			;BLOCKS REMAINING OR OVERDRAWN
		P5     = R4,-			;"available" OR "OVERDRAWN"
		P6     = R2,-			;AUTHORIZED QUOTA
		P7     = R5,-			;AUTHORIZED OVERDRAFT
		P8     = R0			;DEVICE NAME

	BSBB	98$			;deassign the channel
	MOVQ	(R8),R1			;get string descriptor
	BRW	EXTMSG			;output and exit
;
; DEASSIGN THE CHANNEL TO THE DISK
;
98$:	PUSHL	R0			;save return status
	$DASSGN_S	CHAN = CHANNEL(R9)
	MOVL	(SP)+,R0		;restore return status
99$:
	RSB
 
	.END
