DataMuseum.dk

Presents historical artifacts from the history of:

RegneCentralen GIER Computer

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RegneCentralen GIER Computer

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦14553a0a2⟧ Bits:30000738 GIER ALGOL III PROC, 8-hole paper tape

    Length: 70290 (0x11292)
    Description: Bits:30000738 GIER ALGOL III PROC
    Types: 8-hole paper tape
    Notes: Gier Text

GIER Text (HTML)

[14.9.65]
[STANDARD PROCEDURES.
Enter a Standard procedure in the identifier list. example :
b k=c60+e70, i=0 ...... _
Body of the standard procedure. The local slipnames a1 and a2 are defined to: a1 = track number of entrypoint (viz. k-e70) a2 = track relative address of entry point
b k=e90, i=0 _
d i=e89 _
qq pass6 controlwordno.9 + a1.19 + a2.29 + pass6 output.39 pass6 marks
t name of standard-procedure; _
d e71=e71+1; count number of standard identifiers _
d e72=e72+L; count number of words used for long standard identifiers _
in pass 2. For a standard identifier of n characters (where caseshifts are counted as characters) L may be calculated as:
L:= if n _ 6 then 0 else n_6; __ < ____ ____ :
This calculation will ensure enough space reservation for long words
d e89 = i; _
e _
d c60 = c60 + number of tracks used for the standard procedure _
e ; end of the standard procedure _
Control of the normal mode output from pass 6 through the control word: f-marked words. Part 4 followed by pars 3 and 2. Not-f-marked words Procedures with one parameter or no parameters: part 4. Procedures with any number of parameters: d23=97 (CDC: 115) followed by parts 3 and 2]
d e71 = 0 ; Number of std. identifiers _
d e72 = 0 ; Number of words in supplementary _
; table (long identifiers)
b k = c60 + e70, i = 10 ; begin block e0 - 16e0 _
d e0 = k - e70 ; e0 = first track for std- procs _
[14.9.65] [write, output, parameter handling and layout unpacking. track e0]
b a50 ; begin block. tracks e0-3e0 _
[write] pm c90 XV ; vy write [output]pm ra X ; pm 1023 ps (c46) , pm s1 ; s:=lastused; M:=layout description gr s1 X MRA ; stack medium pm (c47) DX 3 ; ga s1 , hs c22 ; stack param. counter: arn (c36) , ps (c46) ; layout value a1: hv ra2 , it 1 ; , next parameter ps (c46) , pm c68 ; count last used arn s , ud s ; restore output sum gm 1023 , ud c89 ; restore medium pm s-1 IRC ; move return information gm s MRC ; pm c43 , gm c37 ; UV:=nonsense pm s1 , ud r-11 ; R:=layout; store medium and param. counter a2: pm s2 , it 1 ; M:=next param. description; count param. bt (s1) , hv c51 ; . exit gr s2 , hs c22 ; store layout; ps (c46) , arn(c36) ; . parameter value a : sr c43 , pm 1023 ; -nonsense gm c68 , ud s1 ; store output sum, select medium
hh ra1 LZ ; if value=nonsens then goto next parameter __ ____ ____
arnf(c36) , it p ; value of parameter; pt c83 , pp 256 ; save p . minexp:= -256
pa c85 X 509 ; numberpart:=true; M:=x ____
ga c82 , arn s2 ; exp 2 , layout gr (c36) D ; store picture sr c36 , tk 14 ; unpack layout ga c84 , tk 10 ; b a3h: ck -6 , ga c81 ; return to here for expprinting . h tk 10 , ck -18 ; gt c1 , tk 20 ; f1 ck -6 , ga c80 ; d tk 11 ITA ; TA:=n=1 ck -7 , gr c54 ; bEf2
pp 0 V LZ ; if bE=0 then minexp:=0 __ ____
ca 1 , pp 10 ; if bE=1 then min exp:=-10 __ ____
ca 2 , pp 100 ; if bE=2 then min exp:=-100 __ ____
hs c2 , qq 1e0.29 ; transfer to next track qq ; unused
b k=e90, i=0 ; _
d i=e89 ; _
qq 193.9+e0.19+0.29 ; pass 6 description of write
t write; ; identifier _
qq 193.9+e0.19+1.29 ; pass 6 description of output
t output; ; identifier _
d e71=2e71, e89=i ; count identifiers _
e ; _
[14.9.65] [conversion, exp 10. roundoff., track 1e0] ps (c82) t 10 ; s:=exp2 + 10 ann c53 , pa c2 ; R:=abs(x1); exp10:=H:=0;
a6h: pa c47 , nk r1 ; comment x1 is stored by c2 in c53 _______
ps s_ , gr c37 ; value to be printed=x=x1⨯2∧exp2; 0 |
hv ra12 LZ ; if x1=0 then goto compute b __ ____ ____
pm c37 ; bs s t -1 ; conversion:
mkn ra19 , hh ra4 ; begin comment _____ _______
tk s1 , gr c37 ; by multiplication by
ps s7 , sr ra18 ; 2∧3/10∧1 or 10∧1/2∧4 | | | |
mkn 320 DV LT ; x is converted to form
a4h: hv ra7 , it 1 ; x=x2⨯10∧H where 1.0>x2_.1 | >
qq (c47) t -1 ;
a8: ps s-3 , hh ra6 ; end conversion. x2 is stored in c37 ___
a7: arn c84 , sr c80 ; compute exp10: ga ra10 , sr c81 ; a10:=b-d; R:=b-d-h-1
mb c41 , it (c81) ; L : if H>h then __ ____
bs (c47) , hs ra14 ; begin Hh:=true; goto increxp10 end _____ ____ ____ ___
mt ra8 , it (c47) ; R:=-R; L2: if H<b-d then __ ____
a10: bs _ , hs ra15 ; begin Hh:=false; goto decrexp10 end 0 _____ _____ ____ ___
a11h: arn ra10 , ar c80 ; R:=b-d; L3: R:=R+d a12: ga c82 , ps (c82) ; b1:=R; arn 256 D NT ; rounding:
a13: bs s511 , hh ra16 ; if b1 _0 then __ > ____
xr , mkn ra20 ; R:=.5⨯.1∧b1; |
ps s-1 , hv ra13 ; goto roundx2 ____
a14: bs (c54) , hv ra15 ; increxp10: if bE_0 then goto a15 __ > ____ ____
bs (c85) ; if -,exppart then __ ____
srn (c54) DV 1 ; begin R:=-1; bE:=1 end _____ ___
itn (c47) , pa c81 ; else begin h:=H; R:=0 end ____ _____ ___
a15: sc c2 , bs (c2) ; decrexp10: exp10:=exp10+R
ac c47 , hh s-1 ; if exp10-minexp10>0 then __ ____
ac c2 , arn c47 ; begin H:=H-R; goto if Hh then L else L2 en _____ ____ __ ____ ____ __
d _
a16h: hh ra11 , ar c37 ; exp10:=exp10-R; R:=H; goto L3; round x2: ____
ps -1 ;
hh ra6 LO ; R:=R+x2; if overflow then goto reconversio __ ____ ____
n hs c3 , qq 2e0.29 ; transfer to next track
a18: vy p51 , mln (204) ; comment constants .1-epsilon _______
a19: can s409 , cm (r-410) ; 2∧3/10∧1 | |
a20: vy p51 , mln (s204) ; .1+epsilon [15.10.63] [printing cycles, track 2e0] hs c65 , qq 3e0.29+1 ; call basic print it s7 , pa ra26 ; update addresses for calls to it s4 , pa ra29 ; basic print it s1 , pt ra31 ; gs ra30 , ud c1 ; p:=f1 bs (c82) , hv ra21 ;
grn c53 , arn c80 ; begin x:=0; H:= _____
ca 0 , nt (c85) ; if d=0∧p_2∧-,exppart then __ > ____
bs p-510 , it 1 ; 1 else 0; ____
pa c47 , ar c47 ; b1:=d+H; exp10:=0; R:=0
ga c82 , pan c2 ; end ___
a21: pm c47 X ; M:=R
bs (c47) ; if H>0 then __ ____
sc c81 V ITA ; begin h:=h-H; LT:=false end _____ _____ ___
qq (c81) t -1 LTA ; else if LT then h:=h-1 ____ __ ____
bs p509 , hv ra25 ; if f1<3 then goto print leadingspaces __ ____ ____
a22: arn (c85) D 15 ; print ten and sign:
a23: hs (ra30) LT ; if -,numberpart then print ten __ ____
pp p10 , arn c53 ; p:=p+10; R:=x arn -480 DV NT ; plus arn 32 DV ; minus
bs p500 , ck 10 ; if p<12 then space for plus __ ____
ca p-10 , hh ra24 ; if p=10 ∧ x _ 0 then skip sign __ > ____
a24: hs (ra30) , pp 4 ; else print sign; sign printed:=true ____ ____
a25: bt (c81) t -1 ; print leading spaces: a26: hsn [a46] , hv ra25 ; count h
bs p509 , hv ra22 ; print sign if -, sign printed __
a32: qq 59 , ps r2 ;
hvn (ra26) t -1 LTA ; if TA then print zero before point __ ____
bt (c47) t -1 ; print digits before point: a29: hsn [a44] , hv r-1 ; count H
arn ra32 , bs (c80) ; if d>0 then print point __ ____
a30: hs [a41] , it -1 ; print decimals a31: bt (c80) , hh [a42] ; count d arn c54 , ud c83 ; R:=bEf2; restore p
pa c82 V -2 NZ ; if R=0 then __ ____
hs c2 , qqf e0.29+7 ; transfer to next parameter ga c84 , pm c2 ; b:=bE; M:=exp10 hs c2 , qqf e0.29+29 ; transfer to expprint qq ; unused [14.9.65] [basic print, sqrt, outsp, track 3e0]
a41: bs (c82) , hv ra45 ; if b1>0 output digit else __ ____
a42: hvn ra46 , arn ra50 ; output space a43: it (c47) t 1 ; count H
bs 0 , hvn ra41 ; if H<0 then output 0 __ ____
a44: bt (c82) t -1 ; count b1 mln ra50 , tk 30 ; next digit to R a45: ar 16 D LZ ; Zero instead of space
a46: ga ra48 , bs (ra51) ; if actual case=upper then __ ____
mt c41 , it 510 ; R:=-R;
a51: sy 570 t -510 LT ; if case changed then output case __ ____
bsn p507 , arn c36 ; R:=if -,signprinting then picture e __ ____ _
lse 0 ___
sy 0 LT ; if R<0 then output space __ ____
a48: sy _ , ac c36 ; output; picture:=picture+R 0
hhn s ; goback a50: qq 10.39 ; 10 qq ; unused [sqrt]a47: ps (c46) , pm s1 ; call hs c22 ; parameter arnf(c36) , ps 8 [text] ; RF:= parameter;
hh c55 LT ; if N < 0 then go_to alarm __ ____ __ __
grf c37 , ps (c46) ; x := N
hv c51 LZ ; if N = 0 then exit __ ____
arn c37 , gr c54 ; tk -1 ; exponent(x) := ga c54 , pa ra49 ; entier(exponent(N)/2)
a33: arnf(c36) , dkf c54 ; for i := 1 step 1 until 5 do ___ ____ _____ _
arf c54 X ; x := (N/x + x)/2 sr 1 DX ;
a49: bt _ t -128 ; i:= i + 1; if i>5 then begin 0 __ ____ _____
grf c37 , hv c51 ; UV:= RF; exit end; ___
grf c54 , hv ra33 ; c54:= RF; go to repeat __ __
qq ; unused [outsp] a34: ps (c46) , pm s1 ; take value hs c22 ; of parameter arnf(c36) , tkf -29 ; R:= round(RF); pm c43 , sr c34 ; M:= nonsense; Q: R:= R - 1;
gm c37 V LT ; if R _ 0 then __ > ____
sy 0 , hh r-2 ; begin output space; go_to Q end; _____ __ __ ___
ps (c46) , hv c51 ; UV:= M; exit qq ; unused
d a47=a47-a41, a34=a34-a41 ; relative addresses _
b k=e90, i=0 ; _
d i=e89 ; _
qq 194.9+3e0.19+a47.29+92.39f ; pass 6 description of sqrt
t sqrt; ; identifier _
qq 198.9+3e0.19+a34.29+92.39f ; pass 6 description of outsp
t outsp; ; identifier _
d e71=2e71, e89=i ; count identifiers _
e ; _
e ; end use of a - a50 names _
[14.9.65] [integ exp, abs, entier, sign, outchar, writecr, outcr, track 4e0]
ba20 _
d e77=k-e70,e78=0 [track number and track relative for integerexp] _
[integexp]a:arnf c68 ITA ; sign for exp annf c68 , tkf -29 ; exp to R39 pm c40 , gm c53 ; result:= a14: hv ra12 X NZ ; more bits in exp
arnf c53 V NTA ; if exp < 0 then __ ____
arnf c40 , dkf c53 ; result:= 1/result ps (c46) t 1 ; store exponent part; M:=number part ps s-1 , hv c2 ; exit a12: cln -1 , gm c68 ; take last bit of exponent hh ra13 LZ ; last bit=0 arnf c54 , mkf c53 ; result:=result⨯argument a13: grf c53 , arnfc54 ;
mkf c54 , grf c54 ; argument:=argument ∧ 2 |
arn c68 , hv ra14 ; next bit in exponent [abs] a1: ps ra8 , hh ra4 ; [entier]a2: ps ra5 , hh ra4 ; [sign]a3: ps ra9 , hh ra4 ; [outchar]a4:ps ra11 , is (c46) ; a8: pm s1 , hv c22 ; a10: annf (c36) , grf c37 ; abs a5: ps (c46) , hv c51 ; exit; arnf (c36) , srf c35 ; entier tkf -29 , nkf 39 ; a9: hh ra10 ; arnf (c36) ; sign arnf c41 V LT ; arnf c40 NZ ; a11: hh ra10 ; arnf (c36) , tkf -29 ; outchar: R:= parameter ck -10 , ga r1 ;
sy _ , pm c43 ; punch char: M:= nonsense 0
gm c37 , ca 63 ; UV:= M; if character = <TF> then __ ____
ck -10 , sc 1023 ; outputsum:= outputsum - 63;
hv ra5 ; goto exit; ____
qq ; not used [writecr]a6:pm 1023 , ud c90 ; select typewriter; M:= output sum; sy 64 , ud c89 ; write CAR RET; output sum:= M; gm 1023 ; arn c43 , hv c14 ; S: R:= nonsense; exit
[outcr] a7: sy 64 , hv r-1 ; punch CARRET; go_to S __ __
d a1=a1-a, a2=a2-a, a3=a3-a, a4=a4-a ; relative addresses _
d a6=a6-a, a7=a7-a ; - - _
b k=e90, i=0 ; _
d i=e89 ; _
qq199.9+4e0.19+a1.29+31.39 ; pass 6 description of abs
t abs; ; identifier _
qq197.9+4e0.19+a2.29+33.39 ; pass 6 description of entier
t entier; ; identifier _
qq197.9+4e0.19+a3.29+92.39 f ; pass 6 descripcion of sign
t sign; ; identifier _
qq198.9+4e0.19+a4.29+92.39 f ; pass 6 description of outchar
t outchar; ; identifier _
qq191.9+4e0.19+a6.29+91.39 f ; pass 6 description of writecr
t writecr; ; identifier _
qq191.9+4e0.19+a7.29+110.39 ; pass 6 description of outcr
t outcr; ; identifier _
d e71=6e71, e72=2e72, e89=i ; count identifiers _
e ; _
e ; end use of a - a20 names _
s _
[14.9.65] [Entry to algol from HP. Only relevant when placed on track 25 i.e. c60 defined to 1 on front page]
b a7, b2, d2 ; begin _ _____
d d1 = 80, d2 = d1 -40 ; define buffer 1 and buffer 2; _
b: qq [e84-31c61-1] ; number of tracks to be summened and [1b]qq [init transl track]; init transl track (set by TLA when e96 > 0);
a1: lk (rb1) , pp 40 ; procedure sum; comment from track given by _________ _______
vk (s) t 1 ; vk instruction in cell[s], number of it (rb1) , pt rb2 ; tracks -1 given as address in cell[s+1]. b1: nt d1 , lk d1+d2 ; Track 38 is skipped during summation: is (s) , it s473 ; bs -511 , hv ra3 ;
b2: pp p-1 , ar p__ ; -1
bs p , hv r-1 ; a3: bt (s1) t -1 ; hh ra1 ; ck 0 , hh s1 ; exit; a4: sy 64[CR] , sy 29[RED]; sum error or KC: writecr; write char(<RED>); sy 60[UC] , vk 0 ; hv ra5 LZ ; write text
sy 18[S] , sy 20[U] ; (if R | 0 then |<SUM| __ = ____ < >
sy 36[M] V ;
a5: sy 34[K] , sy 51[C] ; else |<KC|); ____ < >
sy 0[SP] , sy 49[A] ;
sy 35[L] , sy 55[G] ; write text (|< ALGOL|); < >
sy 38[O] , sy 35[L] ; sy 62[blk], lk 0 ; write char(<BLACK>);
vy 17 , ; by:= 17; comment remove HP-lock; _______
vk 0 , hv 33 ; go to basic input on track 0; __ __
a6: hv ra4 NZ ; test sum: if R | 0 ∨ KC then __ = ____
hv ra4 LKC ; go to sum error or KC; __ __
vk (r1b) , lk e25 ; go to initialize translator on track e14; __ __
vk (r1b) , hv e25 ;
d i=b+35 ; define entry point from track 0; _
vk 24c61 , lk rb-40 ; from track 0: restore this track; vk 0 , hsn ra1-40; sum (track 0);
qq _ , mt r ; R:= -R; 0
vk __c__ , hs ra1-40; sum (translator tracks from 31c61 and rest); 31_61
qq (rb-40), hv ra6-40; go to test sum; __ __
e ; end Entry to algol from HP; _ ___
d e0=e0+e96, i=i+e99-40 ; This track is overwritten if e96 = 0 _
[15.10.63 Standard procedures to drum and from drum.
integer procedure to drum(A); _______ _________
array A; _____
integer procedure from drum(A); _______ _________
array A; _____
Function: Array A is written upon the drum by to drum and read from the drum by from drum. The standard integer drum place, which is the address of the first free location on the drum (calculated as drum place=trackno⨯40+trackrel). is assigned a new value. The value of the procedures is the change of drum place, which is -length of array. Succesive calls of to drum will pack the arraya tightly upon the drum. An alarm will be given if drum place takes on a value outside a restricted region. The restricted region is the entire drum, while reading from the drum, and the space between top of standardprocedures and the translated program, while writing upon the drum. During writing upon the drum the hitherto smallest value of drum place is
stored in c93 (MK: c92) as endtrack_2 with unit in position 9. :
The code for to drum and from drum occupies two tracks and contains a normal blockentry, which reserves space for 6 local variables, which are named as follows: Contents of the stack after blockentry: p-6: working location p-5: endrel corresponds to final value of drum place p-4: endtrack - - - - - - p-3: begrel corresponds to initial value of drum place p-2: begtrack - - - - - p-1: value of function = -length of array p : block information p+1: - p+2: - p+3: array identifier p+4: last used before call: Other variables are:
_oolean part ,LZA_true B______ =____
nospace ,LZB_true =____
to drum ,NTA_true =____
integer address ,contents of b8 current address in array _______
fixed place ,contents of b7 buffer address lower limit ,contents of b11 ] [12.10.65] [track 5e0, to drum, from drum, track 1, lyn, char]
b b20 ; _
d b10=6e0, e26=5e0 ; comment to drum is referenced by _ _______
[to drum] ; gierdrum as trackrelative 0;
b9: arn r V ITA ; to drum:= true; go_to entry ____ __ __
[from drum] srn r ITA ; to drum:= false; _____
hs c5 , qq 1016.29+c1-1 ; entry: blockentry(6)locals hh (c84) , ps 12 ; blocklevel:(1); arnf c69 , tkf -29 ; M:=drum place
gr p-1 X IZC ; part:=nospace:=false; _____
dln rb1 , tl 30 ; gr p-2 , gm p-3 ; calculate begtrack and begrel; arn p3 , ga rb4 ; R:=arrayidentifier; arn p-1 ;
b4: sr _ X -1 ITB ; M:= drumplace-length; 0
hh c55 LTB ; if drum place-length < 0 then al __ ____
arm; dln rb1 , tl 30 ; gr p-4 , gm p-5 ; calculate endtrack and endrel;
arn p-2 , ck -1 ; if to drum then __ ____
pm (40c67) DXV NTA ; begin _____
pm e97 DX ; if begtrack _ first track __ >
gm p-1 , ck -1 ; ∨ endtrack < e98
mt r-1 V NTA ; then alarm; ____
sr p-1 , hv rb13 ; if min drum place>endtrack_2 the __ : ___
n _
ar p-1 ; min drum place:=endtrack_2 :
hh c55 NT ; end ___
arn p-4 , ck -1 ; else ____
[23] qq [pm e98 DX] ; if begtrack>top drum __
ck -1 , mt r ; then alarm; ____
gm p-1 , ar p-1 ; hh c55 LT ; it (p-1) , bs (c92) ; arn p-1 , ga c92 ; b13: hh c55 LT ; srn (rb4) ; nkf 39 , grf p-1 ; drum place:= drum place - length ;
hs c2 , qq b10.29 ; goto track b10; ____
b1: qq 40.39 ; qq ; unused qq ; unused
[lyn] b14: lyn c68 V ; R:= input; go_to P; __ __
[char] b15: arn c49 ; R:= character nkf 9 , hv c13 ; P: RF:= R; exit qq ; not used [word 23 is loaded by the translator loading administration]
d b14=b14-b9, b15=b15-b9 ; relative addresses _
b k= e90, i=0 ; _
d i=e89 ; _
qq 147.9+5e0.19 +32.39f ; pass 6 word for to drum
t to drum; ; identifier _
qq 147.9+5e0.19+ 1.29+32.39f ; pass 6 word for from drum
t from drum; ; identifier _
qq 148.9+5e0.19+b14.29+111.39f ; pass 6 word for lyn
t lyn; ; identifier _
qq 148.9+5e0.19+b15.29+ 91.39f ; pass 6 word for char
t char; ; identifier _
qq 146.9+e80.29-e79.29+74.39f, ; pass 6 word for drum place
t drum place; ; _
d e71=5e71, e72=2e72, e89=i ; count identifiers _
e ; _
[15.10.63] [track 6e0, to drum, from drum, track 2] vk (p-2) ; arf c69 , grf c69 ;
ps (c46) , ps s-40 ; if last used-40 < topprogram __
pmn s DX ; then begin fixed place:=c67; ____ _____
ck -1 , sr c93 ; nospace:=true end else ____ ___ ____
psn c67 LT ; fixed place:=last used-40; gs rb7 IZB ; arn p3 , tk 10 ; address:=part2(arrayidentifier)
ga rb8 , arn p-3 ; if begrel=39 then __ ____
ca 39 , hv rb6 ; goto fulltracks; ____
arn p-2 , ca (p-4) ; if begtrack=endtrack then __ ____
hv rb5 ; goto last track; ____
pt rb11 , hs rb ; lower limit:=0; move first part; pa p-3 t 39 ; begrel:=39; b3: vk (p-2) t -1 ; counting: begtrack:=begtrack-1;
b6: ps 0 , arn p-2 ; fulltracks: if begtrack=endtrack __
ca (p-4) , hv rb5 ; then goto last track; ____ ____
sk (rb8) V -40 NTA ; address:=address-40;
lk (rb8) t -40 ; if to drum then write else read; __ ____ ____
b5h: hv rb3 , ps (p-5) ; it s1 , pt rb11 ; lower limit:=endrel+1;
bs s473 , hs rb ; if endrel < 39 then move last part; __ ____
vk c64 , ps p4 ; if nospace∧part then __ ____
lk c67 LZC ; restore running system;
vk c64 , hh c7 ; goto exit function; ____
b: gs rb2 , ps 0 ; procedure move; _________
lk (rb7) , arn rb8 ; read track to fixed place; sr 1 D ;
sr p-3 , ga rb8 ; for s:=begrel step 1 until ___ ____ _____
ps (p-3) , vk (p-2) ; lower limit do __
b12: qq V LTA ; if to drum then __ ____
b8: pm s[address] V IRC ; STACK[fixed place+s]:=STACK[address+s]
b7: pm s[fixed place] VIRC ; else ____
gm (rb7) V MRC ; STACK[address+s]:=STACK[fixed place+s]; gm (rb8) MRC ;
b11: ps s-1 , it _ ; 0
bs s1 , hv rb12 ;
psn 0 IZA ; part:=true; ____
sk (rb7) NTA ; if to drum then write from fixed place; __ ____
b2: ps _ , hv s1 ; return; 0
e ; end use of b - b20 _
[15.10.63] [outtext, writetext, track 7e0] [outtext] arn r9 , hh r1 ; R:= , pm 1023 [write text] arn c90 , tk 10 ; R:= , vy write ck -10 , ps (c46) ; ar (c47) D 1 ; R:=R+ appetite+1 pm c43 , gm c37 ; UV:=nonsense pm s1 , ca 0 ; M:=parameter vk 0 , hv c15 ; exit if no more parameters gr s1 MRA ; stack parameter counting and medium vk 0 , hs c22 ; get parameter ps (c46) , pm 1023 ; gm c68 , ud s1 ; store output sum select medium pmn (c36) X ITA ; value of parameter gt r5 V NT ; long text on drum or nonsense cl 34 , hv r11 ; short text ck -10 , ga r5 ; ck 10 , sr c43 ;
hv r17 LZ ; if parameter = nonsense then go to nex __ ____ __ __
t
vk (r2) , ps _ ; 0
lk c67 , ps s-40 ; get text from drum
vk _ t -1 ; 0
bs s1 , hv r-2 ; arn s40c67 , cl 36 ; next word ar 32 D LA ; ar 16 D LB ; pa r5 , ck -4 ; character counter :=0; ga r3 , ca 10 ; next character vk c64 , hh r5 ; finished ca 63 , it 1 ; test for CR
sy _ , cln -6 ; output character 0
bt _ t -80 ; count characters 0
ps s1 , hv r-10 ; next word hh r-7 , ps (c46) ; next character lk c67 NTA ; restore free track place if used pm c68 , ud s1 ; restore output sum gm 1023 , ud c89 ; restore by arn s1 , pa c47 ; R:=parameter counting and medium pm (c46) IRC ; move gm (c46) t 1 MRC ; return information hh r-36 , ; goto test for more parameters qq ; unused
b k=e90, i=0 ; _
d i=e89 _
qq193.9+7e0.19+ 0.29 ; pass 6 word for outtext
t outtext; ; identifier _
qq193.9+7e0.19+ 1.29 ; pass 6 word for writetext
t writetext; ; identifier _
d e71=2e71, e72=2e72, e89=i ; count identifiers _
e ; _
[15.10.63] [exp, writechar, track 8e0]
b a14 ; _
d e75 = k-e70, e76=0 ; [track no., track relative for exp] _
[exp] a12: ps (c46) , pm s1 ; hs c22 ; annf(c36) , srf ra0 ; R:= abs(x) - 511 ⨯ln(2)
hh ra1 NT ; if abs(x) _ 511 ⨯ ln(2) then go_to large __ > ____ __ __
arnf (c36)X ; take argument ga ra2 , mln ra3 ;
a2: tl _ t 3 ; R9M := x/ln(2) 0
ga ra4 , tl 10 ; y1 := entier(R9M) cl -2 ; sr 128 DX ; M := R - 1/4
gm c37 , mkn c37 ; z := M; R := z∧2 |
pm 384 DX ; R := 0.75; M := z∧2 |
mk ra6 , gr c54 ; p := 3/4⨯(1 + p ⨯ z∧2) |
gr c68 , arn ra7 ; mk ra8 X ;
mkn c37 , sc c68 ; q := p - 3/4⨯(a⨯z + c ⨯ z∧3) |
ar c54 X ; mln ra5 , dl c68 ; R := p/q/sqrt(2)
a4: nkf 0 t 1 ; RF := R⨯2∧(y1+1) |
a9: grf c37 , ps (c46) ; UV := exp(x) a1: hv c51 , arfn(c36) ; return; large:
hvn ra10 X LT ; if R<0 then begin exp:=0; go_to exit end; __ ____ _____ __ __ ___
ps 9 , hh c55 ; if R>0 then go_to alarm __ ____ __ __
f ; _
a0: 354.1982 ; 511 ⨯ ln(2)
m ; _
a3: qq 5.3+12.7+5.11+5.15+1.19+13.23+9.27+4.31+10.35+14.39 ; log base2(e)/2 a7: 0.519 860 384 45 ; 3/4⨯a a6: 0.144 099 511 28 ; 3/4⨯b a8: 0.016 626 103 230 ; 3/4⨯c a5: 0.707 106 781 1865 ; sqrt(2)/2 qq ; not used qq ; not used [writechar] a11: ps (c46) , pm s1 ; call hs c22 ; parameter arnf(c36) , tkf -29 ; R:= round(parameter) pm 1023 , ud c90 ; save output sum; select typewriter ck -10 , ga r1 ;
sy _ , ud c89 ; type char; select punch 0
gm 1023 , pm c43 ; restore output sum; M:= nonsense a10: gm c37 ; set UV: UV:= M; ps (c46) , hv c51 ; exit
d a11=a11-a12 ; relative address _
b k=e90, i=0 ; _
d i=e89 ; _
qq 194.9+e75.19+92.39f ; pass 6 word for exp
t exp; ; identifier _
qq 198.9+8e0.19+a11.29+92.39f ; pass 6 word for writechar
t writechar; ; identifier _
d e71=2e71, e72=1e72, e89=i ; count identifiers _
e ; _
e ; end a - a14 names _
[15.10.63] [outcopy, writecopy, input track 1, 9e0] [outcopy] ps (c46) , pm s1 ; hs c22 ; get parameter;
arn r , hv r7 ; tryk bool:=true; ____
[writecopy] ps (c46) , pm s1 ; hs c22 ; get parameter pm 1023 , ud c90 ; save output sum; select write gm c68 , arn c89 ; ck 10 , ga r1 ; select
vyn _ t 1016 ; input from tape (input) 0
gt r18 ; pm (c36) , pan c47 ; parameter ; param case:=0 hs r21 , ga r6 ; test character 1 is set hs r20 , ga r1 ; test character 2 is set
pp _ , pa c47 ; p:=testcharacter 2; output case:= 0
0 hs c65 , qq 12e0.29+1 ; call basic read [next] hsn (c91) IOA ; basic read ab c48 , ga c49 ;
ca _ , hv r7 ; if R | testcharacter 1 then 0 __ = ____
ncn p-10 , hvn r-3 ; begin if testcharacter 2 | 10 the _____ __ = ___
n _
arn c48 , ca (c47) ; goto next ____
sy (c49) , hv r-5 ; else output character ____
sy 60 V NZ ; including case
sy 58 ; end; ___
ga c47 , hv r-3 ;
gp r-7 , ncn p-10 ; testcharacter 1:=p; if p | 10 the __ = ___
n _
pp 10 , hv r-10 ; begin p:=10; go to next end; _____ __ __ ___
bs (c48) , sy 58 ; output must end in LC;
pm c68 , can _ ; if -, tryk bool then 0 __ ____
gm 1023 , ud c89 ; restore sum select læs pm c43 , gm c37 ; UV:=nonsense ps (c46) , hv c51 ; exit it 128 , pa c47 ; subroutine for unpack parameter cln -6 , tk -4 ; ca 58 , hh r-2 ; test for LC ca 60 , hv r-3 ; test for UC ca 63 ; test for CR ar 1 D ; ar c47 , hh s ; qq ; not used qq ; not used
b k=e90, i=0 ; _
d i=e89 ; _
qq 195.9+9e0.19 + 93.39f ; pass 6 word for outcopy
t outcopy; ; identifier _
qq 195.9+9e0.19+3.29+93.39f ; pass 6 word for writecopy
t writecopy; ; identifier _
d e71=2e71, e72=2e72, e89=i ; count identifiers _
e _
[14.9.65] [input, typein, inone, typechar, inchar, input track 2, 10e0]
b a10 ; _
[input] a: srn (c47) DX 1 ; appetite+1 ps (c46) , hv r6 ; s:=lastused ps (c46) t 1 ; s:=lastused:=lastused+1 pm s-1 IRC ; return information arn (s) D -1 IZA ; count parameters gm s X MRC ; move return information hv c15 LZA ; exit if no more parameters arn s1 , gm s1 ; next parameter, save counter hh r18 X LA ; expression ga c36 , tk 10 ; ca 0 , hvn r4 ; simple variable ar (c36) t -1 ; array length ga c36 , tk 30 ; sc c36 , sr r-3 ; pm r22 , ga c47 ; M:=return 1; set number of number s hs c65 , qq 11e0.29+1 ; call number read
gm s31 , hv r21 ; set return; goto number read ____
[typein] a1:pm r17 ; M:=return 2 [typechar] a2: hh r9 ; (s=r-1 or r-2) save sum and case [inone] a3: pm r16 , ud c12 ; M:=return 3 hhn r-6 , it r11 ; [inchar]a4: pa r5 t c12 ; sæt return from in-or typechar hs c65 , qq 12e0.29+1 ; call basic read hsn (c91) IOA ; basic read ab c48 , ga c49 ; nkf 9 , grf c37 ; set UV
hv _ , hs c22 ; exit or restore sum and case 0
hvn r-13 , arn c63 ; expression in input; save gr c68 , ud c90 ; sum and case it (c48) , pa c82 ; select type pa c48 , hhn s3 ; case:=0; return from save pm c68 , ud c89 ; restore sum and case it (c82) , pa c48 ; select input gm c63 , hv c12 ; exit hs c2 , qq 10e0.29+31 ; exit from number read after typei n hv c12 ; ,, ,, ,, ,, ,, inone hs c2 , qq 10e0.29+2 ; ,, ,, ,, ,, ,, input qq (c47) t 1 ; n:= n + 1
gp s29 , hv s1 ; save p, go_to number read __ __
qq ; not used
d a1=a1-a, a2=a2-a, a3=a3-a, a4=a4-a ; relative addresses _
b k=e90, i=0 ; _
d i=e89 ; _
qq 192.9+10e0.19 ; pass 6 word for input
t input; ; identifier _
qq 190.9+10e0.19+a1.29+ 91.39 f ; pass 6 word for typein
t typein; ; identifier _
qq 148.9+10e0.19+a2.29+ 91.39 f ; pass 6 word for typechar
t typechar; ; identifier _
qq 190.9+10e0.19+a3.29+ 91.39 f ; pass 6 word for inone
t inone; ; identifier _
qq 148.9+10e0.19+a4.29+ 91.39 f ; pass 6 word for in char
t in char; ; identifier _
d e71=5e71, e72=1e72, e89=i ; count identifiers _
e ; _
e ; end a - a10 names _
[14.9.65] [numberread, input track 3, 11e0]
b b10 ; begin block for 11e0 to 14 e0 _
b a20 ; _
a8: qq (c36) V 1 ; UA:=UA+1; [entry] a3: hs c65 , qq 12e0.29+1 ; call basic read
ppn 0 , ud ra1 ; state:=0; neg:=false;expfac:=10 _____
pm c40 , gm c53 ; dec factor:=1 a5: grn c37 , grn c54 ; number:=0; exp:=0 [next] a: hsn (c91) IZA ; basic read qq 15.6+ 6.12+436.21+272.30+ 5.39; terminator parameter qq 31.6+26.12+ 65.21+ 31.30+ 71.39; digit ,, qq 27.6+14.12+511.21+464.30+511.39; minus ,, qq 0.6+23.12+511.21+471.30+511.39; plus ,, qq 0.6+35.12+143.21+511.30+511.39; point ,, qq 7.6+53.12+287.21+127.30+511.39; ten ,,
[ten] it (s29) , bs 9 ; if oldstate < 3 then __ ____
pm c40 , gm c37 ; number:=1;
[digit h]a13: hv ra , grf c54 ; goto next ____
arnf c37 , mkf ra2 ; number:=number⨯10+digit; arf c54 , grf c37 ;
arnf c53 , bs p-3 ; if state > 3 then __ ____
a7: mkf ra2 , grf c53 ; dec factor:=dec factor⨯10
[ditto h] hh ra5 , hh ra6 ; goto next; ; ____
[termin] gp r1 , it ra ;
hh p_ , hh ra4 ; goto terminator action [f(state 0 ____
)] [.1] a11: cm (r-4) , can r409 ; [10.0] a2: qq 3 , qq 320 ; [end number] arnf c37 , dkf c53 ; store [UA]:=number /
bt (c54) t -1 ; decfactor ⨯ expfactor ∧ exp |
a9: mkf r_ , hv r-1 ; 0
mkf c41 NZB ; if neg then number:=-number __ ____
a6: grf (c36) , ud c89 ;
pp _ , it -1 ; restore p ; 0
ncn (c47) , hv ra8 ; go back if more numbers;
qq _ , qq _ ; exit instruction set by number 0 0
read [minus] bs p-1 ; minus pa ra9 V a10 ; set exponent factor
a1: pa ra9 t a12 IZB ; - - - ; neg:=true ____
[alarm h] a4: hv ra , hsn sb2 ; , error [digit] arn c49 , bs p506 ; digit nkf 9 , hh ra13 ; not in exponent pm c54 , ml sb3 ; in exponent
gm c54 , hv ra ; exp:=exp ⨯ 10 + digit; goto nex ____
t
d b5=a3-a4 ; return after error, relative _
d a10=a11-a9, a12=a2-a9 ; _
e ; end a to a20 names _
[14.9.65] [basic read, input track 4, 12e0]
b a10 _
a1: it 128 , pa c48 ; set case [entry] a: lyn c49 V ; normal entry: P:= input qq ; qq V ; qq ; ca 63 , hv ra ; ignore TAPE FEED ca 127 , hv ra ; - ALL HOLES ca 31 , hv ra2 ; punchoff ck -10 , ac c63 ; sum:=sum+character ck 10 , ca 28 ; grn c63 , hv ra ; clear code ca 60 , hv ra1 ; UPPER CASE ca 58 , hh ra1 ; LOWER CASE ca 12 , hv ra3 ; end code ca 61 , hv ra3 ; sum code
ar c48 NZ ; if not space then R:= R + case __ ____
a7: hr s1 NZA ; return to outcopy or inchar
hv ra LZ ; if space then go_to read HT: arn (c __ ____ __ __
49) D 30 LZ ca 14 , hv ra ; underline ca 16 , qqn ; zero ga c49 , pm s1 ; set last character it (c49) , bs 10 ; pm s2 , hv ra4 ; digit ca 32 , pm s3 ; minus ca 160 , pm s4 ; plus ca 59 , pm s5 ; point ca 155 , pm s6 ; ten a4: tln 26 , gt ra5 ; gp ra6 , tl p20 ; p contains state for number read
a6: ck p_ , tk -7 ; 0
ga ra5 , nc 7 ; state increment
a5: pp p_ , hr s0 ; ok, exit to number read 0
pp 10 , hv ra ; forbidden character in number read a3: vk 13e0 , lk c67 ; call error track vk 13e0 , hv c67 [special entry]
a9: pa c91 t 1 ; char is set:= false _____
arn c49 , hv ra7 ; use last character a8: ca 44 , hv ra ; punch on a2: lyn c49 , hv ra8 ; reading after punch off a10: qq 10.39 ; constant
d b1=a9-a1 ; special entry, relative _
d b2=a3-a1 ; error entry, relative _
d b3=a10-a1 ; constant 10, relative _
e ; end a - a10 names _
[14.9.65] [error- and pause- output during read] [input track 5, 13e0]
b a20 _
[entry] hv ra LZ ; error from numberread gk ra1 , ca 61 ; arn c63 , hh ra2 ; sum code hs ra3 ; text qq 58.9+39.15+49.21+20.27+18.33+53.39; LC p a u s e a2: hv ra4 , tl -59 ; , test inputsum dl ra5 , cl -10 ; ga ra6 , lyn c49 ; pa c63 , pt c63 ;
a6: ca _ , hh ra4 ; sum ok 0
hs ra3 ; text
qq 29.9+18.15+20.21+36.27+54.39; rødt S u m _ f ,
qq 49.9+57.15+35.21+18.27+62.33; a i l s black a4: lyn ra6 , gs ra7 ; wait for input to go on from
a1: vy _ , qq ; pause and sum , restore by 0
hr ra8 ; get start address for basic read a8: it s1 , pt ra10 ; set return address
a7: ps _ , hv ra9 ; restore s , exit 0
a3: pm 1023 , vy 17 ; subroutine for print text; syn 64 , gs ra11 ;
a11: arn _ t 1 LZ ; 0
hh ra12 LA ; ga ra13 , tk 10 ;
a13: sy _ , ck -4 ; 0
a12: hv ra11 , sy 58 ; gm 1023 , hr (ra11) ; a5: qq 127.39 ; constant for sumcheck qq ; not used a: bs (c48) , it 20 ; set U or L in number error text pa ra14 t 35 ; hs ra3 ; text qq 29.9+51.15+38.21+41.27+41.33+53.39 ; red c o r r e
qq 51.9+19.15+ 57.27+37.33+39.39 ; c t _ i n p ,
qq 20.9+19.15+ 21.27+49.33+35.39 ; u t _ v a l ,
qq 20.9+53.15+27.21+ 53.33+37.39 ; u e , _ e n ,
qq 52.9+ 57.21+37.27+ 60.39 ; d _ i n _ UC , ,
a14: qq _.9 +51.15+59.21+ 62.33+58.39 ; _ C : _ black LC 0 0 ,
it sb5 , pt ra10 ; set return addres for number error pa c48 ; inputcase lower a9: vk c64 , lk c67 ; restore free track place
a10:[vk c64 , hv _ instructions in running system] 0
e ; end a to a20 names _
[15.10.53] [cos, sin, setchar, track 14e0, algorithm as described in TRIG-2, with one term less, see also DASK ALGOL]
ba10 _
[cos] a: ps (c46) , pm s1 ; call hs c22 ; parameter
hvn ra3 IZA ; cos:= true; go_to Z; ____ __ __
[sin] a1: ps (c46) , pm s1 ; call hs c22 ; parameter
arn r IZA ; cos:=false; _____
a3: arnf(c36) X ; Z: RF:=parameter ga r1 , ps (c46) ;
bs Xt -16 ; if RF < 2∧(-15) ∧ RF | 0 then __ | = ____
dkf ra4 , hv ra5 ; begin _____
a6: arnf c40 LZA ; small: if cos then RF:= 1 __ ____
a8: grf c37 , hv c51 ; out: UV:= RF; exit end; ___
a5: hv ra6 LZ ; if RF = 0 then go_to small; __ ____ __ __
tkf 10 ; R:=modulus(FF);
ar 128 D LZA ; if -, cos then R:= R + 1/4; __ ____
tk 2 , gr c53 ; pm c53 , pt ra7 ; pt ra7 t -3 NO ; srn 256 D ; mk c53 , gr c54 ; pan r1 t a11 ;
a10: ar r_ Xt 1 ; 4
arn c53 V LA ; mkn c54 , hv r-2 ;
a7: mk c53 , mt r_ ; 0
nkf 0 , hv ra8 ; RF:= R; go_to out; __ __
m _
a9: -.000 003 418 229 ; +.000 151 656 333 ; -.004 369 731 387 ; +.072 906 209 920 ; -.569 703 680 149 ; +.267 162 131 344a ;
f _
a4: qq 2.9+25.15+33.23+251.31+84.39 ; 2⨯pi
m _
d a11=a9-a10-1 ; _
qq ; not used [set char] a2: ps (c46), pm s1 ; call hs c22 ; parameter arnf(c36) , it b1 ; set special entry into pa c91 , tkf 1 ; track 12e0 ga c49 , ps (c46) ; char:= parameter hv c51 ; exit
d a1=a1-a, a2=a2-a ; relative addresses _
b k=e90, i=0 ; _
d i=e89 ; _
qq194.9+14e0.19+92.39f ; pass 6 word for cos
t cos; ; identifier _
qq194.9+14e0.19+a1.29+92.39f ; pass 6 word for sin
t sin; ; identifier _
qq149.9+14e0.19+a2.29+92.39f ; pass 6 word for set char
t setchar ; ; identifier _
d e71=3e71, e72=1e72, e89=i ; count identifiers _
e ; _
e ; end a to a10 names _
e ; end b to b10 names (track 11e0 to 14e0) _
[14.9.65] [arctan, track 15e0, the method is that described by Lance in Numerical Methods, page 40, supplemented close to the origin by the two first terms of a modified Taylor expansion]
b a12 _
[arctan] ps (c46) , pm s1 ; entry point hs c22 ; call arg arnf(c36) X IZA ; take arg
ga ra2 XV LT ; if exponent _ 0 then __ > ____
arnf c41 , hh ra1 ; begin RF:= -1; go_to big argument end _____ __ __ ___
a2: bs [exp] t -8 ; if exponent > -8 then __ ____
ps a10 , hh ra3 ; begin base:= pi/16; go_to compute end _____ __ __ ___
mkf(c36) , mkf(c36) ; RF:= -x∧3⨯0.333306 + x; |
mkf ra4 , arf(c36) ; go_to exit; __ __
a1: hh ra5 , ps a11 ; big argument: base:= -3⨯pi/16;
hhn ra5 LZA ; if arg = 0 then begin RF:= 0; go_to exit end __ ____ _____ __ __ ___
a3: dkf(c36) , ga ra2 ; arg:= -1/arg; compute: tkf 9 , gs ra6 ; a2:= sign(arg); gr c68 , snn c68 ; c68:= arg/2; pm 128 DX ; c37:= mk ra7 , gr c37 ; .25 + (sqrt(2) - 1)/4⨯abs(arg); sr 256 D ; an c68 , tk -1 ; c37:= dk c37 ; (c37 - .5 + abs(arg)/2)/2/c37; gr c37 X ; c54:=
mkn c37 , gr c54 ; c37∧2; |
pan r1 t 5 ; ar r0 Xt 1 ; mkn c37 V LA ; R:= 37⨯ polynomium; mkn c54 , hv r-2 ; a6: arr[base], mt ra2 ; R:= (base + R)⨯sign(a2); a5: nkf 1 , grf c37 ; RF:= 2⨯R; exit: UV:= RF;
ps (c46) , hv c51 ; go_to administration __ __
qq 132 189.26; a[13] qq -1 416 698.28; a[11] qq 10 874 463.30; a[9] qq -82 115 957.32; a[7] qq 670 327 015.34; a[5] qq -6 511 656 473.36; a[3] qq 113858 157095.38,; a[1] a7: qq-26.7-130.15-121.23-153.31-253.39; -(sqrt(2) - 1)/2 a8: qq-75.7- 99.15-753.23-252.31-205.39; -3⨯pi/16 a9: qq 25.7+ 33.15+251.23+ 84.31+ 68.39; pi/16
f ; _
a4: -0.333 306 ; modified Taylor coeff
m ; _
qq ; not used
d a10=a9-a6, a11=a8-a6 ; relative addresses _
b k=e90, i=0 ; _
d i =e89 ; _
qq 194.9+15e0.19+92.39 f ; pass 6 word for arctan
t arctan; ; identifier _
d e71=1e71, e89=i ; count identifiers _
e ; _
e ; end a to a12 names _
s _
[14.9.65] [ln, outclear, outsum, track 16e0]
b a20 _
d e73=k-e70, e74=0 [track no., track relative for ln] _
[ln] a: ps (c46) , pm s1 ; hs c22 ; arnf(c36) , ps 5 ; RF:=arg; set error text
hh c55 LT ; if x<0 then go_to alarm; __ ____ __ __
tk 9 VX NZ ; if x=0 then __ ____
pm ra1 , hv ra3 ; begin ln := -2∧166; go_to exit end; _____ | __ __ ___
ga ra4 , gm c53 ; exp2 := exponent(x) ⨯2∧(-9) + 2∧(-10); | |
gm c54 , arn ra5 ; c53 := (sqrt(2)/4 - numerus(x)/4)/ ac c53 , sr c54 ; (sqrt(2)/4 + numerus(x)/4) dk c53 , gr c53 ;
pm c53 , mkn c53 ; c54 := c53∧2; |
gr c54 ; pan r1 t a6 ; R := 0;
a8:ar r_ X 1 ; for k := -0.000 847 09, -0.001 126 143 206, 0 ___
mkn c53 V LA ; -0.001 878 518 085 do __
mkn c54 , hv r-2 ; R := (k + R) ⨯ c54; ar ra4 X ; ln := ((R - .005 635 527 485) ⨯ c53 + exp2) mkn ra9 ; ⨯ ln(2)
nkf 9 , grf c37 ; ⨯ 2∧9; |
a2:ps (c46) , hv c51 ; go_to exit __ __
m ; _
a7:-0.000 847 09 ; a[7] -0.001 126 143 206 ; a[5] -0.001 878 518 085 ; a[3] -0.005 635 527 485a ; a[1] a9:qq 354.9+57.15+5.22+126.29+31.34+9.39 ; ln(2)
a1: qq 165.9+1.10 ; -2∧166 |
a5:qq 5.4+10.8+8.12+2.16+7.20+9.24+9.28+9.32+15.36+6.39 ; sqrt(2)/4
a4:qq _ t 512 ; exp2 0
a3:gm c37 , hv ra2 ; UV:= M; go_to exit; __ __
qq ; not used qq ; not used qq ; not used [outclear]
a10:sy 28 , hv ra11 ; punch CLEAR CODE; go_to w __ __
[outsum] a12:sy 11 , sy 61 ; punch STOP CODE; punch SUM CODE; arn 1023 , tl -59 ; form sum dl ra13 , cl -10 ; character ga c47 , sy (c47) ; punch sum character a11:pa 1023 , pt 1023 ; w: output sum:= 0; arn c43 , hv c14 ; R:= nonsense; exit a13:qq 127.39 ; modulus
d a6=a7-a8-1 ; _
d a10=a10-a, a12=a12-a ; relative addresses _
b k=e90, i=0 ; _
d i=e89 ; _
qq194.9+e73.19+92.39 f ; pass 6 word for ln
t ln ; ; identifier _
qq 191.9+16e0.19+a10.29+91.39 f ; pass 6 word for outclear
t outclear; ; identifier _
qq191.9+16e0.19+a12.29+91.39 f ; pass 6 word for outsum
t outsum; ; identifier _
d e71=3e71, e72=1e72, e89=i ; count identifiers _
e ; _
e ; end a to a20 names _
d c60=1e73+e96, e0=e0-e96 ; set running track and redefine e0 _
e ; end drum block, e0 - 16e0 _
[14.9.65] [split and pack, page 2]
b k=c60+e70, i=10, a10 _
a2: arn ra4 , hh ra1 ; split: shift:= -39; go to common; __ __
a1: arn ra6 , ps (c46) ; pack: shift:= 1; pm (c47) D 4 ; common: gm s-4 , gr s-3 ; n:= appetite+1; hs c5 , qq 1018.29+c1-1; blockentry (4) locals blocklevel: (1); hh (c84) , arn p3 ; pm p3 DX ; i:= p+3; gr p-3 , hs c22 ; take formal(store[i]);
arn c36 , ca c37 ; if UA:= location(UV) then __ ____
pm c37 , arn p-3 ; begin a:= p+3; store[p+3]:= UV end _____ ___
gr p-4 , gm p3 ; else a:= UA; ____
arn p-2 , hv ra9 ; R:= n; go to test; __ __
; next parameter group: a4: qq -39 , hs c22 ; take formal(store[i]); arnf(c36) , tkf -29 ; b:= address(store[UA]); ck -10 , ud ra7 ; i:= i+1; gr p4 , hs c22 ; take formal(store[i]); arnf(c36) , tkf -29 ; c:= address(store[UA])+ shift-b; ck -10 , ar p-1 ; sr p4 , ud ra7 ; gr p5 , hs c22 ; i:= i+1; arnf(c36) , tkf -29 ; take formal(store[i]); gr p6 , pmn(p-4) ; d:= round(store[UA]); ar 256 D LA ; ar 128 D LB ; RM:=store42bits[a]; a6: xr 1 , cl (p4) ; cl(b); tl(c);
tl (p5) , bs (p-1) ; if shift _ 0 then __ < ____
cl -40 , hv ra5 ; begin _____
nkf 39 , grf (c36) ; store[UA]:= float(R); M:= store[UA];
pm (c36) , hv ra3 ; end ___
a5: ar p6 , it (p4) ; else ____
ns (p5) , cl s40 ; begin cl(-40); _____
a8: xr __ , ck 1 ; R:= R+d; cl(40-b-c); -1
ga ra8 , pi (ra8) ; store42bits[a]:= RM
gm (p-4) t MOC ; end; ___
a3: arn(p-2) D 3 ; n:= n+3; i:= i+1;
a9: ps (p-3) V 1 NT ; test: if n 0 then go to next parameter group; __ ____ __ __
a7: pm (p-3) t 1 ; s:= i;
hh ra4 LT ; if n=2 then __ ____
ca 2 , hv c6-1 ; exit from function with value in M;
ps 15 , hh c55 ; alarm(|<param|); < >
b k=e90, i=0 ; prepare loading of pass 6 words and _
d a1=a1-a2, a2=0 ; procedure names _
d i=e89 ; _
qq145.9+c60.19+a1.29; pass 6 word for pack
t pack; ; name of pack _
qq143.9+c60.19+a2.29; pass 6 word of split
t split; ; name of split _
d e71=2e71, e89=i ; _
e ; _
d c60=1c60 ; increase running track _
e ; end a to a10 names _
[14.9.65] [gier drum, gier proc and gier, page 1. kb on. The code contains a normal blockentry, which reserves space for the local variable n (see below). In case of gier drum or gier proc with tape input further reserva- tions are made by reserve array. The length contained in the label on the tape is stored in the last of the cells reserved in this way. Stack picture: last used:... Input from tape stored ... in this array. p-2: length : Length of array. p-1: n: Number of parameters or, in case of gier drum, 0. p : sr: Normal blockinformation. p+1: i: Running address during input, initialized by reserve array. return: Return address during call of take gier formal. p+2: Normal return information. p+3: First parameter. ... Following parameters.]
b k=c60+e70, i=10, a20, b10 _
d a=i _
a1: ncn(c47) V 3 ; gier drum: appetite:= appetite+3; R:= 0;
; if appetite | 0 then alarm(|<param|); go to common; __ = ____ < > __ __
a2: srn(c47) VD 1 ; gier proc: gier: R:= -appetite-1; ps 15 , hh c55 ; common: ps (c46) , gr s-3 ; n:= R; hsc5, qq1021.29+c1-1; blockentry (1)local level:(1) hh (c84) , pm p3 ;
qq V LA ; if split(store[p+3],40,41,blind) | 1 then __ = ____
hv ra3 LB ; begin _____
hs c22 ; take formal (store[p+3]);
bs (p-1) ; if n > 0 then __ ____
ps ra4 , hv (c36) ; begin s:= ref; go to location[UA] end; _____ __ __ ___
pm (c36) , gm p3 ; store[p+3]:= store[UA] end; ___
a3: hs c2+1c60.39,qq7 ; go to from tape; Note: no symbolic address became of r __ __
-mark.
; comment the following 4 word must be kept together _______
qq (c36) ; as they are referred to via s-1, s-1 and s+1 resp; gs p1 , hs c22 ; take gier formal: return:= s; take formal(M);
a4: ps (p1) , hs s1 ; ref: s:= ref; go to location[return+1]; __ __
[s1]grf c37 , it p3 ; out: UV:= RF; s:= p+3+n; ps (p-1) , it c37 ; UA:= address(UV);
pa c36 , hh c6 ; go to exit proc; __ __
; comment a6 is referenced as track relative 19 in 8a16; _______
a6: srn c34 , ac p-2 ; tape is in: length:= length - 1; ps ra4 , ncn(p-1) ; s:= ref;
is (c46) , hv s1 ; if n | 0 then go to location[last used + 1]; __ = ____ __ __
pm p4 , hs c22 ; take formal (store[p+4]); arn p -2 ; nkf 39 , grf(c36) ; store[UA]:= float(length); arn p1 , ck -10 ; ar p-1 D ; pack (R, 0,9,address(length)-1, 10,19,i, 20,39,0); hs c11 , qq e26.29; to drum (R);
ps p5 , hh c6 ; s:= p+6; go to exit proc; __ __
a17:arn c41 V NKB ; kb on: R:= if NKB then false else true; __ ____ _____ ____ ____
arn c40 ;
hv c14 ; go to end R expr; __ __
; comment 32 words used on this track. _______
[14.9.65] [gier drum, gier proc and gier, page 2.]
d i=a+40 ; start next track; _
a13:it p-1 , pa c46 ; sum error: last used:= p-1; a14:pm 1023 , vy 17 ; ident error: M:= outputsum; select type; sy 64 , sy29[red]; writecr;
sy 55[g] , sy 57[i] ; write red text (|<gier|); < >
sy 53[e] , sy 41[r] ; sy62[black], lync47 ; read a char; gm 1023 , ud c89 ; outputsum:= M; select punch;
; comment a15 is referenced as track relation 7 in a3; _______
a15:grn c68 , lyn c47 ; from tape: sum:=0;
nc 17 , hv ra15 ; if read a char | 17 then go to from tape; __ = ____ __ __
lyn c47 , ca 4 ; if read a char = 4 then __ ____
hs ra11 , hv ra18 ; begin one word; go to compute length end _____ __ __ ___
hs ra11 , ps ra15 ; one word; one word; go to from tape; __ __
; procedure one word; comment to R, marks to RC; _________ _______
a11:lyn rb1 , pa rb2 ; begin R:=0; b1:= char:= read a char; b2:=0; _____
a12:ac (c68) D ; rep: pack (R,0,9,char); sum:= sum+char; b1: pi -1 , tl -7 ; indicator:= b1; tl (-7);
b2: bt __ t -100 ; b2:= b2-100; if b2 < -512 then tl (10) -1 __ ____
tl 10 , hh s ; else begin char:= read a char; go to rep end ____ _____ __ __ ___
ly c47 , hv ra12 ; end; ___
a18:tk 20 , ga rb3 ; compute length: tk 3 , gt rb3 ; length:= round (split(R,20,29,blind)+ tk 12 , is 1 ; split(R,30,39,blind)⨯40+1);
b3: ar s__ D __ ; -1 -1
ck 10 , gr p-2 ; hs ra11 , pm p3 ; one word; M:= store[p+3]; gr p-3 X MRC ; store[p-3]:= R and RC marks; R:= M;
sr p-3 NZ ; if R | 0 then R:= R - store[p-3]; __ = ____
hv ra14 NZ ; if R | 0 then go to ident error; __ = ____ __ __
qq p-2 , hs c50 ; reserve array (length);
qq -1 , hv s2 ; comment reserve array sets i:= last used; _______
pm p-3 XV IRC ; R:= store[p-3]; RC:= marks(store[p-3]); skip; a16:hs ra11 , ; rep: one word; gr (p1) MRC ; store[i]:= R and RC marks; pmn(p1) DX 1 ; i:= i+1;
nc p-2 , hv ra16 ; if i | p-2 then go to rep; __ = ____ __ __
lyn c47 , tk -7 ; R:= 0; pack (r, 14,23,read a char, ly c47 , tk -7 ; 7,16,read a char, 0,9,read a char);
ly c47 , tk 14 ; if sum | split (R, 14,23,blind) then __ = ____
nc (c68) , hv ra13 ; go to sum error; __ __
hs c2+c60.39, qq 19 ; go to tape is in; Note: no symbolic address because o __ __
f r-mark qq [check sum] ; All 40 words used; checksum for tracks stored here;
b k=e90, i=0 ; prepare loading of pass 6 words and _
d i=e89, a1=a1-a, a2=a2-a, a17=a17-a; procedure names _
qq 143.9+c60.19+a1.29 ; pass 6 word for gier drum
t gier drum; ; identifier _
qq 144.9+c60.19+a2.29 ; pass 6 word for gier proc
t gier proc; ; identifier _
qq 141.9+c60.19+a2.29+112.39 ; pass 6 word for gier
t gier; ; identifier _
qq 142.9+c60.19+a17.29+91.39f ; pass 6 word for kb on
t kb on; ; identifier _
d e71=4e71, e72=2e72, e89=i ; count number of tablewords _
e ; _
[14.9.65]
d c60=2c60 ; increase running track _
e ; end a to a20 and b to b10 _
d e73=e73-e0, e75=e75-e0 ; Convert track numbers for ln exp and ∧integ _ |
d e77=e77-e0 ; to relative track numbers (relative to 1. st. _
; proc. track). [Track reservations and GP come next]