Retro1.org codex

*DECK KPCLNUP 
USETEXT NIPDEF
USETEXT AHEADER 
USETEXT AT
USETEXT PT
USETEXT DRHDR 
USETEXT DISTAIL 
USETEXT KDIS
USETEXT KHDRX 
USETEXT KINITBF 
USETEXT SUPMSG
PRGM KPCLNUP    ; 
 STARTIMS;
 #
*1DC  KPCLNUP 
* 
*       1. PROC NAME    AUTHOR           DATE 
*          KPCLNUP      A. BEN-ARTZI     81/12/02 
* 
*       2. FUNCTIONAL DESCRIPTION.
* 
*          CLEANS UP WHATEVER IS LEFT AFTER QUITING FROM K-DISPLAY. 
* 
*          RELEASE ALL GARBAGE BUFFERS,INITIATE THE SCREEN (SEE IKDIS)
* 
*       3. METHOD USED
* 
*          GET THE CHAIN POINTERS FROM KDIS. GO OVER POINTERS AND 
*          RELEASE BUFFERS. THEN REQUEST NEW BUFFER TO INITIATE BLANK 
*                                                               SCREEN. 
* 
*       4. ENTRY PARAMETERS 
* 
*          NONE.
* 
*       5. EXIT PARAMETERS
* 
*          NONE.
* 
*       6. COMDECKS CALLED AND SYMPL TEXT USED
* 
*            NIPDEF      DRHDR   KDIS     KINITBF 
*            SUPMSG     AHEADER     AT     PT 
*            DISTAIL     KHDRX     OSSIZE 
* 
*       7. ROUTINES AND OVERLAYS CALLED 
* 
*        CONSOL - EXECUTE NOS CONSOLE MACRO 
*          MRELS - RELEASE BUFFER SPACE 
*          BLINK - LINK MESSAGE ON DATA RING
*          OSCHAPP - SCHEDULE APPLICATION 
*          MGETS - ALLOCATE BUFFER
*          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 VARIABLES
# 
          XREF
            BEGIN 
            PROC BLINK ;
            PROC CONSOL;     # EXECUTE NOS CONSOLE MACRO               #
            PROC OSCHAPP ;
            PROC MRELS; 
            PROC MGETS; 
            PROC XTRACE;
            LABEL RJMAIN ;
            END 
            ITEM  KINDEX I = 0 ; #  LOCAL COUNTER # 
            ITEM  KBLANK C(10) = O"55555555555555550000"; # BLANK # 
            ITEM KNEXT U; 
            ITEM  KADDR I; # HOLDS THE ADDRESS OF A NEW BUFFER #
 BEGIN
 
        CONTROL IFEQ DEBUG,1; 
           XTRACE("KPCLN"); 
        CONTROL FI; 
 
 KDAPNM[0] = "NAM"; 
 KREPEAT[0]=" ";
# 
    AND UPDATE ALL STATUS FLAGS TO RESET STATE
# 
 KDBK[0]=FALSE; 
 KDNI[0]=TRUE;
 KDST[0]=FALSE; 
      IF KDDAYF[0]
      THEN                   # K-DISPLAY TYPEINS ARE NOT BEING DAYFILED#
        BEGIN 
        KDDAYF[0] = FALSE;   # CHANGE BACK TO DAYFILING K-DISPLY TYPEIN#
        CONSOL(KDWDCON);     # EXECUTE CONSOLE MACRO                   #
        END 
      KDIS$STAT = 0;         # CLEAR STATUS DISPLAY UPDATE INDICATOR   #
      KDIS$RT = KDST[0] AND KFAST[0]; 
# 
           BASE ON ORIGINAL BUFFER TO RE-FORMAT AND USE IT
# 
      BEGIN 
      IF KDORIG[0]
      THEN              # WE DID NOT RELEASED IT YET FROM RING #
        BEGIN 
        IF NOT KDAM[0]
        THEN            # NUM MODE - BLANK BUFFER AT BOTTOM    #
          KADDR = KDBP[0] ; 
        ELSE            # APPLICATION MODE - BUFFER ON TOP     #
          KADDR = KDFP[0] ; 
        END 
      ELSE
        KADDR = KORIGFP[0] ; # RESTORE IT FROM WHERE WE SAVED IT #
      END 
# 
   NOW BEFORE WE  UPDATE  KDFP AND KDBP TO THE NEW BUFFER WE USE THEM 
             FOR THE BUFFER COLLECTION. 
# 
  FOR KINDEX = 0 WHILE KDFP[0] NQ LOC(KDFP[0]) DO 
    BEGIN 
    P<DRHDRWD> = KDFP[0]; 
    KNEXT = NEXTPTR[0]; # SAVE LOCATION OF NEXT DATA BUFFER # 
    IF KDFP[0] NQ LOC(KHDRBP[0])       # NOT HEADER BLOCK  #
       AND KDFP[0] NQ KADDR            # NOT ORIGINAL BUFFER #
    THEN
      MRELS(KDFP[0]); 
    KDFP[0] = KNEXT;
    END 
# 
    NOW RELEASE RIGHT KDISPLAY BUFFERS
# 
   FOR KINDEX = 0 WHILE KDRFP[0] NQ LOC(KDRFP[0]) AND KDRFP[0] NQ 0 DO
      BEGIN 
      P<DRHDRWD> = KDRFP[0];
      KNEXT = NEXTPTR[0]; # SAVE LOCATION OF NEXT DATA BUFFER # 
      MRELS(KDRFP[0]);  # RELEASE BUFFER #
      KDRFP[0]=KNEXT; 
      END 
   KDRFP[0]=0;
   KDRBP[0]=0;
   KDRSTOP[0]=0;
   KDETAIL[0]=FALSE;
   KSHOW[0]=TRUE; 
   KDRNXT[0]=1; 
# 
           PUT POINTERS IN HEADER 
# 
  KDORIG[0]=TRUE; 
 P<DRHDRWD> = KADDR;
#                                                                      #
  BLKID[0] = KDISIDVALUE ;
  BACKPTR[0] = LOC(KDBP[0]);
  NEXTPTR[0] = LOC(KDFP[0]);
# 
              PUT INITIAL VALUES IN NEW BUFFER
# 
 P<KINITBF> = KADDR + BLKHSIZE+KHDRSIZE ; 
  KERROR[KLSIZE-KERRL-2] = " "; 
  KWORD[KLSIZE-3] = KBLANK ;
  K311[KLSIZE-2] = " "; 
  KREADY[KLSIZE-2] = "READY.."; 
  K312[KLSIZE-2] = 0; 
  KDSTAIL[KLSIZE-1] = LOC(KDTLNAM)+1; 
  K7777[KLSIZE-1] = O"7777" ; 
# 
             POINT WITH START-OF-DATA-POINTER TO TOP SCREEN 
# 
  KDLSTOP[0] = KADDR + BLKHSIZE+KHDRSIZE ;
#                                                           # 
 KDFP[0] = KADDR; 
 KDBP[0] = KADDR; 
#                                                                      #
      IF KDAM[0]
      THEN
        BEGIN 
        KDAM[0]=FALSE;# BACK TO NAM MODE  # 
 
        IF ATACBA[KDAN[0]] NQ 0 # APPLICATION STILL THERE              #
          AND NOT ATNVFN[KDAN[0]] # APPLICATION NOT NETOFFED           #
          AND NOT ATNVFF[KDAN[0]] # APPLICATION NOT FAILED             #
        THEN # LINK HOP/END TO TERMINATE K DISPLAY ASSIGNMENT          #
        BEGIN 
          MGETS(LHOPEND+BLKHSIZE+ABHSIZE,KADDR,TRUE) ;
# 
                      BUILD THE HOP/END BLOCK 
# 
        P<SUPMSG>=KADDR+BLKHSIZE+ABHSIZE; 
        P<AHEADER> = KADDR+BLKHSIZE;# BASE APPLICATION HEADER # 
        PFCSFC[0] = HOPENDD ; # SET FUNCTION CODE # 
        ABHTLC[0]=LHOPEND; # LENGTH OF MESSAGE #
        ABHABT[0]=APPCMD;             # THIS IS A COMMAND BLOCK # 
        ABHACT[0]=CT60TRANS;          #CHARACTER TYPE           # 
        ABHABN[0]=0;
        ABHADR[0]=0;
        HOPBN[0] = KLASTBN[0]; # LAST ABN FROM HOP/DIS/U #
        KLASTBN[0] = 0 ;
        BLINK(KADDR,ATACBA[KDAN[0]]) ;
        OSCHAPP    (ATACBA[KDAN[0]]) ;
        END 
        END 
      KDAN[0] = 0 ; 
  GOTO RJMAIN ; 
 END
TERM