home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPFORT18.ZIP / CALLFORT.ASM next >
Encoding:
Assembly Source File  |  1992-02-05  |  2.9 KB  |  107 lines
  1. ;   TPFORT v 1.8
  2. ;   Externals for FORTLINK unit
  3.  
  4.  
  5. data    segment word public
  6.  
  7.         extrn   procs:dword,numprocs:word
  8.         extrn   FortDS:word, FortSP:word
  9.  
  10. data    ends
  11.  
  12. code    segment byte public
  13.         public  SaveTPDS,callfort,fdouble,fsingle,fpointer,enter_pascal
  14.  
  15. TPDS     dw     ?                ; TPDS must be set during initialization
  16.  
  17. SaveTPDS proc near
  18.      cs: mov  TPDS,DS
  19.          ret
  20.  
  21. Initcall macro                   ; gets addresses in BX and BP
  22.          add    sp,4             ; get rid of return to Pascal stub
  23.          pop    cx               ; get procedure number
  24.          mov    sp,bp            ; get rid of any locals
  25.  
  26.          dec    cx
  27.          shl    cx,1
  28.          shl    cx,1
  29.          mov    bx,offset procs
  30.          add    bx,cx            ; BX = offset in proc table (in TP DS)
  31.          shl    cx,1
  32.          mov    bp,Fortsp
  33.          add    bp,cx            ; BP = offset in context table (in SS)
  34.  
  35.          pop    ax               ; keep saved BP in AX for now
  36.          pop    di               ; save return offset of original caller
  37.          pop    si               ; save return segment of original caller
  38. #EM
  39.  
  40. PushResult macro                    ; Pushes 16 bit address on stack where
  41.                                     ; function result should go
  42.          push   bp                  ; push result address
  43. #EM
  44.  
  45. Makecall macro               ; Restore BP, find Fortran address in Procs table,
  46.                              ; set Fortran DS, and call it
  47.          mov    bp,ax
  48.          push   ds
  49.          pop    es
  50.          mov    ds,FortDS
  51.      es: call   far d[bx]
  52. #EM
  53.  
  54. Exitcall macro               ; Restore TP DS, BP, and return to original caller
  55.      cs: mov    ds,TPDS
  56.          push   si           ; Push back return segment
  57.          push   di           ; and offset
  58.          retf                ; returns directly to original caller
  59. #EM
  60.  
  61. callfort proc far
  62.          Initcall
  63.          Makecall
  64.          Exitcall
  65.          endp
  66.  
  67.  
  68. fdouble  proc far
  69.          Initcall
  70.          PushResult
  71.          Makecall
  72.          mov    ds,dx
  73.          mov    bx,ax
  74.          fld    q[bx]               ; load function result
  75.          Exitcall
  76.          endp
  77.  
  78. fsingle  proc far
  79.          Initcall
  80.          PushResult
  81.          Makecall
  82.          mov    ds,dx
  83.          mov    bx,ax
  84.          fld    d[bx]               ; load function result
  85.          Exitcall
  86.          endp
  87.  
  88. fpointer proc far
  89.          Initcall
  90.          PushResult
  91.          Makecall
  92.          Exitcall
  93.          endp
  94.  
  95. enter_pascal proc far
  96.         pop     ax           ; get our return address
  97.         pop     bx
  98.         pushf                ; save the flags, DS, SI, and DI
  99.         push    ds
  100.         push    si
  101.         push    di
  102.     cs: mov     ds,TPDS      ; load the TP data segment
  103.         push    bx           ; put back our return address
  104.         push    ax
  105.         retf
  106.         endp
  107.