.TITLE JUICER_1 .MACRO VERSION ACTION ;V01-002 ACTION /V01-013/ ;V01-013 .ENDM ;V01-002 VERSION .IDENT ;V01-002 .SUBTITLE DECLARATIONS ; ; PROGRAM FOR COMPRESSION OF A VAX/VMS FILES-11 LEVEL 2 ; DISK TO REDUCE FRAGMENTATION ; ; Michael N. LeVine ; Naval Weapons Center ; Code 3514 ; China Lake ; Ca 93555 ; (619)939-3970 ;V01-013 ; AVN 437-3970 ;V01-013 ; .ENABLE DEBUG .LIBRARY /SYS$LIBRARY:LIB.MLB/ $HM2DEF ;DECLARE THE STRUCTURE OF THE HOME BLOCK $FH2DEF ;FILE HEADER STRUCTURE $FI2DEF ;IDENT AREA STRUCTURE $FM2DEF ;MAP AREA STRUCTURE $DVIDEF ;DEVICE INFORMATION PARAMETERS AND FLAGS $DCDEF ;DEVICE TYPE FLAGS $IODEF ;IO CODES $RMSDEF ;RMS ERROR CODES MAX_BLOCK_TRANSFER=100 ;LARGEST NUMBER OF BLOCKS TO XFER IN ONE QIO OPERATION HEADER_BUFFER_COUNT=32 ;NUMBER OF HEADER BLOCKS FOR SCAN BUFFER;V01-007 .IF GT HEADER_BUFFER_COUNT-127 ;V01-007 .ERROR ;HEADER BUFFER TOO LARGE ;V01-007 .ENDC ;V01-007 CR=13 LF=10 ;DEBUG=1 ;ENABLE ASSEMBLY OF DEBUGGING CODE .PAGE .SUBTITLE PURE DATA .PSECT PURE_DATA,RD,NOWRT,GBL,CON,QUAD,NOEXE ; ; ARGUMENT LIST FOR LIB$GET_FOREIGN ; GET_ARG: .LONG 4 .ADDRESS DEVICE_NAME .ADDRESS PROMPT .ADDRESS LENGTH .ADDRESS FORCE PROMPT: .ASCID /Device ? / ; ; GETDEV ARGUMENT LIST ; ITEM_LIST: .WORD 4,DVI$_DEVCLASS .ADDRESS CLASS .LONG 0 .WORD 4,DVI$_ACPTYPE .ADDRESS ACPTYPE .LONG 0 .WORD 4,DVI$_CLUSTER .ADDRESS CLUSTER .LONG 0 .LONG 0 NOT_DISK_ARG: .LONG 1 .ADDRESS NOT_DISK_STRING NOT_DISK_STRING: .ASCID /Specified device is not a disk/ NOT_ODS2_ARG: .LONG 1 .ADDRESS NOT_ODS2_STRING NOT_ODS2_STRING: .ASCID /Specified disk is not structured Files-11 Level 2/ ILLEGAL_CLUSTER_ARG: .LONG 1 .ADDRESS ILLEGAL_CLUSTER_STRING ILLEGAL_CLUSTER_STRING: .ASCID /Illegal disk Cluster Size/ DEFAULT_BITMAP_NAME: .ASCII /SYS$DISK:[000000]BITMAP.SYS/ DFLT_BITMAP_NAM_SIZ=.-DEFAULT_BITMAP_NAME DEFAULT_INDEX_NAME: .ASCII /SYS$DISK:[000000]INDEXF.SYS/ DFLT_INDEX_NAM_SIZ=.-DEFAULT_INDEX_NAME CURRENT_BLOCK_ARG: .LONG 1 .ADDRESS CURRENT_BLOCK FRAGMENT_ARG: .LONG 2 .ADDRESS FRAGMENT_LENGTH,FRAGMENT_LBN BITMAP_READ_ERROR: .ASCID ?Error reading BITMAP.SYS-?- ?run ANALYZE/DISK/REPAIR ? BITMAP_WRITE_ERROR: .ASCID ?Error writeing BITMAP.SYS-?- ?run ANALYZE/DISK/REPAIR ? MAIN_HOME_READ_ERROR: .ASCID /Error reading main HOME block/ MAIN_HOME_CKSUM_ERROR: .ASCID /Checksum error in main HOME block/ ALT_HOME_READ_ERROR: .ASCID /Error reading alt. HOME block/ ALT_HOME_CKSUM_ERROR: .ASCID /Checksum error in alt. HOME block/ FILE_HEADER_ERROR_MESSAGE: .ASCID /Error reading file header in [000000]INDEXF.SYS/ TERMINAL: .ASCID /SYS$INPUT:/ TERMINAL_ASSIGN_ERROR: .ASCID /Error assigning channel to SYS$INPUT/ CURRENT_BLOCK_FORMAT: .ASCID ?Current disk block is !ZL!/Current file header is !ZL? TRANSFER_READ_ERROR: .ASCID ?Fatal error occoured during fragment read from disk-?- ?run ANALYZE/DISK/REPAIR ? TRANSFER_WRITE_ERROR: .ASCID ?Fatal error occoured during fragment write to disk-?- ?run ANALYZE/DISK/REPAIR ? BAD_FORMAT_MESSAGE: .ASCID ?Bad retrieval pointer found in file header-?- ?run ANALYZE/DISK/REPAIR ? INDEX_READ_ERROR: .ASCID ?Error reading file header-?- ?run ANALYZE/DISK/REPAIR ? INDEX_UPDATE_READ_ERROR: .ASCID ?Error reading file header for update-?- ?run ANALYZE/DISK/REPAIR ? INDEX_UPDATE_WRITE_ERROR: .ASCID ?Error writeing file header for update-?- ?run ANALYZE/DISK/REPAIR ? .PAGE .SUBTITLE IMPURE DATA .PSECT IMPURE_DATA,RD,WRT,GBL,CON,QUAD,NOEXE LENGTH: .LONG 0 FORCE: .LONG 0 IOSB: .LONG 0,0 CLASS: .LONG 0 ACPTYPE:.LONG 0 CLUSTER:.LONG 0 CURRENT_BLOCK: ;CURRENT VBN OF BLOCK IN INDEX_BLOCK FROM INDEXF.SYS .LONG 0 CURRENT_BITMAP_BLOCK: ;CURRENT VBN OF BLOCK IN BITMAP_BLOCK FROM BITMAP.SYS .LONG 0 FRAGMENT_LENGTH: ;LENGTH OF INUSE FRAGMENT FOUND .LONG 0 FRAGMENT_LBN: ;FIRST LBN OF INUSE FRAGMENT FOUND .LONG 0 FRAGMENT_RETRIEVAL: ;OFFSET TO RETRIEVAL POINTER IN FILE HEADER OF INUSE FRG .LONG 0 SOURCE_LENGTH: .LONG 0 SOURCE_LBN: .LONG 0 MESSAGE_VECTOR: ;MESSAGE VECTOR FOR ERROR MESSAGES OUTPUT .LONG 0,0,0,0 CHAIN_HEAD: .LONG 0 .LONG 0 ; ; CHAIN ELEMENT HAS FOLLOWING FORMAT ; ; ------------------ ; ! ! 0 NEXT ELEMENT IN POINTER ; ------------------ ; ! ! 4 LAST ELEMENT POINTER ; ------------------ ; ! ! 8 LBN ; ------------------ ; ! ! 12 SIZE ; ------------------ ; ! ! 16 FILE HEADER SEQUENCE NUMBER ; ------------------ ; ! ! 20 OFFSET INTO FILE HEADER OF RETRIEVAL POINTER ; ------------------ ; CHAIN_ELEMENT_L_NEXT=0 CHAIN_ELEMENT_L_LAST=4 CHAIN_ELEMENT_L_LBN=8 CHAIN_ELEMENT_L_SIZE=12 CHAIN_ELEMENT_L_SEQUENCE=16 CHAIN_ELEMENT_L_RETRIEVAL=20 CHAIN_ELEMENT_SIZE=24 HEAP_SIZE: .LONG 0 ;NUMBER OF ELEMENTS IN HEAP HEAP_LIST: .LONG 0,0 MAX_VM_FLAG: ;FLAG.NE.0 WHEN NO MORE V.M. AVAILABLE .LONG 0 FILE_HEADER_1_VBN: ;VBN OF FIRST FILE HEADER IN [000000]INDEXF.SYS .LONG 0 LAST_FILE_HEADER_VBN: ;SEQUENCE NUMBER OF LAST FILE HEADER INPUT .LONG 0 INDEX_EOF_FLAG: .LONG 0 ;FLAG.NE.0 WHEN LAST FILE HEADER READ COUNT: .LONG 0 ;WORKING AREA-SIZE OF CURRENT EMPTY FRAGMENT LBN: .LONG 0 ;WORKING AREA-FIRST LBN OF CURR EMPTY FRAG BASE_ADDRESS: .LONG 0 NUMBER_BYTES: .LONG 0 .ALIGN LONG BITMAP_BLOCK: ;I/O TO BITMAP.SYS VIA THIS BLOCK .BLKB 512 INDEX_BLOCK: ;I/O TO INDEXF.SYS VIA THIS BLOCK .BLKB 512 HEADER_BUFFER: ;BUFFER USED WHEN SCANNING HEADERS;V01-007 .BLKB ;V01-007 HEADER_BUFFER_FIRST_FID: ;V01-007 .LONG 0 ;V01-007 HEADER_BUFFER_HEADER_COUNT: ;V01-007 .LONG 0 ;V01-007 CONTROL_Y_FLAG: ;SET WHEN USER HITS ^Y .LONG 0 CURRENT_BLOCK_MESSAGE: ;BUILD OUTPUT MESSAGE HERE WHEN ^C HIT .ASCID / /- / / TRANSFER_BUFFER: ;FRAGMENT COPY BUFFER .BLKB ERROR_1:.LONG 0 ;ERROR 1 VALUE STORED HERE FOR ERROR MSG OUTPUT ERROR_2:.LONG 0 ;ERROR 2 VALUE STORED HERE FOR ERROR MSG OUTPUT TOTAL_FRAGMENTS: .LONG 0 ;V01-002 EXACT_FIT: .LONG 0 ;V01-002 BEST_FIT: .LONG 0 ;V01-002 ADJACENT_ELEMENT: .LONG 0 ;V01-002 NO_MATCH: .LONG 0 ;V01-002 SYSTEM_FILES: .LONG 0 ;V01-004 PLACEMENT_CONTROL_FILES: .LONG 0 ;V01-004 FILE_STRUCTURE_FILES: .LONG 0 ;V01-004 EXTENTION_HEADERS: .LONG 0 ;V01-004 DISABLE_FLAG_ARG: .LONG 2 ;V01-010 .ADDRESS NEW_FLAG,OLD_FLAG ;V01-010 NEW_FLAG: .LONG ^X02000000 ;V01-010 OLD_FLAG: .LONG 0 ;V01-010 .PAGE .SUBTITLE RMS BLOCKS .PSECT RMS_DATA,RD,WRT,GBL,CON,QUAD,NOEXE .ALIGN LONG INDEX_FAB: $FAB ALQ=0,- DEQ=0,- DNA=DEFAULT_INDEX_NAME,DNS=DFLT_INDEX_NAM_SIZ,- FAC=,- FNA=,FNS=0,- SHR= ;V01-010 .ALIGN LONG INDEX_RAB: $RAB BKT=1,- FAB=INDEX_FAB,- RBF=INDEX_BLOCK,RSZ=512- ROP=,- UBF=INDEX_BLOCK,USZ=512 .ALIGN LONG BITMAP_FAB: $FAB ALQ=0,- DEQ=0,- DNA=DEFAULT_BITMAP_NAME,DNS=DFLT_BITMAP_NAM_SIZ,- FAC=,- FNA=,FNS=0,- SHR= .ALIGN LONG BITMAP_RAB: $RAB BKT=1,- FAB=BITMAP_FAB,- RBF=BITMAP_BLOCK,RSZ=512- ROP=,- UBF=BITMAP_BLOCK,USZ=512 DEVICE_NAME: ;STORE DEVICE NAME HERE-INPUT BY LIB$GET_FOREIGN .ASCID / / DEVICE_CHANNEL: ;ASSIGN DISK TO CHANNEL-STORE CHANNEL NO HERE .LONG 0 TERMINAL_CHANNEL: ;ASSIGN TERMINAL TO CHANNEL-STORE CHANNEL NO HERE .LONG 0 .PAGE .SUBTITLE CODE .SUBTITLE INITALIZATION ;V01-012 .SUBTITLE CHECK DEVICE ;V01-012 .PSECT CODE,RD,NOWRT,EXE,GBL,CON .ENTRY JUICER,0 ; ; GET THE DEVICE NAME ; CALLG GET_ARG,G^LIB$GET_FOREIGN BLBS R0,1$ $EXIT_S R0 1$: MOVL LENGTH,DEVICE_NAME ; ; GET INFORMATION ON SPECIFIED DEVICE ; $GETDVI_S #1,,DEVICE_NAME,ITEM_LIST,IOSB BLBS R0,2$ $EXIT_S R0 2$: $WAITFR_S #1 BLBS IOSB,3$ CVTWL IOSB,R0 $EXIT_S R0 ; MUST BE A DISK 3$: CMPL #DC$_DISK,CLASS BEQL 4$ CALLG NOT_DISK_ARG,G^LIB$PUT_OUTPUT $EXIT_S ; MUST BE ODS-2 4$: CMPL #DVI$C_ACP_F11V2,ACPTYPE BEQL 5$ CALLG NOT_ODS2_ARG,G^LIB$PUT_OUTPUT $EXIT_S ; CLUSTER SIZE 5$: TSTL CLUSTER BGTR 11$ CALLG ILLEGAL_CLUSTER_ARG,G^LIB$PUT_OUTPUT $EXIT_S .PAGE ;V01-012 .SUBTITLE GIVE WARNINGS AND GET ODS-2 STRUCTURE INFO ;V01-012 ; ; DO ALL THE WARNINGS AND CHECKS ; 11$: CALLS #0,DOES_HE_MEAN_IT ; ; OPEN THE INDEXF.SYS FILE ; MOVB LENGTH,INDEX_FAB+FAB$B_FNS $OPEN FAB=INDEX_FAB BLBS R0,6$ $EXIT_S R0 6$: $CONNECT RAB=INDEX_RAB BLBS R0,7$ $EXIT_S R0 ; ; OPEN THE BITMAP.SYS FILE ; 7$: MOVB LENGTH,BITMAP_FAB+FAB$B_FNS $OPEN FAB=BITMAP_FAB BLBS R0,8$ $EXIT_S R0 8$: $CONNECT RAB=BITMAP_RAB BLBS R0,9$ $EXIT_S R0 9$: $ASSIGN_S DEVICE_NAME,DEVICE_CHANNEL BLBS R0,12$ $EXIT_S R0 12$: ; ; GET THE CURRENT HOME BLOCK FOR INFO ON START OF FILE HEADERS ; MOVL #2,INDEX_RAB+RAB$L_BKT ;GET INITIAL HOME BLOCK MOVAL INDEX_BLOCK,INDEX_RAB+RAB$L_UBF ;V01-007 MOVW #512,INDEX_RAB+RAB$W_USZ ;V01-007 $READ RAB=INDEX_RAB BLBS R0,13$ ;ERROR READING MAIN HOME BLOCK PUSHAL INDEX_RAB+RAB$L_STV PUSHAL INDEX_RAB+RAB$L_STS PUSHAL MAIN_HOME_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE BRW 14$ 13$: ;CHECK CHECKSUMS CLRL R0 MOVL #,R1 MOVAL INDEX_BLOCK,R2 15$: ADDW2 (R2)+,R0 SOBGTR R1,15$ CMPW R0,(R2) BNEQ 16$ ;BRANCH IF CHECKSUM1 DOES NOT MATCH CLRL R0 MOVL #,R1 MOVAL INDEX_BLOCK,R2 17$: ADDW2 (R2)+,R0 SOBGTR R1,17$ CMPW R0,(R2) BNEQ 16$ ;BRANCH IF CHECKSUM2 DOES NOT MATCH BRW 18$ ;CHECKSUMMS OK-CONTINUE 16$: PUSHAL MAIN_HOME_CKSUM_ERROR ;CHECKSUM ERROR-MESSAGE OUTPUT CALLS #1,G^LIB$PUT_OUTPUT 14$: ;ATTEMPT TO GET ALT HOME BLOCK MOVL #3,INDEX_RAB+RAB$L_BKT ;GET ALT HOME BLOCK MOVAL INDEX_BLOCK,INDEX_RAB+RAB$L_UBF ;V01-007 MOVW #512,INDEX_RAB+RAB$W_USZ ;V01-007 $READ RAB=INDEX_RAB BLBS R0,23$ ;ERROR READING ALT HOME BLOCK PUSHAL INDEX_RAB+RAB$L_STV PUSHAL INDEX_RAB+RAB$L_STS PUSHAL ALT_HOME_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 23$: ;CHECK CHECKSUMS CLRL R0 MOVL #,R1 MOVAL INDEX_BLOCK,R2 25$: ADDW2 (R2)+,R0 SOBGTR R1,25$ CMPW R0,(R2) BNEQ 26$ ;BRANCH IF CHECKSUM 1 ERROR CLRL R0 MOVL #,R1 MOVAL INDEX_BLOCK,R2 27$: ADDW2 (R2)+,R0 SOBGTR R1,27$ CMPW R0,(R2) BEQL 18$ ;BRANCH IF CHECKSUM 2 OK 26$: PUSHAL ALT_HOME_CKSUM_ERROR ;BOTH HOME BLOCKS BAD CALLS #1,G^LIB$PUT_OUTPUT ;MESSAGE AND EXIT $EXIT_S .PAGE ;V01-012 .SUBTITLE INIT INTERNAL DATA AREAS ;V01-012 ; ; INITALIZE INTERNAL DATA AREAS ; 18$: CVTWL INDEX_BLOCK+HM2$W_IBMAPVBN,R0 ;GET STARTING VBN AND SIZE OF CVTWL INDEX_BLOCK+HM2$W_IBMAPSIZE,R1 ;FILE HEADER BITMAP ADDL3 R1,R0,FILE_HEADER_1_VBN ;CALC VBN OF FIRST FILE HEADER MNEGL CLUSTER,CURRENT_BLOCK MNEGL CLUSTER,CURRENT_BITMAP_BLOCK MOVAL CHAIN_HEAD,CHAIN_HEAD MOVAL CHAIN_HEAD,CHAIN_HEAD+4 MOVAL HEAP_LIST,HEAP_LIST MOVAL HEAP_LIST,HEAP_LIST+4 CLRL HEAP_SIZE CLRL LAST_FILE_HEADER_VBN CLRL MAX_VM_FLAG CLRL INDEX_EOF_FLAG CLRL CONTROL_Y_FLAG CLRL TOTAL_FRAGMENTS ;V01-002 CLRL EXACT_FIT ;V01-002 CLRL BEST_FIT ;V01-002 CLRL ADJACENT_ELEMENT ;V01-002 CLRL NO_MATCH ;V01-002 CLRL SYSTEM_FILES ;V01-004 CLRL PLACEMENT_CONTROL_FILES ;V01-004 CLRL FILE_STRUCTURE_FILES ;V01-004 CLRL EXTENTION_HEADERS ;V01-004 CLRL HEADER_BUFFER_HEADER_COUNT ;V01-007 CLRL HEADER_BUFFER_FIRST_FID ;V01-007 MOVC5 #0,HEADER_BUFFER,#0,#,-;V01-007 HEADER_BUFFER ;V01-007 .PAGE ;V01-012 .SUBTITLE SETUP TERMINAL ;V01-012 ; ; ASSIGN A CHANNEL TO THE INPUT TERMINAL AND SET UP ; AST'S TO CATCH ^C AND ^Y ; $ASSIGN_S TERMINAL,TERMINAL_CHANNEL BLBS R0,28$ PUSHR #^M PUSHAL TERMINAL_ASSIGN_ERROR CALLS #1,G^LIB$PUT_OUTPUT POPR #^M $EXIT_S R0 28$: CALLG DISABLE_FLAG_ARG,G^LIB$DISABLE_CTRL ;V01-010 BLBS R0,33$ ;V01-010 $EXIT_S R0 ;V01-010 33$: $QIOW_S #1,TERMINAL_CHANNEL,#,IOSB,,,- CONTROL_C_AST,#0,#0 BLBC R0,29$ BLBS IOSB,30$ CVTWL IOSB,R0 29$: $EXIT_S R0 30$: $QIOW_S #1,TERMINAL_CHANNEL,#,IOSB,,,- CONTROL_Y_AST,#0,#0 BLBC R0,31$ BLBS IOSB,32$ CVTWL IOSB,R0 31$: $EXIT_S R0 32$: .PAGE .SUBTITLE MAIN LOOP ;V01-012 ; ; SEARCH BITMAP FOR EMPTY FRAG ; LOOP: CALLG CURRENT_BLOCK_ARG,FIND_NEXT_EMPTY_FRAGMENT ;RETURNS LENGTH IN R0 (-1 INDICATES NONE FOUND) ;RETURNS LBN IN R1 (0 INDICATES NONE FOUND) CMPL #-1,R0 ;SEE IF SEARCH DONE BNEQ 2$ ;V01-010 BRW END_LOOP ;V01-010 2$: ;V01-010 INCL TOTAL_FRAGMENTS ;V01-002 ; ; SAVE FRAGMENT LOCATION INFORMATION ; TSTL CONTROL_Y_FLAG BNEQ END_LOOP MOVL R0,FRAGMENT_LENGTH MOVL R1,FRAGMENT_LBN ; ; PRUNE CHAIN OF INUSE FRAGMENTS OF BLOCKS WITH LOWER LBN THAN ; FRAGMENT FOUND AND ADD NEW INUSE FRAGMENTS AS SPACE IS AVAILABLE ; CALLG FRAGMENT_ARG,PRUNE_CHAIN TSTL CONTROL_Y_FLAG BNEQ END_LOOP ; ; FIND BEST FIT FOR BLOCK TO MOVE DOWN ; CALLG FRAGMENT_ARG,FIND_BEST_FIT .IF DF DEBUG CALLS #0,DUMP_BEST_FIT .ENDC TSTL CONTROL_Y_FLAG BNEQ END_LOOP ;RETURNS POINTER TO CHAIN ELEMENT DESCRIPTER OF ELEMENT TO BE ;MOVED OR -1 IF NONE FOUND CMPL #-1,R0 BNEQ 1$ ;V01-010 ADDL2 FRAGMENT_LENGTH,CURRENT_BLOCK ;V01-010 SUBL2 CLUSTER,CURRENT_BLOCK ;V01-010 BRW LOOP ;V01-010 1$: ;V01-010 PUSHL R0 PUSHAL FRAGMENT_LBN PUSHAL FRAGMENT_LENGTH ; ; MOVE DOWN SOURCE FRAGMENT TO TARGET LOCATION AND DO ALL UPDATES TO ; THE DISK FILE SYSTEM ; CALLS #3,MOVE_BLOCK_AND_UPDATE TSTL CONTROL_Y_FLAG BNEQ END_LOOP ; ; REPEAT TILL DONE ; BRW LOOP .PAGE .SUBTITLE SHUTDOWN ;V01-012 END_LOOP: ;V01-012 CALLG DISABLE_FLAG_ARG,G^LIB$ENABLE_CTRL ;V01-010 ; ; RELEASE ALL DISK FILES ; $DASSGN_S DEVICE_CHANNEL $DISCONNECT RAB=INDEX_RAB $CLOSE FAB=INDEX_FAB $DISCONNECT RAB=BITMAP_RAB $CLOSE FAB=BITMAP_FAB ; ; ONE LAST PARTING SHOT ; CALLS #0,FINAL_MESSAGE $EXIT_S .PAGE .SUBTITLE FIND NEXT EMPTY FRAGMENT ;V01-012 .ENTRY FIND_NEXT_EMPTY_FRAGMENT,^M ; ; CALLED WITH 1 ARG-STARTING BLOCK NUMBER ; VALUE IS INITAILLY -1 ; RETURN R0=LENGTH ; R1=LBN ; UNLESS NONE FOUND THEN RETURN R0=-1,R1=0 ; FIRST FIND START OF EMPTY FRAGMENT ; 10$: ADDL2 CLUSTER,@4(AP) ;GO TO NEXT CLUSTER DIVL3 CLUSTER,@4(AP),R11 ;GET CLUSTER NUMBER OF STARTING BLOCK DIVL3 #<512*8>,R11,R10 ;GET BLOCK IN BITMAP OF STARTING CLUSTER ADDL3 #2,R10,BITMAP_RAB+RAB$L_BKT ; ; SEE IF WE ALREADY HAVE THE REQUIRED BITMAP BLOCK IN MEMORY ; CMPL BITMAP_RAB+RAB$L_BKT,CURRENT_BITMAP_BLOCK BEQL 1$ MOVL BITMAP_RAB+RAB$L_BKT,CURRENT_BITMAP_BLOCK $READ RAB=BITMAP_RAB ;INPUT REQUIRED BLOCK BLBS R0,1$ CMPL #RMS$_EOF,R0 BNEQ 2$ MOVL #-1,R0 CLRL R1 RET 2$: PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S ; ; GET BYTE OF BITMAP BLOCK CONTAINING INUSE FLAG ; 1$: BICL3 #^C4095,R11,R9 ;CALCULATE BYTE CONTAINING BIT DIVL2 #8,R9 MOVB BITMAP_BLOCK(R9),R8 ;GET BYTE MOVL R11,R9 ;CALCULATE BIT OFFSET BICL2 #^C7,R9 BBS R9,R8,11$ ;CHECK BIT CLEAR BRW 10$ ;BIT CLEAR-BLOCK IN USE-CHECK NEXT 11$: MOVL @4(AP),R3 ;LOAD STARTING LBN MOVL CLUSTER,R2 ;INITIAL FRAG BLOCK COUNT MOVL @4(AP),R4 ;GET NEXT BLOCK POINTER 20$: ADDL2 CLUSTER,R4 ;GO TO NEXT CLUSTER DIVL3 CLUSTER,R4,R11 ;GET CLUSTER NUMBER OF STARTING BLOCK DIVL3 #<512*8>,R11,R10 ;GET BLOCK IN BITMAP OF STARTING CLUSTER ADDL3 #2,R10,BITMAP_RAB+RAB$L_BKT ; ; AS REQUIRED-READ IN NEW BITMAP BLOCK ; CMPL BITMAP_RAB+RAB$L_BKT,CURRENT_BITMAP_BLOCK BEQL 21$ MOVL BITMAP_RAB+RAB$L_BKT,CURRENT_BITMAP_BLOCK $READ RAB=BITMAP_RAB BLBS R0,21$ CMPL #RMS$_EOF,R0 BNEQ 22$ MOVL R2,R0 MOVL R3,R1 RET 22$: PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S ; ; GET BYTE OF BITMAP BLOCK CONTAINING INUSE FLAG ; 21$: BICL3 #^C4095,R11,R9 ;CALC BYTE OFFSET OF BYTE CONTAINING BIT DIVL2 #8,R9 MOVB BITMAP_BLOCK(R9),R8 ;GET BIT MOVL R11,R9 ;CALC BIT FLAG OFFSET BICL2 #^C7,R9 BBC R9,R8,30$ ;SEE IF FREE ADDL2 CLUSTER,R2 ;YES-SET UP TO CHECK IF NEXT ALSO FREE BRW 20$ 30$: MOVL R2,R0 ;HAVE FULL SIZE AND FIRST LBN OF FRAGMENT MOVL R3,R1 ;SET UP RETURN RET .PAGE .SUBTITLE SYSTEM ERROR MESSAGE HANDLEING .ENTRY SYSTEM_ERROR_MESSAGE,^M ; ; CALLED WITH 3 ARGUMENTS ACCORING TO FORTRAN STD ; ARG1 INDEX ERROR MESSAGE PASS BY DESCRIPTER ; ARG2 SYSTEM ERROR VALUE (SS$_XXX OR RMS$_XXX) ; ARG3 SUPLIMENTAL VALUE TO ABOVE-USEUALLY FAB/RAB$L_STV VALUE ; OUTPUTS TO LIST FILE ARE NOT DONE HERE ; TSTL 4(AP) ;CHECK FOR CALLER SUPPLIED ERROR MESSAGE BEQL 16$ ;SKIP IF NONE PUSHAL @4(AP) ;FIRST OUTPUT THE INDEX ERROR MESSAGE CALLS #1,G^LIB$PUT_OUTPUT 16$: EXTZV #16,#12,@8(AP),R0 ;GET FACILITY CODE CMPL #0,R0 ;IS IT A SYSTEM CODE BNEQ 1$ ;NO BRW 100$ ;YES 1$: CMPL #1,R0 ;IS IT AN RMS CODE BEQL 2$ ;YES BRW 200$ ;NO .MACRO CHKERR ERR,DST,?A CMPL #ERR,R0 BNEQ A BRW DST A: .ENDM CHKERR 2$: ; ; SET UP RMS ERROR CODES ; MOVW #2,MESSAGE_VECTOR MOVW #15,MESSAGE_VECTOR+2 MOVL @8(AP),MESSAGE_VECTOR+4 CLRL MESSAGE_VECTOR+8 MOVL @8(AP),R0 ; ; CHECK ERROR CODES THAT MIGHT HAVE A SECONDARY ERROR MESSAGE ; CHKERR RMS$_ACC,10$ CHKERR RMS$_AID,10$ CHKERR RMS$_ALN,10$ CHKERR RMS$_AOP,10$ CHKERR RMS$_ATR,10$ CHKERR RMS$_ATW,10$ CHKERR RMS$_BKZ,10$ CHKERR RMS$_CCF,10$ CHKERR RMS$_CDA,10$ CHKERR RMS$_CHN,10$ CHKERR RMS$_COD,10$ CHKERR RMS$_CRE,10$ CHKERR RMS$_CRMP,10$ CHKERR RMS$_DAC,10$ CHKERR RMS$_DAN,10$ CHKERR RMS$_DFL,10$ CHKERR RMS$_DNF,10$ CHKERR RMS$_DPE,10$ CHKERR RMS$_DTP,10$ CHKERR RMS$_ENQ,10$ CHKERR RMS$_ENT,10$ CHKERR RMS$_EXT,10$ CHKERR RMS$_FLG,10$ CHKERR RMS$_FND,10$ CHKERR RMS$_IAN,10$ CHKERR RMS$_IBF,10$ CHKERR RMS$_IBK,10$ CHKERR RMS$_IFA,10$ CHKERR RMS$_IFL,10$ CHKERR RMS$_IMX,10$ CHKERR RMS$_IRC,10$ CHKERR RMS$_KNM,10$ CHKERR RMS$_KSI,10$ CHKERR RMS$_LAN,10$ CHKERR RMS$_MKD,10$ CHKERR RMS$_NET,10$ CHKERR RMS$_NETFAIL,10$ CHKERR RMS$_ORD,10$ CHKERR RMS$_POS,10$ CHKERR RMS$_RER,10$ CHKERR RMS$_RMV,10$ CHKERR RMS$_RPL,10$ CHKERR RMS$_SIZ,10$ CHKERR RMS$_SPL,10$ CHKERR RMS$_SUP,10$ CHKERR RMS$_SYS,10$ CHKERR RMS$_SUPPORT,10$ CHKERR RMS$_WBE,10$ CHKERR RMS$_WER,10$ CHKERR RMS$_WPL,10$ CHKERR RMS$_XAB,10$ BRW 300$ 10$: MOVL @12(AP),MESSAGE_VECTOR+8 ;PRIMARY ERROR HAS SECONDARY BRW 300$ ;ERROR MESSAGE 100$: ; ;SYSTEM ERROR CODES ; MOVW #1,MESSAGE_VECTOR MOVW #15,MESSAGE_VECTOR+2 MOVL @8(AP),MESSAGE_VECTOR+4 ; ; ADD SYSTEM ERROR CHECKS HERE FOR FA0 ARGS ; BRW 300$ 200$: ; ; ALL OTHER ERROR TYPES ; MOVW #2,MESSAGE_VECTOR MOVW #15,MESSAGE_VECTOR+2 MOVL @8(AP),MESSAGE_VECTOR+4 CLRL MESSAGE_VECTOR+8 BRW 300$ 300$: PUSHAL MESSAGE_VECTOR CALLS #1,G^SYS$PUTMSG RET .PAGE .SUBTITLE PRUNE_CHAIN AND ADD MORE RETRIEVAL POINTERS .ENTRY PRUNE_CHAIN,^M ; ; REMOVE FROM CHAIN OF RETRIVAL POINTERS ALL THOSE POINTING ; TO INUSE FRAGMENTS WITH STARTING LBN'S LESS THAN THE LBN ; OF THE CURRENT EMPTY FRAGMENT. ; 2$: CMPL CHAIN_HEAD,CHAIN_HEAD+4 ;CHECK FOR EMPTY CHAIN BEQL 1$ ;CHAIN IS EMPTY MOVL CHAIN_HEAD,R0 ;GET FIRST-(LOWEST LBN) RETRIEVAL PTR) CMPL @8(AP),CHAIN_ELEMENT_L_LBN(R0);IS IT BELOW FRAG LBN? BLSSU 1$ ;NO-DONE WITH REMOVE OPERATION REMQUE @CHAIN_HEAD,R0 ;YES-REMOVE FROM QUEUE INSQUE (R0),HEAP_LIST ;PUT ON EMPTY LIST INCL HEAP_SIZE ;BUMP SIZE OF EMPTY LIST BRB 2$ ;LOOP TILL DONE 1$: ; ; NOW TO UPDATE CHAIN ; TSTL INDEX_EOF_FLAG ;SEE IF ALL FILE HEADERS SCANNED YET BEQL 3$ ;NO-GO ADD RETRIVAL PTRS AS SPACE PERMITS RET ;YES-QUIT 3$: ; ; SEE IF ADDITIONAL ENTRIES OK AT THIS POINT ; TSTL MAX_VM_FLAG ;ARE WE OUT OF AVAILABLE VIRTUAL MEMORY BEQL 1003$ ;NOT RUN OUT OF V.M. YET CMPL #30,HEAP_SIZE ;SEE IF NUMBER OF UNUSED ELEMENTS ADEQUATE BLSS 1003$ ;YES RET ;NO-WAIT TILL MORE AVAILABLE 1003$: INCL LAST_FILE_HEADER_VBN ;GO TO NEXT FILE_HEADER PUSHAL INDEX_BLOCK ;V01-007 PUSHAL LAST_FILE_HEADER_VBN ;V01-007 CALLS #2,READ_HEADER ;V01-007 BLBS R0,4$ ;BRANCH IF NO ERROR ; TO GET HERE CAN ONLY BE EOF ;V01-007 MOVL #1,INDEX_EOF_FLAG;SET EOF FLAG WE HAVE READ ALL PTRS RET ; ; SEE IF USER HIT ^Y-RETURN IF YES ; 4$: TSTL CONTROL_Y_FLAG BEQL 1004$ RET 1004$: ; ; CONFIRM IT IS A VALID FILE HEADER ; ; CHECKS BASED ON THOSE USED BY DUMP-CODE ADAPTED FROM THAT READ ; IN SOURCE FICHE. ; MOVAL INDEX_BLOCK,R0 ;CHECK CHECKSUM CLRL R1 MOVL #,R2 6$: ADDW2 (R0)+,R1 SOBGTR R2,6$ CMPW R1,(R0) BEQL 7$ BRW 3$ ;BAD CHECKSUM 7$: CMPB INDEX_BLOCK+FH2$B_STRUCLEV,#2;CHECK STRUCTURE LEVEL BEQL 8$ BRW 3$ ;BAD STRUCTURE ; ; CHECK OFFSETS INTO HEADER ; 8$:; CMPB INDEX_BLOCK+FH2$B_IDOFFSET,# ;V01-011 ; BLSSU 9$ ;V01-011 CMPB INDEX_BLOCK+FH2$B_MPOFFSET,INDEX_BLOCK+FH2$B_IDOFFSET BLSSU 9$ CMPB INDEX_BLOCK+FH2$B_ACOFFSET,INDEX_BLOCK+FH2$B_MPOFFSET BLSSU 9$ CMPB INDEX_BLOCK+FH2$B_RSOFFSET,INDEX_BLOCK+FH2$B_ACOFFSET BLSSU 9$ SUBB3 INDEX_BLOCK+FH2$B_MPOFFSET,INDEX_BLOCK+FH2$B_ACOFFSET,R0 CMPB INDEX_BLOCK+FH2$B_MAP_INUSE,R0 BGTRU 9$ ; ; SEE IF HEADER IN USE ; TSTW INDEX_BLOCK+FH2$W_FID_NUM BNEQ 10$ TSTB INDEX_BLOCK+FH2$B_FID_NMX BNEQ 10$ 9$: BRW 3$ 10$: ; ; ALSO MUST NOT BE AN EXTENTION FILE HEADER ; TSTW INDEX_BLOCK+FH2$W_SEG_NUM BEQL 11$ INCL EXTENTION_HEADERS ;V01-004 BRW 3$ 11$: ; ; CHECK TO SEE IF IT IS ONE OF THE EXCLUDED FILES ; ; FIRST EXCLUDE ALL FILES OWNED BY [1,*] ; CMPW #1,INDEX_BLOCK+FH2$W_UICGROUP BNEQ 12$ INCL SYSTEM_FILES ;V01-004 BRW 3$ 12$: ; ; ALL OF THE BASIC FILE STRUCTURE REQUIRED FILES ; FID_NUM 1-9 ; TSTB INDEX_BLOCK+FH2$B_FID_NMX BNEQ 13$ CMPW #9,INDEX_BLOCK+FH2$W_FID_NUM BLSSU 13$ INCL FILE_STRUCTURE_FILES ;V01-004 BRW 3$ ; ; DIRECTORY FILES ; 13$:; BITL #FH2$M_DIRECTORY,INDEX_BLOCK+FH2$L_FILECHAR ; BEQL 14$ ; BRW 3$ ; ; NOW START SCANNING THE LIST OF RETRIVAL POINTERS ; 14$: MOVZBL INDEX_BLOCK+FH2$B_MPOFFSET,R11 ;GET START OF MAP;V01-005 MULL2 #2,R11 MOVZBL INDEX_BLOCK+FH2$B_MAP_INUSE,R10 ;V01-005 MULL2 #2,R10 ADDL2 R11,R10 20$: CMPL R11,R10 ;SEE IF ALL POINTERS HAVE BEEN SCANNED BLSS 31$ ;NO-GET NEXT BRW 40$ ;YES ; ; EXTRACT FORMAT FIELD ; 31$: EXTZV #FM2$V_FORMAT,#FM2$S_FORMAT,INDEX_BLOCK(R11),R9 ; ; IS IT PLACEMENT CONTROL ; CMPB #FM2$C_PLACEMENT,R9 BNEQ 32$ ;NO ; ; IGNORE PLACEMENT CONTROL THIS FILE CANBE MOVED ;V01-013 ; INCL PLACEMENT_CONTROL_FILES ;V01-004 ADDL2 #4,R11 ;V01-013 BRW 20$ ;V01-013 ; ; IS IT FORMAT 1 ; 32$: CMPB #FM2$C_FORMAT1,R9 BNEQ 33$ ; ; EXTRACT COUNT AND STARTING LBN OF INUSE FRAGMENT ; SAVE ALONG WITH OFFSET OF RETRIEVAL PTR IN FILE HEADER ; AND UPDATE OFFSET TO NEXT PTR. ; MOVZBL INDEX_BLOCK+FM2$B_COUNT1(R11),COUNT MOVZWL INDEX_BLOCK+FM2$W_LOWLBN(R11),LBN EXTZV #FM2$V_HIGHLBN,#FM2$S_HIGHLBN,INDEX_BLOCK(R11),R0 INSV R0,#16,#16,LBN MOVL R11,FRAGMENT_RETRIEVAL ADDL2 #4,R11 BRB 39$ ; ; IS IT FORMAT 2 ; 33$: CMPB #FM2$C_FORMAT2,R9 BNEQ 34$ ;NO ; ; EXTRACT COUNT AND STARTING LBN OF INUSE FRAGMENT ; SAVE ALONG WITH OFFSET OF RETRIEVAL PTR IN FILE HEADER ; AND UPDATE OFFSET TO NEXT PTR. ; EXTZV #FM2$V_COUNT2,#FM2$S_COUNT2,INDEX_BLOCK(R11),COUNT MOVL INDEX_BLOCK+FM2$L_LBN2(R11),LBN MOVL R11,FRAGMENT_RETRIEVAL ADDL2 #6,R11 BRB 39$ ; ; CAN ONLY BE FORMAT 3 ; 34$: CMPB #FM2$C_FORMAT3,R9 BNEQ 35$ ;OOP'S NOT 3 EITHER ; ; EXTRACT COUNT AND STARTING LBN OF INUSE FRAGMENT ; SAVE ALONG WITH OFFSET OF RETRIEVAL PTR IN FILE HEADER ; AND UPDATE OFFSET TO NEXT PTR. ; ROTL #16,INDEX_BLOCK(R11),R0 EXTZV #0,#30,R0,COUNT MOVL INDEX_BLOCK+FM2$L_LBN3(R11),LBN ;V01-003 MOVL R11,FRAGMENT_RETRIEVAL ADDL2 #8,R11 BRB 39$ 35$: ; ;BAD FORMAT SKIP IT ; BRW 3$ ; ; COUNT IS STORED IN RETRIEVAL POINTER AS COUNT-1, FIX UP ; 39$: INCL COUNT ; ; NOW SEE ABOUT PUTTING IT IN THE CHAIN ; IN SEQUENTIAL ORDER BY LBN ; CMPL @8(AP),LBN ;IF IT IS A LBN LOWER THAN FRAGMENT LBN-SKIP IT BLSSU 38$ ;NO BRW 20$ ;YES-FORGET THIS ONE ; ; GET EMPTY ELEMENT FROM HEAP ; 38$: REMQUE @HEAP_LIST,R0 ;GET FREE ELEMENT BVC 50$ ;GOT ONE ; ; HEAP OF EMPTY ELEMNTS FOR CHAIN IS EMPTY-GET MORE FROM VM. ; TSTL MAX_VM_FLAG ;SEE IF ALREADY OUT OF VIRTUAL MEMORY BNEQ 60$ ;YES-HANDLE DIFFERENTLY PUSHAL BASE_ADDRESS ;GET MORE HEAP FROM VIRTUAL MEMORY PUSHAL NUMBER_BYTES MOVL #80*CHAIN_ELEMENT_SIZE,NUMBER_BYTES CALLS #2,G^LIB$GET_VM BLBS R0,60$ ;CHECK FOR ERROR MOVL #1,MAX_VM_FLAG ;USED UP V.M.-SET FLAG BRB 70$ ;GO HANDLE IT DIFFERENTLY ; ; ADD NEW VM TO HEAP QUEUE LIST ; 60$: MOVL #80,HEAP_SIZE MOVL BASE_ADDRESS,R0 MOVL #80,R1 61$: INSQUE (R0),HEAP_LIST ADDL2 #CHAIN_ELEMENT_SIZE,R0 SOBGTR R1,61$ ; ; REMOVE ONE ELEMENT FOR CURRENT POINTER ; REMQUE @HEAP_LIST,R0 BRW 50$ ;ADD TO CHAIN ; ; OUT OF HEAP AND V.M. TO EXTEND IT-SEE ABOUT USEING REUSEING ; ELEMENTS FROM LOW END OF LBN LIST ; 70$: ; ; FIRST CHECK IF LBN IS LOWER THAN LOWEST ELEMENT IN LIST ; MOVL CHAIN_HEAD,R1 CMPL LBN,CHAIN_ELEMENT_L_LBN(R1) BGTRU 71$ ;NO-IS HIGHER SO USE THIS ONE IN ITS PLACE BRW 20$ ;LOWER-FORGET THIS POINTER ; ; TAKE OFF TOP ELEMENT FROM LIST ; 71$: REMQUE @CHAIN_HEAD,R0 BRB 51$ 50$: DECL HEAP_SIZE ;ACCOUNT FOR CHANGE IN HEAP SIZE ; ; INIT THE ELEMENT WITH RETRIVAL INFORMATION ; 51$: MOVW INDEX_BLOCK+FH2$W_FID_NUM,CHAIN_ELEMENT_L_SEQUENCE(R0) MOVZBW INDEX_BLOCK+FH2$B_FID_NMX,CHAIN_ELEMENT_L_SEQUENCE+2(R0) MOVL FRAGMENT_RETRIEVAL,CHAIN_ELEMENT_L_RETRIEVAL(R0) MOVL LBN,CHAIN_ELEMENT_L_LBN(R0) MOVL COUNT,CHAIN_ELEMENT_L_SIZE(R0) ; ; AND PUT IT IN THE CHAIN IN ITS PROPER ORDER BY LBN ; FIRST CHECK BOUNDRY CONDITIONS ; CMPL CHAIN_HEAD,CHAIN_HEAD+4 ;EMPTY LIST BNEQ 52$ INSQUE (R0),CHAIN_HEAD ;PUT IN AS FIRST ELEMENT IN LIST BRW 20$ ;NEXT POINTER 52$: MOVL CHAIN_HEAD,R1 ;SEE IF LOWER THAN CURRENT LOW LBN CMPL CHAIN_ELEMENT_L_LBN(R0),CHAIN_ELEMENT_L_LBN(R1) BGTRU 53$ ;NEW LOWEST LBN?? INSQUE (R0),CHAIN_HEAD ;YES-PUT IN AT HEAD OF LIST BRW 20$ 53$: MOVL CHAIN_HEAD+4,R1 ;SEE IF HIGHER THAN LAST LBN CMPL CHAIN_ELEMENT_L_LBN(R0),CHAIN_ELEMENT_L_LBN(R1) BLSSU 54$ ;NEW HIGHEST LBN?? INSQUE (R0),@CHAIN_HEAD+4;YES INSTALL AT END OF LIST BRW 20$ 54$: ; ;OK DO A SCAN FROM HIGH TO LOW FOR INSERTION POINT ; CMPL CHAIN_ELEMENT_L_LBN(R0),CHAIN_ELEMENT_L_LBN(R1) BGTRU 55$ ;FOUND SPOT ?? MOVL 4(R1),R1;NO-BACK UP POINTER TO NEXT LOWER ENTRY BRB 54$ ;AND CONTINUE CHECK 55$: INSQUE (R0),(R1);INSERT IN QUEUE AT PROPER LOCATION BRW 20$ ; ; THIS HEADER USED UP-SEE IF THERE IS AN EXTENTION HEADER FOR THIS ; FILE ; 40$: MOVW INDEX_BLOCK+FH2$W_EX_FIDNUM,COUNT MOVZBW INDEX_BLOCK+FH2$B_EX_FIDNMX,COUNT+2 TSTL COUNT BNEQ 41$ ;YES THERE IS AN EXTENTION HEADER FOR THIS FILE BRW 3$ ;NO-GO TO NEXT FILE ; ; CALCULATE VBN AND READ IN EXTENTION HEADER FOR THIS FILE ; 41$: ADDL3 FILE_HEADER_1_VBN,COUNT,R0 SUBL3 #1,R0,INDEX_RAB+RAB$L_BKT MOVAL INDEX_BLOCK,INDEX_RAB+RAB$L_UBF ;V01-007 MOVW #512,INDEX_RAB+RAB$W_USZ ;V01-007 $READ RAB=INDEX_RAB BLBS R0,44$ PUSHAL INDEX_RAB+RAB$L_STV PUSHAL INDEX_RAB+RAB$L_STS PUSHAL INDEX_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 44$: TSTL CONTROL_Y_FLAG BEQL 1044$ RET 1044$: ; ; CONFIRM IT IS A VALID FILE HEADER ; MOVAL INDEX_BLOCK,R0 ;CHECKSUM CLRL R1 MOVL #,R2 46$: ADDW2 (R0)+,R1 SOBGTR R2,46$ CMPW R1,(R0) BEQL 47$ BRW 3$ 47$: CMPB INDEX_BLOCK+FH2$B_STRUCLEV,#2 ;STRUCTURE LEVEL BEQL 48$ BRW 3$ ; ; OFFSETS ; 48$:; CMPB INDEX_BLOCK+FH2$B_IDOFFSET,# ;V01-011 ; BLSSU 49$ ;V01-011 CMPB INDEX_BLOCK+FH2$B_MPOFFSET,INDEX_BLOCK+FH2$B_IDOFFSET BLSSU 49$ CMPB INDEX_BLOCK+FH2$B_ACOFFSET,INDEX_BLOCK+FH2$B_MPOFFSET BLSSU 49$ CMPB INDEX_BLOCK+FH2$B_RSOFFSET,INDEX_BLOCK+FH2$B_ACOFFSET BLSSU 49$ SUBB3 INDEX_BLOCK+FH2$B_MPOFFSET,INDEX_BLOCK+FH2$B_ACOFFSET,R0 CMPB INDEX_BLOCK+FH2$B_MAP_INUSE(R11),R0 BGTRU 49$ ; ; MAKE SURE IN USE ; TSTW INDEX_BLOCK+FH2$W_FID_NUM BNEQ 42$ TSTB INDEX_BLOCK+FH2$B_FID_NMX BNEQ 42$ 49$: BRW 3$ 42$: ; ; ALSO MUST BE AN EXTENTION FILE HEADER ; TSTW INDEX_BLOCK+FH2$W_SEG_NUM BNEQ 43$ BRW 3$ 43$: BRW 13$ ;CONTINUE SCANNING RETRIVAL POINTERS .PAGE .SUBTITLE CONTROL C AST ; ; WHEN THE USER HITS ^C, CATCH IT AND WRITE OUT INFO IN WHERE ; PROGRAM IS ON THE DISK ; .ENTRY CONTROL_C_AST,^M ; ; RESET ^C AST FOR NEXT ^C ISSUED ; $QIOW_S #1,TERMINAL_CHANNEL,#,IOSB,,,- CONTROL_C_AST,#0,#0 ; ; CREATE AND OUTPUT MESSAGE SHOWING HOW FAR ALONG WE ARE ; PUSHL LAST_FILE_HEADER_VBN PUSHL CURRENT_BLOCK PUSHAL CURRENT_BLOCK_MESSAGE PUSHL #0 PUSHAL CURRENT_BLOCK_FORMAT CALLS #5,G^SYS$FAO PUSHAL CURRENT_BLOCK_MESSAGE CALLS #1,G^LIB$PUT_OUTPUT RET .PAGE .SUBTITLE CONTROL Y AST ; ; WHEN THE USER HITS ^Y, SET A FLAG FOR THE MAIN LINE CODE. ; THIS ALLOWS THE PROGRAM TO DO A CLEAN EXIT AS SOON AS POSSABLE ; AFTER THE ^Y WAS HIT AND STILL LEAVE THE DISK USEABLE ; .ENTRY CONTROL_Y_AST,^M ; ; RESET ^Y AST SO CAN CATCH ANY OTHER ^Y INCASE USER HITS IT AGAIN ; BEFORE EXIT OCCOURS ; $QIOW_S #1,TERMINAL_CHANNEL,#,IOSB,,,- CONTROL_Y_AST,#0,#0 MOVL #1,CONTROL_Y_FLAG ;SET ^Y FLAG RET .PAGE .SUBTITLE FIND BEST FIT .ENTRY FIND_BEST_FIT,^M ; ; ARG1 LEN OF FRAGMENT TO FIT ; ARG2 LBN OF FRAGMENT TO FIT ; RETURNS ; R0=POINTER TO CHAIN ELEMENT DESCRIPTER OF FRAGMENT TO MOVE ; OR -1 IF NONE FOUND ; ; LOGIC FOR BEST FIT IS AS FOLLOWS ; ; SCANS ONLY KNOWN INUSE DISK FRAGMENTS WITH LBN'S GREATER THAN ; THE LBN OF THE EMPTY FRAGMENT TO BE FILLED. IF ALL THE DISK LBN'S ; FROM THE FILE HEADER RETRIEVAL POINTERS DO NOT FIT, THEN THOSE THAT ; ARE KNOWN ARE USED AND THE REST ARE IGNORED. ; ORDER OF SELECTION FOR BEST FIT ; 1 IN USE DISK FRAGMENT OF EXACT SIZE WITH HIGHEST LBN ; 2 LARGEST INUSE DISK FRAGMENT THAT SILL FITS IN UNUSED FRAGMENT ; WITH LARGEST LBN ; 3 IF KNOWN, THE INUSE DISK FRAGMENT JUST ABOVE FRAGMENT TO BE ; FILLED ; ; MOVL @4(AP),R11 ;GET LENGTH TO FIT TO CLRL R10 ;GET POINTER TO BEST FIT SO FAR MOVAL CHAIN_HEAD,R9 ;POINTER TO CHAIN HEAD MOVL R9,R8 ;SCAN LIST USEING COPY 1$: MOVL 4(R8),R8 ;RUN BACKWARDS THROUGH THE LIST CMPL R8,R9 ;SEE IF DONE BEQL 50$ ;YES-EXIT LOOP CMPL CHAIN_ELEMENT_L_SIZE(R8),R11 ;CHECK FIT BGTRU 1$ ;TO BIG-GOTO NEXT ENTRY BEQL 40$ ;FOUND EXACT MATCH TSTL R10 ;SEE IF PARTIAL FIT FOUND BNEQ 2$ ;YES ;NO PARTIAL FIT YET-MAKE THIS IT MOVL R8,R10 BRB 1$ ; ; PARTIAL FIT FOUND-SEE IF BETTER FIT THAN ONE ALREADY AVAILABLE ; 2$: CMPL CHAIN_ELEMENT_L_SIZE(R8),CHAIN_ELEMENT_L_SIZE(R10) BLEQU 1$ ;NOT A CLOSER FIT-SKIP TO NEXT MOVL R8,R10 BRB 1$ 40$: MOVL R8,R0 ;LOAD EXACT FIT INCL EXACT_FIT ;V01-002 RET ;AND EXIT 50$: TSTL R10 ;SEE WHAT FOUND BNEQ 51$ ;GOT SOMETHING ; ; GOT NOTHING ; CHECK TO SEE IF ADJACENT ELEMENT EXISTS ; ADDL3 @4(AP),@8(AP),R1;GET ADDR OF TARGET START LBN OF INUSE FRAG MOVL CHAIN_HEAD,R0 ;GET ADDR OF LOWEST KNOWN INUSE FRAG CMPL R1,CHAIN_ELEMENT_L_LBN(R0) ;SEE IF SAME BNEQ 52$ ;NO INCL ADJACENT_ELEMENT ;V01-002 RET ;USE ADJACENT INUSE FRAGMENT 52$: MOVL #-1,R0 ;NO BEST FIT FOUND INCL NO_MATCH ;V01-002 RET 51$: MOVL R10,R0 ;USE BEST FIT INCL BEST_FIT ;V01-002 RET .PAGE .SUBTITLE MOVE BLOCK AND UPDATE .ENTRY MOVE_BLOCK_AND_UPDATE,^M ; ; THIS IS THE ROUTINE THAT DOES THE ACTUALL MOVE AND UPDATE ; IT CANNOT BE INTERUPPTED BUT IS WRITTEN IN SUCH A WAY AS TO ; MINIMIZE THE EFFECT OF ANY PREMATURE STOPAGE. ALL OTHER ACTIVITY ; UP TO THIS ROUTINE HAS BEEN PASSIVE-THIS IS THE ONLY PLACE ; WHERE THE DISK CAN GET CORRUPTED. ; ; PASSED ARG ; ARG 1 LENGTH OF FRAGMENT TO BE FILLED ; ARG 2 LBN OF FRAGMENT TO BE FILLED ; ARG 3 CHAIN ELEMENT OF FILE FRAGMENT TO DO FILLING ; ; ACTIONS TO BE TAKEN IN ORDER TO BE DONE ; 1 MOVE BLOCKS TO FRAGMENT TO BE FILLED ; 2 UPDATE BITMAP TO SHOW BLOCKS PREVIOUSLY USED IN FILE ARE NOW FREE ; 3 UPDATE BITMAP TO SHOW EMPTY FRAGMENT BLOCKS NOW IN USE ; 4 UPDATE FILE HEADER RETRIVAL POINTER TO POINT TO NEW BLOCKS ; JUST FILLED-USE SAME POINTER FORMAT ; 5 RELEASE CHAIN ELEMENT FROM CHAIN AND PUT INTO HEAP LIST ; ; STEP 1 MAKE THE MOVE OF FILE FRAGMENT ; MOVL 12(AP),R11 ;GET ADDR OF DESCRIPTER ELEMENT MOVL CHAIN_ELEMENT_L_SIZE(R11),R10 ;GET BLOCKS TO TRANSFER MOVL CHAIN_ELEMENT_L_LBN(R11),R9 ;SOURCE LBN MOVL @8(AP),R8 ;DESTINATION LBN 1$: CMPL #MAX_BLOCK_TRANSFER,R10 ;SEE IF MULTI BLOCK XFER REQ BLSSU 1001$ BRW 2$ ;NO ONLY ONE NEEDED 1001$: $QIOW_S ,DEVICE_CHANNEL,#IO$_READLBLK,IOSB,,,TRANSFER_BUFFER,- #,R9 BLBS R0,3$ PUSHL #0 MOVL R0,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 3$: BLBS IOSB,4$ PUSHL #0 CVTWL IOSB,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 4$: $QIOW_S ,DEVICE_CHANNEL,#IO$_WRITELBLK,IOSB,,,TRANSFER_BUFFER,- #,R8 BLBS R0,5$ PUSHL #0 MOVL R0,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 5$: BLBS IOSB,6$ PUSHL #0 CVTWL IOSB,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S ; ; UPDATE POINTERS AND COUNTERS FOR NEXT TRANSFER ; 6$: SUBL2 #MAX_BLOCK_TRANSFER,R10 ADDL2 #MAX_BLOCK_TRANSFER,R9 ADDL2 #MAX_BLOCK_TRANSFER,R8 BRW 1$ ; ; LAST TRANSFER ; 2$: MULL2 #512,R10 ;GET NUMBER OF BYTES TO XFER $QIOW_S ,DEVICE_CHANNEL,#IO$_READLBLK,IOSB,,,TRANSFER_BUFFER,- R10,R9 BLBS R0,7$ PUSHL #0 MOVL R0,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 7$: BLBS IOSB,8$ PUSHL #0 CVTWL IOSB,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 8$: $QIOW_S ,DEVICE_CHANNEL,#IO$_WRITELBLK,IOSB,,,TRANSFER_BUFFER,- R10,R8 BLBS R0,9$ PUSHL #0 MOVL R0,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 9$: BLBS IOSB,10$ PUSHL #0 CVTWL IOSB,ERROR_1 PUSHAL ERROR_1 PUSHAL TRANSFER_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 10$: .PAGE ; ; STEP 2 SET NOW UNUSED BITS IN BITMAP ; MOVL CHAIN_ELEMENT_L_SIZE(R11),R10 ;GET BLOCKS TO TRANSFER MOVL CHAIN_ELEMENT_L_LBN(R11),R9 ;SOURCE LBN DIVL3 CLUSTER,R10,R8 ;CALC NUMBER OF CLUSTERS MULL3 CLUSTER,R8,R0 SUBL3 R0,R10,R1 BEQL 11$ INCL R8 11$: DIVL2 CLUSTER,R9 ;GET STARTING CLUSTER NUMBER 13$: DIVL3 #<512*8>,R9,R7 ;CALC BLOCK NO IN BITMAP OF BIT ; ; DETERMINE WHAT BLOCK OF BIT MAP IS WANTED, SEE IF IT IS ALREADY ; IN MEMORY. IF IT ISN'T THEN OUTPUT THE ONE CURRENTLY ; HERE AND READ IN THE ONE WANTED ; ADDL3 #2,R7,R6 CMPL R6,CURRENT_BITMAP_BLOCK BEQL 12$ MOVL CURRENT_BITMAP_BLOCK,BITMAP_RAB+RAB$L_BKT $WRITE RAB=BITMAP_RAB BLBS R0,15$ PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 15$: MOVL R6,BITMAP_RAB+RAB$L_BKT MOVL R6,CURRENT_BITMAP_BLOCK $READ RAB=BITMAP_RAB BLBS R0,12$ PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S ; ; ON A BIT BY BIT BASIS-CALCULATE BYTE CONTAINING BIT TO BE SET ; CALC BIT OFFSET OF BIT TO BE SET AND SET IT ; 12$: BICL3 #^C<4095>,R9,R6 DIVL2 #8,R6 ;GOT OFFSET INTO BITMAP CALC BICL3 #^C7,R9,R5 ;GET BIT NO TO SET ASHL R5,#1,R4 ;SET THE BIT POSITION .IF DF DEBUG BITB R4,BITMAP_BLOCK(R6) BEQL 1012$ PUSHAL BIT_SET CALLS #1,G^LIB$PUT_OUTPUT 1012$: .ENDC BISB2 R4,BITMAP_BLOCK(R6);SET BIT FOR CLUSTER FREE ; ; SEE IF ALL CLUSTERS MARKED FREE ; DECL R8 BLEQU 14$ ;DONE INCL R9 ;NEXT CLUSTER BRW 13$ ; ; FINAL UPDATE OF BITMAP ; 14$: MOVL CURRENT_BITMAP_BLOCK,BITMAP_RAB+RAB$L_BKT $WRITE RAB=BITMAP_RAB BLBS R0,16$ PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 16$: .PAGE ; ; STEP 3 CLEAR NOW USED BITS IN BITMAP ; MOVL CHAIN_ELEMENT_L_SIZE(R11),R10 ;GET BLOCKS TO TRANSFER MOVL @8(AP),R9 ;DEST LBN DIVL3 CLUSTER,R10,R8 ;CALC NUMBER OF CLUSTERS MULL3 CLUSTER,R8,R0 SUBL3 R0,R10,R1 BEQL 21$ INCL R8 21$: DIVL2 CLUSTER,R9 ;GET STARTING CLUSTER NUMBER 23$: DIVL3 #<512*8>,R9,R7 ;CALC BLOCK NO IN BITMAP OF BIT ; ; CALC BLOCK OF BITMAP CONTAINING BITS TO BE CLEARED ; SEE IF CURRENTLY IN MEMORY, IF NOT READ IT IN ; ADDL3 #2,R7,R6 CMPL R6,CURRENT_BITMAP_BLOCK BEQL 22$ MOVL CURRENT_BITMAP_BLOCK,BITMAP_RAB+RAB$L_BKT $WRITE RAB=BITMAP_RAB BLBS R0,25$ PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 25$: MOVL R6,BITMAP_RAB+RAB$L_BKT MOVL R6,CURRENT_BITMAP_BLOCK $READ RAB=BITMAP_RAB BLBS R0,22$ PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S ; ; CALC BYTE CONTAINING BIT TO BE CLEARED AND BIT OFFSET IN BYTE ; 22$: BICL3 #^C<4095>,R9,R6 DIVL2 #8,R6 ;GOT OFFSET INTO BITMAP CALC BICL3 #^C7,R9,R5 ;GET BIT NO TO SET ASHL R5,#1,R4 ;SET THE BIT POSITION .IF DF DEBUG BITL R4,BITMAP_BLOCK(R6) BNEQ 1022$ PUSHAL BIT_CLEAR CALLS #1,G^LIB$PUT_OUTPUT 1022$: .ENDC BICB2 R4,BITMAP_BLOCK(R6);CLEAR BIT FOR CLUSTER INUSE ; ; SEE IF ALL CLUSTERS MARKED INUSE ; DECL R8 BLEQU 24$ ;DONE INCL R9 ;NEXT CLUSTER BRW 23$ ; ; FINAL UPDATE OF BITMAP ; 24$: MOVL CURRENT_BITMAP_BLOCK,BITMAP_RAB+RAB$L_BKT $WRITE RAB=BITMAP_RAB BLBS R0,26$ PUSHAL BITMAP_RAB+RAB$L_STV PUSHAL BITMAP_RAB+RAB$L_STS PUSHAL BITMAP_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 26$: .PAGE ; ; STEP 4 IS TO UPDATE FILE HEADER RETRIEVAL POINTER ; ; CALC VBN OF FILE HEADER AND RAD IT IN ; ADDL3 FILE_HEADER_1_VBN,CHAIN_ELEMENT_L_SEQUENCE(R11),R0 SUBL3 #1,R0,INDEX_RAB+RAB$L_BKT MOVAL INDEX_BLOCK,INDEX_RAB+RAB$L_UBF ;V01-007 MOVW #512,INDEX_RAB+RAB$W_USZ ;V01-007 $READ RAB=INDEX_RAB BLBS R0,30$ PUSHAL INDEX_RAB+RAB$L_STV PUSHAL INDEX_RAB+RAB$L_STS PUSHAL INDEX_UPDATE_READ_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 30$: MOVL CHAIN_ELEMENT_L_RETRIEVAL(R11),R10;GET OFFSET TO POINTER ; ; GET THE CURRENT RETRIVAL POINTER FORMAT SO UPDATED FORMAT CAN BE ; PUT IN USEING THE SAME FORMAT ; ONLY UPDATE LBN ; ; GET THE FORMAT ; EXTZV #FM2$V_FORMAT,#FM2$S_FORMAT,INDEX_BLOCK(R10),R7 CMPB #FM2$C_FORMAT1,R7 ;FORMAT 1 ? BNEQ 31$ ;NO ; ; FORMAT 1 ; MOVL 8(AP),R8 ;GET ADDR OF NEW LBN MOVW (R8),FM2$W_LOWLBN+INDEX_BLOCK(R10) INSV 2(R8),#FM2$V_HIGHLBN,#FM2$S_HIGHLBN,INDEX_BLOCK(R10) BRW 40$ 31$: CMPB #FM2$C_FORMAT2,R7 ;FORMAT 2 ? BNEQ 32$ ;NO ; ; FORMAT 2 ; MOVL @8(AP),INDEX_BLOCK+FM2$L_LBN2(R10) BRW 40$ 32$: CMPB #FM2$C_FORMAT3,R7 ;FORMAT 3 ? BNEQ 33$ ;NO ; ; FORMAT 3 ; MOVL @8(AP),INDEX_BLOCK+FM2$L_LBN3(R10) BRW 40$ ; ; BAD/UNKNOWN FORMAT ; 33$: PUSHAL BAD_FORMAT_MESSAGE CALLS #1,G^LIB$PUT_OUTPUT $EXIT_S 40$: ; ; RECALCULATE CHECKSUM ; MOVAL INDEX_BLOCK,R0 CLRL R1 MOVL #,R2 46$: ADDW2 (R0)+,R1 SOBGTR R2,46$ MOVW R1,(R0) ;LOAD NEW CHECKSUM ; ; AND REWRITE UPDATE FILE HEADER ; ADDL3 FILE_HEADER_1_VBN,CHAIN_ELEMENT_L_SEQUENCE(R11),R0 SUBL3 #1,R0,INDEX_RAB+RAB$L_BKT MOVAL INDEX_BLOCK,INDEX_RAB+RAB$L_RBF ;V01-007 MOVW #512,INDEX_RAB+RAB$W_RSZ ;V01-007 $WRITE RAB=INDEX_RAB BLBS R0,41$ PUSHAL INDEX_RAB+RAB$L_STV PUSHAL INDEX_RAB+RAB$L_STS PUSHAL INDEX_UPDATE_WRITE_ERROR CALLS #3,SYSTEM_ERROR_MESSAGE $EXIT_S 41$: .PAGE ; ; STEP 5 REMOVE ELEMENT FROM CHAIN AND PUT INTO HEAP ; REMQUE (R11),R0 INSQUE (R0),HEAP_LIST INCL HEAP_SIZE RET .PAGE .SUBTITLE DEBUG CODE .IF DF DEBUG .ENTRY GET_HEADER,^M ADDL3 FILE_HEADER_1_VBN,4(AP),R0 SUBL3 #1,R0,INDEX_RAB+RAB$L_BKT MOVAL INDEX_BLOCK,INDEX_RAB+RAB$L_UBF ;V01-007 MOVW #512,INDEX_RAB+RAB$W_USZ ;V01-007 $READ RAB=INDEX_RAB MOVAL INDEX_BLOCK,R0 CLRL R1 MOVL #,R2 1$: ADDW2 (R0)+,R1 SOBGTR R2,1$ CMPW R1,(R0) BEQL 2$ PUSHAL BAD_CHECKSUM CALLS #1,G^LIB$PUT_OUTPUT RET 2$: CMPB INDEX_BLOCK+FH2$B_STRUCLEV,#2 BEQL 3$ PUSHAL NOT_LEVEL_2 CALLS #1,G^LIB$PUT_OUTPUT RET 3$:; CMPB INDEX_BLOCK+FH2$B_IDOFFSET,# ;V01-011 ; BLSSU 4$ ;V01-011 CMPB INDEX_BLOCK+FH2$B_MPOFFSET,INDEX_BLOCK+FH2$B_IDOFFSET BLSSU 4$ CMPB INDEX_BLOCK+FH2$B_ACOFFSET,INDEX_BLOCK+FH2$B_MPOFFSET BLSSU 4$ CMPB INDEX_BLOCK+FH2$B_RSOFFSET,INDEX_BLOCK+FH2$B_ACOFFSET BLSSU 4$ SUBB3 INDEX_BLOCK+FH2$B_MPOFFSET,INDEX_BLOCK+FH2$B_ACOFFSET,R0 CMPB INDEX_BLOCK+FH2$B_MAP_INUSE(R11),R0 BGTRU 4$ TSTW INDEX_BLOCK+FH2$W_FID_NUM BNEQ 5$ TSTB INDEX_BLOCK+FH2$B_FID_NMX BNEQ 5$ 4$: PUSHAL HEADER_FORMAT_ERROR CALLS #1,G^LIB$PUT_OUTPUT RET ; ; GET AT THE MAPPING POINTERS ; TAKEN FROM THE FICHE LISTING WITH A LITTLE MODIFICATION ; 5$: MOVZBL INDEX_BLOCK+FH2$B_MPOFFSET,R11 ;GET START OF MAP;V01-005 MULL2 #2,R11 MOVZBL INDEX_BLOCK+FH2$B_MAP_INUSE,R10 ;V01-005 MULL2 #2,R10 ADDL2 R11,R10 10$: CMPL R11,R10 BLSS 11$ BRW 20$ ; ; EXTRACT FORMAT FIELD ; 11$: EXTZV #FM2$V_FORMAT,#FM2$S_FORMAT,INDEX_BLOCK(R11),R9 ; ; IS IT PLACEMENT CONTROL ; CMPB #FM2$C_PLACEMENT,R9 BNEQ 12$ PUSHAL PLACEMENT_CODES CALLS #1,G^LIB$PUT_OUTPUT ADDL2 #2,R11 BRB 10$ ; ; IS IT FORMAT 1 ; 12$: CMPB #FM2$C_FORMAT1,R9 BNEQ 13$ MOVZBL INDEX_BLOCK+FM2$B_COUNT1(R11),STR_COUNT MOVZWL INDEX_BLOCK+FM2$W_LOWLBN(R11),STR_LBN EXTZV #FM2$V_HIGHLBN,#FM2$S_HIGHLBN,INDEX_BLOCK(R11),R0 INSV R0,#16,#16,STR_LBN ADDL2 #4,R11 BRB 19$ ; ; IS IT FORMAT 2 ; 13$: CMPB #FM2$C_FORMAT2,R9 BNEQ 14$ EXTZV #FM2$V_COUNT2,#FM2$S_COUNT2,INDEX_BLOCK(R11),STR_COUNT MOVL INDEX_BLOCK+FM2$L_LBN2(R11),STR_LBN ADDL2 #6,R11 BRB 19$ ; ; CAN ONLY BE FORMAT 3 ; 14$: CMPB #FM2$C_FORMAT3,R9 BNEQ 15$ ROTL #16,INDEX_BLOCK(R11),R0 EXTZV #0,#30,R0,STR_COUNT MOVL INDEX_BLOCK+FM2$L_LBN3(R11),STR_LBN ;V01-003 ADDL2 #8,R11 BRB 19$ 15$: PUSHAL ILLEGAL_FORMAT CALLS #1,G^LIB$PUT_OUTPUT RET 19$: INCL STR_COUNT PUSHL STR_LBN PUSHL STR_COUNT PUSHAL POINTER_LINE PUSHAL STR_LEN PUSHAL POINTER_DESCRIPTER CALLS #5,G^SYS$FAO PUSHAL POINTER_LINE CALLS #1,G^LIB$PUT_OUTPUT BRW 10$ 20$: RET .PSECT IMPURE_DATA STR_LEN:.LONG 0 STR_COUNT: .LONG 0 STR_LBN: .LONG 0 POINTER_LINE: .ASCID / / .PSECT PURE_DATA BAD_CHECKSUM: .ASCID /Header block has invalid checksum/ NOT_LEVEL_2: .ASCID /Header block not ODS-2/ HEADER_FORMAT_ERROR: .ASCID /Header format error/ PLACEMENT_CODES: .ASCID /Placement codes/ ILLEGAL_FORMAT: .ASCID /Illegal format number/ POINTER_DESCRIPTER: .ASCID ?Count !ZL LBN !ZL? .PAGE .PSECT CODE .ENTRY DUMP_CHAIN,^M PUSHL HEAP_SIZE PUSHL MAX_VM_FLAG PUSHL INDEX_EOF_FLAG PUSHL FILE_HEADER_1_VBN PUSHL LAST_FILE_HEADER_VBN PUSHAL CHAIN_LINE PUSHAL CHAIN_LEN PUSHAL CHAIN_DES_1 CALLS #8,G^SYS$FAO PUSHAL CHAIN_LINE CALLS #1,G^LIB$PUT_OUTPUT MOVAL CHAIN_HEAD,R11 MOVL R11,R10 1$: MOVL (R10),R10 CMPL R10,R11 BNEQ 2$ RET 2$: PUSHAL 8(R10) PUSHAL CHAIN_LINE_2 PUSHAL CHAIN_LEN PUSHAL CHAIN_DES_2 CALLS #4,G^SYS$FAOL PUSHAL CHAIN_LINE_2 CALLS #1,G^LIB$PUT_OUTPUT BRB 1$ .PSECT IMPURE_DATA CHAIN_LEN: .LONG 0 CHAIN_LINE: .ASCID / /- / /- / /- / / CHAIN_LINE_2: .ASCID / /- / / .PSECT PURE_DATA CHAIN_DES_1: .ASCID ?Last file header VBN !ZL!/FIle header 1 VBN !ZL!/?- ?EOF Flag !ZL!/Max VM Flag !ZL!/Heap size !ZL!/? CHAIN_DES_2: .ASCID ?LBN !ZL!/SIZE !ZL!/SEQUENCE !ZL!/RETRIEVAL !ZL!/? BIT_SET:.ASCID /Bit already set/ BIT_CLEAR:.ASCID/Bit already clear/ .PAGE .SUBTITLE DUMP BEST FIT .PSECT CODE .ENTRY DUMP_BEST_FIT,^M CMPL #-1,R0 BNEQ 1$ RET 1$: PUSHR #^M ;V01-012 MOVL R0,R11 MOVL R1,R10 PUSHL CHAIN_ELEMENT_L_RETRIEVAL(R11) PUSHL CHAIN_ELEMENT_L_SEQUENCE(R11) PUSHL FRAGMENT_LBN PUSHL CHAIN_ELEMENT_L_LBN(R11) PUSHL FRAGMENT_LENGTH PUSHL CHAIN_ELEMENT_L_SIZE(R11) PUSHAL BEST_FIT_MESSAGE PUSHAL BEST_FIT_LEN PUSHAL BEST_FIT_FORMAT CALLS #9,G^SYS$FAO PUSHAL BEST_FIT_MESSAGE CALLS #1,G^LIB$PUT_OUTPUT MOVL R10,R1 MOVL R11,R0 POPR #^M ;V01-012 RET .PSECT PURE_DATA BEST_FIT_FORMAT: .ASCID ? Source Destination!/?- ?Size !10 !10!/?- ?LBN !10 !10!/?- ?Seq # !10 !/?- ?Offset !10? .PSECT IMPURE_DATA BEST_FIT_LEN: .LONG 0 BEST_FIT_MESSAGE: .ASCID / /- / /- / /- / / .PSECT CODE .ENDC .PAGE ;V01-007 .SUBTITLE READ AND TRANSFER FILE HEADER BLOCKS ;V01-007 .ENTRY READ_HEADER,^M ;V01-007 ; ;V01-007 ; PASS 2 ARGUMENTS BY REFERENCE ;V01-007 ; FID FILE ID OF FILE HEADER TO BE TRANSFERED ;V01-007 ; BUFFER LOCATION OF BUFFER TO RECIEVE HEADER ;V01-007 ; ;V01-007 ; SEE IF WANTED HEADER IS IN BUFFER ;V01-007 ; ;V01-007 CMPL HEADER_BUFFER_FIRST_FID,@4(AP) ;V01-007 BGTRU 1$ ;V01-007 SUBL3 HEADER_BUFFER_FIRST_FID,@4(AP),R11 ;V01-007 CMPL R11,HEADER_BUFFER_HEADER_COUNT ;V01-007 BGEQU 1$ ;HIGHER THAN LAST IN BUFFER ;V01-007 MULL2 #512,R11;GET OFFSET INTO BUFFER ;V01-007 MOVC3 #512,HEADER_BUFFER(R11),@8(AP) ;V01-007 MOVL #1,R0 ;V01-007 RET ;V01-007 ; ;V01-007 ; HEADER NOT IN BUFFER-UPDATE BUFFER ;V01-007 ; ;V01-007 1$: MOVC5 #0,HEADER_BUFFER,#0,#,-;V01-007 HEADER_BUFFER ;V01-007 ADDL3 @4(AP),FILE_HEADER_1_VBN,R0 ;V01-007 SUBL3 #1,R0,INDEX_RAB+RAB$L_BKT ;V01-007 MOVAL HEADER_BUFFER,INDEX_RAB+RAB$L_UBF ;V01-007 MOVW #,INDEX_RAB+RAB$W_USZ ;V01-007 $READ RAB=INDEX_RAB ;READ BLOCK OF HEADERS ;V01-007 BLBS R0,4$ ;BRANCH IF NO ERROR ;V01-007 CMPL #RMS$_EOF,R0 ;WAS ERROR E.O.F. ;V01-007 BNEQ 5$ ;NO ;V01-007 BRW 10$ ;HANDLE EOF CONDITION ;V01-007 ; ;V01-007 ; ERROR FOUND NOT EOF-REPORT IT AND EXIT ;V01-007 ; ;V01-007 5$: PUSHAL INDEX_RAB+RAB$L_STV ;V01-007 PUSHAL INDEX_RAB+RAB$L_STS ;V01-007 PUSHAL INDEX_READ_ERROR ;V01-007 CALLS #3,SYSTEM_ERROR_MESSAGE ;V01-007 $EXIT_S ;V01-007 ; ;V01-007 ; TRANSFER FIRST HEADER TO USER BUFFER ;V01-007 ; ;V01-007 4$: MOVL @4(AP),HEADER_BUFFER_FIRST_FID ;V01-007 MOVL #HEADER_BUFFER_COUNT,HEADER_BUFFER_HEADER_COUNT ;V01-007 MOVC3 #512,HEADER_BUFFER,@8(AP) ;V01-007 MOVL #1,R0 ;V01-007 RET ;V01-007 ; ;V01-007 ; HANDLE EOF-SEE IF NO OR PARTIAL XFER ;V01-007 ; ;V01-007 10$: MOVZWL INDEX_RAB+RAB$W_RSZ,R1 ;V01-007 BNEQ 11$ ;V01-007 RET ;NOTHING XFERD-PASS BACK EOF IN R0 ;V01-007 11$: DIVL3 #512,R1,HEADER_BUFFER_HEADER_COUNT ;V01-007 MOVL @4(AP),HEADER_BUFFER_FIRST_FID ;V01-007 MOVC3 #512,HEADER_BUFFER,@8(AP) ;V01-007 MOVL #1,R0 ;V01-007 RET ;V01-007 .PAGE .SUBTITLE DOES HE MEAN IT AND FINAL MESSAGE ; ; THIS PROCEDURE IS INTENDED TO CHECK TO SEE IF THE USER PICKED ; THE RIGHT DEVICE, HAS DONE ALL THE PROPER PRELIMINARY ; OPERATIONS AND MAINLY TO SEE IF HE REALLY WANTS TO DO THIS ; .ENTRY DOES_HE_MEAN_IT,^M ; ; OUTPUT INTRO ; PUSHAL INTRO CALLS #1,G^LIB$PUT_OUTPUT ; ; OUTPUT WHAT DEVICE SELECTED AND SEE IF THIS IS THE CORRECT DEVICE ; PUSHAL SELECTED_MESSAGE CALLS #1,G^LIB$PUT_OUTPUT PUSHAL DEVICE_NAME CALLS #1,G^LIB$PUT_OUTPUT ; ; IS THIS THE DISK REALLY WANTED ; MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL RIGHT_DEVICE PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 2$ $EXIT_S ; ; CHECK TO SEE IF HE HAS DONE ALL PRELIMINARY OPERATIONS ; ; HAS IT BEEN BACKED UP 2$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL BACKUP PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 1$ $EXIT_S ; ; MAKE SURE NOONE ELSE IS USEING DISK ; 1$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL QUIET PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 3$ $EXIT_S ; ; HAS ANAL/DISK BEEN RUN ON TARGET ; 3$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL ANALYZE PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 4$ $EXIT_S ; ; HAS FRAG BEEN RUN ON TARGET ; 4$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL FRAG PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 10$ ;V01-006 $EXIT_S ; ; IS IT A VOLUME SET AND MAKE SURE HE IS REALLY WATCHING ;V01-006 ; 10$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING ;V01-006 PUSHAL VOL_SET ;V01-006 PUSHAL REPLY ;V01-006 CALLS #2,G^LIB$GET_INPUT ;V01-006 LOCC #^A/N/,#10,REPLY_STRING ;V01-006 BNEQ 5$ ;V01-006 PUSHAL NO_VOL_SET ;V01-006 CALLS #1,G^LIB$PUT_OUTPUT ;V01-012 $EXIT_S ;V01-006 ; ; NOW TO BE SURE HE REALLY MEANS IT-ASK 4 TIMES ; 5$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL SURE PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 6$ $EXIT_S 6$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL POSITIVE PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 7$ $EXIT_S 7$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL ABSOLUTELY PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 8$ $EXIT_S 8$: MOVC5 #0,REPLY_STRING,#0,#10,REPLY_STRING PUSHAL LAST_CHANCE PUSHAL REPLY CALLS #2,G^LIB$GET_INPUT LOCC #^A/Y/,#10,REPLY_STRING BNEQ 9$ $EXIT_S ; ; HE MEANS IT, OUTPUT LAST MESSAGE BEFORE STARTING ; 9$: PUSHAL GERONIMO CALLS #1,G^LIB$PUT_OUTPUT RET .ENTRY FINAL_MESSAGE,^M ; ; COMPRESSION COMPLETE-GOODBY MESSAGE ; ; GIVE STATS ;V01-002 PUSHL EXTENTION_HEADERS ;V01-004 PUSHL FILE_STRUCTURE_FILES ;V01-004 PUSHL PLACEMENT_CONTROL_FILES ;V01-004 PUSHL SYSTEM_FILES ;V01-004 PUSHL NO_MATCH ;V01-002 PUSHL ADJACENT_ELEMENT ;V01-002 PUSHL BEST_FIT ;V01-002 PUSHL EXACT_FIT ;V01-002 PUSHL TOTAL_FRAGMENTS ;V01-002 PUSHAL FINAL_STATS ;V01-002 PUSHAL FINAL_LEN ;V01-002 PUSHAL FINAL_STATS_FORMAT ;V01-002 CALLS #8,G^SYS$FAO ;V01-002 MOVL FINAL_LEN,FINAL_STATS ;V01-002 PUSHAL FINAL_STATS ;V01-002 CALLS #1,G^LIB$PUT_OUTPUT ;V01-002 PUSHAL GOOD_BY CALLS #1,G^LIB$PUT_OUTPUT RET .PAGE ;V01-012 .SUBTITLE STARTUP/CLOSEDOWN PURE DATA AREA ;V01-012 .PSECT PURE_DATA INTRO: .LONG ;V01-002 .ADDRESS INTRO_STRING ;V01-002 INTRO_STRING: ;V01-002 .ASCII ?JUICER_1 ? ;V01-002 VERSION .ASCII ;V01-002 .ASCII ? VAX/VMS ODS-2 disk compresser? ;V01-002 INTRO_STRING_END=. ;V01-002 SELECTED_MESSAGE: .ASCID ?You have selected the following disk to be compressed? BACKUP: .ASCID ?Has the selected disk been fully backed up (Y/N) [N] ? RIGHT_DEVICE: .ASCID ?Is this the right device to be compressed (Y/N) [N] ? QUIET: .ASCID ?Has all other useage of disk been stopped (Y/N) [N] ? ANALYZE:.ASCID ?Have you run ANALYZE/DISK on target device (Y/N) [N] ? FRAG: .ASCID ?Have you run FRAG on target device (Y/N) [N] ? VOL_SET:.ASCID ?Is this a Volume set (Y/N) [Y] ? ;V01-006 NO_VOL_SET:.ASCID ?I don't do Volume sets? ;V01-006 SURE: .ASCID ?Are you SURE you want to do this (Y/N) [N] ? POSITIVE:.ASCID ?Positively (Y/N) [N] ? ABSOLUTELY: .ASCID ?Absolutely positvely (Y/N) [N] ? LAST_CHANCE: .ASCID ?Last Chance (Y/N) [N] ? GERONIMO: .ASCID ?O.K. you asked for it-remember ^C to see progress?- ? and ^Y to terminate? GOOD_BY:.ASCID ?JUICER has completed its compression?- ?, now do the following?- ?(1)If the target disk was the system disk then reboot?- ? the system?? otherwise just DISMOUNT and ?- ?MOUNT the disk?- ?(2)Rerun ANALYZE/DISK and FRAG on the target disk? FINAL_STATS_FORMAT: ;V01-002 .ASCID ?Total free fragments found !ZL!/?-;V01-002 ?Exact fits found !ZL!/?-;V01-002 ?Best fits found !ZL!/?-;V01-002 ?Adjacent in-use fragments used !ZL!/?-;V01-002 ?No match available !ZL!/?-;V01-004 ?System Files !ZL!/?-;V01-004 ?Files with placement control !ZL!/?-;V01-004 ?File Structure Files !ZL!/?-;V01-004 ?Extention Headers !ZL!/? ;V01-004 .PAGE ;V01-012 .SUBTITLE STARTUP/CLOSEDOWN IMPURE DATA ;V01-012 .PSECT IMPURE_DATA FINAL_LEN: .LONG 0 ;V01-002 REPLY: .LONG 10 .ADDRESS REPLY_STRING REPLY_STRING: .ASCII / / FINAL_STATS: .LONG 432 ;V01-004 .ADDRESS FINAL_STATS_STRING ;V01-002 FINAL_STATS_STRING: ;V01-002 .REPEAT 432 ;V01-004 .BYTE ^A/ / ;V01-002 .ENDR ;V01-002 .END JUICER