mim/development/mim/mimc/advmess.mima

   1
   2 <PACKAGE "ADVMESS">
   3
   4 <ENTRY VMESS ANA-MESS ADDVMESS COMPILE-ERROR COMPILE-LOSSAGE COMPILE-WARNING COMPILE-NOTE COMPILE-ACTIVATION>
   5
   6 <USE "NPRINT" "COMPDEC">
   7
   8 #WORD *4565744001*
   9                     <GFCN \1aVMESS ("VALUE" ATOM "TUPLE" TUPLE)>
  10                     <MAKTUP MSG4 O20 = MSG4>
  11                     <INTGO>
  12                     <FRAME '\1aPRINC>
  13                     <PUSH "===== ">
  14                     <GEN-LVAL 'OUTCHAN = STACK>
  15                     <CALL '\1aPRINC 2>
  16                     <CHTYPE MSG4 <TYPE-CODE VECTOR> = MSG4>
  17                     <LOOP>
  18 MAP10
  19                     <INTGO>
  20                     <EMPUV? MSG4 + MAPAP13>
  21                     <NTHUV MSG4 1 = O20>
  22                     <TYPE? O20 <TYPE-CODE STRING> - PHRASE22>
  23                     <FRAME '\1aPRINC>
  24                     <PUSH O20>
  25                     <DEAD O20>
  26                     <GEN-LVAL 'OUTCHAN = STACK>
  27                     <CALL '\1aPRINC 2>
  28                     <JUMP + PHRASE27>
  29 PHRASE22
  30                     <FRAME '\1aPRIN1>
  31                     <PUSH O20>
  32                     <DEAD O20>
  33                     <GEN-LVAL 'OUTCHAN = STACK>
  34                     <CALL '\1aPRIN1 2>
  35 PHRASE27
  36                     <RESTUV MSG4 1 = MSG4 (TYPE VECTOR)>
  37                     <JUMP + MAP10>
  38 MAPAP13
  39                     <FRAME '\1aCRLF>
  40                     <GEN-LVAL 'OUTCHAN = STACK>
  41                     <CALL '\1aCRLF 1 = MSG4>
  42                     <RETURN MSG4>
  43                     <DEAD MSG4>
  44                     <END \1aVMESS>
  45
  46 #WORD *20431271265*
  47                     <GFCN \1aANA-MESS ("VALUE" ATOM <LIST ANY [REST NODE LIST]>) L4>
  48                     <TEMP LL8 TEMP13 O28>
  49                     <INTGO>
  50                     <RESTL L4 1 = LL8 (TYPE LIST)>
  51                     <DEAD L4>
  52                     <LOOP>
  53 AGAIN9
  54                     <INTGO>
  55                     <EMPL? LL8 - PHRASE11 (TYPE LIST)>
  56                     <RETURN 'T>
  57 PHRASE11
  58                     <FRAME '\1aPRINC>
  59                     <PUSH "===== ">
  60                     <GEN-LVAL 'OUTCHAN = STACK>
  61                     <CALL '\1aPRINC 2>
  62                     <RESTL LL8 1 = TEMP13 (TYPE LIST)>
  63                     <NTHL TEMP13 1 = TEMP13 (TYPE LIST)>
  64                     <LOOP>
  65 MAP17
  66                     <INTGO>
  67                     <EMPL? TEMP13 + MAPAP20>
  68                     <NTHL TEMP13 1 = O28>
  69                     <TYPE? O28 <TYPE-CODE NODE> - PHRASE30>
  70                     <FRAME '\1aNODE-COMPLAIN>
  71                     <PUSH O28>
  72                     <DEAD O28>
  73                     <CALL '\1aNODE-COMPLAIN 1>
  74                     <JUMP + PHRASE37>
  75 PHRASE30
  76                     <TYPE? O28 <TYPE-CODE STRING> - PHRASE32>
  77                     <FRAME '\1aPRINC>
  78                     <PUSH O28>
  79                     <DEAD O28>
  80                     <GEN-LVAL 'OUTCHAN = STACK>
  81                     <CALL '\1aPRINC 2>
  82                     <JUMP + PHRASE37>
  83 PHRASE32
  84                     <FRAME '\1aPRIN1>
  85                     <PUSH O28>
  86                     <DEAD O28>
  87                     <GEN-LVAL 'OUTCHAN = STACK>
  88                     <CALL '\1aPRIN1 2>
  89 PHRASE37
  90                     <RESTL TEMP13 1 = TEMP13 (TYPE LIST)>
  91                     <JUMP + MAP17>
  92 MAPAP20
  93                     <FRAME '\1aCRLF>
  94                     <GEN-LVAL 'OUTCHAN = STACK>
  95                     <CALL '\1aCRLF 1>
  96                     <FRAME '\1aNODE-COMPLAIN>
  97                     <NTHL LL8 1 = STACK (TYPE NODE)>
  98                     <CALL '\1aNODE-COMPLAIN 1>
  99                     <RESTL LL8 1 = LL8 (TYPE LIST)>
 100                     <RESTL LL8 1 = LL8 (TYPE LIST)>
 101                     <JUMP + AGAIN9>
 102                     <END \1aANA-MESS>
 103
 104 #WORD *11256535325*
 105                     <GFCN \1aADDVMESS ("VALUE" LIST NODE LIST) N4 L5>
 106                     <TEMP TEMP8 V7:LIST TEMP17>
 107                     <INTGO>
 108                     <GEN-LVAL 'VERBOSE = V7>
 109                     <SET TEMP8 V7>
 110                     <EMPL? TEMP8 + PHRASE12>
 111                     <LOOP (N4 VALUE) (TEMP8 VALUE)>
 112 TAG15
 113                     <NTHL TEMP8 1 = TEMP17>
 114                     <TYPE? TEMP17 <TYPE-CODE NODE> - TAG16>
 115                     <VEQUAL? TEMP17 N4 + TAG14>
 116                     <DEAD TEMP17>
 117 TAG16
 118                     <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
 119                     <EMPL? TEMP8 - TAG15>
 120                     <JUMP + PHRASE12>
 121 TAG14
 122                     <RESTL TEMP8 1 = TEMP17 (TYPE LIST)>
 123                     <DEAD TEMP8>
 124                     <NTHL TEMP17 1 = TEMP8 (TYPE LIST)>
 125                     <DEAD TEMP17>
 126                     <LENL TEMP8 = TEMP17 (TYPE FIX)>
 127                     <SUB TEMP17 -1 = TEMP17 (TYPE FIX)>
 128                     <GRTR? TEMP17 0 - RESTL20 (TYPE FIX)>
 129                     <LOOP (TEMP8 VALUE) (TEMP17 VALUE)>
 130 RESTL18
 131                     <INTGO>
 132                     <RESTL TEMP8 1 = TEMP8 (TYPE LIST)>
 133                     <SUB TEMP17 1 = TEMP17 (TYPE FIX)>
 134                     <GRTR? TEMP17 0 + RESTL18 (TYPE FIX)>
 135 RESTL20
 136                     <PUTREST TEMP8 L5>
 137                     <DEAD L5>
 138                     <RETURN TEMP8>
 139                     <DEAD TEMP8>
 140 PHRASE12
 141                     <CONS L5 () = TEMP17>
 142                     <DEAD L5>
 143                     <CONS N4 TEMP17 = TEMP17>
 144                     <DEAD N4>
 145                     <PUTREST V7 TEMP17>
 146                     <DEAD TEMP17>
 147                     <RESTL V7 1 = TEMP17 (TYPE LIST)>
 148                     <DEAD V7>
 149                     <RESTL TEMP17 1 = TEMP8 (TYPE LIST)>
 150                     <DEAD TEMP17>
 151                     <GEN-SET 'VERBOSE TEMP8>
 152                     <RETURN TEMP8>
 153                     <DEAD TEMP8>
 154                     <END \1aADDVMESS>
 155
 156 #WORD *34156736513*
 157                     <GFCN \1aCOMPILE-ERROR ("VALUE" ANY "TUPLE" ANY)>
 158                     <MAKTUP X4 IT20 = X4>
 159                     <INTGO>
 160                     <FRAME '\1aPRINC>
 161                     <PUSH "*** ERROR ">
 162                     <GEN-LVAL 'OUTCHAN = STACK>
 163                     <CALL '\1aPRINC 2>
 164                     <CHTYPE X4 <TYPE-CODE VECTOR> = X4>
 165                     <LOOP>
 166 MAP10
 167                     <INTGO>
 168                     <EMPUV? X4 + MAPAP13>
 169                     <NTHUV X4 1 = IT20>
 170                     <TYPE? IT20 <TYPE-CODE STRING> - PHRASE22>
 171                     <FRAME '\1aPRINC>
 172                     <PUSH IT20>
 173                     <DEAD IT20>
 174                     <GEN-LVAL 'OUTCHAN = STACK>
 175                     <CALL '\1aPRINC 2>
 176                     <JUMP + PHRASE29>
 177 PHRASE22
 178                     <TYPE? IT20 <TYPE-CODE NODE> - PHRASE27>
 179                     <FRAME '\1aNODE-COMPLAIN>
 180                     <PUSH IT20>
 181                     <DEAD IT20>
 182                     <CALL '\1aNODE-COMPLAIN 1>
 183                     <JUMP + PHRASE29>
 184 PHRASE27
 185                     <FRAME '\1aPRIN1>
 186                     <PUSH IT20>
 187                     <DEAD IT20>
 188                     <GEN-LVAL 'OUTCHAN = STACK>
 189                     <CALL '\1aPRIN1 2>
 190 PHRASE29
 191                     <FRAME '\1aPRINC>
 192                     <PUSH " ">
 193                     <GEN-LVAL 'OUTCHAN = STACK>
 194                     <CALL '\1aPRINC 2>
 195                     <RESTUV X4 1 = X4 (TYPE VECTOR)>
 196                     <JUMP + MAP10>
 197 MAPAP13
 198                     <NTHR 'DEBUGSW 1 = X4 (RECORD-TYPE ATOM) (BRANCH-FALSE + PHRASE39)>
 199                     <TYPE? X4 <TYPE-CODE FALSE> + PHRASE39>
 200                     <NTHR X4 1 = X4 (RECORD-TYPE GBIND)>
 201                     <TYPE? X4 <TYPE-CODE UNBOUND> + PHRASE39>
 202                     <DEAD X4>
 203                     <GVAL 'DEBUGSW = X4>
 204                     <TYPE? X4 <TYPE-CODE FALSE> + PHRASE39>
 205                     <DEAD X4>
 206                     <FRAME '\1aERROR>
 207                     <CALL '\1aERROR 0>
 208 PHRASE39
 209                     <FRAME '\1aRETURN>
 210                     <PUSH %<>>
 211                     <GEN-LVAL 'COMPILE-ACTIVATION = STACK>
 212                     <CALL '\1aRETURN 2 = X4>
 213                     <RETURN X4>
 214                     <DEAD X4>
 215                     <END \1aCOMPILE-ERROR>
 216
 217 #WORD *1706511541*
 218                     <GFCN \1aCOMPILE-LOSSAGE ("VALUE" ANY "TUPLE" ANY)>
 219                     <MAKTUP X4 IT20 = X4>
 220                     <INTGO>
 221                     <FRAME '\1aPRINC>
 222                     <PUSH "*** LOSSAGE ">
 223                     <GEN-LVAL 'OUTCHAN = STACK>
 224                     <CALL '\1aPRINC 2>
 225                     <CHTYPE X4 <TYPE-CODE VECTOR> = X4>
 226                     <LOOP>
 227 MAP10
 228                     <INTGO>
 229                     <EMPUV? X4 + MAPAP13>
 230                     <NTHUV X4 1 = IT20>
 231                     <TYPE? IT20 <TYPE-CODE STRING> - PHRASE22>
 232                     <FRAME '\1aPRINC>
 233                     <PUSH IT20>
 234                     <DEAD IT20>
 235                     <GEN-LVAL 'OUTCHAN = STACK>
 236                     <CALL '\1aPRINC 2>
 237                     <JUMP + PHRASE29>
 238 PHRASE22
 239                     <TYPE? IT20 <TYPE-CODE NODE> - PHRASE27>
 240                     <FRAME '\1aNODE-COMPLAIN>
 241                     <PUSH IT20>
 242                     <DEAD IT20>
 243                     <CALL '\1aNODE-COMPLAIN 1>
 244                     <JUMP + PHRASE29>
 245 PHRASE27
 246                     <FRAME '\1aPRIN1>
 247                     <PUSH IT20>
 248                     <DEAD IT20>
 249                     <GEN-LVAL 'OUTCHAN = STACK>
 250                     <CALL '\1aPRIN1 2>
 251 PHRASE29
 252                     <FRAME '\1aPRINC>
 253                     <PUSH " ">
 254                     <GEN-LVAL 'OUTCHAN = STACK>
 255                     <CALL '\1aPRINC 2>
 256                     <RESTUV X4 1 = X4 (TYPE VECTOR)>
 257                     <JUMP + MAP10>
 258 MAPAP13
 259                     <FRAME '\1aERROR>
 260                     <PUSH 'LOSSAGE!-ERRORS>
 261                     <CALL '\1aERROR 1 = X4>
 262                     <RETURN X4>
 263                     <DEAD X4>
 264                     <END \1aCOMPILE-LOSSAGE>
 265
 266 #WORD *33260646511*
 267                     <GFCN \1aCOMPILE-WARNING ("VALUE" ATOM "TUPLE" ANY)>
 268                     <MAKTUP X4 IT20 = X4>
 269                     <INTGO>
 270                     <FRAME '\1aPRINC>
 271                     <PUSH "*** WARNING ">
 272                     <GEN-LVAL 'OUTCHAN = STACK>
 273                     <CALL '\1aPRINC 2>
 274                     <CHTYPE X4 <TYPE-CODE VECTOR> = X4>
 275                     <LOOP>
 276 MAP10
 277                     <INTGO>
 278                     <EMPUV? X4 + MAPAP13>
 279                     <NTHUV X4 1 = IT20>
 280                     <TYPE? IT20 <TYPE-CODE STRING> - PHRASE22>
 281                     <FRAME '\1aPRINC>
 282                     <PUSH IT20>
 283                     <DEAD IT20>
 284                     <GEN-LVAL 'OUTCHAN = STACK>
 285                     <CALL '\1aPRINC 2>
 286                     <JUMP + PHRASE29>
 287 PHRASE22
 288                     <TYPE? IT20 <TYPE-CODE NODE> - PHRASE27>
 289                     <FRAME '\1aNODE-COMPLAIN>
 290                     <PUSH IT20>
 291                     <DEAD IT20>
 292                     <CALL '\1aNODE-COMPLAIN 1>
 293                     <JUMP + PHRASE29>
 294 PHRASE27
 295                     <FRAME '\1aPRIN1>
 296                     <PUSH IT20>
 297                     <DEAD IT20>
 298                     <GEN-LVAL 'OUTCHAN = STACK>
 299                     <CALL '\1aPRIN1 2>
 300 PHRASE29
 301                     <FRAME '\1aPRINC>
 302                     <PUSH " ">
 303                     <GEN-LVAL 'OUTCHAN = STACK>
 304                     <CALL '\1aPRINC 2>
 305                     <RESTUV X4 1 = X4 (TYPE VECTOR)>
 306                     <JUMP + MAP10>
 307 MAPAP13
 308                     <FRAME '\1aCRLF>
 309                     <GEN-LVAL 'OUTCHAN = STACK>
 310                     <CALL '\1aCRLF 1 = X4>
 311                     <RETURN X4>
 312                     <DEAD X4>
 313                     <END \1aCOMPILE-WARNING>
 314
 315 #WORD *35041035633*
 316                     <GFCN \1aCOMPILE-NOTE ("VALUE" ATOM "TUPLE" ANY)>
 317                     <MAKTUP X4 IT20 = X4>
 318                     <INTGO>
 319                     <FRAME '\1aPRINC>
 320                     <PUSH "*** NOTE ">
 321                     <GEN-LVAL 'OUTCHAN = STACK>
 322                     <CALL '\1aPRINC 2>
 323                     <CHTYPE X4 <TYPE-CODE VECTOR> = X4>
 324                     <LOOP>
 325 MAP10
 326                     <INTGO>
 327                     <EMPUV? X4 + MAPAP13>
 328                     <NTHUV X4 1 = IT20>
 329                     <TYPE? IT20 <TYPE-CODE STRING> - PHRASE22>
 330                     <FRAME '\1aPRINC>
 331                     <PUSH IT20>
 332                     <DEAD IT20>
 333                     <GEN-LVAL 'OUTCHAN = STACK>
 334                     <CALL '\1aPRINC 2>
 335                     <JUMP + PHRASE29>
 336 PHRASE22
 337                     <TYPE? IT20 <TYPE-CODE NODE> - PHRASE27>
 338                     <FRAME '\1aNODE-COMPLAIN>
 339                     <PUSH IT20>
 340                     <DEAD IT20>
 341                     <CALL '\1aNODE-COMPLAIN 1>
 342                     <JUMP + PHRASE29>
 343 PHRASE27
 344                     <FRAME '\1aPRIN1>
 345                     <PUSH IT20>
 346                     <DEAD IT20>
 347                     <GEN-LVAL 'OUTCHAN = STACK>
 348                     <CALL '\1aPRIN1 2>
 349 PHRASE29
 350                     <FRAME '\1aPRINC>
 351                     <PUSH " ">
 352                     <GEN-LVAL 'OUTCHAN = STACK>
 353                     <CALL '\1aPRINC 2>
 354                     <RESTUV X4 1 = X4 (TYPE VECTOR)>
 355                     <JUMP + MAP10>
 356 MAPAP13
 357                     <FRAME '\1aCRLF>
 358                     <GEN-LVAL 'OUTCHAN = STACK>
 359                     <CALL '\1aCRLF 1 = X4>
 360                     <RETURN X4>
 361                     <DEAD X4>
 362                     <END \1aCOMPILE-NOTE>
 363
 364 <ENDPACKAGE>