home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / qbfaqr01 / dos / psp.bas < prev    next >
Encoding:
BASIC Source File  |  1992-08-13  |  5.8 KB  |  219 lines
  1. '
  2. ' PSP.BAS by Brent Ashley
  3. '
  4. DECLARE FUNCTION C$ (Fore%, Back%)
  5. DECLARE FUNCTION CurPspSegment% ()
  6. DECLARE FUNCTION Hex2$ (Num%)
  7. DECLARE FUNCTION Hex4$ (Num%)
  8. DECLARE FUNCTION ProgramSpec$ (PSP AS ANY)
  9. DECLARE SUB LoadPSPVar (PSPSeg%, PSPVar AS ANY)
  10. DECLARE SUB MemCopy (FSeg%, FOfs%, FCnt%, TSeg%, TOfs%, TCnt%)
  11. DECLARE SUB ShowFCB (FCB AS ANY)
  12. DECLARE SUB ShowPSP (PSP AS ANY)
  13.  
  14. 'Uncomment for compiled version and delete MemCopy SUB:
  15. 'DECLARE SUB MemCopy ALIAS "B$ASSN" (BYVAL FSeg%, BYVAL FOfs%, BYVAL FCnt%,_
  16. '                                    BYVAL TSeg%, BYVAL TOfs%, BYVAL TCnt%)
  17. 'this is a routine internal to BCOM45.LIB - using it will
  18. 'result in a smaller program and speed up the memory copies
  19.  
  20. DEFINT A-Z
  21. '$INCLUDE: 'qb.bi'
  22.  
  23. ' user-defined types
  24.  
  25. TYPE UnopenedFCBType
  26.     DriveNum AS STRING * 1
  27.     FileName AS STRING * 8
  28.     Ext AS STRING * 3
  29.     CurBlk AS INTEGER
  30.     RecSize AS INTEGER
  31. END TYPE
  32.  
  33. TYPE PSPType
  34.     Int20 AS STRING * 2
  35.     TopOfMemory AS INTEGER
  36.     Junk1 AS STRING * 6
  37.     TermIP AS INTEGER
  38.     TermCS AS INTEGER
  39.     BreakIP AS INTEGER
  40.     BreakCS AS INTEGER
  41.     CritErrIP AS INTEGER
  42.     CritErrCS AS INTEGER
  43.     ParentPSPSeg AS INTEGER
  44.     HandleTable AS STRING * 20
  45.     EnvSeg AS INTEGER
  46.     Junk3 AS STRING * 4
  47.     HandleCnt AS INTEGER
  48.     HdlTblOfs AS INTEGER
  49.     HdlTblSeg AS INTEGER
  50.     Junk4 AS STRING * 36
  51.     FCB1 AS UnopenedFCBType
  52.     FCB2 AS UnopenedFCBType
  53.     Junk5 AS STRING * 4
  54.     CmdLen AS STRING * 1
  55.     CmdLine AS STRING * 127
  56. END TYPE
  57.  
  58. ' declare variables:
  59.  
  60. DIM SHARED Regs AS RegType, Fg, Bg, Hi
  61. DIM PSP AS PSPType, ParentPSP AS PSPType
  62.  
  63. ' set up colors
  64. DEF SEG = 0
  65. IF PEEK(&H449) = 7 THEN
  66.     ' monochrome
  67.     Fg = 7: Bg = 0: Hi = 15
  68. ELSE
  69.     ' colour
  70.     Fg = 11: Bg = 1: Hi = 14
  71. END IF
  72.  
  73. ' Do that funky PSP thang!
  74.  
  75. ' fill PSP variable with current PSP data
  76. LoadPSPVar CurPspSegment, PSP
  77.  
  78. COLOR Fg, Bg: CLS
  79. PRINT C(Hi, Bg); "----------- Program Segment Prefix Breakdown -----------"
  80. PRINT C(Hi, Bg); "This Program: "; C(Fg, Bg); ProgramSpec(PSP); "  ";
  81. PRINT C(Hi, Bg); "Current PSP at: "; C(Fg, Bg); Hex4$(CurPspSegment)
  82. ShowPSP PSP
  83.  
  84. ' fill ParentPSP variable with data
  85. LoadPSPVar PSP.ParentPSPSeg, ParentPSP
  86. PRINT C(Hi, Bg); "Parent Program: "; C(Fg, Bg); ProgramSpec(ParentPSP)
  87.  
  88. PRINT C(Hi, Bg); "Parent Command Line: "; C(Fg, Bg); CHR$(16);
  89. PRINT LEFT$(ParentPSP.CmdLine, ASC(ParentPSP.CmdLen)); CHR$(17)
  90.  
  91. FUNCTION C$ (Fore, Back)
  92.     'You can change colors in the middle of a print
  93.     'statement with this little gem! (only if you
  94.     'use ; or , to separate the printed elements -
  95.     'don't concatenate strings with + in a print statement
  96.     COLOR Fore, Back
  97.     C$ = ""
  98. END FUNCTION
  99.  
  100. FUNCTION CurPspSegment
  101.     ' return current PSP segment address
  102.     Regs.AX = &H6200
  103.     Interrupt &H21, Regs, Regs
  104.     CurPspSegment = Regs.BX
  105. END FUNCTION
  106.  
  107. FUNCTION Hex2$ (Num)
  108.     Hex2$ = RIGHT$("0" + HEX$(Num), 2)
  109. END FUNCTION
  110.  
  111. FUNCTION Hex4$ (Num)
  112.     Hex4$ = RIGHT$("000" + HEX$(Num), 4)
  113. END FUNCTION
  114.  
  115. SUB LoadPSPVar (PSPSeg, PSPVar AS PSPType)
  116.     ' use memory block ciopy to fill PSP variable with data
  117.     MemCopy PSPSeg, 0, 256, VARSEG(PSPVar), VARPTR(PSPVar), 256
  118. END SUB
  119.  
  120. SUB MemCopy (FSeg, FOfs, FCnt, TSeg, TOfs, TCnt)
  121.     STATIC i, Temp$
  122.     ' copy a block of memory
  123.     ' TCnt should be same as FCnt (it's there for B$ASSN compatibility)
  124.     ' * use B$ASSN alias instead for compiled programs *
  125.  
  126.     ' go to source segment
  127.     DEF SEG = FSeg
  128.     ' peek temporary string
  129.     Temp$ = SPACE$(FCnt)
  130.     FOR i = 0 TO FCnt - 1
  131.         MID$(Temp$, i + 1, 1) = CHR$(PEEK(FOfs + i))
  132.     NEXT
  133.  
  134.     ' go to destination segment
  135.     DEF SEG = TSeg
  136.     ' poke temp string
  137.     FOR i = 0 TO TCnt - 1
  138.         POKE TOfs + i, ASC(MID$(Temp$, i + 1, 1))
  139.     NEXT
  140.     ' restore BASIC seg
  141.     DEF SEG
  142. END SUB
  143.  
  144. FUNCTION ProgramSpec$ (PSP AS PSPType)
  145.     STATIC i, Temp$
  146.     ' Returns full pathspec for program whose PSP is passed
  147.  
  148.     ' look at environment block
  149.     DEF SEG = PSP.EnvSeg
  150.     i = 0
  151.     ' find first occurrence of 00 00
  152.     DO WHILE PEEK(i) OR PEEK(i + 1)
  153.         i = i + 1
  154.     LOOP
  155.  
  156.     ' if user program, then 01 00 follows
  157.     IF (PEEK(i + 2) = 1) AND (PEEK(i + 3) = 0) THEN
  158.         ' jump past user program signature
  159.         i = i + 4
  160.         Temp$ = ""
  161.         ' build string until 00 byte
  162.         DO WHILE PEEK(i)
  163.             Temp$ = Temp$ + CHR$(PEEK(i))
  164.             i = i + 1
  165.         LOOP
  166.         ProgramSpec$ = Temp$
  167.     ELSE
  168.         ProgramSpec$ = "<Command Shell>"
  169.     END IF
  170. END FUNCTION
  171.  
  172. SUB ShowFCB (FCB AS UnopenedFCBType)
  173.     PRINT C(Hi, Bg); "  Drive  :"; C(Fg, Bg); ASC(FCB.DriveNum)
  174.     PRINT C(Hi, Bg); "  Name   : "; C(Fg, Bg); FCB.FileName
  175.     PRINT C(Hi, Bg); "  Ext    : "; C(Fg, Bg); FCB.Ext
  176.     PRINT C(Hi, Bg); "  CurBlk :"; C(Fg, Bg); FCB.CurBlk
  177.     PRINT C(Hi, Bg); "  RecSize:"; C(Fg, Bg); FCB.RecSize
  178. END SUB
  179.  
  180. SUB ShowPSP (PSP AS PSPType)
  181.     PRINT C(Hi, Bg); "Top of memory: ";
  182.     PRINT C(Fg, Bg); Hex4$(PSP.TopOfMemory); "  "
  183.  
  184.     PRINT C(Hi, Bg); "Term: ";
  185.     PRINT C(Fg, Bg); Hex4$(PSP.TermCS); ":"; Hex4$(PSP.TermIP); "  ";
  186.     PRINT C(Hi, Bg); "Break: ";
  187.     PRINT C(Fg, Bg); Hex4$(PSP.BreakCS); ":"; Hex4$(PSP.BreakIP); "  ";
  188.     PRINT C(Hi, Bg); "CritErr: ";
  189.     PRINT C(Fg, Bg); Hex4$(PSP.CritErrCS); ":"; Hex4$(PSP.CritErrIP)
  190.  
  191.     PRINT C(Hi, Bg); "Parent PSP Seg: "; C(Fg, Bg); Hex4$(PSP.ParentPSPSeg); "  ";
  192.     PRINT C(Hi, Bg); "Environment Seg: "; C(Fg, Bg); Hex4$(PSP.EnvSeg)
  193.  
  194.     PRINT C(Hi, Bg); "Handle Table: "
  195.         PRINT C(Fg, Bg); "  ";
  196.     FOR i = 1 TO 20
  197.         PRINT Hex2$(ASC(MID$(PSP.HandleTable, i, 1))); " ";
  198.     NEXT
  199.     PRINT
  200.  
  201.     PRINT C(Hi, Bg); "Handle Count:"; C(Fg, Bg); HandleCnt; "  ";
  202.     PRINT C(Hi, Bg); "Handle Table Address: "; C(Fg, Bg);
  203.     PRINT Hex4$(PSP.HdlTblSeg); ":"; C(Fg, Bg); Hex4$(PSP.HdlTblOfs)
  204.  
  205.     PRINT C(Hi, Bg); "FCB #1"
  206.     ShowFCB PSP.FCB1
  207.  
  208.     PRINT C(Hi, Bg); "FCB #2"
  209.     ShowFCB PSP.FCB2
  210.  
  211.     PRINT C(Hi, Bg); "Cmd Line Length:";
  212.     PRINT C(Fg, Bg); ASC(PSP.CmdLen); "  ";
  213.  
  214.     PRINT C(Hi, Bg); "Command Line: "; C(Fg, Bg);
  215.     PRINT CHR$(16); LEFT$(PSP.CmdLine, ASC(PSP.CmdLen));
  216.     PRINT CHR$(17)
  217. END SUB
  218.  
  219.