Retro1.org codex

*DECK KNAMMOD 
USETEXT NIPDEF
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PT
USETEXT AT
USETEXT ACB 
USETEXT AHEADER 
USETEXT SUPMSG
USETEXT KDIS
PRGM KNAMMOD ; # EXECUTE K-DISPLAY NAM-MOD COMMANDS # 
STARTIMS; 
 #
*1DC  KNAMMOD 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        KNAMMOD             A. BEN-ARTZI        82/03/01 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        EXECUTE K-DISPLAY NAM-MODE COMMANDS. 
* 
*     3. METHOD USED
*        SWITCH ON COMMAND TYPE 
*        FIND APPLICATION NUMBER IF COMMAND IS FOR A SPECIFIC 
*        APPLICATION. 
*        FORMAT HOP COMMAND 
* 
*     4. ENTRY PARAMETERS 
*        PARAMS6 - APPLICATION NAME 
* 
*     5. EXIT PARAMETERS
*        PARAMS7 - ERROR FLAG 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        NIPDEF     PARAMS     PT     AT
*        ACB     AHEADER     SUPMSG 
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*        BLINK - LINK MESSAGE ON DATA RING
*        MGETS - ALLOCATE BUFFER
*        OSCHAPP - SCHEDULE APPLICATION 
*        XTRACE - TRACE PROCEDURE CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS SECONDARY OVERLAY IS CALLED BY KPTYPIN. 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
 #
STOPIMS ; 
# 
      EXTERNAL REFS 
# 
      XREF
        BEGIN 
        PROC XTRACE ; 
        PROC BLINK  ; 
        PROC OSCHAPP; 
        PROC OVLCALL ;
        PROC MGETS  ; 
        LABEL RJMAIN ;
        END 
# 
      INTERNAL VARIABLES
# 
      SWITCH KLAB:NCT        # STATUS SWITCH FOR K DISPLAY COMMAND     #
        KDB:CMD$DB, 
        KDE:CMD$DE, 
        KDU:CMD$DU, 
        KLE:CMD$LE, 
        KRS:CMD$RS, 
        KLB:CMD$LB, 
        KLR:CMD$LR; 
 
      ITEM KAPNO ;
      ITEM BUFADDR ;
      ITEM ACBADDR ;
      ITEM KINDEX  ;
 
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("KNAMD")    ;
      CONTROL FI           ;
 
      PARAMS7 = 0     ; # INITIAL NO-ERROR STATE #
      GOTO KLAB[PARAMS3] ;
#                                                                      #
KDU:   BEGIN
         KSEND(HOPDU,LHOPDU,BUFADDR); 
         GOTO KEXIT ; 
       END
#                                                                      #
KDB:   BEGIN
         KSEND(HOPDB,LHOPDB,BUFADDR); 
         GOTO KEXIT ; 
       END
#                                                                      #
KDE:   BEGIN
         KSEND(HOPDE,LHOPDE,BUFADDR); 
         GOTO KEXIT ; 
       END
#                                                                      #
KLE:   BEGIN
         KSEND(HOPNOTR,LHOPNTR,BUFADDR);
         GOTO KEXIT ; 
       END
#                                                                      #
KRS:   BEGIN
         KSEND(HOPRS,LHOPRS,BUFADDR); 
         GOTO KEXIT ; 
       END
#                                                                      #
KLB:   BEGIN
         KSEND(HOPTRCE,LHOPTRA,BUFADDR);
         GOTO KEXIT ; 
       END
#                                                                      #
KLR:   BEGIN
         KSEND(HOPREL,LHOPREL,BUFADDR); 
         GOTO KEXIT ; 
       END
 
KEXIT: GOTO RJMAIN ;
 
# 
   ---------------------- 
# 
 PROC KSEND(KCODE,KL,BUF);
 ITEM KL    U;
 ITEM KCODE U;
 ITEM BUF   U;
      BEGIN 
        IF PARAMS6 EQ " " 
        THEN
          PARAMS7 = 5 ; 
        ELSE
          BEGIN 
          IF PARAMS6 NQ "ALL" 
          THEN                    # IT IS A SPECIFIC APPLICATION #
            BEGIN 
            KFACB;                # TRY TO GET ITS APP NUMBER    #
            IF KAPNO NQ 0 
            THEN                  # OK WE FOUND IT               #
              BEGIN 
                KGET (KCODE,KL,BUF);
                BLINK(BUF,ATACBA[KAPNO]); 
                OSCHAPP(ATACBA[KAPNO]); 
              END 
            ELSE                  # NO SUCH APPLICATION ON NETWORK# 
              PARAMS7 = 3 ; 
            END 
          ELSE                    # WE SEND TO ALL APPS ON NETWORK# 
            BEGIN 
            FOR KINDEX = 1 STEP 1 UNTIL ATHAN[0] DO 
              BEGIN 
              IF ATACBA[KINDEX] NQ 0
              THEN
                BEGIN 
                KGET(KCODE,KL,BUF); 
                BLINK(BUF,ATACBA[KINDEX]);
                OSCHAPP(ATACBA[KINDEX]);
                END 
              END 
            END 
          END 
        RETURN; 
        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];  # SET AN FROM PT COMMON                #
        END 
        ELSE
          BEGIN 
          IF PARAMS6 EQ "NVF" 
          THEN
          BEGIN 
          KAPNO=NVFAN   ; 
          END 
          ELSE
            BEGIN 
            IF PARAMS6 EQ "NS"
            THEN
            BEGIN 
            KAPNO = PROCAN[NSORD];  # SET AN FROM PT COMMON            #
            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