HSTCOPY 
(*$L'HOSTCOPY UTILITY.',S-,U+ *)
(*$V+ DISPLAY CM RECORD MAP. *) 
(*$E+ USE EXTERNAL ENTRY POINTS. *) 
PROGRAM HSTCOPY(INPUT,OUTPUT,FTS);
(***
 *  HSTCOPY - HOSTCOPY UTILITY. 
 *
 *    L. M. BURGHER/S. V. PRESTON      84/09/22.
 *    S. V. PRESTON                    86/03/14.
 *      MODIFIED TO SUPPORT V10 SST FORMAT. 
 *
 *  OVERVIEW
 *
 *    HSTCOPY READS A FILE AND TRANSFERS IT TO A 5870 OR 5970 
 *    NON-IMPACT PRINTER.  HSTCOPY CALLS THE PP PROGRAM XHC TO
 *    TRANSFER THE DATA TO THE NON-IMPACT PRINTER.
 *
 *    HSTCOPY READS THE FOLLOWING TYPES OF FILES: 
 *
 *      1) RECORDS CONSISTING OF MULTIPLES OF 128 8-BIT BYTES,
 *         WITHOUT ZERO-BYTE TERMINATORS, UP TO A MAXIMUM 
 *         OF 8192 8-BIT BYTES. 
 *
 *      2) 80-BYTE EBCDIC CARD IMAGE RECORDS WITHOUT ZERO-BYTE
 *         TERMINATORS. 
 *
 *  CONTROL STATEMENT CALL
 *
 *    HSTCOPY(INPUT,OUTPUT,FTS) 
 *
 *      HSTCOPY           - HOSTCOPY CONTROL STATEMENT. 
 *      INPUT             - INPUT FILE CONTAINING INPUT DIRECTIVES. 
 *      OUTPUT            - OUTPUT FILE CONTAINING STATUS OF HOSTCOPY.
 *      FTS               - INPUT FILE TO TRANSFER TO NIP.
 *) 
  
CONST 
  
(* DEFINE BUFFER LENGTHS. *)
  
  CML      = 1093;                     (* NUMBER OF CM WORDS *) 
  CMLS     = 69;
  BIT4L    = 16384;                    (* NUMBER OF BIT4S *)
  RECL     = 64;                       (* NUMBER OF 128-BYTE RECS *)
  
(* DEFINE RECORD LENGTH. *) 
  
  RECRDL   = 256;                      (* NUMBER OF BIT4S PER RECRD *)
  RECRDPL  = 2;                        (* NUM OF RECRD POINTERS *)
  
TYPE
  
(*$T- TURN RUNTIME TESTING OFF. *)
  PCNTRL  = ^CONTROL;                  (* CONTROL RECORD POINTER *) 
  PRECRD  = ^RECRD;                    (* DATA RECORD POINTER *)
(*$T= RESTORE RUNTIME TESTING. *) 
  
(* DEFINE BIT FIELD WIDTHS. *)
  
  BIT1  = 0..1B;
  BIT3  = 0..7B;
  BIT4  = 0..17B; 
  BIT6  = 0..77B; 
  BIT9  = 0..777B;
  BIT11 = 0..3777B; 
  BIT12 = 0..7777B; 
  BIT42 = 0..77777777777777B; 
  
(* DEFINE PACKED CHARACTER STRINGS. *)
  
  CHAR3  = PACKED ARRAY[1..3]  OF CHAR; 
  CHAR10 = PACKED ARRAY[1..10] OF CHAR; 
  CHAR40 = PACKED ARRAY[1..40] OF CHAR; 
  
  BUFTAG = 1..2;
  BUFFER = RECORD CASE TAG : BUFTAG OF
             1 : (W  : ARRAY[1..CML] OF INTEGER); 
             2 : (B4 : PACKED ARRAY[1..BIT4L] OF BIT4); 
             END;  (* BUFFER *) 
  
  RECRD = PACKED ARRAY[1..RECRDL] OF BIT4;
                                       (* DATA RECORD *)
  
  CONTROL = PACKED RECORD              (* XHC CONTROL TABLE *)
    FILL1   : BIT3; 
    EQ      : BIT9;                    (* EST ORDINAL *)
    FILL2   : BIT11;
    TERM    : BOOLEAN;                 (* TERMINATE XHC *)
    FILL3   : BIT11;
    CARDIMG : BOOLEAN;                 (* CARD IMAGE *) 
    FILL4   : BIT11;
    COMP    : BOOLEAN;                 (* REQUEST COMPLETE *) 
    FILL5   : BIT42;
    RESV1   : BIT1; 
    RECRDP  : PRECRD;                  (* RECRD POINTER *)
    END;  (* CONTROL *) 
  
  SYSREQ = PACKED RECORD
                                       (* SYSTEM REQUEST FORMAT *)
             PPNAME : CHAR3;           (* PP PROGRAM NAME *)
             RESV1  : BIT1; 
             RECALL : BOOLEAN;         (* RECALL OPTION *)
             FILL1  : BIT4; 
             FILL2  : BIT12;
             FILL3  : BIT6; 
             RESV2  : BIT1;            (* CONTROL POINTER *)
             CNTRLP : PCNTRL; 
             END;  (* SYSREQ *) 
  
VAR 
  
  CNTRLP         : PCNTRL;             (* XHC CONTROL POINTER *)
  INITOK         : BOOLEAN;            (* INITIALIZE OK *)
  RCL, XHC       : SYSREQ;             (* SYSTEM REQUEST *) 
  FTS            : SEGMENTED FILE OF INTEGER; 
                                       (* SYSTEM SOFTWARE FILE *) 
  
(* DEFINE DAYFILE MESSAGE VARIABLES. *) 
  
  EFMSG : CHAR40;                      (* EMPTY FILE *) 
  EQMSG : CHAR40;                      (* INCORRECT EQUIPMENT *)
  LDMSG : CHAR40;                      (* EQUIPMENT LOADED *) 
  
(* DEFINE BUFFER VARIABLES. *)
  
  BUFF           : BUFFER;             (* DATA BUFFER *)
  CMI            : 0..CML;             (* CM INDEX *) 
  BIT4I          : 0..BIT4L;           (* BIT4 INDEX *) 
  RECI           : 0..RECL;            (* RECRD INDEX *)
  RECNUM         : 1..RECL;            (* NUM RECRDS PER BUFFER *)
  
(* DEFINE RECORD VARIABLES. *)
  
  RECRDP         : ARRAY[1..RECRDPL] OF PRECRD; 
                                       (* DATA RECORD POINTERS *) 
  RECRDPI        : 1..RECRDPL;         (* RECORD POINTER INDEX *) 
  RECRDI         : 0..RECRDL;          (* RECORD INDEX *) 
  
VALUE 
  
  INITOK = FALSE; 
  RCL    = ('RCL', 0, TRUE,  0, 0, 0, 0, NIL);
  XHC    = ('XHC', 0, FALSE, 0, 0, 0, 0, NIL);
  
(* DAYFILE MESSAGES. *) 
  
  EFMSG = ' SYSTEM SOFTWARE FILE EMPTY.            '; 
  EQMSG = ' EQXXX, INCORRECT EQUIPMENT NUMBER.     '; 
  LDMSG = ' EQXXX, HOSTCOPY TRANSFER COMPLETE.     '; 
(*$L'EXTERNAL FUNCTIONS AND PROCEDURES.'*)
FUNCTION XDXB(    STR : CHAR10; TYP : INTEGER;
              VAR NUM : INTEGER) : INTEGER; FORTRAN;
(** 
 *  CHARACTER TO INTEGER CONVERSION.
 *
 *  LOADED FROM SRVLIB. 
 *) 
  
PROCEDURE SYS(VAR REQ : SYSREQ); EXTERN;
(** 
 *  ISSUE SYSTEM REQUEST. 
 *
 *  LOADED FROM UTILLIB.
 *) 
(*$L'INIT - INITIALIZE.'*)
PROCEDURE INIT; 
(** 
 *
 *  INITIALIZE HOST COPY. 
 *
 *  EXIT
 *    INITOK = TRUE, IF INITIALIZED PROPERLY. 
 *    THE PP XHC HAS BEEN STARTED.
 *    LDMSG HAS BEEN SET WITH EQUIPMENT NUMBER. 
 *
 *  CALLS 
 *    SYS, XDXB.
 *
 *  NESTED FROM HSTCOPY.
 *) 
  
VAR 
  
  CARDIMG : ALFA;                      (* CARD IMAGE *) 
  EQ      : ALFA;                      (* EST ORDINAL *)
  I, J    : INTEGER;
  VALIDEQ : INTEGER;                   (* VALID EQUIPMENT *)
  
  BEGIN  (* INIT *) 
  RESET(FTS);                          (* INITIALIZE FTS FILE *)
  IF NOT EOS(FTS) THEN
    BEGIN                              (* FILE OK *)
    EQ := '          ';                (* EQ NUMBER *)
    FOR I := 1 TO 3 DO
      READ(EQ[I]);
    READLN; 
    READLN(CARDIMG[1]);                (* CARD IMAGE *) 
    VALIDEQ := XDXB(EQ, 0, I);         (* CONVERT EQ TO INTEGER *)
    IF (VALIDEQ = 0) AND (I <= 777B) THEN 
      BEGIN                            (* VALID EQ *) 
      NEW(CNTRLP);                     (* INITIALIZE POINTERS *)
      FOR J := 1 TO RECRDPL DO
        BEGIN 
        RECRDPI := J; 
        NEW(RECRDP[RECRDPI]); 
        END;
      CNTRLP^.EQ := I;                 (* SETUP XHC CONTROL RECORD *) 
      CNTRLP^.TERM := FALSE;
      IF CARDIMG[1] = 'T' THEN
        CNTRLP^.CARDIMG := TRUE 
      ELSE
        CNTRLP^.CARDIMG := FALSE; 
      CNTRLP^.COMP := FALSE;
      CNTRLP^.RECRDP := NIL;
      XHC.CNTRLP := CNTRLP; 
      RCL.CNTRLP := CNTRLP; 
      SYS(XHC);                        (* INITIATE XHC *) 
      INITOK := TRUE;                  (* INITIALIZE OK *)
      FOR I := 1 TO 3 DO               (* SET EQ IN LOAD MESSAGE *) 
        LDMSG[I+3] := EQ[I];
      END                              (* VALID EQ *) 
    ELSE
      BEGIN                            (* INCORRECT EQ *) 
      FOR I := 1 TO 3 DO               (* SET EQ IN MESSAGE *)
        EQMSG[I+3] := EQ[I];
      MESSAGE(EQMSG); 
      WRITELN(EQMSG); 
      END;  (* IF *)                   (* INCORRECT EQ *) 
    END                                (* FILE OK *)
  ELSE
    BEGIN                              (* EMPTY FILE *) 
    MESSAGE(EFMSG); 
    WRITELN(EFMSG); 
    END;  (* IF *)                     (* EMPTY FILE *) 
  END;  (* INIT *)
(*$L'MAIN PROGRAM.'*) 
BEGIN  (* HSTCOPY *)
INIT;                                  (* INITIALIZE HOST COPY *) 
IF INITOK THEN
  BEGIN                                (* INIT OK *)
  WHILE NOT EOF(FTS) DO 
    BEGIN                              (* PROCESS FTS RECORD *) 
    CMI := 0;                          (* READ FTS RECORD *)
    WHILE (NOT EOS(FTS) AND NOT EOF(FTS)) AND 
          (CMI < CML) DO
      BEGIN 
      CMI := CMI+1; 
      READ(FTS,BUFF.W[CMI]);
      END;  (* WHILE *) 
    GETSEG(FTS);                       (* GET NEXT RECORD *)
    IF CMI = CML THEN                  (* ESTABLISH RECORD SIZE *)
      RECNUM := 64                     (* 8192-BYTES *) 
    ELSE
      BEGIN 
      IF CMI = CMLS THEN
        RECNUM := 4                    (* 512-BYTES *)
      ELSE
        RECNUM := 1;                   (* 128-BYTES *)
      END;
    BIT4I := 0;                        (* XFER FTS RECORD TO NIP *) 
    FOR RECI := 1 TO RECNUM DO
      BEGIN 
      IF RECRDPI < RECRDPL THEN 
        RECRDPI := RECRDPI + 1
      ELSE
        RECRDPI := 1; 
      FOR RECRDI := 1 TO RECRDL DO     (* MOVE ONE 128-BYTE RECORD *) 
        BEGIN 
        BIT4I := BIT4I+1; 
        RECRDP[RECRDPI]^[RECRDI] := BUFF.B4[BIT4I]; 
        END;  (* FOR *) 
      SYS(RCL);                        (* WAIT FOR REQUEST DONE *)
      CNTRLP^.RECRDP := RECRDP[RECRDPI];
                                       (* REQUEST XHC TO XFER RECRD *)
      CNTRLP^.COMP := FALSE;
      END;  (* FOR *) 
    END;  (* WHILE *)                  (* PROCESS FTS RECORD *) 
  SYS(RCL);                            (* WAIT FOR REQUEST DONE *)
  CNTRLP^.TERM := TRUE;                (* TERMINATE XHC *)
  CNTRLP^.COMP := FALSE;
  SYS(RCL);                            (* WAIT FOR TERMINATION *) 
  MESSAGE(LDMSG);                      (* HOSTCOPY COMPLETE *)
  WRITELN(LDMSG); 
  END;  (* IF *)                       (* INIT OK *)
END.  (* HSTCOPY *) 
*WEOR 
          TTL    SYS - ISSUE SYSTEM REQUEST.
          TITLE  SYS - ISSUE SYSTEM REQUEST.
          IDENT  SYS
          ENTRY  SYS
          SST 
          SYSCOM B1 
*COMMENT  SYS - ISSUE SYSTEM REQUEST. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 SYS      SPACE  4,10 
***       SYS - ISSUE SYSTEM REQUEST. 
* 
*         SYS ALLOWS DIRECT SYSTEM CALLS TO THE OPERATING 
*         SYSTEM.  THE REQUEST, IN THE FORM OF AN RA+1 REQUEST, 
*         IS PASSED TO SYS, WHICH IN TURN CALLS SYS=.  THIS 
*         IS REQUIRED BECAUSE OF REGISTER DIFFERENCES.
* 
*         PASCAL DECLARATION: 
* 
*         PROCEDURE SYS(VAR REQ : SYSREQ); EXTERN;
* 
*         REQ    RA+1 REQUEST.
          SPACE  4,10 
***       COMMON DECKS. 
  
  
*CALL     COMCMAC 
          SPACE  4,10 
**        SYS - ISSUE SYSTEM REQUEST. 
* 
*         ENTRY  (X0) = ADDRESS OF THE REQUEST. 
* 
*         EXIT   REQUEST ISSUED.
* 
*         USES   A - 4. 
*                X - 4, 6.
*                B - NONE.
* 
*         CALLS  SYS=.
  
  
 SYS      PS                 ENTRY/EXIT 
          SA4    X0          GET REQUEST
          BX6    X4 
          RJ     =XSYS= 
          EQ     SYS         RETURN 
  
  
          END 
*WEOR 
