github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-25 20:01:51 +00:00
Code Issues Projects Releases Wiki Activity

Rmk161 loadup works with utf 8 source files (#2512)

Browse Source 
* New starter.sysout contains the UTF-8 external format
* Init.sysout is created with the UTF-8 external format
* Files with non-ascii characters and some other files converted to UTF-8, for basic testing
* Environment arg of WITH-READER-ENVIRONMENT can be a stream
* Compiler functions now respect the external format as copied from the source file
* Colon is the package delimiter in DEFINE-FILE-INFO expressions
* UNICODE file is deprecated in favor of UNICODE-FORMATS and UNICODE-TABLES
This commit is contained in:
rmkaplan
2026-03-02 11:56:11 -08:00
committed by GitHub
parent b1bdd90338
commit 0f470b9753
54 changed files with 9450 additions and 7320 deletions
Download Patch File Download Diff File Expand all files Collapse all files

136
sources/CMLCOMPILE
View File

@@ -1,18 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "24-Sep-2023 14:11:25" {WMEDLEY}<sources>CMLCOMPILE.;2 22597
(FILECREATED "25-Feb-2026 23:03:38" {WMEDLEY}<sources>CMLCOMPILE.;4 25235
:EDIT-BY rmk
:CHANGES-TO (FNS COMPILE-IN-CORE)
:CHANGES-TO (FNS FAKE-COMPILE-FILE)
:PREVIOUS-DATE " 2-Jul-90 20:24:02" {WMEDLEY}<sources>CMLCOMPILE.;1)
:PREVIOUS-DATE "25-Feb-2026 19:50:29" {WMEDLEY}<sources>CMLCOMPILE.;3)
(* ; "
Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT CMLCOMPILECOMS)
(RPAQQ CMLCOMPILECOMS
@@ -46,8 +42,111 @@ Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
(DEFINEQ
(FAKE-COMPILE-FILE
(CL:LAMBDA (FILENAME &KEY LAP REDEFINE OUTPUT-FILE (SAVE-EXPRS T) (COMPILER-OUTPUT T) (PROCESS-ENTIRE-FILE NIL PEFP)) (* ; "Edited 29-Jun-90 19:19 by nm") (LET (COMPILE.FILE.AFTER VALUE COMPILE.FILE.VALUE (NLAML NLAML) (NLAMA NLAMA) (LAMS LAMS) (LAMA LAMA) (DFNFLG NIL)) (DECLARE (CL:SPECIAL COMPILE.FILE.AFTER COMPILE.FILE.VALUE NLAML NLAMA LAMS LAMA DFNFLG)) (RESETLST (RESETSAVE NIL (LIST (QUOTE RESETUNDO)) (RESETUNDO)) (RESETSAVE COUTFILE COMPILER-OUTPUT) (RESETSAVE STRF REDEFINE) (RESETSAVE SVFLG (AND SAVE-EXPRS REDEFINE (QUOTE DEFER))) (RESETSAVE LAPFLG LAP) (LET ((*PACKAGE* *INTERLISP-PACKAGE*) (*READ-BASE* 10) (LOCALVARS SYSLOCALVARS) (SPECVARS T) STREAM LSTFIL ROOTNAME INTERLISP-FORMAT ENV FORM) (DECLARE (CL:SPECIAL *PACKAGE* *READ-BASE* LOCALVARS SPECVARS LSTFIL)) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ STREAM (OPENSTREAM FILENAME (QUOTE INPUT))))) (CL:MULTIPLE-VALUE-SETQ (ENV FORM) (\PARSE-FILE-HEADER STREAM (QUOTE RETURN) T)) (SETQ INTERLISP-FORMAT (AND ENV (NEQ ENV *COMMON-LISP-READ-ENVIRONMENT*))) (if (NOT PEFP) then (SETQ PROCESS-ENTIRE-FILE INTERLISP-FORMAT)) (if LAP then (SETQ LSTFIL COUTFILE)) (SETQ FILENAME (FULLNAME STREAM)) (RESETSAVE NIL (LIST (FUNCTION COMPILE.FILE.RESET) (SETQ OUTPUT-FILE (OPENSTREAM (OR OUTPUT-FILE (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE EXTENSION) COMPILE.EXT (QUOTE BODY) FILENAME)) (QUOTE OUTPUT) (QUOTE NEW) (QUOTE ((TYPE BINARY))))) STREAM (ROOTFILENAME FILENAME))) (if OUTPUT-FILE then (RESETSAVE LCFIL OUTPUT-FILE) (PRINT-COMPILE-HEADER (LIST STREAM) (QUOTE ("COMPILE-FILEd")) ENV)) (WITH-READER-ENVIRONMENT ENV (PROG ((DEFERRED.EXPRESSIONS NIL) (*PRINT-ARRAY* T) (*PRINT-LEVEL* NIL) (*PRINT-LENGTH* NIL) (FIRSTFORMS NIL) (AFTERS NIL) (SCRATCH.LCOM (QUOTE {CORE}SCRATCH.LCOM)) DUMMYFILE TEMPVAL) (DECLARE (CL:SPECIAL DEFERRED.EXPRESSIONS *PRINT-ARRAY* *PRINT-LEVEL* *PRINT-LENGTH* FIRSTFORMS AFTERS DEFERS)) (* ; "Edited by TT (11-June-90 : for AR#11185) all contents of file are read, and each forms are compiled.(This reading method is for supporting %"FIRST%", %"NOTFIRST%" tag.)") (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ DUMMYFILE (OPENSTREAM SCRATCH.LCOM (QUOTE BOTH) (QUOTE NEW))))) LPDUMP (if (EQUAL (CAR FORM) (QUOTE RPAQQ)) then (* ; "This is the support method of %"COMPILERVARS%" (2-July-1990 TT)") (SETQ TEMPVAL (CADDR FORM)) (if (SETQ TEMPVAL (ASSOC (QUOTE DECLARE%:) TEMPVAL)) then (if (SETQ TEMPVAL (FMEMB (QUOTE COMPILERVARS) (FMEMB (QUOTE DOEVAL@COMPILE) TEMPVAL))) then (SETQ DFNFLG T) (if (SETQ TEMPVAL (FMEMB (QUOTE ADDVARS) (SETQ TEMPVAL (CADR TEMPVAL)))) then (CL:DOLIST (ARG (CDR TEMPVAL)) (APPLY (QUOTE ADDTOVAR) ARG)))))) (COMPILE-FILE-EXPRESSION FORM DUMMYFILE NIL PROCESS-ENTIRE-FILE) (SKIPSEPRCODES STREAM) (if (EOFP STREAM) then (CLOSEF STREAM) (for FORM in FIRSTFORMS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL PROCESS-ENTIRE-FILE T)) (COPYBYTES DUMMYFILE OUTPUT-FILE 0 (GETFILEPTR DUMMYFILE)) (CLOSEF? DUMMYFILE) (DELFILE (FULLNAME DUMMYFILE)) (AND PROCESS-ENTIRE-FILE (for EXP in (REVERSE DEFERRED.EXPRESSIONS) do (APPLY* (CAR EXP) (CDR EXP) OUTPUT-FILE))) (for FORM in AFTERS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL PROCESS-ENTIRE-FILE T)) (RETURN)) (SETQ FORM (READ STREAM)) (GO LPDUMP)) (PRINT NIL OUTPUT-FILE)) (SETQ COMPILE.FILE.VALUE (CLOSEF OUTPUT-FILE)))) (* ; "Do these after UNDONLSETQ entered") (MAPC (REVERSE COMPILE.FILE.AFTER) (FUNCTION EVAL)) COMPILE.FILE.VALUE))
)
(CL:LAMBDA
(FILENAME &KEY LAP REDEFINE OUTPUT-FILE (SAVE-EXPRS T)
(COMPILER-OUTPUT T)
(PROCESS-ENTIRE-FILE NIL PEFP)) (* ; "Edited 25-Feb-2026 23:02 by rmk")
(* ; "Edited 29-Jun-90 19:19 by nm")
(LET
(COMPILE.FILE.AFTER VALUE COMPILE.FILE.VALUE (NLAML NLAML)
(NLAMA NLAMA)
(LAMS LAMS)
(LAMA LAMA)
(DFNFLG NIL))
(DECLARE (CL:SPECIAL COMPILE.FILE.AFTER COMPILE.FILE.VALUE NLAML NLAMA LAMS LAMA DFNFLG))
(RESETLST
(RESETSAVE NIL (LIST 'RESETUNDO)
(RESETUNDO))
(RESETSAVE COUTFILE COMPILER-OUTPUT)
(RESETSAVE STRF REDEFINE)
(RESETSAVE SVFLG (AND SAVE-EXPRS REDEFINE 'DEFER))
(RESETSAVE LAPFLG LAP)
(LET
((*PACKAGE* *INTERLISP-PACKAGE*)
(*READ-BASE* 10)
(LOCALVARS SYSLOCALVARS)
(SPECVARS T)
STREAM LSTFIL ROOTNAME INTERLISP-FORMAT ENV FORM)
(DECLARE (CL:SPECIAL *PACKAGE* *READ-BASE* LOCALVARS SPECVARS LSTFIL))
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ STREAM (OPENSTREAM FILENAME 'INPUT]
(CL:MULTIPLE-VALUE-SETQ (ENV FORM)
(\PARSE-FILE-HEADER STREAM 'RETURN T))
(SETQ INTERLISP-FORMAT (AND ENV (NEQ ENV *COMMON-LISP-READ-ENVIRONMENT*)))
(if (NOT PEFP)
then (SETQ PROCESS-ENTIRE-FILE INTERLISP-FORMAT))
(if LAP
then (SETQ LSTFIL COUTFILE))
(SETQ FILENAME (FULLNAME STREAM))
(RESETSAVE NIL (LIST (FUNCTION COMPILE.FILE.RESET)
[SETQ OUTPUT-FILE (OPENSTREAM (OR OUTPUT-FILE (PACKFILENAME.STRING
'VERSION NIL
'EXTENSION COMPILE.EXT
'BODY FILENAME))
'OUTPUT
'NEW
`((TYPE BINARY)
(:EXTERNAL-FORMAT ,ENV]
STREAM
(ROOTFILENAME FILENAME)))
(if OUTPUT-FILE
then (RESETSAVE LCFIL OUTPUT-FILE)
(PRINT-COMPILE-HEADER (LIST STREAM)
'("COMPILE-FILEd")
ENV))
(WITH-READER-ENVIRONMENT ENV
(PROG ((DEFERRED.EXPRESSIONS NIL)
(*PRINT-ARRAY* T)
(*PRINT-LEVEL* NIL)
(*PRINT-LENGTH* NIL)
(FIRSTFORMS NIL)
(AFTERS NIL)
(SCRATCH.LCOM '{CORE}SCRATCH.LCOM)
DUMMYFILE TEMPVAL)
(DECLARE (CL:SPECIAL DEFERRED.EXPRESSIONS *PRINT-ARRAY* *PRINT-LEVEL*
*PRINT-LENGTH* FIRSTFORMS AFTERS DEFERS))
(* ; "Edited by TT (11-June-90 : for AR#11185) all contents of file are read, and each forms are compiled.(This reading method is for supporting %"FIRST%", %"NOTFIRST%" tag.)")
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ DUMMYFILE (OPENSTREAM SCRATCH.LCOM 'BOTH 'NEW
`((:EXTERNAL-FORMAT ,ENV]
LPDUMP
[if (EQUAL (CAR FORM)
'RPAQQ)
then (* ;
 "This is the support method of %"COMPILERVARS%" (2-July-1990 TT)")
(SETQ TEMPVAL (CADDR FORM))
(if (SETQ TEMPVAL (ASSOC 'DECLARE%: TEMPVAL))
then (if (SETQ TEMPVAL (FMEMB 'COMPILERVARS (FMEMB 'DOEVAL@COMPILE
TEMPVAL)))
then (SETQ DFNFLG T)
(if [SETQ TEMPVAL (FMEMB 'ADDVARS (SETQ TEMPVAL
(CADR TEMPVAL]
then (CL:DOLIST (ARG (CDR TEMPVAL))
(APPLY 'ADDTOVAR ARG))]
(COMPILE-FILE-EXPRESSION FORM DUMMYFILE NIL PROCESS-ENTIRE-FILE)
(SKIPSEPRCODES STREAM)
(if (EOFP STREAM)
then (CLOSEF STREAM)
(for FORM in FIRSTFORMS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL
PROCESS-ENTIRE-FILE T))
(COPYBYTES DUMMYFILE OUTPUT-FILE 0 (GETFILEPTR DUMMYFILE))
(CLOSEF? DUMMYFILE)
(DELFILE (FULLNAME DUMMYFILE))
(CL:WHEN PROCESS-ENTIRE-FILE
(for EXP in (REVERSE DEFERRED.EXPRESSIONS)
do (APPLY* (CAR EXP)
(CDR EXP)
OUTPUT-FILE)))
(for FORM in AFTERS do (COMPILE-FILE-EXPRESSION FORM OUTPUT-FILE NIL
PROCESS-ENTIRE-FILE T))
(RETURN))
(SETQ FORM (READ STREAM))
(GO LPDUMP))
(PRINT NIL OUTPUT-FILE))
(SETQ COMPILE.FILE.VALUE (CLOSEF OUTPUT-FILE)))) (* ; "Do these after UNDONLSETQ entered")
(MAPC (REVERSE COMPILE.FILE.AFTER)
(FUNCTION EVAL))
COMPILE.FILE.VALUE)))
(INTERLISP-FORMAT-P
[LAMBDA (STREAM) (* bvm%: " 3-Aug-86 14:01")
@@ -302,14 +401,13 @@ Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation.
(ADDTOVAR LAMA FAKE-COMPILE-FILE)
)
(PUTPROPS CMLCOMPILE COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1636 2253 (CL:DISASSEMBLE 1636 . 2253)) (2254 17523 (FAKE-COMPILE-FILE 2264 . 5700) (
INTERLISP-FORMAT-P 5702 . 5920) (INTERLISP-NLAMBDA-FUNCTION-P 5922 . 6156) (COMPILE-FILE-EXPRESSION
6158 . 9508) (COMPILE-FILE-WALK-FUNCTION 9510 . 9757) (ARGTYPE.STATE 9759 . 9919) (
COMPILE.CHECK.ARGTYPE 9921 . 11913) (COMPILE.FILE.DEFINEQ 11915 . 12408) (
COMPILE-FILE-SETF-SYMBOL-FUNCTION 12410 . 13004) (COMPILE-FILE-EX/IMPORT 13006 . 13334) (
COMPILE.FILE.APPLY 13336 . 13596) (COMPILE.FILE.RESET 13598 . 14459) (COMPILE-IN-CORE 14461 . 17521))
(17524 19253 (COMPILE-FILE-SCAN-FIRST 17534 . 19251)) (19796 21163 (COMPILE-FILE-DECLARE%: 19796 .
21163)) (21164 22228 (NEWDEFC 21174 . 22226)))))
(FILEMAP (NIL (1569 2186 (CL:DISASSEMBLE 1569 . 2186)) (2187 20243 (FAKE-COMPILE-FILE 2197 . 8420) (
INTERLISP-FORMAT-P 8422 . 8640) (INTERLISP-NLAMBDA-FUNCTION-P 8642 . 8876) (COMPILE-FILE-EXPRESSION
8878 . 12228) (COMPILE-FILE-WALK-FUNCTION 12230 . 12477) (ARGTYPE.STATE 12479 . 12639) (
COMPILE.CHECK.ARGTYPE 12641 . 14633) (COMPILE.FILE.DEFINEQ 14635 . 15128) (
COMPILE-FILE-SETF-SYMBOL-FUNCTION 15130 . 15724) (COMPILE-FILE-EX/IMPORT 15726 . 16054) (
COMPILE.FILE.APPLY 16056 . 16316) (COMPILE.FILE.RESET 16318 . 17179) (COMPILE-IN-CORE 17181 . 20241))
(20244 21973 (COMPILE-FILE-SCAN-FIRST 20254 . 21971)) (22516 23883 (COMPILE-FILE-DECLARE%: 22516 .
23883)) (23884 24948 (NEWDEFC 23894 . 24946)))))
STOP