🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: bit.listserv.asm370
Article #1558

Operation code...

#1558
From: marcia de oliveira cardoso
Date: Tue, 30 Jun 1992 15:37
215 lines
8780 bytes
We received a program from one of ours users that let fortran's users

to execute cms commands. This program have some commands that are unrecog-

nized to our asm language processor ( ASM H V 02 ). Can someone help us?

Here is the program:

CMD      FSTART
*=================================================================
* To execute a CMS command from within a CMS VSFORTRAN FORTRAN 77
* environment (MAX of 100 tokens)
*    Use -  CALL CMSCMD('cmdstring',RCODE,NSTACK)
*    where  'cmdstring' = CHARACTER variable or constant
*                          with value of a CMS command string
*           RCODE       = INTEGER*4 Return Code from command
*           NSTACK      = INTEGER*4 number of lines stacked as a
*                         result of this command into MAKEBUFed buffer
*=====================================================================
         ST    R1,PARMADD
         PM    MAKEBUF
         PM    SENTRIES
         ST    R15,NSTACKED       INITIAL NUMBER OF LINES IN STACK
         PM    PLISTS
         LA    R0,EPLIST
         LA    R1,PLIST
         ICM   R1,8,=X'01'        V SVC202 SYS PROG ?????
         SVC   202
         DC    AL4(1)             NO ERROR HERE
         L     R1,PARMADD
         L     R2,4(0,R1)
         ST    R15,0(0,R2)        RETURN CODE FROM COMMAND
         PM    SENTRIES
         S     R15,NSTACKED       NUMBER OF LINES STACKED BY CMD
         L     R1,PARMADD
         L     R3,8(0,R1)
         ST    R15,0(0,R3)
         FRETURN
         EJECT
MAKEBUF  PENTRY
         LA    R1,BUFMAKE
         SVC   202
         DC    AL4(1)
         PEXIT
BUFMAKE  DS    0D
         DC    CL8'MAKEBUF'
         DC    8X'FF'
         SPACE 2
SENTRIES PENTRY
         LA    R1,SENTRYS
         SVC   202
         DC    AL4(1)
         PEXIT
SENTRYS  DS    0D
         DC    CL8'SENTRIES'
         DC    8X'FF'
         SPACE 2
INITCHR  PENTRY
         L     R1,PARMADD
         LR    R3,R1
         S     R3,=F'4'           PARMADD-4
         L     R3,0(0,R3)         OFFSET TO LENGTH LIST
         L     R3,0(R3,R1)        ADDRESS OF LENGTH OF CMDSTRING
         L     R3,0(0,R3)
         ST    R3,STRGREM         REMAINING CHARS IN STRING
         L     R2,0(0,R1)         ADDRESS OF CMDSTRING
         AR    R3,R2
         ST    R3,STRGEND         ADDRESS OF CHAR LAST+1
         S     R2,=F'1'
         ST    R2,CHRPNTER        ADDRESS OF CHAR ZERO-1
         PEXIT
         SPACE 2
GETCHR   PENTRY
         IF   (CLC,STRGREM,=F'0',EQ)
           MVI  ENDSTRNG,TRUE
           MVC  CHRPNTER,STRGEND
         ELSE
           MVI   ENDSTRNG,FALSE
           L    R2,CHRPNTER
           LA   R2,1(0,R2)
           ST   R2,CHRPNTER
           MVC  CHR,0(R2)         USER GETS RESULT IN CHR
           L    R3,STRGREM
           BCTR R3,0
           ST   R3,STRGREM
           MVI  DELIM,FALSE
           DOCASE  CHR
             CASE  C'(',C')',C' '
               MVI   DELIM,TRUE
             ESAC
           ESACOD
         FI
         PEXIT
         EJECT
PLISTS   PENTRY
*=============================================================
* CREATE A PLIST OF UP TO 100 TOKENS
* CREATE EXTENDEND PLIST AS WE GO
*=============================================================
         LA    R0,PLIST
         ST    R0,PLISTPTR
         PM    INITCHR
         MVC   ARGSTART,STRGEND          IN CASE OF NO ARGUMENTS
         MVC   ARGEND,STRGEND
         PM    GETCHR
         MVI   SCANNING,TRUE
         DO    WHILE,(CLI,SCANNING,TRUE,EQ)
* PROCEED TO NEXT NON BLANK CHARACTER
           DO    WHILE,(CLI,ENDSTRNG,FALSE,EQ),AND,(CLI,CHR,C' ',EQ)
             PM    GETCHR
           OD
* IF NOT 'ENDSTRNG' WE HAVE FIRST CHARACTER OF NEXT TOKEN IN CHR
* TRANSFER UP TO 8 CHARS TO PLIST
* PARENTHESES ARE SPECIAL IN THAT ARE TO BE TREATED AS -
*  'BLANK',PARENTHESIS,'BLANK'
           IF    (CLI,ENDSTRNG,FALSE,EQ)
             IF    (CLC,PLISTPTR,=AL4(PLIST),EQ) INITIAL TOKEN ?
               MVC   CMDSTART,CHRPNTER
             FI
             IF    (CLC,PLISTPTR,=AL4(PLIST+8),EQ) INITIAL+1 TOKEN ?
               MVC   ARGSTART,CHRPNTER
             FI
             L     R4,PLISTPTR
             SR    R5,R5                     I=0
             DO    WHILE,(C,R5,=F'7',LE)  DO I=0,7
               IF    (CLI,DELIM,FALSE,EQ),AND,(CLI,ENDSTRNG,FALSE,EQ)
                 MVC   0(1,R4),CHR   NEW CHAR INTO PLIST
                 TR    0(1,R4),UPPER
                 PM    GETCHR
                 MVI   SELFDLIM,FALSE   ORDINARY TOKEN
               ELSE
                 IF   (C,R5,=F'0',EQ),AND,(CLI,CHR,C' ',NE) TOKEN=DELIM
                   MVC   0(1,R4),CHR    '(' OR ')' INTO PLIST
                   TR    0(1,R4),UPPER
                   MVI   SELFDLIM,TRUE    SELF DELIMITING TOKEN
                 ELSE
                   MVI   0(R4),C' '     BLANK INTO PLIST
                 FI
               FI
               LA    R4,1(0,R4)   INCREMENT PLIST POINTER
               LA    R5,1(0,R5)   INCREMENT TOKEN CHAR COUNTER
             OD
             ST    R4,PLISTPTR
             IF    (CLI,SELFDLIM,FALSE,EQ)
               DO  WHILE,(CLI,ENDSTRNG,FALSE,EQ),AND,
               (CLI,DELIM,FALSE,EQ)
                 PM   GETCHR        SKIP REST OF LONG 'TOKEN'
               OD
             ELSE
               PM  GETCHR   MOVE TO CHAR FOLLOWING '(' OR ')'
             FI
           FI
* ALL DONE ?
           IF  (CLI,ENDSTRNG,TRUE,EQ),OR,
               (CLC,PLISTPTR,=A(ENDPLIST),EQ)
             MVI    SCANNING,FALSE
           FI
         OD
* BUILD FENCE
         L     R4,PLISTPTR
         MVC   0(8,R4),=X'FFFFFFFFFFFFFFFF'
         PEXIT
         EJECT
PARMADD  DS    F             ADDRESS OF PARAMETER LIST FROM CALLING PGM
NSTACKED DS    F             NUMBER OF LINES STACKED BEFORE COMMAND EXD
SCANNING LOGICAL TRUE,(TRUE,FALSE)  STILL WORKING THRU' CMDSTRING
SELFDLIM LOGICAL TRUE,(TRUE,FALSE)  SELF DELIMITING TOKEN
ENDSTRNG LOGICAL TRUE,(TRUE,FALSE)  END OF CMDSTRING FOUND
CHR      DS    C             CHARACTER FROM CMDSTRING
DELIM    LOGICAL TRUE,(TRUE,FALSE)  CHR IS A DELIMETER
CHRPNTER DS    F             CURRENT POINTER INTO CMDSTRING
STRGREM  DS    F             NUMBER OF CHARS STILL IN CMDSTRING
*                            AFTER CHRPNTER
STRGEND  DS    F             POINTER TO 1 CHAR AFTER CMDSTRING
EPLIST   DS    0F            EXTENDED PLIST
CMDSTART DS    F             ADDRESS OF FIRST CHARACTER OF COMMAND
ARGSTART DS    F                          "             ARG OR = ARGEND
ARGEND   DS    F                          "            FOLLOWING PARAMS
         DC    A(0)          END OF EPLIST
PLISTPTR DS    F             POINTER INTO PLIST
PLIST    DS    100D          TOKENISED PLIST
ENDPLIST EQU   *
FENCE    DS    D             ROOM FOR FENCE IF 100 TOKENS
UPPER    DS    0X
         DC    X'000102030405060708090A0B0C0D0E0F'
         DC    X'101112131415161718191A1B1C1D1E1F'
         DC    X'202122232425262728292A2B2C2D2E2F'
         DC    X'303132333435363738393A3B3C3D3E3F'
         DC    X'404142434445464748494A4B4C4D4E4F'
         DC    X'505152535455565758595A5B5C5D5E5F'
         DC    X'606162636465666768696A6B6C6D6E6F'
         DC    X'707172737475767778797A7B7C7D7E7F'
         DC    X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F'
         DC    X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F'
         DC    X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF'
         DC    X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
         DC    X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'
         DC    X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'
         DC    X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'
         DC    X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
         EQUAL
         END


     Our questions are:

    1- What does PM (op code) mean ?
    2- Are FSTART, FRETURN, PENTRY and PEXIT  macros ?
    3- When and why use "IF THEN ELSE FI" ? Assemble?


                               Thanks for advance,

                                    Marcia - Marcia@UFRJ
                                    JACY   - JACY@UFRJ
Technical Details
Message-ID: <ASM370%92063015241832@UGA.CC.UGA.EDU>
Path: arc1-ca.pugleaf.net!sparky!uunet!paladin.american.edu!auvm!UFRJ.BITNET!MARCIA

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: fcdcb,6545d6492d5b005d,start
X-Google-Attributes: gidfcdcb,public
X-Google-ArrivalTime: 1992-06-30 07:37:22 PST
Comments: Gated by NETNEWS@AUVM.AMERICAN.EDU
Path: arc1-ca.pugleaf.net!sparky!uunet!paladin.american.edu!auvm!UFRJ.BITNET!MARCIA
Message-ID: <ASM370%92063015241832@UGA.CC.UGA.EDU>
Newsgroups: bit.listserv.asm370
Date:         Tue, 30 Jun 1992 15:37:52 BRA
Sender:       IBM 370 Assembly Programming Discussion List <ASM370@UGA.BITNET>
From:         marcia de oliveira cardoso <MARCIA@UFRJ.BITNET>
Subject:      Operation code...
Lines: 215