Files
Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D10/GENLDR.PLM
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

822 lines
21 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('Concurrent CP/M System Loader Generation')
genldr:
do;
/*
Copyright (C) 1983,1984
Digital Research, Inc.
P.O. Box 579
Pacific Grove, CA 93950
*/
/*
Revised:
03 October 83 by Bruce Skidmore
16 February 84 by GLP
*/
declare true literally '0FFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare cr literally '0dh';
declare lf literally '0ah';
declare tab literally '09h';
declare esc literally '1bh';
declare bs literally '08h';
declare bios$data$off literally '0180h';
declare reset label external;
declare fcb (1) byte external;
declare fcb16 (1) byte external;
declare tbuff (1) byte external;
declare maxb address external;
declare bios$fcb (36) byte public initial (
0,'LBIOS3 ','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 bdos$fcb (36) byte public initial (
0,'LBDOS3 ','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 FCBout (36) byte public initial (
0,'CPMLDR ','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);
/*------------------------------------------------------------------------
External Messages
------------------------------------------------------------------------*/
declare
msg9120(16) byte external,
msg9125 byte external,
msg9135 byte external,
msg9140 byte external,
msg9145 byte external,
msg9155 byte external,
msg9160 byte external,
msg9190 byte external,
msg9195 byte external,
msg9250 byte external,
msg9255 byte external,
msg9485 byte external,
msg9490 byte external,
msg9495 byte external,
msg9500 byte external,
msg9505 byte external;
declare sctbfr (1) structure (
record (128) byte) public at (.memory);
declare fcb$msg (13) byte public initial (' . $');
declare display boolean public;
declare dma address public;
declare osbase address public;
declare buff$base address public;
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;
/*
B D O S P r o c e d u r e & F u n c t i o n C a l l s
*/
system$reset:
procedure public;
call mon1 (0,0);
end system$reset;
write$console:
procedure (char) public;
declare char byte;
if display then
call mon1 (2,char);
end write$console;
print$buf:
procedure (buffer$address) public;
declare buffer$address address;
if display then
call mon1 (9,buffer$address);
end print$buf;
crlf:
procedure public;
call write$console (cr);
call write$console (lf);
end crlf;
error:
procedure(term$code,err$type,err$msg$adr) public;
declare (term$code,err$type) byte;
declare err$msg$adr address;
declare (i,temp) byte;
temp = display;
display = true;
call crlf;
call print$buf (.msg9125);
call print$buf (err$msg$adr);
if err$type = 1 then
call print$buf(.fcb$msg);
if term$code then
call system$reset;
call crlf;
display = temp;
end error;
open$file:
procedure (fcb$address) byte public;
declare fcb$address address;
declare fcb based fcb$address (1) byte;
fcb(12), /* ex = 0 */
fcb(32) = 0; /* cr = 0 */
return mon2 (15,fcb$address);
end open$file;
close$file:
procedure (fcb$address) public;
declare fcb$address address;
call mon1 (16,fcb$address);
end close$file;
delete$file:
procedure (fcb$address) public;
declare fcb$address address;
call mon1 (19,fcb$address);
end delete$file;
read$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (20,fcb$address) <> 0 then
do;
call error(true,1,.msg9135);
end;
end read$record;
write$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (21,fcb$address) <> 0 then
do;
call error(true,1,.msg9140);
end;
end write$record;
create$file:
procedure (fcb$address) public;
declare fcb$address address;
declare fcb based fcb$address (1) byte;
if mon2 (22,fcb$address) = 255 then
do;
call error(true,0,.msg9145);
end;
fcb(32) = 0; /* set cr = 0 */
end create$file;
set$DMA$address:
procedure (DMA$address) public;
declare DMA$address address;
call mon1 (26,DMA$address);
end set$DMA$address;
read$random$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (33,fcb$address) <> 0 then
do;
call error(true,1,.msg9135);
end;
end read$random$record;
write$random$record:
procedure (fcb$address) public;
declare fcb$address address;
if mon2 (34,fcb$address) <> 0 then
do;
call error(true,1,.msg9140);
end;
end write$random$record;
set$random$record:
procedure (fcb$address) public;
declare fcb$address address;
call mon1 (36,fcb$address);
end set$random$record;
setbuf:
procedure external;
end setbuf;
/*
D a t a S t r u c t u r e s
*/
declare data$base address public;
declare data$end address public;
declare act$data$end address public;
declare act$buf$end address public;
declare bdos$atts(4) address public;
declare bios$atts(4) address public;
declare (sys$clen,sys$cbase,sys$dlen,sys$dbase) address public;
declare (dblk$last,dblk$next) address public;
declare add$buf$adr address public;
declare add$buf based add$buf$adr structure (
base address,
len address);
declare drvtbl$adr address public;
declare drvtbl based drvtbl$adr (16) address;
declare dph$adr address public;
declare dph based dph$adr structure (
xlt address,
scratch1 address,
scratch2 byte,
mf byte,
scratch3 address,
dpb address,
csv address,
alv address,
dirbcb address,
dtabcb address,
hash address,
init address,
login address,
read address,
write address,
unit byte,
chnnl byte,
fcnt byte);
declare dpb$adr address public;
declare dpb based dpb$adr structure (
spt address,
bsh byte,
blm byte,
exm byte,
dsm address,
drm address,
al0 byte,
al1 byte,
cks address,
off address,
psh byte,
phm byte);
declare header$adr address;
declare header$rec based header$adr structure (
gtype byte,
len address,
base address,
min address,
max address);
declare base$pg$adr address public;
declare base$pg based base$pg$adr structure(
clenw address,
clenb byte,
cbase address,
m80 byte,
dlenw address,
dlenb byte,
dbase address,
res1 byte,
elenw address,
elenb byte,
ebase address,
res2 byte,
slenw address,
slenb byte,
sbase address,
res3 byte);
declare temp$fcb$adr address public;
declare temp$fcb based temp$fcb$adr structure(
drv byte,
name(8) byte,
type(3) byte,
ex byte,
s1 byte,
s2 byte,
rc byte,
dm(16) byte,
cur$rec byte,
rr address,
r2 byte);
/*
L o c a l P r o c e d u r e s
*/
movef:
procedure (count,source$adr,dest$adr) public;
declare count address;
declare (source$adr,dest$adr) address;
if count = 0
then return;
else call move (count,source$adr,dest$adr);
end movef;
upper:
procedure(b) byte public;
declare b byte;
if b < ' ' then return cr; /* all non-graphics */
/* translate alpha to upper case */
if b >= msg9155 and b <= msg9160 then
b = b and 101$1111b; /* upper case */
return b;
end upper;
dsply$hex:
procedure (val) public;
declare val byte;
call write$console (msg9120(shr (val,4)));
call write$console (msg9120(val and 0fh));
end dsply$hex;
dsply$hex$adr:
procedure (val) public;
declare val address;
call dsply$hex (high (val));
call dsply$hex (low (val));
call write$console (msg9195);
end dsply$hex$adr;
get$param:
procedure (val$adr) public;
declare (val$adr) address;
declare word$val based val$adr address;
declare base byte;
declare (char) byte;
declare (lbindx) byte;
lbindx = 0;
word$val = 0;
base = 16;
do while (char := upper(tbuff(lbindx:=lbindx+1))) <> cr;
if char = msg9190 then
do;
base = 10;
end;
else
do;
char = char - '0';
if (base = 16) and (char > 9) then
do;
if char > 16
then char = char - 7;
else char = 255;
end;
if char < base then
do;
word$val = word$val*base + char;
end;
else
do;
call error (true,0,.msg9250);
end;
end;
end;
end get$param;
get$atts:
procedure (fcb$adr,atts$adr);
declare fcb$adr address;
declare atts$adr address;
declare atts based atts$adr (4) address;
declare i byte;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if openfile(fcb$adr) = 0ffh then
call error(true,1,.msg9255);
header$adr = .sctbfr(0);
call set$DMA$address(header$adr);
call read$record(fcb$adr);
do i = 0 to 3;
atts(i) = 0;
end;
do i = 0 to 3;
if (header$rec.gtype <> 0) and (header$rec.gtype < 5) then
atts(header$rec.gtype-1) = header$rec.len;
header$adr = header$adr + 9;
end;
end get$atts;
buf$seg$blk:
procedure(space,fcb$adr) public;
declare space address;
declare fcb$adr address;
declare i byte;
if (dma+space) > (buff$base+1000H) then
do;
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
do i = 0 to 30;
call set$DMA$address(buff$base + (128 * i));
call write$record(.FCBout);
end;
call movef(double(128),buff$base+0f80h,buff$base);
dma = dma - 0f80H;
call set$DMA$address(dma);
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
end;
end buf$seg$blk;
read$write$seg:
procedure (fcb$adr,seg$len) public;
declare fcb$adr address;
declare seg$len address;
declare seg$rec$len address;
declare i address;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if seg$len = 0 then return;
seg$rec$len = (seg$len-1) / 8; /* convert para length to records */
call set$DMA$address(dma);
do i = 0 to seg$rec$len;
call buf$seg$blk(double(128),fcb$adr);
call read$record(fcb$adr);
call set$DMA$address(dma := dma + 128);
end;
end read$write$seg;
read$seg:
procedure (fcb$adr,seg$len) public;
declare fcb$adr address;
declare seg$len address;
declare seg$rec$len address;
declare i address;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if seg$len = 0 then return;
seg$rec$len = (seg$len-1) / 8; /* convert para length to records */
call set$DMA$address(dma);
do i = 0 to seg$rec$len;
call read$record(fcb$adr);
call set$DMA$address(dma := dma + 128);
end;
end read$seg;
write$seg:
procedure (fcb$adr,seg$len) public;
declare fcb$adr address;
declare seg$len address;
declare seg$rec$len address;
declare i address;
call movef(8,fcb$adr+1,.fcb$msg);
call movef(3,fcb$adr+9,.fcb$msg+9);
if seg$len = 0 then return;
seg$rec$len = (seg$len-1) / 8; /* convert para length to records */
call set$DMA$address(dma);
do i = 0 to seg$rec$len;
call write$record(fcb$adr);
call set$DMA$address(dma := dma + 128);
end;
end write$seg;
setup$sysdat:
procedure public;
declare sysdat$adr address;
declare sysdat based sysdat$adr structure(
iosentry$off address,
iosentry$seg address,
iosinit$off address,
iosinit$seg address,
ldrentry$off address,
ldrentry$seg address);
sysdat$adr = data$base; /* Point to SYSTEM Data Area */
/* Setup the pointer to the BIOS entry point */
sysdat.iosentry$off = 3; /* Should be 3 */
sysdat.iosentry$seg = sys$cbase + bdos$atts(0); /* BIOS code segment */
/* Setup the pointer to the BIOS init point */
sysdat.iosinit$off = 0; /* Should be 0 but the Linker adds 5 */
sysdat.iosinit$seg = sys$cbase + bdos$atts(0); /* BIOS code segment */
/* Setup the Loader entry point */
sysdat.ldrentry$off = 6;
sysdat.ldrentry$seg = sys$cbase + bdos$atts(0);
return;
end setup$sysdat;
set$value:
procedure (seg,byteoff,value) public;
declare (seg,value) address;
declare byteoff byte;
declare setword$adr address;
declare setword based setword$adr address;
if temp$fcb.rr <> seg/8 then
do;
temp$fcb.rr = seg/8;
temp$fcb.r2 = 0;
call read$random$record(temp$fcb$adr);
end;
setword$adr = buff$base + ((seg and 7)*16) + byteoff;
setword = value;
call write$random$record(temp$fcb$adr);
end set$value;
fixup$segs:
procedure public;
call set$DMA$address(buff$base);
temp$fcb$adr = .FCBout;
temp$fcb.rr = 0FFFFh;
temp$fcb.r2 = 0FFh;
call set$value(8,6,sys$dbase);
call set$value(bdos$atts(0)+8,9,sys$dbase);
return;
end fixup$segs;
initialization:
procedure public;
declare (first,next,bracket) byte;
first = 1;
next = 1;
bracket = false;
if tbuff(0) <> 0 then
do;
do while(next <= tbuff(0)+1);
if (tbuff(next) = ' ') or (tbuff(next) = tab) or (tbuff(next) = msg9485)
or (tbuff(next) = msg9490) then
do;
if tbuff(next) = msg9485 then
bracket = true;
tbuff(next) = 0;
end;
else
do;
tbuff(first) = tbuff(next);
first = first + 1;
end;
next = next + 1;
end;
tbuff(0) = first - 2;
if bracket = true then
do;
call get$param(.osbase);
end;
end;
else
do;
call error(true,0,.msg9495);
end;
end initialization;
setup$sys$file:
procedure public;
declare i byte;
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
call delete$file (.FCBout);
call create$file (.FCBout);
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
dma = .sctbfr(0);
buff$base = dma;
do i = 0 to 127;
sctbfr(0).record(i) = 0;
end;
call set$DMA$address (dma);
call write$record (.FCBout);
end setup$sys$file;
read$write$code:
procedure public;
declare i byte;
declare flush$cnt address;
dma = buff$base;
call read$write$seg(.bdos$fcb,bdos$atts(0));
dblk$last = (7 - ((bdos$atts(0)-1) and 7)) * 16;
dma = dma - dblk$last;
call read$write$seg(.bios$fcb,bios$atts(0));
dblk$last = (7 - ((bios$atts(0)-1) and 7)) * 16;
call movef(8,.FCBout+1,.fcb$msg);
call movef(3,.FCBout+9,.fcb$msg+9);
dma = dma - dblk$last;
flush$cnt = (dma-buff$base+127)/128 - 1;
dma = buff$base;
call set$DMA$address(dma);
do i = 0 to flush$cnt;
call write$record(.FCBout);
call set$DMA$address(dma:=dma + 128);
end;
call set$random$record(.bdos$fcb);
call set$random$record(.bios$fcb);
call set$random$record(.FCBout);
temp$fcb$adr = .FCBout;
temp$fcb.rr = temp$fcb.rr - 1;
temp$fcb$adr = .bdos$fcb;
temp$fcb.rr = temp$fcb.rr - 1;
temp$fcb$adr = .bios$fcb;
temp$fcb.rr = temp$fcb.rr - 1;
/* the following adjustments are to take care */
/* of BIOS data ORG'ed at BIOS$DATA$OFF. */
temp$fcb.rr = temp$fcb.rr + bios$data$off/128;
bios$atts(0) = bios$atts(0) + bios$data$off/16;
bios$atts(1) = bios$atts(1) - bios$data$off/16;
end read$write$code;
read$data:
procedure public;
dma = buff$base + 128;
call set$DMA$address(dma);
call read$random$record(.FCBout);
call set$DMA$address(buff$base);
call read$random$record(.bdos$fcb);
call read$record(.bdos$fcb);
dblk$next = (7 - ((bdos$atts(0)-1) and 7)) * 16;
dblk$last = (7 - ((sys$clen-1) and 7)) * 16;
call movef(dblk$next,(buff$base+128-dblk$next),(dma+128-dblk$last));
dma = dma + (128 - dblk$last) + dblk$next;
call read$seg(.bdos$fcb,bdos$atts(1) - (dblk$next/16));
dma = dma - (7 - ((bdos$atts(1)-(dblk$next/16)-1) and 7)) * 16;
call set$DMA$address(buff$base);
call read$random$record(.bios$fcb);
call read$record(.bios$fcb);
dblk$next = (7 - ((bios$atts(0) - 1) and 7)) * 16;
dma = dma + bios$data$off - (bdos$atts(1)*16);
call movef(dblk$next,(buff$base+128-dblk$next),dma);
dma = dma + dblk$next;
call read$seg(.bios$fcb,bios$atts(1) - (dblk$next/16));
end read$data;
write$bdos$bios$data:
procedure public;
dma = buff$base;
call write$seg(.FCBout,(bios$data$off/16)+bios$atts(1)+dblk$last/16);
end write$bdos$bios$data;
clean$up:
procedure public;
header$adr = .sctbfr(0);
call set$DMA$address(header$adr);
FCBout(33), FCBout(34), FCBout(35) = 0;
call read$random$record(.FCBout);
header$rec.gtype = 1;
header$rec.len = sys$clen + sys$dlen;
header$rec.base = sys$cbase;
header$rec.min = sys$clen + sys$dlen;
header$adr = header$adr + 9;
header$rec.base = sys$dbase;
call write$random$record(.FCBout);
call close$file(.FCBout);
call close$file(.bios$fcb);
call close$file(.bdos$fcb);
end clean$up;
print$epilog:
procedure public;
display = true;
call print$buf (.msg9500);
end print$epilog;
plm:
procedure public;
/*
G E N C P M M a i n P r o g r a m
*/
call initialization;
call get$atts(.bdos$fcb,.bdos$atts);
call get$atts(.bios$fcb,.bios$atts);
sys$clen = bdos$atts(0) + bios$atts(0);
sys$cbase = osbase;
sys$dlen = bios$atts(1);
sys$dbase = sys$clen + osbase;
call setup$sys$file; /* Take care of creating the */
/* system file. */
call read$write$code; /* Read the system code segments */
/* and concatenate them. */
call read$data; /* Read the system data segments */
/* and concat. them. */
dblk$last = 128 - dblk$last;
dma = buff$base + 128;
buff$base = .sctbfr(0);
call movef(dblk$last+(bios$atts(1)*16)+bios$data$off,dma,buff$base);
data$base = buff$base + dblk$last;
data$end = data$base + (bios$atts(1)*16)+bios$data$off;
drvtbl$adr = data$base + bios$data$off; /* position the DRVTBL array */
if drvtbl(0) = 0 then
call error(true,0,.msg9505);
sys$dbase = sys$clen + osbase;
act$data$end = data$end - data$base;
call setbuf; /* Set up all buffers */
bios$atts(1) = shr((data$end-data$base-bios$data$off+15),4);
sys$dlen = act$buf$end - sys$dbase;
call setup$sysdat; /* Setup the system data. */
call write$bdos$bios$data; /* Write the combined and updated */
/* data to the SYS file. */
call fixup$segs; /* Fixup the segment values */
/* that were not known on the 1st */
/* pass. */
call clean$up; /* Fix up the SYS file header and */
/* close the file. */
call print$epilog;
end plm;
end genldr;
EOF