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