home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / languags / prolog / epro23.ark / SYMB.MAC < prev    next >
Text File  |  1986-11-02  |  6KB  |  390 lines
  1.  
  2. ; ===========================================================
  3. ; SYMB.Z80
  4. ;    symbol table routines for E-Prolog
  5. ;    May 27, 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. ;SYMBOL *
  25. ;gtoken()
  26. ;  {
  27. ;  /* read token */
  28. GTOKEN::
  29. ;  static int i;
  30. ;  static char * tokptr;
  31. ;  static SYMBOL * sadr;
  32. ;  static SYMBOL ** sadrr;
  33.     DSEG
  34. TOKPTR:    DW    0
  35. SADR:    DW    0
  36. SADRR:    DW    0
  37.     CSEG
  38. ;
  39. ;  tokptr = cdma;
  40.     LD    HL,CDMA
  41.     LD    (TOKPTR),HL
  42. ;  while(separp(rdchar()))
  43. ;    ;
  44. GT1:
  45.     CALL    RDCHAR##
  46.     CALL    SEPARP##
  47.     JR    NZ,GT1
  48. ;  if (digitp())
  49.     CALL    DIGITP
  50.     JR    Z,GT2
  51. ;    {
  52. ;    for (i = 0 ; digitp() ; rdchar())
  53.     LD    HL,0
  54. GT4:    PUSH    HL
  55.     CALL    DIGITP
  56.     JR    Z,GT3
  57. ;      i = i*10 + ((int)(character - '0'));
  58.     POP    HL
  59.     ADD    HL,HL
  60.     LD    D,H
  61.     LD    E,L
  62.     ADD    HL,HL
  63.     ADD    HL,HL
  64.     ADD    HL,DE
  65.     LD    A,(CHR##)
  66.     SUB    '0'
  67.     LD    E,A
  68.     LD    D,0
  69.     ADD    HL,DE
  70.     CALL    RDCHAR##
  71.     JR    GT4
  72. GT3:
  73. ;    unrdchar();
  74.     CALL    UNRDCH##
  75. ;    if (numbp(i))
  76. ;      return i;
  77.     POP    HL
  78.     CALL    NUMBP##
  79.     RET    NZ
  80. ;    return 0;
  81.     LD    HL,0
  82.     RET
  83. ;    }
  84. GT2:
  85. ;  if (character == '"')
  86.     LD    A,(CHR##)
  87.     CP    '"'
  88.     JR    NZ,GT5
  89. ;    {
  90. ;    rdchar();
  91.     CALL    RDCHAR##
  92. ;    do
  93. GT9:
  94. ;      {
  95. ;      cntl();
  96.     CALL    CNTL
  97. ;      *tokptr++ = character;
  98.     LD    HL,(TOKPTR)
  99.     LD    A,(CHR##)
  100.     LD    (HL),A
  101.     INC    HL
  102.     LD    (TOKPTR),HL
  103. ;      rdchar();
  104.     CALL    RDCHAR##
  105. ;      }
  106. ;    while (character != '"') ;
  107.     LD    A,(CHR##)
  108.     CP    '"'
  109.     JR    NZ,GT9
  110. ;    }
  111.     JR    GT8
  112. GT5:
  113. ;  else if (character == '\'')
  114.     CP    "'"
  115.     JR    NZ,GT6
  116. ;    {
  117. ;    rdchar();
  118.     CALL    RDCHAR##
  119. ;    do
  120. GT10:
  121. ;      {
  122. ;      cntl();
  123.     CALL    CNTL
  124. ;      *tokptr++ = character;
  125.     LD    HL,(TOKPTR)
  126.     LD    A,(CHR##)
  127.     LD    (HL),A
  128.     INC    HL
  129.     LD    (TOKPTR),HL
  130. ;      rdchar();
  131.     CALL    RDCHAR##
  132. ;      }
  133. ;    while (character != '\'') ;
  134.     LD    A,(CHR##)
  135.     CP    "'"
  136.     JR    NZ,GT10
  137. ;    }
  138.     JR    GT8
  139. GT6:
  140. ;  else if (goodchp())
  141.     CALL    GOODCP
  142.     JR    Z,GT7
  143. ;    {
  144. ;    do
  145. GT11:
  146. ;      {
  147. ;      *tokptr++ = character;
  148.     LD    HL,(TOKPTR)
  149.     LD    A,(CHR##)
  150.     LD    (HL),A
  151.     INC    HL
  152.     LD    (TOKPTR),HL
  153. ;      rdchar();
  154.     CALL    RDCHAR##
  155. ;      }
  156. ;    while (goodchp()) ;
  157.     CALL    GOODCP
  158.     JR    NZ,GT11
  159. ;    unrdchar();
  160.     CALL    UNRDCH##
  161. ;    }
  162.     JR    GT8
  163. GT7:
  164. ;  else
  165. ;    *tokptr++ = character;
  166.     LD    HL,(TOKPTR)
  167.     LD    A,(CHR##)
  168.     LD    (HL),A
  169.     INC    HL
  170.     LD    (TOKPTR),HL
  171. GT8:
  172. ;  *tokptr = '\0';
  173.     LD    HL,(TOKPTR)
  174.     LD    (HL),0
  175. ;
  176. ;  /* find it in symbol table */
  177. ;  sadr = sbot;
  178.     LD    HL,(SBOT##)
  179.     LD    (SADR),HL
  180. ;  do
  181. FS1:
  182. ;    {
  183. ;    if ((i = strcmp(sadr->string,cdma)) == 0)
  184.     LD    HL,(SADR)
  185.     CALL    @STR##
  186.     LD    DE,CDMA
  187.     CALL    STRCMP
  188.     JR    NZ,FS2
  189. ;      return sadr;
  190.     LD    HL,(SADR)
  191.     RET
  192. FS2:
  193. ;    if (i < 0)
  194.     JR    NC,FS3
  195. ;      sadrr = &(sadr->rptr);
  196.     LD    HL,(SADR)
  197.     INC    HL
  198.     INC    HL
  199.     INC    HL
  200.     INC    HL
  201.     LD    (SADRR),HL
  202.     JR    FS4
  203. FS3:
  204. ;    else
  205. ;      sadrr = &(sadr->lptr);
  206.     LD    HL,(SADR)
  207.     INC    HL
  208.     INC    HL
  209.     LD    (SADRR),HL
  210. FS4:
  211. ;    sadr = *sadrr;
  212.     LD    E,(HL)
  213.     INC    HL
  214.     LD    D,(HL)
  215.     LD    (SADR),DE
  216. ;    }
  217. ;  while (sadr != (SYMBOL *)empty) ;
  218.     LD    HL,EMPTY
  219.     CALL    CPHL##
  220.     JR    NZ,FS1
  221. ;  *sadrr = mksymb();
  222.     CALL    MKSYMB
  223.     EX    DE,HL
  224.     LD    HL,(SADRR)
  225.     LD    (HL),E
  226.     INC    HL
  227.     LD    (HL),D
  228. ;  return *sadrr;
  229.     EX    DE,HL
  230.     RET
  231. ;  }
  232.  
  233.  
  234. ; compare two strings
  235. ;
  236. ; input:
  237. ;    HL, DE pointing to the strings
  238. ; output:
  239. ;    Z and C flags:
  240. ;    Z ,NC = (HL) = (DE)
  241. ;    NZ,C  = (HL) < (DE)
  242. ;    NZ,NC = (HL) > (DE)
  243. STRCMP::
  244.     EX    DE,HL
  245. ST1:    LD    A,(DE)
  246.     CP    (HL)
  247.     RET    NZ
  248.     OR    A
  249.     RET    Z
  250.     INC    HL
  251.     INC    DE
  252.     JR    ST1
  253.  
  254. ;BOOLEAN
  255. ;digitp()
  256. ;  {
  257. ;  return ('0' <= character && character <= '9');
  258. ;  }
  259. DIGITP:
  260.     LD    A,(CHR##)
  261.     CP    '0'
  262.     JR    C,RETF
  263.     CP    '9'+1
  264.     JR    NC,RETF
  265. RETT:    OR    A
  266.     RET
  267. RETF:    XOR    A
  268.     RET
  269.  
  270. ;cntl()
  271. CNTL:
  272. ;  {
  273. ;  if (character == '^')
  274.     LD    A,(CHR##)
  275.     CP    '^'
  276.     RET    NZ
  277. ;    {
  278. ;    rdchar();
  279.     CALL    RDCHAR##
  280. ;    if (character == '^')
  281. ;      return;
  282.     LD    A,(CHR##)
  283.     CP    '^'
  284.     RET    Z
  285. ;    if (character < '@')
  286. ;      return;
  287.     CP    '@'
  288.     RET    C
  289. ;    character &= 0x1F;
  290.     AND    1FH
  291.     LD    (CHR##),A
  292. ;    }
  293. ;  }
  294.  
  295. ;BOOLEAN
  296. ;goodchp()
  297. GOODCP:
  298. ;  {
  299. ;  switch (character)
  300.     LD    A,(CHR##)
  301. ;    {
  302. ;    case '_':
  303. ;    case '-':
  304. ;    case '?':
  305. ;      return TRUE;
  306. ;    }
  307.     CP    '_'
  308.     JP    Z,RETT
  309.     CP    '-'
  310.     JP    Z,RETT
  311.     CP    '?'
  312.     JP    Z,RETT
  313. ;  return (('0' <= character && character <= '9') ||
  314. ;          ('A' <= character && character <= 'Z') ||
  315. ;          ('a' <= character && character <= 'z') );
  316.     CP    '0'
  317.     JP    C,RETF
  318.     CP    '9'+1
  319.     JP    C,RETT
  320.     CP    'A'
  321.     JP    C,RETF
  322.     CP    'Z'+1
  323.     JP    C,RETT
  324.     CP    'a'
  325.     JP    C,RETF
  326.     CP    'z'+1
  327.     JP    C,RETT
  328.     JP    RETF
  329. ;  }
  330.  
  331. ; Make an entry in the symbol table
  332. ;
  333. ;SYMBOL *
  334. ;mksymb()
  335. ;  {
  336. MKSYMB::
  337. ;  static char * tokptr;
  338. ;  static SYMBOL * sadr;
  339. ;
  340. ;  sadr = (SYMBOL *)sfree;
  341.     LD    HL,(SFREE##)
  342.     PUSH    HL
  343. ;  sadr->addr = empty;
  344.     LD    DE,EMPTY
  345.     LD    (HL),E
  346.     INC    HL
  347.     LD    (HL),D
  348. ;  sadr->lptr = empty;
  349.     INC    HL
  350.     LD    (HL),E
  351.     INC    HL
  352.     LD    (HL),D
  353. ;  sadr->rptr = empty;
  354.     INC    HL
  355.     LD    (HL),E
  356.     INC    HL
  357.     LD    (HL),D
  358. ;  for (sfree = sadr->string , tokptr = cdma ;
  359. ;       (*sfree++ = *tokptr++) != '\0' ; )
  360. ;    ;
  361.     INC    HL
  362.     EX    DE,HL
  363.     LD    HL,CDMA
  364. MK1:    LD    A,(HL)
  365.     LD    (DE),A
  366.     INC    HL
  367.     INC    DE
  368.     OR    A
  369.     JR    NZ,MK1
  370.     EX    DE,HL
  371.     LD    (SFREE##),HL
  372. ;  if (sfree >= stop)
  373.     LD    DE,(STOP##)
  374.     DEC    DE
  375.     CALL    CPHL##
  376.     JR    C,MK2
  377. ;    fatal("\r\nOut of string space.");
  378.     LD    HL,MK1MSG
  379.     JP    FATAL##
  380.     DSEG
  381. MK1MSG:    DB    CR,LF,"Out of string space.",0
  382.     CSEG
  383. MK2:
  384. ;  return sadr;
  385.     POP    HL
  386.     RET
  387. ;  }
  388.  
  389.     END
  390.