%BEGIN ! ! TEST PROGRAM FOR RDSDI AND CHECK ON SDI FILE PRODUCED BY LIBRIP ! %ROUTINESPEC RDSDI(%INTEGERNAME UNIT,BLOCK,POSN,NO) ! !?? SHORT; %INTEGERARRAY IRDIRC(1:32) ;! RECORD DIRECTORY %BYTEINTEGERARRAY IRTEXT(1:500) ;! RECORD TEXT ! %INTEGER CHECK ;! CJECK INDICATOR %INTEGER YES ;! CONSTANT %INTEGER MXDIRC ;! DIRECTORY SIZE %INTEGER MXBUFS ;! I/O BUFFER SIZE %INTEGER MXCNTB ;! CONTROL BUFFER SIZE 00001350 %INTEGER I ;! LOOP VARIABLE %INTEGER BLOCK ;! BLOCK CONTAINING START OF REC %INTEGER POSN ;! POSITION IN BLOCK %INTEGER NO ;! ENTRY NUMBER INDICATOR %INTEGER UNIT ;! SDI UNIT NUMBER %INTEGER IN ;! NEXT ACTION INDIC %INTEGER WEEKNO ;! CURRENT WEEK NUMBER ! %SWITCH ENTRY(1:3),NEXT(1:2) ! CHECK=0 ;! NO CHECK REQUIRED YES=1 ;! SET CONSTANT MXDIRC=32 ;! SET DIRECTORY LIMITS MXBUFS=1000 ;! SET BUFFER SIZE 00002700 MXCNTB=500 ;! SET SIZE OF CONTROL BUFFER 00002750 UNIT=10 ;! SET SDI UNIT NUMBER WEEKNO=140 ;! SET A WEEK NUMNER IN=1 ;! INITIALISE NEXT SWITCH ! NEXT(1):RDSDI(UNIT,BLOCK,POSN,NO) ;! READ NEXT RECORD -> ENTRY(NO) ;! JUMP DEPENDING ON ENTRY ! ENTRY(1):NEWPAGE PRINTSTRING('CONTENTS OF SDI FILE') NEWLINE PRINTSTRING('********************') ! ENTRY(2):NEWLINES(2) %CYCLE I=1,1,MXDIRC WRITE(IRDIRC(I),3) %REPEAT NEWLINE %CYCLE I=1,1,IRDIRC(2) %IF IRTEXT(I)<' ' %THEN WRITE(IRTEXT(I),2) %ELSEC PRINT SYMBOL(IRTEXT(I)) %REPEAT -> NEXT(IN) ! ENTRY(3):IN=2 -> ENTRY(2) ! NEXT(2):NEWLINES(2) PRINTSTRING('ALL RECORDS OUTPUT') NEWLINE PRINTSTRING(' *** **** *** ') %STOP ! ! ********************************************************************* ! %ROUTINE RDSDI (%INTEGERNAME UNIT,BLOCK,POSN,NO) ! ! THIS ROUTINE CONTROLS THE INTERFACE BETWEEN THE PROCESSING ! ROUTINE AND THE CURRENT S.D.I. FILE. THE NEXT RECORD IS ! TRANSFERRED FROM THE DISC(UNIT) TO THE DIRECTORY AND TEXT ! ARRAYS AS REQUIRED. ON EXIT FROM THE ROUTINE BLOCK IS SET ! TO THE SECTOR NUMBER CONTAINING THE START OF THIS RECORD AND ! POSN IS SET TO THE BYTE POSITION WITHIN THIS SECTOR OF THE ! START OF THE RECORD. NO IS SET TO 1 AFTER THE FIRST ENTRY ! TO RDSDI AND THEREAFTER TO 2 UNTIL THE LAST RECORD IS ! TRANSMITTED WHEN IT IS SET TO 3. ! %EXTERNALROUTINESPEC OPENDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC CLOSEDA (%INTEGER CHANNEL) %EXTERNALROUTINESPEC READDA(%INTEGER CHANNEL, %INTEGERNAME SECT,%C %NAME BEGIN,END) %OWNBYTEINTEGERARRAY BUFA(1:1000) ;! 1ST INPUT BUFFER 00007800 %OWNBYTEINTEGERARRAY BUFB(1:1000) ;! 2ND INPUT BUFFER 00007900 !?? SHORT; %INTEGERARRAY CNTBUF(1:500) ;! CONTROL BLOCK I/P AREA !?? 00008000 ! %OWNINTEGER BUFNO=1 ;! DOUBLE BUFFERING CONTROL %OWNINTEGER IB=1 ;! BUFFER POINTER %OWNINTEGER LASTIB ;! NEXT SPARE BYTE IN LASTSEC %OWNINTEGER LASTSEC ;! LAST OCCUPIED SECTOR %OWNINTEGER NUM=1 ;! ENTRYPOINT CONTROL %OWNINTEGER SECTOR=2 ;! CURRENT SECTOR NUMBER ! %INTEGER I ;! LOOP VARIABLE %INTEGER LIMIT ;! MAX SIZE OF TEXT ARRAY %INTEGER SECT ;! SECTOR TO BE READ FROM DISC %INTEGER START ;! START POS IN INTERNAL REC ! %SWITCH BUFFER(1:2) ;! BUFFER PROCESSING %SWITCH ENTRY(1:3) ;! ENTRYPOINTS ! ! JUMP TO APPROPRIATE ENTRYPOINT ! -> ENTRY(NUM) ! ! 1ST ENTRY - OPEN FILE AND READ CONTROL BLOCK (SECTOR=1). IF ! REQUIRED CHECK THE WEEK NUMBER, SET UP BOUBLE BUFFERING. ! ENTRY(1):OPENDA(UNIT) ;! OPEN FILE SECT=1 ;! READ CONTROL BLOCK READDA(UNIT,SECT,CNTBUF(1),CNTBUF(MXCNTB)) 00010600 SECT=2 ;! FILL FIRST BUFFER READDA(UNIT,SECT,BUFA(1),BUFA(MXBUFS)) 00010800 %IF CHECK=YES %THENC %START ;! WEEK NUMBER CHECK %IF WEEKNO\=CNTBUF(1) %THENC %START ;! INVALID WEEK NUMBER NEWLINE ;! O/P MESSAGE PRINTSTRING('WEEK NUMBERS DO NOT AGREE') NEWLINE PRINTSTRING('WEEK') WRITE(WEEKNO,3) PRINTSTRING(' REQUESTED') NEWLINE PRINTSTRING('WEEK') WRITE(CNTBUF(1),3) PRINTSTRING(' ON THIS DISC') NEWLINES(2) PRINTSTRING('... JOB TERMINATED ...') %STOP ;! TERMINATE JOB %FINISH %FINISH %ELSEC WEEKNO=CNTBUF(1) ;! STORE WEEK NUMBER OF FILE LASTSEC=CNTBUF(2) ;! STORE LAST SECTOR NUMBER LASTIB=CNTBUF(3) ;! AND POSITION WITHIN IT NUM=2 ;! CHANGE ENTRYPOINT NO=1 ;! SET FIRST ENTRY INDICATOR SECT=3 ;! FILL SECOND BUFFER READDA(UNIT,SECT,BUFB(1),BUFB(MXBUFS)) 00013400 -> ENTRY2 ! ! NORMAL ENTRY - THE NEXT RECORD IS TRANSFERRED FROM THE CURRENT ! BUFFER TO THE DIRECTORY AND TEXT ARRAYS IN THE CALLING ROUTINE ! THE BUFFERS BEING REFILLED AS NECESSARY. ! ENTRY(2):NO=2 ;! SET INDICATOR TO NORMAL ENTRY2: BLOCK=SECTOR ;! RETURN CURRENT SECTOR POSN=IB ;! RETURN START POSITION START=1 ;! SET STARTING POINT IN RECORD -> BUFFER(BUFNO) ;! JUMP TO CURRENT BUFFER ! BUFFER(1):LIMIT=INTEGER(ADDR(BUFA(IB+2))) ;! SIZE OF TEXT ARRAY !?? WAS SHORTINTEGER DIRCA1: %CYCLE I=START,1,MXDIRC ;! TRANSFER TO DIRECTORY IRDIRC(I)=INTEGER(ADDR(BUFA(IB))); !?? WAS SHORTINTEGER IB=IB+2 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFS %THENC %START ;! END OF BUFFER REACHED SECT=SECTOR+2 ;! CALC NEXT SECTOR NUMBER %IF SECT<=LASTSEC %THENC READDA (UNIT,SECT,BUFA(1),BUFA(MXBUFS)) IB=1 ;! RESET BUFFER POINTER BUFNO=2 ;! CHANGE BUFFER SWITCH SECTOR=SECTOR+1 ;! UPDATE CURRENT SECTOR -> TEXTB1 %IF I>=MXDIRC ;! JUMP IF DIRECTORY COMPLETE START=I+1 ;! SET NEW STARTING POINT -> DIRCB1 ;! PROCESS NEXT BUFFER %FINISH %REPEAT ! TEXTA1: START=1 ;! SET TEXT STARTING POINT TEXTA2: %CYCLE I=START,1,LIMIT ;! TRANSFER TO TEXT ARRAY IRTEXT(I)=BUFA(IB) IB=IB+1 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFS %THENC %START ;! END OF BUFFER REACHED SECT=SECTOR+2 ;!CALC NEXT SECTOR NUMBER %IF SECT<=LASTSEC %THENC READDA(UNIT,SECT,BUFA(1),BUFA(MXBUFS)) IB=1 ;! RESET BUFFER POINTER BUFNO=2 ;! CHANGE BUFFER SWITCH SECTOR=SECTOR+1 ;! UPDATE CURRENT SECTOR %IF I>=LIMIT %THEN -> RETRN;! JUMP IF TEXT COMPLETED START=I+1 ;! SET NEW STARTING POINT ->TEXTB2 ;! PROCESS NEXT BUFFER %FINISH %REPEAT -> RETRN ! BUFFER(2):LIMIT=INTEGER(ADDR(BUFB(IB+2))) ;! SIZE OF TEXT ARRAY !?? WAS SHORTINTEGER DIRCB1: %CYCLE I=START,1,MXDIRC ;! TRANSFER TO DIRECTORY IRDIRC(I)=INTEGER(ADDR(BUFB(IB))); !?? WAS SHORTINTEGER IB=IB+2 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFS %THENC %START ;! END OF BUFFER REACHED SECT=SECTOR+2 ;! CALC NEXT SECTOR NUMBER %IF SECT<=LASTSEC %THENC READDA (UNIT,SECT,BUFB(1),BUFB(MXBUFS)) IB=1 ;! RESET BUFFER POINTER BUFNO=1 ;! CHANGE BUFFER SWITCH SECTOR=SECTOR+1 ;! UPDATE CURRENT SECTOR -> TEXTA1 %IF I>=MXDIRC ;! JUMP IF DIRECTORY COMPLETE START=I+1 ;! SET NEW STARTING POINT -> DIRCA1 ;! PROCESS NEXT BUFFER %FINISH %REPEAT ! TEXTB1: START=1 ;! SET TEXT STARTING POINT TEXTB2: %CYCLE I=START,1,LIMIT ;! TRANSFER TO TEXT ARRAY IRTEXT(I)=BUFB(IB) IB=IB+1 ;! INCREMENT BUFFER POINTER %IF IB>MXBUFS %THENC %START ;! END OF BUFFER REACHED SECT=SECTOR+2 ;!CALC NEXT SECTOR NUMBER %IF SECT<=LASTSEC %THENC READDA(UNIT,SECT,BUFB(1),BUFB(MXBUFS)) IB=1 ;! RESET BUFFER POINTER BUFNO=1 ;! CHANGE BUFFER SWITCH SECTOR=SECTOR+1 ;! UPDATE CURRENT SECTOR %IF I>=LIMIT %THEN -> RETRN;! JUMP IF TEXT COMPLETED START=I+1 ;! SET NEW STARTING POINT ->TEXTA2 ;! PROCESS NEXT BUFFER %FINISH %REPEAT ! ! BEFORE RETURNING CONTROL THE ROUTINE CHECKS FOR END OF FILE ! RETRN: %IF SECTOR