[Info-vax] Very simple DCL question

[Arne Vajhøj]

On 12/28/2022 9:58 PM, Arne Vajhøj wrote:
> On 12/28/2022 10:49 PM, VAXman- at SendSpamHere.ORG wrote:
>> In article <toisqe$p0r$1 at gioia.aioe.org>, =?UTF-8?Q?Arne_Vajh=c3=b8j?= 
>> <arne at vajhoej.dk> writes:
[Macro-32 omitted]
>> Good grief!  I needed an airsick bag and bottle of Tums after reading 
>> that.
> 
> That bad? Hmmm.

You will probably not like the zweiter sehr verbesserte ausgabe either.

         .title  realp
         $SSDEF
         $DSCDEF
SPACE=32
PRC_C_CMDBUFSIZ=4097 ; 1025 on VAX
PRC$W_PROCLEVEL=56
         .macro  if_end_command,lbl
         cmpl    r3,r4
         bgeq    lbl
         .endm
         .macro  if_space,lbl
         cmpb    (r3),#SPACE
         beql    lbl
         .endm
         .psect  $PDATA quad,pic,con,lcl,shr,noexe,nowrt
nomsg:  .ascid  "This is not run from first level COM file so no action 
taken"
         .psect  $LOCAL quad,pic,con,lcl,noshr,noexe,wrt
copy1:  .blkb   PRC_C_CMDBUFSIZ
copy2:  .blkb   PRC_C_CMDBUFSIZ
pnam:   .ascid  "P1"
pval:   .blkw   1
         .byte   DSC$K_DTYPE_T
         .byte   DSC$K_CLASS_S
         .address pvala
pvala:  .blkb   256
         .psect  $CODE quad,pic,con,lcl,shr,exe,nowrt
         .entry  realp,^m<r2,r3,r4,r5,r6>
; phase 1 : grab copy of recall buffer
;   out  r0 = command length
;   out  r1 = command address
;   temp r2 & r3 for working storage
;   temp r6 = pointer recall buffer P1 space
         movl    #CTL$AG_CLIDATA,r6
         movl    W^PPD$L_PRC(r6),r6
         cmpw    W^PRC$W_PROCLEVEL(r6),#1 ; test if run from first level 
COM file
         bneq    nogood
         movc3   #PRC_C_CMDBUFSIZ,W^PRC_G_COMMANDS(r6),copy1 ; make two 
copies of data to handle circular buffer
         movc3   #PRC_C_CMDBUFSIZ,W^PRC_G_COMMANDS(r6),copy2
         movab   W^PRC_G_COMMANDS(r6),r2 ; find address next command
         movl    W^PRC_L_RECALLPTR(r6),r3
         subl3   r2,r3,r1
         movab   copy2,r6
         addl2   r6,r1
         subl2   #2,r1                   ; find length current command
         cvtwl   (r1),r0
         subl2   r0,r1                   ; find address current command
; phase 2 : parse
;   in   r0 = command length
;   in   r1 = command address
;   temp r2 = parameter number
;   temp r3 = current character in command
;   temp r4 = end of command
;   temp r5 = current Pn output character
         movl    r1,r3                   ; current character = first 
character
         addl3   r0,r3,r4                ; find end of command
; skip command itself
100$:   if_end_command done
         if_space start
         incl    r3                      ; skip if not space
         brb     100$
; process parameters
start:  incl    r3                      ; skip space between command 
itself and P1
         movl    #1,r2                   ; n = 1
200$:   if_end_command done
         movw    #0,pval                 ; reset parameter data
         movab   pvala,r5
300$:   if_end_command 500$
         if_space 400$
         incw    pval                    ; add to parameter data
         movb    (r3)+,(r5)+
         brb     300$
400$:   incl    r3                      ; skip space between Pn and Pn+1
500$:   pushl   #0
         pushab  pval                    ; set Pn symbol
         pushab  pnam
         calls   #3,G^LIB$SET_SYMBOL
         incb    pnam+9                  ; update Pn -> Pn+1
         incl    r2                      ; n = n + 1
         cmpl    r2,#8                   ; while n <= 8
         bleq    200$
         brb     done
; message due to to not being run from first level COM file
nogood: pushab  nomsg
         calls   #1,G^LIB$PUT_OUTPUT
; all done
done:   movl    #SS$_NORMAL,r0
         ret
         .end    realp

Arne