;*****************
;*    PCODE-2    *
;*  INTERPRETER  *
;*EINGABE/AUSGABE*
;*REAL-ARITHMETIK*
;*    MENGEN     *
;* VERSION 1.31  *
;* >>  C-64  <<  *
;*   9.12.1985   *
;*****************
ORG 4252          
;                 
;*SYSTEMVARIABLEN*
<ST     EQU $90   
<LENGTH EQU $B7   
<LOGFIL EQU $B8   
<SECOND EQU $B9   
<DEVICE EQU $BA   
<FILNAM EQU $BB   
<INDEV  EQU $99   
;LFD.EINGABEGERAET
<STRPTR EQU $22   
;FUER STRFLP      
<VAR    EQU $49   
;VARIABLENZEIGER  
;FUER REALS       
<FAC    EQU $61   
TAB     EQU $100  
;16 BYTES FUER    
;FILENAMEN BZW.   
;ASCII-ZAHL       
TABI    EQU $200  
;EINGABE-PUFFER   
;(Z.B. 80 BYTES)  
;                 
;*** VARIABLEN ***
<T      EQU 47    
<P      EQU 49    
<B1     EQU 53    
<F      EQU 57    
;ZEIGER AUF LFD.  
;FILEDESCRIPTOR   
;                 
<TP     EQU $69   
;8 BYTES (=ARG)   
;                 
;** KONSTANTEN ** 
;FILEDESCRIPTOR:  
<EOF    EQU 0     
<EOLN   EQU 2     
<STATUS EQU 4     
<FILENR EQU 5     
<BUFFER EQU 6     
;                 
<SETLEN EQU 11    
;(0..11)          
;** ARITHMETIK ** 
LDFAC   EQU $BBA2 
LDARG   EQU $BA8C 
INTFLP  EQU $B391 
VGLFLT  EQU $BC5B 
FLPINT  EQU $B1BF 
FACVAR  EQU $BBD0 
;                 
;*** ROUTINEN *** 
STRFLP  EQU $B7B5 
FLPSTR  EQU $BDDD 
TESTNR  EQU $F30F 
READST  EQU $FFB7 
FOPEN   EQU $FFC0 
FCLOSE  EQU $FFC3 
CHKIN   EQU $FFC6 
CKOUT   EQU $FFC9 
CLRCHN  EQU $FFCC 
BASIN   EQU $FFCF 
BSOUT   EQU $FFD2 
;-----------------
IOERR EQU 2195    
NEXT5 EQU 2672    
NEXT3 EQU 2672+6  
NEXT2 EQU 2672+9  
NEXT1 EQU 2672+12 
NEXT0 EQU 2695    
POP12 EQU 2716    
POP5  EQU 2716+3  
POP3  EQU 2716+6  
POP2  EQU 2716+9  
POPA  EQU 2716+11 
AL3   EQU 2740    
AL2   EQU 2740+3  
ALLOC EQU 2740+5  
SUMP  EQU 2798    
SUMT  EQU 2818    
SUMB  EQU 2838    
TRUE  EQU 3938    
FALSE EQU 3938+3  
INCT  EQU 4100    
;-----------------
USET              
;FILE-POINTER     
;SETZEN           
;AC=XR=FILENR     
LDY #0            
STY <ST           
LDA (<T),Y        
STA <F            
INY               
LDA (<T),Y        
STA <F+1          
JSR POP2          
LDY #<FILENR      
LDA (<F),Y        
TAX               
RTS               
;                 
INITT             
;<TP  :=ANFANG    
;<TP+2:=ENDE      
;(YR:=0)          
CLC               
LDA <F            
LDX <F+1          
ADC #<BUFFER      
STA <TP           
BCC INITT1        
INX               
INITT1 CLC        
LDY #0            
ADC (<T),Y        
STA <TP+2         
TXA               
STA <TP+1         
INY               
ADC (<T),Y        
STA <TP+3         
JSR POP2          
DEY               
RTS               
;                 
RDEND             
;LESEN-ENDE:      
;C=0 KEIN FEHLER  
;    AC=LETZTES   
;C=1 FEHLER       
;    AC=STATUS    
;                 
BCS RDNOK         
;XR=BYTE          
;(STATUS=0)       
;EOF   :=0        
TAX               
LDA #0            
BEQ IBUF          
;                 
RDNOK             
;EOLN:=TRUE       
;EOF :=TRUE       
;STATUS SETZEN    
LDA #1            
LDX #13           
;                 
IBUF              
;A -> EOF         
;X -> LETZTES     
;     ZEICHEN     
;EOLN,FALLS CR    
;STATUS SETZEN    
;                 
LDY #<EOF         
STA (<F),Y        
JSR READST        
LDY #<STATUS      
STA (<F),Y        
LDA #0            
LDY #<EOF+1       
STA (<F),Y        
LDY #<BUFFER+1    
STA (<F),Y        
LDY #<EOLN+1      
STA (<F),Y        
DEY               
CPX #13           
BNE IBUF1         
LDX #" "          
LDA #1            
IBUF1             
STA (<F),Y        
TXA               
LDY #<BUFFER      
STA (<F),Y        
RTS               
;                 
UBLANK0           
LDA #0            
UBLANK            
;(<T),Y-(X/A)     
;VORAUSGEHENDE    
;LEERZEICHEN      
;AUSGEBEN         
STX <TP+4         
STA <TP+5         
SEC               
LDA (<T),Y        
SBC <TP+4         
TAX               
INY               
LDA (<T),Y        
SBC <TP+5         
BCC BLANK3        
TAY               
;ANZAHL DER BLANKS
;X=L,Y=H          
LDA #" "          
CPX #0            
BEQ BLANK2        
BLANK1            
JSR BSOUT         
DEX               
BNE BLANK1        
BLANK2 DEY        
CPY #255          
BNE BLANK1        
BLANK3 JMP POP2   
;                 
GETCH             
;BASIN            
;TEST AUF FEHLER  
;EVTL. ECHO       
JSR BASIN         
TAY               
JSR READST        
BNE GETCH2        
TYA               
CMP #13           
BNE GETCH1        
LDA <INDEV        
BNE GETCH0        
;(0=> TASTATUR)   
TYA               
JSR BSOUT         
GETCH0 TYA        
GETCH1 CLC        
RTS               
GETCH2 SEC        
RTS               
;-----------------
SIC               
;                 
JSR USET          
BEQ SIC1          
JSR CHKIN         
BCS SOC1          
SIC1 JMP NEXT0    
;                 
SOC               
;                 
JSR USET          
BEQ SIC1          
JSR CKOUT         
BCC SIC1          
SOC1 JMP IOERR    
;                 
CLR               
;                 
JSR CLRCHN        
JMP NEXT0         
;                 
CLS               
;                 
JSR USET          
JSR FCLOSE        
LDA #0            
LDY #<FILENR      
STA (<F),Y        
;FUER STD.FILES   
;INPUT/OUTPUT     
JMP NEXT0         
;                 
OPN               
;TP+2:=LEN(NAME)  
;TP  :=ADR(NAME)  
LDA (<T),Y        
STA <TP+2         
JSR POP2          
LDA (<T),Y        
STA <TP           
INY               
LDA (<T),Y        
STA <TP+1         
JSR POP2          
DEY               
;(Y=0)            
LDA (<T),Y        
STA <SECOND       
JSR POP2          
LDA (<T),Y        
STA <DEVICE       
JSR POP2          
;                 
;DESKRIPTOR ADR:  
;                 
JSR USET          
LDY #0            
LDX #0            
OPN1              
CPY <TP+2         
BEQ OPN2          
LDA (<TP),Y       
STA TAB,X         
INX               
INY               
INY               
CPX #16           
BNE OPN1          
OPN2 STX <LENGTH  
LDA #[TAB         
STA <FILNAM       
LDA #]TAB         
STA <FILNAM+1     
LDX #1            
;SUCHE NEUE LOG.  
;FILENUMMER       
OPN4 STX <TP      
JSR TESTNR        
BNE OPN5          
;(0 =>BELEGT)     
LDX <TP           
INX               
BNE OPN4          
OPN5 LDA <TP      
LDY #<FILENR      
STA (<F),Y        
STA <LOGFIL       
JSR FOPEN         
BCC PUT3          
;EOF:=FALSE       
;(ST=0)           
JMP IOERR         
;                 
PUT               
;                 
JSR INITT         
PUT1 LDA (<TP),Y  
JSR BSOUT         
JSR INCT          
BNE PUT1          
PUT2 LDA #1       
DFD $2C           
PUT3 LDA #0       
;AC -> EOF        
;STATUS LESEN     
LDY #<EOF         
STA (<F),Y        
LDA #0            
INY               
STA (<F),Y        
JSR READST        
LDY #<STATUS      
STA (<F),Y        
JMP NEXT0         
;                 
GET               
;EOF:=TRUE,FALLS  
;BEIM LETZTEN     
;LESEN ST<>0      
;                 
JSR INITT         
GET1 JSR BASIN    
STA (<TP),Y       
JSR INCT          
BNE GET1          
LDY #<STATUS      
LDA (<F),Y        
BNE PUT2          
BEQ PUT3          
;-----------------
WRR               
;                 
JSR POP5          
LDA <T            
LDY <T+1          
JSR LDFAC         
LDA #5            
BNE WRI0          
;                 
WRI               
;                 
JSR POP2          
LDA (<T),Y        
STA <TP           
INY               
LDA (<T),Y        
LDY <TP           
JSR INTFLP        
LDA #2            
;                 
;DRUCKE FAC:      
;                 
WRI0 PHA          
JSR FLPSTR        
LDX #0            
WRI1 LDA TAB,X    
BEQ WRI2          
INX               
BNE WRI1          
WRI2 PLA          
TAY               
JSR UBLANK0       
LDY #0            
WRI3 LDA TAB,Y    
BEQ WREND         
TAX               
JSR BSOUT         
INY               
BNE WRI3          
;                 
WRC               
;                 
JSR POP2          
LDX #1            
LDY #2            
JSR UBLANK0       
LDY #2            
LDA (<T),Y        
DFD $2C           
;                 
WRL               
;WRITELN          
LDA #13           
TAX               
JSR BSOUT         
;                 
WREND             
;SCHREIBEN ENDE:  
;XR=LAST          
;EOF:=TRUE        
LDA #1            
JSR IBUF          
JMP NEXT0         
;                 
WRS               
;LAENGE IN BYTES! 
JSR POP2          
INY               
LDA (<T),Y        
LSR               
PHA               
DEY               
LDA (<T),Y        
ROR               
TAX               
PLA               
LDY #2            
JSR UBLANK        
;                 
CLC               
LDY #0            
LDA (<T),Y        
STA <TP           
LDY #2            
ADC (<T),Y        
STA <TP+2         
DEY               
LDA (<T),Y        
STA <TP+1         
LDY #3            
ADC (<T),Y        
STA <TP+3         
JSR POP2          
LDY #0            
WRS1 LDA (<TP),Y  
TAX               
JSR BSOUT         
JSR INCT          
JSR INCT          
BNE WRS1          
JMP WREND         
;-----------------
FLAG DFD 0        
;0 =>  RDI        
;SONST RDR        
;                 
RDR               
;                 
INY               
;                 
RDI               
STY FLAG          
LDX #0            
RDI1 JSR GETCH    
BCS RDI6          
CMP #" "          
BEQ RDI1          
CMP #13           
BEQ RDI1          
RDI4 STA TABI,X   
INX               
JSR GETCH         
BCS RDI6          
CMP #" "          
BEQ RDI5          
CMP #13           
BNE RDI4          
RDI5 CLC          
RDI6 PHP          
PHA               
LDA #13           
STA TABI,X        
;                 
JSR AL2           
LDA <T            
STA <VAR          
LDY <T+1          
STY <VAR+1        
LDA #[TABI        
STA <STRPTR       
LDA #]TABI        
STA <STRPTR+1     
TXA               
JSR STRFLP        
LDA FLAG          
BNE RDI8          
JSR UINT          
JMP RDI9          
RDI8              
JSR FACVAR        
JSR AL3           
;                 
RDI9 PLA          
PLP               
JSR RDEND         
JMP NEXT0         
;                 
RDC               
;                 
JSR GETCH         
JSR RDEND         
JSR AL2           
LDY #<BUFFER      
LDA (<F),Y        
LDY #0            
STA (<T),Y        
TYA               
INY               
STA (<T),Y        
JMP NEXT0         
;                 
RDL               
;                 
LDY #<EOLN        
LDA (<F),Y        
BNE RDL2          
RDL0 JSR GETCH    
BCS RDL1          
CMP #13           
BNE RDL0          
CLC               
RDL1 JSR RDEND    
RDL2 JMP NEXT0    
;                 
;-----------------
OPADR             
DFD $B86A-1; +    
DFD $B853-1; -    
DFD $BA2B-1; *    
DFD $BB12-1; /    
DFD $BF7D-1; ^    
;                 
DFD $BFB4-1; +/-  
DFD $BC58-1; ABS  
DFD $BF71-1; SQRT 
DFD $B9EA-1; LN   
DFD $BFED-1; EXP  
DFD $E26B-1; SIN  
DFD $E264-1; COS  
DFD $E2B4-1; TAN  
DFD $E30E-1; ATN  
;-----------------
ULOADA JSR AL2    
ULOAD LDY #4      
LOAD1 LDA (<B1),Y 
STA (<T),Y        
DEY               
BPL LOAD1         
JMP AL3           
;                 
USTORP JSR POP3   
USTORE LDY #4     
STORE1 LDA (<T),Y 
STA (<B1),Y       
DEY               
BPL STORE1        
JMP POP2          
;                 
UFLT              
;INTEGER->REAL    
;(<VAR) INDIZIERT 
JSR AL3           
LDY #1            
LDA (<VAR),Y      
TAX               
DEY               
LDA (<VAR),Y      
TAY               
TXA               
;A=H Y=L          
JSR INTFLP        
JMP FACVAR        
;                 
UINT              
;FAC->INTEGER     
;->(<VAR)         
JSR FLPINT        
LDY #0            
LDA $65           
STA (<VAR),Y      
INY               
LDA $64           
STA (<VAR),Y      
RTS               
;                 
ULDTOP            
;FAC :=TOP        
;A/Y =>SCND       
JSR POP3          
LDA <T            
LDY <T+1          
JSR LDFAC         
JSR POP5          
LDA <T            
LDY <T+1          
RTS               
;                 
UEXEC             
;BASIC-ROUTINE    
;AUFRUFEN         
LDY #0            
LDA (<P),Y        
ASL               
TAX               
LDA OPADR+1,X     
PHA               
LDA OPADR,X       
PHA               
LDA <FAC          
RTS               
;-----------------
SRL               
;L/H (LVL)        
JSR SUMP          
JSR USTORP        
JMP NEXT3         
;                 
SRS               
;STACK (LVL)      
JSR POP5          
JSR SUMT          
JSR AL2           
JSR USTORE        
JSR POP2          
JMP NEXT1         
;                 
SR0               
;L/H (LVL=0)      
JSR SUMB          
JSR USTORP        
JMP NEXT2         
;                 
SRA               
;ABSOLUT          
JSR POP5          
LDA (<T),Y        
STA <B1           
INY               
LDA (<T),Y        
STA <B1+1         
JSR AL2           
JSR USTORE        
JSR POP2          
JMP NEXT0         
;                 
LRL               
;L/H (LVL)        
JSR SUMP          
JSR ULOADA        
JMP NEXT3         
;                 
LRS               
;STACK (LVL)      
JSR SUMT          
JSR ULOAD         
JMP NEXT1         
;                 
LR0               
;L/H (LVL=0)      
JSR SUMB          
JSR ULOADA        
JMP NEXT2         
;                 
LRA               
;ABSOLUT          
LDA (<T),Y        
STA <B1           
INY               
LDA (<T),Y        
STA <B1+1         
JSR ULOAD         
JMP NEXT0         
;                 
LRC               
;5 BYTES          
LDA <P            
STA <B1           
LDA <P+1          
STA <B1+1         
JSR ULOADA        
JMP NEXT5         
;                 
FLT               
;TOP->REAL        
LDA <T            
STA <VAR          
LDA <T+1          
STA <VAR+1        
JSR UFLT          
JMP NEXT0         
;                 
FLO               
;SCND->REAL       
SEC               
LDA <T            
SBC #3            
STA <B1           
LDA <T+1          
SBC #0            
STA <B1+1         
LDY #4            
FLO1 LDA (<B1),Y  
STA (<T),Y        
DEY               
BPL FLO1          
SEC               
LDA <B1           
SBC #2            
STA <VAR          
LDA <B1+1         
SBC #0            
STA <VAR+1        
JSR UFLT          
JMP NEXT0         
;                 
INT               
;INTEGER->REAL    
JSR POP3          
LDA <T            
STA <VAR          
LDY <T+1          
STY <VAR+1        
JSR LDFAC         
JSR UINT          
JMP NEXT0         
;                 
MON               
;(INDEX)          
SEC               
LDA <T            
SBC #3            
STA <VAR          
TAX               
LDA <T+1          
SBC #0            
STA <VAR+1        
TAY               
TXA               
JSR LDFAC         
JSR UEXEC         
JSR FACVAR        
JMP NEXT1         
;                 
DYA               
;(INDEX)          
;FAC := TOP       
;ARG := SCND      
JSR ULDTOP        
STA <VAR          
STY <VAR+1        
JSR LDARG         
JSR UEXEC         
JSR FACVAR        
JSR AL3           
JMP NEXT1         
;                 
VGL               
;(MASKE)          
;BIT:       210   
;BEDEUTUNG: <=>   
;                 
JSR ULDTOP        
;A/Y =>SCND       
JSR VGLFLT        
BNE VGL1          
LDA #2            
BNE VGL3          
VGL1 BMI VGL2     
LDA #1            
DFD $2C           
VGL2 LDA #4       
VGL3 LDY #0       
AND (<P),Y        
BEQ VGL4          
;TRUE             
LDA #1            
VGL4 STA (<T),Y   
TYA               
INY               
STA (<T),Y        
JMP NEXT1         
;-----------------
                  
MASK              
DFD %00000001     
DFD %00000010     
DFD %00000100     
DFD %00001000     
DFD %00010000     
DFD %00100000     
DFD %01000000     
DFD %10000000     
;                 
UMASK             
;AC -> MASKE      
;YR -> INDEX 0..11
TAX               
LSR               
LSR               
LSR               
TAY               
CPY #<SETLEN+1    
BCS MASK1         
TXA               
AND #7            
TAX               
LDA MASK,X        
RTS               
;UEBERLAUF:       
;LEERE MASKE      
MASK1 LDA #0      
RTS               
;                 
UEMPTY            
;LEERE MENGE      
;(AB <T)          
LDY #<SETLEN      
LDA #0            
EMPTY1            
STA (<T),Y        
DEY               
BPL EMPTY1        
RTS               
;                 
UISET             
;<T ->1. OPERAND  
;<TP->2. OPERAND  
;Y:=SETLEN        
LDA #246          
JSR POPA          
LDA <T            
STA <TP           
LDA <T+1          
STA <TP+1         
JSR POP12         
LDY #<SETLEN      
RTS               
;-----------------
NUL               
;LEERE MENGE      
JSR AL2           
JSR UEMPTY        
JMP GS11          
;                 
LSA               
;                 
LDA (<T),Y        
STA <TP           
INY               
LDA (<T),Y        
STA <TP+1         
LDY #<SETLEN      
LSA1 LDA (<TP),Y  
STA (<T),Y        
DEY               
BPL LSA1          
BMI GS11          
;                 
SSA               
;                 
JSR POP12         
LDA (<T),Y        
STA <TP           
INY               
LDA (<T),Y        
STA <TP+1         
JSR AL2           
LDY #<SETLEN      
SSA1 LDA (<T),Y   
STA (<TP),Y       
DEY               
BPL SSA1          
LDA #252          
JSR POPA          
JMP NEXT0         
;                 
GS1               
;TOP -> SET       
LDA (<T),Y        
PHA               
JSR UEMPTY        
PLA               
JSR UMASK         
ORA (<T),Y        
STA (<T),Y        
GS11 LDA #10      
JSR ALLOC         
JMP NEXT0         
;                 
GS2               
;SCND..TOP -> SET 
;**GEAENDERT!     
LDA (<T),Y        
STA <TP+1         
JSR POP2          
LDA (<T),Y        
STA <TP           
JSR UEMPTY        
GS21 LDA <TP+1    
CMP <TP           
BMI GS11          
JSR UMASK         
ORA (<T),Y        
STA (<T),Y        
DEC <TP+1         
JMP GS21          
;                 
UNI               
;                 
JSR UISET         
UNI1 LDA (<T),Y   
ORA (<TP),Y       
STA (<T),Y        
DEY               
BPL UNI1          
BMI GS11          
;                 
DIF               
;                 
JSR UISET         
DIF1 LDA (<TP),Y  
EOR #$FF          
AND (<T),Y        
STA (<T),Y        
DEY               
BPL DIF1          
BMI GS11          
;                 
ISC               
;                 
JSR UISET         
ISC1 LDA (<TP),Y  
AND (<T),Y        
STA (<T),Y        
DEY               
BPL ISC1          
BMI GS11          
;                 
SEQ               
;                 
JSR UISET         
SEQ1 LDA (<T),Y   
CMP (<TP),Y       
BNE FALSE^        
DEY               
BPL SEQ1          
;                 
TRUE^ JMP TRUE    
FALSE^ JMP FALSE  
;                 
SLE               
;                 
JSR UISET         
SLE1 LDA (<TP),Y  
EOR #$FF          
AND (<T),Y        
BNE FALSE^        
DEY               
BPL SLE1          
BMI TRUE^         
;                 
SGE               
;                 
JSR UISET         
SGE1 LDA (<T),Y   
EOR #$FF          
AND (<TP),Y       
BNE FALSE^        
DEY               
BPL SGE1          
BMI TRUE^         
;                 
INN               
;                 
JSR POP12         
LDA (<T),Y        
JSR UMASK         
INY               
INY               
AND (<T),Y        
BEQ FALSE^        
BNE TRUE^         
;                 
START             
DFD OPN-1,CLS-1   
DFD SIC-1,SOC-1   
;                 
DFD CLR-1,PUT-1   
DFD GET-1,RDI-1   
DFD RDC-1,RDL-1   
DFD WRI-1,WRC-1   
;                 
DFD WRL-1,WRS-1   
DFD WRR-1,RDR-1   
DFD LRC-1,FLT-1   
DFD FLO-1,INT-1   
;                 
DFD MON-1,DYA-1   
DFD VGL-1,SRL-1   
DFD SRS-1,SR0-1   
DFD SRA-1,LRL-1   
;                 
DFD LRS-1,LR0-1   
DFD LRA-1,SSA-1   
DFD LSA-1,GS1-1   
DFD GS2-1,NUL-1   
;                 
DFD UNI-1,ISC-1   
DFD DIF-1,INN-1   
DFD SGE-1,SLE-1   
DFD SEQ-1         
LAST