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