home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG050.ARK / RTP.ASM < prev    next >
Assembly Source File  |  1984-04-29  |  11KB  |  578 lines
  1. ;
  2. ; TITLE        PASCAL RUNTIME MODULE
  3. ; FILENAME    RTP.ASM
  4. ; AUTHOR    Robert A. Van Valzah   8/30/79
  5. ; LAST REVISED    12/10/79   R.A.V.
  6. ; REASON    changed entry of spalod for hl=lsbyte of alfa
  7. ;
  8. ;
  9. vhu    equ    0    ;verision number hundreds
  10. vtn    equ    0    ;version number tens
  11. vun    equ    8    ;version number units
  12. devrel    equ    'R'    ;development or release version
  13. ;
  14. bdos    equ    5
  15. open    equ    15
  16. close    equ    16
  17. delete    equ    19
  18. readrec    equ    20
  19. writerec equ    21
  20. make    equ    22
  21. setdma    equ    26
  22. ;
  23. romorg    equ    100h
  24.     org    romorg
  25.     jmp    startup
  26.     jmp    base
  27.     jmp    cmpr
  28.     jmp    csp0
  29.     jmp    csp1
  30.     jmp    $
  31.     jmp    csp3
  32.     jmp    $
  33.     jmp    $
  34.     jmp    $
  35.     jmp    $
  36.     jmp    csp8
  37.     jmp    csp9
  38.     jmp    spalit
  39.     jmp    spalod
  40.     jmp    spasto
  41.     jmp    acmpr
  42.     jmp    opr3
  43.     jmp    opr4
  44.     jmp    opr5
  45.     jmp    $
  46.     jmp    $
  47.     jmp    spcal0
  48.     jmp    spcal
  49.     jmp    spret
  50. br    ds    2
  51. ;
  52. ; insert version number in object
  53. ;
  54.     db    'RTP REV '
  55.     db    vhu+'0', vtn+'0', '.', vun+'0', devrel
  56. ;
  57. ; startup sets up the i/o and stacks before transfering to
  58. ; the object code for execution
  59. ;
  60. startup:
  61.     lhld    6    ;set stack under bdos
  62.     mvi    l,0
  63.     sphl
  64.     shld    br    ;inti base reg
  65.     call    setio    ;set ciflag and coflag
  66.     call    openf    ;open files if needed
  67.     jmp    ocode    ;vector to generated object code
  68. ;
  69. ; setio sets ciflag to 0ffh (true) if input is to come from
  70. ; the console (as opposed to 0h if it is to come from disk)
  71. ; and likewise for coflag for console output
  72. ;
  73. setio:
  74.     lda    5dh    ;first name byte of fcb1
  75.     mvi    b,0ffh    ;prepare ciflag value
  76.     cpi    ' '    ;blank means console in
  77.     jz    set1
  78.     cpi    '?'    ;? means console in too
  79.     jz    set1
  80.     inr    b    ;reg b = 0
  81. set1:
  82.     mov    a,b    ;get ciflag value
  83.     sta    ciflag    ;store it
  84.     lxi    h,ifcb    ;copy first name into input fcb
  85.     lxi    d,5ch
  86.     call    copynam
  87.     lda    6dh    ;get first name byte of fcb2
  88.     mvi    b,0ffh    ;same as above
  89.     cpi    ' '
  90.     jz    set2
  91.     cpi    '?'
  92.     jz    set2
  93.     inr    b
  94. set2:
  95.     mov    a,b
  96.     sta    coflag
  97.     lxi    h,ofcb    ;copy second name into output fcb
  98.     lxi    d,6ch
  99.     call    copynam
  100.     ret
  101. ;
  102. ; copynam moves a file name from de to hl.
  103. ; clobbers reg hl, de, b, a.
  104. ;
  105. copynam:
  106.     mvi    b,12    ;filename length
  107. cn1:
  108.     ldax    d    ;get from source
  109.     mov    m,a    ;put to dest
  110.     inx    d
  111.     inx    h
  112.     dcr    b
  113.     jnz    cn1
  114.     ret
  115. ;
  116. ; openf opens the file name in fcb1 for input if ciflag is
  117. ; false and opens the name in fcb2 for output if coflag is
  118. ; false
  119. ;
  120. openf:
  121.     lda    ciflag    ;get ciflag
  122.     ora    a
  123.     jnz    op1    ;skip open if true
  124.     xra    a    ;zap fcbnr
  125.     sta    ifcb+32
  126.     lxi    d,ifcb
  127.     mvi    c,open
  128.     call    bdos
  129.     inr    a
  130.     jz    diskerr    ;not found
  131.     lxi    h,ibuf+80h ;init input buffer pointer
  132.     shld    iptr
  133. op1:
  134.     lda    coflag    ;get coflag
  135.     ora    a
  136.     rnz        ;skip open if true
  137.     lxi    d,ofcb
  138.     mvi    c,delete
  139.     call    bdos
  140.     lxi    d,ofcb
  141.     mvi    c,make
  142.     call    bdos
  143.     inr    a
  144.     jz    diskerr    ;no idrectory space
  145.     xra    a    ;zap fcbnr
  146.     sta    ofcb+32
  147.     lxi    h,obuf    ;init output buffer pointer
  148.     shld    optr
  149.     ret
  150. ;
  151. ; base follow static links back reg a levels, return base
  152. ; in reg hl
  153. ;
  154. base:
  155.     lhld    br    ;start with current base
  156. follow:
  157.     mov    e,m    ;get a link to reg de
  158.     inx    h
  159.     mov    d,m
  160.     xchg        ;link to reg hl
  161.     dcr    a    ;enough links followed?
  162.     jnz    follow    ;no
  163.     ret        ;yes
  164. ;
  165. ; cmpr is called to set flags like (top)-(top-1) before
  166. ; the call to cmpr
  167. ; returns reg a non zero if zero flag is reset
  168. ;
  169. cmpr:
  170.     pop    h    ;cmpr return address to reg hl
  171.     pop    d    ;(top) to reg de
  172.     xthl        ;(top-1) to reg hl, return address to stack
  173.     mov    a,d    ;compare signs
  174.     xra    h
  175.     jp    samsin    ;same sign - unsigned compare ok
  176.     mov    a,d    ;opposite sign
  177.     ral
  178.     mvi    a,0ffh    ;return nonzero value
  179.     ret
  180. samsin:
  181.     mov    a,d    ;compre msb's
  182.     sub    h
  183.     rnz
  184.     mov    a,e
  185.     sub    l
  186.     ret
  187. ;
  188. ; gets gets a character from the pasacl input file.  it
  189. ; comes from the console if ciflag is true, else from disk.
  190. ; char returned in reg a.
  191. ;
  192. gets:
  193.     lda    ciflag
  194.     ora    a
  195.     jnz    ci    ;in from console
  196.     lda    idev
  197.     ora    a
  198.     jnz    ci
  199.     call    idiskch    ;intput disk character
  200.     ret
  201. ci:
  202.     mvi    c,1
  203.     call    bdos
  204.     ret
  205. ;
  206. ; idiskch gets a character from the input disk file to reg a
  207. ;
  208. idiskch:
  209.     lhld    iptr
  210.     mov    a,l
  211.     cpi    (ibuf+80h) and 0ffh
  212.     jnz    noread    ;dont have to read record
  213.     lxi    d,ibuf
  214.     mvi    c,setdma
  215.     call    bdos
  216.     mvi    c,readrec
  217.     lxi    d,ifcb
  218.     call    bdos
  219.     ora    a
  220.     jnz    diskerr
  221.     lxi    d,80h    ;restore dma address
  222.     mvi    c,setdma
  223.     call    bdos
  224.     lxi    h,ibuf
  225. noread:
  226.     mov    a,m    ;get character
  227.     inx    h
  228.     shld    iptr    ;update pointer
  229.     ret
  230. ;
  231. ; putd puts a character to the pascal output file.  it goes
  232. ; to the console if coflag is true, else to the disk.
  233. ; char is passed in reg a.
  234. ;
  235. putd:
  236.     mov    c,a    ;save char while testing coflag
  237.     lda    coflag
  238.     ora    a
  239.     jnz    co    ;out to console
  240.     lda    odev    ;get output device
  241.     ora    a
  242.     jnz    co    ;only device zero can go to disk
  243.     mov    a,c    ;get character back
  244.     call    odiskch    ;out to disk
  245.     ret
  246. co:
  247.     mov    e,c    ;get character back
  248.     mvi    c,2
  249.     call    bdos
  250.     ret
  251. ;
  252. ; odiskch sends the character in reg to the disk output file
  253. ;
  254. odiskch:
  255.     push    psw
  256.     lhld    optr    ;see if past end of out buffer
  257.     mov    a,l
  258.     cpi    (obuf+80h) and 0ffh
  259.     jnz    nowrite    ;nope
  260.     lxi    d,obuf
  261.     mvi    c,setdma
  262.     call    bdos
  263.     lxi    d,ofcb
  264.     mvi    c,writerec
  265.     call    bdos
  266.     ora    a
  267.     jnz    diskerr
  268.     lxi    d,80h    ;restore dma address
  269.     mvi    c,setdma
  270.     call    bdos
  271.     lxi    h,obuf
  272. nowrite:
  273.     pop    psw
  274.     mov    m,a    ;store in buffer
  275.     inx    h
  276.     shld    optr    ;save new pointer
  277.     ret
  278. ;
  279. ; csp0 read a character and push it to stack
  280. ;
  281. csp0:
  282.     sta    idev    ;save input device
  283.     call    gets
  284.     mov    l,a
  285.     mvi    h,0
  286.     xthl
  287.     pchl
  288. ;
  289. ; csp1 pop stack and write it as a character
  290. ;
  291. csp1:
  292.     sta    odev    ;save output device for putd
  293.     pop    h    ;csp1 return address to reg hl
  294.     xthl        ;return adr to stack, (top) to reg hl
  295.     mov    a,l    ;char to reg a for putd
  296.     call    putd
  297.     ret
  298. ;
  299. ; prthl prints the contents of reg hl as a decimal number
  300. ; on the pascal output file
  301. ;
  302. prthl:
  303.     lxi    b,-10    ;divisor
  304. setup:
  305.     lxi    d,-1    ;quotient
  306. sub10:
  307.     dad    b    ;divide by continued subtraction
  308.     inx    d    ;update quotient
  309.     jc    sub10    ;keep dividing till under draft
  310.     mvi    a,10    ;get remainder to reg a
  311.     add    l
  312.     push    psw    ;save on stack
  313.     xchg        ;quotient to reg hl
  314.     mov    a,h    ;any digits left?
  315.     ora    l
  316.     cnz    setup    ;yes - recurse to print next digit
  317.     pop    psw    ;no - get digits to print from
  318.     adi    '0'    ;stack in reverse order & convert
  319.     jmp    putd    ;to ascii and print 'em
  320. ;
  321. ; csp3 pops the stack and writes it as a decimal number to
  322. ; the pascal output file
  323. ;
  324. csp3:
  325.     sta    odev    ;save output device for putd
  326.     pop    h    ;get return address to reg hl
  327.     xthl        ;(top) to reg hl, return address back to stack
  328.     call    prthl    ;print
  329.     ret
  330. ;
  331. ; csp8 prints the alfa variable on the stack
  332. ;
  333. csp8:
  334.     sta    odev    ;save output device for putd
  335.     mvi    d,4    ;number of words to pop
  336. csp81:
  337.     pop    h    ;top word from stack to hl
  338.     xthl
  339.     push    d    ;save word count
  340.     push    h    ;save ms char of word
  341.     mov    a,l    ;print ls char of word
  342.     call    putd
  343.     pop    h    ;get word again
  344.     mov    a,h    ;print ms char of word
  345.     call    putd
  346.     pop    d    ;get word count
  347.     dcr    d    ;doen all 4 words?
  348.     jnz    csp81    ;nope
  349.     ret
  350. ;
  351. ; csp9 returns control to the operating system (boots)
  352. ;
  353. csp9:
  354.     lda    coflag    ;was output to console?
  355.     ora    a
  356.     jnz    0    ;yes - just return to cp/m
  357. seof:
  358.     mvi    a,1ah    ;send eof character
  359.     call    odiskch
  360.     lda    optr
  361.     cpi    (obuf+1) and 0ffh
  362.     jnz    seof    ;until last record has been written
  363.     lxi    d,ofcb
  364.     mvi    c,close
  365.     call    bdos    ;close output file
  366.     inr    a
  367.     jz    diskerr
  368.     jmp    0
  369. diskerr:
  370.     lxi    d,errmsg
  371.     mvi    c,9
  372.     call    bdos
  373.     jmp    0
  374. errmsg:    db    'disk error$'
  375. ;
  376. ; spalit takes the eight bytes following the call to it
  377. ; and pushes them into the stack
  378. ;
  379. spalit:
  380.     pop    h    ;return address to reg hl
  381.     mvi    a,4    ;eight bytes is four words
  382. moralit:
  383.     mov    d,m    ;get a word from code and . . .
  384.     inx    h
  385.     mov    e,m
  386.     inx    h
  387.     push    d    ;push it into the stack
  388.     dcr    a    ;done all words?
  389.     jnz    moralit    ;no
  390.     pchl        ;return to byte following dw's
  391. ;
  392. ; spalod enter with a pointer to lsbyte (first character)
  393. ; of alfa variable and it
  394. ; pushes the variable into the stack
  395. ;
  396. spalod:
  397.     lxi    b,7    ;bias hl to point to msbyte
  398.     dad    b
  399.     pop    b    ;get return address to reg b
  400.     mvi    a,4    ;four words per alfa
  401. moralod:
  402.     mov    d,m    ;get a word from the alfa
  403.     dcx    h
  404.     mov    e,m
  405.     dcx    h
  406.     push    d    ;and push it into the stack
  407.     dcr    a    ;done all words yet?
  408.     jnz    moralod    ;no
  409.     mov    h,b    ;pchl to return address
  410.     mov    l,c
  411.     pchl
  412. ;
  413. ; spasto enter with reg hl pointing to lsbyte (first character)
  414. ; of an alfa variable,
  415. ; an alfa is popped from the stack and stored at reg hl
  416. ;
  417. spasto:
  418.     pop    b    ;get return address
  419.     mvi    a,4    ;four words per alfa
  420. morasto:
  421.     pop    d    ;get a word from the stack
  422.     mov    m,e    ;and store it into alfa
  423.     inx    h
  424.     mov    m,d
  425.     inx    h
  426.     dcr    a    ;done all words yet
  427.     jnz    morasto    ;no
  428.     mov    h,b    ;pchl to return address
  429.     mov    l,c
  430.     pchl
  431. ;
  432. ; acmpr compares two alfa variables on the stack, sets flags
  433. ; like (top)-(top-1)
  434. ;
  435. acmpr:
  436.     lxi    h,18    ;compute stack pointer after
  437.     dad    sp    ;compare is done
  438.     push    h    ;save it
  439.     lxi    d,-8    ;compute address of top-1
  440.     dad    d
  441.     xchg        ;top-1 ptr to reg de
  442.     dad    d    ;top ptr to reg hl
  443.     xchg        ;top ptr to reg de, top-1 to hl
  444.     mvi    c,8    ;chars per alfa
  445. moracmp:
  446.     ldax    d
  447.     cmp    m
  448.     jnz    exitacm    ;miscompare - return with flags
  449.     inx    h
  450.     inx    d
  451.     dcr    c
  452.     jnz    moracmp    ;not done comparing
  453. exitacm:
  454.     pop    h    ;new stack pointer to reg hl
  455.     pop    d    ;return address to reg de
  456.     sphl
  457.     xchg
  458.     pchl
  459. ;
  460. ; opr3 subtracts (top) from (top-1)
  461. ;
  462. opr3:
  463.     pop    h    ;return address to reg hl
  464.     pop    d    ;(top) to reg de
  465.     xthl        ;put back return address, (top-1) to hl
  466.     xra    a    ;negate reg de, holding (top)
  467.     sub    e
  468.     mov    e,a
  469.     sbb    d
  470.     sub    e
  471.     mov    d,a
  472.     dad    d    ;add -(top) to (top-1)
  473.     xthl        ;leave restult on stack and return
  474.     pchl        ;address in reg hl
  475. ;
  476. ; opr4 multiply (top) by (top-1)
  477. ;
  478. opr4:
  479.     pop    h
  480.     pop    d
  481.     xthl
  482.     push    b
  483.     mov    b,h
  484.     mov    c,l
  485.     lxi    h,0
  486. mulmor:
  487.     mov    a,c
  488.     ora    b
  489.     jz    muldone
  490.     dcx    b
  491.     dad    d
  492.     jmp    mulmor
  493. muldone:
  494.     pop    b
  495.     xthl
  496.     pchl
  497. ;
  498. ; opr5 divides (top-1) by (top)
  499. ;
  500. opr5:
  501.     pop    h
  502.     pop    d
  503.     xthl
  504.     push    b
  505.     xra    a    ;negate reg de
  506.     sub    e
  507.     mov    e,a
  508.     sbb    d
  509.     sub    e
  510.     mov    d,a
  511.     lxi    b,-1
  512. mordiv:
  513.     inx    b
  514.     dad    d
  515.     jc    mordiv
  516.     mov    h,b
  517.     mov    l,c
  518.     pop    b
  519.     xthl
  520.     pchl
  521. ;
  522. ; call here with adr to call in reg de
  523. ;
  524. spcal0:
  525.     lhld    br
  526.     push    h    ;static link
  527.     push    h    ;dynamic link
  528.     lxi    h,0
  529.     dad    sp
  530.     shld    br
  531.     xchg        ;pchl to address to call
  532.     pchl
  533. ;
  534. ; call here with level difference in reg a and
  535. ; address to call in reg de
  536. ;
  537. spcal:
  538.     lhld    br    ;dynamic link
  539.     push    h
  540.     push    d    ;save call address
  541.     call    follow    ;get static link
  542.     xthl        ;static link to stack, call addresss to hl
  543.     xchg        ;call address to reg de
  544.     lxi    h,0
  545.     dad    sp
  546.     shld    br
  547.     xchg        ;pchl to call address
  548.     pchl
  549. ;
  550. ; jump here to return from a procedure
  551. ;
  552. spret:
  553.     lhld    br    ;get old sp back
  554.     sphl
  555.     pop    psw    ;pop and ignore static link
  556.     pop    h    ;dynamic link
  557.     shld    br    ;restore base register
  558.     ret
  559. ;
  560. ifcb    db    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  561.     db    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ;a few too many
  562. ofcb    db    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  563.     db    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  564. ciflag    db    0
  565. coflag    db    0
  566. odev    db    0
  567. idev    db    0
  568. ;
  569. iptr    ds    2
  570. optr    ds    2
  571. ibuf    ds    128
  572. obuf    ds    128
  573. ;
  574.     org    (($-1) and 0ff00h) + 100h
  575. ocode:            ;start of compiled code
  576. ;
  577.     end    romorg
  578.