|
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: 37632 (0x9300)
Types: TextFile
Names: »move4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »move4tx «
b. g1,f6 ;begin block insertproc
w.
d.
p.<:fpnames:> ;begin block fpnames
l.
s. a40, c33, e45, g20, i27, b3
w.
k=h55
0 , 0 ; not used
;entry move
;get output entry
;
rs. w1 c1. ;save fp-start
b. i0 ;begin output file
w. ;check
sn w2 x3 ;if no leftside then
jl. a11. ;outerror (move call)
ba w3 x3+1 ;update parameter pointer
rs. w3 c2. ;save parameter pointer
al. w1 c3. ;get output tail address
al w3 x2+2 ;get name address
rs. w3 c15. ;save name address
jd 1<11+42 ;look up entry
se w0 0 ;if unknown then
jl. i0. ;c5=2
rl. w0 c3. ;
sl w0 0 ;if mto-file then
jl. i0. ;c5=0 else
la. w0 c29. ;mask mode off
se. w0 (c14.) ;if bs file then
jl. a14. ;c5=2 else
al w0 0 ;outerror(output kind)
se w0 0 ;
i0:al w0 2 ;
rs. w0 c5.
e. ;end output file check
;c15 contains the address of the
;output file name in the fp-command stack
;check of input parameters : checks an indivisible group of
;separators and parameters to see if they describes a bs-file,
;mt-file, mt-file-set or message.yes. at excit the parameter
;pointer points at the separator starting the next indivisible
;group unless this is a <nl> in case of which the end
;param. c26:= 1.
b. i30
w.
al w1 1 ;initial check for message.yes
rl. w3 c2. ;get param. pointer
i14:bl w0 x3 ;get separator
sh w0 2 ;if separator = <nl> then
jl. a4. ;goto next parameter: else
ba w0 x3+1 ;if separator = <point>
se w0 18 ;and parameter = <name> then goto check name:
jl. i19. ;else goto check for blocklength;
rl w0 x3-8 ;if last name <> <:mes:>
se. w0 (i16.) ;then
jl. a10. ;param error else
rl w0 x3+2 ;check name: get <name>
sn. w0 (i10.) ;if <name> = <yes> then
rs. w1 c23. ;c23:= 1
al w1 20 ; message.yes_or_no:=true
hs w1 x3-9 ;
jl. i15. ;goto update pointer;
i19:se w0 12 ;if separator=point and param=integer then
jl. i15. ;begin <*check for block.<integer>*>
rl w0 x3-8 ;
se. w0 (i17.) ; if last name <> <:blo:> then
jl. a10. ; goto paramerror;
rl w1 x3+2 ;
sh w1 0 ; if blocklength <= 0 then
al w1 1 ; blocklength := 1;
sl w1 85 ; if blocklength >= 85 then
al w1 84 ; blocklength := 84;
ls w1 9 ; maxbll for mt=move bs :=
al w1 x1+2 ; blocklength * 512 +
rs. w1 c27. ; 2;
al w1 14 ; hide integer parameter;
hs w1 x3-9 ;
jl. i15. ; goto update pointer;
;end;
i15:ba w3 x3+1 ;update pointer: point at next
jl. i14. ;pair (separator, parameter)
;end initial check for message.yes
a4:rl. w3 c2. ;next parameter: get param. pointer
bl w0 x3 ;get first separator
se w0 4 ;if first separator <> <s>
jl. a10. ;outerror (parameter error)
bl w0 x3+1 ;get first item
se w0 20 ; if message.yes_or_no=true then
jl. i21. ; begin
al w0 10 ; set item=name
hs w0 x3+1 ; update param.pointer
al w3 x3+10 ; update w2
al w2 1 ; goto message
jl. i0. ; end comment this sequence avoid
i21:se w0 14 ; if blocklength.<integer> then
jl. i4. ; begin
al w0 10 ; reset length;
hs w0 x3+1 ; update param. pointer;
al w3 x3+10 ; goto blocklength;
jl. i20. ; end;
;lookup of message
i4:se w0 10 ;if first item<><name>
jl. a10. ;then outerror (param. error)
al w3 x3+2 ;get address of name
rs. w3 c18. ;save address of name
al. w1 c4. ;get address of entry tail
jd 1<11+42 ;look up entry
rl w2 x1 ;if kind <> bs then
sl w2 0 ; begin
jl. i18. ; if kind <> 18 then
la. w2 c31. ; outerror (input kind)
sn w2 4 ; kind bs but no area
jl. i18. ;
se w2 18 ; end
jl. a15. ;
i18:al w3 x3+8 ;update param. pointer
al w2 1 ;w2:=1
se w0 0 ;if entry name unknown
jl. i0. ;then outerror connect input
ba w0 x3 ;if next separator = point
ba w0 x3+1 ;and next parameter = <name>
sn w0 18 ;then
jl. i0. ;goto message:
hs. w2 c23. ;else bytec23:=1
rl w0 x1 ;get first word of entry tail
bl w1 x3 ;get second separator
sh w1 2 ;if second separator=<nl>
rs. w2 c26. ;then end param.=1
sl w0 0 ;if w0>=0 then
jl. i13. ;goto bs-file
la. w0 c31. ;kind := modekind extract 12;
sh w0 4 ;if kind = 4 then
jl. i13. ;goto bs-file;
rl. w0 c5. ;else
ls w0 -1 ;set c5 bit 23 = 0
ls w0 1 ;and
rs. w0 c5. ;goto
jl. i1. ; mt-file
i13:rl. w0 c26. ;bs-file:
sn w0 1 ;if end param. <> 1
jl. i2. ;and second separator <> <s>
sn w1 4 ;then
jl. i2. ;goto mt-set: else
jl. a10. ;outerror (param. error)
i2:al w0 1 ;mt-set:
lo. w0 c5. ;set c5
rs. w0 c5. ;bit 23 = 1
i3:al w0 0 ;
rs. w0 c8. ;c8:=0
rs. w2 c7. ;c7:=1
rs. w3 c2. ;save param. pointer
jl. a0. ;goto initialize zone
i1:rl. w0 c26. ;mt-file:
sn w0 1 ;if end param.=1
jl. i3. ;or second separator=<s>
sn w1 4 ;then goto i3
jl. i3. ;else
se w1 8 ;if second separator <> point
jl. a10. ;then outerror (param. error)
bl w1 x3+1 ;if second item <> <integer>
se w1 4 ;then
jl. a10. ;outerror (param. error)
rl w1 x3+2 ;else
rs. w1 c7. ;c7:=second item
rl. w1 c5. ; if output fil bs
sn w1 2 ; then set mtfilset true
rs. w2 c33. ;
ba w3 x3+1 ;update param. pointer
bl w1 x3 ;get third separator
se w1 8 ;if third separator <> point
jl. i6. ;then goto i6
bl w1 x3+1 ;get third item
se w1 4 ;if third item <> <integer>
jl. a10. ;then outerror (param. error)
rl w1 x3+2 ;get third item
rs. w1 c8. ;c8:=third item
ba w3 x3+1 ;update param. pointer
bl w1 x3 ;get the fourth separator
se w1 4 ;if the fourth item=<s>
jl. i5. ;then save param. pointer
rs. w3 c2. ;and goto
jl. a0. ;initialize zone
i5:sl w1 3 ;else if fourth separator <> <nl>
jl. a10. ;outerror (too many parameters)
rs. w2 c26. ;else end param.=1
rs. w3 c2. ;save param. pointer
jl. a0. ;goto initialize zone
i6:sh w1 2 ;if third separator <> <nl>
jl. i7. ;or third separator <> <s>
se w1 4 ;then
jl. a10. ;outerror (param. error)
jl. i8. ;if third separator = <nl>
i7:rs. w2 c26. ;end param.=1
i8:al w1 0 ;
rs. w1 c8. ;c8:=0
rs. w3 c2. ;save param. pointer
jl. a0. ;goto initialize zone
i0:bl w0 x3 ;message: if second separator <> point
se w0 8 ;then
jl. a10. ;outerror (param. error )
rl w0 x3+2 ;
sn. w0 (i9.) ;if second item=<yes>
jl. i11. ;then
rs. w2 c23. ;message.yes else
se. w0 (i10.) ;message.no or
jl. a10. ;outerror ( param. error )
i11:ba w3 x3+1 ;update param. pointer
bl w0 x3 ;get third separator
sn w0 4 ;if third separator = <nl>
jl. i12. ;then end param.=1
rs. w2 c26. ;
sl w0 3 ;if third separator<> <nl>
;and third separator <> <s>
jl. a10. ;outerror (param. error)
jl. a19. ;goto write out output file
i20:bl w0 x3 ;blocklength:
se w0 8 ;if second separator<>point then
jl. a10. ; goto paramerror;
jl. i11. ;goto update param.pointer;
i12:rs. w3 c2. ;save param. pointer
hl. w0 c23. ;if bytec23=1 then
se w0 1 ;goto next parameter
jl. a4. ;else
jl. a0. ;goto initialize zone
i9 : <:no:>
i10: <:yes:>
i16: <:mes:>
i17: <:blo:>
e. ;end of input parameter check.
; output file current input file c5
; bs file bs file 3
; bs file mt file 2
; mt file bs file 1
; mt file mt file 0
;if message.yes then byte c23+1 = 1
;if next separator = <nl> then end param. = 1
;c18: name address of current input file
;block procedure input zone
;handles word defect
; w0 : address of answer area
; w1 : - - zone descriptor
; w2 : - - share -
; w3 : logical status word
b. b10 ;
w. ;
a34: sz w3 1 ;if status.hard error then
jl. h68. ; goto fp give up;
zl w3 x2+6 ;
se w3 3 ;if share.operation <> input then
jl. h36. ; goto fp check;
zl w3 x1+h1+1 ;
se w3 18 ;if zone.kind <> 18 then
jl. h36. ; goto fp check;
rl w3 0 ;
rl w0 x3+4 ;
al w3 0 ;
wd. w0 b4. ;
sn w3 0 ;if answer.chars xferred mod 3 = 0 then
jl. h36. ; goto fp check;
se w3 1 ;mask :=
am 2 ; if chars xferred mod 3 = 1 then 8.700
rl. w0 b5. ; else 8.770
rl w3 x2+22 ;
al w3 x3-2 ;
la w0 x3 ;word (share.top xferred - 2) :=
rs w0 x3 ; word (share.top xferred - 2) logical and mask;
jl. h36. ;goto fp check;
b4: 3 ;constant 3
b5: 8.77600000 ; mask
b6: 8.77777400 ; mask
e.
;allocate buffers and initialize descriptors
b. i10
w.
a0:rl. w2 c25. ;initialize zone: if number
se w2 0 ;of files
jl. i1. ;transferred > 0
;then goto initialize move
rl. w2 c15. ;maxbll :=
al w2 x2-3 ;((fp command stack top - 2 -
ac. w1 e20. ; (base buffer area addr + 1))
wa w1 4 ;
al w0 0 ;
wd. w1 c6. ; // 3)
ls w1 -2 ; // 4
ls w1 2 ; * 4;
sh w1 511 ;if max. blocklength<512 then
jl. a17. ;outerror (no core)
al w1 x1+2 ;maxbll := maxbll + 2;
rs. w1 c11. ;save max. blocklength
;initialize zones and shares
al. w3 e20. ;
rs. w3 e1. ;base buffer area input
rs. w3 e11. ;base buffer area output
al w2 x2-1 ;
rs. w2 e2. ;last of buffer input
rs. w2 e12. ;last of buffer output
;input
al. w2 e21.
rs. w2 e3. ;used share=first share
rs. w2 e4. ;first share=e21
al. w2 e22. ;
rs. w2 e5. ;last share=e22
;output
al. w2 e23. ;
rs. w2 e13. ;used share=first share
rs. w2 e14. ;first share=e23
al. w2 e24. ;
rs. w2 e15. ;
;input
rl. w2 a28. ;
rs. w2 e6. ;set give up mask (word defect)
al. w2 a34. ;
rs. w2 e7. ;set give up action (handle word defect)
al w2 0 ;
;output
rs. w2 e16. ;give up mask:=0
rs. w2 e17. ;give up action:=0
;initialize move
i1: rl. w0 c9. ;input file count:=
wa. w0 c8. ;input file count +
rs. w0 c9. ;rel file
;insert first shared
a24:al. w1 e20. ;
ba. w1 1 ;
rs. w1 a1. ;a1:e20+1
rs. w1 e25. ;e25:e20+1 input shared 1
rs. w1 e29. ;e29:e20+1 output shared 1
wa. w1 c11. ;
al w1 x1-2 ;
rs. w1 a2. ;a2:e20+1+maxbll.-2
rs. w1 e27. ;e27:(a2) input shared 2
wa. w1 c11. ;
al w1 x1-2 ;
rs. w1 a3. ;a3:e20+1+2*maxbll.-4
rs. w1 e31. ;e31:(a2) output shared 2
;connect files
;connect input
al. w1 e0. ;get address of input zone
al. w2 c4. ;w2:= if input file mt
rl. w0 c5. ;then tail address
sz w0 1 ;else name address
rl. w2 c18. ;
jl. w3 h27. ;call connect input
se w0 0 ;if no success then
jl. a13. ;outerror (connect input)
;connect output
al. w1 e10. ;get address of output zone
al. w2 c3. ;w2:= if output file mt
rl. w0 c5. ;then tail address
sz w0 2 ;else name address
rl. w2 c15.
al w0 1<2+0 ;connect one temporary segment
jl. w3 h28. ;call connect output
se w0 0 ;if no success then
jl. a12. ;outerror (connect output)
; c5 = 3 = 11 : bs = move bs
; 2 1. : bs = move mt
; 1 .1 : mt = move bs
; 0 .. : mt = move mt
;set last shared if c5=0 or c5=2, input mt
rl. w0 c5.
sz w0 1 ;if input file = bs file
jl. i0. ;then goto i0
rl. w1 c11. ;get maxbll.
rl. w2 c28. ;get maxbll of magtape
sl w1 x2 ;if maxbll>=maxbll of magtape then
rs. w2 c11. ; maxbll=maxbll of magtape
i10:rl. w1 a1. ;set last shared: get first shared
wa. w1 c11. ;add maxbll
al w1 x1-4 ;
rs. w1 b1. ;b1:(a2+maxbll-4)
rs. w1 e26. ;(b1) input last shared 1
rs. w1 e30. ;(b1) output last shared 1
rs. w1 e42. ;set last address of transfer
rs. w1 e44. ;in first input and output share
rl. w1 a2. ;
wa. w1 c11. ;
al w1 x1-4 ;
rs. w1 b2. ;b2:(a2+maxbll-4)
rs. w1 e28. ;(b2) input last shared 2
rs. w1 e43. ;set last address of transfer in last input share
rl. w1 a3. ;
wa. w1 c11. ;
al w1 x1-4 ;
rs. w1 b3. ;b3:(a3+maxbll.-4)
rs. w1 e32. ;(b2) output last shared 2
rs. w1 e45. ;set last address of transfer in last output share
jl. a6. ;goto move loop
;set last shared if c5=1 or c5=3, input bs
i0:sz w0 2 ;if output bs then
jl. i5. ; goto input bs, output bs
;input bs, output mt:
; rl. w1 e26. ;get last input shared 1
; rs. w1 b1. ;save last input shared 1
; rl. w1 e28. ;get last input shared 2
; rs. w1 b2. ;save last input shared 2
; rl. w1 a3. ;get first shared 3
; al w1 x1+510 ;add 510
; rs. w1 b3. ;save last shared 3
; jl. a6. ;goto move loop
rl. w1 c27. ;blocklength := blocklength for mt=move bs
sl. w1 (c28.) ;if blocklength >= maxbll for magtape then
rl. w1 c28. ; blocklength := maxbll for magtape;
rs. w1 c11. ;
jl. i5. ;goto set last shared if input bs
i5:rl. w1 c11. ;maxbll :=
ls w1 -9 ; (maxbll //
ls w1 9 ; 512)*512+
al w1 x1+2 ; 2;
rs. w1 c11. ;
jl. i10. ;goto set last share;
e.
;move loop: this block copy from input file to output file
; by repeated call of inblock and outblock.
; a call of inblock gives us a used input share
; which points at one of three possible buffer areas.
; the move block computes a checksum of the words
; transferred from input file to this buffer area.
; if the buffer area exceeds the size of the input
; block the remaining part is filled with zeroes before
; outblock is called. if both input and output file are
; on mag. tape the outblocklength is equal to the inblock-
; length i.e. no fill with zeroes. when the current input
; file is exhausted the routine jumps to terminate zone
; which checks the last pending output transfer.
b. i15
w.
a6:al w0 0 ;move loop: set number of
rs. w0 a5. ;bytes transferred to zero
rs. w0 a7. ;set checksum to zero
i0:al. w1 e0. ;call inblock: get address of zone
jl. w3 h22. ;call inblock
am. (e3.) ;get
rl w2 +22 ;top transferred
am. (e3.) ;subtract first address
ws w2 +8 ;of transfer
rs. w2 a29. ;save input blocklength
sn w2 0 ;if blocklength equal
jl. i0. ;zero goto call inblock
se w2 2 ;if blocklength=2 and
jl. i1. ;word=<em> then
rl. w1 (e8.) ;if i0=2 goto terminate zone:
se. w1 (i7. ) ;else i1=1 goto last outblock
jl. i1. ;
jl. i8. ;goto terminate zone
i1:rl. w0 c23. ;if message.no
so w0 1 ;then
jl. a27. ;goto fill zeroes
wa. w2 a5. ;number of bytes transferred :=
rs. w2 a5. ;number of bytes transf. + blocklength
rl. w1 e0. ;get address of first word transferred
ba. w1 1 ;
am. (e3.) ;get address of
rl w2 +22 ;last word transferred
al w2 x2-2 ;to used share
rs. w2 i6. ;nonsens total: save address of last word transferred
al w2 0 ;w2:=0
al w1 x1+2 ;w1:=w1+2
i2:wa w2 x1-2 ;w2:=w2+word(x1-2)
wa w2 x1 ;w2:=w2+word(x1)
al w1 x1+4 ;w1:=w1+4 update index reg.
sh. w1 (i6.) ;if index reg.<=address of last byte
jl. i2. ;goto i7
al w1 x1-4 ;w1:=w1-4
rl. w3 i6. ;get address of last word transferred
se w1 x3 ;if index reg.<add. of last word then
wa w2 x3 ;w2:=w2+last word
wa. w2 a7. ;
rs. w2 a7. ;save checksum
;fill with zeroes
a27:am. (e3.) ;set used output share: get first and last
dl w2 +10 ;address of transfer from used input share
am. (e13.) ;store these in first and last address of
ds w2 +10 ;transfer in used output share
al w2 0 ;
rl. w0 c5. ;
se w0 2 ;if bs=move mt then
jl. i9. ;begin
rl. w3 a29. ; get inblocklength
al w3 x3-1 ;
ls w3 -9 ; divide by 512
al w3 x3+1 ; add one
wm. w3 c10. ; multiply by 512; w3 contain outblocklength
se w2 0 ; if blocklength > 2**23 then
jl. a17. ; outerror (no core)
sl. w3 (c11.) ; if blocklength > maxbll. then
jl. a17. ; outerror (no core)
al w3 x3-2 ; last address of mess in used output share :=
am. (e3.) ; first address of mess in used input share +
wa w3 +8 ; outblocklength -
am. (e13.) ; 2
rs w3 +10 ; goto get first and last shared
jl. i12. ;end;
i9:se w0 1 ;if mt=move bs then
jl. i10. ;begin
am. (e3.) ;
rl w3 +22 ; last address of mess in used output share :=
al w3 x3-2 ; top transferred in used input share -
am. (e13.) ; 2;
rs w3 +10 ; comment outblocklength := actually transferred input
jl. i12. ;end;
i10:se w0 3 ;if mt=move mt
sn w0 0 ;or bs=move bs then
jl. i11. ;
jl. i12. ;
i11:rl. w3 a29. ;begin
al w3 x3-2 ; last address of mess in used output share :=
am. (e3.) ; first address of mess in used input share +
wa w3 +8 ; inblocklength - 2
am. (e13.) ; comment outblocklength := inblocklength
rs w3 +10 ;end
i12:am. (e3.) ;get first and last shared
dl w2 +4 ;from used input share
am. (e13.) ;store these in first and last
ds w2 +4 ;shared in used output share
am. (e3.) ;
rl w3 +22 ;w3=input top transf -2
al w3 x3-2 ;
am. (e13.) ;
rl w2 +10 ;w2=last address of transf from output
sl w3 x2 ;
jl. i5. ;if w3>=w2 then goto call outblock
al w0 0 ;
al w1 0 ;
i3:al w3 x3+4 ;
sh w3 x2 ;
jl. i4. ;
rs w1 x2 ;
jl. i5. ;
i4:ds w1 x3 ;
jl. i3. ;
i5:al. w1 e10. ;call outblock: get address of zone
jl. w3 h23. ;call outblock
am. (e13.) ;set used input share: get first and last
dl w2 +4 ;shared in used output share and
am. (e3.) ;store these in
ds w2 +4 ;first and last shared plus first
am. (e3.) ;and last address of transfer
ds w2 +10 ;in used input share
jl. i0. ;goto call inblock:
i8:al. w1 e0. ;terminate zone:get address of input zone
jl. w3 h79. ;call terminate
al. w1 e10. ;get address of output zone
jl. w3 h79. ;call terminate
jl. a8. ;
i6: 0 ;
i7: <:<25><0><0>:> ;
e.
;compute checksum and bytes transferred of output file
b. i4
w.
a8:al w0 0 ;reset
hs. w0 c23. ;byte c23
rl. w0 c7. ;no-of-file :=
bs. w0 1 ;no-of-file - 1
rs. w0 c7. ;
rl. w0 a7. ;checksum of output file :=
ls w0 1 ;checksum of output file +
ls w0 -1 ;checksum of last input file
rs. w0 a7. ;
wa. w0 a9. ;
ls w0 1 ;
ls w0 -1 ;
rs. w0 a9. ;
rl. w0 a5. ;bytes transferred to output file :=
wa. w0 a21. ;bytes transferred to output file +
rs. w0 a21. ;bytes transferred from last input file
rl. w0 c25. ;
ba. w0 1 ;
rs. w0 c25. ;c25:=c25+1
rl. w0 c23. ;if message.no
so w0 1 ;then
jl. a22. ;goto prepare next move:
al w2 10 ;write out:
jl. w3 h26.-2 ;outchar <nl>
al. w1 (c18.) ;
dl w3 x1+2 ;write
lo. w2 i2. ;out
lo. w3 i2. ;input
am 2 ;
ds. w3 i3. ;file name
dl w3 x1+6 ;
lo. w2 i2. ;
lo. w3 i2. ;
am 6 ;
ds. w3 i3. ;
al. w0 i3. ;
jl. w3 h31.-2 ;write out input file name
al. w0 i0. ;write out
jl. w3 h31.-2 ;number of bytes transferred
rl. w0 a5. ;write out
jl. w3 h32.-2 ;number of bytes transferred
1<23+32<12+9 ;from current input file
al w2 32 ;
jl. w3 h26.-2 ;outchar <nl>
al. w0 i1. ;write out
jl. w3 h31.-2 ;checksum
rl. w0 a7. ;write out
jl. w3 h32.-2 ;checksum of
1<23+32<12+9 ;current input file
rl. w0 c7. ;get no-of-file
se w0 0 ;if no-of-file <> 0 then
jl. a22. ;goto prepare next move: else
rl. w0 c26. ;if end param. = 0
se w0 1 ;then goto
jl. a22. ;prepare next move: else
a19:rl. w0 c23. ;if
so w0 1 ;message.no
jl. a22. ;then goto prepare next move
al w2 10 ;write out
jl. w3 h26.-2 ;<nl>
al. w1 (c15.) ;
dl w3 x1+2 ;write
lo. w2 i2. ;out
lo. w3 i2. ;output
am 2 ;
ds. w3 i3. ;file name
dl w3 x1+6 ;
lo. w2 i2. ;
lo. w3 i2. ;
am 6 ;
ds. w3 i3. ;
al. w0 i3. ;
jl. w3 h31.-2 ;output file name
al. w0 i0. ;write out
jl. w3 h31.-2 ;number of bytes transferred
rl. w0 a21. ;write out
jl. w3 h32.-2 ;number of bytes transferred
1<23+32<12+9 ;to output file
al w2 32 ;
jl. w3 h26.-2 ;outchar <nl>
al. w0 i1. ;write out
jl. w3 h31.-2 ;checksum
rl. w0 a9. ;write out
jl. w3 h32.-2 ;checksum of
1<23+32<12+9 ;output file
al w2 10 ;
jl. w3 h26.-2 ;outchar <nl>
jl. a22. ;goto prepare next move:
i0: <: number of halfwords transferred:<0>:>
i1: <:,checksum:<0>:>
i2: <: <0>:> ;
i3: 0, r.4 ;
<:<0>:> ;
e.
;prepare next movement in case of mt.
a22:rl. w1 c5. ;prepare next move:
sz w1 2 ;if output=bs then
jl. a25. ;goto change bs-area
al w0 1 ;output file no:=
wa. w0 c13. ;output file no.+1
rs. w0 c13. ;
rl. w0 c7. ;no-of-files:=no-of-files - 1
sh w0 0 ;if number of files = 0 then
am -8 ;check end param. else
jl. 10 ;goto update counter
rl. w0 c26. ;get end param.
se w0 1 ;if end param. <> 1
jl. a4. ;goto next parameter
jl. a23. ;goto end program
al w0 1 ;
wa. w0 c9. ;update count file-no.
rs. w0 c9. ;in input
jl. a24. ;goto insert first shared
;change bs-area-descriptor
a25:rl. w0 c7. ;change bs-area:
sn w0 0 ;if mt-file-set specified as input
jl. a32. ;then set end param=1 and too_many
al w0 0 ;
rs. w0 c7. ;
jl. a33. ;
a32:rl. w0 c26. ;
sz w0 1 ;
jl. a31. ;
a33:al w0 1 ;
rs. w0 c26. ;
rs. w0 c30. ;set too many param true
jl. a19. ;
a31:rl. w0 e37. ;
rs. w0 c3. ;change output length
se w1 3 ;if c5<>3 then goto
jl. a26. ;change entry
al. w1 c3. ;else
al. w2 c4. ;
rl w0 x2+10 ;outputdescriptor :=
rs w0 x1+10 ;inputdescriptor
dl w0 x2+14 ;
ds w0 x1+14 ;
dl w0 x2+18 ;
ds w0 x1+18 ;
a26:rl. w3 c15. ;change entry: (output)
al. w1 c3. ;
jd 1<11+44 ;
se w0 0 ;if no success then
jl. a18. ;outerror (change error)
rl. w3 c33. ;
sn w3 1 ;
jl. a30. ;
rl. w3 c2. ;
ba w3 x3+1 ;
bl w0 x3 ;
ba w0 x3+1 ;
sn w0 18 ;
jl. a23. ;
a30:rl. w2 c30. ;if too_many_param then
se w2 0 ;
jl. a16. ;outerror (too many param)
a23:al w2 0 ;end program:
am. (c1.) ;
jl +h7 ;
;error texts
g10: <:***move param: <0>:>
g11: <:***move call<0>:>
g12: <:***move: connect output<0>:>
g13: <:***move: connect input<0>:>
g14: <:***move: output kind<0>:>
g15: <:***move: input kind<0>:>
g16: <:***move: too many parameters<0>:>
g17: <:***move: no core<0>:>
g18: <:***move: change error<0>:>
;variables
c0: 0 ;address of output blocklength
c1: 0 ;fp-start
c2: 0 ;parameter pointer
c3: 0,r.10 ;output entry tail
c4: 0,r.10 ;input entry tail
c5: 0 ;file mode boolean
c6: 3 ;number of buffers
c7: 0 ;no of files
c8: 0 ;rel file
c9= c4 + 12 ;file number in input descriptor
c10: 512 ;std. blocklength
c11: 0 ;max blocklength
c13= c3 + 12 ;file number in output descriptor
c14: 1<23+18 ;mt-mode-kind
c15: 0 ;output name address
c18: 0 ;input name address
c23: 0 ;if message.yes then byte c23+1=1
c25: 0 ;number of input files
c26: 0 ;end param.
c27: 1<9+2 ;default maxbll of mt=move bs
c28: 84<9+2 ;maxbll of magtape
c29: 1<23+4095 ;
c30: 0 ;too many param when output is bs
c31: 4095 ;input kind mask
c32: 0 ;
c33: 0 ;
;
a3: 0 ;address of first word in buffer area 3
b3: 0 ;address of last word in buffer area 3
a2: 0 ;address of first word in buffer area 2
b2: 0 ;address of last word in buffer area 2
a1: 0 ;address of first word in bufferarea 1
b1: 0 ;address of last word in buffer area 1
a7: 0 ;checksum of current input file
a5: 0 ;bytes transferred from current input file
a9: 0 ;checksum of output file
a21: 0 ;bytes transferred to output file
a28: 1<7 ;give up mask, word defect
a29: 0 ;input blocklength
;outerror (message)
b. i3
w.
a10: am g10-g11 ;move param:
a11: am g11-g12 ;move call:
a12: am g12-g13 ;connect output
a13: am g13-g14 ;connect input
a14: am g14-g15 ;illegal output kind
a15: am g15-g16 ;illegal input kind
a16: am g16-g17 ;too many parameters
a17: am g17-g18 ;no core:
a18: al. w0 g18. ;change error
rs. w0 c32. ;save error entry
al w2 10 ;write(out,<:<10>:>)
am. (c1.) ;
jl w3 h33-2 ;
am. (c1.) ;
jl w3 h31-2 ;write error message:
rl. w0 c32. ;if param error
sn. w0 g10. ; then
jl. i1. ; goto write_out_param
sn. w0 g13. ; else if connect input
jl. i2. ; goto write_out_input_name
sn. w0 g15. ; else if input kind
jl. i2. ; goto write_out_input_name
i0:al w2 10 ; end
am. (c1.) ;
jl w3 h33-2 ;
al w2 1 ;success := false:
am. (c1.) ;
jl +h7 ;
i1:al w2 32 ;write_out_param:
am. (c1.) ; write(out,<:<32>:>)
jl w3 h33-2 ;
al w0 2 ;
wa. w0 c2. ;
am. (c1.) ; write(out,<param>)
jl w3 h31-2 ;
jl. i0. ; goto end
i2:al w2 32 ;write_out_input_name:
am. (c1.) ;
jl w3 h33-2 ; write(out,<:<32>:>,<input name>)
rl. w0 c18. ;
am. (c1.) ;
jl w3 h31-2 ;
jl. i0. ;
e.
;zone and share descriptors
;define input zone
k=k+2
e0=k-h0+h3 ;record base
e1=e0+h0+0 , e2=e0+h0+2 ;base buffer area, last of buffer
e3=e0+h0+4 ;used share
e4=e0+h0+6 , e5=e0+h0+8 ;first share, last share
e6=e0+h2+0 , e7=e0+h2+2 ;give up mask, give up action
e8=e0+h3+2 , e9=e0+h3+4 ;last byte, record length
k=k+h5
;define output zone
e10=k-h0+h3
e11=e10+h0+0 , e12=e10+h0+2 ;base buffer area, last of buffer
e13=e10+h0+4 ;used share
e14=e10+h0+6 , e15=e10+h0+8 ;first share, last share
e37=e10+h1+16
e16=e10+h2+0 , e17=e10+h2+2 ;give up mask , give up action
e18=e10+h3+2 , e19=e10+h3+4 ;last byte, record length
k=k+h5
;share descriptor addresses
e21=k ;input share 1
e22=e21+h6 ;input share 2
e23=e22+h6 ;output share 1
e24=e23+h6 ;output share 2
e25=e21+2 , e26=e21+4 ;first shared, last shared input 1
e27=e22+2 , e28=e22+4 ;first shared, last shared input 2
e29=e23+2 , e30=e23+4 ;first shared, last shared output 1
e31=e24+2 , e32=e24+4 ;first shared, last shared output 2
e33=e21+22 ;top transferred input 1
e34=e22+22 ;top transferred input 2
e35=e23+22 ;top transferred output 1
e36=e24+22 ;top transferred output 2
e20=e24+h6-1 ;base of buffers
e38=e21+4
e39=e22+4
e40=e23+4
e41=e24+4
e42=e21+10
e43=e22+10
e44=e23+10
e45=e24+10
i.
e. ; end slang segment move
m. rc 1989.01.27 fp utility move
f1=k-h55-h5-h5 ;length
f2=4 ;entry
g0:g1:(:f1+511:)>9 ;segm.
0,r.4 ;name
s2 ;date
0,0 ;file,block
2<12+f2 ;contents,entry
f1 ;length
d.
p.<:insertproc:>
e.
▶EOF◀