.IDENT "5-013" ; Version and edit numbers. .TITLE BLI$CALLG ; CALLG emulator for ALPHA ; ; BLI$CALLG ; ; COPYRIGHT (C) 1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, ; 1984, 1986, 1987, 1988, 1989, 1990 ; ; Digital Equipment Corporation, Maynard, Massachusetts 01754 ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the inclu- ; sion of the above copyright notice. This software, or any ; other copies thereof, may not be provided or otherwise made ; available to any other person except for use on such system ; and to one who agrees to these license terms. Title to and ; ownership of the software shall at all times remain in DEC. ; ; The information in this software is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation. ; ; DEC assumes no responsibility for the use or reliability of ; its software on equipment which is not supplied by DEC. ; ; FACILITY: ; ; BLISS GEM-based Compiler ; ; ABSTRACT: ; ; This EVAX assembler program is intended to provide a ; fake VAX CALLG facility on EVAX. ; ; Parameters: ; ; R16 Address of base of 256 longword vector ; containing VAX-style format block. ; R17 Address of the routine to call. ; ; It is assumed that the first longword ; will have the number of arguments in it. ; ; Routine return value: ; ; Value of the routine that is called from here. ; ; Equivalent BLISS code: ; ; This is the equivalent BLISS code (more or less). ; ; ROUTINE Bli$callg(Args: REF VECTOR[256, LONG,Rtn) = ; BEGIN ; ; REGISTER R16,R17,R18,R19,R20,R21; ; ; IF .A[0] GTR 6 THEN ; BEGIN ; ; STACKLOCAL S: VECTOR[256, LONG]; ; ; LOCAL Count; ; ; Count = .Args[0]; ; INCR I FROM 0 TO (.Args[0] - 6) DO ; BEGIN ; S[.I] = .Args[.Count]; ; Count = .Count - 1; ; END; ; END; ; ; R16 = .Args[1]; ; R17 = .Args[2]; ; R18 = .Args[3]; ; R19 = .Args[4]; ; R20 = .Args[5]; ; R21 = .Args[6]; ; ; (.Rtn)(R16,R17,R18,R19,R20,R21) ; END; ; ; ; ** What do we do for BLISS-64E? There we want everything ** ; ** to be 64 bits. For BLISS-32E, we have to assume the ** ; ** vector elements are 32 bits. ** ; ; AUTHORS: ; ; Andrew W. Fuellemann ; ; CREATION DATE: 2-Apr-1990 ; ; MODIFICATION HISTORY: ; ; Date ! Name ! Description ;_______________!_______!_______________________________________________________ ; 2-Apr-1990 ! AWF ! 5-000 Created. ; 20-Nov-1990 ! AWF ! 5-001 Finally ran this through the simulator and ; ! ! fixed alot of bugs. Now it works. ; 21-Mar-1991 ! AWF ! 5-002 Change attributes of linkage psect so the ; ! ! ALPHA assembler can handle it. ; 11-Apr-1991 ! AWF ! 5-003 Modified procedure descriptor and added use ; ! ! of OTS_CALL_PV for exception handling stuff. ; 30-May-1991 ! AWF ! 5-004 Modified procedure descriptor again. Now use ; ! ! ^x1889 instead of ^x1449. Also added a title ; ! ! and ident. ; 18-Jun-1991 ! AWF ! 5-005 Added conditional compilation of psects to ; ! ! support the MACRO64 assembler. ; 16-Sep-1991 ! AWF ! 5-006 Change "OTS_" to "OTS$" for REV 4. ; 30-Sep-1991 ! AWF ! 5-007 Modified the PDSC$* comment to be correct. ; 30-Sep-1991 ! AWF ! 5-008 Use OTS$CALL_PROC instead of OTS$CALL_PV. ; 31-Jan-1992 ! AWF ! 5-009 Use .procedure_descriptor directive. ; 6-Apr-1992 ! AWF ! 5-010 DRAINT is obsolete, use TRAPB instead. (PPA) ; 13-Apr-1992 ! AWF ! 5-011 Only parameters that are there get stuffed into ; ! ! the parameter registers. ; 24-Jun-1992 ! AWF ! 5-012 Zero out R24 before calling OTS$CALL_PROC. This ; ! ! prevents ACCVIOS when a translated routine ; ! ! address has been passed in. This fix provided ; ! ! Tom Hoey (EVMS::). ; 27-Jul-1992 ! AWF ! 5-013 The FT4 image activator has new support that ; ! ! requires the signature block to be 1 according ; ! ! to the calling standard. This change provided ; ! ! by Tom Hoey (EVMS::). ;------------------------------------------------------------------------------- ; ; Linkage section for BLI$CALLG .if defined MACRO64$ .psect $LINK$,OCTA,NOPIC,CON,REL,LCL,NOSHR,NOEXE,RD,NOWRT .if_false .psect $LINK,9,NOEXE,NOWRT .endc ; Read only after image activate ; .procedure_descriptor BLI$CALLG, BLI_CALLG_ENTRY ; Frame descriptor for stack frame procedure BLI_CALLG ; ; .psect $GLOBAL ; .WORD ^x1889 ; PDSC$V_BASE_REG_IS_FP = 1 ; PDSC$V_NO_JACKET = 1 ; PDSC$K_KIND_FP_REGISTER = 1 ; PDSC$V_NATIVE = 1 .WORD 8 .LONG 0 ; reserved, MBZ, Signature offset .address BLI_CALLG_ENTRY ; Address of entry point of code for procedure. .long 32 ; Size of the area between FP and entry SP. .long 0 ; Reserved longword. .long <1@14>!<1@29> ; IREG mask .long 0 ; FREG mask OTS$CALL_ADDR: .ADDRESS OTS$CALL_PROC ; Need this address for the dispatch. ; ; Entry code sequence for procedure BLI_CALLG ; .if defined MACRO64$ .psect $CODE$,QUAD,PIC,CON,REL,LCL,SHR,EXE,NORD,NOWRT .if_false .psect $CODE .endc ; Code for BLI_CALLG ; BLI_CALLG_ENTRY: ; Address of BLI_CALLG's frame decriptor ; is in R27 on standard call, Return address ; is in R26. ; .MACRO MOV SRC,DES ; Macro to move contents of SRC register to DES register BIS SRC, R31, DES ; Do a logical sum using the null register (R31). .ENDM MOV ; ; Set up a stack frame for BLI_CALLG and store return addresses and other useful stuff. ; TRAPB ; Raise any pending hardware exceptions ; before doing anything else. LDA SP, -32(SP) ; Allocate stack space for BLI_CALLG stack frame. STQ R27, 00(SP) ; Save the address of the procedure descriptor. STQ R26, 08(SP) ; Save return address. STQ R14, 16(SP) ; Save preserved R14. STQ R29, 24(SP) ; Save caller's frame pointer. MOV SP, R29 ; BLI_CALLG is now the current procedure. ; ; Set up the argument list and make the call to the routine that was passed in. ; MOV R16, R0 ; Save the pointer to the argument list. MOV R17, R14 ; Save the pointer to the address of the ; routine to be called. ; ; Need to set the lower byte of the AI register (R25) to the # of arguments passed. ; ; Local variables: ; ; R24 Number of arguments. ; R23 Comparison result. ; ; Equivalent BLISS: ; ; IF .A[0] GTR 6 THEN ; LDL R25, 0(R0) ; Get the argcount. EXTBL R25, #0, R25 ; Zero the rest of the register ; except for the first byte. CMPLE R25, #6, R23 ; Is (R25) <= 6. BNE R23, CALL ; Then no parameters to push on stack. ; ; There are more than 6 parameters. Put them on the stack. Deal with ; the first six parameters later. ; ; Local variables: ; ; R0 Address of the argument to be placed on stack. ; R18 Counter. Temporary argument offset. ; R23 Comparison result. ; R24 Number of remaining arguments. ; ; Equivalent BLISS: ; ; STACKLOCAL S: VECTOR[256, LONG]; ; ; LOCAL Count; ; ; Count = .Args[0]; ; SUBQ R25, #6, R24 ; Get the number of remaining args. LDA SP, -2000(SP) ; Allocate 250 quadwords on the stack. ; ; Initialize the stack with the operands for the routine to be called. ; Push them onto the stack in reverse order. N, N-1, N-2, . . . . ; ; Local variables: ; ; R22 Dummy holder. ; R20 Temp stack holder. ; ; Equivalent BLISS: ; ; INCR I FROM 0 TO (.Args[0] - 6) DO ; BEGIN ; S[.I] = .Args[.Count]; ; Count = .Count - 1; ; END; ; MOV R31, R18 ; Zero out R18 at this point. MOV SP, R20 ; Copy the stack pointer LOOP: LDL R22, 28(R16) ; Get address of argument from memory ADDQ R18, #1, R18 ; Increment the counter. STQ R22, (R20) ; Put operand on stack. LDA R16, 4(R16) ; Get address of next parameter. LDA R20, 8(R20) ; Bump the stack pointer to the next quadword. CMPEQ R18, R24, R23 ; Test to see if finished. BEQ R23, LOOP ; If not done, keep looping. ; ; Store the first six operands. R16 - R21 are only scratch registers. Only load ; operands that are there. If not, we might ACCVIO. ; ; Equivalent BLISS: ; ; R16 = .Args[1]; ; R17 = .Args[2]; ; R18 = .Args[3]; ; R19 = .Args[4]; ; R20 = .Args[5]; ; R21 = .Args[6]; ; CALL: CMPLE R25, #0, R23 ; Is (R25) <= 0. BNE R23, CALL_S ; Then there are no more parameters to put into registers. LDL R16, 04(R0) CMPLE R25, #1, R23 ; Is (R25) <= 1. BNE R23, CALL_S ; Then there are no more parameters to put into registers. LDL R17, 08(R0) CMPLE R25, #2, R23 ; Is (R25) <= 2. BNE R23, CALL_S ; Then there are no more parameters to put into registers. LDL R18, 12(R0) CMPLE R25, #3, R23 ; Is (R25) <= 3. BNE R23, CALL_S ; Then there are no more parameters to put into registers. LDL R19, 16(R0) CMPLE R25, #4, R23 ; Is (R25) <= 4. BNE R23, CALL_S ; Then there are no more parameters to put into registers. LDL R20, 20(R0) CMPLE R25, #5, R23 ; Is (R25) <= 5. BNE R23, CALL_S ; Then there are no more parameters to put into registers. LDL R21, 24(R0) ; ; Do the call. ; ; Equivalent BLISS: ; ; (.Rtn)(R16,R17,R18,R19,R20,R21) ; ; If a literal "0" was passed in, we skip to here. ; VAX/VMS CALLG can handle this so we have to do the same. ; CALL_S: LDQ R27, (R27) ; Load the procedure descriptor address of OTS$CALL_PROC from ; the linkage section into R27 for the JMP to OTS$CALL_PROC. LDQ R26, 08(R27) ; Load the code address for OTS$CALL_PROC into R26. MOV R14, R23 ; Move the target routine's PD address into R23 where ; OTS$CALL_PROC needs to find it. LDA R24, 1(R31) ; Default signature block JSR R26, (R26) ; Jump to OTS$CALL_PROC. The return address is ; in RA register (R26). ; ; Return to caller gracefully. (I hope.) ; TRAPB ; Force any pending hardware exceptions to happen. MOV R29, SP ; Restore the SP to the beginning of the frame. LDQ R26, 08(R29) ; Get the return address. LDQ R14, 16(R29) ; Restore R14. LDQ R29, 24(R29) ; Restore the caller's frame pointer. LDA SP, 32(SP) ; Restore entry SP. JSR R31, (R26) ; Return to caller with result in R0. ; .END ; End of procedure