home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 199.lha / Val.ASM < prev    next >
Encoding:
Assembly Source File  |  1988-12-27  |  11.7 KB  |  459 lines
  1.  
  2. ;*************************************************************
  3. ;   VAL - Jim Butterfield        December 12, 1988           ;
  4. ; Expression evaluator.              Run from CLI only.      ;
  5. ;*************************************************************
  6.  
  7. ;         Exec calls
  8. _LVOOpenLibrary   EQU -$0228
  9. _LVOCloseLibrary  EQU -$019e
  10. ;         DOS calls
  11. _LVOOutput        EQU -$003c
  12. _LVOWrite         EQU -$0030
  13.  
  14.  MOVE.L A0,A5               ; Pointer to text
  15.  LINK   A4,#-100            ; Gimme 100 bytes (Purity!)
  16.  
  17.  MOVE.L 4,A6                ; ExecBase
  18.  LEA    DosName(pc),A1      ; Where's DOS?
  19.  MOVEQ  #0,D0
  20.  JSR    _LVOOpenLibrary(A6)
  21.  MOVE.L D0,A6               ; DosBase
  22.  BEQ    No_DOS
  23.  
  24. ;Get Output Handle:
  25.  JSR    _LVOOutput(A6)
  26.  MOVE.L D0,-$10(A4)         ;OutHandle
  27.  BEQ    EXIT
  28.  
  29.  LEA -$18(A4),A3            ;numeric stack pointer
  30.  LEA -$40(A4),A2            ;operator stack pointer
  31.  
  32. ;Scan Command Tail:
  33.  MOVEQ  #0,D0               ;char buffer
  34.  MOVEQ  #0,D1               ;numeric analyzer
  35.  MOVEQ  #0,D2               ;modulo of input number
  36.  MOVEQ  #0,D3               ;value of input number
  37.  MOVE.L D3,-4(A4)           ;sign
  38.  MOVE.L D3,-8(A4)           ;no parens
  39.  MOVE.L A5,-$C(A4)          ;start-of-text pointer
  40.  MOVE.L D3,-$14(A4)         ;overflow flag
  41.  MOVE.W D3,-(A2)            ;end flag, operator stack
  42.  
  43.  
  44. ScanLoop:
  45.  MOVE.B (A5)+,D0            ;get character
  46.  CMP.B  #$3F,D0             ; '?' anywhere - send prompt
  47.  BEQ    Prompt
  48.  MOVE.B D0,D1               ;number slot
  49.  CMP.B  #$60,D0
  50.  BCS.S  SmallByte
  51.  SUB.B  #$20,D1             ;change lower to upper case
  52. SmallByte:
  53.  CMP.B  #$40,D1
  54.  BCS.S  SmallerByte
  55.  SUB.B  #$37,D1             ;change alpha to hex value
  56. SmallerByte:
  57.  CMP.B  #$3A,D0
  58.  BCC.S  BigByte
  59.  SUB.B  #$30,D1             ;change num to value
  60. BigByte:
  61.  CMP.B  #$10,D1             ;is it numeric/hex digit?
  62.  BCC.S  NotNum              ;  ... no, skip ahead
  63. ; We have found a digit!  Is it the first?
  64.  TST.B  D2                  ;Check if number in progress
  65.  BNE.S  ModuloSet           ; yes, continue
  66.  MOVEQ  #$A,D2              ; Set Decimal flag
  67. ModuloSet:
  68.  CMP.B  D1,D2               ; Digit within range (Dec/Hex?)
  69.  BCS    Over1               ; .. nope, holler
  70.  CMP.W  #$A,D2
  71.  BEQ.s  Decimal             ; If decimal, skip ahead
  72.  ASL.L  #3,D3               ;hex, times 8
  73.  BVS.S  Over1
  74.  ASL.L  #1,D3               ;hex, times 16
  75.  BRA.S  AddDigit
  76. Decimal:
  77.  ASL.L  #1,D3               ; Former value times 2
  78.  BCS.S  Over1
  79.  BMI.S  Over1
  80.  MOVE.L D3,D7               ; Save times2
  81.  ASL.L  #2,D3               ; Times 4, to make times8
  82.  BCS.S  Over1
  83.  ADD.L  D7,D3               ; times2+times8 gives times10
  84.  BCS.S  Over1
  85. AddDigit:
  86.  ADD.L  D1,D3               ; add in new digit
  87.  BCC.S  ScanLoop            ; On to next character
  88. Over1:
  89.  BRA.S  Oops
  90. ; If we reach the following code, we have discovered
  91. ;   a non-numeric character
  92. NotNum:
  93.  TST.B  D2                  ;number in progress?
  94.  BNE.S  SkipTrix            ;.. no, skip next tests
  95.  CMP.B  #45,D0              ;unary minus?
  96.  BNE.S  NotUM
  97.  MOVEQ  #-1,D7
  98.  MOVE.L D7,-4(A4)           ;set negative flag
  99. ScanLink:
  100.  BRA.S  ScanLoop
  101. NotUM:
  102.  CMP.B  #40,D0              ;left parens?
  103.  BNE.S  NotLP               ; .. no, keep looking
  104.  ADD.B  #$10,-8(A4)         ;yes, change hierarchy
  105.  BRA.S  ScanLoop
  106. NotLP:
  107.  CMP.B  #36,D0              ;dollars hex?
  108.  BNE.S  Oops                ; .. no, give up
  109. HexIt:
  110.  MOVEQ  #$10,D2             ; .. yes, change to hex
  111.  BRA.S  ScanLink
  112. ; Any '?' makes us print prompt message
  113. Prompt:
  114.  LEA    Format(pc),A0
  115.  MOVE.L A0,D2               ; Format message pointer
  116.  MOVEQ  #FormLen,D3
  117.  BRA.S  SayIt
  118. ; Parentheses not closed
  119. ParenWarn:
  120.  LEA    ParMsg(pc),A0
  121.  MOVE.L A0,D2               ; Bad parens message pointer
  122.  MOVEQ  #ParLen,D3
  123.  BRA.S  SayIt
  124. ; Overflow during calculation
  125. OverWarn:
  126.  LEA    OvMsg(pc),A0
  127.  MOVE.L A0,D2               ; Overflow message pointer
  128.  MOVEQ  #OvLen,D3
  129.  BRA.S  SayIt
  130. ; Problems.  Print input string up to glitch.
  131. Oops:
  132.  MOVE.B #$3F,(A5)+          ; Add '?',..
  133.  MOVE.B #$0A,(A5)+          ; ..NewLine
  134.  MOVE.L A5,D3               ; Current point
  135.  MOVE.L -$C(A4),D2          ; Start of input
  136.  SUB.L  D2,D3               ; Calc length
  137. SayIt:
  138.  MOVE.L -$10(A4),D1         ; OutHandle
  139.  JSR    _LVOWrite(A6)
  140.  BRA    EXIT
  141. ; Here, we have number in progress and
  142. ; .. non-numeric character
  143. SkipTrix:
  144.  CMP.B  #$21,D1             ; x?
  145.  BNE.S  NotX
  146.  TST.L  D3                  ; Hex if 0x...
  147.  BEQ.S  HexIt
  148. NotX:
  149.  CMP.B  #41,D0              ;close parens?
  150.  BNE.S  NotRP
  151.  SUB.B  #$10,-8(a4)         ;drop hierarchy
  152.  BPL.S  ScanLink
  153. OopsLink:
  154.  BRA.S  Oops                ; too far?
  155. ; Wrap up number, put on numeric stack
  156. NotRP:
  157.  TST.B  -4(A4)              ; negative?
  158.  BEQ.S  Positv              ; no, skip
  159.  MOVE.L D3,D7
  160.  MOVEQ  #0,D3
  161.  SUB.L  D7,D3
  162. Positv:
  163. ; put D3 to Numeric stack
  164.  MOVE.L D3,-(A3)
  165.  MOVEQ  #0,D2               ; clear modulo
  166.  MOVEQ  #0,D3               ; clear value
  167.  MOVE.L D2,-4(A4)           ; reset sign flag
  168. ; Look at Operator
  169.  LEA    Operators(pc),A0
  170.  MOVEQ  #0,D6               ; Operator index
  171.  MOVEQ  #1,D7               ; lowest level
  172.  CMP.B  #$20,D0             ; end of input string?
  173.  BCS.S  PutOper             ; .. yes, log it
  174.  CMP.B  #$5C,D0             ; Backslash symbol?
  175.  BNE.S  OpLoop
  176.  MOVE.B #$25,D0
  177. OpLoop:
  178.  CMP.B  0(A0,D6.W),D0
  179.  BEQ.S  OpFound
  180.  ADDQ.B #4,D6
  181.  CMP.B  #EndOps-Operators,D6
  182.  BNE.S  OpLoop
  183.  BRA.S  OopsLink
  184. OpFound:
  185.  MOVE.B 1(A0,D6.W),D7
  186.  ADD.B  -8(A4),D7
  187. ; Put the symbol on the stack.  But first,
  188. ; higher/equal level symbols must be squeezed out.
  189. PutOper:
  190.  CMP.B  (A2),D7             ; Check level
  191.  BHI.S  LeaveOper
  192.  ; Squeeze out previous operator
  193.  MOVEM.L D0/D1/D2/D6/D7,-(A7)
  194.  MOVE.B  (A2)+,D7           ; ignore level indicator
  195.  MOVE.B  (A2)+,D0           ; get op index
  196.  MOVE.L  (A3)+,D6           ;last numeric from stack
  197.  MOVE.L  (A3)+,D7           ; .. and previous
  198. ; go for the address, off D0
  199.  LEA     Subhead(pc),A1
  200.  MOVE.W  2(A0,D0.W),D1      ; here's the address
  201.  JSR     0(A1,D1.W)         ; go for it
  202.  
  203. ; Operation done.  Stack result, retest operator.
  204. PutBack:
  205.  MOVE.L  D7,-(A3)          ;result to numeric stack
  206.  MOVEM.L (A7)+,D0/D1/D2/D6/D7
  207.  BRA.S   PutOper
  208. ; Everything is pulled off the stack that needs it.
  209. ; Put new operator on stack, and its level.
  210. LeaveOper:
  211.  MOVE.B D6,-(A2)           ; Op pointer
  212.  MOVE.B D7,-(A2)           ; Op level
  213. MoreLoop:
  214.  CMP.B  #$20,D0            ; End of input (NewLine)?
  215.  BCC   ScanLoop
  216. Finish:
  217. ; -8(A4) Check to see all parens closed
  218.  MOVE.L -8(A4),D7          ; hierarchy
  219.  BNE    ParenWarn
  220. ; -$14(A4) Check if overflow
  221.  TST.B  -$14(A4)
  222.  BNE    OverWarn
  223. ; Print value on numeric stack
  224.  MOVE.L (A3)+,D7           ; stack value
  225.  MOVE.B #$20,D2            ; space if positive
  226.  MOVE.L D7,D6
  227.  BPL.S  PositR
  228.  MOVEQ  #0,D6
  229.  SUB.L  D7,D6
  230.  MOVE.B #$2D,D2            ; minus if negative
  231. PositR:
  232.  LEA    -$18(A4),A3
  233.  MOVE.L A3,-4(A4)          ; Mark this spot.
  234.  MOVEQ  #$20,D0            ; SPACE character..
  235.  MOVE.B D0,-(A3)           ; two at end
  236.  MOVE.B D0,-(A3)
  237. DecLoop:
  238.  MOVEQ  #0,D0              ;remainder
  239.  MOVEQ  #0,D1              ;shift count
  240. DivLoop:
  241.  ASL.L  #1,D6
  242.  ROXL.B #1,D0
  243.  CMP.B  #10,D0
  244.  BCS.s  DivCont
  245.  SUBI.B  #10,D0
  246.  BSET   #0,D6
  247. DivCont:
  248.  ADDQ.W #1,D1
  249.  CMP.B  #32,D1
  250.  BCS.s  DivLoop            ; 32 times
  251.  ORI.B  #$30,d0            ; here's the character
  252.  MOVE.B D0,-(A3)           ; stack it
  253. ; Check if anything left
  254.  TST.L  D6                 ; more characters?
  255.  BNE.s  DecLoop            ; .. yes, go get em
  256.  MOVE.B D2,-(A3)
  257. ; Number is stacked in A3 - print!
  258.  MOVE.L -4(A4),D3          ; end of string
  259.  SUB.L  A3,D3              ; buff len
  260.  MOVE.L A3,D2              ; buff add
  261.  MOVE.L -$10(A4),D1        ; file handle
  262.  JSR _LVOWrite(A6)
  263.  
  264. ; Now for hex...
  265.  MOVE.L -4(A4),A3          ; Restore A3
  266.  MOVEQ  #$0A,D6            ; RETURN at end
  267.  MOVE.B D6,-(A3)
  268. HexDig:
  269.  MOVE.B D7,D6
  270.  LSR.L  #4,D7              ; slide those bits
  271.  AND.B  #$0F,D6            ; slice four
  272.  ORI.B  #$30,D6            ; make it a number
  273.  CMP.B  #$3A,D6
  274.  BCS.S  NotAlf
  275.  ADD.B  #7,D6              ; ... or a letter
  276. NotAlf:
  277.  MOVE.B D6,-(A3)           ; stack it!
  278.  TST.L  D7                 ; any more?
  279.  BNE.s  HexDig             ; .. yes, get 'em
  280.  MOVEQ  #$24,D6            ; gimme a dollar (sign)
  281.  MOVE.B D6,-(A3)           ; stack the buck
  282. ; Hex number in A3 - print!
  283.  MOVE.L -4(A4),D3          ; end of string
  284.  SUB.L  A3,D3              ; buff len
  285.  MOVE.L A3,D2              ; buff add
  286.  MOVE.L -$10(A4),D1        ; file handle
  287.  JSR _LVOWrite(A6)
  288.  
  289. EXIT:
  290. ; Close DOS library.
  291.  
  292.  MOVE.L A6,A1              ; DosBase
  293.  MOVE.L 4,A6               ; ExecBase
  294.  JSR   _LVOCloseLibrary(A6)
  295. No_Dos:
  296.  UNLK A4                   ; Back to Stack
  297.  RTS
  298. SubHead:
  299. OrSub:
  300.  OR.L    D6,D7
  301.  RTS
  302. AndSub:
  303.  AND.L   D6,D7
  304.  RTS
  305. AddSub:
  306.  ADD.L   D6,D7
  307.  RTS
  308. SubSub:
  309.  SUB.L   D6,D7
  310.  RTS
  311. PowSub:
  312.  MOVE.L  D6,D1              ; power
  313.  MOVE.L  D7,D6              ; base
  314.  MOVEQ   #1,D7              ; start value
  315. PowLoop:
  316.  TST.B   D1                 ; power?
  317.  BEQ.S   PowExit            ; zero, done.
  318.  SUB.B   #1,D1              ; one less...
  319.  MOVE.L  D6,-(A7)
  320.  MOVE.L  D1,-(A7)
  321.  BSR.S   MultSub
  322.  MOVE.L  (A7)+,D1
  323.  MOVE.L  (A7)+,D6
  324.  BRA.S   PowLoop
  325. PowExit:
  326.  RTS
  327. ; Multiply subroutine:  32 bits x 32 bits signed
  328. ; D7 times D6; uses regs D1 and D2
  329. ; Result in D7
  330. MultSub:
  331.  MOVEQ   #0,D1              ; sign flag
  332.  TST.L   D7                 ; is Arg1 Positive?
  333.  BPL.S   Arg1Pos
  334.  MOVEQ   #0,D2
  335.  SUB.L   D7,D2
  336.  MOVE.L  D2,D7
  337.  MOVEQ   #1,D1
  338. Arg1Pos:
  339.  TST.L   D6
  340.  BPL.S   Arg2Pos            ; is Arg2 Positive?
  341.  MOVEQ   #0,D2
  342.  SUB.L   D6,D2
  343.  MOVE.L  D2,D6
  344.  EORI.B  #1,D1
  345. Arg2Pos:
  346.  MOVE.L  D7,D2              ; biggest val to D2
  347.  CMP.L   D6,D7
  348.  BCC.S   MultMain
  349.  MOVE.L  D6,D2
  350.  MOVE.L  D7,D6              ; smallest to D6
  351. MultMain:
  352.  MOVEQ   #0,D7              ; product area
  353. MultLoop:
  354.  LSR.L   #1,D6              ; multiplier to right!
  355.  BCC.S   NomAdd
  356.  ADD.L   D2,D7
  357.  BCS.S   Moverf
  358. NomAdd:
  359.  TST.L   D6
  360.  BEQ.S   MultDone
  361.  LSL.L   #1,D2              ; multiplicand to left!
  362.  BCC.S   MultLoop
  363. Moverf:
  364.  MOVE.B  #1,-$14(A4)        ; overflow
  365. ; How 'bout that sign?
  366. MultDone:
  367.  TST.L   D1                 ; product sign flag
  368.  BEQ.S   MultExit
  369.  MOVEQ   #0,D2
  370.  SUB.L   D7,D2
  371.  MOVE.L  D2,D7
  372. MultExit:
  373.  RTS
  374.  
  375. DivOver:
  376.  MOVE.B  #1,-$14(A4)
  377.  RTS
  378. ModSub:
  379.  MOVEQ   #0,D0      ;flags modulo
  380.  MOVE.L  D7,D1
  381.  BRA.S   DivJob
  382. DivSub:
  383.  MOVE.L  D7,D1
  384.  EOR.L   D6,D1
  385. DivJob:
  386.  TST.L   D6
  387.  BEQ.S   DivOver
  388.  BPL.S   Darg1Pos
  389.  MOVEQ   #0,D2
  390.  SUB.L   D6,D2
  391.  MOVE.L  D2,D6
  392. Darg1Pos:
  393.  TST.L   D7
  394.  BPL.S   Darg2Pos
  395.  MOVEQ   #0,D2
  396.  SUB.L   D7,D2
  397.  MOVE.L  D2,D7
  398. Darg2Pos:
  399.  MOVE.L  D1,-(A7)           ; Stack the sign
  400.  MOVEQ   #0,D2              ; Remainder
  401.  MOVEQ   #0,D1              ; Counter
  402. DivdLoop:
  403.  ASL.L  #1,D7
  404.  ROXL.L #1,D2
  405.  CMP.L  D6,D2
  406.  BCS.S  DivdCont
  407.  SUB.L  D6,D2
  408.  BSET   #0,D7
  409. DivdCont:
  410.  ADDQ.W #1,D1
  411.  CMP.B  #32,D1
  412.  BCS.S  DivdLoop           ; 32 times
  413.  MOVE.L (A7)+,D1           ; restore sign flag
  414.  TST.B   D0
  415.  BNE.S   NotModul
  416.  MOVE.L  D2,D7             ; slip remainder in
  417. NotModul:
  418.  TST.L   D1
  419.  BPL.S   ModEnd
  420.  MOVEQ   #0,D2
  421.  SUB.L   D7,D2
  422.  MOVE.L  D2,D7
  423. ModEnd:
  424.  RTS
  425.  
  426. ;                   |   &  +  -  *   %  /  ^
  427. Operators: DC.B   $7C,2
  428.            DC.W   OrSub-SubHead
  429.            DC.B   $26,3
  430.            DC.W   AndSub-SubHead
  431.            DC.B   43,4
  432.            DC.W   AddSub-SubHead
  433.            DC.B   45,4
  434.            DC.W   SubSub-SubHead
  435.            DC.B   42,5
  436.            DC.W   MultSub-SubHead
  437.            DC.B   $25,5
  438.            DC.W   ModSub-SubHead
  439.            DC.B   47,5
  440.            DC.W   DivSub-SubHead
  441.            DC.B   94,6
  442.            DC.W   PowSub-SubHead
  443. EndOps:
  444. DosName:   DC.B 'dos.library',0
  445. Format:    DC.B 'Format:  Val <expression>, e.g., 2+3*4',$a
  446. EndFormat: DC.B $20,$2A,$20,$4A,$69,$6D,$20,$42,$75,$74
  447. FormLen = EndFormat-Format
  448.           DC.B  $74,$65,$72,$66,$69,$65,$6C,$64,$20
  449.           DC.B  $44,$65,$63,$2F,$38,$38,$20,$2A,$20
  450.  
  451. OvMsg:    DC.B 'Overflow',$a
  452. EndOv:
  453. OvLen  = EndOv-OvMsg
  454. ParMsg:   DC.B 'Too many "("',$a
  455. EndPar:
  456. ParLen = EndPar-ParMsg
  457.  
  458.  END
  459.