mim/development/mim/20c/jsys.mud

   1
   2 <NEWTYPE XGLOC ATOM>
   3
   4 <NEWTYPE JSYS WORD>
   5
   6 <SETG DOJSYS 504>
   7
   8 <SETG HBPS 506>
   9
  10 <SETG MAX-ACS 5>
  11
  12 <SETG MAX-ACS-1 4>
  13
  14 <SETG BEAR-JSYS 9126805504>
  15
  16 <GDECL (MAX-IMMEDIATE) FIX>
  17
  18 <MANIFEST BEAR-JSYS>
  19
  20 <BLOCK (<ROOT>)>
  21 ALL-JSY
  22 <ENDBLOCK>
  23 <BLOCK (<SETG JSYS-OBLIST <MOBLIST JSYS>> <ROOT>)>
  24 <SETG ALL-JSY
  25       '[0
  26         JSYS
  27         1
  28         LOGIN
  29         2
  30         CRJOB
  31         3
  32         LGOUT
  33         4
  34         CACCT
  35         5
  36         EFACT
  37         6
  38         SMON
  39         7
  40         TMON
  41         8
  42         GETAB
  43         9
  44         ERSTR
  45         10
  46         GETER
  47         11
  48         GJINF
  49         12
  50         TIME-JSYS
  51         13
  52         RUNTM
  53         14
  54         SYSGT
  55         15
  56         GNJFN
  57         16
  58         GTJFN-S-S
  59         16
  60         GTJFN-S-J
  61         16
  62         GTJFN-L
  63         17
  64         OPENF
  65         18
  66         CLOSF
  67         19
  68         RLJFN
  69         20
  70         GTSTS
  71         21
  72         STSTS
  73         22
  74         DELF
  75         23
  76         SFPTR
  77         24
  78         JFNS
  79         25
  80         FFFFP
  81         26
  82         RDDIR
  83         27
  84         CPRTF
  85         28
  86         CLZFF
  87         29
  88         RNAMF
  89         30
  90         SIZEF
  91         31
  92         GACTF
  93         32
  94         STDIR
  95         33
  96         DIRST
  97         34
  98         BKJFN
  99         35
 100         RFPTR
 101         36
 102         CNDIR
 103         37
 104         RFBSZ
 105         38
 106         SFBSZ
 107         39
 108         SWJFN
 109         40
 110         BIN
 111         41
 112         BOUT
 113         42
 114         SIN-JSYS
 115         43
 116         SOUT
 117         44
 118         RIN
 119         45
 120         ROUT
 121         46
 122         PMAP
 123         47
 124         RPACS
 125         48
 126         SPACS
 127         49
 128         RMAP
 129         50
 130         SACTF
 131         51
 132         GTFDB
 133         52
 134         CHFDB
 135         53
 136         DUMPI
 137         54
 138         DUMPO
 139         55
 140         DELDF
 141         56
 142         ASND
 143         57
 144         RELD
 145         58
 146         CSYNO
 147         59
 148         PBIN
 149         60
 150         PBOUT
 151         62
 152         PSOUT
 153         63
 154         MTOPR
 155         64
 156         CFIBF
 157         65
 158         CFOBF
 159         66
 160         SIBE
 161         67
 162         SOBE
 163         68
 164         DOBE
 165         69
 166         GTABS
 167         70
 168         STABS
 169         71
 170         RFMOD
 171         72
 172         SFMOD
 173         73
 174         RFPOS
 175         74
 176         RFCOC
 177         75
 178         SFCOC
 179         76
 180         STI
 181         77
 182         DTACH
 183         78
 184         ATACH
 185         79
 186         DVCHR
 187         80
 188         STDEV
 189         81
 190         DEVST
 191         82
 192         MOUNT
 193         83
 194         DSMNT
 195         84
 196         INIDR
 197         85
 198         SIR
 199         86
 200         EIR
 201         87
 202         SKPIR
 203         88
 204         DIR
 205         89
 206         AIC
 207         90
 208         IIC
 209         91
 210         DIC
 211         92
 212         RCM
 213         93
 214         RWM
 215         94
 216         DEBRK
 217         95
 218         ATI
 219         96
 220         DTI
 221         97
 222         CIS
 223         98
 224         SIRCM
 225         99
 226         RIRCM
 227         100
 228         RIR
 229         101
 230         GDSTS
 231         102
 232         SDSTS
 233         103
 234         RESET-JSYS
 235         104
 236         RPCAP
 237         105
 238         EPCAP
 239         106
 240         CFORK
 241         107
 242         KFORK
 243         108
 244         FFORK
 245         109
 246         RFORK
 247         110
 248         RFSTS
 249         111
 250         SFORK
 251         112
 252         SFACS
 253         113
 254         RFACS
 255         114
 256         HFORK
 257         115
 258         WFORK
 259         116
 260         GFRKH
 261         117
 262         RFRKH
 263         118
 264         GFRKS
 265         119
 266         DISMS
 267         120
 268         HALTF
 269         121
 270         GTRPW
 271         122
 272         GTRPI
 273         123
 274         RTIW
 275         124
 276         STIW
 277         125
 278         SOBF
 279         126
 280         RWSET
 281         127
 282         GETNM
 283         128
 284         GET-JSYS
 285         129
 286         SFRKV
 287         130
 288         SAVE-JSYS
 289         131
 290         SSAVE
 291         132
 292         SEVEC
 293         133
 294         GEVEC
 295         134
 296         GPJFN
 297         135
 298         SPJFN
 299         136
 300         SETNM
 301         137
 302         FFUFP
 303         138
 304         DIBE
 305         139
 306         FDFRE
 307         140
 308         GDSKC
 309         141
 310         LITES
 311         142
 312         TLINK-JSYS
 313         143
 314         STPAR
 315         144
 316         ODTIM
 317         145
 318         IDTIM
 319         146
 320         ODCNV
 321         147
 322         IDCNV
 323         148
 324         NOUT
 325         149
 326         NIN
 327         150
 328         STAD
 329         151
 330         GTAD
 331         152
 332         ODTNC
 333         153
 334         INTNC
 335         154
 336         FLIN
 337         155
 338         FLOUT
 339         156
 340         DFIN
 341         157
 342         DFOUT
 343         160
 344         CRDIR
 345         161
 346         GTDIR
 347         162
 348         DSKOP
 349         163
 350         SPRIW
 351         164
 352         DSKAS
 353         165
 354         SJPRI
 355         176
 356         ASNDP
 357         177
 358         RELDP
 359         178
 360         ASNDC
 361         179
 362         RELDC
 363         180
 364         STRDP
 365         181
 366         STPDP
 367         182
 368         STSDP
 369         183
 370         RDSDP
 371         184
 372         WATDP
 373         186
 374         GTNCP
 375         187
 376         GTHST
 377         188
 378         ATNVT
 379         189
 380         CVSKT
 381         190
 382         CVHST
 383         191
 384         FLHST
 385         192
 386         GCVEC
 387         193
 388         SCVEC
 389         194
 390         SSTYP
 391         195
 392         GTTYP
 393         196
 394         BPT
 395         197
 396         GTDAL
 397         198
 398         WAIT
 399         199
 400         HSYS
 401         200
 402         USRIO
 403         201
 404         PEEK
 405         202
 406         MSFRK
 407         203
 408         ESOUT
 409         204
 410         SPLFK
 411         205
 412         ADVIZ
 413         206
 414         JOBTM
 415         207
 416         DELNF
 417         208
 418         SWTCH
 419         209
 420         TFORK
 421         210
 422         RTFRK
 423         211
 424         UTFRK
 425         212
 426         SCTTY
 427         222
 428         SETER                                         ;"NEW JSYS'S FOR TOPS-20"
 429         320
 430         RSCAN
 431         321
 432         HPTIM
 433         322
 434         CRLNM
 435         323
 436         INLNM
 437         324
 438         LNMST
 439         325
 440         RDTXT
 441         326
 442         SETSN
 443         327
 444         GETJI
 445         328
 446         MSEND
 447         329
 448         MRECV
 449         330
 450         MUTIL
 451         331
 452         ENQ
 453         332
 454         DEQ
 455         333
 456         ENQC
 457         334
 458         SNOOP
 459         335
 460         SPOOL
 461         336
 462         ALLOC
 463         337
 464         CHKAC
 465         338
 466         TIMER
 467         339
 468         RDTTY
 469         340
 470         TEXTI
 471         341
 472         UFPGS
 473         342
 474         SFPOS
 475         343
 476         SYERR
 477         344
 478         DIAG
 479         345
 480         SINR
 481         346
 482         SOUTR
 483         347
 484         RFTAD
 485         348
 486         SFTAD
 487         349
 488         TBDEL
 489         350
 490         TBADD
 491         351
 492         TBLUK
 493         352
 494         STCMP
 495         353
 496         SETJB
 497         354
 498         GDVEC
 499         355
 500         SDVEC
 501         356
 502         COMND
 503         357
 504         PRARG
 505         358
 506         GACCT
 507         359
 508         LPINI
 509         360
 510         GFUST
 511         361
 512         SFUST
 513         362
 514         ACCES
 515         363
 516         RCDIR
 517         364
 518         RCUSR
 519         365
 520         MSTR
 521         366
 522         STPPN
 523         367
 524         PPNST
 525         368
 526         PMCTL
 527         369
 528         LOCK
 529         370
 530         BOOT
 531         371
 532         UTEST
 533         372
 534         USAGE
 535         374
 536         VACCT
 537         375
 538         NODE
 539         376
 540         ADRBK
 541         *606* XGVEC
 542         408
 543         IIT
 544         412
 545         GTBLT
 546         413
 547         VTSOP
 548         414
 549         RTMOD
 550         415
 551         STMOD
 552         416
 553         RTCHR
 554         417
 555         STCHR
 556         488
 557         SNDIM
 558         489
 559         RCVIM
 560         490
 561         ASNSQ
 562         491
 563         RELSQ
 564         504
 565         THIBR
 566         505
 567         TWAKE
 568         506
 569         MRPAC
 570         507
 571         SETPV
 572         508
 573         MTALN
 574         509
 575         TTMSG
 576         *742*
 577         OPEN-JSYS
 578         *743*
 579         CLOSE-JSYS
 580         *740*
 581         SEND
 582         *741*
 583         RECV
 584         *745*
 585         STAT
 586         *746*
 587         CHANL
 588         *747*
 589         ABORT
 590         *744*
 591         SCSLV
 592         *767*
 593         SMAP
 594         *274*
 595         ATNVT]>
 596 <ENDBLOCK>
 597
 598 <DEFINE SETUP-JSY ()
 599         <REPEAT ((PNTR ,ALL-JSY) JSY) #DECL ((PNTR) <VECTOR [REST FIX ATOM]>)
 600                 <COND (<EMPTY? .PNTR> <RETURN>)>
 601                 <SET JSY <CHTYPE <+ ,BEAR-JSYS <1 .PNTR>> JSYS>>
 602                 <COND (<AND <GASSIGNED? <2 .PNTR>> <N==? ,<2 .PNTR> .JSY>>
 603                        <ERROR JSYS-ALREADY-ASSIGNED <1 .PNTR>>)>
 604                 <SETG <2 .PNTR> .JSY>
 605                 <SET PNTR <REST .PNTR 2>>>>
 606
 607 <COND (<GASSIGNED? SETUP-JSY> <SETUP-JSY>)>
 608
 609 <DEFINE SYSOP!-MIMOC (L "AUX" (MUNGED-REG 1) (DEST <>) THING DIR (LBL <>)
 610                                 TT (LL ()) JSFCN JSATM JSFORM JSNUM XL1 XL2)
 611         #DECL ((LL L) LIST)
 612         <COND (<EMPTY? .L> <MIMOCERR NO-JSYS-SUPPLIED!-ERRORS>)>
 613         <COND (<OR <AND <TYPE? <SET JSFORM <1 .L>> FORM>
 614                         <==? <LENGTH .JSFORM> 2>
 615                         <==? <1 .JSFORM> QUOTE>
 616                         <TYPE? <SET JSATM <2 .JSFORM>> ATOM>
 617                         <TYPE? <SET JSATM <LOOKUP <SPNAME .JSATM>
 618                                                   ,JSYS-OBLIST>>
 619                                ATOM>
 620                         <GASSIGNED? .JSATM>
 621                         <TYPE? <SET JSNUM ,.JSATM> JSYS>>
 622                    <AND <TYPE? <SET JSNUM .JSFORM> FIX JSYS>
 623                         <SET JSFORM <MEMQ <CHTYPE <ANDB .JSNUM *777777*> FIX>
 624                                            ,ALL-JSY>>
 625                         <SET JSATM <2 .JSFORM>>>
 626                    <TYPE? .JSNUM ATOM>>
 627                <COND (<SET JSFCN <AND <ASSIGNED? JSATM>
 628                                       <GETPROP .JSATM SPECIAL-JSYS-FUNCTION>>>
 629                       <APPLY .JSFCN .JSATM .L>)
 630                      (ELSE
 631                       <COND (<EMPTY? <SET L <REST .L>>>)
 632                             (<MEMQ <SET THING <1 .L>> '[= + -]>
 633                              <COND (<==? .THING =>
 634                                     <SET DEST <2 .L>>
 635                                     <SET L <REST .L 2>>)>
 636                              <COND (<NOT <EMPTY? .L>>
 637                                     <SET DIR <1 .L>>
 638                                     <SET LBL <2 .L>>)>)
 639                             (ELSE
 640                              <COND (<SET TT <MEMQ = .L>> <SET DEST <2 .TT>>)>
 641                              <COND (<SET TT <OR <MEMQ + .L> <MEMQ - .L>>>
 642                                     <SET DIR <1 .TT>>
 643                                     <SET LBL <2 .TT>>)>
 644                              <REPEAT ((ACL <REST <CHTYPE ,ACS VECTOR> 2>) AC)
 645                                      #DECL ((ACL) VECTOR (AC) ATOM)
 646                                      <COND (<MEMQ <SET THING <1 .L>>
 647                                                   '[+ -]>
 648                                             <RETURN>)
 649                                            (<==? .THING =>
 650                                             <SET DEST <2 .L>>
 651                                             <COND (<EMPTY? <SET L <REST .L 2>>>
 652                                                    <RETURN>)
 653                                                   (ELSE
 654                                                    <AGAIN>)>)>
 655                                      <COND (<AND <TYPE? .THING LIST>
 656                                                  <==? <LENGTH .THING> 2>
 657                                                  <==? <1 .THING> RETURN>>
 658                                             <SET MUNGED-REG <2 .THING>>)
 659                                            (ELSE
 660                                             <SET LL (.THING VALUE <1 .ACL>
 661                                                      !.LL)>
 662                                             <COND
 663                                              (<AND <TYPE? .THING ATOM>
 664                                                    <OR <==? .THING .DEST>
 665                                                        <AND <WILL-DIE? .THING>
 666                                                             <OR <NOT .LBL>
 667                                                                 <WILL-DIE?
 668                                                                  .THING
 669                                                                  <LAB-CODE-PNTR
 670                                                                   <FIND-LABEL
 671                                                                    .LBL>>>>>>>
 672                                                    <DEAD!-MIMOC (.THING) T>)>
 673                                             <SET ACL <REST .ACL 2>>)>
 674                                      <COND (<EMPTY? <SET L <REST .L>>>
 675                                             <RETURN>)>>)>
 676                       <UPDATE-ACS>
 677                       <GET-INTO-ACS !.LL>
 678                       <FLUSH-ACS>
 679                       <COND (<AND .LBL <==? .DIR ->>
 680                              <LABEL-UPDATE-ACS .LBL <>>)>
 681                       <COND (<TYPE? .JSNUM ATOM>
 682                              <SMASH-AC O* .JSNUM VALUE>
 683                              <OCEMIT XCT O* O*>)
 684                             (ELSE
 685                              <OCEMIT .JSATM O* O*>)>
 686                       <COND (<AND .LBL <==? .DIR ->>
 687                              <OCEMIT JUMP TP* <XJUMP .LBL>>
 688                              <RESULT-JSYS .MUNGED-REG .DEST>)
 689                             (<AND .LBL <==? .DIR +>>
 690                              <OCEMIT JUMP TP* <XJUMP <SET XL1 <GENLBL "JS">>>>
 691                              <RESULT-JSYS .MUNGED-REG .DEST>
 692                              <LABEL-UPDATE-ACS .LBL <>>
 693                              <OCEMIT JRST <XJUMP .LBL>>
 694                              <LABEL .XL1>)
 695                             (<NOT .DEST>
 696                              <OCEMIT JUMP P* <XJUMP IOERR>>
 697                              <COND (<==? .MUNGED-REG ALL>
 698                                     <RESULT-JSYS ALL <>>)>)
 699                             (ELSE
 700                              <COND (<OR <==? .JSNUM ,SIBE!-JSYS>
 701                                         <==? .JSNUM ,SOBE!-JSYS>>
 702                                     <OCEMIT CAIA O* O*>
 703                                     <OCEMIT JUMPN A2*
 704                                             <XJUMP <SET XL1 <GENLBL "JS">>>>)
 705                                    (ELSE
 706                                     <OCEMIT JUMP TP*
 707                                             <XJUMP <SET XL1 <GENLBL "JS">>>>)>
 708                              <RESULT-JSYS .MUNGED-REG .DEST>
 709                              <OCEMIT JRST <XJUMP <SET XL2 <GENLBL "JS">>>>
 710                              <LABEL .XL1>
 711                              <OCEMIT MOVEI A1* *400000*>
 712                              <OCEMIT GETER O* O*>
 713                              <OCEMIT HRRZ B2* A2*>
 714                              <OCEMIT MOVSI B1* <TYPE-CODE FIX>>
 715                              <OCEMIT MOVEI C1* 0>
 716                              <PUSHJ CONS .DEST <> FALSE>
 717                              <LABEL .XL2>)>)>)
 718               (<ERROR CANT-COMPILE-SYSOP .L>)>>
 719
 720 <DEFINE RESULT-JSYS (MUNGED-REG DEST)
 721         <COND (<==? .MUNGED-REG ALL>
 722                <SMASH-AC T* <CHTYPE <PARSE "AC-VECTOR"> XGLOC> VALUE>
 723                <OCEMIT MOVE T* 1 '(T*)>
 724                <MUNGED-AC T*>
 725                <REPEAT ((I 0)) #DECL ((I) FIX)
 726                        <COND (<G? <SET I <+ .I 1>> ,MAX-ACS> <RETURN>)>
 727                        <OCEMIT MOVEM <NTH ,ACS <+ <* .I 2> 1>> <- .I 1> '(T*)>>
 728                <COND (.DEST
 729                       <OCEMIT DMOVE A1* @
 730                               !<OBJ-VAL <CHTYPE <PARSE "AC-VECTOR"> XGLOC>>>
 731                       <PUSHJ-VAL .DEST>)>)
 732               (.DEST
 733                <COND (<N==? .MUNGED-REG 2>
 734                       <OCEMIT MOVE A2* .MUNGED-REG>)>
 735                <OCEMIT MOVSI A1* <TYPE-CODE FIX>>
 736                <PUSHJ-VAL .DEST>)>>
 737
 738 <DEFINE SIN-SOUT (JS L "AUX" (DEST <>) ECHAR JFN)
 739         #DECL ((L) LIST)
 740         <COND (<MEMQ = .L>
 741                <COND (<==? <LENGTH .L> 7> <SET DEST <7 .L>> <SET ECHAR <5 .L>>)
 742                      (<==? <LENGTH .L> 6> <SET DEST <6 .L>>)
 743                      (ELSE <MIMOCERR BAD-SIN-SOUT-CALL!-ERRORS>)>)
 744               (<==? <LENGTH .L> 5> <SET ECHAR <5 .L>>)
 745               (<N==? <LENGTH .L> 4> <MIMOCERR BAD-SIN-SOUT-CALL!-ERRORS>)>
 746         <UPDATE-ACS>
 747         <COND (<AND <TYPE? <SET JFN <2 .L>> FIX> <L? .JFN ,MAX-IMMEDIATE>>
 748                <MUNGED-AC A1*>
 749                <OCEMIT MOVEI A1* .JFN>)
 750               (ELSE <SMASH-AC A1* .JFN VALUE>)>
 751         <SMASH-AC O* <3 .L> TYPE>
 752         <SMASH-AC A2* <3 .L> VALUE>
 753         <COND (<AND <TYPE? <SET JFN <4 .L>> FIX> <L? .JFN ,MAX-IMMEDIATE>>
 754                <MUNGED-AC B1*>
 755                <OCEMIT MOVEI B1* .JFN>)
 756               (ELSE <SMASH-AC B1* .JFN VALUE>)>
 757         <COND (<ASSIGNED? ECHAR>
 758                <COND (<AND <==? <PRIMTYPE .ECHAR> WORD>
 759                            <L? <SET ECHAR <CHTYPE .ECHAR FIX>> ,MAX-IMMEDIATE>>
 760                       <MUNGED-AC B2*>
 761                       <OCEMIT MOVEI B2* .ECHAR>)
 762                      (ELSE <SMASH-AC B2* .ECHAR VALUE>)>)>
 763         <PUSHJ .JS .DEST>>
 764
 765 <SETG GJ-SHORT 262144>
 766
 767 <SETG GJ-FNS 524288>
 768
 769 <DEFINE GTJFN-S-DO (JS L "AUX" (FLAGS <2 .L>) (SOURCE <3 .L>) (DEST <5 .L>))
 770         #DECL ((L) LIST)
 771         <UPDATE-ACS>
 772         <COND (<TYPE? .FLAGS FIX WORD>
 773                <SET FLAGS <ORB .FLAGS ,GJ-SHORT <COND (<==? .JS GTJFN-S-J>
 774                                                        ,GJ-FNS)(ELSE 0)>>>
 775                <MUNGED-AC A1*>
 776                <COND (<0? <CHTYPE <ANDB .FLAGS *777777*> FIX>>
 777                       <OCEMIT MOVSI A1* <CHTYPE <LSH .FLAGS -18> FIX>>)
 778                      (ELSE
 779                       <OCEMIT MOVE A1* !<OBJ-VAL .FLAGS>>)>)
 780               (ELSE
 781                <SMASH-AC A1* .FLAGS VALUE>
 782                <OCEMIT TLO A1* <CHTYPE <ORB <LSH ,GJ-SHORT -18>
 783                                             <LSH <COND (<==? .JS GTJFN-S-J>
 784                                                         ,GJ-FNS)(ELSE 0)>
 785                                                  -18>>
 786                                        FIX>>)>
 787         <COND (<==? .JS GTJFN-S-J>
 788                <COND (<AND <TYPE? .SOURCE FIX WORD>
 789                            <L? <CHTYPE .SOURCE FIX> *777777*>>
 790                       <MUNGED-AC A2*>
 791                       <OCEMIT MOVEI A2* .SOURCE>)
 792                      (ELSE
 793                       <SMASH-AC A2* .SOURCE VALUE>)>)
 794               (ELSE
 795                <SMASH-AC A2* <3 .L> VALUE>
 796                <MUNGED-AC B1*>
 797                <OCEMIT HRRZ B1* !<OBJ-TYP <3 .L>>>)>
 798         <PUSHJ GTJFN .DEST>>
 799
 800 <DEFINE GTJFN-L-DO (JS L "AUX" (LN <LENGTH .L>))
 801         #DECL ((L) LIST (LN) FIX)
 802         <UPDATE-ACS>
 803         <COND (<N==? <NTH .L <- .LN 1>> =>
 804                <MIMOCERR NO-PLACE-TO-RETURN!-ERRORS GTJFN>)>
 805         <MAPF <>
 806               <FUNCTION (ARG)
 807                    <COND (<==? .ARG => <MAPLEAVE>)>
 808                    <OCEMIT PUSH TP* !<OBJ-TYP .ARG>>
 809                    <COND (,WINNING-VICTIM
 810                           <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
 811                    <OCEMIT PUSH TP* !<OBJ-VAL .ARG>>
 812                    <COND (,WINNING-VICTIM
 813                           <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>>
 814               <REST .L>>
 815         <OCEMIT MOVEI O1* <- .LN 3>>
 816         <PUSHJ GTJFNL <NTH .L .LN>>>
 817
 818 <DEFINE JFNS-DO (JS L "AUX" (DEST <>) ARG1 ARG2 ARG3 ARG4)
 819         #DECL ((L) LIST)
 820         <COND (<MEMQ = .L>
 821                <COND (<==? <LENGTH .L> 7> <SET DEST <7 .L>>)
 822                      (ELSE <MIMOCERR BAD-JFNS-CALL!-ERRORS>)>)
 823               (<N==? <LENGTH .L> 5> <MIMOCERR BAD-JFNS-CALL!-ERRORS>)>
 824         <COND (<OR <==? <SET ARG1 <2 .L>> .DEST>
 825                    <AND <TYPE? .ARG1 ATOM> <WILL-DIE? .ARG1>>>
 826                <DEAD!-MIMOC (.ARG1) T>)>
 827         <COND (<OR <==? <SET ARG2 <3 .L>> .DEST>
 828                    <AND <TYPE? .ARG2 ATOM> <WILL-DIE? .ARG2>>>
 829                <DEAD!-MIMOC (.ARG2) T>)>
 830         <COND (<OR <==? <SET ARG3 <4 .L>> .DEST>
 831                    <AND <TYPE? .ARG3 ATOM> <WILL-DIE? .ARG3>>>
 832                <DEAD!-MIMOC (.ARG3) T>)>
 833         <COND (<OR <==? <SET ARG4 <5 .L>> .DEST>
 834                    <AND <TYPE? .ARG4 ATOM> <WILL-DIE? .ARG4>>>
 835                <DEAD!-MIMOC (.ARG4) T>)>
 836         <UPDATE-ACS>
 837         <GET-INTO-ACS .ARG1 VALUE A1* .ARG2 VALUE A2* .ARG3 VALUE B1*
 838                       .ARG4 VALUE B2*>
 839         <OCEMIT HRRZ C1* !<OBJ-TYP .ARG1>>
 840         <PUSHJ JFNS .DEST>>
 841
 842 <DEFINE RFTAD-DO (JS L "AUX" (DEST <>) ARG1 ARG2 ARG3 TL)
 843   #DECL ((L) LIST)
 844   <COND (<SET TL <MEMQ = .L>>
 845          <SET DEST <2 .TL>>)>
 846   <UPDATE-ACS>
 847   <MUNGED-AC A1*>
 848   <SMASH-AC A1* <2 .L> VALUE>
 849   <MUNGED-AC A2*>
 850   <SMASH-AC A2* <3 .L> VALUE>
 851   <MUNGED-AC B1*>
 852   <SMASH-AC B1* <4 .L> VALUE>
 853   <PUSHJ RFTAD .DEST>>
 854
 855 <DEFINE ERSTR-DO (JS L "AUX" (DEST <>) ARG1 ARG2 ARG3)
 856         #DECL ((L) LIST)
 857         <COND (<MEMQ = .L>
 858                <COND (<==? <LENGTH .L> 6> <SET DEST <6 .L>>)
 859                      (ELSE <MIMOCERR BAD-ERSTR-CALL!-ERRORS>)>)
 860               (<N==? <LENGTH .L> 4> <MIMOCERR BAD-ERSTR-CALL!-ERRORS>)>
 861         <COND (<OR <==? <SET ARG1 <2 .L>> .DEST>
 862                    <AND <TYPE? .ARG1 ATOM> <WILL-DIE? .ARG1>>>
 863                <DEAD!-MIMOC (.ARG1) T>)>
 864         <COND (<OR <==? <SET ARG2 <3 .L>> .DEST>
 865                    <AND <TYPE? .ARG2 ATOM> <WILL-DIE? .ARG2>>>
 866                <DEAD!-MIMOC (.ARG2) T>)>
 867         <COND (<OR <==? <SET ARG3 <4 .L>> .DEST>
 868                    <AND <TYPE? .ARG3 ATOM> <WILL-DIE? .ARG3>>>
 869                <DEAD!-MIMOC (.ARG3) T>)>
 870         <UPDATE-ACS>
 871         <GET-INTO-ACS .ARG1 VALUE A1* .ARG2 VALUE A2* .ARG3 VALUE B1*>
 872         <PUSHJ ERSTR .DEST>>
 873
 874 <DEFINE LOAD-ARG (V AC)
 875         <COND (<AND <TYPE? .V FIX WORD>
 876                     <L? <SET V <CHTYPE .V FIX>> *777777*>>
 877                <MUNGED-AC .AC>
 878                <OCEMIT MOVEI .AC .V>)
 879               (ELSE
 880                <SMASH-AC .AC .V VALUE>)>>
 881
 882 <PUTPROP SIN-JSYS!-JSYS SPECIAL-JSYS-FUNCTION ,SIN-SOUT>
 883
 884 <PUTPROP SOUT!-JSYS SPECIAL-JSYS-FUNCTION ,SIN-SOUT>
 885
 886 <PUTPROP GTJFN-S-S!-JSYS SPECIAL-JSYS-FUNCTION ,GTJFN-S-DO>
 887
 888 <PUTPROP GTJFN-S-J!-JSYS SPECIAL-JSYS-FUNCTION ,GTJFN-S-DO>
 889
 890 <PUTPROP JFNS!-JSYS SPECIAL-JSYS-FUNCTION ,JFNS-DO>
 891
 892 <PUTPROP ERSTR!-JSYS SPECIAL-JSYS-FUNCTION ,ERSTR-DO>
 893
 894 <PUTPROP GTJFN-L!-JSYS SPECIAL-JSYS-FUNCTION ,GTJFN-L-DO>
 895
 896 <COND (<GASSIGNED? RFTAD-DO>
 897        <PUTPROP RFTAD!-JSYS SPECIAL-JSYS-FUNCTION ,RFTAD-DO>)>