modperl branch collapsed back to MAIN trunk, man!
[www.jankratochvil.net.git] / project / QueryDev / QueryDev.asm
diff --git a/project/QueryDev/QueryDev.asm b/project/QueryDev/QueryDev.asm
new file mode 100644 (file)
index 0000000..fb2521c
--- /dev/null
@@ -0,0 +1,65 @@
+;DEBUG equ     1
+
+       include "SSMac.h"
+
+       clistart
+
+       moveq   #LDF_VOLUMES+LDF_DEVICES+LDF_READ,d1
+       call    dos,LockDosList
+       move.l  d0,d1
+       move.l  d0,d4
+       get.l   Arg_Volume,d2
+       moveq   #LDF_VOLUMES,d3
+       call    FindDosEntry
+       tst.l   d0
+       bne.s   EntryFound
+       dtl     <Volume %s not found>,a0
+VolumeError    geta    Arg_Volume,a1
+       jump    ss,ExitError
+
+EntryFound     move.l  d0,a2
+       move.l  dl_Task(a2),a2
+       moveq   #LDF_DEVICES,d2
+NextDevice     move.l  d4,d1
+       call    NextDosEntry
+       dtl     <No device matching volume %s>,a0
+       move.l  d0,d4
+       beq.s   VolumeError
+       move.l  d0,a0
+       cmp.l   dvi_Task(a0),a2
+       bne.s   NextDevice
+       move.l  dvi_Name(a0),d2
+       moveq   #LDF_VOLUMES+LDF_DEVICES+LDF_READ,d1
+       call    UnLockDosList
+       lsl.l   #2,d2
+       move.l  d2,a0
+       get.l   Arg_VarName,d1
+       bne.s   SomeVarName
+       dtl     <DevName>,a1
+       move.l  a1,d1
+SomeVarName    push    d1
+       moveq   #0,d3
+       move.b  (a0)+,d3
+       move.l  a0,d2
+       moveq   #1,d4
+       lsl.l   #GVB_GLOBAL_ONLY,d4
+       tstv.l  Arg_Global
+       bne.s   GlobalVar
+       lsl.l   #GVB_LOCAL_ONLY-GVB_GLOBAL_ONLY,d4
+GlobalVar      call    SetVar
+       tst.l   d0
+       bne.s   Return
+       dtl     <Variable %s cannot be set>,a0
+       move.l  sp,a1
+       jump    ss,DosError
+
+Return addq    #4,sp
+       rts
+
+       tags
+       template <VOLUME/A,TO=VARNAME,GLOBAL/S>
+       dv.l    Arg_Volume
+       dv.l    Arg_VarName
+       dv.l    Arg_Global
+       finish
+       end