home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / prolog / epro23.ark / CLASS.MAC < prev    next >
Encoding:
Text File  |  1986-11-02  |  3.8 KB  |  280 lines
  1.  
  2. ; ===========================================================
  3. ; CLASS.Z80
  4. ;    predicates, classifiers and tag-movers for E-Prolog
  5. ;    June 22, 1985
  6.  
  7.     .Z80
  8.  
  9. FALSE    EQU    0
  10. TRUE    EQU    1
  11. EMPTY    EQU    -1
  12. UNDEF    EQU    -2
  13.  
  14. HT    EQU    9
  15. LF    EQU    10
  16. CR    EQU    13
  17. CTLZ    EQU    26
  18.  
  19. CPM    EQU        0000H
  20. BDOS    EQU    CPM+0005H
  21. CDMA    EQU    CPM+0080H
  22. TPA    EQU    CPM+0100H
  23.  
  24.  
  25. ;BOOLEAN
  26. ;atomp(p)
  27. ;  char * p;
  28. ;  {
  29. ;  return (nelistp(p) && symbp(first(p)));
  30. ;  }
  31. ATOMP::
  32.     PUSH    HL
  33.     CALL    NELP
  34.     JP    Z,POPF
  35.     CALL    @LEFT
  36.     CALL    SYMBP
  37.     POP    HL
  38.     RET
  39.  
  40. ;BOOLEAN
  41. ;clausep(p)
  42. ;  char * p;
  43. ;  {
  44. ;  return (nelistp(p) && atomp(first(p)));
  45. ;  }
  46. CLP::
  47.     PUSH    HL
  48.     CALL    NELP
  49.     JP    Z,POPF
  50.     CALL    @LEFT
  51.     CALL    ATOMP
  52.     POP    HL
  53.     RET
  54.  
  55. ;BOOLEAN
  56. ;listp(p)
  57. ;  char * p;
  58. ;  {
  59. ;  return (p == empty || nelistp(p));
  60. ;  }
  61. LISTP::
  62.     PUSH    HL
  63.     CALL    NELP
  64.     JP    NZ,POPT
  65.     LD    DE,EMPTY
  66.     CALL    CPHL##
  67.     JP    Z,POPT
  68.     JP    POPF
  69.  
  70. ;BOOLEAN
  71. ;nelistp(p)
  72. ;  char * p;
  73. ;  {
  74. ;  return (hbot <= p && p < hfree);
  75. ;  }
  76. NELP::
  77.     PUSH    HL
  78.     LD    DE,(STOP##)
  79.     CALL    CPHL##
  80.     JP    C,POPF
  81.     LD    DE,(HFREE##)
  82.     CALL    CPHL##
  83.     JP    NC,POPF
  84.     JP    POPT
  85.  
  86. ;BOOLEAN
  87. ;numbp(p)
  88. ;  char * p;
  89. ;  {
  90. ;  return (0 <= p && p < sbot);
  91. ;  }
  92. NUMBP::
  93.     PUSH    HL
  94.     LD    DE,(SBOT)
  95.     CALL    CPHL##
  96.     JP    C,POPT
  97.     JP    POPF
  98.  
  99. ;BOOLEAN
  100. ;substp(x)
  101. ;  /* distinguish (SUBST *) from (SEXPR *) in SUBVAL */
  102. ;  SUBVAL * x;
  103. ;  {
  104. ;  return varp(x->vname);
  105. ;  }
  106. SUBSTP::
  107.     PUSH    HL
  108.     CALL    @VNAME
  109.     CALL    VARP
  110.     POP    HL
  111.     RET
  112.  
  113. ;BOOLEAN
  114. ;symbp(p)
  115. ;  char * p;
  116. ;  {
  117. ;  return (sbot <= p && p < sfree);
  118. ;  }
  119. SYMBP::
  120.     PUSH    HL
  121.     LD    DE,(SBOT##)
  122.     CALL    CPHL##
  123.     JP    C,POPF
  124.     LD    DE,(SFREE##)
  125.     CALL    CPHL##
  126.     JP    NC,POPF
  127.     JP    POPT
  128.  
  129. ;BOOLEAN
  130. ;varp(p)
  131. ;  SYMBOL * p;
  132. ;  {
  133. ;  return (symbp(p) && (p->string[0] == '?'));
  134. ;  }
  135. VARP::
  136.     PUSH    HL
  137.     CALL    SYMBP
  138.     JR    Z,POPF
  139.     CALL    @STR
  140.     LD    A,(HL)
  141.     CP    '?'
  142.     JR    Z,POPT
  143.     JR    POPF
  144. POPT:    LD    A,1
  145.     OR    A
  146.     POP    HL
  147.     RET
  148. POPF:    XOR    A
  149.     POP    HL
  150.     RET
  151.  
  152. ; ------------ indirect reference routines ----------------
  153.  
  154. INDIR::
  155.     LD    A,(HL)
  156.     INC    HL
  157.     LD    H,(HL)
  158.     LD    L,A
  159.     RET
  160. @LINDIR:
  161.     PUSH    HL
  162.     ADD    HL,BC
  163. LINDIR::
  164.     LD    (HL),E
  165.     INC    HL
  166.     LD    (HL),D
  167.     POP    HL
  168.     RET
  169. @INDIR:    ADD    HL,DE
  170.     JR    INDIR
  171. @IND0    EQU    INDIR
  172. @IND2:    LD    DE,2
  173.     JR    @INDIR
  174. @IND4:    LD    DE,4
  175.     JR    @INDIR
  176. @IND6:    LD    DE,6
  177.     JR    @INDIR
  178. @LIND0:    LD    BC,0
  179.     JR    @LINDIR
  180. @LIND2:    LD    BC,2
  181.     JR    @LINDIR
  182. @LIND4:    LD    BC,4
  183.     JR    @LINDIR
  184. @LIND6:    LD    BC,6
  185.     JR    @LINDIR
  186.  
  187. ; for (SYMBOL *) or VARIABLE
  188.     PUBLIC    @ADDR,@LPTR,@RPTR,@LADDR,@LLPTR,@LRPTR,@STR
  189. @ADDR    EQU    @IND0
  190. @LPTR    EQU    @IND2
  191. @RPTR    EQU    @IND4
  192. @LADDR    EQU    @LIND0
  193. @LLPTR    EQU    @LIND2
  194. @LRPTR    EQU    @LIND4
  195. @STR:    LD    DE,6    ; pointer
  196.     ADD    HL,DE
  197.     RET
  198.  
  199. ; for (NODE *) or PAIR
  200.     PUBLIC    @LEFT,@RIGHT,@LLEFT,@LRIGHT
  201. @LEFT    EQU    @IND0
  202. @RIGHT    EQU    @IND2
  203. @LLEFT    EQU    @LIND0
  204. @LRIGHT    EQU    @LIND2
  205.  
  206. ; for (SUBST *) or LSUBST
  207.     PUBLIC    @VNAME,@BACK,@FORW,@LVNAME,@LBACK,@LFORW
  208. @VNAME    EQU    @IND0
  209. @BACK    EQU    @IND2
  210. @FORW    EQU    @IND4
  211. @LVNAME    EQU    @LIND0
  212. @LBACK    EQU    @LIND2
  213. @LFORW    EQU    @LIND4
  214.  
  215. ; for (SEXPR *)
  216.     PUBLIC    @EXPR,@SLIST,@LEXPR,@LSLIST
  217. @EXPR    EQU    @IND0
  218. ;@BACK as above
  219. @SLIST    EQU    @IND4
  220. @LEXPR    EQU    @LIND0
  221. ;@LBACK as above
  222. @LSLIST    EQU    @LIND4
  223.  
  224. ; for (ALPHASTATE *)
  225.     PUBLIC    @PRED,@XBACK
  226. @PRED    EQU    @IND0
  227. XPRED::    LD    L,(IX+0)
  228.     LD    H,(IX+1)
  229.     RET
  230. XGOAL::    LD    L,(IX+2)
  231.     LD    H,(IX+3)
  232.     RET
  233. XDATB::    LD    L,(IX+4)
  234.     LD    H,(IX+5)
  235.     RET
  236. XBACK::    LD    L,(IX+6)
  237.     LD    H,(IX+7)
  238.     RET
  239. @XBACK    EQU    @IND6
  240. XLPRED::
  241.     LD    (IX+0),L
  242.     LD    (IX+1),H
  243.     RET
  244. XLGOAL::
  245.     LD    (IX+2),L
  246.     LD    (IX+3),H
  247.     RET
  248. XLDATB::
  249.     LD    (IX+4),L
  250.     LD    (IX+5),H
  251.     RET
  252. XLBACK::
  253.     LD    (IX+6),L
  254.     LD    (IX+7),H
  255.     RET
  256.  
  257. ; for (BETASTATE *)
  258. YPRED::    LD    L,(IY+0)
  259.     LD    H,(IY+1)
  260.     RET
  261. YASS::    LD    L,(IY+2)
  262.     LD    H,(IY+3)
  263.     RET
  264. YLPRED::
  265.     LD    (IY+0),L
  266.     LD    (IY+1),H
  267.     RET
  268. YLASS::    LD    (IY+2),L
  269.     LD    (IY+3),H
  270.     RET
  271. YSUBST:: PUSH    IY    ; pointer
  272.     POP    HL
  273. @SUBST:: INC    HL
  274.     INC    HL
  275.     INC    HL
  276.     INC    HL
  277.     RET
  278.  
  279.     END
  280.