daily pastebin goal
64%
SHARE
TWEET

Merthese interpreter (SysRPL) v0.00.00

tev Jan 6th, 2012 12 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. %%HP: T(3)A(R)F(.);
  2. DIR
  3.   MAKE
  4.   \<< 2. TVARS 1.
  5.     \<<
  6.       IF DUP \->STR DUP SIZE DUP
  7. 4. - SWAP SUB ".SRC'" ==
  8.       THEN DUP \->STR DUP SIZE 5.
  9. - 2. SWAP SUB DUP 1. DISP S~N
  10. SWAP RCL ASM SWAP STO
  11.       ELSE DROP
  12.       END
  13.     \>> DOLIST
  14.   \>>
  15.   $TITLE
  16. "Merthese interpreter (SysRPL)
  17. Travis Evans
  18. v0.00.00  2012/01/05"
  19.   $ROMID 865.
  20.   $VISIBLE { MERTHESE
  21. MERTHESEMOD ASHBAD.MOD TEV.MOD
  22. NIKKY.MOD KERM.MOD LOADMODULE
  23. ADDCOMMAND EXECCMD APPENDOUTPUT
  24. GETRANDCHAR GETRANDCOMP }
  25.   $HIDDEN { MERTHESE.MOD
  26. INITMODULES RANDINT LOOPRAND
  27. LOOPN }
  28.   $CONFIG 0.
  29.   ASHBAD.MOD.SRC
  30. "(Merthing and Ashbad are awesome
  31.  module)
  32. ::
  33.   \\"a\\"
  34.   \\"ASHBAD IZ SMRT\\"
  35.   ID ADDCOMMAND
  36. ;
  37. @"
  38.   TEV.MOD.SRC
  39. "(Merthing && tev module)
  40. ::
  41.   (t: Print incrementing seq of
  42.    chars of rand len 0-13
  43.    starting from accum. char.
  44.    Set accum. to final char+1
  45.    50% of the time)
  46.   \\"t\\"
  47.   ' ::
  48.     NULL$
  49.     LAM \<-accum
  50.     ' ::
  51.       DUP DOCHR SWAP %1+
  52.       UNROT  ID APPENDOUTPUT
  53.       SWAP
  54.     ;
  55.     ZERO THIRTEEN
  56.     ID LOOPRAND
  57.     {
  58.      :: ' LAM \<-accum  STOLAM ;
  59.      :: DROP ;
  60.     }
  61.     ID GETRANDCOMP  EVAL
  62.   ;
  63.   ID ADDCOMMAND
  64.  
  65.   (e: Print one of .,;:-!? )
  66.   \\"e\\"
  67.   ' ::
  68.     \\".,;:-!?\\"  ID GETRANDCHAR
  69.   ;
  70.   ID ADDCOMMAND
  71.  
  72.   (v: Print accum. char ROT13'ed)
  73.   \\"v\\"
  74.   ' ::
  75.     \\"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\\"
  76.     LAM \<-accum  DOCHR  ONE  POS$
  77.     DUP#0=case
  78.     :: DROP  LAM \<-accum  DOCHR ;
  79.     \\"nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM\\"
  80.     SWAPDUP SUB$
  81.   ;
  82.   ID ADDCOMMAND
  83. ;
  84. @"
  85.   NIKKY.MOD.SRC
  86. "(Merthing w/ Nikky module)
  87. ::
  88.   (n: Add following char in input
  89.    stream to accum.)
  90.   \\"n\\"
  91.   ' ::
  92.     LAM \<-in  LAM inpos#  #1+  DUP
  93.     SUB$  xNUM  LAM \<-accum  %+
  94.     ' LAM \<-accum  STOLAM
  95.     (Skip past just-used char)
  96.     LAM inpos#  #1+
  97.     ' LAM inpos#  STOLAM
  98.     NULL$
  99.   ;
  100.   ID ADDCOMMAND
  101.  
  102.   (i: Input char for accum.)
  103.   \\"i\\"
  104.   ' ::
  105.     \\"Character, please!\\" NULL$
  106.     ONE ZEROZEROZERO FALSE ZERO
  107.     TRUE ZERO InputLine
  108.     ?SKIP ABORT
  109.     xNUM  ' LAM \<-accum  STOLAM
  110.     NULL$
  111.   ;
  112.   ID ADDCOMMAND  
  113.  
  114.   (k: Print \\"nikky\\")
  115.   \\"k\\"
  116.   \\"nikky\\"
  117.   ID ADDCOMMAND
  118.  
  119.   (y: Loop: Number of times
  120.    indicated by next char in
  121.    stream; character after next
  122.    char will be executed this
  123.    many times)
  124.   \\"y\\"
  125.   ' ::
  126.     (Watch for [ON] abort, in
  127.      case someone unwittingly
  128.      runs something like
  129.      \\"yyyyyyyy...\\" :P )
  130.     ?ATTNQUIT
  131.    
  132.     (Save pos of looped cmd to
  133.      execute)
  134.     LAM inpos#  #2+
  135.     DUP  ' LAM inpos#  STOLAM
  136.     SWAP
  137.  
  138.     (Code to loop--restore prog
  139.      pos ptr then execute cmd)
  140.     ' ::
  141.       OVER  ' LAM inpos#  STOLAM
  142.       ID EXECCMD
  143.     ;
  144.    
  145.     LAM \<-in  4PICK  #1-
  146.     DUP SUB$ xNUM COERCE
  147.     ID LOOPN
  148.    
  149.     (Set pos to end of now-
  150.      completed loop[s])
  151.    
  152.     SWAP  ( pos out$ \-> out$ pos )
  153.     BEGIN
  154.       LAM \<-in  OVERDUP  SUB$
  155.       \\"y\\" EQUAL
  156.     WHILE #2+ REPEAT
  157.     ' LAM inpos#  STOLAM
  158.  
  159.     NULL$
  160.   ;
  161.   ID ADDCOMMAND
  162. ;
  163. @"
  164.   KERM.MOD.SRC
  165. "(Merthing @ Kerm module)
  166. ::
  167.   (k: Print accum. char)
  168.   \\"k\\"
  169.   ' :: LAM \<-accum  DOCHR ;
  170.   ID ADDCOMMAND
  171.  
  172.   (e: Increment accum.)
  173.   \\"e\\"
  174.   ' ::
  175.     LAM \<-accum  %1+
  176.     ' LAM \<-accum  STOLAM
  177.     NULL$
  178.   ;
  179.   ID ADDCOMMAND  
  180.  
  181.   (r: Reset accum.)
  182.   \\"r\\"
  183.   ' ::
  184.     %0  ' LAM \<-accum  STOLAM
  185.     NULL$
  186.   ;
  187.   ID ADDCOMMAND
  188.  
  189.   (m: Print accum. as decimal)
  190.   \\"m\\"
  191.   ' ::
  192.     (Conv to ZINT to remove
  193.      annoying trailing period)
  194.     LAM \<-accum  %IP  FPTR2 ^R>Z
  195.     FPTR2 ^Z>S
  196.   ;
  197.   ID ADDCOMMAND
  198. ;
  199. @"
  200.   MERTHESE.MOD.SRC
  201. "(Internal Merthese base module)
  202. ::
  203.   (m: Print \\"merth\\")
  204.   \\"m\\"
  205.   \\"merth\\"
  206.   ID ADDCOMMAND
  207.  
  208.   (e: Print newline)
  209.   \\"e\\"
  210.   NEWLINE$
  211.   ID ADDCOMMAND
  212.  
  213.   (r: Print space)
  214.   \\"r\\"
  215.   SPACE$
  216.   ID ADDCOMMAND
  217.  
  218.   (t: Print string of random
  219.    chars a-z with random length
  220.    0-13)
  221.   \\"t\\"
  222.   ' ::
  223.     ' ::
  224.       \\"abcdefghijklmnopqrstuvwxyz\\"
  225.       ID GETRANDCHAR
  226.       ID APPENDOUTPUT
  227.     ;
  228.     ZERO THIRTEEN
  229.     ID LOOPRAND
  230.     NULL$
  231.   ;
  232.   ID ADDCOMMAND
  233.  
  234.   (h: Seek to next 'h' char and
  235.    resume execution from there)
  236.   \\"h\\"
  237.   ' ::
  238.     LAM \<-in  \\"h\\"  LAM inpos#  #1+
  239.     POS$
  240.     (If not found, zero will be
  241.      saved as prog pos, signaling
  242.      execution to immediately
  243.      end.)
  244.     ' LAM inpos#  STOLAM
  245.     NULL$  (No string output)
  246.   ;
  247.   ID ADDCOMMAND
  248.  
  249.   (Easter egg :]  Evidently,
  250.    someone was getting a little
  251.    too bored while coding :P )  
  252.   NULL$
  253.   \\"A null string?
  254. Are you kidding me?
  255. AHAHAHAHAHAHAHAHAHAHAHA!\\"
  256.   ID ADDCOMMAND
  257. ;
  258. @"
  259.   MERTHESE.SRC
  260. "( mertheseprog$ \->
  261.  Runs a Merthese program.
  262.  Extension modules to be used can
  263.  be named in global list
  264.  'MertheseModules'.
  265. )
  266. ::
  267.   CK1&Dispatch
  268.   THREE  (Str)
  269.   ::
  270.     ' ID MertheseModules  @
  271.     ITE
  272.     ::
  273.       DUPTYPELIST? ?SEMI
  274.       DROP NULL{}
  275.     ;
  276.     ::
  277.       NULL{} DUP
  278.       ' ID MertheseModules
  279.       STO
  280.     ;
  281.     ID MERTHESEMOD
  282.   ;
  283. ;
  284. @"
  285.   MERTHESEMOD.SRC
  286. "( prog$ modulelist \-> output$
  287.  Interprets Merthese program
  288.  prog$ using any optional
  289.  extension modules named in
  290.  modulelist.
  291. )
  292. ::
  293.   CK2&Dispatch
  294.   STRLIST
  295.   ::
  296.     (Set up shared vars [may be
  297.      read and manipulated by
  298.      User/SysRPL extension
  299.      modules])
  300.     ZERO DUP UNCOERCE DUP { } %0
  301.     {
  302.       LAM \<-in       (Input prog str)
  303.       LAM \<-modules  (List of modules)
  304.       LAM inpos#    (Curr prog pos, BINT)
  305.       LAM \<-inpos    (Curr prog pos, real [for UserRPL modules])
  306.       LAM lastinpos (Bkup of \<-inpos to test for modification)
  307.       LAM \<-cmds     (Merthese char lookup table)
  308.       LAM \<-accum    (Accumulator character, real)
  309.     }
  310.     BIND
  311.       LAM \<-modules
  312.       ID INITMODULES
  313.      
  314.       (Main interpreter loop)
  315.       NULL$  (Output string)
  316.       BEGIN
  317.         (Check for [ON] break)
  318.         ?ATTNQUIT
  319.  
  320.         (Advance inpos)
  321.         LAM inpos#  #1+DUP
  322.         UNCOERCE DUP
  323.         ' LAM \<-inpos  STOLAM
  324.         ' LAM lastinpos  STOLAM
  325.         ' LAM inpos#  STOLAM
  326.  
  327.         (Execute next
  328.          instruction and append
  329.          output)
  330.         ID EXECCMD
  331.  
  332.         (Adjust inpos# if \<-inpos
  333.          changed)
  334.         LAM \<-inpos  DUP
  335.         LAM lastinpos
  336.         %<>  ITE
  337.         ::
  338.           DUP COERCE
  339.           ' LAM inpos#  STOLAM
  340.           DUP
  341.           ' LAM \<-inpos  STOLAM
  342.           ' LAM lastinpos  STOLAM
  343.         ;
  344.         DROP
  345.  
  346.         (Stop once interpreter
  347.          ptr is 0 or is beyond
  348.          end of input prog)
  349.         LAM inpos#  DUP  #0=
  350.         SWAP  LAM \<-in  LEN$  #>=_
  351.         OR
  352.       UNTIL
  353.     ABND
  354.   ;
  355. ;
  356. @"
  357.   INITMODULES.SRC
  358. "( modulelist \->
  359.  Sets up extension modules named
  360.  in modulelist.
  361. )
  362. ::
  363.   (Load base Merthese module)
  364.   ' ID MERTHESE.MOD
  365.   ID LOADMODULE
  366.  
  367.   (Load remaining modules in
  368.    specified order)
  369.   INNERCOMP reversym
  370.   ' ID LOADMODULE
  371.   SWAP
  372.   ID LOOPN
  373. ;
  374. @"
  375.   LOADMODULE.SRC
  376. "( module \->
  377.  Load a Merthese module
  378. )
  379. ::  
  380.   CK1&Dispatch
  381.   SIX  (Global name)
  382.   ::
  383.     ?ATTNQUIT
  384.     xRCL  COLA  ID LOADMODULE
  385.   ;
  386.   SEVEN  (Local name)
  387.   ::
  388.     ?ATTNQUIT
  389.     xRCL  COLA  ID LOADMODULE
  390.   ;
  391.   FIFTEEN  (ROMPTR)
  392.   EVAL
  393.   EIGHT  (Program)
  394.   EVAL
  395. ;
  396. @"
  397.   ADDCOMMAND.SRC
  398. "( char$ action \->
  399.  Adds a Merthese command.  char$
  400.  in a Merthese program will eval
  401.  obj 'action'.
  402. )
  403. ::
  404.   CK2&Dispatch
  405.   #30 (str, obj)
  406.   ::
  407.     {{ action char$ }}
  408.  
  409.     (Add command action to lookup
  410.      list)
  411.     char$  ' EQUAL  LAM \<-cmds
  412.     Lookup case
  413.     ::
  414.       (Insert additional action
  415.        for char)
  416.       action >HCOMP
  417.       LAM \<-cmds  char$
  418.       EQUALPOSCOMP #1+
  419.       LAM \<-cmds  PUTLIST
  420.       ' LAM \<-cmds  STOLAM
  421.     ;
  422.     (Add new char & action)
  423.     LAM \<-cmds SWAP
  424.       action ONE {}N
  425.     TWO {}N
  426.     &COMP
  427.     ' LAM \<-cmds  STOLAM
  428.   ;
  429.   #6F0 (char, obj)
  430.   ::
  431.     (Convert chr to str; restart)
  432.     SWAP CHR>$ SWAP
  433.     ID ADDCOMMAND
  434.   ;
  435. ;
  436. @"
  437.   EXECCMD.SRC
  438. "( str \-> str'
  439.  Dispatch and execute Merthese
  440.  command at current prog pos;
  441.  append output to given str
  442. )
  443. ::
  444.   CK1&Dispatch
  445.   THREE  (str)
  446.   ::
  447.     LAM \<-in  LAM inpos#  DUP  SUB$
  448.     ' EQUAL  LAM \<-cmds
  449.     Lookup NOTcase DROP  (Ignore unknown chars)
  450.     ID GETRANDCOMP  EVAL
  451.     ID APPENDOUTPUT
  452.   ;
  453. ;
  454. @"
  455.   APPENDOUTPUT.SRC
  456. "( obj obj \-> str
  457.  Make sure stack has two objects,
  458.  convert them to strings if
  459.  necessary, then concatenate
  460.  them
  461. )
  462. ::
  463.   CK2
  464.   DO>STR SWAP DO>STR SWAP &$
  465. ;
  466. @"
  467.   GETRANDCHAR.SRC
  468. "( str \-> str'
  469.  Return a randomly-selected
  470.  char from a string [returned as
  471.  a 1-char str, not a system
  472.  char!]
  473. )
  474. ::
  475.   CK1&Dispatch
  476.   THREE  (str)
  477.   ::
  478.     DUPLEN$ ONESWAP
  479.     ID RANDINT
  480.     DUP SUB$
  481.   ;
  482. ;
  483. @"
  484.   GETRANDCOMP.SRC
  485. "( comp \-> obj
  486.  Return a randomly-selected
  487.  obj from a composite
  488. )
  489. ::
  490.   CK1&Dispatch
  491.   FIVE  (list)
  492.   ::
  493.     DUPLENCOMP ONESWAP
  494.     ID RANDINT
  495.     NTHELCOMP DROP
  496.   ;
  497. ;
  498. @"
  499.   RANDINT.SRC
  500. "( #min #max \-> #
  501.  Return random bint from #min to
  502.  #max
  503. )
  504. ::
  505.   OVER #- UNCOERCE %RAN %*
  506.   SWAP UNCOERCE %+ COERCE
  507. ;
  508. @"
  509.   LOOPN.SRC
  510. "( obj #numloops \->
  511.  Eval 'obj' '#numloops' times
  512. )
  513. ::
  514.   (Do nothing if zero loops)
  515.   DUP #0=case 2DROP
  516.  
  517.   SWAP
  518.   { LAM obj } BIND
  519.   ZERO_DO
  520.     LAM obj  EVAL
  521.   LOOP
  522.   ABND
  523. ;
  524. @"
  525.   LOOPRAND.SRC
  526. "( obj #min #max \->
  527.  Eval obj random # of times from
  528.  #min to #max
  529. )
  530. ::
  531.   ID RANDINT
  532.   ID LOOPN
  533. ;
  534. @"
  535. END
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top