对于PASCAL空间限制太紧了。
我写的用堆优化的。。在tju AC了，内存17000k。。。
我真的不知道怎么减少内存了！
强烈建议，减小内存限制！
附：本人可怜的代码：
program Highways;
const   maxn=750;
type    link=^node;
        node=record d:integer; w:double; next:link; end;
        heaptype=record lowcost:double; pointer:integer; end;
        postype=record x,y:double; end;
var     vertex:array[1..maxn]of link;
        h:array[1..maxn]of heaptype;
        a:array[1..maxn]of integer;
        chosen:array[1..maxn]of boolean;
        closet:array[1..maxn]of integer;
        loc:array[1..maxn]of postype;
        n,m,num:integer;

procedure go_up(s,t:integer);
var     ti,tj:integer; x:heaptype;
begin
        if s>=t then exit;
        tj:=t; ti:=tj shr 1; x:=h[tj];
        while ti>=s do
         if x.lowcost<h[ti].lowcost
          then begin
           a[h[ti].pointer]:=tj;
           h[tj]:=h[ti]; tj:=ti; ti:=tj shr 1;
          end
          else break;
        h[tj]:=x; a[x.pointer]:=tj;
end;

procedure go_down(s,t:integer);
var     ti,tj:integer; x:heaptype;
begin
        if s>=t then exit;
        ti:=s; tj:=ti shl 1; x:=h[ti];
        while tj<=t do begin
         if (tj<t) and (h[tj+1].lowcost<h[tj].lowcost) then inc(tj);
         if x.lowcost>h[tj].lowcost
          then begin
           a[h[tj].pointer]:=ti;
           h[ti]:=h[tj]; ti:=tj; tj:=ti shl 1;
          end
          else break;
        end;
        h[ti]:=x; a[x.pointer]:=ti;
end;

procedure enter;
var     i,j,x,y:integer; t:double; p:link;
begin
        fillchar(vertex,sizeof(vertex),0); fillchar(chosen,sizeof(chosen),0);

        readln(n);
        for i:=1 to n do readln(loc[i].x,loc[i].y);
        for i:=1 to n-1 do
         for j:=i+1 to n do begin
          t:=sqrt(sqr(loc[i].x-loc[j].x)+sqr(loc[i].y-loc[j].y));
          new(p); p^.d:=j; p^.w:=t; p^.next:=vertex[i]; vertex[i]:=p;
          new(p); p^.d:=i; p^.w:=t; p^.next:=vertex[j]; vertex[j]:=p;
         end;

        readln(m);
        for i:=1 to m do begin
         readln(x,y);
         new(p); p^.d:=y; p^.w:=0; p^.next:=vertex[x]; vertex[x]:=p;
         new(p); p^.d:=x; p^.w:=0; p^.next:=vertex[y]; vertex[y]:=p;
        end;

        chosen[1]:=true; num:=n-1;
        for i:=1 to n-1 do begin
         h[i].lowcost:=9999999999; h[i].pointer:=i+1; a[i+1]:=i; closet[i+1]:=1;
        end;

        p:=vertex[1];
        while p<>nil do begin
         if p^.w<h[a[p^.d]].lowcost
          then begin
           h[a[p^.d]].lowcost:=p^.w;
           go_up(1,a[p^.d]);
          end;
         p:=p^.next;
        end;
end;

procedure solve;
var     i,k:integer; p:link;
begin
        for i:=1 to n-1 do begin
         k:=h[1].pointer; p:=vertex[k]; chosen[k]:=true;
         if h[1].lowcost<>0
          then writeln(k,' ',closet[k]);
         a[h[num].pointer]:=1; h[1]:=h[num]; dec(num);
         go_down(1,num);
         while p<>nil do begin
          if not chosen[p^.d] and (p^.w<h[a[p^.d]].lowcost)
           then begin
            if p^.d=3
             then k:=k;
            closet[p^.d]:=k;
            h[a[p^.d]].lowcost:=p^.w;
            go_up(1,a[p^.d]);
           end;
          p:=p^.next;
         end;
        end;
end;

begin
       
         enter;
         solve;

end.