kread.c (31206B)
1 /* 2 ** kread.c 3 ** Reader for the Kernel Programming Language 4 ** See Copyright Notice in klisp.h 5 */ 6 7 #include <stdio.h> 8 #include <string.h> 9 #include <stdlib.h> 10 11 #include "kread.h" 12 #include "kobject.h" 13 #include "kpair.h" 14 #include "ktoken.h" 15 #include "kstate.h" 16 #include "kerror.h" 17 #include "ktable.h" 18 #include "kport.h" 19 #include "kstring.h" 20 21 22 /* 23 ** Stack for the read FSM 24 ** 25 ** There is always one state in the stack while read is in process and 26 ** selects the action to be performed on the next read token. 27 ** 28 ** The data saved in the stack is below the state and changes according to it: 29 ** ST_FIRST_LIST: pair representing the first pair of the list 30 ** with source info of the '(' token. 31 ** ST_MIDDLE_LIST, ST_LAST_ILIST: two elements, first below, second on top: 32 ** - a pair with car: first pair of the list (with source info 33 ** corrected to car of list) and cdr: source info of the '(' token that 34 ** started the [i]list. 35 ** - another pair, that is the last pair of the list so far. 36 ** ST_PAST_LAST_ILIST: a pair with car: first pair and cdr: source 37 ** info as above (but no pair with last pair). 38 ** ST_SHARED_DEF: a pair with car: shared def token and cdr: source 39 ** info of the shared def token. 40 ** ST_SEXP_COMMENT: the source info of the comment token 41 ** ST_FIRST_EOF_LIST: first pair of the list (with source info, start of file) 42 ** ST_MIDDLE_EOF_LIST: two elements, first below, second on top: 43 ** - a pair with car: first pair of the list (with source info corrected 44 ** to car of list) and cdr: source info of the start of file. 45 ** - last pair of the list so far. 46 */ 47 48 typedef enum { 49 ST_READ, ST_SHARED_DEF, ST_LAST_ILIST, ST_PAST_LAST_ILIST, 50 ST_FIRST_LIST, ST_MIDDLE_LIST, ST_SEXP_COMMENT, ST_FIRST_EOF_LIST, 51 ST_MIDDLE_EOF_LIST 52 } state_t; 53 54 #define push_state(kst_, st_) (ks_spush(kst_, (i2tv((int32_t)(st_))))) 55 #define get_state(kst_) ((state_t) ivalue(ks_sget(kst_))) 56 #define pop_state(kst_) (ks_sdpop(kst_)) 57 58 #define push_data(kst_, st_) (ks_spush(kst_, st_)) 59 #define get_data(kst_) (ks_sget(kst_)) 60 #define pop_data(kst_) (ks_sdpop(kst_)) 61 62 63 /* 64 ** Error management 65 */ 66 #define kread_error(K, str) \ 67 kread_error_g(K, str, false, KINERT) 68 #define kread_error_extra(K, str, extra) \ 69 kread_error_g(K, str, true, extra) 70 71 void kread_error_g(klisp_State *K, char *str, bool extra, TValue extra_value) 72 { 73 /* all cleaning is done in throw 74 (stacks, shared_dict, rooted objs) */ 75 76 /* save the source code info on the port */ 77 kport_update_source_info(K->curr_port, K->ktok_source_info.line, 78 K->ktok_source_info.col); 79 80 /* include the source info (and extra value if present) in the error */ 81 TValue irritants; 82 if (extra) { 83 krooted_tvs_push(K, extra_value); /* will be popped by throw */ 84 TValue si = ktok_get_source_info(K); 85 krooted_tvs_push(K, si); /* will be popped by throw */ 86 irritants = klist_g(K, false, 2, si, extra_value); 87 } else { 88 irritants = ktok_get_source_info(K); 89 } 90 krooted_tvs_push(K, irritants); /* will be popped by throw */ 91 klispE_throw_with_irritants(K, str, irritants); 92 } 93 94 /* 95 ** Shared Reference Management (srfi-38) 96 */ 97 98 /* clear_shared_dict is defined in ktoken to allow cleaning up before errors */ 99 /* It is called after kread to clear the shared alist */ 100 TValue try_shared_ref(klisp_State *K, TValue ref_token) 101 { 102 /* IMPLEMENTATION RESTRICTION: only allow fixints in shared tokens */ 103 int32_t ref_num = ivalue(kcdr(ref_token)); 104 TValue tail = K->shared_dict; 105 while (!ttisnil(tail)) { 106 TValue head = kcar(tail); 107 if (ref_num == ivalue(kcar(head))) 108 return kcdr(head); 109 tail = kcdr(tail); 110 } 111 112 kread_error_extra(K, "undefined shared ref found", i2tv(ref_num)); 113 /* avoid warning */ 114 return KINERT; 115 } 116 117 /* GC: def token is rooted */ 118 void try_shared_def(klisp_State *K, TValue def_token, TValue value) 119 { 120 /* IMPLEMENTATION RESTRICTION: only allow fixints in shared tokens */ 121 int32_t ref_num = ivalue(kcdr(def_token)); 122 TValue tail = K->shared_dict; 123 while (!ttisnil(tail)) { 124 TValue head = kcar(tail); 125 if (ref_num == ivalue(kcar(head))) { 126 kread_error_extra(K, "duplicate shared def found", i2tv(ref_num)); 127 /* avoid warning */ 128 return; 129 } 130 tail = kcdr(tail); 131 } 132 133 TValue new_tok = kcons(K, kcdr(def_token), value); 134 krooted_tvs_push(K, new_tok); 135 K->shared_dict = kcons(K, new_tok, K->shared_dict); 136 krooted_tvs_pop(K); 137 return; 138 } 139 140 /* This overwrites a previouly made def, it is used in '() */ 141 /* NOTE: the shared def is guaranteed to exist */ 142 void change_shared_def(klisp_State *K, TValue def_token, TValue value) 143 { 144 /* IMPLEMENTATION RESTRICTION: only allow fixints in shared tokens */ 145 int32_t ref_num = ivalue(kcdr(def_token)); 146 TValue tail = K->shared_dict; 147 while (!ttisnil(tail)) { 148 TValue head = kcar(tail); 149 if (ref_num == ivalue(kcar(head))) { 150 kset_cdr(head, value); 151 return; 152 } 153 tail = kcdr(tail); 154 } 155 klisp_assert(0); /* shouldn't happen */ 156 return; 157 } 158 159 /* NOTE: the shared def is guaranteed to exist */ 160 void remove_shared_def(klisp_State *K, TValue def_token) 161 { 162 /* IMPLEMENTATION RESTRICTION: only allow fixints in shared tokens */ 163 int32_t ref_num = ivalue(kcdr(def_token)); 164 TValue tail = K->shared_dict; 165 TValue last_pair = KNIL; 166 while (!ttisnil(tail)) { 167 TValue head = kcar(tail); 168 if (ref_num == ivalue(kcar(head))) { 169 if (ttisnil(last_pair)) { 170 /* this is the first value */ 171 K->shared_dict = kcdr(tail); 172 } else { 173 kset_cdr(last_pair, kcdr(tail)); 174 } 175 return; 176 } 177 last_pair = tail; 178 tail = kcdr(tail); 179 } 180 klisp_assert(0); /* shouldn't happen */ 181 return; 182 } 183 184 /* 185 ** Reader FSM 186 */ 187 188 /* 189 ** listp: 190 ** false: read one value 191 ** true: read all values as a list 192 */ 193 194 /* TEMP: For now we'll use just one big function */ 195 TValue kread_fsm(klisp_State *K, bool listp) 196 { 197 /* TODO add more specific sexp comment error msgs */ 198 /* TODO replace some read errors with asserts where appropriate */ 199 klisp_assert(ks_sisempty(K)); 200 klisp_assert(ttisnil(K->shared_dict)); 201 202 push_state(K, ST_READ); 203 204 if (listp) { /* read a list of values */ 205 /* create the first pair */ 206 TValue np = kcons_g(K, K->read_mconsp, KINERT, KNIL); 207 krooted_tvs_push(K, np); 208 /* 209 ** NOTE: the source info of the start of file is temporarily 210 ** saved in np (later it will be replace by the source info 211 ** of the car of the list) 212 */ 213 TValue si = ktok_get_source_info(K); 214 krooted_tvs_push(K, si); 215 #if KTRACK_SI 216 kset_source_info(K, np, si); 217 #endif 218 krooted_tvs_pop(K); 219 push_data(K, np); 220 krooted_tvs_pop(K); 221 push_state(K, ST_FIRST_EOF_LIST); 222 } 223 224 /* read next token or process obj */ 225 bool read_next_token = true; 226 /* the obj just read/completed */ 227 TValue obj = KINERT; /* put some value for gc */ 228 /* the source code information of that obj */ 229 TValue obj_si = KNIL; /* put some value for gc */ 230 int32_t sexp_comments = 0; 231 TValue last_sexp_comment_si = KNIL; /* put some value for gc */ 232 /* list of shared list, each element represent a nested sexp comment, 233 each is a list of shared defs in that particular level, to be 234 undefined after the sexp comment ends */ 235 TValue sexp_comment_shared = KNIL; 236 237 krooted_vars_push(K, &obj); 238 krooted_vars_push(K, &obj_si); 239 krooted_vars_push(K, &last_sexp_comment_si); 240 krooted_vars_push(K, &sexp_comment_shared); 241 242 while (!(get_state(K) == ST_READ && !read_next_token)) { 243 if (read_next_token) { 244 TValue tok = ktok_read_token(K); /* only root it when necessary */ 245 246 if (ttispair(tok)) { /* special token */ 247 switch (chvalue(kcar(tok))) { 248 case '(': { 249 if (get_state(K) == ST_PAST_LAST_ILIST) { 250 kread_error(K, "open paren found after " 251 "last element of improper list"); 252 /* avoid warning */ 253 return KINERT; 254 } 255 /* construct the list with the correct type of pair */ 256 TValue np = kcons_g(K, K->read_mconsp, KINERT, KNIL); 257 krooted_tvs_push(K, np); 258 /* 259 ** NOTE: the source info of the '(' is temporarily saved 260 ** in np (later it will be replace by the source info 261 ** of the car of the list 262 */ 263 TValue si = ktok_get_source_info(K); 264 krooted_tvs_push(K, si); 265 #if KTRACK_SI 266 kset_source_info(K, np, si); 267 #endif 268 krooted_tvs_pop(K); 269 /* update the shared def to point to the new list */ 270 /* NOTE: this is necessary for self referencing lists */ 271 /* NOTE: the shared def was already checked for errors */ 272 if (get_state(K) == ST_SHARED_DEF) { 273 /* take the state out of the way */ 274 pop_state(K); 275 change_shared_def(K, kcar(get_data(K)), np); 276 push_state(K, ST_SHARED_DEF); 277 } 278 279 /* start reading elements of the new list */ 280 push_data(K, np); 281 push_state(K, ST_FIRST_LIST); 282 read_next_token = true; 283 284 krooted_tvs_pop(K); 285 break; 286 } 287 case ')': { 288 switch(get_state(K)) { 289 case ST_FIRST_LIST: { /* empty list */ 290 /* 291 ** Discard the pair in sdata but 292 ** retain the source info 293 ** Return () for processing 294 */ 295 pop_state(K); 296 TValue fp_with_old_si = get_data(K); 297 pop_data(K); 298 299 obj = KNIL; 300 #if KTRACK_SI 301 obj_si = kget_source_info(K, fp_with_old_si); 302 #else 303 UNUSED(fp_with_old_si); 304 obj_si = KNIL; 305 #endif 306 read_next_token = false; 307 break; 308 } 309 case ST_MIDDLE_LIST: /* end of list */ 310 case ST_PAST_LAST_ILIST: { /* end of ilist */ 311 pop_state(K); 312 /* discard info on last pair */ 313 pop_data(K); 314 pop_state(K); 315 TValue fp_old_si = get_data(K); 316 pop_data(K); 317 /* list read ok, process it in next iteration */ 318 obj = kcar(fp_old_si); 319 obj_si = kcdr(fp_old_si); 320 read_next_token = false; 321 break; 322 } 323 case ST_LAST_ILIST: 324 kread_error(K, "missing last element in " 325 "improper list"); 326 /* avoid warning */ 327 return KINERT; 328 case ST_SHARED_DEF: 329 kread_error(K, "unmatched closing paren found " 330 "in shared def"); 331 /* avoid warning */ 332 return KINERT; 333 case ST_SEXP_COMMENT: 334 kread_error_extra(K, "unmatched closing paren found in " 335 "sexp comment", last_sexp_comment_si); 336 /* avoid warning */ 337 return KINERT; 338 case ST_READ: 339 case ST_FIRST_EOF_LIST: 340 case ST_MIDDLE_EOF_LIST: 341 kread_error(K, "unmatched closing paren found"); 342 /* avoid warning */ 343 return KINERT; 344 default: 345 /* shouldn't happen */ 346 kread_error(K, "Unknown read state in )"); 347 /* avoid warning */ 348 return KINERT; 349 } 350 break; 351 } 352 case '.': { 353 switch(get_state(K)) { 354 case (ST_MIDDLE_LIST): 355 /* tok ok, read next obj for cdr of ilist */ 356 pop_state(K); 357 push_state(K, ST_LAST_ILIST); 358 read_next_token = true; 359 break; 360 case ST_FIRST_LIST: 361 kread_error(K, "missing first element of " 362 "improper list"); 363 /* avoid warning */ 364 return KINERT; 365 case ST_LAST_ILIST: 366 case ST_PAST_LAST_ILIST: 367 kread_error(K, "double dot in improper list"); 368 /* avoid warning */ 369 return KINERT; 370 case ST_SHARED_DEF: 371 kread_error(K, "dot found in shared def"); 372 /* avoid warning */ 373 return KINERT; 374 case ST_SEXP_COMMENT: 375 kread_error_extra(K, "dot found outside list in sexp " 376 "comment", last_sexp_comment_si); 377 /* avoid warning */ 378 return KINERT; 379 case ST_READ: 380 case ST_FIRST_EOF_LIST: 381 case ST_MIDDLE_EOF_LIST: 382 kread_error(K, "dot found outside list"); 383 /* avoid warning */ 384 return KINERT; 385 default: 386 /* shouldn't happen */ 387 kread_error(K, "Unknown read state in ."); 388 /* avoid warning */ 389 return KINERT; 390 } 391 break; 392 } 393 case '=': { /* srfi-38 shared def */ 394 switch (get_state(K)) { 395 case ST_SHARED_DEF: 396 kread_error(K, "shared def found in " 397 "shared def"); 398 /* avoid warning */ 399 return KINERT; 400 case ST_PAST_LAST_ILIST: 401 kread_error(K, "shared def found after " 402 "last element of improper list"); 403 /* avoid warning */ 404 return KINERT; 405 default: { 406 krooted_tvs_push(K, tok); 407 try_shared_def(K, tok, KNIL); 408 /* token ok */ 409 /* save the token for later undefining */ 410 if (sexp_comments > 0) { 411 kset_car(sexp_comment_shared, 412 kcons(K, tok, kcar(sexp_comment_shared))); 413 } 414 /* read defined object */ 415 /* NOTE: save the source info to return it 416 after the defined object is read */ 417 TValue si = ktok_get_source_info(K); 418 krooted_tvs_push(K, si); 419 push_data(K, kcons(K, tok, si)); 420 krooted_tvs_pop(K); 421 krooted_tvs_pop(K); 422 push_state(K, ST_SHARED_DEF); 423 read_next_token = true; 424 } 425 } 426 break; 427 } 428 case '#': { /* srfi-38 shared ref */ 429 switch(get_state(K)) { 430 case ST_SHARED_DEF: 431 kread_error(K, "shared ref found in " 432 "shared def"); 433 /* avoid warning */ 434 return KINERT; 435 case ST_PAST_LAST_ILIST: 436 kread_error(K, "shared ref found after " 437 "last element of improper list"); 438 /* avoid warning */ 439 return KINERT; 440 default: { 441 TValue res = try_shared_ref(K, tok); 442 /* ref ok, process it in next iteration */ 443 obj = res; 444 /* NOTE: use source info of ref token */ 445 obj_si = ktok_get_source_info(K); 446 read_next_token = false; 447 } 448 } 449 break; 450 } 451 case ';': { /* sexp comment */ 452 klisp_assert(sexp_comments < 1000); 453 ++sexp_comments; 454 sexp_comment_shared = 455 kcons(K, KNIL, sexp_comment_shared); 456 push_data(K, last_sexp_comment_si); 457 push_state(K, ST_SEXP_COMMENT); 458 last_sexp_comment_si = ktok_get_source_info(K); 459 read_next_token = true; 460 break; 461 } 462 default: 463 /* shouldn't happen */ 464 kread_error(K, "unknown special token"); 465 /* avoid warning */ 466 return KINERT; 467 } 468 } else if (ttiseof(tok)) { 469 switch (get_state(K)) { 470 case ST_SEXP_COMMENT: 471 kread_error_extra(K, "EOF found while reading sexp " 472 " comment", last_sexp_comment_si); 473 /* avoid warning */ 474 return KINERT; 475 case ST_FIRST_EOF_LIST: { 476 pop_state(K); 477 TValue fp_with_old_si = get_data(K); 478 pop_data(K); 479 obj = KNIL; 480 #if KTRACK_SI 481 obj_si = kget_source_info(K, fp_with_old_si); 482 #else 483 UNUSED(fp_with_old_si); 484 obj_si = KNIL; 485 #endif 486 read_next_token = false; 487 break; 488 } 489 case ST_MIDDLE_EOF_LIST: { 490 pop_state(K); 491 /* discard info on last pair */ 492 pop_data(K); 493 pop_state(K); 494 TValue fp_old_si = get_data(K); 495 pop_data(K); 496 /* list read ok, process it in next iteration */ 497 obj = kcar(fp_old_si); 498 obj_si = kcdr(fp_old_si); 499 read_next_token = false; 500 break; 501 } 502 case ST_READ: 503 obj = tok; 504 obj_si = ktok_get_source_info(K); 505 /* will exit in next loop */ 506 read_next_token = false; 507 break; 508 case ST_FIRST_LIST: 509 case ST_MIDDLE_LIST: 510 kread_error(K, "EOF found while reading list"); 511 /* avoid warning */ 512 return KINERT; 513 case ST_LAST_ILIST: 514 case ST_PAST_LAST_ILIST: 515 kread_error(K, "EOF found while reading " 516 "improper list"); 517 /* avoid warning */ 518 return KINERT; 519 case ST_SHARED_DEF: 520 kread_error(K, "EOF found in shared def"); 521 /* avoid warning */ 522 return KINERT; 523 default: 524 /* shouldn't happen */ 525 kread_error(K, "unknown read state in EOF"); 526 /* avoid warning */ 527 return KINERT; 528 } 529 } else { /* this can only be a complete token */ 530 if (get_state(K) == ST_PAST_LAST_ILIST) { 531 kread_error(K, "Non paren found after last " 532 "element of improper list"); 533 /* avoid warning */ 534 return KINERT; 535 } else { 536 /* token ok, process it in next iteration */ 537 obj = tok; 538 obj_si = ktok_get_source_info(K); 539 read_next_token = false; 540 } 541 } 542 } else { /* read_next_token == false */ 543 /* process the object just read */ 544 switch(get_state(K)) { 545 case ST_FIRST_EOF_LIST: 546 case ST_FIRST_LIST: { 547 state_t state = get_state(K); 548 /* get the state out of the way */ 549 pop_state(K); 550 TValue fp = get_data(K); 551 /* replace source info in fp with the saved one */ 552 /* NOTE: the old one will be returned when list is complete */ 553 /* GC: the way things are done here fp is rooted at all 554 times */ 555 #if KTRACK_SI 556 TValue fp_old_si = kget_source_info(K, fp); 557 #else 558 TValue fp_old_si = KNIL; 559 #endif 560 krooted_tvs_push(K, fp); 561 krooted_tvs_push(K, fp_old_si); 562 #if KTRACK_SI 563 kset_source_info(K, fp, obj_si); 564 #endif 565 kset_car_unsafe(K, fp, obj); 566 567 /* continue reading objects of list */ 568 /* save first & last pair of the (still incomplete) list */ 569 pop_data(K); 570 push_data(K, kcons (K, fp, fp_old_si)); 571 krooted_tvs_pop(K); 572 krooted_tvs_pop(K); 573 push_state(K, state); 574 push_data(K, fp); 575 if (state == ST_FIRST_LIST) { 576 push_state(K, ST_MIDDLE_LIST); 577 } else { 578 push_state(K, ST_MIDDLE_EOF_LIST); 579 /* shared dict must be cleared after every element 580 of an eof list */ 581 clear_shared_dict(K); 582 } 583 read_next_token = true; 584 break; 585 } 586 case ST_MIDDLE_LIST: 587 case ST_MIDDLE_EOF_LIST: { 588 state_t state = get_state(K); 589 /* get the state out of the way */ 590 pop_state(K); 591 /* construct the list with the correct type of pair */ 592 /* GC: np is rooted by push_data */ 593 TValue np = kcons_g(K, K->read_mconsp, obj, KNIL); 594 krooted_tvs_push(K, np); 595 #if KTRACK_SI 596 kset_source_info(K, np, obj_si); 597 #endif 598 kset_cdr_unsafe(K, get_data(K), np); 599 /* replace last pair of the (still incomplete) read next obj */ 600 pop_data(K); 601 push_data(K, np); 602 push_state(K, state); 603 if (state == ST_MIDDLE_EOF_LIST) { 604 /* shared dict must be cleared after every element 605 of an eof list */ 606 clear_shared_dict(K); 607 } 608 krooted_tvs_pop(K); 609 read_next_token = true; 610 break; 611 } 612 case ST_LAST_ILIST: 613 /* only change the state, keep the pair data to simplify 614 the close paren code (same as for ST_MIDDLE_LIST) */ 615 pop_state(K); 616 kset_cdr_unsafe(K, get_data(K), obj); 617 push_state(K, ST_PAST_LAST_ILIST); 618 read_next_token = true; 619 break; 620 case ST_SHARED_DEF: { 621 /* shared def completed, continue processing obj */ 622 pop_state(K); 623 TValue def_si = get_data(K); 624 pop_data(K); 625 626 change_shared_def(K, kcar(def_si), obj); 627 628 /* obj = obj; */ 629 /* the source info returned is the one from the shared def */ 630 obj_si = kcdr(def_si); 631 read_next_token = false; 632 break; 633 } 634 case ST_READ: 635 /* this shouldn't happen, should've exited the while */ 636 kread_error(K, "invalid read state (read in while)"); 637 /* avoid warning */ 638 return KINERT; 639 case ST_SEXP_COMMENT: 640 klisp_assert(sexp_comments > 0); 641 --sexp_comments; 642 /* undefine all shared obj defined in the context 643 of this sexp comment */ 644 while(!ttisnil(kcar(sexp_comment_shared))) { 645 TValue first = kcaar(sexp_comment_shared); 646 remove_shared_def(K, first); 647 kset_car(sexp_comment_shared, kcdar(sexp_comment_shared)); 648 } 649 sexp_comment_shared = kcdr(sexp_comment_shared); 650 pop_state(K); 651 last_sexp_comment_si = get_data(K); 652 pop_data(K); 653 read_next_token = true; 654 break; 655 default: 656 /* shouldn't happen */ 657 kread_error(K, "unknown read state in process obj"); 658 /* avoid warning */ 659 return KINERT; 660 } 661 } 662 } 663 664 krooted_vars_pop(K); 665 krooted_vars_pop(K); 666 krooted_vars_pop(K); 667 krooted_vars_pop(K); 668 669 pop_state(K); 670 klisp_assert(ks_sisempty(K)); 671 return obj; 672 } 673 674 /* 675 ** Reader Main Function 676 */ 677 TValue kread(klisp_State *K, bool listp) 678 { 679 klisp_assert(ttisnil(K->shared_dict)); 680 681 TValue obj = kread_fsm(K, listp); 682 clear_shared_dict(K); /* clear after function to allow earlier gc */ 683 return obj; 684 } 685 686 /* port is protected from GC in curr_port */ 687 TValue kread_from_port_g(klisp_State *K, TValue port, bool mut, bool listp) 688 { 689 if (!tv_equal(port, K->curr_port)) { 690 K->ktok_seen_eof = false; /* WORKAROUND: for repl problem with eofs */ 691 K->curr_port = port; 692 } 693 K->read_mconsp = mut; 694 695 ktok_set_source_info(K, kport_filename(port), 696 kport_line(port), kport_col(port)); 697 698 TValue obj = kread(K, listp); 699 700 kport_update_source_info(port, K->ktok_source_info.line, 701 K->ktok_source_info.col); 702 return obj; 703 } 704 705 /* 706 ** Reader Interface 707 */ 708 709 TValue kread_from_port(klisp_State *K, TValue port, bool mut) 710 { 711 klisp_assert(ttisport(port)); 712 klisp_assert(kport_is_input(port)); 713 klisp_assert(kport_is_open(port)); 714 klisp_assert(kport_is_textual(port)); 715 return kread_from_port_g(K, port, mut, false); 716 } 717 718 TValue kread_list_from_port(klisp_State *K, TValue port, bool mut) 719 { 720 klisp_assert(ttisport(port)); 721 klisp_assert(kport_is_input(port)); 722 klisp_assert(kport_is_open(port)); 723 klisp_assert(kport_is_textual(port)); 724 return kread_from_port_g(K, port, mut, true); 725 } 726 727 TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek) 728 { 729 klisp_assert(ttisport(port)); 730 klisp_assert(kport_is_input(port)); 731 klisp_assert(kport_is_open(port)); 732 klisp_assert(kport_is_textual(port)); 733 734 if (!tv_equal(port, K->curr_port)) { 735 K->ktok_seen_eof = false; /* WORKAROUND: for repl problem with eofs */ 736 K->curr_port = port; 737 } 738 int ch; 739 if (peek) { 740 ch = ktok_peekc(K); 741 } else { 742 ktok_set_source_info(K, kport_filename(port), 743 kport_line(port), kport_col(port)); 744 ch = ktok_getc(K); 745 kport_update_source_info(port, K->ktok_source_info.line, 746 K->ktok_source_info.col); 747 } 748 return ch == EOF? KEOF : ch2tv((char)ch); 749 } 750 751 TValue kread_peek_u8_from_port(klisp_State *K, TValue port, bool peek) 752 { 753 klisp_assert(ttisport(port)); 754 klisp_assert(kport_is_input(port)); 755 klisp_assert(kport_is_open(port)); 756 klisp_assert(kport_is_binary(port)); 757 758 if (!tv_equal(port, K->curr_port)) { 759 K->ktok_seen_eof = false; /* WORKAROUND: for repl problem with eofs */ 760 K->curr_port = port; 761 } 762 int32_t u8; 763 if (peek) { 764 u8 = ktok_peekc(K); 765 } else { 766 ktok_set_source_info(K, kport_filename(port), 767 kport_line(port), kport_col(port)); 768 u8 = ktok_getc(K); 769 kport_update_source_info(port, K->ktok_source_info.line, 770 K->ktok_source_info.col); 771 } 772 return u8 == EOF? KEOF : i2tv(u8 & 0xff); 773 } 774 775 TValue kread_line_from_port(klisp_State *K, TValue port) 776 { 777 klisp_assert(ttisport(port)); 778 klisp_assert(kport_is_input(port)); 779 klisp_assert(kport_is_open(port)); 780 klisp_assert(kport_is_textual(port)); 781 782 if (!tv_equal(port, K->curr_port)) { 783 K->ktok_seen_eof = false; /* WORKAROUND: for repl problem with eofs */ 784 K->curr_port = port; 785 } 786 787 uint32_t size = MINREADLINEBUFFER; 788 uint32_t i = 0; 789 int ch; 790 TValue new_str = kstring_new_s(K, size); 791 krooted_vars_push(K, &new_str); 792 793 char *buf = kstring_buf(new_str); 794 ktok_set_source_info(K, kport_filename(port), 795 kport_line(port), kport_col(port)); 796 bool found_newline = false; 797 while(true) { 798 ch = ktok_getc(K); 799 if (ch == EOF) { 800 break; 801 } else if (ch == '\n') { 802 /* adjust string to the right size if necessary */ 803 if (i < size) { 804 new_str = kstring_new_bs(K, kstring_buf(new_str), i); 805 } 806 found_newline = true; 807 break; 808 } else { 809 if (i == size) { 810 size *= 2; 811 char *old_buf = kstring_buf(new_str); 812 new_str = kstring_new_s(K, size); 813 buf = kstring_buf(new_str); 814 /* copy the data we have */ 815 memcpy(buf, old_buf, i); 816 buf += i; 817 } 818 *buf++ = (char) ch; 819 ++i; 820 } 821 } 822 kport_update_source_info(port, K->ktok_source_info.line, 823 K->ktok_source_info.col); 824 krooted_vars_pop(K); 825 return found_newline? new_str : KEOF; 826 } 827 828 /* This is needed by the repl to ignore trailing spaces (especially newlines) 829 that could affect the (freshly reset) source info */ 830 void kread_clear_leading_whitespace_from_port(klisp_State *K, TValue port) 831 { 832 if (!tv_equal(port, K->curr_port)) { 833 K->ktok_seen_eof = false; /* WORKAROUND: for repl problem with eofs */ 834 K->curr_port = port; 835 } 836 /* source code info isn't important because it will be reset later */ 837 ktok_ignore_whitespace(K); 838 }