APRT * /--- FILE TYPE = E * /--- BLOCK ACCLOGPRT 00 000 79/05/03 12.28 OVERLAY(APRINT,0,0) PROGRAM ACCPRT(INPUT,OUTPUT) C C COMMON DEFINITIONS C IMPLICIT INTEGER(A-Z) C C COMMON /ARGS/ FILE,ACCOUNT,STDATE,ENDATE,SHLNFL C COMMON /DISK/ DISKADD,DISKF1,DISKF2,BUFF(320) C COMMON /GETLINE/ BLOCK,NBLOCKS,TBLKS,NXT,END,LINE(64) C COMMON /DATIME/ TIME,DATE C C C C INITIALIZATIONS C CALL SETUP CALL ATTACH (FILE) CALL DATEFIX(STDATE,STDATE) CALL DATEFIX(ENDATE,ENDATE) 2 PRINT 1000 DO 10 I=1,11 BUFF(I)=10L********** 10 CONTINUE PRINT 1010,(BUFF(I),I=1,11) CALL IBFILL(FILE) PRINT 1020,FILE,DATE,TIME IF(ACCOUNT.EQ.0)GOTO 20 I=ACCOUNT CALL IBFILL(I) PRINT 1030,I 20 PRINT 1010,(BUFF(I),I=1,11) CALL DISKIN (0) C TOTAL BLOCKS IN FILE TBLKS=BUFF(3) C ///// C THE FOLLOWING CHECKS FOR OLD TYPE FILE DIRECTORY C ALL CODE BETWEEN THE *///* MARKERS CAN BE REMOVED C ONCE ALL FILES ARE CONVERTED TO NEW FORMAT LMK 1/20/76 C IF(BUFF(4).LT.0)GOTO776 C I=BUFF(5)+1 NBLOCKS=BUFF(I) GOTO 80 C 776 CONTINUE C//// C NUMBER OF BLOCKS IN USE NBLOCKS = BUFF(4).AND.(77777B) 80 CALL ISTLIN IF(END.NE.0)GOTO 90 C C MAIN LOOP - PROCESS NEXT LOG ENTRY C 100 CALL GETLINE IF(END.NE.0)GOTO 90 TYPE=LINE(1).AND.77B IF(TYPE.NE.9)GOTO 100 TYPE=LINE(2).AND.7777B IF(TYPE.LE.0)GOTO 100 C * /--- BLOCK ACCLOGPRT 00 000 81/11/02 14.39 C IF THE SHORTEN/LENGTHENS FLAG IS *SET2*, IGNORE ALL C TYPES EXCEPT'; CREATE=1, DESTROY=2, RENAME=3, COPY=4, C ARCHIVE=7, RETRIEVE=8, COPY CONTENTS=12, REPLACE=31, C TRANSFER=49, OFFLINE COPY AND REPLACE = 54-59. C IF *SET3*, IGNORE ALL EXCEPT'; ACCT RENAME TO=13, C ACCT RENAME FROM=14, ACCT CREATE=15, ACCT DESTROY=16, C CHANGE ACCT DIR=17, CHANGE SPACES=18, CHANGE SUBS=19, C CHANGE PUBLISH FLAG=21, CHANGE LESSON ACCESS=22, C CHANGE ARCHIVE RIGHTS=25, CHANGE PRINT ACCESS=26, C CHANGE NETWORK OPTION=47, CHANGE TEST FLAG=53, C CHANGE PARCEL LIMITS=60-62, CHANGE FREE SPACES=64, C CHANGE CYBERNET TRANSMIT FLAG=65. C ERRORS (>65) ARE ALWAYS INCLUDED. C IF(TYPE.GT.65) GOTO 130 IF(SHLNFL.EQ.4LSET2) GOTO 110 IF(SHLNFL.EQ.4LSET3) GOTO 120 GOTO 130 110 GOTO (130,130,130,130,100,100,130,130,100,100, * 100,130,100,100,100,100,100,100,100,100, * 100,100,100,100,100,100,100,100,100,100, * 130,100,100,100,100,100,100,100,100,100, * 100,100,100,100,100,100,100,100,130,100, * 100,100,100,130,130,130,130,130,130,100, * 100,100,100,100,100) TYPE 120 GOTO (100,100,100,100,100,100,100,100,100,100, * 100,100,130,130,130,130,130,130,130,100, * 130,130,100,100,130,130,100,100,100,100, * 100,100,100,100,100,100,100,100,100,100, * 100,100,100,100,100,100,130,100,100,100, * 100,100,130,100,100,100,100,100,100,130, * 130,130,100,130,130) TYPE 130 CONTINUE * /--- BLOCK ACCLOGPRT 00 000 81/12/10 11.03 C ACCN=LINE(2).AND.77777777777777000000B IF(ACCOUNT.EQ.0)GOTO 150 IF(ACCOUNT.NE.ACCN)GOTO 100 150 NAME=LINE(3) COURSE=LINE(4).AND.77777777777777770000B C IF (STDATE.EQ.0)GOTO 160 CALL DATEFIX(LINE(5),I) IF (I.LT.STDATE) GOTO 100 IF (ENDATE.EQ.0)GOTO 160 IF (I.GT.ENDATE) GOTO 100 C 160 CALL DATER (LINE(5),IDATE) ITIME=ISHL((LINE(5).AND.77777777B),36) FILE1=LINE(6) PACK1=LINE(7) CALL IBFILL(FILE1,PACK1) C CALL IBFILL(ACCN,NAME,COURSE) REMOTE=LINE(2).AND.770000B IF (REMOTE.EQ.0) GO TO 170 REMOTE=SHIFT((REMOTE.OR.(LINE(4).AND.7777B)),42) PRINT 2000,IDATE,ITIME,ACCN,NAME,COURSE,REMOTE GO TO 180 170 STATN=LINE(4).AND.7777B SITE=STATN/32 STATN=STATN.AND.37B PRINT 2010,IDATE,ITIME,ACCN,NAME,COURSE,SITE,STATN C 180 IF(TYPE.GT.65) GOTO 900 GOTO (210,220,230,240,250,260,270,280,290,300, * 310,320,330,340,350,360,370,380,390,400, * 410,420,430,440,450,460,470,480,490,500, * 510,520,530,540,550,560,570,580,590,600, * 610,620,630,640,650,660,670,680,690,700, * 710,720,730,740,750,760,770,780,790,800, * 810,820,830,840,850) TYPE C 210 PRINT 3010,FILE1,PACK1 GOTO 100 C 220 PRINT 3020,FILE1,PACK1 GOTO 100 C 230 FILE2=LINE(8) CALL IBFILL(FILE2) PRINT 3030,FILE1,PACK1,FILE2 GOTO 100 C 240 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3040,FILE1,PACK1,FILE2,PACK2 GOTO 100 C 250 PACK2=LINE(8) CALL IBFILL(PACK2) PRINT 3050,FILE1,PACK1,PACK2 GOTO 100 C 260 PACK2=LINE(8) CALL IBFILL(PACK2) PRINT 3060,FILE1,PACK1,PACK2 GOTO 100 C 270 PRINT 3070,FILE1,PACK1 GOTO 100 C * /--- BLOCK ACCLOGPRT 00 000 80/01/09 13.35 280 FILE2=LINE(8) CALL IBFILL(FILE2) PRINT 3080,FILE1,FILE2,PACK1 GOTO 100 C 290 PRINT 3090,FILE1 GOTO 100 C 300 PRINT 3100,FILE1 GOTO 100 C 310 PRINT 3110,FILE1 GOTO 100 C 320 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3120,FILE1,PACK1,FILE2,PACK2 GOTO 100 C 330 PRINT 3130,FILE1 GOTO 100 C 340 PRINT 3140,FILE1 GOTO 100 C 350 PRINT 3150 GOTO 100 C 360 PRINT 3160 GOTO 100 C 370 PRINT 3170 GOTO 100 C 380 PRINT 3180 GOTO 100 C 390 PRINT 3190 GOTO 100 C 400 PRINT 3200 GOTO 100 C 410 PRINT 3210 GOTO 100 C 420 PRINT 3220 GOTO 100 C 430 PRINT 3230 GOTO 100 C 440 PRINT 3240 GOTO 100 C 450 PRINT 3250 GOTO 100 C 460 PRINT 3260 GOTO 100 C 470 FILE2=LINE(7) CALL IBFILL(FILE2) PRINT 3270,FILE1,FILE2 GOTO 100 C 480 PRINT 3280 GOTO 100 C 490 PRINT 3290 GOTO 100 C 500 PRINT 3300 GOTO 100 C 510 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3310,FILE2,PACK2,FILE1,PACK1 GOTO 100 C 520 PACK2=LINE(8) CALL IBFILL(PACK2) PRINT 3320,FILE1,PACK1,PACK2 GOTO 100 C 530 PRINT 3330, FILE1 GOTO 100 C 540 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3340,FILE1,PACK1,FILE2,PACK2 GOTO 100 C 550 PACK2=LINE(8) CALL IBFILL(PACK2) PRINT 3350,FILE1,PACK1,PACK2 GOTO 100 C * /--- BLOCK ACCLOGPRT 00 000 81/11/02 14.42 560 PRINT 3360, FILE1 GOTO 100 C 570 PRINT 3370, FILE1 GOTO 100 C 580 PRINT 3380 GOTO 100 C 590 PRINT 3390 GOTO 100 C 600 PRINT 3400, FILE1 GOTO 100 C 610 PRINT 3410, FILE1 GOTO 100 C 620 PRINT 3420, FILE1 GOTO 100 C 630 PRINT 3430 GOTO 100 C 640 PRINT 3440 GOTO 100 C 650 PRINT 3450 GOTO 100 C 660 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3460,FILE1,PACK1,FILE2,PACK2 GOTO 100 C 670 PRINT 3470 GOTO 100 C 680 FILE2=LINE(7) CALL IBFILL(FILE2) PRINT 3480,FILE1,FILE2 GOTO 100 C 690 PRINT 3490,FILE1,PACK1 GOTO 100 C 700 PRINT 3500,FILE1,PACK1 GOTO 100 C 710 PRINT 3510,FILE1,PACK1 GOTO 100 C 720 PRINT 3520 GOTO 100 C 730 PRINT 3530 GOTO 100 C 740 PRINT 3540,FILE1,PACK1 GOTO 100 C 750 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3550,FILE2,PACK2,FILE1,PACK1 GOTO 100 C 760 PRINT 3560,FILE1,PACK1 GOTO 100 C 770 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3570,FILE2,PACK2,FILE1,PACK1 GOTO 100 C 780 PRINT 3580,FILE1,PACK1 GOTO 100 C 790 FILE2=LINE(8) PACK2=LINE(9) CALL IBFILL(FILE2,PACK2) PRINT 3590,FILE2,PACK2,FILE1,PACK1 GOTO 100 C 800 PRINT 3600 GOTO 100 C 810 PRINT 3610 GOTO 100 C 820 PRINT 3620 GOTO 100 C 830 PRINT 3630,FILE1,PACK1 GOTO 100 C 840 PRINT 3640 GOTO 100 C 850 PRINT 3650 GOTO 100 * /--- BLOCK ACCLOGPRT 00 000 80/02/14 12.40 900 PRINT 9000,TYPE GOTO 100 C 90 DO 95 I=1,11 BUFF(I)=10L********** 95 CONTINUE PRINT 1010,(BUFF(I),I=1,11) PRINT 1000 RETURN C C 1000 FORMAT (1H1) 1010 FORMAT (6X,11A10,//) 1020 FORMAT (6X,*ACCOUNT FILE MANAGEMENT LOG *,A10,4X, * *PRINTED ON *,A9,2X,*AT *,A6,//) 1030 FORMAT (6X,*ACCOUNT *,A7,//) 2000 FORMAT (6X,A8,2X,A4,4X,*ACCOUNT *,A7,6X,*BY *, * A10,* / *,A8,* / *,A3) 2010 FORMAT (6X,A8,2X,A4,4X,*ACCOUNT *,A7,6X,*BY *, * A10,* / *,A8,* AT*,I3,*-*,I2) 3010 FORMAT (24X,*CREATE FILE *,A10,2X,A10,/) 3020 FORMAT (24X,*DESTROY FILE *,A10,2X,A10,/) 3030 FORMAT (24X,*RE-NAME FILE *,A10,2X,A10, * 5X,*NEW NAME *,A10,/) 3040 FORMAT (24X,*COPY FILE *,A10,2X,A10, * 5X,*TO FILE *,A10,2X,A10,/) 3050 FORMAT (24X,*LENGTHEN FILE *,A10,2X,A10, * 5X,*NEW PACK *,A10,/) 3060 FORMAT (24X,*SHORTEN FILE *,A10,2X,A10, * 5X,*NEW PACK *,A10,/) 3070 FORMAT (24X,*ARCHIVE FILE *,A10,2X,A10,/) 3080 FORMAT (24X,*RETRIEVE ARCHIVE *,A10,2X,*NEW NAME *, * A10,5X,A10,/) 3090 FORMAT (24X,*CHANGE CODEWORD *,A10,/) 3100 FORMAT (24X,*ADD TO ACCOUNT *,A10,/) 3110 FORMAT (24X,*REMOVE FROM ACCT *,A10,/) 3120 FORMAT (24X,*COPY CONTENTS *,A10,2X,A10, * 5X,*TO FILE *,A10,2X,A10,/) 3130 FORMAT (24X,*RENAME ACCT TO *,A10,/) 3140 FORMAT (24X,*RENAME ACCT FROM *,A10,/) 3150 FORMAT (24X,*CREATE ACCOUNT*,/) 3160 FORMAT (24X,*DESTROY ACCOUNT*,/) 3170 FORMAT (24X,*CHANGE ACCOUNT DIRECTOR*,/) 3180 FORMAT (24X,*CHANGE SPACES ALLOTTED*,/) 3190 FORMAT (24X,*CHANGE SUBSCRIPTIONS*,/) 3200 FORMAT (24X,*CHANGE AUTHOR SIGNON CREATION*,/) 3210 FORMAT (24X,*CHANGE PUBLICATION FLAG*,/) 3220 FORMAT (24X,*CHANGE LESSON ACCESS*,/) 3230 FORMAT (24X,*CHANGE ACCOUNT CODEWORD*,/) 3240 FORMAT (24X,*CLEAR LESSON USAGE DATA*,/) 3250 FORMAT (24X,*CHANGE ARCHIVE RIGHTS*,/) 3260 FORMAT (24X,*CHANGE PRINT ACCESS*,/) 3270 FORMAT (24X,*CHANGE DEFAULT LESSON NOTES FILE FROM *, X A10,* TO *,A10,/) 3280 FORMAT (24X,*CHANGE DEFAULT FILE SECURITY CODE*,/) 3290 FORMAT (24X,*CHANGE SYSTEM ACCESS*,/) 3300 FORMAT (24X,*CHANGE LIST OF MAJOR USERS*,/) * /--- BLOCK ACCLOGPRT 00 000 81/11/02 14.43 3310 FORMAT (24X,*REPLACE FILE *,A10,2X,A10, * 5X,*FROM FILE *,A10,2X,A10,/) 3320 FORMAT (24X,*PACK TRANSFER *,A10,2X,A10, * 5X,*NEW PACK *,A10,/) 3330 FORMAT (24X,*CHANGE LESSON NOTES FILE*, * 20X,*OF FILE *,A10,/) 3340 FORMAT (24X,*COPY FILE *,A10,2X,A10, * 5X,*TO FILE *,A10, * 5X,*IN ACCOUNT *,A10,/) 3350 FORMAT (24X,*REORGANIZE FILE *,A10,2X,A10, * 5X,*NEW PACK *,A10,/) 3360 FORMAT (24X,*CHANGE LESSON ACCESS CLASS*, * 18X,*OF FILE *,A10,/) 3370 FORMAT (24X,*CHANGE GROUP TYPE *, * 18X,*OF FILE *,A10,/) 3380 FORMAT (24X,*EDIT WITH SYSTEM PRIVILEGES*,/) 3390 FORMAT (24X,*INSPECT WITH SYSTEM PRIVILEGES*,/) 3400 FORMAT (24X,*CHANGE ACCESS LIST *, * 18X,*OF FILE *,A10,/) 3410 FORMAT (24X,*CHANGE FILE OWNER *, * 18X,*OF FILE *,A10,/) 3420 FORMAT (24X,*CHANGE FILE PRIVACY *, * 18X,*FOR FILE *,A10,/) 3430 FORMAT (24X,*EDIT ACCOUNT ACCESS*,/) 3440 FORMAT (24X,*CHANGE ACCOUNT ACCESS LIST*,/) 3450 FORMAT (24X,*DESTROY ACCOUNT ACCESS LIST*,/) 3460 FORMAT (24X,*RETRIEVE BACKUP *,A10,2X,A10, * 5X,*TO FILE *,A10,2X,A10,/) 3470 FORMAT (24X,*CHANGE INTER-SYSTEM LINK ACCESS*,/) 3480 FORMAT (24X,*CHANGE INTER-SYSTEM LINK LOGFILE FROM *, X A10,* TO *,A10,/) 3490 FORMAT (24X,*TRANSFER FILE *,A10,2X,A10,/) 3500 FORMAT (24X,*ARCHIVE TO OFFLIN*,A10,2X,A10,/) 3510 FORMAT (24X,*ARCHIVE RETRIEVED*,A10,2X,A10,/) 3520 FORMAT (24X,*CHANGE CURRENT USER COUNT*,/) 3530 FORMAT (24X,*CHANGE TEST ACCOUNT FLAG*,/) 3540 FORMAT (24X,*COPY FILE OFFLINE*,A10,2X,A10,/) 3550 FORMAT (24X,*REPLACE FILE OFFL*,A10,2X,A10, * 5X,*FROM FILE *,A10,2X,A10,/) 3560 FORMAT (24X,*COPY FILE FRM OFL*,A10,2X,A10,/) 3570 FORMAT (24X,*REPL FILE FRM OFL*,A10,2X,A10, * 5X,*FROM FILE *,A10,2X,A10,/) 3580 FORMAT (24X,*COPY OFFLN->OFFLN*,A10,2X,A10,/) 3590 FORMAT (24X,*REPL OFFLN->OFFLN*,A10,2X,A10, * 5X,*FROM FILE *,A10,2X,A10,/) 3600 FORMAT (24X,*CHANGE CURRENT NTU LIMIT*,/) 3610 FORMAT (24X,*CHANGE DEFAULT NTU LIMIT*,/) 3620 FORMAT (24X,*CHANGE CURRENT NTU COUNT*,/) 3630 FORMAT (24X,*DELETE ARCHIVE FILE*,A10,2X,A10,/) 3640 FORMAT (24X,*CHANGE NUMBER OF UNCHARGED DISK PARTS*,/) 3650 FORMAT (24X,*CHANGE CYBERNET TRANSMIT FLAG*,/) 9000 FORMAT (24X,*INVALID LOG RECORD, TYPE*,I3,/) C C END * /--- BLOCK DEFINES 00 000 77/04/26 21.28 IDENT LOGSUB TITLE SUBROUTINES FOR LOG PRINTER TITLE DEFFINITIONS * ************************************************ * * BLKLTH EQU 320 * * DISKBUF EQU 0 ECSLTH EQU DISKBUF+BLKLTH * * USE /ARGS/ FILE BSS 1 DATA FILE NAME ACCOUNT BSS 1 ACCOUNT NAME STDATE BSS 1 STARTING DATE ENDATE BSS 1 ENDING DATE SHLNFL BSS 1 SHORTEN/LENGTHEN FLAG * * USE /DISK/ DISKADD BSS 1 DISK ADDRESS OF FILE DISKF1 BSS 1 DISKF2 VFD 48/BLKLTH,12/1 BUFF BSS BLKLTH * * USE /GETLINE/ BLOCK BSS 1 CURRENT BLOCK NUMBER NBLOCKS BSS 1 NUMBER OF BLOCKS IN FILE TBLKS BSS 1 TOTAL NUMBER OF BLOCKS IN FILE NXT BSS 1 POINTER TO NEXT WORD END BSS 1 LINE BSS 64 * * USE /DATIME/ TIME BSS 1 DATE BSS 1 * * USE * * * ************************************************ * /--- BLOCK MACROS 00 000 76/11/05 11.52 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 76/11/05 21.39 TITLE -SETUP- LOAD TIME INITIALIZATIONS * ************************************************ * * * * -SETUP- * LOAD TIME INITIALIZATIONS - SET CM AND ECS FL * * SST SYSCOM * ENTRY SETUP SETUP EQ * CALL GETARG NAME OF FILE TO PRINT SA6 FILE CALL GETARG NAME OF ACCOUNT TO PRINT SA6 ACCOUNT CALL GETARG DATE TO START PRINTING SA6 STDATE CALL GETARG DATE TO END PRINTING SA6 ENDATE CALL GETARG SHORTEN/LENGHTEN PRINT FLAG SA6 SHLNFL 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 EQ SETUP * * * ************************************************ TITLE SYSTEXT * ************************************************ * * * ECSPRTY EQ * MESSAGE ECSMES,,RECALL CALL RELECS RELEASE ALL THE ECS ABORT EQ * * * * *CALL COMCSYS * * * MASTOR REQUEST ROUTINES * EXT REQECS,RELECS,OPF,CPF,READPF,GETARG * * ************************************************ * /--- BLOCK GETLINE 00 000 75/10/11 19.46 TITLE -GETLINE- GET NEXT DATA RECORD * ************************************************ * * * * -GETLINE- * READS NEXT DATA RECORD TO *LINE* * * ENTRY GETLINE GETLINE EQ * SA1 NXT SB1 X1 B1 = POINTER TO NEXT WORD RJ ISTWORD BX6 X1 STORE HEADER WORD SA6 LINE MX0 -6 MASK FOR RECORD LENGTH AX1 6 BX1 -X0*X1 MASK OFF RECORD LENGTH ZR X1,ENDFIL SB2 1 INDEX IN *LINE* SB3 X1 END TEST * GETLP GE B2,B3,ENDLIN RJ NXTWORD GET NEXT WORD OF DATA BX6 X1 SA6 B2+LINE MOVE TO *LINE* BUFFER SB2 B2+1 SB4 B2-64 NG B4,GETLP EQ ENDFIL * ENDLIN SX6 B1 SA6 NXT UPDATE WORD POINTER EQ GETLINE * * * * -NXTWORD- * GET NEXT WORD OF DATA RECORD * * NXTWORD EQ * SX1 B1-BLKLTH SEE IF AT END OF BUFFER PL X1,NXTW1 SA1 B1+BUFF LOAD NEXT WORD SB1 B1+1 ADVANCE POINTER EQ NXTWORD * NXTW1 RJ NXTBLOK GET NEXT BLOCK EQ NXTWORD * * * /--- BLOCK GETLINE 00 000 77/04/26 21.30 * * -ISTWORD- * GET FIRST WORD OF DATA RECORD * ISTWORD EQ * RJ NXTWORD GET NEXT WORD NZ X1,ISTWORD RJ NXTBLOK GET NEXT BLOCK EQ ISTWORD * * NXTBLOK EQ * SX6 B2 SAVE REGISTERS SA6 SAV1 SX6 B3 SA6 SAV2 SA1 BLOCK BLOCK CURRENTLY ON SX7 X1+1 SA7 A1 UPDATE BLOCK COUNT SA2 NBLOCKS NUMBER OF BLOCKS IN FILE IX2 X1-X2 PL X2,ENDFIL JUMP IF END-OF-FILE SA2 TBLKS TOTAL NUM OF BLOCKS IN FILE IX2 X7-X2 PL X2,ENDFIL IF END-OF-FILE SX1 BLOCK BLOCK TO READ CALL DISKIN SB1 1 RESET WORD POINTER SA1 SAV1 SB2 X1 RESTORE B2 SA1 SAV2 SB3 X1 RESTORE B3 SA1 BUFF LOAD NEXT WORD EQ NXTBLOK * ENDFIL MX6 -1 SET END-OF-FILE FLAG SA6 END MX6 0 SA6 LINE CLEAR HEADER WORD EQ GETLINE * * * ************************************************ * /--- BLOCK GETLINE 00 000 76/11/05 12.09 TITLE -ISTLIN- INITIALIZATIONS * ************************************************ * * * * -ISTLIN- * INITIALIZATIONS BEFORE FIRST -GETLINE- CALL * * ENTRY ISTLIN ISTLIN EQ * SX6 1 INITIALIZE BLOCK COUNTER SA6 BLOCK SA1 NBLOCKS NG X1,ISTEND ZR X1,ISTEND MX6 0 SA6 END INITIALIZE END-OF-FILE FLAG SA6 NXT INITIALIZE WORD POINTER SX1 =1 READ BLOCK 1 CALL DISKIN EQ ISTLIN * ISTEND MX6 -1 MARK END-OF-FILE SA6 END EQ ISTLIN * * * ************************************************ * /--- BLOCK DATER 00 000 76/11/05 12.21 TITLE -DATER- UNPACK HOLLERITH DATE * ************************************************ * * * * -DATER- * UNPACKS AND RE-FORMATS DATE FOR PRINTING * (FTN CALLABLE) * * ENTRY DATER DATER EQ * MX0 -12 SX2 1R/ SA4 X1 LOAD COMPRESSED DATE LX4 12 BX6 -X0*X4 MASK OFF FIRST TWO CHARACTERS LX6 6 BX6 X2+X6 ATTACH A SLASH LX6 12 LX4 12 BX3 -X0*X4 BX6 X3+X6 ATTACH NEXT TWO CHARACTERS LX6 6 BX6 X2+X6 ATTACH A SLASH LX6 12 LX4 12 BX3 -X0*X4 BX6 X3+X6 ATTACH LAST TWO CHARACTERS LX6 12 SA1 A1+1 GET ADDR OF 2ND ARG SA6 X1 SAVE EQ DATER * * * ************************************************ * /--- BLOCK DATEFIX 00 000 76/11/05 12.24 TITLE -DATEFIX- PUT YEAR FIRST, MONTH NEXT * ************************************************ * * * * -DATEFIX- * PUTS YEAR IN MOST SIGNIFICANT PLACE, MONTH NEXT. * ENTERS IN FORMAT'; MM DD YY (LEFT JUSTIFIED) * RETURNS IN FORMAT'; YY MM DD (RIGHT JUSTIFIED) * * ENTRY DATEFIX DATEFIX EQ * MX0 -12 SA4 X1 GET DATE LX4 12 GET MONTH BX6 -X0*X4 LX6 12 * LX4 12 GET DAY NEXT BX2 -X0*X4 BX6 X6+X2 * LX4 12 NOW FOR YEAR BX2 -X0*X4 LX2 24 BX6 X6+X2 * SA1 A1+1 ADDR OF 2ND ARG SA6 X1 EQ DATEFIX * * * ************************************************ * /--- BLOCK DISKIN 00 000 76/11/05 12.12 TITLE ATTACH FILE * * * -ATTACH- * ATTACH SPECIFIED FILE * * ON ENTRY - X1 = ADDRESS OF FILE NAME * * ENTRY ATTACH ATTACH EQ * SA2 X1 GET FILE NAME BX6 X2 SA6 PFILE CALL OPF,PFILE NZ X1,ATTERR ERROR CHECK EQ ATTACH * PFILE DATA 0 PLATO FILE NAME DATA 0 EOL * ATTERR MESSAGE ATTMES,,RECALL MESSAGE PFILE,,RECALL CALL RELECS RELEASE ALL ECS 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 SHIFTS 00 000 76/11/05 12.50 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 BLANKFILL 00 000 76/11/05 12.51 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 * * -IBFILLB- * * BLANK FILL A BUFFER (CALLABLE FROM FTN) * * CALL IBFILLB(BUFFER,NWORDS) * BLANK FILLS *BUFFER* THROUGH *BUFFER+NWORDS-1* * ENTRY IBFILLB IBFILLB EQ * SB1 1 SA5 X1 GET FIRST WORD OF BUFFER SA1 A1+1 GET ADDRESS OF NUMBER WORDS SA1 X1 GET NUMBER WORDS FILLBLP RJ BLFILL BLANK FILL WORD SA6 A5 RE-STORE SX1 X1-1 DECREMENT WORD COUNTER ZR X1,IBFILLB ALL FILLED, ---RETURN SA5 A5+1 GET NEXT WORD EQ FILLBLP * * 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 END 00 000 75/10/11 19.55 TITLE STORAGE * ************************************************ * * * ATTMES DIS ,*ATTACH ERROR* DISKMES DIS ,*DISK ERROR* ECSMES DIS ,*ECS ERROR* * 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