seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-24 17:04:19 +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

360
CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/load.plm Normal file
View File

@@ -0,0 +1,360 @@
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;