home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / forst / files.s < prev    next >
Encoding:
Text File  |  1993-10-23  |  10.7 KB  |  602 lines
  1. ; FILES: file access words.
  2. ; Copyright <C> John Redmond 1989, 1990
  3. ; Public domain for non-commercial use.
  4. ;
  5.     section    text
  6.     even
  7. ;
  8. _filemod: dc.w    14            ;14 headers in module
  9.     dc.w    savea7-_fmake        ;length of module
  10. ;
  11. _fmake: pop    d0            ;file mode
  12.     pop    d1            ;^file name
  13.     movem.l d2/a2/a3/a6,-(a7)     ;data stack ptr
  14.     move.w    d0,-(a7)
  15.     move.l    d1,-(a7)
  16.     move.w    #$3c,-(a7)
  17.     trap    #1
  18.     add.l    #8,a7
  19.     movem.l (a7)+,d2/a2/a3/a6
  20.     push    d0            ;returned value
  21.     rts
  22. ;
  23. _open:    pop    d0            ;file mode
  24.     pop    d1            ;^file name
  25.     movem.l    d2/a2/a3/a6,-(a7)    ;data stack ptr
  26.     move.w    d0,-(a7)
  27.     move.l    d1,-(a7)
  28.     move.w    #$3d,-(a7)
  29.     trap    #1
  30.     add.l    #8,a7
  31.     movem.l (a7)+,d2/a2/a3/a6
  32.     cmp.l    #-32,d0
  33.     bgt    .opx
  34.     lea    operror,a0
  35.     bra    _error
  36. .opx:    push    d0            ;returned value
  37.     rts
  38. ;
  39. _close: pop    d0
  40.     movem.l    d2/a2/a3/a6,-(a7)
  41.     move.w    d0,-(a7)        ;handle
  42.     move.w    #$3e,-(a7)
  43.     trap    #1
  44.     addq.l    #4,a7
  45.     movem.l (a7)+,d2/a2/a3/a6
  46.     cmp.l    #-32,d0
  47.     bgt    .clx
  48.     lea    clerror,a0
  49.     bra    _error
  50. .clx:    rts
  51. ;
  52. _seek:    movem.l d2,-(a7)
  53.     pop    d0            ;offset
  54.     pop    d1            ;seek mode
  55.     pop    d2            ;handle
  56.     movem.l d2/a2/a3/a6,-(a7)
  57.     move.w    d1,-(a7)
  58.     move.w    d2,-(a7)
  59.     move.l    d0,-(a7)
  60.     move.w    #$42,-(a7)
  61.     trap    #1
  62.     add.l    #10,a7
  63.     movem.l (a7)+,d2/a2/a3/a6
  64.     push    d0            ;position in file
  65.     move.l    (a7)+,d2
  66.     rts
  67. ;
  68. _read:    move.l    d2,-(a7)
  69.     movem.l (a6)+,d0-d2
  70.     movem.l    d2/a2/a3/a6,-(a7)
  71.     move.l    d1,-(a7)        ;^buffer
  72.     move.l    d0,-(a7)        ;count
  73.     move.w    d2,-(a7)        ;handle
  74.     move.w    #$3f,-(a7)
  75.     trap    #1
  76.     add.l    #12,a7
  77.     movem.l (a7)+,d2/a2/a3/a6
  78.     push    d0
  79.     move.l    (a7)+,d2
  80.     rts
  81. ;
  82. _write: move.l    d2,-(a7)
  83.     movem.l (a6)+,d0-d2
  84.     movem.l d2/a2/a3/a6,-(a7)
  85.     move.l    d2,-(a7)        ;^buffer
  86.     move.l    d0,-(a7)        ;count
  87.     move.w    d1,-(a7)        ;handle
  88.     move.w    #$40,-(a7)
  89.     trap    #1
  90.     add.l    #12,a7
  91.     movem.l (a7)+,d2/a2/a3/a6
  92.     push    d0
  93.     move.l    (a7)+,d2
  94.     rts
  95. ;
  96. _malloc: pop    d0
  97.     movem.l d2/a2/a3/a6,-(a7)
  98.     move.l    d0,-(a7)
  99.     move.w    #$48,-(a7)
  100.     trap    #1
  101.     addq.l    #6,a7
  102.     movem.l (a7)+,d2/a2/a3/a6
  103.     push    d0
  104.     rts
  105. ;
  106. _mfree: pop    d0
  107.     movem.l d2/a2/a3/a6,-(a7)
  108.     move.l    d0,-(a7)
  109.     move.w    #$49,-(a7)
  110.     trap    #1
  111.     addq.l    #6,a7
  112.     movem.l (a7)+,d2/a2/a3/a6
  113.     push    d0
  114.     rts
  115. ;
  116. _fopen: pop    a1            ;^name
  117.     pop    d0            ;fmode
  118.     move.l    (a6),a0            ;^file
  119.     move.l    d0,16(a0)
  120.     push    a1
  121.     push    #0
  122.     tst.l    d0            ;fmode
  123.     bne    .fo5            ;create if non-zero
  124.     bsr    _open            ;open in read mode
  125.     bra    .fo6
  126. .fo5:    bsr    _fmake            ;create new r/w file
  127. .fo6:    pop    d0            ;handle
  128.     move.l    (a6),a0            ;^file
  129.     move.l    d0,12(a0)        ;save handle in file
  130.     push    #1024
  131.     bsr    _malloc
  132.     pop    d0            ;^buffer
  133.     pop    a0            ;^file
  134.     move.l    d0,4(a0)        ;^next char
  135.     move.l    d0,8(a0)        ;^buffer
  136.     clr.l    (a0)            ;0 chars in buffer
  137.     clr.l    20(a0)            ;no chars so far written or read
  138.     rts
  139. ;
  140. _fclose: pop    a0            ;^file
  141.     move.l    16(a0),d0        ;fmode
  142.     beq    .fc5
  143.     bsr    pblock
  144. .fc5:    push    a0
  145.     push    8(a0)            ;^buffer
  146.     bsr    _mfree
  147.     addq.l    #4,a6            ;drop result
  148.     pop    a0
  149.     push    12(a0)            ;handle
  150.     bsr    _close
  151.     rts
  152. ;
  153. _getc:    pop    d0
  154.     cmp.l    #5,d0
  155.     bgt    gc1            ;get from file buffer
  156.     asl.l    #2,d0
  157.     lea    inp,a0
  158.     move.l    0(a0,d0.l),d0        ;get routine offset address
  159.     jmp    (a5,d0.l)
  160. bgetc:    pop    d0            ;source
  161. gc1:    move.l    d0,a0
  162.     move.l    (a0),d1            ;#chars in buffer
  163.     bne    .gc6
  164.     bsr    gblock
  165.     tst.l    d1
  166.     bne    .gc6
  167.     move.l    #-1,d0            ;return error
  168.     bra    .gcx
  169. .gc6:    clr.l    d0
  170.     move.l    4(a0),a1
  171.     move.b    (a1)+,d0
  172.     move.l    a1,4(a0)
  173.     subq.l    #1,d1
  174.     move.l    d1,(a0)            ;#chars still in buffer
  175. .gcx:    push    d0            ;return char
  176.     rts
  177. ;
  178. _putc:    pop    d0            ;file handle
  179.     cmp.l    #5,d0            ;standard handle?
  180.     bgt    .pc1
  181.     asl.l    #2,d0
  182.     lea    outp,a0
  183.     move.l    0(a0,d0.l),d0        ;get routine offset address
  184.     jmp    (a5,d0.l)
  185. .pc1:    move.l    d0,a0            ;non-standard file address
  186.     move.l    (a0),d1            ;#chars in buffer
  187.     cmp.l    #1024,d1        ;full
  188.     blt    .pc5
  189.     bsr    pblock
  190. .pc5:    pop    d0            ;char
  191.     move.l    4(a0),a1        ;char pointer
  192.     move.b    d0,(a1)+        ;store char
  193.     move.l    a1,4(a0)        ;return pointer
  194.     addq.l    #1,d1            ;#chars there now
  195.     move.l    d1,(a0)
  196.     rts
  197. ;
  198. bwrite: bsr    _write            ;write with built-in check
  199.     pop    d0
  200.     bgt    .bwx
  201.     lea    wrerror,a0
  202.     bra    _error
  203. .bwx:    rts
  204. ;
  205. gblock: move.l    8(a0),4(a0)        ;reset char pointer
  206.     push    a0
  207.     push    12(a0)            ;handle
  208.     push    8(a0)            ;buffer address
  209.     push    #1024            ;buffer size
  210.     bsr    _read
  211.     pop    d1            ;#chars read
  212.     pop    a0            ;^file
  213.     move.l    d1,(a0)            ;#chars read this time
  214.     add.l    d1,20(a0)        ;update total #chars read
  215.     rts
  216. ;
  217. pblock: move.l    (a0),d1            ;a0 points to file
  218.     beq    .pbx
  219.     clr.l    (a0)            ;0 chars to be left in buffer
  220.     push    a0
  221.     move.l    8(a0),4(a0)        ;reset char pointer
  222.     push    8(a0)            ;^buffer
  223.     push    12(a0)            ;handle
  224.     add.l    d1,20(a0)        ;update #chars so far written
  225.     push    d1            ;#chars to write now
  226.     bsr    _write
  227.     addq.l    #4,a6            ;drop result
  228.     pop    a0
  229.     clr.l    d1            ;0 chars now in buffer
  230. .pbx:    rts
  231. ;
  232. _lseek: move.l    8(a6),a0        ;^file
  233.     move.l    12(a0),8(a6)        ;file handle
  234.     move.l    a0,-(a7)        ;save ^file
  235.     bsr    _seek
  236.     move.l    (a7)+,a0
  237.     clr.l    (a0)            ;0 chars in buffer
  238.     pop    20(a0)            ;position in file
  239.     rts
  240. ;
  241. _ftell: pop    a0            ;^file
  242.     move.l    20(a0),d0
  243.     tst.l    16(a0)            ;get mode
  244.     beq    .rd            ;read mode
  245.     add.l    (a0),d0            ;else write mode
  246.     bra    .posx
  247. .rd:    sub.l    (a0),d0
  248. .posx:    push    d0            ;#chars read or written
  249.     rts
  250. ;
  251. savea7:    ds.l    1
  252. ;
  253. dummy:    push    #0            ;dummy input
  254.     rts
  255. ;
  256. _rename: pop    d0            ;^ new name
  257.     pop    d1            ;^ old name
  258.     movem.l    d2/a2/a3/a6,-(a7)
  259.     move.l    d0,-(a7)
  260.     move.l    d1,-(a7)
  261.     move.w    #0,-(a7)        ;dummy
  262.     move.w    #$56,-(a7)
  263.     trap    #1
  264.     add.l    #12,a7
  265.     movem.l (a7)+,d2/a2/a3/a6
  266.     push    d0
  267.     rts
  268. ;
  269. _delete: pop    d0            ;^name
  270.     movem.l    d2/a2/a3/a6,-(a7)
  271.     move.l    d0,-(a7)
  272.     move.w    #$41,-(a7)
  273.     trap    #1
  274.     addq.l    #6,a7
  275.     movem.l (a7)+,d2/a2/a3/a6
  276.     push    d0
  277.     rts
  278. ;
  279. _chmod:     movem.l (a6)+,d0/d1/a0        ;^name,flag,attrib
  280.     movem.l    d2/a2/a3/a6,-(a7)
  281.     move.w    d0,-(a7)        ;attrib
  282.     move.w    d1,-(a7)        ;mode
  283.     move.l    a0,-(a7)        ;^name
  284.     move.w    #$43,-(a7)
  285.     trap    #1
  286.     add.l    #10,a7
  287.     movem.l (a7)+,d2/a2/a3/a6
  288.     push    d0
  289.     rts
  290. ;
  291. _setdrv: pop    d0            ;drive
  292.     movem.l    d2/a2/a3/a6,-(a7)
  293.     move.w    d0,-(a7)        ;drive
  294.     move.w    #$0e,-(a7)
  295.     trap    #1
  296.     addq.l    #4,a7
  297.     movem.l (a7)+,d2/a2/a3/a6
  298.     push    d0            ;bitmap of drives present
  299.     rts
  300. ;
  301. _getdrv: movem.l d2/a2/a3/a6,-(a7)
  302.     move.w    #$19,-(a7)
  303.     trap    #1
  304.     addq.l    #2,a7
  305.     movem.l (a7)+,d2/a2/a3/a6
  306.     push    d0            ;current drive
  307.     rts
  308. ;
  309.  
  310. _chdir: pop    d0            ;address of path
  311.     movem.l    d2/a2/a3/a6,-(a7)
  312.     move.l    d0,-(a7)        ;path
  313.     move.w    #$3b,-(a7)
  314.     trap    #1
  315.     addq.l    #6,a7
  316.     movem.l (a7)+,d2/a2/a3/a6
  317.     push    d0
  318.     rts
  319. ;
  320. _fdup:    pop    d0
  321.     movem.l d2/a2/a3/a6,-(a7)
  322.     move.w    d0,-(a7)        ;standard handle
  323.     move.w    #$45,-(a7)
  324.     trap    #1
  325.     addq.l    #4,a7
  326.     movem.l (a7)+,d2/a2/a3/a6
  327.     push    d0
  328.     rts
  329. ;
  330. _force: pop    d0            ;standard handle
  331.     pop    d1            ;nonstandard handle
  332.     movem.l d2/a2/a3/a6,-(a7)
  333.     move.w    d1,-(a7)
  334.     move.w    d0,-(a7)
  335.     trap    #1
  336.     addq.l    #6,a7
  337.     movem.l (a7)+,d2/a2/a3/a6
  338.     push    d0
  339.     rts
  340. ;
  341. _setblock: pop    d0            ;length
  342.     pop    d1            ;start of block
  343.     movem.l d2/a2/a3/a6,-(a7)
  344.     move.l    d0,-(a7)
  345.     move.l    d1,-(a7)
  346.     clr.w    -(a7)
  347.     move.w    #$4a,-(a7)
  348.     trap    #1
  349.     add.l    #12,a7
  350.     movem.l (a7)+,d2/a2/a3/a6
  351.     push    d0
  352.     rts
  353. ;
  354. _sfirst: pop    d0            ;attribute
  355.     pop    d1            ;^name
  356.     movem.l d2/a2/a3/a6,-(a7)
  357.     move.w    d0,-(a7)
  358.     move.l    d1,-(a7)
  359.     move.w    #$4e,-(a7)
  360.     trap    #1
  361.     addq.l    #8,a7
  362.     movem.l (a7)+,d2/a2/a3/a6
  363.     push    d0
  364.     rts
  365. ;
  366. _snext: movem.l d2/a2/a3/a6,-(a7)
  367.     move.w    #$4f,-(a7)
  368.     trap    #1
  369.     addq.l    #2,a7
  370.     movem.l (a7)+,d2/a2/a3/a6
  371.     push    d0
  372.     rts
  373. ;
  374. _getdta: movem.l d2/a2/a3/a6,-(a7)
  375.     move.w    #$2f,-(a7)
  376.     trap    #1
  377.     addq.l    #2,a7
  378.     movem.l (a7)+,d2/a2/a3/a6
  379.     push    d0
  380.     rts
  381. ;
  382. _setdta: pop    d0            ;^dta
  383.     movem.l d2/a2/a3/a6,-(a7)
  384.     move.l    d0,-(a7)
  385.     move.w    #$1a,-(a7)
  386.     trap    #1
  387.     addq.l    #6,a7
  388.     movem.l (a7)+,d2/a2/a3/a6
  389.     push    d0
  390.     rts
  391. ;
  392. _exec:    movem.l d2-d7/a2-a6,-(a7)
  393.     lea    savea7,a0
  394.     move.l    a7,(a0)
  395.     pop    d0            ;mode
  396.     pop    d1            ;file name
  397.     pop    d2            ;command line
  398.     pop    d3            ;environment
  399.  
  400.     move.l    d3,-(a7)
  401.     move.l    d2,-(a7)
  402.     move.l    d1,-(a7)
  403.     move.w    d0,-(a7)
  404.     move.w    #$4b,-(a7)
  405.     trap    #1
  406.  
  407.     lea    savea7,a0
  408.     move.l    (a0),a7
  409.     movem.l    (a7)+,d2-d7/a2-a6
  410.     add.l    #16,a6            ;drop 4 parameters from data stack
  411.     rts
  412. ;
  413. open1:    bsr    getbuff            ;(--^file,filehandle)
  414.     clr.l    -(a6)            ;file mode
  415.     bsr    name
  416.     add.l    #1,(a6)
  417.     bsr    _fopen
  418.     move.l    (a6),a0            ;copy ^file
  419.     push    12(a0)            ;file handle
  420.     rts
  421. ;
  422. _load:    bsr    open1
  423.     pop    d0            ;get resulting handle
  424.     bpl    .ldx
  425.     lea    operror,a0
  426.     bra    _error
  427. .ldx:    bsr    pushin            ;redirect & save old source
  428.     rts
  429. ;
  430. _run:    lea    .null,a0
  431.     push    a0            ;environment
  432.  
  433.     bsr    name            ;BL WORD with check
  434.     pop    a0
  435.     moveq.l    #0,d0
  436.     move.b    (a0)+,d0
  437.     addq.l    #2,d0            ;file name length
  438.     
  439.     push    a0
  440.     push    d0
  441.     bsr    _pad
  442.     pop    d1
  443.     move.l    d1,-(a7)        ;save pad
  444.     
  445.     pop    d0
  446.     push    d1            ;pad
  447.     push    d0            ;length
  448.     bsr    _cmove
  449.     
  450.     push    #13
  451.     bsr    _word
  452.     
  453.     push    (a7)+            ;file name
  454.     
  455.     push    #0            ;mode
  456.     bsr    _exec
  457.     bsr    _key
  458.     bsr    _drop
  459.     rts
  460. ;
  461. .null    dc.w    0
  462. ;
  463. _save:    bsr    name
  464.     add.l    #1,(a6)
  465.     push    #0            ;read-write mode
  466.     bsr    _fmake
  467.     pop    d0            ;get result
  468.     bpl    .sv5
  469.     lea    operror,a0
  470.     bra    _error
  471. .sv5:    move.l    d0,-(a7)        ;save file handle
  472. ;
  473.     lea    cp,a0
  474.     move.l    (a0),2(a5)        ;code length into file header
  475.     move.l    rstck(pc),d0
  476.     add.l    heads(pc),d0
  477.     add.l    work(pc),d0
  478.     move.l    d0,10(a5)        ;bss length
  479.     bsr    _there
  480.     pop    d0            ;top of headers
  481.     lea    stack,a0
  482.     move.l    (a0),a1            ;start of headers
  483.     sub.l    a1,d0            ;data length (headers)
  484.     move.l    d0,6(a5)        ;header length into file header
  485. ;
  486.     push    a1            ;start of headers
  487.     push    (a7)            ;file handle
  488.     push    d0            ;length of headers
  489. ;
  490.     push    a5            ;code start
  491.     push    (a7)            ;file handle
  492.     push    2(a5)
  493. ;
  494.     push    a5            ;start of code
  495.     push    (a7)            ;file handle
  496.     push    #28            ;file header length
  497. ;
  498.     bsr    bwrite            ;file header
  499.     bsr    bwrite            ;code
  500.     bsr    bwrite            ;headers
  501. ;
  502.     move.l    (a7)+,-(a6)        ;file handle
  503.     bsr    _close
  504.     rts
  505. ;
  506.     section    data
  507.     even
  508. ;
  509.     dc.b    $c7,'FILEMO','D'!$80
  510.     vptrs    _filemod,20
  511. ;
  512.     dc.b    $85,'FMAK','E'!$80
  513.     ptrs    _fmake,18
  514. ;
  515.     dc.b    $84,'OPEN',$a0
  516.     ptrs    _open,18
  517. ;
  518.     dc.b    $85,'CLOS','E'!$80
  519.     ptrs    _close,18
  520. ;
  521.     dc.b    $84,'SEEK',$a0
  522.     ptrs    _seek,18
  523. ;
  524.     dc.b    $84,'READ',$a0
  525.     ptrs    _read,18
  526. ;
  527.     dc.b    $85,'WRIT','E'!$80
  528.     ptrs    _write,18
  529. ;
  530.     dc.b    $85,'LSEE','K'!$80
  531.     ptrs    _lseek,18
  532. ;
  533.     dc.b    $85,'FTEL','L'!$80
  534.     ptrs    _ftell,18
  535. ;
  536.     dc.b    $85,'FOPE','N'!$80
  537.     ptrs    _fopen,18
  538. ;
  539.     dc.b    $86,'FCLOSE',$a0
  540.     ptrs    _fclose,20
  541. ;
  542.     dc.b    $84,'GETC',$a0
  543.     ptrs    _getc,18
  544. ;
  545.     dc.b    $84,'PUTC',$a0
  546.     ptrs    _putc,18
  547. ;
  548.     dc.b    $86,'MALLOC',$a0
  549.     ptrs    _malloc,20
  550. ;
  551.     dc.b    $85,'MFRE','E'!$80
  552.     ptrs    _mfree,18
  553. ;
  554.     dc.b    $84,'FDUP',$a0
  555.     ptrs    _fdup,18
  556. ;
  557.     dc.b    $85,'FORC','E'!$80
  558.     ptrs    _force,18
  559. ;
  560.     dc.b    $88,'SETBLOCK',$a0
  561.     ptrs    _setblock,22
  562. ;
  563.     dc.b    $86,'SETDRV',$a0
  564.     ptrs    _setdrv,20
  565. ;
  566.     dc.b    $86,'GETDRV',$a0
  567.     ptrs    _getdrv,20
  568. ;
  569.     dc.b    $85,'CHDI','R'!$80
  570.     ptrs    _chdir,18
  571. ;
  572.     dc.b    $84,'EXEC',$a0
  573.     ptrs    _exec,18
  574. ;
  575.     dc.b    $86,'DELETE',$a0
  576.     ptrs    _delete,20
  577. ;
  578.     dc.b    $86,'RENAME',$a0
  579.     ptrs    _rename,20
  580. ;
  581.     dc.b    $85,'CHMO','D'!$80
  582.     ptrs    _chmod,18
  583. ;
  584.     dc.b    $86,'SFIRST',$a0
  585.     ptrs    _sfirst,20
  586. ;
  587.     dc.b    $85,'SNEX','T'!$80
  588.     ptrs    _snext,18
  589. ;
  590.     dc.b    $86,'GETDTA',$a0
  591.     ptrs    _getdta,20
  592. ;
  593.     dc.b    $86,'SETDTA',$a0
  594.     ptrs    _setdta,20
  595. ;
  596.     dc.b    $84,'LOAD',$a0
  597.     ptrs    _load,18
  598. ;
  599.     dc.b    $83,'RU','N'!$80
  600.     ptrs    _run,16
  601. ;
  602.