Trailing-Edge
-
PDP-10 Archives
-
tops10and20_integ_tools_v9_3-aug-86
-
tools/crc/browse/lbr.mac
There are no other files named lbr.mac in the archive.
;melon:<crc-subs>LBR.MAC.2, 8-Nov-85 15:34:43, edit by Geoff
; Squeezing empty library goes bananas
;<KEVIN>LBR.MAC.22, 14-Dec-84 15:34:43, EDIT BY KEVIN
; If you do a PUSH when no library has ever been mapped, it doesn't
; work when you POP again.
;<KEVIN>LBR.MAC.21, 6-Aug-84 10:35:00, EDIT BY KEVIN
; Fix STATUS command - would not work if first directory command
;<KEVIN>LBR.MAC.20, 6-Aug-84 10:24:20, EDIT BY KEVIN
;<KEVIN>NEWLBR.MAC.8, 18-Jul-84 14:14:55, EDIT BY KEVIN
; Merge in updates from current LBR version - change version number
;<KEVIN>LBR.MAC.17, 10-Jul-84 16:32:41, EDIT BY KEVIN
; OPen library jfn restricted
;<KEVIN>LBR.MAC.16, 5-Jul-84 15:30:07, EDIT BY KEVIN
; (1) Further to last edit, only close/reopen when last command modified
; library.
; (2) Set up control-c fence during EDIT, so that lots of control-cs
; don't leave library in parlous state.
;<KEVIN>LBR.MAC.13, 21-Jun-84 11:37:30, EDIT BY KEVIN
; Add a new method of mapping out the library which doesn't require
; a table rebuild and a new map when re-opening. This is to be done
; between each command, and especially during PUSH (to catch system
; shutdown when library is opened.) Should fix lots of problems
; regarding strange eofs.
;<KEVIN>LBR.MAC.11, 29-May-84 11:36:05, EDIT BY KEVIN
; Make sure control-c interrupt instruction fence set up when in GUIDE
; mode, otherwise get strange messages from exec about instruction traps
; in ephemerons after control-C of GUIDE.
;<KEVIN>LBR.MAC.8, 29-Mar-84 13:34:46, EDIT BY KEVIN
; Make EDIT a lot cleverer about its output files. Don't use temporary
; files, and check to see if a file of the same name already exists, and
; if so, dispose of it. (Ask the user first.)
;<KEVIN>LBR.MAC.7, 23-Mar-84 14:52:01, EDIT BY KEVIN
; When the COPY for an EDIT command fails, the edit still tries to go
; on. Also, COPY still leaves an aborted output file if the expunge
; fails - not so good.
;<KEVIN>LBR.MAC.6, 15-Mar-84 11:29:33, EDIT BY KEVIN
; This one is so wierd as to be unbelievable. We must disable line number
; checking when opening libraries, as in some cases the system seems to
; think that, if the first IO occurs on a file containing nulls,
; the file contains line numbers, and so starts stripping the things
; off.
;<KEVIN>LBR.MAC.2, 8-Mar-84 18:12:13, EDIT BY KEVIN
; When opening libraries for write, also check for Archive status
; error.
;<KEVIN>NEWLBR.MAC.7, 18-Jul-84 13:40:34, EDIT BY KEVIN
; Make VDIREC,FDIREC do different things.
;<KEVIN>LBR.MAC.311, 13-Dec-83 16:34:55, EDIT BY KEVIN
; Instead of continuing an old EXEC, start it. It is bright enough to
; know not to repeat matters
;<KEVIN>LBR.MAC.308, 13-Dec-83 10:12:11, EDIT BY KEVIN
; Pause momentarily in PUSH when continuing old EXEC to get around problem
; where WFORK returns instantly.
;<KEVIN>LBR.MAC.307, 13-Dec-83 09:07:58, EDIT BY KEVIN
; Keep lower EXEC fork after PUSH.
;<KEVIN>LBR.MAC.306, 23-Nov-83 11:33:55, EDIT BY KEVIN
; Save acs over index building in case rescanned command.
;<KEVIN>LBR.MAC.304, 23-Nov-83 10:13:58, EDIT BY KEVIN
; Don't give INDEX option when there are no index files.
;<KEVIN>LBR.MAC.303, 22-Nov-83 19:16:09, EDIT BY KEVIN
;<KEVIN>LBR.MAC.297, 22-Nov-83 12:06:00, EDIT BY KEVIN
; Modify USERR to check NOERR flag.
; When in GUIDE mode, add an INDEX option for chapter listings.
;<KEVIN>LBR.MAC.295, 16-Nov-83 11:22:07, EDIT BY KEVIN
; Problem with SET - right half bits unintentionally set.
;<KEVIN>LBR.MAC.292, 15-Nov-83 15:26:49, EDIT BY KEVIN
;<KEVIN>LBR.MAC.288, 15-Nov-83 14:13:29, EDIT BY KEVIN
;<KEVIN>LBR.MAC.286, 14-Nov-83 18:08:46, EDIT BY KEVIN
;** - V1 fix for user specifying extra pages in create + a byte size
; Remove message about inconsistent stuff 'cos no slot found.
; Add checking of rescan line, modify for GUIDE-style usage.
;************************ Version 2 begins here ***************************
;<KEVIN>LBR.MAC.283, 1-Nov-83 13:42:22, EDIT BY KEVIN
;<KEVIN>LBR.MAC.280, 1-Nov-83 13:10:25, EDIT BY KEVIN
; Add a TDIRECTORY command (if we can)
;<KEVIN>LBR.MAC.278, 28-Oct-83 10:27:35, EDIT BY KEVIN
; Improve rescanning if there is nothing to rescan (like when PCL invokes)
;<KEVIN>LBR.MAC.276, 6-Oct-83 16:56:49, EDIT BY KEVIN
; Allow SQUEEZE to cope with zero-length modules.
;<KEVIN>LBR.MAC.275, 23-Sep-83 16:16:10, EDIT BY KEVIN
; If rescanned command gave a library, we should not even attempt to
; get a jfn on LIBRARY command in LBR.INIT. Just eat the command.
;<KEVIN>LBR.MAC.274, 25-Aug-83 14:33:00, EDIT BY KEVIN
; Lack of OKINT on each pass through REPLACE-type commands meant that
; library was left looking unsafe when in fact it was OK.
;<KEVIN>LBR.MAC.273, 24-Aug-83 10:17:17, EDIT BY KEVIN
; Don't try to fiddle lock word in header page if access is readonly.
;<KEVIN>LBR.MAC.271, 17-Aug-83 10:12:32, EDIT BY KEVIN
; Allow for crazy people who put mega-byte files in libraries.
;<KEVIN>LBR.MAC.269, 25-Jul-83 11:21:28, EDIT BY KEVIN
; Not releasing control-c locks properly on type command
;<KEVIN>LBR.MAC.266, 21-Jul-83 14:18:09, EDIT BY KEVIN
; Update help message.
;<KEVIN>LBR.MAC.264, 21-Jul-83 13:44:34, EDIT BY KEVIN
; Change action of control-c routines from always halting to executing
; instruction. This allows control-c during TYPE to abort typeout.
; Reset trap instruction to be HALTF% on each command.
;<KEVIN>LBR.MAC.260, 10-Jun-83 17:17:05, EDIT BY KEVIN
; Make LBR cope with strange end-of-file problems by expanding library.
; Also, for append output, NEVER use temp files
;<KEVIN>LBR.MAC.258, 6-Jun-83 13:11:35, EDIT BY KEVIN
; Allow initial creation of library to include extra pages.
;<KEVIN>LBR.MAC.256, 3-Jun-83 16:34:54, EDIT BY KEVIN
; Add switches to directory and list for /BEFORE, AFTER etc.
;<KEVIN>LBR.MAC.253, 3-Jun-83 11:58:08, EDIT BY KEVIN
; Don't print message of day in Batch - clutters up log files.
;<KEVIN>LBR.MAC.251, 2-Jun-83 17:16:18, EDIT BY KEVIN
; Must not open APPEND output files more than once
;<KEVIN>LBR.MAC.250, 2-Jun-83 17:03:23, EDIT BY KEVIN
;<KEVIN>LBR.MAC.249, 2-Jun-83 16:50:00, EDIT BY KEVIN
; Wildcard append not working correctly
;<KEVIN>LBR.MAC.248, 2-Jun-83 16:41:52, EDIT BY KEVIN
; Forgot to change tables ; make help better.
;<KEVIN>LBR.MAC.245, 2-Jun-83 16:33:18, EDIT BY KEVIN
; Add APPEND command, and improve MOD.
;<KEVIN>LBR.MAC.243, 19-Apr-83 14:54:15, EDIT BY KEVIN
; PRARG format has changed with V5
;<KEVIN>LBR.MAC.242, 19-Apr-83 14:39:41, EDIT BY KEVIN
; Add GO command to execute last load-class command on exit
;<KEVIN>LBR.MAC.240, 15-Apr-83 14:08:51, EDIT BY KEVIN
; Add a PUSH command (and slap wrists for not doing so before)
;<KEVIN>LBR.MAC.239, 11-Apr-83 10:29:20, EDIT BY KEVIN
; Change startup message.
;<KEVIN>LBR.MAC.238, 8-Apr-83 11:56:29, EDIT BY KEVIN
; Problems with USERR using JRST .+1 inside a literal, as literal may
; be nested. Use call/ret instead.
;<KEVIN>LBR.MAC.237, 6-Apr-83 17:31:39, EDIT BY KEVIN
; Don't print "?" in front of LBR.INIT errors if in batch
;<KEVIN>LBR.MAC.235, 25-Feb-83 10:07:01, EDIT BY KEVIN
; Change SED /READONLY
;<KEVIN>LBR.MAC.234, 1-Feb-83 18:46:11, EDIT BY KEVIN
; Make EDIT ensure that the input file to the editor is always deleted
; after the editor exits.
;<KEVIN>LBR.MAC.233, 1-Feb-83 18:18:37, EDIT BY KEVIN
; Change MOD
;<KEVIN>LBR.MAC.232, 1-Feb-83 13:56:33, EDIT BY KEVIN
; Allow INSERT command to just skip over duplicate files to
; be inserted.
;<KEVIN>LBR.MAC.231, 31-Jan-83 14:06:53, EDIT BY KEVIN
; Don't alter bytesize or extension if library already contains modules.
; (So people can have a library of files with no extension.)
;<KEVIN>LBR.MAC.230, 28-Jan-83 12:03:13, EDIT BY KEVIN
; Allow LBR to merge in an external DDT and use the unsolicted
; breakpoint address.
;<KEVIN>LBR.MAC.229, 27-Jan-83 13:50:54, EDIT BY KEVIN
; ABOTAK fucked up the flag bits.
;<KEVIN>LBR.MAC.226, 20-Jan-83 11:03:36, EDIT BY KEVIN
; Make HELP talk about SET SED
;<KEVIN>LBR.MAC.224, 19-Jan-83 19:08:14, EDIT BY KEVIN
; Add SET SED command for default editor
;<KEVIN>LBR.MAC.223, 18-Jan-83 17:19:48, EDIT BY KEVIN
; Change HELP LIBRARY to mention rescanning command line.
;<KEVIN>LBR.MAC.222, 18-Jan-83 17:10:07, EDIT BY KEVIN
;<KEVIN>LBR.MAC.220, 18-Jan-83 16:50:56, EDIT BY KEVIN
; Make LBR rescan its command line for a library (NOT for a command)
;<KEVIN>LBR.MAC.218, 29-Nov-82 13:34:43, EDIT BY KEVIN
; Make commands that accept wildcards reject invalid module names before
; confirm.
;<KEVIN>LBR.MAC.217, 16-Nov-82 16:25:52, EDIT BY KEVIN
; Make LBR keep subsystem stats.
;<KEVIN>LBR.MAC.216, 9-Nov-82 13:47:39, EDIT BY KEVIN
; EDTPTR wrong
;<KEVIN>LBR.MAC.215, 8-Nov-82 17:59:26, EDIT BY KEVIN
; Add switches to EDIT - /SED and /READONLY
;<KEVIN>LBR.MAC.210, 26-Oct-82 18:24:01, EDIT BY KEVIN
; Try for a LBR.INIT
;<KEVIN>LBR.MAC.208, 25-Oct-82 15:02:27, EDIT BY KEVIN
; Losing count in file positioning in DIRECT
;<KEVIN>LBR.MAC.206, 25-Oct-82 14:55:32, EDIT BY KEVIN
; Problems with multiply define labels
;<KEVIN>LBR.MAC.202, 25-Oct-82 14:25:21, EDIT BY KEVIN
; Add ability for LIST output to go to a named file (like LPT: !)
;<KEVIN>LBR.MAC.201, 13-Sep-82 17:19:36, EDIT BY KEVIN
; Check whether we are in batch for control-c stuff
;<KEVIN>LBR.MAC.200, 13-Sep-82 17:13:29, EDIT BY KEVIN
; Change MOD
;<KEVIN>LBR.MAC.199, 10-Sep-82 10:51:03, EDIT BY KEVIN
; EXPUNGE can delete LBR output files !!
;<KEVIN>LBR.MAC.198, 26-Aug-82 19:22:13, EDIT BY KEVIN
; Must reset TYPING flag each command
;<KEVIN>LBR.MAC.197, 26-Aug-82 19:17:39, EDIT BY KEVIN
; Cannot use SCRATCH for filename
;<KEVIN>LBR.MAC.196, 26-Aug-82 19:10:16, EDIT BY KEVIN
; Separate buffer needed for rescan
;<KEVIN>LBR.MAC.195, 26-Aug-82 19:04:48, EDIT BY KEVIN
;<KEVIN>LBR.MAC.194, 26-Aug-82 19:03:03, EDIT BY KEVIN
;<KEVIN>LBR.MAC.193, 26-Aug-82 18:56:39, EDIT BY KEVIN
; Add EDIT command
;<KEVIN>LBR.MAC.192, 19-Aug-82 10:45:16, EDIT BY KEVIN
;<KEVIN>LBR.MAC.191, 19-Aug-82 10:39:34, EDIT BY KEVIN
; Allow COPY to EXPUNGE
;<KEVIN>LBR.MAC.190, 19-Aug-82 10:11:15, EDIT BY KEVIN
; Include UPDATE in HELP commands
;<KEVIN>LBR.MAC.188, 6-Aug-82 14:03:32, EDIT BY KEVIN
; Make data buffer be multiple pages to speed up squeeze, etc.
;<KEVIN>LBR.MAC.187, 5-Aug-82 14:59:00, EDIT BY KEVIN
; Change error messages to tell user about LIBRARY command if they
; can't figure it.
;<KEVIN>LBR.MAC.186, 2-Aug-82 17:53:04, EDIT BY KEVIN
; DIRECTORY (of modules) GARBAGE produces 2 error messages
;<KEVIN>LBR.MAC.181, 2-Aug-82 14:55:24, EDIT BY KEVIN
; Set up to produce a UNV file too
;<KEVIN>LBR.MAC.179, 29-Jul-82 10:01:35, EDIT BY KEVIN
; Typo in REPLACE affects non-wild replace commands
;<KEVIN>LBR.MAC.178, 27-Jul-82 12:25:27, EDIT BY KEVIN
; SFBSZ does not affect what is returned by SIZEF. We must close and
; reopen the file to make this work, it appears.
; Cure: use SFPTR to EOF then RFPTR instead of SIZEF.
;<KEVIN>LBR.MAC.177, 26-Jul-82 17:44:54, EDIT BY KEVIN
; Check for offline files before insert, etc.
;<KEVIN>LBR.MAC.174, 26-Jul-82 16:06:08, EDIT BY KEVIN
;<KEVIN>LBR.MAC.169, 26-Jul-82 14:41:09, EDIT BY KEVIN
; Add SET EPHEMERAL, SET PERMANENT
;<KEVIN>LBR.MAC.167, 26-Jul-82 14:01:59, EDIT BY KEVIN
; Fix problem with reading files with linenumbers.
;<KEVIN>LBR.MAC.165, 26-Jul-82 13:17:27, EDIT BY KEVIN
; Fix bug with calculation of size of modules whose byte size does
; not match library.
; Change default byte size from 7 to 0
;<KEVIN>LBR.MAC.163, 26-Jul-82 11:50:48, EDIT BY KEVIN
;<KEVIN>LBR.MAC.161, 26-Jul-82 11:17:47, EDIT BY KEVIN
; Bug in EXPDIR with page numbering
;<KEVIN>LBR.MAC.160, 23-Jul-82 13:33:48, EDIT BY KEVIN
Universal LBR
;
; Mapping pages
;
datpag==100000 ;data buffer
hdrpag==200000 ;page to map header to
modules==300000 ;start of TBLUK table
squpag==datpag ;page for squeezing things
squhdr==datpag ;page for copying directory entries
tdlist==datpag ;Page(s) for sorted list in TDIR
ndpag==10 ;number of buffer pages (one disk track)
idxtab==datpag+ndpag*1000 ;where to put index tables
maxidx==100 ;no more than 64 index chapters at the moment
;
; Offsets in header block
;
$hwih==1 ;words in header
$hext==2 ;file type of modules
$hbysz==^d10 ;byte size of modules
$hupdt==^d11 ;last update
$hnent==^d12 ;number of directory entries
$hlfre==^d13 ;size of largest free block
$hflgs==^d14 ;header flags
$htfre==^d15 ;total free space
$hwpde==^d16 ;number of words in directory entry
$hnext==^d17 ;number of pages in extension directory
$hsafe==^d18 ;safety marker
$hndel==^d19 ;number of deleted entries
$hdir==^d20 ;start of directory
unsafe==hdrpag+$hsafe ;useful mnemonic
;
; Directory entry offsets
;
$dmnam==0 ;module name (8 words)
$dmstrt==8 ;start of module
$dmlen==9 ;length of module
$dmupd==^d10 ;insert/update time stamp
;
; Flag bits in $HFLGs
;
hfprm==1b0 ;permanent/ephemeral bit
;
; Definitions of current values for library header block
;
wpde==^d11 ;number of words in a directory entry
wih==^d20 ;number of words in a header block
hdrmrk==^d17758 ;Library ID word
maxent==<<modules-hdrpag-wih>/wpde>-1 ;maximum number of modules in a library
mxpg0=<1000-wih>/wpde ;maximum entries in page 0
mxpgn=1000/wpde ;maximum entries in continuation pages
prgend
Title LBR - program to create and maintain universal libraries
;
; This is a program to maintain universal libraries, much as they exist
; on RSX. A universal library is a file much like a REL file library
; made by MAKLIB, except the the files can be anything - text files,
; command files, etc. The only restriction is that they should all
; originally have had the same file type (extension). The library is
; used to store many original files in one large file, thus saving space
; with small files. Individual files can be extracted from the library
; at any time, or deleted, updated, replaced, etc. Subroutines are
; also available to allow user programs to access files within libraries
; directly, without having to extract them. This can make libraries useful
; for things like tree-structure help files, etc.
; In version 2, the program can be used in a restricted mode to
; access tree-structured help files. A table is maintained at
; SPCTAB of special commands and library names. If LBR sees COMMAND
; in the rescan buffer, it opens a specific library, and changes the
; TYPE command to be INFO. Thus, it can be used like the GUIDE program,
; and GUIDE PRINT will access SYS:GUIDE.LBR and extract module PRINT.
;
;
;
; Library structure is as follows:
;
; Page 0 is the info block, as follows:
; 0 Library header - contains 17758 (decimal)
; 1 Number of words in header before directory
; 2-9 File type of files within this library
; 10 Byte size of files within this library
; 11 Internal date and time of last library update
; 12 Number of entries in library directory
; 13 Size of largest free block in bytes
; 14 Address of largest free block in bytes
; 15 Total unused space in library in bytes
; 16 Number of words in a directory entry
; 17 Safety flag - unsafe if non-zero
; 18 Number of deleted directory entries
; 19-511 Library directory (see below)
;
; Format of a directory entry:
; 0-7 Name of module (ASCIZ)
; 8 Starting byte in file
; 9 Length of module in bytes
; 10 Insertion or update date (internal format).(0 if a deleted entry)
;
search vtmac
search lbr
regdef
external error,errmes,getddt,$bpt
.require k:ersub
.require k:getddt
;
; Macro definitions.
; NOISE (text) - Parse noise field with COMND.
; CONFIRM - Parse end of line
; Both the above check for errors, and issue an automatic return.
; USERR(errmes,flag,jfn) Type error message preceded by ? on a new line
; if needed. If flag is JSYS or JSY, issue jsys
; error message. If flag is FIL, type filename of
; jfn. Return.
; If NOERR is on, do nothing except return
;
; QUOERR To be placed after JSYS's that we want to cause
; an EXPUNGE if they fail.
; COMND(fdb,errmes,jsy) Parse command pointed to by FDB. If parse fails,
; issue a USERR call with the supplied params.
; DMSG (text) Type text if debug flag is set.
; NOINT Inhibit interrupts and mark library unsafe.
; OKINT Decrement lock nesting level, if fully
; cleared, allow interrupts and mark library as
; safe.
; CHKSFE Check safety flag. If unsafe, issue error and
; return.
define noise(nse),<hrroi t2,[asciz/nse/]
call skpnoi
ret>
define confirm,<call endcom
ret>
define userr(text,jsyse<>,jfn<>),<
ifidn <jsyse> <fil>,<push p,jfn>
txne f,noerr ;;error inhibit set ?
ret ;;yes, just return
call tstcol
movei t1,"?" ;;assume non-timeshare job
txne f,takini ;;executing LBR.INIT ?
call [txnn f,timesh ;;yes, in batch ?
movei t1,"%" ;;yes, make it a warning
ret] ;;and continue
pbout% ;;output prefix
tmsg <'text>
ifidn <jsyse> <jsys>,<call puterr>
ifidn <jsyse> <jsy>,<call puterr>
ifidn <jsyse> <fil>,<pop p,t2
movei t1,.priou
setzb t3,t4
jfns%
erjmp .+1>
call abotak ;;abort take file if necessary
ret>
define quoerr(text),<xct errop>
define comand(field,erms<>,jsy<>),<
movei t1,cmdblk
movei t2,field
comnd%
erjmp cmderr
txne t1,cm%nop
jrst [userr <erms>,jsy]>
define dmsg(text),<
hrroi t1,[asciz\text\]
txne f,debug
psout%>
define noint,<call liblck>
define okint,<call lunlock>
define chksfe,<
skipe unsafe ;;safety flag ok ?
jrst [userr <Command is not permitted on a library that is marked unsafe - rebuild the library>]>
f==0 ;flag ac
w$ild==1b1 ;bit indicating wild parse of module name
typing==1b2 ;bit for type/copy command
rwild==1b3 ;bit for repeated wild scan
tempot==1b4 ;output files are temporary
debug==1b5 ;print debugging info
intsys==1b6 ;1 if interrupt system set up
ccwait==1b7 ;1 if a control-c interrupt pending
iexpunge==1b8 ;inhibit auto-expunge
alowsq==1b9 ;allow auto-squeezes
ccints==1b10 ;1 if control-c can be trapped
ronly==1b11 ;library was mapped read only
listc==1b12 ;using LIST (as opposed to DIRECTORY) command
takini==1b13 ;executing LBR.INIT
rslib==1b14 ;rescan successfully got a library name
defsed==1b15 ;SED is the default editor
timesh==1b16 ;we are not a batch job
apping==1b17 ;APPEND/COPY flag
appnxt==1b18 ;Flag to say output file for append is already open
clsnrj==1b19 ;Tell UMAP not to release lib jfn
tdirf==1b20 ;First pass of TDIR (collecting matching pointers)
tdir2==1b21 ;Second pass of TDIR (outputting directory)
guide==1b22 ;LBR is pretending to be GUIDE or something
grscom==1b23 ;Exit after rescanned command (ie was GUIDE PRINT et al)
gprint==1b24 ;PRINT command used instead of INFO
idxmod==1b25 ;in guide mode, INDEX modules were found.
noerr==1b26 ;Inhibit error traps
tabok==1b27 ;flag to MAPLIB to keep old TBLUK tables
modif==1b28 ;flag set by modifying commands
fdflg==1b29 ;FDIRECTORY, so print header stuff
vdflg==1b30 ;VDIR, so print dates/times
qdflg==1b31 ;QDIRECTORY , deleted modules
;
; Flag bits for EDIT
;
edtrdo==1b35 ;edit /READONLY
edtsed==1b34 ;edit /SED
copyok==1b33 ;if 1, copy failed
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ ;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2 ;SIZE OF FUNCTION DESCRIPTOR BLOCK
PDLEN==50 ;PUSH-DOWN STACK LENGTH
;INTERRUPT CHANNELS
RADIX 5+5
CHNTAB:
ccchan: 1,,ctrlc ;control c interrupts on level 1
ICH001: BLOCK 1 ;ASSIGNABLE CHANNEL 1
ICH002: BLOCK 1 ;ASSIGNABLE CHANNEL 2
ICH003: BLOCK 1 ;ASSIGNABLE CHANNEL 3
ICH004: BLOCK 1 ;ASSIGNABLE CHANNEL 4
ICH005: BLOCK 1 ;ASSIGNABLE CHANNEL 5
ICHAOV: BLOCK 1 ;ARITHMETIC OVERFLOW
ICHFOV: BLOCK 1 ;FLOATING OVERFLOW
ICH008: BLOCK 1 ;RESERVED
ICHPOV: BLOCK 1 ;PDL OVERFLOW
ICHEOF: BLOCK 1 ;END OF FILE
ICHDAE: BLOCK 1 ;DATA ERROR
ICHQTA: 2,,quota ;disk quota exceeded on level 2
ICH013: BLOCK 1 ;RESERVED
ICHTOD: BLOCK 1 ;TIME OF DAY (RESERVED)
ICHILI: BLOCK 1 ;ILLEG INSTRUCTION
ICHIRD: BLOCK 1 ;ILLEGAL READ
ICHIWR: BLOCK 1 ;ILLEGAL WRITE
ICHIEX: BLOCK 1 ;ILLEGAL EXECUTE (RESERVED)
ICHIFT: BLOCK 1 ;INFERIOR FORK TERMINATION
ICHMSE: BLOCK 1 ;MACHINE SIZE EXCEEDED
ICHTRU: BLOCK 1 ;TRAP TO USER (RESERVED)
ICHNXP: BLOCK 1 ;NONEXISTENT PAGE REFERENCED
ICH023: BLOCK 1 ;ASSIGNABLE CHANNEL 23
ICH024: BLOCK 1 ;ASSIGNABLE CHANNEL 24
ICH025: BLOCK 1 ;ASSIGNABLE CHANNEL 25
ICH026: BLOCK 1 ;ASSIGNABLE CHANNEL 26
ICH027: BLOCK 1 ;ASSIGNABLE CHANNEL 27
ICH028: BLOCK 1 ;ASSIGNABLE CHANNEL 28
ICH029: BLOCK 1 ;ASSIGNABLE CHANNEL 29
ICH030: BLOCK 1 ;ASSIGNABLE CHANNEL 30
ICH031: BLOCK 1 ;ASSIGNABLE CHANNEL 31
ICH032: BLOCK 1 ;ASSIGNABLE CHANNEL 32
ICH033: BLOCK 1 ;ASSIGNABLE CHANNEL 33
ICH034: BLOCK 1 ;ASSIGNABLE CHANNEL 34
ICH035: BLOCK 1 ;ASSIGNABLE CHANNEL 35
RADIX 8
SAVRET: BLOCK 1 ;RETURN ADDRESS OF CMDINI CALLER
SAVREP: BLOCK 1 ;SAVED STACK POINTER TO RESTORE ON REPARSE
RETPC1: BLOCK 1 ;RETURN PC FOR INTERRUPT LEVEL 1
RETPC2: BLOCK 1 ;RETURN PC FOR INTERRUPT LEVEL 2
RETPC3: BLOCK 1 ;RETURN PC FOR INTERRUPT LEVEL 3
CMDBLK: BLOCK .CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
ATMBFR: BLOCK ATMSIZ ;ATOM BUFFER FOR COMND JSYS
GJFBLK: BLOCK GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
PDL: BLOCK PDLEN ;PUSH DOWN POINTER
NOIFDB: BLOCK FDBSIZ ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
NAMBUF: BLOCK 8 ;BUFFER FOR NAME OF INPUT FILE
INJFN: BLOCK 1 ;INPUT JFN FOR TAKE COMMAND
OUTJFN: BLOCK 1 ;OUTPUT JFN FOR TAKE COMMAND
TAKFLG: BLOCK 1 ;NON-ZERO IF PROCESSING INDIRECT FILE
eswits: 0 ;flag bits for EDIT switches
havddt: 0 ;-1 if DDT loaded
mapcnt: 0 ;counter for waits to access library
libjfn: 0 ;jfn of library file
filjfn: 0 ;jfn of current module
lisjfn: 0 ;jfn for LIST output
defext: block 8 ;file type of library modules (CREATE)
bysiz: 0 ;byte size "" """ ""
mappd: 0 ;=1 if library mapped
loklvl: 0 ;lock nest level on library directory
ccxct: 0 ;instruction to execute when control-c trapped
modbsz: 0 ;byte size of new module
filsiz: 0
libsiz: 0
litlst: 0 ;size of smallest module found
litlad: -1 ;address of best fit slot for module
squjfn: 0 ;jfn of new library being "squeezed"
chdr: 0 ;current directory entry for squeeze
cfil: 0 ;current "eof" pointer in squeeze
dirnum: 0 ;directory number of directory to be expunged
used: 0 ;space used in target EXPUNGE directory
dirnam: block ^d17 ;name of target directory for EXPUNGE
errop: nop ;instruction for execution after SOUT to lib
repjfn: 0 ;jfn for input in REPLACE command
edtptr: 0 ;pointer to crucial bits of edit buffer
luknam: block 9 ;name for lookup
guinam: block 4 ;prompt when in GUIDE mode
scratch: block 20
edtbuf: block ^d20 ;filename edit buffer
copnam: block 8 ;wild module name in copy command
outnam: block 8 ;name for output in wild copys
outext: block 8 ;type " ""
outdir: block ^d16 ;structure/directory """""
prgjfn: 0 ;JFN of editor file
frkhnd: 0 ;inferior fork handle
excfrk: 0 ;Fork for PUSH command
mptrs: 0 ;pointer pointer for TDIR
wldjfn: 0 ;parse only jfn for output
wldptr: 0 ;pointer to directory for output
wldcnt: 0 ;number of entries yet to search on wild lookup
wldblk: gj%fou ;all wild stuff is for output files
.nulio,,.nulio ;all is done from strings
0 ;no default device (in strings)
0 ;or directory ""
-1,,outnam ;pointer to name
-1,,outext ;and extension
0 ;no prot
0 ;no account
0 ;no special jfn
subttl Pure data
DEFINE TB(RTN,TXT)
< [ASCIZ/TXT/] ,, RTN
>
DEFINE ITB(RTN,TXT)
< [CM%FW!CM%INV
ASCIZ/TXT/],,RTN> ;INVISIBLE TABLE ENTRY
CMDTAB: CMDSIZ-1,, CMDSIZ ;CURRENT,,MAX SIZE OF COMMAND TABLE
TB (.APPEN,APPEND) ;APPEND (modules) mods (to file) fil
tb (.COPY,COPY) ;extract module from library
TB (.CREATE,CREATE) ;CREATE (Library name)
itb (.ddt,DDT) ;enter ddt (invisible)
TB (.DELETE,DELETE) ;Remove module from library
TB (.DIREC,DIRECTORY) ;alternative for LIST
TB (.EDIT,EDIT) ;EDIT (module)
TB (.EXIT,EXIT) ;EXIT TO MONITOR
TB (.FDIREC,FDIRECTORY) ;Full directory with header info
TB (.GO,GO) ;GO (and execute last load-class command)
TB (.HELP,HELP) ;OUTPUT HELP MESSAGE
tb (.insert,INSERT) ;insert new module
tb (.library,LIBRARY) ;select new library file
tb (.list,LIST) ;list library directory
tb (.push,PUSH) ;grab an EXEC
; tb (.qdir,QDIRECTORY) ;directory of deleted
tb (.replace,REPLACE) ;update modules
tb (.set,SET) ;Set all sorts of things
tb (.squeeze,SQUEEZE) ;SQUEEZE (empty space from library)
TB (.SDIREC,STATUS) ;Print library banner
TB (.TAKE,TAKE) ;TAKE (COMMANDS FROM) FILE-SPEC ...
TB (.TDIR,TDIRECTORY) ;Directory sorted by time
tb (.type,TYPE) ;type (module)
tb (.update,UPDATE) ;REPLACE without module name
TB(.VDIREC,VDIRECTORY) ;Directory with dates, times, etc.
CMDSIZ== .-CMDTAB
;
; Command table for GUIDE-style stuff
;
guicmd: guisiz,,guisiz
itb (.DDT,DDT)
tb (.gexit,EXIT)
tb (.ghelp,HELP)
tb (.ginfo,INFO) ;INFORMATION (about subject)
tb (.gprnt,PRINT)
tb (.gexit,QUIT)
guisiz==.-guicmd-1
;
; Switches for EDIT
;
edswit: edsiz,,edsiz
TB (edtrdo,READONLY)
TB (edtsed,SED) ;use SED
edsiz==.-edswit-1
; Tables of rescan commands/libraries to use for them.
;
DEFINE X (CMD,LIB),<[ASCIZ/CMD/],,[ASCIZ/SYS:'LIB'.LBR/]>
SPCTAB: spcsiz,,spcsiz
X GUIDE,GUIDE
[asciz/LBR/],,0
X NAG,NAG
X SUBS,SUBS
SPCSIZ=.-SPCTAB-1
; LEVEL TABLE FOR INTERRUPT SYSTEM
LEVTAB: RETPC1
RETPC2
RETPC3
; ENTRY VECTOR DEFINITION
ENTVEC: JRST START ;MAIN ENTRY POINT
JRST START ;REENTER ENTRY POINT
verno 3,,298,3
subttl Main program
START: RESET ;RESET THE UNIVERSE
getnm% ;get our private program name
move t2,t1 ;copy it..
setsn% ;make into system name
ercal error
MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
SETZM TAKFLG ;MARK THAT TAKE FILE NOT BEING PROCESSED
HRROI T1,[asciz/LBR>/] ;GET POINTER TO PROMPT STRING
MOVEM T1,CMDBLK+.CMRTY ;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
HRROI T1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM T1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM T1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
MOVEI T1,PARSE1 ;GET RE-PARSE ADDRESS
MOVEM T1,CMDBLK+.CMFLG ;SAVE RE-PARSE ADDRESS
SETZM CMDBLK+.CMINC ;INITIALIZE # OF CHARACTERS AFTER POINTER
MOVEI T1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM T1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
HRROI T1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM T1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI T1,ATMSIZ*NCHPW ;GET # OF CHARACTERS IN ATOM BUFFER
MOVEM T1,CMDBLK+.CMABC ;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
call intset ;set up interrupt system
txo f,tempot!iexpunge!alowsq
;indicate temporary output files, autoexpunge, allow autosqueeze
call rescan ;try for a library name on the command line
txne f,timesh ;interactive ?
call mod ;yes, type message of day
txnn f,guide ;in guide mode ?
CALL inifil ;no, so try for LBR.INIT
txne f,guide ;GUIDE mode ?
call idxbld ;yes, build the table of indices.
move t1,[jrst cctyp] ;if in GUIDE mode, control-c trap inst
movem t1,ccxct ;store where it can be found
txne f,grscom ;GUIDE mode with module from command line ?
jrst [movei t4,.priou ;output for command
jrst .copy3] ;yes, so we just go straight to type
PARSE: HRROI T1,[asciz/LBR>/] ;GET POINTER TO PROGRAM'S PROMPT STRING
txne f,guide ;in GUIDE mode ?
hrroi t1,guinam ;yes, pick up prompt string
CALL CMDINI ;OUTPUT THE PROMPT
PARSE1: txz f,w$ild!rwild!typing!listc!apping!gprint!noerr!vdflg!fdflg!qdflg ;indicate no wild modules
MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK AGAIN
SETOM T1 ;INDICATE ALL JFN'S SHOULD BE RELEASED
RLJFN ;RELEASE ALL JFN'S
JSERR ;UNEXPECTED ERROR
CALL CLRGJF ;GO CLEAR GTJFN BLOCK
move t1,[txo f,ccwait];instruction to execute when trapping ^C
movem t1,ccxct ;store where it can be found.
MOVEI T1,GJFBLK ;GET ADDRESS OF GTJFN BLOCK
MOVEM T1,CMDBLK+.CMGJB ;STORE POINTER TO GTJFN BLOCK
txne f,ronly ;Read only library ?
ifskp. ;if not....
skipn mappd ;are we mapped ?
ifskp. ;if so...
txzn f,modif ;did last command modify library, or could it?
ifskp. ;if so...
txo f,clsnrj!tabok ;unmap, keep jfn, keep lookup tables
call umap
call maplib ;close and reopen library to keep FDB happy
endif.
endif.
endif. ;end conditionals
MOVEI T1,CMDBLK ;GET POINTER TO COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMKEY,,CMDTAB)] ;GET FUNCTION BLOCK
txne f,guide ;in guide mode ?
movei t2,[flddb. (.cmkey,,guicmd)] ;yes, use guide commands
COMND ;DO INITIAL PARSE
erjmp cmderr ;error, go check for eof on take file
TXNN T1,CM%NOP ;VALID COMMAND ENTERED ?
JRST PARSE5 ;YES, GO DISPATCH TO PROCESSING ROUTINE
CALL TSTCOL ;TEST COLUMN POSITION, NEW LINE IF NEEDED
TMSG <? LBR: No such LBR command as ">
MOVE T1,CMDBLK+.CMABP ;GET POINTER TO ATOM BUFFER
PSOUT ;OUTPUT STRING ENTERED BY USER
TMSG <"
> ;OUTPUT END-OF-MESSAGE
call abotak ;dispose of take file if necessary
JRST PARSE ;GO TRY TO GET A COMMAND AGAIN
PARSE5: HRRZ T1,(T2) ;GET DISPATCH ADDRESS
CALL (T1) ;PERFORM REQUESTED FUNCTION
JRST PARSE ;GO PARSE NEXT COMMAND
SUBTTL TAKE (COMMANDS FROM) FILE-SPEC (LOGGING OUTPUT ON) FILE-SPEC
.TAKE: HRROI T2,[ASCIZ/COMMANDS FROM/] ;GET NOISE TEXT
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
CALL CLRGJF ;GO CLEAR GTJFN BLOCK
MOVX T1,GJ%OLD ;GET EXISTING FILE FLAG
MOVEM T1,GJFBLK+.GJGEN ;STORE GTJFN FLAGS
HRROI T1,[ASCIZ/CMD/] ;GET DEFAULT FILE TYPE FIELD
MOVEM T1,GJFBLK+.GJEXT ;STORE DEFAULT EXTENSION
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMFIL)] ;GET FUNCTION DESCRIPTOR BLOCK ADDRESS
COMND ;PARSE INPUT FILE SPEC
erjmp cmderr ;error, go check for eof on take file
TXNN T1,CM%NOP ;PARSED FILE-SPEC OK ?
JRST TAKE10 ;YES, GO ON AND SAVE INPUT JFN
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? LBR: Invalid file specification, >
CALLRET PUTERR ;OUTPUT ERROR STRING TO TERMINAL
; HERE ON A GOOD INPUT FILE SPEC
TAKE10: MOVEM T2,INJFN ;SAVE INPUT JFN FOR COMMANDS
CALL ENDCOM ;GO PARSE COMMAND CONFIRMATION
RET ;RETURN, BAD CONFIRMATION
; OPEN INPUT AND OUTPUT FILES
MOVE T1,INJFN ;GET INPUT JFN
MOVE T2,[7B5+OF%RD] ;7 BIT BYTES, READ ACCESS
OPENF ;OPEN INPUT FILE
JRST [ CALL TSTCOL ;ERROR, ISSUE NEW LINE IF NEEDED
TMSG <? LBR: Cannot OPEN command file, >
CALLRET PUTERR] ;GO ISSUE REST OF MESSAGE AND RETURN
; NOW SAVE NEW JFN'S AND RETURN TO PARSER
TAKE30: HRLZ T1,INJFN ;GET INPUT JFN
hllm t1,cmdblk+.cmioj ;save new input jfn
SETOM TAKFLG ;MARK THAT COMMANDS ARE COMING FROM FILE
RET ;RETURN TO PARSER
Subttl CREATE command
;
; This command CREATES a new library
; CREATE (Library) libfil.typ (extension) ext (byte size) n (with room for) ents
;
; Extension and byte size default to null.
;
.create: stkvar <newlib,inient,dirpgn>
noise <new library>
movx t1,gj%new!gj%acc ;don't allow inferiors to meddle with jfn
movem t1,gjfblk
hrroi t1,[asciz/LBR/]
movem t1,gjfblk+.gjext ;store default extension
comand <[flddb. (.cmfil,cm%sdh,,<Name of new universal library>)]>,<Invalid library file name - >,jsy
movem t2,newlib ;store jfn
noise (extension)
comand <[flddb. (.cmact,cm%sdh,,<Confirm with carriage return, or file type for all files in library>,<>)]>,<Bad extension - >,jsy
move t1,[atmbfr,,defext]
blt t1,defext+7 ;copy file extension
noise <byte size>
comand <[flddb. (.cmnum,cm%sdh,^d10,<Byte size for files in library>,<0>)]>,<Invalid number - >,jsy
jumpl t2,[userr <Byte size must be 0-36>]
caile t2,^d36 ;OK byte size ?
jrst [userr <Byte size must be less than 36>] ;no
movem t2,bysiz ;store byte size
noise (with room for) ;this many entries
comand <[flddb. (.cmnum,cm%sdh,^d10,<Initial number of files to allow for>,<0>)]>,<Invalid number - >,jsy
jumpl t2,[userr <Must have a positive number of files !>]
caile t2,maxent ;less than maximum entries ?
jrst [userr <Too many entries specified>]
movem t2,inient ;save initial number of entries
noise (entries initially)
confirm ;get confirmation
txo f,modif ;flag library is modified
call umap ;unmap any current library
move t1,newlib ;get new library jfn
movem t1,libjfn ;make current library
txz f,ronly ;clear any read-only flags
move t1,inient ;get initial number of entries
caig t1,mxpg0 ;at least enough for one page ?
movei t1,mxpg0 ;no, make it at least one page
subi t1,mxpg0 ;subtract number of entries we can fit in 1 page
idivi t1,mxpgn ;and divide by number in subsequent pages
skipe t2 ;any remainder ?
aoj t1, ;yes, add one more page
aoj t1, ;add on page 0
movem t1,dirpgn ;store number of pages in directory
setzm hdrpag ;zero out the header page
move t1,[hdrpag,,hdrpag+1] ;source,,dest for BLT
move t2,dirpgn ;get number of pags in directory
imuli t2,1000 ;convert to a number of words
soj t2, ;keep within last page
addi t2,hdrpag ;get address of end of directory buffer
blt t1,(t2) ;now zero the directory
movei t1,hdrmrk ;magic number for page 0 of library
movem t1,hdrpag ;store it
movei t1,wih ;number of words in current header
movem t1,hdrpag+$hwih ;store it
move t1,[defext,,hdrpag+$hext]
blt t1,hdrpag+$hext+7 ;store default extension
move t1,bysiz ;get byte size for library
movem t1,hdrpag+$hbysz ;store
gtad% ;get current date and time
movem t1,hdrpag+$hupdt ;store as time of last update
movei t1,wpde ;words per directory entry
movem t1,hdrpag+$hwpde ;store
move t1,dirpgn ;get number of pages in directory
soj t1, ;subtract one for extension pages
movem t1,hdrpag+$hnext ;store
move t1,libjfn ;get library jfn
movx t2,of%wr
openf% ;open it
erjmp [userr <Cannot open new library - >,jsys]
move t1,libjfn ;write to new library
move t2,[point ^d36,hdrpag] ;from header page
movn t3,dirpgn ;number of pages to do (negative)
imuli t3,1000 ;convert to words
sout% ;write it
quoerr <Cannot write to library>
move t1,libjfn ;now get library
txo t1,co%nrj
closf% ;close, but do not release jfn
ercal error ;tuff
move t1,libjfn ;point to file
txo t1,fld(.fbbyv,cf%dsp) ;word to change
movx t2,fb%bsz ;mask in word to alter
move t3,bysiz ;new byte size for library
lsh t3,<^d35-pos(fb%bsz)>;shifted to proper place
chfdb% ;do it
ercal error
move t3,bysiz ;get byte size
skipn t3 ;is it 0 ?
movei t3,^d36 ;yes, make 36
movei t2,^d36 ;number of bits in word
idiv t2,t3 ;fidn number of bytes in word
imuli t2,^d512 ;get number of bytes in page
imul t2,dirpgn ;multiply by pages in directory
movem t2,t3
move t1,libjfn ;jfn of file
txo t1,fld(.fbsiz,cf%dsp) ;field to modify
seto t2, ;modify all bits
chfdb% ;reset eof byte pointer
ercal error
jrst maplib ;now map new library
subttl LIST - list directory of library file
;
; This command lists all modules in the library
;
; Macro to output message to listing file
define lmsg(text),<
xlist
push p,t2
push p,t3
push p,t4 ;;save some acs
move t1,lisjfn ;;point to output
hrroi t2,[asciz\text\]
setzb t3,t4 ;;terminate on nulls
sout%
ercal error
pop p,t4
pop p,t3
pop p,t2
list>
; Macro to output message and number
define onum(text,value),<
xlist
lmsg <
text>
xlist
move t1,lisjfn
move t2,value
movx t3,^d10
nout%
ercal error
list>
; Switch table
afbtab: 6,,6
[ASCIZ/AFTER:/],,aftswi
[ASCIZ/BEFORE:/],,befswi
[ASCIZ/FULL/],,fulswi
[ASCIZ/OUTPUT:/],,outswi
[ASCIZ/SORTED-BY-TIME-AND-DATE/],,srtswi
[ASCIZ/VERBOSE/],,verswi
.list: noise <of modules called>
txo f,listc ;flag LIST command
jrst .dirc1
.tdir: noise <of modules, by time of update>
txo f,tdirf ;flag sorted directory
movei t1,tdlist ;where list begins
movem t1,mptrs ;initialize pointer
jrst .dirc1 ;join common code
.FDIREC: noise <full directory of modules>
txo f,fdflg!vdflg
jrst .dirc1
.vdirec: noise <verbose directory>
txo f,vdflg
jrst .dirc1
.sdirec: noise <of current library>
confirm
movei t1,.priou ;STATUS always works to TTY:
movem t1,lisjfn
call shohed
ret
.direc: noise <of modules in library>
.dirc1: skipn mappd ;got a library ?
jrst [userr <No library file selected - use LIBRARY command>]
trvar <lodate,hidate,afbtyp>
movei t1,.priou ;set up default output device
movem t1,lisjfn ;in case they typed LIST and CONFIRM
comand [
flddb. (.cmact,cm%sdh,,<Modules to list, or return to list all>,<*>,)],<Invalid module name - >,jsy
move t1,[atmbfr,,copnam]
blt t1,copnam+7 ;copy name of wildcard module to safe place
txo f,w$ild ;indicate wildcard checking must be done
setz t4, ;indicate no jfn getting to be done by WLDSET
call wldset ;check something matches the wild spec
ret ;bad spec
txne f,listc ;is this a LIST command ?
jrst [call outspc ;yes, so get output file name
ret ;failed
jrst .+1] ;succeeded
setzm hidate ;Assume no /BEFORE: switch
setzm lodate ;or /AFTER: switch
call prsafb ;parse any switches
ret ;failed, return
setz t4, ;indicate no jfn getting to be done by WLDSET
call wldset ;initialize for wildcard parse
ret ;bad spec
;...
;...
; Here to actually do the listing
;
txze f,fdflg ;want a full directory ?
call shohed ;yes, output header info
skipn q1 ;any thing to do ?
ret ;no, so go back
txne f,vdflg ;verbose directory ?
jrst [lmsg < Module name Size Last update
>
jrst .list1] ;yes, do verbose header
.list1: txne f,tdir2 ;second pass of TDIR ?
jrst [move q2,@mptrs ;yes, so pick up pointer from sorted list
hlrz t4,(q2) ;get string pointer
jrst .lists] ;continue - no checks needed
move q2,q1 ;address of first module is in q1
hlrz t4,(q2) ;get address of module entry
skipn $dmupd(t4) ;deleted entry ?
jrst .listd ;yes, do not list
skipe t1,hidate ;/BEFORE: switch given ?
camle t1,$dmupd(t4) ;yes, is this module after BEFORE date ?
skipa ;no, so list it
jrst .listd ;yes, so don't list it
skipe t1,lodate ;/AFTER: switch given ?
camge t1,$dmupd(t4) ;yes, is this module before AFTER date ?
skipa ;no, so list it
jrst .listd ;yes, so don't list it
txne f,tdirf ;doing first pass for TDIR ?
jrst [movem q2,@mptrs ;yes, so store the pointer for this modules
aos mptrs ;increment the output pointer
jrst .listd] ;continue
.lists: push p,t4 ;save module pointer
hlro t2,(q2) ;form pointer to module name
move t1,lisjfn ;get out jfn
setzb t3,t4 ;terminate string on null
sout% ;write module name out
pop p,t4 ;get pointer back
txnn f,vdflg ;verbose directory ?
jrst .listn ;no, so no date/time info
hlrz t1,(q2) ;point to name again
call slen ;get string length in t2
movn t3,t2 ;make negative
addi t3,^d40 ;desired column pos
movei t2," " ;get a space
move t1,lisjfn ;place to write to
.list2: bout% ;write it
sojn t3,.list2 ;loop until squared up
move t2,9(t4) ;get number of bytes
move t1,lisjfn ;write to listing file
movx t3,fld(6,no%col)!no%lfl!^d10
caml t2,[^d1000000] ;a megabyte or more in the file ?
movx t3,fld(8,no%col)!no%lfl!^d10 ;yes, what's it doing in a library?
nout% ;write it
ercal error
lmsg < > ;move a space
move t2,^d10(t4) ;get update
move t1,lisjfn ;write to listing
setz t3, ;usual format
odtim% ;write update
ercal error
.listn: lmsg <
> ;new line for new module
.listd: txne f,tdir2 ;second TDIR pass ?
jrst [aos mptrs ;yes, so increment pointer to pointers (!!)
skipe @Mptrs ;all done yet ?
jrst .list1 ;no, so do the next
jrst .liste] ;yes, so finish up
aoj q2, ;improve pointer
call wldnxt ;step wildcard lookup
jrst .liste ;all done
jrst .list1 ;do the mext one
.liste: txne f,tdirf ;finished first pass for TDIR ?
jrst [call tdsrt ;yes, so sort the pointers
txc f,tdirf!tdir2 ;first pass over, second begun
movei t1,tdlist ;point back to listhead (now sorted)
movem t1,mptrs ;and store in pointers pointer
jrst .list1] ;now output the directory listing
lmsg <
> ;close off listing
txz f,tdir2 ;flag TDIR done
txnn f,listc ;LIST command ?
ret ;no, so all done
move t1,lisjfn ;yes, so get listing file
closf% ;and close it
nop
ret ;back to caller
subttl SHOHED - list header info for FD and STATUS
;
; This routine is called by the FDIRECTORY and STATUS commands
; to print info from the library's header block.
;
shohed: lmsg <
Listing of universal library >
move t1,lisjfn
move t2,libjfn
setz t3,
setz t4,
jfns% ;output library name
ercal error
lmsg < at >
move t1,lisjfn
seto t2,
odtim% ;and current date and time
ercal error
lmsg <.
>
move t3,hdrpag+$hnent ;total modules
sub t3,hdrpag+$hndel ;minus deleted ones
onum <Modules in library: >,<t3>
move t2,hdrpag+$hnent
txnn f,w$ild ;wildcard lookup ?
movem t2,q1 ;no, save for later loop
lmsg <
Last updated: >
move t1,lisjfn
move t2,hdrpag+$hupdt
setz t3,
odtim% ;and date of last update
ercal error
onum <Byte size of modules: >,<hdrpag+$hbysz>
lmsg <
Type of files in library: >
move t1,lisjfn
hrroi t2,hdrpag+$hext
setzb t3,t4
sout% ;output file type of modules
move t3,hdrpag+$hnext ;extension pages
aoj t3, ;add page 0
onum <Pages used for overhead: >,<t3>
onum <Number of deleted modules: >,<hdrpag+$hndel>
onum <Free space in bytes: >,<hdrpag+$htfre>
lmsg <
>
ret
subttl TDSRT - sort module pointers for TDIRECTORY command
;
; This command takes a list of TBLUK pointers created by the code
; used for an ordinary directory. It sorts the list into date order,
; then sets a flag to indicate to DIRECTORY to output from this list,
; rather than from the WLDSET stuff, etc.
; A simple bubble sort is used.
;
TDSRT: stkvar <nswaps> ;counter for number of swaps this pass
setzm @mptrs ;clean off end of list
dmsg <
[TDIR - beginning sort]
>
tdpas: setzm nswaps ;no swaps yet
movei t3,tdlist+1 ;Point to list of modules
tdpas1: skipn t2,(t3) ;end of list yet ?
jrst [skipn nswaps ;yes, done any swaps ?
ret ;no, so list is sorted
dmsg <[TDIR - Starting next pass]
>
jrst tdpas] ;yes, so must go round again
hlrz t1,(t2) ;get pointer to module header
move t1,$dmupd(t1) ;and retrieve date of update
move t2,-1(t3) ;get previous pointer
hlrz t2,(t2) ;get address of header
camg t1,$dmupd(t2) ;is previous > current ?
jrst tdnxt ;yes, so look at next
aos nswaps ;no, so increment swaps done
move t1,(t3) ;get current pointer
exch t1,-1(t3) ;swap with previous
movem t1,(t3) ;put previous as current
tdnxt: aoja t3,tdpas1 ;increment pointer into list of lists
subttl PRSAFB - parse possible /AFTER or /BEFORE switches
;
; This subroutine parses general switches for the directory command set.
; It may use t1-t4 freely, and expects variables lodate,hidate
; to be set up by TRVAR before entry.
; A date, time or date and time are parsed, with appropriate fixups
; for each type.
;
prsafb: comand [
flddb. (.cmswi,,afbtab,,,[
flddb. (.cmcfm)])],<Invalid switch or confirmation because: >,jsy
hlrz t1,t3 ;get fdb supplied
hrrz t3,t3 ;and fdb used
came t1,t3 ;equal ?
retskp ;no, so confirm typed, go ahead
hrrz t2,(t2) ;yes, so switch typed, find out which
call (t2) ;yes, so parse whichever switch it was
ret ;failed
jrst prsafb ;and go get another one
;
; AFTER/BEFORE handlers
;
aftswi: setzm afbtyp
call dattim ;parse date/time
ret ;failed
movem t2,lodate ;remember time
retskp ;success return
befswi: setom afbtyp
call dattim ;parse date/time
ret ;failed
movem t2,hidate ;remember limit
retskp ;success return
;
; VERBOSE/FULL handlers
;
verswi: txo f,vdflg ;light the verbose flag
retskp
fulswi: txo f,fdflg!vdflg ;light the full flag
retskp ;continue
srtswi: txo f,tdirf ;flag sorted directory
movei t1,tdlist ;where list begins
movem t1,mptrs ;initialize pointer
retskp
;
; Routine to parse date, time or date and time
;
dfdb1: flddb.(.cmtad,cm%sdh,cm%itm!cm%ida,<Date, time or date and time>,,dfdb2)
dfdb2: flddb. (.cmtad,cm%sdh,cm%itm,,,dfdb3)
dfdb3: flddb. (.cmtad,cm%sdh,cm%ida)
dattim: comand dfdb1,<Invalid date or time because: >,jsy
hrrz t3,t3 ;get fdb used
cain t3,dfdb1 ;date and time ?
retskp ;yes, use as is
cain t3,dfdb2 ;just time ?
jrst dttim ;yes, time only entered, frig the date
caie t3,dfdb3 ;just date ?
jrst [userr <Cannot understand date/time field>]
hllzs t2,t2 ;always reduce input to date only
skipn afbtyp ;was it /AFTER ?
add t2,[1,,0] ;yes, make date next day for comparison
retskp ;and return success
dttim: gtad% ;get current date/time
camg t1,t2 ;is time in past ?
sub t2,[1,,0] ;no, it is 1 AM and they typ /AFT:11pm, so make
; it look like yesterday.
retskp ;and return success
subttl OUTSPC - parse output spec for directory
;
; This routine parses a directory output file spec. It has two
; entry points - one from the LIST command (OUTSPC) and one
; from the /OUTPUT switch (OUTSWI)
;
outspc: noise <on output file>;yes, so grab some noise
jrst outsw2 ;skip check for multiple output
outswi: txoe f,listc ;set list flag, check if already on
jrst [ userr <Illegal to specify multiple output files>]
outsw2: movx t1,gj%fou
movem t1,gjfblk
hrroi t1,[asciz/LST/]
movem t1,gjfblk+.gjext ;store default extension
hrroi t1,[asciz/DSK/] ;default device
movem t1,gjfblk+.gjdev ;point to it
hrroi t1,[asciz/LBR/] ;default name
movem t1,gjfblk+.gjnam ;store pointer
comand <[flddb. (.cmfil,cm%sdh,,<Name of listing output file>)]>,<Invalid name for listing file because: >,jsy
movem t2,lisjfn ;save the jfn
move t1,lisjfn ;get listing jfn
movx t2,fld(7,of%bsz)!of%wr ;open listing file for write access
openf% ;open it
erjmp [userr <Cannot open listing file - >,jsy]
retskp
subttl INSERT - insert new module in file
;
; This command inserts a new module into a library file.
;
.insert: noise (new module)
skipn mappd ;got a library ?
jrst [userr <No library selected - use LIBRARY command>] ;no
txne f,ronly ;read only library ?
jrst [userr <Write access to library required>] ;yes, cannot do it
chksfe ;library safe ?
movx t1,gj%old!gj%ifg!gj%flg ;must be an existing file, allow wild
movem t1,gjfblk
hrroi t1,hdrpag+$hext ;point to default extension
ldb t2,[point 7,hdrpag+$hext,6] ;check the extension
setzm gjfblk+.gjext ;assume no extension
skipe t2 ;is there one yet ?
movem t1,gjfblk+.gjext ;yes, so use it
comand <[flddb. (.cmfil,cm%sdh,,<Module to insert>)]>,<Bad module name - >,jsys
movem t2,q1 ;save jfn
confirm ;get confirmation
txo f,modif ;flag library is modified
;
; Now loop through all files requested
; The wild jfn is retained in q1 (with flags.) Routines that need
; it extract it without the flags by a HRRZ.
;
.innxt: txnn q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
jrst .innx1 ;no, so no filename logging
tmsg <
>
movei t1,.priou ;yes, so point to terminal
hrrz t2,q1 ;get jfn
setzb t3,t4 ;usual filename format
jfns% ;write to screen
ercal error ;should not fail
.innx1: call doins ;do an insert of one module
ret ;failed, so return
hrrz t1,q1 ;get jfn
txo t1,co%nrj ;don't release
closf% ;close it
nop ;tuff
txnn q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
jrst .innx2 ;no
tmsg < [OK]> ;reassure the user
.innx2: move t1,q1 ;get full file handle
gnjfn% ;try to step the jfn
erjmp .inend ;no more files in this group
jrst .innxt ;ok, do the next file
.inend: ret
SUBTTL doins - insert a single module
;
; This routine just inserts one module into a file. +1/+2 return format
; Wild JFN is in q1. (for input file)
;
doins: hrrz t2,q1 ;get jfn of module (no flags)
hrroi t1,luknam ;point to name for lookup
movx t3,fld(.jsaof,js%nam) ;output name
jfns% ;do it
ercal error
call lukmod ;do a lookup
jrst .insec ;not found, continue
call tstcol ;found, so warn we will not do it
tmsg <%Module is already in library, not replaced: > ;type a warning
hrrz t2,q1 ;get the jfn
movei t1,.priou ;point to termial
setz t3,
jfns% ;and tell them what file we didn't do
ercal error
retskp ;must give successful return
.insec: hrrz t1,q1 ;get jfn of module
call chkoff ;check for online file
ret ;not online, return
hrrz t1,q1 ;get jfn again
noint ;we will now meddle the directory - flag it
call chktyp ;verify type, set it if not already done
hrrz t1,q1
call chkbsz ;check byte size
hrrz t1,q1 ;get jfn
move t2,hdrpag+$hbysz ;get library byte size
lsh t2,<^d35-pos(of%bsz)> ;put it in the right place
txo t2,of%pln!of%rd ;we want read access
openf% ;do it
erjmp [userr <Cannot open file for read - >,jsy]
hrrz t1,q1 ;jfn
movem t1,filjfn ;store jfn
call getsiz ;now compute the size of this file in bytes
movem t2,filsiz ;save that
move t1,libjfn
;
; We would like to use SIZEF to read the number of bytes - however,
; GETSIZ may have executed a SFBSZ jsys, which means that the results
; returned by SIZEF% are incorrect until the file is closed. We use
; SFBSZ rather than CHFDB because it means the monitor does the numbers
; for us - let it do it again.
;
seto t2,
sfptr% ;reset library pointer to eof
ercal error
rfptr% ;now read the file position
ercal error
movem t2,libsiz ;save it
call bstfit ;try to find a slot to place this in
call updfil ;update the library data pages
call updtab ;update the lookup tables
ret ;failed
okint ;the file is now consistent
retskp ;return success
subttl UPDTAB - this routine updates library tables
;
; Called when a new module is inserted to update the lookup
; tables, both in memory and the library.
; Inputs: q1/ Indexable file handle.
;
updtab: skipl t1,litlad ;did we get a free slot from BSTFIT ?
jrst updta2 ;yes, so use it
move t1,hdrpag+$hnent ;get number of entries
skipn hdrpag+$hnext ;any extension pages ?
jrst [caige t1,mxpg0 ;no, will we overflow page 0 ?
jrst updta1 ;no, continue
call expdir ;yes, so expand directory
jrst updtaf ;failed
jrst updta1] ;succeeded
subi t1,mxpg0 ;ok, clear first page stuff
move t3,hdrpag+$hnext ;get number of extensions
imuli t3,mxpgn ;multiply by entries in a page
camge t1,t3 ;is this page full yet ?
jrst updta1 ;no, so continue
call expdir ;yes, so expand directory
jrst updtaf ;failed - probably out of space
jrst updta1 ;succeeded - continue
updtaf: userr <Failed to update directory - >,jsy
updta1: move t1,hdrpag+$hnent ;get number of entries again
imul t1,hdrpag+$hwpde ;find address of next free entry
addi t1,hdrpag ;in memory
add t1,hdrpag+$hwih ;add words in header
aos hdrpag+$hnent ;update number of entries
move t2,libsiz ;get byte address in library
movem t2,$dmstrt(t1) ;store
updta2: push p,t1 ;save position
hrros t1,t1 ;make a byte pointer
hrrz t2,q1 ;get jfn of module
movx t3,fld(.jsnof,js%dev)!fld(.jsnof,js%dir)!fld(.jsnof,js%typ)!fld(.jsnof,js%gen)!fld(.jsaof,js%nam)
setz t4,
jfns% ;write file name out
ercal error
pop p,t1 ;get address of entry back
move t2,filsiz ;get size of module
movem t2,$dmlen(t1) ;store
movem t1,t2
gtad% ;get current date
movem t1,$dmupd(t2) ;store
movem t1,hdrpag+$hupdt ;also update library header
hrlzs t2,t2 ;make TBLUK pointer to module name
movei t1,modules ;point to table
tbadd% ;enter in table
ercal error
retskp ;back to caller
subttl UPDFIL - update data pages when inserting new module
;
; This routine updates the library by placing a new module in.
; It does not alter any lookup tables.
;
updfil: move t3,litlad ;get address of possible entry
seto t2, ;assume use end of file
skipl t3 ;did we get a free slot from BSTFIT ?
move t2,$dmstrt(t3) ;yes, so get its start address
move t1,libjfn ;point to end of library
sfptr%
ercal error
move q2,filsiz ;get size back
movns q2,q2 ;make negative
camle q2,[-^d512*ndpag] ;a whole pages worth ?
jrst .inse2 ;no
.inse1: hrrz t1,q1 ;get jfn of input file
move t2,[point ^d36,datpag] ; read as 36 bit bytes
movni t3,^d512*ndpag ;one page's worth
sin% ;read a page
erjmp [movx t1,.fhslf ;check on error
geter%
hrrzs t2,t2 ;get just error code
caie t2,iox4 ;end of file reached ?
call error ;no, invoke error traceback
addi t3,1000*ndpag ;add bytes we wanted to read
movns t3,t3 ;construct bytes actually read
jrst .inse3] ;continue
move t1,libjfn ;point to library
move t2,[point ^d36,datpag] ;point to data
movni t3,^d512*ndpag ;one page
sout% ;write it
quoerr <Cannot write to library>
addi q2,^d512*ndpag ;remove that number of bytes
camg q2,[-^d512*ndpag] ;still whole pages left ?
jrst .inse1 ;yes
.inse2: move t3,q2 ;number of bytes to read
hrrz t1,q1 ;read input file
move t2,[point ^d36,datpag] ;to data buffer
sin% ;do it
erjmp .+1 ;igore errors
movns t3,t3 ;how many bytes left ?
add t3,q2 ;discover how many were read
.inse3: move t1,libjfn ;point to library
move t2,[point ^d36,datpag] ;and data
sout% ;write it out
quoerr <Cannot write to library>
ret ;back to caller
subttl EXPDIR - subroutine to expand library directory
;
; This routine is called by UPDTAB when it has discovered that the entry
; it is about to place in the library directory will cause the current
; page to overflow. As a result, we move the entire library up the
; file by one page, and then go back and update the address pointers in
; the directory to indicate the new situation.
; Returns +1: Failure - could not allocate extra space.
; +2: Success, library and directory are updated.
expdir: stkvar <frepag,dirsiz>
call tstcol
tmsg <[Expanding library directory]>
move t1,libjfn ;point to the library
ffffp% ;find first free file page
ercal error ;unexpected error
jumpl t1,[userr <File has no free pages>]
hrrzm t1,frepag ;get free page number
aos hdrpag+$hnext ;now update number of extension pages used
;
; Now we must loop and update all the entries in the directory.
;
movei t1,^d36 ;number of bits in a word
idiv t1,hdrpag+$hbysz ;divided by bits in a byte
imuli t1,^d512 ;eventually gives bytes in a page
movem t1,t2 ;store this useful number
move t4,hdrpag+$hnent ;get number of entries
movei t3,hdrpag+$hdir+8 ;address of start of directory byte no.
expdi2: addm t2,(t3) ;update this entry
addi t3,wpde ;point to next entry
sojn t4,expdi2 ;loop for all entries
move t1,frepag ;get that number (is number of pages in file)
sub t1,hdrpag+$hnext ;subtract number of extension pages allocated
;
; t1 now contains the number of file pages used for data storage
; We now work backwards through the file, mapping pages from the
; end of the file out beyond the file's new end.
;
; sos frepag ;page numbers start at 0
movnm t1,t4 ;save loop count( negated)
expdi1: hrlz t1,libjfn ;get library jfn
hrr t1,frepag ;and page number of free page
soj t1, ;point to page to read
move t2,[.fhslf,,datpag/1000] ;page we use for mapping data
movx t3,pm%rd!pm%cpy!pm%pld ;load with copy-on-write
pmap% ;do it
ercal error ;not expected
moves datpag ;make page private
hrlz t2,libjfn ;get library jfn
hrr t2,frepag ;point to new page to use
move t1,[.fhslf,,datpag/1000] ;our buffer page
movx t3,pm%wr!pm%rd ;read and write access
pmap% ;map the page out again
erjmp [userr <Cannot expand library - >,jsy]
sos frepag ;decrement page to map counter
aojl t4,expdi1 ;loop for all data pages
; ...
; ...
okint ;OK, make library safe (it is)
move t4,hdrpag+$hbysz ;get byte size before unmap
seto t1, ;now prepare to unmap directory
move t2,[.fhslf,,hdrpag/1000] ;to prepare to close the file
move t3,hdrpag+$hnext ;get number of directory pages
txo t3,pm%cnt ;flag count
pmap% ;do so
ercal error
move t1,libjfn ;library
txo t1,co%nrj ;close, but do not release jfn
closf% ;do it
ercal error ;this must succeed
setzm mappd ;flag not mapped
movei t3,^d36 ;number of bits in a word
idiv t3,t4 ;divide by bits in byte
imuli t3,1000 ;get bytes in a page
addm t3,libsiz ;update size of library in bytes
movx t1,fld(.fbsiz,cf%dsp) ;modify byte count
hrr t1,libjfn ;of library
seto t2, ;change whole word
move t3,libsiz ;new size of library in bytes
add t3,filsiz ;plus size of module just inserted
chfdb% ;do it
ercal error
push p,q1 ;save ac that may be trashed
call maplib ;now map library again
pop p,q1
noint ;make library unsafe again (it will be)
retskp ;return success
subttl BSTFIT - find best fit slot for a new module
;
; This routine is called before an insert or update to determine
; if there is an available deleted slot which will accomodate the current
; module. If one exists, its address is returned for use. The directory
; is not scanned if no deleted modules are present, and so this info must
; be up to date. Also, a check on the largest free block size is made, and
; if smaller than FILSIZ (size of module), the directory is not scanned.
;
bstfit: setom litlad ;no address initially
skipn hdrpag+$hndel ;any deleted slots ?
jrst endfit ;no, so must slot onto end
move t1,filsiz ;get size of new module
camle t1,hdrpag+$hlfre ;is it bigger than largest free slot ?
jrst endfit ;yes, so don't look for a free slot
dmsg <
[Scanning for best fit deleted slot]>
move t1,filsiz ;get module desired size
move t4,hdrpag+$hnent ;ok, looks good - get number of entries
movei t2,hdrpag ;get address of library header
add t2,hdrpag+$hwih ;add header length to point to directory
setzm litlst ;zero out found slot size
bstft1: skipe $dmupd(t2) ;is this entry deleted ?
jrst bstft3 ;no, so skip it
camle t1,$dmlen(t2) ;is this large enough for new module ?
jrst bstft3 ;no, so forget it
move t3,$dmlen(t2) ;looks large enough...
skipn litlst ;found one yet ?
movem t3,litlst ;no, so find this one
camle t3,litlst ;is it bigger than best fit so far ?
jrst bstft3 ;yes, so not very interesting
movem t3,litlst ;no, so remember this size
movem t2,litlad ;and its address
bstft3: add t2,hdrpag+$hwpde ;point to next directory entry
sojn t4,bstft1 ;and loop if we haven't done them all yet
dmsg < [OK]
>
skipe litlst ;ok, did we find an entry ?
jrst bstset ;yes, so start fiddling with it
endfit: setom litlst ;indicate to append to library
dmsg <
[No useful slot found]>
ret ;return to caller
subttl BSTSET - create new deleted entry for best fit algorithm
;
; Come here to create a new deleted entry representing the spare space
; available after the old one has been part used.
;
bstset: sos hdrpag+$hndel ;one less deleted entry
move t4,litlad ;get address of smallest entry
move t2,filsiz ;get size of module to go in
camn t2,$dmlen(t4) ;do they match ?
jrst [dmsg <
[Module fits slot exactly]>
jrst bstscn] ;yes, Hallelujah !!
move t1,$dmlen(t4) ;no, so get the size of the old module
movem t2,$dmlen(t4) ;make the old entry describe the new module
sub t1,t2 ;construct size of new left-over part
setom $dmupd(t4) ;make deleted module undeleted
move t2,t4 ;get address of entry we are using
sub t2,hdrpag+$hwih ;subtract directory start address
idivi t2,wpde ;divide by words per directory entry
aoj t2, ;make entry number from all this
caml t2,hdrpag+$hnent ;are we dealing with the last entry ?
jrst bstscn ;yes, so no meddling with the next one
skipe <$dmlen+wpde>(t4) ;is the following entry deleted ?
jrst bstscn ;no, so just let things pass for the moment
addm t1,<$dmlen+wpde>(t4) ;yes,so concatenate this with new entry
dmsg <
[Concatenating deleted entries]>
move t1,$dmstrt(t4) ;get start address of deleted module
add t1,$dmlen(t4) ;add length of new module
movem t1,<$dmstrt+wpde>(t4) ;make start address of next deleted module
;
; Enter here to scan directory again to find the new largest free block.
;
bstscn: dmsg <
[Scanning for new largest free block]>
move t1,hdrpag+$hnent ;get number of entries
movei t2,hdrpag ;address of header
add t2,hdrpag+$hwih ;make address of directory
setz t3, ;zero size of largest free block so far
bstsc1: skipe $dmupd(t2) ;deleted entry ?
jrst bstsc2 ;no, so skip
camge t3,$dmlen(t2) ;this entry bigger than biggest so far ?
move t3,$dmlen(t2) ;yes, so use it
bstsc2: add t2,hdrpag+$hwpde ;move to next directory entry
sojn t1,bstsc1 ;loop for all entries
movem t3,hdrpag+$hlfre ;store new largest free block size
dmsg < [OK]
>
move t1,hdrpag+$htfre ;get total free space
sub t1,filsiz ;subtract size of new module
movem t1,hdrpag+$htfre ;replace
ret ;return to caller
subttl GETSIZ - compute size of a file in user bytes
;
; This routine is called with a jfn in t1. It computes the size of the
; file in bytes based on the library byte size.
;
getsiz: sizef% ;get the file size
ercal error ;just doesn't happen
move t3,modbsz ;byte size of module
camn t3,hdrpag+$Hbysz ;same as library ?
ret ;yes, so no more to do
movei t3,^d36 ;number of bits in a word
idiv t3,modbsz ;how many bytes of this file in a word ?
idiv t2,t3 ;so how many words in this file ?
skipe t3 ;any remainder ?
aoj t2, ;yes, so add 1 word (Ok,ok I know...)
movei t3,^d36 ;number of bits in word
idiv t3,hdrpag+$hbysz ;so how many bytes of lib to a word ?
imul t2,t3 ;and how many bytes does that give us ?
ret ;back to caller
subttl CHKTYP - verify the type of a new module
;
; This subroutine is called when we are about to insert a module
; or update it in a library. The jfn is passed in t1. A check is
; made to see if the library has a default type already established.
; If it has not, the type of this file is used as the default for
; the library. If it has, we check this type against the library type,
; making sure that they match. Issue a warning if not.
; Only set the type if the library was empty before.
;
chktyp: move t2,t1
ldb t1,[point 7,hdrpag+$hext,6] ;get first byte of type
jumpn t1,chkty1 ;if zero, no type, so set it
skipn hdrpag+$hnent ;but only if library is empty.
jrst chknon ;it is, do it
chkty1: hrroi t1,scratch ;point to scratch buffer
movx t3,fld(.jsnof,js%dev)!fld(.jsnof,js%dir)!fld(.jsnof,js%nam)!fld(.jsnof,js%gen)!fld(.jsaof,js%typ)
setz t4,
jfns% ;write file type out
ercal error
hrroi t1,scratch ;point to test string
hrroi t2,hdrpag+$hext ;point to base string
stcmp% ;do they match ?
jumpn t1,[call tstcol ;non-zero warn user
tmsg <%File type of module does not match library>
jrst .+1]
ret ;back to caller
chknon: hrroi t1,hdrpag+$hext ;point to library type field
movx t3,fld(.jsnof,js%dev)!fld(.jsnof,js%dir)!fld(.jsnof,js%nam)!fld(.jsnof,js%gen)!fld(.jsaof,js%typ)
jfns% ;write extension
ercal error
call tstcol ;get new line
tmsg <[Setting library file type to >
hrroi t1,hdrpag+$hext ;point to new file type
psout% ;type it
tmsg <]>
ret ;back to caller
subttl CHKOFF - check if file for insert or update is online
;
; This routine is called with a jfn in t1. It returns +2 if the file
; is offline, +1 otherwise.
;
chkoff: move t2,[1,,.fbctl] ;get FDB control word
movei t3,t4 ;return in t4
gtfdb% ;do it
ercal error ;failed horribly
txne t4,fb%off ;offline ?
ret ;yes, bad return
retskp ;no, ok
subttl CHKBSZ - verify the byte size of a new module
;
; This routine is called with the jfn of a new module in t1.
; If the library has no byte size, it is set from this module's.
; If the library has a size, it is compared against this module's.
; If they do not match, a warning is given.
;
chkbsz: move t2,[1,,.fbbyv] ;get byte size only
movei t3,t4 ;where to put it
gtfdb% ;read the file byte size
ercal error ;can't fail
txz t4,^-<fb%bsz> ;clear all but the byte size
lsh t4,-<^d35-pos(fb%bsz)> ;and shift down to right end
movem t4,modbsz ;save for GETSIZ
skipn hdrpag+$hbysz ;got a byte size ?
jrst [movem t4,hdrpag+$hbysz ;no, but we have now
move t1,libjfn ;get library jfn
move t2,t4 ;get new byte size
sfbsz% ;recompute useful pointers
ercal error
jrst .+1] ;continue
came t4,hdrpag+$hbysz ;are they equal ?
jrst [call tstcol ;no....
tmsg <%Byte size of module does not match library>
jrst .+1]
ret ;back to caller
subttl LIBRARY - select new library file
;
; This command selects a new library file, unmapping the old one
; if necessary.
;
.library: stkvar <tmpjfn>
noise (is)
movx t1,gj%old!gj%acc ;no access to inferiors
movem t1,gjfblk ;assume old file
hrroi t1,[asciz/LBR/] ;default file type
movem t1,gjfblk+.gjext ;store
txne f,takini ;reading LBR.INIT ?
jrst [txne f,rslib ;yes, so did the rescan line provide a library ?
jrst eatcmd ;yes, so eat up the comand
jrst .+1] ;no, so continue regardless
comand <[flddb. (.cmfil,cm%sdh,,<Name of library to select>)]>,<Invalid library file spec - >,jsys
movem t2,tmpjfn ;save jfn
confirm ;confirm command
txo f,tempot ;assume temporary output again
call umap ;unmap old lib if required
move t1,tmpjfn ;get back saved jfn
movem t1,libjfn ;store
txz f,ronly ;clear any read-only flag around
call maplib ;map the library
ret ;back for next command
purge tmpjfn
eatcmd: comand <[flddb. (.cmtxt)]>
confirm
ret
subttl RESCAN - do a library command from the rescan buffer
;
; This subroutine looks at the rescan buffer to see if it is of the form
; LBR LIBNAME
; It attempts to map the library if it exists, and sets a flag to stop
; a LIBRARY command in LBR.INIT overriding the library specified in the
; command line. (We have to be called before normal command parsing
; begins.)
; It also checks for LBR being invoked with special command names defined
; in SPCTAB. If so, it works in guide mode.
;
RESCAN: movei t1,.rsini ;now make the rescan buffer...
rscan% ;...available for reading
ercal error ;which should never fail
movei t1,.rscnt ;return the number of characters...
rscan% ;lying around in the rescan buffer
ercal error ;which should never fail
jumpe t1,R ;If zero already, just return
movn t3,t1 ;get the number of characters negated
movei t1,.priin ;now prepare to read it
hrroi t2,atmbfr ;into the command buffer (good as anywhere)
sin% ;do it
ercal error
move t1,[point 7,atmbfr] ;look at the command buffer
move t3,[point 7,buffer] ;where to output the word
setzm buffer ;in case rescan contains no words
rescaw: ildb t2,t1 ;get the first character
caige t2,"A" ;check for alphabetic
jrst rescae ;no, end of word
caile t2,"Z" ;more checks
jrst [caige t2,"a" ;like lowercase
jrst rescae ;nope
caile t2,"z" ;perhaps ?
jrst rescae ;definitely nope
jrst .+1] ;ok, part of word
idpb t2,t3 ;so dump out the word
jrst rescaw ;and continue
rescae: setz t4, ;get null
idpb t4,t3 ;terminate command word with it
push p,t1 ;save input byte pointer
movei t1,spctab ;Point to startup command table
hrroi t2,buffer ;and to command that started us
tbluk% ;try a lookup
erjmp [pop p,t1
ret] ;if failed, give up
txnn t2,tl%exm ;exact match with command string ?
jrst [pop p,t1
ret] ;no, so must be start or something
hrrz t2,(t1) ;ok, get table data
movem t2,t3 ;and save the entry
skipe t2 ;is it zero ?
call guidon ;no, set GUIDE-style stuff on
pop p,t1 ;get input byte pointer back
reskp: ildb t2,t1 ;now skip any blanks or tabs in input
cain t2," " ;is it a space ?
jrst reskp ;yes, so get next
cain t2," " ;or a tab ?
jrst reskp ;yes, so get next
cain t2,.chlfd ;or a linefeed perchance ?
ret ;yes, give up
cain t2,15 ;or carriage return
ret ;give up
jumpe t2,r ;if it is a null, just give up
seto t2, ;ok, so now we must backspace
adjbp t2,t1 ;by one byte to read the non-space again
movem t2,t4 ;so, now save the byte pointer to the argument
txne f,guide ;in guide mode ?
jrst guirsc ;yes, so get module name, do a type
movei t1,[gj%old ;so set up a GTJFN arg block for an old file
.nulio,,.nulio ;not reading from files
0 ;no default device
0 ;or directory
0 ;no default name
-1,,[asciz/LBR/] ;default type is .LBR
0 ;no default protection
0 ;no default account
0] ;no special JFN
gtjfn% ;and try for a jfn on the library
erjmp [userr <Cannot find specified library - >,jsy] ;didn't work
movem t1,libjfn ;now we have a jfn, store it where it belongs
call maplib ;and try to map the library
txo f,rslib ;flag we have a rescanned library available
ret ;and return for the LBR.INIT file
subttl GUIDON - load the GUIDE-style library in
;
; We come here when we have determined we are running in GUIDE-style.
; t2 contains a pointer to the name of the library to use.
; T1 contains the TBLUK pointer for the entry (for setting the prompt)
;
guidon: txo f,guide ;mark GUIDE mode
movem t1,guinam ;save prompt pointer
hrro t2,t2 ;make t2 a byte pointer
movx t1,gj%sht!gj%old ;the library must be there
gtjfn% ;get it
erjmp [tmsg <?Cannot find GUIDE file>
haltf%]
movem t1,libjfn ;save the library jfn
push p,t3
push p,t4
call spromp ;set up a prompt string
txo f,ronly ;ask for library read-only
call maplib ;Map it (the library, that is)
pop p,t4
pop p,t3
ret ;and return
; Sprompt - generate a prompt string from the command
spromp: hlro t1,@guinam ;get pointer to command name
hrroi t2,guinam ;write it back over the pointer
setzb t3,t4 ;asciz
sin% ;do it
movei t1,">" ;what to finish a prompt with
idpb t1,t2 ;tidy off prompt
setz t1,
idpb t1,t2 ;asciz-ize it
ret ;done
; Guirsc - pick up rescanned name from command line
guirsc: hrroi t1,buffer ;where to put a module name
movei t3,^d39 ;maximum length of one
movei t4,.chlfd ;character to terminate on
sout% ;write out the module name
setz t4, ;get a null
dpb t4,t1 ;and ASCIZize it
txo f,grscom ;flag GUIDE got a rescanned command
movei t1,modules ;Point to modules
hrroi t2,buffer ;and to name we have
tbluk% ;try a lookup
erjmp gnscmd ;if error, no hope baby
txne t2,tl%nom!tl%amb ;no match or ambiguous?
jrst gnscmd ;yes, complain
movem t1,q1 ;else save the pointer
txo f,typing ;tell COPY that it is like TYPE
ret ;and return
gnscmd: tmsg <?No such subject>
call umap
haltf%
subttl COPY - extract a module from a library to a file
;
; The format of this command is:
; COPY (module) modnam (to file) filename
;
; The filename is set up by default to have the same name as the module,
; and the same type as the library module type.
;
; The TYPE command also uses this code.
; The APPEND command also uses some of this code.
.appen: txo f,apping ;flag APPEND command
jrst .copy+1 ;continue with copy
.type: txo f,typing ;flag TYPE command
move t1,[jrst cctyp] ;instruction to execute on control-c
movem t1,ccxct ;store for trap routine
skipa
.copy: txz f,typing!apping ;not a type or append command
noise (module)
skipn mappd ;got a library ?
jrst [userr <No library selected - use LIBRARY command>] ;no
comand <[flddb. (.cmkey,,modules,<Module, >,,[
flddb. (.cmact,cm%sdh,,<"Wildcard" modules>)])]>,<Invalid module name - >,jsy
hlrz t1,t3 ;get address of FDB supplied
hrrzs t3,t3 ;and FDB used
came t1,t3 ;are they equal ?
jrst [move t1,[atmbfr,,copnam] ;no, so wildcards were used
blt t1,copnam+7 ;so store the filename
movei t2,[copnam,,0] ;point to it
txo f,w$ild ;flag wildcards
setz t4, ;clear possible jfns
call wldset ;and check a match for wild spec exists
ret ;it doesn't, so return
jrst .copy2] ;continue
movem t2,q1 ;save index into table
.copy2: txne f,typing ;TYPE command
jrst [movei t4,.priou ;yes, point to terminal
jrst .type1] ;and continue
hrroi t1,hdrpag+$hext ;point to library module type
movem t1,gjfblk+.gjext ;set up default file type
txne f,apping ;APPEND command ?
jrst [setz t1, ;yes, so no wildcards on output
jrst .copya] ;continue
hlro t1,(t2) ;point to default filename
movem t1,gjfblk+.gjnam ;set up default file name
movx t1,gj%fou ;assume new file
txne f,w$ild ;wildcards used ?
txo t1,gj%ofg!gj%flg ;yes, so allow "parse-only" jfns
txne f,tempot ;temporary output ?
txo t1,gj%tmp ;yes, so force temporary jfn
.copya: movem t1,gjfblk
noise (to file)
comand [flddb. (.cmfil,cm%sdh,,<Name of file to place module in>)],<Invalid output file spec - >,jsy
movem t2,t4 ;save jfn of output file
.type1: confirm ;confirm command
txz f,appnxt ;flag the first appended module for OPENF
txnn f,w$ild ;wild output requested ?
jrst .copy3 ;no, so do it the simple way
txne f,apping ;appending ?
push p,t4 ;yes, we need the jfn, but don't want WLDSET
txne f,typing!apping ;TYPE or APPEND command ?
setz t4, ;yes, no fancy stuff with jfns
call wldset ;yes, so check if any match occurs
jrst [txne f,apping ;appending ?
pop p,t4 ;yes, so clean up stack
ret] ;return, no modules
txne f,apping ;appending ?
pop p,t4 ;retrieve output jfn if appending
call copwon ;output next name in wildcard stuff
;
; Here begins the loop where we actually do the output.
; NOTE - this is also called by EDIT with a jfn in t4 and TBLUK address
; in q1, so watch any changes
;
.copy3: txne f,typing ;TYPE command ?
noint ;yes, inhibit interrupts
.copy4: txz f,copyok ;mark copy ok initially
txne f,typing ;TYPE command ?
movei t4,.priou ;reestablish output for TYPE
move t2,hdrpag+$hbysz ;get library byte size
lsh t2,<^d35-pos(of%bsz)>
txne f,apping ;APPEND command ?
jrst [txo t2,of%app ;yes, set append access
jrst .+2]
txo t2,of%wr ;set byte size, write access
hrrz t1,t4 ;get jfn of output module
txnn f,typing!appnxt ;don't open .PRIOU for TYPE, or do multiple
; opens for append access
openf% ;open it
erjmp [move t1,t4 ;get jfn
rljfn% ;release it
nop
txo f,copyok ;mark copy failed
userr <Cannot open file for output module - >,jsy]
txne f,apping ;APPEND output ?
txo f,appnxt ;yes, flag file already open for next append
hlrz t3,(q1) ;get address of library entry
move t2,$dmstrt(t3) ;get starting byte in library file
move t1,libjfn ;library jfn
sfptr% ;set the pointer
ercal error
movn q1,$dmlen(t3) ;get negative number of bytes
caml q1,[-1000*ndpag] ;more than one page ?
jrst .copye ;no, so use special only
.copyc: move t1,libjfn ;point to library
move t2,[point ^d36,datpag] ;and buffer page
movni t3,1000*ndpag ;read 1k bytes
sin% ;do it
ercal tstlib ;if error, check for end-of-file, and try to fix
hrrz t1,t4 ;get output jfn
move t2,[point ^d36,datpag] ;pointer to buffer page
movni t3,1000*ndpag ;1k worth
sout% ;write it
ercal copexp ;try to expunge on failure - returns above on error
addi q1,1000*ndpag ;drop amount left to write
camge q1,[-1000*ndpag];ok yet ?
jrst .copyc ;yes, go on
.copye: move t1,libjfn ;point to input
move t2,[point ^d36,datpag] ;to buffer
move t3,q1 ;amount left to read
sin% ;do it
ercal tstlib ;if error, check for bad EOF, try to fix it.
hrrz t1,t4
move t2,[point ^d36,datpag] ;buffer to output file
move t3,q1
sout% ;write last buffer
erjmp [move t1,t4 ;output file
txo t1,cz%abt ;mark abort close
closf% ;close it
nop
txne f,typing ;TYPE ?
okint ;yes, allow interrupts
txo f,copyok ;mark copy failed
userr <Error writing output module - >,jsy]
hrrz t1,t4
txnn f,apping!typing ;don't close .PRIOU or APPEND output
closf% ;close the output file
nop ;ignore errors
txne f,apping ;APPEND ?
push p,t4 ;yes, save jfn
txnn f,w$ild ;wildcards used ?
jrst copend ;no, so clean up
tmsg < [OK]> ;yes, so reassure user
call wldnxt ;yes, so grab the next module
jrst copend ;none left, clean up
txne f,apping ;APPEND ?
pop p,t4 ;yes, restore JFN
call copwon ;output name of this module
jrst .copy4 ;process next module
;
; Here to clean up on append command
;
copend: txne f,typing ;TYPE command ?
okint ;yes, allow interrupts again
txne f,grscom ;got here from GUIDE module ?
jrst .exiti ;yes, so stop fast
txzn f,apping ;append command ?
ret ;no, all done
pop p,t1 ;yes, get output JFN back
closf% ;close it
nop ;ignore errors
ret ;all done
;
; Here on control-c interrupt
;
cctyp: movei t1,cctyp1 ;where to continue
movem t1,retpc1 ;interrupt PC
debrk% ;leave interrupt context now.
cctyp1: okint ;allow interrupts
txne f,grscom ;rescanned command in guide mode ?
jrst .exiti ;yes, exit fast
tmsg <
[Aborted]>
okint ;allow interrupts
jrst parse ;get the next command
subttl TSTLIB - handle bad EOFS on a library.
;
; If LBR is aborted prematurely, or something, the most likely
; error that occurs is that on some previous run, the EOF pointer was
; never updated to the true EOF. We come here on errors from using
; SIN% on the library. We check for end of file, and if it has occured,
; we search the directory to see what the maximum byte number in the
; library ought to be. We check that against the current EOF, and if
; greater, we reset the EOF, and continue the aborted JSYS.
;
tstlib: push p,t1
push p,t2
push p,t3
push p,t4 ;Save all relevant acs
movx t1,.fhslf ;Point to our process
geter% ;get the most recent error
hrrzs t2 ;extract the error code
caie t2,iox4 ;end of file reached ?
jrst [pop p,t4 ;no, so restore the acs
pop p,t3
pop p,t2
pop p,t1
jrst error] ;and do usual error handling
move t1,libjfn ;yes, so read the current filesize
rfptr% ;to find out where we are
ercal error
push p,t2 ;and save it
move t3,hdrpag+$hnent ;get number of entries in library
movei t2,hdrpag+$hdir ;point to start of directory entries
setz t1, ;initialize guess as to end of file
tstlop: move t4,$dmstrt(t2) ;get start byte of this module
add t4,$dmlen(t2) ;and add its length
camle t4,t1 ;that a better idea than what we had before ?
move t1,t4 ;yes, update our guess as to eof
addi t2,wpde ;bump to next directory entry
sojg t3,tstlop ;and check them all
pop p,t4 ;get back old eof pointer
camg t1,t4 ;is our guess better than what it is ?
jrst [tmsg <?Serious problem with library: directory is corrupt>
haltf%] ;no, cannot understand problem
movem t1,t3 ;yes, so reset the byte count
tmsg < [Fixing up library EOF] >
move t1,libjfn ;of the library
hrli t1,.fbsiz ;which is in this word
seto t2, ;and takes up a whole word
chfdb% ;do it
ercal error
txo f,clsnrj ;tell UMAP to keep the JFN for us
call umap ;unmap the old library
push p,q1
push p,q2 ;save acs that MAPLIB trashes
call maplib ;remap the library to see new EOF limit
pop p,q2
pop p,q1
pop p,t4
pop p,t3 ;and restore all the acs
pop p,t2
pop p,t1 ;so we can continue the I/O operation...
sin% ;that was so rudely interrupted
ercal error ;if this fails, brother are we in trouble
ret ;all done !
subttl DELETE - delete a module or modules from the library
;
; Command format: DELETE (modules) modnam
;
; Wildcard module names are allowed.
;
.delete: noise (modules)
skipn mappd ;got a library ?
jrst [userr <No library selected - use LIBRARY command>] ;no
txne f,ronly ;read only library ?
jrst [userr <Write access to library required>] ;yes, cannot do it
chksfe ;library safe ?
comand <[flddb. (.cmkey,,modules,<Module to be deleted, >,,[
flddb. (.cmact,cm%sdh,,<"Wildcard" modules>)])]>,<Invalid module name - >,jsy
hlrz t1,t3 ;get address of FDB supplied
hrrzs t3,t3 ;and FDB used
came t1,t3 ;are they equal ?
jrst .del2 ;no, so wildcards were used
movem t2,q1 ;save index into table
hlrz q2,(q1) ;get address of directory entry
confirm ;confirm command
txo f,modif ;mark modification
movei t1,modules ;point to TBLUK table
move t2,q1 ;address of entry to delete
tbdel% ;do it
ercal error
noint ;mark directory unclean
aos hdrpag+$hndel ;increment number of deleted directory entries
move t1,$dmlen(q2) ;get size of this module
addm t1,hdrpag+$htfre ;add to total library free space
camle t1,hdrpag+$hlfre ;is this larger than largest free space ?
jrst [movem t1,hdrpag+$hlfre ;yes, so update directory
move t1,$dmstrt(q2) ;get address of module
jrst .+1] ;continue
setzm $dmupd(q2) ;flag module deleted
gtad% ;get current time+date
movem t1,hdrpag+$hupdt ;flag update occured
okint ;show directory is now OK
call chksqz ;check if squeeze is useful
ret ;and return to caller
; ...
; ... Here to do wildcard deletes
.del2: move t1,[atmbfr,,copnam] ;no, so wildcards were used
blt t1,copnam+7 ;so store the filename
movei t2,[copnam,,0] ;point to it
txo f,w$ild ;flag wildcards
setz t4, ;indicate we don't want output jfns
call wldset ;initialize the wildcard stuff
ret ;no modules match that name
confirm ;confirm deletion
txo f,modif
.delw3: tmsg <
> ;look pretty
hlro t1,(q1) ;point to module name
psout% ;write it to terminal
hlrz q2,(q1) ;now find address of entry in directory
move t2,q1 ;set up to delete this
movei t1,modules ;from the table
tbdel% ;do it
erjmp [userr <Tables are corrupt - >,jsy]
noint ;mark directory unclean
aos hdrpag+$hndel ;increment number of deleted directory entries
move t1,$dmlen(q2) ;get size of this module
addm t1,hdrpag+$htfre ;add to total library free space
camle t1,hdrpag+$hlfre ;is this larger than largest free space ?
jrst [movem t1,hdrpag+$hlfre ;yes, so update directory
move t1,$dmstrt(q2) ;get address of module
jrst .+1] ;continue
setzm $dmupd(q2) ;flag module deleted
gtad% ;get current time+date
movem t1,hdrpag+$hupdt ;flag update occured
okint ;show directory is now OK
tmsg < [OK]> ;reassure user
sos wldptr ;reset things for wild lookup - we have removed
;an entry, so its pointer is askew
setz t4, ;no jfns, thanks
call wldnxt ;try for the next module
jrst [call chksqz ;none left, check for squeeze
ret] ;and go home
jrst .delw3 ;another - go do it
subttl SET - set all sorts of things
;
; This command takes a number of subcommands, notably
; (NO) TEMPORARY - controls whether output files are temporary
; EXTENSION text - sets default library extension
; (NO) DEBUG - controls debugging information
; NOTE: The command can only set left-half bits, and cannot fiddle bit 17.
; Therefore, bits to be controlled by SET commands must be chosen
; appropriately.
;
DEFINE setent(keyword,noise,bit,inv<>),<
IFB <INV>,<tb (<1b18![[asciz\noise\],,(bit)]>,KEYWORD)>
IFNB <INV>,<itb (<1b18![[asciz\noise\],,(bit)]>,KEYWORD)>>
settab: setsiz,,setsiz ;size of command table
SETENT AUTO-EXPUNGE,<on disk quota exceeded errors>,iexpunge
SETENT DEBUG,<mode on>,debug,inv
tb (.setem,EPHEMERAL) ;make library default to temporary
tb (.setex,EXTENSION) ;change extension
tb (.setno,NO) ;NO someting or other
tb (.setpm,PERMAMENT) ;make lib default to no temporary
SETENT SED,<to be the default editor>,defsed
SETENT SQUEEZE,<when library is 1/10 empty>,alowsq
SETENT TEMPORARY,<output files>,tempot
setsiz==.-settab-1
notab: nosiz,,nosiz ;size of no command table
SETENT AUTO-EXPUNGE,<on disk quota exceeded errors>,iexpunge
SETENT DEBUG,<mode on>,debug,inv
SETENT SED,<to be the default editor>,defsed
SETENT SQUEEZE,<when library is 1/10 empty>,alowsq
SETENT TEMPORARY,<output files>,tempot
nosiz==.-notab-1
.set: noise (thing)
comand [flddb. (.cmkey,,settab)],<Invalid set option - >,jsy
hrrz q1,(t2) ;get the appropriate word
txze q1,1b18 ;is bit 18 set ?
jrst setbit ;yes, so this is just a bit modification
jrst (q1) ;no, so we must call another routine
setbit: hlro t2,(q1) ;point to noise word
call skpnoi ;parse noise
ret ;failed
confirm ;make sure they want to do it
hrlz q1,(q1) ;swap the bit into the left half where it belongs
tdo f,q1 ;do the change
ret ;and return
.setno: comand [flddb. (.cmkey,,notab)],<Invalid SET NO option - >,jsy
hrrz q1,(t2) ;get address of descriptor
txz q1,1b18 ;remove flag bit
hlro t2,(q1) ;get noise
call skpnoi ;parse it
ret ;failed
confirm ;confirm the command
hrlz q1,(q1) ;get the bit to fiddle
tdz f,q1 ;zero the flag
ret ;back for next command
.setex: noise (for output files to)
skipn mappd ;got a library ?
jrst [userr <No library selected yet - use LIBRARY command>] ;no
txne f,ronly ;read only library ?
jrst [userr <Write access to library required>] ;yes, cannot do it
chksfe ;library safe ?
comand [flddb. (.cmact,cm%sdh,,<Default extension for output from this library>)],<Bad extension - >,jsy
move t1,[atmbfr,,defext]
blt t1,defext+7 ;save the entered extension
confirm ;confirm the command
move t1,[defext,,hdrpag+$hext]
blt t1,hdrpag+$hext+7 ;now copy into the library header
ret ;back for next command
.setem: noise (default for library)
skipn mappd ;got a library ?
jrst [userr <No library selected yet - use LIBRARY command>] ;no
confirm
move t1,hdrpag+$hflgs ;get header flags word
txz t1,hfprm ;zero permanent bit
movem t1,hdrpag+$hflgs ;put it back
txo f,tempot ;set temporary output
ret
.setpm: noise (default for library)
skipn mappd ;got a library ?
jrst [userr <No library selected yet - use LIBRARY command>] ;no
confirm
move t1,hdrpag+$hflgs ;get header flags word
txo t1,hfprm ;set permanent bit
movem t1,hdrpag+$hflgs ;put it back
txz f,tempot ;set no temporary output
ret
subttl REPLACE - routine to update existing modules
;
; This command is called to insert new versions of modules into
; the library, removing the old ones. If the new module is the same
; size as the old, the same slot is re-used. Otherwise, the new one is
; first deleted, and then a call is made to insert the new one at the best
; fit.
;
.replace: noise (existing modules)
skipn mappd ;got a library ?
jrst [userr <No library selected yet - use LIBRARY command>]
txne f,ronly ;read only library ?
jrst [userr <Write access to library required>] ;yes, cannot do it
chksfe ;library safe ?
comand [flddb. (.cmkey,,modules,<Module name,>,,[
flddb. (.cmact,cm%sdh,,<"Wildcard" module name>)])],<Invalid module name - >,jsy
movem t3,q1 ;save FBD address
hrrzs t3,t3 ;get fdb used
hlrz t1,q1 ;fdb supplied
came t1,t3 ;are they the same ?
jrst [move t1,[atmbfr,,copnam] ;no, wildcard module name
blt t1,copnam+7 ;save wild module name
movei q1,[copnam,,0]
txo f,w$ild ;flag wild name
setz t4, ;ask for no fancy jfns
call wldset ;check a match with the spec exists
ret ;it doesn't, return
jrst .repl2] ;continue
movem t2,q1 ;save TBLUK address
.repl2: hlro t1,(q1) ;point to default filename
movem t1,gjfblk+.gjnam;store it
hrroi t1,hdrpag+$hext ;point to default extension
movem t1,gjfblk+.gjext ;store it
movx t1,gj%old ;files must exist
txne f,w$ild ;were wildcards used ?
txo t1,gj%ifg ;yes, so allow them for filenames
movem t1,gjfblk ;store GTJFN flags
noise <with files>
comand [flddb. (.cmfil,cm%sdh,,<Files to use to replace modules in library>)],<Invalid input file name - >,jsy
movem t2,repjfn ;store returned jfn
confirm ;confirm the command
txo f,modif
;...
;...
; We now have the command - replace all requested modules.
;
txNn f,w$ild ;wild module parse ?
jrst repnrm ;no , handle differntly
setz t4, ;make sure no jfn
call wldset ;set up for wildcard lookup
ret ;bad spec
.repcon:
repnrm: hlrz t1,(q1) ;get address of directory entry
noint ;mark library unsafe
setzm $dmupd(t1) ;delete old module entry
aos $hndel+hdrpag ;increment number of deleted modules
move t3,$dmlen(t1) ;get size of old module
addm t3,hdrpag+$htfre ;add in to total free space
camle t3,hdrpag+$hlfre ;larger than largest free space ?
movem t3,hdrpag+$hlfre ;yes, so update header stats
movei t1,modules ;point to module name lookup table
move t2,q1 ;address of entry for this module
tbdel% ;delete it
erjmp [userr <Lookup tables are corrupted - >,jsy]
hrrz t4,repjfn ;jfn of new module file
txne f,w$ild ;wildcard replace ?
call copwon ;yes, type out the file name
hrrz q1,repjfn ;jfn of input file for insert
call .insec ;insert the new module
jrst repend ;failed, so return
okint ;Mark library safe again
hrrz t1,repjfn ;get jfn of input file
txo t1,co%nrj
closf% ;close, but do not release handle
erjmp .+1 ;ignore errors
txnn f,w$ild ;wild insert ?
jrst repend ;no, so return now
tmsg < [OK]> ;reassure user
setz t4, ;make sure we don't want a jfn
call wldnxt ;step the wild module
jrst repend ;no more modules to replace
move t1,repjfn ;get the wild input jfn
gnjfn% ;step it also
erjmp [userr <Number of modules does not match number of files: >,fil,repjfn]
jrst .repcon ;do next module
repend: okint ;allow interrupts again
call chksqz ;check if a squeeze is needed
ret ;and return for next commdn
subttl UPDATE - replace modules by filename only
;
; This command is used to update a lot of modules when you have all the
; files in one place, but it is difficult to specify a useful module
; name for the REPLACE command. It gets the module name from the filename.
;
.update: noise (library using files)
skipn mappd ;got a library ?
jrst [userr <No library selected yet - use LIBRARY command>] ;no
txne f,ronly ;read only library ?
jrst [userr <Write access to library required>] ;yes, cannot do it
chksfe ;library safe ?
movx t1,gj%old!gj%ifg ;allow wildcards
movem t1,gjfblk ;store for COMND
hrroi t1,hdrpag+$hext ;point to library extension
movem t1,gjfblk+.gjext ;store for input file
comand [flddb. (.cmfil,cm%sdh,,<File(s) to update library with>)],<Invalid input file name - >,jsy
movem t2,q1 ;save jfn
confirm ;confirm command
txo f,modif ;flag modification
.upd1: txnn q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
jrst .upd2 ;no, so no filename logging
tmsg <
>
movei t1,.priou ;yes, so point to terminal
hrrz t2,q1 ;get jfn
setzb t3,t4 ;usual filename format
jfns% ;write to screen
ercal error ;should not fail
.upd2: call .doupd ;do an update of one module
ret ;failed, so return
okint
hrrz t1,q1 ;get jfn
txo t1,co%nrj ;don't release
closf% ;close it
nop ;tuff
txnn q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
jrst .upend ;no
tmsg < [OK]> ;reassure the user
move t1,q1 ;get full file handle
gnjfn% ;try to step the jfn
erjmp .upend ;no more files in this group
jrst .upd1 ;ok, do the next file
.upend: call chksqz ;check if a squeeze is needed
ret
;...
;
; Do a single update
;
.doupd: hrrz t2,q1 ;get jfn of module (no flags)
hrroi t1,luknam ;point to name for lookup
movx t3,fld(.jsaof,js%nam) ;output name
jfns% ;do it
ercal error
call lukmod ;do a lookup
jrst [userr <Module does not exist: >,fil,q1] ;inform user
noint ;we are about to fiddle
movem t1,t2 ;save address of entry
hlrz t3,(t2) ;get pointer to directory entry
movei t1,modules ;TBLUK table
tbdel% ;delete module
erjmp [userr <Tables are corrupt - >,jsy]
setzm $dmupd(t3) ;mark module deleted
aos $hndel+hdrpag ;increment number of deleted modules
move t1,$dmlen(t3) ;get size of old module
addm t1,hdrpag+$htfre ;add in to total free space
camle t1,hdrpag+$hlfre ;larger than largest free space ?
movem t1,hdrpag+$hlfre ;yes, so update header stats
call .insec ;try to put the module in
ret ;failed, return
retskp ;succeeded, ok
subttl EDIT command - edit a module and replace in library
;
; This command accepts a single module name, and extracts it into
; a temporary file. It then starts up EDITOR: (if found) and causes
; it to be read into the editing buffer. On exit, the output file
; (whose name we have supplied) is updated into the library, and the
; original file expunged.
;
.edit: noise (module)
skipn mappd ;got a library ?
jrst [userr <No library selected yet - use LIBRARY command>]
chksfe ;library safe ?
comand [flddb. (.cmkey,,modules,<Module name,>)],<Invalid module name - >,jsy
movem t2,q3 ;save index
txz f,edtrdo!edtsed!copyok ;clear flag bits
txne f,ronly ;library mapped readonly ?
txo f,edtrdo ;yes, so edit must be readonly
txne f,defsed ;SED the default editor ?
txo f,edtsed ;yes, so light the SED bit
.edswi: comand <[flddb. (.cmswi,,edswit,,,[
flddb. (.cmcfm)])]>,<Invalid switch - >,jsy
ldb t1,[point <wid(cm%fnc)>,(t3),<pos(cm%fnc)>] ;get function code
cain t1,.cmcfm ;was it confirm ?
jrst .edcfm ;yes, so continue
hrrz t2,(t2) ;no, so get the flag for this switch
tdo f,t2 ;light the appropriate bit
jrst .edswi ;and try for another switch, or confirm
;
; Here when edit command is confirmed
;
.edcfm: txo f,modif ;flag modified
hlro t2,(q3) ;point to filename
hrroi t1,edtbuf ;and filename buffer
setzb t3,t4
sout% ;copy the filename out
ercal error
movei t2,"." ;get a dot
idpb t2,t1 ;place that out
hrroi t2,hdrpag+$hext ;point to default extension
sout% ;write that out in the buffer
ercal error
movem t1,edtptr ;save this pointer for later
call chkedt ;check to see file does not already exist
hrroi t2,edtbuf ;point to constructed temporary name
movx t1,gj%sht!gj%fou
gtjfn% ;grab a jfn on an output file
ercal error ;woops - shouldn't happen
movem t1,t4 ;place jfn where COPY expects it
move q1,q3 ;and table index too
txo t1,<fld(.fbbyv,cf%dsp)> ;we want to change the generation ret
movx t2,fb%ret ;count in word .fbbyv of the FDB
movx t3,fld(1,fb%ret) ;to 1 (override normal stuff)
chfdb% ;do it
erjmp .+1
call .copy4 ;copy the module out
txne f,copyok ;did it work ?
ret ;no, so don't run the editor
hrroi t2,edtbuf ;temporary output file
movx t1,gj%sht!gj%old
gtjfn% ;get the jfn again (COPY disposed of it)
ercal error ;woops - shouldn't happen
movem t1,q2 ;save this for a mo
call edcmd ;construct EDIT command
call getedt ;get the editor, start it up
ret ;failed, no editor
move t2,edtptr ;pointer to end of filename in edit buffer
setz t1, ;get a null
idpb t1,t2 ;remove temporary attribute
hrroi t2,edtbuf ;point to edit filename buffer
movx t1,gj%sht!gj%old ;old file
gtjfn% ;grab jfn on editor output
erjmp [userr <Cannout find any output from editor>]
movem t1,q2 ;save it
txne f,edtrdo ;read only ?
jrst ednrep ;yes, don't replace
movem q2,repjfn ;store jfn where replace expects it
move q1,q3 ;and table index too
call repnrm ;replace the edited module
hrroi t2,edtbuf ;temporary output file
movx t1,gj%sht!gj%old
gtjfn% ;get the jfn again (REPLACE disposed of it)
ercal error ;woops - shouldn't happen
ednrep: txo t1,df%exp ;mark expunge and delete
delf% ;do it
jrst [userr <Cannot delete temporary file - library is OK>,jsy]
txnn f,edtrdo ;Readonly edit ?
ret ;no, so return
txne f,edtsed ;SED used as editor ?
ret ;yes, so it's already told 'em
tmsg <%Edit was /READONLY - no update done> ;no, so remind them
ret ;that no update was done.
subttl GETEDT - get the editor, and run the thing
;
; This gets the editor in an inferior fork, hands it the rescan
; buffer, and starts it.
;
getedt: movx t1,gj%sht+gj%old ;insist file exists
hrroi t2,[ASCIZ/EDITOR:/] ;editor logical name
txne f,edtsed ;SED requested ?
hrroi t2,[asciz/SYS:SED.EXE/] ;yes
gtjfn% ;try and find it
erjmp [userr <Cannot find EDITOR: >,jsys]
movem t1,prgjfn ;remeber JFN on prog
movx t1,cr%cap ;give inferior our capabilities
cfork% ;create a fork for it
erjmp [userr <Cannot create editor fork - >,jsys]
movem t1,frkhnd ;remember fork handle
hrlz t1,frkhnd ;fork handle in left half
hrr t1,prgjfn ;and JFN in left
get% ;map process to file
erjmp [userr <Cannot map editor - >,jsys]
hrroi t1,scratch ;point to new command line
rscan% ;load buffer
ercal error
getnm% ;read our system name
push p,t1 ;save it
movx t1,<sixbit/TV/> ;assume TV
txne f,edtsed ;using SED ?
movx t1,<sixbit/SED/> ;yup
setnm% ;set up SYSTAT name
move t1,frkhnd ;handle of inferior
setz t2, ;start at START
sfrkv% ;start at entry vector
ercal error
move t1,frkhnd
wfork% ;wait for it to finish
ercal error
pop p,t1 ;get our system name
setnm% ;set it back
move t1,frkhnd
kfork% ;kill inferior
ercal error
retskp ;return OK
subttl EDCMD - construct command for editor
;
; This routine constructs the command that will be loaded into
; the rescan buffer for the editor.
; It makes different commands if the editor is SED, and also does some
; jfn massaging. On input, q2 contains the jfn of the input editor file.
; On return, this is no longer valid.
;
edcmd: hrroi t1,scratch ;point to rescan buffer
hrroi t2,[asciz/EDIT /] ;start of command
txne f,edtsed ;using SED ?
hrroi t2,[asciz "SED "] ;yes, so change rescan buffer
setzb t3,t4
sout% ;write beginning of rescan buffer for editor
ercal error
move t2,q2 ;get the jfn again
movx t3,fld(.jsssd,js%dev)!fld(.jsssd,js%dir)!fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!js%paf ;write out all but generation number
jfns% ;write out the filename
ercal error
hrroi t2,[asciz/ /] ;space between the two filenames
txne f,edtsed ;using SED ?
jrst edcsed ;yes, cannot specify out=in type of command
setzb t3,t4
sout% ;write the space
ercal error
move t2,q2 ;get the output filename again
movx t3,fld(.jsssd,js%dev)!fld(.jsssd,js%dir)!fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!js%paf ;write out all but generation number
jfns% ;write that to the buffer
ercal error
hrroi t2,[asciz/.-1/] ;new generation
setzb t3,t4
sout% ;write that too
ercal error
edcsed: hrroi t2,[asciz/
/] ;get a carriage return
txne f,edtrdo ; /READONLY specified ?
hrroi t2,[asciz " /READONLY
"] ;yes, so plant the switch for SED
setzb t3,t4
sout% ;round off the command
ercal error
move t1,q2 ;get jfn of temp file
rljfn% ;release it
ercal error
ret
subttl CHKEDT - make sure output for editor is safe.
;
; This routine checks to ensure that, before we write an output file
; for an editor, no files of that name already exist in the directory.
; If they do, warn the user.
;
chkedt: hrroi t2,edtbuf ;Point at filename we will use
movx t1,gj%sht!gj%old ;ask for old file
gtjfn% ;grab a jfn
erjmp r ;if failure, no problem
movem t1,t4 ;else BIG problem - we might overwrite
call tstcol
tmsg <%A file already exists in this directory called >
movei t1,.priou ;write name to terminal
move t2,t4 ;jfn of file
setz t3, ;default name format
jfns% ;do it
ercal error
tmsg <
It will be deleted before the editor is entered, to avoid confusion with
the library module you are editing.
>
movei t1,^d2500 ;wait 2 1/2 seconds
disms% ;in case they panic
move t1,t4 ;get jfn of file
delf% ;delete it
erjmp .+1 ;ignore failure (probably offline...)
ret ;done
subttl THONG command
;
; Enter here for commands which we know about really, but don't
; feel like doing.
;
.know: jrst .direc
confirm ;wait for confirm
tmsg <?I don't understand ">
hrroi t1,atmbfr ;point to the atom buffer
psout% ;and tell 'em what we don't understand.
tmsg <". Use "DIRECTORY" or "LIST" if you want a directory listing.>
ret
subttl PUSH command - down to an inferior exec
;
; This command runs an exec beneath us, without giving it LOG
; capability, to prevent our library being left hanging in the air.
;
.push: noise (to TOPS-20 EXEC)
confirm ;confirm the command
skipe excfrk ;got an EXEC yet ?
jrst havexc ;yes, start it again
movx t1,gj%sht+gj%old ;insist file exists
hrroi t2,[asciz/SYSTEM:EXEC.EXE/] ;where the EXEC lives
gtjfn% ;try and find it
erjmp [userr <Cannot find EXEC because: >,jsys]
movem t1,prgjfn ;remeber JFN on prog
setz t1, ;give inferior no capabilities
cfork% ;create a fork for it
erjmp [userr <Cannot create EXEC fork - >,jsys]
movem t1,excfrk ;remember fork handle
movei t1,.fhslf ;now, read our capabilities word
rpcap% ;like this
ercal error ;should never fail
txz t2,sc%log ;disable LOG capability
txz t3,sc%log ;make it impossible to enable it
move t1,excfrk ;get handle of EXEC fork
epcap% ;give it everything we have except LOG
ercal error
hrlz t1,excfrk ;fork handle in left half
hrr t1,prgjfn ;and JFN in left
get% ;map process to file
erjmp [userr <Cannot map EXEC - >,jsys]
havexc: getnm% ;read our system name
push p,t1 ;save it
move t1,excfrk ;handle of inferior
setz t2, ;start at START
sfrkv% ;start at entry vector
ercal error
skipn mappd ;are we mapped ?
ifskp. ;if so...
txo f,clsnrj!tabok ;ask to keeo library, but unmap it
call umap
seto t3, ;note we need to remap
else.
setz t3, ;else note we don't remap
endif.
move t1,excfrk
wfork% ;wait for it to finish
ercal error
pop p,t1 ;get our system name
setnm% ;set it back
skipe t3 ;test if there was a library mapped
call maplib ;reopen library
ret ;return OK
subttl SQUEEZE command - remove empty space from library
;
; This command creates a new version of the library which contains
; no deleted modules or any empty space. It actually creates a new
; generation of the library - it is impossible to do this operation
; in place. The routine which does the work can also be called from the
; DELETE, UPDATE and REPLACE commands if they detect that the library
; is more than one tenth empty.
;
.squeeze: noise (library to remove empty space)
skipn mappd ;got a library to squeeze ?
jrst [userr <No library selected yet - use LIBRARY command>] ;no
txne f,ronly ;read only library ?
jrst [userr <Write access to library required>] ;yes, cannot do it
chksfe ;library safe ?
confirm ;confirm the command
;
; Internal entry point from other commands is here.
;
sqzint: skipe unsafe ;library safe ?
jrst [userr <Cannot (or rather WILL not) squeeze an unsafe library>]
call getnlib ;get jfn on new library, and open it
ret ;failed, return to caller
move q3,hdrpag+$hnent ;get number of entries
sub q3,hdrpag+$hndel ;subtract deleted entries
dmsg <
[Squeezing headers]>
setzm chdr ;mark initialization call
sqzin1: call sqhdr ;squeeze one header across
ret ;failed, so return
sojg q3,sqzin1 ;loop for all modules; n=>g GPG **
dmsg <[OK]
[Squeezing data pages]>
move q3,hdrpag+$hnent
sub q3,hdrpag+$hndel ;subtract deleted entries
setzm chdr ;mark init entry
sqzin2: call sqmod ;squeeze one module's data across
ret ;failed, so return
sojg q3,sqzin2 ;loop for all modules; n=>g GPG **
call maksaf ;now set the new library safe
dmsg <[OK]
[Unmapping old library]>
call umap ;unmap the old library
dmsg < [OK]>
move t1,squjfn ;get jfn of new copy
txo t1,co%nrj ;set to close but keep jfn
closf% ;close new one
ercal error
move t1,squjfn ;get jfn on new library
movem t1,libjfn ;make jfn of current library
dmsg <
[Mapping new library]>
call maplib ;and map the new squeezed copy
dmsg < [OK]>
ret ;back to caller
subttl Copy one module from old library to new
;
; This routine is called to copy one module from the old library to the
; new library. It walks through the directory in the same order that
; SQHDR does, thus putting all files in the right place for their headers.
; On the first call (spotted by CHDR being non-zero), we reset the byte
; size of the library to its own size (this does not modify the FDB)
;
sqmod: skipe chdr ;first call ?
jrst sqmodc ;no, continue as normal
move t1,hdrpag+$hnent ;yes, so get number of entries
sub t1,hdrpag+$hndel ;subtract number of deleted ones
imul t1,hdrpag+$hwpde ;multiply by words per entry
add t1,hdrpag+$hwih ;and add words in fixed header
idivi t1,1000 ;divide by words in page to get pages in
skipe t2 ;directory....
aoj t1, ;and add one if any remainder
movem t1,t4 ;save this for a mo
movei t2,^d36 ;get bits in a word
idiv t2,hdrpag+$hbysz ;divide by bits in a byte
imul t1,t2 ;now get bytes in directory
imuli t1,1000 ;multiply by words in a page
movem t1,cfil ;this is the start byte for new data writes
movei t1,hdrpag ;point to header page
add t1,hdrpag+$hwih ;add number of words in a header
movem t1,chdr ;this points to the current header
move t1,squjfn ;get jfn of squeezed library
move t2,t4 ;and pages in directory
lsh t2,9 ;make pages into word-size bytes
sfptr% ;and set pointer for new writes
ercal error
move t2,hdrpag+$hbysz ;get byte size for data
sfbsz% ;set file byte size...
ercal error ;failed
move t1,hdrpag+$hnent ;get number of entries
sub t1,hdrpag+$hndel ;subtract number of deleted ones
skipg t1 ;do we have any left ?
retskp ; no, so don't do any
sqmodc: move t1,chdr ;point to current header
skipe $dmupd(t1) ;delete module ?
jrst sqmod1 ;no, so do it
add t1,hdrpag+$hwpde ;yes, so add words per entry
movem t1,chdr ;store as new entry pointer
jrst sqmodc ;try the next one...
sqmod1: move q1,chdr ;get current header
move t1,libjfn ;point to input library
move t2,$dmstrt(q1) ;get starting byte for this module
sfptr% ;point there
ercal error
move q2,$dmlen(q1) ;get length of this module
caig q2,1000*ndpag ;more than 512 bytes ?
jrst [movns q2,q2 ;no, so make this a negative count
jrst sqmod3] ;and do it simply
movns q2,q2 ;make byte count negative
sqmod2: move t1,libjfn ;point to library
move t2,[point ^d36,datpag] ;and buffer page
movni t3,1000*ndpag ;read 1k bytes
sin% ;do it
ercal error
move t1,squjfn ;get new library jfn
move t2,[point ^d36,datpag] ;pointer to buffer page
movni t3,1000*ndpag ;1k worth
sout% ;write it
quoerr ;let expunge handle this
addi q2,1000*ndpag ;drop amount left to write
camge q2,[-1000*ndpag];ok yet ?
jrst sqmod2 ;yes, go on
sqmod3: move t1,libjfn ;point to input
move t2,[point ^d36,datpag] ;to buffer
move t3,q2 ;amount left to read
jumpe t3,sqmod4 ;if zero remainder, don't do any work
sin% ;do it
ercal error
move t1,squjfn ;point to new library
move t2,[point ^d36,datpag] ;buffer to output file
move t3,q2
sout% ;write last buffer
quoerr ;let QUOTA trap any errors
sqmod4: move t1,chdr ;get current header
add t1,hdrpag+$hwpde ;update for next call
movem t1,chdr ;store as new entry pointer
retskp ;return success
subttl Copy one header from old library to new
;
; This routine is called to copy across one header from the old
; library to the new. Current pointers are kept in chdr,cfil
;
sqhdr: skipe chdr ;initialized yet ?
jrst sqhdrc ;yes, just do the next one
move t1,hdrpag+$hnent ;no, so get number of entries
sub t1,hdrpag+$hndel ;subtract number of deleted ones
imul t1,hdrpag+$hwpde ;multiply by words per entry
add t1,hdrpag+$hwih ;and add words in fixed header
idivi t1,1000 ;divide by words in page to get pages in
skipe t2 ;directory....
aoj t1, ;and add one if any remainder
movei t2,^d36 ;get bits in a word
idiv t2,hdrpag+$hbysz ;divide by bits in a byte
imul t1,t2 ;now get bytes in directory
imuli t1,1000 ;multiply by words in a page
movem t1,cfil ;this is the start byte for new data writes
movei t1,hdrpag ;point to header page
add t1,hdrpag+$hwih ;add number of words in a header
movem t1,chdr ;this points to the current header
move t1,hdrpag+$hnent ;get number of entries
sub t1,hdrpag+$hndel ;subtract number of deleted ones
skipg t1 ;do we have any left ?
retskp ; no, so don't do any
sqhdrc: move t1,chdr ;get address of next directory entry
skipe $dmupd(t1) ;this entry deleted ?
jrst sqhdr1 ;no, so do it
move t1,hdrpag+$hwpde ;yes, get words per entry
addm t1,chdr ;update current entry pointer
jrst sqhdrc ;and try the next one
sqhdr1: hrlz t1,chdr ;get current header pointer
hrri t1,squhdr ;point to temp area for squeeze headers
movei t2,squhdr ;address of header start
add t2,hdrpag+$hwpde ;add words in an entry
soj t2, ;less one
blt t1,(t2) ;now copy the directory entry
move t1,cfil ;get current "eof" pointer
movem t1,squhdr+$dmstrt ;this is the new module start address
move t1,squjfn ;point to "squeezing library"
move t2,[point ^d36,squhdr] ;byte pointer to area
movn t3,hdrpag+$hwpde ;number of words in an entry
sout% ;write them
quoerr
move t1,squhdr+$dmlen ;get bytes in this module
addm t1,cfil ;update "eof" pointer
move t1,hdrpag+$hwpde ;words per directory entry
addm t1,chdr ;update header pointer
retskp ;return to caller
subttl Get jfn on new library and open for write access
;
; This routine initializes the new library file - sets up a header,
; etc. and establishes the start page for normal writes to take
; place.
;
getnlib: hrroi t1,scratch ;point to scratch buffer
move t2,libjfn ;get jfn of library
movx t3,fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!js%paf ;write out STR:<DIR>NAME.TYP (no generation)
jfns% ;write out current library name
ercal error
movx t1,gj%sht!gj%fou
hrroi t2,scratch ;now prepare to get a jfn on new generation
gtjfn% ;do it
erjmp [userr <Cannot get jfn on new library - >,jsy] ;failed
movem t1,squjfn ;save the jfn
setzm squpag ;zero out the header page
move t1,[squpag,,squpag+1]
blt t1,squpag+777 ;now do it
movei t1,hdrmrk ;magic number for page 0 of library
movem t1,squpag ;store it
move t1,hdrpag+$hwih ;number of words in old header
movem t1,squpag+$hwih ;store it
move t1,[hdrpag+$hext,,squpag+$hext]
blt t1,squpag+$hext+7 ;store default extension
move t1,hdrpag+$hbysz ;get byte size for library
movem t1,squpag+$hbysz ;store
gtad% ;get current date and time
movem t1,squpag+$hupdt ;store as time of last update
move t1,hdrpag+$hwpde ;get number of words per directory entry
movem t1,squpag+$hwpde ;store
move t1,hdrpag+$hnent ;get number of entries
sub t1,hdrpag+$hndel ;subtract deleted ones
movem t1,squpag+$hnent ;this is how many will be in new lib
caile t1,mxpg0 ;do they all fit in page 0 ?
jrst [subi t1,mxpg0 ;no, so how many extension pages
idivi t1,mxpgn ;are there ?
skipe t2 ;remainder in final page ?
aoj t1, ;yes, add another page on
movem t1,squpag+$hnext ;set extension page count
jrst .+1] ;and continue
setom squpag+$hsafe ;mark new library unsafe
move t1,squjfn ;get library jfn
movx t2,of%wr
openf% ;open it
erjmp [userr <Cannot open new library - >,jsys]
move t1,squjfn ;write to new library
move t2,[point ^d36,squpag] ;from header page
movni t3,1000 ;one page worth
sout% ;write it
quoerr <Cannot write to library>
move t1,squjfn ;now get library
txo t1,co%nrj
closf% ;close, but do not release jfn
ercal error ;tuff
move t1,squjfn ;point to file
txo t1,fld(.fbbyv,cf%dsp) ;word to change
movx t2,fb%bsz ;mask in word to alter
move t3,hdrpag+$hbysz ;new byte size for library
lsh t3,<^d35-pos(fb%bsz)>;shifted to proper place
chfdb% ;do it
ercal error
move t1,squjfn
movx t2,of%wr!of%rd ;open for update
openf% ;do it
ercal error
move t2,hdrpag+$hwih ;number of words in header
sfptr% ;set up to write beyond header
ercal error
retskp ;return to caller
subttl GUIDES - command parses for GUIDE mode
;
; These parsers handle the HELP INFO PRINT and EXIT commands when in
; GUIDE mode. They don't do any real work.
;
.gexit: noise (from this program)
confirm
call umap ;get rid of the library
haltf% ;stop
.ghelp: noise (with this program)
confirm
hrroi t1,hlpgui
psout%
ret
.GIDXT: 1,,1
[asciz/INDEX/],,-1
.ginfo: noise (on subject)
txo f,typing
jrst .ginf2
.gprnt: noise (info on the printer about)
txo f,gprint ;flag PRINT-style output
.ginf2: movei t1,cmdblk
movei t2,[flddb. (.cmkey,,.gidxt,,,[
flddb. (.cmkey,,modules,<Subject for help, >)])]
txnn f,idxmod ;any INDEX modules found ?
movei t2,[flddb. (.cmkey,,modules,<Subject for help, >)] ;no, don't allow
comnd% ;Parse the field
erjmp cmderr
txne t1,cm%nop ;Parse ok ?
jrst [userr <Unknown subject - >,jsy] ;no
hrre t1,(t2) ;get data from TBLUK
jumpge t1,.ginf3 ;if non-negative, not INDEX
noise (on chapter name) ;They have typed INDEX
comand <[flddb. (.cmkey,,idxtab,<Index chapter name, >)]>,<Unknown chapter - >,jsy
.ginf3: movem t2,q1 ;save TBLUK index
confirm ;confirm command
txnn f,gprint ;PRINT command ?
jrst [movei t4,.priou
jrst .copy3] ;no, so just go straight for TYPE
hrroi t2,[asciz/LPT:/] ;yes, so grab LPT jfn
movx t1,gj%sht!gj%fou ;must exist
gtjfn%
erjmp [userr <Cannot find line printer - >,jsy]
movem t1,t4 ;save output jfn
jrst .copy3 ;continue with ordinary TYPE
subttl IDXBLD - build table for INDEX command in GUIDE mode.
;
; This routine is called at initialization when in GUIDE mode. It
; searches the library for modules whose name are of the form *-INDEX.
; If any are found, flag IDXMOD is set, and a TBLUK table of the modules
; is built.
;
idxbld: saveac q1
hrroi t1,copnam ;where WLDSET expects filename
hrroi t2,[asciz/*-INDEX/]
setzb t3,t4 ;string is ASCIZ
sout% ;copy match pattern for index modules
txo f,noerr ;inhibit errors
call wldset ;Try for any modules of this type
ret ;no index modules present
txz f,noerr ;allow errors
movei t1,maxidx ;OK, get max number of index chaps
movem t1,idxtab ;and store in index table
movei q2,1 ;where we are in table
idxlop: move q1,(q1) ;so get the entry
movem q1,idxtab(q2) ;store into TBLUK table
call wldnxt ;try for next match
jrst idxend ;no more
aoj q2, ;ok, bump the index
cain q2,maxidx ;too many ?
jrst [tmsg <
?Too many index modules in guide file>
HALTF%]
jrst idxlop ;and continue
idxend: hrlm q2,idxtab ;store number of modules used
txo f,idxmod ;indicate an index is present
ret ;and return
subttl MOD - type any message for this verson of LBR
;
; This routine types any warnings or cajolings for users of LBR.
;
mod: txne f,guide ;guide mode ?
ret ;yes, none of this stuff then
tmsg <
The DIRECTORY commands in LBR are now different. DIRECTORY just prints
a list of filenames in the library ; VDIRECTORY prints all files, together with
date + time of last update, and FDIRECTORY prints the full information like the
old directory command. The STATUS command prints just the header of the old
DIRECTORY command. The switches /FULL,/VERBOSE,/OUTPUT and /SORTED are now
also usable with any flavour of the DIRECTORY command.
>
ret
repeat 0,<
tmsg <
LBR now has a TDIRECTORY command, like the EXEC, which prints the
directory sorted by order of date and time, rather than alphabetically.
The /AFTER and /BEFORE swiches still work with TDIR, and you can use
other feature of DIR (like TDIR S* for a sorted list of all modules
beginning with S.)
>
ret
>
repeat 0,<
TMSG <
If you control-C during a type command, this will now just stop
the typeout and return the LBR prompt, rather than getting out of
LBR altogether. This can be useful for stopping long typeouts.>
TMSG <
When you create a new library, you can now specify the minimum
space to allow for files. This makes it quicker to create the library
if you know it will contain more than 40 modules, as it does not need
to be expanded later.>
TMSG <
The DIRECTORY command now has a BEFORE and AFTER switch, for
listing files between certain dates and/or times.
>
RET
>
REPEAT 0,<
Tmsg <
The /READONLY switch now works with SED.
LBR now has a PUSH command, like the EXEC.
The GO command exits from LBR, and reexecutes your last COMPILE,
EXECUTE or DEBUG command.
There is now an APPEND command to append to an output file when
you copy from a library.
>
tmsg <
You can now type SET SED to make SED your default LBR editor.
You can now type a command like INSERT A* without worrying if something
called A* already exists in your library. If it does, it will be skipped.
>
ret>
subttl SLEN - get string length
;
; This routine is called with an address in t1. It returns a number of
; characters in t2.
;
slen: push p,t3 ;save an ac
hll t1,[point 7,] ;make a byte pointer
setz t2, ;zero the count
slen1: ildb t3,t1 ;get a byte
jumpe t3,[pop p,t3 ;if zero, restore ac
ret] ;and return
aoja t2,slen1 ;else increment count and get next byte
subttl MAKSAF - make new library safe and CHKSQZ
;
; This resets the UNSAFE flag in the new squeezed library, set
; while we were actually writing to it.
;
maksaf: move t1,squjfn ;point to new library
movei t2,^d36 ;set for 36 bit bytes
sfbsz% ;do it
ercal error
move t1,squjfn ;point to new library again
setz t2, ;we want to write a zero
movei t3,$hsafe ;into the safety byte
rout% ;do that
ercal error
move t1,squjfn ;point to library yet again
move t2,hdrpag+$hbysz ;and get real byte size
sfbsz% ;reset this so close works OK
ercal error
ret ;back to caller
;
; This routine is called to see if an auto squeeze would be
; useful.
;
chksqz: txnn f,alowsq ;is AUTO-SQUEEZE permitter ?
ret ;no, so return now
move t1,libjfn ;it is, so get library..
sizef% ;size in bytes
ercal error
idivi t2,^d10 ;and get 10% of that figure
camle t2,hdrpag+$htfre ;is it less than total free space ?
ret ;no, so don't bother right now
call tstcol ;yes, so get a new line
tmsg <[Performing automatic SQUEEZE...>
call sqzint ;enter squeeze at internal entry point
tmsg <OK]> ;reassure user
ret ;back to caller
subttl WLDSET - routine called to commence a wildcard lookup
;
; This routine is called when one wants to initiate a wildcard module
; lookup. The wild module string should be in COPNAM.
; If one is using this to perform output to files, a parse-only
; jfn should be supplied in t4 for constructing individual jfns
; for output files. If t4 contains 0 on entry, no jfns will be
; constructed.
; If QDFLG is set, only deleted modules will be returned for matches.
; Returns: +1/ Failure, no matching modules.
; +2/ Success, pointer to tbluk entry for module
; in q1, jfn for output file in t4, saved wildcard jfn in
; wldjfn
;
; Things are also set up for WLDNXT to pick up the next wild
; module.
;
wldset: movem t4,wldjfn ;save the parse-only jfn (for directory, etc.)
hlrz t4,modules ;number of undeleted entries in lib
txne f,qdflg ;doing deleted stuff ?
move t3,hdrpag+$hndel ;yes, so get deleted number instead
jumpe t4,[userr <Library is empty>] ;if none, return
movei q3,modules+1 ;point to TBLUK table
wldse1: hlrz t1,(q3) ;get address of this entry
skipn $dmupd(t1) ;deleted entry ?
jrst wldsel ;yes, so ignore it
movx t1,.wlstr ;wild string match desired
hrroi t2,copnam ;point to name of wild module
hlro t3,(q3) ;make byte pointer to module name
wild% ;try for a match
ercal error ;should not receive JSYS error
txnn t1,wl%nom ;get a match ?
jrst wldsem ;yes, so return the info
wldsel: aoj q3, ;no, so bump the pointer to the directory
sojn t4,wldse1 ;and loop through the modules
userr <No modules match that specification> ;if we reach here, there is no match
;
; We have found the first match
;
wldsem: movem t4,wldcnt ;save counter for loop
movem q3,wldptr ;and pointer to directory
skipn wldjfn ;were we given a jfn ?
jrst wldse3 ;no, so don't try to construct one
hllz t3,(q3) ;destination...
hrri t3,outnam ;and source....
blt t3,outnam+7 ;for copying output filename
txne f,rwild ;is this a repeated wild scan ?
jrst wldse2 ;yes, the setup has already been performed
movx t1,gj%fou ;assume output use for file
txne f,tempot ;want temporary output ?
txo t1,gj%tmp ;yes, so set flag for GTJFN
movem t1,wldblk ;store flags in GTJFN block
move t1,[hdrpag+$hext,,outext]
blt t1,outext+7 ;set up default extension to be that of library
move t2,wldjfn ;now get jfn used for output
hrroi t1,outext ;area to write extension to
movx t3,fld(.jsaof,js%typ) ;only output extension
txnn t3,gj%ext ;wildcards in extension ?
jfns% ;no, so use it
ercal error ;should not occur
hrroi t1,outdir ;point to area for output directory
move t2,wldjfn ;get output parsing jfn
movx t3,fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf
jfns% ;now output structure and device to use
ercal error
wldse2: movei t1,wldblk ;point to GTJFN block for wild stuff
hrroi t2,outdir ;point to structure/directory
gtjfn% ;try for a jfn
erjmp [userr <Cannot open output file - >,jsy]
movem t1,t4 ;put jfn where it is expected
wldse3: move q1,q3 ;return TBLUK address for this entry
retskp ;return success
subttl WLDNXT - step a wildcard module lookup
;
; this routine is called after one call has already been made to
; WLDSET to initialize wild-card scanning of the library. WLDSET has
; returned the first matching entry, and it is our job to find the next
; one. We can use much of the same code that is used in WLDSET - some
; of it is omitted not because ti would make things go wrong, but because
; it would be a waste of time setting up things that have already been
; done.
;
wldnxt: txo f,rwild ;indicate repeated wild scan
move t4,wldcnt ;retrieve stored counter
move q3,wldptr ;and pointer
soje t4,[ret] ;decrement - if zero, none left
aoj q3, ;some left, step to next entry
wldnx1: hlrz t1,(q3) ;get entry address
skipn $dmupd(t1) ;is entry deleted ?
jrst wldnxl ;yes, so ignore it
movx t1,.wlstr ;wild string match desired
hrroi t2,copnam ;point to name of wild module
hlro t3,(q3) ;point to name of library module to match
wild% ;try for a match
ercal error ;should not receive JSYS error
txnn t1,wl%nom ;get a match ?
jrst wldsem ;yes, so return the info
wldnxl: aoj q3, ;no, so bump pointer to lookup table
sojn t4,wldnx1 ;and loop through the modules
ret ;if here, no matches left
subttl COPWON - output name of destination in wild copy
;
; This routine is called when doing a wildcard copy command.
; It outputs the name of the current destination file on the terminal.
; All acs are preserved.
; If appending, the name of the source module is output instead.
;
copwon: txne f,typing ;TYPE command ?
ret ;yes, do nothing
push p,t1
push p,t2
push p,t3
push p,t4 ;save all acs used
tmsg <
> ;pretty new line
txne f,apping ;appending ?
jrst [hlro t1,(q1) ;yes, point to module name
psout% ;type it
jrst copwor] ;continue
move t2,t4 ;jfn of output file
movei t1,.priou ;terminal
setzb t3,t4 ;usual filename format
jfns% ;write it out
ercal error ;should not happen
copwor: pop p,t4
pop p,t3
pop p,t2
pop p,t1
ret
subttl DDT - enter ddt
;
; This command is here for us to put a breakpoint on with DDT.
;
.ddt: noise (enter DDT - beware !)
confirm
txo f,modif
skipe havddt ;have we got DDT yet ?
jrst .ddt1 ;yes, so just breakpoint
call getddt ;no, so merge and breakpoint
setom havddt ;and remember we have DDT already
ret ;back for next command
.ddt1: jsr @$bpt ;go for unsolicited breakpoint
ret ;and back for next command
subttl LUKMOD - lookup a module in the library
;
; Name of a module is in LUKNAM, we check to see if it exists.
; It attempts to do a lookup on the module specified, and returns
; +1 if not found, +2 if found. If the +2 return is taken, a pointer
; to the directory entry is returned. This routine is not used most
; of the time - its only use is for updates and inserts, which have
; to check that the module is NOT there.
;
lukmod: hrroi t2,luknam ;now point to the name
movei t1,modules ;point to module list
tbluk% ;do a lookup
erjmp [userr <Library directory is corrupt - >,jsy]
txne t2,tl%exm ;exact match ?
retskp ;yes, return success
ret ;no, return failure
subttl Map and unmap libraries
;
; These routines either map or unmap the current library.
;
umap: skipn mappd ;mapped ?
ret ;no, so do nothing
seto t1, ;yes, so set up to unmap
move t2,[.fhslf,,hdrpag/1000] ;unmap header page from this fork
movei t3,1 ;remove 1 page
add t3,hdrpag+$hnext ;plus any extra pages
txo t3,pm%cnt ;flag count present
pmap% ;do it
ercal error
move t1,libjfn ;now get the library
txne f,clsnrj ;keep the jfn, did they say ?
txo t1,co%nrj ;yes, so keep it
closf% ;and close it
ercal error
txzn f,clsnrj ;keep the jfn, did they say ?
setzm libjfn ;no, so forget we ever had it
setzm mappd ;and clear the mapping status
ret ;back to caller
maplib: setom mapcnt ;counter for multiple access attempts
mapint: skipe mappd ;mapped ?
jrst [call umap ;unmap us
userr <Library already mapped>]
move t1,libjfn ;look at the library
move t2,[1,,.fbbyv] ;get the byte size
movei t3,t4 ;where to put it
gtfdb% ;read the file byte size
ercal error ;can't fail
txz t4,^-<fb%bsz> ;clear all but the byte size
lsh t4,-<^d35-pos(fb%bsz)> ;and shift down to right end
move t2,t4 ;get the byte size
lsh t2,<^d35-pos(of%bsz)> ;put in place for OPENF
move t1,libjfn ;open up the library
txo t2,of%rd!of%wr!of%pln ;for read and write access, no SOS numbers
txne f,ronly ;read-only lit ?
txz t2,of%wr ;yes, no write access ta
openf% ;do it
erjmp [cain t1,opnx9 ;invalid simul access ?
jrst mapwt ;yes, so maybe we can wait a bit...
cain t1,opnx4 ;do we need write access ?
jrst lbrrdo ;yes, so do read only
caie t1,opnx30 ;or is it archived ?
jrst [userr <Cannot open library - >,jsys] ;no, some other error
lbrrdo: dmsg <
[Opening library read-only]>
txo f,ronly ;flag read-only
jrst maplib] ;continue
hrlz t1,libjfn ;get the library, map page 0
move t2,[.fhslf,,hdrpag/1000] ; to set page in our process
movx t3,pm%rd!Pm%wr!pm%pld
txne f,ronly ;read-only library ?
txz t3,pm%wr ;yes, no write access
pmap% ;do it
erjmp [move t1,libjfn ;get library
closf% ;close it
nop ;tuff
setzm libjfn ;forget it
userr <Cannot map library - >,jsys]
setom mappd ;indicate mapped, in case of error
movei t1,hdrmrk ;special marker
came t1,hdrpag ;is it set ?
jrst [call umap
userr <File is not a library>]
move t3,hdrpag+$hnext ;any extension pages ?
jumpn t3,[hrlz t1,libjfn ;ok, point to library
hrri t1,1 ;start mapping at page 1 of file
move t2,[.fhslf,,<hdrpag/1000>+1] ;map to extension area
txo t3,pm%rd!pm%wr!pm%pld!pm%cnt
txne f,ronly ;read only library ?
txz t3,pm%wr ;yes, no write access ta
pmap%
erjmp [call umap
userr <Cannot map library extension - >,jsy]
jrst .+1]
skipe unsafe ;library look OK ?
jrst [call tstcol ;nope, it don't
tmsg <%Library directory appears inconsistent - rebuild>
jrst .+1]
txzn f,tabok ;tables will be the same ?
call bldtab ;no, so build lookup table
move t1,hdrpag+$hflgs ;get flag words
txne t1,hfprm ;permanent library ?
txz f,tempot ;yes, so clear temporary stuff
ret ;ok, back to caller
mapwt: hrroi t1,[asciz/
[Waiting for access to library]/]
aosn t2,mapcnt ;increment wait time
psout% ;type message on first attempt
cain t2,5 ;waited too long ?
jrst [userr <Library is being written to by another user>] ;yes
movei t1,^d5000 ;ok, wait 5 seconds
disms% ;like this
jrst mapint ;and try again
subttl BLDTAB - build lookup table from library info
;
; This routine is called whenever a new library is mapped to build
; the TBLUK table that will be used to walk through the library module
; name list. Once the library is open, both the lookup table and
; the library table are updated together, so this never needs to be
; written back.
;
bldtab: move t1,hdrpag+$hnent ;get number of entries
movem t1,q1 ;save
movei t1,maxent ;get maximum number of modules
camge t1,q1 ;not overflowed ?
jrst [userr <Library contains too many modules>]
movem t1,modules ;store size of TBLUK% table
skipn q1 ;any modules there ?
ret ;no, so back to caller
movei q2,hdrpag ;address of start of header
add q2,hdrpag+$hwih ;add number of words in header to point to dir
movei t1,modules ;point to TBLUK% table
hrlz t2,q2 ;point to this entry
bldmn1: skipe $dmupd(q2) ;if deleted, do not add
tbadd% ;add to table
erjmp [userr <Error constructing module name table - >,jsy]
add q2,hdrpag+$hwpde ;point to next directory entry
hrlz t2,q2 ;make TBLUK entry
movei t1,modules ;get address of table again (fouled by TBADD)
sojn q1,bldmn1 ;loop for all modules
ret
subttl Text for HELP commands
hlpgen: asciz \ The LBR program maintains and creates what are known as "universal"
libraries. These are files in your directory that contain many other files, most
of which were originally quite short (only a few pages). LBR conserves disk
space both in your directory, and in the system overhead area, by compressing
lots of small files into one large file. You can extract these small files
whenever you want, or replace them inside the library with new versions, or
remove them altogether, or type them, or get a directory. All of these things
are done with the LBR prorgam.
Two assumptions are made about the libraries you use. First, it
is assumed that all the files will be of a similar type. Second, as a result
of this, it is assumed that all have the same byte size, and all have the same
extension. These are not required, but when you insert a file into the library,
its name is remembered, but its extension is not. When you extract it, the
extension used by default is one set up for the whole library. Similarly, the
output file will be written with the byte size of the library. For most purposes
this presents no problem. However, it means it may not be easy to mix (say)
binary files and text files in one library, unless you are willing to treat
them all as binary.
The space savings that can be made are dramatic. We picked just
one user on our system who had 65 1-page files in his directory (mainly files
of commands to a statistical package). They took up, of course, 65 pages
in his directory, and 65 more pages of overhead (from system directories). In
a library, they took up just 12 pages !
Type HELP FILESPEC for help on the syntax of file and module
specifications in LBR.
\
hlpedt: ASCIZ \ The EDIT command allows you to specifiy a module in the
library which you wish to edit. It starts up the system editor, places the file
in its text buffer, and then automatically replaces the edited module back into
the library when you exit from the editor.
If you wish to use SED as your editor, type /SED after the
module name. To use SED always, you can type SET SED, which makes LBR
always use SED for the EDIT command. You might want to put this in your LBR.INIT
file. If you only want to use the editor to review a file (ie you do
not wish to change it), type /READONLY after the module name. This will prevent
any accidental changes you make being incorporated into the library.
\
hlpfsp: ASCIZ \ File specifications in LBR commands such as COPY, INSERT
LIBRARY, etc. follow the standard TOPS-20 pattern for their names. Both names
and extensions can be upto 39 characters long, and directory specs can be given
which are also 39 characters long. When more than one file can be operated on
by one command, a "wildcard" spec is allowed, where * and % characters are
used in the filename. "*" stands for any combination of characters, "%" for any
single character. Thus A% means all two-character names beginning with A, and
A* means all names beginning with A (including just A, if it exists.)
Module names follow the same rules, except that they are just
names, with no directories or extensions.
When wildcards are used for an output filename, they may not work as
expected. If you specify a wildcard in any field in the output filename, it
means "use the value of the input field here". If you do not, that part of the
output filename is used. Thus
COPY A* (to) <Work-directory>BA*.DAT
does NOT add the letter B to the beginning of all your filenames, It copies
the modules specified to directory <WORK-DIRECTORY>, and gives them the
extension DAT. This is the case with all programs that use output wildcards.
\
hlpcre: asciz \
The CREATE command makes a new library, and makes it the current library for
following commands. The format is:
CREATE (library) LIBNAM.LBR (type) extension (byte size) n (with room for) N
A file of this name must not already exist. This prevents you
accidentally overwriting an existing library. To create a new library to
supersede an old one, you must DELETE the old library first.
Only the name of the library need be type, all the rest defaults.
The extension of the library defaults to .LBR, the default extension for
inserts and extracts to null, and the byte size to 0 (all suitable for
text files.) The number of entries defaults to the minimum possible (which is
around 40 at present). The library is expanded as necessary if room is needed
for more. As the expansion is a lengthy process for large files, if you are
creating a library which you know will contain more than 40 modules, it is worth
your while to allocate more space initially. Each 40 modules of directory space
takes about 1 page of disk space.
The type will be set when the first file is inserted, as will
the byte size, using those supplied by the first file.
Examples:
CREATE GLIM-COMMANDS
CREATE BINARY-DATA (type) BIN (byte size) 36
\
hlpdel: asciz \
The DELETE command deletes modules from a library. Format:
DELETE (modules) name
You can either specify the name of a single module, or a wildcard spec
using * and %. % matches a single character, * any combination of chars.
Thus A* means all modules whose name begins with A ; A% means all modules
whose name begins with and habe 2-letter names. Combinations such as
A%B* are acceptable. Recognition with escape can be used on single names,
but not with wildcard names. You can also use question mark to get a list
of modules.
\
hlpdir: asciz \
The DIRECTORY-class commands are used to list the names of modules in
the library. Optionally, information such as the size and date and time of last
update can also be included. The basic directory command lists all modules ;
typing DIR A* would list all modules beginning with A. The following switches
may be used at the end of the command to modify it:
/AFTER:date+time, or date, or time Only list modules altered after
the specified date or time
/BEFORE:... Like after, but lists only those
modifed before the specified time.
/FULL Prints a header before the directory
like the STATUS command.
/VERBOSE Includes the size of each module,
and the date and time of last update.
/OUTPUT:file Places the directory output in the named
file.
/SORTED-BY-DATE-AND-TIME Sorts the output listing so that the
newest modules are at the top of the
listing (usually the listing is alpha-
betical)
The TDIRECTORY command is like directory with a /SORTED switch
assumed. The FDIRECTORY command assumes the /FULL switch, and the VDIRECTORY
command assumes the /VERBOSE switch. The LIST command requires an output file
name.
If you want a compact listing of filenames and nothing else, it
may be easiest to type
TYPE ?
which will give a list of all modules in a compact tabular form.
\
hlpins: asciz \
The INSERT command places new files into a library. Note that when in the
library, we refer to the files as "modules", to distinguish them from real
files. The format of the command is
INSERT (files) filename.type
You can type the name of a single file, or a wildcard file spec. The type
defaults to the default type for the current library. The files are inserted one
by one into the library, with their names typed as it happens, if you ask for
more than one to be inserted. Note that if a file is encountered which clashes
with a module already present, the file is not inserted, and LBR proceeeds to
the next file in the list.
\
hlprep: asciz \
The REPLACE command is used to update a module in a library which is out of
date. A new copy of the file is written into the library. Command:
REPLACE (modules) modnames (with files) filename
You may use wildcards. The filenames default to the module names used. You
should not attempt to override this unless you have to, as you may not have
as many files as there are modules to replace if you use different names.
You may find the UPDATE command easier to use than REPLACE. They both
perform a similar function.\
hlptyp: asciz \
The TYPE command types files from a library. This is only useful with
text-file libraries. Format:
TYPE (modules) name
\
hlpcop: asciz \
The COPY command copies modules from the library to TOPS-20 files so that
you can use them with another program. Format:
COPY (modules) modnames ( to files) filenames
The filenames default to the module names, the extension to the
library default extension. You may use wildcards. By default, the output files
are temporary files, and will be expunged when you logout. They will still be
in the library. See the SET NO TEMPORARY command to override this.
\
hlpupd: asciz \
The UPDATE command replaces exisiting modules in the library with
new versions from ordinary TOPS-20 files. The format is
UPDATE (modules) modnam
where modnam is either a single module name or a wildcarded name. This command
assumes that the new versions of the files have the same name as their
corresponding module, and the same type as the library, which is the usual state
of affairs. To do more complex updating, see the REPLACE command.\
hlplib: asciz \
The LIBRARY command selects a new library to work with. You must give this
command before attempting to use an existing library. format:
LIBRARY (to use is) libnam
The type defaults to .LBR.
You can also specify the library to be used with
the TOPS-20 command you use to run LBR. Example:
@LBR FRED
starts LBR running, and makes it use FRED.LBR automatically. This will
override any LIBRARY command that you may have in your LBR.INIT file.
\
hlpset: asciz \
The SET command is used to change various defaults. Arguments are:
SET [NO] AUTO-EXPUNGE
This controls whether or not LBR will expunge your directory
when it becomes full when writing to the library. By default, if an INSERT or
UPDATE operation on a library causes the directory to become full, the directory
containing the library will be expunged. A failing COPY command will also
cause this to happen. SET NO AUTO-EXPUNGE prevents this.
LBR then pauses to allow you to create space yourself, selectively.
SET EXTENSION file-extension
This alters the default file extension used in
INSERT, REPLACE and COPY commands. It permanently alters this in the library
for future use.
SET [NO] SQUEEZE
By default, every time the library becomes more than one tenth
empty space, LBR performs a "squeeze" operation, which creates a new version
of the library without any deleted space in it. This is usually desirable, but
may not be if you are about to perform a stream of updates to a large library,
when you may mot have enough disk space for the old and new versions of the
library to coexist. This command controls this feature.
SET [NO] TEMPORARY
This turn on or off the feature whereby output files are
made temporary, so that they are expunged at logout. By default, files
extracted with COPY are made temporary.
SET EPHEMERAL,SET PERMANENT
These commands allow you to permanently override the SET
[NO] TEMPORARY commands for a particular library. Typing SET PERMANENT means
that every time you use the current library from now on, all output files
will no be temporary, without you having to type SET NO TEMPORARY.
SET SED
When you use the EDIT command in LBR, your default editor
(usually TV) is used, unless you type EDIT/SED. The SET SED command makes LBR
use SED at all times for the EDIT command.
\
HLPSQU: ASCIZ \
The SQUEEZE command compresses your library into its most compact form
removing all deleted space and deleted directory entries. When you delete or
update modules, LBR attempts to find a free space that best fits the new
module in the library. If none is found, the new module goes at the end.
Eventually the library accumulates some small patches of unusable space, the
amount of which is typed on a directory listing as "Free space in bytes:".
The SQUEEZE command creates a new copy of the library with this space removed.
A SQUEEZE is performed automatically if, after a command has been
executed, more than 10% of the library is empty space. You can suppress this
action with SET NO SQUEEZE. It may be desirable to do so if you are in the
process of updating a large library, as you may not have enough space to keep 2
copies of the library (the old one being squeezed, and the new one being
created.)
\
hlpgo: asciz/
The GO command exits from LBR, just like the EXIT command, but then asks
TOPS-20 to re-perform your last LOAD-class command (ie LOAD, EXECUTE, COMPILE,
DEBUG.) This is useful if you have just edited a program in a LBR-library and
wish to recompile or execute it.
/
hlpapp: asciz/
The APPEND command works just like the COPY command, except that
it appends the modules to the specified output file, instead of creating new
output files. The exception is that you cannot use wildcards for the output of
the append command - APPEND A* FRED appends all modules beginning with A to
file FRED.??? (where ??? is the filetype of your library.)
/
hlpgui: asciz\
This program can be used to list selected bits of info about the system
or the subroutine libraries. The GUIDE program lists info on system commands
and programs ; the SUBS program on the CRC subroutine library ; the NAG program
on the NAG library.
The INFO command lists info on a particular subject, for instance
INFO TYPE tells you about the TYPE command for typeing files. Type INFO ?
for a list of things you can get info on. The PRINT command is like info,
but prints the information on the lineprinter for later reference.
The EXIT or QUIT commands get you out of the program. If you want
just info on one thing, you can type the whole command on one line to
the TOPS20 "@" prompt:
@GUIDE TYPE
for instance, tells you about the TYPE command.
\
hlpsts: Asciz \
The STATUS command prints information about the current library,
the default filetype, the default bytesize, the number of modules in the
library, and the amount of deleted space. This information is also printed
in an FDIRECTORY or DIRECTORY/FULL command.
\
hlptab: hlpsiz,,hlpsiz
TB (HLPAPP,APPEND)
TB (HLPCOP,COPY)
tb (HLPCRE,CREATE)
TB (HLPDEL,DELETE)
TB (HLPDIR,DIRECTORY)
TB (HLPEDT,EDIT)
TB (HLPDIR,FDIRECTORY)
TB (HLPFSP,FILESPECS)
TB (HLPGEN,GENERAL)
TB (HLPGO,GO)
TB (HLPINS,INSERT)
TB (HLPLIB,LIBRARY)
TB (HLPDIR,LIST)
TB (HLPREP,REPLACE)
TB (HLPSET,SET)
TB (HLPSQU,SQUEEZE)
TB (HLPSTS,STATUS)
tb (HLPDIR,TDIRECTORY)
TB (HLPTYP,TYPE)
TB (HLPUPD,UPDATE)
TB (HLPDIR,VDIRECTORY)
HLPSIZ==.-HLPTAB-1
SUBTTL HELP AND EXIT COMMANDS
; HELP COMMAND
.HELP: HRROI T2,[ASCIZ/with subject/] ;get noise
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
comand [flddb. (.cmkey,,hlptab,<Subject you want help for,>,<GENERAL>)],<Invalid HELP command, try just HELP - >,jsy
hrrz q1,(t2) ;get index to table
confirm ;confirm command
move t1,q1 ;point to text
psout% ;output it
ret ;back to caller
; EXIT COMMAND
.EXIT: HRROI T2,[ASCIZ/from LBR/] ;noise
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
CALL ENDCOM ;GO PARSE END OF COMMAND
RET ;BAD CONFIRMATION, RETURN
.exiti: call umap ;unmap and close current library
SETOM T1 ;INDICATE ALL FILES SHOULD BE CLOSED
CLOSF ;CLOSE ALL OPEN FILES
JSERR ;UNEXPECTED ERROR
HALTF ;RETURN TO MONITOR
JRST START ;IF CONTINUE'D, START OVER
; GO command - exit and do last load-class command
.go: noise (exit from LBR and execute last load-class command)
confirm ;they want to ?
call umap ;yes, so unmap and close the library
seto t1, ;mark to close
closf% ;anything left over
erjmp .+1 ;who cares ?
move t1,[.prast,,.fhslf] ;set up a PRARG block
movei t2,[1 ;number of argument lists
400740,,2 ;pointer to list
0] ;list itself
movei t3,3 ;length of PRARG block
prarg% ;do it
ercal error
haltf% ;stop
jrst start ;and restart
SUBTTL COMMAND ERROR SUBROUTINES
; INVALID END-OF-COMMAND
CFMERR: CALL TSTCOL ;TEST COLUMN POSITION
TMSG <? LBR: Garbage at end-of-command
> ;OUTPUT ERROR MESSAGE
RET ;RETURN TO WHENCE WE CAME ...
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED
TSTCOL: MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT DESIGNATOR
RFPOS ;READ FILE POSITION
HRRZ T2,T2 ;KEEP JUST THE COLUMN POSITION
JUMPE T2,R ;IF AT COLUMN 1 DO NOT OUTPUT CRLF
TMSG <
> ;NO, OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A GTJFN OR OPENF
;
; CALL: CALL PUTERR
; RETURNS: +1 ALWAYS
PUTERR: MOVX T1,.PRIOU ;GET PRIMARY OUTPUT JFN
HRLOI T2,.FHSLF ;OUR FORK, LAST ERROR CODE
SETZM T3 ;
ERSTR ;OUTPUT ERROR STRING
JFCL ;IGNORE
JFCL ;IGNORE
TMSG <
> ;OUTPUT NEW LINE
RET ;RETURN TO WHENCE WE CAME ...
;PUTATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PREFIX STRING TO BE TYPED
; CALL TYPATM
;RETURNS: +1 ALWAYS
TYPATM: STKVAR <ATOMPT>
MOVEM T1,ATOMPT ;SAVE ATOM POINTER
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? LBR: > ;OUTPUT INITIAL PART OF MESSAGE
MOVE T1,ATOMPT ;RESTORE ATOM POINTER
PSOUT ;OUTPUT THE STRING
TMSG < "> ;OUTPUT PUNCTUATION
HRROI T1,ATMBFR ;GET POINTER TO THE ATOM BUFFER
PSOUT ;OUTPUT THE TEXT ENTERED
TMSG <"
> ;OUTPUT END OF LINE
RET ;RETURN
subttl Initialize interrupt system
;
; This subroutine enables control-c capabilities if present, then
; sets up the interrupt system and puts control-c s on channel 0
; If running under batch, don't enable control-c interrupts.
;
intset: setom loklvl ;initialize directory lock nest level
seto t1, ;indicate current job
hrroi t2,t4 ;one word in t4
movei t3,.jibat ;get batch flag
getji% ;do it
ercal error
jumpl t4,intse1 ;if negative, we are in batch
txo f,timesh ;flag no batch
txo f,ccints ;assume control-c is available
movx t1,.fhslf ;point to this fork
rpcap% ;read out capabilities
ercal error
txnn t2,sc%ctc ;got control c ?
jrst [call badint
jrst intse1] ;no, so warn user
txo t3,sc%ctc ;enable control-c
epcap% ;do it
ercal badint
intse1: movx t1,.fhslf ;point to this fork
move t2,[levtab,,chntab] ;addresses of level and channel tables
sir% ;declare to monitor
erjmp badint ;cannot do it
eir% ;enable interrupt system
erjmp badint
txo f,intsys ;flag we have an interrupt system
movx t1,.fhslf ;point to this fork
movx t2,1b<.icqta> ;get channel for quota exceeded
aic% ;activate quota channel
ercal error
ret ;back to caller
badint: call tstcol
tmsg <%Cannot enable control-c interrupts, be sure to let all commands finish>
txz f,ccints ;flag no control-c stuff available
ret
;
; routines to turn control-c on and off
;
liblck: txnn f,ronly ;if library is read-only, cannot lock it
setom unsafe ;mark library unsafe
aos loklvl ;increment lock level
txnn f,ccints ;got an interrupt system ?
ret ;no, so return
skipe loklvl ;was library already locked ?
ret ;was already locked, nothing to do
push p,t1
push p,t2 ;save acs that we will trash
hrlzi t1,.ticcc ;control-c on channel 0
ati% ;assign the code
ercal error
movx t1,.fhslf ;now point to this process
movx t2,1b0
aic% ;and activate channel 0
ercal error
dmsg <
[Locking library]>
pop p,t2
pop p,t1 ;restore save acs
ret ;and return to mainline code
lunlock: sosl loklvl ;decrement lock level
ret ;not yet fully unlocked
setom loklvl ;cope with excessive unlocks
txnn f,ronly ;if library is readonly ,cannot unlock
setzm unsafe ;mark library safe to fiddle with
txnn f,ccints ;got an interrupt system ?
ret ;no, so return
push p,t1
push p,t2 ;save some acs
dmsg <
[Unlocking library]>
txzn f,ccwait ;is there a pending control-c ?
jrst unlnrm ;no, just disable interrupts
call tstcol ;yes, so make a new line
tmsg <^C> ;display the control-c
hrlz t1,libjfn ;get jfn of library
movx t2,1000 ;number of pages to update (assume enormous)
txnn f,ronly ;if read only, cannot do this
ufpgs% ;force disk to be updated before we exit
ercal error
haltf% ;and halt
unlnrm: movx t1,.ticcc
dti% ;deassign control-c
ercal error
movx t1,.fhslf ;point to this process
movx t2,1b0
dic% ;deactivate channel 0
ercal error
pop p,t2
pop p,t1 ;restore saved acs
ret ;return to caller
;
; Come here on control-c
;
ctrlc: xct ccxct ;do whatever caller wants on control-c
push p,t1
dmsg <
[Control-C received]>
pop p,t1
debrk% ;dismiss interrupt
subttl Quota exceeded when writing to library - do something
;
; SOUTS to the library do not have ERCALS or ERJMPs after them.
; We trap them with this routine instead, which will attempt to perform
; an expunge, then DEBRK from the interrupt, allowing the write to
; continue.
;
quota: push p,t1 ;save all acs
push p,t2
push p,t3
push p,t4 ;that we will use
txne f,iexpunge ;inhibit expunge ?
jrst expunge ;no, so do it
tmsg <
?Disk quota exceeded or disk full. DELETE and EXPUNGE some files, then
type CONTINUE to allow the operation to proceed. If you do not do so, the
library will be corrupted and must be rebuilt.>
haltf% ;allow him to do something
jrst quoback ;leave interrupt context
;
; Here to really expunge
;
expunge: tmsg <
[Disk quota exceeded or disk full, expunging > ;type out prefix of message
move t2,libjfn ;supply library jfn
call getdir ;find out which directory we're writing
movx t1,.priou
move t2,dirnum ;number of destination directory
dirst% ;type name to user
ercal error
tmsg <...> ;
move t1,dirnum ;directory number of suspect dir
gtdal% ;find allocation
ercal error
movem t2,used ;save count of used pages
movx t1,dd%dnf ;delete deleted files
move t2,dirnum ;from this directory
deldf% ;do it
erjmp [tmsg <[NOT OK]
?>
call puterr ;type JSYS error
jrst quodie] ;join fail code
move t1,dirnum ;now look at directory again
gtdal% ;how much used ?
ercal error
caml t2,used ;less than before expunge ?
jrst [tmsg <[NOT OK]
?No space released by expunge, you must DELETE and EXPUNGE files, then
type CONTINUE.> ;nope, must do it by hand
jrst quodie]
tmsg <[OK]> ;everything appears fine
quoback: move t1,[nop] ;instruction to execute on return
movem t1,errop ;store for mainline code to pick up
quob1: pop p,t4 ;so restore the acs
pop p,t3
pop p,t2
pop p,t1 ;that we used
debrk% ;and leave interrupt context
quodie: tmsg <
The library will be corrupt unless you correct the disk space problem
and continue the program.>
haltf% ;wait for action....
jrst quoback ;and leave interrupt context
;
; Here to find directory number of directory corresponding to
; a jfn passed in T2. Usually the library, sometimes an output file.
;
getdir: hrroi t1,dirnam ;where to put name
movx t3,fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf ;write dir + device
jfns% ;in ASCIZ
ercal error
hrroi t2,dirnam ;now point to this directory name
movx t1,rc%emo ;allow only exact match of name
rcdir% ;translate to directory number
ercal error
txne t1,rc%nom ;get a match ?
jrst [tmsg <
?Internal error - cannot match directory name>
haltf%] ;no, this should not happen
movem t3,dirnum ;store for caller's use
ret ;return to caller
subttl COPEXP - expunge for COPY command
;
; This routine performs an expunge as the result of a failing COPY
; command. Things work slightly different with this one, as we
; don't give horrific error messages if the expunge fails. Also,
; the directory number must be obtained from the target of the COPY,
; not from the library jfn.
;
copexp: push p,t1
push p,t2
push p,t3
push p,t4 ;save all necessary acs
txnn f,iexpunge ;auto-expunge allowed ?
jrst coperr ;no, issue error and return two levels
tmsg <
[Disk quota exceeded or disk full, expunging > ;type out prefix of message
move t2,t4 ;get jfn of output file
call getdir ;find out which directory we're writing
movx t1,.priou
move t2,dirnum ;number of destination directory
dirst% ;type name to user
ercal error
tmsg <...> ;
move t1,dirnum ;directory number of suspect dir
gtdal% ;find allocation
ercal error
movem t2,used ;save count of used pages
movx t1,dd%dnf ;delete deleted files
move t2,dirnum ;from this directory
deldf% ;do it
erjmp [tmsg <[NOT OK]
>
jrst coperr] ;join fail code
move t1,dirnum ;now look at directory again
gtdal% ;how much used ?
ercal error
caml t2,used ;less than before expunge ?
jrst [tmsg <[NOT OK]
%No space released by EXPUNGE>
jrst coperr]
tmsg <[OK]> ;everything appears fine
pop p,t4 ;so restore the acs
pop p,t3
pop p,t2
pop p,t1 ;that we used
movem t1,dirnum ;save one register for a mo
pop p,t1 ;get return PC
subi t1,2 ;and make it point to the failing SOUT
push p,t1 ;put it back
move t1,dirnum ;get back real t1
ret ;and return to rexecute SOUT jsys
coperr: pop p,t4
pop p,t3
pop p,t2
pop p,t1 ;restore all acs
move t1,t4 ;input file
txo t1,cz%abt ;mark abort io so leave no output
closf% ;close it
nop
pop p,t1 ;get return address from stack and discard
txo f,copyok ;mark copy failed
userr <Error writing output module - >,jsy
SUBTTL PARSING SUBROUTINES
; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL: CALL ENDCOM
; RETURNS: +1 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
; +2 SUCCESS, COMMAND CONFIRMED
ENDCOM: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
COMND ;PARSE CONFIRMATION
erjmp cmderr ;error, go check for eof on take file
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
JRST [ CALLRET CFMERR ] ;NO, ISSUE ERROR MESSAGE AND RETURN
CALL TAKTST ;OUTPUT COMMAND LINE IF DOING TAKE COMMAND
RETSKP ;SUCCESS, RETURN
; ROUTINE TO PARSE NOISE PHRASE
;
; CALL: T2/ POINTER TO NOISE PHRASE
; CALL SKPNOI
; RETURNS: +1 ERROR, INVALID NOISE PHRASE
; +2 SUCCESS, NOISE PHRASE PARSED OK
SKPNOI: MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
SETZM NOIFDB ;CLEAR FIRST WORD OF BLOCK
BLT T1,NOIFDB+FDBSIZ-1 ;CLEAR FUNCTION DESCRIPTOR BLOCK
MOVX T1,.CMNOI ;GET FUNCTION TO PERFORM
STOR T1,CM%FNC,NOIFDB ;STORE FUNCTION CODE IN FDB
MOVEM T2,NOIFDB+.CMDAT ;STORE POINTER TO NOISE PHRASE IN FDB
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,NOIFDB ;GET ADDRESS OF FUNCTION BLOCK
COMND ;PARSE NOISE WORD
erjmp cmderr ;error, go check for eof on take file
TXNN T1,CM%NOP ;NOISE PHRASE PARSED OK ?
RETSKP ;YES, RETURN SUCCESS
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
HRROI T1,[ASCIZ/Invalid guide phrase/]
callret typatm ;output the text entered and return
;
; Routine to get hold of LBR.INIT if it exists, and try to
; execute it.
;
inifil: seto t1, ;this job
hrroi t2,t4 ;store in t4...
movei t3,.jilno ;our logged-in directory number
getji% ;do it
ercal error
move t2,t4 ;get this number
hrroi t1,dirnam ;and write it out
dirst% ;like so
ercal error
hrroi t2,[asciz/LBR.INIT/] ;follow up with name of .INIT file
setzb t3,t4
sout% ;do that too
ercal error
hrroi t2,dirnam ;now point at the filename
movx t1,gj%sht!gj%old ;must exist
gtjfn% ;try for INIT file
erjmp [ret] ;if failure, no sweat, they don't have one
movx t2,fld(7,of%bsz)!of%rd ;but if it's there, open it
openf% ;for read
ercal error ;if this fails, it's bad
movem t1,injfn ;save input jfn
hrlzm t1,cmdblk+.cmioj ;store for COMND%
movei t1,.nulio ;send output to NUL:
hrrm t1,cmdblk+.cmioj ;tell COMND to do this
setom takflg ;mark a take command
txo f,takini ;mark LBR.INIT
ret ;back to caller
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PROMPT STRING
; CALL CMDINI
;RETURNS: +1 ALWAYS, WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
; CALL TO CMDINI.
CMDINI: MOVEM T1,CMDBLK+.CMRTY ;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
POP P,SAVRET ;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
MOVEM P,SAVREP ;SAVE STACK POINTER TO BE RESET ON REPARSE
MOVEI T1,REPARS ;GET ADDRESS OF REPARSE ROUTINE
MOVEM T1,CMDBLK+.CMFLG ;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
COMND ;INITIALIZE COMMAND SCANNER JSYS
ERJMP CMDERR ;ERROR, GO SEE IF END OF "TAKE FILE"
JRST @SAVRET ;RETURN
; HERE TO PROCESS A REPARSE
REPARS: MOVE P,SAVREP ;RESET STACK POINTER
JRST @SAVRET ;RETURN TO CALLER OF CMDINI
SUBTTL GENERAL SUBROUTINES
; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL: CALL CLRGJF
; RETURNS: +1 ALWAYS
CLRGJF: MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD OF BLOCK
BLT T1,GJFBLK+GJFSIZ-1 ;CLEAR GTJFN BLOCK
RET ;RETURN TO WHENCE WE CAME ...
; ROUTINE TO OUTPUT COMMAND LINE TO TERMINAL IF PROCESSING TAKE FILE
;
; CALL: CALL TAKTST
; RETURNS: +1 ALWAYS, COMMAND LINE OUTPUT IF NEEDED
TAKTST: call tstcol ;get new line if needed
HRROI T1,BUFFER ;GET POINTER TO COMMAND LINE
SKIPn TAKFLG ;COMMANDS COMING FROM FILE ?
ret ;no, go back
txnn f,takini ;yes, so LBR.INIT ?
PSOUT ;no, OUTPUT COMMAND LINE
RET ;RETURN
; Routine to abort current take file - called by error routines
; to check if a take file is being used, and if so, kill it.
; CALL: call abotak
; Returns: +1 always, command file aborted and message to user
; if required.
;
abotak: skipn takflg ;using take file ?
ret ;no, return
call tstcol ;get new line if needed
hrroi t1,[asciz/?Error in command file, command file aborted/]
txne f,takini ;doing LBR.INIT ?
jrst [hrroi t1,[asciz/?Error in LBR.INIT, file aborted/]
txnn f,timesh ;yes, in batch ?
hrroi t1,[asciz/%Error in LBR.INIT, file aborted/] ;yes
jrst .+1]
psout% ;type informative message
move t1,injfn ;get command file jfn
closf% ;close it
nop
txz f,takini ;clear initialization flag
setzm injfn ;remove command file
setzm takflg ;flag no take file
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
ret
;CMDERR - ROUTINE TO PROCESS ERRORS ON EXECUTING A COMND JSYS
; IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
; IS SIMPLY PROCESSED. ELSE AN ERROR MESSAGE IS ISSUED AND
; THE PROGRAM IS RESTARTED.
;
; CALL: JRST CMDERR
CMDERR: SKIPN TAKFLG ;PROCESSING A TAKE FILE ?
JRST CMER10 ;NO, GO ISSUE ERROR MESSAGE
HlRZ T1,CMDBLK+.CMIOJ ;GET INPUT FILE JFN FOR TAKE FILE
GTSTS ;GET THE FILE'S STATUS
TXNN T2,GS%EOF ;AT END OF FILE ?
JRST CMER10 ;NO, GO ISSUE ERROR MESSAGE
MOVE T1,[.PRIOU,,.PRIIN] ;YES, GET STANDARD PRIMARY JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;RESET INPUT AND OUTPUT JFN'S
SETZM TAKFLG ;MARK THAT TAKE FILE NOT BEING PROCESSED
move t1,injfn ;get command file jfn
closf% ;close it
nop ;ignore errors
TXZ F,takini ;no LBR.INIT
JRST PARSE ;GO PROCESS NEXT COMMAND
CMER10: CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
call puterr ;output an error
TMSG < LBR: Unexpected COMND JSYS error, restarting...
> ;OUTPUT MESSAGE
JRST ENTVEC+1 ;GO SIMULATE A "REENTER"
end <3,,entvec>