rhialto: Me under a waterfall (Default)
[personal profile] rhialto

I found this in an old archive. I originally wrote it in secondary school for the Commodore PET but this version is converted for the Commodore 64. It is an "extension" to the built-in BASIC. BASIC is already considered to be a bad programming language since it doesn't encourage (or even allow) structured programming. This thing makes it worse, by allowing self-modifying programs (so you don't even know what the program is, any more).

;STRING+ IS EEN WEDGE WAARMEE
;JE BASIC-INSTRUKTIES IN EEN
;STRING KAN STOPPEN DIE
;DAN UITGEVOERD WORDEN.
;GEBRUIK:
;
;10 A$="GOSUB 250"
;20 :[A$]: ENZ.
;
;INSCHAKELEN MET SYS 40000:POKE55,156:POKE56,64:CLR
;        UIT MET SYS 40003
;
        .SKIP 2
*       = 40000
VALTYP  = $0D
TANSGN  = $12
VARNA   = $45
COMPAR  = $4D
STRPNT  = $22
CURLIN  = $39
CHGET   = $0073
CHGET2  = CHGET+3
CHGOT   = CHGET+6
BASBUF  = $0200
SLERR   = $A571
TOKENS  = $A579
FRMEVL  = $AD9E
SNERR   = $AF08
FRESTR  = $B6A3
PRINT   = $FFD2

        .SKIP 1
GOTO    = $89
RUN     = $8A
BUFLEN  = 88
NOCHAR  = 97
LINKS   = $5B           ;[ HAAKJE
RECHTS  = $5D           ;] HAAKJE
CR      = 13
RVS     = 18
OFF     = RVS+128

        .SKIP 2
INAAN   JMP WAAN
INUIT   JMP WUIT

        .SKIP 2
INCREM  INC CHGOT+1     ;VERHOOG
        BNE EXINC       ; CHARGOT
        INC CHGOT+2     ; POINTER
EXINC   JMP CHGOT       ; MET 1

        .SKIP 2
SN      LDA #LINKS      ;DEFAULT TOESTAND
        STA GOED
        JMP SNERR

SL      LDA #LINKS      ;DEFAULT TOESTAND
        STA GOED
        JMP SLERR       ;STRING TOO LONG

WEDGE   LDA GOED        ;IN EEN
        CMP #RECHTS     ; STRING?
        BNE NIEUW       ;NEE, SPRING
        JSR INCREM
        CMP #RUN        ;RUN?
        BEQ UIT
        CMP #GOTO       ;GOTO
        BNE NIEUW2
        PHA
        LDA CHGOT+2     ;HIBYTE CHGOTPOINTER
        CMP #>REGBUF    ;'GOTO' IN STRING
        PLA
        BCC NIEUW2      ;ALS REGBUF>CHGOTPOINTER
UIT     LDA #LINKS
        STA GOED
        JMP CHGOT

        .SKIP 2
NIEUW   JSR INCREM
NIEUW2  CMP GOED
        BEQ TEKOK       ;EEN GOED TEKEN
        JMP CHGOT

        .SKIP 2
TEKOK   CMP #LINKS      ;GOED TEKEN GEVONDEN
        BEQ OPEN
        JMP SLUIT

        .SKIP 2
OPEN    STX SX          ;[ GEVONDEN
        STY SY
        LDA #NOCHAR     ;ONTYPEBAAR CHAR
        STA GOED
        LDA VALTYP      ;RED EEN EN ANDER
        STA SAV0D       ; VAN DE EVALUATOR
        LDA TANSGN
        STA SAV12
        LDA VARNA       ;VARIABELE NAAM
        STA SAV45
        LDA VARNA+1
        STA SAV45+1
        LDA COMPAR
        STA SAV4D
        JSR INCREM      ;HOOG CHGOTPOINTER OP
        JSR FRMEVL      ;HAAL STRING
        JSR CHGOT
        CMP #RECHTS     ;VOLGT ER EEN ] ?
        BNE SN          ; NEE, DAN SYNTAX ERROR
        LDA CHGOT+1     ;RED
        STA CHGPNT      ; CHARGOT
        LDA CHGOT+2     ; POINTER
        STA CHGPNT+1
        JSR FRESTR      ;GEEF RUIMTE VRIJ
        TAY
        CPY #BUFLEN     ;88 BYTES
        BCS SL          ; IS TE VEEL
        INY
        LDA #0          ;AFSLUITING VOOR
        STA BASBUF,Y    ;TOKENIZER
        DEY
        LDA #RECHTS     ;BEEINDIG STRING
        STA BASBUF,Y    ; VOOR WEDGE
        DEY
LOOP1   LDA (STRPNT),Y  ;LOOP DIE
        STA BASBUF,Y    ; GEVONDEN STRING
        DEY             ; IN BASIC INPUT
        BPL LOOP1       ; BUFFER ZET
        LDA #<BASBUF    ;POINTER IN
        STA CHGOT+1     ; INPUTBUFFER
        LDA #>BASBUF
        STA CHGOT+2
        JSR TOKENS      ;TOKENIZE INPUTBUFFER
        LDA #RECHTS
        STA GOED
        LDA SAV0D       ;VAN DE EVALUATOR
        STA VALTYP      ; EEN EN ANDER
        LDA SAV12       ; TERUGHALEN
        STA TANSGN
        LDA SAV45
        STA VARNA       ;VARIABELE NAAM
        LDA SAV45+1
        STA VARNA+1
        LDA SAV4D
        STA COMPAR
        LDX #BUFLEN-1   ;LENGTE VH INPUTBFF
LOOP2   LDA BASBUF,X    ;BRENG INPUTBFF
        STA REGBUF,X    ; NAAR VEILIG GEBIED
        DEX
        BPL LOOP2
        LDA CURLIN      ;RED
        STA REGNUM      ; REGEL
        LDA CURLIN+1    ; NUMMER
        STA REGNUM+1
        LDA #$00        ;REGEL
        STA CURLIN      ; NUMMER
        LDA #>64000     ; WORDT
        STA CURLIN+1    ; 64000
        LDA #<REGBUF-1  ;ZET
                            ; EN MAAR HOPEN DAT 'T BUFFER NIET OP
                            ; PAGINAGRENS BEGINT
        STA CHGOT+1     ; CHARGOT
        LDA #>REGBUF    ; POINTER
        STA CHGOT+2
        LDX SX
        LDY SY
        JMP WEDGE       ;EQUIVALENT MET CHGET

        .SKIP 2
SLUIT   LDA #LINKS      ;] GEVONDEN
        STA GOED
        LDA CHGPNT      ;ZET CHARGOT
        STA CHGOT+1     ; POINTER
        LDA CHGPNT+1    ; WEER GOED
        STA CHGOT+2
        LDA REGNUM      ;ZET REGEL
        STA CURLIN      ; NUMMER
        LDA REGNUM+1    ; WEER GOED
        STA CURLIN+1
        JMP WEDGE       ;EN TERUGSPRINGEN = CHGET

        .SKIP 2
WAAN    LDX #$5         ;SCHAKEL
LUSA1   LDA DATAAN,X    ;WEDGE
        STA CHGET,X     ;IN
        DEX
        BPL LUSA1
        LDA #LINKS
        STA GOED
        LDX #$FF        ;PRINT
LUSA2   INX             ;BERICHT
        LDA AANBER,X    ;BIJ
        JSR PRINT       ;INSCHAKELEN
        BNE LUSA2
        RTS

DATAAN  JMP WEDGE
        JMP INCREM

        .SKIP 2
WUIT    LDX #$5         ;SCHAKEL
LUSU1   LDA DATUIT,X    ;WEDGE
        STA CHGET,X     ;UIT
        DEX
        BPL LUSU1
        RTS

DATUIT  INC CHGOT+1     ;OORSPRONKELIJK
        BNE DATUIT+6    ;BEGIN VAN
        INC CHGOT+2     ;CHARGETROUTINE

        .SKIP 2
AANBER  .BYTE CR,' *',RVS
        .BYTE 'STRING+/64       V14.09.83 V03.05.86'
        .BYTE OFF,'*',CR,CR,0
GOED    .BYTE 0
CHGPNT  .WORD 0
REGNUM  .WORD 0
SX      .BYTE 0
SY      .BYTE 0
REGBUF  ;= SAV0D
SAV0D   .BYTE 0
SAV12   .BYTE 0
SAV45   .WORD 0
SAV4D   .BYTE 0
*       = REGBUF+BUFLEN

        .END

(will be screened)
(will be screened if not validated)
If you don't have an account you can create one now.
HTML doesn't work in the subject.
More info about formatting

If you are unable to use this captcha for any reason, please contact us by email at support@dreamwidth.org

Profile

rhialto: Me under a waterfall (Default)
rhialto

February 2024

S M T W T F S
    123
45678910
11121314151617
18192021 222324
2526272829  

Most Popular Tags

Style Credit

Expand Cut Tags

No cut tags
Powered by Dreamwidth Studios