mim/development/mim/mimc/mimc.mload

   1
   2 <BLOCK (<ROOT>)>
   3
   4 <COND (<NOT <GASSIGNED? ITUPLE>>  <SETG ITUPLE ITUPLE>)>
   5 <COND (<NOT <GASSIGNED? TUPLE>> <SETG TUPLE TUPLE>)>
   6
   7 STACK
   8
   9 MULTI-SET MULTI
  10
  11 <COND (<NOT <GASSIGNED? MULTI-SET> > <FLOAD "MSETC.MSUBR">)>
  12
  13 FGETBITS
  14
  15 FPUTBITS
  16
  17 <SETG MIM T>
  18
  19 <ENDBLOCK>
  20
  21 <SET REDEFINE T>
  22
  23 <BLOCK (<ROOT>)>
  24
  25 UNSPECIAL
  26
  27 ELSE
  28
  29 CALL
  30
  31 ALT-DECL
  32
  33 T$UNBOUND
  34
  35 <ENDBLOCK>
  36
  37 <FLOAD "ROOT-STUFF.MUD">
  38
  39 <FLOAD "PS:<MIMLIB>CBITS">
  40
  41 <MAPF <>
  42       <FUNCTION (X) <PACKAGE .X> <ENDPACKAGE>>
  43                    '("ISTRUC" "COMSUB" "BITTST" "CBACK" "CONFOR"
  44                     "CPRINT" "INFCMP" "CASE"
  45                     "SPCGEN")>
  46
  47
  48 <SETG GROUPS <MAPF ,LIST
  49                    <FUNCTION (NM "AUX" (CHN <>)
  50                                        TT)
  51                         <USE .NM>
  52                         <DROP .NM>>
  53
  54                    <SETG PCKS '("COMPDEC" "CDRIVE" "PASS1"  "SYMANA" "CARANA"
  55                                 "STRANA" "NOTANA" "MAPANA" "CODGEN"
  56                                 "CARGEN" "ADVMESS" "NOTGEN" "NEWREP" "STRGEN"
  57                                 "MMQGEN" "LNQGEN" "ALLR" "BUILDL" "MAPGEN"
  58                                 "MIMGEN" "COMFIL" "SUBRTY" "BITSGEN")>>>
  59
  60 <SET READ-TABLE ,READ-TABLE>
  61
  62 <BLOCK (<ROOT>)>
  63
  64 DBG UDBG PD UPD C R
  65 <SETG CALL `CALL>
  66 <ENDBLOCK>
  67
  68 <DEFINE DBG () <USE-TOTAL !,PCKS>>
  69
  70 <DEFINE UDBG () <DROP !,PCKS>>
  71 <USE "FINDATOM">
  72 <USE "CDRIVE">
  73 <USE "COMPDEC">
  74 <USE "COMFIL">
  75
  76 <DEFINE R (X "OPTIONAL" CH "AUX" (Y <COMPILE .X>) (NO-BQ <>))
  77         #DECL ((NO-BQ) <SPECIAL ANY>)
  78         <COND (<NOT <ASSIGNED? CH>>
  79                <COND (,DF-O
  80                       <SET CH ,OUTCHAN>)
  81                      (ELSE
  82                       <SET CH <OPEN "PRINT" <STRING <SPNAME .X> ".MIMA">>>)>)
  83               (<TYPE? .CH STRING>
  84                <SET CH <OPEN "PRINT" .CH>>)
  85               (<NOT <TYPE? .CH CHANNEL>>
  86                <SET CH ,OUTCHAN>)>
  87         <COND (.CH
  88                <COND (<N==? .CH ,OUTCHAN> <SET NO-BQ T>)>
  89                <MAPF <>
  90                      <FUNCTION (Z)
  91                           <COND (<TYPE? .Z ATOM> <PRIN1 .Z .CH>)
  92                                 (ELSE
  93                                  <PRINC "       " .CH>
  94                                  <PRIN1 .Z .CH>)>
  95                           <CRLF .CH>>
  96                      .Y>
  97                <COND (<N==? .CH ,OUTCHAN> <SET NO-BQ <>><CLOSE .CH>)>
  98                T)
  99               (ELSE .CH)>>
 100
 101
 102
 103 <DEFINE C ("OPTIONAL" (REST-OFF 0))
 104         <MAPF <>
 105               <FUNCTION (I)
 106                    <COND (<TYPE? .I ATOM> <PRIN1 .I>)
 107                          (ELSE
 108                           <PRINC "      ">
 109                           <PRIN1 .I>)>
 110                    <CRLF>>
 111               <REST .CODE-START .REST-OFF>>
 112         T>
 113
 114 <DROP "COMPDEC">
 115
 116 <DEFINE PD (PCK "AUX" (PN <COND (<TYPE? .PCK ATOM> <SPNAME .PCK>)
 117                                 (ELSE .PCK)>))
 118         <BLOCK ,<LOOKUP .PN #OBLIST PACKAGE>>
 119         T>
 120
 121 <DEFINE UPD () <ENDBLOCK> T>
 122
 123 <SETG DF-O T>
 124
 125 <USE "CHKDCL">
 126
 127 <SETG INTERPRETER-IMPLEMENTOR? T>
 128
 129 <DROP "CHKDCL">
 130
 131 <FLOAD "<MIMC.MIM>MIMC.ASK">
 132
 133 <FLOAD "<MIM.BOOT>NBOOT.COMPIL">
 134
 135 <USE "PURIFY">
 136
 137 <PURIFY-WORLD>
 138
 139 <SETG CTLZ-PRINT!-COMPDEC!-PACKAGE T>
 140
 141 <PROG () <PRINC "Invoke <SAV> to create a SAVE file.">
 142          <CRLF>
 143          <PRINT <COPY-GC>>>
 144
 145 <FEATURES "COMPILER" ("MACHINE" "TOPS20")("SUBSYSTEM" "MIMC")
 146           ("ENVIRONMENT" "MIM")>