Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - pascal-demo/server.pas
There are no other files named server.pas in the archive.
{$M-  This is a file of external procedures}
program server;

const
{jsys definitions}
  msend=510B;
  mrecv=511B;
  mutil=512B;
  erstr=11B;
{parameters}
  priou=101B;
  ipcii=3B;

type packetdescriptor=packed record
	ipcfl:integer;
	ipcfs:integer;
	ipcfr:integer;
	case Boolean of
	  true: (ipcfpl:0..777777B;ipcfpn:0..777777B;
		 ipcfd:integer);
	  false: (ipcxx:0..777777B;ipcfpt:^shortmessage)
	end;
     shortmessage=record
	ipci0:integer;
	ipci1:integer;
	ipci2:alfa
	end;
     messpt=^message;
     message=array[1:512]of integer;  {dummy definition}	

var packet:packetdescriptor;
    mess:^shortmessage;
    m:messpt;
    messpage:integer;  {page number of m^}
    ourpid,hispid:integer;
    ret:integer;
    i:integer;
    conv:packed record case Boolean of
	true:(word:integer);
	false:(dum:0..77777777B;error:0..77B)
	end;
    xwd:packed record case Boolean of
	true:(word:integer);
	false:(LH:0..777777B;RH:0..777777B)
	end;
    bits:set of 0..35; {standard word to put bits from jsys in}

procedure quit; extern;

procedure getpages(num:integer;var pagenum:integer;var pagept:messpt);
   extern;

procedure fatal;
{Print most recent error and quit}
  begin
  jsys(erstr,3;priou,400000B:-1,0);
  quit  
  end;

function server(name:alfa):messpt;
{Get a PID with name 'MAKEUSER'.  Returns PID as as OURPID.  Fatal if fails}
	var requestpid:packetdescriptor;
  begin
{Initialize storage}
  new(mess);
  getpages(1,messpage,m);
  server := m;
{send to info asking for pid and name}
  packet.ipcfl := 010000000000B;  {Create pid, jobwide}
  packet.ipcfs := 0;  {sender not assigned yet}
  packet.ipcfr := 0;  {to info}
  packet.ipcfpl := 3;  {create message for info - length 3}
  packet.ipcfpt := mess;
  mess^.ipci0 := ipcii;  {assign name to pid}
  mess^.ipci1 := 0;  {no duplicate}
  mess^.ipci2 := name;  {name of pid}
  jsys(msend,2,ret;4,packet);  {Now ask for the pid}
  if ret <> 2
    then fatal;
  ourpid := packet.ipcfs;   {This is the pid we got}
{receive response}
  packet.ipcfl := 0;  {No special flags}
  packet.ipcfr := ourpid;
  jsys(mrecv,2,ret;4,packet);  {Now get response}
  if ret <> 2
    then fatal;
  conv.word := packet.ipcfl;  {check for error}
  if conv.error <> 0
    then begin
    writeln(tty,'INFO error code ',conv.error:2:O);
    quit
    end;
  end;  

procedure getrequest;
{Receive request from user.}
  begin
  packet.ipcfl := 200000B; {Page mode}
  packet.ipcfr := ourpid;  
  packet.ipcfpl := 512;
  packet.ipcfpn := messpage;
  jsys(mrecv,2,ret;5,packet);  {Get user request}
  if ret <> 2
    then fatal;
  hispid := packet.ipcfs;
  end;  

procedure sendreply;
{Send acknowledgement to user.}
  begin
  packet.ipcfl := 200000B; {page mode}
  packet.ipcfs := ourpid;
  packet.ipcfpl := 512;
  packet.ipcfpn := messpage;
  packet.ipcfr := hispid; {back to sender}
  jsys(msend,2,ret;4,packet);
  if ret <> 2
    then fatal
  end.