|
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: 291840 (0x47400)
Types: TextFile
Names: »tcf «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tcf «
\f
; rc 26.02.71 rc4000 code procedure, connected files page 0.1
;
; release 12.1, 18.10.79
;
; content page
;
; preface 0.1
; slang-names 0.1
; a-names, local labels 0.1
; b-names, zone-buf variables 0.2
; master-file buffer 0.2
; list-file buffer 0.4
; c-names, local variables 0.5
; d-names, global subroutines 0.6
; e-names, code procedures 0.7
; f-names, global constants 0.8
; master-file record 0.8
; list-file record 0.9
; chain-tables 0.10
; list-file block-table 0.11
; list-file block 0.12
; zone-states 0.14
; reference to file-i buffer 0.14
; g-names, tails, head-word, code-segment 0.16
; h-names, zone-descriptor 0.16
; i-names, unused 0.16
; j-names, abs-words, points, chain-for-rel 0.17
; content of segments 0.
; code segments 1.1
;
; obs. pages are numbered <segment>.<page>, the preface is
; regarded as segment 0.
;
;b. h50 ; fp-names dummy block
;
b. b70, e70, f60, g1 ; insertproc-block
w.
;
; slang-names.
;
; a-names
;
; procedure-, subroutine-, or makro-block.
;
; they are used as labels at the innermost block-levels, they should
; preferably label instructions.
\f
; rc 28.10.74 rc4000 code procedure, connected files page 0.2
;
;
; b-names
;
; insertproc-block.
;
; a b-name will always define a displacement relative to cf-buf-ref,
; the absolute address, normally held in w2, pointing to the current
; zone-buffer.
;
; b0 to b49 the variables of cf-procedures and subroutines in
; the socalled cf-buffer.
;
; b50 and up the variables of the file-n procedures, the basic
; list-file administration, in the socalled file-n
; buffer.
;
; master-file buffer.
;
; base-buffer-area: !====================================!
; ! i-buf-ref-rel (>0) !
; !------------------------------------!
; ! cf-buf-ref-rel !
; !------------------------------------!
; first-m-ch-addr - 2:! reference to db-table. !
; ! -1 in file head, !
; ! abs addr after call of init-dbtable!
; !------------------------------------!
; first-m-ch-addr: ! first-mother-chain-table !
; ! . !
; ! . !
; ! . !
; !------------------------------------!
; ! 0 (ends the mother-tables) !
; !------------------------------------!
; ! return address (split-key-code) !
; split-key-code: ! compiled piece of code, which !
; ! can split a key-part into a !
; ! record. !
; ! jl. (split-key-code. - 2) !
; !------------------------------------!
; ! cf-variables used for master- !
; ! files only. !
; !------------------------------------!
; cf-buf-ref: ! cf-variables common to master- !
; ! files and list-files. !
; !------------------------------------!
; ! min-rec-size-zb (master-file only)!
; !====================================!
; ! save-head, the compressed key !
; ! (or key-part) of the current re- !
; ! cord, saved by the file-i procs. !
; ! this is the file-i buffer. !
; ! . !
\f
; rc 10.09.71 rc4000 code procedure, connected files page 0.3
;
;
; definition of common b-names.
;
; b-name ; content in zone-buf ; in file-head ; init by
;
b1=0 ; jl x3 (return-1-zb) ; jl x3 ; -
; b1+2 ; segm-tbl-addr (ret.1) ; 0 ; -
b3=b1+4 ; jump-spec-1-zb ; 0 ; set-jumps-cf
; b3+2 ; jump-spec-2-zb ; 0 ; set-jumps-cf
; b3+4 ; jump-spec-3-zb ; 0 ; set-jumps-cf
b4=b3+6 ; formal.1-jump-proc-zb ; 0 ; set-jumps-cf
; b4+2 ; formal.2-jump-proc-zb ; 0 ; set-jumps-cf
b5=b4+4 ; rec-base-addr-zb ; 0 ; open-cf
b6=b5+2 ; mode-zb ; 0 ; -
b8=b6+2 ; ch-part-base-zb ; 0 ; -
b9=b8+2 ; ch-part-size-zb ; - ; -
b14=b9+2 ; save-head-size-zb ; - ; -
b15=b14+2 ; file-no<4+file-type-zb; - ; -
b16=b15+2 ; first-m-ch-addr-zb ; rel. cf-buf-ref; open-cf
b19=b16+2 ; curr-m-ch-zb ; 0 ; 0
;
; definition of master-file variables.
;
; b-name ; content in zone-buf ; in file-head ; init by
;
b7=b1-6 ; split-key-code-zb ; rel. cf-buf-ref; open-cf
b10=b7+2 ; rec-length-type-zb ; - ; -
b11=b10+2 ; rec-length-pos-zb ; - ; -
;
;
b12=b19+2 ; min-rec-size-zb ; - ; -
b21=b12+2 ; first word, save-head ; in file-i buf
;
;
; attention!
; if one of the values of b-names 0 to 16 is changed, the same
; change has to be made in dbrecdecode, because all the b-names up
; to 16 are copied there.
;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 0.4
;
;
; list-file buffer.
;
; base-buffer-area: !====================================!
; ! 0 (as opposed to master-file) !
; !------------------------------------!
; ! cf-buf-ref-rel !
; !------------------------------------!
; first-m-ch-addr - 2:! reference to db-table. !
; ! as in masterfiles. !
; !------------------------------------!
; first-m-ch-addr: ! first-mother-chain-table !
; ! . !
; ! . !
; ! . !
; !------------------------------------!
; ! 0 (ends the mother-tables) !
; !------------------------------------!
; first-d-ch-addr: ! first-daughter-chain-table !
; ! . !
; ! . !
; ! . !
; !------------------------------------!
; ! cf-variables used for list-files !
; ! only. !
; !------------------------------------!
; cf-buf-ref: ! cf-variables common to master- !
; ! files and list-files. !
; !====================================!
; file-n-buf. ! save-size-zb !
; ! save-rec-no-zb (save-head) !
; !------------------------------------!
; ! file-n !
; ! variables !
; !------------------------------------!
; share-list. ! block-table-share-zb !
; (variable size). ! last-used-share-zb !
; ! . !
; ! . !
; victim-zb: ! victim-share !
; !====================================!
; block-table. ! dead-bytes !
; ! used-bytes upper part !
; ! used-bytes low part !
; ! fill-percentage,blocks-in-file !
; !------------------------------------!
; victim-zb + f18: ! first word of block-table !
; ! . !
; ! . !
; ! . !
; !====================================!
; block-shares. ! first word of first block-share !
; ! . !
; ! . !
; ! . !
\f
; rc 10.09.71 rc4000 code procedure, connected files page 0.5
;
;
; definition of list-file variables.
;
; b-name ; content in zone-buf ; in file-head ; init by
;
b2=b1-10 ; jl x3 (return-2-zb) ; jl x3 ; -
; b2+2 ; segm-tbl-addr (ret.2) ; 0 ; -
b13=b2+4 ; max-rec-size-zb ; - ; -
b17=b13+2 ; first-d-ch-addr-zb ; rel. cf-buf-ref; open-cf
b20=b17+2 ; curr-d-ch-zb ; 0 ; -
;
; definition of file-n variables.
;
; b-name ; content in zone-buf ; in file-head ; init by
;
b50=b19+2 ; save-size-zb ; fix-rec-size ; -
b51=b50+2 ; save-rec-no-zb ; 0 ; -
b52=b51+2 ; segs-in-head-zb ; - ; -
b53=b52+2 ; segs-in-block-zb ; - ; -
b54=b53+2 ; recs-in-block-zb ; - ; -
b55=b54+2 ; max-free-shift-3-zb ; - ; -
b56=b55+2 ; fix-rec-size-zb ; - ; -
b57=b56+2 ; block-ref-zb ; first-segs-zb ; -
b58=b57+2 ; rec-no-rel-zb ; block-size+2-zb; -
b59=b58+2 ; new-blocks-in-file-zb ; max-blocks-zb ; open-cf
b60=b59+2 ; last-rec-no-zb ; 0 ; open-cf
b64=b60+2 ; block-zb ; 0 ; -
b61=b64+2 ; victim-zb ; checksum ; open-cf
b62=b61+2 ; block-table-share-zb ; not-in-head ; open-cf
b63=b62+2 ; last-used-share-zb ; not-in-head ; open-cf
;
;
; note on share-list:
;
; each word in the share-list points to the first byte of the message
; in a share-descriptor, i.e. the normal address of the share-
; descriptor is found by subtracting 6 from the share-list entry.
;
;
; c-names.
;
; procedure-, subroutine-, or makro-block.
;
; they are used for variables and constants at the innermost block-
; levels.
\f
; rc 06.12.74 rc4000 code procedure, connected files page 0.6
;
;
;
; d-names.
;
; slang-segment.
;
; global entries of subroutines, and other global labels.
;
; d0 to d60 cf-subroutines and -labels.
; d60 and up file-n procedures and subroutines.
;
; two d-names are used for each entry or label.
;
; d<2n> normal slang-label, used for reference from own
; segment.
; d<2n+1> relative address on segment, used for reference
; from other segments.
;
; d-name ; cf-subroutine page
;
; d0 - d1 ; prepare 2.2
; d4 - d5 ; check-chain 5.
; d6 - d7 ; set-rec-pointers 2.3
; d8 - d9 ; move-word 5.
; d10 - d11 ; compare 5.
; d14 - d15 ; next-l-int 6.5
; d16 - d17 ; return-algol 2.4
; d18 - d19 ; new-head-chain 5.
; d20 - d21 ; adjust-prior-rec 6.8
; d22 - d23 ; get-mother-rec-int 11.
; d24 - d25 ; decode-rec 11.9
; d26 - d27 ; delete-l-int 7.
; d28 - d29 ; delete-chain-int 7.
; d30 - d31 ; move-double 5.
; d32 - d33 ; put-cf-int 2.10
; d34 - d35 ; alarm 1.2
; d36 - d37 ; call-file-i 2.6
; d38 - d39 ; test-shift-table 2.4
; d40 - d41 ; get-m-int 2.8
; d42 - d43 ; read-only-cf-int 14.4
; d44 - d45 ; open-cf-continued 13.2
; d46 - d47 ; get-param 15.5
; d48 - d49 ; set-param 15.7
; d50 - d51 ; call-protect-cf 13.9
; d52 - d53 ; call-alarmproc 15.8
; d54 - d55 ; call-jump-proc 3.8
; d56 - d57 ; call-init-file-i 13.5
; d58 - d59 ; return-from-call-init-file-i 12.3.1
\f
; rc 06.12.74 rc4000 code procedure, connected files page 0.6.1
;
;
; d-name ; file-n procedure page
;
; d60 - d61 ; set-mode-n 14.6
; d62 - d63 ; get-rec-n 4.
; d64 - d65 ; set-free-n 5.
; d66 - d67 ; insert-n 10.2
; d68 - d69 ; find-rec-no-n 8.2
;
; d-name ; file-n subroutine page
;
; d72 - d73 ; get-block-r 4.
; d74 - d75 ; get-block-b 4.
; d76 - d77 ; log-func 5.
; d78 - d79 ; squeeze 10.5
; d80 - d81 ; find-most-free 8.5
; d82 - d83 ; init-blocks 15.2
; d84 - d85 ; return-from-init-blocks 14.7
; d86 - d87 ; log-func-r 5.
; d88 - d89 ; get-rec-n-int 4.
; d90 - d91 ; write-back 14.9
\f
; rc 06.12.74 rc4000 code procedure, connected files page 0.7
;
;
;
; e-names.
;
; insertproc-block.
;
; only used for the algol procedures.
;
; two e-names are used for each entry, they are only used in the tails.
;
; e<2n> segment-number relative to first code segment.
;
; e<2n+1> relative entry-address on code segment.
;
; n = cf-proc-no
;
; e-name ; code procedure page
;
; e4 - e5 ; init-file-m 12.2
; e6 - e7 ; open-cf 12.2
; e8 - e9 ; set-jumps-cf 16.2
; e10 - e11 ; init-chain 13.6
; e12 - e13 ; close-cf 14.2
; e14 - e15 ; -
; e16 - e17 ; get-m 2.8
; e18 - e19 ; get-l 6.2
; e20 - e21 ; get-head 3.6
; e22 - e23 ; insert-m 3.2
; e24 - e25 ; insert-l 9.2
; e26 - e27 ; connect 11.
; e28 - e29 ; delete-m 7.
; e30 - e31 ; delete-l 7.
; e32 - e33 ; delete-chain 7.
; e34 - e35 ; next-m 2.9
; e36 - e37 ; put-cf 2.10
; e38 - e39 ; read-only-cf 14.4
; e40 - e41 ; read-upd-cf 14.4
; e42 - e43 ; update-all-cf 14.4
; e44 - e45 ; move-chain x.
; e46 - e47 ; get-numb-l 4.
; e48 - e49 ; new-recl-cf x.
;
; e56 - e57 ; init-rec-m 3.2
; e58 - e59 ; disconnect 15.
; e60 - e60 ; get-param-cf 16.2
; e62 - e63 ; set-param-cf 16.2
\f
; rc 10.09.71 rc4000 code procedure, connected files page 0.8
;
;
;
; f-names.
;
; insertproc-block.
;
; used for global administrative counters and constants, such as
; zone-states and format-defining displacements.
;
; f-name ; counter or constant
;
f0=0 ; segment count
; f1 ; number of externals, defined on segment 1
; f2 ; start of external list, defined on segment 1
; f3 ; number of bytes in permanent core, defined under
; j-names
f4=10000 ; first k-value on a code segment
f5=5 ; write-oper, a write-operation on backing store
f6=3 ; read-oper, a read-operation on backing store
;
; format of master-file record.
;
; record-base: !====================================!
; ! user-part, !
; ! an integral number of !
; ! double-words. !
; !------------------------------------!
; + key-field-pos(i): ! key-field(i) !
; !------------------------------------!
; ! . !
; !------------------------------------!
; + rec-length-pos-zb:! length-field (may be absent) !
; !------------------------------------!
; ! . !
; chain-part-base-zb: !------------------------------------!
; ! chain-part, !
; ! an integral number of double- !
; ! words. !
; !------------------------------------!
; ! next-chfld (mother) !
; + chfld-rel-tbl: !------------------------------------!
; ! (chfld-rel-tbl points to the last !
; ! byte of next-chfld). !
; ! . !
; !====================================!
;
; if variable length is defined, the length-field is changed by
; cf-procs to let the record appear to the user as if it only con-
; sisted of the user-part, the file-i procs will always restore the
; original length-field.
;
; values of the 24-bit integer next-chfld (mother).
;
; = 0 end of chain
; > 0 the number of the first daughter-record
\f
; rc 10.09.71 rc4000 code procedure, connected files page 0.9
;
;
; format of list-file record.
;
; 1. fixed record-length.
;
; record-base: !====================================!
; ! user-part, !
; ! an integral number of double- !
; ! words. !
; ! . !
; chain-part-base-zb: !====================================!
; ! chain-part, !
; ! an integral number of words. !
; !------------------------------------!
; ! next-chfld (mother) !
; + chfld-rel-tbl: !------------------------------------!
; ! (chfld-rel-tbl points to the last !
; ! byte of the next-chfld). !
; ! . !
; !------------------------------------!
; ! next-chfld (daughter) !
; + chfld-rel-tbl: !------------------------------------!
; ! head-fld, !
; ! an integral number of words (evt. !
; ! none) holding a compressed key of !
; ! the mother-record. !
; !------------------------------------!
; ! (chfld-rel-tbl defines the base !
; ! of the head-fld). !
; ! . !
; !====================================!
;
; values of the 24-bit integer next-chfld (daughter).
;
; bit(0) = 0 active record
; bit(0) = 1 dead record
; bit(1 to 23) =
; 2**23 - 1 record not connected to this chain
; bit(1 to 23) = 0 this record ends the chain
; bit(1 to 23) <> 0 number of next record in chain
;
f7=1<23 ; dead-bit
f8=1<23-1 ; not connected
f9=f7 o. f8 ; dead not connected
;
;
; 2. variable record-length.
;
; the first double-word of the user-part is used for administration.
;
; administrative double-word in file.
;
; !====================================!
; ! rec-size + free-bit !
; !------------------------------------!
; ! record-number !
; !====================================!
;
; values of free-bit.
;
; 0 a used record (active or dead)
; 1 a free record, i.e. the record has been set free, but
; the surrounding records have still not been squeezed
; together.
\f
; rc 10.09.71 rc4000 code procedure, connected files page 0.10
;
;
; administrative double-word in zone-record.
;
; record-base: !====================================!
; ! length of user-part(double-words) !
; !------------------------------------!
; ! record-number !
; !====================================!
;
;
;
; chain-tables.
;
; 1. mother-tables.
;
; !====================================!
; chain-addr: ! d-ch-addr-tbl (-1 = not-init) !
; + 2 ! d-cf-buf-ref-tbl (-1 = not-init) !
; + 4 ! chfld-rel-tbl !
; + 6 ! chain-number-tbl (byte) !
; + 7 ! chain-seq-number-tbl (byte) !
; !====================================!
; + f10 ! next mother-table or zero !
;
f10=8 ; size of mother-chain-table
;
; 2. daughter-tables.
;
; !====================================!
; chain-addr: ! m-ch-addr-tbl (-1 = not-init) !
; + 2 ! m-cf-buf-ref-tbl (-1 = not-init) !
; + 4 ! chfld-rel-tbl !
; + 6 ! chain-number-tbl (byte) !
; + 7 ! chain-seq-number-tbl (byte) !
; !------------------------------------!
; + 8 ! next-d-ch-tbl !
; + 10 ! head-fld-size-tbl !
; !------------------------------------!
; + f11 ! prior-tbl !
; + f12 ! last-acc-tbl !
; + f13 ! next-tbl !
; + f14 !------------------------------------!
; ! head-tbl, an integral number of !
; ! words holding the compressed key !
; ! of the current mother-record. !
; !====================================!
;
f11=12 ; prior-tbl
f12=f11 + 2 ; last-acc-tbl
f13=f12 + 2 ; next-tbl
f14=f13 + 1 ; base of head-tbl
\f
; rc 01.10.77 rc4000 code procedure, connected files page 0.11
;
;
;
; list-file block-table in zone-buffer.
;
; victim-zb:
; !====================================!
; + 2 ! dead-bytes !
; + 4 ! used-bytes upper part !
; + 6 ! used-bytes low part !
; + 8 ! fill-percentage,blocks-in-file !
; !------------------------------------!
; + f18 ! first word of block-table !
; ! . !
; ! . !
; ! the block-table occupies: !
; ! (blocks-in-file + 3)//4 words. !
; ! . !
; !====================================!
; ! first shared of first block-share !
; ! . !
;
f51=(:-1:)>7 ; mask for blocks-in-file
f52=(:-1:)<17 ; - fill-percentage
f53=7 ; shiftcount
f18=10 ; first block-table-word rel. to victim-zb
;
; list-file blocks are numbered from 0 and up, the block-table holds
; a 6-bit entry for each block giving a logarithmic derivative of the
; amount of free room.
;
; first byte of block-table:
; free(block-0) shift 6 add free(block-1)
;
; last word of block-table:
; unused 6-bit entries are set to zero
;
; free(block-n):= if free-rec-nos(block-n) = 0 then 0
; else log-func(free-bytes(block-n));
;
; log-func works upon the quantity max-free-shift-3-zb and yields a
; result in the range 1 to 63, the latter only for a completely empty
; block.
;
\f
; rc 10.09.71 rc4000 code procedure, connected files page 0.12
;
;
; list-file block.
;
; list-file blocks are numbered from 0 and up to blocks-in-file - 1.
;
; !====================================!
; block-ref + f20: ! free-bytes (byte) !
; block-ref + f21: ! free-rec-nos (byte) !
; block-ref + f22: ! free-base-rel !
; block-ref + f23: ! over-flow-block !
; !------------------------------------!
; block-ref: ! rec-base-rel(0) (byte) !
; + 1 ! rec-base-rel(1) (byte) !
; ! . !
; ! . !
; ! rec-base-rel(recs-in-block - 1) !
; !------------------------------------!
; + recs-in-block ! first word available for records !
; ! . !
; ! . !
; + rec-base-rel(n) !------------------------------------!
; ! the record of the number: !
; ! rec-no:= block-number * !
; ! recs-in-block + n + 1; !
; !------------------------------------!
; ! . !
; ! . !
; + free-base-rel !------------------------------------!
; ! consecutive free area, a new rec- !
; ! cord is always inserted here in !
; ! case of variable record-length. !
; !------------------------------------!
; last-shared: ! 1 (stop-record for squeeze, only !
; ! needed for variable rec-length) !
; !====================================!
;
;
f20= -6 ; free-bytes, rel. to block-ref
f21=f20 + 1 ; free-rec-nos, -
f22=f21 + 1 ; free-base-rel, -
f23=f22 + 2 ; over-flow-block, -
\f
; rc 10.09.71 rc4000 code procedure, connected files page 0.13
;
;
; comment on even and odd addresses:
;
; block-ref = first-shared - f20, i.e. block-ref is even.
;
; the base of a used record is calculated thus:
;
; rec-base-rel(rec-no):= byte(block-ref
; + (rec-no - 1) mod recs-in-block);
;
; rec-base(rec-no):= block-ref + rec-base-rel(rec-no);
;
; i.e. rec-base-rel is odd for a used record.
;
; a record-number is marked free = not-used by subtracting the last
; bit, the used-bit, thereby making rec-base-rel even.
;
; free-base-rel is odd, and the size of the consecutive free area
; is calculated thus:
;
; free-size:= last-shared - 1 - free-base-rel - block-ref;
;
; recs-in-block-zb is even in the case of variable record-length in
; order to let the address of the first word available for records be
; calculated as: block-ref + recs-in-block.
;
; value of over-flow-block.
;
; = -1 no overflow occurred
; >= 0 last overflow occurred to the block of this number
\f
; rc 20.04.79 rc4000 code procedure, connected files page 0.14
;
;
; zone-states.
;
;
f28=16 - 10 ; read-only-m - read-only-i, difference between
; corresponding file-cf- and file-i-states.
;
f29=16 + 8 ; max-cf-state, used in calculating check-bits
;
; each cf-zone-state is represented by two f-names:
;
; f<even> ; abs value of zone-state
; f<even + 1> ; check-bit = 1<(:max-cf-state - f<even>:)
;
; the check-bits are added in w0 as a parameter for the subroutine
; prepare.
; if for example update-all-m and read-update-m are the allowed states,
; the code will look like this:
;
; al w0 f35+f37 ; prepare(update-all-m,
; jl prepare ; read-update-m)
;
; in prepare:
; ls w0 zone-state - max-cf-state
; so w0 1 ;
; jl zone-state-error
;
; f<even> , f<even + 1> ; zone-state
;
f30=16 , f31=1<(:f29-f30:) ; read-only-m
f32=f30 + 1 , f33=1<(:f29-f32:) ; not-used (read-next-i)
f34=f32 + 1 , f35=1<(:f29-f34:) ; read-update-m
f36=f34 + 1 , f37=1<(:f29-f36:) ; update-all-m
f38=f36 + 1 , f39=1<(:f29-f38:) ; init-m
f40=f38 + 1 ; f41 ; not-used
f42=f40 + 1 , f43=1<(:f29-f42:) ; read-only-l
f44=f42 + 1 , f45=1<(:f29-f44:) ; read-update-l
f46=f44 + 1 , f47=1<(:f29-f46:) ; update-all-l
;
;
f49=f31 + f35 + f37 + f43 + f45 + f47 ; check-bits for all cf-states
; except init-m
;
;
; reference to file-i buffer.
;
; f50 and up are used for reference to file-i buf (very few such
; references should ever be needed).
\f
; rc 10.09.79 rc8000 code procedure connected files page 0.15
;
;
b. i15
w.
; isq version 12
;
i0=0
i1=i0+14
i2=i1+20
i10=18
i3=i2+26
i4=i3+i10
i5=i4+i10
\f
; rc 18.10.78 rc4000 code procedure, connected files page 0.16
;
;=======================================================================
f50= i5 + i10 ; curr(recs), used in init-m
f55= i5 + 4 ; entrysize(recs), used in init_m
i.
e.
;
;
; g-names.
;
; insert-proc-block.
;
; g0 first tail
; g1 last tail
;
; code-segment-block.
;
; g1 rel of last point
; g2 rel of last abs work
;
; g3 administration at end segment
;
; g4 and up labels common to one segment only
;
;
; h-names.
;
; fp-name-block.
;
; they are all defined by the standard text-file, fp-names.
; they are used for definition of zone- and share-descriptor-formats.
; see rcsl no: 55-d74, code procedures ....:
;
;
; i-names.
;
; not used yet.
\f
; rc 04.01.72 rc4000 code procedure, connected files page 0.17
;
;
;
; j-names.
;
; code-segment-block.
;
; they are entirely used for abs-words, points, and chain-for-rel.
;
; j-name use
;
; j0 head word, segment-table-address, own segment
; j1 - j20 reference to own segments, j<n>, abs word referring
; to segment <n>
; j21 - j40 reference to own permanent core:
; byte-no content
; j21 1 return-1-p, init to jl x3
; j22 3 return-1-p, (segment tbl address)
; j23 5 return-2-p, init to jl x3
; j24 7 return-2-p, (segment tbl address)
; j25 9 zero, first word of real rec-no-cf
; j26 11 rec-no-cf
; j27 13 size-p, used by file-n procs
; j28 15 over-flow-p, -
; j29 17 unused
; j30 19 work-0-p, used by cf-procs
; j31 21 work-1-p, -
; j32 23 work-2-p, -
; j33 25 proc-no-p, -
; j34 27 result-cf
; j35 29 save-cf-buf-ref-p, used by file-n procs
; j36 31 alarmno-p, j36 to j38 are used by the
; j37 33 subroutine alarm for saving its parameters.
; j38 35
;
;
f3=35 + 1 ; number of bytes in permanent core
;
; j41 - j80 reference to external procedures and variables,
; j<40 + n>, reference to external no. n, see page
; 1.1, the external list.
; j81 - j100 chain for rel
;
; j101 - reference to running system entries, j<100 + n>,
; reference to rs-entry n.
;
;
;
s. d110 ; slang segment.
w. ;
; ;
; end segment 0
\f
; rc 18.10.78 rc4000 code procedure, connected files page 1.1
;
b. g10,j150 ; code segment 1: head admini labels, abswords
; points, and chain_for_rels
f0=f0+1 ; increase segm.count
f1=16 ; initialize no. of externals
k=f4 ; k:= first k-value
h.
j0: g1, g2 ; headword: last point, last absword
j2: 1<11 o.(:2-f0:), 0 ; ref. to segm. 2
j13: 1<11 o.(:13-f0:), 0 ; ref. to segm. 13, call protectcf
j15: 1<11 o.(:15-f0:), 0 ; ref. to segm. 15
j33: 0 , 25 ; procno_p
j36: 0 , 31 ; alarm-no-p
j121: f1 + 21, 0 ; RS general alarm
j130: f1 + 30, 0 ; rs saved stackref, saved w3
;
;
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
f2=k-j0 ; rel. start of external list:
f1 ; no. of externals
8 ; no. of bytes to init in own perm. core
jl x3 ; return_1_p
0
jl x3 ; return_2_p
0
;
\f
; rc 18.10.78 rc4000 code procedure, connected files page 1.1.1
;
;
; externals: file_i_procs and _std.var., same sequence as in RCSL
; 55-D99, i_proc 14 is not called but simulated.
<:initfilei:>,0 ; ext.no.1
1<18+14<12+14<6+8,0 ; proc(zone,realval,realval)
<:initreci:>,0 ; ext.no.2
1<18+26<12+8<6,0 ; proc(zone,array)
<:startfilei:> ; ext.no.3
1<18+8<12,0 ; proc(zone)
<:setreadi:>,0 ; ext.no.4
1<18+8<12,0 ; proc(zone)
<:setputi:>,0 ; ext.no.5
1<18+8<12,0 ; proc(zone)
<:setupdatei:> ; ext.no.6
1<18+8<12,0 ; proc(zone)
<:getreci:>,0 ; ext.no.7
1<18+26<12+8<6,0 ; proc(zone,array)
<:nextreci:>,0 ; ext.no.8
1<18+8<12,0 ; proc(zone)
<:deletereci:> ; ext.no.9
1<18+8<12,0 ; proc(zone)
<:insertreci:> ; ext.no.10
1<18+26<12+8<6,0 ; proc(zone,array)
<:dbrecdecode:> ; ext.no.11
3<18+26<12, 0 ; integer proc(array)
<:resulti:>,0 ; ext.no.12
9<18,0 ; integer variable
;
; external: algol std.proc.
<:open:>,0,0 ; ext.no.13
1<18+19<12+41<6+19,8<18 ; proc(zone,intaddr,undef,intaddr)
;
; externals: file_i_procs no.12-13.
<:getparamsi:> ; ext.no.14
3<18+39<12+8<6,0 ; proc(zone,general)
<:setparamsi:> ; ext.no.15
3<18+39<12+8<6,0 ; proc(zone,general)
;
; external: algol procedure
<:protectcf:>,0 ; ext.no.16
1<18+ 3<12+8<6,0 ; proc(zone,intname)
;
; external: db-procedures
; ext.no.11 is misused for this purpose
s3 ,s4 ; date and time of this version
\f
; rc 18.10.78 rc4000 code procedure, connected files page 1.2
;
;
; subroutine alarm(alarmno);
;
; the routine tests whether the alarm number corresponds to a
; tested cf filehead.
; if that is the case, the jump-specification of the zone
; corresponding to the call of the cf-procedure is inspected to
; see whether the bit corresponding to (procno, result) = (1, 1)
; is one.
; if this bit has been set to one, (by setjumpscf), then a user
; alarm procedure is called with procno-p and alarmno as the pa-
; rameters.
; if the conditions above are not fulfilled, or the user procedu-
; re returns through its final end, then the alarm routine will
; continue in this way:
; protectcf is called with the action procno shift 12 add alarmno
; in order to have a good alarmprint.
; after that
; the routine finds an alarmtext to alarmno, and calls RS general
; alarm. Note that saved_stack_ref (j130) must correspond to the
; cf_proc entry. (Alarmno 1-7 are not used by the cf_system.)
; call
; w0: undef.
; w1: alarmno
; w2: integer ; only used if alarmno = 8 or 38;
; w3: call addr +2
\f
; rc 04.01.72 rc4000 code procedure, connected files page 1.2.1
;
;
b. a10, c5 ; alarm:
w.
d34: d35=k-f4
; if alarmno =
se w1 8 ; 8 zonestate or
sn w1 25 ; 25 zone-buffer-error (opencf) or
jl. a1. ;
se w1 26 ; 26 wrong filehead (opencf) or
sn w1 32 ; 32 not 2 shares (opencf)
jl. a1. ; then goto call_alarm;
;
;
; save the parameters for alarm in permanent core, and inspect the
; jump-spec-bit corresponding to (procno, result) = (1, 1) for the
; zone corresponding to the cf-buf-ref saved in formal1.1, to see
; whether a user alarm procedure should be called.
;
rs. w1 (j36.) ; save the parameters, w1 to w3
am. (j36.) ;
ds w3 +4 ;
;
; load cf-buf-ref from formal1.1 of the cf procedure call.
dl. w3 (j130.) ; w2:= rs saved stackref
rl w2 x2+6 ; w2:= cf-buf-ref:= formal1.1
;
rl. w3 (j2.) ; w1:= testshifts(procno = 1, result = 1)
bz w1 x3+d39 ; := table(1 - 1) + 1;
al w1 x1+1 ; see subroutine return-algol.
;
dl w0 x2+b3+2 ; w3w0:= jumpspec-1-zb, jumpspec-2-zb
ld w0 x1-24 ; w3w0:= w3w0 shift (testshifts - 24)
sl w0 0 ; if signbit(w0) = 0 then
jl. a0. ; goto continue-alarm
;
; now it is known that the user alarm procedure should be called,
; but because segment 1 is rather crowded, the call is performed on
; segment 15 by call-alarmproc.
; the return from the user procedure is at a2 below.
;
al w0 a2 ; w0:= rel.return, to this segment
rl. w3 (j15.) ;
jl x3+d53 ; call-alarmproc
\f
; jw 05.02.79 rc4000 code procedure, connected files page 1.2.2
;
;
a2=k-j0 ; return-from-alarm-proc:
ds. w3 (j130.) ; restore rs saved stackref, saved w3
rl w2 x2+6 ; w2:= cf_bufref:= formal1.1
;
a0: ; continue-alarm:
rl. w1 (j33.) ; action for protectcf:=
ls w1 12 ; procno_p shift 12
wa. w1 (j36.) ; + alarmno_p;
rl. w0 j0. ; call protectcf for alarmprint
rl. w3 (j13.) ;
jl w3 x3+d51 ;
rl. w1 (j36.) ; fetch the alarm parameters
am. (j36.) ;
dl w3 +4 ;
;
a1: ; call-alarm:
al w0 x1
wa w0 2
wa w0 2
wa w0 0 ; w0:= alarmno*6
am (0) ;
al. w0 c0. ; w0:= w0+textbase-8*6
se w1 8 ; if alarmno = 8 or alarmno = 38 then
sn w1 38 ; w1:= int_errorno;
al w1 x2 ; comment zonestate or param-pair-no;
jl. (j121.) ; goto general alarm
c0=k-8*6
<:<10>z.state :> ; start of alarmtexts, 3 words each, first
<:<10>ch.ass. :> ; text = alarmno 8
<:<10>cf-error:> ; alarm 10
<:<10>mode p :>
<:<10>cf-error:>
<:<10>array p :>
<:<10>no.curr.:>
\f
; rc 28.10.74 rc4000 code procedure, connected files page 1.3
;
;
<:<10>chain p :> ; alarm 15
<:<10>ch.state:>
<:<10>ch.state:>
<:<10>ch.head :>
<:<10>rec.no. :>
<:<10>ch.type :> ; alarm 20
<:<10>fixed l :>
<:<10>rec.no. :>
<:<10>a-23 :>
<:<10>prep_cf :>
<:<10>prep_cf :> ; alarm 25
<:<10>prep_cf :>
<:<10>a-27 :>
<:<10>m.state :>
<:<10>d.state :>
<:<10>rec.type:> ; alarm 30
<:<10>zrecsize:>
<:<10>prep-cf :>
<:<10>prep-cf :>
<:<10>a-34 :>
<:<10>a-35 :> ; alarm 35
<:<10>express.:>
<:<10>cf-error:>
<:<10>par.pair:>
i.
e.
\f
; rc 28.06.71 rc4000 code procedure, connected files page 1.4
;
;
g3=k-j0
c. g3-506
m. code on segment 1 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system 1:>
i.
e.
m. end segment 1
\f
; rc 18.10.78 rc4000 code procedure, connected files page 2.1
b. g10, j150 ; code segment 2:
f0=f0+1 ; increase segm.count
k=f4
h.
j0: g1, g2 ; headword: last point, last absword
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm.1
j3: 1<11 o.(:3-f0:), 0 ; ref. to segm.3
j33: 0 , 25 ; own core byte 24-25, proc_no_p
j34: 0 , 27 ; own core byte 26-27, result_cf
j35: 0 , 29 ; own core byte 28-29, save-cf-buf-ref-p
j42: 2 , j82 ; ext.no.2 , init_rec_i
j44: 4 , j84 ; ext.no.4 , set_read_i
j45: 5 , j85 ; ext.no.5 , set_put_i
j46: 6 , j86 ; ext.no.6 , set_update_i
j47: 7 , j87 ; ext.no.7 , get_rec_i
j48: 8 , j88 ; ext.no.8 , next_rec_i
j49: 9 , j89 ; ext.no.9 , delete_rec_i
j50: 10, j90 ; ext.no.10, insert_rec_i
j51: 11, j91 ; ext.no.11, dbrecdecode
j52: 12, 0 ; ext.no.12, result_i
j54: 14, j94 ; ext.no.14, get_params_i
j55: 15, j95 ; ext.no.15, set_params_i
j103: f1+3 , 0 ; rs reserve
j108: f1+8 , 0 ; rs end address expression
j113: f1+13, 0 ; rs last used
j130: f1+30, 0 ; rs saved stack ref, saved w3
;
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
\f
; rc 28.10.74 rc4000 code procedure, connected files page 2.2
;
;
; subroutine prepare (statebits);
;
; the routine is called at the start of every cf_procedure.
; it fetches and saves stack_ref, stores proc.no. in permanent core,
; takes the zone-parameter, checks the zone-state against a mask
; given as call quantity. Finally it calculates cf_buf_ref, stores
; this in formal 1.1, and sets result_cf:= 1.
; call return
; w0: state-bits undef.
; w1: proc.no. undef.
; w2: undef. cf_buf_ref
; w3: return address stack_ref
;
;
b. a5
w.
d0: d1=k-f4 ; prepare:
rl. w2 (j113.) ;
ds. w3 (j130.) ; w2:= stackref:= lastused
rs. w1 (j33.) ; put proc.no. in permanent core
rl w3 x2+8 ; w3:= base of zonedescr.
am (x3+h2+6)
ls w0 -f29 ; if statebits shift (z.state - maxstate)
so w0 1 ; <> 1 then
jl. a0. ; goto zonestate_error;
rl w3 x3+h0+0 ; w3:= basebuffer
wa w3 x3+3 ; +cf_buf_ref_rel;
rs w3 x2+6 ; formal1.1:= cf_buf_ref:= w3;
al w2 x3 ; w2:= w3;
al w0 1 ;
rs. w0 (j34.) ; result_cf:= w0:= 1;
dl. w0 (j130.) ; w3:= saved_stack_ref
jl (0) ; goto return
a0: ; zonestate_error: w3 contains base of z.des.
rl w2 x3+h2+6 ; w2:= zonestate;
al w1 8 ;
g6: rl. w3 (j1.) ;
jl w3 x3+d35 ; goto alarm(8);
e. ; end block prepare;
\f
; rc 18.10.78 rc4000 code procedure, connected files page 2.3
;
;
; subroutine set_rec_pointers
; the routine adjusts rec_size_zd to size of userpart and sets ch_
; part_base_zb to point to the base of the chain_part, and at last
; it adjusts the record-length in the userpart, if variable length
; is specified.
; call return (simple)
; w0: undef. undef.
; w1: undef. undef.
; w2: cf_buf_ref cf_buf_ref
; w3: return addr. undef.
;
;
b. a5, c5 ; set_rec_pointers:
w.
d6: d7=k-f4
rs. w3 c0. ; save_return:= w3
rl w3 x2+b5 ; w3:= rec_base_addr_zb
rl w1 x3+4 ; w1:= rec_size_zd:=
ws w1 x2+b9 ; rec_size_zd -ch_part_size_zb
rs w1 x3+4 ;
rl w3 x3 ; w3:= rec_base_zd
al w0 x3 ; ch_part_base_zb:= w0:= rec_base_zb
wa w0 2 ; +rec_size_zd
rs w0 x2+b8 ;
wa w3 x2+b11 ; w3:= length_addr:= rec_base_zd
; +rec_length_pos_zb
am (x2+b10) ;
jl. a0. ; case rec_length_type_zb of
a0: jl. (c0.) ; 0: fixed length, goto return
0 ; caution! * these two words are used
0 ; ********** by return-algol
j91=k-j0-1 ; dummy chain for rel for dbrecdecode
;
hs w1 x3 ; 6: byte
jl. (c0.)
0
;
rs w1 x3 ; 12: word
jl. (c0.)
0
;
rs w1 x3 ; 18: double-word
jl. (c0.)
c0: 0 ; used for save return;
;
ci w1 0 ; 24: real
ds w1 x3
jl. (c0.)
e. ; end block set_rec_pointers
\f
; rc 01.11.77 rc4000 code procedure, connected files page 2.4
;
;
; subroutine return_algol
;
; the routine inspects result_cf and performs a call of the jump-
; procedure, if it is indicated by jump_spec.
; Returns to the calling program through RS 8.
; call no return
; w0: undef.
; w1: undef.
; w2: cf_buf_ref
; w3: undef.
;
b. a5, c50 ; begin block return_algol
c0 = 6 ,c1 =c0 +1 ; this table with c-names specifies the
c2 =c1 +0,c3 =c2 +0 ; highest testshift-value for each cf_proc.
c4 =c3 +0,c5 =c4 +1 ; the value is assigned by adding the no. of
c6 =c5 +1,c7 =c6 +1 ; results to the testshiftvalue of the pre-
c8 =c7 +3,c9 =c8 +3 ; vious proc. An empty proc.no. or proc.s
c10=c9 +2,c11=c10+6 ; that cannot be jump_specified have no._of_
c12=c11+4,c13=c12+2 ; results = 0. c0 is a pseudo-proc used to
c14=c13+3,c15=c14+2 ; avoid call of jump_proc, when a cf-proc
c16=c15+2,c17=c16+2 ; is called internally.
c18=c17+1,c19=c18+1 ; the testshift-table is stored in halfwords
c20=c19+1,c21=c20+1 ;
c22=c21+4,c23=c22+3 ;
c24=c23+6,c25=c24+0 ;
c26=c25+0,c27=c26+0 ;
c28=c27+4,c29=c28+4 ;
c30=c29+0,c31=c30+0 ;
c32=c31+0 ;
;
; c1 should correspond to the procedure buflengthcf, and should have
; the value c0+0, because buflengthcf can never call the jumpproc.
; but c1 is instead set to c0+1, because the jumpspecification bit
; corresponding to (procno, result) = (1, 1) is used to specify
; whether a user alarm-procedure should be called in case of an alarm.
;
h. 0
d38: d39=k-f4 ; the table is also addressed from the seg-
c0 , c1 ; ment containing set_jumps_cf, which re-
c2 , c3 ; quires that the table is preceded by a
c4 , c5 ; zero and ended with an extra empty test-
c6 , c7 ; shift-value
c8 , c9
c10, c11
c12, c13
c14, c15
c16, c17
c18, c19
c20, c21
c22, c23
c24, c25
c26, c27
c28, c29
c30, c31
c32
\f
; rc 18.10.78 rc4000 code procedure, connected files page 2.5
;
;
w.
d16: d17=k-f4 ; return_algol:
rl w1 x2+b16 ;
rl w1 x1-2 ; w1:= addr2 in db-table;
;ks -10 ; comment w1 = addr 2, w2 = cfbufref
sh w1 2047 ; if addr2 < 2048 then
jl. a2. ; goto continue;
rs. w2 (j35.) ; save cfbufref in cf-bufref-p;
rl w2 x2+b5 ; w2:= recbase addr;
rl w3 x2+4 ; w3:= zonerecsize;
rl w2 x2 ; w2:= recbase;
al w0 -13 ; w0:= itype:=
se w3 0 ; if zonerecsize = 0 then secret
rl w0 x2+6 ; else z.indivtype;
;ks -11 ; comment w0 = itype, w1 = addr2,
; w2 = recbase, w3 = recsize
se w3 (x1-2) ; if zrecsize <> length-of-last-decoded
jl. a3. ; or
sn w0 (x1) ; indivtype <> last-decoded-indivtype then
jl. a1. ; begin
a3:
al w2 x3 ; comment w0 = indivtype , w1 = addr2,
; w2 = zonerecsize, w3 = unused;
;ks -12 ; comment see above
rl. w3 (j51.) ; external entry dbrecdecode;
jl w3 x3+502 ; call decodeinternal in dbrecdecode;
; comment w1 = addr2 in dbtable
rl w3 (x1+8) ; w3:= value of indivclass;
; -2: illegal itype
; -1: illegal length
; >=0: ok
sh w3 -1 ; if iclass <= -1 then
jl. a5. ; goto iclass_alarm;
; end;
a1: rl. w2 (j35.) ; restore cfbufref and continue;
a2: ; continue:
dl w0 x2+b3+2 ; w3w0:= first pair of testwords;
; ks 1
sl w3 0 ; if signbit(w3) = 0 then goto end_addr_expr;
jl. (j108.) ; comment no testshifts at all;
;
rl. w1 (j33.) ; w1:= cf_proc_no_p;
bz. w1 x1+d38.-1 ; testshifts:= w1:=
wa. w1 (j34.) ; tbl(cf_proc_no_p - 1) + result_cf;
; ks 2
sh w1 47 ; if testshifts >= 48 then
jl. a0. ; begin
al w1 x1-48 ; w1:= testshifts mod 48;
dl w0 x2+b3+6 ; w3w0:= next pair of testshiftwords;
; ks 3
; end;
\f
; rc 20.06.75 rc4000 code procedure, connected files page 2.5.1
;
;
;
; now the registers contain:
; w3w0 = the actual pair of testwords
; w1 = testshifts mod 48
; w2 = cf_buf_ref
;
a0: ld w0 x1-24 ; w3w0:= 1 shift (testshifts mod 48) - 24);
; ks 4
sl w0 0 ; if signbit(w0) = 0 then
jl. (j108.) ; goto end_addr_expr;
;
; call the users jump_proc:
;
rl. w3 (j3.) ; load segm.3 rel;
jl w3 x3+d55 ; call-jump-proc;
a5: ; iclass_alarm:
; w3 = -2 illegal itype, -1 ill. length
al w1 x3+32 ; alarm(30) rec.type, alarm(31) zrecsize
jl. g6. ; goto alarmcall in prepare
i.
e. ; end return-algol;
\f
; rc 28.10.74 rc4000 code procedure, connected files page 2.6
;
;
; subroutine call_file_i(i_proc_no);
; the routine calls the file_i_proc given as parameter.
; it sets up the top 5 words of the stack, i.e. the return point and
; the zoneparam, adjusts appetite, changes zonestate before and
; after the file_i_call, and releases back to the old stack_ref.
; Note that the stack-bytes must be reserved in before-hand and evt.
; other parameters be moved and adjusted accordingly.
; call return
; w0: return segm tbl addr undef.
; w1: i_proc_no<2 result_i
; w2: cf_buf_ref cf_buf_ref
; w3: return addr undef.
;
;
b. a5,c5 ; call file i:
w.
d36: rl. w0 j0. ; entry this segm:
d37=k-j0 ; entry other segm.:
ws w3 (0) ; save return_inf
hs w3 x2+b1+1 ; rel. on segm.
rs w0 x2+b1+2 ; segm.no.
rs. w2 (j35.) ; save-cf-buf-ref-p:= cf-buf-ref
;
rl w3 x2+b5 ; w3:= rec-base-addr-zb
rl. w2 (j113.) ; w2:= rs-last-used
rs w3 x2+8 ; formal1.2:= zone-address:= w3
;
al w0 -f28 ; file-i-zone-state:=
wa w0 x3+h2+6 ; cf-zone-state - cf-increment
rs w0 x3+h2+6 ;
;
dl. w0 (j130.) ; w3:= rs-saved-stack-ref
rl. w0 j0. ; w0:= segm-tbl-addr-this-segm
ds w0 x2+2 ; store first double-word of file-i call
;
ws w3 4 ; appetite:= stack-ref - last-used - 6
al w0 x3-6 ;
al w3 a0 ; w3:= rel-return-this-segm
hs w0 6 ; + appetite<12
;
rl. w0 c0. ; w0:= formal1.1:= zone-formal.1
ds w0 x2+6 ; store second double-word of file-i call
;
jl. x1-6 ; case i_proc_no of
rl. w3 (j42.) ; 2, init_rec_i
j82=k+1-j0
jl x3+0
aw 0 ; 3, start_file_i, not called
jl x3+0
rl. w3 (j44.) ; 4, set_read_i
j84=k+1-j0
jl x3+0
rl. w3 (j45.) ; 5, set_put_i
\f
; rc 28.10.74 rc4000 code procedure, connected files page 2.7
;
;
j85=k+1-j0
jl x3+0
rl. w3 (j46.) ; 6, set_update_i
j86=k+1-j0
jl x3+0
rl. w3 (j47.) ; 7, get_rec_i
j87=k+1-j0
jl x3+0
rl. w3 (j48.) ; 8, next_rec_i
j88=k+1-j0
jl x3+0
rl. w3 (j49.) ; 9, delete_rec_i
j89=k+1-j0
jl x3+0
rl. w3 (j50.) ; 10, insert_rec_i
j90=k+1-j0
jl x3+0
aw 0 ; 11, put_rec_i, not called
jl x3+0
rl. w3 (j54.) ; 12, get_params_i
j94=k+1-j0
jl x3+0
rl. w3 (j55.) ; 13, set_params_i
j95=k+1-j0
jl x3+0
a0=k-j0 ; re_entry after call of file_i:
ds. w3 (j130.) ; save_stack_ref, save_w3:= w2w3
;
rl. w2 (j35.) ; fetch save-cf-buf-ref-p
rl w3 x2+b5 ; w3:= rec-base-zb
rl w1 x3+h2+6 ; w1:= zonestate
al w1 x1+f28 ; zonestate:= i_state + cf_increment
rs w1 x3+h2+6 ;
rl. w1 (j52.) ; w1:= result_i
rl w3 (x2+b1+2) ; w3:= segm_tbl_addr return
jl x2+b1 ; goto return_int
c0: 6<12 +23 ; first formal of zone parameter
e. ; end call_file_i
\f
; rc 20.04.79 rc4000 code procedure, connected files page 2.8
;
;
; procedure get_m(zm,key);
; zone zm; array key;
;
; searches a record in a masterfile with a specified key and makes
; it current record.
; if the internal entry is used, the stack_top must hold correct
; return points, as exit is made through return_algol.
; w1 = a dummy_proc_no.
;
; result_cf current record
; 1 found the found
; 2 not found the successor to the specified
; 3 - - , end of file the first
;
b. a5, c5 ; begin block get_m
w.
e16=f0-1 ; get_m:
e17=k-f4
al w1 8 ; proc_no:= 8
d40: d41=k-f4 ; get_m_int:
al w0 f31+f35+f37 ; statebits:= read_only_m,update_all_m,
; read_upd_m
jl. w3 d0. ; goto prepare this segm.
al w1 -14 ; reserve(14 bytes)
jl. w3 (j103.) ; w1:= lastused:= newtop
; old_stack_top = w1 + 14
dl w0 x1+14+12 ; move formals.2
ds w0 x1+12
al w1 7<2 ; goto call_file_i(get_rec_i) this segm.
jl. w3 d36.
rs. w1 (j34.)
jl. w3 d6. ; goto set_rec_pointers this segm.
jl. d16. ; goto return_algol this segm.
i.
e. ; end get_m
\f
; rc 28.06.71 rc4000 code procedure, connected files page 2.9
;
;
; procedure next_m(zm);
; zone zm;
;
; makes the next record in a masterfile current record.
; result_cf current record
; 1 found the next
; 2 found, end of file the first
;
b. a5, e5 ; begin block next_m
w.
e34=f0-1 ; next_m:
e35=k-f4
al w1 17 ; proc_no:= 17
al w0 f31+f35+f37 ; statebits:= read_only_m, update_all_m,
; read_upd_m
jl. w3 d0. ; goto prepare this segm.
rl w0 x2+b6 ;
sz w0 3 ; if modebits_zb extract 2 = 0 then
jl. a0.
rl w1 x2+b5 ; w1:= rec_base_addr_zb
al w0 f34
rs w0 x1+h2+6 ; zonestate_zd:= read_upd_m
a0: al w1 -10 ; reserve(10 bytes)
jl. w3 (j103.) ; w1:= lastused:= newtop
al w1 8<2
jl. w3 d36. ; goto call_file_i(next_rec_i) this segm.
rs. w1 (j34.) ; result_cf:= result_i
rl w0 x2+b6 ;
sz w0 3 ; if modebits_zb extract 2 = 0 then
jl. a1.
rl w1 x2+b5
al w0 f30
rs w0 x1+h2+6 ; zonestate_zd:= read_only_m
a1: jl. w3 d6. ; goto set_rec_pointers this segm.
jl. d16. ; goto return_algol this segm.
m.nextm
i.
e. ; end next_m
\f
; rc 27.07.76 rc4000 code procedure, connected files page 2.10
;
;
; subroutine put_cf_int
;
; sets a write_operation into the share used for the current block.
; if the file is a listfile, the share will be last_used_share else
; last_share.
; call return (simple)
; w0: undef. undef.
; w1: undef. undef.
; w2: cf_buf_ref cf_buf_ref
; w3: return addr undef.
;
b. a5, c5 ; begin block put_cf_int
w.
d32: d33=k-f4
al w0 f5 ; w0:= write_operation
rl w1 x2+b15 ; if file_type_zb = 0 then
sz w1 1
jl. a0.
; masterfile:
rl w1 x2+b5 ; w1:= rec_base_addr_zb (z+h3+0)
rl w1 x1+h0+8 ; w1:= addr_of_last_share
hs w0 x1+6 ; sd(last_share,oper):= write
jl x3 ; return
a0: ; listfile:
am (x2+b5) ;
rl w1 +4 ; w1:= rec_size_zd
sl w1 1 ; if rec_size_zd >= 1 then
hs w0 (x2+b63) ; sd(last_used_share,oper):= write
jl x3 ; return
e. ; end put_cf_int
; procedure put_cf(zm);
; zone zm;
;
; ensures that the current record will be transferred to the file.
; result_cf current record
; 1 ok unchanged
;
b. ; begin block put_cf
w.e36=f0-1
e37=k-f4
al w0 f35+f37+f45+f47 ; statebit:= update_all_m,read_upd_m,
al w1 18 ; read_upd_l,update_all_l;proc_no:= 18
jl. w3 d0. ; goto prepare this segm.
jl. w3 d32. ; goto put_cf_int - -
jl. d16. ; goto return_algol - -
m.putcf
e. ; end put_cf
\f
; rc 28.06.71 rc4000 code procedure, connected files page 2.11
;
;
g3=k-j0
c. g3-506
m. code on segment 2 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system 2:>
m. segment 2
i.
e.
\f
; rc 28.10.74 rc4000 code procedure connected files page 3.1
;
; this segment contains.
; insert-m
; init-rec-m
; get-head
; call-jump-proc
;
b. g10, j150 ; code segment 3:
f0=f0+1 ; increase segm.count
k=f4
h.
j0: g1, g2 ; headword: last point, last absword
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm.1
j2: 1<11 o.(:2-f0:), 0 ; ref. to segm.2
j5: 1<11 o.(:5-f0:), 0 ; ref. to segm.5
j31: 0 , 21 ; own core byte 20-21, work_1_p
j32: 0 , 23 ; own core byte 22-23, work_2_p
j33: 0 , 25 ; own core byte 24-25, proc_no_p
j34: 0 , 27 ; own core byte 26-27, result_cf
j103: f1+3 , 0 ; rs reserve
j105: f1+5 , 0 ; rs goto point
j108: f1+8 , 0 ; rs end address expression
j113: f1+13, 0 ; rs last used
j130: f1+30, 0 ; rs saved stack ref, saved w3
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
\f
; rc 11.12.74 rc4000 code procedure, connected files page 3.2
;
;
; procedure insert_m(zm,record);
; procedure init_rec_m(zm,record);
; zone zm; array record;
;
; the procedures are placed in one block, as the treatment of formal 2
; is the same.
;
; insert_m-specification:
; inserts a new record in an existing masterfile.
; result_cf current record
; 1 record inserted the inserted
; 2 not inserted, already in file the one in the file
; 3 - - , too expensive next higher record
; 4 - - , file is full - - -
; 5 - - , length error - - -
; 6 - - , no buffer - - -
;
; init_rec_m-specification:
; adds records to the m_file in the in the key-order.
; result_cf current record
; 1 record added none
; 2 not added, file is full -
; 3 - - , improper length -
; 4 - - , - key -
;
b. a20, c10 ; begin block
w.
e22=f0-1 ; insert_m:
e23=k-f4
al w0 f35+f37 ; statebits:= update_all_m and read_upd_m
al w1 11 ; proc_no:= 11
rl. w3 (j2.) ; prepare(state-bits)
jl w3 x3+d1 ;
jl. a0.
e56=f0-1 ; init_rec_m:
e57=k-f4
al w0 f39 ; statebits:= init_m
al w1 28 ; proc_no:= 28
rl. w3 (j2.) ; prepare(statebits)
jl w3 x3+d1 ; w2:= cf_buf_ref upon return
; w3:= stack_ref - -
;
a0: ; treat-record-array:
dl w1 x3+12 ; w1:= dope-address
rl w3 x1 ; w3:= array-base
ba w1 0 ;
dl w1 x1 ; w0, w1:=
ba. w0 1 ; upper + 1, lower-k
sh w1 0 ; if lower-k > 0 or
sh w0 (x2+b12) ; upper + 1 <= min_rec_size_zb then
jl. a10. ; goto alarm(array p)
\f
; rc 28.06.71 rc4000 code procedure, connected files page 3.3
;
;
;
wa w3 x2+b11 ; w3:= abs-length-position:=
; array-base + rec-length-pos-zb
;
am (x2+b10) ; case rec-length-type-zb of
jl. a1. ; begin
a1:
jl. a3. ; 0: fixed
0
0
;
bl w1 x3 ; 6: byte
rs. w1 (j31.) ; save user-size for later restauration
jl. a11. ;
;
rl w1 x3 ; 12: word
rs. w1 (j31.) ;
jl. a11. ;
;
rl w1 x3 ; 18: double-word
rs. w1 (j31.) ;
jl. a11. ;
;
dl w1 x3 ; 24: real
ds. w1 (j31.) ;
cf w1 0 ;
a11: ; end case rec-length-type-zb
;
rs. w3 (j32.) ; work-2-p:= save-abs-length-position
;
; snapshot
; w1 user-part-size
; work-0-p, work-1-p save-significant-part-of-user-array
; w3 = work-2-p abs-address-of-this-part
;
al w1 x1+3 ; add 3 to user-part-size; (start round up)
sl w1 (x2+b12) ; if user-part-size >= min-rec-size-zb
wa w1 x2+b9 ; then add ch-part-size-zb
; this will ensure a length-error from
; insert-rec-i in the case:
; user-part-size < min-rec-size <=
; user-part-size + chain-part-size
;
; rec-length:= rec-size//4; because
as w1 -2 ; file-i measures length in zone-elements
;
am (x2+b10) ; case rec-length-type-zb of
jl. a2. ; begin
a2=k-6
hs w1 x3 ; 6: byte
jl. a3. ;
0
;
rs w1 x3 ; 12: word
jl. a3. ;
0
\f
; rc 20.04.79 rc4000 code procedure, connected files page 3.4
;
;
;
rs w1 x3 ; 18: double-word
jl. a3. ;
0
;
ci w1 0 ; 24: real
ds w1 x3 ;
; ; end case rec-length-type-zb
a3: al w1 -14 ; ready for file_i: reserve(14 bytes)
jl. w3 (j103.) ; w1:= lastused:= newtop
; old_stack_ref = w1 + 14
dl w0 x1+14+12 ; move formals.2
ds w0 x1+12
rl. w1 (j33.) ; w1:= proc_no_p
sn w1 11 ; skip if not insert_m
am 8<2 ;
al w1 2<2 ; w1:= proc_no_i shift 2
rl. w0 j0. ; w0:= return segm.
rl. w3 (j2.) ;
jl w3 x3+d37 ; goto call_file_i(proc_no_i)
rs. w1 (j34.) ; result_cf:= result_i:= w1
rl. w0 (j33.)
se w0 11 ; skip if insert_m
jl. a6. ; goto spec. init_rec_m
\f
; rc 18.10.78 rc4000 code procedure, connected files page 3.4.1
; spec. insert_m
rl. w3 (j2.) ; set_rec_pointers;
jl w3 x3+d7
rl. w1 (j34.) ; w1:= result-cf
se w1 1 ; if record not inserted then goto finis
jl. a8.
; put 0 in chainfields (insert)
al w0 0 ; w0:= 0;
rl w1 x2+b8 ; w1:= w3:= chain_part_base_zb
al w3 x1
wa w3 x2+b9 ; addr:= w3:= w3 +chain_part_size_zb
a4: sh w3 x1 ; if addr = chain_part_base_zb then
jl. a5. ; end loop
rs w0 x3 ; w(addr):= 0
al w3 x3-2 ; addr:= addr -2
jl. a4. ;
a5: rl w0 x2+b6 ; test zonestate = read_upd_m:
so w0 1 ; if mode_bits_zb extract 1 = 1 then
jl. a8. ;
rl. w3 (j2.) ; put_cf_int
jl w3 x3+d33 ;
jl. a8. ; goto finis
;
; spec. init_rec_m
a6:
se w1 1 ; if record not added then goto finis
jl. a8. ;
;
rl w3 x2+b5 ; i-buf-ref:= base-buffer-area
rl w3 x3+h0+0
wa w3 x3+1 ; +i_buf_ref_rel
rl w0 x3+f50 ; w0:= recbase:= base_of_next_free_i
ws w0 x3+f55 ; - entrysize(recs)_i;
rs w0 (x2+b5) ; recbase_zd:= w0
rl w0 x3+f55 ; w0:= entrysize(recs)_i
ws w0 x2+b9 ; - chain_part_size_zb
am (x2+b5) ;
rs w0 +4 ; recsize_zd:= w0
rl w3 x3+f50 ; w3:= base_of_next_free_i
\f
; rc 20.04.79 rc4000 code procedure, connected files page 3.5
;
;
; put 0 in chainfields (init)
al w0 0 ; w0:= 0;
al w1 x3 ; addr:= w3; w1:= w3
ws w1 x2+b9 ; w1:= chain_part_base:= w1-chainpartsize_zb
a7: sh w3 x1 ; if addr = chain_part_base then
jl. a8. ; goto finis;
rs w0 x3 ; w(addr):= 0
al w3 x3-2 ; addr:= addr -2
jl. a7.
a8: ; finis:
; if variable length then restore length in formal 2
rl. w3 (j32.) ; w3:= save-abs-length-position
;
am (x2+b10) ; case rec-length-type-zb of
jl. a9. ; begin
a9: ; return:
rl. w3 (j2.) ; 0: fixed
jl x3+d17 ; return-algol
0
;
rl. w1 (j31.) ; 6: byte
hs w1 x3 ;
jl. a9. ;
;
rl. w1 (j31.) ; 12: word
rs w1 x3 ;
jl. a9. ;
;
rl. w1 (j31.) ; 18: double-word
rs w1 x3 ;
jl. a9. ;
;
dl. w1 (j31.) ; 24: real
ds w1 x3 ;
jl. a9. ;
; ; end case rec-length-type-zb
;
a10: al w1 13 ;
rl. w3 (j1.) ; goto alarm(13)
jl w3 x3+d35 ;
i.
;
e. ; end block init_, insert_
\f
; rc 26.09.72 rc4000 code procedure, connected files page 3.6
;
;
; get-head(zl, chain, key).
;
; file-cf procedure.
;
; the procedure is used on current record of a list-file to return the
; key of the mother-record of a chain to which the record is connected.
;
; result-cf current record
; 1 ok unchanged
; 2 record not connected unchanged
;
b. a40, c10 ; begin get-head
w.
e20=f0-1
e21=k-j0
al w1 10 ; proc-no:= 10
al w0 f43+f45+f47 ; prepare(read-only-l, read-update-l,
rl. w3 (j2.) ; update-all-l)
jl w3 x3+d1 ;
;
rl w3 x2+b5 ;
rl w3 x3+4 ;
sh w3 0 ; if rec-size-zd = 0 then
jl. a14. ; goto alarm(no.curr.)
;
al w0 12+0 ; check-chain(param-2, daughter)
rl. w3 (j5.) ;
jl w3 x3+d5 ;
;
rl w0 x1+10 ; if head-fld-size-tbl = 0 then
sh w0 0 ; goto alarm(chain.not.headed)
jl. a20. ;
;
rl w3 x2+b8 ; w3:= addr-of-next-chfld
wa w3 x1+4 ;
;
rl w0 x3 ; if next-chfld = not-connected then
sn. w0 (c0.) ; goto result-2
jl. a10. ;
;
ds. w3 c2. ; save original cf-buf-ref
; save-base-1:= addr-of-next-chfld
rl w2 x1+2 ; cf-buf-ref:= m-cf-buf-ref-tbl
;
rl. w3 (j113.) ; take key-array, obs. rs last-used.....
dl w1 x3+16 ;
rl w3 x1 ; w3:= addr-of-element-0
ba w1 0 ; w1:= dope-addr
dl w1 x1 ; w0, w1:= upper, lower-k
sl w1 1 ; if lower-k > 0 then
jl. a13. ; alarm(array p)
; w0 is checked later (size)
;
rl w1 x2+b15 ;
sz w1 1 ; if file-type = list (1) then
jl. a1. ; goto list-file
;
\f
; rc 28.06.71 rc4000 code procedure, connected files page 3.7
;
;
; master-file.
;
rl w1 x2+b12 ;
sh w0 x1-1 ; if size-of-array < min-rec-size-zb
jl. a13. ; then goto alarm(array p)
;
rl w1 x2+b7 ; w1:= split-key-code-zb
al. w0 a2. ; store return-address
rs w0 x1-2 ;
rl. w2 c2. ; w2:= save-base-1
;
; obs. w3 = base-2 = base-of-array-key
;
jl x1 ; split-key-code
;
; split-key-code returns to a2
;
;
a1:
; list-file.
;
sh w0 3 ; if size < 4 then
jl. a13. ; goto alarm(array p)
;
al w0 0 ;
rl. w1 c2. ; w1:= save-base-1
rl w1 x1+1 ; double-word(base-2 + 3):=
ds w1 x3+3 ; 0, word(base-1 + 1)
;
a2: ; return:
rl. w2 c1. ; fetch original cf-buf-ref
;
a3: ; return(from result-2):
rl. w3 (j2.) ;
jl x3+d17 ; return algol
;
a10: ; result-2:
al w0 2 ; result-cf:= 2
rs. w0 (j34.) ;
jl. a3. ; goto return(from result-2)
;
a13: am 13-14 ; alarm(array p):
a14: am 14-20 ; alarm(no.curr.):
a20: al w1 20 ; alarm(chain not headed):
rl. w3 (j1.) ;
jl w3 x3+d35 ; alarm
;
c0: f8 ; not connected
c1: 0 ; save original cf-buf-ref
c2: 0 ; save base-1
i.
e. ; end get-head
\f
; rc 01.11.74 rc4000 code procedure, connected files page 3.8
;
;
; call jump-proc:
;
; a new stack picture is set up with the zone and cf-proc-no-p as
; parameters, and the jump-proc is called.
; because of fortran, the jump proc must return to this point, else
; the reserved bytes would not be released correctly.
;
b. a10, c10
w.
d54: d55=k-f4 ; call jump-proc:
rl. w2 (j113.) ; w2:= last used;
al w1 -16 ; reserve 16 bytes and
jl. w3 (j103.) ; set up call of jump-proc:
; ks 11
rs w2 x1 ; stack-ref
rl. w3 j0. ; segm.table addr. and
al w0 a1 ; rel. return addr.
ds w0 x1+4 ;
; ks 12
al w0 10 ; appetite:= 10;
hs w0 x1+4 ;
rl. w3 c1. ; new formal 1.1:= zone-kind;
rl w0 x2+8 ; new formal 1.2:= old formal 1.2;
ds w0 x1+8 ; (rec-base-addr)
; ks 13
al w3 26 ; new formal 2.1:= integer kind;
al w0 x2-1 ; new formal 2.2:= addr. of cf-proc-no;
ds w0 x1+12 ;
; ks 14
rl. w0 (j33.) ; store cf-proc-no-p as litteral;
rs w0 x2-1 ;
; ks 15
rl w2 x2+6 ; w2:= cf-buf-ref;
dl w1 x2+b4+2 ; w0w1:= stackref, entry-point of jump-proc;
jl. (j105.) ; call jump proc; comment goto point;
a1=k-j0 ; re_entry after call of jump-proc:
ds. w3 (j130.) ; save stackref, w3;
jl. (j108.) ; goto end-address-expression;
;
c1: 6<12 + 23 ; first formal of zone-parameter;
i.
e. ; end call-jump-proc;
g3=k-j0
c. g3-506
m. code on segment 3 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system 3:>
m. segment 3
i.
e.
\f
; rc 10.09.79 rc4000 code procedure, connected files page 4.1
;
; this segment contains:
; get-block-r and get-block-b
; get-rec-n and get-rec-n-int
; get-numb-l
;
b. g3, j185 ; code segment 4
w.
f0=f0+1 ; increase segm.count
k=f4 ; k:= first k-value
h.
j0: g1, g2 ; head-word: last point, last abs word
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm.1
j2: 1<11 o.(:2-f0:), 0 ; ref. to segm.2
j21: 0 , 1 ; own core, return-1-p
j22: 0 , 3 ; own core, return-1-p
j23: 0 , 5 ; own core, return-2-p
j24: 0 , 7 ; own core, return-2-p
j26: 0 , 11 ; own core, rec-no-cf
j34: 0 , 27 ; own core, result-cf
j35: 0 , 29 ; own core, save-cf-buf-ref-p
j104: f1 + 4, 0 ; rs, take expression
j130: f1 +30, 0 ; rs, saved stackref, saved w3
j185: f1 +85, 0 ; rs, current activity
g2=k-2-j0 ; rel last abs word
;
j133: f1 +33, 0 ; rs, check
g1=k-2-j0 ; rel last point
w.
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 4.2
; get-block-r and get-block-b
;
; file-n subroutine
;
; these are the basic list-file administration routines, used each
; time a certain record or block is wanted.
; the block-fetching routine updates the sorted list of block-shares,
; and initiates the transfer back to the file of a new victim provided
; that at least 3 block-shares are available.
;
; if save-rec-no-zb <> 0, i.e. a current record exists internally, the
; administrative double-word in current record is restored if variable
; record-length, the last used block is put if update-all-mode, and
; save-rec-no-zb is set to zero.
;
; entry exit
; w0 return-segm-tbl-addr undef
; w1 rec-no or block-no undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-addr undef
;
; return quantities:
; block-ref-zb points to the first byte of the record-table
; of the wanted block.
; rec-no-rel-zb is returned by get-block-r, gives the
; address of the entry in the record-table
; corresponding to the record-number given as
; parameter, relative to block-ref-zb.
; block-zb the number of the block fetced.
;
;
b. a20, c20 ; begin get-block-r and get-block-b
w.
d72: rl. w0 j0. ; get-block-r:
d73=k-j0 ;
ws w3 (0) ; save return in return-2-p
hs. w3 (j23.) ;
rs. w0 (j24.) ;
;
al w0 0 ; calculate block-zb and rec-no-rel-zb
al w1 x1-1 ; (rec-no - 1)//recs-in-block-zb
wd w1 x2+b54 ;
rs w0 x2+b58 ; store rec-no-rel-zb = division-rest
jl. a0. ; goto common-code
;
d74: rl. w0 j0. ; get-block-b:
d75=k-j0 ;
ws w3 (0) ; save return in return-2-p
hs. w3 (j23.) ;
rs. w0 (j24.) ;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 4.3
a0: ; common-code:
;
dl w0 x2+b51 ; w3, w0:= save-size-zb, save-rec-no-zb
sn w0 0 ; if no-current-record then
jl. a10. ; goto continue
;
sn w3 (x2+b56) ; if fixed-rec-length then
jl. a9. ; goto reset-save-rec-no-zb (save-size-zb
; = fix-rec-size-zb only in this case)
am (x2+b5) ; restore administrative double-word at
am (0) ; record-base + 3
ds w0 +3 ;
;
a9: ; reset-save-rec-no-zb:
al w0 0 ;
rs w0 x2+b51 ;
;
al w0 f5 ;
rl w3 x2+b6 ;
sn w3 2 ; if mode-zb = update-all then
hs w0 (x2+b63) ; put-block
;
a10: ; continue:
; w1 = block-no
rs w1 x2+b64 ; store block-no in block-zb
rs. w2 (j35.) ; save cf-buf-ref in permanent
;
wm w1 x2+b53 ; use block-ref-zb for searched-segm-no:=
wa w1 x2+b52 ; block-zb * segs-in-block-zb
rs w1 x2+b57 ; + segs-in-head-zb
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 4.4
; search-share
;
; this is a makro which searches for the segment-number of the wanted
; block through the list of block-shares.
; while searching the list is pushed one word forward, so that the
; address of the found share can be inserted as last-used-share-zb.
;
; entry
; w0 undef
; w1 searched-segm-no
; w2 cf-buf-ref
; w3 undef
;
; the makro makes use of the slang-names:
; a1 to a3, and c0 to c1
;
rl w3 (x2+b61) ; insert searched-segm-no in victim-share,
rl w0 x3+6 ; and save the addr of the victim-share and
ds. w0 c1. ; the segm-no of the victim-share.
rs w1 x3+6 ; this will ensure a successfull search
; in any case.
;
; registers for search and push
; w0 searched-segm-no
; w1 share-addr
; w2 cf-buf-ref
; w3 list-addr
;
al w0 x1 ; searched-segm-no
rl w1 x2+b63 ; share-addr of last-used-share
;
sn w0 (x1+6) ; if segm-no(last-used-share) = searched-
jl. a2. ; segm-no then goto found-in-last-used
;
al w3 x2+b63 ; list-addr of last-used-share
;
a1: ; search-and-push:
rx w1 x3+2 ; 1, push share-list one word, and fetch
sn w0 (x1+6) ; next share-addr, if this share contains
jl. a3. ; searched-segm-no then goto found-elsewhere
;
rx w1 x3+4 ; 2.
sn w0 (x1+6) ;
jl. a3. ;
;
rx w1 x3+6 ; 3.
sn w0 (x1+6) ;
jl. a3. ;
;
rx w1 x3+8 ; 4.
sn w0 (x1+6) ;
jl. a3. ;
;
rx w1 x3+10 ; 5.
sn w0 (x1+6) ;
jl. a3. ;
;
al w3 x3+10 ; not found in this game
jl. a1. ; goto search-and-push
\f
; rc 02.08.72 rc4000 code procedure, connected files page 4.5
; constants
c0: 0 ; save victim-share-addr
c1: 0 ; save segm-no(victim)
;
a3: ; found-elsewhere:
rs w1 x2+b63 ; last-used-share-zb:= addr-of-found-share
;
a2: ; found-in-last-used:
dl. w0 c1. ; restore segm-no of old victim-share
rx w0 x3+6 ;
;
; registers
; w0 searched-segm-no
; w1 addr-of-last-used-share
; w2 cf-buf-ref
; w3 undef
;
; end search share makro
;
; insert last-used-share as used-share in the zone-descriptor
;
al w3 x1-6 ; obs. an address in the share-list points
am (x2+b5) ; to the message of the share-descriptor
rs w3 h0+4 ;
;
; if the found share is unchecked then check it
;
rl w3 x1-6 ; if share-state(last-used-share) = 0 then
sn w3 0 ;
jl. a5. ; goto check-segm-no
;
a4: ; check-transfer:
;ks 400
; call rs-check
rl w0 x2+b5 ; w0:= zone-descriptor-addr shift 4
ls w0 4 ;
rl. w1 j133. ; w1:= entry point check
dl. w3 (j130.) ; w2:= saved-stack-ref
jl. w3 (j104.) ; goto rs-take-expression
ds. w3 (j130.) ; save stack-ref
;
rl. w2 (j35.) ; fetch cf-buf-ref
rl w1 x2+b63 ; last-used-share-zb
al w0 f6 ;
hs w0 x1 ; operation(last-used-share):= read-oper
rl w0 x2+b57 ; w0:= searched-segm-no:= (block-ref-zb)
;
\f
; rc 10.09.79 rc4000 code procedure, connected files page 4.6
a5: ; check-segm-no:
; check that last-used-share contains the right block
;
; registers
; w0 searched-segm-no
; w1 last-used-share
; w2 cf-buf-ref
; w3 undef
;
sn w0 (x1+6) ; if right segm-no then
jl. a6. ; goto set-block-ref
;
; now it is evident that a transfer must be initiated, but perhaps the
; block must be written back in the first place
bz w3 x1 ; w3:= operation(last-used-share)
sn w3 f6 ; if operation = read-oper then
rs w0 x1+6 ; segm-no(last-used-share):=
; searched-segm-no
;
; now the transfer will be initiated by a call of send message.
; w1 points already to the message, w3 should point to the name
; of the area process.
rl w3 x2+b5 ;
al w3 x3+h1+2 ;
rl. w2 (j185.) ; w2:= rs_current_activity
jd 1<11+16 ; send message
;
; if no message buffer available (w2=0) then provoke break 6 by wait answer
sn w2 0 ;
jd 1<11+18 ; wait-answer
;
rs w2 x1-6 ; share-state:= w2:= buffer-address
rl. w2 (j35.) ; fetch cf-buf-ref
jl. a4. ; goto check-transfer
;
a6: ; set-block-ref:
; now the searched-segm-no saved in block-ref-zb is superfluous, and
; block-ref can be set.
rl w1 x1+2 ; block-ref-zb:= first-storage-address
al w1 x1-f20 ; (last-used-share) - f20
rs w1 x2+b57 ;
;
\f
; rc 18.10.79 rc4000 code procedure, connected files page 4.7
; if more than 2 block-shares are available the transfer of an
; updated victim is initiated now, provided that the transfer is
; not already initiated.
rl w1 x2+b61 ; if victim-zb <= addr last-used-zb + 2
sh w1 x2+b63+2 ; then
jl. a7. ; goto return
;
rl w1 x1 ; w1:= share-addr(victim)
bz w0 x1 ;
sn w0 f5 ; if operation<>write-oper
sh w0 (x1-6) ; or f5<share-state (f5=5) then
jl. a7. ; goto return
;
; initiate transfer of victim by send-message
rl w3 x2+b5 ;
al w3 x3+h1+2 ;
rl. w2 (j185.) ; w2 := rs_current_activity
jd 1<11+16 ; send message
;
; no message buffer available (w2=0) is ignored, share-state will
; still be 0 in that case, and it is in fact very unlikely that the
; process should have lost a message buffer since input of the wanted
; block.
rs w2 x1-6 ; share-state:= w2:= buffer-address
rl. w2 (j35.) ; fetch cf-buf-ref
;
a7: ; return:
rl. w3 (j24.) ; return-2-p
rl w3 x3 ;
jl. (j23.) ;
;
i.
e. ; end get-block-r and get-block-b
;
;
;
;
\f
; rc 01.11.77 rc4000 code procedure, connected files page 4.8
; get-rec-n
;
; file-n procedure
;
; the procedure fetches the record given by rec-no-cf, provided that
; it is a legal record-number describing a used record.
; chain-part-base-zb, rec-base-zd, rec-size-zd, and the length-field of
; a variable length record are set.
;
; entry exit
; w0 return-segm-tbl-addr undef
; w1 undef undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; call quantities:
; rec-no-cf specifies the wanted record
;
; alarms: 19, 22, 37.
;
b. a37, c20 ; begin get-rec-n
w.
d62: rl. w0 j0. ;
d63=k-j0 ;
ws w3 (0) ; save-return-1-p
hs. w3 (j21.) ;
rs. w0 (j22.) ;
d89=k-j0 ; get-rec-n-int: (called from set-mode-n)
rl. w1 (j26.) ; w1:= rec-no-cf
sh w1 (x2+b60) ; if rec-no>last-rec-no-zb
sh w1 0 ; or rec-no<=0 then
jl. a19. ; goto alarm(ill. rec-no)
;
jl. w3 d72. ; get-block-r(rec-no), on this segment
;
d92: ; entry from get_numb_l
rl w3 x2+b57 ; w3:= block-ref-zb
am (x2+b58) ; rec-base-rel:=
bz w0 x3 ; halfword(block-ref-zb + rec-no-rel-zb)
so w0 1 ; if used-bit = 0 then
jl. a22. ; goto alarm(rec-not-used)
;
wa w3 0 ; w3:= rec-base:= block-ref + rec-base-rel
rl. w1 (j26.) ; w1:= rec-no-cf
;
rl w0 x2+b56 ;
se w0 0 ; if fix-rec-size-zb <> 0 then
jl. a0. ; goto fix-rec-size
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 4.9
; variable rec-size
se w1 (x3+3) ; if rec-no-cf <> rec-no(record) then
jl. a37. ; goto alarm(wrong rec-no-rec)
;
rl w0 x3+1 ; load size(record) in w0
ds w1 x2+b51 ; save-size-zb, save-rec-no-zb:= w0, w1
;
ws w0 x2+b9 ; size:= size(record) - ch-part-size-zb
rs w0 x3+1 ; size(record):= size
jl. a1. ; goto set-pointers
;
a0:
; fix-rec-size.
rs w1 x2+b51 ; save-rec-no-zb:= rec-no-cf
ws w0 x2+b9 ; size:= fix-rec-size-zb - ch-part-size-zb
a1: ; set-pointers:
rl w1 x2+b5 ; w1:= rec-base-addr-zb
rs w3 x1 ; rec-base-zd:= rec-base
rs w0 x1+4 ; rec-sise-zd:= size
wa w3 0 ; ch-part-base-zb:=
rs w3 x2+b8 ; rec-base + size
; return.
rl. w3 (j22.) ; return-1-p
rl w3 x3 ;
jl. (j21.) ;
;
; alarms:
a19: am 19-22 ; alarm(ill. rec-no)
a22: am 22-37 ; alarm(rec-not-used)
a37: al w1 37 ; alarm(wrong rec-no-rec)
rl. w3 (j1.) ;
jl w3 x3+d35 ; alarm(alarm-no)
i.
e. ; end get-rec-n
;
\f
; rc 01.11.77 rc4000 code procedure, connected files page 4.10
; get-numb-l(zl, rec-no)
;
; file-cf procedure
;
; makes the list-file record given by recno available as current record,
; provided the recno is legal and the record is not dead.
;
; result-cf current record
; 1 record active the wanted
; 2 record not found the rec. with next higher no.
; 3 no more recs. none
;
b. a19, c10 ; begin get-numb-l
w.
e46=f0-1
e47=k-j0
al w1 23 ; proc-no:= 23
al w0 f43+f45+f47 ; prepare(read-only-l, read-update-l,
rl. w3 (j2.) ; update-all-l)
jl w3 x3+d1 ;
;
dl w1 x3+12 ; take param 2
so w0 16 ; if expression then
jl. a10. ; goto take-expression
;
a0: ; take-value:
rl w1 x1 ; get parameter=rec_no
rs. w1 (j26.) ; rec_no_cf := rec_no
sh w1 0 ; if rec_no <= 0
jl. a19. ; then alarm(ill. rec_no)
; while rec_no_cf <= last_rec_no_zb search blocks
a1: am (x2+b60) ; if rec_no > last_rec_no
sl w1 +1 ;
jl. a4. ; then result_3
jl. w3 d72. ; else get_block_r(rec_no)
; prepare calc. of position of next_chfld
; c0 := chain_part_size - chfld_rel_tbl
rl w3 x2+b17 ; w3 := first_d_ch_addr_zb
rl w0 x2+b9 ; chain_part_size
ws w0 x3+4 ; -chfld_rel_tbl
rs. w0 c0. ;
;
rl w3 x2+b58 ; rec_no_rel_zb
; while rec_no_rel <= recs_in_block search halfwords
a2: am (x2+b57) ; add block_ref
bz w1 x3 ; to get halfword
so w1 1 ; if not_used
jl. a3. ; then next halfword
; else check dead or alive
wa w1 x2+b57 ; rec_base := block_ref + rec_base_rel
rl w0 x2+b56 ; if fix_rec_size_zb = 0
sn w0 0 ;
rl w0 x1+1 ; then get var_size
\f
; rc 18.10.78 rc4000 code procedure, connected files page 4.10.1
;
; a:next_chfld := size-(chain_part_size - chfld_rel_tbl) + rec_base
ws. w0 c0. ; -(chain_part_size - chfld_rel_tbl)
wa w1 0 ; + rec_base
rl w0 x1 ; w0 := c:next_chfld
sl w0 0 ; if >= 0
jl. a5. ; then found (not dead)
; else next rec_no
a3: al w1 1 ; rec_no_cf :=
wa. w1 (j26.) ; rec_no_cf +1
rs. w1 (j26.) ;
al w0 2 ; result_cf := 2
rs. w0 (j34.) ;
al w3 x3+1 ; adj. for next halfword
sl w3 (x2+b54) ; if rec_no_rel >= recs_in_block
jl. a1. ; then next block
jl. a2. ; else continue (inner while)
;
; result_3
a4: al w0 3 ; rec_no > last_rec_no
rs. w0 (j34.) ; result_cf := 3
al w0 0 ; rec_size_zd := 0
rl w1 x2+b5 ;
rs w0 x1+4 ;
rl. w3 (j2.) ; return_algol
jl x3+d17 ;
;
; found (wanted or next higher)
; return_algol via last part of get_rec_n
a5: rs w3 x2+b58 ; update rec_no_rel_zb
rl. w0 j2. ; segm. 2
rs. w0 (j22.) ;
al w0 d17 ; return_algol
hs. w0 (j21.) ;
jl. d92. ; go get_rec_n
;
a10: ; take-expression:
al w2 x3 ; w2:= stack-ref
jl. w3 (j104.) ; goto rs-take-expression
ds. w3 (j130.) ; save stack-ref
rl w2 x2+6 ; cf_bufref:= formal.1.1
jl. a0. ; goto take-value
; alarms
a19: al w1 19 ; alarm(ill. rec_no)
rl. w3 (j1.) ;
jl w3 x3+d35 ;
;
c0: 0 ; temp: chain_part_size - chfld_rel_tbl
\f
; rc 02.08.72 rc4000 code procedure, connected files page 4.11
i.
e. ; end get-numb-l
g3=k-j0
c. g3-506
m. code on segment 4 too long
z.
c. 502-g3
0, r. 252-g3>1 ; zero fill
z.
<:cf-system 4:>
i.
e.
m. end segment 4
\f
; rc 03.05.71 rc4000 code procedure, connected files page 5.1
;
; this segment contains.
; check-chain
; set-free-n
; log-func - log-func-r
; move-word - move-double
; compare
; new-head-chain
;
b. g3, j150 ; code segment 5
f0=f0+1 ; increase segm.count
k=f4 ; k:= first k-value
h.
j0: g1, g2 ; head-word: last point, last abs word
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm. 1
j32: 0 , 23 ; own core, work-2-p
j130: f1 +30, 0 ; rs, saved stackref, saved w3
g2=k-2-j0 ; rel last abs word
g1=k-2-j0 ; rel last point
w.
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.2
; check-chain
;
; file-cf subroutine
;
; takes the chain-parameter indicated by the parameter, and performs
; the following checks:
;
; 1: the parameter must not be an expression.
;
; 2: chain address for this zone greater or equal to address of
; first mother chain and less than cf-buf-ref
;
; 3: other-ch-addr(chain-param) = other-ch-addr-tbl and
; other-ch-addr(chain-param) > address of formal.
;
; if 2 is fulfilled, but 3 not, it is checked whether
; word(chain-addr) = word(chain-addr + 2) = -1, in that case, the
; alarm 16, chain not initialized, will be given.
;
; entry exit
; w0 formal-rel + mother-bit undef
; w1 undef chain-addr
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; call quantities:
; formal-rel 8 chain is parameter no. 1
; 12 chain is parameter no. 2, etc.
; mother-bit 0 this zone is daughter
; 1 this zone is mother
;
; return quantities:
; curr-d-ch-zb chain-addr (if mother-bit = 0)
; curr-m-ch-zb chain-addr (if mother-bit = 1)
;
; alarms: 15, 16, 36.
;
b. a36, c10 ; begin check-chain
w.
d4: d5=k-j0 ;
rs. w3 c0. ; save return
am. (j130.) ;
rl w3 -2 ; w3:= saved stackref
;
wa w3 0 ; w3:= formal-2-addr + mother-bit
dl w1 x3 ; w0, w1:= formals
so w0 16 ; if expression then
jl. a36. ; goto alarm(express.)
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.3
so w3 1 ; if mother-bit then
jl. a0. ; begin
rl w0 x1 ; other-ch-addr-param:= second-word
rl w1 x1-2 ; chain-addr:= first-word
rs w1 x2+b19 ; curr-m-ch-zb:= chain-addr
jl. a1. ; end
; else
a0: ; begin
dl w1 x1 ; other-ch-addr-param:= first-word
; chain-addr:= second-word
rs w1 x2+b20 ; curr-d-ch-zb:= chain-addr
a1: ; end
; w0 = other-ch-addr-param
; w1 = chain-addr
sl w1 (x2+b16) ; if chain-addr < first-m-ch-addr-zb
sl w1 x2 ; or chain-addr >= cf-buf-ref then
jl. a15. ; goto alarm(chain-p)
;
sn w0 (x1) ; if other-ch-addr-param <> other-ch-addr-
; tbl
sh w0 x3 ; or other-ch-addr-param <= addr-of-formal
jl. a3. ; then goto check-not-init
;
jl. (c0.) ; goto return
;
a15: am 15-16 ; alarm(chain-p):
a16: am 16-36 ; alarm(not-init):
a36: al w1 36 ; alarm(express.):
rl. w3 (j1.) ;
jl w3 x3+d35 ; alarm
;
a3: ; check-not-init:
rl w0 x1 ; w0:= other-ch-addr-tbl
sn w0 -1 ; if other-ch-addr-tbl <> -1
se w0 (x1+2) ; or other-ch-addr-tbl <> other-cf-buf-
; ref-tbl then
jl. a15. ; goto alarm(chain-p)
jl. a16. ; else goto alarm(not-init)
;
c0: 0 ; save-return
i.
e. ; end check-chain
;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.4
; set-free-n
;
; file-n procedure
;
; the procedure releases the current list-file record, and adjusts the
; various counters, but it does not access any new record.
;
; entry exit
; w0 undef undef
; w1 undef undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
b. a10, c10 ; begin set-free-n
w.
d64:
d65=k-j0
rs. w3 c2. ; save return
;
rl w3 x2+b57 ; subtract used-bit from
wa w3 x2+b58 ; byte(block-ref-zb + rec-no-rel-zb)
bz w1 x3 ; = rec-base-rel(current record)
al w1 x1-1 ;
hs w1 x3 ;
;
rl w3 x2+b57 ; w3:= block-ref-zb
bz w1 x3+f21 ; free-rec-nos:=
al w1 x1+1 ; free-rec-nos + 1
hs w1 x3+f21 ;
;
bz w0 x3+f20 ; free-bytes:=
wa w0 x2+b50 ; free-bytes + save-size-zb
hs w0 x3+f20 ;
;
jl. w3 d76. ; free:= w0:= log-func(free-bytes), (>=1)
;
rl w3 x2+b57 ; w3:= block-ref-zb
al w1 -1 ; erase the overflow pointer of the
sl w0 55 ; block, if the block is now at least
rs w1 x3+f23 ; half empty (w0 >= 55)
;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 5.5
rl w3 x2+b64 ; w3:= block-zb
so w3 1 ; if even block-number then
ls w0 6 ; shift free left, (w0>= 64)
;
ls w3 -1 ; block-table-entry-address - f18:=
wa w3 x2+b61 ; block-zb//2 + victim-zb
;
bz w1 x3+f18 ; load left and right old entries
sh w0 63 ; mask out one of them
am 2 ; mask right entry
la. w1 c0. ; mask left entry
lo w1 0 ; add old and new entries
hs w1 x3+f18 ; store the updated double-entry
;
rl w3 x2+b61 ; now decr. dead-bytes and used-bytes
ac w1 (x2+b50) ; dead_bytes:= - save_size_zb
am (x3+2) ; + dead_bytes
al w1 x1 ;
rs w1 x3+2 ;
ac w0 (x2+b50) ; used-bytes := - save_size_zb
ad w1 -24 ; extend
aa w1 x3+6 ; + used_bytes
ds w1 x3+6 ;
;
rl w1 x2+b5 ; w1:= rec-base-addr-zb
;
dl w0 x2+b51 ; load save-size-zb, save-rec-no-zb
sn w3 (x2+b56) ; if save-size-zb = fix-rec-size-zb then
jl. a2. ; goto reset-save-rec-no-zb
; (only possible for fixed rec-size)
al w3 x3+1 ; restore administrative double-word with
am (x1) ; free-bit added to size
ds w0 +4 ;
;
a2: ; reset-save-rec-no-zb:
al w0 0 ;
rs w0 x2+b51 ; save-rec-no-zb:= 0
;
al w0 f5 ;
hs w0 (x2+b62) ; put blocktable;
hs w0 (x2+b63) ; put block
;
jl. (c2.) ; goto return
;
c0: 8.0077 ; mask for removing left block-table entry
c1: 8.7700 ; mask for removing right block-table entry
c2: 0 ; save-return-address
i.
e. ; end set-free-n
;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.6
; log-func and log-func-r
;
; file-n subroutines
;
; the subroutines compute a logarithmic function of the number of free
; bytes in a block and the number of bytes wanted for a record respec-
; tively.
; the value of the function is intended for use as a block-table entry
; and for comparison with block-table entries.
;
; entry exit
; w0 byte-quantity <= max-free-bytes log-func or log-func-r
; w1 undef undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address unchanged
;
; value of the function:
; 1 <= log-func <= 63
; 63 is only obtained for free-bytes = max-free-bytes, i.e. for
; a completely free block.
;
; 0 <= log-func-r <= 62
; 0 is only obtained for records of fixed size.
;
; the safe condition for insertion of a record in a block is this:
;
; log-func-r(rec-size) < block-table-entry(block)
;
; where block-table-entry(block) should be calculated thus:
;
; block-table-entry(block):=
; if free-rec-nos(block) > 0 then log-func(free-bytes(block))
; else 0
;
b. a10, c10 ; begin log-func and log-func-r
w.
d86: d87=k-j0 ; log-func-r:
rl w1 x2+b56 ; w1:= fix-rec-size-zb
se w1 0 ; if fix-rec-size-zb <> 0 then
jl. a0. ; goto result-zero
ws. w0 c1. ; byte-quantity:= byte-quantity - 2
; (to enable insertion of max record)
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.7
d76: d77=k-j0 ; log-func:
al w1 0 ; w1:= byte-quantity * 2**24
wd w1 x2+b55 ; //max-free-shift-3-zb
;
al w0 -1 ; w0:= all ones
ns w1 1 ; w0:= - shifts (-2048 <= w0 <= -1)
; w1:= norm ( 0.25 <= w1 < 0.5)
;
ls w1 2 ; remove bit 0-1 ( 0.0 <= w1 < 1.0)
ld w1 3 ; w0:= (-shifts + (norm - 0.5) shift 2)
; shift 3 (-2048*8 <= w0 <= -8)
wa. w0 c0. ; + 71 ( w0 <= 63)
;
sh w0 0 ;
al w0 1 ; ( 1 <= w0 <= 63)
jl x3 ; goto return
;
a0: ; result-zero:
al w0 0 ;
jl x3 ;
;
c0: 71 ; 63 - (-8)
c1: 2 ; 2 bytes
i.
e. ; end log-func and log-func-r
;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.8
; move-word
;
; file-cf subroutine
;
; moves an even number of bytes (perhaps zero) between two separate
; core areas (1 and 2) identified by the address of the last preceding
; byte or the address of the first byte.
;
; entry exit
; w0 size >= 0 undef
; w1 base-1 undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; call quantity:
; work-2-p base-2
;
b. a20, c20 ; begin move-word, move-double
w.
d8: d9=k-j0 ;
ds. w3 c0. ; save cf-buf-ref, save return
rl. w2 (j32.) ; w2:= base-2
so w0 2.10 ; if size mod 4 = 0 then
jl. a0. ; goto from-even-no-of-words
; the first word is moved separately
rl w3 x1+1 ; move the word
rs w3 x2+1 ;
;
wa w0 4 ; last-2:= size + base-2
al w1 x1+2 ; increment base-1 and base-2
al w2 x2+2 ;
jl. a5. ; goto from-odd-no-of-words
;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.9
; move-double
;
; file-cf subroutine
;
; moves an even number of words (perhaps zero) between two separate
; core areas (1 and 2) identified by the address of the last preceding
; byte or the address of the first byte.
;
; entry exit
; w0 size >= 0 undef
; w1 base-1 undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; call quantity:
; work-2-p base-2
;
d30: d31=k-j0 ;
ds. w3 c0. ; save cf-buf-ref, save return
rl. w2 (j32.) ; w2:= base-2:= work-2-p
;
a0: ; from-even-no-of-words:
wa w0 4 ; last-2:= w0:= size + base-2
a5: ; from-odd-no-of-words:
rs. w0 c1. ; save last-2
;
c2=40 ; portion:= 10 double-words
; this is the max portion moved in one game by the move-list.
sl w0 x2+c2 ; if last-2 >= base-2 + portion then
jl. a3. ; goto move-list
a1: ; remaining:
al w3 x2 ;
ws w3 0 ;
jl. x3+a4. ; goto (end-list - (last-2 - base-2))
a2: ; repeat:
al w1 x1+c2 ; base-1:= base-1 + portion
al w2 x2+c2 ; base-2:= base-2 + portion
sh w0 x2+c2-1 ; if last-2 < base-2 + portion then
jl. a1. ; goto remaining
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.10
; registers for move
; w0 work
; w1 base-1
; w2 base-2
; w3 work
;
; word(c1.) = last-2
; c2 = portion
;
; obs. the last moved double-word is that at the lowest address, this
; simplifies the administration of remaining.
;
a3: ; move-list:
c3=k+c2-1 ; used in move-list
c4=c3+2 ;
;
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
;
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
dl w0 x1+c3-k , ds w0 x2+c4-k
;
a4: ; end-list:
rl. w0 c1. ; w0:= last-2
sl w0 x2+c2+1 ; if last-2 > base-2 + portion then
jl. a2. ; goto repeat
;
dl. w3 c0. ; w2:= cf-buf-ref
jl x3 ; goto save-return
;
0 ; save-cf-buf-ref
c0: 0 ; save-return
c1: 0 ; save-last-2
i.
e. ; end move-word, move-double
;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.11
; compare
;
; file-cf subroutine
;
; compares an even number of bytes in two core areas, identified by
; the address of the last preceding byte or the address of the first
; byte.
; (optimized for size <= 20 (10 words)).
;
; entry exit
; w0 size >= 0 result
; w1 base-1 undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; call quantity:
; work-2-p base-2
;
; return quantity:
; result = w0 1 the two areas are equal
; 0 the two areas are not equal
;
b. a10, c10 ; begin compare
w.
d10: d11=k-j0 ;
ds. w3 c0. ; save cf-buf-ref, save return
rl. w2 (j32.) ; w2:= base-2:= work-2-p
wa w0 4 ; w0:= last-2:= size + base-2
c2=20 ; portion:= 10 words
; this is the max portion compared in one game by the compare-list.
sl w0 x2+c2 ; if last-2 >= base-2 + portion then
jl. a3. ; goto compare-list
;
a1: ; remaining:
al w3 x2 ;
ws w3 0 ;
am x3 ;
am x3 ;
jl. x3+a4. ; goto (end-list - (last-2 - base-2)*3)
;
a2: ; repeat:
al w1 x1+c2 ; base-1:= base-1 + portion
al w2 x2+c2 ; base-2:= base-2 + portion
sh w0 x2+c2-1 ; if last-2 < base-2 + portion then
jl. a1. ; goto remaining
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.12
; registers for compare
; w0 last-2
; w1 base-1
; w2 base-2
; w3 work
;
; the last compared is at the lowest address.
;
a3: ; compare-list:
c3=k + (:c2-1:)*3 ; used in compare-list
c4=c3+2 ;
;
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
;
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
rl w3 x1+(:c3-k:)/3 , se w3 (x2+(:c4-k:)/3) , jl. a6.
;
a4: ; end-list:
sl w0 x2+c2+1 ; if last-2 > base-2 + portion then
jl. a2. ; goto repeat
al w0 1 ; result:= equal
dl. w3 c0. ; w2:= save-cf-buf-rel
jl x3 ; goto save-return
;
a6: ; not-equal:
al w0 0 ; result:= not equal
dl. w3 c0. ;
jl x3 ;
;
0 ; save-cf-buf-ref
c0: 0 ; save-return
i.
e. ; end compare
;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 5.13
; new-head-chain
;
; file-cf subroutine
;
; the subroutine is called in a mother-zone, where current record
; must exist.
; it moves save_key to the chain-table in a daughter-zone correspon-
; ding to curr_m_ch_zb.
; it initializes the prior_ and last_acc_fields of the chain-table
; to zero, and the next_field to the value of next_chfld of the
; record.
; at last it includes the makro, back_to_daughter,.
; call return
; w0: undef undef
; w1: undef curr_ch (daughter)
; w2: cf_buf_ref (mother) cf_buf_ref(daughter)
; w3: return_addr undef
;
;
b. c0 ; new_head_chain:
w.
d18: d19=k-f4
rs. w3 c0. ; save_return:= w3;
rl w1 x2+b19 ; chain_addr:= w1:= curr_m_ch_zb;
rl w3 x1 ; base_2:= work_2_p:=
al w3 x3+f14 ; d_ch_addr_tbl + f14
rs. w3 (j32.) ;
rl w0 x2+b14 ; size:= w0:= save_head_size_zb;
al w1 x2+b21-1 ; base_1:= cf_buf_ref + b21 - 1;
jl. w3 d8. ; call move_word;
;
rl w1 x2+b19 ; curr_ch:= w1:= curr_m_ch_zb;
rl w3 x2+b8 ; w3:= addr of next_chfld
wa w3 x1+4 ;
rl w0 x3 ; w0:= next_chfld
;
; back_to_daughter:
dl w2 x1+2 ; w1:= chain_addr (daughter);
; w2:= cf_buf_ref (daughter);
rs w0 x1+f13 ; next_tbl:= w0:= next_chfld(mother_rec)
al w0 0 ; last_acc_tbl (daughter):=
al w3 0 ; prior_tbl (daughter):= 0;
ds w0 x1+f12 ;
jl. (c0.) ;
c0: 0 ; save return
i.
e. ; end block new_head_chain
g3=k-j0
c. g3-506
m. code on segment 5 too long
z.
c. 502-g3
0, r. 252-g3>1 ; zero fill
z.
<:cf-system 5:>
i.
e.
m. segment 5
\f
; rc 15.06.71 rc4000 code procedure, connected files page 6.1
;
; this segment contains:
; get_l
; next_l_int
; adjust_prior_rec
;
b. g10, j150 ; code segment 6:
f0=f0+1 ; increase segm.count
k=f4
h.
j0: g1, g2 ; headword: last point, last absword
j1: 1<11 o.(:1-f0:), 0 ; segment 1
j2: 1<11 o.(:2-f0:), 0 ; - 2
j4: 1<11 o.(:4-f0:), 0 ; - 4
j5: 1<11 o.(:5-f0:), 0 ; - 5
j7: 1<11 o.(:7-f0:), 0 ; - 7
j26: 0 , 11 ; rec_no_cf
j31: 0 , 21 ; work_1_p
j32: 0 , 23 ; work_2_p
j34: 0 , 27 ; result_cf
j104: f1+ 4, 0 ; rs-entry 4, take_expression
j113: f1+13, 0 ; - 13, last_used
j130: f1+30, 0 ; - 30, saved_stack_ref, saved_w3
g2 = k-2-j0 ; relative of last abs-word
g1 = k-2-j0 ; - - - point
w.
\f
; rc 01.11.77 rc4000 code procedure, connected files page 6.2
;
;
;
; procedure get_l(zl, chain, gmode);
; zone zl; real chain; integer gmode;
;
; the procedure searches a new current record in a listfile. the
; wanted record is specified by gmode in the following way:
; gmode = 1: the first member of the chain from current record
; in the motherfile.
; gmode = 2: the record next to the last accessed record in the
; chain.
; gmode = 3: the last accessed record in the chain.
; gmode = 4: the record next to the current record.
;
; result_cf: current record
; 1 record found the wanted
; 2 record not found if gmode = 2 then the last accessed
; else none
; 3 record not connected
; or last undefined unchanged
;
b. a20,c0 ; begin block get_l
w.
e18=f0-1
e19=k-j0
al w0 f43+f45+f47 ; statebits:= read_only_l + read_update_l
al w1 9 ; + update_all_l;
rl. w3 (j2.) ; call prepare;
jl w3 x3+d1 ; at return w2 = stackref+6 = cf_buf_ref;
;
rl. w2 (j113.) ; w2:= stack_ref;
dl w1 x2+16 ; get parameter gmode;
so w0 16 ; if expression then
jl. w3 (j104.) ; goto take_expression;
ds. w3 (j130.) ; save w2,w3;
rl w1 x1 ;
rs w1 x2+16 ; formal 3.2:= gmode;
rl w2 x2+6 ; w2:= cf_buf_ref;
al w0 12 ; w0:= formal_rel; (chain = sec.param.)
rl. w3 (j5.) ; call check_chain;
jl w3 x3+d5 ; at return w1 = chain_addr (daughter)
;
rl. w3 (j113.) ; w3:= stack_ref;
rl w3 x3+16 ; w3:= gmode
sl w3 1 ; if gmode < 1 or gmode > 4 then
sl w3 5 ; alarm(11);
jl. a11. ; comment wrong mode-parameter;
sn w3 4 ; if gmode=4
jl. a4. ; then goto mode_4
se w3 1 ; if gmode <> 1 then
jl. a0. ; goto mode_2_or_3;
;
; mode_one:
;
; move_to_mother:
; ks 1
dl w2 x1+2 ; w1:= chain_addr(m); w2:= cf_buf_ref(m);
rs w1 x2+b19 ; curr_m_ch_zb:= curr_ch;
;
rl w3 x2+b5 ; w3:= zone_descr_addr (mother);
rl w0 x3+4 ; if -, rec_size_zd(m) > 0 then
sh w0 0 ; alarm(14);
jl. a14. ; comment no curr.rec. in motherfile;
\f
; rc 01.11.77 rc4000 code procedure, connected files page 6.3
;
rl. w0 j0. ;
rl. w3 (j5.) ;
jl w3 x3+d19 ; call new_head_chain;
; at return w1 = curr_ch (daughter)
; and w2 = cf_buf_ref (daughter)
al w0 0 ; work_1_p:= 0; comment no last_in_chain;
rs. w0 (j31.) ;
jl. a2. ; goto all_modes;
;
; mode_2_or_3:
;
a0: rl w0 x1+f12 ; w0:= last_acc_tbl;
; ks 2
se w3 3 ; if gmode = 3 then goto mode_3
jl. a1. ; else goto mode_2;
; mode_3:
sh w0 0 ; if last_acc_tbl not defined
jl. a5. ; then go set result_cf
rl w3 x1+f11 ; next_tbl:= last_acc_tbl; (stored in w0)
ds w0 x1+f13 ; last_acc_tbl:= prior_tbl;
; ks 3
jl. a2. ; goto all_modes;
; mode_2:
a1: sh w0 0 ; if last_acc_tbl not defined
jl. a17. ; then alarm(17)
rl w3 x1+f11 ; work_1_p:= last_acc_tbl; (stored in w0)
ds. w0 (j31.) ; work_0_p:= prior_tbl;
; comment save chain_state for last_in_ch;
; ks 4
jl. a2. ; goto all_modes
;
; mode_4
; check current record
a4: rl w3 x2+b5 ; rec_base_addr
rl w3 x3+4 ; if rec_size_zd = 0
sh w3 0 ;
jl. a14. ; then alarm(no curr.)
; check connected
rl w3 x2+b8 ; a: ch_part_base_zb
wa w3 x1+4 ; add displ. for next_chfld
rl w0 x3 ; if next_chfld indicates not_connected
sn. w0 (c0.) ;
jl. a5. ; then go set result_cf
; update table
rs w0 x1+f13 ; else next_chfld_tbl := next_chfld
al w0 0 ; work_1_p := 0 for
rs. w0 (j31.) ; no last_in_chain
rl w0 x2+b51 ; last_acc_tbl :=
rs w0 x1+f12 ; save_rec_no_zb
; prepare call of move_word (segm.5)
; for moving of head_field
al w0 f14 ; base_2 :=
wa w0 2 ;
rs. w0 (j32.) ; chain_addr + f14
rl w0 x1+10 ; size := head_fld_size
; w3 still points to next_chfld in record
al w1 x3+1 ; base_1 := a:next_chfld + 1
rl. w3 (j5.) ;
jl w3 x3+d9 ; call move_word
\f
; rc 01.11.77 rc4000 code procedure, connected files page 6.3.1
;
;
; all_modes:
;
a2: jl. w3 d14. ; call next_l_int;
; ks 5
se w0 2 ; if result (in w0) = 1 then goto return;
jl. a3. ; comment the wanted record found;
; result_2:
; ks 6
rs. w0 (j34.) ; result_cf:= result;
rl. w0 (j31.) ; w0:= saved last_acc_tbl;
; ks 7
sh w0 0 ; if saved_last_acc = 0 then goto return;
jl. a3. ; comment no records left in then chain;
; fetch last_in_chain:
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
dl. w0 (j31.) ; last_acc_tbl:= work_0_p;
ds w0 x1+f13 ; next_tbl:= work_1_p;
; ks 8
jl. a2. ; goto all_modes;
;
a5: al w0 3 ;
rs. w0 (j34.) ; result_cf := 3
; return:
;
a3: rl. w3 (j2.) ; call return_algol;
jl x3+d17 ;
\f
; rc 01.11.77 rc4000 code procedure, connected files page 6.4
;
;
; alarm_call:
;
a17: am 3 ; alarmno:= 17 else
a14: am 3 ; alarmno:= 14 else
a11: al w1 11 ; alarmno:= 11;
rl. w3 (j1.) ;
jl w3 x3+d35 ; call alarm;
;
c0: f8 ; not connected
i.
e. ; end block get_l
\f
; rc 15.06.71 rc4000 code procedure, connected files page 6.5
;
;
; subroutine next_l_int
; the routine reads the list_file_record given by the next_field
; in the chain_table given by curr_d_ch_zb.
; if this record is dead, it is either set free or marked not con-
; nected in the current chain, the prior record is adjusted, and
; the next record is read as above.
; if end_of_chain is met, the last accessed field of the chain-table
; is set to zero and w0 is set to 2. (1 otherwise).
;
; call return
; w0: return segm_tbl_addr result
; w1: undef undef
; w2: cf_buf_ref cf_buf_ref
; w3: return_addr undef
;
b. a20, c5 ; next_l_int:
w.
d14: rl. w0 j0. ; entry this segm:
d15=k-j0 ; entry other segm:
ws w3 (0) ; save return inf
hs w3 x2+b1+1 ; rel. on segm.
rs w0 x2+b1+2 ; segm.no.
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
; adj_prior_tbl:
a0: dl w0 x1+f13 ; prior_tbl:= last_acc_tbl;
ds w0 x1+f12 ; last_acc_tbl:= next_tbl;
; adj_rec_no_cf:
a1: rs. w0 (j26.) ; rec_no_cf:= last_acc_tbl;
; ks 102
sh w0 0 ; if last_acc_tbl <= 0 then
jl. a8. ; goto end_of_chain;
;
rl. w0 j0. ; call of get_rec_n;
rl. w3 (j4.) ; comment at return the registers contain:
jl w3 x3+d63 ; w1 = addr. of rec_no_cf
; w2 = cf_buf_ref
;
; check_head:
;
; this makro checks that the head-field of curr_d_ch_zb in a record
; is the same as the head of the chain-table.
;
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
rl w3 x2+b8 ; base_2:= work_2_p:=
wa w3 x1+4 ; ch_part_base_zb + chfld_rel_tbl;
rs. w3 (j32.) ;
rl w0 x1+10 ; size:= w0:= head_fld_size_tbl;
al w1 x1+f14 ; base_1:= w1:= chain_addr + f14;
; ks 103
rl. w3 (j5.) ; call compare;
jl w3 x3+d11 ; comment at return w0 contains the
; result: 0: not_equal, 1: equal
se w0 1 ; if result <> equal then
jl. a18. ; alarm(18);
; comment wrong head of list_file_rec;
\f
; rc 15.06.71 rc4000 code procedure, connected files page 6.6
;
;
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
rl w3 x2+b8 ; w3:= addr of next_chfld; comment,
wa w3 x1+4 ; chain_part_base_zb + chfld_rel_tbl;
rl w0 x3 ;
; ks 104
sl w0 0 ; if next_chfld >= 0 then
jl. a7. ; goto record_found;
la. w0 c0. ; record_dead:
rs w0 x1+f13 ; next_tbl:= next_chfld - dead_bit
; ks 105
rl w0 x2+b6 ; if mode_zb = 0 then goto adj_prior_tbl;
sn w0 0 ; comment mode = read_only,
jl. a0. ; record cannot be removed;
rl w0 x1+f11 ;
; ks 106
se w0 0 ; if prior_tbl <> 0 then
jl. a3. ; goto dead_or_free;
am (x1+2) ; if mode_zb(mother) = 0 then
sn w0 (b6) ; goto adj_prior_tbl;
jl. a0. ; comment mother_mode = read_only,
; record cannot be removed;
;
; dead_or_free:
;
; this makro sets the next_chain_field of current record and
; curr_d_ch_zb to dead_not_connected. if all next_chain_fields of
; daughter_chains are in the same state, the result will be free
; (w1:=0), otherwise the result will be dead (w1:=1).
;
a3: rl w0 x1+f13 ; last_acc_tbl:= next_tbl;
rs w0 x1+f12 ;
al w0 f9 ; next_chfld:= dead_not_connected;
rs w0 x3 ;
rl w1 x2+b17 ; chain_addr:= w1:= first_d_ch_addr_zb;
rl w3 x2+b8 ; w3:= chain_part_base_zb;
; ks 108
a4: am (x1+4) ;
rl w0 x3 ;
; ks 109
se w0 f9 ; if next_chfld <> dead_not_connected then
jl. a5. ; goto result_dead;
rl w1 x1+8 ; chain_addr:= w1:= next_d_ch_tbl;
; ks 110
se w1 0 ; if chain_addr <> 0 then
jl. a4. ; goto test_next else
; result:= free; comment w1=0;
;
; result_free:
; ks 111
rl. w3 (j5.) ; call set_free_n;
jl w3 x3+d65 ;
jl. a6. ; goto adjust_prior;
;
; result_dead:
a5: al w0 f5 ; put_block;
hs w0 (x2+b63) ; set write_oper in last_used_share;
; ks 112
\f
; rc 15.06.71 rc4000 code procedure, connected files page 6.7
;
; adjust_prior:
;
a6: jl. w3 d20. ; call adjust_prior_rec;
; comment at return w1 = chain_addr;
rl w0 x1+f12 ; w0:= last_acc_tbl;
; ks 113
jl. a1. ; goto adj_rec_no_cf;
;
; record_found:
; w0 = next_chfld
; w1 = curr_d_ch_zb
;
a7: rs w0 x1+f13 ; next_tbl:= next_chfld;
; ks 114
al w0 1 ; result:= w0:= 1;
jl. a9. ; goto return;
;
; end_of_chain:
; w2 = cf_buf_ref
;
a8: al w0 0 ;
am (x2+b5) ; rec_size_zd:= 0;
rs w0 4 ;
al w0 2 ; result:= w0:= 2;
; ks 115
;
a9: rl w3 (x2+b1+2) ; return:
jl x2+b1 ; goto return_1_zb;
;
; alarm_call:
;
a18: al w1 18 ; alarmno:= 18;
rl. w3 (j1.) ;
jl w3 x3+d35 ;
;
; local constants:
;
c0: 1<23-1 ; mask for dead_bit (= 01111....)
i.
e. ; end block next_l_init
\f
; rc 15.06.71 rc4000 code procedure, connected files page 6.8
;
;
;
; subroutine adjust_prior_rec
;
; the routine adjusts the next_chain_field of the prior record of
; a chain, so that it will be identical with the last_accessed_field
; of the chaintable. if the prior record is the mother-record, it
; must be the current record of the mother-file.
;
; call return
; w0: return_segm_tbl_addr undef
; w1: undef chain_addr
; w2: cf_buf_ref cf_buf_ref
; w3: return_address undef
;
;
b. a5, c0 ; adjust_prior_rec
w.
d20: rl. w0 j0. ; entry this segm:
d21=k-j0 ; entry other segm:
ws w3 (0) ; save return inf
hs w3 x2+b2+1 ; rel.on segm.
rs w0 x2+b2+2 ; segm.no
;
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
rl w3 x1+f11 ; if prior_tbl > 0 then
; ks 201
sh w3 0 ; goto adjust_list_rec else
jl. a1. ; goto adjust_mother_rec;
;
; adjust_list_rec:
;
rs. w3 (j26.) ; rec_no_cf:= prior_tbl;
rl. w0 j0. ;
rl. w3 (j4.) ;
jl w3 x3+d63 ; call get_rec_n;
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
rl w3 x2+b8 ; w3:= addr of next_chfld; comment
wa w3 x1+4 ; ch_part_base_zb(d) + chfld_rel_tbl;
rl w0 x3 ; w0:= next_chfld;
rl w1 x1+f12 ; w1:= last_acc_tbl;
; ks 202
sh w0 -1 ; next_chfld:= last_acc_tbl +
lo. w1 c0. ; (if next_chfld < 0 then dead_bit else 0);
rs w1 x3 ;
; ks 203
al w0 f5 ;
hs w0 (x2+b63) ; put_block;
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
; ks 204
jl. a2. ; goto return;
\f
; rc 15.06.71 rc4000 code procedure, connected files page 6.9
;
; adjust_mother_rec:
;
a1: rl w0 x1+f12 ; w0:= last_acc_tbl;
; move_to_mother:
dl w2 x1+2 ; w1:= m_ch_addr_tbl; w2:= m_cf_buf_ref;
rs w1 x2+b19 ; curr_m_ch_zb:= curr_ch;
rl w3 x2+b8 ; w3:= addr of next_chfld(mother); comment
wa w3 x1+4 ; ch_part_base_zb(m) + chfld_rel_tbl;
rs w0 x3 ; next_chfld:= last_acc_tbl(daughter);
; ks 205
rl. w3 (j2.) ;
jl w3 x3+d33 ; call put_cf_int;
; back_to_daughter:
rl w1 x2+b19 ; w1:= curr_m_ch_zb;
dl w2 x1+2 ; w1:= d_ch_addr_tbl; w2:= d_cf_buf_ref;
; ks 206
;
a2: rl w3 (x2+b2+2) ; return:
jl x2+b2 ; goto return_jump;
;
; local constants:
;
c0: f7 ; dead_bit
i.
e. ; end adjust_prior;
\f
; rc 15.06.71 rc4000 code procedure, connected files page 6.10
;
g3=k-j0
c. g3-506
m. code on segment 6 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system 6:>
m. segment 6
i.
e.
\f
; rc 27.5.71 rc4000 code procedure, connected files page 7.1
;
; this segment contains.
; delete-m
; delete-l
; delete-chain
; delete-l-int
; delete-chain-int
;
b. g3, j150 ; code segment 7
w.
f0=f0+1 ; increase segm.count
k=f4 ; k:= first k-value
h.
j0: g1, g2 ; head-word: last point, last abs word
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm. 1
j2: 1<11 o.(:2-f0:), 0 ; ref. to segm. 2
j4: 1<11 o.(:4-f0:), 0 ; ref. to segm. 4
j5: 1<11 o.(:5-f0:), 0 ; ref. to segm. 5
j6: 1<11 o.(:6-f0:), 0 ; ref. to segm. 6
j11: 1<11 o.(:11-f0:),0 ; ref. to segm. 11
j26: 0 , 11 ; own core, rec-no-cf
j30: 0 , 19 ; own core, work-0-p
j34: 0 , 27 ; own core, result-cf
j103: f1 + 3, 0 ; rs, reserve
g2=k-2-j0 ; rel last abs word
g1=k-2-j0 ; rel last point
w.
\f
; rc 02.08.72 rc4000 code procedure, connected files page 7.2
; delete-m(zm)
;
; file-cf procedure
;
; deletes the current record of the file, and all records in chains
; originating in the master-record.
;
; result-cf current record
; 1 deleted the next in the file
; 2 deleted, end of file the first in the file
; 3 not deleted, only one left the one
;
b. a10, c10 ; begin delete-m
w.
e28=f0-1
e29=k-j0
al w1 14 ; proc-no:= 14
al w0 f35+f37 ; prepare(update-all-m, read-update-m)
rl. w3 (j2.) ;
jl w3 x3+d1 ;
;
rl w1 x2+b16 ; chain-addr:= first-m-ch-addr-zb
;
a0: ; test-end-mother-tables:
rl w0 x1 ;
sn w0 0 ; if word(chain-addr) = 0 then
jl. a1. ; goto delete-master-rec
;
jl. w3 d28. ; delete-chain-int
al w1 x1+f10 ; chain-addr:= next-m-ch
jl. a0. ; goto test-end-mother-tables
;
a1: ; delete-master-rec:
al w1 -10 ; reserve(10 bytes)
jl. w3 (j103.) ;
;
al w1 9<2 ; call-file-i(delete-rec-i)
rl. w0 j0. ;
rl. w3 (j2.) ;
jl w3 x3+d37 ;
;
rs. w1 (j34.) ; result-cf:= result-i
;
rl. w3 (j2.) ; obs. for result 3 file-i dont touch zone
sn w1 3 ; if result-i = 3 then
jl. a3. ; goto put-and-reset
;
jl w3 x3+d7 ; set-rec-pointers
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 7.3
a2: ; return:
rl. w3 (j2.) ;
jl x3+d17 ; return-algol
;
a3: ; put-and-reset:
jl w3 x3+d33 ; put-cf-int
;
al w0 0 ; reset all chain-fields to zero
rl w1 x2+b8 ; w1:= w3:= chain-part-base-zb
al w3 x1 ;
wa w3 x2+b9 ; addr:= w3:= w3 + chain-part-size-zb
;
a4: ; rep:
sh w3 x1 ; if addr <= chain-part-base then
jl. a2. ; goto return
rs w0 x3 ;
al w3 x3-2 ;
jl. a4. ;
i.
e. ; end delete-m
\f
; rc 02.08.72 rc4000 code procedure, connected files page 7.4
; delete-l(zl, chain)
;
; file-cf procedure
;
; deletes the last accessed record in the chain and all records in
; chains originating in the record.
; the next record in the chain becomes current record of the file.
;
; result-cf current record
; 1 deleted next in chain
; 2 deleted, last in chain none
;
b. a30, c10 ; begin delete-l
w.
e30=f0-1
e31=k-j0
al w1 15 ; proc-no:= 15
al w0 f45+f47 ; prepare(read-update-l, update-all-l)
rl. w3 (j2.) ;
jl w3 x3+d1 ;
;
al w0 12+0 ; check-chain(param-2, daughter)
rl. w3 (j5.) ;
jl w3 x3+d5 ;
;
am (x1+2) ;
rl w0 +b6 ;
sn w0 0 ; if mode-zb(mother) = read-only then
jl. a28. ; goto alarm(m.state)
;
rl w0 x1+f12 ;
sn w0 0 ; if last-acc-tbl = 0 then
jl. a17. ; goto alarm(ch.state)
;
sn w0 (x2+b51) ; if last-acc-tbl = save-rec-no-zb then
jl. a0. ; goto delete
;
rs. w0 (j26.) ; rec-no-cf:= last-acc-tbl
rl. w0 j0. ;
rl. w3 (j4.) ;
jl w3 x3+d63 ; get-rec-n
;
a0: ; delete:
jl. w3 d26. ; delete-l-int
;
rl w1 x2+b20 ; chain-addr:= curr-d-ch-zb
rl w0 x1+f13 ; last-acc-tbl:= next-tbl
rs w0 x1+f12 ;
;
rl w0 x1+f11 ;
se w0 0 ; if prior-tbl <> 0 then
jl. a1. ; goto adjust-prior
;
rl. w0 j0. ;
rl. w3 (j11.) ; get-mother-rec-int
jl w3 x3+d23 ;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 7.5
a1: ; adjust-prior:
rl. w0 j0. ;
rl. w3 (j6.) ; adjust-prior-rec
jl w3 x3+d21 ;
;
rl w0 x1+f11 ; last-acc-tbl:= prior-tbl
rs w0 x1+f12 ;
;
rl. w0 j0. ;
rl. w3 (j6.) ; next-l-int
jl w3 x3+d15 ;
rs. w0 (j34.) ; result-cf:= result
;
rl. w3 (j2.) ; return-algol
jl x3+d17 ;
;
a28: am 28-17 ; alarm(m.state):
a17: al w1 17 ; alarm(ch.state):
rl. w3 (j1.) ;
jl w3 x3+d35 ; alarm
i.
e. ; end delete-l
\f
; rc 02.08.72 rc4000 code procedure, connected files page 7.6
; delete-chain(z, chain)
;
; file-cf procedure
;
; deletes all records in a chain starting at current record of the zone,
; and all records in chains originating in records of the chain speci-
; fied.
;
; result-cf current record
; 1 chain deleted unchanged
; 2 no chain to delete unchanged
;
b. a20, c10 ; begin delete-chain
w.
e32=f0-1
e33=k-j0
al w1 16 ; proc-no:= 16
al w0 f35+f37+f45+f47
rl. w3 (j2.) ; prepare(update-all-m, read-update-m,
jl w3 x3+d1 ; read-update-l, update-all-l)
;
al w0 12+1 ; check-chain(param-2, mother)
rl. w3 (j5.) ;
jl w3 x3+d5 ;
;
rl w3 x2+b5 ;
rl w3 x3+4 ;
sn w3 0 ; if rec-size-zd = 0 then
jl. a14. ; goto alarm(no.curr)
;
jl. w3 d28. ; delete-chain-int
;
sn w0 0 ; if result = no-active-recs-in-chain (0)
jl. a2. ; then goto result-2
;
rl w3 x2+b8 ; next-chfld:= 0
wa w3 x1+4 ;
al w0 0 ;
rs w0 x3 ;
;
rl. w3 (j2.) ; put-cf-internal
jl w3 x3+d33 ;
;
a1: ; return:
rl. w3 (j2.) ; return-algol
jl x3+d17 ;
;
a2: ; result-2:
al w0 2 ;
rs. w0 (j34.) ; result-cf:= 2
jl. a1. ; goto return
;
a14: al w1 14 ; alarm(no.curr):
rl. w3 (j1.) ;
jl w3 x3+d35 ; alarm
i.
e. ; end delete-chain
\f
; rc 02.08.72 rc4000 code procedure, connected files page 7.7
; delete-l-int
;
; file-cf subroutine
;
; the subroutine deletes current record of a list-file by:
; 1. delete all chains of which the record is the mother,
; 2. mark the record not-connected for curr-d-ch-zb and
; dead in all next-chflds of daughter-chains,
; 3. set last-acc-tbl of all daughter-tables to zero, and
; 4. if all chains are not-connected, then set the record free.
;
; prior record is not touched.
;
; entry exit
; w0 return-segm-tbl-address undef
; w1 undef undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
b. a10, c10 ; begin delete-l-int
w.
d26: rl. w0 j0. ;
d27=k-j0 ;
ws w3 (0) ; save-return-int-2
hs w3 x2+b2+1 ;
rs w0 x2+b2+2 ;
;
rl w1 x2+b16 ; chain-addr:= first-m-ch-addr-zb
a0: ; test-end-mother-tables:
rl w0 x1 ;
sn w0 0 ; if word(chain-addr) = 0 then
jl. a2. ; goto mark-dead
;
jl. w3 d28. ; delete-chain-int
al w1 x1+f10 ; chain-addr:= next-m-ch
jl. a0. ; goto test-end-mother-tables
;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 7.8
a2:
;
; mark-dead
;
; this makro marks next-chfld of curr-d-ch-zb not-connected, and all
; next-chflds of daughter-chains dead.
; if they are all not-connected, the result will be free, otherwise
; dead.
; it sets last-acc-tbl of all daughter-tables to zero.
; the counter dead-bytes is incremented with save-size-zb.
;
; at exit w0 = result 0 free
; 1 dead
;
rl w1 x2+b61 ; incr. dead_byte
rl w3 x1+2 ; dead_bytes := dead_bytes
am (x2+b50) ; + save_size_zb
al w3 x3 ;
rs w3 x1+2 ;
;
rl w3 x2+b8 ; w3:= chain-part-base-zb
rl w1 x2+b20 ; chain-addr:= curr-d-ch-zb
al w0 f9 ; next-chfld:= dead-not-connected
am (x1+4) ;
rs w0 x3 ;
;
; registers in loop exit
; w0 result result
; w1 chain-addr 0
; w2 work, next-chfld and zero cf-buf-ref
; w3 chain-part-base chain-part-base
;
rs. w2 c0. ; save cf-buf-ref
al w0 0 ; result:= free
rl w1 x2+b17 ; chain-addr:= first-d-ch-zb
; w3 contains already chain-part-base
a3: ; next-daughter-table:
am (x1+4) ; next-chfld:=
rl w2 x3 ; next-chfld or dead-bit
lo. w2 c1. ;
am (x1+4) ;
rs w2 x3 ;
;
se w2 f9 ; if next-chfld <> dead-not-connected then
al w0 1 ; result:= dead
;
al w2 0 ; reset last-acc-tbl
rs w2 x1+f12 ;
;
rl w1 x1+8 ; chain-addr:= next-d-ch-tbl
se w1 0 ; if chain-addr <> 0 then
jl. a3. ; goto next-daughter-table
;
rl. w2 c0. ; restore cf-buf-ref
;
; end mark-dead
;
\f
; rc 04.11.74 rc4000 code procedure, connected files page 7.9
se w0 0 ; if result <> free then
jl. a4. ; goto put
;
rl. w3 (j5.) ; set-free-n
jl w3 x3+d65 ;
rl w3 (x2+b2+2) ; return-int-2
jl x2+b2 ;
;
a4: ; put:
al w0 f5 ;
hs w0 (x2+b62) ; put blocktable;
hs w0 (x2+b63) ; put block;
rl w3 (x2+b2+2) ; return-int-2
jl x2+b2 ;
;
c0: 0 ; save cf-buf-ref
c1: f7 ; dead-bit
i.
e. ; end delete-l-int
\f
; rc 02.08.72 rc4000 code procedure, connected files page 7.10
; delete-chain-int
;
; file-cf subroutine
;
; the subroutine deletes the chain given by current record of a mother-
; file and chain-addr of the mother-table (in w1).
; the subroutine calls delete-l-int which in turn may call delete-
; chain-int etc..
; if no daughter-records exist the subroutine will perform a fast return,
; otherwise the subroutine will check that the chain specified is initi-
; alized, and that the daughter-file is in an update-mode.
;
; entry exit
; w0 return-segm-tbl-addr result
; w1 chain-addr(mother) chain-addr(mother)
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; return quantity:
; result = 0 no active record in chain
; <> 0 some active record in chain
;
b. a30, c10 ; begin delete-chain-int
w.
d28: rl. w0 j0. ;
d29=k-j0 ;
rs w0 x2+b1+2 ; save-segm-tbl-addr(save-return-int-1)
;
; perform fast return if next-chfld is zero.
;
rl w0 x2+b8 ; chain-part-base-zb
wa w0 x1+4 ; chfld-rel-tbl
rl w0 (0) ; w0:= next-chfld
sn w0 0 ; if next-chfld = 0 then
jl x3 ; perform-fast-return
;
ws w3 (x2+b1+2) ; save-rel-return(save-return-int-1)
hs w3 x2+b1+1 ;
;
al w0 0 ; work-0-p:= 0
rs. w0 (j30.) ;
;
rs w1 x2+b19 ; curr-m-ch-zb:= chain-addr
;
rl w3 x1+2 ;
sh w3 0 ; if d-cf-buf-ref-tbl <= 0 then
jl. a16. ; goto alarm(ch.state)
;
rl w3 x3+b6 ;
sn w3 0 ; if mode-zb(daughter) = read-only then
jl. a29. ; goto alarm(d.state)
;
rl. w3 (j5.) ; new-head-chain; moves-to-daughter
jl w3 x3+d19 ;
rs w1 x2+b20 ; curr-d-ch-zb:= chain-addr
;
\f
; rc 06.11.74 rc4000 code procedure, connected files page 7.11
a0: ; fetch-next-record:
rl. w0 j0. ;
rl. w3 (j6.) ; next-l-int
jl w3 x3+d15 ;
sn w0 2 ; if result = 2 = end-of-chain then
jl. a1. ; goto return
;
jl. w3 d26. ; delete-l-int
;
; now it is known that at least one active record did exist in the chain.
; save-result is changed after delete-l-int because delete-chain-int
; may be called recursively.
rs. w2 (j30.) ; work-0-p:= cf-buf-ref (<> 0)
;
jl. a0. ; goto fetch-next-record
;
a1: ; return:
rl. w0 j0. ;
rl. w3 (j11.) ; addr. segm. 11;
jl w3 x3+d25 ; call decoderec;
rl w1 x2+b20 ; back-to-mother
dl w2 x1+2 ;
;
rl. w0 (j30.) ; w0:= result:= work-0-p
rl w3 (x2+b1+2) ; return-int-1
jl x2+b1 ;
;
a16: am 16-29 ; alarm(ch.state):
a29: al w1 29 ; alarm(d.state):
rl. w3 (j1.) ;
jl w3 x3+d35 ; alarm
i.
e. ; end delete-chain-int
g3=k-j0
c. g3-506
m. code on segment 7 too long
z.
c. 502-g3
0, r. 252-g3>1 ; zero fill
z.
<:cf-system 7:>
i.
e.
m. end segment 7
\f
; rc 18.05.71 rc4ooo code procedure, connected files page 8.1
b. g10,j150 ; code segment 8:
f0=f0+1 ; increase segm.count
k=f4 ;
h. ;
j0: g1, g2 ; headword: last point, last absword
j4: 1<11 o.(:4-f0:), 0 ; ref. to segm.4
j5: 1<11 o.(:5-f0:), 0 ; ref. to segm.5
j21: 0 , 1 ; return_1_p
j22: 0 , 3 ; return_2_p
j26: 0 , 11 ; rec_no_cf
j27: 0 , 13 ; size_p
j28: 0 , 15 ; overflow_p
j34: 0 , 27 ; result_cf
;
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
\f
; rc 01.10.77 rc4000 code procedure, connected files page 8.2
;
;
; file_n procedure find_rec_no_n
; the procedure finds a record-number to be used for an insertion.
; it will not update the block to be used for the insertion, but the
; overflow-pointer of the block containing the neighbour-record
; (i.e. the record which is going to be prior to the inserted one,
; or in case of next-to-mother-insertion, then the next to the in-
; serted) will be updated, if overflow occurs. this updating is per-
; formed before retrival of the overflow-block, if overflow_p is 0,
; i.e. overflow has not occurred earlier, but after retrieval, if
; overflow_p is greater than 0.
;
; reg. entry exit
; w0 return segm.tbl.addr undef.
; w1 undef. undef.
; w2 cf_buf_ref cf_buf_ref
; w3 return addr undef.
;
; call quantities:
; rec_no_cf the neighbour-record or zero, if no neighbour
; size_p the wanted record-size, incl. chainpart
; overflow_p = 0 in case of overflow, overflow_block will be
; updated before access to the overflow-block.
; = rec_no_cf overflow_block is updated after access to
; the overflow-block.
; return_quantities:
; rec_no_cf the found record-number or zero.
; result_cf unchanged if rec_no_cf > 0.
; = 2 fill limit exceeded.
; = 4 no block can take this record.
;
b. a20, c10 ; begin block find_rec_no_n
w.
d68: rl. w0 j0.
d69=k-j0 ; find_rec_no_n:
ws w3 (0) ; save return in return_1_p
hs. w3 (j21.) ;
rs. w0 (j22.) ;
; check used_bytes against fill_limit
; fill_limit := (blocks_in _file * max_free) *fill_percentage div 100
rl w3 x2+b61 ; pointer to block_table
al w0 0 ;
rl w1 x3+8 ; fill_percentage , blocks_in_file
ld w1 f53 ; extract fill_percentage
rs. w0 c2. ; save it
ls w1 -f53 ; blocks_in_file
wm w1 x2+b55 ; * max_bytes_per_block_shift_3
wd. w1 c3. ; div 100 shift 3
wm. w1 c2. ; * fill_percentage
ss w1 x3+6 ; w0,w1 := fill_limit - used_bytes
sh w0 -1 ; if used_bytes > fill_limit
jl. a9. ; goto fill limit exceeded
rl. w1 (j26.) ;
sh w1 0 ; if rec_no_cf <= 0 then
jl. a1. ; goto find the best block
rl. w0 j0. ;
rl. w3 (j4.) ; get_block_r(rec_no_cf)
jl w3 x3+d73 ;
rl w1 x2+b57 ; w1:= block_ref_zb
bz w3 x1+f20 ;
rl. w0 (j27.) ;
; ks 31
sh w0 x3 ; if size <= free_bytes then
jl. a4. ; goto try rec_nos
\f
; jw 05.01.79 rc4000 code procedure, connected files page 8.3
;
;
a0: rl w3 x1+f23 ; not room in neighbour-block:
sh w3 -1 ; if overflow_block < 0 then
jl. a1. ; find the best block
rs w3 x2+b64 ; else block_no_zb:= overflow_block
rl. w0 (j27.) ; w0:= size_p
rl. w3 (j5.) ; w0:= free_rec:=
jl w3 x3+d87 ; log_func(size)
rl w1 x2+b64 ; block_tbl_addr:=
ls w1 -1 ; block_no_zb//2
wa w1 x2+b61 ; +victim_zb +f18
bz w3 x1+f18 ; free(block_no):=
; ks 32
rl w1 x2+b64 ; entry(block_tbl_addr)
so w1 1 ;
ls w3 -6 ;
la. w3 c0. ;
sl w0 x3 ; if free_rec >= free(block_no) then
jl. a2. ; find the best block else
; room in overflow_block
al w0 0 ; overflow_p:= 0
rs. w0 (j28.) ;
jl. a3. ; goto get_block
a1: ; find the best block:
rl. w0 (j27.) ; w0:= size_p
rl. w3 (j5.) ; w0:= free_rec:=
jl w3 x3+d87 ; log_func(size)
a2: ; find the best block ( w0 = free_rec )
rs. w0 c1. ; save free_rec
jl. w3 d80. ; find_most_free (this segm.)
; w1 = free(block_no), w3 = block_no
sh. w1 (c1.) ; if free(block_no) <= free_rec then
jl. a8. ; goto no_block
al w1 x3 ; w1:= block_no
rl. w0 (j28.) ;
se w0 0 ; if overflow_p <> 0 then
jl. a3. ; update overflow later
rl. w0 (j26.) ; if rec_no_cf > 0
sh w0 0 ; (i.e. a neighbour-record is given)
jl. a3. ;
am (x2+b57) ; then update overflow immediately
rs w1 f23 ; overflow_block:= block_no
al w0 f5 ; put write_oper in overflow_block
hs w0 (x2+b63) ;
a3: ; get_block:
; ks 34
rl. w0 j0. ;
rl. w3 (j4.) ; get_block_b(block_no)
jl w3 x3+d75 ;
jl. a5. ; goto find rec_no
a4: ; try rec_nos:
bz w3 x1+f21 ;
sn w3 0 ; if free_rec_nos = 0 then
jl. a0. ; not room in neighbour-block
; room in neighbour_block
al w0 0 ;
rs. w0 (j28.) ; overflow_p:= 0
a5: rl w1 x2+b57 ; find rec_no: w1:= block_ref_zb
\f
; rc 02.08.72 rc4000 code procedure, connected files page 8.3.1
; it is attempted to have a random distribution of used recnos in
; a block, in order to facilitate simple reorganization of list
; files of variable record length.
;
; the search for a free record number is started at a pseudo random
; position in the rec-base table.
; the search goes backwards to the start of the rec-base table, and
; then, if that did not succeed, the search is continued from the
; end of the table, still in the backwards direction.
;
al w0 117 ; w0:= (117
ba w0 x1+f21 ; + free-rec-nos)
wm w0 0 ; **2
wd w0 x2+b54 ; w3:= w0 mod recs-in-block-zb
wa w3 x2+b57 ; + block-ref-zb
; w3 is now the pseudo random starting address for the search.
a11: bz w0 x3 ; search-1:
so w0 1 ; if rec-base-rel extract 1 = unused
jl. a7. ; then goto found
al w3 x3-1 ; next byte
sl w3 x1 ; if addr >= block-ref then
jl. a11. ; goto search-1
; now search from the end of the rec-base table
am (x2+b54) ; (search from w3 to w1)
al w3 x1-1 ; w3:= block_ref +recs_in_block_zb -1
; ks 35
\f
; rc 01.10.77 rc4000 code procedure, connected files page 8.4
;
;
a6: bz w0 x3 ;
so w0 1 ; if rec_base_rel extract 1 = unused then
jl. a7. ; goto found
al w3 x3-1 ; next byte
sl w3 x1 ; if addr >= block_ref then
jl. a6. ; continue
ic 63 ; emergency: no found
a7: ; found:
ws w3 2 ; rec_no_rel:= w3 - w1
al w3 x3+1 ; rec_no_cf:= rec_no_rel + 1
rl w1 x2+b64 ; +block_no_zb
wm w1 x2+b54 ; *recs_in_block_zb
wa w3 2 ;
rs. w3 (j26.) ;
; ks 36
rl. w1 (j28.) ;
sh w1 0 ; skip if the so called later updating
jl. a10. ; goto return
rl w0 x2+b64 ; overflow_p:= block_no_zb
rs. w0 (j28.) ;
rl. w0 j0. ;
rl. w3 (j4.) ; get_block_r(old overflow_p)
jl w3 x3+d73 ;
; ks 37
rl. w0 (j28.) ; overflow_block:=
am (x2+b57) ; overflow_p
rs w0 f23 ;
al w0 f5 ; put write_oper
hs w0 (x2+b63) ;
jl. a10. ; goto return
a8: am 2 ; no block can take this record
a9: al w0 2 ; fill limit exceeded
rs. w0 (j34.) ;
al w0 0 ;
rs. w0 (j26.) ; rec_no_cf:=
rl w1 x2+b5 ; rec_size_zd:= 0
rs w0 x1+h3+4 ;
a10: ; return_n
rl. w3 (j22.) ;
rl w3 x3 ;
jl. (j21.) ;
c0: 8.0077 ; mask for block_tbl_entry
c1: 0 ; save free_rec
c2: 0 ; save fill_percentage
c3: 800 ; 100 percent shift 3
;
m.find_rec_no_n
i.
e. ; end block find_rec_no_n
\f
; rc 01.10.77 rc4000 code procedure, connected files page 8.5
;
;
; file_n subroutine find_most_free
; the subroutine searches the block-table from bottom to top to find
; the block of most free room. the search stops if an empty block is
; found.
;
; reg. entry exit (simple return)
; w0 undef. undef.
; w1 undef. free(block_no)
; w2 cf_buf_ref cf_buf_ref
; w3 return address block_no
;
b. a5, c10 ; begin block find most free
w. ;
d80: d81=k-j0 ; find_most_free:
ds. w3 c5. ; save cf_buf_ref, save return_addr:= w2,w3
rl w3 x2+b61 ; w3:= victim_zb
rl w2 x3+8 ; w2:= blocks_in_file
la. w2 c6. ; remove fill_percentage
al w3 x3+f18 ; w3:= first_of_block_tbl:= victim_zb +f18
rs. w3 c3. ; save that
al w2 x2-1 ; last_of_block_tbl:= tbl_addr:= w2:=
ls w2 -2 ; (block_in_file -1)//4
ls w2 1 ; *2
wa w2 6 ; +first_of_block_tbl
al w1 0 ; max_plus_one:= 0 (good for a skip_low)
; ks 11
;
a0: ; repeat:
bz w0 x2+1 ; w0:= byte(tbl_addr+1)
al w3 2.111111 ; take odd entry:
la w3 0 ; w3:= w0 extract 6
; ks 12
sl w3 x1 ; if entry >= max_plus_one then
jl. w3 a2. ; goto found_odd
ls w0 -6 ; take even entry: w0:= w0 shift (-6)
sl w0 x1 ; if entry >= max_plus_one then
jl. w3 a3. ; goto found_even
bz w0 x2 ; w0:= byte(tbl_addr); (comments as above)
al w3 2.111111 ; take odd entry:
la w3 0 ;
; ks 13
sl w3 x1 ;
jl. w3 a4. ;
ls w0 -6 ; take even entry:
sl w0 x1 ;
jl. w3 a5. ;
al w2 x2-2 ; tbl_addr:= tbl_addr -1
sl. w2 (c3.) ; if tbl_addr >= first_of_block_tbl then
jl. a0. ; goto repeat
; finis:
al w1 x1-1 ; free(block_no):= max:= max_plus_one -1
; ks 14
\f
; rc 01.10.77 rc4000 code procedure, connected files page 8.6
;
;
a1: ; spec. an empty block is found
rl. w3 c2. ; w3:= block_no:=
ws. w3 c3. ; (tbl_addr -first_of_block_tbl)
ls w3 1 ; *2
wa. w3 c1. ; +entry
rl. w2 c4. ; w2:= cf_buf_ref
; ks 15
jl. (c5.) ; return
c1: 0 ; save entry
c2: 0 ; save tbl_addr
c3: 0 ; save first_of_block_tbl
c4: 0 ; save cf_buf_ref
c5: 0 ; save return_addr
c6: f51 ; mask for blocks-in-file
; macro: a new max_plus_one is found, w0 = byte(tbl_addr), w2 = tbl_addr
a2: am 1 ; odd found: right byte
a3: am 1 ; even - : - -
a4: am 1 ; odd - : left -
a5: al w1 0 ; even - : - -
ds. w2 c2. ; save entry and tbl_addr
al w1 2.111111 ; w1:=
la w1 0 ; free(block_no)
sn w1 2.111111 ; if w1 = an empty block then
jl. a1. ; stop searching
al w1 x1+1 ; max_plus_one:= w1:= free(block_no) +1
; ks 16
jl x3 ; continue
;
m.findmostfree
i.
e. ; end block find_most_free
\f
; rc 28.06.71 rc4000 code procedure, connected files page 8.7
;
;
g3=k-j0
c. g3-506
m. code on segment 8 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system 8:>
m. segment 8
i.
e.
\f
; rc 18.05.71 rc4000 code procedure, connected files page 9.1
b. g10,j150 ; code segment 9:
f0=f0+1 ; increase segm.count
k=f4 ;
h. ;
j0: g1, g2 ; headword: last point, last absword
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm.1
j2: 1<11 o.(:2-f0:), 0 ; ref. to segm.2
j5: 1<11 o.(:5-f0:), 0 ; ref. to segm.5
j6: 1<11 o.(:6-f0:), 0 ; ref. to segm.6
j8: 1<11 o.(:8-f0:), 0 ; ref. to segm.8
j10: 1<11 o.(:10-f0:), 0 ; ref. to segm.10
j11: 1<11 o.(:11-f0:), 0 ; ref. to segm.11
j26: 0 , 11 ; rec_no_cf
j27: 0 , 13 ; size_p
j28: 0 , 15 ; overflow_p
j31: 0 , 21 ; work_1_p
j32: 0 , 23 ; work_2_p
j34: 0 , 27 ; result_cf
j113: f1+13, 0 ; rs last used
;
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
\f
; rc 26.09.72 rc4000 code procedure, connected files page 9.2
;
;
; procedure insert_l(zl, chain, icmode, record);
; zone zl; real chain; integer icmode; array record;
;
; inserts a record in a listfile according to a spcecified mode, and
; clusters it in the specified chain. the inserted record is made
; available as zone-record, and may be retrieved by its record_no
; (return-value of rec_no_cf), or via the specified chain.
;
; result_cf current record
; 1 inserted the inserted
; 2 fill limit exceeded none
; 3 length error none
; 4 no block can take this record none
;
b. a30, c10 ; begin block insert_l:
w.
e24=f0-1 ; insert_l:
e25=k-j0 ;
al w0 f45+f47 ;
al w1 12 ; proc_no:= 12
rl. w3 (j2.) ; prepare(read_upd_d,update_all_l)
jl w3 x3+d1 ;
al w0 12+0 ;
rl. w3 (j5.) ; check_chain(param2, daughterzone)
jl w3 x3+d5 ;
; take param 4, calc rec-base
rl. w3 (j113.) ; w3:= stack_top
rl w1 x3+20 ; w1:= formal 4.2:= base_word_addr
rl w0 x1 ; w0:= addr_of_base_element
rs. w0 (j31.) ; work_1_p:= addr_of_element_0
ba w1 x3+18 ; w0, w1:=
dl w1 x1 ; upper, lower-k
sh w1 0 ; if lower-k > 0 or
sh w0 1 ; upper <= 1 then
jl. a13. ; goto alarm(array p)
; take param3, icmode
rl w0 x3+14 ; w0:= formal 3.1:= kind
so w0 2.10000 ; if expression then
jl. a20. ; alarm(36)
rl w1 (x3+16) ; w1:= icmode
se w1 1 ; if icmode <> 1 then
jl. a0. ; goto next_or_prior else
; insert as first in chain.
; macro move to mother
rl w1 x2+b20 ;
dl w2 x1+2 ;
rs w1 x2+b19 ;
; end macro, we are in the mother-zone
rl w0 x2+b6 ;
sn w0 0 ; if mode_zb = read_only then
jl. a21. ; goto alarm(28)
rl w3 x2+b5 ;
rl w0 x3+h3+4 ;
sh w0 0 ; if rec_size_zd <= 0 then
jl. a23. ; goto alarm(14)
; ks 23
rl. w3 (j5.) ; new_head_chain
jl w3 x3+d19 ; w1 = curr_ch
\f
; rc 28.06.71 rc4000 code procedure, connected files page 9.3
;
;
; we are in the daughter-zone again
rl w0 x1+f13 ; rec_no_cf:= next_tbl
rs. w0 (j26.) ;
al w0 0 ; overflow_p:=0
rs. w0 (j28.) ; update overflow immediately
jl. a4. ; goto common part
a0: ; next_or_prior:
rl w3 x2+b20 ; chain_addr:= w3:= curr_d_ch_zb
rl w0 x3+f12 ;
sh w0 0 ; if last_acc_tbl <=0 then
jl. a22. ; goto alarm(17)
; ks 24
sn w1 2 ; if icmode = 2 then
jl. a1. ; goto next
se w1 3 ; if icmode > 3 then
jl. a24. ; goto alarm(11)
; insert as prior to last_acc:
rl w0 x3+f11 ; w0:= prior_tbl
; ks 25
se w0 0 ; if prior_tbl = 0 then
jl. a2. ;
rs. w0 (j28.) ; insert as next to mother:
rl w1 x3+2 ;
rl w0 x1+b6 ;
sn w0 0 ; if mode_zb(mother-zone) = read_only then
jl. a21. ; goto alarm(28)
rl. w0 j0. ;
rl. w3 (j11.) ; get_mother_rec_int
jl w3 x3+d23 ; mother-rec is curr-rec in mother-zone
; we are in the daughter-zone
rl w0 x1+f12 ; rec_no_cf:= w0:= last_acc_tbl
rs. w0 (j26.) ;
jl. a3. ;
a1: ; next:
rs. w0 (j26.) ; overflow_p:=
rs. w0 (j28.) ; rec_no_cf:=
rs w0 x3+f11 ; prior_tbl:= last_acc_tbl
jl. a4. ; goto common part
a2: rs. w0 (j26.) ; not the first in chain:
rs. w0 (j28.) ; rec_no_cf:= overflow_p:= prior_tbl
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb
rl w0 x1+f12 ; w0:= last_acc_tbl
a3: rs w0 x1+f13 ; next_tbl:= last_acc_tbl
a4: ; now everything is made common to all insertion-modes
rl w1 x2+b56 ; size:= fix_rec_size_zb
; ks 26
se w1 0 ; if size = 0 then
jl. a5. ;
rl. w3 (j31.) ; w3:= rec_base
rl w1 x3+1 ; size:= word(rec_base +1)
sh w1 (x2+b13) ; if size > max_rec_size_zb or size < 4 then
sh w1 3 ;
jl. a11. ; goto length-error
sz w1 1 ; if size extract 1 = 1 then
al w1 x1+1 ; size:= size +1
wa w1 x2+b9 ; size:= size +chain_part_size_zb
\f
; rc 28.06.71 rc4000 code procedure, connected files page 9.4
;
;
a5: rs. w1 (j27.) ; size_p:= size
rl. w0 j0. ;
rl. w3 (j8.) ; find_rec_no_n
jl w3 x3+d69 ;
rl. w0 (j26.) ;
sh w0 0 ; if rec_no_cf <= 0 then
jl. a10. ; goto return
; rec_no found:
rl w1 x2+b20 ; last_acc_tbl:= rec_no_cf
rs w0 x1+f12 ;
rl. w0 j0. ;
rl. w3 (j6.) ; adjust_prior_rec
jl w3 x3+d21 ; rec_no_cf = prior_tbl
rl w0 x1+f12 ; rec_no_cf:= last_acc_tbl
rs. w0 (j26.) ;
; ks 28
rl. w0 j0. ;
rl. w3 (j10.) ; insert_n
jl w3 x3+d67 ;
rl w3 x2+b5 ; move:
rl w0 x3+h3+4 ; size:= w0:= rec_size_zd
rl w1 x3+h3+0 ; base_2:= work_2_p:= rec_base_zd
rs. w1 (j32.) ;
rl. w1 (j31.) ; base_1:= w1:= work_1_p
rl. w3 (j5.) ; move_word
jl w3 x3+d9 ;
rl w0 x2+b56 ;
se w0 0 ; if fix_rec_size_zb = 0 then
jl. a6. ;
rl w0 x2+b51 ; word(rec_base_zd +3):=
rl. w1 (j32.) ; save_rec_no_zb
rs w0 x1+3 ;
a6: ; put zero in mother-ch-fields
rl w1 x2+b16 ; w1:= ch_addr:= first_m_ch_addr_zb
al w0 0 ;
rl w3 x2+b8 ; w3:= chain_part_base_zb
; ks 29
a7: ; continue loop
sn w0 (x1) ; if word(ch_addr) = 0 then
jl. a8. ; end loop
am (x1+4) ; next_ch_fld:= 0
rs w0 x3 ;
al w1 x1+f10 ; ch_addr:= ch_addr +size_of_m_ch_tbl
jl. a7. ; continue
a8: ; end loop
; put not_connected in daughter-ch-fields
rl w1 x2+b17 ; w1:= ch_addr:= first_d_ch_addr_zb
rl. w0 c0. ; w0:= not_connected
; ks 21
\f
; rc 26.09.72 rc4000 code procedure, connected files page 9.5
;
;
a9: ; continue loop
am (x1+4) ;
rs w0 x3 ; next_ch_fld:= not_connected
rl w1 x1+8 ; ch_addr:= word(ch_addr +8)
se w1 0 ; if ch_addr <> 0 then
jl. a9. ; continue
; end loop
; connect the inserted record to the chain, move head_field
rl w1 x2+b20 ; ch_addr:= w1:= curr_d_ch_zb
rl w0 x1+f13 ;
wa w3 x1+4 ; next_ch_fld:= next_tbl
rs w0 x3 ; base_2:= work_2_p:= chain_part_base_zb
rs. w3 (j32.) ; +ch_fld_rel_tbl
rl w0 x1+10 ; size:= head_fld_size_tbl
al w1 x1+f14 ; base_1:= w1:= ch_addr +base_of_head_tbl
; ks 22
rl. w3 (j5.) ; move_word
jl w3 x3+d9 ;
a10: ; return:
rl. w3 (j2.) ; return_algol
jl x3+d17 ;
a11: ; length-error:
al w0 3 ; result_cf:= 3
rs. w0 (j34.) ;
al w0 0 ;
rl w3 x2+b5 ;
rs w0 x3+h3+4 ; rec_size_zd:=
rs. w0 (j26.) ; rec_no_cf:= 0
jl. a10. ; goto return
;
c0: f8 ; not_connected
;
a13: am 13-36 ; alarm 13, array p
a20: am 8 ; alarm 36, expression
a21: am 11 ; alarm 28, m.zone in read_only
a22: am 3 ; alarm 17, last acc. not def.
a23: am 3 ; alarm 14, no curr.rec
a24: al w1 11 ; alarm 11, wrong mode
rl. w3 (j1.) ; alarm
jl w3 x3+d35 ;
m.insertl
i.
e. ; end block insert_l
\f
; rc 28.06.71 rc4000 code procedure, connected files page 9.6
;
;
g3=k-j0
c. g3-506
m. code on segment 9 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system 9:>
m. segment 9
i.
e.
\f
; jw 05.01.79 rc4000 code procedure, connected files page 10.1
b. g10,j150 ; code segment 10
f0=f0+1 ; increase segm.count
k=f4 ;
h. ;
j0: g1, g2 ; headword: last point, last absword
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm.1
j4: 1<11 o.(:4-f0:), 0 ; ref. to segm.4
j5: 1<11 o.(:5-f0:), 0 ; ref. to segm.5
j21: 0 , 1 ; return_1_p
j22: 0 , 3 ; return_2_p
j26: 0 , 11 ; rec_no_cf
j27: 0 , 13 ; size_p
;
g2=k-2-j0 ; rel of last absword
g1=k-2-j0 ; rel of last point
w.
\f
; jw 05.02.79 rc4000 code procedure, connected files page 10.2
;
;
; file_n procedure insert_n
; inserts a record of a given size at a given record-number.
; the procedure assumes that the record-number is free, and that there
; is enough room in the block.
; the record may be made available as a normal zone-record retrieved
; by get_rec_n, but the first zoneelement will not be initialized
; in case of variable recordlength.
; updates the counters free_bytes, free(block), free_rec_nos, and
; used_bytes.
;
; reg. entry exit
; w0 return segm.tbl.addr undef.
; w1 undef. undef.
; w2 cf_buf_ref cf_buf_ref
; w3 return addr undef.
; call quantities: rec_no_cf, size_p holding the quantities men-
; tioned above.
b. a12,c5 ; begin block insert_n
w.
d66: rl. w0 j0.
d67=k-j0 ; insert_n:
ws w3 (0) ; save return in return_1_p
hs. w3 (j21.) ;
rs. w0 (j22.) ;
rl. w1 (j26.) ; w1:= rec_no_cf
rl. w0 j0. ; get_block_r(rec_no_cf)
rl. w3 (j4.) ;
jl w3 x3+d73 ;
rl. w0 (j27.) ; save size_p and rec_no_cf in _zb
rl. w1 (j26.) ;
ds w1 x2+b51 ;
rl w0 x2+b56 ;
se w0 0 ; skip if var.length
jl. a1. ; goto fixed_length
; var.length record: calc. free_size, i.e. the adjoining free area in
; the bottom of the block.
am (x2+b63) ; w0:= last_storage(last_used_share_zb)
rl w0 +4 ;
rl w1 x2+b57 ; w1:= block_ref
wa w1 x1+f22 ; +free_base_rel
; check for safety that free_base_rel is positive
sh w1 (x2+b57) ; if block_ref + free_base_rel
jl. a12. ; <= block_ref then goto alarm(cf_error 12)
al w1 x1+1 ;
ws w0 2 ; free_size:= w0:= w0 - (w1 + 1)
; ks 2
sl w0 (x2+b50) ; if free_size < save_rec_size_zb then
jl. a0. ;
; check for safety that free_size is not negative
sh w0 -1 ; if free_size <= -1 then
jl. a12. ; goto alarm(cf_error 12)
jl. w3 d78. ; goto squeeze
\f
; jw 05.02.79 rc4000 code procedure, connected files page 10.3
;
;
a0: ; calc. rec_base for var.length
rl w3 x2+b57 ; w3:= block_ref
rl w1 x3+f22 ; w1:= free_base_rel
am (x2+b58) ; rec_base_rel(this rec):= free_base_rel
hs w1 x3 ;
; update free_base_rel
am (x2+b50) ; free_base_rel:=
al w0 x1 ; save_rec_size_zb +free_base_rel
rs w0 x3+f22 ;
am x3 ; rec_base:= w1:= block_ref
al w0 x1 ; +old_free_base_rel
; ks 3
jl. a2. ;
; fix.length record, calc. rec_base
a1: rl w0 x2+b57 ; w0:= block_ref
rl w3 x2+b58 ; w3:= rec_no_rel_zb
wa w3 0 ; rec_base_rel(this rec):=
bz w1 x3 ; rec_base_rel(this rec) +1
al w1 x1+1 ;
hs w1 x3 ;
wa w0 2 ; rec_base:= w0:= block_ref + rec_base_rel
; ks 4
; all records: update zone descr. and file_n counters.
a2: rl w3 x2+b5 ; w3:= zone_descr_base
rs w0 x3+h3 ; rec_base_zd:= rec_base
rl w1 x2+b50 ; rec_size_zd:= w1:=
ws w1 x2+b9 ; save_rec_size_zb - chain_part_size_zb
rs w1 x3+h3+4 ;
wa w0 2 ; chain_part_base_zb:=
rs w0 x2+b8 ; rec_size_zd +rec_base_zd
; ks 5 ;
; check for safety reasons that the inserted record does not extend
; beyond the upper limit of the current block.
wa w0 x2+b9 ; w0:= record_top:= chainpartbase + ch_part_size_zb
am (x2+b63) ; if record_top >=
rl w1 +4 ; last_storage_addr(last_used_share_zb)
sl w0 x1+2 ; +2
jl. a12. ; then goto alarm(cf_error 12)
rl w3 x2+b61 ; w3:= victim_zb
al w0 0 ; used_bytes :=
rl w1 x2+b50 ; save_rec_size_zb
aa w1 x3+6 ; + used_bytes
ds w1 x3+6 ;
rl w3 x2+b57 ; w3:= block_ref
bz w0 x3+f20 ; free_bytes:=
ws w0 x2+b50 ; free_bytes -save_size_zb
hs w0 x3+f20 ;
bz w1 x3+f21 ; free_rec_nos:= w1:=
al w1 x1-1 ; free_rec_nos -1
hs w1 x3+f21 ;
; ks 6
sh w1 0 ; skip if free_rec_nos > 0
jl. a3. ;
; update the block-table
rl. w3 (j5.) ; w0:= log_func(free_bytes)
jl w3 x3+d77 ;
jl. a4. ;
a3: ; block is filled, erase old log_func in the block-table.
rl w3 x2+b64 ; w3:= block_no_zb
sz w3 1 ; even block_no is a left-part-byte-entry
am 2 ;
rl. w0 c0. ; w0:= an erase-mask
\f
; jw 05.02.79 rc4000 code procedure, connected files page 10.4
;
;
ls w3 -1 ; w3:= blocktbladdr -f18:=
wa w3 x2+b61 ; block_no//2 +victim_zb
bz w1 x3+f18 ; w1:= block_tbl_byte
la w1 0 ; erase old entry
hs w1 x3+f18 ;
; ks 7
jl. a5. ;
a4: ; erase old log_func and insert the new one (w0) in the block_tbl.
rl w3 x2+b64 ; w3:= block_no_zb
so w3 1 ; even block_no is a left-part-byte entry
ls w0 6 ; shift for even block_no
ls w3 -1 ; w3:= blocktbladdr -f18:=
wa w3 x2+b61 ; block_no//2 +victim_zb
bz w1 x3+f18 ; w1:= block_tbl_byte
sh w0 63 ; choose an erase-mask,
am 2 ;
la. w1 c0. ; erase old value and
lo w1 0 ; insert the new one
hs w1 x3+f18 ;
; ks 8
; put write-operation in sharedescriptors
a5: al w0 f5 ; w0:= write
hs w0 (x2+b62) ; put blocktable;
hs w0 (x2+b63) ; oper(last_used_share_zb):= write
; macro return_n
rl. w3 (j22.) ;
rl w3 x3 ;
; ks 9
jl. (j21.) ;
;
c0: 8.0077 ; even entry erase-mask
8.7700 ; odd - - -
a12: al w1 12 ; alarm 12, cf-error
rl. w3 (j1.) ; alarm
jl w3 x3+d35 ;
m.insertn
i.
e. ; end insert_n
;
\f
; rc 28.06.71 rc4000 code procedure, connected files page 10.5
;
;
; squeeze
;
; file-n subroutine
;
; the subroutine is called from insert-n, in case the used records of a
; list-file block are spread so much that a new record cannot be inser-
; ted after the last used record. (this can only happen for files of
; variable record-length).
;
; entry exit
; w0 undef undef
; w1 undef undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; return quantities (in last-used block):
; free-base-rel is adjusted to point to the new free area
; rec-base-table a used entry is changed to point to the
; new position of the record.
;
; picture of list-file-block:
;
; ! !
; ! squeezed area !
; ! !
; free-base: !------------------------------------!
; ! !
; ! free area, one or more records !
; ! !
; used-base: !------------------------------------!
; ! !
; ! used area, one or more records !
; ! !
; last-used: !------------------------------------!
; ! !
; ! free area, or stop-record !
; ! !
;
; algorithm of squeeze:
;
; 1. insert stop-record at free-base, and calculate rec-table-base
; (a variable, which added to a record-number gives the absolute
; address of the corresponding entry in the record-table).
;
; 2. find free-base, by stepping until the first free record
; (bit-23 of first word = free-bit = 1).
;
; 3. find used-base, by stepping until the first used record
; (bit-23 = free-bit = 0), if the stop-record (size = 0) is met
; then goto 7.
;
; 4. find last-used, by stepping until the first free record, and
; at the same time adjusting the record-table entries of the
; records encountered.
;
; 5. move the used area to free-base.
;
; 6. adjust free-base, goto 3.
;
; 7. adjust free-base-rel, and return.
;
\f
; rc 28.06.71 rc4000 code procedure, connected files page 10.6
;
;
b. a20, c30 ; begin squeeze
w.
d78: d79=k-j0 ;
ds. w3 c1. ; save cf-buf-ref, save return
;
; 1. insert stop-record for squeeze, and calculate rec-table-base.
;
rl w3 x2+b57 ; w3:= block-ref-zb
;
al w0 1 ; store stop-record at
am (x3+f22) ; word(free-base-rel + block-ref + 1)
rs w0 x3+1 ;
;
rl w1 x2+b64 ; rec-table-base:=
wm w1 x2+b54 ; - (block-zb * recs-in-block-zb + 1)
ac w1 x1+1 ; + block-ref-zb
wa w1 6 ;
rs. w1 c4. ; save it
;
; 2. find free-base, by stepping until the first free record.
;
; registers exit
; w0 size + free-bit size + free-bit
; w1 rec-table-base rec-table-base
; w2 - block-ref-zb free-base-rel
; w3 old-rec-base old-rec-base
;
ac w2 x3 ; w2:= - block-ref-zb
am. (c0.) ;
wa w3 +b54 ; w3:= base-of-first-record + 1
;
; obs. recs-in-block-zb is always even in case of variable rec-length.
al w0 -1 ; -1 is added to w3 in the first place to
; let w3 point to the base of the first record
;
a1: ; find-free-base:
;ks 500
wa w3 0 ; old-rec-base:= old-rec-base + size
rl w0 x3+1 ; w0:= size + free-bit
so w0 1 ; if free-bit = 0 then
jl. a1. ; goto find-free-base
;
rs. w3 c2. ; save free-base:= old-rec-base
wa w2 6 ; w2:= free-base-rel:=
; free-base - block-ref-zb
;
\f
; rc 28.06.71 rc4000 code procedure, connected files page 10.7
;
;
; 3. find used-base, by stepping until the first used record.
;
; registers exit
; w0 size + free-bit size + free-bit
; w1 rec-table-base rec-table-base
; w2 free-base-rel free-base-rel
; w3 old-rec-base old-rec-base
;
a3: ; find-used-base:
sn w0 1 ; if size = 0 (stop-record) then
jl. a10. ; goto finish
wa w3 0 ; old-rec-base:= old-rec-base
al w3 x3-1 ; + size + free-bit - free-bit
rl w0 x3+1 ; w0:= size + free-bit
sz w0 1 ; if free-bit = 1 then
jl. a3. ; goto find-used-base
;
rs. w3 c3. ; save used-base
;
; 4. find last-used and adjust the record-table.
;
; registers exit
; wo size + free-bit size + free-bit
; w1 rec-table-base rec-table-base
; w2 free-base-rel free-base-rel
; w3 old-rec-base old-rec-base
;
a4: ; find-last-used:
am (x3+3) ; rec-base-rel(rec-no + rec-table-base):=
hs w2 x1 ; free-base-rel
;
wa w2 0 ; free-base-rel:= free-base-rel + size
wa w3 0 ; old-rec-base:= old-rec-base + size
rl w0 x3+1 ; w0:= size + free-bit
so w0 1 ; if free-bit = 0 then
jl. a4. ; goto find-last-used
;
; obs. now old-rec-base = last-used
;
ds. w3 c6. ; save free-base-rel, old-rec-base
;
; 5. move the used area to free-base.
;
; registers exit
; w0 work undef
; w1 free-base free-base
; w2 used-base old-rec-base
; w3 work and last-used old-rec-base
;
\f
; rc 28.06.71 rc4000 code procedure, connected files page 10.8
;
;
dl. w2 c3. ; fetch the two base-addresses:
; free-base and used-base
;
c20=80 ; portion:= 20 double-words
; max portion moved in one game by the move-list.
;
a5: ; move-adm:
sl w3 x2+c20 ; if last-used >= used-base + portion
jl. a7. ; then goto move-list
;
; remaining:
ac w3 x3-c20 ; w3:= portion - remaining:=
wa w3 4 ; - (old-rec-base - portion) + used-base
so w3 2.10 ; if remaining is an even no of words then
jl. a6. ; goto continue
;
rl w0 x2+1 ; move one word
rs w0 x1+1 ;
al w1 x1+2 ; increment the two bases with 2
al w2 x2+2 ;
al w3 x3+2 ; increment portion - remaining with 2
;
a6: ; continue:
ws w1 6 ; decrement free-base, used-base with
ws w2 6 ; portion - remaining
jl. x3+a7. ; increment start address of move-list with
; portion - remaining.
;
a7: ; move-list:
; an even number of words are move in increasing address order, the
; first double-word moved being given by the address: base + 3.
c21=3-k ; help constant for move-list
c22=c21-2 ;
;
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
;
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
dl w0 x2+c21+k , ds w0 x1+c22+k , dl w0 x2+c21+k , ds w0 x1+c22+k
\f
; rc 28.06.71 rc4000 code procedure, connected files page 10.9
;
;
;
rl. w3 c6. ; fetch old-rec-base = last-used
al w1 x1+c20 ; increment both bases with portion
al w2 x2+c20 ; the bases now are the bases of the next
; unmoved double-word
sl w3 x2+1 ; if last-used > used-base
jl. a5. ; then goto move-adm
;
; now the move is completed.
;
; 6. adjust free-base, goto 3.
;
; registers exit
; w0 undef size + free-bit
; w1 free-base rec-table-base
; w2 old-rec-base free-base-rel
; w3 old-rec-base old-rec-base
;
rs. w1 c2. ; save free-base
rl w0 x3+1 ; w0:= size + free-bit
dl. w2 c5. ; w1:= save rec-table-base
; w2:= save free-base-rel
jl. a3. ; goto find-used-base
;
; 7. adjust free-base-rel, and return.
;
; registers
; w0 1
; w1 rec-table-base
; w2 free-base-rel
; w3 old-rec-base
;
a10: ; finish:
rl. w3 c0. ; w3:= save-cf-buf-ref
am (x3+b57) ; free-base-rel(block):=
rs w2 +f22 ; free-base-rel
al w2 x3 ; w2:= cf-buf-ref
jl. (c1.) ; goto save return
;
; variables.
;
c0: 0 ; save cf-buf-ref
c1: 0 ; save return
c2: 0 ; save free-base
c3: 0 ; save used base
c4: 0 ; save rec-table-base
c5: 0 ; save free-base-rel
c6: 0 ; save old-rec-base
i.
e. ; end squeeze
\f
; rc 28.06.71 rc4000 code procedure, connected files page 10.10
;
;
g3=k-j0
c. g3-506
m. code on segment 10 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system10:>
m. segment 10
i.
e.
\f
; rc 18.10.78 rc4000 code procedure, connected files page 11.1
;
; this segment contains.
; connect
; get-mother-rec-int
; decode-rec
;
b. g3, j150 ; code segment 11
w.
f0=f0+1 ; increase segm.count
k=f4 ; k:= first k-value
h.
j0: g1, g2 ; headword: last point, last abs word
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm.1
j2: 1<11 o.(:2-f0:), 0 ; ref. to segm.2
j4: 1<11 o.(:4-f0:), 0 ; ref. to segm.4
j5: 1<11 o.(:5-f0:), 0 ; ref. to segm.5
j6: 1<11 o.(:6-f0:), 0 ; ref. to segm.6
j26: 0 , 11 ; own core, rec-no-cf
j31: 0 , 21 ; own core, work-1-p
j32: 0 , 23 ; own core, work-2-p
j34: 0 , 27 ; own core, result-cf
j35: 0 , 29 ; own core, byte 28-29, save cf-buf-ref-p
j51: 11, j91 ; ext.no.11, dbrecdecode
j103: f1+ 3, 0 ; rs reserve
j130: f1+30, 0 ; rs saved stack-ref, saved-w3
g2=k-2-j0 ; rel last abs word
g1=k-2-j0 ; rel last point
w.
;
j91=k-j0+1 ; dummy chain for rel for dbrecdecode
0
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 11.2
; connect(zl, chain_1, chain_2, ic_mode)
;
; file-cf procedure
;
; the procedure connects the last accessed record of chain_1 to chain_2
; according to the mode specified.
;
b. a40, c20 ; begin connect
w.
e26=f0-1
e27=k-j0
al w1 13 ; proc-no:= 13
al w0 f45+f47 ; prepare(read-update-l, update-all-l)
rl. w3 (j2.) ;
jl w3 x3+d1 ;
;
al w0 12+0 ; check-chain(param-2, daughter)
rl. w3 (j5.) ;
jl w3 x3+d5 ;
;
rl w0 x1+f12 ; w0:= last-acc-tbl:= the number of the
; record to be connected.
sh w0 0 ; if last-acc-tbl = 0 then
jl. a17. ; goto alarm(last.acc.not def.)
rs. w0 (j31.) ; save record-number in work-1-p
;
al w0 16+0 ; check-chain(param-3, daughter)
rl. w3 (j5.) ;
jl w3 x3+d5 ;
;
dl. w0 (j130.) ; take ic-mode
rl w0 x3+18 ;
so w0 16 ; if expression then
jl. a36. ; goto alarm(express.)
rl w0 (x3+20) ; w0:= ic-mode
;
; obs. w1 = chain-addr(chain-2), from check-chain
;
se w0 1 ; if ic-mode <> 1 then
jl. a0. ; goto not-mode-1
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 11.3
; ic-mode 1, next to mother.
;
dl w2 x1+2 ; move to mother
rs w1 x2+b19 ; curr-m-ch-zb:= chain-addr
rl w0 x2+b6 ;
sn w0 0 ; if mode-zb = read-only then
jl. a28. ; goto alarm(m.state))
;
rl w3 x2+b5 ;
rl w0 x3+4 ; if rec-size-zd = 0 then
sn w0 0 ; goto alarm(no.curr.)
jl. a14. ;
;
rl. w3 (j5.) ; new-head-chain
jl w3 x3+d19 ;
jl. a5. ; goto adjust-prior
;
a0: ; not-mode-one:
; registers
; w0 ic-mode <> 1
; w1 chain-addr(chain-2)
; w2 cf-buf-ref
; w3 undef
;
rl w3 x1+f12 ;
sh w3 0 ; if last-acc-tbl = 0 then
jl. a17. ; goto alarm(last.acc.not.def)
;
se w0 2 ; if ic-mode <> 2 then
jl. a1. ; goto not-mode-one-or-two
;
; ic-mode 2, next to last accessed.
;
rs w3 x1+f11 ; prior-tbl:= last-acc-tbl
jl. a5. ; goto adjust-prior
;
a1: ; not-mode-one-or-two:
; registers
; w0 ic-mode <> 1 and <> 2
; w1 chain-addr(chain-2)
; w2 cf-buf-ref
; w3 last-acc-tbl
;
se w0 3 ; if ic-mode <> 3 then
jl. a11. ; goto alarm(mode p)
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 11.4
; ic-mode 3, prior to last accessed.
;
rs w3 x1+f13 ; next-tbl:= last-acc-tbl
rl w0 x1+f11 ; if prior-tbl <> 0 then
se w0 0 ; goto adjust-prior
jl. a5. ;
;
am (x1+2) ;
rl w0 +b6 ; if mode-zb(mother-zone) = read-only then
sn w0 0 ; goto alarm(m.state)
jl. a28. ;
;
jl. w3 d22. ; get-mother-rec-int
;
a5: ; adjust-prior:
; registers
; w0 undef
; w1 chain-addr(chain-2)
; w2 cf-buf-ref
; w3 undef
;
rl. w0 (j31.) ; last-acc-tbl:= saved-record-number
rs w0 x1+f12 ;
;
rl. w0 j0. ;
rl. w3 (j6.) ; adjust-prior-rec
jl w3 x3+d21 ;
;
rl w0 x1+f12 ;
rs. w0 (j26.) ; rec-no-cf:= last-acc-tbl
;
rl. w0 j0. ;
rl. w3 (j4.) ; get-rec-n
jl w3 x3+d63 ;
;
rl w1 x2+b20 ; chain-addr:= curr-d-ch-zb
rl w3 x2+b8 ;
wa w3 x1+4 ; w3:= addr-of-next-chfld
rl w0 x3 ;
se. w0 (c0.) ; if nextchfld <> not-connected then
jl. a10. ; goto already-connected
;
; insert daughter-chain-field.
;
; registers
; w0 undef
; w1 chain-addr(chain-2)
; w2 cf-buf-ref
; w3 addr-of-next-chfld = base-of-head-field
;
rl w0 x1+f13 ; next-chfld:= next-tbl
rs w0 x3 ;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 11.5
; move head-field from chain-table to record.
;
rs. w3 (j32.) ; base-2:= work-2-p:= base-of-head-field
rl w0 x1+10 ; size:= head-fld-size-tbl
al w1 x1+f14 ; base-1:= head-fld-size-tbl
rl. w3 (j5.) ;
jl w3 x3+d9 ; move-word
;
al w0 f5 ;
hs w0 (x2+b63) ; put block
;
a8: ; return:
rl. w3 (j2.) ;
jl x3+d17 ; return-algol
;
a10: ; already-connected:
al w0 2 ; result-cf:= 2
rs. w0 (j34.) ;
rl w0 x1+f13 ; last-acc-tbl:= next-tbl
rs w0 x1+f12 ;
;
rl. w0 j0. ; reset the prior record to original state
rl. w3 (j6.) ; adjust-prior-rec
jl w3 x3+d21 ;
;
al w0 0 ;
rs w0 x1+f12 ; last-acc-tbl:=
rl w3 x2+b5 ;
rs w0 x3+4 ; rec-size-zd:=
rs. w0 (j26.) ; rec-no-cf:= 0
jl. a8. ; goto return
;
a11: am 11-14 ; alarm(mode p):
a14: am 14-17 ; alarm(no.curr.):
a17: am 17-28 ; alarm(last.acc.not.def.):
a28: am 28-36 ; alarm(m.state):
a36: al w1 36 ; alarm(express.):
rl. w3 (j1.) ;
jl w3 x3+d35 ; alarm
;
c0: f8 ; not-connected
i.
e. ; end connect
;
\f
; rc 05.11.74 rc4000 code procedure, connected files page 11.6
;
;
;
;
; subroutine get_mother_rec_int;
;
; makes the mother-record of the current daughter-chain available as
; current record of the motherfile if it is not current already.
;
; call return
; w0: return_segm_tbl_addr undef
; w1: undef chain_addr(daughter)
; w2: cf_buf_ref(daughter) cf_buf_ref(daughter)
; w3: return_addr undef
;
;
b. a10, c10 ; begin get_mother_rec_int
w.
d22: rl. w0 j0. ; entry this segm:
d23=k-f4 ; entry other segm:
ws w3 (0) ; save return inf
hs w3 x2+b1+1 ; rel. on segm.
rs w0 x2+b1+2 ;
;
; move to mother
rl w1 x2+b20 ; chain_addr:= w1:= curr_d_ch_zb;
dl w2 x1+2 ; w1:= m_ch_addr_tbl; w2:= m_cf_buf_ref_tbl;
rs w1 x2+b19 ; curr_m_ch_zb:= chain_addr;
;
rl w0 x2+b15 ;
so w0 1 ; if file_type_zb = masterfile then
jl. a1. ; goto get_masterfile_record;
;
; get_listfile_record:
;
rl w1 x1 ; w0:= word(d_ch_addr_tbl + f14 + 1);
rl w0 x1+f14+1 ; comment rec_no of mother-record;
se w0 (x2+b51) ; if w0 <> save_rec_no_zb then
jl. a0. ; goto adjust_rec_no;
rl w3 x2+b5 ; w3:= rec_base_addr_zb;
rl w3 x3+h3+4 ; w3:= rec_size_zd;
se w3 0 ; if rec_size_zd <> 0 then goto record_found;
jl. a4. ; comment current rec. is the wanted;
;
a0: ; adjust_rec_no:
;ks 1100
rs. w0 (j26.) ; rec_no_cf:= w0
rl. w0 j0. ;
rl. w3 (j4.) ; call get_rec_n;
jl w3 x3+d63 ;
jl. a6. ; goto call decode_rec;
;
\f
; rc 02.08.72 rc4000 code procedure, connected files page 11.7
; get_masterfile_record:
;
a1:
rl w1 x1 ; base_2:= work_2_p:=
al w1 x1+f14 ; d_ch_addr_tbl + f14;
rs. w1 (j32.) ;
rl w0 x2+b14 ; size:= w0:= save_head_size_zb;
al w1 x2+b21-1 ; base_1:= w1:= cf_buf_ref + b21 - 1;
rl. w3 (j5.) ; call compare;
jl w3 x3+d11 ;
se w0 0 ; if result = equal then goto record_found;
jl. a4. ;
;ks 1101
;
a2: rl w1 x2+b12 ; reserve (20 + min_rec_size_zb) bytes;
ac w1 x1+20 ; comment w1:= new_stack_top;
jl. w3 (j103.) ;
;
; set up stack_picture for call of get_rec_i.
; the first 5 words are set up by call_file_i, the last contains the
; formals, base_word, dope_vector, and content of array key.
;
; last_used
; + 10: dope-rel<12 + 19 ; 4<12 + 19
; + 12: abs-addr-of-base-word ; last-used + 14
; + 14: base-word ; last-used + 19
; + 16: upper-index ; min-rec-size-zb
; + 18: lower-index - 4 ; 0
; + 20: array key ; set by split-key-code
;
rl. w3 c1. ; dope_rel shift 12 + 19
al w0 x1+14 ; abs.addr.of base_word (last_used + 14)
ds w0 x1+12 ;
al w3 x1+19 ; base_word (last_used + 19)
rl w0 x2+b12 ; upper_index (min_rec_size_zb)
ds w0 x1+16 ;
al w0 0 ; lower_index (0)
rs w0 x1+18 ;
; set_up array in stack: (call split_key_code)
; obs. w3 = base-2 = base-of-array-key
;
rs. w2 c2. ; save cf-buf-ref
rl w1 x2+b7 ; w1:= addr-of-split-key-code
al. w0 a3. ;
rs w0 x1-2 ; store return-addr before split-key-code
rl w2 (x2+b19) ; base-1:= d-ch-add-tbl(curr-m-ch-zb)
al w2 x2+f14 ; + f14
jl x1 ; call split_key_code;
;
\f
; rc 05.11.74 rc4000 code procedure, connected files page 11.8
a3: rl. w2 c2. ; return: restore cf_buf_ref
rl. w0 j0. ;
al w1 7<2 ;
rl. w3 (j2.) ; call_file_i(get_rec_i);
jl w3 x3+d37 ; comment at return w1 = result_i;
se w1 1 ; if result_i <> 1 then alarm(10);
jl. a5. ; comment mother_record does not exist;
;
rl. w3 (j2.) ;
jl w3 x3+d7 ; call set_rec_pointers
;
; call decode_rec:
;
a6: jl. w3 d24. ; goto decode_rec;
;
; record_found:
;
a4: rl w1 x2+b19 ; back_to_daughter: w1:= curr_m_ch_zb;
dl w2 x1+2 ; w1:= curr_ch(d); w2:= cf_buf_ref(d);
rl w3 (x2+b1+2) ; return
jl x2+b1 ; goto return_1_zb;
;
; alarm_call:
;
a5: al w1 10 ; alarmno:= 10;
rl. w3 (j1.) ;
jl w3 x3+d35 ; call alarm
;
; local constants:
;
c1: 4<12+19 ; formal2.1
c2: 0 ; save cf_buf_ref
i.
e. ; end get_mother_rec_int;
\f
; rc 18.10.78 rc4000 code procedure, connected files page 11.9
;
;
; subroutine decode_rec
;
; checks indivtype and length and calls decodeinternal if
; necessary. uses return_1_zb to save return addr.
;
; call: return:
; w0: segm_table_addr undef
; w1: undef undef
; w2: cf_buf_ref cf_buf_ref
; w3: return_addr undef
;
;
b. a10, c10 ; begin decode_rec:
w.
d24: rl. w0 j0. ; entry from this segm:
d25= k-f4 ; entry from other segm:
ws w3 (0) ; save return inf
hs w3 x2+b1+1 ; rel. on segm.;
rs w0 x2+b1+2 ;
rl w1 x2+b16 ;
rl w1 x1-2 ; w1:= addr2 in dbtable;
;ks -20 ; comment w1 = addr2, w2 = cfbufref
sh w1 2047 ; if addr2 < 2048 then
jl. a3. ; goto return;
rs. w2 (j35.) ; save cf_buf_ref in cf_buf_ref_p;
rl w2 x2+b5 ; w2:= recbase addr;
rl w3 x2+4 ; w3:= zone rec size;
rl w2 x2 ; w2:= recbase;
al w0 -13 ; w0:= indivtype:=
se w3 0 ; if zonerecsize = 0 then secret
rl w0 x2+6 ; else z.indivtype;
;ks -21 ; comment w1 = addr2, w2 = recbase,
; w3 = recsize, w0 = indivtype
se w3 (x1-2) ; if zonerecsize <> length_of_last_decoded
jl. a2. ; or
sn w0 (x1) ; itype <> last_decoded_itype then
jl. a1. ; begin
a2:
; comment w0 = itype, w1 = addr2,
al w2 x3 ; w2 = zrecsize, w3 = unused;
;ks -22 ; comment see above
rl. w3 (j51.) ; entry point dbrecdecode;
jl w3 x3+502 ; call decodeinternal;
; comment w1 = addr2 in dbtable
rl w3 (x1+8) ; w3:= value of indivclass;
; -2: illegal itype
; -1: illegal length
; >=0: ok
sh w3 -1 ; if iclass <= -1 then
jl. a5. ; goto iclass_alarm;
; end;
\f
; rc 20.06.75 rc4000 code procedure, connected files page 11.10
;
;
a1: rl. w2 (j35.) ; restore cfbufref and continue;
a3: rl w3 (x2+b1+2) ; return:
jl x2+b1 ;
;
a5: ; iclass_alarm:
; w3 = -2 illegal itype, -1 ill. length
al w1 x3+32 ; alarm(30) rec.type, alarm(31) zrecsize
rl. w3 (j1.) ; call alarm on segment 1.
jl w3 x3+d35 ;
i.
e. ; end decode_rec;
;
g3=k-j0
c. g3-506
m. code on segment 11 too long
z.
c. 502-g3
0, r. 252-g3>1 ; zero fill
z.
<:cf-system11:>
i.
e.
m. end segment 11
\f
; rc 06.12.74 rc4000 code procedure, connected files page 12.1
;
; open_cf (first part)
; init_file_m (first part)
;
b. j134, g3 ; block for segment 12
f0=f0+1 ; segment count
k=f4 ; first k-value
h.
;
; abs-words for this segment
;
j0: g1, g2 ; head-word, last point and last absword
j1: 1<11o.(:1-f0:), 0 ; segment 1
j2: 1<11o.(:2-f0:), 0 ; segment 2
j13: 1<11o.1 , 0 ; next segment
j31: 0, 21 ; work_1_p
j32: 0, 23 ; work_2_p
j33: 0, 25 ; proc_no_p
j34: 0, 27 ; result_cf
j43: 3, j82 ; ext.no. 3, start_file_i
j52: 12, 0 ; ext.no.12, result_i
j53: 13, j81 ; ext.no.13, open
;
j103: f1+ 3, 0 ; rs-entry 3, reserve
j104: f1+ 4, 0 ; - 4, take_expression
j113: f1+13, 0 ; - 13, last_used
j130: f1+30, 0 ; - 30, saved_stack_ref, saved_w3
g2 = k-2-j0 ; relative of last abs-word
j134: f1+34, 0 ; - 34, inblock
g1 = k-2-j0 ; relative of last point
w.
\f
; rc 06.12.74 rc4000 code procedure, connected files page 12.2
;
; procedure open_cf(z, file_name, give_up);
; zone z; string file_name; integer give_up;
;
; opens the zone z for the specified file and prepares it for use
; by the other file_cf procedures.
;
; procedure init_file_m(zm, filename, giveup, buckfactor, blockfactor)
; value buckfactor, blockfactor;
; zone zm;
; string filename;
; integer giveup;
; real buckfactor, blockfactor;
;
; prepares a masterfile for initialization. opens the zone and calls
; init_file_i, which will check the filehead and the call parameters.
; finally zone state is set to init_m. A part of the code is placed
; on the next segment.
;
b. a33, c9 ; begin block open_cf
w.
e4=f0-1 ; init_file_m:
e5=k-j0
am 27-3 ; procno init_file_m
e6=f0-1 ; open_cf:
e7=k-j0
al w0 3 ; procno open_cf
rs. w0 (j33.) ; save procno;
rl. w2 (j113.) ; w2 := stack_ref := last_used;
ds. w3 (j130.) ; saved_stack_ref, saved_w3 := w2,w3;
rl w1 x2+8 ; w1 := zone_descriptor_address;
rl w2 x1+h2+6 ; if zone_state <> 4 then
se w2 4 ; alarm(8);
jl. a8. ;
rl w0 x1+h0+2 ; if last_of_buffer - base_buffer_area
ws w0 x1+h0 ; < 512 then
sh w0 511 ; alarm(25);
jl. a25. ;
dl w0 x1+h0+8 ; w3:= first_share; w0:= last_share;
sh w0 x3 ; if -,(last_share > first_share) then
jl. a32. ; alarm(32);
rs. w0 (j31.) ; work_1_p:= last_share;
rs w3 x1+h0+8 ; last_share:= used_share:= first_share;
rs w3 x1+h0+4 ; comment cheat open and inblock;
;
rl. w2 (j113.) ; w2:= last_used;
al w1 -26 ; set up call of open:
jl. w3 (j103.) ; reserve 26 bytes;
rs w2 x1 ; stack_ref
rl. w3 j0. ; segm.table addr. and
al w0 a0 ; rel.return addr.
ds w0 x1+4 ;
al w0 20 ; appetite:= 20
hs w0 x1+4 ;
dl w0 x2+8 ; new formal 1:= old formal 1;
ds w0 x1+8 ;
al w3 26 ; new formal 2.1:= 26; comment integer;
al w0 x2-1 ; new formal 2.2:= addr. of mode-kind;
ds w0 x1+12 ;
dl w0 x2+12 ; new formal 3:= old formal 2;
ds w0 x1+16 ;
dl w0 x2+16 ; new formal 4:= old formal 3;
ds w0 x1+20 ;
\f
; rc 06.12.74 rc4000 code procedure, connected files page 12.3
al w0 4 ; mode_kind:= 4;
rs w0 x2-2 ;
rl. w3 (j53.) ; call open
j81=k+1-j0 ; chain for rel
jl x3+0 ;
;
a0=k-j0 ; return from open:
ds. w3 (j130.) ; save w2,w3 again
rl w0 x2+8 ; call inblock;
ls w0 4 ; comment read into the whole buffer;
rl. w1 j134. ;
jl. w3 (j104.) ;
ds. w3 (j130.) ; save w2,w3 again
rl w1 x2+8 ; w1:= zone_descriptor_addr;
rl. w0 (j31.) ; restore last_share;
rs w0 x1+h0+8 ;
rl w0 x1+h2+0 ; set the end-of-document-bit
lo. w0 c7. ; in give-up-mask
rs w0 x1+h2+0 ;
rl. w0 (j33.) ; get saved procno;
rl. w3 (j13.) ;
sn w0 27 ; if procno = init_file_m
jl x3+d57 ; then goto call_init_file_m on next segment;
am (x1+h0) ; if word(base_buffer_area + 1) = 0 then
rl w0 1 ; goto list_file;
sn w0 0 ; comment test i_buf_ref_rel;
jl. a3. ;
\f
; rc 09.05.75 rc4000 code procedure, connected files page 12.3.1
;
;
;
; master_file:
;
al w1 -10 ; set up call of start_file_i:
jl. w3 (j103.) ; reserve 10 bytes;
rs w2 x1 ; stack_ref
rl. w3 j0. ; segm.table addr. and
al w0 a1 ; rel.return addr.
ds w0 x1+4 ;
al w0 4 ; appetite:= 4
hs w0 x1+4 ;
dl w0 x2+8 ; new formal 1:= old formal 1;
ds w0 x1+8 ;
rl. w3 (j43.) ; call start_file_i;
j82=k+1-j0 ; chain for rel
jl x3+0 ;
;
a1=k-j0 ; return from start_file_i:
ds. w3 (j130.) ; save w2,w3 again
al w0 f30 ; zone_state_zd:= read_only_m;
am (x2+8) ;
rs w0 h2+6 ;
al w0 f31 ; set up call of prepare
al w1 3 ;
rl. w3 (j2.) ; prepare; at return the registers contain:
jl w3 x3+d1 ; w2 = cf_buf_ref
; w3 = stack_ref
rl w0 x3+8 ; rec_base_addr_zb:= zone_descr_addr;
rs w0 x2+b5 ; comment formal 1.2;
rl w0 x2+b7 ; split_key_code_zb:=
wa w0 4 ; split_key_code_zb + cf_buf_ref
rs w0 x2+b7 ;
rl. w3 (j2.) ; call set_rec_pointers;
jl w3 x3+d7 ;
rl. w0 (j52.) ; result_cf:= result_i;
rs. w0 (j34.) ;
a2: rl w0 x2+b16 ; first_m_ch_addr_zb:=
wa w0 4 ; first_m_ch_addr_zb + cf_buf_ref;
rs w0 x2+b16 ;
al w1 1 ; action:= 1;
rl. w0 j0. ;
rl. w3 (j13.) ; call-protect-cf;
jl w3 x3+d51 ;
rl. w3 (j2.) ; call return_algol;
jl x3+d17 ;
\f
; rc 16.03.78 rc4000 code procedure, connected files page 12.4
;
;
; list_file:
;
a3: rl w1 x2+8 ;
al w0 f42 ; w1:= zone_descriptor_addr;
rs w0 x1+h2+6 ; zone_state_zd:= read_only_l;
al w0 0 ; rec_size_zd:= 0;
rs w0 x1+h3+4 ;
am (x1+h0) ; if cf_buf_ref_rel < 1 or
rl w0 3 ; cf_buf_ref_rel > 2046 then
sl w0 1 ; alarm(26);
sl w0 2047 ; comment cf_buf_ref_rel =
jl. a26. ; word(base_buf_area + 3)
al w0 f43 ; set up call of prepare;
al w1 3 ;
rl. w3 (j2.) ; prepare; at return the registers contain:
jl w3 x3+d1 ; w2 = cf_buf_ref
; w3 = stack_ref
rs. w2 c3. ; save cf_buf_ref;
rl w3 x3+8 ; w3:= zone_descr_addr; comment formal 1.2;
rl w1 x3+h0+2 ; if last_of_buffer <= cf_buf_ref + b63 then
sh w1 x2+b63 ; alarm(25);
jl. a25. ;
; checksum_control:
al w0 x3 ; save zone-descr-addr in w0
al w1 0 ; checksum:= 0
rl w3 x3+h0+0 ; for addr:= base-buffer + 2
a4: al w3 x3+2 ; step 2 until cf-buf-ref + b61 do
am (x3) ; checksum:= word(addr)
al w1 x1 ; + checksum
sh w3 x2+b61-1 ; (address arithmetic gives no overflow)
jl. a4. ;
rl w3 0 ; w3:= saved zone-descr-addr
se. w1 (c0.) ; if checksum <> <:lst:> then
jl. a26. ; alarm(26);
;
al w0 h6 ; no_of_shares_minus_1:= (w1:=)
rs. w0 c6. ; (last_share - first_share)
al w0 0 ; // share_descr_size;
rl w1 x3+h0+8 ;
ws w1 x3+h0+6 ;
wd. w1 c6. ;
rs. w1 c6. ; save no_of_shares_minus_1;
rs w3 x2+b5 ; rec_base_addr_zb:= zone_descr_addr;
;
al w3 x3+h1+2 ; call monitor-proc. process-description;
jd 1<11+4 ; comment w0:= process_descr_addr;
am (0) ;
rl w1 18 ; if segs_in_file
ws w1 x2+b52 ; - segs_in_head_zb
am (x2+b53) ; <= segs_in_block_zb
sh w1 -1 ; -1
jl. a24. ; then alarm(24);
\f
; rc 11.01.72 rc4000 code procedure, connected files page 12.5
;
al w0 0 ; new_blocks_in_file:= (w1:=)
wd w1 x2+b53 ; (segs_in_file - segs_in_head_zb)
; // segs_in_block_zb;
am (x2+b59) ; if new_blocks_in_file > max_blocks_zb then
sl w1 +1 ; alarm(33);
jl. a33. ;
rs w1 x2+b59 ; new_blocks_in_file_zb:= new_blocks_in_file;
al w1 x1+3 ; block_table_size:=
ls w1 -2 ; (new_blocks_in_file + 3) // 4 * 2
ls w1 1 ; + f18 - 2;
al w1 x1+f18-2 ;
rs. w1 (j31.) ; work_1_p:= block_table_size;
am (x2+b5) ;
rl w1 h0+2 ; room_for_blocks:= (w1:=)
al w1 x1-1 ; last_of_buffer - 1
al w0 x2+b62 ; - (cf_buf_ref + b62)
ws w1 0 ; - block_table_size;
ws. w1 (j31.) ;
rl w3 x2+b53 ; blocks_in_core:= (w1:=)
ls w3 9 ; room_for_blocks
al w3 x3+2 ; // (segs_in_block_zb * 512 + 2);
bl w0 2 ;
bl w0 0 ; comment extend sign of w1 to w0;
wd w1 6 ;
sh w1 0 ; if blocks_in_core <= 0 then
jl. a25. ; alarm(25);
rl. w3 c6. ; if blocks_in_core > no_of_shares_minus_1
sl w1 x3+1 ; then blocks_in_core:=
al w1 x3 ; no_of_shares_minus_1;
ls w1 1 ; victim_zb:=
al w1 x1+b62 ; cf_buf_ref + b62 + blocks_in_core * 2;
wa w1 4 ;
rs w1 x2+b61 ;
;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 12.6
;
;
; read the block_table from the file (stored at segm.no. first_segs_zb)
; to the zone_buffer (at the address victim_zb+2 and on).
;
rl w0 x2+b57 ; segm_count_zd:= first_segs_zb;
rl w3 x2+b5 ; w3:= zone_descr_addr;
rs w0 x3+h1+16 ;
al w0 x1+2 ; first-shared, last-shared(first-share)
rl w1 x3+h0+2 ; := first-addr, last-addr(first-share)
am (x3+h0+6) ; := victim-zb + 2, last-of-buffer
ds w1 +4 ;
am (x3+h0+6) ;
ds w1 +4+6 ;
;
;
dl w1 x3+h0+8 ; w0:= first_share; w1:= last_share;
rs. w1 (j32.) ; work_2_p:= last_share; (save last_share)
rs w0 x3+h0+8 ; last_share:= first_share;
rl. w2 (j113.) ; w2:= stack_ref;
al w0 x3 ; call inblock;
ls w0 4 ; comment read the blocktable to the
rl. w1 j134. ; zone-buffer;
jl. w3 (j104.) ;
ds. w3 (j130.) ; save w2,w3 again;
;
dl w3 x2+8 ; w2:= cf_buf_ref; w3:= zone_descr_addr;
rl. w0 (j32.) ;
rs w0 x3+h0+8 ; last_share:= work_2_p; (saved_last_share)
;
; check blocks_in_file:
rl w3 x2+b61 ; w2:= cf_buf_ref;
rl w1 x3+8 ; w3:= victim_zb; comment victim_entry;
al w0 0 ; extract fill_percentage
ld w1 +f53 ; w0:= -
ls w1 -f53 ; w1:= blocks_in_file
; check fill_percentage initialized
sh w0 0 ; if > 0
jl. a5. ;
sh w0 100 ; and =< 100
jl. a6. ; then ok
a5: rl. w0 c8. ; else set standard fill_percentage
lo w0 2 ; merge with blocks_in_file
rs w0 x3+8 ;
; could be an old file with block_table_head of old format
; change format of used_bytes , *ju-hu*
al w0 0 ;
rx w0 x3+4 ; move old used_bytees
rs w0 x3+6 ;
a6: ;
am (x2+b59) ; w1:= blocks_in_file;
sl w1 1 ; if blocks_in_file > new_blocks_in_file_zb then
jl. a24. ; alarm(24);
rl. w3 (j13.) ;
jl x3+d45 ; goto next segment;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 12.7
;
; alarm_call:
a33: am 1 ; alarmno := 33 else
a32: am 6 ; alarmno := 32 else
a26: am 1 ; alarmno := 26 else
a25: am 1 ; alarmno := 25 else
a24: am 16 ; alarmno := 24 else
a8: al w1 8 ; alarmno := 8;
rl. w3 (j1.) ;
jl w3 x3+d35 ; call alarm;
;
;
; local constants in open_cf (first part):
;
c0: <:lst:> ; testword for checksum
c3: 0 ; cf_buf_ref
c4: 0 ; last_from_address
c5: 0 ; word_entries
c6: 0 ; no_of_shares_minus_1
c7: 1<18 ; end-of-document-bit
c8: 80 < 17 ; standard fill_percentage
;
i.
e. ; end block open_cf (first part)
\f
; rc 13.05.71 rc4000 code procedure, connected files page 12.8
;
g3=k-j0
c. g3-506
m. code on segment 12 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system12:>
m. segment 12
i.
e.
\f
; rc 09.05.75 rc4000 code procedure, connected files page 13.1
;
;
b. j130, g3 ; block for segment 13
f0=f0+1
k=f4
h.
;
; abs-words for this segment
;
j0: g1, g2 ; head-word, last point and last abs-word
j1: 1<11o.(:1-f0:), 0 ; segment 1
j2: 1<11o.(:2-f0:), 0 ; segment 2
j31: 0 , 21 ; work-1-p
j33: 0 , 25 ; proc_no_p
j34: 0 , 27 ; result_cf
j35: 0 , 29 ; save-cf-buf-ref-p
j41: 1 , j81 ; ext.no.1 , init_file_i
j52: 12, 0 ; ext.no.12, result_i
j56: 16, j96 ; ext.no.16, protect-cf
j103: f1+ 3, 0 ; rs-entry 3, reserve
j104: f1+ 4, 0 ; - 4, take-expression
j113: f1+13, 0 ; - 13, last_used
j130: f1+30, 0 ; - 30, saved_stack_ref, saved_w3
g2 = k-2-j0 ; relative of last abs-word
g1 = k-2-j0 ; - - - point
w.
\f
; rc 13.05.71 rc4000 code procedure, connected files page 13.2
;
;
; procedure open_cf (second part)
;
b. a16, c12 ; begin block open_cf continued
w.
d44: d45=k-j0
;
; at entry to this segment the registers contain:
; w1 = blocks_in_file
; w2 = cf_buf_ref
;
rl w3 x2+b61 ; w3:= victim_zb;
ds. w3 c11. ; save cf_buf_ref and victim_zb;
;
sn w1 (x2+b59) ; if blocks_in_file = new_blocks_in_file_zb
jl. a12. ; then goto initialize_share_list;
;
; the following code is used when the file to be opened is greater than
; the file stored in the backing store area. new entries in the blocktable
; are created and initialized to the value ,63, (i.e. an empty block).
;
al w3 x3+f18 ; w3:= victim_zb + f18;
al w2 2.11 ; word_entries:= (w0:=)
al w0 x1 ; blocks_in_file extract 2;
la w0 4 ;
ls w1 -2 ; addr:= (w1:=)
ls w1 1 ; blocks_in_file // 4 * 2
wa w1 6 ; + victim_zb + f18;
;
al w3 -6 ; word(addr):= word(addr)
wm w3 0 ; or (-1 shift (-6*word_entries));
al w0 -1 ; comment new entries in the last used
ls w0 x3 ; blocktable-word are set to 63;
rl w3 x1 ;
lo w3 0 ;
rs w3 x1 ;
am. (c10.) ; last_addr:= (w2:=)
rl w2 b59 ; new_blocks_in_file_zb // 4 * 2
ls w2 -2 ; + victim_zb + f18;
ls w2 1 ;
wa. w2 c11. ;
al w2 x2+f18 ;
al w0 -1 ; w0:= -1;
a10: sl w1 x2 ; for addr:= addr + 2 while addr <= last_addr
jl. a11. ; do word(addr):= -1;
al w1 x1+2 ; comment new entries in the next
rs w0 x1 ; block-table-words are set to 63;
jl. a10. ;
\f
; rc 13.05.71 rc4000 code procedure, connected files page 13.3
;
a11: al w0 2.11 ; word_entries:= (w1:=)
am. (c10.) ; new_blocks_in_file_zb extract 2;
rl w1 b59 ;
la w1 0 ;
al w0 6 ; bits:= (w1:=)
al w1 x1-4 ; (word_entries - 4) * 6
wm w1 0 ;
rl w3 x2 ; word(last_addr):= word(last_addr)
ls w3 x1 ; shift bits shift (-bits);
ac w1 x1 ; comment unused entries in the last
ls w3 x1 ; new blocktableword are set to zero;
rs w3 x2 ;
rl. w2 c10. ; w2:= cf_buf_ref;
;
; initialize_share_list:
;
a12: rl w3 x2+b5 ; get zone_descr_addr from rec_base_addr_zb
rl w3 x3+h0+6 ; share_addr:= (w3:=) first_share + 6;
al w3 x3+6 ;
al w0 f6 ; for list_addr:= (w2:=) block_table_share step 2
al w1 0 ; until victim_zb do
al w2 x2+b62 ; begin
a13: rs w3 x2 ; comment set the share_descr_addr in the share-
hs w0 x3 ; list and init.operation in share-descr;
rs w1 x3+6 ; word(list_addr):= share_addr;
al w3 x3+h6 ; operation(share_addr):= read_operation;
al w2 x2+2 ;
sh. w2 (c11.) ; segm_no(share_addr):= 0;
jl. a13. ; share_addr:= share_addr + share_descr_size;
; end;
;
; now the first share-descriptor is initialized to describe
; the block_table_share;
;
rl. w2 c10. ; w2:= cf_buf_ref;
rl w3 x2+b62 ; share_addr:= (w3:=) block_table_share_zb;
rl w0 x2+b57 ; segm_no(share_addr):= first_segs_zb;
rs w0 x3+6 ;
rl. w1 c11. ; first_shared:=
al w1 x1+2 ; first_storage_addr(share_addr):=
rs w1 x3-6+2 ; victim_zb + 2;
rs w1 x3+2 ;
;
rl. w1 (j31.) ; share_size:= (w0:=)
al w0 x1+511 ; (block_table_size + 511) // 512 * 512;
ls w0 -9 ; comment block_table_size is stored
ls w0 9 ; in work_1_p;
wa. w0 c11. ; last_shared:=
rs w0 x3-6+4 ; last_storage_addr(share_addr):=
rs w0 x3+4 ; victim_zb + share_size;
al w1 x1+2 ; first:= (w1:=)
wa. w1 c11. ; block_table_size + victim_zb + 2;
rl w0 x2+b53 ; block_size:= segs_in_block_zb * 512;
ls w0 9 ;
;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 13.4
;
;
; in the following code the share-descriptors are initialized to describe
; the rest of the zone in accordance with the blocktablesize and the
; blocksize. the registers are used as follows:
; w0 = block-size
; w1 = start-addr of share in the zone_buffer (first)
; w2 = share-descriptor-address + 6 (share_addr)
; w3 = pointer to the share-list (list_addr)
;
al w3 x2+b63 ; for list_addr:= addr of last_used_share_zb
a14: rl w2 x3 ; step 2 until victim_zb do
rs w1 x2-6+2 ; begin
rs w1 x2+2 ; share_addr:= word(list_addr);
wa w1 0 ; first_shared:= first_storage_addr:=
al w1 x1-2 ; first;
rs w1 x2-6+4 ; first:= first + block_size;
rs w1 x2+4 ; last_shared:= last_storage_addr:=
al w1 x1+2 ; first - 2;
al w3 x3+2 ; end;
sh. w3 (c11.) ; comment now w3 contains the address
jl. a14. ; victim_zb + 2;
;
rl. w2 c10. ; w2:= cf_buf_ref;
rl w1 x3+6 ; last_rec_no_zb:=
la. w1 c12. ; remove fill_percentage
wm w1 x2+b54 ; blocks_in_file * recs_in_block_zb;
rs w1 x2+b60 ;
al w0 0 ;
rl w1 x3+6 ; if new_blocks_in_file_zb = blocks_in_file
la. w1 c12. ; remove fill_percentage
sn w1 (x2+b59) ; then new_blocks_in_file_zb:= 0;
rs w0 x2+b59 ;
al w1 x2 ; chain_addr (w1):= first_d_ch_addr_zb:=
wa w1 x2+b17 ; first_d_ch_addr_zb + cf_buf_ref
rs w1 x2+b17 ;
;
a15: rl w0 x1+8 ; init_next_daughter_chain_table:
sn w0 0 ; chain_addr:= next_d_ch_tbl;
jl. a16. ; if chain_addr=0 then goto init_mother_chain;
wa w0 4 ; next_d_ch_tbl:= chain_addr:=
rs w0 x1+8 ; chain_addr + cf_buf_ref;
rl w1 0 ;
jl. a15. ; goto init_next_daughter_chain_table;
;
a16: rl w0 x2+b16 ; init_mother_chain:
wa w0 4 ; first_m_ch_addr_zb:=
rs w0 x2+b16 ; first_m_ch_addr_zb + cf_buf_ref;
al w0 0 ; set zone_rec_size_zb to zero;
rl w3 x2+b5 ;
rs w0 x3+h3+4 ;
;
al w1 1 ; action:= 1;
jl. w3 d50. ; call-protect-cf; (this segment)
;
rl. w3 (j2.) ;
jl x3+d17 ; call return_algol;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 13.5
;
;
; local constants in open_cf (second part):
;
c10: 0 ; cf_buf_ref
c11: 0 ; victim_zb
c12: f51 ; mask for blocks_in_file
;
i.
\f
; rc 09.05.75 rc4000 code procedure, connected files page 13.5.1
e. ; end block open_cf (second part)
;
; init_file_m (second part) ,
; call_init_file_i:
;
; at entry at exit
; w0 procno 0
; w1 zone_descr_addr rec_base_addr_zb
; w2 last used cf_buf_ref
; w3 undefined undefined
;
b. a10 ; block call_init_file_i
w.
d56: d57=k-j0
;ks -30
al w1 -18 ; set up call
jl. w3 (j103.) ; reserve 18 bytes
rs w2 x1 ; stack ref
rl. w3 j0. ; segm table addr
al w0 a1 ; rel return addr
ds w0 x1+4 ;
al w0 12 ; appetite = 12 bytes (3 parameters)
hs w0 x1+4 ;
dl w0 x2+8 ;
ds w0 x1+8 ; new formal 1 := old formal 1 (zone)
dl w0 x2+20 ;
ds w0 x1+12 ; new formal 2:= old formal 4 (buckfactor)
dl w0 x2+24 ;
ds w0 x1+16 ; new formal 3:= old formal 5 (blockfactor)
rl. w3 (j41.) ; call init_file_i;
j81=k+1-j0 ; chain for rel
jl x3+0 ;
a1=k-j0 ; return from init_file_i:
;ks -31
ds. w3 (j130.) ; save w2, w3 again;
al w0 f38 ; zone_state_zb:= init_m;
rl w3 x2+8 ; w3:= base of zone descr = formal 1.2
rs w0 x3+h2+6 ;
rl w2 x3+h0+0 ; w2:= cf_buf_ref:= base_buffer
wa w2 x2+3 ; + cf_buf_ref_rel;
rs w3 x2+b5 ; rec_base_addr_zb:= zone_descr_addr;
al w0 0 ;
rs w0 x3+h3+4 ; rec_size_zd:= 0;
rl. w0 (j52.) ; result_cf:= result_i;
rs. w0 (j34.) ;
rl w0 x2+b16 ; first_m_ch_addr_zb:=
wa w0 4 ; first_m_ch_addr_zb + cf_buf_ref;
rs w0 x2+b16 ;
rl. w3 (j2.) ; call return_algol
jl x3+d17 ;
e. ; end block
\f
; rc 01.06.71 rc4000 code procedure, connected files page 13.6
;
;
; procedure init_chain(zm, zl, chainno, chain);
; zone zm,zl; integer chainno; real chain;
;
; establishes the connection between the two zones used for the
; motherfile (zm) and the daughterfile (zl) of a chain;
;
b. a40 ; begin procedure init_chain
w.
e10=f0-1 ; init_chain:
e11=k-j0 ;
rl. w2 (j113.) ; w2:= stack_ref:= last_used;
ds. w3 (j130.) ; save w2,w3;
dl w1 x2+16 ; get parameter chainno
so w0 16 ; if expression then
jl. w3 (j104.) ; goto take_expression;
rl w1 x1
rs w1 x2+16 ; formal 3.2:= chainno;
ds. w3 (j130.) ; save w2,w3;
;
dl w1 x2+20 ; get parameter chain
so w0 16 ; if expression then
jl. a36. ; alarm(36);
;
;
; set up call of prepare for the first parameter (zone zm)
;
al w0 f49 ; prepare;
al w1 5 ; at return the registers contain:
rl. w3 (j2.) ; w2:= formal_1.1:= cf_buf_ref (zm);
jl w3 x3+d1 ; w3:= stack_ref;
;
; copy the function of prepare for the second parameter (zone zl)
;
rl w1 x3+12 ; w1:= base of zonedescr.
al w0 f43+f45+f47 ; w0:= state-bits of allowed zonestates;
am (x1+h2+6) ;
ls w0 -f29 ; if statebits shift (z.state - maxstate)
so w0 1 ; <> 1 then alarm(8);
jl. a4. ; comment zonestate-error;
rl w1 x1+h0+0 ; formal_2.1:= x1:= cf_buf_ref(zl):=
wa w1 x1+3 ; base_buffer(zl) + cf_buf_ref_rel(zl);
rs w1 x3+10 ;
\f
; rc 03.05.72 rc4000 code procedure, connected files page 13.7
;
;
; find and check actual mother_chain_tbl:
;
rl w2 x2+b16 ; m_addr:= (w2:=) first_m_ch_addr_zb(zm);
; comment addr of first mother_chain_tbl;
a0: al w0 0 ; test_chainno_m:
sn w0 (x2) ; if mother_tbl exhausted then alarm(9);
jl. a9. ; comment file and chain not associated;
bz w0 x2+6 ; if chain_number_tbl = chainno then
sn w0 (x3+16) ; goto mother_tbl_found;
jl. a1. ;
al w2 x2+f10 ; m_addr:= addr of next mother_chain_tbl;
jl. a0. ; goto test_chainno_m;
;
a1: ; mother_tbl_found:
;
; find and check actual daughter_chain_tbl:
;
rl w1 x1+b17 ; d_addr:= (w1:=) first_d_ch_addr_zb(zl);
; comment addr of first daughter_ch_tbl;
a2: bz w0 x1+6 ; test_chainno_d:
sn w0 (x3+16) ; if chain_number_tbl = chainno then
jl. a3. ; goto daughter_tbl_found;
rl w1 x1+8 ; d_addr:= next_d_ch_tbl;
sn w1 0 ; if daughter_tbl exhausted then alarm(9);
jl. a9. ; comment file and chain not associated;
jl. a2. ; goto test_chainno_d;
;
a3: ; daughter_tbl_found:
;
; initialize actual mother_chain_tbl and daughter_chain_tbl:
;
rs w2 x1 ; m_ch_addr_tbl:= m_addr;
rl w0 x3+6 ; m_cf_buf_ref_tbl:= cf_buf_ref(zm);
rs w0 x1+2 ;
rs w1 x2 ; d_ch_addr_tbl:= d_addr;
rl w0 x3+10 ; d_cf_buf_ref_tbl:= cf_buf_ref(zl);
rs w0 x2+2 ;
rx w1 4 ; exchange m_addr and d_addr;
ds w2 (x3+20) ; chain:= m_addr shift 24 add d_addr;
; comment return-parameter;
rl w2 x2+2 ; w2:= cf_buf_ref(zm);
rl. w3 (j2.) ;
jl x3+d17 ; call return_algol;
\f
; rc 03.05.72 rc4000 code procedure, connected files page 13.8
;
;
; alarm_call:
;
a4: rl w2 x1+h2+6 ; zonestateerror: w1 = zone_descr_addr;
a8: am 8-9 ; alarm(z.state):
a9: am 9-36 ; alarm(ch.ass.):
a36: al w1 36 ; alarm(express.):
rl. w3 (j1.) ;
jl w3 x3+d35 ; call alarm;
;
i.
e. ; end block init_chain
\f
; rc 05.11.71 rc4000 code procedure, connected files page 13.9
;
; subroutine call-protect-cf
;
; the routine reserves and sets up a new stack top and calls the
; external procedure protect-cf(z, action).
; action indicates where the routine was called from:
; action = 1: from open-cf just before call of return-algol
; = 2: from update-all-cf or read-upd-cf before call
; of update-i-proc or set-mode-n, if old mode
; was read-only.
; = 3: from read-only-cf just before return-algol, if
; old-mode was some update-mode.
;
; call return
; w0: call segm-tbl-addr undef
; w1: action undef
; w2: cf-buf-ref cf-buf-ref
; w3: return-addr undef
;
b. a5, c5 ; begin block call-protect-cf
w.
d50: rl. w0 j0. ; entry this segment:
d51=k-j0 ; entry other segment:
ws w3 (0) ; save return-inf
hs w3 x2+b1+1 ; rel.on segm.
rs w0 x2+b1+2 ; segm.no.
rs. w2 (j35.) ; save-cf-buf-ref-p:= cf-buf-ref;
al w0 x1 ; save action in w0
;
al w1 -16 ; set up call of protect-cf
jl. w3 (j103.) ; reserve 16 bytes
; w0 and w2 are unchanged, w1 = new stack top
al w3 x1+15 ; addr of action and action as
ds w0 x1+14 ; formal2.2 and literal1
;
rl w3 x2+b5 ; rec-base-addr-zb and integer-variable
al w0 26 ; as formal1.2 and formal2.1
ds w0 x1+10 ;
;
dl. w3 (j130.) ; w2:= saved-stack-ref
; store return point and formal1.1
rl. w3 j0. ; stack-ref and
ds w3 x1+2 ; segm-table-addr;
dl. w0 c1. ; appetite < 12 + rel.return and
ds w0 x1+6 ; zone-formal.1;
;
rl. w3 (j56.) ; call protect-cf
j96=k+1-j0 ; chain for rel
jl x3+0 ;
;
a0=k-j0 ; return from protect-cf:
ds. w3 (j130.) ; save stack-ref,w3 again
rl. w2 (j35.) ; w2:= cf-buf-ref
rl w3 (x2+b1+2) ;
jl x2+b1 ; goto return-int;
\f
; rc 05.11.71 rc4000 code procedure, connected files page 13.10
;
;
; local constants:
;
c0: 10<12 + a0 ; appetite shift 12 + rel.return
c1: 6<12 + 23 ; zone-formal.1
i.
e. ; end block call-protect-cf;
g3=k-j0
c. g3-506
m. code on segment 13 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system13:>
m. segment 13
i.
e.
\f
; rc 10.09.79 rc4000 code procedure, connected files page 14.1
b. g10, j185 ; code segment 14:
f0=f0+1 ; increase segment count
k=f4
h.
j0: g1, g2 ; headword: last point, last absword
j1: 1<11 o.(:1-f0:), 0 ; ref. to segm. 1
j2: 1<11 o.(:2-f0:), 0 ; ref. to segm. 2
j4: 1<11 o.(:4-f0:), 0 ; ref. to segm. 4
j13: 1<11 o.(:13-f0:), 0 ; ref. to segm. 13
j15: 1<11 o.(:15-f0:), 0 ; ref. to segm. 15
j21: 0 , 1 ; own core, return-1-p
j22: 0 , 3 ; own core, return-1-p
j23: 0 , 5 ; own core, return-2-p
j24: 0 , 7 ; own core, return-2-p
j26: 0 , 11 ; own core, rec-no-cf
j30: 0 , 19 ; own core byte 18-19, work_0_p
j31: 0 , 21 ; own core byte 20-21, work_1_p
j33: 0 , 25 ; own core byte 24-25, proc_no_p
j35: 0 , 29 ; own core, save-cf-buf-ref-p
j103: f1+3 , 0 ; rs reserve
j104: f1+4 , 0 ; rs take expression
j113: f1+13, 0 ; rs last used
j130: f1+30, 0 ; rs saved stack ref, saved w3
j185: f1+85, 0 ; rs current activity
g2=k-2-j0 ; rel of last absword
j133: f1+33, 0 ; rs entry point for check
g1=k-2-j0 ; rel of last point
w.
\f
; rc 05.11.71 rc4000 code procedure, connected files page 14.2
;
;
; procedure close_cf(z,rel);
; zone z; boolean rel;
;
; terminates the use of the zone by writing back eventual updated
; blocks. releases the document if it is specified by param.2. rec_
; size_zd is set to 0, say, no zone-record available.
; chain_states for all associated chains are set to not_init, simply
; by putting -1 in the corresponding chaintabels of the other zones.
; result_cf = 1, ok
;
b. a10 ; begin block close_cf
w.
e12=f0-1 ; close_cf:
e13=k-f4
al w1 6 ; proc_no:= 6
al w0 f39+f49
rl. w3 (j2.) ;
jl w3 x3+d1 ; prepare(all_cf_states)
rl w1 x3+8 ;
;
rs w1 x2+b5 ; rec-base-addr-zb:= formal1.2
; obs. not done in init-file-m, but used
; in call-file-i
rl w1 x1+h2+6 ; w1:= zonestate
al w2 x3 ; w2:= stack_ref
se w1 f38 ; if zonestate <> init_m then
jl. a0. ; goto other_states;
al w1 -10 ; init_state:
jl. w3 (j103.) ; reserve(10 bytes)
rl. w0 j0.
al w1 4<2
rl w2 x2+6
rl. w3 (j2.) ; call_file_i(set_read_i)
jl w3 x3+d37
dl. w3 (j130.) ; w2:= stack_ref
jl. a2.
a0: al w1 -10 ; other_states: reserve(10 bytes)
jl. w3 (j103.) ;
rs w2 x1 ; w(newtop):= oldtop
rl. w3 j0. ; return segm tbl addr:= this segm
al w0 a1 ; appetite<12 +rel_return:=
ds w0 x1+4 ; 4<12 +rel_this_segm
al w0 4 ;
hs w0 x1+4 ;
;
rl w3 x2+8 ; move formal 1.2
rs w3 x1+8 ;
al w1 0 ; proc_no:= 0
jl. d42. ; read_only_cf_int this segm.
a1=k-j0 ; rel_this_segm:
ds. w3 (j130.)
al w0 6 ; proc_no_p:= 6
rs. w0 (j33.)
\f
; rc 05.11.71 rc4000 code procedure, connected files page 14.3
;
a2:
dl w1 x2+12 ; take param 2, release
so w0 16 ;
jl. w3 (j104.) ;
ds. w3 (j130.) ;
bl w0 x1 ;
rl w1 x2+8 ; w1:= addr of zd
so w0 1 ; if w0 then goto release;
jl. a3. ;
al w3 x1+h1+2 ; release: w3:= name addr
jd 1<11+64 ; goto monitor procedure remove process
a3: al w0 4 ;
rs w0 x1+h2+6 ; zonestate:= 4
al w0 0
rs w0 x1+h3+4 ; rec_size_zd:= 0
rl w2 x2+6 ; w2:= formal1.1:= cf_buf_ref
rl w0 x2+b16 ; test after init_m-state
sh w0 0 ; if first-m-ch-addr-zb <= 0 then
jl. a7. ; goto finis;
al w0 -1 ;
rl w3 x2+b15
so w3 1 ; if file_type_zb = master then
jl. a5. ; goto mother_chains else
; daughter_chains:
rl w1 x2+b17 ; chain_addr:= w1:= first_d_ch_addr_zb
a4: rl w3 x1 ; w3:= w(chain_addr)
se w0 x3 ; if w(chain_addr) <> -1 then
rs w0 x3 ; w(w(chain_addr):=
se w0 x3 ; w(w(chain-addr)+2):= -1
rs w0 x3+2 ;
;
rl w1 x1+8 ; chain_addr:= w(chain_addr +8)
se w1 0 ; if chain_addr <> end of ch_tbl then
jl. a4. ; continue loop
a5: ; mother_chains:
rl w1 x2+b16 ; chain_addr:= w1:= first_m_ch_addr_zb
a6: rl w3 x1 ; w3:= w(chain_addr)
sn w3 0 ; if w(chain_addr) = end of ch_tbl then
jl. a7. ; goto finis;
se w0 x3 ; if w(chain_addr) <> -1 then
rs w0 x3 ; w(w(chain_addr)):=
se w0 x3 ; w(w(chain-addr)+2):= -1
rs w0 x3+2 ;
;
al w1 x1+f10 ; chain_addr:= chain_addr +size_of_m_ch_tbl
jl. a6. ; continue loop
a7: rl. w3 (j2.) ; finis:
jl x3+d17 ; return_algol
i.
e. ; end block close_cf
\f
; rc 05.11.71 rc4000 code procedure, connected files page 14.4
;
; procedure update_all_cf(z);
; procedure read_upd_cf(z);
; procedure read_only_cf(z);
; subroutine read_only_cf_int(z);
; zone z;
;
; the mode is changed according to the procedure called, and blocks are
; transferred to or from the file as required, see the manual.
; result_cf = 1, ok.
;
; note for call of read_only_cf_int:
; the stack-top must hold a correct return-point and formal.2 of the
; zone-parameter.w1:= proc_no:= 0.
;
b. a5 ; begin block mode-procs.
w.
e42=f0-1 ; update_all_cf:
e43=k-f4
am 1
e40=f0-1 ; read_upd_cf:
e41=k-f4
am 1
e38=f0-1 ; read_only_cf:
e39=k-f4
al w1 19 ;
d42: d43=k-j0 ; read_only_cf_int:
al w0 f49
rl. w3 (j2.) ;
jl w3 x3+d1 ; prepare(all states except init_m)
rl. w1 (j33.) ; w1:= proc_no_p
se w1 0 ; w1:= work-1-p:= new-mode:=
al w1 x1-19 ; if proc-no-p <> 0 then proc-no-p - 19
rl w0 x2+b6 ; else 0;
ds. w1 (j31.) ; w0:= work-0-p:= old-mode:= mode-zb;
;
sn w0 0 ; if old-mode = 0 (read-only) and
sn w1 0 ; new-mode <> 0 (read-upd/update-all)
jl. a0. ; then
al w1 2 ; begin
rl. w0 j0. ; action:= 2;
rl. w3 (j13.) ; call-protect-cf;
jl w3 x3+d51 ; end;
;
a0: rl w0 x2+b15 ; w0:= file_type_zb
sz w0 1 ; if file_type = 1 then
jl. a2. ; goto listfile;
\f
; rc 05.11.71 rc4000 code procedure, connected files page 14.5
;
rl. w1 (j31.) ;
rs w1 x2+b6 ; masterfile: mode_zb:= work_1_p
al w1 -10 ;
jl. w3 (j103.) ; reserve(10 bytes)
rl. w0 j0. ;
rl w1 x2+b6 ; w1:= (work_1_p +4)<2
al w1 x1+4 ;
ls w1 2 ;
rl. w3 (j2.) ; call_file_i(set_read_i,set_put_i, or
jl w3 x3+d37 ; set_update_i)
rl. w3 (j2.) ;
jl w3 x3+d7 ; set_rec_pointers
jl. a3. ; goto finis;
;
a2: ; listfile: comment work-1-p holds new_mode;
jl. w3 d60. ; goto set_mode_n this segment
;
a3: ; finis:
rl. w0 (j30.) ; w0:= old-mode:= work-0-p;
rl w1 x2+b6 ; w1:= new-mode:= mode-zb;
sn w1 0 ; if new-mode = 0 (read-only) and
sn w0 0 ; old-mode <> 0 (read-upd/update-all)
jl. a4. ; then
al w1 3 ; begin
rl. w0 j0. ; action:= 3;
rl. w3 (j13.) ; call-protect-cf;
jl w3 x3+d51 ; end;
;
a4: rl. w3 (j2.) ;
jl x3+d17 ; return_algol
i. ;
e. ; end block mode-procs
\f
; rc 05.11.74 rc4000 code procedure, connected files page 14.6
;
;
; set-mode-n
;
; file-n procedure
;
; set-mode-n changes the mode of a list-file.
; two sigificant different changes are possible:
;
; 1. from read-only to any state.
; in all block-shares the non-possible segment-number zero is
; inserted.
;
; 2. from some update-mode to any mode.
; all updated blocks are
; written back to the file.
;
; in any case mode-zb is changed to the new mode, the zone-state
; is altered, and current record, if any, is read again.
; if the new mode is an update-mode, new-blocks-in-file-zb is
; inspected to see if the file has grown bigger since the previous
; run, and the new blocks not included yet, if that is the case the
; new blocks are initialized by a call of init-blocks, which will reset
; new-blocks-in-file-zb to zero.
;
; entry exit
; w0 return segm tbl address undef
; w1 undef undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
; call quantities:
; work-1-p specifies the new mode by the same values as
; mode-zb:
; 0: read-only
; 1: read-update
; 2: update-all
;
b. a20, c20 ; begin set-mode-n
w.
d60: rl. w0 j0. ;
d61=k-j0 ;
ws w3 (0) ; save-return-1-p
hs. w3 (j21.) ;
rs. w0 (j22.) ;
;
rl w3 x2+b5 ;
rl w3 x3+4 ; if rec-size-zd = 0 then
se w3 0 ; rec-no-cf:= 0
rl w3 x2+b51 ; else rec-no-cf:= save-rec-no-zb
rs. w3 (j26.) ;
;
rl w1 x2+b51 ; if save-rec-no-zb <> 0 then last-used-
rl. w3 (j4.) ; block is properly updated by means of
se w1 0 ; an otherwise dummy call of get-block-r
jl w3 x3+d73 ;
\f
; rc 05.11.71 rc4000 code procedure, connected files page 14.7
;
;
rl w0 x2+b6 ; old-mode:= w0:= mode-zb
rl. w1 (j31.) ; mode-zb:= new-mode:= w1:=
rs w1 x2+b6 ; work-1-p
;
al w3 x1+f42 ; zone-state-zd:=
am (x2+b5) ; new-mode + read-only-l
rs w3 h2+6 ;
;
se w0 0 ; if old-mode <> read-only then
jl. a2. ; goto from-some-update-mode
;
a1:
; 1. from read-only to any state.
; insert zero as segment-number in all block-shares.
;
rl w3 x2+b61 ; list-addr:= victim-zb
;
a3: ; rep1:
rl w1 x3 ; segm-no(share(list-addr)):= 0
rs w0 x1+6 ; obs. w0 = 0 = read-only-mode
al w3 x3-2 ; list-addr:= list-addr - 2
sl w3 x2+b63 ; if list-addr >= addr of last-used-share
jl. a3. ; then goto rep1
;
; now all block-shares contains the dummy segment-number zero.
; if new-mode <> read-only and new-blocks-in-file-zb <> 0 then
; the new blocks should be initialized.
se w0 (x2+b6) ; if new-mode = read-only (=0)
sn w0 (x2+b59) ; or new-blocks-in-file-zb = 0 then
jl. a10. ; goto fetch current record (obs. w0=0)
;
rl. w3 (j15.) ;
jl x3+d83 ; init-blocks
d84: d85=k-j0 ; return-from-init-blocks:
jl. a10. ; goto fetch current record
\f
; rc 11.12.74 rc4000 code procedure, connected files page 14.8
;
;
a2:
; 2. from some update-mode to any mode.
; all updated blocks are written back and checked
; by means of subroutine write-back.
;
jl. w3 d90. ; write-back, this segm.
;
a10:
; fetch current record:
; if rec-no-cf > 0 the current record is reestablished by a return
; via get-rec-n-int, otherwise a normal return is performed.
al w0 0 ; set zone_rec_size_zd to zero;
rl w3 x2+b5 ;
rs w0 x3+h3+4 ;
rl. w3 (j4.) ;
rl. w0 (j26.) ;
se w0 0 ; if rec-no-cf <> 0 then
jl x3+d89 ; get-rec-n-int
; normal return:
rl. w3 (j22.) ; return-1-p
rl w3 x3 ;
jl. (j21.) ;
;
i.
e. ; end set-mode-n
\f
; rc 05.11.71 rc4000 code procedure, connected files page 14.9
;
;
;
; write-back
;
; file-n subroutine
;
; the subroutine writes back all updated shares, i.e. all shares con-
; taining a write-operation.
; a read-operation is inserted after check of a transfer.
;
; entry exit
; w0 return-segm-tbl-address undef
; w1 undef undef
; w2 cf-buf-ref cf-buf-ref
; w3 return-address undef
;
;
; the subroutine uses return-2-p and rec-no-rel-zb
;
b. a20, c20 ; begin write-back
w.
d90: rl. w0 j0. ;
d91=k-j0 ;
ws w3 (0) ; save return in return-2-p
hs. w3 (j23.) ;
rs. w0 (j24.) ;
;
; registers in loop
; w0 work
; w1 share-addr
; w2 cf-buf-ref also saved in save-cf-buf-ref-p
; w3 list-addr also saved in rec-no-rel-zb
;
rs. w2 (j35.) ; save-cf-buf-ref-p:= cf-buf-ref
rl w3 x2+b61 ; list-addr:= victim-zb
a4: ; rep:
rl w1 x3 ;
bz w0 x1 ; if operation(share(list-addr)) <>
se w0 f5 ; write-oper then
jl. a7. ; goto next share
;
; the share has been updated, and perhaps the transfer has been ini-
; tialized but not checked.
;
rs w3 x2+b58 ; save-list-addr in rec-no-rel-zb
al w0 x1-6 ; w0:= normal share-descriptor address
rl w3 x2+b5 ; w3:= rec-base-addr-zb
rs w0 x3+h0+4 ; used-share-zd:= current share
rl w0 x1-6 ;
se w0 0 ; if share-state <> checked then
\f
; rc 10.09.79 rc4000 code procedure, connected files page 14.10
;
jl. a6. ; goto check-transfer
;
; init transfer by send message.
; w1 points already to the message, w3 should point to the name of the
; area process.
al w3 x3+h1+2 ;
rl. w2 (j185.) ; w2:= rs_current_activity
jd 1<11+16 ; send message
;
; if no message buffer available then provoke break 6 by wait answer
sn w2 0 ;
jd 1<11+18 ; wait-answer
;
rs w2 x1-6 ; share-state:= w2:= buffer-address
rl. w2 (j35.) ; fetch save-cf-buf-ref-p
;
a6: ; check-transfer:
rl w0 x2+b5 ; w0:= zone-descriptor address
ls w0 4 ; shift 4
rl. w1 j133. ; w1:= entry point check
dl. w3 (j130.) ; w2:= saved-stack-ref
jl. w3 (j104.) ; goto rs take expression
ds. w3 (j130.) ; save stack-ref
rl. w2 (j35.) ; fetch save-cf-buf-ref-p
rl w3 x2+b58 ; fetch list-addr from rec-no-rel-zb
al w0 f6 ; operation(share(list-addr)):=
hs w0 (x3) ; read-oper
;
a7: ; next share:
al w3 x3-2 ; list-addr:= list-addr - 2
sl w3 x2+b62 ; if list-addr >= addr of block-table-share
jl. a4. ; then goto rep
;
rl. w3 (j24.) ; goto return-2-p
rl w3 x3 ;
jl. (j23.) ;
;
i.
e. ; end write-back
\f
; rc 05.11.71 rc4000 code procedure, connected files page 14.11
;
g3=k-j0
c. g3-506
m. code on segment 14 too long
z.
c. 502-g3
0,r. 252-g3>1 ; fill the segment with zeroes
z.
<:cf-system14:>
i.
e.
m. end segment 14
\f
; rc 05.01.72 rc4000 code procedure, connected files page 15.1
;
; this segment contains:
; init-blocks
; subroutine getparam
; subroutine setparam
; call-alarmproc
;
b. g3, j150 ; code segment 15
w.
f0=f0+1 ; increase segm.count
k=f4 ; k:= first k-value
h.
j0: g1, g2 ; head-word: last point, last abs word
j1: 1<11 o.(: 1-f0:), 0 ; ref. to segm.1
j4: 1<11 o.(: 4-f0:), 0 ; ref. to segm.4
j14: 1<11 o.(:14-f0:), 0 ; ref. to segm.14
j31: 0 , 21 ; work_1_p
j32: 0 , 23 ; work_2_p
j33: 0 , 25 ; proc-no-p
j36: 0 , 31 ; alarmno-p
j103: f1 + 3, 0 ; rs reserve
j105: f1 + 5, 0 ; rs goto point
j130: f1 + 30, 0 ; rs saved stack ref, saved w3
g2=k-2-j0 ; rel last abs word
g1=k-2-j0 ; rel last point
w.
\f
; rc 21.04.71 rc4000 code procedure, connected files page 15.2
;
; init-blocks
;
; file-n subroutine.
;
; the procedure initializes all the blocks, which are included in a
; list-file.
; the procedure is only called from set-mode-n, and returns to a speci-
; fic point in that procedure.
;
; entry exit
; w2 cf-buf-ref cf-buf-ref
; other registers are undef
;
; no current record must exist when init-blocks is called, and no cur-
; rent record exists at return.
;
b. a20, c20 ; begin init-blocks
w.
d82: d83=k-j0 ; entry:
;
; use last-used-share for the initialization, no updated block is in
; the share.
;
rl w1 x2+b63 ;
rl w3 x1+2 ; w3:= block-ref-zb:=
al w3 x3-f20 ; first-storage-address - f20
rs w3 x2+b57 ;
rl w1 x1+4 ; w1:= last-storage-address
;
al w0 1 ; word(last-storage-address):=
rs w0 x1 ; marking-of-last-word:= 1
;
al w0 0 ;
a0: ; set-zeroes:
al w1 x1-2 ; put zeroes from last-storage-address - 2
rs w0 x1 ; until block-ref
sl w1 x3+2 ; if addr > block-ref then
jl. a0. ; goto set-zeroes
;
rl w1 x2+b55 ; free-bytes:=
ls w1 -3 ; max-free-shift-3-zb shift (-3)
hs w1 x3+f20 ;
;
rl w1 x2+b54 ; free-rec-nos:=
hs w1 x3+f21 ; recs-in-block-zb
;
so w1 1 ; free-base-rel:=
al w1 x1-1 ; if recs-in-block is odd then
rs w1 x3+f22 ; recs-in-block else recs-in-block - 1
;
al w1 -1 ; over-flow-block:= -1
rs w1 x3+f23 ;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 15.3
;
; initialize the record-table, the table is initialized in the same
; way for fix-rec-size and variable rec-size
;
; registers
; w0 rec-base-rel (even = not used record)
; w1 rec-no-rel
; w2 cf-buf-ref
; w3 block-ref
;
al w0 -1 ;
wa w0 x3+f22 ; rec-base-rel:= free-base-rel - used-bit
al w1 0 ; rec-no-rel:= 0
;
a1: ; next-rec-no:
am x3 ; rec-base-rel(block-ref
hs w0 x1 ; + rec-no-rel):= rec-base-rel
;
wa w0 x2+b56 ; rec-base-rel:= rec-base-rel
; + fix-rec-size-zb
al w1 x1+1 ; rec-no-rel:= rec-no-rel + 1
se w1 (x2+b54) ; if rec-no-rel < recs-in-block-zb then
jl. a1. ; goto next-rec-no
;
; now last-used share has been initialized, and it should be written
; back in the needed number of copies by means of write-back.
am (x2+b61) ;
rl w0 +8 ; block-no:= old-blocks-in-file
la. w0 c0. ; remove fill_percentage
a2: ; next-block:
rs w0 x2+b64 ; save block-no in block-zb
wm w0 x2+b53 ; segm-no:= block-no * segs-in-block-zb
wa w0 x2+b52 ; + segs-in-head-zb
rl w1 x2+b63 ; w1:= share-addr(last-used-share)
rs w0 x1+6 ; store-segm-no in share
;
al w0 f5 ; put-block
hs w0 x1 ;
;
rl. w0 j0. ;
rl. w3 (j14.) ;
jl w3 x3+d91 ; write-back
;
al w0 1 ; block-no:= block-zb + 1
wa w0 x2+b64 ;
se w0 (x2+b59) ; if block-no < new-blocks-in-file-zb then
jl. a2. ; goto next-block
\f
; rc 01.10.77 rc4000 code procedure, connected files page 15.4
;
; set constants:
; all new blocks have now been initialized, and it only remains to
; adjust the block-table accordingly.
;
rl w3 x2+b61 ; pointer to block_table
rl w1 x3+8 ; fill_percentage , blocks_in_file
la. w1 c1. ; change blocks_in_file to
lo w1 x2+b59 ; new_blocks_in_file
rs w1 x3+8 ;
;
rl w1 x2+b59 ; w1:= new_blocks_in_file_zb
wm w1 x2+b54 ; last-rec-no-zb:= new-blocks-in-file-zb
rs w1 x2+b60 ; * recs-in-block-zb
rs w0 x2+b59 ; new-blocks-in-file-zb:= 0 (wm w1)
;
al w0 f5 ;
hs w0 (x2+b62) ; put block-table;
rl. w3 (j14.) ;
jl x3+d85 ; goto return-from-init-blocks
;
; constants and variables:
c0: f51 ; mask for blocks_in_file
c1: f52 ; - fill_percentage
i.
e. ; end init-blocks
\f
; rc 01.10.77 rc4000 code procedure, connected files page 15.5
;
;
; subroutine get_param
;
; the routine is called from the parameter-administration
; in get_param_cf (segment 16)
;
; the routine takes a parameter-value from the zonebuffer of a
; list-file, and stores it at the wanted value-address. work_1_p
; contains the parameter-no:
; 1 = dead-bytes
; 2 = used-bytes
; 3 = fill-percentage
;
; call return
; w0: undef result (1 = ok, 0 = not_ok)
; w1: value-address undef
; w2: cf_buf_ref undef
; w3: return_address undef
;
b. a5, c5 ; begin block get_param
w.
d46: d47=k-f4 ; get_param:
al w3 x3+2 ; modify return_addr;
rs. w3 c0. ; save return_addr;
rs. w1 (j32.) ; work_2_p:= value_address;
rl. w1 (j31.) ; param_no:= w1:= work_1_p;
; ks 101
sl w1 1 ; if param_no < 1 or param_no > 3 then
sl w1 4 ; goto result_not_ok;
jl. a2. ;
;
ls w1 1 ; new_param_no:= w1:= param_no * 2;
am (x2+b61) ; addr:= victim_zb + new_param_no;
dl w0 x1+2 ; w3w0:= dbl_word(addr+2);
; comment dead_bytes - used_bytes.upper part,
; used_bytes ,
; used_bytes.low part - fill_percentage, blocks_in_file;
; ks 102
sn w1 4 ; if used_bytes
rx w3 0 ; ** then return only low part **
se w1 6 ; if new_param_no <> 6 then
jl. a1. ; goto store_param;
\f
; rc 01.10.77 rc4000 code proce ure, connected files page 15.6
;
; extract fill_percentage:
; w0 = fill_percentage,blocks_in_file
; w1 = param_no
; w2 = cf_buf_ref
;
al w3 0 ; move fill_percentage
ld w0 f53 ; to w3
; ks 115
;
a1: rl. w2 (j32.) ; store_param:
rs w3 x2 ; addr:= work_2_p;
; word(addr):= param_value;
; (dead_bytes, used_bytes or fill_percent)
; ks 121
;
am 1 ; result_ok:
a2: al w0 0 ; result_not_ok:
; ks 122
jl. (c0.) ; goto return;
;
c0: 0 ; save return
c1: 100 ;
i.
e. ; end block get_param;
\f
; rc 01.10.77 rc4000 code procedure, connected files page 15.7
;
;
; subroutine set_param
;
; the routine is called from the parameter-administration
; in set_param_cf (segment 16)
;
; the routine inserts a new fill_percentage in the zonebuffer of a
; listfile. the fill_percentage is
; given in work_2_p. work_1_p contains the param_no which must
; be = 3.
;
; call return
; w0: undef result (1 = ok, 0 = not_ok)
; w1: undef undef
; w2: cf_buf_ref undef
; w3: return_address undef
;
b. a5, c5 ; begin block set_param
w.
d48: d49=k-f4 ; set_param:
rs. w3 c0. ; save return;
rl. w0 (j31.) ; param_no:= work_1_p;
; ks 151
se w0 3 ; if param_no <> 3 then
jl. a0. ; goto result_not_ok;
;
rl. w1 (j32.) ; fill_percentage:= work_2_p;
; ks 152
sl w1 1 ; if fill_percentage < 1 or
sl w1 101 ; fill_percentage > 100 then
jl. a0. ; goto result_not_ok;
;
al w0 f5 ; put-block-table;
hs w0 (x2+b62) ;
rl w2 x2+b61 ; pointer to block_table
rl w0 x2+8 ; old fill_percentage , blocks_in_file
la. w0 c1. ; remove -
ls w1 24-f53 ; position new -
lo w0 2 ; merge with blocks_in_file
rs w0 x2+8 ;
; ks 164
;
am 1 ; result_ok:
a0: al w0 0 ; result_not_ok:
; ks 171
jl. (c0.) ; goto return;
;
c0: 0 ; save return
c1: f51 ; mask for blocks_in_file
i.
e. ; end block set_param;
\f
; rc 05.01.72 rc4000 code procedure, connected files page 15.8
;
;
; subroutine call-alarmproc.
;
; the subroutine is called from alarm on segment 1, it will call the
; user procedure specified in formal-jump-proc-zb.
; the return from the user procedure is directed directly to alarm.
;
; call
; w0 relative return on segment 1
; w1 undef
; w2 undef
; w3 undef
;
b. a5, c5 ; begin call-alarmproc
w.
d52: d53=k-j0 ;
al w1 -22 ;
jl. w3 (j103.) ; rs reserve(22 bytes)
;
dl. w3 (j130.) ; w2:= rs saved stackref
rs w2 x1 ; store it in stacktop
;
rl. w3 j1. ; segm.tbl.addr. of segm.1
ds w0 x1+4 ; store segm.tbl.addr. and rel.return
;
al w0 22-6 ; store appetite
hs w0 x1+4 ;
;
rl. w3 c0. ; formal 1.1:= zone formal.1
rl w0 x2+8 ; formal 1.2:= old formal 1.2:= z
ds w0 x1+8 ;
;
al w3 26 ; formal 2.1:= integer kind
al w0 x1+19 ; formal 2.2:= literal-1
ds w0 x1+12 ;
;
al w0 x1+21 ; formal 3.1:= integer kind
ds w0 x1+16 ; formal 3.2:= literal-2
;
rl. w3 (j33.) ; literal-1:= - procno-p
ac w3 x3 ;
rl. w0 (j36.) ; literal-2:= alarmno-p
ds w0 x1+21 ;
;
rl w2 x2+6 ; w2:= cf-buf-ref:= old formal 1.1
dl w1 x2+b4+2 ; w0w1:= formals-jump-proc-zb
jl. (j105.) ; rs goto point
;
c0: 6<12 + 23 ; zone formal.1
i.
e. ; end call-alarmproc
\f
; rc 05.01.72 rc4000 code procedure, connected files page 15.9
;
g3=k-j0
c. g3-506
m. code on segment 15 too long
z.
c. 502-g3
0, r. 252-g3>1 ; zero fill
z.
<:cf-system15:>
i.
e.
m. end segment 15
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.1
;
; this segment contains the cf-procedures:
; set_jumps_cf
; get_param_cf
; set_param_cf
; and the subroutine:
; change_bit
;
b. g20, j150 ; code segment 16:
f0=f0+1 ; increase segment count
k=f4
h.
j0: g1, g2 ; headword: last_point, last_absword
j1: 1<11 o.(:1-f0:), 0 ; segment 1
j2: 1<11 o.(:2-f0:), 0 ; - 2
j5: 1<11 o.(:5-f0:), 0 ; - 5
j15: 1<11 o.(:15-f0:),0 ; - 15
j31: 0 , 21 ; work_1_p
j32: 0 , 23 ; work_2_p
j33: 0 , 25 ; cf_proc_no
j103: f1+ 3, 0 ; rs-entry 3, reserve
j104: f1+ 4, 0 ; - 4, take_expression
j108: f1+ 8, 0 ; - 8, end_address_expression
j112: f1+12, 0 ; - 12, uv
j113: f1+13, 0 ; - 13, last_used
j130: f1+30, 0 ; - 30, saved_stack_ref, saved_w3
g2 = k-2-j0 ; relative of last abs-word
g1 = k-2-j0 ; - - - point
w.
;
;
;
; work_1_p and work_2_p are used for storing param-pairs:
; content in cf-proc: set_jumps get_param set_param
;
; work_1_p: procno paramno paramno
; work_2_p: results value-addr value
;
;
; obs. the segment does only contain room enough for
; 30 of the 44 ks-instructions.
;
;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.2
;
;
;
; procedure set_jumps_cf(z, jump_proc)
; one or more pairs:(cf_proc_no, results);
; procedure get_param_cf(z) one or more pairs:(paramno, val);
; procedure set_param_cf(z) one or more pairs:(paramno, val);
;
; zone z;
; procedure jump_proc;
; integer cf_procno, results, paramno, val;
;
; the procedures are placed in one block, as they have a common
; entry-administration get_parameter_pair, but the very getting and
; setting of parameter-values by get-/set-param-cf in a listfile
; is placed at segment 15.
;
;
; set_jumps_cf:
; makes the procedure jump_proc be called at exit from a cf_proce-
; dure with the number cf_proc_no, when result_cf equals one of the
; digits in results.
;
; get_param_cf:
; yields the values of the specified parameters from the zonebuffer
; of an opened cf-file
;
; set_param_cf:
; inserts the values for the specified parameters into the zonebuffer
; of an opened cf-file;
;
;
b. a20 ; begin block common administration
w.
e8=f0-1 ; set_jumps_cf:
e9=k-f4 ;
am -30+4 ; procno:= 4;
;
e60=f0-1 ; get_param_cf:
e61=k-f4 ;
am -31+30 ; procno:= 30;
;
e62=f0-1 ; set_param_cf:
e63=k-f4 ;
al w1 31 ; procno:= 31;
al w0 f39+f49 ; statebits:= all_cf_states;
rl. w3 (j2.) ; call prepare;
jl w3 x3+d1 ; at return w2 = stackref+6 = cf_buf_ref
; w3 = stackref
; ks 1
rl w0 x2+b15 ;
sz w0 1 ; if file_type_zb = 1 (list_file)
jl. a2. ; or procno = 4 then
rl. w1 (j33.) ; goto check_params;
sn w1 4 ;
jl. a2. ;
;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.3
;
; set up stack_picture for call of get_params_i or set_params_i.
; the first five words are set up by call_file_i, the last are moved
; from the original stack;
;
; find new appetite, i.e. the size of the stack without litterals, as
; these are not moved to the new stack.
; the registers are used as follows:
; w0 = param-kind (formal.1)
; w1 = param-addr (formal.2)
; w2 = addr. of formal-pair + 1
; w3 = stack-ref
; and w3+6 = cf-buf-ref
; w3+8 = formal-limit
;
al w0 x3+6+3 ; formal-limit:= w0:=
ba w0 x3+4 ; stack-ref + 6 + appetite + 3;
rs w0 x3+8 ;
al w2 x3+14 ; addr:= w2:= addr of formal-2.2 + 2;
; ks 11
a0: ; next-param:
dl w1 x2-2 ; w0w1:= formal-pair;
; ks 12
so w0 16 ; if -,expression then
jl. a1. ; begin comment perhaps literal, but in
; any case an address in the stack;
sh w1 (x3+8) ; if param-addr <= formal-limit then
rs w1 x3+8 ; formal-limit:= param-addr;
; end;
a1: al w2 x2+4 ; addr:= addr + 4;
; ks 13
sh w2 (x3+8) ; if addr < formal-limit then
jl. a0. ; goto next-param;
; ks 14
ws w2 6 ; w2:= addr - stack-ref;
ac w1 x2-4 ; reservation-size:= w1:= -(w2 - 4);
al w0 x2-14 ; move-size:= w0:= w2 - 14;
; ks 15
jl. w3 (j103.) ; reserve (reservation-size) bytes;
al w1 x1+9 ; base-2:= work-2-p:= new-stack-top + 9;
rs. w1 (j32.) ;
; ks 16
dl. w2 (j130.) ; w1:= old-stack-ref;
rl w2 x1+6 ; w2:= cf-buf-ref;
al w1 x1+9 ; base-1:= w1:= old-stack-top + 9;
; ks 17
rl. w3 (j5.) ; call move_word;
jl w3 x3+d9 ;
;
rl. w1 (j33.) ; w1:= (cf_proc_no - 18) * 4;
al w1 x1-18 ; comment file_i_procno shift 2;
ls w1 2 ;
rl. w0 j0. ;
rl. w3 (j2.) ; call_file_i(get_/set_params_i);
jl w3 x3+d37 ;
;
; at return from get_params_i or set_params_i, the procedure-value is
; stored in the uv-register. if the value <> 0, the file_i_proc found
; an parameter-error, and the cf_procedure will call alarm.
;
rl. w2 (j112.) ; w2:= uv;
; ks 18
se w2 0 ; if result <> 0 then
jl. a8. ; goto exit_i
jl. (j108.) ; else goto end-addr-expression;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.4
;
; check_params:
;
; here the parameter_list for set_jumps_cf or set_/get_param_cf for a
; list_file is checked. the registers are used as follows:
; w0 = working reg.
; w1 = formal_limit
; w2 = stack_ref
; w3 = param_address
;
a2: rx w2 6 ; w2:= stack_ref; w3:= cf_buf_ref;
al w1 x2+7 ; formal_limit:= formal_1.2:=
ba w1 x2+4 ; stack_ref + appetite(stack_ref) + 7;
rs w1 x2+8 ;
; ks 21
sh w1 x2+13 ; if formal_limit <= stack_ref + 13 then
jl. g7. ; goto exit_zero; comment too few params;
rl. w0 (j33.) ;
; ks 22
sn w0 4 ; if cf_proc_no <> 4 then
jl. a3. ; begin
al w3 x2+14 ; param_addr:= w3:= addr.of formal_2.1;
; ks 23
jl. a5. ; goto first_pair;
; end
; else
a3: dl w1 x2+12 ; begin comment check jump_proc_parameter;
sz w0 2.11111 ; w0w1:= formal_2;
jl. g7. ; if kind(w0) <> procedure then
ls w0 -4 ; goto exit_zero; comment no proc;
; ks 25
sh w0 x3 ; if stack_ref(w0) < cf_buf_ref then
jl. g7. ; goto exit_zero; comment scope-error;
rl w0 x2+10 ;
ds w1 x3+b4+2 ; formal_pair_zb:= formal_2;
al w3 x2+18 ; param_addr:= w3:= addr.of formal_3.1;
; ks 26
jl. a5. ; goto first_pair;
; end;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.5
;
; get_parameter_pair:
; checks the next pair of parameters and switches to the proper action
; get_param, set_param or set_jumps
;
g4: rl. w2 (j113.) ; next_param_pair:
rl w3 x2+10 ; w2:= stack_ref;
; ks 31
am 2 ; param_addr:= w3:= saved_param_addr + 2;
a4: al w3 x3+3 ; second_param: param_addr:= param_addr + 3;
; ks 32
a5: sl w3 (x2+8) ; first_pair:
jl. g5. ; if param_addr >= formal_limit then
; goto exit_normal;
dl w1 x3-1 ; w0w1:= formal_x.1,x.2;
rs w3 x2+10 ; save param_addr in formal_2.1;
al w3 2.11111 ;
la w3 0 ;
; ks 33
sn w3 10 ; if param_kind(w0) <> integer expr then
jl. a6. ; begin
; ks 34
se w3 26 ; if param_kind(w0) <> integer_variable
jl. g6. ; then goto exit_n;
sh w1 (x2+8) ; if param_addr(w1) < formal_limit then
rs w1 x2+8 ; formal_limit:= param_addr(w1);
; ks 35
jl. a7. ; end
; else
a6: jl. w3 (j104.) ; take_expression and
ds. w3 (j130.) ; save_stack_ref;
; ks 36
;
a7: rl w3 x2+10 ; w3:= param_addr;
rl w0 x1 ; formal_2(param_addr):= w0:= value(addr);
rs w0 x3-1 ;
; ks 37
so w3 1 ; if param_addr even then
jl. a4. ; goto second_param;
;
rl w3 x3-5 ; work_1_p:= w3:= value(first_param);
ds. w0 (j32.) ; work_2_p:= w0:= value(second_param);
; w1 = addr (second_param);
; ks 38
rl w2 x2+6 ; w2:= cf_buf_ref;
rl. w0 (j33.) ;
; ks 39
sn w0 4 ; if cf_proc_no = 4 then
jl. g8. ; goto set_jumps
rl. w3 (j15.) ; else
sn w0 30 ; if cf_proc_no =30 then
jl w3 x3+d47 ; goto get_param
jl w3 x3+d49 ; else goto set_param;
;
; return from get_param or set_param:
se w0 0 ; if result_ok then
jl. g4. ; goto next_param_pair else
jl. g6. ; goto exit_n;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.6
;
; exits:
;
g5: ; exit_normal:
so w3 1 ;
jl. (j108.) ; if param_addr even then goto end_addr_expr;
; comment result ok;
g6: rl. w2 (j113.) ; exit_n: (error at param-pair no n)
rl w3 x2+10 ; w2:= stack_ref; w3:= param_addr;
ws w3 4 ; w2:= param_pair_no:=
al w2 x3-6 ; (param_addr - stack_ref - 6) // 8;
ls w2 -3 ;
jl. a9. ; goto alarm_38;
a8: sn w2 -1 ; exit_i: if error_no = -1 then
g7: al w2 0 ; exit_zero: error_no:= 0;
a9: al w1 38 ; alarm_38:
rl. w3 (j1.) ; alarm_no:= 38;
jl w3 x3+d35 ; call alarm;
;
i.
e. ; end common administration;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.7
;
; set_jumps:
; insert testbits in jumpspec-words in the zonebuffer.
; the actual parameter-pair is stored in g12, g13:
; g12 = procno (first parameter)
; g13 = results (second param), each resultno is one decimal digit.
; cf_buf_ref is taken from formal_1.1 (at entry w2 = stack_ref).
;
b. a20, c20 ; begin block set_jumps
w.
g8: rl. w1 (j32.) ; set_jumps:
sh w1 -1 ; result:= w1:= second_parameter;
jl. g6. ; if result < 0 then goto exit_n;
rs. w2 c0. ; store cf_buf_ref;
; next_setbit:
a0: al w0 0 ; setbit:= w0:= result mod 10; (last digit)
wd. w1 c1. ; result:= result // 10;
ds. w1 c6. ; save setbit and new result;
rl. w3 (j31.) ; procno:= w3:= first_parameter;
; ks 103
sh w3 0 ;
al w3 30 ; if procno <= 0 then procno:= max_procno;
; ks 104
rs. w3 c3. ; save new_procno;
;
; load segment 2 into the core and add the segm.table-address to
; procno, so that the testshift-value-table can be addressed directly.
;
rl. w3 (j2.) ; w3:= segm_tbl_addr(segm_2);
rl w2 x3+d39 ; now the testshift-table will stay in core
; as long as segm.alloc. is not changed.
; ks 105
wa. w3 c3. ; w3:= segm_tbl_addr + procno
;
; find the relevant testshift_word for actual procno and setbit.
; the registers are used as follows:
; w0 = setbit
; w1 = addr. of testshift-word in zonebuffer
; w2 = working reg. and bitno
; w3 = procno + segm_tbl_addr(segm_2)
;
a1: bl w2 x3+d39 ; find_test_shift_word:
rs. w2 c2. ; save last_bitno for procno;
bs w2 x3+d39-1 ; w2:= no_of_results for procno;
; ks 112
se w2 0 ; if no_of_results = 0 or
sl w0 x2+1 ; setbit > no_of_results then
jl. a5. ; goto next_proc;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.8
;
;
;
rl. w1 c0. ; find addr.of testshift_word:
bl w2 x3+d39-1 ; w1:= cf_buf_ref;
wa w2 0 ; bitno:= w2:=
; ks 113
sh w2 23 ; testshift_value(procno) + setbit;
jl. a2. ; comment 7 <= bitno <= 59;
sl w2 48 ;
am 2 ; w1:= addr_of_testshift_word:=
am 2 ; cf_buf_ref + b3 +
a2: al w1 x1+b3 ; (if bitno >= 48 then 4 else
; if bitno >= 24 then 2 else 0);
; ks 114
;
sn w0 0 ; if setbit <> 0 then goto set_testbit
jl. a3. ; else goto clear_testbits;
;
; set_testbit:
; snapshot: w1 = addr.of relevant testshift-word
; w2 = bitno for setbit
;
al w0 1 ; bitmode:= 1;
; ks 121
jl. w3 g11. ; call change_bit (set_mode);
jl. a5. ; goto next_proc;
;
; clear_testbits:
; snapshot: w0 = 0 (setbit)
; w1 = addr.of relevant testshift-word
; w2 = bitno before first bit to be removed
; w3 = c4 = procno + segm_tbl_addr(segm_2)
;
a3: al w2 x2+1 ; clear_next:
; ks 131
se w2 24 ; bitno:= bitno + 1;
sn w2 48 ; if bitno = 24 or bitno = 48 then
al w1 x1+2 ; addr_of_testshift_word:= next_addr;
; ks 132
jl. w3 g11. ; call change_bit (clear_mode);
sl. w2 (c2.) ; if bitno < last_bitno then
jl. a5. ; goto clear_next else
jl. a3. ; goto next_proc;
;
; next_proc:
;
a5: rl. w3 c3. ; w3:= procno;
al w3 x3-1 ; procno:= procno - 1;
; ks 141
am. (j31.) ;
sh w3 (0) ; if procno <= procparam then
jl. a6. ; goto next_result;
rs. w3 c3. ; save procno;
wa. w3 (j2.) ; modified_procno:= procno + segm_tbl_addr;
rl. w0 c5. ; w0:= setbit;
jl. a1. ; goto find_testshift_word;
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.9
;
; next_result:
;
a6: rl. w1 c6. ;
; ks 151
se w1 0 ; if result <> 0 then
jl. a0. ; goto next_setbit;
;
; set or clear bit 0 in first testshift_word, to indicate if any test-
; shifts at all.
;
am. (c0.) ; w1:= addr_of_1.testshift_word;
al w1 b3 ;
al w2 0 ; bitno:= 0;
dl. w0 (j32.) ; w3w0:= first_param, sec_param;
; ks 161
sn w0 0 ;
se w3 0 ; if first_param <> 0 or sec_param <> 0
al w0 1 ; then call change_bit (set_mode)
; ks 162
jl. w3 g11. ; else call change_bit (clear_mode);
;
; ks 163
jl. g4. ; goto next_param_pair;
;
; local constants:
;
c0: 0 ; save cf_buf_ref
c1: 10 ; divisor:= 10;
c2: 0 ; save last_bitno for procno
c3: 0 ; save procno
c5: 0 ; save setbit
c6: 0 ; save result
i.
e. ; end block set_jumps
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.10
;
; subroutine change_bit;
; the routine inserts or removes a bit in one of the 3 testshift-
; words in the zonebuffer. bitno is a number in the interval 0-71,
; which depicts a bit in testshiftword 1 (bitno < 24), 2 or 3.
; if bitmode = 1 a 1-bit will be inserted at this place, otherwise
; a zero will be inserted.
;
; call return
; w0: bitmode undef
; w1: addr_of_testshift_word addr_of_testshift_word
; w2: bitno bitno
; w3: return_addr undef
;
b. a5, c5 ; begin block change_bit
w.
g11: rs. w3 c0. ; save return;
; ks 201
ac w3 x2 ; w3:= reduc_bitno:=
sh w3 -48 ; - (bitno mod 24);
al w3 x3+48 ;
sh w3 -24 ;
al w3 x3+24 ;
; ks 202
se w0 1 ; if bitmode = 1 then goto set_one
jl. a1. ; else goto set_zero;
;
; set_one:
ls w0 x3+23 ; testbit:= 1 shift (reduc_bitno + 23);
; ks 203
lo w0 x1 ; testshift_word:=
; ks 204
rs w0 x1 ; testshift_word add testbit;
jl. (c0.) ; goto return;
;
a1: rs. w3 c2. ; set_zero:
; ks 211
dl. w0 c1. ; c2:= reduc_bitno;
; ks 212
am. (c2.) ; testbit:= mask shift (reduc_bitno + 23);
ld w0 23 ; comment 11...101...11;
; ks 213
la w3 x1 ; testshift_word:=
; ks 214
rs w3 x1 ; testshift_word minus testbit;
jl. (c0.) ; goto return;
;
c0: 0 ; save return_address
-2 ; mask for clear testbit, first word
c1: -1 ; - - - - , sec. -
c2: 0 ; save reduc_bitno
i.
e. ; end change_bit
\f
; rc 01.11.71 rc4000 code procedure, connected files page 16.11
;
;
g3=k-j0
c. g3-506
m. code on segment 16 too long
z.
c. 502-g3
0,r. 252-g3>1
z.
<:cf-system16:>
m. segment 16
i.
e.
\f
; rc 06.12.74 rc4000 code procedure, connected files page tails.1
\f
; rc 06.12.74 rc4000 code procedure, connected files page t.1
i. ;
e. ; end slang segment
;
; tails to be inserted in catalog
g0: ; first tail:
; result_cf ; result_cf becomes the area entry in cat.
f0 ; no of segments
0,r.4 ; dummy
27 ; address: byte 27 permanent core
9<18, 0 ; integer variable
4<12+f2 ; rel start of external list
f0<12+f3 ; code segments, bytes in permanent core
; rec_no_cf
1<23+4, 0,r.4
11
9<18, 0 ; integer variable
4<12+f2, f0<12+f3
; init_file_m
1<23+4
0,r.4
1<23+e4<12+e5
1<18+14<12+14<6+19 ; procedure(zone, string, intaddr,
9<18+8<12 ; realval, realval)
4<12+f2, f0<12+f3
; open_cf
1<23+4
0,r.4
1<23+e6<12+e7 ; rel segm, rel entry
1<18+19<12+9<6+8,0 ; procedure(zone,string,intaddr)
4<12+f2
f0<12+f3
; set_jumps_cf
1<23+4, 0,r.4
1<23+e8<12+e9
1<18+39<12+31<6+8,0 ; procedure(zone,procedure,general)
4<12+f2, f0<12+f3 ;
; init_chain
1<23+4, 0,r.4
1<23+e10<12+e11
1<18+20<12+19<6+8 ; procedure(zone,zone,intaddr,realaddr)
8<18
4<12+f2, f0<12+f3
; close_cf
1<23+4, 0,r.4
1<23+e12<12+e13
1<18+12<12+8<6, 0 ; procedure(zone,boolean)
4<12+f2, f0<12+f3
; get_m
1<23+4, 0,r.4
1<23+e16<12+e17
1<18+26<12+8<6, 0 ; procedure(zone, real array)
4<12+f2, f0<12+f3
; get_l
1<23+4, 0,r.4
1<23+e18<12+e19
1<18+19<12+20<6+8,0 ; procedure(zone,realaddr,intaddr)
4<12+f2, f0<12+f3
; get_head
1<23+4, 0,r.4
1<23+e20<12+e21
1<18+26<12+20<6+8,0 ; procedure(zone,realaddr,real array)
4<12+f2, f0<12+f3
; insert_m
1<23+4, 0,r.4
1<23+e22<12+e23
1<18+26<12+8<6, 0 ; procedure(zone, real array)
4<12+f2, f0<12+f3
; insert_l
1<23+4, 0,r.4
1<23+e24<12+e25
1<18+26<12+19<6+20 ; procedure(zone,realaddr,intaddr,real array)
8<18
4<12+f2, f0<12+f3
; connect
1<23+4, 0,r.4
1<23+e26<12+e27
1<18+19<12+20<6+20 ; procedure(zone,realaddr,realaddr,intaddr)
8<18
4<12+f2, f0<12+f3
; delete_m
1<23+4, 0,r.4
1<23+e28<12+e29 ;
1<18+8<12, 0 ; procedure(zone)
4<12+f2, f0<12+f3
; delete_l
1<23+4, 0,r.4
1<23+e30<12+e31
1<18+20<12+8<6, 0 ; procedure(zone,realaddr)
4<12+f2, f0<12+f3
; delete_chain
1<23+4, 0,r.4
1<23+e32<12+e33
1<18+20<12+8<6, 0 ; procedure(zone,realaddr)
4<12+f2, f0<12+f3
; next_m
1<23+4, 0,r.4
1<23+e34<12+e35
1<18+8<12, 0 ; procedure(zone)
4<12+f2, f0<12+f3
; put_cf
1<23+4, 0,r.4
1<23+e36<12+e37
1<18+8<12, 0 ; procedure(zone)
4<12+f2, f0<12+f3
; read_only_cf
1<23+4, 0,r.4
1<23+e38<12+e39
1<18+8<12, 0 ; procedure(zone)
4<12+f2, f0<12+f3
; read_upd_cf
1<23+4, 0,r.4
1<23+e40<12+e41
1<18+8<12, 0 ; procedure(zone)
4<12+f2, f0<12+f3
; update_all_cf
1<23+4, 0,r.4
1<23+e42<12+e43
1<18+8<12, 0 ; procedure(zone)
4<12+f2, f0<12+f3
; get_numb_l
1<23+4, 0,r.4
1<23+e46<12+e47
1<18+19<12+8<6, 0 ; procedure(zone,intaddr)
4<12+f2, f0<12+f3
; init_rec_m
1<23+4, 0,r.4
1<23+e56<12+e57
1<18+26<12+8<6, 0 ; procedure(zone,real array)
4<12+f2, f0<12+f3
; get_param_cf
1<23+4, 0,r.4
1<23+e60<12+e61
1<18+39<12+8<6, 0 ; procedure(zone,general)
4<12+f2, f0<12+f3
; set_param_cf
g1: 1<23+4, 0,r.4 ; last tail:
1<23+e62<12+e63
1<18+39<12+8<6, 0 ; procedure(zone,general)
4<12+f2, f0<12+f3
m. rc 10.9.71 cf-system
▶EOF◀