Antic Magazine 1982 April/Antic_Vol_1_No_1_April_1982.atr/forthfa1.txt

Text File | 2021-02-09 | 3KB | 1 lines

( 39 new-vlank process                    )¢ decimal¢: TASK:  creat [compile] assembler¢  assembler mem ( switch now  )¢  here    ( save pfa )¢  0 scan-tasks  ( find entry now  )¢  !csp¢  mtoff ;¢: ;TASK current @ context !¢  ?csp  ( everything secure )¢  !  ( store pfa into table entry )¢  mton  ; ( do multi-tasking )¢: INSTALL¢  [compile]  0 scan-tasks¢   sneak  ; ( the change into table )¢: REMOVE  [compile]  scan-tasks¢  0 swap sneak ; ( delete by nulling )¢¢( 41 trying a blinking task                        )¢ hex¢0 variable time-left¢0 variable rate¢0 variable blank-state¢d401 constant chactl  ( char control )¢ task: blink¢ time-left  lda, 0=¢  if, blank-state lda, 0= NOT¢      if, 0 # lda,¢      else, 1 # lda,¢      then,¢     chactl sta, blank-state sta,¢     rate lda, time-left sta,¢   else, time-left drc,¢   then, rts,¢ ;tasks¢¢( 42 sound handler example                           )¢ hex¢label envelope¢a0 c, a1 c, a2 c, 00 c, a5 c, a6 c,¢a8 c, 00 c, ab c, ac c, 00 c, af c,¢c variable into¢0 variable sounding¢0 variable old.key¢ decimal¢¢( 43 sound handler example                           )¢ hex¢0 voice¢ task: key.noise¢  sounding lda, 0= not¢       if, into ldx,¢           envelope ,x lda, audv sta,¢           volume sta¢           dex, 0<¢         if, 0 # lda, sounding sta,¢          c # ldx, then, into stx,¢       else, d209 lda, old.key cmp, 0= not¢        if, audf sta, old.key sta,¢            1 # lda, sounding sta,¢       then,¢      then, rts,¢;task¢decimal¢¢( 35 new vblank vectors                          )¢ HEX¢e45c  constant SETVBV¢e460  constant VBLANKI¢e463  constant VBLANKD ( OS dependant )¢code Set-Vblankd ( addr is on stack )¢  pha, tya, pha, xsave stx,¢  bot lda, pha,  ( IS ON STACK )¢  bot 1+ lda, tax, pla, tay,¢  7 # lda, setvbv jsr,¢  pla, tay, pla, xsave ldx,¢  pop jmp,¢end-code¢ decimal¢( the 7 # lda, would be changed to 6 )¢( for the immediate vblankd vector)¢( and to 1-5 for timers 1-5 )¢¢( 36 setting up task table                                )¢00 variable TASK#¢00 variable JUMPER ( indirect jump )¢ label TASK-TABLE¢00 , 00 , 00 , 00 , 00 , 00 , 00 , 00 ,¢¢( 37 setting up task table                               )¢code WHOSE-TURN¢      task# lda, .a asl, tax,¢      task-table 1+ ,x lda, 0= not¢      if, jumper 1+ sta, ( install pointer)¢         task-table ,x lda, jumper sta,¢         jumper ) jmp,¢      then, rts,¢end-code¢code NEXT-TASK  clc, task# lda,¢     1 # adc, 03 # and, task# sta, rts,¢end-code¢( 4 entries in a table are checked )¢code NEW-VBLANK¢     whose-turn jsr¢     next-task    jsr,¢    vblankd        jmp, end-code¢decimal¢¢( 38 new-vblank process                                   )¢ decimal¢: SCAN-TASKS ( match val)¢   -1 swap 32 0 ( flag for 0<)¢   do i task-table + dup ( addr in tabl)¢      @ 3 pick =  ( match to given val )¢      if rot drop. ( loose 0< flag)¢         swap leave¢      else drop  ( addr or flag )¢      then¢   2 +loop drop  ( given val )¢   dup 0< 44 ?error   ;¢( task table in lower 32k of memory !! )¢: MTOFF  vblankd set-vblankd  ;¢( disable and enable multi-tasking     )¢: MTON   new-vblank set-vblankd  ;¢: SNEAK  mtoff !  mton  ;¢( synchronized storage                      )¢