LOAD:
DO;
    /* C P / M   C O M M A N D   F I L E   L O A D E R

    COPYRIGHT (C) 1976, 1977, 1978
    DIGITAL RESEARCH
    BOX 579 PACIFIC GROVE
    CALIFORNIA 93950

    */

DECLARE
    TPA   LITERALLY '0100H',   /* TRANSIENT PROGRAM AREA */
    DFCBA LITERALLY '005CH',   /* DEFAULT FILE CONTROL BLOCK */
    DBUFF LITERALLY '0080H';   /* DEFAULT BUFFER ADDRESS */

/* JMP LOADCOM TO START LOAD */
DECLARE JUMP BYTE DATA(0C3H);
DECLARE JUMPA ADDRESS DATA(.LOADCOM);

DECLARE COPYRIGHT(*) BYTE DATA
    (' COPYRIGHT (C) 1978, DIGITAL RESEARCH ');

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;

DECLARE SP ADDRESS;

BOOT: PROCEDURE;
    STACKPTR = SP;
    RETURN;
    END BOOT;


LOADCOM: PROCEDURE;
    DECLARE FCB (33) BYTE AT (DFCBA),
       FCBA LITERALLY 'DFCBA';
    DECLARE BUFFER (128) BYTE AT (DBUFF),
        BUFFA LITERALLY 'DBUFF';
    DECLARE SFCB(33) BYTE,  /* SOURCE FILE CONTROL BLOCK */
        BSIZE LITERALLY '1024',
        EOFILE LITERALLY '1AH',
        SBUFF(BSIZE) BYTE,  /* SOURCE FILE BUFFER */
        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 */

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;

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;

PRINTM: PROCEDURE(A);
    DECLARE A ADDRESS;
    CALL MON1(9,A);
    END PRINTM;

PRINT: PROCEDURE(A);
    DECLARE A ADDRESS;
    /* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
    NEXT DOLLAR SIGN IS ENCOUNTERED WITH PRECEDING CRLF */
    CALL CRLF;
    CALL PRINTM(A);
    END PRINT;

DECLARE LA ADDRESS;  /* CURRENT LOAD ADDRESS */

PERROR: PROCEDURE(A);
    /* PRINT ERROR MESSAGE */
    DECLARE A ADDRESS;
    CALL PRINT(.('ERROR: $'));
    CALL PRINTM(A);
    CALL PRINTM(.(', LOAD ADDRESS $'));
    CALL PRINTADDR(LA);
    CALL BOOT;
    END PERROR;

DECLARE DCNT BYTE;

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;

    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 (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 PERROR(.('DISK READ$'));
                SBUFF(SBP) = EOFILE;
                SBP = LAST(SBUFF);
                END;
            END;
        SBP = 0; RETURN SBUFF(0);
        END GETCHAR;
DECLARE
    STACKPOINTER LITERALLY 'STACKPTR';

 /* INTEL HEX FORMAT LOADER */

RELOC: PROCEDURE;
    DECLARE (RL, CS, RT) BYTE;
    DECLARE
        TA ADDRESS,     /* TEMP ADDRESS */
        SA ADDRESS,     /* START ADDRESS */
        FA ADDRESS,     /* FINAL ADDRESS */
        NB ADDRESS,     /* NUMBER OF BYTES LOADED */

    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
            CALL PERROR(.('INVERTED LOAD ADDRESS$'));
            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 PERROR(.('DISK WRITE$'));
                END;
            END;
        MBUFF(LOW(LA)) = B;
        END SETMEM;

    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;
    CALL BOOT;
    END DIAGNOSE;

    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
            DO; CALL PRINT(.('INVALID HEX DIGIT$'));
            CALL DIAGNOSE;
            END;
        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;


    /* INITIALIZE */
    SA, FA, NB = 0;
    P = 0; /* PARAGRAPH COUNT */
    TA,L = TPA;  /* BASE ADDRESS OF TRANSIENT ROUTINES */
    SBUFF(0) = EOFILE;


    /* 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 = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STACK));
LA = TPA;

SBP = LENGTH(SBUFF);
   /* SET UP THE SOURCE FILE */
    CALL MOVE(FCBA,.SFCB,33);
    CALL MOVE(.('HEX',0),.SFCB(9),4);
    CALL OPEN(.SFCB);
    IF DCNT = 255 THEN CALL PERROR(.('CANNOT OPEN SOURCE$'));

    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 PERROR(.('NO MORE DIRECTORY SPACE$')); ELSE
        DO; CALL RELOC;
        CALL CLOSE(FCBA);
        IF DCNT = 255 THEN CALL PERROR(.('CANNOT CLOSE FILE$'));
        END;
 CALL CRLF;

CALL BOOT;
END LOADCOM;
END;