home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / forst / io.s < prev    next >
Encoding:
Text File  |  1993-10-23  |  13.5 KB  |  483 lines
  1. ; IO.S: ForST i/o utilities
  2. ; Copyright <C> John Redmond 1989, 1990
  3. ; Public domain for non-commercial use.
  4. ;
  5.         section text
  6.         even
  7. ;
  8. ;character i/o vectors:
  9. ;
  10. inp:    offs    _conin
  11.         offs    _conin          ;just a safeguard
  12.         offs    _auxin
  13.         offs    dummy           ;dummy char from printer
  14.         offs    dummy
  15. outp:   offs    _conout         ;another safeguard
  16.         offs    _conout
  17.         offs    _auxout
  18.         offs    _prtout
  19.         offs    _drop           ;dummy output
  20. ;
  21. ; INCHAR fetches a char from a file (or a buffer accessed with
  22. ; tib and toin).  The char is returned (or a neg val if input finished).
  23. inchar: movem.l a2-a3,-(a7)
  24.         lea     src,a0
  25.         move.l  (a0),d0         ;SRC has file handle
  26.         beq.s   .conchar
  27. ;
  28.         cmp.l   #-1,d0
  29.         beq     .macchar
  30.         push    d0              ;fetch from file
  31.         bsr     bgetc
  32.         pop     d1              ;get returned char
  33.         bmi.s     .eof          ;return error value
  34.         bra.s   .icx            ;return the char
  35. .delim: move.w  #32,d1          ;replace with a space
  36.         bra.s     .icx
  37. .eof:   moveq.l #-1,d1          ;return negative
  38.         bra.s     .icx
  39. ;
  40. .conchar: lea   htib,a2         ;^#chars in buffer
  41.     lea    tib,a1        ;^buffer address
  42.         lea     toin,a0
  43. .cc5:    move.l  (a0),d0         ;pointer offset
  44.         cmp.l   (a2),d0         ;reached the end?
  45.         blt.s   .cc6
  46.         moveq.l #-1,d1          ;eof
  47.         bra.s   .icx
  48. .cc6:    addq.l  #1,(a0)         ;bump offset            
  49.         move.l  (a1),a1         ;fetch buffer address
  50.         clr.l   d1
  51.         move.b  (a1,d0.l),d1    ;fetch the char
  52. .icx:   push    d1
  53.         movem.l (a7)+,a2-a3
  54.         rts
  55. ;
  56. .macchar:
  57.         lea     hmac,a2         ;^#chars in macro
  58.     lea    macptr,a1       ;^macro  string
  59.     lea    macin,a0    ;^pointer offset
  60.         bra.s   .cc5
  61. ;
  62. clrin:  lea     instkptr,a0
  63.         move.l  a0,(a0)         ;empty the stack
  64.         lea     src,a0
  65.         clr.l   (a0)            ;input from keyboard
  66.         rts
  67. ;
  68. pushin: move.l  a2,-(a7)
  69.         lea     instkptr,a1     ;save source on stack, then redirect
  70.         move.l  (a1),a0
  71.         lea     inbott,a2       ;bottom of instack
  72.         cmpa.l  a0,a2
  73.         blo.s   .pi4
  74.         lea     inserr,a0
  75.         bra     _error          ;in stack overflow
  76. .pi4:    lea     src,a2
  77.         move.l  (a2),d0
  78.         pop     (a2)            ;new source to SRC
  79.     tst.l   d0
  80.         bpl.s   .pi5            ;not presently using a text macro
  81.         lea     macptr,a2
  82.         move.l  (a2),-(a0)      ;text macro source
  83.         lea     hmac,a2
  84.         move.l  (a2),-(a0)      ;# text macro chars left
  85.         lea    macin,a2
  86.         move.l    (a2),-(a0)    ;input pointer offset
  87. .pi5:   move.l  d0,-(a0)        ;save source
  88.         move.l  a0,(a1)         ;save instack pointer
  89.         move.l (a7)+,a2
  90.         rts
  91. ;
  92. popin:  movem.l  a2/a3,-(a7)
  93. ;
  94. ; check current source and close file if necessary
  95.         lea     src,a2          ;get source if one is on the stack
  96.         move.l  (a2),d0         ;current source
  97.         beq     .pina           ;finished if from the keyboard
  98.         bmi     .pin5           ;or if from a macro
  99. ; close the file
  100.         push    a2              ;src
  101.         push    d0              ;current source
  102.         lea     f1,a0
  103.         sub.l   a0,d0
  104.         divu    #bsize,d0       ;calc # file
  105.         lea     bufflgs,a0
  106.         clr.b   (a0,d0.w)       ;mark file as unused
  107.         bsr     _fclose         ;close file
  108.         pop     a2
  109.         
  110. ; check for denesting the input
  111. .pin5:  lea     instkptr,a1
  112.         move.l  (a1),a0
  113.         cmp.l   a0,a1           ;anything on the stack?
  114.         bgt     .pinx           ;if so, get it
  115.         clr.l   (a2)            ;return zero = back to keyboard
  116.         bra     .pina
  117.         
  118. ; pop the next higher level of input
  119. .pinx:  move.l  (a0)+,d0
  120.         bpl.s   .pin9           ;not a text macro source
  121.         
  122. ; pop the text macro parameters
  123.         lea     macin,a3
  124.         move.l  (a0)+,(a3)      ;input pointer offset
  125.         lea     hmac,a3
  126.         move.l  (a0)+,(a3)      ;# chars in source
  127.         lea     macptr,a3
  128.         move.l  (a0)+,(a3)      ;text macro source
  129.  
  130. ; do the denest
  131. .pin9:  move.l  d0,(a2)         ;restore SRC
  132.         move.l  a0,(a1)         ;save instack pointer
  133.         tst.l   d0        ;return non-zero for file or text macro
  134.         bne.s   .piny           ;not keyboard input
  135.  
  136. ; check status of keyboard buffer
  137. .pina   lea     htib,a0
  138.         move.l  (a0),d0        ;chars in keyboard buffer?
  139.         lea    toin,a0
  140.         cmp.l    (a0),d0        ;return zero = used all of them
  141. ;
  142. .piny:  movem.l (a7)+,a2/a3
  143.         rts
  144. ;
  145. getbuff: lea    bufflgs,a0      ;start of buffer flags
  146.         move.l  #(nobuffs-1),d0
  147. .gb3:   tst.b   0(a0,d0.l)
  148.         beq     .bvac
  149.         subq.l   #1,d0
  150.         bpl     .gb3
  151.         lea     xserror,a0
  152.         bra     _error
  153. .bvac:  move.b  #-1,0(a0,d0.l)
  154.         mulu    #bsize,d0
  155.         lea     f1,a0
  156.         add.l   a0,d0           ;return start of file
  157.         push    d0              ;one copy for _fopen
  158.         push    d0              ;and one copy for pushin
  159.         rts
  160. ;
  161. _emit:  lea     dest,a0
  162.         move.l  (a0),d0
  163.         bpl.s   .em5            ;output not teed
  164.         neg.l   d0
  165.         move.l  (a6),d1         ;char
  166.         push    d0              ;true file dest
  167.         push    d1              ;second copy of char
  168.         push    #1              ;console output
  169.         bsr     _putc
  170.         bra.s   .em6
  171. .em5:   push    d0
  172. .em6:   bsr     _putc
  173.         rts
  174. ;
  175. _type:  movem.l  (a6)+,d1/a0    ;pointer,length on dstack
  176.         tst.l   d1
  177.         beq.s     .tyx
  178. .tylp:  clr.l   d0
  179.         move.b  (a0)+,d0 
  180.         movem.l d0/d1/a0,-(a6) 
  181.         bsr.s     _emit
  182.         movem.l (a6)+,d1/a0 
  183.         subq.l  #1,d1 
  184.         bne     .tylp
  185. .tyx:   rts
  186.  
  187. ;
  188. _ctype: movem.l  (a6)+,d1/a0    ;pointer,length on dstack
  189.         tst.l   d1
  190.         beq.s     .tyx
  191. .tylp:  clr.l   d0
  192.         move.b  (a0)+,d0 
  193.         movem.l d0/d1/a0,-(a6) 
  194.         bsr     _conout
  195.         movem.l (a6)+,d1/a0 
  196.         subq.l  #1,d1 
  197.         bne.s     .tylp
  198. .tyx:   rts
  199. ;
  200. _message: bsr   _string         ;print message to the console
  201.         push    #10
  202.         push    #13             ;cr/lf
  203.         bsr     _conout
  204.         bsr     _conout
  205.         rts
  206. ;
  207. _string: bsr    _count          ;message to console
  208.         bsr     _ctype
  209.         rts
  210. ;
  211. _bspace: push   #8
  212.         bsr     _emit
  213.         push    #32
  214.         bsr     _emit
  215.         push    #8
  216.         bsr     _emit
  217.         rts
  218. ;
  219. _bspaces: pop     d0
  220.         ble     .bsx
  221.         subq.l  #1,d0
  222.         push    d0
  223.         bsr     _bspace
  224.         bra     _bspaces
  225. .bsx:   rts
  226. ;
  227. _space: push    #32
  228.         bsr     _emit
  229.         rts
  230. ; 
  231. _spaces: pop     d0
  232.         ble     .bsx
  233.         subq.l  #1,d0
  234.         push    d0
  235.         bsr     _space
  236.         bra     _spaces
  237. .bsx:   rts
  238. ;
  239. ; 
  240. _key:   push    #0
  241.         bsr     _getc
  242.         rts
  243. ; 
  244. _xkey:  move.w  #7,-(a7)
  245.         trap    #1 
  246.         addq.l  #2,a7 
  247.         move.l  d0,d1
  248.         lsr.l   #8,d1
  249.         or.l    d1,d0                   ;scan code in byte 1
  250.         and.l   #$0ffff,d0
  251.         push    d0                      ;return char & scan code
  252.         rts 
  253. ;
  254. ; Words for pictured numeric output.
  255. ;
  256. _hash:                                  ;(number,#chars,^buffer)
  257.         lea     base,a0
  258.         push    (a0)
  259.         bsr     _udmod
  260.         bsr     _swap
  261.         bsr     toasc
  262.         bsr     _hold
  263.         rts
  264. ;
  265. toasc:  pop     d0
  266.         add.b   #'0',d0
  267.         cmp.b   #'9',d0
  268.         bls     .tox                    ;not a hex number
  269.         addq.b  #7,d0
  270. .tox:   push    d0
  271.         rts
  272. ;
  273. _hold:  move.l  d2,-(a7)
  274.         movem.l (a6)+,d0-d2/a0          ;everything off stack
  275.         move.b  d0,-(a0)                ;store char in buffer
  276.         addq.l  #1,d2                   ;increase char count
  277.         movem.l d1/d2/a0,-(a6)          ;for another go
  278.         move.l  (a7)+,d2
  279.         rts
  280. ;
  281. _hashs: bsr     _hash
  282.         move.l  (a6),d0
  283.         bne     _hashs
  284.         rts
  285. ;
  286. _sign:  tst.l   (a6)+                   ;test quotient
  287.         bpl     .six
  288.         push    #'-'                    ;minus sign
  289.         bsr     _hold
  290. .six:   rts
  291. ;
  292. _bhash: bsr     _pad
  293.         pop     a0                      ;buffer pointer
  294.         pop     d0                      ;number for conversion
  295.         clr.l   d1                      ;char counter
  296.         movem.l d0/d1/a0,-(a6)
  297.         rts
  298. ;
  299. _hashb: addq.l  #4,a6
  300.         rts
  301. ;
  302. _bdot:  move.l  (a6),-(a7)              ;>R to save sign
  303.         bsr     _abs
  304.         bsr     _bhash
  305.         bsr     _hashs
  306.         push    (a7)+                   ;R> to fetch sign
  307.         bsr     _sign
  308.         bsr     _hashb
  309.         rts
  310. ;
  311. _dot:   bsr     _bdot
  312.         bsr     _type
  313.         bsr     _space
  314.         rts
  315. ;
  316. _udot:  bsr     _bhash
  317.         bsr     _hashs
  318.         bsr     _hashb
  319.         bsr     _type
  320.         bsr     _space
  321.         rts
  322. ;
  323. _convert: movem.l d3/a2-a4,-(a7)
  324.         pop     a4                      ;string pointer
  325.         addq.l  #1,a4                   ;point to a char
  326.         lea     base,a3
  327.         move.l  (a3),d3                 ;keep number base in D3
  328.         movem.l d3/a4,-(a7)             ;save pointer and base
  329. .co1:   movem.l (a7)+,d3/a4             ;pointer and base back
  330.         clr.l   d0
  331.         move.b  (a4)+,d0                ;fetch next char
  332.         sub.b   #'0',d0                 ;strip ASCII bias
  333.         bcs.s   .cox                    ;char too low
  334.         cmp.b   #10,d0                  ;decimal char?
  335.         bcs.s   .valid
  336.         cmp.b   #16,d0
  337.         bcs.s   .cox                    ;not a proper hex char
  338.         subq.b  #7,d0
  339.         cmp.b   d3,d0
  340.         bcs.s   .valid
  341.         bra.s   .cox                    ;char too high
  342. .valid: movem.l  d3/a4,-(a7)            ;base and pointer
  343.         move.l  (a7),-(a6)
  344.         move.l  d0,-(a7)                ;save next digit
  345.         bsr     _uxmult
  346.         addq.l  #4,a6                   ;trim to 32 bits
  347.         move.l  (a7)+,d0
  348.         add.l   d0,(a6)                 ;add into number
  349.         lea     dpl,a4
  350.         tst.l   (a4)
  351.         bmi.s   .co1                    ;no punctuation
  352.         add.l   #1,(a4)                 ;increment decimal places
  353.         bra.s   .co1
  354. .cox:   subq.l  #1,a4                   ;back up pointer
  355.         push    a4                      ;and return it on top
  356.         movem.l (a7)+,d3/a2-a4
  357.         rts
  358. ;
  359. _number: move.l a4,-(a7)
  360.         lea    dpl,a0
  361.         move.l  #-1,a0                  ;punctuation flag
  362.         pop     a4                      ;^string
  363.         clr.l   -(a6)                   ;number accumulator
  364.         clr.l   d5                      ;sign flag
  365.         cmp.b   #'-',1(a4)              ;minus sign?
  366.         bne.s   .nu1
  367.         addq.l  #1,a4
  368.         subq.l  #1,d5                   ;result negative
  369. .nu1:   move.l  d5,-(a7)                ;save sign
  370.         push    a4
  371. .nu2:   bsr     _convert
  372.         move.l  (a6),a0                 ;copy string pointer
  373.         move.b  (a0),d0                 ;fetch next char
  374.         cmpi.b  #32,d0                  ;pointing to a space?
  375.         beq.s   .nu5                    ;end of valid number
  376.         bsr.s   .punct
  377.         bra.s   .nu2                    ;continue after punct.
  378. .nu5:   addq.l  #4,a6                   ;drop pointer
  379.         tst.l   (a7)+                   ;test sign
  380.         beq.s   .nux
  381.         bsr     _negate
  382. .nux:   move.l  (a7)+,a4
  383.         rts
  384. ;
  385. .punct: cmp.b   #44,d0                  ;, char
  386.         blt     .what
  387.         cmp.b   #47,d0                  ;/ char
  388.         bgt     .what
  389.         lea     dpl,a0
  390.         clr.l   (a0)
  391.         rts
  392. ;
  393. .what:  lea     werror,a0               ;reject illegal non-numeric
  394.         bra     _error
  395. ;
  396. _hex:   lea     base,a0
  397.         move.l  #16,(a0)
  398.         rts
  399. ;
  400. _decimal: lea   base,a0
  401.         move.l  #10,(a0)
  402.         rts
  403. ;
  404. _cret:  push    #10
  405.         bsr     _emit
  406.         push    #13
  407.         bsr     _emit
  408.         rts
  409. ;
  410.         section data
  411.         even
  412. ;
  413. ; character io words
  414. ;
  415.         dc.b    $86,'INCHAR',$a0
  416.         ptrs   inchar,20
  417. ;
  418.         dc.b    $83,'KE','Y'!$80
  419.         ptrs    _key,16
  420. ;
  421.         dc.b    $84,'XKEY',$a0
  422.         ptrs    _xkey,18
  423. ;
  424.         dc.b    $84,'EMIT',$a0
  425.         ptrs    _emit,18
  426. ;
  427.         dc.b    $82,'CR',$a0
  428.         ptrs    _cret,16
  429. ;
  430.         dc.b    $83,'CL','S'!$80
  431.         ptrs    _cls,16
  432. ;
  433.         dc.b    $85,'SPAC','E'!$80
  434.         ptrs    _space,18
  435. ;
  436.         dc.b    $86,'SPACES',$a0
  437.         ptrs   _spaces,20
  438. ;
  439. ; number io words
  440. ;
  441.         dc.b    $83,'HE','X'!$80
  442.         ptrs    _hex,16
  443. ;
  444.         dc.b    $87,'DECIMA','L'!$80
  445.         ptrs    _decimal,20
  446. ;
  447.         dc.b    $87,'INUMBE','R'!$80
  448.         ptrs    _number,20
  449. ;
  450.         dc.b    $87,'CONVER','T'!$80
  451.         ptrs    _convert,20
  452. ;
  453.         dc.b    $82,'<#',$a0
  454.         ptrs    _bhash,16
  455. ;
  456.         dc.b    $82,'#>',$a0
  457.         ptrs    _hashb,16
  458. ;
  459.         dc.b    $84,'HOLD',$a0
  460.         ptrs    _hold,18
  461. ;
  462.         dc.b    $84,'SIGN',$a0
  463.         ptrs    _sign,18
  464. ;
  465.         dc.b    $81,'#'!$80
  466.         ptrs    _hash,14
  467. ;
  468.         dc.b    $82,'#S',$a0
  469.         ptrs    _hashs,16
  470. ;
  471.         dc.b    $82,'U.',$a0
  472.         ptrs    _udot,16
  473. ;
  474.         dc.b    $82,'I.',$a0
  475.         ptrs    _dot,16
  476. ;
  477.         dc.b    $85,'INPU','T'!$80
  478.         vptrs   inp,18
  479. ;
  480.         dc.b    $c6,'OUTPUT',$a0
  481.         vptrs   outp,20
  482. ;
  483.