home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / UTILITYS / PUDD.ARC / TURHACK2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-11  |  10KB  |  230 lines
  1.  
  2. {*************************************************************************
  3.  *   procedures for Turbo Pascal  and  CP/M   (on the Z-80)              *
  4.  *                                                                       *
  5.  *   Notes:  While Turbo provides some nice tools which allow the        *
  6.  *    programmer to get into his machine and twist it's guts inside      *
  7.  *    out (like PortArray, absolute memory access, etc) some of these    *
  8.  *    features need supporting tools to be useful.  The following        *
  9.  *    tools have been useful for hard core hacking.  Particularly        *
  10.  *    for debugging inline code.                                         *
  11.  *        If you have similar tools why not add them to the file,        *
  12.  *    update the version # and post it at.....                           *
  13.  *              The Power Board  (608) 251-3494                          *
  14.  *                                                                       *
  15.  *     version 1.0n  6/85                                                *
  16.  *     version 1.1   7/85  added a few more procedures                   *
  17.  *                                                                       *
  18.  *  SetBitW: sets the nth bit in a word                                  *
  19.  *  SetBitB: sets the nth bit in a byte                                  *
  20.  *  ClrBitW: clears the nth bit in a word                                *
  21.  *  ClrBitB: clears the nth bit in a byte                                *
  22.  *  HexEqu:  returns the Hex equivelent of a word in a string            *
  23.  *  HexByte: returns the Hex equivelent of a byte                        *
  24.  *  ReadByte: returns the bit representation of a byte in a string       *
  25.  *                                                                       *
  26.  *************************************************************************}
  27.  
  28.  
  29.  
  30. {**************************************************************************
  31.  * setbitW(bit, word) - set bit #bit in word
  32.  *
  33.  * input -> (char), (integer)
  34.  *
  35.  * Results -> The 'bit'th bit in `word` is set.  Bits are numbered as laid
  36.  *            out below:
  37.  *                       15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
  38.  *************************************************************************}
  39. procedure setbitW(bit : integer; var word : integer);
  40. var       tmp : integer;
  41.           i   : integer;
  42.           temp: integer;
  43. begin
  44.     temp := word;
  45.     tmp := 1;
  46.     for i := 1 to bit do
  47.        tmp := tmp * 2;
  48.     inline( $2A/temp/       {ld HL,(nn)    ;get the word             }
  49.             $ED/$5B/tmp/    {ld DE,(nn)    ;get the mask             }
  50.             $7C/            {ld A,H        ;load low byte            }
  51.             $B2/            {or D          ; mask                    }
  52.             $67/            {ld H,A        ;save                     }
  53.             $7D/            {ld A,L        ;load high byte           }
  54.             $B3/            {or E          ; mask                    }
  55.             $6F/            {ld L,A        ;save                     }
  56.             $22/temp);      {ld (nn),HL    ;restore                  }
  57.    word := temp;
  58. end; { setbit }
  59.  
  60.  
  61. {**************************************************************************
  62.  * setbitB(bit, byte) - set bit #bit in byte
  63.  *
  64.  * input -> (char), (integer)
  65.  *
  66.  * Results -> The 'bit'th bit in `byte` is set.  Bits are numbered as laid
  67.  *            out below:
  68.  *                        7 6 5 4 3 2 1 0
  69.  *************************************************************************}
  70. procedure setbitB(bit : integer; var byte : char);
  71. var       tmp  : integer;
  72.           i    : integer;
  73.           temp :char;
  74. begin
  75.     temp := byte;
  76.     tmp := 1;
  77.     for i := 1 to bit do
  78.        tmp := tmp * 2;
  79.     inline($3A/temp/      { ld   A,(nn)   ;get the byte     }
  80.            $21/tmp/       { ld   HL,nn    ;get the mask adr }
  81.            $56/           { ld   D,(HL)   ;get the mask     }
  82.            $B2/           { or   D        ;use it           }
  83.            $32/temp);     { ld   (nn),A   :put it back      }
  84.     byte := temp;
  85. end; { setbitB }
  86.  
  87.  
  88. {**************************************************************************
  89.  * clrbitW(bit, word) - set bit #bit in word
  90.  *
  91.  * input -> (char), (integer)
  92.  *
  93.  * Results -> The 'bit'th bit in `word` is set.  Bits are numbered as laid
  94.  *            out below:
  95.  *                       15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
  96.  *************************************************************************}
  97. procedure clrbitW(bit : integer; var word : integer);
  98. var       tmp : integer;
  99.           i   : integer;
  100.           temp: integer;
  101. begin
  102.     temp := word;
  103.     tmp := 1;
  104.     for i := 1 to bit do
  105.        tmp := tmp * 2;
  106.     inline( $2A/temp/       {ld HL,(nn)    ;get the word             }
  107.             $ED/$5B/tmp/    {ld DE,(nn)    ;get the mask             }
  108.             $7A/            {ld A,D        ;load low mask            }
  109.             $2F/            {cpl           ;compliment               }
  110.             $A4/            {and H         ;mask from word           }
  111.             $67/            {ld H,A        ;put it back              }
  112.             $7B/            {ld A,E        ;load high mask           }
  113.             $2F/            {cpl           ;compliment               }
  114.             $A5/            {and L         :mask from word           }
  115.             $6F/            {ld L,A        ;save                     }
  116.             $22/temp);      {ld (nn),HL    ;restore                  }
  117.    word := temp;
  118. end; { clrbitW }
  119.  
  120.  
  121. {**************************************************************************
  122.  * clrbitB(bit, byte) - clear bit #bit in byte
  123.  *
  124.  * input -> (char), (integer)
  125.  *
  126.  * Results -> The 'bit'th bit in `byte` is cleared.  Bits are numbered as
  127.  *            laid out below:
  128.  *                        7 6 5 4 3 2 1 0
  129.  *************************************************************************}
  130. procedure clrbitB(bit : integer; var byte : char);
  131. var       tmp  : integer;
  132.           i    : integer;
  133.           temp :char;
  134. begin
  135.     temp := byte;
  136.     tmp := 1;
  137.     for i := 1 to bit do
  138.        tmp := tmp * 2;
  139.     inline($21/tmp/       { ld   HL,nn    ;get the mask adr }
  140.            $7E/           { ld   A,(HL)   ;get the mask     }
  141.            $2F/           { cpl           ;compliment       }
  142.            $21/temp/      { ld   HL,nn    ;get the byte adr }
  143.            $56/           { ld   D,(HL)   ;get the byte     }
  144.            $A2/           { and  D        ;mask it          }
  145.            $32/temp);     { ld   (nn),A   :put it back      }
  146.     byte := temp;
  147. end; { clrbitB }
  148.  
  149.  
  150. {**************************************************************************}
  151. { HexEqu will return the hex equivelent of a two byte word in a four byte  }
  152. { string. The nibbles are refered to as ....           }
  153. {            byte 1    byte 2                          }
  154. {           0000 0000 0000 0000                        }
  155. {   nibble    1    2    3    4                         }
  156. {type AddH = string[4]; ........................this is needed above }
  157. {**************************************************************************}
  158. procedure HexEqu(typAddr:integer;var HexAddr:AddH);
  159. var j   :integer;
  160. begin
  161.  j := hi(typAddr) div 16 + 48;
  162.  if j > 57 then j := j + 7;
  163.  insert(chr(j),HexAddr,1);    { set nibble 1 }
  164.  j := hi(typAddr) mod 16 + 48;
  165.  if j > 57 then j := j + 7;
  166.  insert(chr(j),HexAddr,2);    { set nibble 2 }
  167.  j := lo(typAddr) div 16 + 48;
  168.  if j > 57 then j := j + 7;
  169.  insert(chr(j),HexAddr,3);    { set nibble 3 }
  170.  j := lo(typAddr) mod 16 + 48;
  171.  if j > 57 then j := j + 7;
  172.  insert(chr(j),HexAddr,4);    { set nibble 4 }
  173. end;
  174. {**************************************************************************}
  175.  
  176. {**************************************************************************}
  177. {*   ReadByte will return a charactor string with the correct a series    *}
  178. {*  1's and 0's in an 8 charactor string to represent the actual bits     *}
  179. {*  in the byte.                                                          *}
  180. {**************************************************************************}
  181. procedure ReadByte(sample:byte; var Bitlist:Blist);
  182. var  ListLocal  :Blist;
  183.      ByteLocal  :byte;
  184. begin
  185.  ListLocal := '00000000';
  186.  ByteLocal := sample;
  187.      inline($3A/ByteLocal/   { LD A,(ByteLocal)   }
  188.             $21/ListLocal/   { LD HL,ListLocal    }
  189.             $06/$30/         { LD  B,0            }
  190.             $0E/$31/         { LD  C,1            }
  191.             $16/$08/         { LD  D,8            }
  192.             $23/             { INC HL      :top   }
  193.             $CB/$47/         { BIT 1,A            }
  194.             $20/$03/         { JR  NZ,one         }
  195.             $70/             { LD  (HL),B         }
  196.             $18/$01/         { JR  done           }
  197.             $71/             { LD  (HL),C  :one   }
  198.             $CB/$1F/         { RR  A       :done  }
  199.             $15/             { DEC D              }
  200.             $20/$F2 );       { JR  NZ,top         }
  201.  Bitlist := ListLocal;
  202. end; {........................      ......ReadByte}
  203. {**************************************************************************}
  204.  
  205.  
  206. {**************************************************************************}
  207. { HexByte will return the hex equivelent of a byte in a four byte  }
  208. { string. The nibbles are refered to as ....           }
  209. {            byte                                      }
  210. {           0000 0000                                  }
  211. {   nibble    1    2                                   }
  212.  
  213. procedure HexByte(HByte:char;var HexVal:HexString);
  214. var j,i    :integer;
  215.     k      :char;
  216. begin
  217.  j := 0;
  218.  HexVal := '  ';
  219.  k := HByte;       {make it local to avoid problems  }
  220.  inline($ED/$6B/k/   {ld HL,(nn)       get the low part }
  221.         $ED/$63/j);  {ld (nn),HL      put it in var    }
  222.  i := lo(j) div 16 + 48;
  223.  if i > 57 then i := i + 7;
  224.  insert(chr(i),HexVal,1);    { set nibble 3 }
  225.  i := lo(j) mod 16 + 48;
  226.  if i > 57 then i := i + 7;
  227.  insert(chr(i),HexVal,2);    { set nibble 4 }
  228. end;
  229.  
  230.