Retro1.org codex

*DECK     OCFL
          IDENT  OCFL 
          ENTRY  OCFL 
          EXT    OTIME
          EXT    XTRACE 
          SST 
          TITLE  OCFL    CHANGE FIELD LENGTH
*IF DEF,IMS 
*#
*1DC  OCFL
* 
*     1. PROC NAME           AUTHOR              DATE 
*        OCFL                J. J. LYON          75/04/02 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR CHANGING NIP-S FIELD LENGTH. 
* 
*     3. METHOD USED. 
*          SET UP CALL
*          CALL MTR 
* 
*     4. ENTRY PARAMETERS.
*          A1 = ADDR OF NEW FIELD LENGTH
* 
*     5. EXIT PARAMETERS.  NONE 
* 
*     6. COMDECKS CALLED. 
*          INPARU  MACDEF 
*          STATTAB
* 
*     7. ROUTINES CALLED. 
*          MEMORY            COMPASS MEMORY MACRO 
*          OTIME             GET SYSTEM RTIME 
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES.  NONE
* 
*#
*ENDIF
*CALL MACDEF
*CALL INPARU
*CALL STATTAB 
 COUNT    BSSZ   1
 SAVEA1   BSSZ   1
 MEMRW    BSSZ   1           MEM MACRO REPLY WORD 
 OCFL     BSSZ   1           ENTRY/EXIT 
 
 DEBUG1   IFEQ   DEBUG,1
          SX6    A1 
          SA6    TEMP 
 
 STAT1    IFEQ   STAT,1 
          SA1    STIMEP      PARAMETER BLOCK FOR CALLING OTIME
          RJ   OTIME         GET RTIME VALUE BEFORE CALL
 STAT1    ENDIF 
 
          SX1    XOCFL
          RJ     XTRACE 
          SA1    TEMP 
          SA1    X1 
 DEBUG1   ELSE
 
 STAT1    IFEQ   STAT,1 
          SX6    A1          SAVE ADDRESS OF PARAMETER BLOCK IN TEMP
          SA6    TEMP 
          SA1    STIMEP      PARAMETER BLOCK FOR CALLING OTIME
          RJ   OTIME         GET RTIME VALUE BEFORE CALL
          SA1    TEMP        RESTORE ADDRESS OF PARAMETER BLOCK IN A1 
          SA1    X1 
 STAT1    ENDIF 
 
 DEBUG1   ENDIF 
* 
* 
          SA3    A1          A3 = FWA OF PARAM LIST 
          SA2    X3          A2 = ADDR OF PARAM 1 
          SX7    X2          X2 = PARAM 1   NEW FIELD LENGTH
* 
*                   CALL MTR
* 
          LX7    30 
          SA7    MEMRW       REPLY WORD SET UP
          MEMORY CM,MEMRW,RECALL
 
 STAT2    IFEQ   STAT,1 
          SA1    ETIMEP      PARAMETER BLOCK FOR CALLING OTIME
          RJ   OTIME         GET RTIME VALUE AFTER CALL 
          SA1    STIME       STARTING RTIME VALUE 
          MX0    24D         MASK FOR RTIME MILLESECOND VALUE 
          BX1    -X0*X1      CLEAR SECONDS FIELD
          SA2    ETIME       ENDING RTIME VALUE 
          BX2    -X0*X2      CLEAR SECONDS FIELD
          IX6    X2-X1       ELAPSED TIME FOR SWAPIN
          SA1    ST$LFL      LARGEST TIME SPENT IN OCFL 
          IX5    X1-X6       DETERMINE IF LATEST TIME INTERVAL IS LARGER
          PL   X5,OCFL1      IF PREVIOUS TIME INTERVAL WAS LARGER 
          SA6    ST$LFL      SAVE NEW LARGEST TIME INTERVAL 
 OCFL1    SA3    ST$TFL      PREVIOUS CUMULATIVE VALUE
          IX6    X3+X6       NEW CUMULATIVE VALUE 
          SA6    ST$TFL 
 STAT2    ENDIF 
 
          JP     OCFL        EXIT 
 XOCFL    DATA   L* OCFL* 
 TEMP     BSS    1
 
 STAT3    IFEQ   STAT,1 
          EXT    OTIME
 STIMEP   VFD    60D/STIME
 ETIMEP   VFD    60D/ETIME
 STIME    BSS    1           START TIME FOR COMPARING SWAPIN TIME DELAY 
 ETIME    BSS    1           END TIME FOR COMPARING SWAPIN TIME DELAY 
 STAT3    ENDIF 
 
          END