Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!milano!cadillac!davide From: davide@maverick.cad.mcc.com (David Eckelkamp) Newsgroups: comp.lang.scheme Subject: integrated patch for Scheme->C (Part 3/3) Message-ID: Date: 13 Nov 90 14:41:20 GMT Sender: news@cadillac.CAD.MCC.COM Reply-To: eckelkamp@mcc.com (David Eckelkamp) Organization: MCC CAD Program, Austin, Texas Lines: 1175 *** /dev/null Fri Nov 9 17:25:01 1990 --- APOLLO Sun Nov 4 11:59:41 1990 *************** *** 0 **** --- 1,36 ---- + # + # This is the header file for constructing make files for Apollo 3000 + # series processors (DN3000, DN3500, DN4000, DN4500). + # + + .SUFFIXES: + .SUFFIXES: .o .c .sc .s .asm .bin + + # Processor name: + + cpu = APOLLO + + # Default flags to use when invoking the C compiler. + + OPT = -O + CFLAGS = $(OPT) -A cpu,3000 -A sys,bsd4.3 + CC = cc + + # Assembly language object files. + + Aruntime = apollo.o + + # The assembler does not normally come with Domain/OS. If you don't have the + # assembler, then you can just use the apollo.o file that is supplied. + ASM = /usr/apollo/bin/asm + AFLAGS = -nl -dba + + # Profiled library + + Plib = # libsc_p.a + + # Heap size in megabytes for the compiler. + + scheapmb = 8 -scl 40 + + # End of APOLLO header. *** /dev/null Fri Nov 9 17:25:04 1990 --- I386 Sun Nov 4 11:52:02 1990 *************** *** 0 **** --- 1,29 ---- + # + # This is the header file for constructing make files for I386 processors. + # + + .SUFFIXES: + .SUFFIXES: .o .c .sc .s .u + + # Processor name: + + cpu = I386 + + # Default flags to use when invoking the C compiler. + + CFLAGS = -O -DSYSV + CC = gcc + + # Assembly language object files. + + Aruntime = i386.o + + # Profiled library + + Plib = + + # Heap size in megabytes for the compiler. + + scheapmb = 4 -scl 40 + + # End of I386 header. *** /dev/null Fri Nov 9 17:25:07 1990 --- PRISM Sun Nov 4 11:59:45 1990 *************** *** 0 **** --- 1,36 ---- + # + # This is the header file for constructing make files for Apollo 10000 + # series processors. + # + + .SUFFIXES: + .SUFFIXES: .o .c .sc .s .asm .bin + + # Processor name: + + cpu = PRISM + + # Default flags to use when invoking the C compiler. + + OPT = -O + CFLAGS = $(OPT) -A cpu,a88k -A sys,bsd4.3 + CC = cc + + # Assembly language object files. + + Aruntime = prism.o + + # The assembler does not normally come with Domain/OS. If you don't have the + # assembler, then you can just use the prism.o file that is supplied. + ASM = /sr/apollo/bin/asm + AFLAGS = -dba + + # Profiled library + + Plib = + + # Heap size in megabytes for the compiler. + + scheapmb = 8 -scl 40 + + # End of PRISM header. *** /dev/null Fri Nov 9 17:25:10 1990 --- SPARC Sun Nov 4 11:52:12 1990 *************** *** 0 **** --- 1,29 ---- + # + # This is the header file for constructing make files for SPARC processors. + # + + .SUFFIXES: + .SUFFIXES: .o .c .sc .s .u + + # Processor name: + + cpu = SPARC + + # Default flags to use when invoking the C compiler. + + CFLAGS = -g + CC = cc + + # Assembly language object files. + + Aruntime = sparc.o + + # Profiled library + + Plib = + + # Heap size in megabytes for the compiler. + + scheapmb = 8 -scl 40 + + # End of SPARC header. *** /dev/null Fri Nov 9 17:25:11 1990 --- SUN3 Mon Nov 5 11:42:51 1990 *************** *** 0 **** --- 1,29 ---- + # + # This is the header file for constructing make files for the Sun3 + # + + .SUFFIXES: + .SUFFIXES: .o .c .sc .s + + # Processor name: + + cpu = SUN3 + + # Default flags to use when invoking the C compiler. + + CFLAGS = -O + CC = cc + + # Assembly language object files. + + Aruntime = sun3.o + + # Profiled library + + Plib = + + # Heap size in megabytes for the compiler. + + scheapmb = 8 -scl 40 + + # End of Sun3 header. *** /dev/null Fri Nov 9 17:25:47 1990 --- scrt/apollo.asm Thu Nov 1 08:02:47 1990 *************** *** 0 **** --- 1,229 ---- + * apollo.asm - Apollo specific module for DEC's Scheme->C + * + * This file implements the assembly language part of the Apollo port, + * specifically for the DN3000 and DN4000 series, that is, depending on + * the M68020 CPU and M68881 FPP. + * + * Included are all the necessary math routines to catch integer overflow. + * + * This file is written for PIC (Position Independent Code), to build + * a shared library. + * + * Ray Lischner (uunet!mntgfx!lisch) + * 26 April 1990 + + module sc_apollo + cpu 68020,68881 + sri 68020 + + entry sc_setregs + entry sc_regs + entry sc_iplus + entry sc_idifference + entry sc_inegate + entry sc_itimes + + data + + * set up jump tables for calling PIC routines + data_start equ * + + sc_iplus lea data_start,a0 + jmp.l sc$iplus + sc_idifference lea data_start,a0 + jmp.l sc$idifference + sc_inegate lea data_start,a0 + jmp.l sc$inegate + sc_itimes lea data_start,a0 + jmp.l sc$itimes + + * set up transfer address for external PIC routines + extern sc_makefloat64 + sc$makefloat64 ac sc_makefloat64 + + text + + *********************************************************************** + * void sc_setregs(int* a6, int* a7) + * Apollo's longjmp() checks to see if the jump is backwards in the stack. + * If not, it assumes that something is wrong and ungracefully terminates + * the program. Since we don't want this to happen, we need to fake + * out Domain/OS. This is done by setting the stack pointer (a7) and + * frame pointer (a6) to the destination frame, thus circumventing + * longjmp's checks. + * + * To accomplish this takes some clever tricks. First, we need to know + * how the stack is layed out: + * + * (lower addresses) + * +----------------------------+ + * A7 | local storage ... | + * +----------------------------+ + * A6 | link to previous frame | + * +----------------------------+ + * | return address | + * +----------------------------+ + * | arguments pushed by caller | + * +----------------------------+ + * (higher addresses) + * Note that we are ignoring floating point control blocks. + * + * The caller pushes the desired values for A7 and A6. On entry to sc_setregs(), + * A6 points to the caller's frame, and A7 points to the return address. + * We can retrieve the caller's arguments by dereferencing a7: the second + * argument is in 8(a7), and the first is in 4(a7). We can just copy + * them into the registers we want, but first we need to save the return + * address before we lose the pointer to it. It is saved in A0, at the + * same time we load A6 and A7. Clever, isn't it? After getting the new + * register values, we know that the caller will try to pop the + * arguments off the stack by adding 8 to A7. We circumvent this by + * subtracting 8 now. + + sc_setregs procedure "sc_setregs",nocode + movem.l (a7),a0/a6-a7 + subq.l #8,a7 + jmp (a0) + + *********************************************************************** + * void sc_regs(int regs[12]) + * sc_regs returns the values of a1-a4, d0-d7 in the caller supplied buffer. + * These are the "callee" save registers that need to be examined during + * garbage collection. + + sc_regs procedure "sc_regs",#-4 + move.l 8(a6),a0 * a0 := ®s[0] + movem.l d0-d7/a1-a4,(a0) * save the interesting registers + return sc_regs + + *********************************************************************** + * The following routines are for doing arithmetic on tagged numbers. + * The input arguments are tagged integers, that is, integers shifted + * left by two bits. (Except for sc_itimes, where only the second + * argument, b, is shifted.) This makes it easier to check for overflow, + * but we must unshift the values before calling sc_makefloat64(). + * + * When the result of any operation overflows, the operands are converted + * to floating point, and the operation is repeated. The floating point + * result is then passed to sc_makefloat64() to produce a float object + * to return. + + * int sc_iplus(int a, int b) + * returns the integer sum, a + b, where a and b are the two + * integer arguments, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( (double)a + (double)b ) instead. + + sc$iplus procedure "sc_iplus",#0,a5 + move.l a0,a5 + * add the arguments + move.l 8(a6),d0 + move.l 12(a6),d1 + add.l d1,d0 + * if the operation overflows, we know to use floating point + bvc 1$ + + * otherwise, convert to floating point and add + move.l 8(a6),d0 + asr.l #2,d0 + fmove.l d0,fp0 + * note that d1 still contains "b" + asr.l #2,d1 + fmove.l d1,fp1 + fadd fp1,fp0 + * pass the floating point sum to sc_makefloat64 + fmove.d fp0,-(sp) + move.l sc$makefloat64,a0 + jsr (a0) + addq.l #8,sp + + 1$ return sc$iplus + + + * int sc_idifference(int a, int b) + * returns integer difference, a - b, where a and b are the two + * integer arguments, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( (double)a - (double)b ) instead. + * + + sc$idifference procedure "sc_idifference",#0,a5 + move.l a0,a5 + * subtract the arguments + move.l 8(a6),d0 + move.l 12(a6),d1 + sub.l d1,d0 + * if the operation overflows, we know to use floating point + bvc 1$ + + * otherwise, convert to floating point and subtract + move.l 8(a6),d0 + asr.l #2,d0 + fmove.l d0,fp0 + * note that d1 still contains "b" + asr.l #2,d1 + fmove.l d1,fp1 + fsub fp1,fp0 + * pass the floating point sum to sc_makefloat64 + fmove.d fp0,-(sp) + move.l sc$makefloat64,a0 + jsr (a0) + addq.l #8,sp + + 1$ return sc$idifference + + * int sc_inegate(int a) + * returns integer negation, -a, where a is the integer + * argument, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( -(double)a) instead. + * + + sc$inegate procedure "sc_inegate",#0,a5 + move.l a0,a5 + * negate the argument + move.l 8(a6),d0 + move.l d0,d1 + neg.l d0 + * if the operation overflows, we know to use floating point + bvc 1$ + + * otherwise, convert to floating point and negate + asr.l #2,d1 + fmove.l d1,fp1 + fneg fp1,fp0 + * pass the floating point sum to sc_makefloat64 + fmove.d fp0,-(sp) + move.l sc$makefloat64,a0 + jsr (a0) + addq.l #8,sp + + 1$ return sc$inegate + + * sc_itimes(int a, int b) + * returns integer procuct, a * b, where a and b are the two + * integer arguments, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( (double)a * (double)b ) instead. + * Unlike the previous arithmetic functions, only "b" has been shifted. + + sc$itimes procedure "sc_itimes",#0,a5 + move.l a0,a5 + * multiply the arguments + move.l 8(a6),d0 + move.l 12(a6),d1 + muls.l d1,d0 + + * if the operation overflows, we know to use floating point + bvc 1$ + + * otherwise, convert to floating point and multiply + fmove.l 8(a6),fp0 + * note that d1 still contains "b" + asr.l #2,d1 + fmove.l d1,fp1 + fmul fp1,fp0 + * pass the floating point sum to sc_makefloat64 + fmove.d fp0,-(sp) + move.l sc$makefloat64,a0 + jsr (a0) + addq.l #8,sp + + 1$ return sc$itimes + + end *** /dev/null Mon Nov 12 09:28:29 1990 --- scrt/apollo.o.uu Mon Nov 12 09:26:54 1990 *************** *** 0 **** --- 1,69 ---- + begin 444 apollo.o + M 9< "28WDLH DT '0 L@ X 0 ! #) "P @ + M 0 (?@ "YT97AT "!J @:@ $$ !J + M @ " N=6YW:6YD @JP (*L > JP B* + M ' @+F1A=&$ 0 $ "P + M( @"YB;&]C:W, $ + ! "P '@ #) "- 0 # N + M;&EN97, ! @P 0(, D@ !00 P +G-Y;6)O + M;', 0*> $"G@ I8 66 , "YR=V1I $% + M- !!30 X (+ "/@ 8 ! N;6ER + M &@ "&0 ( +G-R:0 P + M A^ " $S7P0!1CT[03E;__"!N A(T![_3EY.=4Y6 + M O#2I(("X ""(N S0@6@ "(@+@ (Y(#R $ Y('R 4" \@ $(O(G= @ + M;0 H3I!0CRIN__Q.7DYU3E8 "\-*D@@+@ ((BX #)"!: (B N CD@/( + M0 #D@?(!0(#R 0H\B=T "!M "A.D%"/*F[__$Y>3G5.5@ +PTJ2" N @B + M $2 : &.2!\@% @/( !!KR)W0 (&T *$Z04(\J;O_\3EY.=4Y6 O#2I( + M("X ""(N Q, 0@ : 'O(N0 ".2!\@% @/( !"/R)W0 (&T *$Z04(\J + M;O_\3EY.=0 "!J ! @0 !X @:@ @# @ + M @; ! ! /____P (' ^ 2 #____\ "!_@ /@$@ + M _____ @CP #(!( /____P ()N \ 2 #____\ 0 ! @ + M 4 !P #H : +@ > " $ $"# ! IX (&H $ , %* + M"O-, !*@0 5P @ / 0 "P ! 0 + M $ (" * $^ ( $ ( , $ 0! " + M @ "@ !(0 " * ! $ # " ! ' 0 @( H + M 0$ @ % 0 #X P !@ 0 "H$ (" * + M #B ( !X $ ^ , !6 $ !%! " @ "@ R0 " + M H ! ,@ # E ! 8 0 @( *P @ ,@ + M 0 #P P ,8 0 '@; (@O+VIE;&QI;W1T+VQO8V%L7W5S97(O + M9VYU+G-R8RYP ! "YL + M:6YE

6UB;VQS $" + MG@ & # 0 I8 "YR=V1I $%- ' # 0 + M #@ !@ "YM:7( ( # 0 !H + M "YSC + * + * This file implements the assembly language part of the Prism port, + * specifically for the DN10000. + * + * Included are all the necessary math routines to catch integer overflow. + * + * NOTE: Don't even try to read this file if you do not understand + * how an Apollo Prism (also called an AT, for Advanced Technology; + * perhaps Apollo thinks the Prism is as good as an IBM PC AT :-) works. + * I have tried to optimize the parallel operations, such as branch and + * call shadows, and combining integer and floating point operations. + * (The former are common; the latter are rare in this file.) + * + * The sematics of b.sa are completely different from b.sn, and the + * subtle differences are too lengthy to discuss here. Read the + * various Apollo manuals, such as the AT Assembler Reference and + * the AT Technical Reference. + * + * Apollo's setjmp/longjmp do not permit jumps to random locations in the + * stack, so we must write our own. On the DN3000 (M68K), we can get away + * with simply altering the stack and frame pointers (A6 and A7) before + * calling longjmp, but on the Prism this does not work because longjmp + * only jumps to a valid stack frame. I tried modifying call/cc to + * restore the stack and registers before calling longjmp(), but this + * does not work because it changes the data base register, which messes + * up the call to longjmp. The simplest solution is to reimplemen]t + * setjmp and longjmp. + * + * Another reason to write our own setjmp/longjmp is to make sure all + * the registers are saved properly. The standard jmp_buf does not have + * enough room to save all the needed registers. + * + * Ray Lischner (uunet!mntgfx!lisch) + * 1 May 1990 + + module sc_prism + + export.f prism_stack_frame + export.p sc_longjmp + export.f sc_setjmp + export.p sc_regs + export.f sc_iplus + export.f sc_idifference + export.f sc_inegate + export.f sc_itimes + + import.f sc_makefloat64 + import.f sigblock + import.f sigsetmask + + data + + * set up ECBs for all the functions that need one + data_frame equ * + + sc_setjmp procedure ok + .0 = sc$setjmp ; get the relocatable address of the routine + .1 = .sf ; save the old stack frame + .2 = #data_frame ; get the relocatable data frame + b.sa [.0] ; branch to the real routine + [--.sf,#16] = .1 ; push the old .SF onto the stack + + sc_longjmp procedure ok + .0 = sc$longjmp ; get the relocatable address of the routine + .1 = .sf ; save the old stack frame + .2 = #data_frame ; get the relocatable data frame + b.sa [.0] ; branch to the real routine + [--.sf,#16] = .1 ; push the old .SF onto the stack + + sc_idifference procedure ok + .0 = sc$idifference ; get the relocatable address of the routine + .1 = .sf ; save the old stack frame + .2 = #data_frame ; get the relocatable data frame + b.sa [.0] ; branch to the real routine + [--.sf,#16] = .1 ; push the old .SF onto the stack + + sc_inegate procedure ok + .0 = sc$inegate ; get the relocatable address of the routine + .1 = .sf ; save the old stack frame + .2 = #data_frame ; get the relocatable data frame + b.sa [.0] ; branch to the real routine + [--.sf,#16] = .1 ; push the old .SF onto the stack + + sc_iplus procedure ok + .0 = sc$iplus ; get the relocatable address of the routine + .1 = .sf ; save the old stack frame + .2 = #data_frame ; get the relocatable data frame + b.sa [.0] ; branch to the real routine + [--.sf,#16] = .1 ; push the old .SF onto the stack + + sc_itimes procedure ok + .0 = sc$itimes ; get the relocatable address of the routine + .1 = .sf ; save the old stack frame + .2 = #data_frame ; get the relocatable data frame + b.sa [.0] ; branch to the real routine + [--.sf,#16] = .1 ; push the old .SF onto the stack + + * jump table for the ECBs + sc$setjmp data.l sc$$setjmp + sc$longjmp data.l sc$$longjmp + sc$idifference data.l sc$$idifference + sc$inegate data.l sc$$inegate + sc$iplus data.l sc$$iplus + sc$itimes data.l sc$$itimes + + * relocation table for the external functions + sc$makefloat64 data.l sc_makefloat64 + sig$setmask data.l sigsetmask + sig$block data.l sigblock + proc + + *********************************************************************** + * int prism_stack_frame(void) + * Return the caller's stack frame pointer. See the STACKPTR macro + * in heap.h for how this is called. + + prism_stack_frame procedure ok + b.sa [.return] + .0 = .sf + + + *********************************************************************** + * int sc_setjmp(jmp_buf buf) + * Save the current signal mask, processor status words, and preserved + * registers in the caller-supplied buffer, and return zero. + + sc$$setjmp procedure name="sc_setjmp",return=save,stack=(),save=1$ + [.sf,4] = .4 + [.sf,8] = .return + [.sf,12] = .10 + .10 = .2 + using .10, data_frame + 1$ .0 = .ipsw ; and the processor status words + [.4++] = .0 + .0 = .fppsw + [.4++] = .0 + .0 = [.sf,12] ; old value of .10 + [.4++] = .0 + [.4++] = .11 + [.4++] = .12 + [.4++] = .13 + [.4++] = .14 + [.4++] = .15 + [.4++] = .16 + [.4++] = .17 + [.4++] = .18 + [.4++] = .19 + [.4++] = .20 + [.4++] = .21 + [.4++] = .return + .0 = [.sf] + [.4++] = .0 + + .3 = sig$block ; and the current signal mask + .return = call.sa [.3] ; sigblock(0) + .4 = .null + .4 = [.sf,4] + [.4++] = .0 + + .10 = [.sf,12] ; restore the saved registers + .return = [.sf,8] + .0 = .null + b.sa [.return] ; return(0) + .sf = [.sf] + + drop .10 + endp + + * void longjmp(jmp_buf buf, int rtn) + * Jump to the location saved by a previous call to setjmp(), such that + * it looks to the caller of setjmp() as though setjmp returned "rtn". + * If "rtn" is zero, one is returned. + + sc$$longjmp procedure name="sc_longjmp",return=save,stack=(),save=1$ + [.sf,8] = .return + using .2, data_frame + 1$ .cc = .5 + .0 = [.4++] + bnz.sf 2$ ; make sure the return value is non-zero + .5 = #1 + 2$ .ipsw = .0 + .0 = [.4++] + .fppsw = .0 + .10 = [.4++] + .11 = [.4++] + .12 = [.4++] + .13 = [.4++] + .14 = [.4++] + .15 = [.4++] + .16 = [.4++] + .17 = [.4++] + .18 = [.4++] + .19 = [.4++] + .20 = [.4++] + .21 = [.4++] + .0 = [.4++] + [.sf,8] = .0 ; save the return PC + .0 = [.4++] + [.sf] = .0 ; save .sf + [.sf,4] = .5 ; save return value + + .3 = sig$setmask ; restore the signal mask + .return = call.sa [.3] + .4 = [.4] + + .0 = [.sf,4] ; return the user-supplied "rtn" + .return = [.sf,8] + b.sa [.return] + .sf = [.sf] + endp + + *********************************************************************** + * void sc_regs(int regs[12]) + * sc_regs stores the values of .10 - .21 in the caller supplied buffer. + * These are the "callee" save registers that need to be examined during + * garbage collection. + + sc_regs procedure ok + [.4++] = .10 + [.4++] = .11 + [.4++] = .12 + [.4++] = .13 + [.4++] = .14 + [.4++] = .15 + [.4++] = .16 + [.4++] = .17 + [.4++] = .18 + [.4++] = .19 + [.4++] = .20 + b.sa [.return] + [.4] = .21 + endp + + *********************************************************************** + * The following routines are for doing arithmetic on tagged numbers. + * The input arguments are tagged integers, that is, integers shifted + * left by two bits. (Except for sc_itimes, where only the second + * argument, b, is shifted.) This makes it easier to check for overflow, + * but we must unshift the values before calling sc_makefloat64(). + * + * When the result of any operation overflows, the operands are converted + * to floating point, and the operation is repeated. The floating point + * result is then passed to sc_makefloat64() to produce a float object + * to return. + + + * int sc_iplus(int a, int b) + * returns the integer sum, a + b, where a and b are the two + * integer arguments, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( (double)a + (double)b ) instead. + + sc$$iplus procedure name="sc_iplus",return=save,stack=(),save=1$ + [.sf,8] = .return + * add the arguments + 1$ .0.cc = .4 + .5 ; try adding the arguments as integers + .4 = .4 SHRA #2 ; wait 1 cycle until CCs set + bnv.sf 2$ ; return if the integer operation worked + .5 = .5 SHRA #2 ; otherwise keep working + .fs0.i = .5 ; convert the integers to floating point + .fs1.i = .4 + .fd8 = float(.fs1.i) + .fd0 = float(.fs0.i) + * get ready to call makefloat64, while adding the operands + .3 = sc$makefloat64, .fd8 += .fd0 + .return = call.sn [.3] ; call sc_makefloat64() + nop + .return = [.sf,8] ; pop the return PC + + 2$ b.sa [.return] ; return + .sf = [.sf] ; restore the old .SF + endp + + + * int sc_idifference(int a, int b) + * returns integer difference, a - b, where a and b are the two + * integer arguments, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( (double)a - (double)b ) instead. + + sc$$idifference procedure ok,name="sc_idifference" + [.sf,8] = .return + * subtract the arguments + 1$ .0.cc = .4 - .5 ; try subtracting the arguments as integers + .4 = .4 SHRA #2 ; wait 1 cycle until CCs set + bnv.sf 2$ ; return if the integer operation worked + .5 = .5 SHRA #2 ; otherwise keep working + .fs0.i = .5 ; convert the integers to floating point + .fs1.i = .4 + .fd8 = float(.fs1.i) + .fd0 = float(.fs0.i) + * get ready to call makefloat64, while subtracting the operands + .3 = sc$makefloat64, .fd8 -= .fd0 + .return = call.sn [.3] ; call sc_makefloat64() + nop + .return = [.sf,8] ; pop the return PC + + 2$ b.sa [.return] ; return + .sf = [.sf] ; restore the old .SF + endp + + * int sc_inegate(int a) + * returns integer negation, -a, where a is the integer + * argument, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( -(double)a) instead. + + sc$$inegate procedure ok,name="sc_inegate" + [.sf,8] = .return + * negate the argument + 1$ .0.cc = -.4 ; try negating the argument as an integer + .4 = .4 SHRA #2 ; wait 1 cycle until CCs set + bnv.sf 2$ ; return if the integer operation worked + .fs0.i = .4 ; otherwise keep working + .fd8 = float(.fs0.i) ; convert the argument to floating point + * get ready to call makefloat64, while negating the argument + .3 = sc$makefloat64, .fd8 = -.fd8 + .return = call.sn [.3] ; call sc_makefloat64() + nop + .return = [.sf,8] ; pop the return PC + + 2$ b.sa [.return] ; return + .sf = [.sf] ; restore the old .SF + endp + + * sc_itimes(int a, int b) + * returns integer procuct, a * b, where a and b are the two + * integer arguments, unless integer overflow occurs, then returns + * (unsigned int) sc_makefloat64( (double)a * (double)b ) instead. + * Unlike the previous arithmetic functions, only "b" has been shifted. + * + * This is a pain on a Prism because we need to use the floating + * point unit for the integer multiply, and that means we cannot + * set the integer condition codes. Instead, we do a normal + * floating point multiply and explicitly check the result to see + * if it fits into an integer. If not, we divide by 4 to get the + * true result. Note that this does not affect the precision + * of the result. + + sc$$itimes procedure name="sc_itimes",return=save,stack=(),save=1$ + [.sf,8] = .return + 1$ .fs0.i = .4 ; load floating point registers for the + .fs1.i = .5 ; multiplication + .fd8 = float(.fs0.i) + .fd2 = float(.fs1.i) + * do the multiply; at the same time, load sc_makefloat64's address, to + * get ready for calling it, in case the multiply overflows + .3 = sc$makefloat64, .fd8 *= .fd2 + + * The floating point constants do not change, so we can put them in + * the shared text segment. Change the address base to .PC, so we + * use PC-relative addressing. + drop .2 + + * look for overflow by comparing with the maximum allowable integer + .fd2 = maxint ; get maxint + .fcc = .fd8 ? .fd2 + bfgt.sf 2$ ; see if the result fits into an integer + .fd2 = minint.fd + .fcc = .fd8 ? .fd2 + bflt.sf 2$ + + .fs0.i = round(.fd8) ; yes, so convert it to an integer + b.sa 3$ ; and return + .0 = .fs0.i + + 2$ .fd0 = four + .fd8 /= .fd0 ; get the real floating point value + .return = call.sn [.3] ; call sc_makefloat64() + nop + .return = [.sf,8] ; pop the return PC + + 3$ b.sa [.return] ; return + .sf = [.sf] ; restore the old .SF + + * constant value for the division, above + four data.fd 4.0 + + * maximum and minimum possible integer, for comparison, above + maxint data.fd 2147483644.0 + + * The assembler seems to ignore the sign of a floating point constant. + * A Prism uses IEEE format, so the smallest possible integer + * is pretty easy to write in hexadecimal. + *minint data.fd -2147483648.0 + minint data.q h'C1E00000, h'00000000 + endp + + end *** /dev/null Mon Nov 12 09:28:30 1990 --- scrt/prism.o.uu Mon Nov 12 09:26:39 1990 *************** *** 0 **** --- 1,82 ---- + begin 444 prism.o + M 90 ""8]YI@ K0 )0 L@ H 0 ! $R * ( + M$ "YT97AT @!@ ( 8 +8 !@ + M ! @ " N=6YW:6YD (!%@ " 18 < !%@ GX + M ' 0 @+F1A=&$ $ ! * 3( */@ "0 + M$ 0"YM:7( < %: @ N + M02!#X$$@0^)!($/D02!#YD$@0^A!($/J02!#P$$@1H%P (/ 02!&@7 + M !HMP $8&( E"+ -@A 8!< !&+7 @D, 68O< #E$$@0Y9!($.802 + M!#FD$@0YQ!($.>02!#H$$@0Z)!($.D02!#ID$@0ZA!($)# %FJD !JUP ( + M$ 1@!1""OT0MW /$**_1?R_ 0 Y $ _)\!! #D 023_P ?-CR 09/_ !\V + M/ X&( D#*,@@ BQ #$_\ 'V+7 @D, 68O< &K7 @0!&@%$(*_1"W< + M \0HK]%_+\! #D 0#\GP$$ .0!!)/_ !\V/(!!D_\ 'S8\ #@8@"0,IR" + M "+$ ,3_P ?8M< ""0P !9B]P :M< "! ?: 00@K]$K=P "P3$ #\GP$ + M .0! )/_ !\V/( X&( D#)<@@@BQ #$_\ 'V+7 @D, 68O< &K7 C\ + MGP$ .0! /R_ 00 Y $$D_\ 'S8\@ "3_P ?-CP@0>!B ) P3(("[#X < 3$ + M "3_P ?$[P" BJ< QL/@!DD_\ 'Q.\ @*K' (!,0 )/_ !\V' ((K# + M"P3$ #\'R$ .0! .P> "@$Q D_\ 'S ,@@ BQ #$_\ 'V+7 @D, 6 + M8O< ! $ $'?____ P> " &( %H! ' + M @!B 1@ @ _^V" ( A0 $( ( /_M@( " +, H " + M #_[8" @#' * _^P ( VP " /_L " .L !6 + M " #_[8" 8!X >! W(!\87O_X)# #@WE'!@'@!H$#<@'QA>_^0D, + M.#>4<& > %@0-R ?&%[_T"0P X-Y1P8!X 2! W(!\87O^\)# #@WE'!@ + M'@ X$#<@'QA>_Z@D, .#>4<& > "@0-R ?&%[_E"0P X-Y1P @!B ( + M A0 " ,< @#; ( LP " .L ( 0 . #DC + M6\;3 ! " @ * ! $ ! !@! $" !@ . /@ + M !H R #4 ( 4 " & ! 0 * $ /P ! %" , $F/>@! " + M0@0 @( P< 0 *P 0 BP ! /0$ (" + M +4 $ ! $ 'L 0 #A! " @ + M "G0 ! 4 ! !G $ RP0 @( + M FP 0 % 0 4P ! +4$ (" (\ + M $ T $ $8 0 "A! " @ ""0 ! + M A ! E $ >@0 @( =< 0 (P + M 0 @ ! %$$ (" &= $ ( $ + M 0 !(! " @ !:P ! % " 9 $ + M/ 0 @( 3H 0 !0 @ % ! # $ (" + M $' $ 4 ( \ 0 D! " @ + M T ! % " * $ & 0 @( + M )T 0 !0 @ !0 ! P$ (" !K + M $ 4 ( 0 &P #<+R]J96QL:6]T="]L;V-A;%]U + M !( !@ 0 'P 2 8 $ " $@ & ! + MA !( !@ 0 (@ 2 8 $ ", $@ & ! D "0 !@ 0 )0 B + M 8 $ "8 (P & ! O@ !( !@ 0 ,( 6 8 $ #& ' & ! + MR@ !X !@ 0 ,X @ 8 N9FEL90 "+__@ 9P%PC + | + | Sun3 assembly code. + | + + | + | Copyright 1989 Digital Equipment Corporation + | All Rights Reserved + | + | Permission to use, copy, and modify this software and its documentation is + | hereby granted only under the following terms and conditions. Both the + | above copyright notice and this permission notice must appear in all copies + | of the software, derivative works or modified versions, and any portions + | thereof, and both notices must appear in supporting documentation. + | + | Users of this software agree to the terms and conditions set forth herein, + | and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free + | right and license under any changes, enhancements or extensions made to the + | core functions of the software, including but not limited to those affording + | compatibility with other hardware or software environments, but excluding + | applications which incorporate this software. Users further agree to use + | their best efforts to return to Digital any such changes, enhancements or + | extensions that they make and inform Digital of noteworthy uses of this + | software. Correspondence should be provided to Digital at: + | + | Director of Licensing + | Western Research Laboratory + | Digital Equipment Corporation + | 100 Hamilton Avenue + | Palo Alto, California 94301 + | + | This software may be distributed (but not offered for sale or transferred + | for compensation) to third parties, provided such third parties agree to + | abide by the terms and conditions of this notice. + | + | THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL + | WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF + | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL DIGITAL EQUIPMENT + | CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL + | DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR + | PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS + | ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS + | SOFTWARE. + | + + | + | sc_a2to5d2to7 + | + | sc_a2to5d2to7( a ) + | will return the contents of A2, ..., A5, D2, ..., D7 starting at address 'a'. + | + | + .text + .globl _sc_a2to5d2to7 + .even + _sc_a2to5d2to7: + movl sp@(4),a0 + movl a2,a0@(0) + movl a3,a0@(4) + movl a4,a0@(8) + movl a5,a0@(12) + movl d2,a0@(16) + movl d3,a0@(20) + movl d4,a0@(24) + movl d5,a0@(28) + movl d6,a0@(32) + movl d7,a0@(36) + rts