/*
        CP/M UTILITY TO PRINT TEST STRINGS TO AN OUTPUT DEVICE

        CAN OUTPUT TO DEVICES:
            CONSOLE
            LIST
            PUNCH

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

        1.0 11/01/2007 UDO MUNK		INITIAL VERSION
*/

0FAH: /* ORIGIN OF THIS PROGRAM FOR CP/M */

DECLARE         /* ASCII CONSTANTS */
    CR          LITERALLY '13',         /* CARRIAGE RETURN */
    LF          LITERALLY '10';         /* LINEFEED */

DECLARE         /* BDOS FUNCTIONS */
    BDOS$JUMP   LITERALLY '5',          /* BDOS JUMP VECTOR */
    BDOS$CON    LITERALLY '2',          /* PRINT CONSOLE CHARACTER */
    BDOS$LIST   LITERALLY '5',          /* PRINT LIST CHARACTER */
    BDOS$PUNCH  LITERALLY '4';          /* PRINT PUNCH CHARACTER */

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

    /* TEST STRING TO PRINT */
    DECLARE
        STR DATA ('THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG',CR,LF,0);

    /* USAGE ERROR MESSAGE */
    DECLARE
        ERR DATA ('USAGE: DTEST CONSOLE OR LIST OR PUNCH',CR,LF,0);

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

    /* SET UP STACKPOINTER IN THE LOCAL AREA */
    DECLARE STACKPOINTER LITERALLY 'STACKPTR';
    DECLARE STACK(16) ADDRESS, SP ADDRESS;

    DECLARE (OUT, I) BYTE;

    /* CALL BDOS FUNCTION */
    BDOS: PROCEDURE(FUNC,PARM);
        DECLARE FUNC BYTE; DECLARE PARM ADDRESS;
        GO TO BDOS$JUMP;
    END BDOS;

    /* PRINT 0 TERMINATED STRING VIA BDOS FUNCTION */
    PRTSTR: PROCEDURE(FUNC,STR);
        DECLARE FUNC BYTE; DECLARE STR ADDRESS;
        DECLARE S BASED STR BYTE;
        DECLARE I BYTE;
        I = 0;
        DO WHILE S(I) <> 0;
            CALL BDOS(FUNC,S(I));
            I = I + 1;
        END;
    END PRTSTR;

    /* SAVE STACKPOINTER AND SET TO LOCAL AREA */
    SP = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STACK));

    /* FIND OUTPUT DEVICE */
    IF FCB(1) = 'C' THEN        /* CONSOLE OUTPUT */
        OUT = BDOS$CON;
    ELSE IF FCB(1) = 'L' THEN   /* LIST OUTPUT */
        OUT = BDOS$LIST;
    ELSE IF FCB(1) = 'P' THEN   /* PUNCH OUTPUT */
        OUT = BDOS$PUNCH;
    ELSE DO;                    /* ERROR OUTPUT DEVICE */
        CALL PRTSTR(BDOS$CON,.ERR);
        GO TO DONE;
    END;

    /* WRITE TEST STRING 10 TIMES TO OUPUT DEVICE */
    DO I = 1 TO 10;
        CALL PRTSTR(OUT,.STR);
    END;

    /* RESTORE STACKPOINTER AND RETURN TO CCP */
    DONE:
    STACKPOINTER = SP;
    RETURN 0;
END DTEST;

EOF