Retro1.org codex

          IDENT  FOTD,FOT
          ABS
          SST
          ENTRY  FOTD
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1
          TITLE  FOTD - FAMILY ORDINAL TABLE DISPLAY.
*COMMENT  FOTD - FAMILY ORDINAL TABLE DISPLAY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       FOTD - FAMILY ORDINAL TABLE DISPLAY.
*
*         B. J. OLIPHANT     81/03/19.
          SPACE  4,10
***       *FOTD* IS A CPU UTILITY USED BY THE OPERATOR TO DISPLAY
*         THE FAMILY ORDINAL TABLE ASSIGNMENTS ON THE *L* DISPLAY OR
*         TO FORMAT IT FOR A PRINTER.
          SPACE  4,20
***       COMMAND FORMAT.
*
*
*         FOTD(LFN,OP)       ORDER DEPENDENT PARAMETERS.
*          OR
*         FOTD(L=LFN,LO=OP)  ORDER INDEPENDENT (KEYWORD = PARAMETER).
*
*          WHERE
*
*         OP = *L*           FORMAT DATA FOR A LINE PRINTER.
*
*         OP = *D*           FORMAT DATA FOR *L* DISPLAY (DEFAULT).
*
*         LFN                LIST OUTPUT FILE NAME (DEFAULT = OUTPUT).
*                            THIS PARAMETER VALID ONLY WITH (LO=L).
*
*         NOTES  SPECIAL PRIVILEGES REQUIRED.
*                1. USER MUST BE *SYOT* TO USE *L* DISPLAY (LO=D).
*                2. USER MUST BE *SYOT* OR HAVE SYSTEM ORIGIN
*                   PRIVILEGES TO GENERATE A LISTING (LO=L).
          SPACE  4,15
***       DAYFILE MESSAGES.
*
*         THESE MESSAGES ARE ISSUED TO THE JOB AND SYSTEM DAYFILES.
*
*         *ARGUMENT ERROR.*
*                AN INCORRECT PARAMETER WAS ENTERED. (FATAL ERROR)
*
*         *USER ACCESS NOT VALID.*
*                CALLING JOB WAS NOT SYSTEM ORIGIN. (FATAL ERROR)
*
*         *FOTD UTILITY COMPLETE.*
*                INDICATES NORMAL COMPLETION OF PROGRAM.
          SPACE  4,10
***       DEFINITION COMMON DECKS.
*
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMCDCM
*CALL     COMSSFM
*CALL     COMSSSJ
          TITLE  ASSEMBLY CONSTANTS.
****      ASSEMBLY CONSTANTS.
 
 OBUFL    EQU    101B        OUTPUT BUFFER LENGTH
 LBUFL    EQU    LDSY        *L* DISPLAY BUFFER LENGTH
 WBUFL    EQU    100B*2      LENGTH WORKING BUFFER
 XCDT     EQU    4           X - COORDINATE FOR *L* DISPLAY
 YCDT     EQU    2           Y - COORDINATE FOR *L* DISPLAY
 
****
          TITLE  TABLES AND BUFFER DEFINITIONS.
          ORG    111B
 FOT      BSS    0
          SPACE  4,10
*         DAYFILE MESSAGES.
 
 DAFC     DATA   C* FOTD UTILITY COMPLETE.*
 ERAR     DATA   C* ARGUMENT ERROR.*
 ERIU     DATA   C* USER ACCESS NOT VALID.*
          SPACE  4,10
*         FLAG DEFINITIONS.
 
 LFLG     CON    0           *L* DISPLAY FLAG
 PFLG     CON    0           PRINTER OUTPUT FLAG
 SYOF     CON    0           SYSTEM ORIGIN FLAG
 WCNT     BSSZ   1           NUMBER OF WORDS STORED IN WORKING BUFFER
          SPACE  4,10
*         *L* DISPLAY BUFFER FIRST WORD.
*
*         T,     12/ N ,1/ S ,1/ F ,46/
*
*         N      SIZE OF DISPLAY BUFFER.
*         S      CHARACTER SIZE.
*         F      DATA FORMAT BIT.
 
 
 LDSW     VFD    12/LBUFL,1/0,1/0,46/0
          SPACE  4,10
**        *SETJOB* PARAMETER BLOCK.
 
 SETB     VFD    60/0
          VFD    48/0,12/2LDF
          SPACE  4,10
**        *SFM* PARAMETER BLOCK.
 
 
 SFMB     VFD    12/RFDF,12/0,12/WBUFL/2,6/0,18/WBUFA
          CON    0           END OF *SFM* PARAMETER BLOCK
          SPACE  4,5
*         SSJ= PARAMETER BLOCK.
 
 
 SSJ=     BSS    0           SSJ= ENTRY POINT
          BSSZ   SSJL        SSJ= PARAMETER BLOCK
 FETS     SPACE  4,10
*         FET DEFINITIONS.
 
 O        BSS    0           PRINTER OUTPUT FILE BUFFER
 OUTPUT   FILEB  OBUF,OBUFL,(FET=6)
 FOTD     TITLE  MAIN PROGRAM.
**        FOTD - MAIN PROGRAM.
*
*         EXIT   *FOTD* PROGRAM COMPLETED.
*
*         CALLS  PRS, LOP.
*
*         MACROS ENDRUN, MESSAGE.
 
 
 FOTD     BSS    0           ENTRY
          RJ     PRS         PRESET ROUTINE
          RJ     LOP         PROCESS LIST OPTIONS
          MESSAGE  DAFC,0,R  * FOTD UTILITY COMPLETE.*
          ENDRUN
 LOP      TITLE  LIST OPTION PROCESSOR.
**        LOP - LIST OPTION PROCESSOR.
*
*         ENTRY  USER HAS BEEN VALIDATED (EITHER SYSTEM ORIGIN
*                OR SYSTEM ORIGIN PRIVILEDGES).
*
*                (PFLG) = 1, IF PRINT FILE REQUESTED.
*                (LFLG) = 1, IF *L* DISPLAY REQUESTED.
*
*         EXIT   (LBUF) = FWA OF FORMATTED *L* DISPLAY BUFFER,
*                         DISPLAYED ON *L* DISPLAY, IF REQUESTED.
*
*                PRINT FILE, IF REQUESTED, LOCAL TO USER JOB.
*
*         USES   X - 1, 2.
*                A - 1, 2.
*                B - NONE.
*
*         CALLS  FDB, RFD.
*
*         MACROS DSDOUT, SETFS, SETJOB, WRITER.
 
 
 LOP      SUBR               ENTRY/EXIT
          RJ     RFD         GET FOT DATA
          SA2    PFLG        CHECK PRINTER FLAG
          ZR     X2,LOP1     IF NOT FOR PRINTER
          SX2    O           SET OUTPUT FET ADDRESS
          RJ     FDB         BUILD PRINT FILE
          WRITER O           FLUSH OUTPUT BUFFER
          SETFS  O,0         SAVE OUTPUT AS LOCAL FILE
          SETJOB SETB        CHANGE JOB DISPOSITION
          SX2    B0+         INDICATE *L* DISPLAY FOR *FDB*
 LOP1     SA1    LFLG
          ZR     X1,LOPX     IF *L* DISPLAY NOT SELECTED
          RJ     FDB         BUILD DISPLAY BUFFER
          DSDOUT LBUF        DISPLAY *L* DISPLAY BUFFER
          EQ     LOPX        RETURN
          TITLE  SUBROUTINES.
 ERR      SPACE  4,10
**        ERR - ERROR PROCESSOR.
*
*         ENTRY  (X2) = ADDRESS OF ERROR MESSAGE.
*
*         EXIT   MESSAGE ISSUED IN SYSTEM AND USER DAYFILE.
*
*         MACROS ABORT, MESSAGE.
 
 
 ERR      BSS    0           ENTRY
          MESSAGE X2,0,R
          ABORT
 FDB      SPACE  4,10
**        FDB - FORMAT DISPLAY BUFFER.
*
*         ENTRY  (X2) = 0, IF FORMATTING FOR *L* DISPLAY.
*                      .EQ. FET ADDRESS OF OUTPUT FILE IF FOR PRINTER.
*
*         EXIT   (LBUF) = FWA FORMATTED *L* DISPLAY BUFFER.
*
*         USES   X - 1, 3, 4, 6, 7.
*                A - 3, 4, 7.
*                B - 2, 3, 4, 6.
*
*         CALLS  FLB.
 
 
 FDB      SUBR               ENTRY/EXIT
 
*         SET UP PARAMETERS FOR *FLD*.
 
          SA3    WCNT        GET NUMBER OF WORDS TO REFORMAT
          SX6    X3+HBUF-1   LWA OF BUFFER TO REFORMAT
          SX3    B1+         *C* DISPLAY FORMAT
          SB2    LBUF+1      FWA TO PLACE FORMATTED DATA
          SB6    LBUF+LBUFL  LWA+1 OF BUFFER TO RECEIVE CONVERTED DATA
          SX1    PBUF        ASSUME FORMATTING FOR PRINTER
          NZ     X2,FDB1     IF FORMATTING FOR PRINTER
          SA4    LDSW        INITIALIZE *L* DISPLAY BUFFER
          BX7    X4
          SA7    B2-B1
          SB3    XCDT        SET X-COORDINATE FOR *L* DISPLAY
          SB4    YCDT        SET Y-COORDINATE FOR *L* DISPLAY
          SX1    HBUF        FWA FOR FORMATTING FOR *L* DISPLAY
 FDB1     RJ     FLB         FORMAT DATA TO BE OUTPUT
          EQ     FDBX        RETURN
 GNF      SPACE  4,15
**        GNF - GET NEXT FAMILY.
*
*         *GNF* RETURNS THE NEXT FAMILY FROM THE *FOT*.
*
*         ENTRY  (WBUFA) = *FOT* DATA.
*                (B6) = CURRENT FAMILY ORDINAL.
*
*         EXIT   (X1) = FAMILY NAME, LEFT JUSTIFIED.
*
*         USES   X - 0, 1.
*                A - 1.
 
 
 GNF      SUBR               ENTRY/EXIT
          SA1    WBUFA-1+B6  GET NEXT *FOT* ENTRY
          MX0    42          7 CHARACTER FAMILY MASK
          BX1    X0*X1       RETURN 7 FAMILY CHARACTERS ONLY
          EQ     GNFX        RETURN
 GNO      SPACE  4,15
**        GNO - GET NEXT ORDINAL.
*
*         *GNO* RETURNS THE DISPLAY CODE ORDINAL NUMBER WITH TRAILING
*         PERIOD.
*
*         ENTRY  (B6) = PREVIOUS FAMILY ORDINAL NUMBER.
*
*         EXIT   (X1) = DISPLAY CODE ORDINAL WITH TRAILING PERIOD.
*                (B6) = NEXT FAMILY ORDINAL.
*
*         USES   X - 0, 1.
*                B - 6.
*
*         CALLS  COD.
 
 
 GNO      SUBR               ENTRY/EXIT
          SB6    B6+B1       SET CURRENT FAMILY ORDINAL NUMBER
          SX1    B6          ORDINAL NUMBER TO CONVERT
          RJ     COD         CONVERT OCTAL TO DISPLAY CODE
          MX0    -12         MASK FOR ORDINAL DIGITS
          BX1    -X0*X6      SET ORDINAL NUMBER
          SX0    1R.
          LX1    6           SHIFT FOR PERIOD TERMINATOR
          BX1    X0+X1       ADD PERIOD TERMINATOR
          EQ     GNOX        RETURN
 RFD      SPACE  4,15
**        RFD - RETURN *FOT* DATA.
*
*         ENTRY  (SFMB) = *SFM* PARAMETER BLOCK SET UP
*                         FOR *RFDF* SUBFUNCTION.
*
*         EXIT   FAMILY ORDINAL TABLE (FOT) STORED.
*                (HBUF) = FWA OF FORMATTED *FOT* DATA.
*
*         USES   X - 0, 1, 2.
*                A - 2.
*                B - NONE.
*
*         CALLS  WFB.
*
*         MACROS SYSTEM.
 
 
 RFD      SUBR               ENTRY/EXIT
          SYSTEM SFM,R,SFMB,RSDF*100B  RETURN SYSTEM DATA
          SA2    SFMB        SAVE INFORMATION FROM PARAMETER WORD
          LX2    11-47       GET MAXIMUM NUMBER ORDINALS POSSIBLE
          MX0    -12
          BX1    -X0*X2
          LX2    11-59       GET NUMBER OF ORDINALS CURRENTLY IN USE
          BX2    -X0*X2
          IX1    X1-X2       NUMBER OF FOT ENTRIES STILL AVAILABLE
          RJ     WFB         WRITE FOT BUFFER
          EQ     RFDX        RETURN
 WFB      SPACE  4,15
**        WFB - WRITE *FOT* BUFFER.
*
*         ENTRY  (X1) = NUMBER OF FOT ENTRIES STILL AVAILABLE.
*                (X2) = NUMBER OF *FOT* ENTRIES RETURNED BY *SFM*.
*                (WBUFA) = ADDRESS OF FIRST *FOT ENTRY.
*
*         EXIT   (HBUF) = FWA OF FORMATTED *FOT* DATA.
*                (WCNT) = NUMBER OF WORDS STORED IN (HBUF).
*
*        USES    X - ALL.
*                A - 0, 1, 2, 4, 6, 7.
*                B - 5, 6.
*
*         CALLS  COD, GNF, GNO, SFN, ZTB.
 
 
 WFB      SUBR               ENTRY/EXIT
          SB5    X2          SAVE NUMBER OF FAMILIES
          SB6    B0          INITIALIZE ORDINAL NUMBER
          RJ     COD         CONVERT AVAILABLE ENTRIES TO DISPLAY CODE
          SB7    B0+         INDICATE FIRST HALF OF LINE
          MX0    -12
          BX6    -X0*X6      REMOVE BLANK CHARACTERS RETURNED BY *COD*
          SA1    HBUFB-1     MERGE INTO HEADER LINE
          LX6    30          ADJUST RESULT FOR PROPER COLUMNS
          LX0    30          ADJUST MASK FOR PROPER COLUMNS
          BX1    X0*X1       PRESERVE ORIGINAL LINE
          BX6    X6+X1       INSERT AVAILABLE ENTRIES
          SA6    A1+
          SA4    WBUFA       SET FIRST FAMILY = DEFAULT FAMILY
          MX0    42
          BX1    X0*X4
          SA4    HBUFA+2
          MX0    18
          LX0    12          ADJUST MASK
          RJ     SFN         SPACE-FILL NAME
          BX7    X0*X4
          LX6    -6
          BX6    -X0*X6
          BX7    X6+X7       MERGE FAMILY INTO HEADER LINE
          SA7    A4+
          SA0    WBUF        FWA TO RETURN REFORMATTED DATA
 
*         SET WORD 1 OF CURRENT HALF OF LINE.
 
 WFB1     RJ     GNO         GET NEXT ORDINAL
          LX1    36          SET INTO PROPER COLUMN
          BX5    X1
          RJ     GNF         GET NEXT FAMILY
          LX1    -30         PUT INTO PROPER COLUMN
          MX0    -30
          BX2    -X0*X1      LAST PART OF WORD 1
          BX4    X0*X1       FIRST PART OF WORD 2
          BX1    X5+X2       SET WORD 1
          RJ     ZTB         CONVERT ZEROS TO BLANKS
          SA6    A0+         SET INTO *WBUF*
          SA0    A0+B1       NEXT WORD IN *WBUF*
 
*         SET WORD 2 OF CURRENT HALF OF LINE.
 
          BX5    X4          LAST PORTION OF FAMILY
          EQ     B6,B5,WFB4  IF ALL FAMILIES PROCESSED
          RJ     GNO         GET NEXT ORDINAL
          LX1    6           PUT INTO PROPER COLUMN
          BX1    X5+X1       SET WORD 2
          RJ     ZTB         CONVERT ZEROS TO BLANKS
          SA6    A0          SET INTO *WBUF*
          SA0    A0+B1       NEXT LOCATION IN *WBUF*
 
*         SET WORD 3 OF CURRENT HALF OF LINE.
 
          RJ     GNF         GET NEXT FAMILY
          BX5    X1          ADD FAMILY INTO WORD
          EQ     B6,B5,WFB4  IF ALL FAMILIES PROCESSED
          RJ     ZTB         CONVERT ZEROS TO BLANKS
 
*         CHECK IF LINE TERMINATOR NEEDED.
 
          EQ     B7,B1,WFB2  IF TERMINATOR NEEDED
          SB7    1           INDICATE LAST HALF OF LINE
          EQ     WFB3        SET IN LINE AND CONTINUE
 
 WFB2     MX0    48          LINE TERMINATOR MASK
          BX6    X0*X6       ADD LINE TERMINATOR
          SB7    B0+         INDICATE FIRST HALF OF LINE
 WFB3     SA6    A0          SET WORD 3
          SA0    A0+B1       NEXT LOCATION IN *WBUF*
          EQ     WFB1        CONTINUE FORMATTING LINES
 
*         PROCESS END OF FAMILIES.
 
 WFB4     BX1    X5          SET LAST WORD
          RJ     ZTB         CONVERT ZEROS TO BLANKS
          MX0    48          TERMINATOR MASK
          BX6    X0*X6       ADD LINE TERMINATOR
          SA6    A0+
          SX6    A0-HBUF+1   SAVE NUMBER OF WORDS IN FOT BUFFER
          SA6    WCNT
          EQ     WFBX        RETURN
          SPACE  4,5
*         COMMON DECKS.
 
*CALL     COMCCIO
*CALL     COMCCOD
*CALL     COMCCPM
          LIST   X
*CALL     COMCFLD
          LIST   *
*CALL     COMCLFM
*CALL     COMCSFN
*CALL     COMCSYS
*CALL     COMCWOD
*CALL     COMCWTC
*CALL     COMCWTO
*CALL     COMCWTW
*CALL     COMCZTB
          TITLE  BUFFER AREA.
          USE    BUFFERS
 
 
*         BUFFER HEADER FOR PRINT OPTION.
 
 PBUF     DATA   40H FOTD - FAMILY ORDINAL TABLE DISPLAY.
 PDAT     BSSZ   1           DATE STAMP BUFFER
 PTIM     BSSZ   1           TIME STAMP BUFFER
          CON    0           END OF LINE
 
*         BUFFER HEADER FOR *L* DISPLAY OPTION.
 
 HBUF     DATA   C*               FAMILY ORDINAL TABLE DISPLAY*
          DATA   C* *
 HBUFA    DATA   50H    DEFAULT FAMILY =             AVAILABLE ENTRIES
          DATA   8C =   B
 HBUFB    DATA   C* *
          DATA   50HORD. FAMILY    ORD. FAMILY    ORD. FAMILY    ORD.
          DATA   8CFAMILY
          DATA   C* *
 
 HBUFL    EQU    *-HBUF      LENGTH OF HEADER BUFFER
 
 WBUF     EQU    *           WORKING BUFFER
 WBUFA    EQU    WBUF+WBUFL/2  *SFM* RETURNS DATA HERE
 
 LBUF     EQU    WBUF+WBUFL  *L* DISPLAY BUFFER
 LBUFE    EQU    LBUF+LBUFL  END OF *L* DISPLAY BUFFER
 
 OBUF     EQU    LBUF        OUTPUT FILE BUFFER
 OBUFE    EQU    OBUF+OBUFL  END OF OUTPUT BUFFER
 PRS      TITLE  PRESET.
**        PRS - PRESET ROUTINE.
*
*         ENTRY  COMMAND ARGUMENT LIST AT RA+2 (ARGR)
*                IN OPERATING SYSTEM FORMAT.
*
*         EXIT   (B1) = 1.
*                (PFLG) = 1, IF PRINT FILE REQUESTED.
*                (LFLG) = 1, IF *L* DISPLAY REQUESTED.
*
*         ERROR  TO *ERR*, IF ARGUMENT ERROR OR USER ACCESS NOT VALID.
*                (X2) = FWA ERROR MESSAGE.
 
 
*         SET DATE AND TIME IN HEADER.
 
 PRS9     DATE   PDAT        SET DATE IN HEADER
          CLOCK  PTIM        SET TIME IN HEADER
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1           B1 = 1.
          GETSPS SYOF        CHECK FOR SYSTEM ORIGIN PRIVILEGES
          SA1    SYOF
          ZR     X1,PRS1     IF SYSTEM ORIGIN PRIVILEGES
          SX2    ERIU        * USER ACCESS NOT VALID.*
          EQ     ERR         ABORT
 
*         PROCESS ARGUMENT LIST.
 
 PRS1     SB2    CCDR        UNPACK COMMAND
          RJ     USB
          SA1    A6          ASSURE TERMINATOR CHARACTER
          SX6    1R.
          SA6    X1+B1
          SA2    PRSB        SET SEPARATOR MASK
          SB2    60          SET MAXIMUM NON-DELIMITER DISPLAY CODE
          SB7    PRS8        SET EXIT FOR TERMINATOR CHARACTER
          RJ     FNB         FIND NON-BLANK CHARACTER
 
*         SKIP PROGRAM NAME.
 
          SB7    PRS6        SET EXIT FOR TERMINATOR CHARACTER
 PRS4     RJ     FNB         FIND NON-BLANK CHARACTER
          SB4    B5-B2
          LX4    X2,B5
          PL     B4,PRS5     IF SEPARATOR CHARACTER
          PL     X4,PRS4     IF NOT SEPARATOR CHARACTER
 PRS5     SB3    TARG        FWA ARGUMENT EQUIVALENCE TABLE
          SB2    TARGL       LENGTH ARGUMENT TABLE
          SB4    PRSA        ADDRESS TO PLACE DATA
          RJ     CPA         CONVERT POSITIONAL ARGUMENTS
          NG     B5,PRS8     IF ARGUMENT ERROR
          PL     X1,PRS6     IF NO ARGUMENTS PROCESSED
          SX6    B5+         SET LWA OF ARGUMENTS
          SA6    USBC
          SB6    PRSA        FWA OF ARGUMENTS
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,PRS8     IF ERROR
 
*         DETERMINE LIST OPTIONS.
 
 PRS6     SA1    LO          GET CHARACTER FROM LIST OPTION
          SA2    TLOP-1
          MX0    6
          SB4    A2+         SAVE ADDRESS OF ARGUMENT TABLE
 PRS7     BX3    X0*X1       PROCESS NEXT CHARACTER FROM LIST OPTION
          ZR     X3,PRS9     IF ALL OPTIONS PROCESSED
 PRS7.1   SA2    A2+B1       SEARCH ARGUMENT TABLE
          ZR     X2,PRS8     IF LIST OPTION NOT DEFINED IN TABLE
          BX4    X0*X2
          BX4    X4-X3
          NZ     X4,PRS7.1   IF MATCH NOT FOUND
          SX6    B1          SET FLAG FOR THIS OPTION
          SA6    X2
          SX3    A2-TLOP
          LX1    6
          SA2    B4          INITIALIZE TABLE ADDRESS
          NZ     X3,PRS7     IF NOT LO=D
          MX4    -12
          SA3    JOPR        CHECK FOR SYSTEM ORIGIN
          LX3    0-24
          BX3    -X4*X3
          SX3    X3-SYOT
          ZR     X3,PRS7     IF SYSTEM ORIGIN JOB
          SX2    ERIU        * USER ACCESS NOT VALID.*
          EQ     ERR         ABORT
 
 PRS8     SX2    ERAR        *ARGUMENT ERROR.*
          EQ     ERR         ABORT
 
 PRSA     BSS    100
 
 PRSB     CON    40000000000033127777B  SEPARATOR MASK
 
**        ASSUMED VALUES FOR LIST OPTIONS.
 
 
 LO       CON    0LD         SELECTED LIST OPTION (DEFAULT = *D*)
          SPACE  4,10
**        ARGUMENT EQUIVALENCE TABLE.
 
 
 TARG     BSS    0
 L        ARG    O,O,0,0     OUTPUT FILE NAME
 LO       ARG    LO,LO,0,0   LIST OPTIONS
          ARG                END OF ARGUMENT TABLE
 TARGL    EQU    *-TARG-1    LENGTH OF ARGUMENT TABLE
 TLOP     SPACE  4,15
**        TLOP - TABLE OF LIST OPTIONS.
*
*T,       42/ OPTION,18/ ADDR
*
*         (ADDR) WILL BE SET NON-ZERO IN PRS IF OPTION IS SELECTED.
 
 
 TLOP     BSS    0
          VFD    42/0LD,18/LFLG  SELECT *L* DISPLAY
          VFD    42/0LL,18/PFLG  SELECT LINE PRINTER
          CON    0           END OF TABLE
 FNB      SPACE  4,15
**        FNB - FIND NON-BLANK CHARACTER.
*
*         ENTRY  (B6) = NEXT CHARACTER ADDRESS.
*                (B7) = EXIT ADDRESS, IF TERMINATOR ENCOUNTERED.
*
*         EXIT   (X1) = (B5) = NEXT NON-BLANK CHARACTER.
*                (B6) = NEXT CHARACTER ADDRESS (UPDATED).
*                EXIT IS MADE TO (B7), IF TERMINATOR ENCOUNTERED.
*
*         USES   X - 1, 4.
*                A - 1.
*                B - 5, 6.
 
 
 FNB      SUBR               ENTRY/EXIT
 FNB1     SA1    B6          GET NEXT CHARACTER
          SB6    B6+B1
          SX4    X1-1R
          ZR     X4,FNB1     IF BLANK CHARACTER
          SB5    X1+
          SX4    X1-1R.
          ZR     X4,FNB2     IF TERMINATOR CHARACTER
          SX4    X1-1R)
          NZ     X4,FNBX     IF NOT TERMINATOR CHARACTER, RETURN
 FNB2     JP     B7          TERMINATOR CHARACTER
          TITLE  PRESET COMMON DECKS.
*CALL     COMCARM
*CALL     COMCCPA
*CALL     COMCPOP
*CALL     COMCUSB
          SPACE  4,5
 FOTDE    EQU    *           END OF PROGRAM
 .RFL=    MAX    FOTDE,LBUFE,OBUFE
 RFL=     EQU    .RFL=
          SPACE  4,5
          END