<< 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
