home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / languags / prolog / epro23.ark / DATBADD.MAC < prev    next >
Text File  |  1986-11-02  |  2KB  |  102 lines
  1.  
  2. ; ===========================================================
  3. ; DATBADD.Z80
  4. ;    add to the database in E-Prolog
  5. ;    May 26, 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.     DSEG
  25. ;PAIR alldb;
  26. ALLDB::    DS    2
  27. ;PAIR * alldbe;
  28. ALLDBE:: DS    2
  29.     CSEG
  30.  
  31. ;datbadd(relname,clause)
  32. ;  SYMBOL * relname;
  33. ;  EXPR clause;
  34. ;  {
  35. ;  static PAIR * ptr;
  36.     DSEG
  37. CLAUSE:    DW    0
  38. PTR:    DW    0
  39.     CSEG
  40. DBADD::
  41. ;
  42.     LD    (CLAUSE),DE
  43. ;  ptr = &relname->addr;
  44.     LD    (PTR),HL
  45. ;  if (numbp(*ptr))
  46.     CALL    INDIR##
  47.     CALL    NUMBP##
  48.     JR    Z,DB1
  49. ;    {
  50. ;    errmsg(" Cannot change built-in commands.\r\n");
  51. ;    return;
  52.     LD    HL,DB1MSG
  53.     JP    ERRMSG##
  54.     DSEG
  55. DB1MSG:    DB    ' Cannot change built-in commands.',CR,LF,0 
  56.     CSEG
  57. ;    }
  58. DB1:
  59. ;  for ( ; *ptr != (PAIR)empty ; ptr = &(*ptr)->right.list)
  60. ;    ;
  61.     LD    HL,(PTR)
  62.     CALL    INDIR##
  63.     LD    DE,EMPTY
  64.     CALL    CPHL##
  65.     JR    Z,DB2
  66.     INC    HL
  67.     INC    HL
  68.     LD    (PTR),HL
  69.     JR    DB1
  70. DB2:
  71. ;  *ptr = makepair(clause,empty);
  72.     LD    HL,(CLAUSE)
  73.     LD    DE,EMPTY
  74.     CALL    MKPAIR##
  75.     EX    DE,HL
  76.     LD    HL,(PTR)
  77.     LD    (HL),E
  78.     INC    HL
  79.     LD    (HL),D
  80. ;  *alldbe = makepair(clause,empty);
  81.     LD    HL,(CLAUSE)
  82.     LD    DE,EMPTY
  83.     CALL    MKPAIR##
  84.     EX    DE,HL
  85.     LD    HL,(ALLDBE)
  86.     LD    (HL),E
  87.     INC    HL
  88.     LD    (HL),D
  89. ;  alldbe = &((*alldbe)->right.list);
  90.     DEC    HL
  91.     CALL    INDIR##
  92.     INC    HL
  93.     INC    HL
  94.     LD    (ALLDBE),HL
  95. ;  datbtop = hfree;
  96.     LD    HL,(HFREE##)
  97.     LD    (DBTOP##),HL
  98. ;  }
  99.     RET
  100.  
  101.     END
  102.