Retro1.org codex

*DECK BFSCAN
USETEXT NIPDEF
USETEXT FREETAB 
PROC BFSCAN;                 # CHECK VALIDITY OF DYNAMIC BUFFER AREA   #
 STARTIMS;
 #
*1DC  BFSCAN
*     1. PROC NAME           AUTHOR              DATE 
*        BFSCAN              PC.TAM              78/07/28 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        SCAN THE FREE BUFFER CHAIN TO FIND DISCREPANCIES.
* 
*     3. METHOD USED. 
*        LOOP THROUGH ALL FREE BUFFERS, 
*        CHECK IF FORWARD AND BACKWARD POINTERS OK FOR EACH.
* 
*     4. ENTRY PARAMETERS.
*        FREFBFP             FREE CHAIN FORWARD POINTER.
*        FREFBBP             FREE CHAN BACKWARD POINTER.
*        CTLSFWA             FWA OF DYNAMIC BUFFER SPACE
*        CTLSLWA             LWA OF DYNAMIC BUFFER SPACE
* 
*     5. EXIT PARAMETERS. 
*        NONE.
* 
*     6. COMMON DECKS CALLED AND SYMPL TEXTS USED.
*        FREETAB   NIPDEF 
* 
*     7. ROUTINES CALLED. 
*        OMSG                LOG ERROR MESSAGES 
*        ABORT               ABORT NIP
* 
*     8. DAYFILE MESSAGES.
*        *FREE CHAIN ERROR* 
* 
 #
 STOPIMS; 
 
      BEGIN # BFSCAN #
 
      CONTROL IFEQ BFSC,1;
      XREF
        BEGIN 
        PROC ABORT;          # ABORT NIP                               #
        PROC OMSG;           # LOG ERROR MESSAGES                      #
        END 
 
 
      ARRAY EMSG S(2);       # ERROR MESSAGE TEXT.                     #
        BEGIN 
        ITEM MS  C(0,0,16)     =["FREE CHAIN ERROR"]; 
        ITEM MS2 U(1,48,12)    = [0]; 
        END 
 
      ITEM
      PREBUF,                # PREVIOUS BUFFER                         #
      BUFWA,                 # CURRENT FREE BUFFER                     #
      FWPT,                  # FORWARD POINTER OF CURRENT BUFFER       #
      BKPT,                  # BACKWARD POINTER OF CURRENT BUFFER      #
      BLKS,                  # BLOCK SIZE OF CURRENT BUFFER            #
      SIZE,                  # TOTAL SUM OF SIZES OF BUFFERS           #
      I;
 
#**********************************************************************#
 
      P<FREEBUF> = 0; 
      SIZE = 0; 
      PREBUF = LOC(FREFBFP[0]); 
      BUFWA = FREFBFP[0]; 
 
      FOR I = 1 STEP 1 WHILE I LQ FRENOFB[0]
      DO
        BEGIN 
        FWPT = FRBFBFP[BUFWA];# FORWARD POINTER OF CURRENT BUFFER      #
        BKPT = FRBFBBP[BUFWA];# BACKWARD POINTER OF CURRENT BUFFER     #
        BLKS = FRBBS[BUFWA]; # BLOCK SIZE OF CURRENT BUFFER            #
        IF BLKS LQ 0 OR 
           (FWPT LS CTLSFWA AND FWPT NQ LOC(FREFBFP[0])) OR 
           (BKPT LS CTLSFWA AND BKPT NQ LOC(FREFBBP[0])) OR 
           FWPT GQ CTLSLWA OR 
           BKPT GQ CTLSLWA OR 
           BKPT NQ PREBUF 
        THEN
          ABORT(EMSG,0);
 
        SIZE = SIZE + BLKS; 
        PREBUF = BUFWA; 
        BUFWA = FRBFBFP[BUFWA]; 
        END 
 
      IF BUFWA NQ LOC(FREFBFP[0]) OR FREFBBP[0] NQ PREBUF OR
         SIZE NQ FRESFB[0]
      THEN
        BEGIN 
        ABORT(EMSG,0);
        END 
 
      CONTROL FI; 
 
      END # BFSCAN #
 
 
TERM