Upload

Digital Research

CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/BDOS/README.MARKDOWN

@@ -0,0 +1 @@
+PL/M source of a BDOS dating from 08/15/1978. CP/M version 1.4. Disk image in RAW format (IMG).

CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/CPM/CCP.PLM

@@ -0,0 +1,423 @@
+$Q=1
+2900H: DECLARE BDOS LITERALLY '3206H', TRAN LITERALLY '100H';
+ /*  C O N S O L E   C O M M A N D   P R O C E S S O R (C C P)
+
+                           COPYRIGHT (C) GARY A. KILDALL
+                                    JUNE, 1975
+                                                        */
+
+ /* **************** LIBRARY PROCEDURES FOR DISKIO ************* */
+
+MON1: PROCEDURE(F,A);
+    DECLARE F BYTE,
+    A ADDRESS;
+    GO TO BDOS;
+    END MON1;
+
+MON2: PROCEDURE(F,A) BYTE;
+    DECLARE F BYTE,
+    A ADDRESS;
+    GO TO BDOS;
+    END MON2;
+
+READRDR: PROCEDURE BYTE;
+    /* READ FROM CURRENTLY ASSIGNED READER DEVICE */
+    RETURN MON2(3,0);
+    END READRDR;
+
+READCHAR: PROCEDURE BYTE;
+    RETURN MON2(1,0);
+    END READCHAR;
+
+DECLARE
+    TRUE LITERALLY '1',
+    FALSE LITERALLY '0',
+    FOREVER LITERALLY 'WHILE TRUE',
+    CR LITERALLY '13',
+    LF LITERALLY '10',
+    WHAT LITERALLY '63';
+
+PRINTCHAR: PROCEDURE(CHAR);
+    DECLARE CHAR BYTE;
+    CALL MON1(2,CHAR);
+    END PRINTCHAR;
+
+CRLF: PROCEDURE;
+    CALL PRINTCHAR(CR);
+    CALL PRINTCHAR(LF);
+    END CRLF;
+
+PRINT: PROCEDURE(A);
+    DECLARE A ADDRESS;
+    /* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
+    NEXT DOLLAR SIGN IS ENCOUNTERED */
+    CALL CRLF;
+    CALL MON1(9,A);
+    END PRINT;
+
+READ: PROCEDURE(A);
+    DECLARE A ADDRESS;
+    /* READ INTO BUFFER AT A+2 */
+    CALL MON1(10,A);
+    END READ;
+
+
+DECLARE DCNT BYTE;
+
+INITIALIZE: PROCEDURE;
+    CALL MON1(13,0);
+    END INITIALIZE;
+
+SELECT: PROCEDURE(D);
+    DECLARE D BYTE;
+    CALL MON1(14,D);
+    END SELECT;
+
+OPEN: PROCEDURE(FCB);
+    DECLARE FCB ADDRESS;
+    DCNT = MON2(15,FCB);
+    END OPEN;
+
+CLOSE: PROCEDURE(FCB);
+    DECLARE FCB ADDRESS;
+    DCNT = MON2(16,FCB);
+    END CLOSE;
+
+SEARCH: PROCEDURE(FCB);
+    DECLARE FCB ADDRESS;
+    DCNT = MON2(17,FCB);
+    END SEARCH;
+
+SEARCHN: PROCEDURE;
+    DCNT = MON2(18,0);
+    END SEARCHN;
+
+DELETE: PROCEDURE(FCB);
+    DECLARE FCB ADDRESS;
+    CALL MON1(19,FCB);
+    END DELETE;
+
+DISKREAD: PROCEDURE(FCB) BYTE;
+    DECLARE FCB ADDRESS;
+    RETURN MON2(20,FCB);
+    END DISKREAD;
+
+DISKWRITE: PROCEDURE(FCB) BYTE;
+    DECLARE FCB ADDRESS;
+    RETURN MON2(21,FCB);
+    END DISKWRITE;
+
+MAKE: PROCEDURE(FCB);
+    DECLARE FCB ADDRESS;
+    DCNT = MON2(22,FCB);
+    END MAKE;
+
+RENAME: PROCEDURE(FCB);
+    DECLARE FCB ADDRESS;
+    CALL MON1(23,FCB);
+    END RENAME;
+
+DECLARE (MAXLEN,COMLEN) BYTE, /* MAXIMUM AND CURRENT LENGTH */
+    COMBUFF(128) BYTE,                /* COMMAND BUFFER */
+    (TCBP,CBP) BYTE;                  /* BUFFER POINTERS */
+
+READCOM: PROCEDURE;
+    /* READ INTO COMMAND BUFFER */
+    MAXLEN = 128;
+    CALL READ(.MAXLEN);
+    END READCOM;
+
+
+
+ /* **************** END OF LIBRARY PROCEDURES ***************** */
+
+
+BREAK$KEY: PROCEDURE BYTE;
+    RETURN MON2(11,0);
+    END BREAK$KEY;
+
+LIFTHEAD: PROCEDURE;
+    /* EXPLICIT LIFT IF SHUGART 3900 DRIVE */
+    CALL MON1(12,0);
+    END LIFTHEAD;
+
+CSELECT: PROCEDURE BYTE;
+    /* GET CURRENTLY SELECTED DRIVE NUMBER */
+    RETURN MON2(25,0);
+    END CSELECT;
+
+MOVE: PROCEDURE(A,B,L);
+    /* MOVE FROM A TO B FOR L BYTES (L <= 255) */
+    DECLARE (A, B) ADDRESS,
+    (S BASED A, D BASED B, L) BYTE;
+        DO WHILE (L := L - 1) <> 255;
+        D = S; B = B + 1; A = A + 1;
+        END;
+    END MOVE;
+
+ERROR: PROCEDURE;
+    CALL CRLF;
+    CALL PRINT(.'FILE ERROR$');
+    CALL CRLF;
+    END ERROR;
+
+DECLARE BUFFA ADDRESS INITIAL(80H),
+    (BUFF BASED BUFFA) (128) BYTE;
+
+GETBUFF: PROCEDURE(I) BYTE;
+    DECLARE I BYTE;
+    RETURN BUFF(I);
+    END GETBUFF;
+
+    /* DISK I/O BUFFER */
+
+DECLARE COMFCB(32) BYTE, COMREC BYTE; /* COMMAND FILE CONTROL BLK */
+
+GETCOM: PROCEDURE(I) BYTE;
+    DECLARE I BYTE;
+    RETURN COMBUFF(I);
+    END GETCOM;
+
+
+COMERR: PROCEDURE(I);
+    /* ERROR IN COMMAND STRING STARTING AT POSITION I */
+    DECLARE (I,J) BYTE;
+    CALL CRLF;
+        DO WHILE (J := GETCOM(I)) <> ' ' AND I < COMLEN;
+        I = I + 1;
+        CALL PRINTCHAR(J);
+        END;
+    CALL PRINTCHAR(WHAT);
+    CALL CRLF;
+    END COMERR;
+
+DECLARE INTVEC DATA /* INTRINSIC FUNCTIONS */
+    (7,3,'DIRECT',0FFH,         /* LIST DIRECTORY ENTRIES */
+     6,3,'ERASE',0FFH,         /* DELETE FILES */
+     5,2,'TYPE',0FFH,           /* TYPE FILE CONTENTS */
+     5,3,'SAVE',0FFH,           /* SAVE MEMORY */
+    3,2,'A:',0FFH,              /* DISK A */
+    3,2,'B:',0FFH,              /* DISK B */
+     7,2,'ASSIGN',0FFH,         /* ASSIGN DEVICES */
+    7,3,'RENAME',0FFH,          /* RENAME A FILE */
+      0);
+
+
+DECLARE INT BYTE; /* INTRINSIC FUNCTION NUMBER SET BELOW */
+
+INTRINSIC: PROCEDURE;
+    /* THIS PROCEDURE SEARCHES THE INTVEC FOR A BUILT-IN
+    COMMAND.  THE INTRINSIC NUMBER IS STORED IN 'INT' UPON EXIT (255
+    INDICATES NOT FOUND) */
+    DECLARE (I,MAX,MIN,Q,C,NXT) BYTE;
+
+    NEXTINT: PROCEDURE BYTE;
+        RETURN INTVEC(I:=I+1);
+        END NEXTINT;
+
+    INT, I = 255;
+        DO WHILE (MAX := NEXTINT) > 0;
+        MIN = NEXTINT; NXT = I + MAX;
+        INT = INT + 1; C = 0;
+            DO WHILE C < COMLEN AND (Q := GETCOM (C)) = NEXTINT;
+            C = C + 1;
+            END;
+        IF (Q = ' ' OR C >= COMLEN) AND C >= MIN THEN
+            DO; CBP = C; RETURN;
+            END;
+        I = NXT;
+        END;
+    /* OTHERWISE NOT FOUND */
+    INT = 255;
+    END INTRINSIC;
+
+DEBLANK: PROCEDURE;
+    /* DEBLANK THE COMMAND BUFFER */
+        DO WHILE GETCOM(CBP) = ' ' AND CBP < COMLEN;
+        CBP = CBP + 1;
+        END;
+    END DEBLANK;
+
+FILLFCB: PROCEDURE;
+    /* READ THE FILENAME AND EXT FIELDS.  PLACE INTO 'COMFCB' */
+    DECLARE (I, J, CHAR) BYTE;
+
+    PUTFCB: PROCEDURE(I);
+        DECLARE I BYTE;
+        COMFCB(J:=J+1) = I;
+        END PUTFCB;
+
+    SCANC: PROCEDURE(C,L);
+        /* SCAN FOR THE CHARACTER C AND FILL FCB THRU POSITION L */
+        DECLARE (C,L) BYTE;
+            DO WHILE J < L AND (TCBP:=TCBP+1) < COMLEN AND
+            (CHAR := GETCOM(TCBP)) <> C AND CHAR <> ' ';
+            IF CHAR = '*' THEN
+                DO; CHAR = 63; /* QUESTION MARK */
+                TCBP = TCBP - 1;
+                END;
+            CALL PUTFCB(CHAR);
+            END;
+        IF CHAR = '*' THEN CHAR = GETCOM(TCBP:=TCBP+1);
+        END SCANC;
+
+    /* DEBLANK BUFFER */
+    CALL DEBLANK;
+    TCBP = CBP - 1;
+
+    COMFCB,COMREC,J = 0;
+    CHAR = ' ';
+        DO WHILE J <= 12;
+        IF J = 11 THEN CHAR = 0;
+        CALL PUTFCB(CHAR);
+        END;
+
+    J = 0;
+    CALL SCANC('.',8);
+    J = 8;
+    IF CHAR = '.' THEN
+        CALL SCANC('=',11);
+    END FILLFCB;
+
+
+SEARCHF: PROCEDURE;
+    /* SEARCH FOR COMFCB */
+        CALL SEARCH(.COMFCB);
+        END SEARCHF;
+
+
+TRANSIENT: PROCEDURE(A);
+    DECLARE A ADDRESS;
+    /* BRANCH TO TRANSIENT ROUTINE WITH THE ADDRESS OF COMFCB */
+    GO TO TRAN;
+    END TRANSIENT;
+
+CALL INITIALIZE;
+    /* ENABLE THE INTERRUPT SYSTEM */
+    ENABLE;
+
+BREAK:
+    CALL CRLF;
+    /* ARRIVE HERE ON BREAK KEY OR BACKSPACE TO BEGINNING OF LINE */
+  DO;  /* MONITOR COMMAND PROCESSOR */
+  DECLARE (I,J) BYTE;
+  DECLARE LA ADDRESS;
+
+    INCLA: PROCEDURE;
+        /* UTILITY PROCEDURE TO INCREMENT THE LOAD ADDRESS */
+        LA = LA + 80H;
+        END INCLA;
+
+    DO FOREVER;
+    /* SET THE DMA ADDRESS AT 80H */
+    CALL MON1(26,80H);
+    CALL LIFTHEAD;
+    CALL PRINTCHAR('A' + CSELECT);
+    CALL PRINTCHAR ('>');
+    CALL READCOM;
+    CALL CRLF;
+    IF COMLEN > 0 THEN
+        DO;
+        CBP = 0;
+        CALL INTRINSIC;
+        /* MAY BE A SAVE OR ASSIGN COMMAND */
+        IF INT = 3 OR INT = 6 THEN /* SCAN NUMBER */
+        DO;
+        I = 0;
+            DO WHILE (J := GETCOM(CBP:=CBP+1)) <> ' ' AND CBP<COMLEN;
+            I = SHL(I,3) + SHL(I,1) + (J - '0');
+            END;
+        END;
+        CALL FILLFCB;
+        IF INT = 0 THEN /* DIRECTORY */
+            DO;
+            CALL SEARCHF;
+                DO WHILE DCNT <> 255;
+                    DO I=1 TO 12;
+                    IF I = 9 THEN CALL PRINTCHAR(' ');
+                    CALL PRINTCHAR
+                      (GETBUFF((ROR(DCNT,3) AND 110$0000B)+I));
+                     IF BREAK$KEY THEN GO TO BREAK;
+                    END;
+                CALL CRLF;
+                CALL SEARCHN;
+                END;
+            END; ELSE
+        IF INT = 1 THEN /* DELETE COMMAND */
+            DO;
+            CALL DELETE(.COMFCB);
+            END; ELSE
+        IF INT = 2 THEN /* TYPE COMMAND */
+            DO;
+            CALL SEARCHF;
+            IF DCNT = 255 THEN CALL COMERR(CBP); ELSE
+              DO; CALL OPEN(.COMFCB);
+                DO WHILE DISKREAD(.COMFCB) = 0;
+                I = 0;
+                  DO WHILE I < 128 AND (J := GETBUFF(I)) <> 1AH;
+                  CALL PRINTCHAR(J); I = I + 1;
+                    IF BREAK$KEY THEN GO TO BREAK;
+                  END;
+                END; /* DISKREAD */
+              END; /* OF FILE PRESENT */
+            END; ELSE
+        IF INT = 3 THEN /* SAVE */
+            DO;
+            CALL DELETE(.COMFCB);
+            CALL MAKE(.COMFCB);
+            CALL OPEN(.COMFCB);
+            IF DCNT = 255 THEN /* ERROR */ CALL ERROR; ELSE
+                DO; /* SAVE I PAGES */
+                LA = TRAN;
+                /* CHANGE I TO NUMBER OF BLOCKS OF 128 */
+                I = SHL(I,1);
+                    DO WHILE (I:=I-1) <> 255;
+                    CALL MOVE(LA,80H,128); CALL INCLA;
+                    IF DISKWRITE(.COMFCB) <> 0 THEN
+                        DO; CALL ERROR; I = 0;
+                        END;
+                    END;
+                END;
+            CALL CLOSE(.COMFCB);
+            IF DCNT = 255 THEN CALL ERROR;
+            END; ELSE
+        IF INT = 6 THEN /* ASSIGN COMMAND */
+            CALL MON1(8,I);
+        ELSE
+    IF INT = 7 THEN /* RENAME FILE */
+        DO; CALL MOVE(.COMFCB,.COMFCB+16,16);
+        CBP = TCBP+1; CALL FILLFCB;
+        CALL RENAME(.COMFCB);
+        END; ELSE
+        /* LOOK FOR THE COMMAND ON DISK */
+            DO; /* MAY BE A DISK PREFIX */
+            IF INT <= 5 THEN /* A: = 4, B: = 5 */
+                CALL SELECT(INT - 4);
+            IF COMLEN > CBP THEN
+            DO; CALL FILLFCB;
+            CALL MOVE(.'COM',.COMFCB+9,3);
+            CALL OPEN(.COMFCB);
+            IF DCNT = 255 THEN CALL COMERR(0); ELSE
+                DO;
+                LA = TRAN;
+                    DO WHILE (I := DISKREAD(.COMFCB)) = 0;
+                    CALL MOVE(80H,LA,128); CALL INCLA;
+                    END;
+                IF I = 1 THEN
+                    DO; /* LOAD OK */
+                    CBP = TCBP;
+                    CALL FILLFCB;
+                    /* SET-UP FCB DIRECTLY AHEAD OF BUFF */
+                    CALL MOVE(.COMFCB,5CH,33);
+                    CALL LIFTHEAD;
+                    CALL TRANSIENT(5CH);
+                    END; ELSE CALL ERROR;
+                END;
+            END;
+            END;
+        END;
+    END; /* OF DO FOREVER */
+  END; /* OF MONITOR COMMAND PROCESSOR */
+
+EOF
+4=	<09>!<21>=Ny
*4=	<09>!<21>=Ny<12>!U=~<7E><1F>.<2E>w#6<00>j4<6A>!U=4>?<3F><><EFBFBD>56<35><36>~<7E>

CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/CPM/README.MARKDOWN

@@ -0,0 +1 @@
+This is a version of CP/M that is VERY early. It says "Copyright Gary Killdall". It may even be before he formed Digital Research. The source is in PLM. Text in the src calls it FDOS.

CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/LOAD COM/LOAD.PLM

@@ -0,0 +1,260 @@
+0FAH: DECLARE BDOS LITERALLY '3FFDH';
+  /* TRANSIENT COMMAND LOADER PROGRAM */
+
+
+LOADCOM: PROCEDURE BYTE;
+    DECLARE FCBA ADDRESS INITIAL(5CH);
+    DECLARE FCB BASED FCBA (33) BYTE;
+
+    DECLARE BUFFA ADDRESS INITIAL(80H), /* I/O BUFFER ADDRESS */
+        BUFFER BASED BUFFA (128) BYTE;
+
+    DECLARE SFCB(33) BYTE,  /* SOURCE FILE CONTROL BLOCK */
+        BSIZE LITERALLY '1024',
+        EOFILE LITERALLY '1AH',
+        SBUFF(BSIZE) BYTE  /* SOURCE FILE BUFFER */
+            INITIAL(EOFILE),
+        RFLAG BYTE,         /* READER FLAG */
+        SBP ADDRESS;        /* SOURCE FILE BUFFER POINTER */
+
+    /* LOADCOM LOADS TRANSIENT COMMAND FILES TO THE DISK FROM THE
+    CURRENTLY DEFINED READER PERIPHERAL.  THE LOADER PLACES THE MACHINE
+    CODE INTO A FILE WHICH APPEARS IN THE LOADCOM COMMAND */
+
+$I=5
+
+    MOVE: PROCEDURE(S,D,N);
+        DECLARE (S,D) ADDRESS, N BYTE,
+        A BASED S BYTE, B BASED D BYTE;
+            DO WHILE (N:=N-1) <> 255;
+            B = A; S=S+1; D=D+1;
+            END;
+        END MOVE;
+
+    GETCHAR: PROCEDURE BYTE;
+        /* GET NEXT CHARACTER */
+        DECLARE I BYTE;
+        IF RFLAG THEN RETURN READRDR;
+        IF (SBP := SBP+1) <= LAST(SBUFF) THEN
+            RETURN SBUFF(SBP);
+        /* OTHERWISE READ ANOTHER BUFFER FULL */
+            DO SBP = 0 TO LAST(SBUFF) BY 128;
+            IF (I:=DISKREAD(.SFCB)) = 0 THEN
+                CALL MOVE(80H,.SBUFF(SBP),80H); ELSE
+                DO; IF I<>1 THEN CALL PRINT(.'DISK READ ERROR$');
+                SBUFF(SBP) = EOFILE;
+                SBP = LAST(SBUFF);
+                END;
+            END;
+        SBP = 0; RETURN SBUFF;
+        END GETCHAR;
+DECLARE
+    STACKPOINTER LITERALLY 'STACKPTR';
+
+
+PRINTNIB: PROCEDURE(N);
+    DECLARE N BYTE;
+        IF N > 9 THEN CALL PRINTCHAR(N+'A'-10); ELSE
+        CALL PRINTCHAR(N+'0');
+    END PRINTNIB;
+
+PRINTHEX: PROCEDURE(B);
+    DECLARE B BYTE;
+        CALL PRINTNIB(SHR(B,4)); CALL PRINTNIB(B AND 0FH);
+    END PRINTHEX;
+
+PRINTADDR: PROCEDURE(A);
+    DECLARE A ADDRESS;
+    CALL PRINTHEX(HIGH(A)); CALL PRINTHEX(LOW(A));
+    END PRINTADDR;
+
+
+ /* INTEL HEX FORMAT LOADER */
+
+RELOC: PROCEDURE;
+    DECLARE (RL, CS, RT) BYTE;
+    DECLARE
+        LA ADDRESS,     /* LOAD ADDRESS */
+        TA ADDRESS,     /* TEMP ADDRESS */
+        SA ADDRESS,     /* START ADDRESS */
+        FA ADDRESS,     /* FINAL ADDRESS */
+        NB ADDRESS,     /* NUMBER OF BYTES LOADED */
+        SP ADDRESS,     /* STACK POINTER UPON ENTRY TO RELOC */
+
+    MBUFF(256) BYTE,
+    P BYTE,
+    L ADDRESS;
+
+    SETMEM: PROCEDURE(B);
+        /* SET MBUFF TO B AT LOCATION LA MOD LENGTH(MBUFF) */
+        DECLARE (B,I) BYTE;
+        IF LA < L THEN /* MAY BE A RETRY */ RETURN;
+            DO WHILE LA > L + LAST(MBUFF); /* WRITE A PARAGRAPH */
+                DO I = 0 TO 127; /* COPY INTO BUFFER */
+                BUFFER(I) = MBUFF(LOW(L)); L = L + 1;
+                END;
+            /* WRITE BUFFER ONTO DISK */
+            P = P + 1;
+            IF DISKWRITE(FCBA) <> 0 THEN
+                DO; CALL PRINT(.'DISK WRITE ERROR$');
+                HALT;
+                /* RETRY AFTER INTERRUPT NOP */
+                L = L - 128;
+                END;
+            END;
+        MBUFF(LOW(LA)) = B;
+        END SETMEM;
+
+    READHEX: PROCEDURE BYTE;
+        /* READ ONE HEX CHARACTER FROM THE INPUT */
+        DECLARE H BYTE;
+        IF (H := GETCHAR) - '0' <= 9 THEN RETURN H - '0';
+        IF H - 'A' > 5 THEN GO TO CHARERR;
+        RETURN H - 'A' + 10;
+        END READHEX;
+
+    READBYTE: PROCEDURE BYTE;
+        /* READ TWO HEX DIGITS */
+        RETURN SHL(READHEX,4) OR READHEX;
+        END READBYTE;
+
+    READCS: PROCEDURE BYTE;
+        /* READ BYTE WHILE COMPUTING CHECKSUM */
+        DECLARE B BYTE;
+        CS = CS + (B := READBYTE);
+        RETURN B;
+        END READCS;
+
+    MAKE$DOUBLE: PROCEDURE(H,L) ADDRESS;
+        /* CREATE A BOUBLE BYTE VALUE FROM TWO SINGLE BYTES */
+        DECLARE (H,L) BYTE;
+        RETURN SHL(DOUBLE(H),8) OR L;
+        END MAKE$DOUBLE;
+
+    DIAGNOSE: PROCEDURE;
+
+    DECLARE M BASED TA BYTE;
+
+    NEWLINE: PROCEDURE;
+        CALL CRLF; CALL PRINTADDR(TA); CALL PRINTCHAR(':');
+        CALL PRINTCHAR(' ');
+        END NEWLINE;
+
+    /* PRINT DIAGNOSTIC INFORMATION AT THE CONSOLE */
+        CALL PRINT(.'LOAD  ADDRESS $'); CALL PRINTADDR(TA);
+        CALL PRINT(.'ERROR ADDRESS $'); CALL PRINTADDR(LA);
+
+        CALL PRINT(.'BYTES READ:$'); CALL NEWLINE;
+        DO WHILE TA < LA;
+        IF (LOW(TA) AND 0FH) = 0  THEN CALL NEWLINE;
+        CALL PRINTHEX(MBUFF(TA-L)); TA=TA+1;
+        CALL PRINTCHAR(' ');
+        END;
+    CALL CRLF;
+    HALT;
+    END DIAGNOSE;
+
+
+    /* INITIALIZE */
+    SA, FA, NB = 0;
+    SP = STACKPOINTER;
+    P = 0; /* PARAGRAPH COUNT */
+    TA,LA,L = 100H;  /* BASE ADDRESS OF TRANSIENT ROUTINES */
+    IF FALSE THEN
+        CHARERR:  /* ARRIVE HERE IF NON-HEX DIGIT IS ENCOUNTERED */
+        DO; /* RESTORE STACKPOINTER */ STACKPOINTER = SP;
+        CALL PRINT(.'NON-HEXADECIMAL DIGIT ENCOUNTERED $');
+        CALL DIAGNOSE;
+        END;
+
+
+    /* READ RECORDS UNTIL :00XXXX IS ENCOUNTERED */
+
+        DO FOREVER;
+        /* SCAN THE : */
+            DO WHILE GETCHAR <> ':';
+            END;
+
+        /* SET CHECK SUM TO ZERO, AND SAVE THE RECORD LENGTH */
+        CS = 0;
+        /* MAY BE THE END OF TAPE */
+        IF (RL := READCS) = 0 THEN
+                GO TO FIN;
+        NB = NB + RL;
+
+        TA, LA = MAKE$DOUBLE(READCS,READCS);
+        IF SA = 0 THEN SA = LA;
+
+
+        /* READ THE RECORD TYPE (NOT CURRENTLY USED) */
+        RT = READCS;
+
+        /* PROCESS EACH BYTE */
+            DO WHILE (RL := RL - 1) <> 255;
+            CALL SETMEM(READCS); LA = LA+1;
+            END;
+        IF LA > FA THEN FA = LA - 1;
+
+        /* NOW READ CHECKSUM AND COMPARE */
+        IF CS + READBYTE <> 0 THEN
+            DO; CALL PRINT(.'CHECK SUM ERROR $');
+            CALL DIAGNOSE;
+            END;
+        END;
+
+    FIN:
+    /* EMPTY THE BUFFERS */
+    TA = LA;
+        DO WHILE L < TA;
+        CALL SETMEM(0); LA = LA+1;
+        END;
+    /* PRINT FINAL STATISTICS */
+    CALL PRINT(.'FIRST ADDRESS $'); CALL PRINTADDR(SA);
+    CALL PRINT(.'LAST  ADDRESS $'); CALL PRINTADDR(FA);
+    CALL PRINT(.'BYTES READ    $'); CALL PRINTADDR(NB);
+    CALL PRINT(.'RECORDS WRITTEN $'); CALL PRINTHEX(P);
+    CALL CRLF;
+
+    END RELOC;
+
+ /* ARRIVE HERE FROM THE SYSTEM MONITOR, READY TO READ THE HEX TAPE */
+
+ /* SET UP STACKPOINTER IN THE LOCAL AREA */
+DECLARE STACK(16) ADDRESS, SP ADDRESS;
+SP = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STACK));
+
+SBP = LENGTH(SBUFF);
+   /* SET UP THE SOURCE FILE */
+    CALL MOVE(FCBA,.SFCB,33);
+    CALL MOVE(.('HEX',0),.SFCB(9),4);
+    CALL SEARCH(.SFCB);
+    IF (RFLAG := DCNT = 255) THEN
+        CALL PRINT(.'SOURCE IS READER$'); ELSE
+        DO; CALL PRINT(.'SOURCE IS DISK$');
+        CALL OPEN(.SFCB);
+        IF DCNT = 255 THEN CALL PRINT(.'-CANNOT OPEN SOURCE$');
+        END;
+    CALL CRLF;
+
+    CALL MOVE(.'COM',FCBA+9,3);
+
+ /* REMOVE ANY EXISTING FILE BY THIS NAME */
+ CALL DELETE(FCBA);
+ /* THEN OPEN A NEW FILE */
+ CALL MAKE(FCBA); CALL OPEN(FCBA);
+ IF DCNT = 255 THEN CALL PRINT(.'NO MORE DIRECTORY SPACE$'); ELSE
+        DO; CALL RELOC;
+        CALL CLOSE(FCBA);
+        IF DCNT = 255 THEN CALL PRINT(.'CANNOT CLOSE FILE$');
+        END;
+ CALL CRLF;
+
+ /* RESTORE STACKPOINTER FOR RETURN */
+STACKPOINTER = SP;
+RETURN 0;
+END LOADCOM;
+;
+EOF
+= 0;
+                /* IGNORE BLANK TAPE AND RUBOUTS */
+         

CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/LOAD COM/README.MARKDOWN

@@ -0,0 +1 @@
+Here is PLM source for the LOAD command that goes with the early CP/M above. It reads a file from the reader, and saves it to disk.