seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-26 18:04:07 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

Browse Source 
Digital Research
This commit is contained in:
Sepp J Morris
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/0read.me Normal file
View File

@@ -0,0 +1,3 @@
DIR status: rsp and cmd versions working 1/31/83
1/31/82 DIRRSP and DIRCMD conditionally compiled from same source whf

26
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dir.com Normal file
View File

@@ -0,0 +1,26 @@
$ !
$ ! Assemble, compile, link, locate, and generate hex files containing
$ ! DIR.CMD to run with
$ ! Concurrent CP/M-86 vers 2.0
$ ! Note: separate code and data
$ !
$ ccpmsetup
$ plm86 dircmd.plm 'p1' 'p2' 'p3' 'p4' xref optimize(3) debug
$ link86 f1:scd.obj, dircmd.obj to dircmd.lnk
$ loc86 dircmd.lnk od(sm(code,dats,data,stack,const))-
ad(sm(code(0), dats(10000h))) ss(stack(+32)) to dircmd.
$ h86 dircmd
$ !
$ !
$ ! Assemble, compile, link, locate, and generate hex files containing
$ ! DIR.RSP to run with
$ ! Concurrent CP/M-86 vers 2.0
$ ! Note: separate code and data
$ !
$ asm86 rhdir.a86 !Rsp Header DIR
$ plm86 dirrsp.plm 'p1' 'p2' 'p3' 'p4' xref optimize(3) debug
$ link86 rhdir.obj, dirrsp.obj to dirrsp.lnk
$ loc86 dirrsp.lnk od(sm(code,dats,data,stack,const))-
ad(sm(code(0), dats(10000h))) ss(stack(0)) to dirrsp.
$ h86 dirrsp
$ !

139
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dircmd.h86 Normal file
View File

@@ -0,0 +1,139 @@
:020000021000EC
:0100040000FB
:020000021000EC
:020006000000F8
:020000021005E7
:0700000000000000000000F9
:020000021007E5
:04000C0000000000F0
:020000021010DC
:080000000000000000000000F8
:020000020000FC
:10000000EB4B90EB7690434F505952494748542060
:1000100028432920313938332C2044494749544159
:100020004C2052455345415243482020434F4E43B4
:10003000555252454E542043502F4D2D38362032C4
:100040002E302C2030332F33312F3833209C58FA68
:100050008CD98ED18D26F401509DE90505558BEC88
:100060008B56048B4E06CDE0A30001891E02018948
:0F0070000E0401891606015DC204009090909065
:020000020010EC
:020000000010EE
:020000021011DB
:100008004469726563746F727920666F72205573E4
:0700180065722020783A24F4
:02000002101FCD
:100004000D0A46696C65206E6F7420666F756E64A8
:020014002E2498
:020000021020CC
:100006000D0A53797374656D2046696C65732045D6
:050016007869737424F9
:020000021021CB
:10000B000D0A496E76616C69642066696C65737064
:04001B0065632E24C7
:020000021022CA
:10000F000D0A496E76616C696420436F6D6D616E88
:09001F0064204F7074696F6E24B7
:020000020010EC
:10000200558BECA10801B9050003C1A3080103C186
:10001200A3080103C1A3080103C1A3080103C1A3EB
:10002200080103C1A3080103C1A3080103C1A30876
:100032000103C1A3080103C1A3080103C1A308016D
:1000420003C1A3080103C1A3080103C1A30801015D
:050052000E08015DC372
:020000020015E7
:10000700558BECB002508A4604B40050E8F7FE5D09
:03001700C2020022
:020000020016E6
:10000A00558BECB00950FF7604E8E7FE5DC20200AA
:020000020017E5
:07000A00558BECB0005DC353
:020000020018E4
:10000100558BECB01150FF7604E8D0FE5DC20200C2
:020000020019E3
:10000100558BECB01250FF7604E8C0FE5DC20200D1
:02000002001AE2
:10000100558BECB01A50FF7604E8B0FE5DC20200D9
:02000002001BE1
:0F000100558BECB02050B8FF0050E89FFE5DC358
:02000002001CE0
:10000000558BECB020508A4604B40050E88EFE5D5B
:03001000C2020029
:02000002001DDF
:0E000300558BECB000B4005050E87EFE5DC39B
:02000002001EDE
:0F000100558BECB09850B80A0150E86FFE5DC304
:02000002001FDD
:10000000558BECB00D50E85EFFB00A50E858FF5D2C
:01001000C32C
:020000020020DC
:10000100558BEC803E330109760CC6062B0131A0DD
:1000110033012C0AEB08C6062B0120A03301043062
:0C002100A22C01B8180150E83FFF5DC39D
:020000020022DA
:10000D00558BECC606BC0100A03501D0D87308E8AD
:10001D00C2FFC606350100C606360100C60632010E
:10002D00FF823E5C0000750FB01950B8000050E81B
:10003D00FEFDFEC0A25C00803E5D0020751DC60663
:10004D00340101803E34010B77118A1E3401B70053
:10005D00C6875C003FFE06340175E8B85C0050E8C9
:10006D00F2FEA231013CFF7405803E3101FF7503A4
:10007D00E9C000A03101B105D2E0A23001B4008980
:10008D00C38A8F430180E18080F980B0FF74014005
:10009D00A22F018A8F39013A0E3301757DF6D00AF0
:1000AD00063701D0D87373A03201FEC0A23201B45D
:1000BD0000B9040031D2F7F109D2750CE804FFA0A4
:1000CD005C000441FEC8EB02B02050E85CFEB03A83
:1000DD0050E856FEB02050E850FEC60634010180AF
:1000ED003E34010B7740803E3401097506B0205037
:1000FD00E837FE8A1E3401021E3001B7008A8739A7
:10010D0001247F50E823FEE843FED0D87304B000ED
:10011D005DC3FE06340175C7EB0CA02F01D0D8735B
:10012D0005C6063601FFB85C0050E837FEA2310166
:10013D00E936FF803E3201FF7507B8F40150E8FC47
:10014D00FDA03601D0D87307B8060250E8EEFDB019
:03015D00FF5DC380
:020000020038C4
:10000000558BECA10A01A3120109C07503E9BF00D9
:10001000C6065C0000C70610010000E843FEA312FC
:1000200001833E120100B0FF7401408B1E0A018B58
:100030003610015080385BB0FF7401405922C1D0A6
:10004000D873388B0E0E012BCE8D38B05D1E07FC99
:100050008BD1E306F2AE75F82BD14A8916100183D5
:10006000FAFF740A89D68D0040A30A01EBA78B1E04
:100070000A018B361001C60000EBA6A11201A30AEB
:100080000183F8FF743D803E5D0020741609C07442
:100090002E89C3803F5B7427823F007422FF060ACB
:1000A00001EB1C823E5C00007429803E5D002075DF
:1000B000228D3E5D00B03FB90B001E07FCF2AAB0D6
:1000C000FF5DC3B81B0250E820FDC606BC0100B0AE
:0500D000005DC35DC3EB
:020000020045B7
:10000500558BECC70616010000C7060C013901C661
:1000150006BB0100C606B901FFA0BB01F6D022064A
:10002500B901D0D87203E9CE008B0E0E012B0E1646
:10003500018B3E16018DBD8000B05B1E07FC8BD188
:10004500E306F2AE75F82BD14A8916140183FAFF3F
:100055007507C606B90100EBC0A116010306140118
:1000650040A3160189C38D878000A30A01C606BA7D
:1000750001FFA0BB01F6D02206BA01D0D8739AE8D9
:100085000AFDA30A0183F8FF7453803E3A015375B4
:1000950007C6063701FFEB45803E3A0147753980B3
:1000A5003E3C01207409A03C012C30040AEB0C8075
:1000B5003E3B01207408A03B012C30A23001A0304A
:1000C500013C107318B12051A23301B40050E83738
:1000D500FBC6063501FFEB05C606BB01FF8B1E0AF5
:1000E50001803F5D740909DB740583FBFF7583C6D9
:1000F50006BA0100E97BFFA0BB01D0D8730BB82F6E
:0D0105000250E810FCB0005DC3B0FF5DC308
:020000020056A6
:10000200558BECE849FCA23301803E5D0053B0FF02
:10001200740140A23701B8390150E822FCC6063506
:1000220001FFB000A23601A237018D3E8000B980E7
:10003200001E07FC8BD1E306F2AE75F82BD14A897C
:10004200160E01E8ADFEF6D0D0D8723BC606BC0152
:10005200FFC7060A018100C7060C015C00E8BEFD6D
:10006200D0D8730BE864FCF6D0D0D8721AEBEEA0AD
:10007200BC01D0D873118D3E5D00B03FB90B001E9C
:0C00820007FCF2AAE844FCE8E7FB5DC3C1
:00000001FF

950
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dircmd.lst Normal file
View File

@@ -0,0 +1,950 @@
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 1
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE DIR
OBJECT MODULE PLACED IN DIRCMD.OBJ
COMPILER INVOKED BY: :F0: DIRCMD.PLM XREF OPTIMIZE(3) DEBUG
$TITLE('CONCURRENT CP/M 86 --- DIR 1.0 ')
$compact
/* Conditional compile:
rsp=0ffh produce a DIR.RSP type of file
rsp=0 produce a DIR.CMD file
*/
$set(rsp=0h)
$include(dirm.plm)
= /* dirm:
= This is the module included by DIRRSP or DIRCMD.
=
= Revised:
= Jan 80 by Thomas Rolander
= July 81 by Doug Huskey
= June 82 by Bill Fitler
= July 82 by Danny Horovitz (made an RSP)
= Dec 82 by Fran Borda (conditional comp)
= Mar 83 by Bill Fitler ( " " )
= Mar 83 by Danny Horovitz (control C fixes)
=
= Conditional compile:
= rsp=0ffh produce a DIR.RSP type of file
= rsp=0 produce a DIR.CMD file
= */
=
= /**** Vax commands to compile DIR.RSP and DIR.CMD:
=
= $ ccpmsetup
= $ plm86 dircmd.plm 'p1' 'p2' 'p3' 'p4' optimize(3) debug
= $ link86 f1:scd.obj, dircmd.obj to dircmd.lnk
= $ loc86 dircmd.lnk od(sm(code,dats,data,stack,const))-
= ad(sm(code(0), dats(10000h))) ss(stack(+32)) to dircmd.
= $ h86 dircmd
= $ ! DIR.RSP
= $ ! Note: separate code and data
= $ asm86 rhdir.a86 !Rsp Header DIR
= $ plm86 dirrsp.plm 'p1' 'p2' 'p3' 'p4' optimize(3) debug
= $ link86 rhdir.obj, dirrsp.obj to dirrsp.lnk
= $ loc86 dirrsp.lnk od(sm(code,dats,data,stack,const))-
= ad(sm(code(0), dats(10000h))) ss(stack(0)) to dirrsp.
= $ h86 dirrsp
=
= **** Then, on a micro:
= A>vax dircmd.h86 $fans
= A>vax dirrsp.h86 $fans
= A>gencmd dircmd data[b1000]
= A>ren dir.cmd=dircmd.cmd
= A>gencmd dirrsp data[b1000]
= A>ren dir.rsp=dirrsp.cmd
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 2
=
= **** Notes: Both DIRCMD.PLM and DIRRSP.PLM include DIRM.PLM, after setting
= RSP flag appropriately.
=
= ****/
=
=
1 = dir:
= do;
=
= $include (:f1:copyrt.lit)
=1
=1 /*
=1 Copyright (C) 1983
=1 Digital Research
=1 P.O. Box 579
=1 Pacific Grove, CA 93950
=1 */
=1
=
= $include (:f1:comlit.lit)
=1
2 1 =1 declare
=1 lit literally 'literally',
=1 dcl lit 'declare',
=1 true lit '0ffh',
=1 false lit '0',
=1 no lit 'not',
=1 boolean lit 'byte',
=1 forever lit 'while true',
=1 cr lit '13',
=1 lf lit '10',
=1 tab lit '9',
=1 ctrlc lit '3',
=1 ff lit '12',
=1 page$len$offset lit '1ch',
=1 nopage$mode$offset lit '2Ch',
=1 sectorlen lit '128';
=
= $include (:f1:mfunc.lit)
=1
=1 /* Concurrent CP/M function numbers */
=1
3 1 =1 dcl m$prtbuf lit '9',
=1 m$select lit '14',
=1 m$openf lit '15',
=1 m$closef lit '16',
=1 m$deletef lit '19',
=1 m$readf lit '20',
=1 m$writef lit '21',
=1 m$makef lit '22',
=1 m$getlogin lit '24',
=1 m$curdsk lit '25',
=1 m$setdma lit '26',
=1 m$setatt lit '30',
=1 m$setusr lit '32',
=1 m$readrf lit '33',
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 3
=1 m$writerf lit '34',
=1 m$resetdrv lit '37',
=1 m$errmode lit '45',
=1 m$dirbios lit '50',
=1 m$makeq lit '134',
=1 m$openq lit '135',
=1 m$deleteq lit '136',
=1 m$readq lit '137',
=1 m$creadq lit '138',
=1 m$writeq lit '139',
=1 m$cwriteq lit '140',
=1 m$delay lit '141',
=1 m$dispatch lit '142',
=1 m$setprior lit '145',
=1 m$attach lit '146',
=1 m$detach lit '147',
=1 m$setcns lit '148',
=1 m$parse lit '152',
=1 m$getcns lit '153',
=1 m$sysdat lit '154',
=1 m$getpd lit '156',
=1 m$abort lit '157';
=1
=1 /* Internal calls */
=1
4 1 =1 dcl mi$sleep lit '0212H',
=1 mi$wakeup lit '0213H';
=1
=
= $include (:f1:proces.lit)
=1
=1 /*
=1 Proces Literals MP/M-8086 II
=1 */
=1
5 1 =1 declare pnamsiz literally '8';
=1
6 1 =1 declare pd$hdr literally 'structure
=1 (link word,thread word,stat byte,prior byte,flag word,
=1 name (8) byte,uda word,dsk byte,user byte,ldsk byte,luser byte,
=1 mem word';
=1
7 1 =1 declare pd$structure literally 'pd$hdr,
=1 dvract word,wait word,org byte,net byte,parent word,
=1 cns byte,abort byte,conmode word,lst byte,sf3 byte,sf4 byte,sf5 byte,
=1 reservd (4) byte,pret word,scratch word)';
=1
8 1 =1 declare psrun lit '00',
=1 pspoll lit '01',
=1 psdelay lit '02',
=1 psswap lit '03',
=1 psterm lit '04',
=1 pssleep lit '05',
=1 psdq lit '06',
=1 psnq lit '07',
=1 psflagwait lit '08',
=1 psciowait lit '09';
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 4
=1
9 1 =1 declare pf$sys lit '00001h',
=1 pf$keep lit '00002h',
=1 pf$kernal lit '00004h',
=1 pf$pure lit '00008h',
=1 pf$table lit '00010h',
=1 pf$resource lit '00020h',
=1 pf$raw lit '00040h',
=1 pf$ctlc lit '00080h',
=1 pf$active lit '00100h',
=1 pf$tempkeep lit '00200h',
=1 pf$ctld lit '00400h',
=1 pf$childabort lit '00800h',
=1 pf$noctls lit '01000h';
=1
10 1 =1 declare pcm$11 lit '00001h',
=1 pcm$ctls lit '00002h',
=1 pcm$rout lit '00004h',
=1 pcm$ctlc lit '00008h',
=1 pcm$ctlo lit '00080h',
=1 pcm$rsx lit '00300h';
=
= $include (:f1:qd.lit)
=1
=1 /* Queue Descriptor */
=1
11 1 =1 dcl qnamsiz lit '8';
=1
12 1 =1 dcl qd$structure lit 'structure(
=1 link word,
=1 net byte,
=1 org byte,
=1 flags word,
=1 name(qnamsiz) byte,
=1 msglen word,
=1 nmsgs word,
=1 dq word,
=1 nq word,
=1 msgcnt word,
=1 msgout word,
=1 buffer word)';
=1
=1 /* queue flag values */
=1
13 1 =1 dcl qf$mx lit '001h'; /* Mutual Exclusion */
14 1 =1 dcl qf$keep lit '002h'; /* NO DELETE */
15 1 =1 dcl qf$hide lit '004h'; /* Not User writable */
16 1 =1 dcl qf$rsp lit '008h'; /* rsp queue */
17 1 =1 dcl qf$table lit '010h'; /* from qd table */
18 1 =1 dcl qf$rpl lit '020h'; /* rpl queue */
19 1 =1 dcl qf$dev lit '040h'; /* device queue */
=1
=1 /* Queue Parameter Block */
=1
20 1 =1 dcl qpb$structure lit 'structure(
=1 flgs byte,
=1 net byte,
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 5
=1 qaddr word,
=1 nmsgs word,
=1 buffptr word,
=1 name (qnamsiz) byte )';
=1
=
= /**************************************
= * *
= * B D O S INTERFACE *
= * *
= **************************************/
=
=
21 1 = mon1:
= procedure (func,info) external;
22 2 = declare func byte;
23 2 = declare info address;
24 2 = end mon1;
=
25 1 = mon2:
= procedure (func,info) byte external;
26 2 = declare func byte;
27 2 = declare info address;
28 2 = end mon2;
=
29 1 = mon3:
= procedure (func,info) address external;
30 2 = declare func byte;
31 2 = declare info address;
32 2 = end mon3;
=
33 1 = mon4:
= procedure (func,info) pointer external;
34 2 = declare func byte;
35 2 = declare info address;
36 2 = end mon4;
=
=
=
37 1 = patch: procedure public; /* dummy area for patching code segments */
38 2 = declare i address;
= /* first statement = 9 bytes, rest are 5 bytes */
39 2 = i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
44 2 = i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
49 2 = i=i+5; i=i+5; i=i+5; i=i+5; i=i+5; /* about 79 bytes */
54 2 = end patch;
=
=
= $if rsp
= declare fcb (36) byte; /* 1st default fcb */
= declare fcb16 (1) byte at (@fcb(16)); /* 2nd default fcb */
= $else
55 1 = declare fcb (1) byte external; /* 1st default fcb */
56 1 = declare fcb16 (1) byte external; /* 2nd default fcb */
= $endif
=
57 1 = write$console:
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 6
= procedure (char);
58 2 = declare char byte;
59 2 = call mon1 (2,char);
60 2 = end write$console;
=
61 1 = print$buf:
= procedure (buffer$address);
62 2 = declare buffer$address address;
63 2 = call mon1 (9,buffer$address);
64 2 = end print$buf;
=
65 1 = check$ctrl$c:
= procedure byte;
= $if rsp
= if (dir$pd.flag and pf$ctlC) <> 0 then
= do;
= dir$pd.flag = dir$pd.flag and not double(pf$ctlC);
= return(true);
= end;
= $endif
66 2 = return (false);
67 2 = end check$ctrl$c;
=
68 1 = search$first:
= procedure (fcb$address) byte;
69 2 = declare fcb$address address;
70 2 = return mon2 (17,fcb$address);
71 2 = end search$first;
=
72 1 = search$next:
= procedure (fcb$address) byte;
73 2 = declare fcb$address address;
74 2 = return mon2 (18,fcb$address);
75 2 = end search$next;
=
76 1 = setdma: procedure(dma);
77 2 = declare dma address;
78 2 = call mon1(26,dma);
79 2 = end setdma;
=
=
80 1 = get$user$code:
= procedure byte;
81 2 = return mon2 (32,0ffh);
82 2 = end get$user$code;
=
83 1 = set$user$code:
= procedure(user);
84 2 = declare user byte;
85 2 = call mon1 (32,user);
86 2 = end set$user$code;
=
87 1 = terminate:
= procedure;
88 2 = call mon1 (0,0);
89 2 = end terminate;
=
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 7
90 1 = declare
= parse$fn structure (
= buff$adr address,
= fcb$adr address),
= delimiter based parse$fn.buff$adr byte;
91 1 = declare tail$len address;
=
92 1 = parse: procedure address;
93 2 = return mon3(152,.parse$fn);
94 2 = end parse;
=
=
95 1 = crlf:
= procedure;
96 2 = call write$console (0dh);
97 2 = call write$console (0ah);
98 2 = end crlf;
=
=
= /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
=
=
= * * * GLOBAL VARIABLES * * *
=
=
= * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
=
=
=
99 1 = declare dir$title (*) byte initial
= ('Directory for User x:','$');
=
100 1 = declare (sys,temp,dcnt,cnt,user) byte;
101 1 = declare
= i byte,
= new$user byte,
= sys$exists byte,
= incl$sys byte,
= option byte;
=
102 1 = declare
= dirbuf (128) byte;
=
=
= /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
=
=
= * * * DIRECTORY DISPLAY * * *
=
=
= * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
=
=
= /* display directory heading */
103 1 = heading: procedure;
=
104 2 = if user > 9 then
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 8
105 2 = do;
106 3 = dir$title(19) = '1';
107 3 = dir$title(20) = user - 10 + '0';
108 3 = end;
= else
109 2 = do;
110 3 = dir$title(19) = ' ';
111 3 = dir$title(20) = user + '0';
112 3 = end;
113 2 = call print$buf (.dir$title);
114 2 = end heading;
=
= /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
=
= /*
= help: procedure;
= call mon1(m$prt$buf, .(cr, lf, tab, tab, tab ,'DIR EXAMPLES$'));
= call mon1(m$prt$buf, .(cr, lf, lf, 'dir', tab, tab,
= '(show all directory files on current drive and user)
= call mon1(m$prt$buf, .(cr, lf, 'dir [g3]', tab, tab, tab, tab,
= '(show non system files under user 3)$'));
= call mon1(m$prt$buf, .(cr, lf, 'dir a: b: [s]', tab, tab, tab,
= tab, '(show all files under current user on a: and b:)$'));
= call terminate;
= end help;
= */
=
= /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
=
= /* do next directory display */
115 1 = directory: procedure boolean;
=
116 2 = shown$nothing = false;
117 2 = if new$user then do;
119 3 = call heading;
120 3 = new$user = false;
121 3 = end;
122 2 = sys$exists = false;
123 2 = cnt = -1;
= /* if drive is 0 (default)
= then set to current disk */
124 2 = if fcb(0) = 0
= then fcb(0) = mon2 (m$curdsk,0) + 1;
126 2 = if fcb(1) = ' ' then
= /* check for blank filename => wildcard */
127 2 = do i = 1 to 11;
128 3 = fcb(i) = '?';
129 3 = end;
= /* get first file */
130 2 = if (dcnt := search$first (.fcb)) <> 0ffh then
131 2 = do while dcnt <> 0ffh;
132 3 = temp = shl(dcnt,5);
133 3 = sys = ((dirbuf(temp+10) and 80h) = 80h);
134 3 = if (dirbuf(temp) = user) and
= (incl$sys or not sys) then
135 3 = do;
136 4 = if ((cnt:=cnt+1) mod 4) = 0 then
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 9
137 4 = do;
138 5 = call crlf;
139 5 = call write$console ('A'+fcb(0)-1);
140 5 = end;
= else
141 4 = do;
142 5 = call write$console (' ');
143 5 = end;
144 4 = call write$console (':');
145 4 = call write$console (' ');
146 4 = do i = 1 to 11;
147 5 = if i = 9 then call write$console (' ');
149 5 = call write$console
= (dirbuf(temp+i) and 7fh);
150 5 = if check$ctrl$c then
151 5 = return(false);
152 5 = end;
153 4 = end;
154 3 = else if sys then
155 3 = sys$exists = true;
= dcnt = search$next (.fcb);
157 3 = end;
158 2 = if cnt = -1 then
159 2 = do;
160 3 = call print$buf (.(0dh,0ah,
= 'File not found.','$'));
161 3 = end;
162 2 = if sys$exists then
163 2 = call print$buf (.(0dh,0ah,
= 'System Files Exist','$'));
164 2 = return(true);
165 2 = end directory;
=
= /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
=
=
= * * * PARSING * * *
=
=
= * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
=
=
= /* parse one file name, return true if got one */
166 1 = parse$file: procedure boolean;
167 2 = dcl i address;
168 2 = dcl buf based parse$fn.buff$adr (1) byte;
169 2 = dcl parse$ret address;
=
170 2 = if (parse$ret := parse$fn.buff$adr) = 0 then
171 2 = return(false);
172 2 = fcb(0), i = 0;
173 2 = parse$ret = parse; /* kludge around */
174 2 = do while parse$ret = 0 and buf(i) = '['; /* parse file name bugs */
175 3 = if (i := findb(@buf(i), ']', tail$len - i)) <> 0ffffh then
176 3 = do;
177 4 = parse$fn.buff$adr = .buf(i) + 1; /* skip right bracket */
178 4 = i = 0;
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 10
179 4 = parse$ret = parse;
180 4 = end;
= else
181 3 = buf(i) = 0;
182 3 = end;
183 2 = parse$fn.buff$adr = parse$ret;
=
=
184 2 = if parse$fn.buff$adr <> 0ffffh then
185 2 = do;
186 3 = if fcb(1) <> ' ' then
187 3 = do;
188 4 = if parse$fn.buff$adr <> 0 and delimiter <> '[' and delimiter <> 0 then
189 4 = parse$fn.buff$adr = parse$fn.buff$adr + 1;
190 4 = return(true); /* parse$fn.buff$adr could = 0 */
191 4 = end;
192 3 = else if fcb(0) <> 0 and fcb(1) = ' ' then /* drive spec */
193 3 = do;
194 4 = call setb('?', @fcb(1), 11);
195 4 = return(true);
196 4 = end;
= end;
= else /* if parse$fn.buff$adr = 0ffffh then */
198 2 = do;
199 3 = call print$buf(.(cr, lf, 'Invalid filespec.$'));
200 3 = shown$nothing = false; /* don't show directory */
201 3 = return(false); /* also if parse$fn.buf$adr = 0 and fcb(0) = ' ' */
202 3 = end;
203 2 = end parse$file;
=
=
= /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
=
=
= /* parse & interpret all options - assume global */
204 1 = parse$options: procedure boolean;
205 2 = dcl (n,i) word;
206 2 = dcl (options, in$brackets, error) boolean;
207 2 = i = 0; /* parse file name doesn't work with delimiters */
208 2 = parse$fn.fcb$adr = .dirbuf;
209 2 = error = false;
210 2 = options = true;
211 2 = do while options and not error;
212 3 = if (n := findb(@tbuff(i), '[', tail$len - i)) = 0ffffh then
213 3 = options = false;
= else
214 3 = do;
215 4 = i = i + n + 1;
216 4 = parse$fn.buff$adr = .tbuff(i);
217 4 = in$brackets = true;
218 4 = do while in$brackets and not error;
219 5 = if (parse$fn.buff$adr := parse) <> 0ffffh then
220 5 = do;
221 6 = if dirbuf(1) = 'S' then
222 6 = incl$sys = true;
223 6 = else if dirbuf(1) = 'G' then
224 6 = do;
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 11
225 7 = if dirbuf(3) <> ' ' then
226 7 = temp = dirbuf(3) - '0' + 10;
227 7 = else if dirbuf(2) <> ' ' then
228 7 = temp = dirbuf(2) - '0';
= if temp < 16 then
230 7 = do;
231 8 = call mon1(m$setusr, (user:=temp));
232 8 = new$user = true;
233 8 = end;
234 7 = end;
= else
235 6 = error = true;
236 6 = end; /* if parse */
237 5 = if delimiter = ']' or parse$fn.buff$adr = 0 or
= parse$fn.buff$adr = 0ffffh then
238 5 = in$brackets = false;
239 5 = end; /* while in$brackets */
240 4 = end; /* else */
241 3 = end; /* while options */
=
242 2 = if error then
243 2 = do;
244 3 = call print$buf(.(cr, lf, 'Invalid Command Option$'));
245 3 = return(false);
= /* call help; */
246 3 = end;
247 2 = return(true);
248 2 = end parse$options;
=
=
=
= /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
=
=
= * * * M A I N P R O G R A M * * *
=
=
= * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
=
= $if rsp
= declare cpd$pointer pointer; /* Calling PD pointer stuff */
= declare cpd$ptr structure (
= offset address, segment address) at (@cpd$pointer);
= declare calling$pd based cpd$pointer pd$structure;
= declare dpd$pointer pointer; /* DIR RSP PD pointer stuff */
= declare dpd$ptr structure (
= offset address, segment address) at (@dpd$pointer);
= declare dir$pd based dpd$pointer pd$structure;
= declare qdbuf (131) byte;
= declare dirqd qd$structure initial
= (0, 0, 0, qf$keep + qf$rsp, 'DIR ', 131, 1, 0, 0, 0, 0, .qdbuf);
= declare qpbbuf (131) byte;
= declare cpd$offset address at (@qpbbuf(0));
= declare tbuff (128) byte at (@qpbbuf(2));
= declare dirqpb qpb$structure initial
= (0, 0, 0, 0, .qpbbuf, 'DIR ');
= $else
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 12
249 1 = declare tbuff (128) byte external;
= $endif
=
250 1 = declare shown$nothing boolean;
=
251 1 = plmstart: procedure public;
=
= /* initialization */
=
= $if rsp
= call mon1(m$make$q, .dirqd);
= call mon1(m$open$q, .dirqpb);
= call mon1(m$set$prior, 200); /* Set priority same as other transients*/
= $else
252 2 = user = get$user$code; /* ????? whf */
253 2 = incl$sys = (fcb(1) = 'S'); /* ????? why exclude if rsp? whf */
= $endif
=
254 2 = call setdma(.dirbuf);
= $if rsp
= cpd$pointer,dpd$pointer = mon4(m$sysdat, 0);
= dpd$ptr.offset = mon3(m$getpd,0);
= /* Don't allow control S, turn on tempkeep for control C checking */
= dir$pd.flag = dir$pd.flag or pf$noctls or pf$tempkeep;
= /* Read RSP Queue forever */
= do forever;
= call mon1(m$readq, .dirqpb);
= dir$pd.flag = dir$pd.flag and not double(pf$ctlC);
= /* Could be on from last DIR */
= /* set defaults same as calling process's, have both PDs so will poke */
= /* and not call O.S. */
= cpd$ptr.offset = cpd$offset;
= call mon1(m$setcns, calling$pd.cns);
= call mon1(m$setusr, (user := calling$pd.user));
= call mon1(m$select, calling$pd.dsk);
= $endif
255 2 = new$user = true;
256 2 = sys$exists, incl$sys = false;
257 2 = tail$len = findb(@tbuff, 0, 128);
=
= /* scan for options - all are global */
=
258 2 = if not parse$options then
259 2 = goto done; /* option error */
=
= /* do command line */
=
260 2 = shown$nothing = true;
= $if rsp
= parse$fn.buff$adr = .tbuff;
= $else
261 2 = parse$fn.buff$adr = (.tbuff) + 1;/* Skip # of bytes in buffer */
= $endif
262 2 = parse$fn.fcb$adr = .fcb;
263 2 = do while parse$file; /* false when no more files, sets */
264 3 = if not directory then /* shown$nothing=false if parsing error */
265 3 = goto done; /* directory = false if console inpute */
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 13
266 3 = end;
=
267 2 = if shown$nothing then /* no files specified on command line */
268 2 = do;
269 3 = call setb('?', @fcb(1), 11);
270 3 = if not directory then
271 3 = goto done; /* false on console input */
272 3 = end;
273 2 = done:
= $if rsp
= call mon1(m$detach, 0);
= end; /* do forever */
= $else
= call terminate;
= $endif
=
274 2 = end plmstart;
=
275 1 = end dir;
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 14
CROSS-REFERENCE LISTING
-----------------------
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
----- ------ ----- --------------------------------
2 BOOLEAN. . . . . . LITERALLY 115 166 204 206 250
168 0000H 1 BUF. . . . . . . . BYTE BASED(PARSEFN.BUFFADR) ARRAY(1) 174 175 177 181
90 0000H 2 BUFFADR. . . . . . WORD MEMBER(PARSEFN) 90 168 170 174 175 177 181 183 184
188 189 216 219 237 261
61 0004H 2 BUFFERADDRESS. . . WORD PARAMETER AUTOMATIC 62 63
57 0004H 1 CHAR . . . . . . . BYTE PARAMETER AUTOMATIC 58 59
65 007AH 7 CHECKCTRLC . . . . PROCEDURE BYTE STACK=0002H 150
100 002AH 1 CNT. . . . . . . . BYTE 123 136 158
2 CR . . . . . . . . LITERALLY 199 244
95 00F0H 17 CRLF . . . . . . . PROCEDURE STACK=000EH 138
2 CTRLC. . . . . . . LITERALLY
2 DCL. . . . . . . . LITERALLY
100 0029H 1 DCNT . . . . . . . BYTE 130 131 132 156
90 0000H 1 DELIMITER. . . . . BYTE BASED(PARSEFN.BUFFADR) 188 237
1 0002H DIR. . . . . . . . PROCEDURE STACK=0000H
102 0031H 128 DIRBUF . . . . . . BYTE ARRAY(128) 133 134 149 208 221 223 225 226 227 228
254
115 012DH 339 DIRECTORY. . . . . PROCEDURE BYTE STACK=0012H 264 270
99 0010H 23 DIRTITLE . . . . . BYTE ARRAY(23) INITIAL 106 107 110 111 113
76 0004H 2 DMA. . . . . . . . WORD PARAMETER AUTOMATIC 77 78
273 04E9H DONE . . . . . . . LABEL 259 265 271
206 00B3H 1 ERROR. . . . . . . BYTE 209 211 218 235 242
2 FALSE. . . . . . . LITERALLY 66 116 120 122 151 171 200 201 209 213 238
245 256
55 0000H 1 FCB. . . . . . . . BYTE ARRAY(1) EXTERNAL(4) 124 125 126 128 130 139 156 172
186 192 194 253 262 269
56 0000H 1 FCB16. . . . . . . BYTE ARRAY(1) EXTERNAL(5)
68 0004H 2 FCBADDRESS . . . . WORD PARAMETER AUTOMATIC 69 70
72 0004H 2 FCBADDRESS . . . . WORD PARAMETER AUTOMATIC 73 74
90 0002H 2 FCBADR . . . . . . WORD MEMBER(PARSEFN) 208 262
2 FF . . . . . . . . LITERALLY
FINDB. . . . . . . BUILTIN 175 212 257
2 FOREVER. . . . . . LITERALLY
33 0000H 1 FUNC . . . . . . . BYTE PARAMETER 34
21 0000H 1 FUNC . . . . . . . BYTE PARAMETER 22
25 0000H 1 FUNC . . . . . . . BYTE PARAMETER 26
29 0000H 1 FUNC . . . . . . . BYTE PARAMETER 30
80 00B1H 15 GETUSERCODE. . . . PROCEDURE BYTE STACK=0008H 252
103 0101H 44 HEADING. . . . . . PROCEDURE STACK=000EH 119
38 0000H 2 I. . . . . . . . . WORD 39 40 41 42 43 44 45 46 47 48 49 50
51 52 53
167 0008H 2 I. . . . . . . . . WORD 172 174 175 177 178 181
101 002CH 1 I. . . . . . . . . BYTE 127 128 146 147 149
205 000EH 2 I. . . . . . . . . WORD 207 212 215 216
206 00B2H 1 INBRACKETS . . . . BYTE 217 218 238
101 002FH 1 INCLSYS. . . . . . BYTE 134 222 253 256
25 0000H 2 INFO . . . . . . . WORD PARAMETER 27
33 0000H 2 INFO . . . . . . . WORD PARAMETER 35
29 0000H 2 INFO . . . . . . . WORD PARAMETER 31
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 15
21 0000H 2 INFO . . . . . . . WORD PARAMETER 23
2 LF . . . . . . . . LITERALLY 199 244
2 LIT. . . . . . . . LITERALLY 2 3 4 8 9 10 11 12 13 14 15
16 17 18 19 20
3 MABORT . . . . . . LITERALLY
3 MATTACH. . . . . . LITERALLY
3 MCLOSEF. . . . . . LITERALLY
3 MCREADQ. . . . . . LITERALLY
3 MCURDSK. . . . . . LITERALLY 125
3 MCWRITEQ . . . . . LITERALLY
3 MDELAY . . . . . . LITERALLY
3 MDELETEF . . . . . LITERALLY
3 MDELETEQ . . . . . LITERALLY
3 MDETACH. . . . . . LITERALLY
3 MDIRBIOS . . . . . LITERALLY
3 MDISPATCH. . . . . LITERALLY
3 MERRMODE . . . . . LITERALLY
3 MGETCNS. . . . . . LITERALLY
3 MGETLOGIN. . . . . LITERALLY
3 MGETPD . . . . . . LITERALLY
4 MISLEEP. . . . . . LITERALLY
4 MIWAKEUP . . . . . LITERALLY
3 MMAKEF . . . . . . LITERALLY
3 MMAKEQ . . . . . . LITERALLY
21 0000H MON1 . . . . . . . PROCEDURE EXTERNAL(0) STACK=0000H 59 63 78 85 88 231
25 0000H MON2 . . . . . . . PROCEDURE BYTE EXTERNAL(1) STACK=0000H 70 74 81 125
29 0000H MON3 . . . . . . . PROCEDURE WORD EXTERNAL(2) STACK=0000H 93
33 0000H MON4 . . . . . . . PROCEDURE POINTER EXTERNAL(3) STACK=0000H
3 MOPENF . . . . . . LITERALLY
3 MOPENQ . . . . . . LITERALLY
3 MPARSE . . . . . . LITERALLY
3 MPRTBUF. . . . . . LITERALLY
3 MREADF . . . . . . LITERALLY
3 MREADQ . . . . . . LITERALLY
3 MREADRF. . . . . . LITERALLY
3 MRESETDRV. . . . . LITERALLY
3 MSELECT. . . . . . LITERALLY
3 MSETATT. . . . . . LITERALLY
3 MSETCNS. . . . . . LITERALLY
3 MSETDMA. . . . . . LITERALLY
3 MSETPRIOR. . . . . LITERALLY
3 MSETUSR. . . . . . LITERALLY 231
3 MSYSDAT. . . . . . LITERALLY
3 MWRITEF. . . . . . LITERALLY
3 MWRITEQ. . . . . . LITERALLY
3 MWRITERF . . . . . LITERALLY
205 000CH 2 N. . . . . . . . . WORD 212 215
101 002DH 1 NEWUSER. . . . . . BYTE 117 120 232 255
2 NO . . . . . . . . LITERALLY
2 NOPAGEMODEOFFSET . LITERALLY
101 0030H 1 OPTION . . . . . . BYTE
206 00B1H 1 OPTIONS. . . . . . BYTE 210 211 213
2 PAGELENOFFSET. . . LITERALLY
92 00E1H 15 PARSE. . . . . . . PROCEDURE WORD STACK=0008H 173 179 219
166 0280H 213 PARSEFILE. . . . . PROCEDURE BYTE STACK=000EH 263
90 0002H 4 PARSEFN. . . . . . STRUCTURE 90 93 168 170 174 175 177 181 183 184 188
189 208 216 219 237 261 262
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 16
204 0355H 269 PARSEOPTIONS . . . PROCEDURE BYTE STACK=000EH 258
169 000AH 2 PARSERET . . . . . WORD 170 173 174 179 183
37 0002H 85 PATCH. . . . . . . PROCEDURE PUBLIC STACK=0002H
10 PCM11. . . . . . . LITERALLY
10 PCMCTLC. . . . . . LITERALLY
10 PCMCTLO. . . . . . LITERALLY
10 PCMCTLS. . . . . . LITERALLY
10 PCMROUT. . . . . . LITERALLY
10 PCMRSX . . . . . . LITERALLY
6 PDHDR. . . . . . . LITERALLY
7 PDSTRUCTURE. . . . LITERALLY
9 PFACTIVE . . . . . LITERALLY
9 PFCHILDABORT . . . LITERALLY
9 PFCTLC . . . . . . LITERALLY
9 PFCTLD . . . . . . LITERALLY
9 PFKEEP . . . . . . LITERALLY
9 PFKERNAL . . . . . LITERALLY
9 PFNOCTLS . . . . . LITERALLY
9 PFPURE . . . . . . LITERALLY
9 PFRAW. . . . . . . LITERALLY
9 PFRESOURCE . . . . LITERALLY
9 PFSYS. . . . . . . LITERALLY
9 PFTABLE. . . . . . LITERALLY
9 PFTEMPKEEP . . . . LITERALLY
251 0462H 140 PLMSTART . . . . . PROCEDURE PUBLIC STACK=0016H
5 PNAMSIZ. . . . . . LITERALLY
61 006AH 16 PRINTBUF . . . . . PROCEDURE STACK=000AH 113 160 163 199 244
8 PSCIOWAIT. . . . . LITERALLY
8 PSDELAY. . . . . . LITERALLY
8 PSDQ . . . . . . . LITERALLY
8 PSFLAGWAIT . . . . LITERALLY
8 PSNQ . . . . . . . LITERALLY
8 PSPOLL . . . . . . LITERALLY
8 PSRUN. . . . . . . LITERALLY
8 PSSLEEP. . . . . . LITERALLY
8 PSSWAP . . . . . . LITERALLY
8 PSTERM . . . . . . LITERALLY
12 QDSTRUCTURE. . . . LITERALLY
19 QFDEV. . . . . . . LITERALLY
15 QFHIDE . . . . . . LITERALLY
14 QFKEEP . . . . . . LITERALLY
13 QFMX . . . . . . . LITERALLY
18 QFRPL. . . . . . . LITERALLY
16 QFRSP. . . . . . . LITERALLY
17 QFTABLE. . . . . . LITERALLY
11 QNAMSIZ. . . . . . LITERALLY
20 QPBSTRUCTURE . . . LITERALLY
68 0081H 16 SEARCHFIRST. . . . PROCEDURE BYTE STACK=000AH 130
72 0091H 16 SEARCHNEXT . . . . PROCEDURE BYTE STACK=000AH 156
2 SECTORLEN. . . . . LITERALLY
SETB . . . . . . . BUILTIN 194 269
76 00A1H 16 SETDMA . . . . . . PROCEDURE STACK=000AH 254
83 00C0H 19 SETUSERCODE. . . . PROCEDURE STACK=000AH
SHL. . . . . . . . BUILTIN 132
250 00B4H 1 SHOWNNOTHING . . . BYTE 116 200 260 267
100 0027H 1 SYS. . . . . . . . BYTE 133 134 154
101 002EH 1 SYSEXISTS. . . . . BYTE 122 155 162 256
PL/M-86 COMPILER CONCURRENT CP/M 86 --- DIR 1.0 PAGE 17
2 TAB. . . . . . . . LITERALLY
91 0006H 2 TAILLEN. . . . . . WORD 175 212 257
249 0000H 128 TBUFF. . . . . . . BYTE ARRAY(128) EXTERNAL(6) 212 216 257 261
100 0028H 1 TEMP . . . . . . . BYTE 132 133 134 149 226 228 229 231
87 00D3H 14 TERMINATE. . . . . PROCEDURE STACK=0008H 273
2 TRUE . . . . . . . LITERALLY 155 164 190 195 210 217 222 232 235 247 255
260
100 002BH 1 USER . . . . . . . BYTE 104 107 111 134 231 252
83 0004H 1 USER . . . . . . . BYTE PARAMETER AUTOMATIC 84 85
57 0057H 19 WRITECONSOLE . . . PROCEDURE STACK=000AH 96 97 139 142 144 145 148 149
MODULE INFORMATION:
CODE AREA SIZE = 04EEH 1262D
CONSTANT AREA SIZE = 0054H 84D
VARIABLE AREA SIZE = 00B5H 181D
MAXIMUM STACK SIZE = 0016H 22D
699 LINES READ
0 PROGRAM ERROR(S)
END OF PL/M-86 COMPILATION

12
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dircmd.plm Normal file
View File

@@ -0,0 +1,12 @@
$TITLE('CONCURRENT CP/M 86 --- DIR 1.0 ')
$compact
/* Conditional compile:
rsp=0ffh produce a DIR.RSP type of file
rsp=0 produce a DIR.CMD file
*/
$set(rsp=0h)
$include(dirm.plm)

530
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dirm.plm Normal file
View File

@@ -0,0 +1,530 @@
/* dirm:
This is the module included by DIRRSP or DIRCMD.
Revised:
Jan 80 by Thomas Rolander
July 81 by Doug Huskey
June 82 by Bill Fitler
July 82 by Danny Horovitz (made an RSP)
Dec 82 by Fran Borda (conditional comp)
Mar 83 by Bill Fitler ( " " )
Mar 83 by Danny Horovitz (control C fixes)
Conditional compile:
rsp=0ffh produce a DIR.RSP type of file
rsp=0 produce a DIR.CMD file
*/
/**** Vax commands to compile DIR.RSP and DIR.CMD:
$ ccpmsetup
$ plm86 dircmd.plm 'p1' 'p2' 'p3' 'p4' optimize(3) debug
$ link86 f1:scd.obj, dircmd.obj to dircmd.lnk
$ loc86 dircmd.lnk od(sm(code,dats,data,stack,const))-
ad(sm(code(0), dats(10000h))) ss(stack(+32)) to dircmd.
$ h86 dircmd
$ ! DIR.RSP
$ ! Note: separate code and data
$ asm86 rhdir.a86 !Rsp Header DIR
$ plm86 dirrsp.plm 'p1' 'p2' 'p3' 'p4' optimize(3) debug
$ link86 rhdir.obj, dirrsp.obj to dirrsp.lnk
$ loc86 dirrsp.lnk od(sm(code,dats,data,stack,const))-
ad(sm(code(0), dats(10000h))) ss(stack(0)) to dirrsp.
$ h86 dirrsp
**** Then, on a micro:
A>vax dircmd.h86 $fans
A>vax dirrsp.h86 $fans
A>gencmd dircmd data[b1000]
A>ren dir.cmd=dircmd.cmd
A>gencmd dirrsp data[b1000]
A>ren dir.rsp=dirrsp.cmd
**** Notes: Both DIRCMD.PLM and DIRRSP.PLM include DIRM.PLM, after setting
RSP flag appropriately.
****/
dir:
do;
$include (:f1:copyrt.lit)
$include (:f1:comlit.lit)
$include (:f1:mfunc.lit)
$include (:f1:proces.lit)
$include (:f1:qd.lit)
/**************************************
* *
* B D O S INTERFACE *
* *
**************************************/
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;
declare func byte;
declare info address;
end mon3;
mon4:
procedure (func,info) pointer external;
declare func byte;
declare info address;
end mon4;
patch: procedure public; /* dummy area for patching code segments */
declare i address;
/* first statement = 9 bytes, rest are 5 bytes */
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5;
i=i+5; i=i+5; i=i+5; i=i+5; i=i+5; /* about 79 bytes */
end patch;
$if rsp
declare fcb (36) byte; /* 1st default fcb */
declare fcb16 (1) byte at (@fcb(16)); /* 2nd default fcb */
$else
declare fcb (1) byte external; /* 1st default fcb */
declare fcb16 (1) byte external; /* 2nd default fcb */
$endif
write$console:
procedure (char);
declare char byte;
call mon1 (2,char);
end write$console;
print$buf:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$buf;
check$ctrl$c:
procedure byte;
$if rsp
if (dir$pd.flag and pf$ctlC) <> 0 then
do;
dir$pd.flag = dir$pd.flag and not double(pf$ctlC);
return(true);
end;
$endif
return (false);
end check$ctrl$c;
search$first:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (17,fcb$address);
end search$first;
search$next:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (18,fcb$address);
end search$next;
setdma: procedure(dma);
declare dma address;
call mon1(26,dma);
end setdma;
get$user$code:
procedure byte;
return mon2 (32,0ffh);
end get$user$code;
set$user$code:
procedure(user);
declare user byte;
call mon1 (32,user);
end set$user$code;
terminate:
procedure;
call mon1 (0,0);
end terminate;
declare
parse$fn structure (
buff$adr address,
fcb$adr address),
delimiter based parse$fn.buff$adr byte;
declare tail$len address;
parse: procedure address;
return mon3(152,.parse$fn);
end parse;
crlf:
procedure;
call write$console (0dh);
call write$console (0ah);
end crlf;
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * GLOBAL VARIABLES * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
declare dir$title (*) byte initial
('Directory for User x:','$');
declare (sys,temp,dcnt,cnt,user) byte;
declare
i byte,
new$user byte,
sys$exists byte,
incl$sys byte,
option byte;
declare
dirbuf (128) byte;
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * DIRECTORY DISPLAY * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
/* display directory heading */
heading: procedure;
if user > 9 then
do;
dir$title(19) = '1';
dir$title(20) = user - 10 + '0';
end;
else
do;
dir$title(19) = ' ';
dir$title(20) = user + '0';
end;
call print$buf (.dir$title);
end heading;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
help: procedure;
call mon1(m$prt$buf, .(cr, lf, tab, tab, tab ,'DIR EXAMPLES$'));
call mon1(m$prt$buf, .(cr, lf, lf, 'dir', tab, tab,
'(show all directory files on current drive and user)
call mon1(m$prt$buf, .(cr, lf, 'dir [g3]', tab, tab, tab, tab,
'(show non system files under user 3)$'));
call mon1(m$prt$buf, .(cr, lf, 'dir a: b: [s]', tab, tab, tab,
tab, '(show all files under current user on a: and b:)$'));
call terminate;
end help;
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* do next directory display */
directory: procedure boolean;
shown$nothing = false;
if new$user then do;
call heading;
new$user = false;
end;
sys$exists = false;
cnt = -1;
/* if drive is 0 (default)
then set to current disk */
if fcb(0) = 0
then fcb(0) = mon2 (m$curdsk,0) + 1;
if fcb(1) = ' ' then
/* check for blank filename => wildcard */
do i = 1 to 11;
fcb(i) = '?';
end;
/* get first file */
if (dcnt := search$first (.fcb)) <> 0ffh then
do while dcnt <> 0ffh;
temp = shl(dcnt,5);
sys = ((dirbuf(temp+10) and 80h) = 80h);
if (dirbuf(temp) = user) and
(incl$sys or not sys) then
do;
if ((cnt:=cnt+1) mod 4) = 0 then
do;
call crlf;
call write$console ('A'+fcb(0)-1);
end;
else
do;
call write$console (' ');
end;
call write$console (':');
call write$console (' ');
do i = 1 to 11;
if i = 9 then call write$console (' ');
call write$console
(dirbuf(temp+i) and 7fh);
if check$ctrl$c then
return(false);
end;
end;
else if sys then
sys$exists = true;
dcnt = search$next (.fcb);
end;
if cnt = -1 then
do;
call print$buf (.(0dh,0ah,
'File not found.','$'));
end;
if sys$exists then
call print$buf (.(0dh,0ah,
'System Files Exist','$'));
return(true);
end directory;
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * PARSING * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
/* parse one file name, return true if got one */
parse$file: procedure boolean;
dcl i address;
dcl buf based parse$fn.buff$adr (1) byte;
dcl parse$ret address;
if (parse$ret := parse$fn.buff$adr) = 0 then
return(false);
fcb(0), i = 0;
parse$ret = parse; /* kludge around */
do while parse$ret = 0 and buf(i) = '['; /* parse file name bugs */
if (i := findb(@buf(i), ']', tail$len - i)) <> 0ffffh then
do;
parse$fn.buff$adr = .buf(i) + 1; /* skip right bracket */
i = 0;
parse$ret = parse;
end;
else
buf(i) = 0;
end;
parse$fn.buff$adr = parse$ret;
if parse$fn.buff$adr <> 0ffffh then
do;
if fcb(1) <> ' ' then
do;
if parse$fn.buff$adr <> 0 and delimiter <> '[' and delimiter <> 0 then
parse$fn.buff$adr = parse$fn.buff$adr + 1;
return(true); /* parse$fn.buff$adr could = 0 */
end;
else if fcb(0) <> 0 and fcb(1) = ' ' then /* drive spec */
do;
call setb('?', @fcb(1), 11);
return(true);
end;
end;
else /* if parse$fn.buff$adr = 0ffffh then */
do;
call print$buf(.(cr, lf, 'Invalid filespec.$'));
shown$nothing = false; /* don't show directory */
return(false); /* also if parse$fn.buf$adr = 0 and fcb(0) = ' ' */
end;
end parse$file;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* parse & interpret all options - assume global */
parse$options: procedure boolean;
dcl (n,i) word;
dcl (options, in$brackets, error) boolean;
i = 0; /* parse file name doesn't work with delimiters */
parse$fn.fcb$adr = .dirbuf;
error = false;
options = true;
do while options and not error;
if (n := findb(@tbuff(i), '[', tail$len - i)) = 0ffffh then
options = false;
else
do;
i = i + n + 1;
parse$fn.buff$adr = .tbuff(i);
in$brackets = true;
do while in$brackets and not error;
if (parse$fn.buff$adr := parse) <> 0ffffh then
do;
if dirbuf(1) = 'S' then
incl$sys = true;
else if dirbuf(1) = 'G' then
do;
if dirbuf(3) <> ' ' then
temp = dirbuf(3) - '0' + 10;
else if dirbuf(2) <> ' ' then
temp = dirbuf(2) - '0';
if temp < 16 then
do;
call mon1(m$setusr, (user:=temp));
new$user = true;
end;
end;
else
error = true;
end; /* if parse */
if delimiter = ']' or parse$fn.buff$adr = 0 or
parse$fn.buff$adr = 0ffffh then
in$brackets = false;
end; /* while in$brackets */
end; /* else */
end; /* while options */
if error then
do;
call print$buf(.(cr, lf, 'Invalid Command Option$'));
return(false);
/* call help; */
end;
return(true);
end parse$options;
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * M A I N P R O G R A M * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
$if rsp
declare cpd$pointer pointer; /* Calling PD pointer stuff */
declare cpd$ptr structure (
offset address, segment address) at (@cpd$pointer);
declare calling$pd based cpd$pointer pd$structure;
declare dpd$pointer pointer; /* DIR RSP PD pointer stuff */
declare dpd$ptr structure (
offset address, segment address) at (@dpd$pointer);
declare dir$pd based dpd$pointer pd$structure;
declare qdbuf (131) byte;
declare dirqd qd$structure initial
(0, 0, 0, qf$keep + qf$rsp, 'DIR ', 131, 1, 0, 0, 0, 0, .qdbuf);
declare qpbbuf (131) byte;
declare cpd$offset address at (@qpbbuf(0));
declare tbuff (128) byte at (@qpbbuf(2));
declare dirqpb qpb$structure initial
(0, 0, 0, 0, .qpbbuf, 'DIR ');
$else
declare tbuff (128) byte external;
$endif
declare shown$nothing boolean;
plmstart: procedure public;
/* initialization */
$if rsp
call mon1(m$make$q, .dirqd);
call mon1(m$open$q, .dirqpb);
call mon1(m$set$prior, 200); /* Set priority same as other transients*/
$else
user = get$user$code; /* ????? whf */
incl$sys = (fcb(1) = 'S'); /* ????? why exclude if rsp? whf */
$endif
call setdma(.dirbuf);
$if rsp
cpd$pointer,dpd$pointer = mon4(m$sysdat, 0);
dpd$ptr.offset = mon3(m$getpd,0);
/* Don't allow control S, turn on tempkeep for control C checking */
dir$pd.flag = dir$pd.flag or pf$noctls or pf$tempkeep;
/* Read RSP Queue forever */
do forever;
call mon1(m$readq, .dirqpb);
dir$pd.flag = dir$pd.flag and not double(pf$ctlC);
/* Could be on from last DIR */
/* set defaults same as calling process's, have both PDs so will poke */
/* and not call O.S. */
cpd$ptr.offset = cpd$offset;
call mon1(m$setcns, calling$pd.cns);
call mon1(m$setusr, (user := calling$pd.user));
call mon1(m$select, calling$pd.dsk);
$endif
new$user = true;
sys$exists, incl$sys = false;
tail$len = findb(@tbuff, 0, 128);
/* scan for options - all are global */
if not parse$options then
goto done; /* option error */
/* do command line */
shown$nothing = true;
$if rsp
parse$fn.buff$adr = .tbuff;
$else
parse$fn.buff$adr = (.tbuff) + 1;/* Skip # of bytes in buffer */
$endif
parse$fn.fcb$adr = .fcb;
do while parse$file; /* false when no more files, sets */
if not directory then /* shown$nothing=false if parsing error */
goto done; /* directory = false if console inpute */
end;
if shown$nothing then /* no files specified on command line */
do;
call setb('?', @fcb(1), 11);
if not directory then
goto done; /* false on console input */
end;
done:
$if rsp
call mon1(m$detach, 0);
end; /* do forever */
$else
call terminate;
$endif
end plmstart;
end dir;

162
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dirrsp.h86 Normal file
View File

@@ -0,0 +1,162 @@
:020000021000EC
:1000000000000000000000000000000000000000F0
:020000021001EB
:100000000000000000BE03004449522020202020B0
:080010000400000000000000E4
:020000021004E8
:1000000000000000000000000000000000000000F0
:1000100000000000000000000000000000000000E0
:1000200000000000000000000000000000000000D0
:06003000000000003A018F
:02000002100AE2
:100000000100CCCCCCCCCCCCCCCCCCCCCCCCCCCCC7
:10001000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC20
:10002000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC10
:10003000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00
:10004000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCF0
:10005000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCE0
:10006000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCD0
:10007000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC0
:10008000CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCB0
:10009000CCCCCCCCCCCCCCCCCCCCAC0400000000B8
:020000020000FC
:10000000434F5059524947485420284329203139F9
:1000100038322C204449474954414C2052455345DD
:100020004152434820558BEC8B56048B4E06CDE055
:040030005DC20400A9
:020000020003F9
:020004000010EA
:02000002101AD2
:100008004469726563746F727920666F72205573E4
:0700180065722020783A24F4
:020000021035B7
:100004000D0A46696C65206E6F7420666F756E64A8
:020014002E2498
:020000021036B6
:100006000D0A53797374656D2046696C65732045D6
:050016007869737424F9
:020000021037B5
:10000B000D0A496E76616C69642066696C65737064
:04001B0065632E24C7
:020000021038B4
:10000F000D0A496E76616C696420436F6D6D616E88
:09001F0064204F7074696F6E24B7
:020000021015D7
:10000800000000000A0044495220202020208300DC
:0C001800010000000000000000004C028D
:020000021017D5
:10000400000000000000CF0244495220202020209C
:020000020003F9
:10000600558BECA14001B9050003C1A3400103C112
:10001600A3400103C1A3400103C1A3400103C1A33F
:10002600400103C1A3400103C1A3400103C1A34092
:100036000103C1A3400103C1A3400103C1A34001C1
:1000460003C1A3400103C1A3400103C1A3400101B1
:050056000E40015DC336
:020000020008F4
:10000B00558BECB002508A4604B40050E88BFF5D70
:03001B00C202001E
:020000020009F3
:10000E00558BECB00950FF7604E87BFF5DC2020011
:02000002000AF2
:10000E00558BECC41E540126F747068000740A2651
:0D001E008167067FFFB0FF5DC3B0005DC3CA
:02000002000CF0
:10000B00558BECB01150FF7604E84EFF5DC2020039
:02000002000DEF
:10000B00558BECB01250FF7604E83EFF5DC2020048
:02000002000EEE
:10000B00558BECB01A50FF7604E82EFF5DC2020050
:02000002000FED
:0F000B00558BECB02050B8FF0050E81DFF5DC3CF
:020000020010EC
:10000A00558BECB020508A4604B40050E80CFF5DD2
:03001A00C202001F
:020000020011EB
:0E000D00558BECB000B4005050E8FCFE5DC313
:020000020012EA
:0F000B00558BECB09850B8420150E8EDFE5DC344
:020000020013E9
:10000A00558BECB00D50E848FFB00A50E842FF5D4E
:01001A00C322
:020000020014E8
:10000B00558BEC803EC30109760CC606BB0131A0B3
:10001B00C3012C0AEB08C606BB0120A0C3010430A8
:0C002B00A2BC01B8A80150E829FF5DC389
:020000020017E5
:10000700558BECC606520300A0C501D0D87308E88B
:10001700C2FFC606C50100C606C60100C606C20164
:10002700FF823E840100750FB01950B8000050E8F8
:100037007CFEFEC0A28401803E850120751DC60698
:10004700C40101803EC4010B77118A1EC401B700A9
:10005700C68784013FFE06C40175E8B8840150E8ED
:10006700F2FEA2C1013CFF7405803EC101FF75038A
:10007700E9C000A0C101B105D2E0A2C001B4008966
:10008700C38A8FD30180E18080F980B0FF7401407B
:10009700A2BF018A8FC9013A0EC301757DF6D00A46
:1000A70006C701D0D87373A0C201FEC0A2C201B4B3
:1000B70000B9040031D2F7F109D2750CE804FFA0AA
:1000C70084010441FEC8EB02B02050E846FEB03A76
:1000D70050E840FEB02050E83AFEC606C401018051
:1000E7003EC4010B7740803EC401097506B020501D
:1000F700E821FE8A1EC401021EC001B7008A87C913
:1001070001247F50E80DFEE82DFED0D87304B0001F
:100117005DC3FE06C40175C7EB0CA0BF01D0D87341
:1001270005C606C601FFB8840150E837FEA2C10123
:10013700E936FF803EC201FF7507B8540350E8E671
:10014700FDA0C601D0D87307B8660350E8D8FDB044
:03015700FF5DC386
:02000002002CD0
:10000A00558BECA14201A34A0109C07503E9BF005F
:10001A00C606840100C70648010000E843FEA34A59
:10002A0001833E4A0100B0FF7401408B1E42018BDE
:10003A003648015080385BB0FF7401405922C1D064
:10004A00D873388B0E46012BCE8D38B05D1E07FC57
:10005A008BD1E306F2AE75F82BD14A891648018393
:10006A00FAFF740A89D68D0040A34201EBA78B1EC2
:10007A0042018B364801C60000EBA6A14A01A34201
:10008A000183F8FF743D803E850120741609C0740F
:10009A002E89C3803F5B7427823F007422FF064289
:1000AA0001EB1C823E8401007429803E8501207583
:1000BA00228D3E8501B03FB90B001E07FCF2AAB0A3
:1000CA00FF5DC3B87B0350E80AFDC606520300B0C1
:0500DA00005DC35DC3E1
:020000020039C3
:10000F00558BECC7064E010000C7064401C901C657
:10001F00064B0200C6064902FFA04B02F6D022068D
:10002F004902D0D87203E9CE008B0E46012B0E4E3B
:10003F00018B3E4E018DBDD102B05B1E07FC8BD1F3
:10004F00E306F2AE75F82BD14A89164C0183FAFFFD
:10005F007507C606490200EBC0A14E0103064C010D
:10006F0040A34E0189C68D84D102A34201C6064A20
:10007F0002FFA04B02F6D022064A02D0D8739AE8AC
:10008F000AFDA3420183F8FF7453803ECA015375E2
:10009F0007C606C701FFEB45803ECA014775398089
:1000AF003ECC01207409A0CC012C30040AEB0C804B
:1000BF003ECB01207408A0CB012C30A2C001A0C000
:1000CF00013C107318B12051A2C301B40050E8B520
:1000DF00FBC606C501FFEB05C6064B02FF8B1E4292
:1000EF0001803F5D740909DB740583FBFF7583C6CF
:1000FF00064A0200E97BFFA04B02D0D8730BB88FE2
:0D010F000350E8FAFBB0005DC3B0FF5DC314
:02000002004AB2
:10000C00558BECB08650B8580150E86CFBB087505B
:10001C00B8740150E862FBB09150B8C80050E85871
:10002C00FBB8C90150E817FCB09A50B8000050E872
:10003C0047FB891E50018C065201891E54018C0607
:10004C005601B09C50B8000050E82DFBA35401C4DD
:10005C001E5401268B47060D00100D000226894701
:10006C0006B08950B8740150E80EFBC41E5401262A
:10007C008167067FFFA1CF02A35001B09450C41E2C
:10008C005001268A4720B40050E8EDFAB02050C445
:10009C001E5001268A4713A2C301B40050E8D9FAB6
:1000AC00B00E50C41E5001268A4712B40050E8C846
:1000BC00FAC606C501FFB000A2C601A2C7018D3E5B
:1000CC00D102B980001E07FC8BD1E306F2AE75F8A5
:1000DC002BD14A89164601E819FEF6D0D0D8723BCE
:1000EC00C6065203FFC7064201D102C7064401846B
:1000FC0001E82AFDD0D8730BE8D0FBF6D0D0D8722B
:10010C001AEBEEA05203D0D873118D3E8501B03F8F
:10011C00B90B001E07FCF2AAE8B0FBB09350B80074
:0A012C000050E854FAE939FF5DC302
:00000001FF

1042
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dirrsp.lst Normal file
View File

File diff suppressed because it is too large Load Diff

12
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/dirrsp.plm Normal file
View File

@@ -0,0 +1,12 @@
$TITLE('CONCURRENT CP/M 86 --- DIR 1.0 ')
$compact
/* Conditional compile:
rsp=0ffh produce a DIR.RSP type of file
rsp=0 produce a DIR.CMD file
*/
$set(rsp=0ffh)
$include(dirm.plm)

101
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/rhdir.a86 Normal file
View File

@@ -0,0 +1,101 @@
; Code and Data Interface for DIR.RSP
; August 10, 1981
; July 27, 1982 (updated)
; Jan 1983 whf - added reg save to xdos
; Mar 1983 dh - shrunk to resonable size
name rhdir ;Rsp Header DIRectory
cgroup group code
dgroup group dats
public xdos,mon1,mon2,mon3,mon4
public rsplink
extrn plmstart:near
assume cs:cgroup,ds:dgroup
dats segment 'DATA'
org 0
rsphdr_len equ 16
pd_len equ 30H
uda_len equ 100H
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
ncopies db 0
dw 0,0,0,0, 0
db 0
org rsp_pd
pd dw 0,0 ;link fields
db 0 ;status
db 190 ;priority
dw 3 ;flags - system and keep
db 'DIR ' ;name
dw rsp_uda/10h ;uda paragraph
db 0,0 ;disk,user
db 0,0 ;ldisk,luser
dw 0 ;puremem - not re-entrant
;rest of pd
org rsp_uda ;start of uda
uda dw 0
dw 0 ;DMA must be explicitly set
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
org rsp_uda + 60H
db 1 ;insys = 1, always use UDA stack
db 0
dw 0cccch,0cccch,0cccch,0cccch ;62
dw 0cccch,0cccch,0cccch,0cccch ;6A
dw 0cccch,0cccch,0cccch,0cccch ;72
dw 0cccch,0cccch,0cccch,0cccch ;7A
dw 0cccch,0cccch,0cccch,0cccch ;82
dw 0cccch,0cccch,0cccch,0cccch ;8A
dw 0cccch,0cccch,0cccch,0cccch ;92
dw 0cccch,0cccch,0cccch,0cccch ;9A
dw 0cccch,0cccch,0cccch,0cccch ;A2
dw 0cccch,0cccch,0cccch,0cccch ;AA
dw 0cccch,0cccch,0cccch,0cccch ;B2
dw 0cccch,0cccch,0cccch,0cccch ;BA
dw 0cccch,0cccch,0cccch,0cccch ;C2
dw 0cccch,0cccch,0cccch,0cccch ;CA
dw 0cccch,0cccch,0cccch,0cccch ;D2
dw 0cccch,0cccch,0cccch,0cccch ;DA
dw 0cccch,0cccch,0cccch,0cccch ;E2
dw 0cccch,0cccch,0cccch,0cccch ;EA
dw 0cccch,0cccch,0cccch,0cccch ;F2
stk_top dw plmstart,0,0 ;initial IRET
org rsp_bottom
datsend equ offset $
dats ends
code segment public 'CODE'
org 0
db 'COPYRIGHT (C) 1982,'
db ' DIGITAL RESEARCH '
xdos proc
push bp
mov bp,sp
mov dx,[bp+4]
mov cx,[bp+6]
int 224
pop bp
ret 4
xdos endp
mon1 equ xdos
mon2 equ xdos
mon3 equ xdos
mon4 equ xdos
code ends
end

221
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/dir/rhdir.lst Normal file
View File

@@ -0,0 +1,221 @@
MCS-86 MACRO ASSEMBLER RHDIR PAGE 1
ISIS-II MCS-86 MACRO ASSEMBLER V2.1 ASSEMBLY OF MODULE RHDIR
OBJECT MODULE PLACED IN :F0:RHDIR.OBJ
ASSEMBLER INVOKED BY: :F0: RHDIR.A86
LOC OBJ LINE SOURCE
1 ; Code and Data Interface for DIR.RSP
2 ; August 10, 1981
3 ; July 27, 1982 (updated)
4 ; Jan 1983 whf - added reg save to xdos
5 ; Mar 1983 dh - shrunk to resonable size
6
7 name rhdir ;Rsp Header DIRectory
8
9 cgroup group code
10 dgroup group dats
11 public xdos,mon1,mon2,mon3,mon4
12 public rsplink
13 extrn plmstart:near
14
15 assume cs:cgroup,ds:dgroup
16
---- 17 dats segment 'DATA'
0000 18 org 0
0010 19 rsphdr_len equ 16
0030 20 pd_len equ 30H
0100 21 uda_len equ 100H
0000 22 rsp_top equ 0
0010 23 rsp_pd equ rsp_top + rsphdr_len
0040 24 rsp_uda equ rsp_pd + pd_len
0140 25 rsp_bottom equ rsp_uda + uda_len
0000 26 org rsp_top
27 ;RSP header
0000 0000 28 rsplink dw 0 ;becomes system data page paragraph
0002 0000 29 sdatvar dw 0
0004 00 30 ncopies db 0
0005 0000 31 dw 0,0,0,0, 0
0007 0000
0009 0000
000B 0000
000D 0000
000F 00 32 db 0
0010 33 org rsp_pd
0010 0000 34 pd dw 0,0 ;link fields
0012 0000
0014 00 35 db 0 ;status
0015 BE 36 db 190 ;priority
0016 0300 37 dw 3 ;flags - system and keep
0018 44495220202020 38 db 'DIR ' ;name
20
0020 0400 39 dw rsp_uda/10h ;uda paragraph
0022 00 40 db 0,0 ;disk,user
0023 00
0024 00 41 db 0,0 ;ldisk,luser
0025 00
0026 0000 42 dw 0 ;puremem - not re-entrant
MCS-86 MACRO ASSEMBLER RHDIR PAGE 2
LOC OBJ LINE SOURCE
43 ;rest of pd
44
0040 45 org rsp_uda ;start of uda
0040 0000 46 uda dw 0
0042 0000 47 dw 0 ;DMA must be explicitly set
0044 0000 48 dw 0,0,0,0, 0,0,0,0, 0,0,0,0
0046 0000
0048 0000
004A 0000
004C 0000
004E 0000
0050 0000
0052 0000
0054 0000
0056 0000
0058 0000
005A 0000
005C 0000 49 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 50 dw offset stk_top
00A0 51 org rsp_uda + 60H
00A0 01 52 db 1 ;insys = 1, always use UDA stack
00A1 00 53 db 0
00A2 CCCC 54 dw 0cccch,0cccch,0cccch,0cccch ;62
00A4 CCCC
00A6 CCCC
00A8 CCCC
00AA CCCC 55 dw 0cccch,0cccch,0cccch,0cccch ;6A
00AC CCCC
00AE CCCC
00B0 CCCC
00B2 CCCC 56 dw 0cccch,0cccch,0cccch,0cccch ;72
00B4 CCCC
00B6 CCCC
00B8 CCCC
00BA CCCC 57 dw 0cccch,0cccch,0cccch,0cccch ;7A
00BC CCCC
00BE CCCC
00C0 CCCC
00C2 CCCC 58 dw 0cccch,0cccch,0cccch,0cccch ;82
00C4 CCCC
00C6 CCCC
00C8 CCCC
00CA CCCC 59 dw 0cccch,0cccch,0cccch,0cccch ;8A
00CC CCCC
MCS-86 MACRO ASSEMBLER RHDIR PAGE 3
LOC OBJ LINE SOURCE
00CE CCCC
00D0 CCCC
00D2 CCCC 60 dw 0cccch,0cccch,0cccch,0cccch ;92
00D4 CCCC
00D6 CCCC
00D8 CCCC
00DA CCCC 61 dw 0cccch,0cccch,0cccch,0cccch ;9A
00DC CCCC
00DE CCCC
00E0 CCCC
00E2 CCCC 62 dw 0cccch,0cccch,0cccch,0cccch ;A2
00E4 CCCC
00E6 CCCC
00E8 CCCC
00EA CCCC 63 dw 0cccch,0cccch,0cccch,0cccch ;AA
00EC CCCC
00EE CCCC
00F0 CCCC
00F2 CCCC 64 dw 0cccch,0cccch,0cccch,0cccch ;B2
00F4 CCCC
00F6 CCCC
00F8 CCCC
00FA CCCC 65 dw 0cccch,0cccch,0cccch,0cccch ;BA
00FC CCCC
00FE CCCC
0100 CCCC
0102 CCCC 66 dw 0cccch,0cccch,0cccch,0cccch ;C2
0104 CCCC
0106 CCCC
0108 CCCC
010A CCCC 67 dw 0cccch,0cccch,0cccch,0cccch ;CA
010C CCCC
010E CCCC
0110 CCCC
0112 CCCC 68 dw 0cccch,0cccch,0cccch,0cccch ;D2
0114 CCCC
0116 CCCC
0118 CCCC
011A CCCC 69 dw 0cccch,0cccch,0cccch,0cccch ;DA
011C CCCC
011E CCCC
0120 CCCC
0122 CCCC 70 dw 0cccch,0cccch,0cccch,0cccch ;E2
0124 CCCC
0126 CCCC
0128 CCCC
012A CCCC 71 dw 0cccch,0cccch,0cccch,0cccch ;EA
012C CCCC
012E CCCC
0130 CCCC
0132 CCCC 72 dw 0cccch,0cccch,0cccch,0cccch ;F2
0134 CCCC
0136 CCCC
0138 CCCC
013A 0000 E 73 stk_top dw plmstart,0,0 ;initial IRET
MCS-86 MACRO ASSEMBLER RHDIR PAGE 4
LOC OBJ LINE SOURCE
013C 0000
013E 0000
74
0140 75 org rsp_bottom
76
0140 77 datsend equ offset $
---- 78 dats ends
79
---- 80 code segment public 'CODE'
0000 81 org 0
82
0000 434F5059524947 83 db 'COPYRIGHT (C) 1982,'
48542028432920
313938322C
0013 20444947495441 84 db ' DIGITAL RESEARCH '
4C205245534541
52434820
85
0025 86 xdos proc
0025 55 87 push bp
0026 8BEC 88 mov bp,sp
0028 8B5604 89 mov dx,[bp+4]
002B 8B4E06 90 mov cx,[bp+6]
002E CDE0 91 int 224
0030 5D 92 pop bp
0031 C20400 93 ret 4
94 xdos endp
95
0025 96 mon1 equ xdos
0025 97 mon2 equ xdos
0025 98 mon3 equ xdos
0025 99 mon4 equ xdos
---- 100 code ends
101 end
ASSEMBLY COMPLETE, NO ERRORS FOUND