mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 01:14:21 +00:00
295 lines
8.5 KiB
Plaintext
295 lines
8.5 KiB
Plaintext
$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;
|
||
|