PRGM SSDEF; # TITLE SSDEF - MAIN ROUTINE OF SSDEF. # BEGIN # SSDEF # # *** SSDEF - INITIALIZE CATALOGS AND SMMAPS. * * SSDEF ENSURES THAT CATALOGS AND SMMAPS ARE INITIALIZED. * SSDEF MUST BE RUN FROM THE MAINFRAME WHICH HAS ACCESS TO ALL * FAMILIES THAT MAY CONTAIN *M860* FILES. * * * SSDEF,PARAMETER,PARAMETER. * * PARAMETER DESCRIPTION * * SM USE *SM* A. * * SM=X USE *SM* X WHEN X IS ONE OF THE FOLLOWING: * A - *SM* A * B - *SM* B * C - *SM* C * D - *SM* D * E - *SM* E * F - *SM* F * G - *SM* G * H - *SM* H * * SM OMITTED *FM* OPTION MUST BE SPECIFIED. * * FM USE DEFAULT FAMILY. * * FM=FAMILY THE SPECIFIED FAMILY WILL BE USED. * * FM OMITTED *SM* OPTION MUST BE SPECIFIED. * * NOTE: ONE *SM* AND/OR ONE *FM* PARAMETER MUST BE SPECIFIED * FOR EACH EXECUTION OF *SSDEF*. * * * PRGM SSDEF. * * ENTRY. PARAMETERS ARE IN THE *RA* AREA. * * EXIT. SSDEF COMPLETE. * ERROR CONDITION - ABORT WITH DAYFILE MESSAGE. * * MESSAGES. SSDEF ABORT - SYNTAX ERROR. * SSDEF ABORT - NO PARAMETER SPECIFIED. * SSDEF - MUST BE SYSTEM ORIGIN. * SSDEF ABORT - ILLEGAL SM VALUE. * SSDEF ERRORS. * SSDEF COMPLETE. * * COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. # # **** PRGM SSDEF - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # CALLS *ABORT* MACRO # PROC DFCAT; # INITIALIZES SFMCATN FILES # PROC DFMAP; # INITIALIZES SMMAPN FILES # PROC DFTAB; # SETS UP ARGUMENT LIST # PROC GETPFP; # GET USER INDEX AND FAMILY # PROC GETSPS; # GET SYSTEM ORIGIN STATUS # PROC MESSAGE; # CALLS MESSAGE MACRO # PROC RESTPFP; # RESTORE USER-S *PFP* # PROC SSINIT; # ACCESS ROUTINE INITIALIZER # PROC XARG; # CRACK PARAMETER LIST # END # **** PRGM SSDEF - XREF LIST END. # DEF SMMAX #"H"#; # MAXIMUM SM VALUE # DEF SMMIN #"A"#; # MINIMUM SM VALUE # DEF NOPARAM #-1#; # NO PARAMETER SPECIFIED # DEF RSLEN #1#; # RETURN STATUS WORD LENGTH # DEF SYNTAXOK #0#; # SYNTAX OK # DEF LISTCON #0#; # DO NOT LIST COMDECKS # CONTROL PRESET; *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBPFP *CALL COMTDEF *CALL COMTDFP ITEM ARGLIST U; # ADDRESS OF ARGUMENT TABLE # ITEM FLAG U; # ERROR FLAG FOR ASARG # ITEM OPTION I; # OPTION TO SKIP PROGRAM NAME # ARRAY SPSSTAT [0:0] S(1); BEGIN ITEM SPSSTATUS U(00,48,12); # RETURN STATUS # END CONTROL EJECT; # * IF THE USER HAS SYSTEM ORIGIN PRIVELEDGES, THEN SAVE THE USER-S * CURRENT PERMANENT FILE PARAMETERS. # GETSPS(SPSSTAT); # GET SYSTEM ORIGIN STATUS # IF SPSSTATUS NQ 0 THEN BEGIN MSG$LINE[0] = " SSDEF - MUST BE SYSTEM ORIGIN."; MESSAGE(MSG$BUF[0],SYSUDF1); ABORT; END GETPFP(PFP[0]); USER$FAM[0] = PFP$FAM[0]; USER$UI[0] = PFP$UI[0]; USER$PACK[0] = PFP$PACK[0]; # * CRACK THE PARAMETERS ON THE *SSDEF* CALL. # DFTAB(ARGLIST); # SET UP THE ARGUMENT LIST # OPTION = 0; # SKIP OVER PROGRAM NAME # XARG(ARGLIST,OPTION,FLAG); # CRACK THE PARAMETERS # IF FLAG NQ SYNTAXOK THEN BEGIN MSG$LINE[0] = " SSDEF ABORT - SYNTAX ERROR."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END # * CHECK FOR INVALID PARAMETER OPTIONS. # IF(DARG$ISM EQ NOPARAM AND DARG$IFM EQ NOPARAM) THEN BEGIN MSG$LINE[0] = " SSDEF ABORT - NO PARAMETER SPECIFIED."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END IF DARG$ISM NQ NOPARAM ## AND (DARG$IRSM LS SMMIN ## OR DARG$IRSM GR SMMAX ## OR DARG$IRSMR NQ 0) THEN BEGIN MSG$LINE[0] = " SSDEF ABORT - ILLEGAL SM VALUE."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END # * CALL INITIALIZATION ROUTINE FOR CATALOG AND MAP ACCESS ROUTINES. # SSINIT; # INITIALIZES ACCESS ROUTINES # # * PROCESS PARAMETERS. # IF(DARG$IFM NQ NOPARAM) THEN BEGIN # FM PARAMETER SPECIFIED # DFCAT; # INITIALIZE SFMCAT FILES # END IF(DARG$ISM NQ NOPARAM) THEN BEGIN # SM PARAMETER SPECIFIED # DFMAP; # INITIALIZE SMMAP # END # * CHECK ERROR FLAG FOR SSDEF ERRORS. # IF ERRFLAGDF OR ERRFAMDF THEN BEGIN MSG$LINE[0] = " SSDEF ERRORS."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END ELSE BEGIN MSG$LINE[0] = " SSDEF COMPLETE."; # SSDEF COMPLETE # MESSAGE(MSG$BUF[0],UDFL1); END RESTPFP(PFP$END); # RESTORE USER-S *PFP* # END # SSDEF # TERM PROC DFCAT; # TITLE DFCAT - INITIALIZE 8 *M860* CATALOGS. # BEGIN # DFCAT # # ** DFCAT - INITIALIZE 8 *M860* CATALOGS. * * THIS PROCEDURE PERFORMS THE INITIALIZATION PROCESSING * FOR EACH *M860* CATALOG OF THE 8 SUB-FAMILIES. * * PROC DFCAT * * ENTRY INITIALIZATION FOR CATALOG AND MAP ACCESS COMPLETED. * * EXIT M860 CATALOGS INITIALIZED OR ERROR CONDITIONS * DEFINED BELOW. * * MESSAGES 1) PFN=PFN, FAMILY=FAMILY, * UI=UI - ALREADY PERMANENT. * * 2) PFN=PFN, FAMILY=FAMILY, * UI=UI - FILE INITIALIZED. * * 3) PFN=PFN, FAMILY=FAMILY, * UI=UI - CIO ERROR. * * 4) PFN=PFN, FAMILY=FAMILY, * UI=UI - DEFINE ERROR. * * 5) PFN=PFN, FAMILY=FAMILY, * UI=UI - FAMILY NOT FOUND. * * 6) SSDEF ABNORMAL - DFCAT. # # **** PROC DFCAT - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILLS FIELD # PROC CINIT; # INITIALIZES M860 CATALOGS # PROC DELAY; # CALLS *RECALL* MACRO # PROC GETFAM; # GETS DEFAULT FAMILY # PROC LOFPROC; # LIST OF FILES PROCESSOR # PROC MESSAGE; # SENDS MESSAGE TO DAYFILE # PROC PF; # *PFM* REQUEST INTERFACE # PROC RECALL; # PERIODIC RECALL # PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT OR RETURN # PROC RETERN; # RETURNS A FILE # PROC REWIND; # CALLS *REWIND* MACRO # PROC RPHR; # READS A *PRU* FROM FILE # PROC SETPFP; # SETS USER INDEX AND FAMILY # FUNC XCOD; # CHANGES INTEGER TO DISPLAY # PROC XWOD; # CHANGES OCTAL TO DISPLAY # PROC ZSETFET; # SETS UP *FET* FIELDS # END # **** PROC DFCAT - XREF LIST END. # DEF BLANK #" "#; # DISPLAY CODE FOR BLANK # DEF COMMA #","#; # DISPLAY CODE FOR COMMA # DEF FILLSIZE #7#; # FILL SIZE FOR BZFILL # DEF REQUESTDEF #0#; # DEFAULT FAMILY REQUESTED # DEF UN #0#; # USER NUMBER # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBPFP *CALL COMSPFM *CALL COMTDEF *CALL COMTDFP ITEM BLKFILL S:TYPFILL = S"BFILL"; # BLANK FILL FOR BZFILL # ITEM BUSY B; # FILE BUSY FLAG # ITEM ERCINIT U; # *CINIT* RETURN CODE # ITEM FILE$DONE B; # FILE PROCESSING DONE FLAG # ITEM FOUND B; # CHARACTER FOUND FLAG # ITEM I U; # LOOP INDEX # ITEM J U; # DUMMY LOOP INDEX # ITEM K U; # DUMMY LOOP INDEX # ITEM MSGTEMP C(8); # TEMPORARY MESSAGE FIELD # ITEM STAT U; # STATUS FROM ATTACH # ITEM STATUSR U; # RETURN STATUS # ITEM UI U; # USER INDEX # ARRAY CAT [0:0] P(1); BEGIN # CAT # ITEM CAT$PFN C(00,00,07) = ["SFMCAT "]; # NAME HEADER # ITEM CAT$LST C(00,36,01); # UNIQUE IDENTIFIER # END # CAT # ARRAY MSGDETAIL1 [0:0] P(4); BEGIN # ARRAY MSGDETAIL1 # ITEM LEAD1 C(00,00,01) = [" "]; # LEADING BLANK # ITEM MSGPFNH C(00,06,04) = ["PFN="]; # PFN= # ITEM MSGPFN C(00,30,07); # FILE NAME # ITEM MSGFAMH C(01,12,09) = [", FAMILY="]; # FAMILY= # ITEM MSGFAM C(02,06,08); # FAMILY AND COMMA # ITEM MSGZRO1 U(03,00,12) = [0]; # TERMINATOR # END # ARRAY MSGDETAIL1 # # * SWITCH FOR *CINIT* ERROR RETURN. # SWITCH ERJMP:CMASTAT NOERRJ:NOERR, # FILE INITIALIZED # INTLZDJ:INTLZD, # ALREADY PERMANENT # CIOERRJ:CIOERR, # CIO ERROR # DEFERRJ:DEFERR; # DEFINE ERROR # CONTROL EJECT; # * IF *FM* SPECIFIED GET DEFAULT FAMILY. # IF DARG$FM EQ REQUESTDEF THEN BEGIN # DEFAULT FAMILY REQUESTED # GETFAM(FAMT,NDF,LINKDF,DEFAULTDF); # GET DEFAULT FAMILY # DARG$FM = FAM$NAME[DEFAULTDF]; # PUT NAME INTO ARGUMENT ARRAY # DFLTFMDF = TRUE; # SET DEFAULT FAMILY FLAG # END # DEFAULT FAMILY REQUESTED # # * BLANK FILL FAMILY NAME AND MOVE IT INTO DETAIL MESSAGE. # MSGTEMP = DARG$FM; # TEMPORARY BUFFER FOR BZFILL # BZFILL(MSGTEMP,BLKFILL,FILLSIZE); # BLANK FILL # MSGFAM[0] = MSGTEMP; # SET FAMILY INTO MESSAGE # # * PLACE COMMA AFTER FAMILY NAME. # FOUND = FALSE; # FLAG TO INDICATE BLANK FOUND # FASTFOR I = 0 STEP 1 WHILE NOT FOUND DO BEGIN IF CMSGFAM EQ BLANK THEN BEGIN # CHARACTER AT INDEX IS BLANK # FOUND = TRUE; CMSGFAM = COMMA; # CHANGE BLANK TO COMMA # END # CHARACTER AT INDEX IS BLANK # END # * IF *ERRFLAGDF* NOT SET, CALL *CINIT* FOR EACH SUBFAMILY. # ERRFLAGDF = FALSE; IF NOT ERRFLAGDF THEN BEGIN # *CINIT* CALLS # SLOWFOR I = 0 STEP 1 WHILE I LQ MAXSF DO BEGIN # FOR EACH SUBFAMILY # UI = DEF$UI + I; # CALCULATE USER INDEX # XWOD(UI,DIS); # CHANGE FROM OCTAL TO DISPLAY # MSGUIDF[0] = DIS$UI; # PLACE USER INDEX INTO MESSAGE # CAT$LST[0] = XCOD(I); # CHANGE INDEX TO DISPLAY CODE # MSGPFN = CAT$PFN; # FILE NAME TO MESSAGE # PFP$UI[0] = UI; # SET USER INDEX FOR *SETPFP* # PFP$FAM[0] = DARG$FM; # SET FAMILY NAME FOR *SETPFP* # PFP$FG1[0] = TRUE; # SET FAMILY BIT FOR *SETPFP* # PFP$FG4[0] = TRUE; # SET INDEX BIT FOR *SETPFP* # SETPFP(PFP); # SET USER INDEX AND FAMILY # IF PFP$STAT NQ 0 THEN BEGIN MSGDETMSG[0] = "FAMILY NOT FOUND."; MESSAGE(MSGDETAIL1,SYSUDF1); # SEND MESSAGE TO DAYFILE # MESSAGE(MSGDETAIL2,SYSUDF1); ERRFAMDF = TRUE; END IF ERRFAMDF THEN BEGIN TEST I; END # * *CINIT* IS CALLED TO INITIALIZE AN *M860* CATALOG IF THE * CATALOG IS CURRENTLY UNDEFINED. IF THE CATALOG IS ALREADY * PERMANENT, IT IS CHECKED TO DETERMINE WHETHER IT IS A VALID * CATALOG OR WHETHER IT IS AN EMPTY CATALOG CREATED BY * *PFDUMP* FOR INTERLOCKING PURPOSES. IF IT IS A *PFDUMP* * CATALOG, IT IS PURGED AND INITIALIZED BY *CINIT*. * * NOTE - *PFDUMP* CATALOGS ARE EMPTY AND CONSEQUENTLY CAN BE * IDENTIFIED BY REACHING AN *EOI* ON AN ATTEMPT TO READ * A *PRU*. # FILE$DONE = FALSE; LOFPROC(CAT$PFN[0]); # ADD LFN TO LIST OF FILES # SLOWFOR J=0 WHILE NOT FILE$DONE DO BEGIN # CREATE CATALOG OR VERIFY ITS VALIDITY # ZSETFET(TFETADR,CAT$PFN[0],TBUFADR,TBUFL,RFETL); RETERN(TFET,RCL); CINIT(DARG$FM,I,CAT$PFN[0],ERCINIT); # * PROCESS *CINIT* ERROR CODE. # IF ERCINIT LS CMASTAT"NOERR" OR ERCINIT GR CMASTAT"STATLAST " THEN BEGIN # IF *ERCINIT* OUT OF RANGE # MSG$LINE[0] = " SSDEF ABNORMAL, DFCAT."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END # IF *ERCINIT* OUT OF RANGE # # * SIMULATED CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE. # GOTO ERJMP[ERCINIT]; NOERRJ: # FILE INITIALIZED # MSGDETMSG[0] = "FILE INITIALIZED. "; MESSAGE(MSGDETAIL1,UDFL1); MESSAGE(MSGDETAIL2,UDFL1); GOTO ENDCASE; INTLZDJ: # ALREADY PERMANENT # ZSETFET(TFETADR,CAT$PFN[0],TBUFADR,TBUFL,RFETL); BUSY = TRUE; SLOWFOR K=0 WHILE BUSY DO BEGIN # ATTACH *M860* CATALOG # PF("ATTACH",CAT$PFN[0],0,"RC",STAT,"NA",0,0); IF STAT EQ FBS THEN BEGIN # DELAY AND RETRY *ATTACH* # STATUSR = 0; RECALL(STATUSR); # PERIODIC RECALL # TEST K; END # DELAY AND RETRY *ATTACH* # BUSY = FALSE; END # ATTACH *M860* CATALOG # REWIND(TFET[0],RCL); RPHR(TFET[0],RCL); IF FET$AT NQ 0 THEN BEGIN MSGDETMSG[0] = " CIO ERROR. "; GOTO ERRCASE; END IF FET$EOI THEN BEGIN # EMPTY *PFDUMP* CREATED FILE FOUND # PF("PURGE",CAT$PFN[0],"RC",STAT,0); IF STAT NQ 0 THEN BEGIN MSG$LINE[0] = " SSDEF ABNORMAL, DFCAT."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END TEST J; END # EMPTY *PFDUMP* CREATED FILE FOUND # ELSE # NOT *PFDUMP* CATALOG # BEGIN MSGDETMSG[0] = "ALREADY PERMANENT. "; MESSAGE(MSGDETAIL1[0],SYSUDF1); MESSAGE(MSGDETAIL2[0],SYSUDF1); ERRFLAGDF = TRUE; GOTO ENDCASE; END CIOERRJ: # *CIO* ERROR # MSGDETMSG[0] = "CIO ERROR. "; GOTO ERRCASE; DEFERRJ: # *DEFINE* ERROR # MSGDETMSG[0] = "DEFINE ERROR. "; GOTO ERRCASE; ERRCASE: MESSAGE(MSGDETAIL1,SYSUDF1); MESSAGE(MSGDETAIL2,SYSUDF1); ERRFLAGDF = TRUE; RETURN; ENDCASE: FILE$DONE = TRUE; # * END OF CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE. # END # CREATE CATALOG OR VERIFY ITS VALIDITY # END # FOR EACH SUBFAMILY # END # *CINIT* CALLS # END # DFCAT # TERM PROC DFMAP; # TITLE DFMAP - INITIALIZES *SMMAP* FOR THE *SM* SPECIFIED. # BEGIN # DFMAP # # ** DFMAP - INITIALIZES *SMMAP* FOR THE *SM* SPECIFIED. * * THIS PROCEDURE PERFORMS THE INITIALIZATION PROCESSING * FOR THE *SM* SPECIFIED. * * PROC DFMAP * * ENTRY INITIALIZATION FOR CATALOG AND MAP ACCESS COMPLETED. * * EXIT MAP INITIALIZED OR ERROR CONDITIONS * DEFINED BELOW. * * MESSAGES 1) PFN=PFN, FAMILY=FAMILY, * UI=UI - FILE INITIALIZED. * * 2) PFN=PFN, FAMILY=FAMILY, * UI=UI - ALREADY PERMANENT. * * 3) PFN=PFN, FAMILY=FAMILY, * UI=UI - DEFINE ERROR. * * 4) SSDEF ABNORMAL, DFMAP. # # **** PROC DFMAP - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILLS FIELD # PROC GETFAM; # GETS DEFAULT FAMILY # PROC LOFPROC; # LIST OF FILES PROCESSOR # PROC MESSAGE; # CALLS MESSAGE MACRO # PROC MINIT; # INITIALIZES SMMAP # PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT OR RETURN # PROC RETERN; # RETURNS A FILE # PROC SETPFP; # SETS USER INDEX AND FAMILY # PROC XWOD; # CHANGES OCTAL TO DISPLAY CODE # PROC ZSETFET; # SETS UP *FET* FIELDS # END # **** PROC DFMAP - XREF LIST END. # DEF BLANK #" "#; # DISPLAY CODE FOR BLANK # DEF COMMA #","#; # DISPLAY CODE FOR COMMA # DEF FILLSIZE #7#; # FILL SIZE FOR BZFILL # DEF R #1#; # REQUEST RECALL FLAG # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBCMD *CALL COMBCMS *CALL COMBPFP *CALL COMTDEF *CALL COMTDFP ITEM BLKFILL S:TYPFILL = S"BFILL"; # BLANK FILL FOR BZFILL # ITEM ERMINIT U; # MINIT RETURN CODE # ITEM FOUND B; # CHARACTER FOUND FLAG # ITEM I U; # LOOP INDEX # ITEM MSGTEMP C(8); # TEMPORARY MESSAGE FIELD # ITEM ZEROFILL S:TYPFILL = S"ZFILL"; # ZERO FILL FOR BZFILL # ARRAY MAP [0:0] P(1); BEGIN # MAP # ITEM MAP$PFN C(00,00,07) = ["SMMAP"]; # FILE NAME HEADER # ITEM MAP$LST C(00,30,01); # UNIQUE IDENTIFIER # END # MAP # ARRAY MSGDETAIL0 [0:0] P(3); BEGIN # ARRAY MSGDETAIL0 # ITEM LEAD0 C(00,00,01) = [" "]; # LEADING BLANK # ITEM MSGPFNH0 C(00,06,04) = ["PFN="]; # PFN= # ITEM MSGPFN0 C(00,30,06); # FILE NAME # ITEM MSGFAMH0 C(01,06,09) = [", FAMILY="]; # FAMILY= # ITEM MSGFAM0 C(02,00,08); # FAMILY AND COMMA # ITEM MSGZRO0 U(02,48,12) = [0]; # TERMINATOR # END # ARRAY MSGDETAIL0 # SWITCH ERJMP:CMASTAT NOERRJ:NOERR, # FILE INITIALIZED # INTLZDJ:INTLZD, # ALREADY PERMANENT # DEFERRJ:DEFERR; # DEFINE ERROR # CONTROL EJECT; # * CHECK FOR DEFAULT FAMILY. # IF NOT DFLTFMDF THEN BEGIN # DEFAULT FAMILY NOT PREVIOUSLY DEFINED # GETFAM(FAMT,NDF,LINKDF,DEFAULTDF); # GET DEFAULT FAMILY # DARG$FM = FAM$NAME[DEFAULTDF]; # PUT NAME INTO ARGUMENT ARRAY # END # DEFAULT FAMILY NOT PREVIOUSLY DEFINED # # * BLANK FILL FAMILY NAME AND MOVE IT TO DETAILED MESSAGE. # MSGTEMP = DARG$FM; # TEMPORARY BUFFER FOR BZFILL # BZFILL(MSGTEMP,BLKFILL,FILLSIZE); # BLANK FILL # MSGFAM0[0] = MSGTEMP; # SET FAMILY INTO MESSAGE # # * PLACE COMMA AFTER FAMILY NAME. # FOUND = FALSE; # FLAG TO INDICATE BLANK FOUND # FASTFOR I = 0 STEP 1 WHILE NOT FOUND DO BEGIN IF CMSGFAM0 EQ BLANK THEN BEGIN # CHARACTER AT INDEX IS BLANK # FOUND = TRUE; CMSGFAM0 = COMMA; # CHANGE BLANK TO COMMA # END # CHARACTER AT INDEX IS BLANK # END # * CALL *SETPFP* TO SET USER INDEX AND FAMILY. # XWOD(DEF$UI,DIS); # CHANGE OCTAL TO DISPLAY CODE # MSGUIDF[0] = DIS$UI; # SET USER INDEX INTO MESSAGE # MAP$LST[0] = DARG$SM; # CREATE NAME FOR *MINIT* CALL # MSGPFN0[0] = MAP$PFN[0]; # PLACE FILE NAME INTO MESSAGE # PFP$UI[0] = DEF$UI; # SET USER INDEX FOR *SETPFP* # PFP$FAM[0] = DARG$FM; # SET FAMILY NAME FOR *SETPFP* # PFP$FG1[0] = TRUE; # SET FAMILY BIT FOR *SETPFP* # PFP$FG4[0] = TRUE; # SET INDEX BIT FOR *SETPFP* # SETPFP(PFP); # SET USER INDEX AND FAMILY # IF PFP$STAT NQ 0 THEN BEGIN MSG$LINE[0] = " SSDEF ABNORMAL, DFMAP."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END # * CALL *MINIT* TO INITIALIZE **SM*MAP* FOR SPECIFIED *SM*. # BZFILL(MAP,ZEROFILL,FILLSIZE); # ZERO FILL # ZSETFET(TFETADR,MAP$PFN[0],TBUFADR,TBUFL,RFETL); RETERN(TFET,RCL); LOFPROC(MAP$PFN[0]); # ADD LFN TO LIST OF FILES # MINIT(MAP$PFN[0],DARG$IRSM,ERMINIT); # INITIALIZE *SMMAP* # # * PROCESS *MINIT* ERROR CODE. # IF ERMINIT LS CMASTAT"NOERR" OR ERMINIT GR CMASTAT"STATLAST" THEN BEGIN # IF *ERMINIT* OUT OF RANGE # MSG$LINE[0] = " SSDEF ABNORMAL, DFMAP."; MESSAGE(MSG$BUF[0],SYSUDF1); RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END # IF *ERMINIT* OUT OF RANGE # # * SIMULATED CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE. # GOTO ERJMP[ERMINIT]; NOERRJ: # FILE INITIALIZED # MSGDETMSG[0] = "FILE INITIALIZED. "; GOTO ENDCASEOK; INTLZDJ: # ALREADY PERMANENT # MSGDETMSG[0] = "ALREADY PERMANENT. "; ERRFLAGDF = TRUE; GOTO ENDCASE; DEFERRJ: # *DEFINE* ERROR # MSGDETMSG[0] = "DEFINE ERROR. "; ERRFLAGDF = TRUE; ENDCASE: MESSAGE(MSGDETAIL0,SYSUDF1); MESSAGE(MSGDETAIL2,SYSUDF1); RETURN; # * END OF CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE. # ENDCASEOK: MESSAGE(MSGDETAIL0,UDFL1); MESSAGE(MSGDETAIL2,UDFL1); RETURN; END # DFMAP # TERM