ACCPRT * /--- FILE TYPE = E * /--- BLOCK FILES PRT 00 000 81/01/28 15.49 OVERLAY(AFPRINT,0,0) PROGRAM AFPRT(INPUT,OUTPUT) C C COMMON DEFINITIONS C IMPLICIT INTEGER(A-Z) C REAL TEMP,TEMP1 C DIMENSION FNAMES(2000),FIWS(2000),NFILES(17),NPARTS(17) C COMMON /ARGS/ ACCOUNT,PACCT,PGROUP,PNAME,FTYPES C COMMON /DISK/ FIW,DISKADD,DISKF1,DISKF2,BUFF(320) C COMMON /DATIME/ TIME,DATE C DATA NFILES/17*0/,NPARTS/17*0/ C C C INITIALIZATIONS C C CALL SETUP ACCT=ACCOUNT CALL IBFILL(ACCT) C C GET THE DIRECTORY INFO C CALL ATTACH (ACCOUNT) TYPE=ISHR(FIW,30).AND.77B IF (TYPE.EQ.12)GOTO 05 CALL BADFILE C 05 IF (FTYPES.NE.0) GOTO 06 CALL NOTYPES C 06 CALL DISKIN (1) BLOCK=1 C C -------- C // NOTE - IF ACCOUNT DIRECTORY CHANGES, YOU MUST C // CHANGE THESE REFERENCES ALSO. C // C // *FPTR* = START OF FILE NAME TABLE C // *FTBLTH* = LENGTH OF FILE NAME TABLE C -------- C FPTR=BUFF(13) FTBLTH=BUFF(22) FUSED=BUFF(1).AND.777777B FALLOT=ISHR(BUFF(1),18).AND.777777B PRINT 1000 DO 10 I=1,11 BUFF(I)=10L********** 10 CONTINUE CALL IBFILL(PGROUP,PNAME) PRINT 1010,(BUFF(I),I=1,11) PRINT 1020,ACCT,DATE,TIME,PNAME,PGROUP PRINT 1025,FTBLTH,FUSED,FALLOT DO 110 I=1,11 BUFF(I)=10L********** 110 CONTINUE PRINT 1010,(BUFF(I),I=1,11) C IF (FTYPES.EQ.-1) GOTO 120 PRINT 1011 C DO 11 I=1,13 J=ISHL(FTYPES,I).AND.1 IF (J.EQ.0)GOTO 11 J=FILETYP(I) PRINT 1012,J 11 CONTINUE C 120 PRINT 1000 C C DETERMINE 1ST AND LAST BLOCK IN WHICH ACCOUNT C FILE NAME TABLE EXISTS, AND READ THAT INTO THE C FILE NAMES BUFFER C C SBLK=INT((FPTR-1)/320)+1 $$ STUPID -FTN- TEMP=((FPTR-1)/320)+1 SBLK=INT(TEMP) C ENDBLK=INT(((FPTR+FTBLTH)-1)/320)+1 $$ STUPID -FTN- TEMP1=(((FPTR+FTBLTH)-1)/320)+1 ENDBLK=INT(TEMP1) TFILES=0 C C -- *START* SET TO (WHATEVER)+1 BECAUSE *FPTR* REFERENCES C -- FNAMES(0). WHOEVER DID THIS SHOULD BE SHOT. START=FPTR-((SBLK-1)*320)+1 C C -- CATCH THE CASE WHICH IS IF *FPTR* DOES NOT LIE IN C -- BLOCK 1... C IF (SBLK.EQ.BLOCK)GOTO 12 BLOCK=SBLK CALL DISKIN (SBLK) C 12 DO 100 K=SBLK,ENDBLK IF (BLOCK.EQ.K)GOTO 15 C CALL ATTACH (ACCOUNT) CALL DISKIN (K) C CALL DETACH (ACCOUNT) START=1 15 CONTINUE ENDF=320 IF (K.NE.ENDBLK)GOTO 20 ENDF=(FPTR+FTBLTH)-((K-1)*320) 20 CONTINUE * /--- BLOCK FILES PRT 00 000 81/01/30 17.22 DO 25 N=START,ENDF CALL ATTACH (BUFF(N)) I=ISHR(FIW,30).AND.77B I=ISHL(FTYPES,I).AND.1 CALL DETACH (BUFF(N)) IF (I.NE.1) GOTO 25 TFILES=TFILES+1 FNAMES(TFILES)=BUFF(N) FIWS(TFILES)=FIW 25 CONTINUE 100 CONTINUE C C NOW, PRINT THE FILE NAMES AND CORRESPONDING INFO C IF (TFILES.GT.0) GOTO 35 PRINT 1035 GOTO 99 C 35 I=1 J=MIN0(58,TFILES) PAGE=0 45 K=0 PAGE=PAGE+1 PRINT 1026,ACCT,TIME,DATE,PAGE DO 50 N=I,J M=N+58 CALL IBFILL (FNAMES(N)) LENGTH1=ISHR(FIWS(N),24).AND.77B TYPE1=ISHR(FIWS(N),30).AND.77B NFILES(TYPE1)=NFILES(TYPE1)+1 NPARTS(TYPE1)=NPARTS(TYPE1)+LENGTH1 TYPE1=FILETYP(TYPE1) C C IF *M* .GT. THE TOTAL NUMBER OF FILES, ONLY C PRINT ONE PIECE OF FILE INFO PER LINE... C IF (M.GT.TFILES)GOTO 55 C C ELSE PRINT 2 FILES PER LINE C C *FNAMES(M)* = BLANK-FILLED FILE NAME C *TYPE2* = 10 CHAR FILE TYPE C *LENGTH2* = LENGTH OF FILE IN *SYS(DSBLKS)* C CALL IBFILL (FNAMES(M)) LENGTH2=ISHR(FIWS(M),24).AND.77B TYPE2=ISHR(FIWS(M),30).AND.77B NFILES(TYPE2)=NFILES(TYPE2)+1 NPARTS(TYPE2)=NPARTS(TYPE2)+LENGTH2 TYPE2=FILETYP(TYPE2) K=K+2 PRINT 1040,FNAMES(N),LENGTH1,TYPE1,FNAMES(M),LENGTH2,TYPE2 GOTO 50 55 PRINT 1030,FNAMES(N),LENGTH1,TYPE1 K=K+1 C 50 CONTINUE I=I+K J=MIN0(I+57,TFILES) PRINT 1000 IF (I.LE.TFILES)GOTO 45 C C NOW PRINT OUT ACCOUNT SUMMARY C PAGE=PAGE+1 PRINT 1026,ACCT,TIME,DATE,PAGE K=0 N=0 PRINT 1050 DO 65 I=1,17 IF (NFILES(I).EQ.0) GOTO 65 J=FILETYP(I) K=K+NFILES(I) N=N+NPARTS(I) PRINT 1055,J,NFILES(I),NPARTS(I) 65 CONTINUE PRINT 1060,K,N 99 CONTINUE * /--- BLOCK FILES PRT 00 000 78/10/07 00.46 C ****************************************************** C C VARIOUS -FORMAT- STATEMENTS C 1000 FORMAT (1H1) 1010 FORMAT (6X,11A10,//) 1011 FORMAT (6X,*FILE TYPES REQUESTED -*,/) 1012 FORMAT (12X,A10) 1020 FORMAT (6X,*FILES IN ACCOUNT *,A10,4X,*PRINTED ON*,A9, * 2X,*AT *,A6,4X,*BY *,A10,* OF GROUP *,A10,//) 1025 FORMAT (6X,*TOTAL FILES IN ACCOUNT = *,I4,8X, * *SPACES USED/ALLOTTED*,5X,I4,* / *,I4,//) 1026 FORMAT (6X,*LIST OF FILES FOR ACCOUNT *,A7,* AT*,A6,* ON*, * A10,45X*PAGE*,I5,/) 1030 FORMAT (6X,A10,4X,I2,* PART *,A10) 1035 FORMAT (6X,*NO FILES OF SPECIFIED TYPE(S)*) 1040 FORMAT (6X,A10,4X,I2,* PART *,A10,15X, * A10,4X,I2,* PART *,A10) 1050 FORMAT (//,20X,*ACCOUNT SPACE UTILIZATION SUMMARY*,///,15X, * * TYPE*,8X,*TOTAL FILES*,6X,*TOTAL PARTS*,//) 1055 FORMAT (15X,A10,7X,I4,12X,I5) 1060 FORMAT (/,14X,*GRAND TOTAL*,6X,I5,12X,I5) STOP END * /--- BLOCK IDENT 00 000 78/12/01 21.54 IDENT FILESUB TITLE SUBROUTINES FOR ACCOUNT FILES PRINTER TITLE DEFINITIONS * ************************************************ * * BLKLTH EQU 320 SIZE OF A PLATO DISK BLOCK ACSTART EQU 1 1ST BLOCK OF ACCOUNT ACCBLKS EQU 16 TOTAL BLKS IN AN ACCOUNT * * DISKBUF EQU 0 ECSLTH EQU DISKBUF+BLKLTH * * USE /ARGS/ ACCOUNT BSS 1 ACCOUNT NAME PACCT BSS 1 ACCOUNT OF PERSON DOING PRINT PGROUP BSS 1 GROUP OF PERSON DOING PRINT PNAME BSS 1 NAME OF PERSON DOING PRINT FTYPES BSS 1 FILE TYPES TO PRINT FLAGS * * USE /DISK/ FIW BSS 1 FIW OF FILE OPENED DISKADD BSS 1 DISK ADDRESS OF FILE DISKF1 BSS 1 DISKF2 VFD 48/BLKLTH,12/1 BUFF BSS BLKLTH * * USE /DATIME/ TIME BSS 1 DATE BSS 1 * USE * * ************************************************ * * * FORMAT OF THE FILE INFORMATION WORD * * * 1ST BIT = FBIT - FILE CHANGED BIT * NEXT 11 = STATION FILE ATTACHED TO * NEXT 6 = RECORD MANAGEMENT TABLE * NEXT 6 = NUMBER OF DIRECTORY BLKS * NEXT 6 = FILE TYPE * NEXT 6 = LENGTH GIVEN IN *SYS(DSBLKS)* * NEXT 24 = DISK SPACE NUMBER * * * ************************************************ * /--- BLOCK MACARONI 00 000 78/07/03 03.19 TITLE MACROS * ************************************************ * PURGMAC CALL CALL MACRO NAME,ARG1,ARG2,ARG3 IFC NE,**ARG3*,1 SB3 ARG3 IFC NE,**ARG2*,1 SB2 ARG2 IFC NE,**ARG1*,1 SB1 ARG1 RJ =X_NAME_ ENDM * * ************************************************ * /--- BLOCK SETUP 00 000 80/05/17 21.02 TITLE -SETUP- LOAD TIME INITIALIZATIONS ** * PROGRAM INITIALIZATIONS * SST SYSCOM *CALL SYSCON *CALL COMCSYS * ENTRY SETUP SETUP EQ * CALL GETARG NAME OF ACCOUNT TO PRINT NZ X6,SETUP01 IF THIS IS 0, SUMTHING IS WRONG SA6 -1 SETUP01 SA6 ACCOUNT CALL GETARG ACCT OF PERSON DOING PRINT SA6 PACCT CALL GETARG GROUP OF PERSON DOING PRINT SA6 PGROUP CALL GETARG NAME OF PERSON DOING PRINT SA6 PNAME * MX6 0 PRE-SET *FTYPES* SA6 FTYPES SETUP1 CALL GETARG ZR X6,SETUP2 DONE WITH CONTROL CARD LX6 18 RIGHT-JUSTIFY IF - ALL - SX4 X6-3RALL * NZ X4,SETUP15 MX6 59 IF - ALL - SET ALL GOOD BITS EQ SETUP16 * SETUP15 AX6 12 RIGHT-JUSTIFY SINGLE CHAR MX1 54 ISOLATE BOTTOM CHAR ONLY BX6 -X1*X6 SX4 X6-1RM CHECK TO SEE IF VALID FTYPE PL X4,BADONE SB1 X6-60 FIND SHIFT CNT SX6 1 AX6 X6,B1 MOVE TO PROPER LOCATION SA1 FTYPES GET CURRENT *FTYPES* BX6 X1+X6 SETUP16 SA6 FTYPES AND STORE *FTYPES* EQ SETUP1 * BADONE MESSAGE BADTYPE,,RECALL CALL RELECS ABORT * * SETUP2 SA1 LWPR LAST WORD OF PROGRAM SX6 X1+100B ROUND UP BY 100B MX0 -6 BX6 X0*X6 LX6 30 SA6 CMFL SET CM FIELD LENGTH MEMORY CM,CMFL,RECALL SX6 ECSLTH SA6 ECFL CALL REQECS,ECFL CLOCK TIME DATE DATE * WRITE ACCOUNT, COURSE, NAME OF PRINT REQUESTOR * TO ACCOUNT FILE * CONTROL CARD TO ACCOUNT FILE MESSAGE CCDR,5,RECALL * * DAYFILE THE VERSION DATE AND TIME * MESSAGE TO JOB DAYFILE ONLY * MESSAGE VERZION,LOCAL,RECALL SA1 ACCOUNT BX6 X1 SA6 ACCTNAM MESSAGE PRTING,1,RECALL EQ SETUP PRTING DATA 10H PRINTING ACCTNAM BSS 1 DATA 0 * /--- BLOCK SETUP 00 000 80/09/03 00.08 * ************************************************ TITLE SYSTEXT * ************************************************ * ECSPRTY EQ * MESSAGE ECSMES,,RECALL CALL RELECS RELEASE ALL THE ECS ABORT EQ * * TITLE *MASTOR* REQUEST/COMMUNICATION ROUTINES * * MASTOR REQUEST ROUTINES * EXT REQECS,RELECS,OPF,CPF,READPF,GETARG * * ************************************************ TITLE RETURN PROPER FILE TYPE ** * + FILETYP + * * CALLABLE FROM FTN. * * THIS RETURNS THE PROPER, BLANK-FILLED PLATO * FILE TYPE, GIVEN THE NUMERIC VALUE FROM THE -FIW- * * WILLIAM M. GALCHER * JULY 10, 1978 * * ENTRY FILETYP FILETYP EQ * SA2 X1 GET OFFSET INTO TABLE PL X2,FTCHK -- BRIF .GT. 0 BADFT SX2 0 SET TO *UNKNOWN* EQ FRET FTCHK SX3 X2-FTLTH SEE IF IN TABLE PL X3,BADFT FRET SA3 X2+FTINFO BX6 X3 AND STORE IT FOR -FTN- EQ FILETYP * FTINFO DATA 0HUNKNOWN TFINFO(0) DATA 0HTUTOR TUTOR, INSTRUCTOR, ROUTER DATA 0HBINARY BINARIES DATA 0HCURRICULUM NEW-STYLE CURRICULUM FILES DATA 0HDATAFILE STUDENT DATAFILES DATA 0HCODE COMPASS/BACKGROUND FILES DATA 0HGROUP NEW-STYLE GROUPS DATA 0HDATASET DATASETS DATA 0HPLMCURR PLM CURRICULUM FILE DATA 0HGNOTES GENERAL NOTES DATA 0HUNKNOWN FILE TYPE = J, BUT IS NOT DEFINED DATA 0HNAMESET NAMESETS DATA 0HACCOUNT ACCOUNT FILES DATA 0HCATALOG CATALOG FILES DATA 0HUNKNOWN FILE TYPE = N, BUT NOT DEFINED DATA 0HMODULE PLM MODULE FILE DATA 0HPNOTES NAMESET PNOTES FILE DATA 0HDOCUMENTOR NAMESET-TYPE DOCUMENTOR FILE FTLTH EQU *-FTINFO * TITLE -NOTYPES- ARGUMENT ERROR IN CONTROL CARD ENTRY NOTYPES NOTYPES EQ * MESSAGE MISTYPE,,RECALL CALL RELECS ABORT EQ * * * /--- BLOCK SHIFTS 00 000 78/07/03 03.40 TITLE SHIFTS * * FUNCTIONS FOR LEFT AND RIGHT SHIFTS. * CALLABLE FROM FTN. * * LAWRENCE A. WHITE * AUGUST 11, 1976 * ENTRY ISHL ISHL EQ *+400000B SA2 X1 VALUE TO BE SHIFTED SA1 A1+1 SA3 X1 AMOUNT TO SHIFT IT SB2 X3 LX6 X2,B2 EQ ISHL * ENTRY ISHR ISHR EQ *+400000B SA2 X1 SA1 A1+1 SA3 X1 SB2 X3 AX6 X2,B2 EQ ISHR * * * /--- BLOCK BLANK FILL 00 000 78/07/10 05.40 TITLE ZERO TO BLANK ROUTINE * * -IBFILL- * * BLANK FILL ALL ARGUMENTS * CALLABLE FROM FTN. CALL IBFILL(I,J,K,L,M,N) * CONVERTS ALL 00B CHARS TO 55B * ENTRY IBFILL IBFILL EQ * SB1 1 FILLLP ZR X1,IBFILL END OF ARGUMENTS CHECK SA5 X1 GET ARGUMENT RJ BLFILL BLANK FILL SA6 X1 RE-STORE BLANK FILLED VERSION SA1 A1+1 GET ADDRESS OF NEXT ARGUMENT EQ FILLLP GO FILL IT * * ENTRY X5 = 10 CHARACTER WORD * EXIT X6 = SAME THING WITH 6/55B IN PLACE OF 6/0. * BLFILL PS SA2 =40404040404040404040B BX3 -X5 LX4 B1,X3 BX3 X3*X4 LX4 1 BX3 X3*X4 BX4 X3 LX4 3 BX3 X3*X4 BX3 X3*X2 BX4 X3 LX4 -2 BX3 X3+X4 BX4 X3 LX4 -3 BX3 X3+X4 BX6 X5+X3 EQ BLFILL * * /--- BLOCK OPEN/CLOSE 00 000 81/01/28 12.31 TITLE ATTACH PLATO FILE * * -ATTACH- * ATTACH SPECIFIED PLATO FILE * * ON ENTRY - X1 = ADDRESS OF FILE NAME * * ON EXIT - X1 = 0 IF ATTACH WORKED * = 1 IF AN ERROR OCCURRED * X2 = FIW INFO WORD * * ENTRY ATTACH ATTACH EQ * SA2 X1 GET FILE NAME BX6 X2 SA6 PFILE CALL OPF,PFILE NZ X1,ATTERR ERROR CHECK BX6 X2 SA6 FIW SAVE FILE INFO WD EQ ATTACH * PFILE DATA 0 PLATO FILE NAME DATA 0 EOL (FOR -MESSAGE-) * ATTERR BSS 0 SX1 X1+5500B MAKE ERROR CODE ALPHA SA2 PFILE BX6 X1+X2 SA6 A2 STORE WITH FILE NAME * MESSAGE ATTMES,,RECALL MESSAGE PFILE,,RECALL SA1 -1 CALL RELECS RELEASE ALL ECS ABORT TITLE BOMBOFF IF NOT AN ACCOUNT ** * + BADFILE + * * IF ONE TRIES TO ATTACH A FILE WHICH IS NOT * AN ACCOUNT FILE TO TRY TO READ THE NAMES OF * FILES, THE JOB IS A ABORTED WITH THE APPROPRIATE * MESSAGE DUMPED TO THE DAYFILE * ** ENTRY BADFILE BADFILE EQ * MESSAGE NOACC,,RECALL MESSAGE PFILE,,RECALL CALL RELECS ABORT * TITLE DETACH PLATO FILE * * * -DETACH- * DETACH SPECIFIED FILE * * ENTRY DETACH DETACH EQ * CALL CPF,PFILE EQ DETACH * * TITLE READ BLOCK FROM PLATO DISK FILE * * * -DISKIN- * READS SPECIFIED BLOCK FROM DISK AND TRANSFERS * IT TO THE CM BUFFER *BUFF* * * ON ENTRY - X1 = ADDRESS OF BLOCK NUMBER * * ENTRY DISKIN DISKIN EQ * CALL READPF,PFILE,X1,DISKBUF NZ X1,DISKERR ERROR CHECK * SX6 A0 SAVE A0 FOR FTN SA6 A0SAVE SX0 DISKBUF ADDRESS OF ECS BUFFER SA0 BUFF + RE BLKLTH BRING BLOCK TO CM RJ ECSPRTY SA1 A0SAVE RESTORE A0 SA0 X1 EQ DISKIN * DISKERR MESSAGE DISKMES,,RECALL MX6 0 SA6 BUFF SET END-OF-FILE SA6 BUFF+1 EQ DISKIN EXIT * A0SAVE DATA 0 FOR SAVING A0 FOR FTN * /--- BLOCK STORAG/END 00 000 78/07/10 06.36 TITLE STORAGE * ************************************************ * SDATE MICRO 5,5,$"DATE"$ SYEAR MICRO 2,2,$"DATE"$ VERZION DIS 0,* VERSION "SDATE"/"SYEAR" "TIME"* ATTMES DIS ,*ERROR IN OPENING* NOACC DIS ,*NOT AN ACCOUNT* DISKMES DIS ,*DISK ERROR* ECSMES DIS ,*ECS ERROR* MISTYPE DIS ,*ARGUMENT ERROR - NO TYPES SPECIFIED* BADTYPE DIS ,*ARGUMENT ERROR - INVALID FILE TYPE* * IFNT BSS 1 IECS VFD 60/DISKBUF * CMFL BSS 1 ECFL BSS 1 * SAV1 BSS 1 SAV2 BSS 1 ILOC BSS 1 ILOC1 BSS 1 * * ************************************************ END