Retro1.org codex

*DECK KAPIGP
USETEXT NIPDEF
USETEXT PARAMS
USETEXT AHEADER 
USETEXT PT
USETEXT AT
USETEXT ACB 
USETEXT KDIS
USETEXT KHDRX 
USETEXT DISTAIL 
USETEXT SUPMSG
PRGM KAPIGP ; 
STARTIMS; 
 #
*1DC  KAPIGP
* 
*     1. PROC NAME           AUTHOR              DATE 
*        KAPIGP              A. BEN-ARTZI        82/03/01 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        PROCESS K-DISPLAY "AP" AND "IG" COMMAND. 
* 
*     3. METHOD USED
*        FOR "AP" COMMAND - FORMAT A HOP/START
*        FOR "IG" COMMAND - FORMAT A HOP/IG 
* 
*     4. ENTRY PARAMETERS 
*        PARAMS2 - INDICATE TYPE OF COMMAND 
*        PARAMS6 - APPLICATION NAME FROM COMMAND IF SPECIFIED 
* 
*     5. EXIT PARAMETERS
*        PARAMS7 - ERROR CODE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        NIPDEF     PARAMS     AHEADER
*        PT     AT     ACB
*        KDIS     DISTAIL     SUPMSG
*        OSSIZE 
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*        BLINK - LINK MESSAGE ON DATA RING
*        KPUT - K-DISPLAY DYNAMIC UPDATE INTERFACE
*        MGETS - ALLOCATE BUFFER
*        OSCHAPP - SCHEDULE APPLICATION 
*        XTRACE - TRACE PROCEDURE CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS IS A SECONDARY OVERLAY CALLED BY KPTYPIN. 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
 #
STOPIMS;
# 
      EXTERNAL REFERENCES 
# 
      XREF
        BEGIN 
        PROC MGETS ;
        PROC BLINK ;
        PROC KPUT  ;
        PROC OSCHAPP; 
        PROC XTRACE ; 
        LABEL RJMAIN; 
        END 
# 
      INTERNAL VARIABLES
# 
        ITEM ACBADDR ;
        ITEM BUFADDR ;
        ITEM KAPNO   ;
        ITEM KWHERE ; 
        ITEM KINDEX  ;
 
      SWITCH KN DM,KA,KB,KC,KD,KE ; 
 
      BASED ARRAY KALTNR [1:1] S(1) ; 
        BEGIN 
        ITEM KALTN C(0,0,7) ; 
        END 
 
      BASED ARRAY HOPBASE S(1); 
         BEGIN
         ITEM HOPLEFT  U(0,36,12); # LEFT PAGE SIZE FIELD OF HOP/START #
         ITEM HOPRIGHT U(0,48,12); # RIGHT PAGE SIZE FIELD OF HOP/START#
         END
 
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("KAPIG") ; 
      CONTROL FI           ;
 
      BEGIN 
         PARAMS7 = 0 ; # INITIAL NO ERROR STATE # 
      IF PARAMS6 EQ " " 
      THEN
        BEGIN 
        IF KDNAL[0] EQ 0
        THEN
        BEGIN 
        PARAMS7 = 1 ; 
        GOTO KEXIT ;
        END 
        ELSE
          BEGIN 
          PARAMS6 = KAPALT1[0]; 
          KDALAN1[0]=KDALAN2[0];
          KDALAN2[0]=KDALAN3[0];
          KDALAN3[0]=KDALAN4[0];
          KDALAN4[0]=KDALAN5[0];
          KDALAN5[0]=0; 
          KDNAL[0] = KDNAL[0] - 1;
          KAPALT1[0]=KAPALT2[0];
          KAPALT2[0]=KAPALT3[0];
          KAPALT3[0]=KAPALT4[0];
          KAPALT4[0]=KAPALT5[0];
          KAPALT5[0]=" "; 
          END 
        END 
      ELSE
        BEGIN 
#              NOW CHECK FOR THIS NAME IN ALERT Q LISTING              #
        KWHERE = 0; 
        P<KALTNR> = LOC(KAPALT1[0]);
        FOR KINDEX=1 STEP 1 WHILE KWHERE EQ 0 AND KINDEX LQ KMAXALT DO
          BEGIN 
          IF KALTN[KINDEX] EQ PARAMS6 
          THEN
            KWHERE = KINDEX ; 
          END 
# 
            WE HAVE NOW IN KWHERE THE SEQ NO OF ALERT (OR 0)
# 
        IF KWHERE NQ 0           # START SHIFTING THEM ALL             #
        THEN
          BEGIN 
          FOR KINDEX = KWHERE STEP 1 UNTIL KMAXALT-1 DO 
            BEGIN 
            KALTN[KINDEX] = KALTN[KINDEX+1];
            END 
          KAPALT5[0] = " " ;
          GOTO KN[KWHERE];
DM:       ;                      # DUMMY ENTRY                         #
KA:       KDALAN1[0] = KDALAN2[0];
KB:       KDALAN2[0] = KDALAN3[0];
KC:       KDALAN3[0] = KDALAN4[0];
KD:       KDALAN4[0] = KDALAN5[0];
KE:       KDALAN5[0] = 0 ;
          KDNAL[0] = KDNAL[0] -1; 
          END 
        END 
# 
      NOW LET S  GET APPLICATION NUMBER IF ANY
# 
      KFACB;
      IF KAPNO NQ 0 
      THEN
        BEGIN 
        IF NOT ATK[KAPNO] # APPLICATION NOT ALLOWED FOR K-DISPLAY#
        THEN
          BEGIN 
          PARAMS7 = 2 ; 
          GOTO KEXIT ;
          END 
        ELSE
          BEGIN 
          IF PARAMS2 EQ 0   # THIS IS A  -AP-  TYPE-IN #
          THEN       # WE HAVE THE APPLICATION WE WANT START WORKING  # 
#                                                             WITH     #
            BEGIN 
            PARAMS4 = KAPNO ; 
            ATI[KAPNO]=FALSE ;# IN CASE OF A FORMER IGNORE             #
# 
            BUILD THE HOP/START BLOCK 
# 
            KGET(HOPSTRT,LHOPSTR,BUFADDR) ; 
            P<HOPBASE>=P<SUPMSG>; 
            HOPLEFT=KLSIZE-KERRL; 
            HOPRIGHT=KRSIZE;
            GOTO SEND ; 
            END 
          ELSE                  # WE SEND AN IGNORE TO APPL         # 
            BEGIN 
# 
            BUILD THE HOP/IG BLOCK
# 
            KGET(HOPIG,LHOPIG,BUFADDR) ;
# 
            SET THE IGNORE FLAG IN AT ENTRY 
# 
            ATI[KAPNO] = TRUE ; 
            P<ACB> = ATACBA[KAPNO]; 
            IF KDST[0]
              AND ACBKNDX[0] NQ 0 
              AND ACBKNDX[0] GQ KDAPPST[0]
              AND ACBKNDX[0] LQ KDAPPND[0]
            THEN
              BEGIN 
                KPUT(KHDRNP[0],ACBKNDX[0]-KDAPPST[0],KPAPI,"Y") ; 
              END 
            GOTO SEND;
            END 
          END 
        END 
      ELSE         # NO AP OR IG COMMAND WHEN APPLICATION IS NOT ON    #
        BEGIN 
        PARAMS7 = 3 ; 
        GOTO KEXIT ;
        END 
      END 
SEND:  BEGIN
          BLINK(BUFADDR,ATACBA[KAPNO]) ;
          OSCHAPP(ATACBA[KAPNO]); 
       END
KEXIT: BEGIN
         KBUF1[0] = 0 ; 
         GOTO RJMAIN  ; 
       END
# 
   -------------------- 
# 
 PROC KGET(KCODE,KL,BUF); 
      ITEM KCODE U; 
      ITEM KL    U; 
      ITEM BUF   U; 
 BEGIN
     MGETS(KL+BLKHSIZE+ABHSIZE,BUF,TRUE); 
     P<SUPMSG>=BUF+BLKHSIZE+ABHSIZE;
     P<AHEADER> = BUF+BLKHSIZE;# BASE APPLICATION HEADER #
     PFCSFC[0] = KCODE ; # SET FUNCTION CODE #
#                                                                      #
    ABHTLC[0]=KL; # LENGTH OF MESSAGE # 
    ABHABT[0]=APPCMD;             # THIS IS A COMMAND BLOCK # 
    ABHACT[0]=CT60TRANS;          #CHARACTER TYPE           # 
    ABHABN[0]=0;
    ABHADR[0]=0;
    RETURN; 
 END
# 
   -----------------------
# 
 PROC KFACB;
 BEGIN
# 
   LET-S GET ACB AND APPLICATION NUMBER 
# 
      BEGIN 
        KAPNO=0;
        IF PARAMS6 EQ "CS"
        THEN
        BEGIN 
        KAPNO = PROCAN[CSORD];
        END 
        ELSE
          BEGIN 
          IF PARAMS6 EQ "NVF" 
          THEN
          BEGIN 
          KAPNO=NVFAN   ; 
          END 
          ELSE
            BEGIN 
            IF PARAMS6 EQ "NS"
            THEN
            BEGIN 
            KAPNO = PROCAN[NSORD];
            END 
            ELSE
              BEGIN  # NOT CS NS OR NVF. TRY LOOK AT ALL ACB-S #
              FOR KINDEX = NVFAN+1 STEP 1 WHILE (KINDEX LQ ATHAN[0] AND 
                                                KAPNO EQ 0) DO
                BEGIN 
                ACBADDR = ATACBA[KINDEX]; 
                IF ( ACBADDR NQ 0 ) 
                THEN
                  BEGIN 
                  P<ACB> = ACBADDR; 
                  IF PARAMS6 EQ ACBANAME[0] 
                  THEN
                  KAPNO = ACBAN[0]; 
                  END 
                END 
              END 
            END 
          END 
      END 
   RETURN;
 END
 END   # MAIN # 
TERM