; NOTA : ; 2007/XX/XX : Version origine 1.02c ; ; 2007/06/28 : CR remplacer par des XCR .... ; Correction bug enclose FD-V3.pdf page 170 ; Optimisation branch absolute FD-V5N2.pdf ; ; VERSION 0.1 : 2007/XX/XX : foric97.asm : version initiale ; VERSION 0.2 : 2008/XX/XX : foric08.asm : corrections mineures ; VERSION 0.3 : 2011/11/09 : foric11.asm : optimisations/améliorations diverses sur la partie gestion écran VERSION ; ; Through the courtesy of ; ; FORTH INTEREST GROUP ; P.O. BOX 2154 ; OAKLAND, CALIFORNIA ; 94621 ; ; ; Release 1.k0010 ; ; with compiler security ; and ; variable length names ; ; Further distribution need not include this notice. ; The FIG installation Manual is required as it contains ; the model of FORTH and glossary of the system. ; Might be available from FIG at the above address for $95.00 postpaid. ; ; Translated from the FIG model by W.F. Ragsdale with input- ; output given for the Rockwell System-65. Transportation to ; other systems requires only the alteration of : ; ; XEMIT, XKEY, XQTER, XCR, AND RSLW ; ; Equates giving memory assignments, machine ; registers, and disk parameters. ; SSIZE = 256 ; sector size in bytes NBUF = 4 ; number of buffers desired in RAM (SSIZE*NBUF >= 1024 bytes) SECTR = 2048 ; sector per drive forcing high drive to zero SECTL = 4096 ; sector limit for two drives of 800 per drive. BMAG = SSIZE*NBUF+4*NBUF ; total buffer magnitude, in bytes expressed by SSIZ*4E+4*NBUF LO = $2000 ; Ajout : HI = LO + SSIZE*NBUF*10 ; Ajout : Equivalent de 10 ecrans de 16 lignes de 64 caracteres ; ;-------------------------------------------------------------- ; PAGE 0 ;-------------------------------------------------------------- v0Source = $0002 ; word v0Cible = $0004 ; word v0Longueur = $0006 ; word v0CalculAdresse = $0008 ; word v0PtrText = $000A ; word v0Tmp = $000C ; word v0RegTmp = $000E ; byte BOS = $0010 ; bottom of data stack, in zero-page. TOS = $009E ; top of data stack, in zero-page. N = TOS+8 ; scratch workspace. IP = N+6 ; interpretive pointer. W = IP+3 ; code field pointer. UP = W+2 ; user area pointer. XSAVE = UP+2 ; temporary for X register. XW = XSAVE+2 ; scratch reg. to next code field add NP = XW+2 ; scratch reg. pointing to name field ;-------------------------------------------------------------- ; PAGE 1 ;-------------------------------------------------------------- TIBX = $0400 ; terminal input buffer of 80 bytes. PILE = $0180 ;-------------------------------------------------------------- ; PAGE 2 ;-------------------------------------------------------------- v2Work1 = $0200 ; byte v2Work2 = $0201 ; byte v2Work5 = $0204 ; byte v2KBD = $0208 ; byte v2KBD_CTRL = $0209 ; byte v2KBD_ColPattern = $020A ; byte v2KBD_CTRLColPattern = $020B ; byte v2KBD_UpcaseFlag = $020C ; byte v2KBD_ColCount = $020D ; byte v2KBD_RepeatCount = $020E ; byte v2KBD_Work1 = $0210 ; byte v2KBD_Work2 = $0211 ; byte v2TypeScr = $021F ; byte v2KBD_TempoRep = $024E ; byte v2KBD_TempoAuto = $024F ; byte v2NbColEcran = $0257 ; byte v2CursorWork = $0265 ; byte v2CurRow = $0268 ; byte v2CurCol = $0269 ; byte v2Mode0 = $026A ; byte v2Paper = $026B ; byte v2Ink = $026C ; byte v2AuthClig = $0271 ; byte v2TIMER1 = $0272 ; Array[0..2] of WORD v2VduL2 = $0278 ; word v2VduL1 = $027A ; word v2LgEcran = $027C ; word v2NbLigneEcran = $027E ; byte v2LigneStatut = $02C3 ; word : nouveau par rapport à l'oric atmos position de la ligne de statut v2IChar = $02DF ; word v2FlgScroll = $02F0 ;-------------------------------------------------------------- ; PAGE 3 : VIA ;-------------------------------------------------------------- v3_IORB = $0300 ; byte v3_IORA = $0301 ; byte v3_DDRB = $0302 ; byte v3_DDRA = $0303 ; byte v3_T1CL = $0304 ; byte v3_T1CH = $0305 ; byte v3_T1LL = $0306 ; byte v3_T1LH = $0307 ; byte v3_T2CL = $0308 ; byte v3_T2CH = $0309 ; byte v3_SR = $030A ; byte v3_ACR = $030B ; byte v3_PCR = $030C ; byte v3_IFR = $030D ; byte v3_IER = $030E ; byte v3_IOA = $030F ; byte ; ORIG = $C000 ; origin of FORTH's Dictionary. MEM = $7000 ; top of assigned memory+1 byte. FORTH_RAM = $0500 ; Recopie du mot FORTH en memoire UAREA = MEM-128 ; 128 bytes of user area DAREA = UAREA-BMAG ; disk buffer space. BRKBYTE = MEM ; XSAVE+1 ;?flag if break is pressed ; ; monitor calls for terminal support ; ; ; From DAREA downward to the top of the dictionary is free ; space where the user's applications are compiled. ; ; Boot up parameters. This area provides jump vectors ; to Boot up code, and parameters describing the system. ; ; *=ORIG ; ; ; User cold entry point ENTER NOP ; Vector to COLD entry JMP COLD+2 ; REENTR NOP ; User Warm entry point JMP WARM ; Vector to WARM entry .WORD $0004 ; 6502 in radix-36 .WORD $5ED2 ; .WORD NTOP ; Name address of MON .WORD $7F ; Backspace Character .WORD UAREA ; Initial User Area BEGINUAREA .WORD TOS ; Initial Top of Stack .WORD $1FF ; Initial Top of Return Stack .WORD TIBX ; TIB ; Initial terminal input buffer .WORD 31 ; WIDTH ; Initial name field width .WORD 0 ; WARNING ; 0=no disk, 1=disk .WORD FORTH_RAM+$13 ; TOP; FENCE ; Initial fence address .WORD FORTH_RAM+$13 ; TOP; DP ; Initial top of dictionary .WORD FORTH_RAM+$10 ; VOC-LINK ; Initial Vocabulary link ptr. ; ; The following offset adjusts all code fields to avoid an ; address ending $XXFF. This must be checked and altered on ; any alteration , for the indirect jump at W-1 to operate ! ; .ORG *+2 ; ; ; LIT ; SCREEN 13 LINE 1 ; L22 .BYTE $83,"LI",$D4 ; <--- name field ; <----- link field .WORD 0000 ; last link marked by zero LIT .WORD *+2 ; <----- code address field LDA (IP),Y ; <----- start of parameter field PHA INC IP BNE L30 INC IP+1 L30 LDA (IP),Y L31 INC IP BNE PUSH INC IP+1 ; PUSH: DEX DEX ; PUT STA 1,X PLA STA 0,X ; ; NEXT is the address interpreter that moves from machine ; level word to word. ; NEXT LDY #1 LDA (IP),Y ; Fetch code field address pointed STA W+1 ; to by IP. DEY LDA (IP),Y STA W ;@JSR TRACE ;;@ Remove this when all is well CLC ; Increment IP by two. LDA IP ADC #2 STA IP BCC L54 INC IP+1 L54 JMP W-1 ;Jump to an indirect jump (W) which ; vectors to code pointed to by a code ; field. ; ; CLIT pushes the next inline byte to data stack ; L35 .BYTE $84,"CLI",$D4 .WORD L22 ; Link to LIT CLIT: .WORD *+2 LDA (IP),Y PHA TYA BEQ L31 ; a forced branch into LIT ; ; ; This is a temporary trace routine, to be used until FORTH ; is generally operating. Then NOP the terminal query ; "JSR ONEKEY". This will allow user input to the text ; interpreter. When crashes occur, the display shows IP, W, ; and the word locations of the offending code. When all is ; well, remove : TRACE, TCOLON, PRNAM, DECNP, and the ; following monitor/register equates. ; ; ; ; Monitor routines needed to trace. ; ; ; TRACE STX XSAVE JSR XCR LDA IP+1 JSR HEX2 LDA IP JSR HEX2 ; print IP, the interpreter pointer LDA #$20 JSR WRITECAR ; ; LDA #0 LDA (IP),Y STA XW STA NP ; fetch the next code field pointer INY LDA (IP),Y STA XW+1 STA NP+1 JSR PRNAM ; print dictionary name ; LDA XW+1 JSR HEX2 ; print code field address LDA XW JSR HEX2 LDA #$20 JSR WRITECAR ; LDA XSAVE ; print stack location in zero-page JSR HEX2 LDA #$20 JSR WRITECAR ; LDA #1 ; print return stack bottom in page 1 JSR HEX2 TSX INX TXA JSR HEX2 LDA #$20 JSR WRITECAR ; ;@JSR ONEKEY ; wait for operator keystroke LDX XSAVE ; just to pinpoint early problems LDY #0 RTS ; ; TCOLON is called from DOCOLON to label each point ; where FORTH 'nests' one level. ; TCOLON STX XSAVE LDA W STA NP ; locate the name of the called word LDA W+1 STA NP+1 JSR XCR LDA #$3A ; ':' JSR LETTER LDA #$20 JSR WRITECAR JSR PRNAM ; JSR ONEKEY ; wait for operator keystroke LDX XSAVE RTS ; ; Print name by it's code field address in NP ; PRNAM JSR DECNP JSR DECNP JSR DECNP LDY #0 PN1 JSR DECNP LDA (NP),Y ; loop till D7 in name set BPL PN1 PN2 INY LDA (NP),Y JSR LETTER ; print letters of name field LDA (NP),Y BPL PN2 LDA #$20 JSR WRITECAR LDY #0 RTS ; ; Decrement name field pointer ; DECNP LDA NP BNE DECNP1 DEC NP+1 DECNP1 DEC NP RTS ; ; SETUP ASL ; * 2 STA N-1 L63 LDA 0,X STA N,Y INX INY CPY N-1 BNE L63 LDY #0 RTS ; ; EXECUTE ; SCREEN 14 LINE 11 ; L75 .BYTE $87,"EXECUT",$C5 .WORD L35 ; link to CLIT EXEC .WORD *+2 LDA 0,X STA W LDA 1,X STA W+1 INX INX JMP W-1 ; to JMP (W) in z-page ; ; BRANCH ; SCREEN 15 LINE 11 ; L89 .BYTE $86,"BRANC",$C8 .WORD L75 ; link to EXCECUTE BRAN .WORD *+2 CLC LDA (IP),Y ADC IP PHA INY LDA (IP),Y ADC IP+1 STA IP+1 PLA STA IP JMP NEXT +2 ; ; 0BRANCH ; SCREEN 15 LINE 6 ; L107 .BYTE $87,"0BRANC",$C8 .WORD L89 ; link to BRANCH ZBRAN .WORD *+2 INX INX LDA $FE,X ORA $FF,X BEQ BRAN+2 ; BUMP CLC LDA IP ADC #2 STA IP BCC L122 INC IP+1 L122 JMP NEXT ; ; (LOOP) ; SCREEN 16 LINE 1 ; L127 .BYTE $86,"(LOOP",$A9 .WORD L107 ; link to 0BRANCH PLOOP .WORD L130 L130 STX XSAVE TSX INC $101,X BNE PL1 INC $102,X ; PL1 CLC LDA $103,X SBC $101,X LDA $104,X SBC $102,X ; PL2 LDX XSAVE ASL BCC BRAN+2 PLA PLA PLA PLA JMP BUMP ; ; (+LOOP) ; SCREEN 16 LINE 8 ; L154 .BYTE $87,"(+LOOP",$A9 .WORD L127 ; link to (loop) PPLOO .WORD *+2 INX INX STX XSAVE LDA $FF,X PHA PHA LDA $FE,X TSX INX INX CLC ADC $101,X STA $101,X PLA ADC $102,X STA $102,X PLA BPL PL1 CLC LDA $101,X SBC $103,X LDA $102,X SBC $104,X JMP PL2 ; ; (DO) ; SCREEN 17 LINE 2 ; L185 .BYTE $84,"(DO",$A9 .WORD L154 ; link to (+LOOP) PDO .WORD *+2 LDA 3,X PHA LDA 2,X PHA LDA 1,X PHA LDA 0,X PHA ; POPTWO INX INX ; ; ; POP INX INX JMP NEXT ; ; I ; SCREEN 17 LINE 9 ; L207 .BYTE $81,$C9 .WORD L185 ; link to (DO) I: .WORD R+2 ; share the code for R .ORG *+1 ;@ A ETE AJOUTE CAR DEMARRE A UNE ADRESSE EN $xxFF ; ; DIGIT ; SCREEN 18 LINE 1 ; L214 .BYTE $85,"DIGI",$D4 .WORD L207 ; link to I DIGIT .WORD *+2 SEC LDA 2,X SBC #$30 BMI L234 CMP #$A BMI L227 SEC SBC #7 CMP #$A BMI L234 L227 CMP 0,X BPL L234 STA 2,X LDA #1 PHA TYA JMP PUT ; exit true with converted value L234 TYA PHA INX INX JMP PUT ; exit false with bad conversion ; ; (FIND) ; SCREEN 19 LINE 1 ; ;(FIND) addr1 addr2 --- pfa b tf (ok) ; addr1 addr2 --- ff (bad) L243 .BYTE $86,"(FIND",$A9 ; NFA .WORD L214 ; Link to DIGIT ; LFA PFIND .WORD *+2 ; CFA LDA #2 ; Recopie des parametres dans la zone N ; PFA JSR SETUP STX XSAVE ; Sauvegarde du prochain mot à interpreter L249 LDY #0 LDA (N),Y EOR (N+2),Y AND #$3F ; Les 2 bits de poids fort nous n'interessent pas BNE L281 ; Si <> 0 alors prochain mot L254 INY ; Sinon comparaison lettre par lettre LDA (N),Y EOR (N+2),Y ASL BNE L280 BCC L254 LDX XSAVE ; On a trouvée le mot ... DEX DEX DEX DEX CLC TYA ADC #5 ; Retourne le pfa ADC N STA 2,X LDY #0 TYA ADC N+1 STA 3,X STY 1,X LDA (N),Y STA 0,X LDA #1 ; Retourne le booleen true PHA JMP PUSH L280 BCS L284 L281 INY ; Recherche du prochain caractére > $7F LDA (N),Y BPL L281 L284 INY ; Obtient le LFA du mot actuel LDA (N),Y TAX INY LDA (N),Y STA N+1 STX N ; Test si l'adresse est = "0000" ORA N BNE L249 ; On continue la recherche LDX XSAVE ; Si oui retourne faux !! LDA #0 PHA JMP PUSH ; exit false upon reading null link ; ; ENCLOSE ; SCREEN 20 LINE 1 ; L301 .BYTE $87,"ENCLOS",$C5 .WORD L243 ; link to (FIND) ENCL .WORD *+2 LDA #2 JSR SETUP TXA SEC SBC #8 TAX STY 3,X STY 1,X DEY L313 INY LDA (N+2),Y CMP N BEQ L313 STY 4,X L318 LDA (N+2),Y BNE L327 STY 2,X STY 0,X TYA CMP 4,X BNE L326 INC 2,X L326 JMP NEXT L327 STY 2,X INY CMP N BNE L318 STY 0,X JMP NEXT ; ; EMIT ; SCREEN 21 LINE 5 ; L337 .BYTE $84,"EMI",$D4 .WORD L301 ; link to ENCLOSE EMIT .WORD XEMIT ; Vector to code for KEY ; ; KEY ; SCREEN 21 LINE 7 ; L344 .BYTE $83,"KE",$D9 .WORD L337 ; link to EMIT KEY: .WORD XKEY ; Vector to code for KEY ; ; ?TERMINAL ; SCREEN 21 LINE 9 ; L351 .BYTE $89,"?TERMINA",$CC .WORD L344 ; link to KEY QTERM .WORD XQTER ; Vector to code for ?TERMINAL ; ; ; ; ; ; CR ; SCREEN 21 LINE 11 ; L358 .BYTE $82,"C",$D2 .WORD L351 ; link to ?TERMINAL CR: .WORD XCR ; Vector to code for CR ; ; CMOVE ; SCREEN 22 LINE 1 ; L365 .BYTE $85,"CMOV",$C5 .WORD L358 ; link to CR CMOVE .WORD *+2 LDA #3 JSR SETUP L370 CPY N BNE L375 DEC N+1 BPL L375 JMP NEXT L375 LDA (N+4),Y STA (N+2),Y INY BNE L370 INC N+5 INC N+3 JMP L370 ; ; U* ; SCREEN 23 LINE 1 ; L386 .BYTE $82,"U",$AA .WORD L365 ; link to CMOVE USTAR .WORD *+2 LDA 2,X STA N STY 2,X LDA 3,X STA N+1 STY 3,X LDY #16 ; for 16 bits L396 ASL 2,X ROL 3,X ROL 0,X ROL 1,X BCC L411 CLC LDA N ADC 2,X STA 2,X LDA N+1 ADC 3,X STA 3,X LDA #0 ADC 0,X STA 0,X L411 DEY BNE L396 JMP NEXT ; ; U/ ; SCREEN 24 LINE 1 ; L418 .BYTE $82,"U",$AF .WORD L386 ; link to U* USLAS .WORD *+2 LDA 4,X LDY 2,X STY 4,X ASL STA 2,X LDA 5,X LDY 3,X STY 5,X ROL STA 3,X LDA #16 STA N L433 ROL 4,X ROL 5,X SEC LDA 4,X SBC 0,X TAY LDA 5,X SBC 1,X BCC L444 STY 4,X STA 5,X L444 ROL 2,X ROL 3,X DEC N BNE L433 JMP POP ; ; AND ; SCREEN 25 LINE 2 ; L453 .BYTE $83,"AN",$C4 .WORD L418 ; link to U/ ANDD .WORD *+2 LDA 0,X AND 2,X PHA LDA 1,X AND 3,X ; BINARY INX INX JMP PUT ; ; OR ; SCREEN 25 LINE 7 ; L469 .BYTE $82,"O",$D2 .WORD L453 ; link to AND OR .WORD *+2 LDA 0,X ORA 2,X PHA LDA 1,X ORA 3,X INX INX JMP PUT ; ; XOR ; SCREEN 25 LINE 11 ; L484 .BYTE $83,"XO",$D2 .WORD L469 ; link to OR XOR .WORD *+2 LDA 0,X EOR 2,X PHA LDA 1,X EOR 3,X INX INX JMP PUT ; ; SP@ ; SCREEN 26 LINE 1 ; L499 .BYTE $83,"SP",$C0 .WORD L484 ; link to XOR SPAT .WORD *+2 TXA ; PUSHOA PHA LDA #0 JMP PUSH ; ; SP! ; SCREEN 26 LINE 5 ; ; L511 .BYTE $83,"SP",$A1 .WORD L499 ; link to SP@ SPSTO: .WORD *+2 LDY #6 LDA (UP),Y ; load data stack pointer (X reg) from TAX ; silent user variable S0. JMP NEXT .ORG *+1 ;@ A ETE AJOUTE CAR DEMARRE A UNE ADRESSE EN $xxFF ; ; RP! ; SCREEN 26 LINE 8 ; L522 .BYTE $83,"RP",$A1 .WORD L511 ; link to SP! RPSTO .WORD *+2 STX XSAVE ; load return stack pointer (machine LDY #8 ; stack pointer) from silent user LDA (UP),Y ; VARIABLE R0 TAX TXS LDX XSAVE JMP NEXT ; ; ;S ; SCREEN 26 LINE 12 ; L536 .BYTE $82,";",$D3 .WORD L522 ; link to RP! SEMIS: .WORD *+2 PLA STA IP PLA STA IP+1 JMP NEXT ; ; LEAVE ; SCREEN 27 LINE 1 ; L548 .BYTE $85,"LEAV",$C5 .WORD L536 ; link to ;S LEAVE .WORD *+2 STX XSAVE TSX LDA $101,X STA $103,X LDA $102,X STA $104,X LDX XSAVE JMP NEXT ; ; >R ; SCREEN 27 LINE 5 ; L563 .BYTE $82,">",$D2 .WORD L548 ; link to LEAVE TOR: .WORD *+2 LDA 1,X ; move high byte PHA LDA 0,X ; then low byte PHA ; to return stack ;INX ;INX ; popping off data stack ;JMP NEXT JMP POP ; optimisation car POP <=> INX, INX, JMP POP : 2 octets de gagner ; ; R> ; SCREEN 27 LINE 8 ; L577 .BYTE $82,"R",$BE .WORD L563 ; link to >R RFROM .WORD *+2 DEX ; make room on data stack DEX PLA ; high byte STA 0,X PLA ; then low byte STA 1,X ; restored to data stack JMP NEXT ; ; R ; SCREEN 27 LINE 11 ; ; --- n ; Copy the top of the return stack to the computation stack. L591 .BYTE $81,$D2 .WORD L577 ; link to R> R: .WORD *+2 STX XSAVE TSX ; address return stack LDA $101,X ; copy bottom value PHA ; to data stack LDA $102,X LDX XSAVE JMP PUSH ; ; 0= ; SCREEN 28 LINE 2 ; L605 .BYTE $82,"0",$BD .WORD L591 ; link to R ZEQU .WORD *+2 LDA 1,X ; Corrected from FD3/2 p69 STY 1,X ORA 0,X BNE L613 INY L613 STY 0,X JMP NEXT ; ; 0< ; SCREEN 28 LINE 6 ; L619 .BYTE $82,"0",$BC .WORD L605 ; link to 0= ZLESS .WORD *+2 ASL 1,X TYA ROL STY 1,X STA 0,X JMP NEXT ; ; + ; SCREEN 29 LINE 1 ; L632 .BYTE $81,$AB .WORD L619 ; link to V-ADJ PLUS .WORD *+2 CLC LDA 0,X ADC 2,X STA 2,X LDA 1,X ADC 3,X STA 3,X INX INX JMP NEXT ; ; D+ ; SCREEN 29 LINE 4 ; L649 .BYTE $82,"D",$AB .WORD L632 ; LINK TO + DPLUS .WORD *+2 CLC LDA 2,X ADC 6,X STA 6,X LDA 3,X ADC 7,X STA 7,X LDA 0,X ADC 4,X STA 4,X LDA 1,X ADC 5,X STA 5,X JMP POPTWO ; ; MINUS ; SCREEN 29 LINE 9 ; L670 .BYTE $85,"MINU",$D3 .WORD L649 ; link to D+ MINUS .WORD *+2 SEC TYA SBC 0,X STA 0,X TYA SBC 1,X STA 1,X JMP NEXT ; ; DMINUS ; SCREEN 29 LINE 12 ; L685 .BYTE $86,"DMINU",$D3 .WORD L670 ; link to MINUS DMINU .WORD *+2 SEC TYA SBC 2,X STA 2,X TYA SBC 3,X STA 3,X JMP MINUS+3 ; ; OVER ; SCREEN 30 LINE 1 ; L700 .BYTE $84,"OVE",$D2 .WORD L685 ; link to DMINUS OVER .WORD *+2 LDA 2,X PHA LDA 3,X JMP PUSH ; ; DROP ; SCREEN 30 LINE 4 ; L711 .BYTE $84,"DRO",$D0 .WORD L700 ; link to OVER DROP .WORD POP ; ; SWAP ; SCREEN 30 LINE 8 ; L718 .BYTE $84,"SWA",$D0 .WORD L711 ; link to DROP SWAP .WORD *+2 LDA 2,X PHA LDA 0,X STA 2,X LDA 3,X LDY 1,X STY 3,X JMP PUT ; ; DUP ; SCREEN 30 LINE 21 ; L733 .BYTE $83,"DU",$D0 .WORD L718 ; link to SWAP DUP: .WORD *+2 LDA 0,X PHA LDA 1,X JMP PUSH ; ; +! ; SCREEN 31 LINE 2 ; L744 .BYTE $82,"+",$A1 .WORD L733 ; link to DUP PSTOR .WORD *+2 CLC LDA (0,X) ; fetch 16 bit value addressed by ADC 2,X ; bottom of stack, adding to STA (0,X) ; second item on stack, and return INC 0,X ; to memory BNE L754 INC 1,X L754 LDA (0,X) ADC 3,X STA (0,X) JMP POPTWO ; ; TOGGLE ; SCREEN 31 LINE 7 ; L762 .BYTE $81,"TOGGL",$C5 .WORD L744 ; link to +! TOGGL .WORD *+2 LDA (2,X) ; complement bits in memory address EOR 0,X ; second on stack, by pattern on STA (2,X) ; bottom of stack. JMP POPTWO ; ; @ ; SCREEN 32 LINE 1 ; L773 .BYTE $81,$C0 .WORD L762 ; link to TOGGLE AT .WORD *+2 LDA (0,X) PHA INC 0,X BNE L781 INC 1,X L781 LDA (0,X) JMP PUT ; ; C@ ; SCREEN 32 LINE 5 ; L787 .BYTE $82,"C",$C0 .WORD L773 ; link to @ CAT: .WORD *+2 LDA (0,X) ; fetch byte addressed by bottom of STA 0,X ; stack to stack, zeroing the high STY 1,X ; byte JMP NEXT ; ; ! ; SCREEN 32 LINE 8 ; L798 .BYTE $81,$A1 .WORD L787 ; link to C@ STORE: .WORD *+2 LDA 2,X STA (0,X) ; store second 16bit value on stack INC 0,X ; to memory as addressed by bottom BNE L806 ; of stack. INC 1,X L806 LDA 3,X STA (0,X) JMP POPTWO ; ; C! ; SCREEN 32 LINE 12 ; L813 .BYTE $82,"C",$A1 .WORD L798 ; link to ! CSTOR .WORD *+2 LDA 2,X STA (0,X) JMP POPTWO ; ; : ; SCREEN 33 LINE 2 ; L823 .BYTE $C1,$BA .WORD L813 ; link to C! COLON .WORD DOCOL .WORD QEXEC .WORD SCSP .WORD CURR .WORD AT .WORD CON .WORD STORE .WORD CREAT .WORD RBRAC .WORD PSCOD ; DOCOL: LDA IP+1 PHA LDA IP PHA ;@JSR TCOLON ; mark the start of a traced : def. CLC LDA W ADC #2 STA IP TYA ADC W+1 STA IP+1 JMP NEXT ; ; ; ; SCREEN 33 LINE 9 ; L853 .BYTE $C1,$BB .WORD L823 ; link to : .WORD DOCOL .WORD QCSP .WORD COMP .WORD SEMIS .WORD SMUDG .WORD LBRAC .WORD SEMIS ; ; CONSTANT ; SCREEN 34 LINE 1 ; L867 .BYTE $88,"CONSTAN",$D4 .WORD L853 ; link to ; CONST .WORD DOCOL .WORD CREAT .WORD SMUDG .WORD COMMA .WORD PSCOD ; DOCON LDY #2 LDA (W),Y PHA INY LDA (W),Y JMP PUSH ; ; VARIABLE ; SCREEN 34 LINE 5 ; L885 .BYTE $88,"VARIABL",$C5 .WORD L867 ; link to CONSTANT VAR .WORD DOCOL .WORD CONST .WORD PSCOD ; DOVAR CLC LDA W ADC #2 PHA TYA ADC W+1 JMP PUSH ; ; USER ; SCREEN 34 LINE 10 ; L902 .BYTE $84,"USE",$D2 .WORD L885 ; link to VARIABLE USER .WORD DOCOL .WORD CONST .WORD PSCOD ; DOUSE LDY #2 CLC LDA (W),Y ADC UP PHA LDA #0 ADC UP+1 JMP PUSH ; ; 0 ; SCREEN 35 LINE 2 ; L920 .BYTE $81,$B0 .WORD L902 ; link to USER ZERO .WORD DOCON .WORD 0 ; ; 1 ; SCREEN 35 LINE 2 ; L928 .BYTE $81,$B1 .WORD L920 ; link to 0 ONE .WORD DOCON .WORD 1 ; ; 2 ; SCREEN 35 LINE 3 ; L936 .BYTE $81,$B2 .WORD L928 ; link to 1 TWO .WORD DOCON .WORD 2 ; ; 3 ; SCREEN 35 LINE 3 ; L944 .BYTE $81,$B3 .WORD L936 ; link to 2 THREE .WORD DOCON .WORD 3 ; ; BL ; SCREEN 35 LINE 4 ; L952 .BYTE $82,"B",$CC .WORD L944 ; link to 3 BL: .WORD DOCON .WORD $20 ; ; C/L ; SCREEN 35 LINE 5 ; Characters per line L960 .BYTE $83,"C/",$CC .WORD L952 ; link to BL CSLL .WORD DOCON ;.WORD 64 : le 14/11/2011 : 38 car/ligne .WORD 38 ; ; FIRST ; SCREEN 35 LINE 7 ; L968 .BYTE $85,"FIRS",$D4 .WORD L960 ; link to C/L FIRST .WORD DOCON .WORD DAREA ; bottom of disk buffer area ; ; LIMIT ; SCREEN 35 LINE 8 ; L976 .BYTE $85,"LIMI",$D4 .WORD L968 ; link to FIRST LIMIT .WORD DOCON .WORD UAREA ; buffers end at user area ; ; B/BUF ; SCREEN 35 LINE 9 ; Bytes per Buffer ; L984 .BYTE $85,"B/BU",$C6 .WORD L976 ; link to LIMIT BBUF .WORD DOCON .WORD SSIZE ; sector size ; ; B/SCR ; SCREEN 35 LINE 10 ; Blocks per screen ; L992 .BYTE $85,"B/SC",$D2 .WORD L984 ; link to B/BUF BSCR .WORD DOCON .WORD 1024/SSIZE ;@@pour 8 ; blocks to make one screen ; ; +ORIGIN ; SCREEN 35 LINE 12 ; L1000 .BYTE $87,"+ORIGI",$CE .WORD L992 ; link to B/SCR PORIG .WORD DOCOL .WORD LIT,ORIG .WORD PLUS .WORD SEMIS ; ; TIB ; SCREEN 36 LINE 4 ; L1010 .BYTE $83,"TI",$C2 .WORD L1000 ; link to +ORIGIN TIB .WORD DOUSE .BYTE $A ; ; WIDTH ; SCREEN 36 LINE 5 ; L1018 .BYTE $85,"WIDT",$C8 .WORD L1010 ; link to TIB WIDTH .WORD DOUSE .BYTE $C ; ; WARNING ; SCREEN 36 LINE 6 ; L1026 .BYTE $87,"WARNIN",$C7 .WORD L1018 ; link to WIDTH WARN .WORD DOUSE .BYTE $E ;.ORG *+1 ;@ A ETE AJOUTE CAR DEMARRE A UNE ADRESSE EN $xxFF ; FENCE ; SCREEN 36 LINE 7 ; L1034 .BYTE $85,"FENC",$C5 .WORD L1026 ; link to WARNING FENCE .WORD DOUSE .BYTE $10 ; ; ; DP ; SCREEN 36 LINE 8 ; L1042 .BYTE $82,"D",$D0 .WORD L1034 ; link to FENCE DP .WORD DOUSE .BYTE $12 ; ; VOC-LINK ; SCREEN 36 LINE 9 ; L1050 .BYTE $88,"VOC-LIN",$CB .WORD L1042 ; link to DP VOCL .WORD DOUSE .BYTE $14 ; ; BLK ; SCREEN 36 LINE 10 ; L1058 .BYTE $83,"BL",$CB .WORD L1050 ; link to VOC-LINK BLK .WORD DOUSE .BYTE $16 ; ; IN ; SCREEN 36 LINE 11 ; L1066 .BYTE $82,"I",$CE .WORD L1058 ; link to BLK IN .WORD DOUSE .BYTE $18 ; ; OUT ; SCREEN 36 LINE 12 ; L1074 .BYTE $83,"OU",$D4 .WORD L1066 ; link to IN OUT .WORD DOUSE .BYTE $1A ; ; SCR ; SCREEN 36 LINE 13 ; L1082 .BYTE $83,"SC",$D2 .WORD L1074 ; link to OUT SCR: .WORD DOUSE .BYTE $1C ; ; OFFSET ; SCREEN 37 LINE 1 ; L1090 .BYTE $86,"OFFSE",$D4 .WORD L1082 ; link to SCR OFSET .WORD DOUSE .BYTE $1E ; ; CONTEXT ; SCREEN 37 LINE 2 ; L1098 .BYTE $87,"CONTEX",$D4 .WORD L1090 ; link to OFFSET CON: .WORD DOUSE .BYTE $20 ; ; CURRENT ; SCREEN 37 LINE 3 ; L1106 .BYTE $87,"CURREN",$D4 .WORD L1098 ; link to CONTEXT CURR .WORD DOUSE .BYTE $22 ; ; STATE ; SCREEN 37 LINE 4 ; L1114 .BYTE $85,"STAT",$C5 .WORD L1106 ; link to CURRENT STATE .WORD DOUSE .BYTE $24 ; ; BASE ; SCREEN 37 LINE 5 ; L1122 .BYTE $84,"BAS",$C5 .WORD L1114 ; link to STATE BASE: .WORD DOUSE .BYTE $26 ; ; DPL ; SCREEN 37 LINE 6 ; L1130 .BYTE $83,"DP",$CC .WORD L1122 ; link to BASE DPL .WORD DOUSE .BYTE $28 ; ; FLD ; SCREEN 37 LINE 7 ; L1138 .BYTE $83,"FL",$C4 .WORD L1130 ; link to DPL FLD .WORD DOUSE .BYTE $2A ; ; ; ; CSP ; SCREEN 37 LINE 8 ; L1146 .BYTE $83,"CS",$D0 .WORD L1138 ; link to FLD CSP .WORD DOUSE .BYTE $2C ; ; R# ; SCREEN 37 LINE 9 ; L1154 .BYTE $82,"R",$A3 .WORD L1146 ; link to CSP RNUM .WORD DOUSE .BYTE $2E ; ; HLD ; SCREEN 37 LINE 10 ; L1162 .BYTE $83,"HL",$C4 .WORD L1154 ; link to R# HLD .WORD DOUSE .BYTE $30 ;YYY ; USE ; SCREEN 37 LINE 11 ; L1164 .BYTE $83,"US",$C5 .WORD L1162 ; link to HLD USE .WORD DOUSE .BYTE $32 ;YYY ; PREV ; SCREEN 37 LINE 12 ; L1166 .BYTE $84,"PRE",$D6 .WORD L1164 ; link to HLD PREV .WORD DOUSE .WORD $34 ; ; 1+ ; SCREEN 38 LINE 1 ; L1170 .BYTE $82,"1",$AB .WORD L1166 ; link to PREV ONEP: .WORD DOCOL .WORD ONE .WORD PLUS .WORD SEMIS ; ; 2+ ; SCREEN 38 LINE 2 ; L1180 .BYTE $82,"2",$AB .WORD L1170 ; link to 1+ TWOP .WORD DOCOL .WORD TWO .WORD PLUS .WORD SEMIS ; ; HERE ; SCREEN 38 LINE 3 ; L1190 .BYTE $84,"HER",$C5 .WORD L1180 ; link to 2+ HERE .WORD DOCOL .WORD DP .WORD AT .WORD SEMIS ; ; ALLOT ; SCREEN 38 LINE 4 ; L1200 .BYTE $85,"ALLO",$D4 .WORD L1190 ; link to HERE ALLOT .WORD DOCOL .WORD DP .WORD PSTOR .WORD SEMIS ; ; , ; SCREEN 38 LINE 5 ; L1210 .BYTE $81,$AC .WORD L1200 ; link to ALLOT COMMA .WORD DOCOL .WORD HERE .WORD STORE .WORD TWO .WORD ALLOT .WORD SEMIS .ORG *+1 ;@ A ETE AJOUTE CAR DEMARRE A UNE ADRESSE EN $xxFF ; ; C, ; SCREEN 38 LINE 6 ; L1222 .BYTE $82,"C",$AC .WORD L1210 ; link to , CCOMM .WORD DOCOL .WORD HERE .WORD CSTOR .WORD ONE .WORD ALLOT .WORD SEMIS .ORG *+1 ;@ A ETE AJOUTE CAR DEMARRE A UNE ADRESSE EN $xxFF ; ; - ; SCREEN 38 LINE 7 ; L1234 .BYTE $81,$AD .WORD L1222 ; link to C, SUB .WORD DOCOL .WORD MINUS .WORD PLUS .WORD SEMIS ; ; = ; SCREEN 38 LINE 8 ; L1244 .BYTE $81,$BD .WORD L1234 ; link to - EQUAL .WORD DOCOL .WORD SUB .WORD ZEQU .WORD SEMIS ; ; U< ; Unsigned less than ; L1246 .BYTE $82,"U",$BC .WORD L1244 ; link to = ULESS .WORD DOCOL .WORD SUB ; subtract two values .WORD ZLESS ; test sign .WORD SEMIS ; ; < ; Altered from model ; SCREEN 38 LINE 9 ; L1254 .BYTE $81,$BC .WORD L1246 ; link to U< LESS .WORD *+2 SEC LDA 2,X SBC 0,X ; subtract LDA 3,X SBC 1,X STY 3,X ; zero high byte BVC L1258 EOR #$80 ; correct overflow L1258 BPL L1260 INY ; invert boolean L1260 STY 2,X ; leave boolean JMP POP ; ; > ; SCREEN 38 LINE 10 L1264 .BYTE $81,$BE .WORD L1254 ; link to < GREAT .WORD DOCOL .WORD SWAP .WORD LESS .WORD SEMIS ; ; ROT ; SCREEN 38 LINE 11 ; L1274 .BYTE $83,"RO",$D4 .WORD L1264 ; link to > ROT .WORD DOCOL .WORD TOR .WORD SWAP .WORD RFROM .WORD SWAP .WORD SEMIS ; ; SPACE ; SCREEN 38 LINE 12 ; L1286 .BYTE $85,"SPAC",$C5 .WORD L1274 ; link to ROT SPACE .WORD DOCOL .WORD BL .WORD EMIT .WORD SEMIS ; ; -DUP ; SCREEN 38 LINE 13 ; L1296 .BYTE $84,"-DU",$D0 .WORD L1286 ; link to SPACE DDUP .WORD DOCOL .WORD DUP .WORD ZBRAN L1301 .WORD L1303-L1301 ; $4 ; L1303-L1301 .WORD DUP L1303 .WORD SEMIS ; ; TRAVERSE ; SCREEN 39 LINE 14 ; L1308 .BYTE $88,"TRAVERS",$C5 .WORD L1296 ; link to -DUP TRAV .WORD DOCOL .WORD SWAP L1312 .WORD OVER .WORD PLUS .WORD CLIT .BYTE $7F .WORD OVER .WORD CAT .WORD LESS .WORD ZBRAN L1320 .WORD L1312-L1320 ; $FFF1 ; L1312-L1320 .WORD SWAP .WORD DROP .WORD SEMIS ; ; LATES ; SCREEN 39 LINE 6 ; L1328 .BYTE $86,"LATES",$D4 .WORD L1308 ; link to TRAVERSE LATES .WORD DOCOL .WORD CURR .WORD AT .WORD AT .WORD SEMIS ; ; ; LFA ; SCREEN 39 LINE 11 ; L1339 .BYTE $83,"LF",$C1 .WORD L1328 ; link to LATEST LFA .WORD DOCOL .WORD CLIT .BYTE 4 .WORD SUB .WORD SEMIS ; ; CFA ; SCREEN 39 LINE 12 ; L1350 .BYTE $83,"CF",$C1 .WORD L1339 ; link to LFA CFA .WORD DOCOL .WORD TWO .WORD SUB .WORD SEMIS ; ; NFA ; SCREEN 39 LIINE 13 ; L1360 .BYTE $83,"NF",$C1 .WORD L1350 ; link to CFA NFA .WORD DOCOL .WORD CLIT .BYTE $5 .WORD SUB .WORD LIT,$FFFF .WORD TRAV .WORD SEMIS ; ; PFA ; SCREEN 39 LINE 14 ; L1373 .BYTE $83,"PF",$C1 .WORD L1360 ; link to NFA PFA .WORD DOCOL .WORD ONE .WORD TRAV .WORD CLIT .BYTE 5 .WORD PLUS .WORD SEMIS ; ; !CSP ; SCREEN 40 LINE 1 ; L1386 .BYTE $84,"!CS",$D0 .WORD L1373 ; link to PFA SCSP .WORD DOCOL .WORD SPAT .WORD CSP .WORD STORE .WORD SEMIS ; ; ?ERROR ; SCREEN 40 LINE 3 ; L1397 .BYTE $86,"?ERRO",$D2 .WORD L1386 ; link to !CSP QERR .WORD DOCOL .WORD SWAP .WORD ZBRAN L1402 .WORD L1406-L1402 ; 8 ; L1406-L1402 .WORD ERROR .WORD BRAN L1405 .WORD L1407-L1405 ; 4 ; L1407-L1405 L1406 .WORD DROP L1407 .WORD SEMIS ; ; ?COMP ; SCREEN 40 LINE 6 ; L1412 .BYTE $85,"?COM",$D0 .WORD L1397 ; link to ?ERROR QCOMP .WORD DOCOL .WORD STATE .WORD AT .WORD ZEQU .WORD CLIT .BYTE $11 .WORD QERR .WORD SEMIS ; ; ?EXEC ; SCREEN 40 LINE 8 ; L1426 .BYTE $85,"?EXE",$C3 .WORD L1412 ; link to ?COMP QEXEC .WORD DOCOL .WORD STATE .WORD AT .WORD CLIT .BYTE $12 .WORD QERR .WORD SEMIS ; ; ?PAIRS ; SCREEN 40 LINE 10 ; L1439 .BYTE $86,"?PAIR",$D3 .WORD L1426 ; link to ?EXEC QPAIR .WORD DOCOL .WORD SUB .WORD CLIT .BYTE $13 .WORD QERR .WORD SEMIS ; ; ?CSP ; SCREEN 40 LINE 12 ; L1451 .BYTE $84,"?CS",$D0 .WORD L1439 ; link to ?PAIRS QCSP .WORD DOCOL .WORD SPAT .WORD CSP .WORD AT .WORD SUB .WORD CLIT .BYTE $14 .WORD QERR .WORD SEMIS ; ; ?LOADING ; SCREEN 40 LINE 14 ; L1466 .BYTE $88,"?LOADIN",$C7 .WORD L1451 ; link to ?CSP QLOAD .WORD DOCOL .WORD BLK .WORD AT .WORD ZEQU .WORD CLIT .BYTE $16 .WORD QERR .WORD SEMIS ; ; COMPILE ; SCREEN 41 LINE 2 ; L1480 .BYTE $87,"COMPIL",$C5 .WORD L1466 ; link to ?LOADING COMP .WORD DOCOL .WORD QCOMP .WORD RFROM .WORD DUP .WORD TWOP .WORD TOR .WORD AT .WORD COMMA .WORD SEMIS ; ; [ ; SCREEN 41 LINE 5 ; L1495 .BYTE $C1,$DB .WORD L1480 ; link to COMPILE LBRAC .WORD DOCOL .WORD ZERO .WORD STATE .WORD STORE .WORD SEMIS ; ; ] ; SCREEN 41 LINE 7 ; L1507 .BYTE $81,$DD .WORD L1495 ; link to [ RBRAC .WORD DOCOL .WORD CLIT .BYTE $C0 .WORD STATE .WORD STORE .WORD SEMIS ; ; SMUDGE ; SCREEN 41 LINE 9 ; L1519 .BYTE $86,"SMUDG",$C5 .WORD L1507 ; link to ] SMUDG .WORD DOCOL .WORD LATES .WORD CLIT .BYTE $20 .WORD TOGGL .WORD SEMIS ; ; HEX ; SCREEN 41 LINE 11 ; L1531 .BYTE $83,"HE",$D8 .WORD L1519 ; link to SMUDGE HEX .WORD DOCOL .WORD CLIT .BYTE 16 .WORD BASE .WORD STORE .WORD SEMIS ; ; DECIMAL ; SCREEN 41 LINE 13 ; L1543 .BYTE $87,"DECIMA",$CC .WORD L1531 ; link to HEX DECIM: .WORD DOCOL .WORD CLIT .BYTE 10 .WORD BASE .WORD STORE .WORD SEMIS ; ; ; ; (;CODE) ; SCREEN 42 LINE 2 ; L1555 .BYTE $87,"(;CODE",$A9 .WORD L1543 ; link to DECIMAL PSCOD .WORD DOCOL .WORD RFROM .WORD LATES .WORD PFA .WORD CFA .WORD STORE .WORD SEMIS ; ; ;CODE ; SCREEN 42 LINE 6 ; L1568 .BYTE $C5,";COD",$C5 .WORD L1555 ; link to (;CODE) .WORD DOCOL .WORD QCSP .WORD COMP .WORD PSCOD .WORD LBRAC .WORD SMUDG .WORD SEMIS ; ; ; SCREEN 43 LINE 4 ; L1592 .BYTE $85,"DOES",$BE .WORD L1582 ; link to COUNT: .WORD DOCOL .WORD DUP .WORD ONEP .WORD SWAP .WORD CAT .WORD SEMIS ; ; TYPE ; SCREEN 44 LINE 2 ; ; addr count --- ; Transmit count characters from addr to the selected output ; device. L1634 .BYTE $84,"TYP",$C5 .WORD L1622 ; link to COUNT TYPE: .WORD DOCOL .WORD DDUP .WORD ZBRAN L1639 .WORD L1651-L1639 ; $18 ; L1651-L1639 .WORD OVER .WORD PLUS .WORD SWAP .WORD PDO ;(DO) L1644 .WORD I .WORD CAT ;C@ .WORD EMIT .WORD PLOOP L1648 .WORD L1644-L1648 ; $FFF8 ; L1644-L1648 .WORD BRAN L1650 .WORD L1652-L1650 ; $4 ; L1652-L1650 L1651 .WORD DROP L1652 .WORD SEMIS ; ; -TRAILING ; SCREEN 44 LINE 5 ; ;addr n1 --- addr n2 ; Adjusts the character count n1 of a text string beginning ; address to suppress the output of trailing blanks. ie. ; the characters at addr+n2 are blanks. L1657 .BYTE $89,"-TRAILIN",$C7 .WORD L1634 ; link to TYPE DTRAI .WORD DOCOL .WORD DUP .WORD ZERO .WORD PDO ;(DO) L1663 .WORD OVER .WORD OVER .WORD PLUS .WORD ONE .WORD SUB .WORD CAT ;c@ .WORD BL ;$20 .WORD SUB .WORD ZBRAN L1672 .WORD L1676-L1672 ; 8 ; L1676-L1672 .WORD LEAVE .WORD BRAN L1675 .WORD L1678-L1675 ; 6 ; L1678-L1675 L1676 .WORD ONE .WORD SUB L1678 .WORD PLOOP L1679 .WORD $FFE0 ; L1663-L1679 .WORD SEMIS ; ; (.") ; SCREEN 44 LINE 8 L1685 .BYTE $84,"(.",$22,$A9 .WORD L1657 ; link to -TRAILING PDOTQ: .WORD DOCOL .WORD R .WORD COUNT .WORD DUP .WORD ONEP .WORD RFROM .WORD PLUS .WORD TOR .WORD TYPE .WORD SEMIS ; ; ." ; SCREEN 44 LINE12 ; L1701 .BYTE $C2,".",$A2 .WORD L1685 ; link to PDOTQ .WORD DOCOL .WORD CLIT .BYTE $22 .WORD STATE .WORD AT .WORD ZBRAN L1709 .WORD L1719-L1709 ; $14 ; L1719-L1709 .WORD COMP .WORD PDOTQ .WORD WORD .WORD HERE .WORD CAT .WORD ONEP .WORD ALLOT .WORD BRAN L1718 .WORD L1723-L1718 ; $A ; L1723-L1718 L1719 .WORD WORD .WORD HERE .WORD COUNT .WORD TYPE L1723 .WORD SEMIS ; ; EXPECT ; SCREEN 45 LINE 2 ; L1729 .BYTE $86,"EXPEC",$D4 .WORD L1701 ; link to ." EXPEC .WORD DOCOL .WORD OVER .WORD PLUS .WORD OVER .WORD PDO ; (DO) L1736 .WORD KEY .WORD DUP .WORD CLIT .BYTE $E .WORD PORIG ; +ORIGIN .WORD AT .WORD EQUAL .WORD ZBRAN L1744 .WORD L1760-L1744 ; $1F ; L1760-L1744 .WORD DROP .WORD CLIT .BYTE 08 .WORD OVER .WORD I .WORD EQUAL .WORD DUP .WORD RFROM .WORD TWO .WORD SUB .WORD PLUS .WORD TOR .WORD SUB .WORD BRAN L1759 .WORD L1779-L1759 ; $27 ; L1779-L1759 L1760 .WORD DUP .WORD CLIT .BYTE $0D .WORD EQUAL .WORD ZBRAN L1765 .WORD L1772-L1765 ; $0E ; L1772-L1765 .WORD LEAVE .WORD DROP .WORD BL .WORD ZERO .WORD BRAN L1771 .WORD L1773-L1771 ; 04 ; L1773-L1771 L1772 .WORD DUP L1773 .WORD I .WORD CSTOR .WORD ZERO .WORD I .WORD ONEP .WORD STORE L1779 .WORD EMIT .WORD PLOOP L1781 .WORD L1736-L1781 ; $FFA9 ; L1736-L1781 .WORD DROP .WORD SEMIS ; ; QUERY ; SCREEN 45 LINE 9 ; L1788 .BYTE $85,"QUER",$D9 .WORD L1729 ; link to EXPECT QUERY .WORD DOCOL .WORD TIB .WORD AT .WORD CLIT .BYTE 80 ; 80 characters from terminal .WORD EXPEC .WORD ZERO .WORD IN .WORD STORE .WORD SEMIS ; ; X ; SCREEN 45 LINE 11 ; Actually Ascii Null ; L1804 .BYTE $C1,$80 .WORD L1788 ; link to QUERY .WORD DOCOL .WORD BLK .WORD AT .WORD ZBRAN L1810 .WORD L1830-L1810 ; $2A ; L1830-L1810 .WORD ONE .WORD BLK .WORD PSTOR .WORD ZERO .WORD IN .WORD STORE .WORD BLK .WORD AT .WORD ZERO,BSCR .WORD USLAS .WORD DROP ; fixed from model .WORD ZEQU .WORD ZBRAN L1824 .WORD L1828-L1824 ; 8 ; L1828-L1824 .WORD QEXEC .WORD RFROM .WORD DROP L1828 .WORD BRAN L1829 .WORD L1832-L1829 ; 6 ; L1832-L1829 L1830 .WORD RFROM .WORD DROP L1832 .WORD SEMIS ; ; FILL ; SCREEN 46 LINE 1 ; ; L1838 .BYTE $84,"FIL",$CC .WORD L1804 ; link to X FILL .WORD DOCOL .WORD SWAP .WORD TOR .WORD OVER .WORD CSTOR .WORD DUP .WORD ONEP .WORD RFROM .WORD ONE .WORD SUB .WORD CMOVE .WORD SEMIS ; ; ERASE ; SCREEN 46 LINE 4 ; L1856 .BYTE $85,"ERAS",$C5 .WORD L1838 ; link to FILL ERASE .WORD DOCOL .WORD ZERO .WORD FILL .WORD SEMIS ; ; BLANKS ; SCREEN 46 LINE 7 ; L1866 .BYTE $86,"BLANK",$D3 .WORD L1856 ; link to ERASE BLANK .WORD DOCOL .WORD BL .WORD FILL .WORD SEMIS ; ; HOLD ; SCREEN 46 LINE 10 ; L1876 .BYTE $84,"HOL",$C4 .WORD L1866 ; link to BLANKS HOLD .WORD DOCOL .WORD LIT,$FFFF .WORD HLD .WORD PSTOR .WORD HLD .WORD AT .WORD CSTOR .WORD SEMIS ; ; PAD ; SCREEN 46 LINE 13 ; L1890 .BYTE $83,"PA",$C4 .WORD L1876 ; link to HOLD PAD .WORD DOCOL .WORD HERE .WORD CLIT .BYTE 68 ; PAD is 68 bytes above here. .WORD PLUS .WORD SEMIS ; ; WORD ; SCREEN 47 LINE 1 ; L1902 .BYTE $84,"WOR",$C4 .WORD L1890 ; link to PAD WORD .WORD DOCOL .WORD BLK .WORD AT .WORD ZBRAN L1908 .WORD L1914-L1908 ; $C ; L1914-L1908 .WORD BLK .WORD AT .WORD BLOCK .WORD BRAN L1913 .WORD L1916-L1913 ; $6 ; L1916-L1913 L1914 .WORD TIB .WORD AT L1916 .WORD IN .WORD AT .WORD PLUS .WORD SWAP .WORD ENCL .WORD HERE .WORD CLIT .BYTE $22 .WORD BLANK .WORD IN .WORD PSTOR .WORD OVER .WORD SUB .WORD TOR .WORD R .WORD HERE .WORD CSTOR .WORD PLUS .WORD HERE .WORD ONEP .WORD RFROM .WORD CMOVE .WORD SEMIS ; ; UPPER ; SCREEN 47 LINE 12 ; L1943 .BYTE $85,"UPPE",$D2 .WORD L1902 ; link to WORD UPPER .WORD DOCOL .WORD OVER ; This routine converts text to U case .WORD PLUS ; It allows interpretation from a term. .WORD SWAP ; without a shift-lock. .WORD PDO L1950 .WORD I .WORD CAT .WORD CLIT .BYTE $5F .WORD GREAT .WORD ZBRAN L1956 .WORD L1961-L1956 ; 09 ; L1961-L1956 .WORD I .WORD CLIT .BYTE $20 .WORD TOGGL L1961 .WORD PLOOP L1962 .WORD L1950-L1962 ; $FFEA ; L1950-L1962 .WORD SEMIS ; ; (NUMBER) ; SCREEN 48 LINE 1 ; L1968 .BYTE $88,"(NUMBER",$A9 .WORD L1943 ; link to UPPER PNUMB .WORD DOCOL L1971 .WORD ONEP .WORD DUP .WORD TOR .WORD CAT .WORD BASE .WORD AT .WORD DIGIT .WORD ZBRAN L1979 .WORD L2001-L1979 ; $2C ; L2001-L1979 .WORD SWAP .WORD BASE .WORD AT .WORD USTAR .WORD DROP .WORD ROT .WORD BASE .WORD AT .WORD USTAR .WORD DPLUS .WORD DPL .WORD AT .WORD ONEP .WORD ZBRAN L1994 .WORD L1998-L1994 ; 8 ; L1998-L1994 .WORD ONE .WORD DPL .WORD PSTOR L1998 .WORD RFROM .WORD BRAN L2000 .WORD L1971-L2000 ; $FFC6 ; L1971-L2000 L2001 .WORD RFROM .WORD SEMIS ; ; NUMBER ; SCREEN 48 LINE 6 ; L2007 .BYTE $86,"NUMBE",$D2 .WORD L1968 ; link to (NUMBER) NUMBER .WORD DOCOL .WORD ZERO .WORD ZERO .WORD ROT .WORD DUP .WORD ONEP .WORD CAT .WORD CLIT .BYTE $2D .WORD EQUAL .WORD DUP .WORD TOR .WORD PLUS .WORD LIT,$FFFF L2023 .WORD DPL .WORD STORE .WORD PNUMB .WORD DUP .WORD CAT .WORD BL .WORD SUB .WORD ZBRAN L2031 .WORD L2042-L2031 ; $15 ; L2042-L2031 .WORD DUP .WORD CAT .WORD CLIT .BYTE $2E .WORD SUB .WORD ZERO .WORD QERR .WORD ZERO .WORD BRAN L2041 .WORD L2023-L2041 ; $FFDD ; L2023-L2041 L2042 .WORD DROP .WORD RFROM .WORD ZBRAN L2045 .WORD L2047-L2045 ; 4 ; L2047-L2045 .WORD DMINU L2047 .WORD SEMIS ; ; -FIND ; SCREEN 48 LINE 12 ; ;PARAM : -FIND --- pfa b tf (found) --- ff (not found) L2052 .BYTE $85,"-FIN",$C4 .WORD L2007 ; link to NUMBER DFIND: .WORD DOCOL .WORD BL .WORD WORD ; Get next text terminated by "BL" (space) and store it at HERE. .WORD HERE ; ) .WORD COUNT ; |- Optional allowing free use of low .WORD UPPER ; ) case from terminal .WORD HERE .WORD CON, AT, AT ; Get address for CONTEXT .WORD PFIND .WORD DUP .WORD ZEQU .WORD ZBRAN L2068 .WORD L2073-L2068 ; $A ; L2073-L2068 .WORD DROP, HERE, LATES, PFIND L2073 .WORD SEMIS ; ; (ABORT) ; SCREEN 49 LINE 2 ; L2078 .BYTE $87,"(ABORT",$A9 .WORD L2052 ; link to -FIND PABOR .WORD DOCOL .WORD ABORT .WORD SEMIS ; ; ERROR ; SCREEN 49 LINE 4 ; L2087 .BYTE $85,"ERRO",$D2 .WORD L2078 ; link to (ABORT) ERROR .WORD DOCOL .WORD WARN .WORD AT .WORD ZLESS .WORD ZBRAN L2094 .WORD L2096-L2094 ; $4 ; L2096-L2094 .WORD PABOR L2096 .WORD HERE .WORD COUNT .WORD TYPE .WORD PDOTQ .BYTE 4," ? " .WORD MESS .WORD SPSTO .WORD DROP,DROP; make room for 2 error values .WORD IN .WORD AT .WORD BLK .WORD AT .WORD QUIT .WORD SEMIS ; ; ID. ; SCREEN 49 LINE 9 ; L2113 .BYTE $83,"ID",$AE .WORD L2087 ; link to ERROR IDDOT .WORD DOCOL .WORD PAD .WORD CLIT .BYTE $20 .WORD CLIT .BYTE $5F .WORD FILL .WORD DUP .WORD PFA .WORD LFA .WORD OVER .WORD SUB .WORD PAD .WORD SWAP .WORD CMOVE .WORD PAD .WORD COUNT .WORD CLIT .BYTE $1F ;@ $1F .WORD ANDD .WORD TYPE .WORD SPACE .WORD SEMIS ; ; CREATE ; SCREEN 50 LINE 2 ; L2142 .BYTE $86,"CREAT",$C5 .WORD L2113 ; link to ID CREAT .WORD DOCOL .WORD TIB ;) .WORD HERE ;| .WORD CLIT ;| 6502 only, assures .BYTE $A0 ;| room exists in dict. .WORD PLUS ;| .WORD ULESS ;| .WORD TWO ;| Code erreur n2 pour QERR .WORD QERR ;) .WORD DFIND .WORD ZBRAN L2155 .WORD $0F ; A CALCULER .WORD DROP .WORD NFA .WORD IDDOT .WORD CLIT .BYTE 4 .WORD MESS .WORD SPACE L2163 .WORD HERE .WORD DUP .WORD CAT .WORD WIDTH .WORD AT .WORD MIN .WORD ONEP .WORD ALLOT .WORD DP ;) .WORD CAT ;| 6502 only. The code field .WORD CLIT ;| must not straddle page .BYTE $FD ;| boundaries .WORD EQUAL ;| .WORD ALLOT ;) .WORD DUP .WORD CLIT .BYTE $A0 .WORD TOGGL .WORD HERE .WORD ONE .WORD SUB .WORD CLIT .BYTE $80 .WORD TOGGL .WORD LATES .WORD COMMA .WORD CURR .WORD AT .WORD STORE .WORD HERE .WORD TWOP .WORD COMMA .WORD SEMIS ; ; [COMPILE] ; SCREEN 51 LINE 2 ; L2200 .BYTE $C9,"[COMPILE",$DD .WORD L2142 ; link to CREATE .WORD DOCOL .WORD DFIND .WORD ZEQU .WORD ZERO .WORD QERR .WORD DROP .WORD CFA .WORD COMMA .WORD SEMIS ; ; LITERAL ; SCREEN 51 LINE 2 ; L2216 .BYTE $C7,"LITERA",$CC .WORD L2200 ; link to [COMPILE] LITER .WORD DOCOL .WORD STATE .WORD AT .WORD ZBRAN L2222 .WORD L2226-L2222 ; 8 ; L2226-L2222 .WORD COMP .WORD LIT .WORD COMMA L2226 .WORD SEMIS ; ; DLITERAL ; SCREEN 51 LINE 8 ; L2232 .BYTE $C8,"DLITERA",$CC .WORD L2216 ; link to LITERAL DLIT .WORD DOCOL .WORD STATE .WORD AT .WORD ZBRAN L2238 .WORD L2242-L2238 ; 8 ; L2242-L2238 .WORD SWAP .WORD LITER .WORD LITER L2242 .WORD SEMIS .ORG *+1 ;@ A ETE AJOUTE CAR DEMARRE A UNE ADRESSE EN $xxFF ; ; ?STACK ; SCREEN 51 LINE 13 ; L2248 .BYTE $86,"?STAC",$CB .WORD L2232 ; link to DLITERAL QSTAC .WORD DOCOL .WORD CLIT .BYTE TOS .WORD SPAT .WORD ULESS .WORD ONE .WORD QERR .WORD SPAT .WORD CLIT .BYTE BOS .WORD ULESS .WORD CLIT .BYTE 7 .WORD QERR .WORD SEMIS ; ; INTERPRET ; SCREEN 52 LINE 2 ; L2269 .BYTE $89,"INTERPRE",$D4 .WORD L2248 ; link to ?STACK INTER: .WORD DOCOL L2272 .WORD DFIND .WORD ZBRAN L2274 .WORD L2289-L2274 ; $1E ; L2289-L2274 .WORD STATE .WORD AT .WORD LESS .WORD ZBRAN L2279 .WORD L2284-L2279 ; $A ; L2284-L2279 .WORD CFA .WORD COMMA .WORD BRAN L2283 .WORD L2286-L2283 ; $6 ; L2286-L2283 L2284 .WORD CFA .WORD EXEC L2286 .WORD QSTAC .WORD BRAN L2288 .WORD L2302-L2288 ; $1C ; L2302-L2288 L2289 .WORD HERE .WORD NUMBER .WORD DPL .WORD AT .WORD ONEP .WORD ZBRAN L2295 .WORD L2299-L2295 ; 8 ; L2299-L2295 .WORD DLIT .WORD BRAN L2298 .WORD L2301-L2298 ; $6 ; L2301-L2298 L2299 .WORD DROP .WORD LITER L2301 .WORD QSTAC L2302 .WORD BRAN L2303 .WORD L2272-L2303 ; $FFC2 ; L2272-L2303 ; ; IMMEDIATE ; SCREEN 53 LINE 1 ; L2309 .BYTE $89,"IMMEDIAT",$C5 .WORD L2269; ; link to INTERPRET .WORD DOCOL .WORD LATES .WORD CLIT .BYTE $40 .WORD TOGGL .WORD SEMIS ; ; VOCABULARY ; SCREEN 53 LINE 4 ; L2321 .BYTE $8A,"VOCABULAR",$D9 .WORD L2309 ; link to IMMEDIATE .WORD DOCOL .WORD BUILD .WORD LIT,$A081 .WORD COMMA .WORD CURR .WORD AT .WORD CFA .WORD COMMA .WORD HERE .WORD VOCL .WORD AT .WORD COMMA .WORD VOCL .WORD STORE .WORD DOES DOVOC: .WORD TWOP .WORD CON .WORD STORE .WORD SEMIS ; ; FORTH ; SCREEN 53 LINE 9 ; L2346 .BYTE $C5,"FORT",$C8 .WORD L2321 ; link to VOCABULARY FORTH: .WORD DODOE .WORD DOVOC .WORD $A081 XFOR .WORD FORTH_RAM ;NTOP ; points to top name in FORTH VL0 .WORD $0000 ; last vocab link ends at zero ; ; DEFINITIONS ; SCREEN 53 LINE 11 ; ; L2357 .BYTE $8B,"DEFINITION",$D3 .WORD L2321 ; L2346 ; FORTH_RAM ;L2346 ; link to FORTH-RAM DEFIN .WORD DOCOL .WORD CON .WORD AT .WORD CURR .WORD STORE .WORD SEMIS ; ; ( ; SCREEN 53 LINE 14 ; L2369 .BYTE $C1,$A8 .WORD L2357 ; link to DEFINITIONS .WORD DOCOL .WORD CLIT .BYTE $29 .WORD WORD .WORD SEMIS ; ; QUIT ; SCREEN 54 LINE 2 ; L2381 .BYTE $84,"QUI",$D4 .WORD L2369 ; link to ( QUIT: .WORD DOCOL .WORD ZERO .WORD BLK .WORD STORE .WORD LBRAC L2388 .WORD RPSTO .WORD CR .WORD QUERY .WORD INTER .WORD STATE .WORD AT .WORD ZEQU .WORD ZBRAN L2396 .WORD L2399-L2396 ; 7 ; L2399-L2396 .WORD PDOTQ .BYTE 2,"OK" L2399 .WORD BRAN L2400 .WORD L2388-L2400 ; $FFE7 ; L2388-L2400 .WORD SEMIS ; ; ABORT ; SCREEN 54 LINE 7 ;; L2406 .BYTE $85,"ABOR",$D4 .WORD L2381 ; link to QUIT ABORT: .WORD DOCOL .WORD LIT,DAREA ; YYY Ajout de l'init de la variable utilisateur USE .WORD USE .WORD STORE .WORD LIT,DAREA ; YYY Ajout de l'init de la variable utilisateur PREV .WORD PREV .WORD STORE .WORD SPSTO .WORD DECIM .WORD DR0 .WORD CR .WORD PDOTQ .BYTE 36,"fig-FORTH 1.2 (1.02c) for ORIC ATMOS" .WORD CR .WORD PDOTQ .BYTE 30,"Modified by SEILEBOST (C) 2011" .WORD FORTH_RAM+$8 .WORD DEFIN .WORD QUIT ; ; COLD ; SCREEN 55 LINE 1 ; L2423 .BYTE $84,"COL",$C4 .WORD L2406 ; link to ABORT COLD: .WORD *+2 LDA #$00 STA v2CurRow STA v2CurCol STA v2IChar STA v2FlgScroll JSR CLRSCR ; Efface l'écran LDX #$00 LDY #$01 JSR GOTOXY ; Positionne le curseur INITFORTH: ; DEPLACE EN RAM le mot FORTH LDY #$11 LBCL: LDA L2346,Y STA FORTH_RAM,Y DEY BPL LBCL ; Point de depart du code d'origine LDA ORIG+$0C ; from cold start area STA FORTH_RAM+6 ; On recupere l'adresse de NTOP LDA ORIG+$0D STA FORTH_RAM+7 CPY_UAREA: ; Recopie de la zone USER LDY #$15 ; 16 octets BNE L2433 WARM: LDY #$0F L2433 LDA ORIG+$10 ; Recuperation de l'adresse UAREA STA UP LDA ORIG+$11 STA UP+1 L2437 LDA ORIG+$0C,Y ; Initialisation de la zone UAREA par les STA (UP),Y ; donnees situees en $ORIG+$0C a $ORIG+$0C+15 DEY BPL L2437 GO: ; Demarrage par ... ABORT !! LDA #>ABORT ; actually #>(ABORT+2) STA IP+1 LDA #D ; SCREEN 56 LINE 1 ; L2453 .BYTE $84,"S->",$C4 .WORD L2423 ; link to COLD STOD .WORD DOCOL .WORD DUP .WORD ZLESS .WORD MINUS .WORD SEMIS ; ; +- ; SCREEN 56 LINE 4 ; L2464 .BYTE $82,"+",$AD .WORD L2453 ; link to S->D PM .WORD DOCOL .WORD ZLESS .WORD ZBRAN L2469 .WORD 4 ; A calculer .WORD MINUS L2471 .WORD SEMIS ; ; D+- ; SCREEN 56 LINE 6 ; L2476 .BYTE $83,"D+",$AD .WORD L2464 ; link to +- DPM .WORD DOCOL .WORD ZLESS .WORD ZBRAN L2481 .WORD L2483-L2481 ; 4 ; L2483-L2481 .WORD DMINU L2483 .WORD SEMIS ; ; ABS ; SCREEN 56 LINE 9 ; L2488 .BYTE $83,"AB",$D3 .WORD L2476 ; link to D+- ABS .WORD DOCOL .WORD DUP .WORD PM .WORD SEMIS ; ; DABS ; SCREEN 56 LINE 10 ; L2498 .BYTE $84,"DAB",$D3 .WORD L2488 ; link to ABS DABS .WORD DOCOL .WORD DUP .WORD DPM .WORD SEMIS ; ; MIN ; SCREEN 56 LINE 12 ; L2508 .BYTE $83,"MI",$CE .WORD L2498 ; link to DABS MIN .WORD DOCOL .WORD OVER .WORD OVER .WORD GREAT .WORD ZBRAN L2515 .WORD L2517-L2515 ; 4 ; L2517-L2515 .WORD SWAP L2517 .WORD DROP .WORD SEMIS ; ; MAX ; SCREEN 56 LINE 14 ; L2523 .BYTE $83,"MA",$D8 .WORD L2508 ; link to MIN MAX .WORD DOCOL .WORD OVER .WORD OVER .WORD LESS .WORD ZBRAN L2530 .WORD L2532-L2530 ; 4 ; L2532-L2530 .WORD SWAP L2532 .WORD DROP .WORD SEMIS ; ; M* ; SCREEN 57 LINE 1 ; L2538 .BYTE $82,"M",$AA .WORD L2523 ; link to MAX MSTAR .WORD DOCOL .WORD OVER .WORD OVER .WORD XOR .WORD TOR .WORD ABS .WORD SWAP .WORD ABS .WORD USTAR .WORD RFROM .WORD DPM .WORD SEMIS ; ; M/ ; SCREEN 57 LINE 3 ; L2556 .BYTE $82,"M",$AF .WORD L2538 ; link to M* MSLAS .WORD DOCOL .WORD OVER .WORD TOR .WORD TOR .WORD DABS .WORD R .WORD ABS .WORD USLAS .WORD RFROM .WORD R .WORD XOR .WORD PM .WORD SWAP .WORD RFROM .WORD PM .WORD SWAP .WORD SEMIS ; ; * ; SCREEN 57 LINE 7 ; L2579 .BYTE $81,$AA .WORD L2556 ; link to M/ STAR .WORD DOCOL .WORD USTAR .WORD DROP .WORD SEMIS ; ; /MOD ; SCREEN 57 LINE 8 ; L2589 .BYTE $84,"/MO",$C4 .WORD L2579 ; link to * SLMOD .WORD DOCOL .WORD TOR .WORD STOD .WORD RFROM .WORD MSLAS .WORD SEMIS ; ; / ; SCREEN 57 LINE 9 ; L2601 .BYTE $81,$AF .WORD L2589 ; link to /MOD SLASH .WORD DOCOL .WORD SLMOD .WORD SWAP .WORD DROP .WORD SEMIS ; ; MOD ; SCREEN 57 LINE 10 ; L2612 .BYTE $83,"MO",$C4 .WORD L2601 ; link to / MOD .WORD DOCOL .WORD SLMOD .WORD DROP .WORD SEMIS ; ; */MOD ; SCREEN 57 LINE 11 ; L2622 .BYTE $85,"*/MO",$C4 .WORD L2612 ; link to MOD SSMOD .WORD DOCOL .WORD TOR .WORD MSTAR .WORD RFROM .WORD MSLAS .WORD SEMIS ; ; */ ; SCREEN 57 LINE 13 ; L2634 .BYTE $82,"*",$AF .WORD L2622 ; link to */MOD SSLAS .WORD DOCOL .WORD SSMOD .WORD SWAP .WORD DROP .WORD SEMIS ; ; M/MOD ; SCREEN 57 LINE 14 ; L2645 .BYTE $85,"M/MO",$C4 .WORD L2634 ; link to */ MSMOD .WORD DOCOL .WORD TOR .WORD ZERO .WORD R .WORD USLAS .WORD RFROM .WORD SWAP .WORD TOR .WORD USLAS .WORD RFROM .WORD SEMIS ;; YYY Passage dans la DAREA ;;; ;;; USE ;;; SCREEN 58 LINE 1 ;;; ;;L2662 .BYTE $83,"US",$C5 ;; .WORD L2645 ; link to M/MOD ;;USE: ;; .WORD DOVAR ;; .WORD DAREA ;;; ;; YYY Passage dans la DAREA ;;; PREV ;;; SCREEN 58 LINE 2 ;;; ;;L2670 .BYTE $84,"PRE",$D6 ;; .WORD L2662 ; link to USE ;;PREV .WORD DOVAR ;; .WORD DAREA ; ; +BUF ; SCREEN 58 LINE 4 ; ; ;addr1 --- addr2 f ;Advance the disc buffer address addr1 to the address of ;the next buffer addr2. Boolean f is false when addr2 is ;the buffer presently pointed to by variable PREV. L2678 .BYTE $84,"+BU",$C6 .WORD L2645 ; linl to M/MOD ; L2670 ; link to PREV PBUF .WORD DOCOL .WORD LIT .WORD SSIZE+4 ; hold block #, one sector two num .WORD PLUS .WORD DUP .WORD LIMIT .WORD EQUAL .WORD ZBRAN L2688 .WORD L2691-L2688 ; 6 ; L2691-L2688 .WORD DROP .WORD FIRST L2691 .WORD DUP .WORD PREV .WORD AT .WORD SUB .WORD SEMIS ; ; UPDATE ; SCREEN 58 LINE 8 ; L2700 .BYTE $86,"UPDAT",$C5 .WORD L2678 ; link to +BUF UPDAT .WORD DOCOL .WORD PREV .WORD AT .WORD AT .WORD LIT,$8000 .WORD OR .WORD PREV .WORD AT .WORD STORE .WORD SEMIS ; ; FLUSH ; L2705 .BYTE $85,"FLUS",$C8 .WORD L2700 ; link to UPDATE .WORD DOCOL .WORD LIMIT,FIRST,SUB .WORD BBUF,CLIT .BYTE 4 .WORD PLUS,SLASH,ONEP .WORD ZERO,PDO L2835 .WORD LIT,$7FFF,BUFFR .WORD DROP,PLOOP L2839 .WORD $FFF6 ; L2835-L2839 .WORD SEMIS ; ; EMPTY-BUFFERS ; SCREEN 58 LINE 11 ; L2716 .BYTE $8D,"EMPTY-BUFFER",$D3 .WORD L2705 ; link to FLUSH .WORD DOCOL .WORD FIRST .WORD LIMIT .WORD OVER .WORD SUB .WORD ERASE .WORD SEMIS ; ; DR0 ; SCREEN 58 LINE 14 ; L2729 .BYTE $83,"DR",$B0 .WORD L2716 ; link to EMPTY-BUFFERS DR0: .WORD DOCOL .WORD ZERO .WORD OFSET .WORD STORE .WORD SEMIS ; ; DR1 ; SCREEN 58 LINE 15 ; L2740 .BYTE $83,"DR",$B1 .WORD L2729 ; link to DR0 .WORD DOCOL .WORD LIT,SECTR ; sectors per drive .WORD OFSET .WORD STORE .WORD SEMIS ; ; BUFFER ; SCREEN 59 LINE 1 ; ; n --- addr ; Obtain the next memory buffer, assigning it to block n. ; If the contents of the buffer is marked as updated, it is ; written to the disc. The block is not read from the disc. ; The address left is the first cell within the buffer for ; data storage. L2751 .BYTE $86,"BUFFE",$D2 .WORD L2740 ; link to DR1 BUFFR .WORD DOCOL .WORD USE .WORD AT .WORD DUP .WORD TOR L2758 .WORD PBUF ; +BUF .WORD ZBRAN L2760 .WORD L2758-L2760 .WORD USE .WORD STORE .WORD R .WORD AT .WORD ZLESS .WORD ZBRAN L2767 .WORD L2776-L2767 .WORD R .WORD TWOP .WORD R .WORD AT .WORD LIT,$7FFF ; ITS BLOCK # .WORD ANDD .WORD ZERO ; WRITE SECTOR TO DISC .WORD RSLW L2776 .WORD R .WORD STORE ; WRITE NEW BLOCK # INTO THIS BUFFER .WORD R .WORD PREV .WORD STORE ; ASSIGN THIS BUFFER AS 'PREV' .WORD RFROM .WORD TWOP .WORD SEMIS ; MOVE TO STORAGE LOCATION ; ; BLOCK ; SCREEN 60 LINE 1 ; ; n --- addr L0 ; Leave the memory address of the block buffer containing ; block n. If the block is not already in memory, it is ; transferred from disc to which ever buffer was least ; recently written. If the block occupying that buffer has ; been marked as being updated, it is re-written to disc ; before block n is read into the buffer. See also BUFFER, R/W UPDATE FLUSH L2788 .BYTE $85,"BLOC",$CB .WORD L2751 ; link to BUFFER BLOCK: .WORD DOCOL .WORD OFSET,AT,PLUS,TOR ; Retain block # on return stack .WORD PREV,AT,DUP,AT,R,SUB,DUP,PLUS ; (BLOCK = PREV ? ) .WORD ZBRAN L2804 .WORD $34 ; L2830-L2804 L2805 .WORD PBUF ;+BUF(addr1 --- addr2 f) .WORD ZEQU .WORD ZBRAN L2808 .WORD $14 ;L2818-L2808 .WORD DROP .WORD R .WORD BUFFR ; BUFFER .WORD DUP .WORD R .WORD ONE ; 1=READ .WORD RSLW ; READ/WRITE A SECTOR .WORD TWO .WORD SUB ; Backup L2818 .WORD DUP .WORD AT .WORD R .WORD SUB .WORD DUP .WORD PLUS .WORD ZEQU .WORD ZBRAN L2826 .WORD $FFD6 ; L2805-L2826 .WORD DUP .WORD PREV .WORD STORE L2830 .WORD RFROM .WORD DROP .WORD TWOP .WORD SEMIS ; end of BLOCK ; ; ; (LINE) ; SCREEN 61 LINE 2 ; ; n1 n2 --- addr count ; Convert the line number n1 and the screen n2 to the disc ; buffer address containing the data. A count of 64 ; indicates the full line text length. L2838 .BYTE $86,"(LINE",$A9 .WORD L2788 ; link to BLOCK PLINE .WORD DOCOL .WORD TOR ;>R .WORD CSLL ;C/L .WORD BBUF ;B/BUF .WORD SSMOD ;*/MOD .WORD RFROM ;R> .WORD BSCR ;B/SCR .WORD STAR ;* .WORD PLUS ;+ .WORD BLOCK ; Récupération data : n --- addr .WORD SCR ; XXX .WORD PLUS ;+ .WORD CSLL ;C/L .WORD SEMIS ; ; .LINE ; SCREEN 61 LINE 6 ; ; line scr --- ; Print on the terminal device, a line of text from the disc ; by its line and screen number. Trailing blanks are ; suppressed. L2857 .BYTE $85,".LIN",$C5 .WORD L2838 ; link to (LINE) DLINE .WORD DOCOL .WORD PLINE ; n1 n2 --- addr count .WORD DTRAI ; addr n1 --- addr n2 .WORD TYPE ; addr count --- .WORD SEMIS ; ; MESSAGE ; SCREEN 61 LINE 9 ; L2868 .BYTE $87,"MESSAG",$C5 .WORD L2857 ; link to .LINE MESS .WORD DOCOL .WORD WARN .WORD AT .WORD ZBRAN L2874 .WORD L2888-L2874 ; $1B ; L2888-L2874 .WORD DDUP .WORD ZBRAN L2877 .WORD L2886-L2877 ; $11 ; L2886-L2877 .WORD CLIT .BYTE 4 .WORD OFSET .WORD AT .WORD BSCR .WORD SLASH .WORD SUB .WORD DLINE L2886 .WORD BRAN L2887 .WORD L2891-L2887 ; 13 ; L2891-L2887 L2888 ;.WORD PDOTQ ;.BYTE 6,"MSG # " ;.WORD DUP ;.WORD DOT ;.WORD PDOTQ ;.BYTE 1,":" .WORD CLIT .BYTE $19 .WORD MIN .WORD ZERO .WORD MAX .WORD TWO .WORD STAR .WORD LIT,L8FD2 .WORD PLUS .WORD AT .WORD COUNT .WORD TYPE L2891 .WORD SEMIS ; ; LOAD ; SCREEN 62 LINE 2 ; L2896 .BYTE $84,"LOA",$C4 .WORD L2868 ; link to MESSAGE LOAD .WORD DOCOL .WORD BLK .WORD AT .WORD TOR .WORD IN .WORD AT .WORD TOR .WORD ZERO .WORD IN .WORD STORE .WORD BSCR .WORD STAR .WORD BLK .WORD STORE .WORD INTER .WORD RFROM .WORD IN .WORD STORE .WORD RFROM .WORD BLK .WORD STORE .WORD SEMIS ; ; --> ; SCREEN 62 LINE 6 ; L2924 .BYTE $C3,"--",$BE .WORD L2896 ; link to LOAD .WORD DOCOL .WORD QLOAD .WORD ZERO .WORD IN .WORD STORE .WORD BSCR .WORD BLK .WORD AT .WORD OVER .WORD MOD .WORD SUB .WORD BLK .WORD PSTOR .WORD SEMIS ; ; XEMIT writes one ascii character to terminal ; ; XEMIT TYA SEC LDY #$1A ; offset de la variable utilisateur OUT ADC (UP),Y STA (UP),Y INY ; bump user variable OUT LDA #0 ADC (UP),Y STA (UP),Y LDA 0,X ; fetch character to output STX XSAVE JSR WRITECAR ; and display it LDX XSAVE JMP POP ; ; XKEY reads one terminal keystroke to stack ; ; XKEY: STX XSAVE JSR ONEKEY ; might otherwise clobber it while LDX XSAVE ; inputting a char to accumulator JMP PUSHOA ; ; XQTER leaves a boolean representing terminal break ; ; XQTER LDA #$00 JMP PUSHOA ; ; XCR displays a CR and LF to terminal ; ; XCR: STX XSAVE JSR CRLF LDX XSAVE JMP NEXT ; ; -BCD ; Convert binary value to BCD ; L3050 .BYTE $84,"-BC",$C4 .WORD L2924 ; link to --> DBCD .WORD DOCOL .WORD ZERO,CLIT .BYTE 10 .WORD USLAS,CLIT .BYTE 16 .WORD STAR,OR,SEMIS ; ; R/W ; Read or write one sector ; ; addr blk f --- ; The fig-FORTH standard disc read-write linkage. addr ; specifies the source or destination block buffer, blk is ; the sequential number of the referenced block; and f is a ; flag for f=0 write and f=1 for read. R/W determines the ; location on mass storage, performs the read-write and ; performs any error checking. L3060 .BYTE $83,"R/",$D7 .WORD L3050 ; link to -BCD RSLW .WORD DOCOL .WORD TOR ; Save boolean .WORD BBUF,STAR,LIT,LO,PLUS,DUP .WORD LIT,HI .WORD GREAT .WORD CLIT .BYTE $06 .WORD QERR ; Range Check .WORD RFROM .WORD ZBRAN ; Test read L3061 .WORD L3063-L3061 .WORD SWAP L3063 .WORD BBUF .WORD CMOVE .WORD SEMIS ; ; ' (tick) ; SCREEN 72 LINE 2 ; L3202 .BYTE $C1,$A7 .WORD L3060 ; link to R/W TICK .WORD DOCOL .WORD DFIND .WORD ZEQU .WORD ZERO .WORD QERR .WORD DROP .WORD LITER .WORD SEMIS ; ; FORGET ; Altered from model ; SCREEN 72 LINE 6 ; L3217 .BYTE $86,"FORGE",$D4 .WORD L3202 ; link to ' TICK FORG .WORD DOCOL .WORD TICK,NFA,DUP .WORD FENCE,AT,ULESS .WORD CLIT .BYTE $15 ; Code erreur = 15 .WORD QERR .WORD TOR,VOCL,AT L3220 .WORD R,OVER,ULESS .WORD ZBRAN,L3225-* .WORD FORTH_RAM+$8,DEFIN,AT,DUP .WORD VOCL,STORE .WORD BRAN,L3220-* ; $FFFF-24+1 ; L3220-* L3225 .WORD DUP,CLIT .BYTE 4 .WORD SUB L3228 .WORD PFA,LFA,AT .WORD DUP,R,ULESS .WORD ZBRAN,L3228-* ; $FFFF-14+1 ; L3228-* .WORD OVER,TWO,SUB,STORE .WORD AT,DDUP,ZEQU .WORD ZBRAN,L3225-* ; $FFFF-39+1 ; L3225-* .WORD RFROM,DP,STORE .WORD SEMIS ; ; BACK ; SCREEN 73 LINE 1 ; L3250 .BYTE $84,"BAC",$CB .WORD L3217 ; link to FORGET BACK .WORD DOCOL .WORD HERE .WORD SUB .WORD COMMA .WORD SEMIS ; ; BEGIN ; SCREEN 73 LINE 3 ; L3261 .BYTE $C5,"BEGI",$CE .WORD L3250 ; link to BACK .WORD DOCOL .WORD QCOMP .WORD HERE .WORD ONE .WORD SEMIS ; ; ENDIF ; SCREEN 73 LINE 5 ; L3273 .BYTE $C5,"ENDI",$C6 .WORD L3261 ; link to BEGIN ENDIF .WORD DOCOL .WORD QCOMP .WORD TWO .WORD QPAIR .WORD HERE .WORD OVER .WORD SUB .WORD SWAP .WORD STORE .WORD SEMIS ; ; THEN ; SCREEN 73 LINE 7 ; L3290 .BYTE $C4,"THE",$CE .WORD L3273 ; link to ENDIF .WORD DOCOL .WORD ENDIF .WORD SEMIS ; ; DO ; SCREEN 73 LINE 9 ; L3300 .BYTE $C2,"D",$CF .WORD L3290 ; link to THEN .WORD DOCOL .WORD COMP .WORD PDO .WORD HERE .WORD THREE .WORD SEMIS ; ; LOOP ; SCREEN 73 LINE 11 ; ; L3313 .BYTE $C4,"LOO",$D0 .WORD L3300 ; link to DO .WORD DOCOL .WORD THREE .WORD QPAIR .WORD COMP .WORD PLOOP .WORD BACK .WORD SEMIS ; ; +LOOP ; SCREEN 73 LINE 13 ; L3327 .BYTE $C5,"+LOO",$D0 .WORD L3313 ; link to LOOP .WORD DOCOL .WORD THREE .WORD QPAIR .WORD COMP .WORD PPLOO .WORD BACK .WORD SEMIS ; ; UNTIL ; SCREEN 73 LINE 15 ; L3341 .BYTE $C5,"UNTI",$CC .WORD L3327 ; link to +LOOP UNTIL .WORD DOCOL .WORD ONE .WORD QPAIR .WORD COMP .WORD ZBRAN .WORD BACK .WORD SEMIS ; ; END ; SCREEN 74 LINE 1 ; L3355 .BYTE $C3,"EN",$C4 .WORD L3341 ; link to UNTIL .WORD DOCOL .WORD UNTIL .WORD SEMIS ; ; AGAIN ; SCREEN 74 LINE 3 ; L3365 .BYTE $C5,"AGAI",$CE .WORD L3355 ; link to END AGAIN .WORD DOCOL .WORD ONE .WORD QPAIR .WORD COMP .WORD BRAN .WORD BACK .WORD SEMIS ; ; REPEAT ; SCREEN 74 LINE 5 ; L3379 .BYTE $C6,"REPEA",$D4 .WORD L3365 ; link to AGAIN .WORD DOCOL .WORD TOR .WORD TOR .WORD AGAIN .WORD RFROM .WORD RFROM .WORD TWO .WORD SUB .WORD ENDIF .WORD SEMIS ; ; IF ; SCREEN 74 LINE 8 ; L3396 .BYTE $C2,"I",$C6 .WORD L3379 ; link to REPEAT IF .WORD DOCOL .WORD COMP .WORD ZBRAN .WORD HERE .WORD ZERO .WORD COMMA .WORD TWO .WORD SEMIS ; ; ELSE ; SCREEN 74 LINE 10 ; L3411 .BYTE $C4,"ELS",$C5 .WORD L3396 ; link to IF .WORD DOCOL .WORD TWO .WORD QPAIR .WORD COMP .WORD BRAN .WORD HERE .WORD ZERO .WORD COMMA .WORD SWAP .WORD TWO .WORD ENDIF .WORD TWO .WORD SEMIS ; ; WHILE ; SCREEN 74 LINE 13 ; L3431 .BYTE $C5,"WHIL",$C5 .WORD L3411 ; link to ELSE .WORD DOCOL .WORD IF .WORD TWOP .WORD SEMIS ; ; SPACES ; SCREEN 75 LINE 1 ; L3442 .BYTE $86,"SPACE",$D3 .WORD L3431 ; link to WHILE SPACS .WORD DOCOL .WORD ZERO .WORD MAX .WORD DDUP .WORD ZBRAN L3449 .WORD L3455-L3449 ; $0C ; L3455-L3449 .WORD ZERO .WORD PDO L3452 .WORD SPACE .WORD PLOOP L3454 .WORD L3452-L3454 ; $FFFC ; L3452-L3454 L3455 .WORD SEMIS ; ; <# ; SCREEN 75 LINE 3 ; L3460 .BYTE $82,"<",$A3 .WORD L3442 ; link to SPACES BDIGS .WORD DOCOL .WORD PAD .WORD HLD .WORD STORE .WORD SEMIS ; ; #> ; SCREEN 75 LINE 5 ; L3471 .BYTE $82,"#",$BE .WORD L3460 ; link to <# EDIGS .WORD DOCOL .WORD DROP .WORD DROP .WORD HLD .WORD AT .WORD PAD .WORD OVER .WORD SUB .WORD SEMIS ; ; SIGN ; SCREEN 75 LINE 7 ; L3486 .BYTE $84,"SIG",$CE .WORD L3471 ; link to #> SIGN .WORD DOCOL .WORD ROT .WORD ZLESS .WORD ZBRAN L3492 .WORD L3496-L3492 ; $7 ; L3496-L3492 .WORD CLIT .BYTE $2D .WORD HOLD L3496 .WORD SEMIS ; ; # ; SCREEN 75 LINE 9 ; L3501 .BYTE $81,$A3 .WORD L3486 ; link to SIGN DIG .WORD DOCOL .WORD BASE .WORD AT .WORD MSMOD .WORD ROT .WORD CLIT .BYTE 9 .WORD OVER .WORD LESS .WORD ZBRAN L3513 .WORD L3517-L3513 ; 7 ; L3517-L3513 .WORD CLIT .BYTE 7 .WORD PLUS L3517 .WORD CLIT .BYTE $30 .WORD PLUS .WORD HOLD .WORD SEMIS ; ; #S ; SCREEN 75 LINE 12 ; L3526 .BYTE $82,"#",$D3 .WORD L3501 ; link to # DIGS .WORD DOCOL L3529 .WORD DIG .WORD OVER .WORD OVER .WORD OR .WORD ZEQU .WORD ZBRAN L3535 .WORD L3529-L3535 ; $FFF4 ; L3529-L3535 .WORD SEMIS ; ; D.R ; SCREEN 76 LINE 1 ; L3541 .BYTE $83,"D.",$D2 .WORD L3526 ; link to #S DDOTR .WORD DOCOL .WORD TOR .WORD SWAP .WORD OVER .WORD DABS .WORD BDIGS .WORD DIGS .WORD SIGN .WORD EDIGS .WORD RFROM .WORD OVER .WORD SUB .WORD SPACS .WORD TYPE .WORD SEMIS ; ; D. ; SCREEN 76 LINE 5 ; L3562 .BYTE $82,"D",$AE .WORD L3541 ; link to D.R DDOT .WORD DOCOL .WORD ZERO .WORD DDOTR .WORD SPACE .WORD SEMIS ; ; .R ; SCREEN 76 LINE 7 ; L3573 .BYTE $82,".",$D2 .WORD L3562 ; link to D. DOTR .WORD DOCOL .WORD TOR .WORD STOD .WORD RFROM .WORD DDOTR .WORD SEMIS .ORG *+1 ;@ A ETE AJOUTE CAR DEMARRE A UNE ADRESSE EN $xxFF (BUG 6502) ; ; . ; SCREEN 76 LINE 9 ; L3585 .BYTE $81,$AE .WORD L3573 ; link to .R DOT .WORD DOCOL .WORD STOD .WORD DDOT .WORD SEMIS ; ; ? ; SCREEN 76 LINE 11 ; L3595 .BYTE $81,$BF .WORD L3585 ; link to . QUES .WORD DOCOL .WORD AT .WORD DOT .WORD SEMIS ; ; LIST ; SCREEN 77 LINE 2 ; L3605 .BYTE $84,"LIS",$D4 .WORD L3595 ; link to ? LIST .WORD DOCOL .WORD DECIM .WORD CR .WORD DUP .WORD SCR .WORD STORE .WORD PDOTQ .BYTE 6,"SCR # " .WORD DOT .WORD CLIT .BYTE $10 .WORD ZERO .WORD PDO ; (DO) L3620 .WORD CR .WORD I ; I .WORD THREE ; 3 .WORD DOTR ;.R .WORD SPACE ; SPACE .WORD I .WORD SCR .WORD AT ; ARG (SCR) I .WORD DLINE .WORD PLOOP L3630 .WORD L3620-L3630;$FFEC ; A FAIRE .WORD CR .WORD SEMIS ; ; INDEX ; SCREEN 77 LINE 7 ; L3637 .BYTE $85,"INDE",$D8 .WORD L3605 ; link to LIST .WORD DOCOL .WORD CR .WORD ONEP .WORD SWAP .WORD PDO L3647 .WORD CR .WORD I .WORD THREE .WORD DOTR .WORD SPACE .WORD ZERO .WORD I .WORD DLINE .WORD QTERM .WORD ZBRAN L3657 .WORD L3659-L3657 ; 4 ; L3659-L3657 .WORD LEAVE L3659 .WORD PLOOP L3660 .WORD L3647-L3660 ; $FFE6 ; L3647-L3660 .WORD CLIT .BYTE $0C ; form feed for printer .WORD EMIT .WORD SEMIS ; ; TRIAD ; SCREEN 77 LINE 12 ; L3666 .BYTE $85,"TRIA",$C4 .WORD L3637 ; link to INDEX .WORD DOCOL .WORD THREE .WORD SLASH .WORD THREE .WORD STAR .WORD THREE .WORD OVER .WORD PLUS .WORD SWAP .WORD PDO L3681 .WORD CR .WORD I .WORD LIST .WORD PLOOP L3685 .WORD L3681-L3685 ; $FFF8 ; L3681-L3685 .WORD CR .WORD CLIT .BYTE $F .WORD MESS .WORD CR .WORD CLIT .BYTE $0C ; form feed for printer .WORD EMIT .WORD SEMIS ; ; VLIST ; SCREEN 78 LINE 2 ; ; L3696 .BYTE $85,"VLIS",$D4 .WORD L3666 ; link to TRIAD VLIST .WORD DOCOL .WORD CLIT .BYTE $80 .WORD OUT .WORD STORE .WORD CON ; UAREA CONTEXT .WORD AT .WORD AT L3706 .WORD OUT .WORD AT .WORD CSLL ; Character / line .WORD GREAT ; > .WORD ZBRAN L3711 .WORD L3716-L3711 ; $A ; L3716-L3711 .WORD CR .WORD ZERO .WORD OUT .WORD STORE L3716 .WORD DUP .WORD IDDOT .WORD SPACE .WORD SPACE .WORD PFA .WORD LFA .WORD AT .WORD DUP .WORD ZEQU .WORD QTERM .WORD OR .WORD ZBRAN L3728 .WORD L3706-L3728 ; $FFD4 ; L3706-L3728 .WORD DROP .WORD SEMIS ; ; MON ; SCREEN 79 LINE 3 ; NTOP .BYTE $83,"MO",$CE .WORD L3696 ; link to VLIST MON .WORD *+2 STX XSAVE ;BRK ; break to monitor which is assumed LDX XSAVE ; to save this as reentry point JMP NEXT ; ERROR MESSAGES L8FD2 .WORD L9006 .WORD L900B .WORD L9018 .WORD L9034 .WORD L9026 .WORD L9026 .WORD L9100 .WORD L9026 .WORD L9046 .WORD L9026 .WORD L9026 .WORD L9026 .WORD L9026 .WORD L9026 .WORD L9026 .WORD L9026 .WORD L9026 .WORD L9058 .WORD L906B .WORD L907E .WORD L9094 .WORD L90AA .WORD L90BE .WORD L9026 .WORD L90D4 .WORD L9026 L9006 .BYTE 4,"WHAT" L900B .BYTE 12,"STACK EMPTY!" L9018 .BYTE 13,"OUT OF MEMORY" L9026 .BYTE 13,"UNKNOWN ERROR" L9034 .BYTE 17,"HAS BAD ADDR MODE" L9046 .BYTE 17,"BLOCK RANGE ERROR" L9058 .BYTE 18,"FOR COMPILING ONLY" L906B .BYTE 18,"FOR EXECUTING ONLY" L907E .BYTE 21,"IMPROPER CONDITIONALS" L9094 .BYTE 21,"INCOMPLETE DEFINITION" L90AA .BYTE 22,"THIS WORD IS PROTECTED" L90BE .BYTE 21,"USE ONLY WHEN LOADING" L90D4 .BYTE 22,"SPECIFY THE VOCABULARY" L9100 .BYTE 21,"OUT OF RANGE FOR LIST" ;********************************************************** ; Monitor routines needed to trace. ;********************************************************** ; ; print a carriage return and line feed. ; CRLF: LDA #$0D JMP WRITECAR ; print accum as two hex digits HEX2 PHA LSR LSR LSR LSR JSR HEX2A PLA HEX2A AND #$0F JSR HXDGT JMP WRITECAR ; ;convert hex digit to ASCII ; HXDGT CMP #$0A BCC HXDGT1 CLC ADC #7 HXDGT1 ADC #'0' RTS ; ; print accum as one ASCII character ; LETTER AND #$7F CMP #$20 ;compare ASCII space BCS LETTER1 ;good if >= ' ' LDA #'.' LETTER1 JMP WRITECAR ; ; wait for keystroke ; ONEKEY: JSR READ_KEY BEQ ONEKEY RTS TOP .ORG $F000 WARMSTART: RTS ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;FCT: Retourne $00 si aucune touche actionnée sinon le code ascii ;IN : nothing ;OUT: A code ascii or $00 ; X is modified ; v2IChar is modified ; P not modified ;-------------------------------------------------------------- READ_KEY: LDA v2IChar BPL F_READ_KEY PHP AND #$7F LDX #$00 STX v2IChar PLP F_READ_KEY: RTS ;-------------------------------------------------------------- ;FCT: Scrutation clavier ;IN : / ;OUT: X = 00 si aucune touche actionnée (ou meme touche actionnée) sinon code ;-------------------------------------------------------------- SCRUTKEYBOARD: PHA ; Sauvegarde A,P,Y PHP TYA PHA CLD ; Mode decimal TEST_REPETITION: LDA v2KBD BPL RESETSEQREAD ; Si < $80 alors va éeRST_SEQ_KEYBOARD AND #$87 ; Test si c'est la même touche qui est actionnée STA v2KBD_Work1 LDX v2KBD_ColPattern JSR LIT_KEYBOARD ; FCT: Cherche le numéro de la ligne de la touche actionnée ; pour une colonne donnée ; IN : X pos of column ; A pos of line ; OUT: A $00 : pas de touche actionnée sinon ; =10000lll avec lll numéeo de ligne CMP v2KBD_Work1 BNE RESETSEQREAD ; Si ce n'est pas la même touche ; alors on recherche la nouvelle touche actionnée DEC v2KBD_RepeatCount BNE F_NOKB_SCRUTKEYBOARD LDA v2KBD_TempoAuto ; Vitesse de réeéeition des touches STA v2KBD_RepeatCount JMP TRAITKEYB RESETSEQREAD: LDA v2KBD_TempoRep ; RESET DE LA VALEUR TEMPO CLAVIER STA v2KBD_RepeatCount JSR READ_MATRIX_KEYB ; FCT: Recherche de la derniére touche actionnée (touche normale et control) ; IN : / ; OUT: / TRAITKEYB: JSR CONV_MATRIX_2_ASCII ;-------------------------------------------------------------- ; FCT: Conversion de la touche actionnée en ASCII ; IN : / ; OUT: A : Valeur ASCII de la touche actionnée ;-------------------------------------------------------------- JMP F_SCRUTKEYBOARD F_NOKB_SCRUTKEYBOARD: LDA #$00 F_SCRUTKEYBOARD: TAX PLA TAY PLP PLA RTS ;-------------------------------------------------------------- ;FCT: Conversion de la touche actionnée en ASCII ;IN : / ;OUT: A : Valeur ASCII de la touche actionnée ;-------------------------------------------------------------- CONV_MATRIX_2_ASCII: LDA v2KBD_CTRL TAY LDA #0 CPY #$A4 ; = Shift gauche BEQ SetCaps CPY #$A7 ; = Shift Droit BNE SuiteConv SetCaps: CLC ; Accès à la 2eme partie du tableau ; de conversion ADC #$40 SuiteConv: CLC ADC v2KBD BPL F_IsCtrlShift ; Si < $80 alors pas de conversion AND #$7F ; Le tableau a 128 positions ... TAX LDA aTabMask,X ; Contient le code ASCII de la touche ; actionnée suivant les coordonnées X,Y ; 8x8 elements : minuscule ; 8x8 elements : majuscule AND v2KBD_UpcaseFlag ; Traitement du drapeau UPPER/LOWER BPL IsCtrl SEC SBC #$20 ; Passage en mode majuscule IsCtrl: AND #$7F CPY #$A2 ; = Ctrl BNE IsNotCtrl ; Si pas egal alors va a IsnotCtrl CMP #$40 BMI IsNotCtrl ; Si A >= $40 ('@') alors pas de gestion ; CTRL+touche AND #$1F ; Gestion de CTRL+Touche IsNotCtrl: ORA #$80 ; Mise à '1' du bit 7 de A F_IsCtrlShift: RTS ;-------------------------------------------------------------- ;FCT: Recherche de la derniere touche actionnée (touche normale et control) ;IN : / ;OUT: / ;-------------------------------------------------------------- READ_MATRIX_KEYB: LDA #$38 ; Initialisation STA v2KBD_ColCount STA v2KBD STA v2KBD_CTRL LDA #$7F ; Pattern de départ de la colonne ; utilisée pour programmer les sorties ; du port I/O du PSG PHA BclReadMatrix: PLA ; Simulation de POP X ET PUSH X !! PHA TAX LDA #7 JSR LIT_KEYBOARD ; FCT: Cherche le numée de la ligne de la touche actionnée ; pour une colonne donnée ; IN : X pos of column ; A pos of line ; OUT: A $00 : pas de touche actionnée sinon ; =10000lll avec lll numéeo de ligne ORA v2KBD_ColCount BPL PrepColLinMatr ; Si < 0 alors tester la colonne suivante LDX #0 ; Index pour sauvegarde de touche (=0 touche normal, =1 touche de fonction) LDY #$20 ; Est-ce la 4eme colonne ? (colonne CTRL, SHIFT et FCT ?) CPY v2KBD_ColCount ; Ajout du numéeo de colonne codéesur 3 bits BNE SaveKeybRd ; Si non alors touche normale INX ; C'est une touche de control SaveKeybRd: STA v2KBD,X ; Sauvegarde dans soirt v2KBD soir v2KBD_CTRL PLA ; Récupération du motif binaire associée ; au numéro de colonne testée PHA STA v2KBD_ColPattern,X ; Sauvegarde la pattern de la colonne o la touche a éeéeactionnée PrepColLinMatr: SEC ; La retenue '1' sera utilisée pour le ror PLA ROR ; Colonne de la ligne suivante PHA ; On garde sur la pile le numéeo de colonne SEC LDA v2KBD_ColCount ; Le codage du numero de colonne ; se fait par rapport $38=7,$30=6... ; $00=0 SBC #8 ; Passage la colonne suivante STA v2KBD_ColCount BPL BclReadMatrix ; Si < 0 alors on continue la scrutation par colonne PLA ; Suppression du parametre colonne de la pile RTS ;-------------------------------------------------------------- ; FCT: Cherche le numéeo de la ligne de la touche actionnée ; pour une colonne donnée ; IN : X pos of column ; A pos of line ; OUT: A $00 : pas de touche actionnée sinon ; =10000lll avec lll numero de ligne ;-------------------------------------------------------------- LIT_KEYBOARD: PHA ; Sauvegarde du numéeo de ligne SET_COLUMN: ; On veut éerire sur le I/O Port data LDA #$E JSR W8912 ; FCT: Programmation du PSG ; IN : X = data to write to register of PSG ; A = register of PSG SET_LINE: ; Recuperation du numero de ligne PLA AND #7 ; Limitation 8 lignes (0-7) TAX ; X=X mod 7 STA v2KBD_Work2 ; Sauvegarde du numéeo de ligne ; pour arréter le scan ... BCL_LIT_KEYBOARD: ORA #$B8 ; Le OU permet fixer l'éeat de certaines ; broches du port B STA v3_IORB ; On applique le numéeo de ligne JMP IsPressed ; Introduction de temps d'attente NOP NOP IsPressed: LDA v3_IORB ; On lit le port B AND #8 ; On recupere l'éeat de la broche 3 du ; port B BNE FIN_LIT_KEYBOARD; La touche a éeéefrappée (=1) ? DEX ; Non alors ligne suivante TXA AND #7 TAX ; X=X MOD 7 CMP v2KBD_Work2 ; A-t-on termin ? BNE BCL_LIT_KEYBOARD; Non alors éela ligne suivante LDA #0 ; Touche non détectée RTS FIN_LIT_KEYBOARD: TXA ORA #$80 ; Le bit 7 de A est force '1' ; Touche détectée RTS ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;FCT: Print a character (A) + scroll of screen + manage cursor position ;IN : A : code ascii to print ;OUT: A,X,Y,FLAGS are modified ; v2CurCol is modified ; v2CurRow is modified ; v0PtrText is modified ;-------------------------------------------------------------- WRITECAR: PHA LDA #$00 ; Force le curseur à être éteint JSR ManageBlinkingCursor PLA WRCAR_CR: CMP #$0D ; Return Carriage BEQ LINE_NEXT WRCAR_DEL: CMP #$08 ; Suppression(DEL <=> CTRL-H) BEQ DEL CMP #$20 ; ASCII affichable ? BCC F_WRITECAR ; Non alors fin AND #$7F ; On supprime le bit 7 LDY v2CurCol STA (v0PtrText),Y INY STY v2CurCol CPY v2NbColEcran BNE F_WRITECAR LINE_NEXT: ; Passe à la ligne suivante LDX #$02 ; 14/11/2011 : Il faut ajouter le test du mode 38/40 colonnes STX v2CurCol LDX v2CurRow INX CPX v2NbLigneEcran ; Fin de l'écran ? BCS SCREEN_SCROLL ; Oui alors scrolling STX v2CurRow LDA v0PtrText CLC ADC #$28 ; Il y a 40 colonnes dans un écran STA v0PtrText BCC END_LINE_NEXT INC v0PtrText+1 END_LINE_NEXT: RTS SCREEN_SCROLL: INC v2FlgScroll ; Attention scrolling !! Pas de cuseur clignotant JSR SCROLLTEXT ; Scrolling de l'écran DEC v2FlgScroll ; La routine IRQ peut gérer le clignotement CLEAR_LINE: ; Il faut effacer la derniére ligne LDA v0PtrText STA v0Tmp LDA v0PtrText+1 STA v0Tmp+1 JMP CLEAR_ONE_LINE_SCREEN F_WRITECAR: RTS DEL: ; Effacement du caractère LDY v2CurCol CPY #$00 ; 14/11/2011 : il faut ajouter le test du mode 38/40 colonnes BEQ SUITE_DEL ; correction du 08/11/2011 : A vérifier DEY STY v2CurCol SUITE_DEL: LDA #$20 STA (v0PtrText),Y FIN_DEL: RTS ;-------------------------------------------------------------- ;FCT: print a null string at (X,Y) or 256 characters max. ;IN : X : Pos X, Y : Pos Y ; v0Source = ptr of string terminated by 0 ; v0Cible = ptr of saving string ;OUT: A,Y,FLAGS are modified ;-------------------------------------------------------------- WRITESTRINGXY: JSR GOTOXY LDY #$00 BCL_WRITESTRING: LDA (v0Source),Y BEQ FIN_WRITESTRING STA (v0Cible),Y INY BNE BCL_WRITESTRING FIN_WRITESTRING: RTS ;-------------------------------------------------------------- ;FCT: Positionne le curseur a la position (X,Y) ;IN : X : POS X, Y : POS Y ;OUT: v0Cible = $BB80 + Y * 40 + X ; v0PtrText= $BB80 + Y * 40 ; v0CurCol = X ; v0CurRow = Y ;-------------------------------------------------------------- GOTOXY: STX v2CurCol STY v2CurRow MUL_Y_BY_40: TYA JSR MUL_A_BY_40 ; Calcul de Ligne x 40 ADD_BB80: STY v0Cible+1 ; Ajout de 0xBB80 CLC ADC #$80 STA v0Cible STA v0PtrText LDA #$BB ADC v0Cible+1 STA v0Cible+1 STA v0PtrText+1 ADD_POS_X: CLC TXA ADC v0Cible STA v0Cible LDA #$00 ADC v0Cible+1 STA v0Cible+1 RTS ;-------------------------------------------------------------- ;FCT: Multiplication de A par 40 ;IN : A ;OUT: v0CalculAdresse=A*40 (ne respecte pas la convention mémoire du 6502) ; Y=poid fort du calcul ; A=poid faible du calcul ;-------------------------------------------------------------- MUL_A_BY_40: LDY #0 STY v0CalculAdresse STA v0CalculAdresse+1 ASL ROL v0CalculAdresse ASL ROL v0CalculAdresse CLC ADC v0CalculAdresse+1 BCC SUITE_MULABY40 INC v0CalculAdresse SUITE_MULABY40: ASL ROL v0CalculAdresse ASL ROL v0CalculAdresse ASL ROL v0CalculAdresse LDY v0CalculAdresse RTS ;-------------------------------------------------------------- ;FCT: Scrolling de tout ou partie de l'ecran ;IN : nothing ;OUT: A,X,Y,FLAGS are modified ;-------------------------------------------------------------- ; REMARQUE : 15/11/2011 : indépendance des constantes ... ;-------------------------------------------------------------- SCROLLTEXT: LDA v2VduL2 STA v0Source LDA v2VduL2+1 STA v0Source+1 LDA v2VduL1 STA v0Cible LDA v2VduL1+1 STA v0Cible+1 LDX v2NbLigneEcran DEX DEX INIT_LOOP_DX: LDY v2NbColEcran DEY LOOP_DX: LDA (v0Source),Y STA (v0Cible),Y DEY BNE LOOP_DX LDA v0Source STA v0Cible LDA v0Source+1 STA v0Cible+1 CLC LDA v0Source ADC #$28 ; Il y a toujours 40 colonnes dans un écran STA v0Source BCC DEC_LIGNE INC v0Source+1 DEC_LIGNE: DEX BPL INIT_LOOP_DX RTS ;-------------------------------------------------------------- ; FCT: Efface l'ecran par utilisation du caractere 0x20 (espace) ; Utilise v2VduL1 pour déterminer la premiére ligne à effacer ; IN : none ; OUT: A,X,Y and Flags are modified ;-------------------------------------------------------------- CLRSCR: LDA v2VduL1+1 STA v0Tmp+1 STA v0PtrText+1 LDA v2VduL1 STA v0Tmp STA v0PtrText BEGIN_CLRSCR: LDX v2NbLigneEcran DEX ; Il y a une ligne en moins car ligne de statut BCL_DY: LDY v2NbColEcran DEY JSR PRE_COLS_BCL ; Efface une ligne CLC LDA v0Tmp ADC #$28 ; Il y a toujours 40 colonnes dans un écran STA v0Tmp BCC DEC_DY INC v0Tmp+1 DEC_DY: DEX BPL BCL_DY ; Nous bouclons sur v2NbLigneEcran RTS ;-------------------------------------------------------------- ;FCT: Gere le clignotement du curseur ;IN : A : 0 curseur eteint, =1 curseur allume ;OUT: A is modified ; v2CursorWork is modified ;-------------------------------------------------------------- ManageBlinkingCursor: AND v2Mode0 LSR ROR STA v2CursorWork LDY v2CurCol LDA (v0PtrText),Y AND #$7F ORA v2CursorWork STA (v0PtrText),Y RTS ;-------------------------------------------------------------- ;FCT: Affiche le message CAPS (majuscule) ou caps (minuscule) ;IN : v2KBD_UpcaseFlag ;OUT: A,Y,X,FLAGS are modified ;-------------------------------------------------------------- SETMSGCAPS: LDA v2KBD_UpcaseFlag BPL SMC_LOWERCAPS SMC_UPPERCAPS: LDA #aCaps JMP SMC_PR_CAPS SMC_LOWERCAPS: LDA #aNoCaps SMC_PR_CAPS: LDX #$24 ; Set column at $24 (36 decimal) JMP STOUT_LIGNE_ETAT ; Affiche une chaine (Y,A) sur la ligne d'état à la pos X ;-------------------------------------------------------------- ;FCT: Affiche une chaine (Y,A) se terminant par un 0 sur la ligne d'état à la pos X ;IN : (Y,A) : Adresse lineaire de la chaine terminée par un 0 ;OUT: A,Y,X,FLAGS are modified ;-------------------------------------------------------------- ; le 09/11/2011 : Une nouvelle version ... ;-------------------------------------------------------------- STOUT_LIGNE_ETAT: STA v0Source STY v0Source+1 LDA v2LigneStatut STA v0Cible LDA v2LigneStatut+1 STA v0Cible+1 TXA ; On ajoute l'offset X CLC ADC v0Cible STA v0Cible BCC BEFORE_WRITE_STOUT_LIGNE_ETAT INC v0Cible+1 BEFORE_WRITE_STOUT_LIGNE_ETAT: LDY #$00 WRITE_STOUT_LIGNE_ETAT: LDA (v0Source),Y BEQ F_STOUT_LIGNE_ETAT STA (v0Cible),Y INY BNE WRITE_STOUT_LIGNE_ETAT F_STOUT_LIGNE_ETAT: RTS ;-------------------------------------------------------------- ; FCT: Efface une ligne de l'écran et fixe les attributs aux valeurs de v2Paper et v2Ink ; La routine ne vérifie pas si v0Tmp pointe sur le début d'une ligne ! ; IN : v0Tmp : Position de la ligne en adresse lineaire (ex. : 0xBBA8) ; OUT: A,Y,FLAGS are modified ;-------------------------------------------------------------- ; Optimisation : 08/11/2011 : ARRET sur BNE et non pas BPL pour gagner des cycles écritures ;-------------------------------------------------------------- CLEAR_ONE_LINE_SCREEN: LDY v2NbColEcran DEY PRE_COLS_BCL: LDA #$20 ; On remplit d'espace -- XXX @ XXX COLS_BCL: STA (v0Tmp),Y DEY BPL COLS_BCL INY ; On place les attributs : Ajouter le test du mode 38/40 colonnes LDA v2Paper STA (v0Tmp),Y LDA v2Ink INY STA (v0Tmp),Y RTS ;-------------------------------------------------------------- ; FCT: Efface la ligne de statut ; IN : none ; OUT: A,Y,FLAGS are modified ;-------------------------------------------------------------- CLEARSTATUSLINE: LDA v2LigneStatut STA v0Tmp LDA v2LigneStatut+1 STA v0Tmp+1 JMP CLEAR_ONE_LINE_SCREEN ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ORIC_START: LDX #$FF TXS CLD INIT_TEMPO_KEYB: LDA #$09 STA v2KBD_TempoRep LDA #$01 STA v2KBD_TempoAuto INIT_CAPS: LDA #$7F STA v2KBD_UpcaseFlag CLI INIT_VIA6522: JSR INIT_VIA INIT_PSG8192: LDA #$07 LDX #$40 JSR W8912 INIT_TIMER: JSR INIT_TIMERS INIT_TEXT: LDA #$0F ; Keyboard state : no clicks & cursor not blinking STA v2Mode0 LDA #$02 ; INK 2 : vert STA v2Ink LDA #$10 ; PAPER 0 : noir STA v2Paper JSR INITTEXTSCREEN ; Initialisation de l'écran TEXT LDA #$00 ; Initialisation du curseur STA v2CurRow STA v2CurCol INIT_CHAR: LDX #$05 JSR INIT_TRANSFERTCHAR ; Transfert de la fonte des caracteres INIT_MSG_CAPS: JSR SETMSGCAPS ; Affiche Message CAPS/caps FIN_INIT: JMP ENTER ; Initialisation du noyau FORTH ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;FCT: Gestion de l'interruption IRQ ; Si ce n'est pas une interruption venant du TIMER 1 du VIA 6522 ; ALORS sortie directe ; SINON Recherche touche actionnée si nécessaire ; et gestion du clignotement du curseur ;-------------------------------------------------------------- INT_IRQ: PHA LDA v3_IFR AND #$40 BEQ F_INT_IRQ STA v3_IFR TXA PHA TYA PHA LDX #$04 DEC_TIMER: LDA v2TIMER1,X SEC SBC #$01 STA v2TIMER1,X LDA v2TIMER1+1,X SBC #$00 STA v2TIMER1+1,X DEX DEX BPL DEC_TIMER GetValueTimer1: LDX #$00 JSR GET_TIMER CPY #$00 BNE GetValueTimerT2 SetValueTimer1: LDA #$00 LDY #$03 JSR SET_TIMER GetKey JSR SCRUTKEYBOARD StoreKey: TXA BPL GetValueTimerT2 STX v2IChar GetValueTimerT2: LDX #$02 JSR GET_TIMER CPY #$00 BNE F_MANAGE_IRQ SetValueTimerT2: LDA #$00 LDY #$19 JSR SET_TIMER IsScroll: LDA v2FlgScroll BNE F_MANAGE_IRQ ManageClig: LDA v2AuthClig EOR #1 STA v2AuthClig JSR ManageBlinkingCursor F_MANAGE_IRQ: PLA TAY PLA TAX F_INT_IRQ: PLA RTI ;-------------------------------------------------------------- ;FCT: Fixe la tempo du timer donnée par X ; 00 : Timer 1, 02 : timer 2, 04 : timer 2 ;IN : X : N de timer (0,2,4), (Y,A) : le temps en unitée de 10 ms ;OUT: Y is modified ;-------------------------------------------------------------- SET_TIMER: SEI STA v2TIMER1+1,X TYA STA v2TIMER1,X CLI RTS ;-------------------------------------------------------------- ;FCT: Obtient le temps restant du timer donnée par X ; 00 : Timer 1, 02 : timer 2, 04 : timer 2 ;IN : X : N de timer (0,2,4) ;OUT: A,Y : le temps restant ;-------------------------------------------------------------- GET_TIMER: SEI LDA v2TIMER1+1,X LDY v2TIMER1,X CLI RTS ;-------------------------------------------------------------- ;FCT: Initialise les 3 timers software à 0 ;IN : none ;OUT: A,Y, FLAGS are modified ;-------------------------------------------------------------- RESET_ALL_TIMERS: LDY #5 LDA #0 RT_BCL: STA v2TIMER1,Y DEY BPL RT_BCL RTS ;-------------------------------------------------------------- ;FCT: Attend (Y,A) x 10 ms ;IN : X : N de timer, (Y,A) : temps d'attente ;OUT: A,Y,FLAGS are modified ;-------------------------------------------------------------- WAIT: JSR SET_TIMER BCL_WAIT: JSR GET_TIMER CPY #$00 BNE BCL_WAIT CMP #$00 BNE BCL_WAIT F_WAIT: RTS ;-------------------------------------------------------------- ;FCT: Initialise le mode texte puis les variables associées ; sauf celle indiquant la position du curseur ;IN : / ;OUT: A,X,Y,FLAGS are modified ;-------------------------------------------------------------- INITTEXTSCREEN: INIT_VAR: LDA #$00 STA v2TypeScr LDA #$BB STA v2VduL1+1 STA v2VduL2+1 STA v2LigneStatut+1 LDA #$80 STA v2LigneStatut ; Ligne de Statut : $BB80 LDA #$A8 STA v2VduL1 ; 1ere ligne affichée : $BBA8 LDA #$D0 STA v2VduL2 ; 2ème ligne affichée : $BBD0 LDA #$1C STA v2NbLigneEcran ; 28 lignes à l'écran LDA #$28 STA v2NbColEcran ; 40 colonnes à l'écran LDA #4 STA v2LgEcran+1 ; $410 : Taille de l'écran en octets LDA #$10 STA v2LgEcran ACTION_CLRSCR: JSR CLRSCR ; Efface l'écran LDA #$1A ; Changement de l'attribut pour initialiser en mode txt, 50 Hz STA $BFDF LDX #$04 ; TIMER 3 LDA #$00 ; Attend au moins un affichage LDY #$03 ; entier d'un écran pour synchro JMP WAIT ;-------------------------------------------------------------- ;FCT: Effectue le transfert de la table des caracteres en memoire ;IN : X : Position des données (Source,Cible,lg) dans aTabPtrScr ;OUT: A,X,Y,FLAGS are modified ;-------------------------------------------------------------- INIT_TRANSFERTCHAR: LDY #$06 BclInitPtrTrf: LDA aTabPtrScr,X STA v0Source-1,Y DEX DEY BNE BclInitPtrTrf JMP MOVE ;-------------------------------------------------------------- ;FCT: Deplacement de v0Longueur caracteres du ptr v0Source vers le ptr v0Cible ;IN : v0Source, v0Cible, v0Longueur ;OUT: A,X,Y,FLAGS are modified ;-------------------------------------------------------------- MOVE: LDX #$00 LDY #$00 BCL_1_MOVE: CPY v0Longueur BNE BCL_2_MOVE CPX v0Longueur+1 BEQ F_MOVE BCL_2_MOVE: LDA (v0Source),Y STA (v0Cible),Y INY BNE BCL_1_MOVE INC v0Source+1 INC v0Cible+1 INX JMP BCL_1_MOVE F_MOVE: RTS ;-------------------------------------------------------------- ;FCT: INITIALISE LES TIMES SOFTWARES ET HARDWARES ;IN : / ;OUT: A,X,Y,FLAGS are modified ;-------------------------------------------------------------- INIT_TIMERS: JSR RESET_ALL_TIMERS LDX #$00 ; TIMER 2 LDA #$00 LDY #$03 JSR SET_TIMER ; FCT : Fixe la valeur du TIMER point par A ; IN : A : numro de TIMER ( 0, 1 et 2) ; (X,Y) : la valeur du TIMER LDX #$02 ; TIMER 2 LDA #$00 LDY #$19 JSR SET_TIMER ; FCT : Fixe la valeur du TIMER point par A ; IN : A : numro de TIMER ( 0, 1 et 2) ; (X,Y) : la valeur du TIMER LDA #0 STA v2AuthClig ; 1=allume, 0=eteint LDA v3_ACR AND #$7F ORA #$40 STA v3_ACR LDA #$C0 STA v3_IER LDA #$10 STA v3_T1LL STA v3_T1CL LDA #$27 STA v3_T1LH STA v3_T1CH RTS ;-------------------------------------------------------------- ;FCT: INITIALISE LE VIA 6522 (PORT A ET B, INTERRUPTION) ;IN : / ;OUT: A,X,Y,FLAGS are modified ;-------------------------------------------------------------- INIT_VIA: LDA #$FF ; Version patchee STA v3_DDRA LDA #$B7 ; Init orb first with PB4 set to 1 STA v3_IORB LDA #$F7 ; Then turn PB4 from high Z to high output STA v3_DDRB LDA #$DD STA v3_PCR LDA #$7F ; Disable all interrupts enabled because ; bit 7 = 0 and bit 6 to 0 = 1 STA v3_IER LDA #0 STA v3_ACR RTS ;-------------------------------------------------------------- ;FCT: Programmation du PSG ;IN : X = data to write to register of PSG ; A = register of PSG ;OUT: FLAGS is not modified ; A, X, Y is modified ;-------------------------------------------------------------- W8912: PHP SEI SET_REGISTER: STA v3_IOA ; Numero de colonne sur le port A TAY ; Y=A TXA ; A=X CPY #7 ; Numero de registre est = 7 ? BNE LATCH_REGISTER ; non alors en LATCH_REGISTER ORA #$40 ; Si le n° registre=7 alors on ; on met d'office le bit 6 '1' ; pour que le I/O port DATA soit ; programmé en sortie LATCH_REGISTER: PHA LDA v3_PCR ; Charge le Peripheral Control Register ORA #$EE ; BC2 = '1' et CA2 = '1' ; BC2=BDIR et CA2=BC1 du PSG STA v3_PCR ; LATCH ADRESS FROM BUS OF PSG INACTIVE_PSG: ; BC2='0' et CA2='0' AND #$11 ORA #$CC ; BDIR=CB2 et BC1=CA2 du PSG STA v3_PCR ; PSG is inactive SET_DATA: ; X=A TAX PLA ; Récupération du numéro de colonne STA v3_IOA ; Sur le port A INACTIVE_1_PSG: ; A=X TXA ORA #$EC ; CB2=BDIR='1' CA2=BC1='0' STA v3_PCR ; DATA WRITE TO PSG AND #$11 ORA #$CC ; CB2=BDIR='0' et CA2=BC1='0' STA v3_PCR ; PSG is inactive PLP RTS ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;-------------------------------------------------------------- ;Codage : SRC,CIBLE,QUANTITE aTabPtrScr: .WORD aTabCar,$B500,$0300 aCaps: .BYTE "CAPS",0 aNoCaps: .BYTE "caps",0 .ORG $FC78 aTabCar: .BYTE 0, 0, 0, 0, 0, 0, 0, 0 .BYTE 8, 8, 8, 8, 8, 0, 8, 0 .BYTE $14, $14, $14, 0, 0, 0, 0, 0 .BYTE $14, $14, $3E, $14, $3E, $14, $14, 0 .BYTE 8, $1E, $28, $1C, $A, $3C, 8, 0 .BYTE $30, $32, 4, 8, $10, $26, 6, 0 .BYTE $10, $28, $28, $10, $2A, $24, $1A, 0 .BYTE 8, 8, 8, 0, 0, 0, 0, 0 .BYTE 8, $10, $20, $20, $20, $10, 8, 0 .BYTE 8, 4, 2, 2, 2, 4, 8, 0 .BYTE 8, $2A, $1C, 8, $1C, $2A, 8, 0 .BYTE 0, 8, 8, $3E, 8, 8, 0, 0 .BYTE 0, 0, 0, 0, 0, 8, 8, $10 .BYTE 0, 0, 0, $3E, 0, 0, 0, 0 .BYTE 0, 0, 0, 0, 0, 4, 0, 0 .BYTE 0, 2, 4, 8, $10, $20, 0, 0 .BYTE $1C, $22, $26, $2A, $32, $22, $1C, 0 .BYTE 8, $18, 8, 8, 8, 8, $1C, 0 .BYTE $1C, $22, 2, 4, 8, $10, $3E, 0 .BYTE $3E, 2, 4, $C, 2, $22, $1C, 0 .BYTE 4, $C, $14, $24, $3E, 4, 4, 0 .BYTE $3E, $20, $3C, 2, 2, $22, $1C, 0 .BYTE $C, $10, $20, $3C, $22, $22, $1C, 0 .BYTE $3E, 2, 4, 8, $10, $10, $10, 0 .BYTE $1C, $22, $22, $1C, $22, $22, $1C, 0 .BYTE $1C, $22, $22, $1E, 2, 4, $18, 0 .BYTE 0, 0, 8, 0, 0, 8, 0, 0 .BYTE 0, 0, 8, 0, 0, 8, 8, $10 .BYTE 4, 8, $10, $20, $10, 8, 4, 0 .BYTE 0, 0, $3E, 0, $3E, 0, 0, 0 .BYTE $10, 8, 4, 2, 4, 8, $10, 0 .BYTE $1C, $22, 4, 8, 8, 0, 8, 0 .BYTE $1C, $22, $2A, $2E, $2C, $20, $1E, 0 .BYTE 8, $14, $22, $22, $3E, $22, $22, 0 .BYTE $3C, $22, $22, $3C, $22, $22, $3C, 0 .BYTE $1C, $22, $20, $20, $20, $22, $1C, 0 .BYTE $3C, $22, $22, $22, $22, $22, $3C, 0 .BYTE $3E, $20, $20, $3C, $20, $20, $3E, 0 .BYTE $3E, $20, $20, $3C, $20, $20, $20, 0 .BYTE $1E, $20, $20, $20, $26, $22, $1E, 0 .BYTE $22, $22, $22, $3E, $22, $22, $22, 0 .BYTE $1C, 8, 8, 8, 8, 8, $1C, 0 .BYTE 2, 2, 2, 2, 2, $22, $1C, 0 .BYTE $22, $24, $28, $30, $28, $24, $22, 0 .BYTE $20, $20, $20, $20, $20, $20, $3E, 0 .BYTE $22, $36, $2A, $2A, $22, $22, $22, 0 .BYTE $22, $22, $32, $2A, $26, $22, $22, 0 .BYTE $1C, $22, $22, $22, $22, $22, $1C, 0 .BYTE $3C, $22, $22, $3C, $20, $20, $20, 0 .BYTE $1C, $22, $22, $22, $2A, $24, $1A, 0 .BYTE $3C, $22, $22, $3C, $28, $24, $22, 0 .BYTE $1C, $22, $20, $1C, 2, $22, $1C, 0 .BYTE $3E, 8, 8, 8, 8, 8, 8, 0 .BYTE $22, $22, $22, $22, $22, $22, $1C, 0 .BYTE $22, $22, $22, $22, $22, $14, 8, 0 .BYTE $22, $22, $22, $2A, $2A, $36, $22, 0 .BYTE $22, $22, $14, 8, $14, $22, $22, 0 .BYTE $22, $22, $14, 8, 8, 8, 8, 0 .BYTE $3E, 2, 4, 8, $10, $20, $3E, 0 .BYTE $1E, $10, $10, $10, $10, $10, $1E, 0 .BYTE 0, $20, $10, 8, 4, 2, 0, 0 .BYTE $3C, 4, 4, 4, 4, 4, $3C, 0 .BYTE 8, $14, $2A, 8, 8, 8, 8, 0 .BYTE $E, $11, $3C, $10, $3C, $11, $E, 0 .BYTE $C, $12, $2D, $29, $29, $2D, $12, $C .BYTE 0, 0, $1C, 2, $1E, $22, $1E, 0 .BYTE $20, $20, $3C, $22, $22, $22, $3C, 0 .BYTE 0, 0, $1E, $20, $20, $20, $1E, 0 .BYTE 2, 2, $1E, $22, $22, $22, $1E, 0 .BYTE 0, 0, $1C, $22, $3E, $20, $1E, 0 .BYTE $C, $12, $10, $3C, $10, $10, $10, 0 .BYTE 0, 0, $1C, $22, $22, $1E, 2, $1C .BYTE $20, $20, $3C, $22, $22, $22, $22, 0 .BYTE 8, 0, $18, 8, 8, 8, $1C, 0 .BYTE 4, 0, $C, 4, 4, 4, $24, $18 .BYTE $20, $20, $22, $24, $38, $24, $22, 0 .BYTE $18, 8, 8, 8, 8, 8, $1C, 0 .BYTE 0, 0, $36, $2A, $2A, $2A, $22, 0 .BYTE 0, 0, $3C, $22, $22, $22, $22, 0 .BYTE 0, 0, $1C, $22, $22, $22, $1C, 0 .BYTE 0, 0, $3C, $22, $22, $3C, $20, $20 .BYTE 0, 0, $1E, $22, $22, $1E, 2, 2 .BYTE 0, 0, $2E, $30, $20, $20, $20, 0 .BYTE 0, 0, $1E, $20, $1C, 2, $3C, 0 .BYTE $10, $10, $3C, $10, $10, $12, $C, 0 .BYTE 0, 0, $22, $22, $22, $26, $1A, 0 .BYTE 0, 0, $22, $22, $22, $14, 8, 0 .BYTE 0, 0, $22, $22, $2A, $2A, $36, 0 .BYTE 0, 0, $22, $14, 8, $14, $22, 0 .BYTE 0, 0, $22, $22, $22, $1E, 2, $1C .BYTE 0, 0, $3E, 4, 8, $10, $3E, 0 .BYTE $E, $18, $18, $30, $18, $18, $E, 0 .BYTE 8, 8, 8, 8, 8, 8, 8, 8 .BYTE $38, $C, $C, 6, $C, $C, $38, 0 .BYTE $2A, $15, $2A, $15, $2A, $15, $2A, $15 .BYTE $3F, $3F, $3F, $3F, $3F, $3F, $3F, $3F ;aTabMask: .BYTE $37, $EA, $ED, $EB, $20, $F5, $F9, $38 ; .BYTE $EE, $F4, $36, $39, $2C, $E9, $E8, $EC ; .BYTE $35, $F2, $E2, $3B, $2E, $EF, $E7, $30 ; .BYTE $F6, $E6, $34, $2D, $B, $F0, $E5, $2F ; .BYTE 0, 0, 0, 0, 0, 0, 0, 0 ; .BYTE $31, $1B, $FA, 0, 8, $7F, $E1, $D ; .BYTE $F8, $F1, $32, $5C, $A, $5D, $F3, 0 ; .BYTE $33, $E4, $E3, $27, 9, $5B, $F7, $3D ; ; .BYTE $26, $4A, $4D, $4B, $20, $55, $59, $2A ; .BYTE $4E, $54, $5E, $28, $3C, $49, $48, $4C ; .BYTE $25, $52, $42, $3A, $3E, $4F, $47, $29 ; .BYTE $56, $46, $24, $5F, $B, $50, $45, $3F ; .BYTE 0, 0, 0, 0, 0, 0, 0, 0 ; .BYTE $21, $1B, $5A, 0, 8, $7F, $41, $D ; .BYTE $58, $51, $40, $7C, $A, $7D, $53, 0 ; .BYTE $23, $44, $43, $22, 9, $7B, $57, $2B ; Nouvelle definition des codes claviers pour avoir une ;correpondance entre le clavier azerty et le clavier oric aTabMask .BYTE $7D, $EA, $2C, $EB, $20, $F5, $F9, $5F .BYTE $EE, $F4, $2D, $5C, $3B, $E9, $E8, $EC .BYTE $28, $F2, $E2, $ED, $3A, $EF, $E7, $40 .BYTE $F6, $E6, $27, $29, $0B, $F0, $E5, $21 .BYTE $60, $7C, $5B, $7B, $00, $00, $7E, $23 .BYTE $26, $1B, $F7, $3C, $08, $7F, $F1, $0D .BYTE $F8, $E1, $73, $2A, $0A, $24, $F3, $14 .BYTE $22, $E4, $E3, $7C, $09, $5E, $FA, $3D .BYTE $37, $4A, $3F, $4B, $20, $55, $59, $38 .BYTE $4E, $54, $36, $39, $2E, $49, $48, $4C .BYTE $35, $52, $42, $4D, $2F, $4F, $47, $30 .BYTE $56, $46, $34, $5B, $0B, $50, $45, $5D .BYTE $5C, $5E, $40, $5D, $00, $00, $00, $7D .BYTE $31, $1B, $57, $3E, $08, $7F, $51, $D .BYTE $58, $41, $32, $2A, $0A, $5F, $53, 14 .BYTE $33, $44, $43, $25, $09, $7E, $5A, $2B .BYTE $D0, 1 .WORD INT_IRQ ; NMI .WORD ORIC_START ; RESET .WORD INT_IRQ ; IRQ ; ; TOP_ORIC_ATMOS .END ; end of listing