home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / prolog / epro23.ark / HEAP.MAC < prev    next >
Encoding:
Text File  |  1986-11-02  |  6.6 KB  |  454 lines
  1.  
  2. ; ===========================================================
  3. ; HEAP.Z80
  4. ;    heap management 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. FROZEN    EQU    -3
  14.  
  15. HT    EQU    9
  16. LF    EQU    10
  17. CR    EQU    13
  18. CTLZ    EQU    26
  19.  
  20. CPM    EQU        0000H
  21. BDOS    EQU    CPM+0005H
  22. CDMA    EQU    CPM+0080H
  23. TPA    EQU    CPM+0100H
  24.  
  25. ;release(p)
  26. ;  NODE * p;
  27. ;  {
  28. ;  hfree = p;
  29. ;  }
  30. RLS::
  31.     LD    (HFREE##),HL
  32.     RET
  33.  
  34. ;brls(bptr)
  35. ;    /* release the stack above bptr; cancel all unifications
  36. ;    at this level. */
  37. ;  BETASTATE * bptr;
  38. ;  {
  39. ;  SUBST * x;
  40.     DSEG
  41. X:    DW    0
  42.     CSEG
  43. ;
  44. BRLS::
  45. ;  for (x = bptr->subst ; x < (SUBST *)hfree ; x++)
  46.     CALL    YSUBST##
  47.     LD    (X),HL
  48. BR1:    LD    DE,(HFREE##)
  49.     CALL    CPHL##
  50.     JR    NC,BR2
  51. ;    if (x->back.val != UNDEF && x->back.val != FROZEN)
  52.     CALL    @BACK##
  53.     LD    DE,FROZEN
  54.     CALL    CPHL##
  55.     JR    Z,BR3
  56.     LD    DE,UNDEF
  57.     CALL    CPHL##
  58.     JR    Z,BR3
  59. ;      x->back.val->forw.val = (SUBST *)UNDEF;
  60.     CALL    @LFORW##
  61. BR3:    LD    HL,(X)
  62.     LD    DE,6
  63.     ADD    HL,DE
  64.     LD    (X),HL
  65.     JR    BR1
  66. BR2:
  67. ;  hfree = (char *)bptr;
  68.     LD    (HFREE##),IY
  69. ;  }
  70.     RET
  71.  
  72. ;/* freeze this beta-state */
  73. ;freeze(bptr)
  74. ;  BETASTATE * bptr;        passed in IY
  75. FREEZE::
  76. ;  {
  77. ;  SUBST * x;
  78. ;  for (x = bptr->subst ; x < (SUBST *)hfree ; x++)
  79.     CALL    YSUBST##
  80.     LD    (X),HL
  81. FR1:    LD    DE,(HFREE##)
  82.     CALL    CPHL##
  83.     RET    NC
  84. ;    if (x->back == UNDEF)
  85.     CALL    @BACK##
  86.     LD    DE,UNDEF
  87.     CALL    CPHL##
  88.     JR    NZ,FR2
  89. ;      x->back == FROZEN;
  90.     LD    HL,(X)
  91.     LD    DE,FROZEN
  92.     CALL    @LBACK##
  93. FR2:
  94.     LD    HL,(X)
  95.     LD    DE,6
  96.     ADD    HL,DE
  97.     LD    (X),HL
  98.     JR    FR1
  99. ;  }
  100.  
  101. ;#define    cksp()    if (hfree > htop) space()
  102. CKSP:
  103.     LD    HL,(HFREE##)
  104.     LD    DE,(HTOP##)
  105.     CALL    CPHL##
  106.     RET    C
  107. ;
  108. ;space()
  109. ;  {
  110. ;  if (settop(100))
  111.     LD    HL,100
  112.     CALL    SETTOP##
  113.     LD    A,H
  114.     OR    L
  115.     JR    Z,SP1
  116. ;    htop += 100;
  117.     LD    HL,(HTOP##)
  118.     LD    DE,100
  119.     ADD    HL,DE
  120.     LD    (HTOP##),HL
  121.     RET
  122. ;  else
  123. SP1:
  124. ;    fatal("\r\nOut of heap space.");
  125.     LD    HL,SP1MSG
  126.     JP    FATAL##
  127.     DSEG
  128. SP1MSG:    DB    CR,LF,'Out of heap space.',0
  129.     CSEG
  130. ;  }
  131.  
  132. ;PAIR
  133. ;makepair(x1,x2)
  134. ;  /* EXPR */ int x1,x2;
  135. ;  {
  136. ;  PAIR temp;
  137.     DSEG
  138. X1:    DW    0
  139. X2:    DW    0
  140. TEMP:    DW    0
  141.     CSEG
  142. ;
  143. MKPAIR::
  144.     LD    (X1),HL
  145.     LD    (X2),DE
  146. ;  temp = hfree;
  147.     LD    HL,(HFREE##)
  148.     LD    (TEMP),HL
  149. ;  hfree += 4;
  150.     INC    HL
  151.     INC    HL
  152.     INC    HL
  153.     INC    HL
  154.     LD    (HFREE##),HL
  155. ;  cksp();
  156.     CALL    CKSP
  157. ;  temp->left = x1;
  158.     LD    HL,(TEMP)
  159.     LD    DE,(X1)
  160.     CALL    @LLEFT##
  161. ;  temp->right = x2;
  162.     LD    DE,(X2)
  163.     CALL    @LRIGHT##
  164. ;  return temp;
  165.     RET
  166. ;  }
  167.  
  168. ;ALPHASTATE *        in IX
  169. ;makealpha(bptr,x,bback)
  170. ;  BETASTATE * bptr;    in IY
  171. ;  EXPR x;        in HL
  172. ;  char * bback;    in DE
  173. ;  {
  174. ;  ALPHASTATE * aptr;    in IX
  175. ;  static SUBVAL sv;
  176. ;  static LSUBST ls;
  177. ;  static EXPR ex;
  178.     DSEG
  179. BBACK:    DW    0
  180. SV:    DW    0
  181. LS:    DW    0
  182. EEX:    DW    0
  183.     CSEG
  184. ;
  185. MKALPHA::
  186.     LD    (EEX),HL
  187.     LD    (BBACK),DE
  188. ;  aptr = (ALPHASTATE *)hfree;
  189.     LD    HL,(HFREE##)
  190.     PUSH    HL
  191.     POP    IX
  192. ;  hfree += 8;
  193.     LD    DE,8
  194.     ADD    HL,DE
  195.     LD    (HFREE##),HL
  196. ;  cksp();
  197.     CALL    CKSP
  198. ;  aptr->pred = bptr;
  199.     PUSH    IY
  200.     POP    HL
  201.     CALL    XLPRED##
  202. ;  aptr->goal = x;
  203.     LD    HL,(EEX)
  204.     CALL    XLGOAL##
  205. ;  aptr->back = bback;
  206.     LD    HL,(BBACK)
  207.     CALL    XLBACK##
  208. ;  ls = bptr->subst;
  209.     CALL    YSUBST##
  210.     LD    (LS),HL
  211. ;  if (varp(ex.list = x->left.list))
  212.     LD    HL,(EEX)
  213.     CALL    @LEFT##
  214.     LD    (EEX),HL
  215.     CALL    VARP##
  216.     JR    Z,MKA1
  217. ;    {
  218. ;    sv.val = value(vf(ex.list,ls));
  219.     LD    DE,(LS)
  220.     CALL    VF##
  221.     CALL    VALUE##
  222.     LD    (SV),HL
  223. ;    if (substp(sv.val))
  224.     CALL    SUBSTP##
  225.     JR    Z,MKA2
  226. ;      {
  227. ;      aptr->datb = alldb;
  228.     LD    HL,(ALLDB##)
  229.     CALL    XLDATB##
  230. ;      return aptr;
  231.     RET
  232. ;      }
  233. MKA2:
  234. ;    else
  235. ;      {
  236. ;      ex.list = sv.assgn->sexp.list;
  237.     PUSH    HL
  238.     CALL    @EXPR##
  239.     LD    (EEX),HL
  240. ;      ls = sv.assgn->slist;
  241.     POP    HL
  242.     CALL    @SLIST##
  243.     LD    (LS),HL
  244. ;      }
  245. ;    }
  246. MKA1:
  247. ;  if (varp(ex.list = ex.list->left.list))
  248.     LD    HL,(EEX)
  249.     CALL    @LEFT##
  250.     LD    (EEX),HL
  251.     CALL    VARP##
  252.     JR    Z,MKA3
  253. ;    {
  254. ;    sv.val = value(vf(ex.list,ls));
  255.     LD    DE,(LS)
  256.     CALL    VF##
  257.     CALL    VALUE##
  258.     LD    (SV),HL
  259. ;    if (substp(sv.val))
  260.     CALL    SUBSTP##
  261.     JR    Z,MKA4
  262. ;      {
  263. ;      aptr->datb = alldb;
  264.     LD    HL,(ALLDB##)
  265.     CALL    XLDATB##
  266. ;      return aptr;
  267.     RET
  268. ;      }
  269. MKA4:
  270. ;    else
  271. ;      {
  272. ;      ex.list = sv.assgn->sexp.list;
  273.     PUSH    HL
  274.     CALL    @EXPR##
  275.     LD    (EEX),HL
  276. ;      ls = sv.assgn->slist;
  277.     POP    HL
  278.     CALL    @SLIST##
  279.     LD    (LS),HL
  280. ;      }
  281. ;    }
  282. MKA3:
  283. ;  aptr->datb = (PAIR)(ex.symbol->addr);
  284.     LD    HL,(EEX)
  285.     CALL    @ADDR##
  286.     CALL    XLDATB##
  287. ;  return aptr;
  288.     RET
  289. ;  }
  290.  
  291. ;BETASTATE *        in IY
  292. ;mkb(aptr,lst)
  293. ;  ALPHASTATE * aptr;    in IX
  294. ;  PAIR lst;        in HL
  295. ;  {
  296. ;  BETASTATE * bptr;    in IY
  297. ;
  298.     DSEG
  299. LST:    DW    0
  300.     CSEG
  301. MKBETA::
  302.     LD    (LST),HL
  303. ;  bptr = hfree;
  304.     LD    HL,(HFREE##)
  305.     PUSH    HL
  306.     POP    IY
  307. ;  hfree += 4;
  308.     INC    HL
  309.     INC    HL
  310.     INC    HL
  311.     INC    HL
  312.     LD    (HFREE##),HL
  313. ;  bptr->pred = aptr;
  314.     PUSH    IX
  315.     POP    HL
  316.     CALL    YLPRED##
  317. ;  bptr->assertion.list = lst;
  318.     LD    HL,(LST)
  319.     CALL    YLASS##
  320. ;  makelsubst(lst,hfree);
  321.     LD    DE,(HFREE##)
  322.     CALL    MKLSUBST
  323. ;  cksp();
  324.     CALL    CKSP
  325. ;  return bptr;
  326.     RET
  327. ;  }
  328.  
  329. ;makelsubst(lst,st)    /* recursive */
  330. ;  EXPR lst;
  331. ;  SUBST * st;
  332. ;  {
  333. ;  EXPR lstx;
  334. ;  SUBST * x;
  335.     DSEG
  336. LSTX:    DW    0
  337. STX:    DW    0    
  338.     CSEG
  339. ;
  340. MKLSUBST::
  341.     LD    (STX),DE
  342. MKLR:    LD    (LSTX),HL
  343. ;  lstx.number = lst;    /* synonym */
  344. ;  if (varp(lst))
  345.     CALL    VARP##
  346.     JR    Z,MKL1
  347. ;    {
  348. ;    for (x = st ; x < (SUBST *)hfree; x++ )
  349.     LD    HL,(STX)
  350. MKL2:    LD    DE,(HFREE##)
  351.     CALL    CPHL##
  352.     JR    NC,MKL3
  353. ;      if (lstx.symbol == x->vname)
  354. ;        return;
  355.     PUSH    HL
  356.     CALL    @VNAME##
  357.     LD    DE,(LSTX)
  358.     CALL    CPHL##
  359.     POP    HL
  360.     RET    Z
  361.     LD    DE,6
  362.     ADD    HL,DE
  363.     JR    MKL2
  364. MKL3:
  365. ;    makesubst(lst);
  366.     LD    HL,(LSTX)
  367.     JP    MKSUBST
  368. ;    }
  369. MKL1:
  370. ;  else if (nelistp(lst))
  371.     CALL    NELP##
  372.     RET    Z
  373. ;    {
  374. ;    makelsubst(lstx.list->left.list,st);
  375.     LD    HL,(LSTX)
  376.     PUSH    HL
  377.     CALL    @LEFT##
  378.     CALL    MKLR        ; recursion
  379. ;    makelsubst(lstx.list->right.list,st);
  380.     POP    HL
  381.     CALL    @RIGHT##
  382.     JP    MKLR        ; tail recursion
  383. ;    }
  384. ;  }
  385.  
  386. ;SUBST *
  387. ;makesubst(var)
  388. ;  VARIABLE var;
  389. ;  {
  390. ;  SUBST * ptr;
  391.     DSEG
  392. PTR:    DW    0
  393.     CSEG
  394. MKSUBST::
  395.     PUSH    HL
  396. ;
  397. ;  ptr = (SUBST *)hfree;
  398.     LD    HL,(HFREE##)
  399.     LD    (PTR),HL
  400. ;  hfree += 6;
  401.     LD    DE,6
  402.     ADD    HL,DE
  403.     LD    (HFREE##),HL
  404. ;  ptr->vname = var;
  405.     LD    HL,(PTR)
  406.     POP    DE
  407.     CALL    @LVNAME##
  408. ;  ptr->back.val = (SUBST *)UNDEF;
  409.     LD    DE,UNDEF
  410.     CALL    @LBACK##
  411. ;  ptr->forw.val = (SUBST *)UNDEF;
  412.     LD    DE,UNDEF
  413.     CALL    @LFORW##
  414. ;  return ptr;
  415.     RET
  416. ;  }
  417.  
  418. ;SEXPR *
  419. ;makesexpr(se,ba,sl)
  420. ;  EXPR se;
  421. ;  SUBST * ba;
  422. ;  LSUBST sl;
  423. ;  {
  424. ;  SEXPR * temp;
  425. ;
  426. MKSEXPR::
  427.     PUSH    BC
  428.     PUSH    DE
  429.     PUSH    HL
  430. ;  temp = (SEXPR *)hfree;
  431.     LD    HL,(HFREE##)
  432.     PUSH    HL
  433. ;  hfree += 6;
  434.     LD    DE,6
  435.     ADD    HL,DE
  436.     LD    (HFREE##),HL
  437. ;  cksp();
  438.     CALL    CKSP
  439. ;  temp->sexp.list = se;
  440.     POP    HL
  441.     POP    DE
  442.     CALL    @LEXPR##
  443. ;  temp->back.val = ba;
  444.     POP    DE
  445.     CALL    @LBACK##
  446. ;  temp->slist = sl;
  447.     POP    DE
  448.     CALL    @LSLIST##
  449. ;  return temp;
  450.     RET
  451. ;  }
  452.  
  453.     END
  454.