mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-27 10:24:19 +00:00
Upload
Digital Research
This commit is contained in:
679
MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/10/gensys.plm
Normal file
679
MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/10/gensys.plm
Normal file
@@ -0,0 +1,679 @@
|
||||
$title('MP/M 1.1 System Generation')
|
||||
gensys:
|
||||
do;
|
||||
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
/* Gensys Gensys Gensys Gensys Gensys Gensys */
|
||||
|
||||
$include (copyrt.lit)
|
||||
/*
|
||||
Revised:
|
||||
7 Jan 80 by Thomas Rolander
|
||||
*/
|
||||
|
||||
declare true literally '0FFFFH';
|
||||
declare false literally '0';
|
||||
declare forever literally 'while true';
|
||||
declare boolean literally 'byte';
|
||||
|
||||
declare start label;
|
||||
declare jmp$to$start structure (
|
||||
jmp$instr byte,
|
||||
jmp$location address ) data (
|
||||
0C3H,
|
||||
.start-3);
|
||||
|
||||
declare copyright (*) byte data (
|
||||
'COPYRIGHT (C) 1980, DIGITAL RESEARCH ');
|
||||
declare serial$number (6) byte data (
|
||||
'654321');
|
||||
|
||||
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;
|
||||
|
||||
declare fcb (1) byte external;
|
||||
declare fcb16 (1) byte external;
|
||||
declare tbuff (1) byte external;
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S Externals *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
system$reset:
|
||||
procedure;
|
||||
call mon1 (0,0);
|
||||
end system$reset;
|
||||
|
||||
read$console:
|
||||
procedure byte;
|
||||
return mon2 (1,0);
|
||||
end read$console;
|
||||
|
||||
write$console:
|
||||
procedure (char);
|
||||
declare char byte;
|
||||
call mon1 (2,char);
|
||||
end write$console;
|
||||
|
||||
print$console$buffer:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (9,buffer$address);
|
||||
end print$console$buffer;
|
||||
|
||||
read$console$buffer:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
declare buf based buffer$address (1) byte;
|
||||
buf(1) = 0;
|
||||
do while buf(1) = 0;
|
||||
call mon1 (10,buffer$address);
|
||||
if buf(1) = 0
|
||||
then call print$console$buffer (.(0ah,'?','$'));
|
||||
end;
|
||||
buf(buf(1)+2) = 0;
|
||||
end read$console$buffer;
|
||||
|
||||
open$file:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (15,fcb$address);
|
||||
end open$file;
|
||||
|
||||
close$file:
|
||||
procedure (fcb$address);
|
||||
declare fcb$address address;
|
||||
call mon1 (16,fcb$address);
|
||||
end close$file;
|
||||
|
||||
search$first:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (17,fcb$address);
|
||||
end search$first;
|
||||
|
||||
search$next:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (18,fcb$address);
|
||||
end search$next;
|
||||
|
||||
delete$file:
|
||||
procedure (fcb$address);
|
||||
declare fcb$address address;
|
||||
call mon1 (19,fcb$address);
|
||||
end delete$file;
|
||||
|
||||
read$record:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (20,fcb$address);
|
||||
end read$record;
|
||||
|
||||
write$record:
|
||||
procedure (fcb$address);
|
||||
declare fcb$address address;
|
||||
if mon2 (21,fcb$address) <> 0 then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
'Disk write error','$'));
|
||||
call system$reset;
|
||||
end;
|
||||
end write$record;
|
||||
|
||||
create$file:
|
||||
procedure (fcb$address);
|
||||
declare fcb$address address;
|
||||
if mon2 (22,fcb$address) = 255 then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
'Directory full','$'));
|
||||
call system$reset;
|
||||
end;
|
||||
end create$file;
|
||||
|
||||
set$DMA$address:
|
||||
procedure (DMA$address);
|
||||
declare DMA$address address;
|
||||
call mon1 (26,DMA$address);
|
||||
end set$DMA$address;
|
||||
|
||||
crlf:
|
||||
procedure;
|
||||
call write$console (0dh);
|
||||
call write$console (0ah);
|
||||
end crlf;
|
||||
|
||||
|
||||
gnctran:
|
||||
procedure(b) byte;
|
||||
declare b byte;
|
||||
|
||||
if b < ' ' then return 0dh; /* all non-graphics */
|
||||
/* translate alpha to upper case */
|
||||
if b >= 'a' and b <= 'z' then
|
||||
b = b and 101$1111b; /* upper case */
|
||||
return b;
|
||||
end gnctran;
|
||||
|
||||
parse:
|
||||
procedure (pcb$adr) address;
|
||||
declare pcb$adr address;
|
||||
declare pcb based pcb$adr structure (
|
||||
filename$adr address,
|
||||
fcb$adr address );
|
||||
declare pcb$filename$adr address;
|
||||
declare pcb$fcb$adr address;
|
||||
declare filename based pcb$filename$adr (1) byte;
|
||||
declare fcb based pcb$fcb$adr (1) byte;
|
||||
|
||||
declare
|
||||
/* return conditions */
|
||||
endline literally '00000H',
|
||||
badfile literally '0FFFFH',
|
||||
/* useful literals */
|
||||
disk literally 'fcb(0)',
|
||||
fcbname literally '8', /* end of name */
|
||||
fcbtype literally '11', /* end of type field */
|
||||
fcbsize literally '16'; /* partial size of fcb */
|
||||
|
||||
declare char byte; /* global temp for current char */
|
||||
declare fnp byte; /* index into file name buffer */
|
||||
declare fnlen byte;
|
||||
|
||||
gnc:
|
||||
procedure;
|
||||
|
||||
char = gnctran(filename(fnp := fnp + 1));
|
||||
end gnc;
|
||||
|
||||
delimiter:
|
||||
procedure byte;
|
||||
declare i byte;
|
||||
declare del(*) byte data
|
||||
(0dh,' =.:<>_[],');
|
||||
|
||||
do i = 0 to last(del);
|
||||
if char = del(i) then return true;
|
||||
end;
|
||||
return false;
|
||||
end delimiter;
|
||||
|
||||
putchar:
|
||||
procedure;
|
||||
|
||||
fcb(fnlen:=fnlen+1) = char;
|
||||
/* can check here for ambig ref's "char = '?'" */
|
||||
end putchar;
|
||||
|
||||
fillq:
|
||||
procedure(len);
|
||||
/* fill current name or type with question marks */
|
||||
|
||||
declare len byte;
|
||||
|
||||
char = '?'; /* question mark */
|
||||
do while fnlen < len;
|
||||
call putchar;
|
||||
end;
|
||||
end fillq;
|
||||
|
||||
/* initialize local bases */
|
||||
pcb$filename$adr = pcb.filename$adr;
|
||||
pcb$fcb$adr = pcb.fcb$adr;
|
||||
/* initialize file control block to empty */
|
||||
char = ' ';
|
||||
fnlen = 0;
|
||||
fnp = -1;
|
||||
do while fnlen < fcbsize-1;
|
||||
if fnlen = fcbtype then char = 0;
|
||||
call putchar;
|
||||
end;
|
||||
disk = 0;
|
||||
/* scan next name */
|
||||
do forever;
|
||||
/* deblank command buffer */
|
||||
call gnc;
|
||||
do while char = ' ';
|
||||
call gnc;
|
||||
end;
|
||||
if delimiter then return badfile;
|
||||
fnlen = 0;
|
||||
do while not delimiter;
|
||||
if fnlen >= fcbname then /* error, file name too long */
|
||||
return badfile;
|
||||
if char = '*' then call fillq(fcbname); else call putchar;
|
||||
call gnc;
|
||||
end;
|
||||
|
||||
/* check for disk name */
|
||||
if char = ':' then
|
||||
do;
|
||||
if not (disk = 0 and fnlen = 1) then
|
||||
return badfile;
|
||||
/* must be a disk name */
|
||||
if (disk := fcb(1) - 'A' + 1) > 26
|
||||
/* invalid disk name */
|
||||
then return badfile;
|
||||
/* valid disk name replace space in name */
|
||||
else fcb(fnlen) = ' ';
|
||||
end;
|
||||
else
|
||||
do;
|
||||
/* char is not ':', so file name is set. scan remainder */
|
||||
/* at least one char scanned */
|
||||
fnlen = fcbname;
|
||||
if char = '.' then /* scan file type */
|
||||
do;
|
||||
call gnc;
|
||||
do while not delimiter;
|
||||
if fnlen >= fcbtype then
|
||||
/* error, type field too long */
|
||||
return badfile;
|
||||
if char = '*'
|
||||
then call fillq(fcbtype);
|
||||
else call putchar;
|
||||
call gnc;
|
||||
end;
|
||||
end;
|
||||
|
||||
if char = 0dh
|
||||
then return endline;
|
||||
else return .filename(fnp);
|
||||
end;
|
||||
end; /* of forever */
|
||||
end parse;
|
||||
|
||||
declare pcb structure (
|
||||
filename$adr address,
|
||||
fcb$adr address );
|
||||
declare nxt$chr$adr address;
|
||||
declare old$nxt$chr$adr address at (.pcb.filename$adr);
|
||||
declare char byte;
|
||||
declare ret byte at (.char);
|
||||
declare delim based nxt$chr$adr byte;
|
||||
declare fcbin (33) byte;
|
||||
declare fcbout (33) byte initial (
|
||||
0,' ',' ',0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||||
declare default$fcb (33) byte data (
|
||||
0,' ',' ',0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||||
declare rspfcb (33) byte initial (
|
||||
0,'????????','RSP',0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||||
declare nmb$sect literally '32';
|
||||
declare buffer (nmb$sect) structure (
|
||||
record (128) byte);
|
||||
declare sysdatpg (256) byte at (.buffer(1));
|
||||
|
||||
|
||||
setup$output$file:
|
||||
procedure;
|
||||
pcb.filename$adr = .tbuff(1);
|
||||
pcb.fcb$adr = .fcbout;
|
||||
nxt$chr$adr = parse (.pcb);
|
||||
if delim <> '=' then
|
||||
do;
|
||||
if nxt$chr$adr = 0 then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
'No input files specified','$'));
|
||||
go to error;
|
||||
end;
|
||||
if nxt$chr$adr = 0ffffh then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
'Bad output file name','$'));
|
||||
go to error;
|
||||
end;
|
||||
call print$console$buffer (.(
|
||||
'A ''='' delimeter expected after output file name','$'));
|
||||
go to error;
|
||||
end;
|
||||
call set$DMA$address (.buffer);
|
||||
if open$file (.fcbout) <> 255
|
||||
then call delete$file (.fcbout);
|
||||
call create$file (.fcbout);
|
||||
end setup$output$file;
|
||||
|
||||
setup$input$file:
|
||||
procedure;
|
||||
pcb.filename$adr = nxt$chr$adr + 1;
|
||||
pcb.fcb$adr = .fcbin;
|
||||
call move (33,.default$fcb,.fcbin);
|
||||
if (nxt$chr$adr := parse (.pcb)) = 0ffffh then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
'Bad input file name','$'));
|
||||
go to error;
|
||||
end;
|
||||
call set$DMA$address (.buffer);
|
||||
if open$file (.fcbin) = 255 then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
'No such input file','$'));
|
||||
go to error;
|
||||
end;
|
||||
end setup$input$file;
|
||||
|
||||
copy$file:
|
||||
procedure;
|
||||
declare (i,cnt) byte;
|
||||
declare ok boolean;
|
||||
|
||||
do forever;
|
||||
cnt = 0;
|
||||
ok = true;
|
||||
do while ok;
|
||||
call set$DMA$address (.buffer(cnt));
|
||||
if (ok := (read$record (.fcbin) = 0)) then
|
||||
do;
|
||||
ok = ((cnt:=cnt+1) <> nmb$sect);
|
||||
end;
|
||||
else
|
||||
do;
|
||||
if cnt = 0 then return;
|
||||
end;
|
||||
end;
|
||||
do i = 0 to cnt-1;
|
||||
call set$DMA$address (.buffer(i));
|
||||
call write$record (.fcbout);
|
||||
end;
|
||||
if cnt <> nmb$sect then return;
|
||||
end;
|
||||
end copy$file;
|
||||
|
||||
declare lnbfr (14) byte initial (12);
|
||||
|
||||
response:
|
||||
procedure byte;
|
||||
|
||||
call read$console$buffer (.lnbfr);
|
||||
return (lnbfr(2) = 'y') or (lnbfr(2) = 'Y');
|
||||
end response;
|
||||
|
||||
get$param:
|
||||
procedure (string$adr,val$adr);
|
||||
declare (string$adr,val$adr) address;
|
||||
declare val based val$adr byte;
|
||||
declare char byte;
|
||||
declare lbindx byte;
|
||||
|
||||
call print$console$buffer (string$adr);
|
||||
val = 0;
|
||||
call read$console$buffer (.lnbfr);
|
||||
lbindx = 1;
|
||||
do while (char := gnctran(lnbfr(lbindx:=lbindx+1))) <> 0dh;
|
||||
if char = ',' then
|
||||
do;
|
||||
val$adr = val$adr + 1;
|
||||
val = 0;
|
||||
end;
|
||||
else
|
||||
do;
|
||||
char = char - '0';
|
||||
if char > 9 then
|
||||
do;
|
||||
if char > 16
|
||||
then char = char - 7;
|
||||
else char = 255;
|
||||
end;
|
||||
if char < 16 then
|
||||
do;
|
||||
val = val*16 + char;
|
||||
end;
|
||||
else
|
||||
do;
|
||||
char,
|
||||
val = 0;
|
||||
call print$console$buffer (.(
|
||||
'<- bad character, re-enter',0ah,0dh,'$'));
|
||||
call print$console$buffer (string$adr);
|
||||
call read$console$buffer (.lnbfr);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
call crlf;
|
||||
end get$param;
|
||||
|
||||
make$system$dat:
|
||||
procedure;
|
||||
declare i byte;
|
||||
|
||||
call move (12,.(0,'SYSTEM DAT'),.fcb);
|
||||
call set$DMA$address (.buffer);
|
||||
if open$file (.fcb) <> 255
|
||||
then call delete$file (.fcb);
|
||||
call create$file (.fcb);
|
||||
do i = 0 to 255;
|
||||
sysdatpg(i) = 0;
|
||||
end;
|
||||
call move (43,.copyright,.sysdatpg(144));
|
||||
call print$console$buffer (.( 0ah,0dh,
|
||||
'MP/M 1.1 System Generation',0dh,0ah,
|
||||
'==========================',0dh,0ah,0ah,'$'));
|
||||
call get$param (.('Top page of memory = ','$'),
|
||||
.sysdatpg(0));
|
||||
call get$param (.('Number of consoles = ','$'),
|
||||
.sysdatpg(1));
|
||||
call get$param (.('Breakpoint RST # = ','$'),
|
||||
.sysdatpg(2));
|
||||
call print$console$buffer (
|
||||
.('Add system call user stacks (Y/N)? ','$'));
|
||||
sysdatpg(3) = response;
|
||||
call print$console$buffer (.(0dh,0ah,
|
||||
'Z80 CPU (Y/N)? ','$'));
|
||||
sysdatpg(5) = response;
|
||||
call print$console$buffer (.(0dh,0ah,
|
||||
'Bank switched memory (Y/N)? ','$'));
|
||||
sysdatpg(4) = response;
|
||||
if sysdatpg(4) then
|
||||
do;
|
||||
call print$console$buffer (.(0dh,0ah,
|
||||
'Banked BDOS file manager (Y/N)? ','$'));
|
||||
sysdatpg(6) = response;
|
||||
/* Bank switched memory segment table input */
|
||||
call print$console$buffer (.(0ah,0dh,
|
||||
'Enter memory segment table: (ff terminates list)',
|
||||
0ah,0dh,'$'));
|
||||
sysdatpg(15) = 0;
|
||||
i = 16;
|
||||
do while sysdatpg(i) <> 0ffh;
|
||||
if i = 48 then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
' Entry terminated, 8 segments maximum',0dh,0ah,'$'));
|
||||
sysdatpg(48) = 0ffh;
|
||||
end;
|
||||
else
|
||||
do;
|
||||
call get$param (.(' Base,size,attrib,bank = ','$'),
|
||||
.sysdatpg(i));
|
||||
if sysdatpg(i) <> 0ffh then
|
||||
do;
|
||||
sysdatpg(15) = sysdatpg(15) + 1;
|
||||
i = i + 4;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
do;
|
||||
call print$console$buffer (.(0ah,0dh,
|
||||
'Memory segment bases, (ff terminates list)',0ah,0dh,'$'));
|
||||
sysdatpg(i:=112) = 0;
|
||||
do while sysdatpg(i) <> 0ffh;
|
||||
i = i + 1;
|
||||
if i = 121 then
|
||||
do;
|
||||
sysdatpg(121) = 0ffh;
|
||||
call print$console$buffer (.(
|
||||
' : ff <- forced end, 8 segments maximum',0dh,0ah));
|
||||
end;
|
||||
else
|
||||
do;
|
||||
call get$param (.(' : ','$'),.sysdatpg(i));
|
||||
if i = 113 then
|
||||
do;
|
||||
if sysdatpg(113) = 0ffh then
|
||||
do;
|
||||
sysdatpg(113) = 0;
|
||||
sysdatpg(114) = 0ffh;
|
||||
i = 114;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
do;
|
||||
if sysdatpg(i) <= sysdatpg(i-1) then
|
||||
do;
|
||||
i = i - 1;
|
||||
call print$console$buffer (.(
|
||||
'*** error ***',
|
||||
' segment base must be greater than previous',
|
||||
0dh,0ah,'$'));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
sysdatpg(15) = i - 113;
|
||||
end;
|
||||
call set$DMA$address (.sysdatpg);
|
||||
call write$record (.fcb);
|
||||
call set$DMA$address (.sysdatpg(128));
|
||||
call write$record (.fcb);
|
||||
call close$file (.fcb);
|
||||
end make$system$dat;
|
||||
|
||||
declare rsp$filename (12) byte initial (
|
||||
'-------- ? ','$');
|
||||
|
||||
setup$cmd$tail:
|
||||
procedure;
|
||||
declare (i,ret,ptr) byte;
|
||||
declare actual$rspfcb$adr address;
|
||||
declare actual$rspfcb based actual$rspfcb$adr (1) byte;
|
||||
declare nchars literally '45';
|
||||
|
||||
call move (nchars,.('mpm.sys=system.dat,xios.spr,',
|
||||
'bdos.spr,xdos.spr'),.tbuff(1));
|
||||
if sysdatpg(6)
|
||||
then tbuff(29) = 'o';
|
||||
call set$DMA$address (.buffer);
|
||||
ret = search$first (.rspfcb);
|
||||
ptr = nchars;
|
||||
if ret <> 255 then
|
||||
do;
|
||||
call print$console$buffer (.(
|
||||
'Select Resident System Processes: (Y/N)',0dh,0ah,'$'));
|
||||
do while ret <> 255;
|
||||
actual$rspfcb$adr = .buffer + (ret mod 4)*32;
|
||||
call move (8,.actual$rspfcb(1),.rsp$filename);
|
||||
call print$console$buffer (.rsp$filename);
|
||||
if response then
|
||||
do;
|
||||
tbuff(ptr:=ptr+1) = ',';
|
||||
do i = 1 to 11;
|
||||
if i = 9
|
||||
then tbuff(ptr:=ptr+1) = '.';
|
||||
if actual$rspfcb(i) <> ' '
|
||||
then tbuff(ptr:=ptr+1) = actual$rspfcb(i);
|
||||
end;
|
||||
end;
|
||||
call crlf;
|
||||
ret = search$next (.rspfcb);
|
||||
end;
|
||||
end;
|
||||
tbuff(ptr:=ptr+1) = 0;
|
||||
tbuff(0) = ptr;
|
||||
end setup$cmd$tail;
|
||||
|
||||
/*
|
||||
F i l e C o n c a t e n a t i o n
|
||||
*/
|
||||
|
||||
declare last$dseg$byte byte
|
||||
initial (0);
|
||||
|
||||
start:
|
||||
if fcb(1) = ' ' then
|
||||
do;
|
||||
call make$system$dat;
|
||||
call setup$cmd$tail;
|
||||
end;
|
||||
call setup$output$file;
|
||||
do forever;
|
||||
call setup$input$file;
|
||||
call copy$file;
|
||||
if nxt$chr$adr = 0 then
|
||||
do;
|
||||
call close$file (.fcbout);
|
||||
call system$reset;
|
||||
end;
|
||||
end;
|
||||
|
||||
error:
|
||||
call crlf;
|
||||
tbuff(tbuff(0)+1) = '$';
|
||||
call print$console$buffer (old$nxt$chr$adr);
|
||||
call system$reset;
|
||||
|
||||
end gensys;
|
||||
|
||||
Reference in New Issue
Block a user