Upload

Digital Research

CPM OPERATING SYSTEMS/CPM.Z80.DE/PERSONAL/PCPM/PCPM-80 1.0 SOURCE/READ.ME

@@ -0,0 +1,39 @@
+The following list of corrections should be made to the Personal CP/M 8-bit
+version 1.0 documentation.
+
+Programmer's Guide
+
+        page 2-10
+        BDOS function 2
+                text says 'CONSOLE INPUT'
+                should be 'CONSOLE OUTPUT'
+
+        page 2-45
+        BDOS function 33
+                'Entry Parameters' add after Register C line:
+                'Register DE:   FCB Address'
+
+        page 2-49
+        BDOS function 35
+                replace information about values returned in registers with:
+                'Random record field of FCB set'
+
+System Guide
+
+        Section 2
+                References to the BDOS size being 1100h bytes are incorrect.
+                The BDOS code segment is 1000h bytes, and the BDOS data
+                segment is 00BFh bytes.  With the standard distibution,
+                BDOSH.REL and BDOSL.REL will link these in a separate area
+                from the BDOS code segment.  OEMs that purchase the source
+                can set an assembly-time switch that will make the data areas
+                part of the code segment so that it will all be linked as one
+                segment of 1100h bytes if the BDOS will execute in RAM.
+
+        page 4-15
+        BIOS function WRITE
+                Entry Parameters:  Register C = 0:  normal sector write
+                                                1:  write to directory sector
+                                                2:  write to the first sector
+                                                    of a new data block
+

CPM OPERATING SYSTEMS/CPM.Z80.DE/PERSONAL/PCPM/PCPM-80 1.0 SOURCE/README.MARKDOWN

@@ -0,0 +1,61 @@
+Source files of PCP/M-80 1.0.
+
+/READ.ME
+
+The following list of corrections should be made to the Personal CP/M 8-bit
+version 1.0 documentation.
+
+Programmer's Guide
+
+        page 2-10
+        BDOS function 2
+                text says 'CONSOLE INPUT'
+                should be 'CONSOLE OUTPUT'
+
+        page 2-45
+        BDOS function 33
+                'Entry Parameters' add after Register C line:
+                'Register DE:   FCB Address'
+
+        page 2-49
+        BDOS function 35
+                replace information about values returned in registers with:
+                'Random record field of FCB set'
+
+System Guide
+
+        Section 2
+                References to the BDOS size being 1100h bytes are incorrect.
+                The BDOS code segment is 1000h bytes, and the BDOS data
+                segment is 00BFh bytes.  With the standard distibution,
+                BDOSH.REL and BDOSL.REL will link these in a separate area
+                from the BDOS code segment.  OEMs that purchase the source
+                can set an assembly-time switch that will make the data areas
+                part of the code segment so that it will all be linked as one
+                segment of 1100h bytes if the BDOS will execute in RAM.
+
+        page 4-15
+        BIOS function WRITE
+                Entry Parameters:  Register C = 0:  normal sector write
+                                                1:  write to directory sector
+                                                2:  write to the first sector
+                                                    of a new data block
+
+
+/README.TOO
+
+Please note: line 2528 in BDOS.MAC is corrupted. It should read
+
+        jp      z,COPY$DIRLOC   ;stop at end of dir
+
+--------------------------
+
+This zip file contains the original source for Personal CP/M 1.0. 
+If anybody figures out anything about this code, please drop an
+email message to me at : 
+
+gaby@gaby.de
+
+and I'll pass it on.
+
+tnx

CPM OPERATING SYSTEMS/CPM.Z80.DE/PERSONAL/PCPM/PCPM-80 1.0 SOURCE/README.TOO

@@ -0,0 +1,15 @@
+Please note: line 2528 in BDOS.MAC is corrupted. It should read
+
+        jp      z,COPY$DIRLOC   ;stop at end of dir
+
+--------------------------
+
+This zip file contains the original source for Personal CP/M 1.0. 
+If anybody figures out anything about this code, please drop an
+email message to me at : 
+
+gaby@gaby.de
+
+and I'll pass it on.
+
+tnx

CPM OPERATING SYSTEMS/CPM.Z80.DE/PERSONAL/PCPM/PCPM-80 1.0 SOURCE/STAT.PLM

@@ -0,0 +1,834 @@
+stat:
+do;
+declare
+    cpmversion literally '20h'; /* requires 2.0 cp/m */
+ /* c p / m   s t a t u s    c o m m a n d  (s t a t) */
+
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+/* status    status    status    status    status    status */
+
+/*
+            copyright(c) 1975, 1976, 1977, 1978, 1979, 1984
+            digital research
+            box 579
+            pacific grove, ca
+            93950
+  */
+
+/* modified 10/30/78 to fix the space computation */
+/* modified 01/28/79 to remove despool dependencies */
+/* modified 07/26/79 to operate under cp/m 2.0 */
+/* modified 03/14/84 to remove iobyte modification for Personal CP/M */
+
+declare jump byte data(0c3h),
+    jadr address data (.status);
+    /* jump to status */
+
+/* function call 32 returns the address of the disk parameter
+block for the currently selected disk, which consists of:
+        scptrk      (2 by) number of sectors per track
+        blkshf      (1 by) log2 of blocksize (2**blkshf=blksize)
+        blkmsk      (1 by) 2**blkshf-1
+        extmsk      (1 by) logical/physical extents
+        maxall      (2 by) max alloc number
+        dirmax      (2 by) size of directory-1
+        dirblk      (2 by) reservation bits for directory
+        chksiz      (2 by) size of checksum vector
+        offset      (2 by) offset for operating system
+*/
+
+declare
+    /* fixed locations for cp/m */
+    bdosa literally '0006h',     /* bdos base */
+    buffa literally '0080h',     /* default buffer */
+    fcba  literally '005ch',     /* default file control block */
+    dolla literally '006dh',     /* dollar sign position */
+    parma literally '006eh',     /* parameter, if sent */
+    rreca literally '007dh',     /* random record 7d,7e,7f */
+    rreco literally '007fh',     /* high byte of random overflow */
+    sectorlen literally '128',   /* sector length */
+    memsize address at(bdosa),   /* end of memory */
+    rrec address at(rreca),      /* random record address */
+    rovf byte at(rreco),         /* overflow on getfile */
+    doll byte at(dolla),         /* dollar parameter */
+    parm byte at(parma),         /* parameter */
+    sizeset byte,                /* true if displaying size field */
+    dpba address,                /* disk parameter block address */
+    dpb based dpba structure
+    (spt address, bls byte, bms byte, exm byte, mxa address,
+     dmx address, dbl address, cks address, ofs address),
+    scptrk literally 'dpb.spt',
+    blkshf literally 'dpb.bls',
+    blkmsk literally 'dpb.bms',
+    extmsk literally 'dpb.exm',
+    maxall literally 'dpb.mxa',
+    dirmax literally 'dpb.dmx',
+    dirblk literally 'dpb.dbl',
+    chksiz literally 'dpb.cks',
+    offset literally 'dpb.ofs';
+
+
+boot: procedure external;
+    /* reboot */
+    end boot;
+
+mon1: procedure(f,a) external;
+    declare f byte, a address;
+    end mon1;
+
+mon2: procedure(f,a) byte external;
+    declare f byte, a address;
+    end mon2;
+
+mon3: procedure(f,a) address external;
+    declare f byte, a address;
+    end mon3;
+
+
+status: procedure;
+    declare copyright(*) byte data (
+    '   Copyright (c) 1984, Digital Research');
+    /* dummy outer procedure 'status' will start at 100h */
+    /* determine status of currently selected disk */
+
+declare alloca address,
+    /* alloca is the address of the disk allocation vector */
+    alloc based alloca (1024) byte;  /* allocation vector */
+
+declare
+    true literally '1',
+    false literally '0',
+    forever literally 'while true',
+    cr literally '13',
+    lf literally '10';
+
+printchar: procedure(char);
+    declare char byte;
+    call mon1(2,char);
+    end printchar;
+
+crlf: procedure;
+    call printchar(cr);
+    call printchar(lf);
+    end crlf;
+
+printb: procedure;
+    /* print blank character */
+    call printchar(' ');
+    end printb;
+
+printx: procedure(a);
+    declare a address;
+    declare s based a byte;
+        do while s <> 0;
+        call printchar(s);
+        a = a + 1;
+        end;
+    end printx;
+
+print: procedure(a);
+    declare a address;
+    /* print the string starting at address a until the
+    next 0 is encountered */
+    call crlf;
+    call printx(a);
+    end print;
+
+break: procedure byte;
+    return mon2(11,0); /* console ready */
+    end break;
+
+declare dcnt byte;
+
+version: procedure byte;
+    /* returns current cp/m version # */
+    return mon2(12,0);
+    end version;
+
+select: procedure(d);
+    declare d byte;
+    call mon1(14,d);
+    end select;
+
+open: procedure(fcb);
+    declare fcb address;
+    dcnt = mon2(15,fcb);
+    end open;
+
+search: procedure(fcb);
+    declare fcb address;
+    dcnt = mon2(17,fcb);
+    end search;
+
+searchn: procedure;
+    dcnt = mon2(18,0);
+    end searchn;
+
+cselect: procedure byte;
+    /* return current disk number */
+    return mon2(25,0);
+    end cselect;
+
+setdma: procedure(dma);
+    declare dma address;
+    call mon1(26,dma);
+    end setdma;
+
+getalloca: procedure address;
+    /* get base address of alloc vector */
+    return mon3(27,0);
+    end getalloca;
+
+getlogin: procedure address;
+    /* get the login vector */
+    return mon3(24,0);
+    end getlogin;
+
+writeprot: procedure;
+    /* write protect the current disk */
+    call mon1(28,0);
+    end writeprot;
+
+getrodisk: procedure address;
+    /* get the read-only disk vector */
+    return mon3(29,0);
+    end getrodisk;
+
+setind: procedure;
+    /* set file indicators for current fcb */
+    call mon1(30,fcba);
+    end setind;
+
+set$dpb: procedure;
+    /* set disk parameter block values */
+    dpba = mon3(31,0); /* base of dpb */
+    end set$dpb;
+
+getuser: procedure byte;
+    /* return current user number */
+    return mon2(32,0ffh);
+    end getuser;
+
+setuser: procedure(user);
+    declare user byte;
+    call mon1(32,user);
+    end setuser;
+
+getfilesize: procedure(fcb);
+    declare fcb address;
+    call mon1(35,fcb);
+    end getfilesize;
+
+declare oldsp address,   /* sp on entry */
+    stack(16) address;   /* this program's stack */
+
+declare
+    fcbmax literally '512', /* max fcb count */
+    fcbs literally 'memory',/* remainder of memory */
+    fcb(33) byte at (fcba), /* default file control block */
+    buff(128) byte at (buffa);          /* default buffer */
+
+declare bpb address; /* bytes per block */
+
+set$bpb: procedure;
+    call set$dpb; /* disk parameters set */
+    bpb = shl(double(1),blkshf) * sectorlen;
+    end set$bpb;
+
+select$disk: procedure(d);
+    declare d byte;
+    /* select disk and set bpb */
+    call select(d);
+    call set$bpb; /* bytes per block */
+    end select$disk;
+
+getalloc: procedure(i) byte;
+    /* return the ith bit of the alloc vector */
+    declare i address;
+    return
+    rol(alloc(shr(i,3)), (i and 111b) + 1);
+    end getalloc;
+
+declare
+    accum(4) byte,    /* accumulator */
+    ibp byte;         /* input buffer pointer */
+
+compare: procedure(a) byte;
+    /* compare accumulator with four bytes addressed by a */
+    declare a address;
+    declare (s based a) (4) byte;
+    declare i byte;
+        do i = 0 to 3;
+        if s(i) <> accum(i) then return false;
+        end;
+    return true;
+    end compare;
+
+scan: procedure;
+    /* fill accum with next input value */
+    declare (i,b) byte;
+    setacc: procedure(b);
+        declare b byte;
+        accum(i) = b; i = i + 1;
+        end setacc;
+    /* deblank input */
+        do while buff(ibp) = ' '; ibp=ibp+1;
+        end;
+    /* initialize accum length */
+    i = 0;
+        do while i < 4;
+        if (b := buff(ibp)) > 1 then /* valid */
+            call setacc(b); else /* blank fill */
+            call setacc(' ');
+        if b <= 1 or b = ',' or b = ':' or
+          b = '*' or b = '.' or b = '>' or
+          b = '<' or b = '=' then buff(ibp) = 1;
+        else
+            ibp = ibp + 1;
+        end;
+    ibp = ibp + 1;
+    end scan;
+
+pdecimal: procedure(v,prec);
+    /* print value v with precision prec (10,100,1000)
+    with leading zero suppression */
+    declare
+        v address,    /* value to print */
+        prec address, /* precision */
+        zerosup byte, /* zero suppression flag */
+        d byte;       /* current decimal digit */
+    zerosup = true;
+        do while prec <> 0;
+        d = v / prec ; /* get next digit */
+        v = v mod prec;/* get remainder back to v */
+        prec = prec / 10; /* ready for next digit */
+        if prec <> 0 and zerosup and d = 0 then call printb; else
+            do; zerosup = false; call printchar('0'+d);
+            end;
+        end;
+    end pdecimal;
+
+add$block: procedure(ak,ab);
+    declare (ak, ab) address;
+    /* add one block to the kilobyte accumulator */
+    declare kaccum based ak address; /* kilobyte accum */
+    declare baccum based ab address; /* byte accum */
+    baccum = baccum + bpb;
+        do while baccum >= 1024;
+        baccum = baccum - 1024;
+        kaccum = kaccum + 1;
+        end;
+    end add$block;
+
+count: procedure(mode) address;
+    declare mode byte; /* true if counting 0's */
+    /* count kb remaining, kaccum set upon exit */
+    declare
+        ka  address,  /* kb accumulator */
+        ba  address,  /* byte accumulator */
+        i   address,  /* local index */
+        bit byte;     /* always 1 if mode = false */
+    ka, ba = 0;
+    bit = 0;
+        do i = 0 to maxall;
+        if mode then bit = getalloc(i);
+        if not bit then call add$block(.ka,.ba);
+        end;
+    return ka;
+    end count;
+
+abortmsg: procedure;
+    call print(.('** Aborted **',0));
+    end abortmsg;
+
+userstatus: procedure;
+    /* display active user numbers */
+    declare i byte;
+    declare user(32) byte;
+    declare ufcb(*) byte data ('????????????',0,0,0);
+    call print(.('Active User :',0));
+    call pdecimal(getuser,10);
+    call print(.('Active Files:',0));
+        do i = 0 to last(user);
+        user(i) = false;
+        end;
+    call setdma(.fcbs);
+    call search(.ufcb);
+        do while dcnt <> 255;
+        if (i := fcbs(shl(dcnt and 11b,5))) <> 0e5h then
+            user(i and 1fh) = true;
+        call searchn;
+        end;
+        do i = 0 to last(user);
+        if user(i) then call pdecimal(i,10);
+        end;
+    end userstatus;
+
+drivestatus: procedure;
+    declare
+        rpb address,
+        rpd address;
+    pv: procedure(v);
+        declare v address;
+        call crlf;
+        call pdecimal(v,10000);
+        call printchar(':');
+        call printb;
+        end pv;
+    /* print the characteristics of the currently selected drive */
+    call print(.('    ',0));
+    call printchar(cselect+'A');
+    call printchar(':');
+    call printx(.(' Drive Characteristics',0));
+    rpb = shl(double(1),blkshf); /* records/block=2**blkshf */
+    if (rpd := (maxall+1) * rpb) = 0 and (rpb <> 0) then
+        call print(.('65536: ',0)); else
+        call pv(rpd);
+        call printx(.('128 Byte Record Capacity',0));
+    call pv(count(false));
+        call printx(.('Kilobyte Drive  Capacity',0));
+    call pv(dirmax+1);
+        call printx(.('32  Byte Directory Entries',0));
+    call pv(shl(chksiz,2));
+        call printx(.('Checked  Directory Entries',0));
+    call pv((extmsk+1) * 128);
+        call printx(.('Records/ Extent',0));
+    call pv(rpb);
+        call printx(.('Records/ Block',0));
+    call pv(scptrk);
+        call printx(.('Sectors/ Track',0));
+    call pv(offset);
+        call printx(.('Reserved Tracks',0));
+    call crlf;
+    end drivestatus;
+
+diskstatus: procedure;
+    /* display disk status */
+    declare login address, d byte;
+    login = getlogin; /* login vector set */
+    d = 0;
+        do while login <> 0;
+        if low(login) then
+            do; call select$disk(d);
+            call drivestatus;
+            end;
+        login = shr(login,1);
+        d = d + 1;
+        end;
+    end diskstatus;
+
+match: procedure(va,vl) byte;
+    /* return index+1 to vector at va if match */
+    declare va address,
+        v based va (16) byte,
+        vl byte;
+    declare (i,j,match,sync) byte;
+    j,sync = 0;
+        do sync = 1 to vl;
+        match = true;
+            do i = 0 to 3;
+            if v(j) <> accum(i) then match=false;
+            j = j + 1;
+            end;
+        if match then return sync;
+        end;
+    return 0; /* no match */
+    end match;
+
+declare devl(*) byte data
+    ('VAL:USR:DSK:');
+
+devreq: procedure byte;
+    /* process device request, return true if found */
+
+    declare
+        (i,j,items) byte;
+
+
+    items = 0;
+        do forever;
+        call scan;
+        if (i:=match(.devl,8)) = 0 then return items<>0;
+        items = items+1; /* found first/next item */
+        if i = 1 then /* list possible assignment */
+            do;
+            call print(.('Temp R/O Disk: d:=R/O',0));
+            call print(.('Set Indicator: d:filename.typ ',
+                          '$R/O $R/W $SYS $DIR',0));
+            call print(.('Disk Status  : DSK: d:DSK:',0));
+            call print(.('User Status  : USR:',0));
+            end; else
+        if i = 2 then /* list user status values */
+            call userstatus;
+            else
+	if i = 3 then /* show the disk device status */
+            call diskstatus;
+        /* end of current item, look for more */
+        call scan;
+        if accum(0) = ' ' then return true;
+        if accum(0) <> ',' then
+            do; call print(.('Bad Delimiter',0));
+            return true;
+            end;
+        end; /* of do forever */
+    end devreq;
+
+pvalue: procedure(v);
+    declare (d,zero) byte,
+        (k,v) address;
+    k = 10000;
+    zero = false;
+        do while k <> 0;
+        d = low(v/k); v = v mod k;
+        k = k / 10;
+        if zero or k = 0 or d <> 0 then
+             do; zero = true; call printchar('0'+d);
+             end;
+        end;
+    call printchar('k');
+    call crlf;
+    end pvalue;
+
+comp$alloc: procedure;
+    alloca = getalloca;
+    call printchar(cselect+'A');
+    call printx(.(': ',0));
+    end comp$alloc;
+
+prcount: procedure;
+    /* print the actual byte count */
+    call pvalue(count(true));
+    end prcount;
+
+pralloc: procedure;
+    /* print allocation for current disk */
+    call print (.('Bytes Remaining On ',0));
+    call comp$alloc;
+    call prcount;
+    end pralloc;
+
+prstatus: procedure;
+    /* print the status of the disk system */
+    declare (login, rodisk) address;
+    declare d byte;
+    login = getlogin; /* login vector set */
+    rodisk = getrodisk; /* read only disk vector set */
+    d = 0;
+        do while login <> 0;
+        if low(login) then
+            do; call select$disk(d);
+            call comp$alloc;
+            call printx(.('R/',0));
+            if low(rodisk) then
+                call printchar('O'); else
+                call printchar('W');
+            call printx(.(', Space: ',0));
+            call prcount;
+            end;
+        login = shr(login,1); rodisk = shr(rodisk,1);
+        d = d + 1;
+        end;
+    call crlf;
+    end prstatus;
+
+setdisk: procedure;
+    if fcb(0) <> 0 then call select$disk(fcb(0)-1);
+    end setdisk;
+
+getfile: procedure;
+    /* process file request */
+
+    declare
+        fnam literally '11',   fext literally '12',
+        fmod literally '14',
+        frc  literally '15',   fln  literally '15',
+        fdm  literally '16',   fdl  literally '31',
+        ftyp literally '9',
+        rofile literally '9', /* read/only file */
+        infile literally '10';  /* invisible file */
+    declare
+        fcbn address,   /* number of fcb's collected so far */
+        finx(fcbmax) address, /* index vector used during sort */
+        fcbe(fcbmax) address, /* extent counts */
+        fcbb(fcbmax) address, /* byte count (mod kb) */
+        fcbk(fcbmax) address, /* kilobyte count */
+        fcbr(fcbmax) address, /* record count */
+        bfcba address,    /* index into directory buffer */
+        fcbsa address,    /* index into fcbs */
+        bfcb based bfcba (32) byte,   /* template over directory */
+        fcbv based fcbsa (16) byte;   /* template over fcbs entry */
+    declare
+        i address,     /* fcb counter during collection and display */
+        l address,     /* used during sort and display */
+        k address,     /* " */
+        m address,     /* " */
+        kb byte,       /* byte counter */
+        lb byte,       /* byte counter */
+        mb byte,       /* byte counter */
+        (b,f) byte,    /* counters */
+        matched byte;  /* used during fcbs search */
+
+    multi16: procedure;
+        /* utility to compute fcbs address from i */
+        fcbsa = shl(i,4) + .fcbs;
+        end multi16;
+
+    declare
+        scase byte; /* status case # */
+
+    declare
+        fstatlist(*) byte data('R/O',0,'R/W',0,'SYS',0,'DIR',0);
+
+    setfilestatus: procedure byte;
+            /* eventually, scase set r/o=0,r/w=1,dat=2,sys=3 */
+        declare
+            fstat(*) byte data('R/O R/W SYS DIR ');
+        if doll = ' ' then return false;
+        call move(4,.parm,.accum); /* $???? */
+        if accum(0) = 'S' and accum(1) = ' ' then
+            return not (sizeset := true);
+        /* must be a parameter */
+        if (scase := match(.fstat,4)) = 0 then
+            call print(.('Invalid File Indicator',0));
+        return true;
+        end setfilestatus;
+
+    printfn: procedure;
+        declare (k, lb) byte;
+        /* print file name */
+            do k = 1 to fnam;
+            if (lb := fcbv(k) and 7fh) <> ' ' then
+                do; if k = ftyp then call printchar('.');
+                call printchar(lb);
+                end;
+            end;
+        end printfn;
+
+    call set$bpb; /* in case default disk */
+    call setdisk;
+    sizeset = false;
+    scase = 255;
+    if setfilestatus then
+        do; if scase = 0 then return;
+        scase = scase - 1;
+        end; else
+    if fcb(1) = ' ' then /* no file named */
+        do; call pralloc;
+        return;
+        end;
+    /* read the directory, collect all common file names */
+    fcbn,fcb(0) = 0;
+    fcb(fext),fcb(fmod) = '?'; /* question mark matches all */
+    call search(fcba); /* fill directory buffer */
+    collect: /* label for debug */
+        do while dcnt <> 255;
+        /* another item found, compare it for common entry */
+        bfcba = shl(dcnt and 11b,5)+buffa; /* dcnt mod 4 * 32 */
+        matched = false; i = 0;
+            do while not matched and i < fcbn;
+            /* compare current entry */
+            call multi16;
+                do kb = 1 to fnam;
+                if bfcb(kb) <> fcbv(kb) then kb = fnam; else
+                /* complete match if at end */
+                    matched = kb = fnam;
+                end;
+            i = i + 1;
+            end;
+    checkmatched: /* label for debug */
+        if matched then i = i - 1; else
+            do; /* copy to new position in fcbs */
+            fcbn = (i := fcbn) + 1;
+            call multi16;
+            /* fcbsa set to next to fill */
+            if (fcbn > fcbmax) or (fcbsa + 16) >= memsize then
+                do; call print(.('** Too Many Files **',0));
+                i = 0; fcbn = 1;
+                call multi16;
+                end;
+            /* save index to element for later sort */
+            finx(i) = i;
+                do kb = 0 to fnam;
+                fcbv(kb) = bfcb(kb);
+                end;
+            fcbe(i),fcbb(i),fcbk(i),fcbr(i) = 0;
+            end;
+        /* entry is at, or was placed at location i in fcbs */
+        fcbe(i) = fcbe(i) + 1; /* extent incremented */
+        /* record count */
+        fcbr(i) = fcbr(i) + bfcb(frc)
+                + (bfcb(fext) and extmsk) * 128;
+        /* count kilobytes */
+    countbytes: /* label for debug */
+        lb = 1;
+        if maxall > 255 then lb = 2; /* double precision inx */
+            do kb = fdm to fdl by lb;
+                mb = bfcb(kb);
+                if lb = 2 then /* double precision inx */
+                    mb = mb or bfcb(kb+1);
+                if mb <> 0 then /* allocated */
+                call add$block(.fcbk(i),.fcbb(i));
+            end;
+        call searchn; /* to next entry in directory */
+        end; /* of do while dcnt <> 255 */
+
+    display: /* label for debug */
+    /* now display the collected data */
+    if fcbn = 0 then call print(.('File Not Found',0)); else
+    if scase = 255 then /* display collected data */
+        do;
+        /* sort the file names in ascending order */
+        if fcbn > 1 then /* requires at least two to sort */
+            do; l = 1;
+                do while l > 0; /* bubble sort */
+                l = 0;
+                    do m = 0 to fcbn - 2;
+                    i = finx(m+1); call multi16; bfcba = fcbsa; i = finx(m);
+                    call multi16; /* sets fcbsa, basing fcbv */
+                        do kb = 1 to fnam; /* compare for less or equal */
+                        if (b:=bfcb(kb)) < (f:=fcbv(kb)) then /* switch */
+                            do; k = finx(m); finx(m) = finx(m + 1);
+                            finx(m + 1) = k; l = l + 1; kb = fnam;
+                            end;
+                        else if b > f then kb = fnam; /* stop compare */
+                        end;
+                    end;
+                end;
+            end;
+        if sizeset then
+            call print(.(' Size ',0)); else
+            call crlf;
+        call printx(.(' Recs  Bytes  Ext Acc',0));
+        l = 0;
+            do while l < fcbn;
+            i = finx(l); /* i is the index to next in order */
+            call multi16; call crlf;
+            /* print the file length */
+            call move(16,.fcbv(0),fcba);
+            fcb(0) = 0;
+            if sizeset then
+                do; call getfilesize(fcba);
+                if rovf <> 0 then call printx(.('65536',0)); else
+                    call pdecimal(rrec,10000);
+                call printb;
+                end;
+            call pdecimal(fcbr(i),10000); /* rrrrr */
+            call printb; /* blank */
+            call pdecimal(fcbk(i),10000);  /* bbbbbk */
+            call printchar('k'); call printb;
+            call pdecimal(fcbe(i),1000);   /* eeee */
+            call printb;
+            call printchar('R');
+            call printchar('/');
+            if rol(fcbv(rofile),1) then
+                call printchar('O'); else
+                call printchar('W');
+            call printb;
+            call printchar('A'+cselect); call printchar(':');
+            /* print filename.typ */
+            if (mb:=rol(fcbv(infile),1)) then call printchar('(');
+            call printfn;
+            if mb then call printchar(')');
+            l = l + 1;
+            end;
+        call pralloc;
+        end; else
+    setfileatt: /* label for debug */
+    /* set file attributes */
+        do;
+        l = 0;
+            do while l < fcbn;
+            if break then
+                do; call abortmsg; return;
+                end;
+            i = l;
+            call multi16;
+            call crlf;
+            call printfn;
+                do case scase;
+                /* set to r/o */
+                fcbv(rofile) = fcbv(rofile) or 80h;
+                /* set to r/w */
+                fcbv(rofile) = fcbv(rofile) and 7fh;
+                /* set to sys */
+                fcbv(infile) = fcbv(infile) or 80h;
+                /* set to dir */
+                fcbv(infile) = fcbv(infile) and 7fh;
+                end;
+            /* place name into default fcb location */
+            call move(16,fcbsa,fcba);
+            fcb(0) = 0; /* in case matched user# > 0 */
+            call setind; /* indicators set */
+            call printx(.(' set to ',0));
+            call printx(.fstatlist(shl(scase,2)));
+            l = l + 1;
+            end;
+        end;
+    end getfile;
+
+setdrivestatus: procedure;
+    /* handle possible drive status assignment */
+    call scan; /* remove drive name */
+    call scan; /* check for = */
+    if accum(0) = '=' then
+        do; call scan; /* get assignment */
+        if compare(.('R/O ')) then
+            do; call setdisk; /* a: ... */
+            call writeprot;
+            end; else
+        call print(.('Invalid Disk Assignment',0));
+        end;
+    else /* not a disk assignment */
+        do; call setdisk;
+        if match(.devl,8) = 3 then call drive$status; else
+            call getfile;
+        end;
+    end setdrivestatus;
+
+ /* save stack pointer and reset */
+oldsp = stackptr;
+stackptr = .stack(length(stack));
+/* process request */
+if version < cpmversion then
+    call print(.('Wrong CP/M Version (Requires 2.0 or greater)',0));
+    else
+        do;
+        /* size display if $S set in command */
+        ibp = 1; /* initialize buffer pointer */
+        if fcb(0) = 0 and fcb(1) = ' ' then /* stat only */
+            call prstatus; else
+            do;
+            if fcb(0) <> 0 then
+                call setdrivestatus; else
+                do;
+                if not devreq then /* must be file name */
+                    call getfile;
+                end;
+            end;
+        end;
+ /* restore old stack before exit */
+    stackptr = oldsp;
+    end status;
+end;
+

CPM OPERATING SYSTEMS/CPM.Z80.DE/PERSONAL/PCPM/PCPM-80 1.0 SOURCE/XSUB.SUB

@@ -0,0 +1,10 @@
+asm xsub0
+rmac xsub1
+link xsub1[os]
+xsub
+ddt xsub1.spr
+ixsub0.hex
+r
+g0
+save 4 xsubnew.com
+

CPM OPERATING SYSTEMS/CPM.Z80.DE/PERSONAL/PCPM/PCPM-80 1.0 SOURCE/XSUB0.ASM

@@ -0,0 +1,135 @@
+;        xsub relocator     version 2.2
+version	equ	20h
+;	xsub relocator program, included with the module
+;	to perform the move from 200h to the destination address
+;
+;	copyright (c) 1979, 1980
+;	digital research
+;	box 579
+;	pacific grove, ca.
+;	93950
+;
+	org	100h
+	db	(lxi or (b shl 3))	;lxi b,module size
+	org	$+2			;skip address field
+	jmp	start
+	db	' Extended Submit Vers '
+	db	version/16+'0','.',version mod 16+'0'
+nogo:	db	'Xsub Already Present$'
+badver:	db	'Requires CP/M Version 2.0 or later$'
+;
+bdos	equ	0005h	;bdos entry point
+print	equ	9	;bdos print function
+vers	equ	12	;get version number
+ccplen	equ	0800h	;size of ccp
+module	equ	200h	;module address
+;
+start:
+;	ccp's stack used throughout
+	push	b	;save the module's length
+	lda	bdos+1	;xsub already present?
+	cpi	06h	;low address must be 06h
+	jnz	loaderr
+	lhld	bdos+1
+	inx	h
+	inx	h
+	inx	h
+	lxi	d,xsubcon
+	mvi	c,4    
+present:
+	ldax	d
+	cmp	m
+	jnz	continue
+	inx	h
+	inx	d
+	dcr	c
+	jz	loaderr
+	jmp	present
+;
+loaderr:
+;	bdos or xsub not lowest module in memory, return to ccp
+	mvi	c,print
+	lxi	d,nogo	;already present message
+	call	bdos	;to print the message
+	pop	b	;recall length
+	ret		;to the ccp
+;
+continue:
+	mvi	c,vers
+	call	bdos	;version number?
+	cpi	version	;2.0 or greater
+	jnc	versok
+;
+;	wrong version
+	mvi	c,print
+	lxi	d,badver
+	call	bdos
+	pop	b
+	ret		;to ccp
+;
+versok:
+	lxi	h,bdos+2;address field of jump to bdos (top memory)
+	mov	a,m	;a has high order address of memory top
+	dcr	a	;page directly below bdos
+	sui	(ccplen shr 8)	;-ccp pages
+	pop	b	;recall length of module
+	push	b	;and save it again
+	sub	b	;a has high order address of reloc area
+	mov	d,a
+	mvi	e,0	;d,e addresses base of reloc area
+	push	d	;save for relocation below
+;
+	lxi	h,module;ready for the move
+move:	mov	a,b	;bc=0?
+	ora	c
+	jz	reloc
+	dcx	b	;count module size down to zero
+	mov	a,m	;get next absolute location
+	stax	d	;place it into the reloc area
+	inx	d
+	inx	h
+	jmp	move
+;
+reloc:	;storage moved, ready for relocation
+;	hl addresses beginning of the bit map for relocation
+	pop	d	;recall base of relocation area
+	pop	b	;recall module length
+	push	h	;save bit map base in stack
+	mov	h,d	;relocation bias is in d
+;
+rel0:	mov	a,b	;bc=0?
+	ora	c
+	jz	endrel
+;
+;	not end of the relocation, may be into next byte of bit map
+	dcx	b	;count length down
+	mov	a,e
+	ani	111b	;0 causes fetch of next byte
+	jnz	rel1
+;	fetch bit map from stacked address
+	xthl
+	mov	a,m	;next 8 bits of map
+	inx	h
+	xthl		;base address goes back to stack
+	mov	l,a	;l holds the map as we process 8 locations
+rel1:	mov	a,l
+	ral		;cy set to 1 if relocation necessary
+	mov	l,a	;back to l for next time around
+	jnc	rel2	;skip relocation if cy=0
+;
+;	current address requires relocation
+	ldax	d
+	add	h	;apply bias in h
+	stax	d
+rel2:	inx	d	;to next address
+	jmp	rel0	;for another byte to relocate
+;
+endrel:	;end of relocation
+	pop	d	;clear stacked address
+;	h has the high order 8-bits of relocated module address
+	mvi	l,0
+	pchl		;go to relocated program
+xsubcon:
+	db	'xsub'
+	end
+

CPM OPERATING SYSTEMS/CPM.Z80.DE/PERSONAL/PCPM/PCPM-80 1.0 SOURCE/XSUB1.ASM

@@ -0,0 +1,232 @@
+;       xsub  'Extended Submit Facility'  version 2.2
+;
+;
+;
+;	xsub loads below ccp, and feeds command lines to
+;	programs which read buffered input
+;
+bias	equ	0000h	;bias for relocation
+base	equ	0ffffh	;no intercepts below here
+wboot	equ	0000h
+bdos	equ	0005h
+bdosl	equ	bdos+1
+dbuff	equ	0080h
+;
+cr	equ	0dh	;carriage return
+lf	equ	0ah	;line feed
+modnum	equ	14	;module number position
+pbuff	equ	9	;print buffer
+rbuff	equ	10	;read buffer
+openf	equ	15	;open file
+closef	equ	16	;close file
+delf	equ	19	;delete file
+dreadf	equ	20	;disk read
+dmaf	equ	26	;set dma function
+;
+;
+	org	0000h+bias
+;	initialize jmps to include xsub module
+	jmp	start
+	ds	3
+trapjmp:
+	jmp	trap
+	db	'xsub'
+start:
+	lhld	wboot+1
+	shld	savboot
+	lxi	h,wstart
+	shld	wboot+1
+	lhld	bdosl
+	shld	rbdos+1	;real bdos entry
+	lxi	h,trapjmp	;address to fill
+	shld	bdosl	;jmp @0005 leads to trap
+	pop	h	;ccp return address
+	shld	ccpret
+	pchl		;back to ccp
+;
+savboot:
+	ds	2	;warm boot saved and restored at end
+			;of submit file
+;
+wstart:
+	lxi	sp,stack
+	mvi	c,pbuff	;print message
+	CALL	GET$SUBADDR
+	lxi	d,actmsg
+<EFBFBD>	CNZ	rbdos
+	lxi	h,dbuff	;restore default buffer
+	shld	udma
+	call	rsetdma
+	lxi	h,trapjmp
+	shld	bdosl	;fixup low jump address
+	lhld	ccpret	;back to ccp
+	pchl
+
+actmsg:	db	cr,lf,'(xsub active)$'
+;
+trap:	;arrive here at each bdos call
+	pop	h	;return address
+	push	h	;back to stack
+	mov	a,h	;high address
+	cpi	base shr 8
+	jnc	rbdos	;skip calls on bdos above here
+	mov	a,c	;function number
+	cpi	rbuff
+	jz	rnbuff	;read next buffer
+	cpi	dmaf	;set dma address?
+	jnz	rbdos	;skip if not
+	xchg		;dma to hl
+	shld	udma	;save it
+	xchg
+rbdos:	jmp	0000h	;filled in at initialization
+;
+setdma:
+	lxi	d,combuf
+SETDMA1:
+	mvi	c,dmaf
+	JMP	RBDOS
+;
+rsetdma:
+	lhld	udma
+	xchg
+	JMP	SETDMA1
+;
+GET$SUBADDR:
+	LHLD	RBDOS+1
+	MVI	L,09H
+	MOV	E,M
+	INX	H
+	MOV	D,M
+	XCHG
+	MOV	A,M
+	ORA	A
+	RET
+;
+DELETE$SUB:
+	CALL 	GET$SUBADDR
+	MVI	M,0
+	MVI	C,DELF
+	LXI	D,SUBFCB
+;
+<EFBFBD>fbdos:
+	push	b
+	push	d
+	call	setdma
+	pop	d
+	pop	b
+	call	rbdos
+	push	psw
+	call	rsetdma
+	pop	psw
+	ret
+;
+cksub:	;check for sub file present
+	CALL	GET$SUBADDR
+	RZ
+	INX	H
+	LXI	D,SUBS1
+	MVI	C,20
+;
+MOVE:
+	INR	C
+MOVE1:
+	ORA	C
+	DCR	C
+	RZ
+	MOV	A,M
+	STAX	D
+	INX	H
+	INX	D
+	JMP	MOVE1
+;
+rnbuff:
+	push	d	;command address
+	call	cksub	;sub file present?
+	pop	d
+	mvi	c,rbuff
+	ORA	A
+	jz	restor	;no sub file 
+;
+	push	d
+	lda	subrc	;length of file
+	ora	a	;zero?
+	jz	rbdos	;skip if so
+	dcr	a	;length - 1
+	sta	subcr	;next to read
+	mvi	c,dreadf
+	lxi	d,subfcb
+	call	fbdos	;read record
+	ORA	A
+	JZ	READOK
+
+	CALL	DELETE$SUB
+	MVI	C,0
+restor:
+	lhld	savboot
+<EFBFBD>	shld	wboot+1
+	jmp	rbdos
+
+READOK:
+;	now print the buffer with cr,lf
+
+	lxi	h,combuf
+	mov	e,m	;length
+	mvi	d,0	;high order 00
+	dad	d	;to last character position
+	inx	h
+	mvi	m,cr
+	inx	h
+	mvi	m,lf
+	inx	h
+	mvi	m,'$'
+	mvi	c,pbuff
+	lxi	d,combuf+1
+	LDAX	D
+	CPI	3
+	CNZ	rbdos	;to print it
+	pop	h	;.max length
+	lxi	d,combuf
+	ldax	d	;how long?
+	cmp	m	;cy if ok
+	jc	movlin
+	mov	a,m	;max length
+	stax	d	;truncate length
+movlin:
+	mov	c,a	;length to c
+	inr	c	;+1
+	inx	h	;to length of line
+	XCHG
+	CALL	MOVE
+	CALL 	GET$SUBADDR
+
+	PUSH	H	;.SUBFLAG
+	INX	H	;.FCB(S1)
+	INX	H	;.FCB(S2)
+	INX	H	;.FCB(RC)
+	DCR	M
+	POP	H
+	CZ	DELETE$SUB
+	LDA	COMBUF+1	;^C?
+	CPI	3
+	RNZ
+	MVI	C,PBUFF
+	LXI	D,CTLCMSG
+	CALL	RBDOS
+	JMP	WBOOT
+;
+subfcb:
+	db	1	;a:
+	db	'$$$     '
+	db	'SUB'
+<EFBFBD>	db	0
+SUBS1:	
+	DB	0,0
+subrc:
+	ds	1
+	ds	16	;map
+subcr:	ds	1
+;
+CTLCMSG:DB	'^C$'
+combuf:	ds	131
+udma:	dw	dbuff
+ccpret:	ds	2	;ccp return address