%BEGIN %CONTROL 0 ! %INTEGERARRAY STJNUM(1:256) ;! JOURNAL NUMS IN CURRENT SDI 00000300 !?? SHORT; %OWNINTEGERARRAY STIPCT(1:256);! NO OF I/P ITEMS PER JOURNAL 00000400 !?? SHORT; %OWNINTEGERARRAY STOPCT(1:256);! NO OF THESE ITEMS DISTRD. 00000500 !?? SHORT; %OWNINTEGERARRAY STUSCT(1:256);! NO OF USERS RECEIVING ITEMS 00000600 %OWNBYTEINTEGERARRAY STUSMK(1:256) ;! MARKER ARRAY 00000650 ! %INTEGER CSUNIT ;! STATS CUMULATION FILE UNIT NO %INTEGER MXSTJN ;! NO OF DIFF JOURNAL NUMS I/P %INTEGER NEWSTS ;! NEW STATS FILE INDICATOR %INTEGER WEEKNO ;! WEEK NUMBER ! %OWNINTEGER MXNUMB=1024 ;! MAX SIZE OF JOURN NO ARRAY 00001300 %OWNINTEGER STUSOP ;! TOTAL NO OF COPIES DISTRIB 00001350 %OWNINTEGER STUSSV ;! NO OF USERS RECEIVING ITEMS %OWNINTEGER STUSTL ;! NO OF USERS IN SYSTEM %OWNINTEGER YES=1 ;! CONSTANT ! %BEGIN 00001800 ! ! ********************************************************************* ! ! PRODUCE SDI 00002800 ! 00002825 ! ********************************************************************* 00002850 ! 00002875 %ROUTINESPEC READ CONTROL 00000150 %ROUTINESPEC CREATE PROFILES (%INTEGERNAME PISTRM,MAX, %C 00000300 %BYTEINTEGERARRAYNAME PROFIL) 00000350 %ROUTINESPEC READ PROFILES (%INTEGERNAME UNIT,MAX, %C 00000400 %BYTEINTEGERARRAYNAME PROF) 00000450 %ROUTINESPEC READ STATISTICS (%INTEGER STUNIT, %INTEGERNAME MXSTJN) 00003100 %ROUTINESPEC GETSDI (%INTEGERNAME UNIT,BLOCK,POSN,NO) %ROUTINESPEC MARKKEYWDS (%BYTEINTEGERARRAYNAME TEXT, %C %INTEGER KP,KL, %INTEGERNAME N) 00000600 !?? KP,KL WERE SHORTINTEGERS %ROUTINESPEC MARKTITWDS(%BYTEINTEGERARRAYNAME TEXT, %C %INTEGER ST,LT, %INTEGERNAME N) 00000800 !?? ST,LT WERE SHORTINTEGERS %ROUTINESPEC SORT(%BYTEINTEGERARRAYNAME AX, %INTEGERARRAYNAME PTR,N, %C %INTEGER P1,P2) %INTEGERFNSPEC LEXISIGN(%BYTEINTEGERARRAYNAME B1,%INTEGER S1,L1, %C 00001430 %BYTEINTEGERARRAYNAME B2,%INTEGER S2,L2) 00001460 %ROUTINESPEC SCAN PROFILES %ROUTINESPEC PRINT SDI 00001230 %ROUTINESPEC WRITE PROFILES (%INTEGER UNIT,MAX, %C 00001600 %BYTEINTEGERARRAYNAME PROF) 00001650 %ROUTINESPEC COPYTEXT(%BYTEINTEGERARRAYNAME SOURCE,%INTEGER SSTRT, %C 00001360 %BYTEINTEGERARRAYNAME DEST, %INTEGER DSTRT,L) 00001380 %INTEGERFNSPEC CONV(%BYTEINTEGERARRAYNAME A, %INTEGER IA,L) 00002100 ! %INTEGERARRAY MJNUMB(1:1024) ;! MASTER JOURNAL TITLE NUMBERS 00004900 %INTEGERARRAY TBGN(1:250) ;! POINTERS TO START OF TERMS %INTEGERARRAY TLNG(1:250) ;! LENGTH OF TERMS %INTEGERARRAY TSPS(1:250) ;! SPACES TO FOLLOW TERMS ON O/P 00002750 ! !?? SHORT; %INTEGERARRAY IRDIRC(1:32) ;! INTERNAL RECORD DIRECTORY !?? SHORT; %INTEGERARRAY MJBPTR(1:1024) ;! PTR TO JOURN TITLE BLOCK 00005500 !?? SHORT; %INTEGERARRAY MJPPTR(1:1024) ;! PTR TO POSN WITHIN BLOCK 00005600 !?? SHORT; %INTEGERARRAY REFB(1:1000) ;! BLOCK REFERENCES !?? SHORT; %INTEGERARRAY REFP(1:1000) ;! POSN REFERENCES !?? SHORT; %INTEGERARRAY REFC(1:1000) ;! REFERENCE LINKAGES !?? SHORT; %INTEGERARRAY USER(1:100) ;! USERS REQUIRING DIAGNOSTICS 00003850 ! %BYTEINTEGERARRAY IRTEXT(1:500) ;! INTERNAL TEXT RECORD %BYTEINTEGERARRAY PROFIL (1:22000) ;! USERS PROFILES %BYTEINTEGERARRAY PRTEXT (1:500) ;! TEXT OF CURRENT RECORD ! %INTEGER ALL ;! INDICATES FULL DIAGNOSTICS 00004350 %INTEGER CHECK ;! CHECKING INDICATOR %INTEGER COSTRM ;! COMMON WDS I/P STREAM NO 00004500 %INTEGER D ;! DIAGNOSTIC SWITCH VALUE 00004550 %INTEGER DIAGNS ;! DIAGNOSTIC PRINT INDICATOR 00004150 %INTEGER DISP ;! DISPLACEMENT OF NEXT RECORD %INTEGER DUSER ;! NO USERS REQUIRING DIAGNS 00004950 %INTEGER ENO ;! NO OF ENTRIES IN PROFILE %INTEGER I ;! LOOP VARIABLE %INTEGER ID ;! POINTER TO IRDIRC ARRAY 00007500 %INTEGER IP ;! POINTER TO PROFILE ARRAY %INTEGER IT ;! POINTER TO IRTEXT ARRAY 00007700 %INTEGER J ;! LOOP VARIABLE %INTEGER LASTPS ;! NEXT AVAILABLE POSN IN LASTSEC %INTEGER LASTSEC ;! LAST SECT OCCUPIED ON M/JRN %INTEGER LIM ;! LOOP LIMIT %INTEGER LSUNIT ;! O/P LIST UNIT 00005150 %INTEGER MAX ;! LIMIT OF PROF ARRAY USED 00005750 %INTEGER MAXN ;! NUMBER OF MASTER JOURN TITLES 00004900 %INTEGER MJUNIT ;! MASTER JOURNAL TITLE UNIT 00005250 %INTEGER MXBUFS ;! MAX BUFFER SIZE %INTEGER MXCNTB ;! CONTROL BUFFER 00005850 %INTEGER MXDIRC ;! SIZE OF INT RECORD DIRECTORY 00005200 %INTEGER MXLINE ;! MAXIMUM O/P LINE LENGTH 00008850 %INTEGER NJNO ;! NO OF NEW JOURN TITLES I/P %INTEGER NO ;! ENTRYPOINT INDICATOR 00005450 %INTEGER NT ;! CURRENT NUMBER OF TERMS 00005600 %INTEGER PDSP ;! WD CONTAINING DISPLACEMENT %INTEGER PDUNIT ;! PROFILE DISC NUMBER %INTEGER PISTRM ;! PROFILE I/P STREAM NUMBER 00007000 %INTEGER PNXP ;! WD POINTING TO NEXT PROFILE %INTEGER PNXU ;! WD POINTING TO NEXT USER %INTEGER PRLENG ;! PROFILE LENGTH %INTEGER SDBL ;! CURRENT SDI BLOCK %INTEGER SDPS ;! CURRENT SDI POSITION %INTEGER SDUNIT ;! CURRENT WEEKS SDI I/P FILE 00006430 %INTEGER STUNIT ;! CURRENT WEEKS STATS I/P FILE 00006460 %INTEGER UNBL ;! USER NAME/ADDR BLOCK PTR %INTEGER UNPS ;! USER NAME/ADDR POSN PTR %INTEGER UPDPROF ;! PROFILES UPDATE INDICATOR 00006650 %INTEGER USERNO ;! USER NUMBER 00008250 %INTEGER USUNIT ;! USER NAME/ADDR FILE UNIT NO 00006675 ! %OWNINTEGER END=0 ;! END INDICATOR %OWNINTEGER ENDAUT=',' ;! AUTHOR TERMINATOR SYMBOL 00007050 %OWNINTEGER MXNAME=500 ;! MAX SIZE OF USER NAME/ADDR 00008850 %OWNINTEGER MXTITL=500 ;! MAX SIZE OF JOURNAL TITLE 00009200 %OWNINTEGER ONE=1 ;! CONSTANT 00007450 %OWNINTEGER PA=11 ;! POINTER TO AUTHOR DETS %OWNINTEGER PB=15 ;! POINTER TO BIB. DETS 00009330 %OWNINTEGER PD=21 ;! POINTER TO END OF LANG DETS 00009360 %OWNINTEGER PK=27 ;! POINTER TO KEYWORDS 00007550 %OWNINTEGER PN=17 ;! POINTER TO ADDITIONAL NOTE 00009450 %OWNINTEGER PR=5 ;! POINTER TO REFERENCE 00010000 %OWNINTEGER PT=9 ;! POINTER TO TITLE 00007650 %OWNINTEGER PX=23 ;! POINTER TO SPECIAL JOURN TITLE00009650 ! %BYTEINTEGER CODE ;! CODE OF CURRENT RECORD ! %OWNBYTEINTEGER AC='A' ;! AUTHOR CODE (POSITIVE) %OWNBYTEINTEGER BC='B' ;! AUTHOR CODE (NEGATIVE) %OWNBYTEINTEGER BLNK=' ' ;! BLANK %OWNBYTEINTEGER JC='J' ;! JOURNAL CODE (NEGATIVE) %OWNBYTEINTEGER KC='K' ;! JOURNAL CODE (POSITIVE) %OWNBYTEINTEGER MC='-' ;! SECONDARY 'NOT' CODE %OWNBYTEINTEGER NC='N' ;! PRIMARY 'NOT' CODE %OWNBYTEINTEGER NINE='9' ;! MAXIMUM NUMERIC CODE 00013200 %OWNBYTEINTEGER NL=X'0A' ;! NEWLINE SYMBOL %OWNBYTEINTEGER PC='+' ;! 'AND' CODE %OWNBYTEINTEGER RS='/' ;! RECORD SEPERATOR CHARACTER %OWNBYTEINTEGER SC='*' ;! END OF PROFILE CODE %OWNBYTEINTEGER SMA=X'61' ;! LOWER CASE A 00009130 %OWNBYTEINTEGER SMC=X'63' ;! LOWER CASE C 00009160 %OWNBYTEINTEGER SMK='@' ;! SEQUENCE MARK %OWNBYTEINTEGER SMZ=X'7A' ;! LOWER CASE Z 00009250 %OWNBYTEINTEGER TWO='2' ;! MINIMUM NUMERIC CODE 00014000 %OWNBYTEINTEGER UC='%' ;! USER RECORD CODE %OWNBYTEINTEGER XC='X' ;! SINGLE PROFILE RECORD CODE %OWNBYTEINTEGER ZC='Z' ;! START OF PROFILE CODE ! 00011830 %SWITCH S1,S2,S3 (0:1) ;! DIAGNOSTIC PRINT SWITCHES 00011860 ! COSTRM=7 CSUNIT=60 ;! CUMULATED STATS 00013550 LSUNIT=99 ;! O/P LISTING 00013650 MJUNIT=10 00012720 PDUNIT=30 00012830 PISTRM=98 00012700 SDUNIT=20 00012800 STUNIT=40 00012840 USUNIT=50 00012850 MXDIRC=32 MXCNTB=500 00014230 MXBUFS=1000 00014260 READ CONTROL %IF UPDPROF=YES %THEN CREATE PROFILES (PISTRM,MAX,PROFIL) %C 00012800 %ELSE READ PROFILES (PDUNIT,MAX,PROFIL) 00012850 %IF DIAGNS=YES %THEN D=1 %ELSE D=0 00014800 READ STATISTICS (STUNIT,MXSTJN) 00016300 ! NXIT:GETSDI(SDUNIT,SDBL,SDPS,NO) -> S1(D) ;! PRINT DIAGNOSTICS IF REQ 00015650 S1(1): NEWLINES(2) ;! ............................. 00015700 %CYCLE I=1,1,MXDIRC ;! .............................. WRITE(IRDIRC(I),3) ;! ............................. %REPEAT ;! ............................. NEWLINE ;! ............................. %CYCLE I=1,1,IRDIRC(2) ;! ............................. %IF IRTEXT(I)<32 %THEN WRITE(IRTEXT(I),2) %ELSEC PRINT SYMBOL(IRTEXT(I)) %REPEAT 00016450 S1(0):NT=0 00012900 MARKKEYWDS(IRTEXT,IRDIRC(PK),IRDIRC(PK+1),NT) MARKTITWDS(IRTEXT,IRDIRC(PT),IRDIRC(PT+1),NT) -> S2(D) ;! PRINT DIAGNOSTICS IF REQ 00016950 S2(1): NEWLINES(2) ;! ............................. 00017000 PRINTSTRING('UNSORTED') ;! .......................... %CYCLE I=1,1,NT ;! ............................. NEWLINE ;! ............................. WRITE(TBGN(I),6) ;! ............................. WRITE(TLNG(I),6) ;! ............................. %REPEAT ;! ............................. S2(0):SORT(IRTEXT,TBGN,TLNG,1,NT) 00013200 -> S3(D) ;! PRINT DIAGNOSTICS IF REQ 00017880 S3(1): NEWLINES(2) ;! ............................. 00017900 PRINTSTRING('SORTED') ;! .......................... %CYCLE I=1,1,NT ;! ............................. NEWLINE ;! ............................. WRITE(TBGN(I),6) ;! ............................. WRITE(TLNG(I),6) ;! ............................. %REPEAT ;! ............................. S3(0):SCAN PROFILES 00013300 -> NXIT %UNLESS NO=3 ! PRINT SDI ! %IF UPDPROF=YES %THEN WRITE PROFILES (PDUNIT,MAX,PROFIL) 00015000 ! ! ! ********************************************************************* ! %ROUTINE GETSDI(%INTEGERNAME UNIT,BLOCK,POSN,NO) ! ! THIS ROUTINE CONTROLS THE INTERFACE BETWEEN THE PROCESSING ! ROUTINE AND THE CURRENT S.D.I. FILE. THE NEXT RECORD IS ! TRANSFERRED FROM THE DISC(UNIT) TO THE DIRECTORY AND TEXT ! ARRAYS AS REQUIRED. ON EXIT FROM THE ROUTINE BLOCK IS SET ! TO THE SECTOR NUMBER CONTAINING THE START OF THIS RECORD AND ! POSN IS SET TO THE BYTE POSITION WITHIN THIS SECTOR OF THE ! START OF THE RECORD. NO IS SET TO 1 AFTER THE FIRST ENTRY ! TO RDSDI AND THEREAFTER TO 2 UNTIL THE LAST RECORD IS ! TRANSMITTED WHEN IT IS SET TO 3. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA(%INTEGER CHANNEL, %INTEGERNAME SECT,%C %NAME BEGIN,END) %OWNBYTEINTEGERARRAY BUFA (1:1024) ;! 1ST INPUT BUFFER !?? SHORT; %INTEGERARRAY CNTBUF(1:MXCNTB) ;! CONTROL BLOCK I/P AREA 00016500 ! %OWNINTEGER IB=1 ;! BUFFER POINTER %OWNINTEGER NUM=1 ;! ENTRYPOINT CONTROL %OWNINTEGER SECTOR=2 ;! CURRENT SECTOR NUMBER ! %INTEGER I ;! LOOP VARIABLE %INTEGER SECT ;! SECTOR TO BE READ FROM DISC %INTEGER START ;! START POS IN INTERNAL REC ! %SWITCH ENTRY(1:3) ;! ENTRYPOINTS ! ! JUMP TO APPROPRIATE ENTRYPOINT ! -> ENTRY(NUM) ! ! 1ST ENTRY - OPEN FILE AND READ CONTROL BLOCK (SECTOR=1). IF ! REQUIRED CHECK THE WEEK NUMBER, SET UP BOUBLE BUFFERING. ! ENTRY(1):OPENDA(UNIT) ;! OPEN FILE SECT=1 ;! READ CONTROL BLOCK READDA(UNIT,SECT,CNTBUF(1),CNTBUF(MXCNTB)) 00018900 SECT=2 ;! FILL FIRST BUFFER READDA(UNIT,SECT,BUFA(1),BUFA(MXBUFS)) 00019100 %IF CHECK=YES %THENC %START ;! WEEK NUMBER CHECK %IF WEEKNO\=CNTBUF(1) %THENC %START ;! INVALID WEEK NUMBER NEWLINE ;! O/P MESSAGE PRINTSTRING('WEEK NUMBERS DO NOT AGREE') NEWLINE PRINTSTRING('WEEK') WRITE(WEEKNO,4) PRINTSTRING(' REQUESTED') NEWLINE PRINTSTRING('WEEK') WRITE(CNTBUF(1),4) PRINTSTRING(' ON THIS DISC') NEWLINES(2) PRINTSTRING('... JOB TERMINATED ...') %STOP ;! TERMINATE JOB %FINISH %FINISH %ELSEC WEEKNO=CNTBUF(1) ;! SET WEEK NUMBER OF FILE 00028400 LASTSEC=CNTBUF(2) ;! SET LAST SECTOR NUMBER 00028500 LASTPS=CNTBUF(3) ;! AND POSITION WITHIN IT 00028600 NUM=2 ;! CHANGE ENTRYPOINT NO=1 ;! SET FIRST ENTRY INDICATOR -> ENTRY2 ! ! NORMAL ENTRY - THE NEXT RECORD IS TRANSFERRED FROM THE CURRENT ! BUFFER TO THE DIRECTORY AND TEXT ARRAYS IN THE CALLING ROUTINE ! THE BUFFERS BEING REFILLED AS NECESSARY. ! ENTRY(2):NO=2 ;! SET INDICATOR TO NORMAL ENTRY2: BLOCK=SECTOR ;! RETURN CURRENT SECTOR POSN=IB ;! RETURN START POSITION START=1 ;! SET STARTING POINT IN RECORD ! %CYCLE I=1,1,MXDIRC ;! TRANSFER TO DIRECTORY IRDIRC(I)=INTEGER(ADDR(BUFA(IB))); !?? WAS SHORT IB=IB+2 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFS %THENC %START ;! END OF BUFFER REACHED SECTOR=SECTOR+1 ;! CALC NEXT SECTOR NUMBER READDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFS)) IB=1 ;! RESET BUFFER POINTER %FINISH %REPEAT ! %CYCLE I=1,1,IRDIRC(2) ;! TRANSFER TO TEXT ARRAY IRTEXT(I)=BUFA(IB) IB=IB+1 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFS %THENC %START ;! END OF BUFFER REACHED SECTOR=SECTOR+1 ;! CALC NEXT SECTOR NUMBER READDA(UNIT,SECTOR,BUFA(1),BUFA(MXBUFS)) IB=1 ;! RESET BUFFER POINTER %FINISH %REPEAT ! ! BEFORE RETURNING CONTROL THE ROUTINE CHECKS FOR END OF FILE ! RETRN:%IF SECTOR END(NO) ;! EXIT IF END OF FILE %IF TYPE\=1 %THEN -> NOTP(NO) ;! JUMP IF NOT START OF USER 00043200 WRUNA(USUNIT,UNBL,UNPS,PRTEXT,PRLENG,NO) ;! WRITE DETS TO DISC 00034400 NO=2 ;! ENSURE SWITCH CORRECTLY SET -> NOTP(1) ;! READ NEXT RECORD ! ! THE PROFILE IS ANALYSED AND THE INTERNAL PROFILE FOR THIS USER ! IS CREATED FROM THE INPUT DETAILS ! NOTP(2):MARKPTERMS(PRTEXT,2,PRLENG,NT) ;! SET POINTERS TO TERMS 00032300 SORT(PRTEXT,TBGN,TLNG,1,NT) ;! SORT TERMS TO ASCENDING ORDER -> ENTER(ECODE) ;! JUMP TO ENTER DETAILS ! ! NEW USER - LINK FORWARD FROM PREVIOUS PROFILE (OMITTED FOR FIRST ! ENTRY ONLY), STORE REFERENCE TO USER NAME AND ADDRESS DETAILS ! (KEPT ON DISC) AND SET UP OTHER HEADER INFORMATION. 00044600 ! ENTER(1):INTEGER(ADDR(PROFIL(PNXU)))=IP ENTER(0):INTEGER(ADDR(PROFIL(IP)))=UNBL; !?? WAS SHORT INTEGER(ADDR(PROFIL(IP+2)))=UNPS; !?? WAS SHORT PNXU=IP+4 ;! STORE POSN OF PTR TO NEXT USER INTEGER(ADDR(PROFIL(IP+8)))=0 ;! ZEROISE CONCORDANCE POINTERS 00045200 INTEGER(ADDR(PROFIL(IP+12)))=0 ;! FOR SDI REFERENCES IP=IP+16 ;! UPDATE PROFILE POINTER ! ! START OF NEW PROFILE ! ENTER(2):PNXP=IP ;! SET CURRENT PTR TO PROF LINK 00045800 IP=IP+4 ;! UPDATE POINTER ! ! NEXT RECORD - DETAILS EXTRACTED AND STORED ! ENTER(3):PROFIL(IP)=PRTEXT(1) ;! STORE RECORD TYPE CODE PROFIL(IP+1)=NT ;! STORE NUMBER OF TERMS IP=IP+2 ;! UPDATE POINTER %IF TYPE=3 %OR TYPE=5 %THENC %START ;! MORE RECORDS FOLLOW PDSP=IP ;! SET DISPLACEMENT POINTER IP=IP+2 ;! ALLOW SPACE FOR THIS %FINISH %CYCLE I=1,1,NT ;! MOVE TERMS TO PROFILE PROFIL(IP)=TLNG(I) ;! EACH PRECEDED BY ITS LENGTH COPYTEXT(PRTEXT,TBGN(I),PROFIL,IP+1,TLNG(I)) IP=IP+TLNG(I)+1 ;! UPDATE POINTER %REPEAT ! %IF TYPE=3 %OR TYPE=5 %THENC %START ;! PROFILE NOT YET COMPLETE 00047800 IP=ALIGN(IP,2)+1 ;! ALIGN IP TO 1/2 WORD INTEGER(ADDR(PROFIL(PDSP)))=IP-PDSP; !?? WAS SHORT ECODE=3 ;! SET SWITCH VARIABLE -> NOTP(1) ;! READ NEXT RECORD %FINISH ;! PROFILE COMPLETE 00048300 IP=ALIGN(IP,4)+1 ;! ALIGN IP ON FULL WORD %IF NXTYPE=1 %THENC %START ;! LAST RECORD FOR THIS USER ECODE=1 ;! SET SWITCH IN READINESS INTEGER(ADDR(PROFIL(PNXP)))=0 ;! SET LAST PROFILE INDIC %FINISH %ELSEC %START ;! MORE PROFILES FOR THIS USER ECODE=2 ;! SET SWITCH VARIABLE INTEGER(ADDR(PROFIL(PNXP)))=IP %FINISH -> NOTP(1) ;! JUMP TO FETCH NEXT RECORD ! ! END OF FILE FOUND BEFORE ANY VALID RECORD READ ! END(1):NEWLINES(3) PRINTSTRING('NO VALID PROFILE FOUND IN FILE - JOB TERMINATED') %STOP ! ! NORMAL END OF FILE - LAST ENTRY TO DISC O/P ROUTINE TO TIDY ! END(2):NO=3 WRUNA(USUNIT,UNBL,UNPS,PRTEXT,PRLENG,NO) ;! CLOSE FILE 00041600 INTEGER(ADDR(PROFIL(PNXU)))=0 ;! MARK END OF PROFILES %RETURN ! ! ********************************************************************* ! %ROUTINE MARKPTERMS(%BYTEINTEGERARRAYNAME ARR, %INTEGER ST,MAX, %C 00039400 %INTEGERNAME NT) ! ! ROUTINE TO MARK START AND LENGTH OF VALID TERMS IN I/P PROFILE 00039700 ! %ROUTINESPEC MARKPTERM (%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C 00039900 %INTEGERNAME ST,LN,IA) %INTEGER NB ;! START OF WORD %INTEGER NL ;! LENGTH OF WORD ! NT=0 ;! ZEROISE WORD POINTER MKTM:MARKPTERM(ARR,MAX,NB,NL,ST) 00040500 %IF NB=0 %THEN %RETURN ;! RETURN WHEN END REACHED NT=NT+1 ;! UPDATE WORD POINTER TBGN(NT)=NB TLNG(NT)=NL ;! STORE WORD DETAILS -> MKTM ! ! ********************************************************************* ! %ROUTINE MARKPTERM(%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C 00041400 %INTEGERNAME ST,LN,IA) ! ! THIS ROUTINE FINDS THE START AND LENGTH OF THE NEXT SEQUENCE OF ! NON-BLANK CHARACTERS IN THE ARRAY ARR(MXA) STARTING FROM THE ! POSITION IA. IF A SEQUENCE IS FOUND, ST IS SET TO THE VALUE OF ! IA WHEN THE FIRST CHARACTER IS FOUND, LN IS SET TO THE LENGTH OF ! THE SEQUENCE. ON EXIT IA POINTS IMMEDIATELY PAST THE LAST CHAR. ! %INTEGER IND ;! SWITCH VARIABLE %BYTEINTEGER DEL ;! DELIMITER CHARACTER %SWITCH S1,S2(1:2) ! DEL=' ' ;! NORMAL DELIMITER IS BLANK ST=0 ;! SET START VALUE TO ZERO IND=1 ;! SET SWITCH VARIABLE -> CHCK ;! JUMP TO CHECK FIRST CHAR ! S1(1):S2(2):IA=IA+1 ;! INCREMENT POINTER CHCK:%IF IA > MXA %THENC %START ;! END OF ARRAY REACHED %IF ST=0 %THEN %RETURN ;! ERROR EXIT IF NO WORD FOUND -> S1(2) ;! ELSE SET LENGTH ETC. %FINISH %IF ARR(IA)=DEL %THEN -> S1(IND) ;! JUMP IF DELIMITER FOUND -> S2(IND) ;! TO S1 ELSE JUMP TO S2 ! ! WHEN FIRST NON-BLANK FOUND THE SWITCH VARIABLE IS ALTERED SO THAT ! THE NEXT DELIMITER FOUND ACTS AS A TERMINATOR. ! S2(1):IND=2 ;! CHANGE INDICATOR %IF ARR(IA)=SMK %THENC %START ;! START SEQ MARK FOUND DEL=SMK ;! DELIMITER IS RESET ST=IA+1 ;! START ADDRESS IS SET %FINISH %ELSE ST=IA -> S1(1) ;! CONTINUE ! ! THE FIRST DELIMITER FOUND TERMINATES THE CURRENT TERM ! S1(2):LN=IA-ST ;! SET LENGTH OF WORD %IF DEL\=' ' %THEN IA=IA+1 ;! MOVE IA PAST DELIM IF NEC ! %END ;! MARKPTERM 00045700 ! %END ;! MARKPTERMS 00045900 ! ! ********************************************************************* ! %ROUTINE FETCH PROFILE (%INTEGER UNIT, %BYTEINTEGERARRAYNAME TEXT, %C %INTEGERNAME LENG,TYPE,NXTYPE,EOF) ! ! THIS ROUTINE READS THE NEXT RECORD FROM THE INPUT UNIT, CHECKS ! THE VALIDITY OF THE CODE, SETS THE RECORD TYPE AND RETURNS IT ! TO THE CALLING ROUTINE ! %INTEGER IT ;! POINTER TO ARRAY TEXT %OWNINTEGER ENO=1 ;! ENTRY POINT INDIC %BYTEINTEGER CODE ;! CODE LETTER OF CURRENT RECORD %OWNBYTEINTEGER NXCD ;! CODE OF FOLLOWING RECORD ! %SWITCH ENTRY(1:2) ;! ENTRY SWITCH ! -> ENTRY(ENO) ;! JUMP TO REQUIRED ENTRY 00059600 ! ENTRY(1):ENO=2 ;! RESET SWITCH VARIABLE READ SYMBOL(NXCD) ;! SET NEXT CODE ENTRY(2):%IF UNIT\=0 %THEN SELECT INPUT(UNIT) SETC:CODE=NXCD ;! SET CODE CHARACTER %IF CODE=UC %THENC %START ;! USER NAME/ADDR CARDS %IF NEXT SYMBOL=UC %THENC %START ;! END OF PROFILES FOUND EOF=1 ;! SET FILE END INDICATOR %RETURN %FINISH TEXT(1)=BLNK ;! CLEAR FIRST CHARACTER %FINISH %ELSEC %START ;! NON-USER CARD TEXT(1)=CODE ;! STORE CODE IN RECORD %FINISH IT=2 ;! SET POINTER RDSM:READ SYMBOL (TEXT(IT)) ;! READ NEXT CHARACTER %IF TEXT(IT)=NL %THENC %START ;! NEWLINE FOUND %IF NEXT SYMBOL \= BLNK %THEN -> DECI %IF CODE=UC %THEN IT=IT+1 %FINISH %ELSE IT=IT+1 ;! UPDATE POINTER -> RDSM ! DECI:IT=IT-1 ;! REMOVE TRAILING BLANKS %IF TEXT(IT)=BLNK %THEN -> DECI LENG=IT ;! SET LENGTH READ SYMBOL(NXCD) ;! READ CODE OF NEXT RECORD ! ! TYPE MUST NOW BE CALCULATED FROM THE CODE CHARACTERS ! %IF CODE =PC %THENC %START ;! + CODE 00063100 %IF NXCD\=PC %AND NXCD\=NC %THENC %START ;! LAST + CARD OF PROFILE CODE=SC ;! SET * CODE TYPE=4 ;! SET TYPE %FINISH %ELSE TYPE=5 -> NTYP %FINISH ! %IF CODE=ZC %THENC %START ;! Z CODE %IF NXCD\=PC %AND NXCD\=NC %THENC %START ;! IF SINGLE RECORD 00064300 CODE=XC ;! CHANGE CODE TO X TYPE=2 ;! SET TYPE %FINISH %ELSE TYPE=3 -> NTYP %FINISH ! %IF CODE=NC %THENC %START ;! N CODE TYPE=4 ;! ALWAYS TYPE 4 -> NTYP %FINISH ! %IF CODE=AC %OR CODE =JC %THENC %START ;! CODE A OR J TYPE=2 ;! SET TYPE 2 %IF TEXT(2)=PC %OR TEXT(2)=MC %THENC %START ;! + OR - FOLLOWS CODE %IF CODE=AC %AND TEXT(2)=MC %THEN CODE=BC %IF CODE=JC %AND TEXT(2)=PC %THEN CODE=KC TEXT(2)=BLNK ;! CLEAR COL 2 %FINISH -> NTYP %FINISH ! %IF CODE=UC %THENC %START ;! % CODE TYPE=1 ;! SET TYPE -> NTYP %FINISH ! %IF TWO<=CODE<=NINE %THENC %START TYPE=3 ;! NUMERIC CODE SET TYPE -> NTYP %FINISH ! ! UNRECOGNISABLE CODE - PRINT RECORD WITH MESSAGE ! NEWLINES(2) PRINTSTRING('CODE NOT RECOGNISED - PROFILE RECORD IGNORED') NEWLINE %CYCLE IT=1,1,LENG PRINT SYMBOL(TEXT(IT)) %REPEAT -> SETC ;! JUMP TO CHECK NEXT ! ! CODE IS RESTORED TO ARRAY AND NEXT TYPE SET BEFORE RETURNING ! NTYP:%IF CODE\=UC %THEN TEXT(1)=CODE %IF NXCD=UC %THEN NXTYPE=1 %ELSE NXTYPE=0 ! %END ;! FETCH PROFILE ! ! ********************************************************************* ! %INTEGERFN ALIGN (%INTEGER PTR,WIDTH) ! ! ROUNDS THE PTR UP TO THE NEXT MULTIPLE OF WIDTH - THE VALUE ! OF WHICH MUST BE A POWER OF 2. ! %RESULT=(PTR-1)!(WIDTH-1)+1 %END ;! ALIGN ! ! ********************************************************************* ! %ROUTINE WRUNA (%INTEGERNAME UNIT,BLOCK,POSN, %C %BYTEINTEGERARRAYNAME FROM, %INTEGER LENG,NO) ! ! ROUTINE WRITES THE RECORD OF LENGTH 'LENG' FROM THE ARRAY 'FROM' ! TO THE NEXT AVAILABLE POSITION ON DISC 'UNIT'. THE 'BLOCK' AND ! 'POSN' OF THE START POINT ARE RETURNED TO THE CALLING ROUTINE. ! A RECORD IS ALWAYS CONTAINED IN A SINGLE BLOCK FOR SPEED WHEN ! READING THE RECORDS BACK IN RANDOM ORDER. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC WRITEDA (%INTEGER CHANNEL,%INTEGERNAME BLOCK, %C %NAME BEGIN,END) ! %OWNINTEGER IB=1 ;! POINTER TO CURRENT BLOCK %OWNINTEGER IP=1 ;! POINTER TO CURRENT POSITION %OWNBYTEINTEGERARRAY BUF(1:1000) ;! OUTPUT AREA 00072500 %INTEGER I ;! LOOP VARIABLE %SWITCH ENTRY(1:3) 00065150 ! -> ENTRY(NO) ! ENTRY(1):OPENDA(UNIT) ! ENTRY(2):%IF IP+LENG+1 > MXBUFS %THENC %START ;! BUFFER FULL - WRITE TO FILE 00073400 WRITEDA(UNIT,IB,BUF(1),BUF(MXBUFS)) 00065900 IB=IB+1 ;! INCREMENT BLOCK POINTER IP=1 ;! RESET POSITION POINTER %FINISH BLOCK=IB ;! RETURN BLOCK AND POSITN PTRS POSN=IP ;! TO CURRENT RECORD BUF(IP)=LENG>>8&X'FF' ;! LENGTH OF RECORD IS STORED BUF(IP+1)<-LENG ;! IN FIRST TWO BYTES POINTED TO IP=IP+1 %CYCLE I=1,1,LENG BUF(IP+I)=FROM(I) ;! TRANSFER TEXT TO BUFFER %REPEAT IP=IP+LENG+2 ;! INCREMENT POSITION POINTER %RETURN ! ENTRY(3):WRITEDA(UNIT,IB,BUF(1),BUF(MXBUFS)) ;! EMPTY LAST BUFFER CLOSEDA(UNIT) ! %END ;! WRUNA ! %END ;! CREATE PROFILES ! ! ********************************************************************* ! %ROUTINE SORT(%BYTEINTEGERARRAYNAME AX,%INTEGERARRAYNAME PTR,N, %C %INTEGER P1,P2) ! %INTEGERARRAY UT(1:20), LT(1:20) %INTEGER Q,M,P,T,X,I,J,K,NT ! I=P1 J=P2 ;! INITIALISE ARRAY VARIABLES M=1 ! START: %IF J-I < 1 %THEN -> ENDCHK %IF J-I = 1 %THEN -> LSTCHK ! P=(J+I)//2 ;! SET MID-POINT T=PTR(P) NT=N(P) PTR(P)=PTR(I) N(P)=N(I) N(P)=N(I) Q=J K=I+1 ! NEXT:%IF LEXISIGN(AX,PTR(K),N(K),AX,T,NT)>0 %THENC %START LIMCHK: %IF Q CHANGE %FINISH %IF LEXISIGN(AX,PTR(Q),N(Q),AX,T,NT)<0 %THENC %START ;! SWOP POINTERS X=PTR(K) PTR(K)=PTR(Q) PTR(Q)=X X=N(K) ;! SWOP LENGTHS N(K)=N(Q) N(Q)=X Q=Q-1 %FINISH %ELSEC %START Q=Q-1 -> LIMCHK %FINISH %FINISH K=K+1 %IF K <= Q %THEN -> NEXT ! CHANGE:PTR(I)=PTR(Q) N(I)=N(Q) PTR(Q)=T N(Q)=NT %IF Q > P %THENC %START LT(M)=I UT(M)=Q-1 I=Q+1 %FINISH %ELSEC %START LT(M)=Q+1 UT(M)=J J=Q-1 %FINISH M=M+1 -> START ! LSTCHK:%IF LEXISIGN(AX,PTR(I),N(I),AX,PTR(J),N(J))>0 %THENC %START X=PTR(I) PTR(I)=PTR(J) PTR(J)=X X=N(I) N(I)=N(J) N(J)=X %FINISH ! ENDCHK:M=M-1 %IF M> 0 %THENC %START I=LT(M) J=UT(M) -> START %FINISH ! %END ;! SORT ! ! ********************************************************************* ! %INTEGERFN LEXISIGN (%BYTEINTEGERARRAYNAME B1, %INTEGER S1,L1, %C %BYTEINTEGERARRAYNAME B2, %INTEGER S2,L2) ! ! RETURNS +VE VALUE IF WORD1>WORD2, -VE IF WORD1 UNEQUAL 00083800 %REPEAT %RESULT=L1-L2 UNEQUAL:%RESULT=B1(I1+I)&X'DF'-B2(I2+I)&X'DF' 00084100 %END ;! LEXISIGN ! ! ********************************************************************* ! %ROUTINE READ STATISTICS (%INTEGER STUNIT,%INTEGERNAME MXSTJN) 00086600 ! ! ROUTINE READS THE CURRENT WEEKS STATISTICS FROM THE DISC FILE ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL, %INTEGERNAME SECT, %C %NAME BEGIN,END) ! %INTEGERARRAY BUF(1:3) ;! CONTROL DETAILS 00087500 %INTEGER BLOCK ;! NUMBER OF BLOCK TO BE READ ! OPENDA(STUNIT) 00078500 BLOCK=1 READDA(STUNIT,BLOCK,BUF(1),BUF(3)) 00088100 %IF CHECK=YES %THENC %START %IF WEEKNO\=BUF(1) %THENC %START 00087950 NEWLINES(2) PRINTSTRING('*** CHECK FAILURE ***') NEWLINES(2) PRINTSTRING('STATISTICS FILE') PRINTSTRING(' - WEEK NUMBER DOES NOT MATCH') NEWLINE PRINTSTRING('CURRENT WEEK NUMBER') WRITE(WEEKNO,4) NEWLINE PRINTSTRING('WEEK NUMBER IN FILE') WRITE(BUF(1),4) NEWLINES(2) PRINTSTRING('*** JOB TERMINATED ***') %STOP %FINISH 00089350 %FINISH %ELSE WEEKNO=BUF(1) MXSTJN=BUF(3) ;! SET EXTENT OF ARRAYS 00088450 BLOCK=BLOCK+1 READDA(STUNIT,BLOCK,STJNUM(1),STJNUM(MXSTJN)) 00088600 BLOCK=BLOCK+1 READDA(STUNIT,BLOCK,STIPCT(1),STIPCT(MXSTJN)) 00088800 CLOSEDA(STUNIT) %END ;! READ STATISTICS ! ! **************************************************** ! %ROUTINE MARKKEYWDS(%BYTEINTEGERARRAYNAME TEXT, %C 00080000 %INTEGER KP,KL, %INTEGERNAME N);!?? KP,KL WERE SHORT 00080050 !?? KP,KL WERE SHORTINTEGERS ! ! THIS ROUTINE MARKS THE POSITION OF THE KEYWORDS APPEARING IN ! TEXT AND STORES THE MARKERS IN THE ARRAYS TBGN,TLNG STARTING ! AT N+1 AND UPDATING N AS IT GOES ALONG. ! %IF KP=0 %THEN %RETURN ;! CHECK FOR NULL ENTRY 00082650 ENTER:N=N+1 TBGN(N)=KP ;! STORE POINTERS TO 00090600 TLNG(N)=KL ;! THIS KEYWORD 00090700 %IF TEXT(KP+KL)=0 %THEN %RETURN KP=KP+KL+1 ;! IF THERE ARE MORE ENTRIES 00090900 KL=TEXT(KP-1) ;! UPDATE THE POINTERS 00091000 -> ENTER ! %END ;! MARKKEYWDS ! ! ********************************************************************* ! %ROUTINE MARKTITWDS (%BYTEINTEGERARRAYNAME TEXT, %C 00081800 %INTEGER ST,LT, %INTEGERNAME N);!?? ST,LT WERE SHORT00081850 !?? ST,LT WERE SHORTINTEGERS ! ! THIS ROUTINE MARKS THE START AND LENGTH OF THE NON-COMMON WORDS ! IN TEXT STARTING AT TEXT(ST) AND EXAMINING LT CHARACTERS. ! THE POINTER N IS UPDATED AS NECESSARY. ! %ROUTINESPEC MARKTWORD(%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C 00082400 %INTEGERNAME ST,LN,IA) 00082500 %INTEGERFNSPEC WORD(%BYTEINTEGERARRAYNAME TEXT,%INTEGER B,L) ! %INTEGER NB ;! POINTER TO START OF TERM %INTEGER NL ;! LENGTH OF TERM %INTEGER MX ;! EXTENT OF TEXT 00085030 %INTEGER IA ;! CURRENT POSITION 00085060 %OWNINTEGER COMMON=1 ;! COMMON WORD INDICATOR ! MX=LT+ST-1 00091200 IA=ST 00085260 MKNX:MARKTWORD(TEXT,MX,NB,NL,IA) 00085300 %IF NB=0 %THEN %RETURN %IF WORD(TEXT,NB,NL)=COMMON %THEN -> MKNX N=N+1 TBGN(N)=NB TLNG(N)=NL -> MKNX ! ! ********************************************************************* ! %ROUTINE MARKTWORD(%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C 00078700 %INTEGERNAME ST,LN,IA) ! ! THIS ROUTINE FINDS THE START AND LENGTH OF THE NEXT SEQUENCE OF ! CHARACTERS IN THE ARRAY ARR STARTING AT IA AND ENDING WHEN A ! DELIMITER IS FOUND OR WHEN IA(MXA) IS REACHED. ON EXIT IA POINTS ! IMMEDIATELY PAST THE LAST CHARACTER. ! %OWNBYTEINTEGERARRAY CH (0:127) = 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1, 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1, 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1 ! %INTEGER IND ;! SWITCH VARIABLE %OWNBYTEINTEGER DELIMITER=1 ;! DELIMITER CHAR INDICATOR ! %SWITCH S1,S2(1:2) ! ST=0 ;! SET START VALUE TO ZERO IND=1 ;! SET SWITCH VARIABLE -> CHCK ;! JUMP TO CHECK FIRST CHAR ! S1(1):S2(2):IA=IA+1 ;! INCREMENT POINTER CHCK:%IF IA > MXA %THENC %START ;! END OF ARRAY REACHED %IF ST=0 %THEN %RETURN ;! ERROR EXIT IF NO WORD FOUND -> S1(2) ;! ELSE SET LENGTH ETC. %FINISH %IF CH(ARR(IA))=DELIMITER %THEN -> S1(IND);! IF DELIMITER FOUND GO 00097800 -> S2(IND) ;! TO S1 ELSE JUMP TO S2 ! ! WHEN FIRST NON-DELIM FOUND THE SWITCH VARIABLE IS ALTERED SO THAT ! THE NEXT DELIMITER FOUND ACTS AS A TERMINATOR. ! S2(1):IND=2 ;! CHANGE INDICATOR ST=IA ;! SET START ADDRESS -> S1(1) ;! CONTINUE ! ! THE FIRST DELIMITER FOUND TERMINATES THE CURRENT TERM ! S1(2):LN=IA-ST ;! SET LENGTH OF WORD ! %END ;! MARKTWORD 00083300 ! ! ********************************************************************* ! %INTEGERFN WORD(%BYTEINTEGERARRAYNAME TEXT, %INTEGER B,L) ! ! THIS ROUTINE MATCHES THE CHARACTER STRING STARTING AT TEXT(B) ! AND OF LENGTH L AGAINST THE COMMON WORDS HELD IN THE ARRAY COMMON. ! ! ON THE FIRST ENTRY TO THE ROUTINE THE COMMON WORDS ARE READ FROM ! THE INPUT DEVICE SPECIFIED AND TRANSLATED TO THE SPECIAL FORM ! USED FOR FAST COMPARISION. NO COMMON WORD MAY BE MORE THAN SIX ! CHARACTERS LONG, IF IT IS IT WILL BE IGNORED. ! %EXTERNALROUTINESPEC SETMARGINS(%INTEGER A,B,C) ! %OWNBYTEINTEGERARRAY TR(0:127)=0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, 16,17,18,19,20,21,22,23,24,25,26,0,0,0,0, 0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, 16,17,18,19,20,21,22,23,24,25,26,0,0,0,0,0 ! %BYTEINTEGERARRAY IP(1:6) ;! INPUT ARRAY %OWNINTEGERARRAY COMMON(1:50) ;! ARRAY OF COMMON WORDS ! %INTEGER I ;! LOOP VARIABLE AND INDEX TO IP %INTEGER J ;! LOOP VARIABLE %INTEGER WD ;! INTEGER FORM OF WORD ! %OWNINTEGER MAXC ;! POINTER TO COMMON ARRAY %OWNINTEGER MAXL ;! LENGTH OF LONGEST COMMON WORD %OWNINTEGER NO=1 ;! ENTRYPOINT INDICATOR ! %BYTEINTEGER SM ;! CURRENT I/P CHARACTER %OWNBYTEINTEGER ENDSM='%' ;! END OF COMMON WORD I/P FILE ! %SWITCH ENTRY(1:2) ! ->ENTRY(NO) ! ! FIRST ENTRY - READ COMMON WORDS AND SET UP THE ARRAY ! ENTRY(1):NO=2 SELECT INPUT(COSTRM) 00097300 SETMARGINS(COSTRM,1,88) I=0 RD: READ SYMBOL(SM) %IF SM=X'0A' %OR SM=BLNK %THEN -> RD %IF SM=ENDSM %THEN -> END ADD: I=I+1 %IF I>6 %THENC %START ;! COMMON WORD TOO LONG NEWLINES(2) PRINTSTRING('COMMON WORD TOO LONG ') %CYCLE I=1,1,6 PRINT SYMBOL(IP(I)) %REPEAT PR: PRINT SYMBOL(SM) READ SYMBOL(SM) %IF SM\=BLNK %AND SM\=X'0A' %THEN -> PR I=0 -> RD %FINISH IP(I)=SM ;! STORE CHARACTER READ SYMBOL(SM) %IF SM\=X'0A' %AND SM\=BLNK %THEN -> ADD %IF I>MAXL %THEN MAXL=I WD=0 %CYCLE J=1,1,I WD=WD!(TR(IP(J))<<(30-5*J)) ;! ADD CHARACTER TO INTEGER 00104000 %REPEAT MAXC=MAXC+1 COMMON(MAXC)=WD ;! STORE SPECIAL FORM I=0 -> RD ! END: %CYCLE I=1,1,MAXC-1 ;! SORT FINAL ARRAY TO ORDER %CYCLE J=I+1,1,MAXC %IF COMMON(J)MAXL %THEN %RESULT=0 ;! CHECK LENGTH FIRST WD=0 %CYCLE I=0,1,L-1 WD=WD!(TR(TEXT(B+I))<<(25-5*I)) 00106100 %REPEAT ! %CYCLE I=1,1,MAXC %IF WD PRD %REPEAT D=0 ;! NO DIAGNOSTICS IF NO MATCH %FINISH %ELSEC %START ;! DIAGNOSTICS FOR THIS USER PRD: D=1 ;! SET DIAGNOSTICS SWITCH NEWLINES(2) ;! ............................. 00107910 PRINTSTRING('USER') ;! .......................... 00107920 WRITE(USERNO,4) ;! ............................. 00107930 PRINTSTRING(' IP=') ;! .......................... 00107940 WRITE(IP,4) ;! ............................. 00107950 %FINISH 00111030 %FINISH 00111060 ! NXPR:IP=PNXP ;! UPDATE PROFILE ARRAY PTR PNXP=INTEGER(ADDR(PROFIL(IP))) ;! SET NEXT PROFILE POINTER CODE=PROFIL(IP+4) ;! SET CURRENT CODE -> S(D) ;! PRINT DIAGNOSTICS IF REQ 00111450 S(1): NEWLINE ;! ............................. 00111500 PRINTSTRING('CODE ') ;! .......................... 00108340 PRINT SYMBOL(CODE) ;! ............................. 00108360 S(0):%IF PROFILE MATCH(PROFIL,IP+4)=YES %THENC 00111800 %START ;! ITEM MATCHES PROFILE %IF D=1 %THEN PRINTSTRING(' *** MATCH ***') 00112000 %IF CODE=JC %OR CODE=BC %THEN -> NXTU ITMTCH=1 ;! SET MATCH INDICATOR ON 00104400 STUS=STUS+1 ;! INC NO OF USERS SERVED 00104650 REFB(ICONC)=SDBL ;! STORE BLOCK PTR TO ITEM REFP(ICONC)=SDPS ;! STORE POSN OF ITEM %IF INTEGER(ADDRC)=0 %THEN INTEGER(ADDRC)=ICONC %ELSEC 00112300 REFC(INTEGER(ADDRC+4))=ICONC 00112400 INTEGER(ADDRC+4)=ICONC ;! SET LINKAGES 00112800 REFC(ICONC)=0 ;! ZEROISE FORWARD POINTER 00112850 ICONC=ICONC+1 ;! UPDATE CURRENT CONC POINTER -> NXTU ;! JUMP TO EXAMINE NEXT USER %FINISH %IF PNXP\=0 %THEN -> NXPR ;! NO MATCH - EXAMINE NEXT PROF NXTU:%IF PNXU\=0 %THEN -> NXUS ;! MATCH - EXAMINE NEXT USER %IF ITMTCH=YES %THENC %START ;! ITEM MATCHED - CALC STATISTICS JN1=IRDIRC(PB) ;! SET START OF JOURNAL NUMBER 00113600 JN2=IRDIRC(PB+1) ;! SET LENGTH OF JOURNAL NUMBER 00113700 JNUM=CONV(IRTEXT,JN1,JN2) ;! CONVERT TO INTEGER 00113800 %CYCLE I=1,1,MXSTJN ;! SEARCH FOR JOURNAL DETS %IF JNUM=STJNUM(I) %THEN -> EQJN %REPEAT I=MAXN+1 ;! SET MISC NO IF NO MATCH EQJN: STUSOP=STUSOP+STUS ;! ADD NUMBER OF USERS SERVED 00119700 STOPCT(I)=STOPCT(I)+1 ;! INCREMENT ITEMS MATCHED %FINISH %RETURN ;! ALL PROFILES COMPARED 00097350 ! ! ********************************************************************* ! %INTEGERFN PROFILE MATCH (%BYTEINTEGERARRAYNAME PROF,%INTEGER PST) ! ! THIS ROUTINE MATCHES THE CURRENT ITEM (ASSUMED TO BE HELD IN THE ! TWO ARRAYS IRDIRC AND IRTEXT) WITH THE PROFILE STARTING AT ! PROF(PST), RETURNING THE VALUE 1 IF A MATCH IS FOUND OTHERWISE 0. ! %INTEGERFNSPEC COMPARE(%BYTEINTEGERARRAYNAME PROF,%INTEGER IP,LP, %C %BYTEINTEGERARRAYNAME TEXT,%INTEGER IT,TP) ! %INTEGER COUNT ;! SPECIAL PROFILE INDICATOR %INTEGER I ;! LOOP VARIABLE %INTEGER IP ;! START OF PROFILE TERM %INTEGER IT ;! START OF TEXT TERM %INTEGER LP ;! LENGTH OF PROFILE TERM %INTEGER LT ;! LENGTH OF TEXT TERM %INTEGER MXT ;! EXTENT OF TITLE 00116450 %INTEGER N ;! POINTER TO ARRAYS TBGN,TLNG %INTEGER NEWP ;! POINTER TO NEXT PROF REC %INTEGER NFND ;! NUMBER OF TERMS SO FAR FOUND %INTEGER NLIM ;! NUMBER OF TERMS TO BE FOUND %INTEGER NPRT ;! NUMBER OF PROFILE TERMS %INTEGER P ;! POINTER TO PROFILE ARRAY %INTEGER TP ;! TYPE OF MATCHING REQUIRED ! %BYTEINTEGER CODE ;! CODE OF CURRENT PROFILE ! %SWITCH RES1(-1:1) ;! RESULT OF COMPARISION %SWITCH RES2(-1:1) ;! RESULT OF COMPARISION %SWITCH RES3(-1:1) ;! RESULT OF COMPARISION 00117750 ! CODE=PROF(PST) ;! SET CODE OF PROFILE NPRT=PROF(PST+1) ;! SET NUMBER OF TERMS P=PST+2 ;! UPDATE POINTER ! %IF CODE=AC %OR CODE=BC %THENC %START ;! COMPARE AUTHOR PROFILE TP=2 IT=IRDIRC(PA) ;! SET 1ST AUTHOR PTR FROM DIRC LT=IRDIRC(PA+1) ->PROC1 %FINISH ! %IF CODE=JC %OR CODE=KC %THENC %START ;! COMPARE JOURNAL NUMBERS TP=1 IT=IRDIRC(PB) ;! SET POINTERS FROM DIRECTORY 00114000 LT=IRDIRC(PB+1) 00114100 -> PROC1 00119450 %FINISH 00119500 COUNT=0 ;! SET COUNT INDICATOR OFF 00119530 MXT=IRDIRC(PT)+IRDIRC(PT+1)-1 ;! EXTENT OF TITLE 00119540 -> CHCD ;! PROCESS NORMAL PROFILE 00119560 ! ! PROCESSING FOR AUTHOR AND JOURNAL NUMBER COMPARISION ONLY 00114400 ! PROC1:%IF IT=0 %THEN %RESULT=0 ;! NOT EQUAL IF NO TERMS IN TEXT 00120450 %CYCLE I=1,1,NPRT 00120500 IP=P+1 ;! SET PROFILE POINTER LP=PROF(P) ;! AND TERM LENGTH %IF PROF(P+LP)=',' %AND (CODE=AC %OR CODE=BC) %THENC -> RES1(COMPARE(PROF,IP,LP-1,IRTEXT,IT,1)) -> RES1(COMPARE(PROF,IP,LP,IRTEXT,IT,TP)) ! RES1(0):%RESULT=1 ;! EQUAL COMPARE - MATCH ! RES1(-1):P=IP+LP ;! PROFTEXT COMPARE NEXT TEXT P=PST+2 ;! RESET PROFILE POINTER 00121150 -> PROC1 ! ! ALL OTHER CODES ARE MATCHED ON KEYWORDS AND TITLE WORDS ! SETP:CODE=PROF(P) ;! SET PROFILE CODE 00121850 NPRT=PROF(P+1) ;! SET NO TERMS IN PROFILE 00121900 P=P+2 ;! INCREMENT PROFILE POINTER 00121950 CHCD:%IF CODE=ZC %OR CODE=PC %OR TWO<=CODE<=NINE %THENC 00122000 %START ;! DISPLACEMENT VALUE IS PRESENT 00121660 NEWP=INTEGER(ADDR(PROF(P)))+P; !?? WAS SHORT 00122200 P=P+2 ;! INCREMENT POINTER 00121800 %FINISH 00121850 N=1 ;! SET PTR TO FIRST ITEM TERM IT=TBGN(1) %CYCLE I=1,1,NPRT IP=P+1 LP=PROF(P) %IF PROF(P+LP)=SC %THENC %START ;!MATCH SHOULD ACCEPT TRUNCATION TP=2 LP=LP-1 %FINISH %ELSE TP=1 ! CMP2:%IF IT+LP<=MXT+1 %OR IT>MXT %THENC 00123550 -> RES2(COMPARE(PROF,IP,LP,IRTEXT,IT,TP)) %ELSEC 00124400 -> RES3(COMPARE(PROF,IP,MXT-IT+1,IRTEXT,IT,2)) 00124600 ! RES3(0):RES3(1): %C 00123750 RES2(1):%IF N>=NT %THEN -> END1 00125000 N=N+1 ;! PROF>TEXT EXAMINE NEXT TEXT IT=TBGN(N) -> CMP2 ! RES2(-1):RES3(-1):P=P+PROF(P)+1 ;! PROF SETP %FINISH %RESULT=0 ;! NO MATCH ! RES2(0):%IF CODE=ZC %OR CODE=PC %THENC 00126900 %START ;! FURTHER RECS TO BE COMPARED %IF COUNT=YES %THENC %START NFND=NFND+1 ;! INCREMENT NO RECS FOUND %IF NFND>=NLIM %THEN %RESULT=1 %FINISH P=NEWP -> SETP %FINISH ! %IF TWO<=CODE<=NINE %THENC %START ;! NUMERIC - START COUNT COUNT=YES NFND=0 ;! ZEROISE MATCH COUNT NLIM=CODE&X'0F' ;! SET LIMIT REQUIRED P=NEWP -> SETP %FINISH ! %IF CODE=NC %THEN %RESULT=0 ! %IF COUNT=YES %THENC %START NFND=NFND+1 NFND=NFND+1 %IF NFND',0, '@','A','B','C','D','E','F','G','H','I', 'J','K','L','M','N','O', 'P','Q','R','S','T','U','V','W','X','Y', 'Z',0,X'5C',0,X'5E',X'5F', 0 , 'A','B','C','D','E','F','G','H','I', 'J','K','L','M','N','O', 'P','Q','R','S','T','U','V','W','X','Y', 'Z',0,'!',0,'\',0 ! %SWITCH MATCH(1:2) %SWITCH S1(0:1) 00134120 %SWITCH S2(0:1) ;! DIAGNOSTIC PRINT SWITCHES 00134140 %SWITCH S3(0:1) 00134160 ! -> S1(D) ;! PRINT DIAGNOSTICS IF REQ 00134250 S1(1): SPACES(2) ;! ............................. 00134300 WRITE(IP,4) ;! ............................. PRINTSTRING(",") ;! .......................... WRITE(IT,3) ;! ............................. S1(0):%CYCLE I=0,1,LP-1 00134700 PTERM=TR(PROF(IP+I)) TTERM=TR(TEXT(IT+I)) %IF PTERM S2(D) 00135000 %IF PTERM>TTERM %THEN -> S3(D) 00135100 %REPEAT -> MATCH(TP) 00135250 ! S2(1): PRINTSTRING(' L') 00135350 S2(0): %RESULT=-1 00135400 S3(1): PRINTSTRING(' G') 00135460 S3(0): %RESULT=+1 00135480 ! MATCH(1):%IF CH(TEXT(IT+LP))\=DELIMITER %THEN -> S2(D) 00135600 MATCH(2):%IF D=1 %THEN PRINTSTRING(' *') 00139200 %RESULT=0 00135750 ! %END ;! COMPARE ! %END ;! PROFILE MATCH ! %END ;! SCAN PROFILES ! ! ********************************************************************* ! %ROUTINE PRINT SDI ! ! ROUTINE SCANS THE PROFILES AND PRINTS ALL THE ITEMS RETRIEVED ! FOR EACH USER. ! %ROUTINESPEC OUTPUT HEADING (%INTEGER USUNIT,BLOCK,POSN,LSUNIT,NO) %ROUTINESPEC RDSDI (%INTEGERNAME UNIT,BLOCK,POSN,NO) %ROUTINESPEC OUTPUT TITLE (%INTEGER JNUM) 00125500 %ROUTINESPEC OUTPUT ITEM (%INTEGER JNUM) 00125600 %ROUTINESPEC WRLST(%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C %INTEGER LENG,IND) %ROUTINESPEC SET(%BYTEINTEGERARRAYNAME A, %INTEGER START,END,VAL) %ROUTINESPEC MARKWORDS(%BYTEINTEGERARRAYNAME ARR,%INTEGER ST,MAX, %C %INTEGERNAME NW) %ROUTINESPEC CREATELINE(%BYTEINTEGERARRAYNAME OPLINE,DATA, %C %INTEGER START,MXLINE,TNW, %C %INTEGERNAME LENGOP,END) ! %INTEGER ICONC ;! CONCORDANCE POINTER 00126550 %INTEGER J ;! LOOP VARIABLE 00144450 %INTEGER JN1 ;! START OF JOURNAL NUMBER 00127120 %INTEGER JN2 ;! END OF JOURNAL NUMBER 00127140 %INTEGER JNUM ;! JOURNAL NUMBER 00127150 %OWNINTEGER NO=1 ;! ENTRYPOINT INDICATOR 00138900 ! PNXU=1 ;! INITIALISE PTR TO NEXT USER USERNO=0 ;! INITIALISE USER NUMBER 00132950 ! NXUS:USERNO=USERNO+1 ;! INCREMENT USER NUMBER 00133100 IP=PNXU ;! UPDATE PROFILE POINTER PNXU=INTEGER(ADDR(PROFIL(IP+4))) ;! SET PTR TO NEXT USER ICONC=INTEGER(ADDR(PROFIL(IP+8))) ;! STORE CONCORDANCE PTR %IF ICONC=0 %THEN -> CHNX ;! SKIP IF NO ITEMS RETRIEVED 00143400 STUSSV=STUSSV+1 ;! ELSE UPDATE USER SERVICED CNT INTEGER(ADDR(PROFIL(IP+4)))=0 ;! RESET CONCORDANCE POINTERS INTEGER(ADDR(PROFIL(IP+8)))=0 UNBL=INTEGER(ADDR(PROFIL(IP))); !?? WAS SHORT UNPS=INTEGER(ADDR(PROFIL(IP+2))); !?? WAS SHORT OUTPUT HEADING (USUNIT,UNBL,UNPS,LSUNIT,NO) NO=2 ;! CHANGE ENTRY SWITCH 00140250 ! NXRF:SDBL=REFB(ICONC) ;! SET BLOCK OF THIS ITEM SDPS=REFP(ICONC) ;! AND POSN WITHIN THAT BLOCK RDSDI(SDUNIT,SDBL,SDPS,NO) ;! READ ITEM FROM FILE JN1=IRDIRC(PB) ;! SET START OF JOURNAL NUMBER 00140700 JN2=IRDIRC(PB+1) ;! SET LENGTH OF JOURNAL NUMBER 00140800 JNUM=CONV(IRTEXT,JN1,JN2) ;! CONVERT NUMBER TO INTEGER 00140900 %CYCLE J=1,1,MXSTJN %IF JNUM=STJNUM(J) %THENC %START STUSMK(J)=1 -> OPTL %FINISH %REPEAT OPTL:OUTPUT TITLE (JNUM) 00147200 OUTPUT ITEM (JNUM) 00129100 ICONC=REFC(ICONC) ;! SET NEXT CONCORDANCE PTR %IF ICONC\=0 %THEN -> NXRF ;! PROC NEXT ITEM IF ANY %CYCLE J=1,1,MXSTJN STUSCT(J)=STUSCT(J)+STUSMK(J) STUSMK(J)=0 %REPEAT CHNX:%IF PNXU\=0 %THEN -> NXUS ;! PROCESS NEXT USER IF ANY 00145100 ! STUSTL=USERNO ;! SET TOTAL NUMBER OF USERS 00135250 NO=3 00144450 RDSDI(SDUNIT,SDBL,SDPS,NO) ;! CLOSE SDI INPUT FILE 00144500 OUTPUT HEADING(USUNIT,UNBL,UNPS,LSUNIT,3) 00145400 OUTPUT TITLE(0) ;! TERMINATE AND CLOSE FILES 00141650 ! %ROUTINE OUTPUT HEADING (%INTEGER USUNIT,BLOCK,POSN,LSUNIT,NO) ! ! ********************************************************************* ! ! OUTPUT HEADING ! ! ********************************************************************* ! %ROUTINESPEC RDRAR(%INTEGER UNIT,BLOCK,POSN,NO, %C %BYTEINTEGERARRAYNAME TO, %INTEGERNAME LENG) %EXTERNALSTRINGFNSPEC DATE ! ! THIS ROUTINE PRODUCES THE HEADING PAGE OF EACH USERS SDI ! %BYTEINTEGERARRAY USNAME(1:MXNAME) ;! USER NAME/ADDRESS AREA %INTEGER USLENG ;! LENGTH OF NAME/ADDRESS %INTEGER I ;! LOOP VARIABLE ! %SWITCH ENTRY(1:3) ! -> ENTRY(NO) ! ENTRY(1):SELECT OUTPUT(LSUNIT) ENTRY(2):RDRAR(USUNIT,BLOCK,POSN,NO,USNAME,USLENG) 00137300 ! NEWPAGE NEWLINES(6) SPACES(9) 00147700 PRINTSTRING('CULHAM LABORATORY INFORMATION OFFICE') 00147700 NEWLINE SPACES(9) PRINTSTRING('CURRENT AWARENESS SERVICE') SPACES(4) PRINT STRING(DATE) NEWLINES(10) 00148800 %CYCLE I=1,1,USLENG %IF USNAME(I)=NL %THEN NEWLINE %ELSE PRINT SYMBOL(USNAME(I)) 00149200 %REPEAT NEWLINES(10) 00149200 SPACES(39) 00148900 WRITE(USERNO,9) NEWPAGE %RETURN ! ENTRY(3):RDRAR(USUNIT,BLOCK,POSN,NO,USNAME,USLENG) 00139600 ! ! ********************************************************************* ! %ROUTINE RDRAR (%INTEGER UNIT,BLOCK,POSN,NO, %C %BYTEINTEGERARRAYNAME TO, %INTEGERNAME LENG) ! ! THIS ROUTINE READS A RECORD FROM THE RANDOM ACCESS DEVICE 'UNIT' ! TO THE ARRAY 'TO' FROM THE POSITION 'POSN' IN 'BLOCK'. THE LENGTH ! OF THE RECORD IS EXPEXTED TO APPEAR IN THE FIRST TWO BYTES OF THE ! RECORD (THIS IS NOT ALIGNED) ! ! THE ROUTINE IS USED TO READ FROM THE USER NAME AND ADDRESS FILE ! AND FROM THE MASTER JOURNAL TITLE FILE. ! %EXTERNALROUTINESPEC OPENDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA(%INTEGER CHANNEL, %INTEGERNAME BLOCK, %C %NAME BEGIN,END) ! %BYTEINTEGERARRAY BUF(1:MXBUFS) ;! I/P AREA ! %INTEGER I %INTEGER IP ;! POSITION POINTER 00131160 ! %SWITCH ENTRY(1:3) 00131250 -> ENTRY(NO) ! ENTRY(1):OPENDA(UNIT) ! ENTRY(2):READDA(UNIT,BLOCK,BUF(1),BUF(MXBUFS)) IP=POSN LENG=BUF(IP)<<8!BUF(IP+1) ;! EXTRACT LENGTH IP=IP+1 %CYCLE I=1,1,LENG TO(I)=BUF(IP+I) ;! TRANSFER RECORD TEXT %REPEAT %RETURN ! ENTRY(3):CLOSEDA(UNIT) ! %END ;! RDRAR ! 00136030 %END ;! OUTPUT HEADING 00136060 ! ! ********************************************************************* ! %ROUTINE RDSDI (%INTEGERNAME UNIT,BLOCK,POSN,NO) ! ! THE ROUTINE HAS EFFECTIVELY THREE ENTRYPOINTS DEPENDING ON THE ! VALUE OF NO WHICH MAY BE 1,2 OR 3. ! ! NO=1 FIRST ENTRY - THE DISC FILE (UNIT) IS OPENED AND THE CONTROL ! BLOCK READ. CONTROL IS THEN RETURNED TO THE CALLING ROUTINE. ! ! NO=2 NORMAL ENTRY - THE RECORD COMMENCING AT BYTE (POSN) IN ! SECTOR (BLOCK) IS READ FROM THE DISC FILE AND TRANSFERRED ! TO THE DIRECTORY AND TEXT ARRAYS. ! ! NO=3 WHEN PROCESSING IS COMPLETE THE PROGRAM MUST CALL RDSDI ! WITH NO=3 TO CLOSE THE DISC FILE. ! !??; %EXTERNALROUTINESPEC OPENDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA(%INTEGER CHANNEL, %INTEGERNAME SECT,%C %NAME BEGIN,END) %BYTEINTEGERARRAY BUFA(1:MXBUFS) ;! INPUT BUFFER !?? SHORT; %INTEGERARRAY CNTBUF(1:MXCNTB);!CONTROL BLOCK I/P AREA ! %OWNINTEGER IB=1 ;! BUFFER POINTER ! %INTEGER I ;! LOOP VARIABLE %INTEGER SECT ;! SECTOR TO BE READ FROM DISC %SWITCH ENTRY(1:3) ;! ENTRYPOINTS ! ! JUMP TO APPROPRIATE ENTRYPOINT ! -> ENTRY(NO) ! ! 1ST ENTRY - OPEN FILE AND READ CONTROL BLOCK (SECTOR=1). IF ! REQUIRED CHECK THE WEEK NUMBER, SET UP BOUBLE BUFFERING. ! ENTRY(1):OPENDA(UNIT) ;! OPEN FILE SECT=1 ;! READ CONTROL BLOCK READDA(UNIT,SECT,CNTBUF(1),CNTBUF(MXCNTB)) 00138000 %IF CHECK=YES %THENC %START ;! WEEK NUMBER CHECK %IF WEEKNO\=CNTBUF(1) %THENC %START ;! INVALID WEEK NUMBER NEWLINE ;! O/P MESSAGE PRINTSTRING('WEEK NUMBERS DO NOT AGREE') NEWLINE PRINTSTRING('WEEK') WRITE(WEEKNO,4) PRINTSTRING(' REQUESTED') NEWLINE PRINTSTRING('WEEK') WRITE(CNTBUF(1),4) PRINTSTRING(' ON THIS DISC') NEWLINES(2) PRINTSTRING('... JOB TERMINATED ...') %STOP ;! TERMINATE JOB %FINISH %FINISH %ELSEC WEEKNO=CNTBUF(1) ;! STORE WEEK NUMBER OF FILE BLOCK=CNTBUF(2) ;! STORE LAST SECTOR NUMBER POSN=CNTBUF(3) ;! AND POSITION WITHIN IT %RETURN ! ! THE REQUIRED RECORD IS READ FROM THE FILE INTO THE TEXT ! AND DIRECTORY ARRAYS. ! ENTRY(2):SECT=BLOCK IB=POSN READDA(UNIT,BLOCK,BUFA(1),BUFA(MXBUFS)) ! ! TRANSFER DATA FROM BUFFER TO INTERNAL RECORD ! DIRC: %CYCLE I=1,1,MXDIRC ;! TRANSFER DIRECTORY IRDIRC(I)=INTEGER(ADDR(BUFA(IB))); !?? WAS SHORT 00124500 IB=IB+2 %IF IB>MXBUFS %THENC %START SECT=SECT+1 READDA(UNIT,SECT,BUFA(1),BUFA(MXBUFS)) IB=1 %FINISH %REPEAT ! TEXT: %CYCLE I=1,1,IRDIRC(2) ;! TRANSFER TEXT ARRAY 00162100 IRTEXT(I)=BUFA(IB) 00131800 IB=IB+1 %IF IB>MXBUFS %THENC %START SECT=SECT+1 READDA(UNIT,SECT,BUFA(1),BUFA(MXBUFS)) IB=1 %FINISH %REPEAT ! %RETURN ! ENTRY(3):CLOSEDA(UNIT) ! %END ;! RDSDI ! ! ********************************************************************* ! %ROUTINE OUTPUT TITLE (%INTEGER JNUM) ! ! THIS ROUTINE OUTPUTS THE APPROPRIATE TITLE FOR THE JOURNAL JNUM ! %ROUTINESPEC RDMJN(%INTEGER UNIT, %INTEGERNAME BLOCK,POS, %INTEGER IND) ! %OWNBYTEINTEGERARRAY VIP(1:13)=4,X'76',X'6F',X'6C',X'2E',3,X'6E', 00161100 X'6F',X'2E',3,X'70',X'74',X'2E' 00161200 %OWNBYTEINTEGERARRAY NONAM(1:18)='*',' ','T','I','T','L','E',' ', 'N','O','T',' ','F','O','U','N', 'D',' ' ! %BYTEINTEGERARRAY OPLINE(1:MXLINE) ;! O/P AREA %BYTEINTEGERARRAY JNTITL(1:MXTITL) ;! JOURNAL TITLE TEXT ! %INTEGER END ;! END OF O/P INDICATOR %INTEGER I ;! LOOP VARIABLE %INTEGER ID ;! DIRECTORY POINTER 00042110 %INTEGER INCT ;! LENGTH OF CURRENT ITEM 00042120 %INTEGER IT ;! TEXT POINTER 00042130 %INTEGER J ;! LOOP VARIABLE %INTEGER K ;! LOOP VARIABLE %INTEGER L ;! FIELD LIMIT 00162650 %INTEGER LENGOP ;! LENGTH OF O/P LINE %INTEGER LIM ;! LOOP LIMIT %INTEGER MJBL ;! BLOCK POINTER FOR M.JRN FILE %INTEGER MJPS ;! POSN POINTER FOR M.JRN FILE %INTEGER NINC ;! BINARY SEARCH INCREMENT %INTEGER NVAL ;! BINARY SEARCH POINTER %INTEGER NW ;! WORD COUNT %INTEGER PV ;! VOLUME NUMBER POINTER %INTEGER RNUM ;! ROOT OF JOURNAL NUMBER %INTEGER SECT ;! CURRENT SECTION OF BULLETIN %INTEGER TLENG ;! LENGTH OF TITLE TEXT ! %OWNINTEGER ENTNO=1 ;! ENTRY NUMBER %OWNINTEGER MP ;! MID POINT OF MJNUMB ! %SWITCH ENTRY(1:3) ;! ENTRY SWITCH ! ! CHECK FOR LAST ENTRY ! %IF JNUM=0 %THEN ENTNO=3 -> ENTRY(ENTNO) ! ! FIRST ENTRY: THE JOURNAL NUMBER AND POINTER ARRAYS ARE SET ! UP FROM THE MASTER JOURNAL FILE. ! ENTRY(1):RDMJN(MJUNIT,MJBL,MJPS,1) ;! SET UP ARRAYS MP=(MXNUMB+1)//2 ;! CALC MID-POINT OF ARRAY ENTNO=2 ;! THE ENTRY SWITCH VARIABLE ! ! NORMAL ENTRY: THE NEW JOURNAL TITLE IS OUTPUT ! ENTRY(2):SET(OPLINE,1,MXLINE,BLNK) ;! ENSURE O/P AREA CLEAR 00168600 WRLST(LSUNIT,OPLINE,MXLINE,5) ;! OUTPUT BLANK LINE %IF JNUM<999000 %THEN -> PJRN ;! JUMP FOR PERMANENT TITLE 00169600 %IF IRDIRC(PX)=0 %THEN %RETURN ;! EXIT UNLESS PSEUDO JOURNAL 00169650 ! ! PSEUDO-JOURNAL INPUT - TITLE AND BIBLIOGRAPHIC DETAILS MUST ALL ! BE EXTRACTED FROM THE INTERNAL RECORD. ! IT=IRDIRC(PX) ;! SET START AND 00170100 TLENG=IRDIRC(PX+1) ;! LENGTH OF SPECIAL TITLE 00170200 NW=1 ;! INITIALISE WORD COUNT MARKWORDS(IRTEXT,IT,IT+TLENG-1,NW);! MARK TITLE CONTENTS 00048600 CROL:CREATELINE(OPLINE,IRTEXT,1,MXLINE,NW-1,LENGOP,END) WRLST(LSUNIT,OPLINE,LENGOP,4) ;! OUTPUT TO LISTING DEVICE SET(OPLINE,1,LENGOP,BLNK) ;! CLEAR O/P AREA -> CROL %UNLESS END=YES 00170750 %IF JNUM<999020 %THEN -> PVOL ! ! BIBLIOGRAPHIC DETAILS ARE EXTRACTED FROM THE INTERNAL RECORD ! EXCLUDING THE FIRST (JOURNAL NUMBER) AND LAST (PAGINATION) ITEMS. ! NW=1 ;! INITIALISE WORD COUNT ID=15 ;! INITIALISE DIRECTORY IT=IRDIRC(ID)+IRDIRC(ID+1)+1 ;! AND TEXT POINTERS NEWI:INCT=IRTEXT(IT-1) ;! SET LENGTH OF NEXT ITEM %IF IRTEXT(IT+INCT)=0 %THEN -> OPTL ;! EXIT IF LAST ITEM REACHED ! ! WHERE POSSIBLE AN ITEM IS TREATED AS A SINGLE ENTITY BUT IF ! NECESSARY A LARGE ITEM IS PROCESSED WORD BY WORD ! %IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC %START TBGN(NW)=IT ;! SET START AND LENGTH 00136900 TLNG(NW)=INCT ;! OF ITEM AND FOLLOW 00137000 TSPS(NW)=2 ;! BY TWO SPACES 00137100 NW=NW+1 ;! INCREMENT POINTER %FINISH IT=IT+INCT+1 ;! UPDATE TEXT POINTER -> NEWI ;! JUMP TO PROCESS NEXT ITEM ! OPTL:NW=NW-1 ;! ADJUST WORD TOTAL %IF NW<=0 %THEN %RETURN ;! EXIT IF NO MORE ITEMS CRBL:CREATELINE(OPLINE,IRTEXT,1,MXLINE,NW,LENGOP,END) WRLST(LSUNIT,OPLINE,LENGOP,4) ;! OUTPUT TO LISTING DEVICE SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR OUTPUT AREA 00051850 -> CRBL %UNLESS END=YES WRLST(LSUNIT,OPLINE,MXLINE,4) ;! O/P SPACING LINE TO LISTING 00051950 %RETURN ;! EXIT WHEN OUTPUT COMPLETE ! ! PERMANENT JOURNAL INPUT - A BINARY SEARCH IS CARRIED OUT ON THE 00052200 ! MASTER JOURNAL TITLE FILE INDEX TO FIND THE TITLE REQUIRED. 00052250 ! PJRN:NVAL=MP ;! SET START VALUE AND 00047400 NINC=NVAL ;! INITIAL INCREMENT COMP:%IF JNUM=MJNUMB(NVAL) %THEN -> GOTIT ;! JUMP IF TITLE FOUND 00174500 NINC=NINC//2 ;! HALVE INCREMENT %IF NINC<1 %THEN -> MSNG ;! CHECK FOR END OF SEARCH %IF JNUM>MJNUMB(NVAL) %THEN NVAL=NVAL+NINC %C 00174800 %ELSE NVAL=NVAL-NINC -> COMP ;! COMPARE NEXT VALUE ! ! WHEN AN EQUAL COMPARE HAS NEEN FOUND THE CORRESPONDING TITLE ! IS READ FROM THE MASTER FILE AND OUTPUT. ! GOTIT:MJBL=MJBPTR(NVAL) ;! SET THE BLOCK AND MJPS=MJPPTR(NVAL) ;! POSITION POINTERS RDMJN(MJUNIT,MJBL,MJPS,2) ;! FETCH THE TITLE ! ! OUTPUT IS NOW CREATED A LINE AT A TIME, THE VALUE OF END BEING 00048900 ! SET TO ONE WHEN THE END OF THE RECORD HAS BEEN REACHED. 00049000 ! NW=1 MARKWORDS(JNTITL,1,TLENG,NW) CROPL:CREATELINE(OPLINE,JNTITL,1,MXLINE,NW-1,LENGOP,END) WRLST(LSUNIT,OPLINE,LENGOP,4) ;! OUTPUT TO LISTING DEVICE SET (OPLINE,1,LENGOP,BLNK) ;! CLEAR O/P AREA 00041050 -> CROPL %UNLESS END=YES ;! CONTINUE TO END OF TITLE 00041100 ! ! THE VOLUME,ISSUE AND PART NUMBERS OF A JOURNAL FOLLOW THE TITLE ! PVOL:PV=IRDIRC(PB)+IRDIRC(PB+1) ;! CALC POSITION !?? PVOL:PV=IRDIRC(PB)+IRDIRC(PB+1) ;! CALC POSITION LIM=IRTEXT(PV)+PV ;! SET LENGTH OF ITEM J=1 ;! INITIALISE PTR TO VIP K=-1 ;! AND O/P AREA I=PV+1 ;! SET PTR TO FIRST TEXT CHAR ! HEAD:L=VIP(J) ;! SET LENGTH OF NEXT VIP ENTRY %IF IRTEXT(I)='0' %THENC %START ;! NULL ENTRY J=J+L+1 ;! INCREMENT VIP POINTER INC1: I=I+1 ;! EXAMINE NEXT CHARACTER %IF IRTEXT(I)='.' %THEN -> INC2 ;! FOR END OF FIELD %IF I>=LIM %THEN -> OUT ;! END IF I EXCEEDS LIMIT -> INC1 %FINISH COPYTEXT(VIP,J+1,OPLINE,K+2,L) ;! ENTER NAME TO O/P AREA K=K+L+2 ;! UPDATE O/P AREA PTR J=J+L+1 ;! UPDATE VIP POINTER ENT: OPLINE(K)=IRTEXT(I) ;! TRANSFER TEXT CHARACTER K=K+1 ;! INCREMENT POINTER I=I+1 ;! INCREMENT TEXT POINTER %IF I>LIM %THEN -> OUT ;! IF END REACHED - EXIT %IF IRTEXT(I)\='.' %THEN -> ENT ;! CONTINUE TO END OF FIELD INC2:I=I+1 ;! INCREMENT PTR PAST F/STOP %IF I<=LIM %THEN -> HEAD ;! FIND NEXT ENTRY ! ! THE DATE IS ALSO EXTRACTED AND APPEARS ON THE SAME LINE AS THE ! VOLUME DETAILS IF THERE IS ROOM, OTHERWISE ON A SEPARATE LINE. ! OUT: PV=LIM+1 ;! SET START OF DATE DETAILS 00176900 LIM=IRTEXT(PV) ;! SET LENGTH OF DATE FIELD %IF K=-1 %THEN K=1 %ELSE K=K+3 ;! ALLOW FOR SPACING %IF K+LIM-1>MXLINE %THENC %START ;! SEPARATE LINE NECESSARY WRLST(LSUNIT,OPLINE,K-3,4) ;! O/P VOL. ISSUE PT. DETAILS SET(OPLINE,1,K-3,BLNK) ;! CLEAR O/P LINE K=1 ;! RESET O/P POINTER %FINISH COPYTEXT(IRTEXT,PV+1,OPLINE,K,LIM);! MOVE DATE TO O/P AREA WRLST(LSUNIT,OPLINE,K+LIM-1,4) ;! WRITE TO LISTING SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR O/P AREA %IF JNUM<999000 %AND IRDIRC(PX)>0 %THENC %START ;! IF ADDITIONAL TITLE IT=IRDIRC(PX) ;! NOTE IS PRESENT SET TLENG=IRDIRC(PX+1) ;! POINTERS AND OUTPUT NW=1 MARKWORDS(IRTEXT,IT,IT+TLENG-1,NW) -> OPTL ;! JUMP TO PROCESS %FINISH ;! ELSE INSERT BLANK LINE WRLST(LSUNIT,OPLINE,MXLINE,4) %RETURN ! ! IF NO MASTER JOURNAL NUMBER EXISTS FOR AN INPUT RECORD A ! MESSAGE TO THIS EFFECT IS OUTPUT. 00181500 ! MSNG:WRLST(LSUNIT,OPLINE,2,4) ;! O/P BLANK LINE %CYCLE I=1,1,18 OPLINE(I)=NONAM(I) OPLINE(18+I)=NONAM(I) %REPEAT OPLINE(37)='*' WRLST(LSUNIT,OPLINE,37,4) ;! O/P MESSAGE SET(OPLINE,1,37,BLNK) ;! CLEAR O/P LINE WRLST(LSUNIT,OPLINE,1,5) ;! WRITE BLANK LINE %RETURN ! ! THE LAST ENTRY CLOSES THE FILES ! ENTRY(3):RDMJN(MJUNIT,MJBL,MJPS,3) ;! CLOSE MASTER JOURNAL FILE WRLST (LSUNIT,OPLINE,0,0) ;! CLOSE LISTING FILE 00064100 ! ! ********************************************************************* ! %ROUTINE RDMJN(%INTEGER UNIT,%INTEGERNAME BLOCK,POSN,%INTEGER IND) ! ! THIS ROUTINE HANDLES I/O ON THE MASTER JOURNAL NUMBER FILE. ! THE FIRST ENTRY (IND=1) OPENS THE FILE AND PERFORMS ANY ! NECESSARY UPDATING. SUBSEQUENT ENTRIES (IND=2) EXTRACT THE ! REQUIRED RECORD FROM THE SPECIFIED BLOCK AND POSN. THE LAST ! ENTRY (IND=3) REWRITES THE CONTROL BLOCK AND CLOSES THE FILE. ! %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) %ROUTINESPEC GET TITLE (%BYTEINTEGERARRAYNAME JNTITL, %C %INTEGERNAME JST,JLNG,JNUM) %EXTERNALROUTINESPEC SET MARGINS (%INTEGER A,B,C) ! %BYTEINTEGERARRAY JREC(1:500) ;! NEW TITLE AREA %INTEGERARRAY CNT(1:6) ;! CONTROL ARRAY %OWNBYTEINTEGERARRAY BUFFER(1:1000) ;! BUFFER AREA ! %INTEGER I ;! LOOP VARIABLE %INTEGER IN ;! LOWER SUBSCRIPT OF MJNUMB %INTEGER J ;! LOOP VARIABLE %INTEGER JN ;! UPPER SUBSCRIPT OF MJNUMB %INTEGER MJBL ;! CURRENT BLOCK NUMBER %INTEGER NUM ;! NEW JOURN NO IN DECIMAL %INTEGER RLNG ;! LENGTH OF NEW RECORD ! %OWNINTEGER UPD ;! UPDATE INDICATOR %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 CHECK FOR ANY RECORDS TO BE ADDED ! READING AND PROCESSING THEM AT THIS POINT IF NECESSARY. ! ENTRY(1):OPENDA(UNIT) ;! OPEN MASTER FILE MJBL=1 ;! READ CONTROL BLOCK READDA(UNIT,MJBL,CNT(1),CNT(6)) 00188000 MAXN=CNT(1) ;! SET NO OF TITLES IN FILE NFBL=CNT(2) ;! STORE NEXT FREE BLOCK NO NFPS=CNT(3) ;! STORE NEXT FREE POSITION ! JN=MAXN+NJNO ;! TOTAL EXISTING + NEW TITLES %IF JN>MXNUMB %THEN -> OVFL ;! CHECK FOR OVERFLOW CONT:IN=NJNO+1 ;! SET START BEYOND NEW TITLES ! ! THE EXISTING JOURNAL NUMBERS ARE READ INTO THE ARRAY LEAVING ! ROOM AT THE BEGINNING EQUAL TO THE NUMBER OF NEW TITLES. ! THIS ALLOWS US TO MOVE THE JOURNAL NUMBERS UP THE ARRAY INSERTING ! NEW OR REPLACEMENT NUMBERS AS REQUIRED. ! MJBL=CNT(4) ;! READ JOURNAL NUMBER ARRAY READDA(UNIT,MJBL,MJNUMB(IN),MJNUMB(JN)) MJBL=CNT(5) ;! READ BLOCK POINTERS READDA(UNIT,MJBL,MJBPTR(IN),MJBPTR(JN)) MJBL=CNT(6) ;! READ POSITION POINTERS READDA(UNIT,MJBL,MJPPTR(IN),MJPPTR(JN)) ! ! IF NO UPDATING IS REQUIRED JUMP DIRECTLY TO THE END ! %IF NJNO=0 %THEN -> END ! ! THERE ARE NEW RECORDS TO BE ADDED. IT IS ASSUMED THAT THEY ! WILL BE IN STRICT NUMERIC ORDER. ! UPD=YES ;! SET UPDATE INDICATOR JN=1 ;! POINTER TO DESTINATION SELECT INPUT (6) SET MARGINS (6,1,88) ! %CYCLE I=1,1,NJNO ;! CYCLE THRO NEW RECORDS GET TITLE (JREC,ONE,RLNG,NUM) ;! FETCH NEXT RECORD %IF NUM=0 %THEN -> ERROR ;! CHECK FOR ENDFILE ! ! MOVE EXISTING NUMBERS BACK IN THE ARRAY UNTIL THE APPROPRIATE ! POSITION IS FOUND FOR THIS NEW RECORD. ! CHECK:%IF NUM>MJNUMB(IN) %THENC %START ;! MOVE UP EXISTING ENTRIES MJNUMB(JN)=MJNUMB(IN) MJBPTR(JN)=MJBPTR(IN) MJPPTR(JN)=MJPPTR(IN) IN=IN+1 ;! UPDATE BOTH ARRAY JN=JN+1 ;! POINTERS AND JUMP TO -> CHECK ;! EXAMINE THE NEXT RECORD %FINISH ! ! WHEN A LOW OR EQUAL COMPARE IS FOUND THE NEW RECORD IS WRITTEN ! TO THE NEXT AVAILABLE POSITION ON THE DISC FILE. ! %IF NFPS+RLNG+1>MXBUFS %THENC %START ;! RECORD WOULD CROSS BLOCK NFBL=NFBL+1 ;! BOUNDARY. A NEW BLOCK IS NFPS=1 ;! IS THEREFORE STARTED %FINISH %ELSEC READDA(UNIT,NFBL,BUFFER(1),BUFFER(MXBUFS)) BUFFER(NFPS)=RLNG>>8&X'FF' ;! STORE RECORD LENGTH IN BUFFER(NFPS+1)<-RLNG ;! FIRST TWO BYTES OF RECORD %CYCLE J=1,1,RLNG BUFFER(NFPS+J+1)=JREC(J) ;! AND WRITE TO DISC FILE 00194300 %REPEAT ;! AND WRITE TO DISC WRITEDA(UNIT,NFBL,BUFFER(1),BUFFER(MXBUFS)) ! ! SET THE NEW NUMBER AND POINTERS IN THE NEXT POSITION ! MJNUMB(JN)=NUM ;! ENTER JOURNAL NUMBER MJBPTR(JN)=NFBL ;! ENTER BLOBK POINTER MJPPTR(JN)=NFPS ;! ENTER POSITION POINTER NFPS=NFPS+RLNG+2 ;! UPDATE POSITION POINTER JN=JN+1 ;! UPDATE ARRAY POINTERS %IF NUM=MJNUMB(IN) %THEN IN=IN+1 %ELSE MAXN=MAXN+1 %REPEAT ! ! WHEN ALL THE NEW RECORDS HAVE BEEN INSERTED THE ARRAYS MAY NEED ! FURTHER ADJUSTMENT I.E. IF THERE HAVE BEEN ANY REPLACEMENTS. ! %IF JN>MAXN %OR JN=IN %THEN -> END MJNUMB(I)=MJNUMB(IN) ;! CLOSE UP REMAINING CLOS:%CYCLE I=JN,1,MAXN MJBPTR(I)=MJBPTR(IN) ;! RECORDS IF NECESSARY MJPPTR(I)=MJPPTR(IN) IN=IN+1 ;! INCREMENT ARRAY POINTER %REPEAT ! ! 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 CLOS ! ! 2) SOME OR ALL OF THE NEW JOURNAL TITLES WILL NOT BE ADDED TO ! THE FILE AS THEY WOULD EXCEED THE ALLOCATED SPACE. ! OVFL:NEWLINES(2) PRINTSTRING('NUMBER OF JOURNALS WILL EXCEED PERMITTED MAXIMUM') NEWLINE PRINTSTRING('TOTAL NUMBER OF NEW JOURNALS SUBMITTED =') WRITE(NJNO,3) NEWLINE PRINTSTRING('MAXIMUM PERMITTED NUMBER AT PRESENT =') WRITE(MXNUMB-MAXN,3) NEWLINE PRINTSTRING('LAST') WRITE(NJNO-MXNUMB+MAXN,3) PRINTSTRING(' UPDATE RECORDS IGNORED') NEWLINE PRINTSTRING('INCREASE ARRAY SIZES BEFORE MAKING FURTHER ADDITIONS') NEWLINES(2) PRINTSTRING('JOB CONTINUED') NJNO=MXNUMB-MAXN ;! SET NEW VALUE JN=MXNUMB -> CONT ! ********************************************************************* ! ! ! ********************************************************************* ! %ROUTINE GET TITLE (%BYTEINTEGERARRAYNAME JNTITL %C %INTEGERNAME JST,JLNG,JNUM) ! ! ROUTINE FETCHES THE NEXT VALID JOURNAL TITLE FROM THE INPUT ! STREAM. THE NUMBER IS RETURNED IN JNUM WHILE THE TEXT OF THE ! TITLE IS STORED IN JNTITL STARTING AT JST AND OF LENGTH JLNG. ! ! THE INPUT RECORDS MUST BE IN THE FORMAT SPECIFIED ..... ! ! NNNNNN-S TEXT OF THE TITLE . . . . C ! ! NNNNNN THE 6-DIGIT JOURNAL NUMBER INC THE CHECK DIGIT ! ! S THE SEQUENCE NUMBER. TO ENSURE THE TEXT OF A TITLE ! DOES NOT GET OUT OF ORDER EACH 'CARD' FORMING PART OF ! A TITLE CARRIES A SEQUENCE NUMBER BETWEEN 1 AND 9 ! ! C WHERE A TITLE REQUIRES MORE THAN ONE 'CARD' ALL 'CARDS' ! EXCEPT THE LAST MUST HAVE THE CHARACTER 'C' IN THE 73RD 00208100 ! CHARACTER POSITION AS A CONTINUATION SYMBOL. ! %EXTERNALROUTINESPEC ISOCARD (%BYTEINTEGERARRAYNAME A) ! %BYTEINTEGERARRAY BUF(1:80) ;! INPUT BUFFER AREA %INTEGER SUM ;! USED TO CALCULATE CHECK DIGIT %INTEGER CD ;! CHECK DIGIT %INTEGER I ;! LOOP VARIABLE %INTEGER JS ;! CURRENT START VALUE OF J %INTEGER J ;! POINTER TO TITLE ARRAY %INTEGER LIM ;! PRINT LOOP LIMIT %INTEGER ST ;! PRINT LOOP START POINT %INTEGER RNO ;! SWITCH VARIABLE (RET(RNO)) %BYTEINTEGER CHAR ;! CURRENT CHARACTER %BYTEINTEGER CASE ;! CURRENT CASE (SHIFT OR NORMAL) %BYTEINTEGER SEQNO ;! SEQUENCE NUMBER ! %SWITCH ERR(1:6) ;! ERROR SWITCH %SWITCH RET(1:3) ;! RETURN SWITCH FROM PRINT ! ! ON ENTRY TO THE ROUTINE THE NEXT CARD IMAGE IS READ IN ! RDCD:ISOCARD(BUF) ;! READ I/P RECORD %IF BUF(1)='E' %THENC %START ;! END OF FILE FOUND JNUM=0 ;! SET ZERO AS EOF INDICATOR %RETURN ;! RETURN TO CALLING ROUTINE %FINISH ! ! CALCULATE CHECK DIGIT ! CHCD:SUM=0 ;! INITIALISE SUM %CYCLE I=1,1,5 SUM=SUM+(7-I)*(BUF(I)&X'0F') ;! ADD WEIGHTED VALUES %REPEAT CD=10-(SUM-SUM//11*11) ;! CALC SINGLE CHECK DIGIT %IF CD=10 %THEN CD=0 ;! AND COMPARE WITH THAT GIVEN %IF BUF(6)\=CD!X'30' %THEN -> ERR(1) ! ! VALID JOURNAL NUMBER ! JNUM=CONV(BUF,1,6) ;! CONVERT TO BINARY SEQNO='0' ;! INITIALISE SEQUENCE NUMBER CASE=X'20' ;! INITIALISE CASE TO SHIFT JS=JST ;! INITIALISE STARTING POINT ! ! CHECK SEQUENCING - IGNORING IF INVALID ! CHSQ:%IF BUF(8)\=SEQNO+1 %THEN -> ERR(2) SEQNO=BUF(8) ;! STORE NEW SEQUENCE NUMBER ! ! INPUT DATA IS O.K. AND IS ADDED TO THE CURRENT TITLE ! J=JS-1 ;! SET START VALUE OF POINTER %CYCLE I=10,1,72 ;! CYCLE THROUGH I/P RECORD 00213600 CHAR=BUF(I) ;! EXAMINE NEXT CHARACTER %IF CHAR='<' %OR CHAR='>' %THENC %START ;! CASE CHANGE - SET NEW CASE %IF CHAR='<' %THEN CASE=0 %ELSE CASE=X'20' -> REPT ;! CONTINUE %FINISH J=J+1 ;! UPDATE TITLE POINTER JNTITL(J)=CHAR!CASE ;! AND STORE CHARACTER REPT:%REPEAT ! ! WHEN THE END OF THIS I/P RECORD IS REACHED TRAILING BLANKS ARE ! REMOVED. A SINGLE SPACE IS LEFT IF A CONTINUATION IS EXPECTED ! CHKJ:%IF JNTITL(J)=' ' %THENC %START ;! BLANK CHARACTER J=J-1 ;! DECREMENT THE POINTER %IF J>JS %THEN -> CHKJ ;! CONTINU UNLESS START REACHED %IF JS=JST %THEN -> ERR(3) ;! ERROR - 1ST TITLE CARD BLANK -> ERR(4) ;! ERROR - BLANK CARD IN TITLE %FINISH ! ! CHECK FOR A CONTINUATION CARD ! %IF BUF(73)\='C' %THENC 00216000 %START ;! END OF TITLE REACHED JLNG=J-JST+1 ;! CALC LENGTH OF TITLE %RETURN ;! RETURN TO CALLING ROUTINE %FINISH JNTITL(J+1)=' ' ;! ENSURE SPACING CHAR IS BLANK JS=J+2 ;! CONTINUATION - ALLOW A BLANK ! ! READ CONTINUATION CARD AND CHECK THAT THE JOURNAL NUMBER AGREES ! RDCN:ISOCARD(BUF) ;! READ NEXT CARD %IF BUF(1)='E' %THEN -> ERR(5) ;! ERROR - END OF FILE FOUND %IF CONV(BUF,1,6)\=JNUM %THEN -> ERR(6) ;! ERROR - JNUM DISAGREES -> CHSQ ;! NUMBER O.K. CHECK SEQUENCING ! ! ERROR SECTION - MESSAGES AND OFFENDING RECORDS ARE PRINTED AND ! PROCESSING CONTINUES AS SUTABLE THEREAFTER. ! ERR(1):NEWLINES(2) ;! CHECK DIGIT WRONG PRINTSTRING(' ****** INVALID CHECK DIGIT - RECORD IGNORED') -> RET(1) ;! JUMP TO PRINT RECORD ! ERR(2):NEWLINES(2) ;! TITLE CARDS OUT OF ORDER PRINTSTRING(' ****** SEQUENCE NUMBER OUT OF ORDER - RECORD IGNORED') %IF SEQNO='0' %THEN -> RET(1) RNO=1 ;! JUMP TO PRINT RECORD -> PREC ! ERR(3):NEWLINES(2) ;! WARNING MESSAGE PRINTSTRING(' ****** BLANK CARD IN DATA - IGNORED') -> RDCD ;! READ NEXT RECORD ! ERR(4):NEWLINES(2) ;! WARNING MESSAGE PRINTSTRING(' ****** BLANK CARD IN RECORD - IGNORED') -> RDCN ;! READ REST OF CURRENT RECORD ! ERR(5):NEWLINES(2) ;! END OF FILE FOUND UNEXPECTEDLY PRINTSTRING(' ****** END OF DATA FOUND IN MIDDLE OF RECORD') PRINTSTRING(' - RECORD IGNORED') RNO=2 ;! PRINT RECORD DETAILS -> PREC RET(2):JNUM=0 ;! SET EOF INDICATOR %RETURN ;! RETURN TO CALLING ROUTINE ! ERR(6):NEWLINES(2) ;! JOURNAL NUMBER CHANGES PRINTSTRING(' ****** JOURNAL NUMBER CHANGES IN MIDDLE OF RECORD') PRINTSTRING(' - RECORD IGNORED') RNO=3 ;! JUMP TO PRINT RECORD -> PREC RET(3):%IF BUF(8)='1' %THEN -> CHCD ;! IF START OF NEW TITLE CONT NEWLINE ;! ELSE IGNORE 2ND REC TOO PRINTSTRING(' ****** NEW RECORD NOT IN ORDER - ALSO IGNORED') -> RET(1) ! ! ! THIS SECTION PRINTS THE I/P RECORDS THAT HAVE NOT BEEN ! TRANSFERRED TO THE TITLE ARRAY AND ARE TO BE IGNORED. ! RET(1):NEWLINE PRINTSTRING(' ****** ') %CYCLE I=1,1,80 PRINT SYMBOL(BUF(I)) %REPEAT %IF BUF(73)='C' %THENC 00222300 %START ;! READ ALL CONTINUATION CARDS ISOCARD(BUF) -> RET(1) ;! AND PRINT THEM FOR REFERENCE %FINISH -> RDCD ;! READ NEXT TITLE ! ! THIS SECTION PRINTS THE RECORD OR PART THEREOF THAT IS ALREADY ! IN THE ARRAY JNTITL. ! PREC:LIM=J ;! INITIALISE LIMIT ST=1 ;! INITIALISE START NLIN:NEWLINE PRINTSTRING(' ****** ') %IF LIM>80 %THENC %START ;! LINES OF 80 CHARS ARE PRINTED %CYCLE I=ST,1,ST+79 PRINT SYMBOL(JNTITL(I)) %REPEAT LIM=LIM-80 ;! DECREMENT LIMIT ST=ST+80 ;! UPDATE START POINT -> NLIN ;! PRINT NEXT LINE %FINISH %CYCLE I=ST,1,ST+LIM-1 PRINT SYMBOL(JNTITL(I)) ;! PRINT LAST LINE %REPEAT -> RET(RNO) ;! EXIT AS APPROPRIATE ! ! %END ;! GET TITLE ! %END;!RDMJN ! %END ;! OUTPUT TITLE ! ! ********************************************************************* ! %ROUTINE WRLST (%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C %INTEGER LENG,IND) ! ! THIS ROUTINE OUTPUTS THE CONTENTS OF OPAREA TO THE LISTING ! UNIT. IN THIS VERSION OUTPUT IS DIRECT TO THE LINE PRINTER ! SO UNIT IS NOT USED, IT IS HOWEVER INCLUDED FOR COMPATABILITY. ! ! THE FORM OF THE OUTPUT IS DEPENDENT ON THE VALUE OF IND ! 00226800 ! IND=1 NOT USED 00226900 ! ! IND=2 NOT USED ! ! IND=3 OUTPUTS ITEM DELIMITERS 00229600 ! ! IND=4 OUTPUTS THE CONTENTS OF OPAREA PRECEDED BY TEN SPACES ! 00100430 ! IND=5 AS FOR IND=4 BUT FOLLOWED BY A BLANK LINE 00100460 ! ! IND=0 LAST ENTRY PRINTS TERMINATION MESSAGE ! ! ALL THESE FORMS OF OUTPUT ARE SUITABLY SPACED ! ! %INTEGER I ;! LOOP VARIABLE ! %SWITCH ENTRY(0:5) ;! ENTRY SWITCH 00105300 ! -> ENTRY(IND) ;! JUMP TO APPROPRIATE POINT ! ! IND=3 OUTPUT ITEM DELIMITER ! ENTRY(3):NEWLINES(2) 00231100 %CYCLE I=1,1,MXLINE+5 PRINTSTRING("-") %REPEAT NEWLINES(3) %RETURN ! ! IND=4 TITLE OR RECORD SINGLE OUTPUT LINE ! IND=5 AS ABOVE FOLLOWED BY BLANK LINE 00108850 ! ENTRY(4):ENTRY(5):NEWLINE SPACES(5) 00232000 %CYCLE I=1,1,LENG PRINT SYMBOL(OPAREA(I)) %REPEAT %IF IND=5 %THEN NEWLINE %RETURN ! ! IND=0 LAST ENTRY EOJ MESSAGE OUTPUT ! ENTRY(0):NEWPAGE %CYCLE I=1,1,MXLINE+5 00232300 PRINTSTRING("*") %REPEAT NEWLINE %IF MXLINE<9 %THEN -> LINE 00232650 PRINTSTRING("*") 00232700 I=(MXLINE-6)//2 00232750 SPACES(I) 00232800 PRINTSTRING('END OF SDI') SPACES(MXLINE-7-I) 00233000 PRINTSTRING("*") 00233100 LINE:NEWLINE 00233200 %CYCLE I=1,1,MXLINE+5 00233300 PRINTSTRING("*") %REPEAT %RETURN %END;!WRLST ! ! ********************************************************************* ! %ROUTINE CREATELINE (%BYTEINTEGERARRAYNAME OPLINE,DATA, %C %INTEGER START,MXLINE,TNW, %C %INTEGERNAME LENGOP,END) ! ! THIS ROUTINE SETS UP LINES IN OPLINE BEGINNING AT START AND OF ! MAXIMUM LENGTH MXLINE. THE OUTPUT LINE IS BOTH LEFT AND RIGHT ! JUSTIFIED UNLESS THE OUTPUT DOES NOT FILL THE O/P AREA IN WHICH ! CASE ONLY LEFT JUSTIFICATION TAKES PLACE. THE END OF THE DATA ! IS INDICATED BY THE VARIABLE END BEING SET NON-ZERO. ! %OWNINTEGER FOB=1 ;! EXTRA SPACING SIDE INDIC %OWNINTEGER IST ;! POINTER TO CURRENT ITEM %OWNINTEGER NEW=1 ;! NEW DATA INDICATOR ! %INTEGER FRST ;! START POSN IN IRTEXT %INTEGER I ;! LOOP VARIABLE %INTEGER INC ;! NO OF SPACES TO BE INSERTED %INTEGER LENG ;! LENGTH OF ITEM %INTEGER LP ;! CURRENT O/P LINE POINTER %INTEGER NSP ;! NO OF GAPS TO RECEIVE SPACES %INTEGER NW ;! NUMBER OF WORDS IN LINE %INTEGER REM ;! NO OF SPARE POSNS REMAINING ! %SWITCH FILL(1:2) ;! ALTERNATE FILL OUT SWITCH ! %IF NEW=YES %THENC %START ;! FIRST ENTRY FOR NEW ITEM NEW=0 ;! SET NEW DATA SWITCH OFF IST=1 ;! SET START OF LOOP %FINISH LP=START-1 ;! INITIALISE LINE POINTER 00127700 ! ! THE CURRENT SECTION OF THE POINTER ARRAYS IS SCANNED AND THE ! NEXT LINE CREATED AFTER THE REQUIRED ALIGNMENT. ! %CYCLE I=IST,1,TNW %IF LP+TLNG(I)>MXLINE %THEN -> LNFUL ;! JUMP IF LINE FULL 00190700 LP=LP+TLNG(I)+TSPS(I) ;! INCREMENT LINE POINTER 00190800 %REPEAT ! ! END OF DATA REACHED - NO ALIGNMENT NECESSARY ! NW=TNW ;! SET WORD COUNT NEW=YES ;! RESET ENTRY VARIABLE LENGOP=LP-TSPS(TNW) ;! CALC LENGTH OF O/P LINE 00191500 %IF LENGOP CRLN ;! O/P SHORT LINE DIRECTLY 00191600 I=TNW+1 ;! BUT ADJUST LONG LAST LINE 00134850 ! ! END OF OUTPUT LINE REACHED - WORDS ARE LEFT AND RIGHT ADJUSTED ! AS REQUIRED. ! LNFUL:NW=I-1 ;! CALC NUMBER OF ITEMS 00119200 NSP=MXLINE-LP+TSPS(NW) ;! CALC NO OF SPARE SPACES 00192300 LENGOP=MXLINE ;! SET LENGTH OF O/P LINE %IF NW-IST<=0 %THEN -> CRLN ;! O/P LINE IF <= ONE ITEM 00136400 INC=NSP//(NW-IST) ;! CALC OVERALL INCREMENT 00136500 %IF INC=0 %THEN REM=NSP %ELSEC %START ;! OVERALL INCREMENT NON-ZERO %CYCLE I=IST,1,NW-1 ;! ADD APPROPRIATE VALUE TO TSPS(I)=TSPS(I)+INC ;! EACH SPACE ALLOWANCE 00193000 %REPEAT REM=NSP-((NW-IST)*INC) ;! CALCULATE REMAINDER 00137100 %FINISH %IF REM=0 %THEN -> CRLN ;! IF LINE FILLED NO ADJ NEC -> FILL(FOB) ;! ELSE FILL AS INDICATED ! FILL(1):FOB=2 ;! CHANGE SWITCH FOR NEXT TIME %CYCLE I=IST,1,IST+REM-1 ;! ADD SPARES FROM THE LEFT TSPS(I)=TSPS(I)+1 ;! ONE EXTRA PER SPACE 00193900 %REPEAT -> CRLN ;! JUMP TO CREATE O/P LINE ! FILL(2):FOB=1 ;! CHANGE SWITCH FOR NEXT TIME %CYCLE I=NW-REM,1,NW-1 ;! ADD SPARES FROM THE RIGHT TSPS(I)=TSPS(I)+1 ;! ONE EXTRA PER SPACE 00194500 %REPEAT ! ! WHEN WORDS HAVE BEEN PROPERLY SPACED OUT THE OUTPUT LINE IS CREATED ! CRLN:LP=START ;! INITIALISE LINE POSITION 00132400 SET (OPLINE,1,MXLINE,BLNK) ;! CLEAR O/P AREA %CYCLE I=IST,1,NW ;! CYCLE THROUGH WORDS 00122100 FRST=TBGN(I) ;! TRANSFER START TO INTEGER 00195300 LENG=TLNG(I) ;! TRANSFER LENGTH TO INTEGER 00195400 COPYTEXT (DATA,FRST,OPLINE,LP,LENG) LP=LP+TLNG(I)+TSPS(I) ;! UPDATE LINE POINTER 00201300 %REPEAT ! IST=NW+1 ;! INCREMENT START VAL FOR NEXT 00122750 END=NEW ;! SET EXIT INDICATOR %END ;! CREATELINE ! ! ********************************************************************* ! %ROUTINE OUTPUT ITEM (%INTEGER JNUM) ! ! THIS ROUTINE ASSEMBLES THE ITEM DETAILS FROM THE INTERNAL ! RECORD AND OUTPUTS THE RESULTING LINES. ! %BYTEINTEGERARRAY OPLINE(1:MXLINE);! O/P BUFFER %BYTEINTEGERARRAY TEMP(1:500) ;! TEMPORARY ARRAY FOR AUTHORS 00243300 ! %INTEGER I ;! LOOP VARIABLE %INTEGER ID ;! POINTER TO THE DIRECTORY %INTEGER INCT ;! LENGTH OF CURRENT ITEM %INTEGER IND ;! INDICATOR %INTEGER IT ;! POINTER TO THE INT REC TEXT %INTEGER IT1 ;! SUBSIDIARY PTR TO TEXT (1) %INTEGER IT2 ;! SUBSIDIARY PTR TO TEXT (2) %INTEGER LENGOP ;! LENGTH OF O/P LINE (BYTES) %INTEGER MXT ;! END OF CURRENT ITEM %INTEGER NW ;! WORD COUNT 00198150 %INTEGER OPST ;! START POSN OF O/P LINE %INTEGER RLN ;! LENGTH OF REFERENCE ENTRY 00246360 %INTEGER RST ;! START POS OF REFERENCE 00246330 %INTEGER RV ;! SWITCH CONTROL VALUE %INTEGER TPOS ;! CURRENT POS IN TEMP ARRAY %SWITCH RET(1:4) ;! RETURN FROM LINE O/P SWITCH ! SET (OPLINE,1,MXLINE,BLNK) ;! CLEAR O/P AREA ! ! REFERENCE NUMBER - THIS IS MOVED DIRECTLY TO THE O/P AREA ! IT=IRDIRC(PR) ;! SET START OF REFERENCE NO 00251700 COPYTEXT(IRTEXT,IT,OPLINE,1,4) ;! MOVE WEEK NUMBER OVER COPYTEXT(IRTEXT,IT+4,OPLINE,6,3) ;! MOVE ITEM NUMBER OPLINE(5)='/' WRLST(LSUNIT,OPLINE,8,4) ;! O/P TO LISTING UNIT ! ! TITLE - REALIGNED BY WORD BEFORE OUTPUT ! NW=1 ;! INITIALISE WORD POINTER IT=IRDIRC(PT) ;! SET START OF TITLE 00252600 %IF IT=0 %THEN -> RET(1) ;! SKIP IF NULL ITEM 00137650 MXT=IRDIRC(PT+1)+IT-1 ;! SET LENGTH OF TITLE 00252800 MARKWORDS(IRTEXT,IT,MXT,NW) ;! MARK POSN + LENGTH OF WORDS NW=NW-1 ;! ADJUST WORD TOTAL OPST=6 ;! SET START OF 1ST O/P LINE RV=1 ;! SET RETURN VALUE -> CRLN ;! JUMP TO O/P TITLE ! ! AUTHORS - EDIT IN TEMPORARY ARRAY BEFORE O/P AS THEY ARE STORED ! IN A SPECIAL COMPACT FORM IN THE INTERNAL RECORD. ! RET(1):OPLINE(1)=BLNK ;! OUTPUT BLANK LINE 00249050 WRLST(LSUNIT,OPLINE,1,4) 00249100 NW=1 ;! INITIALISE ITEM POINTER 00249150 IT=IRDIRC(PA) ;! SET FIRST TEXT POINTER 00253900 %IF IT=0 %THEN -> RET(2) ;! SKIP IF NULL ITEM 00138850 MXT=IT+IRDIRC(PA+1)-1 ;! SET LENGTH OF THIS ITEM 00254100 TPOS=1 ;! INITIALISE TEMP ARRAY POINTER ABGN:%IF (MXT-IT+1)>MXLINE*2//3 %THENC 00248300 %START ;! IF AUTHOR TOO LONG COPYTEXT(IRTEXT,IT,TEMP,TPOS,MXT-IT+1) ;! SPLIT INTO TERMS MARKWORDS(TEMP,TPOS,TPOS+MXT-IT,NW) NW=NW-1 ;! SET NUMBER OF WORDS 00249050 IT=MXT+1 ;! INCREMENT TEXT POINTER 00248750 -> AEND %FINISH TBGN(NW)=TPOS ;! ELSE TREAT AUTHOR AS ENTITY AMOV:TEMP(TPOS)=IRTEXT(IT) ;! MOVE NEXT CHARACTER TPOS=TPOS+1 ;! INCREMENT TEMP ARRAY PTR TPOS=TPOS+1 ;! INCREMENT TEMP ARRAY PTR %IF IRTEXT(IT)=ENDAUT %THENC %START ;! END OF AUTHOR SURNAME IT=IT+1 ;! UPDATE TEXT POINTER AINT: TEMP(TPOS)=IRTEXT(IT) ;! MOVE INITIALS IT=IT+1 ;! UPDATE POINTERS TO TEXT TPOS=TPOS+1 ;! AND TEMPORARY ARRAYS %IF IT>MXT %THEN -> ASET ;! EXIT IF END OF AUTHOR FOUND ! 00145900 ! A BLANK IS INSERTED BEFORE A CAPITAL LETTER UNLESS IT IS 00145925 ! IMMEDIATELY PRECEDED BY A SPECIAL CHARACTER OR MAC OR MC. 00145950 ! 00145975 %IF 'A'<=IRTEXT(IT)<='Z' %THENC 00146000 %START ;! NEXT CHARACTER IS CAPITAL 00146025 %IF 'A'<=TEMP(TPOS-1)<='Z' %ORC 00146050 SMA<=TEMP(TPOS-1)<=SMZ %THENC 00146075 %START ;! PRECEDED BY ALPHA-CHAR 00146100 %IF TEMP(TPOS-1)=SMC %THENC 00146125 %START ;! CHECK FOR MAC OR MC 00146150 %IF TEMP(TPOS-2)='M' %THEN -> AINT 00146175 %IF TEMP(TPOS-3)='M' %ANDC 00146200 TEMP(TPOS-2)=SMA %THEN -> AINT 00146225 %FINISH 00146250 TEMP(TPOS)=' ' ;! INSERT BLANK CHARACTER 00146275 TPOS=TPOS+1 ;! UPDATE POINTER 00146300 %FINISH 00146325 %FINISH 00146350 -> AINT ;! PROCESS NEXT CHARACTER %FINISH IT=IT+1 ;! UPDATE TEXT POINTER %IF IT<=MXT %THEN -> AMOV ;! CONTINUE TO END OF SURNAME ! ASET:TLNG(NW)=TPOS-TBGN(NW) ;! SET LENGTH OF EDITED AUTHOR 00205100 AEND:TSPS(NW)=3 ;! ALLOW EXTRA SPACING 00251800 %IF IRTEXT(IT)\=0 %THENC %START ;! FURTHER AUTHORS NW=NW+1 ;! UPDATE ITEM POINTER MXT=IRTEXT(IT)+IT ;! SET LIMIT OF THIS AUTHOR IT=IT+1 ;! SET FIRST TEXT POINTER -> ABGN ;!PROCESS NEXT AUTHOR %FINISH ACRL:CREATELINE(OPLINE,TEMP,1,MXLINE,NW,LENGOP,IND) 00142000 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! OUTPUT AUTHOR NAME LIST 00254400 %IF IND=0 %THEN -> ACRL ;! CONTINUE TO END OF AUTHORS 00142150 OPLINE(1)=BLNK ;! OUTPUT BLANK LINE 00254530 WRLST(LSUNIT,OPLINE,1,4) 00254560 ! ! BIBLIOGRAPHIC DETAILS ETC - FOR JOURNALS ONLY PAGINATION DETAILS ! ARE OUTPUT BUT FOR SPECIAL TYPE INPUT ALL SECTIONS ARE PRINTED. ! RET(2):NW=1 ;! RESET THE WORD POINTER 00142550 ID=PB ;! SET DIRECTORY POINTER 00259400 %IF JNUM>999000 %AND IRDIRC(PX)=0 %THENC 00259500 %START ;! SPECIAL TYPE INPUT 00148010 RST=IRDIRC(ID)+IRDIRC(ID+1)+1 ;! SET START OF REFERENCE 00255400 RLN=IRTEXT(RST-1) ;! SET LENGTH OF REFERENCE 00255450 IT=RST+RLN+1 ;! SET TEXT POINTER AND ITEM 00255500 INCT=IRTEXT(IT-1) ;! LENGTH, SKIPPING FIRST ENTRY 00255550 -> BCHK ;! JUMP TO PROCESS 00148050 %FINISH 00148060 !?? %START ;! JOURNAL OR PSEUDO-JOURNAL RST=0 ;! ZEROISE REFERENCE POINTER 00255850 IT1=IRDIRC(ID) ;! SET START OF FIRST ITEM 00246800 %IF IT1=0 %THEN -> BSKP ;! SKIP IF NULL ITEM 00142850 INCT=IRDIRC(ID+1) ;! SET LENGTH OF FIRST ITEM 00247000 BNXT: IT2=IT1+INCT ;! SET PTR TO LENGTH OF NEXT %IF IRTEXT(IT2)\=0 %THENC %START ;! NOT LAST ITEM IT1=IT2+1 ;! SET START OF NEXT ITEM INCT=IRTEXT(IT2) ;! SET LENGTH OF NEXT ITEM -> BNXT ;! CHECK NEXT %FINISH TBGN(NW)=IT1 ;! LAST ITEM IS PAGINATION 00208600 TLNG(NW)=INCT ;! SET START AND LENGTH 00208700 TSPS(NW)=2 ;! AND FOLLOW BY DOUBLE SPACE 00208800 NW=NW+1 ;! UPDATE THE COUNT BSKP: ID=ID+2 ;! SET NEXT DIRECTORY POINTER 00248200 !?? %FINISH BMOV:IT=IRDIRC(ID) ;! SET PTR TO 1ST ITEM FROM DIR %IF IT=0 %THEN -> BEND ;! SKIP IF THERE ARE NO ENTRIES INCT=IRDIRC(ID+1) ;! SET LENGTH OF FIRST ITEM ! ! A LARGE ITEM IS PROCESSED WORD BY WORD, BUT WHERE POSSIBLE AN ! ITEM IS TREATED AS AN ENTITY OF ITSELF. ! BCHK:%IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC00154100 %START TBGN(NW)=IT ;! SET START AND 00210100 TLNG(NW)=INCT ;! LENGTH OF ITEM 00210200 NW=NW+1 ;! UPDATE POINTER %FINISH TSPS(NW-1)=2 ;! FOLLOW BOTH BY DOUBLE SPACE 00210500 IT=IT+INCT+1 ;! SET START OF NEXT ITEM 00145650 INCT=IRTEXT(IT-1) ;! EXAMINE LENGTH OF NEXT ITEM 00145700 %IF INCT\=0 %THEN -> BCHK ;! CONTINUE IF NON-ZERO 00145800 BEND:ID=ID+2 ;! NO MORE ITEMS IN THIS SECTN %IF ID<=PN %THEN -> BMOV ;! UPDATE AND CONTINUE 00263600 NW=NW-1 ;! ADJUST TOTAL WHEN END REACHED RV=3 ;! SET RETURN VALUE %IF NW>0 %THEN -> CRLN ;! O/P ANY ITEMS IF NECESSARY ! ! LANGUAGE DETAILS ARE SIMILAR TO BIBLIOGRAPHIC DETAILS EXCEPT ! THAT MULTIPLE ITEMS WILL NOT APPEAR. ! RET(3):NW=1 ;! RESET ITEM POINTER LMOV:IT=IRDIRC(ID) ;! SET START OF ITEM %IF IT=0 %THEN -> REND ;! SKIP IF NO ENTRY INCT=IRDIRC(ID+1) ;! SET LENGTH OF ITEM %IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC %START ;! ITEM SUFFICIENTLY SMALL TBGN(NW)=IT ;! SET START AND 00212400 TLNG(NW)=INCT ;! LENGTH OF ITEM 00212500 TSPS(NW)=2 ;! FOLLOW BY DOUBLE SPACE 00212600 NW=NW+1 ;! INCREMENT POINTER %FINISH REND:ID=ID+2 ;! INCREMENT DIRECTORY POINTER %IF ID<=PD %THEN -> LMOV ;! CONTINUE IF FURTHER ENTRIES 00265600 NW=NW-1 ;! ELSE ADJUST ITEM TOTAL RV=4 ;! SET RETURN VALUE %IF NW<=0 %THEN -> RET(4) ;! SKIP O/P IF NO ITEMS ! ! OUTPUT IS CREATED AND 'WRITTEN' A LINE AT A TIME ! CRLN:CREATELINE(OPLINE,IRTEXT,OPST,MXLINE,NW,LENGOP,IND) 00149200 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! O/P TO LISTING DEVICE OPST=1 ;! ENSURE O/P LINED UP %IF IND=0 %THEN -> CRLN ;! CONTINUE IF END NOT REACHED 00139000 -> RET(RV) ;! RETURN TO APPROPRIATE POSN ! ! RECORD NOW OUTPUT - RETURN CONTROL TO CALLING ROUTINE ! RET(4):SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR OUTPUT AREA 00150100 %IF RST\=0 %THENC %START ;! O/P REF IF NON-JOURNAL ITEM I=MXLINE-RLN+1 COPYTEXT(IRTEXT,RST,OPLINE,I,RLN) WRLST(LSUNIT,OPLINE,MXLINE,4) %FINISH WRLST(LSUNIT,OPLINE,MXLINE,3) ;! OUTPUT DELIMITER LINES 00262500 ! %END ;! OUTPUTITEM ! ! ********************************************************************* ! %ROUTINE MARKWORDS(%BYTEINTEGERARRAYNAME ARR, %INTEGER ST,MAX, %C %INTEGERNAME NW) ! ! ROUTINE MARKS WORDS OF THE ARRAY 'ARR' USING THE ROUTINE MARKWORD 00234300 ! %ROUTINESPEC MARKWORD(%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C 00235330 %INTEGERNAME ST,LN,SP,IA) 00235360 MKWD:MARKWORD(ARR,MAX,TBGN(NW),TLNG(NW),TSPS(NW),ST) 00216100 %IF TBGN(NW)=0 %THEN %RETURN ;! RETURN WHEN END REACHED 00216200 NW=NW+1 ;! UPDATE WORD POINTER -> MKWD ;! JUMP TO FIND NEXT WORD ! ! ********************************************************************* ! %ROUTINE MARKWORD (%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C %INTEGERNAME ST,LN,SP,IA) ! ! THIS ROUTINE FINDS THE START AND LENGTH OF THE NEXT SEQUENCE OF ! NON-BLANK CHARACTERS IN THE ARRAY ARR(MXA) STARTING FROM THE ! POSITION IA. IF A SEQUENCE IS FOUND, ST IS SET TO THE VALUE OF ! IA WHEN THE FIRST CHARACTER IS FOUND, LN IS SET TO THE LENGTH OF ! THE WORD AND SP TO THE NUMBER OF SPACES WHICH IS TO FOLLOW IT. ! (SP DEPENDS ON THE LAST CHARACTER OF THE SEQUENCE) ON EXIT IA ! POINTS IMMEDIATELY PAST THE LAST CHARACTER OF THE SEQUENCE. ! %INTEGER IND ;! SWITCH VARIABLE %SWITCH S1,S2(1:2) ! ST=0 ;! SET START VALUE TO ZERO IND=1 ;! SET SWITCH VARIABLE -> CHCK ;! JUMP TO CHECK FIRST CHAR ! S1(1):S2(2):IA=IA+1 ;! INCREMENT POINTER CHCK:%IF IA > MXA %THENC %START ;! END OF ARRAY REACHED %IF ST=0 %THEN %RETURN ;! ERROR EXIT IF NO WORD FOUND -> S1(2) ;! ELSE SET LENGTH ETC. %FINISH %IF ARR(IA)=' ' %THEN -> S1(IND) ;! JUMP IF BLANK FOUND 00144600 -> S2(IND) ;! TO S1 ELSE JUMP TO S2 ! ! WHEN FIRST NON-BLANK FOUND THE SWITCH VARIABLE IS ALTERED SO THAT ! THE NEXT BLANK FOUND ACTS AS A TERMINATOR TO THE WORD. ! S2(1):IND=2 ;! CHANGE INDICATOR ST=IA ;! STORE START VALUE OF IA -> S1(1) ;! CONTINUE ! ! THE FIRST BLANK CHARACTER FOUND AFTER ANY NON-BLANK TERMINATES ! THE CURRENT WORD AND LENGTH ETC. MUST BE CALCULATED. ! S1(2):LN=IA-ST ;! SET LENGTH OF WORD 00272850 %IF ARR(IA-1)='.' %THEN SP=2 %ELSE SP=1 ;! CALCULATE SPACING ! %END ;! MARKWORD ! %END ;! MARKWORDS ! ! ********************************************************************* ! %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 ! 00229330 %END ;! PRINT SDI 00229340 ! ! ********************************************************************* ! %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 ! ! ********************************************************************* ! %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 ! %ROUTINE READ CONTROL 00270500 ! ! ********************************************************************* ! ! READ CONTROL ! ! ********************************************************************* ! ! THIS ROUTINE READS THE CONTROL DATA CARDS AND OVERWRITES THE ! DEFAULT VALUES INITIALLY SET UP IF NECESSARY. ! %BYTEINTEGERARRAY CARD(1:80) ;! I/P BUFFER ! %INTEGER CDTYPE ;! I/P CARD CODE %INTEGER CNT ;! I/P CARD COUNT %INTEGER I ;! LOOP VARIABLE %INTEGER J ;! SWITCH VARIABLE %INTEGER LIM ;! LOOP LIMIT %INTEGER NUM ;! NUMERIC I/P ! %SWITCH EXIT (1:3) %SWITCH TEST (1:3) ! ! SET DEFAULT VALUES ! ALL=0 ;! FULL DIAGNOSTICS NOT REQ 00280650 CHECK=YES ;! CHECK FILE IDENTIFIERS DUSER=0 ;! NO USERS REQUIRING DIAGNS 00280850 DIAGNS=0 ;! NO DIAGNOSTIC PRINTING MXLINE=50 ;! SET LINE LENGTH NEWSTS=0 ;! ADD STATS TO EXISTING FILE NJNO=0 ;! NO NEW JOURNAL TITLES UPDPROF=0 ;! USE EXISTING PROFILE FILE 00273500 WEEKNO=0 ;! WEEK NUMBER CANNOT BE SET ! CNT=0 ;! ZEROISE COUNT NEWLINES(2) PRINTSTRING('DATA CARDS') NXCD:NEWLINE %CYCLE I=1,1,80 ;! READ AND PRINT DATA CARD READ SYMBOL(CARD(I)) %IF CARD(I)=NL %THEN -> ANAL ;! JUMP OUT IF NEWLINE FOUND PRINT SYMBOL(CARD(I)) %REPEAT ! ANAL:LIM=I-1 ;! SET LIMIT OF I/P AREA CNT=CNT+1 ;! INCREMENT I/P CARD COUNT J=1 ;! INITIALISE SWITCH VARIABLE ! %CYCLE I=1,1,LIM -> TEST(J) TEST(1):%IF CARD(I)\=' ' %THENC %START ;! 1ST NON-BLANK FOUND J=2 CDTYPE=CARD(I) ;! SET CARD TYPE %IF CDTYPE='W' %OR CDTYPE='N' %OR CDTYPE='M' %OR CDTYPE='D' %C 00283500 %THEN -> REP 00283550 -> EXIT(3) ;! EXIT IF NO NUMERIC EXPECTED %FINISH -> REP TEST(2):%IF '0'<=CARD(I)<='9' %THENC %START ;! START OF NUMERIC ITEM FOUND J=3 NUM=CARD(I)&X'0F' ;! SET INITIAL VALUE %FINISH -> REP TEST(3):%IF '0'<=CARD(I)<='9' %THENC NUM=NUM*10+CARD(I)&X'0F' %ELSEC -> EXIT(3) ;! CONTINUE TO END OF NUMBER REP: %REPEAT 00277000 -> EXIT(J) ! EXIT(1):NEWLINE PRINTSTRING('*** WARNING *** BLANK CARD IN DATA') -> ERR2 ! EXIT(2):NEWLINE PRINTSTRING('*** WARNING *** NUMERIC ITEM EXPECTED BUT NOT FOUND') ERR1:PRINTSTRING(' ON CONTROL DATA CARD') WRITE(CNT,2) ERR2:PRINTSTRING(' - IGNORED') NEWLINE -> NXCD ! EXIT(3):%IF CDTYPE='E' %THEN -> PRNT ;! EXIT WHEN LAST I/P CARD READ %IF CDTYPE='M' %THEN %START; MXLINE=NUM; -> NXCD; %FINISH %IF CDTYPE='C' %THEN %START; CHECK=YES; -> NXCD; %FINISH %IF CDTYPE='W' %THEN %START; WEEKNO=NUM; -> NXCD; %FINISH %IF CDTYPE='P' %THEN %START; UPDPROF=YES; -> NXCD; %FINISH %IF CDTYPE='D' %THEN %START; DIAGNS=YES; -> DIAG; %FINISH 00286800 %IF CDTYPE='S' %THEN %START; NEWSTS=YES; -> NXCD; %FINISH %IF CDTYPE='N' %THEN %START; NJNO=NUM; -> NXCD; %FINISH ! NEWLINE PRINTSTRING('*** WARNING *** INVALID CARD TYPE') -> ERR1 ! DIAG:%IF NUM=0 %THEN ALL=YES %ELSEC %START NEWLINE 00283850 %CYCLE I=1,1,NUM READ(USER(I)) WRITE(USER(I),4) 00284050 %REPEAT DUSER=NUM %CYCLE I=1,1,80 READ SYMBOL(CARD(I)) %IF CARD(I)=NL %THEN -> NXCD %REPEAT %FINISH -> NXCD ! PRNT:NEWPAGE SPACES(30) PRINTSTRING('SDI OUTPUT CHECK LIST') SPACES(17) PRINTSTRING('WEEK') WRITE(WEEKNO,4) NEWLINE SPACES(30) PRINTSTRING('**************************************************') NEWLINES(2) SPACES(40) PRINTSTRING('FILE IDENTIFIER CHECKING') %IF CHECK\=YES %THEN PRINTSTRING(' NOT') PRINTSTRING(' REQUIRED') NEWLINE SPACES(40) %IF DIAGNS=YES %THENC %START %IF ALL=YES %THEN PRINTSTRING('FULL ') %C %ELSE PRINTSTRING('SELECTIVE ') %FINISH PRINTSTRING('DIAGNOSTIC PRINTING') %IF DIAGNS\=YES %THEN PRINTSTRING(' NOT') PRINTSTRING(' REQUIRED') NEWLINE SPACES(40) PRINTSTRING('PROFILES HAVE') %IF UPDPROF\=YES %THEN PRINTSTRING(' NOT') PRINTSTRING(' BEEN UPDATED') NEWLINE SPACES(40) %IF NEWSTS=YES %THENC PRINTSTRING('START NEW') %ELSEC PRINTSTRING('CONTINUE EXISTING') PRINTSTRING(' STATISTICS CUMULATION') NEWLINE SPACES(38) %IF NJNO=0 %THEN PRINTSTRING(' NO') %ELSE WRITE(NJNO,3) PRINTSTRING(' NEW JOURNAL TITLES') NEWLINE SPACES(40) PRINTSTRING('OUTPUT LINE WIDTH:') WRITE(MXLINE,2) PRINTSTRING(' CHARACTERS') ! %END ;! READ CONTROL %ROUTINE WRITE PROFILES (%INTEGER UNIT,MAX,%BYTEINTEGERARRAYNAME PROF) ! ! ********************************************************************* ! ! WRITE PROFILES ! ! ********************************************************************* ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC WRITEDA(%INTEGER CHANNEL,%INTEGERNAME SECTOR %C %NAME BEGIN,END) ! %INTEGERARRAY MX(1:1) ;! DUMMY ARRAY FOR O/P %INTEGER BLOCK ! OPENDA(UNIT) MX(1)=MAX ;! STORE MAX BLOCK=1 WRITEDA (UNIT,BLOCK,MX(1),MX(1)) BLOCK=BLOCK+1 WRITEDA (UNIT,BLOCK,PROF(1),PROF(MAX)) CLOSEDA(UNIT) ! %END ;! WRITE PROFILES %ROUTINE READ PROFILES (%INTEGERNAME UNIT,MAX, %C %BYTEINTEGERARRAYNAME PROF) ! ! ********************************************************************* ! ! READ PROFILES ! ! ********************************************************************* ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA(%INTEGER CHANNEL,%INTEGERNAME SECTOR %C %NAME BEGIN,END) ! %INTEGER BLOCK %INTEGERARRAY MX(1:1) ;! I/P AREA ! OPENDA(UNIT) BLOCK=1 READDA(UNIT,BLOCK,MX(1),MX(1)) ;! READ SIZE OF ARRAY MAX=MX(1) ;! RETURN MAX VALUE BLOCK=BLOCK+1 READDA(UNIT,BLOCK,PROF(1),PROF(MAX)) CLOSEDA(UNIT) ! %END ;! READ PROFILES ! 00295130 %END ;! PRODUCE SDI 00295160 %BEGIN 00296700 ! ! ! ********************************************************************* ! ! PROCESS STATS ! ! ********************************************************************* ! ! THIS SECTION OUTPUTS THE STATISTICAL INFORMATION GATHERED BY 00297500 ! THE PROGRAM AND ACCUMULATES IT WITH THAT ALREADY EXISTING ! %ROUTINESPEC CMSTS(%INTEGER ENO,UNIT,%INTEGERNAME WEEK1,NOWKS,MAX) %ROUTINESPEC SORTN(%INTEGERARRAYNAME AX,PTR, %INTEGER P1,P2,N) ! %INTEGERARRAY BFJNUM(1:MXNUMB) ;! CUM JOURNAL NUMBERS B/F !?? SHORT; %INTEGERARRAY BFIPCT(1:MXNUMB);! NUMBER OF I/P TERMS B/F !?? SHORT; %INTEGERARRAY BFOPCT(1:MXNUMB) ;! NUMBER OF O/P TERMS B/F !?? SHORT; %INTEGERARRAY BFUSCT(1:MXNUMB);! NUMBER OF USERS SERVED B/F %INTEGERARRAY CFJNUM(1:MXNUMB) ;! CUM JOURNAL NUMBERS C/F !?? SHORT; %INTEGERARRAY CFIPCT(1:MXNUMB);! NUMBER OF I/P ITEMS C/F !?? SHORT; %INTEGERARRAY CFOPCT(1:MXNUMB);! NUMBER OF O/P ITEMS C/F !?? SHORT; %INTEGERARRAY CFUSCT(1:MXNUMB);! NUMBER OF USERS SERVED C/F %INTEGERARRAY PTR (1:MXSTJN) ;! PTRS TO CURRENT WEEKS STATS ! %INTEGER BF ;! POINTER TO B/F ARRAYS %INTEGER CF ;! POINTER TO C/F ARRAYS %INTEGER CFIPTL ;! TOTAL CUMULATED I/P RECORDS 00290000 %INTEGER CFOPTL ;! TOTAL CUMULATED O/P RECORDS 00290100 %INTEGER I ;! LOOP VARIABLE %INTEGER IP ;! POINTER TO POINTER ARRAY %INTEGER J ;! POINTER TO STATS ARRAY %INTEGER MAX ;! NO OF JOURNALS IN B/F CUMUL %INTEGER MXCFJN ;! NO OF JOURNALS IN C/F CUMUL 00291000 %INTEGER N1 ;! USED AS INTERMEDIATE VALUES 00298830 %INTEGER N2 ;! WHEN PRINTING JOURNAL NUMBERS 00298860 %INTEGER NO ;! MERGE SWITCH VARIABLE %INTEGER NOWKS ;! NUMBER OF WEEKS IN CUMULATION %INTEGER RET ;! EXIT SWITCH VARIABLE %INTEGER STIPTL ;! COUNT OF CURRENT I/P RECS %INTEGER STOPTL ;! COUNT OF CURRENT O/P RECS %INTEGER WEEK1 ;! WEEK NUMBER OF 1ST WEEK ! %SWITCH EXIT (1:2) ;! CONTROL EXIT FROM HEADING SECT %SWITCH NXT (1:2) ;! CONTROL LOOP IN MERGE SECTN ! %CYCLE I=1,1,MXSTJN PTR(I)=I %REPEAT ! SORTN(STJNUM,PTR,1,MXSTJN,1) ! NEWPAGE SPACES(30) PRINTSTRING('ANALYSIS OF CURRENT WEEKS STATISTICS') SPACES(10) PRINTSTRING('WEEK') WRITE(WEEKNO,5) RET=1 HEAD:NEWLINE ;! O/P COLUMN HEADINGS SPACES(30) %CYCLE I=1,1,60 PRINTSTRING("*") %REPEAT NEWLINES(3) SPACES(59) PRINTSTRING('NO OF ITEMS') SPACES(7) PRINTSTRING('NO OF USERS') NEWLINE SPACES(42) PRINTSTRING('NO OF ITEMS') SPACES(6) PRINTSTRING('DISTIBUTED') SPACES(9) 00303700 PRINTSTRING('RECEIVING') NEWLINE SPACES(31) PRINTSTRING('JOURNAL') SPACES(7) PRINTSTRING('INPUT') SPACES(30) PRINTSTRING('ITEMS') NEWLINE SPACES(57) PRINTSTRING('TOTAL % OF I/P') NEWLINE -> EXIT(RET) ! EXIT(1):STIPTL=0 ;! CURRENT WEEKS STATS STOPTL=0 ;! ZEROISE COUNTERS %CYCLE IP=1,1,MXSTJN J=PTR(IP) NEWLINE SPACES(31) 00304700 N1=STJNUM(J) ;! PRINT JOURNAL NUMBER %CYCLE I=0,1,5 !?? ; N2=N1//INT(10**(5-I)) PRINT SYMBOL(N2!X'30') !?? ; N1=N1-N2*INT(10**(5-I)) %REPEAT WRITE(STIPCT(J),11) WRITE(STOPCT(J),10) PRINTSTRING(' (') PRINT(STOPCT(J)/STIPCT(J)*100.0,3,1) 00304900 PRINTSTRING(' )') WRITE(STUSCT(J),10) STIPTL=STIPTL+STIPCT(J) STOPTL=STOPTL+STOPCT(J) %REPEAT NEWLINES(2) SPACES(30) %CYCLE I=1,1,60 PRINTSTRING("*") %REPEAT NEWLINES(2) SPACES(31) PRINTSTRING('TOTAL') WRITE(STIPTL,12) WRITE(STOPTL,10) PRINTSTRING(' (') PRINT(STOPTL/STIPTL*100.0,3,1) 00306600 PRINTSTRING(' )') NEWLINES(2) SPACES(30) %CYCLE I=1,1,60 PRINTSTRING("*") %REPEAT NEWLINES(4) SPACES(31) PRINTSTRING('TOTAL NUMBER OF USERS') WRITE(STUSTL,7) 00300000 NEWLINES(2) SPACES(31) PRINTSTRING('NUMBER OF USERS SERVED') WRITE(STUSSV,6) 00300400 PRINTSTRING(' (') PRINT(STUSSV/STUSTL*100.0,3,1) 00308200 PRINTSTRING(' )') NEWLINES(2) SPACES(31) PRINTSTRING('AVERAGE NUMBER OF ITEMS PER USER') PRINT(STUSOP/STUSSV,4,1) 00310500 ! ! MERGE FILES IF REQUIRED PRINTING DETAILS AT THE SAME TIME ! %IF NEWSTS=YES %THENC %START NEWLINES(4) SPACES(31) PRINTSTRING('NEW STATISTICAL CUMULATION STARTED THIS WEEK') NOWKS=1 CMSTS(3,CSUNIT,WEEKNO,NOWKS,MXSTJN) 00310900 %STOP %FINISH CMSTS(1,CSUNIT,WEEK1,NOWKS,MAX) NOWKS=NOWKS+1 MXCFJN=MAX NEWPAGE SPACES(30) PRINTSTRING('ANALYSIS OF ACCUMULATED STATISTICS') SPACES(8) PRINTSTRING('WEEKS') WRITE(WEEK1,4) WRITE((-WEEKNO),4) RET=2 -> HEAD EXIT(2):CF=0 ;! INITIALISE PTRS AND VARIABLES CFIPTL=0 CFOPTL=0 J=1 IP=PTR(J) BF=1 ! NXT(1):CF=CF+1 NO=2 %IF STJNUM(IP)>BFJNUM(BF) %THENC %START ;! NO ITEMS FROM THIS JOURNAL CFJNUM(CF)=BFJNUM(BF) ;! IN CURRENT WEEKS INPUT 00313150 CFIPCT(CF)=BFIPCT(BF) 00313200 CFOPCT(CF)=BFOPCT(BF) CFUSCT(CF)=BFUSCT(BF) -> PRNT %FINISH %IF STJNUM(IP)MXSTJN %THENC %START STJNUM(IP)=1000000 %IF BF>MAX %THEN NO=2 %FINISH %ELSE IP=PTR(J) ! PRNT:NEWLINE ;! PRINT CUMULATION DETAILS SPACES(31) 00315000 N1=CFJNUM(CF) ;! PRINT JOURNAL NUMBER %CYCLE I=0,1,5 !?? ; N2=N1//INT(10**(5-I)) PRINT SYMBOL(N2!X'30') !?? ; N1=N1-N2*INT(10**(5-I)) %REPEAT WRITE(CFIPCT(CF),11) WRITE(CFOPCT(CF),10) PRINTSTRING(' (') PRINT(CFOPCT(CF)/CFIPCT(CF)*100.0,3,1) 00315200 PRINTSTRING(' )') WRITE(CFUSCT(CF),10) CFIPTL=CFIPTL+CFIPCT(CF) CFOPTL=CFOPTL+CFOPCT(CF) -> NXT(NO) NXT(2):%IF BF NXT(1) %FINISH %IF J<=MXSTJN %THENC %START BF=MAX+1 BFJNUM(BF)=1000000 -> NXT(1) %FINISH ! NEWLINES(2) SPACES(30) %CYCLE I=1,1,60 PRINTSTRING("*") %REPEAT NEWLINES(2) SPACES(31) PRINTSTRING('TOTAL') WRITE(CFIPTL,12) WRITE(CFOPTL,10) PRINTSTRING(' (') PRINT(CFOPTL/CFIPTL*100.0,3,1) 00317100 PRINTSTRING(' )') NEWLINES(2) SPACES(30) %CYCLE I=1,1,60 PRINTSTRING("*") %REPEAT NEWLINES(2) SPACES(31) PRINTSTRING('AVERAGE') PRINT(CFIPTL/NOWKS,8,1) 00318100 PRINT(CFOPTL/NOWKS,8,1) 00318200 NEWLINES(2) SPACES(30) %CYCLE I=1,1,60 PRINTSTRING("*") %REPEAT NEWPAGE ! WRSC:CMSTS(2,CSUNIT,WEEK1,NOWKS,MXCFJN) 00320800 ! %ROUTINE CMSTS(%INTEGER ENO,UNIT,%INTEGERNAME WEEK1,NOWKS,MAX) ! ! ********************************************************************* ! ! CMSTS ! ! ********************************************************************* ! %EXTERNALROUTINESPEC OPENDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA(%INTEGER CHANNEL,%INTEGERNAME SECTOR, %C %NAME BEGIN,END) %EXTERNALROUTINESPEC WRITEDA(%INTEGER CHANNEL,%INTEGERNAME SECTOR, %C %NAME BEGIN,END) ! %INTEGERARRAY CNT(1:3) %INTEGER BL %INTEGER I %INTEGER IP %SWITCH ENTRY(1:3) 00325200 ! -> ENTRY(ENO) ! ENTRY(1):OPENDA(UNIT) ;! OPEN FILE AND READ DATA BL=1 READDA (UNIT,BL,CNT(1),CNT(3)) WEEK1=CNT(1) NOWKS=CNT(2) MAX=CNT(3) BL=BL+1 READDA(UNIT,BL,BFJNUM(1),BFJNUM(MAX)) BL=BL+1 READDA (UNIT,BL,BFIPCT(1),BFIPCT(MAX)) BL=BL+1 READDA (UNIT,BL,BFOPCT(1),BFOPCT(MAX)) BL=BL+1 READDA (UNIT,BL,BFUSCT(1),BFUSCT(MAX)) %RETURN ! ENTRY(2):BL=1 ;! WRITE DATA + CLOSE FILE CNT(1)=WEEK1 CNT(2)=NOWKS CNT(2)=NOWKS CNT(3)=MAX BL=BL+1 WRITEDA(UNIT,BL,CFJNUM(1),CFJNUM(MAX)) BL=BL+1 WRITEDA(UNIT,BL,CFIPCT(1),CFIPCT(MAX)) BL=BL+1 WRITEDA(UNIT,BL,CFOPCT(1),CFOPCT(MAX)) BL=BL+1 WRITEDA(UNIT,BL,CFUSCT(1),CFUSCT(MAX)) CLOSEDA(UNIT) %RETURN ! ENTRY(3):OPENDA(UNIT) ;! SORT FIRST WEEKS DATA %CYCLE I=1,1,MAX IP=PTR(I) CFJNUM(I)=STJNUM(IP) CFIPCT(I)=STIPCT(IP) CFOPCT(I)=STOPCT(IP) CFUSCT(I)=STUSCT(IP) %REPEAT -> ENTRY(2) ! %END ;! CMSTS ! %ROUTINE SORTN(%INTEGERARRAYNAME AX,PTR, %INTEGER P1,P2,N) ! ! ********************************************************************* ! ! SORTN ! ! ********************************************************************* ! %INTEGERFNSPEC SIGN(%INTEGERARRAYNAME AX, %INTEGER K1,K2,N) %INTEGERARRAY UT(1:20), LT(1:20) %INTEGER Q,M,P,T,X,I,J,K ! I=P1 J=P2 ;! INITIALISE ARRAY VARIABLES M=1 ! START: %IF J-I < 1 %THEN -> ENDCHK %IF J-I = 1 %THEN -> LSTCHK ! P=(J+I)//2 ;! SET MID-POINT T=PTR(P) PTR(P)=PTR(I) Q=J K=I+1 ! NEXT:%IF SIGN(AX,PTR(K),T,N) > 0 %THENC %START LIMCHK: %IF Q CHANGE %FINISH %IF SIGN(AX,PTR(Q),T,N) < 0 %THENC %START ;! SWOP POINTERS X=PTR(K) PTR(K)=PTR(Q) PTR(Q)=X Q=Q-1 %FINISH %ELSEC %START Q=Q-1 -> LIMCHK %FINISH %FINISH K=K+1 %IF K <= Q %THEN -> NEXT ! CHANGE:PTR(I)=PTR(Q) PTR(Q)=T %IF Q > P %THENC %START LT(M)=I UT(M)=Q-1 I=Q+1 %FINISH %ELSEC %START LT(M)=Q+1 UT(M)=J J=Q-1 %FINISH M=M+1 -> START ! LSTCHK:%IF SIGN(AX,PTR(I),PTR(J),N) > 0 %THENC %START X=PTR(I) PTR(I)=PTR(J) PTR(J)=X %FINISH ! ENDCHK:M=M-1 %IF M> 0 %THENC %START I=LT(M) J=UT(M) -> START %FINISH ! %INTEGERFN SIGN (%INTEGERARRAYNAME AX, %INTEGER K1,K2,N) ! ! ********************************************************************* ! ! SIGN ! ! ********************************************************************* ! %RESULT = AX(K1) - AX(K2) %END ;! SIGN %END ;! SORT %END ;! PROCESS STATS ! %ENDOFPROGRAM