.TITLE HOL DISK FRAGMENTATION .IDENT /1.0/ .ENABL LC .SBTTL DATA AREA ; ; DATE: 8/14/78 ; BY: M. ARMSTRONG ; BADGER METER, INC. - ELECTRONICS DIV. ; RICHMOND, CA ; ; THIS MCR TASK WILL PRODUCE FRAGMENTATION STATISTICS FOR THE SPECIFIED ; FILES-11 DEVICE. THE OUTPUT IS A LIST OF CONTIGUOUS FREE BLOCKS (HOLES) ; AND THE TOTAL NUMBER OF FREE BLOCKS FOR THE DEVICE. THE LIST IS IN THE ; FORM OF LINES OF NUMBER PAIRS. THE FIRST NUMBER OF EACH PAIR IS THE ; BLOCK ADDRESS, IN OCTAL, OF THE FIRST BLOCK OF THE HOLE. THE SECOND ; NUMBER IS THE SIZE OF THE HOLE IN DECIMAL BLOCKS. INPUT IS VIA LUN 1. ; ; OUTPUT IS DIRECTED TO LUN 2, WHICH MAY BE ASSIGNED TO ANY TERMINAL. ; ; THIS PROGRAM FULFILLS THE SAME FUNCTION AS, AND IS DERIVED FROM THE ; DECUS PROGRAM 'FRAG' BY MICHAUD, BUT PROVIDES BETTER DETAIL. ; ; ; Modified by:- ; ; Phil Stephensen-Payne, ; c/o Systime Ltd., ; Concourse Computer Centre, ; 432 Dewsbury Road, ; LEEDS LS11 7DF, ; England. ; ; ; ;****************************************************************************** ; ; This software is provided on an "as is" basis only. Caterpillar Tractor Co., ; disclaims all warranties on the program, including without limitation, all ; implied warranties of merchantablity and fitness. ; ; Full permission and consent is hereby given to DECUS and to the DECUS ; special interest groups to reproduce, distribute, and publish and permit ; others to reproduce in whole or in part, in any form and without restriction ; this program and any information relating thereto ; ;****************************************************************************** ; ; 11/18/82 Rick Webster, MSDGO, Caterpillar Tractor Co. ; RAW001 Modifications include: ; 1) Eliminate syntax checking subroutines and ; use .TPARS instead ; 2) Display logical block numbers in decimal ; instead of octal by default ; 3) Add /Octal switch to optionally display ; logical block numbers in octal ; 4) Change messages to upper and lower case ; ; ; ; ; EQUATE SECTION, SYMBOLIC DEFINITIONS ; AFLDSZ= 7 ; MAX SIZE OF OCTAL BLK ADDR FIELD BFLDSZ= 6 ; MAX SIZE OF DECIMAL BLK SIZE FIELD FLDSIZ= AFLDSZ+BFLDSZ+2 ; OOOOOOO;DDDDDD. FLDCNT= LINSIZ/FLDSIZ ; NUMBER OF FIELDS PER OUTPUT LINE LINSIZ= 80. ; NUMBER OF CHARACTERS PER OUTPUT LINE ; CHARACTER EQUATES SPACE = 40 TAB = 11 LF = 12 CR = 15 ; LUN DEFINITIONS INDEV = 1 TERM = 2 ERRDEV = 3 ; Switch definitions ;RAW001 ;RAW001 SW.OCT = 1 ;RAW001 ;RAW001 ; ;RAW001 .MCALL GTIM$,QIOW$,CALL,EXIT$S,DIR$ ;RAW001 .MCALL FCSMC$,ALUN$,GMCR$,GLUN$,FCSBT$ ;RAW001 .MCALL ISTAT$,STATE$,TRAN$ ;RAW001 ;RAW001 FCSMC$ ; DEFINE FCS MACROS ;**-3 FCSBT$ ; DEFINE FCS MACRO OFFSETS FSRSZ$ 0 ; NO FSR FOR BLOCK OPERATIONS FDB: FDBDF$ FDRC$A FD.RWM FDBK$A INBUF,512.,,10 FDOP$A INDEV,DSET DSET: .WORD 0,0 .WORD UICSIZ,UIC .WORD NAMSIZ,NAME UIC: .ASCII /[0,0]/ UICSIZ=.-UIC .EVEN NAME: .ASCII /BITMAP.SYS/ NAMSIZ=.-NAME .EVEN ASCBLK: .ASCII /123456789/ ; Decimal block number from $CDDMG ;RAW001 .EVEN ;RAW001 OUTBUF: .BLKB LINSIZ ; OUTPUT LINE BUFFER .EVEN INBUF: ; INPUT BLOCK BUFFER (OVERLAYS GMCR BFR) GLUN: GLUN$ INDEV,GLBUF ; DPB FOR 'GET LUN CHARACTERISTICS' DIRECTIVE GLBUF: .BLKW 6 ; BUFFER FOR GLUN GMCR: GMCR$ ; DPB FOR 'GET MCR COMMAND LINE' DIRECTIVE .=INBUF+512. ; ALLOCATE SPACE FOR INPUT BFR ON TOP OF GMCR ALUN: ALUN$ INDEV,SY,0 ; DEFAULT ASSIGN LUN TIME: GTIM$ TBUF TBUF: .BLKW 8. ; BUFFER FOR TIME/DATE INFO READ: QIOW$ IO.RVB,INDEV,10,,IOST,, IDPB: QIOW$ IO.RVB,ERRDEV,1,,IOST,, ; ;RAW001 DPB: QIOW$ IO.WVB,TERM,1,,,, ;**-1 ODPB: QIOW$ IO.WVB,TERM,1,,,, IOST: .BLKW 2 STAT: 0 ; STATUS FROM 'GETWRD': ; 1 => NON-ZERO WORD FROM BFR, NOT ALL ONES ; 0 => ZERO WORD FROM BFR ; -1 => ALL-ONES WORD FROM BFR LOWLIM: 0,0 ; DOUBLE PRECISION LOWER HOLESIZE LIMIT COUNT: 0,0 ; " " FREE-BLOCK COUNT (HOLE SIZE) TOTAL: 0,0 ; " " TOTAL FREE-BLOCK COUNT BLKADR: 0,0 ; LOGICAL BLOCK ADDRESS OF HOLE BLOCK: .WORD 1 ; VIRTUAL BLOCK PTR FOR 'BITMAP.SYS' ; BLOCK 1 IS NOT PART OF BIT MAP, ; SO WILL START READING AT BLOCK 2 BUFPTR: INBUF+512. ; PTR INTO INPUT BFR BLOCK (VALUE FORCES READ) BITCNT: 16. ; BIT POSITION IN CURWRD (VALUE FORCES FETCH) CURWRD: 0 ; MAP WORD CURRENTLY BEING EXAMINED HDRDON: 0 ; FLAG TO INDICATE HEADER HAS BEEN DISPLAYED SWFLAG: 0 ; Switch flag word ;RAW001 CMDLTH: 0 ; Length of MCR command line ;RAW001 .NLIST BEX ;RAW001 TOTBUF: .ASCII /Total Free Blocks: / ;RAW001 TOTAMT: .ASCII / ./ ;RAW001 TOTSIZ= .-TOTBUF ;RAW001 ER1: .ASCII /HOL -- Bad switch/ ;RAW001 ER1SIZ=.-ER1 ;RAW001 ER2: .ASCII /HOL -- Failure on reading BITMAP.SYS/ ;RAW001 ER2SIZ=.-ER2 ;RAW001 ER3: .ASCII /HOL -- Command error/ ;RAW001 ER3SIZ= .-ER3 ;RAW001 ER4: .ASCII /HOL -- Illegal device/ ;RAW001 ER4SIZ= .-ER4 ;**-11 HOL: .ASCII /HOL>/ HOLSIZ=.-HOL .EVEN TSKNAM: .ASCII /HOLES/ TKNMSZ= .-TSKNAM ISTRNG: .ASCII /Contiguous Free Blocks (Holes) For Device / ;RAW001 ASCDEV: .ASCII /SY: / ;**-1 .ASCIZ /%Y %2Z%2N/ .LIST BEX .EVEN .PAGE .SBTTL HOLE -- MAIN ROUTINE ;+ ; ** HOLES - DISPLAY FRAGMENTATION DATA FOR FILES-11 DEVICES ; ; SYNTAX: ; HOL [ddn:][/nnn][/Octal] ; ; WHERE: ; dd - A legal FILES-11 device name ; n - A legal unit number for the selected device ; If 'ddn:' is not specified 'SY0:' is assumed ; ; /nnn - Is an optional positive, nonzero integer of 9 ; decimal digits or less. If present, it defines ; the minimum size hole to be reported. ; ; /O - Specifies that logical block numbers are to be ; displayed in octal instead of decimal. Can be ; entered as /O, /OC, /OCT, /OCTA or /OCTAL ; ; ;- HOLE: DIR$ #GMCR ; GET COMMAND LINE ;RAW001 BCC 10$ ; If CC OK - carry on ;RAW001 CALL GETLIN ; Else prompt for line ;RAW001 BR 15$ ; And process as normal ;RAW001 ; ;RAW001 10$: ;RAW001 MOV $DSW,CMDLTH ; Get length of command line ;RAW001 15$: CLR LOWLIM ; Assume low limit is zero ;RAW001 CLR LOWLIM+2 ; " ;RAW001 CLR SWFLAG ; Clear switch word ;RAW001 CLR R1 ; Set TPARS for ignoring spaces & tabs ;RAW001 MOV #KEYTBL,R2 ; Address of keyword table in R2 ;RAW001 MOV CMDLTH,R3 ; Length of command line to parse ;RAW001 MOV #GMCR+G.MCRB,R4 ; Address of command line to parse ;RAW001 MOV #PARCMD,R5 ; Address of state table ;RAW001 CALL .TPARS ; Parse command line ;RAW001 BCC 16$ ; Branch if syntax is ok ;RAW001 JMP ERROR3 ; Go indicate syntax error ;RAW001 16$: DIR$ #ALUN,ERROR4 ; Assign lun to device to check ;RAW001 DIR$ #GLUN ; Now get lun info for that device ;RAW001 BIT #FD.DIR,GLBUF+G.LUCW ; File structured device? ;RAW001 BNE 17$ ; Yes - branch ;RAW001 JMP ERROR4 ; No - indicate illegal device ;RAW001 17$: MOVB GLBUF+G.LUNA,ASCDEV ; Put device in display header ;RAW001 MOVB GLBUF+G.LUNA+1,ASCDEV+1 ; " ;RAW001 MOV #ASCDEV+2,R0 ; Destination address for $CBTA ;RAW001 MOV GLBUF+G.LUNU,R1 ; Logical unit for $CBTA to convert ;RAW001 BIC #177400,R1 ; Clear flags byte (high byte) ;RAW001 MOV #20*400+10,R2 ; 2 octal digits, zero suppress ;RAW001 CALL $CBTA ; Put unit number in display header ;RAW001 MOVB #':,(R0) ; Append a colon to unit number ;RAW001 ; ;RAW001 OPEN$R #FDB,,,,,,ERROR2 ;**-46 NEWLIN: MOV #OUTBUF,R0 ; INIT THE OUTPUT LINE BUFFER PTR MOV #FLDCNT,R4 ; INIT THE FIELD COUNTER GTHOLE: CALL CONTIG ; FIND A HOLE BCS EOFCHK ; EOF OR INPUT ERROR IF CS ADD COUNT+2,TOTAL+2 ADC TOTAL ADD COUNT,TOTAL ; UPDATE THE GRAND TOTAL TST HDRDON ; YES - HAVE WE DONE THE HEADER YET? BNE 4$ ; YES IF NE CALL HEADER ; NO, DO IT NOW 4$: CMP COUNT,LOWLIM ; IS THE HOLESIZE >= THE SPECIFIED LIMIT? BHI 25$ ; YES IF HI BLO GTHOLE ; NO IF LO - FIND ANOTHER CMP COUNT+2,LOWLIM+2; CAN'T TELL IF EQ - LOW ORDER PART >= LIMIT? BLO GTHOLE ; NO IF LO 25$: BIT #SW.OCT,SWFLAG ; Display LBN's in octal? ;RAW001 BEQ 26$ ; No - branch ;RAW001 MOV #BLKADR,R1 ; PACK DISK BLOCK ADDRESS (IN OCTAL) ;RAW001 MOV #AFLDSZ,R2 ; RIGHT-JUSTIFIED, 'AFLDSZ' DIGITS ;RAW001 CALL CDBOM ;RAW001 BR 50$ ;RAW001 26$: MOV R0,-(SP) ; Save R0 ;RAW001 MOV #ASCBLK,R0 ; Put destination address in R0 ;RAW001 MOV #BLKADR,R1 ; Put LBN in R1 ;RAW001 CLR R2 ; Zero suppression indicator ;RAW001 CALL $CDDMG ; Convert LBN to decimal ;RAW001 MOV #ASCBLK,R1 ; R1 has address of converted string ;RAW001 SUB R1,R0 ; R0 has # of characters in converted string ;RAW001 MOV R0,R2 ; Save number of characters in R2 ;RAW001 MOV #AFLDSZ,R1 ; R1 has length of display field ;RAW001 SUB R0,R1 ; R1 has number of spaces to stuff in field ;RAW001 MOV (SP)+,R0 ; Restore R0 (display field address) ;RAW001 29$: MOVB #' ,(R0)+ ; Right justify LBN ;RAW001 SOB R1,29$ ;RAW001 MOV #ASCBLK,R1 ; R1 has address of LBN string ;RAW001 30$: MOVB (R1)+,(R0)+ ; Put LBN string in display field ;RAW001 SOB R2,30$ ;RAW001 45$: MOVB #'.,(R0)+ ; Append a '.' to show it is decimal ;RAW001 50$: MOVB #':,(R0)+ ; SEPARATE FROM HOLE SIZE WITH ':' ;RAW001 MOV #COUNT,R1 ; PACK HOLE SIZE (IN DECIMAL) ;**-4 CLR R2 ; LEFT-JUSTIFIED (ZERO-SUPPRESSED) CALL $CDDMG MOVB #'.,(R0)+ ; PACK A DOT (DECIMAL NUMBER INDICATOR) MOVB #TAB,(R0)+ ; AND SEPARATE FROM NEXT PAIR BY A TAB BR 60$ ;RAW001 55$: JMP GTHOLE ;RAW001 60$: SOB R4,55$ ; LOOP 'TIL LINE IS FULL ;RAW001 110$: MOVB #CR,-1(R0) ; REPLACE LAST TAB WITH EOL ;RAW001 SUB #OUTBUF,R0 ; CALC ACTUAL LINE SIZE ;**-2 MOV R0,DPB+Q.IOPL+2 ; AND LOAD IT INTO THE DPB DIR$ #DPB ; OUTPUT THE LINE BR NEWLIN ; AND START ANOTHER EOFCHK: CMPB #IE.EOF,IOST ; END OF FILE? BNE ERROR2 ; NE=OOPS! MOVB #CR,-1(R0) ; REPLACE LAST TAB WITH EOL SUB #OUTBUF,R0 ; LOAD SIZE OF LAST LINE MOV R0,DPB+Q.IOPL+2 ; INTO DPB DIR$ #DPB ; AND WRITE THE LINE MOV #TOTAL,R1 ; CONVERT THE GRAND TOTAL TO ASCII DECIMAL CLR R2 ; (ZERO-SUPPRESSED, LEFT JUSTIFIED) MOV #TOTAMT,R0 CALL $CDDMG MOVB #'.,(R0)+ ; PACK DOT AND EOL AT END OF LINE MOVB #CR,(R0)+ SUB #TOTBUF,R0 ; PUT CORRECT LINE SIZE INTO DPB MOV R0,DPB+Q.IOPL+2 MOV #TOTBUF,DPB+Q.IOPL ; AND ALSO NEW BFR ADDR BR OUT ; GO OUTPUT THE LINE AND EXIT ; ERROR1: MOV #ER1,DPB+Q.IOPL ; GET ERROR STRING MOV #ER1SIZ,DPB+Q.IOPL+2 ; GET SIZE BR ERROUT ERROR2: MOV #ER2,DPB+Q.IOPL ; GET ERROR STRING MOV #ER2SIZ,DPB+Q.IOPL+2 ; GET SIZE BR ERROUT ERROR3: MOV #ER3,DPB+Q.IOPL ; GET ERROR STRING MOV #ER3SIZ,DPB+Q.IOPL+2 ; GET SIZE BR ERROUT ERROR4: MOV #ER4,DPB+Q.IOPL ; GET ERROR STRING MOV #ER4SIZ,DPB+Q.IOPL+2 ; GET SIZE ERROUT: MOVB #ERRDEV,DPB+Q.IOLU ; CHANGE LUN TO ERROR DEVICE (TI:) OUT: CLOSE$ #FDB ; CLOSE THE FILE DIR$ #DPB EXIT$S .PAGE .SBTTL CONTIG -- CONTIGUOUS BLOCK SEARCH ROUTINE ; ; THIS IS THE ROUTINE THAT SEARCHES THE BIT MAP FILE FOR UNALLOCATED BLOCKS ; AND CALCULATES THE SIZE OF CONTIGUOUS CHUNKS OF THEM. THE RETURN TO THE ; CALLER IS THE DISK ADDRESS OF THE FIRST BLOCK OF A HOLE IN 'BLKADR' AS A ; DOUBLE PRECISION NUMBER AND THE SIZE OF THE HOLE IN 'COUNT', ALSO A DOUBLE ; PRECISION NUMBER. ; CONTIG: CLR COUNT ; INIT THE HOLE SIZE CLR COUNT+2 CALL $SAVAL ; SAVE R0-R5 MOV BITCNT,R2 ; GET THE BIT COUNT FOR THE CURRENT WORD MOV CURWRD,R1 ; IS THE CURRENT WORD NON-ZERO? BNE 2$ ; YES IF NE 1$: MOV #16.,R2 ; INIT THE BIT POSITION INDICATOR CALL GETWRD ; GET THE NEXT WORD FROM THE MAP FILE BCS EXIT ; EOF OR ERROR TST STAT BEQ 1$ ; ZERO WORD IF EQ BMI 7$ ; ALL ONES WORD IF MI 2$: ASR R1 ; IS NEXT BIT ZERO? BCS 3$ ; NO IF CS SOB R2,2$ ; LOOP UNTIL A ONE BIT IS FOUND BR 1$ ; (THIS SHOULDN'T HAPPEN) 4$: ASR R1 ; GET THE NEXT BIT. IS IT ONE? BCS 5$ ; YES BR EXIT ; NO, END OF THIS HOLE 3$: CALL BLKSAV ; SAVE THE BLOCK ADDRESS AND 5$: ADD #1,COUNT+2 ; COUNT ANOTHER BLOCK IN THIS HOLE ADC COUNT SOB R2,4$ ; LOOP 'TIL THE WORD IS DONE 6$: CALL GETWRD ; GET THE NEXT WORD FROM THE MAP BCS EXIT ; EOF OR ERROR TST STAT BEQ EXIT ; ALL ZEROS, END OF HOLE BMI 10$ ; ALL ONES, ADD 16. TO HOLE SIZE MOV #16.,R2 ; NEITHER, COUNT ONES TO NEXT ZERO BR 4$ 7$: CALL BLKSAV ; SAVE ADDRESS OF HOLE 10$: ADD #16.,COUNT+2 ; ADD 16. BLOCKS TO SIZE OF HOLE ADC COUNT BR 6$ ; AND GO BACK FOR MORE EXIT: MOV R1,CURWRD ; SAVE THE WORKING REGISTERS BEQ 11$ ; (IF CURWRD.NE.0 BITCNT MUST BE DEC'D DEC R2 ; TO BE READY FOR NEXT PASS THRU HERE) 11$: MOV R2,BITCNT RETURN .PAGE .SBTTL GETWRD -- GET NEXT MAP WORD ; ; THIS ROUTINE GETS THE NEXT WORD FROM THE MAP FILE INPUT BUFFER. IF THE ; BUFFER IS EXHAUSTED IT WILL READ ANOTHER BLOCK. THE NEXT AVAILABLE WORD ; IS RETURNED IN R1. IF EOF IS REACHED OR A READ ERROR OCCURS THE CARRY ; BIT WILL BE SET ON RETURN AND R1 IS NOT CHANGED. ; GETWRD: CLR STAT ; CLEAR THE STATUS INDICATOR CMP BUFPTR,#INBUF+510. ; IS BUFFER EXHAUSTED? BLO 1$ ; NO IF LO INC BLOCK ; YES, GET NEXT BLOCK FROM FILE MOV BLOCK,READ+Q.IOPL+10 DIR$ #READ TSTB IOST ; READ SUCCESSFUL? BLT ERR ; NO, EITHER EOF OR READ ERROR MOV #INBUF-2,BUFPTR ; RE-INIT THE BUFFER PTR 1$: ADD #2,BUFPTR ; UPDATE THE PTR MOV @BUFPTR,R1 ; GET THE BUFFER WORD BEQ GEXIT ; IF WORD IS ZERO, STATUS IS CORRECT INC STAT ; NON-ZERO CHANGE STATUS CMP #-1,R1 ; IS WORD ALL ONES? BNE GEXIT ; NO IF NE NEG STAT ; YES GEXIT: CLC RETURN ERR: SEC RETURN .PAGE .SBTTL BLKSAV -- SAVE BLOCK ADDRESS OF CURRENT HOLE ; ; THIS ROUTINE TAKES THE BIT MAP VIRTUAL BLOCK NUMBER, THE WORD NUMBER ; WITHIN THE CURRENT BUFFER, AND THE BIT NUMBER WITHIN THE CURRENT WORD ; AND COMBINES THEM TO PRODUCE A LOGICAL BLOCK ADDRESS FOR THE DEVICE. ; BLKSAV: CALL $SAVAL ; SAVE ALL REGISTERS FIRST MOV #512.,R0 ; MULTIPLY THE BLOCK NUMBER RELATIVE TO THE MOV BLOCK,R3 ; START OF THE MAP BY 512. (BYTES/BLOCK) MOV R2,BITCNT ; SAVE THE BIT POSITION BEFORE DESTROYING IT CLR R2 SUB #2,R3 ; (MAP STARTS AT REL BLK 2) CALL $DMUL MOV R1,R3 ; MOV THE PRODUCT BACK TO THE MULTIPLICAND MOV R0,R2 ; REGISTERS MOV BUFPTR,R4 ; CALC. BYTE OFFSET INTO CURRENT BLOCK SUB #INBUF,R4 ADD R4,R3 ; (AT THIS POINT, THE TOTAL NUMBER OF ADC R2 ; MAP BYTES IS CONTAINED IN R2-3) MOV #8.,R0 ; MULTIPLY BY 8. VOL BLKS PER MAP BYTE CALL $DMUL MOV #16.,R4 ; LAST, ADD OFFSET INTO CURRENT WORD SUB BITCNT,R4 ADD R4,R1 ; INTO THE TOTAL TO OBTAIN ADC R0 MOV R1,BLKADR+2 ; THE ACTUAL VOLUME LOGICAL BLOCK ADDRESS MOV R0,BLKADR RETURN .PAGE .SBTTL DISPLAY HEADER AND GETCHR ROUTINES ; ; HEADER OUTPUT ROUTINE ; HEADER: COM HDRDON ; SET HEADER DONE FLAG DIR$ #TIME ; GET CURRENT DATE AND TIME MOV #OUTBUF,R0 ; FORMAT THE LINE INTO THE OUTPUT LINE MOV #ISTRNG,R1 ; (ADDR OF EDIT-CONTROL STRING) MOV #TBUF,R2 ; (DATE/TIME DATA) CALL $EDMSG SUB #OUTBUF,R0 ; SET UP DPB TO OUTPUT THE HEADER MOV R0,DPB+Q.IOPL+2 DIR$ #DPB ; OUTPUT IT MOV #OUTBUF,R0 ; RE-INIT THE LINE BFR PTR MOV #LINSIZ,DPB+Q.IOPL+2 ; RESTORE THE LINE SIZE RETURN ; ;**-123 .PAGE .SBTTL CDBOM ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; CONVERT DOUBLE PRECISION BINARY TO ASCII UNSIGNED OCTAL ; ; THIS ROUTINE CONVERTS AN UNSIGNED, DOUBLE PRECISION BINARY NUMBER TO AN ASCII ; OCTAL NUMBER STRING OF UP TO 11 DIGITS. ; ; TO CALL THE CBDOM ROUTINE: ; ; 1.) SUPPLY THREE INPUT ARGUMENTS IN THE TASK'S SOURCE CODE: ; ; IN R0, THE STARTING ADDRESS OF THE OUTPUT AREA IN ; WHICH THE CONVERTED 1 TO 11 DIGIT NUMBER IS TO BE ; STORED. ; ; IN R1, THE ADDRESS OF THE TWO-WORD INPUT AREA WHICH ; CONTAINS THE DOUBLE PRECISION BINARY NUMBER. ; ; IN R2, THE ZERO SUPPRESSION INDICATOR, WHERE: ; ; R2=0 TO SPECIFY THAT LEADING ZEROES ARE TO BE ; SUPPRESSED AND THE NUMBER LEFT-JUSTIFIED. ; ; R2=N WHERE 0 < N =< 11, TO SPECIFY LEADING ZERO ; SUPPRESSION WITH THE NUMBER RIGHT-JUSTIFIED ; IN A FIELD OF LENGTH N. IF THE CONVERTED ; NUMBER HAS MORE THAN N DIGITS, THE ROUTINE ; INSERTS A STRING OF N ASTERISKS IN THE OUTPUT ; AREA. ; ; R2=M WHERE -11 =< M < 0, TO SPECIFY NO SUPPRESSION ; OF LEADING ZEROES AND A FIELD LENGTH OF M. IF ; THE CONVERTED NUMBER HAS MORE THAN M DIGITS, A ; STRING OF M ASTERISKS WILL BE INSERTED IN THE ; OUTPUT AREA. ; ; NOTE: FOR EITHER MODE OF ZERO SUPPRESSION, IF THE NUMBER IS ZERO THERE WILL ; BE ONE ASCII ZERO INSERTED IN THE OUTPUT AREA. ; ; ; 2.) INCLUDE THE STATEMENT ; ; CALL CDBOM ; ; IN THE SOURCE PROGRAM. ; ; THE CDBOM ROUTINE CALLS $SAVRG TO SAVE AND RESTORE REGISTERS 3-5 OF THE ; CALLING TASK. REGISTERS 1 AND 2 ARE NOT PRESERVED. ; ; OUTPUTS FROM THE CDBOM ROUTINE ARE: ; ; 1.) THE CONVERTED NUMBER, A STRING OF 1 TO 11 DIGITS, IN THE ; OUTPUT AREA. ; ; 2.) R0 = THE NEXT AVAILABLE ADDRESS IN THE OUTPUT AREA. ; ; ; THE CDBOM ROUTINE DOES NOT RETURN ANY ERROR INDICATIONS TO THE CALLER. ; ; ; DATE: 15-AUG-78 ; ; AUTHOR: M. C. ARMSTRONG ; BADGER METER, INC. - ELECTRONICS DIV. ; RICHMOND, CA ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; CDBOM DATA AND DEFINITIONS SECTION ; LDCHAR: .ASCII / 0/ OVFTAB: 10,0 ; 1 DIGIT FIELD SIZE 100,0 ; 2 1000,0 ; 3 10000,0 ; 4 100000,0 ; 5 0,4 ; 6 0,40 ; 7 0,400 ; 8 0,4000 ; 9 0,40000 ; 10 ; ; OFFSET DEFINITIONS FOR STACK VARIABLES ; BUFSAV = 2 ; SAVED OUTPUT BUFFER ADDRESS PKCTRL = 4 ; USED TO PASS OVER UNWANTED ZEROS FOR ; NO-ZS AND ZS,RJ MODES ; ; CDBOM CODE SECTION ; CDBOM:: JSR R5,$SAVRG ; SAVE R3-R5 SUB #6,SP ; ALLOCATE SPACE FOR STACK VARIABLES MOV (R1)+,R4 ; GET DOUBLE PRECISION INPUT NUMBER MOV (R1),R5 ; WHERE IT IS HANDIER (R5=LO, R4=HI) CLR R1 ; INIT MODE REG. TO '0 SUPPRESS, LEFT JUSTIFY' CLR R3 ; AND CLEAR DIGIT REG FOR FIRST PASS TST R2 ; IS MODE '0 SUPPRESS, LEFT JUSTIFY'? BNE 1$ ; NO IF NE MOV #11.,R2 ; YES, SET TO MAX. DIGIT COUNT BR CVSTRT ; AND GO BEGIN CONVERSION WITH 2 HI-ORDER BITS 1$: BPL 2$ ; IF R2 > 0, MODE IS '0 SUPPRESS, RIGHT JUSTIFY' INC R1 ; OTHERWISE ZEROES ARE NOT TO BE SUPPRESSED NEG R2 ; MAKE FIELD SIZE POSITIVE 2$: INC R1 ; (R1=1 => [ZS,RJ]; R1=2 => [NO-ZS]) ; ; CHECK WHETHER NUMBER WILL FIT IN FIELD OF SPECIFIED SIZE ; ASH #2,R2 ; CONVERT FIELD SIZE TO INDEX INTO ; TEST TABLE CMP R4,OVFTAB-2(R2) ; HI-ORDER PART TOO BIG? BHI 3$ ; YES IF HI BNE 5$ ; NO IF NE CMP R5,OVFTAB-4(R2) ; OTHERWISE, IS LO-ORDER PART TOO BIG? BLO 5$ ; NO IF LO 3$: ASH #-2,R2 ; CHANGE R2 FROM TBL INDEX BACK TO FLD SIZE 4$: MOVB #'*,(R0)+ ; PACK ASTERISKS INTO OUTPUT AREA SOB R2,4$ ; UNTIL FILLED BR CVEXIT ; THEN EXIT 5$: MOV R0,BUFSAV(SP) ; SAVE BFR ADR FOR BFR-EMPTY-TEST LATER CLR (SP) ; SET NO SIGNIFICANT-DIGIT-SEEN FLAG ON STACK ASH #-2,R2 ; RESTORE R2 BACK TO FIELD SIZE SPEC AGAIN MOV #12.,PKCTRL(SP) ; INIT LOOP CTR FOR PASSING OVER UNWANTED SUB R2,PKCTRL(SP) ; ZEROS IN NO-ZS AND ZS,RJ MODES BR CVSTRT ; GET THE FIRST DIGIT (TWO BITS ONLY) ; ; BEGIN THE CONVERSION ; CVLOOP: CLR R3 ; CLEAR THE DIGIT REG ASHC #1,R4 ROL R3 CVSTRT: ASHC #1,R4 ROL R3 ASHC #1,R4 ROL R3 TST (SP) ; ANY SIG. DIG.'S YET? BNE 7$ ; YES IF NE TST R3 ; NO, IS THIS DIGIT A ZERO? BNE 6$ TST R1 ; YES, ARE WE IN ZS,LJ MODE? BEQ CVLOOP ; YES IF EQ - GO LOOK FOR SIGNIFICANCE IN LIFE DEC PKCTRL(SP) ; NO - PASSED OVER ALL UNWANTED ZEROS YET? BNE CVLOOP ; NO IF NE - DON'T PACK ANYTHING YET THEN MOVB LDCHAR-1(R1),R3 ; YES, OUTPUT SPACE OR ZERO AS REQUIRED INC PKCTRL(SP) ; (FORCES UNWANTED ZEROS TEST INTO HERE AGAIN) BR 10$ 6$: INC (SP) ; SET SIG.-DIG.-SEEN 7$: BISB #'0,R3 ; MAKE DIGIT ASCII 10$: MOVB R3,(R0)+ ; PACK THE CHARACTER SOB R2,CVLOOP ; DO IT UNTIL ALL DIGITS ARE DONE TST (SP) ; DID WE EVER FIND MEANING IN ALL THIS? BNE CVEXIT ; YES IN NE CMP BUFSAV(SP),R0 ; NO, WAS ANYTHING PACKED (ZS,RJ MODE)? BEQ 11$ ; NO IF EQ DEC R0 ; YES, BACK PTR UP OVER LAST SPACE 11$: MOVB #'0,(R0)+ ; AND PACK ONE ZERO REGARDLESS OF MODE CVEXIT: ADD #6,SP ; CLEAN THE STACK RETURN ; AND EXIT ;+ ; TRY AND GET AN MCR COMMAND LINE ; AND SIMULATE THE HOL>DEV: SYNTAX ;- GETLIN: DIR$ #ODPB ; OUTPUT A 'FRG>' DIR$ #IDPB ; ISSUE INPUT QIO BCS 10$ ; WE HAVE AN ERROR, SO GIVE UP MOV IOST+2,CMDLTH ; Get number of chars ;RAW001 BR 20$ ; OK - carry on ;**-1 ; 10$: JMP ERROR3 ; ELSE WARN USER ; 20$: MOV CMDLTH,R1 ; R1 has # of chars entered ;RAW001 BEQ 40$ ; Branch if no chars entered ;RAW001 MOV #GMCR+6,R0 ; Set input address ;RAW001 25$: BITB #100,(R0) ; A letter? ;RAW001 BEQ 30$ ; If EQ no - carry on ;**-5 BICB #40,(R0) ; Yes - convert it to upper case ; 30$: INC R0 ; Point to next character ;RAW001 SOB R1,25$ ; loop until all chars converted to UC ;RAW001 ; ;RAW001 40$: ;RAW001 MOV #"HO,GMCR+2 ; Fake the first part ;RAW001 MOV #"L ,GMCR+4 ; ;RAW001 ADD #4,CMDLTH ; ;RAW001 RETURN ; OK, GO HOME ;RAW001 .PAGE ;RAW001 .SBTTL State tables for .TPARS ;RAW001 ;RAW001 ISTAT$ STATE1,KEYTBL ;RAW001 ;RAW001 STATE$ PARCMD ;Parse command line ;RAW001 TRAN$ $STRNG ;Bypass program name 'HOL' ;RAW001 ;RAW001 STATE$ ;RAW001 TRAN$ !DEV,CHKSW ;See if a device was specified ;RAW001 TRAN$ $LAMDA,CHKSW ;If not, just check for switches ;RAW001 ;RAW001 STATE$ CHKSW ;RAW001 TRAN$ '/,GETSW ;Check for switch ;RAW001 TRAN$ $EOS,$EXIT ;Only exit from TPARS ;RAW001 ;RAW001 STATE$ GETSW ;RAW001 TRAN$ $DNUMB,CHKSW,SETSIZ ;Check for /nnn ;RAW001 TRAN$ "O",CHKSW,,SW.OCT,SWFLAG ;Check for /O (octal) ;RAW001 TRAN$ "OC",CHKSW,,SW.OCT,SWFLAG ;Check for /OC (octal) ;RAW001 TRAN$ "OCT",CHKSW,,SW.OCT,SWFLAG ;Check for /OCT (octal) ;RAW001 TRAN$ "OCTA",CHKSW,,SW.OCT,SWFLAG ;Check for /OCTA (octal) ;RAW001 TRAN$ "OCTAL",CHKSW,,SW.OCT,SWFLAG ;Check for /OCTAL (octal) ;RAW001 ;RAW001 STATE$ DEV ;/dev subexpression ;RAW001 TRAN$ $ALPHA,,MNEM1 ;Check for 1st letter of device name ;RAW001 ;RAW001 STATE$ ;RAW001 TRAN$ $ALPHA,,MNEM2 ;Check for 2nd letter of device name ;RAW001 ;RAW001 STATE$ ;RAW001 TRAN$ ':,$EXIT ;return if implied unit of 0 ;RAW001 TRAN$ $NUMBR,CKCOL2,STUNIT ;Get unit number ;RAW001 TRAN$ $LAMDA,$EXIT ;Return if implied unit 0 with no : ;RAW001 ;RAW001 STATE$ CKCOL2 ;RAW001 TRAN$ ':,$EXIT ;Return if : entered ;RAW001 TRAN$ $LAMDA,$EXIT ;Return if : not entered ;RAW001 ;RAW001 STATE$ ;End of state table ;RAW001 ; ;RAW001 ; TPARS Action routines ;RAW001 ; ;RAW001 ;RAW001 MNEM1: MOVB .PCHAR,ALUN+A.LUNA ;1st char of device mnumonic ;RAW001 RETURN ;RAW001 ;RAW001 MNEM2: MOVB .PCHAR,ALUN+A.LUNA+1 ;2nd char of device mnumonic ;RAW001 CLR ALUN+A.LUNU ;Assume unit 0 ;RAW001 RETURN ;RAW001 ;RAW001 STUNIT: MOV .PNUMB,ALUN+A.LUNU ;Device unit ;RAW001 RETURN ;RAW001 ;RAW001 SETSIZ: MOV .PNUMH,LOWLIM ;Store high order of low limit ;RAW001 MOV .PNUMB,LOWLIM+2 ;Store low order of low limit ;RAW001 RETURN ;RAW001 ;RAW001 .END HOLE ;**-7