%BEGIN 00000100 %CONTROL 0 ! COMPILE TIME 18 ETU ! RUN TIME 4WKS 99 ETU ! ! PROGRAM TO PRODUCE THE MONTHLY BULLETIN OUTPUT FROM ANY 00000200 ! NUMBER OF FILES, SPECIFIED BY THE CONTROL CARDS. 00000300 ! 00000400 %INTEGER AL ;! LENGTH OF AUTHOR FIELD 00000500 %INTEGER AS ;! START OF AUTHOR FIELD 00000600 %INTEGER AUUNIT ;! AUTHOR LISTING UNIT %INTEGER BLUNIT ;! BULLETIN I/P FILE %INTEGER BLNK ;! BLANK WORD %INTEGER BLOCK ;! CURRENT BLOCK NUMBER %INTEGER BUL ;! FILE COUNT 00001100 %INTEGER CDTYPE ;! INPUT CARD TYPE 00001200 %INTEGER CHECK ;! CHECKING INDICATOR 00001300 %INTEGER CNT ;! INPUT CARD COUNT 00001400 %INTEGER CONCST ;! MASTER CONC POINTER 00001500 %INTEGER CSECT ;! CURRENT RECORD SECTOR 00001600 %INTEGER DIAGNS ;! DIAGNOSTIC PRINT INDICATOR 00001700 %INTEGER DNUM ;! DIAGNOSTIC PRINT VARIABLE 00001800 %INTEGER ENDAUT ;! AUTHOR S/NAME TERMINATOR 00001900 %INTEGER I ;! LOOP VARIABLE 00002000 %INTEGER IC ;! POINTER TO CONCORDANCE 00002100 %INTEGER IN ;! POINTER TO NUMBER,POINTF 00002200 %INTEGER IS ;! POINTER TO SECTOR ARRAY 00002300 %INTEGER ITEMNO ;! ITEM OUTPUT NUMBER 00002400 %INTEGER J ;! LOOP VARIABLE 00002500 %INTEGER LIM ;! LOOP LIMIT 00002600 %INTEGER LSUNIT ;! LISTING DEVICE LUN 00002700 %INTEGER MAXC ;! NUMBER OF CONCORDED ITEMS 00002800 %INTEGER MAXN ;! ACTUAL NO OF DIFF JOURN NOS 00002900 %INTEGER MJUNIT ;! MASTER JOURNAL FILE LUN 00003000 %INTEGER MONTH ;! CURRENT MONTH 00003100 %INTEGER MXBUFA ;! AUTHOR INDEX BUFFER SIZE %INTEGER MXBUFB ;! BULLETIN I/P BUFFER SIZE 00003200 %INTEGER MXBUFR ;! REPORT NO INDEX BUF SIZE %INTEGER MXBUFS ;! DIMENSION OF M/JOURN BUFFER 00003300 %INTEGER MXCNCJ ;! MAX NO ITEMS/WEEK 00003400 %INTEGER MXCNTB ;! SIZE OF BULLETIN CONTROL BUF 00003500 %INTEGER MXCONC ;! TOTAL NO OF ITEMS 00003600 %INTEGER MXDIRC ;! SIZE OF RECORD DIRECTORY 00003700 %INTEGER MXLINE ;! MAX LENGTH OF O/P LINE 00003800 %INTEGER MXNUM ;! NO OF JOURNS IN BULLETIN 00003900 %INTEGER MXNUMB ;! NO OF DIFFERENT JOURN NOS 00004000 %INTEGER MXNUMJ ;! NO OF JOURNS IN WEEK 00004100 %INTEGER MXTEXT ;! SIZE OF RECORD TEXT 00004200 %INTEGER MXTITL ;! MAX SIZE OF JOURNAL TITLE 00004300 %INTEGER MXWDS ;! MAX NO OF ITEMS OF ANALYSIS 00004400 %INTEGER NJNO ;! NUMBER OF NEW JOURNALS 00004500 %INTEGER NL ;! NEWLINE SYMBOL 00004600 %INTEGER NO ;! DATA VALUE OR RDBUL INDICATOR 00004700 %INTEGER NSECTS ;! NO OF SECTIONS OF INTEREST 00004800 %INTEGER NW ;! NUMBER OF O/P TERMS 00004900 %INTEGER ONE ;! CONSTANT 00005000 %INTEGER OPUNIT ;! BULLETIN O/P LOGICAL UNIT NO 00005100 %INTEGER PA ;! POINTER TO AUTHOR DETAILS 00005200 %INTEGER PB ;! PROFILE POSN OF BIB DETS 00005300 %INTEGER PD ;! POINTER TO END OF LANGS 00005400 %INTEGER PJ ;! POINTER TO EXTRA REFS 00005500 %INTEGER PN ;! POINTER TO EXTRA NOTE 00005600 %INTEGER POSN ;! POSITION WITHIN BLOCK 00005700 %INTEGER PR ;! POINTER TO CULHAM REF NO 00005800 %INTEGER PT ;! POINTER TO TITLE DETAILS 00005900 %INTEGER PX ;! POINTER TO SPECIAL JOURN TITL 00006000 %INTEGER R1 ;! VARIABLES USED TO 00006100 %INTEGER R2 ;! EXTRACT DIGITS 00006200 %INTEGER RPUNIT ;! REPORT LIST LUN 00006300 %INTEGER RS ;! RECORD SEPARATOR CHARACTER 00006400 %INTEGER SW ;! SCANNING SWITCH VARIABLE 00006500 %INTEGER WEEKNO ;! WEEK NUMBER 00006600 %INTEGER YES ;! CONSTANT 00006700 ! 00006800 %BYTEINTEGER SMA ;! LOWER CASE A 00006900 %BYTEINTEGER SMC ;! LOWER CASE C 00007000 %BYTEINTEGER SMZ ;! LOWER CASE Z 00007100 ! 00007200 %BYTEINTEGERARRAY CARD(1:80) ;! CONTROL CARD I/P AREA 00007300 %BYTEINTEGERARRAY SECT(1:26) ;! OUTPUT SECTORS REQUIRED 00007400 %BYTEINTEGERARRAY UNIT(1:100) ;! UNIT NUMBERS OF FILES 00007500 ! 00007600 %SWITCH TEST (1:3) ;! SWITCH FOR CHECKING I/P CARDS 00007700 %SWITCH EXIT (1:3) ;! EXIT SWITCH FROM CHECKING CDS 00007800 ! 00007900 ! THE CONTROL AND DIMENSION VARIABLES ARE SET IN THIS OUTER BLOCK 00008000 ! 00008100 MXBUFA=1000 ;! AUTHOR INDEX BUFFER SIZE MXBUFB=1000 ;! BULLETIN BUFFER SIZE (BYTES) 00008200 MXBUFR=1000 ;! REPORT NO INDEX BUF SIZE MXBUFS=1000 ;! MASTER JOURNAL BUFFER SIZE 00008300 MXCNCJ=500 ;! MAX NO ITEMS/WEEK 00008400 MXCNTB=500 ;! BULLETIN CONTROL BUFFER SIZE 00008500 MXCONC=1000 ;! TOTAL NO OF ITEMS 00008600 MXDIRC=32 ;! SIZE OF DIRECTORY 00008700 MXNUM=800 ;! TOTAL NO OF JOURNS 00008800 MXNUMJ=200 ;! NO OF JOURNS THIS WEEK 00008900 MXNUMB=1024 ;! MAX SIZE OF JOURN NO ARRAYS 00009000 MXTEXT=500 ;! MAX SIZE OF TEXT ARRAY 00009100 MXTITL=500 00009200 MXWDS=100 ;! MAX NO OF ITEMS OF ANALYSIS 00009300 ! 00009400 AUUNIT=3 ;! LUN AUTHOR INDEX STREAM 00009500 LSUNIT=99 ;! LUN LISTING UNIT 00009600 MJUNIT=30 ;! LUN MASTER JOURNAL FILE 00009700 OPUNIT=20 ;! LUN BULLETIN O/P 00009800 RPUNIT=4 ;! LUN REPORT NO INDEX 00009900 ! 00010000 BLNK=M' ' ;! BLANK WORD 00010100 IS=0 ;! INITIALISE POINTER 00010200 MAXC=0 ;! SET ITEM COUNT TO ZERO 00010300 ENDAUT=',' ;! END AUTHOR SURNAME IND 00010400 NL=X'0A' ;! SET NEWLINE SYMBOL 00010500 ONE=1 ;! SET CONSTANT 00010600 PA=5 ;! SET AUTHOR PTR 00010700 PB=7 ;! PROFILE POSN OF BIB DETS 00010800 PD=10 ;! SET END OF LANG PTR 00010900 PJ=12 ;! SET EXTRA REFS PTR 00011000 PN=8 ;! SET EXTRA NOTE POINTER 00011100 PR=2 ;! SET PTR TO CULHAM REF NO 00011200 PT=4 ;! SET TITLE POINTER 00011300 PX=11 ;! SET PTR TO SPECIAL TITLES 00011400 RS='/' ;! REC SEP CHAR - NEW JOURN I/P 00011500 SMA=X'61' ;! LOWER CASE A 00011600 SMC=X'63' ;! LOWER CASE C 00011700 SMZ=X'7A' ;! LOWER CASE Z 00011800 YES=1 ;! CONSTANT 00011900 ! 00012000 ! 00012100 ! SET DEFAULT VALUES 00012200 ! 00012300 CHECK=1 ;! CHECK WEEK NUMBER AGREES 00012400 DIAGNS=0 ;! NO DIAGNOSTIC PRINTING 00012500 WEEKNO=0 ;! ZEROISE WEEK NUMBER 00012600 NJNO=0 ;! ZEROISE NO OF NEW JOURN TITLES00012700 MXLINE=46 ;! STANDARD LINE WIDTH 00012800 ! 00012900 ! READ IN DATA CARDS 00013000 ! 00013100 CNT=0 ;! ZEROISE RECORD COUNT 00013200 NEWLINE 00013300 PRINTSTRING('DATA CARDS') 00013400 NXTCD:NEWLINE 00013500 %CYCLE I=1,1,80 00013600 READ SYMBOL (CARD(I)) ;! READ NEXT DATA CARD 00013700 %IF CARD(I)=X'0A' %THEN -> SET ;! JUMP WHEN NEWLINE FOUND 00013800 PRINT SYMBOL (CARD(I)) ;! PRINT FOR REFERENCE 00013900 %REPEAT 00014000 ! 00014100 ! CARD READ IN - SEARCH FOR ITEMS TO BE EXTRACTED 00014200 ! 00014300 SET: LIM=I-1 ;! STORE NUMBER OF CHARS 00014400 CNT=CNT+1 ;! INCREMENT DATA CARD COUNT 00014500 J=1 ;! INITIALISE SWITCH VALUE 00014600 ! 00014700 %CYCLE I=1,1,LIM ;! CYCLE THRO CARD 00014800 -> TEST(J) 00014900 ! 00015000 TEST(1):%IF CARD(I)\=' ' %THENC 00015100 %START ;! START OF DATA FOUND 00015200 J=2 ;! UPDATE SWITCH 00015300 CDTYPE=CARD(I) ;! EXTRACT CARD TYPE 00015400 %IF CDTYPE='B' %OR CDTYPE='N' %OR CDTYPE='M' %THEN -> REP 00015500 -> EXIT(3) 00015600 %FINISH 00015700 -> REP ;! CONTINUE 00015800 ! 00015900 TEST(2):%IF '0' <= CARD(I) <= '9' %THENC 00016000 %START ;! START OF NUMERIC ITEM FOUND 00016100 J=3 ;! UPDATE SWITCH POINTER 00016200 NO=CARD(I)&X'0F' ;! EXTRACT FIRST VALUE 00016300 %FINISH 00016400 -> REP ;! CONTINUE 00016500 ! 00016600 TEST(3):%IF '0'<=CARD(I)<='9' %THENC 00016700 NO=NO*10+CARD(I)&X'0F' %ELSEC 00016800 -> EXIT(3) ;! EXIT AT END OF NUMBER 00016900 REP: %REPEAT ;! CONTINUE CHECKING RECORD 00017000 ! 00017100 ! RECORD NOW COMPLETELY CHECKED - JUMP TO APPROPRIATE EXIT POINT 00017200 ! 00017300 -> EXIT(J) 00017400 ! 00017500 ! ERROR SECTION - THE CONTROL DATA CARD IS INVALID, A WARNING 00017600 ! MESSAGE IS PRINTED AND THE JOB CONTINUES. 00017700 ! 00017800 EXIT(1):NEWLINE 00017900 PRINTSTRING(' *** WARNING *** NO VALID CHARACTERS FOUND') 00018000 -> ERR 00018100 ! 00018200 EXIT(2):NEWLINES(2) 00018300 PRINTSTRING(' *** WARNING *** NUMERIC ITEM EXPECTED BUT NOT FOUND')00018400 ERR: PRINTSTRING(' ON CONTROL DATA CARD') 00018500 WRITE (CNT,2) 00018600 PRINTSTRING(' - IGNORED') 00018700 NEWLINE 00018800 -> NXTCD ;! JUMP TO CONTINUE 00018900 ! 00019000 ! THE NUMERIC ITEM IS TRANSFERRED TO THE APPROPRIATE VARIABLE 00019100 ! 00019200 EXIT(3):%IF CDTYPE='S' %THEN -> RETN ;! EXIT IF SECTION CARD 00019300 %IF CDTYPE='B' %THEN %START; MONTH =NO; -> NXTCD; %FINISH 00019400 %IF CDTYPE='C' %THEN %START; CHECK=YES; -> NXTCD; %FINISH 00019500 %IF CDTYPE='N' %THEN %START; NJNO=NO; -> NXTCD; %FINISH 00019600 %IF CDTYPE='D' %THEN %START;DIAGNS=YES; -> NXTCD; %FINISH 00019700 %IF CDTYPE='M' %THEN %START; MXLINE=NO; -> NXTCD; %FINISH 00019800 ! 00019900 ! INVALID CODE - O/P ERROR MESSAGE AND IGNORE 00020000 ! 00020100 NEWLINES(2) 00020200 PRINTSTRING(' *** WARNING *** INVALID CARD TYPE') 00020300 -> ERR 00020400 ! 00020500 ! CHARACTERS DEFINING SECTIONS TO BE INCLUDED ARE NOW READ IN 00020600 ! 00020700 RETN:%IF CARD(I)=' ' %THEN -> INC 00020800 I=I+1 00020900 -> RETN 00021000 INC: I=I+1 00021100 %IF 'A'<=CARD(I)<='Z' %ANDC 00021200 (CARD(I-1)<'A' %OR CARD(I-1)>'Z') %ANDC 00021300 (CARD(I+1)<'A' %OR CARD(I+1)>'Z') %THENC 00021400 %START ;! EXTRACT SECTION CODE 00021500 IS=IS+1 00021600 SECT(IS)=CARD(I) ;! STORE IN ARRAY 00021700 %FINISH 00021800 %IF I INC 00021900 NSECTS=IS ;! STORE NUMBER OF SECTIONS 00022000 ! 00022100 ! END OF CONTROL DETAILS - PRINT FINAL INFORMATION 00022200 ! 00022300 NEWPAGE 00022400 SPACES(10) ;! MAIN HEADING 00022500 PRINTSTRING('BULLETIN OUTPUT CHECK LIST') 00022600 SPACES(10) 00022700 PRINTSTRING('MONTH') 00022800 WRITE(MONTH,4) ;! PRINT MONTH NUMBER 00022900 NEWLINE 00023000 SPACES(10) ;! UNDERLINE 00023100 %CYCLE I=1,1,49 00023200 PRINTSTRING("*") 00023300 %REPEAT 00023400 NEWLINES(2) 00023500 SPACES(20) ;! CHECK VALUE 00023600 PRINTSTRING('FILE IDENTIFIER CHECKING') 00023700 %IF CHECK\=YES %THEN PRINTSTRING(' NOT') 00023800 PRINTSTRING(' REQUIRED') 00023900 NEWLINE 00024000 SPACES(20) ;! DIAGNS VALUE 00024100 PRINTSTRING('DIAGNOSTIC PRINTING') 00024200 %IF DIAGNS\=YES %THEN PRINTSTRING(' NOT') 00024300 PRINTSTRING(' REQUIRED') 00024400 NEWLINE 00024500 SPACES(19) ;! NO OF NEW JOURN TITLES 00024600 %IF NJNO=0 %THEN PRINTSTRING(' NO') %ELSE WRITE(NJNO,2) 00024700 PRINTSTRING(' NEW JOURNAL TITLES') 00024800 NEWLINE 00024900 SPACES(20) ;! LINE WIDTH 00025000 PRINTSTRING('OUTPUT LINE WIDTH:') 00025100 WRITE(MXLINE,2) 00025200 PRINTSTRING(' CHARACTERS') 00025300 NEWLINE ;! SECTIONS COVERED 00025400 SPACES(20) 00025500 PRINTSTRING('BULLETIN COVERS SECTION') 00025600 %IF NSECTS>1 %THEN PRINTSTRING("S") 00025700 %CYCLE IS=1,1,NSECTS 00025800 SPACE 00025900 PRINT SYMBOL(SECT(IS)) 00026000 %REPEAT 00026100 %IF NSECTS=1 %THEN PRINTSTRING(' ONLY') 00026200 ! 00026300 ! **************************************************************** 00026400 ! 00026500 %BEGIN 00026600 ! 00026700 ! ARRAYS ARE SET UP IN THIS SECONDARY BLOCK FOR EASE OF ALTERING 00026800 ! THEIR DIMENSIONS AS AND WHEN REQUIRED. 00026900 ! 00027000 %ROUTINESPEC RDBUL (%INTEGERNAME UNIT,BLOCK,POSN,NO) 00027100 %ROUTINESPEC AUTHORLIST (%INTEGER AUUNIT, %C 00027200 %BYTEINTEGERARRAYNAME AUTH, %C 00027300 %INTEGER AS,AL,REF) 00027400 %ROUTINESPEC REPORTLIST (%INTEGER RPUNIT, %C 00027500 %BYTEINTEGERARRAYNAME REP, %C 00027600 %INTEGER RS,RL,REF) 00027700 %ROUTINESPEC OUTPUT TITLE (%INTEGER JNUM) 00028400 %ROUTINESPEC OUTPUT ITEM (%INTEGER JNUM) 00028500 %ROUTINESPEC CREATELINE (%BYTEINTEGERARRAYNAME OPLINE,DATA, %C 00028600 %INTEGER START,MXLINE,TNW, %C 00028700 %INTEGERNAME LENGOP,END) 00028800 %ROUTINESPEC COPYTEXT (%BYTEINTEGERARRAYNAME FROM, %INTEGER FRST, %C 00028900 %BYTEINTEGERARRAYNAME TO,%INTEGER TOST,LENG) 00029000 %ROUTINESPEC WRBOP(%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C 00029100 %INTEGER PARM,IND) 00029200 %ROUTINESPEC WRLST (%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C 00029300 %INTEGER LENG,IND) 00029400 %ROUTINESPEC MARKWORDS (%BYTEINTEGERARRAYNAME ARR, %C 00029500 %INTEGER ST,MAX, %INTEGERNAME NW) 00029600 %ROUTINESPEC MARKWORD (%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C 00029700 %INTEGERNAME ST,LN,SP,IA) 00029800 %ROUTINESPEC SET (%BYTEINTEGERARRAYNAME A,%INTEGER START,END,VAL) 00029900 %ROUTINESPEC SORTN (%INTEGERARRAYNAME NUMBER,PTR, %C 00030000 %INTEGER MINN,MAXN,L) 00030100 ! 00030200 %INTEGERARRAY JNUMB(1:MXNUMJ) 00030300 %INTEGERARRAY NUMBER(1:MXNUM) ;! JOURNAL NUMBERS 00030400 %INTEGERARRAY NPTR(1:MXNUM) ;! POINTERS TO JOURN NOS 00030500 %INTEGERARRAY MJNUMB(1:MXNUMB) ;! MASTER JOURNAL NUMBERS 00030600 !?? SHORT;%INTEGERARRAY JPNTF(1:MXNUMJ) ;! SINGLE WEEKS POINTERS 00030700 !?? SHORT; %INTEGERARRAY JPNTL(1:MXNUMJ) ;! TO CONCORDANCE ARRAYS 00030800 !?? SHORT; %INTEGERARRAY POINTF(1:MXNUM) ;! POINTER TO 1ST CONC ENTRY00030900 !?? SHORT; %INTEGERARRAY CONC1(1:MXCONC) ;! BLOCK POINTER 00031000 !?? SHORT; %INTEGERARRAY CONC2(1:MXCONC) ;! POSITION POINTER 00031100 !??SHORT; %INTEGERARRAY CONC3(1:MXCONC) ;! POINTER TO NEXT CONCORDANCE00031200 !?? SHORT; %INTEGERARRAY JCNC1(1:MXCNCJ) ;!SINGLE WEEK'S 00031300 !?? SHORT; %INTEGERARRAY JCNC2(1:MXCNCJ) ;! CONCORDANCE DETAILS 00031400 !?? SHORT; %INTEGERARRAY JCNC3(1:MXCNCJ) ;! BLOCK,POSN,LINK 00031500 !?? SHORT; %INTEGERARRAY WBGN(1:MXWDS) ;! START OF ITEM IN TEXT 00031600 !?? SHORT; %INTEGERARRAY WLNG(1:MXWDS) ;! LENGTH OF ITEM IN TEXT 00031700 !?? SHORT; %INTEGERARRAY WSPS(1:MXWDS) ;! NUMBER OF FOLLOWING SPACES00031800 !?? SHORT; %INTEGERARRAY MJBPTR(1:MXNUMB) ;! M/JOURN BLOCK POINTERS 00031900 !?? SHORT; %INTEGERARRAY MJPPTR(1:MXNUMB) ;! M/JOURN POSN POINTERS 00032000 !?? SHORT; %INTEGERARRAY IRDIRC(1:MXDIRC);! DIRECTORY TO INTERNAL RECORD00032100 %BYTEINTEGERARRAY IRTEXT(1:MXTEXT) ;! TEXT OF INTERNAL RECORD 00032200 %BYTEINTEGERARRAY OPLINE(1:MXLINE) ;! O/P BUFFER AREA 00032300 %BYTEINTEGERARRAY UNITNO(1:MXNUM) ;! ASSOCIATED UNIT NUMBERS 00032400 ! 00032500 %SWITCH S1(1:4),S2(1:4) ;! SCANNING CONTROLS 00032600 ! 00032700 ! THE REQUIRED WEEK NUMBERS ARE READ IN AND THE APPROPRIATE 00032800 ! FILES OPENED. MASTER INDEXES ARE SET UP FOR THE 00032900 ! SECTIONS REQUESTED. 00033000 ! 00033100 BUL=0 ;! ZEROISE COUNT OF FILES 00033200 CONCST=1 ;! INITIALISE MASTER INDEX 00033300 IN=0 ;! ARRAY POINTERS 00033400 ! 00033500 NXCD:%CYCLE I=1,1,80 00033600 READ SYMBOL(CARD(I)) ;! INPUT NEXT CARD 00033700 %IF CARD(I)=NL %THEN -> TEST 00033800 %REPEAT 00033900 TEST:LIM=I-1 ;! SET DATA LIMIT 00034000 I=0 ;! ZEROISE POINTER 00034100 SEEK:I=I+1 ;! INCREMENT 00034200 %IF CARD(I)=' ' %THEN -> SEEK ;! IGNORE LEADING BLANKS 00034300 %IF CARD(I)='E' %THEN -> PROC ;! CHECK FOR TERMINATION 00034400 %IF CARD(I)='W' %THEN -> EXTR ;! JUMP TO EXTRACT DATA 00034500 -> NXCD ;! IGNORE OTHER CODES 00034600 ! 00034700 ! EACH CARD IS SCANNED TO EXTRACT THE WEEK NUMBER AND 00034800 ! ASSOCIATED FILE NUMBER. A ZERO WEEK NUMBER SUPPRESSES 00034900 ! IDENTIFIER CHECKING ON THAT FILE ONLY. 00035000 ! 00035100 EXTR:SW=1 ;! INIT SCANNING SWITCH 00035200 S1(1):S1(3):I=I+1 00035300 %IF '0'<=CARD(I)<='9' %THEN -> S2(SW) ;! NUMERIC 00035400 -> S1(SW) ;! NON-NUMERIC 00035500 ! 00035600 S2(1):SW=2 ;! 1ST NUMERIC STRING FOUND 00035700 WEEKNO=0 ;! ZEROISE WEEK NUMBER 00035800 S2(2):WEEKNO=WEEKNO*10+CARD(I)&X'0F' ;! ADD NEXT DIGIT 00035900 -> S1(1) 00036000 ! 00036100 S1(2):SW=3 ;! END OF 1ST NUM STRING 00036200 -> S1(1) 00036300 ! 00036400 S2(3):SW=4 ;! 2ND NUMERIC STRING FOUND 00036500 BLUNIT=0 ;! ZEROISE UNIT NUMBER 00036600 S2(4):BLUNIT=BLUNIT*10+CARD(I)&X'0F' ;! ADD NEXT DIGIT 00036700 -> S1(1) 00036800 ! 00036900 ! CONTROL BLOCK READ FROM SPECIFIED FILE AND UNIT NO STORED 00037000 ! 00037100 S1(4):RDBUL(BLUNIT,BLOCK,POSN,ONE) ;! OPEN FILE, READ CONTROL 00037200 BUL=BUL+1 ;! UPDATE FILE COUNT 00037300 UNIT(BUL)=BLUNIT ;! STORE UNIT NUMBER 00037400 ! 00037500 ! SCAN CONTROL BLOCKS TO EXTRACT REQUIRED REFERENCES 00037600 ! 00037700 %CYCLE I=1,1,MAXN 00037800 CSECT<-JNUMB(I)>>24 ;! EXTRACT SECTION CODE 00037900 %CYCLE IS=1,1,NSECTS 00038000 %IF CSECT=SECT(IS) %THEN -> ADDP ;! INCLUDE REQ SECTION 00038100 %REPEAT 00038200 -> REP 00038300 ! 00038400 ! NUMBERS AND CONCORDANCE POINTERS ARE SET UP IN MASTER INDEX 00038500 ! 00038600 ADDP:IN=IN+1 ;! INCREMENT INDEX POINTER 00038700 NPTR(IN)=IN ;! STORE POINTER 00038800 NUMBER(IN)=JNUMB(I) ;! STORE JOURNAL NUMBER 00038900 POINTF(IN)=CONCST ;! POINT TO NEXT SPARE CONC 00039000 UNITNO(IN)=BLUNIT ;! STORE UNIT NUMBER 00039100 IC=JPNTF(I) ;! MARK 1ST CONC ENTRY 00039200 ! 00039300 ADDC:CONC1(CONCST)=JCNC1(IC) ;! STORE REFERENCES 00039400 CONC2(CONCST)=JCNC2(IC) 00039500 %IF JCNC3(IC)=0 %THENC 00039600 %START ;! END OF REFERENCES 00039700 CONC3(CONCST)=0 ;! SET MARKER 00039800 CONCST=CONCST+1 ;! UPDATE POINTER 00039900 -> REP 00040000 %FINISH 00040100 CONC3(CONCST)=CONCST+1 ;! CHAIN REFERENCES 00040200 CONCST=CONCST+1 ;! UPDATE POINTER 00040300 IC=JCNC3(IC) ;! SET NEXT OLD PTR 00040400 -> ADDC 00040500 REP: %REPEAT 00040600 -> NXCD ;! PROCESS NEXT CARD 00040700 ! 00040800 ! THE MASTER INDEX TO THE REQUIRED SECTION(S) HAS BEEN SET 00040900 ! UP AND IS NOW SORTED TO ASCENDING ORDER. 00041000 ! 00041100 PROC:MAXC=CONCST-1 ;! SET CONCORDANCE LIMIT 00041200 MAXN=IN ;! SET INDEX LIMIT 00041300 SORTN(NUMBER,NPTR,1,MAXN,1) 00041400 %IF DIAGNS=YES %THENC 00041500 %START ;! PRINT NUMBERS AND CONCORDANCE 00041600 NEWLINES(5) ;! ............................. 00041700 SPACES(5) ;! ............................. 00041800 PRINTSTRING('JOURNAL NUMBERS');! ........................ SPACES(6) ;! ............................. 00042000 PRINTSTRING('CONC') ;! ............................. 00042100 NEWLINE ;! ............................. 00042200 SPACES(3) ;! ............................. 00042300 PRINTSTRING('ON I/P') ;! ............................. 00042400 SPACES(8) ;! ............................. 00042500 PRINTSTRING('SORTED') ;! ............................. 00042600 SPACES(4) ;! ............................. 00042700 PRINTSTRING('PTRS') ;! ............................. 00042800 SPACES(4) ;! ........................ PRINTSTRING('UNIT') ;! ........................ NEWLINE ;! ............................. 00042900 %CYCLE J=1,1,MAXN ;! ............................. 00043100 NEWLINE ;! ............................. 00043200 SPACES(2) ;! ............................. 00043300 PRINT SYMBOL(NUMBER(J)>>24&X'FF') 00043400 DNUM=NUMBER(J)&X'FFFFFF' ;! ............................. 00043500 WRITE(DNUM,7) ;! ............................. 00043600 SPACES(5) ;! ............................. 00043700 DNUM=NUMBER(NPTR(J)) ;! ............................. 00043800 PRINT SYMBOL(DNUM>>24&X'FF') ;! ............................. 00043900 DNUM=DNUM&X'FFFFFF' ;! ............................. 00044000 WRITE(DNUM,7) ;! ............................. 00044100 WRITE(POINTF(NPTR(J)),5) ;! ............................. 00044200 WRITE(UNITNO(NPTR(J)),6) ;! ........................ %REPEAT ;! ............................. 00044300 NEWLINES(3) ;! ............................. 00044400 SPACES(10) ;! ............................. 00044500 PRINTSTRING('CONCORDANCE') ;! ............................. 00044600 NEWLINE ;! ............................. 00044700 SPACES(6) ;! ............................. 00044800 PRINTSTRING('BLOCK POSN NEXT');!........................... 00044900 NEWLINE ;! ............................. 00045000 %CYCLE J=1,1,MAXC ;! ............................. 00045100 NEWLINE ;! ............................. 00045200 WRITE(J,3) ;! ............................. 00045300 WRITE(CONC1(J),5) ;! ............................. 00045400 WRITE(CONC2(J),6) ;! ............................. 00045500 WRITE(CONC3(J),5) ;! ............................. 00045600 %REPEAT ;! ............................. 00045700 %FINISH ;! ............................. 00045800 ! 00045900 ! THE ENTRIES ARE NOW PROCESSED IN ASCENDING NUMERICAL ORDER. FOR 00046000 ! EACH JOURNAL NUMBER A TITLE IS OUTPUT FOLLOWED BY THE ITEMS. 00046100 ! 00046200 %IF MAXN<=0 %THENC 00046300 %START 00046400 NEWLINES(2) 00046600 SPACES(20) 00046700 PRINTSTRING('****** ') 00046800 PRINTSTRING('NO RELEVANT ITEMS') 00046900 PRINTSTRING(' ******') 00047000 -> CLBL 00047100 %FINISH 00047200 NO=2 ;! SET ENTRY VALUE 00047300 ITEMNO=0 ;! INITIALISE ITEM COUNT %CYCLE I=1,1,MAXN 00047400 IN=NPTR(I) ;! SET POINTER TO NUMBER 00047500 IC=POINTF(IN) ;! SET FIRST CONCORDANCE PTR 00047600 BLUNIT=UNITNO(IN) ;! SET UNIT NUMBER BLOCK=CONC1(IC) ;! SET NUMBER OF 1ST BLOCK 00047700 POSN =CONC2(IC) ;! SET POSN WITHIN THAT BLOCK 00047800 RDBUL(BLUNIT,BLOCK,POSN,NO) ;! READ FIRST RECORD 00047900 OUTPUT TITLE (NUMBER(IN)) ;! OUTPUT TITLE FOR THESE RECS 00048000 NEXT:%IF DIAGNS=YES %THENC 00048100 %START ;! PRINT OF CURRENT RECORD 00048200 NEWLINES(2) ;! ............................. 00048300 PRINTSTRING('BLOCK =') ;! ............................. 00048400 WRITE(BLOCK,3) ;! ............................. 00048500 PRINTSTRING(' POSN =') ;! ............................. 00048600 WRITE(POSN,3) ;! ............................. 00048700 SPACES(10) ;! ............................. 00048800 %CYCLE J=1,2,IRDIRC(1)-1 ;! ............................. 00048900 WRITE(IRDIRC(J),3) ;! ............................. 00049000 WRITE(IRDIRC(J+1),3) ;! ............................. 00049100 PRINTSTRING(' //') ;! ............................. 00049200 %REPEAT ;! ............................. 00049300 NEWLINE ;! ............................. 00049400 %CYCLE J=1,1,IRDIRC(2) ;! ............................. 00049500 %IF IRTEXT(J)<' ' %THEN WRITE(IRTEXT(J),2) %ELSEC 00049600 PRINT SYMBOL(IRTEXT(J)) 00049700 %REPEAT ;! ............................. 00049800 NEWLINE ;! ............................. 00049900 %FINISH ;! ............................. 00050000 ITEMNO=ITEMNO+1 ;! UPDATE COUNT 00050100 AS=IRDIRC(2*PA+1) ;! SET START AND LENGTH 00050200 AL=IRDIRC(2*PA+2) ;! OF FIRST AUTHOR 00050300 %IF AS=0 %THEN -> NOAU ;! IGNORE IF NO ENTRY 00050400 OPAU:AUTHORLIST(AUUNIT,IRTEXT,AS,AL,ITEMNO) ;! ADD THIS AUTHOR 00050500 %IF IRTEXT(AS+AL)>0 %THENC 00050600 %START 00050700 AS=AS+AL+1 ;! SET START AND LENGTH 00050800 AL=IRTEXT(AS-1) ;! OF NEXT AUTHOR 00050900 -> OPAU 00051000 %FINISH 00051100 NOAU:%IF (NUMBER(IN)&X'FFFFFF')/10=999023 %THENC 00051200 %START ;! REPORT - O/P TO LIST 00051300 R1=IRDIRC(2*PB+1)+IRDIRC(2*PB+2)+1 ;! SET POINTERS R2=IRTEXT(R1-1) REPORTLIST (RPUNIT,IRTEXT,R1,R2,ITEMNO) %IF IRDIRC(2*PJ+1)>0 %THENC 00051600 %START ;! EXTRA REFS PRESENT 00051700 R1=IRDIRC(2*PJ+1) ;! SET POINTERS 00051800 R2=IRDIRC(2*PJ+2) 00051900 OPRP: REPORTLIST(RPUNIT,IRTEXT,R1,R2,ITEMNO) 00052000 %IF IRTEXT(R1+R2)>0 %THENC 00052100 %START 00052200 R1=R1+R2+1 00052300 R2=IRTEXT(R1-1) 00052400 -> OPRP 00052500 %FINISH 00052600 %FINISH 00052700 %FINISH 00052800 OUTPUT ITEM (NUMBER(IN)) ;! O/P RECORD DETAILS 00052900 IC=CONC3(IC) ;! EXTRACT NEXT CONC POINTER 00053000 %IF IC\=0 %THENC 00053100 %START ;! FURTHER RECS UNDER THIS JOURN 00053200 BLOCK=CONC1(IC) ;! SET NEXT BLOCK POINTER 00053300 POSN =CONC2(IC) ;! SET NEXT POSITION POINTER 00053400 RDBUL(BLUNIT,BLOCK,POSN,NO) ;! READ RECORD FROM FILE 00053500 -> NEXT ;! JUMP TO O/P 00053600 %FINISH 00053700 %REPEAT 00053800 ! 00053900 ! WHEN ALL JOURNALS HAVE BEEN PROCESSED THE FILE HANDLING ROUTINES 00054000 ! ARE CALLED TO CLOSE THE FILES AND TIDY UP AS NECESSARY. 00054100 ! 00054200 OUTPUT TITLE (0) ;! FINAL CALL - CLOSE FILES AUTHORLIST(AUUNIT,IRTEXT,0,0,0) ;! PRODUCE AUTHOR LIST 00054300 REPORTLIST(RPUNIT,IRTEXT,0,0,0) ;! PRODUCE REPORT NO INDEX 00054400 CLBL:NO=3 ;! SET INDICATOR 00054600 %CYCLE I=1,1,BUL 00054700 BLUNIT=UNIT(I) ;! CLOSE ALL I/P FILES 00054800 RDBUL(BLUNIT,BLOCK,POSN,NO) 00054900 %REPEAT 00055000 %STOP ;! END OF JOB 00055100 ! 00055200 ! ********************************************************************* 00055300 ! 00055400 %ROUTINE RDBUL (%INTEGERNAME UNIT,BLOCK,POSN,NO) 00055500 ! 00055600 ! THE ROUTINE HAS EFFECTIVELY THREE ENTRYPOINTS DEPENDING ON THE 00055700 ! VALUE OF NO WHICH MAY BE 1,2 OR 3. 00055800 ! 00055900 ! NO=1 FIRST ENTRY - THE DISC FILE (UNIT) IS OPENED AND THE CONTROL00056000 ! BLOCK READ. THE APPROPRIATE BLOCKS ARE THEN READ IN AND THE 00056100 ! POINTER TABLES SET UP. CONTROL IS THEN RETURNED. 00056200 ! 00056300 ! NO=2 NORMAL ENTRY - THE RECORD COMMENCING AT BYTE (POSN) IN 00056400 ! SECTOR (BLOCK) IS READ FROM THE DISC FILE AND TRANSFERRED 00056500 ! TO THE DIRECTORY AND TEXT ARRAYS. 00056600 ! 00056700 ! NO=3 WHEN PROCESSING IS COMPLETE THE PROGRAM MUST CALL RDBUL 00056800 ! WITH NO=3 TO CLOSE THE DISC FILE. 00056900 ! 00057000 %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) 00057100 %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) 00057200 %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL, %C 00057300 %INTEGERNAME SECT, %C 00057400 %NAME BEGIN,END) 00057500 ! 00057600 %OWNBYTEINTEGERARRAY BUF(1:1000) ;! INPUT BUFFER 00057700 !?? SHORT; %INTEGERARRAY CNTBUF(1:500) ;! CONTROL AREA BUFFER 00057800 ! 00057900 %SWITCH ENTRY(1:3) ;! ENTRYPOINT SWITCH 00058000 %OWNINTEGER SECT ;! SECTOR CURRENTLY IN BUFFER 00058100 %OWNINTEGER STUNIT ;! UNIT CURRENTLY IN USE ! 00058200 %INTEGER CSEC ;! CONCORDANCE START SECTOR 00058300 %INTEGER I ;! LOOP VARIABLE 00058400 %INTEGER IB ;! BUFFER POINTER 00058500 %INTEGER IC ;! LENGTH OF CONCORDANCE 00058600 %INTEGER IN ;! LENGTH OF POINTER TABLES 00058700 %INTEGER J ;! LOOP VARIABLE 00058800 %INTEGER K ;! LOOP VARIABLE 00058900 %INTEGER NSEC ;! PTR TABLES START SECTOR 00059000 ! 00059100 ! JUMP TO APPROPRIATE ENTRY POINT 00059200 ! 00059300 -> ENTRY(NO) 00059400 ! 00059500 ! FIRST ENTRY - OPEN FILE, CHECK WEEK NUMBER IF REQUIRED 00059600 ! AND SET UP THE CONTROL TABLES. 00059700 ! 00059800 ENTRY(1):OPENDA(UNIT) ;! OPEN FILE 00059900 SECT=1 ;! READ CONTROL BLOCK 00060000 READDA(UNIT,SECT,CNTBUF(1),CNTBUF(MXCNTB)) %IF CHECK=YES %AND WEEKNO>0 %THENC 00060200 %START ;! CHECK WEEK NUMBER 00060300 %IF WEEKNO\=CNTBUF(1) %THENC 00060400 %START ;! WEEK NUMBER FAILS TO AGREE 00060500 NEWLINE ;! PRINT MESSAGE 00060600 PRINTSTRING('WEEK NUMBERS DO NOT AGREE ON UNIT') 00060700 WRITE (UNIT,2) 00060800 NEWLINE 00060900 PRINTSTRING('WEEK') ;! PRINT DETAILS 00061000 WRITE(WEEKNO,4) 00061100 PRINTSTRING(' REQUESTED') 00061200 NEWLINE 00061300 PRINTSTRING('WEEK') 00061400 WRITE(CNTBUF(1),4) 00061500 PRINTSTRING(' IN THIS FILE') 00061600 NEWLINES(2) ;! TERMINATE JOB 00061700 PRINTSTRING('*** JOB TERMINATED ***') 00061800 %STOP 00061900 %FINISH 00062000 %FINISH %ELSEC 00062100 WEEKNO=CNTBUF(1) ;! SET WEEK NUMBER 00062200 ! 00062300 ! SET CONTROL VARIABLES FROM CONTROL BLOCK. 00062400 ! 00062500 IN=CNTBUF(2) ;! LENGTH OF POINTER TABLE 00062600 NSEC=CNTBUF(3) ;! START SECTOR OF TABLES 00062700 IC=CNTBUF(4) ;! LENGTH OF CONCORDANCE 00062800 CSEC=CNTBUF(5) ;! START SECTOR OF CONCORDANCES 00062900 ! 00063000 ! READ POINTER TABLES FROM DISC - THEY MAY BE IN ONE SECTOR OR 00063100 ! SEVERAL DEPENDING ON THE TOTAL NUMBER OF DIFFERENT JOURNALS. 00063200 ! 00063300 %IF 8*IN<=MXBUFB %THENC 00063400 %START ;! POINTERS IN SINGLE SECTOR 00063500 READDA(UNIT,NSEC,CNTBUF(1),CNTBUF(MXCNTB)) 00063600 J=IN+IN ;! START OF POINTER 1 00063700 K=J+IN ;! START OF POINTER 2 00063800 %CYCLE I=1,1,IN 00063900 JNUMB(I)=INTEGER(ADDR(CNTBUF(I+I-1))) 00064000 JPNTF(I)=CNTBUF(J+I) 00064100 JPNTL(I)=CNTBUF(K+I) 00064200 %REPEAT 00064300 %FINISH %ELSEC 00064400 %START ;! POINTERS IN SEVERAL SECTORS 00064500 READDA(UNIT,NSEC,JNUMB(1),JNUMB(IN)) 00064600 NSEC=NSEC+1 00064700 READDA(UNIT,NSEC,JPNTF(1),JPNTF(IN)) 00064800 NSEC=NSEC+1 00064900 READDA(UNIT,NSEC,JPNTL(1),JPNTL(IN)) 00065000 %FINISH 00065100 ! 00065200 ! SET MAXIMUM NUMBER OF JOURNALS AND READ CONCORDANCE ARRAYS 00065300 ! 00065400 MAXN=IN 00065500 READDA(UNIT,CSEC,JCNC1(1),JCNC1(IC)) 00065600 CSEC=CSEC+1 00065700 READDA(UNIT,CSEC,JCNC2(1),JCNC2(IC)) 00065800 CSEC=CSEC+1 00065900 READDA(UNIT,CSEC,JCNC3(1),JCNC3(IC)) 00066000 %RETURN 00066100 ! 00066200 ! NORMAL ENTRY - THE BLOCK NUMBER REQUESTED IS CHECKED AGAINST THE 00066300 ! NUMBER OF THE SECTOR CURRENTLY IN THE BUFFER TO AVOID UNNECESSARY 00066400 ! READING FROM THE DISC. 00066500 ! 00066600 ENTRY(2):%IF BLOCK=SECT %AND UNIT=STUNIT %THEN -> E2 !?? %START ;! DISC READ NECESSARY 00066800 SECT=BLOCK ;! SET SECTOR NUMBER 00066900 STUNIT=UNIT ;! STORE NEW UNIT NUMBER READDA(UNIT,SECT,BUF(1),BUF(MXBUFB)) 00067000 !?? %FINISH 00067100 ! 00067200 ! TRANSFER DATA FROM THE BUFFER TO THE INTERNAL RECORD. 00067300 ! 00067400 E2: IB=POSN ;! SET BUFFER POINTER ! 00067600 DIRC:%CYCLE I=1,1,MXDIRC ;! TRANSFER DIRECTORY SECTION 00067700 IRDIRC(I)=INTEGER(ADDR(BUF(IB))); !?? WAS SHORTINTEGER 00067800 IB=IB+2 ;! UPDATE BUFFER POINTER 00067900 %IF IB>MXBUFB %THENC 00068000 %START ;! END OF BUFFER REACHED 00068100 SECT=SECT+1 ;! UPDATE CURRENT SECTOR NUMBER 00068200 READDA(UNIT,SECT,BUF(1),BUF(MXBUFB)) 00068300 IB=1 ;! RESET BUFFER POINTER 00068400 %FINISH 00068500 %REPEAT 00068600 ! 00068700 TEXT:%CYCLE I=1,1,IRDIRC(2) ;! TRANSFER TO TEXT ARRAY 00068800 IRTEXT(I)=BUF(IB) 00068900 IB=IB+1 ;! UPDATE BUFFER POINTER 00069000 %IF IB>MXBUFB %THENC 00069100 %START ;! END OF BUFFER REACHED 00069200 SECT=SECT+1 ;! UPDATE CURRENT SECTOR NUMBER 00069300 READDA(UNIT,SECT,BUF(1),BUF(MXBUFB)) 00069400 IB=1 ;! RESET BUFFER POINTER 00069500 %FINISH 00069600 %REPEAT 00069700 ! 00069800 %RETURN 00069900 ! 00070000 ! THE LAST ENTRY CLOSES THE FILE 00070100 ENTRY(3):CLOSEDA(UNIT) 00070200 %END ;! RDBUL 00070300 ! 00070400 ! ********************************************************************* 00070500 ! 00070600 %ROUTINE OUTPUT TITLE (%INTEGER JNUM) 00070700 ! 00070800 ! THIS ROUTINE OUTPUTS THE APPROPRIATE TITLE FOR THE JOURNAL 00070900 ! NUMBER JNUM TOGETHER WITH ANY MAIN OR SUB-HEADINGS REQUIRED. 00071000 ! 00071100 %ROUTINESPEC RDMJN(%INTEGER UNIT, %INTEGERNAME BLOCK,POS, %INTEGER IND) 00071200 ! 00071300 %OWNBYTEINTEGERARRAY HDJRN(1:8)='J','O','U','R','N','A','L','S' 00071400 %OWNBYTEINTEGERARRAY ZHD(1:10)=1,9,19,25,40,47,0,0,0,0 00071500 %OWNBYTEINTEGERARRAY ZHEAD(1:63)=7,'R','E','P','O','R','T','S', 00071600 9,'P','A','M','P','H','L','E','T','S', 00071700 5,'B','O','O','K','S', 00071800 14,'A','N','N','U','A','L',' ','R','E','P', 00071900 'O','R','T','S', 00072000 6,'T','H','E','S','E','S', 00072100 16,'T','R','A','D','E',' ','C','A','T','A', 00072200 'L','O','G','U','E','S' 00072300 %OWNBYTEINTEGERARRAY VIP(1:13)=4,X'76',X'6F',X'6C',X'2E',3,X'6E', 00072400 X'6F',X'2E',3,X'70',X'74',X'2E' 00072500 %OWNBYTEINTEGERARRAY NONAM(1:18)='*',' ','T','I','T','L','E',' ', 00072600 'N','O','T',' ','F','O','U','N', 00072700 'D',' ' 00072800 ! 00072900 %BYTEINTEGERARRAY OPLINE(1:MXLINE) ;! O/P AREA 00073000 %BYTEINTEGERARRAY JNTITL(1:MXTITL) ;! JOURNAL TITLE TEXT 00073100 ! 00073200 %INTEGER END ;! END OF O/P INDICATOR 00073300 %INTEGER I ;! LOOP VARIABLE 00073400 %INTEGER ID ;! DIRECTORY POINTER 00073500 %INTEGER INCT ;! LENGTH OF CURRENT ITEM 00073600 %INTEGER IT ;! TEXT POINTER 00073700 %INTEGER J ;! LOOP VARIABLE 00073800 %INTEGER K ;! LOOP VARIABLE 00073900 %INTEGER L ;! FIELD LIMIT 00074000 %INTEGER LENGOP ;! LENGTH OF O/P LINE 00074100 %INTEGER LIM ;! LOOP LIMIT 00074200 %INTEGER MJBL ;! BLOCK POINTER FOR M.JRN FILE 00074300 %INTEGER MJPS ;! POSN POINTER FOR M.JRN FILE 00074400 %INTEGER NINC ;! BINARY SEARCH INCREMENT 00074500 %INTEGER NVAL ;! BINARY SEARCH POINTER 00074600 %INTEGER PV ;! VOLUME NUMBER POINTER 00074700 %INTEGER RNUM ;! ROOT OF JOURNAL NUMBER 00074800 %INTEGER SECT ;! CURRENT SECTION OF BULLETIN 00074900 %INTEGER TLENG ;! LENGTH OF TITLE TEXT 00075000 %INTEGER ZTP ;! CURRENT TYPE IN Z SECTION 00075100 ! 00075200 %OWNINTEGER SECTS ;! LAST SECTION NUMBER 00075300 %OWNINTEGER ENTNO=1 ;! ENTRY NUMBER 00075400 %OWNINTEGER MP ;! MID POINT OF MJNUMB 00075500 %OWNINTEGER ZTPS ;! LAST VALUE OF ZTP 00075600 ! 00075700 %SWITCH ENTRY(1:3) ;! ENTRY SWITCH 00075800 ! 00075900 ! CHECK FOR LAST ENTRY 00076000 ! 00076100 %IF JNUM=0 %THEN ENTNO=3 00076200 -> ENTRY(ENTNO) 00076300 ! 00076400 ! FIRST ENTRY: THE JOURNAL NUMBER AND POINTER ARRAYS ARE SET 00076500 ! UP FROM THE MASTER JOURNAL FILE AND MAIN HEADINGS ARE OUTPUT. 00076600 ! 00076700 ENTRY(1):RDMJN(MJUNIT,MJBL,MJPS,1) ;! SET UP ARRAYS 00076800 MP=MXNUMB//2 ;! CALC MID-POINT OF ARRAY 00076900 LENGOP=0 ;! ZEROISE LENGTH 00077000 WRBOP(OPUNIT,OPLINE,LENGOP,1) ;! WRITE HEADINGS TO THE 00077100 WRLST(LSUNIT,OPLINE,LENGOP,1) ;! OUTPUT FILES AND CHANGE 00077200 ENTNO=2 ;! THE ENTRY SWITCH VARIABLE 00077300 ! 00077400 ! NORMAL ENTRY: THE NEW JOURNAL TITLE IS OUTPUT WITH ANY 00077500 ! APPROPRIATE MAIN OR SUBHEADINGS 00077600 ! 00077700 ENTRY(2):RNUM=(JNUM&X'FFFFFF')//10 ;! EXTRACT ROOT NUMBER 00077800 SECT=JNUM>>24&X'FF' ;! EXTRACT SECTION CODE 00077900 %IF SECT='Z' %THEN -> ZSECT ;! PROCESS Z SECTN SEPARATELY 00078000 %IF SECT\=SECTS %THENC 00078100 %START ;! CHANGE OF SECTION 00078200 %IF SECTS=0 %THEN WRLST(LSUNIT,HDJRN,8,2) 00078300 WRBOP(OPUNIT,OPLINE,SECT,3) ;! O/P SECTION HEADINGS 00078400 WRLST(LSUNIT,OPLINE,SECT,3) 00078500 SECTS=SECT ;! STORE NEW SECTION CODE 00078600 %FINISH %ELSEC 00078700 %START ;! SAME SECTION - BLANK LINE 00078800 SET(OPLINE,1,MXLINE,BLNK) ;! ENSURE O/P AREA CLEAR 00078900 WRLST(LSUNIT,OPLINE,MXLINE,5) ;! OUTPUT BLANK LINE 00079000 %FINISH 00079100 OPLINE(1)=' ' ;! SET SINGLE CHARACTER 00079200 WRBOP(OPUNIT,OPLINE,1,4) ;! O/P LINE FEED TO BULLETIN 00079300 %IF DIAGNS=YES %THENC 00079400 %START ;! PRINT CURRENT NUMBER 00079500 NEWLINES(2) ;! ............................. 00079600 PRINT SYMBOL(SECT) ;! ............................. 00079700 WRITE(JNUM&X'FFFFFF',7) ;! ............................. 00079800 NEWLINE ;! ............................. 00079900 PRINTSTRING('---------') ;! ............................. 00080000 %FINISH ;! ............................. 00080100 %IF RNUM<999000 %THEN -> PJRN ;! JUMP FOR PERMANENT TITLE 00080200 ! 00080300 ! PSEUDO-JOURNAL INPUT - TITLE AND BIBLIOGRAPHIC DETAILS MUST ALL 00080400 ! BE EXTRACTED FROM THE INTERNAL RECORD. 00080500 ! 00080600 IT=IRDIRC(2*PX+1) ;! SET START AND 00080700 TLENG=IRDIRC(2*PX+2) ;! LENGTH OF SPECIAL TITLE 00080800 NW=1 ;! INITIALISE WORD COUNT 00080900 MARKWORDS(IRTEXT,IT,IT+TLENG-1,NW);! MARK TITLE CONTENTS 00081000 CROL:CREATELINE(OPLINE,IRTEXT,1,MXLINE,NW-1,LENGOP,END) 00081100 WRBOP(OPUNIT,OPLINE,LENGOP,-4) ;! OUTPUT TO BULLETIN 00081200 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! AND LISTING DEVICE 00081300 SET(OPLINE,1,LENGOP,BLNK) ;! CLEAR O/P AREA 00081400 -> CROL %UNLESS END=YES 00081500 %IF RNUM<999020 %THEN -> PVOL 00081600 ! 00081700 ! BIBLIOGRAPHIC DETAILS ARE EXTRACTED FROM THE INTERNAL RECORD 00081800 ! EXCLUDING THE FIRST (JOURNAL NUMBER) AND LAST (PAGINATION) ITEMS. 00081900 ! 00082000 NW=1 ;! INITIALISE WORD COUNT 00082100 ID=2*PB+1 ;! INITIALISE DIRECTORY 00082200 IT=IRDIRC(ID)+IRDIRC(ID+1)+1 ;! AND TEXT POINTERS 00082300 NEWI:INCT=IRTEXT(IT-1) ;! SET LENGTH OF NEXT ITEM 00082400 %IF IRTEXT(IT+INCT)=0 %THEN -> OPTL ;! EXIT IF LAST ITEM REACHED 00082500 ! 00082600 ! WHERE POSSIBLE AN ITEM IS TREATED AS A SINGLE ENTITY BUT IF 00082700 ! NECESSARY A LARGE ITEM IS PROCESSED WORD BY WORD 00082800 ! 00082900 %IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC00083000 %START 00083100 WBGN(NW)=IT ;! SET START AND LENGTH 00083200 WLNG(NW)=INCT ;! OF ITEM 00083300 NW=NW+1 ;! INCREMENT POINTER 00083400 %FINISH 00083500 WSPS(NW-1)=2 ;! DOUBLE SPACE AT END 00083600 IT=IT+INCT+1 ;! UPDATE TEXT POINTER 00083700 -> NEWI ;! JUMP TO PROCESS NEXT ITEM 00083800 ! 00083900 OPTL:NW=NW-1 ;! ADJUST WORD TOTAL 00084000 %IF NW<=0 %THEN %RETURN ;! EXIT IF NO MORE ITEMS 00084100 CRBL:CREATELINE(OPLINE,IRTEXT,1,MXLINE,NW,LENGOP,END) 00084200 WRBOP(OPUNIT,OPLINE,LENGOP,-4) ;! OUTPUT TO BULLETIN 00084300 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! AND LISTING DEVICE 00084400 SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR OUTPUT AREA 00084500 -> CRBL %UNLESS END=YES 00084600 CRND:WRLST(LSUNIT,OPLINE,MXLINE,4) ;! O/P SPACING LINE SET (OPLINE,1,MXLINE,0) ;! ZEROISE O/P AREA AND 00084800 WRBOP (OPUNIT,OPLINE,20,4) ;! OUTPUT 2" BLANK TAPE 00084900 %RETURN ;! EXIT WHEN OUTPUT COMPLETE 00085000 ! 00085100 ! PERMANENT JOURNAL INPUT - A BINARY SEARCH IS CARRIED OUT ON THE 00085200 ! MASTER JOURNAL TITLE FILE INDEX TO FIND THE TITLE REQUIRED. 00085300 ! 00085400 PJRN:NVAL=MP ;! SET START VALUE AND 00085500 NINC=NVAL ;! INITIAL INCREMENT 00085600 COMP:%IF RNUM=MJNUMB(NVAL) %THEN -> GOTIT ;! JUMP IF TITLE FOUND 00085700 NINC=NINC//2 ;! HALVE INCREMENT 00085800 %IF NINC<1 %THEN -> MSNG ;! CHECK FOR END OF SEARCH 00085900 %IF RNUM>MJNUMB(NVAL) %THEN NVAL=NVAL+NINC %C 00086000 %ELSE NVAL=NVAL-NINC 00086100 -> COMP ;! COMPARE NEXT VALUE 00086200 ! 00086300 ! WHEN AN EQUAL COMPARE HAS NEEN FOUND THE CORRESPONDING TITLE 00086400 ! IS READ FROM THE MASTER FILE AND OUTPUT. 00086500 ! 00086600 GOTIT:MJBL=MJBPTR(NVAL) ;! SET THE BLOCK AND 00086700 MJPS=MJPPTR(NVAL) ;! POSITION POINTERS 00086800 RDMJN(MJUNIT,MJBL,MJPS,2) ;! FETCH THE TITLE 00086900 ! 00087000 ! OUTPUT IS NOW CREATED A LINE AT A TIME, THE VALUE OF END BEING 00087100 ! SET TO ONE WHEN THE END OF THE RECORD HAS BEEN REACHED. 00087200 ! 00087300 NW=1 00087400 MARKWORDS(JNTITL,1,TLENG,NW) 00087500 CROPL:CREATELINE(OPLINE,JNTITL,1,MXLINE,NW-1,LENGOP,END) 00087600 WRBOP(OPUNIT,OPLINE,LENGOP,-4) ;! WRITE CURRENT LINE 00087700 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! TO OUTPUT FILES 00087800 SET (OPLINE,1,LENGOP,BLNK) ;! CLEAR O/P AREA 00087900 -> CROPL %UNLESS END=YES ;! CONTINUE TO END OF TITLE 00088000 ! 00088100 ! THE VOLUME,ISSUE AND PART NUMBERS OF A JOURNAL FOLLOW THE TITLE 00088200 ! 00088300 PVOL:PV=IRDIRC(2*PB+1)+IRDIRC(2*PB+2) ;! CALC POSITION 00088400 LIM=IRTEXT(PV)+PV ;! SET LENGTH OF ITEM 00088500 J=1 ;! INITIALISE PTR TO VIP 00088600 K=-1 ;! AND O/P AREA 00088700 I=PV+1 ;! SET PTR TO FIRST TEXT CHAR 00088800 ! 00088900 HEAD:L=VIP(J) ;! SET LENGTH OF NEXT VIP ENTRY 00089000 %IF IRTEXT(I)='0' %THENC 00089100 %START ;! NULL ENTRY 00089200 J=J+L+1 ;! INCREMENT VIP POINTER 00089300 INC1: I=I+1 ;! EXAMINE NEXT CHARACTER 00089400 %IF IRTEXT(I)='.' %THEN -> INC2 ;! FOR END OF FIELD 00089500 %IF I>=LIM %THEN -> OUT ;! END IF I EXCEEDS LIMIT 00089600 -> INC1 00089700 %FINISH 00089800 COPYTEXT(VIP,J+1,OPLINE,K+2,L) ;! ENTER NAME TO O/P AREA 00089900 K=K+L+2 ;! UPDATE O/P AREA PTR 00090000 J=J+L+1 ;! UPDATE VIP POINTER 00090100 ENT: OPLINE(K)=IRTEXT(I) ;! TRANSFER TEXT CHARACTER 00090200 K=K+1 ;! INCREMENT POINTER 00090300 I=I+1 ;! INCREMENT TEXT POINTER 00090400 %IF I>LIM %THEN -> OUT ;! IF END REACHED - EXIT 00090500 %IF IRTEXT(I)\='.' %THEN -> ENT ;! CONTINUE TO END OF FIELD 00090600 INC2:I=I+1 ;! INCREMENT PTR PAST F/STOP 00090700 %IF I<=LIM %THEN -> HEAD ;! FIND NEXT ENTRY 00090800 ! 00090900 ! THE DATE IS ALSO EXTRACTED AND APPEARS ON THE SAME LINE AS THE 00091000 ! VOLUME DETAILS IF THERE IS ROOM, OTHERWISE ON A SEPARATE LINE. 00091100 ! 00091200 OUT: PV=LIM+1 ;! SET START OF DATE DETAILS 00091300 LIM=IRTEXT(PV) ;! SET LENGTH OF DATE FIELD 00091400 %IF K=-1 %THEN K=1 %ELSE K=K+3 ;! ALLOW FOR SPACING 00091500 %IF K+LIM-1>MXLINE %THENC 00091600 %START ;! SEPARATE LINE NECESSARY 00091700 WRBOP(OPUNIT,OPLINE,K-3,-4) ;! OUTPUT VOLUME, ISSUE 00091800 WRLST(LSUNIT,OPLINE,K-3,4) ;! AND PART DETAILS 00091900 SET(OPLINE,1,K-3,BLNK) ;! CLEAR O/P LINE 00092000 K=1 ;! RESET O/P POINTER 00092100 %FINISH 00092200 COPYTEXT(IRTEXT,PV+1,OPLINE,K,LIM);! MOVE DATE TO O/P AREA 00092300 WRBOP(OPUNIT,OPLINE,K+LIM-1,-4) ;! WRITE TO BULLETIN WRLST(LSUNIT,OPLINE,K+LIM-1,4) ;! WRITE TO LISTING SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR O/P AREA 00092600 %IF RNUM<999000 %AND IRDIRC(2*PX+1)>0 %THENC %START ;! IF ANY ADDITIONAL NW=1 ;! TITLE NOTE IS IT=IRDIRC(2*PX+1) ;! PRESENT SET POINTERS TLENG=IRDIRC(2*PX+2) ;! AND JUMP TO PROCESS MARKWORDS(IRTEXT,IT,IT+TLENG-1,NW) -> OPTL %FINISH ;! ELSE O/P SPACING LINE -> CRND ! 00092800 ! THE Z SECTION DOES NOT CONTAIN JOURNALS AND THEREFORE NO TITLES 00092900 ! ARE REQUIRED. THE OUTPUT ROUTINES ARE CALLED TO OUTPUT SECTION 00093000 ! HEADINGS ONLY. 00093100 ! 00093200 ZSECT:ZTP=RNUM//10 ;! EXTRACT TYPE CODE 00093300 ZTP=ZTP-ZTP//100*100 ;! FROM JOURNAL NUMBER 00093400 %IF ZTP\=ZTPS %THENC 00093500 %START ;! CHANGE OF TYPE 00093600 J=ZHD(ZTP-1) ;! SET HEADING POINTER 00093700 K=ZHEAD(J) ;! SET LENGTH OF HEADING 00093800 %CYCLE I=1,1,K 00093900 OPLINE(I)=ZHEAD(J+I) ;! MOVE HEADING TO O/P AREA 00094000 %REPEAT 00094100 WRLST(LSUNIT,OPLINE,K,2) ;! O/P SECTN HEAD TO LISTING 00094200 %IF ZTPS=0 %THEN WRBOP(OPUNIT,OPLINE,SECT,3) 00094300 SET(OPLINE,1,K,BLNK) ;! CLEAR O/P AREA 00094400 ZTPS=ZTP ;! STORE NEW TYPE CODE 00094500 %FINISH 00094600 %IF DIAGNS=YES %THENC 00094700 %START ;! PRINT CURRENT NUMBER 00094800 NEWLINES(2) ;! ............................. 00094900 PRINT SYMBOL(SECT) ;! ............................. 00095000 WRITE(JNUM&X'FFFFFF',7) ;! ............................. 00095100 NEWLINE ;! ............................. 00095200 PRINTSTRING('---------') ;! ............................. 00095300 %FINISH ;! ............................. 00095400 %RETURN ;! RETURN TO CALLING ROUTINE 00095500 ! 00095600 ! IF NO MASTER JOURNAL NUMBER EXISTS FOR AN INPUT RECORD A 00095700 ! MESSAGE TO THIS EFFECT IS OUTPUT TO THE LISTING DEVICE BUT NO 00095800 ! DATA IS OUTPUT TO THE BULLETIN. 00095900 ! 00096000 MSNG:WRLST(LSUNIT,OPLINE,2,4) ;! O/P BLANK LINE 00096100 %CYCLE I=1,1,18 00096200 OPLINE(I)=NONAM(I) 00096300 OPLINE(18+I)=NONAM(I) 00096400 %REPEAT 00096500 OPLINE(37)='*' 00096600 WRLST(LSUNIT,OPLINE,37,4) ;! O/P MESSAGE 00096700 SET(OPLINE,1,37,BLNK) ;! CLEAR O/P LINE 00096800 WRLST(LSUNIT,OPLINE,1,5) ;! WRITE BLANK LINE 00096900 %RETURN 00097000 ! 00097100 ! THE LAST ENTRY CLOSES THE FILES 00097200 ! 00097300 ENTRY(3):RDMJN(MJUNIT,MJBL,MJPS,3) ;! CLOSE MASTER JOURNAL FILE 00097400 WRBOP (OPUNIT,OPLINE,0,0) ;! CLOSE BULLETIN FILE 00097500 WRLST (LSUNIT,OPLINE,0,0) ;! CLOSE LISTING FILE 00097600 ! 00097700 ! 00097800 ! ********************************************************************* 00097900 ! 00098000 %ROUTINE RDMJN(%INTEGER UNIT,%INTEGERNAME BLOCK,POSN,%INTEGER IND) 00098100 ! 00098200 ! THIS ROUTINE HANDLES I/O ON THE MASTER JOURNAL NUMBER FILE. 00098300 ! THE FIRST ENTRY (IND=1) OPENS THE FILE AND PERFORMS ANY 00098400 ! NECESSARY UPDATING. SUBSEQUENT ENTRIES (IND=2) EXTRACT THE 00098500 ! REQUIRED RECORD FROM THE SPECIFIED BLOCK AND POSN. THE LAST 00098600 ! ENTRY (IND=3) REWRITES THE CONTROL BLOCK AND CLOSES THE FILE. 00098700 ! 00098800 %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) 00098900 %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) 00099000 %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL,%INTEGERNAME SECT %C 00099100 %NAME BEGIN,END) 00099200 %EXTERNALROUTINESPEC WRITEDA (%INTEGER CHANNEL,%INTEGERNAME SECT %C 00099300 %NAME BEGIN,END) 00099400 %ROUTINESPEC GET TITLE (%BYTEINTEGERARRAYNAME JNTITL, %C 00099500 %INTEGERNAME JST,JLNG,JNUM) 00099600 %EXTERNALROUTINESPEC SETMARGINS (%INTEGER A,B,C) ! 00099700 %BYTEINTEGERARRAY JREC(1:500) ;! NEW TITLE AREA 00099800 %INTEGERARRAY CNT(1:6) ;! CONTROL ARRAY 00099900 %OWNBYTEINTEGERARRAY BUFFER(1:1000) ;! BUFFER AREA 00100000 ! 00100100 %INTEGER I ;! LOOP VARIABLE 00100200 %INTEGER IN ;! LOWER SUBSCRIPT OF MJNUMB 00100300 %INTEGER J ;! LOOP VARIABLE 00100400 %INTEGER JN ;! UPPER SUBSCRIPT OF MJNUMB 00100500 %INTEGER MJBL ;! CURRENT BLOCK NUMBER 00100600 %INTEGER NUM ;! NEW JOURN NO IN DECIMAL 00100700 %INTEGER RLNG ;! LENGTH OF NEW RECORD 00100800 ! 00100900 %OWNINTEGER UPD ;! UPDATE INDICATOR 00101000 %OWNINTEGER NFBL ;! POINTER TO NEXT FREE BLOCK 00101100 %OWNINTEGER NFPS ;! POINTER TO NEXT FREE POSN 00101200 %OWNINTEGER NBST ;! LAST BLOCK ACCESSED 00101300 ! 00101400 %SWITCH ENTRY(1:3) ;! ENTRY POINT SWITCH 00101500 ! 00101600 -> ENTRY(IND) ;! JUMP TO APPROPRIATE POINT 00101700 ! 00101800 ! FIRST ENTRY - OPEN FILE CHECK FOR ANY RECORDS TO BE ADDED 00101900 ! READING AND PROCESSING THEM AT THIS POINT IF NECESSARY. 00102000 ! 00102100 ENTRY(1):OPENDA(UNIT) ;! OPEN MASTER FILE 00102200 MJBL=1 ;! READ CONTROL BLOCK 00102300 READDA(UNIT,MJBL,CNT(1),CNT(6)) 00102400 MAXN=CNT(1) ;! SET NO OF TITLES IN FILE 00102500 NFBL=CNT(2) ;! STORE NEXT FREE BLOCK NO 00102600 NFPS=CNT(3) ;! STORE NEXT FREE POSITION 00102700 ! 00102800 JN=MAXN+NJNO ;! TOTAL EXISTING + NEW TITLES 00102900 %IF JN>MXNUMB %THEN -> OVFL ;! CHECK FOR OVERFLOW 00103000 CONT:IN=NJNO+1 ;! SET START BEYOND NEW TITLES 00103100 ! 00103200 ! THE EXISTING JOURNAL NUMBERS ARE READ INTO THE ARRAY LEAVING 00103300 ! ROOM AT THE BEGINNING EQUAL TO THE NUMBER OF NEW TITLES. 00103400 ! THIS ALLOWS US TO MOVE THE JOURNAL NUMBERS UP THE ARRAY INSERTING 00103500 ! NEW OR REPLACEMENT NUMBERS AS REQUIRED. 00103600 ! 00103700 MJBL=CNT(4) ;! READ JOURNAL NUMBER ARRAY 00103800 READDA(UNIT,MJBL,MJNUMB(IN),MJNUMB(JN)) 00103900 MJBL=CNT(5) ;! READ BLOCK POINTERS 00104000 READDA(UNIT,MJBL,MJBPTR(IN),MJBPTR(JN)) 00104100 MJBL=CNT(6) ;! READ POSITION POINTERS 00104200 READDA(UNIT,MJBL,MJPPTR(IN),MJPPTR(JN)) 00104300 ! 00104400 ! IF NO UPDATING IS REQUIRED JUMP DIRECTLY TO THE END 00104500 ! 00104600 %IF NJNO=0 %THEN -> END 00104700 ! 00104800 ! THERE ARE NEW RECORDS TO BE ADDED. IT IS ASSUMED THAT THEY 00104900 ! WILL BE IN STRICT NUMERIC ORDER. 00105000 ! 00105100 UPD=YES ;! SET UPDATE INDICATOR 00105200 JN=1 ;! POINTER TO DESTINATION 00105300 SELECT INPUT (6) SET MARGINS (6,1,88) ! 00105400 %CYCLE I=1,1,NJNO ;! CYCLE THRO NEW RECORDS 00105500 GET TITLE (JREC,ONE,RLNG,NUM) ;! FETCH NEXT RECORD 00105600 %IF NUM=0 %THEN -> ERROR ;! CHECK FOR ENDFILE 00105700 ! 00105800 ! MOVE EXISTING NUMBERS BACK IN THE ARRAY UNTIL THE APPROPRIATE 00105900 ! POSITION IS FOUND FOR THIS NEW RECORD. 00106000 ! 00106100 CHECK:%IF NUM>MJNUMB(IN) %THENC 00106200 %START ;! MOVE UP EXISTING ENTRIES 00106300 MJNUMB(JN)=MJNUMB(IN) 00106400 MJBPTR(JN)=MJBPTR(IN) 00106500 MJPPTR(JN)=MJPPTR(IN) 00106600 IN=IN+1 ;! UPDATE BOTH ARRAY 00106700 JN=JN+1 ;! POINTERS AND JUMP TO 00106800 -> CHECK ;! EXAMINE THE NEXT RECORD 00106900 %FINISH 00107000 ! 00107100 ! WHEN A LOW OR EQUAL COMPARE IS FOUND THE NEW RECORD IS WRITTEN 00107200 ! TO THE NEXT AVAILABLE POSITION ON THE DISC FILE. 00107300 ! 00107400 %IF NFPS+RLNG+1>MXBUFS %THENC 00107500 %START ;! RECORD WOULD CROSS BLOCK 00107600 NFBL=NFBL+1 ;! BOUNDARY. A NEW BLOCK IS 00107700 NFPS=1 ;! IS THEREFORE STARTED 00107800 %FINISH %ELSEC 00107900 READDA(UNIT,NFBL,BUFFER(1),BUFFER(MXBUFS)) 00108000 BUFFER(NFPS)=RLNG>>8&X'FF' ;! STORE RECORD LENGTH IN 00108100 BUFFER(NFPS+1)<-RLNG ;! FIRST TWO BYTES OF RECORD 00108200 %CYCLE J=1,1,RLNG 00108300 BUFFER(NFPS+J+1)=JREC(J) ;! AND WRITE TO DISC 00108400 %REPEAT 00108500 WRITEDA(UNIT,NFBL,BUFFER(1),BUFFER(MXBUFS)) 00108600 ! 00108700 ! SET THE NEW NUMBER AND POINTERS IN THE NEXT POSITION 00108800 ! 00108900 MJNUMB(JN)=NUM ;! ENTER JOURNAL NUMBER 00109000 MJBPTR(JN)=NFBL ;! ENTER BLOBK POINTER 00109100 MJPPTR(JN)=NFPS ;! ENTER POSITION POINTER 00109200 NFPS=NFPS+RLNG+2 ;! UPDATE POSITION POINTER 00109300 JN=JN+1 ;! UPDATE ARRAY POINTERS 00109400 %IF NUM=MJNUMB(IN) %THEN IN=IN+1 %ELSE MAXN=MAXN+1 00109500 %REPEAT 00109600 ! 00109700 ! WHEN ALL THE NEW RECORDS HAVE BEEN INSERTED THE ARRAYS MAY NEED 00109800 ! FURTHER ADJUSTMENT I.E. IF THERE HAVE BEEN ANY REPLACEMENTS. 00109900 ! 00110000 %IF JN>MAXN %OR JN=IN %THEN -> END 00110100 CLOS:%CYCLE I=JN,1,MAXN 00110200 MJNUMB(I)=MJNUMB(IN) ;! CLOSE UP REMAINING 00110300 MJBPTR(I)=MJBPTR(IN) ;! RECORDS IF NECESSARY 00110400 MJPPTR(I)=MJPPTR(IN) 00110500 IN=IN+1 ;! INCREMENT ARRAY POINTER 00110600 %REPEAT 00110700 ! 00110800 ! THE END OF THE ARRAY MJNUMB MUST BE FILLED TO COMPARE 00110900 ! HIGH AGAINST ALL OTHER JOURNAL NUMBERS. 00111000 ! 00111100 END: %CYCLE I=MAXN+1,1,MXNUMB 00111200 MJNUMB(I)=1000000 00111300 %REPEAT 00111400 ! 00111500 %RETURN 00111600 ! 00111700 ! IND=2 NORMAL ENTRY: THE VALUE OF THE BLOCK POINTER IS CHECKED 00111800 ! AGAINST THE MAXIMUM AND IF O.K. THE APPROPRIATE RECORD IS READ 00111900 ! 00112000 ENTRY(2):%IF BLOCK=NBST %THEN -> TRANSF;! CHECK IF BLOCK ALREADY IN 00112100 %IF 1 CLOS 00118000 ! 00118100 ! 2) SOME OR ALL OF THE NEW JOURNAL TITLES WILL NOT BE ADDED TO 00118200 ! THE FILE AS THEY WOULD EXCEED THE ALLOCATED SPACE. 00118300 ! 00118400 OVFL:NEWLINES(2) 00118500 PRINTSTRING('NUMBER OF JOURNALS WILL EXCEED PERMITTED MAXIMUM') 00118600 NEWLINE 00118700 PRINTSTRING('TOTAL NUMBER OF NEW JOURNALS SUBMITTED =') 00118800 WRITE(NJNO,3) 00118900 NEWLINE 00119000 PRINTSTRING('MAXIMUM PERMITTED NUMBER AT PRESENT =') 00119100 WRITE(MXNUMB-MAXN,3) 00119200 NEWLINE 00119300 PRINTSTRING('LAST') 00119400 WRITE(NJNO-MXNUMB+MAXN,3) 00119500 PRINTSTRING(' UPDATE RECORDS IGNORED') 00119600 NEWLINE 00119700 PRINTSTRING('INCREASE ARRAY SIZES BEFORE MAKING FURTHER ADDITIONS')00119800 NEWLINES(2) 00119900 PRINTSTRING('JOB CONTINUED') 00120000 NJNO=MXNUMB-MAXN ;! SET NEW VALUE 00120100 JN=MXNUMB 00120200 -> CONT 00120300 ! 00120400 ! ********************************************************************* 00120500 ! 00120600 %ROUTINE GET TITLE (%BYTEINTEGERARRAYNAME JNTITL %C 00120700 %INTEGERNAME JST,JLNG,JNUM) 00120800 ! 00120900 ! ROUTINE FETCHES THE NEXT VALID JOURNAL TITLE FROM THE INPUT 00121000 ! STREAM. THE NUMBER IS RETURNED IN JNUM WHILE THE TEXT OF THE 00121100 ! TITLE IS STORED IN JNTITL STARTING AT JST AND OF LENGTH JLNG. 00121200 ! 00121300 ! THE INPUT RECORDS MUST BE IN THE FORMAT SPECIFIED ..... 00121400 ! 00121500 ! NNNNNN-S TEXT OF THE TITLE . . . . C 00121600 ! 00121700 ! NNNNNN THE 6-DIGIT JOURNAL NUMBER INC THE CHECK DIGIT 00121800 ! 00121900 ! S THE SEQUENCE NUMBER. TO ENSURE THE TEXT OF A TITLE 00122000 ! DOES NOT GET OUT OF ORDER EACH 'CARD' FORMING PART OF 00122100 ! A TITLE CARRIES A SEQUENCE NUMBER BETWEEN 1 AND 9 00122200 ! 00122300 ! C WHERE A TITLE REQUIRES MORE THAN ONE 'CARD' ALL 'CARDS' 00122400 ! EXCEPT THE LAST MUST HAVE THE CHARACTER 'C' IN THE 73RD 00122500 ! CHARACTER POSITION AS A CONTINUATION SYMBOL. 00122600 ! 00122700 %EXTERNALROUTINESPEC ISOCARD (%BYTEINTEGERARRAYNAME A) 00122800 %INTEGERFNSPEC CONV (%BYTEINTEGERARRAYNAME A,%INTEGER IA,L) 00122900 ! 00123000 %BYTEINTEGERARRAY BUF(1:80) ;! INPUT BUFFER AREA 00123100 %INTEGER SUM ;! USED TO CALCULATE CHECK DIGIT 00123200 %INTEGER CD ;! CHECK DIGIT 00123300 %INTEGER I ;! LOOP VARIABLE 00123400 %INTEGER JS ;! CURRENT START VALUE OF J 00123500 %INTEGER J ;! POINTER TO TITLE ARRAY 00123600 %INTEGER LIM ;! PRINT LOOP LIMIT 00123700 %INTEGER ST ;! PRINT LOOP START POINT 00123800 %INTEGER RNO ;! SWITCH VARIABLE (RET(RNO)) 00123900 %BYTEINTEGER CHAR ;! CURRENT CHARACTER 00124000 %BYTEINTEGER CASE ;! CURRENT CASE (SHIFT OR NORMAL)00124100 %BYTEINTEGER SEQNO ;! SEQUENCE NUMBER 00124200 ! 00124300 %SWITCH ERR(1:6) ;! ERROR SWITCH 00124400 %SWITCH RET(1:3) ;! RETURN SWITCH FROM PRINT 00124500 ! 00124600 ! ON ENTRY TO THE ROUTINE THE NEXT CARD IMAGE IS READ IN 00124700 ! 00124800 RDCD:ISOCARD(BUF) ;! READ I/P RECORD 00124900 %IF BUF(1)='E' %THENC 00125000 %START ;! END OF FILE FOUND 00125100 JNUM=0 ;! SET ZERO AS EOF INDICATOR 00125200 %RETURN ;! RETURN TO CALLING ROUTINE 00125300 %FINISH 00125400 ! 00125500 ! CALCULATE CHECK DIGIT 00125600 ! 00125700 CHCD:SUM=0 ;! INITIALISE SUM 00125800 %CYCLE I=1,1,5 00125900 SUM=SUM+(7-I)*(BUF(I)&X'0F') ;! ADD WEIGHTED VALUES 00126000 %REPEAT 00126100 CD=10-(SUM-SUM//11*11) ;! CALC SINGLE CHECK DIGIT 00126200 %IF CD=10 %THEN CD=0 ;! AND COMPARE WITH THAT GIVEN 00126300 %IF BUF(6)\=CD!X'30' %THEN -> ERR(1) 00126400 ! 00126500 ! VALID JOURNAL NUMBER 00126600 ! 00126700 JNUM=CONV(BUF,1,6) ;! CONVERT TO BINARY 00126800 SEQNO='0' ;! INITIALISE SEQUENCE NUMBER 00126900 CASE=X'20' ;! INITIALISE CASE TO SHIFT 00127000 JS=JST ;! INITIALISE STARTING POINT 00127100 ! 00127200 ! CHECK SEQUENCING - IGNORING IF INVALID 00127300 ! 00127400 CHSQ:%IF BUF(8)\=SEQNO+1 %THEN -> ERR(2) 00127500 SEQNO=BUF(8) ;! STORE NEW SEQUENCE NUMBER 00127600 ! 00127700 ! INPUT DATA IS O.K. AND IS ADDED TO THE CURRENT TITLE 00127800 ! 00127900 J=JS-1 ;! SET START VALUE OF POINTER 00128000 %CYCLE I=10,1,72 ;! CYCLE THROUGH I/P RECORD 00128100 CHAR=BUF(I) ;! EXAMINE NEXT CHARACTER 00128200 %IF CHAR='<' %OR CHAR='>' %THENC 00128300 %START ;! CASE CHANGE - SET NEW CASE 00128400 %IF CHAR='<' %THEN CASE=0 %ELSE CASE=X'20' 00128500 -> REPT ;! CONTINUE 00128600 %FINISH 00128700 J=J+1 ;! UPDATE TITLE POINTER 00128800 JNTITL(J)=CHAR!CASE ;! AND STORE CHARACTER 00128900 REPT:%REPEAT 00129000 ! 00129100 ! WHEN THE END OF THIS I/P RECORD IS REACHED TRAILING BLANKS ARE 00129200 ! REMOVED. A SINGLE SPACE IS LEFT IF A CONTINUATION IS EXPECTED 00129300 ! 00129400 CHKJ:%IF JNTITL(J)=' ' %THENC 00129500 %START ;! BLANK CHARACTER 00129600 J=J-1 ;! DECREMENT THE POINTER 00129700 %IF J>JS %THEN -> CHKJ ;! CONTINU UNLESS START REACHED 00129800 %IF JS=JST %THEN -> ERR(3) ;! ERROR - 1ST TITLE CARD BLANK 00129900 -> ERR(4) ;! ERROR - BLANK CARD IN TITLE 00130000 %FINISH 00130100 ! 00130200 ! CHECK FOR A CONTINUATION CARD 00130300 ! 00130400 %IF BUF(73)\='C' %THENC 00130500 %START ;! END OF TITLE REACHED 00130600 JLNG=J-JST+1 ;! CALC LENGTH OF TITLE 00130700 %RETURN ;! RETURN TO CALLING ROUTINE 00130800 %FINISH 00130900 JNTITL(J+1)=' ' ;! ENSURE SPACING CHAR IS BLANK 00131000 JS=J+2 ;! CONTINUATION - ALLOW A BLANK 00131100 ! 00131200 ! READ CONTINUATION CARD AND CHECK THAT THE JOURNAL NUMBER AGREES 00131300 ! 00131400 RDCN:ISOCARD(BUF) ;! READ NEXT CARD 00131500 %IF BUF(1)='E' %THEN -> ERR(5) ;! ERROR - END OF FILE FOUND 00131600 %IF CONV(BUF,1,6)\=JNUM %THEN -> ERR(6) ;! ERROR - JNUM DISAGREES 00131700 -> CHSQ ;! NUMBER O.K. CHECK SEQUENCING 00131800 ! 00131900 ! ERROR SECTION - MESSAGES AND OFFENDING RECORDS ARE PRINTED AND 00132000 ! PROCESSING CONTINUES AS SUTABLE THEREAFTER. 00132100 ! 00132200 ERR(1):NEWLINES(2) ;! CHECK DIGIT WRONG 00132300 PRINTSTRING(' ****** INVALID CHECK DIGIT - RECORD IGNORED') 00132400 -> RET(1) ;! JUMP TO PRINT RECORD 00132500 ! 00132600 ERR(2):NEWLINES(2) ;! TITLE CARDS OUT OF ORDER 00132700 PRINTSTRING(' ****** SEQUENCE NUMBER OUT OF ORDER - RECORD IGNORED') 00132800 %IF SEQNO='0' %THEN -> RET(1) 00132900 RNO=1 ;! JUMP TO PRINT RECORD 00133000 -> PREC 00133100 ! 00133200 ERR(3):NEWLINES(2) ;! WARNING MESSAGE 00133300 PRINTSTRING(' ****** BLANK CARD IN DATA - IGNORED') 00133400 -> RDCD ;! READ NEXT RECORD 00133500 ! 00133600 ERR(4):NEWLINES(2) ;! WARNING MESSAGE 00133700 PRINTSTRING(' ****** BLANK CARD IN RECORD - IGNORED') 00133800 -> RDCN ;! READ REST OF CURRENT RECORD 00133900 ! 00134000 ERR(5):NEWLINES(2) ;! END OF FILE FOUND UNEXPECTEDLY00134100 PRINTSTRING(' ****** END OF DATA FOUND IN MIDDLE OF RECORD') 00134200 PRINTSTRING(' - RECORD IGNORED') 00134300 RNO=2 ;! PRINT RECORD DETAILS 00134400 -> PREC 00134500 RET(2):JNUM=0 ;! SET EOF INDICATOR 00134600 %RETURN ;! RETURN TO CALLING ROUTINE 00134700 ! 00134800 ERR(6):NEWLINES(2) ;! JOURNAL NUMBER CHANGES 00134900 PRINTSTRING(' ****** JOURNAL NUMBER CHANGES IN MIDDLE OF RECORD') 00135000 PRINTSTRING(' - RECORD IGNORED') 00135100 RNO=3 ;! JUMP TO PRINT RECORD 00135200 -> PREC 00135300 RET(3):%IF BUF(8)='1' %THEN -> CHCD ;! IF START OF NEW TITLE CONT 00135400 NEWLINE ;! ELSE IGNORE 2ND REC TOO 00135500 PRINTSTRING(' ****** NEW RECORD NOT IN ORDER - ALSO IGNORED') 00135600 -> RET(1) 00135700 ! 00135800 ! 00135900 ! THIS SECTION PRINTS THE I/P RECORDS THAT HAVE NOT BEEN 00136000 ! TRANSFERRED TO THE TITLE ARRAY AND ARE TO BE IGNORED. 00136100 ! 00136200 RET(1):NEWLINE 00136300 PRINTSTRING(' ****** ') 00136400 %CYCLE I=1,1,80 00136500 PRINT SYMBOL(BUF(I)) 00136600 %REPEAT 00136700 %IF BUF(73)\='C' %THENC 00136800 %START ;! READ ALL CONTINUATION CARDS 00136900 ISOCARD(BUF) 00137000 -> RET(1) ;! AND PRINT THEM FOR REFERENCE 00137100 %FINISH 00137200 -> RDCD ;! READ NEXT TITLE 00137300 ! 00137400 ! THIS SECTION PRINTS THE RECORD OR PART THEREOF THAT IS ALREADY 00137500 ! IN THE ARRAY JNTITL. 00137600 ! 00137700 PREC:LIM=J ;! INITIALISE LIMIT 00137800 ST=1 ;! INITIALISE START 00137900 NLIN:NEWLINE 00138000 PRINTSTRING(' ****** ') 00138100 %IF LIM>80 %THENC 00138200 %START ;! LINES OF 80 CHARS ARE PRINTED 00138300 %CYCLE I=ST,1,ST+79 00138400 PRINT SYMBOL(JNTITL(I)) 00138500 %REPEAT 00138600 LIM=LIM-80 ;! DECREMENT LIMIT 00138700 ST=ST+80 ;! UPDATE START POINT 00138800 -> NLIN ;! PRINT NEXT LINE 00138900 %FINISH 00139000 %CYCLE I=ST,1,ST+LIM-1 00139100 PRINT SYMBOL(JNTITL(I)) ;! PRINT LAST LINE 00139200 %REPEAT 00139300 -> RET(RNO) ;! EXIT AS APPROPRIATE 00139400 ! 00139500 ! 00139600 ! ********************************************************************* 00139700 ! 00139800 %INTEGERFN CONV(%BYTEINTEGERARRAYNAME A,%INTEGER IA,L) 00139900 ! 00140000 ! FUNCTION CALCULATES THE INTEGER VALUE OF THE L DIGITS IN THE 00140100 ! ARRAY A STARTING AT A(IA). 00140200 ! 00140300 %INTEGER SUM,I 00140400 ! 00140500 SUM=0 00140600 %CYCLE I=0,1,L-1 00140700 SUM = 10*SUM+(A(IA+I)&X'0F') 00140800 %REPEAT 00140900 %RESULT=SUM 00141000 %END;! CONV 00141100 ! 00141200 %END ;! GET TITLE 00141300 ! 00141400 %END;!RDMJN 00141500 ! 00141600 %END ;! OUTPUT TITLE 00141700 ! 00141800 ! ********************************************************************* 00141900 ! 00142000 ! 00142100 ! ********************************************************************* 00142200 ! 00142300 %ROUTINE WRBOP(%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C 00142400 %INTEGER PARM,IND) 00142500 ! 00142600 ! THIS ROUTINE CONTROLS OUTPUT TO THE BULLETIN DEVICE. THIS 00142700 ! VERSION OUTPUTS TO THE PAPER TAPE PUNCH AND THE UNIT PARAMETER 00142800 ! IS NOT IN FACT USED. THE TYPE OF OUTPUT IS SPECIFIED BY THE 00142900 ! VALUE OF IND AS FOLLOWS:- 00143000 ! IND=1 MAIN HEADING 00143100 ! IND=2 (NOT USED AT PRESENT) 00143200 ! IND=3 SECTION DELIMETER 00143300 ! IND=4 O/P CONTENTS OF OPAREA AFTER EDITING 00143400 ! IND=5 O/P AS FOR IND=4 BUT WITH ITEM DELIMITER 00143500 ! IND=0 TERMINATION OUTPUT 00143600 ! (IF IND NEGATIVE OUTPUT IS UNDERLINED) 00143700 ! 00143800 %ROUTINESPEC PTOUT (%BYTEINTEGERARRAYNAME BUF, %INTEGER LENG) 00143900 ! 00144000 %OWNBYTEINTEGERARRAY MHEAD (1:45) = %C 00144100 X'00',X'FF',X'01',X'01',X'01',X'01',X'00', 00144200 X'00',X'FF',X'00', 00144300 X'00',X'FF',X'89',X'89',X'89',X'76',X'00', 00144400 X'00',X'FF',X'88',X'88',X'88',X'77',X'00', 00144500 X'00',X'7F',X'88',X'88',X'88',X'7F',X'00', 00144600 X'00',X'FF',X'88',X'88',X'88',X'77',X'00', 00144700 X'00',X'C0',X'20',X'1F',X'20',X'C0',X'00' 00144800 ! 00144900 %OWNBYTEINTEGERARRAY ARWR (1:10) = %C 00145000 X'18',X'18',X'18',X'18',X'18',X'99',X'DB',X'7E',X'3C',X'18' 00145100 ! 00145200 %OWNBYTEINTEGERARRAY ARWL (1:10) = %C 00145300 X'18',X'3C',X'7E',X'DB',X'99',X'18',X'18',X'18',X'18',X'18' 00145400 ! 00145500 %OWNBYTEINTEGERARRAY DELIM (1:8) = %C 00145600 X'18',X'3C',X'66',X'C3',X'C3',X'66',X'3C',X'18' 00145700 ! 00145800 %OWNBYTEINTEGERARRAY LTRS (0:207) = %C 00145900 X'42',X'42',X'42',X'7E',X'42',X'42',X'24',X'18', 00146000 X'3E',X'42',X'42',X'42',X'3E',X'42',X'42',X'3E', 00146100 X'3C',X'42',X'02',X'02',X'02',X'02',X'42',X'3C', 00146200 X'3E',X'42',X'42',X'42',X'42',X'42',X'42',X'3E', 00146300 X'7E',X'02',X'02',X'02',X'3E',X'02',X'02',X'7E', 00146400 X'02',X'02',X'02',X'02',X'3E',X'02',X'02',X'7E', 00146500 X'3C',X'42',X'42',X'72',X'02',X'02',X'42',X'3C', 00146600 X'42',X'42',X'42',X'42',X'7E',X'42',X'42',X'42', 00146700 X'18',X'18',X'18',X'18',X'18',X'18',X'18',X'18', 00146800 X'0C',X'12',X'10',X'10',X'10',X'10',X'10',X'7E', 00146900 X'42',X'22',X'12',X'0E',X'0E',X'12',X'22',X'42', 00147000 X'7E',X'02',X'02',X'02',X'02',X'02',X'02',X'02', 00147100 X'42',X'42',X'42',X'42',X'5A',X'5A',X'66',X'42', 00147200 X'42',X'42',X'62',X'52',X'4A',X'46',X'42',X'42', 00147300 X'3C',X'42',X'42',X'42',X'42',X'42',X'42',X'3C', 00147400 X'02',X'02',X'02',X'3E',X'42',X'42',X'42',X'3E', 00147500 X'5C',X'22',X'5A',X'42',X'42',X'42',X'42',X'3C', 00147600 X'42',X'22',X'12',X'3E',X'42',X'42',X'42',X'3E', 00147700 X'3C',X'42',X'40',X'20',X'1C',X'02',X'42',X'3C', 00147800 X'18',X'18',X'18',X'18',X'18',X'18',X'7E',X'7E', 00147900 X'3C',X'42',X'42',X'42',X'42',X'42',X'42',X'42', 00148000 X'18',X'24',X'42',X'42',X'42',X'42',X'42',X'42', 00148100 X'42',X'66',X'5A',X'5A',X'42',X'42',X'42',X'42', 00148200 X'42',X'42',X'24',X'18',X'18',X'24',X'42',X'42', 00148300 X'18',X'18',X'18',X'18',X'18',X'24',X'42',X'42', 00148400 X'7E',X'02',X'04',X'08',X'10',X'20',X'40',X'7E' 00148500 ! 00148600 %OWNBYTEINTEGERARRAY TRTBL(0:127) = %C 00148700 0,0,0,0,0,0,0,0,0,X'14',X'12',0,0,0,0,0, 00148800 0,0,0,0,0,0,0,0,0,0,X'FF',0,0,0,0,X'7D', 00148900 X'90',0,0,X'AB',0,X'B0',X'B6',X'A7',X'A8',X'B9',X'AE',X'2D', 00149000 X'BF',X'2E',X'3F',X'0F', 00149100 X'30',X'21',X'22',X'33',X'24',X'35',X'36',X'27',X'28',X'39',X'8F', 00149200 X'BC',X'B3',X'B5',X'A4',X'2B', X'2B',X'41',X'42',X'53',X'44',X'55',X'56',X'47',X'48',X'59',X'5A', 00149400 X'4B',X'5C',X'4D',X'4E',X'5F', 00149500 X'60',X'71',X'72',X'63',X'74',X'65',X'66',X'77',X'78',X'69',X'6A', 00149600 0,X'AD',0,0,X'3A', 00149700 0,X'C1',X'C2',X'D3',X'C4',X'D5',X'D6',X'C7',X'C8',X'D9',X'DA', 00149800 X'CB',X'DC',X'CD',X'CE',X'DF', 00149900 X'E0',X'F1',X'F2',X'E3',X'F4',X'E5',X'E6',X'F7',X'F8',X'E9',X'EA', 00150000 0,X'A1',0,X'A2',0 00150100 ! 00150200 %BYTEINTEGERARRAY BUFFER(1:3*MXLINE) ;! O/P BUFFER 00150300 ! 00150400 %INTEGER CHAR ;! CURRENT CHARACTER 00150500 %INTEGER I ;! LOOP VARIABLE 00150600 %INTEGER IB ;! BUFFER POINTER 00150700 %INTEGER LP ;! SECTION LETTER POINTER 00150800 ! 00150900 %OWNINTEGER CASE=1 ;! CURRENT CASE INDICATOR 00151000 %OWNINTEGER MINL='A' ;! MINIMUM SECTION CODE 00151100 %OWNINTEGER ULIN=X'3A' ;! UNDERLINE CHARACTER 00151200 ! 00151300 %SWITCH ENTRY (-5:5) ;! ENTRYPOINTS 00151400 %SWITCH NRML (1:2) ;! CASE NORMAL ACTIONS 00151500 %SWITCH SHFT (1:2) ;! CASE SHIFT ACTIONS 00151600 ! 00151700 -> ENTRY(IND) ;! SELECT ENTRYPOINT 00151800 ! 00151900 ! ENTRY 1 OUTPUT MAIN HEADING TO PAPER TAPE 00152000 ! 00152100 ENTRY(1):SET(BUFFER,1,100,0) ;! CLEAR O/P AREA 00152200 PTOUT(BUFFER,100) ;! RUNOUT 00152300 COPYTEXT (ARWR,1,BUFFER,1,10) 00152400 COPYTEXT (MHEAD,1,BUFFER,19,45) ;! SET UP MAIN HEADING 00152500 COPYTEXT (ARWR,1,BUFFER,72,10) 00152600 PTOUT (BUFFER,92) ;! OUTPUT LEADER 00152700 SET(BUFFER,1,100,0) 00152800 %RETURN 00152900 ! 00153000 ! ENTRY 3 OUTPUT SECTION DELIMITER AND HEADING 00153100 ! 00153200 ENTRY(3):SET(BUFFER,1,74,0) ;! CLEAR O/P AREA 00153300 COPYTEXT (DELIM,1,BUFFER,1,8) ;! ENTER DELIMITER 00153400 LP=(PARM-MINL)*8 ;! CALC POSN OF SECTN REQUIRED 00153500 COPYTEXT (LTRS,LP,BUFFER,18,8) ;! ENTER SECTN LTR TO O/P AREA 00153600 COPYTEXT (DELIM,1,BUFFER,35,8) ;! ENTER DELIMITER 00153700 PTOUT (BUFFER,62) ;! OUTPUT TO PAPER TAPE 00153800 %RETURN 00153900 ! 00154000 ! ENTRY 4 TRANSLATE TEXT IN OPAREA AND OUTPUT WITH LINEFEED 00154100 ! ENTRY 5 AS ABOVE BUT FOLLOWED BY AN ITEM DELIMETER 00154200 ! 00154300 ENTRY(-4):ENTRY(-5):%C 00154400 ENTRY(4):ENTRY(5):BUFFER(1)=X'12' ;! SET CRLF AT START OF LINE 00154500 IB=1 ;! INITIALISE BUFFER POINTER 00154600 ! 00154700 %CYCLE I=1,1,PARM 00154800 CHAR=OPAREA(I) ;! EXAMINE NEXT CHARACTER 00154900 %IF CHAR=X'FF' %OR CHAR=X'20' %THENC 00155000 %START ;! BLANK OR DELETE CHARACTER 00155100 %IF CHAR=X'FF' %THEN -> LOOP ;! IGNORE DELETE CHARACTER 00155200 IB=IB+1 ;! ELSE UPDATE BUFFER POINTER 00155300 %IF IND<0 %THENC 00155400 %START ;! IF UNDERLINING REQUIRED 00155500 BUFFER(IB)=ULIN ;! CHARACTER IS INSERTED BEFORE 00155600 IB=IB+1 ;! BLANK AND POINTER UPDATED 00155700 %FINISH 00155800 BUFFER(IB)=X'90' ;! AND SET CODE FOR BLANK 00155900 -> LOOP ;! CONTINUE WITH NEXT CHARACTER 00156000 %FINISH 00156100 CHAR=TRTBL(CHAR) ;! TRANSLATE CHARACTER 00156200 ! 00156300 ! JUMP TO ROUTINE DEPENDENT ON CASE OF CHARACTER. 00156400 ! 00156500 %IF CHAR&X'80'=0 %THEN -> NRML(CASE) %ELSE -> SHFT(CASE) 00156600 ! 00156700 ! CHANGE OF CASE TO CASE NORMAL 00156800 ! 00156900 NRML(1):CASE=2 ;! SET CASE NORMAL MARKER 00157000 IB=IB+1 ;! INCREMENT BUFFER POINTER 00157100 BUFFER(IB)=X'17' ;! SET CASE NORMAL IN BUFFER 00157200 -> NRML(2) ;! JUMP TO ENTER CHARACTER 00157300 ! 00157400 ! CHANGE OF CASE TO CASE SHIFT 00157500 ! 00157600 SHFT(2):CASE=1 ;! CHANGE TO CASE SHIFT 00157700 IB=IB+1 ;! INCREMENT BUFFER POINTER 00157800 BUFFER(IB)=X'06' ;! SET CASE SHIFT IN BUFFER 00157900 ! 00158000 ! NORMAL CHARACTER CASE INDICATOR IS REMOVED AND CHARACTER STORED 00158100 ! 00158200 NRML(2):SHFT(1):IB=IB+1 ;! INCREMENT BUFFER POINTER 00158300 %IF IND<0 %THENC 00158400 %START ;! IF UNDERLINING REQUIRED THE 00158500 BUFFER(IB)=ULIN ;! UNDERLINE CHARACTER PRECEDES 00158600 IB=IB+1 ;! THE CURRENT CHARACTER 00158700 %FINISH 00158800 BUFFER(IB)=CHAR&X'7F' ;! REMOVE CASE BIT LOOP:%REPEAT ;! CONTINUE THROUGH O/P AREA 00159000 ! 00159100 ! WHEN END OF OUTPUT AREA IS REACHED THE RESULTING BUFFER IS OUTPUT 00159200 ! TO PAPER TAPE BY A CALL OF THE OUTPUT ROUTINE 00159300 ! 00159400 PTOUT(BUFFER,IB) 00159500 %IF IND=5 %OR IND=-5 %THENC 00159600 %START ;! ENTRYPOINT 5 ONLY 00159700 BUFFER(1)=X'12' ;! SET CRLF AT START AND 00159800 SET (BUFFER,2,21,0) ;! CLEAR REST OF AREA 00159900 PTOUT (BUFFER,21) ;! AND O/P 2" OF RUNOUT 00160000 %FINISH 00160100 %RETURN ;! RETURN TO CALLING ROUTINE 00160200 ! 00160300 ! ENTRY 0 LAST ENTRY - TERMINATION CODE TO PAPER TAPE 00160400 ! 00160500 ENTRY(0):SET(BUFFER,1,100,0) ;! CLEAR O/P AREA 00160600 COPYTEXT(ARWL,1,BUFFER,11,10) 00160700 COPYTEXT(MHEAD,1,BUFFER,29,45) ;! SET UP TERMINATION CODE 00160800 COPYTEXT(ARWL,1,BUFFER,82,10) 00160900 PTOUT(BUFFER,100) ;! OUTPUT TO PUNCH 00161000 SET(BUFFER,1,100,0) ;! CLEAR O/P AREA 00161100 PTOUT(BUFFER,100) ;! FINAL RUNOUT 00161200 ! 00161300 ! ********************************************************************* 00161400 ! 00161500 %ROUTINE PTOUT(%BYTEINTEGERARRAYNAME BUF,%INTEGER LENG) 00161600 ! 00161700 ! THIS ROUTINE OUTPUTS TO P/TAPE VIA A CALL OF SIM2 00161800 ! 00161900 %SYSTEMROUTINESPEC SIM2(%INTEGER EP,R1,R2,R3) 00162000 %INTEGER FLAG ;! P/TAPE O/P SUCCESS/FAIL IND 00162100 ! 00162200 %RETURN SIM2(3,ADDR(BUF(1)),LENG,ADDR(FLAG)) 00162300 %IF FLAG < 0 %THENC 00162400 %START ;! UNSUCCESSFUL OPERATION 00162500 NEWLINES(2) ;! O/P MESSAGE 00162600 PRINTSTRING('ERROR ON PAPER TAPE PUNCH - JOB TERMINATED') 00162700 %STOP ;! AND STOP JOB 00162800 %FINISH 00162900 ! 00163000 %END ;! PTOUT 00163100 ! 00163200 %END ;! WRBOP 00163300 ! 00163400 ! ********************************************************************* 00163500 ! 00163600 %ROUTINE WRLST (%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C 00163700 %INTEGER LENG,IND) 00163800 ! 00163900 ! THIS ROUTINE OUTPUTS THE CONTENTS OF OPAREA TO THE LISTING 00164000 ! DEVICE VIA THE STREAM UNIT. 00164100 ! 00164200 ! THE FORM OF THE OUTPUT IS DEPENDENT ON THE VALUE OF IND 00164300 ! IND=1 OUTPUTS A MAIN HEADING TO THE LISTING - THE CONTENTS OF 00164400 ! LENG AND OPAREA ARE IGNORED. 00164500 ! 00164600 ! IND=2 OUTPUTS A LINE OF ASTERISKS, THEN THE CONTENTS OF 00164700 ! OPAREA SURROUNDED BY ASTERISKS AND LASTLY ANOTHER LINE 00164800 ! OF ASTERISKS. 00164900 ! 00165000 ! IND=3 ADDS THE CHARACTER IN LENG TO THE SECTION HEADING LINE 00165100 ! AND OUTPUTS THIS 00165200 ! 00165300 ! IND=4 OUTPUTS THE CONTENTS OF OPAREA PRECEDED BY TEN SPACES 00165400 ! 00165500 ! IND=5 AS FOR IND=4 BUT FOLLOWED BY A BLANK LINE 00165600 ! 00165700 ! IND=0 LAST ENTRY PRINTS TERMINATION MESSAGE 00165800 ! 00165900 ! ALL THESE FORMS OF OUTPUT ARE SUITABLY SPACED 00166000 ! 00166100 %ROUTINESPEC OUTPUT(%BYTEINTEGERARRAYNAME AREA,%INTEGER LENG,LFB,LFA) 00166200 ! 00166300 %OWNBYTEINTEGERARRAY BUF(1:68)=32,32,32,32,32,32,32,32,32,32,32,32,32, 00166400 32,32,32,32,32,32,32,32,32,'B','U','L', 00166500 'L','E','T','I','N',' ','O','U','T', 00166600 'P','U','T',' ','L','I','S','T','I', 00166700 'N','G',32,32,32,32,32,32,32,32,32,32, 00166800 32,32,32,32,32,32,32,32,32,32,32,32,32 00166900 %OWNBYTEINTEGERARRAY DHEAD(1:68)='*','*','*','*','*','*','*','*','*', 00167000 '*',32,32,32,32,32,32,32,32,32,32,32, 00167100 32,32,32,32,32,32,32,32,32,32,32,32, 00167200 32,32,32,32,32,32,32,32,32,32,32,32, 00167300 32,32,32,32,32,32,32,32,32,32,32,32, 00167400 32,'*','*','*','*','*','*','*','*', 00167500 '*','*' 00167600 %OWNBYTEINTEGERARRAY SHEAD(1:68)='*','*','*','*','*','*','*','*','*', 00167700 '*',32,32,32,32,32,32,32,32,32,32,32, 00167800 32,32,32,32,32,32,32,32,'S','E','C', 00167900 'T','I','O','N',32,32,32,32,32,32,32, 00168000 32,32,32,32,32,32,32,32,32,32,32,32, 00168100 32,32,32,'*','*','*','*','*','*','*', 00168200 '*','*','*' 00168300 %OWNBYTEINTEGERARRAY ASTKA(1:68)='*','*','*','*','*','*','*','*','*', 00168400 '*','*','*','*','*','*','*','*','*', 00168500 '*','*','*','*','*','*','*','*','*', 00168600 '*','*','*','*','*','*','*','*','*', 00168700 '*','*','*','*','*','*','*','*','*', 00168800 '*','*','*','*','*','*','*','*','*', 00168900 '*','*','*','*','*','*','*','*','*', 00169000 '*','*','*','*','*' 00169100 %OWNBYTEINTEGERARRAY EOJB(1:68)='*','*','*','*','*','*','*','*','*', 00169200 '*',32,32,32,32,32,32,32,32,32,32,32, 00169300 32,32,32,32,32,'E','N','D',' ','O', 00169400 'F',' ','B','U','L','L','E','T','I', 00169500 'N',32,32,32,32,32,32,32,32,32,32,32, 00169600 32,32,32,32,32,32,'*','*','*','*','*', 00169700 '*','*','*','*','*' 00169800 ! 00169900 %INTEGER I ;! LOOP VARIABLE 00170000 %INTEGER ST ;! START POINTER 00170100 ! 00170200 %OWNINTEGER MXBUF ;! SIZE OF O/P ARRAYS 00170300 ! 00170400 %SWITCH ENTRY(0:5) ;! ENTRY SWITCH 00170500 ! 00170600 -> ENTRY(IND) ;! JUMP TO APPROPRIATE POINT 00170700 ! 00170800 ! IND=1 FIRST ENTRY O/P HEADING ONLY 00170900 ! 00171000 ENTRY(1):MXBUF=68 ;! SET MAX O/P LINE SIZE 00171100 OUTPUT(BUF,MXBUF,0,0) ;! O/P MAIN HEADING 00171200 %CYCLE I=1,1,MXBUF ;! PRECEDED BY 10 NEW LINES 00171300 %IF BUF(I)\=' ' %THEN BUF(I)='*' ;! UNDERLINE HEADING 00171400 %REPEAT 00171500 OUTPUT(BUF,MXBUF,1,0) ;! OUTPUT UNDERLINING 00171600 SET(BUF,1,MXBUF,BLNK) ;! CLEAR O/P BUFFER 00171700 %RETURN ;! RETURN TO CALLING ROUTINE 00171800 ! 00171900 ! IND=2 MAIN DIVISION HEADING 00172000 ! 00172100 ENTRY(2):OUTPUT(ASTKA,MXBUF,3,0) ;! O/P LINE OF ASTERISKS 00172200 ST=(MXBUF-LENG)//2 ;! CALC STARTING POSITION 00172300 %CYCLE I=1,1,LENG 00172400 DHEAD(ST+I)=OPAREA(I) ;! SET UP DIVISION HEADING 00172500 %REPEAT 00172600 OUTPUT(DHEAD,MXBUF,1,0) ;! OUTPUT DIVISION SEPARATOR 00172700 %CYCLE I=1,1,LENG 00172800 DHEAD(ST+I)=' ' ;! CLEAR CENTRE OF ARRAY 00172900 %REPEAT 00173000 OUTPUT(ASTKA,MXBUF,1,2) ;! OUTPUT LINE OF ASTERISKS 00173100 %RETURN 00173200 ! 00173300 ! IND=3 SECTION HEADING WITHIN JOURNALS 00173400 ! 00173500 ENTRY(3):SHEAD(38)=(LENG&X'FF') ;! MOVE SECTION CODE TO O/P AREA 00173600 OUTPUT(SHEAD,MXBUF,3,2) 00173700 %RETURN 00173800 ! 00173900 ! IND=4 TITLE OR RECORD SINGLE OUTPUT LINE 00174000 ! IND=5 AS ABOVE FOLLOWED BY BLANK LINE 00174100 ! 00174200 ENTRY(4):ENTRY(5):%CYCLE I=1,1,LENG 00174300 BUF(10+I)=OPAREA(I) ;! MOVE O/P TO BUFFER AREA 00174400 %REPEAT 00174500 %IF LENG < MXLINE %THEN SET(BUF,LENG+11,MXLINE+11,BLNK) 00174600 OUTPUT(BUF,MXBUF,1,IND-4) ;! OUTPUT LINE 00174700 %RETURN 00174800 ! 00174900 ! IND=0 LAST ENTRY EOJ MESSAGE OUTPUT 00175000 ! 00175100 ENTRY(0):OUTPUT(ASTKA,MXBUF,3,0) ;! END OF LISTING 00175200 OUTPUT(EOJB,MXBUF,1,0) 00175300 OUTPUT(ASTKA,MXBUF,1,3) 00175400 %RETURN 00175500 ! 00175600 ! ********************************************************************* 00175700 ! 00175800 %ROUTINE OUTPUT(%BYTEINTEGERARRAYNAME AREA, %INTEGER LENG,LFB,LFA) 00175900 ! 00176000 ! ROUTINE OUTPUTS THE ALPHANUMERIC CONTENTS OF AREA TO THE CURRENT 00176100 ! STREAM PRECEEDED BY LFB LINE FEEDS AND FOLLOWED BY LFA LINE FEEDS. 00176200 ! 00176300 %INTEGER I 00176400 %OWNINTEGER POINT=1 00176500 ! 00176600 %SWITCH ENTRY(1:2) ;! ENTRY SWITCH 00176700 ! 00176800 -> ENTRY(POINT) 00176900 ! 00177000 ENTRY(1):NEWPAGE ;! NEW PAGE ON FIRST ENTRY ONLY 00177100 POINT=2 ;! CHANGE ENTRY SWITCH 00177200 ! 00177300 ENTRY(2):%IF LFB<=0 %THEN-> OA 00177400 %IF LFB=1 %THEN NEWLINE %ELSE NEWLINES(LFB) 00177500 ! 00177600 OA: %CYCLE I=1,1,LENG 00177700 PRINT SYMBOL(AREA(I)) ;! OUT PUT CHARACTERS 00177800 %REPEAT 00177900 ! 00178000 %IF LFA<=0 %THEN %RETURN 00178100 %IF LFA=1 %THEN NEWLINE %ELSE NEWLINES(LFA) 00178200 %RETURN 00178300 %END ;! OUTPUT 00178400 %END;!WRLST 00178500 ! 00178600 ! ********************************************************************* 00178700 ! 00178800 %ROUTINE CREATELINE (%BYTEINTEGERARRAYNAME OPLINE,DATA, %C 00178900 %INTEGER START,MXLINE,TNW, %C 00179000 %INTEGERNAME LENGOP,END) 00179100 ! 00179200 ! THIS ROUTINE SETS UP LINES IN OPLINE BEGINNING AT START AND OF 00179300 ! MAXIMUM LENGTH MXLINE. THE OUTPUT LINE IS BOTH LEFT AND RIGHT 00179400 ! JUSTIFIED UNLESS THE OUTPUT DOES NOT FILL THE O/P AREA IN WHICH 00179500 ! CASE ONLY LEFT JUSTIFICATION TAKES PLACE. THE END OF THE DATA 00179600 ! IS INDICATED BY THE VARIABLE END BEING SET NON-ZERO. 00179700 ! 00179800 %OWNINTEGER FOB=1 ;! EXTRA SPACING SIDE INDIC 00179900 %OWNINTEGER IST ;! POINTER TO CURRENT ITEM 00180000 %OWNINTEGER NEW=1 ;! NEW DATA INDICATOR 00180100 ! 00180200 %INTEGER FRST ;! START POSN IN DATA 00180300 %INTEGER I ;! LOOP VARIABLE 00180400 %INTEGER INC ;! NO OF SPACES TO BE INSERTED 00180500 %INTEGER LENG ;! LENGTH OF ITEM 00180600 %INTEGER LP ;! CURRENT O/P LINE POINTER 00180700 %INTEGER NSP ;! NO OF GAPS TO RECEIVE SPACES 00180800 %INTEGER NW ;! NUMBER OF WORDS IN LINE 00180900 %INTEGER REM ;! NO OF SPARE POSNS REMAINING 00181000 ! 00181100 %SWITCH FILL(1:2) ;! ALTERNATE FILL OUT SWITCH 00181200 ! 00181300 %IF NEW=YES %THENC 00181400 %START ;! FIRST ENTRY FOR NEW ITEM 00181500 NEW=0 ;! SET NEW DATA SWITCH OFF 00181600 IST=1 ;! SET START OF LOOP 00181700 %FINISH 00181800 LP=START-1 ;! INITIALISE LINE POINTER 00181900 ! 00182000 ! THE CURRENT SECTION OF THE POINTER ARRAYS IS SCANNED AND THE 00182100 ! NEXT LINE CREATED AFTER THE REQUIRED ALIGNMENT. 00182200 ! 00182300 %CYCLE I=IST,1,TNW 00182400 %IF LP+WLNG(I)>MXLINE %THEN -> LNFUL ;! JUMP IF LINE FULL 00182500 LP=LP+WLNG(I)+WSPS(I) ;! INCREMENT LINE POINTER 00182600 %REPEAT 00182700 ! 00182800 ! END OF DATA REACHED - NO ALIGNMENT NECESSARY 00182900 ! 00183000 NW=TNW ;! SET WORD COUNT 00183100 NEW=YES ;! RESET ENTRY VARIABLE 00183200 LENGOP=LP-WSPS(TNW) ;! CALC LENGTH OF O/P LINE 00183300 %IF LENGOP CRLN ;! O/P SHORT LINE NOW 00183400 I=TNW+1 ;! BUT ADJUST LONG LAST LINE 00183500 ! 00183600 ! END OF OUTPUT LINE REACHED - WORDS ARE LEFT AND RIGHT ADJUSTED 00183700 ! AS REQUIRED. 00183800 ! 00183900 LNFUL:NW=I-1 ;! CALC NUMBER OF ITEMS 00184000 NSP=MXLINE-LP+WSPS(NW) ;! CALC NO OF SPARE SPACES 00184100 LENGOP=MXLINE ;! SET LENGTH OF O/P LINE 00184200 %IF NW-IST<=0 %THEN -> CRLN ;! O/P LINE IF <= ONE ITEM 00184300 INC=NSP//(NW-IST) ;! CALC OVERALL INCREMENT 00184400 %IF INC=0 %THEN REM=NSP %ELSEC 00184500 %START ;! OVERALL INCREMENT NON-ZERO 00184600 %CYCLE I=IST,1,NW-1 ;! ADD APPROPRIATE VALUE TO 00184700 WSPS(I)=WSPS(I)+INC ;! EACH SPACE ALLOWANCE 00184800 %REPEAT 00184900 REM=NSP-((NW-IST)*INC) ;! CALCULATE REMAINDER 00185000 %FINISH 00185100 %IF REM=0 %THEN -> CRLN ;! IF LINE FILLED NO ADJ NEC 00185200 -> FILL(FOB) ;! ELSE FILL AS INDICATED 00185300 ! 00185400 FILL(1):FOB=2 ;! CHANGE SWITCH FOR NEXT TIME 00185500 %CYCLE I=IST,1,IST+REM-1 ;! ADD SPARES FROM THE LEFT 00185600 WSPS(I)=WSPS(I)+1 ;! ONE EXTRA PER SPACE 00185700 %REPEAT 00185800 -> CRLN ;! JUMP TO CREATE O/P LINE 00185900 ! 00186000 FILL(2):FOB=1 ;! CHANGE SWITCH FOR NEXT TIME 00186100 %CYCLE I=NW-REM,1,NW-1 ;! ADD SPARES FROM THE RIGHT 00186200 WSPS(I)=WSPS(I)+1 ;! ONE EXTRA PER SPACE 00186300 %REPEAT 00186400 ! 00186500 ! WHEN WORDS HAVE BEEN PROPERLY SPACED OUT THE OUTPUT LINE IS CREATED00186600 ! 00186700 CRLN:LP=START ;! INITIALISE LINE POSITION 00186800 SET (OPLINE,1,MXLINE,BLNK) ;! CLEAR O/P AREA 00186900 %CYCLE I=IST,1,NW ;! CYCLE THROUGH WORDS 00187000 FRST=WBGN(I) ;! TRANSFER START TO INTEGER 00187100 LENG=WLNG(I) ;! TRANSFER LENGTH TO INTEGER 00187200 COPYTEXT (DATA,FRST,OPLINE,LP,LENG) 00187300 LP=LP+WLNG(I)+WSPS(I) ;! UPDATE LINE POINTER 00187400 %REPEAT 00187500 ! 00187600 IST=NW+1 ;! INCREMENT START VAL FOR NEXT 00187700 END=NEW ;! SET EXIT INDICATOR 00187800 %END ;! CREATELINE 00187900 ! 00188000 ! ********************************************************************* 00188100 ! 00188200 %ROUTINE OUTPUT ITEM (%INTEGER JNUM) 00188300 ! 00188400 ! THIS ROUTINE ASSEMBLES THE BULLETIN OUTPUT RECORD FROM THE 00188500 ! INTERNAL RECORD FORMAT AND CALLS ROUTINES TO OUTPUT THE RESULTING 00188600 ! LINES TO THE BULLETIN AND LISTING DEVICES. 00188700 ! 00188800 %BYTEINTEGERARRAY OPLINE(1:MXLINE) ;! OUTPUT BUFFER %OWNBYTEINTEGERARRAY REFS(1:25) ;! ITEM REFERENCE %BYTEINTEGERARRAY TEMP(1:500) ;! TEMP ARRAY FOR AUTHORS ! %INTEGER I ;! LOOP VARIABLE 00189300 %INTEGER ID ;! POINTER TO THE DIRECTORY 00189400 %INTEGER INCT ;! LENGTH OF CURRENT ITEM 00189500 %INTEGER IND ;! INDICATOR 00189600 %INTEGER IT ;! POINTER TO THE INT REC TEXT 00189700 %INTEGER IT1 ;! SUBSIDIARY PTR TO TEXT (1) 00189800 %INTEGER IT2 ;! SUBSIDIARY PTR TO TEXT (2) 00189900 %INTEGER J ;! TEMPORARY VARIABLE %INTEGER LENGOP ;! LENGTH OF O/P LINE (BYTES) 00190000 %INTEGER MXT ;! END OF CURRENT ITEM 00190100 %INTEGER OPST ;! START POSN OF O/P LINE 00190200 %INTEGER RLN ;! LENGTH OF REFERENCE NUMBER 00190300 %INTEGER RST ;! START POS OF REF NO 00190400 %INTEGER RV ;! SWITCH CONTROL VALUE 00190500 %INTEGER TPOS ;! CURRENT POS IN TEMP ARRAY 00190600 %OWNINTEGER ENO=1 ;! ENTRY SWITCH 00190700 ! 00190800 %SWITCH ENT(1:2) ;! ENTRYPOINTS 00190900 %SWITCH RET(1:4) ;! RETURN FROM LINE O/P SWITCH 00191000 ! 00191100 SET (OPLINE,1,25,0) ;! ZEROISE OUTPUT AREA 00191200 ! 00191300 ! REFERENCE NUMBER - THIS IS MOVED DIRECTLY TO THE O/P AREA 00191400 ! 00191500 -> ENT(ENO) 00191600 ! 00191700 ENT(1):ENO=2 ;! CHANGE ENTRY SWITCH 00191800 I=MONTH ;! EXTRACT DIGITS OF 00191900 J=I//10 ;! MONTH NUMBER AND 00192000 REFS(4)=(I-J*10)!X'30' ;! STORE PERMANENTLY IN 00192100 I=J//10 ;! REFERENCE O/P AREA 00192200 REFS(3)=(J-I*10)!X'30' 00192300 J=I//10 00192400 REFS(2)=(I-J*10)!X'30' 00192500 REFS(1)=J!X'30' 00192600 REFS(5)='/' 00192700 ENT(2):I=ITEMNO 00192800 J=I//10 00192900 REFS(8)=(I-J*10)!X'30' ;! DIGITS OF ITEM 00193000 I=J//10 ;! NUMBER MUST BE 00193100 REFS(7)=(J-I*10)!X'30' ;! EXTRACTED EACH TIME 00193200 REFS(6)=I!X'30' 00193300 WRBOP(OPUNIT,REFS,25,4) ;! OUTPUT TO BULLETIN 00193400 WRLST(LSUNIT,REFS,8,4) ;! OUTPUT TO LISTING 00193500 ! 00193600 ! TITLE - REALIGNED BY WORD BEFORE OUTPUT 00193700 ! 00193800 NW=1 ;! INITIALISE WORD POINTER 00193900 IT=IRDIRC(2*PT+1) ;! SET START OF TITLE 00194000 %IF IT=0 %THEN -> RET(1) ;! SKIP IF NULL ITEM 00194100 MXT=IRDIRC(2*PT+2)+IT-1 ;! SET LENGTH OF TITLE 00194200 MARKWORDS(IRTEXT,IT,MXT,NW) ;! MARK POSN + LENGTH OF WORDS 00194300 NW=NW-1 ;! ADJUST WORD TOTAL 00194400 OPST=6 ;! SET START OF 1ST O/P LINE 00194500 RV=1 ;! SET RETURN VALUE 00194600 -> CRLN ;! JUMP TO O/P TITLE 00194700 ! 00194800 ! AUTHORS - EDIT IN TEMPORARY ARRAY BEFORE O/P AS THEY ARE STORED 00194900 ! IN A SPECIAL COMPACT FORM IN THE INTERNAL RECORD. 00195000 ! 00195100 RET(1):NW=1 ;! INITIALISE ITEM POINTER 00195200 IT=IRDIRC(2*PA+1) ;! SET FIRST TEXT POINTER 00195300 %IF IT=0 %THEN -> RET(2) ;! SKIP IF NULL ITEM 00195400 MXT=IT+IRDIRC(2*PA+2)-1 ;! SET LENGTH OF THIS ITEM 00195500 TPOS=1 ;! INITIALISE TEMP ARRAY POINTER 00195600 ABGN:%IF (MXT-IT+1)>MXLINE*2//3 %THENC 00195700 %START ;! IF AUTHOR TOO LONG, 00195800 COPYTEXT(IRTEXT,IT,TEMP,TPOS,MXT-IT+1) ;! SPLIT UP 00195900 MARKWORDS(TEMP,TPOS,TPOS+MXT-IT,NW) 00196000 NW=NW-1 ;! ADJUST WORD COUNT 00196100 IT=MXT+1 ;! INCREMENT POINTER 00196200 -> AEND 00196300 %FINISH 00196400 WBGN(NW)=TPOS ;! SET START OF AUTHOR 00196500 AMOV:TEMP(TPOS)=IRTEXT(IT) ;! MOVE NEXT CHARACTER 00196600 TPOS=TPOS+1 ;! INCREMENT TEMP ARRAY PTR 00196700 %IF IRTEXT(IT)=ENDAUT %THENC 00196800 %START ;! END OF AUTHOR SURNAME 00196900 IT=IT+1 ;! UPDATE TEXT POINTER 00197000 AINT: TEMP(TPOS)=IRTEXT(IT) ;! MOVE INITIALS 00197100 IT=IT+1 ;! UPDATE POINTERS TO TEXT 00197200 TPOS=TPOS+1 ;! AND TEMPORARY ARRAYS 00197300 %IF IT>MXT %THEN -> ASET ;! EXIT IF END OF AUTHOR FOUND 00197400 ! 00197500 ! A BLANK IS INSERTED BEFORE A CAPITAL LETTER UNLESS IT IS 00197600 ! IMMEDIATELY PRECEDED BY A SPECIAL CHARACTER OR MAC OR MC. 00197700 ! 00197800 %IF 'A'<=IRTEXT(IT)<='Z' %THENC 00197900 %START ;! NEXT CHARACTER IS CAPITAL 00198000 %IF 'A'<=TEMP(TPOS-1)<='Z' %ORC 00198100 SMA<=TEMP(TPOS-1)<=SMZ %THENC 00198200 %START ;! PRECEDED BY ALPHA-CHAR 00198300 %IF TEMP(TPOS-1)=SMC %THENC 00198400 %START ;! CHECK FOR MAC OR MC 00198500 %IF TEMP(TPOS-2)='M' %THEN -> AINT 00198600 %IF TEMP(TPOS-3)='M' %ANDC 00198700 TEMP(TPOS-2)=SMA %THEN -> AINT 00198800 %FINISH 00198900 TEMP(TPOS)=' ' ;! INSERT BLANK CHARACTER 00199000 TPOS=TPOS+1 ;! UPDATE POINTER 00199100 %FINISH 00199200 %FINISH 00199300 -> AINT ;! PROCESS NEXT CHARACTER 00199400 %FINISH 00199500 IT=IT+1 ;! UPDATE TEXT POINTER 00199600 %IF IT<=MXT %THEN -> AMOV ;! CONTINUE TO END OF SURNAME 00199700 ! 00199800 ASET:WLNG(NW)=TPOS-WBGN(NW) ;! SET LENGTH OF EDITED AUTHOR 00199900 AEND:WSPS(NW)=3 ;! ALLOW EXTRA SPACING 00200000 %IF IRTEXT(IT)\=0 %THENC 00200100 %START ;! FURTHER AUTHORS 00200200 NW=NW+1 ;! UPDATE ITEM POINTER 00200300 MXT=IRTEXT(IT)+IT ;! SET LIMIT OF THIS AUTHOR 00200400 IT=IT+1 ;! SET FIRST TEXT POINTER 00200500 -> ABGN ;!PROCESS NEXT AUTHOR 00200600 %FINISH 00200700 ACRL:CREATELINE(OPLINE,TEMP,1,MXLINE,NW,LENGOP,IND) 00200800 WRBOP(OPUNIT,OPLINE,LENGOP,4) ;! O/P AUTHOR NAMES TO BULLETIN 00200900 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! AND LISTING DEVICES 00201000 %IF IND=0 %THEN -> ACRL ;! CONTINUE TO END OF AUTHORS 00201100 ! 00201200 ! BIBLIOGRAPHIC DETAILS ETC - FOR JOURNALS ONLY PAGINATION DETAILS 00201300 ! ARE OUTPUT BUT FOR SPECIAL TYPE INPUT ALL SECTIONS ARE PRINTED. 00201400 ! 00201500 RET(2):NW=1 ;! RESET THE WORD POINTER 00201600 ID=2*PB+1 ;! SET DIRECTORY POINTER 00201700 %IF JNUM>>24&X'FF'='Z' %THENC 00201800 %START ;! SPECIAL TYPE INPUT 00201900 RST=IRDIRC(ID)+IRDIRC(ID+1)+1 ;! STORE TEXT POINTER AND LENGTH 00202000 RLN=IRTEXT(RST-1) ;! OF REFERENCE NUMBER 00202100 IT=RST+RLN+1 ;! SET TEXT PTR AND ITEM LENGTH 00202200 INCT=IRTEXT(IT-1) ;! SKIPPING FIRST TWO ENTRIES 00202300 -> BCHK ;! JUMP TO PROCESS 00202400 %FINISH 00202500 !?? %START ;! JOURNAL OR PSEUDO-JOURNAL 00202600 RST=0 ;! SET REF POINTER TO ZERO 00202700 IT1=IRDIRC(ID) ;! SET START OF FIRST ITEM 00202800 %IF IT1=0 %THEN -> BSKP ;! SKIP IF NULL ITEM 00202900 INCT=IRDIRC(ID+1) ;! SET LENGTH OF FIRST ITEM 00203000 BNXT: IT2=IT1+INCT ;! SET PTR TO LENGTH OF NEXT 00203100 %IF IRTEXT(IT2)\=0 %THENC 00203200 %START ;! NOT LAST ITEM 00203300 IT1=IT2+1 ;! SET START OF NEXT ITEM 00203400 INCT=IRTEXT(IT2) ;! SET LENGTH OF NEXT ITEM 00203500 -> BNXT ;! CHECK NEXT 00203600 %FINISH 00203700 WBGN(NW)=IT1 ;! LAST ITEM IS PAGINATION 00203800 WLNG(NW)=INCT ;! SET START AND LENGTH 00203900 WSPS(NW)=2 ;! AND FOLLOW BY DOUBLE SPACE 00204000 NW=NW+1 ;! UPDATE THE COUNT 00204100 BSKP: ID=ID+2 ;! SET NEXT DIRECTORY POINTER 00204200 !?? %FINISH 00204300 BMOV:IT=IRDIRC(ID) ;! SET PTR TO 1ST ITEM FROM DIR 00204400 %IF IT=0 %THEN -> BEND ;! SKIP IF THERE ARE NO ENTRIES 00204500 INCT=IRDIRC(ID+1) ;! SET LENGTH OF FIRST ITEM 00204600 ! 00204700 ! A LARGE ITEM IS PROCESSED WORD BY WORD, BUT WHERE POSSIBLE AN 00204800 ! ITEM IS TREATED AS AN ENTITY OF ITSELF. 00204900 ! 00205000 BCHK:%IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC00205100 %START 00205200 WBGN(NW)=IT ;! SET START AND 00205300 WLNG(NW)=INCT ;! LENGTH OF ITEM 00205400 NW=NW+1 ;! UPDATE POINTER 00205500 %FINISH 00205600 WSPS(NW-1)=2 ;! DOUBLE SPACE AT END 00205700 IT=IT+INCT+1 ;! SET START OF NEXT ITEM 00205800 INCT=IRTEXT(IT-1) ;! EXAMINE LENGTH OF NEXT ITEM 00205900 %IF INCT\=0 %THEN -> BCHK ;! CONTINUE IF NON-ZERO 00206000 BEND:ID=ID+2 ;! NO MORE ITEMS IN THIS SECTN 00206100 %IF ID<=2*PN+1 %THEN -> BMOV ;! UPDATE AND CONTINUE 00206200 NW=NW-1 ;! ADJUST TOTAL WHEN END REACHED 00206300 RV=3 ;! SET RETURN VALUE 00206400 %IF NW>0 %THEN -> CRLN ;! O/P ANY ITEMS IF NECESSARY 00206500 ! 00206600 ! LANGUAGE DETAILS ARE SIMILAR TO BIBLIOGRAPHIC DETAILS EXCEPT 00206700 ! THAT MULTIPLE ITEMS WILL NOT APPEAR. 00206800 ! 00206900 RET(3):NW=1 ;! RESET ITEM POINTER 00207000 LMOV:IT=IRDIRC(ID) ;! SET START OF ITEM 00207100 %IF IT=0 %THEN -> REND ;! SKIP IF NO ENTRY 00207200 INCT=IRDIRC(ID+1) ;! SET LENGTH OF ITEM 00207300 %IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC00207400 %START ;! ITEM SUFFICIENTLY SMALL 00207500 WBGN(NW)=IT ;! SET START AND 00207600 WLNG(NW)=INCT ;! LENGTH OF ITEM 00207700 NW=NW+1 ;! INCREMENT POINTER 00207800 %FINISH 00207900 WSPS(NW-1)=2 ;! FOLLOW BOTH BY DOUBLE SPACE 00208000 REND:ID=ID+2 ;! INCREMENT DIRECTORY POINTER 00208100 %IF ID<=2*PD+1 %THEN -> LMOV ;! CONTINUE IF MORE ENTRIES 00208200 NW=NW-1 ;! ELSE ADJUST ITEM TOTAL 00208300 RV=4 ;! SET RETURN VALUE 00208400 %IF NW<=0 %THEN -> RET(4) ;! SKIP O/P IF NO ITEMS 00208500 ! 00208600 ! OUTPUT IS CREATED AND 'WRITTEN' A LINE AT A TIME 00208700 ! 00208800 CRLN:CREATELINE(OPLINE,IRTEXT,OPST,MXLINE,NW,LENGOP,IND) 00208900 WRBOP(OPUNIT,OPLINE,LENGOP,4) ;! O/P TO BULLETIN 00209000 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! O/P TO LISTING DEVICE 00209100 OPST=1 ;! ENSURE O/P LINED UP 00209200 %IF IND=0 %THEN -> CRLN ;! CONTINUE IF END NOT REACHED 00209300 -> RET(RV) ;! RETURN TO APPROPRIATE POSN 00209400 ! 00209500 ! RECORD NOW OUTPUT - RETURN CONTROL TO CALLING ROUTINE 00209600 ! 00209700 RET(4):SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR OUTPUT AREA 00209800 %IF RST\=0 %THENC 00209900 %START ;! NON-JOURNAL I/P - ADD REF 00210000 I=MXLINE-RLN+1 ;! SET START POS OF REF IN O/P 00210100 COPYTEXT(IRTEXT,RST,OPLINE,I,RLN) ;! MOVE REFERENCE TO O/P AREA 00210200 WRBOP(OPUNIT,OPLINE,MXLINE,4) ;! O/P TO BULLETIN 00210300 WRLST(LSUNIT,OPLINE,MXLINE,5) ;! O/P TO LISTING 00210400 %FINISH %ELSE WRLST(LSUNIT,OPLINE,MXLINE,4) 00210500 SET(OPLINE,1,MXLINE,0) ;! ZEROISE OUTPUT AREA 00210600 WRBOP (OPUNIT,OPLINE,20,4) ;! OUTPUT BLANK TAPE 00210700 ! 00210800 %END ;! OUTPUTITEM 00210900 ! 00211000 ! ********************************************************************* 00211100 ! 00211200 %ROUTINE MARKWORDS(%BYTEINTEGERARRAYNAME ARR, %INTEGER ST,MAX, %C 00211300 %INTEGERNAME NW) 00211400 ! 00211500 ! ROUTINE CALLS MARKWORD STORES THE RESULT AND UPDATES THE POINTER 00211600 ! 00211700 %INTEGER NB ;! START OF WORD 00211800 %INTEGER NL ;! LENGTH OF WORD 00211900 %INTEGER NS ;! NUMBER OF SPACES TO FOLLOW 00212000 ! 00212100 MKWD:MARKWORD(ARR,MAX,NB,NL,NS,ST) 00212200 %IF NB=0 %THEN %RETURN ;! RETURN WHEN END REACHED 00212300 WBGN(NW)=NB 00212400 WLNG(NW)=NL ;! STORE WORD DETAILS 00212500 WSPS(NW)=NS 00212600 NW=NW+1 ;! UPDATE WORD POINTER 00212700 -> MKWD ;! JUMP TO FIND NEXT WORD 00212800 ! 00212900 %END ;! MARKWORDS 00213000 ! 00213100 ! ********************************************************************* 00213200 ! 00213300 %ROUTINE MARKWORD (%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C 00213400 %INTEGERNAME ST,LN,SP,IA) 00213500 ! 00213600 ! THIS ROUTINE FINDS THE START AND LENGTH OF THE NEXT SEQUENCE OF 00213700 ! NON-BLANK CHARACTERS IN THE ARRAY ARR(MXA) STARTING FROM THE 00213800 ! POSITION IA. IF A SEQUENCE IS FOUND, ST IS SET TO THE VALUE OF 00213900 ! IA WHEN THE FIRST CHARACTER IS FOUND, LN IS SET TO THE LENGTH OF 00214000 ! THE WORD AND SP TO THE NUMBER OF SPACES WHICH ARE TO FOLLOW IT. 00214100 ! (SP DEPENDS ON THE LAST CHARACTER OF THE SEQUENCE) ON EXIT IA 00214200 ! POINTS IMMEDIATELY PAST THE LAST CHARACTER OF THE SEQUENCE. 00214300 ! 00214400 %INTEGER IND ;! SWITCH VARIABLE 00214500 %SWITCH S1,S2(1:2) 00214600 ! 00214700 ST=0 ;! SET START VALUE TO ZERO 00214800 IND=1 ;! SET SWITCH VARIABLE 00214900 -> CHCK ;! JUMP TO CHECK FIRST CHAR 00215000 ! 00215100 S1(1):S2(2):IA=IA+1 ;! INCREMENT POINTER 00215200 CHCK:%IF IA > MXA %THENC 00215300 %START ;! END OF ARRAY REACHED 00215400 %IF ST=0 %THEN %RETURN ;! ERROR EXIT IF NO WORD FOUND 00215500 -> S1(2) ;! ELSE SET LENGTH ETC. 00215600 %FINISH 00215700 %IF ARR(IA)=' ' %THEN -> S1(IND) ;! JUMP IF BLANK FOUND 00215800 -> S2(IND) ;! TO S1 ELSE JUMP TO S2 00215900 ! 00216000 ! WHEN FIRST NON-BLANK FOUND THE SWITCH VARIABLE IS ALTERED SO THAT 00216100 ! THE NEXT BLANK FOUND ACTS AS A TERMINATOR TO THE WORD. 00216200 ! 00216300 S2(1):IND=2 ;! CHANGE INDICATOR 00216400 ST=IA ;! STORE START VALUE OF IA 00216500 -> S1(1) ;! CONTINUE 00216600 ! 00216700 ! THE FIRST BLANK CHARACTER FOUND AFTER ANY NON-BLANK TERMINATES 00216800 ! THE CURRENT WORD AND LENGTH ETC. MUST BE CALCULATED. 00216900 ! 00217000 S1(2):LN=IA-ST ;! SET LENGTH OF WORD 00217100 %IF ARR(IA-1)='.' %THEN SP=2 %ELSE SP=1 ;! CALCULATE SPACING 00217200 ! 00217300 %END ;! MARKWORD 00217400 ! 00217500 ! ********************************************************************* 00217600 ! 00217700 %ROUTINE COPYTEXT(%BYTEINTEGERARRAYNAME SOURCE,%INTEGER SSTRT, %C 00217800 %BYTEINTEGERARRAYNAME DEST,%INTEGER DSTRT,L) 00217900 ! 00218000 ! MOVES L BYTES FROM SOURCE(SSTRT) ET SEQ. TO DEST(DSTRT) ET SEQ.00218100 %INTEGER I 00218200 ! 00218300 %IF L<= 0 %THEN %RETURN 00218400 %CYCLE I=SSTRT,1,SSTRT+L-1 00218500 DEST(DSTRT)=SOURCE(I) 00218600 DSTRT=DSTRT+1 00218700 %REPEAT 00218800 %END;! COPYTEXT 00218900 ! 00219000 ! ********************************************************************* 00219100 ! 00219200 %ROUTINE SET(%BYTEINTEGERARRAYNAME A,%INTEGER START,END,VAL) 00219300 ! 00219400 ! ROUTINE SETS A(START) TO A(END) TO THE LEAST SIGNIFICANT EIGHT 00219500 ! BITS OF THE VALUE HELD IN VAL. 00219600 ! 00219700 %INTEGER I 00219800 ! 00219900 %CYCLE I=START,1,END 00220000 A(I)<-VAL 00220100 %REPEAT 00220200 %END;! SET 00220300 ! 00220400 ! ********************************************************************* 00220500 ! 00220600 %ROUTINE SORTN (%INTEGERARRAYNAME NUMBER,PTR, %C 00220700 %INTEGER MINN,MAXN,L) 00220800 ! 00220900 %INTEGER I ;! LOOP VARIABLE 00221000 %INTEGER J ;! LOOP VARIABLE 00221100 %INTEGER LOOP ;! LOOP LIMIT 00221200 %INTEGER IN ;! POINTER 00221300 %INTEGER JN ;! POINTER 00221400 %INTEGER SWOP ;! SWOP VARIABLE 00221500 ! 00221600 %IF MINN>=MAXN %THEN %RETURN 00221700 ! 00221800 %CYCLE LOOP=1,1,2 ;! DOUBLE CYCLE TO 00221900 %CYCLE I=MINN,1,MAXN-1 ;! MAINTAIN I/P ORDER 00222000 %CYCLE J=I+1,1,MAXN 00222100 IN=PTR(I) 00222200 JN=PTR(J) 00222300 %IF NUMBER(IN) CONT 00222400 SWOP=PTR(I) ;! CHANGE POSITIONS 00222500 PTR(I)=PTR(J) ;! IF = OR > 00222600 PTR(J)=SWOP 00222700 CONT:%REPEAT 00222800 %REPEAT 00222900 %REPEAT 00223000 ! 00223100 %END ;! SORTN 00223200 ! 00223300 ! ********************************************************************* 00223400 ! 00223500 %ROUTINE REPORTLIST(%INTEGER RPUNIT, %BYTEINTEGERARRAYNAME REP, %C 00223600 %INTEGER RS,RL,REF) 00223700 ! 00223800 ! ROUTINE ADDS THE REPORT NUMBER HELD IN REP TO THE LIST, TOGETHER 00223900 ! WITH ITS ASSOCIATED REFERENCE NUMBER. AS THE BUFFER FILLS ! IT IS WRITTEN TO THE FILE AND THE LAST ENTRY TO THE ROUTINE ! - SIGNIFIED BY REF=0 - CAUSES THE LAST BUFFER AND POINTERS ! TO BE OUTPUT, TOGETHER WITH A CONTROL BLOCK, BEFORE THE FILE ! IS CLOSED. ! 00224500 %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC WRITEDA(%INTEGER CHANNEL, %C %INTEGERNAME SECT, %C %NAME BEGIN,END) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) ! 00224700 %OWNBYTEINTEGERARRAY RNOS (1:1000) !?? SHORT; %OWNINTEGERARRAY PTR (1:500) %INTEGERARRAY CNT (1:4) ! 00225400 %OWNINTEGER IR=1 ;! POINTER TO RNOS 00225500 %OWNINTEGER RCNT ;! NUMBER OF REPORT NOS 00225700 %OWNINTEGER BLOCK=2 ;! NEXT FREE BLOCK ! 00225800 %INTEGER R1 ;! TEMPORARY REF OR MONTH DIGIT 00225900 %INTEGER R2 ;! TEMPORARY REF OR MONTH DIGIT 00226000 %INTEGER I ;! LOOP VARIABLE 00226100 ! 00226300 ! CHECK FOR LAST ENTRY 00226600 ! 00226700 %IF REF=0 %THEN -> LAST ! 00226900 ! NORMAL ENTRY - ADD REFERENCE NUMBER 00227000 ! 00227100 RCNT=RCNT+1 ;! INCREMENT COUNT 00227200 %IF IR+RL+4>MXBUFR %THENC %START ;! BUFFER FULL %IF IR<=MXBUFR %THEN RNOS(IR)=0 ;! SET END MARKER %IF BLOCK=2 %THEN OPENDA (RPUNIT) WRITEDA (RPUNIT,BLOCK,RNOS(1),RNOS(MXBUFR)) BLOCK=BLOCK+1 IR=1 %FINISH PTR(RCNT)=(BLOCK-2)*MXBUFR+IR RNOS(IR)=RL ;! STORE LENGTH 00227400 COPYTEXT(REP,RS,RNOS,IR+1,RL) ;! STORE REPORT NUMBER 00227500 IR=IR+RL+1 ;! UPDATE POINTER 00227600 R1=REF//10 00227700 RNOS(IR+3)=(REF-R1*10)!X'30' ;! EXTRACT & STORE REF NO R2=R1//10 00227900 RNOS(IR+2)=(R1-R2*10)!X'30' R1=R2//10 RNOS(IR+1)=(R2-R1*10)!X'30' RNOS(IR)=R1!X'30' IR=IR+4 ;! UPDATE POINTER ! 00228300 %RETURN 00228400 ! 00228500 ! LAST ENTRY - MAKE FINAL ENTRIES TO FILE ! 00228700 LAST:%IF RCNT=0 %THEN %RETURN ;! EXIT IF NO ENTRIES %IF BLOCK=2 %THEN OPENDA(RPUNIT) ;! OPEN FILE IF NECESSARY WRITEDA (RPUNIT,BLOCK,RNOS(1),RNOS(MXBUFR)) CNT(3)=BLOCK ;! STORE LAST BLOCK NUMBER BLOCK=BLOCK+1 WRITEDA (RPUNIT,BLOCK,PTR(1),PTR(MXBUFR//2)) CNT(1)=MONTH CNT(2)=RCNT CNT(4)=IR WRITEDA (RPUNIT,ONE,CNT(1),CNT(4)) CLOSEDA (RPUNIT) ! 00234600 %END ;! REPORTLIST 00234700 ! 00234800 ! ********************************************************************* 00234900 ! 00235000 %ROUTINE AUTHORLIST (%INTEGER AUUNIT, %C 00235100 %BYTEINTEGERARRAYNAME AUTH, %C 00235200 %INTEGER AS,AL,REF) 00235300 ! 00235400 %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC WRITEDA (%INTEGER CHANNEL, %C %INTEGERNAME SECT, %C %NAME BEGIN,END) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) ! 00235600 %OWNBYTEINTEGERARRAY AC (1:1000) !?? SHORT; %OWNINTEGERARRAY PTR (1:1000) %INTEGERARRAY CNT (1:4) ! %OWNINTEGER ACNT ;! COUNT OF AUTHOR NAMES 00236300 %OWNINTEGER IA=1 ;! START OF CURRENT AUTH IN AC 00236400 %OWNINTEGER BLOCK=2 ;! NEXT FREE BLOCK ! 00236600 %INTEGER I ;! LOOP VARIABLE 00236700 %INTEGER IC ;! CURRENT PTR TO AC 00236800 %INTEGER IN ;! POINTER TO LENGTH OF INITIALS 00236900 %INTEGER REF1 ;! PART OF REFERENCE NUMBER 00237700 %INTEGER REF2 ;! SECOND PART OF REF NO ! 00237900 ! THIS ROUTINE ENTERS THE AUTHOR NAME IN THE ARRAY AC FROM THE 00238000 ! ARRAY AUTH STARTING AT AUTH(AS) AND OF LENGTH AL. THE SPECIAL 00238100 ! FORMAT BEING:- LENGTH OF SURNAME - SURNAME - LENGTH OF INITIALS - 00238200 ! INITIALS - REFERENCE. 00238300 ! 00238400 ! THE REFERENCE IS STORED IN CHARACTER FORM IN THE FOUR BYTES ! IMMEDIATELY FOLLOWING THE AUTHORS INITIALS. 00238600 ! 00238700 ! THE ARRAY AC IS WRITTEN TO DISC AS IT FILLS, THE LAST ! ENTRY CAUSING THE FINAL BLOCKS TO BE OUTPUT AND THE ! FILE TO BE CLOSED. ! 00239100 %IF REF=0 %THEN -> LAST ;! JUMP IF LAST ENTRY ! 00239300 ! NORMAL ENTRY - ENTER THE AUTHOR NAME SPECIFIED TO THE ARRAY 00239400 ! 00239500 ACNT=ACNT+1 ;! INCREMENT THE AUTHOR COUNT 00239600 %IF IA+AL+5>MXBUFA %THENC %START ;! BUFFER FULL %IF IA<=MXBUFA %THEN AC(IA)=0 ;! SET END MARK %IF BLOCK=2 %THEN OPENDA(AUUNIT);! WRITE TO FILE WRITEDA (AUUNIT,BLOCK,AC(1),AC(MXBUFA)) BLOCK=BLOCK+1 IA=1 %FINISH PTR(ACNT)=(BLOCK-2)*MXBUFA+IA ;! SET POINTER IC=IA+1 ;! INITIALISE AC POINTER 00239800 IN=0 ;! AND INITIALS POSN PTR 00239900 %CYCLE I=1,1,AL ;! CYCLE THROUGH AUTHORNAME SPEC 00240000 %IF AUTH(AS+I-1)=ENDAUT %THENC 00240100 %START ;! END OF SURNAME FOUND 00240200 AC(IA)=I-1 ;! SET LENGTH OF SURNAME 00240300 IN=IC ;! SET INITIALS POINTER 00240400 %FINISH %ELSE AC(IC)=AUTH(AS+I-1) ;! ELSE STORE CHARACTER 00240500 IC=IC+1 ;! INCREMENT POINTER TO AC 00240600 %REPEAT ;! CONTINUE 00240700 ! 00240800 ! END OF AUTHOR REACHED - LENGTH OF INITIAL SECTION MUST BE SET 00240900 ! AND REFERENCE NUMBER CONVERTED AND STORED. 00241000 ! 00241100 %IF IN=0 %THENC 00241200 %START ;! NO INITIALS FOUND 00241300 AC(IA)=AL ;! SET LENGTH OF SURNAME 00241400 AC(IC)=0 ;! SET LENGTH OF INITIALS = 0 00241500 IC=IC+1 ;! UPDATE POINTER 00241600 %FINISH %ELSE AC(IN)=AL-AC(IA)-1 ;! ELSE SET LENGTH OF INITS 00241700 REF1=REF//10 ;! CONVERT THE FOUR AC(IC+3)=(REF-REF1*10)!X'30' ;! FIGURE REFERENCE REF2=REF1//10 ;! NUMBER TO CHARACTER AC(IC+2)=(REF1-REF2*10)!X'30' ;! FORM AND STORE AFTER REF1=REF2//10 ;! THE AUTHOR DETAILS AC(IC+1)=(REF2-REF1*10)!X'30' AC(IC)=REF1!X'30' IA=IC+4 ;! UPDATE ARRAY POINTER ! 00242400 %RETURN 00242500 ! 00242600 ! LAST ENTRY - TERMINATION BLOCKS ARE WRITTEN TO THE FILE ! LAST:%IF ACNT=0 %THEN %RETURN ;! EXIT IF NO ENTRIES %IF BLOCK=2 %THEN OPENDA(AUUNIT) ;! OPEN FILE IF NECESSARY WRITEDA (AUUNIT,BLOCK,AC(1),AC(MXBUFA)) CNT(3)=BLOCK ;! STORE LAST BLOCK NO BLOCK=BLOCK+1 WRITEDA (AUUNIT,BLOCK,PTR(1),PTR(MXBUFA//2)) BLOCK=BLOCK+1 WRITEDA (AUUNIT,BLOCK,PTR(MXBUFA//2+1),PTR(MXBUFA)) CNT(1)=MONTH CNT(2)=ACNT CNT(4)=IA WRITEDA (AUUNIT,ONE,CNT(1),CNT(4)) CLOSEDA (AUUNIT) ! %END ;! AUTHORLIST 00251500 ! %END 00263200 %ENDOFPROGRAM 00263300