Changeset 12987


Ignore:
Timestamp:
Oct 10, 2009, 7:03:24 AM (15 years ago)
Author:
gz
Message:

ppc and windows changes

Location:
branches/working-0711/ccl/lisp-kernel
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • branches/working-0711/ccl/lisp-kernel/ppc-constants.s

    r12198 r12987  
    189189         _node(initial_tcr)             /* initial thread tcr */
    190190         _node(image_name)              /* --image-name argument */
    191          _node(BADfpscr_save_high)              /* high word of FP reg used to save FPSCR */
    192          _node(BADfpscr_save)              /* saved FPSCR */
     191         _node(BADfpscr_save_high)      /* high word of FP reg used to save FPSCR */
     192         _node(unwind_resume)           /* _Unwind_Resume */
    193193         _node(batch_flag)              /* -b */
    194194         _node(host_platform)           /* for runtime platform-specific stuff */
    … …  
    201201         _node(double_float_one)        /* high half of 1.0d0 */
    202202         _node(short_float_zero)        /* low half of 1.0d0 */
    203          _node(doh_head)                /* creole objects header */
     203         _node(objc2_end_catch)         /* objc_end_catch() */
    204204         _node(metering_info)           /* address of lisp_metering global */
    205205         _node(in_gc)                   /* non-zero when GC active */
    … …  
    207207         _node(lexpr_return)            /* magic &lexpr return code. */
    208208         _node(all_areas)               /* doubly-linked list of all memory areas */
    209          _node(BAD_cs_overflow_limit)   /* limit for control-stack overflow check */
    210          _node(kernel_name)             /* real executable name */
    211          _node(BAD_current_vs)          /* current value-stack area */
     209         _node(kernel_path)             /* real executable name */
     210         _node(objc2_begin_catch)       /* objc_begin_catch */
     211         _node(BAD_current_vs)          /* current value-stack area   */
    212212         _node(statically_linked)       /* non-zero if -static */
    213213         _node(heap_end)                /* end of lisp heap */
    … …  
    230230         _node(saveR13)                 /* probably don]t really need this */
    231231         _node(saveTOC)                 /* where the 68K emulator stores the  emulated regs */
    232          _node(tcr_lock)                /* this thread]s exception frame chain */
     232         _node(objc_2_personality)      /* exception "personality routine" address for ObjC 2.0 */
    233233         _node(kernel_imports)          /* some things we need imported for us */
    234234         _node(interrupt_signal)        /* signal used by PROCESS-INTERRUPT */

  • branches/working-0711/ccl/lisp-kernel/ppc-exceptions.c

    r12198 r12987  
    18521852  xframe_list xframe_link;
    18531853
    1854 #ifdef DARWIN
    1855   if (running_under_rosetta) {
    1856     fprintf(dbgout, "signal handler: signal = %d, pc = 0x%08x\n", signum, xpPC(context));
    1857   }
    1858 #endif
    18591854  if (!use_mach_exception_handling) {
    18601855   

  • branches/working-0711/ccl/lisp-kernel/ppc-spentry.s

    r12301 r12987  
    1 /* Copyright (C) 1994-2001 Digitool, Inc */
     1 /* Copyright (C) 1994-2001 Digitool, Inc */
    22/* This file is part of OpenMCL.   */
    33
    … …  
    15771577        __(mtxer rzero)
    15781578        __(mtctr rzero)
    1579         __(blr)
    1580 
     1579        __ifdef([PPC64])
     1580         __ifdef([DARWIN])
     1581          __(li imm3,1<<TCR_FLAG_BIT_FOREIGN_EXCEPTION)
     1582          __(ld imm4,tcr.flags(rcontext))
     1583          __(and. imm3,imm3,imm4)
     1584          __(bne cr0,0f)
     1585         __endif
     1586        __endif
     1587        __(blr)
     1588        __ifdef([PPC64])
     1589         __ifdef([DARWIN])
     15900:        /* Got here because TCR_FLAG_BIT_FOREIGN_EXCEPTION */
     1591          /* was set in tcr.flags.  Clear that bit. */
     1592          __(andc imm4,imm4,imm3)
     1593          __(std imm4,tcr.flags(rcontext))
     1594          /* Unboxed foreign exception (likely an NSException) in %imm0. */
     1595          /* Box it, then signal a lisp error. */
     1596          __(li imm1,macptr_header)
     1597          __(Misc_Alloc_Fixed(arg_z,imm1,macptr.size))
     1598          __(std imm0,macptr.address(arg_z))
     1599          __(li arg_y,XFOREIGNEXCEPTION)
     1600          __(set_nargs(2))
     1601          __(b _SPksignalerr)
     1602        /* Handle exceptions, for ObjC 2.0 */
     1603LocalLabelPrefix[]ffcallLandingPad:     
     1604          __(mr save1,r3)
     1605          __(cmpdi r4,1)
     1606          __(beq 1f)
     1607LocalLabelPrefix[]ffcallUnwindResume:
     1608          __(ref_global(r12,unwind_resume))
     1609          __(mtctr r12)
     1610          __(bctrl)
     1611LocalLabelPrefix[]ffcallUnwindResume_end:         
     16121:        __(mr r3,save1)
     1613LocalLabelPrefix[]ffcallBeginCatch:
     1614          __(ref_global(r12,objc2_begin_catch))
     1615          __(mtctr r12)
     1616          __(bctrl)
     1617LocalLabelPrefix[]ffcallBeginCatch_end:         
     1618          __(ld save1,0(r3)) /* indirection is necessary because we don't provide type info in lsda */
     1619LocalLabelPrefix[]ffcallEndCatch: 
     1620          __(ref_global(r12,objc2_end_catch))
     1621          __(mtctr r12)
     1622          __(bctrl)             
     1623LocalLabelPrefix[]ffcallEndCatch_end:     
     1624          __(ref_global(r12,get_tcr))
     1625          __(mtctr r12)
     1626          __(li imm0,1)       
     1627          __(bctrl)
     1628          __(ld imm2,tcr.flags(imm0))
     1629          __(ori imm2,imm2,1<<TCR_FLAG_BIT_FOREIGN_EXCEPTION)
     1630          __(std imm2,tcr.flags(imm0))
     1631          __(mr imm0,save1)
     1632          __(b LocalLabelPrefix[]ffcall_call_end)
     1633LocalLabelPrefix[]ffcall_end:   
     1634
     1635                .section __DATA,__gcc_except_tab
     1636          .align 3
     1637LLSDA1:
     1638          .byte 0xff    /* @LPStart format (omit) */
     1639          .byte 0x0     /* @TType format (absolute) */
     1640          .byte 0x4d    /* uleb128 0x4d; @TType base offset */
     1641          .byte 0x3     /* call-site format (udata4) */
     1642          .byte 0x41    /* uleb128 0x41; Call-site table length */
     1643       
     1644          .long Lffcall_setup-Lffcall   /* region 0 start */
     1645          .long Lffcall_setup_end-Lffcall_setup /* length */
     1646          .long 0x0     /* landing pad */
     1647          .byte 0x0     /* uleb128 0x0; action */
     1648       
     1649          .long Lffcall_call-Lffcall    /* region 1 start */
     1650          .long Lffcall_call_end-Lffcall_call   /* length */
     1651          .long LffcallLandingPad-Lffcall       /* landing pad */
     1652          .byte 0x1     /* uleb128 0x1; action */
     1653       
     1654          .long LffcallUnwindResume-Lffcall     /* region 2 start */
     1655          .long LffcallUnwindResume_end-LffcallUnwindResume     /* length */
     1656          .long 0x0     /* landing pad */
     1657          .byte 0x0     /* uleb128 0x0; action */
     1658       
     1659          .long LffcallBeginCatch-Lffcall       /* region 3 start */
     1660          .long LffcallBeginCatch_end-LffcallBeginCatch /* length */
     1661          .long 0       /* landing pad */
     1662          .byte 0x0     /* uleb128 0x0; action */
     1663       
     1664          .long LffcallEndCatch-Lffcall
     1665          .long LffcallEndCatch_end-LffcallEndCatch     /* length */
     1666          .long 0x0     /* landing pad */
     1667          .byte 0x0     /* uleb128 0x0; action */
     1668       
     1669          .byte 0x1     /* Action record table */
     1670          .byte 0x0
     1671          .align 3
     1672          .quad 0       /* _OBJC_EHTYPE_$_NSException */
     1673          .text
     1674         __endif
     1675        __endif
    15811676
    15821677/* Just like poweropen_ffcall, only we save all argument(result)
    … …  
    15851680   r9 and r10 - at least - are overloaded as dedicated lisp registers */
    15861681_spentry(poweropen_ffcall_return_registers)
     1682LocalLabelPrefix[]ffcall_return_registers:               
    15871683        __(mflr loc_pc)
    15881684        __(vpush_saveregs())            /* Now we can use save0-save7 to point to stacks  */
    … …  
    16211717         __(li rcontext,0)
    16221718        __endif
     1719LocalLabelPrefix[]ffcall_return_registers_setup:
    16231720        __(mtctr nargs)
    16241721        __(ldr(r3,c_frame.param0(sp)))
    … …  
    16331730        /* to the function on entry.  */
    16341731        __(mr r12,nargs)
     1732LocalLabelPrefix[]ffcall_return_registers_setup_end:
     1733LocalLabelPrefix[]ffcall_return_registers_call:
    16351734        __(bctrl)
     1735LocalLabelPrefix[]ffcall_return_registers_call_end:
    16361736        __(str(r3,0*node_size(save7)))       
    16371737        __(str(r4,1*node_size(save7)))       
    … …  
    17001800        __(mtxer rzero)
    17011801        __(mtctr rzero)
    1702         __(blr)
    1703 
     1802        __ifdef([DARWIN])
     1803         __ifdef([PPC64])
     1804          __(li imm3,1<<TCR_FLAG_BIT_FOREIGN_EXCEPTION)
     1805          __(ld imm4,tcr.flags(rcontext))
     1806          __(and. imm3,imm3,imm4)
     1807          __(bne 0f)
     1808         __endif
     1809        __endif
     1810        __(blr)
     1811
     1812        __ifdef([DARWIN])
     1813         __ifdef([PPC64])
     18140:        /* Got here because TCR_FLAG_BIT_FOREIGN_EXCEPTION */
     1815          /* was set in tcr.flags.  Clear that bit. */
     1816          __(andc imm4,imm4,imm3)
     1817          __(std imm4,tcr.flags(rcontext))
     1818          /* Unboxed foreign exception (likely an NSException) in %imm0. */
     1819          /* Box it, then signal a lisp error. */
     1820          __(li imm1,macptr_header)
     1821          __(Misc_Alloc_Fixed(arg_z,imm1,macptr.size))
     1822          __(std imm0,macptr.address(arg_z))
     1823          __(li arg_y,XFOREIGNEXCEPTION)
     1824          __(set_nargs(2))
     1825          __(b _SPksignalerr)
     1826        /* Handle exceptions, for ObjC 2.0 */
     1827LocalLabelPrefix[]ffcall_return_registersLandingPad:     
     1828          __(mr save1,r3)
     1829          __(cmpdi r4,1)
     1830          __(beq 1f)
     1831LocalLabelPrefix[]ffcall_return_registersUnwindResume:
     1832          __(ref_global(r12,unwind_resume))
     1833          __(mtctr r12)
     1834          __(bctrl)
     1835LocalLabelPrefix[]ffcall_return_registersUnwindResume_end:         
     18361:        __(mr r3,save1)
     1837LocalLabelPrefix[]ffcall_return_registersBeginCatch:
     1838          __(ref_global(r12,objc2_begin_catch))
     1839          __(mtctr r12)
     1840          __(bctrl)
     1841LocalLabelPrefix[]ffcall_return_registersBeginCatch_end:         
     1842          __(ld save1,0(r3)) /* indirection is necessary because we don't provide type info in lsda */
     1843LocalLabelPrefix[]ffcall_return_registersEndCatch: 
     1844          __(ref_global(r12,objc2_end_catch))
     1845          __(mtctr r12)
     1846          __(bctrl)             
     1847LocalLabelPrefix[]ffcall_return_registersEndCatch_end:     
     1848          __(ref_global(r12,get_tcr))
     1849          __(mtctr r12)
     1850          __(li imm0,1)       
     1851          __(bctrl)
     1852          __(ld imm2,tcr.flags(imm0))
     1853          __(ori imm2,imm2,1<<TCR_FLAG_BIT_FOREIGN_EXCEPTION)
     1854          __(std imm2,tcr.flags(imm0))
     1855          __(mr imm0,save1)
     1856          __(b LocalLabelPrefix[]ffcall_return_registers_call_end)
     1857LocalLabelPrefix[]ffcall_return_registers_end:
     1858          .section __DATA,__gcc_except_tab
     1859          .align 3
     1860LLSDA2:
     1861          .byte 0xff    /* @LPStart format (omit) */
     1862          .byte 0x0     /* @TType format (absolute) */
     1863          .byte 0x4d    /* uleb128 0x4d; @TType base offset */
     1864          .byte 0x3     /* call-site format (udata4) */
     1865          .byte 0x41    /* uleb128 0x41; Call-site table length */
     1866       
     1867          .long Lffcall_return_registers_setup-Lffcall_return_registers /* region 0 start */
     1868          .long Lffcall_return_registers_setup_end-Lffcall_return_registers_setup       /* length */
     1869          .long 0x0     /* landing pad */
     1870          .byte 0x0     /* uleb128 0x0; action */
     1871       
     1872          .long Lffcall_return_registers_call-Lffcall_return_registers  /* region 1 start */
     1873          .long Lffcall_return_registers_call_end-Lffcall_return_registers_call /* length */
     1874          .long Lffcall_return_registersLandingPad-Lffcall_return_registers     /* landing pad */
     1875          .byte 0x1     /* uleb128 0x1; action */
     1876       
     1877          .long Lffcall_return_registersUnwindResume-Lffcall_return_registers   /* region 2 start */
     1878          .long Lffcall_return_registersUnwindResume_end-Lffcall_return_registersUnwindResume   /* length */
     1879          .long 0x0     /* landing pad */
     1880          .byte 0x0     /* uleb128 0x0; action */
     1881       
     1882          .long Lffcall_return_registersBeginCatch-Lffcall_return_registers     /* region 3 start */
     1883          .long Lffcall_return_registersBeginCatch_end-Lffcall_return_registersBeginCatch       /* length */
     1884          .long 0       /* landing pad */
     1885          .byte 0x0     /* uleb128 0x0; action */
     1886       
     1887          .long Lffcall_return_registersEndCatch-Lffcall_return_registers
     1888          .long Lffcall_return_registersEndCatch_end-Lffcall_return_registersEndCatch   /* length */
     1889          .long 0x0     /* landing pad */
     1890          .byte 0x0     /* uleb128 0x0; action */
     1891          .byte 0x1     /* Action record table */
     1892          .byte 0x0
     1893          .align 3
     1894          .quad 0       /* _OBJC_EHTYPE_$_NSException */
     1895          .text
     1896         __endif
     1897        __endif
     1898                     
    17041899
    17051900               
    … …  
    67776972        __(b _SPbind_interrupt_level)
    67786973
     6974        .if 1
     6975        __ifdef([DARWIN])
     6976         __ifdef([PPC64])
     6977L_lisp_objc2_personality:       
     6978        __(ref_global(r12,objc_2_personality))
     6979        __(mtctr r12)
     6980        __(bctr)
     6981        .data
     6982        .globl _lisp_objc2_personality
     6983_lisp_objc2_personality:
     6984        .quad L_lisp_objc2_personality
    67796985       
    6780 
     6986        .section __TEXT,__eh_frame,coalesced,no_toc+strip_static_syms+live_support
     6987EH_frame1:
     6988        .set L$set$12,LECIE1-LSCIE1
     6989        .long L$set$12  /* Length of Common Information Entry */
     6990LSCIE1:
     6991        .long   0x0     /* CIE Identifier Tag */
     6992        .byte   0x1     /* CIE Version */
     6993        .ascii "zPLR\0" /* CIE Augmentation */
     6994        .byte   0x1     /* uleb128 0x1; CIE Code Alignment Factor */
     6995        .byte   0x78    /* sleb128 -8; CIE Data Alignment Factor */
     6996        .byte   0x41    /* CIE RA Column */
     6997        .byte   0x7
     6998        .byte   0x9b
     6999        .long   _lisp_objc2_personality-.
     7000        .byte   0x10    /* LSDA Encoding (pcrel) */
     7001        .byte   0x10    /* FDE Encoding (pcrel) */
     7002        .byte   0xc
     7003        .byte   0x1
     7004        .byte   0x0
     7005        .align 3
     7006LECIE1:
     7007        .globl _SPffcall.eh
     7008_SPffcall.eh:
     7009        .set assembler_nonsense,LEFDEffcall-LSFDEffcall
     7010        .long assembler_nonsense
     7011LSFDEffcall:     
     7012        .long LSFDEffcall-EH_frame1 /* FDE CIE offset */
     7013        .quad Lffcall-. /* FDE Initial Location */
     7014        .quad Lffcall_end-Lffcall /* FDE address range */
     7015        .byte 8 /* uleb128 0x8; Augmentation size */
     7016        .quad LLSDA1-.           /* Language Specific Data Area */
     7017        .byte DW_CFA_def_cfa_offset
     7018        .byte 0xc0,0x1 /* uleb128 0xc0.  A lie:  the frame is variable-length */
     7019        .byte DW_CFA_offset_extended_sf
     7020        .byte   0x41   
     7021        .byte   0x7e    /* sleb128 -2 */
     7022        .byte DW_CFA_advance_loc4
     7023        .long Lffcall_setup-Lffcall
     7024        .byte DW_CFA_advance_loc4
     7025        .long Lffcall_setup_end-Lffcall_setup
     7026        .byte DW_CFA_advance_loc4
     7027        .long Lffcall_call_end-Lffcall_call
     7028        .align 3
     7029LEFDEffcall:
     7030       
     7031        .globl _SPffcall_return_registers.eh
     7032_SPffcall_return_registers.eh:
     7033        .set Lfmh,LEFDEffcall_return_registers-LSFDEffcall_return_registers
     7034        .long Lfmh
     7035LSFDEffcall_return_registers:     
     7036        .long LSFDEffcall_return_registers-EH_frame1 /* FDE CIE offset */
     7037        .quad Lffcall_return_registers-. /* FDE Initial Location */
     7038        .quad Lffcall_return_registers_end-Lffcall_return_registers /* FDE address range */
     7039        .byte 8 /* uleb128 0x8; Augmentation size */
     7040        .quad LLSDA2-.           /* Language Specific Data Area */
     7041        .byte DW_CFA_def_cfa_offset
     7042        .byte 0xc0,0x1 /* uleb128 0xc0.  A lie:  the frame is variable-length */
     7043        .byte DW_CFA_offset_extended_sf
     7044        .byte 0x41     
     7045        .byte 0x7e      /* sleb128 -2 */
     7046        .byte DW_CFA_advance_loc4
     7047        .long Lffcall_return_registers_setup-Lffcall_return_registers
     7048        .byte DW_CFA_advance_loc4
     7049        .long Lffcall_return_registers_setup_end-Lffcall_return_registers_setup
     7050        .byte DW_CFA_advance_loc4
     7051        .long Lffcall_return_registers_call_end-Lffcall_return_registers_call
     7052        .align 3
     7053LEFDEffcall_return_registers:
     7054        .text
     7055         __endif
     7056        __endif
     7057        .endif
    67817058
    67827059                               

  • branches/working-0711/ccl/lisp-kernel/windows-calls.c

    r12303 r12987  
    294294
    295295ssize_t
    296 lisp_read(HANDLE hfile, void *buf, unsigned int count)
     296lisp_standard_read(HANDLE hfile, void *buf, unsigned int count)
    297297{
    298298  HANDLE hevent;
    … …  
    338338  /* We block here */   
    339339  wait_result = WaitForSingleObjectEx(hevent, INFINITE, true);
     340
     341
     342
    340343  tcr->pending_io_info = NULL;
    341344  if (wait_result == WAIT_OBJECT_0) {
    … …  
    367370  }
    368371}
     372
     373ssize_t
     374pipe_read(HANDLE hfile, void *buf, unsigned int count)
     375{
     376  DWORD navail, err;;
     377
     378  do {
     379    navail = 0;
     380    if (PeekNamedPipe(hfile, NULL, 0, NULL, &navail, NULL) == 0) {
     381      err = GetLastError();
     382      if (err = ERROR_HANDLE_EOF) {
     383        return 0;
     384      } else {
     385        _dosmaperr(err);
     386        return -1;
     387      }
     388    }
     389    if (navail != 0) {
     390      return lisp_standard_read(hfile, buf, count);
     391    }
     392    if (SleepEx(50, TRUE) == WAIT_IO_COMPLETION) {
     393      errno = EINTR;
     394      return -1;
     395    }
     396  } while (1);
     397}
     398
     399ssize_t
     400console_read(HANDLE hfile, void *buf, unsigned int count)
     401{
     402  DWORD err, eventcount, i, n;
     403  INPUT_RECORD ir;
     404
     405  do {
     406    err = WaitForSingleObjectEx(hfile, INFINITE, TRUE);
     407    switch (err) {
     408    case WAIT_OBJECT_0:
     409      eventcount = 0;
     410      GetNumberOfConsoleInputEvents(hfile, &eventcount);
     411      for (i = 0; i < eventcount; i++) {
     412        PeekConsoleInput(hfile, &ir, 1, &n);
     413        if (ir.EventType == KEY_EVENT) {
     414          return lisp_standard_read(hfile, buf, count);
     415        } else {
     416          ReadConsoleInput(hfile, &ir, 1, &n);
     417        }
     418      }
     419      break;
     420    case WAIT_IO_COMPLETION:
     421      errno = EINTR;
     422      return -1;
     423      break;
     424    case WAIT_FAILED:
     425      _dosmaperr(GetLastError());
     426      return -1;
     427      break;
     428    }
     429  } while (1);
     430}
     431
     432ssize_t
     433lisp_read(HANDLE hfile, void *buf, unsigned int count) {
     434  switch(GetFileType(hfile)) {
     435  case FILE_TYPE_CHAR:
     436    return console_read(hfile, buf, count);
     437    break;
     438
     439  case FILE_TYPE_PIPE:          /* pipe or one of these newfangled socket things */
     440    {
     441      int socktype, optlen = sizeof(int);
     442      if ((getsockopt((SOCKET)hfile, SOL_SOCKET, SO_TYPE, (char *)&socktype, &optlen) != 0) && (GetLastError() == WSAENOTSOCK)) {
     443        return pipe_read(hfile, buf, count);
     444      }
     445    }
     446    /* It's a socket, fall through */
     447   
     448  case FILE_TYPE_DISK:
     449    return lisp_standard_read(hfile, buf, count);
     450    break;
     451
     452  default:
     453    errno = EBADF;
     454    return -1;
     455  }
     456}
     457
     458
    369459
    370460ssize_t
    … …  
    618708  GetSystemTimeAsFileTime((FILETIME*)&now);
    619709  now -= UNIX_EPOCH_IN_WINDOWS_EPOCH;
    620   now /= 10000;
     710  now /= 10000;               /* convert time to milliseconds */
    621711  tp->tv_sec = now/1000LL;
    622   tp->tv_usec = now%1000LL;
     712  tp->tv_usec = 1000 * (now%1000LL); /* convert milliseconds to microseconds */
    623713  return 0;
    624714}
Note: See TracChangeset for help on using the changeset viewer.