Category : Pascal Source Code
Archive   : ALLSWAGS.ZIP
Filename : NUMBERS.SWG

SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00043 BITWISE TRANSLATIONS ROUTINES 1 05-28-9313:53ALL SWAG SUPPORT TEAM BITS1.PAS IMPORT 14 ž8Á {ã Sean Palmerãã> What if I want to just access a bit? Say I have a Byte, to storeã> Various access levels (if it does/doesn't have this, that, or theã> other). How can Iãã> 1) Access, say, bit 4?ã> 2) Give, say, bit 4, a value of 1?ãã> I have a simple routine that does "GetBit:= Value SHR 1;" to returnã> a value, but how can I *SET* a value? And is the above a goodã> method? I only have TP5.5, so I can't do the Asm keyWord (yet..).ããYou COULD use TP sets to do it...ã}ããTypeã tByte = set of 0..7;ãVarã b : Byte;ãã{to get:ã Write('Bit 0 is ',Boolean(0 in tByte(b)));ããto set:ã tByte(b):=tByte(b)+[1,3,4]-[0,2];ã}ããTypeã bitNum = 0..7;ã bit = 0..1;ããFunction getBit(b : Byte; n : bitNum) : bit;ãbeginã getBit := bit(odd(b shr n));ãend;ããFunction setBit( b : Byte; n : bitNum) : Byte;ãbeginã setBit := b or (1 shl n);ãend;ããFunction clrBit(b : Byte; n : bitNum) : Byte;ãbeginã clrBit := b and hi($FEFF shl n);ãend;ãã{ã OR.....using Inline() code (the fastest)ã These are untested but I'm getting fairly good at assembling by hand...8)ã}ããFunction getBit(b : Byte; n : bitNum) : bit;ãInline(ã $59/ {pop cx}ã $58/ {pop ax}ã $D2/$E8/ {shr al,cl}ã $24/$01); {and al,1}ããFunction setBit(b : Byte; n : bitNum) : Byte;ãInline(ã $59/ {pop cx}ã $58/ {pop ax}ã $B3/$01/ {mov bl,1}ã $D2/$E3/ {shl bl,cl}ã $0A/$C3); {or al,bl}ããFunction clrBit(b : Byte; n : bitNum) : Byte;ãInline(ã $59/ {pop cx}ã $58/ {pop ax}ã $B3/$FE/ {mov bl,$FE}ã $D2/$C3/ {rol bl,cl}ã $22/$C3); {or al,bl}ã 2 05-28-9313:53ALL SWAG SUPPORT TEAM BITS2.PAS IMPORT 25 ž8!5 {ãROB GREENãã> What if I want to just access a bit? Say I have a Byte, to storeã> Various access levels (if it does/doesn't have this, that, or theã> other). How can Iã> 1) Access, say, bit 4?ã> 2) Give, say, bit 4, a value of 1?ããHeres a Procedure i wrote to handle all that. if you need speed, thenãi suggest to manually check each bit, rather than use the Procedures.ãã(these Procedures are based on 1, not 0. thus each Byte is like so:ã87654321 instead of 76543210. to change to 0 base, change the Array toã[0..31] instead of [1..32].)ããto set a bit: (b is an Integer Type, BIT is which bit to setã b:=b or BIT; ex: b:=b or 128 (set bit 8)ããto clear a bit:ã b:=b and not BIT; ex:b:=b and not 8; (clears bit 4)ããto check a bit:ã if b and BIT<>0 then.. ex:if b and 64 then.. (check bit 7)ã}ããConstã{ Used to convert the Bit value to the actual corresponding number }ã bit : Array[1..32] of LongInt =ã (1, 2, 4, 8, $10, $20, $40, $80, $100, $200, $400, $800, $1000, $2000,ã $4000, $8000, $10000, $20000, $40000, $80000, $100000, $200000,ã $400000, $800000, $1000000, $2000000, $4000000, $8000000, $10000000,ã $20000000, $40000000, $80000000);ãã{b is which bit to set(1-32), size is the size of temp.ãUse SIZEOF(TEMP) to get the value, and temp is the actuall Integer basedãnumberãreturns True if bit set, False if not}ããFunction checkbit(b : Byte; size : Byte; Var temp) : Boolean; {1-32}ãVarã c : Boolean;ãbeginã c:=False;ã Case size ofã 1 : c := Byte(temp) and bit[b] <> 0; {Byte,shortint}ã 2 : c := Word(temp) and bit[b] <> 0; {Word,Integer}ã 4 : c := LongInt(temp) and bit[b] <> 0; {LongInt}ã elseã Writeln('Invalid size');ã end;ã checkbit := c;ãend;ãã{b,size,and temp same as above. if onoff =True the bit will be set,ãelse the bit will be cleared}ããProcedure setbit(b : Byte; onoff : Boolean; size : Byte; Var temp); {1-32}ãbeginã if onoff thenã Case size ofã 1 : Byte(temp) := Byte(temp) or bit[b]; {Byte}ã 2 : Word(temp) := Word(temp) or bit[b]; {Word}ã 4 : LongInt(temp) := LongInt(Temp) or bit[b]; {LongInt}ã elseã Writeln('Invalid size');ã endã elseã Case size ofã 1 : Byte(temp) := Byte(temp) and not bit[b]; {Byte}ã 2 : Word(temp) := Word(temp) and not bit[b]; {Word}ã 4 : LongInt(temp) := LongInt(Temp) and not bit[b];{LongInt}ã elseã Writeln('Invalid size');ã end;ãend;ãã{this is a sample test Program i wrote For you to see how to use theãstuff above}ããVarã i : LongInt;ã j : Byte;ãbeginã i := 0;ã setbit(4,True,sizeof(i),i); {8}ã Writeln(i);ã setbit(9,True,sizeof(i),i); {256+8 = 264}ã Writeln(i);ã setbit(9,False,sizeof(i),i); {8}ã Writeln(i);ã setbit(20,True,sizeof(i),i); { $80000+8 = $80008}ã Writeln(i);ã For i := 65550 to 65575 doã beginã Write(i : 8, ' = ');ã For j := 32 downto 1 do {to print right}ã if checkbit(j, sizeof(i), i) thenã Write('1')ã elseã Write('0');ã Writeln;ã end;ãend.ã 3 05-28-9313:53ALL SWAG SUPPORT TEAM BIT_GET.PAS IMPORT 3 ž8¥' { You can use multiplies of 2 like: }ããFunction Find_Bit(B, c : Byte) : Byte;ã{c is the position c=0 far right c=7 far leftãreturns 0 or 1}ãbeginã if b MOD (b shl c) = 0 then Find_Bit := 0ã else Find_Bit := 1ãend;ãã 4 05-28-9313:53ALL SWAG SUPPORT TEAM BIT_ROT1.PAS IMPORT 8 ž8…Ð The commands you need to rotate a Byte/Word are:ããROR, ROL, RCR, RCL.ãROR ==> Rotates the bits the number of times specified, so that theã rightmost bits are rotated into the leftmost bits. NO BITSã ARE LOST. ROL is the same thing in the opposite direction.ããRCR ==> Practically the same as the ROR/ROL instruction, but it rotatesã the bit into the carry, and the carry bit is rotated into theã leftmost bit of the Byte/Word. {Rotate right through carry}ã RCL is the same in the other direction.ããThe format For each of ROR,ROL,RCR,RCL,SHR,SHL isãã [Instruction] ããTo reWrite your original code:ããAsmã Mov AL, ByteVarã Ror AL, 1ã Mov ByteVar, ALãendããThe above would rotate the bits in the Variable ByteVar by one to the right.ã 5 05-28-9313:53ALL CHRIS PRIEDE Rotate Bits LEFT/RIGHT IMPORT 14 ž8G > I made a Program in Turbo-Pascal that rotates the bits in one Byte so I canã> encrypt/decrypt a File, however the routine is slow. I then made the sameã> Program in turbo-C using _RotLeft and _RotRight, the speed of execution wasã> Really faster than Turbo-Pascal. Does anybody know of a way to rotate theã> bits of one Byte in turbo-Pascal and FAST !!!!ããã Since 80xxx CPUs have bit rotate instructions (ROL, ROR), it wouldãbe a shame to use some clumsy HLL Construct. BTW, I'm sure _RotLeft andã_RotRight use rotate instructions too, possibly insert them Inline. Ifãyou are using TP 6.0+, try something like this:ãã{ to rotate left }ãFunction RotLeft(B, Count: Byte): Byte; Assembler;ãAsmã mov al, Bã mov cl, Countã rol al, clãend;ãã{ to rotate right }ãFunction RotRight(B, Count: Byte): Byte; Assembler;ãAsmã mov al, Bã mov cl, Countã ror al, clãend;ããã Of course, if you need to do this in only a few places it wouldãbe better not to define Functions, but insert Asm blocks in your codeãdirectly.ãã The fastest Pascal way to rotate Byte would be something likeãthis:ããFunction RotLeft(B, Count: Byte): Byte;ãVarã W : Word;ã A : Array[0..1] of Byte Absolute W;ãbeginã A[0] := B;ã A[1] := B;ã W := W shl Count;ã RotLeft := A[1];ãend;ãã To rotate right With this method, you would shift right andãreturn A[0]. I would like to think this is as fast as it gets in TPãwithout assembly, but one can never be sure . Anyway, I recommendãthe assembly solution over this one, it is faster and more elegant.ã 6 05-28-9313:53ALL SWAG SUPPORT TEAM BIT_ROT3.PAS IMPORT 5 ž8ª {ãSEAN PALMERã}ããFunction rolW(b : Word; n : Byte) : Word; Assembler;ãAsmã mov ax, bã mov cl, nã rol ax, clãend;ããFunction rolB(b, n : Byte) : Byte; Assembler;ãAsmã mov al, bã mov cl, nã rol al, clãend;ããFunction rolW1(b : Word) : Word; Assembler;ãAsmã mov ax, bã rol ax, 1ãend;ãã{ These would be better off as Inline Functions, such as... }ããFunction IrolW1(b : Word) : Word;ãInline(ã $58/ {pop ax}ã $D1/$C0); {rol ax,1}ãã{ because no Function call is generated. }ãã 7 05-28-9313:53ALL SWAG SUPPORT TEAM BYT2REAL.PAS IMPORT 5 ž8€, Typeã bsingle = Array [0..3] of Byte;ãã{ converts Microsoft 4 Bytes single to TP Real }ããFunction msb_to_Real (b : bsingle) : Real;ãVarã pReal : Real;ã r : Array [0..5] of Byte Absolute pReal;ãbeginã r [0] := b [3];ã r [1] := 0;ã r [2] := 0;ã move (b [0], r [3], 3);ã msb_to_Real := pReal;ãend; { Function msb_to_Real }ãã{ãAnother Turbo Pascal routine to convert Microsoft single to TP LongIntããindex := ((mssingle and not $ff000000) or $00800000) shr (24 -ã((mssingle shr 24) and $7f)) - 1;ã}ã 8 05-28-9313:53ALL SWAG SUPPORT TEAM BYTE2BIN.PAS IMPORT 7 ž8"a {ãByte to Binary...ã}ããTypeã String8 = String[8];ãããFunction Byte2Bin(byTemp : Byte) : String8;ãVarã Count : Integer;ãbeginã Byte2Bin[0] := #8;ã For Count := 0 to 7 doã Byte2Bin[8 - Count] := Char(((byTemp shr Count) and 1) + ord('0'));ãend;ããFunction Byte2BinAsm(byTemp : Byte) : String8; Assembler;ãAsmã push dsã les di,@resultã mov ah,byTempã mov cl,8ã mov al,clã stosbã@loop:ã mov al,24ã add ah,ahã adc al,alã stosbã loop @loopã pop dsãend;ããbeginã Writeln;ã Writeln('10 in Binary = ',Byte2Bin(10));ã Writeln;ã Writeln('The same thing With assembly code: ',Byte2BinAsm(10));ã Writeln;ã Readln;ãend. 9 05-28-9313:53ALL SWAG SUPPORT TEAM BYTEINFO.PAS IMPORT 57 ž8©À {ã>Also, how would I simply read each bit?ã}ã{ Test if a bit is set. }ãFunction IsBitSet(Var INByte : Byte; Bit2Test : Byte) : Boolean;ãbeginã if (Bit2Test in [0..7]) thenã IsBitSet := ((INByte and (1 shl Bit2Test)) <> 0)ã elseã Writeln('ERROR! Bit to check is out of range!');ãend; { IsBitSet. }ãã{ã>How on earth can I manipulate an individual bit?ãã...One method is to use the bit-operators: AND, OR, XOR, NOTã}ãã{ Manipulate an individual BIT within a single Byte. }ãProcedure SetBit(Bit2Change : Byte; TurnOn : Boolean; Var INByte : Byte);ãbeginã if Bit2Change in [0..7] thenã beginã if TurnOn thenã INByte := INByte or (1 shl Bit2Change)ã elseã INByte := INByte and NOT(1 shl Bit2Change);ã end;ãend; { SetBit. }ãã{ã>...but I'm not sure exactly what the shifting is doing.ã}ãã { Check if the bit is to be turned on or off. }ã If TurnOn thenãã {ã SHL 1 (which has a bit map of 0000 0001) to the bitã position we want to turn-on.ãã ie: 1 SHL 4 = bit-map of 0001 0000ãã ...Then use a "logical OR" to set this bit.ãã ie: Decimal: 2 or 16 = 18ã Binary : 0000 0010 or 0001 0000 = 0001 0010ã }ãã INByte := INByte or (1 shl Bit2Change)ã elseãã {ã Else turn-off bit.ãã SHL 1 (which has a bit map of 0000 0001) to the bitã position we want to turn-off.ãã ie: 1 SHL 4 = bit-map of 0001 0000ãã ...Then use a "logical NOT" to flip all the bits.ãã ie: Decimal: not ( 16 ) = 239ã Binary : not (0001 0000) = (1110 1111)ãã ...Than use a "logical AND" to turn-off the bit.ãã ie: Decimal: 255 and 239 = 239ã Binary : 1111 1111 and 1110 1111 = 1110 1111ã }ãã INByte := INByte and NOT(1 shl Bit2Change);ãã{ã>Also, how can you assign a Byte (InByte) a Boolean value (OR/AND/NOT)ãã or / xor / and / not are "logical" bit operators, that can be use onã "scalar" Types. (They also Function in the same manner For "Boolean"ã logic.)ãã>If I have, say 16 bits in one Byte, the interrupt list says that forã>instance the BIOS calls (INT 11), AX is returned With the values. Itã>says that the bits from 9-11 tell how many serial portss there are.ã>How do I read 3 bits?ãã To modify the two routines I posted wo work With 16 bit Variables,ã you'll need to change:ãã INByte : Byte; ---> INWord : Word;ãã ...Also:ãã in [0..7] ---> in [0..15]ãã ...If you don't want to use the IsBitSet Function listed aboveã (modified to accept 16-bit Word values) you could do the followingã to check if bits 9, 10, 11 are set in a 16-bit value:ãã The following is the correct code For reading bits 9, 10, 11ã of the 16-bit Variable "AX_Value" :ãã Port_Count := ((AX_Value and $E00) SHR 9);ãã NOTE: Bit-map For $E00 = 0000 1110 0000 0000ãã ...If you've got a copy of Tom Swan's "Mastering Turbo Pascal",ã check the section on "logical operators".ããã{ã>Var Regs : Registers;ã>beginã> Intr($11,Regs);ã> Writeln(Regs.AX);ã>end.ãã>How do I manipulate that to read each bit (or multiple bits likeã>the number of serial ports installed (bits 9-11) ?ã}ããUsesã Dos;ããVarã Port_Count : Byte;ã Regs : Registers;ããbeginã Intr($11, Regs);ã Port_Count := ((Regs.AX and $E00) SHR 9);ã Writeln('Number of serial-ports = ', Port_Count)ãend.ã{ãNOTE: The hex value of $E00 is equivalent to a 16-bit value withã only bits 9, 10, 11 set to a binary 1. The SHR 9 shifts theã top Byte of the 16-bit value, to the lower Byte position.ã}ã{ã>Is $E00 the same as $0E00 (ie, can you just omit leading zeros)?ããYeah, it's up to you if you want to use the leading zeros or not.ããThe SHR 9 comes in because once the value has been "AND'd" withã$E00, the 3 bits (9, 10, 11) must be placed at bit positions:ã0, 1, 2 ...to correctly read their value.ããFor example, say bits 9 and 11 were set, but not bit 10. If weã"AND" this With $E00, the result is $A00.ãã1011 1010 0111 1110 and 0000 1110 0000 0000 = 0000 1010 0000 0000ã ^ ^ã(bits 9,11 are set) and ( $E00 ) = $A00ã...Taking the result of $A00, and shifting it right 9 bit positionsãã $A00 SHR 9 = 5ãã 0000 1010 0000 0000 SHR 9 = 0000 0000 0000 0101ãã...Which evalutates to 5. (ie: 5 serial ports)ã}ãããããããããã{ãGet Equipment Bit-Mapã---------------------ãã AH ALã 76543210 76543210ãAX = ppxgrrrx ffvvmmciãã...ã...ãrrr = # of RS232 ports installedã...ã...ãã (* reports the number of RS232 ports installed *)ãFunction NumRS232 : Byte;ãVar Regs : Registers; (* Uses Dos *)ãbeginã Intr($11,Regs);ã NumRS232 := (AH and $0E) shr 1;ãend;ããã...When you call Int $11, it will return the number of RS232 ports installedãin bits 1-3 in register AH.ããFor example if AH = 01001110 , you can mask out the bits you *don't* wantãby using AND, like this:ãã 01001110 <--- AHã and 00001110 <---- mask $0Eã ÄÄÄÄÄÄÄÄÄÄÄÄÄÄã 00001110 <---- after maskingãããThen shift the bits to the right With SHR,ãã 00001110 <---- after maskingã SHR 1 <---- shift-right one bit positionã ÄÄÄÄÄÄÄÄÄÄÄÄÄã 00000111 <---- result you wantã}ãã{ã-> How do I know to use $4 For the third bit? Suppose I want to readã-> the fifth bit. Do I simply use b := b or $6?ãã Binary is a number system just like decimal. Let me explain.ãFirst, consider the number "123" in decimal. What this means,ãliterally, isãã1*(10^2) + 2*(10^1) + 3*(10^0), which is 100 + 20 + 3.ãã Binary works just the same, however instead of a 10, a 2 is used asãthe base. So the number "1011" meansãã1*(2^3) + 0*(2^2) + 1*(2^1) + 1*(2^0), or 8+0+2+1, or 11.ãã This should make it clear why if you wish to set the nth bit toãTrue, you simply use a number equal to 2^(n-1). (The -1 is thereãbecause you probably count from 1, whereas the powers of two, as you mayãnote, start at 0.)ãã-> b or (1 SHL 2) Would mean that b := 1 (True) if b is already equal toã-> one (1) and/OR the bit two (2) to the left is one (1) ???ãã Aha. You are not familiar With bitwise or operations. When oneãattempts to or two non-Boolean values (Integers), instead of doing aãlogical or as you are familiar with, each individual BIT is or'd. I.E.ãimagine a Variables A and B had the following values:ããa := 1100 (binary);ãb := 1010 (binary);ããthen, a or b would be equal to 1110 (binary); Notice that each bit of aãhas been or'd With the corresponding bit of b? The same goes For and.ãHere's an example.ããa := 1100 (binary);ãb := 1010 (binary);ããa and b would be equal to 1000;ããI hope this clears up the confusion. And just to be sure, I'm going toãbriefly show a SHL and SHR operation to make sure you know. Considerãthe numberããa := 10100 (binary);ããThis being the number, A SHL 2 would be equal to 1010000 (binary) --ãnotice that it has been "shifted to the left" by 2 bits.ããA SHR 1 would be 1010 (binary), which is a shifted to the right by 2ãbits.ã}ãã 10 05-28-9313:53ALL SWAG SUPPORT TEAM DEC2BIN1.PAS IMPORT 6 ž8Q² {ã> I need to transfer decimal into binary using TURBO PASCAL.ã> One way to do this is to use the basic algorithm, dividingã> by 2 over and over again. if the remainder is zero theã> bit is a 0, else the bit is a 1.ã>ã> However, I was wondering if there is another way to convertã> from decimal to binary using PASCAL. Any ideas?ããAs an 8-bit (ie. upto 255) example...ã}ãã Function dec2bin(b:Byte) : String;ã Var bin : String[8];ã i,a : Byte;ã beginã a:=2;ã For i:=8 downto 1 doã beginã if (b and a)=a then bin[i]:='1'ã else bin[i]:='0';ã a:=a*2;ã end;ã dec2bin:=bin;ã end;ãã 11 05-28-9313:53ALL SWAG SUPPORT TEAM DEC2BIN2.PAS IMPORT 7 ž8žŠ { True so here is another version of the process that returns a String : }ããProgram Dec2BinRec;ããTypeã Str32 = String[32];ããFunction Dec2BinStr(aNumber : LongInt) : Str32;ãã Function Bit(aBit : Byte) : Char;ã (* return either Char '0' or Char '1' *)ã beginã if aBit = 0 thenã Bit := '0'ã elseã Bit := '1'ã end;ããbeginã If aNumber = 0 Thenã Dec2BinStr := '' (* done With recursion ?*)ã else (* convert high bits + last bit *)ã Dec2BinStr := Dec2BinStr(ANumber Div 2) + Bit(aNumber Mod 2);ãend;ããVarã L : LongInt;ãbeginã Repeatã Readln (L);ã If L <> 0 thenã Writeln(Dec2BinStr(L));ã Until (L = 0)ãend.ã 12 05-28-9313:53ALL SWAG SUPPORT TEAM HEX2BIN1.PAS IMPORT 22 ž8/ Function Hex2Bin (B : Byte) : String;ããVarã Temp : String [8];ã Pos, Mask : Byte;ããbeginã Temp := '00000000';ã Pos := 8;ã Mask := 1;ã While (Pos > 0) Doã beginã if (B and Mask)ã thenã Temp [Pos] := '1';ã Dec (Pos);ã Mask := 2 * Mask;ã end;ã Hex2Bin := Temp;ãend;ããããããããFunction Hex2Bin( HexByte:Byte ):String; External; {$L HEX2Bin.OBJ}ãVar i : Integer;ãbeginã For i := $00 to $0F do WriteLn( Hex2Bin(i) );ãend.ã(*********************************************************************)ãã The Assembly source ...ãã;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;ãcode segment Byte 'CODE' ; HEX2Bin.Asmã assume cs:codeã; Function Hex2Bin( HexByte :Byte ) :String;ãString equ dWord ptr [bp+6]ãHexByte equ [bp+4]ã public Hex2BinãHex2Bin proc Near ; link into main TP Programã push bp ; preserveã mov bp,sp ; stack frameã les di, String ; result String Pointerã cld ; Forward scanã mov cx,8 ; 8 bits in a Byteã mov al,cl ; to setã stosb ; binary String lengthã mov ah, HexByte ; get the hex Byteã h2b: xor al,al ; cheap zeroã rol ax,1 ; high bit to low bitã or al,'0' ; make it asciiã stosb ; put it in Stringã loop h2b ; get all 8 bitsã pop bp ; restoreã ret 2 ; purge stack & returnãHex2Bin endpãcode endsã endã;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;ãã Here's the assembled OBJ File ...ãã Put all of this remaining message in a Text File named HEX2Bin.SCR,ã then Type "DEBUG < HEX2Bin.SCR" (no quotes) to create HEX2Bin.ARC;ã then extract HEX2Bin.OBJ using PKUNPAK or PAK ...ã ---------------------------- DEBUG script ----------------------------ã N HEX2Bin.ARCã E 0100 1A 02 48 45 58 32 42 49 4E 2E 4F 42 4A 00 5E 65 00 00 00 4A 19ã E 0115 13 22 60 F2 65 00 00 00 80 0D 00 0B 68 65 78 32 62 69 6E 2E 41ã E 012A 53 4D A9 96 07 00 00 04 43 4F 44 45 44 98 07 00 20 1D 00 02 02ã E 013F 01 1F 90 0E 00 00 01 07 48 45 58 32 42 49 4E 00 00 00 6A 88 04ã E 0154 00 00 A2 01 D1 A0 21 00 01 00 00 55 8B EC C4 7E 06 FC B9 08 00ã E 0169 8A C1 AA 8A 66 04 32 C0 D1 C0 0C 30 AA E2 F7 5D C2 02 00 21 8Aã E 017E 02 00 00 74 1A 00ã Rcxã 0084ã Wã Qã ----------------------------------------------------------gbug-1.0b--ã 13 05-28-9313:53ALL SWAG SUPPORT TEAM HEXCONV.PAS IMPORT 7 ž8xÇ Varã n : Word;ã long : LongInt;ããFunction Byte2Hex(numb : Byte): String; { Converts Byte to hex String }ã Constã HexChars : Array[0..15] of Char = '0123456789ABCDEF';ã beginã Byte2Hex[0] := #2;ã Byte2Hex[1] := HexChars[numb shr 4];ã Byte2Hex[2] := HexChars[numb and 15];ã end; { Byte2Hex }ããFunction Numb2Hex(numb: Word): String; { Converts Word to hex String.}ã beginã Numb2Hex := Byte2Hex(hi(numb))+Byte2Hex(lo(numb));ã end; { Numb2Hex }ããFunction Long2Hex(L: LongInt): String; { Converts LongInt to hex String }ã beginã Long2Hex := Numb2Hex(L shr 16) + Numb2Hex(L);ã end; { Long2Hex }ãããbeginã long := 65536;ã n := 256;ã Writeln(Long2Hex(long));ã Writeln(Numb2Hex(n));ãend.ã 14 05-28-9313:53ALL SWAG SUPPORT TEAM HEXINFO.PAS IMPORT 13 ž8è¢ > I am learning Pascal and don't understand something. How does theã> following Function make a Word into Hex:ãã It's Really doing two things, it's converting a binary valueã into ascii, and from decimal to hex. Let's start With theã calling or main part of the Program. You're taking a 2 Byteã Word and breaking it up into 4 nibbles of 4 bits each. Each ofã these nibbles is displayed as a Single hex Character 0-F.ãã Hex Representation XXXXã ||||ãHexStr := HexStr + Translate(Hi(W) shr 4); -----------||||ãHexStr := HexStr + Translate(Hi(W) and 15);------------|||ãHexStr := HexStr + Translate(Lo(W) shr 4); -------------||ãHexStr := HexStr + Translate(Lo(W) and 15);--------------|ãããNow the translate Function simply converts the decimal value ofãthe 4-bit nibble into an ascii hex value. if you look at anãascii Chart you will see how this is done:ãã'0' = 48 '5' = 53 'A' = 65ã'1' = 49 '6' = 54 'B' = 66ã'2' = 50 '7' = 55 'C' = 67ã'3' = 51 '8' = 56 'D' = 68ã'4' = 52 '9' = 57 'E' = 69ã 'F' = 70ãããAs you can see it easy For 0-9, you just add 48 to the value andãit's converted, but when you go to convert 10 to A, you need toãuse a different offset, so For values above 9 you add 55.ããFunction Translate(B : Byte) : Char;ã beginã if B < 10 thenã Translate := Chr(B + 48)ã elseã Translate := Chr(B + 55);ã end;ã 15 05-28-9313:53ALL SWAG SUPPORT TEAM RANDOM1.PAS IMPORT 15 ž8{ {Another method to acComplish this (which only requires an order of nãitterations is to generate an Array initialized from 2 to 1000 and thenãrandomize that Array. For your 400 numbers, just take 400 values in theãnew sequence (starting at the index of your lowest number). You can doãthat as follows:ã}ããConst MaxNumber = 2000;ãType SeqArray = Array [1..MaxNumber] of Integer;ãã{================================================================}ãProcedure RandomizeSeq (first, last: Integer; Var iseq: SeqArray);ã{================================================================}ããVar i, iran,ã temp, imax : Integer;ã r : Real;ã{ã Operation: A random number within the range 1..last is generatedã on each pass and the upper limit of the random number generated isã decreased by 1. The value stored at the highest index of the lastã pass is moved to the location of the last number selected.ãã Parameters:ã first = lowest number in sequence.ã last = highest number in sequence.ã iseq = Sequence Arrayã}ãbeginã { initialize sequence Array }ã For i := first to last do iseq[i] := i;ã Randomize;ã { randomize the sorted Array }ã For imax := last downto first do beginã { get a random number between 0 and 1 and scale up toã an Integer in the range of first to last }ã r := random;ã iran := Trunc(r*imax) + first;ã { replace With value at highest index }ã temp := iseq[iran];ã iseq[iran] := iseq[imax];ã iseq[imax] := tempã end;ãend;ãã{ Example of generating 20 random numbers from 2 to 100: }ããVar i : Integer;ã a : SeqArray;ãbeginã RandomizeSeq(2,100,a);ã For i := 2 to 21 do Write(a[i]:3); Writeln;ãend.ã 16 05-28-9313:53ALL SWAG SUPPORT TEAM RANDOM2.PAS IMPORT 18 ž8À| { MR> I have started playing With Borland Turbo Pascal 7.0 and I have aã MR> problem. The Random routine is not the same as the one in TP 6.0.ã MR> Using the same RandSeed, they generate different series of numbers.ã MR> I have a couple of applications that depend upon the number seriesã MR> generated by the TP 6.0 version. Can anyone supply me With theã MR> algorithm used in the TP 6.0 Random routine? or maybe point me inã MR> the right direction? I want to Construct my own TP 7 Random routineã MR> that will behave as the one in TP 6.ããThe way both generators work is to update System.Randseed, then calculate theãnew random value from that one. There have been several different ways toãcalculate the value; I think TP 6 is different from TP 5.5, and TP 7 isãdifferent again. The update algorithm has been pretty Constant.ããAs I recall, you can simulate the TP 6 Random(N) Function in TP 7 as follows:ã}ãFunction TP6Random(N:Word):Word;ãVarã junk : Word;ã myrandseed : Recordã lo, hi : Wordã end Absolute system.randseed;ãbeginã junk := Random(0); { Update Randseed }ã TP6Random := myrandseed.hi mod N;ãend;ãã{ãYou might want to keep the following around in Case the update algorithm getsãchanged sometime in the future:ããDemonstration Program to show how the TP 6.0 random number generatorãupdates System.Randseed. Allows the seed to be cycled backwards. }ããProcedure CycleRandseed(cycles:Integer);ã{ For cycles > 0, mimics cycles calls to the TP random number generator.ã For cycles < 0, backs it up the given number of calls. }ãVarã i : Integer;ãbeginã if cycles > 0 thenã For i := 1 to cycles doã system.randseed := system.randseed*134775813 + 1ã elseã For i := -1 downto cycles doã system.randseed := (system.randseed-1)*(-649090867);ãend;ããVarã i : Integer;ãbeginã randomize;ã Writeln('Forwards:');ã For i:=1 to 5 doã Writeln(random);ã Writeln('Backwards:');ã For i:=1 to 5 doã beginã CycleRandseed(-1); { Back to previous value }ã Writeln(random); { Show it }ã CycleRandseed(-1); { Back up over it again }ã end;ãend.ã 17 05-28-9313:53ALL SWAG SUPPORT TEAM REALFRMT.PAS IMPORT 8 ž8¸² {ã I recently came across the need For a way to dynamically Formatã Real Variables For output - I came out With the following. (Youã people following the Compiler thread may want this to make yourã Compiler output pretty)ãã The routine checks to see how big the exponent is; if it's biggerã than 1E7 or smaller than 1E-7, an unFormatted conversion is made.ã if the number is less than 1E7 and greater than 1E-7, then aã Formatted String is created. to make the output prettier, trailingã zeros, periods and leading spaces are deleted.ã}ããFunction FormatReal(r:Real):String;ãVarã s :String;ããbeginã if ((r>1E-7) and (r<1E7))thenã Str(r:12:12, s)ã elseã Str(r, s);ãã While s[ord(s[0])]='0' doã Delete(s, ord(s[0]), 1);ã While (s[1]=' ') doã Delete(s, 1, 1);ã if s[ord(s[0])]='.' thenã Delete(s, ord(s[0]), 1);ãã FormatReal := s;ãend;ã 18 05-28-9313:53ALL SWAG SUPPORT TEAM REVERSE.PAS IMPORT 7 ž8²  {ã a problem. I am asked to find the reverse of a positive Integer. Forã example the reverse of 123 is 321 or the reverse of 1331 is 1331.ã My teacher said that we should use div and MOD.ã}ããVarã X, Y: Integer;ããbeginã X := PositiveInteger;ã Y := 0;ãã While X > 0 doã beginã Y := (Y * 10) + (X mod 10);ã X := X div 10;ã end;ãã{ãThe result will be in Y. Just so you do learn something of use out of this: Itãis a fact that the difference between two transposed (reversed) numbers will beãevenly divisible by 9. This can be of help if you are doing somethingãaccounting related and are trying to figure out why your numbers don't jive. ifãthe amount you are out is evenly divisible by 9, it is most likely aãtransposing error.ã}ã 19 05-28-9313:53ALL SWAG SUPPORT TEAM ROMAN1.PAS IMPORT 19 ž8Z {ãú Subject: Word to Roman Numeralãã OK, here is my second attempt, With error checking and all. Thanks toãTerry Moore For encouraging me. The last Functionãalso contained a couple of errors. This one is errorchecked.ã}ããFunction RomantoArabic(Roman : String) : Integer;ã{ Converts a Roman number to its Integer representation }ã{ Returns -1 if anything is wrong }ãã Function Valueof(ch : Char) : Integer;ã beginã Case ch ofã 'I' : Valueof:=1;ã 'V' : Valueof:=5;ã 'X' : Valueof:=10;ã 'L' : Valueof:=50;ã 'C' : Valueof:=100;ã 'D' : Valueof:=500;ã 'M' : Valueof:=1000;ã else Valueof:=-1;ã end;ã end; { Valueof }ãã Function AFive(ch : Char) : Boolean; { Returns True if ch = 5,50,500 }ã beginã AFive:=ch in ['V','L','D'];ã end; { AFive }ããVarã Position : Byte;ã TheValue, CurrentValue : Integer;ã HighestPreviousValue : Integer;ãbeginã Position:=Length(Roman); { Initialize all Variables }ã TheValue:=0;ã HighestPreviousValue:=Valueof(Roman [Position]);ã While Position > 0 doã beginã CurrentValue:=Valueof(Roman [Position]);ã if CurrentValue<0 thenã beginã RomantoArabic:=-1;ã Exit;ã end;ã if CurrentValue >= HighestPreviousValue thenã beginã TheValue:=TheValue+CurrentValue;ã HighestPreviousValue:=CurrentValue;ã endã elseã begin { if the digit precedes something larger }ã if AFive(Roman [Position]) thenã beginã RomantoArabic:=-1; { A five digit can't precede anything }ã Exit;ã end;ã if HighestPreviousValue div CurrentValue > 10 thenã beginã RomantoArabic:=-1; { e.g. 'XM', 'IC', 'XD'... }ã Exit;ã end;ã TheValue:=TheValue-CurrentValue;ã end;ã Dec(Position);ã end;ã RomantoArabic:=TheValue;ãend; { RomantoArabic }ããbeginã Writeln('XXIV = ', RomantoArabic('XXIV'));ã Writeln('DXIV = ', RomantoArabic('DXIV'));ã Writeln('CXIV = ', RomantoArabic('CXIV'));ã Writeln('MIXC = ', RomantoArabic('MIXC'));ã Writeln('MXCIX = ', RomantoArabic('MXCIX'));ã Writeln('LXVIII = ', RomantoArabic('LXVIII'));ã Writeln('MCCXXIV = ', RomantoArabic('MCCXXIV'));ã Writeln('MMCXLVI = ', RomantoArabic('MMCXLVI'));ã Readln;ãend. 20 05-28-9313:53ALL SWAG SUPPORT TEAM ROMAN2.PAS IMPORT 10 ž8á {ã>Anyone know of how to make a Program that will convert anyã>Integer entered into roman numeral Format?ã}ããProgram Roman_Numeral_Test;ããTypeã st_4 = String[4];ã st_15 = String[15];ã star_4 = Array[0..3] of st_4;ã star_10 = Array[0..9] of st_4;ããConstã Wunz : star_10 = ('', 'I', 'II', 'III', 'IV',ã 'V', 'VI', 'VII', 'VIII', 'IX');ãã Tenz : star_10 = ('', 'X', 'XX', 'XXX', 'XL',ã 'L', 'LX', 'LXX', 'LXXX', 'XC');ãã Hunz : star_10 = ('', 'C', 'CC', 'CCC', 'CD',ã 'D', 'DC', 'DCC', 'DCCC', 'CM');ãã Thouz : star_4 = ('', 'M', 'MM', 'MMM');ãããFunction Dec2Roman(wo_in : Word) : st_15;ãbeginã Dec2Roman := Thouz[(wo_in div 1000)] +ã Hunz[((wo_in mod 1000) div 100)] +ã Tenz[(((wo_in mod 1000) mod 100) div 10)] +ã Wunz[(((wo_in mod 1000) mod 100) mod 10)]ãend;ããVarã wo_Temp : Word;ããbeginã Writeln;ã Write(' Enter number to be converted to roman-numeral equivalent: ');ã readln(wo_Temp);ã if (wo_Temp > 3999) thenã wo_Temp := 3999;ã Writeln;ã Writeln(' Roman-numeral equivalent of ', wo_Temp, ' = ', Dec2Roman(wo_Temp))ãend.ãã 21 05-28-9313:53ALL SWAG SUPPORT TEAM SHLSHR.PAS IMPORT 24 ž85M { INFO ON SHR and SHL }ãã> (5 Shl 2) + 5 which is: (5 x 4) + 5ã> So, 10 * 10 would be (10 Shl 3) + (10 Shl 1)ããThis looks good but, can it be done With Variables (So I can useãnumbers other than 5 & 5)?ãã Yes, just keep in mind that each shift leftward Doubles the value...ãã p SHL 1 = p * 2ã p SHL 2 = p * 4ã p SHL 3 = p * 8ã p SHL 4 = p * 16ã ...ãã (likewise, each shift rightward halves the value).ãã Also keep in mind that the maximum amount you can shift is theã number of bits in the Variable. Bytes are 8 bits, Words andã Integers are 16 bits, and LongInts are 32 bits. if you shiftã a Variable its full bit size, or more, it will be 0 (zero).ãã For example: if p is a Byte, then p SHR 8 = 0.ãã{ Use Shr/Shl to multiply/divide, rather than the operatorsã How do you (or anybody) do this? For example, how would I do 5 * 5?ã}ã{*******************************************************************}ã Program DemoShifts;ã Var Number, Result : Word;ã beginã { Calculate 5 * 5, without using multiplication ... }ãã Number := 5; { original value }ã Result := Number SHL 2; { now Result = 4 * Number }ã Result := Result + Number; { 4*Number + Number = 5*Number }ãã WriteLn( '5 * 5 = ', Result ); { because seeing is believing }ãã end {DemoShifts}.ã{*******************************************************************}ãã But TP seems sometimes to do the 'shift vs. MUL optimization' itself,ã this being bad if Compiling For a 386/486 CPU.ã A "* 2" would always result in a SHL instruction ( unless Realã arithmetic was used ;-> ).ãã Ok, I understand that part. if x shr 4 = x/4 (and the remainder isã dropped) then I Really understand it. Does it? Do I?ããNo. x shl 0 = xã x shl 1 = x/(2^1) = x/2ã x shl 2 = x/(2^2) = x/4ã x shl 3 = x/(2^3) = x/8ã x shl 4 = x/(2^4) = x/16ããJust as:ã x shr 0 = xã x shr 1 = x*(2^1) = 2xã x shr 2 = x*(2^2) = 4xã x shr 3 = x*(2^3) = 8xã x shr 4 = x*(2^4) = 16xããSo now you can see how and why the Compiler substitutes a "shr 1" For "* 2".ãã > PD> So, 10 * 10 would be: (10 shl 3) + 20ã >ã > MC> not quite:ã > MC> (10 Shl 3)+(10 Shl 1)s, I'm back! (3:634/384.6)ã >ã > Why? wouldn't the second one take an additional instruction (shl)?ããWell yes, but 8086 instructions weren't created equal. PerForming twoãshifts and the add to combine them will (on a 286 or lesser) less timeãoverall than doing even one MUL.ããThe 386/486 has streamlined the MUL instruction so that it takes much lessãtime, and can often Compete With the shift/add approach. Which to use?ãWell, I'd stick With the shift/add approach, since if you're writing oneãProgram For both XTs and 386s, the XT will be acceptable, and so will theã386. Using the MUL; True, 386 perFormance will be better, but your XTãperFormance will suffer quite a bit.ã 22 05-28-9313:53ALL SWAG SUPPORT TEAM SWAPNUMS.PAS IMPORT 5 ž8B‰ {ã>Is there a way (using bit manipulations such as AND, OR, XOR) toã>swap to Variables without making a 3rd temporary Variable?ã>ããIf the two Variables are numbers, and the following operationsãwon't overflow the limitations of the Type, then yes, you canãdo it like this:ã}ãVarã A, B : Integer;ããbeginã A := 5;ã B := 3;ãã A := A + B;ã B := A - B;ã A := A - B;ãã { which isãã A := 5 + 3 (8)ã B := 8 - 3 (5)ã A := 8 - 5 (3)ãã A = 3ã B = 5 }ããend; 23 05-28-9313:53ALL SWAG SUPPORT TEAM TP6RAND.PAS IMPORT 12 ž8À {ãBorland changed the Random() algorithm between TP6 and TP/BP7. The Unitãbelow provides the TP6 Random Function in its Integer flavour. (TheãRandomize Procedure wasn't changed.)ãã{ * Turbo Pascal Runtime Library Version 6.0 * ;ã * Random Number Generator * ;ã * * ;ã * Copyright (C) 1988,92 Borland International * }ããUnit TP6Rand;ããInterfaceããFunction Random(Max: Integer): Integer;ããImplementationããConstã { Scaling Constant}ã ConstM31 = LongInt(-31);ã { Multiplication factor}ã Factor: Word = $8405;ãããFunction NextRand: LongInt; Assembler;ã{ã Compute next random numberã New := 8088405H * Old + 1ã Out DX:AX = Next random numberã}ãAsmã MOV AX,RandSeed.Word[0]ã MOV BX,RandSeed.Word[2]ã MOV CX,AXã MUL Factor.Word[0] { New = Old.w0 * 8405H }ã SHL CX,1 { New.w2 += Old.w0 * 808H }ã SHL CX,1ã SHL CX,1ã ADD CH,CLã ADD DX,CXã ADD DX,BX { New.w2 += Old.w2 * 8405H }ã SHL BX,1ã SHL BX,1ã ADD DX,BXã ADD DH,BLã MOV CL,5ã SHL BX,CLã ADD DH,BLã ADD AX,1 { New += 1 }ã ADC DX,0ã MOV RandSeed.Word[0],AXã MOV RandSeed.Word[2],DXãend;ããFunction Random(Max: Integer): Integer; Assembler;ãAsmã CALL NextRandã xor AX,AXã MOV BX,Max.Word[0]ã or BX,BXã JE @@1ã XCHG AX,DXã div BXã XCHG AX,DXã@@1:ãend;ããend.ã 24 05-28-9313:53ALL SWAG SUPPORT TEAM WORD2HEX.PAS IMPORT 67 ž8ŠÔ {ã> How does the following Function make a Word into Hex:ãã - Dissection:ã}ããTypeã Str4 : String[4];ããFunction WordtoHex(W : Word) : St4ãVarã HexStr : St4;ãã Function Translate(B : Byte) : Char;ãã { This Function takes a number from 0 to 15 and makes it into a hex digit.}ãã beginã if B < 10 thenã { if it's 0..9 }ã Translate := Chr(B + 48)ã { These statements use math on Characters... ascii 48 is '0'.ã Could have been written: Translate := Chr(B + ord('0')) }ã elseã Translate := Chr(B + 55);ã { This one is For letters A~F. ascii 55 isn't anything, but if you addã $A (10) to 55 you get 65, which is the ascii code For 'A'ã This could have been written: Translate := Chr(B + ord('A')-$A); }ã end;ããbeginã HexStr := ' ';ã HexStr := HexStr + Translate(Hi(W) shr 4);ã { Hi(W) takes the high Byte of Word W.ã shr 4 means the same as divide by 16...ã What they're Really doing here is taking each nibble of the hex Wordã and isolating it, translating it to hex, and adding it to the String. }ã HexStr := HexStr + Translate(Hi(W) and 15);ã HexStr := HexStr + Translate(Lo(W) shr 4);ã HexStr := HexStr + Translate(Lo(W) and 15);ã WordtoHex := HexStr;ãend;ã{ã> I am learning Pascal and don't understand something. Howã> does the following Function make a Word into Hex:ããIt doesn't, at least not as present! But if you changes two things, maybeãspelling-errors, it will work. This is a bit hard to explain and grasp, becauseãit involves operations at a less abstract level than the one that you usuallyãwork on in TP. Remember, when a number is stored in memory, it's stored binary,ãhexadecimal notion is just For making it easier For man to read. I don't knowãif you know how to Write and read binary- and hexadecimal-numbers, in Case youãdon't know it's all here...ããOn PC, a Word, in the range 0 to 65535, has 16 bits. A Word written in binaryãnotion For this reason contains 16 digits, 0's or 1's! But a Word written inãhexadecimal notion contains 4 digits. Simple math tells us that one digit inãhex-notion is equal to four digits binary. Four digits binary gives 16ãcombinations (2^4). ThereFore, each hexadecimal digit must be able to containãvalues from decimal 0-decimal 15, _in one digit_! Our normal digits, 0-9, isn'tãsufficient For this, we must use 6 other digits. The designers of this systemãchoosed A-F as the extra digits. This means, in hex the digits are 0, 1, 2, 3,ã4, 5, 6, 7, 8, 9, A, B, C, D, E and F. Hanging on?ãã> Function WordtoHex(W : Word) : St4ããCompile-time error: You must have a semicolon after the Function header-line.ãã> Varã> HexStr : St4;ãã> Function Translate(B : Byte) : Char;ã> beginã> if B < 10ã> thenã> Translate := Chr(B + 48)ã> elseã> Translate := Chr(B + 55);ã> end;ããThis is clearer as:ãã if b < 10ã then Translate := Chr(b+ord('0'))ã else Translate := Chr(b+ord('A')-10);ããThink about the first Case, when b < 10, if b were 0, the expression would beã'0' plus 0, '0'!. if b were 1, it's '0' plus 1, '1'!. This works because in theãASCII-table the numbers are sequential ordered. But '0' plus 10 would be ':',ãbecause it happens to be after the numbers.ããthen, when we want 'A'-'F, we would need to start from 'A'. But we can't add 10ãto 'A' For getting 'A' and 11 For getting 'B' and that like. First we must makeãthe value relative 'A'. Because the values that we're working on here is in theãrange 10 to 15, we can decrease it With 10 and get 0 to 5. then is OK to useãthem relative 'A'. As beFore, 'A' plus 0 is 'A', 'A' plus 1 is 'B', and so on.ããHowever, this routine has no safety check, it will gladly return 'G' For 16,ãbecause 'A'+6 is 'G'. It doesn't care if the value is within hexadecimal rangeãor not (numbers bigger than 15 can't be turned into one hex digit, they needãmore digits). But here it's OK, because the routine is local to WordtoHex thatãwill never pass anything else than 0 to 15.ãã> beginã> HexStr := ' ';ããLogical error: You must initalize HexStr to an empty String, '', if not it willãconsist of a space and three hex digits, not four. A hex-Word String isãComposed of four hexadeciamal-digits. Because you have declared the String as aãVariable of the Type St4 and St4 only allows four Chars, exactly what is neededãFor a hexWord-String, the last one added will be discarded if you have a spaceãat the beginning, filling up one position.ãã> HexStr := HexStr + Translate(Hi(W) shr 4);ã> HexStr := HexStr + Translate(Hi(W) and 15);ã> HexStr := HexStr + Translate(Lo(W) shr 4);ã> HexStr := HexStr + Translate(Lo(W) and 15);ã> WordtoHex := HexStr;ã> end;ããIt would be easier to read if the 'and'-value were in hex-notation, $000F. Seeãbelow For explanation why. However, this part requires some understanding ofãthe bits. It's probably best show With an example. Let's say, our number W isã$1234.ãã$1234 is written 0001 0010 0011 0100 in binary. Each hex-digit corresponds to aãfour-group binary digits.ããþ) The binary number 0001 is 0*(2^3) + 0*(2^2) + 0*(2^1) + 1*(2^0). It givesã0+0+0+1=1 in decimal.ããþ) The binary number 0101 is 0*(2^3) + 1*(2^2) + 0*(2^1) + 1*(2^0). It givesã0+4+0+1=5 in decimal.ããþ The _decimal_ number 1101 is 1*(10^3) + 1*(10^2) + 0*(10^1) + 1*(10^0). Itãgives 1000+100+0+1=1011! As you can see, the only difference between theãdecimal and the binary and the hexadecimal system is the base-power. True, theãhex-system Uses strange digits For us used to decimal, but For the ones used toãbinary, 2-9 is equally strange...ããLike our decimal system, in hex and binary, it's unnescessary to includeãleading zeros, i. e. $0001 = $1 (of course you can't remove trailing zeroes,ãdecimal 1000 certainly isn't equal to decimal 1...). But you will note that Iãsometimes include these leading zeroes, just because it looks good (?). andãwriting binary number 1000 0000 is like writing 10000 in decimal as 10,000;ãit's only For easy reading, but the Compiler won't allow it.ããHowever, I hope you grasp a least something of my extremly bad explanation :-(,ãor maybe you know it beFore?! Now, let's look at the things that happens whenãthe above statements are executed and w = $1234 (0001 0010 0011 0100).ããHi returns the upper 8 bits of the Word, in this Case 0001 0010; Lo returns theãlower bits (!), 0011 0100. The above code Uses 'and' and 'shr', a breifãexplanation of them will probably be nescessary (oh no :-)).ããþ and, when not used as a Boolean operator, Uses two binary numbers and, Forãeach bit, tests them. if _both_ bits are set (equal to 1) the resuling bit isãset to 1, if any or both of them is cleared (equal to 0) the result is 0. Thisãmeans:ããã 0001 0010 Hi(w) 0011 0100 Lo(w)ã 0000 1111 and With 15 or $000F 0000 1111 and With 15 or $000Fã --------- ---------ã 0000 0010 0010 binary = 2 hex 0000 0100 0100 binary = 4 hexããThis was the second and first statement, and out you get the second and firstãnumber! When we pass them to Translate, we get back '2' and '4'.ããþ shr, only For binary operations, shifts the bits to the right. The bits thatãpasses over the right side is lost, and the ones that move on left side isãreplaced by zeroes. The bits shifts as many times as the value after theãshr-keyWord, here 4 times. Like this:ãã 00010010 Hi(w) 00110100 Lo(w)ã -------- shr 4 --------ã 00001001 after one shift 00011010ã 00000100 after two shifts 00001101ã 00000010 after three shifts 00000110ã 00000001 after four shifts 00000011ããNow we got binary 0001 and binary 0011, in hex $1 and $3. The first and thirdãstatement, and the first and third number! The String to return is digit1 +ãdigit2 + digit3 + digit4, exactly what we want.ããHmm... Now I haven't told you anything about the binary or, xor, not andãshl-keyWords... But I think this message is quiet long as it is, without that.ãBut if you want more info or a better explanation, only drop me a msg here.ããHappy hacking /Jake 930225 17.35 (started writing last night)ãPS. There may be some errors, I haven't proof-read the Text or my math. then,ãplease correct me, anybody.ã} 25 08-27-9320:03ALL SEAN PALMER Handling Numbers in ASM IMPORT 9 ž8H { SEAN PALMERããI've been playing around with the AAM instruction and came up with someãthings you guys might find useful...ããStrings as function results are WIERD with the inline Assembler. 8)ã}ããfunction div10(b : byte) : byte; assembler;ãasmã mov al, bã aamã mov al, ahãend;ããfunction mod10(b : byte) : byte; assembler;ãasmã mov al, bã aamãend;ããtypeã str2 = string[2];ã str8 = string[8];ããfunction toStr2(b : byte) : str2; assembler;ãasm {only call with b=0~99}ã les di, @RESULTã cldã mov al, 2ã stosbã mov al, bã aamã xchg ah, alã add ax, $3030ã stoswãend;ãã{makes date string in MM/DD/YY format from m,d,y}ãfunction toDateStr(m,d,y:byte):str8;assembler;asm {only call with m,d,y=0~99}ã les di, @RESULTã cldã mov al, 8ã stosbã mov al, mã aamã xchg ah, alã add ax, $3030ã stoswã mov al, '/'ã stosbã mov al, dã aamã xchg ah, alã add ax, $3030ã stoswã mov al, '/'ã stosbã mov al, yã aamã xchg ah, alã add ax, $3030ã stoswãend;ããã 26 08-27-9321:39ALL TREVOR CARLSON MS to IEEE Numbers IMPORT 9 ž8UÈ {ãTrevor Carlsonãã> Does anyone have source examples of how to convert an MSBIN to aã> LongInt Type Variable?ã}ããTypeã MKS = Array [0..3] of Byte;ããFunction MStoIEEE(Var MS) : Real;ã{ Converts a 4 Byte Microsoft format single precision Real Variable asã used in earlier versions of QuickBASIC and GW-BASIC to IEEE 6 Byte Real }ãVarã m : MKS Absolute MS;ã r : Real;ã ieee : Array [0..5] of Byte Absolute r;ãbeginã FillChar(r, sizeof(r), 0);ã ieee[0] := m[3];ã ieee[3] := m[0];ã ieee[4] := m[1];ã ieee[5] := m[2];ã MStoieee := r;ãend; { MStoIEEE }ãããFunction IEEEtoMS(ie : Real) : LongInt;ã{ LongInt Type used only For convenience of Typecasting. Note that this willã only be effective where the accuracy required can be obtained in the 23ã bits that are available With the MKS Type. }ãVarã ms : MKS;ã ieee : Array [0..5] of Byte Absolute ie;ãbeginã ms[3] := ieee[0];ã ms[0] := ieee[3];ã ms[1] := ieee[4];ã ms[2] := ieee[5];ã IEEEtoMS := LongInt(ms);ãend; { IEEEtoMS }ã 27 09-26-9309:31ALL MARTIN RICHARDSON Get HIGH order of WORD IMPORT 7 ž8"ã {*****************************************************************************ã * Function ...... wHi()ã * Purpose ....... Return the High order word from a longint (double word)ã * Parameters .... n LONGINT to retrieve high word fromã * Returns ....... High word from nã * Notes ......... HI only returns the HIgh byte from a word. I neededã * something that returned the high WORD from a LONGINT.ã * Author ........ Martin Richardsonã * Date .......... October 9, 1992ã *****************************************************************************}ãFUNCTION wHi( n: LONGINT ): WORD; ASSEMBLER;ãASMã MOV AX, WORD PTR n[2]ãEND;ãã 28 09-26-9309:31ALL MARTIN RICHARDSON Get Low Order of WORD IMPORT 7 ž8"ã {*****************************************************************************ã * Function ...... wLo()ã * Purpose ....... Return the low order word from a longint (double word)ã * Parameters .... n LONGINT to retrieve low word fromã * Returns ....... Low word from nã * Notes ......... LO only returns the LOw byte from a word. I neededã * something that returned the low WORD from a LONGINT.ã * Author ........ Martin Richardsonã * Date .......... October 9, 1992ã *****************************************************************************}ãFUNCTION wLo( n: LONGINT ): WORD; ASSEMBLER;ãASMã MOV AX, WORD PTR n[0]ãEND;ãã 29 09-26-9310:53ALL KENT BRIGGS Random Number Generator IMPORT 8 ž8P’ (*ãFrom: KENT BRIGGS Refer#: NONEãSubj: TP 7.0 RANDOM GENERATOR Conf: (1221) F-PASCALã*)ããconstã rseed: longint = 0;ããprocedure randomize67; {TP 6.0 & 7.0 seed generator}ãbeginã reg.ah:=$2c;ã msdos(reg); {get time: ch=hour,cl=min,dh=sec,dl=sec/100}ã rseed:=reg.dx;ã rseed:=(rseed shl 16) or reg.cx;ãend;ããfunction rand_word6(x: word): word; {TP 6.0 RNG: word}ãbeginã rseed:=rseed*134775813+1;ã rand_word6:=(rseed shr 16) mod x;ãend;ããfunction rand_word7(x: word): word; {TP 7.0 RNG: word}ãbeginã rseed:=rseed*134775813+1;ã rand_word7:=((rseed shr 16)*x+((rseed and $ffff)*x shr 16)) shr 16;ãend;ããfunction rand_real67: real; {TP 6.0 & 7.0 RNG: real}ãbeginã rseed:=rseed*134775813+1;ã if rseed<0 then rand_real67:=rseed/4294967296.0+1.0 elseã rand_real67:=rseed/4294967296.0;ãend;ã 30 10-28-9311:31ALL J.P. RITCHEY MSBIN to IEEE IMPORT 70 ž8±ì {===========================================================================ãDate: 10-09-93 (23:23)ãFrom: J.P. RitcheyãSubj: MSBIN to IEEEã---------------------------------------------------------------------------ãGE> Does anyone have any code for Converting MSBIN formatãGE> numbers into IEEE? }ãã{$A-,B-,D-,E+,F-,I-,L-,N+,O-,R-,S-,V-}ãunit BFLOAT;ã(*ã MicroSoft Binary Float to IEEE format Conversionã Copyright (c) 1989 J.P. Ritcheyã Version 1.0ãã This software is released to the public domain. Thoughã tested, there could be some errors. Any reports of bugsã discovered would be appreciated. Send reports toã Pat Ritchey Compuserve ID 72537,2420ã*)ãinterfaceããtypeã bfloat4 = recordã { M'Soft single precision }ã mantissa : array[5..7] of byte;ã exponent : byte;ã end;ãã Bfloat8 = recordã { M'Soft double precision }ã mantissa : array[1..7] of byte;ã exponent : byte;ã end;ãããFunction Bfloat4toExtended(d : bfloat4) : extended;ãFunction Bfloat8toExtended(d : Bfloat8): extended;ãã{ These routines will convert a MicroSoft Binary Floating pointã number to IEEE extended format. The extended is large enoughã to store any M'Soft single or double number, so no over/underflowã problems are encountered. The Mantissa of an extended is large enoughã to hold a BFloatx mantissa, so no truncation is required.ãã The result can be returned to TP single and double variables andã TP will handle the conversion. Note that Over/Underflow can occurã with these types. }ããFunction HexExt(ep:extended) : string;ãã{ A routine to return the hex representation of an IEEE extended variableã Left in from debugging, you may find it useful }ããFunction ExtendedtoBfloat4(ep : extended; var b : bfloat4) : boolean;ãFunction ExtendedtoBfloat8(ep : extended; var b : Bfloat8) : boolean;ãã{ These routines are the reverse of the above, that is they convertã TP extended => M'Soft format. You can use TP singles and doublesã as the first parameter and TP will do the conversion to extendedã for you.ãã The Function result returns True if the conversion was succesful,ã and False if not (because of overflow).ãã Since an extended can have an exponent that will not fitã in the M'Soft format Over/Underflow is handled in the followingã manner:ã Overflow: Set the Bfloatx to 0 and return a False result.ã Underflow: Set the BFloatx to 0 and return a True Result.ãã No rounding is done on the mantissa. It is simply truncated toã fit. }ãããFunction BFloat4toReal(b:bfloat4) : Real;ãFunction BFloat8toReal(b:bfloat8) : Real;ãã{ These routines will convert a MicroSoft Binary Floating pointã number to Turbo real format. The real is large enoughã to store any M'Soft single or double Exponent, so no over/underflowã problems are encountered. The Mantissa of an real is large enoughã to hold a BFloat4 mantissa, so no truncation is required. Theã BFloat8 mantissa is truncated (from 7 bytes to 5 bytes) }ããFunction RealtoBFloat4(rp: real; var b:bfloat4) : Boolean;ãFunction RealtoBFloat8(rp : real; var b:bfloat8) : Boolean;ãã{ These routines do the reverse of the above. No Over/Underflow canã occur, but truncation of the mantissa can occurã when converting Real to Bfloat4 (5 bytes to 3 bytes).ãã The function always returns True, and is structured this way toã function similar to the IEEE formats }ããimplementationãtypeã IEEEExtended = recordã Case integer ofã 0 : (Mantissa : array[0..7] of byte;ã Exponent : word);ã 1 : (e : extended);ã end;ãã TurboReal = recordã Case integer ofã 0 : (Exponent : byte;ã Mantissa : array[3..7] of byte);ã 1 : (r : real);ã end;ããFunction HexExt(ep:extended) : string;ãvarã e : IEEEExtended absolute ep;ã i : integer;ã s : string;ã Function Hex(b:byte) : string;ã const hc : array[0..15] of char = '0123456789ABCDEF';ã beginã Hex := hc[b shr 4]+hc[b and 15];ã end;ãbeginã s := hex(hi(e.exponent))+hex(lo(e.exponent))+' ';ã for i := 7 downto 0 do s := s+hex(e.mantissa[i]);ãHexExt := s;ãend;ããFunction NullMantissa(e : IEEEextended) : boolean;ãvarã i : integer;ãbeginãNullMantissa := False;ãfor i := 0 to 7 do if e.mantissa[i] <> 0 then exit;ãNullMantissa := true;ãend;ããProcedure ShiftLeftMantissa(var e);ã{ A routine to shift the 8 byte mantissa left one bit }ãinline(ã{0101} $F8/ { CLC }ã{0102} $5F/ { POP DI }ã{0103} $07/ { POP ES }ã{0104} $B9/$04/$00/ { MOV CX,0004 }ã{0107} $26/$D1/$15/ { RCL Word Ptr ES:[DI],1 }ã{010A} $47/ { INC DI }ã{010B} $47/ { INC DI }ã{010C} $E2/$F9 { LOOP 0107 }ã);ããProcedure Normalize(var e : IEEEextended);ã{ Normalize takes an extended and insures that the "i" bit isã set to 1 since M'Soft assumes a 1 is there. An extended hasã a value of 0.0 if the mantissa is zero, so the first check.ã The exponent also has to be kept from wrapping from 0 to $FFFFã so the "if e.exponent = 0" check. If it gets this smallã for the routines that call it, there would be underflow and 0ã would be returned.ã}ãvarã exp : word;ããbeginãexp := e.exponent and $7FFF; { mask out sign }ãif NullMantissa(e) thenã beginã E.exponent := 0;ã exitã end;ãwhile e.mantissa[7] < 128 doã beginã ShiftLeftMantissa(e);ã dec(exp);ã if exp = 0 then exit;ã end;ãe.exponent := (e.exponent and $8000) or exp; { restore sign }ãend;ããFunction Bfloat8toExtended(d : Bfloat8) : extended;ãvarã i : integer;ã e : IEEEExtended;ãbeginã fillchar(e,sizeof(e),0);ã Bfloat8toExtended := 0.0;ã if d.exponent = 0 then exit;ã { if the bfloat exponent is 0 the mantissa is ignored andã the value reurned is 0.0 }ã e.exponent := d.exponent - 129 + 16383;ã { bfloat is biased by 129, extended by 16383ã This creates the correct exponent }ã if d.mantissa[7] > 127 thenã { if the sign bit in bfloat is 1 then set the sign bit in the extended }ã e.exponent := e.exponent or $8000;ã move(d.Mantissa[1],e.mantissa[1],6);ã e.mantissa[7] := $80 or (d.mantissa[7] and $7F);ã { bfloat assumes 1.fffffff, so supply it for extended }ã Bfloat8toExtended := e.e;ãend;ããFunction Bfloat4toExtended(d : bfloat4) : extended;ãvarã i : integer;ã e : IEEEExtended;ãbeginã fillchar(e,sizeof(e),0);ã Bfloat4toExtended := 0.0;ã if d.exponent = 0 then exit;ã e.exponent := integer(d.exponent - 129) + 16383;ã if d.mantissa[7] > 127 thenã e.exponent := e.exponent or $8000;ã move(d.Mantissa[5],e.mantissa[5],2);ã e.mantissa[7] := $80 or (d.mantissa[7] and $7F);ã Bfloat4toExtended := e.e;ãend;ããFunction ExtendedtoBfloat8(ep : extended; var b : Bfloat8) : boolean;ãvarã e : IEEEextended absolute ep;ã exp : integer;ã sign : byte;ãbeginãFillChar(b,Sizeof(b),0);ãExtendedtoBfloat8 := true; { assume success }ãNormalize(e);ãif e.exponent = 0 then exit;ãsign := byte(e.exponent > 32767) shl 7;ãexp := (e.exponent and $7FFF) - 16383 + 129;ãif exp < 0 then exp := 0; { underflow }ãif exp > 255 then { overflow }ã beginã ExtendedtoBfloat8 := false;ã exit;ã end;ãb.exponent := exp;ãmove(e.mantissa[1],b.mantissa[1],7);ãb.mantissa[7] := (b.mantissa[7] and $7F) or sign;ãend;ããFunction ExtendedtoBfloat4(ep : extended; var b : Bfloat4) : boolean;ãvarã e : IEEEextended absolute ep;ã exp : integer;ã sign : byte;ãbeginãFillChar(b,Sizeof(b),0);ãExtendedtoBfloat4 := true; { assume success }ãNormalize(e);ãif e.exponent = 0 then exit;ãsign := byte(e.exponent > 32767) shl 7;ãexp := (e.exponent and $7FFF) - 16383 + 129;ãif exp < 0 then exp := 0; { underflow }ãif exp > 255 then { overflow }ã beginã ExtendedtoBfloat4 := false;ã exit;ã end;ãb.exponent := exp;ãmove(e.mantissa[5],b.mantissa[5],3);ãb.mantissa[7] := (b.mantissa[7] and $7F) or sign;ãend;ããFunction BFloat4toReal(b:bfloat4) : Real;ãvarã r : TurboReal;ãbeginã fillchar(r,sizeof(r),0);ã r.exponent := b.exponent;ã move(b.mantissa[5],r.mantissa[5],3);ã Bfloat4toReal := r.r;ãend;ããFunction BFloat8toReal(b:bfloat8) : Real;ãvarã r : TurboReal;ãbeginã fillchar(r,sizeof(r),0);ã r.exponent := b.exponent;ã move(b.mantissa[3],r.mantissa[3],5);ã Bfloat8toReal := r.r;ãend;ããFunction RealtoBFloat4(rp: real; var b:bfloat4) : Boolean;ãvarã r : TurboReal absolute rp;ãbeginã fillchar(b,sizeof(b),0);ã b.exponent := r.exponent;ã move(r.mantissa[5],b.mantissa[5],3);ã RealtoBfloat4 := true;ãend;ããFunction RealtoBFloat8(rp : real; var b:bfloat8) : Boolean;ãvarã r : TurboReal absolute rp;ãbeginã fillchar(b,sizeof(b),0);ã b.exponent := r.exponent;ã move(r.mantissa[3],b.mantissa[3],5);ã RealtoBfloat8 := true;ãend;ããend.ã 31 10-28-9311:32ALL GREG VIGNEAULT Verify ISBN Numbers IMPORT 17 ž8„ {===========================================================================ãDate: 09-22-93 (20:14)ãFrom: GREG VIGNEAULTãSubj: Pascal ISBN verificationãã Here's a snippet of TP code for the free SWAG archives. It verifiesã ISBN numbers, via the embedded checksum ... }ãã(********************************************************************)ã(* Turbo/Quick/StonyBrook Pascal source file: ISBN.PAS v1.0 GSV *)ã(* Verify any International Standard Book Number (ISBN) ... *)ããPROGRAM checkISBN;ããCONST TAB = #9; { ASCII horizontal tab }ã LF = #10; { ASCII line feed }ããVAR ISBNstr : STRING[16];ã loopc, ISBNlen, M, chksm : BYTE;ããBEGIN {checkISBN}ãã WriteLn (LF,TAB,'ISBN Check v1.0 Copyright 1993 Greg Vigneault',LF);ãã IF ( ParamCount <> 1 ) THEN BEGIN { we want just one input parm }ã WriteLn ( TAB, 'Usage: ISBN ', LF );ã Halt(1);ã END; {IF}ãã ISBNstr := ParamStr (1); { get the ISBN number }ã Write ( TAB, 'Checking ISBN# ', ISBNstr, ' ...' );ã { eliminate any non-digit characters from the ISBN string... }ã ISBNlen := 0;ã FOR loopc := 1 TO ORD ( ISBNstr[0] ) DOã IF ( ISBNstr[ loopc ] IN ['0'..'9'] ) THEN BEGINã INC ( ISBNlen );ã ISBNstr[ ISBNlen ] := ISBNstr[ loopc ];ã END; {IF & FOR}ã { an 'X' at the end of the ISBN affects the result... }ã IF ( ISBNstr[ ORD ( ISBNstr[0] ) ] IN ['X','x'] ) THENã M := 10ã ELSEã M := ORD ( ISBNstr[ ISBNlen ] ) - 48;ã ISBNstr[0] := CHR ( ISBNlen ); { new ISBN string length }ã WriteLn ( 'reduced ISBN = ', ISBNstr ); WriteLn;ã chksm := 0; { initialize checksum }ã FOR loopc := 1 TO ISBNlen-1 DOã INC (chksm, ( ORD ( ISBNstr[ loopc ] ) - 48 ) * loopc );ã Write ( TAB, 'ISBN ' );ã IF ( ( chksm MOD 11 ) = M ) THENã WriteLn ( 'is okay.' )ã ELSEã WriteLn ( 'error!',#7 );ããEND {checkISBN}. (* Not for commercial retail. *)ã 32 11-02-9305:00ALL CHRIS QUARTETTI Setting/Getting BITS IMPORT 21 ž8· {ãCHRIS QUARTETTIãã>Is there an easy way to create a 1-bit or 2-bit data structure. Forã>example, a 2-bit Type that can hold 4 possible values. For that matter,ã>is there a hard way? Thanks very much -Gregãã I suppose this would qualify For the hard way-- not too flexible, but itãworks. It would be a bit easier to do this if you wanted a bunch of the sameãsize Variables (ie 4 4 bit Variables, or an Array of 4*x 4 bit Variables).ãFWIW I used BP7 here, but TP6 and up will work. Also, it need not be Objectãoriented.ã}ããTypeã bitf = Object { split 'bits' into bitfields }ã bits : Word; { 16 bits total }ãã Function get : Word;ãã Procedure set1(value : Word); { this will be 2 bits }ã Function get1 : Word;ãã Procedure set2(value : Word); { this will be 13 bits }ã Function get2 : Word;ãã Procedure set3(value : Word); { this will be 1 bit }ã Function get3 : Word;ã end;ããFunction bitf.get : Word;ãbeginã get := bits;ãend;ããProcedure bitf.set1(value : Word);ã{ Set the value of the first bitfield }ãConstã valmask : Word = $C000; { 11000000 00000000 }ã bitsmask : Word = $3FFF; { 00111111 11111111 }ãbeginã value := value shl 14 and valmask;ã bits := value + (bits and bitsmask);ãend;ããFunction bitf.get1 : Word;ã{ Get the value of the first bitfield }ãbeginã get1 := bits shr 14;ãend;ããProcedure bitf.set2(value : Word);ã{ Set the value of the second bitfield }ãConstã valmask : Word = $3FFE; { 00111111 11111110 }ã bitsmask : Word = $C001; { 11000000 00000001 }ãbeginã value := (value shl 1) and valmask;ã bits := value + (bits and bitsmask);ãend;ããFunction bitf.get2 : Word;ã{ Get the value of the second bitfield }ãConstã valmask : Word = $3FFE; { 00111111 11111110 }ãbeginã get2 := (bits and valmask) shr 1;ãend;ããProcedure bitf.set3(value : Word);ã{ Set the value of the third bitfield }ãConstã valmask : Word = $0001; { 00000000 00000001 }ã bitsmask : Word = $FFFE; { 11111111 11111110 }ãbeginã value := value and valmask;ã bits := value + (bits and bitsmask);ãend;ããFunction bitf.get3 : Word;ã{ Get the value of the third bitfield }ãConstã valmask : Word = $0001; { 00000000 00000001 }ãbeginã get3 := bits and valmask;ãend;ããVarã x : bitf;ããbeginã x.set1(3); { set all to maximum values }ã x.set2(8191);ã x.set3(1);ã Writeln(x.get1, ', ', x.get2, ', ', x.get3, ', ', x.get);ãend.ã 33 11-02-9305:01ALL ROBERT ROTHENBURG More Get/Set Bits IMPORT 21 ž8Uõ {ãRobert RothenburgããHere's some routines I wrote while playing around with some compressionãalgorithms. Since they're written in Pascal, they're probably not tooãfast but they work.ãããOf course they're need some tweaking.ã}ã(* NoFrills Bit-Input/Output Routines *)ã(* Insert "n" bits of data into a Buffer or Pull "n" bits of *)ã(* data from a buffer. Useful for Compression routines *)ãããunit BitIO;ããinterfaceããconstã BufferSize = 32767; (* Adjust as appropriate *)ããtypeã Buffer = array [0..BufferSize] of byte;ã BufPtr = ^Buffer;ã BuffRec = record (* This was used for I/O by some *)ã Block : BufPtr; (* other units involved with the *)ã Size, (* compression stuff. Not so *)ã Ptr : word; (* Important? *)ã Loc : byteã end;ããvarã InBuffer,ã OutBuffer : BuffRec;ã InFile,ã OutFile : file;ããprocedure InitBuffer(var x : BuffRec); (* Initialize a buffer *)ãprocedure GetBits(var b : word; num : byte); (* Get num bits from *)ã (* InBuffer *)ãprocedure PutBits(b : word; num : byte); (* Put num bits into *)ã (* OutBuffer *)ãfunction Log2(x : word) : byte; (* Self-explanatory... *)ããimplementationããconstã Power : array [1..17] of longint =ã (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536);ããprocedure InitBuffer(var x : BuffRec);ãbeginã with x doã beginã Loc := 8;ã Ptr := 0;ã Size := 0;ã New(Block);ã FillChar(Block^, BufferSize, #0);ã end;ãend;ããprocedure GetBits(var b : word; num : byte);ãvarã Size : word;ãbeginã with InBuffer doã beginã b := 0;ã repeatã b := (b SHL 1);ã if (Block^[Ptr] AND Power[Loc]) <> 0 thenã b := b OR 1;ã dec(Loc);ã if Loc = 0 thenã beginã Loc := 8;ã inc(Ptr);ã end;ã dec(num);ã until (num = 0);ã end;ãend;ããprocedure PutBits(b : word; num : byte);ãvarã i : byte;ãbeginã with OutBuffer doã repeatã if Loc = 0 thenã beginã inc(Ptr);ã Loc := 8;ã end;ã if (b AND Power[num]) <> 0 thenã beginã Block^[Ptr] := Block^[Ptr] OR Power[Loc];ã dec(Loc);ã endã elseã dec(Loc);ã dec(num)ã until num = 0;ã OutBuffer.Size := succ(OutBuffer.Ptr);ãend;ããfunction Log2(x : word) : byte;ãvarã i : byte;ãbeginã i := 17;ã while xdoes andbody know an easy way to convert a Byte value from it's Integerã> notation to hex notatation?ããWell, thank you For this message. It finally got me off my keister (sp?) toãWrite a "decimal-to-hex" converter -- a project I'd been meaning to do, butãnever got around to. (Technically, since I was in a seated position, Iãremained on my keister the whole time, but you know what I mean). Actually,ãthe following is not just "decimal-to-hex" -- it's decimal-to-any-base-from-ã2-to-36-converter (because base 1 and below doesn't make sense, and afterãbase 36 I run out of alphabet to represent "digits"). Here is NUBASE:ã}ãããFunction nubase(numin : LongInt; base, numplaces : Byte) : String;ãVarã tmpstr : String;ã remainder : Byte;ã negatize : Boolean;ãbeginã negatize := (numin < 0); { Record if it's a negative number }ã if negatize thenã numin := abs(numin); { convert to positive For calcs }ã tmpstr[0] := Char(numplaces); { set length of the output String }ãã While numplaces > 0 doã begin { Loop: fills each space in String }ã remainder := numin mod base; { get next "digit" (under new base) }ã if remainder > 9 thenã tmpstr[numplaces] := Char(remainder + 64 - 9) { convert to letter }ã elseã tmpstr[numplaces] := Char(remainder + 48); { use number as is }ã numin := numin div base; { reduce dividend For next "pass" }ã numplaces := numplaces - 1; { go to "next" position in String }ã end; { end of loop }ãã { The following: if we've run out of room on the String, or if it's aã negative number and there's not enough space For the "minus" sign,ã convert the output String to all asterisks. }ãã if (numin <> 0) or (negatize and (tmpstr[1] <> '0')) thenã For numplaces := 1 to Byte(tmpstr[0]) doã tmpstr[numplaces] := '*';ãã { add minus sign }ãã if negatize and (tmpstr[1] = '0') thenã tmpstr[1] := '-';ãã nubase := tmpstr;ãend;ããã{ãFeed it the number to convert, the base to convert into, and the number ofãspaces you want For it. Leading zeros will be provided. Example: toãconvert 111 into hex (base 16) and give 4 digits of answer, you could say:ããWriteln(nubase(111, 16, 4))ããand it'd Write out:ãã006FããThis routine does handle negative numbers too. if you don't give it enoughã"space" in the third parameter you pass, it'll return all asterisks. Forãlaughs, try converting the number 111 into base 10 and giving it 5 digitsãof answer. You'll get:ãã00111 (predictably enough)ã} 35 11-02-9305:52ALL GREG VIGNEAULT LongInt to HEX IMPORT 11 ž8†® {ãGREG VIGNEAULTãã> So to assign the File I will need the HEX in String format.ã}ããTypeã String8 = String[8];ããVarã MyStr : String8;ã ALong : LongInt;ãã{ convert a LongInt value to an 8-Character String, using hex digits }ã{ (using all 8 Chars will allow correct order in a sorted directory) }ããProcedure LongToHex(AnyLong : LongInt; Var HexString : String8);ãVarã ch : Char;ã Index : Byte;ãbeginã HexString := '00000000'; { default to zero }ã Index := Length(HexString); { String length }ã While AnyLong <> 0 doã begin { loop 'til done }ã ch := Chr(48 + Byte(AnyLong) and $0F); { 0..9 -> '0'..'9' }ã if ch > '9' thenã Inc(ch, 7); { 10..15 -> 'A'..'F'}ã HexString[Index] := ch; { insert Char }ã Dec(Index); { adjust chr Index }ã AnyLong := AnyLong SHR 4; { For next nibble }ã end;ãend;ããbeginã ALong := $12345678; { a LongInt value }ã LongToHex(ALong, MyStr); { convert to hex str}ã WriteLn;ã WriteLn('$', MyStr); { display the String}ã WriteLn;ãend.ã 36 11-21-9309:24ALL GREG VIGNEAULT Base Notation IMPORT 21 ž8tÇ ã{ How about a procedure that will display any integer in any baseã notation from 2 to 16? The following example displays the valuesã 0 through 15 in binary (base 2), octal (base 8), decimal (base 10)ã and hexadecimal (base 16) notations ... }ãã(********************************************************************)ãPROGRAM BaseX; (* compiler: Turbo Pascal v4.0+ *)ã (* Nov.14.93 Greg Vigneault *)ã(*------------------------------------------------------------------*)ã(* Display any INTEGER in any base notation from 2 to 16... *)ã(* *)ã(* number base 2 = binary notation (digits 0,1) *)ã(* number base 8 = octal notation (digits 0..7) *)ã(* number base 10 = decimal notation (digits 0..9) *)ã(* number base 16 = hexadecimal notation (digits 0..9,A..F) *)ããPROCEDURE DisplayInteger (AnyInteger :INTEGER; NumberBase :BYTE);ã CONST DataSize = 16; (* bit-size of an INTEGER *)ã VAR Index : INTEGER;ã Digit : ARRAY [1..DataSize] OF CHAR;ã BEGINã IF (NumberBase > 1) AND (NumberBase < 17) THEN BEGINã Index := 0;ã REPEATã INC (Index);ã Digit [Index] := CHR(AnyInteger MOD NumberBase + ORD('0'));ã IF (Digit [Index] > '9') THEN INC (Digit [Index],7);ã AnyInteger := AnyInteger DIV NumberBase;ã UNTIL (AnyInteger = 0) OR (Index = DataSize);ã WHILE (Index > 0) DO BEGINã Write (Digit [Index]);ã DEC (Index);ã END; {WHILE Index}ã END; {IF NumberBase}ã END {DisplayInteger};ãã(*------------------------------------------------------------------*)ã(* to test the DisplayInteger procedure... *)ããVAR Base, Number : INTEGER;ããBEGINã FOR Base := 2 TO 16 DOã CASE Base OFã 2,8,10,16 : BEGINã WriteLn;ã CASE Base OFã 2 : Write ('Binary : ');ã 8 : Write ('Octal : ');ã 10 : Write ('Decimal: ');ã 16 : Write ('Hex : ');ã END; {CASE}ã FOR Number := 0 TO 15 DO BEGINã DisplayInteger (Number, Base);ã Write (' ');ã END; {FOR}ã END;ã END; {CASE}ã WriteLn;ããEND {BaseX}.ã 37 11-21-9309:25ALL SWAG SUPPORT TEAM Bit Handler IMPORT 44 ž8Wp UNIT Bits;ã(**) INTERFACE (**)ãTYPEã bbit = 0..7;ã wbit = 0..15;ã lbit = 0..31;ãã PROCEDURE SetBitB(VAR B : Byte; bit : bbit);ã PROCEDURE ClearBitB(VAR B : Byte; bit : bbit);ã PROCEDURE ToggleBitB(VAR B : Byte; bit : bbit);ã FUNCTION BitSetB(B : Byte; bit : bbit) : Boolean;ã FUNCTION BitClearB(B : Byte; bit : bbit) : Boolean;ãã PROCEDURE SetBitW(VAR W : Word; bit : wbit);ã PROCEDURE ClearBitW(VAR W : Word; bit : wbit);ã PROCEDURE ToggleBitW(VAR W : Word; bit : wbit);ã FUNCTION BitSetW(W : Word; bit : wbit) : Boolean;ã FUNCTION BitClearW(W : Word; bit : wbit) : Boolean;ãã PROCEDURE SetBitL(VAR L : LongInt; bit : lbit);ã PROCEDURE ClearBitL(VAR L : LongInt; bit : lbit);ã PROCEDURE ToggleBitL(VAR L : LongInt; bit : lbit);ã FUNCTION BitSetL(L : LongInt; bit : lbit) : Boolean;ã FUNCTION BitClearL(L : LongInt; bit : lbit) : Boolean;ãã(**) IMPLEMENTATION (**)ã PROCEDURE SetBitB(VAR B : Byte; bit : bbit);ã Assembler;ã ASMã MOV CL, bitã MOV BL, 1ã SHL BL, CL {BL contains 2-to-the-bit}ã LES DI, Bã OR ES:[DI], BL {OR turns on bit}ã END;ãã PROCEDURE ClearBitB(VAR B : Byte; bit : bbit);ã Assembler;ã ASMã MOV CL, bitã MOV BL, 1ã SHL BL, CL {BL contains 2-to-the-bit}ã NOT BLã LES DI, Bã AND ES:[DI], BL {AND of NOT BL turns off bit}ã END;ãã PROCEDURE ToggleBitB(VAR B : Byte; bit : bbit);ã Assembler;ã ASMã MOV CL, bitã MOV BL, 1ã SHL BL, CL {BL contains 2-to-the-bit}ã LES DI, Bã XOR ES:[DI], BL {XOR toggles bit}ã END;ãã FUNCTION BitSetB(B : Byte; bit : bbit) : Boolean;ã Assembler;ã ASMã MOV CL, bitã MOV BL, 1ã SHL BL, CL {BL contains 2-to-the-bit}ã MOV AL, 0 {set result to FALSE}ã TEST B, BLã JZ @Noã INC AL {set result to TRUE}ã @No:ã END;ãã FUNCTION BitClearB(B : Byte; bit : bbit) : Boolean;ã Assembler;ã ASMã MOV CL, bitã MOV BL, 1ã SHL BL, CL {BL contains 2-to-the-bit}ã MOV AL, 0 {set result to FALSE}ã TEST B, BLã JNZ @Noã INC AL {set result to TRUE}ã @No:ã END;ãã PROCEDURE SetBitW(VAR W : Word; bit : wbit);ã Assembler;ã ASMã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã LES DI, Wã OR ES:[DI], BX {OR turns on bit}ã END;ãã PROCEDURE ClearBitW(VAR W : Word; bit : wbit);ã Assembler;ã ASMã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã NOT BXã LES DI, Wã AND ES:[DI], BX {AND of NOT BX turns off bit}ã END;ãã PROCEDURE ToggleBitW(VAR W : Word; bit : wbit);ã Assembler;ã ASMã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã LES DI, Wã XOR ES:[DI], BX {XOR toggles bit}ã END;ãã FUNCTION BitSetW(W : Word; bit : wbit) : Boolean;ã Assembler;ã ASMã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã MOV AL, 0 {set result to FALSE}ã TEST W, BXã JZ @Noã INC AL {set result to TRUE}ã @No:ã END;ãã FUNCTION BitClearW(W : Word; bit : wbit) : Boolean;ã Assembler;ã ASMã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã MOV AL, 0 {set result to FALSE}ã TEST W, BXã JNZ @Noã INC AL {set result to TRUE}ã @No:ã END;ãã PROCEDURE SetBitL(VAR L : LongInt; bit : lbit);ã Assembler;ã ASMã LES DI, Lã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã JZ @TopWord {if zero, use high word}ã OR ES:[DI], BX {OR turns on bit}ã JMP @Finishã @TopWord:ã SUB CL, 16ã MOV BX, 1ã SHL BX, CLã OR ES:[DI+2], BXã @Finish:ã END;ãã PROCEDURE ClearBitL(VAR L : LongInt; bit : lbit);ã Assembler;ã ASMã LES DI, Lã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã JZ @TopWord {if zero, use high word}ã NOT BXã AND ES:[DI], BX {AND of NOT BX turns off bit}ã JMP @Finishã @TopWord:ã SUB CL, 16ã MOV BX, 1ã SHL BX, CLã NOT BXã AND ES:[DI+2], BXã @Finish:ã END;ãã PROCEDURE ToggleBitL(VAR L : LongInt; bit : lbit);ã Assembler;ã ASMã LES DI, Lã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã JZ @TopWord {if zero, use high word}ã XOR ES:[DI], BX {XOR toggles bit}ã JMP @Finishã @TopWord:ã SUB CL, 16ã MOV BX, 1ã SHL BX, CLã XOR ES:[DI+2], BXã @Finish:ã END;ãã FUNCTION BitSetL(L : LongInt; bit : lbit) : Boolean;ã Assembler;ã ASMã MOV AL, 0 {set result to FALSE}ã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã JZ @TopWord {if zero, use high word}ã TEST Word(L), BXã JMP @Finishã @TopWord:ã SUB CL, 16ã MOV BX, 1ã SHL BX, CLã TEST Word(L+2), BXã @Finish:ã JZ @Noã INC AL {set result to TRUE}ã @No:ã END;ãã FUNCTION BitClearL(L : LongInt; bit : lbit) : Boolean;ã Assembler;ã ASMã MOV AL, 0 {set result to FALSE}ã MOV CL, bitã MOV BX, 1ã SHL BX, CL {BX contains 2-to-the-bit}ã JZ @TopWord {if zero, use high word}ã TEST Word(L), BXã JMP @Finishã @TopWord:ã SUB CL, 16ã MOV BX, 1ã SHL BX, CLã TEST Word(L+2), BXã @Finish:ã JNZ @Noã INC AL {set result to TRUE}ã @No:ã END;ãEND.ã 38 11-21-9309:36ALL SWAG SUPPORT TEAM HILO Bit Operators IMPORT 12 ž8”` UNIT HiLo;ã(**) INTERFACE (**)ã FUNCTION SwapN(B : Byte) : Byte;ã FUNCTION HiN(B : Byte) : Byte;ã FUNCTION LoN(B : Byte) : Byte;ãã FUNCTION SwapW(L : LongInt) : LongInt;ã FUNCTION HiW(L : LongInt) : Word;ã FUNCTION LoW(L : LongInt) : Word;ãã FUNCTION WordFromB(H, L : Byte) : Word;ã FUNCTION LongFromW(H, L : Word) : LongInt;ãã(**) IMPLEMENTATION (**)ã FUNCTION SwapN(B : Byte) : Byte; Assembler;ã ASMã MOV AL, B {byte in AL}ã MOV AH, AL {now in AH too}ã MOV CL, 4 {set up to shift by 4}ã SHL AL, CL {AL has low nibble -> high}ã SHR AH, CL {AH has high nibble -> low}ã ADD AL, AH {combine them}ã END;ãã FUNCTION HiN(B : Byte) : Byte; Assembler;ã ASMã MOV AL, Bã MOV CL, 4ã SHR AL, CLã END;ãã FUNCTION LoN(B : Byte) : Byte; Assembler;ã ASMã MOV AL, Bã AND AL, 0Fhã END;ãã FUNCTION SwapW(L : LongInt) : LongInt; Assembler;ã ASMã MOV AX, Word(L+2)ã MOV DX, Word(L)ã END;ãã FUNCTION HiW(L : LongInt) : Word; Assembler;ã ASMã MOV AX, Word(L+2)ã END;ãã FUNCTION LoW(L : LongInt) : Word; Assembler;ã ASMã MOV AX, Word(L);ã END;ãã FUNCTION WordFromB(H, L : Byte) : Word; Assembler;ã ASMã MOV AH, Hã MOV AL, Lã END;ãã FUNCTION LongFromW(H, L : Word) : LongInt; Assembler;ã ASMã MOV DX, Hã MOV AX, Lã END;ãEND. 39 01-27-9411:56ALL DJ MURDOCH Complex Numbers IMPORT 11 ž8  {ã>A>overlooked. No Pascal compiler that I know of (including Turbo) can returnã>A>a complex value (i.e., a record or an array) from a FUNCTION. In order forã>ã>Hmm...never tried this before. Anyway, the sollution is quite simple:ã>just have the megaword-variable public, and pass it to the procedure.ããReturning function values by setting a public variable is pretty dangerous -ãwhat if your function calls another that uses the same public to return itsãvalue? In this case, it's not necessary, since there's a trick to let TPãreturn complex numbers:ã}ããtypeã Float = Double;ã TComplex = string[2*sizeof(float)];ã { Complex number. Not a true string: the values are stored in binaryã format within it. }ãã TCmplx = record { The internal storage format for TComplex }ã len : byte;ã r,i : float;ã end;ããfunction Re(z:TComplex):float;ãbeginã Re := TCmplx(z).r;ãend;ããfunction Im(z:TComplex):float;ãbeginã Im := TCmplx(z).i;ãend;ããfunction Complex(x,y:float):TComplex;ã{ Convert x + iy to complex number. }ãvarã result : TCmplx;ãbeginã with result doã beginã len := 2*sizeof(float);ã r := x;ã i := y;ã end;ã Complex := TComplex(result);ãend;ãã{You can use these to build up lots of functions returning TComplex types.}ã 40 01-27-9412:19ALL HARRY BAECKER Random Numbers IMPORT 7 ž8‹U {ã> I would also like some possible suggestions on a good random generatorã> function or Procedure that is easy to understand.ã}ããã{ Given }ããvar Seed; {among your globals}ãã{ You could try seeding it with: }ããProcedure Randomise;ããvarã hour, min, sec, sex100: word;ã root: Longint;ããbeginãã GetTime(hour,min,sec,sec100); {from Dos or WinDos unit}ã root := hour shr 1;ã root := root * sec * sec100;ã root := root shr 16;ã Seed := LoWord(root); {needs WinAPI unit}ãend;ãã{And to get a "random" integer in the range 0 to N - 1: }ããfunction Random(Target: Integer): Integer;ããvarã work: Longint;ããbeginã work := Seed * Seed;ã work := work shr 16;ã Seed := LoWord(work);ã Random := Seed mod Target;ãend;ãã 41 02-05-9407:56ALL FRANK BITTERLICH Setting BITS IMPORT 7 ž8 {ã > This would seem like something simple but canã > someone explain how toã > calculate what is included in the followingã > statement once I have readã > the variable:ãLooks like a user record of some BBS system or so...ããOr did you want to know how to check / set the bits? }ããFUNCTION GetBit (v, BitNumber: BYTE): BOOLEAN;ã BEGINã IF (v AND (1 SHL BitNumber))<>0 THENã GetBit:=TRUEã ELSEã GetBit:=FALSE;ã END; {Returns TRUE if specified bit is set }ããPROCEDURE SetBit (VAR v: Byte; BitNumber: Byte; SetReset: BOOLEAN);ã BEGINã IF SetReset THENã v:=v OR (1 SHL BitNumber)ã ELSEã v:=v AND NOT (1 SHL BitNumber);ã END;ãã 42 02-09-9407:25ALL DON PAULSEN Setting Bit Flags in ASM IMPORT 64 ž8 (*ãDate: 02-05-95ãFrom: DON PAULSENããã This unit provides routines to manipulate individual bitsã in memory, including test, set, clear, and toggle. You mayã also count the number of bits set with NumFlagsSet, and getã a "picture" of them with the function FlagString.ãã All the routines are in the interface section to provideã complete low-level control of your own data space used forã flags. Usually the oFlags object will be most convenient.ã Just initialize the object with the number of flags required,ã and it will allocate sufficient memory on the heap and clearã them to zero.ã*)ãããUNIT DpFlags;ãã{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}ã{$IFDEF VER70} {$P-,Q-,T-,Y-} {$ENDIF}ãã(*ã File(s) DPFLAGS.PASã Unit(s) Noneã Compiler Turbo Pascal v6.0+ã Author Don Paulsenã v1.00 Date 7-01-92ã Last Change 11-12-93ã Version 1.11ã*)ãã{ Flags are numbered from left to right (low memory to high memory),ã starting with 0, to a maximum of 65520. If the flags object isn't used,ã use the System.FillChar routine to set or clear all the flags at once.ã The memory for storing the flags can be allocated in the data segmentã or on the heap.ãã Here are two methods for declaring an array for the flags (not needed ifã the oFlags object is used):ãã CONSTã cMaxFlagNumber = 50;ã cNumberOfFlags = 51;ãã VARã flags_A : array [0..(cMaxFlagNumber div 8)] of byte;ã flags_B : array [0..(cNumberOfFlags - 1) div 8] of byte;ãã Note that since the first flag is flag 0, cNumberOfFlags is always 1 greaterã than cMaxFlagNumber. }ãããINTERFACEããPROCEDURE SetFlag (var flags; flagNum : word);ãPROCEDURE ClearFlag (var flags; flagNum : word);ãPROCEDURE ToggleFlag (var flags; flagNum : word);ãFUNCTION FlagIsSet (var flags; flagNum : word): boolean;ãFUNCTION NumFlagsSet (var flags; numFlags: word): word;ãFUNCTION FlagString (var flags; numFlags: word): string;ããTYPEã tFlags = ^oFlags;ã oFlags = OBJECTã CONSTRUCTOR Init (numberOfFlags: word);ã PROCEDURE ClearAllFlags;ã PROCEDURE SetAllFlags;ã PROCEDURE SetFlag (flagNum: word);ã PROCEDURE ClearFlag (flagNum: word);ã PROCEDURE ToggleFlag (flagNum: word);ã FUNCTION FlagIsSet (flagNum: word): boolean;ã FUNCTION NumFlagsSet : word;ã FUNCTION FlagString : string;ã DESTRUCTOR Done;ã PRIVATEã flags : pointer;ã numFlags : word;ã END;ãããIMPLEMENTATIONãã{=======================================================}ãPROCEDURE SetFlag (var flags; flagNum: word); assembler;ããASMã les di, flagsã mov cx, flagNumã mov bx, cxã shr bx, 1ã shr bx, 1ã shr bx, 1ã and cl, 7ã mov al, 80hã shr al, clã or es:[di][bx], alãEND;ãã{=========================================================}ãPROCEDURE ClearFlag (var flags; flagNum: word); assembler;ããASMã les di, flagsã mov cx, flagNumã mov bx, cxã shr bx, 1ã shr bx, 1ã shr bx, 1ã and cl, 7ã mov al, 7Fhã ror al, clã and es:[di][bx], alãEND;ãã{==========================================================}ãPROCEDURE ToggleFlag (var flags; flagNum: word); assembler;ããASMã les di, flagsã mov cx, flagNumã mov bx, cxã shr bx, 1ã shr bx, 1ã shr bx, 1ã and cl, 7ã mov al, 80hã shr al, clã xor es:[di][bx], alãEND;ãã{=================================================================}ãFUNCTION FlagIsSet (var flags; flagNum: word): boolean; assembler;ããASMã les di, flagsã mov cx, flagNumã mov bx, cxã shr bx, 1ã shr bx, 1ã shr bx, 1ã and cl, 7ã inc cxã mov al, es:[di][bx]ã rol al, clã and al, 1ã@done:ãEND;ãã{=================================================================}ãFUNCTION NumFlagsSet (var flags; numFlags: word): word; assembler;ããASMã push dsã cldã lds si, flagsã xor bx, bxã mov cx, numFlagsã mov dx, cxã xor di, diã shr cx, 1ã shr cx, 1ã shr cx, 1ã jcxz @remainderã@byte8:ã lodsbã shl al, 1; adc bx, diã shl al, 1; adc bx, diã shl al, 1; adc bx, diã shl al, 1; adc bx, diã shl al, 1; adc bx, diã shl al, 1; adc bx, diã shl al, 1; adc bx, diã shl al, 1; adc bx, diã loop @byte8ã@remainder:ã mov cx, dxã and cx, 7ã jz @doneã lodsbã@bit:ã shl al, 1ã adc bx, diã loop @bitã@done:ã mov ax, bxã pop dsãEND;ãã{==================================================================}ãFUNCTION FlagString (var flags; numFlags: word): string; assembler;ãã{ Returns a string of 0's & 1's showing the flags. Note that at most 255ã flags can shown in a string. Returns nul if numFlags is 0 or greaterã than 255. }ããASMã push dsã cldã lds si, flagsã les di, @resultã mov cx, numflagsã or ch, chã jz @okã xor cx, cxã@ok:ã mov al, clã stosb { length of string }ã jcxz @doneã mov dx, cxã push dx { save number of flags }ã mov ah, '0'ã shr dl, 1ã shr dl, 1ã shr dl, 1ã jz @remainderã@byte8: { do 8 bits at a time }ã lodsbã mov bl, alã mov cl, 8ã@bit8:ã mov al, ah { ah = '0' }ã shl bl, 1ã adc al, dh { dh = 0 }ã stosbã loop @bit8ã dec dlã jnz @byte8ãã@remainder: { do remaining (numFlags mod 8) bits }ã pop dxã mov cx, dxã and cl, 7 { 0 <= cx <= 7 (number of flags in partial byte) }ã jz @doneã lodsb { last byte containing flags }ã mov bl, alã@bit:ã mov al, ah { ah = '0' }ã shl bl, 1ã adc al, dh { dh = 0 }ã stosbã loop @bitã@done:ã pop dsãEND;ãã{=============================================}ãCONSTRUCTOR oFlags.Init (numberOfFlags: word);ããBEGINã if numberOfFlags > 65520 then FAIL;ã numFlags:= numberOfFlags;ã GetMem (flags, (numFlags + 7) div 8);ã if flags = nil then FAIL;ãEND;ãã{==============================}ãPROCEDURE oFlags.ClearAllFlags;ããBEGINã FillChar (flags^, (numFlags + 7) div 8, #0);ãEND;ãã{============================}ãPROCEDURE oFlags.SetAllFlags;ããBEGINã FillChar (flags^, (numFlags + 7) div 8, #1);ãEND;ãã{========================================}ãPROCEDURE oFlags.SetFlag (flagNum: word);ããBEGINã DpFlags.SetFlag (flags^, flagNum);ãEND;ãã{==========================================}ãPROCEDURE oFlags.ClearFlag (flagNum: word);ããBEGINã DpFlags.ClearFlag (flags^, flagNum);ãEND;ãã{===========================================}ãPROCEDURE oFlags.ToggleFlag (flagNum: word);ããBEGINã DpFlags.ToggleFlag (flags^, flagNum);ãEND;ãã{==================================================}ãFUNCTION oFlags.FlagIsSet (flagNum: word): boolean;ããBEGINã FlagIsSet:= DpFlags.FlagIsSet (flags^, flagNum);ãEND;ãã{=================================}ãFUNCTION oFlags.NumFlagsSet: word;ããBEGINã NumFlagsSet:= DpFlags.NumFlagsSet (flags^, numFlags);ãEND;ãã{==================================}ãFUNCTION oFlags.FlagString: string;ããVARã w : word;ããBEGINã w:= numFlags;ã if w > 255 then w:= 255;ã FlagString:= DpFlags.FlagString (flags^, w);ãEND;ãã{======================}ãDESTRUCTOR oFlags.Done;ããBEGINã if flags <> nil then FreeMem (flags, (numFlags + 7) div 8);ãEND;ããEND. { Unit DpFlags }ãã 43 02-09-9407:25ALL GAYLE DAVIS Hex String to LONGINT IMPORT 16 ž8 ã{ You've probably seen a lot of code to convert a number to HEX.ã Here is one that will take a hex String and covert it back to a numberãã The conversion is back to type LONGINT, so you can covert to WORDS orã BYTES by simply declaring your whatever varible you want }ãã{$V-}ãUSES CRT;ããVARã A : LONGINT;ã B : WORD;ã C : BYTE;ã D : WORD;ãã{ ---------------------------------------------------------------------- }ããFUNCTION HexToLong(S : STRING) : LONGINT;ãã FUNCTION ANumBin (B : STRING) : LONGINT; Assembler;ã ASMã LES DI, Bã XOR CH, CHã MOV CL, ES : [DI]ã ADD DI, CXã MOV AX, 0ã MOV DX, 0ã MOV BX, 1ã MOV SI, 0ã @LOOP :ã CMP BYTE PTR ES : [DI], '1'ã JNE @NotOneã ADD AX, BX {add power to accum}ã ADC DX, SIã @NotOne :ã SHL SI, 1 {double power}ã SHL BX, 1ã ADC SI, 0ã DEC DIã LOOP @LOOPã END;ããCONSTã HexDigits : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';ã Legal : SET OF Char = ['$','0'..'9','A'..'F'];ã BinNibbles : ARRAY [0..15] OF ARRAY [0..3] OF CHAR = (ã '0000', '0001', '0010', '0011',ã '0100', '0101', '0110', '0111',ã '1000', '1001', '1010', '1011',ã '1100', '1101', '1110', '1111');ããVAR I : BYTE;ã O : STRING;ããBEGINãO := '';ãHexToLong := 0; { Returns zero if illegal characters found }ãIF S = '' THEN EXIT;ãFOR I := 1 TO LENGTH(S) DOã BEGINã IF NOT (S[i] in LEGAL) THEN EXIT;ã O := O + binNibbles[PRED(POS(S[i],Hexdigits))];ã END;ãHexToLong := ANumBin(O)ãEND;ãã{ ---------------------------------------------------------------------- }ããBEGINãClrScr;ãA := HexToLong('$02F8');ãB := HexToLong('$0DFF');ãC := HexToLong('$00FF'); { The biggest byte there is !! }ãD := HexToLong(''); { this is ILLEGAL !! .. D will be ZERO }ãWriteLn(A,' ',B,' ',C,' ',D);ãEND.