File: SBEWER.MA of Tape: Various/Decus/decus-2
(Source file text) 

.TITLE	L I N K - L I B R A R Y
.SBTTL SBEWER:BEWERTUNG EINES STRINGS


.INCLUDE SYS:MACLIB.MA

/******** SBEWER ******
/26-11-81 RMO,11-5-83 VH,12.8.83 VH
/(L,AC)=?,?
/CIF SBEWER
/JMS SBEWER
/FELD DES GESAMTSTRINGS
/ADRESSE DES GESAMTSTRINGS
/FELD STRINGDEFINITONSTABELLE
/ADRESSE STRINGDEFINITIONSTABELLE
/FELD DER SUBROUTINENTABELLE
/ADRESSE DER    -"-
/(L,AC)=0,0
/1.RUECKSPRUNG:BEI FEHLER 
/2.RUECKSPRUNG:STRING NICHT DEFINIERT
/3.RUECKSPRUNG:NUR EINE ZIFFER EINGEGEBEN
/4.RUECKSPRUNG:NORMAL
/************************


/UNTERPROGRAMM ZUR BEWERTUNG EINES STRINGS,DER ALS BEFEHLSEINGABE DIENEN SOLL.
/DER STRING MUSS FOLGENDES FORMAT HABEN:
/TEILSTR.1/TRENNZ./TEILSTR.2/TRENNZ./....../TEILSTR.6/RETURN ODER ESCAPE
/EIN TEILSTRING KANN SEIN:

/A) BUCHSTABENSTRING AUS MAX 6 BUCHSTABEN
/FOLGENDE ZEICHEN WERDEN WIE BUCHSTABEN BEHANDELT:
/:,;,<,=,>,?,[,\,],^,_,!,",#,$,%,&,',(,),*,.,/

/B) ZAHLENSTRING AUS 1 VORZ. UND MAX 6 ZIFFERN.
/UEBERSCHREITEN DER MAX TEILSTRINGZAHL (6) SOWIE
/DER MAX BUCHSTABEN- U. ZIFFERNANZAHL (6) FUEHRT ZUR
/FEHLERMELDUNG MIT ENTSPRECHENDEM HINWEIS.
/ALS TRENNUNGSZEICHEN DIENEN "SPACE","KOMMA" ODER "-"
/JEDER TEILSTRING WIRD MIT EINER KENNUNG,BESTEHEND AUS DEN BEIDEN
/WORTEN KENNH SOWIE KENNL UND SEINEM BEARBEITETEN INHALT BESTEHEND
/AUS DEN BEIDEN WORTEN BUFFH UND BUFFL,ABGELEGT.

/KENNH : BIT 0:   0-STRING
/                 1-ZAHL
/        BIT 1:   1-NEGATIVE ZAHL
/                 0-POSITIVE ZAHL
/        BIT 9-11:STRINGLAENGE (OHNE TRENNZEICHEN)
/KENNL : ANFANGSADRESSE DES TEILSTRINGS IM GESAMTSTRING
/BUFFH : UEBERTRAG EINER ZAHL
/BUFFL : ZAHL ODER STRINGNUMMER AUS STRINGTABELLE

/ZUM ERSTEN BUCHSTABENSTRING WIRD DIE ADRESSE UND DAS FELD DER ENTSPRECHENDEN
/SUBROUTINE IN SUBADR UND SUBFLD GEMERKT
/BEIDE VARIABLE SIND GLOBAL
OPEN	"BEWER","F"

.EXTERNAL SAM10,STRBEW
.ENTRY	SBEWER

	DEFMER STRPR,PNTR1$,STDEF$,STDE$,SUBRF$,SUBRA$

SBEWER,	OPNSUB RT:AUSGR$,BEWE1,STRPR,STDEF$,STDE$,SUBRF$,SUBRA$

	DCAADD PNTR1$,AC+(STCNT)
	DCAADD STRDEF,AC+STDEF$
	DCAADD STRDE,AC+STDE$
	DCAADD SUBROF,AC+SUBRF$
	DCAADD SUBROU,AC+SUBRA$

BEIN$:	DCA I PNTR1$		/ALLE VARIABLE UND BUFFER AUF 0 SETZEN
	INC PNTR1$,0
	VERGLE PNTR1$,(STRBUF+7),NE:BEIN$
/-------------------------------------------------------------------

BEWE1:	V			/ZEICHEN AUS DEM STRINGBUFFER
	TAD I STRPR
	CDF .FLD
	DCA ZEICHE			

	INC STRPR,0
	TAD ZEICHE

	VERZWG	<"+>	,<"->	,<",>	,<SPACE>,<CR>	,<ESC>
	SPRUNG	VORZPL	,VORZEI	,STRINB	,STRINB	,STRIB1	,STRIB1

	BERAUS AC,<"0>,<"9>,ZIFFER
	BERAUS AC,<"!>,<"_>,BUCHST

	JMP FEHLER
/----------------------------------------------------------------------

BEWEI:	INC STCNT,0		/NAECHSTER STRING
	RESMER CLA:BUCNT,ZICNT
	JMX MERK,EQ:BEWE1


/------------------- RUECKSPRUNG --------------------------------------

	TAD SUBCOU	/STRING EINGEGEBEN ?
	SZA CLA
	INC SBEWER,0	/STRING EINGEGEBEN
	INC SBEWER,0	/NUR ZAHLEN EINGEGEBEN
FEHL3:	INC SBEWER,0	/STRING NICHT GEFUNDEN
FEHLER:	CAL		/EINGABEFEHLER
AUSGR$:	V
	JMP I SBEWER

CLOSE "BEWER"
.SBTTL STRINB:TEILSTRINGBELANDLUNG

OPEN "BEWE1","F",SBEWER

	DEFMER STRNR$,PNTR1$,PNTR2$,PNTR3$,SUBROU

STRIB1,	CLA IAC
	DCA MERK		/RETURN EINGEGEBEN

STRINB:	RESMER CAL:ZICNT,VORZM,BUCHME,ZIFFME,STRMR

	TAD ZICNT
	SZA CLA
	JMP STRI4$		/ZAHL EINGEGEBEN
	TAD BUCNT
	SNA CLA
	JMP BEWEI		/NUR RETURN EINGEGEBEN

	TAELS ZEICHE,STRBUF,BUCNT	/STRING,TRENNZEICHEN SPEICHERN

	CALL STRBEW		/STRING SUCHEN
STRDEF:	V			/STRINGDEFINITONSTABELLE
STRDE:	V
	JMP FEHL3		/STRING NICHT GEFUNDEN
	DCA STRNR$		/STRINGNUMMER

	TAELS STRNR$,BUFFL,STCNT	/BUFFL(STCNT):=STRINGNUMMER

	JMX AC+SUBCOU,NE:STRI4$		/SCHON EINE SUBROUTINE GEMERKT ?

SUBROF:	V
	TAD I SUBROU
	DCA PNTR1$			/SUBROUTINENANZAHL
	DCAADD PNTR2$,AC+SUBROU,STRNR$
	TAD I PNTR2$
	DCA PNTR3$
	DCAADD PNTR2$,AC+PNTR2$,PNTR1$
	TAD I PNTR2$
	CDF SUBADR
	DCA SUBADR		/SUBADR:=SUBROUTINENADRESSE
	TAD PNTR3$
	DCA SUBFLD		/SUBFLD:=SUBROUTINENFELD
	CDF .FLD

	CLA IAC
	DCA SUBCOU

STRI4$:	VERGLE AC+(5),STCNT,NE:STRI2$	/MEHR ALS 5 STRINGS ?

	VERGLE AC+ZEICHE,(CR),NE:FEHLER	/JA

/KENNUNG SETZEN

STRI2$:	DCAADD PNTR3$,AC+(KENNH),STCNT
	DCAADD <I PNTR3$>,<-ANFANG>,STRPR,<I PNTR3$>	/KENNH SETZEN

	DCAADD PNTR1$,AC+(BUFFH),STCNT
	DCAADD PNTR2$,AC+(BUFFL),STCNT

	CAL
	TAD I PNTR3$
	RTL
	CLA
	SNL			/ZIFFER ?
	JMP BEWEI		/NEIN
	TAD I PNTR1$
	CMA
	DCA I PNTR1$		/BUFFH SETZEN
	TAD I PNTR2$
	CLL CMA IAC
	SZL
	INC <I PNTR1$>,0
	DCA I PNTR2$		/BUFFL SETZEN

	JMP BEWEI		/RUECKSPRUNG



CLOSE "BEWE1"

.SBTTL BUCHST:BUCHSTABENBEHANDLUNG
.NOLIST MEB


OPEN	"BUCHST","F",SBEWER


BUCHST,	RESMER CAL:BUCHME

	JMX AC+STRMR,NE:BUCH1$		/STRINGANFANG ?
	INC STRMR			/JA
	CLA CMA
	TAD STRPR
	TAELS AC,KENNL,STCNT		/KENNL(STCNT):=ANFANGSADRESSE
	DCAADD ANFANG,AC+STRPR

BUCH1$:	JMX AC+VORZM,NE:FEHLER		/VORZEICHEN ?
	JMX AC+ZIFFME,NE:FEHLER		/ZIFFER ?

	VERGLE AC+(6),BUCNT,EQ:FEHLER	/MEHR ALS 6 BUCHSTABEN ?

	TAELS ZEICHE,STRBUF,BUCNT	/BUCHSTABE NACH STRBUF

	INC BUCNT,0
	INC BUCHME

	JMP BEWE1			/NAECHSTES ZEICHEN HOLEN


CLOSE	"BUCHST"

.SBTTL VORZEI:VORZEICHENBEHANDLUNG


OPEN	"VORZEI","F",SBEWER


	DEFMER PNTR3$

VORZEI,	JMX AC+BUCHME,NE:STRINB		/"-" WIRD ALS TRENNZEICHEN
	JMX AC+ZIFFME,NE:STRINB		/ERKANNT

VORZPL:	JMX AC+VORZM,NE:FEHLER

	INC VORZM,0

	JMX AC+BUCHME,NE:FEHLER
	JMX AC+ZIFFME,NE:FEHLER

	DCAADD PNTR3$,AC+(KENNH),STCNT

	VERGLE AC+ZEICHE,<"+>,EQ:VORZ2$

VORZ1$:	TAD (2000)

VORZ2$:	DCAADD <I PNTR3$>,<AC+I PNTR3$>	/KENNH:=2000
	DCAADD ANFANG,AC+STRPR
	CLA CMA
	TAD STRPR
	TAELS AC,KENNL,STCNT		/KENNL:=ANFANGSADRESSE

	JMP BEWE1			/NEUE ZIFFER HOLEN


CLOSE	"VORZEI"


.SBTTL ZIFFER:ZIFFERNBEHANDLUNG


OPEN	"ZIFFER","F",SBEWER


	DEFMER PNTR3

ZIFFER,	RESMER CAL:ZIFFME

	JMX AC+STRMR,NE:ZIFF2$		/ZIFFERNANFANG ?
	INC STRMR			/JA

	JMX AC+VORZM,NE:ZIFF1$		/NEGATIVE ZAHL ?

	DCAADD ANFANG,AC+STRPR		/NEIN
	CLA CMA
	TAD STRPR
	TAELS AC,KENNL,STCNT		/KENNL(STCNT):=STRPR-1

ZIFF1$:	TAELL AC,KENNH,STCNT
	TAD (4000)
	TAELS AC,KENNH,STCNT

ZIFF2$:	JMX AC+BUCHME,NE:FEHLER		/BUCHSTABE ?

	INC ZICNT

	VERGLE AC+(7),ZICNT,EQ:FEHLER

	DCAADD PNTR1,AC+(BUFFH),STCNT
	DCAADD ZEICHE,AC+ZEICHE,-"0
	DCAADD PNTR2,AC+(BUFFL),STCNT

	CALL SAM10,<CDF BUFFH>			/ASCII-ZIFFER --> OCTAL ZIFFER
PNTR1:	0
PNTR2:	0

	DCAADD <I PNTR2>,ZEICHE,<I PNTR2>	/BUFFL:=BUFFL+ZEICHEN
	SZL					/UEBERTRAG ?
	INC <I PNTR1>				/JA

	INC ZIFFME

	JMP BEWE1				/NAECHSTE ZIFFER LESEN
	

CLOSE	"ZIFFER"

.SBTTL DATEN :DATEN UND VARIABLE FUER BEWER


OPEN	"SBEWME","D",SBEWER



.ENTRY	STRMU,KENNH,KENNL,BUFFH,BUFFL,STRBUF


STCNT,	V
STRMR,	V
VORZM,	V
ZEICHE,	V
BUCNT,	V
ZICNT,	V
BUCHME,	V
ZIFFME,	V
ANFANG,	V
SUBCOU,	V
MERK,	V
KENNH,	ZBLOCK 6		
KENNL,	ZBLOCK 6
BUFFH,	ZBLOCK 6
BUFFL,	ZBLOCK 6
STRBUF,	ZBLOCK 7

CLOSE	"SBEWME"

	ENDPR