2433 |
@(return s) |
@(return s) |
2434 |
@) |
@) |
2435 |
|
|
2436 |
@(defun logical_pathname (pathname) |
|
2437 |
object s; |
@(defun logical_pathname (s) |
2438 |
vs_mark; |
enum type tp; |
2439 |
@ |
@ |
2440 |
s = pathname; |
|
2441 |
check_type_or_pathname_string_symbol_stream(&s); |
vs_mark; |
2442 |
s = coerce_to_pathname(s); vs_push(s); |
vs_push(s); |
2443 |
|
|
2444 |
if ((s->pn.pn_host == Cnil) || (s->pn.pn_host == sKunspecific)) { |
tp=type_of(s); |
2445 |
file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname); |
if (tp!=t_pathname && |
2446 |
s=Cnil; |
tp!=t_string && |
2447 |
} else |
tp!=t_symbol && |
2448 |
if ((s->pn.pn_device != Cnil) && (s->pn.pn_device != sKunspecific)) { |
tp!=t_stream) { |
2449 |
file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname); |
wrong_type_argument(TSor_pathname_string_symbol_stream, s); |
2450 |
s=Cnil; |
s=Cnil; |
2451 |
} else |
|
2452 |
|
} else { |
2453 |
|
|
2454 |
|
s = coerce_to_pathname(s); |
2455 |
|
vs_push(s); |
2456 |
|
|
2457 |
|
if ((s->pn.pn_host == Cnil) || (s->pn.pn_host == sKunspecific)) { |
2458 |
|
file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname); |
2459 |
|
s=Cnil; |
2460 |
|
} else |
2461 |
|
if ((s->pn.pn_device != Cnil) && (s->pn.pn_device != sKunspecific)) { |
2462 |
|
file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname); |
2463 |
|
s=Cnil; |
2464 |
|
} else |
2465 |
if (pathname_lookup(s->pn.pn_host,sSApathname_logicalA) == Cnil) { |
if (pathname_lookup(s->pn.pn_host,sSApathname_logicalA) == Cnil) { |
2466 |
file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname); |
file_type_error("Pathname ~S is not a ~S.",s, sLlogical_pathname); |
2467 |
s=Cnil; |
s=Cnil; |
2468 |
} |
} else |
2469 |
s->pn.pn_device = sKunspecific; |
s->pn.pn_device = sKunspecific; /*FIXME side effect*/ |
2470 |
|
} |
2471 |
|
|
2472 |
|
vs_reset; |
2473 |
|
@(return s) |
2474 |
|
|
|
vs_reset; |
|
|
@(return s) |
|
2475 |
@) |
@) |
2476 |
|
|
2477 |
|
|
2478 |
void |
void |
2479 |
gcl_init_pathname(void) |
gcl_init_pathname(void) |
2480 |
{ |
{ |
2539 |
make_function("TRANSLATE-PATHNAME", Ltranslate_pathname); |
make_function("TRANSLATE-PATHNAME", Ltranslate_pathname); |
2540 |
make_function("TRANSLATE-LOGICAL-PATHNAME", Ltranslate_logical_pathname); |
make_function("TRANSLATE-LOGICAL-PATHNAME", Ltranslate_logical_pathname); |
2541 |
make_function("LOGICAL-PATHNAME", Llogical_pathname); |
make_function("LOGICAL-PATHNAME", Llogical_pathname); |
2542 |
|
/* make_function("LOGICAL-PATHNAME-P", Llogical_pathname_p); */ |
2543 |
|
|
2544 |
make_si_function("WRAP-PATHNAME", Lwrap_pathname); |
make_si_function("WRAP-PATHNAME", Lwrap_pathname); |
2545 |
make_si_function("SEARCH-LOCAL-PATHNAME", Lsearch_local_pathname); |
make_si_function("SEARCH-LOCAL-PATHNAME", Lsearch_local_pathname); |