|
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: 52992 (0xcf00) Types: TextFile Names: »set4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code └─⟦75ff9bef3⟧ └─⟦this⟧ »set4tx «
\f ; fgs 1988.19.13 fp utility, system 3, cat adm 1 ; the catalog administration 1 consists of the programs: ; set, entry, rename, nextfile. ; the text is assembled with a call of the slang assembler ; of the following kind: ; ; (set=slang text ; set setmt clearmt entry changeentry assign rename permanent nextfile) ;rc 22.05.72 fp utility, system 3, cat adm 1 ...01... b. g15 w. ; outer block for insertproc d. p.<:fpnames:> l. s. a300, b200, i100 w. k=h55+10000 w. g3=k ;procedure init program ; ;entered just after entry of program. the various pointers are ;set. at return w1 contains curr out zone address. ;the return is to link if a left side is in the program call - ;else to link+2. ; ;observe that w1 is used as link. ; b0: ds. w3 a2. ; save first core, pointer; al w3 x3+2 ; rs. w3 a3. ; save address of program name; bz w2 x3-2 ; se w2 6 ; return:= am 2 ; if delim <> 6 then link+2 al w3 x1 ; else link; al. w1 h21.+10000 ; w1:=addr of curr out zone; jl x3 ; goto return; \f ;rc 22.05.72 fp utility, system 3, cat adm 1 ...02... ;end program: b2: am. (a22.) ; set ok: se w1 x1 ; w2:= am 1 ; if not ok then 1 al w2 0 ; else 0; jl. h7.+10000 ; goto fp end program; ;procedure output parameters ; ;searches through the fp command stack for a parameter with ;delim = space or end list while listing the parameters ;found. when such a parameter or end list is found the ;procedure returns. ; ; call return ;w0 destroyed ;w1 destroyed ;w2 addr of param destroyed ;w3 link destroyed ; b. j2 w. b4: rs. w3 j0. ; save link; j1: ; output parameter: bz w1 x2 ; w1:=delim; jl. w3 x1+b29. ; outtext(delim); bz w1 x2+1 ; w1:=kind; al. w3 j2. ; return := j2 ; al w0 x2+2 ; w0:=addr(param); se w1 4 ; if kind <> integer jl. h31.-2+10000 ; then outtext(param); rl w0 (0) ; else jl. w3 h32.-2+10000 ; outinteger(param); 0<23+32<12+1 ; j2: ba w2 x2+1 ; w2:=next param; rl w0 x2 ; sh. w0 (a23.) ; if delim not point or = jl. (j0.) ; then return; jl. j1. ; goto output parameter; j0: 0 ; saved link e. \f ;rc 22.05.72 fp utility, system 3, cat adm 1 ...03... ;procedure next parameter ; ;forwards the pointer a2 to the next parameter in the ;command stack. if end list the return is to link ;else to link + 2. ; ;w0 delim,kind ;w1 unchanged ;w2 pointer ;w3 link destroyed ; ;the pointer points to the item preeceding the parameter. b11: rl. w2 a2. ; ba w2 x2+1 ; step pointer; rl w0 x2 ; w0:=del,kind; sh. w0 (a25.) ; if end list jl x3 ; then goto link rs. w2 a2. ; else store pointer jl x3+2 ; and goto link+2; \f ; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...04... ;error text output procedures ; ;as a rule: ; at call at return ;w0 add of text or integer destroyed ;w1 cur out zone ;w2 unchanged ;w3 link destroyed ;error texts: b50: am i50 ; <: no room<10>:> b49: am i49 ; <: catalog error<10>:>> b48: am i48 ; <: error<10>:> b47: am i47 ; <: protected<10>:> b46: am i46 ; <: entry in use<10>:> b45: am i45 ; <: name conflict<10>:> b44: am i44 ; <: change bs device impossible<10>:> b43: am i43 ; <: change kind impossible<10>:> b42: am i42 ; <: no resources<10>:> b41: am i41 ; <: call<10>:> b40: am i40 ; <: no entries found<10>:> b39: am i39 ; <: bs device unknown<10>:> b38: am i38 ; <: connect :> b37: am i37 ; <: unknown<10>:> b36: am i36 ; <: illegal scope<10>:> b35: am i35 ; <: param :> b34: am i34 ; <:***:> b33: am i33 ; <: :> b32: am i32 ; <:<10>:> b31: al. w0 a31. ; <:.:> b29=b33-4 ; cf ...03... ;outtext on current out b30: jl. h31.-2+10000 ; ;outtext program name and set ok to sorry ; b12: rs. w3 a22. ; ok:=return; jl. w3 b34. ; outtext ( *** rl. w0 a3. ; rl. w3 a22. ; jl. b30. ; <program name> ); ;parametererror. ;outputs the text ; ***<prog name> param <parameter><10> ;and exits to end program b13: jl. w3 b12. ; outtext(***<prog name>); jl. w3 b35. ; outtext(param); rl. w2 a2. ; w2:=pointer; jl. w3 b4. ; output parameter; jl. w3 b32. ; output a nl; jl. b2. ; goto end program; \f ;rc 28.05.72 fp utility, system 3, cat adm 1 ...05... ; rc 23.4.71 fp utility nextfile page 1 b. a10,b10,c10 w. g11: ; entry nextfile k=k-10000 ; adjust k-value rs. w3 b1. ; save w3 bl w0 x3 ; w0:= separator; se w0 6 ; if separator= equal then jl. a0. ; begin al w2 1 ; error:= true; rs. w2 b2. ; al. w0 c1. ; outtext(<: jl. w3 h31.-2 ; ***nextfile call:>); jl. a7. ; goto end nextfile; ; end; a0: rl. w3 b1. ; search for param: reestablish w3 ba w3 x3+ 1 ; w3:= addr of next item; rs. w3 b1. ; save w3 bl w0 x3 ; w0:= separator; sh w0 2 ; if w0<=2 then jl. a7. ; goto end nextfile; se w0 4 ; if separator= space jl. a1. ; and bl w0 x3+10 ; next separator<>point sn w0 8 ; and jl. a1. ; bl w0 x3+ 1 ; kind(parameter) se w0 10 ; =text jl. a1. ; then goto jl. a3. ; lookup entry; a1: al w2 1 ; comment parameter error; rs. w2 b2. ; error:= true; al. w0 c2. ; outtext(<: jl. w3 h31.-2 ; ***nextfile param :>); rl. w3 b1. ; reestablish w3 a2: bl w2 x3 ; nextsearch: w2:=separator al. w0 x2+c7. ; outtext(separator) jl. w3 h31.-2 ; rl. w3 b1. ; reestablish w3 bl w2 x3+ 1 ; w2:=kind(parameter) se w2 10 ; if kind(parameter) jl. a8. ; =text then al w0 x3+ 2 ; outtext(parameter) jl. w3 h31.-2 ; jl. a9. ; else a8: rl w0 x3+ 2 ; jl. w3 h32.-2 ; outinteger(parameter) 1 ; layout \f ;rc 28.02.72 fp utility, system 3, cat adm 1 ...06... ; rc 28.2.72 nextfile page 2 a9: al. w0 c5. ; jl. w3 h31.-2 ; ourcr rl. w3 b1. ; reestablish w3 ba w3 x3+ 1 ; w3:= addr of next item; rs. w3 b1. ; save w3 bl w0 x3 ; w0:= separator; sh w0 2 ; if w0<=2 then jl. a7. ; goto end nextfile; se w0 4 ; if separator<>space jl. a2. ; or bl w0 x3+10 ; next separator=point sn w0 8 ; or jl. a2. ; bl w0 x3+ 1 ; kind(parameter) se w0 10 ; <>text then jl. a2. ; goto nextsearch; ; lookup entry: a3: al. w1 b3. ; w1:= tail addr; al w3 x3+ 2 ; w3:= name addr; jd 1<11+42 ; w0:= lookup entry sn w0 0 ; if w0=0 then goto entry found; jl. a6. ; ; ; not note not entry: al w0 1 ; error:= true; rs. w0 b2. ; al. w0 c0. ; outtext(<: jl. w3 h31.-2 ; ***nextfile :>); rl. w3 b1. ; reestablish w3; al w0 x3+ 2 ; outtext( jl. w3 h31.-2 ; parameter); al. w0 c3. ; outtext(<: jl. w3 h31.-2 ; unknown:>); rl. w3 b1. ; reestablish w3 jl. a0. ; goto search for param; ; ; entry found: (w3=name addr) a6: rl. w1 b4. ; b4=addr of file number in entry tail al w1 x1+ 1 ; file(entry tail):= rs. w1 b4. ; file(entry tail)+1; al. w1 b3. ; w1:= tail addr; jd 1<11+44 ; w0:= change entry; sn w0 0 ; if w0= 0 then jl. a0. ; goto search for param; ; ; al w0 1 ; error:= true; rs. w0 b2. ; al. w0 c0. ; outtext(<: jl. w3 h31.-2 ; ***nextfile:>); rl. w3 b1. ; reestablish w3; al w0 x3+ 2 ; w0:= name addr; jl. w3 h31.-2 ; outtext(parameter); al. w0 c4. ; jl. w3 h31.-2 ; outtext(<: protected:>); rl. w3 b1. ; reestablish w3 jl. a0. ; goto search for param; \f ;rc 28.05.72 fp utility, system 3, cat adm 1 ...07... ; rc 23.4.71 fp utility nextfile page 3 a7: rl. w2 b2. ; end nextfile: w2:= error jl. h7. ; goto fp-endprogram; ; ; b1: 0 ; saved w3 b2: 0 ; error b3: 0,0,r.9 ; tail addres b4=b3+12 ; c0: <:***nextfile <0>:> c1: <:***nextfile call<10><0>:> c2: <:***nextfile param <0>:> c3: <: unknown<10><0>:> c4: <: protected<10><0>:> c5: <:<10>:> c6: <: :>, <:=:>, <:.:> c7=c6-4 k=k+10000 ; adjust k-value e. ; end block \f ; fgs 1988.12.20 fp utility, system 3, cat adm 1 ...08... ;working locations: a1: 0 ; last available core a2: 0 ; param pointer in fp stack a3: 0 ; prog. name address a16: 0 ; output zone address a22: 0 ; ok status a23: 4<12+10 ; space, shortest name a24: 8<12+10 ; point, shortest name a223:4<12+ 9 ; space, nearly name a123:4<12+(:7*8+10:); space, longest name a124:8<12+(:7*8+10:); point, longest name a28: 4<12+4 ; space, integer a25: 4<12-1 ; test end list a29: 8<12+ 4 ; point,integer a30: <:d:> \f ; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...09... ;texts: a33: a51: <:<32><0>:> a32: a61: <:<10><0>:> a31: a52: <:.<0>:> a34: a60: <:***<0>:> a35: <: param <0>:> a36: <: illegal scope<10><0>:> a37: <: unknown<10><0>:> a38: <: connect <0>:> a39: <: bs device unknown<10><0>:> a40: <: no entries found<10><0>:> a41: <: call<10><0>:> a42: <: no resources<10><0>:> a43: <: change kind impossible<10><0>:> a44: <: change bs device impossible<10><0>:> a45: <: name conflict<10><0>:> a46: <: entry in use<10><0>:> a47: <: protected<10><0>:> a48: <: error<10><0>:> a49: <: catalog error<10><0>:> a50: <: no room<10><0>:> a53: <:=set<0>:> a54=a60 ;<:***<0>:> a63: <: ; <0>:> a59: <:temp:>,0,0 ; start of scope table a58: <:login:>,0,0 a57: <:user:>,0,0 a56: <:project:>,0 a55: <:system:>,0,0 <:own:>,0,0,0 a96=a59+2,a97=a59+4 a98=a59+6,a99=k-a59 ; end of table a62: <:<10> ; <0>:> ;i-names are used for addressing by succesive am-es i32=a32-a31,i33=a33-a32,i34=a34-a33,i35=a35-a34,i36=a36-a35 i37=a37-a36,i38=a38-a37,i39=a39-a38,i40=a40-a39,i41=a41-a40 i42=a42-a41,i43=a43-a42,i44=a44-a43,i45=a45-a44,i46=a46-a45 i47=a47-a46,i48=a48-a47,i49=a49-a48,i50=a50-a49 i52=a52-a51,i53=a53-a52,i54=a54-a53,i55=a55-a54,i56=a56-a55 i57=a57-a56,i58=a58-a57,i59=a59-a58,i60=a60-a59,i61=a61-a60 i62=a62-a61,i63=a63-a62 \f ;fgs 198.05.06 fp utility, system 3, cat adm 1 ...10... ;mode kind table a26: <:ip:> ,0 , 1<23+ 0<12+ 0 ; internal process <:bs:> ,0 , 1<23+ 0<12+ 4 ; backing storage area a103=k-2 ; mode.kind bs <:tw:> ,0 , 1<23+ 0<12+ 8 ; typewriter <:tro:>,0 , 1<23+ 0<12+10 ; tape reader odd parity <:tre:>,0 , 1<23+ 2<12+10 ; tape reader even parity <:trn:>,0 , 1<23+ 4<12+10 ; tape reader no parity <:trf:>,0 , 1<23+ 6<12+10 ; tape reader flexo code <:trz:>,0 , 1<23+ 8<12+10 ; tape reader zeroes allowed <:tpo:>,0 , 1<23+ 0<12+12 ; tape punch odd parity <:tpe:>,0 , 1<23+ 2<12+12 ; tape punch even parity <:tpn:>,0 , 1<23+ 4<12+12 ; tape punch no parity <:tpf:>,0 , 1<23+ 6<12+12 ; tape punch flexo code <:tpt:>,0 , 1<23+ 8<12+12 ; tape punch teletype code <:lp:> ,0 , 1<23+ 0<12+14 ; line printer <:crb:>,0 , 1<23+ 0<12+16 ; card reader binary <:crd:>,0 , 1<23+ 8<12+16 ; card reader decimal <:crc:>,0 , 1<23+10<12+16 ; card reader ebcdic <:mto:>,0 , 1<23+ 0<12+18 ; mt, high density, odd parity <:mte:>,0 , 1<23+ 2<12+18 ; even <:nrz:>,0 , 1<23+ 4<12+18 ; low , odd <:nrze:> , 1<23+ 6<12+18 ; even <:mtlh:> , 1<23+ 0<12+18 ; low speed, high , odd <:mtll:> , 1<23+ 4<12+18 ; low <:mthh:> , 1<23+128<12+18 ; high speed, high <:mthl:> , 1<23+132<12+18 ; low <:mt62:> , 1<23+ 0<12+18 ; 6250 bpi <:mt16:> , 1<23+ 4<12+18 ; 1600 <:mt32:> , 1<23+ 8<12+18 ; 3200 <:mt08:> , 1<23+12<12+18 ; 800 <:pl:> ,0 , 1<23+ 0<12+20 ; plotter a27: 0 \f ;rc 28.02.72 fp utility,system 3, cat adm 1 ...11... ;area for a single entry lookup: a80: 0 ; first slice , keys a81=k-1 ; keys a82: 0 ; interval low a83: 0 ; interval up a84: 0 ; name a85: 0 ; first doubleword 0 ; a86: 0 ; second doubleword a87: 0 ; kind a88: 0 ; doc.name a89: 0 ; first doubleword a136: 0 ; a90: 0 ; second doubleword a91: 0 ; name table address a92: 0 ; file a93: 0 ; block a94: 0 ; contry a95: 0 ; length ;call error ; ***<prog.name> call ; ;followed by exit to end program ; b25: jl. w3 b12. ; outtext(***<prog.name>); jl. w3 b41. ; outtext(call); jl. b2. ; goto end program \f ; fgs 1988.12.20 fp utility, system 3, cat adm 1 ...12... ;procedure next compound parameter ; ;used by set and entry programs ; ;reads the next compound parameter from the stack. only ;parameters of the forms: ;<name> , <integer> or <integer1>.<integer2> are accepted. ;other parameters causes an error message and exit to end ;program. a parameter of the type <int>.<int> is interpre- ;ted as <integer1> shift 12 + <integer2>. ; ;if end list is found ( no parameters ) the return is to link ;otherwise to link + 2. ; ; call return ;w0 4<12+10 not 4<12+10 ;w1 first 3 chars integer ;w2 addr of item destroyed ;w3 link destroyed destroyed ; b. j2 w. j0: 0 ; saved link+2 j1: 0 ; saved link b27: al w2 x3+2 ; start: save link,link+2; ds. w3 j1. ; jl. w3 b11. ; next param; jl. (j1.) ; end list: return to link; bz w3 1 ; w3:=length(param); am x3 ; rl w3 x2 ; w3:=next delim,kind; rl w1 x2+2 ; w1:=param (first part may be); sh. w3 (a123.) ; if next del <> point jl. (j0.) ; then return to link+2; sn. w0 (a28.) ; if param <> space, integer se. w3 (a29.) ; or next param <> point, integer then jl. b13. ; goto paramerror; jl. w3 b11. ; next param; ks -3 ; end list:testoutput; ls w1 12 ; w1:=first integer shift 12 wa w1 x2+2 ; + second integer; jl. (j0.) ; return to link+2; e. \f ; fgs 1988.11.30 fp utility, system 3, cat adm 1 ...13... ;the program set ; b. c11 w. g7: jl. w1 b0. ; start: init program; jl. c1. ; if no left side jl. b25. ; then goto call error; c1: rl. w3 a1. ; move name: dl w1 x3+4 ; move name ds. w1 a111. ; to dl w1 x3+8 ; name ds. w1 a113. ; area; jl. w3 b27. ; get kind: next compound param; jl. b80. ; end list: goto set entry; sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name jl. c2. ; then goto store kind; dl w1 x2+4 ; search in table: al. w2 a26. ; index:=first(table); c3: sn w0 (x2) ; compare: if param se w1 (x2+2) ; <> table(index) jl. c4. ; then goto step index; rl w1 x2+4 ; found: kind:=kind(index); c2: rs. w1 a87. ; store kind: jl. w3 b27. ; doc.name: next comp. param; jl. c9. ; end list: goto set shortclock; sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name jl. c5. ; then goto integer doc.name; dl w1 x2+4 ; move doc.name: ds. w1 a89. ; dl w1 x2+8 ; ls w1 -8 ; zero last char ls w1 8 ; of last word in name; ds. w1 a90. ; c8: al. w3 a91. ; rest of tail: rs. w3 c7. ; pointer:=name table addr; rl. w2 a2. ; ba w2 x2+1 ; rl w0 x2 ; if nextparam=name sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name jl. c10. ; goto not name else jl. c0. ; goto test if date; c10: sh. w0 (a25.) ; if nextsep = endsep then jl. c9. ; goto set shortclodk; c6: jl. w3 b27. ; next tail: next comp. param; jl. b80. ; end list: goto set entry; sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name jl. c11. ; goto not name else jl. b13. ; goto paramerror; c11: rl. w3 c7. ; if nextsep = endsep then sl. w3 a95.+2 ; if too many parameters jl. b13. ; then goto param error; rs w1 x3 ; store parameter; al w3 x3+2 ; step pointer; rs. w3 c7. ; jl. c6. ; goto next tail; c5: sl w1 0 ; integer doc.name: sl w1 4 ; if doc.name < 0 or >= 4 jl. b13. ; then goto paramerror; rs. w1 a88. ; store parameter; jl. c8. ; goto rest of tail; c9: dl w1 110 ; set shortclock: ld w1 5 ; rs. w0 a91. ; save shortclock jl. b80. ; goto set entry; \f ; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...14... ;set page 2 c4: al w2 x2+6 ; step index: index:=index+6; se. w2 a27. ; if not end table jl. c3. ; the goto compare jl. b13. ; else paramerror; c7: 0 ; pointer c0: ; test if date, program set rl w0 x2+2 ; se. w0 (a30.) ; if name<>d jl. c6. ; then return; rl w0 x2+10 ; if nextsep<>pointinteger se. w0 (a29.) ; then return; jl. c6. ; rl w1 x2+16 ; clock; rl w0 x2+14 ; if nextnextsep<>pointinteger se. w0 (a29.) ; then al w1 0 ; clock:=0; rl w0 x2+12 ; date; jl. w3 b79. ; transform date and clock; jl. b13. ; if dateerror then paramerror; rl. w3 c7. ; rs w0 x3 ; save shortclock; al w3 x3+2 ; pointer:=pointer+2; rs. w3 c7. ; jl. w3 b11. ; am jl. w3 b11. ; am rl w0 x2+4 ; if nextsep=pointinteger sn. w0 (a29.) ; then jl. w3 b11. ; nextparam; am jl. c6. ; goto next tail; e. ; set entry ; ;creates a new catalog entry or changes the tail of an existing one ;according to name in a110-a113 and tail in a87-a95. ; b. j9 w. b80: al. w1 a87. ; al. w3 a110. ; rl. w0 a27. ; if program sl w0 2 ; =changeentry jl. j2. ; then goto change entry; jd 1<11+40 ; create entry; sn w0 0 ; if ok jl. b2. ; then end program; sn w0 3 ; if entry exists jl. j2. ; then goto change entry; j1: rs. w0 j0. ; error: save cause; j6: jl. w3 b12. ; error message ***<prog.name> jl. w3 b33. ; <sp> al. w0 a110. ; jl. w3 b30. ; <name> am. (j0.) ; bl. w1 j8. ; w1:=addr.table(cause); jl. w3 x1+b30. ; outtext(text(cause)); jl. b2. ; goto end program; j0: 0 ; cause ; text address table ; for causes -1,0,1,2,3,4,5,6 h. j8=k+1 b43-b30,b44-b30,b50-b30,b39-b30 b48-b30,b42-b30,b46-b30,b42-b30 b49-b30,b48-b30 ;texts: ;change kind impos.,,change bs device,no room,bs device unknown ;error,no resources,entry in use,no resources ;catalog error,error w. \f ;rc 22.05.72 fp utility, system 3, cat adm 1 ...15... ;set entry continued: j2: al. w1 a119. ; change entry: jd 1<11+76 ; lookup entry (name); sn w0 0 ; if not found then jl. j4. ; begin j3: al w0 1 ; name conflict: jl. j1. ; goto result 1 ; end j4: rl. w0 a127. ; check kind: w0:=kind(old entry); rl. w1 a87. ; w1:=kind(wanted); sl w0 0 ; if kind(old entry) < 0 sh w1 -1 ; or kind(wanted) < 0 jl. j7. ; then goto test kinds; rl. w1 a88. ; compare device names: sh w1 1 ; if device name(wanted) <= 1 jl. j5. ; then goto change; dl. w1 a129. ; sn. w0 (a88.) ; compare: se. w1 (a89.) ; if doc name(old entry) jl. j6. ; < > dl. w1 a130. ; doc.name(wanted) sn. w0 (a136.) ; then se. w1 (a90.) ; goto change bs device error; jl. j6. ; j5: al. w1 a87. ; change the entry: jd 1<11+44 ; change(old entry,wanted tail); sn w0 0 ; if ok then jl. b2. ; goto end program; jl. j1. ; else goto error; j7: sh w0 -1 ; test kinds: sl w1 0 ; if any of the two kind >= 0 jl. j9. ; then goto change kind error; jl. j5. ; goto change j9: al w0 -1 ; goto jl. j1. ; error -1; e. \f ;rc 21.02.74 fp utility, system 3, cat adm 1 ...16... ;the program entry b. c22 w. ;procedure lookup entry(param) ; ;used during interpretation of the parameters. an entry with the ;name given in the item addressed by w2 is looked up in the area ;a112 to a135 (if the name is equeal to the name in the last ;lookup a new lookup is not made). if the entry is not found ;the return is to link if found the return is to link+2. ; ; ; call return ;w0 undefined ;w1 undefined ;w2 addr of item unchanged ;w3 link undefined b. j2 w. j0: 0 ; saved link c0: dl w1 x2+4 ; compare name with name3: sn. w0 (a115.) ; if first half param <> se. w1 (a116.) ; first half name3 then jl. j1. ; then goto lookup entry; dl w1 x2+8 ; if second half param <> sn. w0 (a117.) ; second half of name3 se. w1 (a118.) ; then jl. j1. ; then goto lookup entry; jl x3+2 ; name was old one: return to link+2; j1: rs. w3 j0. ; lookup entry: al w3 x2+2 ; w3:=name address; al. w1 a119. ; w1:=address of lookup area; jd 1<11+76 ; lookup head and tail; rl. w3 j0. ; sn w0 0 ; if found then jl x3+2 ; return to link+2 jl x3 ; else return to link; e. ;error message because param not found: c11: jl. w3 b12. ; error message: jl. w3 b4. ; <prog.nam> <param> jl. w3 b37. ; unknown; jl. b2. ; goto end program; \f ; fgs 1988.10.13 fp utility, system 3, cat adm 1 ...17... ;entry page 2 : ;start program itself: g6: am 1 ; entry changeentry g5: am 1 ; entry assign g8: al w1 0 ; entry entry rs. w1 a27. ; jl. w1 b0. ; start: init program; jl. c1. ; if no left side jl. b25. ; then goto call error; c1: rl. w3 a1. ; move name: dl w1 x3+4 ; move left side name ds. w1 a111. ; to dl w1 x3+8 ; name ds. w1 a113. ; area no 2; rl. w0 a27. ; if program=changeentry sh w0 1 ; then jl. c19. ; begin al. w3 a110. ; w3:=name addr al. w1 a119. ; w1:=addr lookup area jd 1<11+76 ; lookup head and tail sn w0 0 ; jl. c19. ; if not found then alarm am 1 ; 1=unknown al w0 0 ; 0=version error rs. w0 a27. ; jl. w3 b12. ; error message ***prog.name jl. w3 b33. ; outspace(1) al. w0 a110. ; outtext jl. w3 h31.-2+10000 ; left side name rl. w0 a27. ; se w0 1 ; jl. c17. ; jl. w3 b37. ; outtext(unknown) jl. b2. ; goto end program ; end; c17: rl. w0 a131. ; jl. w3 h32.-2+10000 ; outinteger(oldversion) 1<23+32<12+1 ; jl. w3 b32. ; outcr jl. b2. ; goto end program ; end c19: rl. w0 a27. ; se w0 1 ; if assign then jl. c20. ; begin jl. w3 b27. ; get param jl. b80. ; if endparam then goto setentry sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name then jl. b13. ; alarm param al. w1 a87. ; al w3 x2+2 ; jd 1<11+42 ; lookup param se w0 0 ; if not found then jl. c11. ; error; rl. w0 a87. ; sz. w0 (a138.) ; if modekind = area jl. c22. ; then begin rl. w0 a137. ; rs. w0 a87. ; modekind:=bs; dl w1 x2+4 ; ds. w1 a89. ; move docname; dl w1 x2+8 ; ds. w1 a90. ; end; c22: jl. w3 b27. ; get param; jl. b80. ; if endparam then setentry jl. b13. ; else alarm param ; end; c20: jl. w3 b27. ; get kind: next compound param; jl. b80. ; end list: goto set entry; sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name jl. c4. ; then goto store kind; dl w1 x2+4 ; search in mode.kind table: al. w3 a26. ; index:=first of table; c2: sn w0 (x3) ; compare: if param se w1 (x3+2) ; <> table(index) jl. c3. ; then goto step index; rl w1 x3+4 ; found: w1:=table(index); jl. c4. ; goto store kind; c3: al w3 x3+6 ; step index: index:=index+6; se. w3 a27. ; if not end table jl. c2. ; then goto compare; jl. w3 c0. ; lookup kind param: lookup entry(param); jl. c11. ; if not found then error; rl. w1 a127. ; w1:=kind(entry(param)); c4: rs. w1 a87. ; store kind: kind:=w1; jl. w3 b27. ; get doc name: next comp. param; jl. b80. ; end list: goto set entry; sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name jl. c9. ; then goto integer doc name; rl. w1 a87. ; sn. w1 (a103.) ; if kind = bs jl. c5. ; then goto move doc.name; jl. w3 c0. ; lookup entry(param); jl. c5. ; fi not found then goto move name; al. w2 a127. ; addr:=doc.name(entry) - 2; c5: dl w1 x2+4 ; move doc.name: ds. w1 a89. ; dl w1 x2+8 ; ds. w1 a90. ; \f ; fgs 1988.11.30 fp utility, system 3, cat adm 1 ...18... ;entry page 3 c6: al w3 0 ; rest of tail: count:=0; rl. w2 a2. ; ba w2 x2+1 ; if nextsep=endsep rl w0 x2 ; goto setclock; sh. w0 (a25.) ; jl. b22. ; c7: rs. w3 c10. ; next item: save count; jl. w3 b11. ; step pointer; jl. b80. ; if end list then set entry; rl. w3 c10. ; test count: get count; sl w3 10 ; if count >= 10 jl. b13. ; then goto parameter error; se w3 0 ; if count <> 0 then jl. c16. ; examine separator; sh. w0 (a123.) ; if param > 4 < 12 + longest name sh. w0 (a223.) ; or param < 4 < 12 + shortest name jl. c16. ; goto eamine separator; jl. w1 c21. ; test if date; c16: ba w2 x2+1 ; examine separator: bl w2 x2 ; sn w2 8 ; if next seperator = point then jl. c8. ; goto maybe left byte; so w3 1 ; word or right byte: if count is jl. c14. ; even then goto word; c13: jl. w2 c12. ; store byte: get byte; hs. w0 x3+a91. ; store byte; al w3 x3+1 ; count:=count+1; jl. c7. ; goto next item; c14: jl. w2 c15. ; word: get word; rs. w0 x3+a91. ; store word; al w3 x3+2 ; count:=count+2; jl. c7. ; goto next item; c8: sz w3 1 ; maybe left byte: if count is jl. b13. ; odd then paramerror; jl. c13. ; goto store byte; c9: sl w1 0 ; integer doc.name: sl w1 4 ; if <0 or >= 4 jl. b13. ; then param error; rs. w1 a88. ; set param in tail; jl. c6. ; goto rest of tail; c10: 0 ; count b22: dl w1 110 ; set shortclock: ld w1 5 ; save shortclock; rs. w0 a91. ; jl. b80. ; goto set entry; ;procedures get param byte,get param integer; ; ;if the current parameter in the fp command stack is ;an integer the value is given. if the parameter is a ;name the name is searched in the catalog and the field ;in the entry found addressed by the value of w3 is ;given. ;if the entry is not found an error exit is used. ; ;note that w2 is used as link ******* ; ; call return ; ; w0 value ; w1 destroyed ; w2 link destroyed ; w3 index unchanged b. j5 w. j0: 0 ; saved w2 = link j5: 0 ; saved w3 j1: bz. w0 x3+0 ; byte instruction j2: rl. w0 x3+0 ; word instruction c12: am j1-j2 ; get byte: instruction:=bz; c15: bz. w0 j2. ; get word: instruction:=rl; hs. w0 j3. ; ds. w3 j5. ; save link,w3; rl. w2 a2. ; get param; bz w1 x2+1 ; if param <> name rl w0 x2+2 ; then sh w1 9 ; w0:=value and jl. (j0.) ; return; jl. w3 c0. ; name: lookup entry; jl. c11. ; not found: goto error; dl. w3 j5. ; found: restore w2,w3; j3: rl. w0 x3+a131. ; get word or byte (instruction set above) jl x2 ; return e. ; end procedure c21: ; test if date, program entry and changeentry b. j1 w. rs. w1 j1. ; save return rl w0 x2+2 ; if name<><:d:> se. w0 (a30.) ; then jl x1 ; return; rl w0 x2+10 ; if nextsep<> se. w0 (a29.) ; pointinteger then jl x1 ; return; rl w0 x2+14 ; w0:=nextnextsep; rl w1 x2+16 ; clock; sn. w0 (a29.) ; if nextnextsep<>pointinteger jl. j0. ; then jl. w3 c0. ; begin lookup(d); jl. 6 ; if found then begin rl. w3 c10. ; w3:=count; jl. (j1.) ; return end; al w1 0 ; clock:=0 end; j0: rl w0 x2+12 ; date; jl. w3 b79. ; transform date and clock jl. b13. ; if dateerror then paramerror; rs. w0 a91. ; save shortclock; jl. w3 b11. ; nextparam; am rl w0 x2+4 ; if nextsep=pointinteger sn. w0 (a29.) ; then jl. w3 b11. ; nextparam; am rl. w3 c10. ; al w3 x3+2 ; count:=count+2; jl. c7. ; goto nextitem; j1: 0 ; saved return e. e. b79: ; procedure transform date and clock to shortclock ; entry exit ; w0 yymmdd shortclock ; w1 hhmm destroyed ; w2 - - ; w3 return addr if alarm then return to x3 else x3+2 b. a2, b6, c12 w. rs. w0 b0. ; save w0 ds. w3 b1. ; save w2 w3 ba w0 2 ; w0:=date+clock; sn w0 0 ; if date+clock=0 jl. a2. ; goto special; al w0 0 ; wd. w1 c0. ; sl w0 60 ; if minutes>=60 jl. a1. ; then alarm; sl w1 25 ; if hours>25 then jl. a1. ; alarm rs. w0 b2. ; save minutes rs. w1 b3. ; save hours al w0 0 ; rl. w1 b0. ; yymmdd wd. w1 c0. ; rs. w0 b4. ; save days sl w0 32 ; if days>=32 jl. a1. ; then alarm al w0 0 ; wd. w1 c0. ; rs. w0 b5. ; save months sl w0 13 ; if months>=13 jl. a1. ; then alarm rs. w1 b6. ; save years sl w1 100 ; if years>99 jl. a1. ; then alarm; rl. w1 b6. ; rl. w2 b5. ; sl w2 3 ; if months<3 then jl. a0. ; begin years:=years-1; al w1 x1-1 ; months:=months+12; al w2 x2+12 ; end; a0: al w1 x1-68 wm. w1 c8. ; as w1 -2 ; days:=(year-68)*1461/4 ba. w1 x2+c12. ; +monthstable(months) wa. w1 b4. ; + days wm. w1 c4. ; wa. w1 b3. ; hours:=days*24+hours wm. w1 c5. ; al w2 0 ; rl. w3 b2. ; aa w1 6 ; min:=hours*60+min; wd. w1 c2. ; fourmin:=min/4 wm. w0 c5. ; min:=min mod 4; wm. w0 c9. ; al w2 0 ; msec:=min*60*10000; rl w3 0 ; wm. w1 c11. ; aa w1 6 ; clock:=fourmin*2400000+msec jl. 4 ; special: a2: dl w1 110 ; (clock:=rc4000clock;) ld w1 5 ; shift(5-24) extract 24; dl. w3 b1. ; restore w2 w3 jl x3+2 ; normal return a1: dl. w3 b1. ; restore w2 w3 jl x3 ; alarm return b0: 0 ; saved w0 0 ; saved w2 b1: 0 ; saved w3 b2: 0 ; minutes b3: 0 ; hours b4: 0 ; days b5: 0 ; months b6: 0 ; year c0: 100 ; c1: 10 ; c2: 4 ; c3: 15 ; c4: 24 ; c5: 60 ; c6: 360 ; c7: 365 ; c8: 1461 ; c9: 10000 ; c10: 600000 ; c11: 2400000 ; h.c12=k-1, 0,31,59,90,120,151,181,212,243,273,304,334,365,396 e. \f ; fgs 1982.12.17 fp utility, system 3, cat adm 1 ...19... ;the program rename: b. c5 w. g9: jl. w1 b0. ; start: init program; jl. b25. ; if left side then call error; c1: jl. w3 b11. ; next rename: next param; jl. b2. ; end list: goto end program; rl w1 x2+10 ; sn. w0 (a23.) ; if del,kind <> space,name se. w1 (a24.) ; or next del,kind <> point,name jl. b13. ; then goto paramerror; bz w3 x2+20 ; if second next delim sn w3 8 ; is = point jl. b13. ; then paramerror; jl. w3 b11. ; next param; ps -4 ; end list:testoutput; al w3 x2-8 ; al w1 x2+2 ; jd 1<11+46 ; rename entry; sn w0 0 ; if ok jl. c1. ; then goto next rename; sn w0 3 ; if result=3 then jl. c2. ; unknown or nam.conflict; c5: rs. w0 c3. ; error message: save result; jl. w3 b12. ; <prog.name> al w2 x2-10 ; <parameter> jl. w3 b4. ; am. (c3.) ; bl. w1 c4. ; outtext(text(result)) jl. w3 x1+b30. ; jl. c1. ; goto next rename; c2: al. w1 a87. ; unknown or confl: jd 1<11+42 ; lookup entry(old name); se w0 0 ; if entry unknown then al w0 3 ; result:=3 else jl. c5. ; result:=0; goto error message; c3: 0 ; result; ;table of result texts h. c4:b45-b30,b50-b30,b48-b30,b37-b30,b47-b30,b46-b30 w. e. \f ;rc 4.11.75 fp utility, system 3, cat adm 1 ...19a... ;the program permanent: b. c4 w. g10: jl. w1 b0. ; start: init program; jl. b25. ; if left side then call error; c1: jl. w3 b11. ; next permanent: next param; jl. b2. ; end list: goto end program; rl w1 x2+10 ; sn. w0 (a23.) ; if del,kind <> space,name se. w1 (a29.) ; or next del,kind <> point,integer jl. b13. ; then goto paramerror; bz w3 x2+20 ; if second next delim sn w3 8 ; is = point jl. b13. ; then paramerror; jl. w3 b11. ; next param; ps -4 ; end list:testoutput; al w3 x2-8 ; rl w1 x2+2 ; jd 1<11+50 ; permanent entry; sn w0 0 ; if ok jl. c1. ; then goto next permanent; rs. w0 c3. ; error message: save result; jl. w3 b12. ; <prog.name> al w2 x2-10 ; <parameter> jl. w3 b4. ; am. (c3.) ; am -2 ; bl. w1 c4. ; outtext(text(result)) jl. w3 x1+b30. ; jl. c1. ; goto next permanent; c3: 0 ; result; ;table of result texts h. c4:b48-b30,b37-b30,b47-b30,b46-b30,b42-b30 w. e. \f ; rc 76.05.31 cat adm 1 ...19b... ; setmt clearmt s. a1, b31, c22, d3 w. a1=99;max fileparam g15: am 8 ; entry clear version g14: al w0 -1<11+40; entry set version hs. w0 d0. ; monitorcall:=remove or create entry dl w1 x3+4 ; ds. w1 b1. ; dl w1 x3+8 ; ds. w1 b2. ; save programname for error messages sn w2 x3 ; jl. c1. ; if no left then error1 rl w0 x2+8 ; se w0 0 ; jl. c1. ; if more than 9 char then error1 rl w0 x2+20 ; rl w3 x2+30 ; sn. w0 (b3.) ; se. w3 (b4.) ; jl. c2. ; if params<> name.integer then error2 bl w0 x2+34 ; sl w0 4 ; if -,endsep then jl. w3 d3. ; goto limits; rl w0 x2+32 ; sl w0 0 ; sl w0 a1+1 ; jl. c2. ; if max file>max fileparam then error2 rs. w0 b5. ; save max file dl w0 x2+24 ; ds. w0 b8. ; dl w0 x2+28 ; ds. w0 b9. ; set docname dl w1 110 ld w1 5 rs. w0 b13. ; save shortclock dl w0 x2+4 ; save given entryname ds. w0 b21. ; ds. w0 b24. ; dl w0 x2+8 ; ds. w0 b22. ; ds. w0 b25. ; al. w1 b6. ; al. w2 b23. ; c9: al w3 -16 ; c10: rl w0 x2 ; ls w0 x3 ; sz w0 255 ; jl. c11. ; jl. c12. ; c11: al w3 x3+8 ; sh w3 0 ; jl. c10. ; al w1 x1+2 ; al w2 x2+2 ; jl. c9. ; c12: ac w3 x3 ; rs. w3 b26. ; ds. w2 b28. ; al w3 x3-8 ; sl w3 0 ; jl. c13. ; al w3 16 ; al w1 x1+2 ; al w2 x2+2 ; jl. 4 ; c13: al w2 x1 ; rs. w3 b29. ; ds. w2 b31. ; save words and shifts for entryno. am -2 ; al. w3 b8. ; al. w1 c19. ; jd 1<11+42 ; lookup docname param se w0 0 ; if found then jl. c6. ; begin rl. w0 c19. ; rs. w0 b7. ; move modekind dl. w0 c20. ; move docname ds. w0 b8. ; from dl. w0 c21. ; lookuparaea ds. w0 b9. ; rl. w3 c22. ; move fileno ba. w3 d1. ; add fileno hs. w3 d1. ; end; c6: al. w3 b6. ; d1=k+1 al w2 1 ; rs. w2 b10. ; d2=k+1 al w2 1 ; file:=1 c0: rs. w2 b11. ; om:save file al w1 0 ; wd. w2 b12. ; se w2 0 ; jl. c14. ; al w2 x1 ; al w1 -48 ; c14: al w1 x1+48 ; al w2 x2+48 ; ls. w2 (b26.) ; lo. w2 (b28.) ; rs. w2 (b27.) ; ls. w1 (b29.) ; lo. w1 (b31.) ; rs. w1 (b30.) ; set entryno. in entryname al. w1 b7. ; d0=k+1 ; monitor call will be either jd 1<11+48; create or remove entry depending on entry sn w0 0 ; of program jl. c16. ; al w1 8 ; sz. w1 (d0.) ; jl. c15. ; if setmt then goto createerror sn w0 3 ; removeerror: jl. c3. ; if not found then error3 jl. c4. ; else error4 c15: ; createerror: sn w0 4 ; jl. c5. ; if no resources then error5 se w0 3 ; jl. c4. ; if no name conflict then error4 al. w3 b6. ; w3:=name addr jd 1<11+48; remove old entry se w0 0 ; jl. c4. ; if remove not pos. then error4 al. w1 b7. ; w1:=tail addr jd 1<11+40; create entry se w0 0 ; if not ok then jl. c15. ; goto createrror c16: rl. w2 b10. ; al w2 x2+1 ; file:=file+1 rs. w2 b10. ; rl. w2 b11. ; al w2 x2+1 ; sh. w2 (b5.) ; jl. c0. ; if file <=max file then om jl. c8. ; else exit d3: sn. w0 (b4.) ; if nextsep<>pointint jl. c2. ; then alarm2; rl w0 x2+32 ; hs. w0 d1. ; hs. w0 d2. ; save lower limit; bl w0 x2+38 ; sl w0 4 ; if nextsep<>endparam jl. c2. ; then alarm2; rl w0 x2+36 ; if lower>upper ws w0 x2+32 ; then alarm2; sh w0 -1 ; jl. c2. ; rl w0 x2+36 ; maxparam; jl x3+2 ; return b0:<:***:> ; progname for error messages 0 b1:0 0 b2:0 h. b3:4,10 ; sp.name b4:8,4 ; point.integer w. b5:0 ; max file b6:0 ; entry name var b21:0 0 b22:0 b7:1<23+18 ; tail 0 b8:0 ; docname 0 b9:0 b13:0 ; shortclock b10:0,r.4 ; file b11:0 b12:10 b23:0 ; entryname bas b24:0 0 b25:0 b26:0 b27:0 b28:0 b29:0 b30:0 b31:0 b14:<: call<10><0>:> ; errortext 1, used by both b15:<: param<10>:> ; errortext 2, used by both b16:<: unknown<10><0>:> ; errortext 3, used by clearmt b17:<: catalog error<10><0>:>; errortext 4, used by both b18:<: no resources<10>:>; errortext 5, used by setmt c1: am b14-b15; error1 c2: am b15-b16; error2 c3: am b16-b17; error3 c4: am b17-b18; error4 c5: al. w0 b18. ; error5 rs. w0 c18. ; select errortext al. w0 b0. ; am -2048 jl. w3 h31.-2+12048 ; write program name rl. w0 c18. ; sh. w0 b15. ; jl. c17. ; if error>2 then al w2 32 ; begin am -2048 jl. w3 h26.-2+12048 ; writesp al. w0 b6. ; writetext entryname am -2048 jl. w3 h31.-2+12048 ; end; c17: rl. w0 c18. ; am -2048 jl. w3 h31.-2+12048 ; write errortext al. w3 b6. ; w3:=name addr. rl. w0 c18. ; if error3 then sn. w0 b16. ; goto next file jl. c16. ; c7: am 1 ; errorexit: sorry:=1 c8: al w2 0 ; exit: or 0 am -2048 jl. w3 h7.+12048; fpexit c18: 0 ; saved error text addr c19: 0 ; lookup area 0 ; docname c20: 0 ; 0 c21: 0 0 c22: 0 e. g2=k-g3 \f ;rc 78.03.18 fp utility, cat adm 1 ...20... ;working locations: a110: 0 ; name area 2 a111: 0 ; a112: 0 ; a113: 0 ; a114: 0 ; a119: 0 ; entry area: start of head a120: 0 ; interval lower a121: 0 ; interval upper a115: 0 ; name area 3 a116: 0 ; a117: 0 ; a118: 0 ; a127: 0 ; tail: kind a128: 0 ; a129: 0,r.2 ; a130: 0 ; a131: 0 ; a132: 0 ; a133: 0 ; a134: 0 ; a135: 0 ; a137: 1<23+4 ; bs-code a138: 1<23 ; sign bit \f ;fgs 1984.06.18 cat adm 1, tails i. m.rc 1988.12.20 fp utility, sys 3, cat adm 1 m. set,setmt,clearmt,entry,changeentry,assign,rename,permanent,nextfile e. w. g0: (:g2+511:)>9 ; entry set 0,r.4 s2 ; month year 0,r.2 2<12+g7-g3 g2 1<23+4 ; entry setmt 0, r.4 s2 ; date 0, 0 2<12+g14-g3 g2 1<23+4 ; entry clearmt 0, r.4 s2 0,0 2<12+g15-g3 g2 1<23+4 ; entry entry 0,r.4 s2 ; month year 0,r.2 2<12+g8-g3 g2 1<23+4 ; entry changeentry 0, r.4 s2 ; date 0, r.2 2<12+g6-g3 g2 1<23+4 ; entry assign 0, r.4 s2 ; date 0,0 2<12+g5-g3 g2 1<23+4 ; entry rename 0,r.4 s2 ; month year 0,r.2 2<12+g9-g3 g2 1<23+4 ; entry permanent 0,r.4 s2 ; date 0,0 2<12+g10-g3 g2 ; length g1: 1<23+4 ; entry nextfile 0,r.4 s2 ; month year 0,r.2 2<12+g11-g3 g2 \f d. p.<:insertproc:> l. e. ▶EOF◀