home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / prolog / epro23.ark / OUTPUT.MAC < prev    next >
Encoding:
Text File  |  1986-11-02  |  6.3 KB  |  461 lines
  1.  
  2. ; ===========================================================
  3. ;OUTPUT.Z80
  4. ;    output routines for E-Prolog
  5. ;    May 24, 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. ; compare with given value
  25. ;
  26. ?CPHL    MACRO    ?VALUE
  27.     PUSH    DE
  28.     LD    DE,?VALUE
  29.     CALL    CPHL##
  30.     POP    DE
  31.     ENDM
  32.  
  33.     DSEG
  34.  
  35. ; output file: 0 = console, 1 = disk, -1 = null
  36. OUTF::    DB    0
  37.  
  38. ; file control block for output file
  39. OUTFCB::
  40.     DB    0
  41.     DB    '        '
  42.     DB    '   '
  43.     DB    0,0,0,0
  44.     DS    20
  45.  
  46. ; buffer for output file
  47. OUTDMA::
  48.     DS    128
  49. OUTE::
  50.  
  51. ; pointer for output file
  52. OUTP::    DW    OUTDMA
  53.  
  54.     CSEG
  55.  
  56. ; fill with one character
  57. ;
  58. ; all registers destroyed
  59. ?FILL    MACRO    ?ADDR,?COUNT,?VAL
  60.     LD    HL,?ADDR
  61.     PUSH    HL
  62.     POP    DE
  63.     INC    DE
  64.     LD    BC,?COUNT-1
  65.     LD    (HL),?VAL
  66.     LDIR
  67.     ENDM
  68.  
  69. ; copy string
  70. ;
  71. ; input:
  72. ;    HL -> source
  73. ; all registers destroyed
  74. ?COPY    MACRO    ?ADDR
  75.     LD    DE,?ADDR
  76.     CALL    COPY
  77.     ENDM
  78. ; copy string
  79. ;
  80. ; input:
  81. ;    HL -> source (string terminated by 0, which is
  82. ;        not copied)
  83. ;    DE -> destination
  84. ; all registers destroyed
  85.     DSEG
  86. DEST:    DW    0
  87.     CSEG
  88. COPY::
  89.     LD    (DEST),DE
  90.     CALL    LISTP##
  91.     RET    NZ
  92.     CALL    NUMBP##
  93.     RET    NZ
  94.     CALL    @STR##
  95.     LD    DE,(DEST)
  96. COPY1:    LD    A,(HL)
  97.     OR    A
  98.     RET    Z
  99.     LD    (DE),A
  100.     INC    HL
  101.     INC    DE
  102.     JR    COPY1
  103.  
  104. ; create FCB for output file.
  105. ;
  106. ; input:
  107. ;    HL = list (rest of atom)
  108. ;    DE = lsub (substitutions for HL)
  109.     DSEG
  110. PEXP:    DW    0
  111. PLSUB:    DW    0
  112.     CSEG
  113. DOOUT::
  114.     LD    (PEXP),HL
  115.     LD    (PLSUB),DE
  116.     XOR    A
  117.     LD    (OUTF),A
  118.     ?FILL    OUTFCB,36,0
  119.     ?FILL    OUTFCB+1,11,' '
  120. DOOUT1:    LD    HL,PEXP
  121.     LD    DE,PLSUB
  122.     CALL    VNEXT##
  123.     CALL    SYMBP##
  124.     JR    Z,DOOUT3
  125.     ?CPHL    ACON##
  126.     JR    Z,DOOUT3
  127.     LD    A,-1
  128.     LD    (OUTF),A
  129.     ?CPHL    ANULL##
  130.     JP    Z,DOOUT3
  131.     LD    A,1
  132.     LD    (OUTF),A
  133.     ?COPY    OUTFCB+1
  134.     LD    HL,PEXP
  135.     LD    DE,PLSUB
  136.     CALL    VNEXT##
  137.     CALL    SYMBP##
  138.     JR    Z,DOOUT3
  139.     ?CPHL    ACOLON##
  140.     JR    NZ,DOOUT2
  141.     LD    A,(OUTFCB+1)
  142.     SUB    'A'-1
  143.     LD    (OUTFCB),A
  144.     ?FILL    OUTFCB+1,11,' '
  145.     JR    DOOUT1
  146. DOOUT2:    ?CPHL    ADOT##
  147.     JR    NZ,DOOUT3
  148.     LD    HL,PEXP
  149.     LD    DE,PLSUB
  150.     CALL    VNEXT##
  151.     CALL    SYMBP##
  152.     JR    Z,DOOUT3
  153.     ?COPY    OUTFCB+9
  154. DOOUT3:
  155.     RET
  156.  
  157. CRLF::    LD    HL,CRLFX
  158.     CALL    MSG
  159.     RET
  160.     DSEG
  161. CRLFX:    DB    CR,LF,0
  162.     CSEG
  163.  
  164. ; character out
  165. ;
  166. ; input:
  167. ;    character in A
  168. ; saves registers, except AF
  169. CHROUT::
  170.     PUSH    BC
  171.     PUSH    DE
  172.     PUSH    HL
  173.     LD    E,A
  174.     LD    A,(OUTF)    ; output device
  175.     OR    A
  176.     JR    Z,CHRO1        ; console
  177.     DEC    A
  178.     JR    NZ,CHROE    ; null
  179.     LD    HL,(OUTP)    ; disk file
  180.     PUSH    DE
  181.     LD    DE,OUTE
  182.     CALL    CPHL##
  183.     POP    DE
  184.     JR    NZ,CHRO2
  185.     PUSH    DE        ; E = character
  186.     CALL    FLUSH        ; flush buffer
  187.     POP    DE        ; E = character
  188.     LD    HL,OUTDMA
  189. CHRO2:    LD    (HL),E
  190.     INC    HL
  191.     LD    (OUTP),HL
  192.     JR    CHROE
  193. CHRO1:    LD    C,2        ; console write
  194.     CALL    BDOS
  195. CHROE:    POP    HL
  196.     POP    DE
  197.     POP    BC
  198.     RET
  199.  
  200. ; flush output file buffer
  201. FLUSH::
  202.     LD    DE,OUTDMA
  203.     LD    C,26        ; set DMA
  204.     CALL    BDOS
  205.     LD    DE,OUTFCB
  206.     LD    C,21        ; write sequential
  207.     CALL    BDOS
  208.     OR    A
  209.     RET    Z
  210.     LD    HL,DSKERR
  211.     JP    FATAL##
  212.     DSEG
  213. DSKERR:    DB    CR,LF,'DISK WRITE ERROR.',0
  214.     CSEG
  215.  
  216. ;msg(s)
  217. ;  char * s;
  218. ;  {
  219. ;  register char c;
  220. ;  while(c = *s++)
  221. ;    chrout(c);
  222. ;  }
  223. MSG::
  224.     LD    A,(HL)
  225.     INC    HL
  226.     OR    A
  227.     RET    Z
  228.     CALL    CHROUT
  229.     JR    MSG
  230.  
  231. ; close existing output device
  232. CLOSE::
  233.     LD    A,(OUTF)    ; output device
  234.     DEC    A
  235.     LD    A,0
  236.     LD    (OUTF),A    ; revert to console
  237.     RET    NZ
  238.     LD    HL,(OUTP)
  239. CLOSE0:    ?CPHL    OUTE
  240.     JR    Z,CLOSE1
  241.     LD    (HL),CTLZ    ; fill with ^Z
  242.     INC    HL
  243.     JR    CLOSE0
  244. CLOSE1:    CALL    FLUSH
  245.     LD    DE,OUTFCB
  246.     LD    C,16        ; close file
  247.     CALL    BDOS
  248.     RET
  249.  
  250. ;eprint(ex,ls)        /* recursive */
  251. ;  EXPR ex;
  252. ;  LSUBST ls;
  253.     DSEG
  254. EXP:    DW    0
  255. LSU:    DW    0
  256. ;  {
  257. ;  EXPR e;
  258. ;  SUBVAL sv;
  259. SV:    DW    0
  260.     CSEG
  261. EPRINT::
  262. ;
  263.     LD    (EXP),HL
  264.     LD    (LSU),DE
  265. ;  e.list = ex;    /* synonym */
  266. ;  if (varp(ex) && ls != (LSUBST)empty)
  267.     CALL    VARP
  268.     JP    Z,EP1
  269.     LD    HL,(LSU)
  270.     ?CPHL    EMPTY
  271.     JR    Z,EP1
  272. ;    {
  273. ;    sv.val = value(vf(ex,ls));
  274.     LD    HL,(EXP)
  275.     LD    DE,(LSU)
  276.     CALL    VF##
  277.     CALL    VALUE##
  278.     LD    (SV),HL
  279. ;    if (substp(sv.val))
  280.     CALL    SUBSTP##
  281.     JR    NZ,EP1
  282. ;      ;
  283. ;    else
  284. ;      {
  285. ;      ex = e.list = sv.assgn->sexp.list;
  286.     CALL    @EXPR##
  287.     LD    (EXP),HL
  288. ;      ls = sv.assgn->slist;
  289.     LD    HL,(SV)
  290.     CALL    @SLIST##
  291.     LD    (LSU),HL
  292. ;      }
  293. ;    }
  294. EP1:
  295. ;  if (numbp(ex))
  296. ;    return prdec(ex);
  297.     LD    HL,(EXP)
  298.     CALL    NUMBP##
  299.     JP    NZ,PRDEC
  300. ;  if (symbp(ex))
  301. ;    return msg(e.symbol->string);
  302.     CALL    SYMBP##
  303.     JR    Z,EP2
  304.     CALL    @STR##
  305.     JP    MSG
  306. EP2:
  307. ;  chrout('(');
  308.     LD    A,'('
  309.     CALL    CHROUT
  310. ;  while (ex != (PAIR)empty)
  311. EP3:
  312.     LD    HL,(EXP)
  313.     ?CPHL    EMPTY
  314.     JP    Z,EP4
  315. ;    {
  316. ;    eprint(ex->left.list,ls);
  317.     LD    HL,(SV)
  318.     PUSH    HL
  319.     LD    HL,(EXP)
  320.     PUSH    HL
  321.     CALL    @LEFT##
  322.     LD    DE,(LSU)
  323.     PUSH    DE
  324.     CALL    EPRINT        ; recursion
  325.     POP    HL
  326.     LD    (LSU),HL
  327.     POP    HL
  328.     POP    DE
  329.     LD    (SV),DE
  330. ;    ex = e.list = ex->right.list;
  331.     CALL    @RIGHT##
  332.     LD    (EXP),HL
  333. ;    if (varp(ex) && ls != (LSUBST)empty)
  334.     CALL    VARP##
  335.     JR    Z,EP5
  336.     LD    HL,(LSU)
  337.     ?CPHL    EMPTY
  338.     JR    Z,EP5
  339. ;      {
  340. ;      sv.val = value(vf(ex,ls));
  341.     LD    HL,(EXP)
  342.     LD    DE,(LSU)
  343.     CALL    VF##
  344.     CALL    VALUE##
  345.     LD    (SV),HL
  346. ;      if (substp(sv.val))
  347. ;        ;
  348.     CALL    SUBSTP
  349.     JR    NZ,EP5
  350. ;      else
  351. ;        {
  352. ;        ex = e.list = sv.assgn->sexp.list;
  353.     LD    HL,(SV)
  354.     CALL    @EXPR##
  355.     LD    (EXP),HL
  356. ;        ls = sv.assgn->slist;
  357.     LD    HL,(SV)
  358.     CALL    @SLIST
  359.     LD    (LSU),HL
  360. ;        }
  361. ;      }
  362. EP5:
  363. ;    if (! listp(ex))
  364. ;      {
  365.     LD    HL,(EXP)
  366.     CALL    LISTP
  367.     JR    NZ,EP6
  368. ;      msg(" | ");
  369.     LD    HL,EPM
  370.     DSEG
  371. EPM:    DB    ' | ',0
  372.     CSEG
  373.     CALL    MSG
  374. ;      eprint(ex,ls);
  375.     LD    HL,(SV)
  376.     PUSH    HL
  377.     LD    HL,(EXP)
  378.     PUSH    HL
  379.     LD    DE,(LSU)
  380.     PUSH    DE
  381.     CALL    EPRINT        ; recursion
  382.     POP    HL
  383.     LD    (LSU),HL
  384.     POP    HL
  385.     LD    (EXP),HL
  386.     POP    HL
  387.     LD    (SV),HL
  388. ;      break;
  389.     JR    EP4
  390. ;      }
  391. EP6:
  392. ;    if (ex != (PAIR)empty)
  393. ;      chrout(' ');
  394.     LD    HL,(EXP)
  395.     ?CPHL    EMPTY
  396.     JR    Z,EP8
  397.     LD    A,' '
  398.     CALL    CHROUT
  399. ;    }
  400. EP8:
  401.     JP    EP3
  402. EP4:
  403. ;  return chrout(')');
  404.     LD    A,')'
  405.     JP    CHROUT
  406. ;  }
  407.  
  408. ; print decimal
  409. ;
  410. ; input:
  411. ;    HL = number
  412. ; side effect:
  413. ;    print out in decimal
  414. ; all registers destroyed
  415. PRDEC::
  416.     LD    A,H
  417.     OR    L
  418.     JR    NZ,PRD1
  419.     LD    A,'0'
  420.     JP    CHROUT
  421. PRD1:    LD    BC,DD1
  422. PRD2:    LD    A,(BC)
  423.     LD    E,A
  424.     INC    BC    
  425.     LD    A,(BC)
  426.     LD    D,A
  427.     INC    BC    
  428.     PUSH    HL
  429.     XOR    A
  430.     SBC    HL,DE
  431.     POP    HL
  432.     JR    C,PRD2
  433. PRDL:    XOR    A
  434. PRD3:    SBC    HL,DE
  435.     JR    C,PRD4
  436.     INC    A
  437.     JR    PRD3
  438. PRD4:    ADD    HL,DE
  439.     ADD    A,'0'
  440.     CALL    CHROUT
  441.     LD    A,1
  442.     CP    E
  443.     RET    Z
  444.     LD    A,(BC)
  445.     LD    E,A
  446.     INC    BC    
  447.     LD    A,(BC)
  448.     LD    D,A
  449.     INC    BC    
  450.     JR    PRDL
  451.  
  452.     DSEG
  453. DD1:    DW    10000
  454.     DW    1000
  455.     DW    100
  456.     DW    10
  457.     DW    1
  458.     CSEG
  459.  
  460.     END
  461.