%BEGIN %CONTROL 0 ! COMPILE TIME 19 ETU ! ! ! ROUTINE SPECIFICATIONS ! %ROUTINESPEC INITIALISE PROFILES %ROUTINESPEC INITIALISE VARIABLES 00000550 %ROUTINESPEC NEXTREC (%INTEGERNAME NO, %INTEGERARRAYNAME ANUM) %ROUTINESPEC BULLETIN OUTPUT (%INTEGER NO, %INTEGERARRAYNAME ANUM) %ROUTINESPEC SDICUMUL OUTPUT(%INTEGER NUM) %ROUTINESPEC CHECK FAILURE (%INTEGER CHECKNO, %INTEGERNAME A1,A2) %ROUTINESPEC SET (%BYTEINTEGERARRAYNAME A, %INTEGER START,END,VAL) %INTEGERFNSPEC CONV(%BYTEINTEGERARRAYNAME A,%INTEGER IA,L) ! ! ARRAY DECLARATIONS ! %BYTEINTEGERARRAY IRPROF,PROF2,PROF3 (1:20) ;! INT REC PROFILE 00001500 !?? SHORT; %INTEGERARRAY IRMARK (1:20) ;! INT REC PROF MARKER 00001600 !?? SHORT; %INTEGERARRAY ZITA (1:12,-1:10) ;! I/P REC PROF 00001700 !?? SHORT; %INTEGERARRAY IRDIRC (1:42) ;! DIRECTORY 00001800 %BYTEINTEGERARRAY IRTEXT (1:500) ;! TEXT OF RECORD 00001900 !?? SHORT; %INTEGERARRAY CONC1(1:100) ;! CONCORDANCE - START OF TERM 00002100 !?? SHORT; %INTEGERARRAY CONC2(1:100) ;! CONCORDANCE - LENGTH OF TERM 00002200 !?? SHORT; %INTEGERARRAY CONC3(1:100) ;! CONCORDANCE - PTR TO NEXT 00002300 %INTEGERARRAY ANUM(1:26) ! ! VARIABLE DECLARATIONS ! %INTEGER BLUNIT ;! BULLETIN OUTPUT UNIT %INTEGER CHECK ;! CHECK DETAILS INDICATOR %INTEGER CMUNIT ;! CUMULATION UNIT %INTEGER CODE ;! RESTRICTION CODE 00002650 %INTEGER DIAGNS ;! DIAGNOSTIC O/P INDICATOR %INTEGER END ;! END OF FILE INDICATOR %INTEGER FALCNT ;! FAILURE COUNT %INTEGER FALLIM ;! FAILURE LIMIT %INTEGER I ;! LOOP VARIABLE %INTEGER ID ;! POINTER TO IRDIRC 00003150 %INTEGER IRPLIM ;! INT REC PROFILE SIZE %INTEGER IT ;! POINTER TO IRTEXT 00003220 %INTEGER L ;! LOOP VARIABLE - LIMIT 00003250 %INTEGER MAXZIT ;! MAX NO OF FIELDS IN I/P REC 00003050 %INTEGER MJUNIT ;! MASTER JOURNAL FILE UNIT NO 00004150 %INTEGER MXBUFB ;! MAX DIM: BULLETIN O/P BUFFER %INTEGER MXBUFS ;! MAX DIM: SDI O/P BUFFER %INTEGER MXCNTB ;! MAX DIM: CONTROL BLOCK %INTEGER MXDIRC ;! MAX DIM: INT REC DIRECTORY %INTEGER MXNUMB ;! MAX DIM: JOURN NO ARRAY %INTEGER MXPROF ;! MAX DIM: INT REC PROFILES %INTEGER MXRECS ;! MAX DIM: ITEM CONCORDANCE %INTEGER NEWCUM ;! NEW CUMULATION INDICATOR %INTEGER NUM ;! NO OF JOURN NOS FOR THIS REC %INTEGER PA ;! POINTER TO AUTHOR PROF REFS %INTEGER PB ;! " BIB. DETAILS " %INTEGER PC ;! " RESTRIC. CODE " %INTEGER PD ;! " TRANSLATION NOTE " %INTEGER PF ;! " AFFILIATION " 00004650 %INTEGER PJ ;! " ADDITIONAL REF NOS " %INTEGER PK ;! " KEYWORDS " %INTEGER PL ;! " LANGUAGE " %INTEGER PN ;! " ADDITIONAL NOTE " %INTEGER PQ ;! " REFERENCES " 00005050 %INTEGER PR ;! " CUL REF NO " %INTEGER PS ;! " SOURCE REF NO " 00005150 %INTEGER PT ;! " TITLE " %INTEGER PX ;! " ABSTRACT " 00005230 %INTEGER PZ ;! " CODEN REF " 00005260 %INTEGER RUN ;! RUN NUMBER %INTEGER SDUNIT ;! SDI OUTPUT UNIT %INTEGER STUNIT ;! STATISTICS UNIT %INTEGER VALCNT ;! VALID RECORD COUNT %INTEGER WEEKNO ;! WEEK NUMBER (4 DIGITS) %INTEGER YES ;! CONSTANT (=1) ! %BYTEINTEGER ET ;! END OF PAPER TAPE CODE 00007250 %BYTEINTEGER LSC ;!CLOSE LANGUAGE SEPERATOR %BYTEINTEGER LSO ;! OPEN LANGUAGE SEPERATOR %BYTEINTEGER SMA ;! LOWER CASE A %BYTEINTEGER SMZ ;! LOWER CASE Z %BYTEINTEGER RS ;! REC SEPERATOR CHARACTER %BYTEINTEGER US ;! UNIT SEPERATOR CHARACTER ! ! CALL ROUTINE TO INITIALISE THE I/P AND INTERNAL RECORD PROFILES ! INITIALISE PROFILES ! ! CALL ROUTINE TO SET CONSTANTS AND VARIABLES ! INITIALISE VARIABLES ! ! THE INPUT IS PROCESSED A RECORD AT A TIME ! ! FETCH THE NEXT RECORD ! LAB1:NEXTREC (NUM,ANUM) ! ! CHECK FOR THE END OF THE INPUT ! %IF END=YES %THEN -> LAB3 ;! JUMP IF END FOUND ! ! IF DIAGNOSTIC PRINTING HAS BEEN REQUESTED THE CURRENT RECORD ! IS NOW OUTPUT IN INTERNAL FORMAT. ! %IF DIAGNS=YES %THENC %START NEWLINES(2) PRINTSTRING('DIRECTORY RECORD CREATED') NEWLINE WRITE(IRDIRC(1),3) PRINTSTRING(".") WRITE(IRDIRC(2),3) PRINTSTRING(".") %CYCLE I=4,2,2*IRPLIM+2 00010900 WRITE(IRDIRC(I-1),3) WRITE(IRDIRC(I),3) PRINTSTRING(' //') %REPEAT NEWLINES(2) PRINTSTRING('TEXT RECORD CREATED') NEWLINE IT=1 ID=1 INCID: ID=ID+2 %IF ID>2*IRPLIM+1 %THEN -> LAB2 COMP: %IF IT>IRDIRC(ID) %THEN -> INCID %IF IT=IRDIRC(ID) %THEN L=IRDIRC(ID+1) %ELSEC %START L=IRTEXT(IT) WRITE(L,3) IT=IT+1 %IF L=0 %THEN -> COMP %FINISH %CYCLE I=1,1,L PRINT SYMBOL(IRTEXT(IT)) IT=IT+1 %REPEAT -> COMP %FINISH ! ! OUTPUT RECORD TO BULLETIN AND/OR SDI FILE AS INDICATED ! LAB2:IT=IRDIRC(2*IRPLIM+1) CODE=IRTEXT(IT) ;! EXTRACT RESTRICTION CODE %IF CODE='A' %OR CODE='B' %OR CODE='C' %THENC BULLETIN OUTPUT (NUM,ANUM) ;! O/P TO BULLETIN IF REQUIRED %IF CODE \='A' %THEN SDICUMUL OUTPUT(ANUM(1)) 00014200 ! -> LAB1 ;! JUMP TO PROCESS NEXT RECORD ! ! END OF INPUT FOUND - OUTPUT ROUTINES ARE CALLED TO TIDY AND ! CLOSE THE FILES AND THE JOB IS TERMINATED. ! LAB3:BULLETIN OUTPUT(0,ANUM) SDICUMUL OUTPUT(0) ! NEWLINES(3) ;! TERMINATION MESSAGE PRINTSTRING(' *** EOJ *** ') %STOP ! ! ********************************************************************* ! %ROUTINE INITIALISE PROFILES 00015700 ! ! THIS ROUTINE IS CALLED TO INITIALISE THE INPUT AND INTERNAL ! RECORD PROFILES USED BY THE PROGRAM. IN THE CASE OF AN ! AMENDMENT ONLY THIS ROUTINE NEED BE ALTERED. ! !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITK(1:9)= 13, 1, -2, -2, -2, -2, -2, -2, -2 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITR(1:9)= 7, 2, 0, 2, 2, 2, 2, 2, 2 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITT(1:9)= 4, 3, 1, 1, 1, 1, 1, 1, 1 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITL(1:9)= 9, 3, -1, -1, -1, -1, -1, -1, -1 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITW(1:9)= 5, 1, -2, -2, -2, -2, 2, 2, 1 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITB(1:9)= 7, 1, 0, 1, 1, 1, -1, 1, -1 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITD(1:9)= 7, 1, 0, 1, 1, 1, 1, 1, 1 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITP(1:9)= 7, 1, 1, 1, 1, 1, 1, 1, 1 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITN(1:9)= 8, 4, -1, -1, -1, -1, -1, -1, -1 !?? WAS OWNSHORT; %CONSTINTEGERARRAY ZITC(1:9)= 15, 5, 1, 1, 1, 1, 1, 1, 1 %INTEGER I ! ! ! INITIALISATION OF FORMAT PROFILES FOR INPUT RECORDS. THE ARRAY ! ZITA SO FORMED APPEARS AS BELOW, FORMING A CROSS REFERENCE TABLE ! DEFINING THE ACTION TO BE TAKEN FOR EACH ITEM IN EACH INPUT TYPE. ! ! THE PROFILES ARE SET UP IN PRIVATE VECTORS AND THEN TRANSFERRED ! TO ZITA FOR EASE OF AMENDMENT AND GOOD READABILITY. ! !-------------------------------------------------------- ! ! ! ! ! ! ! ! ! ! ! ! !LINK!ACTION!JRNL!REPT!PMLT!BKS!A/RP!THES!T/CAT! ! ! ! ! ! ! ! ! ! ! ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! K/WDS ! 13 ! 1 ! -2 ! -2 ! -2 ! -2! -2 ! -2 ! -2 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! REFS ! 7 ! 2 ! 0 ! 2 ! 2 ! 2! 2 ! 2 ! 2 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! TITLE ! 4 ! 3 ! 1 ! 1 ! 1 ! 1! 1 ! 1 ! 1 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! LANG ! 9 ! 3 ! -1 ! -1 ! -1 ! -1! -1 ! -1 ! -1 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! AUTHOR ! 5 ! 1 ! -2 ! -2 ! -2 ! -2! 2 ! 2 ! 1 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! BIB DET! 7 ! 1 ! 0 ! 1 ! 1 ! 1! -1 ! 1 ! -1 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! DATE ! 7 ! 1 ! 0 ! 1 ! 1 ! 1! 1 ! 1 ! 1 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! PAGE ! 7 ! 1 ! 1 ! 1 ! 1 ! 1! 1 ! 1 ! 1 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! NOTE ! 8 ! 4 ! -1 ! -1 ! -1 ! -1! -1 ! -1 ! -1 ! !--------!----!------!----!----!----!---!----!----!-----! ! ! ! ! ! ! ! ! ! ! ! ! CODE ! 15 ! 5 ! 1 ! 1 ! 1 ! 1! 1 ! 1 ! 1 ! ! ! ! ! ! ! ! ! ! ! ! !-------------------------------------------------------- ! %CYCLE I=1,1,9 00022300 ZITA(1,I-2) = ZITK(I) ZITA(2,I-2) = ZITR(I) ZITA(3,I-2) = ZITT(I) ZITA(4,I-2) = ZITL(I) ZITA(5,I-2) = ZITW(I) ZITA(6,I-2) = ZITB(I) ZITA(7,I-2) = ZITD(I) ZITA(8,I-2) = ZITP(I) ZITA(9,I-2) = ZITN(I) ZITA(10,I-2)= ZITC(I) %REPEAT MAXZIT=10 ;! SET MAX VALUE OF ROW PTR ! ! THE INTERNAL RECORD PROFILE AND ASSOCIATED CODES, POINTERS AND ! MARKERS ARE INITIALISED HERE FOR EASE OF AMENDMENT SHOULD THIS ! BE NECESSARY AND FOR EASE OF REFERENCE AT ALL TIMES. ! I=0 I=I+1; PZ=I; IRPROF(I) = 10; IRMARK(I) =-2;! CLASSIFICATION I=I+1; PR=I; IRPROF(I) = 21; IRMARK(I) = 0;! CULHAM REF NO I=I+1; PS=I; IRPROF(I) = 22; IRMARK(I) =-1;! SOURCE REF NUMBER I=I+1; PT=I; IRPROF(I) = 30; IRMARK(I) = 1;! TITLE I=I+1; PA=I; IRPROF(I) = 41; IRMARK(I) =-2;! AUTHOR(S) I=I+1; PF=I; IRPROF(I) = 42; IRMARK(I) =-2;! AFFILIATION I=I+1; PB=I; IRPROF(I) = 51; IRMARK(I) = 2;! BIBLIOGRAPHIC DETS I=I+1; PN=I; IRPROF(I) = 52; IRMARK(I) =-2;! FURTHER NOTE I=I+1; PL=I; IRPROF(I) = 61; IRMARK(I) =-1;! LANGUAGE I=I+1; PD=I; IRPROF(I) = 62; IRMARK(I) =-1;! TRANSLATION NOTE I=I+1; PX=I; IRPROF(I) = 70; IRMARK(I) =-1;! ABSTRACT I=I+1; PJ=I; IRPROF(I) = 81; IRMARK(I) =-2;! KEY - NUMERIC I=I+1; PK=I; IRPROF(I) = 82; IRMARK(I) =-2;! KEY - ALPHABETIC I=I+1; PQ=I; IRPROF(I) = 90; IRMARK(I) =-2;! REFERENCES I=I+1; PC=I; IRPROF(I) =100; IRMARK(I) = 1;! RESTRICTION CODE IRPLIM=I ;! SET PROFILE LIMIT ! %END ;! INITIALISE PROFILES ! ! ********************************************************************* ! %ROUTINE INITIALISE VARIABLES ! 00026010 ! THIS ROUTINE INITIALISES ALL THE NON-ARRAY GLOBAL VARIABLES AND 00026020 ! CONSTANTS REQUIRED BY THE PROGRAM. USER SET VARIABLES ARE READ 00026030 ! IN BY THIS ROUTINE AND OVERWRITE THE DEFAULT OPTIONS. 00026040 ! 00026050 %BYTEINTEGERARRAY CARD(1:80) ;! DATA CARD INPUT AREA 00026650 %INTEGER CDTYPE ;! DATA CARD TYPE %INTEGER CNT ;! I/P CARD COUNT %INTEGER I ;! LOOP VARIABLE %INTEGER IND ;! SWITCH VARIABLE %INTEGER J ;! SWITCH VARIABLE 00027000 %INTEGER LIM ;! NO OF CHARS ON DATA CARD 00027030 %INTEGER NO ;! CURRENT NUMERIC ITEM 00027060 %SWITCH TEST(1:3) ;! DATA CARD ANALYSIS SECTION 00027100 %SWITCH EXIT(1:3) ;! DATA CARD COMPLETION SWITCH 00027150 ! ! SET DIMENSIONS ! MXBUFB = 1000 ;! BULLETIN O/P BUFFER SIZE 00028000 MXBUFS = 1000 ;! SDI O/P BUFFER SIZE 00028100 MXCNTB = 500 ;! CONTROL BLOCK O/P BUFFER SIZE 00028200 MXDIRC = 32 ;! CURRENT SIZE OF DIRECTORY MXPROF = 20 ;! MAX SIZE OF PROFILE ARRAYS 00028350 MXNUMB=200 ;! MAX NO OF JOURNALS PER WEEK 00028800 MXRECS=500 ;! MAX NO OF ITEMS /WEEK ! ! SET I/O UNIT NUMBERS ! BLUNIT = 10 ;! BULLETIN O/P FILE CMUNIT = 40 ;! CUMULATIVE FILE MJUNIT=50 ;! MASTER JOURNAL TITLE FILE 00029350 SDUNIT = 20 ;! SDI O/P FILE STUNIT = 30 ;! STATISTICS FILE ! ! SET CONSTANTS ! YES=1 US=X'1F' ;! UNIT SEPERATOR CHARACTER 00029800 RS=X'5C' ;! RECORD SEPERATOR CHARACTER 00029900 ET=X'2D' ;! RS IN P/TAPE I/P CODE 00030200 LSO=X'7C' ;! START OF LANGUAGE SEPERATOR 00030000 LSC=X'7E' ;! END OF LANGUAGE SEPERATOR 00030100 SMA=X'61' ;! LOWER CASE A SMZ=X'7A' ;! LOWER CASE Z ! ! SET INDICATORS AND COUNTERS ! FALCNT=0 ;! ZEROISE FAILURE COUNT END = 0 ;! SET END OF I/P INDICATOR OFF ! ! SET DEFAULT OPTIONS ! WEEKNO=0 ;! WEEK NUMBER DEFAULT ZERO RUN=0 ;! RUN NUMBER DEFAULT - NOT 1ST CHECK=0 FALLIM=10 ;! FAILURE LIMIT - DEFAULT TEN DIAGNS=0 ;! DIAGNOSTICS - DEFAULT OFF NEWCUM=0 ;! NEW CUMULATION IND - OFF ! ! READ DATA CONTROL CARDS AND OVERWRITE DEFAULT VALUES ! CNT=0 ;! ZEROISE RECORD COUNT NEWLINE 00032300 PRINTSTRING('DATA CARDS') NXTCD:NEWLINE %CYCLE I=1,1,80 READ SYMBOL (CARD(I)) ;! READ NEXT DATA CARD %IF CARD(I)=X'0A' %THEN -> SET ;! JUMP WHEN NEWLINE FOUND PRINT SYMBOL (CARD(I)) ;! PRINT FOR REFERENCE %REPEAT ! ! CARD READ IN - SEARCH FOR ITEMS TO BE EXTRACTED ! SET: LIM=I-1 ;! STORE NUMBER OF CHARS CNT=CNT+1 ;! INCREMENT DATA CARD COUNT J=1 ;! INITIALISE SWITCH VALUE ! %CYCLE I=1,1,LIM ;! CYCLE THRO CARD -> TEST(J) ! TEST(1):%IF CARD(I)\=' ' %THENC %START ;! START OF DATA FOUND J=2 ;! UPDATE SWITCH CDTYPE=CARD(I) ;! EXTRACT CARD TYPE %IF CDTYPE='W' %OR CDTYPE='R' %OR CDTYPE='F' %THEN -> REP -> EXIT(3) %FINISH -> REP ;! CONTINUE ! TEST(2):%IF '0' <= CARD(I) <= '9' %THENC %START ;! START OF NUMERIC ITEM FOUND J=3 ;! UPDATE SWITCH POINTER NO=CARD(I)&X'0F' ;! EXTRACT FIRST VALUE %FINISH -> REP ;! CONTINUE ! TEST(3):%IF '0'<=CARD(I)<='9' %THENC NO=NO*10+CARD(I)&X'0F' %ELSEC -> EXIT(3) ;! EXIT AT END OF NUMBER REP: %REPEAT ;! CONTINUE CHECKING RECORD ! ! RECORD NOW COMPLETELY CHECKED - JUMP TO APPROPRIATE EXIT POINT ! -> EXIT(J) ! ! ERROR SECTION - THE CONTROL DATA CARD IS INVALID, A WARNING ! MESSAGE IS PRINTED AND THE JOB CONTINUES. ! EXIT(1):NEWLINE 00036500 PRINTSTRING(' *** WARNING *** NO VALID CHARACTERS FOUND') -> ERR ! EXIT(2):NEWLINES(2) PRINTSTRING(' *** WARNING *** NUMERIC ITEM EXPECTED BUT NOT FOUND') ERR: PRINTSTRING(' ON CONTROL DATA CARD') WRITE (CNT,2) PRINTSTRING(' - IGNORED') NEWLINE 00037450 -> NXTCD ;! JUMP TO CONTINUE ! ! THE NUMERIC ITEM IS TRANSFERRED TO THE APPROPRIATE VARIABLE ! EXIT(3):%IF CDTYPE='E' %THEN -> RETN ;! JUMP OUT IF END OF DATA %IF CDTYPE='W' %THEN %START; WEEKNO=NO; -> NXTCD; %FINISH %IF CDTYPE='R' %THEN %START; RUN =NO; -> NXTCD; %FINISH %IF CDTYPE='F' %THEN %START; FALLIM=NO; -> NXTCD; %FINISH %IF CDTYPE='C' %THEN %START; CHECK=YES; -> NXTCD; %FINISH %IF CDTYPE='N' %THEN %START;NEWCUM=YES; -> NXTCD; %FINISH %IF CDTYPE='D' %THEN %START;DIAGNS=YES; -> NXTCD; %FINISH ! ! INVALID CODE - O/P ERROR MESSAGE AND IGNORE ! NEWLINES(2) PRINTSTRING(' *** WARNING *** INVALID CARD TYPE') -> ERR ! ! END OF CONTROL DATA CARDS FOUND - PRINT DETAILS AND EXIT 00039600 ! RETN:NEWPAGE SPACES(10) ;! MAIN HEADING PRINTSTRING('BULLETIN INPUT CHECK LIST') SPACES(11) PRINTSTRING('WEEK') WRITE(WEEKNO,4) ;! PRINT WEEK AND RUN NUMBER PRINTSTRING(' RUN') WRITE(RUN,1) NEWLINE SPACES(10) ;! UNDERLINE %CYCLE I=1,1,55 PRINTSTRING("*") %REPEAT NEWLINES(2) SPACES(20) ;! CHECK VALUE PRINTSTRING('FILE IDENTIFIER CHECKING') %IF CHECK\=YES %THEN PRINTSTRING(' NOT') PRINTSTRING(' REQUIRED') NEWLINE SPACES(20) ;! NEWCUM VALUE %IF NEWCUM=YES %THEN PRINTSTRING('START NEW') %C 00041800 %ELSE PRINTSTRING('USE EXISTING') PRINTSTRING(' CUMULATION FILE') NEWLINE SPACES(20) ;! DIAGNS VALUE PRINTSTRING('DIAGNOSTIC PRINTING') %IF DIAGNS\=YES %THEN PRINTSTRING(' NOT') PRINTSTRING(' REQUIRED') NEWLINE SPACES(20) ;! FAILURE LIMIT PRINTSTRING('INPUT FAILURE LIMIT SET AT') WRITE(FALLIM,2) %RETURN ;! EXIT FROM ROUTINE 00039800 ! %END ;! INITIALISE VARIABLES ! ! ****************************************************************************** ! %ROUTINE NEXTREC (%INTEGERNAME NO, %INTEGERARRAYNAME ANUM) ! ! ROUTINE SPECIFICATIONS ! %ROUTINESPEC PRINT TITLE(%INTEGER NUM,TP) 00044130 ! 00044160 %ROUTINESPEC CHECKNOTE(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB,TYPE) ! %INTEGERFNSPEC STARTITEM(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME IB) ! %ROUTINESPEC MARKITEM(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB) ! %ROUTINESPEC MARKMULT (%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB,IND) ! %ROUTINESPEC LINK(%INTEGER N,START,LENGTH) ! %ROUTINESPEC MARKTITLE(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB) ! ! %ROUTINESPEC MARKLANG(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB) ! %ROUTINESPEC FTCLRC(%BYTEINTEGERARRAYNAME RECORD, %C %INTEGERNAME RSTRT,RLNG,EOF) ! %ROUTINESPEC COPYTEXT(%BYTEINTEGERARRAYNAME BF1, %INTEGER B1 %C %BYTEINTEGERARRAYNAME BF2, %INTEGER B2, L) ! %ROUTINESPEC INSERTREF(%BYTEINTEGERARRAYNAME TEXT,%INTEGER IT) ! %ROUTINESPEC EDITAUTHR(%BYTEINTEGERARRAYNAME BUF,%INTEGER START %C %BYTEINTEGERARRAYNAME IRTEXT,%INTEGER ITX%C %INTEGERNAME LENG) ! ! ARRAY AND VARIABLE DECLARATIONS ! %OWNBYTEINTEGERARRAY BUFFER(1:1000) ;! INPUT BUFFER %INTEGER BEGIN ;! START OF ITEM IN BUFFER %INTEGER CD ;! CHECK DIGIT 00020750 %INTEGER E ;! END LOOP VALUE %INTEGER I ;! LOOP VARIABLE %INTEGER IB ;! I/P BUFFER POINTER %INTEGER ICONC ;! CURRENT CONCORDANCE POINTER %INTEGER IND ;! MULTIPLE ITEM MARKER %INTEGER IR ;! POINTER TO INT REC PROFILE %INTEGER ITEM ;! SWITCH POINTER FOR NEXT %INTEGER J ;! LOOP VARIABLE %INTEGER LENG ;! LENGTH OF ITEM IN BUFFER %INTEGER NORT ;! NOTE TYPE INDICATOR %INTEGER P ;! GENERAL LINKAGE POINTER %INTEGER PCOUNT ;! O/P LINE POSITION COUNTER %INTEGER REFPT ;! POINTER TO REF NO POSITION %INTEGER RSIZE ;! LENGTH OF I/P RECORD %INTEGER S ;! START LOOP VALUE %INTEGER START ;! NEXT AVAILABLE POS IN BUFFER %INTEGER SUM ;! SUM FOR CALCULATING CH DIGIT 00022650 %INTEGER TIME ;! MULTIPLE ITEM SWITCH %INTEGER Z ;! POINTER TO ZITA ! %OWNINTEGER NUM ;! CURRENT JOURN NO BASE 00020850 %OWNINTEGER PB1 ;! 1ST AND LAST POINTERS TO %OWNINTEGER PB2 ;! STORED BIBLIOGRAPHIC DETS %OWNINTEGER PJ1 ;! 1ST AND LAST POINTERS TO %OWNINTEGER PJ2 ;! SECONDARY REF NOS %OWNINTEGER PXC ;! PTR TO PSEUDO JRN TITLE CONC 00050250 %OWNINTEGER RCONC=1 ;! STORED VALUE OF ICONC 00050300 %OWNINTEGER RSTRT=1 ;! STORED VALUE OF START 00050400 %OWNINTEGER TYPE ;! INPUT RECORD TYPE ! %SWITCH ACT(1:5) ;! ANALYSIS TYPE %SWITCH ERR(1:5) ;! CONTROLS ERROR MESSAGES 00021500 %SWITCH NEXT(1:2) ;! HANDLES PROGRESS THRO REC %SWITCH SA1(1:2) ;! MULTIPLE ITEM SWITCH %SWITCH SA2(1:2) ;! MULTIPLE ITEM SWITCH %SWITCH SSW(1:2) ;! MULTIPLE SECTION SWITCH %SWITCH TJN(1:2) ;! MULTIPLE ITEM SWITCH ! 00024430 ! ********************************************************************* 00024460 ! NEWREC: START=RSTRT ;! INITIALISE STARTING POINT 00048500 ICONC=RCONC ;! INITIALISE CONC POINTER ! 00023210 ! CLEAR PROFILE POINTERS AREA 00023220 ! 00023230 SET (PROF2,1,MXPROF,0) 00023240 SET (PROF3,1,MXPROF,0) 00023250 ! ! FETCH NEXT RECORD FROM INPUT BUFFER ! GETREC: FTCLRC(BUFFER,START,RSIZE,END);! READ NEXT RECORD %IF END=YES %THENC %START PRINT TITLE (0,0) ;! CLOSE FILE WHEN END FOUND %RETURN %FINISH PRIP:%IF DIAGNS=YES %THENC 00049700 %START ;! PRINT INPUT RECORD NEWLINES(3) ;! ............................. PRINTSTRING('INPUT RECORD ') ;! ............................. %CYCLE I=START,1,START+RSIZE-1;! ............................. 00050100 PRINT SYMBOL(BUFFER(I)) ;! ............................. %REPEAT ;! ............................. %FINISH ! ! CHECK FOR START OF A NEW BATCH ! %IF 'A' <= BUFFER(START) <= 'Z' %THEN -> SETSEC ! 00026430 ! ********************************************************************* 00026460 ! ! NEW BATCH STARTED - COPY OVER PREVIOUS DETAILS ! 00026630 ! ********************************************************************* 00026660 ! NEWB:COPYTEXT(BUFFER,START,BUFFER,1,RSIZE) START=1 ;! SET START TO IND BATCH HEAD ! ! CHECK THIS JOURNAL NUMBER FOR VALIDITY ! CHNO:%IF RSIZE<7 %THEN -> F1 ;! FAIL IF INSUFFICIENT CHARS SUM=0 ;! ZEROISE SUM %CYCLE I=1,1,5 ;! CALCULATE CHECK DIGIT SUM=SUM+(BUFFER(I)&X'0F')*(7-I) ;! ON MODULUS 11 BASIS 00027500 %REPEAT ;! SUBSTITUTING 0 FOR 10 CD=10-(SUM-SUM//11*11) ;! WHEN THE LATTER APPEARS 00026700 %IF CD=10 %THEN CD=0 ;! ACCEPT IF CDS AGREE AND %IF BUFFER(6) = CD!X'30' %ANDC 00026900 '0'<=BUFFER(7)<='9' %THEN -> CNVNO;! PART NUMBER IS NUMERIC 00027000 ! ! INVALID JOURNAL NUMBER - JUMP TO FAILURE SECTION ! F1: LENG=1 ;! SET +VE LENGTH AS INDICATOR 00026700 -> FAIL ;! JUMP TO FAIL SECTION ! ! VALID JOURNAL NUMBER - RECORD IS ANALYSED ACCORDING TO I/P TYPE ! CNVNO:NUM=CONV(BUFFER,1,7) ;! CONVERT JOURN NO TO BINARY RSTRT=RSIZE+1 ;! RESET START VALUE 00028000 ICONC=1 ;! RESET CONCORDANCE POINTER PJ1=0 ;! RESET FIRST AND LAST EXTRA PJ2=0 ;! REFERENCES POINTERS LINK(PB,1,6) ;! LINK BASIC JOURNAL NUMBER IB=1 ;! INITIALISE BUFFER POINTER MARKITEM(BUFFER,BEGIN,LENG,IB) ;! UPDATE IB PAST JOURN NUMBER 00057700 PB1=1 ;! STORE VALUE OF 1ST POINTER %IF NUM>9990000 %THENC 00028800 %START ;! SPECIAL INPUT TYPE=CONV(BUFFER,4,2) ;! EXTRACT BATCH TYPE %IF BUFFER(7)='0' %THEN -> SETRC ;! JUMP IF NOT TEMP JOURNAL 00029100 ! ! TEMPORARY JOURNAL TYPE INPUT. TITLE ETC MUST BE EXTRACTED ! %IF TYPE\=1 %THENC %START ;! PSEUDO-JOURNAL P=PB ;! SET FIRST LINKAGE POINTER TJN(1): MARKMULT(BUFFER,BEGIN,LENG,IB,IND) ;! MARK REFS %IF LENG<0 %THEN -> FAIL ;! FAIL IF RS CHAR FOUND %IF LENG=0 %AND IND=0 %THEN -> FAIL LINK(P,BEGIN,LENG) ;! LINK REFERENCE P=PJ ;! ALTER LINKAGE FOR SUBSEQUENT -> TJN(IND) ;! ITEMS AND CONTINUE TJN(2): PJ1=PROF2(PJ) ;! STORE FIRST AND LAST POINTERS PJ2=PROF3(PJ) ;! TO ADDITIONAL REF NUMBERS %FINISH MARKITEM(BUFFER,BEGIN,LENG,IB);! JOURNAL TYPE - MARK TITLE %IF LENG<=0 %THEN -> FAIL ;! FAIL IF NO TITLE FOUND LINK(PX,BEGIN,LENG) ;! ELSE LINK TO INT RECORD 00060100 %FINISH %ELSEC %START ;! EXTRACT TITLE NOTE MARKITEM(BUFFER,BEGIN,LENG,IB);! IF PRESENT %IF LENG<0 %THEN -> FAIL %IF LENG>0 %THEN LINK(PX,BEGIN,LENG) %FINISH ! ! FOR TEMPORARY OR PERMANENT JOURNAL TYPE INPUT, THE ! BIBLIOGRAPHIC DETAILS ARE NOW EXTRACTED FROM THE BATCH HEAD ! TYPE=1 ;! SET JRNL OR PSEUDO-JRNL TYPE MARKITEM(BUFFER,BEGIN,LENG,IB) ;! MARK BIB. DETAILS %IF LENG <= 0 %THEN -> FAIL ;! FAIL IF NO BIB,DETS FOUND LINK(PB,BEGIN,LENG) ;! LINK INTO CONCORDANCE BEGIN=STARTITEM(BUFFER,IB) ;! SET START OF DATE I=BEGIN-1 00058000 INCI:I=I+1 ;! FIND REC SEP CHARACTER %IF BUFFER(I)\=RS %THEN -> INCI DECI:I=I-1 ;! REMOVE TRAILING BLANKS %IF BUFFER(I) = ' ' %THEN -> DECI 00035050 LENG=I+1-BEGIN ;! CALCULATE LENGTH %IF LENG<=0 %THEN -> FAIL ;! FAIL IF NO DATE FOUND LINK (PB,BEGIN,LENG) ;! ELSE LINK DATE DETAILS SETRC:RCONC=ICONC ;! STORE NEXT VALUE OF ICONC START=RSTRT ;! SET NEW START VALUE 00033050 PB2=PROF3(PB) ;! STORE 2ND BIB DETS POINTER PXC=PROF2(PX) ;! STORE CONC PTR TO TEMP JOURN 00062250 ! %IF DIAGNS=YES %THENC %START ;! PRINT NEW TYPE NEWLINE ;! ............................. PRINTSTRING('NEWTYPE =') ;! ............................. WRITE(TYPE,2) ;! ............................. %FINISH PRINT TITLE (NUM,TYPE) 00063250 -> GETREC ;! FETCH NEXT I/P RECORD ! 00036330 ! ********************************************************************* 00036360 ! ! THE SECTION CODES PRECEDE EACH ITEM AND MUST BE EXTRACTED ! AND AMALGAMATED WITH THE BASIC JOURNAL NUMBER BEFORE THE ! ITEMS ARE ANALYSED. ! 00036730 ! ********************************************************************* 00036760 ! SETSEC:PROF2(PB)=PB1 ;! SET PROFILE POINTERS PROF3(PB)=PB2 ;! FROM STORED VALUES FOR PROF2(PJ)=PJ1 ;! BOTH BIBLIOGRAPHIC AND PROF3(PJ)=PJ2 ;! REFERENCE NO DETAILS PROF2(PX)=PXC ;! SET POINTERS TO PSEUDO JOURN 00064330 PROF3(PX)=PXC ;! TITLE (MAY BE ZERO) 00064360 %IF PB2\=0 %THEN CONC3(PB2)=0 ;! ENSURE NO EXTRA LINK REMAINS 00061130 %IF PJ2\=0 %THEN CONC3(PJ2)=0 ;! IN EITHER CONCORDANCE 00061160 NO=0 ;! INITIALISE JOURN NO COUNT IB=START ;! INITIALISE BUFFER POINTER SSW(1):MARKMULT(BUFFER,BEGIN,LENG,IB,IND) ;! MARK SECTION CHAR %IF LENG<0 %OR IND=0 %OR LENG>1 %THEN -> FAIL %IF LENG\=0 %THENC %START ;! CREATE JRN NO FROM VALID REC 00065100 NO=NO+1 ;! INCREMENT COUNT ANUM(NO)=NUM ;! ENTER BASIC NUMBER BYTEINTEGER(ADDR(ANUM(NO)))=BUFFER(BEGIN) ;! ADD SECTION CODE LINK (PZ,BEGIN,LENG) ;! LINK TO INTERNAL RECORD -> SSW(IND) ;! CONTINUE %FINISH ! ! THE REMAINDER OF THIS INPUT RECORD IS NOW PROCESSED ! ACCORDING TO THE PROFILE FOR RECORDS OF THIS TYPE ! SSW(2):Z=0 ;! INITIALISE PROFILE POINTER 00036900 INCZ:Z=Z+1 ;! INCREMENT PROFILE POINTER %IF Z>MAXZIT %THEN -> CREATRC ;! CHECK POINTER WITHIN LIMITS 00039050 %IF ZITA(Z,TYPE)=0 %THEN -> INCZ ;! SKIP IF FIELD NOT APPLICABLE -> ACT(ZITA(Z,0)) ;! JUMP TO APPROP PROCESS ! ! ********************************************************************* 00039350 ! ! TYPE 1: USES EITHER MARKITEM OR MARKMULT DEPENDING ON WHETHER ! OR NOT THE ITEM MAY BE MULTIPLE. ! KEYWORDS, AUTHORS, BIB. DETS, DATE, PAGINATION ! ACT(1):P=ZITA(Z,-1) ;! SET LINKAGE FOR THIS ITEM %IF ZITA(Z,TYPE)&X'01'=0 %THENC %START ;! MULTIPLE ITEM POSSIBLE SA1(1): MARKMULT(BUFFER,BEGIN,LENG,IB,IND) %IF LENG>0 %THENC %START ;! LINK ITEM LINK(P,BEGIN,LENG) -> SA1(IND) ;! CONTINUE %FINISH %IF LENG<0 %THEN -> FAIL ;! FAIL IF RS CHAR FOUND ! ! IF NO ITEM FOUND AND ITEM NOT SHOWN AS OPTIONAL FAIL ! %IF IND=0 %AND ZITA(Z,TYPE)>0 %THEN -> FAIL %FINISH %ELSEC %START ;! SINGLE ITEM ONLY MARKITEM(BUFFER,BEGIN,LENG,IB);! MARK ITEM 00041500 %IF LENG <=0 %THENC %START ;! NULL ITEM - CHECK OPTIONAL %IF LENG<0 %THEN -> FAIL ;! FAIL IF REC SEP FOUND OR ! ?? WHAT IS THIS LINE 5= %THEN -> FAIL ;! ITEM NOT OPTIONAL %FINISH %ELSE LINK(P,BEGIN,LENG) ;! ELSE LINK POSITION %FINISH SA1(2):-> INCZ ;! CONTINUE THROUGH RECORD ! 00042330 ! ********************************************************************* 00042360 ! ! TYPE 2: USES MARKITEM OR MARKMULT AS FOR TYPE 1, BUT WHERE ! MARKMULT IS USED THE FIRST ITEM EXTRACTED IS LINKED IN 00042600 ! THE POSITION SPECIFIED WHILE ALL FURTHER ITEMS ARE 00042700 ! LINKED INTO SECTION 8.1 (PJ) 00042800 ! REPORT REFERENCE NUMBERS IN PARTICULAR BUT MAY BE USED ! FOR ANY REFERENCES ! ACT(2):P=ZITA(Z,-1) ;! SET FIRST LINK VARIABLE ! ! CHECK WHETHER ITEM MAY BE MULTIPLE ! %IF ZITA(Z,TYPE)&X'01'=0 %THENC %START ;! POSSIBLE MULTIPLE ITEM SA2(1): MARKMULT(BUFFER,BEGIN,LENG,IB,IND) ;! MARK NEXT ITEM 00071300 %IF LENG>0 %THENC %START ;! NON-NULL ITEM LINK(P,BEGIN,LENG) ;! LINK DETAILS P=PJ ;! CHANGE LINKAGE POINTER -> SA2(IND) ;! JUMP OUT APPROPRIATELY %FINISH %IF LENG<0 %THEN -> FAIL ;! FAIL IF REC SEP CHAR FOUND ! ! FAIL IF FIELD COMPLETELY NULL AND ITEM NOT OPTIONAL ! %IF IND=0 %AND ZITA(Z,TYPE)>0 %THEN -> FAIL %FINISH %ELSEC %START ;! SINGLE ITEM ONLY MARKITEM(BUFFER,BEGIN,LENG,IB);! MARK DETAILS OF THIS ITEM %IF LENG<=0 %THENC %START ;! NULL FIELD FOUND ! ! FAIL IF REC SEP CHAR FOUND, OR ITEM NOT OPTIONAL ! %IF LENG<0 %OR ZITA(Z,TYPE)>0 %THEN -> FAIL ! ! ELSE LINK DETAILS INTO CONCORDANCE ! %FINISH %ELSE LINK(P,BEGIN,LENG) %FINISH SA2(2):-> INCZ ;! CONTINUE THROUGH RECORD ! 00046530 ! ********************************************************************* 00046560 ! ! TYPE 3: USES MARKTITLE TO MARK AN ITEM TERMINATED BY EITHER A US ! CHARACTER OR A LANGUAGE NOTE, IF THE LATTER IS FOUND ! MARKLANG IS ALSO CALLED TO SET THE DETAILS ! ACT(3):P=ZITA(Z,-1) ;! SET LINKAGE POINTER ! ?? ACT(3):P=ZITA(Z,-1) ;! SET LINKAGE POINTER MARKTITLE(BUFFER,BEGIN,LENG,IB) ;! MARK DETAILS OF THIS ITEM %IF LENG<=0 %THENC %START ;! NULL FIELD FOUND ! ! IF REC SEP CHARACTER FOUND OR ITEM NOT OPTIONAL FAIL RECORD ! %IF LENG <0 %OR ZITA(Z,TYPE)>0 %THEN -> FAIL %FINISH %ELSE LINK(P,BEGIN,LENG) ;! ELSE LINK DETAILS Z=Z+1 ;! UPDATE RECORD POINTER P=ZITA(Z,-1) ;! SET LINKAGE POINTER ! ! CHECK FOR THE PRESENCE OF A LANGUAGE NOTE ! %IF BUFFER(IB-1)=LSO %THENC %START ;! LANGUAGE CODE FOUND MARKLANG(BUFFER,BEGIN,LENG,IB) %IF LENG<=0 %THENC %START ;! NULL ITEM FOUND ! ! IF REC SEP CHAR FOUND OR ITEM NOT OPTIONAL RECORD FAILS ! %IF LENG<0 %OR ZITA(Z,TYPE)>0 %THEN -> FAIL %FINISH %ELSEC %START ;! LINK DETAILS ONLY IF APPLIC %IF ZITA(Z,TYPE)\=0 %THEN LINK(P,BEGIN,LENG) %FINISH %FINISH %ELSEC %START ;! LANG NOTE NOT PRESENT LENG=0 ;! ZEROISE LENGTH AS IND %IF ZITA(Z,TYPE)>0 %THEN -> FAIL ;! FAIL IF NOT OPTIONAL %FINISH -> INCZ ;! CONTINUE THROUGH RECORD ! 00050230 ! ********************************************************************* 00050260 ! ! TYPE 4: AT THE END OF A RECORD THE PRESENCE OF A NOTE MUST BE ! CHECKED FOR AND UNLIKE ELSEWHERE THE RECORD SEPARATOR ! CHARACTER IS NOT INVALID BUT ACTS AS THE TERMINATOR 00078500 ! CHARACTER ! ACT(4):CHECKNOTE(BUFFER,BEGIN,LENG,IB,NORT) %IF NORT\=0 %THENC %START ;! NON-NULL FIELD FOUND %IF LENG<=0 %THEN -> FAIL ;! FAIL IF NOTE NULL %IF NORT='N' %THEN LINK(PN,BEGIN,LENG) ;! LINK INTO APPROP %IF NORT='T' %THEN LINK(PD,BEGIN,LENG) ;! POSN WRT NORT %FINISH %ELSEC %START ;! NO NOTE - CHECK OPTIONAL LENG=0 ;! ZEROISE LENGTH AS IND %IF ZITA(Z,TYPE)>0 %THEN -> FAIL %FINISH -> INCZ ;! CONTINUE THROUGH RECORD ! 00051930 ! ********************************************************************* 00051960 ! ! TYPE 5: THIS MUST ALWAYS FOLLOW DIRECTLY FROM TYPE 4 SINCE ! THE LATTER SEARCHES FOR THE RS CHARACTER AND THIS LINKS ! THE RESTRICTION CODE WHICH IMMEDIATELY PRECEDES THE RS ! AND WHICH IS POINTED TO BY IB ON EXIT FROM ACT(4) ! ACT(5):P=ZITA(Z,-1) ;! SET LINKAGE POINTER LINK(P,IB,1) ;! LINK DETAILS ! ! ****************************************************************************** ! CREATRC:ITEM=1 ;! SET SWITCH 00081400 IR=0 ;! INITIALISE PROFILE POINTER 00081500 ID=3 ;! INITIALISE DIRECTORY POINTER 00081600 IT=1 ;! INITIALISE TEXT POINTER 00081700 ! %IF DIAGNS=YES %THENC %START ;! PRINT LINKAGE DETAILS NEWLINES(3) ;! ............................. PRINTSTRING( 'PROFILE POINTERS') ;! ............................. NEWLINE ;! ............................. %CYCLE I=1,1,15 ;! ............................. NEWLINE ;! ............................. SPACES(2) ;! ............................. WRITE(IRPROF(I),3) ;! ............................. WRITE(PROF2(I),3) ;! ............................. WRITE(PROF3(I),3) ;! ............................. %REPEAT ;! ............................. ! NEWLINES(2) ;! ............................. PRINTSTRING( 'CONCORDANCE') ;! ............................. NEWLINE ;! ............................. J=PROF2(15) ;! ............................. %CYCLE I=1,1,J ;! ............................. NEWLINE ;! ............................. SPACES(2) ;! ............................. WRITE(CONC1(I),3) ;! ............................. WRITE(CONC2(I),3) ;! ............................. WRITE(CONC3(I),3) ;! ............................. %REPEAT ;! ............................. %FINISH ! NEXT(1): IR=IR+1 ;! INCREMENT INTERNAL REC POINTER ! ! SET END SWITCH IF THIS IS LAST ENTRY IN INTERNAL RECORD PROFILE ! %IF IR >= IRPLIM %THEN ITEM=2 ! ! CHECK MARKER ARRAY - IF CURRENT ITEM IS NOT APPLICABLE THE ! DIRECTORY IS SET WITHOUT REFERENCE TO THE INPUT RECORD. ! %IF IRMARK(IR)=0 %THENC %START ;! CHECK FOR REFERENCE NUMBER %IF IRPROF(IR)=21 %THENC %START ;! REFERENCE NUMBER IRDIRC(ID)=IT ;! SET ADDRESS IRDIRC(ID+1)=7 ;! SET LENGTH OF FIELD REFPT=IT ;! STORE POINTER VALUE IT=IT+7 ;! INCREMENT TEXT POINTER %FINISH %ELSEC %START ;! ANY OTHER ENTRY NOENTRY: IRDIRC(ID)=0 ;! SET ZERO ADDRESS IRDIRC(ID+1)=0 ;! AND ZERO LENGTH %FINISH ID=ID+2 ;! INCREMENT DIRECTORY POINTER -> NEXT(ITEM) %FINISH ! ! IF THE INPUT RECORD HAS NO ENTRY FOR THIS ITEM AND THE ITEM IS ! NOT OPTIONAL THEN A FAULT IS NOTIFIED. ! %IF PROF2(IR)=0 %THENC %START ;! NO ENTRY - CHECK %IF IRMARK(IR)>0 %THEN -> ERR(1) -> NOENTRY ;! JUMP TO SET DIRECTORY %FINISH ! ! NON-ZERO ENTRY IN INPUT RECORD. BUILD UP INTERNAL RECORD ! IRDIRC(ID)=IT ;! SET POINTER IN DIRECTORY TIME=1 ;! SET FIRST ENTRY INDICATOR ICONC=PROF2(IR) ;! EXTRACT CONCORDANCE POINTER ! MVTXT: START=CONC1(ICONC) ;! START OF ITEM IN BUFFER LENG=CONC2(ICONC) ;! LENGTH OF ITEM IN BUFFER ! ! IF ITEM IS AUTHOR NAME - EDITING ROUTINE IS CALLED. ! %IF IRPROF(IR)=41 %C %THEN EDITAUTHR(BUFFER,START,IRTEXT,IT,LENG) %C %ELSE COPYTEXT (BUFFER,START,IRTEXT,IT,LENG) %IF TIME=1 %THENC %START ;!FIRST ITEM PROCESSED SEPARATELY IRDIRC(ID+1)=LENG ;! SET LENGTH IN DIRECTORY ID=ID+2 ;! UPDATE DIRECTORY POINTER TIME=2 ;! CHANGE SWITCH 00089800 %FINISH %ELSEC IRTEXT(IT-1)=LENG ;! SUBSEQUENT ITEMS STORE LENGTH 00090000 IT=IT+LENG ;! UPDATE TEXT POINTER ! ! ARE THERE ANY FURTHER ENTRIES FOR THIS ITEM ! %IF CONC3(ICONC)\=0 %THENC %START ;! YES - IS THIS ALLOWED %IF IRMARK(IR)&X'01'=0 %THENC %START ;! YES:- ICONC=CONC3(ICONC) ;! UPDATE CONCORDANCE POINTER 00090900 IT=IT+1 ;! LEAVE SPACE FOR LENGTH -> MVTXT ;! PROCESS NEXT ENTRY %FINISH %ELSEC -> ERR(2) ;! NO - NOTIFY ERROR %FINISH %IF IRMARK(IR)&X'01'=0 %THENC %START ;! NO - ARE MULT ENTRIES POSS 00091600 IRTEXT(IT)=0 ;! YES - SET FOLLOWING LENGTH=0 IT=IT+1 ;! INCREMENT TEXT POINTER %FINISH -> NEXT(ITEM) ;! PROCESS NEXT PROFILE ENTRY ! ! WHEN THE INTERNAL RECORD PROFILE HAS BEEN COMPLETELY SCANNED THE 00092200 ! INTERNAL RECORD IS COMPLETE AND THE REFERENCE NUMBER MAY BE ADDED 00092300 NEXT(2): INSERTREF(IRTEXT,REFPT) ;! INSERT REFERENCE NUMBER ! ! THE RECORD IS THEN PRINTED TO FORM A REFERENCE NUMBER INDEX ! NEWLINES(2) ;! SPACE FOR NEW OUTPUT S=IRDIRC(5) ;! START OF REFERENCE NUMBER PRINT SYMBOL(IRTEXT(S)) ;! PRINT WEEKNO PRINT SYMBOL(IRTEXT(S+1)) PRINT SYMBOL(IRTEXT(S+2)) PRINT SYMBOL(IRTEXT(S+3)) PRINTSTRING("/") PRINT SYMBOL(IRTEXT(S+4)) ;! PRINT ITEM NUMBER PRINT SYMBOL(IRTEXT(S+5)) PRINT SYMBOL(IRTEXT(S+6)) SPACE PCOUNT=1 ;! INITIALISE POSITION COUNTER I=9 ;! NEXT DIRECTORY ENTRY 00063200 IR=4 ;! NEXT PROFILE ENTRY 00063300 -> SET ;! JUMP TO SET LIMITS ! LOOP:%IF IR>=IRPLIM %THEN -> ENDPR ;! FINISH IF RECORD PRINTED IR=IR+1 ;! UPDATE PROFILE POINTER I=I+2 ;! UPDATE DIRECTORY POINTER %IF IRDIRC(I)=0 %THEN -> LOOP ;! IGNORE NULL RECORD NEWLINE SPACES(9) ;! NEWLINE AND INDENT PCOUNT=1 ;! RESET POSITION COUNTER ! SET: S=IRDIRC(I) ;! SET START OF ITEM E=S+IRDIRC(I+1)-1 ;! SET END OF ITEM ! OUT: %CYCLE J=S,1,E ;! CYCLE THROUGH ITEM %IF PCOUNT>100 %THENC %START ;! END OF LINE REACHED PCOUNT=1 ;! RESET POSITION COUNTER NEWLINE ;! ADVANCE LINE PRINTER SPACES(9) ;! INDENT ITEM DETAILS %FINISH PRINT SYMBOL(IRTEXT(J)) ;! PRINT CHARACTER PCOUNT=PCOUNT+1 ;! UPDATE POSITION COUNTER %REPEAT ! %IF IRMARK(IR)&X'01'\=0 %OR IRTEXT(E+1)=0 %THEN -> LOOP 00068300 PRINTSTRING(' * ') ;! DELIMITER FOR MULTIPLE ITEMS PCOUNT=PCOUNT+3 ;! UPDATE POSITION COUNTER S=E+2 ;! SET START OF NEXT ITEM E=S+IRTEXT(E+1)-1 ;! SET END OF NEXT ITEM -> OUT ;! JUMP TO OUTPUT ! ! ! LENGTH OF RECORD IS HELD IN THE DIRECTORY ! ENDPR:NEWLINE %CYCLE I=1,1,110 ;! PRINT DELIMITER PRINTSTRING("-") %REPEAT IRDIRC(1)=IRPLIM*2+2 ;! LENG OF DIREC (1/2 WDS) %IF IT&X'01'=0 %THENC 00094300 %START ;! ADD EXTRA BLANK TO TEXT 00068430 IRTEXT(IT)=' ' ;! RECORD IF NECESSARY 00094500 IT=IT+1 ;! SO THAT DIRECTORY WILL 00094600 %FINISH ;! BE CORRECTLY ALIGNED 00068490 IRDIRC(2)=IT-1 ;! LENGTH OF TEXT (BYTES) 00094800 %RETURN ! ! ****************************************************************************** ! ! ! ********************************************************************* ! %ROUTINE PRINT TITLE(%INTEGER NUM,TP) ! ! ROUTINE PRINTS THE JOURNAL TITLE OR INPUT TYPE ON THE ! BULLETIN INPUT PROGRAM CHECK LISTING. ! %ROUTINESPEC RDMJN(%INTEGER UNIT,%INTEGERNAME BLOCK,POSN,%INTEGER IND) ! %OWNINTEGERARRAY MJNUMB(1:1024) ;! JOURNAL NUMBER ARRAY !?? SHORT; %OWNINTEGERARRAY MJBPTR(1:1024) ;! BLOCK POINTERS !?? SHORT; %OWNINTEGERARRAY MJPPTR(1:1024) ;! POSITION POINTERS %BYTEINTEGERARRAY JNTITL(1:500) ;! TEXT OF JOURNAL TITLE %OWNBYTEINTEGERARRAY PHD(1:10)=1,9,19,25,40,47,0,0,0,0 %OWNBYTEINTEGERARRAY HD(1:63)=7,'R','E','P','O','R','T','S', 9,'P','A','M','P','H','L','E','T','S', 5,'B','O','O','K','S', 14,'A','N','N','U','A','L',' ','R','E', 'P','O','R','T','S', 6,'T','H','E','S','E','S', 16,'T','R','A','D','E',' ','C','A','T', 'A','L','O','G','U','E','S' ! %INTEGER I ;! LOOP VARIABLE %INTEGER I1 ;! VARIABLES USED IN %INTEGER I2 ;! PRINTING TITLE %INTEGER MJBL ;! POINTER TO CURRENT BLOCK %INTEGER MJPS ;! POINTER TO CURRENT POSITION %INTEGER NVAL ;! VARIABLES USED IN BINARY %INTEGER NINC ;! SEARCH FOR TITLE %INTEGER TLENG ;! LENGTH OF TITLE ! %OWNINTEGER MP ;! MID POINT OF JOURNAL NUMBERS %OWNINTEGER MXNUMB=1024 ;! MAX NO OF JOURNAL TITLES %OWNINTEGER NUMS=0 ;! LAST JOURNAL NUMBER %OWNINTEGER TPS=0 ;! LAST TYPE CODE ! %IF NUM=0 %THENC 00103400 %START ;! LAST ENTRY 00103420 RDMJN(MJUNIT,MJBL,MJPS,3) ;! CLOSE FILES 00103440 %RETURN ;! AND EXIT 00103460 %FINISH 00103480 %IF TP\=1 %THENC %START ;! NON-JOURNAL ITEM %IF TP=TPS %THEN %RETURN ;! EXIT IF TYPE UNCHANGED TPS=TP ;! STORE CURRENT TYPE CODE NEWLINES(2) SPACES(10) PRINTSTRING("*") NEWLINE SPACES(9) PRINTSTRING('* * ') I1=PHD(TP-1) ;! SET START OF HEADING I2=HD(I1) ;! SET LENGTH OF HEADING %CYCLE I=1,1,I2 PRINT SYMBOL(HD(I1+I)) ;! PRINT HEADING %REPEAT NEWLINE SPACES(10) PRINTSTRING("*") %RETURN %FINISH ! NUM=NUM//10 ;! EXTRACT ROOT NUMBER %IF NUM>999000 %THENC %START ;! PSEUDO-JOURNAL NEWLINES(2) SPACES(10) PRINTSTRING("*") NEWLINE SPACES(9) PRINTSTRING('* * ') PRINTSTRING('PSEUDO-JOURNAL') 00107500 NEWLINE SPACES(10) PRINTSTRING("*") NUMS=NUM ;! STORE CURRENT NUMBER %RETURN %FINISH ! %IF NUM=NUMS %THEN %RETURN ;! EXIT IF JOURNAL NO UNCHANGED %IF MP=0 %THENC %START ;! FIRST CALL OF RDMJN ONLY RDMJN(MJUNIT,MJBL,MJPS,1) MP=MXNUMB//2 ;! SET MID-POINT OF ARRAYS %FINISH NUMS=NUM ;! STORE CURRENT JOURNAL NUMBER NVAL=MP ;! INITIALISE SEARCH VARIABLES NINC=NVAL COMP:%IF NUM=MJNUMB(NVAL) %THEN -> GOTIT NINC=NINC//2 %IF NINC<1 %THEN -> MSNG %IF NUM>MJNUMB(NVAL) %THEN NVAL=NVAL+NINC %ELSE NVAL=NVAL-NINC -> COMP ! GOTIT:MJBL=MJBPTR(NVAL) ;! SET BLOCK AND POSITION OF MJPS=MJPPTR(NVAL) ;! TITLE REQUIRED RDMJN(MJUNIT,MJBL,MJPS,2) ;! READ TITLE FROM FILE NEWLINES(2) SPACES(10) PRINTSTRING("*") NEWLINE SPACES(9) PRINTSTRING('* * ') %CYCLE I=1,1,TLENG PRINT SYMBOL(JNTITL(I)) ;! PRINT TITLE %REPEAT -> RETN ! MSNG:NEWLINES(2) SPACES(10) PRINTSTRING("*") NEWLINE SPACES(9) PRINTSTRING('* * ') PRINTSTRING('TITLE NOT KNOWN') RETN:NEWLINE SPACES(10) PRINTSTRING("*") NEWLINES(2) %CYCLE I=1,1,110 PRINTSTRING("-") %REPEAT %RETURN ! ! ********************************************************************* ! %ROUTINE RDMJN(%INTEGER UNIT,%INTEGERNAME BLOCK,POSN,%INTEGER IND) ! ! THIS ROUTINE HANDLES I/O ON THE MASTER JOURNAL NUMBER FILE. ! THE FIRST ENTRY OPENS THE FILE AND SETS UP TH CONTROL ! BLOCKS (IND=1). SUBSEQUENT ENTRIES (IND=2) EXTRACT THE ! REQUIRED RECORD FROM THE SPECIFIED BLOCK AND POSN. THE LAST ! ENTRY (IND=3) CLOSES THE FILE. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL,%INTEGERNAME SECT %C %NAME BEGIN,END) ! %INTEGERARRAY CNT(1:6) ;! CONTROL ARRAY %OWNBYTEINTEGERARRAY BUFFER(1:1000) ;! BUFFER AREA ! %INTEGER I ;! LOOP VARIABLE %INTEGER J ;! LOOP VARIABLE %INTEGER MAXN ;! NO OF TITLES IN FILE %INTEGER MJBL ;! CURRENT BLOCK NUMBER ! %OWNINTEGER NFBL ;! POINTER TO NEXT FREE BLOCK %OWNINTEGER NFPS ;! POINTER TO NEXT FREE POSN %OWNINTEGER NBST ;! LAST BLOCK ACCESSED ! %SWITCH ENTRY(1:3) ;! ENTRY POINT SWITCH ! -> ENTRY(IND) ;! JUMP TO APPROPRIATE POINT ! ! FIRST ENTRY - OPEN FILE. ! ENTRY(1):OPENDA(UNIT) ;! OPEN MASTER FILE MJBL=1 ;! READ CONTROL BLOCK READDA(UNIT,MJBL,CNT(1),CNT(6)) MAXN=CNT(1) ;! SET NO OF TITLES IN FILE NFBL=CNT(2) ;! STORE NEXT FREE BLOCK NO NFPS=CNT(3) ;! STORE NEXT FREE POSITION ! MJBL=CNT(4) ;! READ JOURNAL NUMBER ARRAY READDA(UNIT,MJBL,MJNUMB(1),MJNUMB(MAXN)) MJBL=CNT(5) ;! READ BLOCK POINTERS READDA(UNIT,MJBL,MJBPTR(1),MJBPTR(MAXN)) MJBL=CNT(6) ;! READ POSITION POINTERS READDA(UNIT,MJBL,MJPPTR(1),MJPPTR(MAXN)) ! ! THE END OF THE ARRAY MJNUMB MUST BE FILLED TO COMPARE ! HIGH AGAINST ALL OTHER JOURNAL NUMBERS. ! END: %CYCLE I=MAXN+1,1,MXNUMB MJNUMB(I)=1000000 %REPEAT ! %RETURN ! ! IND=2 NORMAL ENTRY: THE VALUE OF THE BLOCK POINTER IS CHECKED ! AGAINST THE MAXIMUM AND IF O.K. THE APPROPRIATE RECORD IS READ ! ENTRY(2):%IF BLOCK=NBST %THEN -> TRANSF;! CHECK IF BLOCK ALREADY IN %IF 1 LAB(ENTRY) ;! JUMP IF NOT FIRST ENTRY ! LAB(1): %IF RUN=1 %THEN VALCNT=0 %ELSEC 00072300 %START ;! RETRIEVE PREVIOUS COUNT 00072370 OPENDA(STUNIT) ;! OPEN STATS FILE 00072380 STBL=1 ;! READ FIRST BLOCK 00072390 READDA(STUNIT,STBL,DUM(1),DUM(3)) 00125200 %IF CHECK=YES %AND DUM(1)\=WEEKNO %THENC 00072410 CHECK FAILURE(3,WEEKNO,DUM(1)) %ELSE WEEKNO=DUM(1) 00123400 VALCNT=DUM(2) ;! SET CURRENT RECORD COUNT 00125500 %FINISH 00072460 NUM=WEEKNO//10 ;! ON THE FIRST ENTRY THE 00076300 W4=(WEEKNO-NUM*10)!X'30' ;! WEEK NUMBER IS MOVED NO=NUM//10 ;! TO THREE SEPARATE BYTES 00076400 W3=(NUM-NO*10)!X'30' ;! FOR EASE AND SPEED OF NUM=NO//10 ;! ACCESS ON SUBSEQUENT W2=(NO-NUM*10)!X'30' ;! ENTRIES TO THE ROUTINE W1=NUM!X'30' ENTRY=2 ;! CHANGE ENTRY SWITCH 00072470 ! LAB(2): A(IA)=W1 ;! MOVE THE WEEK NUMBER DIGITS A(IA+1)=W2 ;! TO THE APPROPRIATE POSITION A(IA+2)=W3 ;! IN THE GIVEN ARRAY. A(IA+3)=W4 ! VALCNT=VALCNT+1 ;! INCREMENT RECORD COUNT 00073200 NUM=VALCNT 00073300 %CYCLE I=0,1,2 ;! CONVERT ITEM NUMBER TO NO=NUM//10 ;! CHARACTERS AND STORE IN A(IA+6-I)=(NUM-10*NO)!X'30' ;! THE GIVEN ARRAY NEXT TO THE 00076100 NUM=NO ;! WEEK NUMBER. %REPEAT ! %END;!INSERTREF ! ! ********************************************************************** ! %ROUTINE FTCLRC (%BYTEINTEGERARRAYNAME RECORD, %C %INTEGERNAME RSTRT,RLNG,EOF) %ROUTINESPEC RDCLBF (%BYTEINTEGERARRAYNAME BUF, %INTEGER MXBUF) ! %OWNBYTEINTEGERARRAY BUF(1:80) %OWNBYTEINTEGERARRAY TRTBL(0:127)=32,26,32,26,32,26,26,26,26, 26,26,26,26,26,26,47,32,26,32,26,32,26,26,26,26,26,26,26,26, 26,26,58,48,49,50,51,52,53,54,55,56,57,95,63,59,43,45,46,37, 124,126,60,62,61,38,39,40,41,95,35,59,92,42,44,26,65,66,67,68, 00129900 69,70,71,72,73,74,75,76,77,78,79,26,97,98,99,100,101,102,103, 104,105,106,107,108,109,110,111,80,81,82,83,84,85,86,87,88,89, 90,26,26,31,26,26,112,113,114,115,116,117,118,119,120,121,122, 26,26,31,26,26 ! %OWNINTEGER IB %OWNINTEGER SHMRK %INTEGER CHAR,IR,NO ! %SWITCH TEST(1:2) ! NO=1 ! ! IF THE INPUT BUFFER IS EMPTY IT MUST BE REFILLED BEFORE PROCEEDING ! TESTIB: %IF IB>=80 %THEN %START RDCLBF(BUF,80) ;! FILL INPUT BUFFER 00108800 IB=1 ;! RESET BUFFER POINTER 00108900 %FINISH %ELSE IB=IB+1 ;! ELSE: INCREMENT POINTER 00109000 CHAR=BUF(IB) ;! FETCH CURRENT CHARACTER 00109100 ! ! BLANK TAPE OR DELETE CHARACTERS ARE IGNORED ! %IF CHAR=X'00' %OR CHAR=X'FF' %THEN -> TESTIB -> TEST(NO) ! ! ANY LEADING BLANKS IN THE RECORD ARE IGNORED ! TEST(1): %IF CHAR=X'90' %THEN -> TESTIB;! IGNORE BLANK 00110000 %IF CHAR=X'12' %THEN -> TESTIB;! IGNORE CRLF CHARACTER 00110100 %IF CHAR=ET %THEN %START ;! CHECK FIRST CHARACTER 00110400 EOF=1 ;! EOF MARKER SET IF 00110300 %RETURN ;! NULL RECORD FOUND 00110400 %FINISH %IF CHAR=X'06' %OR CHAR=X'17' %THENC 00081010 %START ;! CASE CHANGE, SET THEN IGNORE 00081020 %IF CHAR=X'06' %THEN SHMRK=X'10' %ELSE SHMRK=X'00' 00081030 -> TESTIB 00081040 %FINISH 00081050 NO=2 ;! CHANGE SWITCH 00111100 IR=RSTRT ;! SET RECORD POINTER 00111200 ! ! VALID INPUT CHARACTER - CHECK FOR CASE CHANGE ! TEST(2): CHAR=CHAR&X'6F' ;! REMOVE 8TH HOLE AND PARITY 00111600 %IF CHAR=X'06' %THEN %START SHMRK=X'10' ;! SET MARKER TO CASE SHIFT -> TESTIB %FINISH %IF CHAR=X'07' %THEN %START SHMRK=X'00' ;! SET MARKER TO CASE NORMAL 00112200 -> TESTIB %FINISH ! ! TRANSLATE CHARACTER, CHECK VALIDITY AND STORE IN RECORD IF O.K. ! CHAR=TRTBL(CHAR!SHMRK) ;! ADD SHIFT MARK AND TRANSLATE 00112800 %IF CHAR=X'1A' %THEN -> TESTIB;! IGNORE INVALID CHARACTER 00112900 RECORD(IR)=CHAR ;! ELSE: STORE 00113000 %IF CHAR=RS %THEN %START ;! IF END OF RECORD REACHED 00113100 RLNG=IR+1-RSTRT ;! SET RECORD LENGTH 00113200 %RETURN %FINISH IR=IR+1 ;! ELSE: UPDATE RECORD POINTER 00113500 -> TESTIB ;! CONTINUE 00113600 ! ! ********************************************************************* ! %ROUTINE RDCLBF (%BYTEINTEGERARRAYNAME BUF, %INTEGER MXBUF) %SYSTEMROUTINESPEC SIM2 (%INTEGER EP,R1,R2,R3) ! %INTEGER ABUF,F ! ABUF=ADDR(BUF(1)) SIM2(2,ABUF,MXBUF,ADDR(F)) ;! FILL I/P BUFFER %IF F<0 %THEN %START ;! CHECK FOR FAILURE NEWLINE ;! OUTPUT MESSAGE PRINTSTRING('JOB TERMINATED - INPUT FAILURE ON PAPER TAPE') NEWLINE %STOP ;! TERMINATE JOB %FINISH %END;!RDCLBF %END ;! FTCLRC ! ! ****************************************************************************** ! %INTEGERFN STARTITEM(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME IB) ! ! FUNCTION TO FIND NEXT NON-BLANK CHARACTER IN THE GIVEN ARRAY ! WORKING FORWARD FROM BUF(IB). ! IB=IB-1 INC: IB=IB+1; %IF BUF(IB)=' ' %THEN -> INC %RESULT=IB %END ;! STARTITEM ! ! ****************************************************************************** ! %ROUTINE CHECKNOTE (%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB,TYPE) ! ! THIS ROUTINE CHECKS THE REMAINDER OF THE RECORD FOR THE ! PRESENCE OF A NOTE. IF NO NOTE IS FOUND THEN TYPE IS SET ! TO ZERO, OTHERWISE TYPE IS SET TO THE NOTE CODE. ON EXIT ! IB POINTS TO THE RESTRICTION CODE (IF NO RESTRICTION CODE IS ! PRESENT IN THE INPUT RECORD THE DEFAULT OPTION 'D' IS SET.) ! %INTEGER I ! TYPE=0 ;! INITIALISE TYPE TO ZERO IB=STARTITEM(BUF,IB) ;! IGNORE LEADING BLANKS ! CHECK: %IF (BUF(IB)='N' %OR BUF(IB)='T') %AND BUF(IB+1)=';' %THENC %START ;! START OF NOTE FOUND TYPE=BUF(IB) ;! EXTRACT NOTE CODE IB=IB+2 ;! INCREMENT IB START=STARTITEM(BUF,IB) ;! FIND START OF TEXT OF NOTE -> CHECK ;! CONTINUE CHECKING %FINISH %IF BUF(IB)=RS %THENC %START ;! END OF RECORD ENCOUNTERED %IF BUF(IB-1)=' ' %OR BUF(IB-1)=US %THEN BUF(IB)='D' %C %ELSE IB=IB-1 %IF TYPE\=0 %THENC %START ;! CALCULATE LENGTH OF NOTE I=IB ;! REMOVE TRAILING BLANKS DEC: I=I-1 ;! DECREMENT I %IF BUF(I)=' ' %THEN -> DEC LENGTH=I+1-START ;! CALCULATE LENGTH %IF LENGTH<0 %THEN LENGTH=0 %FINISH %RETURN %FINISH IB=IB+1 ;! INCREMENT RECORD POINTER -> CHECK ;! CHECK NEXT CHARACTER %END ;! CHECKNOTE ! ! ****************************************************************************** ! %ROUTINE MARKITEM(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB) ! ! ROUTINE FINDS START AND LENGTH OF NEXT ITEM IN THE INPUT RECORD ! START BEING INDICATED BY A NON-BLANK CHARACTER AND END BY A ! STANDARD UNIT SEPARATOR CHARACTER. IB IS POINTING IMMEDIATELY ! PAST THE SEPARATOR CHARACTER ON EXIT. ! %INTEGER I ! START=STARTITEM(BUF,IB) ;!SET START OF ITEM I=START NEXT: %IF BUF(I)=US %THEN -> END %IF BUF(I)=RS %THEN -> ERROR I=I+1 -> NEXT ! ERROR: LENGTH=-1 ;!SET - VE LENGTH TO IND ERROR IB=I+1 ;!UPDATE IB %RETURN ! END: IB=I+1 ;!SET POINTER PAST UNIT SEP. DEC: I=I-1 ;!REMOVE TRAILING BLANKS %IF BUF(I)=' ' %THEN -> DEC LENGTH=I+1-START ;!SET LENGTH OF ITEM %IF LENGTH<0 %THEN LENGTH=0 %END;!MARKITEM ! ! ****************************************************************************** ! ****************************************************************************** ! %ROUTINE MARKLANG(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB) ! ! IF SQUARE BRACKETS ARE FOUND AT THE END OF A TITLE THIS ROUTINE 00124500 ! EXTRACTS THE LANGUAGE FROM BETWEEN THEM. EITHER A CLOSE SQUARE 00124600 ! BRACKET OR A UNIT SEPARATOR ARE ACCEPTED AS VALID TERMINATORS. ! IB IS SET IMMEDIATELY PAST THE UNIT SEPARATOR ON EXIT. ! %INTEGER I ! START=STARTITEM(BUF,IB) ;!SET START OF LANGUAGE I=START NEXT: %IF BUF(I)=LSC %OR BUF(I)=US %THEN -> END %IF BUF(I)=RS %THEN -> ERROR I=I+1 -> NEXT ! ERROR: LENGTH=-1 ;!SET - VE LENGTH AS ERROR IND IB=IB+1 %RETURN ! END: IB=I+1 ;!SET POINTER PAST TERMINATOR DEC: I=I-1 ;!REMOVE TRAILING BLANKS %IF BUF(I)=' ' %THEN -> DEC LENGTH=I+1-START ;!SET ITEM LENGTH %IF LENGTH<0 %THEN LENGTH=0 CHECK: %IF BUF(IB-1)=US %THEN -> OUT ;!ENSURE IB POINTS PAST UNIT SEP IB=IB+1 -> CHECK OUT: %END;! MARKLANG ! ! ****************************************************************************** ! %ROUTINE MARKTITLE(%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB) ! 00127650 ! ROUTINE FINDS START AND LENGTH OF TITLE IN CULHAM INPUT RECORD ! EITHER OPEN SQUARE BRACKET OR UNIT SEPARATOR IS ACCEPTED AS THE 00127800 ! TERMINATOR CHARACTER. IB IS LEFT POINTING IMMEDIATELY PAST ! WHICHEVER TERMINATOR CHARACTER IS FOUND. ! %INTEGER I ! START=STARTITEM(BUF,IB) ;!FIND START OF TITLE I=START NEXT: %IF BUF(I)=LSO %OR BUF(I)=US %THEN -> END %IF BUF(I)=RS %THEN -> ERROR I=I+1 -> NEXT ! ERROR: LENGTH=-1 ;!SET -VE LENGTH AS ERROR IND IB=I+1 ;!SET POINTER PAST SEPARATOR %RETURN ! END: IB=I+1 ;!SET POINTER PAST SEPARATOR DEC: I=I-1 ;!REMOVE TRAILING BLANKS %IF BUF(I)=' ' %THEN -> DEC LENGTH=I+1-START ;!CALCULATE LENGTH %IF LENGTH<0 %THEN LENGTH=0 %END;! MARKTITLE ! ! ****************************************************************************** ! %ROUTINE COPYTEXT(%BYTEINTEGERARRAYNAME SOURCE,%INTEGER SSTRT, %C %BYTEINTEGERARRAYNAME DEST,%INTEGER DSTRT,L) ! ! MOVES L BYTES FROM SOURCE(SSTRT) ET SEQ. TO DEST(DSTRT) ET SEQ. %INTEGER I ! %IF L<= 0 %THEN %RETURN %CYCLE I=SSTRT,1,SSTRT+L-1 DEST(DSTRT)=SOURCE(I) DSTRT=DSTRT+1 %REPEAT %END;! COPYTEXT ! ! ****************************************************************************** ! %ROUTINE MARKMULT (%BYTEINTEGERARRAYNAME BUF, %C %INTEGERNAME START,LENGTH,IB,IND) ! ! THIS ROUTINE FINDS THE STARTING POINT AND LENGTH OF AN ITEM ! TERMINATED EITHER BY A UNIT SEPARATOR CHARACTER OR A COMMA ! ON EXIT IB POINTS IMMEDIATELY PAST THE SEPARATOR AND IND IS ! SET TO 1,2 OR 0 AS THE TERMINATOR CHARACTER IS A COMMA OR A ! UNIT SEPARATOR OR ALL REMAINING RECORDS ARE NULL. ! %INTEGER I %OWNINTEGER J=0 ! STRT: START=STARTITEM(BUF,IB) ;! SET STARTING POINT I=START ! NEXT: %IF BUF(I)=RS %THENC %START ;! RECORD SEP CHARACTER FOUND 00133500 LENGTH=-1 ;! SET -VE LENGTH AS ERROR IND IB=I+1 ;! SET IB TO POINT PAST RS %RETURN %FINISH %IF BUF(I)\=US %AND BUF(I)\=',' %THENC %START ;! NON SEPARATOR CHARACTER I=I+1 ;! INCREMENT BUFFER POINTER -> NEXT ;! EXAMINE THE NEXT CHARACTER %FINISH ! IB=I+1 DEC: I=I-1 ;! REMOVE TRAILING BLANKS %IF BUF(I)=' ' %THEN -> DEC LENGTH=I+1-START ;! CALCULATE LENGTH %IF LENGTH>0 %THENC %START ;! VALID ITEM - SET MARKER %IF BUF(IB-1)=',' %THEN J=1 %ELSE J=2 %FINISH %ELSEC %START ;! INVALID - CHECK NEXT IF POSS 00135400 %IF BUF(IB-1)=',' %THEN -> STRT %ELSEC %START ;! NO MORE ITEMS LENGTH=0 ;! SET NULL LENGTH %IF J\=1 %THEN J=0 ;! SET INDICATOR IF NECESSARY %FINISH %FINISH IND=J ;! SET VALUE OF IND ON EXIT %END;! MARKMULT ! ! ****************************************************************************** ! %ROUTINE EDITAUTHR(%BYTEINTEGERARRAYNAME BUF, %INTEGER START, %C %BYTEINTEGERARRAYNAME IRTEXT, %INTEGER ITX, %C %INTEGERNAME LENG) ! ! ROUTINE EXTRACTS AUTHORS FROM THE BUFFER ARRAY AND STORES ! THEM IN THE INTERNAL RECORD SURNAME FIRST. ! %INTEGER AUTHMK ;! SURNAME PROCESSED MARKER %INTEGER I ;! LOOP VARIABLE %INTEGER I1 ;! VARIABLE POINTERS TO %INTEGER I2 ;! TEMPORARY ARRAY %INTEGER IB ;! POINTER TO BUFFER %INTEGER IT ;! POINTER TO TEXT %INTEGER LIMIT ;! LIMIT OF RECORD TO BE EXAMINED %BYTEINTEGERARRAY TEMP(1:100) ! ! SET VARIABLES AND MARKERS TO INITIAL VALUES ! IB=START-1 ;! SET BUFFER ARRAY POINTER 00137800 IT=ITX ;! SET INTERNAL RECORD POINTER LIMIT=IB+LENG ;! SET MAX BUFFER POINTER I=1 ;! SET TEMPORARY ARRAY POINTER AUTHMK=0 ;! SET SPECIAL AUTHOR MARK OFF 00138200 ! ! CHECK THAT THE END OF THE AUTHOR HAS NOT BEEN REACHED ! INC1: %IF IB>=LIMIT %THEN -> SETAUTH IB=IB+1 ;! INCREMENT BUFFER POINTER ! ! ALPHABETIC CHARACTERS, BLANKS, HYPHENS AND APOSTRAPHES ARE 00138900 ! THE ONLY CHARACTERS WHICH ARE ACCEPTED AND STORED 00138950 ! COMP: %IF 'A'<=BUF(IB)<='Z' %OR SMA<=BUF(IB)<=SMZ %C %OR BUF(IB)='-' %OR BUF(IB)='''' %C 00139150 %THEN TEMP(I)=BUF(IB) %ELSE TEMP(I)=' ' I=I+1 ;! INCREMENT TEMP ARRAY POINTER %IF BUF(IB)\='*' %THEN -> INC1 ! ! IF THIS CHARACTER IS AN ASTERISK THIS IMPLIES THE START OF A ! SPECIAL AUTHOR NAME - ALL CHARACTERS BETWEEN THE ASTERISKS ! ARE TREATED AS VALID 00139800 ! INC2: IB=IB+1 ! ! IS THIS THE TERMINATING ASTERISK ! %IF BUF(IB)='*' %THENC %START AUTHMK=1 ;! SET SPECIAL AUTHOR MARK -> INC1 ;! PROCESS NEXT CHAR NORMALLY %FINISH IRTEXT(IT)=BUF(IB) ;! MOVE AUTHOR NAME TO INT REC 00140900 IT=IT+1 ;! INCREMENT INTERNAL RECORD PTR 00141000 -> INC2 ;! GO ON CHECKING ASTERISK STR 00141100 ! ! END OF THIS AUTHOR SETAUTH: I2=I-1 ;! SET UPPER LIMIT OF TEMP ARRAY 00141400 ! ! IF AUTHOR SURNAME HAS NOT BEEN EXTRACTED THIS IS DONE NOW 00141600 ! %IF AUTHMK\= 1 %THENC %START DEC1: I=I-1 ;! FIND UPPER LIMIT OF AUTHOR -> DEC1 %IF TEMP(I)=' ' I1=I ;! UPPER LIMIT OF SURNAME DEC2: I=I-1 ;! FIND LOWER LIMIT OF AUTHOR %IF I=0 %THENC %START ;! FINISH IF END REACHED COPYTEXT(TEMP,I+1,IRTEXT,IT,I1) IT=IT+LENG LENG=IT-ITX %RETURN %FINISH -> DEC2 %UNLESS TEMP(I)=' ' SET: I2=I ;! LOWER LIMIT OF SURNAME LENG=I1-I ;! CALC LENGTH OF AUTHOR NAME COPYTEXT (TEMP,I+1,IRTEXT,IT,LENG) IT=IT+LENG ;! RESET INTERNAL RECORD POINTER %FINISH ! %CYCLE I=1,1,I2 ;! EXIT IF THERE ARE NO INITIALS %IF TEMP(I)\=' ' %THEN -> ENT %REPEAT -> OUT ENT: IRTEXT(IT)=',' ;! FOLLOW SURNAME BY COMMA 00167400 IT=IT+1 ;! INCREMENT INTERNAL RECORD PTR 00143400 ! %CYCLE I=1,1,I2 ;! MOVE INITIALS ETC. TO INT REC %IF TEMP(I)\=' ' %THENC %START ;! ONLY MOVE NON-BLANK CHARS 00143800 IRTEXT(IT)=TEMP(I) IT=IT+1 ;! INCREMENT POINTER %FINISH %REPEAT ! ! SET LENGTH TO LENGTH OF INTERNAL RECORD ENTRY BEFORE EXIT ! OUT: LENG=IT-ITX ! %END;!EDITAUTHR ! ! ********************************************************************* ! ! FAILURE SECTION OF ROUTINE. MESSAGES DESCRIBING THE FAILURE ! ARE OUTPUT WITH RELEVANT DETAILS OF THE RECORD. WHERE POSSIBLE ! ONLY THE RECORD IN QUESTION IS IGNORED, BUT IN THE CASE OF A ! BATCH HEADING THE ENTIRE BATCH MUST BE SKIPPED. ! FAIL:NEWLINES(2) ;! OUTPUT APPROPRIATE MESSAGE PRINTSTRING(' **** INPUT FORMAT ERROR - ') 00116700 %IF START=1 %THENC PRINTSTRING('BATCH IGNORED') %ELSEC PRINTSTRING('RECORD IGNORED') ! NEWLINE SPACES(9) ;! OUTPUT ERROR MESSAGE %IF LENG>0 %THENC %START ;! BATCH HEADING ERROR 00146600 %IF LENG=1 %THENC 00143230 %START ;! JOURN NO FAILURE 00143260 PRINTSTRING('JOURNAL NUMBER INVALID IN RECORD:-') 00143300 ->FLPR ;! JUMP TO O/P BATCH HEADING 00143400 %FINISH 00143430 PRINTSTRING('INVALID SECTION CODE IN RECORD:-') 00143460 %FINISH %ELSEC 00143500 %START 00143550 %IF LENG=0 %THENC 00143600 PRINTSTRING('ILLEGAL NULL FIELD') %ELSEC 00143700 PRINTSTRING('UNEXPECTED RECORD SEPARATOR') 00143800 PRINTSTRING(' FOUND IN RECORD:-') 00143900 %IF START=1 %THEN -> FLPR 00144000 %FINISH 00144050 S=START ;! SET START POINT OF DATA RECHK:NEWLINE SPACES(9) ;! RECORD TEXT %IF RSIZE>100 %THENC %START %CYCLE I=0,1,99 PRINT SYMBOL(BUFFER(S+I)) %REPEAT S=S+100 RSIZE=RSIZE-100 -> RECHK %FINISH %CYCLE I=0,1,RSIZE-1 PRINT SYMBOL(BUFFER(S+I)) %REPEAT NEWLINE SPACES(9) PRINTSTRING('IN BATCH:-') RSIZE=START-1 ;! SET RSIZE TO PRINT BATCH NO FLPR:NEWLINE SPACES(9) ;! BATCH NUMBER %CYCLE I=1,1,RSIZE PRINT SYMBOL(BUFFER(I)) %REPEAT ! ! THE NUMBER OF FAILURES IS NOW CHECKED TO ENSURE THAT THE LIMIT ! HAS NOT BEEN EXCEEDED: IF IT HAS, THE RUN IS TERMINATED. ! FALCNT=FALCNT+1 ;! CHECK FOR EXCESS FAILURES 00120600 %IF FALCNT>=FALLIM %THENC 00120700 %START 00120800 TMF: NEWLINES(2) ;! TERMINATE JOB IF NECESSARY 00120900 PRINTSTRING(' **** TOO MANY INPUT ERRORS - JOB TERMINATED ****') ! ?? 00121600 %STOP %FINISH %IF START\=1 %THEN -> NEWREC ;! IF SINGLE RECORD, FETCH NEXT 00147600 ! ! IF BATCH HEADING IS IN ERROR THE WHOLE BATCH IS SKIPPED ! F2: FTCLRC(BUFFER,START,RSIZE,END) ;! READ NEXT RECORD %IF END=YES %THEN %RETURN ;! EXIT IF END OF FILE %IF 'A'<=BUFFER(START)<='Z' %THEN -> F2 ;! CONTINUE UNTIL NEW SET(PROF2,1,MXPROF,0) ;! BATCH FOUND. CLEAR THE 00148250 SET(PROF3,1,MXPROF,0) ;! POINTER ARRAYS AND JUMP TO 00148300 -> PRIP ;! PROCESS NEXT BATCH HEADING 00148350 ! ! COMPULSORY ITEM IN INTERNAL RECORD IS SHOWN AS MISSING BY THE ! INPUT RECORD CONCORDANCE. THIS RECORD IS IGNORED. ! ERR(1):NEWLINES(2) PRINTSTRING(' **** INTERNAL RECORD PROFILE NOT SATISFIED') 00123200 PRINTSTRING(' - RECORD IGNORED') NEWLINE SPACES(9) PRINTSTRING('COMPULSORY FIELD (') WRITE(IRPROF(IR),3) PRINTSTRING(' ) MISSING FROM RECORD (TYPE') WRITE(TYPE,2) PRINTSTRING(' ):-') S=START -> RECHK ! ! MULTIPLE ITEM INDICATED BY INPUT RECORD CONCORDANCE WHERE A ! MULTIPLE ITEM IS NOT EXPECTED BY THE INTERNAL RECORD PROFILE. ! ERR(2):NEWLINES(2) PRINTSTRING(' **** WARNING - UNEXPECTED MULTIPLE ITEM IN FIELD') 00124800 WRITE(IRPROF(IR),3) PRINTSTRING(' OF NEXT RECORD') NEWLINE SPACES(9) PRINTSTRING('FIRST ITEM ONLY ACCEPTED FOR INTERNAL RECORD.') -> NEXT(ITEM) %END ;! NEXTREC ! ! ********************************************************************* ! %ROUTINE BULLETIN OUTPUT(%INTEGER NO, %INTEGERARRAYNAME ANUM) ! ! THIS ROUTINE IS CALLED TO OUTPUT THE CURRENT RECORD TO THE ! CURRENT WEEK'S BULLETIN FILE. A CONCORDANCE IS CREATED ! FOR THE VARIOUS JOURNAL TITLES WHICH IS ALSO HELD IN THE ! BULLETIN FILE. PHYSICAL I/O IS HANDLED BY WRBUL. ! %ROUTINESPEC WRBUL (%INTEGERNAME UNIT,BLOCK,POSN,NO) %ROUTINESPEC CONCORD(%INTEGERNAME LINK, %C %INTEGERNAME CURRENT,BLOCK,POSN) 00125000 ! ?? LINK WAS A SHORTINTEGERNAME ! %OWNINTEGERARRAY NUMBER(1:200) ;! JOURNAL NUMBERS !?? SHORT; %OWNINTEGERARRAY POINTF(1:200) ;! 1ST CONCORDANCE !?? SHORT; %OWNINTEGERARRAY POINTL(1:200) ;!LAST CONCORDANCE !?? SHORT; %OWNINTEGERARRAY CONC1(1:500) ;! CONCORDANCE 1 !?? SHORT; %OWNINTEGERARRAY CONC2(1:500) ;! CONCORDANCE 2 !?? SHORT; %OWNINTEGERARRAY CONC3(1:500) ;! CONCORDANCE 3 ! %OWNINTEGER IN=1 ;! NEXT SPARE ELEMENT OF NUMBER %OWNINTEGER ICONC=1 ;! NEXT SPARE CONCORDANCE ELEMENT %OWNINTEGER LAST=1 ;! POINTER TO LAST JOURNAL NO. %OWNINTEGER TIME=1 ;! ENTRY SWITCH VARIABLE ! %INTEGER NUM 00121450 %INTEGER BLK,POSN,I,N %SWITCH ENTRY(1:2),EXIT(2:3) 00125800 ! ! WHEN THE END OF THE INPUT FILE HAS BEEN FOUND A ZERO NUMBER ! IS PASSED OVER AND WRBUL CALLED TO TIDY AND CLOSE THE O/P FILES00158600 ! %IF NO=0 %THENC 00128820 %START ;! LAST ENTRY 00128840 %IF TIME=1 %THENC 00128860 %START ;! NO PREVIOUS ENTRIES 00128880 NEWLINES(2) ;! OUTPUT MESSAGE 00128900 PRINTSTRING('BULLETIN FILE NOT ACCESSED') 00128920 %RETURN ;! EXIT FROM ROUTINE 00128940 %FINISH %ELSE TIME=3 ;! SET LAST ENTRY MARKER 00128960 %FINISH 00128980 WRBUL(BLUNIT,BLK,POSN,TIME) ;! CALL O/P ROUTINE 00122200 N=0 CHNXT: N=N+1 %IF N>NO %THEN -> EXIT(TIME) 00126700 NUM=ANUM(N) -> ENTRY(TIME) ;! JUMP TO APPROPRIATE ENTRY ! ! NORMAL ENTRY - THE JOURNAL NUMBER IS CHECKED AGAINST THE ! PRECEDING NUMBER, SINCE THE INPUT TENDS TO BE BATCHED, BEFORE ! CHECKING THE ENTIRE ARRAY. WHEN A MATCH IS FOUND THE ! CONCORDANCE IS UPDATED. IF NO MATCH IS FOUND A NEW ENTRY ! IS CREATED IN THE NUMBER ARRAY. ! ENTRY(2):%IF NUM=NUMBER(LAST) %THENC %START ;! LINK TO PREVIOUS RECORD CONCORD(POINTL(LAST),ICONC,BLK,POSN) -> CHNXT ;! CHECK FOR FURTHER NUMBERS %FINISH %CYCLE I=1,1,IN-1 ;! CHECK ALL RECORDS %IF NUM=NUMBER(I) %THENC %START ;! LINK WHEN MATCH FOUND CONCORD(POINTL(I),ICONC,BLK,POSN) LAST=I ;! NEW VALUE OF LAST -> CHNXT ;! CHECK FOR FURTHER NUMBERS %FINISH %REPEAT ! ! IF THIS IS THE FIRST ENTRY AND THERE IS NO EXISTING RECORD ! ON THE STORAGE MEDIUM OR IF A NEW JOURNAL NUMBER HAS BEEN ! FOUND THEN THE INITIAL LINKAGE MUST BE SET UP AND THE NEW ! JOURNAL NUMBER STORED IN THE ARRAY. ! ENTRY(1):NUMBER(IN)=NUM ;! STORE NEW NUMBER LAST=IN ;! SET LAST POINTER POINTF(IN)=ICONC ;! SET PTR TO NEXT CONCORDANCE 00163100 CONCORD(POINTL(LAST),ICONC,BLK,POSN) IN=IN+1 ;! UPDATE NUMBER POINTER TIME=2 ;! ENSURE CORRECT SWITCH VALUE 00125900 -> CHNXT ;! CHECK FOR FURTHER NUMBERS ! ! ON THE LAST ENTRY TO THE ROUTINE A TERMINATION MESSAGE IS ! PRINTED TOGETHER WITH THE TOTAL NUMBER OF STORAGE 'BLOCKS' ! FLLLED ON THE OUTPUT DEVICE - INCLUDING THE CONTROL BLOCKS ! EXIT(3):%IF DIAGNS=YES %THENC %START ;! PRINT CONTROL BLOCK DETAILS NEWLINES(2) ;! ............................. PRINTSTRING('CONTROL BLOCKS SET UP') ;! ............................. NEWLINE ;! ............................. PRINTSTRING('NUMBER POINTF POINTL') ;! ............................. %CYCLE I=1,1,IN-1 ;! ............................. NEWLINE ;! ............................. WRITE(NUMBER(I),5) ;! ............................. WRITE(POINTF(I),6) ;! ............................. WRITE(POINTL(I),6) ;! ............................. %REPEAT ;! ............................. NEWLINES(2) ;! ............................. PRINTSTRING('CONC1 CONC2 CONC3') ;! ............................. %CYCLE I=1,1,ICONC ;! ............................. NEWLINE ;! ............................. WRITE(CONC1(I),4) ;! ............................. WRITE(CONC2(I),5) ;! ............................. WRITE(CONC3(I),5) ;! ............................. %REPEAT ;! ............................. %FINISH ! NEWLINES(2) 00135650 PRINTSTRING('BULLETIN FILE COMPLETED TO DATE') NEWLINE PRINTSTRING('TOTAL NUMBER OF BLOCKS OCCUPIED ON UNIT') WRITE(BLUNIT,2) ;! O/P LOGICAL UNIT NUMBER PRINTSTRING(' =') WRITE(BLK,4) ;! O/P LAST BLOCK NUMBER ! EXIT(2): %RETURN 00133500 ! ! ********************************************************************* ! %ROUTINE WRBUL (%INTEGERNAME UNIT,BLOCK,POSN,NO) ! ! THIS ROUTINE CONTROLS THE PHYSICAL HANDLING OF THE CURRENT ! BULLETIN DISC FILE. ON THE FIRST ENTRY (NO=1) THE FILE ! (UNIT) IS OPENED, THE POINTER TABLES ARE INITIALISED AND ! THE RECORD IS OUTPUT. FOR THE LAST ENTRY (NO=3) THE ! POINTER TABLES ARE WRITTEN TO THE END OF THE DISC FILE ! AND THE CONTROL BLOCK IS SET UP IN SECTOR 1. ! THE FILE IS THEN CLOSED. ! ! THE RECORDS ARE PACKED INTO A BUFFER AREA PRIOR TO OUTPUT ! ON RETURN FROM THE ROUTINE BLOCK AND POSN CONTAIN THE SECTOR ! NUMBER AND STARTING POSITION WITHIN THAT SECTOR OF THE ! RECORD JUST WRITTEN. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL, %INTEGERNAME SECT,%C %NAME BEGIN,END) %EXTERNALROUTINESPEC WRITEDA(%INTEGER CHANNEL, %INTEGERNAME SECT,%C %NAME BEGIN,END) ! %OWNBYTEINTEGERARRAY BUFA(1:1000) ;! OUTPUT BUFFER !?? SHORT; %INTEGERARRAY CNTBUF(1:500) ;! POINTER TABLES O/P AREA 00170000 ! %OWNINTEGER IB ;! BUFFER POINTER %OWNINTEGER SECTOR ;! NEXT SECTOR NUMBER ! %INTEGER I,J,K,L ;! LOOP VARIABLES %INTEGER START ;! START POINT IN INTERNAL REC %INTEGER NSEC ;! SECTOR - START OF TABLES %INTEGER CSEC ;! SECTOR - START OF CONCORDANCE %INTEGER RSEC ;! SECTOR - LAST RECORD WRITTEN %INTEGER IBST ;! NEXT FREE BYTE IN RSEC ! %SWITCH ENTRY(1:3) ;! ENTRYPOINT SWITCH ! ! JUMP TO THE APPROPRIATE ENTRYPOINT ! -> ENTRY(NO) ;! JUMP TO REQUIRED ENTRY ! ! FIRST ENTRY - INITIALISE POINTER TABLES AND OPEN FILE ! ENTRY(1):OPENDA(UNIT) ;! OPEN DIRECT ACCESS FILE ! %IF RUN=1 %THENC %START ;! NEW WEEKS OUTPUT %CYCLE I=1,1,MXNUMB NUMBER(I)=0 ;! INITIALISE JOURNAL NUMBERS POINTF(I)=0 ;! AND FIRST AND LAST POINTER POINTL(I)=0 ;! ARRAYS TO ZERO %REPEAT SECTOR=2 ;! SET FIRST FREE SECTOR NO ICONC=1 ;! SET NEXT CONCORDANCE NUMBER IB=1 ;! SET BUFFER POINTER %FINISH %ELSEC %START ;! CONTINUATION OF CURRENT WEEK NO=2 ;! SET SWITCH TO NORMAL ENTRY I=1 ;! SET I TO READ CONTROL BLOCK READDA(UNIT,I,CNTBUF(1),CNTBUF(MXCNTB)) ! ! CHECK WEEK NUMBER AGREES IF REQUIRED ! %IF CHECK=YES %THENC %START %IF WEEKNO\=CNTBUF(1) %THENC %START I=CNTBUF(1) CHECK FAILURE (1,WEEKNO,I) %FINISH %FINISH 00195900 IN=CNTBUF(2) ;! SET LENGTH OF TABLES NSEC=CNTBUF(3) ;! START OF TABLES ICONC=CNTBUF(4) ;! NUMBER OF CONCORDANCE ENTRIES CSEC=CNTBUF(5) ;! START OF CONCORDANCE SECTOR=CNTBUF(6) ;! CURRENT RECORD SECTOR IB=CNTBUF(7) ;! NEXT POSITION IN SECTOR %IF 8*IN<=MXBUFB %THENC %START ;! ALL TABLES IN SINGLE BLOCK READDA(UNIT,NSEC,CNTBUF(1),CNTBUF(MXCNTB)) J=IN+IN ;! START OF POINTF K=J+IN ;! START OF POINTL %CYCLE I=1,1,IN ;! EXTRACT VALUES NUMBER(I)=INTEGER(ADDR(CNTBUF(I+I-1))) POINTF(I)=CNTBUF(J+I) POINTL(I)=CNTBUF(K+I) %REPEAT %FINISH %ELSEC %START ;! TABLES IN SEPARATE BLOCKS READDA(UNIT,NSEC,NUMBER(1),NUMBER(IN)) NSEC=NSEC+1 READDA(UNIT,NSEC,POINTF(1),POINTF(IN)) NSEC=NSEC+1 READDA(UNIT,NSEC,POINTL(1),POINTL(IN)) %FINISH IN=IN+1 ;! SET NEXT FREE NUMBER POINTER ! ! READ CONCORDANCE ARRAYS FROM END OF DISC FILE ! READDA(UNIT,CSEC,CONC1(1),CONC1(ICONC)) CSEC=CSEC+1 READDA(UNIT,CSEC,CONC2(1),CONC2(ICONC)) CSEC=CSEC+1 READDA(UNIT,CSEC,CONC3(1),CONC3(ICONC)) ICONC=ICONC+1 ;! SET NEXT FREE CONCORDANCE ! ! CURRENT BLOCK IS NOW READ BACK FROM FILE BEFORE PROCEEDING ! READDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFB)) %FINISH ! ! USUAL ENTRY ADDS THE CURRENT RECORD TO THE OUTPUT ! BUFFER WRITING THE LATTER TO DISC AS NECESSARY. ! ENTRY(2):BLOCK=SECTOR ;! SET CURRENT SECTOR NUMBER POSN=IB ;! SET STARTING POSITION START=1 ;! INITIALISE RECORD POINTER ! DIRC: %CYCLE I=START,1,MXDIRC ;! TRANSFER DIRECTORY BUFA(IB)=BYTEINTEGER(ADDR(IRDIRC(I))) BUFA(IB+1)=BYTEINTEGER(ADDR(IRDIRC(I))+1) IB=IB+2 ;! UPDATE BUFFER POINTER %IF IB>=MXBUFB %THENC %START ;! BUFFER A FULL WRITEDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFB)) IB=1 ;! RESET BUFFER POINTER SECTOR=SECTOR+1 ;! INCREMENT SECTOR NUMBER %FINISH %REPEAT ! TEXT1: START=1 ;! INITIALISE RECORD POINTER TEXT2: %CYCLE I=START,1,IRDIRC(2) ;! TRANSFER TEXT ARRAY BUFA(IB)=IRTEXT(I) IB=IB+1 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFB %THENC %START ;! BUFFER A FULL WRITEDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFB)) IB=1 ;! RESET BUFFER POINTER SECTOR=SECTOR+1 ;! INCREMENT SECTOR NUMBER %FINISH %REPEAT %RETURN ;! EXIT IF TRANSFER COMPLETE ! ! LAST ENTRY - THE LAST RECORD BLOCK MUST BE OUTPUT, THE ! CONTROL TABLES ARE WRITTEN TO DISC AND THE CONTROL BLOCK ! IS SET UP AND FORMS THE FIRST SECTOR OF THE DISC FILE ! ENTRY(3):IBST=IB ;! STORE CURRENT BUFFER POINTER RSEC=SECTOR ;! STORE CURRENT SECTOR NUMBER %IF IB\=1 %THENC %START ;! PART-FILLED BUFFER TO BE O/P ! %CYCLE I=IB,1,MXBUFB ;! CLEAR END OF BUFFER BUFA(I)=0 %REPEAT WRITEDA(UNIT,RSEC,BUFA(1),BUFA(MXBUFB)) SECTOR=RSEC+1 ;! INCREMENT TO NEXT FREE SECTOR %FINISH ! ! POINTER AND CONCORDANCE ARRAYS ARE NOW WRITTEN TO THE DISC ! FOLLOWING THE LAST SECTOR OF RECORD OUTPUT. ! NSEC=SECTOR ;! STORE NEXT SECTOR NUMBER IN=IN-1 ;! CORRECT NUMBER OF JOURNALS 00189850 ! ! IF THE NUMBER OF SEPARATE 'JOURNALS' PROCESSED IS SMALL 00190000 ! ENOUGH ALL THE JOURNAL NUMBERS AND POINTER ARRAYS ARE 00190100 ! PACKED INTO A SINGLE BLOCK, OTHERWISE THEY ARE OUTPUT AS ! THREE OR MORE CONSECUTIVE BLOCKS. ! %IF 8*IN <= MXBUFB %THENC %START ;! STORE IN SINGLE BLOCK 00190600 K=IN+IN ;! SET START OF POINTF ARRAY L=K+IN ;! SET START OF POINTL ARRAY %CYCLE I=1,1,IN ;! TRANSFER TABLES TO BUFFER J=I+I CNTBUF(J-1)=INTEGER(ADDR(NUMBER(I))); ! ?? WAS SHORTINTEGER CNTBUF(J)=INTEGER(ADDR(NUMBER(I))+2); ! ?? WAS SHORTINTEGER CNTBUF(J)=INTEGER(ADDR(NUMBER(I))+2); ! ?? WAS SHORTINTEGER CNTBUF(K+I)=POINTF(I) CNTBUF(L+I)=POINTL(I) 00183600 %REPEAT WRITEDA(UNIT,NSEC,CNTBUF(1),CNTBUF(MXCNTB)) SECTOR=NSEC+1 ;! UPDATE SECTOR NUMBER %FINISH %ELSEC %START ;! STORE IN SEVERAL BLOCKS 00191900 WRITEDA(UNIT,SECTOR,NUMBER(1),NUMBER(IN)) SECTOR=SECTOR+1 ;! JOURNAL NUMBERS WRITEDA(UNIT,SECTOR,POINTF(1),POINTF(IN)) SECTOR=SECTOR+1 ;! POINTERS TO 1ST CONCORDANCE WRITEDA(UNIT,SECTOR,POINTL(1),POINTL(IN)) SECTOR=SECTOR+1 ;! POINTERS TO LAST CONCORDANCE %FINISH ! ICONC=ICONC-1 ;! CALCULATE NUMBER OF ITEMS 00159900 CSEC=SECTOR ;! STORE STARTING SECTOR NUMBER ! ! THE THREE CONCORDANCE ARRAYS ARE OUTPUT IN THREE COMMANDS ! AS THEY ARE LIKELY TO FILL 1/2 - 1 SECTOR EACH. ! WRITEDA(UNIT,SECTOR,CONC1(1),CONC1(ICONC)) 00189200 SECTOR=SECTOR+1 00189300 WRITEDA(UNIT,SECTOR,CONC2(1),CONC2(ICONC)) 00189400 SECTOR=SECTOR+1 00189500 WRITEDA(UNIT,SECTOR,CONC3(1),CONC3(ICONC)) 00189600 ! ! THE CONTROL INFORMATION IS THEN WRITTEN TO THE FIRST BLOCK ! BLOCK=CSEC ;! RETURN MAXIMUM SECTOR NUMBER CNTBUF(1)=WEEKNO ;! STORE CURRENT WEEK NUMBER CNTBUF(2)=IN ;! NUMBER OF SEPARATE 'JOURNALS' CNTBUF(3)=NSEC ;! SECTOR OF 1ST TABLE ARRAY CNTBUF(4)=ICONC ;! NUMBER OF SEPARATE ITEMS CNTBUF(5)=CSEC ;! SECTOR OF FIRST CONCORDANCE CNTBUF(6)=RSEC ;! LAST RECORD SECTOR CNTBUF(7)=IBST ;! CURRENT POSITION WITHIN RSEC SECTOR=1 WRITEDA(UNIT,SECTOR,CNTBUF(1),CNTBUF(MXCNTB)) ! CLOSEDA(UNIT) ;! CLOSE DISC FILE ! %END ;! WRBUL ! ! ********************************************************************* ! %ROUTINE CONCORD (%INTEGERNAME LINK, %C %INTEGERNAME CURRENT,BLOCK,POSN) 00163100 ! ?? LINK WAS A SHORTINTEGERNAME ! ! THIS ROUTINE CREATES THE NEXT ENTRY IN CONC1,CONC2,CONC3 ! (CURRENT) LINKING IT FORWARD FROM LINK FOR THE RECORDS ! STARTING AT POSN IN BLOCK ON THE STORAGE MEDIUM. ! %IF LINK\=0 %THEN CONC3(LINK)=CURRENT LINK=CURRENT ;! SET CURRENT POINTER CONC1(CURRENT)=BLOCK ;! STORE BLOCK NUMBER CONC2(CURRENT)=POSN ;! STARTING BYTE WITHIN BLOCK CONC3(CURRENT)=0 ;! SET FORWARD LINK TO ZERO CURRENT=CURRENT+1 ;! UPDATE POINTER ! %END ;! CONCORD %END ;! BULLETIN OUTPUT ! !********************************************************************** ! %ROUTINE SDICUMUL OUTPUT (%INTEGER NUM) ! ! THIS ROUTINE IS CALLED TO OUTPUT THE CURRENT RECORD TO THE ! CURRENT WEEK'S SDI FILE AND THE CUMULATIVE FILE. A COUNT IS ! KEPT OF THE NUMBER OF ITEMS PROCESSED UNDER EACH JOURNAL TITLE ! AND THIS INFORMATION IS STORED IN THE STATISTICS FILE, ALONG ! WITH OTHER HOUSEKEEPING DETAILS, FOR FUTURE REFERENCSE. ! %ROUTINESPEC WRSDI (%INTEGERNAME UNIT,BLOCK,POSN,NO) ! ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) ;! STATISTICS 00199200 %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA(%INTEGER CHANNEL,%INTEGERNAME SECT,%C %NAME BEGIN,END) %EXTERNALROUTINESPEC WRITEDA(%INTEGER CHANNEL,%INTEGERNAME SECT,%C %NAME BEGIN,END) ! %OWNINTEGERARRAY NUMBER(1:200) ;! JOURNAL NUMBERS 00222900 !?? SHORT; %OWNINTEGERARRAY NUMTOT(1:200);! ITEM TOTALS BY JOURNAL NO 00223000 %OWNINTEGERARRAY IDENT(1:13)=M'CULH',M'AM L',M'IBRA',M'RY C', 00223100 M'UMUL',M'ATIV',M'E FI',M'LE ',0,0,0,0,0 00223200 %OWNBYTEINTEGERARRAY BUF(1:1000) ;! CUMULATIVE RECORDS O/P BUFFER 00223300 %INTEGERARRAY CNT(1:3) ;! STATS FILE CONTROL BLOCK 00223400 ! %OWNINTEGER TIME=1 ;! ENTRY SWITCH VARIABLE %OWNINTEGER CMBL ;! CUMUL FILE BLOCK POINTER 00223700 %OWNINTEGER CMPS ;! CUMUL FILE POSN POINTER 00223750 %OWNINTEGER NO ;! NUMBER OF JOURNALS ! %INTEGER I ;! LOOP VARIABLE %INTEGER STBL ;! STATS FILE POINTER %INTEGER SDBL ;! SDI FILE BLOCK POINTER 00224200 %INTEGER SDPS ;! SDI FILE POSN POINTER 00224250 %INTEGER LIM ;! TEXT ARRAY LIMIT ! %SWITCH ENTRY (1:3) ! ! THE RECORD IS FIRST PASSED TO THE SDI FILE CONTROL ROUTINE AND ! FURTHER ACTION IS THEN DETERMINED BY THE ENTRY NUMBER. ! %IF NUM=0 %THENC 00171210 %START ;! LAST ENTRY 00171220 %IF TIME=1 %THENC 00171230 %START ;! NO PREVIOUS ENTRIES 00171240 NEWLINES(2) ;! OUTPUT MESSAGES 00171250 PRINTSTRING('SDI FILE NOT ACCESSED') 00171260 NEWLINES(2) 00171270 PRINTSTRING('STATISTICS FILE NOT ACCESSED') 00171280 NEWLINES(2) 00171290 PRINTSTRING('CUMULATIVE FILE NOT ACCESSED') 00171300 %RETURN ;! EXIT FROM ROUTINE 00171310 %FINISH %ELSE TIME=3 ;! SET LAST ENTRY INDICATOR 00171320 %FINISH 00171330 WRSDI (SDUNIT,SDBL,SDPS,TIME) ;! WRITE RECORD TO SDI FILE -> ENTRY(TIME) ;! JUMP TO APPROPRIATE SECTION ! ! FIRST ENTRY - CHECK DETAILS OF CUMULATIVE AND STATISTICS FILE ! ENTRY(1):TIME=2 ;! CHANGE SWITCH VALUE OPENDA(CMUNIT) ;! OPEN CUMULATIVE FILE 00226850 %IF NEWCUM=YES %THENC %START ;! NEW CUMULATION TO BE STARTED IDENT(9)=WEEKNO ;! STORE CURRENT WEEK NUMBER IDENT(10)=INTEGER(ADDR(IRTEXT(33))) ;! AND RANDOM INTEGER CMBL=2 ;! INITIALISE BLOCK AND 00227600 CMPS=1 ;! POSITION POINTERS 00227650 %FINISH %ELSEC %START ;! CONTINUE EXISTING CUMULATION CMBL=1 ;! READ IDENTIFIER BLOCK 00227900 READDA(CMUNIT,CMBL,IDENT(1),IDENT(13)) 00227950 CMBL=IDENT(11) ;! SET NEXT AVAILABLE BLOCK 00228000 CMPS=IDENT(12) ;! AND POSITION POINTERS 00228050 ! ! ARE CHECK BLOCK DETAILS TO BE CHECKED ! %IF CHECK=YES %THENC %START ;! YES - CHECK DETAILS %IF RUN=1 %THENC %START %IF WEEKNO\=IDENT(13)+1 %ANDC WEEKNO-WEEKNO//100*100\=1 %THENC CHECK FAILURE(4,WEEKNO,IDENT(13)) %FINISH %ELSEC %START %IF WEEKNO\=IDENT(13) %THENC CHECK FAILURE(4,WEEKNO,IDENT(13)) %FINISH %FINISH ! ! IF CHECK O.K. OR NO CHECK REQUIRED READ CURRENT BLOCK 00229100 ! %IF CMPS\=1 %THEN READDA(CMUNIT,CMBL,BUF(1),BUF(MXBUFS)) %FINISH ! ! IF THIS IS THE FIRST RUN OF THE WEEK A NEW SET OF STATISTICS ! MUST BE STARTED - THE PREVIOUS INFORMATION IS OVERWRITTEN ! %IF RUN=1 %THENC %START ;! 1ST RUN OF WEEK OPENDA(STUNIT) ;! OPEN STATS FILE 00230550 NO=1 ;! SET MAX JOURNALS TO 1 NUMBER(1)=(NUM&X'FFFFFF')//10 ;! STORE FIRST NUMBER (ROOT) NUMTOT(1)=1 ;! SET TOTAL FOR THIS NUMBER -> WRCUM ;! JUMP TO WRITE TO CUMULATION %FINISH %ELSEC %START ;! 2ND OR SUBSEQUENT RUN STBL=1 ;! READ STATS FILE CONTROL BLOCK 00231200 READDA(STUNIT,STBL,CNT(1),CNT(3)) 00231300 NO=CNT(3) 00231350 STBL=STBL+1 ;! READ JOURNAL NUMBERS FROM READDA(STUNIT,STBL,NUMBER(1),NUMBER(NO)) ;! STATS FILE 00231500 STBL=STBL+1 ;! READ CURRENT TOTALS FROM READDA(STUNIT,STBL,NUMTOT(1),NUMTOT(NO)) ;! STATS FILE 00231700 %FINISH ! ! NORMAL ENTRY - THE TABLE OF JOURNAL NUMBERS IS SEARCHED AND WHEN ! AN EQUAL COMPARE IS FOUND WITH THE CURRENT NUMBER THE TOTAL OF ! ITEMS FOR THAT NUMBER IS INCREMENTED. IF THE NUMBER IS NOT FOUND ! A NEW ENTRY IS MADE IN THE NEXT AVAILABLE POSITION IN THE TABLE. ! ENTRY(2):NUM=(NUM&X'FFFFFF')//10 ;! EXTRACT ROOT NUMBER %CYCLE I=1,1,NO ;! SEARCH TABLE %IF NUM=NUMBER(I) %THEN -> ADDIN ;! JUMP OUT IF FOUND %REPEAT ;! IF NOT FOUND I=NO+1 ;! SET VALUE OF I NO=I ;! SET NEW MAXIMUM NUMBER(I)=NUM ;! STORE NEW NUMBER ADDIN:NUMTOT(I)=NUMTOT(I)+1 ;! INCREMENT APPROPRIATE TOTAL ! ! ADD CURRENT RECORD TO CUMULATIVE FILE BUFFER WHICH IS 00233500 ! WRITTEN TO DISC AS NECESSARY. 00233550 ! WRCUM:%IF CMPS+2*MXDIRC+IRDIRC(2)>MXBUFS %THENC 00234000 %START ;! NEXT RECORD WILL NOT FIT %IF CMPS ENDC %FINISH ! ! CONTROL BLOCK IS NOW COMPLETED AND WRITTEN TO THE CUMULATIVE FILE ! IDENT(11)=CMBL ;! STORE NEXT BLOCK IDENT(12)=CMPS ;! STORE NEXT POSITION IDENT(13)=WEEKNO ;! STORE CURRENT WEEK NUMBER I=1 ;! WRITE TO FIRST BLOCK OF FILE WRITEDA(CMUNIT,I,IDENT(1),IDENT(13)) ! CLOSEDA(CMUNIT) ;! CLOSE CUMULATIVE FILE CLOSEDA(STUNIT) ;! CLOSE STATISTICS FILE ! ! A TERMINATION MESSAGE IS NOW PRINTED GIVING THE TOTAL NUMBER OF ! BLOCKS USED BY THE SDI,STATISTICS AND CUMULATIVE FILES. ! NEWLINES(2) PRINTSTRING( 'SDI FILE COMPLETED TO DATE') NEWLINE PRINTSTRING( 'TOTAL NUMBER OF BLOCKS OCCUPIED ON UNIT') WRITE(SDUNIT,2) PRINTSTRING( ' =') WRITE(SDBL,4) ! NEWLINES(2) PRINTSTRING( 'STATISTICS FILE COMPLETED TO DATE') NEWLINE PRINTSTRING( 'TOTAL NUMBER OF BLOCKS OCCUPIED ON UNIT') WRITE(STUNIT,2) PRINTSTRING( ' =') WRITE(STBL,2) ! NEWLINES(2) PRINTSTRING( 'CUMULATIVE FILE (') WRITE(IDENT(9),4) PRINTSTRING( ' -') WRITE(IDENT(10),10) PRINTSTRING( ' ) COMPLETED TO DATE') NEWLINE PRINTSTRING( 'TOTAL NUMBER OF BLOCKS OCCUPIED ON UNIT') WRITE(CMUNIT,2) PRINTSTRING( ' =') WRITE(CMBL,4) 00239600 ! ! ! ********************************************************************* ! %ROUTINE WRSDI (%INTEGERNAME UNIT,BLOCK,POSN,NO) ! ! THIS ROUTINE CONTROLS THE PHYSICAL HANDLING OF THE CURRENT ! SDI DISC FILE. ON THE FIRST ENTRY (NO=1) THE FILE (UNIT) ! IS OPENED AND THE FIRST RECORD IS OUTPUT. FOR THE LAST ! ENTRY (NO=3) THE CONTROL BLOCK IS SET UP IN SECTOR 1 AND THE ! FILE IS THEN CLOSED. ! ! THE RECORDS ARE PACKED INTO A BUFFER AREA PRIOR TO OUTPUT ! ON RETURN FROM THE ROUTINE BLOCK AND POSN CONTAIN THE SECTOR ! NUMBER AND STARTING POSITION WITHIN THAT SECTOR OF THE ! RECORD JUST WRITTEN. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL, %INTEGERNAME SECT,%C %NAME BEGIN,END) %EXTERNALROUTINESPEC WRITEDA(%INTEGER CHANNEL, %INTEGERNAME SECT,%C %NAME BEGIN,END) ! %OWNBYTEINTEGERARRAY BUFA(1:1000) ;! OUTPUT BUFFER !?? SHORT; %INTEGERARRAY CNTBUF(1:500) ;! POINTER TABLES O/P AREA 00220700 ! %OWNINTEGER SECTOR ;! NEXT SECTOR NUMBER %OWNINTEGER IB ;! BUFFER POINTER ! %INTEGER I ;! LOOP VARIABLE %INTEGER START ;! START POINT IN INTERNAL REC ! %SWITCH ENTRY(1:3) ;! ENTRYPOINT SWITCH ! ! JUMP TO THE APPROPRIATE ENTRYPOINT ! -> ENTRY(NO) ;! JUMP TO REQUIRED ENTRY ! ! FIRST ENTRY - INITIALISE AND OPEN FILE ! ENTRY(1):OPENDA(UNIT) ;! OPEN DIRECT ACCESS FILE ! %IF RUN=1 %THENC %START ;! NEW WEEKS OUTPUT SECTOR=2 ;! SET FIRST FREE SECTOR NO IB=1 ;! SET BUFFER POINTER %FINISH %ELSEC %START ;! CONTINUATION OF CURRENT WEEK SECTOR=1 READDA(UNIT,SECTOR,CNTBUF(1),CNTBUF(MXCNTB)) ! ! CHECK WEEK NUMBER AGREES IF REQUIRED ! %IF CHECK=YES %THENC %START %IF WEEKNO\=CNTBUF(1) %THENC %START I=CNTBUF(1) CHECK FAILURE (2,WEEKNO,I) %FINISH %FINISH %ELSEC WEEKNO=CNTBUF(1) ! SECTOR=CNTBUF(2) ;! SET CURRENT SECTOR NUMBER IB=CNTBUF(3) ;! SET START POSN IN SECTOR ! ! IF CURRENT BLOCK PART FILLED - READ IT FROM DISC ! %IF IB\=1 %THEN READDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFS)) 00225500 %FINISH ! ! USUAL ENTRY ADDS THE CURRENT RECORD TO THE CURRENT OUTPUT ! BUFFER WRITING THE LATTER TO DISC AS NECESSARY. ! ENTRY(2):BLOCK=SECTOR ;! SET CURRENT SECTOR NUMBER POSN=IB ;! SET STARTING POSITION START=1 ;! INITIALISE RECORD POINTER ! DIRC: %CYCLE I=START,1,MXDIRC ;! TRANSFER DIRECTORY BUFA(IB)=BYTEINTEGER(ADDR(IRDIRC(I))) BUFA(IB+1)=BYTEINTEGER(ADDR(IRDIRC(I))+1) IB=IB+2 ;! UPDATE BUFFER POINTER %IF IB >= MXBUFS %THENC %START ;! BUFFER A FULL WRITEDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFS)) IB=1 ;! RESET BUFFER POINTER SECTOR=SECTOR+1 ;! INCREMENT SECTOR NUMBER %FINISH %REPEAT ! TEXT1: START=1 ;! INITIALISE RECORD POINTER TEXT2: %CYCLE I=START,1,IRDIRC(2) ;! TRANSFER TEXT ARRAY BUFA(IB)=IRTEXT(I) IB=IB+1 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFS %THENC %START ;! BUFFER A FULL WRITEDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFS)) IB=1 ;! RESET BUFFER POINTER SECTOR=SECTOR+1 ;! INCREMENT SECTOR NUMBER %FINISH %REPEAT %RETURN ;! EXIT IF TRANSFER COMPLETE ! ! LAST ENTRY - THE LAST RECORD BLOCK MUST BE OUTPUT AND THE ! CONTROL BLOCK SET UP IN SECTOR 1. THE FILE IS THEN CLOSED. ! ENTRY(3):CNTBUF(1)=WEEKNO ;! STORE WEEK NUMBER CNTBUF(2)=SECTOR ;! STORE CURRENT SECTOR NUMBER CNTBUF(3)=IB ;! STORE NEXT POSITION IN SECTOR %IF IB\=1 %THENC %START ;! PART-FILLED BUFFER TO BE O/P ! %CYCLE I=IB,1,MXBUFS ;! CLEAR END OF BUFFER BUFA(I)=0 %REPEAT WRITEDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFS)) %FINISH ! ! THE CONTROL INFORMATION IS THEN WRITTEN TO THE FIRST BLOCK ! BLOCK=SECTOR ;! RETURN MAXIMUM SECTOR NUMBER SECTOR=1 WRITEDA(UNIT,SECTOR,CNTBUF(1),CNTBUF(MXCNTB)) ! CLOSEDA(UNIT) ;! CLOSE DISC FILE ! %END ;! WRSDI %END;!SDICUMUL OUTPUT ! !********************************************************************** ! %ROUTINE CHECK FAILURE (%INTEGER CHECKNO, %INTEGERNAME A1,A2) ! ! WHEN THE OPTION CHECK=YES IS SPECIFIED THIS ROUTINE WILL BE ! CALLED IF ANY OF THE ITEMS CHECKED FAIL TO MATCH. THE ! APPROPRIATE MESSAGE IS OUTPUT AND THE JOB TERMINATED. ! %SWITCH J10(1:10) ! NEWLINES(2) PRINTSTRING('*** CHECK FAILURE ***') NEWLINES(2) ! -> J10(CHECKNO) ! J10(1): PRINTSTRING('BULLETIN FILE') -> L1 ! J10(2): PRINTSTRING('SDI FILE') -> L1 ! J10(3): PRINTSTRING('STATISTICS FILE') -> L1 ! L1: PRINTSTRING(' - WEEK NUMBER DOES NOT MATCH') L2: NEWLINE 00261100 PRINTSTRING( 'CURRENT WEEK NUMBER') WRITE(A1,4) 00261300 NEWLINE PRINTSTRING( 'WEEK NUMBER IN FILE') WRITE(A2,4) 00261600 -> L99 ! J10(4): PRINTSTRING('CUMULATIVE FILE NOT ACCEPTABLE') 00261900 -> L2 00262000 ! L99: NEWLINES(2) PRINTSTRING( '*** JOB TERMINATED ***') %STOP %END;!CHECK FAILURE ! ! ********************************************************************* ! %ROUTINE SET(%BYTEINTEGERARRAYNAME A,%INTEGER START,END,VAL) ! ! ROUTINE SETS A(START) TO A(END) TO THE LEAST SIGNIFICANT EIGHT ! BITS OF THE VALUE HELD IN VAL. ! %INTEGER I ! %CYCLE I=START,1,END A(I)<-VAL %REPEAT %END ;! SET ! ! ********************************************************************* ! %INTEGERFN CONV(%BYTEINTEGERARRAYNAME A,%INTEGER IA,L) ! ! FUNCTION CALCULATES THE INTEGER VALUE OF THE L DIGITS IN THE ! ARRAY A STARTING AT A(IA). ! %INTEGER SUM,I ! SUM=0 %CYCLE I=0,1,L-1 SUM = 10*SUM+(A(IA+I)&X'0F') %REPEAT %RESULT=SUM %END;! CONV %ENDOFPROGRAM