home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rxfiles.zip / rxshvenv.asm < prev    next >
Assembly Source File  |  1997-08-15  |  11KB  |  307 lines
  1. ;-----------------------------------------------------------------------
  2. ; rxshvenv.ASM for rxshenv.RX by ML /AT /Fe rxshvenv.RX rxshvenv.ASM
  3. ;
  4. ; Usage in a REXX script: RXSHVENV( "stem" ), sets stem.1, etc. to name
  5. ; of 1st, etc. environment variable. RESULT = stem.0 is the number of
  6. ; environment variables set. RESULT = 0 indicates errors like invalid
  7. ; stem name or no more memory to store stem.x in shared variable pool.
  8. ;
  9. ; Note: PC DOS 7 REXX allocates SHV memory under the PID of whatever
  10. ; current process (like RXSVHENV). After termination this new memory
  11. ; is freed by the OS, results are lost. To correct this misbehaviour
  12. ; RXSHVENV replaces in all OS memory blocks (except from its own PSP)
  13. ; its PID by its loader (i.e. REXX) before termination. For unknown
  14. ; reasons simply changing the current PID before calling SHVENTRY by
  15. ; undocumented OS function 50h does not work as expected.
  16. ;-----------------------------------------------------------------------
  17.  
  18. code     segment para public 'CODE'
  19.  
  20.          assume cs:code, ds:code, es:code, ss:code
  21.  
  22. RXSTR    struct
  23.  RxLen   dw     ?
  24.  RxPtr   dd     ?
  25. RXSTR    ends
  26.  
  27. PRXSTR   TYPEDEF far ptr RXSTR
  28.  
  29. SHVBLOCK struct
  30.  ShvNext dd     ?
  31.  ShvNam  RXSTR  <>
  32.  ShvVal  RXSTR  <>
  33.  ShvNamL dw     ?
  34.  ShvValL dw     ?
  35.  ShvCode db     ?
  36.  ShvRet  db     ?
  37. SHVBLOCK ends
  38.  
  39.          org    16h
  40. RXpid    dw     ?               ;_psp:0x16 parent (REXX) pid
  41.  
  42.          org    2Ch
  43. envseg   dw     ?               ;_psp:0x2C environment segment
  44.  
  45.          org    54h
  46. DOSREXX4 dd     ?               ;_psp:0x54 'REXX' signature
  47. SHVENTRY dd     ?               ;_psp:0x58 shared variable handler
  48.  
  49.          org    82h
  50. RXARGC   dw     ?               ;_psp:0x82 number of arguments
  51. RXARGV   PRXSTR ?               ;_psp:0x84 arg.s (length, pointer)
  52. RXRESULT dd     ?               ;_psp:0x88 RESULT buffer (256 bytes)
  53.  
  54.          org    100h            ;COM entry point at CS:100
  55. start:   jmp    stack           ;set stack, release memory
  56.  
  57. total    dw     (0)             ;counter environment strings
  58. stem     db     256 dup (0)     ;target stem from caller
  59. stemp    dw     (0)             ;pointer behind '.' in stem
  60. shvcom   SHVBLOCK <0,<0,0>,<0,0>,0,0,3,0>
  61.  
  62. ifndef   SHV_OKAY               ;SHV broken: works with my PID
  63. strat    dw     (0)             ;memory allocation strategy
  64. umbstate db     (0)             ;undoc.: UMB linkage 0 or 1
  65. endif   ;SHV_OKAY
  66.  
  67. ;-----------------------------------------------------------------------
  68. main     proc   near            ;enter after initialization
  69.  
  70.          cmp    word ptr DOSREXX4+2,'XX'
  71.          jne    badarg
  72.          cmp    RXARGC,1        ;missing argument
  73.          je     gotarg
  74.  
  75. badarg:  mov    al,1            ;REXX function error
  76.          jmp    exit
  77.  
  78. gotarg:  lds    si,RXARGV
  79.          mov    cx,RXSTR.RxLen[si]
  80.          jcxz   badarg          ;target stem empty
  81.          cmp    cx,250
  82.          jnbe   badarg          ;target stem too long
  83.          lds    si,RXSTR.RxPtr[si]
  84.          mov    di,offset stem  ;ES:DI stem buffer
  85.          rep    movsb           ;copy argument to stem
  86.          mov    al,'.'          ;'.' compound variable
  87.          stosb
  88.  
  89.          push   es
  90.          pop    ds              ;restore own DS
  91.  
  92. ifndef   SHV_OKAY               ;SHV broken: works with my PID
  93.          mov    ax,5800h        ;get alloc. strategy
  94.          int    21h
  95.          mov    strat,ax        ;for restore at exit
  96.          mov    ax,5802h        ;get UMB link state
  97.          int    21h
  98.          mov    umbstate,al     ;for restore at exit
  99.          mov    ax,5803h        ;set UMB link state
  100.          mov    bx,0001h        ;try to link in UMBs
  101.          int    21h
  102.          mov    ax,5801h        ;set alloc. strategy
  103.          mov    bx,0081h        ;best fit allocation
  104.          int    21h             ;81h = try UMB first
  105. endif   ;SHV_OKAY
  106.  
  107.          mov    stemp,di        ;save stem pointer
  108.          mov    es,envseg       ;ES = environment
  109.          xor    si,si
  110.  
  111. next:    mov    dx,si
  112.          mov    di,si
  113.          call   strlen
  114.          jcxz   done            ;CX = length (0 last)
  115.          add    si,cx
  116.          inc    si              ;next ES variable
  117.          mov    al,'='
  118.          repnz  scasb
  119.          mov    byte ptr es:[di-1],0
  120.  
  121.          call   inctotal        ;stem.i => stem.i+1
  122.          call   shvset          ;ES:DX var. name
  123.          cmp    cl,1
  124.          jbe    next
  125.          jmp    full            ;give up after error
  126.  
  127. done:    les    di,RXRESULT     ;ES:DI result
  128.          mov    dx,di           ;ES:DX result
  129.          mov    si,stemp        ;DS:SI total (ASCIIZ)
  130.  
  131. result:  lodsb
  132.          stosb
  133.          cmp    al,0
  134.          je     stem0           ;end of string
  135.          jmp    result
  136.  
  137. stem0:   mov    bx,stemp
  138.          mov    word ptr [bx],'0'
  139.          call   shvset          ;ES:DX result
  140.          cmp    cl,1
  141.          jbe    okay            ;stem.0 = result
  142.  
  143. full:    les    di,RXRESULT     ;invalidate result
  144.          mov    word ptr es:[di],'0'
  145.  
  146. okay:
  147. ifndef   SHV_OKAY               ;SHV broken: works with my PID
  148.          mov    es,envseg
  149.          mov    ah,49h          ;free memory block
  150.          int    21h
  151.          mov    ah,52h          ;get list of list
  152.          int    21h
  153.          mov    bx,es:[bx-2]    ;first MCB in chain
  154.          mov    cx,cs           ;CX = CS = my own PID
  155.          mov    dx,RXpid        ;DX = parent REXX PID
  156.  
  157. nextmcb: mov    es,bx
  158.          xor    bx,bx           ;ES:BX = MCB
  159.          cmp    es:[bx+1],cx    ;"my" MCB (CS = owner) ?
  160.          jne    skipmcb         ; no  -> don't patch it
  161.          mov    es:[bx+1],dx    ; yes -> patch REXX PID
  162.  
  163. skipmcb: cmp    byte ptr es:[bx+0],'Z'
  164.          je     lastmcb         ;last MCB in chain
  165.          mov    ax,es
  166.          mov    bx,es:[bx+3]    ;BX = MCB size (paras)
  167.          add    bx,ax
  168.          inc    bx              ;next MCB in chain
  169.          jmp    nextmcb
  170.  
  171. lastmcb: dec    cx
  172.          mov    es,cx           ;patch back own PSP MCB
  173.          mov    es:[bx+1],cs    ;(freed by termination)
  174.  
  175.          mov    ax,5801h        ;set alloc. strategy
  176.          mov    bx,strat        ;reset REXX strategy
  177.          int    21h             ;(sanity)
  178.          mov    ax,5803h        ;set UMB link state
  179.          mov    bl,umbstate     ;reset REXX UMB link
  180.          int    21h             ;(sanity)
  181. endif   ;SHV_OKAY
  182.  
  183.          xor    ax,ax           ;REXX function okay
  184. exit:    mov    ah,4Ch          ;terminate with RC AL
  185.          int    21h
  186.  
  187. main     endp
  188.  
  189. ;-----------------------------------------------------------------------
  190. shvset   proc   near            ;set shv variable (nam stem, val ES:DX)
  191.  
  192.          mov    word ptr shvcom.ShvVal.RxPtr+0,dx
  193.          mov    word ptr shvcom.ShvVal.RxPtr+2,es
  194.          call   strlen
  195.          mov    shvcom.ShvVal.RxLen,cx
  196.  
  197.          push   es              ;modifies AX, BX, CX, DX
  198.          push   ds              ;keep     SI, DI, DS, ES
  199.          push   ds
  200.          pop    es
  201.          mov    dx,offset stem  ;ES:DX variable name
  202.          call   strlen          ;new length for name
  203.          pop    ds
  204.          pop    es
  205.  
  206.          mov    word ptr shvcom.ShvNam.RxPtr+0,dx
  207.          mov    word ptr shvcom.ShvNam.RxPtr+2,ds
  208.          mov    shvcom.ShvNam.RxLen,cx
  209.          mov    shvcom.ShvCode,3
  210.  
  211.          mov    dx,offset shvcom
  212.          push   ds
  213.          push   dx
  214.          call   dword ptr SHVENTRY
  215.          pop    bx
  216.          pop    bx
  217.  
  218.          xor    cx,cx           ;0 set, 1 new, else bad
  219.          mov    cl,shvcom.ShvRet
  220.          ret
  221.  
  222. shvset   endp
  223.  
  224. ;-----------------------------------------------------------------------
  225. inctotal proc   near            ;increment stem counter
  226.  
  227.          mov    bx,stemp        ;modifies AX, BX, CX
  228.          inc    total
  229.  
  230.          mov    ax,total        ;AX = counter   1..9999
  231.          mov    cl,100          ;AL = quotient  0..  99
  232.          div    cl              ;AH = remainder 0..  99
  233.  
  234.          mov    ch,ah           ;save remainder
  235.          mov    cl,'0'          ;search non-zero mask
  236.          aam                    ;adjust quotient 0..99
  237.          xchg   ah,al
  238.          or     al,al           ;search for non-zero
  239.          jz     lt_1000
  240.          or     al,cl
  241.          mov    [bx],al
  242.          inc    bx
  243.          xor    cl,cl           ;clear search mask CL
  244.  
  245. lt_1000: mov    al,ah
  246.          mov    ah,ch           ;restore remainder
  247.          or     al,'0'
  248.          cmp    al,cl           ;search for non-zero
  249.          je     lt_0100
  250.          xor    cl,cl           ;clear search mask CL
  251.          mov    [bx],al
  252.          inc    bx              ;e.g. 2 of total 1234
  253.  
  254. lt_0100: mov    al,ah
  255.          aam                    ;adjust remainder 0..99
  256.          xchg   al,ah
  257.          or     al,'0'
  258.          cmp    al,cl           ;search for non-zero
  259.          je     lt_0010
  260.          mov    [bx],al
  261.          inc    bx              ;e.g. 3 of total 1234
  262.  
  263. lt_0010: mov    al,ah
  264.          or     al,'0'
  265.          mov    [bx],al         ;e.g. 4 of total 1234
  266.  
  267.          ret
  268.  
  269. inctotal endp
  270.  
  271. ;-----------------------------------------------------------------------
  272. strlen   proc   near            ;return length ASCIIZ string ES:DX
  273.  
  274.          xchg   di,dx           ;modifies AX, CX
  275.          mov    cx,di           ;keep DX, DI, ES
  276.          not    cx              ;terminate search at segment limit
  277.          push   di              ;this will work for length < 64 KB
  278.          xor    al,al
  279.          repne  scasb           ;search NUL
  280.          mov    cx,di           ;DI points behind NUL (or is NULL)
  281.          pop    di              ;restore DI
  282.          sub    cx,di           ;length inclusive NUL
  283.          dec    cx              ;length exclusive NUL
  284.          xchg   dx,di           ;restore DX
  285.          ret                    ;returns CX string length
  286.  
  287. strlen   endp
  288.  
  289. ;-----------------------------------------------------------------------
  290.          align  16
  291. stkparas equ    32              ;stack size 512 = 32 * 16
  292.  
  293. stack    label  near            ;initialise *.com program
  294.  
  295.          mov    bx,offset stack + 16 * stkparas
  296.          mov    sp,bx           ;new stack 100h above init
  297.          mov    cl,4
  298.          shr    bx,cl           ;used number of paragraphs:
  299.          mov    ah,4ah          ;modify allocated memory to
  300.          int    21h             ;needed size i.e. free rest
  301.  
  302.          jmp    main            ;current SP must be beyond
  303.  
  304. ;-----------------------------------------------------------------------
  305. code     ends
  306.          end    start           ;program entry point
  307.