home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol166 / asam.rec < prev    next >
Encoding:
Text File  |  1984-04-29  |  7.8 KB  |  155 lines
  1.  
  2. [ASAM.REC]
  3. [some sample programs for CNVRT]
  4. [28 March 1982]
  5.  
  6. [[]]
  7.  
  8. {
  9.                    {
  10.     [find/make FCB]        (Jj'TTY:'EQZD;(':'UQD':'ED\64-%;0%;)
  11.                  ('.'U<(8a;@b;)Q|D>;Z'.DAT'IJj:)
  12.                   '.'FJDZ(3a;@b;)Q|JZDI
  13.                  32(dpGm$r0=npGpGd0&$Sm@znpGQ&$rrS0;
  14.                  r12wQmwnEn;n:)D;) f
  15.     [blank fill by count]    (Zz(d' 'I:;)JZ;) b
  16.     [zero fill]            (cmpw0%(f:;)w;) 0
  17.     [zero FCB & buffer]        ($m33@0130@0nn&0||pLnS;) z
  18.     [set default input file]    (0,30$S'5C'H12wA' 'Ew4@0n0|0|pL31$S
  19.                  'TTY:'31$rrS; B9aQD(3a'   'E
  20.                  'DAT';Q;)|mw31@zn31$rrS31@r;) i
  21.     [open for read]        (@hr15K(255='NO FILE'I;L;)L;) r
  22.     [open for write]        (@hpGpG4+1&SrpG19k22k^^r128&S;) w
  23.     [set DMA address]        ($rpG^^r^^26k;) h
  24.     [open]            (m@f0=n@@;nLL;) O
  25.     [read]            (''(AL@f(0=pG@r;'TTY:'(='T');))
  26.                  ('T'='';L31pG$rr12w'TTY:'Ew;w)
  27.                  L@&'> 'TL(@#I;:);
  28.                  $r(pG^^rpGmr(0=(npGpGm128&S^^26kpGr
  29.                  20K0=L;LL1npGpGm129+26%&SS;)npGmr;;)
  30.                  pG130&-n+&dm(u13%=;10%(=)pGI(26%=;
  31.                  L);ndm:)L^^rn&S;LpG^^r0&S:);) R
  32.     [write]            (Jj'='U<(A@f'TTY:'(=)(0=pG@w;;))>'='ED
  33.                  ZqtD; >'='EDZ<@g;) W
  34.     [write to disk]        ($r(pG^^rpGpGmrpGm- 130+n&maQD>Z<nSn^^
  35.                  26kpGr21kpG^^r128&S:JZQD>nSnSL;);) g
  36.     [close all files]        (31pGm($r0=;pG4+r(0=L;LJj26%I<npGm@gpG
  37.                  ^^rpGr127(N^^26kpGr21k;L;)r16k;)ndpGm:)
  38.                  nL;;) c
  39.     [PVR]            (pG@&#'= '|TL$r(0='undef';yG;)TL;) _
  40.     [cr, lf]            (2573TL;)&
  41.     [insert cr, lf]        (2573I;)|
  42.     [read console]        (R13%='';08%(=)(T@#|;08%T' 'TLTLL@#;);)#
  43.     [type comment]        (@TD;)C
  44.     [display at logon]        ('
  45. A demonstration of CNVRT programs. The choices are
  46.         bsum - sum two strings of binary digits
  47.         merge - combine two lists into one
  48.         reverse - reverse a list
  49.         split - split a list into alternate elements
  50.         list - recognize typical list elements
  51.         word - some fancy word forms
  52.         quit - end the demonstration
  53.         ? - list the choices
  54. 'TL@&;)D
  55.     [write workspace]        (@&JZqt;)T
  56.                 (@@;) }%
  57.     [integer arithmetic]    {(+;)+ (-;)- (*;)* (/&L;)/
  58.                 (pGm/L1=nL1;0=n;n&:)|
  59.                  ((pGmJj(U);QD(O)I;npGmEDZQD(O)IjnpGmI;
  60.                  n@@#I)nLJZ;;) } #
  61.     [save & init variables]    (pGpGm$rm0&$S;) (
  62.     [reinitialize variable]    (pG$r0=L;LnL0&$S;) :
  63.     [undefine variable]        ($r0=;LnL;) )
  64.     [compare/define variable]    (pG$r0=ZQzml&$S;&LyGEz;) ]
  65.     [body of variable search]    (pG$r(0=)yG(E;&L)z&L@=L;pG$r(0=;LL)
  66.                   Z<((&pGm&n(F;''mZz<)jJQmpGl&$S
  67.                   zZ<@=>;J>);nLA:0&$SL>)>LL;) >
  68.     [body of variable search]    (pG$r(0=)yGEz@=L;pG$r(0=;LL)
  69.                   Z<((jJQmpGl&$S
  70.                   zZ<@=>;J>);nLA:0&$S>)>L;) <
  71.     [insert variable]        ($ryGI;) [
  72.                 
  73. [binary sum]
  74. {(0@( 1@( 2@( {(0@: 1@: 2@: ;); (
  75.     @;(J2573TL'b 'TLZqtj()JZD;);
  76.     @;(J'+=0'Ez2@]JZD'+='I2@[;):
  77.     @;(J'+='Ez2@]JZD2@[;);
  78.     @;(J {[vbl] ('+='Ez2@];) = ('+='0@>;)}[vbl] JZD0@['+0='I2@[;):
  79.     @;(J'+'Ez {[vbl] ('='Ez2@];) = ('='1@>;)}[vbl] JZD'0+'I1@['='I2@[;):
  80.     @;(J {[vbl] ('+*'Ez2@];) = ('+*'0@>;)}[vbl] JZD0@['+1'I2@[;):
  81.     @;(J {[vbl] ('+'Ez {[vbl] ('0*'Ez2@];) = ('0*'1@>;)}[vbl] ;) = ('+'0@>;)}[vbl] JZD0@['+'I1@['1'I2@[;):
  82.     @;(J {[vbl] ('+'Ez {[vbl] ('1*'Ez2@];) = ('1*'1@>;)}[vbl] ;) = ('+'0@>;)}[vbl] JZD0@['+'I1@['*0'I2@[;):
  83.     @;(J {[vbl] ('0+'Ez {[vbl] ('0='Ez2@];) = ('0='1@>;)}[vbl] ;) = ('0+'0@>;)}[vbl] JZD0@['+'I1@['=0'I2@[;):
  84.     @;(J {[vbl] ('0+'Ez {[vbl] ('1='Ez2@];) = ('1='1@>;)}[vbl] ;) = ('0+'0@>;)}[vbl] JZD0@['+'I1@['=1'I2@[;):
  85.     @;(J {[vbl] ('1+'Ez {[vbl] ('0='Ez2@];) = ('0='1@>;)}[vbl] ;) = ('1+'0@>;)}[vbl] JZD0@['+'I1@['=1'I2@[;):
  86.     @;(J {[vbl] ('1+'Ez {[vbl] ('1='Ez2@];) = ('1='1@>;)}[vbl] ;) = ('1+'0@>;)}[vbl] JZD0@['+'I1@['*=0'I2@[;):
  87.   ;)} 0@) 1@) 2@)   nn$S nn$S nn$S;)} b
  88.  
  89. [merge two strings into a single string]
  90. {(0@( 1@( 2@( 3@( 4@( {(0@: 1@: 2@: 3@: 4@: ;); (
  91.     @;(J'['Ez {[vbl] (' 'Ez {[vbl] (']['Ez {[vbl] (' 'Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'4@>;)}[vbl] ;) = (']['3@>;)}[vbl] ;) = (' '2@>;)}[vbl] ;) = (']['1@>;)}[vbl] ;) = (' '0@>;)}[vbl] JZD'['I1@[']['I3@[']['I4@[' 'I0@[' 'I2@[']'I;):
  92.     @;(J'['Ez {[vbl] (' 'Ez {[vbl] (']['Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'4@>;)}[vbl] ;) = (']['2@>;)}[vbl] ;) = (']['1@>;)}[vbl] ;) = (' '0@>;)}[vbl] JZD4@[' 'I0@[' 'I2@[' 'I1@[;);
  93.     @;(J'['Ez {[vbl] (']['Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'4@>;)}[vbl] ;) = (']['2@>;)}[vbl] ;) = (']['0@>;)}[vbl] JZD4@[' 'I0@[' 'I2@[;);
  94.   ;)} 0@) 1@) 2@) 3@) 4@)   nn$S nn$S nn$S nn$S nn$S;)} m
  95.  
  96. [reverse a list]
  97. {(0@( 1@( 2@( {(0@: 1@: 2@: ;); (
  98.     @;(J'['Ez {[vbl] (' 'Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'2@>;)}[vbl] ;) = (']['1@>;)}[vbl] ;) = (' '0@>;)}[vbl] JZD'['I1@[']['I0@[' 'I2@[']'I;):
  99.     @;(J'['Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'2@>;)}[vbl] ;) = (']['0@>;)}[vbl] JZD0@[' 'I2@[;);
  100.   ;)} 0@) 1@) 2@)   nn$S nn$S nn$S;)} r
  101.  
  102. [split a string into evens and odds]
  103. {(0@( 1@( 2@( 3@( 4@( {(0@: 1@: 2@: 3@: 4@: ;); (
  104.     @;(J'['Ez {[vbl] (' 'Ez {[vbl] (' 'Ez {[vbl] (']['Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'4@>;)}[vbl] ;) = (']['3@>;)}[vbl] ;) = (']['2@>;)}[vbl] ;) = (' '1@>;)}[vbl] ;) = (' '0@>;)}[vbl] JZD'['I2@[']['I0@[' 'I3@[']['I1@[' 'I4@[']'I;):
  105.     @;(J'['Ez {[vbl] (' 'Ez {[vbl] (']['Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'4@>;)}[vbl] ;) = (']['3@>;)}[vbl] ;) = (']['1@>;)}[vbl] ;) = (' '0@>;)}[vbl] JZD0@[' 'I3@[z<'|'@%Z>1@[' 'I4@[;);
  106.     @;(J'[]['Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'4@>;)}[vbl] ;) = (']['3@>;)}[vbl] JZD3@[z<'|'@%Z>4@[;);
  107.     @;(J'['Ez {[vbl] (']['Ez {[vbl] (']['Ez {[vbl] (']'Ez;) = (']'4@>;)}[vbl] ;) = (']['3@>;)}[vbl] ;) = (']['0@>;)}[vbl] JZD0@[' 'I3@[z<'|'@%Z>4@[;);
  108.   ;)} 0@) 1@) 2@) 3@) 4@)   nn$S nn$S nn$S nn$S nn$S;)} s
  109.  
  110. [word types]
  111. { 
  112. (1@( 2@(  {(1@: 2@: ;); (
  113.   @;(J {[vbl] ( {[vbl] ( {[vbl] ((A);) = (1@<;)}[vbl] ;) = (1@<;)}[vbl] ;) = (1@<;)}[vbl] JZD'tripled word :'I1@[':'Iz<'|'@%Z>z<1@[@wZ>;);
  114.   @;(J {[vbl] ( {[vbl] ((A);) = (1@<;)}[vbl] ;) = (1@<;)}[vbl] JZD'doubled word :'I1@[':'Iz<'|'@%Z>z<1@[@wZ>;);
  115.   @;(J [and] Z<(1(a;L)z jJ><1@](A);>)> [and]  {[vbl] ( {[vbl] ((A);) = (1@<;)}[vbl] ;) = (2@<;)}[vbl] JZD'sandwich :'I1@[':^:'I2@[':^:'I1@[':'Iz<'|'@%Z>z<2@[@wZ>;);
  116.   @;(J(('1'(Fz;Zz<)Z<(('2'(Fz;Zz<)Z<(('3'(Fz;Zz<)Z<(('4'(Fz;Zz<)Z<(('5'(Fz;Zz<)Z<((Z<>;J>);A:)>;J>);A:)>;J>);A:)>;J>);A:)>;J>);A:)>;J>);A:)JZD'five in order'I;);
  117.   @;(J((Z< [and] Z<(3(a;L)z jJ><1@](A);>)> [and] ((Z< {[vbl] (((Z< {[vbl] (((Z<>;J>);A:);) = (1@<;)}[vbl] >;J>);A:);) = (1@<;)}[vbl] >;J>);A:)>;J>);A:)JZD'triple triple :'I1@[':'I;);
  118.   @;(J((Z< [and] Z<(3(a;L)z jJ><1@](A);>)> [and] ((Z< {[vbl] (((Z<>;J>);A:);) = (1@<;)}[vbl] >;J>);A:)>;J>);A:)JZD'repeated triple :'I1@[':'I;);
  119.   @;(J((Z< [and] Z<(2(a;L)z jJ><1@](A);>)> [and] ((Z< {[vbl] (((Z<>;J>);A:);) = (1@<;)}[vbl] >;J>);A:)>;J>);A:)JZD'repeated pair   :'I1@[':'I;);
  120.   @;(J((Z< [and] Z<(1(a;L)z jJ><1@](A);>)> [and] ((Z< {[vbl] (((Z<>;J>);A:);) = (1@<;)}[vbl] >;J>);A:)>;J>);A:)JZD'repeated letter :'I1@[':'I;);
  121.   @;(J1@]JZD'nothing word: 'I1@[;);
  122.    ;)} 1@) 2@)   nn$S nn$S;)} w
  123.  
  124. [list types]
  125. { 
  126.   [letter]    ( {[AND] ( {(>(<;<);) ` (jJ><[not] (Z<  {[OR] (;) \ (Z<(' 'Ez@\; J'('Ez@\; J')'Ez@\;)>;>)} [OR] J>)J>[not] Zz(A)@`;)} ;) ` (Z<1(a;L)z@`>;>)}[AND] ;) a
  127.   [atom]    ( {[OR] (;) \ (Z<(@a@b@\; J@a@\;)>;>)} [OR] ;) b
  128.   [goodparen]    ( {[OR] (;) \ (Z<(' 'Ez@\; J@b@\; J@e@\;)>;>)} [OR] ;) c
  129.   [goodseq]    ( {[OR] (;) \ (Z<(@c@d@\; J@\;)>;>)} [OR] ;) d
  130.   [list]    ('('Ez@d')'Ez;) e
  131.    
  132. ( (
  133.   (J@a(A)JZD'letter'I;);
  134.   (J@b(A)JZD'atom'I;);
  135.   (J@e(A)JZD'list'I;);
  136.   (J@d(A)JZD'good sequence'I;);
  137.   (JJZD'not typical'I;);
  138.    ;) ;)} x
  139.  
  140. { ( (
  141.    (J'word'EzJZDz<z<z<'R'@%Z>@wZ>'C'@%Z>z<'R'@%Z>;):
  142.    (J'list'EzJZDz<z<z<'R'@%Z>@xZ>'C'@%Z>z<'R'@%Z>;):
  143.    (J'bsum'EzJZDz<z<z<'R'@%Z>'+'Iz<'R'@%Z>'='I@bZ>'C'@%Z>z<'R'@%Z>;):
  144.    (J'merge'EzJZDz<z<'['Iz<'R'@%Z>']['Iz<'R'@%Z>'][]'I@mZ>'C'@%Z>z<'R'@%Z>;):
  145.    (J'quit'EzJZD;);
  146.    (J'reverse'EzJZDz<z<'['Iz<'R'@%Z>'][]'I@rZ>'C'@%Z>z<'R'@%Z>;):
  147.    (J'split'EzJZDz<z<'['Iz<'R'@%Z>'][][]'I@sZ>'C'@%Z>z<'R'@%Z>;):
  148.    (J'??'EzJZDz<'D'@%Z>z<'R'@%Z>;):
  149.    (J'?'EzJZDz<' bsum merge reverse split word list quit'I'C'@%Z>z<'R'@%Z>;):
  150.    (JJZDz<'quit to exit, ? for menu'I'C'@%Z>z<'R'@%Z>;):
  151.    ;) ;)} ~
  152. ('i'@%'D'@%'R'@%@~JZqt'c'@%;)  }
  153.  
  154. [end]
  155.