PROC BZFILL(CHAR,(TYP),(NUM)); # IDENT BZFILL TITLE BZFILL - BLANK OR ZERO FILLS A CHARACTER ITEM. # BEGIN # BZFILL # # *** BZFILL - BLANK OR ZERO FILLS A CHARACTER ITEM. * * COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. * * PROC BZFILL(CHAR,(TYP),(NUM)) * * ENTRY (TYP) = TYPE OF FILLING REQUIRED. * = 0 (S"BFILL"), BLANK FILLING. * = 1 (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 COMAMSS *CALL COMABZF 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 # # END # TERM PROC LOFPROC((LFN)); # IDENT LOFPROC 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 COMAMSS *CALL COMAFET 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 # # END # TERM PROC MSG((DFMSG),(OP)); # IDENT MSG 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 *MESSAGE* MACRO ROUTINE) * * 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 COMAMSS 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 # # END # TERM PROC RESTPFP((OPTION)); # IDENT RESTPFP 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 * *COMAMSS*). * = *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 COMAMSS *CALL COMAPFP 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 THE PERMANENT FILE PARAMETERS TO THE USER VALUES. # PFP$WRD0[0] = 0; PFP$FAM[0] = USER$FAM[0]; PFP$UI[0] = USER$UI[0]; PFP$PACK[0] = USER$PACK[0]; PFP$FG1[0] = TRUE; PFP$FG2[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 # # END # TERM PROC SETNM((NAME),(SRCHCHAR),(TERMCHAR),(MSGBUF),ASMBUF); # IDENT SETNM TITLE SETNM - SET NAME IN MESSAGE. # BEGIN # SETNM # # *** SETNM - SET NAME IN MESSAGE. * * *SETNM* REPLACES OCCURENCES OF THE SEARCH CHARACTER WITHIN A * MESSAGE OR LINE WITH THE CHARACTERS OF THE GIVEN NAME OR * NUMBER, ELIMINATING ALL EXCESS OCCURENCES OF THE SEARCH * CHARACTER. THE TERMINATOR CHARACTER IS REPLACED BY AN END OF * LINE IN THE NEW MESSAGE. THE ORIGINAL MESSAGE MUST CONTAIN A * SUFFICIENT NUMBER OF SEARCH CHARACTERS (USUALLY CONSECUTIVE) * TO ALLOW FOR REPLACEMENT BY THE NAME OR NUMBER (UP TO 10 * CHARACTERS). THE MESSAGE MUST NOT CONTAIN COLONS (00B) * SINCE THEY WILL BE INTERPRETED AS EOL. * * PROC SETNM((NAME),(SRCHCHAR),(TERMCHAR),(MSGBUF),ASMBUF) * * ENTRY (NAME) - DISPLAY CODE NAME OR NUMBER TO BE SET IN * THE MESSAGE, LEFT JUSTIFIED, BLANK OR BINARY * ZERO FILLED. IF (NAME) .EQ. 0, ALL SEARCH * CHARACTER OCCURENCES WILL BE DELETED. * (SRCHCHAR) - DISPLAY CODE SEARCH CHARACTER, LEFT * JUSTIFIED. * (TERMCHAR) - DISPLAY CODE MESSAGE TERMINATION CHARACTER, * LEFT JUSTIFIED. IF (TERMCHAR) .EQ. 0, THE * MESSAGE IS TERMINATED BY EOL. * (MSGBUF) - MESSAGE OR LINE (MAXIMUM OF 80 CHARACTERS). * * EXIT (ASMBUF) - MESSAGE WITH THE GIVEN NAME OR NUMBER * ENTERED IN PLACE OF THE SEARCH CHARACTERS * END TERMINATED BY EOL. # ITEM NAME C(10); # REPLACEMENT NAME OR NUMBER # ITEM SRCHCHAR C(1); # SEARCH CHARACTER # ITEM TERMCHAR C(1); # TERMINATING CHARACTER # ITEM MSGBUF C(80); # MESSAGE OR LINE # ITEM ASMBUF C(80); # ASSEMBLY BUFFER # # **** PROC SETNM - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK/ZERO FILL ITEM # END # **** PROC SETNM - XREF LIST END. # DEF BLANK #" "#; # BLANK CHARACTER # DEF ODDNUM(I) #(((I)/2)*2) NQ (I)#; # ODD NUMBER TEST # DEF LISTCON #0#; # COMDECK LIST CONTROL # *CALL COMAMSS *CALL COMABZF ITEM APOS I; # ASSEMBLY BUFFER POSITION # ITEM I I; # LOOP VARIABLE # ITEM NPOS I; # *NAME* POSITION # CONTROL EJECT; APOS = 0; NPOS = 0; BZFILL(NAME,TYPFILL"ZFILL",10); SLOWFOR I = 0 STEP 1 WHILE I LS 80 ## AND CMSGBUF NQ TERMCHAR DO BEGIN # ASSEMBLE MESSAGE # IF CMSGBUF EQ SRCHCHAR THEN BEGIN # TRANSFER *NAME* # IF BNAME NQ 0 AND NPOS LS 10 THEN # REPLACE SEARCH CHARACTER # BEGIN CASMBUF = CNAME; NPOS = NPOS + 1; END ELSE # SKIP SEARCH CHARACTER # BEGIN TEST I; END END # TRANSFER *NAME* # ELSE # TRANSFER MESSAGE # BEGIN CASMBUF = CMSGBUF; END APOS = APOS + 1; # ADVANCE *ASMBUF* POSITION # END # ASSEMBLE MESSAGE # IF ODDNUM(APOS) THEN BEGIN # ODD NUMBER OF CHARACTERS # IF CASMBUF EQ BLANK THEN # DELETE TRAILING BLANK # BEGIN APOS = APOS - 1; END ELSE # ADD TRAILING BLANK # BEGIN CASMBUF = " "; APOS = APOS + 1; END END # ODD NUMBER OF CHARACTERS # BASMBUF = 0; # ADD MESSAGE TERMINATOR # END # SETNM # # END # TERM PROC ZFILL(ZBUF,(WDLEN)); # IDENT ZFILL 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 COMAMSS 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 # # END # TERM PROC ZSETFET((ADDR),(LFN),(FWA),(LEN),(FETL)); # IDENT ZSETFET 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 COMAMSS *CALL COMABZF *CALL COMAFET 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 # # END # TERM