--- /dev/null
+
+<NEWTYPE XGLOC ATOM>
+
+<NEWTYPE JSYS WORD>
+
+<SETG DOJSYS 504>
+
+<SETG HBPS 506>
+
+<SETG MAX-ACS 5>
+
+<SETG MAX-ACS-1 4>
+
+<SETG BEAR-JSYS 9126805504>
+
+<GDECL (MAX-IMMEDIATE) FIX>
+
+<MANIFEST BEAR-JSYS>
+
+<BLOCK (<ROOT>)>
+ALL-JSY
+<ENDBLOCK>
+<BLOCK (<SETG JSYS-OBLIST <MOBLIST JSYS>> <ROOT>)>
+<SETG ALL-JSY
+ '[0
+ JSYS
+ 1
+ LOGIN
+ 2
+ CRJOB
+ 3
+ LGOUT
+ 4
+ CACCT
+ 5
+ EFACT
+ 6
+ SMON
+ 7
+ TMON
+ 8
+ GETAB
+ 9
+ ERSTR
+ 10
+ GETER
+ 11
+ GJINF
+ 12
+ TIME-JSYS
+ 13
+ RUNTM
+ 14
+ SYSGT
+ 15
+ GNJFN
+ 16
+ GTJFN-S-S
+ 16
+ GTJFN-S-J
+ 16
+ GTJFN-L
+ 17
+ OPENF
+ 18
+ CLOSF
+ 19
+ RLJFN
+ 20
+ GTSTS
+ 21
+ STSTS
+ 22
+ DELF
+ 23
+ SFPTR
+ 24
+ JFNS
+ 25
+ FFFFP
+ 26
+ RDDIR
+ 27
+ CPRTF
+ 28
+ CLZFF
+ 29
+ RNAMF
+ 30
+ SIZEF
+ 31
+ GACTF
+ 32
+ STDIR
+ 33
+ DIRST
+ 34
+ BKJFN
+ 35
+ RFPTR
+ 36
+ CNDIR
+ 37
+ RFBSZ
+ 38
+ SFBSZ
+ 39
+ SWJFN
+ 40
+ BIN
+ 41
+ BOUT
+ 42
+ SIN-JSYS
+ 43
+ SOUT
+ 44
+ RIN
+ 45
+ ROUT
+ 46
+ PMAP
+ 47
+ RPACS
+ 48
+ SPACS
+ 49
+ RMAP
+ 50
+ SACTF
+ 51
+ GTFDB
+ 52
+ CHFDB
+ 53
+ DUMPI
+ 54
+ DUMPO
+ 55
+ DELDF
+ 56
+ ASND
+ 57
+ RELD
+ 58
+ CSYNO
+ 59
+ PBIN
+ 60
+ PBOUT
+ 62
+ PSOUT
+ 63
+ MTOPR
+ 64
+ CFIBF
+ 65
+ CFOBF
+ 66
+ SIBE
+ 67
+ SOBE
+ 68
+ DOBE
+ 69
+ GTABS
+ 70
+ STABS
+ 71
+ RFMOD
+ 72
+ SFMOD
+ 73
+ RFPOS
+ 74
+ RFCOC
+ 75
+ SFCOC
+ 76
+ STI
+ 77
+ DTACH
+ 78
+ ATACH
+ 79
+ DVCHR
+ 80
+ STDEV
+ 81
+ DEVST
+ 82
+ MOUNT
+ 83
+ DSMNT
+ 84
+ INIDR
+ 85
+ SIR
+ 86
+ EIR
+ 87
+ SKPIR
+ 88
+ DIR
+ 89
+ AIC
+ 90
+ IIC
+ 91
+ DIC
+ 92
+ RCM
+ 93
+ RWM
+ 94
+ DEBRK
+ 95
+ ATI
+ 96
+ DTI
+ 97
+ CIS
+ 98
+ SIRCM
+ 99
+ RIRCM
+ 100
+ RIR
+ 101
+ GDSTS
+ 102
+ SDSTS
+ 103
+ RESET-JSYS
+ 104
+ RPCAP
+ 105
+ EPCAP
+ 106
+ CFORK
+ 107
+ KFORK
+ 108
+ FFORK
+ 109
+ RFORK
+ 110
+ RFSTS
+ 111
+ SFORK
+ 112
+ SFACS
+ 113
+ RFACS
+ 114
+ HFORK
+ 115
+ WFORK
+ 116
+ GFRKH
+ 117
+ RFRKH
+ 118
+ GFRKS
+ 119
+ DISMS
+ 120
+ HALTF
+ 121
+ GTRPW
+ 122
+ GTRPI
+ 123
+ RTIW
+ 124
+ STIW
+ 125
+ SOBF
+ 126
+ RWSET
+ 127
+ GETNM
+ 128
+ GET-JSYS
+ 129
+ SFRKV
+ 130
+ SAVE-JSYS
+ 131
+ SSAVE
+ 132
+ SEVEC
+ 133
+ GEVEC
+ 134
+ GPJFN
+ 135
+ SPJFN
+ 136
+ SETNM
+ 137
+ FFUFP
+ 138
+ DIBE
+ 139
+ FDFRE
+ 140
+ GDSKC
+ 141
+ LITES
+ 142
+ TLINK-JSYS
+ 143
+ STPAR
+ 144
+ ODTIM
+ 145
+ IDTIM
+ 146
+ ODCNV
+ 147
+ IDCNV
+ 148
+ NOUT
+ 149
+ NIN
+ 150
+ STAD
+ 151
+ GTAD
+ 152
+ ODTNC
+ 153
+ INTNC
+ 154
+ FLIN
+ 155
+ FLOUT
+ 156
+ DFIN
+ 157
+ DFOUT
+ 160
+ CRDIR
+ 161
+ GTDIR
+ 162
+ DSKOP
+ 163
+ SPRIW
+ 164
+ DSKAS
+ 165
+ SJPRI
+ 176
+ ASNDP
+ 177
+ RELDP
+ 178
+ ASNDC
+ 179
+ RELDC
+ 180
+ STRDP
+ 181
+ STPDP
+ 182
+ STSDP
+ 183
+ RDSDP
+ 184
+ WATDP
+ 186
+ GTNCP
+ 187
+ GTHST
+ 188
+ ATNVT
+ 189
+ CVSKT
+ 190
+ CVHST
+ 191
+ FLHST
+ 192
+ GCVEC
+ 193
+ SCVEC
+ 194
+ SSTYP
+ 195
+ GTTYP
+ 196
+ BPT
+ 197
+ GTDAL
+ 198
+ WAIT
+ 199
+ HSYS
+ 200
+ USRIO
+ 201
+ PEEK
+ 202
+ MSFRK
+ 203
+ ESOUT
+ 204
+ SPLFK
+ 205
+ ADVIZ
+ 206
+ JOBTM
+ 207
+ DELNF
+ 208
+ SWTCH
+ 209
+ TFORK
+ 210
+ RTFRK
+ 211
+ UTFRK
+ 212
+ SCTTY
+ 222
+ SETER ;"NEW JSYS'S FOR TOPS-20"
+ 320
+ RSCAN
+ 321
+ HPTIM
+ 322
+ CRLNM
+ 323
+ INLNM
+ 324
+ LNMST
+ 325
+ RDTXT
+ 326
+ SETSN
+ 327
+ GETJI
+ 328
+ MSEND
+ 329
+ MRECV
+ 330
+ MUTIL
+ 331
+ ENQ
+ 332
+ DEQ
+ 333
+ ENQC
+ 334
+ SNOOP
+ 335
+ SPOOL
+ 336
+ ALLOC
+ 337
+ CHKAC
+ 338
+ TIMER
+ 339
+ RDTTY
+ 340
+ TEXTI
+ 341
+ UFPGS
+ 342
+ SFPOS
+ 343
+ SYERR
+ 344
+ DIAG
+ 345
+ SINR
+ 346
+ SOUTR
+ 347
+ RFTAD
+ 348
+ SFTAD
+ 349
+ TBDEL
+ 350
+ TBADD
+ 351
+ TBLUK
+ 352
+ STCMP
+ 353
+ SETJB
+ 354
+ GDVEC
+ 355
+ SDVEC
+ 356
+ COMND
+ 357
+ PRARG
+ 358
+ GACCT
+ 359
+ LPINI
+ 360
+ GFUST
+ 361
+ SFUST
+ 362
+ ACCES
+ 363
+ RCDIR
+ 364
+ RCUSR
+ 365
+ MSTR
+ 366
+ STPPN
+ 367
+ PPNST
+ 368
+ PMCTL
+ 369
+ LOCK
+ 370
+ BOOT
+ 371
+ UTEST
+ 372
+ USAGE
+ 374
+ VACCT
+ 375
+ NODE
+ 376
+ ADRBK
+ *606* XGVEC
+ 408
+ IIT
+ 412
+ GTBLT
+ 413
+ VTSOP
+ 414
+ RTMOD
+ 415
+ STMOD
+ 416
+ RTCHR
+ 417
+ STCHR
+ 488
+ SNDIM
+ 489
+ RCVIM
+ 490
+ ASNSQ
+ 491
+ RELSQ
+ 504
+ THIBR
+ 505
+ TWAKE
+ 506
+ MRPAC
+ 507
+ SETPV
+ 508
+ MTALN
+ 509
+ TTMSG
+ *742*
+ OPEN-JSYS
+ *743*
+ CLOSE-JSYS
+ *740*
+ SEND
+ *741*
+ RECV
+ *745*
+ STAT
+ *746*
+ CHANL
+ *747*
+ ABORT
+ *744*
+ SCSLV
+ *767*
+ SMAP
+ *274*
+ ATNVT]>
+<ENDBLOCK>
+
+<DEFINE SETUP-JSY ()
+ <REPEAT ((PNTR ,ALL-JSY) JSY) #DECL ((PNTR) <VECTOR [REST FIX ATOM]>)
+ <COND (<EMPTY? .PNTR> <RETURN>)>
+ <SET JSY <CHTYPE <+ ,BEAR-JSYS <1 .PNTR>> JSYS>>
+ <COND (<AND <GASSIGNED? <2 .PNTR>> <N==? ,<2 .PNTR> .JSY>>
+ <ERROR JSYS-ALREADY-ASSIGNED <1 .PNTR>>)>
+ <SETG <2 .PNTR> .JSY>
+ <SET PNTR <REST .PNTR 2>>>>
+
+<COND (<GASSIGNED? SETUP-JSY> <SETUP-JSY>)>
+
+<DEFINE SYSOP!-MIMOC (L "AUX" (MUNGED-REG 1) (DEST <>) THING DIR (LBL <>)
+ TT (LL ()) JSFCN JSATM JSFORM JSNUM XL1 XL2)
+ #DECL ((LL L) LIST)
+ <COND (<EMPTY? .L> <MIMOCERR NO-JSYS-SUPPLIED!-ERRORS>)>
+ <COND (<OR <AND <TYPE? <SET JSFORM <1 .L>> FORM>
+ <==? <LENGTH .JSFORM> 2>
+ <==? <1 .JSFORM> QUOTE>
+ <TYPE? <SET JSATM <2 .JSFORM>> ATOM>
+ <TYPE? <SET JSATM <LOOKUP <SPNAME .JSATM>
+ ,JSYS-OBLIST>>
+ ATOM>
+ <GASSIGNED? .JSATM>
+ <TYPE? <SET JSNUM ,.JSATM> JSYS>>
+ <AND <TYPE? <SET JSNUM .JSFORM> FIX JSYS>
+ <SET JSFORM <MEMQ <CHTYPE <ANDB .JSNUM *777777*> FIX>
+ ,ALL-JSY>>
+ <SET JSATM <2 .JSFORM>>>
+ <TYPE? .JSNUM ATOM>>
+ <COND (<SET JSFCN <AND <ASSIGNED? JSATM>
+ <GETPROP .JSATM SPECIAL-JSYS-FUNCTION>>>
+ <APPLY .JSFCN .JSATM .L>)
+ (ELSE
+ <COND (<EMPTY? <SET L <REST .L>>>)
+ (<MEMQ <SET THING <1 .L>> '[= + -]>
+ <COND (<==? .THING =>
+ <SET DEST <2 .L>>
+ <SET L <REST .L 2>>)>
+ <COND (<NOT <EMPTY? .L>>
+ <SET DIR <1 .L>>
+ <SET LBL <2 .L>>)>)
+ (ELSE
+ <COND (<SET TT <MEMQ = .L>> <SET DEST <2 .TT>>)>
+ <COND (<SET TT <OR <MEMQ + .L> <MEMQ - .L>>>
+ <SET DIR <1 .TT>>
+ <SET LBL <2 .TT>>)>
+ <REPEAT ((ACL <REST <CHTYPE ,ACS VECTOR> 2>) AC)
+ #DECL ((ACL) VECTOR (AC) ATOM)
+ <COND (<MEMQ <SET THING <1 .L>>
+ '[+ -]>
+ <RETURN>)
+ (<==? .THING =>
+ <SET DEST <2 .L>>
+ <COND (<EMPTY? <SET L <REST .L 2>>>
+ <RETURN>)
+ (ELSE
+ <AGAIN>)>)>
+ <COND (<AND <TYPE? .THING LIST>
+ <==? <LENGTH .THING> 2>
+ <==? <1 .THING> RETURN>>
+ <SET MUNGED-REG <2 .THING>>)
+ (ELSE
+ <SET LL (.THING VALUE <1 .ACL>
+ !.LL)>
+ <COND
+ (<AND <TYPE? .THING ATOM>
+ <OR <==? .THING .DEST>
+ <AND <WILL-DIE? .THING>
+ <OR <NOT .LBL>
+ <WILL-DIE?
+ .THING
+ <LAB-CODE-PNTR
+ <FIND-LABEL
+ .LBL>>>>>>>
+ <DEAD!-MIMOC (.THING) T>)>
+ <SET ACL <REST .ACL 2>>)>
+ <COND (<EMPTY? <SET L <REST .L>>>
+ <RETURN>)>>)>
+ <UPDATE-ACS>
+ <GET-INTO-ACS !.LL>
+ <FLUSH-ACS>
+ <COND (<AND .LBL <==? .DIR ->>
+ <LABEL-UPDATE-ACS .LBL <>>)>
+ <COND (<TYPE? .JSNUM ATOM>
+ <SMASH-AC O* .JSNUM VALUE>
+ <OCEMIT XCT O* O*>)
+ (ELSE
+ <OCEMIT .JSATM O* O*>)>
+ <COND (<AND .LBL <==? .DIR ->>
+ <OCEMIT JUMP TP* <XJUMP .LBL>>
+ <RESULT-JSYS .MUNGED-REG .DEST>)
+ (<AND .LBL <==? .DIR +>>
+ <OCEMIT JUMP TP* <XJUMP <SET XL1 <GENLBL "JS">>>>
+ <RESULT-JSYS .MUNGED-REG .DEST>
+ <LABEL-UPDATE-ACS .LBL <>>
+ <OCEMIT JRST <XJUMP .LBL>>
+ <LABEL .XL1>)
+ (<NOT .DEST>
+ <OCEMIT JUMP P* <XJUMP IOERR>>
+ <COND (<==? .MUNGED-REG ALL>
+ <RESULT-JSYS ALL <>>)>)
+ (ELSE
+ <COND (<OR <==? .JSNUM ,SIBE!-JSYS>
+ <==? .JSNUM ,SOBE!-JSYS>>
+ <OCEMIT CAIA O* O*>
+ <OCEMIT JUMPN A2*
+ <XJUMP <SET XL1 <GENLBL "JS">>>>)
+ (ELSE
+ <OCEMIT JUMP TP*
+ <XJUMP <SET XL1 <GENLBL "JS">>>>)>
+ <RESULT-JSYS .MUNGED-REG .DEST>
+ <OCEMIT JRST <XJUMP <SET XL2 <GENLBL "JS">>>>
+ <LABEL .XL1>
+ <OCEMIT MOVEI A1* *400000*>
+ <OCEMIT GETER O* O*>
+ <OCEMIT HRRZ B2* A2*>
+ <OCEMIT MOVSI B1* <TYPE-CODE FIX>>
+ <OCEMIT MOVEI C1* 0>
+ <PUSHJ CONS .DEST <> FALSE>
+ <LABEL .XL2>)>)>)
+ (<ERROR CANT-COMPILE-SYSOP .L>)>>
+
+<DEFINE RESULT-JSYS (MUNGED-REG DEST)
+ <COND (<==? .MUNGED-REG ALL>
+ <SMASH-AC T* <CHTYPE <PARSE "AC-VECTOR"> XGLOC> VALUE>
+ <OCEMIT MOVE T* 1 '(T*)>
+ <MUNGED-AC T*>
+ <REPEAT ((I 0)) #DECL ((I) FIX)
+ <COND (<G? <SET I <+ .I 1>> ,MAX-ACS> <RETURN>)>
+ <OCEMIT MOVEM <NTH ,ACS <+ <* .I 2> 1>> <- .I 1> '(T*)>>
+ <COND (.DEST
+ <OCEMIT DMOVE A1* @
+ !<OBJ-VAL <CHTYPE <PARSE "AC-VECTOR"> XGLOC>>>
+ <PUSHJ-VAL .DEST>)>)
+ (.DEST
+ <COND (<N==? .MUNGED-REG 2>
+ <OCEMIT MOVE A2* .MUNGED-REG>)>
+ <OCEMIT MOVSI A1* <TYPE-CODE FIX>>
+ <PUSHJ-VAL .DEST>)>>
+
+<DEFINE SIN-SOUT (JS L "AUX" (DEST <>) ECHAR JFN)
+ #DECL ((L) LIST)
+ <COND (<MEMQ = .L>
+ <COND (<==? <LENGTH .L> 7> <SET DEST <7 .L>> <SET ECHAR <5 .L>>)
+ (<==? <LENGTH .L> 6> <SET DEST <6 .L>>)
+ (ELSE <MIMOCERR BAD-SIN-SOUT-CALL!-ERRORS>)>)
+ (<==? <LENGTH .L> 5> <SET ECHAR <5 .L>>)
+ (<N==? <LENGTH .L> 4> <MIMOCERR BAD-SIN-SOUT-CALL!-ERRORS>)>
+ <UPDATE-ACS>
+ <COND (<AND <TYPE? <SET JFN <2 .L>> FIX> <L? .JFN ,MAX-IMMEDIATE>>
+ <MUNGED-AC A1*>
+ <OCEMIT MOVEI A1* .JFN>)
+ (ELSE <SMASH-AC A1* .JFN VALUE>)>
+ <SMASH-AC O* <3 .L> TYPE>
+ <SMASH-AC A2* <3 .L> VALUE>
+ <COND (<AND <TYPE? <SET JFN <4 .L>> FIX> <L? .JFN ,MAX-IMMEDIATE>>
+ <MUNGED-AC B1*>
+ <OCEMIT MOVEI B1* .JFN>)
+ (ELSE <SMASH-AC B1* .JFN VALUE>)>
+ <COND (<ASSIGNED? ECHAR>
+ <COND (<AND <==? <PRIMTYPE .ECHAR> WORD>
+ <L? <SET ECHAR <CHTYPE .ECHAR FIX>> ,MAX-IMMEDIATE>>
+ <MUNGED-AC B2*>
+ <OCEMIT MOVEI B2* .ECHAR>)
+ (ELSE <SMASH-AC B2* .ECHAR VALUE>)>)>
+ <PUSHJ .JS .DEST>>
+
+<SETG GJ-SHORT 262144>
+
+<SETG GJ-FNS 524288>
+
+<DEFINE GTJFN-S-DO (JS L "AUX" (FLAGS <2 .L>) (SOURCE <3 .L>) (DEST <5 .L>))
+ #DECL ((L) LIST)
+ <UPDATE-ACS>
+ <COND (<TYPE? .FLAGS FIX WORD>
+ <SET FLAGS <ORB .FLAGS ,GJ-SHORT <COND (<==? .JS GTJFN-S-J>
+ ,GJ-FNS)(ELSE 0)>>>
+ <MUNGED-AC A1*>
+ <COND (<0? <CHTYPE <ANDB .FLAGS *777777*> FIX>>
+ <OCEMIT MOVSI A1* <CHTYPE <LSH .FLAGS -18> FIX>>)
+ (ELSE
+ <OCEMIT MOVE A1* !<OBJ-VAL .FLAGS>>)>)
+ (ELSE
+ <SMASH-AC A1* .FLAGS VALUE>
+ <OCEMIT TLO A1* <CHTYPE <ORB <LSH ,GJ-SHORT -18>
+ <LSH <COND (<==? .JS GTJFN-S-J>
+ ,GJ-FNS)(ELSE 0)>
+ -18>>
+ FIX>>)>
+ <COND (<==? .JS GTJFN-S-J>
+ <COND (<AND <TYPE? .SOURCE FIX WORD>
+ <L? <CHTYPE .SOURCE FIX> *777777*>>
+ <MUNGED-AC A2*>
+ <OCEMIT MOVEI A2* .SOURCE>)
+ (ELSE
+ <SMASH-AC A2* .SOURCE VALUE>)>)
+ (ELSE
+ <SMASH-AC A2* <3 .L> VALUE>
+ <MUNGED-AC B1*>
+ <OCEMIT HRRZ B1* !<OBJ-TYP <3 .L>>>)>
+ <PUSHJ GTJFN .DEST>>
+
+<DEFINE GTJFN-L-DO (JS L "AUX" (LN <LENGTH .L>))
+ #DECL ((L) LIST (LN) FIX)
+ <UPDATE-ACS>
+ <COND (<N==? <NTH .L <- .LN 1>> =>
+ <MIMOCERR NO-PLACE-TO-RETURN!-ERRORS GTJFN>)>
+ <MAPF <>
+ <FUNCTION (ARG)
+ <COND (<==? .ARG => <MAPLEAVE>)>
+ <OCEMIT PUSH TP* !<OBJ-TYP .ARG>>
+ <COND (,WINNING-VICTIM
+ <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>
+ <OCEMIT PUSH TP* !<OBJ-VAL .ARG>>
+ <COND (,WINNING-VICTIM
+ <SETG STACK-DEPTH <+ ,STACK-DEPTH 1>>)>>
+ <REST .L>>
+ <OCEMIT MOVEI O1* <- .LN 3>>
+ <PUSHJ GTJFNL <NTH .L .LN>>>
+
+<DEFINE JFNS-DO (JS L "AUX" (DEST <>) ARG1 ARG2 ARG3 ARG4)
+ #DECL ((L) LIST)
+ <COND (<MEMQ = .L>
+ <COND (<==? <LENGTH .L> 7> <SET DEST <7 .L>>)
+ (ELSE <MIMOCERR BAD-JFNS-CALL!-ERRORS>)>)
+ (<N==? <LENGTH .L> 5> <MIMOCERR BAD-JFNS-CALL!-ERRORS>)>
+ <COND (<OR <==? <SET ARG1 <2 .L>> .DEST>
+ <AND <TYPE? .ARG1 ATOM> <WILL-DIE? .ARG1>>>
+ <DEAD!-MIMOC (.ARG1) T>)>
+ <COND (<OR <==? <SET ARG2 <3 .L>> .DEST>
+ <AND <TYPE? .ARG2 ATOM> <WILL-DIE? .ARG2>>>
+ <DEAD!-MIMOC (.ARG2) T>)>
+ <COND (<OR <==? <SET ARG3 <4 .L>> .DEST>
+ <AND <TYPE? .ARG3 ATOM> <WILL-DIE? .ARG3>>>
+ <DEAD!-MIMOC (.ARG3) T>)>
+ <COND (<OR <==? <SET ARG4 <5 .L>> .DEST>
+ <AND <TYPE? .ARG4 ATOM> <WILL-DIE? .ARG4>>>
+ <DEAD!-MIMOC (.ARG4) T>)>
+ <UPDATE-ACS>
+ <GET-INTO-ACS .ARG1 VALUE A1* .ARG2 VALUE A2* .ARG3 VALUE B1*
+ .ARG4 VALUE B2*>
+ <OCEMIT HRRZ C1* !<OBJ-TYP .ARG1>>
+ <PUSHJ JFNS .DEST>>
+
+<DEFINE RFTAD-DO (JS L "AUX" (DEST <>) ARG1 ARG2 ARG3 TL)
+ #DECL ((L) LIST)
+ <COND (<SET TL <MEMQ = .L>>
+ <SET DEST <2 .TL>>)>
+ <UPDATE-ACS>
+ <MUNGED-AC A1*>
+ <SMASH-AC A1* <2 .L> VALUE>
+ <MUNGED-AC A2*>
+ <SMASH-AC A2* <3 .L> VALUE>
+ <MUNGED-AC B1*>
+ <SMASH-AC B1* <4 .L> VALUE>
+ <PUSHJ RFTAD .DEST>>
+
+<DEFINE ERSTR-DO (JS L "AUX" (DEST <>) ARG1 ARG2 ARG3)
+ #DECL ((L) LIST)
+ <COND (<MEMQ = .L>
+ <COND (<==? <LENGTH .L> 6> <SET DEST <6 .L>>)
+ (ELSE <MIMOCERR BAD-ERSTR-CALL!-ERRORS>)>)
+ (<N==? <LENGTH .L> 4> <MIMOCERR BAD-ERSTR-CALL!-ERRORS>)>
+ <COND (<OR <==? <SET ARG1 <2 .L>> .DEST>
+ <AND <TYPE? .ARG1 ATOM> <WILL-DIE? .ARG1>>>
+ <DEAD!-MIMOC (.ARG1) T>)>
+ <COND (<OR <==? <SET ARG2 <3 .L>> .DEST>
+ <AND <TYPE? .ARG2 ATOM> <WILL-DIE? .ARG2>>>
+ <DEAD!-MIMOC (.ARG2) T>)>
+ <COND (<OR <==? <SET ARG3 <4 .L>> .DEST>
+ <AND <TYPE? .ARG3 ATOM> <WILL-DIE? .ARG3>>>
+ <DEAD!-MIMOC (.ARG3) T>)>
+ <UPDATE-ACS>
+ <GET-INTO-ACS .ARG1 VALUE A1* .ARG2 VALUE A2* .ARG3 VALUE B1*>
+ <PUSHJ ERSTR .DEST>>
+
+<DEFINE LOAD-ARG (V AC)
+ <COND (<AND <TYPE? .V FIX WORD>
+ <L? <SET V <CHTYPE .V FIX>> *777777*>>
+ <MUNGED-AC .AC>
+ <OCEMIT MOVEI .AC .V>)
+ (ELSE
+ <SMASH-AC .AC .V VALUE>)>>
+
+<PUTPROP SIN-JSYS!-JSYS SPECIAL-JSYS-FUNCTION ,SIN-SOUT>
+
+<PUTPROP SOUT!-JSYS SPECIAL-JSYS-FUNCTION ,SIN-SOUT>
+
+<PUTPROP GTJFN-S-S!-JSYS SPECIAL-JSYS-FUNCTION ,GTJFN-S-DO>
+
+<PUTPROP GTJFN-S-J!-JSYS SPECIAL-JSYS-FUNCTION ,GTJFN-S-DO>
+
+<PUTPROP JFNS!-JSYS SPECIAL-JSYS-FUNCTION ,JFNS-DO>
+
+<PUTPROP ERSTR!-JSYS SPECIAL-JSYS-FUNCTION ,ERSTR-DO>
+
+<PUTPROP GTJFN-L!-JSYS SPECIAL-JSYS-FUNCTION ,GTJFN-L-DO>
+
+<COND (<GASSIGNED? RFTAD-DO>
+ <PUTPROP RFTAD!-JSYS SPECIAL-JSYS-FUNCTION ,RFTAD-DO>)>
projects / pdp10-muddle.git / blobdiff