Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - pascal-demo/bscr.pas
There are no other files named bscr.pas in the archive.
program bscribe;

include '<pascal>pascmd.pas','<pascal>string.pas','<pascal>quasar.pas';

const
	noswitch=0;
	filex=1;
	la36=2;
	gigi=3;
	lpt=4;
	diablo=5;
	gsi=6;
	pagedfile=7;
	dover=8;
	penguin=9;
	device=10;
	hyphen=11;
	vocab=12;
	words=13;
	quiet=14;
	terse=15;
	draft=16;
	noindex=17;
	x9700=18;
	time=19;
	lastswitch=19;

var
	privs:set of 0..35;
	onechar:packed array[1..1]of char;
	devicename,draftname:packed array[1..40]of char;
	devicelength,draftlength:integer;
	tad:tadrec;
	i,ret:integer;
	infile:text;
	swdone:Boolean;
	switchtable:table;
	switchnames:array[1:lastswitch]of alfa;
	switchlengths:array[1:lastswitch]of integer;
	switches:set of 1..lastswitch;
	buf:packed array[1:100]of char;
	sbuf:packed array[1:39]of char;
	xwd:packed record case Boolean of
		true:(full:integer);
		false:(lh:0..777777B;rh:0..777777B)
		end;

initprocedure;
	begin
	switchnames[filex] := 'FILE      ';
	switchnames[la36] := 'LA36      ';
	switchnames[gigi] := 'GIGI      ';
	switchnames[lpt]  := 'LPT       ';
	switchnames[diablo] := 'DIABLO    ';
	switchnames[gsi] := 'GSI       ';
	switchnames[pagedfile] := 'PAGEDFILE ';
	switchnames[dover] := 'DOVER     ';
	switchnames[penguin] := 'PENGUIN   ';
	switchnames[device] := 'DEVICE    ';
	switchnames[hyphen] := 'HYPHEN    ';
	switchnames[vocab] := 'VOCAB     ';
	switchnames[words] := 'WORDS     ';
	switchnames[quiet] := 'QUIET     ';
	switchnames[terse] := 'TERSE     ';
	switchnames[draft] := 'DRAFT     ';
	switchnames[noindex] := 'NOINDEX   ';
	switchnames[x9700] := 'X9700     ';
	switchnames[time] := 'TIME      ';
	end;

initprocedure;
	begin
	switchlengths[filex] := 4;
	switchlengths[la36] := 4;
	switchlengths[gigi] := 4;
	switchlengths[lpt]  := 3;
	switchlengths[diablo] := 6;
	switchlengths[gsi] := 3;
	switchlengths[pagedfile] := 9;
	switchlengths[dover] := 5;
	switchlengths[penguin] := 7;
	switchlengths[device] := 6;
	switchlengths[hyphen] := 6;
	switchlengths[vocab] := 5;
	switchlengths[words] := 5;
	switchlengths[quiet] := 5;
	switchlengths[terse] := 5;
	switchlengths[draft] := 5;
	switchlengths[noindex] := 7;
	switchlengths[x9700] := 5;
	switchlengths[time] := 4;
	end;

procedure quit; extern;

procedure dodevice;
  begin
  devicelength := cmfld(devicename);
  if devicelength = 0
    then cmuerr('Null device specification')
  end;

procedure dodraft;
  begin
  draftlength := cmfld(draftname);
  if draftlength = 0
    then cmuerr('Null draft specification')
  end;

begin
devicelength := 0;
draftlength := 0;
tad.seconds := 300;

switchtable := tbmak(lastswitch+1+11);
tbadd(switchtable,filex,'FILE',0);
onechar[1] := 'F';
tbadd(switchtable,filex,onechar,1);
tbadd(switchtable,la36,'LA36',0);
onechar[1] := 'A';
tbadd(switchtable,la36,onechar,1);
tbadd(switchtable,gigi,'GIGI',0);
tbadd(switchtable,gigi,'GG',1);
tbadd(switchtable,lpt,'LPT',0);
onechar[1] := 'L';
tbadd(switchtable,lpt,onechar,1);
tbadd(switchtable,diablo,'DIABLO',0);
onechar[1] := 'D';
tbadd(switchtable,diablo,onechar,1);
tbadd(switchtable,gsi,'GSI',0);
onechar[1] := 'G';
tbadd(switchtable,gsi,onechar,1);
tbadd(switchtable,pagedfile,'PAGEDFILE',0);
tbadd(switchtable,dover,'DOVER',0);
tbadd(switchtable,penguin,'PENGUIN',0);
tbadd(switchtable,device,'DEVICE:',0);
tbadd(switchtable,hyphen,'HYPHEN',0);
onechar[1] := 'H';
tbadd(switchtable,hyphen,onechar,1);
tbadd(switchtable,vocab,'VOCAB',0);
onechar[1] := 'V';
tbadd(switchtable,vocab,onechar,1);
tbadd(switchtable,words,'WORDS',0);
onechar[1] := 'W';
tbadd(switchtable,words,onechar,1);
tbadd(switchtable,quiet,'QUIET',0);
onechar[1] := 'Q';
tbadd(switchtable,quiet,onechar,1);
tbadd(switchtable,terse,'TERSE',0);
onechar[1] := 'T';
tbadd(switchtable,terse,onechar,1);
tbadd(switchtable,draft,'DRAFT',0);
tbadd(switchtable,noindex,'NOINDEX',0);
tbadd(switchtable,x9700,'X9700',0);
tbadd(switchtable,time,'TIME:',0);

cminir('BSCRIBE>');

gjgen(100000000000B);	{an input file}
gjext('MSS');
cmfil(infile);		{This is the main part of the command}

swdone := false;
switches := [];
loop
    cmmult;	{multiple mode}
    cmcfm;	{CRLF}
    i := cmswi(switchtable);  {or switch - i is dummy return}
    i := cmdo;  {now actually do it}
    exit if i = 1;  {done if CRLF}    
    i := cmint;
    if i > 0
      then switches := switches + [i]
      else case i of
	-device: dodevice;
	-draft:  dodraft;
	-time:	 cmtn(tad);
	others:  cmuerr('This switch does not take an argument')
	end
    end;

rewrite(output,'BSCRIBE.CTL;T','/m:1');
jsys(150B{rpcap};400000B;i,i,privs);
if (18 in privs) or (19 in privs)
  then writeln('ENABLE');
jsys(20B{gtjfn},2,ret;100001B:0,-1:'SYS:SCRIBE.EXE';i);
if ret <> 2
  then begin
  writeln(tty,'? Can''t find SYS:SCRIBE.EXE');
  quit
  end;
jsys(30B{jfns};0:output,0:i,111100B:1);
writeln;
jsys(23B{rljfn},2;0:i);
jsys(30B{jfns};0:output,0:infile,111110B:1);
for i := 1 to lastswitch do
  if i in switches
    then write('/',switchnames[i]:switchlengths[i]);
if draftlength > 0
  then write('/DRAFT:',draftname:draftlength);
if devicelength > 0
  then write('/DEVICE:',devicename:devicelength);
writeln;
jsys(30B{jfns};-1:buf,0:output,111110B:1);
close(output);
close(infile);

qsrinit;
startqueue(batch,'BSCRIBE   ',buf);
qoutput(lognever);
qnotify(notifytty);
qbatchlog(logsupercede);
qlimit(tad.seconds);
doqueue(true);

end.