ar1.tv
ÿÿÿÿÿ & Xòe2 ð @ pð , P 8 @ D I$I6& (` òe)ÝïP I$I6]
M` ` òe)ÞuP Y' I9"L ðU à5òe)ÝÕh ûâ§Ma( ñQ À1;5= i6îZ"H ñì à-òe)ÝÅP ý2§ja$E ó¯ à)D *` iL ý2§jaò; à%PHH iL iZvðF !òdVJ( iL iZ%}wðD <<h iZv" ð ,Ich ý6ü9* ðÄ àòe)ßP iZ%}w$ ð à<<Z8 iZMj:, ð; à
S^h iZex2& ð7 àGòe2h iZl@* ó
àòe)ÞMh i[< W" ó° ÀòdZ'×h H ! ð ½ ð ð Íð ð É vð
ð
Qð
kð ð y fð 'ð Éð !·ð
ð ð ð îð ð ð ð ! ð # ð % ð ' ð ) ð + ð - ð / ð 1 ð 3 ð 5 ð 7 ð 9 ð ; ð = ð ? ð A !ð C "ð E #ð G $ð I %ð K &ð M 'ð O (ð Q )ð S *ð U +ð W ,ð Y -ð [ .ð ] /ð _ 0ð a 1ð c 2ð e 3ð g 4ð i 5ð k 6ð m 7ð o 8ð q 9ð s :ð u ;ð w <ð y =ð { >ð } ?ð @ð Að Bð
Cð Dð Eð Fð Gð Hð Ið Jð Kð Lð Mð Nð Oð Pð ¡ Qð £ Rð ¥ Sð § Tð © Uð « Vð Wð ¯ Xð ± Yð ³ Zð µ [ð · \ð ¹ ]ð » ^ð ½ _ð ¿ `ð Á að Ã bð Å cð Ç ` Title TRIVIA Start Up Checker
.mllit==1
o=0
a=1
b=2
c=3
hhmmss=11
yymmdd=12
tim=13
now=14
err=15
unm=16
p=17
dskchn==1
ttychn==2
mudchn==1
savchn==2
; file containing total death message
%ddev: sixbit /dsk/
%dfn1: sixbit /trivia/
%dfn2: sixbit /death/
%dsnm: sixbit /_msgs_/
; file indicating curfew
%cdev: sixbit /dsk/
%cfn1: sixbit /trivia/
%cfn2: sixbit /curfew/
%csnm: sixbit /_msgs_/
; file indicating holiday
%hdev: sixbit /dsk/
%hfn1: sixbit /holidy/
%hsnm: sixbit /combat/
; file of last obnoxious request
%rdev: sixbit /dsk/
%rfn1: sixbit /badboy/
%rsnm: sixbit /vanish/
; save file
%sdev: sixbit /dsk/
%sfn1: sixbit /trv/
%sfn2: sixbit /savfil/
%ssnm: sixbit /madman/
; macro to open channels
define open dev,fn1,fn2,snm,erc=4,nxt=.+2,mod=6,chn=dskchn
.call [setz ? sixbit/open/ ? [mod,,chn] ? dev ? fn1 ? fn2 ? snm ? setzb err]
ifn erc,[
jrst [caie err,erc ? jrst gross ? jrst nxt]
]
ife erc,[
jrst gross
]
termin
; macros to expire gracefully
define fatal
jrst gross
termin
define die -messag
.value [asciz /:messag
:kill
/]
termin
; really starts here
start: movei p,[-20,,pdl-1] ; define peter dave lebling
open [[sixbit/tty/]]0,0,0,0,,3,ttychn
open %ddev,%dfn1,%dfn2,%dsnm,4,check1
pushj p,prinf
.break 16,40000
check1: .rdatim hhmmss, ; time
.suset [.rxunam,,unm] ; xuname
ldb a,[63600,,unm] ; first 5 character
came a,[sixbit / cheat/]
camn a,[sixbit / guest/] ; cretin
jrst whoru
camn a,[sixbit / luser/]
jrst whoru
open [[sixbit/dsk/]][[sixbit/.file./]][[sixbit/(dir)/]]unm,20,.+2,
jrst ok
open %cdev,%cfn1,%cfn2,%csnm
jrst curfew
.ryear a,
ldb a,[320300,,a] ; day of the week
jumpe a,ok ; sunday and sunday
cain a,6 ; are ok
jrst ok
open %hdev,%hfn1,yymmdd,%hsnm
jrst ok ; ok if holiday
ldb a,[301400,,hhmmss]
caige a,'22 ; ok if later than 11 pm
caige a,'09 ; or before 8 am
jrst ok
push p,[avhere] ; save dying code
skipa
curfew: push p,[busy]
open %rdev,%rfn1,unm,%rsnm,
jrst compar
newbad: open %rdev,%rfn1,unm,%rsnm,0,,7
jrst @(p)
compar: .call [setz ? sixbit /rfdate/ ? 1000,,dskchn ? setzm tim]
fatal
pushj p,haknow
.call [setz ? sixbit /sfdate/ ? 1000,,dskchn ? setz now]
fatal
tlz tim,600000
hlrz a,tim
hlrz b,now
came a,b
jrst @(p)
sub now,tim
caige now,20.*60.*2.
rude: .value [asciz /:You don't believe me eh? That makes me MAD!!!
:kill :logout
/]
jrst @(p)
whoru: die Please don't play as that, Try :CHUNAME to someone.
avhere: die Sorry, But You Can't Play during Office Hours (8am-11pm).
busy: die The System is VERY loaded, Please Try Again in 20 minutes.
gross: die Gross Bug, Please Notify the Maintainer.
; here if everything is all right
ok: hrri o,[asciz /
This is NEW TRIVIA.
Only use this TRIVIA if you plan on playing over a long period of time.
No warranty, expressed or implied.
/]
pushj p,princ
okok: open %sdev,%sfn1,%sfn2,%ssnm,0,,6,savchn
movsi b,sixbit / mud/
.iot 2,[-1,,o]
.acces 2,[0]
ldb a,[350700,,o]
subi a,40
dpb a,[140600,,b]
ldb a,[260700,,o]
subi a,40
dpb a,[060600,,b]
ldb a,[170700,,o]
subi a,40
dpb a,[000600,,b]
open [[sixbit/dsk/]][[sixbit/ts/]]b,[[sixbit/sys1/]]0,,4,mudchn
movsi p,stuff ; the following is classic
blt p,p
jrst a
stuff: 2
.call load
.value
.iot 1, a
.close mudchn,
addi a,1
jrst @a
load: setz
sixbit /load/
1000,,-1
setzi 1
pdl: block 20
; routine to get into now the current time in
; file creation date format
haknow: move o,[440600,,hhmmss]
pushj p,getnum
imuli a,60.*60.*2
push p,a
pushj p,getnum
imuli a,60.*2
addm a,(p)
pushj p,getnum
imuli a,2
addm a,(p)
pop p,now
pushj p,getnum
dpb a,[330700,,now]
pushj p,getnum
dpb a,[270400,,now]
pushj p,getnum
dpb a,[220500,,now]
popj p,
; routine to get a number from byter point o
getnum: ildb a,o
subi a,'0
imuli a,10. ` !|
ildb b,o
subi b,'0
add a,b
popj p,
; routine to copy a file from dskchn to ttychn
prinf: move a,[-buflen,,buf]
.iot dskchn,a
hrr b,a
hrli b,-buflen
sub b,a
jumpge b,[popj p,]
hrri b,buf
.iot ttychn,b
jumpl a,[popj p,]
move a,[<3_1>+<3_8.>+<3_15.>+<3_22.>+<3_29.>]
movem a,buf
move a,[buf,,buf+1]
blt a,buf+buflen-1
jrst prinf
buflen==200
buf: block buflen
; Routine to print a string till ^@
princ: hrli o,440700
move a,[<3_1>+<3_8.>+<3_15.>+<3_22.>+<3_29.>]
ildb b,o
jumpe b,[popj p,]
dpb b,[350700,,a]
move b,[-1,,a]
.iot ttychn,b
jrst princ+1
end start
ô? Í, TRIVIA Hacker's Manual
-or-
Learning to Frob Obscurely
I. On the Road to the ASYLUM.
All high-quality TRIVIA maintainers must have a small but
finite knowledge of the workings of ASYLUMs (refer to MARC;ASYLUM >).
Asylums have the following obscure features:
Page 0 - MFD page / Octal Words to the Wise
0. Unused
1&2. Disk format date/time for lock hacking
3. Unused
4. Allocator Lock
5. Unused/used horribly
6. Highest legal address for data
7&10. Unused
11. Pointer to free block chain
12. First of Directory Pointers
77. Last Directory Pointer
100. First Page Lock (each locks 3 pages)
1777. Last Page Lock
Page 1 - ALLOCATOR page / More gems of trivial knowledge
0. AOBJN pointer to Top of the Allocator (good for dinner, too)
1. Highest ID used + 1
2. SETZ n /or 0 -- where n is a pointer to start of free ID chain
3-1777. Allocation table entries (length/start of block)
Directories are hidden at the top end of the file and grow towards the
middle. The data area starts at 4000 (octal) and also grows to the middle
of the file. When they meet, run for cover!
A directory is made up of 4 word blocks whose meanings are as follows:
1. Lock word (-1 ==> free 0 ==> locked)
2. Pointer to Block that data calls home.
3. Length of that block if positive
-or-
Pointer to next free ID on free ID chain (if 4.9 bit set)
4. Data word (for DATA-PRINTW, etc)
A data block is made up of a 5 word header followed by the data itself.
The words of the header are:
1. Use word (+ number of people reading this block)
2. Unused
3. Chain pointer to next free data block if N==? 0
4. Unused
5. Length of block INCLUDING header
In addition to the data block header, insane MANIACS created in MADMAN
spaces use an additional 6 words of header but their meaning in obscure and
their value is left for philosophers to decide. No person in his right mind
attempts to grok this.
The following magic incantations may be useful to a fifth-level magic user.
1. <DATA-FIND <asylum> <id number>>
returns the directory block for that ID
2. <DATA-OPEN <mode> ; "PRINT" "READ" or "PRINTW"
<id number> ; -1 for a brand new ID if in PRINT mode
<asylum>>
returns a MANIAC or FALSE
3. <DATA-BLOCK <maniac>
<asylum>
<length of block>>
returns the location of the allocated block or FALSE
4. <DATA-CLOSE <maniac> <asylum>>
returns the MANIAC
5. <DATA-APRINT <asylum> <id number> <space> <object>>
returns the MANIAC created
6. <DATA-IPRINT <maniac> <asylum> <space> <object>>
is like DATA-APRINT with a DATA-OPEN done previously
7. <DATA-AREAD <asylum> <id number> <space>>
returns the object.
8. <DATA-IREAD <maniac> <asylum> <space>>
is the analog of DATA-IREAD.
9. <DATA-PRINTW <id number> <asylum> <primtype word>>
returns the MANIAC
10. <DATA-READW <id number> <asylum>>
returns a <primtype word>
11. <DIR-FIND <asylum> <id number>>
returns the page number in core of the directory on which <id number>
lives. It obviously maps the page in, if it wasn't already.
12. <OPEN-DATA-FILE <file name>>
opens an ASYLUM. There are some optional arguments which are not
really necessary to grok.
13. <DATA-PUT <asylum> <id number> <uvector [dir header]>>
BE CAREFUL!
14. <DATA-DELETE <id number> <asylum>>
deletes this item
15. <DATA-BLOCK-FREE <asylum> <location of start of block>>
deallocates that block
16. <NAME-BLOCK-FREE <id number> <asylum>>
deallocates the name area for <id number>
17. <DATA-RENAME <id number> <asylum> <id number>>
the obvious. May not be debugged totally.
, @l !y<SETG L-NOISY <>>
<FLOAD "AR2:MARC;BUF FBIN">
<FLOAD "AR2:MARC;CALRDR FBIN">
<USE "BUF" "CALSYM" "CALRDR" "STR" "TTY">
<FLOAD "MADMAN;XUNAME NBIN">
<FLOAD "MADMAN;SORTX FBIN">
<FLOAD "MADMAN;LOCK NBIN">
<FLOAD "MADMAN;MADMAN FBIN">
<FLOAD "MADMAN;ASYLUM FBIN">
@l h
<DEFINE FROB ()
<SET FOO <OPEN-DATA-FILE "MADMAN;TV FILE">>
<DATA-RESERVE <+ ,1STCAT ,NCAT 5> .FOO>
<SET BAR <AFIND 1>>
<DATA-APRINT .FOO ,LUSERS .BAR <ALIST .BAR 1>>
<DATA-PRINTW ,HIQLOC .FOO 1>
<DATA-PRINTW ,HIQNUM .FOO 1>
<DATA-PRINTW ,HIMAIL .FO h
O ,LOMAIL>
<AGIVE .BAR>> ô É 6 TITLE TVLOSE
START: .VALUE [ASCIZ /:
TRIVIA is down for repairs
Try again later
Sigh.
:KILL
:VK
/]
.VALUE
END START
6 # TITLE TRIVIA DATA BASE COPIER
A=1
B=2
C=3
DSKI==0
DSKO==1
INPBLK: BLOCK 2000
ERROR: 0
START: .CALL TVOPN
.LOSE 1000
.CALL COPDEL
JFCL
.CALL COPOPN
.LOSE 1000
.VALUE [ASCIZ /:PROCED
/]
CPLOOP: SETZ A,
MOVE B,[-2000,,INPBLK]
.CALL COPIOT
.LOSE 1000
JUMPL B,COPFIN
MOVEI A,1
MOVE B,[-2000,,INPBLK]
.CALL COPIOT
.LOSE 1000
JRST CPLOOP
COPFIN: .CLOSE DSKI,
.CALL SFDUMP
.LOSE 1000
.CLOSE DSKO,
.BREAK 16,60000
TVOPN: SETZ
SIXBIT /OPEN/
MOVSI .BII
MOVEI DSKI
[SIXBIT /DSK/]
[SIXBIT /TV/]
[SIXBIT /FILE/]
SETZ [SIXBIT /MADMAN/]
COPDEL: SETZ
SIXBIT /DELETE/
[SIXBIT /DSK/]
[SIXBIT /TV/]
[SIXBIT /FOO/]
SETZ [SIXBIT /MADMAN/]
COPOPN: SETZ
SIXBIT /OPEN/
MOVSI .BIO
MOVEI DSKO
[SIXBIT /DSK/]
[SIXBIT /TV/]
[SIXBIT /FOO/]
SETZ [SIXBIT /MADMAN/]
COPIOT: SETZ
SIXBIT /IOT/
MOVES ERROR
A
SETZ B
SFDUMP: SETZ
SIXBIT /SDMPBT/
MOVEI DSKO
SETZI 1
END START # 8 TITLE TVLOSE
START: .VALUE [ASCIZ /:
TRIVIA is down for major repairs
Do not expect to play today.
:KILL
/]
.VALUE
END START 8 ! r r þD -8 r r þD r 5< þD -8 r rp þD õ r .p þD õ_ r ô þD + r r þD + r î+ ` þD r r 3Z þD ö r + õ` p h !h 7@C !:
TRIVIA is down for repairs
Try again later
Sigh.
:KILL
:VK
úõnDñ+ ` ,mg` V?QX FhZ + ! !
r r þD -8 r r þD r 5< þD -8 r rp þD õ r .p þD õ_ r ô þD + r r þD + r î+ ` þD r r 3Z þD ö r + õ` p h !h 7@Cï~x !:
TRIVIA is down for major repairs
Do not expect to play today.
:KILL
þeÃäm+ ` ,mg` V?QX FhZ + !
(t r r þD -8 r r þD r 5< þD -8 r rp þD õ r .p þD õ_ r ô þD + r r þD + r î+ ` þD r r 3Z þD ö r + õ` ï~ INX ý2§jaIJ ÿíÎ|ÿINX ý2§jaøõÊiwÿíÎ|ÿINX ú/²9G>l(:INX ø¡+ùmu tINX iK0 g4j6[%X7ôm` 8õ` ñ yõ` õ × < @ R !v Bòè
2B Cöp÷/$Ïï~ /+ E3B D+ E` F+ J+ Gñ õ` õ` uB " Q4B G1B + Gñ £õ` «+ G" W1" Iö(+ Gõ¯7 ,> Xñ ±õ` ¹+ >ñ ½õ` +x úÍâ)/ï~ >ñ Åõ` , _ñ Éõ` d6 û` [ 2B +x õæ 18 0ñ Í+x h nh uñ ùh X
õe` õ` !$]2 d :òè9/" b òè;/" Qy.Mï~` Mb òè=/" b ` !õ` ô/ £õO õ` ` Uh ñ ñ õÈ õ`@ @ Y> @ ðÿÿø SIoÇï~ _ %, h$" õ , h$" <.Bx , h$" .Bx ,^ , hòøK, hb &, hòøM,~ /" $" /$ . ,~ 'ñ û Q$Àõá ðqÀ8 nö© Oû å öO (ô åô Q*" 2õ` ×x ~ ÿÿàeQ A` ( ö Od )ô S + 3B|F ÿÿmÿÿÀ iSH @ _B-` 7ð o ø
ð @ _B-` < ð A !ð Cø
0Z õ` õ` Y ` x DX: ,\z3.99INX MI'õyhõÿÿN" @ _B-` <ð Eð ø
0Z õ` + 2@ _B-` < "ð E #ð Gø
0Z õ` õ` gö @ _B-` < $ð I O8ÿÿ© %ø
0Z õ` õ` oö ð F@ _B-` <ð K & ð Mø
0Z õ` õ` yð @ _B-` ^ð K & ð Mø
@ ü¦ %"! +mÿÿÇð ø @ üæ %ð @ :You don't believe me eh? That makes me MAD!!!
:kill :logout
:Please don't play as that, Try :CHUNAME ttr3K`ÿÿåo someone.
:kill
:Sorry, But You Can't Play during Office Hours (8am-11pm).
:kill
:The System is VERY loaded, Please Try Again inúXç¿Éÿÿ 20 minutes.
:kill
:Gross Bug, Please Notify the Maintainer.
:kill
This is NEW TRIVIA.
Only use this TRIVIA if you plan on playif@U|ÿÿ!ng over a long period of time.
Documentation in MADMAN;TVDOC >
0 @ _B-` ð / 'ð O (ð Qø
x : , ð- _Çÿÿ¬?ð iL gg @ _B-` ð ?ð ð Aø
ù 6 . $ ÿþ å,~ ( s÷G ÿÿü ýA'+ )ïy ,mgïy b- G ð TDTpð Rgi&ð Uo"b UKD $| =1 ð òp³*eð l7 h/& ð YYJ Ý ð
jv zb ð @tn` @y(ð A@y< !AKLð C@&^` "@+(ð E@+< #@D;Lð GC-.` $C1V(ð ICK L %I:N`ð KI>v( &IX+Lð MJ^` 'Jî(ð OJî< (J&;Lð QV?QX )HMEð YòT/.yð uSLvcð yM ** >R8x @>]y` D1=l EòHv/ð 8, ` F0Bcdð oP GoG= HVf @ð £(E%@ UR\ WòoÌ _òj*Vï h f@ð ×8 ð å fð eô+á+ )(t N Title TRIVIA Start Up Checker
.mllit==1
o=0
a=1
b=2
c=3
hhmmss=11
yymmdd=12
tim=13
now=14
err=15
unm=16
p=17
dskchn==1
ttychn==2
mudchn==1
savchn==2
; file containing total N . death message
%ddev: sixbit /dsk/
%dfn1: sixbit /trivia/
%dfn2: sixbit /death/
%dsnm: sixbit /_msgs_/
; file indicating curfew
%cdev: sixbit /dsk/
%cfn1: sixbit /trivia/
%cfn2: sixbit /curfew/
%csnm: sixbit /_msgs_/
; file indicating holiday
%hdev: sixbit /dsk/
%hfn1: sixbit /holidy/
%hsnm: sixbit /combat/
; file of last obnoxious request
%rdev: sixbit /dsk/
%rfn1: sixbit /badboy/
%rsnm: sixbit /vanish/
; save file
%sdev: sixbit /dsk/
%sfn1: sixbit /trv/
%sfn2: sixbit /savfil/
%ssnm: sixbit /madman/
; macro to open channels
define open dev,fn1,fn2,snm,erc=4,nxt=.+2,mod=6,chn=dskchn
.call [setz ? sixbit/open/ ? [mod,,chn] ? dev ? fn1 ? fn2 ? snm ? setzb err]
ifn erc,[
jrst [caie err,erc ? jrst gross ? jrst nxt]
]
ife erc,[
jrst gross
]
termin
; macros to expire gracefully
define fatal
jrst gross
termin
define die -messag
.value [asciz /:messag
:kill
/]
termin
; really starts here
start: movei p,[-20,,pdl-1] ; define peter dave lebling
open [[sixbit/tty/]]0,0,0,0,,3,ttychn
open %ddev,%dfn1,%dfn2,%dsnm,4,check1
pushj p,prinf
.break 16,40000
check1: .rdatim hhmmss, ; time
.suset [.rxunam,,unm] ; xuname
ldb a,[63600,,unm] ; first 5 character
came a,[sixbit / cheat/]
camn a,[sixbit / guest/] ; cretin
jrst whoru
camn a,[sixbit / luser/]
jrst whoru
open [[sixbit/dsk/]][[sixbit/.file./]][[sixbit/(dir)/]]unm,20,.+2,
jrst ok
open %cdev,%cfn1,%cfn2,%csnm
jrst curfew
.ryear a,
ldb a,[320300,,a] ; day of the week
jumpe a,ok ; sunday and sunday
cain a,6 ; are ok
jrst ok
open %hdev,%hfn1,yymmdd,%hsnm
jrst ok ; ok if holiday
ldb a,[301400,,hhmmss]
caige a,'22 ; ok if later than 11 pm
caige a,'09 ; or before 8 am
jrst ok
push p,[avhere] ; save dying code
skipa
curfew: push p,[busy]
open %rdev,%rfn1,unm,%rsnm,
jrst compar
newbad: open %rdev,%rfn1,unm,%rsnm,0,,7
jrst @(p)
compar: .call [setz ? sixbit /rfdate/ ? 1000,,dskchn ? setzm tim]
fatal
pushj p,haknow
.call [setz ? sixbit /sfdate/ ? 1000,,dskchn ? setz now]
fatal
tlz tim,600000
hlrz a,tim
hlrz b,now
came a,b
jrst @(p)
sub now,tim
caige now,20.*60.*2.
rude: .value [asciz /:You don't believe me eh? That makes me MAD!!!
:kill :logout
/]
jrst @(p)
whoru: die Please don't play as that, Try :CHUNAME to someone.
avhere: die Sorry, But You Can't Play during Office Hours (8am-11pm).
busy: die The System is VERY loaded, Please Try Again in 20 minutes.
gross: die Gross Bug, Please Notify the Maintainer.
; here if everything is all right
ok: hrri o,[asciz /
This is NEW TRIVIA.
Only use this TRIVIA if you plan on playing over a long period of time.
Documentation in MADMAN;TVDOC >
/]
pushj p,princ
okok: open %sdev,%sfn1,%sfn2,%ssnm,0,,6,savchn
movsi b,sixbit / mud/
.iot 2,[-1,,o]
.acces 2,[0]
ldb a,[350700,,o]
subi a,40
dpb a,[140600,,b]
ldb a,[260700,,o]
subi a,40
dpb a,[060600,,b]
ldb a,[170700,,o]
subi a,40
dpb a,[000600,,b]
open [[sixbit/dsk/]][[sixbit/ts/]]b,[[sixbit/sys1/]]0,,4,mudchn
movsi p,stuff ; the following is classic
blt p,p
jrst a
stuff: 2
.call load
.value
.iot 1, a
.close mudchn,
addi a,1
jrst @a
load: setz
sixbit /load/
1000,,-1
setzi 1
pdl: block 20
; routine to get into now the current time in
; file creation date format
haknow: move o,[440600,,hhmmss]
pushj p,getnum
imuli a,60.*60.*2
push p,a
pushj p,getnum
imuli a,60.*2
addm a,(p)
pushj p,getnum
imuli a,2
addm a,(p)
pop p,now
pushj p,getnum
dpb a,[330700,,now]
pushj p,getnum
dpb a,[270400,,now]
pushj p,getnum
dpb a,[220500,,now]
popj p,
; routine to get a number from byter point o
getnum: ildb a,o
subi a,'0
imuli a,10.
ildb b,o
subi b,'0
add a,b
popj p,
; routine to copy a file from dskchn to ttychn
prinf: move a,[-buflen,,buf]
.iot dskchn,a
hrr b,a
hrli b,-buflen
sub b,a
jumpge b,[popj p,]
hrri b,buf
.iot ttychn,b
jumpl a,[popj p,]
move a,[<3_1>+<3_8.>+<3_15.>+<3_22.>+<3_29.>]
movem a,buf
move a,[buf,,buf+1]
blt a,buf+buflen-1
jrst prinf
buflen==200
buf: block buflen
; Routine to print a string till ^@
princ: hrli o,440700
move a,[<3_1>+<3_8.>+<3_15.>+<3_22.>+<3_29.>]
ildb b,o
jumpe b,[popj p,]
dpb b,[350700,,a]
move b,[-1,,a]
.iot ttychn,b
jrst princ+1
end start
. kh
<DEFINE PRINT-FREE ("OPTIONAL" FOO)
<COND (<NOT <ASSIGNED? FOO>>
<SET FOO
<CHTYPE <1 <GET-LOC <+ ,IDCHAIN <* 1024 <ALLOCPAGE ,TVASS>>>
,AUV1>>
FIX>>)
(<SET FOO <CHTYPE <ORB *400000000000* .FOO> FIX>>)>
<REPEAT ()
<AND <G=? .FOO 0> <RETURN>>
<SET FOO <CHTYPE <ANDB .FOO #WORD *000000777777*> FIX>>
<COND (<SET M <MEMQ <- .FOO ,SCORE> ,LOSSTABLE>>
<ERROR SCORE-MUNGED .FOO <1 <BACK .M 2>>>)
(<SET M <MEMQ <- .FOO ,QASKED> ,LOSSTABLE>>
<ERROR QASKED-MUNGED .FOO <1 <BACK .M 2>>>)
(<==? .FOO 3> <Eh %l RROR LUSERS-MUNGED>)>
<SET Q <DATA-FIND ,TVASS .FOO>>
<PRIN1 .FOO>
<INDENT-TO 6>
<SET FOO <CHTYPE <3 .Q> FIX>>
<CRLF>>>
<DEFINE PRINT-UBLOCK (OFFSET)
<SET L <DATA-AREAD ,TVASS 3 <ARESET ,TVSPACE>>>
<REPEAT ((LL .L))
<AND <TYPE? <1 .LL> FIX> <RETURN>>
<PRINC <1 .LL>>
<PRINC " -- ">
<PRINT <DATA-AREAD ,TVASS <+ <3 .LL> .OFFSET> <ARESET ,TVSPACE1>>>
<CRLF>
<SET LL <REST .LL 4>>>>
<DEFINE PRINT-Q ()
<REPEAT ((FOO <CHTYPE <DATA-READW ,LOWQUES ,TVASS> FIX>))
<AND <0? .FOO>
<RETURN>>
<SET Q <DATA-AREAD ,TVASS .FOO <ARESET ,TVSPACE>>>
<PRIN1 <NTH .Q ,QQNUM>>
<INDENT-TO 10>
<PRIN1 .FOO>
<INDENT-TO 16>
<PRINC <NTH .Q ,QAUTH>>
<INDENT-TO 23>
<PRIN1 <NTH .Q ,QCAT>>
<SET FOO <CHTYPE <DATA-READW .FOO ,TVASS> FIX>>
<CRLF>>>
<DEFINE PRINT-A (WHR)
<REPEAT ((FOO <CHTYPE <DATA-READW .WHR ,TVASS> FIX>))
<AND <0? .FOO>
<RETURN>>
<SET Q <DATA-AREAD ,TVASS .FOO <ARESET ,TVSPACE>>>
<PRIN1 .FOO>
<INDENT-TO 6>
<PRIN1 <NTH .Q ,AQUES>>
<SET FOO <CHTYPE <DATA-READW .FOO ,TVASS> FIX>>
<CRLF>>>
<DEFINE PRINT-CHAIN (WHR)
<REPEAT ((FOO <CHTYPE <DATA-READW .WHR ,TVASS> FIX>))
<AND <0? .FOO>
<RETURN>>
<SET Q <DATA-AREAD ,TVASS .FOO <ARESET ,TVSPACE>>>
<PRIN1 .FOO>
<INDENT-TO 6>
<PRIN1 .Q>
<SET FOO <CHTYPE <DATA-READW .FOO ,TVASS> FIX>>
<CRLF>>>
; "LENGTH OF CHAIN POINTER IN AN ASYLUM"
<DEFINE CHAIN-LENGTH (WD "AUX" (CNT 0))
#DECL ((WD) <PRIMTYPE WORD> (CNT) FIX)
<REPEAT ((WD <CHTYPE .WD FIX>))
<COND (<0? <SET WD <CHTYPE <DATA-READW .WD ,TVASS> FIX>>>
<RETURN .CNT>)
(<SET CNT <+ .CNT 1>> <CRLF> <PRIN1 .WD>)>>>
<DEFINE DR (FX)
#DECL ((FX) FIX)
<DATA-AREAD .FX ,TVASS <ARESET ,TVSPACE>>>
ô» % BEG: .value messag
jrst beg
messag: asciz ":
8/22/76
Dear Fans,
We regret to announce that the old beloved
program has now been completely flushed. Please
realize that this is in accordance with our
tradition and constant effort of trying to bring
you the best trivia service available on the net.
With our limited manpower and scarce resources
we are unable to maintain two systems at the same
time.
For those who have a strong sentimental
attachment to the demised trivia, we offer the
following special, once in a lifetime offer:
The Giant, Encyclopedic,
67 block long
******************
==> !!! LIBRDR;TV LISTNG !!! <==
******************
containing
a COMPLETE listing of ALL
questions and answers ever
created in the old Trivia.
(Yes, sir all 1462 of them!!)
and
portable, bite-size versions
in the 16-volume series of
*******************************
==> !!! LIBRDR;TVQUES 1-8 & TVANS 1-8 !!! <==
*******************************
(not available in stores)
Either the combined or the series version
would make perfect Christmas or birthday presents.
They would be enjoyed and remembered by generations
to come. Please hurry, with our limited disk
resources (not to mention villain adminstrators)
this offer will not last long! FTP, XGP or TPL
it at your earliest convenience!
Trivially,
TRIVIA@DMS.
:kill
"
END BEG% b <DEFINE SFIND (GZORK "OPTIONAL" (D ,TVASS)) #DECL ((GZORK) FIX (D) ASYLUM)
<PRINC "
Id Address Length Data">
<REPEAT ((CT 0)(UV1 ,DUV1)(FROB <+ <* <MFDPAGE ,TVASS> 1024> ,DIRPTRS>))
#DECL ((CT FROB) FIX (UV1) <UVECTOR <PRIMTYPE WORD>>)
<COND (<0? <CHTYPE <1 <GET-LOC .FROB .UV1>> FIX>>
<RETURN>)
(T
<FINDIT .CT .D .GZORK>
<SET CT <+ .CT 1>>
<SET FROB <+ .FROB 1>>)>>>
<DEFINE FINDIT (DIRNUM D "OPTIONAL" (TARGET 0)
"AUX" LOC HI (DUV ,DATUV) (UV1 ,DUV1) DPAGE TEMP)
#DECL ((DIRNUM TARGET TEMP) FIX (D) ASYLUM (LOC HI) FIX (DPAGE) <OR FALSE FIX>
(UV1) <UVECTOR [1 WORD]> (DUV) <UVECTOR [4 WORD]>)
<COND
(<SET DPAGE <DIR-FIND .D <* .DIRNUM ,DIRSIZE>>>
<SET HI <CHTYPE <1 <GET-LOC <+ ,HIGHID <* <MFDPAGE .D> 1024>> .UV1>> FIX>>
<SET LOC <+ <* .DPAGE 1024> ,OBJSTART>>
<REPEAT ((NAME <* .DIRNUM ,DIRSIZE>) (FOO ,DIRSIZE) BAR)
#DECL ((NAME FOO BAR) FIX)
<COND
(<OR <1? .FOO> <G? .NAME .HI>> <PRINC .DIRNUM> <RETURN>)
(T
<SET BAR <CHTYPE <NTH <GET-LOC .LOC ,NAMUV> <+ ,NAMDATA 1>> FIX>>
<COND (<==? .TARGET <CHTYPE <NTH ,NAMUV <+ ,NAMMISC 1>> FIX>>
<CRLF>
<PRIN1 .NAME>
<INDENT-TO 7>
<AND <==? <NTH ,NAMUV 1> #WORD *0*> <PRINC "*">>
<PRIN1 .BAR>
<INDENT-TO 19>
<PRIN1 <CHTYPE <NTH ,NAMUV <+ ,NAMCHNCDR 1>> FIX>>
<INDENT-TO 29>
<PRIN1 <COND (<OR <0? .TARGET>
<N==?
<SET TEMP
<CHTYPE <b z NTH ,NAMUV <+ ,NAMMISC 1>> FIX>>
.TARGET>> .TEMP)
("**WINNER**")>>)>
<SET NAME <+ .NAME 1>>
<SET FOO <- .FOO 1>>
<SET LOC <+ .LOC ,NAMBLKLEN>>)>>)>>
<DEFINE LISTF (DIRNUM D "AUX" LOC HI (DUV ,DATUV) (UV1 ,DUV1) DPAGE)
#DECL ((DIRNUM) FIX (D) ASYLUM (LOC HI) FIX (DPAGE) <OR FALSE FIX>
(UV1) <UVECTOR [1 WORD]> (DUV) <UVECTOR [4 WORD]>)
<COND
(<SET DPAGE <DIR-FIND .D <* .DIRNUM ,DIRSIZE>>>
<SET HI <CHTYPE <1 <GET-LOC <+ ,HIGHID <* <MFDPAGE .D> 1024>> .UV1>> FIX>>
<SET LOC <+ <* .DPAGE 1024> ,OBJSTART>>
<PRINC "
Id Address Length Data">
<REPEAT ((NAME <* .DIRNUM ,DIRSIZE>) (FOO ,DIRSIZE) BAR)
#DECL ((NAME FOO BAR) FIX)
<COND
(<OR <1? .FOO> <G? .NAME .HI>> <RETURN <CRLF>>)
(T
<COND (<AND <0? <SET BAR
<CHTYPE <NTH <GET-LOC .LOC ,NAMUV>
<+ ,NAMDATA 1>>
FIX>>>
<==? <NTH ,NAMUV <+ ,NAMMISC 1>> #WORD *0*>>
<COND (<0? <SET BAR
<CHTYPE <NTH ,NAMUV <+ ,NAMCHNCDR 1>> FIX>>>)
(<CRLF>
<PRINC !"[>
<PRIN1 .NAME>
<PRINC !"]>)>)
(<CRLF>
<PRIN1 .NAME>
<INDENT-TO 7>
<AND <==? <NTH ,NAMUV 1> #WORD *0*> <PRINC "*">>
<PRIN1 .BAR>
<INDENT-TO 19>
<PRIN1 <CHTYPE <NTH ,NAMUV <+ ,NAMCHNCDR 1>> FIX>>
<INDENT-TO 29>
<PRIN1 <CHTYPE <NTH ,NAMUV <+ ,NAMMISC 1>> FIX>>)>
<SET NAME <+ .NAME 1>>
<SET FOO <- .FOO 1>>
<SET LOC <+ .LOC ,NAMBLKLEN>>)>>)>>
<DEFINE LISTA (D
"AUX" (MFD <* <MFDPAGE .D> 1024>) (ALLOC <* <ALLOCPAGE .D> 1024>)
HIGH LO CNT ALOC)
#DECL ((D) ASYLUM (MFD ALLOC CNT ALOC) FIX)
<ALLOC-MAP .D>
<PRINC "
Database Allocator Statistics">
<SET ALPTR <1 <GET-LOC .ALLOC ,DUV1>>>
<SET CNT
<CHTYPE <ORB <GETBITS .ALPTR <BITS 18 18>> #WORD *777777000000*>
FIX>>
<CRLF>
<SET ALOC
<+ <CHTYPE <ANDB <GETBITS .ALPTR <BITS 18 0>> #WORD *000000001777*>
FIX>
.ALLOC>>
<CRLF>
<PRINC "From To Length">
<REPEAT ((UV ,AUV2))
<GET-LOC .ALOC .UV>
<CRLF>
<PRIN1 <SET LO <CHTYPE <2 .UV> FIX>>>
<PRINC " ">
<PRIN1 <SET HIGH <+ .LO <CHTYPE <1 .UV> FIX>>>>
<PRINC " ">
<PRIN1 <- .HIGH .LO>>
<SET ALOC <+ .ALOC 2>>
<SET CNT <+ .CNT 2>>
<AND <0? .CNT> <RETURN <CRLF>>>>>
<DEFINE LISTM (D
"AUX" (MFD <* <MFDPAGE .D> 1024>) (ALLOC <* <ALLOCPAGE .D> 1024>)
HIGH LO CNT ALOC (DUV ,DUV1) A)
#DECL ((D) ASYLUM (MFD ALLOC CNT ALOC) FIX (DUV) <UVECTOR [1 WORD]>
(A) <PRIMTYPE WORD>)
<SET A <1 <GET-LOC <+ .MFD ,DPGLOCK> .DUV>>>
<PRINC "
MFD Lock -- ">
<COND (<==? .A #WORD *000000000000*> <PRINC "LOCKED">)
(<PRINC "UNLOCKED">)>
<PRINC "
UP time -- ">
<PDSKDATE <1 <GET-LOC <+ .MFD ,DINITRQ> .DUV>>>
<PRINC "
ALTER time -- ">
<PDSKDATE <1 <GET-LOC <+ .MFD ,DINITDN> .DUV>>>
<SET CNT
<CHTYPE <ORB <GETBITS <1 <GET-LOC .ALLOC .DUV>>
<BITS 18 18>>
#WORD *777777000000*>
FIX>>
<PRINC "
ALLOCATOR Use -- ">
<PRIN1 <SET ALOC </ <- .CNT> 2>>>
<PRINC " entries [">
<PRIN1 </ <* .ALOC 100> 511>>
<PRINC "%]">
<PRINC "
ALLOCATOR Lock -- ">
<COND (<==? <1 <GET-LOC <+ .MFD ,ALLOCLOCK> .DUV>>
#WORD *000000000000*>
<PRINC "LOCKED">)
(<PRINC "UNLOCKED">)>
<PRINC "
High Address -- ">
<PRIN1 <SET A <CHTYPE <1 <GET-LOC <+ .MFD ,HIGHADR> .DUV>> FIX>>>
<PRINC " [Page ">
<PRIN1 </ .A 1024>>
<PRINC "]">
<PRINC "
Maximum Address -- ">
<PRIN1 <SET A <CHTYPE <1 <GET-LOC <+ .MFD ,MAXADR> .DUV>> FIX>>>
<PRINC " [Page ">
<PRIN1 </ .A 1024>>
<PRINC "]">
<PRINC "
High ID -- ">
<PRIN1 <CHTYPE <1 <GET-LOC <+ .ALLOC ,HIGHID> .DUV>> FIX>>
<REPEAT ((N ,DIRPTRS) (DIR 0))
#DECL ((N DIR) FIX)
<COND (<0? <SET A <CHTYPE <1 <GET-LOC <+ .MFD .N> .DUV>> FIX>>>
<RETURN>)
(<CRLF>
<PRINC "Directory ">
<PRIN1 .DIR>
<PRINC " at ">
<PRIN1 .A>
<PRINC " [Page ">
<PRIN1 </ .A 1024>>
<PRINC "]">
<SET N <+ .N 1>>
<SET DIR <+ .DIR 1>>)>>
<REPEAT ((N ,PGLOCKS))
<COND (<==? .N 1024> <RETURN>)
(T
<COND (<==? <1 <GET-LOC <+ .MFD .N> .DUV>>
#WORD *000000000000*>
<PRINC "
Pages Locked from ">
<PRIN1 <SET A </ <- .N ,PGLOCKS> .P/L>>>
<PRINC " to ">
<PRIN1 <+ .A ,P/L>>)>
<SET N <+ .N 1>>)>>
,NULL>
<DEFINE LISTB (DC "OPTIONAL" (VERB <>) (SALV <>)
"AUX" (MFD <* <MFDPAGE .DC> 1024>) (UV1 ,DUV1) (DUV ,NAMUV)
(ALLOCK <+ .MFD ,ALLOCLOCK>) DF HI FROB (LOST 0) MOBY)
#DECL ((DC) ASYLUM (MFD ALLOCK) FIX (UV1) <UVECTOR [1 WORD]> (HI) WORD
(LOST) FIX (DUV) <UVECTOR [4 WORD]> (DF) <OR FALSE FIX>
(MOBY) <UVECTOR [REST WORD]> (VERB SALV) <OR 'T FALSE>)
<ALLOC-MAP .DC>
<SET HI <1 <GET-LOC <+ ,HIGHID <* <ALLOCPAGE .DC> 1024>> .UV1>>>
<SET ALPTR
<+ <* 1024 <ALLOCPAGE .DC>>
<CHTYPE <ANDB <1 <GET-LOC <* <ALLOCPAGE .DC> 1024> .UV1>>
z f,H #WORD *000000001777*>
FIX>>>
<SET MOBY
<IUVECTOR <+ 4
<* <CHTYPE .HI FIX> 2>
<SET ALLEN <- <+ 1023 <* <ALLOCPAGE .DC> 1024>> .ALPTR>>>
#WORD *000000000000*>>
<GET-LOC-X .ALPTR <REST .MOBY 2> .ALLEN>
<PUT .MOBY 1 #WORD *777777003777*>
<PUT .MOBY 2 #WORD *000000000001*>
<SET MOBY <REST .MOBY <+ 2 .ALLEN>>>
<REPEAT ((DIR <+ .MFD ,DIRPTRS>) (DIRNUM 0) (ID 0))
#DECL ((DIR DIRNUM ID) FIX)
<COND
(<OR <0? <CHTYPE .DIR FIX>>
<NOT <SET DF <DIR-FIND .DC <* .DIRNUM ,DIRSIZE>>>>>
<RETURN>)
(<SET DPG <+ ,OBJSTART <* 1024 .DF>>>
<REPEAT ((NUM ,DIRSIZE) (WHR 0) WD)
<COND (<OR <EMPTY? .MOBY> <0? .NUM>> <RETURN>)
(<GET-LOC .DPG .DUV>
<AND <==? <NTH .DUV <+ ,NAMDATA 1>> #WORD *000000000000*>
<SET DPG <+ .DPG ,NAMBLKLEN>>
<SET LOST <+ .LOST 2>>
<SET NUM <- .NUM 1>>
<SET WHR <+ .WHR 1>>
<AGAIN>>
<PUT .MOBY 2 <NTH .DUV <+ ,NAMDATA 1>>>
<SET WD <NTH .DUV <+ ,NAMCHNCDR 1>>>
<PUT .MOBY
1
<PUTBITS .WD
<BITS 18 18>
<CHTYPE <+ <* .DIRNUM ,DIRSIZE> .WHR>
WORD>>>
<SET MOBY <REST .MOBY 2>>
<SET DPG <+ .DPG ,NAMBLKLEN>>
<SET NUM <- .NUM 1>>
<SET WHR <+ .WHR 1>>)>>
<SET DIRNUM <+ .DIRNUM 1>>)>>
<SET MOBY <SORT <> <TOP .MOBY> 2 1>>
<AND .VERB
<PRINC "
From To Length Use">>
<REPEAT ((M .MOBY) LO HI (LSTLO -1) (LSTHI -1) (LSTM -1))
#DECL ((LO HI LSTLO LSTHI) FIX (M) UVECTOR)
<AND <EMPTY? .M> <RETURN>>
<AND <==? <1 .M> #WORD *000000000000*>
<SET M <REST .M 2>>
<AGAIN>>
<SET LO <CHTYPE <2 .M> FIX>>
<SET HI <+ <CHTYPE <2 .M> FIX>
<CHTYPE <GETBITS <1 .M> <BITS 18>> FIX>>>
<COND (<==? .LO .LSTLO>
<SALVERR "**SHARED BLOCK**" .LSTLO .LSTHI .LSTM .LO .HI <1 .M>>)
(<L? .LO .LSTHI>
<SALVERR "**BLOCKS OVERLAP**" .LSTLO .LSTHI .LSTM .LO .HI <1 .M>>)
(<AND .SALV
<G? .LO .LSTHI>
<0? <CHTYPE <GETBITS <1 .M> <BITS 18 18>> FIX>>
<0? <CHTYPE <GETBITS .LSTM <BITS 18 18>> FIX>>>
<CRLF>
<PRINC "DEALLOCATING BLOCK - Length = ">
<PRIN1 <- .LO .LSTHI>>
<PRINC " Location = ">
<PRIN1 .LSTHI>
<SALVDEALLOC .DC <- .LO .LSTHI> .LSTHI>)>
<AND .VERB
<PBLOCK .LO .HI <1 .M>>>
<SET LSTLO .LO>
<SET LSTHI .HI>
<SET LSTM <1 .M>>
<SET M <REST .M 2>>>>
<DEFINE PRTYPE (WD "AUX" HOW)
#DECL ((WD) WORD (HOW) FIX)
<COND (<0? <SET HOW <CHTYPE <GETBITS .WD <BITS 18 18>> FIX>>>
<PRINC "Unallocated">)
(<==? <CHTYPE .HOW WORD> #WORD *000000777777*>
<PRINC "Reserved">)
(<PRINC "Object #"> <PRIN1 .HOW>)>>
<DEFINE SALVERR (ERR LLO LHI LM LO HI M)
#DECL ((ERR) STRING (LLO LHI LO HI) FIX (LM M) WORD)
<PRINC "
ERROR -- ">
<PRINC .ERR>
<PBLOCK .LLO .LHI .LM>
<PBLOCK .LO .HI .M>
<CRLF>>
<DEFINE PBLOCK (LO HI M)
#DECL ((LO HI) FIX (M) WORD)
<CRLF>
<PRIN1 .LO>
<INDENT-TO 9>
<PRIN1 .HI>
<INDENT-TO 16>
<PRIN1 <CHTYPE <GETBITS .M <BITS 18>> FIX>>
<INDENT-TO 26>
<PRTYPE .M>>
<DEFINE LISTU ("AUX" (ALL <* 1024 <ALLOCPAGE ,TVASS>>) HI V)
#DECL ((ALL HI) FIX (V) UVECTOR)
<SET HI <CHTYPE <1 <GET-LOC <+ .ALL ,HIGHID> ,DUV1>> FIX>>
<SET V <AIUVECTOR ,MOBYSPACE <- .HI 1> 0>>
<REPEAT ((VEC .V) (N 1) FX)
#DECL ((VEC) UVECTOR (N FX) FIX)
<AND <==? .N .HI> <RETURN>>
<SET FX <CHTYPE <DATA-READW .N ,TVASS> FIX>>
<COND (<AND <G? .FX 0> <L? .FX .HI>>
<PUT .VEC .FX 1>)>
<SET N <+ .N 1>>>
<MAPR <>
<FUNCTION (X "AUX" FOO)
#DECL ((X) UVECTOR (FOO) FIX)
<COND (<1? <1 .X>>)
(<DATA-AREAD ,TVASS <SET FOO <- <LENGTH .V> <LENGTH .X> -1>>
<ARESET ,TVSPACE>>
<COND (<OR <MEMQ <- .FOO 3> ,LOSSTABLE>
<MEMQ <- .FOO 6> ,LOSSTABLE>>)
(<PRINC "
Non-referenced object #">
<PRIN1 .FOO>)>)>>
.V>
,NULL>
,H "> ñ¢yøcIø¨'Æúqj QúÐi)A÷P<Uô+Aú±P.ø4 e÷Ⱦ}ôE<§øµ# ø5)Eùõ¢ ð U,6H *rh , h õ`U/Zx _ô (D ,> .$ ,6p ,6 Bp òé4 Mö1 õ`4 G _ô (D d| . öÈ ð88 õ @ X ör + h .h 'ö´ / h 'ô ¸
+ h %ô ô ,^ õ´ + _ô (B H õ`4 ;/Zx $ õèÿÿô úx X õÈÿÿ & /& õÉÿÿú) õÀ üÿÿ+ h .h '+ Kp,^ .$ ,6p ,6 ,> Bp _ô ô p,^ õå´ O+ Kp/ h (ô8 + h %ô põå´ O+ Kpô ð ñW>o ûlDú¢ÍúÑP#ø°æ QôU Ì«ø¨<úH#I±ô ̧ø¯A§û3*ÍAøÒl)Aø&Oùh"UùáËAø3&Oø5'Ò[ùµgGø"ùõFú³¢"Sô
)» ð 5CL$p( øìü×ýÀ K X DAd/Pÿ/ Mð ; >
îñO Î <ASSIGNED? GLUø¯.ùb yPUT ,DATREMOVE øó*ÅAôèmµg68711ö kö Ú³mö-4e÷.X¶cöÌ cöm2cö 5Aõ¬Y6cöÍ6iöl5eö²Cû¯ ñH A"> h <DEFINE OFFSET (VAR) <- <* <VALUE .VAR> 2> 1>>
<TITLE DATREMOVE>
<DECLARE ("VALUE" <OR FIX FALSE> ASYLUM FIX)>
<PUSH TP* (AB)>
<AOBJN AB* HERE -1>
<PUSHJ P* DATA1>
<JRST FINIS>
<INTERNAL-ENTRY DATA1 2>
<SUBM M* (P)>
<MOVE A* -2(TP)> ; "THE AS h &h YLUM"
<MOVE B* <OFFSET MFDPAGE> (A)>
<LSH B* 10> ; "ADDRESS OF MFD PAGE"
<PUSH P* B>
<ADDI B* ALLOCLOCK>
<PUSH TP* <TYPE-WORD WORD>>
<PUSH TP* B>
<MCALL 1 DHLOCK> ; "HARD LOCK THE ALLOCATOR"
<GETYP B* A>
<CAIN B* <TYPE-CODE FALSE>>
<JRST ALLOSE> ; "SORRY. ALREADY LOCKED"
<MOVE A* -2(TP)>
<MOVE B* <OFFSET ALLOCPAGE> (A)>
<LSH B* 10> ; "ADDRESS OF ALLOCATION PAGE"
<MOVE C* (B)> ; "AOBJN TO TABLE"
<TRZ C* *776000*> ; "FLUSH HIGH BITS"
<ADD C* B>
<SKIPL C>
<ERRUUO* <MQUOTE ALLOCATOR-MUNGED>>
<PUSH P* C> ; " ** SAVED TOP OF ALLOCATION TABLE **"
<SETZ> ; "USE 0 FOR BEST FIT"
<MOVE D* (TP)> ; "ENTRY TO FLUSH BEGINS HERE"
ALLOOP <CAMN D* 1(C)> ; "RIGHT ENTRY?"
<JRST TBLWN1>
ALFROB <ADD C* [<2 (2)>]> ; "TRY NEXT ENTRY"
<JUMPL C* ALLOOP>
TBLOSE <SUB P* [<2 (2)>]>
<MOVE A* <MQUOTE '("NOT FOUND")>>
<JRST ALLOS2>
; "COME HERE IF THERE IS A WINNING ENTRY CLOSE ENOUGH TO THE CORRECT SIZE
TO MAKE IT A WINNER. IT IS ALREADY LOCKED."
TBLWN1 <MOVE O* 1(C)> ; "O HAS WINNING BLOCK POINTER"
<MOVEI A* 1(C)>
<POP P* D> ; " ** RESTORED TOP OF ALLOC TABLE **"
<PUSHJ P* BBLT> ; "REMOVE THIS TABLE ENTRY"
<MOVE A* -2(TP)>
<MOVE A* <OFFSET ALLOCPAGE> (A)>
<LSH A* 10>
<MOVEM D* (A)>
<JRST ALWIN> ; "AND WIN"
BBLT <SUBM M* (P)>
<MOVEI B* 2(D)>
<SUBI A* -1(B)> ; "BLT TABLE UP TWO LOCATIONS"
<MOVE E* A>
<HRLZS A>
<HRR A* D>
<ADDI A* -1(E)>
<MOVEI C* (B)>
<SUBI C* (A)>
<ADDI C* -1(E)>
<HRLI C* A>
<POP A* @ C>
<TLNE A* *777777*>
<JRST HERE -2>
<ADD D* [<2 (2)>]> ; "REST THE TABLE 2"
<JRST MPOPJ>
ALWIN <POP P* B> ; " ** RESTORED ADDRESS OF MFD **"
<ADDI B* ALLOCLOCK>
<PUSH TP* <TYPE-WORD WORD>>
<PUSH TP* B>
<PUSH P* O> ; "ADDRESS FOR WRITE"
<MCALL 1 DUNLOCK> ; "UNLOCK THE ALLOCATION TABLE"
ALWIN1 <MOVE D* -2(TP)>
<MOVE B* <OFFSET ALLOCPAGE> (D)>
<MOVE A* <TYPE-WORD FIX>>
<POP P* B> ; "RESTORE WINNING ADDRESS"
<SUB TP* [<4 (4)>]> ; "TASTE AND WINNAGE"
<JRST MPOPJ>
; "VARIOUS LOSSAGES"
ALLOSE <SUB P* [<1 (1)>]>
<MOVE B* <MQUOTE (6)>>
<JRST ALLOS2>
ALLOS2 <MOVE A* <TYPE-WORD FALSE>>
<SUB TP* [<4 (4)>]>
<JRST MPOPJ>
ôÚ Éð!ß<SETG L-NOISY <>>
<FLOAD "AR2:MARC;BUF FBIN">
<FLOAD "AR2:MARC;CALRDR FBIN">
<USE "BUF" "CALSYM" "CALRDR" "STR" "TTY">
<FLOAD "MADMAN;XUNAME NBIN">
<FLOAD "MADMAN;SORTX FBIN">
<FLOAD " J MADMAN;ALOCK NBIN">
<FLOAD "MADMAN;MADMAN FBIN">
<FLOAD "MADMAN;ASYLUM FBIN">
ô !·H PE (WD "AUX" HOW)
#DECL ((WD) WORD (HOW) FIX)
<COND (<0? <SET HOW <CHTYPE <GETBITS .WD <BITS 18 18>> FIX>>>
<PRINC "Unallocated">)
(<==? <CHTYPE .HOW WORD> #WORD *000000777777*>
<PRINC "Reserved">)
(<PRINC "Object #"> <PRIN1 .HOW>)>>
<DEFINE SALVERR (ERR LLO LHI LM LO HI M)
#DECL ((ERR) STRING (LLO LHI LO HI) FIX (LM M) WORD)
<PRINC "
ERROR -- ">
<PRINC .ERR>
<PBLOCK .LLO .LHI .LM>
<PBLOCK .LO .HI .M>
<CRLF>>
<DEFINE PBLOCK (LO HI M)
#DECL ((LO HI) FIX (M) WORD)
<CRLF>
<PRIN1 .LO>
<INDENT-TO 9>
<PRIN1 .HI>
<INDENT-TO 16>
<PRIN1 <CHTYPE <GETBITS .M <BITS 18>> FIX>>
<INDENT-TO 26>
<PRTYPE .M>>
<DEFINE LISTU ("AUX" (ALL <* 1024 <ALLOCPAGE ,TVASS>>) HI V)
#DECL ((ALL HI) FIX (V) UVECTOR)
<SET HI <CHTYPE <1 <GET-LOC <+ .ALL ,HIGHID> ,DUV1>> FIX>>
<SET V <AIUVECTOR ,MOBYSPACE <- .HI 1> 0>>
<REPEAT ((VEC .V) (N 1) FX)
#DECL ((VEC) UVECTOR (N FX) FIX)
<AND <==? .N .HI> <RETURN>>
<SET FX <CHTYPE <DATA-READW .N ,TVASS> FIX>>
<COND (<AND <G? .FX 0> <L? .FX .HI>>
<PUT .VEC .FX 1>)>
<SET N <+ .N 1>>>
<MAPR <>
<FUNCTION (X "AUX" FOO)
#DECL ((X) UVECTOR (FOO) FIX)
<COND (<1? <1 .X>>)
(<DATA-AREAD ,TVASS <SET FOO <- <LENGTH .V> <LENGTH .X> -1>>
<ARESET ,TVSPACE>>
<COND (<OR <MEMQ <- .FOO 3> ,LOSSTABLE>
<MEMQ <- .FOO 6> ,LOSSTABLE>>)
(<PRINC "
Non-referenced object #">
<PRIN1 .FOO>)>)>>
.V>
,NULL>
,H "> ñ¢yøcIø¨'Æúqj QúÐi)A÷P<Uô+Aú±P.ø4 e÷Ⱦ}ôE<§øµ# ø5)Eùõ¢ ð U,6H *rh , h õ`U/Zx _ô (D ,> .$ ,6p ,6 Bp òé4 Mö1 õ`4 G _ô (D d| . öÈ ð88 õ @ X ör + h .h 'ö´ / h 'ô ¸
+ h %ô ô ,^ õ´ + _ô (B H õ`4 ;/Zx $ õèÿÿô úx X õÈÿÿ & /& õÉÿÿú) õÀ üÿÿ+ h .h '+ Kp,^ .$ ,6p ,6 ,> Bp _ô ô p,^ õå´ O+ Kp/ h (ô8 + h %ô põå´ O+ Kpô ð ñW>o ûlDú¢ÍúÑP#ø°æ QôU Ì«ø¨<úH#I±ô ̧ø¯A§û3*ÍAøÒl)Aø&Oùh"UùáËAø3&Oø5'Ò[ùµgGø"ùõFú³¢"Sô
)» ð 5CL$p( øìü×ýÀ K X DAd/Pÿ/ Mð ; >
îñO Î <ASSIGNED? GLUø¯.ùb yPUT ,DATREMOVE øó*ÅAôèmµg68711ö kö Ú³mö-4e÷.X¶cöÌ cöm2cö 5Aõ¬Y6cöÍ6iöl5eö²Cû¯ ñH A"> h <DEFINE OFFSET (VAR) <- <* <VALUE .VAR> 2> 1>>
<TITLE DATREMOVE>
<DECLARE ("VALUE" <OR FIX FALSE> ASYLUM FIX)>
<PUSH TP* (AB)>
<AOBJN AB* HERE -1>
<PUSHJ P* DATA1>
<JRST FINIS>
<INTERNAL-ENTRY DATA1 2>
<SUBM M* (P)>
<MOVE A* -2(TP)> ; "THE ASH 