Beispiele

Es soll die folgende Funktion in Assembler implementiert werden:

XSUBSTRING[2/3](STRING = <string_ausdruck>
                ,START = <arithm_ausdruck>
                ,LENGTH = <arithm_ausdruck> / *REST-LENGTH
               )

Assembler-Schnittstelle

Titel der Funktion:	XSUBSTRING2
Entry:	XSUBEX2
Eingabedaten:	STRING, START POSITION, LENGTH
Ausgabedaten:	SUBSTRING

Erster Schritt : Syntaxbeschreibung

BIFDESC    NAME='XSUBSTRING2',                -
           ENTRYN=(*CSECT,XSUBDEF2),          -
           PARLIST=                           -
            ((STRING,*STRING),                -
              (START,*INTEGER,1),             -
              (LENGTH,*INTEGER,*REST-LENGTH,  -
               (*REST-LENGTH))                -
              ),                              -
           PARFORM=BY-VALUE,
           VALTYPE=*STRING
END

Zweiter Schritt: Ausführungsprogramm

XSUBEX2    CSECT
XSUBEX2    AMODE   ANY
XSUBEX2    RMODE   ANY
           STM     14,12,12(13)       Speichere die Register des Aufrufers
           BASR    10,0               R10: Basisregister
           USING   *,10
           USING   DSMDL1,4
           USING   DSMDL2,5
*
           L       1,0(0,1)           R1 › a(p1)   ?? R1=a(p1)
*
           LA      5,48(1)            R5 › fünftes Element der Operandenliste
                                        (z.B. RC)
           L       5,4(5)             R5 › RC
           MVC     0(9,5),OKRC        Set RC = OK
*
           LA      4,0(1)             bei R4 beginnt Operandenliste
           L       6,BIF1VLG          R6: Länge des Operanden STRING
           L       7,BIF1VPT          R7: Adresse des Operanden STRING
           LTR     6,6                Ist die Länge von STRING=0?
           BE      MSGNULL            Sende eine Meldung NILL_STRING
*
           LA      4,12(1)            bei R4 folgt zweites Element der 
                                       Operandenliste (z.B. START)
           LA      2,1(0,0)           R2 = 1
           L       8,BIF1VPT          R8: Adresse des Werts START
           L       8,0(8)             R8: Wert von START
           CR      8,2                Wenn START < 1
           BL      MSGBOUN            Sende Meldung OUT_OF_BOUNDS
           CR      8,6                Wenn START > Länge von STRING
           BH      MSGBOUN            Sende Meldung OUT_OF_BOUNDS
*
           LA      4,24(1)            bei R4 folgt drittes Element der 
                                       Operandenliste (z.B. LENGTH)
*                                      R3 = Länge von STRING - START + 1
           LA      3,1(0,0)           R3 = 1
           AR      3,6                R3 = R3 + Länge von STRING
           SR      3,8                R3 = R3 - START
           CLI     BIF1VTY,BIF1INT
           BE      LENINT
LENKEYW    DS      OH
*                                      *REST-LENGHT ist gesucht
           LR      9,3
           B       @0001
LENINT     DS      OH
*                                      LENGTH = *INTEGER
           L       9,BIFTVPT          R9: Adresse des Werts LENGHT
           L       9,0(9)             R9: Wert von LENGTH
           CR      9,2                Wenn LENGTH < 1
           BL      MSGBOUN            Sende Meldung OUT_OF_BOUNDS
           CR      9,3                Wenn LENGTH < REST-LENGTH
           BNH     @0001              Dann ok
           LR      9,3                LENGTH abgeschnitten 
           MVC     0(9,5),TRUNCRC     Setze RC = TRUNCATED
@0001      DS      OH
                                       Berechne den Funktionswert
           LA      4,36(1)            bei R4 folgt viertes Element der 
                                       Operandenliste (z.B. FUNCTION_VALUE)
           L       6,BIF1VPT          R6 : Funktionwertadresse
           AR      8,7                R8 = Adresse von STRING + START
           SR      8,2                R8 = R8-1
           LR      7,9                R7 = Länge des Funktionswerts
           ST      7,BIF1VLG
           MVCL    6,8                Kopiere in Funktionswert
           B       RETURN
*
MSGNULL    MSG7X   MF=E,PARAM=NULLPL
           MVC     0(9,5),NULLRC      Setze RC = NULL_STRING
           B       RETURN
*
MSGBOUN    MSG7X   MF=E,PARAM=BOUNDPL Setze RC = OUT OF BOUNDS
           MVC     0(9,5),BOUNDRC
*
RETURN     LM      14,12,12(13)       Register (Aufrufer) zurückschreiben
           BR      14                 Zurück zum Aufrufer
OKRC       DC      XL1'00'
           DC      XL1'00'
           DC      CL7'CMD0001'
TRUNCRC    DC      XL1'02'
           DC      XL1'00'
           DC      CL7'SDP0414'
BOUNDRC    DC      XL1'00'
           DC      XL1'01'
           DC      CL7'SDP0412'
NULLRC     DC      XL1'00'
           DC      XL1'01'
           DC      CL7'SDP0411'
           DS      OF
NULLPL     MSG7X   MF=L,ID=SDP0411
BOUNDPL    MSG7X   MF=L,ID=SDP0412
           DS      OF
DSMDL1     BIFMDL1 MF=D
           DS      OF
DSMDL2     BIFMDL2 MF=D
           END

Dritter Schritt: BIFTAB aktualisieren

BIFTAB     CSECT
           .....
XSUBSTR2   BIFDEF   MF=L,NAME=XSUBSTRING2,SYNTAX=XSUBDEF2,CODE=XSUBEX2
           .....
           END