mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 09:24:19 +00:00
Upload
Digital Research
This commit is contained in:
@@ -0,0 +1,294 @@
|
||||
$title('VCMODE.CMD - Set Virtual Console Background Mode')
|
||||
$compact
|
||||
vcmode:
|
||||
do;
|
||||
|
||||
$include (:f2:copyrt.lit)
|
||||
$include (:f2:vaxcmd.lit)
|
||||
$include (:f2:comlit.lit)
|
||||
$include (:f2:mfunc.lit)
|
||||
$include (:f2:fcb.lit)
|
||||
|
||||
dcl fcb (1) byte external;
|
||||
dcl buff (1) byte external;
|
||||
|
||||
$include (:f2:sd.lit)
|
||||
|
||||
dcl ccb$pointer pointer;
|
||||
dcl ccb$ptr structure ( offset address, segment address) at
|
||||
(@ccb$pointer);
|
||||
$include (:f2:vccb.lit)
|
||||
dcl ccb based ccb$pointer ccb$structure;
|
||||
|
||||
dcl ccpmproduct lit '14h';
|
||||
dcl bdosversion lit '31h';
|
||||
|
||||
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;
|
||||
|
||||
mon3: procedure (func,info) address external;
|
||||
dcl func byte, info address;
|
||||
end mon3;
|
||||
|
||||
mon4: procedure (func,info) pointer external;
|
||||
dcl func byte, info address;
|
||||
end mon4;
|
||||
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S Externals *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
print$char: procedure(char);
|
||||
declare char byte;
|
||||
call mon1(2,char);
|
||||
end print$char;
|
||||
|
||||
print$console$buffer: procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (9,buffer$address);
|
||||
end print$console$buffer;
|
||||
|
||||
version: procedure address;
|
||||
return mon3(12,0);
|
||||
end version;
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* X D O S Externals *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
terminate: procedure;
|
||||
call mon1 (143,0);
|
||||
end terminate;
|
||||
|
||||
get$console$number: procedure byte;
|
||||
return mon2 (153,0);
|
||||
end get$console$number;
|
||||
|
||||
printb: procedure public;
|
||||
call print$char(' ');
|
||||
end printb;
|
||||
|
||||
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;
|
||||
|
||||
/*lbracket: procedure byte; /* find left bracket in command tail return */
|
||||
/* dcl i byte; /* its index. if not found ret 0 */
|
||||
/* i = 1;
|
||||
do while i <= buff(0) and (buff(i) = ' ' or buff(i) = tab);
|
||||
i = i + 1;
|
||||
end;
|
||||
if buff(i) = '[' then
|
||||
return(i);
|
||||
return(0);
|
||||
end lbracket;
|
||||
*/
|
||||
|
||||
help: procedure;
|
||||
call mon1(m$prt$buf, .(cr, lf, tab, tab, tab ,'VCMODE EXAMPLES$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, lf, 'vcmode', tab, tab, tab, tab, tab,
|
||||
'(show background mode)$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, 'vcmode dynamic', tab, tab, tab, tab,
|
||||
'(sets background mode)$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, 'vcmode buffered', tab, tab, tab, tab,
|
||||
tab, '"$'));
|
||||
/* call mon1(m$prt$buf, .(cr, lf, 'vcmode suspend', tab, tab, tab, tab,
|
||||
tab, '"$'));*/
|
||||
call mon1(m$prt$buf, .(cr, lf, 'vcmode size = 5', tab, tab, tab, tab,
|
||||
'(sets buffered mode max file size in)$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, tab, tab, tab, tab, tab,
|
||||
'(kilobytes, legal range is 1 to 8191)$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, tab, tab, tab, tab, tab,
|
||||
'(also sets background mode to buffered)$'));
|
||||
/* call mon1(m$prt$buf, .(cr, lf, 'vcmode size = 100H', tab, tab, tab,
|
||||
'(legal range in HEX is 1H to 1FFFFH)$'));*/
|
||||
call mon1(m$prt$buf, .(cr, lf, 'vcmode help', tab, tab, tab, tab,
|
||||
'(prints this message)$'));
|
||||
call mon1(m$prt$buf, .(cr, lf, '$'));
|
||||
call terminate;
|
||||
end help;
|
||||
|
||||
showstate: procedure (verb);
|
||||
dcl (verb,state) address;
|
||||
call mon1(m$prt$buf, .(cr,lf,'Background Mode For Virtual Console$'));
|
||||
call pdecimal (console, 100, true);
|
||||
call printb;
|
||||
call mon1(m$prt$buf, verb);
|
||||
state = ccb.state and csm$buffered;
|
||||
if state = 0 then
|
||||
call mon1(m$prt$buf, .(' Dynamic$'));
|
||||
else
|
||||
do;
|
||||
call mon1(m$prt$buf, .(' Buffered', cr, lf, 'Maximum file size = $'));
|
||||
call pdecimal(ccb.maxbufsiz, 10000, true);
|
||||
call mon1(m$prt$buf, .('K$'));
|
||||
end;
|
||||
call mon1(m$prt$buf, .(cr, lf, '$'));
|
||||
|
||||
end show$state;
|
||||
|
||||
$include (:f2:qd.lit)
|
||||
|
||||
dcl qpb qpb$structure;
|
||||
|
||||
read$change$mxq: procedure;
|
||||
qpb.qaddr = ccb.vcmxq;
|
||||
call mon1 (m$readq, .qpb);
|
||||
end read$change$mxq;
|
||||
|
||||
write$change$mxq: procedure;
|
||||
qpb.qaddr = ccb.vcmxq;
|
||||
call mon1 (m$writeq, .qpb);
|
||||
end write$change$mxq;
|
||||
|
||||
atohb: procedure (char) byte public; /* convert ascii hex to nibble value */
|
||||
declare char byte;
|
||||
if char >= '0' and char <= '9' then
|
||||
char = char - '0';
|
||||
else if char >= 'A' and char <= 'F' then
|
||||
char = char - 'A' + 10;
|
||||
else
|
||||
char = 255;
|
||||
return(char);
|
||||
end atohb;
|
||||
|
||||
atodb: procedure (char) byte public;/* convert ascii decimal to nibble value */
|
||||
declare char byte;
|
||||
if char >= '0' and char <= '9' then
|
||||
char = char - '0';
|
||||
else
|
||||
char = 255;
|
||||
return(char);
|
||||
end atodb;
|
||||
|
||||
atoi: procedure(str) word; /* convert ascii to 16 bit unsigned value */
|
||||
dcl str pointer;
|
||||
dcl (accum, temp) word;
|
||||
dcl (val, i, len) byte;
|
||||
dcl string based str (1) byte;
|
||||
i, accum = 0;
|
||||
if (len := findb(str, 'H', 5)) <> 0ffffh then /* hex conversion */
|
||||
do while (val := atohb(string(i))) <> 0ffh and i < len;
|
||||
accum = shl(accum, 4) + val;
|
||||
i = i + 1;
|
||||
end;
|
||||
else /* decimal is default base */
|
||||
do while (val := atodb(string(i))) <> 0ffh and i < 5;
|
||||
accum = 10 * accum + val;
|
||||
if i = 4 then
|
||||
temp = accum;
|
||||
i = i + 1;
|
||||
end;
|
||||
if temp > accum then /* overflow */
|
||||
accum = 0ffffh;
|
||||
return(accum);
|
||||
end atoi;
|
||||
|
||||
compare: procedure(ustr, ostr, minlen, maxlen) boolean;
|
||||
dcl (ustr, ostr) pointer; /* user string, option string */
|
||||
dcl user$string based ustr (1) byte;
|
||||
dcl (minlen, maxlen) byte;
|
||||
dcl cmplen word;
|
||||
cmplen = cmpb(ustr, ostr, maxlen);
|
||||
if cmplen = 0ffffh or (user$string(cmplen) = ' ' and cmplen >= minlen) then
|
||||
return(true);
|
||||
if user$string(cmplen) = ' ' then
|
||||
do;
|
||||
call mon1(m$prt$buf, .(cr,lf,'Invalid Command Option.', cr ,lf, '$'));
|
||||
call help;
|
||||
end;
|
||||
return(false);
|
||||
end compare;
|
||||
|
||||
dcl vers address initial (0);
|
||||
dcl no$state lit '0ffh';
|
||||
dcl console byte;
|
||||
|
||||
/*
|
||||
Main Program
|
||||
*/
|
||||
|
||||
plmstart: procedure public;
|
||||
dcl option$ptr byte;
|
||||
dcl num word;
|
||||
vers = version;
|
||||
if (high(vers) <> ccpmproduct) then
|
||||
do;
|
||||
call print$console$buffer(.(cr,lf,'Requires Concurrent CP/M-86', cr, lf,
|
||||
'$'));
|
||||
call mon1(0,0);
|
||||
end;
|
||||
|
||||
sysdat$pointer, ccb$pointer = mon4(m$sysdat, 0); /* system data segment */
|
||||
ccb$ptr.offset = sd.ccb + (console := mon2(m$getcns, 0)) * size(ccb);
|
||||
|
||||
call read$change$mxq; /* MXQ is written in kernel terminate code */
|
||||
if (ccb.state and csm$background) <> 0 then
|
||||
call mon1(m$prt$buf, .(cr,lf,'Virtual Console not in foreground', cr, lf,
|
||||
'$'));
|
||||
else if buff(0) = 0 then
|
||||
call show$state(.('is$')); /* show current state */
|
||||
else /* try to set state or show help message */
|
||||
do;
|
||||
fcb(f$type) = ' ';
|
||||
if compare(@fcb(f$name), @('BUFFERED'), 1, 8) then
|
||||
ccb.state = ccb.state or csm$buffered;
|
||||
else if compare(@fcb(f$name), @('DYNAMIC'), 1, 7) then
|
||||
ccb.state = ccb.state and not double(csm$buffered);
|
||||
else if compare(@fcb(f$name), @('HELP'), 1, 4) then
|
||||
call help;
|
||||
else if compare(@fcb(f$name), @('SIZE'), 1, 4) then /* change to 2,4 */
|
||||
do; /* when suspend is put back in */
|
||||
num = atoi(@fcb(f$name2));
|
||||
if num > 0 and num < 2000H then
|
||||
ccb.maxbufsiz = num; /* limit size to 16 bit record count */
|
||||
else
|
||||
do;
|
||||
call mon1(m$prt$buf, .(cr,lf,'File size out of range', cr ,lf, '$'));
|
||||
call help;
|
||||
end;
|
||||
ccb.state = ccb.state or csm$buffered;
|
||||
/* automatically sets to buffered */
|
||||
end;
|
||||
else
|
||||
do;
|
||||
call mon1(m$prt$buf, .(cr,lf,'Invalid Command Option.', cr ,lf, '$'));
|
||||
call help;
|
||||
end;
|
||||
call show$state(.('set to$'));
|
||||
end;
|
||||
call terminate;
|
||||
|
||||
end plmstart;
|
||||
end vcmode;
|
||||
Reference in New Issue
Block a user