mirror of
https://github.com/PDP-10/its.git
synced 2026-04-17 08:51:08 +00:00
1312 lines
44 KiB
Plaintext
1312 lines
44 KiB
Plaintext
;;;-*-MIDAS-*-
|
||
|
||
SUBTTL HAIRY LIST HANDLING UUO'S - description
|
||
IFN 0,[
|
||
New List-area storage format:
|
||
|
||
One list entity, or LSE, requires 3 separate UUO areas, termed
|
||
the HDR, LA, and SA, for storage respectively of Header information,
|
||
List structures, and Strings. The SA is simply an amorphous buffer
|
||
for string storage, and the HDR contains various addressing and
|
||
management information. (See "Contents of HDR".)
|
||
List structures are composed of linked List Nodes, or
|
||
LN's. $LNSIZ is an assembly parameter defining the # words per LN,
|
||
currently 2; this is constant for ALL LN's, which can be of 3 types:
|
||
value, list, and string.
|
||
_______________________________________________
|
||
|Res |Data|Res | Attrib | |
|
||
|srvd|type|srvd| type | CDR ---------|------> next LN (cdr=0 if last)
|
||
| 0 | 7 | 0 | 777 | 777777 |
|
||
|_____________________________________________|
|
||
| |
|
||
| Data Word |
|
||
|_____________________________________________|
|
||
|
||
The "Data type" field indicates which of these 3 types the LN is,
|
||
and affects only the interpretation of the LN's data word. It can
|
||
be considered syntactic information about the structure of the data,
|
||
as opposed to the Attrib-type field which is a "name" for it
|
||
and is purely semantic. The 3 types are defined below, one to a flag bit:
|
||
]
|
||
; LN type flags & field definitions
|
||
%LTVAL==10000 ; data is a Value
|
||
%LTLST==20000 ; data is a List-Pointer
|
||
%LTSTR==40000 ; data is a String-Pointer
|
||
%LTMSK==70000 ; mask for Data-type field.
|
||
%LAMSK==777 ; mask for Attrib-type field.
|
||
; BP LH for Attribute field.
|
||
$LAFLD==(.BP <%LAMSK,,0>,)
|
||
$LTFLD==(.BP <%LTMSK,,0>,)
|
||
$LNSIZ==2 ; LN's are 2 words.
|
||
|
||
IFN 0,[
|
||
A "Value" type LN (VLN) simply treats the data word as 36 bits of data.
|
||
For a List-Pointer LN (LLN), the data word is a List Pointer or LP
|
||
which points to another list of LN's. For a String-Pointer LN (SLN), the
|
||
data word is an string pointer (SPT) in ASCNT format, relative to the SA.
|
||
That is, the LH contains a char count, and the RH is the relative address
|
||
of the string in the SA area. This has the restriction that such strings
|
||
must begin on a word boundary.
|
||
LP's are, of course, relative to the beginning of the LA; this
|
||
allows fast shifting and loading, at some expense in addressing time.
|
||
The first LN in the LA (i.e. at LP address 0) is always zeroed,
|
||
to prevent LP's of 0 from doing anything. Initialized and deleted
|
||
LN's are kept on a Freelist, which will link all unused LN's as long
|
||
as no trees are accidentally left dangling.
|
||
]
|
||
|
||
;PRINT VERSION NUMBER
|
||
.TYO6 .IFNM1
|
||
.TYO 40
|
||
.TYO6 .IFNM2
|
||
PRINTX/ included in this assembly.
|
||
/
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;;;;;;; ;;;;;;;;;
|
||
;;;;;;;; CONTENTS OF HDR: ;;;;;;;;;
|
||
;;;;;;;; HDR Area Definitions and initial Address-table ;;;;;;;;;
|
||
|
||
UHDRDF:
|
||
OFFSET -. ; So symbolic addresses are defined relative to beginning
|
||
; of HDR, starting at 0.
|
||
$LHBEG::REPEAT 20,[%%IDX==.RPCNT
|
||
REPEAT $LNSIZ, (%%IDX)+.RPCNT
|
||
] ; First of all comes addressing table for LA access.
|
||
; (See explanation, "LA Addressing")
|
||
$LHLTB==.-$LHBEG ; This is resultant length of above table.
|
||
$LHARP:: 0 ; Stores addr of ARBLK (ie ARPT) for this (HDR) area.
|
||
|
||
$LLFRE:: 0 ; <Rel ptr to first free LA loc>
|
||
$LLLST:: 0 ; Main List pointer. <LP to whatever>
|
||
$LLFRL:: 0 ; Freelist pointer. <LP to freelist>
|
||
$LLFRC:: 0 ; Freelist count. <# free LN's>
|
||
$LSFRE:: 0 ; <Rel ptr to first free SA loc> = <# words used>
|
||
$LSGC:: 0 ; <# of wds SA uses which are garbage>
|
||
0 ? 0 ? 0 ? 0 ? 0 ; Spare words for easier expansion.
|
||
|
||
$LLAR:: BLOCK $ARSIZ ; LA ARBLK, with various auxiliary defs
|
||
$LLLOC==$LLAR+$ARLOC ; abs location of LA
|
||
$LLWPT==$LLAR+$ARWPT ; abs write ptr
|
||
$LLRPT==$LLAR+$ARRPT ; abs read ptr
|
||
$LLLEN==$LLAR+$ARLEN ; area length
|
||
$LLCHL==$LLAR+$ARCHL ; # chs left to write in (if type %ARTCH)
|
||
$LLTOP==$LLAR+$ARTOP ; area lastaddr+1 (loc+len)
|
||
|
||
$LSAR:: BLOCK $ARSIZ ; SA ARBLK, exactly as for LA.
|
||
$LSLOC==$LSAR+$ARLOC ; abs location of SA
|
||
$LSWPT==$LSAR+$ARWPT ; etc.
|
||
$LSRPT==$LSAR+$ARRPT
|
||
$LSLEN==$LSAR+$ARLEN
|
||
$LSCHL==$LSAR+$ARCHL
|
||
$LSTOP==$LSAR+$ARTOP
|
||
|
||
0 ? 0 ? 0 ? 0 ; More spare words.
|
||
|
||
; Any other assembled HDR defs must come before $LHEND!
|
||
|
||
$LHEND:: ; Highest used. Can expand HDR area dynamically above this.
|
||
$LHSIZ:: ; Minimum size required for HDR area.
|
||
|
||
OFFSET 0 ;Back to normal LOC
|
||
|
||
IFN 0,[
|
||
LA Addressing:
|
||
|
||
The REPEAT's at $LHBEG represent an addressing table for use with the
|
||
LISTAR macro. To "directly" address a location in the LA, AC L must be
|
||
loaded with the address of the HDR, i.e. the $ARLOC entry for that area. One
|
||
can then reference anything in the HDR with constructs like
|
||
ADD A,$LSLOC(L). However, to address a list structure, one must have
|
||
the LP in a register (say C) and use MOVE A,LISTAR(C). The idea
|
||
is to treat LISTAR as equivalent to the absolute address of the LA.
|
||
What it actually expands to is @(L)+<$LNSIZ*C>. Thus, it indirectly
|
||
addresses location $LNSIZ*C of the table, which contains (C)LADDR.
|
||
The use of $LNSIZ*20 entries allows references such as LISTAR(C)+1,
|
||
etc. to win, as long as the additional increment is less than $LNSIZ.
|
||
(unfortunately due to macro difficulties one can't say the more
|
||
usual LISTAR+1(C). )
|
||
]
|
||
; Special macro to simulate start addr of current LA.
|
||
;note that one must say LISTAR(X)+1 instead of LISTAR+1(X),
|
||
;and an index reg must always be present! Better than
|
||
;nothing though.
|
||
|
||
DEFINE LISTAR ?IDX
|
||
@$LNSIZ*IDX(L)TERMIN
|
||
|
||
|
||
IFN 0,[
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;;;;;;; ;;;;;;;;
|
||
;;;;;;;; Disk Storage of LSE's ;;;;;;;;
|
||
|
||
A list entity is stored on disk in a "List Block" of the following
|
||
format. Any number of such List Blocks can be kept in a single file,
|
||
since all information is relative to the LB or its internal
|
||
HDR, LA, etc blocks. Since disk storage implies that formats
|
||
must be adhered to in order to read previously written data, a
|
||
version numbering scheme is included so that new versions can
|
||
be introduced without destroying the ability to read data written
|
||
in old formats. The point at which conversion takes place is
|
||
in LSEIN, where the disk data is actually read; user routines
|
||
should never have to know what the version number actually is.
|
||
|
||
---------------------------------
|
||
0: <# words in total blk>
|
||
1: <SIXBIT major identifier>
|
||
2: <flags?>,,<version #>
|
||
3: <HDR blk loc relative to start of LB>
|
||
4: <# wds in HDR blck>
|
||
5: <# wds in LA block>
|
||
6: <# wds in SA block>
|
||
|
||
<Optional extra information>
|
||
|
||
rel loc of HDR block:
|
||
<HDR block>
|
||
<LA block> ; Immediately follows HDR
|
||
<SA block> ; " " LA
|
||
|
||
<Optional extra information>
|
||
--------------------------------
|
||
|
||
The contents of the HDR, LA, and SA blocks are exactly as
|
||
they exist in core, and they can be written out directly. However,
|
||
on readin some HDR-block parameters are of necessity reinitialized,
|
||
such as the LA addressing table and the ARBLKs for the LA and SA.
|
||
Those which are invariant and meaningful are:
|
||
$LLFRE - rel addr of first free LA word
|
||
$LSFRE - rel addr of first free SA word
|
||
$LLFRL - Freelist pointer
|
||
$LLFRC - Freelist count
|
||
$LLLST - Main list pointer
|
||
$LSGC - # of garbage words in SA
|
||
|
||
The <optional extra information> can be anything which belongs
|
||
in the block somehow, and is meant to allow for easy addition of
|
||
new features, but it must all fit within the block bounds as specified by
|
||
word 0.
|
||
] ;end of IFN 0
|
||
|
||
|
||
SUBTTL LNCOPY - LN Copier.
|
||
|
||
; LNCOPY AC,[[addr of LSE] ? SETZ [lp]]
|
||
; General-purpose LN copier. The given LSE address (HDR loc)
|
||
; specifies the "X-LSE" which the LP points into, and the list
|
||
; pointed to is completely (CDR and all) copied into the L-LSE, with
|
||
; pointer left in AC. (Note: If the specified LSE's are in fact one
|
||
; and the same, "pure" strings are used for fast copying.)
|
||
;
|
||
; LNCOPY AC,[[addr of LSE] ? [lp]]
|
||
; Without the SETZ, acts just like above, but copies only the
|
||
; single LN pointed to, ignoring its CDR.
|
||
|
||
UUODEF LNCOPY:,ULCOPY
|
||
ULCOPY: MOVE U3,U40 ;get addr of 2-wd block
|
||
SKIPE U4,(U3) ;get addr to LSE-address
|
||
SKIPN U4,@U4 ;if addr and LSE-address both non-zero, get it.
|
||
MOVE U4,L ;else use L.
|
||
EXCH U4,L ; Reference X-LSE
|
||
HRRZ U1,@1(U3) ; to get LP.
|
||
CAML U1,$LLLEN(L) ; Check range
|
||
JSR AUTPSY
|
||
JUMPE U1,ULCOP1 ; Empty list
|
||
IFSVU2, PUSH P,U2
|
||
MOVE U2,LISTAR(U1) ; And get first wd of LN.
|
||
SKIPL 1(U3) ; Now if sign bit (SETZ) was set, that's it.
|
||
HLLZS U2 ; else must flush CDR, for single-LN copy.
|
||
MOVE U3,LISTAR(U1)+1 ; 2nd wd of LN.
|
||
EXCH U4,L ; restore LSE pointers
|
||
PUSHJ P,LNPOP ; Get a free LN to copy into.
|
||
PUSH P,U1 ; and save LP, because ULCPY doesn't!
|
||
PUSHJ P,ULCPY2 ; copy it. Special entry needed to allow single-LN hack.
|
||
LDB U2,UACFLD
|
||
POP P,(U2) ; restore LP to list directly into result AC.
|
||
IFSVU2, POP P,U2
|
||
UUOXRT
|
||
|
||
ULCOP1: LDB U1,UACFLD
|
||
SETZM (U1)
|
||
UUOXRT
|
||
|
||
; ULCPY - List Copier. Given LP in U1, copies and leaves new LP in U1. Thinks it is
|
||
; supposed to copy from X-LSE to L-LSE, specified by U4 and L
|
||
; respectively. If c(L) = c(U4) then string LN's are copied directly
|
||
; with no re-writing of the string. Clobbers everything but U4.
|
||
|
||
ULCPY: MOVE U2,U1
|
||
PUSHJ P,LNPOP ; U1 = new LP, U2 = source X-LP
|
||
PUSH P,U1
|
||
PUSHJ P,ULCPY1
|
||
POP P,U1 ; restore LP to new list.
|
||
POPJ P,
|
||
|
||
; Workhorse for ULCPY. This routine takes LP in U1 to destination
|
||
; LN, LP in U2 to source LN for copying. Is able to iterate on
|
||
; CDR to copy list because it need not worry about saving U1, which
|
||
; is up to the caller!
|
||
ULCPY1: PUSH P,U1
|
||
MOVE U1,U2 ; get X-LP out of U2.
|
||
EXCH U4,L ;To read from X-LSE, put right thing in L.
|
||
MOVE U2,LISTAR(U1) ;Get first wd of LN in X-LSE
|
||
MOVE U3,LISTAR(U1)+1 ;and second.
|
||
EXCH U4,L ;now restore LSE pointers.
|
||
POP P,U1 ; restore new LP.
|
||
ULCPY2: TLNE U2,%LTLST ;list? (note - entry pt for LNCOPY UUO.)
|
||
JRST [ PUSHAE P,[U1,U2]
|
||
HRRZ U1,U3
|
||
TRNE U1,-1 ; Skip if LP = 0
|
||
PUSHJ P,ULCPY ;recurse, copy list.
|
||
MOVE U3,U1 ;get returned LP
|
||
POPAE P,[U2,U1]
|
||
JRST ULCPY6] ;and go store it as value.
|
||
TLNE U2,%LTSTR
|
||
JRST ULCPY8 ;if string, go to special rtn.
|
||
|
||
;consider it a value.
|
||
ULCPY6: MOVEM U3,LISTAR(U1)+1 ;store value
|
||
HLLZM U2,LISTAR(U1) ;store LH only (don't have CDR yet)
|
||
TRNN U2,-1 ; If CDR non-existent,
|
||
POPJ P, ; then all done!
|
||
|
||
; Iterate on CDR.
|
||
MOVE U3,U1 ; Save new-LP temporarily
|
||
PUSHJ P,LNPOP ; get LP to be its CDR
|
||
HRRM U1,LISTAR(U3) ; and store CDR in the LN!
|
||
JRST ULCPY1 ; U1 = new LP, U2 = source LP, go copy.
|
||
|
||
|
||
;copy string. auxiliary part of ULCPY. U2 and U3 have wds 1 & 2
|
||
;of LN to be copied. U1 has LP to free LN to copy into. Copies
|
||
;string only if LSE's different, and puts new SPT in U3 as value.
|
||
;Mustn't clobber U1, U2, or U4!
|
||
ULCPY8: CAMN L,U4
|
||
JRST ULCPY6 ;if LSE's same, just use same SPT.
|
||
PUSHAE P,[U2] ;else must actually re-write string... ugh.
|
||
MOVE U2,U3 ;get original SPT in better place
|
||
HLRZ U3,U2 ;get char count.
|
||
ADDI U3,4
|
||
PUSH P,U4
|
||
IDIVI U3,5 ;find # words necessary for string.
|
||
POP P,U4
|
||
ADD U3,$LSFRE(L) ;get what will be new $LSFRE ptr.
|
||
CAML U3,$LSLEN(L) ;compare new count with length of area, and
|
||
JRST [ PUSHAE P,[U1,U3]
|
||
SUB U3,$LSLEN(L) ;gobble more room if need be. Find how much
|
||
MOVEM U3,ARUNIT ;and set up
|
||
MOVEI U1,$LSAR(L) ; GIVE IT THE ARPT
|
||
PUSHJ P,UABUMP ;and get the room.
|
||
POPAE P,[U3,U1]
|
||
JRST .+1]
|
||
ADD U3,$LSLOC(L) ;get absolute end+1 for BLT.
|
||
ADD U2,$LSLOC(U4) ;get abs source address for original SPT.
|
||
PUSH P,U4
|
||
HRRZ U4,$LSFRE(L)
|
||
ADD U4,$LSLOC(L) ;get abs destination address in RH.
|
||
HRL U4,U2 ;and stuff abs source addr in LH.
|
||
BLT U4,-1(U3) ;xfer the words!
|
||
POP P,U4
|
||
SUB U3,$LSLOC(L) ;make end relative again
|
||
EXCH U3,$LSFRE(L) ;and store as new first-free ptr (swap with old)
|
||
HLL U3,U2 ;stuff char count in to form new SPT.
|
||
POPAE P,[U2]
|
||
JRST ULCPY6 ;done with string copy!
|
||
|
||
SUBTTL List String Comparision UUO's - SLNE, SLNEA, USLNE, USLNEA
|
||
|
||
; SLNE AC,[slp] AC must also hold a SLP (LP to a string LN).
|
||
; The two strings are compared, and the UUO skips if they're equal.
|
||
; Fails to skip if strings are different, of different lengths, or
|
||
; if a LN is not string type.
|
||
; USLNE AC,[slp] same, but forces both to upper case during compare.
|
||
; SLNEA AC,[ASCNT [string]]
|
||
; USLNEA AC,[ASCNT [string]] See below.
|
||
|
||
|
||
UUODEF SLNE:,UQSTRE
|
||
UUODEF USLNE:,UQUSTR
|
||
|
||
LVAR UQSTRF: 0 ; Flag set when comparing with uppercase force.
|
||
LVAR UQSTRC: 0 ; cnt to loop on
|
||
|
||
UQSTRE: SETZM UQSTRF ;clear flag (no uppercase force)
|
||
SKIPA
|
||
UQUSTR: SETOM UQSTRF ;set flag for uppercase forcing
|
||
LDB U1,UACFLD
|
||
MOVE U1,(U1) ;get acc = ptr
|
||
IFSVU2, PUSH P,U2
|
||
MOVE U2,@U40 ;get addr = ptr
|
||
MOVE U3,LISTAR(U1)
|
||
MOVE U4,LISTAR(U2)
|
||
TLNN U3,%LTSTR ;be sure type is string
|
||
JRST UQSTR9 ;lose
|
||
TLNN U4,%LTSTR
|
||
JRST UQSTR9 ;ditto
|
||
MOVE U3,LISTAR(U1)+1 ;get string vals (# cnt,,addr)
|
||
MOVE U4,LISTAR(U2)+1
|
||
ADD U3,$LSLOC(L) ;make abs.
|
||
ADD U4,$LSLOC(L)
|
||
UQSTR4: HLRZ U1,U3
|
||
HLRZ U2,U4 ;try comparing cnts first
|
||
CAME U1,U2
|
||
JRST UQSTR9 ;can't be eq if different lengths!
|
||
MOVEM U1,UQSTRC ;store cnt to loop on
|
||
HRLI U3,440700
|
||
HRLI U4,440700
|
||
UQSTR5: SOSGE UQSTRC
|
||
JRST UQSTR7 ;through, we've won!
|
||
ILDB U1,U3
|
||
ILDB U2,U4
|
||
CAIN U1,(U2) ;skip if fail
|
||
JRST UQSTR5
|
||
SKIPN UQSTRF ;failed, but skip to try uppercase if flag set
|
||
JRST UQSTR9
|
||
XORI U1,(U2) ; Get XOR of the chars...
|
||
CAIE U1,40 ; Same char but different case?
|
||
JRST UQSTR9 ; Definitely not same char.
|
||
CAIL U2,"A ; Aha, win if one char is A-Z or a-z.
|
||
CAILE U2,"z ; First test for A-z.
|
||
JRST UQSTR9 ; Outside range, so no case folding.
|
||
CAIG U2,"Z ; Within A-z, is it inside A-Z?
|
||
JRST UQSTR5 ; Yes, win!
|
||
CAIL U2,"a ; Hmm, within a-z?
|
||
JRST UQSTR5 ; Yes, win!
|
||
; Bah, between Z-a! Fall thru to fail.
|
||
UQSTR9:
|
||
IFSVU2, POP P,U2
|
||
UUOXRT ;return w/o skipping
|
||
|
||
UQSTR7:
|
||
IFSVU2, POP P,U2
|
||
AOS UUORPC
|
||
UUOXRT ; won, skip
|
||
|
||
|
||
; SLNEA AC,[ASCNT [string]] AC must contain a SLP, as for (U)SLNE;
|
||
; however, comparision is done with the specified string. The advantage
|
||
; is that a template string need not be stored in a list-area.
|
||
; USLNEA AC,[ASCNT [string]] Same, but uppercase compare.
|
||
|
||
UUODEF SLNEA:,ULSTR
|
||
UUODEF USLNEA:,ULUSTR
|
||
|
||
ULSTR: SETZM UQSTRF
|
||
CAIA
|
||
ULUSTR: SETOM UQSTRF ;uppercase compare
|
||
LDB U1,UACFLD
|
||
MOVE U1,(U1) ;get ptr
|
||
IFSVU2, PUSH P,U2
|
||
MOVE U2,LISTAR(U1)
|
||
TLNN U2,%LTSTR ; String type?
|
||
JRST UQSTR9 ; No, fail.
|
||
MOVE U3,LISTAR(U1)+1 ;get stringval
|
||
ADD U3,$LSLOC(L) ;make abs
|
||
MOVE U4,@U40 ;get literal stringval(already abs)
|
||
JRST UQSTR4 ;jump into normal routine.
|
||
|
||
SUBTTL Wonderful Super LN-Creation UUO - MAKELN !!
|
||
|
||
; MAKELN AC,[ <attrib type>,,[[list-ptr]] Make a LN according to args,
|
||
; <LN type spec>,,[[LN-value]]] and leave LP to it in AC.
|
||
;
|
||
; The nesting of brackets may be confusing, but is less so in practice;
|
||
; using the RH to point at a full @(X)E address field allows arguments to
|
||
; be indexed and indirected to, and thus list-area addresses can be given.
|
||
; <attrib type> - an arbitrary value to be put into the ATTRIB field of the LN.
|
||
; list-ptr - will be inserted in RH of the LN, i.e. what list-ptr points to
|
||
; becomes the CDR of that LN.
|
||
; <LN type> - tells the routine what type of LN it is (value, list, string) and
|
||
; how to gobble the given LN-value. The defined types are:
|
||
; %LTVAL - type VAL, stores LN-val as the value of LN (2nd word).
|
||
; %LTLST - type LIST, stores LN-val as a ptr to a list.
|
||
; %LTSTR - type STRING, takes LN-val as being ASCNT /string/ and stores.
|
||
; %LTBPT - type STRING, takes LN-val as <# chars>,,[b.p. to string]
|
||
; %LTSAR - type STRING, takes LN-val as an ARPT and forms a LN string
|
||
; value from the text in that area.
|
||
; %LTSAO - type STRING, makes string of everything accumulated on
|
||
; regular output UUO's since a SAOBEG. If a
|
||
; non-zero value is furnished, it is interpreted
|
||
; as an instruction to XCT, and the resulting
|
||
; output is used for the string; no SAOBEG is needed.
|
||
; Output must be on the "standard output"; the OUT
|
||
; package must be used.
|
||
|
||
%LTBPT==1 ; This flag is for MAKELN only. (see above)
|
||
%LTSAR==2 ; Ditto.
|
||
%LTSAO==4 ; Ditto.
|
||
|
||
; The right thing is done when various fields are left zero, e.g. saying
|
||
; MAKELN A,[A$RHST,,0 is legal and produces a VAL-type LN with attribute of
|
||
; %LTVAL,,0] A$RHST. Its CDR is 0 and its value is 0, because
|
||
; neither arg is accessible.
|
||
|
||
UUODEF MAKELN,UMAKEL
|
||
|
||
UMAKEL: MOVE U4,U40
|
||
IFSVU2, PUSH P,U2
|
||
MOVE U3,(U4) ; Get lh,,[loc-of-cdr-ptr]
|
||
MOVE U4,1(U4) ; Get type,,[loc-of-val]
|
||
TRNE U3,-1 ; Keep cdr nil if already is
|
||
HRR U3,@(U3) ; else get cdr ptr.
|
||
TRNN U4,-1 ;ditto for loc-of-val
|
||
SKIPA U2,[0] ;substitute 0 if no address.
|
||
MOVE U2,@(U4) ;else get val.
|
||
TLNN U4,%LTSTR+%LTBPT+%LTSAR+%LTSAO ;skip if type is string
|
||
JRST USTOQ7 ;isn't string. store value/list
|
||
|
||
TLZ U3,%LTMSK ;clear all type bits
|
||
TLO U3,%LTSTR ;force type to string
|
||
EXCH U3,U4 ;save 1st wd in u4
|
||
TLNE U3,%LTSAO ;type store accumulated SA output?
|
||
JRST USTOQ3
|
||
TLNE U3,%LTBPT ;is type=byte ptr to string?
|
||
JRST [ MOVE U3,(U2)
|
||
JRST USTOQ5] ;yes, get the byte ptr
|
||
TLNE U3,%LTSAR ;type = string area?
|
||
JRST [ MOVE U3,$ARLOC(U2) ;U2 has ARPT. Get abs location of area
|
||
HRLI U3,440700
|
||
PUSH P,U1
|
||
MOVE U1,$ARWPT(U2) ; Get write ptr,
|
||
SUBI U1,(U3) ; Make it relative to beg,
|
||
MULI U1,5 ; and do bp hack
|
||
ADD U2,UADBP7(U1) ; to get char count in U2.
|
||
POP P,U1
|
||
JRST USTOQ6]
|
||
HRRZ U3,U2 ;no, just form a 440700,,addr
|
||
HRLI U3,440700
|
||
USTOQ5: HLRZ U2,U2 ;count in rh
|
||
USTOQ6: MOVEM U3,OUT"UBMPSP ;kludgery necessary to ensure ptr correct
|
||
PUSHJ P,LNPOP ;even if LNPOP bumps areas. get ptr in U1 to free LN.
|
||
HRLZ U3,U2 ;form SPT beforehand... get count
|
||
HRR U3,$LSFRE(L) ;and rel addr.
|
||
PUSH P,U3 ;and save SPT.
|
||
MOVE U3,OUT"UBMPSP ;restore source BP.
|
||
PUSHJ P,USSTRG ;do it
|
||
POP P,LISTAR(U1)+1 ;Done, now store SPT computed previously,
|
||
MOVEM U4,LISTAR(U1) ;and finally 1st wd of LN.
|
||
JRST USTOQ9 ;last thing to do: return LP in AC.
|
||
|
||
USTOQ7: HLLZ U4,U4 ;get type,,0
|
||
IOR U3,U4 ;put type flag into 1st LN lh
|
||
PUSHJ P,LNPOP ;if not, get one.
|
||
MOVEM U3,LISTAR(U1) ;store 1st LN wd
|
||
MOVEM U2,LISTAR(U1)+1 ;store 2nd
|
||
USTOQ9: LDB U2,UACFLD ;get # acc (again)
|
||
MOVEM U1,(U2) ;return ptr in it.
|
||
IFSVU2, POP P,U2
|
||
UUOXRT
|
||
|
||
; Make SLN of stuff between $LSFRE addr and $LSWPT write pointer.
|
||
; (i.e. it's already been output there)
|
||
; U4 contains word to store in 1st wd of LN, otherwise everything
|
||
; clobberable.
|
||
USTOQ3:
|
||
IFN $$OUT,[
|
||
JUMPE U2,USTOQ4 ; If no value given, assume closing-up.
|
||
|
||
; Special hack! Value given for %LTSAO is instruction to XCT.
|
||
; It should output on the standard output channel...
|
||
; Could reference SAOCH if necessary, but should be avoided.
|
||
IFE $$UCAL,PUSH P,UUORPC
|
||
PUSHAE P,[U40,OC,U4,U2] ; Note U2 last!! Don't need U1,U3.
|
||
OUT(,CH(SAOCH),OPEN(UC$SAO)) ; Open SAOCH, make std output.
|
||
XCT (P) ; Execute the frob! Might be UUO.
|
||
POPAE P,[U2,U4,OC,U40]
|
||
IFE $$UCAL,POP P,UUORPC
|
||
; Then drop through to finalize!
|
||
USTOQ4:
|
||
]
|
||
MOVE U1,$LSWPT(L) ; Get write ptr
|
||
SUB U1,$LSLOC(L) ; Make rel to start of SA
|
||
MOVE U3,$LSFRE(L) ; Get rel addr of start of free stuff,
|
||
SUBI U1,(U3) ; and BP rel to this.
|
||
MULI U1,5 ; Now do BP hack
|
||
ADD U2,UADBP7(U1) ; to get # chars used.
|
||
HRL U2,U3 ; Now use it to make reversed SPT
|
||
PUSHJ P,LNPOP ; Get a free LN,
|
||
MOVEM U4,LISTAR(U1) ; and store 1st and
|
||
MOVSM U2,LISTAR(U1)+1 ; 2nd words in it. (Note halves swapped!)
|
||
|
||
MOVEI U2,4(U2) ; Now get # chars + 4
|
||
IDIVI U2,5 ; Find # wds used,
|
||
ADDB U2,$LSFRE(L) ; and bump addr of first free loc.
|
||
SUB U2,$LSLEN(L) ; Make sure we didn't overrun anything -
|
||
CAILE U2,0 ; (note this gives neg of # wds free)
|
||
JSR AUTPSY ; First free greater than length means illegal loc writ!
|
||
IMULI U2,5
|
||
MOVEM U2,$LSCHL(L) ;store new -cnt of chars left.
|
||
JRST USTOQ9 ;done
|
||
|
||
|
||
; USSTRG - auxiliary rtn for MAKELN. given
|
||
;LN ptr in U1, chr cnt in U2, byte ptr in U3, does the actual
|
||
;write of string into SA. Clobbers U2, U3.
|
||
|
||
USSTRG: JUMPE U2,APOPJ
|
||
PUSHAE P,[U1,U4]
|
||
MOVEM U3,OUT"UBMPSP ;store BP in convenient place for auto-adjust.
|
||
MOVE U4,U2 ;and store cnt in AC out of way.
|
||
ADDI U2,4
|
||
IDIVI U2,5 ;find # words string will need.
|
||
PUSH P,U2 ;save
|
||
ADD U2,$LSFRE(L) ;add current relative write addr.
|
||
SUB U2,$LSLEN(L) ;check bounds by subtracting area length.
|
||
JUMPGE U2,[MOVEM U2,ARUNIT ;oops! need more core! Indicate this much.
|
||
MOVEI U1,$LSAR(L) ;and give ARPT to string area.
|
||
PUSHJ P,UABUMP ;get um.
|
||
JRST .+1]
|
||
MOVE U3,OUT"UBMPSP ;restore (possibly bumped) BP.
|
||
MOVE U2,$LSFRE(L)
|
||
ADD U2,$LSLOC(L) ;get abs ptr to start.
|
||
HRLI U2,440700 ;make BP.
|
||
ILDB U1,U3 ;get char
|
||
IDPB U1,U2 ;dep.
|
||
SOJG U4,.-2 ;fast.
|
||
|
||
POP P,U2 ;get back # wds newly occupied.
|
||
ADDM U2,$LSFRE(L) ;and cnt of wds used.
|
||
POPAE P,[U4,U1] ;return
|
||
POPJ P,
|
||
|
||
|
||
; SAOBEG CH, - Initializes for standard UUO output into SA area,
|
||
; given channel # output will occur on. The %LTSAO type
|
||
; bit in MAKELN will form a string LN of accumulated output.
|
||
; Sets OC to CH as current channel.
|
||
|
||
UUODFA SAOBEG,USABG
|
||
USABG: MOVE U1,$LSFRE(L)
|
||
ADD U1,$LSLOC(L) ;get abs start addr
|
||
HRLI U1,440700 ;form BP
|
||
MOVEM U1,$LSWPT(L) ;and set up new write ptr for area.
|
||
HRRZS U1
|
||
SUB U1,$LSTOP(L) ;get -<# wds left>
|
||
IMULI U1,5
|
||
MOVEM U1,$LSCHL(L) ;store as $ARCHL for SA.
|
||
;; LDB U2,UACFLD ;now ready to open indicated channel. Get it.
|
||
;; MOVE U1,[OUTOPN [$UCUAR,,$LSAR(L)]] ;get instr with right args.
|
||
;; DPB U2,[$ACFLD,,U1]
|
||
;;IFE $$UCAL,PUSH P,UUORPC ; Save return addr, since using UUO within UUO!
|
||
;; XCT U1 ; Do the OUTOPN!
|
||
;;IFE $$UCAL,POP P,UUORPC
|
||
LDB U1,UACFLD ; Get channel #
|
||
OUT(,CH((U1)),OPEN(UC$UAR,$LSAR(L))) ; Open channel into area
|
||
UUOXRT ; Return
|
||
|
||
SUBTTL List Searching UUO's - FINDA and FINDAL
|
||
|
||
; FINDA AC,[<attrib type>,,[[list-ptr]]]
|
||
; Searches list pointed to by list-ptr for a LN containing the
|
||
; given attribute type, and if one is found immediately skips with ptr
|
||
; to it in AC. Else doesn't skip and AC is meaningless.
|
||
; FINDA AC,[%HSIGN <attrib type>,,[[list-ptr]]
|
||
; [<ASCNT string ptr>]]
|
||
; As a special case, this form will search for the attribute type
|
||
; which has a string-value matching (exactly) the given string. LN's
|
||
; which have the right attrib type but wrong data type (non-string)
|
||
; will obviously not match.
|
||
|
||
UUODEF FINDA:,UFINDA
|
||
|
||
UFINDA: SKIPGE U3,@U40 ; Get c(e)= $attr,,[loc]
|
||
JRST UFNDA3 ; If sign bit set, hack special string-search.
|
||
HRRZ U1,@(U3) ; Get c(loc)=ptr to first node
|
||
CAML U1,$LLLEN(L) ; Check validity
|
||
JSR AUTPSY
|
||
HLRZ U3,U3 ; Put attrib in rh
|
||
JUMPE U1,UUORTL ; Now enter loop, unless first pointer zero!
|
||
IFSVU2, PUSH P,U2
|
||
UFNDA0: LDB U2,[$LAFLD,,LISTAR(U1)] ; Get attrib of LN pointed to
|
||
CAIN U2,(U3) ; Equal to one we want?
|
||
JRST UFNDA9 ; Yes, jump out.
|
||
UFNDA1: HRRZ U1,LISTAR(U1) ; No, get CDR and continue,
|
||
JUMPN U1,UFNDA0 ; as long as list still exists.
|
||
IFSVU2, POP P,U2
|
||
UUOXRT ; Sigh, never found.
|
||
|
||
|
||
; Sign bit is set, search for attrib with matching string.
|
||
UFNDA3: HRRZ U1,@(U3) ; Get c(Loc) = LP to first node
|
||
JUMPE U1,UUORTL ; Stop right here if first pointer zero...
|
||
HLRZS U3 ; Get attrib type into RH
|
||
TRZ U3,%HSIGN ; Ensuring that the sign bit is cleared!
|
||
MOVE U4,U40
|
||
IFSVU2, PUSH P,U2
|
||
PUSH P,@1(U4) ; Get ASCNT ptr to string, onto stack.
|
||
UFNDA4: LDB U2,[$LAFLD,,LISTAR(U1)] ;get attrib of LN pointed to
|
||
CAIN U2,(U3) ; equal to one we want?
|
||
JRST UFNDA6 ; Yes, jump out.
|
||
UFNDA5: HRRZ U1,LISTAR(U1) ; No, get CDR and continue,
|
||
JUMPN U1,UFNDA4 ; as long as list still exists.
|
||
SUB P,[1,,1]
|
||
IFSVU2, POP P,U2
|
||
UUOXRT ; Sigh, never found.
|
||
|
||
; Found right attrib, now see if string matches...
|
||
UFNDA6: MOVE U2,LISTAR(U1) ; Get word for testing...
|
||
TLNN U2,%LTSTR ; Skip if string,
|
||
JRST UFNDA5 ; else obviously not a match.
|
||
HLRZ U2,LISTAR(U1)+1 ; Get cnt of SPT for attrib name.
|
||
HLRZ U4,(P) ; and cnt for string being sought.
|
||
CAME U2,U4 ; String lengths equal?
|
||
JRST UFNDA5 ; Nope, keep looking.
|
||
|
||
MOVE U2,LISTAR(U1)+1 ; Aha, counts equal, test contents. Get whole SPT
|
||
ADD U2,$LSLOC(L) ; Make absolute
|
||
MOVE U4,(P) ; Get whole ascnt ptr for test string.
|
||
PUSH P,U3
|
||
UFNDA7: JUMPL U4,UFNDA8 ; See if any left to test.
|
||
TLNN U4,-1 ; Check both neg. and 0
|
||
JRST UFNDA8 ; and jump if all done...
|
||
MOVE U3,(U2) ; get a word to test
|
||
CAME U3,(U4) ; Match against template string.
|
||
JRST [ POP P,U3 ; No match.
|
||
JRST UFNDA5]
|
||
ADD U4,[-5,,1] ; Else bump down char cnt and increment index.
|
||
AOJA U2,UFNDA7 ; and get another word.
|
||
|
||
; Aha, found right attrib with matching string!
|
||
UFNDA8: SUB P,[2,,2] ; Flush both saved U3 and ASCNT template.
|
||
|
||
; Found attrib.
|
||
UFNDA9: LDB U2,UACFLD ; Get result acc
|
||
MOVEM U1,(U2) ; Store ptr.
|
||
IFSVU2, POP P,U2
|
||
AOS UUORPC ; Skip on return
|
||
UUOXRT
|
||
|
||
|
||
DEFINE FNDSTR AC,PTRLOC,ATTRIB,STRING
|
||
FINDA AC,[%HSIGN+ATTRIB,,[PTRLOC]
|
||
LITSTR [STRING]]
|
||
TERMIN
|
||
|
||
IFN 0,[
|
||
; FINDAL AC,[<attrib type>,,[[list-ptr]]]
|
||
; Like FINDA above, but searches through the entire tree pointed to.
|
||
|
||
UUODEF FINDAL,UFNDAL
|
||
|
||
UFNDAL: MOVE U4,@U40 ;get c(e)= $attr,,[loc]
|
||
HRRZ U1,@(U4) ;get c(loc)=ptr to first node
|
||
HLRZ U4,U4 ;put attrib in rh
|
||
|
||
;ptr in u1, attrib searched for in u4.
|
||
SETZM UFNRT' ;clear loc where result stored
|
||
PUSHJ P,UFND ;get um recursively.
|
||
SKIPG U1,UFNRT ;get result into u1 if found
|
||
UUOXRT ;no. blah.
|
||
LDB U2,UACFLD ;aha! must store
|
||
MOVEM U1,(U2) ;in uuo acc
|
||
AOS UUORPC ;and skip
|
||
UUOXRT
|
||
|
||
UFND: TRNN U1,-1 ;skip unless rh=0
|
||
POPJ P,
|
||
MOVE U3,LISTAR(U1)
|
||
LDB U2,[$LAFLD,,U3] ;get attrib of LN pointed to
|
||
CAIN U2,(U4) ;equal to one we want?
|
||
JRST [ HRRZM U1,UFNRT
|
||
POPJ P,] ;if so, store tr and return
|
||
TLNN U3,%LTLST ;still hope if list
|
||
JRST [ HRRZ U1,U3
|
||
JRST UFND] ;nope
|
||
PUSH P,U3
|
||
HRRZ U1,LISTAR(U1)+1 ;get ptr to list
|
||
PUSHJ P,UFND
|
||
POP P,U3
|
||
SKIPLE UFNRT ;skip unless found something
|
||
POPJ P, ;if found, return
|
||
HRRZ U1,U3 ;nope, try cdr.
|
||
JRST UFND
|
||
]
|
||
|
||
SUBTTL Randomness - LNAPP, OUTLS, NREVERSE
|
||
|
||
; LNAPP [[list-lp A] ? [list-lp-B]]
|
||
; Appends the list B points to onto the end of the list A points to.
|
||
; Simply stuffs list-lp-B in as the CDR of the last item in list A.
|
||
|
||
UUODFE LNAPP:,UAPND
|
||
|
||
UAPND: MOVE U4,U40 ; Get addr of 2-wd arg block
|
||
HRRZ U3,@(U4) ; Get LP to base list (appended to)
|
||
HRRZ U1,@1(U4) ; Get LP to list being appended.
|
||
CAMGE U1,$LLLEN(L) ; Check both
|
||
CAML U3,$LLLEN(L)
|
||
JSR AUTPSY
|
||
JUMPE U3,[HRRM U1,@(U4) ; If nil base list, store LP B in place
|
||
UUOXRT] ; LP A would occupy.
|
||
UAPND1: MOVEI U4,(U3) ; Loop to find end of list A.
|
||
HRRZ U3,LISTAR(U4)
|
||
JUMPN U3,UAPND1
|
||
HRRM U1,LISTAR(U4) ; Found end, smash CDR to point at list B.
|
||
UUOXRT
|
||
|
||
; NREVERSE LP, Reverses the LNs in the list by bashing the CDR
|
||
; pointers, and returns the LP to the thus reversed
|
||
; list in AC. Analogous to the LISP function, of course.
|
||
|
||
UUODFA NREVERSE:,UNREV
|
||
UNREV:
|
||
IFSVU2, LDB U1,UACFLD ? SKIPN U1,(U1) ; Get our argument, an LP.
|
||
.ELSE LDB U2,UACFLD ? SKIPN U1,(U2)
|
||
UUOXRT ; If nothing there, just ignore.
|
||
HRRZ U3,LISTAR(U1) ; Initialize the loop
|
||
HLLZS LISTAR(U1) ; Special case: zero out this CDR.
|
||
UNREV1: HRRZ U4,LISTAR(U3) ; Loop, in which U1 is an LP to a
|
||
HRRM U1,LISTAR(U3) ; LN in the list, and U3 an LP
|
||
MOVE U1,U3 ; to the immediately next node.
|
||
SKIPE U3,U4 ; If that was zero, all done.
|
||
JRST UNREV1
|
||
IFSVU2, LDB U3,UACFLD ? MOVEM U1,(U3)
|
||
.ELSE MOVEM U1,(U2) ; Store back result in the AC.
|
||
UUOXRT
|
||
|
||
SUBTTL Free-list Manipulation Primitives - LNPOP and friends.
|
||
|
||
; LNPOP - called when want a free LN from list area.
|
||
;Returns ptr in U1 to a free LN.
|
||
|
||
LNPOP: SKIPG U1,$LLFRL(L) ; Get LP to a free LN.
|
||
JRST LNPOP2 ; none there? Must get new freelist.
|
||
SOSGE $LLFRC(L) ; Got one, bump count down...
|
||
JSR AUTPSY ; and fulfill its sole purpose in life.
|
||
MOVE U1,LISTAR(U1) ; Won. Get CDR to next free LN
|
||
EXCH U1,$LLFRL(L) ; and make it new freelist ptr.
|
||
RET ; Return previous ptr to free LN.
|
||
|
||
; Freelist ptr is nil, must create more free LN's.
|
||
LNPOP2: SKIPE $LLFRC(L) ; Consistency check...
|
||
JSR AUTPSY ; count should have zeroed out!!
|
||
|
||
MOVE U1,$LLFRE(L) ; Get # wds actually used in LA area.
|
||
SUB U1,$LLLEN(L) ; Subtract total length, to get -# wds avail.
|
||
ADDI U1,100*$LNSIZ ; Gobble at least 100 new ones at a time.
|
||
CAIG U1,0 ; If need to get more core, skip.
|
||
JRST LNPOP3 ; Else needn't expand, just use extra room.
|
||
MOVEM U1,ARUNIT
|
||
MOVEI U1,$LLAR(L) ; Set up ARPT for UABUMP.
|
||
PUSHJ P,UABUMP ; Expand LA.
|
||
LNPOP3: SETZM $LLFRL(L) ; Make SURE current freelist is nil.
|
||
PUSHJ P,LNINIT ; Now munch extra core onto freelist!
|
||
SKIPN $LLFRL(L) ; Make sure something now on freelist.
|
||
JSR AUTPSY ; Ugh??
|
||
CALRET LNPOP ; Now go back and get a LN.
|
||
|
||
|
||
; LNINIT - looks at "extra" core between $LLFRE and actual end of LA area,
|
||
; and makes freelist LN's out of it. Updates $LLFRE, $LLFRL, and $LLFRC.
|
||
|
||
LNINIT: PUSHAE P,[U1,U2,U3]
|
||
MOVE U1,$LLLEN(L) ; Get total # wds in area,
|
||
MOVE U3,$LLFRE(L) ; and rel addr of 1st free wd in area.
|
||
SUB U1,U3 ; Find # wds extra by subtracting # used.
|
||
IDIVI U1,$LNSIZ ; Get # LN's possible within this space.
|
||
JUMPE U1,LNINI9 ; If can't snarf any, quit immediately.
|
||
ADDM U1,$LLFRC(L) ; Can make some! Update count now.
|
||
|
||
MOVNS U1
|
||
HRLZS U1 ; Make AOBJN of
|
||
HRRI U1,(U3) ; -<# LN's to make>,,<LP to first>
|
||
LNINI1: MOVEI U2,$LNSIZ(U1) ; Get ptr to next LN
|
||
MOVEM U2,LISTAR(U1) ; Insert ptr in current LN
|
||
ADDI U1,$LNSIZ-1 ; Bump ptr
|
||
AOBJN U1,LNINI1
|
||
|
||
HRRZM U1,$LLFRE(L) ; First unused LP => first unused addr.
|
||
SUBI U1,$LNSIZ ; Point to last LN
|
||
MOVE U2,$LLFRL(L) ; Get current freelist ptr
|
||
HRRZM U2,LISTAR(U1) ; Store its ptr in last LN of new list.
|
||
MOVEM U3,$LLFRL(L) ; And set freelist ptr to 1st new LN.
|
||
LNINI9: POPAE P,[U3,U2,U1]
|
||
POPJ P,
|
||
|
||
SUBTTL More Freelist manipulators - LNDEL UUO, LNFREE
|
||
|
||
; LNDEL AC,[<lp>]
|
||
; There are 3 cases depending on presence or absence of AC and E.
|
||
; When either is present, their contents must be LP's; the general
|
||
; semantics are that AC indicates a single LN for the flushing
|
||
; operation, whereas c(E) indicates a list.
|
||
;
|
||
; (0) LNDEL - Error.
|
||
; (1) LNDEL AC, - The indicated LN only is flushed (not its CDR).
|
||
; (2) LNDEL [<lp>] - As above, but CDR is flushed also, hence
|
||
; this is "list-flush".
|
||
; (3) LNDEL AC,[<lp>] - Only LN indicated by AC is flushed from list
|
||
; indicated by c(E). It is a fatal error if
|
||
; the LN is not in fact found on the list!
|
||
;
|
||
; Whenever E is specified, the LP to resulting list is stored back in
|
||
; c(E). Since for case 3 the LP pointing to deleted LN is changed to
|
||
; point to the next LN, c(E) will be modified if c(E)=c(AC).
|
||
; Case 2 will clear c(E).
|
||
|
||
|
||
UUODEF LNDEL:,ULNDEL
|
||
ULNDEL: MOVE U3,U40 ; Get instruction
|
||
IFSVU2, PUSH P,U2
|
||
LDB U2,[$ACFLD,,U3] ; Get AC #
|
||
JUMPE U2,[TRNN U3,-1 ; If no AC, make sure E exists.
|
||
JSR AUTPSY ; It doesn't??
|
||
HRRZ U1,(U3) ; It does, get LP to start of list,
|
||
HLLZS (U3) ; zap RH of c(E) before actually flushing, and
|
||
PUSHJ P,LNFREE ; Flush it,
|
||
IFSVU2, POP P,U2
|
||
UUOXRT] ; and return.
|
||
HRRZ U1,(U2) ; Get c(AC)
|
||
TRNN U3,-1 ; Is E = 0?
|
||
JRST ULNDL8 ; If so, go flush only this LN.
|
||
MOVE U2,(U3) ; No, get c(E) = LP to first node of list LN is on.
|
||
CAIN U1,(U2) ; Special first test... LPs same?
|
||
JRST [ MOVE U2,LISTAR(U2) ; Yes! replace c(E) by CDR of doomed LN.
|
||
HRRM U2,(U3) ; Like so.
|
||
JRST ULNDL8] ; And go flush doomed LN.
|
||
ULNDL4: MOVE U3,U2 ; Search list. Save LP to previous LN.
|
||
MOVE U2,LISTAR(U3) ; Get LP to next LN.
|
||
TRNN U2,-1 ; If it's 0,
|
||
JSR AUTPSY ; then the LN wasn't on the list!! Lose.
|
||
CAIE U1,(U2) ; This it?
|
||
JRST ULNDL4 ; No, continue search.
|
||
|
||
MOVE U2,LISTAR(U2) ; Aha, found it! Get CDR of doomed LN,
|
||
HRRM U2,LISTAR(U3) ; and put it in previous LN.
|
||
ULNDL8: HLLZS LISTAR(U1) ; Now kill LN's CDR to isolate it.
|
||
PUSHJ P,LNFREE ; And delete it.
|
||
IFSVU2, POP P,U2
|
||
UUOXRT
|
||
|
||
|
||
; LNFREE - hairy routine to track down everything pointed to by
|
||
; a LN and flush it into freelist.
|
||
; Takes ptr in U1 to first node; LH must be zero!
|
||
; Clobbers U1, U2, U3.
|
||
|
||
LNFREE: JUMPE U1,[POPJ P,] ; Do nothing if LP = 0.
|
||
LNFRE1: CAML U1,$LLLEN(L) ; Safety check to make sure LP within bounds.
|
||
JSR AUTPSY
|
||
MOVE U2,LISTAR(U1) ; Get 1st wd of LN (CDR in RH)
|
||
TLNN U2,%LTLST ; Is data a list?
|
||
JRST LNFRE5 ; No, continue
|
||
|
||
; Flush list
|
||
PUSH P,U1
|
||
HRRZ U1,LISTAR(U1)+1 ; Put list ptr in as arg
|
||
PUSHJ P,LNFREE ; to a recursion!
|
||
POP P,U1
|
||
JRST LNFRE8 ; Now go flush node like a value.
|
||
|
||
LNFRE5: TLNN U2,%LTSTR ; Data a string?
|
||
JRST LNFRE8 ; No, must be Value.
|
||
|
||
; String...bleah
|
||
HLRZ U2,LISTAR(U1)+1 ; Get char cnt
|
||
ADDI U2,4
|
||
IDIVI U2,5 ; Get # wds being flushed.
|
||
ADDM U2,$LSGC(L) ; Add to # wds garbage in string area.
|
||
|
||
; Value. flush current LN and go after its CDR
|
||
LNFRE8: MOVE U2,$LLFRL(L) ; Get freelist ptr
|
||
EXCH U2,LISTAR(U1) ; Cons LN on freelist by making CDR = old list
|
||
HRRZM U1,$LLFRL(L) ; and pointing freelist at freed LN.
|
||
AOS $LLFRC(L) ; Increment cnt of # free for checking.
|
||
SETZM LISTAR(U1)+1 ; Zap data wd just for neatness.
|
||
TRNN U2,-1 ; Now see if anything in old CDR...
|
||
POPJ P, ; Nope, can return!
|
||
MOVEI U1,(U2) ; Else must put into U1
|
||
JRST LNFRE1 ; and go flush it.
|
||
|
||
SUBTTL LSEGC - LSE garbage collection (compactor)
|
||
|
||
; There are several possible screws one can hit while trying to
|
||
; GC a LSE. At the moment, this code assumes that there is
|
||
; only one well-ordered list in the LSE, which $LLLST points to,
|
||
; and that there are no "pure strings".
|
||
; "Well-ordered" means no circular lists and only one pointer
|
||
; to any single LN.
|
||
; One feature is that the entire HDR is copied except for those
|
||
; parameters which are address dependent. This preserves any
|
||
; idiosyncratic HDR info.
|
||
|
||
; L - Specifies LSE to compact.
|
||
; On return, L will address new LSE. The ARBLK which LSE is based in
|
||
; will likewise be updated.
|
||
|
||
LSGEC: PUSHAE P,[A,B,C]
|
||
SKIPE C,$LHARP(L) ; Get ARPT pointing at this LSE.
|
||
SKIPN $AROPN(C) ; Who knows? Just in case.
|
||
JSR AUTPSY
|
||
MOVEI A,LGCAR
|
||
CALL LSEOPN ; Create a minimal LSE.
|
||
|
||
; Now copy extra HDR words over...
|
||
MOVE B,$ARLEN(C) ; Find length of source HDR
|
||
SUBI B,$LHSIZ ; Find how many extra wds
|
||
CAIGE B,
|
||
JSR AUTPSY ; Must not be less!
|
||
JUMPG B,[UAREXP B,LGCAR ; Expand by additional # of wds.
|
||
HRLZ A,$ARLOC(C)
|
||
HRR A,$ARLOC+LGCAR ; Get <source HDR>,,<dest HDR>
|
||
ADD A,[$LHSIZ,,$LHSIZ]
|
||
ADDI B,(A) ; Get last addr+1
|
||
BLT A,-1(B) ; Move the extra stuff.
|
||
JRST .+1]
|
||
|
||
; Now simply copy the whole thing...
|
||
MOVE B,L ; Save LSE pointer
|
||
MOVE L,$ARLOC+LGCAR ; and make new LSE current.
|
||
LNCOPY B,[B ? SETZ $LLLST(L)] ; Copy whole list!
|
||
MOVEM B,$LLLST(L) ; Store LP as pointer to whole list in new LSE.
|
||
|
||
; Now move new LSE HDR ARBLK stuff into old ARBLK.
|
||
UARPUSH LGCAR ; Push LSE on stack
|
||
UARPOP (C) ; Pop back to final location, closing old LSE!
|
||
|
||
POPAE P,[C,B,A]
|
||
RET
|
||
|
||
LVAR LGCAR: BLOCK $ARSIZ
|
||
|
||
SUBTTL LSEOPN, LSEIN, LSEOUT - Initialization and I/O rtns for LSE's.
|
||
|
||
; LSEOPX - Create a fresh LSE
|
||
; A - ARPT to use for HDR area. MOVE L,$ARLOC(A) will make LSE current.
|
||
; B - address of a 3-wd block, specifying initial sizes for LSE.
|
||
; B -> [size for HDR] ? [size for LA] ? [size for SA]
|
||
; Addrs can be any ACs except A or B.
|
||
; LSEOPN - As above, but B is defaulted to minimums.
|
||
|
||
.SCALAR LSESZS(3) ; Temps for area sizes
|
||
LSESZD: $LHSIZ ? 100 ? 100 ; Default sizes.
|
||
|
||
LSEOPN: PUSH P,B
|
||
SETZ B,
|
||
CALL LSEOPX
|
||
PJRST POPBJ
|
||
|
||
LSEOPX: PUSHAE P,[L,A] ; ARPT is (P)
|
||
CAIN B,
|
||
MOVEI B,[0 ? 0 ? 0] ; Use defaults.
|
||
PUSH P,B
|
||
MOVSI A,-3
|
||
LSEOP3: SKIPE B,(B) ; Get addr of HDR size
|
||
MOVE B,@B ; Get size for HDR
|
||
CAMGE B,LSESZD(A)
|
||
MOVE B,LSESZD(A) ; Force above minimal value.
|
||
MOVEM B,LSESZS(A)
|
||
AOS B,(P)
|
||
AOBJN A,LSEOP3
|
||
POP P,B
|
||
MOVE A,(P)
|
||
|
||
UAROPN [%ARTLH,,(A) ; Open HDR area, using ARPT in A.
|
||
LSESZS+0] ; Flag indicates HDR.
|
||
MOVE L,$ARLOC(A) ; Set up address.
|
||
HRRZM A,$LHARP(L) ; Now store HDR's ARPT in HDR itself!
|
||
MOVE A,L
|
||
HRLI A,UHDRDF ; Set up BLT ptr from initial HDR block
|
||
BLT A,(L)$LHEND-1 ; to created one, and zap things up!
|
||
|
||
; Initialize LA.
|
||
UAROPN [%ARTLA,,$LLAR(L) ; ARPT is in HDR... flag says LA-type,
|
||
LSESZS+1] ; causing initialization of LA address table.
|
||
|
||
; OK, can now access LA!
|
||
MOVSI A,-$LNSIZ
|
||
SETZM LISTAR(A) ; Set first LN to 0.
|
||
AOBJN A,.-1
|
||
MOVEI A,$LNSIZ
|
||
MOVEM A,$LLFRE(L) ; Indicate first LN is "used".
|
||
PUSHJ P,LNINIT ; Init freelist starting right after zero'd LN.
|
||
|
||
; Now initialize SA.
|
||
UAROPN [%ARTZM+%ARTCH,,$LSAR(L) ; Open SA, ARBLK is in HDR too.
|
||
LSESZS+2]
|
||
|
||
POPAE P,[A,L]
|
||
POPJ P, ; All done!
|
||
|
||
|
||
; Disk-Block (DB) index definitions
|
||
BVAR
|
||
ULSDBH: OFFSET -. ; Buffer for reading in disk-block header.
|
||
DB$LEN::0 ; DB length
|
||
DB$ID:: 0 ; DB identifier (SIXBIT)
|
||
DB$VER::0 ; DB flags,,version
|
||
DB$HLC::0 ; Loc of HDR relative to start of DB (DB$LEN)
|
||
DB$HDR::0 ; # wds in HDR block
|
||
DB$LA:: 0 ; # wds in LA block
|
||
DB$SA:: 0 ; # wds in SA block
|
||
DB$SIZ:: ; Size of a disk-block header.
|
||
OFFSET 0
|
||
EVAR
|
||
|
||
ULSEID: SIXBIT /LSEID0/ ; LSE ID word contents.
|
||
DB$V1==:1 ; Version 1 symbol.
|
||
|
||
; LSEIN - Routine taking ARPT in A, .ACCESS pointer in B on opened
|
||
; DKIC channel. Reads in a LSE from specified point in
|
||
; file, using given ARBLK for the HDR area. If B negative,
|
||
; reads from current point on DKIC.
|
||
; Skips unless IOC error or bad format.
|
||
|
||
LSEIN: PUSHAE P,[A,B,C,D,L]
|
||
JUMPL B,[SYSCAL RFPNTR,[CIMM DKIC ? CRET B] ; if B neg, find current ptr.
|
||
JSR AUTPSY
|
||
JRST LSEIN0]
|
||
.ACCESS DKIC,B ; If B specified, set ACCESS ptr to it.
|
||
LSEIN0: MOVEM B,ULSIPT ; Save initial .ACCESS ptr.
|
||
MOVE C,[-DB$SIZ,,ULSDBH]
|
||
XCTIOC [.IOT DKIC,C] ; Get disk header of DB into ULSDBH.
|
||
JRST LSEIN9 ; Jump if lost
|
||
MOVE D,ULSEID
|
||
CAMN D,ULSDBH+DB$ID ; Does DB have right identifier?
|
||
JRST LSEI20 ; Yes, go handle normal case.
|
||
JRST LSEIN9 ; No ID word, must be garbaged
|
||
IFN 0,[ ; No ID word. For now, assume old-style format.
|
||
MOVE D,ULSDBH+1 ; Get <# wds in HDR>,,<rel addr of HDR>
|
||
PUSH P,ULSDBH+2 ; Get <# wds in LA>
|
||
PUSH P,ULSDBH+3 ; Get <# wds in SA>
|
||
HRRZM D,ULSDBH+DB$HLC ; Store stuff in right places.
|
||
HLRZM D,ULSDBH+DB$HDR
|
||
POP P,ULSDBH+DB$SA
|
||
POP P,ULSDBH+DB$LA
|
||
SETZM ULSDBH+DB$VER ; Zero out version # and flags.
|
||
JRST LSEI22 ; Skip over version # check.
|
||
]; end IFN 0
|
||
|
||
; Do normal-style new format readin.
|
||
LSEI20: HRRZ D,ULSDBH+DB$VER ; Get version #
|
||
CAIE D,DB$V1 ; V1 is only thing we hack now.
|
||
JRST LSEIN9 ; Lost badly.
|
||
LSEI22: ADD B,ULSDBH+DB$HLC ; Find absolute disk addr of HDR block.
|
||
.ACCESS DKIC,B ; Point there.
|
||
MOVE C,ULSDBH+DB$HDR ; Get size of HDR block.
|
||
UAROPN [%ARTLH,,(A) ? C] ; Open HDR area with that size.
|
||
IMUL C,[-1,,0] ; Now set up block mode pointer...
|
||
HRR C,$ARLOC(A) ; Addr to snarf into.
|
||
XCTIOC [.IOT DKIC,C] ; Get HDR
|
||
JRST LSEIN9 ; Jump if lost.
|
||
MOVE L,$ARLOC(A) ; Get beg addr again, to set up L index
|
||
SKIPE ULSDBH+DB$VER ; Hacking old-format?
|
||
JRST LSEI30 ; No, can continue normally.
|
||
|
||
; Must convert old-fmt HDR to new. Just push everything that
|
||
; needs preserving, and pop back to right places. Note that
|
||
; push/pop lists are reversed relative to each other.
|
||
HLRZ C,53(L) ; Get cnt from old $LLFRL = <#>,,<LP>
|
||
HRRZ D,53(L) ; Get LP
|
||
PUSHAE P,[C,D,52(L),54(L),66(L),67(L)] ; Save old stuffs.
|
||
MOVEI D,$LHEND-70 ; Find # wds must expand by.
|
||
UAREXP D,(A) ; Expand the HDR area; may bump.
|
||
MOVE L,$ARLOC(A) ; Make sure L points to right place.
|
||
MOVE D,$ARTOP(A) ; Find addr of last wd + 1
|
||
HRROI C,-<1+$LHEND-70>(D) ; Set up a "PDL ptr" to last data wd.
|
||
SUBI D,$LHEND(L) ; Get # wds to move.
|
||
POP C,<$LHEND-70>(C) ; Move to end of HDR area,
|
||
SOJG D,.-1 ; until all non-assembled stuff gone.
|
||
POPAE P,[$LSGC(L),$LSFRE(L),$LLLST(L),$LLFRE(L),$LLFRL(L),$LLFRC(L)]
|
||
|
||
LSEI30: MOVEM A,$LHARP(L) ; and store ARPT within HDR.
|
||
SETZM $LLAR(L)+$AROPN ; Clear "OPEN" flags for LA and SA ARBLKs,
|
||
SETZM $LSAR(L)+$AROPN ; to avoid attempt by UAROPN to "close" them!
|
||
UAROPN [%ARTLA,,$LLAR(L) ; Open LA area (Note size).
|
||
ULSDBH+DB$LA] ; This inits all LA addressing info too.
|
||
MOVN C,ULSDBH+DB$LA
|
||
HRLZS C
|
||
HRR C,$LLLOC(L) ; Set up block mode ptr -<cnt>,,<loc>
|
||
XCTIOC [.IOT DKIC,C] ; (LA immediately follows HDR)
|
||
JRST LSEIN9 ; Jump if lost.
|
||
UAROPN [%ARTZM+%ARTCH,,$LSAR(L) ; Open SA area, as for LA.
|
||
ULSDBH+DB$SA]
|
||
MOVN C,ULSDBH+DB$SA
|
||
HRLZS C
|
||
HRR C,$LSLOC(L) ; And read in as for LA.
|
||
XCTIOC [.IOT DKIC,C] ; (SA immediately follows LA)
|
||
JRST LSEIN9 ; Jump if lost.
|
||
|
||
|
||
|
||
; Readin all done. Point .ACCESS ptr to immediately after DB.
|
||
LSEI85: MOVE B,ULSIPT ; Get back original dsk addr
|
||
ADD B,ULSDBH ; Add in tot # wds in block.
|
||
.ACCESS DKIC,B ; Set to right after it.
|
||
|
||
AOS -5(P) ; Won, skip return.
|
||
LSEIN9: POPAE P,[L,D,C,B,A]
|
||
POPJ P,
|
||
|
||
LVAR ULSIPT: 0 ; Initial .ACCESS ptr for LSEIN
|
||
LVAR ULSOPT: 0 ; Initial .ACCESS ptr for LSEOUT
|
||
|
||
|
||
; LSEOUT - Routine similar to LSEIN, A has ARPT to a LSE HDR,
|
||
; B has either an .ACCESS pointer or -1, meaning use current.
|
||
; Writes out LSE block on DKOC channel.
|
||
; Returns in A the original .ACCESS pntr, in B # words written.
|
||
|
||
LSEOUT: PUSHAE P,[C,L]
|
||
MOVE L,$ARLOC(A) ; Set up L
|
||
JUMPL B,[SYSCAL RFPNTR,[CIMM DKOC ? CRET B]
|
||
JSR AUTPSY
|
||
JRST .+2]
|
||
.ACCESS DKOC,B
|
||
MOVEM B,ULSOPT ; Save .ACCESS ptr
|
||
MOVEI C,DB$SIZ
|
||
MOVEM C,ULSDBH+DB$LEN ; Initialize cumulative total of # wds in blk.
|
||
MOVE C,$ARLEN(A) ; Find length of HDR area
|
||
MOVEM C,ULSDBH+DB$HDR ; Store, and
|
||
ADDM C,ULSDBH+DB$LEN ; add to cumulative sum.
|
||
MOVE C,$LLLEN(L) ; Find length of LA area
|
||
MOVEM C,ULSDBH+DB$LA ; ditto ditto
|
||
ADDM C,ULSDBH+DB$LEN
|
||
MOVE C,$LSLEN(L) ; Find length of SA
|
||
MOVEM C,ULSDBH+DB$SA
|
||
ADDM C,ULSDBH+DB$LEN ; Now finish cumulative total of # wds in blk!
|
||
|
||
MOVEI C,DB$SIZ ; Start HDR immediately after the DB header.
|
||
MOVEM C,ULSDBH+DB$HLC
|
||
MOVE C,ULSEID ; Set up ID word
|
||
MOVEM C,ULSDBH+DB$ID
|
||
MOVEI C,DB$V1 ; and version #
|
||
MOVEM C,ULSDBH+DB$VER
|
||
|
||
MOVE C,[-DB$SIZ,,ULSDBH]
|
||
.IOT DKOC,C ; Out goes the header!
|
||
|
||
; Now output HDR, LA, SA areas.
|
||
IRP LENX,,[DB$HDR,DB$LA,DB$SA]LOC,,[L,$LLLOC(L),$LSLOC(L)]
|
||
MOVN C,ULSDBH+LENX ; Get -length of area
|
||
HRLZS C ; Put in LH for ptr
|
||
HRR C,LOC ; Point to start of area
|
||
.IOT DKOC,C ; Out it goes!
|
||
TERMIN
|
||
|
||
MOVE A,ULSOPT ; Return original .ACCESS ptr
|
||
MOVE B,ULSDBH+DB$LEN ; And # wds written out.
|
||
POPAE P,[L,C]
|
||
POPJ P,
|
||
subttl LSE debugging aids
|
||
|
||
; Debugging aids for list stuff...
|
||
|
||
DEBEG: JSR DEBSAV
|
||
.VALUE [ASCIZ /: Ready /]
|
||
DEBEND: JSR DEBRST
|
||
.VALUE [ASCIZ /: Reset /]
|
||
|
||
LVAR DEBSAV: 0 ? JRST DEBSV0 ; jump to pure
|
||
LVAR DEBCHP: 0 ;-1 if channel already opened by user.
|
||
|
||
DEBSV0: PUSHAE P,[U40]
|
||
IFE $$UCAL,PUSH P,UUORPC
|
||
MOVEM 17,DEBACS+17
|
||
MOVEI 17,DEBACS
|
||
BLT 17,DEBACS+16 ; Save ACs
|
||
MOVE 17,DEBACS+17
|
||
SKIPN DEBCHP
|
||
JRST [ .OPEN DBC,[.UAO,,'TTY]
|
||
.VALUE
|
||
OUT(DBC,OPEN(UC$IOT))
|
||
JRST .+1 ]
|
||
JRST @DEBSAV
|
||
|
||
LVAR DEBRST: 0 ? JRST DEBRS0 ; jump to pure
|
||
|
||
DEBRS0: SKIPN DEBCHP
|
||
.CLOSE DBC,
|
||
MOVSI 17,DEBACS
|
||
BLT 17,17
|
||
IFE $$UCAL,POP P,UUORPC
|
||
POPAE P,[U40]
|
||
JRST @DEBRST
|
||
|
||
BVAR
|
||
DEBACS: BLOCK 20
|
||
DEBAR: BLOCK $ARSIZ ; Area block, in case debug rtns want to use an area.
|
||
EVAR
|
||
|
||
; DEBPRF - Print out a file (LSE-block).
|
||
; Argument, in DEBFIL, is the address of file block
|
||
LVAR DEBFIL: 0 ; Must have addr of FN1/FN2
|
||
DEBPRF: JSR DEBSAV
|
||
SKIPN A,DEBFIL
|
||
JRST DEBPLX ; If nothing, simply return.
|
||
.IOPUSH DKIC,
|
||
SYSCAL OPEN,[[.BII,,DKIC] ? (A) ? 1(A) ? 2(A) ? 3(A)]
|
||
JRST [ OUT(DBC,("Couldn't open "),6F((A)),SP,6F(1(A)))
|
||
JRST DEBPFX]
|
||
MOVEI A,DEBAR
|
||
SETZ B,
|
||
PUSHJ P,LSEIN ; Read in.
|
||
.VALUE
|
||
MOVE L,$ARLOC+DEBAR
|
||
MOVE A,$LLLST(L)
|
||
PUSHJ P,DEBPL ; Print out main list.
|
||
UARCLS DEBAR
|
||
DEBPFX: .IOPOP DKIC,
|
||
JSR DEBRST
|
||
POPJ P,
|
||
|
||
; DEBLSE - Print out a LSE. Uses current LSE as indicated by L.
|
||
; Outputs on DBC. DEBPRL same, but uses LP in DEBLP instead
|
||
; of $LLLST(L).
|
||
|
||
DEBLSE: SETOM DEBLP
|
||
DEBPRL: JSR DEBSAV
|
||
SETZM DEBLEV
|
||
SKIPGE A,DEBLP
|
||
MOVE A,$LLLST(L)
|
||
PUSHJ P,DEBPL
|
||
DEBPLX: JSR DEBRST ; $G here if DEBPRL loses during printout.
|
||
POPJ P,
|
||
|
||
LVAR DEBLP: 0 ; LP to list to print. If negative, uses $LLLST(L).
|
||
LVAR DEBLEV: 0 ; Level of recursion (indent)
|
||
|
||
DEBPL: OUT(,CH(DBC),O(A),TAB)
|
||
MOVE B,DEBLEV
|
||
SOJGE B,[OUT(,(" "))
|
||
JRST .]
|
||
MOVE C,LISTAR(A) ; Get 1st wd
|
||
OUT(,HV(C),SP)
|
||
TLNE C,%LTLST
|
||
OUTCAL(,("List "))
|
||
TLNE C,%LTVAL
|
||
OUTCAL(,("Val "))
|
||
TLNE C,%LTSTR
|
||
OUTCAL(,("Str "))
|
||
LDB B,[$LAFLD,,LISTAR(A)] ; Get attrib #
|
||
OUT(,O(B),SP,TC(ATTRTB(B)),EOL,TAB)
|
||
MOVE B,DEBLEV
|
||
SOJGE B,[OUT(,(" "))
|
||
JRST .]
|
||
TLNE C,%LTSTR
|
||
JRST [ OUT(,HV(LISTAR(A)+1),(| "|),TLS(A),C(""))
|
||
JRST DEBPL5]
|
||
TLNE C,%LTVAL
|
||
JRST [ OUT(,O(LISTAR(A)+1))
|
||
JRST DEBPL5]
|
||
OUT(,HV(LISTAR(A)+1))
|
||
|
||
DEBPL5: OUT(,EOL)
|
||
TLNN C,%LTLST
|
||
JRST DEBPL6 ;not a list...
|
||
PUSH P,A
|
||
AOS DEBLEV
|
||
HRRZ A,LISTAR(A)+1
|
||
PUSHJ P,DEBPL ; Print out its list.
|
||
SOS DEBLEV
|
||
POP P,A
|
||
|
||
DEBPL6: MOVE C,LISTAR(A)
|
||
TRNN C,-1
|
||
POPJ P,
|
||
OUT(,EOL) ; Do the CDR
|
||
HRRZ A,C
|
||
JRST DEBPL
|
||
|
||
|