home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 2 / MECOMP-CD-II.iso / amiga / emulation / qlsource / romsrc / main / main_asm
Encoding:
Text File  |  1998-02-23  |  34.1 KB  |  1,828 lines
  1.     SECTION MAIN
  2.  
  3.     INCLUDE '/INC/QDOS_inc'
  4.     INCLUDE '/INC/AMIGA_inc'
  5.     INCLUDE '/INC/AMIGQDOS_inc'
  6.  
  7. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  8. ; MAIN1_asm - Amiga specific patches
  9. ;       - last modified 22/02/98
  10.  
  11. ; These are all the necessary sources required to convert a
  12. ; standard QL specific QDOS ROM, for use on the Amiga computer.
  13.  
  14. ; QDOS-Amiga sources by Rainer Kowallik
  15. ;  ...latest changes by Mark J Swift
  16. ;  ...COPYBACK switches added by SNG
  17.  
  18. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  19. ;extras     equ     1
  20. ;dotrace  equ     1
  21.  
  22. ;  ROM header
  23.  
  24. BASE:
  25.     dc.l    $4AFB0001    ; ROM recognition code
  26.     dc.w    PROC_DEF-BASE    ; add BASIC procs here
  27.     dc.w    ROM_START-BASE
  28.  
  29.     dc.b    0,32
  30.     dc.b    'Amiga-QDOS MAIN o/s hooks v1.46'
  31.     dc.b    $A
  32.  
  33. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  34. ;  start of ROM code
  35.  
  36. ROM_START:
  37.  
  38. ; --------------------------------------------------------------
  39. ;  enter supervisor mode and disable interrupts
  40.  
  41.     trap    #0
  42.  
  43.     ori.w    #$0700,sr    ; disable interrupts
  44.  
  45. ; --------------------------------------------------------------
  46. ;  save register entry values
  47.  
  48.     movem.l    d0-d3/d6-d7/a0-a4/a6,-(a7)
  49.  
  50. ; --------------------------------------------------------------
  51. ;  disable all interrupts and DMA
  52.  
  53.     move.b    #$7F,CIAA_ICR    ; no ints from CIA-A
  54.     move.b    #$7F,CIAB_ICR    ; no ints from CIA-B
  55.     move.w    #$7FFF,INTREQ    ; clear interrupt requests
  56.     move.w    #$7FFF,INTENA    ; disable interrupts
  57.     move.w    #$07FF,DMACON    ; no DMA, no blitter prio'ty
  58.     clr.b    $de0000        ; no slow bus errors
  59.  
  60. ; --------------------------------------------------------------
  61. ;  disable caches on '020 and above
  62.  
  63.     bsr    CACHOFF        ; disable caches
  64.     move.l    d0,d7        ; save cacr value
  65.  
  66. ; --------------------------------------------------------------
  67. ;  clear bitplanes and Amiga variables
  68.  
  69. CLR_BP:
  70.     lea    $10000,a0
  71.     move.w    #$1FFF,d0
  72. CLR_BPLUP:
  73.     clr.l    (a0)+
  74.     dbra    d0,CLR_BPLUP
  75.  
  76.     lea    $18200,a0
  77.     move.w    #$F7F,d0
  78. CLR_AVLUP:
  79.     clr.l    (a0)+
  80.     dbra    d0,CLR_AVLUP
  81.  
  82. ; --------------------------------------------------------------
  83. ;  store amiga vars identification long word
  84.  
  85.     move.w    #(AV_IDENT>>16),AV.IDENT
  86.     move.w    #(AV_IDENT&$FFFF),AV.IDENT+2
  87.  
  88. ;  clear mirror CIA variables
  89.  
  90.     clr.b    AV.CIAA_ICR
  91.     clr.b    AV.CIAB_ICR
  92.     clr.b    AV.CIAA_MSK
  93.     clr.b    AV.CIAB_MSK
  94.  
  95. ; --------------------------------------------------------------
  96. ;  allocate memory for local variables
  97.  
  98.     move.l    #MV_LEN,d1
  99.     moveq    #MT.ALCHP,d0
  100.     moveq    #0,d2
  101.     trap    #1
  102.  
  103.     move.l    a0,AV.MAIV
  104.     move.l    a0,a4
  105.  
  106. ; --------------------------------------------------------------
  107. ;  allocate memory for ROM redirection links
  108.  
  109.     move.l    #RV_LEN,d1
  110.     moveq    #MT.ALCHP,d0
  111.     moveq    #0,d2
  112.     trap    #1
  113.  
  114.     move.l    a0,MV.RVARS(a4)
  115.  
  116. ; --------------------------------------------------------------
  117.     move.l    a7,d0
  118.     andi.l    #$FFFF8000,d0
  119.     move.l    d0,a6        ; address of system vars
  120.  
  121.     suba.l    a0,a0        ; a handy reference point
  122.  
  123.     tst.b    161(a6)
  124.     beq.s    STOVCTRS
  125.  
  126. ; --------------------------------------------------------------
  127. ;  allocate memory and set vector base register (010+)
  128.  
  129.     move.l    #1024,d1
  130.     moveq    #MT.ALCHP,d0
  131.     moveq    #0,d2
  132.     trap    #1
  133.  
  134.     moveq    #47,d0
  135.     suba.l    a1,a1
  136.  
  137. MOVVCTRS:
  138.     move.l    (a1)+,(a0)+
  139.     dbra    d0,MOVVCTRS
  140.  
  141.     move.w    #207,d0
  142.     suba.l    a1,a1
  143.  
  144. CLRVCTRS:
  145.     move.l    12*4(a1),(a0)+
  146.     dbra    d0,CLRVCTRS
  147.  
  148.     lea    -1024(a0),a0
  149.  
  150.     move.l    4*4(a0),61*4(a0)    ; new illegal instruction?
  151.  
  152.     dc.w    $4E7B,$8801    ; movec a0,vbr
  153.  
  154. ; --------------------------------------------------------------
  155. ;  Redirect RESET routine
  156.  
  157. STOVCTRS:
  158.     move.l    MV.RVARS(a4),a2
  159.  
  160.     lea    RV.RSETlink(a2),a1
  161.     move.l    a1,AV.RSETlink    ; ptr to 1st link
  162.  
  163.     clr.l    (a1)        ; clear final link
  164.     move.l    $04(a0),$04(a1)    ; address of ROM routine
  165.  
  166.     lea    RSET(pc),a1    ; make redirection routine
  167.     move.l    a1,$04(a0)    ; new exception
  168.  
  169. ; --------------------------------------------------------------
  170. ;  Redirect ILLEGAL interrupt routine
  171.  
  172.     lea    RV.ILLGlink(a2),a1
  173.     move.l    a1,AV.ILLGlink    ; ptr to 1st link
  174.  
  175.     clr.l    (a1)        ; clear final link
  176.     move.l    $60(a0),$04(a1)    ; address of ROM routine
  177.  
  178.     lea    ILLG(pc),a1    ; make redirection routine
  179.     move.l    a1,$60(a0)    ; new exception
  180.  
  181. ; --------------------------------------------------------------
  182. ;  store link to LVL5 interrupt routine
  183.  
  184.     lea    RV.LVL5link(a2),a1
  185.     move.l    a1,AV.LVL5link    ; ptr to 1st link
  186.  
  187.     clr.l    (a1)        ; clear final link
  188.     move.l    $74(a0),$04(a1)    ; address of ROM routine
  189.  
  190. ; --------------------------------------------------------------
  191. ;  store link to LVL7 interrupt routine
  192.  
  193.     lea    RV.LVL7link(a2),a1
  194.     move.l    a1,AV.LVL7link    ; ptr to 1st link
  195.  
  196.     clr.l    (a1)        ; clear final link
  197.     move.l    $7C(a0),$04(a1)    ; address of ROM routine
  198.  
  199. ; --------------------------------------------------------------
  200. ;  Redirect other interrupts through relevant vectors
  201.  
  202.     lea    RV.MAINlink(a2),a1
  203.     move.l    a1,AV.MAINlink    ; ptr to 1st link
  204.  
  205.     clr.l    (a1)        ; clear final link
  206.     move.l    $68(a0),$04(a1)    ; address of ROM routine
  207.  
  208.     lea    MAIN(pc),a1    ; make new exception for...
  209.     move.l    a1,$64(a0)    ; level 1
  210.     move.l    a1,$68(a0)    ; level 2
  211.     move.l    a1,$6C(a0)    ; level 3
  212.     move.l    a1,$70(a0)    ; level 4
  213.     move.l    a1,$74(a0)    ; level 5
  214.     move.l    a1,$78(a0)    ; level 6
  215.     move.l    a1,$7C(a0)    ; level 7
  216.  
  217. ; --------------------------------------------------------------
  218. ;  Redirect TRAP #0 routine
  219.  
  220.     lea    RV.TRP0link(a2),a1
  221.     move.l    a1,AV.TRP0link    ; ptr to 1st link
  222.  
  223.     clr.l    (a1)        ; clear final link
  224.     move.l    $80(a0),$04(a1)    ; address of ROM routine
  225.  
  226.     lea    TRP0(pc),a1    ; make redirection routine
  227.     move.l    a1,$80(a0)    ; new exception
  228.  
  229. ; --------------------------------------------------------------
  230. ;  Redirect TRAP #1 routine
  231.  
  232.     lea    RV.TRP1link(a2),a1
  233.     move.l    a1,AV.TRP1link    ; ptr to 1st link
  234.  
  235.     clr.l    (a1)        ; clear final link
  236.     move.l    $84(a0),$04(a1)    ; address of ROM routine
  237.  
  238.     lea    TRP1(pc),a1    ; make redirection routine
  239.     move.l    a1,$84(a0)    ; new exception
  240.  
  241. ; --------------------------------------------------------------
  242. ;  dislocate original polled task list
  243.  
  244.     move.l    #0,SV_PLIST(a6)    ; pointer to list of polled
  245.                 ; tasks
  246.  
  247. ; --------------------------------------------------------------
  248. ;  link a custom routine onto the RESET routine
  249.  
  250.     lea    AV.RSETlink,a1
  251.     lea    MV.RSETlink(a4),a2
  252.  
  253.     move.l    (a1),(a2)
  254.     move.l    a2,(a1)
  255.  
  256.     lea    MY_RSET(pc),a1
  257.     move.l    a1,$04(a2)
  258.  
  259. ; --------------------------------------------------------------
  260. ;  link a custom routine into level 7 interrupt server
  261.  
  262.     lea    AV.LVL7link,a1
  263.     lea    MV.LVL7link(a4),a2
  264.  
  265.     move.l    (a1),(a2)
  266.     move.l    a2,(a1)
  267.  
  268.     lea    MY_LVL7(pc),a1
  269.     move.l    a1,$04(a2)
  270.  
  271. ; --------------------------------------------------------------
  272. ;  initialise relevant hardware
  273.  
  274.     bsr    INIT_HW
  275.  
  276.     move.b    AV.FLGS1,d0
  277.     andi.b    #%00111111,d0
  278.     move.b    d0,AV.FLGS1    ; allow blitter activity
  279.  
  280.     move.l    d7,d0
  281.     bsr    SETCACH
  282.  
  283. ; -------------------------------------------------------------
  284. ; link in a default external interrupt routine
  285.  
  286. XINT_LINK:
  287.     lea    XINT_SERver(pc),a1 ; address of routine
  288.     lea    MV.XINTLink(a4),a0
  289.     move.l    a1,4(a0)
  290.     moveq    #MT.LXINT,d0
  291.     trap    #1
  292.  
  293. ; --------------------------------------------------------------
  294. ;  restore register entry values
  295.  
  296. ROM_EXIT:
  297.     movem.l    (a7)+,d0-d3/d6-d7/a0-a4/a6
  298.  
  299. ; --------------------------------------------------------------
  300. CHEC_BEGin:
  301.     movem.l    d0/a1/a3,-(a7)
  302.  
  303. ; --------------------------------------------------------------
  304.  
  305.     movem.l    a4-a6,-(a7)
  306.  
  307.     move.l    a7,d0
  308.     andi.l    #$FFFF8000,d0
  309.     move.l    d0,a6        ; address of system vars
  310.  
  311. ; --------------------------------------------------------------
  312. ;  Link unused memory (system memory has to be contiguous), into
  313. ;  common heap. Allocate ranges that do not contain memory as
  314. ;  'used'.
  315.  
  316.     move.l    SV_RAMT(a6),a3    ; don't check memory beyond
  317.     move.l    a3,d0
  318.     add.l    #$00040000-1,d0    ; assume ROMs < 256K and
  319.     andi.l    #$FFFC0000,d0    ; a 256K minimum mem chunk
  320.     move.l    d0,a2        ; probable top of RAM
  321.  
  322.     cmp.l    #$1000000,a6
  323.     bge    ROM_DO
  324.  
  325. ; find last free space in common heap
  326.  
  327.     lea    SV_CHPFR(a6),a5    ; first free space in heap
  328.     subq.l    #4,a5
  329.  
  330.     bra.s    CHPJMP
  331.  
  332. CHPLUP:
  333.     adda.l    d0,a5        ; next free space
  334.  
  335. CHPJMP:
  336.     move.l    4(a5),d0
  337.     bne.s    CHPLUP
  338.  
  339.     move.l    SV_FREE(a6),a4
  340.  
  341. ; link free CHIP RAM into common heap
  342.  
  343.     bsr    chip_ram     ; how much CHIP RAM?
  344.  
  345.     bsr    MEMLINK        ; link memory into common heap
  346.  
  347.     cmp.l    a2,a3
  348.     ble.s    MEMSKIP
  349.  
  350. ; link expansion memory into common heap
  351.  
  352.     lea    $200000,a1
  353.  
  354. ERAM_LUP:
  355.     bsr    expansion_ram    ; how much EXPANSION RAM?
  356.  
  357.     bsr    MEMLINK        ; link memory into common heap
  358.  
  359.     move.l    a2,a1
  360.     adda.l    #$10000,a1    ; next 64K
  361.  
  362.     cmp.l    #$A00000,a1
  363.     blt.s    ERAM_LUP
  364.  
  365.     cmp.l    a1,a3
  366.     ble.s    MEMSKIP
  367.  
  368. ; link RANGER memory into common heap
  369.  
  370.     bsr    ranger_ram
  371.  
  372.     bsr    MEMLINK
  373.  
  374. MEMSKIP:
  375.     clr.l    4(a5)        ; dislocate last block of RAM
  376.                 ; from common heap.
  377.  
  378.     move.l    0(a4),d0     ; length of last block of RAM
  379.     add.l    a4,d0
  380.     move.l    d0,a2        ; calculate maximum RAMTOP
  381.  
  382.     move.l    a4,a1        ; base of free area
  383.  
  384. ; a1 now holds base of free area, a2 max RAM, a3 RAMTOP
  385.  
  386.  
  387. ; find first usable entry in slave table
  388.  
  389.     move.l    a1,d0
  390.     addi.l    #$1FF,d0
  391.     sub.l    a6,d0        ; Slave blocks start at the
  392.     andi.w    #-$200,d0    ; sys vars and are each 512
  393.     lsr.l    #6,d0        ; bytes long.
  394.  
  395. ; invalidate all slave block entries outside system RAM
  396.  
  397.     lea    SV_STACT(a6),a1    ; first address in slave table
  398.     lea    0(a1,d0.l),a4    ; first usable address
  399.  
  400. INI_TBL1:
  401.     clr.l    (a1)+
  402.     cmpa.l    a4,a1
  403.     blt.s    INI_TBL1
  404.  
  405.     move.l    a1,SV_BTPNT(a6)    ; Store most recent block.
  406.  
  407. ROM_DO:
  408.     movem.l    (a7)+,a4-a6
  409.  
  410. ; link in ROMS from RAMTOP until end of memory
  411.  
  412. ROM_LUP:
  413.     bsr    EPROM_LInk
  414.  
  415.     adda.l    #$100,a3
  416.     cmp.l    a3,a2        ; ..until end of memory
  417.     bgt.s    ROM_LUP
  418.  
  419. ; --------------------------------------------------------------
  420. CHECK_EXit:
  421.     movem.l    (a7)+,d0/a1/a3
  422.  
  423. ;  enable interrupts and re-enter user mode
  424.  
  425.     andi.w    #$D8FF,sr
  426.  
  427.     rts
  428.  
  429. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  430. ; default external interrupt routine to clear interrupts
  431.  
  432. XINT_SERver
  433.     movem.l    d0,-(a7)
  434.  
  435. ;     move.b     CIAA_ICR,d0     ; read CIA-A ICR
  436. ;     or.b     AV.CIAA_ICR,d7
  437. ;     move.b     d0,AV.CIAA_ICR     ; store for later
  438.  
  439. ;     move.b     CIAB_ICR,d0     ; read CIA-B ICR
  440. ;     or.b     AV.CIAB_ICR,d0
  441. ;     move.b     d0,AV.CIAB_ICR     ; store for later
  442.  
  443. ;     move.w     #$7FFF,INTREQ     ; clear interrupt requests
  444.  
  445.     movem.l    (a7)+,d0
  446.     rts
  447.  
  448. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  449. ; find how much CHIP RAM is installed
  450.  
  451. ; on exit:
  452.  
  453. ;   a1=0
  454. ;   a2=CHIP top
  455.  
  456. chip_ram:
  457.     movem.l    d0-d1/a0-a1,-(a7)
  458.  
  459.     suba.l    a1,a1
  460.     move.l    (a1),a0
  461.     clr.l    (a1)
  462.     suba.l    a2,a2
  463.     move.l    #-$D2B4977,d1
  464.     bra.s    LF801E0
  465.  
  466. LF801DE:
  467.     move.l    d0,(a2)
  468.  
  469. LF801E0:
  470.     lea    $4000(a2),a2
  471.  
  472.     cmpa.l    #$200000,a2    ; ...or maximum CHIP RAM
  473.     beq.s    LF801FA
  474.  
  475.     move.l    (a2),d0
  476.     move.l    d1,(a2)
  477.     nop
  478.     cmp.l    (a1),d1
  479.     beq.s    LF801FA
  480.  
  481.     cmp.l    (a2),d1
  482.     beq    LF801DE
  483.  
  484. LF801FA:
  485.     move.l    d0,(a2)
  486.     move.l    a0,(a1)
  487.  
  488.     movem.l    (a7)+,d0-d1/a0-a1
  489.  
  490.     rts
  491.  
  492. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  493. ; find how much EXPANSION RAM is installed
  494.  
  495. ; The machine has not been reset since expansion.library of
  496. ; AmigaDOS initialised the expansion memory. Therefore when you
  497. ; enter    QDOS the expansion RAM should still be mapped in (if
  498. ; there's any installed).
  499.  
  500. ; on entry
  501.  
  502. ;   a1=EXPANSION base
  503.  
  504. ; on exit:
  505.  
  506. ;   a1=EXPANSION base
  507. ;   a2=EXPANSION top
  508.  
  509. expansion_ram:
  510.     movem.l    d1-d2/a0/a4,-(a7)
  511.  
  512.     move.l    a7,a4        ; save for later
  513.  
  514.     dc.w    $2078,$0008    ; move.l  $08.w,a0 (bus err)
  515.     lea    exp_EXIT(pc),a2
  516.     dc.w    $21CA,$0008    ; move.l  a2,$08.w
  517.  
  518.     move.l    a1,a2
  519.  
  520. exp_NEXT:
  521.     move.w    (a2),d2
  522.     moveq    #1,d1
  523.  
  524. exp_CHEK:
  525.     move.w    d1,(a2)
  526.     cmp.w    (a2),d1
  527.     bne.s    exp_EXIT
  528.  
  529.     lsl.w    #1,d1
  530.     bne.s    exp_CHEK
  531.  
  532.     move.w    d2,(a2)
  533.     adda.l    #$10000,a2    ; next 64K
  534.  
  535.     cmpa.l    #$A00000,a2
  536.     blt.s    exp_NEXT     ; ...or max expansion RAM
  537.  
  538. exp_EXIT:
  539.     dc.w    $21C8,$0008    ; move.l  a0,$08.w
  540.  
  541.     move.l    a4,a7        ; tidy up stack
  542.  
  543.     movem.l    (a7)+,d1-d2/a0/a4
  544.     rts
  545.  
  546. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  547. ; find how much RANGER RAM is installed
  548.  
  549. ; on exit:
  550.  
  551. ;   a1=$C00000
  552. ;   a2=RANGER top
  553.  
  554. ranger_ram:
  555.     movem.l    d0-d1/a0/a4,-(a7)
  556.  
  557.     lea    $C00000,a1
  558.     lea    $DC0000,a0
  559.  
  560.     move.l    a1,a2
  561.  
  562.     adda.l    #$40000,a1    ; a1 holds $C40000
  563.  
  564. LF80330:
  565.     move.l    a2,a4
  566.     adda.l    #$40000,a4
  567.  
  568.     move.w    INTENAR,d1    ; store interrupts
  569.     move.w    -$F66(a4),d0    ; store (RAM) contents
  570.  
  571.     move.w    #$7FFF,$9A-$1000(a4)    ; mirror custom chips?
  572.     tst.w    $1C-$1000(a4)
  573.     bne.s    LF80352            ; ...possible RAM
  574.  
  575.     move.w    #$BFFF,$9A-$1000(a4)
  576.     cmpi.w    #$3FFF,$1C-$1000(a4)
  577.     bne.s    LF80352            ; ...possible RAM
  578.  
  579. ; at this point we definitely have a mirror of the custom chips
  580.  
  581. LF8038A:
  582.     move.w    #$7FFF,INTENA    ; disable all interrupts
  583.  
  584.     ori.w    #%1100000000000000,d1    ; enable interrupts
  585.     move.w    d1,INTENA
  586.  
  587.     bra.s    LF80390            ; ...and exit
  588.  
  589. LF80352:
  590.  
  591. ; may be RAM
  592.  
  593.     move.l    #$F2D4,d1
  594.     move.w    d1,-$F66(a4)    ; store test number into RAM
  595.     cmp.w    -$F66(a4),d1
  596.     bne.s    LF80390        ; exit if RAM test failed
  597.  
  598.     move.l    #$B698,d1
  599.     move.w    d1,-$F66(a4)    ; store different test number
  600.     cmp.w    -$F66(a4),d1
  601.     bne.s    LF80390        ; exit if RAM test failed
  602.  
  603. ; definitely RAM - but may be a mirror of $C00000-$C40000
  604.  
  605.     cmpa.l    a1,a4
  606.     beq    LF80384        ; addresses same? not mirror
  607.  
  608.     cmp.w    -$F66(a1),d1    ; mirror of previous RAM?
  609.     bne.s    LF80384        ; no ...must be real RAM
  610.  
  611.     move.l    #$F2D4,d1
  612.     move.w    d1,-$F66(a4)    ; store test number into RAM
  613.  
  614.     cmp.w    -$F66(a1),d1    ; mirror of previous RAM?
  615.     bne.s    LF80384        ; no ...must be real RAM
  616.  
  617. ; at this point, RAM at (a1) has proven to be a mirror of RAM at (a4)
  618.  
  619. LF80380:
  620.     move.w    d0,-$F66(a4)    ; restore RAM contents
  621.     bra    LF80390        ; ...and exit
  622.  
  623. LF80384:
  624.     move.w    d0,-$F66(a4)    ; restore RAM contents
  625.  
  626.     move.l    a4,a2
  627.  
  628.     cmpa.l    a2,a0        ; check against upper bound
  629.     bhi    LF80330
  630.  
  631. LF80390:
  632.     suba.l    #$40000,a1    ; a1 holds $C00000
  633.  
  634.     movem.l    (a7)+,d0-d1/a0/a4
  635.  
  636. LF8039C:
  637.     rts
  638.  
  639. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  640. ; link memory into common heap as 'free' heap.
  641.  
  642. ; a1 holds base, a2 the upper limit of memory range.
  643.  
  644. MEMLINK:
  645.     movem.l    d0-d1/a3,-(a7)
  646.  
  647.     cmp.l    a1,a2        ; memory range valid?
  648.     ble.s    MEMLINKX
  649.  
  650.     cmp.l    a4,a1
  651.     blt.s    MEMLINK2     ; no previous range
  652.  
  653. ; must link the HOLES between memory ranges as 'allocated' heap
  654.  
  655.     move.l    a4,a3        ; find 'gap' between last
  656.     add.l    0(a4),a3     ; free range and this one.
  657.     move.l    a1,d0
  658.     sub.l    a3,d0
  659.     bne.s    MEMLINK1
  660.  
  661. ; no gap between last memory range and this one, so concatenate
  662.  
  663.     movea.l    a4,a1
  664.     bra.s    MEMLINK5
  665.  
  666. MEMLINK1:
  667.     moveq    #16,d1        ; length of header
  668.     sub.l    d1,a3
  669.     add.l    d1,d0
  670.     move.l    d0,0(a3)     ; store a header for memory hole
  671.     clr.l    $4(a3)
  672.     clr.l    $8(a3)
  673.     clr.l    $C(a3)
  674.  
  675.     sub.l    d1,0(a4)     ; reduce length of last range
  676.  
  677. MEMLINK2:
  678.     cmp.l    SV_FREE(a6),a1    ; common heap extended beyond
  679.     bge.s    MEMLINK3     ; lower bound of memory range?
  680.  
  681.     move.l    SV_FREE(a6),a1    ; new lower bound for memory
  682.  
  683. MEMLINK3:
  684.     cmp.l    a4,a1
  685.     bne.s    MEMLINK4
  686.  
  687.     movea.l    a5,a4
  688.  
  689. MEMLINK4:
  690.     move.l    a1,d0
  691.     sub.l    a4,d0        ; store relative pointer from
  692.     move.l    d0,4(a4)     ; previous block
  693.  
  694.     move.l    a4,a5
  695.     move.l    a1,a4
  696.     move.l    a4,SV_FREE(a6)    ; update SV_FREE
  697.  
  698. MEMLINK5:
  699.     move.l    a2,d0
  700.     sub.l    a1,d0        ; find length of memory block
  701.  
  702.     move.l    d0,0(a1)     ; store length
  703.     clr.l    4(a1)        ; zero pointer to next free block
  704.     clr.l    $8(a1)        ; owner
  705.     clr.l    $C(a1)        ; location to set/clr when removed
  706.  
  707. MEMLINKX:
  708.     movem.l    (a7)+,d0-d1/a3
  709.  
  710.     rts
  711.  
  712. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  713. ;  Subroutine to check for EPROMs and link them in.
  714. ;  Enter in supervisor mode with interrupts disabled.
  715. ;
  716. ;  Entry:
  717. ;    a0 channel ID for messages
  718. ;    a3 start address to check
  719.  
  720. EPROM_LInk:
  721.  
  722.     movem.l    d0-d3/a0-a3,-(a7)
  723.  
  724.     andi.w    #$D8FF,sr    ; enable ints & enter User
  725.                 ; mode
  726.     CMPI.W    #$4AFB,(A3)
  727.     BNE.S    EPROM_EXit
  728.  
  729.     CMPI.W    #$0001,2(A3)
  730.     BNE.S    EPROM_EXit
  731.  
  732.     LEA    8(A3),A1     ; Eprom copyright
  733.     MOVE.W    $D0,A2        ; UT.MTEXT
  734.     JSR    (A2)
  735.  
  736.     MOVE.W    4(A3),D0     ; any Basic extensions ?
  737.     BEQ.S    EPROM_INit
  738.  
  739.     LEA    0(A3,D0.W),A1
  740.     MOVE.W    $110,A2        ; BP.INIT
  741.     JSR    (A2)
  742.  
  743. EPROM_INit:
  744.     MOVE.W    6(A3),D0     ; initialization procedure
  745.     BEQ.S    EPROM_EXit
  746.  
  747.     JSR    0(A3,D0.W)    ; routine must not corrupt
  748.                 ; output channel (a0) or start
  749.                 ; address (a3) and must return
  750.                 ; whilst in USER mode
  751.  
  752. EPROM_EXit:
  753.     trap    #0        ; enter supervisor mode
  754.     ori.w    #$0700,sr    ; disable interrupts
  755.  
  756.     movem.l    (a7)+,d0-d3/a0-a3
  757.  
  758.     rts
  759.  
  760. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  761. ;  Redirection routine for Illegal Interrupt
  762.  
  763. ILLG:
  764.     move.w    #$7FFF,INTREQ    ; clear interrupt request
  765.     move.w    #MAGENTA,COLOR00    ; Signal bad interrupt
  766.  
  767.     subq.l    #4,a7
  768.     movem.l    a3,-(a7)
  769.     move.l    AV.ILLGlink,a3
  770.     move.l    4(a3),4(a7)
  771.     movem.l    (a7)+,a3     ; address of next routine
  772.     rts
  773.  
  774. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  775. ;  Custom interrupt server for main 50Hz & external.interrupts
  776.  
  777. MAIN:
  778.     ori.w    #$0700,sr    ; disable further interrupts
  779.     movem.l    d7/a5/a6,-(a7)
  780.  
  781.     movea.l    a7,a5
  782.     move.l    a7,d7
  783.     andi.l    #$FFFF8000,d7
  784.     move.l    d7,a6        ; address of system vars
  785.  
  786.     move.w    INTENAR,d7
  787.     btst    #5,d7        ; 50Hz ints enabled?
  788.     beq.s    EXTRN_INT    ; no, must be another.
  789.  
  790.     move.w    INTREQR,d7    ; read interrupt request reg
  791.     btst    #5,d7        ; 50Hz interrupt?
  792.     bne.s    FRAME_INT
  793.  
  794. ; --------------------------------------------------------------
  795. ;  Let external interrupt server handle it
  796. ;  NOTE every driver MUST clear the relevant interrupt request!
  797.  
  798. EXTRN_INT:
  799.     move.b    #%00010000,PC_INTR ; signal external interrupt
  800.                  ; in QL hardware
  801.  
  802.     bra.s    MAINX
  803.  
  804. ; --------------------------------------------------------------
  805. ;  server for 50 Hz vertical blank interrupt
  806.  
  807. FRAME_INT:
  808.     move.w    #%0000000000100000,INTREQ ; clear interrupts
  809.  
  810.     move.b    #%00001000,PC_INTR ; signal 50Hz interrupt
  811.                  ; in QL hardware
  812.  
  813. MAINX:
  814.     movem.l    (a7)+,d7/a5/a6
  815.  
  816.     subq.l    #4,a7
  817.     movem.l    a3,-(a7)
  818.     move.l    AV.MAINlink,a3
  819.     move.l    4(a3),4(a7)    ; address of next routine
  820.     movem.l    (a7)+,a3
  821.     rts
  822.  
  823. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  824. ;  Redirect RESET routine through table
  825.  
  826. RSET:
  827.     ori.w    #$0700,sr    ; disable further interrupts
  828.  
  829.     move.b    #$7F,CIAA_ICR    ; no ints from CIA-A
  830.     move.b    #$7F,CIAB_ICR    ; no ints from CIA-B
  831.     move.w    #$7FFF,INTREQ    ; clear interrupt requests
  832.     move.w    #$7FFF,INTENA    ; disable interrupts
  833.     move.w    #$07FF,DMACON    ; no DMA, no blitter prio'ty
  834.  
  835.     movem.l    d0,-(a7)
  836.     bsr    CACHOFF
  837.     movem.l    (a7)+,d0
  838.  
  839.     subq.l    #4,a7
  840.     movem.l    a3,-(a7)
  841.     move.l    AV.RSETlink,a3
  842.     move.l    4(a3),4(a7)
  843.     movem.l    (a7)+,a3     ; address of next routine
  844.     rts
  845.  
  846. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  847. ;  Redirection routine for Trap #0
  848.  
  849. TRP0:
  850.     subq.l    #4,a7
  851.     movem.l    a3,-(a7)
  852.     move.l    AV.TRP0link,a3
  853.     move.l    4(a3),4(a7)    ; address of next routine
  854.     movem.l    (a7)+,a3
  855.  
  856.     ifd    dotrace
  857.  
  858.     btst    #7,4(a7)     ; were we in trace mode?
  859.     beq.s    TRP0X
  860.  
  861.     ori.w    #$8000,sr    ; ...yup, trace back on.
  862.  
  863. TRP0X:
  864.     endif
  865.     rts
  866.  
  867. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  868. ;  Redirection routine for Trap #1
  869.  
  870. TRP1:
  871.     subq.l    #4,a7
  872.     movem.l    a3,-(a7)
  873.     move.l    AV.TRP1link,a3
  874.     move.l    4(a3),4(a7)    ; address of next routine
  875.     movem.l    (a7)+,a3
  876.  
  877.     ifd    dotrace
  878.     btst    #7,4(a7)     ; were we in trace mode?
  879.     beq.s    TRP1X
  880.     ori.w    #$8000,sr    ; ...yup, trace back on.
  881.     endif
  882.  
  883. TRP1X:
  884.     rts
  885.  
  886. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  887. ;  enable relevant interrupts/DMA
  888.  
  889. INIT_HW:
  890.     movem.l    d0,-(a7)
  891.  
  892.     move.w    #%1100000000100000,INTENA ; enable 50Hz int
  893.  
  894.     movem.l    (a7)+,d0
  895.     rts
  896.  
  897. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  898. ;  Custom RESET routine to put back all vectors & reset computer
  899.  
  900. MY_RSET:
  901.     movem.l    d0/a0-a3/a6,-(a7)
  902.  
  903.     suba.l    a0,a0        ; a handy reference
  904.  
  905.     move.l    a7,d0
  906.     andi.l    #$FFFF8000,d0
  907.     move.l    d0,a6        ; address of system vars
  908.  
  909.     tst.b    161(a6)
  910.     beq.s    MY_RSET1
  911.  
  912.     dc.w    $4E7A,$8801    ; movec vbr,a0
  913.  
  914. MY_RSET1:
  915.     move.l    AV.MAIV,a3
  916.     move.l    MV.RVARS(a3),a2
  917.  
  918.     move.l    RV.RSET(a2),$04(a0)
  919.     move.l    RV.ILLG(a2),$60(a0) ; level 0
  920.     move.l    RV.LVL5(a2),$74(a0) ; level 5
  921.     move.l    RV.LVL7(a2),$7C(a0) ; level 7
  922.     move.l    RV.ILLG(a2),$64(a0) ; level 1
  923.     move.l    RV.ILLG(a2),$6C(a0) ; level 3
  924.     move.l    RV.ILLG(a2),$70(a0) ; level 4
  925.     move.l    RV.ILLG(a2),$78(a0) ; level 6
  926.     move.l    RV.MAIN(a2),$68(a0) ; level 2
  927.     move.l    RV.TRP0(a2),$80(a0)
  928.     move.l    RV.TRP1(a2),$84(a0)
  929.  
  930.     move.b    161(a6),d0
  931.     beq.s    MY_RSET2
  932.  
  933.     suba.l    a0,a0        ; a handy reference
  934.     dc.w    $4E7B,$8801    ; movec a0,vbr
  935.  
  936.     cmp.b    #$40,d0
  937.     bcs.s    MY_RSET2
  938.  
  939. ;     move.l     #$0000C000,d1     ; Write Through to Chip memory
  940.     move.l    #$0000C040,d1    ; Serialize 0-16 Mb
  941.     dc.w    $4E7B,$1006    ; movec d1,(006) DTT0
  942.     move.l    #$00FFC020,d1    ; Copyback on all memory
  943.     dc.w    $4E7B,$1007    ; movec d1,(007) DTT1
  944.  
  945. MY_RSET2:
  946.     movem.l    (a7)+,d0/a0-a3/a6
  947.  
  948.     subq.l    #4,a7
  949.     movem.l    a3,-(a7)
  950.     move.l    AV.MAIV,a3
  951.     move.l    MV.RSETlink(a3),a3
  952.     move.l    4(a3),4(a7)    ; address of next routine
  953.     movem.l    (a7)+,a3
  954.  
  955.     rts
  956.  
  957. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  958. ;  Custom LVL7 routine to initialise hardware
  959.  
  960. MY_LVL7:
  961.     bsr    INIT_HW
  962.  
  963.     subq.l    #4,a7
  964.     movem.l    a3,-(a7)
  965.     move.l    AV.MAIV,a3
  966.     move.l    MV.LVL7link(a3),a3
  967.     move.l    4(a3),4(a7)    ; address of next routine
  968.     movem.l    (a7)+,a3
  969.  
  970.     rts
  971.  
  972. *******************************************************************
  973. *
  974. * routine to disable the instruction & data caches
  975. * Exit:    d0 = previous CACR value
  976. *
  977. CACHOFF:
  978.     movem.l    d1,-(a7)
  979.  
  980.     moveq    #0,d0
  981.     moveq    #-1,d1
  982.     bsr.s    DOCACH
  983.  
  984.     movem.l    (a7)+,d1
  985.     rts
  986.  
  987. *******************************************************************
  988. *
  989. * routine to set the CACR
  990. * Entry: d0 = value to write to CACR
  991. * Exit:    d0 = previous CACR value
  992. *
  993. SETCACH:
  994.     movem.l    d1,-(a7)
  995.  
  996.     moveq    #-1,d1
  997.     bsr.s    DOCACH
  998.  
  999.     movem.l    (a7)+,d1
  1000.     rts
  1001.  
  1002. *******************************************************************
  1003. *
  1004. * routine to alter the state of the CACR
  1005. * callable from user or supervisor modes
  1006. * Entry: d0 = bits to set
  1007. *    d1 = bits to clear/alter
  1008. * Exit:    d0 = previous CACR value
  1009. *
  1010. DOCACH:
  1011.     movem.l    d2/a0/a6,-(a7)
  1012.     movea.l    a7,a0
  1013.     trap    #0
  1014.     move.w    sr,-(a7)
  1015.     ori.w    #$0700,sr    interrupts off
  1016.  
  1017.     subq.l    #2,a0
  1018.     cmpa.l    a0,a7
  1019.     beq.s    DOCACHSV     entered routine as supervisor
  1020.  
  1021.     bclr    #5,0(a7)     otherwise sr on exit = user mode
  1022.  
  1023. DOCACHSV:
  1024.     move.l    a7,d2        Calculate start of
  1025.     andi.w    #-$8000,d2    system variables
  1026.     move.l    d2,a6
  1027.  
  1028.     and.l    d1,d0
  1029.     not.l    d1
  1030.  
  1031.     cmpi.b    #$10,$A1(a6)
  1032.     bls.s    DOCACHX        exit if 010 or less
  1033.  
  1034.     dc.w    $4E7A,$2002    movec    cacr,d2
  1035.     and.l    d2,d1        mask off changed bits
  1036.     or.l    d0,d1        or in set bits
  1037.  
  1038.     move.l    d2,d0        store old cacr value
  1039.  
  1040.     ori.w    #$0808,d1    always clear caches on 020/030
  1041.  
  1042.     cmpi.b    #$30,$A1(a6)
  1043.     bls.s    DOCACHSET
  1044.  
  1045.     tst.w    d0        check 040 bits
  1046.     bpl.s    DOCACHDCHK    branch if instruction cache off
  1047.     dc.w    $F4B8        cpusha    ic
  1048.                 ; otherwise update memory from cache
  1049.  
  1050. DOCACHDCHK:
  1051.     tst.l    d0        check 040 bits
  1052.     bpl.s    DOCACHDINV    branch if data cache off
  1053.     dc.w    $F478        cpusha    dc
  1054.                 ; otherwise update memory from cache
  1055.  
  1056.     tst.l    d1        check 040 bits
  1057.     bmi.s    DOCACHIINV    branch if leaving data cache on
  1058.  
  1059. DOCACHDINV:
  1060.     dc.w    $F458        cinva    dc
  1061.                 ; invalidate cache
  1062.  
  1063. DOCACHIINV:
  1064.     dc.w    $F498        cinva    ic
  1065.                 ; invalidate cache
  1066.  
  1067. DOCACHSET:
  1068.     dc.w    $4E7B,$1002    movec    d1,cacr
  1069.                 ; set the cache
  1070.  
  1071. DOCACHX:
  1072.     move.w    (a7)+,sr
  1073.     movem.l    (a7)+,d2/a0/a6
  1074.     rts
  1075.  
  1076. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1077. ;  BASIC extensions specific to AMIGA QDOS
  1078.  
  1079. PROC_DEF:
  1080.     ifd    extras
  1081.  
  1082.     dc.w    28
  1083.     dc.w    B_BL_OFF-*
  1084.     dc.b    8,'BLIT_OFF',0
  1085.     dc.w    B_BL_ON-*
  1086.     dc.b    7,'BLIT_ON'
  1087.     dc.w    RESET_RANGE-*
  1088.     dc.b    13,'RESET_EXTENTS'
  1089.     dc.w    RESET_TOP-*
  1090.     dc.b    9,'RESET_TOP'
  1091.     dc.w    RESET_SV-*
  1092.     dc.b    8,'RESET_SV',0
  1093.     dc.w    B_INTEN-*
  1094.     dc.b    6,'INTENA',0
  1095.     dc.w    B_INTRQ-*
  1096.     dc.b    6,'INTREQ',0
  1097.     dc.w    B_DMACN-*
  1098.     dc.b    6,'DMACON',0
  1099.     dc.w    DCACHE_ON-*
  1100.     dc.b    9,'DCACHE_ON'
  1101.     dc.w    DCACHE_OFF-*
  1102.     dc.b    10,'DCACHE_OFF',0
  1103.     dc.w    ICACHE_ON-*
  1104.     dc.b    9,'ICACHE_ON'
  1105.     dc.w    ICACHE_OFF-*
  1106.     dc.b    10,'ICACHE_OFF',0
  1107.  
  1108.         dc.w    COPYBACK_ON-*        ; ** SNG **
  1109.         dc.b    11,'COPYBACK_ON'
  1110.         dc.w    COPYBACK_OFF-*
  1111.         dc.b    12,'COPYBACK_OFF',0
  1112.     dc.w    0
  1113.  
  1114.     dc.w    13
  1115.     dc.w    B_INTENR-*
  1116.     dc.b    7,'INTENAR'
  1117.     dc.w    B_INTRQR-*
  1118.     dc.b    7,'INTREQR'
  1119.     dc.w    B_DMACNR-*
  1120.     dc.b    7,'DMACONR'
  1121.     dc.w    B_CHIP-*
  1122.     dc.b    4,'CHIP',0
  1123.     dc.w    B_EXPANSION-*
  1124.     dc.b    9,'EXPANSION'
  1125.     dc.w    B_RANGER-*
  1126.     dc.b    6,'RANGER',0
  1127.     dc.w    DMODE-*
  1128.     dc.b    5,'DMODE'
  1129.     dc.w    CACHE_REG-*
  1130.     dc.b    9,'CACHE_REG'
  1131.  
  1132.     dc.w    0
  1133.  
  1134.     endc
  1135.  
  1136.     ifnd    extras
  1137.  
  1138.     dc.w    22
  1139.     dc.w    B_BL_OFF-*
  1140.     dc.b    8,'BLIT_OFF',0
  1141.     dc.w    B_BL_ON-*
  1142.     dc.b    7,'BLIT_ON'
  1143.     dc.w    RESET_RANGE-*
  1144.     dc.b    13,'RESET_EXTENTS'
  1145.     dc.w    RESET_TOP-*
  1146.     dc.b    9,'RESET_TOP'
  1147.     dc.w    RESET_SV-*
  1148.     dc.b    8,'RESET_SV',0
  1149.     dc.w    DCACHE_ON-*
  1150.     dc.b    9,'DCACHE_ON'
  1151.     dc.w    DCACHE_OFF-*
  1152.     dc.b    10,'DCACHE_OFF',0
  1153.     dc.w    ICACHE_ON-*
  1154.     dc.b    9,'ICACHE_ON'
  1155.     dc.w    ICACHE_OFF-*
  1156.     dc.b    10,'ICACHE_OFF',0
  1157.  
  1158.     dc.w    COPYBACK_ON-*        ; ** SNG **
  1159.     dc.b    11,'COPYBACK_ON'
  1160.     dc.w    COPYBACK_OFF-*
  1161.     dc.b    12,'COPYBACK_OFF',0
  1162.  
  1163.     dc.w    0
  1164.  
  1165.     dc.w    3
  1166.     dc.w    DMODE-*
  1167.     dc.b    5,'DMODE'
  1168.     dc.w    CACHE_REG-*
  1169.     dc.b    9,'CACHE_REG'
  1170.  
  1171.     dc.w    0
  1172.  
  1173.     endc
  1174.  
  1175. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1176. ;  BASIC extensions specific to AMIGA QDOS
  1177.  
  1178.     ifd    extras
  1179.  
  1180. B_INTEN:
  1181.     bsr    FETCH_W
  1182.     bne.s    B_INTENX
  1183.  
  1184.     cmp.l    a3,a5
  1185.     bne    RPRT_BP
  1186.  
  1187.     move.w    d1,INTENA
  1188.     moveq    #0,d0
  1189.  
  1190. B_INTENX:
  1191.     rts
  1192.  
  1193. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1194. B_INTRQ:
  1195.     bsr    FETCH_W
  1196.     bne.s    B_INTRQX
  1197.  
  1198.     cmp.l    a3,a5
  1199.     bne    RPRT_BP
  1200.  
  1201.     move.w    d1,INTREQ
  1202.     moveq    #0,d0
  1203.  
  1204. B_INTRQX:
  1205.     rts
  1206.  
  1207. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1208. B_DMACN:
  1209.     bsr    FETCH_W
  1210.     bne.s    B_DMACNX
  1211.  
  1212.     cmp.l    a3,a5
  1213.     bne    RPRT_BP
  1214.  
  1215.     move.w    d1,DMACON
  1216.     moveq    #0,d0
  1217.  
  1218. B_DMACNX:
  1219.     rts
  1220.  
  1221.     endc
  1222.  
  1223. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1224. ;  request stop blitter
  1225.  
  1226. B_BL_OFF:
  1227.  
  1228.     bset    #7,AV.FLGS1    ; request blit disable
  1229.     moveq    #0,d0
  1230.  
  1231.     rts
  1232.  
  1233. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1234. ;  request restart blitter
  1235.  
  1236. B_BL_ON:
  1237.  
  1238.     bclr    #7,AV.FLGS1    ; clear blit disable
  1239.     moveq    #0,d0
  1240.  
  1241.     rts
  1242.  
  1243. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1244. RESET_RANGE:
  1245.     bsr    FETCH_L
  1246.     bne.s    RESET_RNGXIT
  1247.     move.l    d1,d6        ; RAMTOP 'from' address
  1248.  
  1249.     bsr    FETCH_L
  1250.     bne.s    RESET_RNGXIT
  1251.     move.l    d1,d7        : RAMTOP 'to' address
  1252.  
  1253.     bsr    FETCH_L
  1254.     bne.s    RESET_RNGXIT
  1255.     move.l    d1,a5        : new SV address
  1256.  
  1257.     move.l    d6,a3
  1258.     move.l    d7,a4
  1259.  
  1260.     trap    #0        ; enter supervisor mode
  1261.     ori.w    #$0700,sr    ; disable interrupts
  1262.  
  1263.     bsr    SYSRANGE
  1264.  
  1265.     bsr    RNGCHK
  1266.     bne.s    RESET_RNGX
  1267.  
  1268.     bsr    SVCHK
  1269.     bne.s    RESET_RNGX
  1270.  
  1271.     bsr    RNGNEW
  1272.     bsr    SVNEW
  1273.  
  1274.     bra    RESET_SV1
  1275.  
  1276. RESET_RNGX:
  1277.     andi.w    #$D8FF,sr    ; user mode, ints on
  1278.  
  1279. RESET_RNGXIT:
  1280.     rts            ; return error
  1281.  
  1282.  
  1283.  
  1284. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1285. RESET_TOP:
  1286.     bsr    FETCH_L
  1287.     bne.s    RESET_TOPXIT
  1288.     move.l    d1,d6        ; ROMTOP 'from' address
  1289.  
  1290.     bsr    FETCH_L
  1291.     bne.s    RESET_TOPXIT
  1292.     move.l    d1,a4        : ROMTOP 'to' address
  1293.  
  1294.     move.l    d6,a3
  1295.  
  1296.     trap    #0        ; enter supervisor mode
  1297.     ori.w    #$0700,sr    ; disable interrupts
  1298.  
  1299.     bsr    SYSRANGE
  1300.     move.l    a2,a5
  1301.  
  1302.     bsr    RNGCHK
  1303.     bne.s    RESET_TOPX
  1304.  
  1305.     bsr    RNGNEW
  1306.  
  1307.     bra.s    RESET_SV1
  1308.  
  1309. RESET_TOPX:
  1310.     andi.w    #$D8FF,sr    ; user mode, ints on
  1311.  
  1312. RESET_TOPXIT:
  1313.     rts            ; return error
  1314.  
  1315. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1316. RESET_SV:
  1317.     bsr    FETCH_L
  1318.     bne.s    RESET_SVXIT
  1319.     move.l    d1,a5        ; new SV address
  1320.  
  1321.     trap    #0        ; enter supervisor mode
  1322.     ori.w    #$0700,sr    ; disable interrupts
  1323.  
  1324.     bsr    SYSRANGE
  1325.     move.l    a0,a1
  1326.  
  1327.     bsr    SVCHK
  1328.     bne.s    RESET_SVX
  1329.  
  1330.     bsr    SVNEW
  1331.  
  1332. RESET_SV1:
  1333.     move.l    $0,a7        ; reset supervisor stack
  1334.  
  1335.     move.l    a7,d0
  1336.     andi.l    #$FFFF8000,d0
  1337.     move.l    d0,a6
  1338.  
  1339.     suba.l    a0,a0
  1340.  
  1341.     tst.b    161(a6)        ; skip if not 010+
  1342.     beq.s    RESET_SV2
  1343.  
  1344.     dc.w    $4E7A,$8801    ; movec vbr,a0
  1345.  
  1346. RESET_SV2:
  1347.     move.l    $4(a0),-(a7)    ; jump to reset routine
  1348.     rts
  1349.  
  1350. RESET_SVX:
  1351.     andi.w    #$D8FF,sr    ; user mode, ints on
  1352.  
  1353. RESET_SVXIT:
  1354.     rts            ; return error
  1355.  
  1356. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1357. RNGNEW:
  1358.     move.l    a1,SV_RAMT(a2)    ; new RAMTOP
  1359.  
  1360.     cmp.l    a3,a4
  1361.     bgt.s    MDN_TST
  1362.     blt.s    MUP_TST
  1363.     bra    RNGNEW_XIT
  1364.  
  1365. MUP_LUP:
  1366.     move.l    (a0),(a1)+    ; ...move
  1367.     clr.l    (a0)+        ; ...and clear
  1368.  
  1369. MUP_TST:
  1370.     cmp.l    a3,a0        ; until end
  1371.     blt.s    MUP_LUP
  1372.  
  1373.     bra.s    RNGNEW_XIT
  1374.  
  1375. MDN_LUP:
  1376.     move.l    -(a3),-(a4)    ; ...move
  1377.     clr.l    (a3)        ; ...and clear
  1378.  
  1379. MDN_TST:
  1380.     cmp.l    a3,a0        ; until end
  1381.     blt.s    MDN_LUP
  1382.  
  1383. RNGNEW_XIT:
  1384.     rts
  1385.  
  1386. RNGCHK:
  1387.     move.l    a0,d1        ; current RAMTOP
  1388.     sub.l    a3,d1        ; ROMTOP 'from'
  1389.     bgt.s    RNGCHK_BP    ; invalid?
  1390.  
  1391.     add.l    a4,d1
  1392.     move.l    d1,a1        ; possible new RAMTOP
  1393.  
  1394.     cmp.l    a5,a1
  1395.     ble.s    RNGCHK_BP    ; invalid 'to' addr
  1396.  
  1397.     moveq    #ERR.OK,d0
  1398.     bra.s    RNGCHK_XIT
  1399.  
  1400. RNGCHK_BP:
  1401.     moveq    #ERR.BP,d0
  1402.  
  1403. RNGCHK_XIT:
  1404.     tst.l    d0
  1405.     rts
  1406.  
  1407. SVNEW:
  1408.     move.l    (a2),(a5)        ; QDOS sysvars ID
  1409.     move.l    SV_RAMT(a2),SV_RAMT(a5)    ; RAMTOP
  1410.     move.b    161(a2),161(a5)        ; processor type
  1411.     lea    $480(a5),a6
  1412.     move.l    a6,$0            ; new sys stack
  1413.     rts
  1414.  
  1415. SVCHK:
  1416.     move.l    a5,d1
  1417.     andi.w    #$7FFF,d1    ; must be on 32K boundary
  1418.     bne.s    SVCHK_BP
  1419.  
  1420.     cmp.l    #$28000,a5
  1421.     blt.s    SVCHK_BP
  1422.  
  1423.     cmp.l    a2,a5        ; no change?
  1424.     beq.s    SVCHK_BP
  1425.  
  1426.     cmp.l    a1,a5        ; beyond RAMTOP?
  1427.     bge.s    SVCHK_BP
  1428.  
  1429.     moveq    #ERR.OK,d0    ; ev'rythin' fine
  1430.     bra.s    SVCHK_XIT
  1431.  
  1432. SVCHK_BP:
  1433.     moveq    #ERR.BP,d0
  1434.  
  1435. SVCHK_XIT:
  1436.     tst.l    d0
  1437.     rts
  1438.  
  1439. SYSRANGE:
  1440.     move.l    a7,d1
  1441.     andi.l    #$FFFF8000,d1
  1442.     move.l    d1,a2        ; address of system vars
  1443.  
  1444.     move.l    SV_RAMT(a2),a0    ; RAMTOP
  1445.  
  1446.     rts
  1447.  
  1448. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1449. DCACHE_OFF:
  1450.     cmp.l    a3,a5
  1451.     bne    RPRT_BP
  1452.  
  1453. *          1=data cache enable (>=040)
  1454. *          |            1=clear data cache (030)
  1455. *          |            |  1=data cache enable (030)
  1456. *          |            |  |
  1457.     move.l    #%00000000000000000000100000000000,d0
  1458.     move.l    #%10000000000000000000100100000000,d1
  1459.     bsr    DOCACH
  1460.     moveq    #0,d0        ; no errors
  1461.     rts
  1462.  
  1463. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1464.  
  1465. DCACHE_ON:
  1466.     cmp.l    a3,a5
  1467.     bne    RPRT_BP
  1468.  
  1469. *          1=data cache enable (>=040)
  1470. *          |            1=clear data cache (030)
  1471. *          |            |  1=data cache enable (030)
  1472. *          |            |  |
  1473.     move.l    #%10000000000000000000100100000000,d0
  1474.     move.l    d0,d1
  1475.     bsr    DOCACH
  1476.     moveq    #0,d0        ; no errors
  1477.     rts
  1478.  
  1479. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1480. ICACHE_OFF:
  1481.     cmp.l    a3,a5
  1482.     bne    RPRT_BP
  1483.  
  1484. *                1=instr cache enable (>=040)
  1485. *                |       1=clear instr cache (020,030)
  1486. *                |       |  1=instr cache enable(020,030)
  1487. *                |       |  |
  1488.     move.l    #%00000000000000000000000000001000,d0
  1489.     move.l    #%00000000000000001000000000001001,d1
  1490.     bsr    DOCACH
  1491.     moveq    #0,d0        ; no errors
  1492.     rts
  1493.  
  1494. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1495. ICACHE_ON:
  1496.     cmp.l    a3,a5
  1497.     bne    RPRT_BP
  1498.  
  1499. *                1=instr cache enable (>=040)
  1500. *                |       1=clear instr cache (020,030)
  1501. *                |       |  1=instr cache enable(020,030)
  1502. *                |       |  |
  1503.     move.l    #%00000000000000001000000000001001,d0
  1504.     move.l    d0,d1
  1505.     bsr    DOCACH
  1506.     moveq    #0,d0        ; no errors
  1507.     rts
  1508.  
  1509. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1510. CACHE_REG:
  1511.     cmp.l    a3,a5
  1512.     bne    RPRT_BP
  1513.  
  1514.     moveq    #0,d0        ; MT.INF
  1515.     trap    #1
  1516.     move.b    161(a0),d0
  1517.     cmp.b    #$10,d0
  1518.     bcs.s    RPRT_NI
  1519.  
  1520.     trap    #0        ; sv mode
  1521.     ori    #$700,sr
  1522.     dc.w    $4E7A,$2002    ; movec    cacr,d2
  1523.     andi.w    #$D8FF,sr    ; ints on & user mode
  1524.     move.l    d2,d1
  1525.     bra    RET_L
  1526.  
  1527. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1528. ; Copyback controls by SNG, June 1995
  1529.  
  1530. COPYBACK_ON:
  1531.     cmp.l    a3,a5
  1532.     bne    RPRT_BP
  1533.  
  1534.     moveq    #0,d0        ; MT.INF
  1535.     trap    #1
  1536.  
  1537.     move.b    161(a0),d0
  1538.     cmp.b    #$40,d0
  1539.     bcs.s    RPRT_NI
  1540.  
  1541.     trap    #0        ; Supervisor mode
  1542.     ori.w    #$700,sr
  1543. ;     move.l     #$0000C000,d1     ; Write Through to Chip memory
  1544.     move.l    #$0000C040,d1    ; Serialize 0-16 Mb
  1545.     dc.w    $4E7B,$1006    ; movec d1,(006) DTT0
  1546. ;
  1547. ; If TTU/ATU settings clash, DTT0 takes priority over DTT1
  1548. ;
  1549.     move.l    #$00FFC020,d1    ; Copyback on all memory
  1550.     dc.w    $4E7B,$1007    ; movec d1,(007) DTT1
  1551.     andi.w    #$D8FF,sr    ; ints on & user mode
  1552.     moveq    #0,d0
  1553.     rts
  1554.  
  1555. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1556.  
  1557. COPYBACK_OFF:
  1558.     cmp.l    a3,a5
  1559.     bne    RPRT_BP
  1560.     moveq    #0,d0        ; MT.INF
  1561.     trap    #1
  1562.     move.b    161(a0),d0
  1563.     cmp.b    #$40,d0
  1564.     bcc.s    ATLEAST040
  1565. RPRT_NI:
  1566.     moveq    #ERR.NI,d0
  1567.     rts
  1568.  
  1569. ATLEAST040:
  1570.  
  1571.     trap    #0        ; Supervisor mode
  1572.     ori.w    #$700,sr
  1573.  
  1574.     dc.w    $F478        ; CPUSHA dc ('040 plus)
  1575.     move.l    #$0000C040,d1    ; Serialize 0-16 Mb
  1576.     dc.w    $4E7B,$1006    ; movec d1,(006) DTT0
  1577.     move.l    #$00FF0000,d1    ; ATU off pattern
  1578.     dc.w    $4E7B,$1007    ; movec d1,(007) DTT1
  1579.  
  1580.     andi.w    #$D8FF,sr    ; ints on & user mode
  1581.     moveq    #0,d0
  1582.     rts
  1583.  
  1584. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1585. DMODE:
  1586.     cmp.l    a3,a5
  1587.     bne    RPRT_BP
  1588.  
  1589.     moveq    #-1,d1
  1590.     moveq    #-1,d2
  1591.     moveq    #MT.DMODE,d0
  1592.     trap    #1
  1593.  
  1594.     bra    RET_W
  1595.  
  1596. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1597.     ifd    extras
  1598.  
  1599. B_INTENR:
  1600.     move.w    INTENAR,d1
  1601.     bra    RET_W
  1602.  
  1603. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1604. B_INTRQR:
  1605.     move.w    INTREQR,d1
  1606.     bra    RET_W
  1607.  
  1608. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1609. B_DMACNR:
  1610.     move.w    DMACONR,d1
  1611.     bra    RET_W
  1612.  
  1613. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1614. B_CHIP:
  1615.     trap    #0
  1616.     ori.w    #$0700,sr
  1617.  
  1618.     move.l    a7,d0
  1619.     andi.l    #$FFFF8000,d0
  1620.     move.l    d0,a0        ; address of system vars
  1621.  
  1622.     move.l    SV_RAMT(a0),a3    ; limit for RAM check
  1623.  
  1624.     bsr    chip_ram
  1625.  
  1626.     andi.w    #$D8FF,sr
  1627.     move.l    a2,d1
  1628.     bra    RET_L
  1629.  
  1630. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1631. B_EXPANSION:
  1632.     trap    #0
  1633.     ori.w    #$0700,sr
  1634.  
  1635.     move.l    a7,d0
  1636.     andi.l    #$FFFF8000,d0
  1637.     move.l    d0,a0        ; address of system vars
  1638.  
  1639.     lea    $200000,a1    ; RAM check start address
  1640.     move.l    SV_RAMT(a0),a3    ; limit for RAM check
  1641.  
  1642.     bsr    expansion_ram
  1643.  
  1644.     andi.w    #$D8FF,sr
  1645.     move.l    a2,d1
  1646.     bra    RET_L
  1647.  
  1648. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1649. B_RANGER:
  1650.     trap    #0
  1651.     ori.w    #$0700,sr
  1652.  
  1653.     move.l    a7,d0
  1654.     andi.l    #$FFFF8000,d0
  1655.     move.l    d0,a0        ; address of system vars
  1656.  
  1657.     move.l    SV_RAMT(a0),a3    ; limit for RAM check
  1658.  
  1659.     bsr    ranger_ram
  1660.  
  1661.     andi.w    #$D8FF,sr
  1662.     move.l    a2,d1
  1663.     bra    RET_L
  1664.  
  1665.     endc
  1666.  
  1667. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1668. ; Entry: A3.L   pointer to first parameter
  1669. ;    A5.L   pointer to last parameter
  1670. ;
  1671. ; Exit:    A3.L   updated
  1672. ;    A5.L   updated
  1673. ;    D0.L...error code
  1674. ;    D1.W   result
  1675.  
  1676. FETCH_W:
  1677.     MOVEM.L    A1-A2,-(A7)
  1678.  
  1679.     MOVE.W    CA.GTINT,A2
  1680.     BSR.S    GET_ONE
  1681.     BNE.S    FETCH_WX
  1682.  
  1683.     MOVE.W    #0,D1
  1684.     MOVE.W    0(A6,A1.L),D1
  1685.     ADDQ.L    #2,A1
  1686.     MOVE.L    A1,BV_RIP(A6)
  1687.  
  1688. FETCH_WX:
  1689.     MOVEM.L    (A7)+,A1-A2
  1690.     TST.L    D0
  1691.     RTS
  1692.  
  1693. ; --------------------------------------------------------------
  1694. ; Fetch one long word
  1695.  
  1696. FETCH_L:
  1697.     movem.l    a2,-(a7)
  1698.  
  1699.     move.w    CA.GTLIN,a2
  1700.     bsr.s    GET_ONE
  1701.     bne.s    FETCH_LX
  1702.  
  1703.     move.l    a1,BV_RIP(a6)
  1704.     move.l    0(a6,a1.l),d1
  1705.     addq.l    #4,BV_RIP(a6)
  1706.  
  1707. FETCH_LX:
  1708.     movem.l    (a7)+,a2
  1709.     tst.l    d0
  1710.     rts
  1711.  
  1712. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1713. ;  This routine gets one parameter and returns it on the maths
  1714. ;  stack, pointed to by (A1).
  1715. ;
  1716. ; Entry: A2.L   routine to call (i.e. CA.GTINT)
  1717. ;    A3.L   pointer to first parameter
  1718. ;    A5.L   pointer to last parameter
  1719. ;
  1720. ; Exit:    A3.L   updated
  1721. ;    A5.L   updated
  1722. ;    A1.L   updated pointer to top of maths stack
  1723. ;    D0.L   error code
  1724.  
  1725. GET_ONE:
  1726.     MOVEM.L    D1-D6/A0/A2,-(A7)
  1727.  
  1728.     LEA    8(A3),A0
  1729.     CMP.L    A0,A5
  1730.     BLT.S    GET_ONEBp
  1731.  
  1732.     MOVE.L    BV_RIP(A6),A1
  1733.     MOVE.L    A5,-(A7)
  1734.     MOVE.L    A0,A5
  1735.     MOVE.L    A5,-(A7)
  1736.     JSR    (A2)
  1737.     MOVEM.L    (A7)+,A0/A5
  1738.  
  1739.     TST.L    D0
  1740.     BNE.S    GET_ONEX
  1741.  
  1742.     MOVE.L    A0,A3
  1743.     MOVE.L    A1,BV_RIP(A6)
  1744.  
  1745.     BRA.S    GET_ONEX
  1746.  
  1747. GET_ONEBp:
  1748.     MOVEQ    #ERR.BP,D0
  1749.  
  1750. GET_ONEX:
  1751.     MOVEM.L    (A7)+,D1-D6/A0/A2
  1752.     TST.L    D0
  1753.     RTS
  1754.  
  1755. ; --------------------------------------------------------------
  1756. ;  Return word d1.w to BASIC
  1757.  
  1758. RET_W:
  1759.     move.l    d1,d4
  1760.     moveq.l    #2,d1
  1761.     move.w    BV.CHRIX,a2
  1762.     jsr    (a2)
  1763.     move.l    d4,d1
  1764.  
  1765.     move.l    BV_RIP(a6),a1    ; Get arith stack pointer
  1766.     subq.l    #2,a1        ; room for 2 bytes
  1767.     move.l    a1,BV_RIP(a6)
  1768.     move.w    d1,0(a6,a1.l)    ; Put int number on stack
  1769.     moveq.l    #3,d4        ; set Integer type
  1770.  
  1771.     moveq.l    #ERR.OK,d0    ; no errors
  1772.     rts
  1773.  
  1774. ; -------------------------------------------------------------
  1775. ;    Return long Integer d1.l to BASIC
  1776.  
  1777. RET_L:
  1778.     move.l    d1,d4
  1779.     moveq.l    #6,d1
  1780.     move.w    BV.CHRIX,a2
  1781.     jsr    (a2)
  1782.     move.l    d4,d1
  1783.  
  1784.     bsr.s    CONV_L2F
  1785.     subq.l    #6,BV_RIP(a6)
  1786.     move.l    BV_RIP(a6),a1
  1787.     move.w    d2,0(a6,a1.l)
  1788.     move.l    d1,2(a6,a1.l)
  1789.     moveq.l    #2,d4
  1790.  
  1791.     moveq.l    #ERR.OK,d0
  1792.     rts
  1793.  
  1794. ; -------------------------------------------------------------
  1795. ;  convert long Integer to floating point form.
  1796. ;  Entry: d1.l = long int
  1797. ;  Exit:  d1.w = mantissa
  1798. ;     d2.l = exponent
  1799.  
  1800. CONV_L2F:
  1801.     move.l    d1,d2
  1802.     beq.s    CONV_L2FX
  1803.  
  1804.     move.w    #$81F,d2
  1805.     move.l    d1,-(a7)
  1806.  
  1807. CONV_L2F1:
  1808.     add.l    d1,d1
  1809.     bvs.s    CONV_L2F2
  1810.  
  1811.     subq.w    #1,d2
  1812.     move.l    d1,(a7)
  1813.     bra.s    CONV_L2F1
  1814.  
  1815. CONV_L2F2:
  1816.     move.l    (a7)+,d1
  1817.  
  1818. CONV_L2FX:
  1819.     rts
  1820.  
  1821. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1822. RPRT_BP:
  1823.     moveq    #ERR.BP,d0
  1824.     rts
  1825.  
  1826. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1827.     END
  1828.