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