;-----------------
;    PASCAL 1.4   
;                 
; M-CODE ROUTINEN 
;  FUER DEN C-64  
;    (FETCH.E)    
;22.11.1985       
;                 
ORG $4000         
;-----------------
;** KONSTANTEN ** 
<ANFZ   EQU 34    
;GAENSEFUESSCHEN  
<AL     EQU 7     
<AL2    EQU 14    
;SIGNIFIKANTE     
;ZEICHEN          
;-----------------
;** VARIABLEN  ** 
<SELECT EQU 1     
<XL     EQU 2     
<IND    EQU 3     
<ZEIG   EQU $FE   
;                 
<B      EQU 51    
<TMEM   EQU 55    
;-----------------
AUS     EQU 826   
TEMPFLG EQU 907   
PNT     EQU 909   
RET     EQU 929   
;                 
INIT    EQU 2087  
HLT     EQU 2341  
START   EQU 5611  
START10 EQU 5621  
;+10 BYTES        
;                 
SOURCE  EQU 641   
;MIT OFFSET $6000 
<OFFSET EQU $60   
TARGET  EQU $A000 
<CHRGOT EQU $79   
<ZEIGER EQU $7A   
<DEZPKT EQU $5F   
<INTH   EQU $64   
<INTL   EQU $65   
READY   EQU $A474 
ASCFLP  EQU $BCF3 
FLPINT  EQU $B1BF 
PACK    EQU $BBD4 
;-----------------
READST  EQU $FFB7 
SETLFS  EQU $FFBA 
SETNAM  EQU $FFBD 
OPEN    EQU $FFC0 
CLOSE   EQU $FFC3 
CHKIN   EQU $FFC6 
CHKOUT  EQU $FFC9 
CHRIN   EQU $FFCF 
CHROUT  EQU $FFD2 
CLRCHN  EQU $FFCC 
;-----------------
COMPILE           
;EINSPRUNG ZUM    
;COMPILER:        
;<TMEM := ORG     
;<T    :=START10  
;                 
LDA #0            
STA <TMEM         
LDA #$40          
STA <TMEM+1       
LDA #[RETURN      
STA HLT+9         
LDA #]RETURN      
STA HLT+10        
LDY #5            
C0 LDA TAB,Y      
STA START,Y       
DEY               
BPL C0            
JMP INIT          
;                 
TAB               
;STACKANFANG &    
;JMP PCODE+2      
DFD START10       
DFD $12,PCODE+2   
;                 
RETURN            
LDA #[READY       
STA HLT+9         
LDA #]READY       
STA HLT+10        
LDA PC            
STA PNT+2; 45     
LDA PC+1          
STA PNT+3; 46     
JMP RET           
;                 
RAMON             
;RAM EINBLENDEN   
;                 
SEI               
LDA <SELECT       
AND #%11111000    
STA <SELECT       
RTS               
;                 
RAMOFF            
;RAM AUSBLENDEN   
;                 
LDA <SELECT       
ORA #%00000111    
STA <SELECT       
CLI               
RTS               
;                 
GEN               
;BYTE SPEICHERN   
;ADR+$A000-START  
;                 
SEC               
LDA ADR           
SBC #[START       
STA <IND          
LDA ADR+1         
SBC #]START       
CLC               
ADC #]TARGET      
STA <IND+1        
JSR RAMON         
LDY #0            
LDA BYTE          
STA (<IND),Y      
JMP RAMOFF        
;                 
;*PASCALVARIABLEN*
ADR     DFD 0,0   
BYTE    DFD 0,0   
PC      DFD 0,0   
NUMBER  DFD 0,0   
ZNR     DFD 0,0   
FROM    DFD 0,0   
CHAR    DFD 0,0   
POS     DFD 0,0   
FLOAT             
DFD 0,0,0,0,0     
ID                
DFD 0,0,0,0,0,0   
DFD 0,0,0,0,0,0   
DFD 0,0,0         
;(LAENGE = AL2)   
;-----------------
INDEX   DFD 0     
LBYTE   DFD 0     
HBYTE   DFD 0     
TSTFLG  DFD 0,0   
CODE    DFD 0     
XREG    DFD 0     
STRFLG  DFD 0     
ZNR1    DFD 0,0   
LAST    DFD 0,0   
XL1     DFD 0     
;-----------------
VGL               
DFD "ÁNDÁRRAY"    
DFD "ÂEGINÃASE"   
DFD "ÃONSTÄIVÄO"  
DFD "ÄOWNTOÅLSE"  
DFD "ÅNDÆILEÆOR"  
DFD "ÆORWARD"     
DFD "ÆUNCTION"    
DFD "ÇOTOÉFÉN"    
DFD "ÌABELÍODÎIL" 
DFD "ÎOTÏFÏR"     
DFD "ÐACKED"      
DFD "ÐROCEDURE"   
DFD "ÐROGRAM"     
DFD "ÒECORDÒEPEAT"
DFD "ÓETÔHENÔO"   
DFD "ÔYPEÕNTIL"   
DFD "ÖAR×HILE"    
DFD "×ITH"        
DFD 255           
;-----------------
BEZTAB            
DFD "FALSE  "     
DFD "TRUE   "     
DFD "BOOLEAN"     
DFD "MAXINT "     
DFD "INTEGER"     
DFD "CHAR   "     
DFD "REAL   "     
DFD "*NIL   "     
DFD "*STRING"     
DFD "*SET   "     
DFD "TEXT   "     
DFD "OPEN   "     
DFD "CLOSE  "     
DFD "GET    "     
DFD "PUT    "     
DFD "WRITE  "     
DFD "WRITELN"     
DFD "READ   "     
DFD "READLN "     
DFD "POKE   "     
DFD "SYS    "     
DFD "HALT   "     
DFD "NEW    "     
DFD "MARK   "     
DFD "RELEASE"     
DFD "ORD    "     
DFD "CHR    "     
DFD "SUCC   "     
DFD "PRED   "     
DFD "PEEK   "     
DFD "EOLN   "     
DFD "EOF    "     
DFD "STATUS "     
DFD "ODD    "     
DFD "ABS    "     
DFD "SQRT   "     
DFD "LN     "     
DFD "EXP    "     
DFD "SIN    "     
DFD "COS    "     
DFD "TAN    "     
DFD "ARCTAN "     
DFD "INT    "     
DFD "POWER  "     
DFD "ADDU   "     
DFD "INPUT  "     
DFD "OUTPUT "     
;                 
STRNG             
DFD ",P,R",0      
HOLE1 JSR ULES    
LDX #255          
;-----------------
UHOLE             
;HOLE DAS NAECHSTE
;ZEICHEN          
;-----------------
INX               
ULFD              
LDA AUS,X         
BEQ HOLE1         
CMP #255          
BEQ ABORT         
RTS               
;                 
ABORT PLA         
PLA               
LDA #255          
JMP GETS^         
;                 
;-----------------
UINIT             
;HOLE 1. SYMBOL   
;VOM BASIC-TEXT   
;-----------------
JSR RAMON         
;                 
LDA SOURCE        
STA <ZEIG         
CLC               
LDA SOURCE+1      
ADC #<OFFSET      
STA <ZEIG+1       
LDY #0            
STY FROM          
STY FROM+1        
STY STRFLG        
LDA #255          
STA ZNR1          
STA ZNR1+1        
JSR ULESRAM       
STA XL1           
JSR ULESRAM       
STA LAST          
JSR ULESRAM       
STA LAST+1        
JSR ULESRAM       
JSR ULESRAM       
JSR USKIP         
JSR USKIP         
JSR USKIP         
;                 
JSR RAMOFF        
;                 
INIT1             
;ERZWINGT ZEILEN- 
;ANFANG           
LDA #0            
STA AUS           
STA INDEX         
;-----------------
GETSYM            
;HOLE DAS NAECHSTE
;SYMBOL IM TEXT   
;-----------------
LDX INDEX         
GETS1             
JSR ULFD          
CMP #<ANFZ        
BNE GETS11        
;                 
;STRINGS KOPIEREN:
;                 
TAY               
LDA STRFLG        
EOR #255          
STA STRFLG        
TYA               
GETS11            
BIT STRFLG        
BPL GETS2         
INX               
JMP GETS^         
;                 
GETS2 CMP #" "    
BNE GETS3         
INX               
BNE GETS1         
;                 
GETS3 JSR UTEST   
BCC GETS31        
JMP GETS4         
;                 
;SONDERZEICHEN:   
;                 
GETS31 CMP #":"   
BNE SONDER3       
LDA AUS+1,X       
CMP #"="          
BNE SONDERF       
LDA #170          
BNE SONDERR       
SONDER3 CMP #"<"  
BNE SONDER5       
LDA AUS+1,X       
CMP #"="          
BNE SONDER4       
LDA #171          
BNE SONDERR       
SONDER4 CMP #">"  
BNE SONDERF       
LDA #172          
BNE SONDERR       
SONDER5 CMP #">"  
BNE SONDER6       
LDA AUS+1,X       
CMP #"="          
BNE SONDERF       
LDA #173          
BNE SONDERR       
SONDER6 CMP #"."  
BNE SONDER7       
LDA AUS+1,X       
CMP #"."          
BNE SONDERF       
LDA #174          
BNE SONDERR       
SONDER7 CMP #"("  
BNE SONDERF       
LDA AUS+1,X       
CMP #"*"          
BEQ KOMMENT       
;                 
SONDERF           
;                 
LDA AUS,X         
INX               
DFD $2C           
;                 
SONDERR           
;                 
INX               
INX               
JMP GETS^         
;                 
KOMMENT           
;AKTIVE KOMMENTARE
;PRUEFEN:         
;                 
INX               
JSR UHOLE         
CMP #"$"          
BNE KOMMENT9      
JSR UHOLE         
CMP #<ANFZ        
BNE KOMMENT1      
JMP UXCHNG        
;->INCLUDE FILE   
KOMMENT1          
CMP #"R"          
BNE KOMMENT9      
;RANGE CHECK      
JSR UHOLE         
LDY #0            
CMP #"-"          
BEQ KOMMENT2      
CMP #"+"          
BNE KOMMENT9      
INY               
KOMMENT2          
STY TSTFLG        
;                 
KOMMENT8          
JSR UHOLE         
KOMMENT9          
CMP #"*"          
BNE KOMMENT8      
LDA AUS+1,X       
CMP #")"          
BNE KOMMENT8      
INX               
INX               
JMP GETS1         
;                 
GETS4 CMP #"A"    
BCC GETS5         
;                 
;BEZEICHNER ODER  
;WORTSYMBOL:      
;                 
STX XREG          
LDA #128          
STA CODE          
LDY #0            
LDA VGL,Y         
;                 
WSYM1             
AND #$7F          
WSYM2 CMP AUS,X   
BEQ WSYM4         
BCS WSYM5         
WSYM^ LDX XREG    
WSYM3 INY         
LDA VGL,Y         
BPL WSYM3         
INC CODE          
BNE WSYM1         
WSYM4 INX         
INY               
LDA VGL,Y         
BPL WSYM2         
DEX               
DEY               
;*** GLEICH ***   
LDA AUS+1,X       
JSR UTEST         
BCS WSYM^         
INX               
LDA CODE          
BNE GETS^         
;***UNGLEICH***   
;BEZEICHNER NACH  
;ID KOPIEREN      
WSYM5             
LDX XREG          
LDA AUS,X         
LDY #0            
BEZ1 CPY #<AL2    
BPL BEZ11         
STA ID,Y          
BEZ11 INY         
INX               
LDA AUS,X         
JSR UTEST         
BCS BEZ1          
LDA #" "          
BEZ13 CPY #<AL2   
BPL BEZ14         
STA ID,Y          
INY               
BNE BEZ13         
BEZ14             
LDA #252          
BNE GETS^         
;                 
GETS5             
;***ZAHL***       
;                 
JSR UZAHL         
                  
GETS^             
;                 
;SYMBOL UEBERGEBEN
;UND INDEX SETZEN:
;                 
STX INDEX         
STA CHAR          
LDA #0            
STA CHAR+1        
RTS               
;-----------------
UTEST             
;C=1-> BUCHSTABE  
;      ODER ZAHL  
;-----------------
CMP #"["          
BCS TEST1         
CMP #"0"          
BCC TEST2         
CMP #"A"          
BCS TEST2         
CMP #":"          
BCC TEST3         
TEST1 CLC         
TEST2 RTS         
TEST3 SEC         
RTS               
;-----------------
UXCHNG            
;UMSCHALTUNG      
;AUF FILE ".."    
;X ENTHAELT INDEX 
;AUF NAMEN IN TAB 
;-----------------
INX               
STX XREG          
LDA #1            
JSR CLOSE         
LDA #1            
LDX #8            
LDY #3            
JSR SETLFS        
LDY #0            
LDX XREG          
;"....",P,R       
XCH1 LDA AUS,X    
CMP #<ANFZ        
BEQ XCH2          
STA AUS,Y         
INY               
INX               
CPY #17           
BNE XCH1          
XCH2 LDX #0       
XCH3 LDA STRNG,X  
BEQ XCH4          
STA AUS,Y         
INY               
INX               
BNE XCH3          
XCH4 TYA          
LDX #[AUS         
LDY #]AUS         
JSR SETNAM        
JSR OPEN          
LDX #1            
JSR CHKIN         
JSR CHRIN         
JSR CHRIN         
JSR CHRIN         
STA <XL           
LDY #0            
CLC               
ADC #3            
BCC *+3           
INY               
CLC               
ADC <XL           
BCC *+3           
INY               
CLC               
ADC <XL           
BCC *+3           
INY               
TAX               
;** VORLAUF       
;** UEBERLESEN    
BEQ XCH6          
XCH5 JSR CHRIN    
DEX               
CPX #255          
BNE XCH5          
XCH6 DEY          
LDX #255          
CPY #255          
BNE XCH5          
;                 
JSR CLRCHN        
LDA #255          
STA ZNR           
STA ZNR+1         
;**RELATIV ZUM    
;**FILE-ANFANG    
LDA #1            
STA FROM          
JMP INIT1         
;**NEUER ZEILEN-  
;**ANFANG         
;-----------------
ULESF             
;LESEROUTINE(FILE)
;                 
;LIEST EINE ZEILE 
;DES PROGRAMMES   
;NACH AUS         
;0  -> ZEILENENDE 
;AM  TEXTENDE     
;FROM:=0          
;-----------------
INC ZNR           
BNE LESF1         
INC ZNR+1         
LESF1 LDX #1      
JSR CHKIN         
LDX #0            
;                 
LESF2 JSR CHRIN   
STA AUS,X         
INX               
CPX <XL           
BNE LESF2         
LDA #0            
STA AUS,X         
JSR READST        
PHA               
JSR CLRCHN        
PLA               
BEQ LESF5         
;**RUECKSCHALTEN  
LDA #0            
STA FROM          
;                 
LESF5             
JMP LESR          
;-----------------
ULES              
;LESEROUTINE/ALLG.
;                 
;LIEST EINE ZEILE 
;DES PROGRAMMES   
;NACH AUS         
;0  -> ZEILENENDE 
;255-> TEXTENDE   
;-----------------
LDA FROM          
BNE ULESF         
;                 
JSR RAMON         
;                 
INC ZNR1          
BNE LES1          
INC ZNR1+1        
LES1 LDA ZNR1     
STA ZNR           
LDX ZNR1+1        
STX ZNR+1         
CMP LAST          
BNE LES2          
CPX LAST+1        
BNE LES2          
;**PROGRAMMENDE   
LDA #255          
STA AUS           
LDA #0            
STA AUS+1         
BEQ LES4          
;                 
LES2 LDY #0       
LES3              
LDA (<ZEIG),Y     
STA AUS,Y         
INY               
CPY XL1           
BNE LES3          
;                 
LDA #0            
STA AUS,Y         
JSR USKIP         
LES4              
JSR RAMOFF        
;-----------------
LESR              
;LISTING AUSGEBEN 
LDX #2            
JSR CHKOUT        
LDX #0            
LESR1 LDA AUS,X   
BEQ LESR2         
JSR CHROUT        
INX               
BNE LESR1         
LESR2 LDA #13     
JSR CHROUT        
JMP CLRCHN        
;-----------------
USKIP             
;UEBERSPRINGE EINE
;ZEILE IM RAM     
CLC               
LDA <ZEIG         
ADC XL1           
STA <ZEIG         
BCC SKIP1         
INC <ZEIG+1       
SKIP1 RTS         
;-----------------
ULESRAM           
;HOLE NAECHSTES   
;ZEICHEN AUS DEM  
;SPEICHER         
LDY #0            
LDA (<ZEIG),Y     
INC <ZEIG         
BNE LESRAM1       
INC <ZEIG+1       
LESRAM1 RTS       
;-----------------
UZAHL             
;LESEN ZAHL       
;AKKU:=253        
;=>INTEGER,WERT   
;  IN NUMBER      
;AKKU:=254        
;=>REAL,ADRESSE   
;  IN NUMBER      
;XR ENTHAELT DEN  
;   TEXTZEIGER    
;-----------------
STX INDEX         
;**SETZE ZEIGER:  
CLC               
LDA #[AUS         
ADC INDEX         
STA <ZEIGER       
LDA #]AUS         
ADC #0            
STA <ZEIGER+1     
;**UMWANDLUNG:    
JSR <CHRGOT       
JSR ASCFLP        
SEC               
LDA <ZEIGER       
SBC #[AUS         
TAX               
;**DEZIMALPUNKT   
;**UND EXPONENT   
;**AM ZAHLENENDE  
;**IGNORIEREN:    
LDA AUS-1,X       
CMP #"."          
BEQ ZAHL2         
CMP #"E"          
BNE ZAHL3         
ZAHL2 LDA #0      
STA <DEZPKT       
DEX               
ZAHL3             
;**GETSYM HOLT DAS
;**NAECHSTE ZCHN: 
STX INDEX         
;                 
LDA <DEZPKT       
BNE REAL^         
;**INTEGER:       
JSR FLPINT        
LDA <INTL         
LDY <INTH         
LDX #253          
BNE FERTIG        
;**REAL:          
;**(WERT IN FLOAT)
REAL^             
LDX #[FLOAT       
LDY #]FLOAT       
JSR PACK          
LDA #[FLOAT       
LDY #]FLOAT       
LDX #254          
FERTIG            
STA NUMBER        
STY NUMBER+1      
TXA               
LDX INDEX         
RTS               
;                 
;-----------------
UPOSI             
;TABELLENSUCHE    
;STACK:           
;+15 -> ID        
;+13 -> TABBEZ[TX]
;+11 -> TX        
;(<B ALS BASIS)   
;                 
<ID     EQU 109   
<TABB   EQU 107   
<J      EQU 105   
;                 
LDA #255          
STA POS           
STA POS+1         
LDY #16           
POSI0 LDA (<B),Y  
;**STA <J-11,Y    
DFD $99,<J-11,0   
DEY               
CPY #10           
BNE POSI0         
LDY #1            
LDA (<ID),Y       
BMI POSI^         
DEY               
LDA (<ID),Y       
CMP #"*"          
BEQ POSI^         
; DOWNTO 0        
POSI1             
SEC               
LDA <J            
SBC #1            
STA <J            
BCS POSI2         
DEC <J+1          
BMI POSI^         
POSI2 SEC         
LDA <TABB         
SBC #<AL2         
STA <TABB         
BCS POSI4         
DEC <TABB+1       
;                 
POSI4 LDY #0      
POSI5             
LDA (<ID),Y       
CMP (<TABB),Y     
BNE POSI1         
INY               
CPY #<AL2         
BNE POSI5         
;**GEFUNDEN       
LDA <J            
STA POS           
LDA <J+1          
STA POS+1         
POSI^             
RTS               
;                 
PCODE