*COMDECK HIP33
_$J+? 
_ 
 CCCCCCCCCC    YY        YY   BBBBBBBBBBB    EEEEEEEEEEEE   RRRRRRRRRRR 
CCCCCCCCCCCC    YY      YY    BBBBBBBBBBBB   EEEEEEEEEEEE   RRRRRRRRRRRR
CC               YY    YY     BB        BB   EE             RR        RR
CC                YY  YY      BB        BB   EE             RR        RR
CC                 YYYY       BB        BB   EE             RR        RR
CC                  YY        BBBBBBBBBBB    EEEEEEEEEEEE   RRRRRRRRRRRR
CC                  YY        BBBBBBBBBBB    EEEEEEEEEEEE   RRRRRRRRRRR 
CC                  YY        BB        BB   EE             RR    RR
CC                  YY        BB        BB   EE             RR     RR 
CC                  YY        BB        BB   EE             RR      RR
CCCCCCCCCCCC        YY        BBBBBBBBBBBB   EEEEEEEEEEEE   RR       RR 
 CCCCCCCCCC         YY        BBBBBBBBBBB    EEEEEEEEEEEE   RR        RR
  
  
  
  
  
  
  
  
      HH        HH            IIIIIIIIIIII            PPPPPPPPPPP 
      HH        HH            IIIIIIIIIIII            PPPPPPPPPPPP
      HH        HH                 II                 PP        PP
      HH        HH                 II                 PP        PP
      HH        HH                 II                 PP        PP
      HHHHHHHHHHHH                 II                 PPPPPPPPPPPP
      HHHHHHHHHHHH                 II                 PPPPPPPPPPP 
      HH        HH                 II                 PP
      HH        HH                 II                 PP
      HH        HH                 II                 PP
      HH        HH            IIIIIIIIIIII            PP
      HH        HH            IIIIIIIIIIII            PP
  
  
  
  
  
  
  
VV        VV   EEEEEEEEEEEE   RRRRRRRRRRR                   333333333333
VV        VV   EEEEEEEEEEEE   RRRRRRRRRRRR                  333333333333
VV        VV   EE             RR        RR                            33
VV        VV   EE             RR        RR                            33
VV        VV   EE             RR        RR                            33
VV        VV   EEEEEEEEEEEE   RRRRRRRRRRR                        3333333
VV        VV   EEEEEEEEEEEE   RRRRRRRRRR                         3333333
 VV      VV    EE             RR    RR                                33
  VV    VV     EE             RR     RR                               33
   VV  VV      EE             RR      RR                              33
    VVVV       EE             RR       RR                   333333333333
     VV        EEEEEEEEEEEE   RR        RR                  333333333333
? 
_$J+? 
_$R-,G-,I-? 
_ NON-RECURSIVE, INTERRUPTABLE? 
_ 
* 
************************************************************************
*                                                                      *
*              * *   C Y B E R   C O U P L E R   * *                   *
*                                                                      *
*                        O P S   L E V E L                             *
*                                                                      *
*                          P T H I P O P S                             *
*                                                                      *
************************************************************************
* 
** OVERVIEW -  THIS PROCEDURE HANDLES TIMEOUT ENTRIES MADE FOR THE     *
*              COUPLER BY SYSTEM TIMER ROUTINES (IDLE TIMEOUT AND      *
*              DEADMAN TIMEOUT).                                       *
*                                                                      *
** INPUT -     INTERMEDIATE ARRAY BWWLENTRY[OPS] WITH THE FOLLOWING:   *
*                                                                      *
*              ACPEVENT       DESCRIPTION                              *
*                                                                      *
*              A0TIMEOUT      TIMEOUT ENTRY                            *
*                                                                      *
* OUTPUT -                                                             *
*              1)  CLEAR COUPLER COMMAND  (ERROR CASE)                 *
*              2)  WORKLIST TO SVM - REGULATION                        *
*              3)  START TIMER                                         *
*              4)  START COUPLER INPUT TRANSACTION                     *
*                                                                      *
** EXTERNAL SUBROUTINES USED                                           *
*              1) PBLSPUT   - PUT WORKLIST - REGULATION CHANGE         *
*              2) PBLSGET   - GET A WORKLIST - DATA BLOCK              *
*              3) PNCEFILE  - MAKE CE FILE ENTRY                       *
*              4) PBRELCHN  - RELEASE BUFFER CHAIN                     *
*              5) PTHIPSIO  - COUPLER INPUT ROUTINE                    *
*              6) PBAMASK   - DISABLE COUPLER INTERRUPT                *
*              7) PBLMASK   - ENABLE  COUPLER INTERRUPT                *
*              8) PBRELZRO  - RELEASE BUFFER CHAIN                     *
*                                                                      *
************************************************************************
? 
PROCEDURE PTHIPOPS; 
CONST 
_ 
*              ---- COUPLER HARDWARE STATUS WORD ---- 
? 
      AMEMPA   = BIT0;   _ ** MEMORY PARITY ERROR                      ?
      AMEMPF   = BIT1;   _ ** MEMORY PROTECT FAULT                     ?
      ACPSRL   = BIT2;   _    CPSRL - NPU STATUS REGISTER LOADED       ?
      AMMARL   = BIT3;   _    MARL  - MEMORY ADDRESS REG LOADED        ?
      ACPXCA   = BIT4;   _    EXTERNAL CABINET ALARM                   ?
      AATXCP   = BIT5;   _ *  TRANSMISSION COMPLETE                    ?
      AATRTN   = BIT6;   _ *  TRANSFER TERMINATED BY NPU               ?
      AATRTP   = BIT7;   _ *  TRANSFER TERMINATED BY PPU               ?
      AAORDR   = BIT8;   _ *  ORDERWORD LOADED                         ?
      AASTAC   = BIT9;   _    NPU STATUS ACCEPTED                      ?
      AATIMO   = BIT10;  _ ** HARDWARE TIMEOUT                         ?
      ACHPAR   = BIT11;  _ ** CYBER 170 CHANNEL PARITY ERROR           ?
      ACZERO   = BIT14;  _ *  CHAIN ADDRESS ZERO                       ?
      AALARM   = BIT15;  _ ** ALARM                                    ?
_ 
*     **  ALARM CONDITION - ALL ALARMS GENERATE AN NPU INTERRUPT
*     *   NPU INTERRUPT CONDITION 
* 
? 
VAR WIDLE    : BOOLEAN;                     _ IDLE TIMEOUT             ?
    HPCMD    : INTEGER;                     _ HARDWARE COMMAND WORD    ?
    HPPARM   : B0OVERLAY;                   _ HARDWARE GENERAL PURPOSE ?
PROCEDURE PTREG;
BEGIN 
WITH BWWLENTRY[OPS],                        _ INTERMEDIATE ARRAY       ?
     CGLCBP'[0].BZSUB1PTR'[ACPBLINO.        _ SUB LINE CONTROL BLOCK   ?
                           BDSUBPORT],
     BZTCBPTR'.BHCCB,                       _ COUPLER CONTROL BLOCK    ?
     BWWLENTRY[OPS].CMSMLEY DO              _ SVC MSG OVERLAY          ?
  BEGIN 
  CMLTYP   := CPLR;                         _ LINK TYPE = COUPLER      ?
  CMREG    := BHCPREG.BACPREG.BACPRG;       _ SET REGULATION LEVEL     ?
  CMWKCODE := D0LINK;                       _ WORK CODE = LINK EVENT   ?
  CMPTR    := BZTCBPTR;                     _ COUPLER CONTROL BLOCK    ?
  PBLSPUT (BWWLENTRY[OPS],BYWLCB[B0SMWL]);  _ SEND TO SERVICE MODULE   ?
  PBRELZRO (BHCPINPUT,BEDBSIZE);            _ RELEASE POSSIBLE BUFFERS ?
  WHILE (PBLSGET (BWWLENTRY[OPS],BHWLCB)    _ IF DATA QUEUED           ?
                 = FALSE) DO
    PBRELCHN (BWWLENTRY[OPS].BWPKTPTR,BEDBSIZE);
  END;  _ WITH ?
END;  _ PTREG ? 
PROCEDURE PTDEAD; 
BEGIN 
WITH BWWLENTRY[OPS],                        _ INTERMEDIATE ARRAY       ?
     CGLCBP'[0].BZSUB1PTR'[ACPBLINO.        _ SUB LINE CONTROL BLOCK   ?
                           BDSUBPORT],
     BZTCBPTR'.BHCCB,                       _ COUPLER CONTROL BLOCK    ?
     CNCEOVLY[OPS] DO                       _ CE ERROR SM OVERLAY      ?
  BEGIN 
  BHCPDEAD        := TRUE;                  _ SET HOST DOWN            ?
  BHCPREG.BACPREG.BACPRG := 0;              _ SET REG LEVEL            ?
  CNCECODE        := CEDEADTO;              _ DEADMAN TIMEOUT          ?
  ADST1.BALCHAR   := CHR(BHSTATE);          _ STATE GOING TO           ?
  ADST1.BARCHAR   := CHR(BHCPBZST);         _ STATE COMING FROM        ?
  ADST2.BALBYT    := BHLLCB'.BLLLCB.BLSPART 
                     .BLDN; 
  PNCEFILE(3);                              _ SEND CE ERROR MESSAGE    ?
  BLSTIMTBL[BZLINO.BDSUBPORT]               _ WAIT FOR HOST            ?
            .BLTIME := ADEADTO; 
_ 
* * * * * ISSUE CLEAR COUPLER COMMAND * * * * 
? 
  HPCMD := BHCPCONN + ACPCLR;               _ CMD = CLEAR COUPLER      ?
  INST  ($E400,HPCMD,                       _ LDQ   COMMAND            ?
         $0B04);                            _ SIO                      ?
_ 
* * * * * WRITE NPU STATUS WORD * * * * 
? 
  HPCMD := BHCPCONN + ACPONS;               _ CMD = OUTPUT STATUS      ?
  HPPARM.BAINT := AINITC;                   _ STATUS = INIT COMPLETE   ?
  BHCPCMD := HPPARM.BAINT;                  _ SAVE LAST NPU STATUS     ?
  INST  ($E400,HPCMD,                       _ LDQ   COMMAND            ?
         $C400,HPPARM,                      _ LDA   STATUS WORD        ?
         $0B04);                            _ SIO                      ?
  PTREG;                                    _ NOTIFY SERVICE MODULE    ?
  BHSTATE := A0PT0;                         _ SET STATE TO IDLE        ?
  END;  _ WITH ?
END;  _ PTDEAD ?
_ 
* * * * * START OF PTHIPOPS * * * * 
? 
BEGIN 
WITH BWWLENTRY[OPS],                        _ INTERMEDIATE ARRAY       ?
     CGLCBP'[0].BZSUB1PTR'[ACPBLINO.        _ SUB LINE CONTROL BLOCK   ?
                           BDSUBPORT],
     BZTCBPTR'.BHCCB,                       _ COUPLER CONTROL BLOCK    ?
     BLSTIMTBL[BZLINO.BDSUBPORT] DO         _ TIMER                    ?
  BEGIN 
  IF ACPEVENT = A0TIMEOUT                   _ WORK CODE = TIMEOUT      ?
  THEN
    BEGIN 
_ 
* * * *  PREVENT COUPLER INTERRUPTS 
? 
    PBAMASK (BHCPAMASK);                    _ MASK OUT COUPLER INTERUPT?
    IF BLTIME " 0                           _ IF TIMER STILL ACTIVE    ?
    THEN
      GOTO 50;                              _ EXIT PDQ                 ?
_ 
* * * *  READ COUPLER STATUS
? 
    HPCMD := BHCPCONN + ACPICS;             _ CMD = READ STATUS        ?
    INST  ($E400,HPCMD,                     _ LDQ   COMMAND            ?
           $0A00,                           _ ENA   0                  ?
           $0B04,                           _ SIO                      ?
           $6400,HPPARM);                   _ STA   HPPARM             ?
    BHCPSTATUS := HPPARM.BASET;             _ SAVE STATUS IN CPCB      ?
_ 
* * * *  CHECK CURRENT STATE
? 
    CASE BHSTATE OF 
      A0PT0 :                               _ IDLE                     ?
        BEGIN 
        IF BHCPDEAD                         _ IF COUPLER DEAD          ?
        THEN
          BEGIN 
          IF NOT (ACPSRL IN BHCPSTATUS)     _ NPU STATUS READ          ?
          THEN
            BEGIN                           _ PLACE INIT COMPLETE      ?
            HPCMD := BHCPCONN + ACPONS;     _ CMD = OUTPUT STATUS      ?
            HPPARM.BAINT := AINITC;         _ STATUS = INIT COMPLETE   ?
            INST  ($E400,HPCMD,             _ LDQ   COMMAND            ?
                   $C400,HPPARM,            _ LDA   STATUS WORD        ?
                   $0B04);                  _ SIO                      ?
            END;  _ IF NOT ?
          BLTIME := ADEADTO;                _ WAIT FOR HOST            ?
          GOTO 50;                          _ EXIT                     ?
          END; _ IF BHCPDEAD ?
        IF ACPSRL IN BHCPSTATUS             _ DID PPU READ STATUS      ?
        THEN                                _ NO                       ?
          BEGIN 
          BHCPIDLT := BHCPIDLT + 1;         _ INCREMENT DEAD COUNT     ?
          IF BHCPIDLT \ ADEADTO             _ IF TIME EXPIRED          ?
          THEN
            PTDEAD                          _ NOTIFY SERVICE MODULE    ?
          ELSE  _ NOT DEADMAN TIMEOUT ? 
            BLTIME := 1;                    _ SET TIMER                ?
          END  _ IF ACPSRL ?
        ELSE  _ PPU READ STATUS ? 
          BEGIN 
          WIDLE    := TRUE;                 _ SET IDLE FLAG            ?
          BHCPIDLT := 0;                    _ CLEAR DEADMAN COUNT      ?
          END;  _ ELSE PPU READ STATUS ?
        END;  _ CASE OF A0PT0 ? 
  
  
      A0PT1 :                               _ IDLE STATUS SENT         ?
        BEGIN 
        IF ACPSRL IN BHCPSTATUS             _ DID PPU READ STATUS      ?
        THEN                                _ NO                       ?
          BEGIN 
          BHCPIDLT := BHCPIDLT + AIDLETO;   _ ADD TO DEAD COUNT        ?
          IF BHCPIDLT \ ADEADTO             _ IF DEADMAN TIMEOUT       ?
          THEN                              _ YES                      ?
            PTDEAD                          _ NOTIFY SERVICE MODULE    ?
          ELSE                              _ NO                       ?
            BLTIME := AIDLETO;              _ SET TIMER                ?
          END  _ IF ACPSRL ?
        ELSE  _ PPU READ STATUS ? 
          BEGIN 
          WIDLE    := TRUE;                 _ SET IDLE FLAG            ?
          BHCPIDLT := 0;                    _ CLEAR DEADMAN COUNT      ?
          END;  _ ELSE PPU READ STATUS ?
        END;  _ CASE OF A0PT1 ? 
      A0PT2 :                               _ INPUT ACTIVE             ?
        IF ACPSRL IN BHCPSTATUS             _ DID PPU READ STATUS      ?
        THEN                                _ NO                       ?
          PTDEAD                            _ NOTIFY SERVICE MODULE    ?
        ELSE                                _ YES                      ?
          BEGIN 
          BHSTATE := A0PT0;                 _ SET STATE TO IDLE        ?
          BLTIME  := 1;                     _ SET TIMER                ?
          END;
  
  
      A0PT3,                                _ OUTPUT ACTIVE            ?
      A0PT4 :                               _  DEADMAN TIMEOUT         ?
        BEGIN 
        PTDEAD;                             _ NOTIFY SERVICE MODULE    ?
        IF BHCPAVPTR " NIL                  _ ANY BUFFERS PRESENT      ?
        THEN
          PBRELCHN (BHCPAVPTR,BEDBSIZE);    _ RELEASE ALL BUFFERS      ?
        BHCPBUFAV := 0;                     _ CLEAR BUFFER COUNT       ?
        END;  _ CASE OF A0PT3, A0PT4 ?
  
  
      A0PT5,                                _ READY FOR OUTPUT DELAY   ?
      A0PT6 :                               _ NOT READY FOR O/P DELAY  ?
        BEGIN 
        IF ACPSRL IN BHCPSTATUS             _ DID PPU READ STATUS      ?
        THEN                                _ NO                       ?
          BEGIN 
          BHCPIDLT := BHCPIDLT + 1;         _ INCREMENT DEADMAN COUNT  ?
          IF BHCPIDLT \ ADEADTO             _ IF DEADMAN TIMEOUT       ?
          THEN                              _ YES                      ?
            PTDEAD                          _ NOTIFY SERVICE MODULE    ?
          ELSE                              _ NOT DEAD                 ?
            BLTIME := 1;                    _ SET TIMER                ?
          END  _ IF ACPSRL ?
        ELSE  _ PPU READ STATUS ? 
          BEGIN 
          BHCPIDLT := 0;                    _ CLEAR DEADMAN COUNT      ?
          IF BHSTATE = A0PT5                _ READY FOR OUTPUT DELAY   ?
          THEN
            BEGIN 
            BHSTATE      := A0PT4;          _ SET TO OUTPUT COMPLETE   ?
            HPPARM.BAINT := AAREADY;        _ STATUS = READY FOR OUTPUT?
            BLTIME       := ADEADTO;        _ SET DEADMAN TIMEOUT      ?
            END 
          ELSE  _ NOT READY FOR OUTPUT DELAY ?
            BEGIN 
            BHSTATE      := A0PT0;          _ RETURN TO IDLE           ?
            HPPARM.BAINT := AANREADY;       _ STATUS = NOT READY       ?
            BLTIME       := 1;              _ SET TIMER                ?
            END;
_ 
* * * *  OUTPUT STATUS TO HOST
? 
            HPCMD := BHCPCONN + ACPONS;     _ CMD = OUTPUT STATUS      ?
            INST  ($E400,HPCMD,             _ LDQ   COMMAND            ?
                   $C400,HPPARM,            _ LDA   STATUS WORD        ?
                   $0B04);                  _ SIO                      ?
          END;  _ ELSE PPU READ STATUS ?
        END;  _ CASE OF A0PT5, A0PT6 ?
    END;  _ CASE OF BHSTATE ? 
_ 
*              ---- SERVICE INPUT ----
? 
    IF WIDLE                                _ IF NO ACTIVITY           ?
    THEN
      BEGIN 
      WIDLE := FALSE;                       _ CLEAR IDLE FLAG          ?
      IF BHCPINPUT = NIL                    _ NOTHING ALREADY IN QUEUE ?
      THEN
        IF PBLSGET (BWWLENTRY[OPS],BHWLCB)  _ GET A SEGMENT            ?
        THEN                                _ NOTHING IN QUEUE         ?
          BEGIN 
          BLTIME := AIDLETO;                _ IDLE TIMEOUT             ?
_ 
* * * *  SEND IDLE STATUS 
? 
          BHSTATE      := A0PT1;            _ STATE = IDLE SENT        ?
          HPCMD        := BHCPCONN + ACPONS;_ CMD = OUTPUT STATUS      ?
          HPPARM.BAINT := AIDLE;            _ STATUS = IDLE            ?
          BHCPCMD      := HPPARM.BAINT;     _ SAVE LAST NPU STATUS     ?
          INST  ($E400,HPCMD,               _ LDQ   COMMAND            ?
                 $C400,HPPARM,              _ LDA   STATUS WORD        ?
         $0B04);                            _ SIO                      ?
          END  _ IF PBLSGET ? 
        ELSE  _ BLOCK REMOVED FROM QUEUE ?
          BEGIN 
          BHCPINPUT := BWWLENTRY[OPS]       _ BUFFER ADDRESS           ?
               .BWPKTPTR; 
          PTHIPSIO (BZTCBPTR);              _ START INPUT              ?
          END 
      ELSE  _ INPUT ALREADY QUEUED ?
        PTHIPSIO (BZTCBPTR);                _ START INPUT              ?
      END;  _ IF WIDLE ?
_ 
* * * *  PUT COUPLER BACK IN INTERRUPT MASK 
? 
50 :  
    PBLMASK;
    END;  _ IF TIMEOUT ?
  
  END;  _ WITH ?
  
END;  _ PTHIPOPS ?
_?
_$J+? 
_$R-,G-,I-? 
_ 
* 
************************************************************************
*                                                                      *
*              * *   P T H I P Q U E U E   * *                         *
*                                                                      *
************************************************************************
* 
** OVERVIEW -  THIS ROUTINE IS CALLED BY A USER TO PUT A BLOCK IN      *
*              QUEUE FOR THE HIP.  IF THE HIP IS IDLE THE BLOCK IS     *
*              INPUT TO THE COUPLER IMMEDIATELY OTHERWISE IT IS        *
*              DELAYED QUEUED TO THE HIP#S TCB.                        *
*                                                                      *
** INPUT -                                                             *
*              1) B1BUFF - BLOCK ADDRESS (B0BUFPTR)                    *
*                                                                      *
** OUTPUT -                                                            *
*              1) COMMANDS TO THE COUPLER                              *
*              2) BLOCK QUEUE TO COUPLER CONTROL BLOCK                 *
*                                                                      *
** EXTERNAL SUBROUTINES USED                                           *
*              1) PBLSPUT  - MAKE WORKLIST ENTRY - DATA SEGMENT        *
*              2) PTHIPSIO - INITIATE INPUT TO COUPLER                 *
*              3) PBAMASK  - DISABLE COUPLER INTERRUPT                 *
*              4) PBLMASK  - ENABLE  COUPLER INTERRUPT                 *
*              5) PN1SRCH  - SEARCH *DELOCDN* TABLE                    *
*                                                                      *
** NOTE -      THIS PROCEDURE RUNS AT OPS LEVEL ONLY.  TO PREVENT      *
*              QUEUE CONTENTION AND CONTENTION WITH THE COUPLER        *
*              INTERRUPT HANDLER THE COUPLER INTERRUPT IS DISABLED.    *
*                                                                      *
************************************************************************
* 
* 
? 
PROCEDURE PTHIPQUE; 
_?
VAR WTCB : B0BUFPTR;
    ID : INTEGER; 
BEGIN 
ID := ORD(B1BUFF'.BFDATAC[DN]);                  _ GET DESTINATION ID  ?
WTCB := PN1SRCH(ID,DELOCDN);                     _ GET COUPLER CB      ?
  WITH WTCB'.BHCCB DO                            _ COUPLER CONTROL BLK ?
  BEGIN 
    PBAMASK(BHCPAMASK);                          _ DISABLE COUPLER INT.?
    IF ((BHSTATE @ A0PT1) &                      _ HIP IDLE            ?
       (BHCPINPUT = NIL)) &                      _ NO INPUT LEFTOVER   ?
       (BHCPDEAD = FALSE)                        _ HOST IS UP          ?
    THEN
_ 
*              ---- HIP IDLE, INPUT BLOCK NOW ----
? 
    BEGIN 
      BHCPINPUT := B1BUFF;                       _ SET UP BLK ADDRESS  ?
      PTHIPSIO (WTCB);                           _ START INPUT         ?
    END 
_ 
*              ---- HIP BUSY, DELAY QUEUE BLOCK ----
? 
    ELSE
      BEGIN 
      IF BHCPREG.BACPREG.BACPRL = 0         _ IF NODE IS DOWN THEN     ?
      THEN                                  _ DISCARD BUFFER           ?
        PBRELCHN (B1BUFF,BEDBSIZE)
      ELSE
        BEGIN 
        BWWLENTRY[OPS].BWPKTPTR := B1BUFF;  _ PUT SEG ADDRESS IN ARRAY ?
        PBLSPUT (BWWLENTRY[OPS],BHWLCB)     _ MAKE DATA LIST ENTRY     ?
        END;
      END;
    PBLMASK;                                _ RE-ENABLE COUPLER INTRPT ?
_?
_?
  END;  _ WITH  ? 
_?
END;  _ PTHIPQUEUE  ? 
_$J+? 
_$R-,G-,I+? 
_ 
* 
************************************************************************
*                                                                      *
*              * *   H I P   I N P U T   S U B R O U T I N E  * *      *
*                                                                      *
************************************************************************
* 
** OVERVIEW -  THIS SUBROUTINE SENDS AN INPUT BLOCK TO THE HOST        *
*              VIA THE COUPLER.  IT IS CALLED BY THE OPS LEVEL HIP     *
*              AND BY THE INTERRUPT LEVEL HIP AND THEREFORE MUST       *
*              BE NON INTERRUPTABLE.  THE HOST IS ALSO TOLD THE        *
*              APPROX. BLOCK SIZE.                                     *
*              IF THE HOST HAS NOT READ THE LAST NPU STATUS WORD       *
*              THE INPUT IS NOT ISSUED TO THE COUPLER. INSTEAD         *
*              AN IDLE TIMEOUT IS SET UP.                              *
*                                                                      *
** INPUTS -                                                            *
*              1) HPTCB - ADDRESS OF COUPLER CONTROL BLOCK             *
*              2) BHCPINPUT - CONTAINS ADDRESS OF BLOCK TO INPUT       *
*                                                                      *
** OUTPUT -    COMMANDS TO THE COUPLER                                 *
*                                                                      *
**EXTERNAL SUBROUTINES USED                                            *
*              1) PTCTCHR  - COUNT NUMBER OF CHARACTERS                *
*                                                                      *
*                                                                      *
************************************************************************
? 
PROCEDURE PTHIPSIO (HPTCB : B0BUFPTR);
CONST 
      ACPSRL = BIT2;         _  CPSRL  - NPU STATUS REGISTER LOADED    ?
VAR 
    HPCMD  : INTEGER; 
    HPPARM : B0OVERLAY; 
    HPBLKT : BLKTYPE;                            _ BLK TYPE OF INP BUFF?
    HPDBC  : DBDBC;                              _ DBC OF INPUT BUFFER ?
    HPWBP  : B0BUFPTR;                           _ WORK BUFFER POINTER ?
    HPCNT  : INTEGER;                            _ CHAR/PRU COUNT      ?
    HPFCD  : INTEGER;                            _ WORK FCD INTEGER    ?
  
BEGIN 
  WITH HPTCB'.BHCCB,                             _ TCB ADDRESS         ?
       BHLCBP' DO                                _ LCB                 ?
  BEGIN 
_ 
*              ---- READ COUPLER STATUS ----
? 
    HPCMD := BHCPCONN + ACPICS;                  _ CMD = READ STATUS   ?
    INST  ($E400,HPCMD,                          _ LDQ   COMMAND       ?
           $0A00,                                _ CLEAR A REG         ?
           $0B04,                                _ SIO                 ?
           $6400,HPPARM);                        _ STA   STATUS SAVE   ?
    BHCPSTATUS := HPPARM.BASET;                  _ SAVE STATUS IN TCB  ?
_ 
*              ---- CHECK FOR CONTENTION ---- 
? 
    IF ACPSRL IN BHCPSTATUS                      _ DID HOST RD LAST ST ?
    THEN
    BEGIN                                        _ NO                  ?
      BHSTATE  := A0PT0;                         _ SET STATE TO IDLE   ?
      BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME := 1;   _ SET UP QUICK RETURN ?
    END 
    ELSE
_ 
*              ---- SET UP BUFFER ADDRESS ----
? 
    BEGIN 
      HPCMD := BHCPCONN + ACPOMA;                _ CMD = OUTPUT M.A.R  ?
      HPPARM.BABUFPTR := BHCPINPUT;              _ BUFFER ADDRESS      ?
      BHBUFOTT := BHCPINPUT;                     _ SAVE LAST M.A.R.    ?
      INST  ($E400,HPCMD,                        _ LDQ   COMMAND       ?
             $C400,HPPARM,                       _ LDA   BUFFER ADDRESS?
             $0B04);                             _ SIO                 ?
_ 
*              ---- CALCUALTE NR CHARS AND SET EOT FLAG ----
? 
      HPWBP := BHCPINPUT;                        _ GET PTR 1ST BUFFER  ?
      HPCNT := DN - (DBC + 1);                   _ INIT CHAR COUNT     ?
      REPEAT
        HPWBP'.BFEOTFLG := FALSE;                _ RESET EOT FLAG      ?
        HPFCD := HPWBP'.BFFCD;                   _ GET FCD LOCAL       ?
        HPCNT := HPWBP'.BFLCD - HPFCD + 1 +      _ ADD CHARS IN BUFFER ?
                 HPCNT;                          _ TO TOTAL COUNT      ?
        IF HPWBP'.BCCHAINS [DBUFLEN] = NIL
        THEN                                     _ LAST IN CHAIN       ?
          HPWBP'.BFEOTFLG := TRUE;               _ SET EOT FLAG        ?
        HPWBP := HPWBP'.BCCHAINS [DBUFLEN];      _ GET NEXT BUFFER     ?
      UNTIL HPWBP = NIL;
_ 
*              ---- SEND INPUT REQUEST ---- 
? 
      WITH BHCPINPUT' DO
      BEGIN 
        HPBLKT.BTCHR := BFDATAC[BTPT];           _ GET BLOCK TYPE      ?
        HPDBC.DBCHAR := BFDATAC[DBC];            _ GET DBC OF BLOCK    ?
        IF BFLCD < DBC                      _ IF DBC NOT IN BUFFER     ?
        THEN
          BEGIN 
          HPWBP := BCCHAINS[DBUFLENGTH];         _ GET NEXT BUFFER     ?
          HPFCD := HPWBP'.BFFCD;                 _ GET FIRST CHARACTER ?
          HPDBC.DBCHAR := HPWBP'.BFDATAC[HPFCD]; _ GET DBC             ?
          END;
        IF (HPBLKT.BTYPE @ HTMSG) & 
            HPDBC.DBBDATA                        _ BATCH DATA BLOCK    ?
        THEN
        BEGIN 
          IF HPDBC.DBBXPT                        _ IF TRANSPARENT DATA ?
          THEN
            HPCNT := HPCNT * 2;                  _ ADJUST CHAR COUNT SO?
                                                 _ ENOUGH BUFRS RESERVD?
          HPCNT := (HPCNT + 639) / 640;          _ CALC NUMBER OF PRUS ?
          IF HPCNT @ 1
          THEN                                   _ 0 - 640 CHARS       ?
            HPPARM.BAINT := AINP1B               _ SET BLOCK SIZE = 1  ?
          ELSE
            IF HPCNT = 2
            THEN                                 _ 641 - 1280 CHARS    ?
              HPPARM.BAINT := AINP2B             _ SET BLOCK SIZE = 2  ?
            ELSE                                 _ 1281 - 1920 CHARS   ?
              HPPARM.BAINT := AINP3B;            _ SET BLOCK SIZE = 3  ?
        END 
        ELSE                                     _ INTERACTIVE DATA    ?
                                                 _ OR NON DATA BLOCK   ?
          IF HPCNT > 256 + (DN - (DBC + 1)) 
          THEN
            HPPARM.BAINT := AINPLB               _ SET BLOCK TO LARGE  ?
          ELSE
            HPPARM.BAINT := AINPSB;              _ SET BLOCK TO SMALL  ?
      END;  _WITH BSCINPUT? 
      BHCPCMD := HPPARM.BAINT;                   _ SAVE LAST NPU STATUS?
      HPCMD   := BHCPCONN + ACPONS;              _ CMD = OUT. STATUS   ?
      INST  ($E400,HPCMD,                        _ LDQ   COMMAND       ?
             $C400,HPPARM,                       _ LDA   STATUS WD     ?
             $0B04);                             _ SIO                 ?
      BHSTATE  := A0PT2;                         _ SET UP RETURN       ?
      BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME := ADEADTO;  _ DEADMAN TIMER  ?
    END;   _ SEND INPUT  ?
_?
  END;  _ WITH  ? 
_?
END;  _ PTHIPSIO  ? 
_$J+? 
_$R-,G-,I+? 
_ 
* 
************************************************************************
*                                                                      *
*              * *   C Y B E R   C O U P L E R   * *                   *
*                                                                      *
*                 I N T E R R U P T   H A N D L E R                    *
*                                                                      *
*                          P T H I P I N T                             *
*                                                                      *
************************************************************************
* 
** OVERVIEW -  PTHIPINT HANDLES INTERRUPTS ORIGINATING FROM THE        *
*              COUPLER.  THE COUPLER STATUS WORD IS READ AND           *
*              CHECKED FOR ERROR.  CONTROL IS THEN PASSED TO ONE       *
*              OF THE STATE PROCESS ROUTINES                           *
*                                                                      *
** INPUT -     COUPLER LINE NUMBER                                     *
*                                                                      *
** OUTPUT -                                                            *
*              1) ERROR REPORTING                                      *
*              2) SERVICE MODULE NOTIFICATION OF HOST REGULATION CHANGE*
*              3) OUTPUT COUPLER BLOCK                                 *
*              4) INPUT COUPLER BLOCK                                  *
*              5) COUPLER COMMANDS                                     *
*                                                                      *
** EXTERNAL SUBROUTINES USED -                                         *
*              1) PBHALT - SYSTEM HALT FOR SERIOUS ALARM CONDITION     *
*              2) PNCEFILE - CE ERROR FILE ENTRY                       *
*              3) PBBFAVA1L - BUFFERS AVAILABLE CHECK                  *
*              4) PBGET1BF  - GET A BUFFER                             *
*              5) PBRELCHN  - RELEASE A CHAIN OF BUFFERS               *
*              6) PTHIPSIO - COUPLER INPUT ROUTINE                     *
*              7) PBLSGET   - GET A WORKLIST ENTRY - DATA SEGMENT      *
*                                                                      *
************************************************************************
* 
? 
PROCEDURE PTHIPINT (LINEO : INTEGER); 
CONST 
_ 
*              ---- COUPLER HARDWARE STATUS WORD ---- 
? 
      AMEMPA   = BIT0;   _ ** MEMORY PARITY ERROR                      ?
      AMEMPF   = BIT1;   _ ** MEMORY PROTECT FAULT                     ?
      ACPSRL   = BIT2;   _    CPSRL - NPU STATUS REGISTER LOADED       ?
      AMMARL   = BIT3;   _    MARL  - MEMORY ADDRESS REG LOADED        ?
      ACPXCA   = BIT4;   _    EXTERNAL CABINET ALARM                   ?
      AATXCP   = BIT5;   _ *  TRANSMISSION COMPLETE                    ?
      AATRTN   = BIT6;   _ *  TRANSFER TERMINATED BY NPU               ?
      AATRTP   = BIT7;   _ *  TRANSFER TERMINATED BY PPU               ?
      AAORDR   = BIT8;   _ *  ORDERWORD LOADED                         ?
      AASTAC   = BIT9;   _    NPU STATUS ACCEPTED                      ?
      AATIMO   = BIT10;  _ ** HARDWARE TIMEOUT                         ?
      ACHPAR   = BIT11;  _ ** CYBER 170 CHANNEL PARITY ERROR           ?
      ACZERO   = BIT14;  _ *  CHAIN ADDRESS ZERO                       ?
      AALARM   = BIT15;  _ ** ALARM                                    ?
_ 
*     **  ALARM CONDITION - ALL ALARMS GENERATE AN NPU INTERRUPT
*     *   NPU INTERRUPT CONDITION 
* 
? 
_ 
*              ---- PPU ORDER CODE ---- 
? 
      ABOPL1   = 1 ;     _ OUTPUT LEVEL 1 (SERVICE MESSAGES)           ?
      ABOPL2   = 2 ;     _ OUTPUT LEVEL 2 (HIGH PRIORITY DATA)         ?
      ABOPL3   = 3 ;     _ OUTPUT LEVEL 3 (LOW PRIORITY DATA)          ? ?
      ABNRIP   = 4 ;     _ NOT READY FOR INPUT                         ?
      ABREGC   = 5 ;     _ REGULATION CHANGE                           ?
      ABINAK   = 6 ;     _ INITIALIZATION REQUEST ACKNOWLEDGEMENT      ?
                         _ (USED ONLY BY SAM)                          ?
VAR 
    WADBGI : INTEGER;                       _INDEX TO NEXT BLOCK U/L   ?
    WADBGA : ARRAY [0..14] OF B0BUFPTR;     _SAVED UPLINE BLOCK ARRAY  ?
    WABUFS : BOOLEAN;                            _ THRESHOLD FLAG      ?
    WABUFT : B0BUFPTR;                           _ BUFFER ADDRESS HOLD ?
    WADLBF : B0BUFPTR;                           _ DOWN-LINE DATA PTR  ?
    WABFTH : B0BUFLEVELS;                        _ CHECK THRESHOLD     ?
    I      : INTEGER;                            _ INDEX               ?
    WACNT  : INTEGER;                            _ NUMBER TO ALLCOATE  ?
    WACNT1 : INTEGER;                            _ NUMBER OF BUFFS NEED?
    HPCMD  : INTEGER; 
    HPPARM : B0OVERLAY; 
_?
BEGIN 
  WITH CGLCBP'[0].BZSUB1PTR'[LINEO],             _ SUB LCB ADDRESS     ?
       BZTCBPTR'.BHCCB,                          _ TERM. CONTROL BLOCK ?
       CNCEOVLY[LEVELNO] DO                      _ CE ERROR SM OVERLAY ?
    BEGIN 
      BHCPBZST := BHSTATE;                       _ SAVE PREVIOUS STATE ?
      BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME := ADEADTO;  _ DEADMAN TIMER  ?
                                                 _ FOR OTHER STATES    ?
      HPCMD := BHCPCONN + ACPICS;                _ CMD = INPUT STATUS  ?
      INST  ($E400,HPCMD,                        _ LDQ   COMMAND       ?
             $0A00,                              _ ENA   0             ?
             $0B04,                              _ SIO                 ?
             $6400,HPPARM);                      _ STA   SAVE          ?
      BHCPSTATUS := HPPARM.BASET;                _ SAVE STATUS IN TCB  ?
      IF AALARM IN BHCPSTATUS                    _ CHECK FOR ALARM     ?
      THEN
      BEGIN 
        IF BHCPSTATUS & [AMEMPA,AMEMPF] " []     _ MEMORY PARITY OR    ?
                                                 _ PROTECT FAULT       ?
        THEN PBHALT (J0CPALARM);                 _ B O N Z A I         ?
      END;
_ 
*              ---- CHECK STATUS FOR OUTPUT ORDERWORD : 
* 
*                   1. CHAIN ADDRESS ZERO 
*                   2. HARDWARE TIMEOUT 
*                   3. TRANSFER COMPLETE
*                   4. TRANSMISSION COMPLETE
? 
      IF BHCPSTATUS & [ACZERO,AATIMO,AATRTP,AATXCP] = []
      THEN
        IF AAORDR IN BHCPSTATUS                  _ IS ORDERWORD LOADED ?
        THEN
        BEGIN 
          IF BHSTATE " A0PT4                     _ CHECK OUTPUT BUSY   ?
          THEN BHSTATE := A0PT3;                 _ FORCE OUTPUT        ?
        END;   _ AA0RDR IN BHCPSTATUS  ?
_ 
*              * *   C O U P L E R   S T AT E S   * * 
* 
*              STATE     DESCRIPTION
* 
*              A0PT0     NO ACTIVITY
*              A0PT1     IDLE SENT
*              A0PT2     COMPLETE INPUT TRANSACTION 
*              A0PT3     START OUTPUT TRANSACTION 
*              A0PT4     COMPLETE OUTPUT TRANSACTION
* 
? 
_ 
*              ---- PROCESS CURRENT STATE ----
? 
      CASE BHSTATE OF 
_ 
*              * *   S E E   R E S T   O F   T H E   C A S E
* 
*              S T A T E M E N T   O N   T H E
* 
*              F O L L O W I N G   P A G E S   :  
* 
? 
_$J+? 
_ 
************************************************************************
*                                                                      *
*              * *   S T A T E   Z E R O   * *    A 0 P T 0            *
*              * *   S T A T E   O N E     * *    A 0 P T 1            *
*                                                                      *
************************************************************************
* 
*              ---- IDLE STATE ---- 
*                   IDLE SENT 
? 
A0PT0,
A0PT1 : BEGIN 
_?
    CNCECODE := CESPINT;                         _ SPURIOUS INTERRUPT  ?
_ 
*              ---- CONTROL COMES HERE ALSO FROM A0PT4
*                   WHEN A WRITE ERROR OCCURS 
? 
01: ADST1.BASET := BHCPSTATUS;                   _ COUPLER STATUS      ?
    ADST2.BALBYT := BHLLCB'.BLLLCB.BLSPART.BLDN;
    PNCEFILE(3);                                 _ SEND CE ERROR SM    ?
    GOTO 12                                      _ GO TEST QUEUE       ?
END;   _ A0PT0, A0PT1 ? 
_$J+? 
_ 
* 
************************************************************************
*                                                                      *
*              * *   S T A T E   T W O  --  A 0 P T 2   * *            *
*                                                                      *
************************************************************************
* 
*              ---- COMPLETE INPUT TRANSMISSION  ---- 
* 
*              ---- CHECK STATUS FOR COMPLETION : 
* 
*                   1. CHAIN ADDRESS ZERO 
*                   2. HARDWARE TIMEOUT 
*                   3. TRANSFER TERMINATED BY PPU 
*                   4. TRANSFER COMPLETE
* 
? 
A0PT2 : BEGIN 
_?
  IF BHCPSTATUS & [ACZERO,AATIMO,AATRTP,AATXCP] " []
  THEN
  BEGIN 
  WADBGA [WADBGI] := BHCPINPUT;             _SAVE PTR TO UPLINE BLOCK  ?
  WADBGI          := (WADBGI + 1) MOD 15;   _UPDATE INDEX INTO ARRAY   ?
_ 
*              ---- CHECK STATUS FOR ERROR :  
* 
*                   1. CHAIN ADDRESS ZERO 
*                   2. HARDWARE TIMEOUT 
*                   3. TRANSFER TERMINATED BY PPU 
* 
? 
  IF BHCPSTATUS & [ACZERO,AATIMO,AATRTP] " [] 
  THEN
  BEGIN 
    IF ACZERO IN BHCPSTATUS 
    THEN PBHALT (J0CHAIN);                       _ CHAIN ADDRESS ZERO  ?
_?
    IF AATIMO IN BHCPSTATUS 
    THEN CNCECODE := CEINTIMO;                   _ HARDWARE TIMEOUT    ?
_?
    IF AATRTP IN BHCPSTATUS 
    THEN CNCECODE := CEINTERM;                   _ XFR TERM BY PPU     ?
_?
    ADST1.BASET := BHCPSTATUS;                   _ COUPLER STATUS      ?
    ADST2.BALBYT := BHLLCB'.BLLLCB.BLSPART.BLDN;
    PNCEFILE(3);                                 _SEND CE ERROR SM     ?
_?
  END; _ ERROR STATUS ? 
_ 
*              ---- IGNORE ERRORS ON INPUT. 
*                   RELEASE BUFFERS IF SOURCE RETENTION NOT SPECIFIED 
? 
  PBRELCHN (BHCPINPUT,BEDBSIZE);                 _ RELEASE ALL BUFFERS ?
_ 
*              ----- IF ORDERWORD WAS ALSO LOADED GO SERVICE OUTPUT 
? 
12 :  
  IF AAORDR IN BHCPSTATUS                        _ TEST FOR ORDERWORD  ?
  THEN GOTO 20;                                  _ INITIATE OUTPUT     ?
_ 
*              ---- CHECK FOR INPUT ----
* 
*                   CONTROL ALSO COMES HERE FROM A0PT0,1,3,4
? 
13 :  
    IF BHCPINPUT " NIL                           _ WAS INPUT ATTEMPTED ?
    THEN GOTO 14                                 _ GO PROCESS CURRENT  ?
    ELSE
    BEGIN 
      IF PBLSGET (BWWLENTRY[LEVELNO],BHWLCB)     _ CK FOR SEGMENT AVAIL?
_ 
*              ---- QUEUE EMPTY, EXIT 
? 
      THEN
      BEGIN 
        BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME := AIDLETO;  _ IDLE TIMEOUT ?
        BHSTATE  := 0;                           _ SET IDLE STATE      ?
      END  _ NO DATA AVAILABLE ?
_ 
*              ---- DATA AVAILABLE ---- 
? 
      ELSE
      BEGIN 
        BHCPINPUT := BWWLENTRY[LEVELNO].
                     BWPKTPTR;                   _ SEGMENT ADDRESS     ?
14 :    PTHIPSIO (BZTCBPTR);                     _ CALL INPUT ROUTINE  ?
      END;  _ IF PBLSGET ?
_?
_?
    END;  _ CHECK FOR INPUT ? 
_?
  END;   _ INPUT COMPLETE ? 
_?
END;  _ A0PT2 ? 
_$J+? 
_ 
* 
************************************************************************
*                                                                      *
*              * *   S T A T E   T H R E E  --  A 0 P T 3   * *        *
*                                                                      *
************************************************************************
* 
*              ---- INITIALIZE OUTPUT TRANSACTION ----
? 
A0PT3 : BEGIN 
20 :  
    HPCMD := BHCPCONN + ACPIOW;                  _ CMD = INPUT ORDERWOR?
    INST  ($E400,HPCMD,                          _ LDQ   COMMAND       ?
           $0A00,                                _ ENA   0             ?
           $0B04,                                _ SIO                 ?
           $6400,HPPARM);                        _ STA   SAVE          ?
    BHCPDATA.BAINT := HPPARM.BAINT;              _ SAVE ORDWD IN TCB   ?
_ 
*              ---- PROCESS THE ORDER CODE ---- 
? 
    CASE BHCPDATA.BACPOW.BACPOC OF               _ ORDER CODE VALUE    ?
_?
      ABOPL1 : WABFTH := B0TH1LV;                _ SERVICE MESSAGES    ?
      ABOPL2 : WABFTH := B0TH2LV;                _ HIGH PRIORITY DATA  ?
      ABOPL3 : WABFTH := B0TH3LV;                _ LOW PRIORITY DATA   ?
      ABNRIP :                                   _ NOT READY FOR INPUT ?
        BEGIN 
        BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME      _ 15 MILLESEC TIMEOUT  ?
          := 0; 
        PBTMRSRVS(BHPKTPTR);
        BHSTATE := A0PT0;                        _ STATE TO IDLE       ?
        GOTO 40;                                 _ EXIT HIP            ?
        END;  _ CASE ABNRIP ? 
      ABREGC :                                   _ REGULATION CHANGE   ?
        WITH BWWLENTRY[LEVELNO].CMSMLEY,         _ INTERMEDIATE ARRAY  ?
             BHCPREG.BACPREG DO                  _ REGULATION OVERLAY  ?
          BEGIN 
          BACPRG   := BHCPDATA.BACPOW.BACPRC;    _ REG LEVEL           ?
          BACPRS   := BACPRL;                    _ SPECIFIED LEVEL     ?
          CMLTYP   := CPLR;                      _ LINK TYPE           ?
          CMREG    := BACPRG;                    _ REGULATION CHANGE   ?
          CMWKCODE := D0LINK;                    _ WORK CODE           ?
          CMPTR    := BZTCBPTR;                  _ COUPLER CONTROL BLK ?
          PBLSPUT (BWWLENTRY[LEVELNO],BYWLCB     _ NOTIFY SVM MODULE   ?
                     [B0SMWL]); 
          IF BHCPREG.BACPREG.BACPRL = 0          _ IF REGULATION ZERO  ?
          THEN
            BEGIN 
            PBRELZRO (BHCPINPUT, BEDBSIZE);      _ RELEASE DATA        ?
            WHILE (PBLSGET(BWWLENTRY[LEVELNO],   _ WHILE MORE DATA     ?
                   BHWLCB) = FALSE) DO           _ QUEUED RELEASE IT   ?
              PBRELZRO (BWWLENTRY[LEVELNO]. 
                        BWPKTPTR,BEDBSIZE); 
            IF BHCPDEAD = FALSE                  _ IF CPLR WAS UP      ?
            THEN
              BHWLCB.BYNAME := BHWLCB.BYNAME + 1;_ SET FLAG *DEBUG*    ?
            END;
          BHCPDEAD := FALSE;                     _ MARK COUPLER ALIVE  ?
          BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME
                       := AIDLETO;               _ IDLE TIMEOUT        ?
          BHSTATE      := A0PT1;                 _ STATE = IDLE SENT   ?
          HPCMD        := BHCPCONN +             _ CMD = OUTPUT STATUS ?
                          ACPONS; 
          HPPARM.BAINT := AIDLE;                 _ STATUS = IDLE       ?
          BHCPCMD      := HPPARM.BAINT;          _ SAVE LAST NPU STATUS?
                                                 _  SENT               ?
          INST  ($E400,HPCMD,                    _ LDQ COMMAND         ?
                 $C400,HPPARM,                   _ LDA STATUS WORD     ?
                 $0B04);                         _ SIO                 ?
          GOTO 13;                               _ GO CHECK INPUT      ?
          END;  _ CASE ABREGC ? 
  
_?
    END;  _ CASE OF BACPOC ?
_ 
*              ---- COMPUTE NUMBER OF BUFFERS NEEDED ---- 
? 
    WACNT1 := ((BHCPDATA.BACPOW.BACPLN * 16) +   _ NUMBER OF CHARS     ?
              (HPBUFCHAR - 1)) DIV HPBUFCHAR;    _ DIV BY BUFFER LENGTH?
    WACNT  := WACNT1 - BHCPBUFAV;                _ NUMBER TO ALLOCATE  ?
  
    IF ( WACNT > 0 )  &                          _ ARE ANY REQUIRED    ?
       ( PBNBFAVAIL (WACNT1*2, WABFTH))          _ENOUGH BFRS AVAILABLE?
    THEN
    BEGIN 
      BHCPBUFAV := BHCPBUFAV + WACNT;            _ SET NEW COUNT       ?
_ 
*              ---- ALLOCATE NEEDED BUFFERS ----
? 
    WHILE WACNT " 0 DO                           _ LOOP TO ALLOCATE    ?
    BEGIN 
      WABUFT    := PBGET1BF (BEDBSIZE);          _ GET A DATA BUFFER   ?
      WABUFT'.BCCHAINS[DBUFLENGTH] := BHCPAVPTR; _ CHAIN PREV TO CURR  ?
      BHCPAVPTR := WABUFT;                       _ SAVE NEW PREV       ?
      WACNT     := WACNT -1;                     _ DECREMENT COUNT     ?
    END;
    END;
_ 
*              ---- CHECK FOR ENOUGH BUFFERS FOR OUTPUT ----
? 
    IF BHCPBUFAV \ WACNT1                        _ ENOUGHT FOR XFER    ?
    THEN
    BEGIN 
      BHBUFOTT  := BHCPAVPTR;                    _ FIRST BUFFER        ?
      BHCPAVPTR'.BFFCD := BLOCK;                 _1ST BUFFER FCD       ?
_ 
*              ---- OUTPUT MEMORY ADDRESS ----
? 
      HPCMD := BHCPCONN + ACPOMA;                _ CMD = OUTPUT M.A.R. ?
      HPPARM.BABUFPTR := BHBUFOT;                _ SET UP BUFFER ADDR  ?
      INST  ($E400,HPCMD,                        _ LDQ   COMMAND       ?
             $C400,HPPARM,                       _ LDA   BUFFER ADDRESS?
             $0B04);                             _ SIO                 ?
_ 
*              ---- READ STATUS AGAIN, CHECK FOR NO STATUS
*                   LOADED. 
? 
      HPCMD := BHCPCONN + ACPICS;                _ COMMAND = READ STAT ?
      INST  ($E400,HPCMD,                        _ LDQ   COMMAND       ?
             $0B04,                              _ SIO                 ?
             $6400,HPPARM);                      _ STA   SAVE STATUS   ?
      BHCPSTATUS := HPPARM.BASET;                _ SAVE STATUS IN TCB  ?
      IF ACPSRL IN BHCPSTATUS                    _ WAS NPU STATUS READ ?
      THEN                                       _ NO - DELAY OUTPUT   ?
      BEGIN 
        BHSTATE  := A0PT5;                       _ DELAY RETURN        ?
        BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME := 1; _ QUICK TIMEOUT       ?
      END 
      ELSE
      BEGIN 
        HPCMD := BHCPCONN + ACPONS;              _ CMD = OUT. STATUS   ?
        HPPARM.BAINT := AAREADY;                 _ STATUS = RDY FOR O. ?
        BHCPCMD := HPPARM.BAINT;                 _ SAVE LAST NPU STATUS?
        INST  ($E400,HPCMD,                      _ LDQ   COMMAND       ?
               $C400,HPPARM,                     _ LDA   STATUS VALUE  ?
               $0B04);                           _ SIO                 ?
        BHSTATE := A0PT4;                        _ SET UP RETURN       ?
      END;
    END                                          _ FOR OUTPUT          ?
_ 
*              ---- NOT READY FOR OUTPUT ---- 
? 
    ELSE
    BEGIN 
      IF ACPSRL IN BHCPSTATUS                    _ WAS NPU STATUS READ ?
      THEN
      BEGIN 
        BHSTATE  := A0PT6;                       _ DELAY RETURN        ?
        BLSTIMTBL[BZLINO.BDSUBPORT].BLTIME := 1; _ QUICK TIMEOUT       ?
      END 
      ELSE
      BEGIN 
        HPCMD := BHCPCONN + ACPONS;              _ CMD = OUT. STATUS   ?
        HPPARM.BAINT := AANREADY;                _ STATUS = NOT RDY    ?
        BHCPCMD := HPPARM.BAINT;                 _ SAVE LAST NPU STATUS?
        INST  ($E400,HPCMD,                      _ LDQ   COMMAND       ?
               $C400,HPPARM,                     _ LDA   STATUS WORD   ?
               $0B04);                           _ SIO                 ?
        GOTO 13;                                 _ GO CHECK INPUT      ?
      END;
    END;  _ NOT READY FOR OUTPUT  ? 
_?
END;  _ A0PT3 ? 
_$J+? 
_ 
* 
************************************************************************
*                                                                      *
*              * *   S T A T E   F O U R  --  A 0 P T 4   * *          *
*                                                                      *
************************************************************************
* 
*              ---- OUTPUT TERMINATION LOGIC ---- 
? 
_ 
*              ---- CHECK STATUS FOR COMPLETION : 
* 
*                   1. CHAIN ADDRESS ZERO 
*                   2. HARDWARE TIMEOUT 
*                   3. TRANSFER TERMINATED BY PPU 
*                   4. TRANSFER COMPLETE
*                   5. ORDERWORD LOADED 
* 
? 
A0PT4 : BEGIN 
  IF BHCPSTATUS & [ACZERO,AATIMO,AATRTP,AATXCP,AAORDR] " [] 
  THEN
_ 
*              ---- CHECK FOR HARDWARE TIMEOUT AND TRANSFER 
*                   TERMINATED BY PPU 
? 
  BEGIN 
    IF BHCPSTATUS & [AATIMO,AATRTP] = []
    THEN
_ 
*              ---- CHECK FOR CHAIN ADDRESS ZERO ---- 
? 
    BEGIN 
      IF ACZERO IN BHCPSTATUS                    _ CK FOR CHAIN ADDR 0 ?
      THEN PBHALT (J0CHAIN)                      _ CHAIN ADDRESS ZERO  ?
_ 
*              -- NOT CHAIN ADDRESS ZERO ---- 
? 
      ELSE
        IF NOT (AATXCP IN BHCPSTATUS)            _ CK FOR XMIT CMPL    ?
        THEN GOTO 33                             _ GO TO ERROR ROUT.   ?
        ELSE
_ 
*              ---- NORMAL OUTPUT COMPLETION ---- 
? 
        BEGIN 
          WADLBF := BHCPAVPTR;                   _ SAVE DOWN-LINE DATA ?
_ 
*              ---- FIND LAST BUFFER ---- 
? 
          HPCMD := BHCPCONN + ACPRMA;            _ CMD = READ M.A.R.   ?
  
          INST ($E400,HPCMD,                     _ LDQ   COMMAND       ?
                $0B04,                           _ SIO                 ?
                $6400,WABUFT);                   _ STA   SAVE LAST BUFF?
          BHCPAVPTR := WABUFT'.BCCHAINS          _ SET UP NEW FIRST    ?
                       [DBUFLENGTH];             _ AVAIL BUFFER        ?
          WABUFT'.BCCHAINS[DBUFLENGTH] := NIL;   _ CLEAR CHAIN WORD    ?
          WACNT     := 0;                        _ CLEAR COUNTER       ?
          WABUFT    := BHCPAVPTR;                _ SET UP NEW FIRST    ?
          WHILE WABUFT " NIL DO                  _ LOOP TO FIND NUMBER ?
          BEGIN 
            WACNT  := WACNT + 1;                 _ INCREMENT COUNT     ?
            WABUFT := WABUFT'.BCCHAINS[DBUFLENGTH]; _ CHAIN TO NEXT    ?
          END;
          BHCPBUFAV := WACNT;                    _ SAVE NEW AVAIL CNT  ?
_ 
*              ---- FORWARD BLOCK TO INTERNAL PROCESS ----
? 
          PBSWLE (WADLBF);                       _ SEND WLE TO BIP     ?
          GOTO 12;                               _ GO CHECK INPUT QUEUE?
        END;  _ NORMAL OUTPUT COMPLETION ?
_?
    END  _ NOT HARDWARE T/O OR XFER TERM. ? 
_ 
*              ---- BLOCK RECEIVED IN ERROR ----
? 
    ELSE
33 :BEGIN 
_ 
*              ---- RELEASE ALL OUTPUT BUFFERS ---- 
? 
      PBRELCHN (BHCPAVPTR,BEDBSIZE);        _ RELEASE BUFFERS          ?
                                                 _ RELEASE EACH BUFFER ?
      BHCPBUFAV := 0;                            _ CLEAR BUFFER COUNT  ?
_ 
*              ---- SET UP CE ERROR MESSAGE ----
? 
      IF AATRTP IN BHCPSTATUS 
      THEN CNCECODE := CEOUTERM                  _ OUTPUT TERM BY PPU  ?
_?
      ELSE IF AATIMO IN BHCPSTATUS
      THEN CNCECODE := CEOUTIMO                  _ HARDWARE TIMEOUT    ?
_?
      ELSE CNCECODE := CETXCMIS;                 _ EOP MISSING         ?
_?
      GOTO 01;                                   _ MAKE CE ENTRY       ?
                                                 _ AND CK INPUT QUEUE  ?
_?
    END;  _ ERROR ? 
_?
  END;  _ OUTPUT COMPLETE ? 
_?
END;  _ A0PT4  ?
_ 
* 
*              * *   E N D   O F   C A S E
* 
*                    S T A T E M E N T
? 
    END;  _ CASE ?
_?
40 :  
  END;  _ WITH ?
_?
END;  _ PTHIPINT ?
