.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 ;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 ;SAVE REGISTERS MOVL R6,R3 ;COPY SYMBOL POINTER BSBB DISPSYMB ;FORMAT AND OUTPUT ENTRY POPR #^M ;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 ;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+,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 ;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