Return to %ugexp.m CVS log

Up to [Coherent Logic Development] / freem / contrib

Annotation of freem/contrib/%ugexp.m, revision 1.1

1.1     ! snw         1: %ugexp ; Global export utility - version 0.5.0.1
        !             2:  ; Jon Diamond - 1999-03-31
        !             3:  ;
        !             4:  w !,$t(+1),"  ",$$^%uxdat
        !             5:  ;
        !             6:  n error,device,comment
        !             7:  s error=$$init^%uxxxx,comment="",device=""
        !             8:  ;
        !             9:  k @%uwork
        !            10: %gsel s error=$$gsel^%ugxxx(%uwork) q:error<0
        !            11:  i $o(@%uwork@(""))="" s error=$$writep^%uxxxx("No globals selected") q
        !            12:  ;
        !            13: %device i device'="" s error=$$close^%ufxxx(device) i error<0 g %exit1
        !            14:  s error=$$select^%ufxxx(.device,"out")
        !            15:  i +error=-1 g %gsel
        !            16:  i error<0 g %exit1
        !            17:  ;
        !            18: %comment s error=$$readn^%uxxxx("Header comment ",.comment)
        !            19:  i +error=-1 g %device
        !            20:  ;
        !            21:  s error=$$go(device,%uwork,comment) i error<0 s a=$$error^%uxxxx(error) g %exit
        !            22:  s error=$$writep^%uxxxx("Finished")
        !            23: %exit s error=$$close^%ufxxx(device) i error<0 ; ??? if error
        !            24: %exit1 k @%uwork
        !            25:  q
        !            26:  ;
        !            27:  ; Executable entry point
        !            28:  ; Needs modifying to allow a selection mask (major changes!)
        !            29: go(device,select,comment)
        !            30:  n a,b,c,error,cnt
        !            31:  s error=$$header^%ufxxx(device,$t(+1),$g(comment)) i error<0 q error
        !            32:  s a=99999
        !            33:  f  s a=$o(@select@(a)) q:a=""  d  q:error<0
        !            34:  . s (b,c)=^(a),cnt=0 i $e(b)'="^" s (b,c)="^"_b
        !            35:  . i $e(c,$l(c))=")" s $e(c,$l(c))=""
        !            36:  . s error=$$writep^%uxxxx("Writing global - "_b)
        !            37:  . f  s b=$q(@b) q:$e(b,1,$l(c))'=c  d  q:error<0
        !            38:  . . s error=$$write^%ufxxx(device,b) q:error<0
        !            39:  . . s error=$$write^%ufxxx(device,@b)
        !            40:  . . s cnt=cnt+1
        !            41:  i error'<0 s error=$$trailer^%ufxxx(device,$t(+1))
        !            42:  q error
        !            43:  ;
        !            44:  ;
        !            45:  ; Alternative entry point with Open/Close included
        !            46: export(device,select,comment) 
        !            47:  n error
        !            48:  s error=$$open^%ufxxx(device,"out") q:error<0
        !            49:  s error=$$go(device,select,$g(comment)) q:error<0
        !            50:  s error=$$close^%ufxxx(device)
        !            51:  q
        !            52: