|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 57600 (0xe100)
Types: TextFile
Names: »tdbcodes «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tdbcodes «
(dbrecdecode=slang
dbrecdecode dbreccreate dbrectransf initdbtable connectdb dbrecdescr)
\f
; rc 76.10.04 dbcodes -1-
; segment 1: decodeinternal, dbrecdecode, dbreccreate, dbrectransf
; segment 2: initdbtable
; segment 3: isodate, connectdb, dbrecdescr
; segment 4: insert-constants (extension of dbreccreate)
s. g22 w.
d.p.<:fpnames:>,l.
; the procedures on segment 1 uses the dbtable,
; which is shown on segment 2
s. j30 h.
g4: g3, g2 ; rel last point, rel abs word
j1: 0, 1 ; own core byte basedbtable
j4: 1<11o.3, 0 ; reference to segment 4 (dbreccreate extension)
j7: 7, 0 ; rs end uv expr
j12: 12, 0 ; rs uv
j13: 13, 0 ; rs last used
j21: 21, 0 ; rs general alarm
j29: 29, 0 ; rs param alarm
j30: 30, 0 ; rs saved last used
g2=k-2-g4
; kommentarer i koden bærer præg af at første param tidligere
; var en zone
g3=k-2-g4
b. p0, c7 w.
; decodeinternal
; this subroutine is called from
; 1) the procedures dbrecdecode dbreccreate dbrectransf
; 2) implicitely from any cf-procedure which gets
; a new record
;
; the subroutine places a new value in the dbtable for:
; length of last decoded and
; type of last decoded
; and further assigns the relevant values to:
; all field variables connected to this zone (or array) and
; the indivclass variable.
;
; not found length error not used ok
; uv 0 tabvalue 0 tabvalue
; length last decoded 0 0 0 tabvalue
; indivclass -2 -1 0 tabvalue
; fieldvariables 0 0 0 tabvalue
p0:
; procedure decodeinternal
; entry exit
; w0 indivtype destroyed
; w1 addr2 unchanged
; w2 z.indivlength *) unchanged
; w3 return addr destroyed
; *) stackref if called from create
\f
; rc 79.04.20 dbcodes -2-
b. m13 w.
ds. w2 c6. ; save w1.w2
rs w0 x1 ; last decoded:=indivtype;
rs. w3 c4. ; c4:=return addr
al w2 x1 ; w2:=addr2
al w1 x1+14 ; w1:=addr of first indivtype
m0: sh w0 (x1+0) ; loop:
jl. m5. ; find indiv in dbtable
sh w0 (x1+8) ;
jl. m4. ;
sh w0 (x1+16) ;
jl. m3. ;
sh w0 (x1+24) ;
jl. m2. ;
sh w0 (x1+32) ;
jl. m1. ;
al w1 x1+40 ;
jl. m0. ;
m1: am 8 ;
m2: am 8 ;
m3: am 8 ;
m4: al w1 x1+8 ;
m5: se w0 (x1) ; if not found then
jl. m8. ; goto not found
rs w1 x2+2 ; save addr of indivtype
; w2= addr2
; w1=addr of indivtype
rl w0 x1+4 ;
rs w0 x2-2 ; length of last decoded:=indivlength;
rs. w0 (j12.) ; uv:=indivlength;
rl. w3 (j13.) ;
se. w0 (c6.) ; if indivlength=reclength
sn. w3 (c6.) ; or reclength=lastused
jl. m13. ; then goto take_indiv_class
; perhaps variable record length, inspect keys.
rl w3 x2+12 ; w3:= keys(addr2)
sz w3 1<3 ; if -, varlength
sl. w0 (c6.) ; or indivlength >= reclength
jl. m9. ; then goto length_error
m13: ; take_indiv_class:
rl w3 x1+6 ; w3:=tabvalue;
rs w3 (x2+8) ; indivclassvar:=w3
sh w3 0 ; if indivclass <= 0 then
jl. m12. ; goto zero_set_indivclass
rl w1 x1+2 ; w1:=addr4
sn w1 0 ; if not used then
jl. m10. ; goto zeroset all fieldvar;
rl w0 x2+10 ; w0:=endaddr
rl w2 x2+6 ; w2:=addr3
m6: rl w3 x1 ; fieldvarloop:
rs w3 (x2+4) ; fieldvar:=modif<12+reladdr
sn w0 x2+4 ;
jl. m7. ;
rl w3 x1+2 ;
rs w3 (x2+10) ;
sn w0 x2+10 ;
jl. m7. ;
al w1 x1+4 ;
al w2 x2+12 ;
jl. m6. ; repeat for all field variables
m7: dl. w2 c6. ; restore w1.w2
jl. (c4.) ; return
\f
; rc 76.10.04 dbcodes -3-
m8: se w0 -13 ; not found:
am -2 ; indivclass:=
m12: ; zero_set_indivclass:
am +1 ; if not used then 0
m9: al w0 -1 ; else if not found then -2
rs w0 (x2+8) ; else if length error then -1;
al w1 0 ;
se w0 -1 ; if -,lengtherror then
rs. w1 (j12.) ; uv:=0;
rs w1 x2-2 ; length last decoded:=0;
m10: rl w0 x2+10 ; zeroset all fieldvar:
rl w2 x2+6 ; w0:=end adddr; w2:=addr3;
sn w0 x2 ; if addr3=end addr
jl. m7. ; then goto exit;
m11: rs w1 (x2+4) ; all fieldvar:=0;
sn w0 x2+4 ;
jl. m7. ;
rs w1 (x2+10) ;
sn w0 x2+10 ;
jl. m7. ;
al w2 x2+12 ;
jl. m11. ;
e.
; dbrecdecode
; integer procedure dbrecdecode(z);
; array z;
; (zone record contains the record to be decoded)
; if type<>last decoded then call decodeinternal
; result:=indivlength from dbtable;
;
; dbreccreate
; integer procedure dbreccreate(z,indivtype,record);
; array z; integer indivtype; array record;
; (contents of zone record irrelevant)
; proceed as dbrecdecode and continue with:
; a.2:=indivlength; a.4:=0;
; a.6:=indivtype; a.8:=isodate;
; remaining part of record:= 0;
; insert standardvalues from the constanttable;
;
; dbrectransf
; integer procedure dbrectransf(z,indivtype,record);
; array z; integer indivtype; array record;
; (zone record contains the record to be transformed)
; proceed as dbreccreate and continue with:
; move fix part to record
; move reoccuring fieldgroups to record
;
; alarms:
; dbinitst 0 : dbtable not initialized
; dbinitst 1 : zone (or array) not in dbtable
; param : record param identical to zone param
; recsize <indivsize> : record too short for new indiv
; -create <registerno> : it is prohibited to create in this reg.
; -transf <registerno> : it is prohibited to transf in this reg.
\f
; rc 79.04.20 dbcodes -4-
b. a5, m12, e5 w.
g6: am 2 ; dbrecdecode: type:=4;
g7: am 1 ; dbreccreate: type:=2;
g8: al w1 1 ; dbrectransf: type:=1;
rs. w1 c0. ; save type;
rl. w2 (j13.) ; w2:=last used
ds. w3 (j30.) ; saved last used:=last used
rl. w1 (j1.) ; w1:=basedbtable
sn w1 0 ; if not initialized then
jl. a0. ; alarm(<:dbinitst 0:>);
rl w1 x1+10 ; w1:=addr1
m0: rl w0 x1+2 ; loopzones:
sn w0 (x2+8) ;
jl. m1. ; find similar zone addr
sn w0 -1 ;
jl. a1. ; if not found then
al w1 x1+10 ; alarm(<:dbinitst 1:>);
jl. m0. ;
m1: rl w1 x1+8 ; found: w1:=addr2
; w1=addr2
; w2=last used
rs. w1 c1. ; save addr2
rl w0 x1+12 ; w0:=keys
la. w0 c0. ; leave relevant bit
se w0 0 ; if something prohibited then
jl. a2. ; goto alarm(-create or -transf)
rl w3 (x2+8) ; w3:= recordbase(param1)
rs. w3 c2. ; save recordbase
rl w0 x1-2 ;
rs. w0 (j12.) ; uv:=length last decoded.
rl. w0 c0. ;
sn w0 2 ; if type=dbreccreate then
jl. m3. ; goto decodenew;
rl w2 x3+2 ; w2:=z.indivlength;
rl w0 x3+6 ; w0:=indivtype;
sn w0 (x1) ; if indivtype<>lastdecoded
se w2 (x1-2) ; or z.indivlength<>length last then
jl. w3 p0. ; goto decodeinternal;
rl w0 (x1+8) ; if indivclass<1
rl. w3 c0. ; or type=dbrecdecode
se w3 4 ; then goto algol
sh w0 0 ;
jl. w3 (j7.) ;
rl w0 x1+2 ;
rs. w0 c7. ; c7:=addr of old indivtype;
\f
; rc 79.04.20 dbcodes -5-
; continue if dbreccreate or dbrectransf
rl. w2 (j13.) ; w2:=stack pointer
rl w0 x2+8 ;
sn w0 (x2+16) ; if param1=param3
jl. w3 (j29.) ; then alarm(<:param:>);
m3: ; decodenew:
rl w0 (x2+12) ; w0:=indivtype;
rl w3 x1 ; if indivtype
se w0 x3 ; <>last decoded then
jl. w3 p0. ; decodeinternal;
rl w3 (x1+8) ; w3:=indivclassvar;
sh w3 0 ; if indivclass<1
jl. w3 (j7.) ; then goto algol;
rl w0 x1-2 ; w0:=indivlength;
al w1 1 ; w1:= 1 (first halfword of record)
rl w3 x2+16 ; w3:= dope_address:=
ba w3 x2+14 ; base_word_address + dope_rel
sh w0 (x3-2) ; if indivlength > upper
sh w1 (x3 ) ; or 1 <= lower - k
jl. a4. ; then alarm(<:recsize:>,indivlength);
rl w3 (x2+16) ; w3:=recordbase;
rs. w3 c3. ; c3:=recordbase;
al w1 0 ; record.2:=indivlength;
ds w1 x3+4 ; record.4:=0;
rl w1 (x2+12) ;
rs w1 x3+6 ; record.6:=indivtype;
rl. w1 (j1.) ;
rl w1 x1+8 ;
rs w1 x3+8 ; record.8:=isodate;
rl. w2 (j12.) ;
wa w2 6 ; w2:=addr record.last
al w0 0 ; w0:=0; w1:=0;
al w1 0 ; raf:=0;
sl w2 x3+10 ; if last >= 10 then
rs w0 x2 ; record.last:= 0 (see doubleword loop below)
m4: sh w2 x3+12-1 ; loop:
jl. m5. ;
ds w1 x3+12 ; record.raf(3):=0;
sh w2 x3+16-1 ;
jl. m5. ;
ds w1 x3+16 ; record.raf(4):=0;
sh w2 x3+20-1 ;
jl. m5. ;
ds w1 x3+20 ; record.raf(5):=0;
al w3 x3+12 ; raf:=raf+12;
jl. m4. ; goto loop;
m5: ; end_loop:
\f
; rc 76.10.04 dbcodes -5a-
;
; prepare the insertion of constants.
; the insertion is done on segment 4, but this segment will
; stay in core.
rl. w0 c3. ; w0:= record-base
rl. w1 c1. ; w1:= addr2
rl. w2 (j1.) ; w2:= base_dbtable
rl. w3 (j4.) ; goto
jl w3 x3+g22 ; insert_constants (on segm. 4)
rl. w0 c0. ; if type=dbreccreate
sn w0 2 ; then
jl. w3 (j7.) ; return to algol
\f
; rc 79.04.20 dbcodes -6-
; continue if dbrectransf
rl. w1 c7. ;
rl w1 x1+2 ; w1:=old_addr4;
rl. w2 c1. ; w2:=addr2;
rl w3 x2+10 ;
rs. w3 c6. ; c6:=addr of last field var
al w3 7 ; base:=7;
m8: al w3 x3+2 ; fixloop: base+2;
sl w3 (x2+4) ; if base>fix then
jl. m9. ; exit fixloop;
am. (c2.) ;
rl w0 x3+1 ; w0:=zone.base
am. (c3.) ;
rs w0 x3+1 ; record.base:=w0;
jl. m8. ; goto fixloop;
m9: rl w2 x2+6 ; w2:=addr3
m10: ; testmoveloop:
sl. w2 (c6.) ; if addr3>addr last
jl. w3 (j7.) ; then return to algol;
bz w0 (x2+4) ;
sn w0 0 ; if new rel=0 then
jl. m12. ; goto next;
wa. w0 c3. ;
rs. w0 c5. ; c5:=record.newrel
bz w0 x1 ;
sn w0 0 ; if old rel=0 then
jl. m12. ; goto next;
wa. w0 c2. ;
rs. w0 c4. ; c4:=zone.oldrel
al w3 0 ; i:=0;
m11: al w3 x3+2 ; moveloop: i:=i+2;
am. (c4.) ;
rl w0 x3 ; w0:=z.oldrel.i
am. (c5.) ;
rs w0 x3 ; record.newrel.i:=w0;
se w3 (x2+2) ; if i<>length then
jl. m11. ; goto moveloop;
m12: al w2 x2+6 ; next: addr3:=addr3+6;
al w1 x1+2 ; addr4:=addr4+2;
jl. m10. ; goto testmoveloop;
\f
; rc 79.04.20 dbcodes -7-
; alarms:
a0: am -1 ; number:=0;
a1: al w1 1 ; number:=1;
al. w0 e2. ; text:=dbinitst
jl. w3 (j21.) ; goto general alarm
a2: ; -create or -transf
se w0 1 ; skip if transf
am e0 ; text:=-create
al. w0 e4. ; text:=-transf
rl w1 x1-4 ; number:=registerno
jl. w3 (j21.) ; goto general alarm
a4: al w1 (0) ; number:=indivlength;
al. w0 e3. ; text:=recsize
jl. w3 (j21.) ; goto general alarm
e1: <:<10>-create:> ;
e2: <:<10>dbinitst:> ;
e3: <:<10>recsize:> ;
e4: <:<10>-transf:> ;
e0=e1-e4
g5: ; no.of externals, byte to be init, init value
; date, clock
c0: 0 ; saved proceduretype
c1: 2 ; 0 ; saved addr2
c2: 0 ; saved zonebase
c3: s3 ; 0 ; saved recordbase
c4: s4 ; saved z.field
c5: 0 ; saved record.field
c6: 0 ; saved addr of last fieldvar
c7: 0 ; saved addr of old indivtype
e.
m. rc 76.10.04 decodeinternal
m. dbrecdecode dbreccreate dbrectransf
h.r.g4.+503 w.
jl. p0. ; call from cf/procedures
<:dbdecode<0><0>:>
e.
e. ; segment 1
\f
; rc 75.04.11 dbcodes -8-
b. p1
s. j30 w.
k=0 h.
g10: g11, g12 ; rel last point, rel last abs word
j0: 1<11o.1, 0 ; segm.table addr next segm
j1: 0, 1 ; own core byte basedbtable
j8: 8, 0 ; rs end addr expr
j13: 13, 0 ; rs last used
j21: 21, 0 ; rs general alarm
j30: 30, 0 ; rs saved stack ref, saved w3
g11=k-2-g10
g12=k-2-g10
w.
; procedure initdbtable(dbtable,registerno,z,indivclassname,
; fieldgroupno,fieldvarname,
; ...
; ... );
; zone dbtable; array z;
; integer registerno,indivclassname,fieldgroupno,fieldvarname;
; indivclassname and fieldvarname must not be constants
; or expressions.
;
; alarms:
; blockjam 0 : zone declared external to dbtable
; blockjam 1 : zone declared external to fieldvariable
; -dbfield <fieldgroupno> : fieldgroupno in dbtable was
; expected as parameter
; +initdb <registerno> : initialization of 2 dbtables attempted.
; param <paramno> : 1) param is not integer
; 2) param must not be a constant
; 3) too many param
; -startdb <registerno> : dbtable has not been started
; -regno <registerno> : register not found in dbtable
; +regno <registerno> : this register is already initialized
; +zone <old registerno>: this zone (or array) was earlier specified
; together with register <registerno>.
; z.state <zonestate> : cf-register is not opened.
\f
; rc 76.10.04 dbcodes -9-
; the procedure is called after the algol procedure startdbtable,
; which sets the zone state to 25, recordlength to zero and leaves
; the following contents in dbtable: (addrn=byten+basedbtable)
;
; byte:
; (2) size of dbtable
; (4) 0 (changed by first call of initdbtable to basedbtable)
; (6) 0 (changed by first call of initdbtable to zone descr.
; addr. dbtable)
; (8) 0 (changed by first call of initdbtable to isodate)
; (10) byte1 (changed by first call of initdbtable to addr1)
; (12) constanttable, rel.to basedbtable, changed to abs base.
; (14) recdescrtable, rel.to basedbtable, changed to abs base.
; ...
; !------------!---------------!---!---------!--------------!
; (byte1) !registerno1 ! 0 ! -1!file type!byte2-byte1 !
; ! !(changed by ! or! !(changed by !
; ! !initdbtable to ! 0 ! !initdbtable to!
; ! !zone descr addr! ! !addr2) !
; ! !reg. zone) ! ! ! !
; ! ... ! ... ! !... !... !
; !------------!---------------!---!---------!--------------!
; ! 8388607 ! -1 !
; !------------!---------------!
; and for each register:
; !-----------------------!
; ! registernumber !
; ! 0 ! (length of last decoded indiv)
; (byte2) ! 0 ! (last decoded indivtype)
; ! 0 ! (addr of last indivtype)
; ! length of fixed part !
; ! byte3-byte2 (or 0) ! (changed by initdbtable to addr3)
; ! 0 ! (changed by initdbtable to addr
; ! ! of indivclass variable)
; ! no. of fieldgroups ! (changed by initdbtable to addr
; ! ! of last fieldvariable addr)
; ! regindex, keys !
; !-------------!-----------------!--------------!----------------!
; ! indivtype1 ! byte4-byte2(or 0! length of ! indivclass !
; ! ! (changed by ! indiv ! !
; ! ! initdbtable to ! ! !
; ! ! addr4) ! ! !
; ! ... ! ... ! ... ! ... !
; !-------------!-----------------!--------------!----------------!
; ! 8388607 ! -1 !
; !-------------!-----------------!
;
; !-------------!--------------!----------------!
; (byte3) ! fieldgroupno! length ! 0 !
; ! ! of fieldgr ! (changed by !
; ! ! ! initdbtable to !
; ! ! ! addr of field !
; ! ! ! variable) !
; ! ... ! ... ! ... !
; !-------------!--------------!----------------!
; ! 8388607 !
; !-------------!
;
; !---------------!---------------!---------------!--------
; (byte4.1) ! modif<12+rel1 ! modif<12+rel2 ! modif<12+rel3 ! .....
; (byte4.2) ! or 0 ! or 0 ! or 0 ! ...
; ! ... ! ... ! ... ! .
; !---------------!---------------!---------------!--
;
; registernumbers, indivtypes and fieldgroupnumbers are sorted.
\f
; rc 78.10.18 dbcodes -10-
b. a12, b16, c6, e8, m16 w.
g9: rl. w2 (j13.) ; w2:=last used
ds. w3 (j30.) ; saved last used:=last used
rl w3 x2+8 ; w3:=zone descr addr dbtable;
rl w0 x3+h2+6 ; w0:=zone state
rl w1 x3+h0+0 ; w1:= base dbtable
sn w0 26 ; if w0 = 26 <* after init *> then
jl. m0. ; goto check_base;
se w0 25 ; if zonestate<>25 then
jl. a0. ; alarm(-startdb);
rl w0 x3+h3+4 ; w0:=dbreclength;
se w0 0 ; if reclength<>0 then
jl. a0. ; alarm(-startdb);
al w0 26 ; zonestate:= 26; <* after init *>
rs w0 x3+h2+6 ;
; initialize base_dbtable and the head of dbtable
rs. w1 (j1.) ; basedbtable:=base dbtable
rs w1 x1+4 ; dbtable(2):=basedbtable;
rs w3 x1+6 ; dbtable(3):=zone descr addr dbtable
rl. w3 (j0.) ;
jl w3 x3+p0 ; get isodate
al w0 x1 ;
rl. w1 (j1.) ; restore w1
rl. w2 (j13.) ; restore w2
rl w3 x2+8 ; restore w3
rs w0 x1+8 ; dbtable(4):=isodate;
al w0 x1 ; dbtable(5):=dbtable(5)
wa w0 x1+10 ; +basedbtable;
rs w0 x1+10 ;
al w0 x1 ; add basedbtable to dbtable(6);
wa w0 x1+12 ;
rs w0 x1+12 ;
al w0 x1 ; add basedbtable to dbtable(7)
wa w0 x1+14 ;
rs w0 x1+14 ;
; now the initilization is over.
m0: rl. w0 (j1.) ; check_base:
se w0 x1 ; if w1<>basedbtable then
jl. a1. ; alarm(+initdb);
rl w1 x1+10 ; w1:=addr1
rs. w1 c0. ; save addr1
rl w0 (x2+12) ; w0:=registerno
m1: sh w0 (x1+0) ; loop:
jl. m6. ; find regno in dbtable
sh w0 (x1+10) ;
jl. m5. ;
sh w0 (x1+20) ;
jl. m4. ;
al w1 x1+30 ;
jl. m1. ;
m4: am 10 ;
m5: al w1 x1+10 ;
m6: se w0 (x1) ; if not found then
jl. a2. ; alarm(<:-regno:>);
rs. w1 c2. ; save found addr.
\f
; rc 76.10.04 dbcodes -11-
rl w0 x2+16 ; w0:=zone descr
rl w1 x1+2 ; w1:=stored zone
rl w3 (x2+12) ; w3:=regno
se w1 0 ; if stored zone<>0 then
jl. a3. ; alarm(+regno);
rl. w3 c0. ; w3:=addr1;
al w1 -1 ; w1:=end value;
m8: sn w0 (x3+2) ; loopzones: if param=
jl. a4. ; stored zone then alarm(+zone);
al w3 x3+10 ;
se w1 (x3+2) ; if not endvalue then
jl. m8. ; goto loopzones;
rl w0 x2+16 ; stored zone:=param
m9: rl. w1 c2. ; w1:=found addr;
rs w0 x1+2 ; store zone descr addr
rl w3 (x2+16) ; w3:=base zonebuf
rs. w3 c6. ; save zonebase
sl w3 (x2+8) ; if zone declared external to
jl. a5. ; dbtable then alarm(blockjam 0);
rl w3 x1+8 ;
wa. w3 c0. ;
rs w3 x1+8 ; byte2:=addr2
rs. w3 c1. ;
rl w0 x1+6 ;
sh w0 4 ; if filetype=3 or
sh w0 2 ; filetype=4 then
jl. m10. ; begin
bz w1 x2+15 ; if not zone
se w1 23 ; then
jl. m10. ; skip;
rl w1 x2+16 ; comment cf;
rl w0 x1+h2+6 ; w0:=zonestate;
sl w0 15 ; if zonestate<15 or
sl w0 25 ; or zonestate>25 then
jl. a7. ; alarm(z.state);
; cf-names
b1=0
b3=b1+4
b4=b3+6
b5=b4+4
b6=b5+2
b8=b6+2
b9=b8+2
b14=b9+2
b15=b14+2
b16=b15+2
rl w1 x1+h0+0 ; w1:=base buf;
wa w1 x1+3 ; w1:=cf-buf-ref;
rl w1 x1+b16 ; zbuffer:=addr2;
rs w3 x1-2 ; end cf;
\f
; rc 76.10.04 dbcodes -12-
m10: rl w1 x3+6 ;
se w1 0 ;
wa. w1 c1. ; w1:=addr3;
rs w1 x3+6 ; byte3:=addr3;
rs. w1 c0. ; c0:=addr3
rl w1 x2+20 ;
rs w1 x3+8 ; save addr of indivclass
al w0 x2+6 ;
ba w0 x2+4 ; upperlimit:=stackref+6+appetite;
rs. w0 c4. ; c4:=upper limit;
rs. w0 c2. ; c2:=upper limit;
sl w0 x1 ; if indivclassvar=constant
sh w1 x2+6 ;
se w1 x1 ;
jl. a10. ; then alarm(param 4);
rl w1 x2+18 ;
se w1 26 ; if not integer then
jl. a10. ; alarm(param 4);
al w0 0 ; set indivclass to zero;
rs w0 (x3+8) ;
rl w1 x3+10 ;
sn w1 0 ;
jl. m11. ;
al w0 6 ;
wm w1 0 ; number of fieldvar:=
al w1 x1-2 ; addr of last
wa w1 x3+6 ;
rs w1 x3+10 ;
m11: al w1 x3+14 ; w1:=addr first indivtype;
m12: rl w3 x1+2 ; w3:=byte4;
sn w3 -1 ; exit if -1
jl. m13. ;
se w3 0 ; if byte4<>0 then
wa. w3 c1. ; byte4:=addr4;
rs w3 x1+2 ;
al w1 x1+8 ;
jl. m12. ;
m13: al w3 x2+29-8 ; curparamadr:=stackref+29-8;
rs. w3 c5. ; c5:=cur param
m14: rl. w3 c5. ; paramloop:
al w3 x3+8 ; curparamadr:=curparamadr+8;
sl. w3 (c4.) ; if addr>=upper limit then
jl. m16. ; goto test last fieldgr
rs. w3 c5. ; save curparamaddr
bl w1 x3-6 ;
se w1 26 ; if first param not integer then
jl. a11. ; goto param alarm
bl w1 x3-2 ;
se w1 26 ; if sec.param not integer then
jl. a12. ; goto param alarm
rl w1 x3-4 ; w1:=addr first param
sl. w1 (c4.) ; if addr<upperlimit and
jl. m15. ; addr>=first param addr then
sl w1 x2+6 ; upperlimit:=addr;
rs. w1 c4. ;
\f
; rc 75.04.11 dbcodes -13-
m15: rl w1 x3 ;
sh. w1 (c2.) ; if constant then
sh w1 x2+6 ;
se w1 x1 ;
jl. a12. ; param alarm
rl. w1 c0. ; w1:=addr3
sn w1 0 ; if no param expected
jl. a11. ; then alarm(param);
rl w0 x1 ; if too many param
sn. w0 (c3.) ; then alarm(param);
jl. a11. ;
rl w0 (x3-4) ; w0:=param fieldgrno
se w0 (x1) ; if param<>field in table then
jl. a8. ; alarm(-dbfield);
al w1 x1+6 ;
rs. w1 c0. ; addr3:=addr3+6;
rl w0 x3 ;
sh. w0 (c6.) ; if zone declared external to
sh w0 x2+6 ;
se w3 x3 ;
jl. a6. ; fieldvar then alarm(blockjam 1);
rs w0 x1+4-6 ; store fieldvar addr in dbtable
al w0 0 ;
rs w0 (x3) ; fieldvar:=0;
jl. m14. ;
m16: rl. w1 c0. ; if cur fieldgr in dbtable
sn w1 0 ; exists and
jl. w3 (j8.) ;
rl w1 x1 ;
sn. w1 (c3.) ; <>end value then
jl. w3 (j8.) ; goto algol;
jl. a9. ; else alarm(-dbfield);
\f
; rc 76.10.04 dbcodes -14-
e0: <:<10>-startdb:> ;
e1: <:<10>+initdb :> ;
e2: <:<10>-regno :> ;
e3: <:<10>+regno :> ;
e4: <:<10>+zone :> ;
e5: <:<10>blockjam:> ;
e6: <:<10>z.state :> ;
e7: <:<10>-dbfield:> ;
e8: <:<10>param :> ;
a0: am e0-e1 ; text:=-startdb
a1: am e1-e2 ; text:=+initdb
a2: am e2-e3 ; text:=-regno
a3: al. w0 e3. ; text:=+regno
rl w1 (x2+12) ; number:=registerno
jl. w3 (j21.) ; goto general alarm
a4: rl w1 x3 ; number:=old regno
al. w0 e4. ; text:=+zone
jl. w3 (j21.) ; goto general alarm;
a5: am -1 ; number:=0;
a6: al w1 1 ; number:=1;
al. w0 e5. ; text:=blockjam
jl. w3 (j21.) ; goto general alarm;
a7: al w1 (0) ; number:=zonestate
al. w0 e6. ; text:=z.state
jl. w3 (j21.) ; goto general alarm;
a8: rl w1 x1 ; number:=field in dbtable;
a9: al. w0 e7. ; text:=-dbfield
jl. w3 (j21.) ; goto general alarm
a10: al w3 x2+25 ; number:=4;
a11: am -4 ;
a12: al w1 x3-5 ;
ws w1 4 ;
ls w1 -2 ;
al. w0 e8. ; text:=param
jl. w3 (j21.) ; goto general alarm;
c0: 0 ; addr1, addr3
c1: 0 ; addr2
c2: 0 ; found reg addr, upper limit
c3: 8388607 ; last fieldgroup
c4: 0 ; cur. upper limit
c5: 0 ; cur. param
c6: 0 ; zonebase
e.
m. rc 76.10.04 initdbtable
0, h.r.g10.+505
w. <:initdbtable<0>:> ;
e. ; segment 2
\f
; rc 75.04.11 dbcodes -15-
s. j30 w.
k=0 h.
g13: g15 , g14 ; rel.last point,rel abs word
j1: 0 , 1 ; own dbtable
j6: 6 , 0 ; rs end reg expr
j7: 7 , 0 ; end uv expr
j12: 12 , 0 ; uv
j13: 13 , 0 ; rs last used
j21: 21 , 0 ; general alarm
j30: 30 , 0 ; rs saved last used
g14=k-2-g13
g15=k-2-g13
w.
g16:
; integer procedure isodate
b. c8 w.
rl. w2 (j13.) ; w2:=last used;
rs. w3 (j30.) ; saved last used:=last used;
rl. w3 j6. ; return:=end uv expr
p1: ; entry from initdbtable:
p0=p1-g13
rs. w3 c0. ; save return addr
jd 1<11+36 ; w0w1:=get clock
nd w1 3 ; float
fd. w1 c8. ; div by 10000
bl w3 3 ;
ad w1 x3-47 ; normalize
wd. w1 c6. ; day:=sec//86400;
ld w1 26 ; year:=(day*4
wa. w0 c7. ; +99111
al w3 0 ; //1461;
wd. w0 c4. ;
as w3 -2 ; day:=day*4+99111 mod 1461//4;
wm. w3 c1. ; month:=day*5
al w3 x3+461 ; +461
wd. w3 c3. ; //153;
al w1 x2+5 ; day:=(day*5+461) mod 153 + 5;
sl w3 13 ; if month>13 then
al w3 x3+88 ; month:=month-twelvemonth+oneyear;
wm. w3 c2. ; month:=month*100;
rx w2 0 ;
wd. w1 c1. ; day:=day//5;
wa w3 2 ; date:=day+month;
wm. w2 c5. ; year:=year*10000;
wa w3 4 ; date:=date+year;
al w1 x3 ; w1:=date;
jl. w3 (c0.) ; return
c0: 0 ; return addr
c1: 5 ;
c2: 100 ;
c3: 153 ; days in the 5 month march-july
c4: 1461 ; days in 4 years
c5: 10000 ;
c6: 86400 ; seconds in 24 hours
c7: 99111 ; to adjust for 1.1.68 being date 0
10000<9 ; 10000*
c8: 4096+14-47 ; 2**(-47) as floating point number
e.
\f
; rc 75.04.11 dbcodes -16-
; connectdb
; integer procedure connectdb(connect,a,z);
; boolean connect; array a; zone z;
;
; connectdb (return value, integer) registernumber (see connect)
;
; connect (call value, boolean)
; true (connect)
; a is searched in the dbtable.
; connectdb:=registerno of a.
; if not found then alarm(dbinitst 1).
; a is replaced by z in the dbtable.
; a is saved for later check when deconnect.
; if a is described as connected to cfzone,
; then addr2 is stored in the zonebuffer
; false (deconnect)
; z is searched in the dbtable.
; connectdb:=registerno of z.
; if not found the alarm(dbinitst 1).
; a is restored in the dbtable
; false add 1 (only registernumber)
; a is searched in the dbtable
; connectdb:=registerno of a (or 0)
; false add 2 (only registerno)
; z is searched in the dbtable
; connectdb:=registerno of z (or 0)
; a (call value, array) array which is earlier used in a call
; of initdbtable
; z (call value, zone) zone which has a one to one relation to a,
; but which is for storage reasons declared
; in a later block.
;
; alarms:
; dbinitst 0 : dbtable is not initialized
; dbinitst 1 : array(connect) or zone(deconnect) not in dbtable
; array cannot be found if already connected
; -regno <registerno> : connect: a must not be connected
; deconnect: a is not connected to z
; +zone <registerno> : z is already connected to another register
; z.state <zonestate> : cfzone is not opened.
;
\f
; rc 75.04.11 dbcodes -17-
g17:
b. a5, b16, c0, e4, m4
w.
rl. w2 (j13.) ; w2:=last used;
ds. w3 (j30.) ; saved last used:=last used;
rl. w1 (j1.) ; w1:=basedbtable;
sn w1 0 ; if not initialized then
jl. a0. ; alarm(dbinitst 0);
rl w1 x1+10 ; w1:=addr1
rs. w1 c0. ; save addr1
bl w0 (x2+8) ; w2:=connect
rl w3 x2+12 ; w3:=a
so w0 1 ; if connect=false or false add 2
rl w3 x2+16 ; then w3:=z;
m0: rl w0 x1+2 ; loopzones:
sn w0 x3 ; find similar zone
jl. m2. ;
sn w0 -1 ;
jl. m1. ;
al w1 x1+10 ;
jl. m0. ;
m1: al w0 0 ; if not found then
se w1 x1 ; regno:=0
m2: rl w0 x1 ; else regno:=found;
rs. w0 (j12.) ; uv:=regno;
bl w0 (x2+8) ; if connect
sl w0 1 ; =false add x
jl. (j7.) ; then return to algol;
rl. w3 (j12.) ; if regno=0
sn w3 0 ; then
jl. a1. ; alarm(dbinitst 1);
se w0 0 ;
jl. m3. ; if deconnect then
; begin
rl w3 x2+12 ; if dbtable(no,3)<>a
se w3 (x1+4) ; then
jl. a3. ; alarm(-regno);
rs w3 x1+2 ; dbtable(no,2):=a;
al w3 0 ;
rs w3 x1+4 ; dbtable(no,3):=0;
jl. (j7.) ; return to algol
\f
; rc 75.04.11 dbcodes -18-
m3: rl w3 x1+4 ; if dbtable(no,3)
se w3 0 ; <>0 then
jl. a3. ; alarm(-regno);
rl. w3 c0. ; w3:=addr1;
rs. w1 c0. ; store addr reg
rl w0 x2+16 ; w0:=z;
al w1 -1 ;
m4: sn w0 (x3+2) ; search zone:
jl. a4. ; if found then alarm(+zone);
al w3 x3+10 ;
se w1 (x3+2) ;
jl. m4. ;
rl. w1 c0. ;
rs w0 x1+2 ; dbtable(no,2):=z;
rl w0 x2+12 ;
rs w0 x1+4 ; dbtable(no,3):=a;
rl w0 x1+6 ; if filetype=3 or
sh w0 4 ; filetype=4
sh w0 2 ; then
jl. (j7.) ; begin
rl w3 x2+16 ; comment cf;
rl w0 x3+h2+6 ; w0:=zonestate;
sl w0 15 ; if zonestate<15 or
sl w0 25 ; zonestate>25 then
jl. a5. ; alarm(z.state);
; cf-names
b1=0
b3=b1+4
b4=b3+6
b5=b4+4
b6=b5+2
b8=b6+2
b9=b8+2
b14=b9+2
b15=b14+2
b16=b15+2
rl w3 x3+h0+0 ; w3:=base buffer
wa w3 x3+3 ; w3:=cf-buf-ref;
rl w3 x3+b16 ;
rl w1 x1+8 ; w1:=addr2
rs w1 x3-2 ; z-cf-buffer:=addr2;
jl. (j7.) ; end cf;
c0: 0 ; addr1, addr regno
\f
; rc 76.10.04 dbcodes -19-
e0: <:<10>dbinitst<0>:> ;
e1: <:<10>-regno:> ;
e3: <:<10>+zone<0>:> ;
e4: <:<10>z.state:> ;
a0: am -1 ; no:=0
a1: al w1 1 ; no:=1
al. w0 e0. ; text:=dbinitst
jl. w3 (j21.) ; goto general alarm;
a3: al. w0 e1. ; text:=-regno
rl w1 x1 ; no:=registerno
jl. w3 (j21.) ; goto general alarm;
a4: al. w0 e3. ; text:=+zone;
rl w1 x3 ; no:=registerno
jl. w3 (j21.) ; goto general alarm
a5: rl w1 0 ; no:=zonestate
al. w0 e4. ; text:=z.state
jl. w3 (j21.) ; goto general alarm;
e.
\f
; rc 76.10.04 dbcodes -20-
;
;
; dbrecdescr
; integer procedure dbrecdescr(register, registerno, iclass);
; real array register ;
; integer registerno, iclass ;
;
; dbrecdescr(return value, integer)
; 1 ok, registerno and iclass corresponds to the
; last decoded record of register.
; if iclass (indivclass) > 0 then the zone
; record of dbtable points to the descripion
; of this recordtype.
; 2 dbtable does not contain the recorddescrip-
; tion table.
; registerno and iclass as for result 1.
; 3 register does not correspond to any register.
; registerno and iclass are both set to -999999.
;
; register (call value, real array or zone record)
; must be connected to dbtable as a register by
; either initdbtable or connectdb.
; it identifies the register.
;
; registerno(return value, integer) see above.
;
; iclass (return value, integer) indivclass, see above.
;
; alarms:
; dbinitst 0 : dbtable is not initialized.
;
\f
; rc 76.10.04 dbcodes -21-
;
; the procedure accesses the decodetable to find the register.
; from the register entry it fetches the registernumber and the
; indivclass.
; if the indivclass is positive, it uses regindex and the address
; of the last decoded indivtype from the registerentry to access the
; recorddescription table.
; the structure of the recorddescription table is this:
;
; abs base of recorddescriptions = dbtable(7)
;
; !--------------------------------------!
; ! rel.base reg.descr.(regindex 2) !
; ! rel.base reg.descr.(regindex 4) !
; ! ... !
; !--------------------------------------!
;
; abs base of recorddescriptions for one register =
; dbtable(7) + rel.base reg.descr.
;
; !--------------------------------------!
; ! rel.base recorddescr.(itypindex 2) !
; ! rel.base recorddescr.(itypindex 4) !
; ! ... !
; !--------------------------------------!
;
; abs base of recorddescription of one recordtype (itype) =
; abs base for one register + rel.base recorddescr.
;
; !--------------------------------------!
; ! length of recorddescription !
; ! field descriptions !
; ! ... !
; !--------------------------------------!
;
; the format of the field descriptions is irrelevant for this
; procedure, since it just selects the piece of table correspon-
; ding to the last decoded recordtype as zone record of dbtable.
; the use of the recorddescription is left for other systems,
; f.ex. dbrecprint, which is coded in algol.
;
\f
; rc 76.10.04 dbcodes -22-
;
g18: ; dbrecdescr:
b. a0, c0, e0, m4
w.
rl. w2 (j13.) ; w2:= last_used
ds. w3 (j30.) ; saved last_used:= last_used
rl. w1 (j1.) ; w1:= base_dbtable
sn w1 0 ; if not_initialized then
jl. a0. ; alarm(dbinitst 0)
rl w3 x2+8 ; w3:= zone_addr (register)
rl w1 x1+10 ; w1:= addr1:= dbtable(5);
m0: ; loop_zones:
rl w0 x1+2 ; w0:= zone_addr(x1)
sn w0 x3 ; if addr_from_table = register then
jl. m3. ; goto zone_found;
al w1 x1+10 ; w1:= next_registertable_index
se w0 -1 ; if last_zone_addr_in_table <> stop (-1) then
jl. m0. ; goto loop_zones
; notfound:
rl. w0 c0. ;
rs w0 (x2+12) ; registerno:= -999999
rs w0 (x2+16) ; iclass := -999999
am 1 ; result_3:
m2: al w1 2 ; result_2:
jl. (j6.) ; end register expression
c0: -999999 ; dummy registerno and iclass
m3: ; zonefound:
rl w0 x1 ;
rs w0 (x2+12) ; registerno:= registerno(x1)
rl w1 x1+8 ; w1:= addr2
rl w0 (x1+8) ;
rs w0 (x2+16) ; iclass:= iclass(iclassvar(registerentry))
sh w0 0 ; if iclass <= 0 then
jl. m4. ; goto result_1 (no change of zonerecord)
\f
; rc 76.10.04 dbcodes -23-
;
; now find the recorddescription if the recdescr.table is present.
rl. w2 (j1.) ; w2:= base_dbtable
rl w3 x2+14 ; w3:= base_recdescrtable
sh w3 x2 ; if base_recdescrtable <= base_dbtable then
jl. m2. ; goto result_2
bz w2 x1+11 ; w2:= regindex(2, 4, 6, 8, ...)
am x3 ;
rl w2 x2 ; w2:= word(base_recdescrtable + regindex)
wa w3 4 ; w3:= base_recdescr.table for this register
ac w2 x1+14 ; w2:= itypeindex(0, 2, 4, 6, ...):=
wa w2 x1+2 ; (addr_of_last_decoded_itype - addr_of_first)
ls w2 -2 ; //4
am x3 ;
rl w2 x2+2 ; w2:= word(base_recdescr.table_this_register
; + itypeindex + 2)
wa w2 6 ; w2:= abs base of recorddescription.
rl. w1 (j1.) ; w1:= base_dbtable
rl w1 x1+6 ; w1:= zone_descr_addr_dbtable:= dbtable(3)
rs w2 x1+h3+0 ; recordbase(dbtable):= base of recorddescription.
rl w0 x2+2 ;
rs w0 x1+h3+4 ; recordsize(dbtable):= word(recbase + 2)
m4: ; result_1:
al w1 1 ;
jl. (j6.) ; end register expression
a0: ; alarm(dbinitst 0):
al w1 0 ;
al. w0 e0. ; w0:= textaddress
jl. w3 (j21.) ; general alarm
e0: <:<10>dbinitst<0>:>
e.
m. rc 76.10.04 isodate connectdb dbrecdescr
0, h.r.g13.+505
w. <:connectdb<0>:>
e. ; segment 3
\f
; rc 76.10.04 dbcodes -24-
;
s.
w. k=0
h.
g19: g21 , g20 ; rel. last point, rel. last absword
g20=k-2-g19 ;
g21=k-2-g19 ;
w.
; insert_constants
; this is an extension of dbreccreate on segment 1.
; it may not access other program segments.
;
; the extension accesses the constanttable in much the same way as
; the procedure dbrecdescr (on segment 3) accesses the record-
; description table.
; some of the initialization has of course been done by dbreccreate,
; but the structure of the accesstables on register- and recordtype-
; level is the same.
; the only difference here is that the table indexed by itypeindex
; is a byte-table and not a word-table, due to the expected more
; limited size of the constanttable.
; (one field will only occur one time, and only if it is associated
; with a standard value).
; an entry in the accesstables may hold a zero to indicate that
; there are no constants at all, either for the register or the
; recordtype.
; but if a nonzero address has been calculated, it will point to
; a constantlist, which is interpreted in the order of decreasing
; addresses.
; a constantlist consists of elements of at least one word, the
; headword:
;
; base_address < 13 + length < 3 + constanttype
;
; the base_address is relative to recordbase or to fieldgroupbase.
; the interpretation is controlled by the constanttype:
;
; 0 stop, ref. to fieldgroup or ref. to constantlist.
; the exact interpretation depends on the values of
; base_address and length:
; 0 0 stop
; 0 >0 jump to other list
; no return.
; >0 >0 jump to fieldgroup
; with this base_address.
; return to actual list.
; 1 0 end of fieldgroup.
;
; the entry to another constantlist or to a fieldgroup
; is found by using length as the index to the access-
; table earlier indexed by itypeindex.
\f
; rc 76.10.04 dbcodes -25-
;
; constanttype: (continued)
; 1 immediate byte, length is stored at storebase + 1
; 2 immediate word, length is stored at storebase + 2
; 3 immediate long, length is stored at storebase + 4
; 4 byte, the following word is stored as a byte at
; storebase + 1
; 5 word array, the following word is stored as a word
; at storebase + 2, .... storebase + length.
; (it is stored at least once even if length = 0).
; 6 long array, the following long is stored as a long
; at storebase + 4, .... storebase + length.
; 7 words, the following length bytes of words, (still in
; decreasing address order) are stored at storebase + 2,
; ..... storebase + length.
; (i.e. the core is rotated on wordlevel).
;
; the storebase is the recordbase or the fieldgroupbase incremented
; with the base_address from the headword.
\f
; rc 76.10.04 dbcodes -26-
;
b. a1, c5, m71
w.
c0: 0 ; return address
c1: 0 ; abs storebase (c0 c1 = long)
c2: 0 ; saved list address (c1 c2 = long)
c3: 0 ; record base (c2 c3 = long)
c4: 0 ; base of itype access table
c5: 0 ; saved last store addr
g22: ; insert_constants:
; entered from dbreccreate on segment 1 with:
; w0 = record base
; w1 = addr2 in dbtable
; w2 = basedbtable
; w3 = return address
;
ds. w0 c1. ; save return address
rs. w0 c3. ; save record base
; now find the start of the relevant constantlist.
rl w3 x2+12 ; w3:= base constanttable:= dbtable(6)
sh w3 x2 ; if dbtable(6) <= base_dbtable then
jl. (c0.) ; goto return;
bz w2 x1+11 ; w2:= regindex (0, 2, 4, ...)
am x3 ;
rl w2 x2 ; w2:= word(base constanttable + regindex)
sh w2 0 ; if regentry <= 0 then
jl. (c0.) ; goto return
wa w3 4 ; w3:= base itype access table
rs. w3 c4. ; save base itype access table
ac w2 x1+14 ; w2:= itypeindex(0, 1, 2, ...):=
wa w2 x1+2 ; (addr_last_decoded_itype
ls w2 -3 ; - addr_first_itype)//8
am x3 ;
bz w2 x2+1 ; w2:= byte(base_itype_access_table
; + itypeindex + 1)
sn w2 0 ; if itypeentry = 0 then
jl. (c0.) ; goto return
wa w3 4 ; w3:= list_address:= base_itype_access_table
; + itypeentry
\f
; rc 76.10.04 dbcodes -27-
;
; note that the constantlist is interpreted in the order of decreasing
; list address, so the list address is always decremented.
;
; w3 = list_addr
a0: ; next_list_element:
rl w2 x3 ; w2:= head_word
al w3 x3-2 ; decrement list_addr
al w1 2.111 ; w1:= constant_type:=
la w1 4 ; head_word extract 3
ls w2 -3 ; w2:= head_word shift(-3)
al w0 2.1111111111; w0:= length:=
la w0 4 ; head_word shift(-3) extract 10
ls w2 -10 ; w2:= store_base:=
wa. w2 c1. ; abs_store_base + head_word shift(-13)
bz. w1 x1+a1. ; goto
jl. x1+2 ; case constant_type of
; (m0, m10, m20, m30, m40, m50, m60, m70)
; w0 = length
; w2 = store_base
; w3 = list_addr ready for next element
m0: ; jump:
se. w2 (c1.) ; if base_address <> 0 then
jl. m2. ; goto field_group
; stop or ref. to other constantlist:
sn w0 0 ; if length = 0 then
jl. (c0.) ; goto return
m1: ; get_new_list_addr:
wa. w0 c4. ; w3:= list_addr:=
bz w3 (0) ; byte(length + base_itype_accesstable)
wa. w3 c4. ; + base_itype_accesstable
jl. a0. ; goto next_list_element
m2: ; field_group:
sn w0 0 ; if length = 0 then
jl. m3. ; goto end_field_group
; jump to field_group:
ds. w3 c2. ; save abs_store_base, list_addr
jl. m1. ; goto get_new_list_addr
m3: ; end_field_group:
dl. w0 c3. ; w3:= saved_list_addr
rs. w0 c1. ; abs_store_base:= record_base
jl. a0. ; goto next_list_element
\f
; rc 76.10.04 dbcodes -28-
;
m10: ; immediate byte:
hs w0 x2+1 ;
jl. a0. ;
m20: ; immediate word:
rs w0 x2+2 ;
jl. a0. ;
m30: ; immediate long:
al w1 0 ;
rs w1 x2+2 ;
rs w0 x2+4 ;
jl. a0. ;
m40: ; byte:
rl w1 x3 ; byte(store_base + 1):=
hs w1 x2+1 ; word(list_addr)
al w3 x3-2 ; decrement list_addr
jl. a0. ;
m50: ; word array:
wa w0 4 ; w0:= last_store_addr
rl w1 x3 ; w1:= word(list_addr)
al w3 x3-2 ; decrement list_addr
m51: ; store_word:
rs w1 x2+2 ; word(store_base + 2):= w1
sh w0 x2+2 ; if last_store_addr <= store_base + 2 then
jl. a0. ; goto next_list_element
al w2 x2+2 ; increment store_base
jl. m51. ; goto store_word
m60: ; long array:
wa w0 4 ;
rs. w0 c5. ; c5:= last_store_addr
dl w1 x3 ; w0w1:= long(list_addr)
al w3 x3-4 ; decrement list_addr
m61: ; store_long:
ds w1 x2+4 ; long(store_base + 4):= w0w1
al w2 x2+4 ; increment store-base
sl. w2 (c5.) ; if store_base >= saved_last_store_addr then
jl. a0. ; goto next_list_element
jl. m61. ; goto store_long
\f
; rc 76.10.04 dbcodes -29-
;
m70: ; words:
wa w0 4 ; w0:= last_store_addr
m71: ; move_word:
rl w1 x3 ; word(store_base + 2):=
rs w1 x2+2 ; word(list_addr)
al w3 x3-2 ; decrement list_addr
sh w0 x2+2 ; if last_store_addr <= store_base + 2 then
jl. a0. ; goto next_list_element
al w2 x2+2 ; increment store_base
jl. m71. ; goto move_word
; case table for the branching on constanttype
a1:
h. m0-m0, m10-m0, m20-m0, m30-m0, m40-m0, m50-m0, m60-m0, m70-m0 w.
e. ; end insert_constants;
m. rc 76.10.04 insert_constants
0, h.r.g19.+505
w. <:dbreccreate:>
e. ; segment 4
e.
\f
; rc 78.10.18 dbcodes -30-
g0: 3 ; dbrecdecode entry description:
0, r.4 ; docname
1<23+g6-g4 ; entry point
3<18+26<12 ; integer proc, array param
0 ; param spec2
4<12+g5-g4 ; external list
4<12+2 ; code segm, own bytes
1<23+4 ; dbreccreate entry description:
0, r.4 ; docname
1<23+g7-g4 ; entry point
3<18+26<12+19<6+26 ; integer proc,array,integer,array
0 ; param spec2
4<12+g5-g4 ; external list
4<12+2 ; code segm, own bytes
1<23+4 ; dbrectransf entry description:
0, r.4 ; docname
1<23+g8-g4 ; entry point
3<18+26<12+19<6+26 ; integer proc,array,integer,array
0 ; param spec2
4<12+g5-g4 ; external list
4<12+2 ; code segm, own bytes
1<23+4 ; initdbtable entry description:
0, r.4 ; docname
1<23+1<12+g9-g10 ; entry point
1<18+40<12+26<6+19 ; no type proc,general,array,integer
8<18 ; param zone
4<12+g5-g4 ; external list
4<12+2 ; code segm. own bytes
; 1<23+4 ; isodate entry description
; 0, r.4 ; docname
; 1<23+2<12+g16-g13 ; entry point
; 3<18 ; integer proc
; 0 ; param spec 2
; 4<12+g5-g4 ; external list
; 4<12+2 ; code segm, own bytes
1<23+4 ; connectdb entry description
0, r.4 ; docname
1<23+2<12+g17-g13 ; entry point
3<18+8<12+26<6+12 ; integer proc,zone,array,boolean
0 ; param spec2
4<12+g5-g4 ; external list
4<12+2 ; code segm, own bytes
g1: 1<23+4 ; dbrecdescr entry description
0, r.4 ; docname
1<23+2<12+g18-g13 ; entrypoint
3<18+19<12+19<6+26 ; integer proc, int.addr, int.addr, array
0 ; paramspec. 2
4<12+g5-g4 ; external list
4<12+2 ; code segm, own bytes
d.
p.<:insertproc:>
▶EOF◀