         TITLE    'PIGEON DESCRIPTION'
*M*      PIGEON   DRIVER MODULE FOR 'PIGEON GHOST'
*
***********************************************************************
*P*
*P*      NAME:    PIGEON
*P*
*P*      PURPOSE: PIGEON IS USED TO:
*P*                    1.  TRANSMIT ALL OPERATOR 'SEND' KEYINS
*P*                    2.  GHOST ALL TAPE ERROR MESSAGES PRINTED ON
*P*                                 THE OPERATORS CONSOLE AND ALSO THE
*P*                                 OPERATORS RESPONSE.
*P*
*P*      DESCRIPTION:   PIGEON IS INITIATED AS A GHOST JOB BY 'KEYIN',
*P*               TEL, OR THE I/O SYSTEM WHENEVER A MESSAGE NEEDS TO
*P*               BE TRANSMITTED TO ONE OR ALL ON-LINE USERS.
*P*               PIGEON OBSERVED THE PROTOCALL OF NOT SATURATING THE
*P*               COC BUFFERS, NOT FLOODING ANY PARTICULAR USER WITH
*P*               OUTPUT CHARACTERS, AND HONORING ANY USER'S REQUEST TO
*P*               HAVE SUCH BROADCASTS DEFFERED OR IGNORED.
*P*
*P*               PIGEON CAN ALSO BE INITIATED AS EITHER A BATCH JOB
*P*               OR AS AN ON-LINE JOB.  INPUT IS READ FROM M:SI.
*P*
***********************************************************************
*
*D*      NAME:    PIGEON
*D*
*D*      CALL:    VIA T:GJOBSTRT SPECIFYING 'PIGEON' OR AS AN
*D*               ON-LINE OR BATCH JOB
*D*
*D*      INTERFACE:
*D*
*D*      ENVIRONMENT:  EXECUTED MAPPED MASTER MODE (UNPROTECTED)
*D*
*D*      INPUT:
*D*
*D*      OUTPUT:
*D*
*D*      DESCRIPTION:  PIGEON IS INITIATED AS A GHOST JOB BY KEYIN, TEL
*D*               OR THE I/O SYSTEM WHENEVER A MESSAGE NEEDS TO BE
*D*               TRANSMITTED TO ONE OR ALL ON-LINE USERS.
*D*
*D*               THE MESSAGE REQUEST IS CHAINED ON PIGHEADS CHAIN
*D*               OF REQUESTS TO BE PERFORMED.  PIGEON WHEN AWAKENED
*D*               REMOVES ALL ENTRIES FROM THE CHAIN AND MOVES THE
*D*               CONTENTS TO ITS OWN CHAIN.  IT THEN FREES UP
*D*               THE COC BUFFERS/MPOOLS BACK TO THE SYSTEM.
*D*               PIGEON THEM COMMENCES TO PROCESS THE CHAIN ON
*D*               MESSAGE REQUESTS.
*D*
*D*               IN THE CASE OF A 'SEND,ALL' KEYIN, KEYIN WILL HAVE
*D*               MOVED THE MESSAGE TEXT INTO THE 'COCMESS' BUFFER
*D*               SUCH THAT IT IS POSSIBLE TO DEFER SUCH 'SEND'
*D*               KEYINS UPON A USER'S REQUEST (VIA THE 'DONT SEND'
*D*               TEL COMMAND OR VIA A CAL1,8 WITH AN FPT CODE OF X'06').
*D*               KEYIN WILL THEN CHAIN A 'SEND,ALL' REQEUEST ON PIGEONS
*D*               CHAIN OF THINGS TO DO AND THEN START UP PIGEON.
*D*
*D*               IN THE CASE OF A 'SEND,ID' KEYIN, KEYIN WILL MOVE THE
*D*               MESSAGE TEXT TO AN MPOOL AND CHAIN A 'SEND,ID' REQUEST
*D*               ON PIGEONS CHAIN OF THINGS TO DO AND THEN START UP
*D*               PIGEON.  PIGEON WILL THEN ATTEMPT TO SEND THE MESSAGE
*D*               TO THE USER.  IF UNABLE TO DO SO THE OPERATOR WILL BE
*D*               NOTIFIED.
*D*
*D*
*D*
*D*
         TITLE    'PIGEONS REFS'
*
*
         REF      NEWQ              * USED TO DETERMINE CORRECT MONSTK
*
         REF      J:JIT             * ADDRESS OF THE JIT
*
         REF      HRBA              * USED TO CALCULATE # AVAILABLE COC BUFS
*
         REF      PIGHEAD           * HEAD OF BUFFER CHAIN IN THE MONITOR
*
         REF      ECBFBLK           * ROUTINE TO GIVE BACK COC BUFFER
*
         REF      ECBGBLK           * ROUTINE TO GET COC BUFFER
*
         REF      AVRTBLSIZ         * NUMBER OF TAPE AVR TABLE ENTRIES
*
         REF      BATAPE            * DCTX OF FIRST TAPE
*
         REF      DCTSIZ            * NUMBER OF DCT INDEXES
*
         REF      DCT16             * TEXTC DEVICE ADDRESS
*
         REF      LNOL              * MAXIMUM NUMBER OF COC LINES
*
         REF      LB:UN             * COC TABLE CONTAINING USER #
*
         REF      RMB               * ROUTINE TO RELEASE MPOOL
*
         REF      GETUSER#          * TO VERYIFY USER #
*
         REF      COB:CPS           * TO DETERMINE TERMINAL BLOCK LIMIT
*
         REF      COB:MNIC          * TO SEND MAX # IDLES AFTER CR
*
         REF      COCDSABL          * TO DISABLE COC INTERRUPTS
*
         REF      COCENABL          * ENABLE COC INTERRUPTS
*
         REF      COCII             * TO CHECK FOR INPUT RECEIVED
*
         REF      COCOC             * TO CALCULATE # OUTPUT CHARACTERS
*
         REF      COCOTV            * TO TRANSLATE CHARATERS
*
         REF      COCSENDX          * TO SEND CHARACTERS TO TERMINAL
*
         REF      COCTERM           * TO DETERMINE TERMINAL-TYPE
*
         REF      COC#BUFS          * CHECK FOR PENDING BUFFER DEPLETION
*
         REF      CPOS              * TO RE-POSITION CARRIAGE FOR USER
*
         REF      ECHOCR2           * TO UPDATE TERMINAL LINE COUNT
*
         REF      J:TELFLGS         * TO BUILD 'DEFER' DO-LIST ITEM
*
         REF      MODE              * TO CHECK 'TRANSPARENT BIT'
*
         REF      MODE2             * TO CHECK FOR 2741 TERMINAL TYPE
*
         REF      MODE4             * TO DETERMINE TERMINAL BLOCK LIMIT
*
         REF      MODE4INIT         * TO DETERMINE LINE SPEED
*
         REF      MODE5             * TO CHECK 'DS'/'TPSLAVE' BITS
*
         REF      MODE6             * TO CHECK FOR HALF DUPLEX LINES
*
         REF      SL:TB             * TO DETERMINE TERMINAL BLOCK LIMIT
*
         REF      MASKS             *  MASKS
*
         REF      T:DEFER           * TO BUILD 4-WORD DO-LIST BLOCK
*
         REF      UH:DL             * TO CHAIN 4-WORD DO-LIST BLOCK
*
         REF      UH:FLG            TO SEE IF USER IS IN TEL
*
         REF      #DLBLKS           * TO CALCULATE MAX # 4-WD BLOCKS AVAIL
*
         SREF     T:TURNOUT         * TO TURN HALF-DUPLEX LINES TO OUTPUT
*
*
*
         TITLE    'PIGEONS DEFS'
*
         DEF      PIGDD             *  DYNAMIC DATA START
*
         DEF      PIGPD             *  STATIC DATA START
*
         DEF      PIGPP             *  CODE START
*
         DEF      PIGEON            *  START OF PIGEON
*
         DEF      PATCH             *  START OF PATCH AREA
*
*
         TITLE    'PIGEONS EQUATES'
*
*
*
*        REGISTER DEFINITIONS
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
*
CC1      EQU      8                 * CONDITION CODE 1
CC2      EQU      4                 * CONDITION CODE 2
CC3      EQU      2                 * CONDITION CODE 3
CC4      EQU      1                 * CONDITION CODE 4
*
*
BHDIN    EQU      CC2               * HALF DUPLEX INPUT CC
TRANSPARENT EQU   CC3               * TRANSPARENT LINE CC
TPSLAVE  EQU      CC1               * TP SLAVE LINE
DS       EQU      CC3               * DONT SEND FLAG
*
*
FAIL     EQU      CC1               * FAIL RET    CC
PASS     EQU      CC2               * PASS RET    CC
*
*
EMPTY    EQU      CC3               * MONITOR CHAIN WAS EMPTY
DEFER    EQU      CC3               * TERMINAL IN STATE REQUIRING DEFER
*
         PAGE
*
*        COMMUNICATION BUFFER FORMAT AND EQUATES
*
************************************************************
*             *              *              *              *
*             *              *              *              *
*                      LINK FIELD                          *   WORD 0
*             *              *              *              *
*             *              *              *              *
************************************************************
*             *              *              *              *
*             *              *              *              *
*   TYPE      *    PASS      *   ORIGINAL   *    USER      *
*  BLOCK      *   NUMBER     *    TYPE      *   NUMBER     *   WORD 1
*             * /ANS FLG     *              *              *
*             *              *              *              *
************************************************************
*             *              *              *              *
*       LINE NUMBER                 *    *  DCT INDEX *
*             *              *              *              *
*----------------------------------------------------------*   WORD 2
*                                                          *
*             'ALL' OR 'ID' OR SERIAL # OR 'O/S: '         *
*                                                          *
************************************************************
*             *              *              *              *
*             *              *              *              *
* COC BUF CNT *                                            *
* / CHAR CNT  *              MESSAGE ADDRESS/INDEX         *   WORD 3
* /DCT INDEX  *              *              *              *
*             *              *              *              *
************************************************************
*
*
TYPE     EQU      4                 * DISPLACEMENT OF TYPE FIELD
ORIG:TYPE EQU     6                 * DISPLACEMENT OF ORIGINAL TYPE FIELD
*
*
DCTX     EQU      12                * DISPLACEMENT OF DCT ONDEX FIELD
*
ANSX     EQU      5                 * DISPLACEMENT TO ANS INDEX
*
SERIAL#  EQU      2                 * DISPLACEMENT TO SERIAL #
*
COCBUFCNT EQU     12                * DISPLACEMENT OF COC BUF COUNT
*
CHARCNT  EQU      12                * DISPLACMENT TO CHAR COUNT
*
MSGX     EQU      3                 * DISPLACEMENT TO MSG ADDRESS
*
USER#    EQU      7                 * DISPLACEMENT OF USER NUMBER
*
LINE#    EQU      4                 * DISPLACEMENT OF LINE NUMBER
*
WORD:2   EQU      2                 * DISPLACEMENT OF WORD 2
*
LASTPASS EQU      5                 * DISPLACEMENT TO LAST PASS COUNT
*
*
*        MISCELLANEOUS EQUATE
*
END:OF:FILE EQU   X'06'             * ABNORMAL CODE FOR END OF FILE
*
TYPE:1   EQU      1                 * TYPE:1 VALUE 1
*
TYPE:2   EQU      2                 * TYPE:2 VALUE 2
*
TYPE:3   EQU      3                 * TYPE:3 VALUE 3
*
TYPE:4   EQU      4                 :  TYPE:4 VALUE 4
*
TIC      EQU      X'0080'           TEL-IN-CONTROL BIT IN UH:FLGS
MAX#LINES EQU     512               * MAX # COC LINES = 8 7611'S
*
*
         TITLE    'PIGEONS SYSTEMS, PROCS, AND CONTROL SECTION'
*
*
*
         SYSTEM   SIG7FDP           * INSTRUCTION SET
*
         SYSTEM   BPM               * SYSTEM CALLS
*
,PT0,PT1 M:PT     1                 * SET ALL FPTS TO PROTECTION TYPE 1
*
         LIST,1   1                 * PRINT ONLY FIRST WORD OF ITERATIONS
*
*
PIGDD    CSECT    0                 DEFINE PIGEONS DATA
*
PIGPD    CSECT    1                 DEFINE PIGEOND PROCEDURE DATA
*
PIGPP    CSECT    1                 DEFINE PIGEONS PROCEDURE CODE
*
*
M:SI     DSECT    1                 M:SI DCB
M:SI     M:DCB    (FILE),(DEVICE,'SI'),(ASN,DEVICE)
*
*        DEFINE CALL PROC
*
CALL     CNAME
         PROC
LF       EQU      %
         LI,R15   %+3
         PSW,R15  RETURN:STACK      SAVE RET
         B        AF(1)             GO TO ROUTINE
*
*        DEFINE RETURN STACK IF NOT ALREADY DEFINED
*
         LIST     0
         DO       TCOR(RETURN:STACK,S:FR)
         LOCAL    X
X        SET      %
         USECT    PIGDD
         DEF      RETURN:STACK      * DEF THE ADDRESS OF THE RETURNSTACK
         BOUND    8
RETURN:STACK EQU  %
         DATA     %+1
         DATA,2   20,0
         DO1      20
         DATA     C'NULL'
         USECT    X
         FIN
         LIST     1
         PEND
*
*
*        DEFINE RET, RET:FAIL, RET:PASS, RETC PROCS
*
*
RET      CNAME    0
RETC     CNAME    1
         PROC
LF       EQU      %
         DO       NAME(1)=0
         DO       TCOR(RETRN,S:FR)  SEE IF RETURN IS DEFINED
*
         DEF      RETRN             DEFINE RETURN
*
RETRN    EQU      %
         PLW,R15  RETURN:STACK      RESTORE RETURN
         B        *R15              RETURN
*
         ELSE
*
         BAL,R15  RETRN             USE BAL SO KNOW WHERE WE CAME FROM
*
         FIN
*
*
         ELSE
*
*
         LOCAL    X
X        SET      NUM(AF)+SCOR(AF(1),PASS,FAIL)
*
         DO       X=0
         BAL,R15  RETURNCC
         FIN
*
         DO       X=1
         LCI      AF(1)&X'F'        LOAD TYPE OF RETURN
         BAL,R15  RETURNCC          GO TO THE EXIT POINT
         FIN
*
         DO       X=2               PASS
         DO       TCOR(RETURN:PASS,S:FR)
         BAL,R15  RETURN:PASS       GO TO THE ROUTINE
RETURN:PASS EQU   %
         PLW,R15  RETURN:STACK      GET RETURN
         LCI      PASS&X'F'         INDICATE PASS
         B        *R15              RETURN
         ELSE
         BAL,R15  RETURN:PASS
         FIN
         FIN
*
         DO       X=3               FAIL
         DO       TCOR(RETURN:FAIL,S:FR)
         BAL,R15  RETURN:FAIL
RETURN:FAIL EQU   %
         PLW,R15  RETURN:STACK      GET RETURN
         LCI      FAIL&X'F'
         B        *R15              RETURN
         ELSE
         BAL,R15  RETURN:FAIL
         FIN
         FIN
         DO       TCOR(RETURNCC,S:FR)
RETURNCC EQU      %
         STCF     *RETURN:STACK     SAVE TYPE OF RETURN
         PLW,R15  RETURN:STACK
         LCF      R15               RESTORE CODITION CODES
         B        *R15              AND RETURN
         FIN
*
*
         FIN
*
*
*
         PEND
*
*
*
*
*
*        DEFINE ENABLE/DISABLE PROCS
*
ENABLE   CNAME    X'27'
DISABLE  CNAME    X'37'
         PROC
LF       WD,0     NAME(1)
         PEND
*
*
*        DEFINE TEST RETURN PROC
*
*
TEST     CNAME
         PROC
LF       GEN,1,7,4,3,17 AFA(1),X'69',CF(2),AF(2),AF(1)
         PEND
*
*
*
*
*
*
         TITLE    'PIGEONS DATA'
*
*
*
         USECT    PIGDD             * PROTECTION TYPE 0
*
PIG:HD   DATA     0                 * HEAD OF PIGEONS TASK CHAIN
*
PIG:FREE:HD DATA  0                 * HEAD OF PIGEONS FREE BLOCK CHAIN
*
PIG:CUR  DATA     0                 * ADDRESS OF CURRENT RUNNING TASK ENTRY
*
PIG:NEXT DATA     0                 * ADDRESS OF NEXT BLOCK TO PROCESS
*
PIG:MODE DATA     0                 * TYPE OF RUNNING MODE
*                                   *    0 = GHOST
*                                   *    1 = BATCH/ON-LINE
GMAXBUF  DATA     0                 * CALCULATED MAX BUFFERS/GLOBAL
*
MAX#DLBLKS DATA   0                 * CALCULATED MAX # D-L BLOCKS
*
TEMP:SIZE DATA    0                 * SIZE OF CURRENT ENTRY IN TEMP:BUF
*
CUR:CHAR DATA     0                 * CURRENT CHARACTER WORD AND BYTE INDEX
*
TEMP:ADR DATA     BA(TEMP:BUF)      * CURRENT POINTER TO END OF DATA IN TEMP:BUF
*
TEMP:BUF RES      20                * TEMPARARY BUFFER
*
PIG:BREAK DATA    0                 * FLAG TO INDICATE BREAK OCCURED
*
REPLY:MSG DATA    0                 * REPLY IN RESPONE TO QUITE MSG
*
ECB      DATA     0                 * ECB TO WAIT FOR KEYIN
*
SEND:COUNT DATA   0                 * COUNT OF # BLANKS TO SEND
*
INPUT:BUFFER RES  80/4              * INPUT BUFFER FOR NON GHOST
*
BROADCAST DATA    0                 * 0 = NO BROADCAST IN PROGRESS
*                                   * 1 = BROADCAST IN PROGRESS
SKIPFLAG DATA     0                 * FLAG INDICATING SKIPPED USER
*
STATUS   EQU      %                 * TABLE USED TO INDICATE MESSAGE SENT
         DO       MAX#LINES/4
         DATA     0
         LIST     0
         FIN
         LIST     1
*
PATCH    EQU      %                 *  PATCH AREA
         DO       50
         DATA     0
         LIST     0
         FIN
         LIST     1
*
*
         TITLE    'PIGEON DRIVER'
*
***********************************************************************
*
*D*      NAME:    PIGEON
*D*
*D*      DESCRIPTION:  THIS IS THE BASIC DRIVER FOR PIGEON.
*D*               IT PERFORMS INITIALIZATION, GETTING INPUT,
*D*               PROCESSING THE INPUT DATA, AND TERMINATING.
*D*
*D*      INPUT:   NONE
*D*
*D*      OUTPUT:  NONE
*D*
************************************************************************
*
*
         USECT    PIGPP             CHANGE TO PROCEDURE CODE
*
*
PIGEON   EQU      %
         CALL     PIG:INIT          PERFORM INITIALIZATION
         TEST,FAIL PIGEON:80        FAIL-->BRANCH
PIGEON:50 EQU     %
         CALL     PIG:GET           GET SOMETHING TO DO
         TEST,FAIL PIGEON:80        FAIL-->BRANCH
         TEST,EMPTY PIGEON:90       LETS GO EXIT IF NOTHING TO DO
         CALL     PIG:PROCESS       GO PROCESS SOMETHING GOTTEN
         CALL     CHECK:BRK         SEE IF USER WANTS  OUT
         TEST,PASS PIGEON:90        YES-->BRANCH
         B        PIGEON:50         LOOP
*
PIGEON:80 EQU     %
         M:EXIT   4                 EXIT THE SCENE WITH STEP CC = 4
*
*
PIGEON:90 EQU     %
         LC       J:JIT             RUNNING GHOST?
         BCR,4    PIGEON:95         IF NOT GO EXIT
         CALL     WAIT:25
         B        PIGEON:50
PIGEON:95 EQU     %
         M:EXIT   0                 EXIT THE SCENE WITH STEP CC = 0
*
         TITLE    'PIGEON INITIALIZATION'
*
***********************************************************************
*D*
*D*      NAME:    PIG:INIT
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL PERFORM BASIC INITIALIZATION.
*D*
*D*      INPUT:   NONE
*D*
*D*      OUTPUT:  CONDITION CODES SET AS FOLLOWS:
*D*                                 CC1 = FAIL
*D*                                 CC2 = PASS
*D*
*D*
***********************************************************************
*
PIG:INIT EQU      %
         M:SYS                      GO MASTER/UNPROTECTED
         BCR,CC1  INIT:10           X'C0' PRIV-->BRANCH
         LI,R14   LOW:PRIV:MSG      'UNABLE TO OBTAIN MASTER MODE'
         CALL     PRINT:MSG         GO PRINT MESSAGE
         RETC     FAIL              INDICATE WE FAILED
INIT:10  EQU      %
         CI,R10   NEWQ              SEE IF LOADED WITH CORRECT MONSTK
         BE       INIT:20           RIGHT MONSTK-->BRANCH
         LI,R14   BAD:MONSTK:MSG    'BAD MONSTK'
         CALL     PRINT:MSG         GO PRINT THE MESSAGE
         RETC     FAIL              INDICATE WE FAILED
INIT:20   EQU     %
*
         LC       J:JIT             ARE WE NON GHOST
         BCS,4    INIT:30           GHOST-->BRANCH
         M:PC     '>'               SET PROMPT CHARACTER
*
*        NOTE     ABNORMAL RETURN IS TO CAL + 2
*
         M:OPEN   M:SI,(ERR,M:SI:ERR),(ABN,M:SI:ABN)
         B        INIT:30           OPEN OK-->BRANCH
*
INIT:25  EQU      %
         LI,R14   BAD:OPEN:MSG      INDICATE UNABLE TO OPEN M:SI
         CALL     PRINT:MSG         PRINT THE ERROR
         RETC     FAIL              INDICATE THAT WE FAILED
INIT:30  EQU      %
*
*        CALCULATE GLOBAL MAX # OF COC BUFFERS TO USE
*                 75 % OF TOTAL COC BUFFERS
*
         LI,R1    HRBA              # COC BUFFERS * 4
         MI,R1    3                 * 3
         SAS,R1   -4                / 16
         STW,R1   GMAXBUF           GLOBAL MAX = 75% OF TOTAL
*
*        CALCULATE TOTAL NUMBER OF DO LIST BLOCKS TO USE
*                 12.5 % OF TOTAL COC BUFFERS
*
         LI,R1    HRBA              # COC BUFFERS * 4
         SAS,R1   -5                / 32
         STW,R1   MAX#DLBLKS        MAX D-L BLKS = 12.5% OF TOTAL
*
*        SET UP BREAK ROUTINE ADDRESS
*
         M:INT    PIG:BREAK:RTN     IF AN INT OCCURS PROCESS IT
         RETC     PASS              INDICATE EVERYTHING OK
*
         TITLE    'PIGEON GET SOMETHING TO DO'
**********************************************************************
*D*
*D*      NAME:    PIG:GET
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL GET A BLOCK TO PROCESS.
*D*               IF RUNNING IN GHOST MODE IT WILL GET THE BLOCKS
*D*               FROM THE MONITORS CHAIN AND CURRENT TASK CHAIN.
*D*
*D*               IF RUNNING ONLINE OR BATCH IT WILL CALL ONLINE INPUT
*D*               TO READ FOR SOMETHING TO DO.
*D*
*D*
***********************************************************************
*
PIG:GET  EQU      %
         LC       J:JIT             ARE WE GHOST
         BCR,4    GET:30            NON GHOST-->BRANCH
         CALL     MON:PIG           GET STUF OFF MON CHAIN
         TEST,PASS  GET:10          OK-->BRANCH
         RETC                       RETURN BACK WITH THE FAILURE
GET:10        EQU %
         LW,R1    PIG:NEXT          GET THE NEXT    ENTRY
         BNEZ     GET:20            FOUND-ENTRY-->BRANCH
         LW,R1    PIG:HD            IS THERE ANYTHING TO DO
         BNEZ     GET:20            FOUND ENTRY-->BRANCH
         RETC     EMPTY             INDICATE NOTHING TO DO
GET:20         EQU %
         STW,R1   PIG:CUR           SAVE ADDRESS OF ENTRY TO PROCESS
         LW,R1    0,R1              GET THE FORWARD LINK OF NEXT ONE TO
*                                        PROCESS
         STW,R1   PIG:NEXT          AND SAVE AS NEXT TO PROCESS
         RETC     PASS
*
GET:30      EQU   %
         CALL     ONLINE:INPUT      GET ONLINE INPUT
         RETC                       RETURN WITH EMPTY OR ERROR
         TITLE    'PIGEON PROCESSING ROUTINE'
*
***********************************************************************
*
*D*      NAME:    PIG:PROCESS
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL CALL THE APPROPRIATE
*D*               ROUTINE BASED ON THE BLOCK TYPE.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*
***********************************************************************
*
PIG:PROCESS EQU   %
         LI,R1    TYPE              GET THE TYPE DISPLACEMENT
         LB,R2    *PIG:CUR,R1       GET THE TYPE OF BLOCK
         B        %+1,R2            BRANCH TO THE APPROPRIATE ROUTINE
         B        PROCESS:10        TYPE 0 = DEVICE ERROR MESSAGE
         B        PROCESS:20        TYPE 1 = SEND MESSAGE
         B        PROCESS:30        TYPE 2 = PREPROCESSED SEND,ALL
         B        PROCESS:40        TYPE 3 = PREPROCESSED SEND,ID
         B        PROCESS:50        TYPE 4 = PREPROCESSED SEND,ALL
*                                        WHILE BROADCAST IN PROGRESS
         B        PROCESS:60        TYPE 5 = MOUNT (OPERATOR/SYSTEM)
*
PROCESS:10 EQU    %
         CALL     PROC:TYPE:0       PROCESS TYPE 0
         TEST,PASS PIG:PROCESS      PROCESS IT AGAIN
         RETC                       RETURN BACK THE FAILURE
*
PROCESS:20 EQU    %
         CALL     PROC:TYPE:1       PROCESS TYPE 1
         TEST,PASS PIG:PROCESS      PROCESS IT AGAIN
         RETC                       RETURN BACK THE FAILURE
PROCESS:30 EQU    %
         CALL     PROC:TYPE:2       PROCESS TYPE 2
         RETC                       RETURN BACK THE ANSWER MUST BE PASS
PROCESS:40 EQU    %
         CALL     PROC:TYPE:3       PROCESS TYPE 3
         TEST,FAIL PROCESS:47       FAIL TO SEND-->BRANCH
         TEST,PASS PROCESS:44       SENT-->BRANCH
*
*        DEFERED ID
*
         LI,R1    ORIG:TYPE         SEE IF ORIGINAL TYPE WAS DEVICE ERROR
         LB,R2    *PIG:CUR,R1       WHICH WAS TYPE 0
         BEZ      PROCESS:44        TYPE 0-->BRANCH
         CI,R2    5                 OR TYPE 5
         BE       PROCESS:44        TYPE 5-->BRANCH
         LI,R14   DEFER:ID:MSG      INDICATE FAILURE
         CALL     PRINT:MSG         PRINT IT
PROCESS:44 EQU    %
         CALL     DECHAIN:BLOCK     DECHAIN THE BLOCK
         RETC     PASS              GET OUT
PROCESS:47 EQU    %
         LI,R1    LASTPASS          SEE IF ITS THE LAST TIME
         MTB,0    *PIG:CUR,R1       BY CHECKING LAST PASS
         BLZ      PROCESS:44        YES-->BRANCH
         LC       J:JIT             SEE IF ON-LINE OR BATCH
         BCS,4    PROCESS:49        GHOST-->BRANCH
         CALL     CHECK:BRK         SEE IF BREAK OCCURED
         TEST,FAIL PROCESS:40       TRY TO SEND AGAIN IF NO BREAK
PROCESS:49 EQU    %
         RETC     PASS              GET OUT WITH EVERYTHING OK
PROCESS:50 EQU    %
         CALL     PROC:TYPE:4       PROCESS TYPE 4
         TEST,PASS PIG:PROCESS      IF OK-->BRANCH
         RETC     PASS              GO ON TO NEXT THING
*
PROCESS:60 EQU    %
         CALL     PROC:TYPE:5       PROCESS TYPE 5
         TEST,PASS PIG:PROCESS      IF OK-->BRANCH
         RETC     PASS              GO ON TO THE NEXT THING
*
*
         TITLE    'PIGEON PROCESS TYPE 0 MESSAGES'
*
***********************************************************************
*
*D*      NAME:    PROC:TYPE:0
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL CONVERT A TYPE 0
*D*               (DEVICE MSG) INTO A TYPE 3 (PROCESSED MSG).
*D*               IT WILL VERIFY THE DCT INDEX.
*D*               IT WILL BUILD THE MESSAGE AND CHAIN IT ON THE MSG CHAIN.
*D*               IT WILL OBTAIN THE LINE # AND STORE IT.
*D*
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  BLOCK POINTED TO BY PIG:CUR CHANGED TO TYPE 3
*D*               OR DELETED BLOCK.
*D*
*D*
***********************************************************************
*
PROC:TYPE:0 EQU   %
         LI,R4    BA(TEXTC:LEFT:PAREN)  MOVE IN A LEFT  PAREN FOR SN
         CALL     TEXTC:TO:TEMP:INIT  MOVE RIGHT PAREN TO BUFFER
         CALL     CHECK:SN          PROCESS THE SERIAL #
         LI,R4    BA(TEXTC:RIGHT:PAREN) MOVE IN A RIGHT PAREN
         CALL     TEXTC:TO:TEMP     MOVE IT
         LI,R2    DCTX              GET THE DCTX DISPLACEMENT
         LB,R1    *PIG:CUR,R2       GET THE DCT INDEX
         BEZ      TYPE:0:30         ZERO-->BRANCH
         CI,R1    DCTSIZ            CHECK IT FOR VALIDITY
         BG       TYPE:0:30         INVALID-->BRANCH
         LI,R4    DCT16             GET ADDRESS OF DCT16
         SLS,R1   1                 CONVERT DOUBLEWORD INDEX TO WORD INDEX
         AW,R4    R1                ADD IN TO CALC WORD OF DCT16
         LCI      2                 GET THE MESSAGE
         LM,R4    *4                INTO OUR BUFFER
         STM,R4   INPUT:BUFFER      SO WE CAN CHANGE BYTE COUNT
         MTB,2    INPUT:BUFFER      CHANGE FROM 5 TO SEVEN BYTES
         LI,R4    BA(INPUT:BUFFER)  SET UP BYTE ADDRESS OF MESSAGE
         CALL     TEXTC:TO:TEMP     MOVE TEXTC TO BUFFER
         LI,R3    MSGX              GET MESSAGE INDEX
         LW,R4    *PIG:CUR,R3       GET THE MESSAGE INDEX/ADDRESS
         AND,R4   HEX00FFFFFF       GET THE ANDRESS PORTION ONLY
         CI,R4    MAX:MSG:INDEX     IS IT AN INDEX
         BG       TYPE:0:20         NOT CANNED MSG-->BRANCH
         LW,R4    CANNED:MSG:ADR,R4   GET CANNED MSG ADDRESS
TYPE:0:20  EQU    %
         SLS,R4   +2                CONVERT TO BYTE ADDRESS
         CALL     TEXTC:TO:TEMP     MOVE IN THE MSG
         CALL     TEMP:TO:CHAIN     CHAIN TEMP BUFFER TO CHAIN
         TEST,FAIL TYPE:0:35        BAD DEAL-->BRANCH
         CALL     BASIC:4:INIT      INITIALIZE BASIC DATA IN TYPE 3 BLOCK
          TEST,FAIL  TYPE:0:35       BAD ID--BRANCH
         RETC                       RETURN BACKWITH PASS
TYPE:0:30 EQU     %
         LI,R14   INVALID:ERR:MSG   INDICATE BAD ERROR BLOCK
         CALL     PRINT:MSG         PRINT IT
TYPE:0:35 EQU     %
         CALL     DECHAIN:BLOCK     GET RID OF THE BLOCK
         RETC     FAIL              RETURN WITH AFAILURE
*
*
         TITLE    'PIGEON PROCESS TYPE 1 MESSAGES'
*
***********************************************************************
*
*D*      NAME:    PROC:TYPE:1
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL TAKE A TYPE 1 BLOCK
*D*               (SEND,ID/ALL) AND CONVERT IT TOO THE PROPER TYPE.
*D*               SEND,ID IS CHANGED TO TYPE 3.
*D*               SEND,ALL WHEN BROADCAST IN PROGRESS IS CHANGED TO TYPE 4.
*D*               SEND,ALL (NO BROADCAST) IS CHANGED TO TYPE 2.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  UPDATED BLOCK POINTED TO BY PIG:CUR
*D*
*
***********************************************************************
*
PROC:TYPE:1 EQU   %
         LC       J:JIT             SEE IF GHOST
         BCR,4    TYPE:1:10         NOT GHOST-->BRANCH
         LI,R1    MSGX              GET MSG INDEX
         LW,R4    *PIG:CUR,R1       GET THE MSG ADDRESS
         SLS,R4   +2                CONVERT TO BYTE ADDRESS
         CALL     TEXTC:TO:TEMP:INIT  MOVE TEXTC TO BUFFER
         LW,R14   *PIG:CUR,R1       GET THE ADDRESS AGAIN
         BAL,R11  RMB               RELEASE THE MPOOL
TYPE:1:10 EQU     %
         CALL     TEMP:TO:CHAIN     CHAIN THE TEMP BUFFER TO MESSAGE CHAIN
         TEST,FAIL TYPE:1:20        FAILURE-->BRANCH
         LI,R1    WORD:2            GET WORD 2
         LW,R2    TEXT:ALL          GET TEXT ALL
         CW,R2    *PIG:CUR,R1       SEE IT THAT WHAT WE GOT
         BNE      TYPE:1:15         NOT ALL->BRANCH
         CALL     BASIC:4:INIT      INITIALIZE THE BLOCK
         LI,R1    TYPE              GET TYPE INDEX
         LI,R2    TYPE:2            GET TYPE 2 VALUE
         MTW,0    BROADCAST         IS A BROADCAST CURRENTLY IN PROGRESS
         BNE      TYPE:1:12         NO-->BRANCH
         LI,R2    TYPE:4            SET UP TYPE FOUR
TYPE:1:12 EQU     %
         STB,R2   *PIG:CUR,R1       CHANGE TYPE TO TYPE 2
         RETC     PASS              IGNORE THE ERROR ON USER #
TYPE:1:15 EQU     %
         CALL     CONVERT:SYSID     GET THE USER # FROM SYSID
         TEST,FAIL TYPE:1:20        FAILURE-->BRANCH
         CALL     BASIC:4:INIT      INITIALIZE BASIC DATA
         TEST,FAIL TYPE:1:20        FAILURE-->BRANCH
         RETC                       RETURN BACK WITH PASS
TYPE:1:20 EQU     %
         CALL     DECHAIN:BLOCK     DECHAIN THE BLOCK
         RETC     FAIL              RETURN WITH A FAILURE
*
*
         TITLE    'PIGEON PROCESS TYPE 2 MESSAGES'
*
***********************************************************************
*
*D*      NAME:    PROC:TYPE:2
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL PROCESS A TYPE 2 BLOCK
*D*               (SEND,ALL)
*D*
*D*               IT WILL PROCESS EVERY LINE IN THE SYSTEM THAT IS
*D*               ACTIVE.  FOR MESSAGE PROCESSING THE BLOCK IS
*D*               TREATED AS A TYPE 3 BLOCK AND PROC:TYPE:3 IS CALLED.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
***********************************************************************
*
PROC:TYPE:2 EQU   %
         LI,R1    LINE#             GET LINE # INDEX
         LH,R2    *PIG:CUR,R1       GET THE ACTUAL LINE #
         CI,R2    LNOL              MAX LINE NUMBER
         BGE      TYPE:2:10
         MTB,0    STATUS,R2         HAS LINE BEEN PROCESSED ALREADY
         BEZ      TYPE:2:20         NO-->BRANCH
TYPE:2:5 EQU      %
         AI,R2    1                 POINT TO NEXT LINE #
         CI,R2    LNOL              COMPARE TO MAX LINE #
         BGE      TYPE:2:10         GREATER-->BRANCH
         STH,R2   *PIG:CUR,R1       STORE LINE # AND GO PROCESS
         B        PROC:TYPE:2       THE NEXT LINE #
TYPE:2:10 EQU     %
         LI,R2    0                 ZERO OUT
         STH,R2   *PIG:CUR,R1       THE LINE #
         XW,R2    SKIPFLAG          DID WE SKIP ANY
         BEZ      TYPE:2:15         NO-->BRANCH
         LI,R2    LASTPASS          GET PASS COUNTER
         MTB,-1   *PIG:CUR,R2       COUNT DOWN THE PASS COUNTER
         BLZ      TYPE:2:15         IF THAT WAS LAST PASS, QUIT
         CALL     WAIT:2            GO IDLE FOR A LITTLE WHILE
         B        PROC:TYPE:2       AND TRY AGAIN
TYPE:2:15 EQU     %
         LW,R1    ZERO:STATUS       ZERO OUT STATUS AREA
         MBS,R0   BA(BINARY:ZERO)   FOR NEXT TIME
         LI,R14   BROADCAST:MSG     SEND BROADCAST COMPLETE MSG
         CALL     PRINT:MSG         PRINT IT
         CALL     DECHAIN:BLOCK     GET RID OF CURRENT BLOCK
         RETC     PASS              INDICATE EVERYTHING OK
TYPE:2:20 EQU     %
         LB,R3    LB:UN,R2          GET USER #
         BEZ      TYPE:2:5          NO USER-->BRANCH
         LI,R4    USER#             SET UP IN BLOCK
         STB,R3   *PIG:CUR,R4       FOR PRTYPE 3 PROCESSING
         CALL     PROC:TYPE:3       SEND THE MESSAGE IF POSSIBLE
         TEST,DEFER TYPE:2:30       DEFER-->BRANCH
         TEST,PASS TYPE:2:40        PASS-->BRANCH
         MTW,1    SKIPFLAG          INDICATE WE SKIPPED SOMEONE
         LI,R1    LASTPASS          COUNT UP LASTPASS BECAUSE OF
         MTB,1    *PIG:CUR,R1       TYPE 3 PROCESSING
         B        TYPE:2:50         GET READY TO GO BACK
TYPE:2:30 EQU     %
         CALL     DEFER:MSG         BUILD DO LIST ENTRY
TYPE:2:40 EQU     %
         LI,R1    LINE#             GET LINE # AGAIN
         LH,R2    *PIG:CUR,R1       GET IT
         MTB,1    STATUS,R2         AND TURN STATUS ON
TYPE:2:50 EQU     %
         LI,R1    LINE#             GET INE # INDEX
         MTH,1    *PIG:CUR,R1       COUNT IT UP FOR NEXT LINE
TYPE:2:60 EQU     %
         CALL     CHECK:BRK         SEE IF BREAK OCCURED
         TEST,FAIL PROC:TYPE:2      CONTINUE OTHERWISE
         B        TYPE:2:15         GET OUT AND TERMINATE
*
*
         TITLE    'PIGEON PROCESS TYPE 3 MESSAGES'
*
***********************************************************************
*
*D*      NAME:    PROC:TYPE:3
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL PROCESS BLOCK TYPE 3.
*D*               IT WILL CAUSE THE MESSAGE TO BE SENT TO THE USER
*D*               IF POSSIBLE.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  BLOCK POINTED TO BY PIG:CUR
*D*
***********************************************************************
*
PROC:TYPE:3 EQU   %
         LI,R1    LINE#             GET THE LINE # INDEX
         LH,R2    *PIG:CUR,R1       GET THE LINE #
         LI,R1    USER#             GET THE USER# INDEX
         LB,R3    *PIG:CUR,R1       GET THE USER #
         CB,R3    LB:UN,R2          IS IT STILL THE SAME USER #
         BNE      TYPE:3:65         NOT SAME USER -> BRANCH
         LC       MODE5,R2          IS IT A TP-SLAVE-LINE
         BCS,TPSLAVE  TYPE:3:65     TP SLAVE -> BRANCH
         BCS,DS   TYPE:3:68         DONT SEND SET -> BRANCH
         LC       MODE,R2           IS IT OPERATING IN TRANSPARENT MODE
         BCS,TRANSPARENT TYPE:3:70  TRANSPARENT-->BRANCH
*
*        TEST FOR GLOBAL SATURATION
*
TYPE:3:10 EQU     %
         LI,R1    COCBUFCNT         GET INDEX TO # COC BUFS
         LB,R4    *PIG:CUR,R1       GET # COC BUFS FOR MESSAGE
         AW,R4    COC#BUFS          AND IN THE NUMBER CURRENTLY IN USE
         CW,R4    GMAXBUF           HAVE WE EXCEEDED MAX ALLOWED
         BL       TYPE:3:20         NO-->BRANCH
         CALL     WAIT:2            WAIT A WHILE
         CALL     CHECK:BRK         SEE IF BREAK OCCURED
         TEST,PASS TYPE:3:65        YES-->BRANCH
         B        TYPE:3:10         LOOP AND TRY AGAIN
*
TYPE:3:20 EQU     %
         LB,R4    MODE4INIT,R2      GET LINE SPEED INDICATOR
         AND,R4   HEX00000007            ONLY
         LB,R5    COB:CPS,R4        GET CHARACTERS PER SECOND
         MW,R5    SL:TB             (CHAR/SEC) X (TERM BLOCK IN SECS)
         MI,R5    3                 (TERM BLOCK IN CHARS) X 3
         SLS,R5   -2                /4  (GET 3/4 TERM BLOCK LIMIT)
         SH,R5    COCOC,R2          ('OUR' BLOCK LIMIT) - (OUT CHAR COUNT)
         LI,R1    COCBUFCNT         GET COC BUFFER CNT INDEX
         LB,R13   *PIG:CUR,R1       GET SIZE OF THIS MESSAGE IN BUFFERS
         MI,R13   14                MAKE MAX # OF CHARACTERS
         SW,R5    R13               SEE IF THIS WOULD PUSH OVER LIMIT
         BGE      TYPE:3:30         IF NOT IT'S OK TO SEND (PROBABLY)
         LH,R5    COCOC,R2          CHECK OUTPUT CHARATER COUNT
         BEZ      TYPE:3:30         IF NONE, SEND THE MESSAGE NOW
         LI,R1    LASTPASS          GET LAST PASS INDEX
         MTB,0    *PIG:CUR,R1       SEE IF IT'S THE LAST PASS
         BNEZ     TYPE:3:90         IF NOT, SKIP USER FOR NOW
TYPE:3:30 EQU     %
         LI,R1    LASTPASS          GET LAST PASS INDEX
         MTB,0    *PIG:CUR,R1       SEE IF ITS LAST PASS
         BEZ      TYPE:3:50         LAST PASS-->BRANCH
         LC       MODE2,R2          SEE IF 2741
         BCS,1    TYPE:3:40
         LC       MODE6,R2          SEE IF HALF-DUPLEX LINE IN INPUT MODE
         BCR,BHDIN TYPE:3:60        NOT HALF-DUPLEX-->BRANCH
TYPE:3:40 EQU     %
         LH,R5    COCII,R2          CHECK INPUT INSERTION POINTER
         BNEZ     TYPE:3:90         INPUT BUFFERS EXIST-->BRANCH
TYPE:3:50 EQU     %
         LC       MODE6,R2          CHECK FOR HALF-DUPLEX LINE IN INPUT MODE
         BCR,BHDIN TYPE:3:60        NOT HALF-DUPLEX-->BRANCH
         BAL,R13  COCDSABL          ** DISABLE COC INTERRUPTS **
         BAL,R9   T:TURNOUT         TURN LINE TO OUTPUT MODE
         BAL,R13  COCENABL          ** ENABLE COC INTERRUPTS **
TYPE:3:60 EQU     %
         CALL     SEND:MSG          GO SEND THE MESSAGE
TYPE:3:65 EQU     %
         RETC     PASS              INDICATE THAT EVERYTING IS OK
TYPE:3:68 EQU     %
         LH,R4    UH:FLG,R3          GET USER FLAGS
         CI,R4    TIC               IS TEL IN CONTROL?
         BANZ     TYPE:3:10         IF SO, OVERRIDE THE DONT SEND
*                                   TO AVOID LOSING MESSAGE
TYPE:3:70 EQU     %
         RETC     DEFER             INDICATE THAT WE MUST DEFER THE MESSAGE
TYPE:3:90 EQU     %
         LI,R1    LASTPASS          GET LAST PASS INDEX
         MTB,-1   *PIG:CUR,R1       COUNT DOWN LOOP INDEX
         RETC     FAIL              INDICATE THAT WE PROCESSED IT
*
*
         TITLE    'PIGEON PROCESS TYPE 4 MESSAGES'
*
***********************************************************************
*
*D*      NAME:    PROC:TYPE:4
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL CHECK FOR BROADCAST
*D*               IN PROGRESS.  IF SO IT WILL BYPASS THE CURRENT
*D*               BLOCK BY RETURNING FAILURE.  OTHERWISE IT WILL
*D*               CHANGE THE BLOCK TO TYPE 2 AND EXIT PASS.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  BLOCK POINTED TO BY PIG:CUR (MAY BE CHANGED TO TYPE 2)
*D*
***********************************************************************
*
PROC:TYPE:4 EQU   %
         MTW,0    BROADCAST         SEE IF BROADCAST IN PROGRESS
         BEZ      TYPE:4:10         NO-->BRANCH
         RETC     FAIL              INDICATE A FAILURE
TYPE:4:10 EQU     %
         MTW,1    BROADCAST         INDICATE THAT BROADCAST IN PROGRESS
         LI,R1    TYPE              GET TYPE INDEX
         LI,R2    TYPE:2            CHANGE TYPE TO 2
         STB,R2   *PIG:CUR,R1       STORE IT AWAY
         RETC     PASS              RETURN BACK WITH NEW BLOCK
*
*
         TITLE    'PIGEON PROCESS TYPE 5 MESSAGES'
*
***********************************************************************
*
*D*      NAME:    PROC:TYPE:5
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL PROCESS MESSAGES
*D*               CREATED BY KEYIN AND TYPR THAT HAVE THE FORM:
*D*               S:  MSG
*D*               O:  MSG
*D*               WHERE S: IS PRODUCED BY TYPR MEANING SYSTEM
*D*               AND O: IS PRODUCED BY KEYIN MEANING OPERATOR
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  BLOCK POINTED TO BY PIG:CUR CHANGED TO TYPE 2
*D*
***********************************************************************
*
PROC:TYPE:5 EQU   %
         LW,R4    PIG:CUR           GET ADDRESS OF BLOCK
         AI,R4    2                 POINT TO WORD 2
         SLS,R4   +2                CONVERT IT TO BYTE ADDRESS
         CALL     TEXTC:TO:TEMP:INIT  MOVE IT TO TEMP BUFFER
         LI,R1    MSGX              GET MSG INDEX
         LW,R4    *PIG:CUR,R1       GET THE MPOOL ADDRESS
         SLS,R4   +2                CONNVERT IT TO BYTE ADDRESS
         CALL     TEXTC:TO:TEMP     MAKE THE TOTAL MSG
         LW,R14   *PIG:CUR,R1       GET THE MPOOL ADDRESS AGAIN
         BAL,R11  RMB               RELEASE THE MPOOL
         CALL     TEMP:TO:CHAIN     CHAIN THE MSG
         TEST,FAIL TYPE:5:90        ERROR-->BRANCH
         CALL     BASIC:4:INIT      INITILIZE THE BLOCK
         TEST,FAIL TYPE:5:90        ERROR-->BRANCH
         RETC     PASS              RETURN WITH EVERYTHING OK
*
TYPE:5:90 EQU     %
         CALL     DECHAIN:BLOCK     GET RID OF THE BAD BLOCK
         RETC     FAIL              AND INDICATE WE DID
*
*
         TITLE    'PIGEON SEND MESSAGE'
*
***********************************************************************
*
*D*      NAME:    SEND:MSG
*D*
*D*      DESCRIPTION: THIS SUBROUTINE WILL SEND THE MESSAGE TO
*D*               THE USER SPECFIED.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  MESSAGE SENT TO THE USER
*D*
*D*
************************************************************************
*
SEND:MSG EQU      %
         LI,R1    LINE#             GET THE LINE # INDEX
         LH,R2    *PIG:CUR,R1       GET THE LINE #
         LB,R6    CPOS,R2           LOAD CURRENT CARRIAGE POSITION
         CI,R6    1                 AT COLUMN 1?
         BE       SEND:MSG:5        IF SO SKIP CR/LF
         LB,R5    MODE4,R2          GET MODE 4
         AND,R5   HEX00000007       GET TIMING ALGORITHM ONLY
         LB,R5    COB:MNIC,R5       LOAD MAX # OF IDLES COLUMN #
         STB,R5   CPOS,R2           STORE CPOS VALUE FOR MAX # OF IDLES
         LI,R5    X'0D'             CR/LF CHARACTER SEQUENCE
         CALL     SEND:CHAR         SEND THE CHARATER TO THE TERMINAL
SEND:MSG:5 EQU    %
         LI,R1    0                 ZERO OUT THE
         STW,R1   TEMP:SIZE         TEMP SIZE TO COUNT UP THE MSG LENGTH
         CALL     GET:CHAR:INIT     GET A CHARACTER INIT
SEND:MSG:10 EQU   %
         CALL     GET:CHAR          GET A CHARACTER
         TEST,FAIL SEND:MSG:30      NO MORE CHAR-->BRANCH
*                                        A 2741 OR ASCII APL TERMINAL
SEND:MSG:20 EQU   %
         CALL     SEND:CHAR         SEND THE CHARACTER TO THE TERMINAL
         MTW,1    TEMP:SIZE         COUNT FOR EACH CHARACTER SENT
         B        SEND:MSG:10       LOOP FOR ALL OF THE MESSAGE
SEND:MSG:30 EQU   %
         LW,R7    TEMP:SIZE         GET THE SIZE OF THE MESSAGE
         STB,R7   CPOS,R2           STORE IT IN THE CURRENT CARRIAGE POSITION
         SW,R7    R6                (MESSAGE BC) - (ORIGINAL CPOS)
         BL       SEND:MSG:40       CARR  RIGHT OF CPOS-->BRANCH
         LI,R5    X'0D'             LOAD CARRIAGE RETURN CHAR
         CALL     SEND:CHAR         SEND THE CHARACTER TO THE TEMINAL
         LCW,R7   R6                GET COMPLEMENT OF ORIG CARR POSITION
SEND:MSG:40 EQU   %
         STW,R7   SEND:COUNT        * SAVE # OF BLANKS TO SEND
         STB,R6   CPOS,R2           SET ORIGINAL CARRAIGE POSITION
         LI,R5    ' '               GET A BLANK
SEND:MSG:50 EQU   %
         MTW,1    SEND:COUNT        * COUNT UP # OF BLANKS TO SEND
         BGEZ     SEND:MSG:60       SENT ENUFF-->BRANCH
         CALL     SEND:CHAR         SEND A BLANK
         B        SEND:MSG:50       LOOP FOR NEXT ONE
SEND:MSG:60 EQU   %
         RET                        RETURN WITH THE MESSAGE SENT
*
*
         TITLE    'PIGEON SEND CHARACTER'
*
***********************************************************************
*
*D*      NAME:    SEND:CHAR
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL SEND A CHARACTER TO
*D*               THE SPECIFIED TERMINAL.
*D
*D*      INPUT:   R2 = LINE #
*D*               R5 = CHARACTER
*D*               R10 = TRANSLATION TABLE INDEX
*D*
*D*      OUTPUT:  CHARACTER SENT TO THE USER
*D*
************************************************************************
*
SEND:CHAR EQU     %
         LB,R1    COCTERM,R2        GET THE TERMINAL TYPE
         LH,R10   COCOTV,R1         GET TRANSLATION TABLE INDEX
         BAL,R13  COCDSABL          **  DISABLE COC INTERRUPTS  **
         BAL,R9   COCSENDX          SEND THE CHARACTER
         BAL,R13  COCENABL          **  ENABLE COC INTERRUPTS  **
         CI,R5    X'0D'             SEE IF CR/LF SEQUENCE
         BNE      SEND:CHAR:10      NOT CR/LF-->BRANCH
         BAL,R15  ECHOCR2           ACCOUNT FOR NEW LINE
SEND:CHAR:10 EQU  %
         RET                        RETURN
*
*
         TITLE    'PIGEON GET CHARACTER'
*
************************************************************************
*
*D*      NAME:    GET:CHAR
*D*
*D*      DESCRIPTION:  THIS ROUTINE WILL GET A CHARACTER FROM
*D*               THE BUFFER CHAIN POINTED TO BY PIG:CUR.
*D*               EACH TIME IT IS CALLED IT WILL RETURN THE
*D*               NEXT CHARACTER IN SEQUENCE.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  R5 = CHARACTER TO SEND
*D*
***********************************************************************
*
GET:CHAR:INIT EQU %
         LI,R1    MSGX              GET MESSAGE INDEX
         LW,R1    *PIG:CUR,R1       GET THE CURRENT MESSAGE HEAD
         STW,R1   CUR:CHAR          SAVE CURRENT MESSAGE HEAD
         LI,R1    4                 SET UP CHAR INDEX
         STB,R1   CUR:CHAR          SAVE IT
         RET                        RETURN
*
GET:CHAR EQU      %
         LB,R1    CUR:CHAR          GET CURRENT INDEX
         CI,R1    16                HAVE WE FINISHED THIS BLOCK
         BL       GET:CHAR:20       NO-->BRANCH
         LW,R1    *CUR:CHAR         GET FORWARD LINK
         BEZ      GET:CHAR:90       NO FORWARD LINK-->BRANCH
GET:CHAR:10 EQU   %
         STW,R1   CUR:CHAR          SAVE NEW ADDRESS
         LI,R1    4                 SET UP NEW INDEX
         STB,R1   CUR:CHAR          INITIALIZE BYTE INDEX
         B        GET:CHAR          TRY AGAIN
GET:CHAR:20 EQU   %
         LB,R5    *CUR:CHAR,R1      GET THE CURRENT CHARACTER
         BEZ      GET:CHAR:90       NO MORE CHAR-->BRANCH
         AI,R1    1                 POINT TO NEXT CHAR
         STB,R1   CUR:CHAR          SAVE CURRENT INDEX
         RETC     PASS              GET OUT WITH EVERYTHING OK
GET:CHAR:90 EQU   %
         RETC     FAIL              INDICATE FAILURE
*
*
         TITLE    'PIGEON TEXTC TO TEMP'
*
***********************************************************************
*
*D*      NAME:    TEXTC:TO:TEMP
*D*               TEXTC:TO:TEMP:INIT
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL MOVE THE TEXTC INFORMATION
*D*               TO A TEMPARARY BUFFER AREA.
*D*
*D*               IF TEXTC:TO:TEMP:INIT IS CALLED ALL PERTINENT
*D*               FIELDS ARE INITIALIZED.
*D*
*D*
*D*      INPUT:   R4 = BYTE ADDRESS OF TEXTC
*D*
*D*      OUTPUT:  INFORMATION MOVED TO TEMPARARY BUFFER
*D*
***********************************************************************
*
TEXTC:TO:TEMP:INIT EQU %
         LI,R15   0                 SET FIELDS TO ZERO
         STW,R15  TEMP:SIZE         ZERO OUT TEMP SIZE
         LI,R15   BA(TEMP:BUF)      SET CURRENT POINTER TO BEGINNING
         STW,R15  TEMP:ADR          SAND MAKE IT CURRENT
*
TEXTC:TO:TEMP EQU %
         LW,R5    TEMP:ADR          GET CURRENT ADDRESS IN TEMP BUFFER
         LB,15    0,R4              GET THE BYTE COUNT
         AWM,R15  TEMP:SIZE         ACCUMULATE TOTAL SIZE
         STB,R15  R5                SET UP FOR MOVE
         MBS,R4   1                 MOVE IN THE TEXTC
         STW,R5   TEMP:ADR          SAVE NEW BYTE ADDRESS
         RET                        RETURN
*
*
         TITLE    'PIGEON TEMP TO CHAIN '
*
***********************************************************************
*
*D*      NAME:    TEMP:TO:CHAIN
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL MOVE THE CURRENT TEMP BUFFER
*D*               TO 4 WORD BLOCKS AND CHAIN THEM TO THE CURRENT
*D*               TASK BLOCK POINTED TO BY PIG:CUR.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*               TEMPARY BUFFER CONTAINING MESSAGE
*D*
*D*      OUTPUT:  MESSAGE CHANGED ON BLOCK POINTED TO BY PIG:CUR
*D*
***********************************************************************
*
TEMP:TO:CHAIN EQU %
         LI,R4    BA(TEXTC:5:ZEROS) LOAD ADDESS OF 5 BINARY ZEROS
         CALL     TEXTC:TO:TEMP     MOVE IN 5 ZEROS  TO PADD OUT TO EVEN WORD
         LW,R1    TEMP:ADR          GET CURRENT BYTE ADDRESS
         SLS,R1   -2                CONVERT IT TO WORD ADDRESS
         STW,R1   TEMP:ADR          AND SAVE IT
         LI,R2    TEMP:BUF          SET UP BUFFER ADDRESS
         LI,R3    0                 SET UP FORWARD LINK
         LW,R8    PIG:CUR           GET CURRENT ENTRY ADDRESS
         AI,R8    MSGX              POINT TO THE MESSAGE VALUE
         STW,R3   *R8               ZERO OUT THE FORWARD LINK
         STW,R8   CUR:CHAR          SAVE MESSAGE HEAD
TEMP:TO:CHAIN:10  ;
         EQU      %
         LCI      3                 LOAD THE MSG
         LM,R4    *R2               GET THE MESSAGE DATA
         CALL     GET:FREE:BLOCK         GET A FREE BLOCK
         TEST,FAIL TEMP:TO:CHAIN:20
         LCI      4                 MOVE THE DATA TO THE BLOCK
         STM,R3   *R9               MOVE THE DATA TO THE BLOCK
         LW,R8    CUR:CHAR          RESTORE MESSAGE HEAD
         CALL     ADD:CHAIN         CHAIN IT ON THE END
         AI,R2    3                 UPDATE THE POINTER
         CW,R2    TEMP:ADR          SEE IF WE ARE DONE
         BL       TEMP:TO:CHAIN:10  NOT DONE-->BRANCH
         LW,R1    TEMP:SIZE         GET THE TOTAL SIZE OF THE MESSAGE
         AI,R1    8                 ROUND UP 5 -ZEROS PLUS 8
         DW,R1    FOURTEEN          DIVIDE BY 14
         LI,R2    COCBUFCNT         GET COC BUF CNT INDEX
         STB,R1   *PIG:CUR,R2       SAVE THE # OF COC BUFFERS REQUIRED
         RETC     PASS              INDICATE EVERYTHING IS OK
TEMP:TO:CHAIN:20 EQU %
         MTW,0    *R8               SEE IF WE HAVE CHAINED ANYTHING YET
         BEZ      TYPE:TO:CHAIN:30  NO-->BRANCH
         LI,R8    PIG:FREE:HD       GET ADDRESS OF HEAD OF FREE CHAIN
         LW,R9    *R8               GET THE FIRST ONE ON THE CHAIN
         CALL     ADD:CHAIN         ADD THE BLOCKS BACK TO THE FREE CHAIN
         LI,R1    MSGX              GET MSG INDEX
         LI,R2    0                 AND A ZERO
         STW,R2   *PIG:CUR,R1       AND ZERO OUT THE MSG ADDRESS
TYPE:TO:CHAIN:30 EQU %
         RETC     FAIL              INDICATE THAT WE COULN'T PROCESS MESSAGE
*
*
         TITLE    'PIGEON BASIC 4 INIT'
*
***********************************************************************
*
*D*      NAME:    BASIC:4:INIT
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL CHANGE THE BLOCK POINTED
*D*               TO BY PIG:CUR TO TYPE 3, ZERO WORD 2, AND FIND
*D*               LINE # BASED ON USER #.
*D*
*D*      INPUT:   PIG:CUR
*D*
*D*      OUTPUT:  UPDATED BLOCK
*D*
*************************************************************************
*
BASIC:4:INIT EQU  %
         LI,R15   0                 LOAD A ZERO
         LI,R1    WORD:2            GET WORD TWO INDEX
         STW,R15  *PIG:CUR,R1       ZERO OUT WORD 2
         LI,R1    LASTPASS          GET LAST PASS INDEX
         LI,R2    3                 GET LOOP COUNT
         STB,R2   *PIG:CUR,R1       STORE AWAY LOOP COUNT
         LI,R15   TYPE:3            SET UP TYPE 3
         LI,R1    TYPE              GET TYPE DISPLACEMENT
         LB,R2    *PIG:CUR,R1       GET THE CURRENT TYPE
         STB,R15  *PIG:CUR,R1       CHANGE IT
         LI,R1    ORIG:TYPE         GET ORIGINAL TYPE INDEX
         STB,R2   *PIG:CUR,R1       AND SAVE ORIGINAL TYPE
         LI,R1    USER#             GET USER # INDEX
         LB,R15   *PIG:CUR,R1       GET THE USER #
         BEZ      BASIC:4:15        NO USER #-->BRANCH
         LI,R14   LNOL              GET # OF LINES
         LI,R1    0                 SET UP INDEX
BASIC:4:10     EQU %
         CB,R15   LB:UN,R1          SEE IF ITS A MATCH
         BE       BASIC:4:20        MATCH-->BRANCH
         AI,R1    1                 POINT TO NEXT LINE
         BDR,R14  BASIC:4:10        LOOP UNTIL DONE
BASIC:4:15 EQU    %
         RETC     FAIL              UNABLE TO FIND LINE #
BASIC:4:20     EQU %
         LI,R2    LINE#             GET LINE # INDEX
         STH,R1   *PIG:CUR,R2       STORE AWAY THE LINE #
         RETC     PASS              GET OUT WITH A SUCCESSFUL TYPE 3
*
*
         TITLE    'PIGEON CONVERT SYSID'
*
***********************************************************************
*D*
*D*      NAME:    CONVERT:SYSID
*D*
*D*      DESCRIPTION: THIS SUBROUTINE WILL CONVERT THE SYSID IN WORD2
*D*               TO A USER # AND VERIFY THAT IT IS A VALID USER #.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  COONVERTED SYSID IN UPDATED BLOCK POINTED TO BY PIG:CUR
*D*
***********************************************************************
*
CONVERT:SYSID EQU %
         LI,R1    WORD:2            GET THE ID
         LW,R15   *PIG:CUR,R1       GET THE ID
         LI,R5    0                 ZERO OUT THE USER ID TO BE
         LI,R6    0                 ZERO OUT THE CONVERTED IT
         CW,R15   TEXT:ALL          SEE IF ITS ALL
         BE       CVT:ID:30         ALL-->BRANCH
CVT:ID:10 EQU     %
         SLD,R14  +8                GET THE FIRST CHARACTER
         AND,R14  HEX000000FF       SEE IF ITS A BLANK AND GET CHAR ONLY
         BEZ      CVT:ID:20         BLANK-->BRANCH
         CI,R14   ' '               IS IT A BLANK
         BE       CVT:ID:20         BLANK-->BRANCH
         AI,R14   -(X'C1'-10)       SEE IF ITS A-F
         BLZ      CVT:ID:90         LESS ZERO-->BRANCH
         CI,R14   X'F'              IS IT GREATER THAN A X'F'
         BLE      CVT:ID:15         CONVERTED OK-->BRANCH
         AI,R14   -(X'F1'-X'C1'+9)  CONVERT 1-9
         BLZ      CVT:ID:90         ERROR-->BRANCH
CVT:ID:15 EQU     %
         SLS,R6   +4                POSITION THE ID 4 BITS OVER
         OR,R6    R14               SET UP THE ACCULATED ID
         B        CVT:ID:10         LOOP UNTIL DONE
CVT:ID:20 EQU     %
         BAL,R7   GETUSER#          GET USER # AND VERIFY IT
         B        CVT:ID:90         INVALID-->BRANCH
*                                   VALID RETURNS + 2
CVT:ID:30 EQU     %
         LI,R1    USER#             GET USER # DISPLACEMENT
         STB,R5   *PIG:CUR,R1       STORE IT AWAY
         RETC     PASS              RETURN WITH EVERYTHING OK
CVT:ID:90 EQU     %
         LI,R14   BAD:ID:MSG        INDICATE THAT WE GOT BAD ID
         CALL     PRINT:MSG         PRINT THE MESSAGE
         RETC     FAIL              INDICATE THAT SOMETHING IS WRONG
*
*
         TITLE    'PIGEON ONLINE INPUT'
*
***********************************************************************
*
*D*
*D*      NAME:    ONLINE:INPUT
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL READ FROM THE M:SI DCB
*D*               AND BUILD THE APPROPRIATE MESSAGES TO BE SENT.
*D*
*D*      INPUT:   USER INPUT
*D*
*D*      OUTPUT:  PIG:CUR POINTING TO BLOCK TO PROCESS
*D*
***********************************************************************
*
ONLINE:INPUT EQU  %
         LW,R1    BLANK:INPUT       SET UP TO BLANK INPUT BUFFER
         MBS,R0   BA(BLANKS)        AND DO IT
         M:READ   M:SI,(BUF,INPUT:BUFFER),(SIZE,80),;
                    (ERR,M:SI:ERR),(ABN,M:SI:ABN)
         B        ONLINE:20              READ OK-->BRANCH
         LB,R10   R10               GET THE ERROR CODE
         CI,R10   END:OF:FILE       DID WE GET AN END OF FILE
         BNE      ONLINE:10         NO-->BRANCH
         RETC     EMPTY             RETURN AN END OF FILE
ONLINE:10 EQU     %
         LI,R14   BAD:READ:MSG      INDICATE A BAD READ
         CALL     PRINT:MSG         PRINT THE MESSAGE
         RETC     FAIL              INDICATE A FAILURE
*
ONLINE:20 EQU     %
         LI,R1    0                 INITIALIZE INDEX INTO BUFFER
         LW,R2    BLANKS            GET R2 FULL OF BLANKS
         LI,R15   4                 SET UP LOOP COUNT
ONLINE:30 EQU     %
         LB,R3    INPUT:BUFFER,R1   GET THE CHARACTER
         CI,R3    ' '               IS IT A BLANK
         BE       ONLINE:50         BLANK-->BRANCH
         BL       ONLINE:40         CONTROL CHAR-->BRANCH
         STB,R3   R2,R1             STORE THE BYTE AWAY
         AI,R1    1                 POINT TO NEXT BYTE
         BDR,R15  ONLINE:30         LOOP UNTIL DONE
ONLINE:40 EQU     %
         LI,R14   BAD:SEND:MSG      INDICATE BAD SEND MESSAGE
         CALL     PRINT:MSG         PRINT THE MSG
         RETC     FAIL              INDICATE A FAILURE
ONLINE:50 EQU     %
         STW,R1   CUR:CHAR          SAVE THE BYTE INDEX
         CALL     GET:FREE:BLOCK    GET A FREE BLOCK
         TEST,PASS ONLINE:60        GOT ONE-->BRANCH
         RETC                       RETURN THE ERROR
ONLINE:60 EQU     %
         STW,R9   PIG:CUR           MAKE THE ITEM THE CURRENT ONE
         LI,R1    WORD:2            GET WORD 2 INDEX
         STW,R2   *PIG:CUR,R1       STORE AWAY THE ID
         LW,R1    CUR:CHAR          RESTORE THE BYTE INDEX
         ANLZ,R4  ONLINE:30         GET BYTE ADDRESS OF START OF MESSAGE
ONLINE:75 EQU     %
         LB,R2    INPUT:BUFFER,R1   GET THE NEXT CHARACTER
         CI,R2    7                 SEE IF CHARACTER IS A BELL
         BE       ONLINE:80         BELL-->BRANCH
         CI,R2    ' '               SEE IF A BLANK
         BL       ONLINE:90         LESS THAN BLANK-->BRANCH
ONLINE:80 EQU     %
         AI,R1    1                 POINT TO NEXT CHARACTER
         CI,R1    80                CHECK FOR END OF CARD
         BL       ONLINE:75         LOOP UNTIL DONE
ONLINE:90 EQU     %
         ANLZ,R5  ONLINE:30         GET ENDING BYTE COUNT
         AI,R5    -1                GET RID OF LAST BYTE
         SW,R5    R4                CACULATE RECORD SIZE
         STB,R5   0,R4              MAKE IT TEXTC
         CALL     TEXTC:TO:TEMP:INIT   MOVE IT TO THE TEMP AREA
         LI,R1    TYPE              GET TYPE INDEX
         LI,R2    TYPE:1            SET IT TO TYPE 1
         STB,R2   *PIG:CUR,R1       STORE IT IN THE BLOCK
ONLINE:100 EQU    %
         LI,R8    PIG:HD            CHAIN ENTRY ON THE CHAIN
         LW,R9    PIG:CUR           GET CURRENT ENTRY ADDRESS
         CALL     ADD:CHAIN         ADD IT TO THE PROCESSING CHAIN
         RETC     PASS              RETURN T O THE CALLER
         TITLE    'PIGEON PRINT MESSAGE'
***********************************************************************
*D*
*D*      NAME:    PRINT:MSG
*D*
*D*      DESCRIPTION: THIS SUBROUTINE WILL PRINT THE MESSAGE PASSED TO
*D*               IT AND RET.
*D*
*D*      INPUT:   R14 = MESSAGE ADDRESS
*D*
***********************************************************************
*
PRINT:MSG     EQU %
         LC       J:JIT             SEE IF GHOST
         BCS,4    PRINT:MSG:10      GOST-->BRANCH
         M:PRINT  (MESS,*R14)       PRINT FOR ONLINE-BATCH
         RET                        RETURN
PRINT:MSG:10 EQU  %
         M:TYPE   (MESS,*R14)       TO THE OPERATOR FOR GHOST
         RET                        RETURN
*
*
         TITLE    'PIGEON GET PAGE AND BUILD FREE CHAIN'
*
***********************************************************************
*D*
*D*      NAME:    GET:PAGE
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL ACQUIRE A PAGE OF MEMORY AND
*D*               BUILD A SET OF 4 WORD BLOCKS AND CHAIN THEM TO
*D*               THE CURRENT FREE CHAIN
*D*
*D*      INPUT:   NONE
*D*
*D*      OUTPUT:  UPDATED PIG:FREE:CHAIN
*D*
***********************************************************************
*
GET:PAGE     EQU  %
         M:GP     1                 GET ONE PAGE
         BCR,CC1  GET:PAGE:10       GOT PAGE-->BRANCH
         LI,R14   NO:PAGE:MSG       INDICATE WHY WE FAILED
         CALL     PRINT:MSG         PRINT OUT THE MESSAGE
         RETC     FAIL              FAIL ON THE RETURN
GET:PAGE:10 EQU   %
         LI,R15   512/4             GET # OF 4 WORD BLOCKS
GET:PAGE:20 EQU   %
         LW,R8    R9                MOVE THE FIRST ADDR TO R8
         AI,R9    4                 CALC ADDR OF NEXT LINK
         STW,R9   *R8               STORE THE FORWARD LINK
         BDR,R15  GET:PAGE:20       LOOP FOR ALL BLOCKS
         STW,R15  *R8               SET THE FL OF LAST BLOCK TO ZERO
         AI,R9    -512              POINT BACK TO FRONT OF CHAIN
         LI,R8    PIG:FREE:HD       GET ADDRESS OF HEAD OF CHAIN
         CALL     ADD:CHAIN         ADD TO THE FREE CHAIN
         RETC     PASS              INDICATE EVERTHING IS OK
*
*
         TITLE    'PIGEON ADD TO THE CHAIN'
*
***********************************************************************
*D*
*D*      NAME:    ADD:CHAIN
*D*
*D*      DESCRIPTION;  THIS SUBROUTINE WILL ADD THE ENTRY/CHAIN PASSED
*D*               TO IT TO THE SPECIFIED CHAIN AT THE END.  IT IS
*D*               ASSUMED THE THE FORWARD LINK IS ALREADY ZEROED.
*D*
*D*      INPUT:   R8 = CHAIN HEAD ADDRESS
*D*               R9 = ENTRY/CHAIN TO BE ADDED TO THE END
*D*
*D*      OUTPUT:  UPDATED CHAIN
*D*
***********************************************************************
*
ADD:CHAIN EQU     %
         LW,R15   *R8               GET THE FORWARD LINK
         BEZ      ADD:CHAIN:10      ADD:CHAIN:10-->BRANCH
         LW,R8    R15               SET UP FOR NEXT ENTRY
         B        ADD:CHAIN         AND LOOP UNTIL END IS FOUND
ADD:CHAIN:10 EQU  %
         STW,R9   *R8               CHAIN THE ENTRY ON THE END
         RET                        RETURN WITH NO ANSWER
*
*
         TITLE    'PIGEON GET FREE BLOCK'
*
***********************************************************************
*
*D*      NAME:    GET:FREE:BLOCK
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL GET AN ENTRY OFF THE FREE
*D*               BLOCK CHAIN.  IF NO ENTRIES AVAILABLE IT WILL CALL GET
*D*               PAGE TO GET MORE FREE ENTRIES.
*D*
*D*      INPUT:   NONE
*D*
*D*      OUTPUT:  R9 = FREE BLOCK ADDRESS
*D*
***********************************************************************
*
GET:FREE:BLOCK      ;
         EQU      %
         LW,R9    PIG:FREE:HD       SEE IF ANY FREE BLOCK AVAILABLE
         BNEZ     GET:FREE:BLOC:10  BLOCK AVAIL-->BRANCH
         CALL     GET:PAGE          GET SOME MORE FREE BLOCKS
         TEST,PASS GET:FREE:BLOCK      LOOP SINCE WE GOT ONE
         RETC                       RETURN THE ERROR
GET:FREE:BLOC:10 EQU %
         LW,R15   *R9               GET THE FORWARD LINK
         STW,R15  PIG:FREE:HD       AND MAKE IT THE CURRENT HEAD
         LI,R14   0                 ZERO OUT THE FREE BLOCK
         LI,R7    3                 SET BDR COUNT
GET:FREE:BLOCK:20 EQU %
         STW,R14  *R9,R7            ZERO OUT THE BUFFER
         BDR,R7   GET:FREE:BLOCK:20  LOOP
         STW,R14  *R9,R7            ZERO OUT THE LAST ONE
         RETC     PASS              GO BACK WITH AN OK
*
*
         TITLE    'PIGEON MONITOR TO PIGEONS CHAIN'
*
***********************************************************************
*D*
*D*      NAME:    MON:PIG
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL MOVE THE MONITORS
*D*               CHAIN OF THINGS TO DO TO PIGEONS CHAIN.
*D*
*D*      INPUT:   PIGHEAD
*D*
*D*      OUTPUT:  NONE ON MONITORS CHAIN
*D*
*D*
***********************************************************************
*
MON:PIG     EQU   %
         LI,R3    0                 SET UP TO ZERO OUT MONITOS HEAD
         DISABLE                    *****  DISABLE  *****
         XW,R3    PIGHEAD           GET THE HEAD OF THE CHAIN
         ENABLE                     *****  ENABLE  *****
         CI,R3    0                 SEE IF WE GOT ANYTHING
         BNE      MON:PIG:10        NOT EMPTY-->BRANCH
         RETC     PASS+EMPTY        RETURN OK BUT EMPTY
MON:PIG:10    EQU %
         CALL     GET:FREE:BLOCK    GET A FREE BLOCK
         TEST,FAIL MON:PIG:30       UNABLE TO GET BLOCK
         LCI      4                 GET THE DATA FROM THE COC BUF
         LM,R4    0,R3              GET IT
         LW,R2    R3                MOVE THE ADDRESS OF ECBFBLK
         BAL,R1   ECBFBLK           FREE THE 4 WORD BUFFER
         LW,R3    R4                SAVE THE FORWARD LINK
         LI,R4    0                 ZERO OUT THE CURRENT FORWARD LINK
         LCI      4                 SAVE THE MONITOR DATA
         STM,R4   *R9               IN PIGEONS TASK BLOCK
         LI,R8    PIG:HD            GET ADDRESS OOF PIGEONS TASK CHAIN
         CALL     ADD:CHAIN         CHAIN IT ON PIGEONS CHAIN
         CI,R3    0                 IS THERE ANYTHING ELSE TO DO
         BNEZ     MON:PIG:10        BRANCH IF YES
         RETC     PASS              RETURN A PASS CONDITION
*
MON:PIG:30 EQU    %
         LW,R2    R3                GET ADDRESS TO RELASE
MON:PIG:40 EQU    %
         LW,R3    *R2               GET THE FORWARD LINK OF CURRENT BLOCK
         BAL,R1   ECBFBLK           FREE THE COC BUFFER
         LW,R2    R3                SET UP FOR NEXT ONE
         BNEZ     MON:PIG:40        MORE TO DO-->BRANCH
         RETC     FAIL              INDICATE SOMETHING WENT WRONG
*
         TITLE    'PIGEONS BREAK ROUTINE'
*
***********************************************************************
*D*
*D*      NAME:    PIG:BREAK:RTN
*D*
*D*      DESCRIPTION: THIS SUBROUTINE WILL INDICATE THAT A BREAK OCCURED
*D*               BY SETTING PIG:BREA NON-ZERO.
*D*
***********************************************************************
PIG:BREAK:RTN     ;
         EQU      %
         MTW,1    PIG:BREAK         INDICATE THAT A BREAK OCCURED
         M:TRTN                     RETURN BACK TO PIGEON
*
*
         TITLE    'PIGEON CHECK FOR BREAK'
*
***********************************************************************
*
*D*      NAME:    CHECK:BRK
*D*
*D*      DESCRIPTION:  THIS ROUTINE WILL CHECK FOR A BREAK AND
*D*               SEE IF USER WANTS TO QUIT.
*D*
***********************************************************************
*
CHECK:BRK EQU     %
         MTW,0    PIG:BREAK         SEE IF BREAK HAS OCCURED
         BEZ      CHECK:BRK:5       NO-->BRANCH
         BLZ      CHECK:BRK:10      'Y' ALREADY OCCURED-->BRANCH
         M:KEYIN  (MESS,BREAK:MSG),(REPLY,REPLY:MSG),(SIZE,3),;
                  (ECB,ECB)
         LW,R1    ECB               IS IT DONE
         BLZ      %-1               NO-->BRANCH
         LI,R1    1                 GET THE SECOND BYTE
         LB,R1    REPLY:MSG,R1
         CI,R1    'Y'               WAS IT A YESS
         BE       CHECK:BRK:10      'Y'-->BRANCH
CHECK:BRK:5 EQU   %
         LI,R1    0                 ZERO OUT THE CELL
         STW,R1   PIG:BREAK         FOR THE NEXT TIME
         RETC     FAIL
CHECK:BRK:10 EQU  %
         LI,R1    -5000             SET IT VERY NEGATIVE
         STW,R1   PIG:BREAK         SO WE KNOW WHAT WE GOT
         RETC     PASS              INDICATE THAT IT WAS A YESS
*
*
         TITLE    'PIGEON WAIT ROUTINES'
*
***********************************************************************
*
*D*      NAME:    WAIT:2
*D*               WAIT:4
*D*               WAIT:25
*D*
*D*      DESCRIPTION:  THESE SUBROUTINES WILL WAIT FOR EITHER
*D*               2, 4, OR 25   TIU.
*D*
*D*
***********************************************************************
*
WAIT:2   EQU      %
         M:WAIT   2
         RET                        RETURN
WAIT:4   EQU      %
         M:WAIT   4
         RET                        RETURN
WAIT:25   EQU     %
         M:WAIT   25
         RET
*
*
         TITLE    'PIGEON DECHAIN BLOCK'
*
***********************************************************************
*
*D*      NAME:    DECHAIN:BLOCK
*D*
*D*      DESCRIPTION:  THIS SUBROUTINE WILL DECHAIN THE BLOCK POINTED TOO
*D*               BY PIG:CUR AND ADD IT TO THE FREE CHAIN.
*D*
*D*               IN ADDITION IT WILL DECHAIN THE MESSAGE CHAIN.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OUTPUT:  UPDATED PIG:NEXT
*D*               DECHAINED BLOCK POINTED TO BY PIG:CUR
*D*               UPDATED FREE CHAIN
*D*
***********************************************************************
*
DECHAIN:BLOCK EQU %
         LI,R8    PIG:HD            GET THE HEAD OF THE CHAIN
DECHAIN:10 EQU    %
         LW,R9    *R8               GET THE FORWARD LINK
         CW,R9    PIG:CUR           AND COMPARE TO CURRENT
         BE       DECHAIN:20        SAME-->BRANCH
         LW,R8    R9                MAKE FL THE CURRENT
         B        DECHAIN:10        LOOP UNTL FIND IT
DECHAIN:20 EQU    %
         LW,R15   *PIG:CUR          GET CURRENT ENTRY FORWARD LINK
         STW,R15  *R8               MAKE IT THE NEW CURRENT ENTRY
         STW,R15  PIG:NEXT          MAKE IT THE NEXT ENTRY
         LI,R8    PIG:FREE:HD       SET UP TO PUT ON FREE CHAIN
         LI,R1    MSGX              GET MSGX
         LW,R9    *PIG:CUR,R1       AND GET THE LINK IF ANY
         BEZ      DECHAIN:30        NONE THERE
         CALL     ADD:CHAIN         ADD MSG DATA BACK TO CHAIN
DECHAIN:30 EQU    %
         LW,R9    PIG:CUR           GET RID OF CURRENT ENTRY
         LI,R8    0                 MAKE SURE THE LINK IS ZERO
         STW,R8   *PIG:CUR          SO ZERO IT FOR SURE
         LI,R8    PIG:FREE:HD       GET FREE CHAIN HD ADDRESS
         CALL     ADD:CHAIN         GET RID OF IT
         RET                        RETURN
*
*
         TITLE    'PIGEON DEFER MESSAGE ROUTINE'
*
***********************************************************************
*
*D*      NAME:    DEFER:MSG
*D*
*D*      DESCRIPTION:  THIS ROUTINE WILL BUILD A DO-LIST ENTRY
*D*               FOR DEFERED MESSAGES.
*D*
*D*      INPUT:   BLOCK POINTED TO BY PIG:CUR
*D*
*D*      OOUTPUT: DO LIST ENTRY FOR SPECIFIED USER
*D*
***********************************************************************
*
DEFER:MSG EQU     %
         LC       J:JIT             SEE WHAT TYPE OF MODE
         BCR,4    DEFER:MSG:20      NON GHOST-->BRANCH
DEFER:MSG:5 EQU   %
         LW,R2    #DLBLKS           GET # BLOCKS IN USE BY PIGEON
         CW,R2    MAX#DLBLKS        COMPARE TO MAX ALLOWED
         BL       DEFER:MSG:10      OK-->BRANCH
         CALL     WAIT:2            WAIT A WHILE
         B        DEFER:MSG:5       LOOP UNTIL GET ONE
DEFER:MSG:10 EQU  %
         BAL,R1   ECBGBLK           GET A 4-WD BLOCK ADRESS IN R2
         BEZ      DEFER:MSG         LOOP UNTIL WE GET ONE
         MTW,1    #DLBLKS           COUNT UP # BLOCKS IN USE
         LCI      4
         LM,R12   DL:DATA           INITIALIZE 4-WD BLOCK
         STM,R12  *R2               TYPE-7 ITEM; DRIVES TO T:DEFER
         LI,R1    USER#             GET USER #
         LB,R1    *PIG:CUR,R1       GET THE USER # ITESELF
         DISABLE                    **  DISABLE  **
         LH,R4    UH:DL,R1          GET CURRENT HEAD ITEM
         LW,R5    MASKS+12          DA(D-L TIEM) MASK
         STS,R4   *R2               ESTABLISH FLINK
         SLS,R2   -1                CONVERT 4-WD BLK ADR TO DOUBLE WORD ADR
         LW,R3    MASKS+12
         STS,R2   R4                MAKE NEW 4-WD BLK THE HEAD
         STH,R4   UH:DL,R1          PUT IT AWAY
         ENABLE                     **  ENABLE  **
DEFER:MSG:20 EQU  %
         RET                        RETURN
*
*
         TITLE    'PIGEON M:SI ERROR AND ABNORMAL ROUTINES'
*
***********************************************************************
*
*D*      NAME:    M:SI:ERR
*D*               M:SI:ABN
*D*
*D*      DESCRIPTION:  THIS ROUTINE RETURNS TO THE CAL LOCATION + 2
*D*
*D*      INPUT:   R8 = CAL ADDRESS PLUS 1
*D*
*D*               R10 = ERRCODE + DCB ADDRESS
*D*
***********************************************************************
*
M:SI:ERR EQU      %
*
M:SI:ABN EQU      %
         AI,R8    1                 POINT 2 PAST THE CAL
         B        *R8               GO BACK AND LET WHOMEVER DIAGNOSE PROBLEM
*
*
         TITLE    'CHECK:SN'
*
***********************************************************************
*
*D*      NAME:    CHECK:SN
*D*
*D*      DESCRIPTION:  THIS ROUTINE WILL PROCESS THE SERIAL # IN A TYPE
*D*                                 0 BUFFER
*D*
***********************************************************************
*
CHECK:SN EQU      %
         LI,R4    BA(TEXTC:PUBLIC)  USE 'PUBLIC' FOR SN IF PUBLIC PACK
         LI,R1    SERIAL#           GET THE SERIAL # INDEX
         LW,R8    *PIG:CUR,R1       GET THE ACTUAL SERIAL #
         BEZ      CHECK:SN:50       PUBLIC PACK
         LW,R9    BLANKS            PAD JUST IN CASE NOT ANS
         LI,R1    4                 SET DEFAULT SN# LENGTH = 4
         LI,R2    ANSX              GET THE FLAG INDEX
         LB,R2    *PIG:CUR,R2       GET THE FLAGS
         CI,R2    X'C0'             SEE IF ITS AN ANS TAPE
         BAZ      CHECK:SN:40       NO-->BRANCH
         LI,R2    DCTX
         LB,R2    *PIG:CUR,R2       GET DCTX OF DEVICE
         CI,R2    BATAPE+AVRTBLSIZ  ANSFLGS MEANINGLESS IF PACK
         BGE      CHECK:SN:40       IT'S PACK
         LW,R2    R8                MOVE THE SN
         SLD,R2   -20               GET THE LOW ORDER PORTION
         SLS,R3   -12               POSITIONED CORERECTLY
         LW,R5    R3                MOVE IT FOR DIVIDE
         LI,R6    6                 SET UP LOOP COUNT
CHECK:SN:10 EQU   %
         SLD,R2   -2                GET TOP 2 BITS OF BYTE
         SLS,R3   -26               GET SIX BITS OF BINARY VALUE
         LI,R4    0                 SET UP FOR DIVIDE
         DW,R4    TEN               CONVERT TO BASE TEN
         OR,R3    R4                PUT IT TOGETHER
         BEZ      CHECK:SN:20       BLANK==>BRANCH
         AI,R3    X'80'             ADD IT THE 80 BITS
CHECK:SN:20 EQU   %
         AI,R3    X'40'             ADD IN THE 40 BITS
         SLD,R8   -8                POSITION FOR NEXT BYTE
         STB,R3   R8                STORE NEXT BYTE
         BDR,R6   CHECK:SN:10       LOOP UNTIL DONE
         LI,R1    6                 MAKE SN# LENGTH = 6 CHAR
CHECK:SN:40 EQU   %
         SLD,R8   -8                MOVE ROOM FOR TEXTC
         STB,R1   R8                SET UP TEXTC
         LI,R4    R8**2             BYTE ADDRESS OF R8
CHECK:SN:50 EQU   %
         CALL     TEXTC:TO:TEMP     MOVE IN THE SERIAL #
         RET                        RETURN
*
*
         TITLE    'PIGEONS PURE PROCEDURE DATA'
*
*
         USECT    PIGPD             * PROTECTION TYPE 1
*
*
TEXTC:5:ZEROS     ;
         DATA     X'05000000'       * FIVE  TEXTC BINARY ZEROS
         DATA     0
*
CANNED:MSG:ADR    ;
         EQU      %                 *  ADRESS USED TO INDEX TO CANNED MSGS
         DATA     TEXTC:SE          * ADR OF ,ERROR BY USER MSG
         DATA     TEXTC:C           * ADR  OF ,C MESSAGE
         DATA     TEXTC:R           * ADR OF ,R MESSAGE
         DATA     TEXTC:E           * ADR  OF ,E MESSAGE
         DATA     TEXTC:F           * ADR OF ,F MESSAGE
MAX:MSG:INDEX     ;
         EQU      %-CANNED:MSG:ADR-1 * MAXIMUM # OF MESSAGES
*
TEXTC:SE TEXTC    ' ERRORED BY USER'     * TEXTC ERRORED BY USER
TEXTC:C  TEXTC    ',C '             * TEXTC ,C
TEXTC:R  TEXTC    ',R '             * TEXTC ,R
TEXTC:E  TEXTC    ',E '             * TEXTC ,E
TEXTC:F  TEXTC    ',F '             * TEXTC ,F
*
TEXTC:PUBLIC TEXTC 'PUBLIC'
*
TEXT:ALL TEXT     'ALL'             * TEXT ALL
*
TEXTC:RIGHT:PAREN  ;
         TEXTC    ')   '            * RIGHT PAREN
*
TEXTC:LEFT:PAREN  ;
         TEXTC    '('               * LEFT PAREN
*
HEX000000FF DATA  X'000000FF'       * MASK OF X'000000FF'
*
HEX00000007 DATA  X'00000007'       * MASK OF X'00000007'
*
HEX00FFFFFF DATA  X'00FFFFFF'       * MASK OF X'00FFFFFF'
TEN      DATA     10                * CONSTANT OF TEN
*
FOURTEEN DATA     14                * CONSTANT OF FOURTEEN
*
BLANK:INPUT DATA  X'50000000'+BA(INPUT:BUFFER)   * SET UP FOR MBS
*
ZERO:STATUS DATA ((MAX#LINES/4)**24)+BA(STATUS) * SET UP TO CLEAR STATUSS
*
BINARY:ZERO DATA  0                 * BINARY ZEROS
*
         BOUND    8
DL:DATA  DATA     X'00070000',T:DEFER,J:TELFLGS,X'00800000'
*
BLANKS   DATA     '    ','    '     *  DOUBLE WORD OF BLANKS
*
*
*
         TITLE    'PIGEON MESSAGES'
*
*
LOW:PRIV:MSG      ;
         TEXTC    'UNABLE TO OBTAIN MASTER MODE'
*
BAD:MONSTK:MSG    ;
         TEXTC    'LOADED WITH INCORRECT MONSTK--RELOAD!'
*
NO:PAGE:MSG       ;
         TEXTC    'UNABLE TO GET REQUIRED PAGE OF MEMORY'
*
BAD:OPEN:MSG      ;
         TEXTC    'UNABLE TO OPEN M:SI'
*
BAD:READ:MSG      ;
         TEXTC    'UNABLE TO READ M:SI'
*
BAD:SEND:MSG      ;
         TEXTC    'SYNTAX ERROR IN ''SEND'' KEYIN - PLEASE RETRY'
*
BAD:ID:MSG        ;
         TEXTC    'INVALID ID IN ''SEND'' KEYIN - PLEASE RETRY'
*
BROADCAST:MSG     ;
         TEXTC    'BROADCAST COMPLETE'
*
DEFER:ID:MSG      ;
         TEXTC    'MESSAGE REJECTED BY USER - PLS RETRY LATER'
*
*
INVALID:ERR:MSG   ;
         TEXTC    'INVALID DEVICE ERROR BLOCK'
BREAK:MSG         ;
         TEXTC    'QUIT--YES/NO'
*
*
         END      PIGEON

