Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl

Commits:

3 changed files:

Changes:

  • src/code/float-trap.lisp
    ... ... @@ -102,9 +102,11 @@
    102 102
         ;; FPU and only use the SSE2 rounding control bits.
    
    103 103
         (let* ((x87-modes (vm::x87-floating-point-modes))
    
    104 104
     	   (sse-modes (vm::sse2-floating-point-modes))
    
    105
    +	   (x87-exceptions (logand #x3f x87-modes))
    
    106
    +	   (x87-enables (logand #x3f (ash x87-modes -16)))
    
    105 107
     	   (final-mode (logior sse-modes
    
    106
    -			       (ash (logand #x3f x87-modes) 7) ; control
    
    107
    -			       (logand #x3f (ash x87-modes -16)))))
    
    108
    +			       x87-exceptions
    
    109
    +			       (ash x87-enables 7))))
    
    108 110
     
    
    109 111
           final-mode))
    
    110 112
       (defun (setf floating-point-modes) (new-mode)
    
    ... ... @@ -112,15 +114,17 @@
    112 114
         ;; Set the floating point modes for both X87 and SSE2.  This
    
    113 115
         ;; include the rounding control bits.
    
    114 116
         (let* ((rc (ldb float-rounding-mode new-mode))
    
    117
    +	   (new-exceptions (logand #x3f new-mode))
    
    118
    +	   (new-enables (logand #x3f (ash new-mode -7)))
    
    115 119
     	   (x87-modes
    
    116
    -	    (logior (ash (logand #x3f new-mode) 16)
    
    120
    +	    (logior new-exceptions
    
    117 121
     		    (ash rc 10)
    
    118
    -		    (logand #x3f (ash new-mode -7))
    
    122
    +		    (ash new-enables 16)
    
    119 123
     		    ;; Set precision control to be 64-bit, always.  We
    
    120 124
     		    ;; don't use the x87 registers with sse2, so this
    
    121 125
     		    ;; is ok and would be the correct setting if we
    
    122 126
     		    ;; ever support long-floats.
    
    123
    -		    (ash 3 8))))
    
    127
    +		    (ash 3 (+ 8 16)))))
    
    124 128
           (setf (vm::sse2-floating-point-modes) (ldb (byte 24 0) new-mode))
    
    125 129
           (setf (vm::x87-floating-point-modes) (ldb (byte 24 0) x87-modes)))
    
    126 130
         new-mode)
    

  • src/compiler/x86/float-sse2.lisp
    ... ... @@ -1380,7 +1380,7 @@
    1380 1380
       float-modes)
    
    1381 1381
     
    
    1382 1382
     ;; Extract the control and status words from the FPU.  The low 16 bits
    
    1383
    -;; contain the control word, and the high 16 bits contain the status.
    
    1383
    +;; contain the status word, and the high 16 bits contain the control.
    
    1384 1384
     (define-vop (x87-floating-point-modes)
    
    1385 1385
       (:results (res :scs (unsigned-reg)))
    
    1386 1386
       (:result-types unsigned-num)
    
    ... ... @@ -1396,12 +1396,15 @@
    1396 1396
        (inst byte #x66)			; operand size prefix
    
    1397 1397
        (inst or sw-reg cw-stack)
    
    1398 1398
        (inst xor sw-reg #x3f)		; invert exception mask
    
    1399
    -   (move res sw-reg)))
    
    1399
    +   (move res sw-reg)
    
    1400
    +   ;; Put status word in the low 16 bits and the control word in the
    
    1401
    +   ;; high 16 bits.
    
    1402
    +   (inst rol res 16)))
    
    1400 1403
     
    
    1401 1404
     ;; Set the control and status words from the FPU.  The low 16 bits
    
    1402
    -;; contain the control word, and the high 16 bits contain the status.
    
    1405
    +;; contain the status word, and the high 16 bits contain the control.
    
    1403 1406
     (define-vop (x87-set-floating-point-modes)
    
    1404
    -  (:args (new :scs (unsigned-reg) :to :result :target res))
    
    1407
    +  (:args (new-modes :scs (unsigned-reg) :to :result :target res))
    
    1405 1408
       (:results (res :scs (unsigned-reg)))
    
    1406 1409
       (:arg-types unsigned-num)
    
    1407 1410
       (:result-types unsigned-num)
    
    ... ... @@ -1410,7 +1413,12 @@
    1410 1413
       (:temporary (:sc unsigned-stack) cw-stack)
    
    1411 1414
       (:temporary (:sc byte-reg :offset al-offset) sw-reg)
    
    1412 1415
       (:temporary (:sc unsigned-reg :offset ecx-offset) old)
    
    1416
    +  (:temporary (:sc unsigned-reg) new)
    
    1413 1417
       (:generator 6
    
    1418
    +   (move new new-modes)
    
    1419
    +   ;; Put the status word in the high 16 bits and the control word in
    
    1420
    +   ;; the low 16 bits.
    
    1421
    +   (inst rol new 16)
    
    1414 1422
        (inst mov cw-stack new)
    
    1415 1423
        (inst xor cw-stack #x3f)  ; invert exception mask
    
    1416 1424
        (inst fnstsw)
    
    ... ... @@ -1425,7 +1433,7 @@
    1425 1433
        (inst fldenv (make-ea :dword :base esp-tn))
    
    1426 1434
        (inst add esp-tn 28)
    
    1427 1435
        DONE
    
    1428
    -   (move res new)))
    
    1436
    +   (move res new-modes)))
    
    1429 1437
     
    
    1430 1438
     
    
    1431 1439
     (defun sse2-floating-point-modes ()
    

  • src/lisp/elf.c
    ... ... @@ -11,11 +11,11 @@
    11 11
      $Id: elf.c,v 1.32 2010/12/23 03:20:27 rtoy Exp $
    
    12 12
     */
    
    13 13
     
    
    14
    +#include <stddef.h>
    
    14 15
     #include <stdio.h>
    
    15 16
     #include <stdlib.h>
    
    16 17
     #include <string.h>
    
    17 18
     #include <fcntl.h>
    
    18
    -#include <sys/stat.h>
    
    19 19
     #include <sys/types.h>
    
    20 20
     #include <unistd.h>
    
    21 21
     
    
    ... ... @@ -319,59 +319,65 @@ write_space_object(const char *dir, int id, os_vm_address_t start, os_vm_address
    319 319
         return ret;
    
    320 320
     }
    
    321 321
     
    
    322
    +#ifdef UNICODE
    
    323
    +#define LISPCHAR unsigned short
    
    324
    +#else
    
    325
    +#define LISPCHAR char
    
    326
    +#endif
    
    327
    +
    
    328
    +static LISPCHAR *
    
    329
    +tokenize(LISPCHAR *str, LISPCHAR **end)
    
    330
    +{
    
    331
    +    LISPCHAR *ptr;
    
    332
    +
    
    333
    +    ptr = str;
    
    334
    +again:
    
    335
    +    while (*ptr != '\0' && *ptr != ':')
    
    336
    +	ptr++;
    
    337
    +    if (str == ptr && *ptr == ':') {
    
    338
    +	str = ++ptr;
    
    339
    +	goto again;
    
    340
    +    }
    
    341
    +    *end = ptr;
    
    342
    +    return str;
    
    343
    +}
    
    344
    +
    
    322 345
     int
    
    323 346
     obj_run_linker(long init_func_address, char *file)
    
    324 347
     {
    
    325 348
         lispobj libstring = SymbolValue(CMUCL_LIB);     /* Get library: */
    
    326 349
         struct vector *vec = (struct vector *)PTR(libstring);
    
    327
    -    char *paths;
    
    328
    -    char command[FILENAME_MAX + 1];
    
    329
    -    char command_line[FILENAME_MAX + FILENAME_MAX + 10];
    
    330
    -    char *strptr;
    
    331
    -    struct stat st;
    
    350
    +    char command[PATH_MAX];
    
    351
    +    char command_line[PATH_MAX * 2 + 10];
    
    352
    +    LISPCHAR *strptr, *end = (LISPCHAR *)vec->data;
    
    332 353
         int ret;
    
    333 354
         extern int debug_lisp_search;
    
    334
    -#ifndef UNICODE
    
    335
    -    paths = strdup((char *)vec->data);
    
    336
    -    if (paths == NULL) {
    
    337
    -	perror("strdup");
    
    338
    -	return -1;
    
    339
    -    }
    
    340
    -#else
    
    341
    -    /*
    
    342
    -     * What should we do here with 16-bit characters?  For now we just
    
    343
    -     * take the low 8-bits.
    
    344
    -     */
    
    345
    -    paths = malloc(vec->length);
    
    346
    -    if (paths == NULL) {
    
    347
    -	perror("malloc");
    
    348
    -	return -1;
    
    349
    -    } else {
    
    350
    -        int k;
    
    351
    -        unsigned short *data;
    
    352
    -        data = (unsigned short*) vec->data;
    
    353
    -        
    
    354
    -        for (k = 0; k < vec->length; ++k) {
    
    355
    -            paths[k] = data[k] & 0xff;
    
    356
    -        }
    
    357
    -    }
    
    358
    -#endif
    
    359
    -    strptr = strtok(paths, ":");
    
    360 355
     
    
    361 356
         if (debug_lisp_search) {
    
    362 357
             printf("Searching for linker.sh script\n");
    
    363 358
         }
    
    364 359
     
    
    365
    -    while(strptr != NULL) {
    
    366
    -        
    
    367
    -	sprintf(command, "%s/%s", strptr, LINKER_SCRIPT);
    
    360
    +    while ((strptr = tokenize(end, &end)) != end) {
    
    361
    +	ptrdiff_t len = end - strptr;
    
    362
    +	ptrdiff_t i;
    
    363
    +
    
    364
    +	if (len + strlen("/" LINKER_SCRIPT) > PATH_MAX)
    
    365
    +	    continue;
    
    366
    +
    
    367
    +	/*
    
    368
    +	 * What should we do here with 16-bit characters?  For now we just
    
    369
    +	 * take the low 8-bits.
    
    370
    +	 */
    
    371
    +	for (i = 0; i < len; i++)
    
    372
    +	    command[i] = strptr[i] & 0xFF;
    
    373
    +	command[i] = '\0';
    
    374
    +	strcat(command, "/" LINKER_SCRIPT);
    
    368 375
     
    
    369 376
             if (debug_lisp_search) {
    
    370 377
                 printf("  %s\n", command);
    
    371 378
             }
    
    372 379
             
    
    373
    -	if (stat(command, &st) == 0) {
    
    374
    -	    free(paths);
    
    380
    +	if (access(command, F_OK) == 0) {
    
    375 381
     	    printf("\t[%s: linking %s... \n", command, file);
    
    376 382
     	    fflush(stdout);
    
    377 383
     #if defined(__linux__) || defined(__FreeBSD__) || defined(SOLARIS) || defined(__NetBSD__)
    
    ... ... @@ -394,15 +400,14 @@ obj_run_linker(long init_func_address, char *file)
    394 400
     	    }
    
    395 401
     	    return ret;
    
    396 402
     	}
    
    397
    -	strptr = strtok(NULL, ":");
    
    398 403
         }
    
    399 404
     
    
    400 405
         fprintf(stderr,
    
    401 406
     	    "Can't find %s script in CMUCL library directory list.\n", LINKER_SCRIPT);
    
    402
    -    free(paths);
    
    403 407
         return -1;
    
    404 408
     }
    
    405 409
     
    
    410
    +#undef LISPCHAR
    
    406 411
     
    
    407 412
     /* Read the ELF header from a file descriptor and stuff it into a
    
    408 413
     	 structure.	 Make sure it is really an elf header etc. */