mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 16:34:07 +00:00
553 lines
15 KiB
Plaintext
553 lines
15 KiB
Plaintext
$title ('MP/M II V2.0 Loader')
|
||
mpmldr:
|
||
do;
|
||
|
||
/*
|
||
Copyright (C) 1979,1980,1981
|
||
Digital Research
|
||
P.O. Box 579
|
||
Pacific Grove, CA 93950
|
||
|
||
Revised:
|
||
14 Sept 81 by Thomas Rolander
|
||
*/
|
||
|
||
declare true literally '0FFH';
|
||
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 signon (*) byte data (
|
||
0dh, /* Filler */
|
||
0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,
|
||
0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,0ah,
|
||
'MP/M II V2.0 Loader ',0dh,0ah,
|
||
'Copyright (C) 1981, Digital Research',0dh,0dh,0ah,'$');
|
||
|
||
/**************** Warning ******************/
|
||
/* */
|
||
/* This location must be at or above 015CH */
|
||
/* */
|
||
/*********************************************/
|
||
|
||
declare copyright (*) byte data (
|
||
'COPYRIGHT (C) 1981,');
|
||
declare company$name (*) byte data (
|
||
' DIGITAL RESEARCH ');
|
||
declare serial$number (6) byte data (
|
||
'654321');
|
||
|
||
declare err$msgadr address initial (.default$err$msg);
|
||
declare err$msg based err$msgadr (1) byte;
|
||
declare default$err$msg (*) byte data (
|
||
'Dsk rd err','$');
|
||
|
||
declare mon1 literally 'ldmon1';
|
||
declare mon2 literally 'ldmon2';
|
||
|
||
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 *
|
||
* *
|
||
**************************************/
|
||
|
||
write$console:
|
||
procedure (char);
|
||
declare char byte;
|
||
call mon1 (2,char);
|
||
end write$console;
|
||
|
||
print$buffer:
|
||
procedure (buffer$address);
|
||
declare buffer$address address;
|
||
call mon1 (9,buffer$address);
|
||
end print$buffer;
|
||
|
||
reset$disk$system:
|
||
procedure;
|
||
call mon1 (13,0);
|
||
end reset$disk$system;
|
||
|
||
open$file:
|
||
procedure (fcb$address) byte;
|
||
declare fcb$address address;
|
||
return mon2 (15,fcb$address);
|
||
end open$file;
|
||
|
||
read$record:
|
||
procedure (fcb$address) byte;
|
||
declare fcb$address address;
|
||
return mon2 (20,fcb$address);
|
||
end read$record;
|
||
|
||
set$DMA$address:
|
||
procedure (DMA$address);
|
||
declare DMA$address address;
|
||
call mon1 (26,DMA$address);
|
||
end set$DMA$address;
|
||
|
||
|
||
/**************************************
|
||
* *
|
||
* Misc. BDOS procs *
|
||
* *
|
||
**************************************/
|
||
|
||
crlf:
|
||
procedure;
|
||
call write$console (0dh);
|
||
call write$console (0ah);
|
||
end crlf;
|
||
|
||
printdecimal:
|
||
procedure (n);
|
||
declare n byte;
|
||
declare (digit,pdigit) byte;
|
||
pdigit = false;
|
||
digit = '0';
|
||
do while n >= 100;
|
||
pdigit = true;
|
||
digit = digit + 1;
|
||
n = n - 100;
|
||
end;
|
||
if pdigit then
|
||
do;
|
||
call write$console (digit);
|
||
digit = '0';
|
||
end;
|
||
do while n >= 10;
|
||
pdigit = true;
|
||
digit = digit + 1;
|
||
n = n - 10;
|
||
end;
|
||
if pdigit then
|
||
call write$console (digit);
|
||
call write$console ('0'+n);
|
||
end printdecimal;
|
||
|
||
printnib:
|
||
procedure (n);
|
||
declare n byte;
|
||
if n > 9
|
||
then call write$console (n+'A'-10);
|
||
else call write$console (n+'0');
|
||
end printnib;
|
||
|
||
printhex:
|
||
procedure (b);
|
||
declare b byte;
|
||
call printnib (shr(b,4));
|
||
call printnib (b and 0fh);
|
||
end printhex;
|
||
|
||
printaddr:
|
||
procedure (a);
|
||
declare a address;
|
||
call write$console (' ');
|
||
call write$console (' ');
|
||
call printhex (high(a));
|
||
call printhex (low(a));
|
||
call write$console ('H');
|
||
end printaddr;
|
||
|
||
printstring:
|
||
procedure (sadr,sz);
|
||
declare sadr address;
|
||
declare sz byte;
|
||
declare s based sadr (1) byte;
|
||
declare i byte;
|
||
do i = 0 to sz-1;
|
||
call write$console (s(i) and 7fh);
|
||
end;
|
||
end printstring;
|
||
|
||
printname:
|
||
procedure (nadr);
|
||
declare nadr address;
|
||
call printstring (nadr,11);
|
||
end printname;
|
||
|
||
printitems:
|
||
procedure (nadr,base,size);
|
||
declare (nadr,base,size) address;
|
||
call print$name (nadr);
|
||
call printaddr (base);
|
||
call printaddr (size);
|
||
call crlf;
|
||
end printitems;
|
||
|
||
printitemsadr:
|
||
procedure (nadr,base,size);
|
||
declare nadr address;
|
||
declare (base,size) byte;
|
||
call printitems (nadr,
|
||
double (base)*256,
|
||
double (size)*256);
|
||
end printitemsadr;
|
||
|
||
match$serial:
|
||
procedure (cpyrtadr,memadr);
|
||
declare (cpyrtadr,memadr) address;
|
||
declare (i,j) byte;
|
||
declare cpyrt based cpyrtadr (1) byte;
|
||
declare mem based memadr (1) byte;
|
||
|
||
do forever;
|
||
i,j = -1;
|
||
do while cpyrt(i:=i+1) = mem(j:=j+1);
|
||
;
|
||
end;
|
||
if i > 23 then return;
|
||
if (memadr = 0) or (i > 17) then
|
||
do;
|
||
err$msgadr = .('Synchronization: Serial numbers do not match','$');
|
||
go to error;
|
||
end;
|
||
memadr = memadr + 1;
|
||
end;
|
||
end match$serial;
|
||
|
||
declare (base,cur$top,prev$top) address;
|
||
declare cur$record address;
|
||
declare sysdatadr address;
|
||
declare wordadr address;
|
||
declare word based wordadr address;
|
||
declare xios$common based cur$top structure (
|
||
jmpinstr byte,
|
||
base address );
|
||
declare actual$xios$common$base address;
|
||
|
||
declare nrec byte;
|
||
declare notdone boolean;
|
||
|
||
declare rspname (11) byte initial (
|
||
'????????RSP');
|
||
declare brspname (11) byte initial (
|
||
'????????BRS');
|
||
|
||
declare mpm$sys$fcb (36) byte initial (
|
||
0,'MPM ','SYS',0,0,0,0,0,0,0,0,
|
||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||
|
||
declare entry$point (3) address;
|
||
|
||
declare system$data (256) byte at (.fcb);
|
||
|
||
$include (sysdat.lit)
|
||
|
||
declare break boolean;
|
||
declare debug$RST byte;
|
||
declare destination based cur$top (1) byte;
|
||
declare link based cur$top address;
|
||
declare test$byte based cur$top byte;
|
||
declare rspcnt byte;
|
||
|
||
print2addr:
|
||
procedure;
|
||
call printaddr (cur$top);
|
||
call printaddr (prev$top-cur$top);
|
||
call crlf;
|
||
end print2addr;
|
||
|
||
load$system$data:
|
||
procedure;
|
||
declare cntr byte;
|
||
call set$DMA$address (.system$data);
|
||
if open$file (.mpm$sys$fcb) = 0ffh then
|
||
do;
|
||
call move (4,.(' ?','$'),.mpm$sys$fcb(12));
|
||
err$msgadr = .mpm$sys$fcb(1);
|
||
go to error;
|
||
end;
|
||
if read$record (.mpm$sys$fcb) <> 0 then
|
||
do;
|
||
go to error;
|
||
end;
|
||
call set$DMA$address (.system$data(128));
|
||
if read$record (.mpm$sys$fcb) <> 0 then
|
||
do;
|
||
go to error;
|
||
end;
|
||
sysdatadr,
|
||
cur$top = shl(double(mem$top),8);
|
||
|
||
call print$buffer (.(
|
||
'Nmb of consoles = ','$'));
|
||
call printnib (nmb$cns);
|
||
call print$buffer (.(0dh,0ah,
|
||
'Breakpoint RST # = ','$'));
|
||
call printnib (brkpt$RST);
|
||
/**********************************************************
|
||
if z80$cpu then
|
||
call print$buffer (.(0dh,0ah,
|
||
'Z80 Alternate register set saved/restored',
|
||
' by dispatcher','$'));
|
||
if bank$switched <> 0 then
|
||
do;
|
||
call print$buffer (.(0dh,0ah,
|
||
'Common base addr =','$'));
|
||
call printaddr (double (common$base) * 256);
|
||
end;
|
||
if banked$bdos then
|
||
call print$buffer (.(0dh,0ah,
|
||
'Banked BDOS file manager','$'));
|
||
call print$buffer (.(0dh,0ah,
|
||
'Nmb of ticks/second = ','$'));
|
||
call printdecimal (ticks$per$second);
|
||
call print$buffer (.(0dh,0ah,
|
||
'System drive = ','$'));
|
||
call write$console ('A'+system$drive-1);
|
||
call write$console (':');
|
||
call print$buffer (.(0dh,0ah,
|
||
'Max lckd recs/proc = ','$'));
|
||
call printdecimal (max$locked$records);
|
||
call print$buffer (.(0dh,0ah,
|
||
'Totl lckd recs/sys = ','$'));
|
||
call printdecimal (total$system$locked$records);
|
||
call print$buffer (.(0dh,0ah,
|
||
'Max open files/proc = ','$'));
|
||
call printdecimal (max$open$files);
|
||
call print$buffer (.(0dh,0ah,
|
||
'Totl open files/sys = ','$'));
|
||
call printdecimal (total$system$open$files);
|
||
call print$buffer (.(0dh,0ah,
|
||
'To<54> o<> MP/M-80 =','$'));
|
||
call printaddr (cur$top + 255);
|
||
*************************************************************/
|
||
|
||
call print$buffer (.(0dh,0ah,
|
||
'Memory Segment Table:',0dh,0ah,'$'));
|
||
call printitems (.('SYSTEM DAT'),cur$top,256);
|
||
cur$top = cur$top
|
||
- (prev$top := (shr(nmb$cns-1,2)+1)*256);
|
||
call printitems (.('TMPD DAT'),cur$top,prev$top);
|
||
if sys$call$stks then
|
||
do;
|
||
cur$top = cur$top
|
||
- (prev$top := (shr(nmb$mem$seg-2,2)+1)*256);
|
||
call printitems (.('USERSYS STK'),cur$top,prev$top);
|
||
end;
|
||
end load$system$data;
|
||
|
||
display$OS:
|
||
procedure;
|
||
declare (base,cntr) byte;
|
||
declare rspsadr (16) address;
|
||
declare temp$rspl address;
|
||
declare temp$rspl$adr based temp$rspl address;
|
||
call printitemsadr (.('XIOSJMP TBL'),
|
||
xios$jmp$tbl$base,
|
||
1);
|
||
call printitemsadr (.('RESBDOS SPR'),
|
||
resbdos$base,
|
||
xios$jmp$tbl$base-resbdos$base);
|
||
call printitemsadr (.('XDOS SPR'),
|
||
xdos$base,
|
||
resbdos$base-xdos$base);
|
||
if nmb$rsps <> 0 then
|
||
do;
|
||
cntr = 0;
|
||
temp$rspl = rspl;
|
||
do while (rspsadr(cntr):=temp$rspl) <> 0;
|
||
cntr = cntr + 1;
|
||
temp$rspl = temp$rspl$adr;
|
||
end;
|
||
rspsadr(cntr) = double (xdos$base)*256;
|
||
do while (cntr:=cntr-1) <> -1;
|
||
call move (8,rspsadr(cntr)+6+2,.rspname);
|
||
call printitems (.rspname,
|
||
rspsadr(cntr),
|
||
rspsadr(cntr+1)-rspsadr(cntr));
|
||
end;
|
||
end;
|
||
call printitemsadr (.('BNKXIOS SPR'),
|
||
bnkxios$base,
|
||
rsp$base-bnkxios$base);
|
||
call printitemsadr (.('BNKBDOS SPR'),
|
||
bnkbdos$base,
|
||
bnkxios$base-bnkbdos$base);
|
||
call printitemsadr (.('BNKXDOS SPR'),
|
||
bnkxdos$base,
|
||
bnkbdos$base-bnkxdos$base);
|
||
call printitemsadr (.('TMP SPR'),
|
||
tmp$base,
|
||
bnkxdos$base-tmp$base);
|
||
if nmb$brsps <> 0 then
|
||
do;
|
||
cntr = 0;
|
||
temp$rspl = brspl;
|
||
do while (rspsadr(cntr):=temp$rspl) <> 0;
|
||
cntr = cntr + 1;
|
||
temp$rspl = temp$rspl + 2;
|
||
temp$rspl = temp$rspl$adr;
|
||
end;
|
||
rspsadr(cntr) = double (tmp$base)*256;
|
||
do while (cntr:=cntr-1) <> -1;
|
||
call move (8,rspsadr(cntr)+4,.brspname);
|
||
call printitems (.brspname,
|
||
rspsadr(cntr),
|
||
rspsadr(cntr+1)-rspsadr(cntr));
|
||
end;
|
||
base = brsp$base;
|
||
end;
|
||
else
|
||
do;
|
||
base = tmp$base;
|
||
end;
|
||
cntr = base - high (total$list$items*10 + 255);
|
||
call printitemsadr (.('LCKLSTS DAT'),
|
||
cntr,
|
||
base-cntr);
|
||
if nmb$cns <> 0 then
|
||
do;
|
||
base = cntr;
|
||
cntr = base - nmb$cns;
|
||
call printitemsadr (.('CONSOLE DAT'),
|
||
cntr,
|
||
base-cntr);
|
||
end;
|
||
end display$OS;
|
||
|
||
display$mem$map:
|
||
procedure;
|
||
declare msgadr address;
|
||
|
||
call print$buffer (.(
|
||
'-------------------------',0dh,0ah,'$'));
|
||
msgadr = .('MP/M II Sys','$');
|
||
do nrec = 0 to nmb$mem$seg-1;
|
||
call print$buffer (msgadr);
|
||
msgadr = .('Memseg Usr','$');
|
||
call printaddr (shl(double(mem$seg$tbl(nrec).base),8));
|
||
call printaddr (shl(double(mem$seg$tbl(nrec).size),8));
|
||
if bank$switched <> 0 then
|
||
do;
|
||
call print$buffer (.(' Bank ','$'));
|
||
call printdecimal (mem$seg$tbl(nrec).bank);
|
||
end;
|
||
call crlf;
|
||
end;
|
||
end display$mem$map;
|
||
|
||
Restart$instr:
|
||
procedure;
|
||
disable; /* this disable is overlayed with RST x */
|
||
end Restart$instr;
|
||
|
||
xeq$mpm:
|
||
procedure;
|
||
declare brkpt$adr address data (.Restart$instr);
|
||
declare brkpt based brkpt$adr byte;
|
||
declare loc$0007 byte at (0007h);
|
||
|
||
stack$ptr = .entry$point(2);
|
||
/* if command tail starts with 'B' then break */
|
||
if break then
|
||
do;
|
||
if mem$top >= loc$0007 then
|
||
do;
|
||
errmsg$adr = .('No break, CP/M debugger overlaid by MP/M',
|
||
'$');
|
||
go to error;
|
||
end;
|
||
brkpt = 1100$0111b or shl(debug$RST,3);
|
||
call Restart$instr;
|
||
end;
|
||
end xeq$mpm;
|
||
|
||
command$tail:
|
||
procedure;
|
||
declare fcbstr$adr address;
|
||
declare fcbstr based fcbstr$adr (1) byte;
|
||
break = false;
|
||
fcbstr$adr = .fcb;
|
||
if fcbstr(1) = ' ' then
|
||
return;
|
||
if fcbstr(1) = '$' then
|
||
do;
|
||
if fcbstr(2) = 'B' then
|
||
do;
|
||
break = true;
|
||
if fcbstr(3) = ' '
|
||
then debug$RST = 7;
|
||
else debug$RST = fcbstr(3) and 0000$0111b;
|
||
end;
|
||
fcbstr$adr = .fcb16;
|
||
end;
|
||
if (fcbstr( 9) = 'S') and
|
||
(fcbstr(10) = 'Y') and
|
||
(fcbstr(11) = 'S') then
|
||
do;
|
||
call move (9,fcbstr$adr,.mpm$sys$fcb);
|
||
end;
|
||
end command$tail;
|
||
|
||
|
||
/*
|
||
Main Program
|
||
*/
|
||
|
||
start:
|
||
/* disable; -> removed from base of MP/M 1.x loader */
|
||
call reset$disk$system;
|
||
call command$tail;
|
||
call print$buffer (.signon);
|
||
call load$system$data;
|
||
|
||
cur$top = sysdatadr;
|
||
|
||
cur$record = 1;
|
||
do while (cur$record:=cur$record+1) <> nmb$records;
|
||
call set$DMA$address (cur$top:=cur$top-128);
|
||
if read$record (.mpm$sys$fcb) <> 0 then
|
||
do;
|
||
errmsg$adr = .('failed to read MPM.SYS','$');
|
||
go to error;
|
||
end;
|
||
end;
|
||
|
||
entry$point(2) = double (xdos$base)*256;
|
||
call match$serial (.company$name,.system$data);
|
||
|
||
call display$OS;
|
||
call display$mem$map;
|
||
|
||
call move (256,.system$data,sysdatadr);
|
||
|
||
call xeq$mpm;
|
||
|
||
error:
|
||
call print$buffer (.(0dh,0ah,
|
||
'MPMLDR error: ','$'));
|
||
call print$buffer (err$msgadr);
|
||
do forever;
|
||
stackptr = 0;
|
||
disable;
|
||
halt;
|
||
end;
|
||
|
||
end mpmldr;
|
||
|