home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPA2_A.ZIP / INTERNAL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-11  |  3.1 KB  |  120 lines
  1. {NO NEED TO LINK!!!}
  2.  
  3. TYPE
  4.   String255 = STRING[255];
  5.  
  6. VAR
  7.   HexDigits: ARRAY[0..15] OF CHAR;
  8.   Str1,Str2: String255;
  9.  
  10. FUNCTION  HexByte(SourceByte: BYTE): INTEGER; Forward;
  11. PROCEDURE Concat(Var S1,S2: String255; Size1: INTEGER); Forward;
  12. {- In a PROGRAM, Use FORWARD in place of EXTERNAL -}
  13.  
  14. Internal Example;
  15.  
  16. DATA    SEGMENT WORD PUBLIC
  17.  
  18.         EXTRN   HexDigits:BYTE      ;Not required by INTERNAL
  19.  
  20. DATA    ENDS
  21.  
  22. CODE    SEGMENT BYTE PUBLIC
  23.  
  24.         ASSUME  CD:CODE,DS:DATA     ;Not required by INTERNAL
  25.  
  26.         PUBLIC  HexByte,Concat      ;Not required by INTERNAL
  27.  
  28. ; FUNCTION  HexByte(SourceByte: BYTE): INTEGER; Forward;
  29.  
  30. HexByte         PROC    NEAR
  31.  
  32.         MOV     BX,SP
  33.         MOV     AL,SS:[BX+2] ; Get parameter
  34.  
  35.         Xor     Ah,Ah        ; set Ah = 0 to prevent Divide Overflow
  36.         Mov     Bl,010
  37.         Div     Bl           ; Al = Quo, Ah = Rem
  38.         Mov     Bx,Offset HexDigits
  39.         Xchg    Al,Ah
  40.         XlatB
  41.         Xchg    Al,Ah
  42.         XlatB
  43.         Ret     2  ; T4 & T5 Externals don't remove function result
  44.  
  45. HexByte         ENDP
  46.  
  47.  
  48.  
  49. ; PROCEDURE Concat(Var S1,S2: String255; Size1: INTEGER); Forward;
  50.  
  51. String1         EQU     DWORD PTR [BP+10]
  52. String2         EQU     DWORD PTR [BP+6]
  53. SizeOf1         EQU     WORD PTR [BP+4]
  54.  
  55. Concat          PROC NEAR
  56.  
  57.         Push    Bp
  58.         Mov     Bp,Sp
  59.         Push    Ds
  60.         Xor     Ax,Ax
  61.         Mov     Cx,SizeOf1
  62.         Dec     Cx           ;Max length is Allocated size - 1
  63.         Xor     Ch,Ch        ;In no case let str1 exceed 255
  64.         Les     Di,String1
  65.         Lds     Si,String2
  66.         Lodsb                ;length(S2)
  67.         Add     Al,Es:[Di]   ;+Length(S1)
  68.         jC      L1           ;exceeds 255, use Limit
  69.         Cmp     Al,Cl
  70.         jA      L1           ;exceeds Limit (use Limit)
  71.         Mov     Cl,Al        ;else use sum of lengths
  72.         Jmp     Short L2
  73. L1:     Mov     Al,Cl
  74. L2:     Sub     Cl,Es:[Di]   ;New length - old length(S1)
  75.         jBE     Done         ;New < Old, don't shorten
  76.         Xchg    Al,Es:[Di]   ;Put in new length, get old
  77.         Inc     Di           ;skip length byte
  78.         Add     Di,Ax        ;and original string to set dest
  79.         Rep     Movsb        ;Concatenate
  80. Done:   Pop     Ds
  81.         Pop     Bp
  82.         Ret     10
  83.  
  84. Concat          ENDP
  85.  
  86.  
  87. CODE    ENDS
  88.  
  89.         END (Internal Example)
  90.  
  91.  
  92. CONST Result: RECORD
  93.         Len: BYTE;
  94.         Wrd: INTEGER;
  95.       END = (Len:2;Wrd:0);
  96. VAR
  97.   n: BYTE;
  98.   ResultString: STRING[2] Absolute Result;
  99.  
  100. BEGIN {Main Program}
  101. {- Demonstrate HexByte -}
  102.   HexDigits:= '0123456789ABCDEF';
  103.   FOR n := 0 TO 255 DO BEGIN
  104.     WRITE(n:3,' ');
  105.     Result.Wrd := HexByte(n);
  106.     WRITE(ResultString,'  ');
  107.   END; {FOR n := 0 TO 255 DO }
  108.   WRITELN;
  109. {- Demonstrate Concat -}
  110.   Str1 := 'String1';
  111.   Str2 := 'String2';
  112.   WRITELN('Before Concat:  ',Str1);
  113.   FOR n := 1 TO 5 DO BEGIN
  114.     Concat(Str1,Str2,SizeOf(Str1));
  115.     WRITELN('After Concat',n,':  ',Str1);
  116.   END; {FOR n := 1 TO 5 DO }
  117.   Concat(Str1,Str2,45);
  118.   WRITELN('Partial Concat: ',Str1);
  119. END. {Main}
  120.