mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 00:14:25 +00:00
360 lines
8.9 KiB
Plaintext
360 lines
8.9 KiB
Plaintext
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;
|