home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol166 / asmbl.rec < prev    next >
Encoding:
Text File  |  1984-04-29  |  8.0 KB  |  176 lines
  1.  
  2. [ASMBL.REC]
  3. [CNVRT assembler of intermediate code for "C"]
  4. [Harold V. McIntosh, 20 June 1983]
  5.  
  6. {
  7.                    {
  8.     [find/make FCB]        (Jj'TTY:'EQZD;(':'UQD':'ED\64-%;0%;)
  9.                  ('.'U<(8a;@b;)Q|D>;Z'.DAT'IJj:)
  10.                   '.'FJDZ(3a;@b;)Q|JZDI
  11.                  32(dpGm$r0=npGpGd0&$Sm@znpGQ&$rrS0;
  12.                  r12wQmwnEn;n:)D;) f
  13.     [blank fill by count]    (Zz(d' 'I:;)JZ;) b
  14.     [zero fill]            (cmpw0%(f:;)w;) 0
  15.     [zero FCB & buffer]        ($m33@0130@0nn&0||pLnS;) z
  16.     [set default input file]    (0,30$S'5C'H12wA' 'Ew4@0n0|0|pL31$S
  17.                  'TTY:'31$rrS; B9aQD(3a'   'E
  18.                  'DAT';Q;)|mw31@zn31$rrS31@r;) i
  19.     [open for read]        (@hr15K(255='NO FILE'I;L;)L;) r
  20.     [open for write]        (@hpGpG4+1&SrpG19k22k^^r128&S;) w
  21.     [set DMA address]        ($rpG^^r^^26k;) h
  22.     [open]            (m@f0=n@@;nLL;) O
  23.     [read]            (''(AL@f(0=pG@r;'TTY:'(='T');))
  24.                  ('T'='';L31pG$rr12w'TTY:'Ew;w)
  25.                  L@&'> 'TL(@#I;:);
  26.                  $r(pG^^rpGmr(0=(npGpGm128&S^^26kpGr
  27.                  20K0=L;LL1npGpGm129+26%&SS;)npGmr;;)
  28.                  pG130&-n+&dm(u13%=;10%(=)pGI(26%=;
  29.                  L);ndm:)L^^rn&S;LpG^^r0&S:);) R
  30.     [write]            (Jj'='U<(A@f'TTY:'(=)(0=pG@w;;))>'='ED
  31.                  ZqtD; >'='EDZ<@g;) W
  32.     [write to disk]        ($r(pG^^rpGpGmrpGm- 130+n&maQD>Z<nSn^^
  33.                  26kpGr21kpG^^r128&S:JZQD>nSnSL;);) g
  34.     [close all files]        (31pGm($r0=;pG4+r(0=L;LJj26%I<npGm@gpG
  35.                  ^^rpGr127(N^^26kpGr21k;L;)r16k;)ndpGm:)
  36.                  nL;;) c
  37.     [PVR]            (pG@&#'= '|TL$r(0='undef';yG;)TL;) _
  38.     [cr, lf]            (2573TL;)&
  39.     [insert cr, lf]        (2573I;)|
  40.     [read console]        (R13%='';08%(=)(T@#|;08%T' 'TLTLL@#;);)#
  41.     [type comment]        (@TD;)C
  42.     [display at logon]        ('cnvrt/icuap/1983'TL@&;)D
  43.     [write workspace]        (@&JZqt;)T
  44.                 (@@;) }%
  45.     [integer arithmetic]    {(+;)+ (-;)- (*;)* (/&L;)/
  46.                 (pGm/L1=nL1;0=n;n&:)|
  47.                  ((pGmJj(U);QD(O)I;npGmEDZQD(O)IjnpGmI;
  48.                  n@@#I)nLJZ;;) } #
  49.     [save & init variables]    (pGpGm$rm0&$S;) (
  50.     [reinitialize variable]    (pG$r0=L;LnL0&$S;) :
  51.     [undefine variable]        ($r0=;LnL;) )
  52.     [compare/define variable]    (pG$r0=ZQzml&$S;&LyGEz;) ]
  53.     [body of variable search]    (pG$r(0=)yG(E;&L)z&L@=L;pG$r(0=;LL)
  54.                   Z<((&pGm&n(F;''mZz<)jJQmpGl&$S
  55.                   zZ<@=>;J>);nLA:0&$SL>)>LL;) >
  56.     [body of variable search]    (pG$r(0=)yGEz@=L;pG$r(0=;LL)
  57.                   Z<((jJQmpGl&$S
  58.                   zZ<@=>;J>);nLA:0&$S>)>L;) <
  59.     [insert variable]        ($ryGI;) [
  60.                 
  61. [generic assignment]
  62. {(0@( 1@( {(0@: 1@: ;); (
  63.     @;(J'+=@&'Ez@1(('@[2]in'(Fz;Zz<)Z<>;J>);A:)JZDz<'/pob/poa/*a#'I1@['/+[b]a/pu[b]'I'C'@%Z>'[2]in'I;);
  64.     @;(J'+=@&'Ez@1(('@&[2]in'(Fz;Zz<)Z<>;J>);A:)JZDz<'poa/pob/lb[b]/xab/*a#'I1@['/+[b]a/pu[b]'I'C'@%Z>'[2]in'I;);
  65.     @;(J'-=@&'Ez@1(('@[2]in'(Fz;Zz<)Z<>;J>);A:)JZDz<'/pob/poa/*a#'I1@['/-[b]a/pu[b]'I'C'@%Z>'[2]in'I;);
  66.     @;(J'-=@&'Ez@1(('@&[2]in'(Fz;Zz<)Z<>;J>);A:)JZDz<'poa/pob/lb[b]/xab/*a#'I1@['/-[b]a/pu[b]'I'C'@%Z>'[2]in'I;);
  67.     @;(J {[vbl] ('@&'Ez@2'in@'Ez@2'in'Ez;) = ('@&'0@>;)}[vbl] JZDz<'/pob/poa'Iz<0@[@bZ>'/pua'I'C'@%Z>'[2]in'I;);
  68.     @;(J {[vbl] ('@&'Ez@2'in@&'Ez@2'in'Ez;) = ('@&'0@>;)}[vbl] JZDz<'/poa/pob/lb[b]/xab'Iz<0@[@bZ>'/pua'I'C'@%Z>'[2]in'I;);
  69.     @;(JJZD'can'I39%I't store'I;);
  70.   ;)} 0@) 1@)   nn$S nn$S;)} a
  71.  
  72. [code for assignment options]
  73. {((
  74.     (J'='EzJZD'/sa[b]'I;);
  75.     (J'+='EzJZD'/+a[b]/sa[b]'I;);
  76.     (J'-='EzJZD'/-a[b]/sa[b]'I;);
  77.   ;) ;)} b
  78.  
  79. [generic binary]
  80. {(0@( 1@( {(0@: 1@: ;); (
  81.     @;(J'-@'Ez@1(('@'(Fz;Zz<)Z<@1>;J>);A:)JZD'[2]in'Iz<'/poa/pob/div#'I1@['/pua'I'C'@%Z>;);
  82.     @;(J {[vbl] ('@[2]in@[2]in'Ez;) = ('@[2]in@[2]in'0@>;)}[vbl] JZD'[2]in'Iz<'/poa/pob'Iz<0@[@dZ>'C'@%Z>'/pua'I;);
  83.     @;(J {[vbl] ('@&[2]in@[2]in'Ez;) = ('@&[2]in@[2]in'0@>;)}[vbl] JZD'[2]in'Iz<'/pob/la[b]/pob'Iz<0@[@dZ>'/pua'I'C'@%Z>;);
  84.     @;(J {[vbl] ('@[2]in@&[2]in'Ez;) = ('@[2]in@&[2]in'0@>;)}[vbl] JZD'[2]in'Iz<'/poa/pob/lb[b]'Iz<0@[@dZ>'/pua'I'C'@%Z>;);
  85.     @;(J {[vbl] ('@&[2]in@&[2]in'Ez;) = ('@&[2]in@&[2]in'0@>;)}[vbl] JZD'[2]in'Iz<'/pob/la[b]/pob/lb[b]'Iz<0@[@dZ>'/pua'I'C'@%Z>;);
  86.   ;)} 0@) 1@)   nn$S nn$S;)} c
  87.  
  88. [code for binary options]
  89. {((
  90.     (J'+'EzJZD'/+ab'I;);
  91.     (J'-'EzJZD'/-ab'I;);
  92.     (J'*'EzJZD'/*ab'I;);
  93.   ;) ;)} d
  94.  
  95. [generic unary]
  96. {
  97.     ( [and] Z<( [or] Z<('+'Ez; J'-'Ez; J'!'Ez;>)> [or]  jJ><0@](A);>)> [and] ;) A
  98.     ( [and] Z<( [or] Z<('pri'Ez; J'prd'Ez; J'poi'Ez; J'pod'Ez;>)> [or]  jJ><0@](A);>)> [and] ;) B
  99.   (0@( 1@( {(0@: 1@: ;); (
  100.     @;(J'&@&'Ez0@]JZD0@[;);
  101.     @;(J'&'EzJZDz<'excess &'I'C'@%Z>;);
  102.     @;(J'*@&*'Ez0@]JZD'&'I0@[z<'/pob/pu[b]'I'C'@%Z>;);
  103.     @;(J@A'@&[2]in'EzJZD'[2]in'Iz<'/pob/pu[b]'I'C'@%Z>z<z<0@[@fZ>'C'@%Z>;);
  104.     @;(J@B'@&[2]in'EzJZD'[2]in'Iz<z<0@[@fZ>'C'@%Z>;);
  105.     @;(J@A'@[2]in'EzJZD'[2]in'Iz<z<0@[@fZ>'C'@%Z>;);
  106.     @;(J@B'@&*['Ez {[vbl] (']'Ez;) = (']'1@>;)}[vbl] JZD'[2]in'Iz<z<0@['@'I1@[@gZ>'C'@%Z>;);
  107.     @;(J@B'@&['Ez(('*'(Fz;Zz<)Z< {[vbl] (']'Ez;) = (']'1@>;)}[vbl] >;J>);A:)JZD'[2]in'Iz<z<0@['@'I1@[@gZ>'C'@%Z>;);
  108.     @;(J {[vbl] ('@[2]in'Ez;) = ('@[2]in'0@>;)}[vbl] JZD'[2]in'Iz<z<0@[@fZ>'C'@%Z>;);
  109.   ;)} 0@) 1@)   nn$S nn$S;)} e
  110.  
  111. [code for unary options]
  112. {((
  113.     (J'pri'EzJZD'/pob/i[b]/pu[b]'I;);
  114.     (J'prd'EzJZD'/pob/d[b]/pu[b]'I;);
  115.     (J'poi'EzJZD'/pob/pu[b]/i[b]'I;);
  116.     (J'pod'EzJZD'/pob/pu[b]/d[b]'I;);
  117.     (J'!'EzJZD'/poa/-a#1/sbb ax,ax/pua'I;);
  118.     (J'-'EzJZD'/poa/neg ax/pua'I;);
  119.     (J'~'EzJZD'/poa/not ax/pua'I;);
  120.   ;) ;)} f
  121.  
  122. [auto increment and decrement]
  123. {(0@( 1@( {(0@: 1@: ;); (
  124.     @;(J'pri@'Ez0@]JZD'/pob/la[b]/+a#'I0@['/sa[b]/pua'I;);
  125.     @;(J'prd@'Ez0@]JZD'/pob/la[b]/-a#'I0@['/sa[b]/pua'I;);
  126.     @;(J'poi@'Ez0@]JZD'/pob/la[b]/pua/+a#'I0@['/sa[b]'I;);
  127.     @;(J'pod@'Ez0@]JZD'/pob/la[b]/pua/-a#'I0@['/sa[b]'I;);
  128.   ;)} 0@) 1@)   nn$S nn$S;)} g
  129.  
  130. [assemble fetches]
  131. {(0@( 1@( {(0@: 1@: ;); (
  132.         @;(J' 'Ez {[vbl] (','Ez((' '(Fz;Zz<)Z< {[vbl] ( {[vbl] (','Ez;) = (1@<;)}[vbl] ;) = (0@<;)}[vbl] >;J>);A:);) = (0@<;)}[vbl] JZD'&'I1@[z<'/la#'I0@['/pua'I'C'@%Z>;);
  133.         @;(J' 'Ez {[vbl] (','Ez;) = (0@<;)}[vbl] JZD'&[2]int'Iz<'/la#'I0@['/pua'I'C'@%Z>;);
  134.   ;)} 0@) 1@)   nn$S nn$S;)} h
  135.  
  136. [assemble index]
  137. {(0@( 1@( {(0@: 1@: ;); (
  138.     @;(J'&[2]in@&['Ez(('*'(Fz;Zz<)Z< {[vbl] (']'Ez1@];) = (']'0@>;)}[vbl] >;J>);A:)JZD'&['I0@[']'I1@[z<'/pob/la[b]/pob/*a#'I0@['/+ba/pub'I'C'@%Z>;);
  139.     @;(J'[2]in@&['Ez(('*'(Fz;Zz<)Z< {[vbl] (']'Ez1@];) = (']'0@>;)}[vbl] >;J>);A:)JZD'&['I0@[']'I1@[z<'/poa/pob/*a#'I0@['/+ba/pub'I'C'@%Z>;);
  140.     @;(JJZD'not indexable'I;);
  141.   ;)} 0@) 1@)   nn$S nn$S;)} i
  142.  
  143. [assemble function]
  144. {(0@( 1@( {(0@: 1@: ;); (
  145.     @;(J'&()'Ez {[vbl] ('@'Ez;) = ('@'0@>;)}[vbl] JZD0@[z<'/pob/call [bx]'I'C'@%Z>;);
  146.   ;)} 0@) 1@)   nn$S nn$S;)} j
  147.  
  148. [option menu]
  149. {
  150.   [pointer weights]    ( [or] Z<('*'Ez [and] Z<('*'Ez jJ><1@](A);>)> [and] ; J'*['Ez {[vbl] (']'Ez;) = (']'1@>;)}[vbl] ; J'['Ez(('*'(Fz;Zz<)Z< {[vbl] (']'Ez;) = (']'1@>;)}[vbl] >;J>);A:);>)> [or] ;) 1
  151.   [pointer compatible]  ( [or] Z<('*'Ez((']'(Fz;Zz<)Z<>;J>);A:); J'[2]'Ez; J(('*2]'(Fz;Zz<)Z<>;J>);A:);>)> [or] ;) 2
  152.   (0@( 1@( 2@( 3@( {(0@: 1@: 2@: 3@: ;); (
  153.     @;(J';'EzJZD;);
  154.     @;(J':'Ez0@]JZDz<0@['C'@%Z>z<'R'@%Z>0@[;):
  155.     @;(J'/fetch'Ez {[vbl] (':prog:'Ez {[vbl] (':dict:'Ez2@];) = (':dict:'1@>;)}[vbl] ;) = (':prog:'0@>;)}[vbl] JZD'::prog:'Iz<0@[','I2@[@hZ>'@'I1@[':dict:'I2@[;):
  156.     @;(J'/define'Ez {[vbl] (':prog:'Ez {[vbl] (':dict:'Ez2@];) = (':dict:'1@>;)}[vbl] ;) = (':prog:'0@>;)}[vbl] JZD'::prog:'I1@[':dict:'I0@[2@[;):
  157.     @;(J'/assign 'Ez {[vbl] (':prog:'Ez {[vbl] ('@'Ez {[vbl] ('@'Ez3@];) = ('@'2@>;)}[vbl] ;) = ('@'1@>;)}[vbl] ;) = (':prog:'0@>;)}[vbl] JZD'::prog:'Iz<0@['@'I1@['@'I2@[@aZ>'@'I3@[;):
  158.     @;(J'/binary 'Ez {[vbl] (':prog:'Ez {[vbl] ('@'Ez {[vbl] ('@'Ez3@];) = ('@'2@>;)}[vbl] ;) = ('@'1@>;)}[vbl] ;) = (':prog:'0@>;)}[vbl] JZD'::prog:'Iz<0@['@'I1@['@'I2@[@cZ>'@'I3@[;):
  159.     @;(J'/unary 'Ez {[vbl] (':prog:'Ez {[vbl] ('@'Ez2@];) = ('@'1@>;)}[vbl] ;) = (':prog:'0@>;)}[vbl] JZD'::prog:'Iz<0@['@'I1@[@eZ>'@'I2@[;):
  160.     @;(J'/index:prog:'Ez {[vbl] ('@'Ez {[vbl] ('@'Ez2@];) = ('@'1@>;)}[vbl] ;) = ('@'0@>;)}[vbl] JZD'::prog:'Iz<0@['@'I1@[@iZ>'@'I2@[;):
  161.     @;(J'/function:prog:'Ez {[vbl] ('@'Ez {[vbl] ('@'Ez2@];) = ('@'1@>;)}[vbl] ;) = ('@'0@>;)}[vbl] JZD'::prog:'Iz<0@['@'I1@[@jZ>'@'I2@[;):
  162.     @;(J'/char'Ez0@]JZD'/define a[1]ch, b[1]ch, c[3*1]ch, d*[1]ch,'I0@[;):
  163.     @;(J'/int'Ez0@]JZD'/define i[2]in, j*[2]in, k[8*2]in, o**[8*3*2]in, l()[2]in,'I0@[;):
  164.     @;(J'/float'Ez0@]JZD'/define p[4]fl, q***[4]fl, r()[4]fl,'I0@[;):
  165.     @;(J'/clear'EzJZD'::prog:@'Iz<'|'@%Z>':dict:'I;):
  166.     @;(J((':prog:'(Fz;Zz<)Z<0@]>;J>);A:)JZDz<'nope'I'C'@%Z>'::prog:'I0@[;):
  167.   ;)} 0@) 1@) 2@) 3@)   nn$S nn$S nn$S nn$S;)} w
  168.  
  169. [main program]
  170. {((  
  171.     (JJZDz<z<'R'@%Z>':prog:@'Iz<'|'@%Z>':dict:'I@wZ>;);
  172.   ;) ;)} ~
  173. ('i'@%'D'@%'R'@%@~JZqt'c'@%;)  }
  174.  
  175. [end]
  176.