Changeset 10516 for trunk/source/level-1/l1-sockets.lisp
- Timestamp:
- Aug 21, 2008, 11:57:33 AM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-sockets.lisp
r10515 r10516 148 148 "WITH-OPEN-SOCKET")) 149 149 150 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 ) 151 164 152 165 (define-condition socket-error (simple-stream-error) … … 1196 1209 1197 1210 (defun c_socket_1 (domain type protocol) 1198 (int-errno-call (#_socket 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)) 1199 1221 1200 1222 (defun c_socket (domain type protocol) … … 1242 1264 1243 1265 (defun c_bind (sockfd sockaddr addrlen) 1244 (int-errno-call (#_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)))) 1245 1285 1246 1286 … … 1254 1294 (progn 1255 1295 (fd-set-flags sockfd (logior flags #$O_NONBLOCK)) 1256 (let* ((err (int-errno-call (#_connect sockfd addr len)))) 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))))) 1257 1313 (cond ((or (eql err (- #$EINPROGRESS)) (eql err (- #$EINTR))) 1258 1314 (if (process-output-wait sockfd timeout-in-milliseconds) … … 1263 1319 1264 1320 (defun c_listen (sockfd backlog) 1265 (int-errno-call (#_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)))) 1266 1335 1267 1336 (defun c_accept (sockfd addrp addrlenp) 1268 (ignoring-eintr 1269 (int-errno-call (#_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))))) 1270 1354 1271 1355 (defun c_getsockname (sockfd addrp addrlenp) 1272 (int-errno-call (#_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)))) 1273 1372 1274 1373 (defun c_getpeername (sockfd addrp addrlenp) 1275 (int-errno-call (#_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)))) 1276 1390 1277 1391 (defun c_socketpair (domain type protocol socketsptr) 1278 (int-errno-call (#_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 1279 1429 1280 1430 1281 1431 (defun c_sendto (sockfd msgptr len flags addrp addrlen) 1282 (int-errno-call (#_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)))) 1283 1454 1284 1455 (defun c_recvfrom (sockfd bufptr len flags addrp addrlenp) 1285 (int-errno-call (#_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)))) 1286 1478 1287 1479 (defun c_shutdown (sockfd how) 1288 (int-errno-call (#_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)))) 1289 1494 1290 1495 (defun c_setsockopt (sockfd level optname optvalp optlen) 1291 (int-errno-call (#_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)))) 1292 1516 1293 1517 (defun c_getsockopt (sockfd level optname optvalp optlenp) 1294 (int-errno-call (#_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)))) 1295 1538 1296 1539 (defun c_sendmsg (sockfd msghdrp flags) 1297 (int-errno-call (#_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)))) 1298 1556 1299 1557 (defun c_recvmsg (sockfd msghdrp flags) 1300 (int-errno-call (#_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)))) 1301 1574 1302 1575
Note: See TracChangeset
for help on using the changeset viewer.