Changeset 10544

Show
Ignore:
Timestamp:
08/22/08 17:43:10 (3 months ago)
Author:
gb
Message:

Try again to use ff-calls, not syscalls (now that the transparent-union
dust has settled a bit.)

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

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

    r10516 r10544  
    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) 
    …… 
    12081195 
    12091196(defun c_socket_1 (domain type protocol) 
    1210   #-(or linuxppc-target solaris-target) 
    1211   (syscall syscalls::socket domain type protocol) 
    1212   #+linuxppc-target 
    1213   (rlet ((params (:array :unsigned-long 3))) 
    1214     (setf (paref params (:* :unsigned-long) 0) domain 
    1215           (paref params (:* :unsigned-long) 1) type 
    1216           (paref params (:* :unsigned-long) 2) protocol) 
    1217     (syscall syscalls::socketcall 1 params)) 
    1218   #+solaris-target 
    1219   (syscall syscalls::so_socket domain type protocol +null-ptr+ #$SOV_DEFAULT)) 
     1197  (int-errno-call (#_socket domain type protocol))) 
    12201198 
    12211199(defun c_socket (domain type protocol) 
    …… 
    12631241 
    12641242(defun c_bind (sockfd sockaddr addrlen) 
    1265   #-linuxppc-target 
    1266   (progn 
    1267     #+(or darwin-target freebsd-target) 
    1268     (setf (pref sockaddr :sockaddr_in.sin_len) addrlen) 
    1269     (syscall syscalls::bind sockfd sockaddr addrlen)) 
    1270   #+linuxppc-target 
    1271   (progn 
    1272     #+ppc32-target 
    1273     (%stack-block ((params 12)) 
    1274       (setf (%get-long params 0) sockfd 
    1275             (%get-ptr params 4) sockaddr 
    1276             (%get-long params 8) addrlen) 
    1277       (syscall syscalls::socketcall 2 params)) 
    1278     #+ppc64-target 
    1279     (%stack-block ((params 24)) 
    1280       (setf (%%get-unsigned-longlong params 0) sockfd 
    1281             (%get-ptr params 8) sockaddr 
    1282             (%%get-unsigned-longlong params 16) addrlen) 
    1283       (syscall syscalls::socketcall 2 params)))) 
     1243  (int-errno-call (#_bind sockfd sockaddr addrlen))) 
    12841244 
    12851245 
    …… 
    12931253         (progn 
    12941254           (fd-set-flags sockfd (logior flags #$O_NONBLOCK)) 
    1295            (let* ((err  
    1296                    #-linuxppc-target 
    1297                    (syscall syscalls::connect sockfd addr len) 
    1298                    #+linuxppc-target 
    1299                    (progn 
    1300                      #+ppc32-target 
    1301                      (%stack-block ((params 12)) 
    1302                        (setf (%get-long params 0) sockfd 
    1303                              (%get-ptr params 4) addr 
    1304                              (%get-long params 8) len) 
    1305                        (syscall syscalls::socketcall 3 params)) 
    1306                      #+ppc64-target 
    1307                      (%stack-block ((params 24)) 
    1308                        (setf (%%get-unsigned-longlong params 0) sockfd 
    1309                              (%get-ptr params 8) addr 
    1310                              (%%get-unsigned-longlong params 16) len) 
    1311                        (syscall syscalls::socketcall 3 params))))) 
     1255           (let* ((err (int-errno-call (#_connect sockfd addr len)))) 
    13121256             (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR))) 
    13131257                    (if (process-output-wait sockfd timeout-in-milliseconds) 
    …… 
    13181262 
    13191263(defun c_listen (sockfd backlog) 
    1320   #-linuxppc-target 
    1321   (syscall syscalls::listen sockfd backlog) 
    1322   #+linuxppc-target 
    1323   (progn 
    1324     #+ppc32-target 
    1325     (%stack-block ((params 8)) 
    1326       (setf (%get-long params 0) sockfd 
    1327             (%get-long params 4) backlog) 
    1328       (syscall syscalls::socketcall 4 params)) 
    1329     #+ppc64-target 
    1330     (%stack-block ((params 16)) 
    1331       (setf (%%get-unsigned-longlong params 0) sockfd 
    1332             (%%get-unsigned-longlong params 8) backlog) 
    1333       (syscall syscalls::socketcall 4 params)))) 
     1264  (int-errno-call (#_listen sockfd backlog))) 
    13341265 
    13351266(defun c_accept (sockfd addrp addrlenp) 
    1336   (ignoring-eintr  
    1337    #-linuxppc-target 
    1338    (syscall syscalls::accept sockfd addrp addrlenp) 
    1339    #+linuxppc-target 
    1340    (progn 
    1341      #+ppc32-target 
    1342      (%stack-block ((params 12)) 
    1343        (setf (%get-long params 0) sockfd 
    1344              (%get-ptr params 4) addrp 
    1345              (%get-ptr params 8) addrlenp) 
    1346        (syscall syscalls::socketcall 5 params)) 
    1347      #+ppc64-target 
    1348      (%stack-block ((params 24)) 
    1349        (setf (%%get-unsigned-longlong params 0) sockfd 
    1350              (%get-ptr params 8) addrp 
    1351              (%get-ptr params 16) addrlenp) 
    1352        (syscall syscalls::socketcall 5 params))))) 
     1267  (ignoring-eintr 
     1268   (int-errno-call (#_accept sockfd addrp addrlenp)))) 
    13531269 
    13541270(defun c_getsockname (sockfd addrp addrlenp) 
    1355   #-linuxppc-target 
    1356   (syscall syscalls::getsockname sockfd addrp addrlenp) 
    1357   #+linuxppc-target 
    1358   (progn 
    1359     #+ppc32-target 
    1360     (%stack-block ((params 12)) 
    1361       (setf (%get-long params 0) sockfd 
    1362             (%get-ptr params 4) addrp 
    1363             (%get-ptr params 8) addrlenp) 
    1364       (syscall syscalls::socketcall 6 params)) 
    1365     #+ppc64-target 
    1366     (%stack-block ((params 24)) 
    1367       (setf (%%get-unsigned-longlong params 0) sockfd 
    1368             (%get-ptr params 8) addrp 
    1369             (%get-ptr params 16) addrlenp) 
    1370       (syscall syscalls::socketcall 6 params)))) 
     1271  (int-errno-call (#_getsockname sockfd addrp addrlenp))) 
    13711272 
    13721273(defun c_getpeername (sockfd addrp addrlenp) 
    1373   #-linuxppc-target 
    1374   (syscall syscalls::getpeername sockfd addrp addrlenp) 
    1375   #+linuxppc-target 
    1376   (progn 
    1377     #+ppc32-target 
    1378     (%stack-block ((params 12)) 
    1379       (setf (%get-long params 0) sockfd 
    1380             (%get-ptr params 4) addrp 
    1381             (%get-ptr params 8) addrlenp) 
    1382       (syscall syscalls::socketcall 7 params)) 
    1383     #+ppc64-target 
    1384     (%stack-block ((params 24)) 
    1385       (setf (%%get-unsigned-longlong params 0) sockfd 
    1386             (%get-ptr params 8) addrp 
    1387             (%get-ptr params 16) addrlenp) 
    1388       (syscall syscalls::socketcall 7 params)))) 
     1274  (int-errno-call (#_getpeername sockfd addrp addrlenp))) 
    13891275 
    13901276(defun c_socketpair (domain type protocol socketsptr) 
    1391   #-(or linuxppc-target solaris-target) 
    1392   (syscall syscalls::socketpair domain type protocol socketsptr) 
    1393   #+linuxppc-target 
    1394   (progn 
    1395     #+ppc32-target 
    1396     (%stack-block ((params 16)) 
    1397       (setf (%get-long params 0) domain 
    1398             (%get-long params 4) type 
    1399             (%get-long params 8) protocol 
    1400             (%get-ptr params 12) socketsptr) 
    1401       (syscall syscalls::socketcall 8 params)) 
    1402     #+ppc64-target 
    1403     (%stack-block ((params 32)) 
    1404       (setf (%%get-unsigned-longlong params 0) domain 
    1405             (%%get-unsigned-longlong params 8) type 
    1406             (%%get-unsigned-longlong params 16) protocol 
    1407             (%get-ptr params 24) socketsptr) 
    1408       (syscall syscalls::socketcall 8 params))) 
    1409   #+solaris-target 
    1410   (let* ((fd1 (syscall syscalls::so_socket domain type protocol +null-ptr+ #$SOV_DEFAULT))) 
    1411     (if (>= fd1 0) 
    1412       (let* ((fd2 (syscall syscalls::so_socket domain type protocol +null-ptr+ #$SOV_DEFAULT))) 
    1413         (if (>= fd2 0) 
    1414           (progn 
    1415             (setf (paref socketsptr (:* :int) 0) fd1 
    1416                   (paref socketsptr (:* :int) 1) fd2) 
    1417             (let* ((res (syscall syscalls::so_socketpair socketsptr))) 
    1418               (when (< res 0) 
    1419                 (fd-close fd1) 
    1420                 (fd-close fd2)) 
    1421               res)) 
    1422           (progn 
    1423             (fd-close fd1) 
    1424             fd2))) 
    1425       fd1))) 
    1426  
    1427  
     1277  (int-errno-call (#_socketpair domain type protocol socketsptr))) 
    14281278 
    14291279 
    14301280(defun c_sendto (sockfd msgptr len flags addrp addrlen) 
    1431   #-linuxppc-target 
    1432   (syscall syscalls::sendto sockfd msgptr len flags addrp addrlen) 
    1433   #+linuxppc-target 
    1434   (progn 
    1435     #+ppc32-target 
    1436     (%stack-block ((params 24)) 
    1437       (setf (%get-long params 0) sockfd 
    1438             (%get-ptr params  4) msgptr 
    1439             (%get-long params 8) len 
    1440             (%get-long params 12) flags 
    1441             (%get-ptr params  16) addrp 
    1442             (%get-long params 20) addrlen) 
    1443       (syscall syscalls::socketcall 11 params)) 
    1444     #+ppc64-target 
    1445     (%stack-block ((params 48)) 
    1446       (setf (%%get-unsigned-longlong params 0) sockfd 
    1447             (%get-ptr params  8) msgptr 
    1448             (%%get-unsigned-longlong params 16) len 
    1449             (%%get-unsigned-longlong params 24) flags 
    1450             (%get-ptr params  32) addrp 
    1451             (%%get-unsigned-longlong params 40) addrlen) 
    1452       (syscall syscalls::socketcall 11 params)))) 
     1281  (int-errno-call (#_sendto sockfd msgptr len flags addrp addrlen))) 
    14531282 
    14541283(defun c_recvfrom (sockfd bufptr len flags addrp addrlenp) 
    1455   #-linuxppc-target 
    1456   (syscall syscalls::recvfrom sockfd bufptr len flags addrp addrlenp) 
    1457   #+linuxppc-target 
    1458   (progn 
    1459     #+ppc32-target 
    1460     (%stack-block ((params 24)) 
    1461       (setf (%get-long params 0) sockfd 
    1462             (%get-ptr params  4) bufptr 
    1463             (%get-long params 8) len 
    1464             (%get-long params 12) flags 
    1465             (%get-ptr params  16) addrp 
    1466             (%get-ptr params  20) addrlenp) 
    1467       (syscall syscalls::socketcall 12 params)) 
    1468     #+ppc64-target 
    1469     (%stack-block ((params 48)) 
    1470       (setf (%get-long params 0) sockfd 
    1471             (%get-ptr params  8) bufptr 
    1472             (%get-long params 16) len 
    1473             (%get-long params 24) flags 
    1474             (%get-ptr params  32) addrp 
    1475             (%get-ptr params  40) addrlenp) 
    1476       (syscall syscalls::socketcall 12 params)))) 
     1284  (int-errno-call (#_recvfrom sockfd bufptr len flags addrp addrlenp))) 
    14771285 
    14781286(defun c_shutdown (sockfd how) 
    1479   #-linuxppc-target 
    1480   (syscall syscalls::shutdown sockfd how) 
    1481   #+linuxppc-target 
    1482   (progn 
    1483     #+ppc32-target 
    1484     (%stack-block ((params 8)) 
    1485       (setf (%get-long params 0) sockfd 
    1486             (%get-long params 4) how) 
    1487       (syscall syscalls::socketcall 13 params)) 
    1488     #+ppc64-target 
    1489     (%stack-block ((params 16)) 
    1490       (setf (%%get-unsigned-longlong params 0) sockfd 
    1491             (%%get-unsigned-longlong params 8) how) 
    1492       (syscall syscalls::socketcall 13 params)))) 
     1287  (int-errno-call (#_shutdown sockfd how))) 
    14931288 
    14941289(defun c_setsockopt (sockfd level optname optvalp optlen) 
    1495   #-linuxppc-target 
    1496   (syscall syscalls::setsockopt sockfd level optname optvalp optlen) 
    1497   #+linuxppc-target 
    1498   (progn 
    1499     #+ppc32-target 
    1500     (%stack-block ((params 20)) 
    1501       (setf (%get-long params 0) sockfd 
    1502             (%get-long params 4) level 
    1503             (%get-long params 8) optname 
    1504             (%get-ptr params 12) optvalp 
    1505             (%get-long params 16) optlen) 
    1506       (syscall syscalls::socketcall 14 params)) 
    1507     #+ppc64-target 
    1508     (%stack-block ((params 40)) 
    1509       (setf (%%get-unsigned-longlong params 0) sockfd 
    1510             (%%get-unsigned-longlong params 8) level 
    1511             (%%get-unsigned-longlong params 16) optname 
    1512             (%get-ptr params 24) optvalp 
    1513             (%%get-unsigned-longlong params 32) optlen) 
    1514       (syscall syscalls::socketcall 14 params)))) 
     1290  (int-errno-call (#_setsockopt sockfd level optname optvalp optlen))) 
    15151291 
    15161292(defun c_getsockopt (sockfd level optname optvalp optlenp) 
    1517   #-linuxppc-target 
    1518   (syscall syscalls::getsockopt sockfd level optname optvalp optlenp) 
    1519   #+linuxppc-target 
    1520   (progn 
    1521     #+ppc32-target 
    1522     (%stack-block ((params 20)) 
    1523       (setf (%get-long params 0) sockfd 
    1524             (%get-long params 4) level 
    1525             (%get-long params 8) optname 
    1526             (%get-ptr params 12) optvalp 
    1527             (%get-ptr params 16) optlenp) 
    1528       (syscall syscalls::socketcall 15 params)) 
    1529     #+ppc64-target 
    1530     (%stack-block ((params 40)) 
    1531       (setf (%%get-unsigned-longlong params 0) sockfd 
    1532             (%%get-unsigned-longlong params 8) level 
    1533             (%%get-unsigned-longlong params 16) optname 
    1534             (%get-ptr params 24) optvalp 
    1535             (%get-ptr params 32) optlenp) 
    1536       (syscall syscalls::socketcall 15 params)))) 
     1293  (int-errno-call (#_getsockopt sockfd level optname optvalp optlenp))) 
    15371294 
    15381295(defun c_sendmsg (sockfd msghdrp flags) 
    1539   #-linuxppc-target 
    1540   (syscall syscalls::sendmsg sockfd msghdrp flags) 
    1541   #+linuxppc-target 
    1542   (progn 
    1543     #+ppc32-target 
    1544     (%stack-block ((params 12)) 
    1545       (setf (%get-long params 0) sockfd 
    1546             (%get-ptr params 4) msghdrp 
    1547             (%get-long params 8) flags) 
    1548       (syscall syscalls::socketcall 16 params)) 
    1549     #+ppc64-target 
    1550     (%stack-block ((params 24)) 
    1551       (setf (%%get-unsigned-longlong params 0) sockfd 
    1552             (%get-ptr params 8) msghdrp 
    1553             (%%get-unsigned-longlong params 16) flags) 
    1554       (syscall syscalls::socketcall 16 params)))) 
     1296  (int-errno-call (#_sendmsg sockfd msghdrp flags))) 
    15551297 
    15561298(defun c_recvmsg (sockfd msghdrp flags) 
    1557   #-linuxppc-target 
    1558   (syscall syscalls::recvmsg sockfd msghdrp flags) 
    1559   #+linuxppc-target 
    1560   (progn 
    1561     #+ppc32-target 
    1562     (%stack-block ((params 12)) 
    1563       (setf (%get-long params 0) sockfd 
    1564             (%get-ptr params 4) msghdrp 
    1565             (%get-long params 8) flags) 
    1566       (syscall syscalls::socketcall 17 params)) 
    1567     #+ppc64-target 
    1568     (%stack-block ((params 24)) 
    1569       (setf (%%get-unsigned-longlong params 0) sockfd 
    1570             (%get-ptr params 8) msghdrp 
    1571             (%%get-unsigned-longlong params 16) flags) 
    1572       (syscall syscalls::socketcall 17 params)))) 
     1299  (int-errno-call   (#_recvmsg sockfd msghdrp flags))) 
    15731300  
    15741301;;; Return a list of currently configured interfaces, a la ifconfig.