<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$CONTROL USLINIT,NOWARN,CODE,MAP                                        00010000
<<LISTEQ2>>                                                             00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$CONTROL MAIN=LISTEQ2,PRIVILEGED                                        00055000
BEGIN                                                                   00060000
    DEFINE                                                              00065000
PTITLE = ("LISTEQ5          (C) HEWLETT-PACKARD CO., 1983")#,  << 9077>>00070000
        TURNOFFTRAPS = PUSH (STATUS);                                   00075000
                       TOS.(2:1) := 0;                                  00080000
                       SET (STATUS) #;                                  00085000
EQUATE VUUFF'COL   = 8;  << Index into PTITLE. >>              <<04192>>00090000
$TITLE "PROGRAM: LISTEQ5:     FOR MPE-V"                       <<07368>>00095000
                                                                        00100000
$INCLUDE INCLVUF                                               <<04192>>00105000
                                                                        00110000
                                                                        00115000
$INCLUDE INCLPXG                                               <<06602>>00120000
COMMENT:PURPOSE                                                         00125000
THIS PROGRAM PRINTS ALL TEMP FILES AND FILE                             00130000
EQUATIONS CREATED DURING THE PRESENT JOB/SESSION.                       00135000
;                                                                       00140000
                                                                        00145000
                                                                        00150000
COMMENT: MODIFICATIONS                                                  00155000
PROGRAM MODIFIED TO INCLUDE NOLABEL OPTION 3/26/73.                     00160000
PROGRAM MODIFIED TO INCLUDE TAPE LABELS,DYNAMIC LOCKING                 00165000
                 AND FORMS ON 1/24/78.                                  00170000
INCREASED SIZE OF THE ARRAY HOLDING THE JDT, SINCE IT HAS      <<01158>>00175000
BEEN ENLARGED TO 2172 WORDS.  11/2/79                          <<01158>>00180000
PROGRAM MODIFIED TO INCLUDE FUTURE EXPANSION OF FILE COMMAND  <<<01549>>00185000
        FOR KEYWORDS "ENV=" AND "OUTQ=" ON 1/6/80             <<<01549>>00190000
;                                                                       00195000
                                                                        00200000
                                                                        00205000
COMMENT:GLOBALS                                                         00210000
OPT=POINTS TO NEXT AVAIL. OUTPUT BYTE.                                  00215000
NCH=# OF CHAR. IN OUTPUT BUFFER                                         00220000
OUTPUT=OUTPUT BYTE ARRAY.                                               00225000
ENTR=POINTS TO HEAD OF PRESENT JDT ENTRY.                               00230000
NWD=# OF WORDS IN PRESENT JDT ENTRY.                                    00235000
TEMP=POINTS TO HEAD OF TEMP FILE TABLE IN JDT.                          00240000
FEQH=POINTS TO HEAD OF FILE EQ. TABLE IN JDT.                           00245000
FEQE=POINTS TO END OF JDT TABLE                                         00250000
B=BYTE ARRAY OF ALL MESSAGES.                                           00255000
  FIRST W                                                               00260000
  FIRST CHAR OF EACH ENTRY IS OCTAL # OF                                00265000
  CHARS IN MESSAGE+200 OCTAL.                                           00270000
JDT=STORAGE FOR JDT TAVLE                                               00275000
FOPT=FOPTIONS                                                           00280000
AOPT=AOPTIONS                                                           00285000
P1=PMASK WORD 1 IN JDT ENTRY                                            00290000
P2=PMASK WORD 2 IN JDT ENTRY                                            00295000
X1=LENGTH OF B IN XHAR.                                                 00300000
X2=MAX LENGTH OF JDT TABLE(WORDS)                                       00305000
FINUM=FILE# OF LIST FILE.                                               00310000
REC=LIST RECORD LENGTH(BYTES).                                          00315000
;                                                                       00320000
                                                                        00325000
                                                                        00330000
                                                                        00335000
EQUATE X2 = 6396;     << max size of JDT= 50 sectors>>         <<07368>>00340000
EQUATE FORMS = 0;                                              <<B0.00>>00345000
EQUATE TAPE'LABEL = 1;                                         <<B0.00>>00350000
EQUATE KSAM  = 2;                                              <<B0.00>>00355000
ARRAY JDT(0:X2);                                                        00360000
BYTE POINTER OPT;                                                       00365000
DOUBLE POINTER NMJ;                                                     00370000
LOGICAL POINTER ENTR,                                                   00375000
                FEQH,                                                   00380000
                TEMP,                                                   00385000
                FEQE;                                                   00390000
INTEGER NWD,NCH,K,K2;                                                   00395000
INTEGER FINUM,REC;                                                      00400000
LOGICAL AOPT,FOPT,P1,P2;                                                00405000
BYTE ARRAY OUTPUT(0:255);                                               00410000
ARRAY OUTPUT'(*)=OUTPUT;                                                00415000
BYTE ARRAY BX2(0:4):="LIST ";                                           00420000
EQUATE X1=612;                                                 <<01549>>00425000
                                                                        00430000
                                                                        00435000
BYTE ARRAY B(0:X1):=                                                    00440000
%220,"***NO TEMP FILES",                                                00445000
%215,"***TEMP FILES",                                                   00450000
%224,"***NO FILE EQUATIONS",                                            00455000
%221,"***FILE EQUATIONS",                                               00460000
%206,":FILE ",                                                          00465000
%201,";",                                                               00470000
%201,",",                                                               00475000
%201,"=",                                                               00480000
%211,"=$STDLIST",                                                       00485000
%211,"=$NEWPASS",                                                       00490000
%211,"=$OLDPASS",                                                       00495000
%207,"=$STDIN",                                                         00500000
%210,"=$STDINX",                                                        00505000
%206,"=$NULL",                                                          00510000
%201,"F",                                                               00515000
%201,"V",                                                               00520000
%201,"U",                                                               00525000
%204,",NEW",                                                            00530000
%204,",OLD",                                                            00535000
%210,",OLDTEMP",                                                        00540000
%205,";DEV=",                                                           00545000
%206,";DISC=",                                                          00550000
%206,";NOBUF",                                                          00555000
%205,";CCTL",                                                           00560000
%203,";MR",                                                             00565000
%204,";EXC",                                                            00570000
%205,";SEMI",                                                  <<01549>>00575000
%204,";SHR",                                                            00580000
%205,";ACC=",                                                           00585000
%205,";BUF=",                                                           00590000
%204,";DEL",                                                            00595000
%205,";SAVE",                                                           00600000
%205,";TEMP",                                                           00605000
%206,";CODE=",                                                          00610000
%207,",BINARY",                                                         00615000
%206,",ASCII",                                                          00620000
%205,";REC=",                                                           00625000
%201,"*",                                                               00630000
%202,"IN",                                                              00635000
%203,"OUT",                                                             00640000
%207,"OUTKEEP",                                                         00645000
%206,"APPEND",                                                          00650000
%205,"INOUT",                                                           00655000
%206,"UPDATE",                                                          00660000
%222,"FAILURE TO GET JDT",                                              00665000
%231,"FAILURE TO OPEN LIST FILE",                                       00670000
%235,"FAILURE TO WRITE ON LIST FILE",                                   00675000
%210,";NOLABEL",                                                        00680000
%206,";LABEL",                                                 <<B0.00>>00685000
%205,";KSAM",                                                  <<B0.00>>00690000
%206,";FORMS",                                                 <<B0.00>>00695000
%205,";LOCK",                                                  <<B0.00>>00700000
%207,";NOLOCK",                                                <<B0.00>>00705000
%207,";NOCCTL",                                                <<MS.00>>00710000
%205,";NOMR",                                                  <<MS.00>>00715000
%206,";MULTI",                                                 <<MS.00>>00720000
%210,";NOMULTI",                                               <<MS.00>>00725000
%205,";WAIT",                                                  <<MS.00>>00730000
%207,";NOWAIT",                                                <<MS.00>>00735000
%207,";GMULTI",                                                <<01549>>00740000
%204,";STD",                                                   <<01549>>00745000
%204,";RIO",                                                   <<01549>>00750000
%204,";MSG",                                                   <<01549>>00755000
%204,";CIR",                                                   <<01549>>00760000
%205,";COPY",                                                  <<01549>>00765000
%207,";NOCOPY",                                                <<01549>>00770000
%377;<<END OF PRINT CONSTANTS>>                                         00775000
LOGICAL PARM=Q-4;                                                       00780000
                                                                        00785000
PROCEDURE H(A);                                                         00790000
VALUE A; INTEGER A;                                                     00795000
OPTION FORWARD;                                                         00800000
                                                                        00805000
                                                                        00810000
INTRINSIC FOPEN,FWRITE,PRINT,TERMINATE,LOADPROC;               <<07442>>00815000
                                                                        00820000
                                                                        00825000
LOGICAL PROCEDURE MOVEJDT(A,B);                                         00830000
VALUE B;LOGICAL B;ARRAY A;                                              00835000
OPTION PRIVILEGED;                                                      00840000
COMMENT:                                                                00845000
        THIS PROCEDURE FILLS A DB RELATIVE ARRAY A                      00850000
        WITH THE CONTENTS OF THE JOB DIRECTORY TABLE.                   00855000
        THE DST NUMBER FOR THE JDT IS IN LOC 5 OF THE PCBX              00860000
        FOR THE USER STACK.                                             00865000
        B IS THE MAX SIZE OF THE ARRAY A(IN WORDS). IF THE              00870000
        JDT IS BIGGER THAN THE ARRAY THEN B WORDS ARE TRANSFERED        00875000
        AND MOVEJDT IS SET FALSE OTHERWISE ITS SET TRUE.;               00880000
BEGIN                                                                   00885000
ARRAY QARRAY(*) = Q + 0;                                       <<06602>>00890000
INTEGER PCBGLOBLOC;                                            <<06602>>00895000
INTEGER S0 = S - 0;                                            <<06602>>00900000
INTEGER X=X,ADX=Q-5;                                                    00905000
EQUATE JDT=5;                                                           00910000
LOGICAL DSTN,LXK;                                                       00915000
ARRAY XDB(*)=DB+0;                                                      00920000
                                                               <<01.01>>00925000
LOGICAL PROCEDURE EXCHANGEDB(A);                                        00930000
VALUE A;LOGICAL A;OPTION EXTERNAL;                                      00935000
                                                               <<01.01>>00940000
<< get the JDT DST number from the PXGLOBAL area >>            <<06295>>00945000
                                                               <<06295>>00950000
PXGLOBAL;                                                      <<06602>>00955000
DSTN := PXG'JDTDST;                                            <<06602>>00960000
TOS:=ADX;                                                               00965000
PUSH(DL);                                                               00970000
ASSEMBLE(SUB,ZERO);                                                     00975000
<< exchangeDB to the JDT DST   >>                              <<06295>>00980000
LXK:=EXCHANGEDB(DSTN);                                                  00985000
TOS:=IF(MOVEJDT:=B>=XDB(4)) THEN XDB(4) ELSE B;                         00990000
ASSEMBLE(MVBL,3);                                                       00995000
<< exchangeDB to the JDT DST   >>                              <<06295>>01000000
EXCHANGEDB(LXK);                                                        01005000
END;                                                                    01010000
                                                                        01015000
                                                                        01020000
                                                                        01025000
PROCEDURE A(N);                                                         01030000
VALUE N;INTEGER N;                                                      01035000
COMMENT:                                                                01040000
  MOVES MESSAGE N FROM ARRAY B                                          01045000
  TO OUTPUT BUFFER(FIRST MESSAGE # 0);                                  01050000
BEGIN                                                                   01055000
INTEGER I;                                                              01060000
I:=-1;                                                                  01065000
N:=N+1;                                                                 01070000
WHILE 0<=(N:=N-1) DO                                                    01075000
  DO I:=I+1 UNTIL B(I)>%200;                                            01080000
  N:=B(I)-%200;                                                         01085000
  MOVE OPT:=B(I+1),(N),2;                                               01090000
  @OPT:=TOS;                                                            01095000
  NCH:=NCH+N;                                                           01100000
END;                                                                    01105000
                                                                        01110000
                                                                        01115000
                                                                        01120000
PROCEDURE OUTFORM;                                             <<01.01>>01125000
COMMENT:                                                                01130000
  PLACES THE FORMAL DESIGNATOR OF THE JDT ENTRY                         01135000
  POINTED TO BY ENTR IN THE OUTPUT BUFFER;                              01140000
BEGIN                                                                   01145000
BYTE POINTER B2;                                                        01150000
INTEGER C,I;                                                            01155000
C:=2*ENTR.(8:8);                                                        01160000
@B2:=(1+@ENTR)*2;                                                       01165000
I:=-1;                                                                  01170000
WHILE C>(I:=I+1) DO                                                     01175000
  BEGIN                                                                 01180000
  IF B2(I)>=%200 THEN                                                   01185000
    BEGIN                                                               01190000
    B2(I):=B2(I)-%200;                                                  01195000
    IF I<>0 THEN                                                        01200000
      BEGIN                                                             01205000
      OPT:=".";                                                         01210000
      @OPT:=@OPT+1;                                                     01215000
      NCH:=NCH+1;                                                       01220000
      END;                                                              01225000
  END;                                                                  01230000
IF B2(I)=" " THEN RETURN;                                               01235000
OPT:= B2(I);                                                            01240000
@OPT:=@OPT+1;                                                           01245000
NCH:=NCH+1;                                                             01250000
END;                                                                    01255000
END;                                                                    01260000
                                                                        01265000
                                                                        01270000
                                                                        01275000
PROCEDURE OUTACT;                                              <<01.01>>01280000
COMMENT:                                                                01285000
  PLACES THE ACTUAL FILE DESIGNATOR OF THE JDT                          01290000
  ENTRY POINTED TO BY ENTR IN THE OUTPUT BUFFER;                        01295000
BEGIN                                                                   01300000
BYTE POINTER B2;                                                        01305000
INTEGER I;                                                              01310000
I:=(ENTR(ENTR.(8:8)+3).(0:8));                                          01315000
@B2:=(@ENTR+INTEGER(ENTR.(8:8))+4)*2;                                   01320000
MOVE OPT:=B2,(I),2;                                                     01325000
@OPT:=TOS;                                                              01330000
NCH:=NCH+I;                                                             01335000
END;                                                                    01340000
                                                                        01345000
                                                                        01350000
                                                                        01355000
PROCEDURE OUTDEV;                                              <<01.01>>01360000
COMMENT:                                                                01365000
  PLACES THE DEVICE NAME IN THE JDT ENTRY                               01370000
  POINTED TO BY ENTR IN THEN OUTPUT BUFFER;                             01375000
BEGIN                                                                   01380000
BYTE POINTER B2;                                                        01385000
INTEGER I;                                                              01390000
INTEGER DEVPART, KEYPART;  <<DEVICE SPECIFICATION, KEYWORD=>> <<<01549>>01395000
BYTE ARRAY TEMP(0:120);  << Temporary storage for string. >>   <<06153>>01400000
<<>>                                                          <<<01549>>01405000
I:=(ENTR(ENTR.(8:8)+3)).(8:8);                                          01410000
@B2:=(@ENTR+INTEGER(ENTR.(8:8))+4)*2                                    01415000
     +INTEGER((ENTR(ENTR.(8:8)+3)).(0:8));                              01420000
TEMP := %15; <<CR>>                                           <<<01549>>01425000
MOVE TEMP(1) := TEMP, (119); << Fill with CR. >>               <<06153>>01430000
MOVE TEMP := B2, (I) ;                                        <<<01549>>01435000
SCAN TEMP UNTIL %6473, 1; <<FIND CR,SEMICOLON>>               <<<01549>>01440000
DEVPART := TOS - @TEMP;                                       <<<01549>>01445000
KEYPART := I - DEVPART -1;                                    <<SP.ENV>>01450000
MOVE OPT := B2, (DEVPART), 2;                                 <<<01549>>01455000
@OPT:=TOS;                                                              01460000
NCH := NCH + DEVPART;                                         <<<01549>>01465000
IF P2.(10:1) OR P2.(11:1) THEN                                          01470000
   BEGIN                                                                01475000
   A(6);                                                                01480000
   I := INTEGER(ENTR(K+6)); << GET PRI AND # COPIES >>                  01485000
   IF P2.(11:1) THEN H(I.(0:4));                                        01490000
   IF P2.(10:1) THEN BEGIN A(6); H(I.(4:7)); END;                       01495000
   END;                                                                 01500000
IF KEYPART  > 0 THEN   <<EXTRACT KEYWORDS FROM>>              <<SP.ENV>>01505000
   BEGIN            <<DEVICE FIELD: "ENV=", "OUTQ=", ETC>>    <<<01549>>01510000
   IF DEVPART = 0 AND NOT (P2.(10:1) LOR P2.(11:1)) THEN       <<01854>>01515000
      BEGIN                                                    <<01854>>01520000
      NCH := NCH - 5;                                          <<01854>>01525000
      @OPT := @OPT - 5;                                        <<01854>>01530000
      END;                                                     <<01854>>01535000
   @B2 := @B2 + DEVPART;                                      <<<01549>>01540000
   MOVE OPT := B2 , (KEYPART) , 2;                            <<<01549>>01545000
   @OPT := TOS;                                               <<<01549>>01550000
   NCH := NCH + KEYPART;                                      <<<01549>>01555000
   END;                                                       <<<01549>>01560000
END;                                                                    01565000
                                                                        01570000
                                                                        01575000
LOGICAL PROCEDURE BUMP(A);                                     <<01.01>>01580000
VALUE A;POINTER A;                                                      01585000
COMMENT:                                                                01590000
  SETS ENTR TO THE NEXT ENTRY UNLESS THIS                               01595000
  WOULD MAKE @ENTR > @A. BUMP:=TRUE IF ENTR WAS MOVED;         <<01.01>>01600000
BEGIN                                                                   01605000
BUMP := TRUE;                                                  <<01.01>>01610000
IF (INTEGER(A)+@JDT)<=(@ENTR+NWD) THEN                                  01615000
  BEGIN                                                                 01620000
  BUMP := FALSE;                                               <<01.01>>01625000
  RETURN;                                                               01630000
  END;                                                                  01635000
@ENTR:=@ENTR+NWD;                                                       01640000
NWD:=ENTR.(0:8);                                                        01645000
END;                                                                    01650000
                                                                        01655000
                                                                        01660000
PROCEDURE QUIT(A2);                                                     01665000
VALUE A2;INTEGER A2;                                                    01670000
COMMENT:                                                                01675000
  PRINTS ERROR AND TERMINATES;                                          01680000
BEGIN                                                                   01685000
INTRINSIC TERMINATE;                                                    01690000
INTRINSIC PRINT;                                                        01695000
NCH:=0;                                                                 01700000
@OPT:=@OUTPUT;                                                          01705000
A(A2);                                                                  01710000
PRINT(OUTPUT',-NCH,0);                                         <<01.01>>01715000
TERMINATE;                                                              01720000
END;                                                                    01725000
                                                                        01730000
                                                                        01735000
                                                                        01740000
                                                                        01745000
PROCEDURE G;                                                            01750000
COMMENT:                                                                01755000
  PRINTS A LINE OF OUTPUT NCH CHAR LING ON LIST;                        01760000
BEGIN                                                                   01765000
INTRINSIC FWRITE;                                                       01770000
FWRITE(FINUM,OUTPUT',-NCH,0);                                  <<01.01>>01775000
IF<>THEN QUIT(46);                                                      01780000
@OPT:=@OUTPUT;                                                          01785000
NCH:=0;                                                                 01790000
END;                                                                    01795000
                                                                        01800000
                                                                        01805000
PROCEDURE H(A);                                                         01810000
VALUE A;INTEGER A;                                                      01815000
COMMENT:                                                                01820000
  TURNS A INTO A BASE 10 INTEGER AND PUTS                               01825000
  INTO THE OUTPUT BUFFER;                                               01830000
BEGIN                                                                   01835000
INTRINSIC ASCII;                                                        01840000
TOS:=ASCII(A,10,OPT);                                                   01845000
ASSEMBLE(DUP);                                                          01850000
@OPT:=@OPT+TOS;                                                         01855000
NCH:=NCH+TOS;                                                           01860000
END;                                                                    01865000
                                                                        01870000
                                                                        01875000
                                                                        01880000
PROCEDURE X(A);                                                         01885000
VALUE A;DOUBLE A;                                                       01890000
COMMENT:                                                                01895000
  TURNS A INTO A DOUBLE BASE 10 INTEGER AND PUTS                        01900000
  IN THE OUTPUT BUFFER;                                                 01905000
BEGIN                                                                   01910000
INTRINSIC DASCII;                                                       01915000
TOS:=DASCII(A,10,OPT);                                                  01920000
ASSEMBLE(DUP);                                                          01925000
@OPT:=@OPT+TOS;                                                         01930000
NCH:=NCH+TOS;                                                           01935000
END;                                                                    01940000
PROCEDURE FORMS'LABEL'KSAM(TYPE);                              <<B0.00>>01945000
   VALUE TYPE;                                                 <<B0.00>>01950000
   INTEGER TYPE;                                               <<B0.00>>01955000
                                                               <<B0.00>>01960000
COMMENT:                                                       <<B0.00>>01965000
   PLACES THE INFORMATION IN THE FORMSMSG ARRAY                <<B0.00>>01970000
   IN THE OUTPUT BUFFER;                                       <<B0.00>>01975000
                                                               <<B0.00>>01980000
BEGIN                                                          <<B0.00>>01985000
BYTE POINTER B2;                                               <<B0.00>>01990000
<< NOTE THAT ENTR(K+2) = LENGTH OF ARRAY>>                     <<06295>>01995000
<< AND THAT  ENTR(K+3) = ARRAY          >>                     <<06295>>02000000
INTEGER I;                                                     <<B0.00>>02005000
BYTE POINTER EOF;                                              <<B0.00>>02010000
                                                               <<B0.00>>02015000
I := ENTR(K+2);                                                <<06295>>02020000
IF I=0 THEN RETURN;                                            <<B0.00>>02025000
CASE TYPE OF                                                   <<B0.00>>02030000
BEGIN  <<CASE>>                                                <<B0.00>>02035000
                                                               <<B0.00>>02040000
   BEGIN <<FORMS>>                                             <<B0.00>>02045000
      @B2 := (@ENTR(K+3))*2;                                   <<06295>>02050000
      SCAN B2 UNTIL "..",1;                                    <<B0.00>>02055000
      @EOF := TOS;                                             <<B0.00>>02060000
      IF @EOF > @B2 THEN                                       <<B0.00>>02065000
         BEGIN                                                 <<B0.00>>02070000
            A(7);                                              <<B0.00>>02075000
            MOVE OPT := B2,(I := @EOF - @B2 + 1),2;            <<B0.00>>02080000
            @OPT := TOS;                                       <<B0.00>>02085000
            NCH := NCH + I;                                    <<B0.00>>02090000
         END;                                                  <<B0.00>>02095000
   END;   <<FORMS>>                                            <<B0.00>>02100000
                                                               <<B0.00>>02105000
   BEGIN  <<LABEL>>                                            <<B0.00>>02110000
      @B2 := (@ENTR(K+3))*2;                                   <<06295>>02115000
      SCAN B2 UNTIL "..",1;                                    <<B0.00>>02120000
      @EOF := TOS;                                             <<B0.00>>02125000
      IF I > @EOF - @B2 +1 THEN                                <<B0.00>>02130000
         BEGIN                                                 <<B0.00>>02135000
            A(7);                                              <<B0.00>>02140000
            I := I - (@EOF - @B2) -2;                          <<B0.00>>02145000
            MOVE OPT := EOF(1) ,(I),2;                         <<B0.00>>02150000
            @OPT := TOS;                                       <<B0.00>>02155000
            NCH := NCH + I;                                    <<B0.00>>02160000
         END;                                                  <<B0.00>>02165000
   END;    <<LABEL>>                                           <<B0.00>>02170000
                                                               <<B0.00>>02175000
END; <<CASE>>                                                  <<B0.00>>02180000
END; <<FORMS'LABEL'KSAM>>                                      <<B0.00>>02185000
                                                                        02190000
                                                                        02195000
                                                                        02200000
<<****************** MAIN ******************************************>>  02205000
                                                                        02210000
                                                                        02215000
TURNOFFTRAPS;                                                           02220000
<<OPEN LIST FILE>>                                                      02225000
FINUM:=FOPEN(BX2,IF PARM THEN %14 ELSE %2014,1);                        02230000
IF <>THEN QUIT(45);                                                     02235000
<< move the program title into the output buffer. Compute >>   <<06295>>02240000
<< the number of characters; and then move in the official>>   <<06295>>02245000
<< VUF number to the output buffer, and then write it to  >>   <<06295>>02250000
<< the output device.                                     >>   <<06295>>02255000
                                                               <<06295>>02260000
   MOVE OUTPUT := PTITLE,2;                                    <<01.01>>02265000
   NCH := TOS-@OUTPUT;                                         <<01.01>>02270000
   MOVE OUTPUT( VUUFF'COL ) := OFFICIAL'VUUFF;                 <<04192>>02275000
   FWRITE (FINUM,OUTPUT',-NCH,0);                              <<01.01>>02280000
<< check to see if we are running on an MPEIV system. IF >>    <<07442>>02285000
<< we are then kill the program because this is MPEV     >>    <<07442>>02290000
                                                               <<07442>>02295000
MOVE OUTPUT := "MPE ";  << the procedure MPE >>                <<07442>>02300000
LOADPROC( OUTPUT, 0, K );  << search system SL >>              <<07442>>02305000
IF =                                                           <<07442>>02310000
THEN BEGIN                                                     <<07442>>02315000
  TOS := 0;     << This will be the return value   >>          <<07442>>02320000
  TOS := K;                                                    <<07442>>02325000
  ASSEMBLE( PCAL 0 );  << call MPE >>                          <<07442>>02330000
  IF TOS = 5 THEN GOTO MPEV;                                   <<07442>>02335000
END;                                                           <<07442>>02340000
                                                               <<07442>>02345000
<< This isn't MPE-V, tell the user and terminate >>            <<07442>>02350000
K := MOVE OUTPUT :=                                            <<07442>>02355000
   "This version will work only on MPE-V";                     <<07442>>02360000
FWRITE(FINUM, OUTPUT',-K,0);                                   <<07442>>02365000
TERMINATE;                                                     <<07442>>02370000
MPEV:    << we only get here if running on an MPEV system >>   <<07442>>02375000
                                                               <<07442>>02380000
<<SET UP HEAD OF TABLE POINTERS>>                                       02385000
@TEMP:=@JDT+2;                                                          02390000
@FEQH:=@JDT+3;                                                          02395000
@FEQE:=@JDT+4;                                                          02400000
<<GET JDT>>                                                             02405000
IF NOT MOVEJDT(JDT,X2) THEN QUIT(44);                                   02410000
<< print a line zero chars long with procedure G          >>   <<06295>>02415000
NCH:=0;                                                                 02420000
G;                                                                      02425000
<< move the starting address of the TEMP files table to   >>   <<06295>>02430000
<< pointer ENTR.                                          >>   <<06295>>02435000
                                                               <<06295>>02440000
@ENTR:=TEMP;                                                            02445000
<<LIST TEMP FILES>>                                                     02450000
<< if the address of TEMP file table = the address of the >>   <<06295>>02455000
<< job file equation table then there are not TEMP files. >>   <<06295>>02460000
<< In this case call procedure A which prints "*** NO TEMP>>   <<06295>>02465000
<< FILES",  procedure G writes the message. then go process>>  <<06295>>02470000
<< the file equations (GO FEQ)                            >>   <<06295>>02475000
                                                               <<06295>>02480000
IF @ENTR=INTEGER(FEQH) THEN BEGIN A(0);G;GO FEQ;END;                    02485000
@ENTR:=@ENTR+@JDT;                                                      02490000
<< get the entry size from the first word of the entry    >>   <<06295>>02495000
NWD:=ENTR.(0:8);                                                        02500000
<< print header "*** TEMP FILES"  >>                           <<06295>>02505000
A(1);                                                                   02510000
<< print two blank lines          >>                           <<06295>>02515000
G;G;                                                                    02520000
<< loop through the JOB TEMP file table printing out the  >>   <<06295>>02525000
<< names of the temporary files.                          >>   <<06295>>02530000
MORE:                                                                   02535000
<< put formal designator of JDT entry pointed to by ENTR  >>   <<06295>>02540000
<< in output buffer and then print it. (G)                >>   <<06295>>02545000
                                                               <<06295>>02550000
OUTFORM; G;                                                    <<01.01>>02555000
IF BUMP(FEQH) THEN GO MORE;                                    <<01.01>>02560000
<< begin processing and printing file equations from JFEQ >>   <<06295>>02565000
FEQ:                                                                    02570000
<< print a blank line.  >>                                     <<06295>>02575000
G;                                                                      02580000
<< set ENTR to the beginning of the File Equation Table.  >>   <<06295>>02585000
@ENTR:=FEQH;                                                            02590000
<<LIST FILE EQUATIONS>>                                                 02595000
<< is the index to JFEQ equal to index to beginning of    >>   <<06295>>02600000
<< JLEQ table?                                            >>   <<06295>>02605000
IF @ENTR=INTEGER(FEQE) THEN BEGIN A(2);GO DONE;END;                     02610000
@ENTR:=@ENTR+@JDT;                                                      02615000
NWD:=ENTR.(0:8);                                                        02620000
<< print "*** FILE EQUATIONS" and then 2 blank lines (G)  >>   <<06295>>02625000
A(3);                                                                   02630000
G;G;                                                                    02635000
OVR:                                                                    02640000
<< print "FILE" >>                                             <<06295>>02645000
A(4);                                                                   02650000
OUTFORM;                                                       <<01.01>>02655000
<< put contents of PMASK words in P1 and P2 .             >>   <<06295>>02660000
P1:=ENTR(ENTR.(8:8)+1);                                                 02665000
P2:=ENTR(ENTR.(8:8)+2);                                                 02670000
<< look at NAME bit and POINTER ENTRY bit in PMASK        >>   <<06295>>02675000
IF P1.(15:1) THEN A(7);                                                 02680000
IF P2.(6:1) THEN BEGIN A(37);OUTACT;GO NMORE;END;              <<01.01>>02685000
<< put actual designator in output buffer.                >>   <<06295>>02690000
OUTACT;                                                        <<01.01>>02695000
K:=ENTR(ENTR.(8:8)+3);                                                  02700000
K2:=(K.(8:8)+K.(0:8)+1)/2;                                              02705000
<< K2 is length of name-actual designator + dev name      >>   <<06295>>02710000
K:=ENTR.(8:8)+3;                                                        02715000
<< get FOPTION and AOPTION words.                         >>   <<06295>>02720000
FOPT:=ENTR(K:=K+K2+1);                                                  02725000
AOPT:=ENTR(K:=K+1);                                                     02730000
K:=K+1;                                                                 02735000
<< look at the DEFLT DESIGNATOR, DOMAIN, DEVICE bits in   >>   <<06295>>02740000
<< the PMASK.  Use proc. A to put in the proper info in   >>   <<06295>>02745000
<< the output buffer.  Procedure OUTDEV places the device >>   <<06295>>02750000
<< name in the JDT entry and then in the output buffer.   >>   <<06295>>02755000
                                                               <<06295>>02760000
IF P1.(11:1) THEN A(FOPT.(10:3)+7);                                     02765000
IF P1.(13:1) THEN A(FOPT.(14:2)+17);                                    02770000
IF P1.(14:1) OR P2.(10:1) OR P2.(11:1) THEN BEGIN              <<01.01>>02775000
      A(20); OUTDEV; END;                                      <<01.01>>02780000
IF (P1 LAND %140050)<>0 THEN                                            02785000
  BEGIN                                                                 02790000
  A(36);                                                                02795000
  IF P1.(1:1) THEN H(ENTR(K+1));                                        02800000
IF (P1 LAND %100050)=0 THEN GO XTT;                                     02805000
A(6);                                                                   02810000
<< look at block factor, if there's a blocking factor     >>   <<06295>>02815000
<< translate it into base 10 and put it into output buffer>>   <<06295>>02820000
                                                               <<06295>>02825000
IF P1.(0:1) THEN H(ENTR(K+2).(8:8));                                    02830000
<< if ASCII/BINARY and RECORD FORMAT bits not set go to XTT>>  <<06295>>02835000
IF (P1 LAND %50)=0 THEN GO XTT;                                         02840000
A(6);                                                                   02845000
<< if RECORD FORMAT bit set move record format message to>>    <<06295>>02850000
<< to output buffer.                                     >>    <<06295>>02855000
IF P1.(10:1) THEN A(14+FOPT.(8:2));                                     02860000
<<is bit 12 set in PMASK 1? no; goto XTT else move in msg.>>   <<06295>>02865000
IF (P1 LAND %10)=0 THEN GO XTT;                                         02870000
IF P1.(12:1) THEN A(FOPT.(13:1)+34);                                    02875000
END;                                                                    02880000
XTT:                                                                    02885000
<< look at FILESIZE/NUMEXTS/INIT ALLOC bits in PMASK(13:3)>>   <<06295>>02890000
IF P2.(13:3)<>0 THEN                                                    02895000
  BEGIN                                                                 02900000
A(21);                                                                  02905000
@NMJ:=@ENTR+K+3;                                                        02910000
IF P2.(13:1) THEN X(NMJ);                                               02915000
IF P2.(14:2)=0 THEN GO YTT;                                             02920000
A(6);                                                                   02925000
IF P2.(14:1) THEN H(ENTR(K+2).(0:5)+1);  << SERIES II >>                02930000
IF P2.(15:1)=0 THEN GO YTT;                                             02935000
A(6);                                                                   02940000
IF P2.(15:1) THEN H(ENTR(K).(8:5)+1); << SERIES II >>                   02945000
END;                                                                    02950000
YTT:                                                                    02955000
<< if inhibit buffering then put in "NOBUF" to output buff>>   <<06295>>02960000
IF P1.(4:1) THEN IF AOPT.(7:1) THEN A(22);                              02965000
<< if carriage control bit on put in "CCTL" else "MULTI">>     <<06295>>02970000
IF P1.(9:1) THEN IF FOPT.(7:1) THEN                            <<MS.00>>02975000
   A(23) ELSE A(53);                                           <<MS.00>>02980000
<< if multirecord bit on put in "MR" else "NOMULTI"       >>   <<06295>>02985000
IF P1.(6:1) THEN IF AOPT.(11:1) THEN                           <<MS.00>>02990000
   A(24) ELSE A(54);                                           <<MS.00>>02995000
IF P1.(5:1) THEN A(AOPT.(8:2)+24);                                      03000000
IF P1.(7:1) THEN BEGIN A(28); A(AOPT.(12:4)+38); END;                   03005000
IF P1.(3:1) THEN BEGIN A(29); H(ENTR(K).(0:8));END;                     03010000
<< deal with file disposition (DEL,TEMP,SAVE)             >>   <<06295>>03015000
IF P1.(2:1) THEN                                                        03020000
  BEGIN                                                                 03025000
  IF ENTR(K).(13:1) THEN A(30);                                         03030000
  IF ENTR(K).(14:1) THEN A(32);                                         03035000
  IF ENTR(K).(15:1) THEN A(31);                                         03040000
  END;                                                                  03045000
IF P1.(8:1) THEN  <<COPY>>                                     <<01549>>03050000
  CASE AOPT.(3:1) OF                                           <<01549>>03055000
    BEGIN                                                      <<01549>>03060000
    A(65);  <<NOCOPY>>                                         <<01549>>03065000
    A(64);  <<COPY>>                                           <<01549>>03070000
    END;                                                       <<01549>>03075000
IF P2.(12:1) THEN BEGIN A(33);H(ENTR(K+5)); END;                        03080000
IF P2.(9:1) THEN  <<MULTIACCESS>>                              <<01549>>03085000
  CASE AOPT.(5:2) OF                                           <<01549>>03090000
    BEGIN                                                      <<01549>>03095000
    A(56);  <<NOMULTI>>                                        <<01549>>03100000
    A(55);  <<MULTI>>                                          <<01549>>03105000
    A(59);  <<GMULTI>>                                         <<01549>>03110000
    END;                                                       <<01549>>03115000
IF P2.(8:1) THEN IF AOPT.(4:1) THEN                            <<01549>>03120000
   A(58) ELSE A(57);                                           <<01549>>03125000
<<LABELED TAPES>>                                              <<B0.00>>03130000
K := K + 7;                                                    <<B0.00>>03135000
<< K is at the reference count/# user labels word.        >>   <<06295>>03140000
IF P2.(1:1) AND NOT FOPT.(6:1) THEN                            <<01098>>03145000
   A(47)                     << NOT LABELED >>                 <<01098>>03150000
ELSE IF P2.(1:1) THEN        << LABELED >>                     <<01098>>03155000
   BEGIN                                                       <<01098>>03160000
         A(48);                                                <<B0.00>>03165000
         FORMS'LABEL'KSAM(TAPE'LABEL);                         <<B0.00>>03170000
         END;                                                  <<B0.00>>03175000
IF P2.(0:1) THEN  <<FILE TYPE>>                                <<01549>>03180000
  CASE FOPT.(2:3) OF                                           <<01549>>03185000
    BEGIN                                                      <<01549>>03190000
    A(60);  <<STD>>                                            <<01549>>03195000
    A(49);  <<KSAM>>                                           <<01549>>03200000
    A(61);  <<RIO>>                                            <<01549>>03205000
    ;       <<UNDEFINED>>                                      <<01549>>03210000
    A(63);  <<CIR>>                                            <<01549>>03215000
    ;       <<UNDEFINED>>                                      <<01549>>03220000
    A(62);  <<MSG>>                                            <<01549>>03225000
    END;                                                       <<01549>>03230000
IF P2.(2:1) THEN BEGIN         <<FORMS  >>                     <<B0.00>>03235000
                  A(50);                                       <<B0.00>>03240000
                  FORMS'LABEL'KSAM(FORMS);                     <<B0.00>>03245000
                  END;                                         <<B0.00>>03250000
IF P2.(7:1) THEN IF AOPT.(10:1) THEN                           <<B0.00>>03255000
   A(51)                      <<DYNAMIC LOCK>>                 <<B0.00>>03260000
   ELSE A(52);                <<NOLOCK>>                       <<B0.00>>03265000
NMORE:                                                                  03270000
G;                                                                      03275000
IF BUMP(FEQE) THEN GO OVR;                                     <<01.01>>03280000
DONE:                                                                   03285000
G;G;G;                                                                  03290000
END.                                                                    03295000
