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 */