home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPA22.ZIP / TPA_INTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-22  |  4.8 KB  |  150 lines
  1. {═══════════════════════════ INTERNAL.PAS ═══════════════════════════}
  2. { Demonstrates the use of an Internal statement in a Program.        }
  3. {                                                                    }
  4. { Internal and External statements require that you code an entire   }
  5. { Procedure or Function in assembly, and that you explicitly code    }
  6. { any necessary entry and exit code.  For that reason it is usually  }
  7. { more convenient to use Assemble or Asm statements, which can be    }
  8. { mixed with Pascal statements on a line by line basis.  On the      }
  9. { other hand, Internal and External are useful when you want to      }
  10. { completely eliminate the standard Pascal entry and exit code.  In  }
  11. { the Concat example below, the compiler would normally reserve 256  }
  12. { bytes on the stack and make a local copy of the String Value       }
  13. { parameter S2.  Since this parameter will not be modified, there is }
  14. { no reason to reserve limited stack space and make the local copy.  }
  15. { Using Internal eliminates this unwanted entry code.                }
  16. {═══════════════════════════ INTERNAL.PAS ═══════════════════════════}
  17.  
  18. {  No Link directive - Internal Procedures and Functions are linked  }
  19. {  on a Proc by Proc basis by the Turbo Smart-Linker, resulting in   }
  20. {  a smaller EXE file.  (External code is linked "all or nothing").  }
  21.  
  22. VAR
  23.   HexDigits: ARRAY[0..15] OF CHAR;
  24.   Str1:      String;
  25.  
  26.  
  27. FUNCTION  HexByte(SourceByte: BYTE): INTEGER;         Forward;
  28. PROCEDURE Concat(Var S1; S2: String; Size1: INTEGER); Forward;
  29. {- In a PROGRAM, Use FORWARD in place of EXTERNAL -}
  30.  
  31.  
  32. Internal Example;
  33.  
  34. DATA    SEGMENT WORD PUBLIC
  35.  
  36.         EXTRN   HexDigits:BYTE      ;Not required by INTERNAL
  37.  
  38. DATA    ENDS
  39.  
  40. CODE    SEGMENT BYTE PUBLIC
  41.  
  42.         ASSUME  CS:CODE,DS:DATA     ;Not required by INTERNAL
  43.  
  44.         PUBLIC  HexByte,Concat      ;Not required by INTERNAL
  45.  
  46. ; FUNCTION  HexByte(SourceByte: BYTE): INTEGER; Forward;
  47.  
  48. HexByte         PROC    NEAR
  49.  
  50.         MOV     BX,SP
  51.         MOV     AL,SS:[BX+2] ; Get parameter
  52.  
  53.         Xor     Ah,Ah        ; set Ah = 0 to prevent Divide Overflow
  54.         Mov     Bl,010
  55.         Div     Bl           ; Al = Quo, Ah = Rem
  56.         Mov     Bx,Offset HexDigits
  57.         Xchg    Al,Ah
  58.         XlatB
  59.         Xchg    Al,Ah
  60.         XlatB                ; Leave result in Ax
  61.         Ret     2
  62.  
  63. HexByte         ENDP
  64.  
  65.  
  66.  
  67. ; PROCEDURE Concat(Var S1; S2: String; Size1: INTEGER); Forward;
  68.  
  69. ; Note: the String Value parameter S2 will Not be copied into a
  70. ; local work area.  It will frequently represent a String Constant
  71. ; stored in the Code Segment in a space much smaller than 256 bytes.
  72. ; Because of this, and because of the compiler's automatic merging
  73. ; of string constants, it should not be modified.
  74.  
  75. String1         EQU     DWORD PTR [BP+10]
  76. String2         EQU     DWORD PTR [BP+6]
  77. SizeOf1         EQU     WORD PTR [BP+4]
  78.  
  79. Concat          PROC NEAR
  80.  
  81.         Push    Bp
  82.         Mov     Bp,Sp
  83.         Push    Ds
  84.         Cld                  ;set forward
  85.         Xor     Ax,Ax
  86.         Mov     Cx,SizeOf1
  87.         Dec     Cx           ;Max length is Allocated size - 1
  88.         Xor     Ch,Ch        ;In no case let str1 exceed 255
  89.         Les     Di,String1
  90.         Lds     Si,String2
  91.         Lodsb                ;length(S2)
  92.         Add     Al,Es:[Di]   ;+Length(S1)
  93.         jC      L1           ;exceeds 255, use Limit
  94.         Cmp     Al,Cl
  95.         jA      L1           ;exceeds Limit (use Limit)
  96.         Mov     Cl,Al        ;else use sum of lengths
  97.         Jmp     Short L2
  98. L1:     Mov     Al,Cl
  99. L2:     Sub     Cl,Es:[Di]   ;New length - old length(S1)
  100.         jBE     Done         ;New < Old, don't shorten
  101.         Xchg    Al,Es:[Di]   ;Put in new length, get old
  102.         Inc     Di           ;skip length byte
  103.         Add     Di,Ax        ;and original string to set dest
  104.         Rep     Movsb        ;Concatenate
  105. Done:   Pop     Ds
  106.         Pop     Bp
  107.         Ret     10
  108.  
  109. Concat          ENDP
  110.  
  111. CODE    ENDS
  112.  
  113.         END (Internal Example)
  114.  
  115.  
  116. CONST Result: RECORD
  117.         Len: BYTE;
  118.         Wrd: INTEGER;
  119.       END = (Len:2;Wrd:0);
  120. VAR
  121.   n: BYTE;
  122.   ResultString: STRING[2] Absolute Result;
  123.  
  124. BEGIN {Main Program}
  125.  
  126. {- Demonstrate HexByte -}
  127.   HexDigits:= '0123456789ABCDEF';
  128.   FOR n := 0 TO 255 DO BEGIN
  129.     WRITE(n:3,' ');
  130.     Result.Wrd := HexByte(n);
  131.     WRITE(ResultString,'  ');
  132.   END; {FOR n := 0 TO 255 DO }
  133.   WRITELN;
  134.  
  135. {- Demonstrate Concat -}
  136.   Str1 := 'String1';
  137.   WRITELN('Before Concat:  ',Str1);
  138.   FOR n := 1 TO 5 DO BEGIN
  139.     Concat(Str1,'String2',SizeOf(Str1));
  140.     WRITELN('After Concat',n,':  ',Str1);
  141.   END; {FOR n := 1 TO 5 DO }
  142.   Concat(Str1,'XXXXXXXXXXXX',45);
  143.   WRITELN('Partial Concat: ',Str1);
  144.  
  145.   WRITELN(#13#10'Press a key to exit'#13#10);
  146.   Asm Mov Ah,0;  {- Read from Keyboard -}
  147.   Asm Int 16h;
  148.  
  149. END. {Main}
  150.