home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / k10sys.mac < prev    next >
Text File  |  2020-01-01  |  24KB  |  754 lines
  1.     TITLE    KERSYS - System interface routines
  2.     SUBTTL    Robert C. McQueen, Nick Bush
  3.  
  4. ; Universals
  5.  
  6.     SEARCH    GLXMAC            ; Galaxy definitions
  7.     SEARCH    KERUNV            ; Kermit definitions
  8.  
  9. ; Directives
  10.  
  11.     PROLOG    (KERSYS)
  12.     .DIREC    FLBLST            ; List file line of binary only
  13.  
  14.   ; Version number
  15.  
  16.     SYSVER==3            ; Major version number
  17.     SYSMIN==0            ; Minor version number
  18.     SYSEDT==125            ; Edit level
  19.     SYSWHO==0            ; Customer edit
  20.  
  21.  
  22.     TWOSEG    400K            ; Make this a two segment program
  23.     RELOC    0            ; Low segment
  24.     RELOC                ; Back to the high segment
  25.     SUBTTL    Table of Contents
  26.  
  27. ;+
  28. ;.pag.lit
  29. ;                          Table of Contents of KERSYS
  30. ;
  31. ;
  32. ;                                    Section                             Page
  33. ;   1.   Table of Contents. . . . . . . . . . . . . . . . . . . . . . . .   2
  34. ;   2.   Revision History . . . . . . . . . . . . . . . . . . . . . . . .   3
  35. ;   3.   Operating system interface
  36. ;      3.1.   SY%TIME . . . . . . . . . . . . . . . . . . . . . . . . . .   4
  37. ;      3.2.   SY%LOGOUT . . . . . . . . . . . . . . . . . . . . . . . . .   5
  38. ;      3.3.   SY%DISMISS. . . . . . . . . . . . . . . . . . . . . . . . .   6
  39. ;   4.   End of KERSYS. . . . . . . . . . . . . . . . . . . . . . . . . .   7
  40. ;
  41. ;.end lit.pag
  42. ;-
  43.     SUBTTL    Revision History
  44.  
  45. COMMENT    |
  46.  
  47. 116    By: Nick Bush        On: 14-March-1984
  48.     Add parsing for all REMOTE commands.
  49.     Add support for some generic and local commands.
  50.     Fix wild card processing to handle pathological names correctly.
  51.     Modules: KERMIT,KERSYS,KERWLD
  52.  
  53. 117    By: Nick Bush        On: 14-March-1984
  54.     Add code to support changing default path.
  55.     Modules: KERSYS
  56.  
  57. 123    By: Nick Bush        On: 2-April-1984
  58.     Change SPACE generic command to use PPN of default path instead of users
  59.     PPN if no argument is supplied.
  60.     Make DIRECTORY and DELETE generic commands print out a header at the
  61.     top of the list, and print file size in both words and allocated blocks.
  62.     Add SPACE as synonym for DISK-USAGE command and ERASE as synonym for
  63.     DELETE.
  64.     
  65.     Modules: KERMIT,KERSYS
  66.  
  67. Start of Version 3(124)
  68.  
  69. 125    By: Nick Bush        On: 26-June-1984
  70.     Add patches from CSM:
  71.     
  72.     - Wrong AC when setting PIM break set.
  73.     - Checks for not-logged-in Kermits
  74.     - Parity for CONNECT (implemented differently)
  75.     
  76.     Modules: KERMIT,KERSYS
  77. |
  78.     SUBTTL    Initialization routine
  79.  
  80. ; This routine will initialize the operating system interface.
  81.  
  82. SY%INIT::
  83.     MOVEI    S1,LOWSIZ        ; Get size of low segment
  84.     MOVEI    S2,LOWBEG        ; And start address
  85.     $CALL    .ZCHNK            ; Clear it out
  86.  
  87. ; Now read default path
  88.  
  89.     MOVX    S1,.PTFRD        ; Get the function
  90.     MOVEM    S1,DEFPTH+.PTFCN    ; Store it
  91.     MOVE    S1,[XWD .PTMAX,DEFPTH]    ; Point at the block
  92.     PATH.    S1,            ; And get the path
  93.      JFCL                ; Ignore errors
  94.     $RETT                ; And return
  95.     SUBTTL    Operating system interface -- SY%TIME
  96.  
  97. ;+
  98. ;.HL1 SY%TIME ()
  99. ;This routine will return the current system uptime in milliseconds to
  100. ;KERMSG.  This is used to calculate the effective baud rate for the sending
  101. ;and receiving of messages.
  102. ;-
  103.  
  104. BLSRTN(SY%TIME)
  105. TOPS10<
  106.     $SAVE    <T1,T2,T3,T4>        ; Save a few registers
  107.     MOVX    T1,%CNSUP        ; Get the system uptime
  108.     GETTAB    T1,            ; . . .
  109.       SETZ    T1,            ; Clear assume zero
  110.     MULX    T1,^D1000        ; Convert to milliseconds
  111.     DIV    T1,JIFSEC##        ; . . .
  112.     MOVE    S1,T1            ; Move to the return location
  113. >; End of TOPS10 conditional
  114.     POPJ    P,            ; Return to the caller
  115.     SUBTTL    Operating system interface -- SY%LOGOUT
  116.  
  117. ;+
  118. ;.HL1 SY%LOGOUT ()
  119. ;This routine will cause KERMIT-10 to log off the system.
  120. ;-
  121.  
  122. BLSRTN(SY%LOGOUT)
  123. TOPS20<
  124.     SETO    S1,            ; Do it to me
  125.     LGOUT%                ; Do it
  126.     BLSRET                ; Just return
  127. >; End of TOPS20 conditional
  128. TOPS10<
  129.     SKIPN    LOGDIN##        ;[125] Are we logged in?
  130.      LOGOUT                ;[125] No, just logout
  131.     MOVSI    S1,-1            ;[125] We want to detach ourself
  132.     ATTACH    S1,            ;[125] Do it
  133.      JFCL                ;[125] If it doesn't work, don't worry
  134.     MOVEI    S1,S2            ; Build arguments in the registers
  135.     MOVX    S2,<SIXBIT /SYS/>    ; Run LOGOUT from SYS:
  136.     MOVX    T1,<SIXBIT /LOGOUT/>    ; Get the program name
  137.     SETZB    T2,T3            ; No extension and the zero
  138.     SETZB    T4,P1            ; No PPN or core assignment
  139.     RUN    S1,UU.PHY        ; Do the UUO
  140.       HALT    .            ; Fail.
  141. >; End of TOPS10 conditional
  142.     SUBTTL    Operating system interface -- SY%GENERIC
  143.  
  144. ;+
  145. ;.HL1 SY%GENERIC (GCTYPE, STRADR, STRSIZ, GETRTN)
  146. ;This routine is called with a generic command.
  147. ;It will return either a pointer to a string to be returned to the
  148. ;other Kermit (STRADR, STRSIZ),
  149. ;or a routine address to call to get characters to be returned (GETRTN),
  150. ;or a file name to be transferred (in FILE%NAME, FILE%SIZE).
  151. ;-
  152.  
  153. BLSRTN(SY%GENERIC,<GETRTN, STRSIZ, STRADR, GCTYPE>)
  154.     $SAVE    <T1,T2,T3,T4>        ; Save T1-4
  155.     $SAVE    <TF,S2>            ; And TF/S2
  156.     MOVE    S1,GCTYPE        ; Get the command type
  157.     MOVE    S2,[XWD -GCTLEN,GCTAB]    ; Get the table pointer
  158. SYGE.0:    MOVE    T1,(S2)            ; Get the entry
  159.     CAIE    S1,(T1)            ; Correct one?
  160.      AOBJN    S2,SYGE.0        ; No, keep looking
  161.     MOVS    T1,T1            ; Point at correct routine
  162.     JUMPL    S2,(T1)            ; And call it if we really found one
  163.     BLSCAL    KRM%ERROR##,<[EXP UNIMPLGEN]> ; Give the error
  164.     BLSRET    UNIMPLGEN        ; Server command not implemented
  165.  
  166. ; Table of routines for generic commands
  167.  
  168.     DEFINE ENT(FUNC,RTN)<XWD SY%'RTN,GC%'FUNC'##>
  169.  
  170. GCTAB:    ENT    STATUS,STATUS
  171.     ENT    DISK%USAGE,DSK
  172.     ENT    DELETE,DEL
  173.     ENT    DIRECTORY,DIR
  174.     ENT    HELP,HLP
  175.     ENT    TYPE,TYP
  176.     ENT    CONNECT,CWD
  177. GCTLEN==.-GCTAB
  178.  
  179.  
  180. ; Here for a type command.  This can only show up from LOCAL, since
  181. ;KERMSG normally handles it in server mode
  182.  
  183. SY%TYP:    MOVE    T1,[POINT 7,FILE%NAME##] ; Point at file name
  184.     MOVE    T2,[POINT 7,GEN%1DATA##] ; And argument
  185.     MOVE    S2,GEN%1SIZE##        ; Get length
  186.     MOVEM    S2,FILE%SIZE##        ; Store it
  187. TYPE.0:    ILDB    S1,T2            ; Get a byte
  188.     IDPB    S1,T1            ; Store it
  189.     SOJG    S2,TYPE.0        ; Loop for all characters
  190.     IDPB    S2,T1            ; And a null
  191.     BLSRET    NORMAL            ; And return the file name
  192.  
  193. ; Here for connect command.  Either reset the path to what we had
  194. ;when we started, or change to the new one supplied.
  195.  
  196. SY%CWD:    SKIPN    GEN%1SIZE##        ; Any argument?
  197.      JRST    SCWD.3            ; No, just use default
  198.     MOVX    S1,.FDSIZ        ; Yes, get length
  199.     XMOVEI    S2,SYSFD        ; Point at FD
  200.     $CALL    .ZCHNK            ; Clear it out
  201.  
  202.     MOVE    S1,[POINT 7,GEN%1DATA##] ; Point at the text
  203.     XMOVEI    S2,SYSFD        ; And the FD
  204.     $CALL    PRSDIR##        ; Parse the directory
  205.  
  206. ; Now copy the path to our PATH block, checking for wild-cards
  207.  
  208.     MOVX    S1,.PTMAX        ; Point at block
  209.     XMOVEI    S2,NEWPTH        ; for new path
  210.     $CALL    .ZCHNK            ; Clear it out
  211.     MOVX    S2,FD.DIR        ; Did we get a directory?
  212.     TDNN    S2,SYSFD+.FDMOD        ;  .  .  .
  213.      JRST    SCWD.3            ; No, use default
  214.     SETO    S2,            ; Get a convenient minus 1
  215.     CAME    S2,SYSFD+.FDDIM        ; Have a PPN?
  216.      JRST    SCWD.E            ; No, illegal wild-card
  217.     MOVE    S1,SYSFD+.FDPPN        ; Get the PPN
  218.     MOVEM    S1,NEWPTH+.PTPPN    ; Store in path block
  219.     MOVSI    T1,-<.PTMAX-.PTSFD-1>    ; Get the number of possible directories
  220.  
  221. SCWD.1:    MOVE    S1,SYSFD+.FDPAT(T1)    ; Get an SFD
  222.     MOVEM    S1,NEWPTH+.PTSFD(T1)    ; Store it
  223.     JUMPE    S1,SCWD.2        ; Done?
  224.     CAME    S2,SYSFD+.FDPAT+.FDD2M(T1) ; Any wild-cards?
  225.      JRST    SCWD.E            ; Yes, complain
  226.     AOBJN    T1,SCWD.1        ; No, loop
  227.     SETZM    NEWPTH+.PTSFD(T1)    ; Ensure we have a zero
  228.  
  229. SCWD.2:    SKIPA    S1,[EXP NEWPTH]        ; Point at new path block
  230.  
  231. SCWD.3:     MOVEI    S1,DEFPTH        ; Point at default path
  232.     MOVX    S2,.PTFSD        ; Set default path
  233.     MOVEM    S2,.PTFCN(S1)        ; Store function
  234.     SETZM    .PTSWT(S1)        ; Clear the flags
  235.     HRLI    S1,.PTMAX        ; Full block
  236.     PATH.    S1,            ; Set the path
  237.      JRST    SCWD.E            ; Error, go give message
  238.     MOVX    S1,.PTFRD        ; Get default path back
  239.     MOVEM    S1,NEWPTH+.PTFCN    ; Store function
  240.     MOVE    S1,[XWD .PTMAX,NEWPTH]    ; Get the current path
  241.     PATH.    S1,            ;  .  .  .
  242.      JFCL                ; This better not happen
  243.     JSP    S1,RTNTXT        ; Set up to return text
  244.     $TEXT    (<(S1)>,<Default path set to [^O/NEWPTH+.PTPPN,LHMASK/,^O/NEWPTH+.PTPPN,RHMASK/^A>)
  245.     MOVSI    T1,-<.PTMAX-.PTSFD-1>    ; Get the number of SFDs possible
  246. SCWD.6:    SKIPN    NEWPTH+.PTSFD(T1)    ; Finished?
  247.      JRST    SCWD.7            ; Yes, close off
  248.     $TEXT    (<(S1)>,<,^W/NEWPTH+.PTSFD(T1)/^A>) ; Type the SFD
  249.     AOBJN    T1,SCWD.6        ; Loop for all SFDs
  250. SCWD.7:    $TEXT    (<(S1)>,<]^A>)        ; Type the closing bracket
  251.     $RETT                ; And return
  252.  
  253. ; Here on error
  254.  
  255. SCWD.E:    KERERR    (<Cannot change default path to ^T/GEN%1DATA##/>)
  256.     BLSRET    RMS32            ; Random error
  257.  
  258. ; Routine to handle help command.  Just return pointers to the help text.
  259.  
  260. SY%HLP:    MOVEI    S1,REMHLP        ; Get address
  261.     MOVEM    S1,@STRADR        ; Save it
  262.     MOVEI    S1,REMHLL        ; Get the length
  263.     MOVEM    S1,@STRSIZ        ; Save it
  264.     BLSRET    NORMAL            ; And return
  265.  
  266.     DEFINE TXT (ADDR,LEN,TEXT)<
  267.     LEN==0            ;; Start out at zero characters
  268.     IRPC <TEXT>,<LEN==LEN+1> ;; Count the character
  269. ADDR:    ASCII |'TEXT'|        ;; Generate the text
  270. > ; End of TXT definition
  271.     TXT    (REMHLP,REMHLL,<Kermit-10 Server handles the following functions:
  272.  
  273. Function                    Standard command
  274. --------                    ----------------
  275.  
  276. Send a file                 SEND file-spec
  277. Retrieve a file             GET file-spec
  278. Log out from system         BYE or LOGOUT
  279. Exit from Kermit server     FINISH
  280. Type a file                 REMOTE TYPE file-spec
  281. List directory              REMOTE DIRECTORY file-spec
  282. Delete a file               REMOTE DELETE file-spec
  283. Show disk usage             REMOTE DISK
  284. Show disk usage for UFD     REMOTE DISK device:[PPN]
  285. Show status information     REMOTE STATUS
  286. Type this text              REMOTE HELP
  287. >) ; End of TXT macro call
  288. COMMENT |
  289. Change default directory    REMOTE CWD new-device/directory
  290. Reset default directory     REMOTE CWD
  291. Copy a file                 REMOTE COPY old-file-spec
  292.                                         New-file-spec
  293. Rename a file               REMOTE RENAME old-file-spec
  294.                                           New-file-spec
  295. Send message to user        REMOTE SEND terminal-name
  296.                                         message text
  297. Show who's logged in        REMOTE WHO
  298. Perform DCL command         REMOTE HOST DCL-command
  299. |
  300.  
  301.  
  302. ; Routine to handle generic status command
  303.  
  304. SY%STATUS:
  305.     MOVEI    S1,WRTSTS##        ; Get routine which will generate the
  306.                     ; text
  307.     PJRST    RTNTXT            ; And go return the text
  308.  
  309. ; Routine to handle disk usage
  310.  
  311. SY%DSK:    MOVEI    S1,DSKUSE        ; Get routine address
  312. ;    PJRST    RTNTXT            ; Go do it
  313.  
  314. ; Routine to handle any generic command which just generates text into
  315. ;a buffer (less than a page worth).
  316.  
  317. RTNTXT:    MOVE    T1,S1            ; Save generation routine address
  318.     SKIPN    S1,TXTPAG        ; Have a text page?
  319.      $CALL    M%GPAG            ; No, get one
  320.     MOVEM    S1,TXTPAG        ; Save the address
  321.     MOVEM    S1,@STRADR        ; Point at the string for later
  322.     HRLI    S1,(POINT 7,)        ; Set up the byte pointer
  323.     MOVEM    S1,TXTPTR        ; Save it
  324.     MOVX    S1,<5*PAGSIZ>-1        ; Get the amount of data we can store
  325.     MOVEM    S1,TXTCTR        ; Save the counter
  326.     MOVEI    S1,TXTOUT        ; Get the output routine
  327.     $CALL    (T1)            ; Write the text
  328.     SETZ    S1,            ; Write a null to terminate the text
  329.     IDPB    S1,TXTPTR        ; Store the null
  330.  
  331.     MOVX    S1,<5*PAGSIZ>-1        ; Get the max size
  332.     SKIPLE    TXTCTR            ; Overfilled?
  333.      SUB    S1,TXTCTR        ; No, get amount actually used
  334.     MOVEM    S1,@STRSIZ        ; Save the length
  335.     BLSRET    NORMAL            ; And return happy
  336.  
  337. ; Handle directory command.
  338.  
  339. SY%DIR:    MOVEI    S1,.FDSIZ        ; Get length of block
  340.     MOVEI    S2,SYSFD        ; And address
  341.     $CALL    .ZCHNK            ; Clear it out
  342.     MOVX    S1,<<SIXBIT /*/>>        ; Get an asterisk
  343.     MOVEM    S1,SYSFD+.FDNAM        ; Save name
  344.     MOVEM    S1,SYSFD+.FDEXT        ; And extension
  345.     MOVE    S1,[POINT 7,GEN%1DATA##] ; Point at file spec
  346.     XMOVEI    S2,SYSFD        ; And at our block
  347.     $CALL    PRSFIL            ; Parse the name
  348.     JUMPF    [KERERR    (<Illegal file specification ^T/GEN%1DATA##/>)
  349.         BLSRET    RMS32]        ; And punt
  350.     SKIPN    SYSFD+.FDNAM        ; Did we get some name?
  351.      JRST    [MOVX    S1,<<SIXBIT /*/>>    ; No, assume all
  352.         MOVEM    S1,SYSFD+.FDNAM        ; Store it
  353.         SETZM    S1,SYSFD+.FDNMM        ; And the name mask
  354.         JRST    .+1]            ; Continue
  355.     $TEXT    (<-1,,GEN%1DATA##>,<^F/SYSFD/^0>) ; rewrite name with defaults
  356.     SETOM    GEN%1SIZE##        ; Set up to count size
  357.     MOVE    S2,[POINT 7,GEN%1DATA##] ;  .  .  .
  358. DIR.1:    ILDB    S1,S2            ; Get a character
  359.     AOS    GEN%1SIZE##        ; Count it
  360.     JUMPN    S1,DIR.1        ; If more to come, keep trying
  361.  
  362. ; Now process all the files
  363.  
  364. DIR.0:    XMOVEI    S2,[ITEXT(<^T/DIRHDR/>)] ; Get header ITEXT
  365.     JSP    S1,PROFIL        ; Set up for processing each file
  366.     SKIPE    ELB##+.RBTIM        ; Have a date/time?
  367.      $TEXT    (TXTOUT,<    ^H/ELB##+.RBTIM/^A>) ; Yes, type it
  368.     $TEXT    (TXTOUT,<>)        ; And a CRLF
  369.     BLSCAL    (FILE%CLOSE##,<[EXP 0]>) ; Close the file
  370.     BLSRET    NORMAL            ; And return
  371.  
  372. ; Header text
  373.  
  374. DIRHDR:    ASCIZ    /
  375. File name            Size        Creation date
  376.                 words  blocks      and time
  377. /
  378.  
  379.  
  380. ; Handle delete command.  This will delete the file(s) specified in
  381. ;the command string.
  382.  
  383. SY%DEL:    SKIPN    LOGDIN            ;[125] Are we logged in?
  384.      JRST    [KERERR    (<Cannot delete files when not logged in>)
  385.         BLSRET    RMS32]        ;[125] No, can't do this
  386.     XMOVEI    S2,[ITEXT(<^T/FILHDR/>)] ; Just use normal header
  387.     JSP    S1,PROFIL        ; Call routine to process file
  388. ;
  389. ;Here from PROFIL to process one file.  S1 is zero if this is the
  390. ;first file. Header (up to extension) is already stored.
  391. ; File is open on channel FIL.  Generate the text for the file being
  392. ;deleted, and then delete it.
  393.  
  394.     SETZB    T1,T2            ; No new name
  395.     RENAME    FIL,T1            ; Delete the file
  396.      JRST    DELE.F            ; Failed, give the error
  397.     $TEXT    (TXTOUT,< [OK]>)    ; Say we got it
  398. DELE.R:    BLSCAL    (FILE%CLOSE##,<[EXP BLSTRU]>) ; Close the file
  399.     $RETT                ; And return
  400.  
  401. ; Here if a delete fails.  Give reasonable error message, but continue
  402.  
  403. DELE.F:    $TEXT    (TXTOUT,< - ^T/FILERR##(S1)/>) ; Give the error
  404.     JRST    DELE.R            ; And return
  405.  
  406.  
  407.  
  408. ; Routine to process a set of files.  This is used by both the delete and
  409. ;directory commands
  410. ; Usage:
  411. ;    XMOVEI    S2,Address of ITEXT for first header
  412. ;    JSP    S1,PROFIL        ; Enter common routine
  413. ;    <code to process file>
  414. ;
  415.  
  416. ; Text for normal header
  417.  
  418. FILHDR:    ASCIZ    \
  419. File name            Size
  420.                 words  blocks
  421. \
  422.  
  423. PROFIL:    MOVEM    S1,PRORTN        ; Save the routine for later
  424.     MOVEM    S2,NXTHDR        ; Dump this header before first file
  425.     SETZM    TXTCTR            ; Set up as no data to return yet
  426.     MOVE    T1,[POINT 7,GEN%1DATA##] ; Point at argument
  427.     MOVE    T2,GEN%1SIZE##        ; And the size
  428.     MOVEM    T2,FILE%SIZE##        ; Save the size
  429.     MOVE    S2,[POINT 7,FILE%NAME##] ; Copy to file name
  430. PROF.0:    ILDB    S1,T1            ; Get a character
  431.     IDPB    S1,S2            ; Store it
  432.     SOJG    T2,PROF.0        ; Copy the whole string
  433.     SETZ    S1,            ; Make a null
  434.     IDPB    S1,S2            ; Store at end of string
  435.  
  436. ; Now just open the first file (by calling FILE%OPEN), and return the
  437. ;address of the routine to get characters.
  438.  
  439.     $SAVE    <TY%FIL##>        ; Save packet type out
  440.     SETZM    TY%FIL##        ; Clear packet type out flag
  441.     BLSCAL    FILE%OPEN##,<[EXP 0]>    ; Open the file
  442.     TXNN    S1,BLSTRU        ; Find it ok?
  443.      BLSRET    RMS32            ; Return ok, error already issued
  444.  
  445.     XMOVEI    S1,PROF.1        ; Get the routine to fetch characters
  446.     MOVEM    S1,@GETRTN        ; Store the so it gets called
  447. ;
  448. ; Set up place to store text
  449. ;
  450.     SKIPN    S1,TXTPAG        ; Have a text page?
  451.      $CALL    M%GPAG            ; No, get one
  452.     MOVEM    S1,TXTPAG        ; Save the address
  453.     HRLI    S1,(POINT 7,)        ; Set up the byte pointer
  454.     MOVEM    S1,TXTPTR        ; Save it
  455.     MOVX    S1,<5*PAGSIZ>-1        ; Get the amount of data we can store
  456.     MOVEM    S1,TXTCTR        ; Save the counter
  457. ;
  458. ; Now process the first file
  459. ;
  460.     SETZM    PRVSTR            ; No previous structure
  461.     SETZM    PRVPTH+.PTPPN        ; Or path
  462.     $CALL    PROHDR            ; Generate the header
  463.     SETZ    S1,            ; This is first call
  464.     $CALL    @PRORTN            ; Process the first file
  465.     SETZ    S1,            ; Write a null to terminate the text
  466.     IDPB    S1,TXTPTR        ; Store the null
  467.     MOVX    S1,<5*PAGSIZ>-1        ; Get the max size
  468.     SKIPLE    TXTCTR            ; Overfilled?
  469.      SUB    S1,TXTCTR        ; No, get amount actually used
  470.     MOVEM    S1,TXTCTR        ; Store the count for the fetch
  471.     MOVE    S1,TXTPAG        ; Get the address back
  472.     HRLI    S1,(POINT 7,)        ; Set up byte pointer
  473.     MOVEM    S1,TXTPTR        ; So fetches work
  474.     BLSRET    NORMAL            ; Return normal now.  The get-a-char
  475.                     ; routine will actually process this file
  476.  
  477. ; Routine called by KERMSG to get a character to return.  It will
  478. ;process one file and return the text character by character.  When
  479. ;the text for the file is finished, it will advance to the next file
  480. ;by calling NEXT%FILE.  If there are no more, it will return EOF.
  481. ;
  482.  
  483.     BLSRTN    (PROF.1,<CHRADR>)    ; This is called like GET%FILE
  484.     SKIPE    TXTPAG            ; Really have a page?
  485.      JRST    PROF.3            ; Yes, no problem
  486.     BLSRET    EOF            ; Return end of file if no page
  487.  
  488. PROF.3:    SOSGE    TXTCTR            ; Any characters left?
  489.      JRST    PROF.2            ; No, process file
  490.     ILDB    S1,TXTPTR        ; Get a character
  491.     MOVEM    S1,@CHRADR        ; Store it
  492.     BLSRET    NORMAL            ; And return
  493.  
  494. ; Here when we run out of data to return.  Process the next file.
  495.  
  496. PROF.2:    $SAVE    <TY%FIL##>        ; Save file type out flag
  497.     SETZM    TY%FIL##        ; And clear it
  498.     $CALL    NEXT%FILE##        ; Get next file
  499.     TXNE    S1,BLSTRU        ; Good return?
  500.      CAIN    S1,NOMORFILES        ; None left?
  501.       JRST    [SETZ    S1,        ; Clear S1
  502.         EXCH    S1,TXTPAG    ; Get current page address
  503.         $CALL    M%RPAG        ; Return it
  504.         BLSRET    EOF]        ; All done, return EOF
  505.  
  506. ; Here when we get a new file.  Call the processing routine.
  507.  
  508.     MOVX    S1,<5*PAGSIZ>-1        ; Reset counter
  509.     MOVEM    S1,TXTCTR        ;  .  .  .
  510.     MOVE    S1,TXTPAG        ; Get address of page
  511.     HRLI    S1,(POINT 7,)        ; Make it a byte pointer
  512.     MOVEM    S1,TXTPTR        ; Save it
  513.  
  514.     $CALL    PROHDR            ; Generate the header
  515.     SETO    S1,            ; Not first call
  516.     $CALL    @PRORTN            ; Do it
  517.     SETZ    S1,            ; Write a null to terminate the text
  518.     IDPB    S1,TXTPTR        ; Store the null
  519.     MOVX    S1,<5*PAGSIZ>-1        ; Get the max size
  520.     SKIPLE    TXTCTR            ; Overfilled?
  521.      SUB    S1,TXTCTR        ; No, get amount actually used
  522.     MOVEM    S1,TXTCTR        ; Store new count
  523.     MOVE    S1,TXTPAG        ; Reset byte pointer
  524.     HRLI    S1,(POINT 7,)        ;  .  .  .
  525.     MOVEM    S1,TXTPTR        ;  .  .  .
  526.     PJRST    PROF.3            ; And return the character
  527.  
  528. ; Routine to generate the start of the line for processing a file
  529. ; It will generate a new device/path line only if it changes
  530.  
  531. PROHDR:    SKIPN    NXTHDR            ; Have a header to dump first?
  532.      JRST    PROH.0            ; No, continue
  533.     $TEXT    (TXTOUT,<^I/@NXTHDR/^A>) ; Yes, do it
  534.     SETZM    NXTHDR            ; Done now
  535. PROH.0:    SETZ    T1,            ; Assume we don't need path
  536.     SKIPN    S1,FPTH##        ; Get structure file was on
  537.      MOVE    S1,ELB+.RBDEV        ; Try hard to find it
  538.     JUMPN    S1,.+2            ; Get something?
  539.      MOVE    S1,FLP##+.FODEV        ; No, use device name from FILOP
  540.     CAMN    S1,PRVSTR        ; Same structure as before?
  541.      JRST    PROH.1            ; Yes, check path
  542.     MOVEM    S1,PRVSTR        ; No, save new structure
  543.     $TEXT    (TXTOUT,<^M^J^W/PRVSTR/:^A>) ; List the structure name
  544.     MOVEI    T1,1            ; Need to list path
  545.  
  546. PROH.1:    MOVSI    S2,-<.PTMAX-.PTPPN-1>    ; Get number of words to check
  547. PROH.2:    MOVE    S1,FPTH+.PTPPN(S2)    ; Get current item
  548.     CAME    S1,PRVPTH+.PTPPN(S2)    ; Same?
  549.      TRO    T1,2            ; Need to list path
  550.     MOVEM    S1,PRVPTH+.PTPPN(S2)    ; Save the PPN
  551.     AOBJN    S2,PROH.2        ; Loop for all entries
  552.  
  553.     JUMPE    T1,PROH.5        ; If nothing changed, continue on
  554.     TRNN    T1,1            ; Need a leading CRLF?
  555.      $TEXT    (TXTOUT,<>)        ; Yes, do it
  556.     $TEXT    (TXTOUT,<[^O/PRVPTH+.PTPPN,LHMASK/,^O/FPTH+.PTPPN,RHMASK/^A>)
  557.  
  558.     MOVSI    S1,-<.PTMAX-.PTSFD-1>    ; Now some SFD's
  559. PROH.3:    SKIPN    PRVPTH+.PTSFD(S1)    ; Have a SFD?
  560.      JRST    PROH.4            ; No, all done
  561.     $TEXT    (TXTOUT,<,^W/PRVPTH+.PTSFD(S1)/^A>) ; Yes, list it
  562.     AOBJN    S1,PROH.3        ; Loop for all of them
  563. PROH.4:    $TEXT    (TXTOUT,<]>)        ; End of path
  564.  
  565. ; Now list the file name and extension
  566.  
  567. PROH.5:    $TEXT    (TXTOUT,<^W6L /ELB+.RBNAM/.^W3L /ELB+.RBEXT,LHMASK/^A>)
  568.     $TEXT    (TXTOUT,<    ^D8R /ELB##+.RBSIZ/ ^D6R /ELB##+.RBALC/^A>) ; List the file size
  569.     $RETT                ; And return
  570.     SUBTTL    Operating system interface -- SY%DISMISS
  571.  
  572. ;+
  573. ;.HL1 SY%DISMISS(seconds)
  574. ;This routine will cause KERMIT to sleep the specified number of seconds.
  575. ;-
  576.  
  577. BLSRTN(SY%DISMISS,<SECONDS>)
  578.  
  579. TOPS10<
  580.     SKIPLE    S1,SECONDS        ; Get the number of seconds
  581.     SLEEP    S1,            ; Go away for that many
  582.       JFCL                ; No error return
  583.     BLSRET    NORMAL            ; Give a good return
  584. >; End of TOPS10 conditional
  585.     SUBTTL    Support routines -- DSKUSE
  586.  
  587. ; This routine will generate the text for the disk usage generic
  588. ;command.
  589. ;
  590. ; Usage:
  591. ;    S1/ output-a-character routine address
  592. ;    GEN%1D - Argument <disk:><[ppn]>
  593. ;    $CALL    DSKUSE
  594. ;     return here always
  595. ;
  596.  
  597. DSKUSE:    $SAVE    <P1,P2,P3>        ; Save a register
  598.     MOVEI    P2,[ITEXT(<>)]        ; String to output before
  599.     MOVE    P1,S1            ; Save the pointer
  600.     MOVX    P3,.PTFRD        ; Read current default path
  601.     MOVEM    P3,NEWPTH+.PTFCN    ;  .  .  .
  602.     MOVE    P3,[XWD .PTMAX,NEWPTH]    ;  .  .  .
  603.     PATH.    P3,            ; From monitor
  604.      SKIPA    P3,MYPPN##        ; Can't get it, use PPN instead
  605.       MOVE    P3,NEWPTH+.PTPPN    ; Get PPN of current path
  606.     SETOM    JOBBLK+.DFJNM        ; Initialize the structure name
  607. ;
  608. ; Once the defaults are set, now try to do a specific if given
  609. ;
  610.     SKIPN    GEN%1SIZE##        ; Have any characters?
  611.      JRST    DSKU.0            ; No, skip this
  612.     MOVX    S1,.FDSIZ        ; Get the size of the block
  613.     XMOVEI    S2,SYSFD        ; And the address
  614.     $CALL    .ZCHNK            ; Clear it out
  615.     MOVEI    S1,GEN%1DATA##        ; Point to the data
  616.     HRLI    S1,(POINT 7)        ; Build a byte pointer to it
  617.     XMOVEI    S2,SYSFD        ; Point to the FD
  618.     $CALL    PRSFIL##        ; Parse the file
  619.     JUMPF    DSKU.0            ; Failed, do them all
  620.     SKIPE    SYSFD+.FDPPN        ; Have a PPN?
  621.       MOVE    P3,SYSFD+.FDPPN        ; Yes, get the PPN
  622.     MOVE    S1,SYSFD+.FDSTR        ; Get the structure
  623.     CAXN    S1,<SIXBIT /DSK/>    ; Is this DSK:?
  624.      JRST    DSKU.0            ; Do the looping
  625.     MOVEM    S1,JOBBLK+.DFJNM    ; No, store for later
  626.     $TEXT    (<(P1)>,<^I/DSKHDR/>)    ; Do the header
  627.     PJRST    DSKSUB            ; Do the structure
  628.  
  629. ;
  630. ; Here to loop over all of the file structures
  631. ;
  632. DSKU.0:    $TEXT    (<(P1)>,<^I/DSKHDR/>)    ; Do the header
  633. DSKU.1:    MOVE    S1,[XWD .DFJBL,JOBBLK]    ; Get the argument block address
  634.     JOBSTR    S1,            ; Get the structure information
  635.      $RETT                ; Just return at this point
  636.     MOVE    S1,JOBBLK+.DFJNM    ; Get the structure name
  637.     CAXN    S1,-1            ; Is this the end?
  638.      $RETT                ; Yes, just reutrn
  639.     JUMPE    S1,DSKU.2        ; Jump if we have a fence
  640.     $CALL    DSKSUB            ; Handle the single structure
  641.     JRST    DSKU.1            ; Loop for the next
  642.  
  643. DSKU.2:    MOVEI    P2,[ITEXT( -- Fence --^M^J)] ; Get the ITEXT to output
  644.     JRST    DSKU.1            ; Loop for the next one
  645.  
  646. ;+
  647. ;.hl2 DSKSUB
  648. ;Routine to output the disk usage for a specific structure.
  649. ;.literal
  650. ;
  651. ; Usage:
  652. ;    P1/ Output routine to use
  653. ;    P2/ ITEXT to output before structure name
  654. ;    P3/ PPN to use
  655. ;
  656. ;.end literal
  657. ;-
  658.  
  659. DSKSUB:    MOVX    S1,.RBMAX        ; Get the length
  660.     XMOVEI    S2,UFDELB        ; Point to the block
  661.     $CALL    .ZCHNK            ; Clear the block
  662.     MOVX    S1,.RBMAX        ; Get the length
  663.     MOVEM    S1,UFDELB+.RBCNT    ; Store as the count
  664.     MOVE    S1,P3            ; Get the PPN
  665.     MOVEM    S1,UFDELB+.RBNAM    ; Store the name
  666.     MOVX    S1,<SIXBIT /UFD/>    ; Get the quotas from the UFD
  667.     MOVEM    S1,UFDELB+.RBEXT    ; Store this
  668.     MOVE    S1,MFDPPN##        ; Get the UFDPPN
  669.     MOVEM    S1,UFDELB+.RBPPN    ; Store the PPN
  670.     MOVX    T1,UU.PHS!.IODMP    ; Get the mode
  671.     MOVE    T2,JOBBLK+.DFJNM    ; Get the structure
  672.     SETZM    T3            ; Clear the buffer pointers
  673.     OPEN    0,T1            ; Open the structure
  674.       $RETF                ; Failed, return failure
  675.     LOOKUP    0,UFDELB        ; Look for the quotas
  676.       JRST    DSKS.1            ; Failed, clean up
  677.     MOVE    T1,JOBBLK+.DFJNM    ; Get the name
  678.     MOVE    T2,P3            ; Get my PPN
  679.     MOVX    S1,<XWD .DUFRE,T1>    ; Point to the arguments
  680.     DISK.    S1,            ; Get the quota
  681.      JRST    [MOVE    S1,UFDELB+.RBQTF    ; Get amount used
  682.         SUB    S1,UFDELB+.RBUSD    ; Get amount free
  683.         JRST    .+1]        ; Continue
  684.     PUSH    P,S1            ; Save the amount FCFS free
  685.     MOVE    T1+.DCNAM,JOBBLK+.DFJNM    ; Get the structure name
  686.     MOVX    S1,<XWD .DCFCT+1,T1>    ; Point to the arguments
  687.     DSKCHR    S1,            ; Get the information
  688.       JRST    [POP    P,(P)        ; Remove this
  689.         JRST    DSKS.1]        ; Keep going
  690.     POP    P,S1            ; Restore S1
  691.     MOVE    S2,T1+.DCFCT        ; Get the amount free on the structure
  692.     MOVE    T1,UFDELB+.RBQTF    ; Get the FCFS quota
  693.     SUB    T1,S1            ; Determine the amount used
  694.     MOVE    T2,UFDELB+.RBQTO    ; Get the logged out quota
  695.     SUB    T2,T1            ; Determine the amount of logged out quota left
  696.  
  697.     $TEXT    (<(P1)>,<^I/(P2)/^W9/JOBBLK+.DFJNM/^D8R /T1/ ^D13R /S1/ ^D12R /T2/ ^D13R /S2/>)
  698.     TRNA                ; Skip $TEXT and return to caller
  699.  
  700. DSKS.1:    $TEXT    (<(P1)>,<^I/(P2)/^W9/JOBBLK+.DFJNM/ - No directory on this structure ->)
  701.     MOVEI    P2,[ITEXT()]        ; Nothing to output
  702.     RELEAS    0,            ; Release the channel
  703.     $RETT                ; Give a good return
  704.  
  705. DSKHDR:    ITEXT(<User: ^P/P3/^M^J^T/DSKHD1/^M^J^T/DSKHD2/^M^J>)
  706. DSKHD1:    ASCIZ    |Structure  Blocks    Logged in    Logged out   System storage|
  707. DSKHD2:    ASCIZ    |           Used      quota left   quota left   left|
  708.     SUBTTL    Support routines -- Text writing
  709.  
  710. ; This routine is used as the output routine for $TEXT calls.  It
  711. ;will write the characters into the page we have set up.
  712.  
  713. TXTOUT:    SOSL    TXTCTR            ; Count the character
  714.      IDPB    S1,TXTPTR        ; Store the character if we have room
  715.     $RETT                ; And return
  716.     SUBTTL    Data storage
  717.  
  718.     RELOC                ; This is low segment
  719.  
  720. LOWBEG:!
  721. ;
  722. ; Anything that parses file specifications uses this
  723. ;
  724. SYSFD:    BLOCK    .FDSIZ            ; File specification block
  725. ;
  726. ; For text writing routines
  727. ;
  728. TXTPAG:    BLOCK    1            ; Text page address
  729. TXTPTR:    BLOCK    1            ; Byte pointer into page
  730. TXTCTR:    BLOCK    1            ; Byte counter for page
  731. ;
  732. ; For file processing routines
  733. ;
  734. PRORTN:    BLOCK    1        ; Routine to process a file
  735. PRVSTR:    BLOCK    1        ; Last structure seen
  736. PRVPTH:    BLOCK    .PTMAX        ; Last path seen
  737. NXTHDR:    BLOCK    1        ; ITEXT to put out as header before next file
  738. ;
  739. ; For CWD
  740. ;
  741. DEFPTH:    BLOCK    .PTMAX            ; Default path on startup
  742. NEWPTH:    BLOCK    .PTMAX            ; New path desired
  743. ;
  744. ; For DSKUSE
  745. ;
  746. UFDELB:    BLOCK    .RBMAX
  747. JOBBLK:    BLOCK    .DFJBL
  748.  
  749. LOWSIZ==.-LOWBEG            ; Size of data
  750.  
  751.     SUBTTL    End of KERSYS
  752.  
  753.     END
  754.