$CONTROL USLINIT,MAIN=COPY3K,LINES=56 
$COPYRIGHT "91750-18213 REV.2013 800319 "                            ,& 
$     "(C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS "      ,& 
$     "RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, "       ,& 
$     "REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT ",& 
$     "THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY." 
  
BEGIN 
  
    COMMENT   VERSION 2-19-80      D.M.T./DATA SYSTEMS DIVISION 
  
    THIS IS A SLAVE PROGRAM USED TO TRANSFER FILES
    BETWEEN HP 1000 AND HP 3000 COMPUTERS.
       THIS PROGRAM BLOCKS OR DEBLOCKS RECORDS IN 
    TRANSFER BUFFERS AND TRANSLATES I/O CONTROL CODES 
    FROM RTE TO MPE;
  
  
<< THE RECORD LENGTH (BYTES) IS STORED IN RECORD(0) >>
BYTE ARRAY BRECORD(0:769);
INTEGER ARRAY RECORD(*)=BRECORD;
  
INTEGER ARRAY BUFFER(0:4095),      << TRANSMISSION BUFFER >>
              TAG(0:19);           << P-TO-P TAG FIELD >> 
              COMMENT  THE TAG FIELD ELEMENTS HAVE THE FOLLOWING
               MEANINGS-- 
                TAG(0)   MPE FOPTIONS 
                TAG(1)   OPERATION: 2=READ, 3=WRITE 
                TAG(2)   RTE FILE TYPE (USED FOR READ)
                TAG(3)   0 UNTIL END OF FILE
                TAG(4)   0 UNTIL ERROR OCCURS 
                TAG(5)   "UN" IF LAST 8 COLS ARE REMOVED (USED ON READ) 
                TAG(6)   MPE RECSIZE
                TAG(7)   LENGTH OF DATA IN PREAD (WORDS)
                TAG(8)   SPECIFIC ERROR CODE (SEE 4)
                TAG(9)   OLD(0)/NEW(-1) INDICATOR 
                TAG(10)  P-TO-P BUFFER SIZE (MAX BLOCK SIZE)
                TAG(11)  "SP" IF RTE FILE IS SPOOLED, 
                         "CC" FOR CARRIAGE CONTROL
                TAG(12)  RECORD COUNT;
  
INTEGER FUNCTION,     << FUNCTION FROM "GET" >> 
        WRDLEN,       << NUMBER OF WORDS READ >>
        BYTLEN,       << NUMBER OF BYTES READ >>
        TOTLEN,       << TOTAL LENGTH OF TRANSMISSION BUFFER >> 
        ERROR,        << ERROR INDICATOR >> 
        FILENUM,      << MPE FILE NUMBER >> 
        OPERATION,    << OPERATION CODE PASSED IN POPEN TAG FIELD >>
        DISPOSITION,  << DISPOSITION OF MPE FILE UPON CLOSE >>
        CC,           << CONDITION CODE AFTER FOPEN >>
        FILEERROR,    << MPE FILE ERROR CODE >> 
        CONTROL,      << MPE I/O CONTROL WORD >>
        CONWD;        << RTE I/O CONTROL WORD >>
  
LOGICAL DEVTYPE,      << USED IN FGETINFO CALL >> 
        HDADDR,       << USED IN FGETINFO CALL >> 
        COUNT,        << NUMBER OF RECORDS READ/WRITTEN >>
        PRESPC:=%401, << PRESPACING CARRIAGE CNTRL>>
        KILL,         << FALSE UNTIL ERROR OCCURS >>
        UNNUMBERED;   << TRUE IF LAST 8 COLUMNS ARE TO BE REMOVED>> 
  
<< P-TO-P INTRINSICS >> 
INTRINSIC GET,ACCEPT,REJECT,PCHECK; 
  
<< FILE INTRINSICS >> 
INTRINSIC FREAD,FWRITE,FCONTROL,FCHECK,FOPEN,FCLOSE,FGETINFO; 
$PAGE " * * *   C H E C K / R E P O R T   E R R O R S   * * *"
PROCEDURE REPORTMPE;
   BEGIN
   << REPORT MPE FILE ERROR >>
   FCHECK(FILENUM,FILEERROR); 
   KILL := TRUE;
   END;  << OF REPORTMPE >> 
  
  
  
  
  
PROCEDURE CHECKDS;
   BEGIN
   << CHECK FOR ERROR. PASS BACK THESE INDICATORS:
  
      CONDITION          TAG(4)        TAG(8) 
      BAD MASTER CALL      1             0
      DS ERROR             2            PCHECK()
      FILE ERROR           3            FCHECK()   >> 
  
   IF < THEN
      BEGIN 
      TAG(4) := 2;
      TAG(8) := PCHECK(0);
      END 
    ELSE IF FILEERROR <> 0 THEN 
      BEGIN 
      TAG(4) := 3;
      TAG(8) := FILEERROR;
      FILEERROR := 0; 
      END 
    ELSE IF FUNCTION <> OPERATION THEN
      TAG(4) := 1;
   IF TAG(4) <> 0 THEN
      BEGIN 
      KILL := TRUE; 
      REJECT(TAG);
      END 
   END;  << OF CHECKDS >> 
$PAGE " * * *   R E A D D A T A (FROM MPE TO RTE)   * * *"
PROCEDURE READDATA; 
   BEGIN
   << USED WHEN TAG(1) SPECIFIES FILE IS TO BE READ >>
  
   LOGICAL MPEASCII;  << TRUE WHEN MPE ASCII FOPTION BIT SET. >>
   MPEASCII := TAG(0).(13:1) = 1; 
  
   TOTLEN := 0; 
   WHILE TAG(3)>=0  AND  NOT KILL DO
      BEGIN 
      BYTLEN := FREAD(FILENUM,RECORD(1),-768);
      IF = THEN 
         BEGIN  << FILE READ WAS OK >>
         COUNT := COUNT + 1;
         << CHECK FOR ODD # OF BYTES >> 
         IF BYTLEN.(15:1)=1 THEN
            BRECORD(BYTLEN+2) := " "; 
         << IS IT AN ASCII FILE? >> 
         IF TAG(2)=4 OR MPEASCII THEN 
            BEGIN  << GET RID OF TRAILING BLANKS >> 
            IF UNNUMBERED AND BYTLEN>=8 THEN
               BYTLEN := BYTLEN - 8;
            WHILE BRECORD(BYTLEN+1)=" " AND BYTLEN>1 DO 
               BYTLEN := BYTLEN - 1;
            END;
         RECORD(0) := BYTLEN; 
         WRDLEN := (BYTLEN+3)/2; << ADD 1 FOR LENGTH WORD >>
         IF TOTLEN+WRDLEN > TAG(10) THEN
            BEGIN  << TIME TO TRANSFER DATA TO HP 1000 >> 
            FUNCTION := GET(TAG); 
            TAG(12) := COUNT; 
            CHECKDS;
            TAG(7) := TOTLEN; 
            IF NOT KILL THEN ACCEPT(TAG,BUFFER,TOTLEN); 
            TOTLEN := 0;
            END;
         MOVE BUFFER(TOTLEN) := RECORD(0),(WRDLEN); 
         TOTLEN := TOTLEN + WRDLEN; 
         END
       ELSE 
         BEGIN
         IF < THEN
            << FILE ERROR >>
            REPORTMPE 
          ELSE
            BEGIN  << END OF FILE >>
            FUNCTION := GET(TAG); 
            TAG(12) := COUNT; 
            CHECKDS;
            TAG(3) := -1; 
            TAG(7) := TOTLEN; 
            IF NOT KILL THEN ACCEPT(TAG,BUFFER,TOTLEN); 
            END;
         END; 
      END;  << WHILE STATEMENT >> 
   END;  << OF READDATA >>
$PAGE " * * *   W R I T E D A T A   (FROM RTE TO MPE)   * * *"
PROCEDURE WRITEDATA;
   BEGIN
   << USED WHEN TAG(1) SPECIFIES FILE IS TO BE WRITTEN >> 
   INTEGER I; 
   << IF CARRIAGE CONTROL OK, SET FOR PRESPACE
      (SO LINEPRINTER OUTPUT WILL MATCH RTE) >> 
   IF TAG(0).(7:1)=1 THEN 
      FWRITE(FILENUM,PRESPC,0,PRESPC);
   WHILE TAG(3)>=0  AND  NOT KILL DO
      BEGIN 
      FUNCTION := GET(TAG,TOTLEN);
      TAG(12) := COUNT; 
      CHECKDS;
      IF NOT KILL THEN ACCEPT(TAG,BUFFER,TOTLEN); 
      I := 0; 
      WHILE I<TOTLEN AND NOT KILL DO
         BEGIN
         IF TAG(11)="SP" THEN 
            BEGIN  << RTE FILE IS IN SPOOL FORMAT >>
            IF BUFFER(I+1).(10:6) = 2 THEN
               BEGIN  << WRITE REQUEST >> 
               CONWD := BUFFER(I+1);
               IF CONWD.(5:1)=1 THEN
                  CONTROL := %320  << SUPRESS LINE FEED >>
                ELSE IF CONWD.(8:1)=0 THEN
                  BEGIN  << COLUMN 1 IS CARRIAGE CONTROL >> 
                  CONTROL := 1; 
                  IF BUFFER(I+3).(0:8)="*" THEN 
                     BUFFER(I+3).(0:8):="+";
                  END 
                ELSE CONTROL := %40; << SINGLE SPACE >> 
               FWRITE(FILENUM,BUFFER(I+3),BUFFER(I+2),CONTROL); 
               END
             ELSE IF BUFFER(I+1).(4:6) = %11 THEN 
               BEGIN  << SPACING CONTROL >> 
               CONWD := BUFFER(I+2);
               IF CONWD<0  OR  CONWD=63  THEN CONTROL := %300 
                ELSE IF 1<=CONWD<=55 THEN CONTROL := CONWD+%200 
                ELSE IF 56<=CONWD<=61 THEN CONTROL := CONWD + %212
                ELSE IF CONWD=62 THEN CONTROL := %301 
                ELSE IF CONWD=64 THEN CONTROL := %102 
                ELSE IF CONWD=65 THEN CONTROL := %103 
                ELSE IF 66<=CONWD<=69 THEN CONTROL := CONWD + %206
                ELSE CONWD := %40;
               FWRITE(FILENUM,BUFFER,0,CONTROL);
               END; 
            END 
          ELSE  << REGULAR RTE FILE >>
            BEGIN 
            IF TAG(11)="CC" THEN
               BEGIN  << COLUMN 1 IS CARRIAGE CONTROL >>
               CONTROL := 1;
               IF BUFFER(I+1).(0:8)="*" THEN
                  BUFFER(I+1).(0:8):="+"; 
               END
             ELSE CONTROL := %40;  << SINGLE SPACE >> 
            FWRITE(FILENUM,BUFFER(I+1),-BUFFER(I),CONTROL); 
            END;
         IF <> THEN 
            << FILE ERROR >>
            REPORTMPE 
          ELSE  << BUMP RECORD COUNTER >> 
            COUNT := COUNT + 1; 
         << INCREMENT I (LENGTH COUNT). ALLOW FOR ODD BYTE
            AND COUNT WORD. >>
         I := I + (BUFFER(I)+3)/2;
         END;  << OF WHILE >> 
      END;  << OF WHILE >>
   << WRITE EOF >>
   FCONTROL(FILENUM,6,I); 
   END;  << OF WRITEDATA >> 
$PAGE " * * *   M A I N   * * *"
<< BEGINNING OF MAIN PROGRAM >> 
FILEERROR := 0; 
  
DO
   BEGIN << WAIT FOR A POPEN >> 
   KILL := FALSE; 
   OPERATION := 1;    FUNCTION:=GET(TAG);   CHECKDS;
   END
UNTIL KILL=FALSE; 
<< TOO BIG? >>
IF TAG(10) > 4096 THEN TAG(10) := 4096; 
ACCEPT(TAG);
  
<< WE TERMINATE WHEN MASTER SENDS PCLOSE >> 
WHILE TRUE DO 
   BEGIN
   FILEERROR := 0;
  
   DO 
      BEGIN  << WAIT FOR PWRITE. >> 
      KILL := FALSE;
      OPERATION := 3;    FUNCTION:=GET(TAG,TOTLEN);   CHECKDS;
      END 
   UNTIL NOT KILL;
  
  
   << READY TO GO! SET UP TAG FIELDS AND OPEN FILE. >>
   ACCEPT(TAG,BUFFER,TOTLEN); 
   UNNUMBERED := TAG(5) = "UN"; 
   FILENUM := FOPEN(BUFFER,3,4);
   IF < THEN
      BEGIN   << FILE DOES NOT EXIST >> 
      CC := -1; 
      IF TAG(1)= 3 THEN    << WRITE SPECIFIED >>
         BEGIN  << CREATE THE FILE >> 
         FILENUM := FOPEN(BUFFER,TAG(0),1,TAG(6));
         IF < THEN
            REPORTMPE 
          ELSE
            DISPOSITION := %11; 
         END
       ELSE   << READ SPECIFIED, BUT FILE DOES NOT EXIST >> 
         REPORTMPE; 
      END 
    ELSE
      BEGIN   << FILE EXISTS >> 
      CC := DISPOSITION := 0; 
      IF TAG(1)=3 THEN  << OK TO OVERWRITE? >>
         BEGIN
         FGETINFO(FILENUM,,,,,DEVTYPE,,HDADDR); 
         IF HDADDR.(0:8)=0  << SPOOLED DEVICE >>
          OR DEVTYPE.(8:8)>1 THEN << NON-DISC DEVICE >> 
            CC := -1;  << TREAT LIKE NEW FILE >>
         END; 
      END;
  
  
   << WAIT FOR PCONTROL. SEND BACK FILE OPEN INDICATOR >> 
   OPERATION := 4;   FUNCTION := GET(TAG);   CHECKDS; 
   FGETINFO(FILENUM,,TAG(0),,TAG(6)); 
   TAG(9) := CC;
   IF NOT KILL THEN ACCEPT(TAG);
   OPERATION := TAG(1); 
   COUNT := 0;
  
   IF OPERATION=2 THEN READDATA 
    ELSE IF OPERATION=3 THEN WRITEDATA; 
  
   KILL := FALSE; 
   IF FILENUM<>0 THEN 
      BEGIN 
      FCLOSE(FILENUM,DISPOSITION,0);
      IF < THEN 
         REPORTMPE; 
      END;
  
   << MASTER SHOULD SEND PCONTROL >>
   OPERATION := 4;   FUNCTION := GET(TAG);
   TAG(12) := COUNT;  CHECKDS;
   IF NOT KILL THEN ACCEPT(TAG);
  
   END << GO BACK TO "WHILE TRUE" >> ;
  
END.