?login_element?

Subversion Repositories NedoOS

Rev

Rev 632 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1.  
  2.  
  3. ;
  4. ; cc2c.asm:
  5. ;
  6. ; This is the binary expression special case list interpreter
  7. ; for version 1.4:
  8. ;
  9.  
  10. spcash: push af
  11.         call spcs2
  12.         pop af
  13.         ret
  14.  
  15. spcs2:  lhld svv1       ;if INFO1 is the constant:
  16.         shld sr0        ;<constant value> into sr0
  17.         call cmh
  18.         shld sr2        ;-<constant value> into sr2
  19.         dec hl
  20.         shld sr4        ;-<constant value + 1> into sr4
  21.  
  22.         lda sval2
  23.         sta ssval
  24.         call tcnst2
  25.         jp nz,spcs2a
  26.         lhld svv2       ;if INFO2 is the constant:
  27.         shld sr0        ;<constant value> into sr0
  28.         shld svv1
  29.         call cmh
  30.         shld sr2        ;-<constant value> into sr2
  31.         dec hl
  32.         shld sr4        ;-<constant value + 1> into sr4
  33.         lda sval1
  34.         sta ssval
  35. spcs2a: ex de,hl
  36. spcs3:  ld a,(hl)
  37.         or a
  38.         ret z
  39.         sta key
  40.         ld b,a
  41.         inc hl
  42.         ld e,(hl)
  43.         inc hl
  44.         ld d,(hl)      
  45.         inc hl
  46.         ld c,0
  47.         and 7
  48.         cp 7
  49.         jp nz,spcs3a
  50.         push hl
  51.         call spcs2      ;perform a recursive list evaluation
  52.         pop hl
  53.         jp z,spcs3      ;if not match found in subordinate list, resume search
  54.         ret             ;else a match was found - done.
  55.        
  56. spcs3a: ex de,hl
  57.         shld spval
  58.         ex de,hl
  59.         ld e,(hl)
  60.         inc hl
  61.         ld d,(hl)
  62.         inc hl
  63.         ex de,hl
  64.         shld spmac
  65.         ex de,hl
  66.         and 7
  67.         dec a           ;key = 1?
  68.         jp nz,sptst2
  69.  
  70. sptry1: call tcnst1     ;yes.
  71.         jp z,sptr1a     ;fit template?
  72.         inc c           ;no-commutative?
  73.         ld a,b
  74.         and 20h
  75.         jp nz,sptry3    ;if so, go try key=3 case
  76.         jp spcs3        ;else no match yet
  77.  
  78. sptr1a: lda sval2       ;fits key=1 template if info2 in HL
  79.         and 0c0h
  80.         jp nz,spcs3
  81.         jp spfnd
  82.  
  83. sptst2: dec a           ;key = 2?
  84.         jp nz,sptst3
  85. sptry2: call tcnst1     ;yes.
  86.         jp z,sptr2a     ;fit template?
  87.         inc c           ;no. commutative?
  88.         ld a,b
  89.         and 20h
  90.         jp nz,sptry4    ;if so, try key=4      
  91.         jp spcs3        ;else no match
  92.  
  93. sptr2a: lda sval2       ;fits key=2 template if info2 in HL
  94.         and 0c0h
  95.         jp z,spcs3
  96.         jp spfnd
  97.  
  98. sptst3: dec a           ;key = 3?
  99.         jp nz,sptst4
  100. sptry3: call tcnst2     ;yes
  101.         jp nz,spcs3     ;no good unless info2 a constant
  102. sptr3a: lda sval1       ;OK, good only if info1 in HL  
  103.         and 0c0h
  104.         jp nz,spcs3
  105.         jp spfnd
  106.  
  107. sptst4: dec a           ;key = 4?
  108.         jp nz,sptst5
  109. sptry4: call tcnst2     ;yes
  110.         jp nz,spcs3     ;good only if info2 is a constant
  111. sptr4a: lda sval1       ;OK, good only if info1 in DE
  112.         and 0c0h
  113.         jp z,spcs3
  114.         jp spfnd
  115.  
  116. sptst5: push hl         ;set "constant value doesn't matter" flag
  117.         ld hl,5500h
  118.         shld spval      ;this is so no auto-lxi is done
  119.         pop hl
  120.         dec a
  121.         jp nz,sptst6    ;key = 5?
  122.         call tcnst1     ;yes. check to make sure there are no constants
  123.         jp z,spcs3
  124.         call tcnst2
  125.         jp z,spcs3
  126.         ld a,b          ;commutative?
  127.         and 20h
  128.         jp nz,spfnd     ;if so, we know enough to match
  129.         jp sptr3a       ;else go check to make sure info1 is in HL
  130.  
  131. sptst6: dec a           ;key = 6?
  132.         call nz,ierror  ;better be!
  133.         call tcnst1     ;make sure we have no constants
  134.         jp z,spcs3
  135.         call tcnst2
  136.         jp z,spcs3
  137.         jp sptr4a       ;if OK, make sure info1 is in DE
  138.  
  139. spfnd:  push hl
  140.         lhld spval
  141.         ld a,h
  142.         cp 55h          ;wild card constant test?
  143.         jp z,spgo               ;if so, don't bother to compare constant values
  144.         ex de,hl                ;no. must match value
  145.         lhld svv1
  146.         ld a,h
  147.         cp d
  148.         jp nz,spfnd1
  149.         ld a,l
  150.         cp e            ;all 16 bits match?
  151.         jp z,spgo               ;if so, go do the special case!
  152. spfnd1: pop hl          ;no good. go for more list searching
  153.         jp spcs3
  154.  
  155. spgo:   ld a,l          ;do we need to do an auto-lxi?
  156.         cp 55h
  157.         jp nz,spgo1     ;if not 55h, we DO NOT want to do it; else
  158.         ld de,mac04     ;yes. do either ld hl,sr0 or ld de,sr0
  159.         lda ssval
  160.         and 0c0h
  161.         jp nz,spgo0
  162.         ld de,mac4a
  163. spgo0:  call mcrog
  164. spgo1:  pop hl
  165.         lhld spmac      ;get the macro
  166.         ex de,hl
  167.         call mcrog      ;do it
  168.  
  169.         ld b,0          ;now set all the resultant infox attributes
  170.         lda key         ;register B will accumulate new sval1 value
  171.         ld c,a
  172.         and 8           ;result in a register?
  173.         jp z,spgo2
  174.         ld a,c          ;yes. if in DE, set b6 of reg B accordingly
  175.         or a
  176.         jp p,spgo2
  177.         ld b,40h
  178.  
  179. spgo2:  ld a,c
  180.         and 10h         ;result a flag?
  181.         jp z,spgo3
  182.         ld a,c          ;yes. set bmap1 and reg B (sval1) accordingly
  183.         rlca
  184.         rlca
  185.         and 3
  186.         sta sbmap1
  187.         ld b,4          ;this becomes sval1--a flag setting.
  188.  
  189. spgo2a: xor a  
  190.         sta indc1
  191.         sta typ1
  192.  
  193. spgo3:  ld a,c          ;result a constant?
  194.         and 18h
  195.         jp nz,spgo4
  196.         ld a,c          ;yes. FFFF?
  197.         and 0c0h
  198.         ld hl,0ffffh
  199.         cp 0c0h
  200.         jp z,spgo3a     ;if so, go set
  201.         inc hl          ;0000?
  202.         or a
  203.         jp z,spgo3a     ;if so, go set that
  204.         inc hl
  205.         cp 40h          ;0001?
  206.         call nz,ierror  ;if not, something's screwy in the state of confusion
  207. spgo3a: shld svv1
  208.         ld b,1
  209.  
  210. spgo4:  ld a,b          ;set new sval1
  211.         sta sval1
  212.         xor a           ;clear Z bit so we'll know we're done if this
  213.         inc a           ;is a recursive call to spcash
  214.         ret
  215.  
  216. ;
  217. ; The list structures representing all possible special cases of
  218. ; binary operators:
  219. ;
  220.  
  221. ;
  222. ; First define some common constant values:
  223. ;
  224.  
  225. r:      equ 8h          ;result in a register (key bit flag)
  226. f:      equ 10h         ;result is a flag (key bit flag)
  227. con0:   equ 0           ;result is constant value of 0
  228. con1:   equ 40h         ;result is constant value of 1
  229. conff:  equ 0c0h        ;result is constant value of FFFFh
  230. fz:     equ f+000h      ;result is Z flag set on true (Z true)
  231. fnz:    equ f+040h      ;result is Z flag reset on true (NZ true)
  232. fc:     equ f+080h      ;result is C flag set on true (C true)
  233. fnc:    equ f+0c0h      ;result is C flag reset on true (NC true)
  234. k:      equ 20h         ;operator is commutative
  235. rd:     equ r+80h       ;result in DE
  236. rh:     equ r+00h       ;result in HL
  237. endlst: equ 0           ;end of list or sub-list
  238.  
  239.                         ;wild-card constant value entries:
  240. dolxi:  equ 05555h      ;do auto-lxi of constant value into free register
  241. nolxi:  equ 05500h      ;wild card value, but no lxi
  242.  
  243. smadd:  db 1+rh+k
  244.         dw 0,mnul               ; + operator
  245.  
  246.         db 2+rd+k
  247.         dw 0,mnul
  248.  
  249.         db 1+rh
  250.         dw 1,macih1
  251.  
  252.         db 1+rh
  253.         dw 2,macih2
  254.  
  255.         db 1+rh
  256.         dw 3,macih3
  257.  
  258.         db 1+rh
  259.         dw 4,macih4
  260.  
  261.         db 1+rh
  262.         dw -1,macdh1
  263.  
  264.         db 1+rh
  265.         dw -2,macdh2
  266.  
  267.         db 1+rh
  268.         dw -3,macdh3
  269.  
  270.         db 1+rh
  271.         dw -4,macdh4
  272.  
  273.         db 2+rd
  274.         dw 1,macid1
  275.  
  276.         db 2+rd
  277.         dw 2,macid2
  278.  
  279.         db 2+rd
  280.         dw 3,macid3
  281.  
  282.         db 2+rd
  283.         dw 4,macid4
  284.  
  285.         db 2+rd
  286.         dw -1,macdd1
  287.  
  288.         db 2+rd
  289.         dw -2,macdd2
  290.  
  291.         db 2+rd
  292.         dw -3,macdd3
  293.  
  294.         db 2+rd
  295.         dw -4,macdd4
  296.  
  297.         db 1+rh+k
  298.         dw dolxi,mac0ca
  299.  
  300.         db 2+rh+k
  301.         dw dolxi,mac0ca
  302.  
  303.         db 5+rh+k
  304.         dw nolxi,mac0ca
  305.  
  306.         db endlst
  307.  
  308.  
  309. smsub:  db 1+rh
  310.         dw 0,mnul               ; - operator
  311.  
  312.         db 2+rd
  313.         dw 0,mnul
  314.  
  315.         db 3+rh
  316.         dw 0,maccom
  317.  
  318.         db 4+rd
  319.         dw 0,maccmd
  320.  
  321.         db 1+rh
  322.         dw 1,macdh1
  323.  
  324.         db 1+rh
  325.         dw 2,macdh2
  326.  
  327.         db 1+rh
  328.         dw 3,macdh3
  329.  
  330.         db 1+rh
  331.         dw 4,macdh4
  332.  
  333.         db 1+rh
  334.         dw -1,macih1
  335.  
  336.         db 1+rh
  337.         dw -2,macih2
  338.  
  339.         db 1+rh
  340.         dw -3,macih3
  341.  
  342.         db 1+rh
  343.         dw -4,macih4
  344.  
  345.         db 2+rd
  346.         dw 1,macdd1
  347.  
  348.         db 2+rd
  349.         dw 2,macdd2
  350.  
  351.         db 2+rd
  352.         dw 3,macdd3
  353.  
  354.         db 2+rd
  355.         dw 4,macdd4
  356.  
  357.         db 2+rd
  358.         dw -1,macid1
  359.  
  360.         db 2+rd
  361.         dw -2,macid2
  362.  
  363.         db 2+rd
  364.         dw -3,macid3
  365.  
  366.         db 2+rd
  367.         dw -4,macid4
  368.  
  369.         db 1+rh
  370.         dw nolxi,macsb1
  371.  
  372.         db 2+rh
  373.         dw nolxi,macsb2
  374.  
  375.         db 3+rh
  376.         dw dolxi,macsb3
  377.  
  378.         db 4+rh
  379.         dw dolxi,macsb4
  380.  
  381.         db 5+rh
  382.         dw nolxi,mcssbh
  383.  
  384.         db 6+rh
  385.         dw nolxi,mcssbd
  386.  
  387.         db endlst
  388.  
  389.  
  390. smmul:  db 1+con0+k
  391.         dw 0,mnul               ;common cases for both
  392.  
  393.         db 2+con0+k
  394.         dw 0,mnul               ;signed and unsigned
  395.  
  396.         db 1+rh+k
  397.         dw 1,mnul               ;multiplication
  398.  
  399.         db 2+rd+k
  400.         dw 1,mnul
  401.  
  402.         db 1+rh+k
  403.         dw -1,maccom
  404.  
  405.         db 2+rd+k
  406.         dw -1,maccmd
  407.  
  408.         db 1+rh+k
  409.         dw 2,mcddh1
  410.  
  411.         db 1+rh+k
  412.         dw 4,mcddh2
  413.  
  414.         db 1+rh+k
  415.         dw 8,mcddh3
  416.  
  417.         db 1+rh+k
  418.         dw 16,mcddh4
  419.  
  420.         db 2+rh+k
  421.         dw 2,mcddd1
  422.  
  423.         db 2+rh+k
  424.         dw 4,mcddd2
  425.  
  426.         db 2+rh+k
  427.         dw 8,mcddd3
  428.  
  429.         db 2+rh+k
  430.         dw 16,mcddd4
  431.  
  432.         db endlst
  433.  
  434.  
  435. smmulu: db 7   
  436.         dw smmul                ;unsigned *
  437.  
  438.         db 1+rh+k
  439.         dw dolxi,mcumul
  440.  
  441.         db 2+rh+k
  442.         dw dolxi,mcumul
  443.  
  444.         db 5+rh+k
  445.         dw nolxi,mcumul
  446.  
  447.         db endlst
  448.  
  449.  
  450. smmuls: db 7   
  451.         dw smmul                ;signed *
  452.  
  453.         db 1+rh+k
  454.         dw dolxi,mcsmul
  455.  
  456.         db 2+rh+k
  457.         dw dolxi,mcsmul
  458.  
  459.         db 5+rh+k
  460.         dw nolxi,mcsmul
  461.  
  462.         db endlst
  463.  
  464.  
  465. smdiv:  db 1+con0+k
  466.         dw 0,mnul               ;common cases for both
  467.  
  468.         db 2+con0+k
  469.         dw 0,mnul               ;signed and unsigned
  470.  
  471.         db 1+rh
  472.         dw 1,mnul               ;division
  473.  
  474.         db 2+rd
  475.         dw 1,mnul
  476.  
  477.         db 1+rh
  478.         dw -1,maccom
  479.  
  480.         db 1+rd
  481.         dw -1,maccmd
  482.  
  483.         db endlst
  484.  
  485.  
  486. smdivu: db 7   
  487.         dw smdiv                ; unsigned / operator
  488.  
  489.         db 1+rh
  490.         dw dolxi,mcdiv5
  491.  
  492.         db 2+rh
  493.         dw dolxi,mcudiv
  494.  
  495.         db 3+rh
  496.         dw dolxi,mcudiv
  497.  
  498.         db 4+rh
  499.         dw dolxi,mcdiv5
  500.  
  501.         db 5+rh
  502.         dw nolxi,mcudiv
  503.  
  504.         db 6+rh
  505.         dw nolxi,mcdiv5
  506.  
  507.         db endlst
  508.  
  509.  
  510. smdivs: db 7   
  511.         dw smdiv                ;signed / operator
  512.  
  513.         db 1+rh
  514.         dw dolxi,mcdiv7
  515.  
  516.         db 2+rh
  517.         dw dolxi,mcsdiv
  518.  
  519.         db 3+rh
  520.         dw dolxi,mcsdiv
  521.  
  522.         db 4+rh
  523.         dw dolxi,mcdiv7
  524.  
  525.         db 5+rh
  526.         dw nolxi,mcsdiv
  527.  
  528.         db 6+rh
  529.         dw nolxi,mcdiv7
  530.  
  531.         db endlst
  532.  
  533.  
  534. smmod:  db 1+con0+k
  535.         dw 0,mnul               ;common % operator cases
  536.  
  537.         db 2+con0+k
  538.         dw 0,mnul
  539.  
  540.         db endlst
  541.  
  542.  
  543. smmodu: db 7   
  544.         dw smmod                ;unsigned % operator
  545.  
  546.         db 1+con0
  547.         dw 1,mnul
  548.  
  549.         db 2+con0
  550.         dw 1,mnul
  551.  
  552.         db 1+rh
  553.         dw dolxi,mcmod5
  554.  
  555.         db 2+rh
  556.         dw dolxi,mcumod
  557.  
  558.         db 3+rh
  559.         dw dolxi,mcumod
  560.  
  561.         db 4+rh
  562.         dw dolxi,mcmod5
  563.  
  564.         db 5+rh
  565.         dw nolxi,mcumod
  566.  
  567.         db 6+rh
  568.         dw nolxi,mcmod5
  569.  
  570.         db endlst
  571.  
  572.  
  573. smmods: db 7   
  574.         dw smmod                ;signed % operator
  575.  
  576.         db 1+rh
  577.         dw dolxi,mcmod7
  578.  
  579.         db 2+rh
  580.         dw dolxi,mcsmod
  581.  
  582.         db 3+rh
  583.         dw dolxi,mcsmod
  584.  
  585.         db 4+rh
  586.         dw dolxi,mcmod7
  587.  
  588.         db 5+rh
  589.         dw nolxi,mcsmod
  590.  
  591.         db 6+rh
  592.         dw nolxi,mcmod7
  593.  
  594.         db endlst
  595.  
  596.  
  597. smsr:   db 1+rh
  598.         dw 0,mnul               ; >> operator
  599.  
  600.         db 2+rd
  601.         dw 0,mnul
  602.  
  603.         db 1+rh
  604.         dw dolxi,macsrh
  605.  
  606.         db 2+rh
  607.         dw dolxi,macsrd
  608.  
  609.         db 3+rh
  610.         dw dolxi,macsrd
  611.  
  612.         db 4+rh
  613.         dw dolxi,macsrh
  614.  
  615.         db 5+rh
  616.         dw nolxi,macsrd
  617.  
  618.         db 6+rh
  619.         dw nolxi,macsrh
  620.  
  621.         db endlst
  622.  
  623.  
  624. smsl:   db 1+rh
  625.         dw 0,mnul               ; << operator
  626.  
  627.         db 2+rd
  628.         dw 0,mnul
  629.  
  630.         db 1+rh
  631.         dw 1,mcddh1
  632.  
  633.         db 1+rh
  634.         dw 2,mcddh2
  635.  
  636.         db 1+rh
  637.         dw 3,mcddh3
  638.  
  639.         db 1+rh
  640.         dw 4,mcddh4
  641.  
  642.         db 1+rh
  643.         dw 5,mcddh5
  644.  
  645.         db 2+rh
  646.         dw 1,mcddd1
  647.  
  648.         db 2+rh
  649.         dw 2,mcddd2
  650.  
  651.         db 2+rh
  652.         dw 3,mcddd3
  653.  
  654.         db 2+rh
  655.         dw 4,mcddd4
  656.  
  657.         db 2+rh
  658.         dw 5,mcddd5
  659.  
  660.         db 1+rh
  661.         dw dolxi,macslh
  662.  
  663.         db 2+rh
  664.         dw dolxi,macsld
  665.  
  666.         db 3+rh
  667.         dw dolxi,macsld
  668.  
  669.         db 4+rh
  670.         dw dolxi,macslh
  671.  
  672.         db 5+rh
  673.         dw nolxi,macsld
  674.  
  675.         db 6+rh
  676.         dw nolxi,macslh
  677.  
  678.         db endlst
  679.  
  680.  
  681. smgtu:  db 1+fnz
  682.         dw 0,mcn10              ; unsigned ">" operator
  683.  
  684.         db 2+fnz
  685.         dw 0,macde0
  686.  
  687.         db 3+con0
  688.         dw 0,mnul
  689.  
  690.         db 4+con0
  691.         dw 0,mnul
  692.  
  693.         db 1+fc
  694.         dw nolxi,macsb5
  695.  
  696.         db 2+fc
  697.         dw nolxi,macsb6
  698.  
  699.         db 3+fnc       
  700.         dw nolxi,macsb1
  701.  
  702.         db 4+fnc       
  703.         dw nolxi,macsb2
  704.  
  705.         db 5+fc
  706.         dw nolxi,mcagbu
  707.  
  708.         db 6+fc
  709.         dw nolxi,mcbgau
  710.  
  711.         db endlst
  712.  
  713.  
  714. smgts:  db 1+fnc                ;signed ">" operator
  715.         dw -1,macrhl
  716.  
  717.         db 2+fnc       
  718.         dw -1,macrdl
  719.  
  720.         db 3+fc
  721.         dw 0,macrhl
  722.  
  723.         db 4+fc
  724.         dw 0,macrdl
  725.  
  726.         db 1+fc
  727.         dw dolxi,mcbgas
  728.  
  729.         db 2+fc
  730.         dw dolxi,mcagbs
  731.  
  732.         db 3+fc
  733.         dw dolxi,mcagbs
  734.  
  735.         db 4+fc
  736.         dw dolxi,mcbgas
  737.  
  738.         db 5+fc
  739.         dw nolxi,mcagbs
  740.  
  741.         db 6+fc
  742.         dw nolxi,mcbgas
  743.  
  744.         db endlst
  745.  
  746.  
  747. smltu:  db 1+con0               ;unsigned "<" operator
  748.         dw 0,mnul
  749.  
  750.         db 2+con0
  751.         dw 0,mnul
  752.  
  753.         db 3+fnz
  754.         dw 0,mcn10
  755.  
  756.         db 4+fnz
  757.         dw 0,macde0
  758.  
  759.         db 1+fnc       
  760.         dw nolxi,macsb1
  761.  
  762.         db 2+fnc       
  763.         dw nolxi,macsb2
  764.  
  765.         db 3+fc
  766.         dw nolxi,macsb5
  767.  
  768.         db 4+fc
  769.         dw nolxi,macsb6
  770.  
  771.         db 5+fc
  772.         dw nolxi,mcalbu
  773.  
  774.         db 6+fc
  775.         dw nolxi,mcblau
  776.  
  777.         db endlst
  778.  
  779.  
  780. smlts:  db 1+fc                 ;signed "<" operator
  781.         dw 0,macrhl
  782.  
  783.         db 2+fc
  784.         dw 0,macrdl
  785.  
  786.         db 3+fnc
  787.         dw -1,macrhl
  788.  
  789.         db 4+fnc
  790.         dw -1,macrdl
  791.  
  792.         db 1+fc
  793.         dw dolxi,mcblas
  794.  
  795.         db 2+fc
  796.         dw dolxi,mcalbs
  797.  
  798.         db 3+fc
  799.         dw dolxi,mcalbs
  800.  
  801.         db 4+fc
  802.         dw dolxi,mcblas
  803.  
  804.         db 5+fc
  805.         dw nolxi,mcalbs
  806.  
  807.         db 6+fc
  808.         dw nolxi,mcblas
  809.  
  810.         db endlst
  811.  
  812.  
  813. smeq:   db 1+fz+k
  814.         dw 0,mcn10              ; == operator
  815.  
  816.         db 2+fz+k
  817.         dw 0,macde0
  818.  
  819.         db 1+fz+k
  820.         dw 1,mache1
  821.  
  822.         db 1+fz+k
  823.         dw 2,mache2
  824.  
  825.         db 1+fz+k
  826.         dw 3,mache3
  827.  
  828.         db 1+fz+k
  829.         dw 4,mache4
  830.  
  831.         db 2+fz+k
  832.         dw 1,macde1
  833.  
  834.         db 2+fz+k
  835.         dw 2,macde2
  836.  
  837.         db 2+fz+k
  838.         dw 3,macde3
  839.  
  840.         db 2+fz+k
  841.         dw 4,macde4
  842.  
  843.         db 1+fz+k
  844.         dw -1,mchen1
  845.  
  846.         db 1+fz+k
  847.         dw -2,mchen2
  848.  
  849.         db 1+fz+k
  850.         dw -3,mchen3
  851.  
  852.         db 2+fz+k
  853.         dw -1,mcden1
  854.  
  855.         db 2+fz+k
  856.         dw -2,mcden2
  857.  
  858.         db 2+fz+k
  859.         dw -3,mcden3
  860.  
  861.         db 1+fz+k
  862.         dw nolxi,mcsb1a
  863.  
  864.         db 2+fz+k
  865.         dw nolxi,mcsb1b
  866.  
  867.         db 5+fz+k
  868.         dw nolxi,mceq
  869.  
  870.         db endlst
  871.  
  872.  
  873. smand:  db 1+con0+k
  874.         dw 0,mnul               ; & operator
  875.  
  876.         db 2+con0+k
  877.         dw 0,mnul
  878.  
  879.         db 1+rh+k
  880.         dw -1,mnul
  881.  
  882.         db 2+rd+k
  883.         dw -1,mnul
  884.  
  885.         db 1+rh+k
  886.         dw dolxi,mcand
  887.  
  888.         db 2+rh+k
  889.         dw dolxi,mcand
  890.  
  891.         db 5+rh+k
  892.         dw nolxi,mcand
  893.  
  894.         db endlst
  895.  
  896.  
  897. smor:   db 1+rh+k
  898.         dw 0,mnul               ; | operator
  899.  
  900.         db 2+rd+k
  901.         dw 0,mnul
  902.  
  903.         db 1+conff+k
  904.         dw -1,mnul     
  905.  
  906.         db 2+conff+k
  907.         dw -1,mnul
  908.  
  909.         db 1+rh+k
  910.         dw dolxi,mcor
  911.  
  912.         db 2+rh+k
  913.         dw dolxi,mcor
  914.  
  915.         db 5+rh+k
  916.         dw nolxi,mcor
  917.  
  918.         db endlst
  919.  
  920.  
  921. smxor:  db 1+rh+k
  922.         dw 0,mnul
  923.  
  924.         db 2+rd+k
  925.         dw 0,mnul
  926.  
  927.         db 1+rh+k
  928.         dw dolxi,mcxor
  929.  
  930.         db 2+rh+k
  931.         dw dolxi,mcxor
  932.  
  933.         db 5+rh+k
  934.         dw nolxi,mcxor
  935.  
  936.         db endlst
  937.  
  938.  
  939.  
  940.  
  941.  
  942. ;
  943. ; This routine returns Z true if both operands are chars,
  944. ; else returns not Z and clears the high order byte of
  945. ; any of the two operands which aren't chars:
  946. ;
  947.  
  948. chradj: call tschr      ;first operand a char?
  949.         jp nz,chrdj2
  950.         call tschr2     ;yes. 2nd?
  951.         ret z           ;if so, return Z true
  952.         ld de,mac61     ;else clear hi byte of HL
  953. chrdj1: call mcrog
  954.         xor a
  955.         inc a           ;and return Z false
  956.         ret
  957. chrdj2: call tschr2     ;2nd operand char?
  958.         ret nz          ;if not, done
  959.         ld de,mac62     ;if so, clear hi byte of DE
  960.         jp chrdj1
  961.  
  962.  
  963. parerr: ld de,stg18
  964.         jp perr
  965.  
  966. unsadj: call tptr
  967.         jp z,unsdj2
  968.         call tptr2
  969.         jp z,unsdj2
  970.         call tsval
  971.         ret nz
  972.         call tsval2
  973.         ret nz
  974.         lda typ1
  975.         cp 2
  976.         ret z
  977.         lda typ2
  978.         cp 2
  979.         ret nz
  980.         sta typ1
  981.         ret
  982.  
  983. unsdj2: xor a
  984.         ret
  985.  
  986. ;
  987. ; Routine to "pass over" a simple expression in text:
  988. ;
  989.  
  990. sexpas: call igsht
  991.         inc hl
  992.         cp mulcd        ;check for unary ops
  993.         jp z,sexpas
  994.         cp ancd
  995.         jp z,sexpas
  996.         cp mincd
  997.         jp z,sexpas
  998.         cp notcd
  999.         jp z,sexpas
  1000.         cp circum
  1001.         jp z,sexpas
  1002.         cp pplus
  1003.         jp z,sexpas
  1004.         cp mmin
  1005.         jp z,sexpas
  1006.         cp sizcd
  1007.         jp z,sexpas
  1008.         dec hl          ;else pass primary expr
  1009.         call ppas
  1010.         ret
  1011.  
  1012. ppas:   call sppas      ;pass simple primary expr
  1013.         ret c           ;abort if error
  1014. ppas2:  call igsht      ;check for primary ops
  1015.         cp open
  1016.         jp nz,ppas3
  1017. ppas2a: call mtchp
  1018.         jp ppas2
  1019.  
  1020. ppas3:  cp openb
  1021.         jp nz,ppas4
  1022.         call mtchb
  1023.         jp ppas2
  1024.  
  1025. ppas4:  inc hl
  1026.         cp arrow
  1027.         jp z,ppas5
  1028.         cp period
  1029.         jp z,ppas5
  1030.         cp pplus
  1031.         jp z,ppas2
  1032.         cp mmin
  1033.         jp z,ppas2
  1034.         dec hl          ;all done.
  1035.         scf
  1036.         ccf
  1037.         ret
  1038.  
  1039. ppas5:  call igsht
  1040.         cp varcd
  1041.         jp nz,ppase
  1042. ppas6:  inc hl
  1043.         inc hl
  1044.         inc hl
  1045.         jp ppas2
  1046.  
  1047. sppas:  cp open
  1048.         jp z,ppas2a
  1049.         cp strcd
  1050.         jp z,ppas6
  1051.         cp varcd
  1052.         jp z,ppas6
  1053.         cp concd
  1054.         jp z,ppas6
  1055.  
  1056. ppase:  ld de,stg10
  1057.         call perrsv
  1058.         scf
  1059.         ret
  1060.  
  1061.  
  1062.  
  1063. ;
  1064. ; Routine to "look ahead" past the current text, and
  1065. ; return the next non-space character, restoring old
  1066. ; text pointer and line count:
  1067. ;
  1068.  
  1069. looka:  push hl
  1070.         lhld nlcnt
  1071.         ex (sp),hl
  1072.         push hl
  1073.         inc hl
  1074.         call igsht
  1075.         pop hl
  1076.         ex (sp),hl
  1077.         shld nlcnt
  1078.         pop hl
  1079.         ret
  1080.  
  1081.  
  1082. domac:  ld a,c
  1083.         add a
  1084.         add a
  1085.         add a
  1086.         add b
  1087.         add b
  1088.         push hl
  1089.         ld hl,mact
  1090.         ld e,a
  1091.         ld d,0
  1092.         add hl,de
  1093.         ld e,(hl)
  1094.         inc hl
  1095.         ld d,(hl)
  1096.         call mcrog
  1097.         pop hl
  1098.         ret
  1099.  
  1100. aluadj: ld a,l
  1101.         or a
  1102.         ret nz
  1103.         ld a,h
  1104.         or a
  1105.         ret nz
  1106.         ld h,1
  1107.         ret
  1108.  
  1109.  
  1110. mult:   push bc
  1111.         push de
  1112.         ld b,h
  1113.         ld c,l
  1114.         lhld subval
  1115.         ex de,hl
  1116.         ld hl,0
  1117.  
  1118. mult1:  ld a,b
  1119.         or c
  1120.         jp z,mult2
  1121.         add hl,de
  1122.         dec bc
  1123.         jp mult1
  1124.  
  1125. mult2:  shld subval
  1126.         pop de
  1127.         pop bc
  1128.         ret
  1129.  
  1130. maddd:  ld a,d
  1131.         or a
  1132.         jp nz,maddd2
  1133.         ld a,e
  1134.         cp 4
  1135.         jp nc,maddd2
  1136. maddd1: ld a,d
  1137.         or e
  1138.         ret z
  1139.         ld a,23h
  1140.         call genb
  1141.         dec de
  1142.         jp maddd1
  1143.  
  1144. maddd2: ex de,hl
  1145.         shld sr0
  1146.         ex de,hl
  1147.         ld de,mac0c
  1148.         call mcrog
  1149.         ret
  1150.  
  1151.  
  1152. ;
  1153. ; Return Z set if keyword in A is a binary operator:
  1154. ;
  1155.  
  1156. binop:  ld b,15
  1157.         cp 0b6h
  1158.         ret z
  1159.         cp 0b7h
  1160.         ret z
  1161.         cp 0b8h
  1162.         ret z
  1163.         dec b
  1164.         cp 0c4h
  1165.         ret z
  1166.         cp 0b5h
  1167.         ret z
  1168.         dec b
  1169.         cp 0b0h
  1170.         ret z
  1171.         cp 0b1h
  1172.         ret z
  1173.         dec b
  1174.         cp 0bah
  1175.         ret z
  1176.         cp 0b9h
  1177.         ret z
  1178.         cp 0afh
  1179.         ret z
  1180.         cp 0aeh
  1181.         ret z
  1182.         dec b
  1183.         cp 0aah
  1184.         ret z
  1185.         cp 0abh
  1186.         ret z
  1187.         dec b
  1188.         cp 0bbh
  1189.         ret z
  1190.         dec b
  1191.         cp 0bch
  1192.         ret z
  1193.         dec b
  1194.         cp 0bdh
  1195.         ret z
  1196.         dec b
  1197.         cp 0ach
  1198.         ret z
  1199.         dec b
  1200.         cp 0adh
  1201.         ret
  1202.  
  1203. ;
  1204. ; Return Z if keyword in A is logical binary op (&& or ||):
  1205. ;
  1206.  
  1207. lbinop: cp oror
  1208.         ret z
  1209.         cp andand
  1210.         ret
  1211.  
  1212. ;
  1213. ; Return Z if keyword is ++ or --:
  1214. ;
  1215.  
  1216. ppormm: cp pplus
  1217.         ret z
  1218.         cp mmin
  1219.         ret
  1220.  
  1221. ;
  1222. ; Return Z if keyword in A is asignment operator:
  1223. ;
  1224.  
  1225.  
  1226. asgnop: cp 0beh
  1227.         ret z
  1228.         cp 0a0h
  1229.         ret c
  1230.         cp 0ach
  1231.         ccf
  1232.         ret
  1233.  
  1234. cnvsop: sub 0a0h
  1235.         push hl
  1236.         push de
  1237.         ld hl,sopt
  1238.         ld e,a
  1239.         ld d,0
  1240.         add hl,de
  1241.         ld a,(hl)
  1242.         pop de
  1243.         pop hl
  1244.         ret
  1245.  
  1246. sopt:   db 0c4h,0b5h,0b6h,0b7h,0b8h
  1247.         db 0b1h,0b0h,0bbh,0bch,0bdh
  1248.  
  1249. primop: cp open
  1250.         ret z
  1251.         cp openb
  1252.         ret z
  1253.         cp arrow
  1254.         ret z
  1255.         cp period
  1256.         ret
  1257.  
  1258. prmop2: call primop
  1259.         ret z
  1260.         cp pplus
  1261.         ret z
  1262.         cp mmin
  1263.         ret
  1264.  
  1265. ;
  1266. ; Handle a binary expression, with HL pointing to the first arg:
  1267. ;
  1268.  
  1269. lcflag: ds 1            ;controls optimizing for constant logical subexpr.
  1270.                         ;=10h when no lbinop activity,
  1271.                         ;=20h when pending next (noted) lbinop result
  1272.                         ;b6 hi when abs logical value of binexp determined
  1273.                         ;if b6 true, b7 is: 1 for TRUE, 0 for FALSE
  1274.  
  1275. lflag:  ds 1            ;true if &&/|| expression
  1276.  
  1277. bexpr:  lda codflg
  1278.         push af
  1279.         lda arith
  1280.         push af
  1281.         ld a,10h        ;initialize lcflag to: "no activity"
  1282.         sta lcflag
  1283.         xor a
  1284.         sta arith
  1285.         sta lflag
  1286. bxpr00: call rpshp
  1287. bxpr0:  xor a
  1288.         call oppsh
  1289.         call sexpasl
  1290.         push hl
  1291.         lhld ltabp
  1292.         cp andand       ; Do special ltab hackery if NEXT operator is || or &&
  1293.         jp nz,bxpr0a    ;&& operator?
  1294.         push hl         ;yes. propogate last false branch table label,
  1295.         dec hl          ;add new true label
  1296.         dec hl
  1297.         ld d,(hl)
  1298.         dec hl
  1299.         ld e,(hl)
  1300.         pop hl
  1301.         push de
  1302.         ex de,hl
  1303.         call glbl
  1304.         ex de,hl
  1305.         ld (hl),e
  1306.         inc hl
  1307.         ld (hl),d
  1308.         inc hl
  1309.         pop de
  1310.         jp bxpr0b
  1311.  
  1312. bxpr0a: cp oror
  1313.         jp nz,bxpr0c    ;|| operator?
  1314.         push hl         ;yes. propogate last true branch table label,  
  1315.         ld de,-5        ;add new false label.
  1316.         add hl,de
  1317.         ld e,(hl)
  1318.         inc hl
  1319.         ld d,(hl)
  1320.         pop hl
  1321.         ld (hl),e
  1322.         inc hl
  1323.         ld (hl),d
  1324.         inc hl
  1325.         ex de,hl
  1326.         call glbl
  1327.         ex de,hl
  1328. bxpr0b: ld (hl),e
  1329.         inc hl
  1330.         ld (hl),d
  1331.         inc hl
  1332.         inc hl
  1333.         shld ltabp
  1334.  
  1335.         lda lcflag      ;first activity?
  1336.         cp 10h
  1337.         jp nz,bxpr0c    ;if not, don't change this here
  1338.         ld a,20h        ;if not, prime for some activity
  1339.         sta lcflag     
  1340.  
  1341. bxpr0c: pop hl
  1342.  
  1343.         lda value
  1344.         push af
  1345.  
  1346.         lda arith
  1347.         push af
  1348.         or a            ;was arith set?
  1349.         call nz,ltabmp  ;if so, bump ltable to keep branches local...
  1350.  
  1351.         lda lcflag      ;save logical constant flag
  1352.         push af
  1353.         lda lflag       ;save logical expression flag
  1354.         push af
  1355.  
  1356.         xor a
  1357.         call sgenv      ;evaluate the operand.
  1358.  
  1359.         pop af
  1360.         sta lflag       ;restore logical expr flag
  1361.  
  1362.         pop af          ;get old lcflag in A
  1363.         ld b,a          ;save in B
  1364.         or a            ;was old lcflag cleared?
  1365.         jp z,lchck1     ;if so, keep it that way.
  1366.         and 30h         ;was it primed or inactive?
  1367.         ld a,b
  1368.         jp nz,lchck2    ;if so, let newer one be propogated
  1369.                         ;else...
  1370. lchck1: sta lcflag      ;restore logical constant flag
  1371.  
  1372. lchck2: pop af
  1373.         sta arith
  1374.  
  1375.         pop af
  1376.         or a
  1377.         jp z,bxpr1
  1378.         sta value       ;logical `or' "value" with old "value"
  1379.  
  1380. bxpr1:  lda arith       ;was last term preceded by arith operator?
  1381.         or a
  1382.         jp z,bxpr1a     ;if not, don't clean up
  1383.         xor a           ;yes; reset arith flag
  1384.         sta arith
  1385.         call ltabtd     ;define all possible branches as here
  1386.         call ltabfd
  1387.         call ltabpp     ;clean up branch table
  1388.         pop af          ;and restore old value of val
  1389.         sta val
  1390.  
  1391. bxpr1a: call oppops
  1392.  
  1393. bxpr2:  ld a,(hl)      
  1394.         call binop      ;next thing in text a binary op?
  1395.         jp z,bxpr4
  1396.  
  1397. bxpr3:  call tstops     ;no. any old ops on stack?
  1398.         jp z,bxpr9
  1399.                         ;yes. generate operations.
  1400.         call ppshp
  1401.         call oppop     
  1402.         call ppn2
  1403.         call alugen
  1404.         jp bxpr3
  1405.  
  1406. bxpr4:  call tstops     ;ok, we have a new binop to process.
  1407.         jp nz,bxpr7     ;any old stuff on stack?
  1408.         ld a,(hl)               ;no. Let's handle && and || specially...
  1409.         cp andand       ; && operator?
  1410.         jp nz,bxpr5
  1411.         sta lflag       ;set, set logical expression flag
  1412.         call ppshp
  1413.  
  1414.         lda lcflag      ;see if it's OK to check for constants
  1415.         and 0f0h
  1416.         jp z,bxpr4a     ;only test for constants if lcflag cooperates.
  1417.  
  1418.         call tcnst1     ;was arg a constant?
  1419.         jp z,bxpr40
  1420.         lda lcflag      ;if not, clear lcflag if not already finalized
  1421.         and 0c0h
  1422.         sta lcflag
  1423.         jp bxpr4a
  1424.  
  1425. bxpr40: lda lcflag      ;was lcflag primed?
  1426.         cp 20h
  1427.         jp nz,bxpr41
  1428.         ld a,10h        ;if so, un-prime in case we don't score the right
  1429.         sta lcflag      ;polarity on this constant.
  1430.  
  1431. bxpr41: call tcnsz      ;we have a constant. zero?
  1432.         jp nz,bxpr4b    ;if not, skip the cond'l jump, but keep evaluating
  1433. bxpr42: xor a           ;yes...
  1434.         sta codflg      ; don't bother generating any more code for the bexpr
  1435.         ld a,40h
  1436.         sta lcflag      ;set logical constant flag to "yes, false"
  1437.         jp bxpr4b
  1438.  
  1439. bxpr4a: lda val
  1440.         cp 81h          ;if must force value, do it:
  1441.         call z,lv01th   ; get 0 or 1 into HL, no matter WHAT.
  1442.         call gncjf      ;generate conditional jump on false
  1443. bxpr4b: call ltabtd
  1444.         call ltabfo
  1445.         jp bxpr5c
  1446.  
  1447. bxpr5:  cp oror
  1448.         jp nz,bxpr6     ; || operator?
  1449.         sta lflag       ;yes, set logical expression flag
  1450.         call ppshp
  1451.  
  1452.         lda lcflag      ;see if it's OK to check for constants
  1453.         and 0f0h
  1454.         jp z,bxpr5a     ;only test for constants if lcflag cooperates.
  1455.  
  1456.         call tcnst1     ;was arg a constant?
  1457.         jp z,bxpr50
  1458.         lda lcflag      ;if not, clear lcflag if not already finalized
  1459.         and 0c0h
  1460.         sta lcflag
  1461.         jp bxpr5a
  1462.  
  1463. bxpr50: lda lcflag      ;was lcflag primed?
  1464.         cp 20h
  1465.         jp nz,bxpr51
  1466.         ld a,10h        ;if so, un-prime in case we don't score the right
  1467.         sta lcflag      ;polarity on this constant.
  1468.  
  1469. bxpr51: call tcnsz      ;we have a constant. zero?
  1470.         jp z,bxpr5b     ;if so, skip the cond'l jump, but keep evaluating
  1471.  
  1472.         xor a           ;no...thus true, so
  1473.         sta codflg      ;don't bother generating any more code for the bexpr
  1474.         ld a,0c0h       ;set logical constant flag to "yes, true"
  1475.         sta lcflag
  1476.         jp bxpr5b
  1477.  
  1478. bxpr5a: lda val
  1479.         cp 81h          ;if must force value, do it:
  1480.         call z,lv01th   ; get 0 or 1 in HL no matter WHAT.
  1481.         call gncjt      ;generate conditional jump on true
  1482. bxpr5b: call ltabfd
  1483.         call ltabto
  1484.  
  1485. bxpr5c: call ltabpp
  1486.         inc hl
  1487.         jp bxpr00
  1488.  
  1489. tcnsz:  lda sval1       ;set Z flag if constant value of zero
  1490.         and 1
  1491.         jp z,invrt      ;if not absolute constant, not value of zero
  1492.         push hl         ;save text pointer
  1493.         lhld svv1
  1494.         ld a,h
  1495.         or l
  1496.         pop hl          ;now Z set if zero value
  1497.         ret
  1498.  
  1499.  
  1500. bxpr6:  lda sval1       ;if logical bit set, turn it into actual value here
  1501.         and 4           ;so stuff like: " <Bang>kbhit() & a<5 " works.
  1502.         call nz,cvtlvh
  1503.  
  1504.         lda val
  1505.         cp 81h          ;if must force value, do it:
  1506.         call z,cvtlvh   ; make sure flag settings turn into values in HL
  1507.  
  1508.         call tcnst1
  1509.         call nz,spshp
  1510.         call z,rpshp
  1511.         call pshn1
  1512.         ld a,(hl)
  1513.         call oppsh
  1514.         inc hl
  1515.  
  1516.         call igsht      ;next term a complex expression in parens?
  1517.         cp open
  1518.         jp nz,bxpr0
  1519.  
  1520.         lda val         ;if so, assume it needs complete evaluation
  1521.         push af
  1522.         ld a,81h        ;force value result
  1523.         sta val
  1524.         ld a,1          ;set arith mode while evaluating
  1525.         sta arith       ;   next operand of binary op,
  1526.         jp bxpr0        ;and go evaluate next arg
  1527.  
  1528. bxpr7:  call oppop
  1529.         call oppsh
  1530.         ld c,b
  1531.         call binop
  1532.  
  1533.         push de
  1534.         ld de,stgbbo
  1535.         call nz,perrab  ;no other operators; better be '|'
  1536.         pop de
  1537.  
  1538.         ld a,c
  1539.         cp b
  1540.         jp z,bxpr8
  1541.         jp nc,bxpr6
  1542.  
  1543. bxpr8:  call ppshp
  1544.         call oppop
  1545.         call ppn2
  1546.         call alugen
  1547.         jp bxpr2
  1548.  
  1549. bxpr9:  call ppshp
  1550.         lda val         ;absolutely need a value?
  1551.         cp 81h
  1552.         jp nz,bxpr90
  1553.  
  1554.         lda lflag       ;was it a logical expression (with && and ||) ?
  1555.         or a
  1556.         jp z,bxpr91
  1557.         call lv01th     ;if so, go convert into 0 or 1 in HL, no matter WHAT
  1558.         jp bxpr90
  1559.  
  1560. bxpr91: call cvtlvh     ;else just flush logical flag values into HL
  1561.  
  1562. bxpr90: pop af
  1563.         sta arith       ;restore arith flag
  1564.         pop af
  1565.         sta codflg      ;restore code flag.
  1566.         lda lcflag      ;result a logical constant?
  1567.         and 0c0h
  1568.         jp z,bxpr9b     ;if not, don't create constant return value
  1569.  
  1570.         or a            ;set Z flag if constant of 0
  1571.         ld a,1
  1572.         sta sval1       ;yes--set constant flag
  1573.         push hl
  1574.         ld hl,0         ;constant value of zero?
  1575.         jp p,bxpr9a     ;if so, go store
  1576.         inc hl          ;else make it 1
  1577. bxpr9a: shld svv1
  1578.         pop hl
  1579.  
  1580. bxpr9b: pop af
  1581.         cp 2
  1582.         ret nz
  1583.         ld de,stg8
  1584.         jp perr
  1585.        
  1586. ;
  1587. ; This makes sure that the result of the current
  1588. ; expression is a hard value of 0 or 1 in HL, no matter WHAT.
  1589. ;
  1590.  
  1591. lv01th: lda sval1       ;logical flag?
  1592.         and 4
  1593.         jp nz,cvtlvh    ;if so, go convert
  1594.         lda sval1
  1595.         and 1           ;constant?
  1596.         jp z,lv01b
  1597.         push hl         ;yes. turn into 0 or 1 in HL
  1598.         lhld svv1
  1599.         ld a,h
  1600.         or l
  1601. lv01d:  ld hl,0
  1602.         jp z,lv01a
  1603.         inc hl
  1604. lv01a:  shld svv1
  1605.         pop hl
  1606.         call flshh1     ;flush constant into HL
  1607.         ret
  1608.  
  1609. lv01b:  lda sval1       ;not abs constant-is it rel lv?
  1610.         and 2
  1611.         jp z,lv01c
  1612.         ld a,1          ;if so, turn into constant equal to 0
  1613.         sta sval1
  1614.         push hl
  1615.         xor a           ;set Z to force constant value of 0
  1616.         jp lv01d        ;and go wrap up
  1617.  
  1618. lv01c:  lda sval1       ;not any kind of constant, so must be val in reg
  1619.         and 0c0h        ;in DE?
  1620.         jp z,lv01e
  1621.         ld de,macde0    ;yes. char?
  1622.         call tschr
  1623.         call nz,mcrog   ;if not, do 16-bit test
  1624.         ld de,mcn12
  1625.         call z,mcrog    ;else do 8-bit test
  1626.         jp lv01f        ;and go convert into HL value
  1627.  
  1628. lv01e:  ld de,mache0    ;value in HL. char?
  1629.         call tschr
  1630.         call nz,mcrog   ;if not, do 16-bit test
  1631.         ld de,mcn11
  1632.         call z,mcrog    ;else do 8-bit test
  1633.  
  1634. lv01f:  ld de,macf2     ;now convert NZ flag state into HL value
  1635.         call mcrog
  1636.         ld a,24h        ;set flag and value result
  1637.         sta sval1
  1638.         ld a,1          ;set flag value of NZ true
  1639.         sta sbmap1
  1640.         ret
  1641.  
  1642.  
  1643.  
  1644. ;
  1645. ; Process assignment expression, given HL -> left
  1646. ; element of assignment. This might be either a simple
  1647. ; assignment or an op= type assignment:
  1648. ;
  1649.  
  1650. aexpr:  call igsht      ;check for leading & or ++ or --, so that
  1651.         cp ancd ;some common invalid lvalues that can't be
  1652.         jp z,badlv      ;detected by analyz can be diagnosed properly.
  1653.         call ppormm     ;is it ++ or --?
  1654.         jp z,badlv      ;if so, bad lvalue
  1655.         cp varcd        ;a variable name?
  1656.         jp nz,aexpr0    ;if not, all done checking for special cases
  1657.         inc hl
  1658.         inc hl
  1659.         inc hl
  1660.         ld a,(hl)
  1661.         call ppormm     ;is it an expr of form foo++ or foo-- ?
  1662.         dec hl
  1663.         dec hl
  1664.         dec hl
  1665.         jp nz,aexpr0
  1666.  
  1667. badlv:  ld de,stg8b
  1668.         call perr
  1669.  
  1670. aexpr0: call rpshp
  1671.         ld a,2          ;generate address of left arg
  1672.         call sgenv
  1673.         call ppshp
  1674.         cp letcd        ; simple '=' assignment?
  1675.         jp z,aexpl      ;if so, go do it.
  1676.         call cnvsop     ;convert op= to just op
  1677.         push af ;and save the op for later
  1678.         lda sval1       ;no. abs const lvalue?
  1679.         and 1
  1680.         jp z,aexp0
  1681.         call glvcv      ;yes. get value of left operand
  1682.         call pshn1      ;save info on lvalue before it was indirected
  1683.         xor a
  1684.         sta sval1       ;after indirection, it's a simple value
  1685.         jp aexp2a
  1686.  
  1687. aexp0:  call flshh1     ;not abs const lvalue. flush into HL
  1688.         call pshn1
  1689.         call gpushh     ;gen. push instr. to save address of left arg
  1690.         call tsclv      ;test for char value. Is it?
  1691.         jp z,aexp2      ;if so, go do single byte indirection
  1692.  
  1693.         call maca0c     ;else do double byte indirection, perhaps RST'ed
  1694.         jp aexp2a
  1695.  
  1696. aexp2:  ld de,mac6e     ;if a char, just do "ld l,(hl)"
  1697.         call mcrog
  1698.  
  1699. aexp2a: call tslv       ;was left arg a simple lvalue?
  1700.         jp nz,aexp2b
  1701.         lda indc1       ;if so, de-bump indirection count
  1702.         dec a           ; (corresponding to the just-done indirection)
  1703.         sta indc1
  1704. aexp2b: call pshn1      ;save info on the left arg
  1705.         inc hl
  1706.         call spshp
  1707.         call evala
  1708.         call ppshp
  1709.         call ppn2       ;pop info on left arg
  1710.         pop af          ;get back the operator code
  1711.         call alugen     ;now perform the operation
  1712. aexp3:  call ppn2       ;peek at original lvalue info
  1713.         call pshn2
  1714.         lda sval2       ;was lvalue an abs lv const?
  1715.         and 10h
  1716.         jp nz,aexp3b    ;if so, don't pop or do ANYTHING messy.
  1717.  
  1718. aexp3a: call pn1ind     ;else make sure the alugen result is in DE
  1719.         call gpoph      ;gen 'pop hl' to get addr of left arg back in HL
  1720.  
  1721. aexp3b: call mvn12      ;and put the info on the left and right args into
  1722.         call ppn1       ;  info1 and info2, respectively
  1723.         jp letgen       ;and go generate the assignment code
  1724.  
  1725. aexpl:  call pshn1      ;come here to handle simple '=' operator
  1726.         inc hl
  1727.         lda sval1
  1728.         push af ;save info1 optimization byte
  1729.         call tcnst1
  1730.         call nz,spshp
  1731.         call z,rpshp
  1732.         call evala      ;evaluate rvalue
  1733.         call ppshp
  1734.         call tpshd
  1735.         jp nz,aexpl2
  1736.         pop af
  1737.         jp aexp3a
  1738.  
  1739. aexpl2: lda sval1
  1740.         and 2
  1741.         jp nz,aexpl3
  1742.         pop af
  1743.         jp aexp3b
  1744.  
  1745. aexpl3: pop af
  1746.         ld b,a          ;save left operand into in B
  1747.         and 3           ;left operand in a register?
  1748.         jp z,aexpl4
  1749.         call flshd1     ;no...flush right operand into DE
  1750.         jp aexp3b       ;and go process assignment
  1751.  
  1752. aexpl4: ld a,b          ;left operand in a register.
  1753.         and 0c0h        ;push the appropriate register on stack
  1754.         call z,gpushh
  1755.         call nz,gpushd
  1756.         call flshd1     ;evaluate right operand into DE
  1757.         call gpoph      ;pop left operand into HL
  1758.         call mvn12      ;set up for assignment processor
  1759.         call ppn1
  1760.         lda sval1       ;but force left operand data to indicate in HL
  1761.         and 3fh
  1762.         sta sval1
  1763.         jp letgen
  1764.  
  1765. evala:  lda val
  1766.         push af
  1767.         ld a,81h
  1768.         sta val
  1769.         call ltabmp     ;bump logical table to make sure we stay in this
  1770.         xor a           ;statement no matter what the (maybe) logical value is
  1771.         call expr2v
  1772.         call ltabtd     ;come here if true
  1773.         call ltabfd     ;and come here if false, too.
  1774.         call ltabpp     ;and pop ltab entry
  1775.         pop af
  1776.         sta val
  1777.         ret
  1778.  
  1779.  
  1780. letgen: call analyz     ;ok to assign to the lvalue given?
  1781.         lda asnokf
  1782.         or a
  1783.         jp nz,lg2
  1784. letbad: ld de,stg8b     ;no. error.
  1785.         call perr
  1786.         pop af
  1787.         ret
  1788.  
  1789. lg2:    push hl         ;yup. abs lvalue constant?
  1790.         lda sval1
  1791.         and 11h
  1792.         jp nz,palvc     ;if so, go handle
  1793.  
  1794.         lda sval1       ;no. relative lvalue constant?
  1795.         and 2
  1796.         jp nz,prlvc     ;if so, go handle that.
  1797.  
  1798.         lda sval2       ;OK, we have lvalue in HL, rvalue somewhere
  1799.         and 1           ;rvalue a constant?
  1800.         jp z,lgncon     ;if not, go handle
  1801.  
  1802.         call flshh1     ;OK, put lvalue into HL if it is in DE
  1803.  
  1804. lg3:    lda val         ;yes, rvalue is constant.
  1805.         or a
  1806.         jp nz,lg5               ;need result?
  1807.         call tsclv
  1808.         jp nz,lg4b      ;8 bit value?
  1809.         ld a,36h        ;yes. do "ld (hl),vaue"
  1810.         call genb
  1811.         lda svv2
  1812.         call genb
  1813.         jp lgdone
  1814.  
  1815. lg4b:   lhld svv2       ;16-bit value.
  1816.         ld a,h
  1817.         or l            ;zero special case?
  1818.         jp nz,lg4c
  1819.         ld de,macac1    ;yes.
  1820.         call mcrog
  1821.         jp lgdone
  1822.  
  1823. lg4c:   ld a,36h
  1824.         call genb      
  1825.         lda svv2
  1826.         call genb
  1827.         ld a,23h
  1828.         call genb
  1829.         ld a,36h
  1830.         call genb
  1831.         lda svv2+1
  1832.         call genb
  1833.         jp lgdone
  1834.  
  1835. lg5:    lhld svv2       ;we need value result.
  1836.         shld sr0
  1837.         call tsclv
  1838.         jp nz,lg5b
  1839.         ld a,1eh
  1840.         call genb
  1841.         lda svv2
  1842.         call genb
  1843.         ld a,73h
  1844.         call genb
  1845. lg5a:   ld a,40h        ;set result in DE flag
  1846.         sta sval1
  1847.         jp lgdone
  1848.  
  1849. lg5b:   ld de,macac3
  1850.         call mcrog
  1851.         jp lg5a
  1852.  
  1853. ;
  1854. ; Come here after all assignments have been done
  1855. ;
  1856.  
  1857. lgdone: call tslv
  1858.         jp nz,lgdn2
  1859.         lda indc1
  1860.         dec a
  1861.         sta indc1
  1862. lgdn2:  pop hl
  1863.         pop af
  1864.         call ckvok
  1865.         ret
  1866.  
  1867. ;
  1868. ; Handle assignment of value in DE to lvalue in HL:
  1869. ;
  1870.  
  1871. lgncon: call tsclv
  1872.         jp nz,lgnc5     ;char lvalue?
  1873.         ld a,73h        ;yes.
  1874.         call genb
  1875.         jp lg5a
  1876.  
  1877. lgnc5:  call tschr2     ;no. char rvalue?
  1878.         jp nz,lgnc6
  1879.         ld de,macac4    ;yes--so we're assigning a char to an int lvalue.
  1880.         lda val         ;need value result?
  1881.         or a
  1882.         jp z,lgnc5a
  1883.         ld de,macac5    ;if so, make sure high-order byte is zeroed in result
  1884. lgnc5a: call mcrog
  1885.         jp lg5a
  1886.  
  1887. lgnc6:  lda optimf
  1888.         and 8
  1889.         jp z,lgnc7
  1890.         ld a,0e7h       ;rst 4: ld (hl),e inc hl ld (hl),d
  1891.         call genb
  1892.         jp lg5a
  1893.  
  1894. lgnc7:  ld de,maca1
  1895.         call mcrog
  1896.         jp lg5a
  1897.  
  1898. ;
  1899. ; Assign to absolute lvalue constant location:
  1900. ;
  1901.  
  1902. palvc:  lhld svv1
  1903.         shld sr0
  1904.         lhld svv2
  1905.         shld sr1
  1906.         lda sval2       ;rvalue a constant?
  1907.         and 1
  1908.         jp z,palvcc
  1909.         lda val         ;yes.
  1910.         or a
  1911.         jp nz,palv3     ;need value result?
  1912.         call tsclv      ;no.
  1913.         jp nz,palv2     ;8-bit object?
  1914.         ld a,3eh        ;yes.
  1915.         call genb
  1916.         lda svv2
  1917.         call genb
  1918.         ld de,macacb
  1919.         call mcrog
  1920.         jp lgdone
  1921.  
  1922. palv2:  ld de,macacc    ;16-bit object.
  1923. palv2a: call mcrog
  1924.         xor a
  1925.         sta sval1       ;result in HL (if needed)
  1926.         jp lgdone
  1927.  
  1928. palv3:  call tsclv      ;need value result.
  1929.         jp nz,palv2
  1930.         ld a,1eh
  1931.         call genb
  1932.         lda svv2
  1933.         call genb
  1934. palv4:  ld a,7bh
  1935.         call genb
  1936.         ld de,macacb
  1937.         call mcrog
  1938.         jp lg5a
  1939.  
  1940. palvcc: call tsclv      ;rvalue is in a register.
  1941.         jp nz,plvc2     ;simple char lvalue?
  1942.         lda sval2       ;yes.
  1943.         and 0c0h
  1944.         jp nz,palv4     ;in HL?
  1945.         ld a,7dh        ;yes.
  1946.         call genb
  1947.         ld de,macacb
  1948.         jp palv2a
  1949.  
  1950. plvc2:  lda sval2       ;16-bit value. in HL?
  1951.         and 0c0h
  1952.         call nz,gexdehl ;go "ex de,hl" if not, to get value into HL
  1953.         call tschr2     ;simple char rvalue?
  1954.         jp nz,plvc3     ;if not, do 16-bit assignment normally
  1955.  
  1956.         ld a,26h        ;else clear H before assigning
  1957.         call genb
  1958.         xor a
  1959.         call genb
  1960.  
  1961. plvc3:  ld de,mac09     ;go perform assignment
  1962.         jp palv2a
  1963.        
  1964. ;
  1965. ; Assign to a relative lvalue (external or local) location:
  1966. ;
  1967.  
  1968. prlvc:  lda sval2
  1969.         and 1
  1970.         jp z,prlv2      ;constant rvalue?
  1971. prlv1:  call flshh1     ;yes. get value in HL
  1972.         jp lg3
  1973.  
  1974. prlv2:  lda sval1       ;no; rvalue in a reg. local lvalue?
  1975.         and 8
  1976.         jp nz,prlv3
  1977.         call pn2ind     ;yes. get value in DE
  1978.         call flshh1
  1979.         jp lgncon
  1980.  
  1981. prlv3:  lda sval2       ;must be external.
  1982.         and 0c0h
  1983.         ld a,0e5h       ;push rvalue.
  1984.         jp z,prlv4
  1985.         ld a,0d5h
  1986. prlv4:  call genb
  1987.         call flshh1     ;generate lvalue in HL
  1988.         ld a,0d1h       ;get back rvalue in DE
  1989.         call genb
  1990.         ld a,40h        ;result in DE
  1991.         sta sval2
  1992.         jp lgncon       ;go perform assignment.
  1993.  
  1994. glvcv:  push hl
  1995.         lhld svv1
  1996.         shld sr0
  1997.         pop hl
  1998.         ld de,mac40
  1999.         call mcrog
  2000.         lda sval1
  2001.         and 0feh        ;no longer a simple lvalue constant
  2002.         or 10h          ;now a "has been" !
  2003.         sta sval1
  2004.         ret
  2005.  
  2006. ;
  2007. ; Gen code to multiply HL by value passed here in HL:
  2008. ;
  2009.  
  2010. gnmulh: shld sr0        ;save the value
  2011.         ld a,h
  2012.         or a            ;is it very big?
  2013.         jp nz,mulhbg    ;if so, go do brutal ld de,val- call mult- etc.
  2014.         ld a,l          ;yes.
  2015.         or a
  2016.         jp nz,gnmh2
  2017.         ld de,mac04     ;trivial case: ld hl,0
  2018.         call mcrog
  2019.         ret
  2020.  
  2021. gnmh2:  ld b,6          ;find out if we have an easy power of two.
  2022.         push af ;push value
  2023. gnmh2a: pop af          ;pop value
  2024.         rra             ;rotate right along with carry
  2025.         push af ;and immediately save to preserve carry bit
  2026.         or a            ;did we just rotate the only 1 bit into the carry?
  2027.         jp z,gnmh3      ;if so, we've got a power of 2 and can do "add hl,hl"'s
  2028.         dec b           ;else keep rotating
  2029.         jp nz,gnmh2a
  2030.         pop af          ;clean up stack...
  2031.  
  2032. mulhbg: ld de,mac0a     ;no simple power of two. use brute force.
  2033.         call mcrog
  2034.         ret
  2035.  
  2036. gnmh3:  pop af
  2037.         ld a,7          ;ok, we can use add hl,hl's. find out how many
  2038.         sub b           ;are needed.
  2039.         ld b,a          ;save 1+n in B.
  2040. gnmh4:  dec b
  2041.         ret z
  2042.         ld a,29h        ;and spit 'em out till done.
  2043.         call genb
  2044.         jp gnmh4
  2045.  
  2046.  
  2047. ;
  2048. ; process e1 ? e2 : e3
  2049. ; (upon entry, HL -> "?")
  2050. ;
  2051. ; New for v1.45 (fixing a bug...)
  2052. ; Take special care in the case of mixed character and non-character
  2053. ; values for e2 and e3, so 16 bit values don't get their high order
  2054. ; bytes chopped off.
  2055. ;
  2056.  
  2057. qexpr:  inc hl          ;get HL -> e2
  2058.         call gncjf      ;gen cond'l jump-on-false to e3
  2059.  
  2060.         call ltabtd     ;define $ as true branch of pre-? expr
  2061.                         ;               (fixes bug found by D. Greenlaw)
  2062.         pop af
  2063.         push af
  2064.         call rpshp
  2065.         call expr1
  2066.         call ppshp
  2067.         call flshh1
  2068.         call igsht
  2069.         cp colon        ;followed by colon?
  2070.         jp z,qxpr2
  2071.         call ltabpp
  2072. qxpr1:  ld de,stg14     ;if not, bad news.
  2073.         call perr
  2074.         pop de
  2075.         ret
  2076.  
  2077. qxpr2:  inc hl          ;colon found OK.
  2078.         call tschr      ;set Z if e2 is a character value
  2079.  
  2080.         pop bc          ;get item on top of stack
  2081.         push af ;save result of tschr test for later
  2082.         push bc         ;put top item back on the stack
  2083.  
  2084.         jp nz,qxpr2a    ;if e2 wasn't a char, don't bother clearing H
  2085.         ld de,mac61
  2086.         call mcrog      ;clear H if e2 is a char expression    
  2087.  
  2088. qxpr2a: pop af
  2089.         call gfjp       ;generate forward jump to after e3.
  2090.         push af
  2091.         call ltabfd     ;define false ltab branch
  2092.         call ltabpp     ;and pop off ltab entry
  2093.         call rpshp
  2094.         pop af 
  2095.  
  2096. ;       call    expr1   ;evaluate e3 ;??? why comment out???
  2097.  
  2098.         push af ;like the call above, except comma operator
  2099.         call expr2      ;recognition is not allowed due to precedence
  2100.         pop af          ;rules. This fixes a Dan Grayson bug.
  2101.  
  2102.         call ppshp
  2103.         call flshh1     ;get result in HL
  2104.  
  2105.         pop bc          ;get top item off stack (label code for plvdl)
  2106.         pop af          ;get back Z flag, set iff e2 was a char value
  2107.         push bc         ;put label code back onto stack
  2108.         jp z,qxpr3      ;if e2 was a char, we don't care if e3 is a char
  2109.                         ;otherwise we might have to promote e3, so let's check:
  2110.         call tschr      ;was e3 a char value?
  2111.         jp nz,qxpr3     ;if not, we don't have to worry about e2 being demoted
  2112.         ld de,mac61     ;else promote e3 to an int so that e2 won't be demoted
  2113.         call mcrog      ;       since e2 was a 16-bit value and e3 is a char.
  2114.         ld a,1          ;and make the overall result an int
  2115.         sta typ1
  2116. qxpr3:  call plvdl      ;and pop and define after-e3 label
  2117.         ret
  2118.  
  2119.         ;IF LASM
  2120.         ;link cc2d
  2121.         ;ENDIF
  2122.