Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
pascal-demo/user.pas
There are no other files named user.pas in the archive.
{$M- This is a file of external procedures}
program user;
const
{jsys definitions}
msend=510B;
mrecv=511B;
mutil=512B;
erstr=11B;
{parameters}
priou=101B;
ipciw=1B;
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;
message=array[1:512]of integer;
messpt=^message;
var packet:packetdescriptor;
mess:^shortmessage;
m:messpt;
messpage:integer; {page number of m^}
ourpid,hispid:integer;
ret:integer;
userlen,i,j:integer;
conv:packed record case Boolean of
true:(word:integer);
false:(dum:0..77777777B;error:0..77B)
end;
procedure getpages(num:integer;var page:integer;var loc:messpt); extern;
procedure quit; extern;
procedure fatal;
{Print most recent error and quit}
begin
jsys(erstr,3;priou,400000B:-1,0);
quit
end;
function user(name:alfa):messpt;
{Find the PID with name 'MAKEUSER'. Returns PID as as HISPID. Fatal if fails}
var requestpid:packetdescriptor;
begin
{Allocate memory}
new(mess);
getpages(1,messpage,m);
user := m;
{send to info asking for pid and name}
packet.ipcfl := 010000000000B; {Create pid, temp}
packet.ipcfs := 0; {sender not assigned yet}
packet.ipcfr := 0; {to info}
packet.ipcfpl := 3; {create message for info - length 3}
packet.ipcfpt := mess; {use short message}
mess^.ipci0 := ipciw; {get pid for name}
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}
conv.word := packet.ipcfl; {check for error}
if conv.error <> 0
then begin
if conv.error = 76B
then writeln(tty,'? The server you have asked to talk to is not running')
else writeln(tty,'? Unable to find the server you have asked to talk to - INFO error code ',conv.error:2:O);
quit
end;
if ret <> 2
then fatal;
hispid := mess^.ipci1; {This was what info said}
end;
procedure sendrequest;
{Receive request from user.}
begin
packet.ipcfpl := 512;
packet.ipcfpn := messpage;
packet.ipcfl := 200000B; {Page mode}
packet.ipcfs := ourpid;
packet.ipcfr := hispid;
jsys(msend,2,ret;4,packet); {send user request}
if ret <> 2
then fatal;
end;
procedure getreply;
{Send acknowledgement to user.}
begin
packet.ipcfl := 200000B; {Page mode}
packet.ipcfs := hispid;
packet.ipcfpl := 512;
packet.ipcfpn := messpage;
packet.ipcfr := ourpid;
jsys(mrecv,2,ret;4,packet);
if ret <> 2
then fatal
end.