/*
        CP/M BINARY FILE VIEWER

        THIS PROGRAM WAS WRITTEN FOR THE INTEL PL/M-80 CROSS COMPILER

        1.0 03/11/2007 UDO MUNK		INITIAL VERSION
        1.1 04/06/2007 UDO MUNK		GLOBAL VARIABLE INITIALIZATION
*/

0100H: /* ORIGIN OF THIS PROGRAM FOR CP/M */

DECLARE 	/* ASCII CONSTANTS */
    CR		LITERALLY '13',		/* CARRIAGE RETURN */
    LF		LITERALLY '10',		/* LINEFEED */
    LQ		LITERALLY '113';	/* LOWER CASE Q */

DECLARE		/* BDOS FUNCTIONS */
    BDOS$EXIT	LITERALLY '0',		/* EXIT PROGRAM */
    BDOS$GETC	LITERALLY '1',		/* GET CONSOLE CHARACTER */
    BDOS$PRINT	LITERALLY '2',		/* PRINT CONSOLE CHARACTER */
    BDOS$PRINTS	LITERALLY '9',		/* PRINT CONSOLE STRING */
    BDOS$FOPEN	LITERALLY '15',		/* OPEN FILE */
    BDOS$FREAD	LITERALLY '20';		/* READ FILE */

/* JUST FOR THE FUN OF IT: A DIGITAL RESEARCH LIKE COPYRIGHT */
DECLARE
    COPYRIGHT DATA (' V1.1, COPYRIGHT (C) 2007, UDO MUNK ');

DECLARE		/* DEFAULT FILE CONTROL BLOCK */
    FCB$A	ADDRESS INITIAL(5CH),
    FCB		BASED FCB$A (33) BYTE;

DECLARE		/* DEFAULT BUFFER */
    BUFF$A	ADDRESS INITIAL(80H),
    BUFF	BASED BUFF$A (128) BYTE;

DECLARE		/* SOME MORE GLOBAL VARIABLES */
    ADDR	ADDRESS INITIAL(0),	/* CURRENT ADDRESS */
    ROW		BYTE INITIAL(0),	/* CURRENT DISPLAY ROW */
    I		BYTE,
    C		BYTE;

/* CALL BDOS FUNCTIONS WITHOUT RETURN CODE */
BDOS1: PROCEDURE(FUNC,PARM);
    DECLARE FUNC BYTE;
    DECLARE PARM ADDRESS;
    DECLARE BDOS$JUMP LITERALLY '05H';
    GO TO BDOS$JUMP;
END BDOS1;

/* CALL BDOS FUNCTIONS WITH BYTE RETURN CODE */
BDOS2: PROCEDURE(FUNC,PARM) BYTE;
    DECLARE FUNC BYTE;
    DECLARE PARM ADDRESS;
    DECLARE BDOS$JUMP LITERALLY '05H';
    GO TO BDOS$JUMP;
END BDOS2;

/* PRINT CR AND LF */
CRLF: PROCEDURE;
    CALL BDOS1(BDOS$PRINT,CR);
    CALL BDOS1(BDOS$PRINT,LF);
END CRLF;

/* PRINT A STRING TERMINATED WITH $ CHARACTER */
PRINTS: PROCEDURE(S);
    DECLARE S ADDRESS;
    CALL BDOS1(BDOS$PRINTS,S);
END PRINTS;

/* PRINT HEX 4 BITS */
PRINTNIBBLE: PROCEDURE(X);
    DECLARE X BYTE;
    IF X > 9 THEN
        CALL BDOS1(BDOS$PRINT,X + 'A' - 10);
    ELSE
        CALL BDOS1(BDOS$PRINT,X + '0');
END PRINTNIBBLE;

/* PRINT HEX 8 BITS */
PRINTBYTE: PROCEDURE(X);
    DECLARE X BYTE;
    CALL PRINTNIBBLE(SHR(X,4));
    CALL PRINTNIBBLE(X AND 0FH);
END PRINTBYTE;

/* PRINT HEX 16 BITS */
PRINTADDR: PROCEDURE(X);
    DECLARE X ADDRESS;
    CALL PRINTBYTE(HIGH(X));
    CALL PRINTBYTE(LOW(X));
END PRINTADDR;

/* WAIT UNTIL USER ENTERS CHARACTER */
WAIT: PROCEDURE BYTE;
    DECLARE C BYTE;
    CALL PRINTS(.('---- HIT RETURN TO CONTINUE, Q TO QUIT ----: $'));
    C = BDOS2(BDOS$GETC,0);
    CALL CRLF;
    RETURN C;
END WAIT;

/* DUMP ONE LINE OF DATA FROM BUFFER */
DUMPLINE: PROCEDURE(N) BYTE;
    DECLARE N BYTE;
    DECLARE (I,C) BYTE;
    CALL PRINTADDR(ADDR);
    CALL BDOS1(BDOS$PRINT,':');
    CALL BDOS1(BDOS$PRINT,' ');
    DO I = 0 TO 15;
        CALL PRINTBYTE(BUFF(N + I));
        CALL BDOS1(BDOS$PRINT,' ');
    END;
    DO I = 0 TO 15;
        C = BUFF(N + I);
        IF C >= 20H AND C < 80H THEN
            CALL BDOS1(BDOS$PRINT,C);
        ELSE
            CALL BDOS1(BDOS$PRINT,'.');
    END;
    CALL CRLF;
    ROW = ROW + 1;
    ADDR = ADDR + 16;
    IF ROW > 20 THEN DO;
        IF WAIT = LQ THEN RETURN 1;
        ROW = 0;
    END;
    RETURN 0;
END DUMPLINE;

/* OPEN FILE AND DUMP CONTENTS UNTIL EOF */
IF (BDOS2(BDOS$FOPEN,FCB$A) = 255) THEN
    CALL PRINTS(.('FILE NOT FOUND$'));
ELSE DO;
    DO WHILE BDOS2(BDOS$FREAD,FCB$A) = 0;
        DO I = 0 TO 7;
            IF (C := DUMPLINE(I * 16)) <> 0 THEN GO TO DONE;
        END;
    END;
DONE:
END;

CALL BDOS1(BDOS$EXIT,0); /* DONE, TERMINATE PROGRAM */

EOF