Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

OPTIONS(/external);
EXTERNAL REF (Infile) PROCEDURE findinfile;
EXTERNAL REF (Outfile) PROCEDURE findoutfile;
EXTERNAL TEXT PROCEDURE conc,front,scanto,upcase,
frontstrip,rest,checkextension,getitem;
EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL PROCEDURE split,arrtxt;
EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,ilog,
maxint,search,splita,hash,arrlgd;
EXTERNAL BOOLEAN PROCEDURE menu,puttext;
EXTERNAL CLASS safeio;
EXTERNAL CLASS simdbm,dbmset;
dbmset CLASS dbsort;
BEGIN
  INTEGER k,m,n;
  BOOLEAN errorflag;
  TEXT t,u,v;

  COMMENT Procedure RECSORT will sort the contents
  of the lrecord array in ASCENDING order.
  Author: Algorithm 271 CACM 11-65, 5-66.
  Modified by: Mats Ohlin, FOA 1, S-104 50 STOCKHOM 80, SWEDEN.
  Date: 75-09-19
  ;
  PROCEDURE recsort (arr,n,key);
  REF (record) ARRAY arr;   INTEGER n,key;
  BEGIN   INTEGER i,k,q,m,p;   TEXT t,x;
    REF (record) rt,rx;
    INTEGER ARRAY ut,lz [1:Ln(Abs(n)+2)/0.69314718];

    OPTIONS(/A);
    IF arr[1].avalues[key] > arr[n].avalues[key] THEN
    BEGIN
      rt:- arr[1];
      OPTIONS(/-A);   arr[1]:- arr[n];   arr[n]:- rt
    END test and swap;

    i:= m := 1;
    WHILE m > 0 DO
    BEGIN
      IF n-i > 1 THEN
      BEGIN
	p:= (n+i)//2;    t:- arr[p].avalues[key];   rt:- arr[p];
	arr[p]:- arr[i];
	q:= n;   k:= i;
	FOR k:= k+1 WHILE k <= q DO
	BEGIN
	  IF arr[k].avalues[key] > t THEN
	  BEGIN
	    WHILE q >= k DO
	    BEGIN
	      IF arr[q].avalues[key] < t THEN
	      BEGIN
		rx:- arr[k];   arr[k]:- arr[q];
		arr[q]:- rx;   q:= q-1;
		GO TO l;
	      END;
	      q:= q-1;
	    END Q;
	  END;
	  l:
	END K;
	arr[i]:- arr[q];
	arr[q]:- rt;
	IF 2*q>i+n THEN
	BEGIN
	  lz[m]:= i;   ut[m]:= q-1;   i:= q+1;
	END
	ELSE
	BEGIN
	  lz[m]:= q+1;   ut[m]:= n;   n:= q-1;
	END;
	m:= m+1;
      END
      ELSE
      BEGIN
	IF (IF i < n THEN arr[i].avalues[key] > arr[n].avalues[key] ELSE
	FALSE) THEN
	BEGIN
	  rx:- arr[i];   arr[i]:- arr[n];   arr[n]:- rx
	END;
	m:= m-1;
	IF m > 0 THEN
	BEGIN   i:= lz[m];   n:= ut[m]   END;
      END
    END m > 0 loop;
  END recsort IN ASCENDING ORDER;

  PROCEDURE scan(ra,p);
!  g} igenom alla poster i arrayen ra (slutmarkering = NONE)
och anropa proceduren P f`r varje post
--------------------------------------------------------;
  REF (record) ARRAY ra; PROCEDURE p;
  BEGIN INTEGER k; REF (record) r;
    r:-ra(1); k:=1;
    WHILE r =/= NONE DO
    BEGIN p(r); k:=k+1; r:-ra(k); END;
  END of scan;

  INTEGER PROCEDURE rec_array(rtyp,sortfield,ra,owner,setname);
  VALUE rtyp,sortfield,setname;
  TEXT rtyp,sortfield,setname;
  REF (record) ARRAY ra; REF (record) owner;
  ! ________________________________________
  scan all records of type rtyp
  store references to them in ra,
  sort ra on the attribute sortfield
  ------------------------------------------;
  BEGIN INTEGER k,n,m,max,sortpos; REF (rspec) rs;

    PROCEDURE rsave(r); REF (record) r;
    BEGIN ! save record in array ra;
      IF r == NONE THEN
      BEGIN
	Outtext("Felaktigt set f`r posten: "); outline(owner.getkey);
      END ELSE
      BEGIN
	max:=max+1; ra(max):-r;
      END;
    END rsave;

    PROCEDURE errorstop(t,u); VALUE u; TEXT t,u;
    BEGIN
      Outtext(t); outline(u);
      errorflag:=TRUE; GOTO fin;
    END;

    max:=0; ra(1):-NONE;
! verifiera att angiven posttyp och sorteringsf{lt motsvaras
av storheter definierade i databasens specifikation
----------------------------------------------------------;
    rs:-getrecordspec(rtyp);
    IF rs == NONE THEN
    errorstop(rtyp,": Record type undefined !");
    n:=loctext(sortfield,rs.anames);
    IF n = 0 THEN errorstop(sortfield,": Undefined sort field !");
    IF owner == NONE THEN doforeach(rtyp,rsave) ELSE
    BEGIN
      mapset(owner,setname,rsave);
    END;
    IF max > 1 THEN recsort(ra,max,n);
    ra(max+1):-NONE;
    fin:
    rec_array:=max;
  END of rec_array;

END;