;=================
;    PAS.MOD1     
; VERSION  C-128  
;                 
;TABELLEN, FEHLER-
;MELDUNGEN UND    
;GLOBALE UTILITIES
;=================
;                 
;4.9.1986         
;U1: 27.6.1989    
;                 
IMP PAS.SYST      
;                 
;=================
ORG BASE          
;(= ENDE COMMON-  
; AREA, BANK1)    
;=================
;                 
;FILE-DESCRIPTOR  
;FUER INPUT/OUTPUT
;                 
IBUF              
DFD 0,0,0,0       
DFD 0,0,0,0       
OBUF              
DFD 0,0,0,0       
DFD 0,0,0,0       
;                 
BANK DFD $F       
;                 
SAVEERR           
DFD 0,0           
;                 
SAVTOP            
DFD 0,0           
;                 
ERRMSG            
DFD "STACK OV"    
DFD "ERFLO×  "    
;                 
DFD "INTEGER "    
DFD "OVERFLO×"    
;                 
DFD "DIVISION"    
DFD " BY 0  "     
DFD (" "+128)     
;                 
DFD "NO LABEL"    
DFD " IN CASÅ"    
;                 
DFD "HEAP OVE"    
DFD "RFLO×   "    
;                 
DFD "STRING O"    
DFD "VERFLO× "    
;                 
DFD "VALUE OUT "  
DFD "OF BOUNDS:"  
DFD (" "+128)     
;                 
TXT1              
DFD 13," ERROR "  
DFD "AÔ"          
;                 
TXT2              
DFD "CALLED AÔ"   
;                 
TXT3              
DFD "IN",160      
;=================
ORGFETCH          
;HOLE ZEICHEN AUS 
;BELIEBIGER BANK  
LDA #0            
;*WIRD MODIFIZIERT
STA MMUCR         
LDA (<P),Y        
STA LCRB          
RTS               
;- - - - - - - - -
;STOP.IT          
;<---EINSPRUNG BEI
;BASERR (X=CODE)  
STA LCRB          
JMP BASERR        
;- - - - - - - - -
;UGRFSTA          
;FUER GRAFIK-IFACE
STA LCRA          
;** WIRD GEAENDERT
;** (FUER SOUND)  
STA GRFTAB,X      
STA LCRB          
RTS               
;=================
PRTERR            
;* FEHLER (A/Y)   
;* AUSGEBEN       
STA <ERRTXT       
STY <ERRTXT+1     
PRTERR1 LDY #0    
PRTERR2           
LDA (<ERRTXT),Y   
PHA               
AND #$7F          
JSR XBSOUT        
INY               
PLA               
BPL PRTERR2       
RTS               
;-----------------
UCALLAY           
;ROUTINE AB A/Y   
;IN BANK 15       
STA <FARPC+1;  L  
STY <FARPC;    H  
JMP CALLF1        
;-----------------
CRLF              
;ZEILENVORSCHUB   
LDA #13           
;- - - - - - - - -
XBSOUT            
;ZEICHENAUSGABE   
PHA               
LDA #[BSOUT       
STA <FARPC+1      
LDA #]BSOUT       
STA <FARPC        
PLA               
;- - - - - - - - -
UCALLF            
;KERNAL-ROUTINE   
;AUFRUFEN         
STA <FARA         
STY <FARY         
CALLF1 STX <FARX  
;*KONFIGURATIONS- 
;*INDEX!          
LDA #<BANKF       
STA <FARCNF       
;- - - - - - - - -
UCALL             
;*****************
;AUFRUF EINER ROM-
;ROUTINE AB DER   
;ADRESSE (<FARPC) 
;DIE KONFIGURATION
;BLEIBT GLEICH!   
;*****************
;*AENDERE DIE     
;*RUECKKEHRKONF.  
LDA FARRET        
PHA               
LDA MMUCR         
STA FARRET        
STA LCRD          
JSR JSRFAR        
PLA               
STA FARRET        
LDA <FARST        
PHA               
;* Y BLEIBT GLEICH
LDX <FARX         
LDA <FARA         
PLP               
RTS               
;-----------------
INIT              
;<----            
;AUFRUF PCODE-    
;INTERPRETER:     
;A/Y ZEIGER AUF 1.
;    STATEMENT    
;X   BANK FUER    
;    CODE         
;KEINE RUECKKEHR, 
;SONDERN SPRUNG   
;ZU (ERRPTR) BEI  
;KONFIGURATION 15 
;-----------------
PHA               
STA <P            
STX ORGFETCH+1    
STY <P+1          
TYA               
PHA               
;                 
LDX #26           
INIT0             
LDA ORGFETCH,X    
STA PASFET,X      
DEX               
BPL INIT0         
;*ERRORVEKTOR AUF 
;*STOP.IT IN DER  
;*COMMON-AREA     
LDA ERRPTR        
STA SAVEERR       
LDA ERRPTR+1      
STA SAVEERR+1     
LDA #[STOP.IT     
STA ERRPTR        
LDA #]STOP.IT     
STA ERRPTR+1      
;                 
;BASTOP AUS BANK0 
;                 
LDA #<TP          
STA FETVEC        
LDA #[BASTOP      
STA <TP           
LDA #]BASTOP      
STA <TP+1         
LDY #0            
LDX #<BANK0       
JSR FETCH         
STA SAVTOP        
INY               
LDX #<BANK0       
JSR FETCH         
STA SAVTOP+1      
;                 
;STD. I/O SETZEN: 
;                 
LDY #0            
STY IBUF+5        
STY OBUF+5        
STY <DIRECT       
;(FUER BASMOV)    
LDA #<BANKF       
STA BANK          
;                 
JSR PASFET        
TAX               
INY               
JSR PASFET        
STA <TP           
INY               
JSR PASFET        
STX <P            
LDY <TP           
STY <P+1          
CMP #1            
;********* GRAFIK?
BNE INIT1         
;                 
PLA               
CLC               
ADC #$24          
PHA               
LDA #[BASMOVE     
LDY #]BASMOVE     
JSR UCALLAY       
;                 
LDA SAVTOP        
LDX #223          
;BASTOP-GRFTAB    
JSR UGRFSTA       
INX               
LDA SAVTOP+1      
CLC               
ADC #$24          
JSR UGRFSTA       
;                 
INIT1 LDY #1      
JSR PASFET        
STA <T+1          
STA <B+1          
DEY               
JSR PASFET        
STA <T            
STA <B            
;                 
;HEAP IST LEER    
;                 
LDA <HIMEM        
STA <TOP          
LDA <HIMEM+1      
STA <TOP+1        
;*****************
;HAUPTPROGRAMM:   
;RA:=START P-CODE 
;DL:=0            
;ALLOCIERE PLATZ  
;FUER HEAD        
;*****************
LDY #<RA+1        
PLA               
STA (<B),Y        
DEY               
PLA               
STA (<B),Y        
DEY               
LDA #0            
STA (<B),Y        
DEY               
STA (<B),Y        
;                 
LDA #6            
JSR ALLOC         
;                 
JMP NEXT2         
;-----------------
WRINT             
;16 BIT INTEGER   
;MIT VORZEICHEN!  
;(XR=L A=H)       
;                 
STA LCRD          
STX <TP           
LDY <TP           
JSR INTFLP        
JSR FLPSTR        
STA LCRB          
LDX #0            
WRINT0 LDA TAB,X  
BEQ WRINT1        
JSR XBSOUT        
INX               
BNE WRINT0        
;                 
WRINT1            
LDA #" "          
JMP XBSOUT        
;-----------------
STACKO LDA #0     
DFD $2C           
OVERFL LDA #1     
DFD $2C           
DIVISI LDA #2     
;                 
;A ENTHAELT CODE: 
;                 
ERROR LDX #1      
;LOESCHE FLAG FUER
;"OUT OF RANGE"   
ERROR1 STX <TP    
ASL               
ASL               
ASL               
ASL               
CLC               
ADC #[ERRMSG      
STA <ERRTXT       
LDA #]ERRMSG      
ADC #0            
STA <ERRTXT+1     
BNE ERR1          
;                 
IOERR TAX         
;- - - - - - - - -
BASERR            
;--> BASIC ERROR  
; X ENTHAELT CODE 
;>=128,FALLS BREAK
;-----------------
TXA               
BPL BASER1        
LDX #30;   "BREAK"
BASER1 DEX        
STX <TP           
;LOESCHE FLAG FUER
;"OUT OF RANGE"   
TXA               
STA LCRD          
JSR ERRADR        
;                 
ERR1              
;DRUCKE <ERRTXT   
;                 
STA LCRD          
JSR CLRCHN        
LDA #0            
STA <IODEV        
BIT <M4080        
BMI ERR2          
STA <HIRES        
ERR2 JSR CRLF     
JSR PRTERR1       
STA LCRB          
;                 
LDY <TP           
BNE ERR5          
;*****************
;TP=0 ==>         
;"VALUE OUT OF    
;"RANGE ERROR"    
;                 
LDA (<T),Y        
TAX               
INY               
LDA (<T),Y        
JSR WRINT         
LDY #0            
JSR PASFET        
TAX               
INY               
JSR PASFET        
JSR WRINT         
LDY #2            
JSR PASFET        
TAX               
INY               
JSR PASFET        
JSR WRINT         
;*****************
ERR5              
LDA #[TXT1        
LDY #]TXT1        
JSR PRTERR        
;                 
LDX <P            
LDA <P+1          
JSR WRINT         
;*****************
ERR6              
;FUER ALLE VOR-   
;GAENGER IN DYN.  
;LINK:            
LDA #[TXT3        
LDY #]TXT3        
JSR PRTERR        
;                 
;HOLE ADRESSE DES 
;BLOCKANFANGS     
LDY #<RA          
LDA (<B),Y        
STA <P            
STA <TP           
INY               
LDA (<B),Y        
STA <P+1          
STA <TP+1         
LDY #1            
JSR PASFET        
TAX               
DEY               
JSR PASFET        
STX <P+1          
STA <P            
;(Y=0)            
;DRUCKE DEN NAMEN 
;RUECKWAERTS:     
ERR7 LDA <P       
BNE ERR8          
DEC <P+1          
ERR8 DEC <P       
JSR PASFET        
PHA               
AND #$7F          
JSR XBSOUT        
PLA               
BPL ERR7          
JSR CRLF          
;                 
;BIS DL=(0,0)     
;                 
LDY #<DL          
LDA (<B),Y        
TAX               
INY               
LDA (<B),Y        
STX <B            
STA <B+1          
ORA <B            
BEQ HLT           
;                 
;FUER PROZEDUREN  
;DIE DL KETTE     
;DURCHLAUFEN      
;                 
LDA #[TXT2        
LDY #]TXT2        
JSR PRTERR        
LDX <TP           
LDA <TP+1         
JSR WRINT         
JMP ERR6          
;*****************
HLT               
;                 
LDA #[BASMOVD     
LDY #]BASMOVD     
JSR UCALLAY       
;                 
LDA SAVTOP        
LDX #223          
;BASTOP-GRFTAB    
JSR UGRFSTA       
INX               
LDA SAVTOP+1      
JSR UGRFSTA       
;                 
;>>BEGIN U1       
;RESTORE Z-PAGE:  
LDA #0            
LDY #4            
STA <T            
STY <T+1          
STA <P            
STY <P+1          
STA <B1           
STY <B1+1         
LDY #$FF          
STA <TOP          
STY <TOP+1        
STA <F            
STA <F+1          
;<<END U1         
LDA SAVEERR       
STA ERRPTR        
LDY SAVEERR+1     
STY ERRPTR+1      
;                 
LDX #$80          
JMP UCALLAY       
;--> EXIT INTERPR.
;                 
;=================
;                 
;  INTERPRETER-   
;   SCHLEIFE:     
;                 
;=================
NEXT5 LDA #5      
BNE NEXT          
NEXT4 LDA #4      
BNE NEXT          
NEXT3 LDA #3      
BNE NEXT          
NEXT2 LDA #2      
DFD $2C           
NEXT1 LDA #1      
NEXT              
CLC               
ADC <P            
STA <P            
BCC NEXT0         
INC <P+1          
;                 
NEXT0             
;INTERPRETIERT    
;DEN NAECHSTEN    
;BEFEHL           
LDY #0            
JSR PASFET        
ASL               
TAX               
LDA TABOP+1,X     
PHA               
LDA TABOP,X       
PHA               
INC <P            
BNE NEXT9         
INC <P+1          
NEXT9 RTS         
;=> CODE (YR=0!!!)
;KONFIGURATION:   
;NUR RAM EINGE-   
;SCHALTET         
;=================
;STACK-ROUTINEN:  
;=================
POP12 LDA #244    
BNE POPA          
POP5 LDA #251     
BNE POPA          
POP3 LDA #253     
DFD $2C           
POP2 LDA #254     
POPA              
;A BYTES FREIGEBEN
;YR BLEIBT GLEICH 
;                 
CLC               
ADC <T            
STA <T            
BCS POP21         
DEC <T+1          
POP21 RTS         
;-----------------
AL4 LDA #4        
BNE ALLOC         
AL3 LDA #3        
DFD $2C           
AL2 LDA #2        
ALLOC             
;A BYTES BELEGEN: 
;YR:=1            
;                 
CLC               
ADC <T            
STA <T            
BCC AL21          
INC <T+1          
LDA <T+1          
CMP <TOP+1        
BCC AL21          
JMP STACKO        
AL21 LDY #1       
RTS               
;-----------------
UBASE             
;HOLE BASISADRESSE
;(<P),Y GLIEDER IN
;DER SL KETTE     
;ZURUECK NACH <B1 
;(YR:=0)          
;                 
LDA <B            
STA <B1           
LDA <B+1          
STA <B1+1         
JSR PASFET        
TAX               
BEQ BASE9         
BASE1             
LDY #<SL+1        
LDA (<B1),Y       
PHA               
DEY               
LDA (<B1),Y       
STA <B1           
PLA               
STA <B1+1         
DEX               
BNE BASE1         
BASE9 LDY #0      
RTS               
;-----------------
SUMP              
;<B1:=            
;BASIS+OFFSET AUS 
;DEM PROGRAMM     
;(YR:=1)          
LDY #2            
JSR UBASE         
CLC               
JSR PASFET        
ADC <B1           
STA <B1           
INY               
JSR PASFET        
ADC <B1+1         
STA <B1+1         
RTS               
;-----------------
SUMT              
;BASIS+OFFSET VOM 
;STAPELSPEICHER   
;(YR:=1)          
LDY #0            
JSR UBASE         
CLC               
LDA (<T),Y        
ADC <B1           
STA <B1           
INY               
LDA (<T),Y        
ADC <B1+1         
STA <B1+1         
RTS               
;-----------------
SUMB              
;<B1:=            
;LFD.BASIS+OFFSET 
;AUS DEM PROGRAMM 
;(YR:=1)          
LDY #0            
CLC               
JSR PASFET        
ADC <B            
STA <B1           
INY               
JSR PASFET        
ADC <B+1          
STA <B1+1         
RTS               
;-----------------
UABS              
;(YR=0)           
LDA (<T),Y        
STA <B1           
INY               
LDA (<T),Y        
STA <B1+1         
RTS               
;-----------------
UCOPYA JSR AL2    
UCOPY             
;YR MUSS 1 SEIN   
LDA (<B1),Y       
STA (<T),Y        
DEY               
LDA (<B1),Y       
STA (<T),Y        
RTS               
;=================
ENDMOD1           
;=================
;                 
EXP IBUF,OBUF,    
XBSOUT,BANK,      
UCALLF,UCALL,     
UCALLAY,BASERR,   
INIT,STACKO,      
OVERFL,DIVISI,    
ERROR,ERROR1,     
IOERR,HLT,        
NEXT5,NEXT4,NEXT3,
NEXT2,NEXT1,NEXT, 
NEXT0,            
POP12,POP5,POP3,  
POP2,POPA,        
AL4,AL3,AL2,      
ALLOC,            
UBASE,SUMP,SUMT,  
SUMB,UABS,UCOPYA, 
UCOPY,ENDMOD1     
;                 
END