From a24a4dffc211633905958a64bde9e582f5a217cd Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 9 Mar 2026 12:31:01 -0700 Subject: [PATCH] READ-READER-ENVIRONMENT can take a file name in addition to an open stream (#2531) --- sources/BOOTSTRAP | 93 ++++++++++++++++++++++------------------- sources/BOOTSTRAP.LCOM | Bin 14658 -> 15214 bytes 2 files changed, 51 insertions(+), 42 deletions(-) diff --git a/sources/BOOTSTRAP b/sources/BOOTSTRAP index 61339fa6..ebcd8a76 100644 --- a/sources/BOOTSTRAP +++ b/sources/BOOTSTRAP @@ -1,12 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "25-Feb-2026 15:03:24" {WMEDLEY}BOOTSTRAP.;69 47041 +(FILECREATED " 2-Mar-2026 12:03:05" {WMEDLEY}BOOTSTRAP.;71 47856 :EDIT-BY rmk - :CHANGES-TO (FNS MAKE-DEFINE-FILE-INFO-ENV READ-READER-ENVIRONMENT) + :CHANGES-TO (FNS READ-READER-ENVIRONMENT) - :PREVIOUS-DATE "25-Feb-2026 13:52:00" {WMEDLEY}BOOTSTRAP.;66) + :PREVIOUS-DATE "25-Feb-2026 15:03:24" {WMEDLEY}BOOTSTRAP.;69) (PRETTYCOMPRINT BOOTSTRAPCOMS) @@ -800,7 +800,9 @@ (TERPRI STREAM)))]) (READ-READER-ENVIRONMENT - [LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 25-Feb-2026 14:15 by rmk") + [LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 2-Mar-2026 12:03 by rmk") + (* ; "Edited 1-Mar-2026 10:49 by rmk") + (* ; "Edited 25-Feb-2026 14:15 by rmk") (* ; "Edited 26-Sep-2021 23:31 by rmk:") (* ;; "Starting environment is the old interlisp file, just for the seprchar scans.") @@ -809,42 +811,49 @@ (* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE") - (CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*)) - (LET ((START (GETFILEPTR STREAM)) - ARGS - (ENV DEFAULTENV) - (*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF *OLD-INTERLISP-READ-ENVIRONMENT*))) - (DECLARE (SPECVARS *READTABLE*)) - (SETFILEPTR STREAM 0) (* ; "Hope we are RANDACCESSP") - (SELCHARQ (SKIPSEPRCODES STREAM) - (";" (* ; "Assume it's a common lisp file") - (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF + (if (\GETSTREAM STREAM 'INPUT T) + then (CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*)) + (LET ((START (GETFILEPTR STREAM)) + ARGS + (ENV DEFAULTENV) + (*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF + *OLD-INTERLISP-READ-ENVIRONMENT* + ))) + (DECLARE (SPECVARS *READTABLE*)) + (SETFILEPTR STREAM 0) (* ; "Hope we are RANDACCESSP") + (SELCHARQ (SKIPSEPRCODES STREAM) + (";" (* ; "Assume it's a common lisp file") + (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF *COMMON-LISP-READ-ENVIRONMENT* - )) - *COMMON-LISP-READ-ENVIRONMENT*) - ("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF + )) + *COMMON-LISP-READ-ENVIRONMENT*) + ("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF *DEFINE-FILE-INFO-ENV* - )) (* ; + ))(* ;  "Should we reset the format if we fail?") - (READCCODE STREAM) - (WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV* - (if (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM)) - then - (* ;; + (READCCODE STREAM) + (WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV* + (if (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM)) + then + (* ;;  "After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.") - (SETQ ARGS (CL:READ-DELIMITED-LIST (CHARCODE ")") - STREAM)) - (SETQ ENV (\DO-DEFINE-FILE-INFO STREAM ARGS)) - else (SETFILEPTR STREAM START)) + (SETQ ARGS (CL:READ-DELIMITED-LIST (CHARCODE ")") + STREAM)) + (SETQ ENV (\DO-DEFINE-FILE-INFO STREAM ARGS)) + else (SETFILEPTR STREAM START)) - (* ;; + (* ;;  "If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.") - (CL:IF (AND RETURNFORM ARGS) - (CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS)) - ENV))) - DEFAULTENV]) + (CL:IF (AND RETURNFORM ARGS) + (CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS)) + ENV))) + DEFAULTENV)) + else (CL:WITH-OPEN-FILE (STRM (OR (FINDFILE STREAM T) + STREAM) + :DIRECTION :INPUT) + (READ-READER-ENVIRONMENT STRM DEFAULTENV RETURNFORM]) (MAKE-DEFINE-FILE-INFO-ENV [LAMBDA NIL (* ; "Edited 25-Feb-2026 15:03 by rmk") @@ -969,13 +978,13 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4621 14293 (GETPROP 4631 . 5203) (SETATOMVAL 5205 . 5334) (RPAQQ 5336 . 5389) (RPAQ -5391 . 5703) (RPAQ? 5705 . 6075) (MOVD 6077 . 7941) (MOVD? 7943 . 8373) (SELECTQ 8375 . 8562) ( -SELECTQ1 8564 . 8906) (NCONC1 8908 . 9104) (PUTPROP 9106 . 10590) (PROPNAMES 10592 . 10783) (ADDPROP -10785 . 12848) (REMPROP 12850 . 13704) (MEMB 13706 . 13965) (CLOSEF? 13967 . 14291)) (14366 34343 ( -LOAD 14376 . 15545) (\LOAD-STREAM 15547 . 28034) (FILECREATED 28036 . 29454) (FILECREATED1 29456 . -30564) (PRETTYCOMPRINT 30566 . 31051) (BOOTSTRAP-NAMEFIELD 31053 . 32013) (PUTPROPS 32015 . 32383) ( -DECLARE%: 32385 . 32517) (DECLARE%:1 32519 . 33391) (ROOTFILENAME 33393 . 34341)) (34381 44987 ( -DEFINE-FILE-INFO 34391 . 34826) (\DO-DEFINE-FILE-INFO 34828 . 38971) (PRINT-READER-ENVIRONMENT 38973 - . 40725) (READ-READER-ENVIRONMENT 40727 . 43553) (MAKE-DEFINE-FILE-INFO-ENV 43555 . 44985))))) + (FILEMAP (NIL (4595 14267 (GETPROP 4605 . 5177) (SETATOMVAL 5179 . 5308) (RPAQQ 5310 . 5363) (RPAQ +5365 . 5677) (RPAQ? 5679 . 6049) (MOVD 6051 . 7915) (MOVD? 7917 . 8347) (SELECTQ 8349 . 8536) ( +SELECTQ1 8538 . 8880) (NCONC1 8882 . 9078) (PUTPROP 9080 . 10564) (PROPNAMES 10566 . 10757) (ADDPROP +10759 . 12822) (REMPROP 12824 . 13678) (MEMB 13680 . 13939) (CLOSEF? 13941 . 14265)) (14340 34317 ( +LOAD 14350 . 15519) (\LOAD-STREAM 15521 . 28008) (FILECREATED 28010 . 29428) (FILECREATED1 29430 . +30538) (PRETTYCOMPRINT 30540 . 31025) (BOOTSTRAP-NAMEFIELD 31027 . 31987) (PUTPROPS 31989 . 32357) ( +DECLARE%: 32359 . 32491) (DECLARE%:1 32493 . 33365) (ROOTFILENAME 33367 . 34315)) (34355 45802 ( +DEFINE-FILE-INFO 34365 . 34800) (\DO-DEFINE-FILE-INFO 34802 . 38945) (PRINT-READER-ENVIRONMENT 38947 + . 40699) (READ-READER-ENVIRONMENT 40701 . 44368) (MAKE-DEFINE-FILE-INFO-ENV 44370 . 45800))))) STOP diff --git a/sources/BOOTSTRAP.LCOM b/sources/BOOTSTRAP.LCOM index 043018dc29bd43a6f58ebb465c42315e541624ce..74f0d1d83c435d4eb596759c8154e84e9b9560b7 100644 GIT binary patch delta 1031 zcmZuwzi-n(6t+`TS{GHNDrr)NK81$bMWMcP>^NQ;H@QSs9ou!B2Ba))2@ohy1qrbs z*cqx5tVIZk8CA@c*kC~7A7Erb0%iu_&S|4Sx#51id+&YkefQnF-nR!Ua)neKkL0S3 zOLC4^^}!14@|s;Eka4_-gs#&FGGK+ou0-~#`;U2VB{c&$SKsXAu!;>p*ito1)%R{M zFBgykQU)8jYG-S3i;#u%3~co}+xPD5c6U10p!0CIcRy><{bYKgdlxd*rt1PW_P(dg z6R|j-Q6!lcTV@qSqym}$!P6CSeyo5XUodrpUKfGB5DjXI^1*NMOO`$#&(e?Mb5~Vp zL}4AOfPm3pH{FPM8|;W7BvCVDY{a)3*lJPL6cCcaDM1X@!wG?naX#JL9z9$b6{iFl zVQAMk7+nz*=)Ra9lRU?jWJO}wv%amWDh8`!vg%<7_c-&UkPw9622Z&jXXhCalwGUr z`VGRG*1@t@{V-x%o->)EPZv&4Beh=~1W@dEL%%LQOCUra%UKcA*YX8XqrVo?7sc6$ z5n-ehLv&+^mv4j*_N!KMD{)wgo3UF-`ct02oEqhIydRVJ(n?M3$Um6xlTvGL_@W=v znxi%4R=d=Vo!=e-#3(UH_iRFnPccF~`O~q%pNSog=)(m(=oYYU4#>nhJ-d`%<^&?Z zS`qw!cz`hiCfo{_0-&M>4HEHv5QTuuJkU?`=SEP$pr4iWdBfn;koBhR0x}SU?BsYg zrq&`?-6O=3wQD5ePIeuTYA^xVm2%myu;i)=ZE}Tu1Dj9Z=Oj0Er1U{sE9+U<2_dU?V`3zUB12d*9PXclZ6#+gYdKFxLy1?0P^v%bXOr89_on*?lRcO`p3WZD+W3)FF2MeM5Z!_AgQCs9t%?7({$*BG zQQ{jpZ8t+onS)21u?Q`Lv?%UzfS*VicN=AV!BzRpp|lARfyWMay{PLaU%0O|JX~MG ziiDhnucaDKpxF)k{V~z(m9Ue=k>~!cgqWf1^d--bzFS2wOq)aJzPbzd7~mM z=IZ?tpNFAv>7eoB<#FNZ*06*RnwPl}K5O2Q3k_-*kgzm|jnWvXZoDoj z@->Y>lE!RjVEaH@8pN6Mf*w$+0v^||J^@NJ81-11f3y2w5y8mvjrn|E8AFL z`)(Nb?G!ZYOiDE&+4iD@MRD#*KvhmLDv-7RO`HvynkM|^UHNk&lv+5g3oDidUJwmZ aFpOLmH6;(6f?QoVpSgjm)(MlPi$4K~4xa)5