home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume4 / vms-vi-2 / part02 < prev    next >
Encoding:
Internet Message Format  |  1989-02-03  |  18.0 KB
  1. Path: xanth!mcnc!gatech!bloom-beacon!bu-cs!mirror!necntc!ncoast!allbery
  2. From: gregg@a.cs.okstate.edu (Gregg Wonderly)
  3. Newsgroups: comp.sources.misc
  4. Subject: v04i093: TPUVI for VMS part 2 of 17
  5. Message-ID: <8809212052.AA07298@uunet.UU.NET>
  6. Date: 26 Sep 88 01:47:27 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Reply-To: gregg@a.cs.okstate.edu (Gregg Wonderly)
  9. Lines: 927
  10. Approved: allbery@ncoast.UUCP
  11.  
  12. Posting-number: Volume 4, Issue 93
  13. Submitted-by: "Gregg Wonderly" <gregg@a.cs.okstate.edu>
  14. Archive-name: vms-vi-2/Part02
  15.  
  16. $ show default
  17. $ if f$search("SRC.DIR;1") .eqs. "" then -
  18.      CREATE/LOG/DIRECTORY [.SRC]
  19. $ write sys$output "Creating [.SRC]TPUSUBS.MAR"
  20. $ create [.SRC]TPUSUBS.MAR
  21. $ DECK/DOLLARS="*$*$*EOD*$*$*"
  22.         .TITLE    TPUSUBS
  23.  
  24. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  25. ;
  26. ;    This file contains TPU CALL_USER support routines for VI.
  27. ;
  28. ;    Written by Gregg Wonderly, June, 1987
  29. ;
  30. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  31.  
  32.         $ssdef
  33.         $rmsdef
  34.         $lnmdef
  35.         $iodef
  36.         $qiodef
  37.         $trmdef
  38.         $ttdef
  39.          $dcdef
  40.         $jpidef
  41.         $dvidef
  42.         $prcdef
  43.  
  44. TPU_CWD=1
  45. TPU_TRNLNM_JOB=2
  46. TPU_TRNLNM_PROC=3
  47. TPU_TRNLNM_SYS=4
  48. TPU_TRNLNM_GROUP=5
  49. TPU_GETMSG=6
  50. TPU_SET_SYSDISK=7
  51. TPU_SLEEP=8
  52. TPU_PASTHRU_ON=9
  53. TPU_PASTHRU_OFF=10
  54.  
  55. DEBUG = 0
  56.  
  57.         .psect    data,rd,wrt,noexe,pic
  58.  
  59. ;+ ---
  60. ;
  61. ;- ---
  62.         .MACRO    DEBUG,str
  63.         .IF NE DEBUG
  64.         pushab    str
  65.         calls    #1,g^lib$put_output
  66.         .ENDC
  67.         .ENDM
  68.  
  69. ;+ ---
  70. ;
  71. ;- ---
  72.         .MACRO    trnlnm_item,code,len,bufaddr,retlenaddr
  73.         .WORD    len
  74.         .WORD    code
  75.         .ADDRESS -
  76.             bufaddr
  77.         .ADDRESS -
  78.             retlenaddr
  79.         .ENDM
  80.  
  81. ;+ ---
  82. ;
  83. ;- ---
  84.         .MACRO    put_item,buf,code,len,bufaddr,retlenaddr
  85.         MOVW    len,buf
  86.         MOVW    code,buf+2
  87.         MOVAL    bufaddr,buf+4
  88.         MOVAL    retlenaddr,buf+8
  89.         .ENDM
  90. ;+ ---
  91. ;
  92. ;- ---
  93. iosb:
  94.         .quad    0
  95.  
  96. sysc_descr:
  97.         .ASCID    /SYS$COMMAND/
  98.  
  99. iochan:
  100.         .word    0
  101.  
  102. newchar_buf:
  103.         .blkl    3
  104. newchar_buf_len = .-newchar_buf
  105. ;
  106. tempchar_buf:
  107.         .blkb    newchar_buf_len
  108. ;
  109. par_settings:
  110.         .long    0
  111.  
  112. tt_descr:
  113.         .ASCID    /TT:/
  114. job_descr:
  115.         .ASCID    /LNM$JOB/
  116. sys_descr:
  117.         .ASCID    /LNM$SYSTEM/
  118. proc_descr:
  119.         .ASCID    /LNM$PROCESS/
  120. group_descr:
  121.         .ASCID    /LNM$GROUP/
  122. sysdisk_descr:
  123.         .ASCID    /SYS$DISK/
  124.  
  125. itemlist:
  126.         trnlnm_item    0,0,0,0
  127. itemlist_2:
  128.         trnlnm_item    0,0,0,0
  129.         .long        0
  130.  
  131. msgnum:
  132.         .long    0
  133. stat:
  134.         .long    0
  135. i_parm_descr:
  136.         .blkb    8
  137. i_res_descr:
  138.         .blkb    8
  139. i_parm:
  140.         .blkb    512
  141. i_res:
  142.         .blkb    512
  143.  
  144. timebuf:
  145.         .long    0
  146.         .long    0
  147.  
  148. dummy:
  149.         .long    0
  150.  
  151. tenths=-1000000
  152.  
  153.         .psect    code,exe,rd,nowrt,pic
  154. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  155. ;
  156. ;
  157. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  158.  
  159.         .entry    sleep,^m<r2,r3,r4,r5,r6>
  160.         movl    4(ap),r0
  161.         mull3    r0,#tenths,r1
  162.         movl    r1,timebuf
  163.         movl    #-1,timebuf+4
  164.         $schdwk_s -
  165.             daytim=timebuf
  166.         blbc    r0,10$
  167.         $hiber_s
  168.         blbs    r0,20$
  169. 10$:
  170.         pushl    r0
  171.         calls    #1,g^lib$signal
  172. 20$:
  173.         ret
  174. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  175. ;
  176. ;
  177. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  178.  
  179.         .entry    atoi,^m<r2,r3,r4,r5>
  180.         movl    4(ap),r0        ;Get the descriptor address
  181.         clrl    r1            ;Clear the accumulator
  182.         movl    4(r0),r2        ;Get the string address
  183.         cvtwl    (r0),r0            ;Get the length
  184. 10$:
  185.         mull2    #10,r1            ;multiply by 10
  186.         cvtbl    (r2)+,r3
  187.         addl3    r3,#-48,r4        ;Add in digit
  188.         addl    r4,r1
  189.         sobgtr    r0,10$
  190.         movl    r1,r0
  191.         ret
  192.  
  193. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  194. ;
  195. ;
  196. ;
  197. ;
  198. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  199.  
  200.         .entry    tpu$calluser,^m<r2,r3,r4,r5>
  201.  
  202.         movl    #512,i_res_descr    ;Build result descriptor
  203.         movab    i_res,i_res_descr+4
  204.  
  205.         movl    #512,i_parm_descr    ;Build parameter copy descriptor
  206.         movab    i_parm,i_parm_descr+4
  207.  
  208.         pushl    8(ap)            ;Make a copy of the parameter
  209.         pushab    i_parm_descr
  210.         calls    #2,g^str$copy_dx
  211.  
  212.         pushab    dummy            ;Set the length of the string
  213.         pushab    i_parm_descr
  214.         pushl    8(ap)
  215.         calls    #3,g^str$analyze_sdesc
  216.  
  217.         put_item -            ;Set descriptor up for $TRNLNM
  218.                 itemlist,#lnm$_string,-
  219.                 #512,i_res,i_res_descr
  220.  
  221.         put_item -
  222.                 itemlist_2,#0,#0,#0,#0    ;Dummy up descriptor
  223.  
  224.         movl    4(ap),r1        ;Get address of case value
  225.         casew    (r1),#TPU_CWD,#TPU_PASTHRU_OFF;Do case
  226. case_1:
  227.         .word    do_cwd - case_1
  228.         .word    do_trnlnm_job - case_1
  229.         .word    do_trnlnm_proc - case_1
  230.         .word    do_trnlnm_sys - case_1
  231.         .word    do_trnlnm_group - case_1
  232.         .word    do_getmsg - case_1
  233.         .word    do_set_sysdisk - case_1
  234.         .word    do_sleep - case_1
  235.         .word    do_pasthru_on - case_1
  236.         .word    do_pasthru_off - case_1
  237. ;
  238.         .word    case_2 - case_1
  239. case_2:
  240.         movl    #SS$_BADPARAM,r0
  241.         ret
  242. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  243. ;
  244. ;
  245. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  246.  
  247. do_cwd:
  248.         movw    i_parm_descr,r1        ;Get the length of parameter
  249.         tstl    r1            ;If zero, then get current dir
  250.         bneq    10$
  251.         pushal    i_res_descr        ;Push args
  252.         pushal    i_res_descr
  253.         pushl    #0
  254.         calls    #3,g^sys$setddir
  255.         brw    out
  256. 10$:                        ;Otherwise set the current dir
  257.         pushal    i_res_descr
  258.         pushal    i_res_descr
  259.         pushal    i_parm_descr
  260.         calls    #3,g^sys$setddir
  261.         brw    out
  262.         
  263. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  264. ;
  265. ;
  266. ;
  267. ;
  268. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  269.  
  270. do_trnlnm_job:
  271.         $trnlnm_s -
  272.             attr=#LNM$M_CASE_BLIND,-
  273.             tabnam=job_descr,-
  274.             lognam=i_parm_descr,-
  275.             itmlst=itemlist
  276.         brw    out
  277.  
  278. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  279. ;
  280. ;
  281. ;
  282. ;
  283. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  284.  
  285. do_trnlnm_proc:
  286.         $trnlnm_s -
  287.             attr=#LNM$M_CASE_BLIND,-
  288.             tabnam=proc_descr,-
  289.             lognam=i_parm_descr,-
  290.             itmlst=itemlist
  291.         brw    out
  292.  
  293. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  294. ;
  295. ;
  296. ;
  297. ;
  298. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  299.  
  300. do_trnlnm_sys:
  301.         $trnlnm_s -
  302.             attr=#LNM$M_CASE_BLIND,-
  303.             tabnam=sys_descr,-
  304.             lognam=i_parm_descr,-
  305.             itmlst=itemlist
  306.         brw    out
  307.  
  308. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  309. ;
  310. ;
  311. ;
  312. ;
  313. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  314.  
  315. do_trnlnm_group:
  316.         $trnlnm_s -
  317.             attr=#LNM$M_CASE_BLIND,-
  318.             tabnam=group_descr,-
  319.             lognam=i_parm_descr,-
  320.             itmlst=itemlist
  321.         brw    out
  322.  
  323. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  324. ;
  325. ;
  326. ;
  327. ;
  328. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  329.  
  330. do_getmsg:
  331.         pushal    i_parm_descr        ;Convert the string to a number
  332.         calls    #1,atoi
  333.         movl    r0,msgnum        ;Store the result
  334.         movl    #512,i_res_descr
  335.         $getmsg_s -
  336.             msgid=msgnum,-
  337.             msglen=i_res_descr,-
  338.             bufadr=i_res_descr
  339.         brw    out
  340.  
  341. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  342. ;
  343. ;
  344. ;
  345. ;
  346. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  347.  
  348. do_set_sysdisk:
  349.         pushal    i_parm_descr
  350.         pushal    sysdisk_descr
  351.         calls    #2,g^lib$set_logical
  352.         clrl    i_res_descr
  353.         brw    out
  354.  
  355. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  356. ;
  357. ;
  358. ;
  359. ;
  360. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  361.  
  362. do_sleep:
  363.         pushal    i_parm_descr        ;Convert the string to a number
  364.         calls    #1,atoi
  365.         pushl    r0
  366.         calls    #1,sleep
  367.         clrl    i_res_descr
  368.         brw    out
  369.  
  370. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  371. ;
  372. ;
  373. ;
  374. ;
  375. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  376.  
  377. do_pasthru_on:
  378.         $assign_s -
  379.             devnam=tt_descr,-
  380.             chan=iochan
  381.         blbs    r0,10$
  382. 5$:
  383.         pushl    r0
  384.         pushl    r0
  385.         calls    #1,g^lib$signal
  386.         movl    (sp)+,r0
  387.         brw    out
  388. 10$:
  389.         movab    dassign,(fp)
  390.         $qiow_s -
  391.             chan=iochan,-
  392.             func=#IO$_SENSEMODE,-
  393.             p1=newchar_buf,-
  394.             p2=#newchar_buf_len
  395.         blbs    r0,20$
  396. 15$:
  397.         movl    r0,r2
  398.         $dassgn_s -
  399.             chan=iochan
  400.         clrw    iochan
  401.         movl    r2,r0
  402.         brw    5$
  403. ;
  404. 20$:
  405.         bisl2    #TT2$M_PASTHRU,newchar_buf+8
  406.         $qiow_s -
  407.             chan=iochan,-
  408.             func=#IO$_SETMODE,-
  409.             p1=newchar_buf,-
  410.             p2=#newchar_buf_len
  411.         blbc    r0,15$
  412.  
  413.         $dassgn_s -
  414.             chan=iochan
  415.         clrw    iochan
  416.         clrl    (fp)
  417.         clrl    i_res_descr
  418.         brw    out
  419.  
  420. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  421. ;
  422. ;
  423. ;
  424. ;
  425. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  426.  
  427.         .entry    dassign,^m<>
  428.         tstw    iochan
  429.         beql    10$
  430.         $dassgn_s -
  431.             chan=iochan
  432.         clrw    iochan
  433. 10$:
  434.         clrl    i_res_descr
  435.         ret
  436.  
  437. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  438. ;
  439. ;
  440. ;
  441. ;
  442. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  443.  
  444. do_pasthru_off:
  445.         $assign_s -
  446.             devnam=tt_descr,-
  447.             chan=iochan
  448.         blbs    r0,10$
  449. 5$:
  450.         pushl    r0
  451.         pushl    r0
  452.         calls    #1,g^lib$signal
  453.         movl    -(sp),r0
  454.         brw    out
  455. 10$:
  456.         movab    dassign,(fp)
  457.         $qiow_s -
  458.             chan=iochan,-
  459.             func=#IO$_SENSEMODE,-
  460.             p1=newchar_buf,-
  461.             p2=#newchar_buf_len
  462.         blbs    r0,20$
  463. 15$:
  464.         movl    r0,r2
  465.         $dassgn_s -
  466.             chan=iochan
  467.         clrw    iochan
  468.         movl    r2,r0
  469.         brw    5$
  470. ;
  471. 20$:
  472.         bicl2    #TT2$M_PASTHRU,newchar_buf+8
  473.         $qiow_s -
  474.             chan=iochan,-
  475.             func=#IO$_SETMODE,-
  476.             p1=newchar_buf,-
  477.             p2=#newchar_buf_len
  478.         blbc    r0,15$
  479.  
  480.         $dassgn_s -
  481.             chan=iochan
  482.         clrw    iochan
  483.         clrl    (fp)
  484.         clrl    i_res_descr
  485.         brw    out
  486.  
  487. ;+ *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  488. ;
  489. ;
  490. ;
  491. ;
  492. ;- *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
  493.  
  494. out:
  495.         blbc    r0,err
  496.         pushal    i_res_descr
  497.         pushl    12(ap)
  498.         calls    #2,g^str$copy_dx
  499.  
  500.         movl    12(ap),r1
  501.         movw    i_res_descr,(r1)
  502.         movl    #SS$_NORMAL,r0
  503. err:
  504.         ret
  505.         .end
  506. *$*$*EOD*$*$*
  507. $ if f$search("SRC.DIR;1") .eqs. "" then -
  508.      CREATE/LOG/DIRECTORY [.SRC]
  509. $ write sys$output "Creating [.SRC]VI.MAR"
  510. $ create [.SRC]VI.MAR
  511. $ DECK/DOLLARS="*$*$*EOD*$*$*"
  512. ;
  513. ;    This file contains the source to a program that exercises callable
  514. ;    TPU.  You will be interested in using this program ONLY if you
  515. ;    make use of more than ONE TPU utility that requires a CALL_USER
  516. ;    routine, and/or you like to define TPUSECINI as opposed to using
  517. ;    the /SECTION quailfier of EDIT/TPU.
  518. ;
  519. ;    This program expects to be able to use the VI$CALLUSER logical
  520. ;    to find the call_user routines for VI.  It also uses VISECINI
  521. ;    for the name of the TPU section file.  Just to be complete, it will
  522. ;    also use TPU$CALLUSER and TPUSECINI if the VI logicals do not exist.
  523. ;
  524. ;    Written by Gregg Wonderly, 10-jul-1987
  525. ;
  526.         $ssdef
  527.         $lnmdef
  528.         $psldef
  529.         $fabdef
  530.         $rabdef
  531.         $namdef
  532.         .macro    item,code,blen,badr,radr
  533.         .word    blen
  534.         .word    code
  535.         .address -
  536.             badr
  537.         .address -
  538.             radr
  539.         .endm
  540.  
  541. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  542. ;
  543. ;    Program data section
  544. ;
  545. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  546.  
  547.         .psect    rwdata,rd,wrt,noexe
  548.  
  549. fabdef:
  550.         $fab
  551. fablen=.-fabdef
  552.  
  553. rabdef:
  554.         $rab
  555. rablen=.-rabdef
  556.  
  557. namdef:
  558.         $nam
  559. namlen=.-namdef
  560.  
  561. blkdescr:
  562.         .address    0
  563. exit_h:
  564.         .long    0
  565.         .address exit_handler
  566.         .long    0
  567.         .address exit_stat
  568. ;
  569. exit_stat:
  570.         .long    0
  571. ;
  572. clean_flags:
  573.         .long    TPU$M_DELETE_JOURNAL!-
  574.             TPU$M_DELETE_EXITH!-
  575.             TPU$M_RESET_TERMINAL!-
  576.             TPU$M_KILL_PROCESSES!-
  577.             TPU$M_LAST_TIME
  578. bvpval:
  579.         .long    0
  580. ;
  581. bvp:
  582.         .address -
  583.             tpu_init
  584.         .long    0
  585. ;
  586. calluserd:
  587.         .long    0
  588.         .long    0
  589. ;
  590. fileiod:
  591.         .address -
  592.             TPU$FILEIO
  593.         .long    0
  594. ;
  595. crelnm_items:
  596.         item    LNM$_STRING,0,trnlnm_string,dummy
  597.         .long    0
  598. dummy:
  599.         .long    0
  600.  
  601. trnlnm_items:
  602.         item    LNM$_STRING,512,trnlnm_string,string_len
  603.         .long    0
  604.         .long    0
  605.  
  606. trnlnm_string:
  607.         .blkb    512
  608.  
  609. sectdescr:
  610. string_len:
  611.         .long
  612.         .address -
  613.             trnlnm_string
  614.  
  615. vicalldescr:
  616.         .ascid    /VI_CALLUSER/
  617.  
  618. tpucalldescr:
  619.         .ascid    /TPU$CALLUSER/
  620.  
  621. visectdescr:
  622.         .ascid    /VI_SECTION/
  623.  
  624. tpusectdescr:
  625.         .ascid    /TPU$SECTION/
  626.  
  627. procdescr:
  628.         .ascid    /LNM$PROCESS_TABLE/
  629.  
  630. badvicall:
  631.         .ascid    /%VI-F-BADTPUCALL, improper definition of VI$CALLUSER/
  632.  
  633. badtpucall:
  634.         .ascid    /%VI-F-BADTPUCALL, improper definition of TPU$CALLUSER/
  635.  
  636. nocalluser:
  637.         .ascid    /%VI-F-NOCALLUSER, no calluser routine could be loaded/
  638.  
  639.         .psect    code,rd,exe,nowrt
  640.  
  641.         .entry    noerr,^m<>
  642.         ret
  643.  
  644. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  645. ;
  646. ;    The program itself, straight forward no?
  647. ;
  648. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  649.  
  650.         .entry    viedit,^m<r2,r3,r4,r5,r6>
  651.  
  652.         movab    noerr,(fp)        ;Forget about errors we will
  653.                         ;handle them
  654.         pushal    calluserd        ;Push return address location
  655.         pushab    tpucalldescr        ;Routine name
  656.         pushab    vicalldescr        ;Image to search through
  657.         calls    #3,g^lib$find_image_symbol    ;Find the symbol
  658.         blbs    r0,10$            ;Branch on success
  659. ;
  660.         cmpl    r0,#RMS$_FNF        ;If FNF then try TPU$CALLUSER
  661.         beql    5$
  662.         pushl    r0            ;Save the exit value
  663.         pushab    badvicall        ;Pass the right message
  664.         brw    8$            ;Join the other code
  665. 5$:
  666. ;
  667. ;    There is no VI$CALLUSER image, so try TPU$CALLUSER.
  668. ;
  669.         pushal    calluserd        ;Push return address location
  670.         pushab    tpucalldescr        ;Routine name
  671.         pushab    tpucalldescr        ;Image to search through
  672.         calls    #3,g^lib$find_image_symbol    ;Find the symbol
  673.         blbs    r0,10$            ;Branch if we got that
  674.  
  675.         pushl    r0            ;Save the status
  676.  
  677.         cmpl    r0,#RMS$_FNF        ;If FNF then say the right thing
  678.         beql    7$            ;Go set up the right parameter
  679.  
  680.         pushab    badtpucall        ;Push the message descr
  681.         brb    8$            ;Join other code
  682. ;
  683. 7$:
  684.         pushab    nocalluser        ;Push the message descr
  685. ;
  686. 8$:
  687.         calls    #1,g^lib$put_output    ;Output the message
  688.         calls    #1,g^sys$exit        ;Stop with the status pushed
  689. ;
  690. ;    Got the calluser routine, continue processing
  691. ;
  692. 10$:
  693.         clrl    (fp)            ;Remove condition handler
  694.  
  695.         $trnlnm_s -
  696.             tabnam=procdescr,-
  697.             lognam=visectdescr,-
  698.             itmlst=trnlnm_items    ;Get the VISECINI defintion
  699.         blbc    r0,20$            ;If that fails then don't worry
  700.                         ;If /SECTION is not there, then
  701.                         ;TPU will bark for us.
  702.  
  703. ;        pushaq    sectdescr        ;On success, redefine TPUSECINI
  704. ;        pushaq    tpusectdescr        ;to be VISECINI's value
  705. ;        calls    #2,g^lib$set_logical
  706. ;        blbs    r0,20$
  707. ;        pushl    r0
  708. ;        calls    #1,g^sys$exit        ;Exit with the condition
  709.  
  710. 20$:
  711.         movab    g^tpu$handler,(fp)    ;Establish tpu$handler
  712.  
  713.         pushab    calluserd        ;Pass the BVP's to parseinfo
  714.         pushab    fileiod            ;Use TPU$FILEIO
  715.         calls    #2,g^tpu$parseinfo    ;Get the command line stuff
  716.         movl    r0,bvpval        ;This is the value for the
  717.                         ;call back routine to return
  718.                         ;to tpu$initialize, so save it.
  719.  
  720.         pushab    bvp            ;Pass the BVP for the callback
  721.         calls    #1,g^tpu$initialize    ;Initialize TPU
  722.         blbc    r0,err            ;Branch on error
  723.  
  724.         $dclexh_s -
  725.             desblk=exit_h        ;Establish an exit handler
  726.         blbc    r0,err
  727.  
  728.         calls    #0,g^tpu$execute_inifile ;Execute the initialization
  729.  
  730.         blbc    r0,err
  731.         cmpl    r0,#TPU$_SUCCESS
  732.         bneq    done            ;Skip control if not SUCCESS
  733.  
  734.         calls    #0,g^tpu$control    ;Call control to do editing.
  735.         blbc    r0,err
  736. done:
  737.         brb    out
  738. err:
  739.         pushl    r0            ;Signal any error
  740.         calls    #1,g^sys$exit
  741. out:
  742.         ret                ;Back to caller
  743. ;
  744. ;    Merely return the value that tpu$parseinfo returned to us
  745. ;
  746.         .entry    tpu_init,^m<>
  747.         movl    bvpval,r0
  748.         ret
  749.  
  750. ;
  751. ;    This exit handler is called at image exit to cleanup the things that
  752. ;    are of no more interest to us.  Sadly enough, there is not a perfect
  753. ;    policy for the journal file that satisfies everyone.  I have always
  754. ;    written out my changes from time to time, so I really don't ever use
  755. ;    the journal.  The current itemlist to tpu$cleanup causes the journal
  756. ;    to be deleted.  WARNING, don't $FORCEX a VI that you wish to have the
  757. ;    journal from.
  758. ;
  759.         .entry    exit_handler,^m<>
  760.         pushal    clean_flags
  761.         calls    #1,g^tpu$cleanup
  762.         movl    exit_stat,r0
  763.         ret
  764. ;
  765. ;
  766. ;
  767. ;
  768.         .entry    vi$fileio,^m<r2,r3,r4,r5,r6,r7,r8,r9>
  769.  
  770.         movl    @4(ap),r1        ;Get the code
  771.         cmpl    r1,#TPU$K_OPEN
  772.         bneq    10$
  773.         jmp    tpu_open
  774. ;
  775. 10$:
  776.         cmpl    r1,#TPU$K_CLOSE
  777.         bneq    20$
  778.         jmp    tpu_close
  779. ;
  780. 20$:
  781.         cmpl    r1,#TPU$K_CLOSE_DELETE
  782.         bneq    30$
  783.         jmp    tpu_close_delete
  784. ;
  785. 30$:
  786.         cmpl    r1,#TPU$K_GET
  787.         bneq    40$
  788.         jmp    tpu_get
  789. ;
  790. 40$:
  791.         cmpl    r1,#TPU$K_PUT
  792.         beql    tpu_put
  793.         movl    #SS$_BADPARAM,r0
  794.         ret
  795. ;
  796. ;    $PUT routine for VI to use
  797. ;
  798. tpu_put:
  799.         
  800. ;
  801. ;    $GET routine for VI to use
  802. ;
  803. tpu_get:
  804.  
  805. ;
  806. ;    $CLOSE with delete for VI to use
  807. ;
  808. tpu_close_delete:
  809.  
  810. ;
  811. ;    $CLOSE for VI to use
  812. ;
  813. tpu_close:
  814.  
  815. ;
  816. ;    $OPEN for VI to use
  817. ;
  818. tpu_open:
  819.  
  820.  
  821.         ret
  822.         .end    viedit
  823. *$*$*EOD*$*$*
  824. $ if f$search("SRC.DIR;1") .eqs. "" then -
  825.      CREATE/LOG/DIRECTORY [.SRC]
  826. $ write sys$output "Creating [.SRC]TPUSUBS.OPT"
  827. $ create [.SRC]TPUSUBS.OPT
  828. $ DECK/DOLLARS="*$*$*EOD*$*$*"
  829. TPUSUBS.OBJ
  830. UNIVERSAL=TPU$CALLUSER
  831. *$*$*EOD*$*$*
  832. $ if f$search("SRC.DIR;1") .eqs. "" then -
  833.      CREATE/LOG/DIRECTORY [.SRC]
  834. $ write sys$output "Creating [.SRC]STEPWISE.TPU"
  835. $ create [.SRC]STEPWISE.TPU
  836. $ DECK/DOLLARS="*$*$*EOD*$*$*"
  837. PROCEDURE step_compile (fn)
  838.     LOCAL
  839.         pos,
  840.         buf,
  841.         spos,
  842.         epos,
  843.         rng;
  844.  
  845.     ON_ERROR
  846.         IF ERROR = TPU$_COMPILEFAIL THEN
  847.             QUIT;
  848.         ENDIF;
  849.     ENDON_ERROR
  850.  
  851.     buf := CREATE_BUFFER ("$$temp_buf$$", fn);
  852.     IF (buf = 0) THEN
  853.         MESSAGE ("Error loading file!!!");
  854.         RETURN;
  855.     ENDIF;
  856.  
  857.     POSITION (BEGINNING_OF (buf));
  858.     pos := MARK (NONE);
  859.     LOOP
  860.         rng := SEARCH (line_begin & "PROC", FORWARD, EXACT);
  861.         EXITIF (rng = 0);
  862.         spos := BEGINNING_OF (rng);
  863.         POSITION (spos);
  864.         MESSAGE (CURRENT_LINE);
  865.         rng := SEARCH (line_begin & "ENDPROC", FORWARD, EXACT);
  866.         EXITIF (rng = 0);
  867.         epos := BEGINNING_OF (rng);
  868.         POSITION (epos);
  869.         MOVE_VERTICAL (1);
  870.         pos := MARK (NONE);
  871.         MOVE_HORIZONTAL (-1);
  872.         COMPILE (CREATE_RANGE (spos, MARK (NONE), NONE));
  873.     ENDLOOP;
  874.  
  875.     POSITION (pos);
  876.     COMPILE ("PROCEDURE step_compile ENDPROCEDURE;");
  877.     EXECUTE (COMPILE (CREATE_RANGE (pos, END_OF (CURRENT_BUFFER), NONE)));
  878. ENDPROCEDURE;
  879.  
  880. step_compile (GET_INFO (COMMAND_LINE, "FILE_NAME"));
  881. quit;
  882. *$*$*EOD*$*$*
  883. $ if f$search("SRC.DIR;1") .eqs. "" then -
  884.      CREATE/LOG/DIRECTORY [.SRC]
  885. $ write sys$output "Creating [.SRC]MAKE.COM"
  886. $ create [.SRC]MAKE.COM
  887. $ DECK/DOLLARS="*$*$*EOD*$*$*"
  888. $ do="@[-.exe]do"
  889. $ if f$logical ("vi$root") .nes. "" THEN do="@[exe]do"
  890. $ if p1 .eqs. "ALL" then p1="TPUSUBS,EXE,VI"
  891. $ if p1 .eqs. "" then p1 = "VI"
  892. $ opers =","+p1+","
  893. $ i = 1
  894. $!
  895. $ NEXT_ELEM:
  896. $    next = f$element (i, ",", opers)
  897. $    i = i + 1
  898. $    if (next .eqs. "") .or. (next .eqs. ",") then goto done
  899. $    write sys$output "* Making ''next'"
  900. $    on warning then goto go_err
  901. $    goto 'next'
  902. $ go_err:
  903. $    write sys$output "   \''next'\"
  904. $    goto next_elem 
  905. $!
  906. $ VI:
  907. $    on warning then stop
  908. $    do edit/tpu/command=stepwise.tpu/nodispay/nosection vi.tpu
  909. $    do rename vi.gbl [-.exe]
  910. $    set noon
  911. $   mcr install
  912. vi$root:[exe]vi.gbl/replace
  913. $   set on
  914. $    goto next_elem
  915. $!
  916. $ TPUSUBS:
  917. $    on warning then stop
  918. $    do macro tpusubs
  919. $    do link/share/exe=[-.exe]tpusubs tpusubs/opt
  920. $    goto next_elem
  921. $!
  922. $ EXE:
  923. $    on warning then stop
  924. $    do macro vi
  925. $    do link/exe=[-.exe]vi vi
  926. $    goto next_elem
  927. $!
  928. $ CLEAN:
  929. $    on warning then stop
  930. $    do purge/log VI$ROOT:[*...]*.*
  931. $    do delete/log VI$ROOT:[SRC]*.obj;,VI$ROOT:[SRC]MAKE.OUT;
  932. $    goto next_elem
  933. $!
  934. $ DONE:
  935. $    on warning then stop
  936. $    exit
  937. *$*$*EOD*$*$*
  938. $ exit
  939.