FOTD
          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 
