home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / dpl.zip / EXPR.D < prev    next >
Text File  |  1988-07-12  |  11KB  |  444 lines
  1. ; Doug's Programming Language  -- DPL, Version 2.22
  2. ; Copyright (c) 1988 Douglas S. Cody, All rights reserved.
  3. ;-------------------------==============================-----------------------
  4. ;-------------------------==============================-----------------------
  5. ;-------------------------==============================-----------------------
  6. ;
  7. SUBPGM    EXPR
  8. ;
  9. ; EXPR - This subroutine performs "recursive decent parsing" on an
  10. ; algebraic formula to derive a 16 bit signed answer. The routine uses
  11. ; a subset of the hierarchy of operators from 'The "C" Programming
  12. ; Language', chapter 2, page 49.
  13. ;
  14. ; Entry Conditions:
  15. ;    AX points to an UPPERCASE string
  16. ; Exit Conditions:
  17. ;    CARRY SET    - bad formula
  18. ;            AX holds the error number
  19. ;            BX holds the character position of the bad token
  20. ;          CLEAR  - good formula
  21. ;            result in AX
  22. ;
  23. ; Possible Errors:
  24. ;
  25. _PARENERR    EQU    1    ; Unbalanced Parenthesis
  26. _BADVAL        EQU    2    ; Bad literal #
  27. _INVALID    EQU    3    ; invalid formal error
  28. ;
  29. ; local string storage for token extraction
  30. ;
  31. STRING        TOKEN,32    ; Holds the extracted string token
  32. TOKENTYPE    DB    0    ; Holds the token type
  33. ;
  34. _UNKTYPE        EQU    0    ; Illegal token type
  35. _DELIM            EQU    1    ; DELIMITER token type
  36. _NUMERIC        EQU    2    ; NUMERIC token type
  37. _VARIABLE        EQU    3    ; VARIABLE token type
  38. _FUNC            EQU    4    ; FUNCTION token type
  39. ;
  40. ; delimiter lists
  41. ;
  42. LLIST1    DB    0DH,' ',9,"+-*/%()",0    ; LLIST1 contains all delimiters
  43. LLIST2        EQU    LLIST1+3    ; LLIST2 doesn't include cr,tab,space
  44. L1SIZE        EQU    11        ; 11 delimiters
  45. L2SIZE        EQU     8        ;  8 delimiters
  46. ;
  47.     PUBLIC    SYMLOOK
  48. SYMLOOK    DW    0        ; Holds the address of a symbol lookup
  49. ;                ; function. This vector is supplied by
  50. ;                ; the user program. Functions & keywords
  51. ;                ; must be searched for by this routine.
  52. ;
  53. VARFUNC DW    0        ; Holds the vector/variable value returned
  54. ;                ; by SYMLOOK.
  55. ;
  56. ; The SYMLOOK routine must accept and return the following conditions:
  57. ;
  58. ; Entry Conditions:
  59. ;    DS:SI points to the TOKEN
  60. ; Exit Conditions:
  61. ;    AX,BX,CX,DX may be modified. No other registers may be changed
  62. ;    CARRY SET   - No match found, string undefined.
  63. ;          CLEAR - Match found, AX holds the value
  64. ;              BH holds the token type, _VARIABLE or _FUNC
  65. ;
  66. ;-------------------------==============================-----------------------
  67. ;-------------------------====< START OF EXECUTION >====-----------------------
  68. ;-------------------------==============================-----------------------
  69. ;
  70. BEGIN    EXPR
  71.     EXTRN    _DV1616:NEAR, _DEC:NEAR
  72.     PUSH    BP        ; SAVE THE INDEXES
  73.     PUSH    SI
  74.     PUSH    AX        ; SAVE A COPY OF THE STRING ADDRESS
  75.     MOV    BP,SP        ; IN CASE OF AN ERROR, WE CAN FLUSH THE STACK
  76.     MOV    SI,AX        ; SI POINTS TO THE STRING
  77. ;
  78.     CALL    GETTOKEN    ; PRIME THE PUMP, GET THE 1ST ELEMENT
  79.     CMP    [TOKEN],0    ; ANY EXPRESSION?
  80.     MOV    AX,_INVALID    ; (FIRST, LOAD THE ERROR NUMBER)
  81.     JZ    EXPR_ERR    ; YES, ITS NOT A VALID FORMULA
  82. ;
  83.     CALL    LEVEL1        ; GET THE FINAL RESULT
  84. ;
  85.     POP    BX        ; FLUSH THE STRING ADDRESS
  86.     POP    SI        ; RESTORE THE OTHERS
  87.     POP    BP
  88.     CLC
  89.     RET
  90. ;
  91. EXPR_ERR:
  92.     MOV    SP,BP        ; ERROR, FLUSH ALL & RETURN
  93.     MOV    BX,SI        ; BX POINTS TO THE STRING
  94.     POP    SI        ; GET THE ORIGINAL ADDRESS
  95.     SUB    BX,SI        ; BX HOLDS THE 0 BASED POINTER
  96.     DEC    BX
  97.     POP    SI
  98.     POP    BP
  99.     STC
  100.     RET
  101. ;
  102. ;
  103. ; L E V E L 1  --  PROCESS '=' '+=' '-=', ETC
  104. ;
  105. LEVEL1    PROC    NEAR
  106.     CALL    LEVEL11        ; NOT INCORPORATED YET
  107.     RET
  108.  
  109. LEVEL1    ENDP
  110. ;
  111. ;
  112. ; L E V E L 1 1  --  PROCESS '+' & '-' EQUATIONS
  113. ;
  114. ; Entry Conditions:
  115. ;    TOKEN holds the 1st term
  116. ;    SI points to the operator
  117. ; Exit Conditions:
  118. ;    Result in AX
  119. ;
  120. LEVEL11    PROC    NEAR
  121.     CALL    LEVEL12            ; PROCESS HIGHER PRECEDENCE OPERATORS
  122. ;
  123. L11_LOOP:
  124.     CMP    [TOKEN],'+'        ; ADDITION?
  125.     JZ    L11_ADD            ; YES, CONTINUE ON...
  126.     CMP    [TOKEN],'-'        ; SUBTRACTION?
  127.     JZ    L11_SUB            ; YES, CONTINUE ON...
  128.     RET                ; NO, ALL DONE
  129. ;
  130. L11_ADD:
  131.     CALL    L11_COMM        ; DO COMMON CODE
  132.     ADD    AX,BX            ; ADD TWO TERMS
  133.     JMP    SHORT L11_LOOP        ; CONTINUE TILL DONE
  134. ;
  135. L11_SUB:
  136.     CALL    L11_COMM
  137.     SUB    AX,BX            ; SUBTRACT TWO TERMS
  138.     JMP    SHORT L11_LOOP
  139. ;
  140. L11_COMM    PROC    NEAR
  141.     PUSH    AX            ; SAVE 1ST TERM
  142.     CALL    GETTOKEN        ; FETCH NEXT ELEMENT
  143.     CALL    LEVEL12            ; DO CHECK IT OUT
  144.     POP    BX
  145.     XCHG    AX,BX            ; STRAIGTHEN OUT THE ORDER
  146.     RET
  147. L11_COMM    ENDP
  148. LEVEL11        ENDP
  149. ;
  150. ;
  151. ; L E V E L 1 2  --  PROCESS '*' & '/' & '%' EQUATIONS
  152. ;
  153. ; Entry Conditions:
  154. ;    TOKEN holds the 1st term
  155. ;    SI points to the operator
  156. ; Exit Conditions:
  157. ;    Result in AX
  158. ;
  159. LEVEL12    PROC    NEAR
  160.     CALL    LEVEL13            ; PROCESS HIGHER PRECEDENCE OPERATORS
  161. ;
  162. L12_LOOP:
  163.     CMP    [TOKEN],'*'        ; MULTIPLICATION?
  164.     JZ    L12_MUL            ; YES, CONTINUE ON...
  165.     CMP    [TOKEN],'/'        ; DIVISION?
  166.     JZ    L12_DIV            ; YES, CONTINUE ON...
  167.     CMP    [TOKEN],'%'        ; MODULO DIVISION?
  168.     JZ    L12_MOD            ; YES, CONTINUE ON...
  169.     RET                ; NO, ALL DONE
  170. ;
  171. L12_MUL:
  172.     CALL    L12_COMM        ; DO COMMON CODE
  173.     IMUL    BX            ; MULTIPLY TWO TERMS
  174.     JMP    SHORT L12_LOOP        ; CONTINUE TILL DONE
  175. ;
  176. L12_DIV:
  177.     CALL    L12_COMM
  178.     CALL    _DV1616            ; DIVIDE TWO TERMS
  179. ;
  180. L12_DIVCOMM:
  181.     CMP    STATUS,0        ; GOOD?
  182.     JZ    L12_LOOP
  183.     SUB    AX,AX
  184.     JMP    SHORT L12_LOOP
  185. ;
  186. L12_MOD:
  187.     CALL    L12_COMM
  188.     CALL    _DV1616            ; DIVIDE TWO TERMS
  189.     MOV    AX,DX
  190.     JMP    SHORT L12_DIVCOMM
  191. ;
  192. L12_COMM    PROC    NEAR
  193.     PUSH    AX            ; SAVE 1ST TERM
  194.     CALL    GETTOKEN        ; FETCH NEXT ELEMENT
  195.     CALL    LEVEL13            ; DO CHECK IT OUT
  196.     POP    BX
  197.     XCHG    AX,BX            ; STRAIGTHEN OUT THE ORDER
  198.     RET
  199. L12_COMM    ENDP
  200. LEVEL12        ENDP
  201. ;
  202. ;
  203. ; L E V E L 1 3  --  PROCESS UNARY '+' & '-' TERMS
  204. ;
  205. ; Entry Conditions:
  206. ;    TOKEN holds the unary sign
  207. ;    SI points to the term
  208. ; Exit Conditions:
  209. ;    Result in AX
  210. ;
  211. LEVEL13    PROC    NEAR
  212.     CMP    [TOKEN],'+'        ; POSITIVE?
  213.     JZ    L13_UADD        ; YES, CONTINUE ON...
  214.     CMP    [TOKEN],'-'        ; NEGATIVE?
  215.     JZ    L13_USUB        ; YES, CONTINUE ON...
  216.     CALL    LEVEL14A        ; GO GET THE VALUE & RETUR IT
  217.     RET                ; NO, ALL DONE
  218. ;
  219. L13_UADD:
  220.     CALL    GETTOKEN        ; GET THE TERM
  221.     CALL    LEVEL14A        ; GET THE VALUE
  222.     RET                ; RETURN UNCHANGED
  223. ;
  224. L13_USUB:
  225.     CALL    GETTOKEN        ; GET THE TERM
  226.     CALL    LEVEL14A        ; GET THE BINARY VALUE
  227.     NEG    AX            ; INVERT 2 COMP.
  228.     RET
  229.  
  230. LEVEL13    ENDP
  231. ;
  232. ;
  233. ; L E V E L 1 4 A  --  PROCESS A FUNCTION TOKEN
  234. ;
  235. ; Entry Conditions:
  236. ;    SI points to the next term
  237. ; Exit Conditions:
  238. ;    Result in AX
  239. ;
  240. LEVEL14A    PROC    NEAR
  241.     CMP    [TOKENTYPE],_FUNC    ; START OF FUNCTION?
  242.     JZ    L14A_FUNC        ; YES, CONTINUE ON...
  243.     CALL    LEVEL14B        ; NO, GO GET THE # & RETURN IT
  244.     RET                ; RETURN WITH THE VALUE
  245. ;
  246. L14A_FUNC:
  247.     PUSH    [VARFUNC]        ; SAVE OUR VECTOR
  248.     CALL    GETTOKEN        ; GET THE NEXT TERM
  249.     CALL    LEVEL14B        ; GET THE #
  250. ;
  251. L14A_DOIT:
  252.     POP    BX            ; GET THE VECTOR
  253.     PUSH    SI            ; DO NOT DISTURB OUR POINTER
  254. ;
  255.     CALL    BX            ; & GO DO IT
  256. ;
  257.     POP    SI
  258.     RET                ; RETURN WITH NEW VALUE
  259.  
  260. LEVEL14A    ENDP
  261. ;
  262. ;
  263. ; L E V E L 1 4 B  --  PROCESS '(' & ')' OPERATORS
  264. ;
  265. ; Entry Conditions:
  266. ;    TOKEN might hold the '('
  267. ;    SI points to the next term
  268. ; Exit Conditions:
  269. ;    Result in AX
  270. ;
  271. LEVEL14B    PROC    NEAR
  272.     CMP    [TOKEN],'('        ; START OF PAREN EXPRESSION?
  273.     JZ    L14B_PAREN        ; YES, CONTINUE ON...
  274.     CALL    GETTERM            ; NO, GO DECODE THE NUMBER
  275.     RET                ; RETURN WITH THE VALUE
  276. ;
  277. L14B_PAREN:
  278.     CALL    GETTOKEN        ; GET THE NEXT TERM
  279.     CALL    LEVEL1            ; GET THE RESULT
  280.     CMP    [TOKEN],')'        ; ENDING PAREN?
  281.     JNZ    L14B_ERR        ; NO, EXIT IN ERROR
  282.     PUSH    AX            ; SAVE THE VALUE
  283.     CALL    GETTOKEN        ; SKIP THE PAREN & GET THE NEXT TERM
  284.     POP    AX
  285.     RET                ; RETURN UNCHANGED
  286. ;
  287. L14B_ERR:
  288.     MOV    AX,_PARENERR        ; GIVE THE ERROR
  289.     JMP    EXPR_ERR        ; EXIT IN ERROR
  290.  
  291. LEVEL14B    ENDP
  292. ;
  293. ;
  294. ; G E T T E R M  --  Convert the decimal string to binary
  295. ;
  296. ; Entry Conditions:
  297. ;    TOKEN holds the string value
  298. ; Exit Conditions:
  299. ;    AX holds the value
  300. ;
  301. GETTERM    PROC    NEAR
  302.     PUSH    SI            ; SAVE THE INDEXES
  303. ;
  304.     CMP    [TOKENTYPE],_VARIABLE    ; VARIABLE TOKEN?
  305.     JNZ    GETE_05            ; NO, CONTINUE ON...
  306.     CMP    [SYMLOOK],0        ; VECTOR SET?
  307.     JZ    GETE_BAD        ; NO, GO SIGNAL AN ERROR
  308.     MOV    AX,[VARFUNC]        ; GET THE VARIABLE VALUE
  309.     JMP    SHORT GETE_10        ; EXIT ALSO IF GOOD
  310. ;
  311. GETE_05:
  312.     MOV    SI,OFFSET TOKEN
  313.     CMP    BYTE PTR [SI],0        ; NULL VALUE?
  314.     JZ    GETE_BAD        ; YES, ITS INVALID
  315.     CALL    _DEC            ; CONVERT TO BINARY
  316.     CMP    [STATUS],0        ; GOOD VALUE
  317.     JZ    GETE_10            ; YES, CONTINUE ON...
  318. ;
  319. GETE_BAD:
  320.     MOV    AX,_BADVAL
  321.     POP    SI            ; SI MUST POINT TO THE STRING
  322.     JMP    EXPR_ERR        ; EXIT BAD
  323. ;
  324. GETE_10:
  325.     POP    SI            ; GET THE STRING POINTER BACK
  326.     PUSH    AX            ; SAVE THE VALUE
  327.     CALL    GETTOKEN        ; LOAD THE NEXT TOKEN
  328.     POP    AX
  329.     RET
  330.  
  331. GETTERM    ENDP
  332. ;
  333. ;
  334. ; G E T T O K E N  --  GET THE NEXT TOKEN FROM INPUT
  335. ;
  336. ; Entry Conditions:
  337. ;    SI points to the input string
  338. ; Exit conditions:
  339. ;    TOKEN holds the next element
  340. ;
  341. GETTOKEN    PROC    NEAR
  342.     PUSH    ES            ; SAVE ALL INDEXES, SEGMENTS
  343.     PUSH    DI
  344.     PUSH    DS            ; ES POINTS TO DATA SEGMENT
  345.     POP    ES
  346.     MOV    DI,OFFSET TOKEN        ; ES:DI POINTS TO TOKEN
  347. ;
  348. GET_SP:
  349.     LODSB                ; GET THE NEXT CHARACTER
  350.     CMP    AL,' '            ; SPACE?
  351.     JZ    GET_SP            ; YES, EAT IT
  352.     CMP    AL,9            ; TAB?
  353.     JZ    GET_SP            ; YES, EAT IT
  354. ;
  355. GETO_10:
  356.     MOV    CX,L2SIZE        ; CHECK AGAINST LIST
  357.     MOV    BX,OFFSET LLIST2-1
  358.     CALL    CMPLIST            ; DELIMITER?
  359.     JNZ    GETO_15            ; NO, CONTINUE ON...
  360.     STOSB                ; YES, SAVE IT & RETURN
  361.     SUB    AL,AL
  362.     STOSB                ; SET THE TERMINATOR
  363.     MOV    [TOKENTYPE],_DELIM    ; AND THE TYPE
  364.     JMP    GETO_EXIT
  365. ;
  366. GETO_15:
  367.     CMP    AL,'_'            ; ACCEPTABLE VARIABLE CHARACTER?
  368.     JZ    GETO_17            ; YES, GO SAVE IT
  369.     CMP    AL,'@'            ; ACCEPTABLE VARIABLE CHARACTER?
  370.     JB    GETO_20            ; NO, GO CHECK FOR LITERAL NUMBER
  371.     CMP    AL,'Z'            ; ACCEPTABLE VARIABLE CHARACTER?
  372.     JA    GETO_20            ; NO, GO CHECK FOR LITERAL NUMBER
  373. ;
  374. GETO_17:
  375.     STOSB                ; SAVE IN STRING
  376.     LODSB                ; FETCH THE NEXT CHARACTER
  377.     CMP    AL,'0'            ; MUST BE A LITERAL NUMBER
  378.     JB    GETO_18            ; EXIT BAD...
  379.     CMP    AL,'9'            ; IS IT 0 - 9?
  380.     JLE    GETO_17            ; YES, SAVE IN THE STRING
  381. ;
  382. GETO_18:
  383.     MOV    CX,L1SIZE        ; CHECK FOR TERMINATOR
  384.     MOV    BX,OFFSET LLIST1-1
  385.     CALL    CMPLIST            ; IS IT A TERMINATOR?
  386.     JZ    GETO_19            ; YES, EXIT GOOD
  387.     JMP    GETO_15            ; GO CHECK FOR AN ALPHA CHARACTER
  388. ;
  389. GETO_19:
  390.     DEC    SI            ; TERMINATOR, POINT TO IT
  391.     SUB    AL,AL
  392.     STOSB                ; SET THE TERMINATOR
  393.     CMP    [SYMLOOK],0        ; VARIABLE VECTOR SET?
  394.     JZ    GETO_BAD        ; NO, GO SIGNAL AN ERROR
  395.     PUSH    SI            ; SAVE THE SOURCE POINTER...
  396.     MOV    SI,OFFSET TOKEN        ; POINT FOR NEXT ROUTINE
  397.     CALL    [SYMLOOK]        ; GO PROCESS THE VARIABLE
  398.     POP    SI            ; RESTORE FIRST...
  399.     JC    GETO_BAD        ; EXIT IF BAD
  400.     MOV    [TOKENTYPE],BL        ; SET THE TOKEN TYPE
  401.     MOV    [VARFUNC],AX        ; SAVE THE VALUE/VECTOR
  402.     JMP    GETO_EXIT        ; ALL DONE, RETURN NOW
  403. ;
  404. GETO_20:
  405.     CMP    AL,'0'            ; MUST BE A LITERAL NUMBER
  406.     JB    GETO_BAD        ; EXIT BAD...
  407.     CMP    AL,'9'
  408.     JA    GETO_BAD
  409.     STOSB                ; SAVE IN THE STRING
  410.     LODSB                ; FETCH NEXT CHARACTER
  411.     MOV    CX,L1SIZE        ; CHECK FOR TERMINATOR
  412.     MOV    BX,OFFSET LLIST1-1
  413.     CALL    CMPLIST            ; IS IT A TERMINATOR?
  414.     JNZ    GETO_20            ; NO, GO SAVE IT
  415. ;
  416.     DEC    SI            ; TERMINATOR, POINT TO IT
  417.     SUB    AL,AL
  418.     STOSB
  419.     MOV    [TOKENTYPE],_NUMERIC    ; SET THE TOKEN TYPE FOR LITERAL NUMBER
  420. ;
  421. GETO_EXIT:
  422.     POP    DI
  423.     POP    ES
  424.     RET
  425. ;
  426. GETO_BAD:
  427.     MOV    [TOKEN],0        ; NULL OUT THE BAD TOKEN & RETURN
  428.     MOV    [TOKENTYPE],_UNKTYPE
  429.     MOV    AX,_INVALID
  430.     JMP    EXPR_ERR
  431. ;
  432. CMPLIST    PROC    NEAR
  433.     INC    BX            ; MOVE TO NEXT ELEMENT
  434.     CMP    AL,[BX]            ; IS IT THE TERMINATOR?
  435.     LOOPNE    CMPLIST            ; NO, CONTINUE SEARCHING
  436.     RET
  437.  
  438. CMPLIST    ENDP
  439. GETTOKEN    ENDP
  440. ;
  441. ENDPGM    EXPR
  442. ;
  443.  
  444.