Digital Research
This commit is contained in:
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions

View File

@@ -0,0 +1,13 @@
declare
lit literally 'literally',
dcl lit 'declare',
true lit '0ffh',
false lit '0',
no lit 'not',
boolean lit 'byte',
forever lit 'while true',
cr lit '13',
lf lit '10',
tab lit '9';

View File

@@ -0,0 +1,44 @@
/* Concurrent CP/M function numbers */
dcl m$prtbuf lit '9',
m$select lit '14',
m$openf lit '15',
m$closef lit '16',
m$deletef lit '19',
m$readf lit '20',
m$writef lit '21',
m$makef lit '22',
m$getlogin lit '24',
m$curdsk lit '25',
m$setdma lit '26',
m$setatt lit '30',
m$setusr lit '32',
m$readrf lit '33',
m$writerf lit '34',
m$resetdrv lit '37',
m$errmode lit '45',
m$dirbios lit '50',
m$makeq lit '134',
m$openq lit '135',
m$deleteq lit '136',
m$readq lit '137',
m$creadq lit '138',
m$writeq lit '139',
m$cwriteq lit '140',
m$delay lit '141',
m$dispatch lit '142',
m$setprior lit '145',
m$detach lit '147',
m$setcns lit '148',
m$parse lit '152',
m$getcns lit '153',
m$sysdat lit '154',
m$getpd lit '156',
m$abort lit '157';
/* Internal calls */
dcl mi$sleep lit '0212H',
mi$wakeup lit '0213H';

View File

@@ -0,0 +1,9 @@
/* MP/M-86 XIOS function numbers */
dcl mx$conin lit '1',
mx$conout lit '2',
mx$lstout lit '4',
mx$switch lit '7',
mx$upstatus lit '8';

View File

@@ -0,0 +1,19 @@
$ !
$ ! this proc compiles, links and generates in hex the PIN process RSP
$ ! for Concurrent CP/M-86: vers IBM PC 1.0
$ ! It is assumed that the BATCH command is used for
$ ! setting the default directory
$ !
$ set verify
$ def sys$print nowhere ! log file goes to syslogin
$ newplm ! use NEW plm compiler
$ assign 'f$directory()' f1:
$ as86 rhpin.a86
$ as86 pxios.a86
$ pl86 pin.plm optimize(3) debug xref 'p1' 'p2' 'p3'
$ li86 rhpin.obj, pxios.obj, pin.obj to rhpin.lnk
$ ren rhpin.lnk pin.lnk
$ lo86 pin.lnk od(sm(code,dats,data,const,stack)) -
ad(sm(code(0),dats(10000h))) ss(stack(0)) to pin.dat
$ newh86 pin.dat
$ pclean

View File

@@ -0,0 +1,211 @@
:020000020000FC
:10000000558BEC8B56048B4E06CDE05DC20400553B
:100010008BEC8B5E048B56068B4E081E8E1E0000EA
:100020008B3668008E441090FF1E0000901F5DC24A
:020030000600C8
:020000021000EC
:1000000000000000000000000000000000000000F0
:020000021001EB
:100000000000000000B9030050494E2020202020AD
:08001000040000000000FF00E5
:020000021004E8
:1000000000000000000000000000000000000000F0
:1000100000000000000000000000000000000000E0
:1000200000000000000000000000000000000000D0
:10003000000000003A010000000000000000000085
:0A00400000000000000000000000B6
:02000002100AE2
:0700000001000000000000F8
:02000002100AE2
:10000700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC29
:10001700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC19
:10002700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC09
:10003700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCF9
:10004700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCE9
:10005700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCD9
:10006700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC9
:10007700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCB9
:10008700CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCA9
:03009700CCCCCC02
:020000021013D9
:06000A0050070000000099
:020000020004F8
:10000000558BEC8B46088B4E068B56041E8E1E00BD
:10001000008B3668008E4410FF1E28001F5DC2064C
:0100200000DF
:020000021018D4
:02000C00FFFFF4
:020000021016D6
:06000800000000000000F2
:020000021017D5
:0100080000F7
:020000021017D5
:100009004142434445464748494A4B4C4D4E4F505F
:0100190020C6
:020000021018D4
:10000E000D0A4F70656E2066696C65206F6E2064F8
:09001E007269766528732920003F
:02000002101AD2
:010007002CCC
:02000002101AD2
:020008000D0ADF
:02000002101AD2
:10000A000D0A5072696E74657220427573790D0A11
:01001A0000E5
:020000020006F6
:10000200558BECB8010050B800005050E8CFFFA368
:040012006E015DC35B
:020000020007F5
:10000600558BECC606770100A07701B40089C6C4FB
:100016005E04268A083A4E08B0FF75014089F25000
:100026003A560AB0FF7201405922C1D0D87319B8A6
:10003600020050268A00B40050A07601B40050E8B1
:0C00460088FFFE067701EBC05DC20800D9
:02000002000CF0
:10000200558BEC8B4604A35A01B08950B858015065
:07001200E82BFF5DC20200B4
:02000002000DEF
:10000900558BEC8B4604A35A01B08B50B85801505C
:07001900E814FF5DC20200C4
:02000002000FED
:10000000558BECB8120250FF7604B8090050E80E88
:05001000FF5DC20200CB
:020000020010EC
:10000500558BECB8130250FF7604B8000050E8F9A0
:05001500FE5DC20200C7
:020000020011EB
:10000A00558BECFAC45E04268A470424083C007423
:10001A00098D472250E8BEFFEBEAC45E0426804FF2
:07002A000408FB5DC20400A5
:020000020014E8
:10000100558BECC45E0426806704F78D472250E8C7
:06001100B2FF5DC2040015
:020000020015E7
:10000700558BECC45E04268B470E25010083F80050
:10001700743EC45E04268B4714A35A01C7065E01CB
:100027008C01B08C50B8580150E87DFEC45E0426A0
:100037008B4714A35A01C7065E018C01B08C50B8D8
:10004700580150E863FEC45E048D472650E85EFF02
:040057005DC2040082
:02000002001AE2
:10000B00558BECC41E4C01268B4712A35A018D460F
:10001B0004A35E01B08C50B8580150E837FE83F84A
:10002B00FF7523C41E4C010653E843FFB802005072
:10003B00B8070050A07601B40050E858FEC41E4C1F
:0A004B00010653E850FF5DC20200F9
:02000002001FDD
:10000500558BECC4064C01A350018C0652018A465F
:1000150004B400B92C00F7E1C41E4001260347547F
:07002500A34C015DC20200C3
:020000020021DB
:10000C00558BECA06E01C41E4001263A4747720284
:10001C005DC3C41E4C01268B470E25080083F800D7
:10002C0074025DC3A06E01C41E4C01263A470B75C9
:10003C00025DC3A06E01A27601FF366E01E899FF46
:10004C00C41E500126FF7716E85BFEC41E50010645
:10005C0053E8AAFEC41E5001268B470E0D02002643
:10006C0089470E25040083F80074062681670EFB71
:10007C00FFC41E4C0126FF7716E82AFEC41E4C0155
:10008C000653E879FEB8070050B8000050A076017E
:10009C00B40050E88EFDC40650010650E886FEC43C
:1000AC001E500126FF7716E813FEC41E5001268B46
:1000BC00470E25010083F80074050653E87CFEC446
:1000CC001E4C01268B470E25FDFF2689470E250168
:1000DC000083F8007413268B470E0D040025BFFF18
:1000EC002689470E0653E852FEC4064C010650E81A
:1000FC0033FEC41E4C0126FF7716E8C0FDC41E4C0F
:10010C0001268B470E25800083F8007407C60678FD
:10011C0001FFEB05C606780100B8080050B80000D6
:07012C005050E8FFFC5DC329
:020000020034C8
:10000300558BECC41E4401268B472225080083F838
:10001300007409FF366E01E84EFE5DC3C41E4C0139
:1000230026FF7716E858FDC41E4C01268B470E2584
:100033007FFE2689470EC60678010025040083F853
:1000430000740E268B470E25FBFF0D2000268947E3
:100053000EC41E4C01268B4712A35A01C7065E012C
:100063007001B08A50B8580150E851FC3CFF75F25A
:10007300C41E4C0126C647070026FF7716E816FD67
:10008300C41E4C010653E88BFDC41E4C018D47244E
:1000930050E82EFDC41E4C01268B07A36801B09DBA
:1000A30050B8680150E815FCB01850B8000050E88B
:1000B3000BFCA37401C70672010100C6068A010086
:1000C300C70670010000833E70010F7739A17401E8
:1000D3002306720183F8007422B02550FF367201A3
:1000E300E8DAFB3C007414A1700183C0418A1E8AC4
:1000F30001B70088877901FE068A01D12672018340
:100103000670010173C0803E8A01007703E9850010
:10011300C41E4C010653E8BEFCB0FF50B000508D26
:10012300068E011E50E80BFCB00150B000508D0646
:1001330079011E50E8FCFBC70670010100A08A018B
:10014300FEC8B400390670017729B00150B00050E1
:100153008D06A7011E50E8DAFBB00150B000508BAA
:100163001E70018D8779011E50E8C7FB830670015D
:100173000173CAB00250B000508D06A8011E50E8AA
:10018300B1FBC41E4C0126C647050026C647060020
:070193000653E869FC5DC39F
:02000002004DAF
:10000A00558BECC41E4401268B472225800083F8B9
:10001A00007409FF366E01E8B7FC5DC3C41E4C01CB
:10002A0026FF7716E8C1FBC41E4C012681770E0015
:10003A000126FF7716E8C7FBC41E4C010653E83CAD
:0F004A00FCB8080050B800005050E819FB5DC327
:020000020052AA
:10000900558BECC41E4C0126FF7716E88BFBC41EEA
:100019004C012681670EFFFE26FF7716E891FBC487
:100029001E4C010653E806FCB8080050B800005001
:0600390050E8E3FA5DC38C
:020000020055A7
:10000F00558BECC41E4401268B470625001083F840
:10001F000074025DC3C41E4401268B4722250200D3
:10002F0083F8007409FF366E01E820FC5DC3C41E1F
:10003F004C0126FF7716E82AFBC41E4C01268B477E
:10004F000E25FFFE0D80002689470EB8080050B818
:10005F0000005050E88AFAC41E4C0126FF7716E8BC
:09006F0018FBC6067801FF5DC311
:02000002005CA0
:10000800558BECC41E4C0126FF7716E8ECFAC41E8B
:100018004C012681670E7FFF26FF7716E8F2FAC4A7
:100028001E4C010653E867FBC41E4C018D47245043
:10003800E80AFBB8080050B800005050E839FAC682
:06004800067801005DC313
:0200000200609C
:10000E00558BECC41E4401268B472225040083F831
:10001E00007409FF366E01E883FB5DC3E8FCFEC485
:10002E001E4C0126FF7716E88AFAC41E4C01268B59
:10003E00470E25000283F8007578C4364401268ADF
:10004E004424B400B90A00F7E1C43E4001260385FA
:10005E008600A35401FAC43E540126833D00752444
:10006E0026C705FFFFA07601268845098E064601A4
:10007E00268A44248E064E012688470826814F0E76
:10008E000002EB77FBC41E4C010653E87EFAB0FF6C
:10009E0050B000508D06AA011E50E8CBF9C41E4C7C
:1000AE000126C647060026C64705000653E883FA12
:1000BE00EB4AFAC41E4C01268A4708B400B90A005E
:1000CE00F7E1C43640012603848600A35401C436EA
:1000DE00540126C704000026C64409FF8E064E01B1
:1000EE0026C64708FF2681670EFFFD26806704DFC0
:1000FE008E0656018D440250E8FCF9FBC41E4C01DD
:10010E0026FF7716E8C4F9B8080050B80000505022
:05011E00E81FF95DC3BC
:0200000200728A
:10000300558BECC41E4C01268B07A3440183F800D7
:100013007417C41E4401268B470625400083F8004D
:0D0023007504B0005DC3E87CFEB0FF5DC356
:02000002007587
:10000000558BECA10000A34201A35601A34E01C4ED
:100010001E4001268B4754A34C01B09C50B80000F1
:1000200050E88CF8891E44018C064601C60676010C
:1000300000E8DEF8803E6F01FF7505E88EFAEBF10F
:10004000803E6F010075EAE889FFD0D87309FF365A
:100050006E01E806FAEBDAA07801D0D8733F803E53
:100060006E0103743F803E6E01117505E809FEEBD9
:10007000C0803E6E01107450C4064C010650E84921
:10008000F9B8020050B8070050A07601B40050E85B
:100090005EF8C4064C010650E856F9EB94803E6EBB
:1000A00001037505E84CFBEB88803E6E0113750576
:1000B000E85CFDEBF2803E6E010F7505E8CBFCEBD2
:1000C000E6803E6E01107505E8F3FDEBDAC41E4CC8
:1000D00001268B470E25000183F8007403E8F9FC24
:0500E000E96BFF5DC3A8
:00000001FF

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,493 @@
$title ('PIN RSP - reads characters from keyboard')
$set (debug=0)
$compact
pin:
do;
/* PIN performs physical input from for each physical console
and places the characters into the input queue associated
with each virtual console. Switch screen commands are
received from the XIOS and acted on by PIN.
Control S/Q, Control O and Control C are intercepted and
processed by PIN. The input queues are created by VOUT.
*/
$include (:f1:comlit.lit)
dcl rsp$link word external; /* segment of SYSDAT */
$include (:f1:mfunc.lit)
$include (:f1:mxfunc.lit)
$include (:f1:sdpin.lit)
$include (:f1:proces.lit)
declare pd$pointer pointer;
declare pd$ptr structure (offset word, segment word) at (@pd$pointer);
declare pd based pd$pointer pd$structure;
declare ncopies byte external, /* copy number of this process, corresponds */
cnsnum byte at(@ncopies);/* with physical console number */
declare ctrlC lit '3'; /* some ASCII codes */
declare ctrlD lit '4';
declare bell lit '7';
declare ctrlO lit '15';
declare ctrlP lit '16';
declare ctrlQ lit '17';
declare ctrlS lit '19';
declare esc lit '27';
/* - global variables - */
$include (:f1:vccb.lit)
declare ccb$pointer pointer;
declare ccb$ptr structure(offset word,segment word) at (@ccb$pointer);
declare ccb based ccb$pointer ccb$structure;
declare old$ccb$pointer pointer;
declare old$ccb based old$ccb$pointer ccb$structure;
declare lcb$pointer pointer;
declare lcb$ptr structure(offset word,segment word) at (@lcb$pointer);
declare lcb based lcb$pointer lcb$structure;
declare screen byte; /* current foreground screen number */
$include (:f1:qd.lit)
declare qpb qpb$structure;
dcl null word data (0ffffh); /* sent to VOUTQ to wake up VOUT */
/* Note: this forces a 2 byte constant section and thus hex generation */
dcl apb structure ( /* abort parameter block */
pd word, term word, cns byte, rsrvd byte) initial (0,0,0,0);
dcl cword word, /* format of console input from XIOS */
chars (2) byte at (@cword),
char byte at (@chars(0)),
char$type byte at(@chars(1)),
ct$switch lit '0ffh',
ct$data lit '0';
mon1: procedure(func,a) external;
dcl func byte, a address;
end mon1;
mon2: procedure(func,a) byte external;
dcl func byte, a address;
end mon2;
mon3: procedure(func,a) address external;
dcl func byte, a address;
end mon3;
mon4: procedure(func,a) pointer external;
dcl func byte, a address;
end mon4;
intsys: procedure (cx, dx, bx) external; /* internal O.S. functions */
dcl (cx, dx, bx) word;
end intsys;
/* the following 4 procedures call the XIOS directly, the PXIOS.A86 */
/* sets the registers to make this legal. DS = system data segment, */
/* ES = UDA. The parameters are passed AX=FUNC, CX=P1, DX=P2 */
pxios1: procedure(func,p1,p2) external;
dcl (func,p1,p2) address;
end pxios1;
/*pxios2: procedure(func,p1,p2) byte external;
dcl (func,p1,p2) address;
end pxios2;*/
pxios3: procedure(func,p1,p2) word external;
dcl (func,p1,p2) address;
end pxios3;
/*pxios4: procedure(func,p1,p2) pointer external;
dcl (func,p1,p2) address;
end pxios4;*/
conin: procedure;
cword = pxios3(mx$conin, 0, 0); /* get console input from XIOS */
end; /* AX=func, CX=0, DX(device#)=0 */
print$msg: procedure(len, endchar, sptr); /* print string to delimiter */
dcl (len, i, endchar) byte, sptr pointer, /* or len number of chars */
string based sptr (1) byte;
i = 0;
do while string(i) <> endchar and i < len;
call pxios1(mx$conout, string(i), screen);
i = i + 1;
end;
end print$msg;
$if debug=1
error: procedure (msg$ptr);
dcl msg$ptr pointer;
call print$msg(0ffh, 0, @(cr, lf, '**** PIN ERROR ****', cr, lf, 0));
call print$msg(0ffh, '$', msg$ptr);
halt;
end error;
$endif
read$change$mxq: procedure (qaddr);
dcl qaddr address;
qpb.qaddr = qaddr;
call mon1 (m$readq, .qpb);
end read$change$mxq;
write$change$mxq: procedure (qaddr);
dcl qaddr address;
qpb.qaddr = qaddr;
call mon1 (m$writeq, .qpb);
end write$change$mxq;
sleep: procedure (list$root);
dcl list$root word;
call intsys(mi$sleep, list$root, ps$ciowait);
end sleep;
wake$up: procedure (list$root);
dcl list$root word;
call intsys(mi$wakeup, list$root, 0);
end wake$up;
/* The conout flag is set and "owned" before any process calls the XIOS
console output routine for a particular screen. PIN sets this flag
to insure there is no process in the XIOS console output code. The
ccb.cosleep is a temporary location for processes waiting to own the
the XIOS conout bit. */
set$conout$flag: procedure(ccb$ptr);
dcl ccb$ptr pointer;
dcl ccb based ccb$ptr ccb$structure;
disable;
do while (ccb.flag and cf$conout) <> 0; /* Another process is in XIOS */
call sleep (.ccb.cosleep); /* PIN gets awakened 1st: */
end; /* better priority */
ccb.flag = ccb.flag or cf$conout;
enable;
end set$conout$flag;
reset$conout$flag: procedure (ccb$ptr);
dcl ccb$ptr pointer;
dcl ccb based ccb$ptr ccb$structure;
ccb.flag = ccb.flag and not cf$conout; /* wake sleeping process */
call wakeup(.ccb.cosleep);
end reset$conout$flag;
wake$vout: procedure(ccb$ptr);
dcl ccb$ptr pointer;
dcl ccb based ccb$ptr ccb$structure;
if (ccb.state and csm$buffered) = 0 then
return; /* dynamic mode */
qpb.qaddr = ccb.voutq;
qpb.buffptr = .null; /* VOUT message is 2 byte format */
call mon1(m$cwriteq, .qpb); /* null message if first byte = 0ffh */
qpb.qaddr = ccb.voutq;
qpb.buffptr = .null; /* VOUT needs two wake-ups in some */
call mon1(m$cwriteq, .qpb); /* situations */
call wake$up(.ccb.vsleep);
end wake$vout;
write$vinq: procedure(c);
dcl c byte;
qpb.qaddr = ccb.vinq;
qpb.buffptr = .c;
if mon3(m$cwriteq, .qpb) = 0ffffh then /* ring console bell if type */
do;
call set$conout$flag(@ccb); /* XIOS is not reentrant on same console */
call pxios1(mx$conout, bell, screen); /* ahead buffer if full */
call reset$conout$flag(@ccb);
end;
end write$vinq;
set$ccb: procedure (vc); /* base VCCB structure */
dcl vc byte;
old$ccb$pointer = ccb$pointer;
ccb$ptr.offset = sd.ccb + size(ccb) * vc;
end set$ccb;
/* the functions below act on special keys received from the keyboard */
dcl controlS$has$been$pressed boolean initial (false);
switch: procedure; /* switch virtual consoles */
if char >= sd.ncns then
return; /* check for legal range */
if (ccb.state and csm$noswitch) <> 0 then /* no switch state */
return;
if char = ccb.vc then /* request is for currently selected screen */
return;
call set$ccb(screen := char); /* switch old$ccb and ccb structures */
/* - Switch Out Action - */
call read$change$mxq(oldccb.vcmxq); /* read the MX 1st THEN */
call set$conout$flag(@oldccb); /* the conout flag */
oldccb.state = oldccb.state or csm$background;
if (oldccb.state and csm$purging) <> 0 then
oldccb.state = oldccb.state and not double(csm$purging);
/* turn off purge */
/* Ensure the two affected screens are not currently being updated */
/* by the XIOS console output routines. */
call read$change$mxq(ccb.vcmxq);
call set$conout$flag$(@ccb);
call pxios1(mx$switch, 0, screen);
call reset$conout$flag(oldccb$pointer);
call write$change$mxq(oldccb.vcmxq); /* allow VOUT to change state */
if (oldccb.state and csm$buffered) <> 0 then /* background buffered */
call wake$vout(@oldccb); /* send chars to VOUT if buffer, */
/* else user process hangs on USLEEP */
/* - Switch In Action - */
ccb.state = ccb.state and not double(csm$background);
if (ccb.state and csm$buffered) <> 0 then
do; /* buffer or buffer error states */
/* turn on purge */
ccb.state = (ccb.state or csm$purging) and not double(csm$filefull);
/* turn off error could print msg */
call wake$vout(@ccb); /* here eventually */
end;
call reset$conout$flag(ccb$pointer);
call write$change$mxq(ccb.vcmxq);
if (ccb.state and csm$ctrlS) <> 0 then /* we "own" the XIOS console */
controlS$has$been$pressed = true; /* output flag */
else
controlS$has$been$pressed = false;
call pxios1(mx$upstatus, 0, 0);
end switch;
dcl drive$letters (17) byte initial ('ABCDEFGHIJKLMNOP ');
controlC: procedure;
dcl (junk,cur$drive,logged$in$drives) word;
dcl letter$index byte;
if (pd.conmode and pcm$ctlc) <> 0 then
do;
call write$vinq(char);
return;
end;
call read$change$mxq(ccb.vcmxq); /* keep CCB state from changing */
/* while we test and change it */
ccb.state = ccb.state and not double(csm$ctrlS or csm$ctrlO);
controlS$has$been$pressed = false;
/* control C turns off control S and */
/* control O, doesn't change control P */
if (ccb.state and csm$purging) <> 0 then /* stop purge */
ccb.state = ccb.state and not double (csm$purging) or csm$abort;
qpb.qaddr = ccb.vinq; /* drain input queue, we have better */
qpb.buffptr = .junk; /* priority than user process or TMP */
do while mon2(m$creadq, .qpb) <> 0ffh; /* drain type-ahead q */
end;
ccb.nchar = 0; /* zero console status look ahead */
call write$change$mxq(ccb.vcmxq);
call wake$vout(@ccb); /* let VOUT clean up if buffering */
call wake$up(.ccb.usleep); /* user process could have gone to sleep */
/* during this rigamarole */
apb.pd = ccb.attach; /* CIO keeps aborts from happening */
call mon1(m$abort, .apb); /* while in the XIOS, do abort after */
/* VOUT has cleaned up, otherwise the TMP*/
/* with a better priority can print its */
/* prompt, and then VOUT prints one last */
/* purge character */
/* reset drives and print which fail */
logged$in$drives = mon3(m$getlogin,0);
cur$drive = 1; /* drive to reset */
letter$index = 0;
do junk = 0 to 15;
if (logged$in$drives and cur$drive) <> 0 then
if mon2(m$resetdrv, cur$drive) <> 0 then
do;
drive$letters(letter$index) = 'A' + junk;
letter$index = letter$index + 1;
end;
cur$drive = shl(cur$drive,1);
end;
if letter$index > 0 then
do;
call set$conout$flag(@ccb);
call print$msg(0ffh,0,@(cr,lf,'Open file on drive(s) ',0));
call print$msg(1,0,@drive$letters(0));
do junk = 1 to letter$index - 1;
call print$msg(1,0,@(','));
call print$msg(1,0,@drive$letters(junk));
end;
call print$msg(2,0,@(cr,lf));
ccb.startcol, ccb.column = 0; /* for function 10 - line redraw */
call reset$conout$flag(@ccb);
end;
end controlC;
controlO: procedure; /* toggle console output byte bucket */
if (pd.conmode and pcm$ctlo) <> 0 then /* ignore if control P or if func */
do;
call write$vinq(char);
return;
end;
call read$change$mxq(ccb.vcmxq);
ccb.state = ccb.state xor csm$ctrlO;
call write$change$mxq(ccb.vcmxq);
call wake$vout(@ccb);
call pxios1(mx$upstatus, 0, 0);
end controlO;
turn$off$ctrlO: procedure;
call read$change$mxq(ccb.vcmxq);
ccb.state = ccb.state and not double(csm$ctrlO);
call write$change$mxq(ccb.vcmxq);
call wake$vout(@ccb);
call pxios1(mx$upstatus, 0, 0);
end turn$off$ctrlO;
controlS: procedure;
if (pd.flag and pf$noctls) <> 0 then /* special condition for CLI day */
return; /* file logging */
if (pd.conmode and pcm$ctlS) <> 0 then
do;
call write$vinq(char);
return;
end;
call read$change$mxq(ccb.vcmxq);
ccb.state = ccb.state and not double(csm$ctrlO) or csm$ctrlS;
/* control S turns off control O */
call pxios1(mx$upstatus, 0, 0);
call write$change$mxq(ccb.vcmxq);
controlS$has$been$pressed = true;
end controlS;
controlQ: procedure;
call read$change$mxq(ccb.vcmxq);
ccb.state = ccb.state and not double(csm$ctrlS);
call write$change$mxq(ccb.vcmxq);
call wake$vout(@ccb);
call wakeup(.ccb.usleep);
call pxios1(mx$upstatus, 0, 0);
controlS$has$been$pressed = false;
end controlQ;
controlP: procedure;
if (pd.conmode and pcm$rout) <> 0 then /* control P is ignored if console */
do;
call write$vinq(char);
return; /* mode is raw output */
end;
call turn$off$ctrlO;
call read$change$mxq(ccb.vcmxq);
if (ccb.state and csm$ctrlP) = 0 then /* turn control P on */
do;
lcb$ptr.offset = sd.lcb + pd.lst * size(lcb);
disable;
if lcb.attach = 0 then
do;
lcb.attach = 0ffffh;
lcb.msource = screen;
ccb.mimic = pd.lst;
ccb.state = ccb.state or csm$ctrlP;
enable;
end;
else
do;
enable;
call set$conout$flag(@ccb);
call print$msg(0ffh,0,@(cr,lf,'Printer Busy',cr,lf,0));
ccb.column,ccb.startcol = 0; /* for function 10 */
call reset$conout$flag(@ccb);
end;
end;
else /* turn off control P */
do;
disable;
lcb$ptr.offset = sd.lcb + ccb.mimic * size(lcb);
lcb.attach = 0;
lcb.msource,ccb.mimic = 0ffh;
ccb.state = ccb.state and not double(csm$ctrlP);
ccb.flag = ccb.flag and not cf$bufp;
call wakeup(.lcb.queue);
enable;
end;
call write$change$mxq(ccb.vcmxq);
call pxios1(mx$upstatus, 0, 0);
end controlP;
raw: procedure boolean;
if (pd$ptr.offset := ccb.attach) = 0 then /* 0 during initialization */
return(true);
if (pd.flag and pf$raw) = 0 then /* set by function 6 only */
return(false);
call controlQ; /* avoid deadlock if user is mixing func 6 */
return(true); /* other console I/O calls */
end raw;
plmstart: procedure public;
sysdat$ptr.segment, lcb$ptr.segment, ccb$ptr.segment = rsp$link;
/* init pointers */
ccb$ptr.offset = sd.ccb; /* CCB 0 is first in the table */
pd$pointer = mon4(m$getpd, 0);
screen = 0; /* initial foreground console is 0 */
do forever;
call conin;
if char$type = ct$switch then
call switch;
else if char$type = ct$data then
do;
if raw then
call write$vinq(char);
else
do;
if controlS$has$been$pressed then
do;
if char = ctrlC then
call controlC;
else if char = ctrlQ then
call controlQ;
else if char = ctrlP then
call controlP;
else
do;
call set$conout$flag(ccb$pointer); /* guard against unlikely */
call pxios1(mx$conout,bell,screen); /* race condition */
call reset$conout$flag(ccb$pointer);
end;
end;
else
do; /* controlS has not been pressed */
if char = ctrlC then
call controlC;
else if char = ctrlS then
call controlS;
else if char = ctrlO then
call controlO;
else if char = ctrlP then
call controlP;
else
do;
if (ccb.state and csm$ctrlO) <> 0 then
call turn$off$ctrlO;
call write$vinq(char);
end;
end;
end;/* else (if not raw) */
end; /* if char$type <> ct$data and char$type <> ct$switch then */
/* XIOS console input is ignored */
end; /* do forever */
end plmstart;
end pin;

View File

@@ -0,0 +1,48 @@
/*
Proces Literals MP/M-8086 II
*/
declare pnamsiz literally '8';
declare pd$hdr literally 'structure
(link word,thread word,stat byte,prior byte,flag word,
name (8) byte,uda word,dsk byte,user byte,ldsk byte,luser byte,
mem word';
declare pd$structure literally 'pd$hdr,
dvract word,wait word,org byte,net byte,parent word,
cns byte,abort byte,conmode word,lst byte,sf3 byte,sf4 byte,sf5 byte,
reservd (4) byte,pret word,scratch word)';
declare psrun lit '00',
pspoll lit '01',
psdelay lit '02',
psswap lit '03',
psterm lit '04',
pssleep lit '05',
psdq lit '06',
psnq lit '07',
psflagwait lit '08',
psciowait lit '09';
declare pf$sys lit '00001h',
pf$keep lit '00002h',
pf$kernal lit '00004h',
pf$pure lit '00008h',
pf$table lit '00010h',
pf$resource lit '00020h',
pf$raw lit '00040h',
pf$ctlc lit '00080h',
pf$active lit '00100h',
pf$tempkeep lit '00200h',
pf$ctld lit '00400h',
pf$childabort lit '00800h',
pf$noctls lit '01000h';
declare pcm$11 lit '00001h',
pcm$ctls lit '00002h',
pcm$rout lit '00004h',
pcm$ctlc lit '00008h',
pcm$ctlo lit '00080h',
pcm$rsx lit '00300h';

View File

@@ -0,0 +1,50 @@
; Interface to call Physical XIOS
; From a process not in the O.S.
; code reentrant, separate data areas per process
; used by VOUT and PIN RSPs
name pxios
cgroup group code
dgroup group dats
assume cs:cgroup
assume ds:dgroup
dats segment public 'DATA'
extrn rsplink:word ;segment of SYSDAT
extrn udaseg:word ;UDA must be in ES for XIOS call
extrn u_retseg:word, u_wrkseg:word, u_insys:byte
dats ends
code segment public 'CODE'
public pxios1, pxios2, pxios3, pxios4
xiosmod equ 28h
p_uda equ 10h
rlr equ 68h
pxios2 equ pxios1
pxios3 equ pxios1
pxios4 equ pxios1
pxios1 proc
push bp
mov bp,sp
mov ax,[bp+8] ;set up registers
mov cx,[bp+6]
mov dx,[bp+4]
push ds
mov ds,rsplink ;SYSDAT
mov si,ds:word ptr rlr ;ready list root
mov es,[p_uda+si] ;UDA
call ds:dword ptr [xiosmod]
pop ds
pop bp
ret 6
pxios1 endp
code ends
end

View File

@@ -0,0 +1,68 @@
8086/8087/8088 MACRO ASSEMBLER PXIOS 17:10:39 04/22/83 PAGE 1
VAX/VMS 8086/8087/8088 MACRO ASSEMBLER V1.0 ASSEMBLY OF MODULE PXIOS
OBJECT MODULE PLACED IN PXIOS.OBJ
NO INVOCATION LINE CONTROLS
LOC OBJ LINE SOURCE
1 ; Interface to call Physical XIOS
2 ; From a process not in the O.S.
3 ; code reentrant, separate data areas per process
4 ; used by VOUT and PIN RSPs
5
6 name pxios
7
8 cgroup group code
9 dgroup group dats
10
11 assume cs:cgroup
12 assume ds:dgroup
13
---- 14 dats segment public 'DATA'
15 extrn rsplink:word ;segment of SYSDAT
16 extrn udaseg:word ;UDA must be in ES for XIOS call
17 extrn u_retseg:word, u_wrkseg:word, u_insys:byte
---- 18 dats ends
19
---- 20 code segment public 'CODE'
21 public pxios1, pxios2, pxios3, pxios4
0028 22 xiosmod equ 28h
0010 23 p_uda equ 10h
0068 24 rlr equ 68h
25
0000 26 pxios2 equ pxios1
0000 27 pxios3 equ pxios1
0000 28 pxios4 equ pxios1
29
0000 30 pxios1 proc
0000 55 31 push bp
0001 8BEC 32 mov bp,sp
33
0003 8B4608 34 mov ax,[bp+8] ;set up registers
0006 8B4E06 35 mov cx,[bp+6]
0009 8B5604 36 mov dx,[bp+4]
37
000C 1E 38 push ds
000D 8E1E0000 E 39 mov ds,rsplink ;SYSDAT
0011 8B366800 40 mov si,ds:word ptr rlr ;ready list root
0015 8E4410 41 mov es,[p_uda+si] ;UDA
0018 FF1E2800 42 call ds:dword ptr [xiosmod]
001C 1F 43 pop ds
44
001D 5D 45 pop bp
001E C20600 46 ret 6
47 pxios1 endp
48
---- 49 code ends
50 end
8086/8087/8088 MACRO ASSEMBLER PXIOS 17:10:39 04/22/83 PAGE 2
LOC OBJ LINE SOURCE
ASSEMBLY COMPLETE, NO ERRORS FOUND

View File

@@ -0,0 +1,39 @@
/* Queue Descriptor */
dcl qnamsiz lit '8';
dcl qd$structure lit 'structure(
link word,
net byte,
org byte,
flags word,
name(qnamsiz) byte,
msglen word,
nmsgs word,
dq word,
nq word,
msgcnt word,
msgout word,
buffer word)';
/* queue flag values */
dcl qf$mx lit '001h'; /* Mutual Exclusion */
dcl qf$keep lit '002h'; /* NO DELETE */
dcl qf$hide lit '004h'; /* Not User writable */
dcl qf$rsp lit '008h'; /* rsp queue */
dcl qf$table lit '010h'; /* from qd table */
dcl qf$rpl lit '020h'; /* rpl queue */
dcl qf$dev lit '040h'; /* device queue */
/* Queue Parameter Block */
dcl qpb$structure lit 'structure(
flgs byte,
net byte,
qaddr word,
nmsgs word,
buffptr word,
name (qnamsiz) byte )';

View File

@@ -0,0 +1,111 @@
; Code and Data Interface for PIN RSP
; Virtual console support for Concurrent CP/M
; March 30, 1982
name rpin
cgroup group code
dgroup group dats
assume cs:cgroup,ds:dgroup
public xdos,mon1,mon2,mon3,mon4,intsys
public rsplink, pd, ncopies, udaseg
public u_retseg, u_wrkseg, u_insys
extrn plmstart:near
code segment public 'CODE'
xdos proc
push bp
mov bp,sp
mov dx,[bp+4]
mov cx,[bp+6]
int 224
pop bp
ret 4
xdos endp
intsys proc ;call O.S. as if we are
push bp ;already in it
mov bp,sp
mov bx,[bp+4]
mov dx,[bp+6]
mov cx,[bp+8]
push ds
mov ds,rsplink ;DS = Sysdat Segment
mov si,ds:word ptr rlr
mov es,[si+p_uda]
call ds:dword ptr [supervisor]
pop ds
pop bp
ret 6
intsys endp
mon1 equ xdos
mon2 equ xdos
mon3 equ xdos
mon4 equ xdos
code ends
dats segment public 'DATA'
rlr equ 68h ;ready list root
p_uda equ 10h ;UDA in process descriptor
supervisor equ 0 ;supervisor entry point for internal
nvcns equ 47h
rsphdr_len equ 16
pd_len equ 30H
uda_len equ 100H
insysoff equ 60H
rsp_top equ 0
rsp_pd equ rsp_top + rsphdr_len
rsp_uda equ rsp_pd + pd_len
rsp_bottom equ rsp_uda + uda_len
org rsp_top
;RSP header
rsplink dw 0 ;becomes system data page paragraph
sdatvar dw 0 ;tell gensys to one
ncopies db 0
dw 0,0,0,0, 0
db 0
org rsp_pd
pd dw 0,0 ;link fields
db 0 ;status
db 185 ;initial priority better than TMP - worse than
;VOUT
dw 3 ;flags - system and keep
db 'PIN ' ;name
udaseg dw rsp_uda/10h ;uda paragraph
db 0,0 ;disk,user
db 0,0 ;ldisk,luser
dw 0ffh ;puremem - re-entrant
;rest of pd
org rsp_uda ;start of uda
uda dw 0
dw 0 ;no default DMA
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
dw 0,0,0,0, 0,0,0,0, 0,0,0,0
dw offset stk_top
dw 0,0,0,0, 0,0,0,0
u_wrkseg dw 0
u_retseg dw 0
org rsp_uda + insysoff
u_insys db 1
db 0 ;u_stat_save
dw 0 ;ccb
dw 0 ;lcb
db 0 ;print string delimiter
db 93h dup (0cch) ;fill rest of UDA stack with INT3s
stk_top dw plmstart
dw 0,0 ;segment, flags: unknown
dats ends
end

View File

@@ -0,0 +1,175 @@
8086/8087/8088 MACRO ASSEMBLER RPIN 17:10:27 04/22/83 PAGE 1
VAX/VMS 8086/8087/8088 MACRO ASSEMBLER V1.0 ASSEMBLY OF MODULE RPIN
OBJECT MODULE PLACED IN RHPIN.OBJ
NO INVOCATION LINE CONTROLS
LOC OBJ LINE SOURCE
1 ; Code and Data Interface for PIN RSP
2 ; Virtual console support for Concurrent CP/M
3
4 ; March 30, 1982
5
6 name rpin
7
8 cgroup group code
9 dgroup group dats
10
11 assume cs:cgroup,ds:dgroup
12
13 public xdos,mon1,mon2,mon3,mon4,intsys
14 public rsplink, pd, ncopies, udaseg
15 public u_retseg, u_wrkseg, u_insys
16 extrn plmstart:near
17
---- 18 code segment public 'CODE'
19
0000 20 xdos proc
0000 55 21 push bp
0001 8BEC 22 mov bp,sp
0003 8B5604 23 mov dx,[bp+4]
0006 8B4E06 24 mov cx,[bp+6]
0009 CDE0 25 int 224
000B 5D 26 pop bp
000C C20400 27 ret 4
28 xdos endp
29
000F 30 intsys proc ;call O.S. as if we are
000F 55 31 push bp ;already in it
0010 8BEC 32 mov bp,sp
0012 8B5E04 33 mov bx,[bp+4]
0015 8B5606 34 mov dx,[bp+6]
0018 8B4E08 35 mov cx,[bp+8]
36
001B 1E 37 push ds
001C 8E1E0000 R 38 mov ds,rsplink ;DS = Sysdat Segment
0020 8B366800 39 mov si,ds:word ptr rlr
0024 8E441090 40 mov es,[si+p_uda]
0028 FF1E000090 41 call ds:dword ptr [supervisor]
002D 1F 42 pop ds
43
002E 5D 44 pop bp
002F C20600 45 ret 6
46 intsys endp
47
0000 48 mon1 equ xdos
0000 49 mon2 equ xdos
0000 50 mon3 equ xdos
8086/8087/8088 MACRO ASSEMBLER RPIN 17:10:27 04/22/83 PAGE 2
LOC OBJ LINE SOURCE
0000 51 mon4 equ xdos
---- 52 code ends
53
---- 54 dats segment public 'DATA'
55
0068 56 rlr equ 68h ;ready list root
0010 57 p_uda equ 10h ;UDA in process descriptor
0000 58 supervisor equ 0 ;supervisor entry point for internal
0047 59 nvcns equ 47h
0010 60 rsphdr_len equ 16
0030 61 pd_len equ 30H
0100 62 uda_len equ 100H
0060 63 insysoff equ 60H
0000 64 rsp_top equ 0
0010 65 rsp_pd equ rsp_top + rsphdr_len
0040 66 rsp_uda equ rsp_pd + pd_len
0140 67 rsp_bottom equ rsp_uda + uda_len
68
0000 69 org rsp_top
70 ;RSP header
0000 0000 71 rsplink dw 0 ;becomes system data page paragraph
0002 0000 72 sdatvar dw 0 ;tell gensys to one
0004 00 73 ncopies db 0
0005 0000 74 dw 0,0,0,0, 0
0007 0000
0009 0000
000B 0000
000D 0000
000F 00 75 db 0
0010 76 org rsp_pd
0010 0000 77 pd dw 0,0 ;link fields
0012 0000
0014 00 78 db 0 ;status
0015 B9 79 db 185 ;initial priority better than TMP - worse than
80 ;VOUT
0016 0300 81 dw 3 ;flags - system and keep
0018 50494E20202020 82 db 'PIN ' ;name
20
0020 0400 83 udaseg dw rsp_uda/10h ;uda paragraph
0022 00 84 db 0,0 ;disk,user
0023 00
0024 00 85 db 0,0 ;ldisk,luser
0025 00
0026 FF00 86 dw 0ffh ;puremem - re-entrant
87 ;rest of pd
88
0040 89 org rsp_uda ;start of uda
0040 0000 90 uda dw 0
0042 0000 91 dw 0 ;no default DMA
0044 0000 92 dw 0,0,0,0, 0,0,0,0, 0,0,0,0
0046 0000
0048 0000
004A 0000
004C 0000
004E 0000
8086/8087/8088 MACRO ASSEMBLER RPIN 17:10:27 04/22/83 PAGE 3
LOC OBJ LINE SOURCE
0050 0000
0052 0000
0054 0000
0056 0000
0058 0000
005A 0000
005C 0000 93 dw 0,0,0,0, 0,0,0,0, 0,0,0,0
005E 0000
0060 0000
0062 0000
0064 0000
0066 0000
0068 0000
006A 0000
006C 0000
006E 0000
0070 0000
0072 0000
0074 3A01 R 94 dw offset stk_top
0076 0000 95 dw 0,0,0,0, 0,0,0,0
0078 0000
007A 0000
007C 0000
007E 0000
0080 0000
0082 0000
0084 0000
0086 0000 96 u_wrkseg dw 0
0088 0000 97 u_retseg dw 0
00A0 98 org rsp_uda + insysoff
00A0 01 99 u_insys db 1
00A1 00 100 db 0 ;u_stat_save
00A2 0000 101 dw 0 ;ccb
00A4 0000 102 dw 0 ;lcb
00A6 00 103 db 0 ;print string delimiter
104
00A7 (147 105 db 93h dup (0cch) ;fill rest of UDA stack with INT3s
CC
)
106
013A 0000 E 107 stk_top dw plmstart
013C 0000 108 dw 0,0 ;segment, flags: unknown
013E 0000
109
---- 110 dats ends
111 end
ASSEMBLY COMPLETE, NO ERRORS FOUND

View File

@@ -0,0 +1,68 @@
/* System Data Page */
dcl sysdat$pointer pointer;
dcl sysdat$ptr structure(
offset word,
segment word) at (@sysdat$pointer);
declare sd based sysdat$pointer structure (
supmod (4) word,
/* rtmmod (4) word,
memmod (4) word,
ciomod (4) word,
bdosmod (4) word,
xiosmod (4) word,
netmod (4) word,
reservd (4) word */
space1(28) word,
mpmseg word,
rspseg word,
endseg word,
module$map byte,
ncns byte,
nlst byte,
nccb byte,
nflags byte,
srchdisk byte,
mmp word,
nslaves byte,
dayfile byte,
tempdisk byte,
tickspersec byte,
lul word,
ccb word,
flags word,
mdul word,
mfl word,
pul word,
qul word,
qmau (4) word,
rlr word,
dlr word,
drl word,
plr word,
slr word,
thrdrt word,
qlr word,
mal word,
version word,
vernum word,
mpmvernum word,
tod_day word,
tod (3) byte,
ncondev byte,
nlstdev byte,
nciodev byte,
lcb word,
openvec word,
lockmax byte,
openmax byte,
space2 (2) word,
cmod byte );
declare sd$byte based sysdat$pointer (1) byte;
dcl ncondev lit '83h',
nlstdev lit '84h',
nciodev lit '85h';

View File

@@ -0,0 +1,81 @@
/* Concurrent CP/M Character Control Block Structure */
/* +---------+---------+---------+---------+
00 | attach | queue |
+---------+---------+---------+---------+
04 | flag | startcol| column | nchar |
+---------+---------+---------+---------+
08 | mimic | msource | pc | vc |
+---------+---------+---------+---------+
0C | btmp | resrvd | state |
+---------+---------+---------+---------+
10 | maxbufsiz | vinq |
+---------+---------+---------+---------+
14 | voutq | vcmxq |
+---------+---------+---------+---------+
18 | qpbflgs | qpbfill | qpbqaddr |
+---------+---------+---------+---------+
1C | qpbnmsgs | qpbbuffptr |
+---------+---------+---------+---------+
20 | qbuff | cosleep |
+---------+---------+---------+---------+
24 | usleep | vsleep |
+---------+---------+---------+---------+
28 | ... reserved ... |
+---------+---------+---------+---------+
*/
dcl ccb$structure lit 'structure (attach address, queue address,
flag byte, startcol byte, column byte, nchar byte, mimic byte, msource byte,
ccb$tail1';
dcl ccb$tail1 lit
'pc byte, vc byte, btmp byte, reservd byte, state word, maxbufsiz word,
ccb$tail2';
dcl ccb$tail2 lit
'vinq address, voutq address, vcmxq address,
qpbflags byte, qpbresrvd byte, qpbqaddr address,
qpbnmsgs address, qpbbuffptr address, qbuff address, cosleep word,
usleep word, vsleep word, r1 word, r2 word)';
declare /* flag values */
cf$listcp lit '001h', /* control P toggle */
cf$compc lit '002h', /* suppress output */
cf$switchs lit '004h', /* XIOS supports switch screening */
cf$conout lit '008h', /* XIOS console output ownership */
cf$vout lit '010h', /* process writing to VOUTQ */
cf$bufp lit '020h'; /* toggle to control printer echo */
/* on control P when background */
/* and buffered */
/* values of state byte */
/* conout goes to XIOS */
/* state word flags */
dcl
csm$buffered lit '0001h',
csm$background lit '0002h',
csm$purging lit '0004h',
csm$noswitch lit '0008h',
csm$suspend lit '0010h',
csm$abort lit '0020h',
csm$filefull lit '0040h',
csm$ctrlS lit '0080h',
csm$ctrlO lit '0100h',
csm$ctrlP lit '0200h';
dcl x$init$offset lit '0Ch',
x$init$pointer pointer,
x$init$ptr structure (offset word, segment word) at (@x$init$pointer),
x$init based x$init$pointer structure
(tick byte, ticks$sec byte, door byte, resrvd1 (2) byte,
nvcns byte, nccb byte, nlst byte, ccb word, lcb word);
dcl lcb$structure lit 'structure (attach address, queue address,
flag byte, startcol byte, column byte, nchar byte,
mimic byte, msource byte)';