|
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: 18432 (0x4800)
Types: TextFile
Names: »headp3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »headp3tx «
; ta-okh 23.01.1973 headpunch, page 1
; the program is translated like:
; (headpunch=slang text
; headpunch)
b. g4 w. ; for insertproc
s. a200,c60,d100,f50
w.
d.
p.<:fpnames:>
l.
k=h55
d0: 0 ; current command
d1: 0 ; program name
; connect outputfile
ds. w3 d1. ; save command and program name
jl. w3 h29.-4 ; stack current input
dl. w3 d1.
al w2 x2+2 ; w2:=left side
se w3 x2-2 ; if left side then
jl. c15. ; alarm(call)
al. w2 a13. ; w2:=<:tpn:>
al w0 1<1+1
jl. w3 h28. ; connect output to current input zone
se w0 0 ; if error then
jl. c31. ; goto c31
c10: al. w2 a10. ; start: textpunch(<: :>)
jl. w3 f2.
; get and output jobname
rl. w3 d1. ;
bl w0 x3+10 ;
sl w0 4 ; if parameters in the call
jl. c40. ; then goto treat parameters;
rl. w2 h16.
al w2 x2+2 ; w2:=address of jobname
jl. w3 f2. ; textpunch(jobname)
al. w2 a10.
jl. w3 f2. ; textpunch(<: :>)
al w2 10
jl. w3 h26.-2 ; outchar(out,<nl>)
rl. w2 h16.
al w0 x2+2
jl. w3 h31.-2 ; outtext(out,jobname)
al. w0 a10.
jl. w3 h31.-2 ; outtext(out,<: :>)
\f
; fgs 1987.03.13 headpunch, page 2
; compute clock and date
c20: jd 1<11+36 ; w0w1:=time (unit 0.1 ms)
wd. w1 a0. ; four_minutes:=time//(60*10000*4)
; <*four to avoid integer exception*>
al w0 0
wd. w1 a1. ; w1:=hours w0:=four_minutes
ls w0 2 ; w0 := minutes;
jl. w2 f50. ; minutes:=decimal(minutes)
ls w3 -8 ; >8
wa. w3 a180. ; add <:.:>;
rs. w3 d55.
al w0 0
wd. w1 a2. ; w1:=days w0:=hours
jl. w2 f50.
ls w3 -8 ; hours :=
wa. w3 a10. ; decimal (hours) add <: :>;
rs. w3 d54.
ad w1 26 ; compute year and date
wa. w0 a3. ; w0:=year:=
al w3 0 ; (day*4+99111)//1461
wd. w0 a4.
as w3 -2 ; day:=((day*4+99111)
wm. w3 a5. ; mod 1461)//4
al w3 x3+461 ; w3:=month:=
wd. w3 a6. ; (day*5+461)//153
al w1 x2+5 ; w1:=day:=((day*5+461)mod 153)+5
sh w3 12 ; if month <= 12 then
jl. c25. ; goto c25 else
al w3 x3-12 ; begin month:=month-12;
ba.w0 1 ; year:=year+1 end;
c25: rs. w3 d52. ; save month
jl. w2 f50. ; w3:=decimal(year)
rl. w2 a9.
al w3 x3+46 ; w2w3 := ' 19' add year add '.';
ds. w3 d51.
rl. w0 d52.
jl. w2 f50. ; month:=
al w3 x3+46 ; decimal(month) add /./
rs. w3 d52.
al w0 0
wd. w1 a5. ; date:=day//5
rs w1 0
jl. w2 f50. ; date:=
al w3 x3+32 ; decimal(date) add / /
rs. w3 d53.
\f
; okh 23.01.1973 headpunch, page 3
; output clock and date
al. w1 h20.
al. w2 d50.
jl. w3 f2. ; textpunch(clock and date)
al. w0 d50.
jl. w3 h31.-2 ; outtext(out,clock and date)
c30: al w2 10 ; exit:
jl. w3 h26.-2 ; outchar(out,<nl>)
; terminate zone and exit to fp
al. w1 h20.
al. w2 a12. ;
jl. w3 f2. ; textpunch(<: :>)
jl. w3 h95. ; close up-as it should be
jl. w3 h79.-4 ; terminate zone
al w2 0
jl. w3 h7. ; exit
; error response
c15: am 1 ; error call
c31: al w0 0 ; error connect
rs. w0 d50. ;
al. w0 a14. ; text:=<:<10>***:>
jl. w3 h31.-2 ; outtext(out,text)
rl. w1 d1. ; text:=programname
al w0 x1+2 ;
jl. w3 h31.-2 ; outtext(out,text)
rl. w1 d50. ;
al. w0 a15. ; text:=<: call:>
se w1 0 ;
al. w0 a16. ; text:=<: connect tpn:>
jl. w3 h31.-2 ;
c32: al w2 1
jl. w3 h7. ; exit sorry
\f
; ta 76.05.21 headpunch,page ...4...
; treatment of parameters
c40: rs. w1 d50. ;
rl. w3 d1. ;
rl w1 x3+12 ;
se. w1 (a190.); if first param<>text<:in:> then
jl. c42. ; goto copy param list
rl w1 x3+20 ;
se. w1 (a191.); if sep<>pointtext then
jl. c42. ; goto copy param list
al w3 x3+22 ;
rs. w3 d51. ;
al. w1 d70. ;
jd 1<11+42 ; lookup param
se w0 0 ; if not found then
jl. c42. ; goto copy param list
rl. w0 d70. ;
sh w0 0 ; if kind<>bs then
jl. c42. ; goto copy param list
jl. w3 h29.-4 ; stack current input
rl. w2 d51. ;
jl. w3 h27.-2 ; connect current input to param
se w0 0 ; if hard error then goto
jl. c42. ; copy param list
jl. w3 h22.-2 ; inblock from current in
al. w2 d70. ;
al w2 x2-2 ;
rs. w2 d52. ; d52:-current store base
rl w1 x1 ; w1:=current zone base
c41: al w1 x1+2 ; move loop: increase zone addr
rl. w2 d52. ;
al w2 x2+2 ;
rs. w2 d52. ; increase store addr
al. w3 d70. ;
ws w2 6 ;
sl w2 80 ; if text>90 characters
jl. c48. ; then goto finistext
rl w3 x1 ;
al w2 0 ; 0->127
ld w3 8
sn w2 0
al w2 127
ld w3 8
sz w2 127
se w2 x2
al w2 x2+127
ld w3 8
sz w2 127
se w2 x2
al w2 x2+127
ld w3 -24
rs. w3 (d52.) ; store contents.=zone contents
al w2 0 ;
al w0 -24 ;
ld w3 8 ;
sn w2 25 ; if firstchar=em then
jl. c48. ; goto finistext
sl w2 128 ; if not text then
jl. c48. ; goto finistext
al w2 0 ;
al w0 -16 ;
ld w3 8 ;
sn w2 25 ; if second char=em then
jl. c48. ; goto finistext
sl w2 128 ; if not text then
jl. c48. ; goto finistext
al w2 0
al w0 -8 ;
ld w3 8 ;
sn w2 25 ; if third char=em then
jl. c48. ; goto finistext
sl w2 128 ; if not text then
jl. c48. ; goto finistext
jl. c41. ; goto moveloop
\f
; fgs 1987.03.13 headpunch, page 5
c48: ; finistext:
jl. w3 h30.-4 ; unstack current in
rl. w3 (d52.) ;
ls w3 (0) ;
ac w0 (0) ;
ls w3 (0) ;
rs. w3 (d52.) ; replace em by null
rl. w1 d50. ;
al. w2 d70. ;
jl. w3 f2. ; textpunch(zone,text)
al. w0 d70. ;
jl. w3 h31.-2 ; outtext(out,text)
jl. c30. ; goto exit
; copy param list
c42: rl. w2 d1. ; next param:
ba w2 x2+1 ; w2:=param pointer
rs. w2 d1. ; w2:=w2+length of param
bl w3 x2 ; d1:=addr next param
sh w3 3 ; if sep=end then
jl. c30. ; goto exit;
sn w3 4 ;
am 2 ;
al. w2 a180. ;
rs. w2 d52. ; d52:=text equal to sep
rl. w1 d50. ; w1:=zone descr
jl. w3 f2. ; textpunch(zone,sep)
rl. w0 d52. ;
jl. w3 h31.-2 ; outtext(out,sep)
rl. w2 d1. ;
bl w0 x2+1 ;
sn w0 4 ;if number param then
jl. c43. ; goto printnumber
al w2 x2+2 ;
rs. w2 d52. ; w2:=d52:=addr textparam
rl. w1 d50. ;
jl. w3 f2. ; textpunch(zone,text)
rl. w0 d52. ;
jl. w3 h31.-2 ; outtext(out,text)
jl. c42. ; goto next param
c43: rl w0 x2+2 ; printnumber:
rs. w0 d52. ; number:=param
jl. w3 h32.-2 ; outinteger(out,number)
32<12+1 ;
rl. w1 d52. ;
al. w2 a182. ; w2:=addr text<:0:>
sn w1 0 ; if number=0 then
jl. c49. ; goto punchinteger
rl. w1 a181. ; div:=1000000
rs. w1 d53. ;
al w1 0 ; textno:=0
rs. w1 d54. ; text(1):=0
rs. w1 d55. ; text(2):=0
rs. w1 d56. ; text(3):=0
al w2 -8 ; shift:=-8
\f
; ta 26.09.73 headpunch, page 6
c44: rl. w0 d52. ; repeat:
al w3 0 ;
wd. w0 d53. ;
rs. w3 d52. ; number:=number mod div
sn w0 0 ; if cif<>0 then
jl. c45. ; begin
sn w2 -8 ; if shift=-8 then
al w2 0 ; shift:=0
c45: sn w2 -8 ; end;
jl. c47. ; if shift<>-8 then
al w2 x2+8 ; begin
sn w2 32 ; shift:=shift+8
al w2 8 ; if shift=32 then shift:=8
sn w2 8 ; if shift=8 then
al w1 x1+2 ; textno:=textno+1
rl. w3 x1+d53.; w3:=text(textno)
sh w0 9 ; if cif>9 then
jl. c46. ; begin
ws. w0 a7. ; cif:=cif-10
al w2 16 ; shift:=16
al w3 49 ; text(1):=1
c46: ls w0 16 ; end;
wa. w0 a182. ; cif:=textcif
ld w0 8 ; text(textno):=text(textno)
rs. w3 x1+d53.; shift 8 add textcif
c47: al w3 0 ; end;
rl. w0 d53. ;
wd. w0 a7. ;
rs. w0 d53. ; div:=div//10
se w0 0 ; if div<>0 then
jl. c44. ; goto repeat
ac w2 x2-24 ; shift:=24-shift
rl. w3 x1+d53.; text(textno):=text(textno)
ls w3 x2 ; shift shift
rs. w3 x1+d53.;
al. w2 d54. ;
c49: rl. w1 d50. ; punchinteger:
jl. w3 f2. ; textpunch(zone,integertext)
jl. c42. ; goto next param
\f
; fgs 1987.03.13 headpunch, page 7
; table of constants
a0: 600000*4
a1: 60/4
a2: 24
a3: 99111 ; correction for 1.1.1968 being time base
a4: 1461 ; days in four years
a5: 5
a6: 153 ; days in the five months march-july
a7: 10
a8: 48<16+48<8 ; <:00:>
a9: 32<16+49<8+57 ; <: 19:>
a91: 32<8+32 ; <:<0> :>
a10: <: <0>:>
a12: <: <0>:>
a13: <:tpn:>,0,0,0
a14: <:<10>***:>
a15: <: call<10><0>:>
a16: <: connect tpn<10>:>
a177: 8.177
a180:<:.:>
<: :>
a181:1000000 ; div
a182:48<16 ; text<:0:>
a190:<:in:>
a191:8<12+10 ; pointtext
d50: 0 ; save for clock and date
d51: 0
d52: 0
d53: 0
d54: 0
d55: 0
d56: 0
\f
; okh 6.9.1973 headpunch, page 8
; procedure decimal(i)
; converts an integer less than 100 to decimal
; call: w0=integer
; w2=return
; return: w3(0:15)=result w3(16:23)=0
; w1 unchanged
f50: al w3 0
wd.w0 a7. ; w0:=i//10 w3:=i mod 10
ls w0 8
wa w3 0
ls w3 8
wa. w3 a8.
jl x2+0 ; return
; procedure textpunch(string)
; a textstring terminated by a zero character
; is punched by writepunch
; call: w1=zone
; w2=address(string)
; w3=return
; return: w1 unchanged
b. i2,d3
w.
d2: 0, d3: 0
f2: rs. w3 d3.
i0: rs. w2 d2. ; word:
al w0 -16 ; shift:=-16
i1: rl. w2 (d2.) ; char:
ls w2 (0)
la. w2 a177. ; w2:=nextchar
sn w2 0 ; if nextchar=0 then
jl. i2. ; return
jl. w3 f0. ; writepunch(nextchar,zone)
rl w2 0
al w0 x2+8 ; shift:=shift+8
sh w0 0 ; if shift<=0 then
jl. i1. ; goto char
rl. w2 d2. ; addr:=addr+1
al w2 x2+2
jl. i0. ; goto word
i2: rl. w3 d3.
jl x3+0 ; return
e.
\f
; okh-ta 30.06.1975 headpunch, page 9
; procedure writepunch(char,zone)
; call: w1=zone
; w2=char
; w3=return
; return: w0,w1 unchanged
; outputs on zone a string of characters
; representing char. the string is found
; in table starting at b32
b. i100,b100,d5
w.
d0: 0
d2: 0
d3: 0
f0: rs. w3 d3.
rs. w0 d0.
sn w2 10 ; if nl then sp
al w2 32
sh w2 31 ; if char <32 then
i0: jl. i1. ; return
sl w2 126 ; if char >125 then
jl. i1. ; return
sl w2 96 ; if char >95 then
al w2 x2-32 ; char:=char-32
rs. w2 d2.
se w2 73 ; if char<>73 then
jl. i77. ; goto i77
al. w0 b73. ; firstaddr:=b73
am 2
al. w2 b73. ; lastaddr:=firstaddr+2
jl. w3 f1. ; out(firstaddr,lastaddr,z)
jl. i1. ; return
i77:se w2 77 ; i77: if char<>77 then
jl. i87. ; goto i87
am 2
al. w2 b77. ; lastaddr:=b77+2; goto i2
jl. i2.
i87:se w2 87 ; i87: if char <>87 then
jl. i3. ; goto tabelopslag
am 2
al. w2 b87. ; lastaddr:=b87+2
i2: al w0 x2-2 ; firstaddr:=lastaddr-2
jl. w3 f1. ; out(firstaddr,lastaddr,zone)
i3: rl. w2 d2. ; tabelopslag:
al w2 x2-32 ; char:=char-32
al w3 9
wm w3 4 ; w3:=9*char
al. w0 x3+b32.; firstaddr:=b32+9*char
am 8
al. w2 x3+b32. ; lastaddr:=b32+9*char+8
jl. w3 f1. ; out(firstaddr,lastaddr,z)
i1: rl.w0 d0.
rl. w3 d3.
jl x3+0 ; return
\f
; okh 6.9.1973 headpunch, page 10
h.
b73: 255,255,0 ; special action for i,
b77: 255,255,96 ; m and
b87: 240,252,15 ; w
; space
b32:0,0,0,0
0,0,0,0
0
; !
0,0,0,251
251,0,0,0
0
; "
0,224,224,0
224,224,0,0
0
; pound #
36,36,255,36
36,255,36,36
0
; dollar $
50,74,255,74
74,255,74,68
0
; %
227,166,228,8
24,55,101,199
0
; &
206,177,113,9
2,4,10,1
0
; '
0,0,32,96
192,128,0,0
0
; (
0,255,255,129
129,129,129,0
0
; )
0,129,129,129
129,255,255,0
0
; *
8,74,44,24
24,44,74,8
0
; +
24,24,24,254
254,24,24,24
0
; ,
0,0,56,57
58,60,0,0
0
; -
24,24,24,24
24,24,24,24
0
\f
; okh 6.9.1973 headpunch, page 11
; .
0,0,7,7
7,7,0,0
0
; /
3,6,4,8
24,48,96,192
0
; 0
60,126,129,129
129,129,126,60
0
; 1
0,1,17,33
127,255,1,1
0
; 2
3,71,193,129
129,137,249,113
0
; 3
2,67,193,129
129,137,255,118
0
; 4
8,24,56,104
200,255,255,8
0
; 5
248,249,137,145
145,145,143,134
0
; 6
62,127,201,137
137,137,143,6
0
; 7
128,128,128,135
159,248,224,0
0
; 8
118,255,137,137
137,137,255,118
0
; 9
112,249,137,137
137,139,254,124
0
; :
0,0,119,119
119,0,0,0
0
; ;
0,0,236,237
238,0,0,0
0
; <
0,8,24,52
102,195,129,0
0
\f
; okh 6.9.1973 headpunch, page 12
; =
102,102,102,102
102,102,102,102
0
; >
0,129,195,102
52,24,8,0
0
; ?
0,96,240,131
139,248,112,0
0
; snabela @
28,34,93,85
93,69,61,2
0
; a
127,255,136,136
136,136,255,127
0
; b
255,255,137,137
137,137,255,118
0
; c
126,255,129,129
129,129,195,66
0
; d
255,255,129,129
129,129,255,126
0
; e
255,255,137,137
137,137,129,129
0
; f
255,255,136,136
136,136,128,128
0
; g
126,255,129,129
137,137,207,78
0
; h
255,255,8,8
8,8,255,255
0
; i
0,0,0,0
0,0,0,0
0
; j
2,3,1,1
1,1,255,254
0
; k
255,255,8,24
52,102,195,129
0
\f
; okh 6.9.1973 headpunch, page 13
; l
255,255,1,1
1,1,1,1
0
; m
48,24,8,24
48,96,255,255
0
; n
255,255,96,48
24,8,255,255
0
; o
126,255,129,129
129,129,255,126
0
; p
255,255,136,136
136,136,248,112
0
; q
126,255,129,133
135,131,255,126
0
; r
255,255,136,136
140,142,251,113
0
; s
112,249,137,137
137,137,143,6
0
; t
128,128,128,255
255,128,128,128
0
; u
254,255,1,1
1,1,255,254
0
; v
224,120,28,7
7,28,120,224
0
; w
3,14,28,14
3,15,252,240
0
; x
195,102,52,24
24,52,102,195
0
; y
192,96,48,31
31,48,96,192
0
; z
131,135,133,137
153,177,225,193
0
\f
; okh 6.9.1973 headpunch, page 14
; æ
127,255,136,136
255,255,137,137
0
; ø
126,255,133,137
153,177,255,126
0
; å
31,63,228,164
164,228,63,31
0
; ^
128,128,128,128
128,128,128,128
128
; _
1,1,1,1
1,1,1,1
1
e.
; procedure out(firstaddr,lastaddr,zone)
; call: w0=firstaddr
; w1=zone
; w2=lastaddr
; w3=return
; return: w1 unchanged
; outputs on zone char in firstaddr-lastaddr
; stored with one character /byte
b. d3,i10
w. d2: 0, d3: 0
f1: ds. w3 d3. ; save return and lastaddr
i0: rl w2 0 ; next: w2:=firstaddr
al w0 x2+1 ; firstaddr:=firstaddr+1
bz w2 x2+0 ; w2:=byte
jl. w3 h26. ; output byte on zone
sh. w0 (d2.) ; if firstaddr<=lastaddr
jl. i0. ; then goto next
rl. w3 d3.
jl x3+0 ; return
e.
d70: ; store for lookup and moved text
m.rc, headpunch 1987.03.13
g2=k-h55 ; length
g0:g1: (:g2+511:)>9 ; segm
0, r.4
s2 ;
0,0 ; file, block
2<12+4 ; contents, entry
g2 ; length
d.
p.<:insertproc:>
l.
e.,e.
▶EOF◀