home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / f68k / qlf68k.asm < prev    next >
Encoding:
Assembly Source File  |  1993-10-23  |  36.3 KB  |  991 lines
  1. ;Loader für F68K auf dem QL
  2. ;7.3.1991 by Dirk Kutscher
  3. ;mit VT52-Emulation und Druckerunterstuetzung
  4. ;Letzte Änderung:  --->   Sat   1991 Aug 03 19:46:24  <---
  5. ;Dies ist die Version mit dem neuen Protokoll fuer die
  6. ;Uebergabe der Adressen an F68K duch die forthparas Tabelle.
  7.  
  8.                     DATA      2560
  9.                     ORG       0
  10.  
  11. TIBlength           EQU       $1000     ;space between TIB and RO
  12. syssize             EQU       $010000   ;total space for code
  13. datasize            EQU       $020000   ;total space for data
  14. ;
  15. ;JobHeader
  16. ;
  17.  
  18.                     bra.s     sstart
  19.                     dc.l      0
  20.                     dc.w      $4afb
  21.                     dc.w      13
  22.                     dc.b      'F68K Ver. 1.b'
  23.  
  24. sstart              bra       start
  25. ;--------------------------------------------
  26. ;Fehlerabfangen:
  27. Fehler              tst.l     d0
  28.                     beq.s     okay
  29. Ciao                move.w    $ca,a4
  30.                     jsr       (a4)
  31.                     move.l    d0,d3
  32.                     moveq     #mt_frjob,d0
  33.                     moveq     #-1,d1
  34.                     trap      #1
  35.  
  36. okay                rts
  37. ;-------------------------------------------------
  38. GibMeldung          move.w    ut_err,a5           ; Error code in D0
  39.                     sub.l     a6,a6
  40.                     move.l    a0,a3
  41.                     move.l    ID,a0
  42.                     jsr       (a5)
  43.                     move.l    a3,a0
  44.                     rts
  45. ;-----
  46. Flush               moveq     #-1,d3              ; ID in A0
  47.                     moveq     #fs_flush,d0
  48.                     trap      #3
  49.                     rts
  50.  
  51. Ink                 moveq     #-1,d3              ; ID in A0
  52.                     moveq     #sd_setin,d0        ; Farbe in d1
  53.                     trap      #3
  54.                     rts
  55.  
  56. Over                moveq     #-1,d3              ; ID in A0
  57.                     moveq     #sd_setmd,d0        ; Mode byte in d1
  58.                     trap      #3
  59.                     rts
  60.  
  61. Newline             moveq     #-1,d3              ; ID in A0
  62.                     moveq     #sd_nl,d0
  63.                     trap      #3
  64.                     rts
  65.  
  66. Csize               moveq     #-1,d3              ; ID in A0
  67.                     moveq     #sd_setsz,d0        ; Character width in d1.w
  68.                     trap      #3                  ; Character height in d2.w
  69.                     rts
  70.  
  71. Back                moveq     #-1,d3              ; ID in A0
  72.                     moveq     #sd_pcol,d0
  73.                     trap      #3
  74.                     rts
  75. ;-----------------------------------------------
  76. WennESC             move.b    #-1,d5
  77.                     move.b    Ypsilon,d3
  78.                     tst.b     d3
  79.                     beq.s     e0a
  80.                     cmp.b     #-1,d3
  81.                     bne.s     cp2
  82. /cp1                lea       Ypsilon,a4
  83.                     move.b    d1,(a4)
  84.                     lea       Escape,a4
  85.                     move.b    #27,(a4)
  86.                     clr.l     d1
  87.                     rts
  88. /cp2                clr.l     d2
  89.                     move.b    Ypsilon,d2
  90.                     sub.b     #32,d2
  91.                     sub.b     #32,d1
  92.                     lea       Ypsilon,a4
  93.                     move.b    #0,(a4)
  94.                     lea       Escape,a4
  95.                     move.b    #0,(a4)
  96. SetPos              moveq     #-1,d3              ; ID in A0
  97.                     moveq     #sd_pos,d0          ; Spalte in d1.w
  98.                     trap      #3                  ; Zeile in d2.w
  99.                     clr.l     d1
  100.                     rts
  101.  
  102. e0a                 cmp.b     #65,d1
  103.                     bne.s     e0
  104. CurUp               moveq     #-1,d3
  105.                     moveq     #sd_prow,d0
  106.                     trap      #3
  107.                     rts
  108. e0                  cmp.b     #66,d1
  109.                     bne.s     e1
  110. CurDown             moveq     #-1,d3
  111.                     moveq     #sd_nrow,d0
  112.                     trap      #3
  113.                     rts
  114. e1                  cmp.b     #67,d1
  115.                     bne.s     e2
  116. CurRight            moveq     #-1,d3
  117.                     moveq     #sd_ncol,d0
  118.                     trap      #3
  119.                     rts
  120. e2                  cmp.b     #68,d1
  121.                     bne.s     e3
  122. CurLeft             moveq     #-1,d3
  123.                     moveq     #sd_pcol,d0
  124.                     trap      #3
  125.                     rts
  126. e3                  cmp.b     #69,d1
  127.                     bne.s     e4
  128. Cls                 moveq     #-1,d3
  129.                     moveq     #sd_clear,d0
  130.                     trap      #3
  131.                     rts
  132. e4                  cmp.b     #72,d1
  133.                     bne.s     e5
  134. Home                moveq     #-1,d3
  135.                     moveq     #0,d1
  136.                     moveq     #0,d2
  137.                     moveq     #sd_pos,d0
  138.                     trap      #3
  139.                     rts
  140. e5                  cmp.b     #73,d1
  141.                     bne.s     e6
  142. UpIns               rts
  143. e6                  cmp.b     #74,d1
  144.                     bne.s     e7
  145. DelEop              moveq     #-1,d3
  146.                     moveq     #sd_clrbt,d0
  147.                     trap      #3
  148.                     rts
  149. e7                  cmp.b     #75,d1
  150.                     bne.s     e8
  151. DelEol              moveq     #-1,d3
  152.                     moveq     #sd_clrrt,d0
  153.                     trap      #3
  154.                     rts
  155. e8                  cmp.b     #76,d0
  156.                     bne.s     e9
  157. InsLine             moveq     #-1,d3
  158.                     moveq     #10,d1
  159.                     moveq     #sd_scrbt,d0
  160.                     trap      #3
  161.                     rts
  162. e9                  cmp.b     #77,d0
  163.                     bne.s     e10
  164. DelLine             moveq     #-1,d3
  165.                     move.w    #-10,d1
  166.                     moveq     #sd_scrbt,d0
  167.                     trap      #3
  168.                     rts
  169. e10                 cmp.b     #100,d1
  170.                     bne.s     e11
  171. DelSop              rts
  172. e11                 cmp.b     #101,d1
  173.                     bne.s     e12
  174. curon               moveq     #-1,d3              ; ID in A0
  175.                     moveq     #sd_cure,d0
  176.                     trap      #3
  177.                     rts
  178. e12                 cmp.b     #102,d1
  179.                     bne.s     e13
  180. curoff              moveq     #-1,d3              ; ID in A0
  181.                     moveq     #sd_curs,d0
  182.                     trap      #3
  183.                     rts
  184. e13                 cmp.b     #107,d1
  185.                     bne.s     e14
  186. RestCursor          lea       CuPos,a2
  187.                     move.w    (a2),d2
  188.                     move.w    2(a2),d1
  189.                     exg       d1,d2
  190.                     bsr       SetPos
  191.                     rts
  192. e14                 cmp.b     #108,d1
  193.                     bne.s     e15
  194. EraseLine           moveq     #-1,d3
  195.                     moveq     #sd_clrln,d0
  196.                     trap      #3
  197.                     rts
  198. e15                 cmp.b     #89,d1
  199.                     bne.s     e17
  200. AbsCursor           lea       Ypsilon,a4
  201.                     lea       Escape,a5
  202.                     move.b    #27,(a5)
  203.                     move.b    #-1,(a4)
  204.                     rts
  205. e17                 cmp.b     #106,d1
  206.                     bne.s     e18
  207. StorePos            lea       InqBlock,a1
  208.                     moveq     #-1,d3
  209.                     moveq     #sd_chenq,d0
  210.                     trap      #3
  211.                     rts
  212. e18                 cmp.b     #112,d1
  213.                     bne.s     e19
  214. InvON               move.b    #0,d1
  215.                     bsr       Ink
  216.                     move.b    #7,d1
  217. Strip               moveq     #-1,d3              ; Strip colour in d1
  218.                     moveq     #sd_setst,d0
  219.                     trap      #3
  220.                     rts
  221. e19                 cmp.b     #113,d1
  222.                     bne.s     e20
  223. InvOFF              move.b    #7,d1
  224.                     bsr       Ink
  225.                     move.b    #0,d1
  226.                     bsr.s     Strip
  227.                     rts
  228. e20                 cmp.b     #118,d1
  229.                     bne.s     e21
  230. WrapON              lea       NoWrap,a4
  231.                     move.b    #0,(a4)
  232.                     rts
  233. e21                 cmp.b     #119,d1
  234.                     bne.s     e22
  235. WrapOFF             lea       NoWrap,a4
  236.                     move.b    #-1,(a4)
  237.                     rts
  238. e22                 move.b    #0,d5
  239.                     rts
  240. ;---------------------------------------------------
  241.  
  242.  
  243. Control             cmp.b     #27,d1
  244.                     bne.s     co0
  245.                     lea       Escape,a4
  246.                     move.b    #27,(a4)
  247.                     rts
  248. co0                 move.b    Escape,d2
  249.                     cmp.b     #27,d2
  250.                     bne.s     co1
  251.                     lea       Escape,a4
  252.                     move.b    #0,(a4)
  253.                     bsr       WennESC
  254.                     tst.b     d5
  255.                     beq.s     co1
  256.                     clr.l     d1
  257.                     rts
  258. co1                 cmp.b     #08,d1              ; key in d1
  259.                     bne.s     co2
  260.                     bsr       CurLeft
  261.                     clr.l     d1
  262.                     rts
  263. co2                 move.b    NoWrap,d6
  264.                     tst.b     d6
  265.                     beq.s     co3
  266.                     cmp.b     #13,d1
  267.                     beq.s     co3
  268.                     moveq     #-1,d3
  269.                     lea       WrapBlock,a1
  270.                     moveq     #sd_chenq,d0
  271.                     trap      #3
  272.                     lea       WrapBlock,a1
  273.                     move.w    $04(a1),d2
  274.                     cmp.w     #79,d2
  275.                     blt.s     co3
  276.                     clr.l     d1
  277. co3                 rts
  278. ;-------
  279.  
  280. AufDev              move.l    a4,a0
  281.                     moveq     #0,d3
  282.                     moveq     #-1,d1
  283.                     moveq     #io_open,d0
  284.                     trap      #2
  285.                     rts                           ; ID in A0
  286.  
  287. position            move.l    a1,a5               ; Buffer pointer retten
  288.                     moveq     #-1,d3              ; ID in A0
  289.                     moveq     #fs_posab,d0        ; position in D1
  290.                     trap      #3                  ; New position in D1.l
  291.                     move.l    a5,a1
  292.                     rts
  293.  
  294. ReadBlock           bsr.s     position            ; File pointer positionieren
  295.                     move.w    #2048,d2            ; ID in A0
  296.                     moveq     #-1,d3              ; Adresse in A1
  297.                     moveq     #io_fstrg,d0
  298.                     trap      #3
  299.                     rts
  300.  
  301.  
  302. WriteBlock          bsr.s     position            ; File pointer positionieren
  303.                     move.w    #2048,d2            ; ID in A0
  304.                     moveq     #-1,d3              ; Adresse in A1
  305.                     moveq     #io_sstrg,d0
  306.                     trap      #3
  307.                     rts
  308.  
  309. PRTauf              lea       Drucker,a0
  310.                     moveq     #-1,d1
  311.                     move.l    #0,d3
  312.                     moveq     #io_open,d0
  313.                     trap      #2
  314.                     lea       prtID,a1
  315.                     move.l    a0,(a1)
  316.                     rts
  317. ;-----------------------------------------------
  318.  
  319. EDITaLINE           move.w    #0,d1               ; Adresse in A1
  320.                     swap      d1                  ; ID in A0
  321.                     move.w    (a1),d1
  322.                     moveq     #30,d2              ; Lenght of Buffer
  323.                     moveq     #-1,d3              ; A1 pointing to end
  324.                     adda.w    (a1),a1             ; of buffer
  325.                     adda.l    #2,a1
  326.                     moveq     #io_edlin,d0
  327.                     trap      #3
  328.                     suba.w    d1,a1
  329.                     suba.l    #2,a1
  330.                     subq.w    #1,d1
  331.                     move.w    d1,(a1)
  332.                     rts
  333.  
  334. ;-------------------------------------------------
  335. start               sub.l     a6,a6               ; A6 loeschen
  336.  
  337.                     moveq     #mt_inf,d0          ; Job ID
  338.                     trap      #1
  339.                     move.l    d1,d2               ; JOB ID in d2
  340.                     move.l    #syssize,d1         ; codespace reservieren
  341.                     add.l     #datasize,d1        ; und dataspace
  342.                     add.l     #40,d1              ; space for Returnstack
  343.                     add.l     #28,d1              ; 28 byte header
  344.                     move.l    d1,d4               ; nach d4 retten
  345.                     moveq     #mt_alchp,d0
  346.                     trap      #1                  ; Adresse in A0
  347.                     cmp.l     d1,d4               ; Fehler auschliessen
  348.                     bgt       Ciao
  349.                     bsr       Fehler              ;wirklich!
  350.                     move.l    a0,a2
  351.                     add.l     #28,a2
  352.                     lea       codeseg,a1
  353.                     move.l    a2,(a1)
  354.                     add.l     #datasize,a2
  355.                     lea       dataseg,a1
  356.                     move.l    a2,(a1)
  357.  
  358. ;-----------------------------------------
  359.  
  360. ;Eine Console fuer F68K:
  361. ConOpen             move.w    ut_con,a4
  362.                     lea       console,a1
  363.                     jsr       (a4)      ;ID in A0
  364.                     bsr       Fehler
  365.                     bsr       Cls
  366.  
  367. ; Die ID soll jetzt gleich an die forthparas Tabelle angefuegt werden,
  368. ; damit sie F68K uebergeben werden kann.
  369.  
  370.                     lea       Standarduebergabe,a5
  371.                     move.l    a0,2(A5)
  372.  
  373. ;Eine kleine Botschaft:
  374.                     move.w    Kutscher,d2
  375.                     lea       Kutscher,a1
  376.                     adda.l    #2,a1
  377.                     moveq     #3,d3
  378.                     moveq     #io_sstrg,d0
  379.                     trap      #3
  380. ;Logo:
  381.                     moveq     #1,d1
  382.                     bsr       Over
  383.                     moveq     #2,d1
  384.                     moveq     #1,d2
  385.                     bsr       Csize
  386.                     moveq     #2,d1
  387.                     bsr       ink
  388.                     move.w    #20,d5
  389.                     move.w    #20,d6
  390.                     moveq     #-1,d3
  391.                     lea       hey,a4
  392.                     move.w    ut_mtext,a5
  393.                     moveq     #10,d4    ; 10mal
  394.                     bra.s     ewloop
  395. /wloop              addq.w    #1,d5
  396.                     addq.w    #1,d6
  397.                     move.w    d5,d1
  398.                     move.w    d6,d2
  399.                     moveq     #-1,d3
  400.                     moveq     #sd_pixp,d0
  401.                     trap      #3
  402.                     move.l    a4,a1
  403.                     jsr       (a5)
  404. /ewloop             dbf       d4,wloop
  405.  
  406.                     moveq     #4,d1
  407.                     bsr       Ink
  408.                     move.w    d5,d1
  409.                     move.w    d6,d2
  410.                     moveq     #-1,d3
  411.                     moveq     #sd_pixp,d0
  412.                     trap      #3
  413.                     move.l    a4,a1
  414.                     jsr       (a5)
  415.                     move.w    #0,d1
  416.                     bsr       Over
  417.                     clr.w     d1
  418.                     clr.w     d2
  419.                     bsr       Csize
  420.                     bsr       Newline
  421.                     bsr       Newline
  422.  
  423.                     move.w    Abfrage,d5
  424.                     tst.w     d5
  425.                     beq.s     NoAbfrage
  426.                     lea       file,a1
  427.                     bsr       EDITaLINE
  428.                     lea       f68kout,a1
  429.                     bsr       EDITaLINE
  430.                     lea       f68kin,a1
  431.                     bsr       EDITaLINE
  432.                     lea       sdev,a1
  433.                     bsr       EDITaLINE
  434.                     lea       rdev,a1
  435.                     bsr       EDITaLINE
  436.  
  437. noAbfrage           moveq     #7,d1
  438.                     bsr       ink
  439.                     lea       ID,a1
  440.                     move.l    a0,(a1)
  441. ;---------------------------------------------
  442.  
  443. Oeffnen             moveq.l   #-1,d1
  444.                     moveq.l   #0,d3
  445.                     lea       file,a0
  446.                     moveq     #io_open,d0
  447.                     trap      #2
  448.                     bsr       Fehler
  449.  
  450.                     moveq     #64,d2              ; Read file header
  451.                     moveq     #-1,d3
  452.                     lea       header,a1
  453.                     moveq     #fs_headr,d0
  454.                     trap      #3
  455.  
  456.                     move.l    header,d2           ; Load F68K_IMG
  457.                     moveq     #-1,d3
  458.                     move.l    codeseg,a1
  459.                     sub.l     #28,a1
  460.                     moveq     #fs_load,d0
  461.                     trap      #3
  462.                     bsr       Fehler
  463.  
  464. Close               moveq     #io_close,d0         ;flp1_F68K_IMG schliessen
  465.                     trap      #2
  466.                     bsr       Fehler
  467.  
  468.                     move.l    codeseg,a0
  469.                     move.l    -22(a0),d0
  470.                     add.l     -26(a0),a0
  471.                     move.l    dataseg,a1
  472.                     divu      #48,d0
  473.                     bra.s     ealp
  474. salp                movem.l   (a0)+,d1-d7/a2-a6
  475.                     movem.l   d1-d7/a2-a6,(a1)
  476.                     adda.l    #48,a1
  477. ealp                dbf       d0,salp
  478.                     clr.w     d0
  479.                     swap      d0
  480.                     divu      #4,d0
  481.                     bra.s     eblp
  482. sblp                move.l    (a0)+,d1
  483.                     move.l    d1,(a1)+
  484. eblp                dbf       d0,sblp
  485.                     clr.w     d0
  486.                     swap      d0
  487.                     bra.s     eclp
  488. sclp                move.b    (a0)+,d1
  489.                     move.b    d1,(a1)+
  490. eclp                dbf       d0,sclp
  491.  
  492.  
  493.  
  494. ;---------------------------------------------
  495. ;----------------------------------------------------------
  496.                     lea       ret,a1
  497.                     move.l    A7,(a1)            ;save returnstackpointer
  498. ;push I/O-Adresses
  499.  
  500.                     lea       key,a1              ; Adressen der
  501.                     lea       ksub,a0             ; Routinen in die
  502.                     move.l    a1,(a0)             ; tables einsetzen
  503.  
  504.                     lea       vt52emit,a1
  505.                     lea       vt52sub,a0
  506.                     move.l    a1,(a0)
  507.                     lea       emit,a1
  508.                     move.l    a1,4(a0)
  509.                     lea       pureEmit,a1
  510.                     move.l    a1,8(a0)
  511.                     lea       printerEmit,a1
  512.                     move.l    a1,12(a0)
  513.  
  514.  
  515.                     lea       keyquest,a1
  516.                     lea       qsub,a0
  517.                     move.l    a1,(a0)
  518.  
  519.                     lea       rw,a1
  520.                     lea       rsub,a0
  521.                     move.l    a1,(a0)
  522.  
  523.                     lea       readsys,a1
  524.                     lea       readsub,a0
  525.                     move.l    a1,(a0)
  526.  
  527.                     lea       writesys,a1
  528.                     lea       writesub,a0
  529.                     move.l    a1,(a0)
  530. ;------------
  531.  
  532.                     lea       t_roottable,a1      ; die Adressen der
  533.                     lea       roottable,a2        ; tables in die
  534.                     move.l    a1,(a2)             ; forthparas Tabelle
  535.                     lea       t_WRITEsys,a1
  536.                     move.l    a1,-(a2)
  537.                     lea       t_READsys,a1
  538.                     move.l    a1,-(a2)
  539.                     lea       t_r_wtable,a1
  540.                     move.l    a1,-(a2)
  541.                     lea       t_keyqtable,a1
  542.                     move.l    a1,-(a2)
  543.                     lea       t_keytable,a1
  544.                     move.l    a1,-(a2)
  545.                     lea       t_emittable,a1
  546.                     move.l    a1,-(a2)
  547.  
  548.                     move.l    #datasize,-(A2)
  549.                     move.l    #syssize,-(A2)
  550.  
  551. ;push memory description
  552.                     move.l    dataseg,d1        ;start of data segment
  553.                     addi.l    #datasize,d1       ;end of data segment
  554.                     move.l    d1,-(A7)            ;Returnstack
  555.                     move.l    d1,d2
  556.                     subi.l    #TIBlength,d2
  557.                     move.l    d2,-(A2)            ;this is the TIB
  558.                     move.l    d1,-(A2)            ; retstk
  559.                     move.l    d2,-(A2)            ; data-stack base
  560.                     move.l    codeseg,-(A2)      ;sysbot
  561.                     move.l    dataseg,-(A2)      ;databot
  562. ;-------------------
  563.  
  564.  
  565. ; Okay:
  566. ; Die Adresse von forthparas auf den Stack
  567.  
  568.                     lea       forthparas,a2
  569.                     move.l    a2,-(a7)
  570. ; Und dann F68K aufrufen:
  571.  
  572.                     move.l    codeseg,a0
  573.                     jsr       (a0)                ;toi toi toi
  574.  
  575.                     movea.l   ret,A7              ;restore returnstack
  576.  
  577.                     move.l    ID,a0              ; Channels schliessen
  578.                     moveq     #io_close,d0
  579.                     trap      #2
  580.  
  581.                     move.w    first,d4
  582.                     tst.w     d4
  583.                     beq.s     cstream
  584.                     move.l    outhandle,a0
  585.                     moveq     #io_close,d0
  586.                     trap      #2
  587.  
  588. cstream             move.l    streamID,d1
  589.                     tst.l     d0
  590.                     beq.s     Crdev
  591.                     move.l    d1,a0
  592.                     moveq     #io_close,d0
  593.                     trap      #2
  594. Crdev               move.l    rawID,d1
  595.                     tst.l     d1
  596.                     beq.s     inclose
  597.                     move.l    d1,a0
  598.                     moveq     #io_close,d0
  599.                     trap      #2
  600.  
  601. inclose             move.l    inhandle,d1
  602.                     tst.l     d1
  603.                     beq.s     Ende
  604.                     move.l    d1,a0
  605.                     moveq     #io_close,d0
  606.                     trap      #2
  607.  
  608. Ende                bra       Ciao                ; und weg
  609.  
  610. ;******************************
  611. ;******* I/O-routines *********
  612. ;******************************
  613.  
  614. ;         1.) KEY ( -- char )
  615. key                 move.l    ID,a0
  616.                     bsr       curon
  617.                     moveq     #-1,d3
  618.                     moveq     #io_fbyte,d0
  619.                     clr.l     d1
  620.                     trap      #3
  621.                     bsr       curoff
  622.                     lea       ID,a1
  623.                     move.l    a0,(a1)
  624.                     lea       INuebersetz,a1
  625.                     adda.l     d1,a1
  626.                     move.b    (a1),d0
  627. nix                 rts
  628.  
  629. ;         2.) EMIT ( char -- )
  630. vt52emit            move.l    ID,a0
  631.                     clr.l     d1
  632.                     move.l    4(a7),d1
  633.                     bsr       Control
  634.                     lea       OUTuebersetz,a1
  635.                     adda.l    d1,a1
  636.                     move.b    (a1),d1
  637.                     tst.b     d1
  638.                     beq.s     vtnix2
  639.                     moveq     #-1,d3
  640.                     moveq     #io_sbyte,d0
  641.                     trap      #3
  642.                     lea       ID,a1
  643.                     move.l    a0,(a1)
  644. vtnix2              rts
  645.  
  646. emit                move.l    ID,a0
  647.                     clr.l     d1
  648.                     move.l    4(a7),d1
  649.                     lea       OUTuebersetz,a1
  650.                     adda.l    d1,a1
  651.                     move.b    (a1),d1
  652.                     tst.b     d1
  653.                     beq.s     nix2
  654.                     moveq     #-1,d3
  655.                     moveq     #io_sbyte,d0
  656.                     trap      #3
  657.                     lea       ID,a1
  658.                     move.l    a0,(a1)
  659. nix2                rts
  660.  
  661. pureEmit            move.l    ID,a0
  662.                     move.l    4(a7),d1
  663.                     tst.b     d1
  664.                     beq.s     purenix2
  665.                     moveq     #-1,d3
  666.                     moveq     #io_sbyte,d0
  667.                     trap      #3
  668.                     lea       ID,a1
  669.                     move.l    a0,(a1)
  670. purenix2            rts
  671.  
  672. printerEmit         move.l    prtID,a0
  673.                     move.l    a0,d3
  674.                     tst.l     d3
  675.                     bne.s     Poffen
  676.                     bsr       PRTauf
  677. Poffen              move.l    4(a7),d1
  678.                     tst.b     d1
  679.                     beq.s     PRTnix2
  680.                     moveq     #-1,d3
  681.                     moveq     #io_sbyte,d0
  682.                     trap      #3
  683. PRTnix2             rts
  684.  
  685. ;-------------------------------------------
  686. ;         3.) KEY? ( -- flag )
  687. keyquest            move.l    ID,a0
  688.                     move.w    #0,d3
  689.                     moveq     #io_pend,d0
  690.                     trap      #3
  691.                     tst.l     d0
  692.                     beq.s     jawoll
  693.                     clr.l     d0
  694.                     rts
  695. jawoll              moveq     #-1,d0
  696.                     rts
  697.  
  698. ;         4.) R/W ( addr block r/w-flag -- flag )
  699. ;                   4(a7) 8(a7) 12(a7)
  700.  
  701. rw                  move.l    8(a7),d2            ; Block Nr
  702.                     cmp.l     #249,d2
  703.                     bgt.s     fn1
  704. fn0                 lea       streamID,a3
  705.                     lea       sdev,a4
  706.                     bra.s     zu
  707. fn1                 lea       rawID,a3
  708.                     lea       rdev,a4
  709.                     subi.l    #250,d2
  710. zu                  move.l    d2,8(a7)
  711.                     move.l    (a3),a0
  712.                     ;move.l    a0,d5
  713.                     ;tst.l     d5
  714.                     ;bne.s     offen
  715.                     bsr       AufDev              ; ID in A0, name adr in A4
  716.                     tst.l     d0
  717.                     beq.s     offen
  718.                     move.l    #0,(a3)
  719.                     bsr       GibMeldung
  720.                     move.l    #0,d0
  721.                     rts
  722.                     ;move.l    a0,(a3)
  723. offen               move.l    4(a7),a1            ; Block Buffer
  724.                     move.l    8(a7),d1
  725.                     ;move.l    d2,d1
  726.                     muls      #2048,d1
  727.                     move.l    $c(a7),d0
  728.                     tst.l     d0
  729.                     beq.s     BlLies
  730. SchreibBlock        bsr       WriteBlock
  731.                     bra.s     FertigRW
  732. BlLies              bsr       ReadBlock
  733. FertigRW            move.l    a0,(a3)
  734.                     moveq     #2,d0     ; Neu:
  735.                     trap      #2        ; Jetzt immer Close
  736.                     tst.l     d0
  737.                     bne.s     falsch
  738. noError             moveq     #1,d0
  739.                     rts
  740. falsch              bsr       GibMeldung
  741.                     clr.l     d0
  742.                     rts
  743.  
  744. ;         5.) READSYS ( addr count -- flag )
  745. readsys             move.l    inhandle,a0
  746.                     move.l    a0,d1
  747.                     tst.w     d1
  748.                     bne.s     rnocreate
  749.                     moveq.l   #-1,d1
  750.                     move.l    #0,d3
  751.                     lea       f68kin,a0
  752.                     moveq     #io_open,d0
  753.                     trap      #2
  754.                     lea       inhandle,a1
  755.                     move.l    a0,(a1)
  756. Rnocreate           move.l    4(a7),a1
  757.                     move.l    8(a7),d2
  758.                     moveq     #-1,d3
  759.                     moveq     #fs_load,d0
  760.                     trap      #3
  761.                     tst.l     d0
  762.                     beq.s     rOK
  763.                     bsr       GibMeldung
  764.                     move.l   #0,d0
  765.                     rts
  766. rOK                 moveq.l   #-1,d0
  767.                     rts
  768.  
  769.  
  770. ;         6.) WRITESYS ( addr count -- flag )
  771. ;         offsets:       4(A7)  8(A7)    d0
  772. writesys            move.l    outhandle,a0
  773.                     move.l    a0,d1
  774.                     tst.l     d1
  775.                     bne.s     nocreate
  776.                     moveq.l   #-1,d1
  777.                     move.l    #2,d3
  778.                     lea       f68kout,a0
  779.                     moveq     #io_open,d0
  780.                     trap      #2
  781.                     lea       outhandle,a1
  782.                     tst.l     d0
  783.                     beq.s     opOK
  784.                     move.l    #0,(a1)
  785.                     bsr       GibMeldung
  786.                     move.l    #0,d0
  787.                     rts
  788. opOK                move.l    a0,(a1)
  789. nocreate            move.l    4(a7),a1
  790.                     move.l    8(a7),d2
  791.                     moveq     #-1,d3
  792.                     moveq     #fs_save,d0
  793.                     trap      #3
  794.                     tst.l     d0
  795.                     beq.s     wOK
  796.                     bsr       GibMeldung
  797.                     move.l    #0,d0
  798.                     rts
  799. wOK                 moveq.l   #-1,d0
  800.                     ;bsr       Flush
  801.                     rts
  802.  
  803. ;----------------------------------------------------
  804. ;Data:
  805.  
  806. forthparas
  807. registers           ds.l      16
  808. Fdata               ds.l      1
  809. code                ds.l      1
  810. datstk              ds.l      1
  811. retstk              ds.l      1
  812. TIBptr              ds.l      1
  813. codelen             ds.l      1
  814. datalen             ds.l      1
  815. emittable           ds.l      1
  816. keytable            ds.l      1
  817. keyqtable           ds.l      1
  818. r_wtable            ds.l      1
  819. tablereadsys        ds.l      1
  820. tablewritesys       ds.l      1
  821. roottable           ds.l      1
  822. ;---------------------------------
  823. ; Ich habe hier jetzt den Versuch einer Standardparameteruebergabe
  824. ; eingefuegt:
  825. ; Es folgt ein  word mit der Anzahl der fuer F68K geoeffneten Kanaele,
  826. ; gefolgt von der/den ID(s) (long). Danach sollen 128 Bytes fuer Strings
  827. ; etc. reserviert werden...
  828.  
  829. Standarduebergabe   dc.w      1
  830.                     ds.l      1
  831. Teststring          dc.w      24
  832.                     dc.b      'Dies ist der Teststring!'
  833.                     ds.b      104
  834. ;----------------------------------
  835.  
  836. t_roottable         dc.l      2
  837.                     dc.l      0
  838.                     dc.l      250
  839.                     dc.l      250
  840.                     dc.l      49
  841.  
  842. t_keytable          dc.l      1
  843. ksub                dc.l      key
  844.  
  845. t_emittable         dc.l      4
  846. vt52sub             dc.l      vt52emit
  847. esub                dc.l      emit
  848. psub                dc.l      pureEmit
  849. prtsub              dc.l      printerEmit
  850.  
  851. t_keyqtable         dc.l      1
  852. qsub                dc.l      keyquest
  853.  
  854. t_r_wtable          dc.l      1
  855. rsub                dc.l      rw
  856.  
  857. t_readsystable      dc.l      1
  858. readsub             dc.l      readsys
  859.  
  860. t_writesystable     dc.l      1
  861. writesub            dc.l      writesys
  862.  
  863. ;------------------------
  864. ; Es folgt der Block für das Konfigurationsprogramm Config_exe
  865.  
  866. first               dc.w      0
  867. Kennung             dc.b      '⇩DK⇩'
  868. file                dc.w      13
  869.                     dc.b      'flp1_f68k_img'
  870.                     ds.b      17
  871.  
  872. f68kout             dc.w      13
  873.                     dc.b      'flp1_f68k_out'
  874.                     ds.b      17
  875.  
  876. f68kin              dc.w      12
  877.                     dc.b      'flp1_f68k_in'
  878.                     ds.b      18
  879.  
  880. sdev                dc.w      12
  881.                     dc.b      'flp1_DEV_SCR'
  882.                     ds.b      18
  883.  
  884. rdev                dc.w      12
  885.                     dc.b      'flp1_RAW_SCR'
  886.                     ds.b      18
  887.  
  888. Drucker             dc.w      4
  889.                     dc.b      'ser1'
  890.                     ds.b      26
  891.  
  892. Abfrage             dc.w     -1         ; soll abgefragt werden
  893. ;---------------------
  894.  
  895. streamID            dc.l      0
  896. rawID               dc.l      0
  897.  
  898.  
  899. Kutscher            dc.w      53
  900.                     dc.b      '*** F68K-Lader für Sinclair QL von Dirk Kutscher ***',10
  901. hey                 dc.w      20
  902.                     dc.b      "Hey Ho - Let's Go !!"
  903.  
  904. console             dc.b      %11010111
  905.                     dc.b      2,0,4
  906.                     dc.w      490,254,11,1
  907. ID                  ds.l      1         ;Channel ID
  908.  
  909. prtID               dc.l      0
  910.  
  911.  
  912. outhandle           dc.l      0
  913. inhandle            dc.l      0
  914. ret                 ds.l      1         ;Returnstack
  915. fileheader          ds.b      28        ;Programmheader
  916. .codeseg            ds.l      1
  917. .dataseg            ds.l      1
  918.                    ;ds.l      10
  919. header              ds.b      64
  920.  
  921. Escape              dc.b      0
  922. Ypsilon             dc.b      0
  923. InqBlock            ds.w      2
  924. CuPos               ds.w      2
  925. NoWrap              dc.b      0
  926. WrapBlock           ds.w      4
  927.  
  928. ;Uebersetzungstabelle:
  929.  
  930. ;Hier stehen die Bytes für die Umwandlung
  931. ;von Eingabe (QL-code) nach F68K (Atari-code)   --> KEY
  932.  
  933. INuebersetz         dc.b       0,1,2,3,4,5,6,7,8,9
  934.                     dc.b       13,11,12,13,14,15,16,17,18,19 ; 13 = RETURN
  935.                     dc.b       20,21,22,23,24,25,26,27,'ß','¢' ; ^<, ^=
  936.                     dc.b       '¥',31,32,33,34,35,36,37,38,39 ; ^>
  937.                     dc.b       40,41,42,43,44,45,46,47,48,49
  938.                     dc.b       50,51,52,53,54,55,56,57,58,59
  939.                     dc.b       60,61,62,63,64,65,66,67,68,69
  940.                     dc.b       70,71,72,73,74,75,76,77,78,79
  941.                     dc.b       80,81,82,83,84,85,86,87,88,89
  942.                     dc.b       90,91,92,93,94,95,96,97,98,99
  943.                     dc.b      100,101,102,103,104,105,106,107,108,109
  944.                     dc.b      110,111,112,113,114,115,116,117,118,119
  945.                     dc.b      120,121,122,123,124,125,126,127,132,129 ; 132 = 'ä'
  946.                     dc.b      130,131,148,133,134,129,136,137,138,139 ; 129 = 'ü', 148 = 'ö'
  947.                     dc.b      140,141,142,143,144,145,146,147,148,149
  948.                     dc.b      150,151,152,153,154,155,158,157,158,159 ; 158 = 'ß'
  949.                     dc.b      142,161,162,163,153,165,166,154,168,169 ; 142 = 'Ä', 153 = 'Ö', 154 = 'Ü'
  950.                     dc.b      170,171,172,173,174,175,176,177,178,179
  951.                     dc.b      180,181,182,183,184,185,186,187,188,189
  952.                     dc.b      190,191,19,193,8,195,196,197,198,199    ; 8=Backspace, 19= <--
  953.                     dc.b      4,201,202,203,204,205,206,207,5,209     ; 4 = -->, 5=Up
  954.                     dc.b      210,211,212,213,214,215,24,217,218,219  ; 24= Down
  955.                     dc.b      220,221,222,223,224,225,226,227,228,229
  956.                     dc.b      230,231,232,233,234,235,236,237,238,239
  957.                     dc.b      240,241,242,243,244,245,246,247,248,249
  958.                     dc.b      250,251,252,253,254,255
  959.  
  960. ;Hier stehen die Bytes für die Umwandlung
  961. ;von F68K (Atari-code) für die Ausgabe (QL-code) --> EMIT
  962.  
  963. OUTuebersetz        dc.b       0,1,2,3,4,5,6,7,0,9          ; 8=Backspace
  964.                     dc.b       0,11,12,10,14,15,16,17,18,19 ; 13 = RETURN
  965.                     dc.b       20,21,22,23,24,25,26,0,28,29
  966.                     dc.b       30,31,32,33,34,35,36,37,38,39
  967.                     dc.b       40,41,42,43,44,45,46,47,48,49
  968.                     dc.b       50,51,52,53,54,55,56,57,58,59
  969.                     dc.b       60,61,62,63,64,65,66,67,68,69
  970.                     dc.b       70,71,72,73,74,75,76,77,78,79
  971.                     dc.b       80,81,82,83,84,85,86,87,88,89
  972.                     dc.b       90,91,92,93,94,95,96,97,98,99
  973.                     dc.b      100,101,102,103,104,105,106,107,108,109
  974.                     dc.b      110,111,112,113,114,115,116,117,118,119
  975.                     dc.b      120,121,122,123,124,125,126,127,128,'ü'
  976.                     dc.b      130,131,'ä',133,134,135,136,137,138,139
  977.                     dc.b      140,141,'Ä',143,144,145,146,147,'ö',149
  978.                     dc.b      150,151,152,'Ö','Ü',155,156,157,'ß',159
  979.                     dc.b      160,161,162,163,164,165,166,167,168,169
  980.                     dc.b      170,171,172,173,174,175,176,177,178,179
  981.                     dc.b      180,181,182,183,184,185,186,187,188,189
  982.                     dc.b      190,191,192,193,194,195,196,197,198,199
  983.                     dc.b      200,201,202,203,204,205,206,207,208,209
  984.                     dc.b      210,211,212,213,214,215,216,217,218,219
  985.                     dc.b      220,221,222,223,224,225,226,227,228,229
  986.                     dc.b      230,231,232,233,234,235,236,237,238,239
  987.                     dc.b      240,241,242,243,244,245,246,247,248,249
  988.                     dc.b      250,251,252,253,254,255
  989.  
  990. END
  991.