Retro1.org codex

*DECK KHOPDIS 
USETEXT NIPDEF
USETEXT DRHDR 
USETEXT KINITBF 
USETEXT ACB 
USETEXT KDIS
USETEXT DISTAIL 
USETEXT SUPMSG
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT APPSTAT 
USETEXT NWLNTRY 
PRGM KHOPDIS; 
 STARTIMS;
 #
*1DC  KHOPDIS 
* 
*       1. PROC NAME    AUTHOR             DATE 
*          KHOPDIS      A. BEN-ARTZI       81/12/08 
* 
*       2. FUNCTIONAL DESCRIPTION 
* 
*          PUT HOP/DIS MESSAGES ON K-DISPLAY SCREEN 
* 
*       3. METHOD USED
*          DECODE OUT THE DIS MESSAGE FROM NWL. 
*          RELEASE USED PORTION OF NWL. 
*          CHAIN BUFFER WITH K-DISPLAY DATA RING, AND 
*               RELEASE SAME NUMBER OF LINES FROM TOP OF RING.
* 
*       4. ENTRY PARAMETERS.
* 
*          WLADDR 
* 
*       5. EXIT PARAMETERS
* 
*          PARAMS1 - ERROR CODE (IF ANY)
* 
*       6. COMDECKS CALLED AND SYMPL TEXT USED
* 
*          NIPDEF     KDIS     DISTAIL
*          SUPMSG     APPSTAT     NWLNTRY 
*          DRHDR     KINITBF     PARAMS 
* 
*       7. ROUTINES AND OVRLAYS CALLED
* 
*          XTRACE - TRACE PROCEDURE CALL
*          MRELS - RELEASE BUFFER SPACE 
*          HRELPWL - RELEASE USED PORTION OF WORKLIST 
* 
* 
* 
* 
*       8. DAYFILE MESSAGES 
* 
*          THIS PROGRAM IS A SECONDARY OVERLAY LOADED BY
*          SUBROUTINE OVLCALL.  WHEN EXECUTION HAS COMPLETED, 
*          A JUMP IS MADE TO LOCATION RJMAIN TO RETURN TO 
*          THE CALLING PROGRAM. 
* 
*          W A R N I N G - THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
* 
*          THIS OVERLAY IS CALLED BY HPKDISP
* 
 #
 STOPIMS; 
# 
   EXTERNAL REFERENCES
# 
      XREF
        BEGIN 
        LABEL RJMAIN;   # RETURN ADDRESS IN OVLCALL                    #
        PROC XTRACE;
        PROC MRELS; 
        PROC HRELPWL; 
        END 
# 
   INTERNAL VARIABLES 
# 
        ITEM ENDLOOP  I=0 ; 
        ITEM KLINES I=0 ; # NUMBER OF LINES IN HOP/DIS RECEIVED        #
        ITEM KINDEX I=0; # LOCAL LOOP COUNTER                          #
        ITEM KCOUNT I=0; # LOCAL COUNTER                               #
        ITEM KDONE  B  ; # AND OF RELEASE LOOP   CHECK                 #
        ITEM K2     I=0; # NO OF DOWN LINES KDISTOP SHOULD MOVE        #
        ITEM KBACK  U ;  # ADDRESS OF FORMER BLOCK IN RING             #
        ITEM KREL   U ;  # ADDRESS OF BUFFER TO BE RELEASED            #
        BASED ARRAY HOPLN [1:1] S(1) ;
          BEGIN 
          ITEM HOPENDL U(0,48,12) ; 
          ITEM HOPSTRL U(0,0,12) ;
          ITEM HOPWRDL U(0,0,60) ;
          END 
      BEGIN 
         CONTROL IFEQ  DEBUG,1; 
           XTRACE("KHOPD"); 
         CONTROL FI;
#**********************************************************************#
      PARAMS1 = 0 ; 
# 
      FIRST PUT THE TABLETS 
# 
      P<DRHDRWD> = WLADDR;
      P<SUPMSG> = WLADDR + AIPHSIZE + ABHSIZE;
      P<HOPLN> = P<SUPMSG> + 1 ;
      IF HOPI[0]
      THEN         # WE CAN ENABLE INPUT TO APPLICATION                #
        BEGIN 
        KDNI[0]=FALSE;
        KDBK[0]=FALSE;
        END 
#                                                                      #
      P<KINITBF> = WLADDR + BLKBS[0]-1;  # TABLET ON LAST WORD OF BUFFR#
      IF P<KINITBF> LS P<HOPLN> 
      THEN     # NO DATA AT ALL. EVEN A ZERO WORD # 
        GOTO ERRX  ;
      IF HOPSCR THEN
         BEGIN
         K7777[0] = 0;
         KDSTAIL[0] = 0;                # END OF RIGHT DISPLAY         #
         END
      ELSE
         BEGIN
         K7777[0] = O"7777";
         KDSTAIL[0] = LOC(KDTLNAM[0])+1;# AND POINT TO NEXT DATA(TAIL) #
         END
# 
      SCAN ALL MESSAGE TO SEE HOW MANY LINES WE GOT (BYTE 4=BINARY 0
# 
      KLINES  = 0 ; 
      ENDLOOP = BLKBS[0] - AIPHSIZE - ABHSIZE - KHDRSIZE - 1 ;
      IF ENDLOOP EQ 0 
      THEN                # EMPTY HOPDIS #
        GOTO KEXIT  ; 
      IF HOPWRDL[1] EQ 0
      THEN                         # TERMINATOR WITHOUT TEXT           #
        GOTO ERRX ; 
      FOR KINDEX=1 STEP 1 UNTIL ENDLOOP DO
         BEGIN
         IF HOPSTRL[KINDEX] EQ 0 AND HOPWRDL[KINDEX] NQ 0 
         THEN 
           GOTO ERRX   ;
         IF HOPENDL[KINDEX] EQ 0
         THEN 
           BEGIN
           KLINES = KLINES+1; 
           IF (HOPWRDL[KINDEX+1] EQ 0) AND
              (KINDEX NQ ENDLOOP) 
           THEN                      # DSD MAY GET CONFUSED            #
             GOTO ERRX ;
           END
         END
 
      BLKID[0] = KDISIDVALUE;    # THEN MAKE IT A K TYPE BLOCK         #
      P<KINITBF> = WLADDR+BLKHSIZE ;
      KDTYPE[0]  = KDISTYPE        ;
      IF HOPSCR THEN
         BEGIN
           IF KDRFP[0] NQ 0 
           THEN              # PREVIOUS RIGHT SCREEN BUFFER EXISTS     #
             BEGIN
             MRELS(KDRFP[0]);  # RELEASE PREVIOUS RIGHT SCREEN BUFFER  #
             END
           HRELPWL;          # RELEASE FIRST PART OF NWL               #
         BACKPTR[0] = LOC(KDRBP[0]); # CHAIN BUF INTO RIGHT SCRN CHAIN #
         KDRBP[0] = WLADDR; 
         NEXTPTR[0] = LOC(KDRFP[0]);
         KDRFP[0] = WLADDR; 
         KDRSTOP[0] = WLADDR+3;  # POINT TO FIRST DISPLAY WORD         #
         GOTO RJMAIN; 
      END 
# 
      NOW WE UPDATE DATA AND POINTERS IN THE BLOCK WE JUST GOT
# 
      BACKPTR[0] = KDBP[0];      # FIRST PUT INTO K RING               #
      NEXTPTR[0] = LOC(KDFP[0]);
# 
      NOW UPDATE THE LAST BLOCK (TO BE CHAINED TO NEW ONE)
# 
      P<DRHDRWD> = KDBP[0];   # HERE IT IS                             #
#                                                                      #
      NEXTPTR[0] = WLADDR;
#                                                                      #
      P<KINITBF> = KDBP[0]+BLKBS[0]-1; # PUT TABLET ON LAST WORD OF BLK#
      KDSTAIL[0] = P<HOPLN> ;          # AND POINT TO NEW DATA         #
# 
      FINALLY SHOW THE CHAIN BOTTOM MOVE ON THE KDIS COMMON 
# 
      KDBP[0] = WLADDR; 
# 
      AND RELEASE USED PORTION ON NWL 
# 
      HRELPWL;
# 
      NOW WE MOVE KDISTOP POINTER DOWN,SAME LINES AS NEWLY CAME 
# 
      KCOUNT=0; 
      K2    =0; 
      KDONE = FALSE ; 
      P<KINITBF> = KDLSTOP[0]; # START COUNTING FROM CURRENT LOCATION  #
#                                                                      #
      FOR KINDEX =0 WHILE NOT KDONE    DO 
      BEGIN 
#                                                                      #
      IF K7777[KCOUNT] EQ O"7777"        # THIS IS NOT A DATA LINE   #
      THEN
        BEGIN # JUMP TO NEXT BLOCK TO CONTINUE SEARCH.RELEASE THIS ONE #
#                                                                      #
        KDLSTOP[0] = KDSTAIL[KCOUNT]; 
        P<KINITBF> = KDLSTOP[0];
        KCOUNT = 0; 
#                               AND RELEASE THE ONE JSUT PASSED        #
        P<DRHDRWD> = KDFP[0]; 
        KBACK = BACKPTR[0] ;
        KDFP[0]=NEXTPTR[0] ;
        IF KDORIG[0]
        THEN
          BEGIN    # THIS IS OUR FIRST AND SPECIAL BUFFER # 
          BACKPTR[0] = LOC(KORIGBP[0]) ; # SO WE SAVE IT  # 
          NEXTPTR[0] = BACKPTR[0]      ;
          BLKID  [0] = DRIDVALUE       ;
          KORIGBP[0] = P<DRHDRWD>      ; # SAVE ADDRESS IN COMMON # 
          KORIGFP[0] = P<DRHDRWD>      ;
          END 
        ELSE
          KREL = P<DRHDRWD> ; 
        P<DRHDRWD> = KDFP[0]; 
        BACKPTR[0] = KBACK; 
# 
        AND RELEASE IT (IF IT IS NOT THE ORIGINAL)
# 
        IF KDORIG[0]
        THEN
          KDORIG[0] = FALSE ; 
        ELSE
          MRELS(KREL) ; 
        END 
#                                                                      #
      ELSE   #  THIS IS A REGULAR DATA LINE IN PREVIOUS MESSAGE        #
        BEGIN 
        IF K2 EQ KLINES 
        THEN
          KDONE = TRUE  ;  # WE ADVANCED EXACTLLY ENOUGH LINES  # 
        ELSE
          BEGIN 
          IF K312[KCOUNT] EQ 0
          THEN
            K2=K2+1; # ZERO BYTE,MEANS WE GOT ONE MORE LINE IN HAND # 
# 
            AND INCREMENT THE WORDS COUNTER IN BOTH CASES 
# 
          KCOUNT = KCOUNT + 1 ; 
          END 
        END 
      END 
# 
      NOW KCOUNT HAS NUMBER OF WORDS (IN JUST THE UPMOST BLOCK) THAT
       THE DATA POINTER(KDISTOP) SHOULD BE MOVED
# 
      KDLSTOP[0] = KDLSTOP[0] + KCOUNT ;
      GOTO RJMAIN;   # RETURN TO CALLING ROUTINE                       #
 
ERRX: 
      PARAMS1 = RLG"ISM" ;
KEXIT:  
      GOTO RJMAIN ; 
 
      END 
TERM