lang/occam/lib/tail_ocm.a

   1 e�builtin.c\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0p\ 5/* $Id: builtin.c,v 1.5 1994/06/24 12:27:56 ceriel Exp $ */
   2 /*
   3  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   4  * See the copyright notice in the ACK home directory, in the file "Copyright".
   5  */
   6
   7 /*      builtin.c - built in named processes */
   8 #include "ocm_chan.h"
   9 #ifndef nil
  10 #define nil 0
  11 #endif
  12
  13 extern int errno;
  14
  15 static void nullterm(s) register char *s;
  16 /* Change Occam string to C string */
  17 {
  18         register len= (*s & 0377);
  19         register char *p;
  20
  21         while (--len>=0) {
  22                 p=s++;
  23                 *p = *s;
  24         }
  25         *s=0;
  26 }
  27
  28 static void lenterm(s) register char *s;
  29 /* Change C string to Occam string */
  30 {
  31         register i=0;
  32         register c0, c1;
  33
  34         c0=0;
  35         do {
  36                 c1=s[i];
  37                 s[i++]=c0;
  38                 c0=c1;
  39         } while (c0!=0);
  40         *s= i-1;
  41 }
  42
  43 void b_open(mode, name, index) register char *mode, *name; long *index;
  44 /* PROC open(VAR index, VALUE name[], mode[])=  */
  45 {
  46         register FILE *fp;
  47         register i;
  48
  49         nullterm(name);
  50         nullterm(mode);
  51
  52         fp=fopen(name, mode);
  53
  54         lenterm(name);
  55         lenterm(mode);
  56
  57         if (fp==nil)
  58                 *index= -errno;
  59         else {
  60                 /* Find free file channel, there must be one free! */
  61
  62                 for (i=0; (file[i].f.flgs&C_F_INUSE)!=0; i++) ;
  63
  64                 file[i].f.flgs|=C_F_INUSE;
  65                 unix_file[i]=fp;
  66                 *index=i;
  67         }
  68 }
  69
  70 void b_close(index) long index;
  71 /* PROC close(VALUE index)=     */
  72 {
  73         fclose(unix_file[index]);
  74         file[index].f.flgs&= ~C_F_INUSE;
  75 }
  76
  77 void b_exit(code) long code;
  78 /* PROC exit(VALUE code)=       */
  79 {
  80         exit((int) code);
  81 }
  82 chan_strct.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\11\ 3/* $Id: chan_strct.c,v 1.3 1994/06/24 12:28:01 ceriel Exp $ */
  83 /*      chan_struct.c - channel routines for more structured objects */
  84 #include "ocm_chan.h"
  85
  86 void cbyte_in(b, c) char *b; chan *c;
  87 {
  88         long v;
  89         chan_in(&v, c);
  90         *b= (char) v;
  91 }
  92
  93 void c_wa_in(a, z, c) register long *a; register unsigned z; register chan *c;
  94 {
  95         do
  96                 chan_in(a++, c);
  97         while (--z!=0);
  98 }
  99
 100 void c_ba_in(a, z, c) register char *a; register unsigned z; register chan *c;
 101 {
 102         do {
 103                 long v;
 104                 chan_in(&v, c);
 105                 *a++ = (char) v;
 106         } while (--z!=0);
 107 }
 108
 109 void c_wa_out(a, z, c) register long *a; register unsigned z; register chan *c;
 110 {
 111         do
 112                 chan_out(*a++, c);
 113         while (--z!=0);
 114 }
 115
 116 void c_ba_out(a, z, c) register char *a; register unsigned z; register chan *c;
 117 {
 118         do
 119                 chan_out((long) (*a++ &0377), c);
 120         while (--z!=0);
 121 }
 122 dchannel.c\0.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ f/* $Id: channel.c,v 1.12 1994/06/24 12:28:06 ceriel Exp $ */
 123 /*      channel.c - basic channel handling routines */
 124 #include <errno.h>
 125 #ifndef __BSD4_2
 126 #include <signal.h>
 127 #endif
 128 #include <sgtty.h>
 129 #include "ocm_chan.h"
 130
 131 static void disaster();
 132
 133 void c_init(c, z) register chan *c; register unsigned z;
 134 /* Initialise an array of interprocess channels declared as: CHAN c[z]. */
 135 {
 136         do {
 137                 c->type=C_T_CHAN;
 138                 (c++)->c.synch=C_S_FREE;
 139         } while (--z!=0);
 140 }
 141
 142 void chan_in(v, c) long *v; register chan *c;
 143 /* Reads a value from channel c and returns it through v. */
 144 {
 145         switch(c->type) {
 146         case C_T_FILE:
 147                 if ((c->f.flgs&C_F_READAHEAD)!=0) {
 148                         *v=(c->f.preread&0377);
 149                         c->f.flgs&= ~C_F_READAHEAD;
 150                 } else {
 151                         register FILE *fp= unix_file[c->f.index];
 152
 153                         *v= feof(fp) ? C_F_EOF : getc(fp);
 154                 }
 155                 break;
 156         case C_T_CHAN:
 157                 deadlock=0;             /* Wait for value to arrive */
 158                 while (c->c.synch!=C_S_ANY) resumenext();
 159
 160                 *v=c->c.val;
 161                 c->c.synch=C_S_ACK;     /* Acknowledge receipt */
 162                 break;
 163         default:
 164                 disaster();
 165         }
 166 }
 167 \f
 168 void chan_out(v, c) long v; register chan *c;
 169 /* Send value v through channel c. */
 170 {
 171         switch(c->type) {
 172         case C_T_FILE: {
 173                 register FILE *fp= unix_file[c->f.index];
 174                 struct sgttyb tty;
 175
 176                 if ((v& ~0xff)==0)      /* Plain character */
 177                         putc( (int) v, fp);
 178                 else
 179                 if (v==C_F_TEXT) {
 180                         gtty(fileno(fp), &tty);
 181                         tty.sg_flags&= ~CBREAK;
 182                         tty.sg_flags|= ECHO|CRMOD;
 183                         stty(fileno(fp), &tty);
 184                 } else
 185                 if (v==C_F_RAW) {
 186                         gtty(fileno(fp),&tty);
 187                         tty.sg_flags|= CBREAK;
 188                         tty.sg_flags&= ~(ECHO|CRMOD);
 189                         stty(fileno(fp), &tty);
 190                 }
 191         }       break;
 192         case C_T_CHAN:
 193                 deadlock=0;             /* Wait until channel is free */
 194                 while (c->c.synch!=C_S_FREE) resumenext();
 195
 196                 c->c.val=v;
 197                 c->c.synch=C_S_ANY;     /* Channel has data */
 198
 199                 deadlock=0;             /* Wait for acknowledgement */
 200                 while (c->c.synch!=C_S_ACK) resumenext();
 201
 202                 c->c.synch=C_S_FREE;    /* Back to normal */
 203                 break;
 204         default:
 205                 disaster();
 206         }
 207 }
 208 \f
 209 #ifndef __BSD4_2
 210 static void timeout();
 211 #endif
 212
 213 int chan_any(c) register chan *c;
 214 {
 215 #ifdef __BSD4_2
 216 #include <fcntl.h>
 217         int flags;
 218 #endif
 219         switch (c->type) {
 220         case C_T_FILE:
 221                 if ((c->f.flgs&C_F_READAHEAD)!=0)
 222                         return 1;
 223                 else {
 224                         register FILE *fp= unix_file[c->f.index];
 225
 226                         if (feof(fp))
 227                                 return 1;
 228                         else {
 229                                 extern int errno;
 230                                 register ch;
 231
 232                                 deadlock=0;
 233                                         /* No deadlock while waiting for key */
 234
 235                                 /* Unfortunately, the mechanism that was used
 236                                    here does not work on all Unix systems.
 237                                    On BSD 4.2 and newer, the "read" is
 238                                    automatically restarted. Therefore, on
 239                                    these systems, we try it with non-blocking
 240                                    reads
 241                                 */
 242 #ifdef __BSD4_2
 243                                 flags = fcntl(fileno(fp), F_GETFL, 0);
 244                                 fcntl(fileno(fp), F_SETFL, flags | O_NDELAY);
 245                                 errno = 0;
 246                                 ch = getc(fp);
 247                                 fcntl(fileno(fp), F_SETFL, flags);
 248                                 if (errno == EWOULDBLOCK) {
 249                                         clearerr(fp);
 250                                         return 0;
 251                                 }
 252 #else
 253                                 signal(SIGALRM, timeout);
 254                                 alarm(1);
 255
 256                                 errno=0;
 257                                 ch=getc(fp);
 258
 259                                 signal(SIGALRM, SIG_IGN);
 260                                 alarm(0);
 261
 262                                 if (errno==EINTR) {
 263                                         clearerr(fp);
 264                                         return 0;
 265                                 }
 266 #endif
 267                                 else {
 268                                         if (!feof(fp)) {
 269                                                 c->f.flgs|=C_F_READAHEAD;
 270                                                 c->f.preread=ch;
 271                                         }
 272                                         return 1;
 273                                 }
 274                         }
 275                 }
 276         case C_T_CHAN:
 277                 return c->c.synch==C_S_ANY;
 278         default:
 279                 disaster();
 280         }
 281 }
 282
 283 #ifndef __BSD4_2
 284 /* The ch=getc(fp) in the above function calls read(2) to do its task, but if
 285  * there's no input on the file (pipe or terminal) then the read will block.
 286  * To stop this read from blocking, we use the fact that if the read is
 287  * interrupted by a signal that is caught by the program, then the read returns
 288  * error EINTR after the signal is processed. Thus we use a one second alarm
 289  * to interrupt the read with a trap to timeout(). But since the alarm signal
 290  * may occur *before* the read is called, it is continuously restarted in
 291  * timeout() to prevent it from getting lost.
 292  */
 293
 294 static void timeout(sig)
 295 {
 296         signal(SIGALRM, timeout);
 297         alarm(1);
 298 }
 299 #endif
 300
 301 static void disaster()
 302 {
 303         write(2, "Fatal error: Channel variable corrupted\n", 40);
 304         abort();
 305 }
 306 co.c\0el.c\0.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0+       /* $Id: co.c,v 1.4 1994/06/24 12:28:11 ceriel Exp $ */
 307 /*      co.c - Routines to handle coroutines */
 308 #include "ocm_proc.h"
 309
 310 static void search(), RESUMERR();
 311
 312 void resume(id) identification id;
 313 /* Stops the current process, by saving its stack, and searches for the
 314  * process with identification 'id' in the group the running process
 315  * belongs to. If 'id' cannot be found then repeat these actions with
 316  * the running process' parent. If 'id' is found it is activated. It
 317  * is a fatal error if 'id' cannot be found.
 318  */
 319 {
 320         if (group!=nil) {
 321                 register wordsize size;
 322
 323                 size=top_size(group->s_brk);
 324                 (*group->active)->stack=alloc((unsigned) size);
 325
 326                 if (top_save(size, (*group->active)->stack))
 327                         search(id);
 328                 else {
 329                         free((*group->active)->stack);
 330                         load_betweens();
 331                 }
 332         } else
 333                 RESUMERR();
 334 }
 335
 336 static void search(id) identification id;
 337 /* Searches for the process with identification 'id'.
 338  * If the process is found it is activated and its process tree is
 339  * traversed to find the running process.
 340  */
 341 {
 342         register struct process **aproc, *proc;
 343
 344         for(;;) {
 345                 aproc= &group->first;
 346
 347                 while (*aproc!=nil && (*aproc)->id!=id)
 348                         aproc= &(*aproc)->next;
 349
 350                 if (*aproc!=nil) break;
 351
 352                 save_between(group);
 353
 354                 if ((group=group->up)==nil)
 355                         RESUMERR();
 356         }
 357         group->active=aproc;
 358         proc= *aproc;
 359         highest_group=group;
 360
 361         while (proc->down!=nil) {
 362                 group=proc->down;
 363                 proc= *group->active;
 364         }
 365         top_load(proc->stack);
 366 }
 367 \f
 368 static void delete_group(group) struct procgroup *group;
 369 /* Removes the whole group and sub-groups recursively from the running
 370  * process.
 371  */
 372 {
 373         register struct process *proc, *next;
 374
 375         proc=group->first;
 376
 377         while (proc!=nil) {
 378                 if (proc->down!=nil)
 379                         delete_group(proc->down);
 380                 else
 381                         free(proc->stack);
 382                 next=proc->next;
 383                 free( (void *) proc);
 384                 proc=next;
 385         }
 386         delete_between(group);
 387         free( (void *) group);
 388 }
 389
 390 void coend()
 391 {
 392         register struct process *proc, *next;
 393         register struct procgroup *junk;
 394
 395         proc=group->first;
 396
 397         while (proc!=nil) {
 398                 if (proc!= *group->active) {
 399                         if (proc->down!=nil)
 400                                 delete_group(proc->down);
 401                         else
 402                                 free(proc->stack);
 403                 }
 404                 next=proc->next;
 405                 free( (void *) proc);
 406                 proc=next;
 407         }
 408         delete_between(group);
 409         junk=group;
 410         group=group->up;
 411         free( (void *) junk);
 412
 413         if (group!=nil)
 414                 (*group->active)->down=nil;
 415 }
 416
 417 static void RESUMERR()
 418 {
 419         write(2, "RESUMERR\n", 9);
 420         abort();
 421 }
 422  now.c\0l.c\0.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\95\0/* $Id: now.c,v 1.3 1994/06/24 12:28:16 ceriel Exp $ */
 423 long now()
 424 {
 425         extern int deadlock;
 426         long time();
 427
 428         deadlock = 0;
 429         return time((long *) 0);
 430 }
 431 Rpar.c\0l.c\0.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0;\b/* $Id: par.c,v 1.4 1994/06/24 12:28:26 ceriel Exp $ */
 432 /*      par.c - Routines to simulate parallelism */
 433 #include "ocm_proc.h"
 434
 435 static void search_next(), DEADLOCK();
 436
 437 void resumenext()
 438 /* Stops the current process, by saving its stack,  and determines a new one
 439  * to restart. In case the root of the process tree is passed more then once,
 440  * without a process  having done something useful, we'll have a deadlock.
 441  */
 442 {
 443         if (group!=nil) {
 444                 register struct process *proc= *group->active;
 445                 register wordsize size;
 446
 447                 size=top_size(group->s_brk);
 448                 proc->stack=alloc((unsigned) size);
 449
 450                 if (top_save(size, proc->stack)) {
 451                         group->active= &proc->next;
 452                         search_next();
 453                 } else {
 454                         free(proc->stack);
 455                         load_betweens();
 456                 }
 457         } else
 458                 if (++deadlock>1) DEADLOCK();
 459 }
 460
 461 static void search_next()
 462 /* Tries to resume the active process, if this is not possible, the process
 463  * tree will be searched for another process. If the process tree is fully
 464  * traversed, search will restart at the root of the tree.
 465  */
 466 {
 467         while (*group->active==nil && group->up!=nil) {
 468                 save_between(group);
 469
 470                 group=group->up;
 471
 472                 group->active= &(*group->active)->next;
 473         }
 474
 475         if (*group->active==nil) {
 476                 if (++deadlock>1) DEADLOCK();
 477                 group->active= &group->first;
 478         }
 479
 480         highest_group=group;
 481
 482         while ((*group->active)->down!=nil) {
 483                 group=(*group->active)->down;
 484                 group->active= &group->first;
 485         }
 486         top_load((*group->active)->stack);
 487 }
 488 \f
 489 void parend()
 490 /* Deletes the current process from its process group and searches for a new
 491  * process to run. The entire group is removed if this is the last process in
 492  * the group, execution then continues with the process that set up this group
 493  * in the first place.
 494  */
 495 {
 496         register struct process *junk;
 497
 498         junk= *group->active;
 499         *group->active=junk->next;
 500         free((void *) junk);
 501
 502         if (group->first==nil) {
 503                 register struct procgroup *junk;
 504
 505                 delete_between(group);
 506
 507                 junk=group;
 508                 group=group->up;
 509                 free((void *) junk);
 510
 511                 if (group!=nil)
 512                         (*group->active)->down=nil;
 513         } else {
 514                 deadlock=0;
 515                 search_next();
 516         }
 517 }
 518
 519 static void DEADLOCK()
 520 {
 521         write(2, "DEADLOCK\n", 9);
 522         abort();
 523 }
 524 nparco.c\0c\0.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0E\v/* $Id: parco.c,v 1.4 1994/06/24 12:28:31 ceriel Exp $ */
 525 /*      parco.c - Common routines for simulating parallelism or coroutines on
 526  *                machines with downward growing stacks
 527  */
 528 #include "ocm_proc.h"
 529
 530 struct procgroup *group=nil, *highest_group;
 531
 532 int deadlock=0;
 533
 534 void pc_begin(s_brk, id)
 535         register void *s_brk;
 536         identification id;
 537 /* Sets up a group of processes and puts the current process in it */
 538 {
 539         register struct procgroup *pg;
 540         register struct process *p;
 541
 542         pg= (struct procgroup *) alloc(sizeof *pg);
 543         p= (struct process *) alloc(sizeof *p);
 544
 545         pg->s_brk= s_brk==nil ? (void *) (&id +1) : s_brk;
 546         pg->up=group;
 547         pg->first=p;
 548         pg->active= &pg->first;
 549
 550         p->next=nil;
 551         p->down=nil;
 552         p->id=id;
 553
 554         if (group!=nil)
 555                 (*group->active)->down=pg;
 556
 557         group=pg;
 558         init_between(group);
 559 }
 560 \f
 561 int pc_fork(id) identification id;
 562 /* Makes a copy of the stack top of the calling function and creates an
 563  * entry for it in the current process group.  Pc_fork() returns 1 in the
 564  * current process, 0 in the copied process. The current process runs first.
 565  */
 566 {
 567         register struct process *newp;
 568         register wordsize size;
 569
 570         newp= (struct process *) alloc(sizeof *newp);
 571
 572         newp->down=nil;
 573         newp->id=id;
 574
 575         newp->next= *group->active;
 576         *group->active= newp;
 577         group->active= &newp->next;
 578
 579         size=top_size(group->s_brk);
 580         newp->stack=alloc((unsigned) size);
 581
 582         if (top_save(size, newp->stack))
 583                 return 1;
 584         else {
 585                 free(newp->stack);
 586                 load_betweens();
 587                 return 0;
 588         }
 589 }
 590 \f
 591 void init_between(group) register struct procgroup *group;
 592 /* Allocates memory to hold the stack space between s_brk and up->s_brk. */
 593 {
 594         register wordsize size;
 595
 596         if (group->up==nil
 597             || (size= (wordsize) group->up->s_brk - (wordsize) group->s_brk)==0)
 598                 group->between=nil;
 599         else
 600                 group->between=alloc((unsigned) size);
 601 }
 602
 603 void block_move();
 604
 605 void save_between(group) register struct procgroup *group;
 606 /* Saves the stack space between  s_brk and up->s_brk. */
 607 {
 608         register wordsize size;
 609
 610         if (group->between!=nil) {
 611                 size= (wordsize) group->up->s_brk - (wordsize) group->s_brk;
 612                 block_move(size, group->s_brk, group->between);
 613         }
 614 }
 615
 616 void load_betweens()
 617 /* All stack pieces between s_brk and up->s_brk from the current group
 618  * upto the 'highest_group' are loaded onto the stack at the right
 619  * place (i.e. s_brk).
 620  */
 621 {
 622         register struct procgroup *gr=group, *up;
 623         register wordsize size;
 624
 625         while (gr!=highest_group) {
 626                 up=gr->up;
 627                 if (gr->between!=nil) {
 628                         size= (wordsize) up->s_brk - (wordsize) gr->s_brk;
 629
 630                         block_move(size, gr->between, gr->s_brk);
 631                 }
 632                 gr=up;
 633         }
 634 }
 635
 636 void delete_between(group) register struct procgroup *group;
 637 /* Deallocates the stack space between s_brk and up->s_brk. */
 638 {
 639         if (group->between!=nil)
 640                 free(group->between);
 641 }
 642
 643 void *malloc();
 644
 645 void *alloc(size) unsigned size;
 646 {
 647         register void *mem;
 648
 649         if ((mem=malloc(size))==nil) {
 650                 write(2, "Heap error\n", 14);
 651                 abort();
 652         }
 653         return mem;
 654 }
 655 ;misc.e\0\0c\0.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1#
 656  mes 2,EM_WSIZE,EM_PSIZE
 657
 658 oldtrp
 659  bss EM_PSIZE, 0, 0
 660
 661  exp $init
 662  pro $init, 0
 663  loc -321-1
 664  sim
 665  lpi $catch1
 666  sig
 667  lae oldtrp
 668  sti EM_PSIZE
 669  cal $initfile
 670  ret 0
 671  end 0
 672
 673  pro $catch1, 0
 674  lae oldtrp
 675  loi EM_PSIZE
 676  sig
 677  asp EM_PSIZE
 678  loe 0
 679  lae 4
 680  loi EM_PSIZE
 681  lol 0
 682  cal $catch
 683  asp 2*EM_WSIZE+EM_PSIZE
 684  lol 0
 685  trp
 686  rtt
 687  end 0
 688
 689  exp $block_move
 690  pro $block_move, 0
 691  lal EM_PSIZE
 692  loi EM_PSIZE
 693  lal 2*EM_PSIZE
 694  loi EM_PSIZE
 695
 696  lal 0
 697  loi EM_PSIZE
 698  loc EM_PSIZE
 699  loc EM_WSIZE
 700  cuu
 701  bls EM_WSIZE
 702  ret 0
 703  end 0
 704 ocrt.c\0\0c\0.c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 3/* $Id: ocrt.c,v 1.4 1994/06/24 12:28:21 ceriel Exp $ */
 705 /*      ocrt.c - Occam runtime support */
 706 #include "ocm_chan.h"
 707
 708 int chandes[]= { 0, 0, sizeof(int)+sizeof(long) };
 709 int worddes[]= { 0, 0, sizeof(long) };
 710 int bytedes[]= { 0, 0, 1 };
 711 long any;
 712
 713 void catch(sig, file, line) int sig; char *file; int line;
 714 /* Catches traps in the occam program */
 715 {
 716         register char *mes;
 717
 718         switch (sig) {
 719         case 0:
 720                 mes="array bound error";
 721                 break;
 722         case 6:
 723                 mes="division by zero";
 724                 break;
 725         case 8:
 726                 mes="undefined variable";
 727                 break;
 728         default:
 729                 return;
 730         }
 731         fprintf(stderr, "%s (%d) F: %s\n", file, line, mes);
 732         abort();
 733 }
 734
 735 chan file[20];
 736 FILE *unix_file[20];
 737
 738 void initfile()
 739 {
 740         register i;
 741         register chan *c=file;
 742
 743         for (i=0; i<20; i++) {
 744                 c->type=C_T_FILE;
 745                 c->f.flgs=0;
 746                 (c++)->f.index=i;
 747         }
 748         file[0].f.flgs|=C_F_INUSE;
 749         unix_file[0]=stdin;
 750
 751         file[1].f.flgs|=C_F_INUSE;
 752         unix_file[1]=stdout;
 753
 754         file[2].f.flgs|=C_F_INUSE;
 755         unix_file[2]=stderr;
 756 }
 757 Ppar_misc.e\0c\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\93\b#
 758  mes 2,EM_WSIZE,EM_PSIZE
 759  exp $top_size
 760 #ifdef __sparc
 761  inp $top_size2
 762  pro $top_size, 0
 763  mes 11
 764  zer EM_PSIZE
 765  lal 0
 766  loi EM_PSIZE
 767  cal $top_size2
 768  asp 2*EM_PSIZE
 769  lfr EM_WSIZE
 770  ret EM_WSIZE
 771  end 0
 772  pro $top_size2, 3*EM_WSIZE+3*EM_PSIZE
 773 #else
 774  pro $top_size, 3*EM_WSIZE+3*EM_PSIZE
 775 #endif
 776  mes 11
 777  lal 0
 778  loi EM_PSIZE           ; s_brk
 779  lor 1                  ; s_brk  SP
 780  sbs EM_PSIZE           ; s_brk-SP
 781  ret EM_PSIZE           ; return size of block to be saved
 782  end 3*EM_WSIZE+3*EM_PSIZE
 783
 784  exp $top_save
 785 #ifdef __sparc
 786  inp $top_save2
 787  pro $top_save,0
 788  mes 11
 789  lal 0
 790  loi 2*EM_PSIZE
 791  cal $top_save2
 792  asp 2*EM_PSIZE
 793  lfr EM_WSIZE
 794  ret EM_WSIZE
 795  end 0
 796  pro $top_save2,0
 797 #else
 798  pro $top_save, 0
 799 #endif
 800  mes 11
 801  loe 0
 802  lae 4                  ; load line number and file name
 803  loi EM_PSIZE
 804  lim                    ; ignore mask
 805  lor 0                  ; LB
 806  lal 0
 807  loi EM_PSIZE           ; size of block
 808  loc EM_PSIZE
 809  loc EM_WSIZE
 810  cuu
 811  dup EM_WSIZE
 812  stl 0                  ; push & store size in 2 bytes
 813  lor 1                  ; SP (the SP BEFORE pushing)
 814  lor 1                  ; SP (address of stack top to save)
 815  lal EM_PSIZE                   ; area
 816  loi EM_PSIZE
 817  lol 0                  ; size
 818  bls EM_WSIZE           ; move whole block
 819  asp 3*EM_PSIZE+3*EM_WSIZE      ; remove the lot from the stack
 820  loc 1
 821  ret EM_WSIZE                   ; return 1
 822  end 0
 823
 824 sv
 825  bss EM_PSIZE, 0, 0
 826
 827  exp $top_load
 828 #ifdef __sparc
 829  inp $top_load1
 830  pro $top_load,0
 831  lal 0
 832  loi EM_PSIZE
 833  cal $top_load1
 834  asp EM_PSIZE
 835  lfr EM_WSIZE
 836  ret EM_WSIZE
 837  end 0
 838  pro $top_load1, 0
 839 #else
 840  pro $top_load, 0
 841 #endif
 842  mes 11
 843  lal 0
 844  loi EM_PSIZE
 845  lae sv
 846  sti EM_PSIZE
 847
 848  lxl 0
 849 2
 850  dup EM_PSIZE
 851  adp -3*EM_PSIZE
 852  lal 0
 853  loi EM_PSIZE           ; compare target SP with current LB to see if we must
 854  loi EM_PSIZE
 855  cmp                    ; find another LB first
 856  zgt *1
 857  dch                    ; just follow dynamic chain to make sure we find
 858                         ; a legal one
 859  bra *2
 860 1
 861  str 0
 862
 863  lae sv
 864  loi EM_PSIZE
 865  loi EM_PSIZE
 866  str 1                  ; restore SP
 867  asp -EM_PSIZE
 868  lae sv
 869  loi EM_PSIZE
 870  lor 1                  ; SP (the SP AFTER, see above)
 871  adp EM_PSIZE
 872  lae sv
 873  loi EM_PSIZE
 874  lof EM_PSIZE           ; size of block
 875  bls EM_WSIZE           ; move block back (SP becomes the SP BEFORE again!)
 876  asp EM_WSIZE+EM_PSIZE  ; drop size + SP
 877  str 0                  ; LB
 878  sim                    ; ignore mask
 879  lae 4
 880  sti EM_PSIZE
 881  ste 0                  ; line and file
 882  loc 0
 883  ret EM_WSIZE           ; return 0
 884  end 0
 885 t