mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 00:14:25 +00:00
Upload
Digital Research
This commit is contained in:
260
CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/LOAD COM/LOAD.PLM
Normal file
260
CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/LOAD COM/LOAD.PLM
Normal file
@@ -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 */
|
||||
|
||||
@@ -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.
|
||||
Reference in New Issue
Block a user