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

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