(George Source)
Macros used: ACROSS, ALTLEND, BFCBX, BITDEFS, BS, BXE, BXU, CHECKA, DOWN, FOUTMOVE, FREEBAX, FREECORE, FSHSKIP, GEOERR, JBC, JBS, LINK, MBS, MENDAREA, MFREEW, MHUNTW, NAMEX, PSTAC, RELOFP, REPMON, RV, SEG, SEGENTRY, SETBIT, SUBCUBS, TESTMON, TESTREP2, TESTRPN2, TOPCA, TOPCA1, TOPFCA, TOPFCA2, TOPFCAB2, TOPFCB2, WHATBACK
223S ... SEG MTSTART,8,FILE,OLP 225L ... SEGENTRY K1MTSTART,ZFIRSTPERI[ENTRY TO PROCESS FIRST RERI ON FILE 227D ... SEGENTRY K2MTSTART,RENAMEPERI[ENTRY FOR RENAME PERI FROM MTOBJ 229= ... SEGENTRY K4MTSTART,ZCLOSEPERI[ENTRY FOR CLOSE PERI FROM MTOBJ 22?4 ...[ 22#W ...[ THIS SEGMENT IMPLEMENTS THE FIRST OBJECT PROGRAM PERI ON 22BN ...[ A MAGNETIC TAPE FILESTORE FILE, A LINK TO K1MTSTART BEING SET IN 22DG ...[ THE AOLPT BY ASSIGN WHEN IT IS SET UP BY AN ASSIGN COMMAND OR AN 22G# ...[ ASSILO MACRO (IN THE RETAINED LOAD PERIPHERAL CASE). 22J6 ...[ IT EXITS TO MTOBJ IF THE FILE IS ALREADY OPEN (FOR ALLOT PURPOSES) 22KY ...[ I.E. IF THE GIVE QUALIFIER HAS BEEN USED AND IN THE ASSILO CASE, 22MQ ...[ OR IF THE PERI IS NOT AN OPEN PERI, HAVING FIRST POSITIONED THE FILE 22PJ ...[ AFTER THE FIRST RECORD (USUALLY A HEADER LABEL) IF IT HAS NOT YET 22RB ...[ BEEN POSITIONED (I.E. ALL CASES EXCEPT ASSILO) 22T8 ...[ OTHERWISE IF THE FIRST PERI IS AN OPEN FOR READING PERI THE FILE 22X2 ...[ IS POSITIONED AFTER THE FIRST RECORD AND MTOBJ ENTERED TO SET 22YS ...[ THE REPLY WORD, OR IF THE PERI IS "OPEN FOR WRITING" (INCLUDING MODE 232L ...[ #300 ON AN EMPTY FILE) THE FILE IS EMPTIED AND A HEADER LABEL IS 234D ...[ WRITTEN TO THE FILE WHICH IS THEN POSITIONED AFTER IT BEFORE ENTERING 236= ...[ MTOBJ TO SET THE REPLY WORD 2384 ...[ 239W ...[ THE SEGMENT IS ALSO ENTERED AT K2MTSTART BY ACROSS FROM MTOBJ 23?N ...[ WHEN A RENAME PERI IS ENCOUNTERED. AFTER CHECKING FOR A MONITOR 23*G ...[ EVENT ALL EXISTING USAGE BLOCKS ARE FREECORED (INCLUDING WRITE BLOCKS) 23C# ...[ AND THE SUBSEQUENT PATH IS SIMILAR TO AN "OPEN FOR WRITING PERI. 23F6 ...[ 23GY ...[ THE K4MTSTART ENTRY POINT IS ENTERED ACROSS FROM MTOBJ WHEN 23JQ ...[ A CLOSE OR UNLOAD PERI IS ENCOUNTERED & SIMPLY RELEASES THE 23LJ ...[ PERIPHERAL CHANNEL AFTER CHECKING FOR A MONITOR EVENT. USAGE BLOCKS 23NB ...[ WILL BE CLEARED UP BY CLOSE. 23Q8 ...[ 23S2 ...[ 23TS ...[ FOR FORMAT OF MT FILESTORE FILES SEE PRM 5.5.3.2 23XL ...[ FREADWORD : B0-11 :INDEX BLOCKLET POINTER RELATIVE TO FBLKS*BLN 23^D ...[ B12-23:WORD POINTER WITHIN INDEX BLOCKLET 243= ...[ 2454 ...[ THIS SEGMENT PERFORMS NO BACKING STORE TRANSFERS BUT USES MTOBJ 246W ...[ AND MTCODE TO SET UP INDEX BUFFERS & RELIES ON MTOBJ TO 248N ...[ FREE THEM (EXCEPT IN THE RENAME CASE). 24=G ...[ 24## ...[ IT IS ASSUMED THAT COMMUNAL WRITING IS PROHIBITED 24B6 ...[ 24D6 [ 24PS ...ZFINDEX [ DO ) BUFFER 253G ...#HAL FINDEX+FILE,0 [ ) 25*8 ...ZFINDEXW [ ) BLOCK 25LW ...#HAL FINDEXW+FILE,0 [ NOT ) 25YJ ...#HAL FILE+FURB,0 [ ) TYPES 26== ...#HAL FILE+FUWB,0 [ DISTURB ) 26HY ...[ 26TL ... BITDEFS AWORK4,0,NOTOPENMODE,,,MODE3C,OUTPUT,RENAME,SCRATCH 277# ...[ 27F2 ...OWNMON #34000 [OPEN PERI ADDITIVE MODE (IGNORED) 27QN ...[ 284B ...MODE100 #100 [OPEN FOR READING & WRITING 28B4 ... [ WPR IRRELEVANT 28MQ ...MODE200 #200 [OPEN FOR READING : NO WPR 28^D ...MODE300 #300 [OPEN FOR READING & WRITING 29?6 ... [ WPR NEEDED 29JS ...MODE400 #400 [OPEN FOR OUTPUT 29WG ...MODE600 #600 [OPEN SCRATCH TAPE 2=88 ...[ 2=FW ...TSN 4H TSN [REPLY WORD FOR OPEN PERIS 2=RJ ...[ 2?5= ...[ SCRATCH TAPE HEADER LABEL 2?BY ...THEAD 0,24HHDDRHDDR TSNSCRATCH TAPE,0,0,0,0,0 [ DO ) 2?NL ...#REP 10 [ ) 2#2# ... +0 [ NOT ) 2##2 ...THDDR 4HHDDR [ ) 2#KN ...TEND 4HEND [ DISTURB ) 2#XB ...[ 2*9B TMARK 4HMARK 2*P2 ...[ 2B8L ...ZFEXTRA 2BN= ...#HAL FILE+FEXTRA,0 2C7W ...[ 2CMG ...[ LINKS FOR TOPCA 2D76 ...STARTLINK 2DLQ ... LINK MTSTART,1 2F6B ...OBJLINK 2FL2 ... LINK MTOBJ,1 2G5L ...[ 2GK= ...[ 2H4W ...TOPCA [CHANGE CURRENT ACTIVITY TO APET 2HJG ...[ ON ENTRY X1->LINK TO BE LEFT IN AOLPT 2J46 ... TOPCA1 0(1) 2JHQ ... EXIT 4 0 2K3B ...[ 2KH2 ...[ 2L2L ...TESTMON [EXIT IF MONITOR OFF : REPORT EVENT IF MONITOR ON 2LG= ...[ EXPECTS X5=MONITOR TYPE & X2=FX2 2L^W ... SBX 6 FX1 6Y8G TESTMON APETADDR(2),5,FTYPNO(2),XMONITOR 6^MB ADX 6 1 6^M^ ... EXIT 6 0 [MONITOR OFF 6^NJ ...[ 6^P7 ...XMONITOR [MONITOR ON 6^PQ ... ADN 1 OBJLINK [LEAVE LINK TO K1MTOBJ 6^Q* ... LDX 6 FTYPNO(2) [PERIPHERAL TYPE/MODE FOR REPMON 6^QY ... LDX 7 ACAP(2) [PROGRAM CONTROL AREA ADDRESS 6^RH ... CALL 4 TOPCA 6^S6 ... REPMON 1 [REPORT MONITOR EVENT 6^SP ...[ 6^T# ...[ 6^TX ...SINDEX [GET POINTER TO 1ST INDEX BLOCKLET IN X3 6^WG ...[ EXPECTS & LEAVES X1=FX1,X2=FX2 6^X5 ...[ DESTROYS X4; LINK X6 6^XN ... TOPFCA2 3 [X3->FCA 6^Y? ... PSTAC 3,3 [X3->FSTACK 6^YW ... BFCBX 2,3 [X2->FCB 6^^F ... LDX 4 FBLKS(2) [GET 1ST BLKLT NO. IN FILE 7224 ... LDX 2 FX2 722M ...NEXTBL 723= ... LDX 3 FPTR(3) [GET NEXT BLOCK 723T ... BXE 3 CXFI,NOTFOUND [EXIT IF END OF FILE CHAIN 724D ... LDX 0 ATYPE(3) 7253 ... BXE 0 FFSFCB,NOTFOUND [EXIT IF NEXT FCB 725L ... BXE 0 ZFEXTRA(1),NOTFOUND [END OF !RING 7269 ... BXE 0 ZFINDEX(1),PHOUND [MT INDEX BLKLT FOUND 726S ... BXU 0 ZFINDEXW(1),NEXTBL [TRY NEXT BLOCK IF NOT MT INDEX BLKLT 727C ...PHOUND 7282 ... BXE 4 BACK2(3),(6) [EXIT IF 1ST INDEX BLKLT FOUND 728K ... BRN NEXTBL [ELSE TRY NEXT BLOCK 7298 ...NOTFOUND 729R ... SBX 6 FX1 72=B ... DOWN MTOBJ,7 [READ 1ST INDEX BLKLT FROM BS 72=^ ... LDN 3 FYILLINS 72?J ... TESTRPN2 OK,QERROR [J IF FAILED OR CORRUPT 72#7 ... ADX 6 FX1 72#Q ... BRN SINDEX [START AGAIN TO LOCATE BLKLT 72** ...[ 72*Y ...[ 72BH ...ZCLOSEPERI [ENTRY FROM MTOBJ FOR CLOSE PERI 72C6 ...[ 72CP ... LDN 5 BBCLOSE 72D# ... CALL 6 TESTMON 72DX ... RELOFP FTYPNO(2) [MONITOR OFF : RELEASE CHANNEL 72FG ...[ 72G5 ...[ 72GN ...ZFIRSTPERI [INITIAL ENTRY POINT : SET BY ASSIGN 72H? ...[ 72HW ... STOZ AWORK4(2) [SWITCH WORD 72JF ... LDX 0 GIVE(2) 72K4 ... BNG 0 NOTOPEN [J IF GIVE QUALIFIER SPECIFIED 72KM ... LDX 4 EVENT4(2) [TYPE-MODE WORD 72L= ... ANDX 4 BSP16 [B9-23 72LT ... LDX 0 OWNMON(1) 72MD ... ANDX 0 4 72N3 ... BZE 0 NOOWN [J. IF #34000 MODE NOT PRESENT 72NL ... ERX 0 OWNMON(1) [CHECK IF #34000 OR SOME OTHER MODE 72P9 ... BNZ 0 NOTOPEN [J. IF NOT AN OPEN MODE AT ALL 72PS ... ERX 4 OWNMON(1) [REMOVE #34000 FROM THE MODE WORD 72QC ...NOOWN 72R2 ... BXE 4 MODE300(1),YESMODE300 72RK ... BXE 4 MODE100(1),WPR 72S8 ... BXU 4 MODE200(1),MORECH 72SR ... JBC WPR,FILERING(2),BAMWRITE 72TB ... LDN 3 FYMODER [MODE 200 ILLEGAL IF OPEN FOR WRITING 72T^ ... BRN QERROR 72WJ ...[ 72X7 ...YESMODE300 72XQ ... BS 2,MODE3C [I.E. MODE 300 72Y* ... BRN NOTMODE 72YY ...[ 72^H ...MORECH 7326 ... BXE 4 MODE400(1),NOTMODE 732P ... BXU 4 MODE600(1),NOTOPEN [J IF NOT AN OPEN MODE 733# ... BS 2,SCRATCH 733X ... BRN NOTMODE 734G ...[ 7355 ...[ NOT AN OPEN PERI 735N ...NOTOPEN 736? ... BS 2,NOTOPENMODE 736W ... TOPFCAB2 1,2 [X1->FCA; X2->FCB 737F ... LDX 0 FBLMOD(2) 7384 ... SBN 0 FBLKS-A1 738M ... BNZ 0 POSITION [J. IF NOT EMPTY 739= ... LDN 3 FYENDFILE 739T ... JBC QERROR,1,BAMWRITE [OPEN EMPTY FILE FOR READING:ILLEGAL 73=D ... LDN 3 FLOC1(2) 73?3 ... SMO FX2 73?L ... LDN 4 ACA3 73#9 ... MOVE 3 3 [SET UP THE FILE NAME IN ACA3,4,5 73#S ... BRN NOTOPEMP 73*C ...[ 73B2 ...RENAMEPERI [ENTRY FROM MTOBJ FOR RENAME PERI 73BK ...[ 73C8 ... LDN 5 BBRENAME 73CR ... CALL 6 TESTMON 73DB ... STOZ AWORK4(2) [MONITOR OFF 73D^ ... BS 2,RENAME 73FJ ...[ 73G7 ...NOTMODE [EMPTY THE FILE IF RENAME,MODE 400 OR 600 73GQ ...[ 73H* ... BS 2,OUTPUT 73HY ... LDN 3 FYNOWRITE 73JH ... JBC QERROR,FILERING(2),BAMWRITE [MODES 300,400,500,600 ILLEGA 73K6 ... [UNLESS FILE OPEN FOR WRITING 73KP ...WPR LDN 5 9 [CHECK 9 WORDS EVEN IF MODE 500 OR 60 73L# ... CHECKA ACAP(2),5,RV,APETADDR(2),,QCOOR,,,K1MTSTART 73LX ...QCOOR [CHECK CONTROL AREA 73MG ... LDX 6 ACAP(2) 73N5 ... LDN 7 ACA1(2) 73NN ... FOUTMOVE APETADDR(2),6,7,5,HLOCK1,2 [MOVE CONTROL AREA TO ACA1 - A 73P? ... JBC NOUT,2,OUTPUT [J TO POSITION IF MODE 100 OR 200 73PW ... JBS NOUT,2,MODE3C [J TO POSITION FILE IF MODE 300 73QF ... JBC NOTOPEMP,2,RENAME [J UNLESS RENAME 73R4 ...MORE [RENAME : FILE EMPTIED - FREE ALL USAGE BLOCKS 73RM ... TOPFCA2 3 73S= ... PSTAC 3,3 73ST ...MOREBLKS 73TD ... LDX 3 FPTR(3) [GET NEXT BLOCK 73W3 ... BXE 3 CXFI,NOTOPEMP [J IF NO MORE USAGE BLOCKS 73WL ... LDX 0 ATYPE(3) 73X9 ... BXE 0 FFSFCB,NOTOPEMP [J IF NO MORE USAGE BLOCKS 73XS ... BXE 0 ZFEXTRA(1),NOTOPEMP [ DITTO (WORKFILE) 73YC ... LDN 4 5 73^2 ...MORETY 73^K ... SBN 4 1 7428 ... BZE 4 MOREBLKS [J TO TRY NEXT BLOCK IN CHAIN 742R ... SMO 4 743B ... BXU 0 ZFINDEX-1(1),MORETY [TRY EACH USAGE BLOCK TYPE IN TURN 743^ ... FREECORE 3 744J ... BRN MORE 7457 ...[ 745Q ...NOTOPEMP 746* ... TOPFCA 3 746Y ... SUBCUBS 3,FILE,JOB [REMOVE FILE FROM CUBS 747H ...Z300 [MODE 300 ON EMPTY FILE MUST 7486 ... TOPFCB2 2 [ WRITE A HEADER LABEL 748P ... MBS 2,BFALTR,BFALTB 749# ... LDN 0 FBLKS-A1 749X ... STO 0 FBLMOD(2) 74=G ... STOZ BULKMOD(2) [ EMPTY FILE 74=N ... FSHSKIP B,NOTIFINB 74=W ...( 74?5 ...#SKI 0 [CODE FOLLOWING WAS TO ENSURE MT FILES HAD AT LEAST 74?N ...( [64 BLOCKS - PROBABLY UNNECESSARY NOW 74#? ...[ (TO ASSIST BS ALLOCATION SYSTEM) 74#W ... SBX 0 FUSEBL(2) 74*F ... BZE 0 NOBLOCKS [J IF NO BLOCKS IN FCB 74B4 ... ADN 0 AMTFLSZ [GOT ENUFF IF >AMTFLSZ 74BM ... BNG 0 NALRDY 74C= ... SBN 0 AMTFLSZ+2 74CT ... NGX 3 0 74DD ... SETUPCOR 3,1,BSTB,FULLB 74F3 ... TOPFCB2 2 74FL ... STO 3 A1(1) 74G9 ... ADN 1 A1+1 74GS ... LDN 0 BSPRE(2) 74HC ... MOVE 0 511(3) 74J2 ... LDN 0 FBLKS-A1 74JK ... STO 0 FUSEBL(2) 74K8 ... FREEBAX 74KR ... MFREEW BSTB,EMPTYB 74LB ... TOPFCB2 2 74L^ ...NOBLOCKS 74MJ ... LDX 3 2 74N7 ... ALTLEND 3,FBLKS-A1+AMTFLSZ 74NQ ... LDN 1 AMTFLSZ [PICK UP BLOCKS FOR FILE 74P* ... WHATBACK 7,1 74PY ... TOPFCB2 2 74QH ... MHUNTW 1,BSTB,FULLB 74R6 ... ADN 1 A1+1 74RP ... ADN 2 BSPRE 74S# ... MOVE 1 AMTFLSZ+1 [MOVE IN THE BLOCK NUMBERS 74SX ... SBN 1 A1+1 74TG ... FREECORE 1 74W5 ... TOPFCB2 2 74WN ... LDN 0 AMTFLSZ+FBLKS-A1 74X? ... STO 0 FUSEBL(2) 74XW ...NALRDY 74YF ...) 74YM ...NOTIFINB 74YT ...) 74^4 ... LDX 2 FX2 74^M ... TOPFCA2 1 752= ... LDN 0 FBLKS*BLN-1 752T ... SLL 0 12 753D ... STO 0 FREADWORD(1) [SET BLKLT PTR TO -1 7543 ... STOZ AWORK2(2) [BULK FILE ADDRESS 754L ... DOWN MTCODE,4 [EXTEND INDEX TO 1 BLOCK 7559 ... TESTREP2 REFUSED,REFUSED,FILEFULL,ZGEOERR 755S ... CALL 6 SINDEX [GET X3->FINDEX 756C ... LDX 0 ZFINDEXW(1) 7572 ... NAMEX 3 [NAME BLOCK FINDEXW 757K ... LDN 0 AMTQUAL [POSITION AFTER HEADER 7588 ... SMO FILERING(2) 758R ... ADS 0 FREADWORD 759B ... ADN 3 A1 759^ ... LDN 2 THEAD(1) 75=J ... MOVE 2 AMTSENT+4 [WRITE THE HEADER LABEL & END 75?7 ... LDX 2 FX2 [ (NAME SCRATCH TAPE) 75?Q ... JBS NEND,2,SCRATCH [J IF SCRATCH ELSE PUT IN NAME 75#* ... LDN 6 ACA3(2) [MOVE FILENAME ETC FROM CONTROL AREA 75#Y ... LDN 7 4(3) [ TO HEADER LABEL 75*H ... MOVE 6 6 75B6 ... BRN NEND 75BP ...[ 75C# ...REFUSED [BACKING STORE LIMIT REACHED 75CX ... SMO FILERING(2) 75DG ... NGS 2 FREADWORD [REINITIALIZE 75F5 ... ADN 1 STARTLINK [LEAVE LINK TO K1MTSTART 75FN ... CALL 4 TOPCA 75G? ... ACROSS OLPODD,2 [ASK FOR 1 MORE 75GW ...[ 75HF ...NOUT [MODES 100, 200 & 300 75J4 ... TOPFCB2 1 75JM ... LDX 0 FBLMOD(1) 75K= ... SBN 0 FBLKS-A1 75KT ... BNZ 0 POSITION [J TO POSITION IF NOT EMPTY 75LD ... JBS Z300,2,MODE3C [WRITE HEADER IF EMPTY & MODE 300 75M3 ...TAPEND 75ML ... LDN 3 FYENDFILE 75N9 ... BRN QERROR 75NS ...[ 75PC ...RV [RESERVATION VIOLATION 75Q2 ... LDN 3 FYNOCA 75QK ...QERROR [REPORT ILLEGAL : OLPODD EXPECTS IDENTIFIER IN X3 75R8 ... LDX 1 FX1 75RR ... ADN 1 STARTLINK [LEAVE LINK TO K1MTSTART 75SB ... CALL 4 TOPCA [CHANGE TO APET 75S^ ... ACROSS OLPODD,4 [TO REPORT ILLEGAL 75TJ ...[ 75W7 ...POSITION [POSITION AFTER 1ST RECORD 75WQ ... LDX 2 FX2 75X* ... TOPFCA2 1 75XY ... LDX 0 FREADWORD(1) 75YH ... BPZ 0 NEND [JIF FILE ALREADY POSITIONED 75^6 ... LDN 0 FBLKS*BLN 75^P ... SLL 0 12 762# ... STO 0 FREADWORD(1) [SET INDEX POINTER TO B.O.F. 762X ... LDX 1 FX1 763G ... CALL 6 SINDEX [GET X3-> 1ST INDEX BLOCKLET 7645 ... LDX 0 A1+1(3) 764N ... BNG 0 NDATA [J UNLESS DATA RECORD 765? ... LDN 0 AMTDATA 765W ... BRN TPOS 766F ...[ 7674 ...NDATA 767M ... BXU 0 TMARK(1),NMARK [CHECK WHETHER TAPEMARK 768= ... LDN 0 AMTMARK 768T ... BRN TPOS 769D ...[ 76=3 ...NMARK 76=L ... BXE 0 TEND(1),TAPEND [ILLEGAL IF FILE EMPTY 76?9 ... LDN 0 AMTQUAL 76?S ...TPOS 76#C ... SMO FILERING(2) 76*2 ... ADS 0 FREADWORD [SET INDEX POINTER TO NEXT RECORD 76*K ...NEND 76*W ... STOZ AWORK1(2) [CLEAR E.O.T. MARKER FOR MTOBJ 76B8 ... SETBIT 0,GIVE(2) [FILE NOW OPEN FOR ALLOT EXTRACODE 76BR ... JBS NOTSTANDARD,2,NOTOPENMODE 76CB ... SMO FX1 76C^ ... LDX 0 TSN 76DJ ... STO 0 ACA2(2) [REPLY WORD TO BE SET BY MTOBJ 76F7 ... ACROSS MTOBJ,3 [TO SET REPLY WORD & RESTART PROGRAM 76FQ ...[ 76G* ...NOTSTANDARD 76GY ... ACROSS MTOBJ,1 [TO PROCESS PERI 76R5 ...[ 76T6 ...ZGEOERR 76X7 ... GEOERR 1,FILEFULL 76^8 ...[ 773= MENDAREA 30,K99MTSTART 77GW #END ^^^^ ...75566567000200000000