github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-24 03:18:05 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/syseng/dskuse.76
Lars Brinkhoff 51eb040369 Build DSKUSE.
2016-11-29 11:54:28 -08:00

2045 lines
36 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

; -*-MIDAS-*-
TITLE DSKUSE -- DSK INFO -- PDL 2/19/76
;9/6/79 Modified for new TUT format (ITS 1154)
; note to the perplexed: The value of the symbol
; MAXUSR (currently 512.) controls how many users DSKUSE can handle.
; since this is the maximum number of directories ITS can have in the
; current implementation, this should be enough.
.MLLIT=1
; ====================================================================
; accumulator definitions
; ====================================================================
A=1
B=2
C=3
D=4
E=5
F=6
G=7
H=10
I=11
J=12
K=13
L=14
M=15
N=16
ARGP=16
P=17
TYIC==1 ; channels
TYOC==2
CH==3
MCH==4
TCMD==5 ; command output channel
; disk system variables
.INSRT SYSTEM;FSDEFS >
%USRBLK==8 ; size of single user info block
%USER==0 ; offsets of data
%FILES==1
%LINKS==2
%BLCKS==3
%QUOTA==4
%ALLOC==5
%PACKN==6
%BLKAV==7
; command macro
DEFINE COM DIS,NMS
IRP NM,,[NMS]
SIXBIT \!NM!\
PUSHJ P,DIS
TERMIN
TERMIN
; fix and float macros
DEFINE FLOAT AX,AY
TLC AX,232000+1000*AY
FADR AX,AX
TERMIN
DEFINE FIX AX,AY
MULI AX,400
TSC AX,AX
ASH AX+1,AY-243(AX)
TERMIN
; ====================================================================
; :dskuse ?
; ====================================================================
CINFO: ASCIZ \
DSKUSE is usually driven by a command from its JCL line, as follows:
:DSKUSE user statistics on the user directory given, or the MSNAME
directory if no argument.
:DSKUSE > user print message if MSNAME user (or user given explicitly)
is over quota, else nothing.
:DSKUSE @ file statistics on all users output to TPL:, or to file
if given.
:DSKUSE & file output two tables, sorted on user and blocks, to TPL:
or to file if given.
:DSKUSE # general statistics on disk system (takes time).
:DSKUSE $ same as previous, only less detailed (faster, too).
:DSKUSE % user print % of directory space used by user.
:DSKUSE * statistics on all users, in tabular form.
this command is special in that it leaves you in DSKUSE.
you may type the number or name of a column to sort by
that column and then reprint the table (0 or USER, 1 or
FILES, etc.). in this mode the @ command, with a file
name optionally following it, causes subsequent sorts
to go to the file. the commands #, %, and > are not
available. The dual sort (& or BOTH) is, however.
For more details see .INFO.;DSKUSE INFO.\
INFO: OASCR CINFO
JRST KILL
; ====================================================================
; DSKUSE
; ====================================================================
START: MOVE P,[-100,,PDL] ; set up pdl
; here to open ttys
.OPEN TYIC,[SIXBIT / TTYFOOBARBLECH /]
.VALUE [ASCIZ /:CANT OPEN TTY/]
.OPEN TYOC,[SIXBIT / !TTYXXXXXXYYYYYY/]
.VALUE [ASCIZ !:CANT OPEN TTY!]
.OPEN TCMD,[SIXBIT / 1TTYXXXXXXYYYYYY/]
.VALUE [ASCIZ !:CANT OPEN TTY!]
; set up TTY interrupt
.CALL [SETZ
'TTYGET
1000,,TYIC
2000,,A
402000,,B]
.VALUE [ASCIZ /:CANT GET CONSOLE TYPE/]
; make only ^G and ^S interrupt
MOVE 0,[SIXBIT / !!!!!/]
ANDCAM 0,A
MOVE 0,[SIXBIT / !!!!!/]
ANDCAM 0,B
.CALL [SETZ
'TTYSET
1000,,TYIC
A
400000,,B]
.VALUE [ASCIZ /:CANT SET CONSOLE TYPE/]
; enable interrupt
MOVEI A,1 ; tty int
SETZ B,
.SETM2 A,
; get msname of user
.SUSET [.RSNAM,,RSYSNM]
MOVE RSYSNM
MOVEM USRNAM
; get command from superior
.SUSET [.ROPTIO,,A]
TLNN A,40000 ; OPTCMD
JRST HUSER
.BREAK 12,[5,,COMMND]
SKIPN COMMND
JRST HUSER ; no argument
; got arg, so parse it
MOVE [440700,,COMMND]
MOVEM COMPTR
PUSHJ P,GETSYL ; get command, if any
JUMPE B,HUSER
; dispatch
MOVE A,SWPTR
JCLOOP: CAMN B,(A)
JRST @1(A)
AOS A
AOBJN A,JCLOOP
MOVEM B,USRNAM
JRST OUSER ; assume funny user
; ====================================================================
; jcl line command table
; ====================================================================
SWTABL: COM AUSER,[&] ; two column, user and blocks sorted
COM AUSER1,[@] ; one column, user, to tpl
COM AUSER2,[*] ; one column, no tpl
COM DSKDAT,[$] ; quick statistics
COM QUSER,[#] ; detailed statistics
COM UFULL,[%] ; percent of dir used
COM UFULLB,[%%] ; dir bloated?
COM UOVER,[>] ; quota check
COM INFO,[?] ; info
SWPTR: -<<.-SWTABL>/2>,,SWTABL
; ====================================================================
; :DSKUSE %
; ====================================================================
UFULLB: SETOM UFULLF'
UFULL: PUSHJ P,GETSYL
SKIPE B
MOVEM B,USRNAM
.SUSET [.SSNAM,,USRNAM]
; read ufd in
.OPEN CH,UDIR
JRST NOUFD
MOVE A,[-2000,,FDIR]
.IOT CH,A
.CLOSE CH,
PUSHJ P,UFULL0
JRST KILL
UFULL0: MOVE D,UDESCP+FDIR
MOVEI C,UDDESC+FDIR ; ; D/ desc count
HRLI C,440600 ; "BYTE PTR"
SETZ B, ; "COUNT"
NEXTA: SETZ A,
NEXTB: SOJL D,FEND
ILDB C
JUMPE NBYTE ; "ZERO BYTE?"
SETOM A ; "NON-ZERO BYTE"
JRST NEXTB ; "LOOP"
NBYTE: JUMPN A,NEXTA ; "ZERO, WAS LAST ZERO?"
SETZM A
AOJA B,NEXTB ; "AOS NULL COUNT"
FEND: MOVE C,UDESCP+FDIR
SUB C,B
IDIVI C,6 ; "NUMBER OF WORDS"
ADDI C,2000
SUB C,UDNAMP+FDIR
FLOAT C
MOVEI B,2000-UDDESC
FLOAT B
FDVR B,[100.0]
FDVR C,B
SKIPN UFULLF
JRST UFULLP
CAMGE C,[97.0]
POPJ P,
UFULLP: OASC [ASCIZ /Directory /]
OSIX USRNAM
OASC [ASCIZ / is /]
JUMPE C,UEMPTY
OFLOAT C
OASCR [ASCIZ /% full./]
POPJ P,
UEMPTY: OASCR [ASCIZ /empty./]
POPJ P,
; ====================================================================
; :DSKUSE >
; ====================================================================
UOVER: PUSHJ P,GETSYL
SKIPE B
MOVEM B,USRNAM
.SUSET [.SSNAM,,USRNAM]
PUSHJ P,USRDSK
JRST KILL
MOVE B,UBLCKS
CAMG B,UQUOTA
JRST KILL
SUBM B,UQUOTA
OASCR [0]
OSIX USRNAM
OASC [ASCIZ / OVER QUOTA BY /]
ODEC UQUOTA
OASCR [ASCIZ / BLOCKS/]
JRST KILL
; ====================================================================
; :DSKUSE #
; ====================================================================
QUSER: PUSHJ P,DSKAV
PUSHJ P,GATHER
PUSHJ P,DATOUT
OASCR [0]
PUSHJ P,QSKOUT
JRST KILL
; ====================================================================
; :DSKUSE %
; ====================================================================
; here for general data
DSKDAT: PUSHJ P,DSKAV ; get system data
PUSHJ P,DATOUT ; print system data
JRST KILL ; exit
; ====================================================================
; :DSKUSE
; ====================================================================
; here for just doing this user
HUSER: .SUSET [.RSNAM,,USRNAM]
JRST EUSER
; ====================================================================
; :DSKUSE <user>
; ====================================================================
; here for specified user
OUSER: SKIPE USRNAM
.SUSET [.SSNAM,,USRNAM]
; common area for single user dskuse
EUSER: OASCR [0]
PUSHJ P,DSKAV ; get data on system as whole
PUSHJ P,USRDSK ; get data on single user
JRST NOUFD
; print data for single user
PUSHJ P,UFULL0
;OASC [ASCIZ /User /]
;OSIX USRNAM
;OASCR [0]
OASC [ASCIZ /Files /]
ODECR UFILES
OASC [ASCIZ /Links /]
ODECR ULINKS
OASC [ASCIZ /Blocks /]
ODEC UBLCKS
SKIPN UPACKN
JRST EUQOTA
OASCR [0]
OASC [ASCIZ/Allocated to pack /]
ODEC UPACKN
;Attempt to extract pack name out of the system
MOVE A,UPACKN
MOVE B,NQS
SUBI B,1
CAME A,QPKID(B)
SOJGE B,.-1
JUMPL B,EUQOTA
SKIPE A,TRESRV(B)
CAMN A,[-1]
JRST EUQOTA
OASC [ASCIZ/ (/]
OSIX A
OASC [ASCIZ/:)/]
EUQOTA: SKIPG A,UQUOTA
JRST EUSBLK
CAMGE A,UBLCKS
OASCI "*
EUSBLK: OASCR [0]
SKIPG UALLOC
JRST EUSERQ
OASC [ASCIZ \Allocation \]
ODECR UALLOC
EUSERQ: MOVE A,UALLOC
CAMN A,UQUOTA
JRST EUSYST
OASC [ASCIZ \Quota \]
ODECR UQUOTA
; print data for system as a whole
EUSYST: OASC [ASCIZ \Free Blocks \]
SKIPG FREEBL
JRST EUSYS1
; here if there are allocations
OASCR [0]
OASC [ASCIZ \ Unallocated \]
ODECR FRUNAL
OASC [ASCIZ \ Allocated \]
ODEC FREEBL
EUSYS2: OASC [ASCIZ \ of \]
ODECR ALLBL
OASC [ASCIZ \Average User \]
ODECR AVER
JRST KILL ; exit
; here if there are no allocations
EUSYS1: ODEC FRUNAL
JRST EUSYS2
; ====================================================================
; :DSKUSE &
; ====================================================================
AUSER: SETOM BOTH ; set & flag
; ====================================================================
; :DSKUSE @
; ====================================================================
; here to output table to disk
AUSER1: PUSHJ P,SCNAME
PUSHJ P,DSKOUT ; open disk channel
SETOM JCLFLG
; ====================================================================
; :DSKUSE *
; ====================================================================
; here to output table to tty after finishing
AUSER2: SETZB G,H
SETZ I,
OASCR [0]
; get data on date, time, and system name
; what system are we on?
.CALL RDSYST
JFCL
; time
.RTIME A,
MOVEM A,TIME
; date
.RDATE A,
ROT A,12.
MOVEM A,DATE
; optional sort number 0 => 5
PUSHJ P,GETSYL
LDB A,[360600,,B]
SUBI A,20
CAIL A,0
CAILE A,5 ; 6 columns
SETZ A,
SKIPE A
MOVEM A,SORTX ; sort on what entry in vector?
HRRM A,SORTX
; enter loop here to get users and status them one after another
; out of mfd
PUSHJ P,DSKAV
PUSHJ P,GETMFD
PUSHJ P,GATHER ; here to frob all ufd's
HRRI N,USERS ; save aobjn to users
MOVEM N,CPTR
; calculate blocks/file
MOVE A,TBL
MOVE B,TFL
FLOAT A,
FLOAT B,
FDVR A,B
MOVEM A,TAV
JRST ENDST1
; call block for .call /sstatu/
RDSYST: SETZ
SIXBIT /SSTATU/
2000,,0
2000,,0
2000,,0
2000,,0
2000,,0
SETZM SYSNAM
; * print *
ENDST1: SKIPL BOTH
JRST ONESRT
; * here for & dskuse (0 & 3 sort at once) *
; do 3 sort (blocks)
MOVEI A,3
MOVE M,CPTR
PUSHJ P,VSORT
; move results into second data vector
MOVE M,CPTR
HRRI M,FDIR
MOVEM M,CPTR1
MOVE A,[USERS,,FDIR]
BLT A,FDIR+MAXUSR-1
; do 0 sort
MOVSI A,-1
MOVE M,CPTR
PUSHJ P,VSORT
JRST PRTSRT ; print results
; * do single sort *
ONESRT: MOVE A,SORTX ; sort key
MOVE M,CPTR ; cptr
PUSHJ P,VSORT ; do it
; here to print sort
PRTSRT: OASCI ^L ; form feed
OASCR [0]
; herald message
OSIX SYSNAM
OASC [ASCIZ \ DISK USAGE by \]
OSIX RSYSNM
OASC [ASCIZ \ at \]
OTIME TIME
OASC [ASCIZ \ on \]
ODATE DATE
OASCR [0]
OASCR [0]
; general system data
PUSHJ P,DATOUT
OASCR [0]
SKIPN BOTH
JRST COLHDR
PUSHJ P,QSKOUT
OASCR [0]
; column header(s)
COLHDR: OASCR [0]
PUSHJ P,TYPHDR
SKIPN BOTH
JRST ONEHDR
; here to type extra header for & mode
OASC [ASCIZ \ \]
PUSHJ P,TYPHDR
OASCR [0]
; underline appropriate column headers
OASC [ASCIZ \---- \]
SKIPG TQUO
JRST COLHD1
OASCI ^I
COLHD1: SKIPG TALLO
JRST COLHD2
OASCI ^I
COLHD2: OASCR [ASCIZ \ ------\]
JRST TYPSTT ; start normal typeout
; here to underline normal header
ONEHDR: OASCR [0]
HRRZ B,SORTX
XCT PTABS(B) ; appropriate tabs
OASCR [0]
; here to start typing user stats
TYPSTT: OASCR [0]
MOVE D,CPTR
MOVE G,CPTR1
; loop
TYPNXT: MOVE A,(D)
PUSHJ P,TYPOUT
SKIPN BOTH
JRST TYPEND
OASC [ASCIZ \ \]
MOVE A,(G)
PUSHJ P,TYPOUT
TYPEND: OASCR [0]
ADD G,[1,,1]
AOBJN D,TYPNXT
; done, type totals
OASCR [0]
PUSHJ P,TYPTOT
SKIPN BOTH
JRST TYPGET
; type extra total, for second list in & dskuse
OASC [ASCIZ \ \]
PUSHJ P,TYPTOT
; form feed if in & mode
SKIPE BOTH
OASCI ^L
; prepare to get a command
TYPGET: SETZM BOTH
; here to get a command typed from tty, after we have performed
; the single command that could be given when dskuse was invoked.
TYPCOM: SKIPE JCLFLG'
JRST KILL
.IOT TCMD,["*]
MOVE N,M
PUSHJ P,READ
PUSHJ P,GETSYL
MOVE A,TYPPTR
TYPLUP: CAMN B,(A)
JRST @1(A)
AOS A
AOBJN A,TYPLUP
BADCOM: .IOT TCMD,["?]
.IOT TCMD,["?]
.IOT TCMD,[^M]
.IOT TCMD,[^J]
JRST TYPCOM
TYPTAB: COM KILL,[Q,QUIT,KILL]
COM DSKOPN,[@]
COM DSKOP1,[&]
COM SRTUSR,[0,U,USER]
COM SRTFIL,[1,F,FILE,FILES]
COM SRTLNK,[2,L,LINK,LINKS]
COM SRTBLK,[3,B,BLK,BLOCK,BLOCKS]
COM SRTQUO,[4,Q,QUO,QUOTA,QUOTAS]
COM SRTALL,[5,A,ALL,ALLOC,ALLOCA]
COM SRTPCK,[6,P,PACK]
COM SRTAVG,[7,R,RATIO,B/F,BF,AVG]
TYPPTR: -<<.-TYPTAB>/2>,,TYPTAB
; ====================================================================
; sort commands
; ====================================================================
SRTUSR: MOVEI A,0
JRST SORTIT
SRTFIL: MOVEI A,1
JRST SORTIT
SRTLNK: MOVEI A,2
JRST SORTIT
SRTBLK: MOVEI A,3
JRST SORTIT
SRTQUO: MOVEI A,4
JRST SORTIT
SRTALL: MOVEI A,5
JRST SORTIT
SRTPCK: MOVEI A,6
JRST SORTIT
SRTAVG: MOVEI A,7
; if name column, sort "backwards"
SORTIT: SKIPN A
HRLI A,-1 ; sort "frontwards"
MOVEM A,SORTX ; set up sort key
JRST ENDST1
; output a double sort
DSKOP1: SETOM BOTH
JRST ENDST1
; ====================================================================
; output rest of sorts to disk
; ====================================================================
DSKOPN: PUSHJ P,SCNAME ; cons up output file spec
PUSHJ P,DSKOUT ; open it
JRST TYPCOM ; loop
; here to reopen "TTY" channel to "DSK"
DSKOUT: .SUSET [.SSNAM,,RSYSNM]
MOVEI '!
HRLM OUTPUT
.OPEN TYOC,OUTPUT
.VALUE [ASCIZ !:CANT OPEN OUTPUT FILE!]
POPJ P,
; here to exit by killing job and not typing anything
EXIT: .VALUE [ASCIZ /:KILL

/]
KILL: .BREAK 16,140000
HEADER: ASCIZ \USER Files Links Blocks\
HEADE1: ASCIZ \ Quota\
HEADE2: ASCIZ \ Alloc\
HEADE3: ASCIZ \ Pack\
HEADE4: ASCIZ \ B/F\
TYPHDR: OASC HEADER
SKIPE TQUO
OASC HEADE1
SKIPE TALLO
OASC HEADE2
OASC HEADE3
OASC HEADE4
POPJ P,
PTABS: OASC [ASCIZ /----/]
OASC [ASCIZ / -----/]
OASC [ASCIZ / -----/]
OASC [ASCIZ / ------/]
OASC [ASCIZ / -----/]
OASC [ASCIZ / -----/]
OASC [ASCIZ / ----/]
OASC [ASCIZ / ---/]
; * type total line *
TYPTOT: OASC [ASCIZ \Total \]
OJUST 3,TFL
OASCI ^I
OJUST 3,TLK
OASCI ^I
OJUST 4,TBL
OASCI ^I
SKIPG TQUO
JRST TYPTO1
OJUST 4,TQUO
OASCI ^I
TYPTO1: SKIPG TALLO
JRST TYPTO2
OJUST 4,TALLO
OASCI ^I
OASCI ^I
TYPTO2: OFLOAT TAV
POPJ P,
; * output general data *
DATOUT: OASC [ASCIZ \Total number of users is \]
ODEC TUS
SKIPG TQUO
JRST DATUAL
OASC [ASCIZ \, \]
ODEC TUQUOT
OASC [ASCIZ \ with quotas\]
DATUAL: SKIPG TALLO
JRST DATUSR
OASC [ASCIZ \, \]
ODEC TUALLO
OASC [ASCIZ \ with allocations\]
DATUSR: OASCR [0]
SKIPG TQUO
JRST DATAVG
OASC [ASCIZ \Over quota: \]
ODEC TPIGS
OASC [ASCIZ \ users, \]
ODEC TFAT
OASC [ASCIZ \ blocks, average excess \]
ODEC TBACON
OASC [ASCIZ \ blocks each\]
OASCR [0]
DATAVG: OASC [ASCIZ \Average blocks per user \]
ODEC AVER
SKIPG TQUO
JRST DATALO
OASC [ASCIZ \, per quota'ed user \]
ODEC TAQUOT
DATALO: SKIPG TALLO
JRST DATFRE
OASC [ASCIZ \, per allocated user \]
ODEC TAALLO
DATFRE: OASCR [0]
OASC [ASCIZ \Free disk blocks: \]
ODEC FRUNAL
SKIPG TALLO
JRST DATOUX
OASC [ASCIZ \ unallocated, \]
ODEC FREEBL
OASC [ASCIZ \ allocated\]
DATOUX: OASCR [0]
OASC [ASCIZ \Disk system contains \]
ODEC NQS
OASC [ASCIZ \ disks\]
MOVE A,NQS
CAMN A,NQSONL
JRST DATOUY
OASC [ASCIZ \ (\]
ODEC NQSONL
OASC [ASCIZ \ on-line)\]
DATOUY: OASC [ASCIZ \, \]
ODEC ALLBL
OASCR [ASCIZ \ blocks\]
OASC [ASCIZ \Free swapping blocks: \]
ODEC FREESW
OASC [ASCIZ \ out of \]
ODECR SWAPAL
OASC [ASCIZ \Unused UFD slots: \]
MOVE A,NUDSL
SUB A,TUS
SETZ B,
BLT B,
SKIPE B ;If this is a KL10 or a KS10, it has a
SUBI A,2 ; front-end file system in blocks 0,1
ODEC A
OASC [ASCIZ \ of \]
MOVE A,NUDSL
SKIPE B
SUBI A,2
ODECR A
POPJ P,
; here to output tables of disk crufties
QSKOUT: OASC [ASCIZ \Drive \]
SETZ K,
QSKTOP: CAML K,NQS
JRST QSKEND
OASC [ASCIZ \DK\]
ODEC K
OASC [ASCIZ \: \]
AOJA K,QSKTOP
QSKEND: OASCR [0]
OASCR [0]
OASC [ASCIZ \Pack # \]
MOVEI B,QPKID
PUSHJ P,QTABL1
OASC [ASCIZ \Disk size \]
MOVEI B,TLASTB
PUSHJ P,QTABL1
OASCR [0]
OASC [ASCIZ \Available \]
MOVEI B,TSIZES
PUSHJ P,QTABL1
; only print alloc if there is some
SKIPG TALLO
JRST QFREEP
OASC [ASCIZ \Allocated \]
MOVEI B,PACK
PUSHJ P,QTABL1
QFREEP: OASC [ASCIZ \Free space \]
MOVEI B,QSFT
PUSHJ P,QTABL1
OASCR [0]
OASC [ASCIZ \Swap area \]
MOVEI B,TSWAPA
HLL B,QPTR
MOVE D,QPTR
HRRI D,QACT
QSWAPT: SKIPE (D)
JRST QSWAP1
MOVE C,(B)
SUB C,NUDSL
SKIPGE C
MOVEI C,0
OJUST 5,C
QSWAP2: OASCI ^I
AOBJN D,.+1
AOBJN B,QSWAPT
OASCR [0]
OASC [ASCIZ \Free swap area \]
MOVEI B,QSFTS
PUSHJ P,QTABL1
POPJ P,
QSWAP1: OASC [ASCIZ / --/]
JRST QSWAP2
QTABL1: PUSH P,C
MOVE C,QPTR
HRRI C,QACT
HLL B,QPTR
QTABL3: SKIPE (C)
JRST QTABL2
OJUST 5,(B)
QTABL4: OASCI ^I
AOBJN C,.+1
AOBJN B,QTABL3
OASCR [0]
POP P,C
POPJ P,
QTABL2: OASC [ASCIZ \ --\]
JRST QTABL4
QTABLE: HLL B,QPTR
OJUST 5,(B)
OASCI ^I
AOBJN B,QTABLE+1
OASCR [0]
POPJ P,
; point at user vector -- up to MAXUSR users
GATHER: MOVEI A,USERS
MOVEM A,N
MOVEM A,M ; ptr to vector
; zero total of users
SETZM TUS ; users
SETZM TPIGS ; users over quota
SETZM TFAT ; total excess
SETZM TBACON ; average excess
PUSHJ P,GETMFD
GATHE1: PUSHJ P,MFDN ; get a user id into C
JRST GATHEX
JUMPE C,GATHE1 ; loop if empty slot
MOVEM C,USRNAM ; username
.SUSET [.SSNAM,,C] ; set to it
; individual user stats
PUSHJ P,USRDSK
JRST GATHE1
PUSHJ P,USRVEC ; add to vector
AOS TUS
JRST GATHE1 ; loop
GATHEX: MOVE A,TFAT ; calculate avg blks for pigs
MOVE B,TPIGS
PUSHJ P,AVG
MOVEM A,TBACON
MOVE A,TBQUOT ; calculate avg blks for quota
MOVE B,TUQUOT
PUSHJ P,AVG
MOVEM A,TAQUOT
MOVE A,TBALLO ; calculate avg blks for alloc
MOVE B,TUALLO
PUSHJ P,AVG
MOVEM A,TAALLO
POPJ P,
; average, given total and number of instances (as fixes), return a fix
AVG: PUSH P,B
FLOAT A
FLOAT B
FDVR A,B
FIX A
MOVE A,B
POP P,B
POPJ P,
; * here to get average number of blocks per user on disk *
;This comment is wrong!
; makes a good guess at number of free blocks on disks by finding out
; number of packs, and number of free blocks on each, subtracting that from
; number of packs times 5000 blocks per pack minus 200 ufd blocks and 1 mfd, 1 tut
; per pack.
; Puts results out in ALLBL (total number of blocks)
; and FREEBL (number of blocks free)
DSKAV: PUSHJ P,QNUM ; how many packs
PUSHJ P,QRES ; any reserved?
PUSHJ P,DSKALL ; total disk blocks
PUSHJ P,DSKFRE ; free disk blocks
PUSHJ P,SWPFRE ; free swapping blocks
PUSHJ P,DSKMFD ; get # of users, blocks/user
POPJ P,
; * number of packs in system *
; nqs/ # of packs
; qtuto/ -n,,qtuto
; tutsiz/ # of blocks per tut
QNUM: PUSH P,A
MOVE A,[SQUOZE 0,NQS]
.EVAL A,
.VALUE [ASCIZ /:.EVAL OF NQS FAILED/]
MOVEM A,NQS
MOVNS A
HRLS A
HRRI A,QTUTO
MOVEM A,QPTR
; get number blocks for a tut
MOVE A,[SQUOZE 0,NTUTBL]
.EVAL A,
.VALUE [ASCIZ /:.EVAL OF SYMBOL IN A FAILED/]
MOVEM A,TUTSIZ
POP P,A
POPJ P,
; any reserved packs in system??
QRES: PUSH P,A
MOVE A,[SQUOZE 0,QRSRVP]
SETOM TUTRSR
.EVAL A,
SETZB A,TUTRSR
MOVEM A,QRSRVP
POP P,A
POPJ P,
; * free blocks in system *
; freebl/ free blocks in system
DSKFRE: PUSH P,A
PUSH P,B
MOVE A,[QSFT,,[SQUOZE 0,QSFT]]
PUSHJ P,GETQ
MOVEI B,QSFT
PUSHJ P,QTOTAL
MOVEM A,FREEBL
MOVEI B,0
HLL B,QPTR
SETZ A,
DSKFR1: SKIPE TRESRV(B)
JRST DSKFR2
SKIPL QSFT(B)
ADD A,QSFT(B)
DSKFR2: AOBJN B,DSKFR1
MOVEM A,FRUNAL
MOVNS A
ADDM A,FREEBL
POP P,B
POP P,A
POPJ P,
; * free swapping blocks *
; freesw/ free swapping blocks
SWPFRE: PUSH P,A
PUSH P,B
MOVE A,[QSFTS,,[SQUOZE 0,QSFTS]]
PUSHJ P,GETQ
MOVEI B,QSFTS
PUSHJ P,QTOTAL
MOVEM A,FREESW
POP P,B
POP P,A
POPJ P,
; * getloc of (in ac A) symbol to symbol+nqs *
; qtuto/ first pack
; ...
; qtuto+nqs-1/ last pack
GETQ: PUSH P,B
MOVE B,QPTR
HLR B,A
MOVE A,(A)
.EVAL A,
.VALUE [ASCIZ /:.EVAL OF SYMBOL IN A FAILED/]
HRLS A
HRR A,B
.GETLOC A,
ADD A,[1,,1]
AOBJN B,.-2
POP P,B
POPJ P,
; A/ <table>,, symbol
GETUT: PUSH P,B
PUSH P,C
HRLZ C,A ; C/ symbol,,0
HLRZ A,A ; A/ table nqs long
MOVE B,QPTR ; B/ -nqs,,qtuto
SIZLUP: HRL A,(B)
ADD A,C ; offset by QTUTO
.GETLOC A,
AOS A
AOBJN B,SIZLUP
POP P,C
POP P,B
POPJ P,
; * allocations *
; swapal/ swapping allocation
; allbl/ total of system blocks
DSKALL: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
; read in qtuto table
MOVE A,[QTUTO,,[SQUOZE 0,QTUTO]]
PUSHJ P,GETQ
; find out which packs are active
MOVE A,[QACT,,[SQUOZE 0,QACT]]
PUSHJ P,GETQ
; now total on-line disk packs
SETZ A,
MOVEI B,QACT
HLL B,QPTR
SKIPN (B) ; offline?
AOS A
AOBJN B,.-2
MOVEM A,NQSONL
; find out pack numbers for each drive
MOVE A,[QPKID,,[SQUOZE 0,QPKID]]
PUSHJ P,GETQ
; find out which packs are allocated
SKIPN TUTRSR ; reservations in tut?
JRST OLDRSR
MOVE A,[TRESRV,,QTRSRV]
SKIPE QRSRVP ; any reserved packs in system?
PUSHJ P,GETUT
JRST GSWAPA
OLDRSR: MOVE A,[TRESRV,,[SQUOZE 0,QRESRV]]
PUSHJ P,GETQ ; else in table
; get size of packs
GSWAPA: MOVE A,[TLASTB,,QLASTB]
PUSHJ P,GETUT
; get swapping allocations
MOVE A,[TSWAPA,,QSWAPA]
PUSHJ P,GETUT
; start by getting number of ufds
MOVE A,[SQUOZE 0,NUDSL]
.EVAL A,
.VALUE [ASCIZ /:.EVAL OF NUDSL FAILED/]
MOVEM A,NUDSL
; get total swapping allocation, fixed up by removing blocks
; allocated for UFDs
HLLZ C,QPTR
MOVEI B,0
GSWAP1: SKIPE QACT(C)
JRST GSWAP2
MOVE A,TSWAPA(C)
SUB A,NUDSL
SKIPLE A
ADD B,A
GSWAP2: AOBJN C,GSWAP1
MOVEM B,SWAPAL
; calculate total blocks per pack
MOVE B,QPTR
HRRI B,TLASTB
MOVE C,QPTR
HRRI C,TSWAPA
MOVE D,QPTR
HRRI D,TSIZES
DSKTOT: MOVE A,(B)
; get greater of nudsl and swapa into 0
MOVE 0,NUDSL
CAMGE 0,(C)
MOVE 0,(C)
SUB A,0
; subtract mfd and tut if not already part of swapa
CAIGE 0,2500.
SUB A,TUTSIZ ; flush tut blocks
MOVEM A,(D)
AOBJN B,.+1
AOBJN C,.+1
AOBJN D,DSKTOT
; calculate total blocks by adding all packs
MOVEI B,TSIZES
PUSHJ P,QTOTAL
MOVEM A,ALLBL
; restore acs and return
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
; total a table nqs long -- ignore inactive packs
QTOTAL: PUSH P,C
MOVE C,QPTR
HRRI C,QACT
HLL B,QPTR
SETZ A,
QTOTA1: SKIPE (C)
JRST QTOTA2
SKIPL (B)
ADD A,(B)
QTOTA2: AOBJN C,.+1
AOBJN B,QTOTA1
POP P,C
POPJ P,
; total users and average per user
; aver/ average blocks per user
; tus/ total users
DSKMFD: PUSH P,A
PUSH P,B
SKIPE B,TUS
JRST DSKMF1
PUSHJ P,GETMFD
PUSHJ P,MFDN
SKIPA
AOJA B,.-2
MOVEM B,TUS
; now compute average blocks per user
DSKMF1: MOVE A,ALLBL
SUB A,FREEBL
IDIV A,B
MOVEM A,AVER
.CLOSE MCH,
POP P,B
POP P,A
POPJ P,
; * next username from mfd *
; C/ username in sixbit
MFDN: AOS MFDPTR
AOS C,MFDPTR
CAILE C,MFDPTR+1777
POPJ P,
SKIPN C,(C)
JRST MFDN
AOS (P)
POPJ P,
; * add info on a user to free block *
; get 6 word block
USRVEC: MOVEI A,%USRBLK
ADDB A,FREEPT
; put out data
MOVE 0,USRNAM ; username
MOVEM 0,%USER(A)
MOVE 0,UFILES ; # files
MOVEM 0,%FILES(A)
MOVE 0,ULINKS ; # links
MOVEM 0,%LINKS(A)
MOVE 0,UBLCKS ; # blocks
MOVEM 0,%BLCKS(A)
MOVE 0,UQUOTA ; quota
MOVEM 0,%QUOTA(A)
MOVE 0,UALLOC
MOVEM 0,%ALLOC(A)
MOVE 0,UPACKN
MOVEM 0,%PACKN(A)
MOVE 0,UBKFLS ; blocks/file
MOVEM 0,%BLKAV(A)
; update cptr to pointers
MOVEM A,(N)
SUB N,[(1)]
ADDI N,1
POPJ P,
; * typeout information on a given user *
; a/ ptr to data block
TYPOUT: PUSH P,A
PUSH P,B
MOVE B,A
; type out data
OSIX %USER(B) ; user-id
OASCI ^I
OJUST 3,%FILES(B) ; # file
OASCI ^I
OJUST 3,%LINKS(B) ; # links
OASCI ^I
OJUST 4,%BLCKS(B) ; # blocks
; give him a * if over quota
SKIPE TQUO
SKIPG A,%QUOTA(B) ; has quota?
JRST TYPBLK
CAMGE A,%BLCKS(B)
OASCI "*
TYPBLK: SKIPG TQUO
JRST TYPALC
SKIPG TALLO
JRST TYPOU1
OASCI ^I
SKIPG %ALLOC(B)
JRST TYPQUO
; here if has alloc. (print quota only if different)
TYPALL: MOVE A,%QUOTA(B)
CAMN A,%ALLOC(B)
JRST TYPAL1
OJUST 4,%QUOTA(B)
TYPAL1: OASCI ^I
OJUST 4,%ALLOC(B)
JRST TYPOU1
; here if only has quota
TYPQUO: OJUST 4,%QUOTA(B)
OASCI ^I
; restore acs and return
TYPOU1: OASCI ^I
SKIPE %PACKN(B)
OJUST 2,%PACKN(B)
OASCI ^I
OFLOAT %BLKAV(B) ; blocks/file
POP P,B
POP P,A
POPJ P,
TYPALC: SKIPG TALLO
JRST TYPOU1
OASCI ^I
OJUST 4,%ALLOC(B)
JRST TYPOU1
; * read in mfd *
GETMFD: SKIPE MFDBUF+MDNAMP
JRST GETMFX
.OPEN MCH,MFDDIR
.VALUE [ASCIZ !:CANT OPEN M.F.D.!]
MOVE A,[-2000,,MFDBUF]
.IOT MCH,A
JUMPL A,TINY
.CLOSE MCH,
GETMFX: MOVE A,MFDBUF+MDNAMP
ADDI A,MFDBUF-2 ; aos's first, cretin...
MOVEM A,MFDPTR
POPJ P,
TINY: .VALUE [ASCIZ !:M.F.D. LESS THAN 2000 WORDS LONG?!]
; * single user statistics gatherer *
NOUFD: OASCI ""
OSIX USRNAM
OASCR [ASCIZ \" is not the name of a directory.\]
JRST KILL
USRDSK: PUSH P,D
PUSH P,E
; read ufd in
.OPEN CH,UDIR
JRST USRLSR
MOVE A,[-2000,,FDIR]
.IOT CH,A
.CLOSE CH,
; initialize world
SETZB C,D
SETZB E,F
SETZM UFILES
SETZM ULINKS
SETZM UBLCKS
SETZM UBKFLS
SETZM UQUOTA
SETZM UALLOC
SETZM UPACKN
SETZM OLDC
; quota and number of blocks
MOVE B,FDIR+UDBLKS
HLREM B,UQUOTA
SKIPGE B
SETZM UQUOTA
HRREM B,UBLCKS
SKIPG A,UQUOTA
JRST L69
CAML A,UBLCKS
JRST L69
MOVE A,UBLCKS
SUB A,UQUOTA
ADDM A,TFAT
AOS TPIGS
; pack and allocation
L69: HRRE B,FDIR+UDALLO
SKIPLE B ; if negative or zero (UALLOC is 0 already)
MOVEM B,UALLOC
HLRZ E,FDIR+UDALLO
JUMPE E,L105
MOVEM E,UPACKN
SKIPN TUTRSR
JRST O69
MOVE A,QPTR ; here for new style reservations
HLLZ A,A ; done by pack number rather than drive
DRLOOP: SKIPL QACT(A) ; drive off line?
CAME E,QPKID(A)
JRST DRNEXT
ADDM B,PACK(A)
JRST L105
DRNEXT: AOBJN A,DRLOOP
JRST L105
O69: ADDM B,PACK(E) ; for old style reservation hackery
L105: MOVE B,UDNAMP+FDIR
ADDI B,FDIR
L1: CAILE B,FDIR+1773
JRST UNUM
SKIPN (B)
JRST NEXTFL
MOVE E,UNRNDM(B)
TLNE E,UNIGFL
JRST NEXTFL
TLNE E,1
AOSA ULINKS ; was a link
AOS UFILES ; was a regular file
; move to next file
NEXTFL: ADDI B,LUNBLK
JRST L1
; finish calculations and exit
; calculate blocks/file
UNUM: MOVE A,UBLCKS
FLOAT A
MOVE B,UFILES
FLOAT B
FDVR A,B
MOVEM A,UBKFLS
; add to totals
SKIPLE E,UFILES
ADDM E,TFL
SKIPLE E,ULINKS
ADDM E,TLK
SKIPLE E,UBLCKS
ADDM E,TBL
SKIPG UALLOC
JRST UPDUSR
AOS TUALLO ; here for allocated directory
ADDM E,TBALLO
JRST UPDUS1
UPDUSR: SKIPG UQUOTA
JRST UPDUS1
AOS TUQUOT ; here for quota'ed directory
ADDM E,TBQUOT
UPDUS1: SKIPLE E,UQUOTA
ADDM E,TQUO
SKIPLE E,UALLOC
ADDM E,TALLO
; go here if no files in dir
ZEROES: AOS -2(P)
USRLSR: POP P,E
POP P,D
POPJ P,
; byte pointer table
DESCBP: 440600
360600
300600
220600
140600
060600
; * buffers *
MAXUSR==512.
USERS: BLOCK MAXUSR ; this is largest number of users prog will handle
FREEPT: FREESP+1-%USRBLK
FREESP: BLOCK MAXUSR*%USRBLK ; free storage buffer
PDL: BLOCK 100
FDIR: BLOCK 2000
BUF: BLOCK 20.
; variables
SORTX: -1,,0
CPTR: 0
CPTR1: 0
OLDC: 0
; * variables used for getting system info *
TUTRSR: 0 ; non-zero if new style reservation stuff
TUTSIZ: 0 ; number of blocks in tut (NTUTBL)
NQS: 0 ; number of packs
NQSONL: 0 ; number of packs online
QPTR: 0 ; -nqs,,qtuto
QRSRVP: 0 ; any reserved packs?
NUDSL: 0 ; number of ufds allowed
QTUTO: BLOCK 10 ; location of tut for drives
TLASTB: BLOCK 10 ; drive sizes (rp02 or rp03)
TRESRV: BLOCK 10 ; reserved? (-1 if is)
TSWAPA: BLOCK 10 ; swapping allocations
QACT: BLOCK 10 ; disk active?
QPKID: BLOCK 10 ; pack numbers
TSIZES: BLOCK 10 ; calculated sizes (exclude ufds and mfd and tut)
QSFT: BLOCK 10 ; free file space
QSFTS: BLOCK 10 ; free swap space
PACK: BLOCK 10 ; total allocated on each drive
; * status variables *
; single user totals
USRNAM: 0 ; user
UFILES: 0 ; # of files
ULINKS: 0 ; # of links
UBLCKS: 0 ; number of blocks in ufd
UBKFLS: 0 ; blocks/file average
UQUOTA: 0 ; quota
UALLOC: 0 ; allocation
UPACKN: 0 ; allocated pack number
; system wide totals
TUS: 0 ; total # users
TUALLO: 0 ; total # allocated users
TUQUOT: 0 ; total # quota'ed users
TPIGS: 0 ; users over quota
TFAT: 0 ; total excess for TPIGS
TBACON: 0 ; average pigness of TPIGS
TFL: 0 ; total files
TLK: 0 ; total links
TBL: 0 ; total blocks
TBALLO: 0 ; total blocks in allocated directories
TBQUOT: 0 ; total blocks in quota'ed directories
TAV: 0 ; average b/f over system
TAALLO: 0 ; average b/u for allocated directories
TAQUOT: 0 ; average b/u for quota'ed directories
TQUO: 0 ; total of quotas
TALLO: 0 ; total of allocations
; block for cretinous mfd
MFDPTR: 0
MFDBUF: BLOCK 2000.
; disk system stats
FREESW: 0 ; free swapping blocks
SWAPAL: 0 ; swapping allocation
FREEBL: 0 ; free disk blocks
FRUNAL: 0 ; free unallocated blocks
ALLBL: 0 ; total number of blocks
AVER: 0 ; average number of blocks per user directory
DATE: 0 ; date dskuse was run
TIME: 0 ; time dskuse was run
; * I/O variables *
BOTH: 0 ; flag for double dskuse ("&")
; files
UDIR: SIXBIT / &DSK.FILE.(DIR) /
MFDDIR: SIXBIT / &DSKM.F.D.(FILE)/
OUTPUT: SIXBIT / !TPLDSKUSEOUTPUT/
RSYSNM: 0 ; sname of user
SYSNAM: 0 ; which system? dm, ai, or ml?
; ================================================================
; read a command line
; ================================================================
COMMND: BLOCK 20
COMPTR: 0
; set up buffer
READ: PUSH P,A
PUSH P,B
SETZM COMMND
MOVE [COMMND,,COMMND+1]
BLT 0,COMPTR-1
; command reader
RCMD: MOVE B,[440700,,COMMND]
MOVEM B,COMPTR
MOVEI C,0
RCMD1: .IOT TYIC,A
CAIN A,177
JRST RUB
CAIN A,^D
JRST RREPEA
CAIN A,^L
JRST RCLEAR
CAIN A,^J
JRST RCMD1
CAIN A,^Q
JRST RQUOTE
CAIN A,^M
JRST RCMDX
RCMDL: IDPB A,B
CAMGE B,[350700,,COMMND+17]
AOJA C,RCMD1
RCFUL: IDPB A,B
MOVEI A,15
IDPB A,B
RCMDX: IDPB A,B
MOVEI A,0
IDPB A,B
POP P,B
POP P,A
POPJ P,
RREPEA: .IOT TCMD,[^M]
.IOT TCMD,[^J]
JRST REPPER
RCLEAR: .IOT TCMD,[^P]
.IOT TCMD,["C]
REPPER: .IOT TCMD,["*]
MOVEI A,COMMND
HRLI A,440700
REP1: ILDB A
JUMPE RCMD1
.IOT TCMD,
JRST REP1
RQUOTE: IDPB A,B
CAML B,[350700,,COMMND+17]
JRST RCFUL
SETOM QUTFLG
AOS C
.IOT TYIC,A
SETZM QUTFLG'
JRST RCMDL
RUB: PUSHJ P,RUBBER
JRST RCMD
JRST RCMD1
RUBBER: SOJL C,[POPJ P,] ; erasure rubout handler
MOVEI A,0
DPB A,B
.IOT TCMD,[^P]
.IOT TCMD,["X]
ADD B,[070000,,]
TLNE B,400000
ADD B,[347777,,-1]
AOS (P)
POPJ P,
; ===================================================================
; command line reading and parsing section
; ===================================================================
; read a file spec
SCNAME: PUSH P,D
MOVEI D,OUTPUT
PUSH P,A
PUSH P,B
PUSH P,C
MOVSI C,-2
HRRI C,1(D)
JRST SCNONE
SCNGET: HRRZ A,(D)
CAIE A,'TPL
JRST SCNONE
MOVEI A,'DSK
HRRM A,(D)
SCNONE: PUSHJ P,GETSYL
JUMPE B,SCNX
CAIE A,':
JRST .+3
HLRZM B,(D)
JRST SCNGET
CAIE A,';
JRST SCNNMN
MOVEM B,3(D)
JRST SCNGET
SCNNMN: MOVEM B,(C)
JUMPL A,SCNX
CAIE A,',
AOBJN C,SCNGET
SCNX: POP P,C
POP P,B
POP P,A
POP P,D
POPJ P,
; get a syllable from command buffer
GETSYL: PUSH P,C
PUSH P,[0]
MOVEI B,(P)
HRLI B,440600
GETSLP: PUSHJ P,GETCCA
JUMPL A,GETSX
SETO E,
CAIN A,^Q
JRST GETQOT
SUBI A,40
JUMPL A,GETSX
JUMPE A,GETSP
CAIN A,'_
JRST GETSX
CAIE A,':
CAIN A,';
JRST GETSX
GETSPT: CAIL A,100
SUBI A,40
TLNN B,770000
JRST GETSLP
IDPB A,B
JRST GETSLP
GETQOT: ILDB A,COMPTR
SUBI A,40
JUMPGE A,GETSPT
JRST GETSX
GETSP: TLNE B,400000
JRST GETSLP
GETSX: POP P,B ; character word
POP P,C
POPJ P,
GETCCA: ILDB A,COMPTR
JUMPE A,GETCCX
CAIN A,^I
MOVEI A,40
CAIN A,^M
JRST GETCCX
CAIN A,"
MOVEI A,",
POPJ P,
GETCCX: SETOM A
POPJ P,
; ================================================================
; interrupt handler (tty only)
; ================================================================
ZZZ=.
LOC 42
JSR TSINT
LOC ZZZ
TSINT: 0
0
PUSH P,A
MOVEI A,TYIC
.ITYIC A,
JRST TSDIS
CAIE A,^G
CAIN A,^S
JRST TSKILL ; if ^S or ^G typed, quit
TSDIS: POP P,A
.DISMIS TSINT+1
TSKILL: .IOT TYIC,A
POP P,A
.DISMIS [BADCOM]
; ================================================================
; uuo handler (typeout uuos)
; ================================================================
ZZZ==.
LOC 40
0
JSR UUOH
LOC ZZZ
UUOCT==0
UUOTAB: JRST ILUUO
IRPS X,,[OSIX OASC OASCI OASCR ODEC ODECR OFLOAT OJUST ODATE OTIME]
UUOCT==UUOCT+1
X=UUOCT_33
JRST U!X
TERMIN
UUOMAX==.-UUOTAB
UUOD: 0 ; contents of UUO eff addr.
UUOE: 0 ; UUO effad.
UUOH: 0
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
MOVEI @40 ; get eff addr. of uuo
MOVEM UUOE
MOVE @0
MOVEM UUOD ; contents of eff adr
MOVE B,UUOE ; eff adr
LDB A,[270400,,40] ; get uuo ac,
LDB C,[330600,,40] ; op code
CAIL C,UUOMAX
MOVEI C,0 ; grt=>illegal
JRST @UUOTAB(C) ; go to proper rout
UUORET: POP P,D
POP P,C
POP P,B
POP P,A ; restore ac's
JRST 2,@UUOH
ILUUO: .VALUE [ASCIZ /:ILLEGAL UUO/]
UOASCR: SKIPA C,[^M] ; cr for end of type
UOASC: MOVEI C,0 ; no cr
HRLI B,440700 ; make ascii pointer
UOASC1: ILDB A,B ; get char
JUMPE A,.+3 ; finish?
PUSHJ P,IOTA
JRST .-3 ; and get another
SKIPE A,C ; get saved cr?
PUSHJ P,IOTA
JRST UUORET
UOASCI: MOVE A,B ; prt ascii immediate
PUSHJ P,IOTA
JRST UUORET
UOSIX: MOVE B,UUOD
USXOOP: JUMPE B,UUORET
LDB A,[360600,,B]
ADDI A,40
PUSHJ P,IOTA
LSH B,6
JRST USXOOP
TENS: 0 ? 10. ? 100. ? 1000. ? 10000. ? 100000.
UOJUST: MOVE B,UUOD
TYOJ1: CAML B,TENS(A)
JRST UOJUS1
.IOT TYOC,[40]
SOJG A,TYOJ1
UOJUS1: SETZB A,D
MOVEI C,10.
JRST UOOCTI+1
UODECR: SKIPA D,[^M]
UODEC: SETZ D,
MOVEI C,10.
JRST .+3
UOOCT: SETZ D,
MOVEI C,8. ; octal base
MOVE B,UUOD ; get actual word to prt
JRST .+3 ; join code
UODECI: SKIPA C,[10.] ; decimal
UOOCTI: MOVEI C,8.
MOVEM C,BASE'
SKIPN A
HRREI A,-1 ; a=digit count
PUSHJ P,UONUM ; print numbr
SKIPE A,D
PUSHJ P,IOTA
JRST UUORET
UONUM: IDIV B,BASE
HRLM C,(P) ; save digit
SOJE A,UONUM1 ; done if 0
SKIPG A ; + => more
SKIPE B ; - => b=0 => done
PUSHJ P,UONUM ; else more
UONUM1: HLRZ C,(P) ; retreive digits
ADDI C,"0 ; make to ascii
CAILE C,"9 ; is it good dig
ADDI C,"A-"9-1 ; make hex digit
PUSHJ P,IOTC
POPJ P, ; ret
UOFLOA: PUSH P,E
PUSH P,F
PUSH P,G
PUSH P,H
PUSH P,I
MOVE A,UUOD
MOVE D,A
PUSHJ P,NFLOT
POP P,I
POP P,H
POP P,G
POP P,F
POP P,E
JRST UUORET
; at this point we enter code abstracted from DDT.
NFLOT: JUMPE A,FP1A
TFL1: MOVEI B,0
CAMGE A,FT01
JRST FP4
CAML A,FT8
AOJA B,FP4
FP1A:
FP3: SETZB C,TEM1 ; CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
MULI A,400
ASHC B,-243(A)
MOVE A,B
PUSHJ P,FP7
PUSH P,A
MOVEI A,".
PUSHJ P,IOTA
POP P,A
MOVNI A,3
ADD A,TEM1
MOVE E,C
FP3A: MOVE D,E
MULI D,12
PUSHJ P,FP7B
SKIPE E
AOJL A,FP3A
POPJ P, ; ONE return from OFLT here
FP4: MOVNI C,6
MOVEI F,0
FP4A: ADDI F,1(F)
XCT FCP(B)
SOSA F
FMPR A,@FCP+1(B)
AOJN C,FP4A
PUSH P,EXPSGN(B)
PUSHJ P,FP3
PUSH P,A
MOVEI A,"E
PUSHJ P,IOTA
POP P,A
POP P,D
MOVE A,D
PUSHJ P,IOTA
MOVE A,F
FP7: SKIPE A ; AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
AOS TEM1
IDIVI A,12
HRLM B,(P)
JUMPE A,FP7A1
PUSHJ P,FP7
FP7A1: HLRZ D,(P)
FP7B: ADDI D,"0
PUSH P,A
MOVE A,D
PUSHJ P,IOTA
POP P,A
POPJ P,
; constants
1.0^32.
1.0^16.
FT8: 1.0^8
1.0^4
1.0^2
1.0^1
FT: 1.0^0
1.0^-32.
1.0^-16.
1.0^-8
1.0^-4
1.0^-2
FT01: 1.0^-1
FT0=FT01+1
TEM1: 0
; instructions
FCP: CAMLE A, FT0(C)
CAMGE A, FT(C)
0, FT0(C)
EXPSGN: "-
"+
; ====================================================================
; uuo character output
; ====================================================================
IOTC: PUSH P,A
MOVE A,C
PUSHJ P,IOTA
POP P,A
POPJ P,
IOTA: CAIN A,^P
JRST IOTAP
IOTA1: CAIE A,^J
.IOT TYOC,A
CAIN A,^M
.IOT TYOC,[^J]
POPJ P,
IOTAP: .IOT TYOC,["^]
ADDI A,100
JRST IOTA1
; type time
UOTIME: MOVEI C,":
JRST UOTUPL
; type date
UODATE: MOVEI C,"/
UOTUPL: LDB A,[360600,,UUOD]
ADDI A,40
PUSHJ P,IOTA
LDB A,[300600,,UUOD]
ADDI A,40
PUSHJ P,IOTA
PUSHJ P,IOTC
LDB A,[220600,,UUOD]
ADDI A,40
PUSHJ P,IOTA
LDB A,[140600,,UUOD]
ADDI A,40
PUSHJ P,IOTA
PUSHJ P,IOTC
LDB A,[060600,,UUOD]
ADDI A,40
PUSHJ P,IOTA
LDB A,[000600,,UUOD]
ADDI A,40
PUSHJ P,IOTA
JRST UUORET
; ====================================================================
; sorter
; ====================================================================
; simple interchange sort
; A/ sort forward or backward (-1/0)
VSORT: PUSH P,A
PUSH P,G
PUSH P,M
MOVE F,[CAMG G,(C)]
SKIPL A
MOVE F,[CAML G,(C)]
HRRZS A
MOVE D,M
POP D,(D)
AOS D
MOVEM D,E
VSORT1: SETZM K
MOVE D,E
AOBJP D,.+1
SOS D
MOVEM D,E
VSORT2: AOBJP D,VSORTX
MOVE C,(D)
ADD C,A
MOVE B,-1(D)
ADD B,A
MOVE G,(B)
XCT F
JRST VSORT2
EXCH G,(D)
EXCH G,-1(D)
EXCH G,(D)
JUMPL K,VSORT2
SETOM K
MOVEM D,E
POP E,(E)
POP E,(E)
HRRZ B,E
HRRZ C,M
CAMGE B,C
AOBJN E,.+1
JRST VSORT2
VSORTX: JUMPL K,VSORT1
POP P,M
POP P,G
POP P,A
POPJ P,
END START
Reference in New Issue View Git Blame Copy Permalink