/*SPLH*/ /*$TITLE='PERIPHERAL INTERCHANGE PROGRAM' */
PIPMOD:
    DO;
/* P E R I P H E R A L  I N T E R C H A N G E  P R O G R A M
 
         COPYRIGHT (C) 1976, 1977, 1978, 1979, 1980, 1981
         DIGITAL RESEARCH
         BOX 579
         PACIFIC GROVE, CA
         93950
 
         REVISED:
            17 JAN 80  BY  THOMAS ROLANDER (MP/M 1.1)
            05 OCT 81  BY  RAY PEDRIZETTI  (MP/M-86 2.0)
            18 DEC 81  BY  RAY PEDRIZETTI  (CP/M-86 1.1)
            31 JULY 82 BY  H.CHAKI (CP/M-68K)           */
 
/*    COMMAND LINES USED FOR .68K FILE GENERATION   */
 /*  Command line to generate PIP.68K
 
 [[ assume that the all default VOLUME is SYS:0.. on EXORmacs]]
 
 (1)S-PL/H Compile and ASM on EXORmacs
    =SPLH PIP,,;A,S,X,NOV,NOF,MAR=1/80
    =ASM PIPSUB,,;A,S,X,NOV,NOF,MAR=1/80
    =ASM UT68K,,;
    [[ caution ]]
     PIP: main routine of PIP utility in S-PL/H
     PIPSUB: sub routine of PIP utility in ASM
     UT68K: standard interface routine in ASM
     A: assemble listing option
     S: symbol listing option
     X: xref listing option
     NOV: non save option
     NOF: non floatable option
     MAR: margin option [[ important ]]
 
  (2)LINK on EXORmacs
     =LINK PIP/PIPSUB/UT68K,PIP68K,PIP68K;MIXRL=SPLHLIB.RO
     [[ caution ]]
     R option: generate relocatable object
 
  (3)XLINK on EXORmacs
     =XLINK PIP68K.RO,PIP68K.OX,O=PIP68K.OL
 
  (4)Convert file on EXORmacs to send to VAX
     =CONV PIP68K.OX,PIP68K.OC
 
  (5)Send to VAX from EXORMACS
     =VAX
     VAX command
     S
     Source file
     PIP68K.OC
 
  (6)Download to CP/M file from VAX
 
  (7)Re-convert file on CP/M
    A>RECONV
      input file :PIP68K.OC
      output file :PIP.68K
 
 
 end command line                 */
 
DECLARE
    VERSION  LITERALLY '0022H', /* REQUIRED FOR OPERATION */
    MVERSION LITERALLY '1130H'; /* FOR MP/M-86 OPERATION */
 
DECLARE
    MAXB  POINTER EXTERNAL,     /* ADDR FIELD OF JMP BDOS */
/*68K*/ MAXBL LONG AT(@MAXB),
    FCB (33) BYTE EXTERNAL,     /* DEFAULT FILE CONTROL BLOCK */
    BUFF(128)BYTE EXTERNAL;     /* DEFAULT BUFFER */
 
DECLARE
    ENDFILE LITERALLY '1AH';    /* END OF FILE MARK */
 
DECLARE      /* MAIN PROGRAM ENTRY LABEL */
    PLM LABEL PUBLIC;
 
DECLARE COPYRIGHT(*) BYTE DATA (
      ' (7/31/82) CP/M-68K PIP VERS 1.0 ');
 
 
    /* LITERAL DECLARATIONS */
DECLARE
/*SPLH*/ /* LIT  LITERALLY 'LITERALLY',   */
    LPP  LIT '60',     /* LINES PER PAGE */
    TAB  LIT '09H',    /* HORIZONTAL TAB */
    FF   LIT '0CH',    /* FORM FEED */
    LA   LIT '05FH',   /* LEFT ARROW */
    LB   LIT '05BH',   /* LEFT BRACKET */
    RB   LIT '05DH',   /* RIGHT BRACKET */
 
    FSIZE  LIT '33',
    FRSIZE LIT '36',   /* SIZE OF RANDOM FCB */
    NSIZE  LIT '8',
    FNSIZE LIT '11',
    FEXT   LIT '9',
    FEXTL  LIT '3',
 
        /* SCANNER RETURN TYPE CODE */
    OUTT     LIT '0',   /* OUTPUT DEVICE */
    PRNT     LIT '1',   /* PRINTER */
    LSTT     LIT '2',   /* LIST DEVICE */
    AXOT     LIT '3',   /* AUXILARY OUTPUT DEVICE */
    FILE     LIT '4',   /* FILE TYPE */
    CONS     LIT '5',   /* CONSOLE */
    AXIT     LIT '6',   /* AUXILARY INPUT DEVICE */
    INPT     LIT '7',   /* INPUT DEVICE */
    NULT     LIT '8',   /* NUL CHARACTERS */
    EOFT     LIT '9',   /* EOF CHARACTER */
    ERR      LIT '10',  /* ERROR TYPE */
    SPECL    LIT '11',  /* SPECIAL CHARACTER */
    DISKNAME LIT '12';  /* DISKNAME LETTER */
 
DECLARE
    SEARFCB LITERALLY 'FCB';   /* SEARCH FCB IN MULTI COPY */
 
DECLARE
    TRUE    LITERALLY '1',
    FALSE   LITERALLY '0',
    FOREVER LITERALLY 'WHILE TRUE',
    CR      LITERALLY '13',
    LF      LITERALLY '10',
    WHAT    LITERALLY '63';
 
DECLARE
    COLUMN   BYTE,      /* COLUMN COUNT FOR PRINTER TABS */
    LINENO   BYTE,      /* LINE WITHIN PAGE */
    FEEDBASE BYTE,      /* USED TO FEED SEARCH CHARACTERS */
    FEEDLEN  BYTE,      /* LENGTH OF FEED STRING */
    MATCHLEN BYTE,      /* USED IN MATCHING STRINGS */
    QUITLEN  BYTE,      /* USED TO TERMINATE QUIT COMMAND */
    CDISK    BYTE,      /* CURRENT DISK */
    SBLEN    ADDRESS,   /* SOURCE BUFFER LENGTH */
    DBLEN    ADDRESS,   /* DEST BUFFER LENGTH */
    TBLEN    ADDRESS,   /* TEMP BUFFER LENGTH */
    SBASE    POINTER,   /* SOURCE BUFFER BASE */
/*68K*/ SBASEL LONG AT(@SBASE),
/*SPLH*/  MEMORY (1024) BYTE EXT,
/*SPLH*/  DCHAKIP POINTER,
          DCHAKIL LONG AT(@DCHAKIP),
    /* THE VECTORS DBUFF AND SBUFF ARE DECLARED WITH DIMENSION
    1024, BUT ACTUALLY VARY WITH THE FREE MEMORY SIZE */
    DBUFF(1024) BYTE AT (@MEMORY), /* DESTINATION BUFFER */
    SBUFF BASED SBASE (1024) BYTE, /* SOURCE BUFFER */
 
        /* SOURCE FCB, PASSWORD AND PASSWORD MODE */
    SOURCE STRUCTURE (
        FCB(FRSIZE)  BYTE,
        USER         BYTE,
        TYPE         BYTE ),
 
        /* TEMPORARY DESTINATION FCB, PASSWORD AND PASSWORD MODE */
    DEST STRUCTURE (
        FCB(FRSIZE)  BYTE,
        USER         BYTE,
        TYPE         BYTE ),
 
        /* ORIGINAL DESTINATION FCB, PASSWORD AND PASSWORD MODE */
    ODEST STRUCTURE (
        FCB(FRSIZE)  BYTE,
        USER         BYTE,
        TYPE         BYTE ),
 
    FILSIZE(3) BYTE,  /* FILE SIZE RANDOM RECORD NUMBER */
 
    DESTR    ADDRESS AT(@DEST.FCB(34)),    /* RANDOM RECORD POSITION */
    SOURCER  ADDRESS AT(@SOURCE.FCB(34)),  /* RANDOM RECORD POSITION */
    DESTR2   BYTE    AT(@DEST.FCB(33)),    /* RANDOM RECORD POSITION R2 */
    SOURCER2 BYTE    AT(@SOURCE.FCB(33)),  /* RANDOM RECORD POSITION R2 */
 
    EXTSAVE  BYTE,      /* TEMP EXTENT BYTE FOR BDOS BUG */
 
    NSBUF   ADDRESS,    /* NEXT SOURCE BUFFER */ 
    NSOURCE ADDRESS,    /* NEXT SOURCE CHARACTER */
    NDEST   ADDRESS;    /* NEXT DESTINATION CHARACTER */
 
DECLARE
    FASTCOPY BYTE,      /* TRUE IF COPY DIRECTLY TO DBUF */
    DBLBUF   BYTE,      /* TRUE IF BOTH SOURCE AND DEST BUFFER USED */
    CONCAT   BYTE,      /* TRUE IF CONCATINATION COMMAND */
    AMBIG    BYTE,      /* TRUE IF FILE IS AMBIG TYPE */
    DFILE    BYTE,      /* TRUE IF DEST IS FILE TYPE */
    SFILE    BYTE,      /* TRUE IF SOURCE IS FILE TYPE */
    MADE     BYTE,      /* TRUE IF FILE ALREADY MADE */
    ENDOFSRC BYTE,      /* TRUE IF END OF SOURCE FILE */
    NENDCMD  BYTE,      /* TRUE IF NOT END OF COMMAND TAIL */
    INSPARC  BYTE,      /* TRUE IF IN MIDDLE OF SPARCE FILE */
    SPARFIL  BYTE,      /* TRUE IF SPARCE FILE BEING COPIED */
    MULTCOM  BYTE,      /* FALSE IF PROCESSING ONE LINE */
    PUTNUM   BYTE,      /* SET WHEN READY FOR NEXT LINE NUM */
    CONCNT   BYTE,      /* COUNTER FOR CONSOLE READY CHECK */
    CHAR     BYTE,      /* LAST CHARACTER SCANNED */
    FLEN     BYTE;      /* FILE NAME LENGTH */
 
DECLARE
    F1     BYTE,        /* F1 USER ATTRIBUTE FLAG */
    F2     BYTE,        /* F2 USER ATTRIBUTE FLAG */
    F3     BYTE,        /* F3 USER ATTRIBUTE FLAG */
    F4     BYTE,        /* F4 USER ATTRIBUTE FLAG */
    RO     BYTE,        /* READ ONLY ATTRIBUTE FLAG */
    SYS    BYTE,        /* SYSTEM ATTRIBUTE FLAG */
    DCNT   BYTE;        /* ERROR CODE OR DIRECTORY CODE */
 
DECLARE CBUFF(130) BYTE,   /* COMMAND BUFFER */
    MAXLEN       BYTE AT (@CBUFF(0)),  /* MAX BUFFER LENGTH */
    COMLEN       BYTE AT (@CBUFF(1)),  /* CURRENT LENGTH */
    COMBUFF(128) BYTE AT (@CBUFF(2));  /* COMMAND BUFFER CONTENTS */
 
DECLARE
    CBP  BYTE;   /* COMMAND BUFFER POINTER */
 
DECLARE
    CUSER BYTE; /* CURRENT USER NUMBER */
 
DECLARE
   LAST$USER BYTE;
 
DECLARE /* CONTROL TOGGLE VECTOR */
    CONT(26) BYTE,   /* ONE FOR EACH ALPHABETIC */
    /* 00 01 02 03 04 05 06 07 08 09 10 11 12 13
        A  B  C  D  E  F  G  H  I  J  K  L  M  N
       14 15 16 17 18 19 20 21 22 23 24 25
        O  P  Q  R  S  T  U  V  W  X  Y  Z   */
    ARCHIV BYTE  AT(@CONT(0)),     /* FILE ARCHIVE */
    DELET  BYTE  AT(@CONT(3)),     /* DELETE CHARACTERS */
    ECHO   BYTE  AT(@CONT(4)),     /* ECHO CONSOLE CHARACTERS */
    FORMF  BYTE  AT(@CONT(5)),     /* FORM FILTER */
    GETU   BYTE  AT(@CONT(6)),     /* GET FILE, USER # */
    HEXT   BYTE  AT(@CONT(7)),     /* HEX FILE TRANSFER */
    IGNOR  BYTE  AT(@CONT(8)),     /* IGNORE :00 RECORD ON FILE */
    KILDS  BYTE  AT(@CONT(10)),    /* KILL FILENAME DISPLAY */
    LOWER  BYTE  AT(@CONT(11)),    /* TRANSLATE TO LOWER CASE */
    NUMB   BYTE  AT(@CONT(13)),    /* NUMBER OUTPUT LINES */
    OBJ    BYTE  AT(@CONT(14)),    /* OBJECT FILE TRANSFER */
    PAGCNT BYTE  AT(@CONT(15)),    /* PAGE LENGTH */
    QUITS  BYTE  AT(@CONT(16)),    /* QUIT COPY */
    RSYS   BYTE  AT(@CONT(17)),    /* READ SYSTEM FILES */
    STARTS BYTE  AT(@CONT(18)),    /* START COPY */
    TABS   BYTE  AT(@CONT(19)),    /* TAB SET */
    UPPER  BYTE  AT(@CONT(20)),    /* UPPER CASE TRANSLATE */
    VERIF  BYTE  AT(@CONT(21)),    /* VERIFY EQUAL FILES ONLY */
    WRROF  BYTE  AT(@CONT(22)),    /* WRITE TO R/O FILE */
    ZEROP  BYTE  AT(@CONT(25));    /* ZERO PARITY ON INPUT */
 
DECLARE ZEROSUP BYTE,  /* ZERO SUPPRESSION */
    (C3,C2,C1) BYTE;     /* LINE COUNT ON PRINTER  */
 
 DCL DUMMYP POINTER,
     DUMMYL LONG AT(@DUMMYP);
 DCL DUM1P POINTER,
     DUM1L LONG AT(@DUM1P);
 DCL DUM2P POINTER,
     DUM2L LONG AT(@DUM2P);
   
OUTD: PROCEDURE(B) EXTERNAL;
    DECLARE B BYTE;
    /* SEND B TO OUT: DEVICE */
    END OUTD;
 
INPD: PROCEDURE BYTE EXTERNAL;
    END INPD;
 
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;
 
MON3: PROCEDURE(F,A) ADDRESS EXTERNAL;
    DECLARE F BYTE,
    A ADDRESS;
    END MON3;
/* 68K*/
 MON5: PROC(F,A) EXT;
         DCL F BYTE,A POINTER;
 END;
 MON6: PROC(F,A) BYTE EXT;
         DCL F BYTE,A POINTER;
 END;
 MON7: PROC(F,A) ADDR EXT;
         DCL F BYTE,A POINTER;
 END;
 
BOOT: PROCEDURE;
    /* SYSTEM REBOOT */
    CALL MON1(0,0);
    END BOOT;
 
 
RDCHAR: PROCEDURE BYTE;
    /* READ CONSOLE CHARACTER */
    RETURN MON2(1,0);
    END RDCHAR;
 
PRINTCHAR: PROCEDURE(CHAR);
    DECLARE CHAR BYTE;
    CALL MON1(2,CHAR AND 7FH);
    END PRINTCHAR;
 
CRLF: PROCEDURE;
    CALL PRINTCHAR(CR);
    CALL PRINTCHAR(LF);
    END CRLF;
 
PRINTX: PROCEDURE(A);
    DECLARE A POINTER;
    CALL MON5(9,A);
    END PRINTX;
 
PRINT: PROCEDURE(A);
    DECLARE A POINTER;
    /* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
    NEXT DOLLAR SIGN IS ENCOUNTERED */
    CALL CRLF;
    CALL PRINTX(A);
    END PRINT;
 
RDCOM: PROCEDURE;
    /* READ INTO COMMAND BUFFER */
    MAXLEN = 128;
    CALL MON5(10,@MAXLEN);
    END RDCOM;
 
CONBRK: PROCEDURE BYTE;
    /* CHECK CONSOLE CHARACTER READY */
    RETURN MON2(11,0);
    END CONBRK;
 
CVERSION: PROCEDURE ADDRESS;
    RETURN MON3(12,0); /* VERSION NUMBER */
    END CVERSION;
 
SETDMA: PROCEDURE(A);
    DECLARE A POINTER;
    CALL MON5(26,A);
    END SETDMA;
 
OPEN: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    DCNT = MON6(15,FCB);
    END OPEN;
 
CLOSE: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    DCNT = MON6(16,FCB);
    END CLOSE;
 
CK$USER: PROCEDURE;
    DO FOREVER;
        IF DCNT = 0FFH THEN RETURN;
        IF LAST$USER = BUFF(ROR (DCNT,3) AND 110$0000B)
            THEN RETURN;
        DCNT = MON2(18,0);
    END;
    END CK$USER;
 
SEARCH: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    DCNT = MON6(17,FCB);
    CALL CK$USER;
    END SEARCH;
 
SEARCHN: PROCEDURE;
    DCNT = MON2(18,0);
    CALL CK$USER;
    END SEARCHN;
 
DELETE: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    CALL MON5(19,FCB);
    END DELETE;
 
DISKRD: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    DCNT = MON6(20,FCB);
    END DISKRD;
 
DISKWRITE: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    DCNT = MON6(21,FCB);
    END DISKWRITE;
 
MAKE: PROCEDURE(FCBA);
    DECLARE FCBA POINTER;
    DCNT = MON6(22,FCBA);
    END MAKE;
 
RENAME: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    DCNT = MON6(23,FCB);
    END RENAME;
 
GETDISK: PROCEDURE BYTE;
    RETURN MON2(25,0);
    END GETDISK;
 
SETIND: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    DCNT = MON6(30,FCB);
    END SETIND;
 
GETUSER: PROCEDURE BYTE;
    RETURN MON2(32,0FFH);
    END GETUSER;
 
SETUSER: PROCEDURE(USER);
    DECLARE USER BYTE;
    CALL MON1(32,(LAST$USER:=USER));
    END SETUSER;
 
SETCUSER: PROCEDURE;
    CALL SETUSER(CUSER);
    END SETCUSER;
 
SETDUSER: PROCEDURE;
    CALL SETUSER(ODEST.USER);
    END SETDUSER;
 
SETSUSER: PROCEDURE;
    CALL SETUSER(SOURCE.USER);
    END SETSUSER;
 
RD$RANDOM: PROCEDURE(FCB) BYTE;
    DECLARE FCB POINTER;
    RETURN MON6(33,FCB);
    END RD$RANDOM;
 
WRITE$RANDOM: PROCEDURE(FCB) BYTE;
    DECLARE FCB POINTER;
    RETURN MON6(34,FCB);
    END WRITE$RANDOM;
 
RETFSIZE: PROCEDURE(FCB) BYTE;
    DECLARE FCB POINTER;
    RETURN MON6(35,FCB);
    END RETFSIZE;
 
SET$RANDOM: PROCEDURE(FCB);
    DECLARE FCB POINTER;
    /* SET RANDOM RECORD POSITION */
    CALL MON5(36,FCB);
    END SET$RANDOM;
 
 
MOVE: PROCEDURE(S,D,N);
    DECLARE (S,D) POINTER, N BYTE;
    DECLARE A BASED DUM1P BYTE, B BASED DUM2P BYTE;
/*68K*/ DUM1P=S; DUM2P=D;
        DO WHILE (N:=N-1) <> 255;
/*68K*/ B = A; DUM1L=DUM1L+1; DUM2L=DUM2L+1;
        END;
    END MOVE;
 
ERROR: PROCEDURE(ERRTYPE,FILEADR);
    DECLARE I BYTE,
        TEMP BYTE,
        ERRTYPE BYTE,
        FILEADR POINTER,
        FCB BASED FILEADR (FSIZE) BYTE;
 
    /* ERRTYPE ERROR MESSAGES */
    DECLARE ER00(*) BYTE DATA ('DISK READ$');
    DECLARE ER01(*) BYTE DATA ('DISK WRITE$');
    DECLARE ER02(*) BYTE DATA ('VERIFY$');
    DECLARE ER03(*) BYTE DATA ('INVALID DESTINATION$');
    DECLARE ER04(*) BYTE DATA ('INVALID SOURCE$');
    DECLARE ER05(*) BYTE DATA ('USER ABORTED$');
    DECLARE ER06(*) BYTE DATA ('BAD PARAMETER$');
    DECLARE ER07(*) BYTE DATA ('INVALID USER NUMBER$');
    DECLARE ER08(*) BYTE DATA ('INVALID FORMAT$');
    DECLARE ER09(*) BYTE DATA ('HEX RECORD CHECKSUM$');
    DECLARE ER10(*) BYTE DATA ('FILE NOT FOUND$');
    DECLARE ER11(*) BYTE DATA ('START NOT FOUND$');
    DECLARE ER12(*) BYTE DATA ('QUIT NOT FOUND$');
    DECLARE ER13(*) BYTE DATA ('INVALID HEX DIGIT$');
    DECLARE ER14(*) BYTE DATA ('CLOSE FILE$');
    DECLARE ER15(*) BYTE DATA ('UNEXPECTED END OF HEX FILE$');
    DECLARE ER16(*) BYTE DATA ('INVALID SEPARATOR$');
    DECLARE ER17(*) BYTE DATA ('NO DIRECTORY SPACE$');
    DECLARE ER18(*) BYTE DATA ('INVALID FORMAT WITH SPARSE FILE$');
 
    DECLARE ERRMSG(*) POINTER DATA(
        @ER00,@ER01,@ER02,@ER03,@ER04,
        @ER05,@ER06,@ER07,@ER08,@ER09,
        @ER10,@ER11,@ER12,@ER13,@ER14,
        @ER15,@ER16,@ER17,@ER18);
 
    CALL SETDUSER;
    IF MADE THEN
        DO; CALL CLOSE(@DEST);
        CALL DELETE(@DEST);  /* DELETE DESTINATION SCRATCH FILE */
        END;
 
    /* PRINT OUT ERROR MESSAGE */
    CALL PRINT(@('ERROR: $'));
    CALL PRINTX(ERRMSG(ERRTYPE));
    CALL PRINTX(@(' - $'));
    IF FILEADR <> 0 THEN
        DO; CALL PRINTCHAR('A' + FCB(0) - 1);
        CALL PRINTCHAR(':');
            DO I = 1 TO FNSIZE;
            IF (TEMP := FCB(I) AND 07FH) <> ' ' THEN
                DO; IF I = FEXT THEN CALL PRINTCHAR('.');
                CALL PRINTCHAR(TEMP);
                END;
            END;
        END;
 
    /* ZERO THE COMLEN IN CASE THIS IS A SINGLE COMMAND */
    COMLEN = 0;
    CALL CRLF;
    GO TO RETRY;
    END ERROR;
 
FORMERR: PROCEDURE;
    CALL ERROR(8,0);  /* INVALID FORMAT */
    END FORMERR;
 
MAXSIZE: PROCEDURE BYTE;
    IF (SOURCE.FCB(35) = FILSIZE(2)) AND
       (SOURCE.FCB(34) = FILSIZE(1)) AND
       (SOURCE.FCB(33) = FILSIZE(0)) THEN RETURN TRUE;
    RETURN FALSE;
    END MAXSIZE;
 
SETUPDEST: PROCEDURE;
    CALL SETDUSER;  /* DESTINATION USER */
    CALL MOVE(@ODEST,@DEST,(FRSIZE + 1));  /* SAVE ORIGINAL DEST */
    /* MOVE THREE CHARACTER EXTENT INTO DEST FCB */
    CALL MOVE(@('$$$'),@DEST.FCB(FEXT),FEXTL);
    CALL DELETE(@DEST); /* REMOVE OLD $$