Changeset 10515


Ignore:
Timestamp:
Aug 21, 2008, 10:51:47 AM (11 years ago)
Author:
gb
Message:

Replace syscall with int-errno call. See what breaks ...

Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/level-1/l1-sockets.lisp

    r10288 r10515  
    148148            "WITH-OPEN-SOCKET"))
    149149
    150 (eval-when (:compile-toplevel :execute)
    151   #+linuxppc-target
    152   (require "PPC-LINUX-SYSCALLS")
    153   #+linuxx8664-target
    154   (require "X8664-LINUX-SYSCALLS")
    155   #+darwinppc-target
    156   (require "DARWINPPC-SYSCALLS")
    157   #+darwinx8664-target
    158   (require "DARWINX8664-SYSCALLS")
    159   #+freebsdx8664-target
    160   (require "X8664-FREEBSD-SYSCALLS")
    161   #+solarisx8664-target
    162   (require "X8664-SOLARIS-SYSCALLS")
    163   )
     150
    164151
    165152(define-condition socket-error (simple-stream-error)
    … …  
    12091196
    12101197(defun c_socket_1 (domain type protocol)
    1211   #-(or linuxppc-target solaris-target)
    1212   (syscall syscalls::socket domain type protocol)
    1213   #+linuxppc-target
    1214   (rlet ((params (:array :unsigned-long 3)))
    1215     (setf (paref params (:* :unsigned-long) 0) domain
    1216           (paref params (:* :unsigned-long) 1) type
    1217           (paref params (:* :unsigned-long) 2) protocol)
    1218     (syscall syscalls::socketcall 1 params))
    1219   #+solaris-target
    1220   (syscall syscalls::so_socket domain type protocol +null-ptr+ #$SOV_DEFAULT))
     1198  (int-errno-call (#_socket domain type protocol)))
    12211199
    12221200(defun c_socket (domain type protocol)
    … …  
    12641242
    12651243(defun c_bind (sockfd sockaddr addrlen)
    1266   #-linuxppc-target
    1267   (progn
    1268     #+(or darwin-target freebsd-target)
    1269     (setf (pref sockaddr :sockaddr_in.sin_len) addrlen)
    1270     (syscall syscalls::bind sockfd sockaddr addrlen))
    1271   #+linuxppc-target
    1272   (progn
    1273     #+ppc32-target
    1274     (%stack-block ((params 12))
    1275       (setf (%get-long params 0) sockfd
    1276             (%get-ptr params 4) sockaddr
    1277             (%get-long params 8) addrlen)
    1278       (syscall syscalls::socketcall 2 params))
    1279     #+ppc64-target
    1280     (%stack-block ((params 24))
    1281       (setf (%%get-unsigned-longlong params 0) sockfd
    1282             (%get-ptr params 8) sockaddr
    1283             (%%get-unsigned-longlong params 16) addrlen)
    1284       (syscall syscalls::socketcall 2 params))))
     1244  (int-errno-call (#_bind sockfd sockaddr addrlen)))
    12851245
    12861246
    … …  
    12941254         (progn
    12951255           (fd-set-flags sockfd (logior flags #$O_NONBLOCK))
    1296            (let* ((err
    1297                    #-linuxppc-target
    1298                    (syscall syscalls::connect sockfd addr len)
    1299                    #+linuxppc-target
    1300                    (progn
    1301                      #+ppc32-target
    1302                      (%stack-block ((params 12))
    1303                        (setf (%get-long params 0) sockfd
    1304                              (%get-ptr params 4) addr
    1305                              (%get-long params 8) len)
    1306                        (syscall syscalls::socketcall 3 params))
    1307                      #+ppc64-target
    1308                      (%stack-block ((params 24))
    1309                        (setf (%%get-unsigned-longlong params 0) sockfd
    1310                              (%get-ptr params 8) addr
    1311                              (%%get-unsigned-longlong params 16) len)
    1312                        (syscall syscalls::socketcall 3 params)))))
     1256           (let* ((err (int-errno-call (#_connect sockfd addr len))))
    13131257             (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR)))
    13141258                    (if (process-output-wait sockfd timeout-in-milliseconds)
    … …  
    13191263
    13201264(defun c_listen (sockfd backlog)
    1321   #-linuxppc-target
    1322   (syscall syscalls::listen sockfd backlog)
    1323   #+linuxppc-target
    1324   (progn
    1325     #+ppc32-target
    1326     (%stack-block ((params 8))
    1327       (setf (%get-long params 0) sockfd
    1328             (%get-long params 4) backlog)
    1329       (syscall syscalls::socketcall 4 params))
    1330     #+ppc64-target
    1331     (%stack-block ((params 16))
    1332       (setf (%%get-unsigned-longlong params 0) sockfd
    1333             (%%get-unsigned-longlong params 8) backlog)
    1334       (syscall syscalls::socketcall 4 params))))
     1265  (int-errno-call (#_listen sockfd backlog)))
    13351266
    13361267(defun c_accept (sockfd addrp addrlenp)
    1337   (ignoring-eintr
    1338    #-linuxppc-target
    1339    (syscall syscalls::accept sockfd addrp addrlenp)
    1340    #+linuxppc-target
    1341    (progn
    1342      #+ppc32-target
    1343      (%stack-block ((params 12))
    1344        (setf (%get-long params 0) sockfd
    1345              (%get-ptr params 4) addrp
    1346              (%get-ptr params 8) addrlenp)
    1347        (syscall syscalls::socketcall 5 params))
    1348      #+ppc64-target
    1349      (%stack-block ((params 24))
    1350        (setf (%%get-unsigned-longlong params 0) sockfd
    1351              (%get-ptr params 8) addrp
    1352              (%get-ptr params 16) addrlenp)
    1353        (syscall syscalls::socketcall 5 params)))))
     1268  (ignoring-eintr
     1269   (int-errno-call (#_accept sockfd addrp addrlenp))))
    13541270
    13551271(defun c_getsockname (sockfd addrp addrlenp)
    1356   #-linuxppc-target
    1357   (syscall syscalls::getsockname sockfd addrp addrlenp)
    1358   #+linuxppc-target
    1359   (progn
    1360     #+ppc32-target
    1361     (%stack-block ((params 12))
    1362       (setf (%get-long params 0) sockfd
    1363             (%get-ptr params 4) addrp
    1364             (%get-ptr params 8) addrlenp)
    1365       (syscall syscalls::socketcall 6 params))
    1366     #+ppc64-target
    1367     (%stack-block ((params 24))
    1368       (setf (%%get-unsigned-longlong params 0) sockfd
    1369             (%get-ptr params 8) addrp
    1370             (%get-ptr params 16) addrlenp)
    1371       (syscall syscalls::socketcall 6 params))))
     1272  (int-errno-call (#_getsockname sockfd addrp addrlenp)))
    13721273
    13731274(defun c_getpeername (sockfd addrp addrlenp)
    1374   #-linuxppc-target
    1375   (syscall syscalls::getpeername sockfd addrp addrlenp)
    1376   #+linuxppc-target
    1377   (progn
    1378     #+ppc32-target
    1379     (%stack-block ((params 12))
    1380       (setf (%get-long params 0) sockfd
    1381             (%get-ptr params 4) addrp
    1382             (%get-ptr params 8) addrlenp)
    1383       (syscall syscalls::socketcall 7 params))
    1384     #+ppc64-target
    1385     (%stack-block ((params 24))
    1386       (setf (%%get-unsigned-longlong params 0) sockfd
    1387             (%get-ptr params 8) addrp
    1388             (%get-ptr params 16) addrlenp)
    1389       (syscall syscalls::socketcall 7 params))))
     1275  (int-errno-call (#_getpeername sockfd addrp addrlenp)))
    13901276
    13911277(defun c_socketpair (domain type protocol socketsptr)
    1392   #-(or linuxppc-target solaris-target)
    1393   (syscall syscalls::socketpair domain type protocol socketsptr)
    1394   #+linuxppc-target
    1395   (progn
    1396     #+ppc32-target
    1397     (%stack-block ((params 16))
    1398       (setf (%get-long params 0) domain
    1399             (%get-long params 4) type
    1400             (%get-long params 8) protocol
    1401             (%get-ptr params 12) socketsptr)
    1402       (syscall syscalls::socketcall 8 params))
    1403     #+ppc64-target
    1404     (%stack-block ((params 32))
    1405       (setf (%%get-unsigned-longlong params 0) domain
    1406             (%%get-unsigned-longlong params 8) type
    1407             (%%get-unsigned-longlong params 16) protocol
    1408             (%get-ptr params 24) socketsptr)
    1409       (syscall syscalls::socketcall 8 params)))
    1410   #+solaris-target
    1411   (let* ((fd1 (syscall syscalls::so_socket domain type protocol +null-ptr+ #$SOV_DEFAULT)))
    1412     (if (>= fd1 0)
    1413       (let* ((fd2 (syscall syscalls::so_socket domain type protocol +null-ptr+ #$SOV_DEFAULT)))
    1414         (if (>= fd2 0)
    1415           (progn
    1416             (setf (paref socketsptr (:* :int) 0) fd1
    1417                   (paref socketsptr (:* :int) 1) fd2)
    1418             (let* ((res (syscall syscalls::so_socketpair socketsptr)))
    1419               (when (< res 0)
    1420                 (fd-close fd1)
    1421                 (fd-close fd2))
    1422               res))
    1423           (progn
    1424             (fd-close fd1)
    1425             fd2)))
    1426       fd1)))
    1427 
    1428 
     1278  (int-errno-call (#_socketpair domain type protocol socketsptr)))
    14291279
    14301280
    14311281(defun c_sendto (sockfd msgptr len flags addrp addrlen)
    1432   #-linuxppc-target
    1433   (syscall syscalls::sendto sockfd msgptr len flags addrp addrlen)
    1434   #+linuxppc-target
    1435   (progn
    1436     #+ppc32-target
    1437     (%stack-block ((params 24))
    1438       (setf (%get-long params 0) sockfd
    1439             (%get-ptr params  4) msgptr
    1440             (%get-long params 8) len
    1441             (%get-long params 12) flags
    1442             (%get-ptr params  16) addrp
    1443             (%get-long params 20) addrlen)
    1444       (syscall syscalls::socketcall 11 params))
    1445     #+ppc64-target
    1446     (%stack-block ((params 48))
    1447       (setf (%%get-unsigned-longlong params 0) sockfd
    1448             (%get-ptr params  8) msgptr
    1449             (%%get-unsigned-longlong params 16) len
    1450             (%%get-unsigned-longlong params 24) flags
    1451             (%get-ptr params  32) addrp
    1452             (%%get-unsigned-longlong params 40) addrlen)
    1453       (syscall syscalls::socketcall 11 params))))
     1282  (int-errno-call (#_sendto sockfd msgptr len flags addrp addrlen)))
    14541283
    14551284(defun c_recvfrom (sockfd bufptr len flags addrp addrlenp)
    1456   #-linuxppc-target
    1457   (syscall syscalls::recvfrom sockfd bufptr len flags addrp addrlenp)
    1458   #+linuxppc-target
    1459   (progn
    1460     #+ppc32-target
    1461     (%stack-block ((params 24))
    1462       (setf (%get-long params 0) sockfd
    1463             (%get-ptr params  4) bufptr
    1464             (%get-long params 8) len
    1465             (%get-long params 12) flags
    1466             (%get-ptr params  16) addrp
    1467             (%get-ptr params  20) addrlenp)
    1468       (syscall syscalls::socketcall 12 params))
    1469     #+ppc64-target
    1470     (%stack-block ((params 48))
    1471       (setf (%get-long params 0) sockfd
    1472             (%get-ptr params  8) bufptr
    1473             (%get-long params 16) len
    1474             (%get-long params 24) flags
    1475             (%get-ptr params  32) addrp
    1476             (%get-ptr params  40) addrlenp)
    1477       (syscall syscalls::socketcall 12 params))))
     1285  (int-errno-call (#_recvfrom sockfd bufptr len flags addrp addrlenp)))
    14781286
    14791287(defun c_shutdown (sockfd how)
    1480   #-linuxppc-target
    1481   (syscall syscalls::shutdown sockfd how)
    1482   #+linuxppc-target
    1483   (progn
    1484     #+ppc32-target
    1485     (%stack-block ((params 8))
    1486       (setf (%get-long params 0) sockfd
    1487             (%get-long params 4) how)
    1488       (syscall syscalls::socketcall 13 params))
    1489     #+ppc64-target
    1490     (%stack-block ((params 16))
    1491       (setf (%%get-unsigned-longlong params 0) sockfd
    1492             (%%get-unsigned-longlong params 8) how)
    1493       (syscall syscalls::socketcall 13 params))))
     1288  (int-errno-call (#_shutdown sockfd how)))
    14941289
    14951290(defun c_setsockopt (sockfd level optname optvalp optlen)
    1496   #-linuxppc-target
    1497   (syscall syscalls::setsockopt sockfd level optname optvalp optlen)
    1498   #+linuxppc-target
    1499   (progn
    1500     #+ppc32-target
    1501     (%stack-block ((params 20))
    1502       (setf (%get-long params 0) sockfd
    1503             (%get-long params 4) level
    1504             (%get-long params 8) optname
    1505             (%get-ptr params 12) optvalp
    1506             (%get-long params 16) optlen)
    1507       (syscall syscalls::socketcall 14 params))
    1508     #+ppc64-target
    1509     (%stack-block ((params 40))
    1510       (setf (%%get-unsigned-longlong params 0) sockfd
    1511             (%%get-unsigned-longlong params 8) level
    1512             (%%get-unsigned-longlong params 16) optname
    1513             (%get-ptr params 24) optvalp
    1514             (%%get-unsigned-longlong params 32) optlen)
    1515       (syscall syscalls::socketcall 14 params))))
     1291  (int-errno-call (#_setsockopt sockfd level optname optvalp optlen)))
    15161292
    15171293(defun c_getsockopt (sockfd level optname optvalp optlenp)
    1518   #-linuxppc-target
    1519   (syscall syscalls::getsockopt sockfd level optname optvalp optlenp)
    1520   #+linuxppc-target
    1521   (progn
    1522     #+ppc32-target
    1523     (%stack-block ((params 20))
    1524       (setf (%get-long params 0) sockfd
    1525             (%get-long params 4) level
    1526             (%get-long params 8) optname
    1527             (%get-ptr params 12) optvalp
    1528             (%get-ptr params 16) optlenp)
    1529       (syscall syscalls::socketcall 15 params))
    1530     #+ppc64-target
    1531     (%stack-block ((params 40))
    1532       (setf (%%get-unsigned-longlong params 0) sockfd
    1533             (%%get-unsigned-longlong params 8) level
    1534             (%%get-unsigned-longlong params 16) optname
    1535             (%get-ptr params 24) optvalp
    1536             (%get-ptr params 32) optlenp)
    1537       (syscall syscalls::socketcall 15 params))))
     1294  (int-errno-call (#_getsockopt sockfd level optname optvalp optlenp)))
    15381295
    15391296(defun c_sendmsg (sockfd msghdrp flags)
    1540   #-linuxppc-target
    1541   (syscall syscalls::sendmsg sockfd msghdrp flags)
    1542   #+linuxppc-target
    1543   (progn
    1544     #+ppc32-target
    1545     (%stack-block ((params 12))
    1546       (setf (%get-long params 0) sockfd
    1547             (%get-ptr params 4) msghdrp
    1548             (%get-long params 8) flags)
    1549       (syscall syscalls::socketcall 16 params))
    1550     #+ppc64-target
    1551     (%stack-block ((params 24))
    1552       (setf (%%get-unsigned-longlong params 0) sockfd
    1553             (%get-ptr params 8) msghdrp
    1554             (%%get-unsigned-longlong params 16) flags)
    1555       (syscall syscalls::socketcall 16 params))))
     1297  (int-errno-call (#_sendmsg sockfd msghdrp flags)))
    15561298
    15571299(defun c_recvmsg (sockfd msghdrp flags)
    1558   #-linuxppc-target
    1559   (syscall syscalls::recvmsg sockfd msghdrp flags)
    1560   #+linuxppc-target
    1561   (progn
    1562     #+ppc32-target
    1563     (%stack-block ((params 12))
    1564       (setf (%get-long params 0) sockfd
    1565             (%get-ptr params 4) msghdrp
    1566             (%get-long params 8) flags)
    1567       (syscall syscalls::socketcall 17 params))
    1568     #+ppc64-target
    1569     (%stack-block ((params 24))
    1570       (setf (%%get-unsigned-longlong params 0) sockfd
    1571             (%get-ptr params 8) msghdrp
    1572             (%%get-unsigned-longlong params 16) flags)
    1573       (syscall syscalls::socketcall 17 params))))
     1300  (int-errno-call   (#_recvmsg sockfd msghdrp flags)))
    15741301
    15751302

  • trunk/source/level-1/linux-files.lisp

    r10441 r10515  
    1616
    1717(in-package "CCL")
    18 
    19 (eval-when (:compile-toplevel :execute)
    20   #+linuxppc-target
    21   (require "PPC-LINUX-SYSCALLS")
    22   #+linuxx8664-target
    23   (require "X8664-LINUX-SYSCALLS")
    24   #+darwinppc-target
    25   (require "DARWINPPC-SYSCALLS")
    26   #+darwinx8632-target
    27   (require "DARWINX8632-SYSCALLS")
    28   #+darwinx8664-target
    29   (require "DARWINX8664-SYSCALLS")
    30   #+(and freebsd-target x8664-target)
    31   (require "X8664-FREEBSD-SYSCALLS")
    32   #+(and solaris-target x8664-target)
    33   (require "X8664-SOLARIS-SYSCALLS")
    34   )
    3518
    3619
    … …  
    210193(defun %chdir (dirname)
    211194  (with-filename-cstrs ((dirname dirname))
    212     (syscall syscalls::chdir dirname)))
     195    (int-errno-call (#_chdir dirname))))
    213196
    214197(defun %mkdir (name mode)
    … …  
    218201      (setq name (subseq name 0 (1- len))))
    219202    (with-filename-cstrs ((name name))
    220       (syscall syscalls::mkdir name mode))))
     203      (int-errno-call (#_mkdir name mode)))))
    221204
    222205(defun %rmdir (name)
    … …  
    226209                 (eql (%get-byte name last) (char-code #\/)))
    227210        (setf (%get-byte name last) 0))
    228     (syscall syscalls::rmdir name))))
     211      (int-errno-call (#_rmdir name)))))
    229212
    230213
    … …  
    251234fails unless the OpenMCL process has super-user privileges or the ID
    252235given is that of the current user."
    253   (syscall syscalls::setuid uid))
     236  (int-errno-call (#_setuid uid)))
    254237
    255238(defun setgid (uid)
    … …  
    257240fails unless the OpenMCL process has super-user privileges or the ID
    258241given is that of a group to which the current user belongs."
    259   (syscall syscalls::setgid uid))
     242  (int-errno-call (#_setgid uid)))
    260243 
    261244
    … …  
    291274     (#_ __xstat #$_STAT_VER_LINUX cname stat)
    292275     #-linux-target
    293      (syscall syscalls::stat cname stat)
     276     (#_stat cname stat)
    294277     stat)))
    295278
    … …  
    299282   (#_ __fxstat #$_STAT_VER_LINUX fd stat)
    300283   #-linux-target
    301    (syscall syscalls::fstat fd stat)
     284   (#_fstat fd stat)
    302285   stat))
    303286
    … …  
    308291     (#_ __lxstat #$_STAT_VER_LINUX cname stat)
    309292     #-linux-target
    310      (syscall syscalls::lstat cname stat)
     293     (#_lstat cname stat)
    311294     stat)))
    312295
    … …  
    386369(defun %uname (idx)
    387370  (%stack-block ((buf (* #$_UTSNAME_LENGTH 6))) 
    388     (%uts-string (syscall syscalls::uname buf) idx buf)))
     371    (%uts-string (#_uname buf) idx buf)))
    389372
    390373#+darwin-target
    … …  
    404387
    405388(defun fd-dup (fd)
    406   (syscall syscalls::dup fd))
     389  (int-errno-call (#_dup fd)))
    407390
    408391(defun fd-fsync (fd)
    409   #-solaris-target
    410   (syscall syscalls::fsync fd)
    411   #+solaris-target
    412   (syscall syscalls::fdsync fd #$FSYNC))
     392  (int-errno-call (#_fsync fd)))
    413393
    414394(defun fd-get-flags (fd)
    415   (let* ((result (#_fcntl fd #$F_GETFL)))
    416     (declare (fixnum result))
    417     (if (< result 0)
    418       (%get-errno)
    419       result)))
     395  (int-errno-call (#_fcntl fd #$F_GETFL)))
    420396
    421397(defun fd-set-flags (fd new)
    422   (let* ((result (#_fcntl fd #$F_SETFL :int new)))
    423     (declare (fixnum result))
    424     (if (< result 0)
    425       (%get-errno)
    426       result)))
     398  (int-errno-call (#_fcntl fd #$F_SETFL :int new)))
    427399
    428400(defun fd-set-flag (fd mask)
    … …  
    514486
    515487(defun %%rusage (usage &optional (who #$RUSAGE_SELF))
    516   #-solaris-target
    517   (syscall syscalls::getrusage who usage)
    518   #+solaris-target
    519   (#_getrusage who usage)
    520   )
     488  (int-errno-call (#_getrusage who usage)))
    521489
    522490
    … …  
    579547(defun getpid ()
    580548  "Return the ID of the OpenMCL OS process."
    581   (syscall syscalls::getpid))
     549  (int-errno-call (#_getpid)))
    582550
    583551(defun getuid ()
    584552  "Return the (real) user ID of the current user."
    585   (syscall syscalls::getuid))
     553  (int-errno-call (#_getuid)))
    586554
    587555(defun get-user-home-dir (userid)
    … …  
    612580(defun %delete-file (name)
    613581  (with-cstrs ((n name))
    614     (syscall syscalls::unlink n)))
     582    (int-errno-call (#_unlink n))))
    615583
    616584(defun os-command (string)
    … …  
    749717    (#_close fd)))
    750718
    751 
    752 
    753 
    754 
    755 
    756 ;;; I believe that the Darwin/FreeBSD syscall infterface is rather ... odd.
    757 ;;; Use libc's interface.
    758719(defun pipe ()
    759720  ;;  (rlet ((filedes (:array :int 2)))
    … …  
    11541115created with :WAIT NIL.) Return T if successful; signal an error otherwise."
    11551116  (require-type proc 'external-process)
    1156   (let* ((pid (external-process-pid proc))
    1157          (error (syscall syscalls::kill pid signal)))
    1158     (or (eql error 0)
    1159         (%errno-disp error))))
     1117  (let* ((pid (external-process-pid proc)))
     1118    (when pid
     1119      (int-errno-call (#_kill pid signal)))))
     1120
    11601121
    11611122;;; EOF on a TTY is transient, but I'm less sure of other cases.
Note: See TracChangeset for help on using the changeset viewer.