%BEGIN %CONTROL 0 ! PROGRAM TO PRODUCE THE WEEKLY BULLETIN OUTPUT FROM A SINGLE ! WEEK'S BULLETIN FILE ONLY. ! %INTEGER BLUNIT ;! BULLETIN I/P LOGICAL UNIT NO %INTEGER BLNK ;! BLANK WORD %INTEGER BLOCK ;! CURRENT BLOCK NUMBER %INTEGER CDTYPE ;! INPUT CARD TYPE 00000750 %INTEGER CHECK ;! CHECKING INDICATOR %INTEGER CNT ;! INPUT CARD COUNT 00000850 %INTEGER DIAGNS ;! DIAGNOSTIC PRINT INDICATOR 00000830 %INTEGER DNUM ;! DIAGNOSTIC PRINT VARIABLE 00000860 %INTEGER ENDAUT ;! AUTHOR S/NAME TERMINATOR %INTEGER I ;! LOOP VARIABLE %INTEGER IC ;! POINTER TO CONCORDANCE %INTEGER IN ;! POINTER TO NUMBER,POINTF %INTEGER J ;! LOOP VARIABLE 00001450 %INTEGER LIM ;! LOOP LIMIT 00001650 %INTEGER LSUNIT ;! LISTING DEVICE LUN %INTEGER MAXC ;! NUMBER OF CONCORDED ITEMS 00001350 %INTEGER MAXN ;! ACTUAL NO OF DIFF JOURN NOS %INTEGER MJUNIT ;! MASTER JOURNAL FILE LUN %INTEGER MXBUFB ;! BULLETIN I/P BUFFER SIZE %INTEGER MXBUFS ;! DIMENSION OF M/JOURN BUFFER %INTEGER MXCNTB ;! SIZE OF BULLETIN CONTROL BUF 00001750 %INTEGER MXCONC ;! NO OF DIFFERENT ITEMS %INTEGER MXDIRC ;! SIZE OF RECORD DIRECTORY %INTEGER MXLINE ;! MAX LENGTH OF O/P LINE %INTEGER MXNUM ;! NO OF JOURNALS IN CURRENT WEEK %INTEGER MXNUMB ;! NO OF DIFFERENT JOURN NOS %INTEGER MXTEXT ;! SIZE OF RECORD TEXT %INTEGER MXTITL ;! MAX SIZE OF JOURNAL TITLE %INTEGER MXWDS ;! MAX NO OF ITEMS OF ANALYSIS %INTEGER NJNO ;! NUMBER OF NEW JOURNALS %INTEGER NL ;! NEWLINE SYMBOL %INTEGER NO ;! DATA VALUE OR RDBUL INDICATOR 00003700 %INTEGER NW ;! NUMBER OF O/P TERMS %INTEGER ONE ;! CONSTANT %INTEGER OPUNIT ;! BULLETIN O/P LOGICAL UNIT NO %INTEGER PA ;! POINTER TO AUTHOR DETAILS 00003950 %INTEGER PB ;! PROFILE POSN OF BIB DETS %INTEGER PD ;! POINTER TO END OF LANGS 00004010 %INTEGER PN ;! POINTER TO EXTRA NOTE 00004020 %INTEGER POSN ;! POSITION WITHIN BLOCK %INTEGER PR ;! POINTER TO CULHAM REF NO 00004350 %INTEGER PT ;! POINTER TO TITLE DETAILS 00004030 %INTEGER PX ;! POINTER TO SPECIAL JOURN TITL 00004500 %INTEGER RS ;! RECORD SEPARATOR CHARACTER %INTEGER WEEKNO ;! WEEK NUMBER %INTEGER YES ;! CONSTANT ! 00004120 %BYTEINTEGER SMA ;! LOWER CASE A 00004140 %BYTEINTEGER SMC ;! LOWER CASE C 00004160 %BYTEINTEGER SMZ ;! LOWER CASE Z 00004180 ! 00004510 %BYTEINTEGERARRAY CARD(1:80) ;! CONTROL CARD I/P AREA 00004520 ! 00004520 %SWITCH TEST (1:3) ;! SWITCH FOR CHECKING I/P CARDS 00004540 %SWITCH EXIT (1:3) ;! EXIT SWITCH FROM CHECKING CDS 00004560 ! ! THE CONTROL AND DIMENSION VARIABLES ARE SET IN THIS OUTER BLOCK ! MXBUFB=1000 ;! BULLETIN BUFFER SIZE (BYTES) 00005600 MXBUFS=1000 ;! MASTER JOURNAL BUFFER SIZE 00005700 MXCNTB=500 ;! BULLETIN CONTROL BUFFER SIZE 00005800 MXCONC=500 ;! NO OF DIFFERENT ITEMS MXDIRC=32 ;! SIZE OF DIRECTORY MXNUM=200 ;! NO OF JOURNS IN CURRENT WEEK MXNUMB=1024 ;! MAX SIZE OF JOURN NO ARRAYS MXTEXT=500 ;! MAX SIZE OF TEXT ARRAY MXTITL=500 MXWDS=100 ;! MAX NO OF ITEMS OF ANALYSIS ! BLUNIT=10 ;! LUN BULLETIN I/P LSUNIT=99 ;! LUN LISTING UNIT 00006800 MJUNIT=30 ;! LUN MASTER JOURNAL FILE OPUNIT=20 ;! LUN BULLETIN O/P ! BLNK=M' ' ;! BLANK WORD MAXC=0 ;! SET ITEM COUNT TO ZERO 00005660 ENDAUT=',' ;! END AUTHOR SURNAME IND 00005700 NL=X'0A' ;! SET NEWLINE SYMBOL ONE=1 ;! SET CONSTANT PA=5 ;! SET AUTHOR PTR 00007650 PB=7 ;! PROFILE POSN OF BIB DETS PD=10 ;! SET END OF LANG PTR 00007710 PN=8 ;! SET EXTRA NOTE POINTER 00007720 PR=2 ;! SET PTR TO CULHAM REF NO 00008450 PT=4 ;! SET TITLE POINTER 00007730 PX=11 ;! SET PTR TO SPECIAL TITLES 00008550 RS='/' ;! REC SEP CHAR - NEW JOURN I/P 00006050 SMA=X'61' ;! LOWER CASE A 00006925 SMC=X'63' ;! LOWER CASE C 00006950 SMZ=X'7A' ;! LOWER CASE Z 00006975 YES=1 ;! CONSTANT ! ! ! SET DEFAULT VALUES ! CHECK=1 ;! CHECK WEEK NUMBER AGREES DIAGNS=0 ;! NO DIAGNOSTIC PRINTING MXLINE=46 ;! SET STANDARD LINE WIDTH 00010400 WEEKNO=0 ;! ZEROISE WEEK NUMBER NJNO=0 ;! ZEROISE NO OF NEW JOURN TITLES ! ! READ IN DATA CARDS ! CNT=0 ;! ZEROISE RECORD COUNT NEWLINE PRINTSTRING('DATA CARDS') NXTCD:NEWLINE %CYCLE I=1,1,80 READ SYMBOL (CARD(I)) ;! READ NEXT DATA CARD %IF CARD(I)=X'0A' %THEN -> SET ;! JUMP WHEN NEWLINE FOUND PRINT SYMBOL (CARD(I)) ;! PRINT FOR REFERENCE %REPEAT ! ! CARD READ IN - SEARCH FOR ITEMS TO BE EXTRACTED ! SET: LIM=I-1 ;! STORE NUMBER OF CHARS CNT=CNT+1 ;! INCREMENT DATA CARD COUNT J=1 ;! INITIALISE SWITCH VALUE ! %CYCLE I=1,1,LIM ;! CYCLE THRO CARD -> TEST(J) ! TEST(1):%IF CARD(I)\=' ' %THENC %START ;! START OF DATA FOUND J=2 ;! UPDATE SWITCH CDTYPE=CARD(I) ;! EXTRACT CARD TYPE %IF CDTYPE='W' %OR CDTYPE='N' %OR CDTYPE='M' %THEN -> REP -> EXIT(3) %FINISH -> REP ;! CONTINUE ! TEST(2):%IF '0' <= CARD(I) <= '9' %THENC %START ;! START OF NUMERIC ITEM FOUND J=3 ;! UPDATE SWITCH POINTER NO=CARD(I)&X'0F' ;! EXTRACT FIRST VALUE %FINISH -> REP ;! CONTINUE ! TEST(3):%IF '0'<=CARD(I)<='9' %THENC NO=NO*10+CARD(I)&X'0F' %ELSEC -> EXIT(3) ;! EXIT AT END OF NUMBER REP: %REPEAT ;! CONTINUE CHECKING RECORD ! ! RECORD NOW COMPLETELY CHECKED - JUMP TO APPROPRIATE EXIT POINT ! -> EXIT(J) ! ! ERROR SECTION - THE CONTROL DATA CARD IS INVALID, A WARNING ! MESSAGE IS PRINTED AND THE JOB CONTINUES. ! EXIT(1):NEWLINE PRINTSTRING(' *** WARNING *** NO VALID CHARACTERS FOUND') -> ERR ! EXIT(2):NEWLINES(2) PRINTSTRING(' *** WARNING *** NUMERIC ITEM EXPECTED BUT NOT FOUND') ERR: PRINTSTRING(' ON CONTROL DATA CARD') WRITE (CNT,2) PRINTSTRING(' - IGNORED') NEWLINE -> NXTCD ;! JUMP TO CONTINUE ! ! THE NUMERIC ITEM IS TRANSFERRED TO THE APPROPRIATE VARIABLE ! EXIT(3):%IF CDTYPE='E' %THEN -> RETN ;! JUMP OUT IF END OF DATA %IF CDTYPE='W' %THEN %START; WEEKNO=NO; -> NXTCD; %FINISH %IF CDTYPE='C' %THEN %START; CHECK=YES; -> NXTCD; %FINISH %IF CDTYPE='N' %THEN %START; NJNO=NO; -> NXTCD; %FINISH %IF CDTYPE='D' %THEN %START;DIAGNS=YES; -> NXTCD; %FINISH %IF CDTYPE='M' %THEN %START; MXLINE=NO; -> NXTCD; %FINISH ! ! INVALID CODE - O/P ERROR MESSAGE AND IGNORE ! NEWLINES(2) PRINTSTRING(' *** WARNING *** INVALID CARD TYPE') -> ERR ! ! END OF CONTROL DATA CARDS FOUND - PRINT DETAILS AND EXIT ! RETN:NEWPAGE SPACES(10) ;! MAIN HEADING PRINTSTRING('BULLETIN OUTPUT CHECK LIST') SPACES(11) PRINTSTRING('WEEK') WRITE(WEEKNO,4) ;! PRINT WEEK AND RUN NUMBER NEWLINE SPACES(10) ;! UNDERLINE %CYCLE I=1,1,49 PRINTSTRING("*") %REPEAT NEWLINES(2) SPACES(20) ;! CHECK VALUE PRINTSTRING('FILE IDENTIFIER CHECKING') %IF CHECK\=YES %THEN PRINTSTRING(' NOT') PRINTSTRING(' REQUIRED') NEWLINE SPACES(20) ;! DIAGNS VALUE PRINTSTRING('DIAGNOSTIC PRINTING') %IF DIAGNS\=YES %THEN PRINTSTRING(' NOT') PRINTSTRING(' REQUIRED') NEWLINE SPACES(19) ;! NO OF NEW JOURN TITLES %IF NJNO=0 %THEN PRINTSTRING(' NO') %ELSE WRITE(NJNO,2) PRINTSTRING(' NEW JOURNAL TITLES') NEWLINE SPACES(20) ;! LINE WIDTH PRINTSTRING('OUTPUT LINE WIDTH:') WRITE(MXLINE,2) PRINTSTRING(' CHARACTERS') ! 00020000 %BEGIN ! 00009750 ! ARRAYS ARE SET UP IN THIS SECONDARY BLOCK FOR EASE OF ALTERING ! THEIR DIMENSIONS AS AND WHEN REQUIRED. ! %ROUTINESPEC RDBUL (%INTEGERNAME UNIT,BLOCK,POSN,NO) %ROUTINESPEC OUTPUT TITLE (%INTEGER JNUM) %ROUTINESPEC OUTPUT ITEM (%INTEGER JNUM) %ROUTINESPEC CREATELINE (%BYTEINTEGERARRAYNAME OPLINE,DATA, %C %INTEGER START,MXLINE,TNW, %C %INTEGERNAME LENGOP,END) %ROUTINESPEC COPYTEXT (%BYTEINTEGERARRAYNAME FROM, %INTEGER FRST, %C %BYTEINTEGERARRAYNAME TO,%INTEGER TOST,LENG) %ROUTINESPEC WRBOP(%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C %INTEGER PARM,IND) %ROUTINESPEC WRLST (%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C %INTEGER LENG,IND) %ROUTINESPEC MARKWORDS (%BYTEINTEGERARRAYNAME ARR, %C %INTEGER ST,MAX, %INTEGERNAME NW) %ROUTINESPEC MARKWORD (%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C %INTEGERNAME ST,LN,SP,IA) %ROUTINESPEC SET (%BYTEINTEGERARRAYNAME A,%INTEGER START,END,VAL) %ROUTINESPEC SORT (%INTEGERARRAYNAME AX,PTR, %INTEGER P1,P2,N) ! %INTEGERARRAY NUMBER(1:MXNUM) ;! JOURNAL NUMBERS %INTEGERARRAY NPTR(1:MXNUM) ;! POINTERS TO JOURN NOS %INTEGERARRAY MJNUMB(1:MXNUMB) ;! MASTER JOURNAL NUMBERS !?? SHORT; %INTEGERARRAY POINTF(1:MXNUM) ;! POINTER TO 1ST CONC ENTRY !?? SHORT; %INTEGERARRAY POINTL(1:MXNUM) ;! POINTER TO LAST CONC ENTRY !?? SHORT; %INTEGERARRAY CONC1(1:MXCONC) ;! BLOCK POINTER !?? SHORT; %INTEGERARRAY CONC2(1:MXCONC) ;! POSITION POINTER !?? SHORT; %INTEGERARRAY CONC3(1:MXCONC) ;! POINTER TO NEXT CONCORDANCE !?? SHORT; %INTEGERARRAY WBGN(1:MXWDS) ;! START OF ITEM IN TEXT !?? SHORT; %INTEGERARRAY WLNG(1:MXWDS) ;! LENGTH OF ITEM IN TEXT 00023300 !?? SHORT; %INTEGERARRAY WSPS(1:MXWDS) ;! NUMBER OF FOLLOWING SPACES !?? SHORT; %INTEGERARRAY MJBPTR(1:MXNUMB) ;! M/JOURN BLOCK POINTERS !?? SHORT; %INTEGERARRAY MJPPTR(1:MXNUMB) ;! M/JOURN POSN POINTERS !?? SHORT; %INTEGERARRAY IRDIRC(1:MXDIRC);! DIRECTORY TO INTERNAL RECORD %BYTEINTEGERARRAY IRTEXT(1:MXTEXT) ;! TEXT OF INTERNAL RECORD %BYTEINTEGERARRAY OPLINE(1:MXLINE) ;! O/P BUFFER AREA ! ! THE INDICATOR IS SET TO 1 TO OPEN THE BULLETIN FILE AND SET UP 00011200 ! THE CONTROL DATA. THE WEEK NUMBER IS CHECKED IF REQUIRED. ! NO=1 ;! FIRST ENTRY RDBUL(BLUNIT,BLOCK,POSN,NO) NO=2 ;! CHANGE ENTRY SWITCH ! ! THE POINTER ARRAY IS INITIALISED ! %CYCLE I=1,1,MAXN NPTR(I)=I %REPEAT ! ! THE POINTER IS THEN SORTED BY ASCENDING ORDER OF NUMBER. ! SORT(NUMBER,NPTR,1,MAXN,1) %IF DIAGNS=YES %THENC %START ;! PRINT NUMBERS AND CONCORDANCE NEWLINES(5) ;! ............................. SPACES(5) ;! ............................. PRINTSTRING('JOURNAL NUMBERS') ;! .......................... 00026100 SPACES(6) ;! ............................. PRINTSTRING('CONC') ;! .......................... 00026300 NEWLINE ;! ............................. SPACES(3) ;! ............................. PRINTSTRING('ON I/P') ;! .......................... 00026600 SPACES(8) ;! ............................. PRINTSTRING('SORTED') ;! .......................... 00026800 SPACES(4) ;! ............................. PRINTSTRING('PTRS') ;! .......................... 00027000 NEWLINE ;! ............................. MAXC=0 ;! ............................. %CYCLE J=1,1,MAXN ;! ............................. 00027300 NEWLINE ;! ............................. SPACES(2) ;! ............................. PRINT SYMBOL(NUMBER(J)>>24&X'FF') DNUM=NUMBER(J)&X'FFFFFF' ;! ............................. WRITE(DNUM,7) ;! ............................. SPACES(5) ;! ............................. DNUM=NUMBER(NPTR(J)) ;! ............................. PRINT SYMBOL(DNUM>>24&X'FF') ;! ............................. DNUM=DNUM&X'FFFFFF' ;! ............................. 00016700 WRITE(DNUM,7) ;! ............................. WRITE(POINTF(NPTR(J)),5) ;! ............................. %IF POINTL(NPTR(J))>MAXC %THEN MAXC=POINTL(NPTR(J)) %REPEAT ;! ............................. NEWLINES(3) ;! ............................. SPACES(10) ;! ............................. PRINTSTRING('CONCORDANCE') ;! .......................... NEWLINE ;! ............................. SPACES(6) ;! ............................. PRINTSTRING('BLOCK POSN NEXT');! .......................... NEWLINE ;! ............................. %CYCLE J=1,1,MAXC ;! ............................. NEWLINE ;! ............................. WRITE(J,3) ;! ............................. WRITE(CONC1(J),5) ;! ............................. WRITE(CONC2(J),6) ;! ............................. WRITE(CONC3(J),5) ;! ............................. %REPEAT ;! ............................. %FINISH ;! ............................. ! ! THE ENTRIES ARE NOW PROCESSED IN ASCENDING NUMERICAL ORDER. FOR ! EACH JOURNAL NUMBER A TITLE IS OUTPUT FOLLOWED BY THE ITEMS. ! %CYCLE I=1,1,MAXN IN=NPTR(I) ;! SET POINTER TO NUMBER IC=POINTF(IN) ;! SET FIRST CONCORDANCE PTR BLOCK=CONC1(IC) ;! SET NUMBER OF 1ST BLOCK POSN =CONC2(IC) ;! SET POSN WITHIN THAT BLOCK RDBUL(BLUNIT,BLOCK,POSN,NO) ;! READ FIRST RECORD 00013650 OUTPUT TITLE (NUMBER(IN)) ;! OUTPUT TITLE FOR THESE RECS NEXT:%IF DIAGNS=YES %THENC %START ;! PRINT OF CURRENT RECORD NEWLINES(2) ;! ............................. PRINTSTRING('BLOCK =') ;! .......................... WRITE(BLOCK,3) ;! ............................. PRINTSTRING(' POSN =') ;! .......................... WRITE(POSN,3) ;! ............................. SPACES(10) ;! ............................. %CYCLE J=1,2,IRDIRC(1)-1 ;! ............................. WRITE(IRDIRC(J),3) ;! ............................. WRITE(IRDIRC(J+1),3) ;! ............................. PRINTSTRING(' //') ;! .......................... %REPEAT ;! ............................. NEWLINE ;! ............................. %CYCLE J=1,1,IRDIRC(2) ;! ............................. %IF IRTEXT(J)<' ' %THEN WRITE(IRTEXT(J),2) %ELSEC 00033700 PRINT SYMBOL(IRTEXT(J)) 00033800 %REPEAT ;! ............................. NEWLINE ;! ............................. 00033850 %FINISH ;! ............................. OUTPUT ITEM (NUMBER(IN)) ;! O/P RECORD DETAILS 00013800 IC=CONC3(IC) ;! EXTRACT NEXT CONC POINTER %IF IC\=0 %THENC %START ;! FURTHER RECS UNDER THIS JOURN BLOCK=CONC1(IC) ;! SET NEXT BLOCK POINTER POSN =CONC2(IC) ;! SET NEXT POSITION POINTER RDBUL(BLUNIT,BLOCK,POSN,NO) ;! READ RECORD FROM FILE -> NEXT ;! JUMP TO O/P %FINISH %REPEAT ! ! WHEN ALL JOURNALS HAVE BEEN PROCESSED THE FILE HANDLING ROUTINES ! ARE CALLED TO CLOSE THE FILES AND TIDY UP AS NECESSARY. ! NO=3 ;! SET INDICATOR 00024300 RDBUL(BLUNIT,BLOCK,POSN,NO) OUTPUT TITLE (0) ;! FINAL CALL TO CLOSE FILES 00025200 %STOP ;! END OF JOB 00025300 ! ! ********************************************************************* ! %ROUTINE RDBUL (%INTEGERNAME UNIT,BLOCK,POSN,NO) ! ! THE ROUTINE HAS EFFECTIVELY THREE ENTRYPOINTS DEPENDING ON THE ! VALUE OF NO WHICH MAY BE 1,2 OR 3. ! ! NO=1 FIRST ENTRY - THE DISC FILE (UNIT) IS OPENED AND THE CONTROL ! BLOCK READ. THE APPROPRIATE BLOCKS ARE THEN READ IN AND THE ! POINTER TABLES SET UP. CONTROL IS THEN RETURNED. ! ! NO=2 NORMAL ENTRY - THE RECORD COMMENCING AT BYTE (POSN) IN ! SECTOR (BLOCK) IS READ FROM THE DISC FILE AND TRANSFERRED ! TO THE DIRECTORY AND TEXT ARRAYS. ! ! NO=3 WHEN PROCESSING IS COMPLETE THE PROGRAM MUST CALL RDBUL ! WITH NO=3 TO CLOSE THE DISC FILE. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA(%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL, %C %INTEGERNAME SECT, %C %NAME BEGIN,END) ! %OWNBYTEINTEGERARRAY BUF(1:1000) ;! INPUT BUFFER 00037500 !?? SHORT; %INTEGERARRAY CNTBUF(1:500) ;! CONTROL AREA BUFFER 00037600 ! %SWITCH ENTRY(1:3) ;! ENTRYPOINT SWITCH %OWNINTEGER SECT ;! SECTOR CURRENTLY IN BUFFER ! %INTEGER CSEC ;! CONCORDANCE START SECTOR 00038050 %INTEGER I ;! LOOP VARIABLE 00038100 %INTEGER IB ;! BUFFER POINTER 00038102 %INTEGER IC ;! LENGTH OF CONCORDANCE 00038104 %INTEGER IN ;! LENGTH OF POINTER TABLES 00038106 %INTEGER J ;! LOOP VARIABLE 00038110 %INTEGER K ;! LOOP VARIABLE 00038120 %INTEGER NSEC ;! PTR TABLES START SECTOR 00038200 ! ! JUMP TO APPROPRIATE ENTRY POINT ! -> ENTRY(NO) ! ! FIRST ENTRY - OPEN FILE, CHECK WEEK NUMBER IF REQUIRED ! AND SET UP THE CONTROL TABLES. ! ENTRY(1):OPENDA(UNIT) ;! OPEN FILE SECT=1 ;! READ CONTROL BLOCK READDA(UNIT,SECT,CNTBUF(1),CNTBUF(MXCNTB)) %IF CHECK=YES %THENC %START ;! CHECK WEEK NUMBER %IF WEEKNO\=CNTBUF(1) %THENC %START ;! WEEK NUMBER FAILS TO AGREE NEWLINE ;! PRINT MESSAGE PRINTSTRING('WEEK NUMBERS DO NOT AGREE') NEWLINE PRINTSTRING('WEEK') ;! PRINT DETAILS WRITE(WEEKNO,4) PRINTSTRING(' REQUESTED') NEWLINE PRINTSTRING('WEEK') WRITE(CNTBUF(1),4) PRINTSTRING(' IN THIS FILE') NEWLINES(2) ;! TERMINATE JOB PRINTSTRING('*** JOB TERMINATED ***') %STOP %FINISH %FINISH %ELSEC WEEKNO=CNTBUF(1) ;! SET WEEK NUMBER ! ! SET CONTROL VARIABLES FROM CONTROL BLOCK. ! IN=CNTBUF(2) ;! LENGTH OF POINTER TABLE NSEC=CNTBUF(3) ;! START SECTOR OF TABLES IC=CNTBUF(4) ;! LENGTH OF CONCORDANCE CSEC=CNTBUF(5) ;! START SECTOR OF CONCORDANCES ! ! READ POINTER TABLES FROM DISC - THEY MAY BE IN ONE SECTOR OR ! SEVERAL DEPENDING ON THE TOTAL NUMBER OF DIFFERENT JOURNALS. ! %IF 8*IN<=MXBUFB %THENC %START ;! POINTERS IN SINGLE SECTOR READDA(UNIT,NSEC,CNTBUF(1),CNTBUF(MXCNTB)) J=IN+IN ;! START OF POINTER 1 K=J+IN ;! START OF POINTER 2 %CYCLE I=1,1,IN NUMBER(I)=INTEGER(ADDR(CNTBUF(I+I-1))) POINTF(I)=CNTBUF(J+I) POINTL(I)=CNTBUF(K+I) %REPEAT %FINISH %ELSEC %START ;! POINTERS IN SEVERAL SECTORS READDA(UNIT,NSEC,NUMBER(1),NUMBER(IN)) NSEC=NSEC+1 READDA(UNIT,NSEC,POINTF(1),POINTF(IN)) NSEC=NSEC+1 READDA(UNIT,NSEC,POINTL(1),POINTL(IN)) %FINISH ! ! SET MAXIMUM NUMBER OF JOURNALS AND READ CONCORDANCE ARRAYS ! MAXN=IN 00045600 READDA(UNIT,CSEC,CONC1(1),CONC1(IC)) CSEC=CSEC+1 READDA(UNIT,CSEC,CONC2(1),CONC2(IC)) CSEC=CSEC+1 READDA(UNIT,CSEC,CONC3(1),CONC3(IC)) %RETURN ! ! NORMAL ENTRY - THE BLOCK NUMBER REQUESTED IS CHECKED AGAINST THE ! NUMBER OF THE SECTOR CURRENTLY IN THE BUFFER TO AVOID UNNECESSARY ! READING FROM THE DISC. ! ENTRY(2):%IF BLOCK\=SECT %THENC %START ;! DISC READ NECESSARY SECT=BLOCK ;! SET SECTOR NUMBER READDA(UNIT,SECT,BUF(1),BUF(MXBUFB)) %FINISH ! ! TRANSFER DATA FROM THE BUFFER TO THE INTERNAL RECORD. ! IB=POSN ;! SET BUFFER POINTER ! DIRC:%CYCLE I=1,1,MXDIRC ;! TRANSFER DIRECTORY SECTION IRDIRC(I)=INTEGER(ADDR(BUF(IB))); !?? WAS SHORTINTEGDR IB=IB+2 ;! UPDATE BUFFER POINTER %IF IB>MXBUFB %THENC %START ;! END OF BUFFER REACHED SECT=SECT+1 ;! UPDATE CURRENT SECTOR NUMBER READDA(UNIT,SECT,BUF(1),BUF(MXBUFB)) IB=1 ;! RESET BUFFER POINTER %FINISH %REPEAT ! TEXT:%CYCLE I=1,1,IRDIRC(2) ;! TRANSFER TO TEXT ARRAY 00050300 IRTEXT(I)=BUF(IB) IB=IB+1 ;! UPDATE BUFFER POINTER %IF IB>MXBUFB %THENC %START ;! END OF BUFFER REACHED SECT=SECT+1 ;! UPDATE CURRENT SECTOR NUMBER READDA(UNIT,SECT,BUF(1),BUF(MXBUFB)) IB=1 ;! RESET BUFFER POINTER %FINISH %REPEAT ! %RETURN ! ! THE LAST ENTRY CLOSES THE FILE ENTRY(3):CLOSEDA(UNIT) %END ;! RDBUL ! ! ********************************************************************* ! %ROUTINE OUTPUT TITLE (%INTEGER JNUM) ! ! THIS ROUTINE OUTPUTS THE APPROPRIATE TITLE FOR THE JOURNAL ! NUMBER JNUM TOGETHER WITH ANY MAIN OR SUB-HEADINGS REQUIRED. ! %ROUTINESPEC RDMJN(%INTEGER UNIT, %INTEGERNAME BLOCK,POS, %INTEGER IND) ! %OWNBYTEINTEGERARRAY HDJRN(1:8)='J','O','U','R','N','A','L','S' %OWNBYTEINTEGERARRAY ZHD(1:10)=1,9,19,25,40,47,0,0,0,0 00052700 %OWNBYTEINTEGERARRAY ZHEAD(1:63)=7,'R','E','P','O','R','T','S', 00052800 9,'P','A','M','P','H','L','E','T','S', 5,'B','O','O','K','S', 14,'A','N','N','U','A','L',' ','R','E','P', 'O','R','T','S', 00053200 6,'T','H','E','S','E','S', 00053225 16,'T','R','A','D','E',' ','C','A','T','A', 00053250 'L','O','G','U','E','S' 00053275 %OWNBYTEINTEGERARRAY VIP(1:13)=4,X'76',X'6F',X'6C',X'2E',3,X'6E', 00053300 X'6F',X'2E',3,X'70',X'74',X'2E' 00053400 %OWNBYTEINTEGERARRAY NONAM(1:18)='*',' ','T','I','T','L','E',' ', 'N','O','T',' ','F','O','U','N', 'D',' ' ! %BYTEINTEGERARRAY OPLINE(1:MXLINE) ;! O/P AREA %BYTEINTEGERARRAY JNTITL(1:MXTITL) ;! JOURNAL TITLE TEXT ! %INTEGER END ;! END OF O/P INDICATOR %INTEGER I ;! LOOP VARIABLE %INTEGER ID ;! DIRECTORY POINTER 00042110 %INTEGER INCT ;! LENGTH OF CURRENT ITEM 00042120 %INTEGER IT ;! TEXT POINTER 00042130 %INTEGER J ;! LOOP VARIABLE %INTEGER K ;! LOOP VARIABLE %INTEGER L ;! FIELD LIMIT 00054850 %INTEGER LENGOP ;! LENGTH OF O/P LINE %INTEGER LIM ;! LOOP LIMIT %INTEGER MJBL ;! BLOCK POINTER FOR M.JRN FILE %INTEGER MJPS ;! POSN POINTER FOR M.JRN FILE %INTEGER NINC ;! BINARY SEARCH INCREMENT %INTEGER NVAL ;! BINARY SEARCH POINTER %INTEGER PV ;! VOLUME NUMBER POINTER %INTEGER RNUM ;! ROOT OF JOURNAL NUMBER %INTEGER SECT ;! CURRENT SECTION OF BULLETIN %INTEGER TLENG ;! LENGTH OF TITLE TEXT %INTEGER ZTP ;! CURRENT TYPE IN Z SECTION ! %OWNINTEGER SECTS ;! LAST SECTION NUMBER %OWNINTEGER ENTNO=1 ;! ENTRY NUMBER %OWNINTEGER MP ;! MID POINT OF MJNUMB %OWNINTEGER ZTPS ;! LAST VALUE OF ZTP ! %SWITCH ENTRY(1:3) ;! ENTRY SWITCH ! ! CHECK FOR LAST ENTRY ! %IF JNUM=0 %THEN ENTNO=3 -> ENTRY(ENTNO) ! ! FIRST ENTRY: THE JOURNAL NUMBER AND POINTER ARRAYS ARE SET ! UP FROM THE MASTER JOURNAL FILE AND MAIN HEADINGS ARE OUTPUT. ! ENTRY(1):RDMJN(MJUNIT,MJBL,MJPS,1) ;! SET UP ARRAYS MP=MXNUMB//2 ;! CALC MID-POINT OF ARRAY LENGOP=0 ;! ZEROISE LENGTH WRBOP(OPUNIT,OPLINE,LENGOP,1) ;! WRITE HEADINGS TO THE WRLST(LSUNIT,OPLINE,LENGOP,1) ;! OUTPUT FILES AND CHANGE ENTNO=2 ;! THE ENTRY SWITCH VARIABLE ! ! NORMAL ENTRY: THE NEW JOURNAL TITLE IS OUTPUT WITH ANY ! APPROPRIATE MAIN OR SUBHEADINGS ! ENTRY(2):RNUM=(JNUM&X'FFFFFF')//10 ;! EXTRACT ROOT NUMBER SECT=JNUM>>24&X'FF' ;! EXTRACT SECTION CODE %IF SECT='Z' %THEN -> ZSECT ;! PROCESS Z SECTN SEPARATELY %IF SECT\=SECTS %THENC %START ;! CHANGE OF SECTION %IF SECTS=0 %THEN WRLST(LSUNIT,HDJRN,8,2) WRBOP(OPUNIT,OPLINE,SECT,3) ;! O/P SECTION HEADINGS WRLST(LSUNIT,OPLINE,SECT,3) SECTS=SECT ;! STORE NEW SECTION CODE %FINISH %ELSEC 00047000 %START ;! SAME SECTION - BLANK LINE SET(OPLINE,1,MXLINE,BLNK) ;! ENSURE O/P AREA CLEAR WRLST(LSUNIT,OPLINE,MXLINE,5) ;! OUTPUT BLANK LINE %FINISH OPLINE(1)=' ' ;! SET SINGLE CHARACTER 00058950 WRBOP(OPUNIT,OPLINE,1,4) ;! O/P LINE FEED TO BULLETIN 00048550 %IF DIAGNS=YES %THENC %START ;! PRINT CURRENT NUMBER NEWLINES(2) ;! ............................. PRINT SYMBOL(SECT) ;! ............................. WRITE(JNUM&X'FFFFFF',7) ;! ............................. NEWLINE ;! ............................. PRINTSTRING('---------') ;! ............................. %FINISH ;! ............................. %IF RNUM<999000 %THEN -> PJRN ;! JUMP FOR PERMANENT TITLE ! ! PSEUDO-JOURNAL INPUT - TITLE AND BIBLIOGRAPHIC DETAILS MUST ALL ! BE EXTRACTED FROM THE INTERNAL RECORD. ! IT=IRDIRC(2*PX+1) ;! SET START AND 00061000 TLENG=IRDIRC(2*PX+2) ;! LENGTH OF SPECIAL TITLE 00061100 NW=1 ;! INITIALISE WORD COUNT MARKWORDS(IRTEXT,IT,IT+TLENG-1,NW);! MARK TITLE CONTENTS 00048600 CROL:CREATELINE(OPLINE,IRTEXT,1,MXLINE,NW-1,LENGOP,END) WRBOP(OPUNIT,OPLINE,LENGOP,-4) ;! OUTPUT TO BULLETIN WRLST(LSUNIT,OPLINE,LENGOP,4) ;! AND LISTING DEVICE SET(OPLINE,1,LENGOP,BLNK) ;! CLEAR O/P AREA -> CROL %UNLESS END=YES 00062950 %IF RNUM<999020 %THEN -> PVOL ;! JUMP IF TEMP-JOURN ! ! BIBLIOGRAPHIC DETAILS ARE EXTRACTED FROM THE INTERNAL RECORD ! EXCLUDING THE FIRST (JOURNAL NUMBER) AND LAST (PAGINATION) ITEMS. ! NW=1 ;! INITIALISE WORD COUNT ID=2*PB+1 ;! INITIALISE DIRECTORY 00060900 IT=IRDIRC(ID)+IRDIRC(ID+1)+1 ;! AND TEXT POINTERS NEWI:INCT=IRTEXT(IT-1) ;! SET LENGTH OF NEXT ITEM %IF IRTEXT(IT+INCT)=0 %THEN -> OPTL ;! EXIT IF LAST ITEM REACHED ! ! WHERE POSSIBLE AN ITEM IS TREATED AS A SINGLE ENTITY BUT IF ! NECESSARY A LARGE ITEM IS PROCESSED WORD BY WORD ! %IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC00061700 %START WBGN(NW)=IT ;! SET START AND LENGTH WLNG(NW)=INCT ;! OF ITEM 00063900 NW=NW+1 ;! INCREMENT POINTER %FINISH WSPS(NW-1)=2 ;! DOUBLE SPACE AT END 00064250 IT=IT+INCT+1 ;! UPDATE TEXT POINTER -> NEWI ;! JUMP TO PROCESS NEXT ITEM ! OPTL:NW=NW-1 ;! ADJUST WORD TOTAL %IF NW<=0 %THEN %RETURN ;! EXIT IF NO MORE ITEMS CRBL:CREATELINE(OPLINE,IRTEXT,1,MXLINE,NW,LENGOP,END) WRBOP(OPUNIT,OPLINE,LENGOP,-4) ;! OUTPUT TO BULLETIN WRLST(LSUNIT,OPLINE,LENGOP,4) ;! AND LISTING DEVICE SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR OUTPUT AREA 00051850 -> CRBL %UNLESS END=YES CRND:WRLST(LSUNIT,OPLINE,MXLINE,4) ;! O/P SPACING LINE SET (OPLINE,1,MXLINE,0) ;! ZEROISE O/P AREA AND 00051970 WRBOP (OPUNIT,OPLINE,20,4) ;! OUTPUT 2" BLANK TAPE 00053000 %RETURN ;! EXIT WHEN OUTPUT COMPLETE ! ! PERMANENT JOURNAL INPUT - A BINARY SEARCH IS CARRIED OUT ON THE 00052200 ! MASTER JOURNAL TITLE FILE INDEX TO FIND THE TITLE REQUIRED. 00052250 ! PJRN:NVAL=MP ;! SET START VALUE AND 00047400 NINC=NVAL ;! INITIAL INCREMENT COMP:%IF RNUM=MJNUMB(NVAL) %THEN -> GOTIT ;! JUMP IF TITLE FOUND NINC=NINC//2 ;! HALVE INCREMENT %IF NINC<1 %THEN -> MSNG ;! CHECK FOR END OF SEARCH %IF RNUM>MJNUMB(NVAL) %THEN NVAL=NVAL+NINC %C %ELSE NVAL=NVAL-NINC -> COMP ;! COMPARE NEXT VALUE ! ! WHEN AN EQUAL COMPARE HAS NEEN FOUND THE CORRESPONDING TITLE ! IS READ FROM THE MASTER FILE AND OUTPUT. ! GOTIT:MJBL=MJBPTR(NVAL) ;! SET THE BLOCK AND MJPS=MJPPTR(NVAL) ;! POSITION POINTERS RDMJN(MJUNIT,MJBL,MJPS,2) ;! FETCH THE TITLE ! ! OUTPUT IS NOW CREATED A LINE AT A TIME, THE VALUE OF END BEING 00048900 ! SET TO ONE WHEN THE END OF THE RECORD HAS BEEN REACHED. 00049000 ! NW=1 MARKWORDS(JNTITL,1,TLENG,NW) CROPL:CREATELINE(OPLINE,JNTITL,1,MXLINE,NW-1,LENGOP,END) WRBOP(OPUNIT,OPLINE,LENGOP,-4) ;! WRITE CURRENT LINE 00049600 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! TO OUTPUT FILES SET (OPLINE,1,LENGOP,BLNK) ;! CLEAR O/P AREA 00041050 -> CROPL %UNLESS END=YES ;! CONTINUE TO END OF TITLE 00041100 ! ! THE VOLUME,ISSUE AND PART NUMBERS OF A JOURNAL FOLLOW THE TITLE ! PVOL:PV=IRDIRC(2*PB+1)+IRDIRC(2*PB+2) ;! CALCULATE POSITION LIM=IRTEXT(PV)+PV ;! SET LENGTH OF ITEM J=1 ;! INITIALISE PTR TO VIP K=-1 ;! AND O/P AREA I=PV+1 ;! SET PTR TO FIRST TEXT CHAR ! HEAD:L=VIP(J) ;! SET LENGTH OF NEXT VIP ENTRY %IF IRTEXT(I)='0' %THENC %START ;! NULL ENTRY J=J+L+1 ;! INCREMENT VIP POINTER INC1: I=I+1 ;! EXAMINE NEXT CHARACTER %IF IRTEXT(I)='.' %THEN -> INC2 ;! FOR END OF FIELD %IF I>=LIM %THEN -> OUT ;! END IF I EXCEEDS LIMIT -> INC1 %FINISH COPYTEXT(VIP,J+1,OPLINE,K+2,L) ;! ENTER NAME TO O/P AREA K=K+L+2 ;! UPDATE O/P AREA PTR J=J+L+1 ;! UPDATE VIP POINTER ENT: OPLINE(K)=IRTEXT(I) ;! TRANSFER TEXT CHARACTER K=K+1 ;! INCREMENT POINTER I=I+1 ;! INCREMENT TEXT POINTER %IF I>LIM %THEN -> OUT ;! IF END REACHED - EXIT %IF IRTEXT(I)\='.' %THEN -> ENT ;! CONTINUE TO END OF FIELD INC2:I=I+1 ;! INCREMENT PTR PAST F/STOP %IF I<=LIM %THEN -> HEAD ;! FIND NEXT ENTRY ! ! THE DATE IS ALSO EXTRACTED AND APPEARS ON THE SAME LINE AS THE ! VOLUME DETAILS IF THERE IS ROOM, OTHERWISE ON A SEPARATE LINE. ! OUT: PV=LIM+1 ;! SET START OF DATE DETAILS 00071100 LIM=IRTEXT(PV) ;! SET LENGTH OF DATE FIELD %IF K=-1 %THEN K=1 %ELSE K=K+3 ;! ALLOW FOR SPACING 00072900 %IF K+LIM-1>MXLINE %THENC %START ;! SEPARATE LINE NECESSARY WRBOP(OPUNIT,OPLINE,K-3,-4) ;! OUTPUT VOLUME, ISSUE 00052800 WRLST(LSUNIT,OPLINE,K-3,4) ;! AND PART DETAILS SET(OPLINE,1,K-3,BLNK) ;! CLEAR O/P LINE K=1 ;! RESET O/P POINTER %FINISH COPYTEXT(IRTEXT,PV+1,OPLINE,K,LIM);! MOVE DATE TO O/P AREA 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 %IF RNUM<999000 %AND IRDIRC(2*PX+1)>0 %THENC %START ;! IF ADDITIONAL TITLE IT=IRDIRC(2*PX+1) ;! NOTE IS PRESENT TLENG=IRDIRC(2*PX+2) ;! SET POINTERS AND NW=1 ;! JUMP TO PROCESS MARKWORDS(IRTEXT,IT,IT+TLENG-1,NW) -> OPTL %FINISH -> CRND ! ! THE Z SECTION DOES NOT CONTAIN JOURNALS AND THEREFORE NO TITLES ! ARE REQUIRED. THE OUTPUT ROUTINES ARE CALLED TO OUTPUT SECTION ! HEADINGS ONLY. ! ZSECT:ZTP=RNUM//10 ;! EXTRACT TYPE CODE 00059900 ZTP=ZTP-ZTP//100*100 ;! FROM JOURNAL NUMBER 00059450 %IF ZTP\=ZTPS %THENC %START ;! CHANGE OF TYPE J=ZHD(ZTP-1) ;! SET HEADING POINTER K=ZHEAD(J) ;! SET LENGTH OF HEADING %CYCLE I=1,1,K OPLINE(I)=ZHEAD(J+I) ;! MOVE HEADING TO O/P AREA %REPEAT WRLST(LSUNIT,OPLINE,K,2) ;! O/P SECTN HEAD TO LISTING 00060800 %IF ZTPS=0 %THEN WRBOP(OPUNIT,OPLINE,SECT,3) 00060900 SET(OPLINE,1,K,BLNK) ;! CLEAR O/P AREA ZTPS=ZTP ;! STORE NEW TYPE CODE %FINISH %IF DIAGNS=YES %THENC %START ;! PRINT CURRENT NUMBER NEWLINES(2) ;! ............................. PRINT SYMBOL(SECT) ;! ............................. WRITE(JNUM&X'FFFFFF',7) ;! ............................. NEWLINE ;! ............................. PRINTSTRING('---------') ;! ............................. %FINISH ;! ............................. %RETURN ;! RETURN TO CALLING ROUTINE ! ! IF NO MASTER JOURNAL NUMBER EXISTS FOR AN INPUT RECORD A ! MESSAGE TO THIS EFFECT IS OUTPUT TO THE LISTING DEVICE BUT NO ! DATA IS OUTPUT TO THE BULLETIN. ! MSNG:WRLST(LSUNIT,OPLINE,2,4) ;! O/P BLANK LINE %CYCLE I=1,1,18 OPLINE(I)=NONAM(I) OPLINE(18+I)=NONAM(I) %REPEAT OPLINE(37)='*' WRLST(LSUNIT,OPLINE,37,4) ;! O/P MESSAGE SET(OPLINE,1,37,BLNK) ;! CLEAR O/P LINE WRLST(LSUNIT,OPLINE,1,5) ;! WRITE BLANK LINE %RETURN ! ! THE LAST ENTRY CLOSES THE FILES ! ENTRY(3):RDMJN(MJUNIT,MJBL,MJPS,3) ;! CLOSE MASTER JOURNAL FILE WRBOP (OPUNIT,OPLINE,0,0) ;! CLOSE BULLETIN FILE 00064000 WRLST (LSUNIT,OPLINE,0,0) ;! CLOSE LISTING FILE 00064100 ! ! ! ********************************************************************* ! %ROUTINE RDMJN(%INTEGER UNIT,%INTEGERNAME BLOCK,POSN,%INTEGER IND) ! ! THIS ROUTINE HANDLES I/O ON THE MASTER JOURNAL NUMBER FILE. ! THE FIRST ENTRY (IND=1) OPENS THE FILE AND PERFORMS ANY ! NECESSARY UPDATING. SUBSEQUENT ENTRIES (IND=2) EXTRACT THE ! REQUIRED RECORD FROM THE SPECIFIED BLOCK AND POSN. THE LAST ! ENTRY (IND=3) REWRITES THE CONTROL BLOCK AND CLOSES THE FILE. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA (%INTEGER CHANNEL,%INTEGERNAME SECT %C %NAME BEGIN,END) %EXTERNALROUTINESPEC WRITEDA (%INTEGER CHANNEL,%INTEGERNAME SECT %C %NAME BEGIN,END) %ROUTINESPEC GET TITLE (%BYTEINTEGERARRAYNAME JNTITL, %C %INTEGERNAME JST,JLNG,JNUM) %EXTERNALROUTINESPEC SET MARGINS (%INTEGER A,B,C) ! %BYTEINTEGERARRAY JREC(1:500) ;! NEW TITLE AREA %INTEGERARRAY CNT(1:6) ;! CONTROL ARRAY %OWNBYTEINTEGERARRAY BUFFER(1:1000) ;! BUFFER AREA ! %INTEGER I ;! LOOP VARIABLE %INTEGER IN ;! LOWER SUBSCRIPT OF MJNUMB %INTEGER J ;! LOOP VARIABLE %INTEGER JN ;! UPPER SUBSCRIPT OF MJNUMB %INTEGER MJBL ;! CURRENT BLOCK NUMBER %INTEGER NUM ;! NEW JOURN NO IN DECIMAL %INTEGER RLNG ;! LENGTH OF NEW RECORD ! %OWNINTEGER UPD ;! UPDATE INDICATOR %OWNINTEGER NFBL ;! POINTER TO NEXT FREE BLOCK %OWNINTEGER NFPS ;! POINTER TO NEXT FREE POSN %OWNINTEGER NBST ;! LAST BLOCK ACCESSED ! %SWITCH ENTRY(1:3) ;! ENTRY POINT SWITCH ! -> ENTRY(IND) ;! JUMP TO APPROPRIATE POINT ! ! FIRST ENTRY - OPEN FILE CHECK FOR ANY RECORDS TO BE ADDED ! READING AND PROCESSING THEM AT THIS POINT IF NECESSARY. ! ENTRY(1):OPENDA(UNIT) ;! OPEN MASTER FILE MJBL=1 ;! READ CONTROL BLOCK READDA(UNIT,MJBL,CNT(1),CNT(6)) 00081800 MAXN=CNT(1) ;! SET NO OF TITLES IN FILE NFBL=CNT(2) ;! STORE NEXT FREE BLOCK NO NFPS=CNT(3) ;! STORE NEXT FREE POSITION ! JN=MAXN+NJNO ;! TOTAL EXISTING + NEW TITLES %IF JN>MXNUMB %THEN -> OVFL ;! CHECK FOR OVERFLOW CONT:IN=NJNO+1 ;! SET START BEYOND NEW TITLES ! ! THE EXISTING JOURNAL NUMBERS ARE READ INTO THE ARRAY LEAVING ! ROOM AT THE BEGINNING EQUAL TO THE NUMBER OF NEW TITLES. ! THIS ALLOWS US TO MOVE THE JOURNAL NUMBERS UP THE ARRAY INSERTING ! NEW OR REPLACEMENT NUMBERS AS REQUIRED. ! MJBL=CNT(4) ;! READ JOURNAL NUMBER ARRAY READDA(UNIT,MJBL,MJNUMB(IN),MJNUMB(JN)) MJBL=CNT(5) ;! READ BLOCK POINTERS READDA(UNIT,MJBL,MJBPTR(IN),MJBPTR(JN)) MJBL=CNT(6) ;! READ POSITION POINTERS READDA(UNIT,MJBL,MJPPTR(IN),MJPPTR(JN)) ! ! IF NO UPDATING IS REQUIRED JUMP DIRECTLY TO THE END ! %IF NJNO=0 %THEN -> END ! ! THERE ARE NEW RECORDS TO BE ADDED. IT IS ASSUMED THAT THEY ! WILL BE IN STRICT NUMERIC ORDER. ! UPD=YES ;! SET UPDATE INDICATOR JN=1 ;! POINTER TO DESTINATION SELECT INPUT(6) SET MARGINS (6,1,88) ! %CYCLE I=1,1,NJNO ;! CYCLE THRO NEW RECORDS GET TITLE (JREC,ONE,RLNG,NUM) ;! FETCH NEXT RECORD %IF NUM=0 %THEN -> ERROR ;! CHECK FOR ENDFILE ! ! MOVE EXISTING NUMBERS BACK IN THE ARRAY UNTIL THE APPROPRIATE ! POSITION IS FOUND FOR THIS NEW RECORD. ! CHECK:%IF NUM>MJNUMB(IN) %THENC %START ;! MOVE UP EXISTING ENTRIES MJNUMB(JN)=MJNUMB(IN) MJBPTR(JN)=MJBPTR(IN) MJPPTR(JN)=MJPPTR(IN) IN=IN+1 ;! UPDATE BOTH ARRAY JN=JN+1 ;! POINTERS AND JUMP TO -> CHECK ;! EXAMINE THE NEXT RECORD %FINISH ! ! WHEN A LOW OR EQUAL COMPARE IS FOUND THE NEW RECORD IS WRITTEN ! TO THE NEXT AVAILABLE POSITION ON THE DISC FILE. ! %IF NFPS+RLNG+1>MXBUFS %THENC %START ;! RECORD WOULD CROSS BLOCK NFBL=NFBL+1 ;! BOUNDARY. A NEW BLOCK IS NFPS=1 ;! IS THEREFORE STARTED %FINISH %ELSEC READDA(UNIT,NFBL,BUFFER(1),BUFFER(MXBUFS)) BUFFER(NFPS)=RLNG>>8&X'FF' ;! STORE RECORD LENGTH IN BUFFER(NFPS+1)<-RLNG ;! FIRST TWO BYTES OF RECORD %CYCLE J=1,1,RLNG BUFFER(NFPS+J+1)=JREC(J) ;! AND WRITE TO DISC FILE 00089700 %REPEAT 00088400 CLOSEDA(UNIT) OPENDA(UNIT) WRITEDA(UNIT,NFBL,BUFFER(1),BUFFER(MXBUFS)) CLOSEDA(UNIT) OPENDA(UNIT) ! ! SET THE NEW NUMBER AND POINTERS IN THE NEXT POSITION ! MJNUMB(JN)=NUM ;! ENTER JOURNAL NUMBER MJBPTR(JN)=NFBL ;! ENTER BLOBK POINTER MJPPTR(JN)=NFPS ;! ENTER POSITION POINTER NFPS=NFPS+RLNG+2 ;! UPDATE POSITION POINTER JN=JN+1 ;! UPDATE ARRAY POINTERS %IF NUM=MJNUMB(IN) %THEN IN=IN+1 %ELSE MAXN=MAXN+1 %REPEAT ! ! WHEN ALL THE NEW RECORDS HAVE BEEN INSERTED THE ARRAYS MAY NEED ! FURTHER ADJUSTMENT I.E. IF THERE HAVE BEEN ANY REPLACEMENTS. ! %IF JN>MAXN %OR JN=IN %THEN -> END CLOS:%CYCLE I=JN,1,MAXN MJNUMB(I)=MJNUMB(IN) ;! CLOSE UP REMAINING MJBPTR(I)=MJBPTR(IN) ;! RECORDS IF NECESSARY MJPPTR(I)=MJPPTR(IN) IN=IN+1 ;! INCREMENT ARRAY POINTER %REPEAT ! ! THE END OF THE ARRAY MJNUMB MUST BE FILLED TO COMPARE ! HIGH AGAINST ALL OTHER JOURNAL NUMBERS. ! END: %CYCLE I=MAXN+1,1,MXNUMB MJNUMB(I)=1000000 %REPEAT ! %RETURN ! ! IND=2 NORMAL ENTRY: THE VALUE OF THE BLOCK POINTER IS CHECKED ! AGAINST THE MAXIMUM AND IF O.K. THE APPROPRIATE RECORD IS READ ! ENTRY(2):%IF BLOCK=NBST %THEN -> TRANSF;! CHECK IF BLOCK ALREADY IN %IF 1 CLOS ! ! 2) SOME OR ALL OF THE NEW JOURNAL TITLES WILL NOT BE ADDED TO ! THE FILE AS THEY WOULD EXCEED THE ALLOCATED SPACE. ! OVFL:NEWLINES(2) PRINTSTRING('NUMBER OF JOURNALS WILL EXCEED PERMITTED MAXIMUM') NEWLINE PRINTSTRING('TOTAL NUMBER OF NEW JOURNALS SUBMITTED =') WRITE(NJNO,3) NEWLINE PRINTSTRING('MAXIMUM PERMITTED NUMBER AT PRESENT =') WRITE(MXNUMB-MAXN,3) NEWLINE PRINTSTRING('LAST') WRITE(NJNO-MXNUMB+MAXN,3) PRINTSTRING(' UPDATE RECORDS IGNORED') NEWLINE PRINTSTRING('INCREASE ARRAY SIZES BEFORE MAKING FURTHER ADDITIONS') NEWLINES(2) PRINTSTRING('JOB CONTINUED') NJNO=MXNUMB-MAXN ;! SET NEW VALUE JN=MXNUMB -> CONT ! ! ********************************************************************* ! %ROUTINE GET TITLE (%BYTEINTEGERARRAYNAME JNTITL %C %INTEGERNAME JST,JLNG,JNUM) ! ! ROUTINE FETCHES THE NEXT VALID JOURNAL TITLE FROM THE INPUT ! STREAM. THE NUMBER IS RETURNED IN JNUM WHILE THE TEXT OF THE ! TITLE IS STORED IN JNTITL STARTING AT JST AND OF LENGTH JLNG. ! ! THE INPUT RECORDS MUST BE IN THE FORMAT SPECIFIED ..... ! ! NNNNNN-S TEXT OF THE TITLE . . . . C ! ! NNNNNN THE 6-DIGIT JOURNAL NUMBER INC THE CHECK DIGIT ! ! S THE SEQUENCE NUMBER. TO ENSURE THE TEXT OF A TITLE ! DOES NOT GET OUT OF ORDER EACH 'CARD' FORMING PART OF ! A TITLE CARRIES A SEQUENCE NUMBER BETWEEN 1 AND 9 ! ! C WHERE A TITLE REQUIRES MORE THAN ONE 'CARD' ALL 'CARDS' ! EXCEPT THE LAST MUST HAVE THE CHARACTER 'C' IN THE 73RD 00102400 ! CHARACTER POSITION AS A CONTINUATION SYMBOL. ! %EXTERNALROUTINESPEC ISOCARD (%BYTEINTEGERARRAYNAME A) %INTEGERFNSPEC CONV (%BYTEINTEGERARRAYNAME A,%INTEGER IA,L) ! %BYTEINTEGERARRAY BUF(1:80) ;! INPUT BUFFER AREA %INTEGER SUM ;! USED TO CALCULATE CHECK DIGIT %INTEGER CD ;! CHECK DIGIT %INTEGER I ;! LOOP VARIABLE %INTEGER JS ;! CURRENT START VALUE OF J %INTEGER J ;! POINTER TO TITLE ARRAY %INTEGER LIM ;! PRINT LOOP LIMIT %INTEGER ST ;! PRINT LOOP START POINT %INTEGER RNO ;! SWITCH VARIABLE (RET(RNO)) %BYTEINTEGER CHAR ;! CURRENT CHARACTER %BYTEINTEGER CASE ;! CURRENT CASE (SHIFT OR NORMAL) %BYTEINTEGER SEQNO ;! SEQUENCE NUMBER ! %SWITCH ERR(1:6) ;! ERROR SWITCH %SWITCH RET(1:3) ;! RETURN SWITCH FROM PRINT ! ! ON ENTRY TO THE ROUTINE THE NEXT CARD IMAGE IS READ IN ! RDCD:ISOCARD(BUF) ;! READ I/P RECORD %IF BUF(1)='E' %THENC %START ;! END OF FILE FOUND JNUM=0 ;! SET ZERO AS EOF INDICATOR %RETURN ;! RETURN TO CALLING ROUTINE %FINISH ! ! CALCULATE CHECK DIGIT ! CHCD:SUM=0 ;! INITIALISE SUM %CYCLE I=1,1,5 SUM=SUM+(7-I)*(BUF(I)&X'0F') ;! ADD WEIGHTED VALUES %REPEAT CD=10-(SUM-SUM//11*11) ;! CALC SINGLE CHECK DIGIT %IF CD=10 %THEN CD=0 ;! AND COMPARE WITH THAT GIVEN %IF BUF(6)\=CD!X'30' %THEN -> ERR(1) ! ! VALID JOURNAL NUMBER ! JNUM=CONV(BUF,1,6) ;! CONVERT TO BINARY SEQNO='0' ;! INITIALISE SEQUENCE NUMBER CASE=X'20' ;! INITIALISE CASE TO SHIFT JS=JST ;! INITIALISE STARTING POINT ! ! CHECK SEQUENCING - IGNORING IF INVALID ! CHSQ:%IF BUF(8)\=SEQNO+1 %THEN -> ERR(2) SEQNO=BUF(8) ;! STORE NEW SEQUENCE NUMBER ! ! INPUT DATA IS O.K. AND IS ADDED TO THE CURRENT TITLE ! J=JS-1 ;! SET START VALUE OF POINTER %CYCLE I=10,1,72 ;! CYCLE THROUGH I/P RECORD 00108000 CHAR=BUF(I) ;! EXAMINE NEXT CHARACTER %IF CHAR='<' %OR CHAR='>' %THENC %START ;! CASE CHANGE - SET NEW CASE %IF CHAR='<' %THEN CASE=0 %ELSE CASE=X'20' -> REPT ;! CONTINUE %FINISH J=J+1 ;! UPDATE TITLE POINTER JNTITL(J)=CHAR!CASE ;! AND STORE CHARACTER REPT:%REPEAT ! ! WHEN THE END OF THIS I/P RECORD IS REACHED TRAILING BLANKS ARE ! REMOVED. A SINGLE SPACE IS LEFT IF A CONTINUATION IS EXPECTED ! CHKJ:%IF JNTITL(J)=' ' %THENC %START ;! BLANK CHARACTER J=J-1 ;! DECREMENT THE POINTER %IF J>JS %THEN -> CHKJ ;! CONTINU UNLESS START REACHED %IF JS=JST %THEN -> ERR(3) ;! ERROR - 1ST TITLE CARD BLANK -> ERR(4) ;! ERROR - BLANK CARD IN TITLE %FINISH ! ! CHECK FOR A CONTINUATION CARD ! %IF BUF(73)\='C' %THENC 00110400 %START ;! END OF TITLE REACHED JLNG=J-JST+1 ;! CALC LENGTH OF TITLE %RETURN ;! RETURN TO CALLING ROUTINE %FINISH JNTITL(J+1)=' ' ;! ENSURE SPACING CHAR IS BLANK JS=J+2 ;! CONTINUATION - ALLOW A BLANK ! ! READ CONTINUATION CARD AND CHECK THAT THE JOURNAL NUMBER AGREES ! RDCN:ISOCARD(BUF) ;! READ NEXT CARD %IF BUF(1)='E' %THEN -> ERR(5) ;! ERROR - END OF FILE FOUND %IF CONV(BUF,1,6)\=JNUM %THEN -> ERR(6) ;! ERROR - JNUM DISAGREES -> CHSQ ;! NUMBER O.K. CHECK SEQUENCING ! ! ERROR SECTION - MESSAGES AND OFFENDING RECORDS ARE PRINTED AND ! PROCESSING CONTINUES AS SUTABLE THEREAFTER. ! ERR(1):NEWLINES(2) ;! CHECK DIGIT WRONG PRINTSTRING(' ****** INVALID CHECK DIGIT - RECORD IGNORED') -> RET(1) ;! JUMP TO PRINT RECORD ! ERR(2):NEWLINES(2) ;! TITLE CARDS OUT OF ORDER PRINTSTRING(' ****** SEQUENCE NUMBER OUT OF ORDER - RECORD IGNORED') %IF SEQNO='0' %THEN -> RET(1) RNO=1 ;! JUMP TO PRINT RECORD -> PREC ! ERR(3):NEWLINES(2) ;! WARNING MESSAGE PRINTSTRING(' ****** BLANK CARD IN DATA - IGNORED') -> RDCD ;! READ NEXT RECORD ! ERR(4):NEWLINES(2) ;! WARNING MESSAGE PRINTSTRING(' ****** BLANK CARD IN RECORD - IGNORED') -> RDCN ;! READ REST OF CURRENT RECORD ! ERR(5):NEWLINES(2) ;! END OF FILE FOUND UNEXPECTEDLY PRINTSTRING(' ****** END OF DATA FOUND IN MIDDLE OF RECORD') PRINTSTRING(' - RECORD IGNORED') RNO=2 ;! PRINT RECORD DETAILS -> PREC RET(2):JNUM=0 ;! SET EOF INDICATOR %RETURN ;! RETURN TO CALLING ROUTINE ! ERR(6):NEWLINES(2) ;! JOURNAL NUMBER CHANGES PRINTSTRING(' ****** JOURNAL NUMBER CHANGES IN MIDDLE OF RECORD') PRINTSTRING(' - RECORD IGNORED') RNO=3 ;! JUMP TO PRINT RECORD -> PREC RET(3):%IF BUF(8)='1' %THEN -> CHCD ;! IF START OF NEW TITLE CONT NEWLINE ;! ELSE IGNORE 2ND REC TOO PRINTSTRING(' ****** NEW RECORD NOT IN ORDER - ALSO IGNORED') -> RET(1) ! ! ! THIS SECTION PRINTS THE I/P RECORDS THAT HAVE NOT BEEN ! TRANSFERRED TO THE TITLE ARRAY AND ARE TO BE IGNORED. ! RET(1):NEWLINE PRINTSTRING(' ****** ') %CYCLE I=1,1,80 PRINT SYMBOL(BUF(I)) %REPEAT %IF BUF(73)\='C' %THENC 00116700 %START ;! READ ALL CONTINUATION CARDS ISOCARD(BUF) -> RET(1) ;! AND PRINT THEM FOR REFERENCE %FINISH -> RDCD ;! READ NEXT TITLE ! ! THIS SECTION PRINTS THE RECORD OR PART THEREOF THAT IS ALREADY ! IN THE ARRAY JNTITL. ! PREC:LIM=J ;! INITIALISE LIMIT ST=1 ;! INITIALISE START NLIN:NEWLINE PRINTSTRING(' ****** ') %IF LIM>80 %THENC %START ;! LINES OF 80 CHARS ARE PRINTED %CYCLE I=ST,1,ST+79 PRINT SYMBOL(JNTITL(I)) %REPEAT LIM=LIM-80 ;! DECREMENT LIMIT ST=ST+80 ;! UPDATE START POINT -> NLIN ;! PRINT NEXT LINE %FINISH %CYCLE I=ST,1,ST+LIM-1 PRINT SYMBOL(JNTITL(I)) ;! PRINT LAST LINE %REPEAT -> RET(RNO) ;! EXIT AS APPROPRIATE ! ! ! ********************************************************************* ! %INTEGERFN CONV(%BYTEINTEGERARRAYNAME A,%INTEGER IA,L) ! ! FUNCTION CALCULATES THE INTEGER VALUE OF THE L DIGITS IN THE ! ARRAY A STARTING AT A(IA). ! %INTEGER SUM,I ! SUM=0 %CYCLE I=0,1,L-1 SUM = 10*SUM+(A(IA+I)&X'0F') %REPEAT %RESULT=SUM %END;! CONV ! %END ;! GET TITLE ! %END;!RDMJN ! %END ;! OUTPUT TITLE ! ! ********************************************************************* ! %ROUTINE WRBOP(%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C %INTEGER PARM,IND) ! ! THIS ROUTINE CONTROLS OUTPUT TO THE BULLETIN DEVICE. THIS ! VERSION OUTPUTS TO THE PAPER TAPE PUNCH AND THE UNIT PARAMETER ! IS NOT IN FACT USED. THE TYPE OF OUTPUT IS SPECIFIED BY THE ! VALUE OF IND AS FOLLOWS:- ! IND=1 MAIN HEADING ! IND=2 (NOT USED AT PRESENT) ! IND=3 SECTION DELIMETER ! IND=4 O/P CONTENTS OF OPAREA AFTER EDITING 00079000 ! IND=5 O/P AS FOR IND=4 BUT WITH ITEM DELIMITER 00079050 ! IND=0 TERMINATION OUTPUT 00079100 ! (IF IND NEGATIVE OUTPUT IS UNDERLINED) 00087850 ! %ROUTINESPEC PTOUT (%BYTEINTEGERARRAYNAME BUF, %INTEGER LENG) ! %OWNBYTEINTEGERARRAY MHEAD (1:45) = %C X'00',X'FF',X'01',X'01',X'01',X'01',X'00', X'00',X'FF',X'00', X'00',X'FF',X'89',X'89',X'89',X'76',X'00', X'00',X'FF',X'88',X'88',X'88',X'77',X'00', X'00',X'7F',X'88',X'88',X'88',X'7F',X'00', X'00',X'FF',X'88',X'88',X'88',X'77',X'00', X'00',X'C0',X'20',X'1F',X'20',X'C0',X'00' ! %OWNBYTEINTEGERARRAY ARWR (1:10) = %C X'18',X'18',X'18',X'18',X'18',X'99',X'DB',X'7E',X'3C',X'18' ! %OWNBYTEINTEGERARRAY ARWL (1:10) = %C X'18',X'3C',X'7E',X'DB',X'99',X'18',X'18',X'18',X'18',X'18' ! %OWNBYTEINTEGERARRAY DELIM (1:8) = %C X'18',X'3C',X'66',X'C3',X'C3',X'66',X'3C',X'18' ! %OWNBYTEINTEGERARRAY LTRS (0:207) = %C X'42',X'42',X'42',X'7E',X'42',X'42',X'24',X'18', X'3E',X'42',X'42',X'42',X'3E',X'42',X'42',X'3E', X'3C',X'42',X'02',X'02',X'02',X'02',X'42',X'3C', X'3E',X'42',X'42',X'42',X'42',X'42',X'42',X'3E', X'7E',X'02',X'02',X'02',X'3E',X'02',X'02',X'7E', X'02',X'02',X'02',X'02',X'3E',X'02',X'02',X'7E', X'3C',X'42',X'42',X'72',X'02',X'02',X'42',X'3C', X'42',X'42',X'42',X'42',X'7E',X'42',X'42',X'42', X'18',X'18',X'18',X'18',X'18',X'18',X'18',X'18', X'0C',X'12',X'10',X'10',X'10',X'10',X'10',X'7E', X'42',X'22',X'12',X'0E',X'0E',X'12',X'22',X'42', X'7E',X'02',X'02',X'02',X'02',X'02',X'02',X'02', X'42',X'42',X'42',X'42',X'5A',X'5A',X'66',X'42', X'42',X'42',X'62',X'52',X'4A',X'46',X'42',X'42', X'3C',X'42',X'42',X'42',X'42',X'42',X'42',X'3C', X'02',X'02',X'02',X'3E',X'42',X'42',X'42',X'3E', X'5C',X'22',X'5A',X'42',X'42',X'42',X'42',X'3C', X'42',X'22',X'12',X'3E',X'42',X'42',X'42',X'3E', X'3C',X'42',X'40',X'20',X'1C',X'02',X'42',X'3C', X'18',X'18',X'18',X'18',X'18',X'18',X'7E',X'7E', X'3C',X'42',X'42',X'42',X'42',X'42',X'42',X'42', X'18',X'24',X'42',X'42',X'42',X'42',X'42',X'42', X'42',X'66',X'5A',X'5A',X'42',X'42',X'42',X'42', X'42',X'42',X'24',X'18',X'18',X'24',X'42',X'42', X'18',X'18',X'18',X'18',X'18',X'24',X'42',X'42', X'7E',X'02',X'04',X'08',X'10',X'20',X'40',X'7E' ! %OWNBYTEINTEGERARRAY TRTBL(0:127) = %C 0,0,0,0,0,0,0,0,0,X'14',X'12',0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,X'FF',0,0,0,0,X'7D', X'90',0,0,X'AB',0,X'B0',X'B6',X'A7',X'A8',X'B9',X'AE', X'2D',X'BF',X'2E',X'3F',X'0F', X'30',X'21',X'22',X'33',X'24',X'35',X'36',X'27',X'28',X'39',X'8F', 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', X'4B',X'5C',X'4D',X'4E',X'5F', X'60',X'71',X'72',X'63',X'74',X'65',X'66',X'77',X'78',X'69',X'6A', 0,X'AD',0,0,X'3A', 0,X'C1',X'C2',X'D3',X'C4',X'D5',X'D6',X'C7',X'C8',X'D9',X'DA', X'CB',X'DC',X'CD',X'CE',X'DF', X'E0',X'F1',X'F2',X'E3',X'F4',X'E5',X'E6',X'F7',X'F8',X'E9',X'EA', 0,X'A1',0,X'A2',0 ! %BYTEINTEGERARRAY BUFFER(1:3*MXLINE) ;! O/P BUFFER 00094500 ! %INTEGER CHAR ;! CURRENT CHARACTER %INTEGER I ;! LOOP VARIABLE %INTEGER IB ;! BUFFER POINTER %INTEGER LP ;! SECTION LETTER POINTER ! %OWNINTEGER CASE=1 ;! CURRENT CASE INDICATOR %OWNINTEGER MINL='A' ;! MINIMUM SECTION CODE %OWNINTEGER ULIN=X'3A' ;! UNDERLINE CHARACTER 00095350 ! %SWITCH ENTRY (-5:5) ;! ENTRYPOINTS 00095500 %SWITCH NRML (1:2) ;! CASE NORMAL ACTIONS %SWITCH SHFT (1:2) ;! CASE SHIFT ACTIONS ! -> ENTRY(IND) ;! SELECT ENTRYPOINT ! ! ENTRY 1 OUTPUT MAIN HEADING TO PAPER TAPE ! ENTRY(1):SET(BUFFER,1,100,0) ;! CLEAR O/P AREA PTOUT(BUFFER,100) ;! RUNOUT COPYTEXT (ARWR,1,BUFFER,1,10) 00103100 COPYTEXT (MHEAD,1,BUFFER,19,45) ;! SET UP MAIN HEADING 00103200 COPYTEXT (ARWR,1,BUFFER,72,10) 00103300 PTOUT (BUFFER,92) ;! OUTPUT LEADER 00103400 SET(BUFFER,1,100,0) %RETURN ! ! ENTRY 3 OUTPUT SECTION DELIMITER AND HEADING ! ENTRY(3):SET(BUFFER,1,74,0) ;! CLEAR O/P AREA 00102700 COPYTEXT (DELIM,1,BUFFER,1,8) ;! ENTER DELIMITER 00104100 LP=(PARM-MINL)*8 ;! CALC POSN OF SECTN REQUIRED 00104200 COPYTEXT (LTRS,LP,BUFFER,18,8) ;! ENTER SECTN LTR TO O/P AREA 00104300 COPYTEXT (DELIM,1,BUFFER,35,8) ;! ENTER DELIMITER 00104400 PTOUT (BUFFER,62) ;! OUTPUT TO PAPER TAPE 00104500 %RETURN ! ! ENTRY 4 TRANSLATE TEXT IN OPAREA AND OUTPUT WITH LINEFEED ! ENTRY 5 AS ABOVE BUT FOLLOWED BY AN ITEM DELIMETER 00089550 ! ENTRY(-4):ENTRY(-5):%C 00098550 ENTRY(4):ENTRY(5):BUFFER(1)=X'12' ;! SET CRLF AT START OF LINE 00089700 IB=1 ;! INITIALISE BUFFER POINTER ! %CYCLE I=1,1,PARM CHAR=OPAREA(I) ;! EXAMINE NEXT CHARACTER %IF CHAR=X'FF' %OR CHAR=X'20' %THENC %START ;! BLANK OR DELETE CHARACTER %IF CHAR=X'FF' %THEN -> LOOP ;! IGNORE DELETE CHARACTER IB=IB+1 ;! ELSE UPDATE BUFFER POINTER %IF IND<0 %THENC 00099410 %START ;! IF UNDERLINING REQUIRED 00099420 BUFFER(IB)=ULIN ;! CHARACTER IS INSERTED BEFORE 00099430 IB=IB+1 ;! BLANK AND POINTER UPDATED 00099440 %FINISH 00099450 BUFFER(IB)=X'90' ;! AND SET CODE FOR BLANK -> LOOP ;! CONTINUE WITH NEXT CHARACTER %FINISH CHAR=TRTBL(CHAR) ;! TRANSLATE CHARACTER ! ! JUMP TO ROUTINE DEPENDENT ON CASE OF CHARACTER. ! %IF CHAR&X'80'=0 %THEN -> NRML(CASE) %ELSE -> SHFT(CASE) ! ! CHANGE OF CASE TO CASE NORMAL ! NRML(1):CASE=2 ;! SET CASE NORMAL MARKER IB=IB+1 ;! INCREMENT BUFFER POINTER BUFFER(IB)=X'17' ;! SET CASE NORMAL IN BUFFER -> NRML(2) ;! JUMP TO ENTER CHARACTER ! ! CHANGE OF CASE TO CASE SHIFT ! SHFT(2):CASE=1 ;! CHANGE TO CASE SHIFT IB=IB+1 ;! INCREMENT BUFFER POINTER BUFFER(IB)=X'06' ;! SET CASE SHIFT IN BUFFER ! ! NORMAL CHARACTER CASE INDICATOR IS REMOVED AND CHARACTER STORED ! NRML(2):SHFT(1):IB=IB+1 ;! INCREMENT BUFFER POINTER %IF IND<0 %THENC 00101910 %START ;! IF UNDERLINING REQUIRED THE 00101920 BUFFER(IB)=ULIN ;! UNDERLINE CHARACTER PRECEDES 00101930 IB=IB+1 ;! THE CURRENT CHARACTER 00101940 %FINISH 00101950 BUFFER(IB)=CHAR&X'7F' ;! REMOVE CASE BIT LOOP:%REPEAT ;! CONTINUE THROUGH O/P AREA ! ! WHEN END OF OUTPUT AREA IS REACHED THE RESULTING BUFFER IS OUTPUT ! TO PAPER TAPE BY A CALL OF THE OUTPUT ROUTINE ! PTOUT(BUFFER,IB) %IF IND=5 %OR IND=-5 %THENC 00102700 %START ;! ENTRYPOINT 5 ONLY 00093720 BUFFER(1)=X'12' ;! SET CRLF AT START AND 00109150 SET (BUFFER,2,21,0) ;! CLEAR REST OF AREA 00110600 PTOUT (BUFFER,21) ;! AND O/P 2" OF RUNOUT 00110700 %FINISH 00093750 %RETURN ;! RETURN TO CALLING ROUTINE ! ! ENTRY 0 LAST ENTRY - TERMINATION CODE TO PAPER TAPE ! ENTRY(0):SET(BUFFER,1,100,0) ;! CLEAR O/P AREA COPYTEXT(ARWL,1,BUFFER,11,10) COPYTEXT(MHEAD,1,BUFFER,29,45) ;! SET UP TERMINATION CODE COPYTEXT(ARWL,1,BUFFER,82,10) PTOUT(BUFFER,100) ;! OUTPUT TO PUNCH SET(BUFFER,1,100,0) ;! CLEAR O/P AREA PTOUT(BUFFER,100) ;! FINAL RUNOUT ! ! ********************************************************************* ! %ROUTINE PTOUT(%BYTEINTEGERARRAYNAME BUF,%INTEGER LENG) ! ! THIS ROUTINE OUTPUTS TO P/TAPE VIA A CALL OF SIM2 ! %SYSTEMROUTINESPEC SIM2(%INTEGER EP,R1,R2,R3) %INTEGER FLAG ;! P/TAPE O/P SUCCESS/FAIL IND ! SIM2(3,ADDR(BUF(1)),LENG,ADDR(FLAG)) %IF FLAG < 0 %THENC %START ;! UNSUCCESSFUL OPERATION NEWLINES(2) ;! O/P MESSAGE PRINTSTRING('ERROR ON PAPER TAPE PUNCH - JOB TERMINATED') %STOP ;! AND STOP JOB %FINISH ! %END ;! PTOUT ! %END ;! WRBOP ! ! ********************************************************************* ! %ROUTINE WRLST (%INTEGER UNIT, %BYTEINTEGERARRAYNAME OPAREA, %C %INTEGER LENG,IND) ! ! THIS ROUTINE OUTPUTS THE CONTENTS OF OPAREA TO THE LISTING ! DEVICE VIA THE STREAM UNIT. 00127500 ! ! THE FORM OF THE OUTPUT IS DEPENDENT ON THE VALUE OF IND ! IND=1 OUTPUTS A MAIN HEADING TO THE LISTING - THE CONTENTS OF ! LENG AND OPAREA ARE IGNORED. ! ! IND=2 OUTPUTS A LINE OF ASTERISKS, THEN THE CONTENTS OF ! OPAREA SURROUNDED BY ASTERISKS AND LASTLY ANOTHER LINE ! OF ASTERISKS. ! ! IND=3 ADDS THE CHARACTER IN LENG TO THE SECTION HEADING LINE ! AND OUTPUTS THIS ! ! IND=4 OUTPUTS THE CONTENTS OF OPAREA PRECEDED BY TEN SPACES ! 00100430 ! IND=5 AS FOR IND=4 BUT FOLLOWED BY A BLANK LINE 00100460 ! ! IND=0 LAST ENTRY PRINTS TERMINATION MESSAGE ! ! ALL THESE FORMS OF OUTPUT ARE SUITABLY SPACED ! %ROUTINESPEC OUTPUT(%BYTEINTEGERARRAYNAME AREA,%INTEGER LENG,LFB,LFA) ! %OWNBYTEINTEGERARRAY BUF(1:68)=32,32,32,32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,32,32,32,32,'B','U','L', 'L','E','T','I','N',' ','O','U','T', 'P','U','T',' ','L','I','S','T','I', 'N','G',32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,32,32,32,32,32,32,32,32 %OWNBYTEINTEGERARRAY DHEAD(1:68)='*','*','*','*','*','*','*','*','*', '*',32,32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,32,32,32,32,32,32,32, 32,'*','*','*','*','*','*','*','*', '*','*' %OWNBYTEINTEGERARRAY SHEAD(1:68)='*','*','*','*','*','*','*','*','*', '*',32,32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,32,32,32,'S','E','C', 'T','I','O','N',32,32,32,32,32,32,32, 32,32,32,32,32,32,32,32,32,32,32,32, 32,32,32,'*','*','*','*','*','*','*', '*','*','*' %OWNBYTEINTEGERARRAY ASTKA(1:68)='*','*','*','*','*','*','*','*','*', '*','*','*','*','*','*','*','*','*', '*','*','*','*','*','*','*','*','*', '*','*','*','*','*','*','*','*','*', '*','*','*','*','*','*','*','*','*', '*','*','*','*','*','*','*','*','*', '*','*','*','*','*','*','*','*','*', '*','*','*','*','*' %OWNBYTEINTEGERARRAY EOJB(1:68)='*','*','*','*','*','*','*','*','*', '*',32,32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,'E','N','D',' ','O', 'F',' ','B','U','L','L','E','T','I', 'N',32,32,32,32,32,32,32,32,32,32,32, 32,32,32,32,32,32,'*','*','*','*','*', '*','*','*','*','*' ! %INTEGER I ;! LOOP VARIABLE %INTEGER ST ;! START POINTER ! %OWNINTEGER MXBUF ;! SIZE OF O/P ARRAYS ! %SWITCH ENTRY(0:5) ;! ENTRY SWITCH 00105300 ! -> ENTRY(IND) ;! JUMP TO APPROPRIATE POINT ! ! IND=1 FIRST ENTRY O/P HEADING ONLY ! ENTRY(1):MXBUF=68 ;! SET MAX O/P LINE SIZE OUTPUT(BUF,MXBUF,0,0) ;! O/P MAIN HEADING %CYCLE I=1,1,MXBUF ;! PRECEDED BY 10 NEW LINES %IF BUF(I)\=' ' %THEN BUF(I)='*' ;! UNDERLINE HEADING %REPEAT OUTPUT(BUF,MXBUF,1,0) ;! OUTPUT UNDERLINING SET(BUF,1,MXBUF,BLNK) ;! CLEAR O/P BUFFER %RETURN ;! RETURN TO CALLING ROUTINE ! ! IND=2 MAIN DIVISION HEADING ! ENTRY(2):OUTPUT(ASTKA,MXBUF,3,0) ;! O/P LINE OF ASTERISKS ST=(MXBUF-LENG)//2 ;! CALC STARTING POSITION %CYCLE I=1,1,LENG DHEAD(ST+I)=OPAREA(I) ;! SET UP DIVISION HEADING %REPEAT OUTPUT(DHEAD,MXBUF,1,0) ;! OUTPUT DIVISION SEPARATOR %CYCLE I=1,1,LENG DHEAD(ST+I)=' ' ;! CLEAR CENTRE OF ARRAY %REPEAT OUTPUT(ASTKA,MXBUF,1,2) ;! OUTPUT LINE OF ASTERISKS %RETURN ! ! IND=3 SECTION HEADING WITHIN JOURNALS ! ENTRY(3):SHEAD(38)=(LENG&X'FF') ;! MOVE SECTION CODE TO O/P AREA OUTPUT(SHEAD,MXBUF,3,2) %RETURN ! ! IND=4 TITLE OR RECORD SINGLE OUTPUT LINE ! IND=5 AS ABOVE FOLLOWED BY BLANK LINE 00108850 ! ENTRY(4):ENTRY(5):%CYCLE I=1,1,LENG 00109000 BUF(10+I)=OPAREA(I) ;! MOVE O/P TO BUFFER AREA %REPEAT %IF LENG < MXLINE %THEN SET(BUF,LENG+11,MXLINE+11,BLNK) 00109300 OUTPUT(BUF,MXBUF,1,IND-4) ;! OUTPUT LINE 00109900 %RETURN ! ! IND=0 LAST ENTRY EOJ MESSAGE OUTPUT ! ENTRY(0):OUTPUT(ASTKA,MXBUF,3,0) ;! END OF LISTING OUTPUT(EOJB,MXBUF,1,0) OUTPUT(ASTKA,MXBUF,1,3) %RETURN ! ! ********************************************************************* ! %ROUTINE OUTPUT(%BYTEINTEGERARRAYNAME AREA, %INTEGER LENG,LFB,LFA) ! ! ROUTINE OUTPUTS THE ALPHANUMERIC CONTENTS OF AREA TO THE CURRENT 00139600 ! STREAM PRECEEDED BY LFB LINE FEEDS AND FOLLOWED BY LFA LINE FEEDS. 00139700 ! %INTEGER I %OWNINTEGER POINT=1 ! %SWITCH ENTRY(1:2) ;! ENTRY SWITCH ! -> ENTRY(POINT) ! ENTRY(1):NEWPAGE ;! NEW PAGE ON FIRST ENTRY ONLY POINT=2 ;! CHANGE ENTRY SWITCH ! ENTRY(2):%IF LFB<=0 %THEN-> OA %IF LFB=1 %THEN NEWLINE %ELSE NEWLINES(LFB) ! OA: %CYCLE I=1,1,LENG PRINT SYMBOL(AREA(I)) ;! OUT PUT CHARACTERS %REPEAT ! %IF LFA<=0 %THEN %RETURN %IF LFA=1 %THEN NEWLINE %ELSE NEWLINES(LFA) %RETURN %END ;! OUTPUT %END;!WRLST ! ! ********************************************************************* ! %ROUTINE CREATELINE (%BYTEINTEGERARRAYNAME OPLINE,DATA, %C %INTEGER START,MXLINE,TNW, %C %INTEGERNAME LENGOP,END) ! ! THIS ROUTINE SETS UP LINES IN OPLINE BEGINNING AT START AND OF ! MAXIMUM LENGTH MXLINE. THE OUTPUT LINE IS BOTH LEFT AND RIGHT ! JUSTIFIED UNLESS THE OUTPUT DOES NOT FILL THE O/P AREA IN WHICH ! CASE ONLY LEFT JUSTIFICATION TAKES PLACE. THE END OF THE DATA ! IS INDICATED BY THE VARIABLE END BEING SET NON-ZERO. ! %OWNINTEGER FOB=1 ;! EXTRA SPACING SIDE INDIC %OWNINTEGER IST ;! POINTER TO CURRENT ITEM %OWNINTEGER NEW=1 ;! NEW DATA INDICATOR ! %INTEGER FRST ;! START POSN IN DATA %INTEGER I ;! LOOP VARIABLE %INTEGER INC ;! NO OF SPACES TO BE INSERTED %INTEGER LENG ;! LENGTH OF ITEM %INTEGER LP ;! CURRENT O/P LINE POINTER %INTEGER NSP ;! NO OF GAPS TO RECEIVE SPACES %INTEGER NW ;! NUMBER OF WORDS IN LINE %INTEGER REM ;! NO OF SPARE POSNS REMAINING ! %SWITCH FILL(1:2) ;! ALTERNATE FILL OUT SWITCH ! %IF NEW=YES %THENC %START ;! FIRST ENTRY FOR NEW ITEM NEW=0 ;! SET NEW DATA SWITCH OFF IST=1 ;! SET START OF LOOP %FINISH LP=START-1 ;! INITIALISE LINE POINTER 00127700 ! ! THE CURRENT SECTION OF THE POINTER ARRAYS IS SCANNED AND THE ! NEXT LINE CREATED AFTER THE REQUIRED ALIGNMENT. ! %CYCLE I=IST,1,TNW %IF LP+WLNG(I)>MXLINE %THEN -> LNFUL ;! JUMP IF LINE FULL LP=LP+WLNG(I)+WSPS(I) ;! INCREMENT LINE POINTER %REPEAT ! ! END OF DATA REACHED - NO ALIGNMENT NECESSARY ! NW=TNW ;! SET WORD COUNT NEW=YES ;! RESET ENTRY VARIABLE LENGOP=LP-WSPS(TNW) ;! CALC LENGTH OF O/P LINE %IF LENGOP CRLN ;! O/P SHORT LINE NOW 00134800 I=TNW+1 ;! BUT ADJUST LONG LAST LINE 00134850 ! ! END OF OUTPUT LINE REACHED - WORDS ARE LEFT AND RIGHT ADJUSTED ! AS REQUIRED. ! LNFUL:NW=I-1 ;! CALC NUMBER OF ITEMS 00119200 NSP=MXLINE-LP+WSPS(NW) ;! CALC NO OF SPARE SPACES 00128400 LENGOP=MXLINE ;! SET LENGTH OF O/P LINE %IF NW-IST<=0 %THEN -> CRLN ;! O/P LINE IF <= ONE ITEM 00136400 INC=NSP//(NW-IST) ;! CALC OVERALL INCREMENT 00136500 %IF INC=0 %THEN REM=NSP %ELSEC %START ;! OVERALL INCREMENT NON-ZERO %CYCLE I=IST,1,NW-1 ;! ADD APPROPRIATE VALUE TO WSPS(I)=WSPS(I)+INC ;! EACH SPACE ALLOWANCE %REPEAT REM=NSP-((NW-IST)*INC) ;! CALCULATE REMAINDER 00137100 %FINISH %IF REM=0 %THEN -> CRLN ;! IF LINE FILLED NO ADJ NEC -> FILL(FOB) ;! ELSE FILL AS INDICATED ! FILL(1):FOB=2 ;! CHANGE SWITCH FOR NEXT TIME %CYCLE I=IST,1,IST+REM-1 ;! ADD SPARES FROM THE LEFT WSPS(I)=WSPS(I)+1 ;! ONE EXTRA PER SPACE %REPEAT -> CRLN ;! JUMP TO CREATE O/P LINE ! FILL(2):FOB=1 ;! CHANGE SWITCH FOR NEXT TIME %CYCLE I=NW-REM,1,NW-1 ;! ADD SPARES FROM THE RIGHT WSPS(I)=WSPS(I)+1 ;! ONE EXTRA PER SPACE %REPEAT ! ! WHEN WORDS HAVE BEEN PROPERLY SPACED OUT THE OUTPUT LINE IS CREATED ! CRLN:LP=START ;! INITIALISE LINE POSITION 00132400 SET (OPLINE,1,MXLINE,BLNK) ;! CLEAR O/P AREA %CYCLE I=IST,1,NW ;! CYCLE THROUGH WORDS 00122100 FRST=WBGN(I) ;! TRANSFER START TO INTEGER LENG=WLNG(I) ;! TRANSFER LENGTH TO INTEGER COPYTEXT (DATA,FRST,OPLINE,LP,LENG) LP=LP+WLNG(I)+WSPS(I) ;! UPDATE LINE POINTER %REPEAT ! IST=NW+1 ;! INCREMENT START VAL FOR NEXT 00122750 END=NEW ;! SET EXIT INDICATOR %END ;! CREATELINE ! ! ********************************************************************* ! %ROUTINE OUTPUT ITEM (%INTEGER JNUM) ! ! THIS ROUTINE ASSEMBLES THE BULLETIN OUTPUT RECORD FROM THE ! INTERNAL RECORD FORMAT AND CALLS ROUTINES TO OUTPUT THE RESULTING ! LINES TO THE BULLETIN AND LISTING DEVICES. ! %BYTEINTEGERARRAY OPLINE(1:MXLINE);! O/P BUFFER %BYTEINTEGERARRAY TEMP(1:500) ;! TEMPORARY ARRAY FOR AUTHORS 00170400 ! %INTEGER I ;! LOOP VARIABLE %INTEGER ID ;! POINTER TO THE DIRECTORY %INTEGER INCT ;! LENGTH OF CURRENT ITEM %INTEGER IND ;! INDICATOR %INTEGER IT ;! POINTER TO THE INT REC TEXT %INTEGER IT1 ;! SUBSIDIARY PTR TO TEXT (1) %INTEGER IT2 ;! SUBSIDIARY PTR TO TEXT (2) %INTEGER LENGOP ;! LENGTH OF O/P LINE (BYTES) %INTEGER MXT ;! END OF CURRENT ITEM %INTEGER OPST ;! START POSN OF O/P LINE %INTEGER RLN ;! LENGTH OF REFERENCE NUMBER 00171840 %INTEGER RST ;! START POS OF REF NO 00171820 %INTEGER RV ;! SWITCH CONTROL VALUE %INTEGER TPOS ;! CURRENT POS IN TEMP ARRAY %SWITCH RET(1:4) ;! RETURN FROM LINE O/P SWITCH ! SET (OPLINE,1,25,0) ;! ZEROISE OUTPUT AREA 00172800 ! ! REFERENCE NUMBER - THIS IS MOVED DIRECTLY TO THE O/P AREA ! IT=IRDIRC(2*PR+1) ;! SET START OF CULHAM REF NO 00171400 COPYTEXT(IRTEXT,IT,OPLINE,1,4) ;! MOVE WEEK NUMBER OVER COPYTEXT(IRTEXT,IT+4,OPLINE,6,3) ;! MOVE ITEM NUMBER OPLINE(5)='/' WRBOP(OPUNIT,OPLINE,25,4) ;! O/P TO BULLETIN 00173600 WRLST(LSUNIT,OPLINE,8,4) ;! O/P TO LISTING UNIT SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR OUTPUT AREA 00173200 ! ! TITLE - REALIGNED BY WORD BEFORE OUTPUT ! NW=1 ;! INITIALISE WORD POINTER IT=IRDIRC(2*PT+1) ;! SET START OF TITLE 00155500 %IF IT=0 %THEN -> RET(1) ;! SKIP IF NULL ITEM 00137650 MXT=IRDIRC(2*PT+2)+IT-1 ;! SET LENGTH OF TITLE 00155700 MARKWORDS(IRTEXT,IT,MXT,NW) ;! MARK POSN + LENGTH OF WORDS NW=NW-1 ;! ADJUST WORD TOTAL OPST=6 ;! SET START OF 1ST O/P LINE RV=1 ;! SET RETURN VALUE -> CRLN ;! JUMP TO O/P TITLE ! ! AUTHORS - EDIT IN TEMPORARY ARRAY BEFORE O/P AS THEY ARE STORED ! IN A SPECIAL COMPACT FORM IN THE INTERNAL RECORD. ! RET(1):NW=1 ;! INITIALISE ITEM POINTER IT=IRDIRC(2*PA+1) ;! SET FIRST TEXT POINTER 00156800 %IF IT=0 %THEN -> RET(2) ;! SKIP IF NULL ITEM 00138850 MXT=IT+IRDIRC(2*PA+2)-1 ;! SET LENGTH OF THIS ITEM 00157000 TPOS=1 ;! INITIALISE TEMP ARRAY POINTER ABGN:%IF (MXT-IT+1)>MXLINE*2//3 %THENC 00175400 %START ;! IF AUTHOR TOO LONG COPYTEXT(IRTEXT,IT,TEMP,TPOS,MXT-IT+1) ;! SPLIT INTO TERMS MARKWORDS(TEMP,TPOS,TPOS+MXT-IT,NW) NW=NW-1 ;! ADJUST WORD COUNT IT=MXT+1 ;! INCREMENT TEXT POINTER 00175850 -> AEND %FINISH WBGN(NW)=TPOS ;! ELSE TREAT AUTHOR AS ENTITY AMOV:TEMP(TPOS)=IRTEXT(IT) ;! MOVE NEXT CHARACTER TPOS=TPOS+1 ;! INCREMENT TEMP ARRAY PTR %IF IRTEXT(IT)=ENDAUT %THENC %START ;! END OF AUTHOR SURNAME IT=IT+1 ;! UPDATE TEXT POINTER AINT: TEMP(TPOS)=IRTEXT(IT) ;! MOVE INITIALS IT=IT+1 ;! UPDATE POINTERS TO TEXT TPOS=TPOS+1 ;! AND TEMPORARY ARRAYS %IF IT>MXT %THEN -> ASET ;! EXIT IF END OF AUTHOR FOUND ! 00145900 ! A BLANK IS INSERTED BEFORE A CAPITAL LETTER UNLESS IT IS 00145925 ! IMMEDIATELY PRECEDED BY A SPECIAL CHARACTER OR MAC OR MC. 00145950 ! 00145975 %IF 'A'<=IRTEXT(IT)<='Z' %THENC 00146000 %START ;! NEXT CHARACTER IS CAPITAL 00146025 %IF 'A'<=TEMP(TPOS-1)<='Z' %ORC 00146050 SMA<=TEMP(TPOS-1)<=SMZ %THENC 00146075 %START ;! PRECEDED BY ALPHA-CHAR 00146100 %IF TEMP(TPOS-1)=SMC %THENC 00146125 %START ;! CHECK FOR MAC OR MC 00146150 %IF TEMP(TPOS-2)='M' %THEN -> AINT 00146175 %IF TEMP(TPOS-3)='M' %ANDC 00146200 TEMP(TPOS-2)=SMA %THEN -> AINT 00146225 %FINISH 00146250 TEMP(TPOS)=' ' ;! INSERT BLANK CHARACTER 00146275 TPOS=TPOS+1 ;! UPDATE POINTER 00146300 %FINISH 00146325 %FINISH 00146350 -> AINT ;! PROCESS NEXT CHARACTER %FINISH IT=IT+1 ;! UPDATE TEXT POINTER %IF IT<=MXT %THEN -> AMOV ;! CONTINUE TO END OF SURNAME ! ASET:WLNG(NW)=TPOS-WBGN(NW) ;! SET LENGTH OF EDITED AUTHOR AEND:WSPS(NW)=3 ;! ALLOW EXTRA SPACING 00178900 %IF IRTEXT(IT)\=0 %THENC %START ;! FURTHER AUTHORS NW=NW+1 ;! UPDATE ITEM POINTER MXT=IRTEXT(IT)+IT ;! SET LIMIT OF THIS AUTHOR IT=IT+1 ;! SET FIRST TEXT POINTER -> ABGN ;!PROCESS NEXT AUTHOR %FINISH ACRL:CREATELINE(OPLINE,TEMP,1,MXLINE,NW,LENGOP,IND) 00142000 WRBOP(OPUNIT,OPLINE,LENGOP,4) ;! O/P AUTHOR NAMES TO BULLETIN 00142050 WRLST(LSUNIT,OPLINE,LENGOP,4) ;! AND LISTING DEVICES 00142100 %IF IND=0 %THEN -> ACRL ;! CONTINUE TO END OF AUTHORS 00142150 ! ! BIBLIOGRAPHIC DETAILS ETC - FOR JOURNALS ONLY PAGINATION DETAILS ! ARE OUTPUT BUT FOR SPECIAL TYPE INPUT ALL SECTIONS ARE PRINTED. ! RET(2):NW=1 ;! RESET THE WORD POINTER ID=2*PB+1 ;! SET DIRECTORY POINTER 00162350 %IF JNUM>>24&X'FF'='Z' %THENC 00148000 %START ;! SPECIAL TYPE INPUT 00148010 RST=IRDIRC(ID)+IRDIRC(ID+1)+1 ;! STORE TEXT POINTER AND LENGTH 00180900 RLN=IRTEXT(RST-1) ;! OF REFERENCE NUMBER 00180950 IT=RST+RLN+1 ;! SET TEXT PTR AND ITEM LENGTH 00181000 INCT=IRTEXT(IT-1) ;! SKIPPING FIRST TWO ENTRIES 00181050 -> BCHK ;! JUMP TO PROCESS 00148050 %FINISH 00148060 !?? %START ;! JOURNAL OR PSEUDO-JOURNAL RST=0 ;! SET REF POINTER TO ZERO 00181750 IT1=IRDIRC(ID) ;! SET START OF FIRST ITEM 00163200 %IF IT1=0 %THEN -> BSKP ;! SKIP IF NULL ITEM 00142850 INCT=IRDIRC(ID+1) ;! SET LENGTH OF FIRST ITEM 00163400 BNXT: IT2=IT1+INCT ;! SET PTR TO LENGTH OF NEXT %IF IRTEXT(IT2)\=0 %THENC %START ;! NOT LAST ITEM IT1=IT2+1 ;! SET START OF NEXT ITEM INCT=IRTEXT(IT2) ;! SET LENGTH OF NEXT ITEM -> BNXT ;! CHECK NEXT %FINISH WBGN(NW)=IT1 ;! LAST ITEM IS PAGINATION WLNG(NW)=INCT ;! SET START AND LENGTH WSPS(NW)=2 ;! AND FOLLOW BY DOUBLE SPACE NW=NW+1 ;! UPDATE THE COUNT BSKP: ID=ID+2 ;! SET NEXT DIRECTORY POINTER 00164600 !?? %FINISH BMOV:IT=IRDIRC(ID) ;! SET PTR TO 1ST ITEM FROM DIR %IF IT=0 %THEN -> BEND ;! SKIP IF THERE ARE NO ENTRIES INCT=IRDIRC(ID+1) ;! SET LENGTH OF FIRST ITEM ! ! A LARGE ITEM IS PROCESSED WORD BY WORD, BUT WHERE POSSIBLE AN ! ITEM IS TREATED AS AN ENTITY OF ITSELF. ! BCHK:%IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC00154100 %START WBGN(NW)=IT ;! SET START AND WLNG(NW)=INCT ;! LENGTH OF ITEM NW=NW+1 ;! UPDATE POINTER %FINISH WSPS(NW-1)=2 ;! DOUBLE SPACE AT END 00183450 IT=IT+INCT+1 ;! SET START OF NEXT ITEM 00145650 INCT=IRTEXT(IT-1) ;! EXAMINE LENGTH OF NEXT ITEM 00145700 %IF INCT\=0 %THEN -> BCHK ;! CONTINUE IF NON-ZERO 00145800 BEND:ID=ID+2 ;! NO MORE ITEMS IN THIS SECTN %IF ID<=2*PN+1 %THEN -> BMOV ;! UPDATE AND CONTINUE 00166600 NW=NW-1 ;! ADJUST TOTAL WHEN END REACHED RV=3 ;! SET RETURN VALUE %IF NW>0 %THEN -> CRLN ;! O/P ANY ITEMS IF NECESSARY ! ! LANGUAGE DETAILS ARE SIMILAR TO BIBLIOGRAPHIC DETAILS EXCEPT ! THAT MULTIPLE ITEMS WILL NOT APPEAR. ! RET(3):NW=1 ;! RESET ITEM POINTER LMOV:IT=IRDIRC(ID) ;! SET START OF ITEM %IF IT=0 %THEN -> REND ;! SKIP IF NO ENTRY INCT=IRDIRC(ID+1) ;! SET LENGTH OF ITEM %IF INCT>MXLINE*2//3 %THEN MARKWORDS(IRTEXT,IT,IT+INCT-1,NW) %ELSEC00167700 %START ;! ITEM SUFFICIENTLY SMALL WBGN(NW)=IT ;! SET START AND WLNG(NW)=INCT ;! LENGTH OF ITEM NW=NW+1 ;! INCREMENT POINTER %FINISH WSPS(NW-1)=2 ;! FOLLOW BOTH BY DOUBLE SPACE 00185750 REND:ID=ID+2 ;! INCREMENT DIRECTORY POINTER %IF ID<=2*PD+1 %THEN -> LMOV ;! CONTINUE IF MORE ENTRIES 00168600 NW=NW-1 ;! ELSE ADJUST ITEM TOTAL RV=4 ;! SET RETURN VALUE %IF NW<=0 %THEN -> RET(4) ;! SKIP O/P IF NO ITEMS ! ! OUTPUT IS CREATED AND 'WRITTEN' A LINE AT A TIME ! CRLN:CREATELINE(OPLINE,IRTEXT,OPST,MXLINE,NW,LENGOP,IND) 00149200 WRBOP(OPUNIT,OPLINE,LENGOP,4) ;! O/P TO BULLETIN WRLST(LSUNIT,OPLINE,LENGOP,4) ;! O/P TO LISTING DEVICE OPST=1 ;! ENSURE O/P LINED UP %IF IND=0 %THEN -> CRLN ;! CONTINUE IF END NOT REACHED 00139000 -> RET(RV) ;! RETURN TO APPROPRIATE POSN ! ! RECORD NOW OUTPUT - RETURN CONTROL TO CALLING ROUTINE ! RET(4):SET(OPLINE,1,MXLINE,BLNK) ;! CLEAR OUTPUT AREA 00150100 %IF RST\=0 %THENC 00188830 %START ;! NON-JOURNAL I/P - ADD REF 00188860 I=MXLINE-RLN+1 ;! SET START POS OF REF IN O/P 00188420 COPYTEXT(IRTEXT,RST,OPLINE,I,RLN) ;! MOVE REFERENCE TO O/P AREA 00188430 WRBOP(OPUNIT,OPLINE,MXLINE,4) ;! O/P TO BULLETIN 00188460 WRLST(LSUNIT,OPLINE,MXLINE,5) ;! O/P TO LISTING 00188500 %FINISH %ELSE WRLST(LSUNIT,OPLINE,MXLINE,4) 00189250 SET(OPLINE,1,MXLINE,0) ;! ZEROISE OUTPUT AREA 00150160 WRBOP (OPUNIT,OPLINE,20,4) ;! OUTPUT BLANK TAPE 00159100 ! %END ;! OUTPUTITEM ! ! ********************************************************************* ! %ROUTINE MARKWORDS(%BYTEINTEGERARRAYNAME ARR, %INTEGER ST,MAX, %C %INTEGERNAME NW) ! ! ROUTINE CALLS MARKWORD STORES THE RESULT AND UPDATES THE POINTER 00171400 ! %INTEGER NB ;! START OF WORD %INTEGER NL ;! LENGTH OF WORD %INTEGER NS ;! NUMBER OF SPACES TO FOLLOW ! MKWD:MARKWORD(ARR,MAX,NB,NL,NS,ST) %IF NB=0 %THEN %RETURN ;! RETURN WHEN END REACHED WBGN(NW)=NB WLNG(NW)=NL ;! STORE WORD DETAILS WSPS(NW)=NS NW=NW+1 ;! UPDATE WORD POINTER -> MKWD ;! JUMP TO FIND NEXT WORD ! %END ;! MARKWORDS ! ! ********************************************************************* ! %ROUTINE MARKWORD (%BYTEINTEGERARRAYNAME ARR, %INTEGER MXA, %C %INTEGERNAME ST,LN,SP,IA) ! ! THIS ROUTINE FINDS THE START AND LENGTH OF THE NEXT SEQUENCE OF ! NON-BLANK CHARACTERS IN THE ARRAY ARR(MXA) STARTING FROM THE ! POSITION IA. IF A SEQUENCE IS FOUND, ST IS SET TO THE VALUE OF ! IA WHEN THE FIRST CHARACTER IS FOUND, LN IS SET TO THE LENGTH OF ! THE WORD AND SP TO THE NUMBER OF SPACES WHICH ARE TO FOLLOW IT. 00192800 ! (SP DEPENDS ON THE LAST CHARACTER OF THE SEQUENCE) ON EXIT IA ! POINTS IMMEDIATELY PAST THE LAST CHARACTER OF THE SEQUENCE. ! %INTEGER IND ;! SWITCH VARIABLE %SWITCH S1,S2(1:2) ! ST=0 ;! SET START VALUE TO ZERO IND=1 ;! SET SWITCH VARIABLE -> CHCK ;! JUMP TO CHECK FIRST CHAR ! S1(1):S2(2):IA=IA+1 ;! INCREMENT POINTER CHCK:%IF IA > MXA %THENC %START ;! END OF ARRAY REACHED %IF ST=0 %THEN %RETURN ;! ERROR EXIT IF NO WORD FOUND -> S1(2) ;! ELSE SET LENGTH ETC. %FINISH %IF ARR(IA)=' ' %THEN -> S1(IND) ;! JUMP IF BLANK FOUND 00144600 -> S2(IND) ;! TO S1 ELSE JUMP TO S2 ! ! WHEN FIRST NON-BLANK FOUND THE SWITCH VARIABLE IS ALTERED SO THAT ! THE NEXT BLANK FOUND ACTS AS A TERMINATOR TO THE WORD. ! S2(1):IND=2 ;! CHANGE INDICATOR ST=IA ;! STORE START VALUE OF IA -> S1(1) ;! CONTINUE ! ! THE FIRST BLANK CHARACTER FOUND AFTER ANY NON-BLANK TERMINATES ! THE CURRENT WORD AND LENGTH ETC. MUST BE CALCULATED. ! S1(2):LN=IA-ST ;! SET LENGTH OF WORD %IF ARR(IA-1)='.' %THEN SP=2 %ELSE SP=1 ;! CALCULATE SPACING ! %END ;! MARKWORD ! ! ********************************************************************* ! %ROUTINE COPYTEXT(%BYTEINTEGERARRAYNAME SOURCE,%INTEGER SSTRT, %C %BYTEINTEGERARRAYNAME DEST,%INTEGER DSTRT,L) ! ! MOVES L BYTES FROM SOURCE(SSTRT) ET SEQ. TO DEST(DSTRT) ET SEQ. %INTEGER I ! %IF L<= 0 %THEN %RETURN %CYCLE I=SSTRT,1,SSTRT+L-1 DEST(DSTRT)=SOURCE(I) DSTRT=DSTRT+1 %REPEAT %END;! COPYTEXT ! ! ********************************************************************* ! %ROUTINE SET(%BYTEINTEGERARRAYNAME A,%INTEGER START,END,VAL) ! ! ROUTINE SETS A(START) TO A(END) TO THE LEAST SIGNIFICANT EIGHT ! BITS OF THE VALUE HELD IN VAL. ! %INTEGER I ! %CYCLE I=START,1,END A(I)<-VAL %REPEAT %END;! SET ! ! ********************************************************************* ! %ROUTINE SORT (%INTEGERARRAYNAME AX,PTR, %INTEGER P1,P2,N) %INTEGERFNSPEC SIGN(%INTEGERARRAYNAME AX, %INTEGER K1,K2,N) %INTEGERARRAY UT(1:20), LT(1:20) %INTEGER Q,M,P,T,X,I,J,K ! I=P1 J=P2 ;! INITIALISE ARRAY VARIABLES M=1 ! START: %IF J-I < 1 %THEN -> ENDCHK %IF J-I = 1 %THEN -> LSTCHK ! P=(J+I)//2 ;! SET MID-POINT T=PTR(P) PTR(P)=PTR(I) Q=J K=I+1 ! NEXT:%IF SIGN(AX,PTR(K),T,N) > 0 %THENC %START LIMCHK: %IF Q CHANGE %FINISH %IF SIGN(AX,PTR(Q),T,N) < 0 %THENC %START ;! SWOP POINTERS X=PTR(K) PTR(K)=PTR(Q) PTR(Q)=X Q=Q-1 %FINISH %ELSEC %START Q=Q-1 -> LIMCHK %FINISH %FINISH K=K+1 %IF K <= Q %THEN -> NEXT ! CHANGE:PTR(I)=PTR(Q) PTR(Q)=T %IF Q > P %THENC %START LT(M)=I UT(M)=Q-1 I=Q+1 %FINISH %ELSEC %START LT(M)=Q+1 UT(M)=J J=Q-1 %FINISH M=M+1 -> START ! LSTCHK:%IF SIGN(AX,PTR(I),PTR(J),N) > 0 %THENC %START X=PTR(I) PTR(I)=PTR(J) PTR(J)=X %FINISH ! ENDCHK:M=M-1 %IF M> 0 %THENC %START I=LT(M) J=UT(M) -> START %FINISH ! ! ********************************************************************* ! %INTEGERFN SIGN (%INTEGERARRAYNAME AX, %INTEGER K1,K2,N) %RESULT = AX(K1) - AX(K2) %END ;! SIGN %END ;! SORT %END %ENDOFPROGRAM