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

MCCS as default format -- see docs/internal/MCCS.TEDIT

Browse Source
This commit is contained in:
rmkaplan
2025-09-11 23:45:34 -07:00
parent 9e7a6b0657
commit 4549ad1e65
12 changed files with 1524 additions and 159 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
sources/BOOTSTRAP
View File

@@ -1,16 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Sep-2021 10:25:31" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;60 47698
changes to%: (FNS PRINT-READER-ENVIRONMENT READ-READER-ENVIRONMENT)
(FILECREATED "23-Apr-2025 23:39:10" {WMEDLEY}<sources>BOOTSTRAP.;61 47417
previous date%: "17-Aug-2021 00:08:39"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58)
:EDIT-BY rmk
:CHANGES-TO (FNS PRINT-READER-ENVIRONMENT \DO-DEFINE-FILE-INFO)
:PREVIOUS-DATE "27-Sep-2021 10:25:31" {WMEDLEY}<sources>BOOTSTRAP.;59)
(* ; "
Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT BOOTSTRAPCOMS)
@@ -19,7 +16,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(FNS GETPROP SETATOMVAL RPAQQ RPAQ RPAQ? MOVD MOVD? SELECTQ SELECTQ1 NCONC1 PUTPROP
PROPNAMES ADDPROP REMPROP MEMB CLOSEF?))
(COMS (* ;
 "Need these in order to load even compiled files SYSLOAD")
 "Need these in order to load even compiled files SYSLOAD")
(FNS LOAD \LOAD-STREAM FILECREATED FILECREATED1 PRETTYCOMPRINT BOOTSTRAP-NAMEFIELD
PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME))
[COMS (* ; "For DEFINE-FILE-INFO")
@@ -714,66 +711,64 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL ARGS])
(\DO-DEFINE-FILE-INFO
[LAMBDA (STREAM ARGS) (* ; "Edited 17-Aug-2021 00:05 by rmk:")
[LAMBDA (STREAM ARGS) (* ; "Edited 23-Apr-2025 23:12 by rmk")
(* ; "Edited 17-Aug-2021 00:05 by rmk:")
(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.")
(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.")
(* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM")
(* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM")
(* ;;; "")
(* ;;; "")
(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist. If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.")
(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist. If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.")
(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment. I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.")
(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment. I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.")
(LET (PACKAGE READTABLE BASE FORMAT VALUE PACKAGEFORM READTABLEFORM)
[for TAIL on ARGS by (CDDR TAIL)
do (SETQ VALUE (CADR TAIL))
(SELECTQ (CAR TAIL)
((:PACKAGE %:PACKAGE)
(SETQ PACKAGE (if (LISTP VALUE)
then (SETQ PACKAGEFORM VALUE)
(EVAL VALUE)
ELSE VALUE))
(IF (TYPEP PACKAGE 'PACKAGE)
ELSEIF (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE))
ELSE
(SELECTQ (CAR TAIL)
((:PACKAGE %:PACKAGE)
(SETQ PACKAGE (if (LISTP VALUE)
then (SETQ PACKAGEFORM VALUE)
(EVAL VALUE)
ELSE VALUE))
(IF (TYPEP PACKAGE 'PACKAGE)
ELSEIF (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE))
ELSE
(* ;; "Better message than just \DTEST")
(* ;; "Better message than just \DTEST")
(ERROR "Can't find package for DEFINE-FILE-INFO reader environment"
VALUE)))
((:READTABLE %:READTABLE)
(SETQ READTABLE (if (LISTP VALUE)
then (SETQ READTABLEFORM VALUE)
(EVAL VALUE)
ELSE VALUE))
(IF (TYPEP READTABLE 'READTABLEP)
ELSEIF (SETQ READTABLE (FIND-READTABLE READTABLE))
ELSE
(* ;; "Better message than just \DTEST")
(ERROR
"Can't find package for DEFINE-FILE-INFO reader environment"
VALUE)))
((:READTABLE %:READTABLE)
(SETQ READTABLE (if (LISTP VALUE)
then (SETQ READTABLEFORM VALUE)
(EVAL VALUE)
ELSE VALUE))
(IF (TYPEP READTABLE 'READTABLEP)
ELSEIF (SETQ READTABLE (FIND-READTABLE READTABLE))
ELSE
(ERROR "Can't find read table for DEFINE-FILE-INFO reader environment"
VALUE)))
((:BASE %:BASE) (* ;
 "RMK: An EVAL form here makes no sense. ")
(SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE)
then (EVAL VALUE)
else VALUE))
(ERROR "Bad read base for DEFINE-FILE-INFO reader environment"
VALUE))))
((:FORMAT FORMAT %:FORMAT)
(SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT VALUE))))
(ERROR "Unrecognized file info key" (CAR TAIL]
(* ;; "Better message than just \DTEST")
(* ;; "Set the defaults. Is this essentially ignoring the *DEFAULT-MAKEFILE-ENVIRONMENT*? Maybe the defaults should be take from there?")
(ERROR
"Can't find read table for DEFINE-FILE-INFO reader environment"
VALUE)))
((:BASE %:BASE) (* ;
 "RMK: An EVAL form here makes no sense. ")
(SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE)
then (EVAL VALUE)
else VALUE))
(ERROR
"Bad read base for DEFINE-FILE-INFO reader environment"
VALUE))))
((:FORMAT FORMAT %:FORMAT)
(SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT
VALUE))))
(ERROR "Unrecognized file info key" (CAR TAIL]
(* ;; "Set the defaults. Is this essentially ignoring the *DEFAULT-MAKEFILE-ENVIRONMENT*? Maybe the defaults should be take from there?")
(CL:UNLESS FORMAT (SETQ FORMAT :XCCS))
(CL:UNLESS FORMAT
(SETQ FORMAT (CL:IF (FIND-FORMAT :MCCS T)
:MCCS
:XCCS)))
(CL:WHEN STREAM (\EXTERNALFORMAT STREAM FORMAT))
(create READER-ENVIRONMENT
REPACKAGE _ (OR PACKAGE *INTERLISP-PACKAGE*)
@@ -784,7 +779,8 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
REREADTABLEFORM _ READTABLEFORM])
(PRINT-READER-ENVIRONMENT
[LAMBDA (ENV STREAM) (* ; "Edited 27-Sep-2021 10:24 by rmk:")
[LAMBDA (ENV STREAM) (* ; "Edited 23-Apr-2025 23:38 by rmk")
(* ; "Edited 27-Sep-2021 10:24 by rmk:")
(* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")
@@ -798,13 +794,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
[SETQ RDTBL (IF (FETCH REREADTABLEFORM OF ENV)
ELSEIF (fetch REREADTABLE of ENV)
THEN (READTABLEPROP (fetch REREADTABLE of ENV)
'NAME]
'NAME]
(PRINT [CONS 'DEFINE-FILE-INFO
`(,@[AND PKG `(:PACKAGE ,PKG]
,@[AND RDTBL `(:READTABLE ,RDTBL]
:BASE
,(fetch REBASE of ENV)
,@(CL:UNLESS (EQ :XCCS (FETCH REFORMAT OF ENV))
,@(CL:UNLESS (EQMEMB (FETCH REFORMAT OF ENV)
'(:MCCS :XCCS))
`(:FORMAT ,(FETCH REFORMAT OF ENV)))]
STREAM
(FETCH (READER-ENVIRONMENT REREADTABLE) OF *DEFINE-FILE-INFO-ENV*))
@@ -953,8 +950,8 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(FUNCTION (LAMBDA (X)
(OR (CCODEP (CDR X))
(MOVD (CAR X)
(CDR X)
NIL T]
(CDR X)
NIL T]
(AND (CCODEP 'BOOTSTRAP-NAMEFIELD)
(PUTD 'BOOTSTRAP-NAMEFIELD))
@@ -979,16 +976,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(ADDTOVAR LAMA )
)
(PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4751 14423 (GETPROP 4761 . 5333) (SETATOMVAL 5335 . 5464) (RPAQQ 5466 . 5519) (RPAQ
5521 . 5833) (RPAQ? 5835 . 6205) (MOVD 6207 . 8071) (MOVD? 8073 . 8503) (SELECTQ 8505 . 8692) (
SELECTQ1 8694 . 9036) (NCONC1 9038 . 9234) (PUTPROP 9236 . 10720) (PROPNAMES 10722 . 10913) (ADDPROP
10915 . 12978) (REMPROP 12980 . 13834) (MEMB 13836 . 14095) (CLOSEF? 14097 . 14421)) (14496 35060 (
LOAD 14506 . 15675) (\LOAD-STREAM 15677 . 28751) (FILECREATED 28753 . 30171) (FILECREATED1 30173 .
31281) (PRETTYCOMPRINT 31283 . 31768) (BOOTSTRAP-NAMEFIELD 31770 . 32730) (PUTPROPS 32732 . 33100) (
DECLARE%: 33102 . 33234) (DECLARE%:1 33236 . 34108) (ROOTFILENAME 34110 . 35058)) (35098 45530 (
DEFINE-FILE-INFO 35108 . 35543) (\DO-DEFINE-FILE-INFO 35545 . 39891) (PRINT-READER-ENVIRONMENT 39893
. 41475) (READ-READER-ENVIRONMENT 41477 . 44252) (MAKE-DEFINE-FILE-INFO-ENV 44254 . 45528)))))
(FILEMAP (NIL (4617 14289 (GETPROP 4627 . 5199) (SETATOMVAL 5201 . 5330) (RPAQQ 5332 . 5385) (RPAQ
5387 . 5699) (RPAQ? 5701 . 6071) (MOVD 6073 . 7937) (MOVD? 7939 . 8369) (SELECTQ 8371 . 8558) (
SELECTQ1 8560 . 8902) (NCONC1 8904 . 9100) (PUTPROP 9102 . 10586) (PROPNAMES 10588 . 10779) (ADDPROP
10781 . 12844) (REMPROP 12846 . 13700) (MEMB 13702 . 13961) (CLOSEF? 13963 . 14287)) (14362 34926 (
LOAD 14372 . 15541) (\LOAD-STREAM 15543 . 28617) (FILECREATED 28619 . 30037) (FILECREATED1 30039 .
31147) (PRETTYCOMPRINT 31149 . 31634) (BOOTSTRAP-NAMEFIELD 31636 . 32596) (PUTPROPS 32598 . 32966) (
DECLARE%: 32968 . 33100) (DECLARE%:1 33102 . 33974) (ROOTFILENAME 33976 . 34924)) (34964 45363 (
DEFINE-FILE-INFO 34974 . 35409) (\DO-DEFINE-FILE-INFO 35411 . 39554) (PRINT-READER-ENVIRONMENT 39556
. 41308) (READ-READER-ENVIRONMENT 41310 . 44085) (MAKE-DEFINE-FILE-INFO-ENV 44087 . 45361)))))
STOP