Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
5-galaxy/qf.ps
There are no other files named qf.ps in the archive.
%!PS-Adobe-
%%Title: qf.pas
%%Creator: REVER by Todd Koumrian, SRI International 1989
%%For: VIVIAN
%%CreationDate: Mon Nov 13 21:30:34 1989
%%DocumentFonts: /Courier
%%Pages: (atend)
%%EndComments
% Prelude for REVER - by Todd Koumrian, 13-Feb-89
/SF {findfont exch scalefont setfont} bind def
/SL {/LS exch def} bind def
/LM 54 def
/TM 756 def
/RFRM {LM TM moveto} bind def
/STPG { /PGSV save def /PN 0 def } bind def
/EOPG { showpage PGSV restore } bind def
/MDP {
/STPN { RFRM } bind def
/EOPN { EOPG } bind def
} bind def
/MDB {
/STPN { /PNSV save def 612 PN 2 mod 0 eq {0} {396} ifelse translate
90 rotate 0.6471 0.7727 scale RFRM } bind def
/EOPN {PNSV restore PN 2 mod 1 eq {EOPG} {/PN PN 1 add def} ifelse} bind def
} bind def
/MDL {
/STPN { 1 792 translate -90 rotate 0.7727 dup scale RFRM } bind def
/EOPN { EOPG } bind def
} bind def
/MDQV {
/STPN { /PNSV save def PN 2 mod 0 eq {0 393 translate} if
PN 4 mod 2 ge {306 0 translate} if 0.5 0.5 scale RFRM } bind def
/EOPN {PNSV restore PN 4 mod 3 eq {EOPG} {/PN PN 1 add def} ifelse} bind def
} bind def
/MDQH {
/STPN { /PNSV save def PN 2 mod 1 eq {306 0 translate} if
PN 4 mod 2 lt {0 393 translate} if 0.5 dup scale RFRM } bind def
/EOPN {PNSV restore PN 4 mod 3 eq {EOPG} {/PN PN 1 add def} ifelse} bind def
} bind def
/NL { LM currentpoint exch pop LS sub moveto /WD 0 def } bind def
/PR { dup stringwidth pop /WD exch def show } bind def
/PL { show NL } bind def %More efficient than {PR NL}
/BK { WD 0 gt {stringwidth pop neg 0 rmoveto /WD WD 1 sub def} {pop} ifelse
} bind def
%%EndProlog
%%BeginSetup
11 /Courier SF
12 SL
MDQV
%%EndSetup
%%Page: ? 1
STPG
STPN
(BEGIN \(* main program *\)) PL
() PL
(RESET\(queue,'PS:<SPOOL>PRIMARY-MASTER-QUEUE-FILE.QUASAR',TRUE\);) PL
(\(* RESET\(queue,'PRIVATE-MASTER-QUEUE-FILE.QUASAR',TRUE\); *\)) PL
() PL
(PASFIX\(queue\); \(* Fix up byte count *\)) PL
(head:=nil; \(* Set list of requests empty *\)) PL
(For indexpos:=2 to 777B do begin \(* go through valid indexes *\)) PL
( Tries:=0; \(* Start couting tries at good data *\)) PL
( Repeat) PL
( success:=false; \(* Haven't succeeded yet *\)) PL
( Tries:=Tries+1; \(* Count tries *\)) PL
( SETPOSGET\(queue,1000B+indexpos\); \(* Read index word *\)) PL
( indexword:=queue^;) PL
( if \(indexword.full=0\) or \(indexword.left<>RBBAT\)) PL
( then goto 9999;) PL
( \(* Must be a valid request, and not a file delete *\)) PL
( SETPOSGET\(queue,indexpos*1000B+eqrid\);) PL
( If EOF\(queue\) then begin) PL
( writeln\(tty,'Page vanished while attempting to map, ignoring'\);) PL
( goto 9999) PL
( end;) PL
( request:=queue^.full; \(* Get request ID from page*\)) PL
( If request=0 then begin) PL
( Writeln\(tty,'Request vanished, ignoring'\);) PL
( goto 9999;) PL
( end;) PL
( SETPOSGET\(queue,indexpos*1000B\); \(* Go to start of page *\)) PL
( messagelen:=queue^.left; \(* Get length for this page *\)) PL
( new\(cureq\); \(* Get an entry slot *\)) PL
( for i:=0 to messagelen do begin) PL
( cureq^.eq[i] := queue^; GETFIX\(queue\);) PL
( end;) PL
( SETPOSGET\(queue,indexpos*1000B+eqrid\); \(* Go to request again *\)) PL
( if request<>queue^.full then begin) PL
( writeln\(tty,'Request changed while looking, trying again '\);) PL
( dispose\(cureq\);) PL
( end else begin \(* Valid data *\)) PL
( success:=true; \(* say so *\)) PL
(\(* if cureq^.eq[eqrob+robty].full <> otbat then begin *\)) PL
( \(* Not a batch entry... *\)) PL
( cureq^.next:=head;) PL
( head:=cureq; \(* Insert this entry at front of list *\)) PL
(\(* end *\)) PL
( end \(* If valid data *\)) PL
( until \(tries>10\) or success; \(* Try this up to ten times *\)) PL
( If not success then writeln\(tty,'Couldn''t get consistent data, giving up after 10 tries'\);) PL
() PL
(9999:) PL
(end; \(* loop over index entries *\)) PL
() PL
(\(* We have read in the whole queue, now sort it *\)) PL
(Head:=Qsort\(head,qcompare\);) PL
() PL
(\(* Now print out queue in order *\)) PL
(cureq:=head;) PL
(while cureq<>nil do begin) PL
( TellAboutJob\(cureq^.eq\);) PL
( cureq:=cureq^.next;) PL
(end;) PL
EOPN
STPN
() PL
(END.) PL
EOPN
EOPG
%%Page: ? 2
STPG
STPN
(\(* <SU-UTILITIES>QF.PAS.3, 7-Apr-85 11:09:07, Edit by WHP4 *\)) PL
(\(* do print batch requests *\)) PL
(\(* <WHP4>QF.PAS.5, 14-May-84 17:31:28, Edit by WHP4 *\)) PL
(\(* print card-punch requests, they're really laser-printer requests *\)) PL
(\(* ACCT:<SU-UTILITIES>QF.PAS.3, 29-Nov-83 14:59:57, Edit by R.RMK *\)) PL
(\(* Don't print batch requests *\)) PL
(\(* ACCT:<SU-UTILITIES>QF.PAS.2, 8-Aug-83 19:49:42, Edit by R.RMK *\)) PL
(\(* Change for 4.2 GALAXY. *\)) PL
(Program Qfile;) PL
(\(* Performs various read-only operations on the galaxy system) PL
(by reading the master queue file.*\)) PL
() PL
(LABEL 9999;) PL
(\(* Structured programming, huh? Tell P20 to have a construct) PL
(for going to the end of a loop from the middle, or multiple) PL
(EXIT IF statements, and I wouldn't need this label *\)) PL
() PL
(CONST) PL
(\(* from GLXMAC *\)) PL
( FDLEN=0;FDFIL=1;) PL
( FPLEN=0;) PL
( \(* Object type codes *\)) PL
( OTLPT=3;) PL
( OTBAT=4;) PL
( OTCDP=5; \(* not card punch, Canon LGP *\)) PL
(\(* from QSRMAC *\)) PL
( RBBAT=1; \(* code for normal queue entry *\)) PL
( EQRID=14B;) PL
( EQLEN=4;) PL
( EQROB=5;) PL
( ROBTY=0;) PL
( EQSPC=15B;) PL
( EQJOB=11B;) PL
( EQOWN=131B;) PL
() PL
(TYPE halfword=0..777777B;) PL
( sixbitchar=0..77B;) PL
( sixbit=packed array[1..6] of sixbitchar;) PL
( asciichars=packed array[1..5] of char;) PL
( word = packed record case integer of) PL
( 1: \(full:integer\);) PL
( 2: \(right,left:halfword\);) PL
( 3: \(six:sixbit\);) PL
( 4: \(asc:asciichars\);) PL
( end; \(* type word *\)) PL
( page = array[0..777B] of word;) PL
( qentry = record ) PL
( next:^qentry;) PL
( eq:page;) PL
( end;) PL
( qptr=^qentry;) PL
() PL
(VAR queue:file of word;) PL
(\(* qpage:page; *\)) PL
( tries:integer; \(* Number of tries at getting consistant data*\)) PL
( request:integer; \(* Request number, to check consistancy *\)) PL
( indexpos:integer; \(* position we are at in index page *\)) PL
( indexword:word; \(* word read from index *\)) PL
( messagelen:integer; \(* Length of message on current page *\)) PL
( success:boolean;) PL
EOPN
STPN
( cureq:^qentry; \(* Temp to point to EQ blocks *\)) PL
( head:^qentry; \(* Pointer to head of queue of EQ *\)) PL
( i:integer; \(* Loop counter*\)) PL
() PL
(procedure sixtype\(var f:file;val:word\);) PL
(\(* Types VAL to file in sixbit *\)) PL
(var i:integer;) PL
(begin) PL
(for i:=1 to 6 do write\(f,chr\(val.six[i]+40B\)\);) PL
(end;) PL
( ) PL
(PROCEDURE PASFIX\(var f:file\);extern;) PL
(\(* This procedure sets the byte count of the file to a very large number, so) PL
(that files who's byte count is 0 can still be read by PMAP *\)) PL
() PL
(Procedure asctype\(var f:file;eq:page;index:integer\);) PL
(\(* Given an array with an EQ in it and and index, types that asciz string that starts at that address *\)) PL
(var c:char;i:integer;) PL
(begin) PL
(i:=1;) PL
(repeat) PL
( c:=eq[index + \(\(i-1\) div 5\)].asc[\(\(i-1\) mod 5\) + 1];) PL
( if ord\(c\)<>0 then write\(f,c\); \(*Stop on null*\)) PL
( i:=i+1;) PL
(until \(ord\(c\)=0\) or \(i>300\)) PL
(\(* Stop on null, or if an unreasonable number of chars printed *\)) PL
(end;) PL
() PL
(Function AscCompare\(var one,two:page;index:integer\):boolean;) PL
(\(* Returns true if the asciz string starting at index is greater in page TWO) PL
(than in page one. *\)) PL
(var c1,c2:char;) PL
( i:integer;greater,less:boolean;) PL
(begin) PL
(i:=1;) PL
(\(* write\(tty,'Comparing "'\);) PL
(asctype\(ttyoutput,one,index\);) PL
(write\(tty,'" with "'\);) PL
(asctype\(ttyoutput,two,index\);) PL
(writeln\(tty,'"'\); *\)) PL
() PL
(greater:=false;) PL
(less:=false;) PL
(repeat \(* Repeat until we get an decision *\)) PL
( c1:=one[index + \(\(i-1\) div 5\)].asc[\(\(i-1\) mod 5\) + 1];) PL
( c2:=two[index + \(\(i-1\) div 5\)].asc[\(\(i-1\) mod 5\) + 1];) PL
( if c1>c2 then greater:=true;) PL
( if c1<c2 then less:=true;) PL
( i:=i+1;) PL
(until greater or less or \(ord\(c1\)=0\);) PL
(asccompare:=greater;) PL
(\(* Stop if decision or strings run out [if c1=0 then c2=0 or else LESS) PL
( would be set *\)) PL
(end; \(* Procedure Asccompare *\)) PL
() PL
(PROCEDURE GETFIX\(var f:file\);) PL
(begin) PL
(GET\(f\);) PL
(end;) PL
() PL
EOPN
STPN
(PROCEDURE SETPOSGET\(var f:file;pos:integer\);) PL
(\(* This procedure sets the file to position POS and then does) PL
(a GET, so that f^ will be the datum at that position. The GET) PL
(is documented to be done automatically by SETPOS, but it does) PL
(not happen that way on files of integer *\)) PL
(BEGIN) PL
(SETPOS\(f,pos\);) PL
(\(* GETFIX\(f\); *\)) PL
(END;) PL
() PL
(Procedure TellAboutJob\(eq:page\);) PL
(\(* Tell user about a job given EQ *\)) PL
(Var i:integer;) PL
( filecount:integer; \(* Files in this request *\)) PL
( fileptr:integer; \(* Used to point to fileblocks in request *\)) PL
() PL
(Begin) PL
( case eq[eqrob+robty].full of) PL
( otlpt: write\(tty,'LPT: '\);) PL
( otbat: write\(tty,'BATCH: '\); ) PL
( otcdp: write\(tty,'Canon: '\);) PL
( others: write\(tty,'Unknown request type: '\);) PL
( end;) PL
( write\(tty,'Request ',eq[eqrid].full:0,', job '\);) PL
( sixtype\(ttyoutput,eq[eqjob]\);) PL
( write\(tty,' for user '\);) PL
( asctype\(ttyoutput,eq,eqown\);) PL
( writeln\(tty\);) PL
( write\(tty,' Files:'\);) PL
( filecount:=eq[eqspc].right; \(* Number of files in request *\)) PL
( fileptr:=eq[eqlen].right; \(* Skip header to first FP *\)) PL
( for i:=1 to filecount do begin) PL
( fileptr:=fileptr+eq[fileptr+FPLEN].left;) PL
( \(* Skip over FP to FD *\)) PL
( asctype\(ttyoutput,eq,fileptr+FDFIL\);) PL
( If i<>filecount then write\(tty,','\);) PL
( fileptr:=fileptr+eq[fileptr+FDLEN].left;) PL
( \(* skip over FD to next FP *\)) PL
( end; \(* loop over files *\)) PL
( writeln\(tty\);) PL
(End;) PL
() PL
EOPN
STPN
(\(* Procedures to do the QUICKSORT of queue entries *\)) PL
() PL
(Function QCompare\(one,two:page\):boolean;) PL
(\(* Returns true if two comes after one. The comparison is done by looking) PL
(first at object type, then at username *\)) PL
(Begin) PL
( If one[eqrob+robty].full>two[eqrob+robty].full then qcompare:=false) PL
( else if one[eqrob+robty].full<two[eqrob+robty].full then qcompare:=true) PL
( else qcompare:= AscCompare\(one,two,eqown\);) PL
(\(* Compare ascii strings starting at EQOWN, return result *\)) PL
(end;) PL
( ) PL
(Function Append\(first,last:qptr\):qptr;) PL
(\(* Appends the LAST list on to the end of the FIRST list, returns the result,) PL
(which is the same as FIRST unless FIRST is NIL *\)) PL
(var cur:qptr;) PL
(Begin) PL
(If first=nil then append:=last) PL
(else begin) PL
( cur:=first;) PL
( while cur^.next<>nil do cur:=cur^.next; \(* Go up to the end *\)) PL
( cur^.next:=last; \(* Put ending list *\)) PL
( append:=first;) PL
(end;) PL
(End; \(* Procedure append *\)) PL
() PL
(Function Qsort\(list:qptr;function compare:boolean\):qptr;) PL
(\(* Perform a Quicksort on a Queue pointed to by LIST, by calling the) PL
( function COMPARE on pairs of EQs. Compare should return true if the) PL
( second argument is greater than the first *\)) PL
(var small,big,cur,next:qptr;) PL
(Begin) PL
(small:=nil; big:=nil;) PL
(If list=nil then qsort:=nil) PL
(else if list^.next=nil then qsort:=list \(* Zero or one is immediate *\)) PL
(else begin) PL
( cur:=list^.next; \(* Start out with second element *\)) PL
( while cur<>nil do begin) PL
(\(* writeln\(tty,'Looking at ',ord\(cur\)\);*\)) PL
( next:=cur^.next; \(* Remember next element *\)) PL
( If compare\(list^.eq,cur^.eq\) then begin) PL
( cur^.next:=small;) PL
( small:=cur; \(* Smaller, goes on small list *\)) PL
( end else begin) PL
( cur^.next:=big;) PL
( big:=cur; \(* Big, goes on big list *\)) PL
( end;) PL
( cur:=next; \(* Move to next in list *\)) PL
( end; \(* while *\)) PL
(big:=qsort\(big,compare\);) PL
(small:=qsort\(small,compare\); \(* Sort the sublists *\)) PL
(list^.next:=big; \(* Put the dividing element on from of big list *\)) PL
(qsort:=append\(small,list\); \(* Put the big list after the small list *\)) PL
(end; \(* if not trivial case *\)) PL
(end; \(* procedure qsort *\)) PL
() PL
EOPN
%%Trailer
%%Pages: 6