Retro1.org codex

*DECK QTPUT 
USETEXT AIPDEF
USETEXT QTRMCOM 
USETEXT QTRMNIT 
PROC QTPUT(WSA);
*IF DEF,IMS 
 #
*1DC  QTPUT 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        QTPUT               J.C. LEE            79/01/12 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        SEND A MESSAGE TO A SPECIFIED TERMINAL.
* 
*     3. METHOD USED
*          ENTRY POINT QTPUT: 
*            SET QTTIPCALL FLAG TO FALSE. 
*          ENTRY POINT QTTIP: 
*            SET QTTIPCALL FLAG TO TRUE.
*          IF NETON NOT SUCCESSFUL, 
*            CALL NP$ERR TO ISSUE DAYFILE MSG AND ABORT APP.
*          ELSE (NETON HAS COMPLETED),
*            IF CONNECTION NUMBER IS BAD, 
*              SET SEC-RETURN-CODE FIELD IN NIT TO ERROR CODE.
*            ELSE (CONNECTION EXISTS),
*              IF CONNECTION HAS BEEN LOANED TO ANOTHER APP,
*                SET SEC-RETURN-CODE FIELD IN NIT TO ERROR CODE.
*              ELSE (CONNECTION BELONGS TO THIS APPLICATION), 
*                IF CONNECTION IS IN WRONG STATE, 
*                  SET SEC-RETURN-CODE FIELD IN NIT TO ERROR CODE.
*                ELSE (CONNECTION IS IN GOOD STATE FOR CALL), 
*                  IF CONNECTION IS AT BLOCK LIMIT, 
*                    SET SEC-RETURN-CODE FIELD IN NIT TO ERROR CODE.
*                  ELSE (BLOCK CAN BE SENT TO NAM), 
*                    IF A-A DISPLAY CODE CONNECTION 
*                      AND DATA BLOCK IS WRONG SIZE,
*                      SET SEC-RETURN-CODE FIELD IN NIT TO ERROR CODE.
*                    ELSE (OKAY TO SEND BLOCK), 
*                      IF DISPLAY CODE DATA,
*                        IF SIZE NOT SPECIFIED, 
*                          SCAN DATA BLOCK TO DETERMINE SIZE. 
*                        IF TERMINAL CONNECTION,
*                          ADD LINE TERMINATOR TO END OF DATA BLOCK.
*                      SET UP APPLICATION BLOCK HEADER WORD.
*                      CALL NETPUT TO SEND DATA BLOCK TO NAM. 
* 
*     4. ENTRY CONDITIONS 
*        NIT$STATE - CURRENT STATE OF THE CONNECTION
*        NIT$C$ABL - CURRENT APPLICATION BLOCK LIMIT OF THE CONNECTION
*        NIT$CHAR$SET - CHARACTER SET TO BE USED
*        NIT$CON - CONNECTION TO RECEIVE THE OUTPUT DATA
*        NIT$CTLC - CURRENT TEXT LENGTH IN CHARACTERS 
*        NIT$MTLC - MAXIMUM TEXT LENGTH ALLOWED 
*        NIT$INT$MSG - SET IF DATA IS A -BLK-, CLEARED IF A -MSG- 
*        NIT$QDATA - SET IF DATA IS QUALIFIED DATA
*        WSA - LOCATION OF MESSAGE TEXT TO BE OUTPUT
* 
*     5. EXIT CONDITIONS
*        NIT$RC - RETURN CODE, 0 IF DATA IS SENT TO NAM, AND 5 IF 
*                 THE APPLICATION BLOCK LIMIT IS EXCEEDED.
*        NIT$ABN - LAST ABN SENT IS INCREMENTED BY 1
*        NIT$C$ABL - CURRENT ABL IS DECREMENTED BY 1
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        AIPDEF    NP$CRT    QTRMCOM   QTRMNIT
* 
*     7. ROUTINES CALLED
*        NETPUT - AIP PROCEDURE TO OUTPUT DATA TO NETWORK 
*        NP$ERR - AIP PROCEDURE TO DAYFILE ERROR MESSAGES 
* 
*     8. DAYFILE MESSAGES 
*        NETWORK APPLICATION ABORTED, RC = 72.
*        QTPUT: REQUEST INVALID BEFORE QTOPEN.
* 
* 
 #
*ENDIF
 
# 
      CONTROL DEFINITIONS 
# 
      CONTROL PRESET; 
      CONTROL PACK; 
      CONTROL DISJOINT; 
      CONTROL INERT;
      CONTROL FASTLOOP; 
 
*CALL NP$CRT
 
# 
      ROUTINES CALLED 
# 
    XREF
      BEGIN 
      PROC NP$ERR;                      # DAYFILE ERROR MESSAGES       #
      PROC NETPUT;                      # OUTPUT DATA TO NETWORK       #
      END 
# 
      LOCAL VARIABLES 
# 
    ARRAY WSA [0:204] S(1);            # OUTPUT MESSAGE TEXT AREA      #
      BEGIN 
      ITEM WSA$WORD    C(0,0,WC); 
      ITEM WSA$LSW     I; 
      END 
 
      ITEM
        ACN            I,               # CONNECTION NUMBER            #
        I              I,               # TEMPORARY VARIABLE           #
        J              I,               # TEMPORARY VARIABLE           #
        K              I,               # TEMPORARY VARIABLE           #
        LEN            I;               # TEXT LENGTH IN CHARACTERS    #
      ITEM QTTIPCALL B ;
      CONTROL EJECT;
# 
      BEGIN QTPUT PROCESSING
# 
   BEGIN
 
      QTTIPCALL = FALSE ; 
      GOTO QTPUT1 ; 
 
      ENTRY PROC QTTIP(WSA) ; 
      QTTIPCALL = TRUE ;
 
QTPUT1: 
      IF NOT NETON$STATUS               # CHECK IF NETON IS COMPLETED  #
      THEN
        IF QTTIPCALL
        THEN
          NP$ERR("74") ;
        ELSE
          NP$ERR("72") ;     # QTPUT CALLED BEFORE NETTED ON           #
 
      P<NIT> = NIT$ADDR;
      NIT$RC[0] = S"QTPUTREJ";          # INITIALIZE TO BAD CALL       #
      ACN = NIT$CON[0];                 # SPECIFIED ACN                #
 
      IF (NIT$STATE[ACN] EQ S"NULL") OR 
         (NIT$STATE[ACN] EQ S"WCONENDN") OR 
         (ACN EQ 0) OR
         (ACN GR NIT$NO$TERMS[0]) 
      THEN                   # CONNECTION IS NONEXISTENT               #
        BEGIN 
        NIT$S$RC[0] = S"BADCN"; # RETURN LOGICAL ERROR REASON CODE     #
        END 
      ELSE                   # CONNECTION EXISTS OR LOANED             #
        BEGIN 
        IF (NIT$STATE[ACN] EQ S"LEND") OR 
           (NIT$STATE[ACN] EQ S"LENT")
        THEN                 # CONNECTION HAS BEEN LOANED TO ANOTHER AP#
          BEGIN 
          NIT$S$RC[0] = S"CONLOANED";  # STORE REASON FOR BAD CALL     #
          END 
        ELSE                 # CONNECTION EXISTS                       #
          BEGIN 
          IF (NIT$STATE[ACN] EQ S"LIMBO") OR
             (NIT$STATE[ACN] EQ S"POSE") OR 
             ( (NIT$STATE[ACN] GQ STATE"WAITPRU") AND 
               (NIT$STATE[ACN] LQ STATE"PRUEOO" )    ) OR 
             (NIT$STATE[ACN] EQ S"LENDRET") 
          THEN               # DATA CANNOT BE SENT ON CON IN THIS STATE#
            BEGIN 
            NIT$S$RC[0] = S"BADSTATE";  # STORE REASON FOR BAD CALL    #
            END 
          ELSE               # CONNECTION IS IN GOOD STATE FOR CALL    #
            BEGIN 
            IF NIT$C$ABL[ACN] EQ 0
            THEN             # ABL HAS BEEN EXCEEDED                   #
              BEGIN 
              NIT$S$RC[0] = S"OVERABL"; # STORE REASON FOR BAD CALL    #
              END 
            ELSE             # OKAY TO SEND DATA BLOCK ON THIS CON     #
              BEGIN 
              LEN = NIT$CTLC[0];        # TEXT LENGTH IN CHARACTERS    #
 
              K = NIT$MTLC[0] - (NIT$MTLC[0]/4)*4;
              J = NIT$CTLC[0] - (NIT$CTLC[0]/4)*4;
              IF (NIT$DEVTYP[ACN] NQ 0) AND 
                 (NIT$CHAR$SET[0] EQ CT6DISPLAY) AND
                 ( ( (LEN EQ 0) AND (K NQ 0) ) OR 
                   ( (LEN NQ 0) AND (J NQ 0) ) )
              THEN           # BAD SIZE FOR DISPLAY CODE DATA ON A-A   #
                BEGIN 
                NIT$S$RC[0] = S"AAACT4ERR";  # STORE REASON FOR BAD CAL#
                END 
              ELSE           # GOOD QTPUT CALL                         #
                BEGIN 
                NIT$RC[0] = S"OK";  # NORMAL COMPLETION RETURN CODE    #
                IF NIT$CHAR$SET[0] EQ CT6DISPLAY
                THEN         # MESSAGE IS IN DISPLAY CODE              #
                  BEGIN 
                  IF LEN EQ 0 
                  THEN                    # COMPUTE MESSAGE LENGTH     #
                    BEGIN                 # SCAN BACKWARD FOR NON-BLANK#
                    K = NIT$MTLC[0]-(NIT$MTLC[0]/10)*10;
                    FOR I=NIT$MTLC[0]/10 WHILE C<K,1>WSA$WORD[I] EQ " " 
                        AND I GQ 0
                    DO
                      BEGIN 
                      IF K EQ 0 
                      THEN
                        BEGIN 
                        K = 9;
                        I = I - 1;
                        END 
                      ELSE
                        BEGIN 
                        K = K - 1;
                        END 
                      END 
                    LEN = (I*10) + K + 1; 
                    IF NIT$DEVTYP[ACN] NQ 0 
                    THEN     # NEED TO ROUND UP TO NEAREST MULT OF 4   #
                      BEGIN 
                      LEN = ((LEN+3)/4)*4;
                      END 
                    END 
 
                  IF NIT$DEVTYP[ACN] EQ 0 
                  THEN       # TERMINAL CONNECTION                     #
                    BEGIN 
                    J = LEN/10; 
                    K = LEN-(J*10);  # NO OF CHARS IN LAST WORD        #
                    FOR I=K STEP 1 UNTIL 9 DO 
                      BEGIN  # FORM 0 BYTES TERMINATOR                 #
                      C<I,1> WSA$WORD[J] = 0; 
                      END 
                    IF K EQ 9 
                    THEN     # LINE TERMINATOR IS 66 0 BITS            #
                      BEGIN 
                      J = J+1;
                      WSA$LSW[J] = 0; 
                      END 
 
                    LEN = (J+1)*10;  # LENGTH OF OUTPUT MESSAGE        #
                    END 
 
                  END 
 
                NIT$ABN[ACN] = NIT$ABN[ACN] + 1;
                NIT$C$ABL[ACN] = NIT$C$ABL[ACN] - 1;
 
                ABHWORD[0] = 0;  # INITIALIZE ABH WORD                 #
# 
                SET UP ABH WORD 
# 
                ABHADR[0] = ACN ; 
                ABHABN[0] = NIT$ABN[ACN] ;
                ABHACT[0] = NIT$PUTSET[0] ; 
 
                IF QTTIPCALL
                THEN
                  BEGIN 
                  ABHABT[0] = APPCMD;  # BLOCK TYPE 3 FOR QTTIP CASE   #
                  END 
                ELSE         # QTPUT CALL                              #
                  BEGIN 
                  IF NIT$INT$MSG EQ 0 
                  THEN
                    BEGIN 
                    IF NIT$QDATA[0] EQ 0
                    THEN     # NOT QUALIFIED DATA                      #
                      BEGIN 
                      ABHABT[0] = APMSG ; 
                      END 
                    ELSE     # QUALIFIED MSG BLOCK                     #
                      BEGIN 
                      ABHABT[0] = APPQMSG;  # SET BLOCK TYPE IN ABH    #
                      END 
                    END 
                  ELSE       # BLOCK BLOCK TYPE                        #
                    BEGIN 
                    IF NIT$QDATA[0] EQ 0
                    THEN     # NOT QUALIFIED DATA                      #
                      BEGIN 
                      ABHABT[0] = APPBLK ;  # SET BLOCK TYPE IN ABH    #
                      END 
                    ELSE     # QUALIFIED MSG BLOCK                     #
                      BEGIN 
                      ABHABT[0] = APPQBLK;  # SET BLOCK TYPE IN ABH    #
                      END 
                    END 
 
                  IF NIT$DEVTYP[ACN] EQ 0 
                  THEN       # TERMINAL CONNECTION                     #
                    BEGIN 
                    IF NIT$XPTSET[0] EQ 1 
                    THEN
                      BEGIN 
                      ABHXPT[0] = 1 ; 
                      END 
                    END 
                  ELSE       # APPLICATION-TO-APPLICATION CONNECTION   #
                    BEGIN 
                    IF NIT$CHAR$SET[0] EQ CT6DISPLAY
                    THEN     # SENDING DISPLAY CODE ON A-TO-A CON      #
                      BEGIN 
                      ABHACT[0] = CT8ASCII;  # CHANGE CHAR SET TO ASCII#
                      LEN = (LEN/4)*3;  # CONVERT TLC FOR ACT=2        #
                      END 
                    END 
                  END        # QTPUT CALL                              #
                ABHTLC[0] = LEN;
                NIT$DN$ABH[ACN] = ABHWORD[0]; # SET LAST DOWNLINE ABH  #
 
                NETPUT(HEADER, WSA);  # SEND DATA TO TERMINAL          #
 
                END 
              END 
            END 
          END 
        END 
      RETURN; 
      END 
TERM