PROC BZFILL(CHAR,(TYP),(NUM)); # TITLE BZFILL - BLANK OR ZERO FILLS A CHARACTER ITEM. # BEGIN # BZFILL # # ** BZFILL - BLANK OR ZERO FILLS A CHARACTER ITEM. * * PROC BZFILL(CHAR,(TYP),(NUM)) * * ENTRY (TYP) = TYPE OF FILLING REQUIRED. * = S"BFILL", BLANK FILLING. * = S"ZFILL", ZERO FILLING. * (NUM) = LENGTH OF CHARACTER ITEM IN NUMBER * OF CHARACTERS. * * EXIT (CHAR) = BLANK OR ZERO FILLED CHARACTER. * * NOTES DEPENDING ON THE TYPE OF CONVERSION, ZEROES * ARE REPLACED BY BLANKS OR BLANKS BY ZEROES. # ITEM CHAR C(240); # ITEM TO BE BLANK/ZERO FILLED # ITEM TYP U; # TYPE OF FILLING REQUIRED # ITEM NUM I; # LENGTH OF *CHAR* IN NUMBER OF CHARACTERS # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF ITEM I I; # LOOP INDUCTION VARIABLE # CONTROL EJECT; # * START OF EXECUTABLE CODE. # IF TYP EQ TYPFILL"BFILL" THEN BEGIN # BLANK FILL # FASTFOR I = 0 STEP 1 UNTIL NUM-1 DO BEGIN IF CCHAR EQ 0 # REPLACE ZEROES BY BLANKS # THEN BEGIN CCHAR = " "; END END RETURN; END # BLANK FILL # IF TYP EQ TYPFILL"ZFILL" THEN BEGIN # ZERO FILL # FASTFOR I = 0 STEP 1 UNTIL NUM-1 DO BEGIN IF BCHAR EQ O"55" # REPLACE BLANKS BY ZEROES # THEN BEGIN BCHAR = 0; END END RETURN; END # ZERO FILL # END # BZFILL # TERM PROC LOFPROC((LFN)); # TITLE LOFPROC - LIST OF FILES PROCESSOR. # BEGIN # LOFPROC # # ** LOFPROC - LIST OF FILES PROCESSOR. * * *LOFPROC* IS USED TO CREATE A LIST OF LOCAL FILE NAMES, AND ALSO * TO RETURN THE FILES NAMED IN THIS LIST. * * PROC LOFPROC((LFN)) * * ENTRY (LFN) = NONZERO, LOCAL FILE NAME TO BE ADDED TO THE * LIST OF FILES. * = 0, ALL FILES IN THE LIST ARE TO BE RETURNED. * * EXIT THE SPECIFIED FILE HAS BEEN ADDED TO THE LIST, OR ALL * FILES IN THE LIST HAVE BEEN RETURNED. # ITEM LFN I; # FILE NAME TO BE ADDED TO LIST # # **** PROC LOFPROC - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILL ITEM # PROC RETERN; # RETURN FILE # PROC ZSETFET; # INITIALIZE FET # END # **** PROC LOFPROC - XREF LIST END. # DEF LOFMAX #15#; # MAXIMUM LENGTH OF FILE LIST # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBFET ITEM I I; # INDUCTION VARIABLE # ITEM ORD U = 0; # CURRENT TABLE ORDINAL # ARRAY LFET [0:0] S(SFETL); ; # FET USED FOR *RETURN* REQUEST # ARRAY LOF [0:LOFMAX] S(1); # LIST OF FILES TABLE # BEGIN ITEM LOF$WRD U(00,00,60); # FULL WORD DEFINITION # ITEM LOF$LFN C(00,00,07); # LOCAL FILE NAME # END CONTROL EJECT; IF LFN NQ 0 AND ORD LQ LOFMAX THEN # ADD LFN TO LIST OF FILES # BEGIN BZFILL(LFN,1,7); LOF$WRD[ORD] = LFN; ORD = ORD + 1; RETURN; END IF LFN EQ 0 THEN # RETURN ALL FILES LISTED # BEGIN # RETURN FILES # ZSETFET(LOC(LFET[0]),"",0,0,SFETL); SLOWFOR I = 0 STEP 1 WHILE I LS ORD DO BEGIN FET$LFN[0] = LOF$LFN[I]; RETERN(LFET[0],RCL); END END # RETURN FILES # RETURN; END # LOFPROC # TERM PROC MSG((DFMSG),(OP)); # TITLE MSG - DISPLAY DAYFILE MESSAGE. # BEGIN # MSG # # ** MSG - DISPLAY DAYFILE MESSAGE. * * *MSG* SEARCHES A MESSAGE FOR A TERMINATING CHARACTER AND * ZERO FILLS THE MESSAGE FROM THE TERMINATOR TO THE END * OF THE MESSAGE. * * PROC MSG((DFMSG),(OP)) * * ENTRY (DFMSG) - MESSAGE TO BE DISPLAYED, 80 CHARACTER * MAXIMUM. * (OP) - MESSAGE ROUTING OPTION. * (VALUES DEFINED IN *COMBFAS*) * * EXIT THE MESSAGE HAS BEEN DISPLAYED AT THE LOCATION * SPECIFIED BY (OP). # ITEM DFMSG C(80); # MESSAGE TEXT # ITEM OP I; # MESSAGE ROUTING OPTION # # **** PROC MSG - XREF LIST BEGIN. # XREF BEGIN PROC MESSAGE; # ISSUE MESSAGE # END # **** PROC MSG - XREF LIST END. # DEF BLANK #" "#; # BLANK CHARACTER # DEF TERMCHAR #";"#; # TERMINATOR CHARACTER # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS ITEM I I; # LOOP COUNTER # ITEM CP I; # CHARACTER POSITION # CONTROL EJECT; CP = 0; FASTFOR I = 0 STEP 1 WHILE I LS 80 AND CP EQ 0 DO # FIND TERMINATOR # BEGIN IF CDFMSG EQ TERMCHAR THEN BEGIN CP = I; END END IF CP NQ 0 THEN # ZERO FILL END OF MESSAGE # BEGIN BDFMSG = 0; END MESSAGE(DFMSG,OP); # ISSUE MESSAGE # RETURN; END # MSG # TERM PROC RESTPFP((OPTION)); # TITLE RESTPFP - RESTORE USER *PFP* AND ABORT OR RETURN. # BEGIN # RESTPFP # # ** RESTPFP - RESTORE USER *PFP* AND ABORT OR RETURN. * * *RESTPFP* RESTORES THE USER-S FAMILY AND USER INDEX, AND * OPTIONALLY CALLS *LOFPROC* TO RETURN ANY LISTED FILES. * * PROC RESTPFP((OPTION)) * * ENTRY (OPTION) - PROCESSING OPTION (VALUES DEFINED IN * *COMBFAS*). * = *PFP$ABORT*, RESTORE *PFP*, RETURN ANY * LISTED FILES, AND ABORT PROCESSING. * = *PFP$END*, RESTORE *PFP*, RETURN ANY LISTED * FILES, AND RETURN TO CALLING PROGRAM. * = *PFP$RESUME*, RESTORE *PFP* AND RETURN TO * CALLING PROGRAM (NO FILES RETURNED). * (USER$FAM) = USER-S CURRENT FAMILY (IN *APFPCOM*). * (USER$UI) = USER-S CURRENT USER INDEX (IN *APFPCOM*). * * EXIT THE USER INDEX AND FAMILY OF THE USER HAVE BEEN * RESTORED. DEPENDING ON THE VALUE OF *OPTION*, * LISTED FILES MAY HAVE BEEN RETURNED, AND/OR * PROCESSING MAY HAVE BEEN ABORTED. * * MESSAGE * PROGRAM ABNORMAL, RESTPFP.*. # ITEM OPTION I; # PROCESSING OPTION # # **** PROC RESTPFP - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ISSUE ABORT # PROC LOFPROC; # LIST OF FILES PROCESSOR # PROC MESSAGE; # ISSUE MESSAGE # PROC SETPFP; # SET FAMILY AND USER INDEX # END # **** PROC RESTPFP - XREF LIST BEGIN. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBPFP ARRAY PFPMSG [0:0] S(3); # ABNORMAL CONDITION MESSAGE # BEGIN ITEM PFPLINE C(00,00,28) =[ # MESSAGE LINE # " PROGRAM ABNORMAL, RESTPFP."]; ITEM PFPZERO U(02,48,12)=[0]; # ZERO BYTE TERMINATOR # END CONTROL EJECT; # * RESTORE FAMILY AND USER INDEX TO USER VALUES. # PFP$WRD0[0] = 0; PFP$FAM[0] = USER$FAM[0]; PFP$UI[0] = USER$UI[0]; PFP$FG1[0] = TRUE; PFP$FG4[0] = TRUE; SETPFP(PFP[0]); IF PFP$STAT[0] NQ OK THEN BEGIN MESSAGE(PFPMSG[0],UDFL1); ABORT; END # * OPTIONALLY RETURN LISTED FILES. # IF OPTION NQ PFP$RESUME THEN BEGIN LOFPROC(0); END # * OPTIONALLY ABORT PROCESSING. # IF OPTION EQ PFP$ABORT THEN # ABORT REQUESTED # BEGIN ABORT; END RETURN; END # RESTPFP # TERM PROC ZFILL(ZBUF,(WDLEN)); # TITLE ZFILL - ZERO FILLS A BUFFER. # BEGIN # ZFILL # # ** ZFILL - ZERO FILLS A BUFFER. * * PROC ZFILL(ZBUF,(WDLEN)) * * ENTRY (WDLEN) = NUMBER OF WORDS TO BE ZERO FILLED. * * EXIT (ZBUF) = ZERO FILLED BUFFER. # ARRAY ZBUF [0:0] ; # ARRAY TO BE ZERO FILLED # BEGIN ITEM ZWORD U(00,00,60); END ITEM WDLEN I; # NUMBER OF WORDS TO BE ZEROED # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS ITEM I I; # LOOP INDUCTION VARIABLE # CONTROL EJECT; # * ZERO FILL THE SPECIFIED NUMBER OF * WORDS IN THE BUFFER. # FASTFOR I = 0 STEP 1 UNTIL WDLEN-1 DO BEGIN ZWORD[I] = 0; END END # ZFILL # TERM PROC ZSETFET((ADDR),(LFN),(FWA),(LEN),(FETL)); # TITLE ZSETFET - INITIALIZES A *FET*. # BEGIN # ZSETFET # # ** ZSETFET - INITIALIZES A FILE ENVIRONMENT TABLE. * * THIS PROCEDURE CREATES A *FET* AT THE SPECIFIED * ADDRESS AND SETS STANDARD FIELDS. OTHER FIELDS MUST BE SET * BY THE USER. * * PROC ZSETFET((ADDR),(LFN),(FWA),(LEN),(FETL)). * * ENTRY (ADDR) - ADDRESS *FET* IS TO START AT. * (LFN) - NAME OF FILE TO BE ACCESSED. * (FWA) - FIRST WORD ADDRESS OF *CIO* BUFFER. * (LEN) - LENGTH OF THE *CIO* BUFFER. * (FETL) - LENGTH OF THE *FET*. * * EXIT *FET* IS INITIALIZED (I.E. *FIRST*, *IN*, *OUT*, AND * *LIMIT* POINTERS , AND *FET* LENGTH FIELDS ARE SET * AND THE *LFN* FIELD IS ZERO FILLED). * * NOTES VALUES SPECIFIED BY PARAMETERS ARE PLACED IN THE * APPROPRIATE ARRAY FIELDS, AND THE POINTER OF BASED * ARRAY *FETSET* IS SET TO *ADDR*. # ITEM ADDR U; # ADDRESS OF *FET* # ITEM LFN C(7); # FILE NAME # ITEM FWA U; # *FWA* OF *CIO* BUFFER # ITEM LEN U; # LENGTH OF *CIO* BUFFER # ITEM FETL U; # LENGTH OF *FET* # # **** PROC ZSETFET - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # ZERO OR BLANK FILLS ITEM # PROC ZFILL; # ZERO FILLS AN ARRAY # END # **** PROC ZSETFET - XREF LIST END. # DEF MINFETL #5#; # MINIMUM *FET* LENGTH # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBFET CONTROL EJECT; # * ZERO FILL *FET* AND SET STANDARD FIELDS. # P = ADDR; ZFILL(FETSET[0],FETL); BZFILL(LFN,TYPFILL"ZFILL",7); # ZERO-FILL FILE NAME # FET$LFN[0] = LFN; FET$LOCK[0] = TRUE; FET$FRST[0] = FWA; FET$IN[0] = FWA; FET$OUT[0] = FWA; FET$LIM[0] = FWA + LEN; FET$L[0] = FETL - MINFETL; # SET LENGTH OF *FET* # RETURN; END # ZSETFET # TERM