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

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

File:
1 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
Note: See TracChangeset for help on using the changeset viewer.