(George Source)
Macros used: ALTLENGD, BACKWAIT, BFCBX, BLAM, BXE, BXGE, BXL, BXU, CHAIN, FILEAUTR, FILEAUTW, FILEREAD, FILETRAN, FINDCORE, FINMOVE, FOUTMOVE, FREEBAX, FREECORE, GETBAX, GETCORE, HUNTW, INMOVE, MBS, MEND, MENDAREA, MHUNTW, NAME, OUTMOVE, PSTAC, READ, SEG, SEGENTRY, SETNCORE, SETREP, SETREP2, SUBCUBS, TESTREP2, TOPFCA2, TOPFCAB2, TOPFCB2, TRACEIF, UP, VFREEW
22FL ... SEG MTCODE,8,FILE,OLP 22^= ... SEGENTRY K1MTCODE,Z1MTCODE [ROUTINE TO EXTEND BULK FILE 23DW ... [ BY [X3] BLOCKS 23YG ... SEGENTRY K2MTCODE,Z2MTCODE [ROUTINE TO CONTRACT INDEX FILE 24D6 ... SEGENTRY K4MTCODE,Z4MTCODE [ROUTINE TO EXTEND INDEX FILE 24XQ ... SEGENTRY K5MTCODE,ZTRANSTYPE [ROUTINE TO TRANSFER BULK 25CB ... [ DATA TO PROGRAM 25X2 ... SEGENTRY K7MTCODE,ZGETBUFF [ROUTINE TO GET A FURB 26BL ...[ 26W= ...[ THIS SEGMENT CONTAINS ROUTINES TO PERFORM VARIOUS FUNCTIONS FOR 27*W ...[ MTSTART,MTOBJ AND MATALO. 27TG ... 28*6 ...[ IT IS ASSUMED THAT COMMUNAL WRITING IS FORBIDDEN. 28SQ ...[ 29#B ...[ FOR FORMAT OF FILESTORE MAGNETIC TAPE FILES SEE PRM 5.5.3.2 29S2 ...[ 2=?L ... 2=R= ...[ 2?=W ...MEND 4HEND 2?QG ...ZFEXTRA 2#=6 ...#HAL FILE+FEXTRA,0 2#PQ ...[ 2*9B ... FILETRAN [SUBROUTINES FOR TRANSFER MACROS 2*P2 ...[ 2B8L ...MOVEIN [MOVE DATA INTO OBJECT PROGRAM 2BN= ...#SKI G3 2C7W ... FINMOVE 3,2,1,4 2CMG ...#SKI G4 [FINMOVE NO GOOD IN G4:START ADDRESS 2D76 ... INMOVE 3,2,1,4 [ NOT IN 1ST K OF CHECKED AREA 2DLQ ... LDX 2 FX2 2F6B ... EXIT 6 0 2FL2 ...[ 2G5L ...MOVEOUT [MOVE DATA OUT OF OBJECT PROGRAM 2GK= ...#SKI G3 2H4W ... FOUTMOVE 3,1,2,4 2HJG ...#SKI G4 [SAME PROBLEM IN G4 AS FINMOVE 2J46 ... OUTMOVE 3,1,2,4 2JHQ ... LDX 2 FX2 2K3B ... EXIT 6 0 2KH2 ...[ 2L2L ...[ 2LG= ...[ ROUTINE TO INCREASE FBLMOD BY [X3], GETTING NEW BLOCKS IF 2LQ4 ...[ NECESSARY. NOTE THAT FBLMOD IS NOT ACTUALLY INCREASED BECAUSE 2L^W ...[ IT WOULD LEAVE THE INDEX APPARENTLY CORRUPT: THE CALLING 2M9N ...[ ROUTINE MUST DO THIS ITSELF AT AN APPROPRIATE TIME 2MFG ...[ OUTPUT FILE FULL (EXCEEDING MAX FILE SIZE) AND END-OF-TAPE (WITHIN 2M^6 ...[ 4K OF MAX FILE SIZE) CONDITIONS CHECKED FOR. 2NDQ ...[ 2NYB ...Z1MTCODE 2PD2 ...[ 2PXL ... TRACEIF K6MTCODE,199,299,3,XTNDBULK 2QC= ... LDX 7 1 [X7-FX1=0 TO INDICATE ENTRY BY DOWN 2QWW ... TOPFCB2 2 2RBG ...XTNDBULK [ENTRY FROM ROUTINE TO EXTEND INDEX 2RW6 ... SBX 7 FX1 [ (LINK X7) 2S*Q ... LDX 6 3 2STB ... ADX 3 FBLMOD(2) 2T*2 ... SBN 3 FBLKS-A1+1 [GIVING REQD FILE SIZE -1 2TSL ... BXGE 3 FSIZE(2),OUTFULL [J IF WOULD EXCEED MAX FILE SIZE 2W#= ... INCRECUB ANSWER,,6 [INCR CUBS - X6=AMOUNT 2WRW ... TESTREP2 REFUSED,REFUSED [J IF BS LIMIT EXCEEDED 2X?G ... TOPFCB2 2 2XR6 ...[ 2Y=Q ... SEGENTRY K77MTCODE [TO MEND E.O.T. POSITION (FOR OPCS) 2YQB ...[ 2^=2 ... LDN 0 4096/GSBS(3) 2^PL ... BXL 0 FSIZE(2),NOTEOT [J IF NOT WITHIN 4K OF MAX FILE SIZE 329= ... LDCT 0 #20 32NW ... SMO FX2 338G ... ORS 0 ACA2 [SET E.O.T. BIT 4 33N6 ...NOTEOT 347Q ... LDN 0 FBLKS-A1(3) 34MB ... BXL 0 FUSEBL(2),NOMOREBLOX [J IF ENUFF SPARE BLOX 3572 ... ADN 3 10 [TRY TO GET REQD NO. OF BLOX +10 35LL ... BXL 3 FSIZE(2),NOTMAX 366= ... LDX 3 FSIZE(2) [TOO MUCH - GET AS MUCH AS POSS 36KW ... SBN 3 1 375G ...NOTMAX 37K6 ... ADN 3 FBLKS-A1 384Q ... LDX 5 FUSEBL(2) 38JB ... BXL 3 ALOGLEN(2),NOALTLEN [J IF ROOM IN FCB FOR NEW BLOCKS 3942 ... LDX 4 2 39HL ... ALTLENGD 4,1(3),REFINDFCB [LENGTHEN FCB 3=3= ...NOALTLEN 3=GW ... ADN 3 3 [GIVING NEW FCB SIZE +2 3?2G ... SBX 3 5 [NOW = NO. OF NEW BLOX +2 3?G6 ... SETUPCOR 3,1,BSTB,EMPTYB 3?^Q ... STO 3 A1(1) [RECORD HEADER FOR EMPTYB 3#FB ...NEWBLOX 3#^2 ... TOPFCB2 2 3*DL ... LDX 4 BSPRE(2) 3*Y= ... STO 4 A1+1(1) [RESIDENCE 3BCW ... GETBAX [GET NEW BLOX 3BXG ... TOPFCB2 2 3CC6 ... BXE 4 BSPRE(2),NCOPIED [J IF RESIDENCE NOT CHANGED 3CWQ ... FREEBAX [FREE NEW BLOX ON OLD RESIDENCE 3DBB ... MHUNTW 1,BSTB,EMPTYB 3DW2 ... BRN NEWBLOX [J TO GET BLOX ON NEW RESIDENCE 3F*L ... 3FT= ...REFINDFCB 3G#W ... TOPFCB2 2 [RE-LOCATE FCB FOR ALTLENG 3GSG ... EXIT 1 0 3H#6 ... 3HRQ ...NCOPIED 3J?B ... MHUNTW 1,BSTB,FULLB 3JR2 ... LDN 4 A1+2(1) [-> NEW BLK NOS. 3K=L ... ADN 5 A1(2) [-> END OF BLK NOS. IN FCB 3KQ= ... SBN 3 2 3L9W ... MOVE 4 0(3) [BUNG IN NEW BLOX 3LPG ... ADS 3 FUSEBL(2) [UPDATE NO. OF BLOX THE FILE OWNS 3M96 ... FREECORE 1 [FREE FULLB 3MNQ ... TOPFCB2 2 3N8B ...NOMOREBLOX 3NN2 ... MBS 2,BFALTB,BFALTR 3P7L ... BZE 7 XBUP [JIF NOT EXTENDING INDEX 3PM= ... ADX 7 FX1 3Q6W ... EXIT 7 0 3QLG ...XBUP 3RKQ ... SETREP OK 3S5B ... UP 3SK2 ... 3T4L ...OUTFULL 3TJ= ... SETREP FILEFULL 3W3W ...REFUSED [BS LIMIT EXCEEDED 3WHG ... UP 3X36 ...[ 3XGQ ...[ 3Y2B ...[ 3YG2 ...[ ROUTINE TO CONTRACT FILE BY MOVING BULK BLOCKS "DOWN" AND 3Y^L ...[ EXPECTS FREADWORD->POSITION @ WHICH FILE IS TO BE 3^F= ...[ TRUNCATED AND [AWORK2]=CORRESPONDING POSITION IN BULK FILE. 3^YW ...[ 42DG ...Z2MTCODE 42Y6 ...[ 43CQ ... TOPFCA2 3 43XB ... LDX 4 FREADWORD(3) 44C2 ... TRACEIF K6MTCODE,199,299,4,CONTRACT 44WL ... SRL 4 12 [GET NO. OF INDEX BLKLETS(+FBLKS*BLN) 45B= ... SRL 4 BLS [CONVERT TO BLOCKS 45TW ... SBN 4 A1-1 [CURRENT INDEX BLK +1 (+FBLKS-A1) 46*G ... LDX 5 AWORK2(2) [CURRENT BULK FILE WORD ADDRESS 46T6 ... ADN 5 GSBS-1 [ROUND UP & CONVERT TO BLOCKS 47#Q ... SRL 5 GSBSLOG [NO. OF BULK BLOX STILL REQD 47SB ... PSTAC 3,3 [X3->FSTACK 48#2 ... BFCBX 3,3 [X3->FCB 48RL ... LDX 7 4 49?= ... ADX 7 5 [TOTAL NO. OF BLOX = INDEX + BULK 49QW ... SBX 7 FBLMOD(3) [ - ORIGINAL NUMBER 4==G ... BPZ 7 NOREDCUBS [J IF NO CHANGE 4=Q6 ... NGX 7 7 [NUMBER OF BLOCKS TO BE FREED 4?9Q ... SUBCUBS ,7,JOB,DEPTH [REDUCE "CURRENT USED B.S." 4?PB ... TOPFCB2 3 4#92 ... SBS 7 FBLMOD(3) [FBLMOD = NO. OF INDEX + BULK BLOX 4#NL ...NOREDCUBS 4*8= ... MBS 3,BFALTB,BFALTR 4*MW ... LDX 0 BULKMOD(3) [ORIGINAL SIZE OF INDEX 4B7G ... SBN 4 FBLKS-A1 [NEW SIZE OF ONDEX 4BM6 ... STO 4 BULKMOD(3) [BULKMOD = END OF INDEX BLOX 4C6Q ... SBX 4 0 4CLB ... BPZ 4 NOFREEINDX [JIF NO FREE INDEX BLOX 4D62 ... BZE 5 NOBULK [JIF NO BULK BLOX TO MOVE "DOWN" 4DKL ... NGX 4 4 [NO. OF FREE INDEX BLOX 4F5= ... ADN 0 FBLKS(3) [-> BULK BLOX 4FJW ... LDX 1 0 4G4G ...[ 4GJ6 ...MOVEDOWN [MOVE BULK BLOCKS DOWN ONE AT A TIME & REPLACE FREED 4H3Q ...[ INDEX BLOCKS IN VACATED LOCATION AT END OF BULK BLOCKS 4HHB ... SBN 1 1 [->LAST INDEX BLOCK 4J32 ... LDX 7 0(1) [KEEP A FREE INDEX BLK 4JGL ... SMO 5 4K2= ... MOVE 0 0 [MOVE BULK BLOX "DOWN" 4KFW ... SMO 5 4K^G ... STO 7 0(1) [AND PUT INDEX BLK ON END OF BULK 4LF6 ... SBN 0 1 [ BLOCKS 4LYQ ... BCT 4 MOVEDOWN [LOOP FOR FURTHER FREE INDEX BLOX 4MDB ...NOBULK [INDEX BLOCKS ALREADY @ END OF FBLMOD 4MY2 ...NOFREEINDX 4NCL ... LDX 1 FPTR(3) [X1->FSTACK 4NX= ...[ 4PBW ...ZWRIT [NOW GET RID OF UNWANTED FUWB(OTHER TYPES DON'T MATTER) 4PWG ...[ 4QB6 ... LDX 1 FPTR(1) 4QTQ ... BXE 1 CXFI,ZUP [J IF END OF FILE CHAIN 4R*B ... LDX 0 ATYPE(1) 4RT2 ... SMO FX1 4S#L ... BXE 0 ZFEXTRA,ZUP [J IF END OF WORKFILE RTNG 4SS= ... BXE 0 FFSFCB,ZUP 4T?W ... BXU 0 FFSFUWB,ZWRIT 4TRG ... LDX 2 FBLMOD(3) [CAN FREE WRITE BLOX IF NO LONGER 4W?6 ... SBN 2 FBLKS-A1 [ WITHIN FILE 4WQQ ... BZE 2 ZFREE [FILE EMPTY - FREE ALL BLOX 4X=B ... LDX 0 BACK2(1) 4XQ2 ...ZLOOP BXE 0 FBLKS(3),ZUP [JIF STILL WITHIN FILE 4Y9L ... BUX 3 £ 4YP= ... BCT 2 ZLOOP 4^8W ...ZFREE FREECORE 1 4^NG ...ZUP 5286 ... UP 52MQ ...[ 537B ...[ 53M2 ...ZBLAM [CONVERT BLOCK NO. IN BACK2 TO FREADBLOCK-TYPE POINTER 546L ...[ EXPECTS X3->BLOCK; LINK X0: LEAVES X1=POINTER; X2->FCB 54L= ...[ X3-X7 UNCHANGED 555W ... STO 0 GEN0 [SAVE LINK 55KG ... BLAM ,3 [DEPTH ZERO(%A NULL) 5656 ... BRN (GEN0) [EXIT 56JQ ...[ 574B ...[ 57J2 ...[ ZFINDBUFF SUBROUTINE 583L ...[ ON ENTRY X2=FX2 X5=REC SA X6=LINK 58H= ...[ ON EXIT THE USAGE BLOCK GIVEN FOR THE WORD POINTER IN X5 WILL 592W ...[ BE CHAINED IN THE FILE CHAIN 59GG ...[ X1-> USAGE BLOCK X2=FX2 X0,X3,X4,X5 DESTROYED 5=26 ...[ X7 PRESERVED UNCHANGED 5=FQ ...[ AN UNUSED USAGE BLOCK (IF ANY) WILL BE DISPOSED OF 5=^B ...[ 5?F2 ...[ IF THE BLOCK CANNOT BE FOUND & X7 IS ZERO (I.E. WRITING) 5?YL ...[ AND LS 9 BITS OF X5=0 (I.E. TRANSFER BRGINS ON BLOCK 5#D= ...[ BOUNDARY), IT WILL BE SET UP BY A GETCORE 5#XW ...[ 5*CG ...ZFINDBUFF 5*X6 ... SBX 6 FX1 5BBQ ... STO 6 AWORK3(2) 5BWB ... TOPFCAB2 3,1 [X3->FCA; X1->FCB 5CB2 ... LDN 6 0 5CTL ... BNZ 7 NOTWRITING [J IF READ TRANSFER 5D*= ... LDEX 0 5 [GET B15-23 OF BULK FILE ADDRESS 5DSW ... BNZ 0 NOTWRITING [J UNLESS WRITING FROM START OF BLK 5F#G ... LDX 6 GSIGN [SET "DON'T BACKREAD" MARKER 5FS6 ...NOTWRITING 5G?Q ... SRL 5 GSBSLOG [CONVERT BULK FILE ADDRESS TO BLOCKS 5GRB ... ADX 5 BULKMOD(1) [MAKE IT RELATIVE TO BOF 5H?2 ... ADN 5 FBLKS [MAKE IT RELATIVE TO A0 OF FCB 5HQL ... ORX 6 5 [AS STANDARD FREADBLOCK POINTER 5J== ... STO 6 FREADBLOCK(3) [SAVE IT 5JPW ...ZRESTART [(RE)CALCULATE BLOCK NUMBER (AFTER COOR DURING 5K9G ...[ WHICH RESIDENCE MAY HAVE CHANGED DUE TO COPYFILE). 5KP6 ... SMO 6 5L8Q ... LDX 5 0(1) [ BLK NO 5LNB ... LDN 6 0 [BLOCK NOT FOUND 5M82 ... LDX 3 FPTR(1) [X3->FSTACK 5MML ...ZMOREBL 5N7= ... LDX 1 FX1 5NLW ... LDX 2 FX2 5P6G ... LDX 3 FPTR(3) [ NEXT BLK 5PL6 ... BXE 3 CXFI,NOTFOUND [J IF END OF FILE CHAIN 5Q5Q ... LDX 0 ATYPE(3) 5QKB ... BXE 0 FFSFCB,NOTFOUND [J IF NEXT FCB 5R52 ... BXE 0 ZFEXTRA(1),NOTFOUND [J IF END OF !RING 5RJL ... BXE 0 FFSFURB,READ 5S4= ... BXU 0 FFSFUWB,ZMOREBL 5SHW ...[ 5T3G ...[ FUWB FOUND SO CAN'T BE ANY MORE BUFFERS 5TH6 ...[ 5W2Q ... BXE 5 BACK2(3),ZOUT [J IF RIGHT BLOCK FOUND 5WGB ... CHAIN 3,2 [MOVE TO ACTIVITY CHAIN 5X22 ... CALL 0 ZBLAM [GET STANDARD FREADBLOCK-TYPE POINTER 5XFL ... LDX 4 1 5X^= ... FILEAUTW ,FAIL+FREE,,4,,,NOCHECK [WRITE BLOCK AWAY AUTONOMOUSLY 5YDW ... BRN NOTFOUND 5YYG ...[ 5^D6 ...READ 5^XQ ... BXU 5 BACK2(3),WRONGBLOCK [J UNLESS RIGHT BLOC 62CB ... BNZ 6 (GEOERR) [SHOULDN'T FIND SAME BLOCK TWICE 62X2 ... LDX 6 3 [KEEP ADDRESS OF BLOCK 63BL ... BRN ZMOREBL [LOOK FOR MORE UNUSED BLOCKS 63W= ...[ 64*W ...WRONGBLOCK 64TG ...[ 65*6 ...[ FREE THE BLOCK IF NO ONE ELSE IS USING IT. 65SQ ...[ 66#B ... TOPFCA2 2 66S2 ... PSTAC 2,2 [X2->FSTACK 67?L ... LDEX 4 ARINGNO(2) [ NO 0F ELEMENTS 67R= ... SBN 4 1 68=W ... BZE 4 ZREADFREE [ ONE 0WNER 68QG ... ADN 4 1 69=6 ... CALL 0 ZBLAM [GET FREADBLOCK-TYPE POINTER 69PQ ... LDX 2 FPTR(2) [X2->FSTACK 6=9B ...ZFELL 6=P2 ... BXE 1 A1+FREADBLOCK(2),ZMOREBL [J IF IN USE 6?8L ... ADN 2 FELLEN [ NEXT ELEMENT 6?N= ... BCT 4 ZFELL 6#7W ...ZREADFREE 6#MG ... LDX 3 BPTR(3) [KEEP ADDRESS OF PREVIOUS BLOCK 6*76 ... FREECORE FPTR(3) [FREE UNUSED BLOCK 6*LQ ... BRN ZMOREBL 6B6B ...[ 6BL2 ...NOTFOUND 6C5L ... LDX 3 6 [ADDRESS OF FOUND BLOCK 6CK= ... BNZ 3 ZOUT [J IF BLOCK LOCATED 6D4W ... HUNTW 3,BSTB,BREAD 6DJG ... BPZ 3 ZNAMEFURB [J IF FILEREAD ALREADY DONE 6F46 ... SMO FILERING(2) 6FHQ ... LDX 6 FREADBLOCK 6G3B ... BPZ 6 ZFREAD [J UNLESS "DON'T BACKREAD" MARKER SET 6GH2 ... GETCORE BSBS,1 [BLOCK NOT YET USED 6H2L ... FINDCORE 3 6HG= ... TOPFCB2 1 6H^W ... LDX 0 BSPRE(1) [RESIDENCE NO. MAY HAVE CHANGED 6JFG ... STO 0 BACK1(3) [DURING GETCORE DUE TO COPYFILE 6J^6 ... SMO 6 6KDQ ... LDX 0 0(1) [RECOVER BLOCK NO. USING FREADBLOCK 6KYB ... STO 0 BACK2(3) [ POINTER 6LD2 ... BRN ZNAMEFURB [REJOIN MAIN PATH 6LXL ...[ 6MC= ...ZFREAD 6MWW ... FILEREAD ,FAIL,,6,,,NOCHECK 6NBG ... 6NW6 ...[ NOW CHECK NO-ONE ELSE HAS SET UP THE SAME BLOCK 6P*Q ... 6PTB ... TOPFCB2 1 6Q*2 ... BRN ZRESTART [START AGAIN 6QSL ...[ 6R#= ...ZNAMEFURB 6RRW ... NAME 3,FILE,FURB 6S?G ... TOPFCA2 2 6SR6 ... PSTAC 2,2 [X2->FSTACK 6T=Q ... CHAIN 3,2 [PUT IN FILE CHAIN 6TQB ...ZOUT 6W=2 ... VFREEW BSTB,BREAD [UNUSED BREAD:- SOMEONE ELSE READ IT 6WPL ... LDX 2 FX2 6X9= ... LDX 1 3 [PUT BLOCK ADDRESS IN X1 AS WELL 6XNW ... LDX 6 AWORK3(2) 6Y8G ... ADX 6 FX1 6YN6 ... EXIT 6 0 6^7Q ...[ 6^MB ...[ 7272 ...[ ENTRY TO GET A FURB 72LL ...[ 736= ...ZGETBUFF 73KW ... LDX 5 AWORK3(2) [BULK FILE ADDRESS IN WORDS 745G ... LDN 7 1 [MARKER TO INDICATE READING 74K6 ... CALL 6 ZFINDBUFF [ENSURE FURB IN FILE CHAIN 754Q ... UP 75JB ...[ 7642 ...[ 76HL ...[ ROUTINE TO SET UP A NEW INDEX BLOCKLET. A BLOCK IS TAKEN FROM THE 773= ...[ END OF THE BULK FILE IF THE INDEX REQUIRES EXTENSION. 77GW ...[ 782G ...[ 78G6 ...Z4MTCODE 78^Q ...[ 79FB ... TOPFCA2 2 79^2 ... LDX 0 FREADWORD(2) 7=DL ... TRACEIF K6MTCODE,199,299,0,XTNDINDX 7=Y= ... SRL 0 12 7?CW ... SBN 0 FBLKS*BLN-1 7?XG ... SRL 0 BLS [GIVING BLK HOLDING NEXT INDEX BLT 7#C6 ... PSTAC 2,2 7#WQ ... BFCBX 2,2 7*BB ... BXL 0 BULKMOD(2),NONEWBLK [JIF NO NEED TO EXTEND INDEX 7*W2 ... TRACEIF K6MTCODE,199,299,BULKMOD(2),NEWIXBLK 7B*L ... LDN 3 1 7BT= ... CALL 7 XTNDBULK [CHECK FOR FILE FULL & E.O.T. AND 7C#W ... LDX 5 FBLMOD(2) [ GET NEW BLK IF NECESSARY 7CSG ... SBN 5 FBLKS-A1 7D#6 ... SBX 5 BULKMOD(2) 7DRQ ... BZE 5 NBULK [JIF NO BULK BLOX IN FILE 7F?B ... LDX 1 2 7FR2 ... ADX 1 FBLMOD(2) [-> TO END OF BULK FILE 7G=L ... LDX 7 A1(1) [PINCH A BLK FROM THE END 7GQ= ...MOVEUP 7H9W ... LDX 0 A1-1(1) 7HPG ... STO 0 A1(1) [MOVE BULK BLOX "UP" 7J96 ... SBN 1 1 7JNQ ... BCT 5 MOVEUP 7K8B ... STO 7 A1(1) [POP IN THE NEW INDEX BLK 7KN2 ...NBULK 7L7L ... ADS 6 FBLMOD(2) [INCREMENT BY 1 : LEFT BY XTNDBULK 7LM= ... ADS 6 BULKMOD(2) [ DITTO 7M6W ...NONEWBLK 7MLG ... SETNCORE GSBS4,3,FILE,FINDEXW 7N66 ... TOPFCA2 1 7NKQ ... LDX 7 FREADWORD(1) 7P5B ... ANDX 7 HALFTOP 7PK2 ... ADX 7 BIT11 [ADD 1 TO BLOCKLET POINTER 7Q4L ... STO 7 FREADWORD(1) [ & ZEROIZE WORD POINTER 7QJ= ... PSTAC 1,1 7R3W ... BFCBX 1,1 7RHG ... LDX 0 BSPRE(1) 7S36 ... STO 0 BACK1(3) [SET UP BACK1 OF NEW BLT 7SGQ ... SRL 7 12 7T2B ... LDX 0 7 7TG2 ... ANDN 0 BLN-1 [ISOLATE BLT WITHIN BLK 7T^L ... SRL 7 BLS 7WF= ... SMO 7 7WYW ... ORX 0 0(1) [ & ADD IN BLK NO. 7XDG ... STO 0 BACK2(3) [GIVING BACK2 OF NEW BLT 7XY6 ... TRACEIF K6MTCODE,199,299,AWORK2(2),NEW A1 7YCQ ... LDX 0 AWORK2(2) 7YXB ... STO 0 A1(3) [1ST WD = LAST USED BULK WD +1 7^C2 ... SMO FX1 7^WL ... LDX 0 MEND 82B= ... STO 0 A1+1(3) [SET 'END ' 82TW ... LDX 2 FPTR(1) [X2->FSTACK 83*G ... CHAIN 3,2 [CHAIN NEW FINDEXW IN FRONT OF 83T6 ... SETREP2 OK [ FSTACK 84#Q ... UP 84SB ...[ 85#2 ...[ 85RL ...[ ZTRANSTYPE SUBROUTINE 86?= ...[ 86QW ...[ REGION A B C D X 87=G ...[ TRANSFER *** **** *** OR * 87Q6 ...[ BLOCK BOUNDARY ^ ^ ^ ^ ^ ^ 889Q ...[ X5=END ADDRESS OF PERI IN BULK FILE 88PB ...[ X6=LENGTH OF TRANSFER REQUIRED 8992 ...[ ON EXIT ACA4=NEXT OBJECT PROGRAM BUFFER ADDRESS; ACA6-9 DESTROYED 89NL ...[ USAGE ACA6=A OR D TYPE LENGTH 8=8= ...[ ACA7=B TYPE LENGTH 8=MW ...[ ACA8=C TYPE LENGTH 8?7G ...ZTRANSTYPE 8?M6 ... SBX 5 6 [START ADDRESS IN BULK FILE 8#6Q ... STO 5 ACA9(2) [SET UP START ADDRESS IN ACA9 8#LB ... LDEX 4 5 [X4=0 IF STARTING ON BLOCK BOUNDARY 8*62 ... LDN 0 GSBS 8*KL ... SBX 0 4 [X0=A OR D+X 8B5= ... BXL 0 6,ZNOTYPED [J UNLESS TYPE D OR A+B+C WHERE A=C=0 8BJW ... STO 6 ACA6(2) [SET TYPE D COUNT IN ACA6 8C4G ... TRACEIF K6MTCODE,199,299,ACA6(2),TYPE D 8CJ6 ... STOZ ACA7(2) [NO TYPE B 8D3Q ... STOZ ACA8(2) [NO TYPE C 8DHB ... BRN TYPED [TYPE D TRANSFER ONLY 8F32 ...[ 8FGL ...ZNOTYPED 8G2= ... STO 0 ACA6(2) [SET TYPE A COUNT IN ACA6 8GFW ... SBS 0 6 [X6=REMAINDER COUNT 8G^G ... LDEX 0 6 [TYPE C COUNT 8HF6 ... STO 0 ACA8(2) 8HYQ ... ERX 0 6 [TYPE B COUNT 8JDB ... STO 0 ACA7(2) [SET TYPE B COUNT IN ACA7 8JY2 ... LDX 0 ACA6(2) 8KCL ... TRACEIF K6MTCODE,199,299,ACA6(2),TYPE A 8KX= ... TRACEIF K6MTCODE,199,299,ACA7(2),TYPE B 8LBW ... TRACEIF K6MTCODE,199,299,ACA8(2),TYPE C 8LWG ... BZE 0 ONOTYPEA 8MB6 ...[ 8MTQ ...TYPED [TYPE A OR D TRANSFER 8N*B ...[ 8NT2 ... CALL 6 ZFINDBUFF [X1->USAGE BLOCK 8P#L ... LDX 5 ACA9(2) [BULK FILE START ADDRESS 8PS= ... ADX 5 ACA6(2) [NEXT BULK FILE START ADDRESS 8Q?W ... LDX 3 APETADDR(2) 8QRG ... LDX 4 ACA6(2) [TYPE A OR D LENGTH 8R?6 ... BNZ 7 ONORITEA [J IF READING 8RQQ ...[ 8S=B ...[ WRITE TYPE A OR D 8SQ2 ...[ 8T9L ... NAME 1,FILE,FUWB [ENSURE USAGE BLOCK WRITTEN 8TP= ... LDEX 0 ACA9(2) [START ADDRESS WITHIN USAGE BLOCK 8W8W ... ADN 1 A1 8WNG ... ADX 1 0 8X86 ... LDX 2 1 [X2->START ADDRESS OF DATA AREA IN US 8XMQ ... SMO FX2 8Y7B ... LDX 1 ACA4 [OBJECT PROGRAM BUFFER ADDRESS 8YM2 ... CALL 6 MOVEOUT [MOVE DATA TO OBJECT PROGRAM 8^6L ... BRN OA 8^L= ...[ 925W ...ONORITEA [READ TYPE A OR D 92KG ...[ 9356 ... LDEX 0 ACA9(2) 93JQ ... ADX 1 0 944B ... ADN 1 A1 [X1->DATA AREA IN USAGE BLOCK 94J2 ... LDX 2 ACA4(2) [X2->START OF OBJECT PROGRAM BUFFER 953L ... CALL 6 MOVEIN [MOVE DATA OUT OF OBJECT PROGRAM 95H= ...[ 962W ...OA [UPDATE POINTERS 96GG ...[ 9726 ... LDX 0 ACA6(2) [TYPE A OR D LENGTH 97FQ ... ADS 0 ACA4(2) [UPDATE OBJECT PROGRAM BUFFER ADDRESS 97^B ...[ 98F2 ...ONOTYPEA 98YL ... LDX 6 ACA7(2) 99D= ... BZE 6 ONOTYPEB [J IF NO TYPE B TRANSFERS 99XW ...[ 9=CG ...[ TYPE B TRANSFERS ARE DONE DIRECTLY BETWEEN THE PROGRAM AND BS. 9=X6 ...[ THIS MEANS THAT MULTIPLE READERS MAY FAIL TO SHARE TRANSFERS BUT 9?BQ ...[ TRANSFERS RARELY EXCEED GSBS WORDS AND MULTIPLE READING IS ALSO RARE. 9?WB ...[ THE ADVANTAGE OF DIRECT TRANSFERS IS THAT READS CAN BE AUTONOMOUS 9#B2 ...[ AND THAT WRITES DO NOT FILL UP CORE WITH BWRITE BLOCKS. 9#TL ...[ 9**= ... SRL 6 GSBSLOG [CONVERT TYPE B COUNT TO BLOCKS 9*SW ...[ 9B#G ...OSTA LDX 4 5 [BULK FILE START ADDRESS 9BS6 ... SRL 4 GSBSLOG [CONVERT TO BLOCKS 9C?Q ... TOPFCB2 1 9CRB ... ADN 4 FBLKS 9D?2 ... ADX 4 BULKMOD(1) [CONVERT TO FREADBLOCK-TYPE POINTER 9DQL ... STO 6 AWORK3(2) 9F== ... LDX 6 ACA4(2) [OBJECT PROGRAM BUFFER ADDRESS 9FPW ... BNZ 7 ONORITEB 9G9G ... LDX 7 APETADDR(2) 9GP6 ... FILEAUTW ,FAIL+BOBJ,,4,EX6,EX7 9H8Q ... LDN 7 0 [RESTORE X7=0 (I.E. WRITING) 9HNB ... BRN OB 9J82 ...[ 9JML ...ONORITEB 9K7= ... LDX 7 APETADDR(2) [N.B. X7 NOT = 0 (I.E. READING) 9KLW ... FILEAUTR ,FAIL+BOBJ,,4,EX6,EX7 9L6G ...[ 9LL6 ...OB LDX 6 AWORK3(2) [COUNT OF TYPE B TRANSFERS 9M5Q ... LDN 0 GSBS 9MKB ... ADS 0 ACA4(2) [UPDATE OBJECT PROGRAM BUFFER ADDRESS 9N52 ... ADS 0 5 [UPDATE BULK FILE ADDRESS IN X5 9NJL ... BCT 6 OSTA [J IF MORE 9P4= ...[ 9PHW ...ONOTYPEB 9Q3G ... LDX 0 ACA8(2) 9QH6 ... BZE 0 ONOTYPEC [J IF NO TYPE C TRANSFER 9R2Q ... CALL 6 ZFINDBUFF [X1->USAGE BLOCK 9RGB ... LDX 3 APETADDR(2) 9S22 ... LDX 4 ACA8(2) [TYPE C LENGTH 9SFL ... BNZ 7 ONORITEC [J IF READING 9S^= ... NAME 1,FILE,FUWB [ENSURE USAGE BLOCK IS WRITTEN 9TDW ... ADN 1 A1 9TYG ... LDX 2 1 [X2->A1 OF USAGE BLOCK 9WD6 ... SMO FX2 9WXQ ... LDX 1 ACA4 [X1->OBJECT PROGRAM BUFFER AREA 9XCB ... CALL 6 MOVEOUT [MOVE DATA TO OBJECT PROGRAM 9XX2 ... BRN OC 9YBL ...[ 9YW= ...ONORITEC 9^*W ... ADN 1 A1 [X1->A1 OF USAGE BLOCK 9^TG ... LDX 2 ACA4(2) [X2->OBJECT PROGRAM BUFFER AREA =2*6 ... CALL 6 MOVEIN [MOVE DATA OUT OF OBJECT PROGRAM =2SQ ...[ =3#B ...OC =3S2 ... LDX 0 ACA8(2) =4?L ... ADS 0 ACA4(2) [UPDATE NEXT PROGRAM BUFFER ADDRESS =4R= ...ONOTYPEC =5=W ... LDX 0 ACA7(2) =5QG ... BZE 0 OUP [J IF NO TYPE B TRANSFERS =6=6 ... BACKWAIT [WAIT FOR AUTO TRANSFERS TO FINISH =6PQ ...OUP =79B ... UP =7P2 ...[ =88L ... MENDAREA 30,K99MTCODE =8N= ...#END ^^^^ ...702575260001