This reminds me that I had modified MPEX's LISTF,ACCESS so that it displays
on one line due to the high availability of 132 column screens. (It easier
to use the FILTER command that way, no more CONTEXT parameters.)
I called it ACCESSL (L for LONG) code below:
VAR NUMOPENERS: SHORTINT;
VAR OPENERPINS: ARRAY [1024] OF SHORTINT;
VAR OPENERFNUMS: ARRAY [1024] OF SHORTINT;
VAR I: INTEGER;
VAR RFILEUSER: TFILEUSER;
VAR ROPENFILE: TOPENFILE;
VAR LOCKSTATE: INTEGER;
VAR F: STRING[8];
VAR JOBTYPE: STRING[1];
VAR JOBNUM: INTEGER;
VAR MAXOPENPIN: INTEGER;
SUBROUTINE CLEARF;
VAR FF: STRING[8];
BEGIN
FF:=F;
F:='';
SCOPY(FF)
END;
SUBROUTINE GETFMTACCESSMODE; RFILEUSER.FMTACCESSMODE;
SUBROUTINE GETCURRENTRECORD; RFILEUSER.CURRENTRECORD(RFILE);
SUBROUTINE GETFMTJOBNUM;
BEGIN
IF JOBNUM=0 THEN 7*' '
ELSE STRWRITE('#',JOBTYPE:1,JOBNUM:5:'LEFT')
END;
SUBROUTINE GETFMTLOGON;
BEGIN
TRY
STRWRITE(VEJOBINFO(JOBTYPE,JOBNUM).FMTLOGON:'DOWNSHIFT') +
(IF JOBTYPE='S' THEN ' (ldev '+VEJOBINFO(JOBTYPE,JOBNUM).LDEVIN+')'
ELSE '')
RECOVER
SEG (STRWRITE('(original opener inaccesssible)'))
END;
SUBROUTINE DOLOADED;
VAR WROTELOADED: BOOLEAN;
VAR LOADINFO: TLOADINFO;
BEGIN
IFVERSION5 THEN
IF LOADED THEN
SEG (BEGIN
WROTELOADED:=TRUE;
LOADINFO.TYPE:=255;
WHILE ISBOOLEAN (CALL LSTD'NEXT (@LOADINFO)) DO
IF (LOADINFO.UFID)[0]=(ISDOUBLEPTR(UFID))[0] THEN
IF LOADINFO.ISPROGRAM AND LOADINFO.PROGALLOCATED THEN
WRITELN (CLEARF:10,
IF LOADINFO.PROGAUTOALLOCATED THEN "AUTOALLOCATED"
ELSE "ALLOCATED")
ELSE IF LOADINFO.ISPROCESS THEN
BEGIN
JOBTYPE:=PINJOBTYPE(LOADINFO.PROCESSPIN);
JOBNUM:=PINJOBNUMBER(LOADINFO.PROCESSPIN);
WRITELN (CLEARF:10, "LOADED":10, GETFMTJOBNUM,
LOADINFO.PROCESSPIN:4:'LEFT',
IF JOBNUM=0 OR JOBTYPE='' THEN ''
ELSE GETFMTLOGON);
END
ELSE IF LOADINFO.ISSL THEN
WRITELN (CLEARF:10, "SL LOADED");
IF F<>'' THEN
WRITELN (CLEARF:10, "LOADED":10,"SYSTEM");
END);
END;
MPEXHEADER1:="FILENAME ---TYPE--- JOBNUM PIN ---------PROGRAM----"+
"----- ACCESS RECORD -LOCK-"+
"----- SESSION NAME -----";
MPEXHEADER2:="";
MPEXHEADER3:="";
MAXOPENPIN:=1024;
FOR RFILE IN MPEXFILESETGENERAL (1, TRUE)
SELECT SEG (OPENED OR STORED OR RESTORED OR LOADED OR READING
OR STORESTAT<>0)
DO
BEGIN
F:=SCOPYFILE;
IFVERSION5 THEN
DOLOADED;
IF RESTORED OR RESTORING THEN
WRITELN (CLEARF:10, "BEING RESTORED")
ELSE IF STORED OR STORING THEN
WRITELN (CLEARF:10, "BEING STORED")
ELSE IF CBU THEN
WRITELN (CLEARF:10, "OPEN BY CONCURRENT-BACKUP");
NUMOPENERS:=0;
IF OPENED THEN
BEGIN
IFVERSION5 THEN
ROPENFILEREAD (RFILE, UFID, ROPENFILE);
TRY
CALL FOPENERS (@RFILE, (@RFILEUSER.GUFDPTR-@RFILEUSER)/2,
CALLDPARM(0), CALLDPARM(0),
@NUMOPENERS, @OPENERPINS, @OPENERFNUMS);
RECOVER;
IF NUMOPENERS=0 THEN
SEG (WRITELN (CLEARF:10, "OPENED":10,
"(accessor information unavailable)"));
(* Kludge: Would be better as a FOR loop, but then WRITELNs
within it wouldn't do the outer FOR loop's PAGEHEADs.
Too bad. EV 92/12/26. *)
I:=0;
WHILE I<MIN(NUMOPENERS,MAXOPENPIN) DO
BEGIN
RFILEUSERREAD (OPENERPINS[I], OPENERFNUMS[I], RFILEUSER);
IF OPENERPINS[I]=0 THEN
SEG (WRITELN (CLEARF:10,
"OPENED":10, "":7, "":4, "GLOBALLY":26,
GETFMTACCESSMODE:8, GETCURRENTRECORD:6))
ELSE
BEGIN
IFVERSIONXL THEN
LOCKSTATE:=-1
ELSE
LOCKSTATE:=SIGNEXTEND (CALL RIN'PIN'STATUS (ROPENFILE.RIN,
OPENERPINS[I]));
JOBTYPE:=PINJOBTYPE(OPENERPINS[I]);
JOBNUM:=PINJOBNUMBER(OPENERPINS[I]);
WRITELN (CLEARF:10, "OPENED":10, GETFMTJOBNUM,
OPENERPINS[I]:4:"LEFT",
" ",
PINPROGNAME(OPENERPINS[I]):26,
GETFMTACCESSMODE:8,
GETCURRENTRECORD:6, " ",
IF LOCKSTATE=-1 THEN " "
ELSE IF LOCKSTATE=0 THEN "LOCKER "
ELSE STRWRITE ("WAIT:", LOCKSTATE),
GETFMTLOGON);
END;
I:=I+1;
END;
END
ELSE IF READING AND VALIDCOLDLOADID THEN
WRITELN (CLEARF:10, "SYSTEM PROTECTED");
IF NUMOPENERS > MAXOPENPIN THEN
SEG( WRITELN ( CLEARF:10,
"(Output truncated: Can't recover more than ",
MAXOPENPIN," accessors)"));
END;
Tracy M. Johnson
TRW Automotive Electronics
Sensors & Components
|
