X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=%3Cmdl.comp%3E%2Fcomcod.mud.45;fp=%3Cmdl.comp%3E%2Fcomcod.mud.45;h=c92c7158067f3dc3d7f7520664d0b59344393fa3;hb=3395a5e4ef72d59cdb6832af7808dc9c2cf2a413;hp=0000000000000000000000000000000000000000;hpb=363cc6ead5cf4df20759797fe46b5dc29b3886e9;p=pdp10-muddle.git diff --git a//comcod.mud.45 b//comcod.mud.45 new file mode 100644 index 0000000..c92c715 --- /dev/null +++ b//comcod.mud.45 @@ -0,0 +1,936 @@ + + + + + + +)> + +CSOURCE + + + +)> + + + +"***** BEGINNING OF THE IMPLEMENTATION SECTION *****" + + + >> + + FIX>) -1>]> + +"Special datum meaning nothing returned." + +> + + + +> + + + +> + + + +) TYPED:ADDRESS>> + + + +;"FUNNY FUDGES " + + >> + + >> + + >> + + + + + +>> + > + >>> + .ATM> + +>> + +> + + + ) + .ATM> )>> + .LOCAL-TAGS>> + + (LOCAL-TAGS) LIST) + + >) + .ATM> + > + )> + > + >)>> + .LOCAL-TAGS>) + (ELSE + >> .DEF?) + !.LOCAL-TAGS)> + .ATM)>> + + + >) + > !.LOSERS)>)>> + .L> + > + )>> + +) + (>>>>)>> + +>> + + <>>> + +) + >>> + + '![UVECTOR VECTOR!]> + 0>>>> + > AC> + + + .TAG>>) + (ELSE + + !>> + )>) + (ELSE + >> + + `O* + '>> + )>> + +>> + +>> + +) "AUX" (DAT )) + .DAT> + .DAT>)> + .DAT> + +> >>>> + +)) + #DECL ((DAT) ) + > + + ()) + ( ()) + ( ) + ( .ADR) + ( (<1 .ADR>)) + ( + > #ADDRESS:PAIR (|$TTB + `TB )> + (<1 .ADR> `(TB) )) + (ELSE + > ;"FORCE INDEX INTO REG " + > > + '![STORAGE UVECTOR!]>> + (>>)) + (ELSE + (<1 .ADR> + ! 4> <4 .ADR>) + (ELSE (0))> + (>>)))>)>)>> + +) "AUX" TAC (P )) + #DECL ((AC TAC TOAC) AC) + + >>> + >> + >> + + ()>> + >>> + > + +> + +)) + #DECL ((DAT) ) + > + + (!.ADR 1)) + ( ) + ( ()) + ( ) + ( + > #ADDRESS:PAIR (|$TTB + `TB )> + (<+ <1 .ADR> 1> `(TB) )) + (ELSE + > + (! 4> <4 .ADR>) (ELSE (0))> + <+ 1 <1 .ADR>> + (>>)))>) + (ELSE ())>> + + + (TM) TEMP (OFF) FIX (FCN) NODE) + > + >) + (<1? .OFF> >) + ()>) + ( + (! !) + ( !.TMPS)> + '`(TP) )) + (ELSE + + + <* -2>) + (ELSE 0)> !.TMPS) .AC-HACK>)>)>> + + + (! !) + ( !.TMPS)> + '`(TP) )) + (ELSE + + + <* -2>) + (ELSE 0)> !.TMPS) .AC-HACK>)>> + +"FIX:ADDR TAKES TWO ARGUMENTS. THESE ARE A NEGATIVE AND POSITIVE OFFSETS ON THE STACK + AND BUILDS A COMPOSITE OFFSET ELIMINATING DUPLICATION" + +) (NUM 0) (NPOS ()) (NNEGS ()) LN) + #DECL ((NEGS POS) LIST (NUM) FIX (NNEGS) LIST) + + >) + ( + >> + -1>> + >) + (ELSE )>> + .NEGS> + + >) + ()>> + .POS> + > (
!.NPOS)) + (ELSE (.NUM !.NPOS))>> + + (NUM) FIX) + ) + (ELSE > > .IT)>> + + WORD> + >>> + ) + ( LIST> > + > '[0]>) + (ELSE + > -1>)>> + +) + > + > + +) + + >> + > + '(-1))>>>)> + .DAT> + +>> + >> + .ADR> + +) + "AUX" TMP TT TO TAC T1 TMP1 T2 FROM (NOTYET <>) (NOTYET2 <>) + VAL LSEXCH) + #DECL ((TMP FROM TO) < ANY ANY> (TAC) AC (VAL) FIX) + > FLUSHED) + (<==? .FROM1 ,NO-DATUM> ) + ( >> > + > ANY-AC> + AC> >) + (ELSE >>)> + ) + + + + >>) + (ELSE + + + >> + .L> + )>>)> + > ANY-AC> + AC> + >>) + (ELSE + + + > + )> + >>> + + + )>)>> + AC> + AC> + <==? .T1 > + <==? .TT >>> + >>> + > >> + .LSEXCH>> + + )) + > + + >)>> + >>)> + + AC> + >>> + + + > ) + ( >> + ) + (ELSE )>> + + + .TAC> ) + ( + + + >> + ) + (ELSE )>> + + + + .T1> + .TT>) + (ELSE + + .TT> + .T1>)> + + ) + (ELSE + .TT> + .T1>)> + ) + > + + > + >>> + >>) + (> + + ) + > + > + >> >>) + (ELSE + ATOM> + 2> + <=? >>>> + ,ACO> + ) + > + >> >>)> + ATOM> + 2> <=? >>>> + ADDRESS:PAIR> + >> FIX>> -1> + <0? .VAL>>> + ) + `SETZM ) + (ELSE `SETOM )> + !>> + >> >>) + (ELSE + ,ACO> + ) + > + >> >>)>)>)> + + + >)>> + .TO>)> + >> + ) + .TO> .FROM>> + >> >>) + ( .FROM1) + (ELSE .TO1)>>> + +) + ( + + + + > > + '![STORAGE UVECTOR!]>> + > + > .TAC>) + (ELSE + + !>>)> + >) + ( + + + + + !>>> + >) + (> + + )>> + +) + ( + + + + .ADDRF> + >) + ( + + + + + !>>> + >) + (> + + )>> + +) (TT )) + #DECL ((TAC) AC (DAT) DATUM) + + <==? .TT .TAC> + <==? .T1 .TT>> + + > + <==? > .TAC>>>> + +) + + > + + )>> + .L> + .LST> + +> <==? .AC2 >> + + ) + (> + + )> + ) + ()>> + >>) + (> + + )> + ) + (ELSE )>> + >>)>> + +>)) + #DECL ((AC) AC (L) ) + ) + (ELSE )>)>> + +) + >> + AC> <==? ANY-AC>> + ) + ( ATOM> + AC> + <==? ANY-AC>>> + )> + >>> + +) + "AUX" SRC VAL (LN )) + #DECL ((AC) (VAL LN) FIX (INS) + (SRC) < ANY >>) + + >> + VECTOR> + > + > FIX>> + + + OPCODE!-OP>> + .AC .VAL>>) + ( + #WORD *400000000000*> + 262144> + OPCODE!-OP>> + ;"Was negative immediate ins supplied?" + .AC <- >>>) + ( + <0? > FIX>>> + + .AC + > FIX>>>) + (ELSE + .AC !>>)>) + (ELSE + .AC !>>)>> + +> + > + -1>> + >> + >> + +>>> + >> ;"Initial declarations."> + +) + >> + >> + +>> + +) + >> + >> + +>> + >>> + +>) (TR ) + (RQ ) (INAME ) TG + DC) + #DECL ((FCN) NODE (TR RQ) FIX (INAME) UVECTOR) + + > + > + > + >) + (ELSE + > + + >)) + > + > + ) + (ELSE )> + >> + .INAME> + > + >)>) + (ELSE + > + > + + <2 .L>>>>> + .ACSTR> + >)> + > + >> + >> + +>> + + >) + (ELSE >)>> + + (NOD) NODE) + > + + .RDCL> + + +)) + #DECL ((CODE:TOP) ) + .CSOURCE> + >)> + >>> + + )> + <> .SRC-FLG>) + (ELSE .X)>> + + + + + + +>> + + + >> + >>> + +)) + + + .SPECD + >>) + (.SPECD + > + >)>> + + > + > FIX> >) + (<==? .TEM PSLOT> >) + (<==? .TEM PSTACK> >) + (ELSE )> + >> + + > + >> + + ]>>>) + (ELSE + >> + <0? .PSTN>> + >>) + (ELSE + > PSLOT> >) + (<==? .TEM PSTACK> + + `@ + <- .OFFS> + '`(P) >> + >) + (ELSE + + `@ + <- .OFFS> + '`(P) >>)>)> + >> >> + > (.PST)>]>>)> + + !.OTHERS + .AMNT + ()>> + ()>> + >>)> + <0? .PST>>>> + +;"This is machine dependant code associated with setting up argument TUPLEs." + +> + > ;"D will count args pushed."> + +> + ]>> + ;"Bump an AOBJN pointer"> + +> + >> + +>> + +) + > + +)) + #DECL ((VALUE) ) + > + .VAL> + +) + (ELES )>> + +)) + #DECL ((VALUE) ) + > + +;"Machine dependant stuff for activations and environemnts" + +)) + > + +)) + > + .VAL> + +> + > + > + > + >) + (ELSE + ]>>)> + >> + +> + > + +)) + > + .VAL> + +> + >> + >> + +;"Machine dependent segment hacking code." + +>> + > + > + ]>>> + +>> + > + >> + +> + >> + +>> + +>> + + 1>> + + >> + +> + + 1>>> + +>> + + 2> !.NTSLOTS)>>> + > + 1>> + > + 1>> + >> + + !.NTSLOTS)>>> + +>> + +) + '[-1]>>> + + (NUMBER) FIX) + >>> + > + +>)>]>> + >> + +>> + + 2> 2>)) + + ]>> + > + >)> + >> + +>> + +>> + +>> + +>> + +;"Special code for READ EOF hacks." + +> + > + >> + >> + +> + > + >> + > + >>> + .BR> + + +