Files
Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE/UTIL7/DP.PLM
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

133 lines
3.9 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 ('SDIR - Print')
/*
Copyright (C) 1981
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
Revised:
14 Sept 81 by Danny Horovitz
*/
dprint:
do;
/* print routines for extended directory */
declare dcl literally 'declare',
lit literally 'literally',
word lit 'address',
true literally '1',
false literally '0',
boolean literally 'byte',
cr literally '13',
lf literally '10';
mon1: procedure(f,a) external;
declare f byte, a address;
end mon1;
dcl debug byte external;
break: procedure external;
end break;
/* fcb and dma buffer constants */
declare
f$name lit '1', /* file name */
fnamelen lit '8', /* file name length */
f$type lit '9', /* file type field */
f$typelen lit '3'; /* type length */
/* BDOS calls */
print$char: procedure(char) public;
declare char byte;
call mon1(2,char);
end print$char;
print: procedure(string$adr) public;
dcl string$adr address;
call mon1(9,string$adr);
if debug then
call break;
end print;
printb: procedure public;
call print$char(' ');
end printb;
crlf: procedure public;
call print$char(cr);
call print$char(lf);
end crlf;
printfn: procedure(fname$adr) public;
dcl fname$adr address,
file$name based fname$adr (1) byte,
i byte; /* <filename> ' ' <filetype> */
do i = 0 to f$namelen - 1;
call printchar(file$name(i) and 7fh);
end;
call printchar(' ');
do i = f$namelen to f$namelen + f$typelen - 1;
call printchar(file$name(i) and 7fh);
end;
end printfn;
pdecimal: procedure(v,prec,zerosup) public;
/* print value v, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean, /* zero suppression flag */
d byte; /* current decimal digit */
do while prec <> 0;
d = v / prec; /* get next digit */
v = v mod prec; /* get remainder back to v */
prec = prec / 10; /* ready for next digit */
if prec <> 0 and zerosup and d = 0 then
call printb;
else
do;
zerosup = false;
call printchar('0'+d);
end;
end;
end pdecimal;
p3byte: procedure(byte3adr,prec) public;
/* print 3 byte value with 0 suppression */
dcl byte3adr address, /* assume high order bit is < 10 */
prec address,
b3 based byte3adr structure (
lword address,
hbyte byte),
i byte;
/* prec = 1 for 6 chars, 2 for 7 */
if b3.hbyte <> 0 then
do;
call pdecimal(b3.hbyte,prec,true); /* 3 for 8 chars printed */
call pdecimal(b3.lword,10000,false);
end;
else
do;
i = 1;
do while i <= prec;
call printb;
i = i * 10;
end;
call pdecimal(b3.lword,10000,true);
end;
end p3byte;
end dprint;