Files
Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/07/user.plm
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

1 line
3.7 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

$title('MP/M 1.1 User Number Assign/Display')
user:
do;
$include (copyrt.lit)
/*
Revised:
27 Jan 80 by Thomas Rolander
*/
declare start label;
declare jmp$to$start structure (
jmp$instr byte,
jmp$location address ) data (
0c3h,.start-3);
$include (proces.lit)
/*
Common Literals
*/
declare true literally '0FFFFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
mon1:
procedure (func,info) external;
declare func byte;
declare info address;
end mon1;
mon2:
procedure (func,info) byte external;
declare func byte;
declare info address;
end mon2;
mon2a:
procedure (func,info) address external;
declare func byte;
declare info address;
end mon2a;
declare xdos literally 'mon2';
declare xdosa literally 'mon2a';
declare fcb (1) byte external;
print$buffer:
procedure (bufferadr);
declare bufferadr address;
call mon1 (9,bufferadr);
end print$buffer;
who$user:
procedure byte;
return mon2 (32,0ffh);
end who$user;
terminate:
procedure;
call mon1 (143,0);
end terminate;
who$con:
procedure byte;
return xdos (153,0);
end who$con;
sys$dat$adr:
procedure address;
return xdosa (154,0);
end sys$dat$adr;
ASCII$to$int:
procedure (string$adr) byte;
declare string$adr address;
declare string based string$adr (1) byte;
if (string(0) := string(0) - '0') < 10 then
do;
if string(1) <> ' '
then return string(0)*10 + (string(1)-'0');
else return string(0);
end;
return 254;
end ASCII$to$int;
int$to$ASCII:
procedure (string$adr);
declare string$adr address;
declare string based string$adr (1) byte;
if string(0) < 10 then
do;
string(0) = string(0) + '0';
string(1) = ' ';
end;
else
do;
string(1) = (string(0)-10) + '0';
string(0) = '1';
end;
end int$to$ASCII;
declare datapgadr address;
declare datapg based datapgadr address;
declare thread$root$adr address;
declare thread$root based thread$root$adr address;
declare TMPx (8) byte
initial ('Tmpx ');
declare console byte at (.TMPx(3));
declare msg1 (*) byte
initial ('User Number = ');
declare msg2 (5) byte
initial ('xx',0dh,0ah,'$');
declare user$nmb byte at (.msg2(0));
declare pdadr address;
declare pd based pdadr Process$descriptor;
declare i byte;
/*
User Main Program
*/
start:
if fcb(1) = ' ' then
/* displaying user number */
do;
user$nmb = who$user;
end;
else
/* assigning user number */
do;
if (user$nmb := ASCII$to$int(.fcb(1))) < 16 then
do;
console = who$con + '0';
datapgadr = sys$dat$adr + 252;
datapgadr = datapg;
thread$root$adr = datapgadr + 17;
pdadr = thread$root;
do while pdadr <> 0;
i = 0;
do while (i <> 8) and (pd.name(i) = TMPx(i));
i = i + 1;
end;
if i = 8 then
do;
pd.diskslct = (pd.diskslct and 0F0h) or user$nmb;
pdadr = 0;
end;
else
do;
pdadr = pd.thread;
end;
end;
end;
else
/* invalid user number entry */
do;
user$nmb = who$user;
call print$buffer (.(
'Invalid user number, ignored',0dh,0ah,'$'));
end;
end;
call int$to$ASCII (.usernmb);
call print$buffer (.msg1);
call terminate;
end user;