SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00057 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] <Destination> <Shift Count>ππ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 <g>. 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 <T.Moore@massey.ac.nz> 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 <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? <g> 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 x<Power[i] doπ dec(i);π Log2 := i;πend;ππend.π 34 11-02-9305:14ALL LOU DUCHEZ Convert Number to HEX IMPORT 22 ₧84┼ {πLOU DUCHEZππ>does 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. 44 05-25-9408:00ALL MIKE ANTTILA writing bits.. SWAG9405 8 ₧8 {π MT> Could someone please tell me how to write to/read from a particularπ MT> bit in a number? Do you have to break the number down into binaryπ MT> or is there some function somewhere that I haven't found yet?ππHere's some procs I wrote that should help you out:π}ππProcedure SetBit(Var Number : Byte; Bit : Byte);π π Beginπ Number := Number OR (1 SHL Bit);π End;π πProcedure ClearBit(Var Number : Byte; Bit : Byte);π π Beginπ Number := Number AND NOT (1 SHL Bit);π End;π πFunction ReadBit(Number, Bit : Byte) : Boolean;π π Beginπ ReadBit := (Number AND (1 SHL Bit)) <> 0;π End;π{πOK, provided you know binary, this should be pretty simple to implement. Theπbits are of course numbered 7-0. SetBit sets a given bit to 1, ClearBit sets aπgiven bit to 0, and ReadBit returns TRUE if 1, FALSE if 0. Anyway, hope thatπhelps...ππ PsychoMan.π}π 45 05-25-9408:08ALL VARIOUS Improved Decimal To BinarSWAG9405 7 ₧8 π{Convert a Decimal to a String - Maximum number of bits = 16}ππFunction Dec2Bin (D: Word; No_Bits: Byte): String;πVar A : Word;π L : Byte;π S : String;πBeginπ S := '';π A := Trunc (Exp ((No_Bits-1)*Ln (2)));π For L := No_Bits downto 1 doπ Beginπ A := A div 2;π If (D AND A)=A then S := S+'1' else S := S+'0';π End;π Dec2Bin := S;πEnd;ππ(*------------------------------------------------------*)πFunction BinStr(num:word;bits:byte):string; assembler;πASMπ PUSHFπ LES DI, @Resultπ XOR CH, CHπ MOV CL, bitsπ MOV ES:[DI], CLπ JCXZ @@3π ADD DI, CXπ MOV BX, numπ STDπ@@1: MOV AL, BLπ AND AL, $01π OR AL, $30π STOSBπ SHR BX, 1π LOOP @@1π@@3: POPFπEnd;ππ 46 05-25-9408:15ALL MAYNARD PHILBROOK Reading on bit of an inteSWAG9405 10 ₧8 {π SK> 12345 --------------- Longinteger of the value 12345π SK> ^^^^^π SK> |||||π SK> ||||+----------------- Integer value 5π SK> ||||π SK> |||+------------------ Integer value 4π SK> |||π SK> ||+------------------- Integer value 3π SK> ||π SK> |+-------------------- Integer value 2π SK> |π SK> +--------------------- Integer value 1ππ SK> I tried using the procedure of geting the MOD of a number then div theπ SK> number out. It works fine until you get a number likeπ SK> 10,100,1000,100000, etc....π SK> Please help...π not sure what your asking but have you can use SHR, SHL, OR ect to fetchπ single bits..........π}πfunction getbitstate( bitpos:byte; lint:longint):boolean;π beginπ asmπ mov @result, 00; { clear bolean first }π cmp bitpos, 16π jg @higher;π mov bx, lint;π@yup:π test bx, bitpos;π jnz @yes;π jmp @done;π@higher:π mov bx,lint+2;π jmp @yup;π@yes:π inc @result, 1; { adjust bolean return }π@done:π end;πend;ππ_____ to use it ____ππBeginπ if getbitstate(8, $80) then Write(' Yup, it's on ');πend;π 47 05-25-9408:21ALL EDWIN GROOTHUIS RIP SWAG9405 12 ₧8 {π AE> numbersystem... When you want to create something in RIP youπ AE> first need to write some calculator to translate normal numbersπ AE> to RIP codes...ππIt's not that difficult, you know how to convert hex -> normal andπnormal -> hex? Well, then you also can convert mega -> normal and normalπ-> megaππlittle idea:π}ππfunction word2mega(w:word):string;πconst table:array[0..35] of char='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';πvar s:string;πbeginπ s:='';π while w>0 doπ beginπ s:=table[w mod 36]+s;π w:=w div 36;π end;π while length(s)<4 do s:='0'+s;π word2mega:=s;πend;ππfunction mega2word(s:string):word;πvar w:word;πbeginπ w:=0;π if length(s)<5 thenπ while s<>'' doπ beginπ if s[1]>'9' thenπ w:=w*36+ord(s[1])-ord('A')+10π elseπ w:=w*36+ord(s[1])-ord('0');π delete(s,1,1);π end;π mega2word:=w;πend;πππvar n:word;π s:string;πbeginπ s:=paramstr(1);π for n:=1 to length(s) doπ s[n]:=upcase(s[n]);π writeln('mega2word: ',mega2word(s));π val(s,n,n);π writeln('word2mega: ',word2mega(n));πend.ππconverts a meganum to a word and a word to a meganum in one program!π(Just one program so I don't have to think in which way it has to beπconverted)ππmega 12<cr> givesπmega2word: 38πword2mega: 0Cππmega 1C<cr> givesπmega2word: 48πword2mega: 00ππ 48 05-25-9408:21ALL JASON KING RIP Mega Numbers SWAG9405 14 ₧8 π{πYou're right about that... The only thin why I found it difficult, isπbecause TP (or any other language) doesn't support the MenaNum itself..πSome other thing is that when you're creating a file, you need to useπtwo windows, and constantly convert the numbers... But for the source,πthanks, I'll look it over... Is it Ok with you when I place it in theπdownload of my BBS..? I havn't seen any DEC<>MEGA program yet...ππTry this...π}ππFunction MegaToDec(Num: String) : LongInt; {Converts String MEGA to Dec}πConst MegaNum : Set of Char = ['0'..'9','A'..'Z']; {assume UC}ππVar HoldNum,π TempVal : LongInt;π CharPos : Byte; {Position of Character}ππ Function ToThirtySix(Ex: Byte) : Longint; {Raises to power of 36}π Var Times: Byte;π HoldPower: LongInt;ππ Beginπ HoldPower:=0;π If Ex=0 then beginπ ToThirtySix:=1;π End;π For Times:=1 to Ex do HoldPower:=HoldPower*36;π ToThirtySix:=HoldPower;π End;ππ Function ConvertVal(Ch: Char) : Byte;π Var Temp : Char;π Beginπ Temp:=Ch;π Upcase(Temp);π If Ord(Ch)>47 and Ord(Ch)<58 then ConvertVal:=Ord(Ch)-48;π {Converts if 0..9}π If Ord(Ch)>64 and Ord(Ch)<91 then ConvertVal:=Ord(Ch)-55;π End;ππ Beginπ HoldNum:=0;π For CharPos:=Length(Num) downto 1 doπ HoldNum:=HoldNum+ConverVal(Num[CharPos])*π ToThirtysix(CharPos-1);π MegaToDec:=HoldNum;π End;ππNote: this is untested, but it should work... try values of 10 Mega π(should by 36 dec) or 2Z (should be 107 dec I think)... Tell me how itπworks...π 49 05-26-9406:16ALL DAVID DUNSON Binary and Hexidecimal IMPORT 16 ₧8 {πI've seen requests for these two procedures several times, and finally gotπaround to writing them in ASM.ππ{ ------- CUT HERE ------- }ππ(* Hex converts a number (num) to Hexadecimal. *)π(* num is the number to convert *)π(* nib is the number of Hexadecimal digits to return *)π(* Example: Hex(31, 4) returns '001F' *)ππFunction Hex(num: Word; nib: Byte): String; Assembler;πASMπ PUSHFπ LES DI, @Resultπ XOR CH, CHπ MOV CL, nibπ MOV ES:[DI], CLπ JCXZ @@3π ADD DI, CXπ MOV BX, numπ STDπ@@1: MOV AL, BLπ AND AL, $0Fπ OR AL, $30π CMP AL, $3Aπ JB @@2π ADD AL, $07π@@2: STOSBπ SHR BX, 1π SHR BX, 1π SHR BX, 1π SHR BX, 1π LOOP @@1π@@3: POPFπEnd;πππ(* Binary converts a number (num) to Binary. *)π(* num is the number to convert *)π(* bits is the number of Binary digits to return *)π(* Example: Binary(31, 16) returns '0000000000011111' *)ππFunction Binary(num: Word; bits: Byte): String; Assembler;πASMπ PUSHFπ LES DI, @Resultπ XOR CH, CHπ MOV CL, bitsπ MOV ES:[DI], CLπ JCXZ @@3π ADD DI, CXπ MOV BX, numπ STDπ@@1: MOV AL, BLπ AND AL, $01π OR AL, $30π STOSBπ SHR BX, 1π LOOP @@1π@@3: POPFπEnd;ππ{ ------- CUT HERE ------- }ππThese procedures are fully optomized to my knowledge and have been testedπagainst normal Pascal routines that perform the same functions. Test resultsπreturned that Hex performed aprox. 2.14 times faster than it's Pascalπequivilent, and Binary performed aprox. 14 times faster than it's Pascalπequivilent.ππEnjoy!πDavidπ 50 08-24-9413:25ALL SETH ANDERSON Binary to Integer SWAG9408 ╜╜ 26 ₧8 {πHey, recently, I've developed a binary to integer, and integer to binary,πconversion operations. This is the fastest way that I know how to write this,πshort of assembly (which I do not know at current). The original code wasπmuch longer, and much slower, yet it worked too, just slower. If you have anyπsuggestions, please let me know, I'm curious to see the results. (And, pleaseπlet me know if you find a use for this source. Right now, I only use it inπone of several units I've written, to view binary files.)ππMy programming style is very organized, so it shouldn't be too hard to follow.ππ------------------------------ CUT HERE --------------------------------------}πππTYPEπ String8 = String[8]; { For Use With The Binary Conversion }π String16 = String[16]; { For Use With The Binary Conversion }ππ Conversions = Objectπ Function Bin8ToInt ( X : String ) : Integer;π Procedure IntToBin8 ( X : Integer; VAR Binary8 : String8 );π End; { OBJECT Conversions }ππ{ I only use OOP because it sits in a unit. For a normal program, or an }π{ easy to use unit, you don't even need these three lines. I have more }π{ conversion subprograms added to this object, which is why I have an }π{ individual object for the conversion subprograms. }ππCONSTπ Bits8 : Array [1..8] of Integer = (128, 64, 32, 16, 8, 4, 2, 1);ππ{ This defines a normal 8 bits. I have a Bin16toInt and IntToBin16 }π{ procedure and function, retrorespectively, but I think that they do not }π{ have any use to them. }ππ{────────────────────────────────────────────────────────────────────────────}ππFunction Conversions.Bin8ToInt ( X : String ) : Integer;ππ{ Purpose : Converts an 8-bit Binary "Number" to an Integer. }π{ The 8-bit "Number" is really an 8-character string, or at least }π{ it should be. }ππVARπ G, Total : Integer;ππBeginπ Total := 0;π For G := 1 to 8 Doπ If ( X[G] = '1' ) thenπ Total := Total + Bits8[G];π Bin8ToInt := Total;ππEnd; { FUNCTION Conversions.Bin8ToInt }π{────────────────────────────────────────────────────────────────────────────}ππProcedure Conversions.IntToBin8 ( X : Integer;π VAR Binary8 : String8 );ππ{ Purpose : Converts an integer (from 1 to 256) to an 8-bit Binary "integer."}π{ The 8-bit "integer" is actually a string, easily convertable to }π{ an integer. }ππVARπ G : Integer;ππBeginπ Binary8 := '00000000';π For G := 1 to 8 Doπ If ( X >= Bits8[G] ) Thenπ Beginπ X := X - Bits8[G];π Binary8[G] := '1';π End;π If ( X > 0 ) Thenπ Binary8 := 'ERROR';ππEnd; { PROCEDURE Conversions.IntToBin8 }π{────────────────────────────────────────────────────────────────────────────}π 51 08-24-9413:53ALL ERIC LOWE Ramdon Integer SWAG9408 │.ß· 3 ₧8 πFunction RandomInteger: Integer; Assembler;πasmπ mov ah,2chπ int 21h { Get a random seed from DOS's clock }π imul 9821π inc axπ ror al,1π rol ah,1 { Randomize the seed }πend;π 52 08-24-9413:54ALL BRIAN RICHARDSON Random Numbers SWAG9408 ┐ù╘? 11 ₧8 {π HG> Did any one have an algorithm to generate random numbers?π HG> I know Borland Pascal have de function RANDOM but what I realyπ HG> want is the code to do that. Any Language is ok, but I preferπ HG> Pascal.ππ Here's a small random number unit that is quite good..π}ππunit Random;ππinterfaceππprocedure SeedRandomNum(ASeed : word);πprocedure InitRandom;πfunction RandomNum : word;πfunction RandomRange(ARange : word): word;ππimplementationππvarπ Fib : array[1..17] of word;π i, j : word;ππprocedure SeedRandomNum(ASeed : word);πvar x : word;πbeginπ Fib[1] := ASeed;π Fib[2] := ASeed;π for x := 3 to 17 doπ Fib[x] := Fib[x-2] + Fib[x-1];π i := 17;π j := ASeed mod 17;πend;ππprocedure InitRandom;πbeginπ SeedRandomNum(MemW[$40:$6C]);πend;ππprocedure SeedRandom(ASeed : word);πvar x : word;πbeginπ Fib[1] := ASeed;π Fib[2] := ASeed;π for x := 3 to 17 doπ Fib[x] := Fib[x-2] + Fib[x-1];π i := 17;π j := ASeed mod 17;πend;ππfunction RandomNum : word;πvar k : word;πbeginπ k := Fib[i] + Fib[j];π Fib[i] := k;π dec(i);π dec(j);π if i = 0 then i := 17;π if j = 0 then j := 17;π RandomNum := k;πend;ππfunction RandomRange(ARange : word): word;πbeginπ RandomRange := RandomNum mod ARange;πend;ππend.π 53 08-25-9409:06ALL JOSE CAMPIONE Hex encode binary files SWAG9408 1 i 32 ₧8 (*************************************************************************ππ ===============================================π Hex-encode binary files in debug-script batchesπ ===============================================π Copyright (c) 1993,1994 by José Campioneπ Ottawa-Orleans Personal Systems Groupπ Fidonet: 1:163/513.3ππ This program reads a binary file and creates a hex-encoded π text file. This text file is also a batch file and a debug π script which, when run, will use debug.exe or debug.com to π reconstruct the binary file. ππ**************************************************************************)π{$M 2048,0,0}πprogram debugbat;ππuses crt,dos;ππconstπ maxsize = $FFEF;ππtypeπ string2 = string[2];ππvarπ ifile : file of byte;π ofile : text;π n : word;π s : word;π b : byte;π fsize : word;π dir : dirstr;π nam : namestr;π ext : extstr;π filename : string[12];π i : integer;ππfunction b2x(b: byte): string2;πconst hexdigit: array[0..15] of char = '0123456789ABCDEF';πbeginπ b2x:= hexdigit[b shr 4] + hexdigit[b and $0F];πend;ππprocedure myhalt(e: byte);πbeginπ gotoxy(1,wherey);π case e ofπ 0 : writeln('done.');π 1 : writeln('error in command line.');π 2 : writeln('file exceeds the 65K limit.');π else beginπ e:= 255;π writeln('Unknown error.');π end;π end;π halt(e);πend;ππbeginπ writeln;π writeln('DEBUGBAT v.1.0. Copyright (c) Feb/93 by J. Campione.');π write('Wait... ');π n := 0;π s := $F0;π {$I-}π assign(ifile,paramstr(1));π reset(ifile);π {$I+}π if (paramcount <> 1) or (ioresult <> 0) or (paramstr(1) = '') then myhalt(1);π fsplit(paramstr(1),dir,nam,ext);π for i:= 1 to length(ext) do ext[i]:= upcase(ext[i]);π for i:= 1 to length(nam) do nam[i]:= upcase(nam[i]);π if ext = '.EXE' then filename:= nam + '.EXX'π else filename:= nam + ext;π fsize:= filesize(ifile);π if fsize > maxsize then myhalt(2);π assign(ofile, nam + '.BAT');π rewrite(ofile);π writeln(ofile,'@echo off');π writeln(ofile,'rem');π writeln(ofile,'rem *************************************************************************');π writeln(ofile,'rem File ',nam + '.BAT',' was created by program DEBUGBAT.EXE v.1.0');π writeln(ofile,'rem Copyright (c) Feb. 1993 by J. Campione (1:163/513.3)');π writeln(ofile,'rem Running this file uses DEBUG to reconstruct file ',nam + ext);π writeln(ofile,'rem *************************************************************************');π writeln(ofile,'rem');π writeln(ofile,'echo DEBUGBAT v.1.0. Copyright (c) Feb/93 by J. Campione.');π writeln(ofile,'if not exist %1debug.exe goto error1');π writeln(ofile,'goto decode');π writeln(ofile,':error1');π writeln(ofile,'if not exist %1debug.com goto error2');π writeln(ofile,':decode');π writeln(ofile,'echo Wait...');π writeln(ofile,'debug < %0.BAT > nul');π writeln(ofile,'goto name');π writeln(ofile,':error2');π writeln(ofile,'echo Run %0.BAT with DEBUG''s path in the command line');π writeln(ofile,'echo example: %0 c:\dos\ ... notice the trailing slash!');π write(ofile,'goto end');π while not eof(ifile) do beginπ n:= n + 1;π read(ifile,b);π if n mod 16 = 1 then beginπ s := s + 16;π writeln(ofile);π write(ofile,'E ',b2x(hi(s)),b2x(lo(s)));π end;π write(ofile,' ',b2x(b));π end;π writeln(ofile);π writeln(ofile,'RCX');π writeln(ofile,b2x(hi(n)),b2x(lo(n)));π if ext = '.EXE' then beginπ filename:= nam + '.EXX';π end;π writeln(ofile,'N ',filename);π writeln(ofile,'W');π writeln(ofile,'Q');π writeln(ofile,':name');π if ext = '.EXE' then beginπ writeln(ofile,'if exist ',nam + ext,' del ',nam + ext);π writeln(ofile,'rename ',nam + '.EXX ',nam + ext);π end;π writeln(ofile,':end');π close(ifile);π close(ofile);π myhalt(0);πend.ππ 54 08-25-9409:10ALL CLIVE MOSES Permutinf Words SWAG9408 ÑΓ⌡O 18 ₧8 {πHere is another attempt. It will also work with any length stringπand generates all permutations without running out of memory, byπsearching in a depth-first fashion.π}ππ{$M 64000,0,655360}ππprogram perms2;ππuses Crt;ππtype str52 = string[52];ππconst objects : str52 = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';ππvar m, n,π fw, level,π nperline : integer;π p1, p2 : str52;π nperms : longint;ππprocedure p (var p1, p2 : str52; var level : integer);πvar p1n, p2n : str52;π i, nlevel : integer;πbeginπ if level < mπ thenπ beginπ nlevel := level + 1;π for i := 1 to length(p2) doπ beginπ p1n := p1 + p2[i];π p2n := p2;π delete (p2n, i, 1);π p (p1n, p2n, nlevel);π end;π endπ elseπ beginπ write (p1:fw);π inc (nperms);π end;πend;ππbeginπ repeatπ clrscr;π repeatπ write ('How many objects altogether? ');π readln (n);π until (n>=0) and (n<53);π if n>0π thenπ beginπ repeatπ write ('How many in each permutation? ');π readln (m);π until (m>0) and (m<=n);π writeln;π case m ofπ 1 : fw := 2; { 40 per line }π 2..3 : fw := 4; { 20 per line }π 4 : fw := 5; { 16 per line }π 5..7 : fw := 8; { 10 per line }π 8..9 : fw := 10; { 8 per line }π 10..15 : fw := 16; { 5 per line }π 16..19 : fw := 20; { 4 per line }π 20..39 : fw := 40; { 2 per line }π 40..52 : fw := 80; { 1 per line }π end;π nperline := 80 div fw;π level := 0;π p1 := '';π p2 := copy (objects, 1, n);π nperms := 0;π p (p1, p2, level);π if (nperms mod nperline) <> 0 then writeln;π writeln;π writeln (nperms,' Permutations generated.');π readln;π end;π until n=0;πend.π{πThis one is a little more elegant, and should also be a littleπeasier to decipher than the last one! Hope this will be of someπuse to you!π}π 55 08-25-9409:10ALL CLIVE MOSES Word Permutes 2! SWAG9408 àå2ƒ 30 ₧8 {πDC>I have a little major problem... And offcourse I want YOU to help me!πDC>I want to write something that gives of a 8-letter word all the possibleπDC>combinations. So that 'RDEPTRAO' gives 'PREDATOR'. I think it must be aboutπDC>256 combinations. I don't need a program that gives 'PREDATOR' directly, butπDC>just something that gives me all those possibilities.ππHere is something that may help you a little. It works fine on myπPC with one small proviso. If you specify permutations of 8πobjects taken 8 at a time (what you want ...) then the programπruns out of heap space. Try it will smaller numbers first - likeπpermutations of 5 objects taken 3 at a time. This will show youπhow it works. You can then try to modify it so that it will notπrun out of memory generating the 40320 permutations that you areπlooking for.ππ Program perms, written by Clive Moses. This program willπ generate all permutations of n objects, taken r at a time,π memory allowing.ππ Challenge: try to modify the program so that it will notπ guzzle massive amounts of memory generating its output.π}ππprogram perms;ππ{ Program to generate permutations of n objects, taken m at a time.π For test purposes: m <= n <= 8. The program, as implemented here,π effectively uses a 'breadth-first' algorithm. If it could be changedπ to run in a 'depth-first' fashion, it would not be necessary toπ store all of the intermediate information used to create theπ permutations. A 'depth-first' algorithm might have to be recursiveπ however.π}ππuses crt;ππtype str8 = string[8];ππ torec = ^rec;ππ rec = recordπ perm,π left : str8;π next : torec;π end;ππconst objects : str8 = 'abcdefgh';ππvar m, n : integer;π first : torec;ππprocedure NewRec (var p : torec);πbeginπ NEW (p);π with p^ doπ beginπ perm := '';π left := '';π next := NIL;π end;πend;ππprocedure PrintPerms (var first : torec);πvar p : torec;π count : integer;πbeginπ p := first;π count := 0;π while p<>NIL doπ beginπ if p^.perm <> ''π thenπ beginπ write (p^.perm:8);π inc (count);π end;π p := p^.next;π end;π writeln;π writeln;π writeln (count,' records printed.');πend;ππprocedure MakePerms (m, n : integer; var first : torec);πvar i,π level : integer;π p,π p2,π temp : torec;πbeginπ writeln ('Permutations of ',n,' objects taken ',m,' at a time ...');π writeln;π if m <= nπ thenπ beginπ level := 0;π NewRec (first);π first^.left := copy (objects, 1, n);π while level < m doπ beginπ p2 := NIL;π temp := NIL;π p := first;π NewRec (p2);π while p <> NIL doπ beginπ for i := 1 to length(p^.left) doπ beginπ if temp=NIL then temp := p2;π p2^.perm := p^.perm + p^.left[i];π p2^.left := p^.left;π delete (p2^.left, i, 1);π NewRec (p2^.next);π p2 := p2^.next;π end;π p := p^.next;π end;π inc (level);π p := first;π while p<>NIL doπ beginπ p2 := p^.next;π dispose (p);π p := p2;π end;π first := temp;π endπ end;πend;ππbegin { Main Program }π clrscr;π first := NIL;π writeln ('Memory available = ',memavail);π writeln;π repeatπ write ('Total number of objects: ');π readln (n);π until n in [1..8];π repeatπ write ('Size of permutation: ');π readln (m);π until m in [1..n];π MakePerms (m, n, first);π PrintPerms (first);π writeln;π writeln ('Memory available = ',memavail);πend.π 56 08-26-9407:26ALL COLIN NICHOLSON NUM2WORD.PAS SWAG9408 ╫Xôú 40 ₧8 Unit Num2Word;π{* Program by: Richard Weber - 08/02/94 - 4 hours work *}π{* 70614,2411 *}πInterfaceππ{* BY: Richard Weber *}π{* CrazyWare - 08/02/94 *}π{* CompuServe ID: 70614,2411 *}ππ{* This program was written in 4 hours. *}ππ{* Program is self Explainatory. There is only one available function. *}π{* Function Number2Name(L : LongInt) : String; *}ππ{* If you call Number2Name(20) it will return the word equalivent *}π{* as a string. It function will process up to 2 billion and will *}π{* not process numbers less than zero or fractions of one. *}ππ{* I hope the unit comes in handy and will prevent you from working *}π{* one out form scratch. *}ππ{* Feel free to modify and expand it as will. Please leave me a message *}π{* for any questions or comments. *}πππ Function Number2Name(L : LongInt) : String;π { Function converts Long Integer supplied to a Word String }ππImplementationππCONSTπ N_Ones : Array[0..9] of String[5] =π ('',π 'One',π 'Two' ,π 'Three',π 'Four',π 'Five',π 'Six',π 'Seven',π 'Eight',π 'Nine');π N_OnesX : Array[0..9] of String[9] =π ('Ten',π 'Eleven',π 'Twelve',π 'Thirteen',π 'Fourteen',π 'Fifteen',π 'Sixteen',π 'Seventeen',π 'Eightteen',π 'Nineteen');π N_Tens : Array[2..10] of String[7] =π ('Twenty',π 'Thirty',π 'Forty',π 'Fifty',π 'Sixty',π 'Seventy',π 'Eighty',π 'Ninety',π 'Hundred');π N_Extra : Array[1..3] of String[8] =π ('Thousand',π 'Million',π 'Billion');ππ Hundred = 10; {* N_Tens[10] *}ππ Function LongVal(S : String) : LongInt;π Varπ TmpVal : LongInt;π Count : Integer;π Beginπ Val(S, TmpVal, Count);π LongVal := TmpVal;π End;ππ Function Long2Str(L : LongInt) : String;π Varπ S : String;π Beginπ Str(L,S);π Long2Str := S;π End;ππ Function Number2Name(L : LongInt) : String;π Varπ NameString : String;π NumberString : String;π Finished : Boolean;π Place : Integer;π StopPlace : Integer;π BeginPlace : Integer;π CountPlace : Integer;ππ Function Denom(I : Integer) : String;π Varπ TestPlace : Integer;ππ Beginπ TestPlace := I Div 3;π If I Mod 3 <> 0 then Inc(TestPlace);ππ If TestPlace > 1 thenπ Denom := N_Extra[TestPlace-1]π Elseπ Denom := '';π End;ππ Function TensConvert(S : String) : String;π Var TmpStr : String;π Beginπ If Length(S) > 2 then S := Copy(S,2,2);π TensConvert := '';ππ If LongVal(S) <= 19 thenπ Beginπ If LongVal(S) >=10 thenπ TensConvert := N_OnesX[LongVal(S)-10]π Elseπ TensConvert := N_Ones[LongVal(S)];π Endπ Elseπ Beginπ TmpStr := N_Tens[LongVal(S) Div 10];π If LongVal(S) Mod 10 <> 0 thenπ TmpStr := TmpStr + '-' + N_Ones[LongVal(S) Mod 10];π TensConvert := TmpStr;π End;π End;ππ Function HundredConvert(S : String; Place : BYTE) : String;π Varπ TmpString : String;ππ Beginπ TmpString := '';π If LongVal(S) > 0 thenπ Beginππ If (Length(S) = 3) and (LongVal(S[1]) > 0) thenπ TmpString := TmpString + ' ' + N_Ones[LongVal(S[1])]+π ' ' + N_Tens[Hundred];ππ TmpString := TmpString + ' ' + TensConvert(S);ππ TmpString := TmpString + ' ' + Denom(Place);ππ End;π HundredConvert := TmpString;π End;ππ Beginπ If L > 0 then π Beginπ StopPlace := 0;π Place := 3;π NameString := '';π NumberString := Long2Str(L);ππ Finished := False;π Repeatπ If Place > Length(NumberString) thenπ Beginπ Place := Length(NumberString);π Finished := True;π End;ππ IF Place <> StopPlace thenπ Beginπ BeginPlace := Length(NumberString)-Place+1;π CountPlace := Place-StopPlace;π NameString := HundredConvert(Copy(NumberString,BeginPlace,CountPlace),Place ) + NameString;π End;ππ StopPlace := Place;π Inc(Place,3);π Until Finished;ππ Number2Name := NameString;π Endπ Elseπ Number2Name := ' Zero';π End;ππBeginπEnd.ππ{ --------------- demo ------------------------- }ππProgram TestNum;πUses Num2Word;ππVarπ Lop : Integer;π Tmp : LongInt;ππBeginπ Writeln;π Randomize;π For Lop := 1 to 10 doπ Beginπ Tmp := Random(65534);π Writeln(Tmp, Number2Name(Tmp));π End;ππ Readln;πππ For Lop := 0 to 20 doπ Beginπ Writeln(Lop, Number2Name(Lop));π End;ππ Readln;πππ For Lop := 10 to 100 doπ Beginπ Writeln(Lop*10, Number2Name(Lop*10));π End;ππEnd. 57 08-26-9408:32ALL NEIL J. RUBENKING BCD Reals SWAG9408 t▀ƒ 9 ₧8 { The below is a function to convert BCD real numbers into "normal"π Turbo Reals. It runs under "normal" Turbo or Turbo-87. Very likelyπ the only use for it is to read BCD reals from a FILE and convert them.π -- Neil J. Rubenking}ππ TYPEπ RealBCD = array[0..9] of byte;ππ FUNCTION BCDtoNorm(R : realBCD) : real;π Varπ I, IntExponent : Integer;π N, Tens, Exponent : Real;π sign : integer;π BEGINπ IF R[0] = 0 THEN BCDtoNORM := 0π ELSEπ BEGINπ IntExponent := (R[0] AND $7F) - $3F;π IF R[0] AND $80 = $80 THEN Sign := -1 ELSE Sign := 1;π N := 0; Tens := 0.1;π FOR I := 9 downto 1 DOπ BEGINπ N := N + Tens*(R[I] SHR 4);π Tens := Tens * 0.1;π N := N + Tens*(R[I] AND $F);π Tens := Tens * 0.1;π END;π Exponent := 1.0;π FOR I := 1 to IntExponent DO Exponent := Exponent * 10.0;π BCDtoNORM := Exponent * N * Sign;π END;π END;π
