(,}+ ,}DUMPTOOLJMS P 060381(0INPUT=DUMPTOOL 00010UTIL 00020DUMP,FN=COSYLOAD,OW=$$ 00030DUMP,FN=CSYLOD ,OW=$$ 00040DUMP,FN=DDT ,OW=$$ 00050DUMP,FN=DMPMST ,OW=$$ 00060DUMP,FN=LIST ,OW=$$ 0007000DUMP,FN=MON ,OW=$$ 00080DUMP,FN=MOVDEL ,OW=$$ 00090DUMP,FN=MOVE ,OW=$$ 00100DUMP,FN=MOVEID ,OW=$$ 00110DUMP,FN=RBUILD ,OW=$$ 00120DUMP,FN=REDUCE ,OW=$$ 00130DUMP,FN=SNARF ,OW=$$ 0014000DUMP,FN=SP ,OW=$$ 00150DUMP,FN=SREDUC ,OW=$$ 00160DUMP,FN=TIMSTAMP,OW=$$ 00170DUMP,FN=VOLSON ,OW=$$ 00180DUMP,FN=WATZIT ,OW=$$ 00190DUMP,FN=WEAVE ,OW=$$ 00200DUMP,FN=TABIT ,OW=LIBRARY 0021000DUMP,FN=TABLKSIO,OW=LIBRARY 00220DUMP,FN=TACHO2LR,OW=LIBRARY 00230DUMP,FN=TADEFFIO,OW=LIBRARY 00240DUMP,FN=TAFDWMTH,OW=LIBRARY 00250DUMP,FN=TAFRHX ,OW=LIBRARY 00260DUMP,FN=TAGETVIT,OW=LIBRARY 00270DUMP,FN=TALOCF ,OW=LIBRARY 0028000DUMP,FN=TAMEMORY,OW=LIBRARY 00290DUMP,FN=TAMPWRXX,OW=LIBRARY 00300DUMP,FN=TANDWMTH,OW=LIBRARY 00310DUMP,FN=TAQ8CMP ,OW=LIBRARY 00320DUMP,FN=TARAO ,OW=LIBRARY 00330DUMP,FN=TASEKVIT,OW=LIBRARY 00340DUMP,FN=TASYSMSG,OW=LIBRARY 0035000DUMP,FN=TAVDC ,OW=LIBRARY 00360DUMP,FN=TAVLTOI ,OW=LIBRARY 00370DUMP,FN=TAWTRD ,OW=LIBRARY 00380DUMP,FN=TFADD ,OW=LIBRARY 00390DUMP,FN=TFAINPUT,OW=LIBRARY 00400DUMP,FN=TFASCII ,OW=LIBRARY 00410DUMP,FN=TFBATS ,OW=LIBRARY 0042000DUMP,FN=TFBATSUM,OW=LIBRARY 00430DUMP,FN=TFBLANK ,OW=LIBRARY 00440DUMP,FN=TFCATAPE,OW=LIBRARY 00450DUMP,FN=TFCDS ,OW=LIBRARY 00460DUMP,FN=TFCHEAT ,OW=LIBRARY 00470DUMP,FN=TFCHG ,OW=LIBRARY 00480DUMP,FN=TFCHKDEF,OW=LIBRARY 0049000DUMP,FN=TFCHKFDB,OW=LIBRARY 00500DUMP,FN=TFCHKFDD,OW=LIBRARY 00510DUMP,FN=TFCHKHDR,OW=LIBRARY 00520DUMP,FN=TFCKSTR ,OW=LIBRARY 00530DUMP,FN=TFCNV2W ,OW=LIBRARY 00540DUMP,FN=TFCNVSTR,OW=LIBRARY 00550DUMP,FN=TFCONVER,OW=LIBRARY 0056000DUMP,FN=TFCOPY ,OW=LIBRARY 00570DUMP,FN=TFCSYLOD,OW=LIBRARY 00580DUMP,FN=TFDATTIM,OW=LIBRARY 00590DUMP,FN=TFDDSUBS,OW=LIBRARY 00600DUMP,FN=TFDEFILE,OW=LIBRARY 00610DUMP,FN=TFDEFSFL,OW=LIBRARY 00620DUMP,FN=TFDEL ,OW=LIBRARY 0063000DUMP,FN=TFDELFIL,OW=LIBRARY 00640DUMP,FN=TFDFINIT,OW=LIBRARY 00650DUMP,FN=TFDHOLE ,OW=LIBRARY 00660DUMP,FN=TFDMPFCB,OW=LIBRARY 00670DUMP,FN=TFDSKERR,OW=LIBRARY 00680DUMP,FN=TFDUPL ,OW=LIBRARY 00690DUMP,FN=TFECHO ,OW=LIBRARY 0070000DUMP,FN=TFEXTEND,OW=LIBRARY 00710DUMP,FN=TFFCBADR,OW=LIBRARY 00720DUMP,FN=TFFETFCB,OW=LIBRARY 00730DUMP,FN=TFFILES ,OW=LIBRARY 00740DUMP,FN=TFFILLIT,OW=LIBRARY 00750DUMP,FN=TFFMTFCB,OW=LIBRARY 00760DUMP,FN=TFGCNVRT,OW=LIBRARY 0077000DUMP,FN=TFGENREC,OW=LIBRARY 00780DUMP,FN=TFGENRPT,OW=LIBRARY 00790DUMP,FN=TFGETVOL,OW=LIBRARY 00800DUMP,FN=TFGINPUT,OW=LIBRARY 00810DUMP,FN=TFGTDATA,OW=LIBRARY 00820DUMP,FN=TFGTPARM,OW=LIBRARY 00830DUMP,FN=TFHASH ,OW=LIBRARY 0084000DUMP,FN=TFHEXASC,OW=LIBRARY 00850DUMP,FN=TFHEXDEC,OW=LIBRARY 00860DUMP,FN=TFICNVRT,OW=LIBRARY 00870DUMP,FN=TFIINPUT,OW=LIBRARY 00880DUMP,FN=TFINIT ,OW=LIBRARY 00890DUMP,FN=TFLASTCH,OW=LIBRARY 00900DUMP,FN=TFLBASIC,OW=LIBRARY 0091000DUMP,FN=TFLHOLES,OW=LIBRARY 00920DUMP,FN=TFLIST ,OW=LIBRARY 00930DUMP,FN=TFLST ,OW=LIBRARY 00940DUMP,FN=TFLSTAPE,OW=LIBRARY 00950DUMP,FN=TFLSTBAS,OW=LIBRARY 00960DUMP,FN=TFLSTBIN,OW=LIBRARY 00970DUMP,FN=TFLSTMIO,OW=LIBRARY 0098000DUMP,FN=TFLSTSIO,OW=LIBRARY 00990DUMP,FN=TFLUREAD,OW=LIBRARY 01000DUMP,FN=TFMMREAD,OW=LIBRARY 01010DUMP,FN=TFMMWRIT,OW=LIBRARY 01020DUMP,FN=TFMPFACE,OW=LIBRARY 01030DUMP,FN=TFMRKHDR,OW=LIBRARY 01040DUMP,FN=TFMSG ,OW=LIBRARY 0105000DUMP,FN=TFMTBLEN,OW=LIBRARY 01060DUMP,FN=TFNFETCH,OW=LIBRARY 01070DUMP,FN=TFNXTFCB,OW=LIBRARY 01080DUMP,FN=TFOWNER ,OW=LIBRARY 01090DUMP,FN=TFPAGE1 ,OW=LIBRARY 01100DUMP,FN=TFPRCHEK,OW=LIBRARY 01110DUMP,FN=TFPRINIT,OW=LIBRARY 0112000DUMP,FN=TFPROMPT,OW=LIBRARY 01130DUMP,FN=TFPROVE ,OW=LIBRARY 01140DUMP,FN=TFPROVRM,OW=LIBRARY 01150DUMP,FN=TFQUIET ,OW=LIBRARY 01160DUMP,FN=TFREMOVE,OW=LIBRARY 01170DUMP,FN=TFREPL ,OW=LIBRARY 01180DUMP,FN=TFRETSFL,OW=LIBRARY 0119000DUMP,FN=TFRIPSSP,OW=LIBRARY 01200DUMP,FN=TFSCAN ,OW=LIBRARY 01210DUMP,FN=TFSETKEY,OW=LIBRARY 01220DUMP,FN=TFSNARF ,OW=LIBRARY 01230DUMP,FN=TFSQINIT,OW=LIBRARY 01240DUMP,FN=TFSQUIRM,OW=LIBRARY 01250DUMP,FN=TFSQUISH,OW=LIBRARY 0126000DUMP,FN=TFSSINIT,OW=LIBRARY 01270DUMP,FN=TFSSP ,OW=LIBRARY 01280DUMP,FN=TFSTAT ,OW=LIBRARY 01290DUMP,FN=TFSUBRCM,OW=LIBRARY 01300DUMP,FN=TFTAPEUT,OW=LIBRARY 01310DUMP,FN=TFTRM ,OW=LIBRARY 01320DUMP,FN=TFTWCMPR,OW=LIBRARY 0133000DUMP,FN=TFUSERID,OW=LIBRARY 01340DUMP,FN=TFUSRSQU,OW=LIBRARY 01350DUMP,FN=TFVALTID,OW=LIBRARY 01360DUMP,FN=TFWATZIT,OW=LIBRARY 01370DUMP,FN=TFWCMTCH,OW=LIBRARY 01380DUMP,FN=TFWEAVE ,OW=LIBRARY 01390DUMP,FN=TFZCNVRT,OW=LIBRARY 0140000DUMP,FN=TFZERO ,OW=LIBRARY 01410DUMP,FN=TFZINPUT,OW=LIBRARY 01420DUMP,FN=TMFMUCOM,OW=LIBRARY 01430DUMP,FN=TPUTMAC ,OW=LIBRARY 01440DUMP,FN=TPUTPROC,OW=LIBRARY 01450DUMP,FN=TXBIN ,OW=LIBRARY 01460DUMP,FN=TXDMPFCB,OW=LIBRARY 0147000DUMP,FN=TXFCBTTL,OW=LIBRARY 01480DUMP,FN=TXFTNJOB,OW=LIBRARY 01490DUMP,FN=TXINSTAL,OW=LIBRARY 01500DUMP,FN=TXJOB ,OW=LIBRARY 01510DUMP,FN=TXLSTBLK,OW=LIBRARY 01520DUMP,FN=TXPRVBLK,OW=LIBRARY 01530DUMP,FN=TXSQUBLK,OW=LIBRARY 0154000DUMP,FN=TXSSPBLK,OW=LIBRARY 01550DUMP,FN=WABIN ,OW=LIBRARY 01560DUMP,FN=WASKEL ,OW=LIBRARY 01570DUMP,FN=WFBIN ,OW=LIBRARY 01580DUMP,FN=WFSKEL ,OW=LIBRARY 01590DUMP,FN=WSBATS ,OW=LIBRARY 01600DUMP,FN=WSBATSUM,OW=LIBRARY 0161000DUMP,FN=WSCATAPE,OW=LIBRARY 01620DUMP,FN=WSCHEAT ,OW=LIBRARY 01630DUMP,FN=WSDEFILE,OW=LIBRARY 01640DUMP,FN=WSDELFIL,OW=LIBRARY 01650DUMP,FN=WSDMPFCB,OW=LIBRARY 01660DUMP,FN=WSEXTEND,OW=LIBRARY 01670DUMP,FN=WSFCBADR,OW=LIBRARY 0168000DUMP,FN=WSLIST ,OW=LIBRARY 01690DUMP,FN=WSPROVE ,OW=LIBRARY 01700DUMP,FN=WSSQUISH,OW=LIBRARY 01710DUMP,FN=WSSSP ,OW=LIBRARY 01720DUMP,FN=WSSTAT ,OW=LIBRARY 01730DUMP,FN=WSTPUTPR,OW=LIBRARY 01740DUMP,FN=WSUSERID,OW=LIBRARY 0175000DUMP,FN=WSUSRBLK,OW=LIBRARY 01760DUMP,FN=WSUSRDAT,OW=LIBRARY 01770DUMP,FN=WSWATZIT,OW=LIBRARY 01780DUMP,FN=WSWEAVE ,OW=LIBRARY 01790DUMP,FN=TACCSBLK,OW=CCS30 01800DUMP,FN=TACCSCST,OW=CCS30 01810DUMP,FN=TACCSGET,OW=CCS30 0182000DUMP,FN=TACCSMVA,OW=CCS30 01830DUMP,FN=TACCSPUT,OW=CCS30 01840DUMP,FN=TFFILERR,OW=CCS30 01850DUMP,FN=TFMOVE ,OW=DRG 01860DUMP,FN=TFMOVEID,OW=DRG 01870DUMP,FN=TFRANF ,OW=DRG 01880DUMP,FN=QUINN01 ,OW=JMS 0189000DUMP,FN=QUINN02 ,OW=JMS 01900DUMP,FN=QUINN03 ,OW=JMS 01910DUMP,FN=QUINN04 ,OW=JMS 01920DUMP,FN=QUINN05 ,OW=JMS 01930DUMP,FN=QUINN06 ,OW=JMS 01940DUMP,FN=QUINN07 ,OW=JMS 01950DUMP,FN=QUINN08 ,OW=JMS 0196000DUMP,FN=QUINN09 ,OW=JMS 01970DUMP,FN=QUINN10 ,OW=JMS 01980DUMP,FN=QUINN11 ,OW=JMS 01990DUMP,FN=QUINN12 ,OW=JMS 02000DUMP,FN=QUINN13 ,OW=JMS 02010DUMP,FN=QUINN14 ,OW=JMS 02020DUMP,FN=QUINN15 ,OW=JMS 0203000DUMP,FN=QUINN16 ,OW=JMS 02040DUMP,FN=QUINN17 ,OW=JMS 02050DUMP,FN=QUINN18 ,OW=JMS 02060DUMP,FN=QUINN19 ,OW=JMS 02070DUMP,FN=QUINN20 ,OW=JMS 02080DUMP,FN=QUINN21 ,OW=JMS 02090DUMP,FN=QUINN22 ,OW=JMS 0210000DUMP,FN=QUINN23 ,OW=JMS 02110DUMP,FN=QUINN24 ,OW=JMS 02120DUMP,FN=PROTON ,OW=JMS 02130DUMP,FN=PROTON.D,OW=JMS 02140EX 02150CAT6 02160_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0`.K!.T.COSYLOAD$$ ` @vΓK NSh-A)  K Tө @ml fNܑ̝ !\ԄPnC  fMd̦ <_ @@ @@ @@ _T_TւTłT1TtTr \QutTtT(6H DONE )TnT - l l+ ENTER PROGRAM NAME: ENTER PROGRAM MODE: lŖ  N@Sm d\  Tz T' Tb (A1,13H COSY LOADER) T T  ֘ T\ \ Ն  ȿ H l H TVTdh h -d@@~Tp{|}Tl~TkTl 1:Tz  h݀khT'd 1\Tb(15HCANT OPEN FILE ,4A2,8H OWNER ,4A2,13H ERROR CODE $,Z4) TH TVTdhh\h h _ ; h hTSh   hTg P1$\h T,h < h̘7\ P1 hȾl H TVTdhhl! hA hh h  hnmh+H TVTdh\ h\h˂\hdRl\h dRd\ @ d T TF@@" C A lTyT l)"C O CPT\T MĐONT \TTشT. lT# ) .4 0 06 e/ 8SH # A J BE @BBPOPaPO-- dTu hX6 fZ hJ6 f dȾd 7 (6 (T:v8h lT~v6h HTVTd d hAhhh Hh  H TVTdh\h END/ CSY/ )@0Tvh TQv \y  T hTA@@d6 HTVTdhd h8n2?AHTVTd h\ h\h h8nH TVTdh\ h\hTW h &# h h ]# Qhh H TVTdh\h7 h h !  hTiHTVTd h\ h\h NAMED DECK NOT FOUND hTnobpaaaaTHX%X#X!XXXXXXXXXX X X XXXXXH7h H/32"4` aADe !aaݘ AA a a Vh@@` X X ` X X X X X XH "H !H HT` h  h  h  ɀhHhh H hT9@@@ h ɀhHhhhhh Hq``X`HX " hNHhB4 "c" H]h\hRhMhRKuXhKJhAHFv" c h8"5Tz39cTh.h;X7H&8%#Td$h$h`  TT ܟ#  TF TTa4h2@@55؈ȇXuh&ڨ*IhTT3./0p=H ' &eh @ȫTȨXȞ Tbȡ`><Ȓ T} H T dTy TT}TG h3HHdDhdEDhhdTFKhh hHL8@ hk"ThT} hy"  b hqT PިXM H֨CbCwΨ U hS Va `hL1D{lEwe& ?!RX"ȭ ȩ!0XHyl'e@@ #!6X Ȍ TT `h XX\\ TaH #h! TT hBDhEhBhBhDhwh:8# `h9 V1a Dh/X+)*h+DT  #%  # Dj A Dh h h  Hhh&aH3[HX" L!`Ψh TT aH> 3 DH-j+̾Ⱥ(j'% hȲDhT̝Ȟ̘nΙlؘؚș _ U h@@ HDX hgHghf>XhdHdhc h-+h) H, @BH'H%#B9*h"H AhBH j `0 >Dh'd >w hrHr s"htjqh hDh`Hah`I/O REQUEST      X XX*EX XX&X+@XXX< XwhHh h,h*X" h$ h!X h hX ThX THX12 M TL `u HehdhgXlXvhb"aTzZ@@WDT hUHUHRRQ  pJf XNXXhEn HAXHXR(?R!39h9X?XInhTK  NX0h+ h n ;ln  H T` + ȋXh؆1   HhH㞚  TT hhhhd)hhuXh̺ (BD n&ȫd*ȫ  hJIEhE h h  hh h8H60TyXDX h%`" "h*hT3\]^ T h hhh ll X# Xh@@h@4i` Xj TT Cr q d Y hUDhT XHXlhNXghX^h:a62Hl20X), H,)H& XX>h a&hh۸nX X h H   HShhh<@ T}H $T\h9Dh5TFh122-3 T**%!!Ty@@ TF \T3Tx \T  H+h* r Gh hlBhHX"9" "hh0" Tz+TyX% hT\H `CT T}@ TFhTyh XX TyT 2X X' h$  X0X XzШ Xhˠ T T H= X H8X H0TX*@) \TJ   hTH(STOP PAUSE + h\H jN qDhQ`hS \hL!:R hJE hBEOi:Dh ḷ l !& !/ l 9!/̫ !+̧ h$ӈl !( l 5T l̻ ̵dl\ϔgTĔTnU  0l\\U ldd d:\͔  ld 9!. !* hĈl̨ l 3\    d !Tbϔ l F7̣ 4̠ l̜  0lTĔTn@@ ddldddd d f| 1T  l r  l  l z\ݔl $ӌ lLdd߬l,lLlll ̲ l,܌lLlެll~,Ќld l ̓ l zT B > : 6  93 %   l 95 2v  0lo  d dlX̺ ̷  ̯  Ed l D\̠ ̜  d  9! ! d$ӌl c"@@ l T  0l ḏ k3 dl՜ldd}d~ddd D llddl T~̻   l  dldldl dTb~ l\ l\Ṋl T@~  ̚dl̛dl l\Ք~ l\Д)" < ) EHp d; dl\Ȕ ! !lHdʤlT̘l\ l\ l  Hll\ˬl d l ddd d n 1 d +dd dTb @@l\̗  l\򔿔dddʤd  -lܺdldl dl TTdl  -ldlld d /̼dd$l,ldlLdllLld߬l,l,ތl,l,l  ,Llجٌl̶dlLlͬlڌlLdԬlܦf ̜ !̗ ! d  dn 1  l 7 -ldl  Ԝl Όl d !Y 1TΫ n !M̷ d̳  l!̩ l !5 n̜@@ ܡ, d̥  ̦ l 7 +l̞dlܚ dn 1 l 0n 1 d 0n 1 d r rdl Ôl̿ !i̻  l̶8T l \ ld dl !  0ṉh\ܫ l̹ l\̳̔ l  2\̥ l 2Հh\ l l 2\ l !d  d8T l \ l\\ l  ̳h\pܭ l \֔ l\є\ϔd@@d+ !" 8 % l\ܨ 1P\\J\\Ddd ddld dl`p=l  lܹ 0f.lۜll 1  +d dlTbFld dl -l l l  l 0dd !#  l5Tܘ \ lڜ9ƀh\3 lӜ4\ d\̨ld dddl *xl 2̬ l̩d ,\̤ l ! l l윳4\ܯm l`p5dl 0e 4 n l@@̭ḷl 1 l l  1 d "z l +T l ! d " ll 8̽h\ܷ "z l  l\є̥ l !\Ŕ̶ l !b@aH^H[TVTdhh\hhhFhhhh{hhh\hhhhhhhah\hqhhvhhI\hgh\hch\h_h\h[h\hWh\hShA T|` h/&hHgaV`H _H H M A cTXFRXB H H\00T002=:\؝002@@/  HI&Aa%acAD aa h h HR dQI H T|Ժ hHXhxhy`Xhh{ HfL#dhtHg ! lbag4lZ a``]cTX^RXZ I^HT˝ HG9Qs>L1a: Lw T&RH5 I  vR  LaT:\T: H d hh Huhi[G M^@BPCE}GN HJzLLK@ d"  `a` ` `X,8A"C  x&LpsX;@@a*XFXXȰ,` Ȱ#`X `Ȱ#`X`Ȱ#`XXhbXO`Ƞ$d `d`Ȱ.`X XXLbb Ƞ$`S@@`Ϡ *`@ed`d`X` `Ƞ4`n Ƞ$Ȱ$>a.`X"dR`2H `͠ `D`D```XCXX}XS#Ȱ.` A`@ @ ŀX2X0` `2@A`πҐ`"G z @35` ` 2` 1`ϐ+ e% b ``"dR`2H ```XcX X8#Ȱ.`aA@@@͠`d `rd 0 d1 " 2a0 `Da0 1 q  ! Xn` ` `X XdRXX@`!d߰2H `Ԡ"`@`ed`d``Vϐ.`@`@`@ϐ"h t=`hA``h`A``B΀" e " `@2T "@k"Ƞ>.`Rd"Ƞ>`R@`" ` &B``` "Ƞ,2!Ƞ#`&2  X@@/2 <CF=BȰ#`X X9@ `X!X1 Ƞ$XX Ȱ#!1H%X#X X X 4 4p"d 2esR4R4!D RȢA1`R "dR@ R  B H gad `Ȱ#`X0Xb Ȱ#`X$`!dB2 @rdR@`/@Ƞ4` H(X t` Q  T|"" R1 H XRRt`p@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@`,g!,u,CSYLOD $$ ` @' ?$ a#f # , 4$( c c 4 DONE uTTTTTW"T#$%$&TTu ,, SCREEN DESCRIPTION :PAUSE "PK  00 #)^ F 8 3T# TT-  dTT\ (h (hT7QPT< u\,<T u@@Tϕd & !ȗ \Ռd"<̦ \#$\%<TpT̮* x d&TD<&(d'( )d;`222v2222p22DDT 1.0 ( 5/26/79)BUFFER SIZE= 300 BINARY RECORDS  ILLEGAL COMMAND ILLEGAL SYNTAXILLEGAL HEX INPUT ILLEGAL DECIMAL INPUT ONE WORD OVERFLOW ADDRESS NOT IN USER PROGRAM SYMBOL@@ TABLE FULL SYMBOL NOT FOUNDPROGRAM TOO LARGE PROGRAM NOT FOUND SWITCH ON SWITCH OFFPAUSE PLEASE PTR PROBLEMS TO D.QUINN X1hh h hThAh hk hi X)X /XXZhh hM hI h -X4h 5hT X'X + 9"XX) ( $ $ 2  X $ 2   X^ X[H(X  hXM  XdX  XX8DX."X,h H< h"X(" 2 1 :"@@ H W6h XNMXHX     - h~X ` g" `X X X Xj hX  f"X ߆"f" Xh  XBX9 - ' ) $ 1XH@0h>X= ) $X^& XK XXX9XhBX $ )XH `QH WV" c q H0X hghfhe X X XXXX  jRX ߊNjL XX H h 2X h@@ hXh  VjRyH"XXXX   ! AX h^HhT?H""HX"X  XX> hh/H/Qh(4$ ; 1h?ˠ"d4 3 (X PX!XX} AX QX IX 1X 2X 3X 4X OXg 0XFXX ]XgX^X] X6 =X3SL`GFECA?h5H4h20.,*  hH :j< B hH -j' B  XX A@@hX Xf"bbbXf"bbb  0""  X[XXXX X X XX"X "Xo"Xl H`ha" "Shhh?hhhhCT h7W h,R"aH( H  jTL  h hX' h hXxyQX o^  \`i" y" `HX7hJ.hIhhETFQP h>??ppqqrrssttuuvvwwxxyy::#@ '==""{#AABBCCDDEEFFGGHHII})J$K.L?@@@@`18<\\\@@@@\\\<'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@h)X@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ R{.' '( #)|))))))))@@))* * **6 *D*b**'**@P"d@@ŀ@P"8@@@P.@P.8@P2@@@P6@P6   t@P= x@@@P7>@P>1 /@(K@z@PC8@@@PH UU@P6L@PL   t@@@PS x@PMT  b 0>1b >0a StS(//62V  /,*/2DR X X XXm J2>2 [TAPE  АQ48@@L2t B  7 7 /88 80/ / / StS/ / StSt/6 =  B( * 70/t/ 7B 8, @@&F@&HJ2 B  7t 6 =  B( 7* /tt/@P[@@ t@Pb x@@@P\c@Pc1@@Pd8 @@@Pm-@@Pm8 @PvK@@@@Pv8 @P_@@P8 @@@Ps@@@P8@Ps@@@P[@P 4` D`@P@@@P1@ @7@E]nn`@P@P@@` @ @+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@  $ ,X,\,^,`@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@  $ ,X,\,^,`@`a!H LIST $$ ` @hR g 'HXXX)* HX, ,,,,,,VOLUME NAME EXCEEDS 8 CHARACTERSFILE NAME EXCEEDS 8 CHARACTERSNO FILE NAME SPECIFIED FILE NAME?VOLUME NAME?OWNER NAME? MODE?  NO  hT낂TgTTh 2l hT}: h hT,h\,h\,h\,h\,hȤ h 1z !pȖ h\Â.ȍ h !V 7\g2 + hm\2@@ l " l + hTT}6\k l * h9\kT.kTT=\\M\\󂑂\\\nT.- T .TTЂd 1\͂y\2 \2\ゑ\傃d 7\g2\s\6 \‚6\ÂT}k\\k S\TTwĬ2*V*\2.g .Q.Q,\j?.O=.NY*̒.\o.M.M.M2.NάL.Qb.Q@@Ĭ2*V*\2.g .Q.Q,\j?.O=.NY*̒.\o.M.M.M2.NάL.Qb.QĬ2*V*\2.g .Q.Q,\j?.O=.NY*̒.\o.M.M.M2.NάL.Qb.QdDTZED h hTEh\Eh\Eh\Ehȱ h " h 3TAȠ l\ǃED‚Ș h " h +Ȋ dD\EDƂ 6T@@Gƃ l " l d . l hTZEDʂTʂ T‚Ƃ΃d " dTq΂ zTn\ςʂăTMŃ\ƃ\탱ǃ\䃱Fƃ\ۃmȃ\҃Ƀ\Ƀ+ʃ\Ń\mʃ\Ń\ʃ\ ! "d "T?TZ‚˃TMŃ\ !\\‚˃\Ƃ̃\⃱̓\TX "` hhTEEI hh\EGEI@@ h T{nLEhhHTgTuh\h h h\h S R A D C B O$%&*+,-./0124@EDCL OPN Y $ $~ 0 TJ hhTn݄h\n 1 hʫl%  ȧl ȹ șlȗl TZdT TTTk\\\\酗d l\Ʌl ll lT}\d\l\  l\dwd\\rl\ԅlt\@@  Tlj\lh\lf \d\d\dTZ 0d dGlT B  T䅙h<dRn$4l\녕hT'n l l 1SXG# A J BE @BBXnPaH -- dTu hX6 fZ hJ6 f dȾd dd7d:d dddd ddd! dE % "lTd dd"T> lTƟ ld. Tӟ T  l̼   RECORD LENGTH EXCEEDS 2200 BYTES FILE NOT FOUNDPAUSE(LF TO PR@@INT) $ dldP"7 1 0  %"FT TÈT%T d "И"TĈ\Lj hTȈʈhȺ 7 #ȹ ȯhT]Ȱ xȣ 3Ȩ /T:ਠlȚh h P1ȑh\ (lȌ d P! 'h\. d d\̈Ty߈ɈT҈ h*T҉Ԉ  TֈՈֈ\׈\Ո؈ lT߈ĈT dTTT}وӈ '\􈳈ڈۈTĈ\HT*T8h#h%\hh@hRm d T̤ ̠ TF̚ .@@  l\ d̛  d  RECORD NKP|;L5FTTĉZ Ah hT ʊ hO\lT}ɊʊT\ ( h7T?l\ʊ hȻ)h\ì܉ ( h \ԉɊʊlȪh ( :h\lɉʊl؜ș '\ʊ m ؙ 1\ʊHT*T8 h\h\hdl lT{T d% \ ld l dTF . B  ^\ɟldTM \ @RECORD XXXXP   * ( h ( h hThT}@@ӊኋT֊㊋^ Ah hT \\ي芋Tъ\ҊȽ h?T?j\Ίيފ݊ߊ hȢ!0بȧ,h\ȥ ( h"\ي芋jȕh ( h\\ފj &вF̕ dhT+f B1T֊ኋݜ !HT*T8 h\h\haQl lT +l̯d"Y TӟZd^8d l lT  d l\TPRINT? (Y/N) NOT A BASIC FILE1 LIST OF BASIC FILE: ???????? / ???????? / ????????`!NO$/ 60 d Kk0 f (d+ @@(lTыhT ̨Hh  T}C\G\񈆋T֌ \ T: hh 1 hȤ!Tߌ Tċȉ \׌ؐ\ًTHMdT  T TT hPOOhT? lF   l 1@ (h99h h6T}d+l)lT]  T h\ȳ Ȱ  h\댓2ܖHT*T8 h\h\hhhhhh h\hh h-0 /20 \ٟW l&T???????? `H lkT} .C .\@@ .G .\* . .S\ . .TP ȯ ]Tȩ UT(h !K hȺhT&&( h\& &(ȊhT2&+KlȢ0Hl\ . .dA h\4  \(d0 14 1HT*T8hqhh hshh hh\h\h[ + _N ȯ "ج Q#uMrJF (jj AXBf\/  \ #d+ 1/ 1HT%T3hqhh hshh hh\h\h[aH + _N ȯ "ج Q#uMrJF (jj AXBf@@  \d& 1* 1HT T.hqhh hshh hh\h\h[h !aH + _N ȯ "ج Q#uMrJF (jj AXBf"b"b"bhT`a HX AH=h=X8r""3Xga"a X" Xb Xa f"! 6"b!b$"A1f" XbH"h "hX"H" " b b  X Xَ" XXԎ'H Lbb@ H `HGHh HX @@l` `"i HH""d̻ T TTT hPOOhT'lF   l 1@ (h99h h6Te ጄ+l)lTE  T h\ጅȳ Ȱ  h\댆 lHTT h\h\hhhhhh h\hhl d T l lh-0 /2???????? ` lkTe!C!\!G!\!!@@S\!!T8ȯ ]Tȩ UTh !K hȺhT h\ȊhT%+KlȢ0Hl\!!dC h\'  \d# 1' 1HTT hqhh hshh hh\h\h[0 h !aH + _N ȯ "ج Q#uMrJF (jj AXBfh h\h h h\h hg h h   1 h lTiHTiTw h h\ h\ h H-h,TiTwh'\h&\h%h# L `: ` @@" v  l` H/h.`h,h'Dh*h((`B 9H!  0 nH DQ S  0n `'d X hh hTO=TO hX X:XjDhBhTOXo X /6Ȉh}Ȉ{h~hhTOc Ch [YlX7 X! 1 OhF?X& Xlh=19116h h+&Ȉ$h h ! hTOڋTOX@@ Xȟ h H !bhΐjTODXTOڋX X\h! 1 Oh^! 1 hhX X8XhBh@h?h Ȉ7h ' jTO|hhy TO !h h hTOX=! uyntXy+ !ijeͤ _nXdhHH TI h@  PAUSE Zd^8d l lT@@  d l\T  T T#ПП dT T d:d\!!dd 7Xo Xl)hyX` Xw= lhtoȠ lbel blhbV X X ` X X X X X XH "H !H HT`h Hq``X`HX " h HhB4 "c" H= X H8X H0TX*@) \TJ   hTH. STOP PAUSE  h\@@H jN qDhQ`hS \hL!:R hJE hBEOi:DhmTU[T,U[ÐPd\c\c>m̛l\\]\\]Ïl\c\ܐNn\ݐNnÐ\lݔ  djTÐj\ldol AT+Ðjpp \Ðj\ldq +l l\Y_\Y_ÐRḷ  lTmÐjRld  ddl)Tc>mTNnT,NnÐ\d\c\c>m\Y_\Y_ÐRl\c ddTrTKUU\r@@TTvT (H%THTVhh h\h\hhhhhhhhhh hhdd  h 1 h! hT+ L hH THTVh\hӠ $$SYSA $ SYSVOL  ` h  T.BHqCDDG h Xx hs h hn Xm XEhFh X^ X}w 2 1Tr 2 1Nn !Jh d ȶ 3XH>ZH: H Ȣ h Ph'I#HBȑ?h ! PhX h5h -Hy1@@ Hh hTݓH` # h TۓH  h l X X h? h>X? "  2 2  " P" Ȍ hh# 2 PhT.BCDDHrq !hH ! X Xl X Xlz H*h)`h'h!h  Qhl ` h h  XÁ hhHhllaHTHTVh h\h hؠ31B@'d  ca h h h (hT$  1 (hT 0@@n    h n 1  0lHTHTVhhhh\ h h0ad a  ! 1 3d   #2d A d ( 2adaa1 aDa1 bAa?ad A2aF ad2aa1 aa1 aDa1 aaaa#a`a hH_h_h]h[hZhWh?@[HTHTV h h\ h\ h0123456789ABCDEF1 Th3 h\h, hh\h!dRl\h hݨ hрh\ԱhhdRl  HTHTVhhh\h hV"':'d (~!dhT2dhh\dhޘh\dh՘h\dh̘hp8 0hp8 0hp8 0hp8 0hp8 0hȱ  hȭ  hȩ  hȦ  h h$ " -hThdRl\@@m @HH H h h !#H  H"h! h h Ah @ m 5@06;; dh7h h h .j 1 h h 2j lh lTSELECTED FILE STATUS ENTER SELECTED VOLUME NAME : [ ] SORT BY SECTOR ADDRESS OR FILE NAME (ADDR/NAME) : [ ]GROUPED BY OWNER (YES/NO) : [ ] RESTRICT TO A SINGLE OWNER (YES/NO) : [ ] VOLUME ???????? NOT MOUNTEDYOU HAVE SELECTED THE FOLLOWING:INFORMATION FROM VOLUME ????????, MMUNIT??SORTED BY FILE NAM@@E SORTED BY SECTOR ADDRESS WITHIN OWNER NAMEBUT, ONLY FOR ???????? SELECTION(CR) => VIEW (RESET) => TRY IT AGAINENTER SELECTED OWNER : [ ] (LINE FEED) => PRINT???? IS NOT AN OPTION ERROR - ???????? VIWPS IS NOT 96ENTER FILE NAME PATERN [ ] ADDRNAMEYES NO DEMOFILE???????? ` ( 839",'! 0* dO d6 dP dQ dR dS @(du*>uTTwrT%@v\?\wx\j>u>uT%MyuzdLTF F \т>u>uT?{yT^ /< \>uA|u\wx\A}\@@wxT\d>s!>s\a~!slTO!bd \!>s6>s\Ü6\f>s$>s# Th>s$>s\}$l\ӂ$fh \$>s6>s\6\ߜf>s'>s \՜h>s' TӼ lEn dlPn l @HH Ah  @m @m@HH TT h\h\h     1 :@ "L "00 _O T,,, "T &Tuܥ h@@T}ܥވKߍۥߘ\ $+h  1! ,Ę h\܍ܥKhȿ h\؍܍ۥߦ7ȶ A h HT*T8h@ A "T `hTk.B # TADAFT.D.F ,l l H T*T8h\hPAUSE   !TTT l Ah h<߈ hT+%nTh\ֈHT*T8 h hh\hh TT֦צئ٦צզզTH LIST $/T}\CT\G\\ሆ@@H T*T8hhhhhhl* FILE LIST UNIT ????????PAUSE(LF TO PRINT);̧ 7\ $ ! !"̚  1 0 T4T54TU  hTPWWW\XTP4TU h TYZUh v  h h\Y\Uhȳ eT]ȴ 4 2Ȭh h hT dTcVߧ[`aȝ TTyߧ`^T\4FOO h3T\W4E "_ T֧bc4T}XT9dT\X9\\be4 lTߧ`^\ l^HT*T8hThghshh\H/.. BE @h-hFh hT',-@@d.T'.`DT(*(/l   Ahl,HT*T8h\h\h\h\h ^Tvh !h\h h\h h \h h\먑l HT*T8h٠$$SYSA $ SYSVOL , h  T󨟩ZΨ h Xx hs h hn Xm Xhh X^ X}w 2 1Tr 2 1Nn !Jh d ȶ 3XH>ZH:X  Ȣ h Ph'I#Bȑ?h ! PhX h5h -y1 Hh@@ hTt # h Ttw yz{|y yh l X X h? h>X? "  2 2  " P" Ȍ hh# 2 PhT󨟨Zϩ !h ! X Xl X Xlz h  1 h! hT]  hH T*T8h\hNT d d &  l $ l l d dTT3T; * 7ʵ l\\\ ll lPl dHN  lPLlK `  hH@@_h_h]h[hZhWh NS+(裀 SآV O+O&SآV(SO > NS+(裀Sأ, O+O&Sأ,(SO B R裀ȡI٢0ۢ on drive  , msos lu=  Q h ɡ"S+(צMonitor which terminal:  裀!+++Ȅo裀!ؤ,, ?S, O,Í+O&S,(S, Port not logged in צInvalid port number vX!צGF(iles,U(sers,O(ut_batch,I(n_batch,P(seudo,V(olumes,T(erminals,Q(uit : Zš ,s@R FB>:6 2!. *rFV"(" 2,",B4Qá>JJj*f Pn  " \ x ` D"S+(צMonitor which terminal:  裀!+++Ȅo裀!ؤ,, ?S, O,Í+O&S,(S, Port not logged in צInvalid port number vX!צGF(iles,U(sers,O(ut_batch,I(n_batch,P(seudo,V(olumes,T(erminals,Q(uit : Zš ,s@R FB>:6 2!. *rFV"(" 2,",&ءj*f Pn  " \ x ` D"S+(צMonitor which terminal:  裀!+++Ȅo裀!ؤ,, ?S, O,Í+O&S,(S, Port not logged in צInvalid port number vX!צGF(iles,U(sers,O(ut_batch,I(n_batch,P(seudo,V(olumes,T(erminals,Q(uit : Zš ,s@R FB>:6 2!. *rFV"(" 2,",__ءj*f Pn  " \ x ` D"S+(צMonitor which terminal:  裀!+++Ȅo裀!ؤ,, ?S, O,Í+O&S,(S, Port not logged in צInvalid port number vX!צGF(iles,U(sers,O(ut_batch,I(n_batch,P(seudo,V(olumes,T(erminals,Q(uit : Zš ,s@R FB>:6 2!. *rFV"(" 2,",`Ty!TTMOVDEL $$ 083180` @:h u  Ha(M| I S Ga  uR u  *nX!X T a "A2 0 X !"\Xha!a''  "FILE TO BE MOVED (CR FOR ALL FILES) aTLSYSVOL SQENTER TO ID: (DEFAULT IS LOGON ID) AAAAAAAA/ BBBBBBBBOK TO MOVE, ALL FOR MOVE WITH NO VERIFICATION a*#F a( ?# (a( &c+ A (c# q L0SS2TORAGE O$LOW o.OKALL : (87F"*H- MTf @@TDTl  T d h\ HȰ Ȫ / \̓\ɂ\Ԃ  d  h\ H Ȅ  /\ 2 \2 dd   l\ d  hTl HȜ Ü / TD\  ̿ Tڄ\ d/dTdd "\僣 d %Ȍh9\ H  / Pl d dTT  3 dd\ "l 2/@@TdT B ! /" T#/Z  \^  ^TDZ̈́\^҄T hTl Hׄ$ Ȍh\ ̄H%  / &dPl &(' ḷ P\C7bd6Gd9\Z\Z* TD.\P:TdT!* 1*Jd)"> *f\\ڃs\΂6%\ʃ6%Ts* Ts# \g8+Ts# Ts \6%T**\T#/dTd\̋ \@@Tl , !4 TDڄ\Մ\ ҄- !iT.#z\/#u\#q\0#m\ 12\   l@\\\%TdT =TB T  \3# \4#ߤ5 \6#פ! \7#Ϥ8 ɤ9 T^Tc h8nHTT$ h\ h\h h7 nH TT$ h\h h7nH TT$ h\h hh !  h@@HTT$ h\ h\hABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@( ? ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB@@ABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAB`FILE-NAME 1=VOLUME-NAME=FILE-NAME 2=OWNER-NAME =VOLUME-NAME= h hdd.hhhddh h h@@!hTd h f~f 1dh `dd l,l+ l)l( l&l%T.\. dh llT.̧L 2̟ "\.̔ "̏L T.. "\ъ. "l̾l P "ddO M h  d  1˜ dhK `ddT.̑ "\.̈ " lf~f 1pTMOVE $$ ` @5h u  Ha(M| I S Ga  uR u  *nX!X T a "A2 0 X !"\Xha!a''  "FILE TO BE MOVED (CR FOR ALL FILES) h SYSVOL {ENTER TO ID: (DEFAULT IS LOGON ID) AAAAAAAA/ BBBBBBBBOK TO MOVE, ALL FOR MOVE WITH NO VERIFICATION a)a*#F a( ?# (a( &c+ A ( q0 2MASS S$GE OVELOo$.OKALL #:(87F"*H- MTb T@ @@Th  T~ d h\Cȱ ȫ + \̓ \ɂ \Ԃ d  h\ C ȅ  +\ 2 \2 dd   l\ d  hTh CȜ Ü + T@ \  ̿ T~ڄ \ d+dT`d "\僟 d %Ȍh9\C  + Kl d dTT  3 dd\ "l 2+T`T@@B + T+Z  \^  ^T@ZɄ \^΄ T~  hThCӄ  Ȍh\ȄC!  + &dKl "$# ḷ K\C7 bd6Gd9\Z\Z* T@. \P:T`T* 1&Jd%"= *]y}~}T\ۃo\ς6!\˃6!To*To\g4'T oTo\6!T&*+dT`\ ̔ \ Th @@!4 T@ڄ \Մ \҄( !sT)\*\{\+w\,- \   lJ\ \ \!T`T =TBT \. \/ۤ0 \1Ѥ \2Ǥ3 4 TZT_ h8nHTT h\ h\h h7 nH TT h\h h7nH TT h\h hh !  h@@HTT h\ h\h@P"p<,d@m $m fV̼ ll! ̯ l̽l sJ@Pl̫l̒d&lܮ d d̑ d'"ll̎l lK@@@P/ d%d! fh  hT@PK@@( ? PDENSE |PQ8PKUPQ8PREPRDXFR GETAJ ILINK cDISPATw@@P PvXCHECK 39836101 COPYRIGHT CONTROL DATA CORP. 19@P@@@P H"! (9@WV dJ d BdD l dI l l l @P-lh lT!uDߔr # l l cϜ 2 l[ h @PXlT"uD sl lܶ lC̰ 3 l dH̭ d "l\uD̟ @@@P&T ,\dK dM h dIT\ 1\l l hH@PRPXCHECK@@PRDXFR 4WRXFR ZLINK DISPATP PvGETAJ 39835801 COPYRIGHT CONTROL DATA CORP. 19@@@P ; !<  h=! e,h T @P!\h! I6> e,h\ 4 @@@P8 e,h\ؿB 2? $ Gh h̷!ȯh e,ʈh\ @ء@@@Pb̻h e,h!\["@ HTThh\h\h\h}PGETAJ uPHFLOT Q8PKUP{Q8PREPx@@P Pv,ZERO 39836501 COPYRIGHT CONTROL DATA CORP. 19@PTT@7\@ @@@P\@\H TThh\hހHߪ_ h T TH T T_ T  Th \Ac T T \/u \){ \# \ \ \ \  \)*PX Y ,(-' @h hhTF0 /   h\ 4Tӡ hh˘6 f@@  \\  \  ̵h hh{M T{N{ShAhK  K \ @mۄ{Pn l{J #\# "N/  G  !Tӡ ffffl n lTF0 \䡯  S  \̡l dd4 ̪ \, 3 \'̙  9 !5  3\ df/  \̘ ̴ Q̯  {{D % lTӡ̬nܗ ̓ @@   d d $\̰ۡ d{NTK@{Umm# {Sm d O Id $\z2  I Tӡ @mC \\ d/ N @ HH& d/dd7d-d.T!2/,81  l 2 -Tӣ"! ,1PONMLK\裚" ; (K Dܶ "\У̯ l̮d6̩ "\ģ, \  d9dT72 l l4 \(81 %2 1 @@ Tӣ.  \̷ A d!HS$ hTF0 S/ S\ !N Xy$ hhdy#!y- y, Č y" >dh h+nصض 1ӌl̼  dT ̳ 1 lȜlTӤP\̤ ̠  lO l\Q̥lTF +/4 1 HoW, hhh d{N{Sh ${Lh"p8 hh Hhըh h h 'TӤ l=TF , $0 \ȶhz "\jت/ Ƞ  @@\Ѥȕ @-h %z-܈DŽl @HH'!"#%&:;<>?@[\]^_SU,=0[\2. hnh hh hhTF0 / ؽTӥ[ {M T{N{SI 2@mK-  @mk K K \C K \οO κE \dή  Tӥ[l d f| 1 dddd{N{Pd{SI@@dlHk x   l`笚d {Um ${Lh(p8% dlƬ Hll ldzn l ܘ !/ dddTdd d  d̞lTF0 {M T{N{SI 2@mK(  @mI Tӥ[K ̈́{Pf| l̍ /  4\ܥ[̟ l  ll l dT4 TF̓d \  , $0 \[f}\ 1 @@؞ !Ι !f~̚ \ 1 f/ ̙ l l ̩ lܗ Tӥ[\̫    dddd̳d`FILE-NAME 1=VOLUME-NAME=FILE-NAME 2=OWNER-NAME =VOLUME-NAME= h hdd*hhhddh h hhT`@@ h fzf 1dh `dd l,l+ l)l( l&l%T{*\* dh llT*̧L 2̟ "\{*̔ "̏L T{** "\͊* "l̾l L "ddK I h  d  1˜ dhK `ddT{*̑ "\*̈ " lfzf 1pc . +h` ABh8 h " Hh٘!֐ Xc h@@H h HhHhX߅c Dhȵ h`7f6؊ȉ a@!hz!  !# ol0daaaaaaaU aR)HZ @H- joj j q XRTHD XH h THD  `j q `gj j qTLDVKhhX!6b =h KhTLDXTİh @ Hh h h T'`THD1SezĄ@@'.K  8+ILLEGAL: ITOS HAS NOT BEEN DISABLEDILLEGAL: NOT RUNNING FROM MASTER CONSOLE ILLEGAL: NOT RUNNING IN INTERACTIVE MODE DISK I/O ERROR NOTEDENTER DISK UNIT NUMBER (1-8) AND TYPE CARRIAGE RETURN ILLEGAL: NOT DEFINED AS DISK ILLEGAL: NO FDD EXISTS ON PACK ILLEGAL: BATCH IS OPERATING FDD REBUILD COMPLETE. DUPLICATE NAME/OWNER STRING NOTED NAME OWNER IS ENTER NEW NAME AND OWNER STRING FILE-NAME = OWNER-NAME = RAN OUT OF FDD SPACE - FATAL ERROR AUTOLOAD TO CONTINUE FILE NAME CHANGED. OLD NAME/OWNER IS @@ NEW NAME IS @@ X X ` X X X X X XH "H !H HT` HT"hShIhHH JxG"h?h>h= hhhh hg j?Tx2Ca# TfDW$`,3 l  lTvA>1R lTvBK $$CREP $$ SYSVOL h""3 2"l ldX%X#X!XXXXXXXXXX X X XXXXXH7h H/32"4` aADe !@@aaݘ AA a a Vh`2Ca# TfDW$`,3 l  lTvA>1R lTvBK $$CREP $$ SYSVOL h""3 2"l ldX%X#X!XXXXXXXXXX X X XXXXXH7h H/32"4` aADe !@`@!7 REDUCE $$ ` @<K NSh-A)  K Tө @ml fNܑ̝ !\ԄPnC  fMd̦ <κ 6αIdNO   &&8398$$.). 0 *     TuFHIT*#T{F$%&$**G\ENTER VOLUME NAME: (DEFAULT IS SYSVOL)ENTER TO VOLUME: (DEFAULT IS SYSVOL) FILE AAAAAAAA/ BBBBBBBB CANNOT BE REDUCEDPAUSE AAAAAAAA/ BBBBBBBB REDUCED!d"d\F34$**G\F5/)$$**G\)$&T{F#g67$@@0G̖ \˂$! $l%l\F84$**G\ۂF8/)$0LQV[`ejot $).38=BGy..\F**0 @,\o*[,g_)FILE TO BE REDUCED (CR FOR ALL FILES) ΰB*SYSVOL ˨*ENTER TO ID: (DEFAULT IS LOGON ID) AAAAAAAA/ BBBBBBBBOK TO REDUCE, ALL FOR REDUCE WITH NO VERIFICATION 2.g .Q.Q,\j?. .0̒.&ENDM.o$2OKALL (87F"*H- MTo@@TTu TЂ d h\Ȱ Ȫ } \̓\ɂ ddȍ   l\  \ڄ\ d}dTmd "\ d 'ȌhE\  }} ' l d d T T  3 d!d"\ "l 2}T#T B$$% }& T'(}Z   \^  ^TZ̈́\^҄TЃ@@ hTuׄ) Ȍh\̄*  } &d l +-, ḷ  \H\ZTr#Tr$\ T\. } !16 \ڄ\݂ՄTu҄/ !T0(y\1(u\'(q\2(m\ބ34\Մ  l\\\*T#T$$$ =TB$T"$b \5( \6(ߤ7 \8(פ% \9(Ϥ: ɤ; 1TgT@@l~ h8n HTT- h\ h\hdl h7 nH TT- h\hl h7n H TT- h\h hh !  h1dHTT- h\ h\hTX%X#X!XXXXXXXXXX X X XXXXXH7h H/32"4` aADe !aaݘ AA a a Vh` X X ` X X X X X XH "H !H HT` HK!"hE!dhD@@H3  j;T$߇4"T߈*!vT"߇ H H  -X~ H   #3T Xo H  Xy$$SYMSGF$$ \"Xq HI HXG  X\Xn H: H X8  X H(X) H$X4 \ȵ" \bT"߇ ȮX2whth \ h H ! qH  HHa2Ƞ(h!n 8 H X X' hdLH 1  :Xӈ H"A HB0Fh  0X  00j qa! -" hh! u @@ HTLDHHSYSTEM MESSAGE XXXXh Hq``X`HX " hHhB4 "c" H= X H8X H0TX*@) \TJ   hTH \STOP PAUSE  h\H jN qDhQ`hS \hL!:R hJE hBEOi:Dh5T|GHTT hh\hh hTo\oTbr!hTprnnrstlh\r \prnnrstl'ΰB(30HENTER FIRST SOURCE FILE NAME ) (24HENTER OUTPUT FILE NAME ) (4A2) HTT hh h\hh h Ĭ2*V*\2.g .Q.Q,\j?.O=.NY*̒.\o.M.M.M2.NάL.Qb.Q@@P P5DATE LA k@VOLR lHEXDECnHEXASCoENCODEpDECODEs DECHEXu`ASCII vFLOATGwCLOCK xFLDF z@DEFFIL}@DEFIDX~LOKFIL~UNLFILRELFILST@@OSEQ`RTVSEQSTOIDXRT_( RT( hhTiu !9T+݅vw .\݅rw h 1#TbzTwT8(31HERROR IN WRITING FILE - ISTAT=$,Z4) T|H TT h\hhLE`TIMPT1TIMER GTFILE @SPACE @RELEASPTNCORMOTION ŠSYSCHD̀MOT @BSR EOF REW ܀UNL @ADF BSF ADR ߀DISP @FFERGTFILE @SPACE @RELEASPTNCORMOTION ŠSYSCHD̀MOT @BSR EOF REW ܀ @@P P VALID l :  ! l l " ! !$ l l h 5 l lT@@j TG lhHTT h\h h h hh hh\hhhThT'ч )  l+l&)Tbz TT8(34HERROR IN READING FILE -- ISTAT = $,Z4)T|HTT h h\h\h\h\h{J_6( (, h  hTi<)d ldHTT h\h\h\hl h8n$T>HTT h\ h\h  h8nl̼H TT h\ h\hlT H TT h\h\ T H TT h\@@hTbr(36HENTER FIRST LINE NUMBER ( 5 DIGITS )) T !\r(35HENTER LAST LINE NUMBER ( 5 DIGITS ))\(I5) 1 1\r (36H FIRST GREATER THAN LAST -- RE-ENTER)  H TT h\h :# J hhTA:TElT>9?\@ll5 !N hhTbr n"?(56HINPUT FILE APPEARS UN-SEQUENCED, LINE COUNT WILL BE USED) "ȭ تȩhh\:\l\>9?\@ll4Ȗ 1ȓ hȏhd;(75X,I5)H TT hhzm dT̤ ̠ TF̚ @@  TɉTމ߉ȉȉ߉ɉމ l hT݉ɉh 9! ! (ވ l 1K HTT hX%X#X!XXXXXXXXXX X X XXXXXH7h H/32"4` aADe !aaݘ AA a a Vh` X X ` X X X X X XH "H !H HT` HK!"hE!dhDH3  j;T94"T' *!vT7 H H  -X~ H   #3T Xo H  Xy $$SYMSGF$$ @@ \"Xq HI HXG  X\Xn H: H X8  X H(X) H$X4  \ȵ" \bT7 ȮX2whth \ h H ! qH  HHa2Ƞ(h!n 8 H X X' hdLH 1  :XӋ H"A HB0Fh  0X  00j qa! -" hh! u  HTLD HHSYSTEM MESSAGE XXXX@@ hcbHbHaXAHWX? hUX<Ȓ TS H T dYTO TTSTÎWWWWXWWWWW h3HH@@dhdDhhdTFKhh hHL8@ hk"T_hTZ} hy"  b hqTw PިXM H֨CbCwΨ U hS Va `hL1D{lEwe& ?!RX"ȭ ȩ!0XHyl'e #!6X Ȍ TbTq `h XX\\ TaH #h! TT hBDhEhBhBhDhwh:8# `h9 V1a Dh/X+)*h+DT  #%  # Dj A Dh h h @@ Hhh&aH3[HX" L!`Ψh TT aH> 3 DH-j+̾Ⱥ(j'% hȲDhT̝Ȟ̘nΙlؘؚș _ U h HDX hgHghf>XhdHdhc h-+h) H, @BH'H%#B9*h"H AhBH j `0 'd  hrHr@@ s"htjqh hDh`Hah`I/O REQUEST     X XX*EX XX&X+@XXX< XwhHh h,h*X" h$ h!X h hX ThX TZHX{N{S TL `u HehdhgXlXvhb"aTPZWDT hUHUHRRQ  pJf XNXXhEn HAXHXR(?R!39h9X?XInhTK  NX0h+ h n ;ln  H T` + ȋXh؆1   HhH㞚  TT hh@@hhdbhhuXh̺ (BDY n&ȫdȫ  hJIEhE h h  hh h8H60TOXDX h%`" "h*hT234 T h hhh ll X# Xhh@4i` Xj TT Cr q d Y hUDhT@@ XHXlhNXghX^h:a62Hl20X), H,)H& XX>h a&hh۸nX X h H   HShhh<@ TSH $T\h9Dh5TFh122-3 T**%!!TO TF \T YTN \T  H+h* r Gh hlBhHX"9" "hh0" TP+TOX% hT\H `CT TS@ TFhTOh XX TOTb 2X X'@@ h$  X0X XzШ Xhˠ T Tb H= X H8X H0gTlX*@) d\TJ   hTHbSTOP PAUSE a h\H jN qDhQ`hS \hL!:R hJE hBEOi:Dh ḷ l !& !/ l 9!/̫ !+̧ h$Ol !(z l 5TFl l̻ ̵dl\KHgTETDF  0l\P\ ldQdR dB:\͚F  ldS 9!. !* hKĈl̨ l 3\F    dH !T8KH l F7̣ 4̠ l̜  0lTETD dUdVldLdWdXdY dB f 1TFF z@@ l   l  l \ݚF{l/ $O lLd8ZdK[l,lLlll ̲ l,܌lLlެll,Ќl\dR ]l ̓ l TFF B > : 6  93 % FX Y l 95 2v  0lo  d{ dUlX̺ ̷ / ̯  EdCz l D\F̠ ̜  dWF  9! ! d8V$Ol c"U l TF F 0l ḏ k3 dl՜Y@@l{d'd(d)d*d+d,/ D lld-d.l T@̻ UC  lL  dldldl dHT8H l\H l\HṊl T U ̚dl̛dl l\ՙH l\ЙH)|" < ) EHp d/; dDl\DHz ! !lHdFJlTF̘l\F l\F l  Hll\Fˬl da l d9d:d; dB n 1 db +dLdW dHT89H l\:H̗  l\;Hd?d=d>ʤddc  -lܺdl@@dl/ dl T@<T5L1a: Lw T&RH5 I  vR  LaTL\GTL \ݗ] d4 hh H\uhi[G M^@BPCE}GN HJzLLK@#y a%XH!""" A#*   "!"X# a1rX""  "!f" !" f""" f" "a""! @@h " "f"" "f" !"` a! a a"X  a! a"XXaa a a! a"X~"  !T 9!a Fa a! a"X a a! a"Xf a! a"X a a! a"3X6Xh`X``` a` a` `/" 4 A *a A    gR@R@ -A` .a ` a! a"X a! a"XX@TEX -`" ` c1Xd 2QTEqX c1XjTE[Zd@X #  a` aܐ!XsTEYD]@XX a Ea a! a"Xh a! a"X a  +a `"d` 5 aX@@ aaXa `aBP@@#4h h` ` ``TEBP@#dRAR`B@ @"si`  dr$Rd`@$dR@ R  DA ) H f H g AddRAaX c1XjTE[Zd@X #  a` aܐ!XsTEYD]@XX a Ea a! a"Xh a! a"X a  +a `"d` 5 aX@`d@!:7 dSP $$ 010780012180` @TPE"*v"D H H[H`'   HB            ThbW q ZqTE#EF"ddFhp8dhB8 D$d$d@@dF#4 9"eT1Db1T Drq;  d"X# dX dX2X2X 1X1E"!V"҃F+h &+hN"H hV"H baHذ2"X!T"BAXT"BAXhH    b4cl쇁%WLrn 1}-ćψʄ,5υBą܄̌ K>crMw|j0e@@wC)VAN& d hI\+XHdHA\@:8cH6 H0Ad4 `h"'"dd dddT  h 2"" #HX "Ad2"H" 9 54 AdhX "b" " h H"Ad2"H  "Ad4f"hȬX ȩX ȪX h " Hh"Ad2ȕf"h" XT Tz " @hhm;4"R4`;"H <"H U@@9"h:4"R4%b"H %"H 1%*3B3d: Dd hX20/h- hX, h& d   HhhhhhhX ȧ "V"d3 d3%) " ,H HȄ"  d3   @@ %=Uds   q" h= hX> #AB0, & B#XHH X,f4 +E4h#+h X  "Ȭʦhh+h:ʥh9ʦhX/ n n n Tȇ" h  Ts# hp Tc# h` 4hZhYhT`NhH hP hM hM hL hKXM@B s!l@: L>aArI%@@@Xoh`\V@ %\O}@ @\H[@|o?C5Ƙ1 `>Ř3Ƙ= " HX* `B\#Z]Y^]J@Ő1G" `R z` `TǷؔ3\՞+(Y^#Y^@@Y^Y^ Y^]@ŀ`\\յ@@>UV=UVŐ1` #d*@1*A`ݠ4ad`Š 1`Tǽ^]مٝYٵ ^\@Zy@X @@A@@UNƘ@:\X]9@ `Ř04Ơ,;.` `\õ~"@\ܞY@@&#^Y^Y^Y\}@\@AdA@*@Ke>@U@>G SYSTEM.PASCALSYSTEM.MISCINFILE SYSTEM.PASCAL NOT FOUND @h`5hhXTX  UbT  f X!TT@@ h  H Vn" FHT 5lf l bl bcch Ad `hchT  f"bD< "Ad2D; "Ad4`; "Ad`3Dd dDD DDD:D9 DDd%HXyQ NUX) IdX$ DsX BJ4 d`TӂPASCAL h nXBW X?T X<QjX T h H  jTD7TD!L  h h@@ h*X  aQX M" L I T h  TT$ INVALID PASCAL PARAMETER SPCIFIED `; "Ad`3Dd dDD DDD:D9 DDd%HXyQ NUX) IdX$ DsX BJ4 d`TӂPASCAL h nXBW X?T X<QjX T h H  jTD7TD!L  h h@`?.!? R?SREDUC $$ 999999` @ ENTER FILE NAME Tө @ml fNܑ̝ !\ԄPnC  fMd̦ <κ 6αIdNO   &&8398$$.). 0 *     TuFHITOPRCF$%&**G\d hdT TT/|d d d dTZ| TX| h !"(hLj"p8(h# 2T lȸl\͂|T<| hȩ 1\Tz ȡhT\T(19HFILE ERROR -- CODE ,A2,1X,Z4) \T݂$@@ h7 n H TT h\hGX%X#X!XXXXXXXXXX X X XXXXXH7h H/32"4` aADe !aaݘ AA a a Vh` X X ` X X X X X XH "H !H HT`h Hq``X`HX " hVHhB4 "c" H]h\hRhMhRKuXhKJhAHFv" c h8"5T39cTBh.h;X7H&8%#T$h$h@@`  TDT P TF TT4h255؈ȇXuh&ڨ*IhTuTp=H ' &eh @ȫTȨXȞ Tȡ`><Ȓ T H T+ QdT T+TT h3HHdhdDhhdTFKhh hHL8@ hk"ThT} hy"  b hqT PިXM H֨CbCwΨ U hS@@ Va `hL1D{lEwe& ?!RX"ȭ ȩ!0XHyl'e #!6X Ȍ TT `h XX\\ TaH #h! TDT hBDhEhBhBhDhwh:8# `h9 V1a Dh/X+)*h+DT+  #%  # Dj A Dh h h  Hhh&aH3[HX" L!`Ψh TDT aH> 3 DH-j+̾Ⱥ(j'% hȲDhT+̝Ȟ̘nΙlؘؚș@@ _ U h HDX hgHghf>XhdHdhc h-+h) H, @BH'H%#B9*h"H AhBH j `0 dT 'd a\ hrHr s"htjqh hDh`Hah`I/O REQUEST 9     X XX*EX XX&X+@XXX< XwhHh h,Yh*X" Mh$ h!X Vh hX TrhX@@ THXC A  TL `u HehdhgXlXvhb"aTZWDT hUHUHRRQ  pJf XNXXhEn HAXHXR(?R!39h9X?XInhTK  NX0h+0 .-h n ;ln  H T` + ȋXh؆1   HhH㞚  TDT hhhhdhhuXh̺ (BD n&ȫdȫ  hJIEhE h h  hh h8H6Q0TXDX h%`" "h*hTˈ̈ @@Ti h hhh ll X# Xhh@4i` Xj TDT Cr q d Y hUDhT XHXlhNXghX^h:a62Hl20X), H,)H& XX>h a&hh۸nX X h H   HShhh<@ TH@@ $T\h9Dh5TFh122-3 TD**%!!T TF \TT \T  H+h* r Gh hlBhHX"9" "hh0" T+TX% hT\H `CT T@ TFhTh XX TT 2X X' h$  X0X XzШ Xhˠ TD T H= X H8X H0TX*@) \TJ   hTHSTOP @@PAUSE  h\H jN qDhQ`hS \hL!:R hJE hBEOi:Dh d?\Ɏ9    !> ḷ l !& !/ l 9!/̫ !+̧ h$Bl !(m l 5T 9Y l̻ ̵dl\>;gT38T9  0l\C\ ldDdE d5:\͎9  ldF 9!. !* h>Ĉl̨ l 3\9@@    d; !Tю>; l F7̣ 4̠ l̜  0lT38T dHdIld?dJdKdL d5 f 1T 99 m l   l  l \ݎ9nl" $B lLd+Md>Nl,lLlll ̲ l,܌lLlެll,ЌlOdE Pl ̓ l T 99 B > : 6  93 % 9K L l 95 2v  0lo  dn dHlX̺ ̷ " ̯  Ed6@@m l D\9̠ ̜  dJ9  9! ! d+I$Bl c"H l T 9 9 0l ḏ k3 dl՜Llndddddd" D lld d!l TF̻ H6  l?  dldldl d;Tэ; l\; l\;Ṋl T H ̚dl̛dl l\Ս; l\Ѝ;)o" < ) EHp d"; d7l\7;m ! !lHd9=lT 9̘l\9 l\9 l  Hll\@@9ˬl dT l d,d-d. d5 n 1 dU +d?dJ d;Tю,; l\-;̗  l\.;d2d0d1ʤWdV  -lܺdldl" dl T/T(/d4:l  -ldlldX dY /̼dZ3d[$Bl,ld\NlLd+MllLld]߬l;,l,ތl,l,l  ,Llجٌl̶d^lLlͬlڌlLd_Ԭlܦf" ̜ !̗ !n d`  d5n 1J  4 l 7 -ldlo  Ԝl Όl@@ dY !Y 1TΫ n !M̷ da̳  l!̩ l !5 n̜ ܡ, d̥  ̦ l 7 +l̞dlܚ dEn 1 l 0n 1 d5 0n 1 dDo  nTdmlJ Ô4l̿ !i̻  l̶8T < l? \? ldU dl !  0ṉh\ܫ l̹ l\̎S̳ l  2\Ḁ l 2Dh\K@Y lm l 2\b lnT !dE  d58T < l?@@ \? l\A\S l  ̳h\Aܭ l" \֎R l\юQ\ώJ4dc2dd+ a!" 8 % l\Aܨ 1P\A\J\\Dd;d_ dXd^ldE d5l`p=l  lܹ 0f.lۜll 1  +d? dTlTюc;lcWdV dl -l l la  l 0dmde !#  l5T <ܘ \@ lڜ95h\a  lӜ4\b d;\c;̨ld_ dXd^d`l *l ̬ l̩df ,\<̤ @@l ! l l윳4\Aܯm la`p5'd+Ml 0e 4 n ḽḷl5 1 l l  1 mde " l +T < l ! dE " ll 8̽h\ܷ " l  l\юG̥ l !\Ŏ<̶ l !b@aH^H[TThh\hhhFhhhh{hhh\hhhhhhhah\hqhhvhhI\hgh\hch\h_h\h[h\hWh\hShA T` h/&hHgaV`H _H @@H M A cTXFRXB H H\TbO=:\ؖQO/  HI&Aa%acAD aa h h HR h2 H TԺ hHXhxhy`Xhh{ HfL#dhtHg ! lbag4lZ a``]cTX^RXZ I^HTb:: HG9Qs>L1a: Lw T&RH5 I  vR  LaTi\:Ti 3  l hh HOuhi[G M^@BPCE}GN HJzLLK@@@    @X 0t`H0 Q Xk"" R1`p @X 0RRt` 0 XJ` h9aaaa&H}H |H%2H M A chxV "Xa bX\ kJ " H\66\6-6@T:\ 6-0-6TgԘ6-6B  HI ;a88Aa,h/aAa+aah$cDAaghDaau h h HR 1  H XԺ hfHXhh`Xhh[ HL#dhSH ! laal aa<`9ch9W "X@@ bX *L "HTg HsLoAAd] T|LQ3AaI 'Lv T*a)RH%3I  aHQ A a#vR  2LaHH ALȱaXa\XY N[ hhh-uhi f[G ߂M^@BPCE}GN HJzLLK@@@ bX *L "HTg HsLoAAd] T|LQ3AaI 'Lv T*a)RH%3I  aHQ A a#vR  2LaHH ALȱaXa\XY N[ hhh-uhi f[G ߂M^@BPCE}GN HJzLLK@@`r*!TIMSTAMP$$ 999999060381` @""" e"aaXITxC e"aaX;%" <XHh-" <"XAh$""X=hT?@CABBBB TIME SINCE LAST CALLED : : c# VC`K 0<a 7a 2a"B0F 0 0% X X ` X X X X X XH "H !H HT`3̿l̟lŜ  @mܒέ , ldgdTV֐g l =k = < wd$  @`3K!3j3VOLSON $$ 123180072280` @ TX\]^Tʂ_bcT\dgeffLhI HG""7YEhuS hsNOhn hl"hmTfkhVjhVfhSbhP^hMT\eeffQPNT MMLUTBLU VOLUME NAME ON-LINE -- ----------- ------- A08 SYSVOL YES ! X X ` X X X X X XH "H !H HT` HT"hShIhHH JxG"h?h>h= hhhh hg j?T&>Oa# T&"PW$`,3 l  lT&M>1R lT&NK @@$$CREP $$ SYSVOL h""3 2"l ldX a#*a a a a a"a !RA aXdX%X#X!XXXXXXXXXX X X XXXXXH7h H/32"4` aADe !aaݘ AA a a Vh` aafRda -a0F 0ac 2 .a `9ac a aA `! aa a( a .a 0a!@@D Q" !yR *a aa A a! a"X a! a"XPXHH"4` " "aXaX ahh`XPqa aa a a a a a! a"Xa"  6 9! T d  a a! a"X   `  `  aXaaX" a   a! a"X  aaX'bdRQ"X ; aX 3 aX +  "X yaX M  "X laX l X baX Xf" @@#"Xf" a# a a A aA aA  XX" a a A aA   a  aXeX"a A a` !RAX(aS aXHK aX@C  "X aX6  "X aX)a#"XE"a` aX O aX #"X- X aX aa  "X a! a"X a az a a a p a_a( a! a"Xu^aXX1 aA a a! a"X a! a"XU a! a"XN2a a Da  a  @@a  a! a"X 3 ! a! a"X" h`X`````` a` a` `/" 4 A *a A %lR@@R@@R@ -A` .a ` a! a"X a! a"XX %hJTܵ``X  -`% ` c1X d 2Q\ݵ``X c1X \[Zr@``X #  a` aܐ!X `` `\YH]@X``X  a Da a! a"X a! a"X: a  +a `"d` 5 aXM aaXFa@@`aBP@@H bb@`X X a*` a aX &Baa"aC3%pȰ,` Ȱ#`XaXȰ#`XaȰ#`XTbX&)+25,Ȱ#`X TA a!1  !1Xv`` `"Ƞ>a.`AA&dRARAa 2H a a a a 4Da a a a @@>`)X X9Tbbb T@@@ ` *`@ @id`d`d`  Ȱ.`"Ƞ,2!Ƞ#`'2 ' dXX.#Ȱ.` !Aa@ !! A !! A !Aa@Xa@ !! ƁXÁX@` !AX`"Š"Š``@ AaaA3AasA``c` 1 m@`$ `ǨA a a a "Ƞ-G . a a a a a a a #a Ƞ=`XX(X~#Ȱ.`1@@   #0a d a  !13d #2d Ad( 2adaa1 aDa1bAa?ad A2aF ad2aa1`a1`Da1` a a aȀ-`aaaaA&RARAda2H a aaa  ! T)a a a a _XadadRXWaAaA!dذ2H a "a aAa A a hda da da  a aa  a1 a A  a A a A a A a" @@x a ` d aa bAa a babAa"H1h #h`Aa`Aaa`AaaMaB a #a  A Dda a a #a  n a )a a #a A a A # a 2W  ,or | AA A   AA A  a A kdRA a da . Ƞ>t` A U@ `a `X"dR@ R  B H gad `Ȱ#`XTbȰ#`X`!dB2 @rdR@`/@@@o aHhB4 "c"#y a%XOH!""" A#*   "!"X3# a1rX)""  "!f" !" f""" f" "a""! h " "f"" "f" !"` a! a a"X  a! a"XXaa a a! a"X~"  !T 9!a Fa a! a"X a a! a"Xf a! a"X a a! a"3X6Xh`X``` a` a` `/" 4 A *a A    gR@R@ -A` .a ` a! a"Xi a! a"XX@T<X -`" ` c1Xd 2QT<qX c1XjT<[Zd@X #  a` aܐ!XsTa.`X"dR`2H `͠ `D`D```XCXX}XS#Ȱ.` A`@ @ ŀX2X0` `2@A`πҐ`"G z @35` ` 2` 1`ϐ+ e% b ``"dR`2H ```XcX X8#Ȱ.`aA@͠`d `rd 0 d1 " 2a0 `Da0 1 q  ! Xn` ` `X XdRXX@`!d@@߰2H `Ԡ"`@`ed`d``Vϐ.`@`@`@ϐ"h t=`hA``h`A``B΀" e " `@2T "@k"Ƞ>.`Rd"Ƞ>`R@`" ` &B``` "Ƞ,2!Ƞ#`&2  X/2 <CF=BȰ#`X X9@ `X!X1 Ƞ$XX Ƞ$!1H%X#X@@ X X 4 4p"d 2esR4R4!D RȢA1`R "dR@ R  B H gad `Ȱ#`X0Xb Ȱ#`X$`!dB2 @rdR@`/@Ƞ4` H(X t` Q  T$"" R1 H XRRt`p` ```TܵBP@@@ X X 4 4p"d 2esR4R4!D RȢA1`R "dR@ R  B H gad `Ȱ#`X0Xb Ȱ#`X$`!dB2 @rdR@`/@Ƞ4` H(X t` Q  T$"" R1 H XRRt`p` ```TܵBP@@`E'L!EDREWATZIT $$ ` @ΓK (22H AS FLOATING POINT , F9.0 ) TFz(TT(A2,21H ENTER IN HEX FORMAT:) TTNh\h\z  hȷh\ ر 1 hȪh\αؤ 1 hȝh\&ؗ 1\Tڂ@q$\Ԃ\Ԃނf!J\Ԃ܂`!B d\߸ԂS" l\ָԂJ" l\͸ԂA" l\ĸԂ8" l\Ԃ؂/" llTFzTTT\z9\\\O@H;A7GN E}CBP12!#(///22H IN HEX $,Z4,3H, $,Z4,/22H IN ALPHA -,A2,A2,1H-,/22H AS DECIMAL INTEGERS @@ ,I7,1H,,I7)(22H AS FLOATING POINT ,F16.7) (22H AS FLOATING POINT ,E14.7) T(ej H" 2 1 `h"Ƞ 2 1 `ȸ**0 @,\o*[,g_), ILLEGAL CHARACTER IN INPUT, RE-TYPE LINE PLEASE 4P  hT-hhj \󃯃jh hȻhTjinȈ +\؃hhƜ 1˜ 1Ȼh\hhH TT h\h@@09 ,.+-AFPe. lhh h T s\ "\hhȘ 6՘ 2h˘ 6˘ 2hŘ ȸhȿ ȳhȹ Ȯhȳ ȩh (hh (Ah$h"! ( *.-+lTBl dRlO lUdkdSu dldHTThUhe\hQha\hT\hPh9 X X ` X X X X X XH "H !H HT` hdcHcHbXAHXX? hVX<Ȓ T7 H Tv d=T3 TvT7T?;;;;<;;;;; h3HHdhdDhhdjTFKhh hHL8@ hk"TChT>} hy"  b hqT[ PިXM H֨Cb@@CwΨ U hS Va `hL1D{lEwe& ?!RX"ȭ ȩ!0XHyl'e #!6X Ȍ TFTU `h XX\\ TaH #h! TT hBDhEhBhBhDhwh:8# `h9 V1a Dh/X+)*h+DTv  #%  # Dj A Dh h h  Hhh&aH3[HX" L!`Ψh TT aH> 3 DH-j+̾Ⱥ(j'% hȲDhTv̝Ȟ@@̘nΙlؘؚș _ U h HDX hgHghf>XhdHdhc h-+h) H, @BH'H%#B9*h"H AhBH j `0T  l 'd l\T hrHr s"htjqh hDh`Hah`I/O REQUEST ν     X XX*EX XX&X+@XXX< XwhHh h,h*X" h$ h!X @@h hX ThX T>HXd d TL `u HehdhgXlXvhb"aT4ZWDT hUHUHRRQ  pJf XNXXhEn HAXHXR(?R!39h9X?XInhTK  NX0h+{ yxh n ;ln  H T` + ȋXh؆1   HhH㞚  TT hhhhdFhhuXh̺ (BD= n&ȫdȫ  hJIEhE h h  hh h8H60T3XDX h%`" "h*@@hT+ T h hhh ll X# Xhh@4i` Xj TT Cr q d Y hUDhT XHXlhNXghX^h:a62Hl20X), H,)H& XX>h a&hh۸nX X h H   HS@@hhh<@ T7H $T\h9Dh5TFh122-3 T**%!!T3 TF \T=T2 \T  H+h* r Gh hlBhHX"9" "hh0" T4+T3X% hT\H `CT T7@ TFhT3h XX T3TF 2X X' h$  X0X XzШ Xhˠ T TF H= X H8X H0KTPX*@) H\TJ   hTH@@FhYSTOP PAUSE BA h\H jN qDhQ`hS \hL!:R hJE hBEOi:Dh ḷ l !& !/ l 9!/̫ !+̧ h$ˈl !( l 5Tk l̻ ̵dl\ǐ@@gT~T(M  0l\\M ldd d:\͐  ld 9!. !* hĈl̨ l 3\    d !Tǐ l F7̣ 4̠ l̜  0lT~T( ddldddd d ft 1Tk  l j  l  l r\ݐl y$ˌ lLdd׬lx,lLlll ̲ lw,܌lLlެllv,Ќld l ̓ l rTk B > : @@6  93 %   l 95 2v  0lo  d dlX̺ ̷  ̯  Ed l D\̠ ̜  d  9! ! d$ˌl c" l Tk  0l dẕ k3 dl՜lddudvdwdd D lxlyddl Tvz̻   l  dldldl dTv l\w l\xṊl T8vzz  ̚dl̛dl l\Րv l\Аw)@@" < ) EHp d; dl\ ! !lHd¤lTk̘l\ l\ l  Hll\ˬl d l ddd d n 1 d +dd dT l\̗  l\򐷐dddʤd  -lܺdldl dl T萸Tdl  -ldlld d /̼dd$l,ldlLdllLld߬l,l,ތl,l,l  ,Llجٌl̶dlLlͬlڌlLdԬlܦ@@fz ̜ !̗ ! d{  dn 1  l 7 -ldl  Ԝl Όl d !Y 1TΫ n !M̷ d̳  l!̩ lz !5 n̜ ܡ, d̥  ̦ l 7 +l̞dlܚ dn 1 l 0n 1 d 0n 1 d j jdl Ôl̿ !i̻  l̶8Tk l \ ld dl !z  0ṉzh\ܫ l̹ l\̳̐ l  2@@\̥ l 2̀zh\ l l 2\ l !d  d8Tk l \ l\\ l  ̳zh\hܭ l \֐ l\ѐ\ϐdd+ !" 8 % l\ܨ 1P\\J\\Ddd ddld dl`p=l  lܹ 0f.lۜll 1  +d dlT>ld dl -l l l  l 0dd !#  l5Tkܘ @@\ lڜ9h\ lӜ4\ d\̨ld dddl *pl *̬ l̩d ,\̤ l ! l l윳4\ܯm l`p5dl 0e 4 n ḽḷl 1 l l  1 d "r l +Tk l ! d " ll 8̽h\Tܷ "r l  l\ѐ̥ l !\Ő̶ l !b@aH^H[TThh\hhhFhhhh{hhh\hhhhhh@@hah\hqhhvhhI\hgh\hch\h_h\h[h\hWh\hShA T6` h/&hHgaV`H _H H M A cTXFRXB H H\((T((*=:\ؙ(ڙ(*/  HI&Aa%acAD aa h h HR ,l̙ H T6Ժ hHXhxhy`Xhh{ HfL#dhtHg ! lbag4lZ a``]cTX^RXZ I^HTÙ HG9Qs>L1a: Lw T&RH5 I @@ vR  LaT\T T?5 hh Huhi[G M^@BPCE}GN HJzLLK@ XJ` h9aaaa&H}H |H%2H M A chxV "Xa bX\ kJ " H\\x@T:\ x{xTƾԚxB  HI ;a88Aa,h/aAa+aah$cDAaghDaau h h HR  `h H XԺ hfHXhh`Xhh[ HL#dhSH ! laal aa<`@@9ch9W "X bX *L "HTƹ HsLoAAd] m 5|LQ3AaI 'Lv T*a)RH%3I  aHQ A a#vR  2LaHH ALȱaXu\Xm N[ hhhxuhi f[G ߂M^@BPCE}GN HJzLLK@@@9ch9W "X bX *L "HTƹ HsLoAAd] m 5|LQ3AaI 'Lv T*a)RH%3I  aHQ A a#vR  2LaHH ALȱaXu\Xm N[ hhhxuhi f[G ߂M^@BPCE}GN HJzLLK@@`g8!sHWEAVE $$ ` @? HX,  XP hTɂ hTn-;=h P: hTl8./0>TX:)  T_4)8./0>T4TT` I @P9N @@@P @PF=@P*@@@P@P00 @PXXXXXXXXX 99, 9999@@@PXXX 99, 9999@P99/99/99@PMR. JOHN SMITH616 ELAINE AVE@@@PSAN DIEGO, CA. 92115@PJOHN SMITH@PMR. SMITH @@@PMR. R. JONES(999)999-9999 SXG# A J BE @BBXnPaH -- dTu hX6 fZ hJ6 f dȾd dd7d:d dddd ddd! dE % "lTd dd"T> lTƟ ld.dd# 1̴ Tc ḻ % " l̩ ̦ ̣ ̣ \ǟ̚ d!  $ 1̝@@ W E A V E VERSION 3.91 01/09/81 80 2?A0@IJ$$ _TsڈۈT ݈ވ߈ނrrT0o~wTdsTo\~ h T(Ā3hTTȾ ȹ(3hTȮ h " (hzyu Tׂ T (h\q \ꂋ  $h \߂hMT]C " ,h ,uhTXo \ ,h)(ί ,̀uh ,ȀshTdνT?osTw,3hToe̽ ,hu  ,uhTςqT?H\T 5@@Tz+ d}hT 1T(27HDONE--REMEMBER TO SEQUENCE ,4A2,15H BEFORE EDITING) \~qq<\z// lŀh\ܿ 1\(24HFILE PYRAMID TO DEEP -- ,4A2) \ d,3h\ 1THTThhy\h m KTnlTl `lTo -TdhphT'qhT HTThh\hh h h h hINPUT FILE: OUTPUT FILE: \ɟldTM \ @Sm̡Pnܟ# ( D̓ T\\T 銱@@늾  T\芷 T TT TXHTThh\hhhh\h\h\m mфPn̟d l\̱ \ d: dTF̕ .  -  \)*n!lw   8 5 %  l lT +l̯d"Y TӟZd^8d l lT@P̯ d\̦l l\̝ d  h\t  l@@@P h\t  l\" ܳܲTM l̚  @P̦ diܞtܙ 2 l $ d' a Hd@P !d $ l(Hld   ' )̳ Tk@@@P L̨ \̞ \\"  \܎@P w 1 l , d $ dPTHd" 9 &@P dH!lll dT~HFT l̽ dtT Kt@@@P  H  l\HF\ܜ 1\H\!H l\HF \\J@P \!H l\H!\HF\T J\H /l\@P #"H!"\HF\\J\H\H! NdT H FT @@@P N\JT !H\#H!# kl\HF\(H%TTh'\h \e? \_E \YK \SQ \MW \G] \Ac \;i \5o \/u \){ \# \ \ \ \  \@@PQ8PKUP tQ8PREP qCCSBLK CCSCST.CCSMVA RFWRITE EDISP MLTRDTECCSGETP PLTRDTE B76 F CCS CCS 3.0 SL-149@@@P@PI @P , 19 @@@PJANUARY FEBRUARYMARCH @PAPRIL MAY JUNEJULY@PAUGUSTSEPTEMBER OCTOBER @@@P(NOVEMBERDECEMBER@P0JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC @PRhhhh  @@@PiTII\IJITd"! ."4GYl~@P\JHJȫ h \KK@P\ KHKȗ h\KK\MHMH h\KK\M@@@PHM h\KK\OHO hTjKK\PHP@P h\KK\PHP̲ h\KK\NHN̟ h\@P*KK}\LHL̍ d\KKj\$JHJH l\KKW@@@PU\(KHK l\KKE\,KHK lTKK2@Paz@PzTyd  dQ\0QOO\II\IJI l\KK@@@Pc@PTH@P@@@POHLTThh h h\hhhhhhhhhhh&h@P.h5h=hDhLhRh[hahjhphxh~hhhh\hrh\hoWPLTRDTE@@m @HH H h h !#H  H"h!_h (dh( hDhTd !9TE .\E h 1#Tz'TT(31HERROR IN WRITING FILE - ISTAT=$,Z4) TH TTh\hh hÌ   1 6 -3TӲd-ȧḻ ȡ \ #3̽ / h *T @@@P&@P'@P'IV1@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@P't@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@P'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@P'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ÒH_ h TÒ TH T T_ T  Th \Ac T T \/u \){ \# \ \ \ \  \)*PX Y ,(-' @h hhTF. -  Î h\ 4T hh˘6 f Î \\  \  ̵h hhM TNShAhK  K \ @mۄPn lJ #\@@! "N-  G  !T ffffl n lTF. \  ÎS  \l dd4 ̪ \* 3 \'̙  9 !5  3\ df-  \̘ ̴ Q̯  {D % lT̬nܗ ̓    d d $\̰ dNTK@Umm! Sm d §O Id $\z0  I@@ T @mC \\ d- N @ HH& d-dd5d+d,T!0-*6/  l 0 -TÚ"! ,1PONMLK\Ú" ; (K Dܶ "\Ú̯ l̮d4̩ "\Û* \Ú  d7dÜT70Ü l l2 \Ú(6/ %0 1  TÝ,  \Þ̷ A dHS$ hTF. S- S\ !N X$ hhd#!+ * Č " >@@dh h)nصض 1ӌl̼  dT ̳ 1 lȜlTP\̤ ̠  lO l\Q̥lTF +-4 1 HoW, hhh dNSh $Lh"p8 hh Hhըh h h 'T l=TF * $. \ȶh "\jت- Ƞ  \ȕ @-h %-܈DŽl @HH'!"#%&:;<>?@[\]^_SU,=@@0[\2. hnh hh hhTF. - ؽTŕ[ M TNSI 0@mK-  @mk K K \ŖCŦ K \ŗοO κE \Řƍdřή Ŕ TŚ[l dś f| 1 dŜdŝdŞdşNPdʼnSIdŊlHk    l`笚dŋ Um $Lh(p8% dŠlƬ Hlšl ldŢn l ܘ Ŕ !- ŌdōdŃ@@ŎdŇTddţ dœ  dś̞lTF. M TNSIŦ 0@mK(  @mI TŤ[K ̈́Pf|Š l̍ -  4\ť[̟ l Ŕ lŋl l dŢT2 TF̓dś \  * $. \ŧ[f}\ 1 ؞ !Ι !f~̚ \ 1 f- ̙ lŠ l ̩ lܗŔ TŨ[\̫    dũdŪņdşłdŞ̳dŝœ@@  $ŌdƸ ,$ōdţ$ŜlʼnnfŊf l ū!) n dŒő m l- eT2 ] \Ŭ[ l̝l̩ŀl 1̜ńlŃ 1̎ňdşŇ 1Ū   n"̖dŭŏll dŮ důTF̧ .  * 2zl\ u u u TŰ- Q l dű d7T2   l\ŕ[ dŲ dųdŴ(dŵ /$?@[\]^_\5 hT2  h    l d7 h h\ T̋ lx   ȿ  ػȻ1ȵlȴ h \̌9T̉o hn  ܨȤnhTe$5؛ 1 d̎̉!5T2(l /$Fl\$5ܚ lvl /#l\$5  l  El  $lHTThhh\hyHAEFHI.)R$/X,(0 l3 l2l2l2l2hhhT7YX h     h h "! '@@UTȽ d 1Ⱥ !" : ' hȣ裖G " ; '_zyw Z 1 ̷" 8 $ ̥" 8 $ ͐" 8 $`["! 1umfvmxJmkGEvtf̧ d[ !g"! *[Z7XZ l ̵W  1@"! )F542F76>YUd͒ d͐V m l d͑ l l l lܿ l l ll l lьl l l l l̻@@h , l "ΒZl̲  ̠h $͔l ̑h $͓l̋Wl̊ Β l dXT7YXYU " d " d͐lV  l[ "΢Χ| l$H!TThfhh?h\h_hF\h[h1\hWh\hTh+QR e h! d%TF. ,TE-  [}\ \FM P\G  CTu d_T N@Sm  @m@m 0@mׄPn̦ ̖ \F"\ @m̾n@@\ ZhW VhR PhPhT ĔĕlTSC@ ?UDhh  ) TEuĖ騹 hʟdi djȯdkTM T#̧Ph \ߟx ¤Ęd dĖ \ʟuĖNγDl\uĖHTT#h h   l :  ! l l  ! !% dl l h 5 dl lTLJ T?L lhHTTh\hh h h hh hh\hhh hT )  l+Il&ƋTz TT(34HERRO@@R IN READING FILE -- ISTAT = $,Z4)THTTh h\h\h\h\ht Sl l,dNTΧIsdwΡE_hB(, h  hTdl hT lvHTT h\h\h\h\ %hϟx h8nHTT h\ h\h h8n #H TTh\ h\hT H TTh\h T H TTh\h,  D  TT®î\\ hhTnǮh hiTThd hbTUTh\@@Ǯh Q d \ȸ hA\دTh=ȯ h;\U̯Tȧh\Ǯh +Ȝ h%\Th!ȓ h\UT 1 Dh\Th h \UTY&H#TThhhhhhh\hfhh hdh\hhh\hahS+sl#T}T.}T} HTTh@ \ퟀ)  hT  h 1 h hh h\h ژ 2 hNҘ 1Th\h\hT䯣ؾ H1ȷ )\诠h\HTThhh\h\hhzT h\(h\(l\ h\(h\(l\ @@h\(h\(lC H TTh h h͛N HTT\D % l\ThTi  ! lh hHTTh\h\hh\h  h "h $H TTh\hINPUT=@PROC UTIL BATCH,FN= ,HO= ,AP= ,TY= ,PN= ,M= EX @@ DELETE,FN= @PROC $$ SYSVOL ll $)2 l\zl d М hTᲈh̴ h\y P!̺l\zl̟ d  ̙ d\yy5H2TTh)h-h<Ȓ T H T CdTڠ TTTv h3HHdhdDhhdTF@@Khh hHL8@ hk"ThT} hy"  b hqT PިXM H֨CbCwΨ U hS Va `hL1D{lEwe& ?!RX"ȭ ȩ!0XHyl'e #!6X Ȍ TT `h XX\\ TaH #h! T6T hBDhEhBhBhDhw{h:8# `h9 V1a Dh/X+)*h+DT  #%  # Dj A Dh h h  Hhh&aH3@@[HX" L!`Ψh T6T aH> 3 DH-j+̾Ⱥ(j'% hȲDhT̝Ȟ̘nΙlؘؚș _ U h HDX hgHghf>XhdHdhc h-+h) H, @BH'H%#B9*h"H AhBH j `0 'd  hrHr s"htjqh hDh`Hah`I/@@O REQUEST     X XX*EX XX&X+@XXX< XwhHh h,Kh*X" ?h$ h!X Hh hX TdhX THX TL `u HehdhgXlXvhb"aTZWDT hUHUHRRQ  pJf XNXXhEn HAXHXR(?R!39h9X?XInhTK  NX0h+"  h n ;ln  H T` + ȋXh؆1   HhH㞚  T6T hhhhdhhuXh̺@@ (BD n&ȫdȫ  hJIEhE h h  hh h8H6C0TڠXDX h%`" "h*hTb T[ h hhh ll X# Xhh@4i` Xj T6T Cr q d Y hUDhT XHXlhNXghX^h@@:a62Hl20X), H,)H& XX>h a&hh۸nX X h H   HShhh<@ TH $T\h9Dh5TFh122-3 T6**%!!Tڠ TF \TT \T  H+h* r Gh hlBhHX"9" "hh0" T+TX% hT\H `CT T@ TFhTh XX TڠT 2X X' h$  X0X X@@zШ Xhˠ T6 T H= X H8X H0TX*@) \TJ   hTHSTOP PAUSE h\H jN qDhQ`hS \hL!:R hJE hBEOi:Dh ḷ l !& !/ l 9!/̫ !+̧ h$l !(- l 5T l̻ ̵dl\gT%TɄ  0l\\Ʉ ldd d:\  ld 9!. !* hĈl̨ l 3\@@    d !T l F7̣ 4̠ l̜  0lT%T dd ldd d d d f 1T - l ġ  l  l ĩ\.l $ lLd dl,lLlll ̲ l,܌lLlެll,Ќld l ̓ l ĩT B > : 6  93 %    l 95 2v  0lo  d. dlX̺ ̷  ̯  Ed@@- l D\̠ ̜  d   9! ! d $l c" l T  0l ḏ k3 dl՜ l.dddddd D llddl T]̻   l  dldldl dT l\ l\Ṋl To  ̚dl̛dl l\ l\)/" < ) EHp d; dl\- ! !lHdlT̘l\ l\ l  Hll\@@ˬl d l ddd d n 1 d +dd dT l\̗  l\dddʤd  -lܺdldl dl T]Tdl  -ldlld d /̼dd$l,ldlLd llLld߬l,l,ތl,l,l  ,Llجٌl̶dlLlͬlڌlLdԬlܦf ̜ !̗ !. d  dn 1  l 7 -ldl/  Ԝl Όl@@ d !Y 1TΫ n !M̷ d!̳  l!̩ l !5 n̜ ܡ, d̥  ̦ l 7 +l̞dlܚ dn 1 l 0n 1 d 0n 1 d/ ǡ ǡ.d-l Ôl̿ !i̻  l̶8T l \ ld dl !  0ṉh\ܫ l̹ l\̳ l  2\̥ l 2h\ l- l 2\" l. !d  d8T l@@ \ l\\ l  ̳h\ܭ l \ l\\ d#d$+ !!" 8 % l\ܨ 1P\\J\\Ddd ddld dl`p=l  lܹ 0f.lۜll 1  +d dlT#ul#d dl -l l l!  l 0d-d% !#  l5Tܘ \ lڜ9h\d lӜ4\" d\#̨ld ddd l *l a̬ l̩d& ,\̤ @@l ! l l윳4\ܯm l!`p5d l 0e 4 n ḽḷl 1 l l  1 -d% "ȩ l +T l ! d " ll 8̽h\ ܷ "ȩ l  l\̥ l !\̶ l !b@aH^H[TThh\hhhFhhhh{hhh\hhhhhhhah\hqhhvhhI\hgh\hch\h_h\h[h\hWh\hShA T` h/&hHgaV`H _H @@H M A cTXFRXB H H\__T"__a=:\__a/  HI&Aa%acAD aa h h HR Y dB H TԺ hHXhxhy`Xhh{ HfL#dhtHg ! lbag4lZ a``]cTX^RXZ I^HT" HG9Qs>L1a: Lw T&RH5 I  vR  LaT)\T)   hh Huhi[G M^@BPCE}GN HJzLLK@@@    @X 0t`H0 Q X"" R1`p @X 0RRt` 0 d" dB H TԺ hHXhxhy`Xhh{ HfL#dhtHg ! lbag4lZ a``]cTX^RXZ I^HT" HG9Qs>L1a: Lw T&RH5 I  vR  LaT)\T)   hh Huhi[G M^@BPCE}GN HJzLLK@@(rm TTABIT LIBRARY Pb999999060381(0 NAM BIT 00010 ENT BIT 00020 SPC 3 00030 EQU ZERO($22),ZROBIT($33),LPMASK(2),LIM(10),AEXTBL($E9) 00040 EQU AEND0(15),ONEBIT($23) 00050 EJT 00060 SPC 3 0007000* PARAMETER PICKUP ROUTINE 00080 SPC 2 00090PICKUP NUM 0 00100 LDA* BIT TEST FOR PART 1 00110 SAM P10 IN BANK 1 MUST BE PART 0 00120P05 JMP P50 GET END0V4 FROM VECTOR TABLES 00130* PLUG P05 AND P05+1 WITH SUB =XEND0V4 0014000 INA -1 00150 SAP P10 00160 LDA* (BIT) NOT PART 1 00170 SAP P20 SKIP IF ABSOLUTE 00180 ADD* BIT RELATIVE-- ABSOLUTIZE IT 00190 AND- LPMASK+15 00200 JMP* P20 0021000P10 LDA* (BIT) 00220P20 RAO* BIT 00230 TRA Q 00240 LDA- (ZERO),Q BIT VALUE IN A, ADDRESS IN Q 00250 JMP* (PICKUP) 00260 SPC 2 00270P50 LDQ- AEXTBL 0028000 LDQ- AEND0,Q 00290 STQ* P05+1 00300 LDQ =N$9000 00310 STQ* P05 00320 JMP* P05 00330 EJT 00340* STORAGE 0035000SQ ADC 0 SAVE Q REG 00360SI NUM 0 SAVE I REG 00370ADDR ADC 0 ADDRESS 00380 SPC 4 00390BIT NUM 0 ENTRY 00400 STQ* SQ SAVE Q REG 00410 LDQ- I SAVE I REG 0042000 STQ* SI 00421 RTJ* PICKUP GET FIRST PARAMETER 00430 STQ* ADDR SAVE ITS ADDRESS 00440 RTJ* PICKUP GET SECOND PARAMETER 00450 INA -1 CONVERT TO ZERO BASIS 00460 TRA Q COPY IT TO Q TO FORM WORD INDEX 00470 AND- LPMASK+4 MASK TO FORM BIT INDEX 0048000 TCA A NEGATE IT 00490 INA 15 TURN BIT ORDER AROUND IN WORD 00500 STA- I BIT INDEX TO I REG 00510 QRS 4 FORM WORD INDEX IN Q 00520 LDA* (ADDR),Q GET PROPER WORD 00530 AND- ONEBIT,I GET BIT 00540 SAZ 1 IF ITS ZERO, ITS ZERO 0055000 ENA 1 IF ITS NOT ZERO ITS ONE 00560 LDQ* SI RESTORE REGISTERS 00570 STQ- I 00580 LDQ* SQ 00590 JMP* (BIT) 00600 END 00610_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(r TABLKSIOLIBRARY P999999060381(0 NAM BLKSIO BUFFERED WTREAD INTERFACE SUMMARY-*** 00010 SPC 2 00020*** ENTRY POINTS 00030 SPC 1 00040 ENT CLRLIN CALL CLRLIN(ILN,ICL) 00050 ENT CLRSCR CALL CLRSCR 00060 ENT DISPOS CALL DISPOS 0007000 ENT DSPLA CALL DSPLA(ILN,ICL,ISTR,ILEN) 00080 ENT FLUSH CALL FLUSH 00090 ENT INPLEN N=INPLEN(N) 00100 ENT INPUT ITC=INPUT(ILN,ICL,ISTR,IMAX) 00110 ENT TERMCH ITC=TERMCH(ITC) 00120 SPC 2 00130*** EXTERNALS 0014000 SPC 1 00150 EXT CLOSFL 00160 EXT OPENFL 00170 EXT WTREAD 00180 SPC 2 00190*** EQUIVALENCES 00200 SPC 1 0021000BUFMAX EQU BUFMAX(80) 00220 EJT 00230LU NUM 5 00240HFFFE NUM $FFFE 00250H0000 NUM $0000 00260H1600 NUM $1600 00270D00001 NUM 1 0028000TC NUM 0 00290 SPC 1 00300BUFBUF EQU BUFBUF(*) 00310IREQ BZS IREQ(24) 00320IDATA ALF 4,$$SYSA 00330 NUM $0924 00340 ALF 3, 0035000 ALF 4,SYSVOL 00360 NUM 0 00370 NUM 1 00380 NUM 0 00390 BSS (BUFMAX/2+1+BUFBUF-*) 00400BUFPOS NUM 0 CURRENT BUFFER POSITION 00410 EJT 0042000*** DISPOS 00430* 00440* DISCARD ANY UNDISPLAYED TEXT AND SET OUTPUT BUFFER EMPTY. 00450* 00460* FORTRAN CALL: 00470* CALL DISPOS 00480 SPC 4 0049000DISPOS NOP 0 ENTRY/EXIT 00500 ENA 0 00510 STA* BUFPOS SET BUFFER POINTER TO EMPTY 00520 JMP* (DISPOS) RETURN 00530 EJT 00540*** FLUSH 00550* 0056000* FORCE DISPLAY OF ANY TEXT REMAINING IN THE OUTPUT BUFFER. 00570* 00580* FORTRAN CALL: 00590* CALL FLUSH 00600 SPC 4 00610FLUSH NOP 0 ENTRY/EXIT 00620 LDA* BUFPOS 0063000 SAZ FLS01 00640 RTJ WTREAD FLUSH BUFFER 00650 ADC LU 00660 ADC XYP 00670 ADC BUFBUF 00680 ADC BUFPOS 00690 ADC HFFFE 0070000 ADC H0000 00710 ADC H0000 00720 ADC TC 00730 SPC 1 00740 ENA 0 00750 STA* BUFPOS SET BUFFER EMPTY CONDITION 00760FLS01 JMP* (FLUSH) RETURN 0077000 EJT 00780*** CLRSCR 00790* 00800* CLEAR THE SCREEN 00810* 00820* FORTRAN CALL: 00830* CALL CLRSCR 0084000 SPC 4 00850CLRSCR NOP 0 ENTRY/EXIT 00860 LDA* CLRSCR 00870 RTJ* PRESET 00880 SPC 1 00890 ENA 0 00900 STA* XYP SET HOME POSITIONING 0091000 ENA 2 00920 STA* BUFPOS 2 BYTE CLEAR SEQUENCE / DISCARD ANY EXISTING 00930 LDA =N$2018 00940 STA* BUFBUF INSERT CLEAR SEQUENCE IN BUFFER 00950 JMP* CMNEX RETURN 00960 EJT 00970*** CLRLIN 0098000* 00990* CLEAR SPECIFIED LINE 01000* 01010* FORTRAN CALL: 01020* CALL CLRLIN(ILN,ICL) 01030* ILN - SCREEN DESTINATION LINE ( 1 <= ILN <= 24 ) 01040* ICL - SCREEN DESTINATION CILUMN ( 1 <= ICL <= 80 ) 0105000 SPC 4 01060CLRLIN NOP 0 ENTRY/EXIT 01070 LDA* CLRLIN 01080 RTJ* PRESET 01090 SPC 1 01100 ENQ 2 01110 RTJ GETARG 0112000 SPC 1 01130 LDA =XH1600 01140 STA P3 POINT P3 TO CLEAR CODE SEQUENCE 01150 LDA =XD00001 01160 STA P4 POINT P4 TO CLEAR CODE LENGTH 01170 JMP* DSP00 USE DSPLA TO INSERT CLEAR SEQUENCE INTO BUFFER 01180 EJT 0119000*** DSPLA BUFFERED OUTPUT 01200* 01210* DSPLA PERFORMS THE BUFFERED OUTPOUT FUNCTIONS. 01220* 01230* FORTRAN CALL: 01240* 01250* CALL DSPLA(ILN,ICL,STR,N) 0126000* 01270* - ILN LINE NUMBER ( 1 <= ILN <= 24 ) 01280* - ICL COLUMN NUMBER (1 <= ICL <= 80 ) 01290* - STR TEXT 01300* - N LENGTH OF TEXT ( BYTES ) 01310 SPC 2 01320DSPLA NOP 0 ENTRY/EXIT 0133000 LDA* DSPLA 01340 RTJ* PRESET 01350 SPC 1 01360 ENQ 4 01370 RTJ* GETARG 01380 SPC 1 01390* VALIDATE PARAMETERS 0140000 SPC 1 01410DSP00 LDA* (P1) VALIDATE ILN 01420 INA -1 01430 SAM DSP01 01440 INA -24 01450 SAM DSP02 01460DSP01 JMP* CMNEX 0147000 SPC 1 01480DSP02 LDA* (P2) VALIDATE ICL 01490 INA -1 01500 SAM DSP03 01510 INA -80 01520 SAM DSP04 01530DSP03 JMP* CMNEX 0154000 SPC 1 01550DSP04 LDA* (P4) VALIDATE N 01560 INA -1 01570 SAP DSP05 01580 JMP* CMNEX 01590 SPC 1 01600DSP05 LDQ* (P2) FORM WTREAD CURSOR POSITIONING 0161000 INQ -1 01620 QLS 8 01630 ADQ* (P1) 01640 INQ -1 01650 SPC 1 01660* CHECK BUFFER EMPTINESS 01670 SPC 1 0168000 LDA* BUFPOS 01690 SAZ DSP06 IF OUTPUT BUFFER EMPTY 01700 INA 4-BUFMAX 01710 SAM DSP07 IF ROOM FOR POSITIONING SEQUENCE 01720 RTJ* FLUSH 01730 SPC 1 01740DSP06 STQ* XYP 0175000 JMP* DSP08 01760 SPC 1 01770* FILL BUFFER 01780 SPC 1 01790DSP07 ADQ* CPBIAS EMBED POSITIONING SEQUENCE INTO TEXT 01800 STQ* PSTNWD+1 01810* 0182000 LR1 =XPSTNWD 01830 LDQ* BUFPOS 01840 ENA 4*2 01850 LLS 15 01860 ADD =XBUFBUF 01870 XFA 2 01880 ENA 4 0189000 MOV CCSMVA(PSTNWD,1,4,BUFBUF,BUFPOS+1,4) 01900* 01910 LDA* BUFPOS 01920 INA 4 01930 STA* BUFPOS 01940 SPC 1 01950DSP08 ENA BUFMAX 0196000 SUB* BUFPOS 01970 STA* AVAIL BUFFER AVAILABLE SPACE 01980* 01990 LR1* P3 02000 LDQ* BUFPOS 02010 LDA* AVAIL 02020 ALS 1 0203000 LLS 15 02040 ADD =XBUFBUF 02050 XFA 2 02060 LDA* (P4) 02070 MOV CCSMVA(STR,1,SLEN,BUFBUF,BUFPOS+1,AVAIL) 02080* 02090 LDA* BUFPOS 0210000 ADD* (P4) 02110 STA* BUFPOS 02120 INA -BUFMAX-1 02130 SAP DSP09 IF BUFFER OVERFLOW 02140 JMP* CMNEX 02150 SPC 1 02160* CONTINUE WHEN BUFFER OVERFLOW 0217000 SPC 1 02180DSP09 ENA BUFMAX 02190 STA* BUFPOS 02200 RTJ* FLUSH FLUSH FULL BUFFER 02210 SPC 1 02220 ENA -1 02230 STA* XYP 0224000 LDA* (P4) PSUEDO ( ADJUSTED ) LENGTH 02250 SUB* AVAIL 02260 STA* BUFPOS 02270* 02280 LDA* AVAIL 02290 LDQ* BUFPOS 02300 QLS 1 0231000 LLS 15 02320 ADQ* P3 02330 XFQ 1 02340 LR2 =XBUFBUF 02350 LDQ BUFPOS 02360 MOV CCSMVA(STR,AVAIL+1,BUFPOS,BUFBUF,1,BUFPOS) 02370* 0238000 JMP* CMNEX 02390 SPC 2 02400AVAIL NUM 0 BYTES AVAILABLE IN BUFFER 02410PSTNWD NUM $1B31 EMBEDDED POSITIONING SEQUENCE 02420 NUM 0 02430XYP NUM 0 02440 EJT 0245000*** CMNEX COMMON EXIT ROUTINE 02460 SPC 4 02470CMNEX LDQ* SAVEQ 02480 JMP* (EXITAD) 02490 EJT 02500*** PRESET 02510* 0252000* PRESET CODE 02530* 02540* ENTRY 02550* (A) CALLING ROUTINE ADDRESS 02560 SPC 4 02570PRESET NOP 0 02580 STQ* SAVEQ 0259000 STA* EXITAD 02600 LDA* FCFLAG 02610 SAZ PRS01 02620 JMP* (PRESET) 02630 SPC 1 02640PRS01 ENA 1 02650 STA* FCFLAG 0266000 RTJ OPENFL 02670 ADC IREQ 02680 ADC IDATA 02690 ADC ISTAT 02700 SPC 1 02710 LDA* ISTAT 02720 SAP PRS02 0273000 ENA 0 02740 STA* CPBIAS 02750 JMP* (PRESET) 02760 SPC 1 02770PRS02 RTJ CLOSFL 02780 ADC IREQ 02790 ADC ISTAT 0280000 JMP* (PRESET) 02810 SPC 2 02820ISTAT NUM 0 02830SAVEQ NUM 0 02840FCFLAG NUM 0 02850EXITAD ADC EXITAD 02860CPBIAS NUM $2020 0287000 EJT 02880*** GETARG 02890* 02900* PROCESS PARAMETER ADDRESS LIST 02910* 02920* ENTRY: 02930* (Q) - PARAMETER COUNT 0294000* (EXITAD) - ADDRESS OF ENTRY 02950 SPC 4 02960P1 ADC P1 02970P2 ADC P2 02980P3 ADC P3 02990P4 ADC P4 03000P ADC P1 0301000 SPC 2 03020GETARG NOP 0 ENTRY/EXIT 03030 LDA =XP1 03040 STA* P ESTABLISH PARAMETER ADDRESS STORAGE LOCATION 03050 INQ -1 03060 SPC 1 03070* PARAMETER ADDRESS PROCESS LOOP 0308000 SPC 1 03090GET01 LDA* (EXITAD) NEXT PARAMETER ADDRESS 03100 STA* (P) SAVE IN P.I 03110 RAO* P POINT TO NEXT PARAMETER ADDRESS SAVE WORD 03120 RAO* EXITAD INCREMENT PARAMETER LIST POINTER 03130 DQP *-GET01 03140 SPC 1 0315000 JMP* (GETARG) RETURN 03160 EJT 03170*** INPUT 03180* 03190* INPUT ROUTINE 03200* 03210* FORTRAN CALL: 0322000* ITC=INPUT(ILN,ICL,STR,N) 03230* ITC - TERMINATION CODE 03240* ILN - LINE POSITION FOR INPUT ( 1 <= ILN <= 24 ) 03250* ICL - COLUMN POSITION ( 1 <= ICL <= 80 ) 03260* STR - INPUT TEXT DESTINATION AREA 03270* N - BYTE LENGTH OF STR 03280 SPC 4 0329000INPUT NOP 0 ENTRY/EXIT 03300 LDA* INPUT 03310 RTJ* PRESET 03320 SPC 1 03330 ENQ 4 03340 RTJ* GETARG 03350 SPC 1 0336000 ENA -1 03370 STA* TCHAR SET TERMINATION CODE 03380 ENA 0 03390 STA* IMAX SET INPUT LENGTH 03400 SPC 1 03410 RTJ FLUSH FLUSH OUT ANY BUFFERRED TEXT 03420 SPC 1 0343000* VALIDATE PARAMETERS 03440 SPC 1 03450 LDA* (P4) VALIDATE INPUT TEXT LENGTH 03460 INA -1 03470 SAP INP01 03480 ENA 0 SET RETURN VALUE 03490 JMP* CMNEX ERROR EXIT 0350000 SPC 1 03510INP01 LDA* (P1) VALIDATE LINE POSITIONING 03520 INA -1 03530 SAM INP02 03540 INA -24 03550 SAM INP03 03560INP02 ENA 0 SET RETURN VALUE 0357000 JMP* CMNEX ERROR EXIT 03580 SPC 1 03590INP03 LDA* (P2) VALIDATE COLUMN POSITIONING 03600 INA -81 03610 SAP INP04 03620 INA 80 03630 SAP INP05 0364000INP04 ENA 0 SET RETURN VALUE 03650 JMP* CMNEX ERROR RETURN 03660 SPC 1 03670INP05 ALS 8 FORM WTREAD CURSOR POSITIONING 03680 ADD* (P1) 03690 INA -1 03700 STA* XYP 0371000 SPC 1 03720 LDA* (P4) 03730 STA* IMAX 03740 INA -BUFMAX-1 03750 SAM INP06 03760 ENA BUFMAX 03770 STA* IMAX FORCE INPUT TEXT TO FIT BUFFER 0378000INP06 RTJ WTREAD INPUT FROM TERMINAL 03790 ADC LU 03800 ADC HFFFE 03810 ADC H0000 03820 ADC H0000 03830 ADC XYP 03840 ADC BUFBUF 0385000 ADC IMAX 03860 ADC TCHAR 03870 SPC 1 03880* MOVE INPUT TEXT INTO DESTINATION AREA 03890 SPC 1 03900 LDQ* IMAX 03910 INQ 1 0392000 QRS 1 03930 LDA BUFBUF,Q 03940 STA* IMAX 03950* 03960 LR1 =XBUFBUF 03970 LR2* P3 03980 LDA* IMAX 0399000 LDQ* (P4) 04000 INQ 1 FORCE FULL WORD BOUNDRY ON RECEIVING AREA 04010 QRS 1 04020 QLS 1 04030 MOV CCSMVA(BUFBUF,1,IMAX,STR,1,SLEN) 04040* 04050 LDA* TCHAR SET RETURN VALUE 0406000 JMP* CMNEX RETURN 04070 SPC 2 04080TCHAR NUM 0 TERMINATION CODE FROM INPUT 04090IMAX NUM 0 INPUT TEXT LENGTH 04100 EJT 04110*** INPLEN 04120* 0413000* ACCESS LENGTH OF LAST INPUT 04140* 04150* FORTRAN CALL: 04160* ILEN=INPLEN(ILEN) 04170* ILEN - LENGTH OF LAST INPUT STRING ( BYTES ) 04180 SPC 4 04190INPLEN NOP 0 ENTRY/EXIT 0420000 LDA* INPLEN 04210 RTJ* PRESET 04220 SPC 1 04230 ENQ 1 04240 RTJ* GETARG 04250 SPC 1 04260 LDA* IMAX 0427000 STA* (P1) SET RETURN VALUE 04280 JMP* CMNEX RETURN 04290 EJT 04300*** TERMCH 04310* 04320* ACCESS THE TERMINATION CODE FROM THE LAST INPUT. 04330* 0434000* FORTRAN CALL: 04350* ITERM=TERMCH(ITERM) 04360* ITERM - TERMINATION CODE FROM LAST INPUT 04370 SPC 4 04380TERMCH NOP 0 ENTRY/EXIT 04390 LDA* TERMCH 04400 RTJ* PRESET 0441000 SPC 1 04420 ENQ 1 04430 RTJ* GETARG 04440 SPC 1 04450 LDA* TCHAR 04460 STA* (P1) 04470 JMP CMNEX RETURN 0448000 SPC 4 04490 END 04500_ 00 00 00 00 00 00 00 __ 0(s ?TACHO2LRLIBRARY P999999060381(0 NAM CHO2LR DECK-ID B51 ITOS 1.2 SUMMARY-126 00010* UTILITY CHARACTER ASSEMBLY ROUTINE 00020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00040* COPYRIGHT CONTROL DATA CORPORATION 1977 00050* 00060* *****************************************'****** 0007000* * * 00080* * ROUTINE TO ASSEMBLE 1 CHAR/WORD INTO * 00090* * 2 CHAR/WORD, EITHER LEFT OR RIGHT * 00100* * JUSTIFIED * 00110* * * 00120* ************************************************ 00130* 0014000* 00150****** CALLING SEQUENCE : 00160* 00170* RTJ CH02LR 00180* ADC SOURCE SOURCE DATA ARRAY (1 CHAR/WORD) 00190* ADC TARGET TARGET DATA ARRAY 00200* ADC SIZELR SIZE AND LEFT/RIGHT 0021000* 00220* 00230* CALL CH02LR(SOURCE,TARGET,SIZELR) (FORTRAN CALL 00240* 00250* 00260****** ROUTINE FUNCTION 00270* 0028000* THIS ROUTINE IS USED TO ASSEMBLE 1 CHAR/WORD DATA 00290* INTO 2 CHAR/WORD DATA EITHER LEFT/RIGHT (0/1) 00300* JUSTIFIED OF THE 2 CHAR/WORD 00310* 00320* 00330* 00340 SPC 3 0035000* 00360****** *** E N T R Y N A M E 00370* 00380 SPC 1 00390 ENT CHO2LR ENTRY NAME 00400 SPC 2 00410* 0042000****** *** E Q U I V A L E N C E 00430* 00440 SPC 1 00450LPMSK EQU LPMSK(2) BIT MASK 00460ONE EQU ONE(3) CONSTANT ONE 00470ZERO EQU ZERO(2) CONSTANT ZERO 00480 SPC 4 0049000* 00500****** ***** P R O G R A M S T A R T ***** 00510* 00520 SPC 2 00530CHO2LR NOP 0 ENTRY 00540 STQ* QSAVE SAVE Q-REGISTER 00550 LDA- I I 0056000 STA* ISAVE 00570* 00580 LDA* (CHO2LR) GET SOURCE DATA BUFFER ADDRESS 00590 STA- I 00600 RAO* CHO2LR BUMP TO NEXT PARAMETER 00610 SPC 1 00620 LDA* (CHO2LR) GET TARGET BUFFER ADDRESS 0063000 STA* TARGET 00640 RAO* CHO2LR BUMP TO THIRD PARAMETER 00650* 00660 LDQ* (CHO2LR) GET SIZE/LEFT-RIGHT INDICATOR PARA. ADD. 00670 LDA- (ZERO),Q FETCH SIZE AND SAVE 00680 STA* NOCHAR 00690 LDA- 1,Q OBTAIN LEFT/RIGHT INDICATOR (0/1) 0070000 STA* HILO 00710 SPC 1 00720*** GET CHARACTER AND ASSEMBLE 00730 SPC 1 00740GETCHA LDA- (ZERO),I GET CHARACTER FROM SOURCE 00750 AND- LPMSK+8 00760 LDQ* HILO FETCH HI/LO INSERTION FLAG AND POSITION CHAR. 0077000 SQN CHAPOS 00780 ALS 8 00790CHAPOS STA* TEMP 00800 LDA* (TARGET) GET TARGET WORD AND SAVE THE PROPER BYTE 00810 AND* BYTMSK,Q 00820 ADD* TEMP INSERT CURRENT BYTE AND SAVE 00830 STA* (TARGET) 0084000 SPC 2 00850* 00860*---- UPDATE POINTERS 00870* 00880 SPC 1 00890 LDA* NOCHAR DECREMENT SIZE BY 1 AND CHECK IF DONE 00900 INA -1 0091000 SAN UPTR SKIP, NO DONE 00920 LDA* ISAVE RESTORE I AND Q-REGISTERS PRIOR TO RETURN 00930 STA- I 00940 LDQ* QSAVE 00950 RAO* CHO2LR SET EXIT ADDRESS AND 00960 JMP* (CHO2LR) RETURN 00970* 0098000UPTR STA* NOCHAR SAVE REMAINDER SIZE 00990 LDA* HILO UPDATE HI/LOW POINTER 01000 INA 1 01010 AND- ONE 01020 STA* HILO 01030 SAN NOBUMP 01040 RAO* TARGET BUMP TARGET ADD. BY 1 IF 2 CHAR. INSERTED 0105000NOBUMP RAO- I INCREMENT SOURCE 01060 JMP* GETCHA 01070 SPC 2 01080*** STORAGES 01090 SPC 1 01100TEMP NUM 0 01110QSAVE NUM 0 0112000ISAVE NUM 0 01130NOCHAR NUM 0 SIZE 01140HILO NUM 0 HI/LO BYTE 01150TARGET NUM 0 TARGET BUFFER ADD. 01160BYTMSK NUM $00FF,$FF00 MASK 01170 END 01180_ 00 00 00 00 00 __ 0(Xs XTADEFFIOLIBRARY P~999999060381(0 NAM DEFFIO RPTTBL FILE ACCESS INTERFACE SUMMARY-*** 00010 SPC 2 00020*** ENTRY POINTS 00030 SPC 1 00040 ENT DEFACC CALL DEFACC(KEY,IPOS,ILNG,ISEC) ACCESS 00050 ENT DEFCLO CALL DEFCLO CLOSFL 00060 ENT DEFCMP CALL DEFCMP COMFIL 0007000 ENT DEFDEL CALL DEFDEL(KEY,ISTAT) DELREC 00080 ENT DEFOPE CALL DEFOPE OPENFL 00090 ENT DEFRDR CALL DEFRDR(KEY,REC,ISTAT) READR 00100 ENT DEFSET CALL DEFSET(FILNAM) 00110 ENT DEFUPD CALL DEFUPD(REC,KEY) UPDREC 00120 ENT DEFWTR CALL DEFWTR(REC,ISTAT) WRITER 00130 SPC 2 0014000*** EXTERNALS 00150 SPC 1 00160 EXT CLOSFL 00170 EXT COMFIL 00180 EXT DELREC 00190 EXT FILERR 00200 EXT ICNVRT 0021000 EXT OPENFL 00220 EXT PGMIN 00230 EXT PGMOUT 00240 EXT READR 00250 EXT UPDREC 00260 EXT WRITER 00270 EJT 0028000*** EQUIVALENCED SYMBOLS 00290 SPC 1 00300LPMASK EQU LPMASK($2) 00310ZERO EQU ZERO($22) 00320ONEBIT EQU ONEBIT($23) 00330 SPC 1 00340* FILERR MESSAGE ORDINALS 0035000ERROPE EQU ERROPE(3) 00360ERRWRI EQU ERRWRI(12) 00370ERRREA EQU ERRREA(13) 00380ERRUPD EQU ERRUPD(15) 00390ERRDEL EQU ERRDEL(16) 00400ERRCOM EQU ERRCOM(17) 00410 SPC 4 0042000*** FILE MANAGER PROCESSING CONTROL INFORMATION 00430 SPC 1 00440ISTAT NUM 0 FILE MANAGER STATUS RESPONSE WORD 00450IDATA ALF 4,RPTTBL FILE NAME 00460 ALF 4,CCS20 OWNER NAME 00470 ALF 4, VOLUME NAME 00480 NUM 1 KEY 1 ACCESS 0049000 NUM 1 SINGLE RECORD RETRIEVAL 00500 NUM 1 RECORD LOCKING 00510REQBUF BSS REQBUF(24) FILE MANAGER REQUEST BUFFER 00520 EJT 00530*** DEFSET 00540* 00550* SET ALTERNATE FILE NAME. THE OWNER NAME IS FORCED TO THE 0056000* LOGON USERID. 00570* 00580* FORTRAN CALL: 00590* CALL DEFSET(FILNAM) 00600* - FILNAM ALTERNATE FILE NAME ( 8 CHARACTERS ) 00610 SPC 4 00620DEFSET NOP 0 ENTRY/EXIT 0063000 STQ* SETQ SAVE Q REGISTER 00640 LDQ* (DEFSET) ADDRESS OF THE FILE NAME 00650 RAO* DEFSET 00660 STQ* SETP 00670 RTJ* DEFCLO FORCE THE FILE CLOSED 00680 SPC 1 00690 ENQ 4-1 0070000SET01 LDA* (SETP),Q COPY THE FILE NAME INTO THE REQUEST SPECIFIER 00710 STA* IDATA,Q 00720 DQP *-SET01 00730 SPC 1 00740 RTJ PGMIN SET FILE OWNER NAME AS LOGON USER-ID 00750 ADC IDATA+4 00760 ADC ISTAT 0077000 ADC ISTAT 00780 ADC ISTAT 00790 SPC 1 00800 LDA =N$2020 00810 ENQ 4-1 00820SET02 STA* IDATA+8,Q BLANK FILL VOLUME NAME 00830 DQP *-SET02 0084000 SPC 1 00850 LDQ* SETQ RESTORE Q 00860 JMP* (DEFSET) RETURN 00870 SPC 2 00880SETQ NUM 0 Q REGISTER STORAGE 00890SETP NUM 0 PARAMETER ADDRESS 00900 EJT 0091000*** DEFCMP 00920* 00930* COMPRESS THE DATA ELEMENT FILE. 00940* 00950* FORTRAN CALL: 00960* CALL DEFCMP 00970 SPC 4 0098000DEFCMP NOP 0 ENTRY/EXIT 00990 RTJ* DEFCLO 01000 SPC 1 01010 ENA -1 01020 STA* IDATA+12 OPEN FOR COMPRESSION 01030 ENA 0 01040 STA* IDATA+14 0105000 RTJ* DEFOPE 01060 SPC 1 01070CMP01 RTJ COMFIL COMPRESS LOOP 01080 ADC REQBUF 01090 ADC REC 01100CMPIST ADC ISTAT 01110 SPC 1 0112000 LDA* (CMPIST) 01130 SAM CMP02 IF DONE 01140 JMP* CMP01 01150 SPC 1 01160CMP02 ALS 15-8 01170 SAM CMP03 IF END OF FILE 01180 ENQ ERRCOM 0119000 JMP* FMEX1 ERROR EXIT 01200 SPC 1 01210CMP03 RTJ* DEFCLO 01220 ENA 1 01230 STA* IDATA+12 RESTORE IDATA 01240 STA* IDATA+14 01250 JMP* (DEFCMP) RETURN 0126000 EJT 01270*** DEFCLO 01280* 01290* CLOSE THE DATA ELEMENT FILE. 01300* 01310* FORTRAN CALL: 01320* CALL DEFCLO 0133000 SPC 4 01340DEFCLO NOP 0 ENTRY/EXIT 01350 RTJ CLOSFL CLOSE THE DATA ELEMENT FILE 01360 ADC REQBUF 01370 ADC ISTAT 01380 SPC 1 01390 ENA 0 0140000 STA* CLOFLG MARK FILE CLOSED 01410 JMP* (DEFCLO) RETURN 01420 SPC 2 01430CLOFLG NUM 0 01440 EJT 01450*** DEFRDR 01460* 0147000* READ A SPECIFIED RECORD FROM THE DATA ELEMENT FILE 01480* 01490* FORTRAN CALL: 01500* CALL DEFRDR(KEY,REC,ISTAT) 01510* - KEY ITEM NAME 01520* - REC 80 CHARACTER BUFFER ADDRESS 01530* - ISTAT NON-FATAL FM STATUS RESPONSE 0154000 SPC 4 01550DEFRDR NOP 0 ENTRY/EXIT 01560 RTJ* DEFOPE 01570 SPC 1 01580 ENQ 3 3 PARAMETERS 01590 LDA+ =XDEFRDR 01600 RTJ GETARG 0161000 SPC 1 01620 LDA* P1 COPY PARAMETER ADDRESSES ( KEY, REC ) 01630 STA* RDRP1 01640 LDA* P2 01650 STA* RDRP2 01660 RTJ READR 01670 ADC REQBUF 0168000RDRP2 ADC RDRP2 01690RDRP1 ADC RDRP1 01700RDRIST ADC ISTAT 01710 SPC 1 01720 LDA* (RDRIST) 01730 STA* (P3) 01740 ALS 15-8 0175000 SAM RDR01 IF EOF 01760 ALS 17-8 01770 SAP RDR01 01780 ENQ ERRREA 01790 JMP* FMEX1 ERROR EXIT 01800 SPC 1 01810RDR01 LDQ* SAVEQ 0182000 JMP* (DEFRDR) RETURN 01830 EJT 01840*** DEFOPE 01850* 01860* OPEN THE DATA ELEMENT FILE 01870* 01880* FORTRAN CALL: 0189000* CALL DEFOPE 01900 SPC 4 01910DEFOPE NOP 0 ENTRY/EXIT 01920 STQ* SAVEQ 01930 LDA* CLOFLG 01940 SAN OPE02 IF FILE IS NOT CLOSED 01950 SPC 1 0196000 ENQ 24-1 01970OPE01 STA* REQBUF,Q 01980 DQP *-OPE01 01990 SPC 1 02000 RTJ OPENFL ATTEMPT FILE ACCESS 02010 ADC REQBUF 02020 ADC IDATA 0203000OPEIST ADC ISTAT 02040 SPC 1 02050 LDA* (OPEIST) 02060 SAP OPE02 02070 ENQ ERROPE 02080 JMP* FMEX1 ERROR EXIT 02090 SPC 1 0210000OPE02 ENA 1 02110 STA* CLOFLG FILE IS NO LONGER CLOSED 02120 LDQ* SAVEQ 02130 JMP* (DEFOPE) RETURN 02140 EJT 02150*** DEFUPD 02160* 0217000* UPDATE DATA ELEMENT FILE ITEM 02180* 02190* FORTRAN CALL: 02200* CALL DEFUPD(REC,ISTAT) 02210* - REC UPDATE RECORD 02220* - ISTAT NON-FATAL FILE MANAGER STATUS RESPONCE 02230 SPC 4 0224000DEFUPD NOP 0 ENTRY/EXIT 02250 RTJ* DEFOPE 02260 SPC 1 02270 ENQ 2 2 PARAMETERS 02280 LDA =XDEFUPD 02290 RTJ* GETARG 02300 SPC 1 0231000 LDA* P1 02320 STA* UPDP1 02330 ENQ 3-2 02340UPD01 LDA* (P1),Q EXTRACT KEY 02350 STA* KEY,Q 02360 DQP *-UPD01 02370 SPC 1 0238000 RTJ READR POSITION TO RECORD 02390 ADC REQBUF 02400 ADC REC 02410 ADC KEY 02420UPDIST ADC ISTAT 02430 SPC 1 02440 LDA* (UPDIST) 0245000 ALS 15-9 02460 SAM UPD02 IF NO SUCH KEY 02470 ALS 9-8 02480 SAM UPD02 IF EOF 02490 ALS 17-8 02500 SAP UPD03 02510 ENQ ERRREA 0252000FMEX1 JMP* FMEX2 ERROR EXIT 02530 SPC 1 02540UPD02 LDA- (ONEBIT+9) SET NOT FOUND STATUS 02550 JMP* UPD04 NORMAL EXIT 02560 SPC 1 02570UPD03 RTJ UPDREC PROCESS UPDATE 02580 ADC REQBUF 0259000UPDP1 ADC UPDP1 02600 ADC ISTAT 02610 SPC 1 02620 LDA* (UPDIST) 02630 SAP UPD04 02640 ENQ ERRUPD 02650 JMP* FMEX2 ERROR EXIT 0266000 SPC 1 02670UPD04 STA* (P2) SET STATUS 02680 LDQ* SAVEQ 02690 JMP* (DEFUPD) RETURN 02700 SPC 2 02710KEY BSS KEY(3) 02720 EJT 0273000*** DEFDEL 02740* 02750* DELETE THE SPECIFIED ITEM FROM THE DATA ELEMENT FILE 02760* 02770* FORTRAN CALL: 02780* CALL DEFEMT(KEY,ISTAT) 02790* - KEY ITEM NAME 0280000* - ISTAT NON-FATAL FILE MANAGER RESPONCE 02810 SPC 4 02820DEFDEL NOP 0 ENTRY/EXIT 02830 RTJ* DEFOPE 02840 SPC 1 02850 ENQ 2 2 PARAMETERS 02860 LDA+ =XDEFDEL 0287000 RTJ* GETARG 02880 SPC 1 02890 LDA* P1 02900 STA* DELP1 02910 RTJ READR POSITION TO RECORD 02920 ADC REQBUF 02930 ADC REC 0294000DELP1 ADC DELP1 02950DELIST ADC ISTAT 02960 SPC 1 02970 LDA* (DELIST) 02980 ALS 15-9 IF KEY UNKNOWN 02990 SAM DEL01 03000 ALS 9-8 IF EOF 0301000 SAM DEL01 03020 ALS 17-8 03030 SAP DEL02 IF RECORD IS FOUND 03040 ENQ ERRREA 03050 JMP* FMEX2 ERROR EXIT 03060 SPC 1 03070DEL01 LDA =N$8200 SET NOT FOUND STATUS 0308000 JMP* DEL03 NORMAL EXIT 03090 SPC 1 03100DEL02 RTJ DELREC DELETE THE SPECIFIED RECORD 03110 ADC REQBUF 03120 ADC REC 03130 ADC ISTAT 03140 SPC 1 0315000 LDA* (DELIST) 03160 SAP DEL03 03170 ENQ ERRDEL 03180 JMP* FMEX2 ERROR EXIT 03190 SPC 1 03200DEL03 STA* (P2) SET STATUS 03210 LDQ* SAVEQ RETURN 0322000 JMP* (DEFDEL) 03230 EJT 03240P1 ADC P1 03250P2 ADC P2 03260P3 ADC P3 03270P4 ADC P4 03280SAVEQ NUM 0 0329000 SPC 4 03300*** GETARG GET ARGUMENT ADDRESSES 03310* 03320* ENTRY: 03330* (A) - ADDRESS OF CALLING ROUTINE ENTRY POINT 03340* (Q) - NUMBER OF PARAMETERS EXPECTED 03350 SPC 1 0336000GETARG NOP 0 03370 STA* ARGADR SAVE ADDRESS OF CALLER 03380 STQ* ARGCNT SAVE PARAMETER COUNT 03390 ENA 1 03400 STA* ARGP 03410 SPC 1 03420* LOOP TO EXTRACT PARAMETER ADDRESSES 0343000 SPC 1 03440ARG01 LDQ* (ARGADR) ADDRESS OF NEXT PARAMETER ADDRESS 03450 RAO* (ARGADR) INCREMENT FOR NEXT PARAMETER / RETURN 03460 LDA- (ZERO),Q PARAMETER ADDRESS 03470 LDQ* ARGP 03480 STA* P1-1,Q SAVE PARAMETER ADDRESS 03490 RAO* ARGP COUNT PARAMETER ADDRESSES PROCESSED 0350000 LDA* ARGCNT 03510 EAQ A 03520 SAZ ARG02 IF DONE 03530 JMP* ARG01 03540 SPC 1 03550ARG02 JMP* (GETARG) RETURN 03560 SPC 2 0357000ARGADR ADC ARGADR 03580ARGCNT NUM 0 03590ARGP NUM 0 03600 EJT 03610*** DEFWTR 03620* 03630* WRITE ITEM TO DATA ELEMENT FILE 0364000* 03650* FORTRAN CALL: 03660* CALL DEFWTR(REC,ISTAT) 03670* - REC ITEM TO WRITE 03680* - ISTAT NON-FATAL FILE MANAGER RESPONCE 03690 SPC 4 03700DEFWTR NOP 0 ENTRY/EXIT 0371000 RTJ* DEFOPE 03720 SPC 1 03730 ENQ 2 2 PARAMETERS 03740 LDA+ =XDEFWTR 03750 RTJ* GETARG 03760 SPC 1 03770 ENQ 40-1 0378000WTR01 LDA* (P1),Q COPY RECORD IMAGE 03790 STA* REC,Q 03800 DQP *-WTR01 03810 SPC 1 03820 RTJ WRITER WRITE TO FILE 03830 ADC REQBUF 03840 ADC REC 0385000 ADC REC ( KEY ) 03860WTRIST ADC ISTAT 03870 SPC 1 03880 LDA* (WTRIST) 03890 STA* (P2) 03900 ALS 15-12 03910 SAM WTR02 IF FILE IS FULL 0392000 ALS 12-4 03930 SAM WTR02 IF KEY IS NOT UNIQUE 03940 ALS 17-12 03950 SAP WTR02 03960 ENQ ERRWRI 03970FMEX2 JMP* FMERR ERROR EXIT 03980 SPC 1 0399000WTR02 LDQ* SAVEQ 04000 JMP* (DEFWTR) RETURN 04010 EJT 04020*** DEFACC 04030* 04040* ACCESS ITEM INFORMATION 04050* 0406000* FORTRAN CALL: 04070* CALL DEFACC(KEY,IPOS,ILNG,ISEC) 04080* - KEY ITEM NAME 04090* - IPOS ITEM POSITION IN FILE 04100* - ILNG ITEM LENGTH IN FILE 04110* - ISEC ITEM SECURITY CODE IN FILE ( 1R? FORMAT ) 04120* 0413000* ERROR CONDITIONS ( KEY NOT FOUND, INTEGER CONVERSION FAILURE ) 04140* ARE INDICATED BY IPOS=ILEN=ISEC=0 04150 SPC 4 04160DEFACC NOP 0 ENTRY/EXIT 04170 RTJ DEFOPE 04180 SPC 1 04190 ENQ 4 4 PARAMETERS 0420000 LDA+ =XDEFACC 04210 RTJ* GETARG 04220 SPC 1 04230 LDA* P1 04240 STA* ACCP1 04250 RTJ READR GET THE SPECIFIED RECORD 04260 ADC REQBUF 0427000 ADC REC 04280ACCP1 ADC ACCP1 04290ACCIST ADC ISTAT 04300 SPC 1 04310 LDA* (ACCIST) 04320 ALS 15-9 KEY MISSING INDICATOR 04330 SAM ACC01 0434000 ALS 9-8 END OF FILE INDICATOR 04350 SAM ACC01 04360 ALS 17-8 04370 SAP ACC02 04380 ENQ ERRREA 04390 JMP* FMERR ERROR EXIT 04400 SPC 1 0441000ACC01 ENA 0 SET NOT FOUND STATUS / ERROR IN CONVERSION 04420 STA* (P2) 04430 STA* (P3) 04440 STA* (P4) 04450 LDQ* SAVEQ 04460 JMP* (DEFACC) RETURN, NOT FOUND OR ERROR 04470 SPC 1 0448000ACCICV ADC ICNVRT 04490 SPC 1 04500ACC02 ENA 6 04510 STA* IPT 04520 RTJ* (ACCICV) CONVERT POSITION FIELD 04530 ADC REC 04540 ADC IPT 0455000 ADC D00010 04560 ADC ISTAT 04570 SPC 1 04580 LDQ* (ACCIST) 04590 SQZ ACC03 04600 JMP* ACC01 IF ERROR 04610 SPC 1 0462000ACC03 STA* (P2) RETURN ITEM POSITION 04630 ENA 10 04640 STA* IPT 04650 RTJ* (ACCICV) CONVERT LENGTH FIELD 04660 ADC REC 04670 ADC IPT 04680 ADC D00014 0469000 ADC ISTAT 04700 SPC 1 04710 LDQ* (ACCIST) 04720 SQZ ACC04 04730 JMP* ACC01 IF ERROR 04740 SPC 1 04750ACC04 STA* (P3) RETURN ITEM LENGTH 0476000 LDA* REC+8 04770 ALS 8 04780 AND- (LPMASK+8) 04790 STA* (P4) RETURN SECURITY CODE IN 1R? FORMAT 04800 LDQ* SAVEQ 04810 JMP* (DEFACC) 04820 SPC 4 0483000IPT NUM 0 04840REC BSS REC(42) 04850D00010 NUM 10 04860D00014 NUM 14 04870 EJT 04880*** FMERR PROCESS FILE MANAGER ERRORS 04890* 0490000* ENTRY: 04910* (Q) - ERROR ORDINAL FOR FILERR 04920 SPC 1 04930FMEP1 NUM 0 ERROR NUMBER PARAMETER 04940LU NUM 5 LOGICAL UNIT NUMBER PARAMETER 04950 SPC 2 04960FMERR STQ* FMEP1 SAVE ERROR NUMBER 0497000 RTJ FILERR ISSUE ERROR MESSAGE 04980 ADC IDATA FILE NAME 04990 ADC FMEP1 ERROR NUMBER 05000 ADC ISTAT STATUS 05010 ADC LU DISPLAY LOGICAL UNIT 05020 SPC 1 05030 RTJ PGMOUT QUIT 0504000 SPC 4 05050 END 05060_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(t ?TAFDWMTHLIBRARY PF999999060381(0 NAM FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122 00010* FORTRAN INTERFACE TO DOUBLE WORD ADD/SUBTRACT/MULTIPLY 00020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00040* COPYRIGHT CONTROL DATA CORPORATION 1977 00050* 00060**** 0007000* 00080* THIS ROUTINE PROVIDES A FORTRAN INTERFACE TO THE FILE MANAGER 00090* DOUBLE WORD MATH ROUTINES. 00100* 00110* CALLING SEQUENCES: 00120* CALL FDWADD (OP1, OP2, RESULT, OV) 00130* CALL FDWSUB (OP1, OP2, RESULT, OV) 0014000* CALL FDWMUI (OP1, OP3, RESULT, OV) 00150* 00160* PARAMETERS: 00170* OP1 - FIRST OPERAND (MSB/LSB) 00180* OP2 - SECOND OPERAND (MSB/LSB) (SUBTRAHEND) 00190* OP3 - SINGLE WORD OPERAND 00200* RESULT - COMPUTATION RESULT (MSB/LSB) 0021000* OV - OVERFLOW INDICATOR: 00220* =0 IF NONE OCCURRED 00230* =1 IF ONE DID OCCUR 00240* 00250* ENTRY POINTS 00260* 00270 ENT FDWADD FORTRAN INTERFACE FOR DOUBLE WORD ADD 0028000 ENT FDWSUB FORTRAN INTERFACE FOR DOUBLE WORD SUBTRACT 00290 ENT FDWMUI FORTRAN INTERFACE FOR DOUBLE WORD MULTIPLY 00300* 00310* EXTERNALS 00320* 00330 EXT Q8PREP PREPARE TO PICKUP PARAMETERS 00340 EXT Q8PKUP PICKUP ABSOLUTIZED PARAMETER ADDRESS 0035000 EXT DWADD DOUBLE WORD ADD ROUTINE 00360 EXT DWSUB DOUBLE WORD SUBTRACT ROUTINE 00370 EXT DWMUL DOUBLE WORD MULTIPLY ROUTINE 00380**** 00390* 00400* EQUIVALENCES 00410* 0042000 EQU ZERO(2) SYSTEM ZERO 00430 EJT 00440FDWADD ADC 0 ENTRY FOR ADD 00450 LDA* FDWADD 00460 STA* FDWMUI TRANSFER PARAMETER ADDRESS 00470 ENA 0 00480 STA* OPTYPE SET OPERATOR CODE TO ADD 0049000 JMP* CONTIN 00500* 00510FDWSUB ADC 0 ENTRY FOR SUBTRACT 00520 LDA* FDWSUB 00530 STA* FDWMUI TRANSFER PARAMETER ADDRESS 00540 ENA 3 00550 STA* OPTYPE SET OPERATOR CODE TO SUBTRACT 0056000 JMP* CONTIN 00570* 00580FDWMUI ADC 0 ENTRY FOR MULTIPLY 00590 ENA 6 00600 STA* OPTYPE SET OPERATOR CODE TO MULTIPLY 00610 EJT 00620CONTIN STQ* QSAVE SAVE Q-REG 0063000 LDA- I SAVE I-REG 00640 STA* ISAVE 00650* 00660 RTJ Q8PREP ABSOLUTIZE PARAMETERS FOR F.M. ROUTINES 00670 ADC* FDWMUI 00680ADR RTJ Q8PKUP 00690 TRA Q 0070000 LDA- (ZERO),Q 00710 STA* PLIST OP1 MSB 00720 LDA- 1,Q 00730 STA* PLIST+1 OP1 LSB 00740 RTJ* (ADR+1) 00750 TRA Q 00760 LDA- (ZERO),Q 0077000 STA* PLIST+2 OP2 (MSB) OR OP3 00780 LDA* OPTYPE LIST FORMAT DIFFERS FOR ADD/SUB AND MUI 00790 INA -6 00800 SAM ADDSUB 00810 RTJ* (ADR+1) 00820 STA* RESULT ADDRESS OF RESULT 00830 RTJ* (ADR+1) 0084000 STA* OVADR OVERFLOW STATUS ADDRESS 00850 JMP* COMPUT 00860* 00870ADDSUB LDA- 1,Q 00880 STA* PLIST+3 OP2 (LSB) 00890 RTJ* (ADR+1) 00900 STA* RESULT ADDRESS OF RESULT 0091000 RTJ* (ADR+1) 00920 STA* OVADR OVERFLOW STATUS ADDRESS 00930 EJT 00940COMPUT LDQ =XPLIST GO CALL APPROPRIATE ROUTINE 00950 LDA* OPTYPE 00960 STA- I 00970 NUM $1901 0098000* 00990 RTJ DWADD ADD 01000 JMP* RET 01010 RTJ DWSUB SUBTRACT 01020 JMP* RET 01030 RTJ DWMUL MULTIPLY 01040 EJT 0105000RET LDQ* RESULT RETURN RESULT TO CALLER 01060 LDA* OPTYPE 01070 INA -6 01080 SAM AS 01090 LDA* PLIST+3 01100 STA- (ZERO),Q 01110 LDA* PLIST+4 0112000 STA- 1,Q 01130 LDA* PLIST+5 01140 JMP* EXIT 01150* 01160AS LDA* PLIST+4 01170 STA- (ZERO),Q 01180 LDA* PLIST+5 0119000 STA- 1,Q 01200 LDA* PLIST+6 01210 SPC 3 01220EXIT STA* (OVADR) RETURN OVERFLOW STATUS 01230 LDQ* QSAVE RESTORE Q AND I REGISTERS 01240 LDA* ISAVE 01250 STA- I 0126000 JMP* (FDWMUI) RETURN TO CALLER 01270 SPC 3 01280PLIST BZS PLIST(7) 01290QSAVE NUM 0 01300ISAVE NUM 0 01310RESULT NUM 0 01320OVADR NUM 0 OVERFLOW STATUS ADDRESS 0133000OPTYPE NUM 0 01340 END 01350_ 00 00 __ 0(u ?TAFRHX LIBRARY P999999060381(0 NAM FRHX DECK-ID B53 ITOS 1.2 SUMMARY-126 00010* UTILITY HEXIDECIMAL CONVERSION ROUTINE 00020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00040* COPYRIGHT CONTROL DATA CORPORATION 1977 00050* 00060* *********'*******************************'***** 0007000* * * 00080* * ROUTINE TO CONVERT A VALUE INTO HEX * 00090* * * 00100* *****************************************'***** 00110* 00120* 00130****** CALLING SEQUENCES : 0014000* 00150* RTJ FRHX 00160* ADC DATBUF 5-WORD ARRAY, WORD 1 FOR VALUE 00170* THE LAST 4 WORDS ARE FOR HEX. VALUE 00180* (BITS 15-08-NULL, BITS 07-00-HEX) 00190* 00200* CALL FRHX(LVALUE) (FORTRAN SEQUENCE) 0021000* 00220* 00230****** FOUTINE FUNCTION : 00240* 00250* THE VALUE IS CONVERTED INTO 4 ASCII CHARACTERS, 00260* RIGHT JUSTIFIED AND NULL FILLES BITS 15-08. 00270* 0028000* 00290* 00300 SPC 3 00310* 00320****** *** E N T R Y N A M E 00330* 00340 SPC 1 0035000 ENT FRHX ROUTINE ENTRY NAME 00360 SPC 2 00370* 00380****** *** E Q U I V A L E N C E S 00390* 00400 SPC 1 00410LPMSK EQU LPMSK(2) BIT MASK 0042000ZERO EQU ZERO(2) CONSTANT ZERO 00430 SPC 4 00440* 00450****** ***** P R O G R A M S T A R T ***** 00460* 00470 SPC 2 00480FRHX NOP 0 ENTRY 0049000 STQ* QSAVE SAVE Q-REGISTER 00500 LDA- I 00510 STA* ISAVE SAVE I-REGISTER 00520* 00530 LDA* (FRHX) GET PARAMETER ADDRESS AND SAVE IN I-REG. 00540 STA- I 00550 LDA- (ZERO),I GET VALUE AND SAVE 0056000 STA* TEMP 00570 SPC 2 00580* EXTRACT VALUE 00590 SPC 1 00600 CLR A CLEAR CHARACTER COUNT 00610 STA* INDEX 00620GETVAL LDA* TEMP GET VALUE AND EXTRACT 4 BIT 0063000 CLR Q 00640 LLS 4 00650 STA* TEMP SAVE REMAINDER 00660 TRQ A 4-BIT VALUE IN BOTH A AND Q 00670 SPC 2 00680* ASSEMBLE VALUE EITHER NUMERIC OR ALPHABETIC CHARACTER 00690 SPC 1 0070000 INA $30 SET FOR NUMERIC 00710 INQ -10 00720 SQM SAVCHA 00730 INA 7 BUMP TO ALPHABETIC CHARACTER 00740 SPC 2 00750* GET INDEX, STORE, INCREMENT COUNT AND CHECK IF DONE 00760 SPC 1 0077000SAVCHA LDQ* INDEX GET STORAGE INDEX AND SAVE CHARACTER 00780 STA- 1,B 00790 INQ 1 INCREMENT INDEX BY 1 AND CHECK IF DONE 00800 STQ* INDEX 00810 INQ -4 00820 SQZ TOREST SKIP, ON DONE 00830 JMP* GETVAL NOT DONE, TO REPEAT 0084000 SPC 2 00850* RESTORE REGISTERS AND EXIT 00860 SPC 1 00870TOREST RAO* FRHX SET EXIT ADDRESS 00880 LDA* ISAVE RESTORE I-REGISTER 00890 STA- I 00900 LDQ* QSAVE 0091000 JMP* (FRHX) RETURN TO SENDER 00920 SPC 2 00930* STORAGES 00940 SPC 1 00950ISAVE NUM 0 I-REGISTER SAVE LOCATION 00960QSAVE NUM 0 Q 00970TEMP NUM 0 VALUE TEMPORARY STORAGE 0098000INDEX NUM 0 NUMBER OF CHARACTER COUNT 00990 END 01000_ 00 00 00 00 00 00 00 __ 0(duO d*TAGETVITLIBRARY P999999060381(0 NAM GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHIB1100010* GET VIT FOR SPECIFIED VOLUME B1100020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 B1100030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1100040* COPYRIGHT CONTROL DATA CORPORATION 1977 B1100050* B1100060**** B110007000* B1100080* FUNCTION B1100090* B1100100* THIS ROUTINE GETS THE CONTENTS OF THE VIT SPECIFIED BY MMUNIT B1100110* AND MOVES IT TO A TABLE POINTED TO BY OUTP B1100120* B1100130* CALLING SEQUENCE B110014000* B1100150* CALL GETVIT(MMUNIT,OUTP) B1100160* B1100170* PARAMETERS B1100180* B1100190* MMUNIT MASS MEMORY LOGICAL UNIT NO B1100200* B110021000* OUTP TABLE ADDR TO READ IN THE SPECIFIED VIT B1100220* B1100230* B1100240* ENTRY POINT B1100250* B1100260 ENT GETVIT B1100270* B110028000* EXTERNALS B1100290* B1100300* EXT MMLUTB OLD EXTERNAL FROM ITOS 1.2 NOT NEEDED FOR 2.0B1100310* B1100320* EQUIVALENCES B1100330* B1100340 EQU ZERO($22) B110035000* B1100360* START OF GETVIT B1100370* B1100380**** B1100390GETVIT NOP B1100400 STQ* QSAVE SAVE Q REGISTER B1100410 SRI* ISAVE SAVE I REGISTER B110042000* B1100430 LDA* (GETVIT) PICK-UP PARAMETERS B1100440 STA* MMUNIT B1100450 RAO* GETVIT B1100460 LDA* (GETVIT) B1100470 STA* OUTP B1100480 RAO* GETVIT B110049000* CHECK FOR BAD MMUNIT 00500 LDA* (MMUNIT) 00510 INA -1 00520 SAM BAD 00530* B1100540 LDQ- $E9 EXTBV4 B1100550 LDQ- 29,Q MMLUTB 0056000 LDA- (ZERO),Q 00570 SUB* (MMUNIT) 00580 INA 0 00590 SAP OK 00600BAD ENA 0 WANTED A NONEXISTANT VIT 00610 STA* (OUTP) 00620 JMP* ENDVIT 0063000OK ADQ* (MMUNIT) B1100640 LRI- (ZERO),Q VIT-ADDR IN I B1100650 ENQ 21 SET POINTER TO 21 B1100660* B1100670LOOP LDA- (ZERO),B TRANSFER VIT CONTENTS TO OUTP B1100680 STA* (OUTP),Q B1100690 DQP *-LOOP B110070000* B1100710ENDVIT LDQ* QSAVE RESTORE REGISTERS B1100720 LDA* ISAVE B1100730 STA- I B1100740 JMP* (GETVIT) RETURN B1100750* B1100760* LOCAL VARIABLES B110077000* B1100780MMUNIT NUM 0 B1100790OUTP NUM 0 B1100800QSAVE NUM 0 B1100810ISAVE NUM 0 B1100820 END B1100830_ 00 00 00 __ 0(duz d*TALOCF LIBRARY P999999060381(0 NAM ILOCF 00010 ENT ILOCF 00020* 00030* FORTRAN CALLABLE FUNCTION *ILOCF* 00040* FUNCTION RETURNS THE ADDRESS OF THE PARAMETER 00050* 00060* FORTRAN CALLING SEQUENCE: 0007000* I=ILOCF(VARABL) 00080* 00090* ASSEMBLY LANGUAGE CALLS ARE MEANINGLESS 00100 SPC 2 00110ILOCF ADC 0 00120 LDA* (ILOCF) 00130 RAO* ILOCF 0014000 JMP* (ILOCF) 00150 END 00160_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(r2  TAMEMORYLIBRARY P999999060381(0 NAM MEMORY 00010 ENT MEMORY 00020MEMORY NUM 0 00030 STQ* SQ 00040 LDQ* (MEMORY) ADDRESS OF ARGUMENT IN Q 00050 RAO* MEMORY 00060 LDQ- (2),Q ARGUMENT IN Q 0007000 LDA- (2),Q 00080 LDQ* SQ 00090 JMP* (MEMORY) 00100SQ NUM 0 00110 END 00120_ 00 00 00 __ 0(u iTAMPWRXXLIBRARY P999999060381(0 NAM MPWRXX UNIT RECORD FUNCTION PROCESSOR SUMMARY-***B4500010* UTILITY READ/WRITE RECORD ROUTINE B4500020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 B4500030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4500040* COPYRIGHT CONTROL DATA CORPORATION 1977 B4500050* B4500060* B450007000* *****************************************'****** B4500080* * * B4500090* * ROUTINE FOR READ/WRITE RECORD(S) FOR * B4500100* * 'DUMP FILE' AND 'RELOAD' (FORMATTED) * B4500110* * (REQUEST) * B4500120* * * B4500130* ************************************************ B450014000* B4500150* B4500160* B4500170* B4500180***** ROUTINE FUNCTION : B4500190* B4500200* THIS ROUTINE IS USE FOR READ/WRITE (FORMATTED) B450021000* OPERATION (MAINLY FOR MAG. TAPE) FOR FILE DUMP B4500220* OR RELOAD. B4500230* B4500240* B4500250 SPC 2 B4500260* B4500270**** B450028000* B4500290**** THIS ROUTINE IS AN INTEGER FUNCTION --- B4500300* B4500310* CALLING SEQUENCES : B4500320* B4500330* (1) ASSEM : B4500340* B450035000* RTJ MPWRXX B4500360* ADC LU LOGICAL UNIT B4500370* ADC BUFFER BUFFER ADDRESS B4500380* ADC SIZE SIZE OF DATA B4500390* B4500400* A-REGISTER CONTAIN LOGICAL UNIT STAUTUS B4500410* B450042000* (2) FORTRAN : B4500430* B4500440* MSTATS = MPWRXX(LU,KBUF,KSIZE) B4500450* B4500460* B4500470* B4500480 SPC 2 B450049000* B4500500***** ***** E N T R Y P O I N T S B4500510* B4500520 SPC 1 B4500530 ENT MPWRIX WRITE ENTRY B4500540 ENT MPREDX READ ENTRY B4500550 ENT MPWRIU WRITE UNFORMAT ENTRY B450056000 ENT MPREDU READ UNFORMAT ENTRY B4500570 ENT MPMOTN MOTION ENTRY B4500580 SPC 2 B4500590* B4500600***** ***** E U Q I V A L E N C E S B4500610* B4500620 SPC 1 B450063000* MSOS EQUIVALENCES B4500640 SPC 1 B4500650ADISP EQU ADISP($EA) DISPATCHER B4500660CURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B4500670AMONI EQU AMONI($F4) MONITOR B4500680 SPC 1 B4500690* I/O REQUEST EQUIVALENCES B450070000 SPC 1 B4500710D EQU D(1) 'D' BIT B4500720X EQU X(0) 'X' BIT B4500730RP EQU RP(4) REQUEST PRIORITY B4500740NULL EQU NULL(0) NULL B4500750READCD EQU READCD(4) F-READ B4500760WRITCD EQU WRITCD(6) F-WRITE B450077000READU EQU READU(1) UNFORMATTED READ CODE B4500780WRITU EQU WRITU(2) UNFORMATTED WRITE CODE B4500790MOTION EQU MOTION(14) MOTION CODE B4500800 SPC 1 B4500810* MSOS LOW CORE EQUIVALENCE B4500820 SPC 1 B4500830ZERO EQU ZERO(2) LOCATION CONTAINS ZERO B450084000 SPC 5 B4500850* B4500860***** ***** P R O G R A M S T A R T ***** B4500870* B4500880 SPC 3 B4500890MPWRIU NOP 0 UNFORMATTED WRITE ENTRY B4500900 LDA* MPWRIU GET RTJ ADDRESS B450091000 STA* MPREDX STORE IT IN STANDARD ENTRY B4500920 ENA WRITU LOAD UNF. WRITE CODE B4500930 JMP* COMPRO B4500940 SPC 3 B4500950MPREDU NOP 0 UNFORMAT READ ENTRY B4500960 LDA* MPREDU GET RTJ ADDRESS B4500970 STA* MPREDX STORE IT IN STANDARD ENTRY B450098000 ENA READU LOAD UNF. READ CODE B4500990 JMP* COMPRO B4501000 SPC 3 B4501010MPWRIX NOP 0 WRITE REQUEST ENTRY B4501020 LDA* MPWRIX MOVE RETURN ADDRESS B4501030 STA* MPREDX B4501040 ENA WRITCD SET TO WRITE REQUEST B450105000 JMP* COMPRO TO COMMON PROCESSING SEQUENCE B4501060 SPC 2 B4501070* READ ENTRY B4501080 SPC 1 B4501090MPREDX NOP 0 READ ENTRY B4501100 ENA READCD SET FOR READ CODE B4501110* B450112000COMPRO ALS 9 ASSEMBLE I/O REQUEST CODE B4501130 ADD- CURLV + CURRENT PRIORITY LEVEL B4501140 ADD* CALBAS + CALL CODE BASE B4501150 STA* CALPAR SAVE CALL CODE B4501160 STQ* QSAVE SAVE Q-REGISTER B4501170 LDA- I I B4501180 STA* ISAVE B450119000 SPC 1 B4501200* GET PARAMETERS FOR I/O REQUEST B4501210 SPC 1 B4501220 LDQ* (MPREDX) GET LOGICAL B4501230 LDA- (ZERO),Q B4501240 STA* LU B4501250 RAO* MPREDX BUMP TO NEXT ONE B450126000 LDQ* (MPREDX) GET SIZE B4501270 STQ* BUF B4501280 RAO* MPREDX BUMP TO NEXT ONE B4501290 LDQ* (MPREDX) GET BUFFER ADDRESS B4501300 LDA- (ZERO),Q GET SIZE B4501310 STA* SIZE B4501320 SPC 2 B450133000* I/O REQUEST VIA MONITOR B4501340 SPC 1 B4501350MAKCAL RTJ- (AMONI) B4501360CALPAR NUM 0 0. CALL CODE (FILLED) B4501370 ADC RETURN 1. COMPLETION ADDRESS B4501380 NUM 0 2. THREAD B4501390LU NUM 0 3. LOGICAL UNIT B450140000SIZE NUM 0 4. SIZE (FILLED) B4501410BUF NUM 0 5. BUFFER ADDRESS (FILLED) B4501420 JMP- (ADISP) B4501430 SPC 1 B4501440* B4501450CALBAS VFD X2/D,X5/NULL,X1/X,X4/RP,X4/NULL B4501460 SPC 1 B450147000* RETURN FROM I/O B4501480 SPC 1 B4501490RETURN TRQ A STATUS TO A B4501500 LDQ* ISAVE RESTORE I-REGISTER B4501510 STQ- I B4501520 LDQ* QSAVE Q B4501530 RAO* MPREDX BUMP TO EXIT B450154000 JMP* (MPREDX) RETURN TO SENDER B4501550* B4501560ISAVE NUM 0 I-SAVE B4501570QSAVE NUM 0 Q-SAVE B4501580* B4501590* B4501600* MOTION ENTRY B450161000* B4501620MPMOTN NOP 0 B4501630 LDA* MPMOTN B4501640 STA* MPREDX MOVE RETURN ADDRESS B4501650 ENA MOTION B4501660 ALS 9 B4501670 ADD- CURLV B450168000 ADD* CALBAS B4501690 STA* CALPAR B4501700 STQ* QSAVE B4501710 LDA- I B4501720 STA* ISAVE B4501730 LDQ* (MPREDX) B4501740 LDA- (ZERO),Q B450175000 STA* LU GET LOGICAL UNIT B4501760 RAO* MPREDX B4501770 LDQ* (MPREDX) B4501780 LDA- (ZERO),Q B4501790 STA* SIZE PICK UP MOTION FUNCTIONS (SET BY USER) B4501800 LDA* SIZE+2 MOVE DISPATCHER CALL UP B4501810 STA* SIZE+1 B450182000 JMP* MAKCAL B4501830 END B4501840_ 00 00 00 00 00 00 00 00 00 __ 0(v TTANDWMTHLIBRARY P999999060381(0 NAM NDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122 00010* DOUBLE-WORD MATH SUBROUTINES - NONREETRANT VERSION 00020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00040* COPYRIGHT CONTROL DATA CORPORATION 1977 00050* 00060* 0007000* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM 00080* THREE DOUBLE WORD ARITHMETIC OPERATIONS. 00090* THE DOUBLE WORD FORMAT IS THE SAME AS THE 00100* MSB/LSB FORMAT USED FOR SECTOR AND WORD 00110* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE 00120* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN 00130* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS 0014000* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). 00150* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO 00160* 'DOUBLE WORD VALUE'. 00170* 00180* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: 00190* ADD A DWV TO A 2ND DWV 00200* SUBTRACT A DWV FROM ANOTHER DWV 0021000* MULTIPLE A DWV BY A SINGLE WORD VALUE 00220* 00230* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER 00240* STORES THE VALUES TO BE OPERATED ON IN AN 00250* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF 00260* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- 00270* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE 0028000* SAVED AND RESTORED PRIOR TO RETURN TO THE 00290* CALLER. THE COMPLETION STATUS WILL BE 0 IF 00300* GOOD, ELSE IT WILL BE NON-ZERO. 00310* 00320* THE ENTRY POINT NAMES ARE AS FOLLOWS: 00330 ENT DWADD DOUBLE WORD ADD 00340 ENT DWSUB DOUBLE WORD SUBTRACT 0035000 ENT DWMUL DOUBLE WORD MULTIPLY 00360* 00370 EQU ZERO($22) 00380 EQU ONEMSK(3) 00390 EQU ONEBIT($23) 00400 EJT 00410* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: 0042000* FOR DWADD 00430* WORD DESCRIPTION 00440* 1 MSB OF 1ST DWV 00450* 2 LSB OF 1ST DMV 00460* 3 MSB OF 2ND DMV 00470* 4 LSB OF 2ND DMV 00480* 5 MSB OF RESULT DMV 0049000* 6 LSB OF RESULT DMV 00500* 7 COMPLETION STATUS 00510* 00520* FOR DWSUB 00530* WORD DESCRIPTION 00540* 1 MSB OF MINUEND 00550* 2 LSB OF MINUEND 0056000* 3 MSB OF SUBTRAHEND 00570* 4 LSB OF SUBTRAHEND 00580* 5 MSB OF RESULT 00590* 6 LSB OF RESULT 00600* 7 COMPLETION STATUS 00610* FOR DWMUL 00620* WORD DESCRIPTION 0063000* 1 MSB OF DWV 00640* 2 LSB OF DMV 00650* 3 SINGLE WORD VALUE 00660* 4 MSB OF RESULT 00670* 5 LSB OF RESULT 00680* 6 COMPLETION STATUS 00690* 0070000 EJT 00710DWADD 000 000 DOUBLE WORD ADD ROUTINE 00720A1 LDA- I SAVE I-REG CONTENTS 00730 STA* ISAVE 00740 STQ- I SET I TO ARRAY ADDRESS 00750 LDA- 1,I SET A TO LSB 00760 ENQ 0 CLEAR Q FOR USE AS MSB OFFSET 0077000 SOV 0 CLEAR OVERFLOW STATUS 00780 ADD- 3,I ADD LSB 00790 SNO A2 SKIP TO A3 IF NO OVERFLOW 00800 AND- ONEMSK+14 MASK OUT BIT 15 00810 INQ 1 BUMP Q TO PUT OVERFLOW IN MSB 00820A2 SAP A3 SKIP IF RESULT POSITIVE 00830 INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET 0084000 ADD- ONEBIT+15 MAKE LSW POSITIVE 00850A3 STA- 5,I STORE LSB 00860 TRQ A TRANSFER MSB OFFSET TO A 00870 SOV 0 CLEAR OVERFLOW 00880 ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET 00890 ADD- 2,I 00900 STA- 4,I STORE MSB 0091000 ENQ 0 CLEAR Q FOR COMPLETION STATUS 00920 SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEG 00930 SAP A5 00940A4 ENQ 1 00950A5 STQ- 6,I 00960 LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US 00970 SAP A6 SKIP IF NOT COMPLEMENTED 0098000 TCA A 00990 STA- 2,I 01000 LDA- 3,I 01010 TCA A 01020 STA- 3,I 01030A6 LDA* ISAVE RESTORE I-REG 01040 STA- I 0105000 JMP* (DWADD) 01060 SPC 4 01070ISAVE NUM 0 01080 EJT 01090DWSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE 01100 LDA* DWSUB 01110 STA* DWADD STORE RETURN ADDRESS IN DWADD'S ENTRY POINT 0112000 LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DWADD TO ADD 01130 TCA A 01140 STA- 2,Q 01150 LDA- 3,Q 01160 TCA A 01170 STA- 3,Q 01180 JMP* A1 0119000 EJT 01200DWMUL 000 000 DOUBLE WORD MULTIPLY 01210 LDA- I 01220 STA* ISAVE SAVE I-REG 01230 STQ- I SET I TO ARRAY ADDRESS 01240 LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE 01250 MUI- 2,I MULTIPLY BY SINGLE WORD VALUE 0126000 LLS 1 01270 ALS 15 CONVERT TO DOUBLE PRECISION FORMAT 01280 STQ* SAVE SAVE MSB 01290 STA- 4,I STORE LSB IN RESULT 01300 LDA- (ZERO),I 01310 MUI- 2,I MULTIPLY MSB BY SINGLE WORD 01320 LLS 1 0133000 ALS 15 DOUBLE PRECISION FORMAT 01340 SOV 0 CLEAR OVERFLOW 01350 INQ 0 CHECK FOR OVERFLOW 01360 SQZ 2 01370 LDQ- $11 SET OVERFLOW IND 01380 INQ 1 01390 LDQ* SAVE ADD MSB THAT WAS SAVED 0140000 AAQ Q ADD IN RESULT FROM MSB MULTIPLY 01410 STQ- 3,I STORE IN RESULT 01420 CLR A 01430 SOV M0 SKIP IF OVERFLOW 01440 SQP M1 01450M0 INA 1 01460M1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD 0147000 LDA* ISAVE RESTORE I-REG 01480 STA- I 01490 JMP* (DWMUL) RETURN TO CALLER 01500 SPC 2 01510SAVE NUM 0 01520 END 01530_ 00 00 00 00 00 00 00 __ 0(,vd ,}TAQ8CMP LIBRARY P (999999060381(0 NAM Q8CMP DECK-ID H06 FTN 3.3 RUNTIME SUMMARY-116 00010* 1700 MASS STORAGE FORTRAN VERSION 3.3 00020* SMALL COMPUTER DEVELOPMENT DIVISION, LA JOLLA CALIFORNIA 00030* COPYRIGHT CONTROL DATA CORPORATION 1973 00040 SPC 2 00050* CMPL0/CMPL1 00060* CMPL0 INITIALIZES AN I/O REQUEST 0007000* CMPL1 IMPLEMENTS AN I/O REQUEST 00080* 00090 ENT Q8CMP0 CMPL0 00100 ENT Q8CMP1 CMPL1 00110 ENT Q8DFAD 00120 ENT Q8QENS 00130 ENT RECEND 0014000* 00150 EXT Q8EREM EREMSG 00160 EXT Q8BEGB BEGBUF 00170 EXT Q8LOCB LOCBUF 00180 EXT Q8CLRB CLRBUF 00190 EXT Q8RINT RINTBF 00200 EXT Q8EOTT 0021000 EXT WRFLG 00220* 00230Q8DFAD JMP* CMPL0 00240 SLS 0 00250* CHECK UNIT RECORD TYPE 00260* ENTER WITH FLAG IN A, UNIT IN Q 00270CMPL0 NOP 0 0028000 STA* FLAG 00290 STQ UNIT1 00300 STQ* UNIT2 00310 LDA* Q8DFAD 00320 STA+ CHEK-2 SET UP SECTOR ADDR IF DISK 00330 SUB =N$1802 00340 SAN 2 SKIP IF DISK ADDR 0035000 STA Q8QENS IF NOT DISK CLEAR 00360 LDA* Q8DFAD+1 00370 STA+ CHEK-1 00380 CLR A 00390 STA COUNT 00400 STA TFLG 00410 STA WRFLG CLEAR I/O FLAG IN Q8RWBU 0042000* 00430* MAKE STATUS REQUEST 00440* SAVE EQUIPMENT TYPE 00450* 00460 RTJ- ($F4) 00470 NUM $4600 00480UNIT2 SLS 0 0049000 SLS 0 00500 TRQ A 00510 AND* EQPMSK EQUIPMENT CLASS MASK $3800 00520 ARS 11 00530 STA* ECLASS EQUIPMENT CLASS 00540* 00550 LDA* FLAG CHECK FO R FORMAT 0056000 AND* B14 00570 SAZ T00001 00580 LDA* UNIT2 FORMAT 00590 EOR* B12 00600 STA UNIT1 ASCII BIT ON IN UNIT PSR 743 00610T00001 LDA* FLAG CHECK READ OR WRITE 00620CK AND* B10 0063000 SAN RED-*-1 00640 LDA* FWRITE WRITE 00650 STA RQST 68*1553 00660 JMP* (CMPL0) 00670RED LDA* FREAD READ 00680 JMP* CK+3 00690FREAD NUM $4801 **FTN 3.0** 0070000FWRITE NUM $4C01 **FTN 3.0** 00710EQPMSK NUM $3800 EQUIPMENT CLASS MASK 00720B10 NUM $0400 00730B12 NUM $1000 00740 EQU B9A10(UNIT2-1) 00750 BZS FLAG 00760ECLASS NUM 0 SAVE FOR TYPE PSR 743 0077000B14 NUM $4000 00780* 00790* ENTRY FROM RWBUF, Q8QEND, AND FORMATTER 00800* 00810CMPL1 NOP 0 00820 STA* ENDFLG Q8QEND INDICATOR 00830 TRA Q 0084000 RTJ+ Q8BEGB BEGBUF 00850 STA LOC1 BEG LOC OF BUFFER 00860* COMPUTE NR OF WORDS 00870 RTJ+ Q8LOCB LOCBUF 00880 SUB LOC1 00890 INA 1 00900 STA NR1 NO OF WORDS IN BUFFER 0091000 TRA Q 00920 LDA* ECLASS PSR 743 00930 INA -1 CHECK FOR MAG TAPE 00940 SAN NOTMAG-*-1 NO 00950 INQ -9 YES. CHECK TRANSGER LENGT 00960 SQP 2 PSR 743 00970 ENA 9 L. T. 9 WORDS IS ERROR 0098000 STA* NR1 00990 RTJ Q8EOTT CHECK END OF MAG TAPE 01000NOTMAG LDA* ECLASS IS THIS A TTY 01010 INA -6 01020 SAZ TTY 01030 JMP* NOTYPE NO TTY 01040TTY LDA* ENDFLG 0105000 SAZ TYPE-*-1 CALL FROM WRBUF OR BINBUF 01060 LDA* FLAG CALL FROM Q8QEND 01070 AND* B10 TEST FOR READ 01080 SAZ 1 01090 JMP* EXIT 01100TYPE RTJ* RORW 01110EXIT NOP 0 0112000* 01130* EXIT/RETURN WITH COMPOSITE I/O STATUS IN A 01140* FOR Q8QEND 01150* 01160 LDA* ENDFLG NONZERO FOR Q8QEND 01170 SAZ RETURN-*-1 01180 LDA* FLAG 0119000 AND* B9A10 BITS 9-10 FOR W/R 01200 LDQ* TFLG I/O ERROR BITS 15,14,13 01210 SQP RETURN-*-1 NO I/O ERROR 01220 ARS 3 COMPENSATE 01230 LLS 3 SHIFT ERROR BITS INTO A 01240RETURN JMP* (CMPL1) 01250* 0126000* NON-TELETYPE I/O MEDIA 01270NOTYPE RAO* COUNT INCREASE PHYS REC COUNT 01280 LDA* FLAG IS TJIS FORMAT I/O 01290 AND* B14 01300 SAZ 1 01310 JMP* FORM+1 01320* 0133000* BINARY LOG REC ARE COMPPOSED OF 86 WORD PHYS REC 01340* WORD1 IS CONTROL WORD WITH LAST PHYS REC CONTROL WOR 01350* D = NUMBER OF PHYS REC IN LOG REC 01360* 01370 LDA* LOC1 01380 INA -1 01390 STA* LOC1 DECREASE LOC OF BUFFER 0140000 ENA 86 01410 LDQ* FLAG 01420 QLS 7 01430 SQP 1 SKIP IF NOT DISK 01440 ENA 96 01450 EQU FORM(*) 01460 STA* NR1 0147000KLUGA LDA* ENDFLG 01480 SAZ 1 01490 JMP* END CALL FROM Q8QEND 01500WRBUF CLR A 01510 LDQ* FLAG FORMAT 01520 QLS 1 01530 SQM WRBUFA YES 0154000 STA* (LOC1) 01550 LDQ* FLAG IS THIS A 01560 QLS 5 IS THIS A READ REQUEST 01570 SQM WRBUFA YES SKIP END OF RECORD TEST 01580 QLS 2 NO IS IT A DISK REQUEST 01590 SQP WRBUFA NO 01600 LDA* RECEND CHECK FOR PAST END OF RECORD 0161000 INA -1 01620 SUB* CHEK-1 01630 SAP WRBUFA 01640 JMP* KLUGE 01650WRBUFA RTJ* RORW I/O 01660 JMP* EXIT 01670END LDA* FLAG IS THIS A READ 0168000 AND* B10 01690 SAN 1 YES 01700 JMP* WEND NO 01710REND LDA* FLAG CHECK FOR 01720 ALS 7 MASS MEMEOY 01730 SAP 1 NO 01740 JMP* EXIT YES SKIP READ TO END 0175000 LDA* (LOC1) CHECK LOGICAL RECORD END 01760 SAZ 1 01770 JMP* EXIT END OF LOGICAL RECORD 01780 RTJ* RORW NOT END-CONTINUE READ 01790 JMP* REND 01800WEND LDA* COUNT 01810 LDQ* FLAG FORMAT 0182000 QLS 1 01830 SQM WENDA 01840 STA* (LOC1) 01850 LDQ* FLAG IS THIS A 01860 QLS 7 DISK REQUEST 01870 SQP WENDA 01880* 2 CARDS DELETED *** REMOVED TEST FOR MASS STORAGE I/O 0189000 LDA* RECEND CHECK FOR WRITE 01900 INA -1 BEYOND END OF REXORD 01910 SUB* CHEK-1 01920 SAP WENDA O K 01930 JMP* KLUGE TOO 01940WENDA RTJ* RORW 01950 JMP* EXIT 0196000 BZS TFLG 01970* 1 CARD DELETED 01980 BZS ENDFLG 01990 BZS Q8QENS HOLDS ENDING SECTOR ADDR FOR DISK 02000RECEND BZS RECEND ENDSEC+1 FOR RECORD 02010RORW NOP 0 02020 LDA* FLAG 0203000 AND* B10 02040 SAN 1 02050 JMP* WRITE 02060READ RTJ+ Q8CLRB CLRBUF 02070 RTJ+ Q8RINT RINTBF 02080 ENA 60 ALL FORMAT READS ARE **ITOS 2.0** 02090 STA* NR1 SHORT TRANSFERS 0210000 RTJ* RQST1 02110 JMP* (RORW) 02120WRITE RTJ* RQST1 02130 RTJ* (READ+1) CLEAR BUFFER 02140 RTJ* (READ+3) REINITIALIZE BUFFER 02150 JMP* (RORW) 02160* OUTPUT BUFFER ON DEVICE 0217000RQST1 NOP 0 02180* 2 CARDS DELETED 68$1553 02190 RTJ- ($F4) 02200RQST SLS 0 02210COMP1 ADC 0 COMPLETION ADDRESS 68*1553 02220THRD ADC 0 THREAD WORD 68*1553 02230UNIT1 SLS 0 0224000NR1 SLS 0 02250LOC1 SLS 0 02260 SAZ 1 WILL CONTAIN SECTOR ADDR IF DISK 02270 SLS 0 02280CHEK LDA* THRD 68*1553 02290 SAZ OUTLOP 68*1553 02300 JMP* CHEK 0231000OUTLOP LDQ* UNIT1 TEST FOR ERROR 70*1606 02320 SQP NOEROR 70*1606 02330 STQ* TFLG SAVE ERROR FLAG 70*1606 02340NOEROR LDA* Q8QENS ENDING SECTOR NUMBER FOR DISK 70*1606 02350 SAN 1 SKIP IF DISK I/O 02360 JMP* (RQST1) NOT DISK - EXIT 02370 LDA* CHEK-1 0238000 INA 1 BUMP FOR NEXT READ OR WRITE 02390 SAP 3 02400 AND =N$7FFF 02410 RAO* CHEK-2 BUMP HIGH ORDER ADDR 02420 STA* CHEK-1 02430 SUB* Q8QENS 02440 SAZ 1 OK IF ZERO 0245000 SAP 1 SKIP IF OUT OF RANGE 02460 JMP* (RQST1) 02470KLUGE ENA 19 02480 RTJ+ Q8EREM 02490 JMP* EX19 02500* 02510* 0252000* 3 CARDS DELETED 68*1553 02530EX19 RTJ- ($F4) EXIT REQUEST 02540 NUM $0A00 02550* 02560* 1 CARD DELETED 68*1553 02570 BZS COUNT 02580 EQU Q8CMP0(CMPL0),Q8CMP1(CMPL1) 0259000 END 02600_ 00 00 00 00 00 __ 0(v  TARAO LIBRARY Px999999060381(0 NAM RAO 00010 ENT RAO 00020RAO NUM 0 00030 STQ* SQ 00040 LDQ* (RAO) 00050 RAO* RAO 00060 RAO- ($22),Q 0007000 LDA- ($22),Q 00080 LDQ* SQ 00090 JMP* (RAO) 00100SQ NUM 0 00110 END 00120_ 00 __ 0(v TTASEKVITLIBRARY P999999060381(0 NAM SEKVIT SEARCH FOR VIT MATCH TO VOLUME NAME 00010* SEARCH VIT FOR MATCH AGAINST VOLUME NAME 00020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00040* COPYRIGHT CONTROL DATA CORPORATION 1977 00050* MODIFIED 03/25/80 J.M.SCHMIDT/CGODSO/PSD 00060* 0007000**** 00080* FUNCTION 00090* 00100* 00110* THIS ROUTINE SEARCHES THE CORE-RESIDENT VOLUME-INFORMATION TABLES 00120* FOR A MATCH AGAINST A PASSED VOLUME-NAME.IF A MATCH IS FOUND THEN 00130* THE CORE-ADDRESS AND THE MASS-MEMORY UNIT NO.OF THE SELECTED VIT 0014000* ARE RETURNED . IF NO MATCH IS FOUND,AN ADDRESS OF ZERO IS RETURNED 00150* 00160* CALLING SEQUENCE 00170* 00180* CALL SEKVIT (NAME,VITADR,MMUNIT) 00190* 00200* 0021000* INPUT 00220* 00230* NAME VOLUME NAME 00240* 00250* 00260* OUTPUT 00270* 0028000* VITADR VOLUME INFORMATION TABLE ADDR 00290* MMUNIT PHYSICAL MM UNIT NO 00300* 00310* PARAMETER 00320* 00330* NAME 4 WORD ASCII BUFFER CONTAINING THE VOLUME-NAME 00340* VITADR SELECTED VIT OR ZERO 0035000* MMUNIT VOLUME'S MASS MEMORY UNIT NO(INDEX TO MMLUTB) 00360* 00370* ENTRY POINTS 00380* 00390 ENT SEKVIT 00400* 00410* EXTERNALS 0042000* 00430 EXT Q8PREP 00440 EXT Q8PKUP 00450* 00460* EQUIVALENCES 00470* 00480 EQU ZERO($22) 0049000* 00500* VOLUME INFORMATION TABLE 00510* 00520 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READY 00530* ACCESS VISLUN INDIRECTLY 00540 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 00550* VOLUME NAME - ASCII CHARACTERS 3 AND 4 0056000* VOLUME NAME - ASCII CHARACTERS 5 AND 6 00570* VOLUME NAME - ASCII CHARACTERS 7 AND 8 00580 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) 00590 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB 00600 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB 00610 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB 00620 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB 0063000 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY 00640 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB 00650 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB 00660 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME 00670 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB 00680 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB 00690 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME 0070000 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME 00710 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY 00720 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY 00730 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME 00740**** 00750* 00760* 0077000* START OF VIT SEARCH 00780* 00790SEKVIT NOP 00800 STQ* QSAVE SAVE Q REGISTER 00810 LDA- I 00820 STA* ISAVE SAVE I REGISTER 00830* 0084000 RTJ Q8PREP 00850 ADC* SEKVIT ABSOLUTISE PARAMETER ADDRESS 00860* 00870HERE RTJ Q8PKUP 00880 STA* NAME SAVE BUFFER ADDRESS 00890 RTJ* (HERE+1) 00900 STA* VITADR SAVE VITADR ADDRESS 0091000 RTJ* (HERE+1) 00920 STA* MMUNIT SAVE MMUNIT ADDRESS 00930* 00940 LDQ- $E9 ADDRESS OF EXTENDED CORE TABLE 00950 LDA- $1D,Q ADDRESS OF MASS MEMORY LU TABLE 00960 STA* XMMLUT 00970* 0098000* START TABLE LOOP 00990* 01000 ENQ 1 01010 STQ* (MMUNIT) 01020* 01030TLOOP LDQ* (MMUNIT) Q=CURRENT INDEX TO MMLUTB 01040 LDA* (XMMLUT),Q GET TABLE ADDRESS 0105000 STA- I 01060 LDA- (VISLUN),I CHECK IF VOLUME IS MOUNTED 01070 SAM NEXT SKIP IF NOT MOUNTED 01080 LDA- I 01090 INA VINAME SAVE VOLUME NAME ADDRESS 01100 STA- I 01110 ENQ 3 CHECK IF NAME MATCHES 0112000* 01130NLOOP LDA* (NAME),Q 01140 EOR- (ZERO),B 01150 SAN NEXT SKIP IF NOT EQUAL 01160 INQ -1 01170 SQM FOUND 01180 JMP* NLOOP 0119000* 01200NEXT LDA* (MMUNIT) ALL TABLES SEARCHED 01210 SUB* (XMMLUT) 01220 SAZ EXIT YES 01230 RAO* (MMUNIT) NO 01240 JMP* TLOOP 01250* 0126000FOUND LDA- I RETURN VIT ADDRESS 01270 INA -VINAME 01280* 01290EXIT STA* (VITADR) 01300 LDQ* QSAVE RESTORE Q REGISTER 01310 LDA* ISAVE 01320 STA- I RESTORE I REGISTER 0133000* 01340 JMP* (SEKVIT) 01350* 01360* LOCAL VARIABLES 01370* 01380QSAVE NUM 0 LOCATION TO SAVE Q REGISTER 01390ISAVE NUM 0 LOCATION TO SAVE I REGISTER 0140000NAME NUM 0 LOCATION TO SAVE VOLNAM ADDRESS 01410VITADR NUM 0 01420MMUNIT NUM 0 01430XMMLUT NUM 0 01440* 01450 END 01460_ 00 00 00 00 00 00 00 00 __ 0(xu TASYSMSGLIBRARY P999999060381(0 NAM SYSMSG DECK-ID A33 ITOS 2.0 ( 132 ) SUMMARY-*** 00010* USER PROGRAM MESSAGE PROCESSOR 00020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 2.0 00030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00040* COPYRIGHT CONTROL DATA CORPORATION 1978 00050* 00060 SPC 2 0007000 ENT SYSMSG SYSTEM MESSAGE 00080 ENT ERRSET SET FILE/OWNER/VOLUME FOR ERRMSG 00090 ENT ERRMSG USER MESSAGE 00100 EXT OPENFL OPEN FILE FILE REQUEST 00110 EXT CLOSFL CLOSE FILE FILE REQUEST 00120 EXT READR READ RECORD RANDOMLY FILE REQUEST 00130 EQU LPMASK(2) BIT MASK TABLE 0014000 EQU ZERO($22) LOCATION CONTAINING ZERO 00150 EQU TEN($46) LOCATION CONTAINING TEN 00160 EQU AMONI($F4) MONITOR REQUEST ENTRY 00170 EQU ASC($40) ASCII SPECIFICATION CHARACTER (@) 00180 EQU DEC($23) DECIMAL SPECIFICATION CHARACTER (#) 00190 EQU HEX($24) HEXIDECIMAL SPECIFICATION CHARACTER ($) 00200 SPC 2 0021000ERRMSG NOP 0 PROCESS MESSAGE FROM USER DEFINED FILE 00220 LDA =XJDATA 00230 STA* PATCH1 PATCH OPENFL REQUEST 00240 ENA 3 00250 STA MESGSW SET INDEX FOR DEFAULT MESSAGE 00260 LDA* ERRMSG 00270 STA* SYSMSG PATCH RETURN ADDRESS 0028000 JMP* SYS001 ENTER SYSMSG PROCESSING 00290 SPC 2 00300SYSMSG NOP 0 00310 LDA =XIDATA 00320 STA* PATCH1 PATCH OPENFL REQUEST 00330 ENA 2 00340 STA MESGSW SET INDEX FOR DEFAULT MESSAGE 0035000 SPC 1 00360SYS001 STQ* SAVQ SAVE THE Q-REGISTER 00370 SPC 1 00380 LDA- $E3 IS THE SYSTEM HANG SWITCH SET 00390SYS010 SAP SYS020 NO, CONTINUE 00400 JMP* SYS010 CLEAR THE A-REGISTER TO CONTINUE 00410 SPC 1 0042000SYS020 LDQ* (SYSMSG) 00430 RAO* SYSMSG 00440 LDA- (ZERO),Q OBTAIN THE FIRST PARAMETER - MESSAGE INDEX 00450 STA* MSGTYP SAVE THE DISPOSITION INDICATOR 00460 SAP SYS030 00470 TCA A 00480SYS030 SAN SYS040 0049000 JMP SYS450 INDEX = 0 (ILLEGAL) 00500 EJT 00510 SPC 4 00520SYS040 STA* RECNUM+1 RECNUM = MESSAGE INDEX 00530 SPC 1 00540 LDQ* (SYSMSG) 00550 RAO* SYSMSG 0056000 STQ* DATBUF SAVE THE SECOND PARAMETER - DATA BUFFER 00570 SPC 1 00580 ENQ 23 00590 ENA 0 00600SYS050 STA REQBUF,Q INITIALIZE THE FILE REQUEST BUFFER 00610 DQP *-SYS050 00620 SPC 1 0063000 RTJ+ OPENFL OPEN THE SYSTEM MESSAGE FILE 00640 ADC REQBUF 00650PATCH1 ADC IDATA 00660 ADC ISTAT 00670 SPC 1 00680 LDA* ISTAT WERE THERE ANY FILE ERRORS 00690 SAP SYS060 NO 0070000 JMP SYS450 YES 00710 SPC 1 00720SYS060 RTJ+ READR READ THE MESSAGE RECORD 00730 ADC REQBUF 00740 ADC RECBUF 00750 ADC RECNUM 00760 ADC ISTAT 0077000 SPC 1 00780 LDA* ISTAT WERE THERE ANY FILE ERRORS 00790 SAP SYS070 NO 00800 JMP* SYS450 YES 00810 SPC 1 00820 SPC 1 00830SYS070 RTJ+ CLOSFL CLOSE THE MESSAGE FILE 0084000 ADC REQBUF 00850 ADC ISTAT 00860 EJT 00870 SPC 4 00880 ENQ 0 00890 STQ* RECIDX INITIALIZE THE RECORD CHARACTER INDEX 00900 STQ* BUFIDX INITIALIZE THE DATA CHARACTER INDEX 0091000 SPC 1 00920SYS100 LDQ* RECIDX 00930 TRQ A 00940 INA -80 HAS THE ENTIRE RECORD BEEN SEARCHED 00950 SAP SYS130 YES, DISPLAY THE MESSAGE 00960 SPC 1 00970 RTJ GETCHR NO, GET THE NEXT CHARACTER FROM RECBUF 0098000 ADC RECBUF 00990 INQ 1 01000 STQ* RECIDX 01010 SPC 1 01020 INA -ASC IS THIS AN ASCII SPECIFICATION 01030 SAZ SYS140 YES 01040 INA -DEC+ASC NO, IS A DECIMAL SPECIFICATION 0105000 SAZ SYS110 YES 01060 INA -HEX+DEC NO, IS IT A HEXIDECIMAL SPECIFICATION 01070 SAZ SYS120 YES 01080 JMP* SYS100 NO, CONTINUE THE SCAN 01090 SPC 1 01100SYS110 JMP* SYS200 DECIMAL CONVERSION 01110SYS120 JMP* SYS300 HEXIDECIMAL CONVERSION 0112000SYS130 JMP* SYS400 DISPLAY THE MESSAGE RECORD 01130 SPC 2 01140SYS140 LDQ* BUFIDX ASCII SPECIFICATION 01150 RTJ* GETCHR GET THE NEXT CHARACTER FROM THE DATA BUFFER 01160DATBUF ADC 0 MESSAGE DATA BUFFER ADDRESS 01170 INQ 1 01180 STQ* BUFIDX 0119000 SPC 1 01200 LDQ* RECIDX 01210 INQ -1 01220 RTJ* PUTCHR PLACE THE CHARACTER IN THE MESSAGE RECORD 01230 ADC RECBUF 01240 JMP* SYS100 CONTINUE 01250 EJT 0126000 SPC 4 01270* D A T A A N D S T O R A G E 01280 SPC 2 01290SAVQ ADC 0 Q-REGISTER STORAGE 01300MSGTYP ADC 0 MESSAGE DISPOSITION TYPE 01310RECIDX ADC 0 MESSAGE RECORD CHARACTER INDEX 01320BUFIDX ADC 0 MESSAGE BUFFER CHARACTER INDEX 0133000ISTAT ADC 0 FILE REQUEST RETURN STATUS 01340RECNUM ADC 0,0 MESSAGE FILE RELATIVE RECORD NUMBER 01350IDATA ALF 4,$$SYMSGF FILE NAME 01360 ALF 4,$$ FILE OWNER 01370 ALF 4, FILE VOLUME 01380 ADC 0 SEQUENTIAL FILE 01390 ADC 1 RECORDS / REQUEST 0140000 ADC 0 RECORD LOCK INDICATOR 01410 EJT 01420 SPC 4 01430SYS200 RTJ* (AGTVAL) OBTAIN THE DATA VALUE 01440 RAO* BUFIDX 01450 RAO* BUFIDX INCREMENT THE DATA BUFFER INDEX 01460 RTJ* DECCON CONVERT THE VALUE TO DECIMAL ASCII 0147000 SPC 1 01480 ENQ 0 01490 STQ* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX 01500 LDQ* RECIDX 01510 INQ -1 01520 STQ* BASIDX SAVE THE INITIAL CHARACTER INDEX 01530 SPC 1 0154000SYS210 RTJ* GETCHR OBTAIN THE NEXT MESSAGE CHARACTER 01550 ADC RECBUF 01560 INA -DEC IS IT A DECIMAL SPECIFICATION 01570 SAN SYS220 NO 01580 INQ 1 YES 01590 JMP* SYS210 CONTINUE 01600 SPC 1 0161000SYS220 RTJ* MOVDAT MOVE THE CONVERTED DATA INTO THE RECORD 01620 JMP* SYS100 CONTINUE THE RECORD SCAN 01630 SPC 4 01640SYS300 RTJ* (AGTVAL) OBTAIN THE DATA VALUE 01650 RTJ* HEXCON CONVERT THE VALUE TO HEXIDECIMAL ASCII 01660 SPC 1 01670 ENQ 0 0168000 STQ* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX 01690 LDQ* RECIDX 01700 INQ -1 01710 STQ* BASIDX SAVE THE INITIAL CHARACTER INDEX 01720 SPC 1 01730SYS310 RTJ* GETCHR OBTAIN THE NEXT MESSAGE CHARACTER 01740 ADC RECBUF 0175000 INA -HEX IS IT A HEXIDECIMAL SPECIFICATION 01760 SAN SYS320 NO 01770 INQ 1 YES 01780 JMP* SYS310 CONTINUE 01790 SPC 1 01800SYS320 RTJ* MOVDAT MOVE THE CONVERTED DATA INTO THE RECORD 01810 JMP* SYS100 CONTINUE THE RECORD SCAN 0182000 SPC 2 01830BASIDX ADC 0 TEMPORARY STORAGE - BASE RECORD INDEX 01840PUTIDX ADC 0 TEMPORARY STORAGE - DATA PLACEMENT INDEX 01850AGTVAL ADC GETVAL ADDRESS OF THE DATA VALUE PICKUP ROUTINE 01860 EJT 01870 SPC 4 01880MOVDAT NOP 0 0189000 SPC 1 01900MOV010 INQ -1 01910 STQ* PUTIDX 01920 SPC 1 01930 LDQ* CONIDX 01940 RTJ* GETCHR OBTAIN THE NEXT CONVERTED CHARACTER 01950 ADC CONBUF 0196000 SPC 1 01970 INQ 1 01980 STQ* CONIDX 01990 SPC 1 02000 LDQ* PUTIDX 02010 RTJ* PUTCHR PLACE THE DATA IN THE RECORD 02020 ADC RECBUF 0203000 TRQ A 02040 SUB* BASIDX HAS ALL THE DATA BEEN ENTERED 02050 SAZ MOV020 YES 02060 JMP* MOV010 NO, CONTINUE 02070 SPC 1 02080MOV020 JMP* (MOVDAT) RETURN 02090 EJT 0210000 SPC 4 02110SYS400 ENQ 0 DISPLAY THE MESSAGE ON THE USERS TERMINAL 02120 RTJ* (AMESSG) 02130 SPC 1 02140 LDA* MSGTYP IS IT ALSO REQUIRED AT THE MASTER TERMINAL 02150 SAP SYS410 NO 02160 SPC 1 0217000 ENQ 1 YES, DISPLAY THE MESSAGE THERE ALSO 02180 RTJ* (AMESSG) 02190 SPC 1 02200SYS410 LDQ* SAVQ RESTORE THE Q-REGISTER 02210 JMP (SYSMSG) RETURN 02220 SPC 2 02230SYS450 RTJ+ CLOSFL CLOSE THE MESSAGE FILE 0224000 ADC REQBUF 02250 ADC ISTAT 02260 SPC 1 02270 ENQ 0 MESSAGE RECORD NOT AVAILABLE 02280 LDA* RECNUM+1 02290 RTJ* DECCON CONVERT THE RECORD NUMBER 02300 SPC 1 0231000 LDQ* MESGSW RECORD NUMBER TO CORRECT MESSAGE STRING 02320 LDQ MESSAD,Q 02330 INQ 9 02340 LDA* CONBUF 02350 ALS 8 EXCHANGE THE 2 LSD 02360 STA- (ZERO),Q 02370 INQ -1 0238000 LDA* CONBUF+1 02390 ALS 8 EXCHANGE THE NEXT 2 DIGITS 02400 STA- (ZERO),Q 02410 SPC 1 02420 LDQ* MESGSW DISPLAY THE MESSAGE RECORD NUMBER 02430 RTJ* (AMESSG) 02440 JMP* SYS410 CONTINUE 0245000 SPC 2 02460MESGSW ADC 0 SYSTEM(2) / USER(3) MESSAGE SWITCH 02470CONIDX ADC 0 MESSAGE DATA CHARACTER INDEX 02480AMESSG ADC MESSAG ADDRESS OF THE MASSAGE DISPLAY ROUTINE 02490 EJT 02500GETCHR NOP 0 02510 LDA* (GETCHR) OBTAIN THE BUFFER ADDRESS 0252000 STA* CHRBUF AND SAVE 02530 RAO* GETCHR 02540 STQ* CHRTMP SAVE THE CHARACTER INDEX 02550 SPC 1 02560 QRS 1 Q = WORD INDEX 02570 LDA* (CHRBUF),Q OBTAIN THE WORD CONTAINING THE CHARACTER 02580 LDQ* CHRTMP 0259000 QLS 15 IS THIS A RIGHT OR LEFT CHARACTER 02600 SQM GET010 RIGHT 02610 ARS 8 02620GET010 QLS 1 RESTORE THE CHARACTER INDEX 02630 AND- LPMASK+8 ISOLATE THE CHARACTER 02640 JMP* (GETCHR) RETURN 02650 SPC 2 0266000CHRTMP ADC 0 TEMPORARY STORAGE - CHARACTER INDEX 02670CHRBUF ADC 0 TEMPORARY STORAGE - BUFFER ADDRESS 02680 SPC 4 02690PUTCHR NOP 0 02700 STQ* CHRTMP SAVE THE CHARACTER INDEX 02710 LDQ* (PUTCHR) OBTAIN THE BUFFER ADDRESS 02720 STQ* CHRBUF AND SAVE 0273000 RAO* PUTCHR 02740 SPC 1 02750 LDQ* CHRTMP 02760 ALS 9 02770 LRS 1 BITS 8-14 OF A = CHARACTER, Q = WORD INDEX 02780 LDQ* (CHRBUF),Q OBTAIN THE CURRENT BUFFER WORD 02790 SAM PUT010 SKIP IF THE CHARACTER IS ON THE RIGHT 0280000 LLS 16 02810 ALS 8 POSITION THE CHARACTER 02820PUT010 AND- LPMASK+15 REMOVE THE LEFT / RIGHT INDICATOR 02830 QRS 8 02840 LRS 8 FORM THE WORD 02850 LDQ* CHRTMP 02860 QRS 1 Q = WORD INDEX 0287000 STA* (CHRBUF),Q 02880 LDQ* CHRTMP RESTORE THE CHARACTER INDEX 02890 JMP* (PUTCHR) RETURN 02900 EJT 02910DECCON NOP 0 02920 SPC 1 02930 DVI* TENKAY DIVIDE THE DATA INTO TWO PARTS 0294000 STQ* CONTMP SAVE THE LSD 02950 SAZ DEC010 SKIP IF THE MSD IS ZERO 02960 SPC 1 02970 ENQ 4 CONVERT THE MSD TO DECIMAL ASCII 02980 RTJ* CONVRT 02990 SPC 1 03000DEC010 ENQ 0 CONVERT THE LSD TO DECIMAL ASCII 0301000 LDA* CONTMP 03020 RTJ* CONVRT 03030 SPC 1 03040 JMP* (DECCON) RETURN 03050 SPC 2 03060CONTMP ADC 0 TEMPORARY STORAGE 03070TENKAY ADC 10000 DATA DIVISOR 0308000 SPC 4 03090HEXCON NOP 0 03100 SPC 1 03110 ENA 0 03120 STA* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX 03130 SPC 1 03140HEX010 LRS 4 0315000 ARS 12 OBTAIN THE NEXT DIGIT 03160 AND- LPMASK+4 03170 STQ* CONQUO SAVE THE QUOTIENT 03180 INA -$A 03190 SAM HEX020 CONVERT THE DIGIT TO ASCII 03200 INA 7 03210HEX020 INA $3A 0322000 LDQ* CONIDX 03230 RTJ* PUTCHR PLACE THE DIGIT IN THE CONVERSION BUFFER 03240 ADC CONBUF 03250 SPC 1 03260 INQ 1 03270 STQ* CONIDX 03280 LDA* CONQUO 0329000 AND- LPMASK+12 03300 TRA Q IS MORE CONVERSION REQUIRED 03310 SQZ HEX030 NO 03320 JMP* HEX010 YES, CONTINUE 03330 SPC 1 03340HEX030 JMP* (HEXCON) RETURN 03350 EJT 0336000CONVRT NOP 0 03370 SPC 1 03380CON010 STQ* CONIDX SAVE THE STORAGE INDEX 03390 CLR Q 03400 DVI- TEN OBTAIN THE NEXT DIGIT 03410 STA* CONQUO SAVE THE QUOTIENT 03420 TRQ A 0343000 INA $30 CONVERT THE DIGIT TO ASCII 03440 LDQ* CONIDX 03450 RTJ* PUTCHR PLACE THE DIGIT IN THE CONVERSION BUFFER 03460 ADC CONBUF 03470 SPC 1 03480 INQ 1 INCREMENT THE STORAGE INDEX 03490 LDA* CONQUO IS MORE CONVERSION REQUIRED 0350000 SAZ CON020 NO 03510 JMP* CON010 YES, CONTINUE 03520 SPC 1 03530CON020 JMP* (CONVRT) RETURN 03540 SPC 2 03550CONQUO ADC 0 TEMPORARY STORAGE - DIVISION QUOTIENT 03560ABFIDX ADC BUFIDX ADDRESS OF THE DATA BUFFER INDEX 0357000 SPC 4 03580GETVAL NOP 0 03590 SPC 1 03600 ENQ 7 03610 LDA =A00 INITIALIZE THE CONVERSION BUFFER 03620GEV010 STA* CONBUF,Q 03630 INQ -1 0364000 SQM GEV020 03650 JMP* GEV010 03660 SPC 1 03670GEV020 LDQ* (ABFIDX) Q = DATA BUFFER CHARACTER INDEX 03680 LRS 1 03690 SAP GEV030 CONVERT TO WORD INDEX 03700 INQ 1 0371000GEV030 ADQ DATBUF 03720 LDA- 1,Q A = LSD OF THE VALUE 03730 LDQ- (ZERO),Q Q = MSD OF THE VALUE 03740 RAO* (ABFIDX) 03750 RAO* (ABFIDX) INCREMENT THE DATA INDEX 03760 JMP* (GETVAL) RETURN 03770 SPC 2 0378000CONBUF BZS CONBUF(8) 03790 EJT 03800 SPC 4 03810MESSAG NOP 0 03820 LDA* MESSAD,Q 03830 STA* MESAD SPECIFY THE MESSAGE ADDRESS 03840 LDA* MESLUN,Q 0385000 STA* MESLU SPECIFY THE MESSAGE LOGICAL UNIT 03860 LDQ* MESLEN,Q 03870 QRS 1 03880 SPC 1 03890MES010 INQ -1 03900 SQM MES020 03910 LDA* (MESAD),Q 0392000 SUB =A IS THIS THE END OF THE SIGNIFICANT TEXT 03930 SAN MES020 YES 03940 JMP* MES010 NO, CONTINUE 03950 SPC 1 03960MES020 INQ 1 03970 QLS 1 03980 STQ* MESLN SPECIFY THE MESSAGE LENGTH 0399000 SPC 1 04000 RTJ- (AMONI) DISPLAY THE MESSAGE 04010 ADC $4C44 04020 ADC 0 04030 ADC 0 04040MESLU ADC 0 04050MESLN ADC 0 0406000MESAD ADC 0 04070 SPC 1 04080 JMP* (MESSAG) RETURN 04090 SPC 2 04100MESSAD ADC RECBUF 0 04110 ADC RECBUF 1 04120 ADC MESG02 2 0413000 ADC MESG03 3 04140 SPC 1 04150MESLEN ADC 72 0 04160 ADC 72 1 04170 ADC 2*LMSG02 2 04180 ADC 2*LMSG03 3 04190 SPC 1 0420000MESLUN ADC 00 0 04210 ADC 4 1 04220 ADC 0 2 04230 ADC 0 3 04240 EJT 04250 SPC 4 04260MESG02 ALF $,SYSTEM MESSAGE XXXX$ 0427000 EQU LMSG02(*-MESG02) 04280* MESG03 FORMAT MUST BE SAME AS MESG02 FORMAT 04290MESG03 ALF $,USER MESSAGE XXXX$ 04300LMSG03 EQU LMSG03(*-MESG03) 04310REQBUF BZS REQBUF(24) 04320RECBUF BZS RECBUF(40) 04330 EJT 0434000 SPC 4 04350ERRSET NOP 0 SET USER DEFINED MESSAGE FILE 04360 STQ SAVQ SAVE THE Q-REGISTER 04370 LDA* (ERRSET) PARAMETER STRING ADDRESS 04380 STA* ERRADR 04390 RAO* ERRSET 04400 ENQ 12-1 0441000ERR010 LDA* (ERRADR),Q COPY FILE / OWNER / VOLUME 04420 STA* JDATA,Q 04430 DQP *-ERR010 04440 LDQ SAVQ RESTORE Q-REGISTER 04450 JMP* (ERRSET) RETURN 04460 SPC 1 04470JDATA ADC 0,0,0,0 USER FILE NAME 0448000 ALF 4, USER FILE OWNER 04490 ALF 4, USER FILE VOLUME 04500 ADC 0 SEQUENTIAL FILE 04510 ADC 1 RECORDS / REQUEST 04520 ADC 0 RECORD LOCK INDICATOR 04530ERRADR ADC 0 ADDRESS OF PARAMETER STRING 04540 END 0455000_ 00 00 00 00 00 00 __ 0(dwA d*TAVDC LIBRARY P999999060381(0 NAM VDC VALIDATE TWO DISPLAYABLE CHARACTERS 00010 SPC 1 00020* COPYRIGHT COTROL DATA CORPORATION 01/21/80 00030 SPC 1 00040* 00050 ENT VDC 00060* 0007000LPMASK EQU LPMASK(2) 00080ZERO EQU ZERO($22) 00090* 00100TEMP BSS TEMP(1) 00110SAVEQ BSS SAVEQ(1) 00120 SPC 4 00130*** VDC - VALIDATE TO DISPLAYABLE CHARACTERS. 0014000* 00150* IW=VDC(JW) 00160* JW - 2 CHARACTER INPUT WORD 00170* IW - RESULT, DISPLAYABLE CHARACTER MAPPING OF JW 00180 SPC 4 00190VDC NOP 0 ENTRY 00200 STQ* SAVEQ SAVE IT FOR FTN 0021000 LDQ* (VDC) 00220 LDA- (ZERO),Q 00230 AND- LPMASK+8 LOWER CHARACTER 00240 INA -$20 00250 SAM VDC10 IF UNDISPLAYABLE 00260 INA $20-$7E-1 00270 SAM VDC11 IF DISPLAYABLE 0028000VDC10 ENA $2E-$7E-1 BIASED PERIOD AS FILL CHARACTER 00290VDC11 INA $7E+1 UNBIAS DISPLAYABLE CHARACTER 00300 STA* TEMP SAVE HALF OF RESULT 00310 LDA- (ZERO),Q 00320 ALS 8 00330 AND- LPMASK+8 UPPER CHARACTER 00340 INA -$20 0035000 SAM VDC20 IF UNDISPLAYABLE 00360 INA $20-$7E-1 00370 SAM VDC21 IF DISPLAYABLE 00380VDC20 ENA $2E-$7E-1 BIASED PERIOD FILL CHARACTER 00390VDC21 INA $7E+1 UNBIAS DISPLAYABLE CHARACTER 00400 ALS 8 00410 EOR* TEMP BOTH CHARACTERS 0042000 LDQ* SAVEQ RESTORE Q 00430 RAO* VDC 00440 JMP* (VDC) RETURN 00450 SPC 2 00460 END 00470_ 00 00 00 00 00 00 00 00 __ 0(wl iTAVLTOI LIBRARY P999999060381(0 NAM VLTOI DECK-ID B61 ITOS 1.2 SUMMARY-126 00010* UTILITY INTEGER CONVERSION ROUTINE 00020* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00030* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00040* COPYRIGHT CONTROL DATA CORPORATION 1977 00050* 00060* *****************************************'***** 0007000* * * 00080* * ROUTINE TO CONVERT VALUE TO INTEGER * 00090* * * 00100* *********'************************************* 00110* 00120* 00130****** CALLING SEQUENCE : 0014000* 00150* RTJ VLTOI 00160* ADC DATBUF 6-WORD ARRAY WITH WORD 1 AS VALUE AND 00170* LAST 5 WORDS FOR ASCII INTEGERS 00180* 00190* CALL VLTOI(DATBUF) (FORTRAN SEQUENCE) 00200* 0021000* 00220****** ROUTINE FUNCTION : 00230* 00240* THIS ROUTINE CONVERTS AN UNSIGN VALUE TO 5 ASCII 00250* INTEGER AND RIGHT JUSTIFIED WITH NULL FILLED LEFT 00260* PORTION. LEADING ZERO IS SPACE FILLED. 00270* 0028000* 00290* 00300 SPC 3 00310* 00320****** *** E N T R Y N A M E 00330* 00340 SPC 1 0035000 ENT VLTOI ENTRY NAME 00360 SPC 2 00370* 00380****** *** E Q U I V A L E N C E S 00390* 00400 SPC 1 00410LPMSK EQU LPMSK(2) BIT MASK 0042000ZERO EQU ZERO(2) CONSTANT ZERO 00430 SPC 1 00440* SYSTEM DEPENDENT VARIABLE 00450 SPC 1 00460MAXDIG EQU MAXDIG(5) MAX. NO. OF DIGITS TO BE CONVERTED 00470 SPC 5 00480* 0049000****** ***** P R O G R A M S T A R T ***** 00500* 00510 SPC 3 00520VLTOI NOP 0 ENTRY 00530 STQ* QSAVE SAVE Q-REGISTER 00540 LDA- I I 00550 STA* ISAVE 0056000 SPC 1 00570* GET PARAMETER 00580 SPC 1 00590 LDA* (VLTOI) GET PARAMETER ADDRESS 00600 STA- I 00610 STA* PARADD 00620 LDA- (ZERO),I GET VALUE TO BE CONVERTED 0063000 STA* VALUE 00640* 00650 CLR A 00660 STA* INDEX 00670 STA* LEDZRO 00680 SPC 1 00690* REPEAT DIVIDE VALUE BY 10**I 0070000 SPC 1 00710REPEAT LDA* INDEX GET CHARACTER INDEX 00720 STA- I 00730 CLR Q 00740 LDA* VALUE CONVERT VALUE BY DIVIDING TO TEN POWER 00750 DVI* POWER,I 00760 STQ* VALUE 0077000* 00780 LDQ* LEDZRO GET LEADING ZERO FLAG 00790 SAZ CHARO 00800 RAO* LEDZRO SET NON-LEADING ZERO FOR VALUE OTHER THAN 0 00810ASMASC INA $30 CONVERT AS ASCII 00820* 00830 LDQ* INDEX BUMP INDEX AND SAVE CHARACTER 0084000 INQ 1 00850 STA* (PARADD),Q 00860 STQ* INDEX 00870 INQ -MAXDIG CHECK IF DONE 00880 SQZ DONASM YES, SKIP (DONE) 00890 JMP* REPEAT NO, REPEAT 00900 SPC 1 0091000* CHARACTER IS ZERO, CHECK IF LEADING ZERO 00920* IF SO IGNORE IT AND REPLACE WITH SPACE 00930 SPC 1 00940CHARO SQN TOASM 00950 ENA $20-$30 00960TOASM JMP* ASMASC 00970 SPC 2 0098000* DONE CONVERSION 00990* CHECK IF ALL ZERO, IF SO, SET ONE ZERO 01000 SPC 1 01010DONASM LDQ* LEDZRO CHECK IF ANY VALUE (NON-ZERO) 01020 SQN RESTR YES, SKIP 01030 ENQ MAXDIG 01040 ENA $30 SAVE ZERO 0105000 STA* (PARADD),Q 01060 SPC 1 01070* 01080RESTR LDQ* QSAVE RESTORE Q-REGISTER 01090 LDA* ISAVE I 01100 STA- I 01110 RAO* VLTOI SET EXIT 0112000 JMP* (VLTOI) RETURN TO CALLER 01130 SPC 3 01140* CONSTANTS AND STORAGES 01150 SPC 1 01160POWER NUM 10000,1000,100,10,1 01170VALUE NUM 0 01180QSAVE NUM 0 Q-REGISTER 0119000ISAVE NUM 0 I 01200PARADD NUM 0 PARAMETER ADDRESS 01210LEDZRO NUM 0 LEADING ZERO FLAG (NON-ZERO FOR NON-ZERO) 01220INDEX NUM 0 CHARACTER STORAGE INDEX 01230 END 01240_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( yG  NTAWTRD LIBRARY P999999060381(0 NAM WTRD WTREAD INTERFACE 00010 SPC 1 00020* COPYRIGHT CONTROL DATA CORPORATION 06/02/80 (CGODSO) 00030 SPC 4 00040*** WTRD WTREAD INTERFACE 00050* 00060* WTRD IS AN INTERFACE TO WTREAD. WTRD WAS DESIGNED TO BE A USEFUL 0007000* AND FLEXIBLE TOOL TO HANDLE THE MUNDANE TASKS OF TERMINAL I/O. 00080 SPC 4 00090 ENT CLRSCR CALL CLRSCR 00100 ENT DISPLA CALL DISPLA(TXT,TSIZ) 00110 ENT ERROR CALL ERROR(TXT,TSIZ,POS) 00120 ENT LMARGN CALL LMARGN(N) 00130 ENT NCHAR NC=NCAHR(NC) 0014000 ENT OPMSG CALL OPMSG(TXT,TSIZ) 00150 ENT PAUSE CALL PAUSE 00160 ENT POSITN IZ=POSITN(IX,IY) 00170 ENT PROMPT TC=PROMPT(TXT,TSIZ,RESP,RSIZ,POS) 00180 ENT TERMC TC=TERMC(TC) 00190 ENT WHERE IY=WHERE(IX,IY) 00200* 0021000 EXT PGMIN 00220 EXT WTREAD 00230* 00240LPMASK EQU LPMASK(2) 00250NZERO EQU NZERO($12) 00260CR EQU CR(2) 00270RUBOUT EQU RUBOUT(4) 0028000LASTX EQU LASTX(79) LAST POSSIBLE X COORDINATE ON DISPLAY 00290LASTY EQU LASTY(23) LAST POSSIBLE Y COORDINATE ON DISPLAY 00300 EJT 00310*** CLRSCR CLEAR SCREEN 00320* 00330* CLRSCR BLANKS THE TERMINAL SCREEN AND REINITIALIZES THE 00340* ENVIRONMENT FOR WTRD. 0035000* 00360* CALLING SEQUENCE: 00370* 00380* CALL CLRSCR 00390 SPC 2 00400CLRSCR NUM 0 ENTRY 00410 LDA* CLRSCR 0042000 RTJ PRS PRESET 00430 ENA 0 00440 STA XP RESET X-COORD 00450 STA YP RESET Y-COORD 00460 ENA -1 00470 STA XYP CLEAR FORCED POSITIONING 00480 RTJ WTREAD ISSUE SCREEN CLEAR 0049000 ADC LU 00500 ADC AZERO 00510 ADC A2018 00520 ADC A2 00530 ADC AM1 00540 ADC AZERO 00550 ADC AZERO 0056000 ADC TC 00570 SPC 1 00580 JMP EXIT RETURN 00590 EJT 00600** CLRERR CLEAR ERROR MESSAGE 00610* 00620* CLEAR ERROR MESSAGE IF ON DISPLAY. 0063000 SPC 2 00640CLRERR NUM 0 ENTRY 00650 LDA ERRFLG 00660 SAM CLR1 IF NO ERROR MESSAGE ON DISPLAY 00670 RTJ WTREAD ISSUE LINE CLEAR 00680 ADC LU 00690 ADC ERRFLG 0070000 ADC A1600 00710 ADC A1 00720 ADC AM1 00730 ADC AZERO 00740 ADC AZERO 00750 ADC TC 00760 SPC 1 0077000 ENA -1 00780 STA ERRFLG CLEAR ERROR MESSAGE FLAG 00790CLR1 JMP* (CLRERR) RETURN 00800 EJT 00810*** DISPLA DISPLAY LINE 00820* 00830* DISPLAY TEXT AT THE NEXT AVAILABLE LINE OF THE TERMINAL. 0084000* 00850* CALLING SEQUENCE: 00860* 00870* CALL DISPLA(TXT,TSIZ) 00880* 00890* TXT CHARACTER STRING TO DISPLAY 00900* TSIZ NUMBER OF CHARACTERS TO DISPLAY 0091000 SPC 2 00920DISPLA NUM 0 ENTRY 00930 LDA* DISPLA 00940 RTJ PRS PRESET 00950 ENQ 2 00960 RTJ* GTPARM GET 2 PARAMETERS 00970 RTJ NXTLIN DETERMINE DISPLAY COORDINATES 0098000 LDA P1 00990 STA* DSP1 01000 LDA P2 01010 STA* DSP1+1 01020 RTJ WTREAD WRITE TEXT 01030 ADC LU 01040 ADC XY1 0105000DSP1 NUM 0 01060 NUM 0 01070 ADC AM1 01080 ADC AZERO 01090 ADC AZERO 01100 ADC TC 01110 SPC 1 0112000 JMP EXIT RETURN 01130 EJT 01140*** ERROR ERROR DISPLAY 01150* 01160* DISPLAY AN ERROR MESSAGE AT THE SELECTED SCREEN LOCATION. 01170* 01180* CALLING SEQUENCE: 0119000* 01200* CALL ERROR(TXT,TSIZ,POS) 01210* 01220* TXT TEXT TO DISPLAY 01230* TSIZ NUMBER OF CHARACTEERS TO DISPLAY 01240* POS POSITIONING INFORMATION 01250* <0, IF MESSAGE GOES TO NEXT LINE 0126000* >=0, IF MESSAGE GOES TO THE LAST LINE 01270* DISPLAYED, BUT AT THE SPECIFIED 01280* X COORDINATE 01290 SPC 2 01300ERROR NUM 0 ENTRY 01310 LDA* ERROR 01320 RTJ PRS PRESET 0133000 ENQ 3 01340 RTJ* GTPARM GET 3 PARAMETERS 01350 LDA* (P3) 01360 SAM ERR1 IF NO SPECIAL PROCESSING 01370 ALS 8 01380 ADD XY1 01390 STA ERRFLG 0140000 JMP* ERR2 01410 SPC 1 01420ERR1 LDA XP 01430 ALS 8 01440 ADD YP 01450 STA ERRFLG 01460 SPC 1 0147000ERR2 LDA* P1 01480 STA* ERR3 01490 LDA* P2 01500 STA* ERR3+1 01510 RTJ WTREAD 01520 ADC LU 01530 ADC ERRFLG 0154000ERR3 NUM 0 01550 NUM 0 01560 ADC AM1 01570 ADC AZERO 01580 ADC AZERO 01590 ADC TC 01600 SPC 1 0161000 JMP EXIT RETURN 01620 EJT 01630** GTPARM GET PARAMETERS 01640* 01650* GET THE ADDRESSES OF THE SPECIFIED NUMBER OF PARAMETERS AND 01660* ADJUST THE RETURN ADDRESS ACCORDINGLY. 01670* 0168000* ENTRY Q - NUMBER OF PARAMETERS EXPECTED 01690* EXIT ADDRESSES IN LOCATIONS P1 THROUGH P5 01700 SPC 2 01710GTPARM NUM 0 ENTRY 01720 INQ -1 ADJUST TO COUNT 0 TO N-1 01730 LDA =XP1 01740 STA* P0 SAVE ADDRESS OF NEXT PARAMETER 0175000GT1 LDA (XADR) NEXT PARAMETER ADDRESS 01760 RAO XADR 01770 STA* (P0) SAVE PARAMETER ADDRESS 01780 RAO* P0 01790 DQP *-GT1 LOOP FOR ALL PARAMETERS 01800 JMP* (GTPARM) RETURN 01810 SPC 2 0182000** PARAMETER STORAGE 01830 SPC 1 01840P0 NUM 0 TEMP FOR GTPARM 01850 SPC 1 01860P1 NUM 0 ADDRESS OF PARAMETER 1 01870P2 NUM 0 ADDRESS OF PARAMETER 2 01880P3 NUM 0 ADDRESS OF PARAMETER 3 0189000P4 NUM 0 ADDRESS OF PARAMETER 4 01900P5 NUM 0 ADDRESS OF PARAMETER 5 01910 EJT 01920*** LMARGN LEFT MARGIN 01930* 01940* SET THE DEFAULT LEFT MARGIN ( NUMBER OF SPACES BEFORE THE FIRST 01950* CHARACTER OF DISPLAY TEXT ). THE INITIAL LEFT MARGIN IS ZERO. 0196000* 01970* CALLING SEQUENCE: 01980* 01990* CALL LMARGN(N) 02000* 02010* N NUMBER OF SPACES TO PRECEED THE FIRST 02020* DISPLAYED CHARACTER ON SUBSEQUENT CALLS 0203000* TO DISPLA, ERROR, AND PROMPT 02040* 0 .LE. P1 .LT. LASTX 02050 SPC 2 02060LMARGN NUM 0 ENTRY 02070 LDA* LMARGN 02080 RTJ PRS PRESET 02090 ENQ 1 0210000 RTJ* GTPARM GET THE PARAMETER 02110 LDA* (P1) 02120 SAP LM1 INSURE NON-NEGATIVE 02130 ENA 0 02140LM1 INA -LASTX 02150 SAM LM2 INSURE AT MOST RIGHT EDGE OF SCREEN 02160 ENA 0 0217000LM2 INA LASTX 02180 STA XP 02190 JMP EXIT RETURN 02200 EJT 02210*** NCHAR NUMBER OF CHARACTERS 02220* 02230* NCHAR RETURNS THE NUMBER OF CHARACTERS ENTERED ON THE LAST 0224000* RESPONSE TO A PROMPT. 02250* 02260* CALLING SEQUENCE: 02270* 02280* NC=NCHAR(NC) 02290* 02300* NC NUMBER OF CHARACTERS ENTERED 0231000 SPC 2 02320NCHAR NUM 0 ENTRY 02330 LDA* NCHAR 02340 RTJ PRS PRESET 02350 ENQ 1 02360 RTJ GTPARM GET 1 PARAMETER 02370 LDA CHRCNT SET RETURN VALUES 0238000 STA* (P1) 02390 STA RETVAL 02400 JMP EXIT RETURN 02410 EJT 02420** NXTLIN SET NEXT LINE 02430* 02440* DETERMINE COORDINATES FOR NEXT LINE, PAUSING IF SCREEN FULL. 0245000 SPC 2 02460NXTLIN NUM 0 ENTRY 02470 LDA ERRFLG 02480 SAM 1 02490 JMP* (NXTLIN) 02500 SPC 1 02510 LDA XYP 0252000 SAM NXT1 IF NO FORCED POSITIONING 02530 STA XY1 USE AS REQUESTED 02540 ENA -1 02550 STA XYP CLEAR FORCED POSITIONING 02560 JMP* (NXTLIN) RETURN 02570 SPC 1 02580NXT1 LDA XP USE SPECIFIED LEFT MARGIN 0259000 ALS 8 02600 ADD YP 02610 STA XY1 02620 LDA YP 02630 INA 1 02640 STA YP 02650 INA -LASTY 0266000 SAP 1 02670 JMP* NXT2 IF SCREEN NOT FULL 02680 ENA 0 02690 STA YP RESET Y COORDINATE 02700 RTJ WTREAD 02710 ADC LU 02720 ADC A0017 0273000 ADC PMSG 02740 ADC A6 02750 ADC A0617 02760 ADC RESP 02770 ADC A1 02780 ADC TC 02790 RTJ WTREAD 0280000 ADC LU 02810 ADC AM1 02820 ADC A2018 02830 ADC A2 02840 ADC AM1 02850 ADC AZERO 02860 ADC AZERO 0287000 ADC TC 02880 SPC 1 02890 JMP* NXT1 RETRY 02900 SPC 1 02910NXT2 JMP* (NXTLIN) RETURN 02920 EJT 02930*** OPMSG SEND MESSAGE TO MASTER CONSOLE 0294000* 02950* WRITE THE REQUESTED TEXT TO THE MASTER CONSOLE FOR THE 02960* OPERATOR TO READ. 02970* 02980* CALLING SEQUENCE: 02990* 03000* CALL OPMSG(TXT,TSIZ) 0301000* 03020* TXT CHARACTER STRING TO DISPLAY 03030* TSIZ NUMBER OF CHARACTERS TO DISPLAY 03040 SPC 2 03050OPMSG NUM 0 ENTRY 03060 LDA* OPMSG 03070 RTJ PRS PRESET 0308000 ENQ 2 03090 RTJ* GTPARM GET 2 PARAMETERS 03100 LDA* P1 BIAS DOWN TEXT ADDRESS 03110 INA -1 03120 STA* P1 03130 LDQ* (P2) 03140 INQ 2 ADD 2 TO CHARACTER COUNT FOR CR/LF 0315000 STQ* P2 03160 INQ -1 BIAS DOWN BY 2 AND ADD 1 FOR ROUNDING 03170 QRS 1 CHARACTER COUNT TO WORD COUNT 03180 SQP OP1 03190 JMP EXIT IF REALY NOTHING TO BE DONE 03200 SPC 1 03210OP1 LDA A0D0A INSERT CR/LF 0322000 STA LINE 03230 SPC 1 03240OP2 LDA* (P1),Q COPY TEXT 03250 STA LINE,Q 03260 DQP *-OP2 03270 RTJ WTREAD 03280 ADC A4 0329000 ADC AM1 03300 ADC LINE 03310 ADC P2 03320 ADC AM1 03330 ADC AZERO 03340 ADC AZERO 03350 ADC TC 0336000 SPC 1 03370 JMP EXIT RETURN 03380 EJT 03390*** PAUSE WAIT FOR INPUT BEFORE PROCEEDING 03400* 03410* PAUSE ISSUES THE MESSAGE *PAUSE* IN THE LOWER LEFT HAND CORNER 03420* OF THE SCREEN AND WAITS FOR A TERMINATION CHARACTER BEFORE 0343000* RETURNING. NO INPUT IS ACCEPTED. 03440* 03450* CALLING SEQUENCE: 03460* 03470* CALL PAUSE 03480 SPC 2 03490PAUSE NUM 0 ENTRY 0350000 LDA* PAUSE 03510 RTJ PRS PRESET 03520 RTJ WTREAD 03530 ADC LU 03540 ADC A0017 03550 ADC PMSG 03560 ADC A6 0357000 ADC A0617 03580 ADC RESP 03590 ADC A1 03600 ADC TC 03610 SPC 1 03620 JMP EXIT RETURN 03630 EJT 0364000*** POSITN SET CURSOR POSITION 03650* 03660* SET A NEW CURSOR POSITION FOR THE NEXT CALL TO ERROR, DISPLA, 03670* AND PROMPT (UNLESS CLRSCR IS CALLED). 03680* 03690* CALLING SEQUENCE: 03700* 0371000* IZ=POSITN(IX,IY) 03720* 03730* IX NEW X POSITION ( 0 .LE. X .LE. LASTX ) 03740* IY NEW Y POSITION ( 0 .LE. Y .LE. LASTY ) 03750* IZ OLD Y POSITION 03760 SPC 2 03770POSITN NUM 0 ENTRY 0378000 LDA* POSITN 03790 RTJ PRS PRESET 03800 ENQ 2 03810 RTJ GTPARM GET 2 PARAMETERS 03820 LDA (P1) 03830 SAP PN1 INSURE NON-NEGATIVE 03840 ENA 0 0385000PN1 INA -LASTX 03860 SAM PN2 INSURE AT MOST RIGHT HAND EDGE OF SCREEN 03870 ENA 0 03880PN2 INA LASTX 03890 ALS 8 POSITION FO COMBINATION 03900 STA XYP SAVE FOR USE 03910 LDA (P2) 0392000 SAP PN3 INSURE NON-NEGATIVE 03930 ENA 0 03940PN3 INA -LASTY 03950 SAM PN4 INSURE AT MOST BOTTOM EDGE OF SCREEN 03960 ENA 0 03970PN4 INA LASTY 03980 ADD XYP COMBINE TO FORM COORDINATE 0399000 STA XYP 04000 LDA YP 04010 STA RETVAL ESTABLISH FUNCTION VALUE 04020 JMP EXIT RETURN 04030 EJT 04040*** PROMPT SOLICIT RESPONCE FROM TERMINAL 04050* 0406000* PROMPT ISSUES A MESSAGE TO THE TERMINAL AND AWAITS A RESPONCE. 04070* 04080* *NOTE* THERE IS A DEFAULT VALUE FOR THE INPUT. 04090* 04100* CALLING SEQUENCE: 04110* 04120* TC=PROMPT(TXT,TSIZ,RESP,RSIZ,POS) 0413000* 04140* TXT CHARACTER STRING TO QUERY WITH 04150* TSIZ NUMBER OF CHARACTERS IN QUERY 04160* RESP RESPONSE AREA 04170* RSIZ MAXIMUM SIZE OF RESPONSE 04180* POS RESPONSE POSITIONING INFORMATION 04190* TC TERMINATION CHARACTER ON INPUT [WTREAD] 0420000* 04210* ON ENTRY, RESP SHOULD CONTAIN THE DEFAULT RESPONSE. IF THE INPUT 04220* STRING IS NULL AND THE TERMINATION CHARACTER IS (CR), THEN THIS 04230* STRING WILL BE DISPLAYED IN THE RESPONSE AREA. IF THE INPUT 04240* STRING IS NOT NULL OR IF THE TERMINATION IS NEITHER (CR) OR 04250* (RUBOUT), THEN UPON RETURNING RESP WILL CONTAIN THE INPUT STRING 04260* LEFT JUSTIFIED AND BLANK FILLED WITH THE CHARACTER COUNT OF THE 0427000* INPUT IN RESP( (RSIZ+1)/2 + 1 ) [SEE WTREAD]. 04280 SPC 2 04290PROMPT NUM 0 ENTRY 04300 LDA* PROMPT 04310 RTJ PRS PRESET 04320 ENQ 5 04330 RTJ GTPARM GET 5 PARAMETERS 0434000 RTJ NXTLIN 04350 LDA P1 PATCH WTREAD CALL 04360 STA* PMT3 04370 LDA P2 04380 STA* PMT3+1 04390 LDA P4 04400 STA* PMT3+4 0441000 LDA XY1 RESPONSE COORDINATES 04420 AND- LPMASK+8 04430 ALS 8 04440 ADD XP 04450 ADD (P5) 04460 ALS 8 04470 STA XY2 0448000PMT1 ENQ 39 04490 LDA =X$2020 04500PMT2 STA RESP,Q 04510 DQP *-PMT2 04520 RTJ WTREAD 04530 ADC LU 04540 ADC XY1 0455000PMT3 NUM 0 04560 NUM 0 04570 ADC XY2 04580 ADC RESP 04590 NUM 0 04600 ADC TC 04610 SPC 1 0462000 LDA TC 04630 STA TERMCH 04640 STA RETVAL 04650 INA -RUBOUT 04660 SAN PMT4 04670 RTJ WTREAD 04680 ADC LU 0469000 ADC XY1 04700 ADC A1600 04710 ADC A1 04720 ADC AM1 04730 ADC AZERO 04740 ADC AZERO 04750 ADC TC 0476000 SPC 1 04770 JMP* PMT1 04780 SPC 1 04790PMT4 LDQ (P4) CHECK CHARACTER COUNT 04800 INQ 1 04810 QRS 1 04820 LDA RESP,Q 0483000 STA CHRCNT 04840 SAZ 1 04850 JMP* PMT6 04860 LDA TERMCH 04870 INA -CR 04880 SAZ 1 04890 JMP* PMT6 0490000 LDA P3 04910 STA PMT5 04920 LDA P4 04930 STA PMT5+1 04940 RTJ WTREAD 04950 ADC LU 04960 ADC XY2 0497000PMT5 NUM 0 04980 NUM 0 04990 ADC AM1 05000 ADC AZERO 05010 ADC AZERO 05020 ADC TC 05030 SPC 1 0504000 RTJ CLRERR 05050 JMP EXIT RETURN 05060 SPC 1 05070PMT6 LDQ (P4) 05080 QRS 1 05090 INQ -1 05100 SQM PMT75 0511000PMT7 LDA RESP,Q 05120 STA (P3),Q 05130 DQP *-PMT7 05140PMT75 LDQ (P4) 05150 QLS 15 05160 SQM PMT8 05170 RTJ CLRERR 0518000 JMP EXIT 05190 SPC 1 05200PMT8 QLS 1 05210 INQ -1 05220 QRS 1 05230 LDA RESP,Q 05240 AND NZERO+8 0525000 STA RESP,Q 05260 LDA (P3),Q 05270 AND LPMASK+8 05280 EOR RESP,Q 05290 STA (P3),Q 05300 RTJ CLRERR 05310 JMP EXIT 0532000 EJT 05330** PRS PRESET WTRD 05340* 05350* PRS ESTABLISHES THE LOGICAL UNIT AND MODE FOR CONVERSATION, 05360* SAVES THE Q AND I REGISTER CONTENTS, AND SETS THE CALLING ADDRES 05370* FOR EXIT AND GTPARM. 05380* 0539000* ENTRY A - ENTRY POINT CONTENTS 05400 SPC 2 05410PRS NUM 0 ENTRY 05420 STA* XADR SAVE RETURN ADDRESS 05430 STQ* SAVEQ SAVE Q-REG 05440 LDQ- I 05450 STQ* SAVEI SAVE I-REG 0546000 LDA* FCF 05470 SAZ PRS1 IF FIRST CALL 05480 JMP* (PRS) 05490 SPC 1 05500PRS1 RTJ PGMIN GET MODE AND UNIT 05510 ADC USER 05520 ADC LU 0553000 ADC MODE 05540 ADC NOPORT 05550 SPC 1 05560 ENA 1 05570 STA* FCF 05580 JMP* (PRS) 05590 SPC 2 0560000FCF NUM 0 FIRST CALL FLAG 05610SAVEI NUM 0 I SAVE AREA 05620SAVEQ NUM 0 Q SAVE AREA 05630 SPC 4 05640** EXIT RETURN FROM WTRD 05650* 05660* EXIT RESTORES THE Q AND I REGISTERS, MOVE A POSSIBLE FUNCTION 0567000* VALUE TO THE A REGISTER, AND RETURNS TO THE EXTERNAL WTRD CALLER. 05680 SPC 2 05690XADR NUM 0 05700EXIT LDQ* SAVEI 05710 STQ- I 05720 LDQ* SAVEQ 05730 LDA* RETVAL 0574000 JMP* (XADR) 05750 EJT 05760XP NUM 0 CURRENT X POSITION 05770YP NUM 0 CURRENT Y POSITION 05780XYP NUM -1 05790LU NUM 0 LOGICAL UNIT NUMBER 05800TC NUM 0 TERMINATION CODE 0581000RETVAL NUM 0 FUNCTION RETURN VALUE 05820ERRFLG NUM -1 ERROR MESSAGE DISPLAYED FLAG 05830AZERO NUM 0 05840AM1 NUM -1 05850A1 NUM 1 05860A2 NUM 2 05870A4 NUM 4 0588000A6 NUM 6 05890A0017 NUM $0017 05900A0617 NUM $0617 05910A1600 NUM $1600 05920A2018 NUM $2018 05930A0D0A NUM $0D0A 05940PMSG ALF 3,PAUSE PAUSE MESSAGE TEXT 0595000LINE BSS LINE(41) 05960RESP BSS RESP(42) 05970XY1 NUM 0 05980XY2 NUM 0 05990USER BSS USER(4) 06000MODE NUM 0 CONVERSATION MODE 06010NOPORT NUM 0 PORT NUMBER 0602000TERMCH NUM 0 06030TMP NUM 0 06040CHRCNT NUM 0 06050 EJT 06060*** TERMC TERMINATION CODE 06070* 06080* TERMC RETURNS THE TERMINATION CODE FROM THE LAST PROMPT RESPONSE. 0609000* 06100* CALLING SEQUENCE: 06110* 06120* TC=TERMC(TC) 06130* 06140* TC PREVIOUS TERMINATION CODE (RETURN VALUE) 06150 SPC 2 0616000TERMC NUM 0 ENTRY 06170 LDA* TERMC 06180 RTJ PRS PRESET 06190 ENQ 1 06200 RTJ GTPARM GET 1 PARAMETER 06210 LDA TERMCH SET RETURN VALUE 06220 STA (P1) 0623000 STA RETVAL 06240 JMP EXIT RETURN 06250 EJT 06260*** WHERE WHERE IS CURSOR 06270* 06280* WHERE RETURNS THE POSITION SELECTED FOR THE NEXT DISPLAY LINE. 06290* 0630000* CALLING SEQUENCE: 06310* 06320* IZ=WHERE(IX,IY) 06330* 06340* IX X COORDINATE 06350* IY Y COORDINATE 06360* IZ Y COORDINATE ( SAME VALUE AS IY ) 0637000 SPC 2 06380WHERE NUM 0 ENTRY 06390 LDA* WHERE 06400 RTJ PRS PRESET 06410 ENQ 2 06420 RTJ GTPARM GET 2 PARAMETERS 06430 LDA XYP 0644000 SAM WHR1 IF NO FORCED POSITIONING 06450 AND- LPMASK+8 STRIP OFF Y-PART 06460 STA (P2) 06470 STA RETVAL 06480 LDA XYP 06490 ALS 8 06500 AND- LPMASK+8 STRIP OFF X-PART 0651000 STA (P1) 06520 JMP EXIT RETURN 06530 SPC 1 06540WHR1 LDA XP 06550 STA (P1) SET X COORDINATE 06560 LDA YP 06570 STA (P2) SET Y COORDINATE 0658000 STA RETVAL 06590 JMP EXIT RETURN 06600 SPC 2 06610 END 06620_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(z TTFADD LIBRARY P999999060381(0 SUBROUTINE ADD 00010 + /CCS 2.0 $$USERID MANAGER DECK02 SUMMARY-*** 000202 00030C ADD - CREATE NEW ENTRIES ON THE FILE $$USERID. 00040C THE OPERATOR MAY MAKE ADDITIONS IN THE FOLLOWING FORMS: 00050C 1. 00060C A SINGLE TRIPLE COMPOSED OF USER IDENTIFIER, TERMINAL 0007000C PORT CODE, AND FORCED REQUEST; 00080C 2. 00090C A SET OPERATION WHICH PRODUCES TRIPLES WITH A SINGLE 00100C SPECIFIED USER IDENTIFIER, EACH KNOWN VALID TERMINAL 00110C PORT CODE, AND A SPECIFIED FORCED REQUEST; 00120C 3. <*,TX,PGM> 00130C A SET OPERATION WHICH PRODUCES TRIPLES WITH EACH 0014000C KNOWN USER IDENTIFIER, A SPECIFIED TERMINAL PORT CODE, 00150C AND A SPECIFIED FORCED REQUEST. 001602 00170C *NOTE* 00180C - (CR) WILL INDICATE A DEFAULT VALUE CONSISTING OF AN 00190C ALL BLANK FIELD; 00200C - ALL ADDITIONS ARE DISPLAYED TO THE TERMINAL. 0021000C - CHANGES ARE MADE IMMEDIATELY ( DIRECTLY TO THE FILE ). 002202 00230 INTEGER PMT0(13), PMT1(3), PMT2(4), PMT3(7), PMT4(10), PMT5(9) 00240 INTEGER MSGFUL(15), MSGUNQ(11) 00250 INTEGER PGM(5), FULL, UNQFLG, FULFLG 002601 00270 DATA PMT0 / ' ADD ' / 0028000 DATA PMT1 / 'ID(*):' / 00290 DATA PMT2 / 'PROGRAM:' / 00300 DATA PMT3 / 'TERMINAL CODE:' / 00310 DATA PMT4 / 'FILE FULL, COMPRESS?' / 00320 DATA PMT5 / 'TERMINAL CODE(*): ' / 00330 DATA MSGFUL / ' *FILE FULL AFTER COMPRESSION*' / 00340 DATA MSGUNQ / ' * NOT UNIQUE* ' / 0035000 DATA UNQFLG / $0010 / 00360 DATA FULFLG / $1000 / 00370$$WSUSRBLK 00380 100 CALL PROMPT(PMT0,-26,0,0) 00390 CALL PROMPT(2H ,2,0,0) 00400 CALL PROMPT(PMT2,8,PGM,8) 00410+ ; FORCED REQUEST 0042000 CALL PROMPT(PMT1,6,CURID,8) 00430+ ; ID(*) AFFECTED 00440 IF ( (CURID(1).EQ.2H* ) .AND. (CURID(5).EQ.1) ) GOTO 500 00450 DO 180 I=1,4 00460+ ; FILL IN USER INFORMATION 00470 USER(I)=CURID(I) 00480 USER(I+6)=PGM(I) 0049000 180 CONTINUE 00500 USER(6)=2H 005101 00520 200 CALL PROMPT(PMT5,17,TX,2) 00530+ ; TERMINAL PORT CODE (*) 00540 IF ( (TX(1).EQ.2H* ) .AND. (TX(2).EQ.1) ) GOTO 220 00550 IF ( TX(2).EQ.0 ) GOTO 600 00560001 00570C ADD 005801 00590 IF ( VALTID(TX(1)).EQ.0 ) GOTO 200 00600+ ; REPROMPT ON INVALID PORT CODE 00610 USER(5)=TX(1) 00620 CURID(5)=TX(1) 0063000 CALL WRITER(REQBLK,USER,CURID,ISTAT) 00640 IF ( AND(ISTAT,UNQFLG).EQ.UNQFLG ) GOTO 210 00650+ ; NOT UNIQUE 00660 IF ( AND(ISTAT,FULFLG).EQ.FULFLG ) GOTO 300 00670+ ; FILE IS FULL 00680 IF ( ISTAT.LT.0 ) CALL MSG(7) 00690 CALL MSG(0) 0070000 GOTO 200 007101 00720C THE SPECIFIED USER IDENTIFIER, TERMINAL PORT CODE PAIR IS NOT A 00730C UNIQUE KEY FOR THE FILE '$$USERID'. 007401 00750 210 CALL PROMPT(MSGUNQ,21,0,0) 00760 GOTO 200 00770001 00780C ADD BY LOOPING THROUGH 'TCODE' TO FORMAT ALL 00790C VALID ENTRIES. EXISTING ENTRIES ARE NOT EFFECTED. 008001 00810 220 NEXT=0 00820 CALL MSG(12) 00830 240 NEXT=NEXT+1 0084000 IF ( TCODE(NEXT).EQ.0 ) GOTO 600 00850+ ; IF PORT CODE LIST IS EXHAUSTED 00860 USER(5)=TCODE(NEXT) 00870 CURID(5)=TCODE(NEXT) 00880 CALL WRITER(REQBLK,USER,CURID,ISTAT) 00890 IF ( AND(ISTAT,UNQFLG).EQ.UNQFLG ) GOTO 240 00900+ ; NOT UNIQUE, IGNORE 0091000 IF ( AND(ISTAT,FULFLG).EQ.FULFLG ) GOTO 300 00920+ ; FILE IS FULL 00930 IF ( ISTAT.LT.0 ) CALL MSG(7) 00940 CALL MSG(0) 00950 GOTO 240 009601 00970C $$USERID IS FULL. 0098000C IF PERMISSION IS GRANTED, THEN ATTEMPT TO COMPRESS $$USERID. 00990C IF RECORD SPACE IS AVAILABLE AFTER COMPRESSION, THEN RESTART 01000C ( NOTE: <*,TX,PGM> MAY BE RESTARTED BECAUSE EXISTING ENTRIES FOR 01010C A GENERATED KEY ARE DETECTED ). 01020C IF NO RECORD SPACE IS GAINED, THE THIS ROUTINE WILL EXIT TO THE 01030C CALLER ( MENU SELECTION ) AFTER A MESSAGE AND PAUSE. 010401 0105000 300 CALL PROMPT(PMT4,20,TX,2) 01060+ ; COMPRESS VERIFICATION 01070 IF ( TX(1).NE.2HOK ) RETURN 01080 CALL SQUISH(FULL) 01090 IF ( FULL.EQ.0 ) GOTO 100 01100 CALL PROMPT(MSGFUL,30,0,0) 01110 CALL MSG(11) 0112000 RETURN 011301 01140C ADD <*,TX,PGM> BY SCANNING $$USERID FOR ACTIVE USER IDENTIFIERS. 011501 01160 500 CALL PROMPT(PMT3,14,TX,2) 01170+ ; TERMINAL PORT CODE 01180 IF ( TX(2).EQ.0 ) GOTO 600 0119000 IF ( VALTID(TX(1)).EQ.0 ) GOTO 500 01200+ ; REPROPMT - INVALID PORT CODE 01210 DO 520 I=1,4 01220 CURID(I)=0 01230 520 CONTINUE 01240 CURID(5)=2H00 01250 CALL MSG(12) 0126000 530 CALL READR(REQBLK,USER,CURID,ISTAT) 01270 IF ( AND(ISTAT,EOFLAG).EQ.EOFLAG ) GOTO 600 01280 IF ( ISTAT.LT.0 ) CALL MSG(3) 01290 DO 540 I=1,4 01300+ ; COPY IN USER INFORMATION 01310 CURID(I)=USER(I) 01320 USER(I+6)=PGM(I) 0133000 540 CONTINUE 01340 CURID(5)=TX(1) 01350 USER(5)=TX(1) 01360 USER(6)=2H 01370 CALL WRITER(REQBLK,USER,CURID,ISTAT) 01380 IF ( AND(ISTAT,UNQFLG).EQ.UNQFLG ) GOTO 560 01390+ ; NOT UNIQUE, IGNORE 0140000 IF ( AND(ISTAT,FULFLG).EQ.FULFLG ) GOTO 300 01410+ ; FILE IS FULL 01420 IF ( ISTAT.LT.0 ) CALL MSG(7) 01430 CALL MSG(0) 01440 560 CURID(5)=2H99 01450 GOTO 530 014601 0147000C PAUSE AND RESTART 014801 01490 600 IF ( CURID(5).EQ.0 ) RETURN 01500 CALL MSG(11) 01510 GOTO 100 015201 01530 END 0154000_ 00 00 00 00 00 00 __ 0(z TTFAINPUTLIBRARY P999999060381(0 SUBROUTINE AINPUT( IC, N ) 00010 INTEGER IC(1), BUFFER(41),CHAR 00020 DO 10 I = 1, N 0003010 IC(I) = $2020 00040 CALL WTREAD( 5, -1, 0, 0, -1, BUFFER, 80, ITC ) 00050 MPT = BUFFER(41) 00060 IF( MPT .LE. 0 ) RETURN 0007000 IF( MPT .GT. N ) MPT = N 00080 DO 20 I = 1, MPT 00090 IC(I) = CHAR( BUFFER, I ) * $100 + $20 00100 20 CONTINUE 00110 RETURN 00120 END 00130_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2w 2TFASCII LIBRARY P999999060381(0 SUBROUTINE ASCII(IN,OUT) 00010 + /ASCII TO HEX CONVERSION 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 05/01/80 (CGODSO) 000401 00050C ASCII - ASCII TO HEX CONVERSION ( CHEAP/DIRTY ) 000601 0007000C ASCII CONVERTS TWO WORDS OF ASCII CHARACTERS ( 0-9, A-F ) TO 00080C A SINGLE HEX INTEGER VALUE. 00090C 00100C IN - 2 WORD ARRAY OF 4 ASCII CHARACTERS ( 0-9, A-F ) 00110C OUT - 1 WORD CONVERSION TO HEX 00120C 00130C *NOTE* 0 IS RETURNED ON ERRONEOUS INPUT. 00140002 00150 INTEGER IN(2), OUT 001601 00170 INTEGER J, D(4), VALUE(23) 00180 DATA VALUE / 0,1,2,3,4,5,6,7,8,9,7*0,10,11,12,13,14,15 / 001902 00200 D(1)=ISHIFT(AND(IN(1),$FF00),8) 0021000+ ; EXTRACT SINGLE CHARACTERS 00220 D(2)=AND(IN(1),$00FF) 00230 D(3)=ISHIFT(AND(IN(2),$FF00),8) 00240 D(4)=AND(IN(2),$00FF) 002501 00260 OUT=0 00270 DO 100 I=1,4 0028000+ ; VERIFY 0 - 9 OR A - F 00290 IF ( D(I).LT.$0030 ) RETURN 00300 IF ( D(I).LT.$003A ) GOTO 100 00310 IF ( D(I).LT.$0041 ) RETURN 00320 IF ( D(I).GT.$0046 ) RETURN 00330 100 CONTINUE 003401 0035000 DO 200 I=1,4 00360+ ; ASSEMBLE RESULT VALUE 00370 J=D(I)-$0030+1 00380 OUT=ISHIFT(OUT,4)+VALUE(J) 00390 200 CONTINUE 00400 RETURN 004101 0042000 END 00430_ 00 __ 0({@ iTFBATS LIBRARY P999999060381(0 PROGRAM BATS 000102 00020C BATCH STATUS 000302 00040 INTEGER GET4, VDC 00050 INTEGER HSTAT, HOST(15), BSTAT, BATCH(15) 00060 DATA HOST / '$$HOST ', '$$ ', 'SYSVOL ', 0,8,0 / 0007000 DATA BATCH / '$$BATCH ', '$$ ', 'SYSVOL ', 0,480,0 / 00080 INTEGER HRECS(18,8), BRECS(32,480) 00090 INTEGER REQ(24), TEMP(7), USER(4) 00100 INTEGER LINE(40), MSG(5,9), EMPTY(8) 00110 DATA LINE / 40*$2020 / 00120 DATA MSG / 'NOT SENT ', 'BEING SENT', 'SENT ', 00130 + 'RECEIVED ', 'PRINT REQ ', ' ', 0014000 + 'ABORTED ', 'DISC PEND ', 'DISC--SENT' / 00150 DATA EMPTY / $0D0A, 'NO ACTIVE JOBS' / 001602 00170 CALL ZERO(REQ,24) 00180 CALL OPENFL(REQ,HOST,HSTAT) 00190 IF ( HSTAT.LT.0 ) GOTO 9000 00200 CALL GETS(REQ,HRECS,0,HSTAT) 0021000 IF ( HSTAT.LT.0 ) GOTO 9001 00220 CALL CLOSFL(REQ,HSTAT) 002301 00240 CALL ZERO(REQ,24) 00250 CALL OPENFL(REQ,BATCH,BSTAT) 00260 IF ( BSTAT.LT.0 ) GOTO 9002 00270 CALL GETS(REQ,BRECS,0,BSTAT) 0028000 IF ( BSTAT.LT.0 ) GOTO 9003 00290 CALL CLOSFL(REQ,BSTAT) 003001 00310 CALL PGMIN(USER,IDUMMY,IDUMMY,IDUMMY) 00320 JFLAG=0 00330 DO 299 IHOST=1,8 00340 IF ( HRECS(1,IHOST).EQ.2H ) GOTO 299 0035000 DO 199 JOB=1,60 00360 JSTAT=GET4(HRECS(4,IHOST),JOB) 00370 IF ( JSTAT.EQ.0 ) GOTO 199 00380 JFLAG=1 00390 N=(IHOST-1)*60+JOB 00400 CALL CCSMVA(2H J,1,2,LINE,1,80) 00410 CALL CCSCST(BRECS(7,N),1,8,USER,1,8,IFLAG) 0042000 IF ( IFLAG.NE.0 ) LINE(1)=$0E4A 00430 CALL DIG3( (IHOST-1)*100+JOB, TEMP ) 00440 CALL CCSMVA(TEMP,2,3,LINE,3,3) 00450 CALL CCSMVA(MSG(1,JSTAT),1,10,LINE,7,10) 00460 LINE(10)=VDC(BRECS(11,N)) 00470 LINE(11)=VDC(BRECS(12,N)) 00480 LINE(12)=VDC(BRECS(13,N)) 0049000 LINE(13)=VDC(BRECS(14,N)) 00500 IF ( JSTAT.EQ.6 ) GOTO 198 00510 IF ( JSTAT.GT.9 ) GOTO 198 00520 CALL DANDT(BRECS(15,N),TEMP) 00530 CALL CCSMVA(TEMP,1,13,LINE,28,13) 00540 IF ( JSTAT.EQ.1 ) GOTO 198 00550 CALL DANDT(BRECS(21,N),TEMP) 0056000 CALL CCSMVA(TEMP,1,13,LINE,42,13) 00570 IF ( (JSTAT.NE.4) .AND. (JSTAT.NE.5 ) ) GOTO 198 00580 CALL DANDT(BRECS(27,N),TEMP) 00590 CALL CCSMVA(TEMP,1,13,LINE,56,13) 00600 CALL TIMDIF(BRECS(24,N),BRECS(30,N),TEMP) 00610 CALL CCSMVA(TEMP,1,7,LINE,71,7) 00620 198 CALL DSP(LINE) 0063000 199 CONTINUE 00640 299 CONTINUE 00650 IF ( JFLAG.EQ.0 ) CALL WTREAD(5,-1,EMPTY,16,-1,0,0,ITC) 00660 CALL PGMOUT 006701 00680 9000 CALL SYSMSG(19,HSTAT) 00690 CALL PGMOUT 0070000 9001 CALL SYSMSG(21,HSTAT) 00710 CALL PGMOUT 00720 9002 CALL SYSMSG(19,BSTAT) 00730 CALL PGMOUT 00740 9003 CALL SYSMSG(21,BSTAT) 00750 CALL PGMOUT 007601 0077000 END 00780 INTEGER FUNCTION GET4(STR,N4) 007901 00800 INTEGER STR(1), N4 008101 00820 NBYTE=(N4+1)/2 00830 CALL CCSGET(STR,NBYTE,ICH) 0084000 GET4=AND(ICH,$0F) 00850 IF ( 2*NBYTE.NE.N4 ) GET4=ICH/$0010 00860 RETURN 008701 00880 END 00890 SUBROUTINE DSP(LINE) 009001 0091000 INTEGER LINE(40) 009201 00930 INTEGER TTL1(9), TTL2(40), PAUSE(4) 00940 DATA TTL1 / $2018, 'BATCH STATUS', 2*$0D0A / 00950 DATA TTL2 / ' JOB STATUS FILE REQUESTED ', 00960 + ' SENT RECEIVED TIME USED ' / 00970 DATA PAUSE / $0D0A, 'PAUSE ' / 0098000 INTEGER LNR, IANS(2) 00990 DATA LNR / 0 / 010001 01010 IF ( LNR.LT.22 ) GOTO 100 01020 CALL WTREAD(5,-1,PAUSE,8,-1,IANS,1,ITC) 01030 LNR=0 010401 0105000 100 IF ( LNR.GT.0 ) GOTO 200 01060 CALL WTREAD(5,-1,TTL1,18,-1,0,0,ITC) 01070 CALL WTREAD(5,-1,TTL2,80,-1,0,0,ITC) 01080 LNR=3 010901 01100 200 LNR=LNR+1 01110 CALL WTREAD(5,-1,LINE,LASTCH(LINE,80),-1,0,0,ITC) 0112000 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 01130 RETURN 011401 01150 END 01160 SUBROUTINE DANDT(IN,OUT) 011701 01180 INTEGER IN(6), OUT(7) 01190001 01200 INTEGER TMPLT(7) 01210 DATA TMPLT / 'MM/DD/YY HHMM ' / 012201 01230 TMPLT(1)=IN(2) 01240 CALL CCSMVA(IN,1,2,TMPLT,4,2) 01250 TMPLT(4)=IN(3) 0126000 CALL CCSMVA(IN(4),1,4,TMPLT,10,4) 01270 DO 100 I=10,13 01280 CALL CCSGET(TMPLT,I,ICH) 01290 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,TMPLT) 01300 100 CONTINUE 01310 CALL CCSMVA(TMPLT,1,13,OUT,1,13) 01320 RETURN 01330001 01340 END 01350 SUBROUTINE DIG3(IN,OUT) 013601 01370 INTEGER IN(1), OUT(2) 01380 INTEGER TMP(3) 013901 0140000 CALL HEXDEC(IN,TMP) 01410 DO 100 I=1,4 01420 CALL CCSGET(TMP(2),I,ICH) 01430 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,TMP(2)) 01440 100 CONTINUE 01450 OUT(1)=TMP(2) 01460 OUT(2)=TMP(3) 0147000 RETURN 014801 01490 END 01500 SUBROUTINE TIMDIF(TRAN,RECV,DIF) 015101 01520 INTEGER TRAN(3), RECV(3), DIF(4) 015301 0154000 INTEGER H1,H2,H3, M1,M2,M3, S1,S2,S3 01550 INTEGER T, C 015601 01570 T(JCH)=(JCH/$0100-1R0)*10+AND(JCH-1R0,$00FF) 01580 C(NUM)=(NUM/10+1R0)*$0100+MOD(NUM,10)+1R0 015901 01600 DO 100 I=1,6 0161000 CALL CCSGET(TRAN,I,ICH) 01620 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,TRAN) 01630 CALL CCSGET(RECV,I,ICH) 01640 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,RECV) 01650 100 CONTINUE 016601 01670 H1=T(TRAN(1)) 0168000 M1=T(TRAN(2)) 01690 S1=T(TRAN(3)) 017001 01710 H2=T(RECV(1)) 01720 M2=T(RECV(2)) 01730 S2=T(RECV(3)) 017401 0175000 ITIME=H1*60+M1 01760 JTIME=H2*60+M2 01770 IF ( ITIME.LT.JTIME ) GOTO 200 01780 IF ( (S1.LT.S2) .AND. (ITIME.EQ.JTIME) ) GOTO 200 01790 H2=H2+24 018001 01810 200 S3=S2-S1 0182000 IF ( S3.GE.0 ) GOTO 220 01830 S3=S3+60 01840 M2=M2-1 018501 01860 220 M3=M2-M1 01870 IF ( M3.GE.0 ) GOTO 240 01880 M3=M3+60 0189000 H2=H2-1 019001 01910 240 H3=H2-H1 019201 01930 DIF(1)=C(H3) 01940 DIF(2)=C(M3) 01950 DIF(3)=1H: 0196000 CALL CCSMVA(C(S3),1,2,DIF,6,2) 01970 RETURN 019801 01990 END 02000_ 00 00 00 00 00 00 00 __ 0({ iTFBATSUMLIBRARY P*999999060381(0 PROGRAM BATSUM 000102 00020C BATCH STATUS SUMMARY 000302 00040 INTEGER GET4, VDC 00050 INTEGER HSTAT, HOST(15) 00060 DATA HOST / '$$HOST ', '$$ ', 'SYSVOL ', 0,8,0 / 0007000 INTEGER HRECS(18,8) 00080 INTEGER REQ(24), TEMP(7) 00090 DATA REQ / 24*0 / 00100 INTEGER COUNTS(16), INACT, QUEUED, SENT, RECD, PRINT, ABORT 00110 INTEGER TITLE(29), LINE(29), TYPES(3,3) 00120 DATA TITLE / $2018, 00130 + 'NAME LU TYPE INACT QUEUED SENT RECD PRINT ABORT' / 0014000 DATA LINE / $0D0A, 28*$2020 / 00150 DATA TYPES / 'LOCL ', '200UT ', 'HASP ' / 001602 00170 CALL OPENFL(REQ,HOST,HSTAT) 00180 IF ( HSTAT.LT.0 ) GOTO 9000 00190 CALL GETS(REQ,HRECS,0,HSTAT) 00200 IF ( HSTAT.LT.0 ) GOTO 9001 0021000 CALL CLOSFL(REQ,HSTAT) 002201 00230 CALL WTREAD(5,-1,TITLE,58,-1,0,0,ITC) 00240 DO 299 IHOST=1,8 00250 CALL ZERO(COUNTS,16) 00260 DO 199 JOB=1,60 00270 N=GET4(HRECS(4,IHOST),JOB) 0028000 COUNTS(N+1)=COUNTS(N+1)+1 00290 199 CONTINUE 00300 CALL CCSBLK(LINE(2),56) 00310 CALL CCSMVA(HRECS(1,IHOST),1,4,LINE(2),1,4) 00320 CALL C2D(AND(HRECS(3,IHOST),$00FF),LINE(5)) 00330 ITYPE=AND(HRECS(3,IHOST)/$0100,$0003) 00340 CALL CCSMVA(TYPES(1,ITYPE+1),1,6,LINE(2),11,6) 0035000 CALL C2D(COUNTS(1),LINE(12)) 00360 CALL C2D(COUNTS(2),LINE(16)) 00370 CALL C2D(COUNTS(3)+COUNTS(4)+COUNTS(9)+COUNTS(10),LINE(19)) 00380 CALL C2D(COUNTS(5),LINE(22)) 00390 CALL C2D(COUNTS(6),LINE(25)) 00400 CALL C2D(COUNTS(8),LINE(29)) 00410 IF ( HRECS(1,IHOST).EQ.2H ) CALL CCSBLK(LINE(7),6) 0042000 CALL WTREAD(5,-1,LINE,58,-1,0,0,ITC) 00430 299 CONTINUE 00440 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 00450 CALL PGMOUT 004601 00470 9000 CALL SYSMSG(19,HSTAT) 00480 CALL PGMOUT 0049000 9001 CALL SYSMSG(21,HSTAT) 00500 CALL PGMOUT 005101 00520 END 00530 INTEGER FUNCTION GET4(STR,N4) 005401 00550 INTEGER STR(1), N4 00560001 00570 NBYTE=(N4+1)/2 00580 CALL CCSGET(STR,NBYTE,ICH) 00590 GET4=AND(ICH,$0F) 00600 IF ( 2*NBYTE.NE.N4 ) GET4=ICH/$0010 00610 RETURN 006201 0063000 END 00640 SUBROUTINE C2D(IN,OUT) 006501 00660C C2D - CONVERT 2 DIGITS 006701 00680 INTEGER IN, OUT 006901 0070000 IF ( (IN.LT.0) .OR. (99.LT.IN) ) GOTO 100 00710 I1=IN/10+1R0 00720 I2=MOD(IN,10)+1R0 00730 IF ( I1.EQ.1R0 ) I1=$0020 00740 OUT=I1*$0100+I2 00750 RETURN 007601 0077000 100 OUT=2H** 00780 RETURN 007901 00800 END 00810_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2| 2TFBLANK LIBRARY P999999060381(0 SUBROUTINE BLANK(STR,NWORDS) 00010 + /BLANK FILL WORDS 000202 00030C BLANK - BLANK FILL WORDS 000401 00050C COPYRIGHT CONTROL DATA CORPORATION (CGODSO) 000601 0007000 INTEGER STR(1), NWORDS 000802 00090 IF ( NWORDS.LE.0 ) RETURN 00100+ ; NOUGHT TO BE DONE 00110 DO 100 I=1,NWORDS 00120 STR(I)=2H 00130 100 CONTINUE 0014000 RETURN 001501 00160 END 00170_ 00 00 00 00 00 __ 0(d|* d*TFCATAPELIBRARY P999999060381(0 PROGRAM CATAPE 00010 + /CATALOG UTIL FORMAT DUMP TAPE 000202 00030C CATAPE - CATALOG A UTIL FORMATTED DUMP TAPE 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 08/11/80 (CGODSO) 000602 0007000 INTEGER MSG1(13), MSG2(9), MSG3(8), MSG4(7) 00080 DATA MSG1 / 'CATAPE - CATALOG DUMP TAPE' / 00090 DATA MSG2 / 'TAPE UNIT (6/16): ' / 00100 DATA MSG3 / 'HARDCOPY (Y/N): ' / 00110 DATA MSG4 / 'DISPLAY (Y/N):' / 00120 INTEGER HCOPY, UNIT, SCOPY 00130 DATA HCOPY / 'N ' / 0014000 DATA UNIT / '6 ' / 00150 DATA SCOPY / 'Y ' / 00160$$TXFCBTTL,LIBRARY 001701 00180 INTEGER BFR(222), REC(66), TEMP(3) 001902 00200 CALL CLRSCR 0021000 CALL DISPLA(MSG1,26) 00220 CALL DISPLA(2H ,2) 00230 CALL DISPLA(2H ,2) 00240 CALL PROMPT(MSG2,18,UNIT,2,18) 00250 CALL DISPLA(2H ,2) 00260 CALL PROMPT(MSG3,16,HCOPY,1,16) 00270 CALL DISPLA(2H ,2) 0028000 CALL PROMPT(MSG4,14,SCOPY,1,15) 00290 CALL DISPLA(2H ,2) 00300 IF ( (HCOPY.NE.2HY ).AND.(SCOPY.NE.2HY ) ) CALL PGMOUT 003101 00320 LINE1(26)=2HTA 00330 LINE1(27)=2HPE 00340 MAGTAP=6 0035000 IF ( UNIT.EQ.2H16 ) MAGTAP=16 00360 ISTAT=MPMOTN(MAGTAP,$3500) 00370 IF ( SCOPY.NE.2HY ) GOTO 100 00380 CALL CLRSCR 00390 CALL DISPLA(LINE1,78) 00400 CALL DISPLA(LINE2,78) 00410 CALL DISPLA(2H ,2) 0042000 NFILE=0 004301 00440 100 IF ( HCOPY.NE.2HY ) GOTO 200 00450 ISTAT=MPWRIX(9,LINE1,132) 00460 ISTAT=MPWRIX(9,LINE2,132) 00470 ISTAT=MPWRIX(9,2H ,2) 004801 0049000 200 ISTAT=MPREDU(MAGTAP,BFR,200) 00500 IF ( AND(ISTAT,$C000).EQ.$C000 ) CALL PGMOUT 00510 BFR(6)=AND(BFR(6),$DFFF) 00520+ ; FILE IS OBVIOUSLY CLOSED 00530 NFILE=NFILE+1 00540 CALL FMTFCB(NFILE,BFR,REC) 00550 CALL HEXDEC(NFILE,TEMP) 0056000+ ; FILE COUNTS TO DECIMAL 00570 CALL MOVECH(TEMP,1,REC(25),2,6) 00580 REC(29)=2H T 00590+ ; STARTING SECTOR IS " TAPE " 00600 REC(30)=2HAP 00610 REC(31)=2HE 00620 IF ( SCOPY.EQ.2HY ) CALL DISPLA(REC,78) 0063000 IF ( HCOPY.EQ.2HY ) ISTAT=MPWRIX(9,REC,132) 00640 ISTAT=MPMOTN(MAGTAP,$5000) 00650 GOTO 200 006601 00670 END 00680_ 00 00 00 00 00 __ 0(2|U 2TFCDS LIBRARY Pn999999060381(0 SUBROUTINE CDS 00010 + /CCS 2.0 $$USERID MANAGER DECK03 SUMMARY-*** 000202 00030C CDS - CLOSE DOWN SHOP. 00040C CURRENT FUNCTION IS TO CLOSE $$USERID BEFORE NORMAL 00050C PROGRAM EXIT. 00060$$WSUSRBLK 0007000 CALL CLOSFL(REQBLK,ISTAT) 00080 IF ( ISTAT.LT.0 ) CALL MSG(2) 00090 RETURN 001001 00110 END 00120_ 00 00 00 00 00 00 __ 0(|k iTFCHEAT LIBRARY P999999060381(0 PROGRAM CHEAT 00010 + /CHEAP PEEK AT MEMORY ( MAIN + MASS ) 000202 00030C CHEAT - PEEK AT MEMORY ( MAIN & MASS ) 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 04/30/80 (CGODSO) 000601 0007000C 00080C FIRST INPUT: 00090C MMUNIT - FROM 0 TO 9 00100C 00110C SECOND INPUT: 00120C X,XXXX - MASS MEMORY SECTOR ADDRESS 00130C XXXX - MAIN MEMORY ADDRESS 0014000C 00150C SPECIAL TERMINATORS ( ON NULL INPUT ONLY ): 00160C RUBOUT - REFRESH CURRENT DISPLAY 00170C LFEED - PRINT CURRENT DISPLAY 00180C ENTER+ - ADVANCE DISPLAY BY 96 WORDS 00190C ENTER- - RETREAT DISPLAY BY 96 WORDS 002002 0021000 INTEGER ADRBFR(3), DSKBFR(96), IFLAG, TC, SAVEI, ONE2(2) 00220 DATA ADRBFR / 96,0,0 /, ONE2 / 0,1 / 00230 INTEGER MSLU(2), MSADR(4), OLD 00240 INTEGER MSG1(4), MSG2(4), LXXX(50), TXXX(8) 00250 INTEGER LINE(40), TTMP(5) 00260 EQUIVALENCE ( LINE(1),LXXX(2) ), ( TTMP(1),TXXX(2) ) 00270 DATA MSG1 / ' MMU: ' / 0028000 DATA MSG2 / ' MMADR: ' / 00290 DATA LXXX / 50*$2020 / 00300 INTEGER LFEED, RUBOUT, ENTERP, ENTERM, PLUS, MINUS 00310 DATA LFEED, RUBOUT, ENTERP, ENTERM, PLUS, MINUS 00320 + / 3, 4, 7, 8, $2B, $2D / 00330 INTEGER STR(41), VAL(2), RELFLG, TWFLG, ERRFLG 00340 INTEGER MSGE(4), MSGR(4), MSGT(4), MAIN(2), MASS(2) 0035000 DATA MSGE / 'ERROR ' / 00360 DATA MSGR / 'RELATIVE' / 00370 DATA MSGT / '31 BIT ' / 00380 DATA MAIN / 'MAIN' / 00390 DATA MASS / 'MASS' / 004001 00410 INTEGER VPC 00420002 00430 LU=5 00440 100 ASSIGN 9999 TO I 00450+ ; INITIAL CTL-D TO PGMOUT 00460 CALL PGMINT(I,0) 004701 00480 CALL WTREAD(LU,$0000,$2018,2,-1,0,0,TC) 0049000 120 CALL BLANK(STR,40) 00500 CALL WTREAD(LU,$0000,MSG1,8,$0800,STR,80,TC) 00510+ ; PROMPT FOR MMUNIT 00520 CALL WTREAD(LU,$0800,$1600,2,-1,0,0,TC) 00530 IF ( TC.EQ.RUBOUT ) GOTO 120 00540 CALL WTREAD(LU,$0901,$1600,2,-1,0,0,TC) 00550 CALL WTREAD(LU,$0901,STR,STR(41),-1,0,0,TC) 0056000 ASSIGN 100 TO I 00570+ ; CTL-D TO MMUNIT PROMPT 00580 CALL PGMINT(I,0) 005901 00600 CALL CNVSTR(STR,STR(41),VAL,RELFLG,TWFLG,ERRFLG) 00610 IF ( RELFLG.NE.0 ) GOTO 121 00620 IF ( TWFLG.NE.0 ) GOTO 122 0063000 IF ( ERRFLG.NE.0 ) GOTO 123 00640 GOTO 130 006501 00660 121 CALL WTREAD(LU,$4600,MSGR,8,-1,0,0,TC) 00670 GOTO 120 00680 122 CALL WTREAD(LU,$4600,MSGT,8,-1,0,0,TC) 00690 GOTO 120 0070000 123 CALL WTREAD(LU,$4600,MSGE,8,-1,0,0,TC) 00710 GOTO 120 007201 00730 130 MSLU(1)=VAL(2) 00740 CALL HEXASC(MSLU(1),TTMP(2)) 00750 TTMP(1)=2H $ 00760 CALL WTREAD(LU,$0800,TTMP,6,-1,0,0,TC) 0077000 TC=MEMORY(MEMORY($00E9)+29) 00780 IF ( (MSLU(1).LT.0).OR.(MSLU(1).GE.MEMORY(TC)) ) GOTO 123 00790 MSLU(1)=AND(MEMORY(MEMORY(TC+MSLU(1)+1)),$7FFF) 00800 ADRBFR(2)=0 00810 ADRBFR(3)=0 00820 ASSIGN 140 TO OLD 00830 140 CALL BLANK(STR,40) 0084000 VAL(1)=0 00850 VAL(2)=0 00860 CALL WTREAD(LU,$0002,$1600,2,-1,0,0,TC) 00870 CALL WTREAD(LU,$0002,MSG2,8,$0802,STR,80,TC) 00880+ ; PROMPT FOR ADDRESS 00890 CALL WTREAD(LU,$0003,$1600,2,-1,0,0,TC) 00900 CALL WTREAD(LU,$0003,STR,STR(41),-1,0,0,TC) 0091000 CALL WTREAD(LU,$0802,$1600,2,-1,0,0,TC) 00920 IFWG=0 00930+ ; ASSUME OUTPUT TO TERMINAL 00940 IF ( (TC.EQ.RUBOUT) .AND. (STR(41).EQ.0) ) GOTO OLD 00950+ ; RE-DISPLAY 00960 IF ( (TC.EQ.LFEED) .AND. (STR(41).EQ.0) ) GOTO 600 00970+ ; PRINT AS IS 0098000 IF ( TC.EQ.RUBOUT ) GOTO 140 00990+ ; REPROMPT 01000 IF ( (TC.EQ.ENTERP).AND.(STR(41).EQ.0) ) GOTO 620 01010+ ; ADVANCE 01020 IF ( (TC.EQ.ENTERM).AND.(STR(41).EQ.0) ) GOTO 640 01030+ ; RETREAT 01040 CALL CNVSTR(STR,STR(41),VAL,RELFLG,TWFLG,ERRFLG) 0105000 IF ( (TWFLG.EQ.0) .AND. (VAL(1).EQ.1) ) VAL(2)=OR(VAL(2),$8000) 01060 IF ( ERRFLG.EQ.0 ) GOTO 145 01070 141 CALL WTREAD(LU,$0E00,$1600,2,-1,0,0,TC) 01080 CALL WTREAD(LU,$4600,MSGE,8,-1,0,0,TC) 01090 GOTO 140 011001 01110 145 CALL WTREAD(LU,$3E00,$1600,2,-1,0,0,TC) 0112000 IF ( TWFLG.NE.0 ) CALL WTREAD(LU,$3E00,MSGT,8,-1,0,0,TC) 01130 IF ( RELFLG.NE.0 ) CALL WTREAD(LU,$4600,MSGR,8,-1,0,0,TC) 01140 IF ( RELFLG.EQ.PLUS ) CALL FDWADD(ADRBFR(2),VAL,ADRBFR(2),TC) 01150 IF ( RELFLG.EQ.MINUS ) CALL FDWSUB(ADRBFR(2),VAL,ADRBFR(2),TC) 01160 IF ( RELFLG.EQ.0 ) CALL MOVECH(VAL,1,ADRBFR(2),1,4) 011701 01180 IF ( RELFLG.NE.0 ) GOTO OLD 0119000 IF ( TWFLG.EQ.0 ) GOTO 500 012001 01210C READ SELECTED MASS MEMORY 012201 01230 160 ASSIGN 160 TO OLD 01240 N1=0 01250 CALL HEXASC(ADRBFR(2),VAL) 0126000 TTMP(1)=2H$ 01270 TTMP(3)=2H , 01280 CALL MOVECH(VAL,1,TTMP(1),2,4) 01290 CALL HEXASC(ADRBFR(3),TTMP(4)) 01300 CALL WTREAD(LU,$0901,TTMP,10,-1,0,0,TC) 01310 CALL WTREAD(LU,$1401,MASS,4,-1,0,0,TC) 01320 IF ( ADRBFR(2).LT.0 ) GOTO 141 0133000 IFLAG=MMREAD(MSLU(1),ADRBFR(1),ADRBFR(2),DSKBFR) 013401 01350C DISPLAY REQUESTED DATA 013601 01370 200 LTN=6 01380 K=1 01390 N2=N1+95 0140000 DO 310 J1=N1,N2,8 01410 CALL HEXASC(J1,LINE(4)) 01420+ ; "ADDRESS" 01430 L=7 01440 L2=32 01450 DO 300 J2=1,8 01460+ ; COMPLETE 1 LINE 0147000 CALL HEXASC(DSKBFR(K),LINE(L)) 01480 LINE(L2)=VPC(DSKBFR(K)) 01490 K=K+1 01500 L=L+3 01510 L2=L2+1 01520 300 CONTINUE 01530 IF ( IFWG.EQ.0 ) CALL WTREAD(LU,LTN,LINE,80,-1,0,0,TC) 0154000 IF ( IFWG.NE.0 ) TC=MPWRIX(12,LXXX,82) 01550 LTN=LTN+1 01560 310 CONTINUE 01570 GOTO 140 015801 01590C READ SELECTED MAIN MEMORY 016001 0161000 500 N1=ADRBFR(3) 01620 ASSIGN 505 TO OLD 01630 505 IF ( RELFLG.EQ.PLUS ) N1=N1+VAL(2) 01640 IF ( RELFLG.EQ.MINUS ) N1=N1-VAL(2) 01650 M1=N1 01660 TTMP(1)=2H 01670 TTMP(2)=2H 0168000 TTMP(3)=2H $ 01690 CALL HEXASC(M1,TTMP(4)) 01700 CALL WTREAD(LU,$0901,TTMP,10,-1,0,0,TC) 01710 CALL WTREAD(LU,$1401,MAIN,4,-1,0,0,TC) 01720 DO 510 I=1,96 01730 DSKBFR(I)=MEMORY(M1) 01740 M1=M1+1 0175000 510 CONTINUE 01760 GOTO 200 017701 01780C SET UP TO PRINT CURRENT DISPLAY 017901 01800 600 IFWG=1 01810 TXXX(1)=2H 0182000 TC=MPWRIX(12,TXXX,12) 01830 GOTO 200 018401 01850C ADVANCE DISPLAY BY 96 WORDS 018601 01870 620 N1=N1+96 01880 CALL WTREAD(LU,$4600,MSGR,8,-1,0,0,TC) 0189000 CALL FDWADD(ADRBFR(2),ONE2,ADRBFR(2),TC) 01900 GOTO OLD 019101 01920C RETREAT DISPLAY BY 96 WORDS 019301 01940 640 N1=N1-96 01950 CALL WTREAD(LU,$4600,MSGR,8,-1,0,0,TC) 0196000 CALL FDWSUB(ADRBFR(2),ONE2,ADRBFR(2),TC) 01970 GOTO OLD 019801 01990 9999 CALL PGMOUT 020001 02010 END 02020 INTEGER FUNCTION VPC(I) 0203000 INTEGER VDC 02040 VPC=VDC(I) 02050 RETURN 02060 END 02070_ 00 00 00 00 00 00 __ 0(d| d*TFCHG LIBRARY PR999999060381(0 SUBROUTINE CHG 00010 + /CCS 2.0 $$USERID MANAGER DECK04 SUMMARY-*** 000202 00030C CHG - CHANGE FORCED REQUEST. 00040C CHANGE THE FORCED REQUEST PROGRAM FIELD FOR 00050C 1. SPECIFIC PAIRS; 00060C 2. ALL TERMINAL PORT CODE ENTRIES UNDER A SPECIFIED 0007000C USER IDENTIFIER . 00080C ALL CHANGES ARE MADE IMMEDIATELY ( DIRECTLY TO $$USERID ). 000902 00100 INTEGER PMT0(20), PMT1(2), PMT2(4), PMT3(9), PGM(5), ICNT 001101 00120 DATA PMT0 / 'CHANGE FORCED REQUEST ' / 00130 DATA PMT1 / 'ID: ' / 0014000 DATA PMT2 / 'PROGRAM:' / 00150 DATA PMT3 / 'TERMINAL CODE(*): ' / 00160$$WSUSRBLK 00170 100 CALL PROMPT(PMT0,-40,0,0) 00180 CALL PROMPT(2H ,2,0,0) 00190 CALL PROMPT(PMT1,3,CURID,8) 00200+ ; AFFECTED USER IDENTIFIER 0021000 IF ( CURID(5).EQ.0 ) RETURN 00220 CALL PROMPT(PMT2,8,PGM,8) 00230+ ; FORCED REQUEST PROGRAM 00240 DO 120 I=1,4 00250 UID(I)=CURID(I) 00260 120 CONTINUE 002701 0028000C LOOP FOR ALL REQUESTED TERMINALS ON THIS USER IDENTIFIER AND 00290C FORCED REQUEST PAIR ( ) AS REPEATED SINGLE ENTRIES. 003001 00310 200 CALL PROMPT(PMT3,17,TX,2) 00320+ ; TERMINAL PORT CODE (*) 00330 IF ( TX(2).EQ.0 ) GOTO 100 00340+ ; NO MORE TERMINALS 0035000 IF ( (TX(1).EQ.2H* ) .AND. (TX(2).EQ.1) ) GOTO 300 00360+ ; ALL 00370 IF ( VALTID(TX(1)).EQ.0 ) GOTO 200 00380 CURID(5)=TX(1) 00390 CALL READR(REQBLK,USER,CURID,ISTAT) 00400 DO 210 I=1,4 00410 IF ( USER(I).NE.UID(I) ) GOTO 240 0042000 210 CONTINUE 00430 IF ( USER(5).NE.TX(1) ) GOTO 240 00440 IF ( ISTAT.LT.0 ) CALL MSG(3) 00450 DO 220 I=1,4 00460+ ; CHANGE FORCED REQUEST 00470 USER(I+6)=PGM(I) 00480 220 CONTINUE 0049000 CALL UPDREC(REQBLK,USER,ISTAT) 00500 IF ( ISTAT.LT.0 ) CALL MSG(4) 00510 CALL MSG(0) 00520 GOTO 200 005301 00540 240 CALL MSG(10) 00550+ ; NOT DEFINED 0056000 GOTO 200 005701 00580C PROCESS ALL TERMINAL PORT CODES ON THIS USER IDENTIFIER 005901 00600 300 CURID(5)=2H00 00610 ICNT=0 00620 CALL READR(REQBLK,USER,CURID,ISTAT) 0063000 320 IF ( AND(ISTAT,EOFLAG).EQ.EOFLAG ) GOTO 380 00640 IF ( ISTAT.LT.0 ) CALL MSG(3) 00650 DO 340 I=1,4 00660 IF ( CURID(I).NE.UID(I) ) GOTO 380 00670+ ; IDENTIFIERS DIFFER 00680 340 CONTINUE 00690 ICNT=ICNT+1 0070000 DO 360 I=1,4 00710 USER(I+6)=PGM(I) 00720 360 CONTINUE 00730 CALL UPDREC(REQBLK,USER,ISTAT) 00740 IF ( ISTAT.LT.0 ) CALL MSG(4) 00750 CALL MSG(0) 00760 CALL GETS(REQBLK,USER,CURID,ISTAT) 0077000 GOTO 320 007801 00790C BEGIN A NEW USER IDENTIFIER 008001 00810 380 IF ( ICNT.EQ.0 ) CALL MSG(10) 00820 CALL MSG(11) 00830 GOTO 100 00840001 00850 END 00860_ 00 00 __ 0(d} d*TFCHKDEFLIBRARY P 999999060381(0 SUBROUTINE CHKDEF(REC,NORG) 00010 + /VALIDATE SINGLE FDD ENTRIES 000202 00030C CHKDEF - VALIDATE SINGLE FILE DEFINITION DIRECTORY ENTRIES. 000401 00050C CHECK THE FILENAME/OWNERNAME WITH THE ASSOCIATED FCB. 00060C CHECK THE HASH 0007000C CHECK FOR SINGLE USE OF FCB-S 000802 00090 INTEGER REC(9), NORG 001001 00110 INTEGER ADR(2), BIT(16), LIST(16) 00120 DATA BIT /$8000,$4000,$2000,$1000,$0800,$0400,$0200,$0100, 00130 + $0080,$0040,$0020,$0010,$0008,$0004,$0002,$0001 / 00140001 00150 INTEGER VPC 00160$$TXPRVBLK,LIBRARY 00170 IFLAG=0 00180 DO 100 I=1,9 00190 IF ( REC(I).NE.0 ) IFLAG=1 00200 100 CONTINUE 0021000 IF ( IFLAG.EQ.0 ) RETURN 002201 00230 IFLAG=0 00240 DO 110 I=1,8 00250 IFLAG=AND(REC(I)+IFLAG,$7FFF) 00260 110 CONTINUE 00270 I=VLNFDB/2 0028000 IFLAG=IFLAG/I 00290 ASSEM $4400,+IFLAG 00300+ ; REMAINDER == INDEX 00310 IF ( IFLAG.NE.NORG ) GOTO 230 003201 00330 ADR(1)=0 00340 ADR(2)=REC(9) 0035000 CALL FDWADD(ADR,FCBADR,ADR,TC) 00360 IFLAG=MMREAD(MMU,96,ADR,HDR) 00370 IF ( HDR(1).EQ.0 ) GOTO 200 00380 DO 120 I=1,8 00390 IF ( REC(I).NE.HDR(I+24) ) GOTO 210 00400 120 CONTINUE 00410 140 NP=1 + REC(9)/$10 0042000 NB=AND(REC(9),$000F)+1 00430 IF ( AND(FDDBIT(NP),BIT(NB)).NE.0 ) GOTO 220 00440 FDDBIT(NP)=OR(FDDBIT(NP),BIT(NB)) 00450 RETURN 004601 00470 200 WRITE (12,9000) REC(9), NFDB 00480 GOTO 300 00490001 00500 210 WRITE (12,9001) REC(9), NFDB 00510 GOTO 300 005201 00530 220 WRITE (12,9002) REC(9), NFDB 00540 GOTO 300 005501 0056000 230 DO 231 I=1,8 00570 LIST(I)=VPC(REC(I)) 00580 231 CONTINUE 00590 WRITE (12,9005) NFDB, (REC(I), I=1,8), (LIST(I), I=1,8), REC(9) 00600 RETURN 006101 00620 300 DO 310 I=1,8 0063000 LIST(I)=VPC(REC(I)) 00640 LIST(I+8)=VPC(HDR(I+24)) 00650 310 CONTINUE 00660 WRITE (12,9003) (REC(I), I=1,8), (LIST(I), I=1,8) 00670 WRITE (12,9004) (HDR(I), I=25,32), (LIST(I), I=9,16) 00680 RETURN 006901 0070000 9000 FORMAT(' NO FCB FOR FDB ENTRY, NFCB = $',Z4,', NFDB = $',Z4) 00710 9001 FORMAT(' NAME/OWNER ERROR, NFCB = $',Z4,', NFDB = $',Z4) 00720 9002 FORMAT(' FDB MULTI-MARK, NFCB = $',Z4,', NFDB = $',Z4) 00730 9003 FORMAT(' FDD : ',8(X,Z4),2X,8A2) 00740 9004 FORMAT(' FCB : ',8(X,Z4),8X,8A2) 00750 9005 FORMAT(' FDD HASH ERROR, NFDD = $',Z4,X,8(X,Z4),2X,8A2,' $',Z4) 007601 0077000 END 00780_ 00 00 00 __ 0(d} d*TFCHKFDBLIBRARY P999999060381(0 SUBROUTINE CHKFDB(REC) 00010 + /PROCESS A FDD SECTOR 000202 00030C CHKFDB - PROCESS A SECTOR OF THE FILE DEFINITION DIRECTORY. 000401 00050C CHKFDB LOOPS THROUGH A SECTOR OF THE FDD AND PASSES EACH 9 WORD 00060C ENTRY TO *CHKDEF* FOR VALIDATION. 0007000C 00080C *NOTE* OVERFLOW BLOCKS ARE READ IN OVER THE ORIGINAL 00090C SECTOR AREA ( *REC* ) 001002 00110 INTEGER REC(96) 001201 00130 INTEGER ADR(2) 0014000$$TXPRVBLK,LIBRARY 00150 INTEGER VLNXTB 00160 EQUIVALENCE (VLNXTB,VOL(34)) 001702 00180 N=NFDB 00190 100 DO 200 I=2,85,9 00200 CALL CHKDEF(REC(I),N) 0021000 200 CONTINUE 00220 NFDB=N 00230 IF ( REC(1).EQ.0 ) RETURN 00240 IF ( REC(1).GE.VLNXTB ) GOTO 300 00250 M=REC(1)+1-VLNFDB/2 00260 IF ( ALCFDV(M).NE.-1 ) GOTO 310 00270 ALCFDV(M)=N 0028000 ADR(1)=0 00290 ADR(2)=REC(1) 00300 CALL FDWADD(ADR,VLFDD,ADR,TC) 00310 CALL FDWSUB(ADR,ONE2,ADR,TC) 00320 NFDB=ADR(2)-VLFDD(2) 00330 IFLAG=MMREAD(MMU,96,ADR,REC) 00340 GOTO 100 00350001 00360 300 WRITE (12,9000) NFDB, REC(1) 00370 RETURN 003801 00390 310 WRITE (12,9001) NFDB, REC(1), ALCFDV(M) 00400 RETURN 004101 0042000 9000 FORMAT(' FDB $',Z4,' INDEXES UNALLOCATED OVF BLOCK $',Z4) 00430 9001 FORMAT(' FDB $',Z4,' INDEXES MULTI-USED OVF BLOCK $',Z4, 00440 + ' PREVIOUS REFERENCE FDB $',Z4) 004501 00460 END 00470_ 00 00 00 00 00 00 00 00 __ 0(2} 2TFCHKFDDLIBRARY P6999999060381(0 SUBROUTINE CHKFDD 00010 + /PROCESS ENTIRE FDD 000202 00030C CHKFDD - PROCESS THE ENTIRE FILE DEFINITION DIRECTORY. 000401 00050C CHKFDD LOOPS THROUGH THE FDD AND PASSES EACH SECTOR TO *CHKFDB*. 000602 0007000 INTEGER ADR(2) 00080$$TXPRVBLK,LIBRARY 00090 N=VLNFDB/2 00100 CALL ZERO(FDDBIT,288) 00110 DO 100 I=1,256 00120 ALCFDV(I)=-1 00130 100 CONTINUE 00140001 00150 ADR(1)=VLFDD(1) 00160 ADR(2)=VLFDD(2) 00170 NFDB=0 00180 IX=64+1 00190 200 IF ( IX.LE.64 ) GOTO 220 00200 IF ( NFDB.GE.N ) RETURN 0021000 IFLAG=MMREAD(MMU,64*96,ADR,FCBBFR) 00220 IX=1 00230 220 IF ( NFDB.GE.N ) RETURN 00240 CALL CHKFDB(FCB(1,IX)) 00250 CALL FDWADD(ADR,ONE2,ADR,TC) 00260 IX=IX+1 00270 NFDB=NFDB+1 0028000 GOTO 200 002901 00300 END 00310_ 00 00 00 __ 0(d} d*TFCHKHDRLIBRARY PX999999060381(0 SUBROUTINE CHKHDR(OLD,HDR) 00010 + /VALIDATE HEADER SECTOR 000202 00030C CHKHDR - CHECK HEADER SECTOR. 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 000601 0007000C CHKHDR PERFORMS SOME SIMPLE TESTS TO VERIFY A HEADER SECTOR. 00080C IF NOT VERIFIED, THEN THE PROGRAM IS STOPPED. 00090C IF VERIFIED, THE 'FCBBFR' CONTAINES THE FCB FOR THE HEADER. 001001 00110C OLD - SECTOR ADDRESS OF THE HEADER SECTOR. 00120C HDR - FILE HEADER SECTOR 001302 0014000 INTEGER OLD(2), HDR(96) 001501 00160 INTEGER ONE2(2), WHERE(2) 00170 DATA ONE2 / 0,1 / 00180 INTEGER MSG1(16), MSG2(23), MSG3(23), MSG4(19), MSG5(21) 00190 DATA MSG1 / 'WHAT ????, ???? NO AL IN HEADER' / 00200 DATA MSG2 / 'WHAT ????, ???? BAD HEADER ADDRESS POINTER 1 ' / 0021000 DATA MSG3 / 'WHAT ????, ???? BAD HEADER ADDRESS POINTER 2 ' / 00220 DATA MSG4 / 'WHAT ????, ???? BAD HEADER FCB INDEX ' / 00230 DATA MSG5 / 'WHAT ????, ???? HEADER SELF ADDRESS WRONG' / 00240 INTEGER MSG6(21) 00250 DATA MSG6 / 'WHAT ????, ???? FCB DOES NOT ADDRESS FILE' / 00260$$TXSQUBLK,LIBRARY 00270 IF ( HDR(1).NE.2HAL ) CALL BADHDR(OLD,MSG1,32) 0028000 WHERE(1)=0 00290 WHERE(2)=VOLBFR(33) 00300 CALL FDWADD(WHERE,VOLBFR(29),WHERE,TC) 00310 IF ( HDR(14).NE.WHERE(1) ) CALL BADHDR(OLD,MSG2,46) 00320 IF ( HDR(15).LT.0 ) CALL BADHDR(OLD,MSG3,46) 00330 IF ( HDR(16).LT.0 ) CALL BADHDR(OLD,MSG4,38) 00340 IF ( HDR(16).GE.VLMAXF ) CALL BADHDR(OLD,MSG4,38) 0035000 IF ( HDR(4).NE.OLD(1) ) CALL BADHDR(OLD,MSG5,42) 00360 IF ( HDR(5).NE.OLD(2) ) CALL BADHDR(OLD,MSG5,42) 00370 IFLAG=MMREAD(MLU,VLWPS,HDR(14),FCBBFR) 00380 CALL FDWSUB(FCBBFR(4),ONE2,WHERE,IFLAG) 00390 IF ( WHERE(1).NE.OLD(1) ) CALL BADHDR(OLD,MSG6,42) 00400 IF ( WHERE(2).NE.OLD(2) ) CALL BADHDR(OLD,MSG6,42) 00410 RETURN 00420001 00430 END 00440 SUBROUTINE BADHDR(OLD,MSG,NBYTES) 00450 + /BAD HEADER SECTOR MESSAGE, ABORT 004602 00470C BADHDR - BAD HEADER SECTOR MESSAGE 004801 0049000C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 005001 00510 INTEGER OLD(2), MSG(1), NBYTES 005202 00530 900 CALL HEXASC(OLD(1),MSG(4)) 00540 CALL HEXASC(OLD(2),MSG(7)) 00550 CALL DISPLA(MSG,NBYTES) 0056000 CALL DISPLA(2H ,2) 00570 CALL PGMOUT 005801 00590 END 00600_ 00 00 00 00 00 00 __ 0(2~ 2TFCKSTR LIBRARY P999999060381(0 INTEGER FUNCTION CKSTR(STR,NR1,NR2) 00010 + /TWO OPTION STRING MATCH 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C CKSTR - CHECK STRING. 000601 0007000C CKSTR COMPARES A FOUR BYTE ( TWO WORD ) ITEM WITH TWO ALTERNATIVE 00080C FOR A POSSIBLE MATCH. IF THE FIRST MATCHES, THEN +1 IS RETURNED. 00090C IF THE SECOND MATCHES, THEN -1 IS RETURNED. IF NEITHER OF THE 00100C ALTENATIVES MATCH, THEN +0 IS RETURNED. 00110C *NOTE* THE RETURN VALUE IS SET INTO THE THIRD WORD OF THE 00120C COMPARISON STRING. 001302 0014000 INTEGER STR(3), NR1(2), NR2(2) 001501 00160 CKSTR=+0 00170 IF ( (STR(1).EQ.NR1(1)) .AND. (STR(2).EQ.NR1(2)) ) CKSTR=+1 00180 IF ( (STR(1).EQ.NR2(1)) .AND. (STR(2).EQ.NR2(2)) ) CKSTR=-1 00190 STR(3)=CKSTR 00200 RETURN 00210001 00220 END 00230_ 00 00 00 00 __ 0(2~+ 2TFCNV2W LIBRARY P999999060381(0 SUBROUTINE CNV2W(IN,OUT) 00010 + /32 BIT TO 31 BIT INTEGER CONVERSION 000202 00030C CONVERT 32 BIT INTEGER TO 31 BIT INTEGER 000401 00050 INTEGER IN(2), OUT(2) 000601 0007000 INTEGER LOCL1(2), LOCL2(2) 000802 00090 LOCL1(1)=IN(1) 00100 LOCL1(2)=IN(2) 00110 ASSEM $E400,+LOCL1(1) 00120+ ; LDQ TDATRM 00130 ASSEM $C400,+LOCL1(2) 0014000+ ; LDA TDATRM+1 00150 ASSEM $0FE1 00160+ ; LLS 1 00170 ASSEM $0FCF 00180+ ; ALS 15 00190 ASSEM $4800,LOCL2(1) 00200+ ; STQ SECREC 0021000 ASSEM $6800,LOCL2(2) 00220+ ; STA SECREC+1 00230 OUT(1)=LOCL2(1) 00240 OUT(2)=LOCL2(2) 00250 RETURN 002601 00270 END 0028000_ 00 00 00 __ 0(,~A ,}TFCNVSTRLIBRARY P999999060381(0 SUBROUTINE CNVSTR(STR,MAX,VAL,RELFLG,TWFLG,ERRFLG) 000102 00020 INTEGER STR(1), MAX, VAL(2), RELFLG, TWFLG, ERRFLG 000301 00040 INTEGER MATHOP, NEXTCH 00050 INTEGER CH, IP, OP, OVF, NEW(2) 00060 INTEGER COMMA, MINUS, PERIOD, PLUS 0007000 DATA COMMA, MINUS, PERIOD, PLUS 00080 + / $2C, $2D, $2E, $2B / 000902 00100 RELFLG=0 00110 TWFLG=0 00120 ERRFLG=0 00130 VAL(1)=0 0014000 VAL(2)=0 00150 OP=MATHOP(PLUS) 00160 IP=0 00170 CH=NEXTCH(STR,IP,MAX) 00180 IF ( (CH.NE.PLUS) .AND. (CH.NE.MINUS) ) GOTO 300 00190 RELFLG=CH 00200 CH=NEXTCH(STR,IP,MAX) 00210001 00220 300 IF ( CH.EQ.PERIOD ) GOTO 600 00230 CALL HEXNUM(STR,IP,MAX,CH,NEW(1)) 00240 GOTO 800 002501 00260 600 CH=NEXTCH(STR,IP,MAX) 00270 CALL DECNUM(STR,IP,MAX,CH,NEW(1)) 00280001 00290 800 IF ( CH.NE.COMMA ) GOTO 1500 00300 TWFLG=1 00310 CH=NEXTCH(STR,IP,MAX) 00320 IF ( CH.EQ.PERIOD ) GOTO 1300 00330 CALL HEXNUM(STR,IP,MAX,CH,NEW(2)) 00340 GOTO 1600 00350001 00360 1300 CH=NEXTCH(STR,IP,MAX) 00370 CALL DECNUM(STR,IP,MAX,CH,NEW(2)) 00380 GOTO 1600 003901 00400 1500 NEW(2)=NEW(1) 00410 NEW(1)=0 00420001 00430 1600 IF ( AND(NEW(2),$8000).NE.0 ) NEW(1)=NEW(1)+1 00440 NEW(2)=AND(NEW(2),$7FFF) 00450 GOTO ( 1601, 1602, 1603, 1604 ), OP 004601 00470 1601 CALL FDWADD(VAL,NEW,VAL,OVF) 00480 GOTO 1700 00490001 00500 1602 CALL FDWSUB(VAL,NEW,VAL,OVF) 00510 GOTO 1700 005201 00530 1603 CALL FDWMUI(VAL,NEW(2),VAL,OVF) 00540 GOTO 1700 005501 0056000 1604 CALL FDWDIV(VAL,NEW(2),VAL,OVF) 00570 IF ( OVF.NE.0 ) GOTO 1900 005801 00590 1700 IF ( CH.LT.0 ) RETURN 00600 OP=MATHOP(CH) 00610 IF ( OP.EQ.0 ) GOTO 1900 00620 CH=NEXTCH(STR,IP,MAX) 0063000 GOTO 300 006401 00650 1900 ERRFLG=1 00660 RETURN 006701 00680 END 00690 SUBROUTINE DECNUM(STR,IP,MAX,CH,NUM) 00700002 00710 INTEGER STR(1), IP, MAX, CH, NUM 007201 00730 INTEGER DIG, DECDIG 007402 00750 NUM=0 00760 100 DIG=DECDIG(CH) 0077000 IF ( DIG.LT.0 ) RETURN 00780 NUM=AND((AND((AND(ISHIFT(NUM,1),$7FFE)+AND(ISHIFT(NUM,3),$7FFE)), 00790 + $7FFF)+DIG),$7FFF) 00800 CH=NEXTCH(STR,IP,MAX) 00810 GOTO 100 008201 00830 END 0084000 INTEGER FUNCTION DECDIG(CH) 008502 00860 INTEGER CH 008701 00880 INTEGER ZERO, NINE 00890 DATA ZERO, NINE 00900 + / $30, $39 / 00910001 00920 DECDIG=-1 00930 IF ( (ZERO.LE.CH) .AND. (CH.LE.NINE) ) DECDIG=CH-ZERO 00940 RETURN 009501 00960 END 00970 SUBROUTINE HEXNUM(STR,IP,MAX,CH,NUM) 00980002 00990 INTEGER STR(1), IP, MAX, CH, NUM 010001 01010 INTEGER DIG, HEXDIG 010202 01030 NUM=0 01040 100 DIG=HEXDIG(CH) 0105000 IF ( DIG.LT.0 ) RETURN 01060 NUM=OR(AND(ISHIFT(NUM,4),$FFF0),DIG) 01070 CH=NEXTCH(STR,IP,MAX) 01080 GOTO 100 010901 01100 END 01110 INTEGER FUNCTION HEXDIG(CH) 01120002 01130 INTEGER CH 011401 01150 INTEGER ZERO, NINE, A, F 01160 DATA ZERO, NINE, A, F 01170 + / $30, $39, $41, $46 / 011802 0119000 HEXDIG=-1 01200 IF ( (ZERO.LE.CH) .AND. (CH.LE.NINE) ) HEXDIG=CH-ZERO 01210 IF ( ( A.LE.CH) .AND. (CH.LE. F) ) HEXDIG=CH-A+10 01220 RETURN 012301 01240 END 01250 INTEGER FUNCTION MATHOP(CH) 01260002 01270 INTEGER CH 012801 01290 INTEGER PLUS, MINUS, TIMES, SLASH 01300 DATA PLUS, MINUS, TIMES, SLASH 01310 + / $2B, $2D, $2A, $2F / 013202 0133000 MATHOP=0 01340 IF ( CH.EQ.PLUS ) MATHOP=1 01350 IF ( CH.EQ.MINUS ) MATHOP=2 01360 IF ( CH.EQ.TIMES ) MATHOP=3 01370 IF ( CH.EQ.SLASH ) MATHOP=4 01380 RETURN 013901 0140000 END 01410 INTEGER FUNCTION NEXTCH(STR,IP,MAX) 014202 01430 INTEGER STR(1), IP, MAX 014401 01450 INTEGER CHAR 01460 INTEGER BLANK 0147000 DATA BLANK / $20 / 014802 01490 100 NEXTCH=-1 01500 IF ( IP.GE.MAX ) RETURN 01510 IP=IP+1 01520 NEXTCH=CHAR(STR,IP) 01530 IF ( NEXTCH.EQ.BLANK ) GOTO 100 0154000 RETURN 015501 01560 END 01570 SUBROUTINE FDWDIV(OP1,OP2,RES,OVF) 015802 01590 INTEGER OP1(2), OP2, RES(2), OVF 016001 0161000 INTEGER LOP1(2), LOP2, LRES, LOVF 016202 01630 LOP1(1)=OP1(1) 01640 LOP1(2)=OP1(2) 01650 LOP2=OP2 01660 RES(1)=0 01670 RES(2)=0 01680001 01690 ASSEM $E400,+LOP1(1) 01700+ ; LDQ+ OP1(1) 01710 ASSEM $C400,+LOP1(2) 01720+ ; LDA+ OP1(2) 01730 ASSEM $0FC1 01740+ ; ALS 1 0175000 ASSEM $0F61 01760+ ; LRS 1 01770 ASSEM $3400,+LOP2 01780+ ; DVI+ LOP2 01790 ASSEM $6400,+LRES 01800+ ; STA+ LRES 01810 ASSEM $0A01 0182000+ ; ENA 1 01830 ASSEM $01A1 01840+ ; SOV 1 01850 ASSEM $0A00 01860+ ; ENA 0 01870 ASSEM $6400,+LOVF 01880+ ; STA+ LOVF 01890001 01900 OVF=LOVF 01910 IF ( OVF.NE.0 ) RETURN 01920 RES(2)=LRES 01930 RETURN 019401 01950 END 0196000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(~ ?TFCONVERLIBRARY P999999060381(0 SUBROUTINE CONVER(INP,IDIG) 00010 * /DECK-ID C10 ITOS 1.1 SUMMARY-122 00020C CONVERT N BYTES BINARY TO ASCII 00030C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00040C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION 1977 00060C 0007000C*** 00080C 00090C FUNCTION 00100C 00110C CONVERTS A SIXTEEN BIT BINARY NUMBER INTO AN EIGHT 00120C DIGIT ASCII NUMBER LEFT JUSTIFIED,BLANK FILL 00130C 0014000C 00150C GENERAL DESCRIPTION 00160C 00170C THE FORTRAN ROUTINE FDWSUB IS CALLED CONTINEOUSLY UNTILL 00180C THE OVERFLOW INDICATOR (IOV) IS SET OR UNTIL IT IS CALLED 00190C FOR NINE SUCCESSIVE TIMES. 00200C IF IOV IS SET FDWADD IS CALLED TO RESTORE THE LAST POSITIVE 0021000C VALUE IN THE INPUTWORDS (INP) AND THE ASCII OUTPUT DIGIT 00220C IS STORED INTO THE OUTPUTBUFFER(IDIG) STARTING AT THE 00230C HIGH-ORDER LOCATION 00240C 00250C 00260C INPUT 00270C 0028000C INP TWO WORD ARRAY CONTAINING THE BINARY NO 00290C 00300C 00310C OUTPUT 00320C 00330C IDIG EIGHT WORD ARRAY CONTAINING THE ASCII NO 00340C 0035000C 00360C MISCELLANEOUS 00370C 00380C JVAL TWO DIMENSIONAL ARRAY CONTAINING THE 00390C DOUBLE PRECISION HEX.VALUE FOR THE VALUE 00400C TO BE SUBTRACTED 00410C 0042000C*** 00430 DIMENSION JVAL(2,8),IDIG(8),INP(2) 00440 DATA JVAL/$131,$1680,$1E,$4240,$3,$06A0,$0,$2710,$0,$3E8,$0,$64, 00450 1 $0,$A,$0,$1/ 00460C 00470 IFLAG=0 00480 DO 100 J=1,8 0049000 DO 50 I=1,9 00500 CALL FDWSUB(INP,JVAL(1,J),INP,IOV) 00510 IF(IOV .EQ. 1) GO TO 75 00520 50 CONTINUE 00530 GO TO 80 00540 75 CALL FDWADD (INP,JVAL(1,J),INP,IOV) 00550 80 IDIG(J)=(I-1)+$30 0056000 IF (IFLAG .EQ. 1) GO TO 100 00570 IF (IDIG(J) .EQ. $30) GO TO 90 00580 IFLAG=1 00590 GO TO 100 00600 90 IDIG(J)=$20 00610 100 CONTINUE 00620 IF(IDIG(8) .EQ. $20) IDIG(8)=$30 0063000 RETURN 00640 END 00650_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(~ TFCOPY LIBRARY P999999060381(0 SUBROUTINE COPY (CPDAT,IDATA) 00010 + /DECK-ID CUSTOM COPY SUBROUTINE SUMMARY-*** 00020C COMMAND PROCESSOR FOR COPY 00030C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 00040C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION 1977 00060C*** 0007000C ************************************************************* 122*4868 00080C 00090C 00100C FUNCTION 00110C 00120C THIS PROCESSOR WILL COPY AN EXCISTING FILE INTO ANOTHER 00130C EXCISTINF FILE WITH DELETION OF THE RECORDS MARKED AS SUCH 0014000C 00150C ************************************************************* 122*4868 00160C MAX RECORD SIZE IS 8000 BYTES 00170C *********************'*******************************'******* 122*4868 00180C 00190C GENERAL DESCRIPTION 00200C 0021000C 00220C ************************************************************* 122*4868 00230C AFTER ALL PARAMETERS HAVE BEEN READ,A CHECK FOR VALIDITY 00240C IS DONE 00250C BOTH FILES WILL BE OPENED WITH LOCK AND THE FCB OF BOTH FILES 00260C IS OBTAINED 00270C A CHECK IS DONE TO ENSURE THAT BOTH FILES HAVE THE SAME 0028000C RECORD-LENGTH AND THE FYLE-TYPE SHOULD ALSO BE EQUAL 00290C IF NOT,AN APPROPRIATE ERROR MESSAGE(65,66) IS DISPLAYED 00300C THE FILE SPECIFIED BY F2 IS CLEARED PRIOR TO THE COPY PROCESS 00310C IF THE FILE IS AN INDEXED FILE,OR THE SECTOR ALIGNMENT IS 00320C NOT EQUAL,THE COPY IS DONE ON A RECORD BASES 00330C IF THE FILE IS SEQUENTIAL AND THE SECTOR ALIGNMENT OF BOTH 00340C FILES IS EQUAL,THE COPY IS BLOCKED DEPENDING UPON RECORD-SIZE 0035000C RECORDS ARE OBTAINED USING THE GETS FILE-MANAGER REQUEST 00360C IN CASE OF AN SEQUENTIAL FILE,THE COPY IS DONE USING PUTS REQUEST 00370C ELSE THE PRIMARY KEY-VALUE IS EXTRACTED FROM THE RECORDBUFFER(RECB 00380C AND STORED INTO THE VARIABLE KEYVAL 00390C NEXT A WRITER REQUEST IS PERFORMED 00400C COPY STOPS AT DETECTION OF AN EOF AND BOTH FILES ARE CLOSED 00410C *****************************************************'******* 122*4868 0042000C 00430C COMMAND FORMAT 00440C 00450C COPY,FN=AAAAAAAA,VL=AAAAAAAA,F2=AAAAAAAA,OW=BBBBBBBB,V2=BBBBBBB 00460C 00470C COPY,AAAAAAAA,VVVVVVVV,BBBBBBBB,OOOOOOOO,BBBBBBBB 00480C 0049000M FMUCOM 00500. 00510C 00520 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL 00530 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 00540 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP 00550 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) 0056000 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE 00570 INTEGER OPN,WVL 00580 INTEGER RECBUF 00590 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND 00600 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1,IDATA(24) 00610C ************************************************************* 122*4868 00620 INTEGER BUFSIZ,SECLEN,FMRDEL 0063000C ************************************************************* 122*4868 00640C 00650 DIMENSION IPNAM(17) 00660 DIMENSION IREQ(17) 00670 DIMENSION IFND(17) 00680 DIMENSION NAME(30) 00690 DIMENSION NAME12(4) 0070000 DIMENSION OWNR12(4) 00710 DIMENSION KEYVAL(15) 00720C ************************************************************* 122*4868 00730 DIMENSION RECBUF(4002) 00740C ************************************************************* 122*4868 00750C 00760 EQUIVALENCE (PPCOPY,PPTAB) 0077000 EQUIVALENCE (CPRECL,CPFCB(1)) 00780 EQUIVALENCE (CPFIND,CPFCB(6)) 00790 EQUIVALENCE (CPLEN1,CPFCB(15)) 00800 EQUIVALENCE (CPPOS1,CPFCB(16)) 00810 BYTE (IDEL,ISTAT(4=4)) 00820. 00830C 0084000C FILE CONTROL BLOCK 00850C 00860 EQUIVALENCE (RECLEN,FCBBUF(1)) 00870 EQUIVALENCE (TDATRM,FCBBUF(2)) 00880 EQUIVALENCE (TDATRL,FCBBUF(3)) 00890 EQUIVALENCE (DATBAM,FCBBUF(4)) 00900 EQUIVALENCE (DATBAL,FCBBUF(5)) 0091000 EQUIVALENCE (FCBIND,FCBBUF(6)) 00920 EQUIVALENCE (NEDATM,FCBBUF(7)) 00930 EQUIVALENCE (NEDATL,FCBBUF(8)) 00940 EQUIVALENCE (NEXTBM,FCBBUF(9)) 00950 EQUIVALENCE (NEXTBL,FCBBUF(10)) 00960 EQUIVALENCE (TNKEYM,FCBBUF(11)) 00970 EQUIVALENCE (TNKEYL,FCBBUF(12)) 0098000 EQUIVALENCE (KEYBAM,FCBBUF(13)) 00990 EQUIVALENCE (KEYBAL,FCBBUF(14)) 01000 EQUIVALENCE (LENKY1,FCBBUF(15)) 01010 EQUIVALENCE (POSKY1,FCBBUF(16)) 01020 EQUIVALENCE (LENKY2,FCBBUF(17)) 01030 EQUIVALENCE (LENKY3,FCBBUF(19)) 01040 EQUIVALENCE (LENKY4,FCBBUF(21)) 0105000 EQUIVALENCE (TSFILM,FCBBUF(23)) 01060 EQUIVALENCE (TSFILL,FCBBUF(24)) 01070 EQUIVALENCE (NAME12,FCBBUF(25)) 01080 EQUIVALENCE (OWNR12,FCBBUF(29)) 01090 EQUIVALENCE (EXPDAT,FCBBUF(89)) 01100 EQUIVALENCE (CRTDAT,FCBBUF(92)) 01110 EQUIVALENCE (FTYPE,FCBBUF(95)) 0112000C 01130C EXTERNALS 01140C 01150 EXTERNAL WTREAD 01160 EXTERNAL SYSMSG 01170 EXTERNAL OPENFL 01180 EXTERNAL GETFCB 0119000C 01200C 01210 BYTE (IFND,PPTEMP(15=15)) 01220 BYTE (IREQ,PPTEMP(12=12)) 01230 BYTE (IPNAM,PPTEMP(7=0)) 01240C 01250 BYTE (OPN,ISTAT(0=0)) 0126000 BYTE (NFD,ISTAT(1=1)) 01270 BYTE (LOK,ISTAT(2=2)) 01280 BYTE (IRLOK,ISTAT(3=3)) 01290 BYTE (INUNK,ISTAT(4=4)) 01300 BYTE (MME,ISTAT(5=5)) 01310 BYTE (IEOF,ISTAT(8=8)) 01320 BYTE (IWKY,ISTAT(9=9)) 0133000 BYTE (IFE,ISTAT(10=10)) 01340 BYTE (MFOS,ISTAT(11=11)) 01350 BYTE (MFO,ISTAT(12=12)) 01360 BYTE (IOUT,ISTAT(12=12)) 01370 BYTE (WVL,ISTAT(13=13)) 01380 BYTE (ILR,ISTAT(14=14)) 01390C 0140000 DATA NAME/'FILE-NAME 1=VOLUME-NAME=FILE-NAME 2=OWNER-NAME =VOLUME- 01410 *NAME='/ 01420 DATA NOCUR/-1/,ZRO/0/ 01430 DATA BUFLEN/40/ 01440 DATA BLANK/$2020/ 01450 DATA QUEST/'? '/ 01460C ************************************************************* 122*4868 0147000 DATA BUFSIZ/4000/ 01480 DATA SECLEN/96/ 01490 DIMENSION ISAVB1(10),ISAVB2(10) 01500 INTEGER ONE(2) 01510 DATA ONE/0,1/ 01520C*** 01530C ************************************************************* 122*4868 0154000. 01550C 01560C INITIALISATION 01570C 01580 IFTSW=0 01590 11 INDEX=0 01600+ ERROR MSG NO. 0161000 ERBUF=0 01620+ ERROR MSG BUF 01630 ISTAT=0 01640+ STATUS OF FM-REQUEST 01650 LNGO=0 01660+ LENGTH OF FIELD TO MOVE 01670 MORPAR=0 0168000+ INDICATOR IF MORE PARAMETERS NEEDED 01690 MORLIN=0 01700+ INDICATOR IF MORE LINES NEED TO BE READ 01710 PARNUM=0 01720+ COUNT OF REQ.AND NOT FOUND PARAMETERS 01730 PARID=0 01740 IFLAG=0 0175000 IP=1 01760C ************************************************************* 122*4868 01770 ASSEM $E0E9,$E21F,$C20D,$6800,IFMDEL 01780C *********************'*************************************** 122*4868 01790C 01800 ASSIGN 9998 TO INTLOC 01810 CALL PGMINT(INTLOC,IFLAG) 0182000C 01830C 01840C 01850 20 DO 30 I=1,24 01860 REQBUF(I)=0 01870 CPREQ(I)=0 01880C 0189000 30 CONTINUE 01900C 01910C 01920C SET UP DEFAULT VALUE FOR NO. OF RECORD TO BE PROCESSED 01930C 01940C 01950C 0196000C SET UP OPEN FILE CONDITION ACCORDINGLY 01970C 01980 ASSEM $C000,+FCBHDR 01990 ASSEM $6400,+REQBUF(10) 02000 ASSEM $C000,+CPHDR 02010 ASSEM $6800,CPREQ(10) 02020 REQBUF(13) = 96 0203000 CPREQ (13) = 96 02040 IDATA (13) = 0 02050 CPDAT (13) = 0 02060 IDATA (14) = 1 02070 CPDAT (14) = 1 02080 IDATA (15) = -2 02090 CPDAT (15) = -2 0210000C 02110 CALL OPENFL(REQBUF,IDATA,ISTAT) 02120C 02130 CALL OPENFL(CPREQ,CPDAT,ISTAT) 02140 450 CPVOL=CPDAT(9) 02150 IVOL=IDATA(9) 02160 IDATA(9)=0 0217000 CPDAT(9)=0 02180C 02190 CALL GETFCB (CPREQ,CPDAT(9),INDEX,CPFCB,ISTAT) 02200 IF (IOUT-1) 460,8000,8000 02210 460 IF(ISTAT) 8010,470,470 02220C 02230 470 CALL GETFCB (REQBUF,IDATA(9),INDEX,FCBBUF,ISTAT) 0224000 IF ( (IOUT .EQ. 1) .OR. (ISTAT .LT. 0) ) GO TO 8000 02250 CALL CLOSFL (REQBUF,ISTAT) 02260 IF (ISTAT) 8000,500,500 02270C 02280 500 CALL CLOSFL (CPREQ,ISTAT) 02290 IF(ISTAT) 8010,510,510 02300C 0231000 510 IDATA(9)=IVOL 02320 CPDAT(9)=CPVOL 02330C ************************************************************* 122*4864 02340C IF NO USER ID PARAMETER WAS ENTERED, MAKE THE ID COMMON 02350C 02360C ************************************************************* 122*4864 02370C 0238000C CHECK IF BOTH FILE-TYPES ARE EQUAL 02390C 02400 IF (RECLEN .NE. CPRECL) GO TO 8220 02410C **************************************************************122*4868 02420 IF(RECLEN .GT. BUFSIZ) GO TO 8240 02430C *********************'*******************************'******* 122*4868 02440C 0245000 IPWIND=AND(FCBIND,$1) 02460 CPWIND=AND(CPFIND,$1) 02470C 02480 IF (CPWIND .NE. IPWIND) GO TO 8230 02490 IF(FTYPE .NE. CPFCB(95)) GO TO 8230 02500C 02510C ASSURE FILE'S SECTOR ALIGNMENTS ARE IDENTICAL 0252000C 02530 IF (AND(FCBIND,$8000) .NE. AND(CPFIND,$8000)) GO TO 8230 02540C 02550C ASSURE KEY DEFINITIONS ARE IDENTICAL 02560C 02570 DO 512 I = 15,22 02580 IF (FCBBUF(I).NE.CPFCB(I)) GO TO 8230 0259000 512 CONTINUE 02600 IF (FCBBUF(6).NE.CPFCB(6)) GO TO 8230 02610C 02620C 02630 ASSEM $C000,+FCBHDR 02640 ASSEM $6400,+REQBUF(10) 02650 ASSEM $C000,+CPHDR 0266000 ASSEM $6800,CPREQ(10) 02670 REQBUF(13) = 96 02680 CPREQ (13) = 96 02690 CALL OPENFL( REQBUF(1), IDATA(1), ISTAT) 02700 IF (ISTAT .LT. 0) GO TO 8000 02710 CALL OPENFL(CPREQ(1), CPDAT(1), ISTAT) 02720 IF (ISTAT .LT. 0) GO TO 8010 0273000C 02740C TRANSFER THE FILE'S RECORD SPACE FIRST 02750C 02760C SAVE FIRST 10 WORDS OF EACH FILE'S FCB 02770C 02780 515 CONTINUE 02790 DO 520 I = 1,10 0280000 ISAVB1(I) = FCBBUF(I) 02810 520 ISAVB2(I) = CPFCB(I) 02820C 02830C SET NUMBER OF RECORDS FOR READ 02840C 02850 NUMREC = BUFSIZ / RECLEN 02860C 0287000C** CALCULATE SECTOR ALIGNED BLOCKING IF NEEDED 02880C 02890 IF (AND(FCBIND ,$8000) .EQ. 0) GO TO 521 02900 NUMSEC = RECLEN / SECLEN 02910 IF ( (NUMSEC * SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 02920 NUMREC = BUFSIZ / (SECLEN * NUMSEC) 02930 521 CONTINUE 0294000 CPREQ(13) = NUMREC 02950C 02960C REDEFINE BOTH FILES AS SEQUENTIAL - IF INDEXED 02970C 02980 FCBBUF(6) = AND($FFFE,FCBBUF(6)) 02990 CPFCB(6) = AND($FFFE,CPFCB(6)) 03000C 0301000C TRANSFER RECORDS TILL EOF REACHED 03020C 03030 IDONE = 0 03040 525 CALL GETS(CPREQ,RECBUF,KEYVAL,ISTAT) 03050 NUMOUT = CPREQ(15) 03060 IF (IEOF .NE. 0) GO TO 540 03070 IF (ISTAT)8010,530,530 0308000C 03090 530 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) 03100 IF (ISTAT) 8000,535,535 03110 535 IF (IOUT .NE. 1) GO TO 525 03120 537 CONTINUE 03130 INDEX = 55 03140 GO TO 9999 0315000C 03160C EOF FOUND 03170C 03180 540 IF (ISTAT.LT. 0) GO TO 550 03190 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) 03200 IF (ISTAT) 8000,545,545 03210 545 CONTINUE 0322000 IF (IOUT .EQ. 1) GO TO 537 03230C 03240C CHECK IF FILES ARE INDEXED, IF YES, COPY INDEX SPACE 03250C 03260 550 IF (IPWIND.EQ.0) GO TO 9998 03270C 03280C REDEFINE FCBS TO HAVE 3 SECTOR LONG RECORDS, RECORD SPACE STARTING 0329000C AT INDEX SPACE, TOTAL NUMBER OF RECORDS EQUAL TO TOTAL NUMBER 03300C OF KIBS AND EXISTING NUMBER OF RECORDS IN INPUT FILE TO NUMBER OF 03310C KIBS USED. 03320C 03330 FCBBUF(1) = 288 03340 FCBBUF(2) = FCBBUF(11) 03350 FCBBUF(3) = FCBBUF(12) 0336000 FCBBUF(4) = FCBBUF(13) 03370 FCBBUF(5) = FCBBUF(14) 03380 FCBBUF(7) = 0 03390 FCBBUF(8) = 0 03400 CPFCB(1) = 288 03410 CPFCB(2) = CPFCB(11) 03420 CPFCB(3) = CPFCB(12) 0343000 CPFCB(4) = CPFCB(13) 03440 CPFCB(5) = CPFCB(14) 03450 CALL FDWSUB (CPFCB(09),ONE,CPFCB(7),ISTAT) 03460C 03470C SET NUMBER OF RECORDS FOR I/O 03480C 03490 NUMREC = BUFSIZ / 288 0350000 CPREQ(13) = NUMREC 03510C 03520C INITIALIZE CPREQ FOR NEW GETS CALLS 03530C 03540 DO 555 I = 15,20 03550 555 CPREQ(I) = 0 03560C 0357000C TRANSFER KIBS TILL EOF REACHED 03580C 03590 560 CALL GETS (CPREQ,RECBUF,KEYVAL,ISTAT) 03600 NUMOUT = CPREQ(15) 03610 IF (IEOF .NE. 0) GO TO 575 03620 IF (ISTAT) 700,565,565 03630C 0364000 565 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) 03650 IF (ISTAT) 705,570,570 03660 570 IF (IOUT .NE. 1) GO TO 560 03670 GO TO 590 03680C 03690C EOF FOUND 03700C 0371000 575 IF (ISTAT.LT.0) GO TO 710 03720 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) 03730 IF (ISTAT) 705,580,580 03740 580 IF (IOUT .NE. 1) GO TO 710 03750 590 CONTINUE 03760 INDEX = 55 03770 IDONE = 3 0378000 GO TO 710 03790C 03800C 03810C ERROR NOTED ON FM CALL - INPUT FILE 03820C 03830 700 IDONE = 1 03840 GO TO 710 0385000C 03860C ERROR NOTED ON FM CALL - OUTPUT FILE 03870C 03880 705 IDONE = 2 03890C 03900C RESTORE INPUT FILE 03910C 0392000 710 DO 715 I = 1,10 03930 715 CPFCB(I) = ISAVB2(I) 03940C 03950C RESTORE FIRST PART OF OUTPUT FILE FCB 03960C 03970 DO 720 I = 1,8 03980 720 FCBBUF(I) = ISAVB1(I) 0399000C 04000C PROCESS ERROR IF REQUIRED 04010C 04020 GO TO ( 725,8010,8000,9999),IDONE + 1 04030C 04040C SET UP OUTPUT FILE'S FCB 04050C 0406000 725 CONTINUE 04070 DO 730 I = 7,10 04080 730 FCBBUF(I) = CPFCB(I) 04090 GO TO 9998 04100C 04110C 04120C FM-REQUEST TERMINATED WITH AN ERROR 0413000C 04140C 04150C********** CLOSE FILE AND NO ERROR CHECK , DUE TO ERROR 04160C 04170 8000 CONTINUE 04180 CALL CLOSFL( REQBUF(1), IP) 04190 GO TO 9993 0420000C 04210 8220 INDEX=65 04220+ 65 RECORD LENGTH NOT EQUAL 04230 GO TO 9999 04240 8230 INDEX=66 04250+ 66 FILE TYPE NOT EQUAL 04260 GO TO 9999 0427000C 04280C ************************************************************* 122*4868 04290 8240 INDEX=64 04300+ 64 RECORD LENGTH TOO LARGE 04310 GO TO 9999 04320C 04330C ************************************************************* 122*4868 0434000 8010 CONTINUE 04350 CALL CLOSFL( CPREQ(1), IP) 04360 GO TO 9993 04370C 04380C ERROR ROUTINE 04390C 04400 9999 CALL SYSMSG (INDEX,ERBUF) 0441000C 04420 9993 IF (PIND) 9994,9994,11 04430 9994 IF (MODE) 9995,9998,9995 04440 9995 ASSEM $E400,+MODE 04450 ASSEM $D622 04460C 04470 9998 CALL CLOSFL(REQBUF,ISTAT) 0448000 9996 CALL CLOSFL (CPREQ,ISTAT) 04490 9997 RETURN 04500 END 04510_ 00 00 00 00 00 00 00 __ 0( TFCSYLODLIBRARY P 012681060381(0 PROGRAM CSYLOD 00010 INTEGER TAPFND,FNAME(4),RQBUF(24),MSG(4) 00020 DATA MSG / $0D0A, ' DONE '/ 00030 CALL GETNAM ( FNAME ) 00040 CALL OPEN ( RQBUF, FNAME ) 00050 CALL TAPFND ( FNAME(2) ) 00060 CALL CPYDCK ( RQBUF ) 0007000 CALL CLOSFL ( RQBUF, ISTAT ) 00080 CALL WTREAD ( 5, -1, MSG, 8, -1, 0, 0, ITC ) 00090 CALL PGMOUT 00100 END 00110 SUBROUTINE CPYDCK ( RQBUF ) 00120 INTEGER RQBUF(24), BUFFER( 2402 ) 00130 MREC = 2400/40 0014000 LIMU = 40* ( MREC -1 ) +1 00150 10 DO 15 I= 1, LIMU, 40 00160 CALL GETCRD( BUFFER(I) ) 00170 IF( BUFFER(I) .EQ. $5F80 ) GO TO 20 00180 15 CONTINUE 00190 CALL PUTS( RQBUF, BUFFER, MREC, ISTAT ) 00200 GO TO 10 0021000 20 NREC = (I+39)/40 -1 00220 IF( NREC .NE. 0 ) CALL PUTS( RQBUF, BUFFER, NREC, ISTAT ) 00230 BUFFER(1) = $5F82 00240 DO 21 I = 2, 800 00250 21 BUFFER(I) = $2020 00260 CALL PUTS( RQBUF, BUFFER, 20, ISTAT ) 00270 RETURN 0028000 END 00290 SUBROUTINE GETNAM( NAME ) 00300 INTEGER NAME(4),MODE,T,BUFFER(20),M1(25),M2(25),M3(25),BLANK 00310 INTEGER RUBOUT, ICLR(7) 00320 DATA T/'T '/ , RUBOUT/4/ 00330 DATA M1 / 'ENTER PROGRAM NAME: '/ 00340 DATA M2 / 'ENTER PROGRAM MODE: '/ 0035000 DATA ICLR /$1820, ' COSY LOADER'/ 00360 DATA BLANK /' '/ 00370 CALL WTREAD( 5, -1, ICLR, 14, -1, 0, 0, ITC ) 00380 CALL SET ( BLANK, BUFFER, 20 ) 0039010 CALL WTREAD ( 5, 2, M1, 25, -1, BUFFER, 20, ITC ) 00400 IF ( ITC .EQ. RUBOUT ) GO TO 10 00410 CALL MOVE ( BUFFER, NAME(2), 3 ) 004200020 CALL SET ( BLANK, BUFFER, 20 ) 00430 CALL WTREAD ( 5, 4, M2, 25, -1, BUFFER, 20, ITC ) 00440 IF( ITC .EQ. RUBOUT ) GO TO 20 00450 NAME(1) = T + BUFFER(1)/$100 -$20 00460 RETURN 00470 END 00480 SUBROUTINE OPEN( RQBUF, FNAME ) 0049000 INTEGER RQBUF(24),FNAME(4),FDATA(15) 00500 DATA FDATA/12*0, 0, 1, -1 / 00510 CALL PGMIN( FDATA(5), LUNIT, MODE, NPORT ) 00520 CALL MOVE( FNAME, FDATA, 4) 00530 CALL SET( 0, RQBUF, 24 ) 00540 CALL OPENFL( RQBUF, FDATA, ISTAT ) 00550 IF( ISTAT .GE. 0 ) RETURN 0056000 RQBUF(1) = ISTAT 00570 CALL MOVE( FDATA, RQBUF(2), 12 ) 00580 CALL SYSMSG( 19, RQBUF ) 00590 CALL PGMOUT 00600 END 00610 SUBROUTINE GETCRD( BUFFER ) 00620 INTEGER BUFFER(40),CHAR,GETC,EODCK,FLAG 0063000 INTEGER MSG(16) 00640 DATA MSG / 'INPUT LINE EXCEEDS 80 CHARACTERS' / 006502 00660C BLANK BUFFER 006701 00680 CALL SET ( $2020, BUFFER, 40 ) 006901 0070000C SET POINTER 007101 00720 IPT = 0 007301 00740C GET ID BYTE AND DISCARD 007501 00760 ID = GETC(0) 0077000 IF( ID .EQ. $5F ) GO TO 100 007801 00790 10 IF( IPT .GT. 80 ) GO TO 200 00800 CHAR = GETC(0) 00810 IF( CHAR .EQ. $5F ) GO TO 100 00820 IPT = IPT + 1 00830 CALL PUTC( CHAR, BUFFER, IPT ) 0084000 GO TO 10 008502 00860 100 CHAR = GETC(0) 00870C CHECK FOR END OF DECK 00880 IF( CHAR .NE. $5F ) GO TO 110 00890 BUFFER( 1 ) = $5F80 00900 RETURN 00910001 00920 110 IF( CHAR .NE. $5E ) GO TO 120 00930 RETURN 009401 00950 120 IF( CHAR .NE. $20 ) GO TO 130 00960 IPT = IPT + 1 00970 CALL PUTC( $5F, BUFFER, IPT ) 0098000 GO TO 10 009901 01000 130 NBL = CHAR -$20 01010 IF( NBL .GE. 6 ) NBL = NBL - 1 01020 IPT = IPT + NBL + 2 01030 GO TO 10 010402 0105000 200 CALL WTREAD( 5, -1, MSG, 32, -1, 0, 0, ITC ) 01060 CALL PGMOUT 010702 01080 END 01090 INTEGER FUNCTION GETC(IDUM) 01100 COMMON /LABEL/ BUFFER,POINTR 01110 INTEGER BUFFER(192),POINTR 0112000 DATA POINTR /385/ 01130 IF( POINTR .LE. 2*192) GO TO 10 01140 MTSTAT = MPREDX( $1006, BUFFER, 192 ) 01150 POINTR = 1 0116010 GETC = IGETC(BUFFER, POINTR) 01170 POINTR = POINTR + 1 01180 RETURN 0119000 END 01200 SUBROUTINE TAPFND( NAME ) 01210 COMMON /LABEL/ BUFFER, POINTR 01220 INTEGER BUFFER(192),NAME(3),COMPAR,POINTR 01230 INTEGER END(3),FLAG,ICSY(3) 01240 DATA END/' END/'/,FLAG/0/,ICSY/' CSY/ '/ 012501 MSTATS= MPREDX($1006,BUFFER, 41) 0126000 IF(AND($4000,MSTATS).EQ.0)GOTO 1 01270* IF(COMPAR(BUFFER(3),ICSY,3).NE.1)GOTO 1 01280 IF( COMPAR(BUFFER,NAME,3) .EQ. 0 )GOTO 100 01290 IF(COMPAR(BUFFER(4),END,3).NE.0)GOTO 1 01300 IF(FLAG.EQ.1)CALL NOTFND 01310 FLAG=1 01320 CALL MPMOTN(6,$3000) 0133000 GOTO 1 01340100 POINTR=385 01350 RETURN 01360 END 01370 SUBROUTINE NOTFND 01380 INTEGER MSG(11),CRLF 01390 DATA MSG/ ' NAMED DECK NOT FOUND'/,CRLF/$0A0D/ 0140000 MSG(1)=CRLF 01410 CALL WTREAD(5,-1,MSG,22,0,0,0,0) 01420 CALL PGMOUT 01430 END 01440 MON 01450*ASSEM 01460 NAM MOVE WORD MOVE ROUTINE 0147000 ENT MOVE 01480MOVE NUM 0 01490 STQ* SQ 01500 ENQ 2 01510PLOOP LDA* (MOVE),Q 01520 STA* PBUF,Q 01530 DQP *-PLOOP 0154000 LDA* MOVE 01550 INA 3 01560 STA* MOVE 01570 LDQ* (ACOUNT) 01580 INQ -1 01590 SQM EXIT SKIP IF NO MOVE TO DO 01600MLOOP LDA* (ASORC),Q 0161000 STA* (ADEST),Q 01620 DQP *-MLOOP 01630EXIT LDQ* SQ 01640 JMP* (MOVE) 01650 SPC 2 01660PBUF EQU PBUF(*) 01670ASORC NUM 0 ADDRESS OF SOURCE 0168000ADEST NUM 0 ADDRESS OF DESTINATION 01690ACOUNT NUM 0 ADDRESS OF COIUNT 01700SQ NUM 0 Q SAVE WORD 01710 SPC 1 01720 END 01730 NAM SET AREA PRESET ROUTINE 01740 ENT SET 0175000SET NUM 0 ENTRY POINT 01760 STQ* SQ 01770 ENQ 2 01780PLOOP LDA* (SET),Q 01790 STA* PBUF,Q 01800 DQP *-PLOOP 01810 LDA* SET 0182000 INA 3 01830 STA* SET 01840 LDQ* (ACOUNT) 01850 INQ -1 01860 SQM EXIT 01870 LDA* (ASORC) 01880SLOOP STA* (ADEST),Q 0189000 DQP *-SLOOP 01900EXIT LDQ* SQ 01910 JMP* (SET) 01920 SPC 1 01930PBUF EQU PBUF(*) 01940ASORC NUM 0 01950ADEST NUM 0 0196000ACOUNT NUM 0 01970SQ NUM 0 01980 SPC 1 01990 END 02000 NAM COMPAR STRING COMPARE FUNCTION 02010 ENT COMPAR 02020COMPAR NUM 0 0203000 STQ* SQ 02040 ENQ 2 02050PLOOP LDA* (COMPAR),Q 02060 STA* PBUF,Q MOVE PARAMETER LIST 02070 DQP *-PLOOP 02080 LDA* COMPAR 02090 INA 3 0210000 STA* COMPAR 02110 LDQ* (ACOUNT) 02120 INQ -1 02130CLOOP LDA* (ASTRG1),Q COMPARE STRINGS 02140 EOR* (ASTRG2),Q 02150 SAN NOCOMP 02160 DQP *-CLOOP 0217000 JMP* EXIT 02180NOCOMP ENA 1 NO COMPARE RETURN A=1 02190EXIT LDQ* SQ 02200 JMP* (COMPAR) 02210 SPC 1 02220PBUF EQU PBUF(*) 02230ASTRG1 NUM 0 0224000ASTRG2 NUM 0 02250ACOUNT NUM 0 02260SQ NUM 0 02270 SPC 1 02280 END 02290 NAM PUTC CHARACTER PUT ROUTINE 02300 ENT PUTC 0231000PUTC NUM 0 02320 STQ* SQ SAVE Q 02330 ENQ 2 GET PARAMETERS 02340PLOOP LDA* (PUTC),Q 02350 STA* PBUF,Q 02360 DQP *-PLOOP 02370 LDA* PUTC 0238000 INA 3 02390 STA* PUTC 02400 LDQ* (APOS) 02410 INQ -1 CONVERT TO ZERO BASE 02420 LDA* (ASORC) 02430 SCA* (ASTR),Q 02440 LDQ* SQ 0245000 JMP* (PUTC) 02460 SPC 1 02470PBUF EQU PBUF(*) 02480ASORC NUM 0 02490ASTR NUM 0 02500APOS NUM 0 02510SQ NUM 0 0252000 SPC 1 02530 END 02540 NAM IGETC 02550 ENT IGETC 02560 EQU ZERO(2) 02570IGETC NUM 0 02580 STQ* SQ 0259000 LDA* (IGETC) 02600 RAO* IGETC 02610 LDQ* (IGETC) 02620 RAO* IGETC 02630 LDQ- (ZERO),Q 02640 INQ -1 02650 LCA- (ZERO),Q,A 0266000 LDQ* SQ 02670 JMP* (IGETC) 02680SQ NUM 0 02690 END 02700_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2w 2TFDATTIMLIBRARY P^999999060381(0 SUBROUTINE DATTIM(DATM) 00010 + /DATE & TIME AREA TRANSFER 000202 00030C DATTIM - DATE/TIME AREA BLOCK TRANSFER. 000401 00050C RETURN THE 12 WORD BLOCK OF DATE/TIME INFORMATION FROM THE 00060C EXTENDED CORE TABLE. 0007000C 00080C WORD 1 - AYERTO, CURRENT YEAR (ASCII) 00090C WORD 2 - AMONTO, CURRENT MONTH (ASCII) 00100C WORD 3 - ADAYTO, CURRENT DAY (ASCII) 00110C WORD 4 - YERTO, CURRENT YEAR (INTEGER) 00120C WORD 5 - MONTO, CURRENT MONTH (INTEGER) 00130C WORD 6 - DAYTO, CURRENT DAY (INTEGER) 0014000C WORD 7 - HORTO, CURRENT HOUR (INTEGER) 00150C WORD 8 - MINT0, CURRENT MINUTE (INTEGER) 00160C WORD 9 - SECON, CURRENT SECOND (INTEGER) 00170C WORD 10 - CONTA, CURRENT COUNT (INTEGER) 00180C WORD 11 - HORMIN, CURRENT 24-HOUR TIME 00190C WORD 12 - TOTMIN, CURRENT DAY ELAPSED MINUTES 00200C 0021000C DATM - 12 WORD RECEIVING ARRAY 002202 00230 INTEGER DATM(12) 002401 00250 INTEGER ADR 002602 00270 ADR=MEMORY(MEMORY($00E9)+12) 0028000 DO 100 I=1,12 00290 DATM(I)=MEMORY(ADR) 00300 ADR=ADR+1 00310 100 CONTINUE 00320 RETURN 003301 00340 END 0035000_ 00 00 __ 0(x TTFDDSUBSLIBRARY P999999060381(0 SUBROUTINE CHKFDD 00010 + /PROCESS ENTIRE FDD 000202 00030C CHKFDD - PROCESS THE ENTIRE FILE DEFINITION DIRECTORY. 000401 00050C CHKFDD LOOPS THROUGH THE FDD AND PASSES EACH SECTOR TO *CHKFDB*. 000602 0007000 INTEGER ADR(2) 00080$$TXPRVBLK,LIBRARY 00090 N=VLNFDB/2 00100 CALL ZERO(FDDBIT,288) 00110 DO 100 I=1,256 00120 ALCFDV(I)=-1 00130 100 CONTINUE 00140001 00150 ADR(1)=VLFDD(1) 00160 ADR(2)=VLFDD(2) 00170 NFDB=0 00180 IX=64+1 00190 200 IF ( IX.LE.64 ) GOTO 220 00200 IF ( NFDB.GE.N ) RETURN 0021000 IFLAG=MMREAD(MMU,64*96,ADR,FCBBFR) 00220 IX=1 00230 220 IF ( NFDB.GE.N ) RETURN 00240 CALL CHKFDB(FCB(1,IX)) 00250 CALL FDWADD(ADR,ONE2,ADR,TC) 00260 IX=IX+1 00270 NFDB=NFDB+1 0028000 GOTO 200 002901 00300 END 00310 SUBROUTINE CHKFDB(REC) 00320 + /PROCESS A FDD SECTOR 003302 00340C CHKFDB - PROCESS A SECTOR OF THE FILE DEFINITION DIRECTORY. 00350001 00360C CHKFDB LOOPS THROUGH A SECTOR OF THE FDD AND PASSES EACH 9 WORD 00370C ENTRY TO *CHKDEF* FOR VALIDATION. 00380C 00390C *NOTE* OVERFLOW BLOCKS ARE READ IN OVER THE ORIGINAL 00400C SECTOR AREA ( *REC* ) 004102 0042000 INTEGER REC(96) 004301 00440 INTEGER ADR(2) 00450$$TXPRVBLK,LIBRARY 00460 INTEGER VLNXTB 00470 EQUIVALENCE (VLNXTB,VOL(34)) 004802 0049000 N=NFDB 00500 100 DO 200 I=2,85,9 00510 CALL CHKDEF(REC(I),N) 00520 200 CONTINUE 00530 NFDB=N 00540 IF ( REC(1).EQ.0 ) RETURN 00550 IF ( REC(1).GE.VLNXTB ) GOTO 300 0056000 M=REC(1)+1-VLNFDB/2 00570 IF ( ALCFDV(M).NE.-1 ) GOTO 310 00580 ALCFDV(M)=N 00590 ADR(1)=0 00600 ADR(2)=REC(1) 00610 CALL FDWADD(ADR,VLFDD,ADR,TC) 00620 CALL FDWSUB(ADR,ONE2,ADR,TC) 0063000 NFDB=ADR(2)-VLFDD(2) 00640 IFLAG=MMREAD(MMU,96,ADR,REC) 00650 GOTO 100 006601 00670 300 WRITE (12,9000) NFDB, REC(1) 00680 RETURN 006901 0070000 310 WRITE (12,9001) NFDB, REC(1), ALCFDV(M) 00710 RETURN 007201 00730 9000 FORMAT(' FDB $',Z4,' INDEXES UNALLOCATED OVF BLOCK $',Z4) 00740 9001 FORMAT(' FDB $',Z4,' INDEXES MULTI-USED OVF BLOCK $',Z4, 00750 + ' PREVIOUS REFERENCE FDB $',Z4) 007601 0077000 END 00780 SUBROUTINE CHKDEF(REC,NORG) 00790 + /VALIDATE SINGLE FDD ENTRIES 008002 00810C CHKDEF - VALIDATE SINGLE FILE DEFINITION DIRECTORY ENTRIES. 008201 00830C CHECK THE FILENAME/OWNERNAME WITH THE ASSOCIATED FCB. 0084000C CHECK THE HASH 00850C CHECK FOR SINGLE USE OF FCB-S 008602 00870 INTEGER REC(9), NORG 008801 00890 INTEGER ADR(2), BIT(16), LIST(16) 00900 DATA BIT /$8000,$4000,$2000,$1000,$0800,$0400,$0200,$0100, 0091000 + $0080,$0040,$0020,$0010,$0008,$0004,$0002,$0001 / 009201 00930 INTEGER VPC 00940$$TXPRVBLK,LIBRARY 00950 IFLAG=0 00960 DO 100 I=1,9 00970 IF ( REC(I).NE.0 ) IFLAG=1 0098000 100 CONTINUE 00990 IF ( IFLAG.EQ.0 ) RETURN 010001 01010 IFLAG=0 01020 DO 110 I=1,8 01030 IFLAG=AND(REC(I)+IFLAG,$7FFF) 01040 110 CONTINUE 0105000 I=VLNFDB/2 01060 IFLAG=IFLAG/I 01070 ASSEM $4400,+IFLAG 01080+ ; REMAINDER == INDEX 01090 IF ( IFLAG.NE.NORG ) GOTO 230 011001 01110 ADR(1)=0 0112000 ADR(2)=REC(9) 01130 CALL FDWADD(ADR,FCBADR,ADR,TC) 01140 IFLAG=MMREAD(MMU,96,ADR,HDR) 01150 IF ( HDR(1).EQ.0 ) GOTO 200 01160 DO 120 I=1,8 01170 IF ( REC(I).NE.HDR(I+24) ) GOTO 210 01180 120 CONTINUE 0119000 140 NP=1 + REC(9)/$10 01200 NB=AND(REC(9),$000F)+1 01210 IF ( AND(FDDBIT(NP),BIT(NB)).NE.0 ) GOTO 220 01220 FDDBIT(NP)=OR(FDDBIT(NP),BIT(NB)) 01230 RETURN 012401 01250 200 WRITE (12,9000) REC(9), NFDB 0126000 GOTO 300 012701 01280 210 WRITE (12,9001) REC(9), NFDB 01290 GOTO 300 013001 01310 220 WRITE (12,9002) REC(9), NFDB 01320 GOTO 300 01330001 01340 230 DO 231 I=1,8 01350 LIST(I)=VPC(REC(I)) 01360 231 CONTINUE 01370 WRITE (12,9005) NFDB, (REC(I), I=1,8), (LIST(I), I=1,8), REC(9) 01380 RETURN 013901 0140000 300 DO 310 I=1,8 01410 LIST(I)=VPC(REC(I)) 01420 LIST(I+8)=VPC(HDR(I+24)) 01430 310 CONTINUE 01440 WRITE (12,9003) (REC(I), I=1,8), (LIST(I), I=1,8) 01450 WRITE (12,9004) (HDR(I), I=25,32), (LIST(I), I=9,16) 01460 RETURN 01470001 01480 9000 FORMAT(' NO FCB FOR FDB ENTRY, NFCB = $',Z4,', NFDB = $',Z4) 01490 9001 FORMAT(' NAME/OWNER ERROR, NFCB = $',Z4,', NFDB = $',Z4) 01500 9002 FORMAT(' FDB MULTI-MARK, NFCB = $',Z4,', NFDB = $',Z4) 01510 9003 FORMAT(' FDD : ',8(X,Z4),2X,8A2) 01520 9004 FORMAT(' FCB : ',8(X,Z4),8X,8A2) 01530 9005 FORMAT(' FDD HASH ERROR, NFDD = $',Z4,X,8(X,Z4),2X,8A2,' $',Z4) 01540001 01550 END 01560_ 00 00 00 00 00 00 __ 0(d d*TFDEFILELIBRARY P:999999060381(0 PROGRAM DEFILE 000102 00020C DEFILE,,,<#RECORDS>, 000301 00040C COPYRIGHT CONTROL DATA CORPORATION 08/06/80 (CGODSO) 000502 00060 INTEGER ISTAT, PARM(4,4), VIT(23) 0007000 INTEGER REQBUF(24), IDATA(24) 00080 DATA REQBUF / 24*0 / 00090 DATA IDATA / ' ',' ','????????',80,11*0 / 00100 INTEGER MSG1(17), MSG4(11), MSG5(10), MSG6(12) 00110 DATA MSG1 / '????????/????????/???????? CREATED' / 00120 DATA MSG4 / 'NO FILE NAME SPECIFIED' / 00130 DATA MSG5 / 'INVALID RECORD COUNT' / 0014000 DATA MSG6 / 'FM ERROR - CREATE $????' / 001502 00160 ASSIGN 9999 TO ICTLD 00170 CALL PGMINT(ICTLD,0) 00180 CALL PGMIN(IDATA(5),IDUMMY,IDUMMY,IDUMMY) 00190 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 002001 0021000 CALL GETVIT(2,VIT) 00220 IF ( VIT(1).LT.0 ) CALL GETVIT(1,VIT) 00230 CALL CCSMVA(VIT(2),1,8,IDATA(9),1,8) 00240 CALL GTPARM(PARM,4) 00250 IF ( PARM(1,1).EQ.2H ) GOTO 130 00260 CALL CCSMVA(PARM(1,1),1,8,IDATA(1),1,8) 00270 IF ( PARM(1,2).NE.2H ) CALL CCSMVA(PARM(1,2),1,8,IDATA(9),1,8) 0028000 IPT=0 00290 IDATA(15)=ICNVRT(PARM(1,3),IPT,8,IFLAG) 00300 IF ( IFLAG.NE.0 ) GOTO 140 00310 IF ( IDATA(15).LT.0 ) GOTO 140 00320 IF ( IDATA(15).EQ.0 ) IDATA(15)=100 003301 00340 CALL CREATE(REQBUF,IDATA,ISTAT) 0035000 IF ( ISTAT.LT.0 ) GOTO 100 00360 CALL FILLIT(IDATA,PARM(1,4)) 00370 CALL CCSMVA(IDATA(1),1,8,MSG1(1),1,8) 00380 CALL CCSMVA(IDATA(5),1,8,MSG1(1),10,8) 00390 CALL CCSMVA(IDATA(9),1,8,MSG1(1),19,8) 00400 CALL WTREAD(5,-1,MSG1,34,-1,0,0,ITC) 00410 CALL PGMOUT 00420001 00430 100 CALL HEXASC(ISTAT,MSG6(11)) 00440 CALL WTREAD(5,-1,MSG6,24,-1,0,0,ITC) 00450 CALL PGMOUT 004601 00470 130 CALL WTREAD(5,-1,MSG4,22,-1,0,0,ITC) 00480 CALL PGMOUT 00490001 00500 140 CALL WTREAD(5,-1,MSG5,20,-1,0,0,ITC) 00510 CALL PGMOUT 005201 00530 9999 CALL PGMOUT 005401 00550 END 0056000_ 00 00 00 00 00 00 __ 0(d d*TFDEFSFLLIBRARY PX999999060381(0 SUBROUTINE DEFSFL 00010 + /DEFINE SORT FILE 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C DEFSFL - DEFINE THE INTERMEDIATE (SORT) FILE. 000601 0007000C DEFSFL CREATES A NEW INDEXED FILE TO BE USED TO SORT THE STATUS 00080C ENTRIES. THE KEY IS THE FIRST 16 BYTES OF THE RECORD. 00090$$TXSSPBLK 00100 INTEGER SFNAME(4), SYSVOL(4) 00110 DATA SFNAME / '@SSP@ ' / 00120 DATA SYSVOL / 'SYSVOL ' / 001302 0014000 CALL CCSMVA(SFNAME,1,8,IDATA,1,8) 00150 IDATA(3)=IDATA(3)+ISHIFT(NOPORT,8) 00160 CALL CCSMVA(USER,1,8,IDATA(5),1,8) 00170 CALL CCSMVA(SYSVOL,1,8,IDATA(9),1,8) 00180 CALL ZERO(REQBUF,24) 00190 CALL DELETE(REQBUF,IDATA,ISTAT) 00200+ ; DISCARD OLD FILE IF PRESENT 00210001 00220 CALL PAGE1 00230+ ; LIST BASIC INFO BEFORE CREATE 002401 00250 IDATA(13)=16+132+4 00260+ ; NUMBER OF BYTES PER RECORD 00270 IDATA(14)=0 0028000+ ; NO LOCKING 00290 IDATA(15)=VIT(17) 00300+ ; NR OF RECORDS = MAX NR FILES 00310 IF ( (NOPORT.EQ.00) .AND. (ONEID(3).EQ.-1) ) IDATA(15)=2*IDATA(15) 00320 IDATA(16)=$0001 00330+ ; INDEXED FILE 00340 IDATA(17)=16 0035000+ ; KEY 1 LENGTH 00360 IDATA(18)=1 00370+ ; KEY 1 STARTING POSITION 00380 CALL ZERO(IDATA(19),6) 00390 CALL ZERO(REQBUF,24) 00400 CALL CREATE(REQBUF,IDATA,ISTAT) 00410+ ; MAKE A GOOD NEW FILE 0042000 IF ( ISTAT.LT.0 ) CALL DSKERR(343) 004301 00440 CALL GETVIT(VOLUME(5),VIT) 00450+ ; IN CASE VOLUME IS 'SYSVOL' 00460 IDATA(13)=1 00470+ ; ACCESS BY PRIMARY KEY 00480 IDATA(14)=1 0049000+ ; ACCESS 1 RECORD PER FM REQUEST 00500 IDATA(15)=0 00510+ ; NO LOCKING 00520 CALL ZERO(REQBUF,24) 00530 CALL OPENFL(REQBUF,IDATA,ISTAT) 00540 IF ( ISTAT.LT.0 ) CALL DSKERR(344) 00550 CALL LHOLES 00560001 00570 RETURN 005801 00590 END 00600_ 00 00 00 00 00 00 __ 0(d d*TFDEL LIBRARY P999999060381(0 SUBROUTINE DEL 00010 + /CCS 2.0 $$USERID MANAGER DECK06 SUMMARY-*** 000202 00030C DEL - DELETE ENTRIES. 00040C 1. 00050C A SINGLE ENTRY UNIQUELY DEFINED BY THE USER IDENTIFIER 00060C AND TERMINAL PORT CODE; 0007000C 2. 00080C ALL ENTRIES FOR THIS USER IDENTIFIER. 000902 00100 INTEGER PMT0(11), PMT1(2), PMT2(9) 001101 00120 DATA PMT0 / ' DELETE ' / 00130 DATA PMT1 / 'ID: ' / 0014000 DATA PMT2 / 'TERMINAL CODE(*): ' / 00150$$WSUSRBLK 00160 CALL PROMPT(PMT0,-21,0,0) 00170 100 CALL PROMPT(2H ,2,0,0) 00180 CALL PROMPT(PMT1,3,CURID,8) 00190+ ; USER IDENTIFIER 00200 IF ( CURID(5).EQ.0 ) RETURN 0021000 DO 140 I=1,4 00220 UID(I)=CURID(I) 00230 140 CONTINUE 002401 00250 200 CALL PROMPT(PMT2,17,TX,2) 00260+ ; TERMINAL PORT CODE (*) 00270 IF ( TX(2).EQ.0 ) GOTO 100 0028000+ ; NO MORE FOR THIS USER ID 00290 IF ( (TX(1).EQ.1H* ) .AND. (TX(2).EQ.1) ) GOTO 300 003001 00310C DELETE A SINGLE ENTRY 003201 00330 IF ( VALTID(TX(1)).EQ.0 ) GOTO 200 00340 CURID(5)=TX(1) 0035000 CALL READR(REQBLK,USER,CURID,ISTAT) 00360 DO 210 I=1,4 00370 IF ( USER(I).NE.UID(I) ) GOTO 220 00380 210 CONTINUE 00390 IF ( USER(5).NE.TX(1) ) GOTO 220 00400 IF ( ISTAT.LT.0 ) CALL MSG(3) 00410 CALL MSG(0) 0042000 CALL DELREC(REQBLK,USER,ISTAT) 00430 IF ( ISTAT.LT.0 ) CALL MSG(5) 00440 GOTO 200 004501 00460 220 CALL MSG(10) 00470 DO 230 I=1,4 00480 CURID(I)=UID(I) 0049000 230 CONTINUE 00500 GOTO 200 005101 00520C DELETE ALL ACTIVE ENTRIES FOR THIS USER IDENTIFIER. 005301 00540 300 CALL MSG(12) 00550 ICNT=0 0056000 CURID(5)=2H00 00570+ ; MINIMAL TERMINAL PORT CODE 00580 CALL READR(REQBLK,USER,CURID,ISTAT) 00590 320 IF ( AND(ISTAT,EOFLAG ).EQ.EOFLAG ) GOTO 360 00600 IF ( ISTAT.LT.0 ) CALL MSG(3) 00610 DO 340 I=1,4 00620 IF ( USER(I).NE.UID(I) ) GOTO 360 0063000 340 CONTINUE 00640 ICNT=ICNT+1 00650 CALL MSG(0) 00660 CALL DELREC(REQBLK,USER,ISTAT) 00670 IF ( ISTAT.LT.0 ) CALL MSG(5) 00680 CALL GETS(REQBLK,USER,CURID,ISTAT) 00690 GOTO 320 00700001 00710C REPROMPT FOR NEXT USER IDENTIFIER 007201 00730 360 IF ( ICNT.EQ.0 ) CALL MSG(10) 00740 GOTO 100 007501 00760 END 0077000_ 00 00 00 __ 0($ iTFDELFILLIBRARY P4999999060381(0 PROGRAM DELFIL 000102 00020C DELFIL,[,[] 000301 00040C COPYRIGHT CONTROL DATA CORPORATION 03/24/81 (CGODSO) 000502 00060 INTEGER PARM(4,2), ISTAT, TC 0007000 INTEGER REQBUF(24), IDATA(12) 00080 DATA REQBUF / 24*0 / 00090 DATA IDATA / '????????','????????',' ' / 00100 INTEGER MSG1(17), MSG4(11), MSG5(26) 00110 DATA MSG1 / '????????/????????/???????? DELETED' / 00120 DATA MSG4 / 'NO FILE NAME SPECIFIED' / 00130 DATA MSG5 / 'FM ERROR - DELETE $????', 0014000 + ' ????????/????????/???????? ' / 00150 INTEGER B4000(13), B2000(10), B0020(10), B0002(9), B0001(7) 00160 DATA B4000 / $0D0A, 'FM DATA STRUCTURE ERROR ' / 00170 DATA B2000 / $0D0A, 'VOLUME NOT MOUNTED' / 00180 DATA B0020 / $0D0A, 'MASS MEMORY ERROR ' / 00190 DATA B0002 / $0D0A, 'FILE NOT LOCATED' / 00200 DATA B0001 / $0D0A, 'FILE IS OPEN' / 00210002 00220 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,TC) 00230 CALL PGMIN(IDATA(5),ISTAT,ISTAT,ISTAT) 00240 CALL GTPARM(PARM,2) 002501 00260 IF ( PARM(1,1).EQ.2H ) GOTO 200 00270+ ; NO FILE NAME 0028000 CALL CCSMVA(PARM(1,1),1,8,IDATA(1),1,8) 00290 CALL CCSMVA(PARM(1,2),1,8,IDATA(9),1,8) 003001 00310 CALL DELETE(REQBUF,IDATA,ISTAT) 00320 IF ( ISTAT.LT.0 ) GOTO 100 00330+ ; IF ERROR 00340 CALL CCSMVA(IDATA(1),1,8,MSG1,1,8) 0035000 CALL CCSMVA(IDATA(5),1,8,MSG1,10,8) 00360 CALL CCSMVA(IDATA(9),1,8,MSG1,19,8) 00370 CALL WTREAD(5,-1,MSG1,34,-1,0,0,TC) 00380 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 00390 CALL PGMOUT 004001 00410 100 CALL HEXASC(ISTAT,MSG5(11)) 0042000 CALL CCSMVA(IDATA(1),1,8,MSG5,26,8) 00430 CALL CCSMVA(IDATA(5),1,8,MSG5,35,8) 00440 CALL CCSMVA(IDATA(9),1,8,MSG5,44,8) 00450 CALL WTREAD(5,-1,MSG5,52,-1,0,0,TC) 00460 IF ( AND(ISTAT,$4000).NE.0 ) CALL WTREAD(5,-1,B4000,25,-1,0,0,TC) 00470 IF ( AND(ISTAT,$2000).NE.0 ) CALL WTREAD(5,-1,B2000,20,-1,0,0,TC) 00480 IF ( AND(ISTAT,$0020).NE.0 ) CALL WTREAD(5,-1,B0020,19,-1,0,0,TC) 0049000 IF ( AND(ISTAT,$0002).NE.0 ) CALL WTREAD(5,-1,B0002,18,-1,0,0,TC) 00500 IF ( AND(ISTAT,$0001).NE.0 ) CALL WTREAD(5,-1,B0001,14,-1,0,0,TC) 00510 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 00520 CALL PGMOUT 005301 00540 200 CALL WTREAD(5,-1,MSG4,22,-1,0,0,TC) 00550 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 0056000 CALL PGMOUT 005701 00580 END 00590_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( iTFDFINITLIBRARY P999999060381(0 SUBROUTINE DFINIT(FCB,VOL,MMADDR) 00010 + /INITIALIZE FOR DMPFCB 000202 00030C COPYRIGHT CONTROL DATA CORPORATION 08/16/80 (CGODSO) 000401 00050 INTEGER FCB(96), VOL(4), MMADDR(2) 000601 0007000 INTEGER FNAME(4), OWNER(4), SEL, VOLUME(4), TEMP(6), VIT(23) 00080 INTEGER TC, ZCNVRT, ICNVRT, HASH, NFCB, MMUNIT, VITADR, IDUMMY(2) 00090 INTEGER RUBOUT, QM(4), HEX(5), COMMA 00100 DATA RUBOUT / 4 / 00110 DATA QM / '????????' / 00120 DATA HEX / '$????,????' / 00130 DATA COMMA / $2C / 0014000 INTEGER MSG1(16), MSG2(5), MSG3(3), MSG4(4), MSG5(5), MSG6(4) 00150 DATA MSG1 / 'DMPFCB - DUMP FILE CONTROL BLOCK' / 00160 DATA MSG2 / 'FILE NAME:' / 00170 DATA MSG3 / 'OWNER:' / 00180 DATA MSG4 / 'VOLUME: ' / 00190 DATA MSG5 / 'FCB INDEX:' / 00200 DATA MSG6 / 'MM UNIT:' / 0021000 INTEGER MSG7(10), MSG8(7), MSG9(7) 00220 DATA MSG7 / 'FCB SECTOR ADDRESS: ' / 00230 DATA MSG8 / 'PHYSICAL UNIT:' / 00240 DATA MSG9 / 'SELECTION: [?]' / 00250 INTEGER MSG10(9), MSG11(7), MSG12(12), MSG13(4) 00260 DATA MSG10 / 'VOLUME NOT MOUNTED' / 00270 DATA MSG11 / 'FILE NOT FOUND' / 0028000 DATA MSG12 / 'ILLEGAL INPUT CHARACTER ' / 00290 DATA MSG13 / 'Z: EXIT ' / 00300 INTEGER FCFLAG, COMMA, COMMAS(2), LINE(42) 00310 DATA FCFLAG / 0 / 00320 DATA COMMA / 1R, / 00330 DATA COMMAS / ',,,,' / 00340 INTEGER SCAN, NLEN 00350002 00360 IF ( FCFLAG.LT.0 ) CALL PGMOUT 00370+ ; IF ONE TIME MODE USED UP 00380 CALL NFETCH(LINE,NLEN) 00390 CALL CCSMVA(COMMAS,1,4,LINE,NLEN+1,4) 00400 I0=0 00410 I1=SCAN(LINE,COMMA,I0,NLEN+4) 0042000 I2=SCAN(LINE,COMMA,I1,NLEN+4) 00430 I3=SCAN(LINE,COMMA,I2,NLEN+4) 00440 I4=SCAN(LINE,COMMA,I3,NLEN+4) 00450 IF ( I1-I0.GT.1 ) GOTO 600 004601 00470 CALL CLRSCR 00480 CALL DSPLA(1,11,MSG1,32) 00490001 00500 50 CALL DSPLA(4,1,2HA:,2) 00510 CALL DSPLA(4,4,MSG2,10) 00520 CALL DSPLA(4,15,QM,8) 00530 CALL DSPLA(5,4,MSG3,6) 00540 CALL DSPLA(5,11,QM,8) 00550 CALL DSPLA(6,4,MSG4,7) 0056000 CALL DSPLA(6,12,QM,8) 005701 00580 CALL DSPLA(8,1,2HB:,2) 00590 CALL DSPLA(8,4,MSG5,10) 00600 CALL DSPLA(8,16,HEX,5) 00610 CALL DSPLA(9,4,MSG6,8) 00620 CALL DSPLA(9,13,QM,1) 00630001 00640 CALL DSPLA(11,1,2HC:,2) 00650 CALL DSPLA(11,4,MSG7,19) 00660 CALL DSPLA(11,24,HEX,10) 00670 CALL DSPLA(12,4,MSG8,14) 00680 CALL DSPLA(12,19,QM,2) 006901 0070000 CALL DSPLA(14,1,MSG13,7) 007101 00720 100 SEL=2H 00730 CALL DSPLA(16,1,MSG9,14) 00740 TC=INPUT(16,13,SEL,1) 00750 CALL CLRLIN(18,1) 00760 IF ( TC.EQ.RUBOUT) GOTO 100 0077000 IF ( INPLEN(IDUMMY).EQ.0 ) GOTO 100 00780 IF ( SEL.EQ.2HA ) GOTO 200 00790 IF ( SEL.EQ.2HB ) GOTO 300 00800 IF ( SEL.EQ.2HC ) GOTO 400 00810 IF ( SEL.EQ.2HZ ) GOTO 900 00820 GOTO 100 008301 0084000 200 CALL CLRLIN(4,15) 00850 IF ( INPUT(4,15,FNAME,8).EQ.RUBOUT ) GOTO 200 00860 220 CALL CLRLIN(5,11) 00870 IF ( INPUT(5,11,OWNER,8).EQ.RUBOUT ) GOTO 220 00880 IF ( INPLEN(IDUMMY).NE.0 ) GOTO 230 00890 CALL PGMIN(OWNER,TC,TC,TC) 00900 CALL DSPLA(5,11,OWNER,8) 0091000 230 CALL CLRLIN(6,12) 00920 IF ( INPUT(6,12,VOLUME,8).EQ.RUBOUT ) GOTO 230 00930 IF ( INPLEN(IDUMMY).GT.0 ) GOTO 240 00940 231 DO 235 INDEX=1,8 00950 CALL GETVIT(INDEX,VIT) 00960 IF ( VIT(1).EQ.0 ) GOTO 235 00970 NFCB=HASH(FNAME,OWNER,VIT,IDUMMY) 0098000 IF ( NFCB.GE.0 ) GOTO 245 00990 235 CONTINUE 01000 GOTO 291 010101 01020 240 CALL SEKVIT(VOLUME,VITADR,INDEX) 01030 IF ( VITADR.EQ.0 ) GOTO 290 01040 CALL GETVIT(INDEX,VIT) 0105000 IF ( VIT(1).EQ.0 ) GOTO 290 01060 NFCB=HASH(FNAME,OWNER,VIT,IDUMMY) 01070 IF ( NFCB.LT.0 ) GOTO 291 01080 245 MMADDR(1)=0 01090 MMADDR(2)=NFCB 01100 CALL FDWADD(MMADDR,VIT(15),MMADDR,TC) 01110 VIT(18)=0 0112000 CALL FDWADD(MMADDR,VIT(18),MMADDR,TC) 01130 MMUNIT=AND(VIT(1),$7FFF) 01140 GOTO 500 011501 01160 290 IF ( FCFLAG.LT.0 ) GOTO 690 01170 CALL DSPLA(18,1,MSG10,18) 01180 GOTO 50 0119000 291 IF ( FCFLAG.LT.0 ) GOTO 691 01200 CALL DSPLA(18,1,MSG11,14) 01210 GOTO 50 012201 01230 300 CALL CLRLIN(8,16) 01240 TC=INPUT(8,16,TEMP,4) 01250 301 IF ( TC.EQ.RUBOUT ) GOTO 300 0126000 IF ( INPLEN(IDUMMY).EQ.0 ) GOTO 300 01270 IPT=0 01280 INX=ZCNVRT(TEMP,IPT,4,IFLAG) 01290 IF ( IFLAG.NE.0 ) GOTO 390 01300 310 TEMP(1)=2H 01310 CALL CLRLIN(9,13) 01320 TC=INPUT(9,13,TEMP,1) 0133000 311 IF ( TC.EQ.RUBOUT ) GOTO 310 01340 MMUNIT=0 01350 IPT=0 01360 IF ( TEMP(2).NE.0 ) MMUNIT=ICNVRT(TEMP,IPT,1,IFLAG) 01370 IF ( IFLAG.NE.0 ) GOTO 391 01380 CALL GETVIT(MMUNIT+1,VIT) 01390 IF ( VIT(1).EQ.0 ) GOTO 290 0140000 MMADDR(1)=0 01410 MMADDR(2)=INX 01420 CALL FDWADD(MMADDR,VIT(15),MMADDR,TC) 01430 VIT(18)=0 01440 CALL FDWADD(MMADDR,VIT(18),MMADDR,TC) 01450 MMUNIT=AND(VIT(1),$7FFF) 01460 GOTO 500 01470001 01480 390 CALL DSPLA(18,1,MSG12,23) 01490 CALL CLRLIN(8,16) 01500 TC=INPUT(8,16,TEMP,4) 01510 CALL CLRLIN(18,1) 01520 GOTO 301 015301 0154000 391 CALL DSPLA(18,1,MSG12,23) 01550 TEMP(1)=2H 01560 CALL CLRLIN(9,13) 01570 TC=INPUT(9,13,TEMP,1) 01580 CALL CLRLIN(18,1) 01590 GOTO 311 016001 0161000 400 CALL CLRLIN(11,25) 01620 TC=INPUT(11,25,TEMP,9) 01630 401 IF ( TC.EQ.RUBOUT ) GOTO 400 01640 IPT=0 01650 N1=ZCNVRT(TEMP,IPT,9,IFLAG) 01660 IF ( IFLAG.NE.0 ) GOTO 490 01670 CALL CCSGET(TEMP,IPT,ICH) 0168000 IF ( ICH.NE.COMMA ) GOTO 410 01690 N2=ZCNVRT(TEMP,IPT,9,IFLAG) 01700 IF ( IFLAG.NE.0 ) GOTO 490 01710 GOTO 420 017201 01730 410 N2=N1 01740 N1=0 0175000 420 CALL CLRLIN(12,19) 01760 TC=INPUT(12,19,TEMP,2) 01770 421 IF ( TC.EQ.RUBOUT ) GOTO 420 01780 IPT=0 01790 MMUNIT=ICNVRT(TEMP,IPT,2,IFLAG) 01800 IF ( IFLAG.NE.0 ) GOTO 491 01810 MMADDR(1)=N1 0182000 MMADDR(2)=N2 01830 MMUNIT=MMUNIT 01840 GOTO 500 018501 01860 490 CALL DSPLA(18,1,MSG12,23) 01870 CALL CLRLIN(11,25) 01880 TC=INPUT(11,25,TEMP,9) 0189000 CALL CLRLIN(18,1) 01900 GOTO 401 019101 01920 491 CALL DSPLA(18,1,MSG12,23) 01930 CALL CLRLIN(12,19) 01940 TC=INPUT(12,19,TEMP,2) 01950 CALL CLRLIN(18,1) 0196000 GOTO 421 019701 01980 500 TEMP(1)=0 01990 TEMP(2)=0 02000 CALL MMREAD(MMUNIT,96,TEMP,FCB) 02010 CALL CCSMVA(FCB(3),1,8,VOL,1,8) 02020 CALL MMREAD(MMUNIT,96,MMADDR,FCB) 0203000 RETURN 020401 02050 600 FCFLAG=-1 02060 M=I1-I0-1 02070 CALL CCSMVA(LINE,I0+1,M,FNAME,1,8) 02080 M=I2-I1-1 02090 CALL PGMIN(OWNER,IDUMMY,IDUMMY,IDUMMY) 0210000 IF ( M.GT.0 ) CALL CCSMVA(LINE,I1+1,M,OWNER,1,8) 02110 M=I3-I2-1 02120 CALL CCSBLK(VOLUME,8) 02130 IF ( M.LT.1 ) GOTO 231 02140 CALL CCSMVA(LINE,I2+1,M,VOLUME,1,8) 02150 GOTO 240 021601 0217000 690 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 02180 CALL WTREAD(5,-1,MSG10,18,-1,0,0,ITC) 02190 CALL PGMOUT 02200 691 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 02210 CALL WTREAD(5,-1,MSG11,14,-1,0,0,ITC) 02220 CALL PGMOUT 022301 0224000 900 CALL CLRSCR 02250 CALL FLUSH 02260 CALL PGMOUT 022701 02280 END 02290_ 00 00 00 __ 0( iTFDHOLE LIBRARY P 999999060381(0 SUBROUTINE DHOLE 00010 + /MOVE FILES DOWN 000202 00030C DHOLE - MOVE FILES DOWN 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 000601 0007000C REMOVE THE INTERNAL HOLES IN THE FILE MANAGER SPACE BY MOVING 00080C ALL FILES AFTER THE FIRST HOLE DOWN OVER THE FREE SPACE. 000902 00100 INTEGER MSG1(14) 00110 DATA MSG1 / $0D0A, 'MOVING ???????? ????????' / 00120 INTEGER ASDLEN, RECSIZ, NEWLOC(2), OLDLOC(2), DELTA(2) 00130 INTEGER IATADR(2), IATLEN, FIAT(288) 0014000+ ; 3*96 00150 INTEGER MOVLEN, DSKSEC(3), LWAHOL(2), MOVSEC(2) 00160 INTEGER BITS(16) 00170 DATA BITS / $8000,$4000,$2000,$1000,$0800,$0400,$0200,$0100, 00180 + $0080,$0040,$0020,$0010,$0008,$0004,$0002,$0001 / 001901 00200 INTEGER HOLSIZ(2), HOLADR(2) 0021000 EQUIVALENCE (HOLSIZ,DSKBFR(1)), (HOLADR,DSKBFR(3)) 00220 INTEGER DATBA(2), FILSIZ(2) 00230 EQUIVALENCE (DATBA,FCBBFR(4)) 00240 EQUIVALENCE (FILSIZ,HDRBFR(2)) 00250+ ; INCLUDES HEADER SECTOR 002601 00270 INTEGER VPC 0028000$$TXSQUBLK,LIBRARY 00290 IF ( CNT.EQ.0 ) RETURN 00300+ ; IF NO FILES TO BE MOVED 00310 ASDLEN=VLASDS*VLWPS 00320+ ; WORD LENGTH OF ASD 00330 IATLEN=3*VLWPS 00340+ ; WORD LENGTH OF FIAT 0035000 DSKSEC(1)=0 00360 DSKSEC(2)=LENDSK/VLWPS 00370 DSKSEC(3)=DSKSEC(2) 00380 IFLAG=MMREAD(MLU,ASDLEN,VLASD,DSKBFR) 00390+ ; READ ASD 004001 00410C FIAT SECTOR ADDRESS = (0,VLMAXF) + (0,VLNFDB) + (VLFDDM,VLFDDL) 0042000C ( FIAT IS THE FILE CONTROL BLOCK INDEX ALLOCATION TABLE ) 004301 00440 IATADR(1)=0 00450 IATADR(2)=VLMAXF 00460 CALL FDWADD(IATADR,VLFDD,IATADR,TC) 00470 TEMP(1)=0 00480 TEMP(2)=VLNFDB 0049000 CALL FDWADD(IATADR,TEMP,IATADR,TC) 00500 IFLAG=MMREAD(MLU,IATLEN,IATADR,FIAT) 00510+ ; READ FIAT 005201 00530C MAIN PROCESSING LOOP 00540C 00550C MOVE DOWN 1 FILE ON EACH ITERATION 00560001 00570 100 IF ( HOLSIZ(1).EQ.-1) RETURN 005801 00590C LOCATE NEXT FILE TO MOVE DOWN 006001 00610 CALL FDWADD(HOLSIZ,HOLADR,OLDLOC,TC) 00620+ ; FILE HEADER ADDRESS 0063000 IFLAG=MMREAD(MLU,VLWPS,OLDLOC,HDRBFR) 00640+ ; READ HEADER SECTOR 00650 CALL CHKHDR(OLDLOC,HDRBFR) 00660+ ; READ FCB AND CHECK WITH HEADER 006701 00680C DETERMINE MOVE LIMITS 006901 0070000 NEWLOC(1)=HOLADR(1) 00710+ ; NEW SECTOR ADDRESS FOR FILE 00720 NEWLOC(2)=HOLADR(2) 00730 DELTA(1)=HOLSIZ(1) 00740+ ; DISTANCE OF THE MOVE DOWN 00750 DELTA(2)=HOLSIZ(2) 00760 RECSIZ=RECLEN 0077000+ ; REMEMBER FILE RECORD SIZE 007801 00790C ENLARGE HOLE 008001 00810 RECLEN=0 00820+ ; MARK FCB NOT USED 00830 CALL FDWADD(HOLSIZ,FILSIZ,HOLSIZ,TC) 0084000+ ; ENLARGE THIS HOLE 00850 CALL FDWADD(HOLSIZ,HOLADR,LWAHOL,TC) 00860+ ; LWA+1 HOLE 00870 IF ( HOLSIZ(5).EQ.-1 ) GOTO 200 00880+ ; IF LAST HOLE 00890 IF ( (LWAHOL(1).NE.HOLADR(5)) 00900 + .OR.(LWAHOL(2).NE.HOLADR(6)) ) GOTO 200 0091000+ ; CAN'T COALESCE 00920 CALL FDWADD(HOLSIZ(1),HOLSIZ(5),HOLSIZ(1),TC) 00930+ ; COMBINED HOLE SIZE 00940 I=4 00950 120 DSKBFR(I+1)=DSKBFR(I+5) 00960 DSKBFR(I+2)=DSKBFR(I+6) 00970 DSKBFR(I+3)=DSKBFR(I+7) 0098000 DSKBFR(I+4)=DSKBFR(I+8) 00990 I=I+4 01000 IF ( DSKBFR(I+1).NE.-1 ) GOTO 120 010101 01020C INDICATE MOVE IN PROGRESS 010301 01040 200 DO 220 I=1,4 0105000+ ; PREPARE 'MOVING' MESSAGE 01060 MSG1(I+5)=VPC(FCBNAM(I)) 01070 MSG1(I+10)=VPC(FCBOWN(I)) 01080 220 CONTINUE 01090 CALL WTREAD(5,-1,MSG1,28,-1,0,0,ITC) 011001 01110C ADJUST FIAT 01120001 01130 NP= 1 + FCBINX/$10 01140+ ; FIAT WORD FOR THIS FCB INDEX 01150 NB= 1 + AND(FCBINX,$000F) 01160+ ; FIAT BIT FOR THIS FCB INDEX 01170 FIAT(NP)=EOR(FIAT(NP),BITS(NB)) 01180+ ; MARK FCB AVAILABLE 01190001 01200C MAKE THE FILE DISAPPEAR ( FOR DURATION OF RELOCATION ) 012101 01220 IFLAG=MMWRIT(MLU,IATLEN,IATADR,FIAT) 01230+ ; UPDATE FIAT 01240 IFLAG=MMWRIT(MLU,VLWPS,FCBLOC,FCBBFR) 01250+ ; UPDATE FCB 0126000 IFLAG=MMWRIT(MLU,ASDLEN,VLASD,DSKBFR) 01270+ ; UPDATE ASD 012801 01290C FILE MOVE DOWN LOOP 013001 01310 MOVSEC(1)=FILSIZ(1) 01320 MOVSEC(2)=FILSIZ(2) 0133000 MOVLEN=LENDSK 013401 01350 IFIXIT=1 01360 300 IF ( MOVSEC(1).GT.0 ) GOTO 320 01370+ ; DSKSEC(1) == ZERO 01380 IF ( MOVSEC(2).GE.DSKSEC(2) ) GOTO 320 01390 IF ( MOVSEC(2).LE.0 ) GOTO 340 0140000+ ; IF DONE WITH MOVE 014101 01420 MOVLEN=MOVSEC(2)*VLWPS 01430 DSKSEC(2)=MOVSEC(2) 014401 01450 320 IFLAG=MMREAD(MLU,MOVLEN,OLDLOC,DSKBFR) 01460+ ; PICK 'EM UP 0147000 IF ( IFIXIT.NE.1 ) GOTO 330 01480 DSKBFR(4)=NEWLOC(1) 01490 DSKBFR(5)=NEWLOC(2) 01500 IFIXIT=99 01510 330 IFLAG=MMWRIT(MLU,MOVLEN,NEWLOC,DSKBFR) 01520+ ; PUT 'EM DOWN 01530 CALL FDWADD(OLDLOC,DSKSEC,OLDLOC,TC) 0154000+ ; ADVANCE OLD ADDRESS 01550 CALL FDWADD(NEWLOC,DSKSEC,NEWLOC,TC) 01560+ ; ADVANCE NEW ADDRESS 01570 CALL FDWSUB(MOVSEC,DSKSEC,MOVSEC,TC) 01580+ ; LESS AMOUNT MOVED 01590 GOTO 300 016001 0161000 340 DSKSEC(2)=DSKSEC(3) 01620+ ; REPAIR 016301 01640C MAKE THE FILE REAPPEAR ( THE RELOCATION HAS OCCURRED ) 016501 01660 IFLAG=MMREAD(MLU,ASDLEN,VLASD,DSKBFR) 01670+ ; GET ASD 0168000 RECLEN=RECSIZ 01690+ ; RESTORE FILE RECORD SIZE 01700 CALL FDWSUB(DATBA,DELTA,DATBA,TC) 01710+ ; NEW DATA START ADDR 01720 CALL FDWSUB(KEYBA,DELTA,KEYBA,TC) 01730+ ; NEW KEY START ADDR 01740 CALL FDWSUB(HOLSIZ,FILSIZ,HOLSIZ,TC) 0175000+ ; RESIZE THE HOLE 01760 CALL FDWADD(HOLADR,FILSIZ,HOLADR,TC) 01770+ ; RELOCATE THE HOLE 01780 FIAT(NP)=EOR(FIAT(NP),BITS(NB)) 01790+ ; MARK FCB NOT AVAILABLE 018001 01810C RESTORE FILE MANAGER DISK AREAS 01820001 01830 IFLAG=MMWRIT(MLU,ASDLEN,VLASD,DSKBFR) 01840+ ; ASD WITH FILE MOVED 01850 IFLAG=MMWRIT(MLU,VLWPS,FCBLOC,FCBBFR) 01860+ ; FCB WITH FILE MOVED 01870 IFLAG=MMWRIT(MLU,IATLEN,IATADR,FIAT) 01880+ ; FIAT WITH FCB INUSE 01890001 01900C THIS FILE MOVE IS NOW COMPLETE 019101 01920 CNT=CNT-1 01930 IF ( CNT.GT.0 ) GOTO 100 01940+ ; IF MORE FILES TO BE MOVED 019501 0196000C REFLECT VOLUME CHANGES IN THE VOLUME HEADER 019701 01980 VOLBFR(26)=HOLSIZ(1) 01990 VOLBFR(27)=HOLSIZ(2) 02000 TEMP(1)=0 02010 TEMP(2)=0 02020 IFLAG=MMWRIT(MLU,VLWPS,TEMP(1),VOLBFR) 0203000 RETURN 020401 02050 END 02060_ 00 00 00 00 00 00 __ 0(b TFDMPFCBLIBRARY P 999999060381(0 PROGRAM DMPFCB 00010 + /DUMP FCB CONTENTS 000202 00030C DMPFCB - DUMP CONTENTS OF FCB 00040C 00050C DMPFCB - PROMPTING MODE 00060C DMPFCB,FILENAME,, 00070001 00080C COPYRIGHT CONTROL DATA CORPORATION 08/16/80 (CGODSO) 000902 00100 INTEGER FCB(96), VDC, TC, FCBADR(2) 00110 INTEGER DETAIL(40,6) 00120 INTEGER TEMP(8), WORDS(2) 00130 INTEGER RIGHT8(2) 0014000 DATA RIGHT8 / 8, 1 / 00150 INTEGER YES(2), NO(2), RAND(4), ORDR(4), CLOSED(3), OPEN(3) 00160 DATA YES / ' YES' / 00170 DATA NO / ' NO' / 00180 DATA RAND / ' RANDOM' / 00190 DATA ORDR / ' ORDERED' / 00200 DATA CLOSED / 'CLOSED' / 0021000 DATA OPEN / ' OPEN' / 00220 INTEGER BINARY(3), TEXT(3), SEQUEN(5), INDEX(5) 00230 DATA BINARY / 'BINARY' / 00240 DATA TEXT / ' TEXT' / 00250 DATA SEQUEN / 'SEQUENTIAL' / 00260 DATA INDEX / ' INDEXED' / 00270 INTEGER UNK(7), SEQ14(7), IND14(7), ADR(7), DIRECT(7), COBOL(7) 0028000 DATA UNK / ' UNKNOWN' / 00290 DATA SEQ14 / ' SEQUENTIAL' / 00300 DATA IND14 / ' INDEXED' / 00310 DATA ADR / ' ADDROUT' / 00320 DATA DIRECT / ' DIRECT' / 00330 DATA COBOL / 'COBOL RELATIVE' / 00340 INTEGER MSG(17), PLINE0(21) 0035000 DATA MSG / 'DO YOU WANT A PRINTED COPY? (Y/N):' / 00360 DATA PLINE0 / 'VOLUME: ???????? SECTOR ADDRESS $??,????' / 00370$$TXDMPFCB,LIBRARY 00380 ASSIGN 9999 TO ICTLD 00390 CALL PGMINT(ICTLD,0) 00400 50 CALL DFINIT(FCB,PLINE0(5),FCBADR) 004101 0042000 CALL HEXDEC(FCB(1),TEMP) 00430 CALL CCSMVA(TEMP,1,6,LINE01,46,6) 00440 CALL HEXASC(FCB(1), LINE01(30)) 004501 00460 CALL CNV2W(FCB(2),WORDS) 00470 CALL CONVER(WORDS,TEMP) 00480 CALL CHO2LR(TEMP,LINE02(22),RIGHT8) 0049000 CALL HEXASC(FCB(2),TEMP) 00500 CALL CCSMVA(TEMP,1,4,LINE02,54,4) 00510 CALL HEXASC(FCB(3),LINE02(30)) 005201 00530 CALL HEXASC(FCB(4),TEMP) 00540 CALL CCSMVA(TEMP,1,4,LINE03,54,4) 00550 CALL HEXASC(FCB(5),LINE03(30)) 00560001 00570 CALL HEXASC(AND(FCB(6),$06FE),LINE04(22)) 00580 CALL HEXASC(FCB(6),LINE04(30)) 005901 00600 CALL CCSMVA(NO,1,4,LINE05,59,4) 00610 IF ( AND(FCB(6),$8000).NE.0 ) CALL CCSMVA(YES,1,4,LINE05,59,4) 00620 LINE05(25)=2H0 0063000 IF ( AND(FCB(6),$8000).NE.0 ) LINE05(25)=2H1 006401 00650 CALL CCSMVA(RAND,1,8,LINE06,55,8) 00660 IF ( AND(FCB(6),$4000).NE.0 ) CALL CCSMVA(ORDR ,1,8,LINE06,55,8) 00670 LINE06(25)=2H0 00680 IF ( AND(FCB(6),$4000).NE.0 ) LINE06(25)=2H1 006901 0070000 CALL CCSMVA(CLOSED,1,6,LINE07,57,6) 00710 IF ( AND(FCB(6),$2000).NE.0 ) CALL CCSMVA(OPEN,1,6,LINE07,57,6) 00720 LINE07(25)=2H0 00730 IF ( AND(FCB(6),$2000).NE.0 ) LINE07(25)=2H1 007401 00750 CALL CCSMVA(NO,1,4,LINE08,59,4) 00760 IF ( AND(FCB(6),$1000).NE.0 ) CALL CCSMVA(YES,1,4,LINE08,59,4) 0077000 LINE08(25)=2H0 00780 IF ( AND(FCB(6),$1000).NE.0 ) LINE08(25)=2H1 007901 00800 CALL CCSMVA(NO,1,4,LINE09,59,4) 00810 IF ( AND(FCB(6),$0800).NE.0 ) CALL CCSMVA(YES,1,4,LINE09,59,4) 00820 LINE09(25)=2H0 00830 IF ( AND(FCB(6),$0800).NE.0 ) LINE09(25)=2H1 00840001 00850 CALL CCSMVA(TEXT,1,6,LINE10,57,6) 00860 IF ( AND(FCB(6),$0100).NE.0 ) CALL CCSMVA(BINARY,1,6,LINE10,57,6) 00870 LINE10(25)=2H0 00880 IF ( AND(FCB(6),$0100).NE.0 ) LINE10(25)=2H1 008901 00900 CALL CCSMVA(SEQUEN,1,10,LINE11,53,10) 0091000 IF ( AND(FCB(6),$0001).NE.0 ) CALL CCSMVA(INDEX,1,10,LINE11,53,10) 00920 LINE11(25)=2H0 00930 IF ( AND(FCB(6),$0001).NE.0 ) LINE11(25)=2H1 009401 00950 CALL CNV2W(FCB(7),WORDS) 00960 CALL CONVER(WORDS,TEMP) 00970 CALL CHO2LR(TEMP,LINE12(22),RIGHT8) 0098000 CALL HEXASC(FCB(7),TEMP) 00990 CALL CCSMVA(TEMP,1,4,LINE12,54,4) 01000 CALL HEXASC(FCB(8),LINE12(30)) 010101 01020 CALL CNV2W(FCB(9),WORDS) 01030 CALL CONVER(WORDS,TEMP) 01040 CALL CHO2LR(TEMP,LINE13(22),RIGHT8) 0105000 CALL HEXASC(FCB(9),TEMP) 01060 CALL CCSMVA(TEMP,1,4,LINE13,54,4) 01070 CALL HEXASC(FCB(10),LINE13(30)) 010801 01090 CALL CNV2W(FCB(11),WORDS) 01100 CALL CONVER(WORDS,TEMP) 01110 CALL CHO2LR(TEMP,LINE14(22),RIGHT8) 0112000 CALL HEXASC(FCB(11),TEMP) 01130 CALL CCSMVA(TEMP,1,4,LINE14,54,4) 01140 CALL HEXASC(FCB(12),LINE14(30)) 011501 01160 CALL HEXASC(FCB(13),TEMP) 01170 CALL CCSMVA(TEMP,3,2,LINE15,56,2) 01180 CALL HEXASC(FCB(14),LINE15(30)) 01190001 01200 CALL HEXDEC(FCB(15),LINE16(15)) 01210 CALL HEXDEC(FCB(17),LINE16(18)) 01220 CALL HEXDEC(FCB(19),LINE16(21)) 01230 CALL HEXDEC(FCB(21),LINE16(24)) 012401 01250 CALL HEXDEC(FCB(16),LINE17(15)) 0126000 CALL HEXDEC(FCB(18),LINE17(18)) 01270 CALL HEXDEC(FCB(20),LINE17(21)) 01280 CALL HEXDEC(FCB(22),LINE17(24)) 012901 01300 WORDS(1)=FCB(23) 01310 WORDS(2)=FCB(24) 01320 CALL CONVER(WORDS,TEMP) 0133000 CALL CHO2LR(TEMP,LINE18(22),RIGHT8) 01340 CALL HEXASC(FCB(23),TEMP) 01350 CALL CCSMVA(TEMP,1,4,LINE18,54,4) 01360 CALL HEXASC(FCB(24),LINE18(30)) 013701 01380 LINE19(17)=VDC(FCB(25)) 01390 LINE19(18)=VDC(FCB(26)) 0140000 LINE19(19)=VDC(FCB(27)) 01410 LINE19(20)=VDC(FCB(28)) 01420 CALL HEXASC(FCB(25),TEMP) 01430 CALL CCSMVA(TEMP,1,4,LINE19,44,4) 01440 CALL HEXASC(FCB(26),LINE19(25)) 01450 CALL HEXASC(FCB(27),TEMP) 01460 CALL CCSMVA(TEMP,1,4,LINE19,54,4) 0147000 CALL HEXASC(FCB(28),LINE19(30)) 014801 01490 LINE20(17)=VDC(FCB(29)) 01500 LINE20(18)=VDC(FCB(30)) 01510 LINE20(19)=VDC(FCB(31)) 01520 LINE20(20)=VDC(FCB(32)) 01530 CALL HEXASC(FCB(29),TEMP) 0154000 CALL CCSMVA(TEMP,1,4,LINE20,44,4) 01550 CALL HEXASC(FCB(30),LINE20(25)) 01560 CALL HEXASC(FCB(31),TEMP) 01570 CALL CCSMVA(TEMP,1,4,LINE20,54,4) 01580 CALL HEXASC(FCB(32),LINE20(30)) 015901 01600 CALL HEXDEC(FCB(33),TEMP) 0161000 CALL CCSMVA(TEMP,1,6,LINE21,46,6) 01620 CALL HEXASC(FCB(33),LINE21(30)) 016301 01640 CALL CNV2W(FCB(34),WORDS) 01650 CALL CONVER(WORDS,TEMP) 01660 CALL CHO2LR(TEMP,LINE22(22),RIGHT8) 01670 CALL HEXASC(FCB(34),TEMP) 0168000 CALL CCSMVA(TEMP,1,4,LINE22,54,4) 01690 CALL HEXASC(FCB(35),LINE22(30)) 017001 01710 CALL CNV2W(FCB(36),WORDS) 01720 CALL CONVER(WORDS,TEMP) 01730 CALL CHO2LR(TEMP,LINE23(22),RIGHT8) 01740 CALL HEXASC(FCB(36),TEMP) 0175000 CALL CCSMVA(TEMP,1,4,LINE23,54,4) 01760 CALL HEXASC(FCB(37),LINE23(30)) 017701 01780 J=0 01790 DO 100 I=38,85,8 01800 CALL HEXASC(FCB(I+0),LINE26(1)) 01810 CALL HEXASC(FCB(I+1),TEMP) 0182000 CALL CCSMVA(TEMP,1,4,LINE26,6,4) 01830 CALL HEXASC(FCB(I+2),LINE26(6)) 01840 CALL HEXASC(FCB(I+3),TEMP) 01850 CALL CCSMVA(TEMP,1,4,LINE26,16,4) 01860 CALL HEXASC(FCB(I+4),LINE26(11)) 01870 CALL HEXASC(FCB(I+5),TEMP) 01880 CALL CCSMVA(TEMP,1,4,LINE26,26,4) 0189000 CALL HEXASC(FCB(I+6),LINE26(16)) 01900 CALL HEXASC(FCB(I+7),TEMP) 01910 CALL CCSMVA(TEMP,1,4,LINE26,36,4) 01920 LINE26(24)=VDC(FCB(I+0)) 01930 LINE26(25)=VDC(FCB(I+1)) 01940 LINE26(26)=VDC(FCB(I+2)) 01950 LINE26(27)=VDC(FCB(I+3)) 0196000 LINE26(28)=VDC(FCB(I+4)) 01970 LINE26(29)=VDC(FCB(I+5)) 01980 LINE26(30)=VDC(FCB(I+6)) 01990 LINE26(31)=VDC(FCB(I+7)) 02000 CALL HEXDEC(I,TEMP) 02010 CALL CCSMVA(TEMP,5,2,LINE26,66,2) 02020 CALL HEXDEC(I+7,TEMP) 0203000 CALL CCSMVA(TEMP,5,2,LINE26,71,2) 02040 J=J+1 02050 CALL CCSMVA(LINE26,1,80,DETAIL(1,J),1,80) 02060 100 CONTINUE 020701 02080 CALL HEXDEC(FCB(86),LINE27(24)) 02090 CALL HEXASC(FCB(86),LINE27(30)) 02100001 02110 CALL HEXDEC(FCB(87),LINE28(24)) 02120 CALL HEXASC(FCB(87),LINE28(30)) 021301 02140 CALL HEXDEC(FCB(88),LINE29(24)) 02150 CALL HEXASC(FCB(88),LINE29(30)) 021601 0217000 TEMP(1)=VDC(FCB(89)) 02180 TEMP(2)=VDC(FCB(90)) 02190 TEMP(3)=VDC(FCB(91)) 02200 CALL CCSMVA(TEMP,1,6,LINE30,40,6) 02210 CALL HEXASC(FCB(89),LINE30(25)) 02220 CALL HEXASC(FCB(90),TEMP) 02230 CALL CCSMVA(TEMP,1,4,LINE30,54,4) 0224000 CALL HEXASC(FCB(91),LINE30(30)) 022501 02260 TEMP(1)=VDC(FCB(92)) 02270 TEMP(2)=VDC(FCB(93)) 02280 TEMP(3)=VDC(FCB(94)) 02290 CALL CCSMVA(TEMP,1,6,LINE31,40,6) 02300 CALL HEXASC(FCB(92),LINE31(25)) 0231000 CALL HEXASC(FCB(93),TEMP) 02320 CALL CCSMVA(TEMP,1,4,LINE31,54,4) 02330 CALL HEXASC(FCB(94),LINE31(30)) 023401 02350 CALL HEXDEC(FCB(95),TEMP) 02360 CALL CCSMVA(TEMP,1,6,LINE32,34,6) 02370 CALL HEXASC(FCB(95),TEMP) 0238000 CALL CCSMVA(TEMP,1,4,LINE32,42,4) 02390 CALL CCSMVA(UNK,1,14,LINE32,49,14) 02400 IF ( FCB(95).EQ.0 ) CALL CCSMVA(SEQ14,1,14,LINE32,49,14) 02410 IF ( FCB(95).EQ.1 ) CALL CCSMVA(IND14,1,14,LINE32,49,14) 02420 IF ( FCB(95).EQ.2 ) CALL CCSMVA(ADR,1,14,LINE32,49,14) 02430 IF ( FCB(95).EQ.3 ) CALL CCSMVA(DIRECT,1,14,LINE32,49,14) 02440 IF ( FCB(95).EQ.4 ) CALL CCSMVA(COBOL,1,14,LINE32,49,14) 02450001 02460 CALL HEXDEC(FCB(96),TEMP) 02470 CALL CCSMVA(TEMP,1,6,LINE33,34,6) 02480 CALL HEXASC(FCB(96),TEMP) 02490 CALL CCSMVA(TEMP,1,4,LINE33,42,4) 02500 CALL CCSMVA(YES,1,4,LINE33(30),1,4) 02510 IF ( FCB(96).EQ.0 ) CALL CCSMVA(NO,1,4,LINE33(30),1,4) 02520002 02530 CALL CLRSCR 02540 CALL DSPLA( 1,1,LINE01,LASTCH(LINE01,80)) 02550 CALL DSPLA( 2,1,LINE02,LASTCH(LINE02,80)) 02560 CALL DSPLA( 3,1,LINE03,LASTCH(LINE03,80)) 02570 CALL DSPLA( 4,1,LINE04,LASTCH(LINE04,80)) 02580 CALL DSPLA( 5,1,LINE05,LASTCH(LINE05,80)) 0259000 CALL DSPLA( 6,1,LINE06,LASTCH(LINE06,80)) 02600 CALL DSPLA( 7,1,LINE07,LASTCH(LINE07,80)) 02610 CALL DSPLA( 8,1,LINE08,LASTCH(LINE08,80)) 02620 CALL DSPLA( 9,1,LINE09,LASTCH(LINE09,80)) 02630 CALL DSPLA(10,1,LINE10,LASTCH(LINE10,80)) 02640 CALL DSPLA(11,1,LINE11,LASTCH(LINE11,80)) 02650 CALL DSPLA(12,1,LINE12,LASTCH(LINE12,80)) 0266000 CALL DSPLA(13,1,LINE13,LASTCH(LINE13,80)) 02670 CALL DSPLA(14,1,LINE14,LASTCH(LINE14,80)) 02680 CALL DSPLA(15,1,LINE15,LASTCH(LINE15,80)) 02690 CALL DSPLA(16,1,LINE34,LASTCH(LINE34,80)) 02700 CALL DSPLA(17,1,LINE16,LASTCH(LINE16,80)) 02710 CALL DSPLA(18,1,LINE17,LASTCH(LINE17,80)) 02720 CALL DSPLA(19,1,LINE18,LASTCH(LINE18,80)) 0273000 CALL DSPLA(20,1,LINE19,LASTCH(LINE19,80)) 02740 CALL DSPLA(21,1,LINE20,LASTCH(LINE20,80)) 02750 CALL DSPLA(22,1,LINE21,LASTCH(LINE21,80)) 02760 CALL DSPLA(24,1,LINE24,LASTCH(LINE24,80)) 02770 TC=INPUT(24,16,IDUMMY,1) 02780 CALL CLRSCR 02790 CALL DSPLA( 1,1,LINE22 ,LASTCH(LINE22,80)) 0280000 CALL DSPLA( 2,1,LINE23 ,LASTCH(LINE23,80)) 02810 CALL DSPLA( 3,1,2H , 2) 02820 CALL DSPLA( 4,1,LINE25 ,LASTCH(LINE25,80)) 02830 CALL DSPLA( 5,1,2H , 2) 02840 CALL DSPLA( 6,1,DETAIL(1,1),LASTCH(DETAIL(1,1),80)) 02850 CALL DSPLA( 7,1,DETAIL(1,2),LASTCH(DETAIL(1,2),80)) 02860 CALL DSPLA( 8,1,DETAIL(1,3),LASTCH(DETAIL(1,3),80)) 0287000 CALL DSPLA( 9,1,DETAIL(1,4),LASTCH(DETAIL(1,4),80)) 02880 CALL DSPLA(10,1,DETAIL(1,5),LASTCH(DETAIL(1,5),80)) 02890 CALL DSPLA(11,1,DETAIL(1,6),LASTCH(DETAIL(1,6),80)) 02900 CALL DSPLA(12,1,2H , 2) 02910 CALL DSPLA(13,1,LINE27 ,LASTCH(LINE27,80)) 02920 CALL DSPLA(14,1,LINE28 ,LASTCH(LINE28,80)) 02930 CALL DSPLA(15,1,LINE29 ,LASTCH(LINE29,80)) 0294000 CALL DSPLA(16,1,LINE30 ,LASTCH(LINE30,80)) 02950 CALL DSPLA(17,1,LINE31 ,LASTCH(LINE31,80)) 02960 CALL DSPLA(18,1,LINE32 ,LASTCH(LINE32,80)) 02970 CALL DSPLA(19,1,LINE33 ,LASTCH(LINE33,80)) 02980 CALL DSPLA(20,1,2H , 2) 02990 200 IANS=2H 03000 CALL DSPLA(21,1,MSG,34) 0301000 IF ( INPUT(21,35,IANS,1).EQ.4 ) GOTO 200 03020 IF ( IANS.NE.2HY ) GOTO 50 03030 CALL MPWRIX(12,2H1 ,2) 03040 CALL HEXASC(FCBADR(1),TEMP) 03050 CALL CCSMVA(TEMP,3,2,PLINE0,36,2) 03060 IF ( PLINE0(18).EQ.2H$0 ) PLINE0(18)=$2024 03070 CALL HEXASC(FCBADR(2),PLINE0(20)) 0308000 CALL MPWRIX(9,PLINE0,42) 03090 CALL MPWRIX(9,2H ,2) 03100 CALL MPWRIX(9,LINE01,80) 03110 CALL MPWRIX(9,LINE02,80) 03120 CALL MPWRIX(9,LINE03,80) 03130 CALL MPWRIX(9,LINE04,80) 03140 CALL MPWRIX(9,LINE05,80) 0315000 CALL MPWRIX(9,LINE06,80) 03160 CALL MPWRIX(9,LINE07,80) 03170 CALL MPWRIX(9,LINE08,80) 03180 CALL MPWRIX(9,LINE09,80) 03190 CALL MPWRIX(9,LINE10,80) 03200 CALL MPWRIX(9,LINE11,80) 03210 CALL MPWRIX(9,LINE12,80) 0322000 CALL MPWRIX(9,LINE13,80) 03230 CALL MPWRIX(9,LINE14,80) 03240 CALL MPWRIX(9,LINE15,80) 03250 CALL MPWRIX(9,LINE34,80) 03260 CALL MPWRIX(9,LINE16,80) 03270 CALL MPWRIX(9,LINE17,80) 03280 CALL MPWRIX(9,LINE18,80) 0329000 CALL MPWRIX(9,LINE19,80) 03300 CALL MPWRIX(9,LINE20,80) 03310 CALL MPWRIX(9,LINE21,80) 03320 CALL MPWRIX(9,2H ,2) 03330 CALL MPWRIX(9,LINE24,80) 03340 CALL MPWRIX(9,2H ,2) 03350 CALL MPWRIX(9,LINE22,80) 0336000 CALL MPWRIX(9,LINE23,80) 03370 CALL MPWRIX(9,2H ,2) 03380 CALL MPWRIX(9,LINE25,80) 03390 CALL MPWRIX(9,2H ,2) 03400 CALL MPWRIX(9,DETAIL(1,1),80) 03410 CALL MPWRIX(9,DETAIL(1,2),80) 03420 CALL MPWRIX(9,DETAIL(1,3),80) 0343000 CALL MPWRIX(9,DETAIL(1,4),80) 03440 CALL MPWRIX(9,DETAIL(1,5),80) 03450 CALL MPWRIX(9,DETAIL(1,6),80) 03460 CALL MPWRIX(9,2H ,2) 03470 CALL MPWRIX(9,LINE27,80) 03480 CALL MPWRIX(9,LINE28,80) 03490 CALL MPWRIX(9,LINE29,80) 0350000 CALL MPWRIX(9,LINE30,80) 03510 CALL MPWRIX(9,LINE31,80) 03520 CALL MPWRIX(9,LINE32,80) 03530 CALL MPWRIX(9,LINE33,80) 03540 GOTO 50 035501 03560 9999 CALL PGMOUT 03570001 03580 END 03590_ 00 00 00 00 00 00 __ 0(2xW 2TFDSKERRLIBRARY P999999060381(0 SUBROUTINE DSKERR(MSGORD) 00010 + /REPORT DISK ( FM ) ERROR 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C DSKERR - DISK ERROR PROCESSOR. 000601 0007000C ISSUE SYSMSG NUMBER 'MSGORD' WITH THE CONTENTS OF STATUS FROM 00080C COMMON STORAGE, THEN TERMINATE PROCESSING. 000902 00100 INTEGER MSGORD 00110$$TXSSPBLK 00120 CALL SYSMSG(MSGORD,ISTAT) 00130 CALL PGMOUT 00140001 00150 END 00160_ 00 00 00 00 00 __ 0(2 2TFDUPL LIBRARY P999999060381(0 SUBROUTINE DUPL(FROM,TO,NWORDS) 00010 + /DUPLICATE ( COPY ) ARRAY 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/28/80 (CGODSO) 000402 00050C DUPL - DUPLICATE. 000601 0007000C MAKE A COPY OF 'FROM' IN 'TO' UNDER CONTROL OF WORD COUNT 'NWORDS' 000802 00090 INTEGER FROM(1), TO(1), NWORDS 001002 00110 IF ( NWORDS.LE.0 ) RETURN 00120+ ; BEWARE 00130 DO 100 I=1,NWORDS 0014000 TO(I)=FROM(I) 00150 100 CONTINUE 00160 RETURN 001701 00180 END 00190_ 00 00 00 00 00 __ 0(2 2TFECHO LIBRARY P999999060381(0 PROGRAM ECHO 00010 INTEGER BUF(2),MSG(18) 00020 DATA MSG/$0D0A,'ENTER ONE OR TWO CHARACTERS '/ 00030 ASSIGN 900 TO INTLOC 00040 CALL PGMINT(INTLOC,IDUM) 0005010 BUF(1)=0 00060 CALL WTREAD(0,-1,MSG,36,-1,BUF,2,ITC) 0007000 IF(ITC.EQ.4)GOTO 10 00080 WRITE(5,1000)BUF(1) 00090 GOTO 10 00100900 CALL PGMOUT 001101000 FORMAT('HEX VALUE IS $',Z4) 00120 END 00130_ 00 00 00 00 00 00 __ 0(6 TTFEXTENDLIBRARY P999999060381(0 PROGRAM EXTEND 000102 00020C EXTEND,FILENAME,, 000301 00040 INTEGER IFILE(24), OFILE(24), FCBBFR(96) 00050 DATA IFILE / 12*$2020, 0, 1, 10*0 / 00060 DATA OFILE / '@EXTEND@', 20*0 / 0007000 INTEGER MSG5(15), REQBUF(24) 00080 INTEGER COMPAR, CPFCB(96), CPREQ(24) 00090 DATA MSG5 / $0D0A, 'AAAAAAAA/ BBBBBBBB EXTENDED ' / 001001 00110 INTEGER IMORE(2) 00120 DATA IMORE / 0,50 / 00130 INTEGER ERROR1(12), ERROR2(15) 0014000 DATA ERROR1 / $0D0A, 'NO FILE NAME SPECIFIED' / 00150 DATA ERROR2 / $0D0A, 'NON-NUMERIC EXTENTION FIELD ' / 00160 INTEGER PARM(4,3) 001703 00180 CALL PGMIN(IFILE(5),IDUMMY,IDUMMY,NOPORT) 00190 CALL GTPARM(PARM,3) 00200 IF ( PARM(1,1).EQ.2H ) GOTO 9000 0021000 CALL CCSMVA(PARM(1,1),1,8,IFILE(1),1,8) 00220 CALL CCSMVA(PARM(1,2),1,8,IFILE(9),1,8) 00230 IPT=0 00240 IF ( M.GT.0 ) IMORE(2)=ICNVRT(PARM(1,3),IPT,8,IFLAG) 00250 IF ( IFLAG.NE.0 ) GOTO 9001 00260 IF ( IMORE(2).LT.1 ) IMORE(2)=50 002701 0028000 CALL ZERO(REQBUF,24) 00290 CALL OPENFL(REQBUF,IFILE,ISTAT) 00300 IF ( ISTAT.LT.0 ) GOTO 9002 00310 CALL GETFCB(REQBUF,0,0,FCBBFR,ISTAT) 00320 IF ( ISTAT.LT.0 ) GOTO 9007 00330 CALL CLOSFL(REQBUF,ISTAT) 003401 0035000 OFILE(4)=OFILE(4)+NOPORT 00360+ ; NAMEXX - FILE NAME 00370 CALL CCSMVA(IFILE(5),1,16,OFILE(5),1,16) 00380+ ; OWNER / VOLUME 00390 OFILE(13)=FCBBFR(33) 00400+ ; BYTLEN - RECORD LENGTH 00410 CALL FDWADD(FCBBFR(2),IMORE,OFILE(14),IDUMMY) 0042000+ ; TDATRM - MAX # RECS 00430 OFILE(16)=FCBBFR(6) 00440+ ; FCBIND - FCB INDICATORS 00450 CALL CCSMVA(FCBBFR(15),1,16,OFILE(17),1,16) 00460+ ; KEY INFORMATION 00470 CALL ZERO(REQBUF,24) 00480 CALL DELETE(REQBUF,OFILE,ISTAT) 0049000 CALL ZERO(REQBUF,24) 00500 CALL CREATE(REQBUF,OFILE,ISTAT) 00510 IF ( ISTAT.LT.0 ) GOTO 9005 00520 CALL ZERO(CPREQ,24) 00530 OFILE(13)=0 00540 OFILE(14)=1 00550 OFILE(15)=0 0056000 CALL OPENFL(CPREQ,OFILE,ISTAT) 00570 IF ( ISTAT.LT.0 ) GOTO 9008 00580 CALL GETFCB(CPREQ,0,IDUMMY,CPFCB,ISTAT) 00590 IF ( ISTAT.LT.0 ) GOTO 9006 00600 CALL CCSMVA(FCBBFR(38),1,116,CPFCB(38),1,116) 00610 CALL UPDFCB(CPREQ,0,IDUMMY,CPFCB,ISTAT) 00620 IF ( ISTAT.LT.0 ) GOTO 9009 0063000 CALL CLOSFL(CPREQ,ISTAT) 00640 CALL COPY(IFILE,OFILE) 00650 OFILE(15)=IMORE(2) 00660 IF ( FCBBFR(87).EQ.1 ) CALL FILLIT(OFILE,$2020) 00670 CALL ZERO(REQBUF,24) 00680 CALL DELETE(REQBUF,IFILE,ISTAT) 00690 IF ( ISTAT.LT.0 ) GOTO 9003 0070000 CALL ZERO(REQBUF,24) 00710 CALL RENAME(REQBUF,OFILE,IFILE,ISTAT) 00720 IF ( ISTAT.LT.0 ) GOTO 9004 00730 CALL CCSMVA(IFILE,1,8,MSG5(2),1,8) 00740 CALL CCSMVA(IFILE(9),1,8,MSG5(7),1,8) 00750 CALL WTREAD(5,-1,MSG5,29,-1,0,0,ITC) 00760 CALL PGMOUT 00770001 00780 9000 CALL WTREAD(5,-1,ERROR1,24,-1,0,0,ITC) 00790 CALL PGMOUT 00800 9001 CALL WTREAD(5,-1,ERROR2,30,-1,0,0,ITC) 00810 CALL PGMOUT 00820 9002 CALL FILERR(IFILE,3,ISTAT,5) 00830 CALL PGMOUT 0084000 9003 CALL FILERR(IFILE,2,ISTAT,5) 00850 CALL PGMOUT 00860 9004 CALL FILERR(OFILE,9,ISTAT,5) 00870 CALL PGMOUT 00880 9005 CALL FILERR(OFILE,0,ISTAT,5) 00890 CALL PGMOUT 00900 9006 CALL FILERR(OFILE,7,ISTAT,5) 0091000 CALL PGMOUT 00920 9007 CALL FILERR(IFILE,7,ISTAT,5) 00930 CALL PGMOUT 00940 9008 CALL FILERR(OFILE,3,ISTAT,5) 00950 CALL PGMOUT 00960 9009 CALL FILERR(OFILE,8,ISTAT,5) 00970 CALL PGMOUT 00980001 00990 END 01000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( TTFFCBADRLIBRARY Pt999999060381(0 PROGRAM FCBADR 00010 + /LOCATE FCB 000202 00030C FCBADR - LOCATE FCB 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 08/07/80 (CGODSO) 000601 0007000C ITOS REQUEST : 00080C 00090C FCBADR,,[],[] 001002 00110 INTEGER LINE0(38), MSG01(9), MSG02(5), MSG03(11) 00120 DATA LINE0 / '???????? / ???????? / ???????? FDD: $????/$??', 00130 + '?? FCB: $???? SADR: ??,????' / 0014000 DATA MSG01 / '???????? NOT FOUND' / 00150 DATA MSG02 / 'NOT FOUND ' / 00160 DATA MSG03 / 'NO FILE NAME SPECIFIED' / 00170 INTEGER COMMA, COMMAS(2), FNAME(4), OWNER(4), VOLUME(4) 00180 DATA FNAME / ' ' / 00190 DATA OWNER / ' ' / 00200 DATA VOLUME / ' ' / 0021000 DATA COMMAS / ',,,,' / 00220 DATA COMMA / $2C / 002301 00240 INTEGER VIT(23), FDDINX(2), VOLNAM(8) 00250 INTEGER LINE(40), ALLVOL, MMADDR(2), DATBUF(2) 002601 00270 INTEGER SCAN, HASH 00280002 00290 NFND=0 00300+ ; NO FILES FOUND AT THIS TIME 00310 CALL NFETCH( LINE, N ) 00320 CALL CCSMVA(COMMAS,1,4 ,LINE ,N+1 ,4 ) 00330 N=N+4 003401 0035000 I0=1 00360 I1=SCAN( LINE ,COMMA ,I0 ,N ) 00370+ ; SCAN THE PROGRAM NAME 00380 I2=SCAN( LINE ,COMMA ,I1 ,N ) 00390+ ; SCAN THE FILE NAME 00400 I3=SCAN( LINE ,COMMA ,I2 ,N ) 00410+ ; SCAN THE OWNER NAME 0042000 I4=SCAN( LINE ,COMMA ,I3 ,N ) 00430+ ; SCAN THE VOLUME NAME 00440 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 00450 M=I1-I0-1 00460 IF ( M.GT.8 ) M=8 00470 IF ( M.LE.0 ) GOTO 240 00480+ ; NO FILE NAME SPECIFIED 0049000 CALL CCSMVA(LINE,I0+1,M ,FNAME ,1 ,8 ) 00500 M=I2-I1-1 00510 IF ( M.GT.8 ) M=8 00520 IF ( M.GT.0 ) CALL CCSMVA(LINE,I1+1,M ,OWNER(1) ,1 ,8 ) 00530 IF ( M.LE.0 ) CALL PGMIN( OWNER, IDUM, IDUM, IDUM ) 00540 M=I3-I2-1 00550 IF ( M.GT.8 ) M=8 0056000 ALLVOL=0 00570 IF ( M.LE.0 ) GOTO 100 00580 ALLVOL=-1 00590 CALL CCSMVA(LINE,I2+1,M ,VOLUME ,1 ,8 ) 00600 CALL CCSMVA(VOLUME,1,8, VOLNAM, 1, 8 ) 00610 100 CALL GETVOL( ALLVOL, VOLUME, VIT ) 00620 IF ( VOLUME(1).EQ.0 ) GOTO 200 0063000 NFCB=HASH( FNAME, OWNER, VIT , FDDINX ) 00640 IF ( NFCB.LT.0 ) GOTO 200 00650+ ; FCB NOT FOUND 00660 NFND=1 00670+ ; FOUND A FILE 00680 CALL CCSMVA(FNAME,1,8, LINE0, 1, 8 ) 00690 CALL CCSMVA(OWNER,1,8, LINE0, 12, 8 ) 0070000 CALL CCSMVA(VIT(2),1,8, LINE0, 23, 8 ) 00710 CALL HEXASC( FDDINX(1), LINE0(20) ) 00720 CALL HEXASC( FDDINX(2), LINE0(23) ) 00730 CALL HEXASC( NFCB, LINE0(29) ) 00740 MMADDR(1)=0 00750 MMADDR(2)=NFCB 00760 DATBUF(1)=0 0077000 DATBUF(2)=VIT(19) 00780 CALL FDWADD( MMADDR, DATBUF, MMADDR, IOVF ) 00790 CALL FDWADD( MMADDR, VIT(15), MMADDR, IOVF ) 00800 DATBUF(1)=MMADDR(1) 00810 CALL FRHX( DATBUF ) 00820 IF ( DATBUF(4).EQ.$0030 ) DATBUF(4)=$0020 00830 CALL CCSMVA(DATBUF(4),2,1, LINE0, 70, 1) 0084000 CALL CCSMVA(DATBUF(5),2,1, LINE0, 71, 1 ) 00850 CALL HEXASC( MMADDR(2), LINE0(37) ) 00860 CALL WTREAD(5,-1,LINE0,76,-1,0,0,ITC) 00870 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 008801 00890 200 IF ( ALLVOL.LT.0 ) GOTO 220 00900+ ; CHECKING JUST ONE VOLUME 0091000 IF ( ALLVOL.LT.8 ) GOTO 100 00920+ ; LOOK FOR MORE VOLUMES 00930 IF ( NFND.GT.0 ) CALL PGMOUT 00940 CALL CCSMVA(FNAME,1,8, MSG01, 1, 8 ) 00950 CALL WTREAD(5,-1,MSG01,18,-1,0,0,ITC) 00960 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 00970 CALL PGMOUT 00980001 00990 220 IF ( NFND.GT.0 ) CALL PGMOUT 01000 CALL CCSMVA(FNAME,1,8, LINE0, 1, 8 ) 01010 CALL CCSMVA(OWNER,1,8, LINE0, 12, 8 ) 01020 CALL CCSMVA(VOLNAM,1,8, LINE0, 23, 8 ) 01030 CALL HEXASC( FDDINX(1), LINE0(20) ) 01040 CALL HEXASC( FDDINX(2), LINE0(23) ) 0105000 CALL CCSMVA(MSG02,1,10,LINE0, 51, 10 ) 01060 CALL WTREAD(5,-1,LINE0,60,-1,0,0,ITC) 01070 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 01080 CALL PGMOUT 010901 01100 240 CALL WTREAD(5,-1,MSG03,22,-1,0,0,ITC) 01110 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 0112000 CALL PGMOUT 011301 01140 END 01150_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2 2TFFETFCBLIBRARY P999999060381(0 SUBROUTINE FETFCB(NFCB,VIT,FCBBFR) 00010 + /FETCH THE SPECIFIED FCB 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 08/06/80 (CGODSO) 000402 00050C FETFCB - FETCH THE SPECIFIED FCB 000601 0007000C READ FCB #NFCB ON THE VOLUME DESCRIBED BY THE VIT INTO FCBBFR 000801 00090 INTEGER NFCB, VIT(23), FCBBFR(96) 001001 00110 INTEGER MMADDR(2), FCBINX(2) 001202 00130 MMADDR(1)=0 0014000 MMADDR(2)=VIT(19) 00150+ ; VINFDB 00160 CALL FDWADD( VIT(15), MMADDR, MMADDR, IOVF ) 00170+ ; VIFDD* + VINFDB 00180 FCBINX(1)=0 00190 FCBINX(2)=NFCB 00200 CALL FDWADD( MMADDR, FCBINX, MMADDR, IOVF ) 0021000+ ; MMADDR OF FCB 00220 ISTAT=MMREAD( AND(VIT(1),$7FFF), 96, MMADDR, FCBBFR ) 00230 RETURN 002401 00250 END 00260_ 00 00 00 00 __ 0(2 2TFFILES LIBRARY PZ999999060381(0 PROGRAM FILES 000101 00020 INTEGER SSP(4) 00030 DATA SSP / 'SSP ' / 000401 00050 CALL CHAIN(SSP) 00060 STOP 00070001 00080 END 00090_ 00 00 00 00 00 00 __ 0(d d*TFFILLITLIBRARY P:999999060381(0 SUBROUTINE FILLIT(IDATA,ISEQ) 000102 00020C FILLIT - FILL FILE 000301 00040C COPYRIGHT CONTROL DATA CORPORATION 08/06/80 (CGODSO) 000502 00060 INTEGER IDATA(24) 00070001 00080 INTEGER FILLER(40,100), RDATA(15), FCBBFR(96), REQBFR(24), NFILL 00090 DATA FILLER / 4000*$2020 / 00100 DATA FCBBFR / 96*0 / 00110 DATA REQBFR / 24*0 / 00120 DATA NFILL / 100 / 00130 INTEGER MSG1(12), MSG2(12), MSG3(12) 0014000 DATA MSG1 / 'FM ERROR - OPENFL $????' / 00150 DATA MSG2 / 'FM ERROR - PUTS $????' / 00160 DATA MSG3 / 'FM ERROR - UPDFCB $????' / 001701 00180 CALL CCSMVA(IDATA,1,24,RDATA,1,24) 00190 RDATA(13)=0 00200 RDATA(14)=1 0021000 RDATA(15)=0 00220 CALL OPENFL(REQBFR,RDATA,ISTAT) 00230 IF ( ISTAT.LT.0 ) GOTO 900 00240 IF ( ISEQ.NE.2H ) GOTO 200 00250 N=IDATA(15) 00260 FILLER(1,1)=MEMORY(MEMORY(MEMORY($00E9)+31)+14) 00270 100 IF ( N.LT.NFILL ) NFILL=N 0028000 CALL PUTS(REQBFR,FILLER,NFILL,ISTAT) 00290 IF ( ISTAT.LT.0 ) GOTO 910 00300 FILLER(1,1)=$2020 00310 N=N-NFILL 00320 IF ( N.GT.0 ) GOTO 100 00330 FCBBFR(87)=1 00340 FCBBFR(95)=3 0035000 200 FCBBFR(89)=2H99 00360 FCBBFR(90)=2H99 00370 FCBBFR(91)=2H99 00380 FCBBFR(92)=MEMORY(MEMORY(MEMORY($00E9)+13)) 00390 FCBBFR(93)=MEMORY(MEMORY(MEMORY($00E9)+14)) 00400 FCBBFR(94)=MEMORY(MEMORY(MEMORY($00E9)+12)) 00410 CALL UPDFCB(REQBFR,0,0,FCBBFR,ISTAT) 0042000 IF ( ISTAT.LT.0 ) GOTO 920 00430 CALL CLOSFL(REQBFR,ISTAT) 00440 RETURN 004501 00460 900 CALL HEXASC(ISTAT,MSG1(11)) 00470 CALL WTREAD(5,-1,MSG1,24,-1,0,0,ITC) 00480 CALL PGMOUT 0049000 910 CALL HEXASC(ISTAT,MSG2(11)) 00500 CALL WTREAD(5,-1,MSG2,24,-1,0,0,ITC) 00510 CALL PGMOUT 00520 920 CALL HEXASC(ISTAT,MSG3(11)) 00530 CALL WTREAD(5,-1,MSG3,24,-1,0,0,ITC) 00540 CALL PGMOUT 005501 0056000 END 00570_ 00 00 00 00 00 00 __ 0(7 TTFFMTFCBLIBRARY Pn999999060381(0 SUBROUTINE FMTFCB(NFCB,FCB,REC) 00010 + /GENERATE STATUS RECORD 000202 00030C FMTFCB - GENERATE A STATUS RECORD. 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 08/06/80 (CGODSO) 000601 0007000C FMTFCB PRODUCES A REPORT LINE RECORD FROM A FCB AND FCB INDEX 00080C GIVEN BY THE USER. 000902 00100 INTEGER NFCB, FCB(96), REC(66) 001101 00120 INTEGER FTYPE(7), LEFT4(2), LEFT6(2), RIGHT4(2), RIGHT5(2) 00130 DATA FTYPE / 2H S, 2H R, 2H A, 2H D, 2H C, 2H B, 2H O / 0014000 DATA LEFT4 / 4, 0 / 00150 DATA LEFT6 / 6, 0 / 00160 DATA RIGHT4 / 4, 1 / 00170 DATA RIGHT5 / 5, 1 / 00180 INTEGER RIGHT6(2) 00190 DATA RIGHT6 / 6, 1 / 00200 INTEGER DATBUF(10), INP(2) 00210001 00220 INTEGER VDC 002302 00240 CALL CCSBLK(REC,132) 002501 00260C ENTER FILENAME AND OWNER 002701 0028000 DO 100 I=1,4 00290 REC(I+0)=VDC(FCB(I+24)) 00300 REC(I+5)=VDC(FCB(I+28)) 00310 100 CONTINUE 003201 00330C ENTER FILE TYPE 003401 0035000 I=FCB(95)+1 00360 REC(11)=FTYPE(I) 00370 IF ( (I.EQ.1) .AND. (AND(FCB(6),$0100).NE.0) ) REC(11)=FTYPE(6) 00380 IF ( (I.EQ.1) .AND. (AND(FCB(6),$0001).NE.0) ) REC(11)=FTYPE(2) 00390 IF ( AND(FCB(6),$4001).EQ.$4001 ) REC(11)=FTYPE(7) 00400 IF ( FCB(87).EQ.1 ) CALL CCSMVA(2HED,1,1,REC(11),1,1) 004101 0042000C ENTER RECORD LENGTH ( IN BYTES ) 004301 00440 DATBUF(1)=FCB(33) 00450 CALL VLTOI(DATBUF) 00460 CALL CHO2LR(DATBUF(2),REC(13),RIGHT5) 004701 00480C ENTER CURRENT RECORD COUNT 00490001 00500 CALL CNV2W(FCB(7),INP) 00510 CALL CONVER(INP,DATBUF) 00520 CALL CHO2LR(DATBUF(3),REC(16),RIGHT6) 005301 00540C ENTER MAXIMUM RECORD COUNT 005501 0056000 CALL CNV2W(FCB(2),INP) 00570 CALL CONVER(INP,DATBUF) 00580 CALL CHO2LR(DATBUF(3),REC(20),LEFT6) 005901 00600C ENTER STATUS ( OPEN/CLOSED ) 006101 00620 I=2HCL 0063000+ ; ASSUME CLOSED 00640 IF ( AND(FCB(6),$2000).NE.0 ) I=2HOP 00650+ ; IF OPEN 00660 CALL CCSMVA(I,1,2,REC(23),2,2) 006701 00680C ENTER SECTOR ALIGNMENT CONDITION 006901 0070000 REC(25)=2HN 00710 IF ( AND(FCB(6),$8000).NE.0 ) REC(25)=2HY 007201 00730C ENTER FCB INDEX 007401 00750 REC(26)=2H$ 00760 DATBUF(1)=NFCB 0077000 CALL FRHX(DATBUF) 00780 CALL CHO2LR(DATBUF(2),REC(26),RIGHT4) 007901 00800C ENTER STARTING SECTOR ADDRESS 008101 00820 DATBUF(5)=FCB(5) 00830 CALL FRHX(DATBUF(5)) 0084000 DATBUF(1)=FCB(4) 00850 CALL FRHX(DATBUF(1)) 00860 IF ( DATBUF(4).EQ.$0030 ) DATBUF(4)=$0020 00870 CALL CHO2LR(DATBUF(4),REC(29),LEFT6) 008801 00890C ENTER SECTOR COUNT 009001 0091000 INP(1)=FCB(23) 00920 INP(2)=FCB(24) 00930 CALL CONVER(INP,DATBUF) 00940 CALL CHO2LR(DATBUF(3),REC(32),RIGHT6) 009501 00960C ENTER FCB INDICATORS 009701 0098000 DATBUF(1)=FCB(6) 00990 CALL FRHX(DATBUF) 01000 REC(36)=2H $ 01010 CALL CHO2LR(DATBUF(2),REC(37),LEFT4) 010201 01030C ENTER FILE DATE 010401 0105000 IF ( FCB(92).EQ.0 ) GOTO 140 01060+ ; IF UNSPECIFIED DATE 01070 REC(40)=VDC(FCB(92)) 01080 REC(41)=VDC(FCB(93)) 01090 REC(42)=VDC(FCB(94)) 011001 01110C ENTER EXPIRATION DATE 01120001 01130 140 IF ( FCB(89).EQ.0 ) GOTO 180 01140+ ; IF NONE SPECIFIED 01150 DATBUF(1)=VDC(FCB(89)) 01160 DATBUF(2)=VDC(FCB(90)) 01170 DATBUF(3)=VDC(FCB(91)) 01180 CALL CCSMVA(DATBUF,1,6 ,REC(43),2,6) 01190001 01200C ENTER KEY LENGTH AND KEY POSITION FOR ALL KEYS. 01210C ZERO ENTRIES ARE SUPPRESSED. 012201 01230 180 J=48 01240 DO 200 I=1,8,2 01250 DATBUF(1)=FCB(I+14) 0126000+ ; LENGTH 01270 CALL VLTOI(DATBUF) 01280 IF ( FCB(I+14).NE.0 ) REC(J)=OR(ISHIFT(DATBUF(5),8),DATBUF(6)) 01290 DATBUF(1)=FCB(I+15) 01300+ ; POSITION 01310 CALL VLTOI(DATBUF) 01320 CALL CHO2LR(DATBUF(2),REC(J+1),RIGHT5) 0133000 IF ( REC(J+3).EQ.2H 0 ) REC(J+3)=2H 01340 J=J+5 01350 200 CONTINUE 01360 RETURN 013701 01380 END 01390_ 00 00 00 00 00 00 00 00 00 __ 0(d d*TFGCNVRTLIBRARY P999999060381(0 REAL FUNCTION GCNVRT( ISTR, IPT, MPT, FLAG ) 00010 INTEGER ISTR( 1 ), NXST( 7, 3 ), ACTION( 7, 3 ), TYPE 00020 INTEGER FLAG, ZERO, NINE, BLANK, COMMA, PERIOD, PLSIGN, MNSIGN 00030 INTEGER OTHER, DIGIT, DECPT, PLUS, MINUS, SPACE, TERM 000401 00050C DATA TABLES 000601 0007000 DATA ZERO,NINE,BLANK,COMMA,PERIOD,PLSIGN,MNSIGN 00080 * / $30, $39, $20, $2C , $2E, $2B, $2D / 000901 00100 DATA OTHER, DIGIT, DECPT, PLUS, MINUS, SPACE, TERM 00110 * / 7, 2, 5, 3, 4, 1, 6 / 001201 00130C SPACE DIGIT PLUS MINUS DECML COMMA OTHER 0014000 DATA NXST 00150 * / 1, 2, 2, 2, 3, 0, -1, 00160 * 0, 2, -2, -2, 3, 0, -1, 00170 * 0, 3, -2, -2, -2, 0, -1 / 001801 00190 DATA ACTION 00200 * / 1, 2, 1, 3, 1, 6, 5, 0021000 * 6, 2, 5, 5, 1, 6, 5, 00220 * 6, 4, 5, 5, 5, 6, 5 / 002303 00240C INITIALIZE 00250 FLAG = 0 00260 X = 0.0 00270 NEG = 0 0028000 FRACF = 0.1 00290 ISTATE = 1 00300 IF( IPT .NE. MPT ) GO TO 1 00310+ CHECK FOR FINAL COMMA 00320 CALL CCSGET( ISTR, IPT, ICH ) 00330 IF ( ICH .NE. COMMA ) GOTO 1 00340 IPT = IPT +1 0035000 GO TO 200 003602 00370C GET CHARACTER 003801 00390 1 IPT = IPT + 1 00400 IF( IPT .GT. MPT ) GO TO 200 00410 CALL CCSGET( ISTR, IPT , ICHAR ) 00420001 00430C DETERMINE TYPE OF CHARACTER 004401 00450 TYPE = OTHER 00460 IF( ICHAR .GE. ZERO .AND. ICHAR .LE. NINE ) TYPE = DIGIT 00470 IF( ICHAR .EQ. PERIOD ) TYPE = DECPT 00480 IF( ICHAR .EQ. PLSIGN ) TYPE = PLUS 0049000 IF( ICHAR .EQ. MNSIGN ) TYPE = MINUS 00500 IF( ICHAR .EQ. BLANK ) TYPE = SPACE 00510 IF( ICHAR .EQ. COMMA ) TYPE = TERM 005202 00530C GET NEXT STATE, ACTION 005401 00550 NSTATE = NXST( TYPE, ISTATE ) 0056000 IACT = ACTION( TYPE, ISTATE ) 005701 00580 GO TO ( 10,20,30,40,50,60),IACT 005901 00600 10 GO TO 100 00610+ NULL ACTION 006201 0063000 20 X = 10.0 * X + ( ICHAR - ZERO ) 00640+ INTEGER PART 00650 GO TO 100 006601 00670 30 NEG = 1 00680+ MINUS SIGN 00690 GO TO 100 00700001 00710 40 X = X + FRACF * ( ICHAR - ZERO ) 00720+ FRACTIONAL PART 00730 FRACF = FRACF * 0.1 00740 GO TO 100 007501 00760 50 FLAG = NSTATE 0077000+ ERROR TERMINATION 00780 GO TO 200 007901 00800 60 GO TO 200 00810+ NORMAL TERMINATION 008202 00830C SET UP NEXT STATE 0084000 100 ISTATE = NSTATE 00850 GO TO 1 008602 00870 200 IF( NEG .NE. 0 ) X = -X 00880 GCNVRT = X 00890 RETURN 00900 END 0091000_ 00 __ 0(d d*TFGENRECLIBRARY P^999999060381(0 SUBROUTINE GENREC 00010 + /GENERATE STATUS RECORD 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C GENREC - GENERATE A STATUS RECORD. 000601 0007000C GENREC PRODUCES A SORT KEY PLUS REPORT LINE RECORD FROM A FCB AND 00080C THE SPECIFICATIONS GIVEN BY THE USER. 00090$$TXSSPBLK 00100 FNDD=1 00110 CALL SETKEY 00120+ ; ENTER PRIMARY KEY TO RECORD 001301 0014000C PRODUCE FORMATTED INFORMATION 001501 00160 CALL FMTFCB(NFCB,FCBBFR,REC(9)) 001701 00180C CLEAN OUT STATUS=CLOSED AND ALIGNMENT=NO 001901 00200 IF ( REC(31).EQ.2H C ) REC(31)=2H 0021000 IF ( REC(32).EQ.2HL ) REC(32)=2H 00220 IF ( REC(33).EQ.2HN ) REC(33)=2H 002301 00240C ENTER SECTOR COUNT FOR SUBTOTALS 002501 00260 CALL CNV2W(FCBBFR(23),REC(75)) 002701 0028000C WRITE RECORD TO THE INTERMEDIATE FILE 002901 00300 CALL WRITER(REQBUF,REC,REC,ISTAT) 00310 IF ( ISTAT.LT.0 ) CALL DSKERR(345) 00320 RETURN 003301 00340 END 0035000_ 00 00 00 00 00 00 00 00 00 __ 0( ?TFGENRPTLIBRARY P999999060381(0 SUBROUTINE GENRPT 00010 + /GENERATE FINAL REPORT 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C GENRPT - GENERATE REPORT. 000601 0007000C GENERATE THE SELECTED REPORT BY READING THROUGH THE INERMEDIATE 00080C FILE IN PRIMARY KEY ORDER. IF OWNER NAME SORT WAS SELECTED, THEN 00090C PRODUCE A BLANK LINE AS A CONTROL BREAK BETWEEN OWNER GROUPS. 00100$$TXSSPBLK 00110 INTEGER LINCNT, LINMAX, KEYVAL(8), OLD(5) 00120 INTEGER LINE1(67), LINE2(67) 00130 DATA LINE1 / '1 FILENAME OWNER FILE RECORD RECORD MAX. S', 0014000 + 'TAT FCB START SECTOR FCBIND CREATE EXP', 00150 + 'IRE K1 K2 K3 K4 ' / 00160 DATA LINE2 / ' TYPE LENGTH COUNT RECORD A', 00170 + 'LGN INDEX SECTOR COUNT DATE DA', 00180 + 'TE LEN POS LEN POS LEN POS LEN POS ' / 00190 INTEGER STFILE, STSECT(2), GTFILE, GTSECT(2), DATBUF(10) 00200 DATA STFILE / 0 / 0021000 DATA STSECT / 0,0 / 00220 DATA GTFILE / 0 / 00230 DATA GTSECT / 0,0 / 00240 INTEGER TOTLIN(66), RPTMSG(9) 00250 DATA TOTLIN / ' ????? FILES ',57*$2020 / 00260 DATA RPTMSG / ' PRINTING REPORT' / 002701 0028000 INTEGER OWNER 002902 00300 IF ( FNDD.EQ.0 ) RETURN 00310+ ; IF NO FILES FOUND 00320 CALL DISPLA(2H ,2) 00330 IF ( MODE.EQ.0 ) CALL ERROR(RPTMSG,18,36) 00340 CALL ZERO(OLD,4) 0035000+ ; PREVIOUS OWNER NAME 00360 OLD(5)=1 00370+ ; VERIFY FLAG FOR OWNER FUNCTION 00380 LINMAX=60 00390+ ; PRINT LINES PER PAGE 00400 ISTAT=MPFACE(PRNTLU,2H ,2) 00410 ISTAT=MPFACE(PRNTLU,2H ,2) 0042000 ISTAT=MPFACE(PRNTLU,2H ,2) 00430 LINE1(1)=2H 00440 ISTAT=MPFACE(PRNTLU,LINE1,134) 00450 LINE1(1)=2H1 00460 ISTAT=MPFACE(PRNTLU,LINE2,134) 00470 ISTAT=MPFACE(PRNTLU,2H ,2) 00480 LINCNT=5+3+4 0049000+ ; BASIC INFO + SPACEING + TITLES 00500 CALL ZERO(KEYVAL,8) 00510+ ; INITIAL (LOW) KEY VALUE 005201 00530C PROCESSING LOOP : GET NEXT RECORD IN KEY VALUE ORDER AND LIST IT. 005401 00550 100 CALL READR(REQBUF,REC,KEYVAL,ISTAT) 0056000 IF ( AND(ISTAT,$0100).NE.0 ) GOTO 300 00570+ ; IF END OF FILE 00580 IF ( ISTAT.LT.0 ) CALL DSKERR(262) 00590 KEYVAL(8)=KEYVAL(8)+1 00600+ ; NEXT POSSIBLE KEY VALUE 00610 IF ( SUBSRT(3).NE.1 ) GOTO 120 00620+ ; IF NO OWNER NAME SORT 0063000 IF ( OWNER(OLD,REC(14)).EQ.1 ) GOTO 120 00640+ ; IF SAME OWNER 00650 CALL CCSMVA(REC(14),1,8,OLD,1,8) 00660+ ; REMEMBER NEW OWNER NAME 00670 IF ( STFILE.EQ.0 ) GOTO 130 00680 DATBUF(1)=STFILE 00690 CALL VLTOI(DATBUF) 0070000 RIGHT(1)=5 00710 CALL CHO2LR(DATBUF(2),TOTLIN(3),RIGHT) 00720 GTFILE=GTFILE+STFILE 00730 STFILE=0 00740 CALL FDWADD(GTSECT,STSECT,GTSECT,ISTAT) 00750 CALL CONVER(STSECT,DATBUF(1)) 00760 RIGHT(1)=6 0077000 CALL CHO2LR(DATBUF(3),TOTLIN(33),RIGHT) 00780 STSECT(1)=0 00790 STSECT(2)=0 00800 ISTAT=MPFACE(PRNTLU,TOTLIN,132) 00810 LINCNT=LINCNT+2 00820 IF ( LINCNT.LT.LINMAX ) ISTAT=MPFACE(PRNTLU,$2020,2) 00830 120 LINCNT=LINCNT+1 0084000 130 IF ( LINCNT.LE.LINMAX ) GOTO 200 00850+ ; IF PAGE NOT FULL 00860 ISTAT=MPFACE(PRNTLU,LINE1,134) 00870+ ; WRITE TITLE LINES 00880 ISTAT=MPFACE(PRNTLU,LINE2,134) 00890 ISTAT=MPFACE(PRNTLU,2H ,2) 00900 LINCNT=4 0091000 200 STFILE=STFILE+1 00920 CALL FDWADD(STSECT,REC(75),STSECT,ISTAT) 00930 REC(8)=2H 00940+ ; INSERT CARRIAGE CONTROL 00950 ISTAT=MPFACE(PRNTLU,REC(8),134) 00960+ ; PRINT DETAIL LINE 00970 GOTO 100 00980001 00990 300 IF ( STFILE.EQ.0 ) RETURN 01000 DATBUF(1)=STFILE 01010 CALL VLTOI(DATBUF) 01020 RIGHT(1)=5 01030 CALL CHO2LR(DATBUF(2),TOTLIN(3),RIGHT) 01040 CALL FDWADD(GTSECT,STSECT,GTSECT,ISTAT) 0105000 CALL CONVER(STSECT,DATBUF(1)) 01060 RIGHT(1)=6 01070 CALL CHO2LR(DATBUF(3),TOTLIN(33),RIGHT) 01080 IF ( GTFILE.EQ.0 ) ISTAT=MPFACE(PRNTLU,$2020,2) 01090 ISTAT=MPFACE(PRNTLU,TOTLIN,132) 01100 ISTAT=MPFACE(PRNTLU,2H ,2) 01110 IF ( GTFILE.EQ.0 ) RETURN 0112000 GTFILE=GTFILE+STFILE 01130 DATBUF(1)=GTFILE 01140 CALL VLTOI(DATBUF) 01150 RIGHT(1)=5 01160 CALL CHO2LR(DATBUF(2),TOTLIN(3),RIGHT) 01170 CALL CONVER(GTSECT,DATBUF(1)) 01180 RIGHT(1)=6 0119000 CALL CHO2LR(DATBUF(3),TOTLIN(33),RIGHT) 01200 ISTAT=MPFACE(PRNTLU,TOTLIN,132) 01210 RETURN 012201 01230 END 01240_ 00 00 00 00 __ 0(" TTFGETVOLLIBRARY Ph999999060381(0 SUBROUTINE GETVOL( ALLVOL, VOLUME, VIT ) 00010 + /GET SPECIFIED VIT 000202 00030C GETVOL - GET SPECIFIED VIT 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 08/07/80 (CGODSO) 000601 0007000C IF ALLVOL<0 GET VIT FOR "VOLUME" 00080C IF ALLVOL>=0 GET VIT FOR VOLUME #ALLVOL 000902 00100 INTEGER ALLVOL, VOLUME(4), VIT(23) 001101 00120 INTEGER VITADR 001302 0014000 IF ( ALLVOL.LT.0 ) GOTO 200 00150+ ; IF VOLUME NAME SPECIFIED 00160 100 IF ( ALLVOL.GT.7 ) GOTO 300 00170+ ; IF TOO MANY 00180 ALLVOL=ALLVOL+1 00190 CALL GETVIT( ALLVOL, VIT ) 00200 IF ( VIT(1).LE.0 ) GOTO 100 0021000+ ; TRY NEXT 00220 CALL CCSMVA(VIT(2),1,8, VOLUME, 1, 8 ) 00230 RETURN 002401 00250 200 CALL SEKVIT( VOLUME, VITADR, INDEX ) 00260 IF ( VITADR.EQ.0 ) GOTO 300 00270 CALL GETVIT( INDEX, VIT ) 0028000 CALL CCSMVA(VIT(2),1,8, VOLUME, 1, 8 ) 00290 IF ( VIT(1).NE.0 ) RETURN 003001 00310 300 VOLUME(1)=0 00320+ ; ERROR 00330 RETURN 003401 0035000 END 00360_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(dw d*TFGINPUTLIBRARY P999999060381(0 SUBROUTINE GINPUT ( X, N ) 00010 DIMENSION X( 1 ) 00020 INTEGER FLAG, BUFFER(41), MSG1( 26 ) 00030 DATA MSG1 / $0D0A, 00040 1 'ILLEGAL CHARACTER IN INPUT, RE-TYPE LINE PLEASE ', 00050 2 $0D0A / 00060 DATA LMSG1 / 52 / 00070003 00080 I = 1 00090 1 CALL WTREAD ( 5 , -1, 0, 0, -1, BUFFER, 80, ITC ) 00100 2 IF ( ITC .NE. 4 ) GO TO 10 001101 00120C PROCESS RUBOUT S 001301 0014000 CALL WTREAD ( 5, -1, $0D18, 2, -1, BUFFER, 80, ITC ) 00150 GO TO 2 001602 00170 10 II = I 00180+ ESTABLISH TEMP POINTER 00190 IPT = 0 00200+ SETUP SCAN POINTER 0021000 MPT = BUFFER(41) 00220+ SETUP SCAN LIMIT 002302 00240 20 X( II ) = GCNVRT ( BUFFER, IPT, MPT, FLAG ) 00250 IF( FLAG .GE. 0 ) GO TO 25 002601 00270C PROCESS INPUT ERROR 0028000 CALL WTREAD ( 5, -1, MSG1, LMSG1, -1, 0, 0, ITC ) 00290 GO TO 1 003002 00310 25 IF( II .GE. N ) RETURN 00320+ IF DONE, RETURN 003302 00340 II = II + 1 0035000+ BUMP TEMP POINTER 00360 IF( IPT .LE. MPT ) GO TO 20 00370+ CHARACTERS LEFT IN THIS LINE? 003801 00390C NO, GET NEXT LINE 00400 I = II 00410+ UPDATE PERMANENT POINTER 0042000 CALL WTREAD( 5, -1, $0D0A, 2, -1, 0, 0, ITC ) 00430 GO TO 1 004402 00450 END 00460_ 00 00 00 00 00 00 00 00 __ 0(d d*TFGTDATALIBRARY P"999999060381(0 SUBROUTINE GTDATA 00010 + /SELECT FCB-S 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C GTDATA - GET DATA 000601 0007000C GTDATA SELECTS FCB-S FOR SSP PROCESSING. 00080$$TXSSPBLK 00090 INTEGER OWNER, WCMTCH 001002 00110 FILCNT=0 00120+ ; COUNTING HITS 00130 MAXFIL=VIT(18) 0014000 CALL CCSBLK(REC,148) 00150 100 CALL NXTFCB 00160 IF ( AND(ISTAT,$1000).NE.0 ) RETURN 00170+ ; IF FCB RANGE ERROR 00180 FILCNT=FILCNT+1 00190+ ; COUNT A HIT 00200C IF ( OWNER(USERID,FCBBFR(29)).EQ.1 ) CALL GENREC 0021000 IF ( (OWNER(USERID,FCBBFR(29)).EQ.1) 00220 +.AND.(WCMTCH(PATERN,FCBBFR(25),8,1R?).EQ.1) ) CALL GENREC 00230 IF ( FILCNT.LT.MAXFIL ) GOTO 100 00240+ ; PRESUMABLY MORE TO FIND 002501 00260 RETURN 002701 0028000 END 00290_ 00 00 00 00 00 00 00 00 00 00 __ 0(d d*TFGTPARMLIBRARY P:999999060381(0 SUBROUTINE GTPARM(PLIST,NPARM) 00010 + /GET REQUEST PARAMETERS SUMMARY-*** 000201 00030C GTPARM - GET REQUEST LINE PARAMETERS 00040C 00050C PLIST - PARMETER LIST 00060C NPARM - NUMBER OF PARAMETERS EXPECTED ( <1 IF PRG NAME ) 00070001 00080 INTEGER PLIST(4,1), NPARM 000901 00100 INTEGER COMMA, REQLIN(40) 00110 DATA COMMA / 1R, / 001202 00130 CALL NFETCH(REQLIN,LEN) 0014000 I1=0 00150 CALL SCAN(REQLIN,COMMA,I1,LEN) 00160 IF ( NPARM.LT.1 ) GOTO 200 00170+ ; RETRIEVE PROGRAM NAME ONLY 00180 CALL CCSBLK(PLIST,8*NPARM) 00190 N=0 00200 DO 100 IPARM=1,NPARM 0021000 I0=I1 00220 CALL SCAN(REQLIN,COMMA,I1,LEN) 00230 IF ( I1.EQ.0 ) GOTO 300 00240 M=I1-I0 00250 IF ( M.GT.1 ) CALL CCSMVA(REQLIN,I0+1,M-1,PLIST(1,IPARM),1,8) 00260 N=IPARM 00270 100 CONTINUE 0028000 GOTO 300 002901 00300 200 CALL CCSMVA(REQLIN,1,I1-1,PLIST,1,8) 00310 N=1 003201 00330 300 IF ( N.LT.1 ) RETURN 00340 DO 320 IPARM=1,N 0035000 CALL LJUST(PLIST(1,IPARM),8) 00360 320 CONTINUE 00370 RETURN 003801 00390 END 00400 SUBROUTINE LJUST(STR,LEN) 00410 + /LEFT JUSTIFY STRING SUMMARY-*** 00420001 00430 INTEGER STR(1), LEN 004401 00450 IF ( LEN.LT.1 ) RETURN 00460 I=0 00470 DO 100 J=1,LEN 00480 CALL CCSGET(STR,J,ICH) 0049000 IF ( ICH.EQ.1R ) GOTO 100 00500 I=I+1 00510 CALL CCSPUT(1R ,J,STR) 00520 CALL CCSPUT(ICH,I,STR) 00530 100 CONTINUE 00540 RETURN 005501 0056000 END 00570_ 00 00 00 00 00 00 __ 0(d d*TFHASH LIBRARY P999999060381(0 INTEGER FUNCTION HASH(FNAME,OWNER,VIT,FDDINX) 00010 + /HASH FILE NAME + OWNER NAME INTO FDD 000202 00030C HASH - HASH FILE NAME AND OWNER NAME INTO FDD FOR THE VOLUME 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 08/07/80 (CGODSO) 000602 0007000 INTEGER FNAME(4), OWNER(4), VIT(23), FDDINX(2) 000801 00090 INTEGER MMADDR(2), FDDBFR(96) 001002 00110 HASH=-1 00120+ ; ASSUME NOT FOUND 001301 0014000 INDEX=AND( FNAME(1)+FNAME(2), $7FFF ) 00150+ ; " SUMMMATION " 00160 INDEX=AND( INDEX+FNAME(3), $7FFF ) 00170 INDEX=AND( INDEX+FNAME(4), $7FFF ) 00180 INDEX=AND( INDEX+OWNER(1), $7FFF ) 00190 INDEX=AND( INDEX+OWNER(2), $7FFF ) 00200 INDEX=AND( INDEX+OWNER(3), $7FFF ) 0021000 INDEX=AND( INDEX+OWNER(4), $7FFF ) 00220 IDIV=VIT(19)/2 00230+ ; VIT(19) = VINFDB 00240 INDEX=INDEX/IDIV 00250 ASSEM $4400,+INDEX 00260+ ; REMAINDER = INDEX OF FDB 00270 FDDINX(1)=INDEX 0028000 FDDINX(2)=INDEX 00290 MMADDR(1)=0 00300 MMADDR(2)=INDEX 00310 100 CALL FDWADD( MMADDR, VIT(15), MMADDR, IOVF ) 00320+ ; NFDB + VIFDD* 00330 CALL MMREAD( AND(VIT(1),$7FFF), 96, MMADDR, FDDBFR ) 00340 DO 120 I=2,85,9 0035000 INDEX=I 00360 IF ( MATCH( FDDBFR(I), FNAME, OWNER ).EQ.1 ) GOTO 200 00370 120 CONTINUE 00380 IF ( FDDBFR(1).EQ.0 ) RETURN 00390+ ; NO MORE OVERFLOW BLOCKS 00400 MMADDR(1)=0 00410 MMADDR(2)=FDDBFR(1)-1 0042000 FDDINX(2)=MMADDR(2) 00430 GOTO 100 004401 00450 200 HASH=FDDBFR(INDEX+8) 00460 RETURN 004701 00480 END 0049000 INTEGER FUNCTION MATCH( FDB, FNAME, OWNER ) 00500 + /MATCH FDD ENTRY FOR FILE NAME + OWNER NAME 005102 00520C MATCH - MATCH FDD ENTRY FOR FILE NAME AND OWNER NAME 005301 00540C CHECK FDB(1:8) = ( FNAME(1:4) ; OWNER(1:4) ) 005502 0056000 INTEGER FDB(9), FNAME(4), OWNER(4) 005702 00580 MATCH=0 00590+ ; ASSUME NO MATCH 00600 DO 100 I=1,4 00610 IF ( FNAME(I).NE.FDB(I) ) RETURN 00620 IF ( OWNER(I).NE.FDB(I+4) ) RETURN 0063000 100 CONTINUE 00640 MATCH=1 00650+ ; WHAT JOY, IT MATCHES! 00660 RETURN 006701 00680 END 00690_ 00 00 00 00 00 __ 0(2# 2TFHEXASCLIBRARY P999999060381(0 SUBROUTINE HEXASC(IN,OUT) 00010 + /HEX TO ASCII CONVERSION 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 05/01/80 (CGODSO) 000401 00050C HEXASC - HEX TO ASCII CONVERSION (CHEAP/DIRTY) 000601 0007000C HEXASC CONVERTS A WORD TO 2 WORDS OF PACKED ASCII. 00080C 00090C IN - SINGLE VALUE TO CONVERT 00100C OUT - 2 WORD ( 4 CHARACTER ) CONVERSION 001102 00120 INTEGER IN, OUT(2) 001301 0014000 INTEGER CHAR(16) 00150 DATA CHAR / $30,$31,$32,$33,$34,$35,$36,$37,$38,$39, 00160 + $41,$42,$43,$44,$45,$46 / 001702 00180 I1= 1 + AND(ISHIFT(IN,4),$000F) 00190 I2= 1 + AND(ISHIFT(IN,8),$000F) 00200 OUT(1)=OR(ISHIFT(CHAR(I1),8),CHAR(I2)) 0021000 I1= 1 + AND(ISHIFT(IN,12),$000F) 00220 I2= 1 + AND(IN,$000F) 00230 OUT(2)=OR(ISHIFT(CHAR(I1),8),CHAR(I2)) 00240 RETURN 002501 00260 END 00270_ 00 00 00 00 __ 0(d9 d*TFHEXDECLIBRARY P999999060381(0 SUBROUTINE HEXDEC(IN,OUT) 00010 + /BINARY TO DECIMAL CHARACTER CONVERSION 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 08/07/80 (CGODSO) 000402 00050C HEXDEC - BINARY TO DECIMAL CHARACTER CONVERSION 000601 0007000C IN - INTEGER TO CONVERT 00080C OUT - 3 WORD ARRAY FOR CONVERSION 000902 00100 INTEGER IN, OUT(3) 001102 00120 LIN=IABS( IN ) 00130 L10000= LIN - MOD( LIN, 10000 ) 0014000 LIN = LIN - L10000 00150 L1000 = LIN - MOD( LIN, 1000 ) 00160 LIN = LIN - L1000 00170 L100 = LIN - MOD( LIN, 100 ) 00180 LIN = LIN - L100 00190 L10 = LIN - MOD( LIN, 10 ) 00200 L1 = LIN - L10 00210001 00220 L10000= L10000 / 10000 + $0030 00230 L1000 = L1000 / 1000 + $0030 00240 L100 = L100 / 100 + $0030 00250 L10 = L10 / 10 + $0030 00260 L1 = L1 / 1 + $0030 002701 0028000 IF ( L10000.NE.$0030 ) GOTO 100 00290 L10000=$0020 00300 IF ( L1000 .NE.$0030 ) GOTO 100 00310 L1000 =$0020 00320 IF ( L100 .NE.$0030 ) GOTO 100 00330 L100 =$0020 00340 IF ( L10 .NE.$0030 ) GOTO 100 0035000 L10 =$0020 003601 00370 100 LSIGN=$0020 00380 IF ( IN.LT.0 ) LSIGN=$002D 003901 00400 OUT(1)=OR( ISHIFT( LSIGN, 8 ), L10000 ) 00410 OUT(2)=OR( ISHIFT( L1000, 8 ), L100 ) 0042000 OUT(3)=OR( ISHIFT( L10 , 8 ), L1 ) 00430 RETURN 004401 00450 END 00460_ 00 00 00 00 00 00 00 00 __ 0(d TTFICNVRTLIBRARY PB999999060381(0 INTEGER FUNCTION ICNVRT( ISTR, IPT, MPT, FLAG ) 000102 00020C ICNVRT - INTEGER CONVERSION ROUTINE 000301 00040C ICNVRT SCANS A CHARACTER STRING AND CONVERTS AN INTEGER UNTIL A 00050C SEPERATOR IS ENCOUNTERED. THE CONVERSION IS FROM AN ASCII STRING 00060C TO INTERNAL HEXIDECIMAL ( BASE 10 CONVERSION ). 0007000C 00080C ISTR - TEXT STRING 00090C IPT - INITIAL POSITION FOR SCAN ( FIRST BYTE INDEX - 1 ) 00100C IPT IS INREMENTED TO THE SEPERATOR DURING THE SCAN. 00110C MPT - INDEX OF LAST BYTE IN STRING 00120C FLAG - SUCCESS/FAILURE INDICATOR 00130C =0, IF SUCCESSFUL CONVERSION 0014000C OTHERWISE, NON-ZERO STATE INFORMATION. 00150C 00160C RETURN VALUE: INTEGER CONVERSION IN HEX 001701 00180 INTEGER X 00190 INTEGER ISTR( 1 ), NXST( 7, 3 ), ACTION( 7, 3 ), TYPE 00200 INTEGER FLAG, ZERO, NINE, BLANK, COMMA, PERIOD, PLSIGN, MNSIGN 0021000 INTEGER OTHER, DIGIT, DECPT, PLUS, MINUS, SPACE, TERM 002201 00230C DATA TABLES 002401 00250 DATA ZERO,NINE,BLANK,COMMA,PERIOD,PLSIGN,MNSIGN 00260 * / $30, $39, $20, $2C , $2E, $2B, $2D / 002701 0028000 DATA OTHER, DIGIT, DECPT, PLUS, MINUS, SPACE, TERM 00290 * / 7, 2, 5, 3, 4, 1, 6 / 003001 00310C SPACE DIGIT PLUS MINUS DECML COMMA OTHER 00320 DATA NXST 00330 * / 1, 2, 2, 2, -1, 0, -1, 00340 * 0, 2, -2, -2, -1, 0, -1, 0035000 * 0, 3, -2, -2, -1, 0, -1 / 003601 00370 DATA ACTION 00380 * / 1, 2, 1, 3, 5, 6, 5, 00390 * 6, 2, 5, 5, 5, 6, 5, 00400 * 6, 4, 5, 5, 5, 6, 5 / 004103 0042000C INITIALIZE 00430 FLAG = 0 00440 X = 0 00450 NEG = 0 00460 CONTINUE 00470 ISTATE = 1 00480 IF( IPT .NE. MPT ) GO TO 1 0049000+ CHECK FOR FINAL COMMA 00500 CALL CCSGET( ISTR, IPT, ICHAR ) 00510 IF( ICHAR .NE. COMMA ) GO TO 1 00520 IPT = IPT +1 00530 GO TO 200 005402 00550C GET CHARACTER 00560001 00570 1 IPT = IPT + 1 00580 IF( IPT .GT. MPT ) GO TO 200 00590 CALL CCSGET( ISTR, IPT, ICHAR ) 006001 00610C DETERMINE TYPE OF CHARACTER 006201 0063000 TYPE = OTHER 00640 IF( ICHAR .GE. ZERO .AND. ICHAR .LE. NINE ) TYPE = DIGIT 00650 IF( ICHAR .EQ. PERIOD ) TYPE = DECPT 00660 IF( ICHAR .EQ. PLSIGN ) TYPE = PLUS 00670 IF( ICHAR .EQ. MNSIGN ) TYPE = MINUS 00680 IF( ICHAR .EQ. BLANK ) TYPE = SPACE 00690 IF( ICHAR .EQ. COMMA ) TYPE = TERM 00700002 00710C GET NEXT STATE, ACTION 007201 00730 NSTATE = NXST( TYPE, ISTATE ) 00740 IACT = ACTION( TYPE, ISTATE ) 007501 00760 GO TO ( 10,20,30,40,50,60),IACT 00770001 00780 10 GO TO 100 00790+ NULL ACTION 008001 00810 20 X = 10 * X + ( ICHAR - ZERO ) 00820+ INTEGER PART 00830 GO TO 100 00840001 00850 30 NEG = 1 00860+ MINUS SIGN 00870 GO TO 100 008801 00890 40 CONTINUE 00900+ FRACTIONAL PART 0091000 CONTINUE 00920 GO TO 100 009301 00940 50 FLAG = NSTATE 00950+ ERROR TERMINATION 00960 GO TO 200 009701 0098000 60 GO TO 200 00990+ NORMAL TERMINATION 010002 01010C SET UP NEXT STATE 01020 100 ISTATE = NSTATE 01030 GO TO 1 010402 0105000 200 IF( NEG .NE. 0 ) X = -X 01060 ICNVRT = X 01070 RETURN 01080 END 01090_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( TTFIINPUTLIBRARY P999999060381(0 SUBROUTINE IINPUT ( IX, N ) 00010 DIMENSION IX( 1 ) 00020 INTEGER FLAG, BUFFER(41), MSG1( 26 ) 00030 DATA MSG1 / $0D0A, 00040 1 'ILLEGAL CHARACTER IN INPUT, RE-TYPE LINE PLEASE ', 00050 2 $0D0A / 00060 DATA LMSG1 / 52 / 00070003 00080 I = 1 00090 1 CALL WTREAD ( 5 , -1, 0, 0, -1, BUFFER, 80, ITC ) 00100 2 IF ( ITC .NE. 4 ) GO TO 10 001101 00120C PROCESS RUBOUT S 001301 0014000 CALL WTREAD ( 5, -1, $0D18, 2, -1, BUFFER, 80, ITC ) 00150 GO TO 2 001602 00170 10 II = I 00180+ ESTABLISH TEMP POINTER 00190 IPT = 0 00200+ SETUP SCAN POINTER 0021000 MPT = BUFFER(41) 00220+ SETUP SCAN LIMIT 002302 00240 20 IX( II ) = ICNVRT ( BUFFER, IPT, MPT, FLAG ) 00250 IF( FLAG .GE. 0 ) GO TO 25 002601 00270C PROCESS INPUT ERROR 0028000 CALL WTREAD ( 5, -1, MSG1, LMSG1, -1, 0, 0, ITC ) 00290 GO TO 1 003002 00310 25 IF( II .GE. N ) RETURN 00320+ IF DONE, RETURN 003302 00340 II = II + 1 0035000+ BUMP TEMP POINTER 00360 IF( IPT .LE. MPT ) GO TO 20 00370+ CHARACTERS LEFT IN THIS LINE? 003801 00390C NO, GET NEXT LINE 00400 I = II 00410+ UPDATE PERMANENT POINTER 0042000 CALL WTREAD( 5, -1, $0D0A, 2, -1, 0, 0, ITC ) 00430 GO TO 1 004402 00450 END 00460_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(d d*TFINIT LIBRARY PX999999060381(0 SUBROUTINE INIT(L,LINE1,LINE2) 00010 + /CCS 2.0 $$USERID MANAGER DECK07 SUMMARY-*** 000202 00030C INIT - INITIALIZATION. 00040C INITIALIZE THE USER IDENTIFIER PROCESSING BY: 00050C 1. DETERMINE SYSTEM HEADER INFORMATION (LINE1 & LINE2); 00060C 2. OPEN FILE $$USERID; 0007000C 3. DETERMINE THE TERMINAL LOGICAL UNIT NUMBER (LU/L); 00080C 4. PROVIDE SOME COMMON COMMUNICATION AND DATA DEFINITIONS. 000902 00100 INTEGER L, LINE1(17), LINE2(12) 001101 00120 INTEGER DATM(12), MODE, PORT, MSGSYS(17), MSGDAT(12), MSGGOD(16) 001301 0014000 DATA MSGGOD / 'REQUEST USERID CANNOT BE FOUND' / 00150 DATA MSGSYS / ' ********************************' / 00160 DATA MSGDAT / ' **/**/** ****' / 00170$$WSUSRBLK 00180$$WSUSRDAT 00190 CALL PGMIN(CURID,LU,MODE,PORT) 00200O GOTO 8902 0021000O8901 CONTINUE 00220 IF ( PORT.NE.00 ) GOTO 200 00230 IF ( CURID(1).NE.2H$$ ) GOTO 200 00240 IF ( CURID(2).NE.2H ) GOTO 200 00250 IF ( CURID(3).NE.2H ) GOTO 200 00260 IF ( CURID(4).NE.2H ) GOTO 200 00270O8902 CONTINUE 0028000O IDATA(1)=2H'' 00290 CALL TRM 00300+ ; LOAD IN TERMINAL PORT CODES 00310 CALL GETSYS(MSGSYS(2)) 00320+ ; SYSTEM IDENTIFICATION 00330 CALL DATTIM(DATM) 00340+ ; CURRENT DATE/TIME 0035000 L=LU 00360 MSGDAT(6)=DATM(2) 00370+ ; MM 00380 MSGDAT(7)=OR(AND(DATM(3)/$0100,$00FF),$2F00) 00390+ ; /D 00400 MSGDAT(8)=OR(AND(DATM(3),$00FF)*$0100,$002F) 00410+ ; D/ 0042000 MSGDAT(9)=DATM(1) 00430+ ; YY 00440 CALL HEXDEC(DATM(11),MSGDAT(10)) 00450 MSGDAT(10)=2H 00460 DO 100 I=1,17 00470 LINE1(I)=MSGSYS(I) 00480 100 CONTINUE 0049000 DO 120 I=1,12 00500 LINE2(I)=MSGDAT(I) 00510 120 CONTINUE 00520 CALL OPENFL(REQBLK,IDATA,ISTAT) 00530 IF ( ISTAT.GE.0 ) RETURN 00540 CALL MSG(1) 00550 CALL PGMOUT 00560001 00570C MUST RUN UNDER $$ AT 00. 005801 00590 200 CALL WTREAD(LU,-1,$0A0D,2,-1,0,0,TX) 00600 CALL WTREAD(LU,-1,MSGGOD,32,-1,0,0,TX) 00610 CALL PGMOUT 006201 0063000 END 00640_ 00 00 00 00 00 __ 0(29 2TFLASTCHLIBRARY P999999060381(0 INTEGER FUNCTION LASTCH(STR,N) 000102 00020C LASTCH - LAST CHARACTER 000301 00040C LASTCH DETERMINES THE BYTE POSITION OF THE LAST NON-BLANK 00050C CHARACTER IN THE SPECIFIED STRING. 00060C 0007000C STR - STRING TO SCAN 00080C N - NUMBER OF BYTES IN "STR" 00090C LASTCH - INDEX OF LAST NON-BLANK CHARACTER IN "STR" 001001 00110 INTEGER STR(1), N 001201 00130 INTEGER BLANK 0014000 DATA BLANK / $0020 / 001502 00160 LASTCH=1 00170 IF ( N.LE.0 ) RETURN 00180 DO 100 I=1,N 00190 LASTCH= (N+1) - I 00200 CALL CCSGET(STR,LASTCH,ICH) 0021000 IF ( ICH.NE.BLANK ) RETURN 00220 100 CONTINUE 00230 LASTCH=1 00240 RETURN 002501 00260 END 00270_ 00 00 00 00 __ 0(O iTFLBASICLIBRARY P999999060381(0 OPT XL 00010 PROGRAM LBASIC 000201 00030 ASSIGN 100 TO I 00040 CALL PGMINT(I,0) 00050 CALL LBPPRS 00060 CALL BLSTAL 0007000 100 CALL PGMOUT 000801 00090 END 00100 SUBROUTINE BLSTAL 001101 00120 INTEGER REC(400), BUF(140), IX, NCHAR 00130 INTEGER ISTAT, IDATA(15), IREQ(24) 00140001 00150 COMMON / BLPBLK / REC, BUF, IX, NCHAR 00160 COMMON / BLPBLK / ISTAT, IDATA, IREQ 001701 00180 100 IF ( REC(2).NE.-1 ) RETURN 00190 CALL RDREC 00200 IX=4 0021000 NLINES=REC(3) 00220 DO 200 I=1,NLINES 00230 CALL GETLIN 00240 CALL MPWRIX(9,BUF,NCHAR) 00250 200 CONTINUE 00260 GOTO 100 002701 0028000 END 00290 SUBROUTINE RDREC 003001 00310 INTEGER GETNAM(3) 00320 DATA GETNAM / 'GETS ' / 003301 00340 INTEGER REC(400), BUF(140), IX, NCHAR 0035000 INTEGER ISTAT, IDATA(15), IREQ(24) 003601 00370 COMMON / BLPBLK / REC, BUF, IX, NCHAR 00380 COMMON / BLPBLK / ISTAT, IDATA, IREQ 003901 00400 DO 100 I=1,289,96 00410 CALL GETS(IREQ,REC(I),0,ISTAT) 0042000 IF ( ISTAT.LT.0 ) GOTO 900 00430 100 CONTINUE 00440 RETURN 004501 00460 900 CALL ERROR(GETNAM,ISTAT) 00470 CALL PGMOUT 004801 0049000 END 00500 SUBROUTINE GETLIN 005101 00520 INTEGER REC(400), BUF(140), IX, NCHAR 00530 INTEGER ISTAT, IDATA(15), IREQ(24) 005401 00550 COMMON / BLPBLK / REC, BUF, IX, NCHAR 0056000 COMMON / BLPBLK / ISTAT, IDATA, IREQ 005701 00580 DO 100 I=1,50 00590 BUF(I)=2H 00600 100 CONTINUE 00610 NW=REC(IX)-2 00620 IX=IX+1 0063000 CALL HEXDEC(REC(IX),BUF(2)) 00640 BUF(2)=2H 00650 IX=IX+1 00660 NCHAR=2+6+2 00670 IF ( NW.LE.0 ) RETURN 00680 DO 200 I=1,NW 00690 CALL STUFF2(REC(IX),BUF,NCHAR) 0070000 IX=IX+1 00710 200 CONTINUE 00720 RETURN 007301 00740 END 00750 SUBROUTINE STUFF2(REC,BUF,NCHAR) 007601 0077000 INTEGER REC, BUF(1), NCHAR 007801 00790 I1=AND( REC/$0100, $00FF ) 00800 IF ( I1.EQ.$0003 ) RETURN 00810 IF ( (I1.LT.$0020) .OR. ($005F.LT.I1) ) I1=$002E 00820 NCHAR=NCHAR+1 00830 CALL PUTCH(I1,BUF,NCHAR) 00840001 00850 I2=AND( REC, $00FF ) 00860 IF ( I2.EQ.$0003 ) RETURN 00870 IF ( (I2.LT.$0020) .OR. ($005F.LT.I2) ) I2=$002E 00880 NCHAR=NCHAR+1 00890 CALL PUTCH(I2,BUF,NCHAR) 00900 RETURN 00910001 00920 END 00930 SUBROUTINE HEXDEC(IN,OUT) 009401 00950 INTEGER IN, OUT(3) 009601 00970 NUM=IN 0098000 IF ( NUM.LT.0 ) NUM=-NUM 00990 I1=NUM/10000 01000 I2= ( NUM - I1*10000 ) / 100 01010 I3= NUM - (NUM/100)*100 01020 CALL C2D(I1,OUT(1)) 01030 CALL C2D(I2,OUT(2)) 01040 CALL C2D(I3,OUT(3)) 0105000 RETURN 010601 01070 END 01080 SUBROUTINE C2D(IN,OUT) 010901 01100 INTEGER IN, OUT 011101 0112000 I1=IN/10 01130 I2=IN-I1*10 01140 OUT = ( $0030+I1 )*$0100 + ( $0030+I2 ) 01150 RETURN 011601 01170 END 01180 SUBROUTINE ERROR(NAME,ISTAT) 01190001 01200 INTEGER NAME(3), ISTAT 012101 01220 INTEGER MSG(12) 01230 DATA MSG / $0D0A, 'FM ERROR ?????? $????' / 012401 01250 MSG(7)=NAME(1) 0126000 MSG(8)=NAME(2) 01270 MSG(9)=NAME(3) 01280 CALL ASCII(ISTAT,MSG(11)) 01290 CALL WTREAD(5,-1,MSG,24,-1,0,0,ITC) 01300 CALL PGMOUT 013101 01320 END 0133000 SUBROUTINE ASCII(IN,OUT) 013401 01350 INTEGER IN, OUT(2) 013601 01370 INTEGER ADIG(16) 01380 DATA ADIG / $30, $31, $32, $33, $34, $35, $36, $37, $38, 01390 + $39, $41, $42, $43, $44, $45, $46 / 01400001 01410 I1=AND( IN/$1000, $000F ) +1 01420 I2=AND( IN/$0100, $000F ) +1 01430 I3=AND( IN/$0010, $000F ) +1 01440 I4=AND( IN, $000F ) +1 01450 OUT(1)= ADIG(I1)*$0100 + ADIG(I2) 01460 OUT(2)= ADIG(I3)*$0100 + ADIG(I4) 0147000 RETURN 014801 01490 END 01500 SUBROUTINE LBPPRS 015101 01520 INTEGER MSG(13), FERR(9), OPENAM(3), OFILM(21) 01530 DATA MSG / $0D0A, 'ENTER BASIC FILE NAME: ' / 0154000 DATA FERR / $0D0A, 'NOT A BASIC FILE' / 01550 DATA OPENAM / 'OPENFL' / 01560 DATA OFILM / ' LIST OF BASIC FILE: ???????? ????????' / 015701 01580 INTEGER REC(400), BUF(140), IX, NCHAR 01590 INTEGER ISTAT, IDATA(15), IREQ(24) 016001 0161000 COMMON / BLPBLK / REC, BUF, IX, NCHAR 01620 COMMON / BLPBLK / ISTAT, IDATA, IREQ 016301 01640 100 DO 200 I=1,12 01650 IDATA(I)=2H 01660 200 CONTINUE 01670 CALL WTREAD(5,-1,MSG,26,-1,IDATA,8,ITC) 0168000 IF ( ITC.EQ.4 ) GOTO 100 01690 CALL PGMIN(IDATA(5),ITC,ITC,ITC) 01700 IDATA(13)=0 01710 IDATA(14)=1 01720 IDATA(15)=0 01730 DO 300 I=1,24 01740 IREQ(I)=0 0175000 300 CONTINUE 01760 CALL OPENFL(IREQ,IDATA,ISTAT) 01770 IF ( ISTAT.LT.0 ) GOTO 9000 01780 CALL GETFCB(IREQ,0,0,REC,ISTAT) 01790C* IF ( ISTAT.LT.0 ) 01800 IF ( REC(33).NE.192 ) GOTO 9001 01810 IF ( REC(6).NE.$2000 ) GOTO 9001 0182000 CALL MPWRIX(9,2H ,2) 01830 CALL MPWRIX(9,2H ,2) 01840 DO 700 I=1,4 01850 OFILM(I+12)=IDATA(I) 01860 OFILM(I+17)=IDATA(I+4) 01870 700 CONTINUE 01880 CALL MPWRIX(9,OFILM,42) 0189000 CALL MPWRIX(9,2H ,2) 01900 CALL MPWRIX(9,2H ,2) 01910 REC(2)=-1 01920 BUF(1)=2H 01930 BUF(5)=2H 01940 RETURN 019501 0196000 9000 CALL ERROR(OPENAM,ISTAT) 01970 CALL PGMOUT 01980 9001 CALL WTREAD(5,-1,FERR,18,-1,0,0,ITC) 01990 CALL PGMOUT 020001 02010 END 02020_ 00 00 00 00 00 00 00 __ 0( iTFLHOLESLIBRARY P999999060381(0 SUBROUTINE LHOLES 00010 + /LIST HOLES 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C LHOLES - CONDITIONALLY LIST AVAILABLE SPACE DIRECTORY HOLES 000601 0007000C GENERATE ENTRIES FOR THE HOLES. 000801 00090C IF RUNNING FROM MASTER CONSOLE AND SELECTING ALL OWNER IDENTIFIERS 00100C THEN PRODUCE ENTRIES FOR HOLES IN THE AVAILABLE SPACE DIRECTORY. 00110$$TXSSPBLK 00120 INTEGER N 00130 DATA N / 0 / 0014000 INTEGER DAT(10), M1, M2, INP(2), RGHT(2), LFT6(2), ONE2(2) 00150 DATA RGHT / 6,1 / 00160 DATA LFT6 / 6,0 / 00170 DATA ONE2 / 0,1 / 00180 INTEGER HOLNAM(9), NOSPAC(3) 00190 DATA HOLNAM / ' AVAILABLE ' / 00200 DATA NOSPAC / ' *' / 00210002 00220 IF ( NOPORT.NE.00 ) RETURN 00230+ ; MUST BE AT MASTER CONSOLE 00240 IF ( ONEID(3).NE.-1 ) RETURN 00250+ ; MUST SELECT ALL OWNER IDS 002601 00270 NFCB=0 0028000 CALL ZERO(FCBBFR(29),4) 00290 CALL CCSBLK(REC,148) 00300 CALL CCSMVA(HOLNAM,1,18,REC(9),1,18) 00310+ ; SET FILE NAME / OWNER NAME 003201 00330C READ AVAILABLE SPACE DIRECTORY BY 64 SECTOR CHUNKS 003401 0035000 LENGTH(1)=64*96 00360 LENGTH(2)=VIT(9) 00370 LENGTH(3)=VIT(10) 00380 100 IFLAG=MMREAD(VIT(1),LENGTH(1),LENGTH(2),DSKBFR) 003901 00400C PROCESS EACH 4 WORD ENTRY IN THE AVAILABLE SPACE DIRECTORY 004101 0042000 DO 180 I=1,6144,4 00430 IF ( DSKBFR(I).EQ.-1 ) RETURN 00440+ ; IF END OF LIST 00450 CALL CCSMVA(DSKBFR(I+2),1,8,FCBBFR(4),1,8) 00460+ ; FILE SECTOR ADDRESS 00470 CALL CCSMVA(DSKBFR(I+2),1,8,FCBBFR(25),1,8) 00480+ ; " FILE NAME " 0049000 CALL SETKEY 005001 00510C GENERATE INFORMATIVE RECORD 005201 00530 DAT(5)=DSKBFR(I+3) 00540+ ; SECTOR ADDRESS OF HOLE 00550 CALL FRHX(DAT(5)) 0056000 DAT(1)=DSKBFR(I+2) 00570 CALL FRHX(DAT(1)) 00580 IF ( DAT(4).EQ.$0030 ) DAT(4)=$0020 00590 CALL CHO2LR(DAT(4),REC(37),LFT6) 00600 CALL FDWSUB(DSKBFR(I),ONE2,REC(75),ISTAT) 00610+ ; FILE SIZE OF HOLE 00620 INP(1)=REC(75) 0063000 INP(2)=REC(76) 00640 CALL CONVER(INP,DAT) 00650 CALL CHO2LR(DAT(3),REC(40),RGHT) 00660 IF ( (DSKBFR(I).EQ.0) .AND. (DSKBFR(I+1).EQ.1) ) 00670 + CALL CCSMVA(NOSPAC,1,6,REC(40),2,6) 006801 00690 CALL WRITER(REQBUF,REC,REC,ISTAT) 0070000 IF ( ISTAT.LT.0 ) CALL DSKERR(345) 00710 180 CONTINUE 00720 INP(1)=0 00730 INP(2)=64 00740 CALL FDWADD(LENGTH(2),INP,LENGTH(2),ISTAT) 00750+ ; NEXT READ ADDRESS 00760 GOTO 100 00770001 00780 END 00790_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(# TTFLIST LIBRARY P&999999060381(0 PROGRAM LIST 000102 00020C LIST,FILENAME,OWNER,VOLUME,HEX 000301 00040C COPYRIGHT CONTROL DATA CORPORATION 08/08/80 (CGODSO) 000502 00060 INTEGER LINE(40), SCAN, COMMA, RUBOUT 0007000 DATA COMMA / $2C / 00080 DATA RUBOUT / 4 / 00090 INTEGER IDATA(12), COMMAS(3) 00100 DATA IDATA / ' ',' ',' ' / 00110 DATA COMMAS / ',,,,,,' / 00120 INTEGER MSG2(16), MSG3(15), MSG4(11) 00130 DATA MSG2 / 'VOLUME NAME EXCEEDS 8 CHARACTERS' / 0014000 DATA MSG3 / 'FILE NAME EXCEEDS 8 CHARACTERS' / 00150 DATA MSG4 / 'NO FILE NAME SPECIFIED' / 00160 INTEGER OWNER(4), MODE(3) 00170 INTEGER MSG10(5), MSG11(6), MSG12(6), MSG13(3) 00180 DATA MSG10 / 'FILE NAME?' / 00190 DATA MSG11 / 'VOLUME NAME?' / 00200 DATA MSG12 / 'OWNER NAME? ' / 0021000 DATA MSG13 / 'MODE? ' / 002202 00230 ASSIGN 9999 TO ICTLD 00240 CALL PGMINT(ICTLD,0) 00250 CALL PGMIN(OWNER,IDUMMY,IDUMMY,IDUMMY) 00260 CALL CLRSCR 002701 0028000 CALL NFETCH(LINE,N) 00290 IF ( N.LE.5 ) GOTO 200 00300+ ; NO PARAMETERS ON CALL 00310 CALL CCSMVA(COMMAS,1,6,LINE,N+1,6) 00320 N=N+4 003301 00340 I0=1 0035000 I1=SCAN(LINE,COMMA,I0,N) 00360 I2=SCAN(LINE,COMMA,I1,N) 00370 I3=SCAN(LINE,COMMA,I2,N) 00380 I4=SCAN(LINE,COMMA,I3,N) 00390 I5=SCAN(LINE,COMMA,I4,N) 004001 00410 M=I1-I0-1 0042000 IF ( M.LE.0 ) GOTO 130 00430+ ; NO FILE NAME 00440 IF ( M.GT.8 ) GOTO 120 00450+ ; /FILENAME/ > 8 00460 CALL CCSMVA(LINE,I0+1,M,IDATA(1),1,8) 004701 00480 M=I2-I1-1 0049000 IF ( M.GT.8 ) GOTO 110 00500+ ; /OWNER / > 8 00510 IF ( M.LE.0 ) CALL CCSMVA(OWNER,1,8,IDATA(5),1,8) 00520 IF ( M.GT.0 ) CALL CCSMVA(LINE,I1+1,M,IDATA(5),1,8) 005301 00540 M=I3-I2-1 00550+ ; VOLUME 0056000 IF( M .GT. 8 ) M = 8 00570 IF ( M.GT.0 ) CALL CCSMVA(LINE,I2+1,M,IDATA(9),1,8) 005801 00590 CALL CCSMVA(2HNO,1,2,MODE,1,6) 00600 M = I4-I3-1 00610 IF( M .GT. 0 ) CALL CCSMVA(LINE,I3+1,M,MODE,1,6) 006201 0063000 10 CALL LISTIT(IDATA,MODE) 00640 CALL QUIT 006501 00660 110 CALL DSPLA(2,1,MSG2,32) 00670 CALL QUIT 006801 00690 120 CALL DSPLA(2,1,MSG3,30) 0070000 CALL QUIT 007101 00720 130 CALL DSPLA(2,1,MSG4,22) 00730 CALL QUIT 007401 00750 200 CALL DSPLA(1,1,MSG10,10) 00760 IF ( INPUT(1,12,IDATA(1),8).NE.RUBOUT ) GOTO 210 0077000 CALL CCSBLK(IDATA(1),8) 00780 CALL CLRLIN(1,1) 00790 GOTO 200 008001 00810 210 IF ( INPLEN(IDUMMY).LE.0 ) GOTO 130 008201 00830 220 CALL DSPLA(2,1,MSG12,11) 0084000 IF ( INPUT(2,13,IDATA(5),8).NE.RUBOUT ) GOTO 230 00850 CALL CCSBLK(IDATA(5),8) 00860 CALL CLRLIN(2,1) 00870 GOTO 220 008801 00890 230 IF ( INPLEN(IDUMMY).LE.0 ) CALL CCSMVA(OWNER,1,8,IDATA(5),1,8) 009001 0091000 240 CALL DSPLA(3,1,MSG11,12) 00920 IF ( INPUT(3,14,IDATA(9),8).NE.RUBOUT ) GOTO 250 00930 CALL CCSBLK(IDATA(9),8) 00940 CALL CLRLIN(3,1) 00950 GOTO 240 009601 00970 250 CALL CCSMVA(2HNO,1,2,MODE,1,6) 0098000 CALL DSPLA(4,1,MSG13,5) 00990 IF ( INPUT(4,7,MODE,6).NE.RUBOUT ) GOTO 10 01000 CALL CLRLIN(4,1) 01010 GOTO 250 010201 01030 9999 CALL QUIT 010401 0105000 END 01060 SUBROUTINE LISTIT( FILE, MODE ) 010701 01080C COPYRIGHT CONTROL DATA CORPORATION 08/08/80 (CGODSO) 010901 01100 INTEGER FILE( 12 ), MODE(3) 011101 0112000 INTEGER TERMCH 01130 INTEGER MSGSTR(35), FILSTR(2), NOTFND(5) 01140 DATA MSGSTR / 18*$2020, ' RECORD LENGTH EXCEEDS 2200 BYTES ' / 01150 DATA FILSTR / 'FILE' / 01160 DATA NOTFND / ' NOT FOUND' / 01170 INTEGER LF,PMSG(9),LPMSG 01180 DATA LF, PMSG,LPMSG/ 3,'PAUSE(LF TO PRINT)',18/ 0119000$$TXLSTBLK 01200 CALL LSTAPE(FILE,MODE) 01210 CALL OPENIT(FILE,MODF,LEN) 01220 CALL MAKEID(MSGSTR) 01230 CALL CLRSCR 01240 ILN=0 01250 IF ( LEN.LT.0 ) GOTO 900 0126000 IF( LEN .GT. 2200 ) GO TO 900 01270 CALL OUT(MSGSTR,36) 01280 CALL OUT(1H ,1) 01290 IPT=0 01300 I80=ICNVRT(MODE,IPT,6,IFLAG) 01310 IF ( (IFLAG.NE.0) .OR. (I80.LE.0) .OR. (I80.GT.LEN) ) I80=LEN 01320 CALL CCSGET(MODE,1,ICH) 0133000 IF ( ICH.EQ.1RB ) GOTO 800 01340 IF( MODF .NE. 0 ) GO TO 500 01350 IF ( ICH.EQ.1RH ) GOTO 500 013602 01370C PROCESS ALPHA OUT 013801 01390 100 CALL GETREC(0) 0140000 BUFFER(2)=AND(BUFFER(2),$7F7F) 01410 LENT = I80 01420 IPT = 1 01430 150 IF( LENT .LE. 80 ) GO TO 200 01440 CALL OUT(BUFFER(IPT),80) 01450 IPT = IPT + 40 01460 LENT = LENT - 80 0147000 IF ( LENT.GT.80 ) GOTO 150 014801 01490 200 IF ( LENT.GT.0 ) CALL OUT(BUFFER(IPT),LENT) 01500 GO TO 100 015102 01520C PROCESS HEX REQ AND BINARY FILES 015301 0154000 500 NREC = 1 01550 IBFLGN=0 01560 520 CALL GETREC(0) 01570 CALL BINDIS( BUFFER, I80, NREC ) 01580 CALL DSPLA(24,1,PMSG,LPMSG) 01590 IF ( INPUT(24,LPMSG+2,IDUM,1).NE.LF ) GOTO 540 01600 IF ( IBFLGN.NE.0 ) GOTO 530 0161000 CALL MPWRIX(12,1H1,1) 01620 CALL MPWRIX(9,MSGSTR,36) 01630 CALL MPWRIX(12,1H0,1) 01640 IBFLGN=1 01650 530 CALL BINPRN( BUFFER, LEN, NREC ) 01660 540 CALL CLRSCR 01670 ILN=0 0168000 NREC = NREC + 1 01690 GO TO 520 017001 01710C LIST BASIC INTERNAL ( FM 1 ) FILE 017201 01730 800 CALL BLSTAL 01740 CALL QUIT 01750001 01760C ERROR - EXCESSIVE RECORD LENGTH 017701 01780 900 CALL CCSMVA(FILSTR,1,4,MSGSTR,2,4) 01790 IF ( LEN.LT.0 ) CALL CCSMVA(NOTFND,1,10,MSGSTR,37,34) 01800 CALL OUT(MSGSTR,70) 01810 CALL QUIT 01820001 01830 END 01840_ 00 00 __ 0(dx d*TFLST LIBRARY P999999060381(0 SUBROUTINE LST 00010 + /CCS 2.0 $$USERID MANAGER DECK08 SUMMARY-*** 000202 00030C LST - LIST $$USERID ENTRIES. 00040C 1. IF A SINGLE ASTERISK (*) CHARACTER IS ENTERED FOR THE 00050C USER IDENTIFIER LIST KEY, THEN ALL ACTIVE ENTRIES WILL 00060C BE DISPLAYED; 0007000C 2. IF THE LIST IDENTIFIER IS NOT A SINGLE ASTERISK, THEN 00080C ONLY THOSE ACTIVE ENTRIES WHICH MATCH IN THE FIRST EIGHT 00090C CHARACTERS WILL BE DISPLAYED. 001002 00110 INTEGER PMT0(9), PMT(5), ICNT, ALL 001201 00130 DATA PMT0 / ' LIST ' / 0014000 DATA PMT / 'USERID(*):' / 00150$$WSUSRBLK 00160 CALL PROMPT(PMT0,-18,0,0) 00170 100 CALL PROMPT(2H ,2,0,0) 00180 CALL PROMPT(PMT,10,CURID,8) 00190+ ; USER ID (*) 00200 IF ( CURID(5).EQ.0 ) RETURN 0021000 CALL MSG(12) 00220 CALL PROMPT(2H ,2,0,0) 002301 00240 ALL=0 00250+ ; ASSUME SINGLE IDENTIFIER LIST 00260 IF ( (CURID(1).NE.2H* ) .OR. (CURID(5).NE.1) ) GOTO 160 002701 0028000C PREPARE TO LIST ALL ACTIVE ENTRIES. 002901 00300 ALL=1 00310+ ; SELECT SKIP OF ID MATCH LOOP 00320 DO 140 I=1,4 00330 CURID(I)=0 00340 140 CONTINUE 00350001 00360C PREPARE TO LIST ENTRIES FOR A SPECIFIED USER IDENTIFIER. 003701 00380 160 DO 180 I=1,4 00390 UID(I)=CURID(I) 00400 180 CONTINUE 004101 0042000C MAIN PROCESSING LOOP. 00430C INITIAL READ IS WITH A 00 TERMINAL PORT CODE. THE REMAINING READS 00440C ARE SEQUENTIAL UNTIL EITHER AN END-OF-FILE IS ENCOUNTERED OR THE 00450C SPECIFIED USER IDENTIFIER IS NO LONGER MATCHED. 004601 00470 UID(5)=2H00 00480 ICNT=0 0049000 CALL READR(REQBLK,USER,UID,ISTAT) 00500 220 IF ( AND(ISTAT,EOFLAG).EQ.EOFLAG ) GOTO 300 00510 IF ( ISTAT.LT.0 ) CALL MSG(3) 00520 IF ( ALL.EQ.1 ) GOTO 260 00530+ ; SKIP KEY COMPARISON 00540 DO 240 I=1,4 00550 IF ( CURID(I).NE.UID(I) ) GOTO 300 0056000 240 CONTINUE 00570 260 ICNT=ICNT+1 00580 CALL MSG(0) 00590 CALL GETS(REQBLK,USER,UID,ISTAT) 00600 GOTO 220 006101 00620C CHECK FOR ENTRIES FOUND. 0063000C REPROMPT FOR ANOTHER LIST. 006401 00650 300 IF ( ICNT.EQ.0 ) CALL MSG(9) 00660 GOTO 100 006701 00680 END 00690_ 00 00 00 00 00 __ 0(d d*TFLSTAPELIBRARY P999999060381(0 SUBROUTINE LSTAPE(FILE,MODE) 000101 00020 INTEGER FILE(12), MODE 000301 00040 INTEGER ASTOWN(4) 00050 DATA ASTOWN / '* ' / 00060 INTEGER MSGSTR(12), LFEED, PMSG(9), LPMSG 0007000 DATA MSGSTR / ' FILE LIST UNIT ????????' / 00080 DATA LFEED / 3 / 00090 DATA PMSG, LPMSG / 'PAUSE(LF TO PRINT)', 18 / 00100 INTEGER USER(4) 00110$$TXLSTBLK 00120 CALL CCSCST(FILE,1,8,ASTOWN,1,8,IFLAG) 00130 IF ( IFLAG.NE.0 ) RETURN 0014000 LU=0 00150 CALL PGMIN(USER,IDUMMY,IDUMMY,IDUMMY) 00160 CALL CCSCST(FILE,9,8,USER,1,8,IFLAG) 00170 IPT=8 00180 IF ( IFLAG.NE.0 ) LU=ICNVRT(FILE,IPT,16,IFLAG) 00190 IF ( IFLAG.NE.0 ) RETURN 00200 IF ( LU.EQ.0 ) LU=6 0021000 IPT=16 00220 LEN=ICNVRT(FILE,IPT,24,IFLAG) 00230 IF ( IFLAG.NE.0 ) RETURN 00240 CALL MTBLEN(MAXLEN) 00250 IF ( (LEN.LE.0) .OR. (LEN.GT.MAXLEN) ) LEN=MAXLEN 002601 00270 NREC=1 0028000 IBFLGN=0 00290 CALL CLRSCR 00300 ILN=0 00310 100 CALL LUREAD(LU,BUFFER,LEN, LENGTH,ISTAT) 00320 IF ( LENGTH.EQ.0 ) CALL QUIT 00330 CALL BINDIS(BUFFER,LENGTH,NREC) 00340 CALL DSPLA(24,1,PMSG,LPMSG) 0035000 IF ( INPUT(24,LPMSG+2,IDUMMY,1).NE.LFEED ) GOTO 140 00360 IF ( IBFLGN.NE.0 ) GOTO 130 00370 CALL MPWRIX(12,1H1,1) 00380 CALL CCSMVA(FILE,9,8,MSGSTR,17,8) 00390 CALL MPWRIX(9,MSGSTR,24) 00400 CALL MPWRIX(12,1H0,1) 00410 IBFLGN=1 0042000 130 CALL BINPRN(BUFFER,LENGTH,NREC) 00430 140 CALL CLRSCR 00440 ILN=0 00450 NREC=NREC+1 00460 GOTO 100 004701 00480 END 0049000_ 00 00 00 00 00 00 00 __ 0(d d*TFLSTBASLIBRARY Pl999999060381(0 SUBROUTINE BLSTAL 000101 00020 INTEGER BUF(52), MSG(8) 00030 DATA MSG / 'PRINT? (Y/N) ' / 00040 INTEGER FERR(8), OFILM(27) 00050 DATA FERR / 'NOT A BASIC FILE' / 00060 DATA OFILM / '1 LIST OF BASIC FILE: ???????? / ???????? ', 0007000 + '/ ????????' / 00080$$TXLSTBLK 00090 IF ( FCB(33).NE.192 ) GOTO 9001 00100 IF ( FCB(6).NE.0 ) GOTO 9001 00110 FCB(1)=4*96 00120 FCB(33)=4*192 001301 0014000 50 CALL DSPLA(3,1,MSG,16) 00150 IANS=2HNO 00160 IF ( INPUT(3,14,IANS,1).EQ.4 ) GOTO 50 00170 IANS=AND(IANS,$FF00)/$0100 00180 IF ( IANS.NE.1RY ) GOTO 100 00190 CALL CCSMVA(FCB(25),1,8,OFILM,25,8) 00200 CALL CCSMVA(FCB(29),1,8,OFILM,36,8) 0021000 CALL CCSMVA(FCB(92),1,8,OFILM,47,8) 00220 CALL MPWRIX(12,OFILM,54) 00230 CALL MPWRIX(12,2H0 ,2) 002401 00250 100 CALL GETREC(1) 00260 IX=4 00270 NLINES=BUFFER(3) 0028000 IF ( NLINES.LE.0 ) GOTO 100 00290 DO 200 I=1,NLINES 00300 CALL GETLIN(BUFFER,IX,BUF,NCHAR) 00310 CALL OUT(BUF,NCHAR) 00320 IF ( IANS.EQ.1RY ) CALL MPWRIX(9,BUF,NCHAR) 00330 200 CONTINUE 00340 GOTO 100 00350001 00360 9001 CALL DSPLA(3,1,FERR,16) 00370 CALL QUIT 003801 00390 END 00400 SUBROUTINE GETLIN(BUFFER,IX,BUF,NCHAR) 004101 0042000 INTEGER BUFFER(96), IX, BUF(52), NCHAR 004301 00440 CALL CCSBLK(BUF,100) 00450 NW=BUFFER(IX)-2 00460 IX=IX+1 00470 CALL HEXDEC(BUFFER(IX),BUF(2)) 00480 BUF(2)=2H 0049000 IX=IX+1 00500 NCHAR=2+6+2 00510 IF ( NW.LE.0 ) RETURN 00520 NCLEN=2*NW 00530 CALL CCSMVA( BUFFER(IX) ,1,NCLEN,BUF,NCHAR+1,NCLEN) 00540 IX=IX+NW 00550 NCHAR=NCHAR+NCLEN 0056000 CALL CCSGET(BUF,NCHAR,ICH) 00570 IF ( (ICH.EQ.$03).OR.(ICH.EQ.$00) ) CALL CCSPUT($20,NCHAR,BUF) 00580 CALL CCSGET(BUF,NCHAR-1,ICH) 00590 IF ( (ICH.EQ.$03).OR.(ICH.EQ.$00) ) CALL CCSPUT($20,NCHAR-1,BUF) 00600 RETURN 006101 00620 END 0063000_ 00 00 00 00 00 __ 0(d d*TFLSTBINLIBRARY P999999060381(0 SUBROUTINE BINDIS( INBUF, LEN, NREC ) 000101 00020C COPYRIGHT CONTROL DATA CORPORATION 08/08/80 (CGODSO) 000301 00040 INTEGER INBUF(1), BUFFER(40), KBUF(3) 00050 INTEGER MREC(7) 00060 DATA MREC/' RECORD '/ 00070002 00080 CALL HEXASC( NREC, MREC(6)) 00090 CALL OUT ( MREC, 14 ) 00100 LENW = ( LEN + 1 )/ 2 00110 I = 1 00120 1 CALL CCSBLK(BUFFER,80) 00130 CALL HEXASC( I-1 ,KBUF) 0014000 CALL CCSMVA(KBUF,1,4,BUFFER,3,4) 00150 CALL CCSPUT($007C,59,BUFFER) 00160 CALL CCSPUT($007C,76,BUFFER) 00170 CALL HEXDEC( 2*I-1 ,KBUF) 00180 CALL CCSMVA(KBUF,2,5,BUFFER,53,5) 00190 DO 10 JJJ = 1, 8 00200 CALL HEXASC( INBUF(I), KBUF ) 0021000 CALL CCSMVA(KBUF,1,4,BUFFER, 5*JJJ+6,4) 00220 CALL CCSMVA(INBUF(I),1,2,BUFFER, 2*JJJ+58, 2 ) 00230 I = I+1 00240 IF( I .LE. LENW ) GO TO 10 00250 CALL OUT ( BUFFER, 80 ) 00260 RETURN 00270 10 CONTINUE 0028000 CALL OUT ( BUFFER, 80 ) 00290 GO TO 1 003001 00310 END 00320 SUBROUTINE BINPRN( INBUF, LEN, NREC ) 003301 00340C COPYRIGHT CONTROL DATA CORPORATION 08/08/80 (CGODSO) 00350001 00360 INTEGER INBUF(1), BUFFER( 70 ), BAR1,BAR2, VDC 00370 INTEGER HEADER(6), KBUF(3) 00380 DATA HEADER/'RECORD XXXX'/ 00390 DATA NPLIN/ 16/ 004001 00410 BAR1 = 19 + 5* NPLIN 0042000 BAR2 = BAR1 + 2*NPLIN + 1 00430 IBYT = BAR1-6 00440 CALL HEXASC( NREC, HEADER(5)) 00450 BUFFER(1)=2H 00460 CALL CCSMVA(HEADER,1,12,BUFFER,3,12) 00470 CALL MPWRIX( 9,BUFFER,14) 00480 LENW = (LEN+1)/2 0049000 IPT = 0 00500 1 CALL CCSBLK(BUFFER,132) 00510 CALL HEXASC( IPT, KBUF ) 00520 CALL CCSMVA(KBUF,1,4,BUFFER,3,4) 00530C BAR1 = 10+5*NPLIN 00540C BAR2 = BAR1+2*NPLIN+1 00550 CALL CCSPUT(1R*,BAR1,BUFFER) 0056000 CALL CCSPUT(1R*,BAR2,BUFFER) 00570 CALL HEXDEC( IPT*2+1,KBUF) 00580 CALL CCSMVA(KBUF,2,5,BUFFER,IBYT,5) 00590 DO 10 JJ= 1, NPLIN 00600 IPT = IPT +1 00610 CALL HEXASC( INBUF(IPT),KBUF) 00620 CALL CCSMVA(KBUF,1,4,BUFFER,(JJ-1)*5+10,4) 0063000 CALL CCSMVA(INBUF(IPT),1,2,BUFFER,BAR1+2*JJ-1,2) 00640 IF( IPT .GE. LENW ) GO TO 11 00650 10 CONTINUE 00660 11 DO 12 I=1,66 00670 BUFFER(I)=VDC(BUFFER(I)) 00680 12 CONTINUE 00690 CALL MPWRIX(12,BUFFER,132) 0070000 IF( IPT .LT.LENW ) GO TO 1 00710 RETURN 007201 00730 END 00740_ 00 00 00 00 __ 0(d d*TFLSTMIOLIBRARY Pf999999060381(0 SUBROUTINE OPENIT(FILE,MODF,LEN) 000101 00020 INTEGER FILE(12), MODF, LEN 00030 INTEGER VITADR, MMUNIT, VIT(23), HASH, MMADR(2), IDUMMY(2) 00040 INTEGER QM(4) 00050 DATA QM / '????????' / 00060$$TXLSTBLK 0007000 LEN=-1 00080 CALL CCSMVA(FILE(1),1,8,FCB(25),1,8) 00090 CALL CCSMVA(FILE(5),1,8,FCB(29),1,8) 00100 CALL CCSMVA(QM,1,8,FCB(92),1,8) 00110 IF ( FILE(9).EQ.2H ) GOTO 200 00120 CALL CCSMVA(FILE(9),1,8,FCB(92),1,8) 00130 CALL SEKVIT(FILE(9),VITADR,MMUNIT) 0014000 IF ( VITADR.EQ.0 ) RETURN 00150 CALL GETVIT(MMUNIT,VIT) 00160 IF ( VIT(1).EQ.0 ) RETURN 00170 NFCB=HASH(FILE(1),FILE(5),VIT,IDUMMY) 00180 IF ( NFCB.LT.0 ) RETURN 00190 100 MMADR(1)=0 00200 MMADR(2)=NFCB 0021000 CALL FDWADD(MMADR,VIT(15),MMADR,IDUMMY) 00220 VIT(18)=0 00230 CALL FDWADD(MMADR,VIT(18),MMADR,IDUMMY) 00240 MMUNIT=AND(VIT(1),$7FFF) 00250 CALL MMREAD(MMUNIT,96,MMADR,FCB) 00260 LEN=FCB(33) 00270 MODF=AND($0100,FCB(6))/$0100 0028000 CALL CCSMVA(VIT(2),1,8,FCB(92),1,8) 00290 FCB(96)=MMUNIT 00300 RETURN 003101 00320 200 DO 220 I=1,8 00330 CALL GETVIT(I,VIT) 00340 IF ( VIT(1).EQ.0 ) GOTO 220 0035000 NFCB=HASH(FILE(1),FILE(5),VIT,IDUMMY) 00360 IF ( NFCB.GE.0 ) GOTO 100 00370 220 CONTINUE 00380 RETURN 003901 00400 END 00410 SUBROUTINE GETREC(IFLAG) 00420001 00430 INTEGER IFLAG 004401 00450 INTEGER DISK(6146), IPT, IMAX, TW1(2) 00460 DATA IPT / 12289 / 00470 DATA IMAX / 12288 / 00480 DATA TW1 / 0,1 / 0049000$$TXLSTBLK 00500 IF ( IFLAG.NE.0 ) GOTO 100 00510 CALL FDWSUB(FCB(2),TW1,FCB(2),IDUMMY) 00520 IF ( FCB(2).LT.0 ) CALL QUIT 00530 100 IF ( IPT.LE.IMAX ) GOTO 200 00540 CALL FILL(DISK,IMAX) 00550 IPT=1 0056000 200 CALL CCSMVA(DISK,IPT,FCB(33),BUFFER,1,2200) 00570 IF ( BUFFER(1).EQ.$5F82 ) CALL QUIT 00580 IPT=IPT+2*FCB(1) 00590 IF ( IPT.LE.IMAX+1 ) RETURN 00600 MOVED=IMAX-IPT+2*FCB(1)+1 00610 CALL FILL(DISK,IMAX) 00620 LEN=FCB(33)-MOVED 0063000 CALL CCSMVA(DISK,1,LEN,BUFFER,MOVED+1,LEN) 00640 IPT=( (LEN+1)/2 )*2 +1 00650 RETURN 006601 00670 END 00680 SUBROUTINE FILL(DISK,IMAX) 006901 0070000 INTEGER DISK(1), IMAX 007101 00720 INTEGER TW64(2) 00730 DATA TW64 / 0,64 / 00740$$TXLSTBLK 00750 IF ( FCB(23).LT.0 ) CALL QUIT 00760 CALL MMREAD(FCB(96),96*64,FCB(4),DISK) 0077000 IF ( (FCB(23).EQ.0) .AND. (FCB(24).LT.64) ) GOTO 100 00780 CALL FDWSUB(FCB(23),TW64,FCB(23),IDUMMY) 00790 CALL FDWADD(FCB(4),TW64,FCB(4),IDUMMY) 00800 RETURN 008101 00820 100 IMAX=192*FCB(24) 00830 FCB(23)=-1 0084000 RETURN 008501 00860 END 00870_ 00 00 __ 0(d d*TFLSTSIOLIBRARY P0999999060381(0 SUBROUTINE OUT(LINE,LENGTH) 000101 00020 INTEGER LINE(1), LENGTH 000301 00040 INTEGER PAUSE(3), VDC 00050 DATA PAUSE / 'PAUSE ' / 00060$$TXLSTBLK 0007000 ILN=ILN+1 00080 IF ( ILN.LT.23 ) GOTO 100 00090 CALL DSPLA(24,1,PAUSE,5) 00100 CALL INPUT(24,7,IDUMMY,1) 00110 CALL CLRSCR 00120 ILN=1 00130 100 N=(LENGTH+1)/2 0014000 DO 200 I=1,N 00150 LINE(I)=VDC(LINE(I)) 00160 200 CONTINUE 00170 CALL DSPLA(ILN,1,LINE,LASTCH(LINE,LENGTH)) 00180 RETURN 001901 00200 END 0021000 SUBROUTINE QUIT 002201 00230 CALL FLUSH 00240 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 00250 CALL PGMOUT 002601 00270 END 0028000 SUBROUTINE MAKEID(MSG) 002901 00300 INTEGER MSG(18) 003101 00320 INTEGER LIST(3) 00330 DATA LIST / ' LIST ' / 00340$$TXLSTBLK 0035000 CALL CCSMVA(LIST,1,6,MSG,1,36) 00360 CALL CCSMVA(FCB(25),1,8,MSG,7,8) 00370 CALL CCSPUT(1R/,16,MSG) 00380 CALL CCSMVA(FCB(29),1,8,MSG,18,8) 00390 CALL CCSPUT(1R/,27,MSG) 00400 CALL CCSMVA(FCB(92),1,8,MSG,29,8) 00410 RETURN 00420001 00430 END 00440_ 00 00 00 00 00 00 00 00 __ 0(d $ d*TFLUREADLIBRARY P@999999060381(0 SUBROUTINE LUREAD(LU,BFR,NBYTES, LENGTH,QSTAT) 000101 00020C LUREAD READ FROM LOGICAL UNIT 000301 00040C LU - LOGICAL UNIT TO READ FROM 00050C BFR - RECIEVING BUFFER 00060C NBYTES - NUMBER OF BYTES TO READ 0007000C LENGTH - NUMBER OF BYTES TRANSFERED 00080C QSTAT - Q-STATUS RESPONSE INDICATOR 000901 00100 INTEGER LU, BFR(1), NBYTES, LENGTH, QSTAT 001101 00120 INTEGER TEMP(8), LEN(3), TW1(2) 00130 DATA LEN / 0, 0, 0 / 0014000 DATA TW1 / 0, 1 / 001501 00160 LEN(1)=NBYTES 00170 ASSIGN 100 TO ICMPLT 00180 IFLAG=0 00190 CALL FREAD(LU,BFR,LEN,ICMPLT,IFLAG,TEMP) 00200 ASSEM $C0FF,$6400,+ISAVE 0021000+ ; SAVE I-REGISTER 00220 CALL DISPAT 00230 100 CONTINUE 00240 ASSEM $C400,+ISAVE,$60FF 00250+ ; RESTORE I-REGISTER 00260 ASSEM $4400,+QSTAT 00270+ ; RETURN Q-STATUS 0028000 CALL FDWADD(LEN(2),TW1,LEN(2),IDUMMY) 00290 LENGTH=NBYTES 00300 IF ( AND(QSTAT,$4000).EQ.0 ) RETURN 00310 N=(NBYTES+1)/2 00320 LENGTH=BFR(N+1) 00330 RETURN 003401 0035000 END 00360_ 00 00 00 00 00 00 00 00 00 __ 0(2 O 2TFMMREADLIBRARY PT999999060381(0 FUNCTION MMREAD(MMPUN,LENBFR,MMADDR,BUFFER) 00010 + /MASS MEMORY READ FUNCTION 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 04/17/80 (CGODSO) 000402 00050C MMREAD - MASS MEMORY READ. 000601 0007000C MMREAD ATTEMPTS TO READ THE SPECIFIED MASS MEMORY. 00080C 00090C MMPUN - MASS MEMORY PHYSICAL UNIT NUMBER 00100C LENBFR - NUMBER OF WORDS TO TRANSFER ( I.E. SIZE OF BUFFER ) 00110C MMADDR - TWO WORD MASS MEMORY SECTOR ADDRESS 00120C BUFFER - ARRAY TO RECEIVE DATA 001302 0014000 INTEGER MMPUN, LENBFR, MMADDR(2), BUFFER(1) 001501 00160 INTEGER LENGTH(3), CMPLT, IFLAG, TEMP(8), SAVEI 001702 00180 LENGTH(1)=LENBFR 00190 LENGTH(2)=MMADDR(1) 00200 LENGTH(3)=MMADDR(2) 0021000 ASSIGN 100 TO CMPLT 00220 IFLAG=0 00230 CALL FREAD(MMPUN,BUFFER,LENGTH,CMPLT,IFLAG,TEMP) 00240 ASSEM $C0FF,$6400,+SAVEI 00250+ ; SAVE I-REG 00260 CALL DISPAT 00270 100 CONTINUE 0028000 ASSEM $C400,+SAVEI,$60FF 00290+ ; RESTORE I-REG 00300 ASSEM $4400,+IFLAG 00310+ ; RETURN Q-STATUS 00320 MMREAD=IFLAG 00330 RETURN 003401 0035000 END 00360_ 00 00 __ 0(2 e 2TFMMWRITLIBRARY PT999999060381(0 FUNCTION MMWRIT(MMPUN,LENBFR,MMADDR,BUFFER) 00010 + /MASS MEMORY WRITE FUNCTION 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 04/17/80 (CGODSO) 000402 00050C MMWRIT - MASS MEMORY WRITE. 000601 0007000C MMWRIT ATTEMPTS TO WRITE THE SPECIFIED MASS MEMORY. 00080C 00090C MMPUN - MASS MEMORY PHYSICAL UNIT NUMBER 00100C LENBFR - NUMBER OF WORDS TO TRANSFER ( I.E. BUFFER SIZE ) 00110C MMADDR - TWO WORD MASS MEMORY SECTOR ADDRESS 00120C BUFFER - DATA TO BE TRANSFERED 001302 0014000 INTEGER MMPUN, LENBFR, MMADDR(2), BUFFER(1) 001501 00160 INTEGER LENGTH(3), CMPLT, IFLAG, TEMP(8), SAVEI 001702 00180 LENGTH(1)=LENBFR 00190 LENGTH(2)=MMADDR(1) 00200 LENGTH(3)=MMADDR(2) 0021000 ASSIGN 100 TO CMPLT 00220 IFLAG=0 00230 CALL FWRITE(MMPUN,BUFFER,LENGTH,CMPLT,IFLAG,TEMP) 00240 ASSEM $C0FF,$6400,+SAVEI 00250+ ; SAVE I-REG 00260 CALL DISPAT 00270 100 CONTINUE 0028000 ASSEM $C400,+SAVEI,$60FF 00290+ ; RESTORE I-REG 00300 ASSEM $4400,+IFLAG 00310+ ; RETURN Q-STATUS 00320 MMWRIT=IFLAG 00330 RETURN 003401 0035000 END 00360_ 00 00 __ 0(2 { 2TFMPFACELIBRARY P999999060381(0 INTEGER FUNCTION MPFACE(I1,J2,K3) 00010 + /OUTPUT INTERFACE 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 00040$$TXSSPBLK 00050 INTEGER FC, J2(1) 00060 DATA FC / 0 / 00070002 00080 MPFACE=0 00090 IF ( MODE.NE.0 ) GOTO 100 00100+ ; IF TO DISPLAY AT TERMINAL 00110 MPFACE=MPWRIX(I1,J2,K3) 00120 RETURN 001302 0014000 100 IF ( MODE.GT.0 ) RETURN 00150+ ; IF PAGE1 LIST OF HOLES 00160 IF ( FC.EQ.0 ) CALL CLRSCR 00170+ ; INITIALIZE WTRD PACKAGE 00180 FC=FC+1 001901 00200 210 IF ( K3.GT.80 ) GOTO 220 0021000 IF ( FC.GT.11 ) RETURN 00220+ ; ONLY THE INITIAL SHORT LINES 00230 LOCAL=J2(1) 00240 J2(1)=2H 00250 CALL DISPLA(J2,K3) 00260 J2(1)=LOCAL 00270 RETURN 00280001 00290 220 IF ( K3.GE.132 ) GOTO 260 00300+ ; IF FILE INFORMATION LINE 00310 CALL DISPLA(J2,44) 00320 CALL DISPLA(J2(24),42) 00330 RETURN 003401 0035000 260 IF ( (J2(12).EQ.2HIL).AND.(FC.GT.11) ) RETURN 00360+ ; RESTRICT HEADERS 00370 IF ( (J2(12).EQ.2HYP).AND.(FC.GT.11) ) RETURN 00380 CALL DISPLA(J2(2),78) 00390 RETURN 004001 00410 END 0042000_ 00 __ 0( ?TFMRKHDRLIBRARY P999999060381(0 SUBROUTINE MRKHDR 00010 + /PASS 1 - MARK FILE HEADER SECTORS 000202 00030C MRKHDR - MARK HEADERS 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 000601 0007000C MRKHDR MARKS THE HEADER RECORDS FOR FILES WITH A SECTOR ADDRESS 00080C LARGER THAN THE SECTOR ADDRESS OF THE FIRST HOLE IN THE AVAILABLE 00090C SPACE DIRECTORY. 00100C 00110C HEADER(14) <- MSB SECTOR ADDRESS OF THE FCB FOR THIS FILE 00120C HEADER(15) <- LSB SECTOR ADDRESS OF THE FCB FOR THIS FILE 00130C HEADER(16) <- INDEX OF THE FCB FOR THIS FILE 00140002 00150 INTEGER MSG2(11), MSG1(8) 00160 DATA MSG1 / 'MARKING HEADERS ' / 00170 DATA MSG2 / 'DONE - NO HOLES FOUND ' / 00180 INTEGER NFCB, FCBADR(2), IX, ONE2(2) 00190 DATA ONE2 / 0,1 / 002001 0021000 INTEGER ASD1(4) 00220 EQUIVALENCE (ASD1,FCBBFR) 00230 INTEGER BLKFCB(1), DATBA(2) 00240 EQUIVALENCE (BLKFCB,DSKBFR), (DATBA,DSKBFR(4)) 00250$$TXSQUBLK,LIBRARY 002601 00270 CALL DISPLA(MSG1,16) 0028000 CALL DISPLA(2H ,2) 002901 00300C READ FIRST SECTOR OF THE AVAILABLE SPACE DIRECTORY 003101 00320 IFLAG=MMREAD(MLU,VLWPS,VLASD,ASD1) 00330 IF ( ASD1(1).NE.-1 ) GOTO 100 00340+ ; IF AT LEAST 1 HOLE 0035000 CALL DISPLA(MSG2,22) 00360 CALL DISPLA(2H ,2) 00370 CALL PGMOUT 003801 00390C PREPARE TO MARK HEADERS 004001 00410 100 CNT=0 0042000+ ; NUMBER OF FILES MARKED 00430 NFCB=0 00440+ ; NUMBER OF FCB-S PROCESSED 00450 TEMP(1)=0 00460 TEMP(2)=VLNFDB 00470 CALL FDWADD(VLFDD,TEMP(1),FCBADR,TC) 00480+ ; FCB SECTOR FWA 00490001 00500C MAIN PROCESSING LOOP 005101 00520 200 IF ( NFCB.GE.VLMAXF ) RETURN 00530+ ; DONE, MAX. FILES COUNTED 00540 IFLAG=MMREAD(MLU,LENDSK,FCBADR,BLKFCB) 00550+ ; READ SOME FCB-S 0056000 IX=1 00570+ ; BUFFER ADDRESS OF NEXT FCB 005801 00590C CHECK NEXT FCB IN BUFFER 006001 00610 220 IF ( NFCB.GE.VLMAXF ) RETURN 00620+ ; DONE, MAX FILES COUNTED 0063000 IF ( BLKFCB(IX).EQ.0 ) GOTO 260 00640+ ; IF FCB NOT USED 006501 00660C CHECK : MARK FILE IF IT BEGINS AFTER THE FIRST HOLE 006701 00680 IF ( DATBA(IX).LT.ASD1(3) ) GOTO 260 00690+ ; IF BEFORE 1-ST HOLE 0070000 IF ( (DATBA(IX).EQ.ASD1(3)) 00710 + .AND.(DATBA(IX+1).LT.ASD1(4)) ) GOTO 260 00720+ ; IF BEFORE 1-ST HOLE 007301 00740C READ AND MARK FILE HEADER SECTOR 007501 00760 CNT=CNT+1 0077000+ ; COUNT FILES TO BE MOVED 00780 CALL FDWSUB(DATBA(IX),ONE2,DATBA(IX),TC) 00790+ ; HEADER SECTOR ADDRESS 00800 IFLAG=MMREAD(MLU,VLWPS,DATBA(IX),HDRBFR) 00810 FCBLOC(1)=FCBADR(1) 00820+ ; FCB MM SECTOR ADDRESS 00830 FCBLOC(2)=FCBADR(2) 0084000 FCBINX=NFCB 00850+ ; FCB INDEX 00860 IFLAG=MMWRIT(MLU,VLWPS,DATBA(IX),HDRBFR) 00870+ ; WRITE MARKED HEADER 008801 00890C ADVANCE TO NEXT FCB 009001 0091000 260 CALL FDWADD(FCBADR,ONE2,FCBADR,TC) 00920+ ; NEXT FCB SECTOR ADDRESS 00930 NFCB=NFCB+1 00940+ ; NEXT FCB INDEX 00950 IX=IX+VLWPS 00960+ ; NEXT FCB BUFFER INDEX 00970 IF ( IX.LT.LENDSK ) GOTO 220 0098000+ ; IF MORE IN THE BUFFER 00990 GOTO 200 01000+ ; GET MORE FCB-S 010101 01020 END 01030_ 00 00 00 00 00 00 00 __ 0( ?TFMSG LIBRARY Pt999999060381(0 SUBROUTINE MSG(IX) 00010 + /CCS 2.0 $$USERID MANAGER DECK09 SUMMARY-*** 000202 00030C MSG - MESSAGE PROCESSOR. 00040C MSG DISPLAYS A COMMON SET OF ONE LINE MESSAGES AT THE 00050C TERMINAL WITHOUT REQUESTING A RESPONSE ( EXCEPT PAUSE 00060C ACKNOWLEDGEMENT ). 00070002 00080C ENTRY - 00090C IX = 00100C 0 - LIST CURRENT USER INFORMATION 00110C 1 - OPEN ERROR (FM) 00120C 2 - CLOSE ERROR (FM) 00130C 3 - READR/GETS ERROR (FM) 0014000C 4 - UPDREC ERROR (FM) 00150C 5 - DELREC ERROR (FM) 00160C 6 - GETFCB ERROR (FM) 00170C 7 - WRITER ERROR (FM) 00180C 8 - COMFIL ERROR (FM) 00190C 9 - *NONE* MESSAGE 00200C 10 - *NO ENTRIES FOR THIS ID* MESSAGE 0021000C 11 - PAUSE MESSAGE ( AT BOTTOM OF SCREEN), WAIT FOR OPERATOR 00220C ENTRY ( IGNORED ) 00230C 12 - TITLE LINE FOR USER DISPLAYS 002402 00250C *NOTE* FOR FILE MANAGER ERRORS ( 1-8 ), THE VALUE OF 'ISTAT' IS 00260C DISPLAYED AND THE PROGRAM IS ENDED BY AN EXIT TO THE 00270C SYSTEM. NO CLEANUP FUNCTIONS ARE PERFORMED. 00280002 00290 INTEGER IX 003001 00310 INTEGER LIST(33), LISTIX(8), LINE(13), I, N, DUMIE(2) 00320 INTEGER MSGNON(8), MSGFND(13), PAUSE(3), TITLE(12) 003301 00340 DATA LISTIX / 1, 4, 8, 14, 18, 22, 26, 30 / 0035000 DATA LIST / 2, 'OPEN', 3, 'CLOSE ', 5, 'READR/GETS', 3, 'UPDREC' 00360 + , 3, 'DELREC', 3, 'GETFCB', 3, 'WRITER', 3, 'COMFIL' / 00370 DATA MSGNON / ' *NONE*' / 00380 DATA MSGFND / ' *NO ENTRIES FOR THIS ID* ' / 00390 DATA TITLE / ' USERID TRML PROGRAM' / 00400 DATA PAUSE / 'PAUSE ' / 00410$$WSUSRBLK 0042000 IF ( IX.LT.0 ) RETURN 00430 IF ( IX.GT.12 ) RETURN 00440 IF ( IX.EQ.9 ) GOTO 400 00450 IF ( IX.EQ.10 ) GOTO 420 00460 IF ( IX.EQ.11 ) GOTO 440 00470 IF ( IX.EQ.12 ) GOTO 460 00480 IF ( IX.NE.0 ) GOTO 200 00490001 00500C IX=0 : FORMAT A SINGLE LINE TO DISPLAY THE CURRENT USER 00510C INFORMATION FROM THE ARRAY 'USER'. 005201 00530 LINE(1)=2H ( 00540 DO 100 K=1,4 00550+ ; INSERT USER IDENTIFIER 0056000 LINE(K+1)=USER(K) 00570 100 CONTINUE 00580 LINE(6)=2H) 00590 LINE(7)=USER(5) 00600+ ; INSERT TERMINAL PORT CODE 00610 LINE(8)=2H ( 00620 DO 120 K=7,10 0063000+ ; INSERT FORCED REQUEST 00640 LINE(K+2)=USER(K) 00650 120 CONTINUE 00660 LINE(13)=2H) 00670 CALL PROMPT(LINE,26,0,0) 00680 RETURN 006901 0070000C 0 < IX < 9 : FORMAT COMMON FILE MANAGER ERROR MESSAGES 007101 00720 200 LINE(1)=2H($ 00730 CALL HEXASC(ISTAT,LINE(2)) 00740+ ; INSERT STATUS CODE 00750 LINE(4)=2H) 00760 LINE(5)=2HER 0077000 LINE(6)=2HRO 00780 LINE(7)=2HR 00790 LINE(8)=2H- 00800 I=LISTIX(IX) 00810+ ; INDEX TO MESSAGE SIZE AND TEXT 00820 N=LIST(I) 00830 DO 220 K=1,N 0084000+ ; COPY MESSAGE TEXT 00850 I=I+1 00860 LINE(K+8)=LIST(I) 00870 220 CONTINUE 00880 CALL PROMPT(LINE,2*(N+8),0,0) 00890 CALL CDS 00900 CALL PGMOUT 00910001 00920C MESSAGE: *NONE* 009301 00940 400 CALL PROMPT(MSGNON,16,0,0) 00950 RETURN 009601 00970C MESSAGE: *NO ENTRIES FOR THIS ID* 00980001 00990 420 CALL PROMPT(MSGFND,26,0,0) 01000 RETURN 010101 01020C MESSAGE: PAUSE AT BOTTOM OF SCREEN, WAIT FOR OPERATOR TO 01030C RESPOND (CR) BEFORE CONTINUING. 010401 0105000 440 CALL PROMPT(0,0,0,-1) 01060 RETURN 010701 01080C MESSAGE: TITLE LINE FOR DISPLAYS 010901 01100 460 CALL PROMPT(TITLE,-24,0,0) 01110 CALL PROMPT(2H ,2,0,0) 0112000 RETURN 011301 01140 END 01150_ 00 00 00 00 00 __ 0(   TFMTBLENLIBRARY P999999060381(0 SUBROUTINE MTBLEN(NBYTES) 000101 00020C DETERMINE THE LENGTH OF THE MASTER TERMINAL I/O BUFFER (IN BYTES) 000301 00040C N=2*MEMORY(MEMORY(MEMORY(MEMORY(MEMORY($E9)+33)+3)+30)-1) 00050 I=MEMORY($E9) 00060+ ; ADR OF EXTENDED CORE TABLE 0007000 I=MEMORY(I+33) 00080+ ; ADR OF EXECUTIVE VECTOR TABLE 00090 I=MEMORY(I+3) 00100+ ; ADR OF TERMINAL USER TABLE 00110 I=MEMORY(I+30) 00120+ ; ADR OF BUFFER 00130 NBYTES=2*MEMORY(I-1) 0014000+ ; BYTES = 2* WORDS 00150 RETURN 001601 00170 END 00180_ __ NBYTES=2*MEMORY(I-1) 001400(   TFNFETCHLIBRARY PZ999999060381(0 SUBROUTINE NFETCH(IBUF,NLEN) 00010 + /FETCH ITOS REQUEST COMMAND LINE 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 08/06/80 (CGODSO) 000401 00050 DIMENSION IBUF(1) 00060 NLEN=MEMORY($8000+333) 0007000 LEN=(NLEN+1)/2 00080 DO 10 I=1,LEN 0009010 IBUF(I)=MEMORY(I+$8124) 00100 RETURN 00110 END 00120_ 00 __ 0(d % d*TFNXTFCBLIBRARY P999999060381(0 SUBROUTINE NXTFCB 00010 + /GET NEXT FCB 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C NXTFCB - NEXT FCB. 000601 0007000C NXTFCB COPIES THE NEXT FCB INTO THE COMMON BLOCK BUFFER. THE 00080C MASS MEMORY FCB AREA IS READ 64 SECTORS PER REQUEST. 00090$$TXSSPBLK 00100 INTEGER OP2(2), OLD 00110 INTEGER FCBPNT, FCFLAG, TW64(2), FCBCNT 00120 DATA FCBPNT / 6145 / 00130+ ; 64*96 + 1 0014000 DATA FCFLAG / 0 / 00150+ ; FIRST CALL FLAG 00160 DATA TW64 / 0,64 / 00170 DATA FCBCNT / 0 / 001802 00190 100 OLD=VIT(18) 00200 ISTAT=0 0021000 IF ( FCBPNT.LT.BUFSIZ ) GOTO 300 00220 IF ( FCFLAG.NE.0 ) GOTO 200 00230 OP2(1)=0 00240 OP2(2)=VIT(19) 00250+ ;NUMBER OF BLOCKS IN FDD 00260 CALL FDWADD(VIT(15),OP2,LENGTH(2),ISTAT) 00270 LENGTH(1)=64*96 0028000 200 IF ( FCFLAG.GE.VIT(17) ) GOTO 400 00290 IFLAG=0 00300 FCFLAG=FCFLAG+64 00310 IFLAG=MMREAD(VIT(1),LENGTH(1),LENGTH(2),DSKBFR) 00320 CALL FDWADD(LENGTH(2),TW64,LENGTH(2),ISTAT) 00330 FCBPNT=1 00340 300 NFCB=FCBCNT 0035000 FCBCNT=FCBCNT+1 00360 IF ( DSKBFR(FCBPNT).EQ.0 ) GOTO 320 00370+ ; IGNORE, IF FCB NOT USED 00380 CALL CCSMVA(DSKBFR(FCBPNT),1,2*96,FCBBFR,1,2*96) 00390 FCBPNT=FCBPNT+96 00400 VIT(18)=MEMORY(VITADR+17) 00410 IF ( VIT(18).GT.OLD ) MAXFIL=MAXFIL+1 0042000 RETURN 004301 00440 320 FCBPNT=FCBPNT+96 00450 GOTO 100 004601 00470 400 ISTAT=$1000 00480+ ; 'EOF' 0049000 RETURN 005001 00510 END 00520_ 00 00 00 00 00 00 00 __ 0(2 P 2TFOWNER LIBRARY P999999060381(0 INTEGER FUNCTION OWNER(ID,OWN) 00010 + /CONDITIONAL COMPARISON OF 8 BYTE STRINGS 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C OWNER - COMPARE OWNER NAMES. 000601 0007000C OWNER RETURNS 1 IF THE NAMES 'ID' AND 'OWN' MATCH OR IF THE 00080C NO VERIFICATION FLAG [ ID(5) ] IS NON-ZERO. OTHERWISE, RETURN 0. 000902 00100 INTEGER ID(5), OWN(4) 001102 00120 OWNER=1 00130 IF ( ID(5).NE.1 ) RETURN 0014000 IF ( ID(1).NE.OWN(1) ) OWNER=0 00150 IF ( ID(2).NE.OWN(2) ) OWNER=0 00160 IF ( ID(3).NE.OWN(3) ) OWNER=0 00170 IF ( ID(4).NE.OWN(4) ) OWNER=0 00180 RETURN 001901 00200 END 0021000_ 00 00 00 00 __ 0( f iTFPAGE1 LIBRARY P*999999060381(0 SUBROUTINE PAGE1 00010 + /PRODUCE BULK STATUS INFORMATION 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C PAGE1 - PRODUCE THE FIRST PAGE HEADERS. 000601 0007000C PAGE1 PRODUCES THE SUMMARY LINES FOR THE FIRST PAGE(S). 00080C THE BASIC INFORMATION ( VOLUME, DATE, TIME, MAX. FILE COUNT, 00090C CURRENT FILE COUNT, AVAILABLE SECTOR COUNT, LARGEST BLOCK SIZE ) 00100C IS ALWAYS PRODUCED. IF RUNNING FORM THE MASTER CONSOLE, THEN 00110C ADDITIONAL INFORMATION FROM THE VIT AND THE AVAILABLE SPACE 00120C DIRECTORY IS PRODUCED BEFORE THE BASIC INFORMATION. 00130$$TXSSPBLK 0014000 INTEGER TEMP(12), LEFT8(2) 00150 DATA LEFT8 / 8,0 / 00160 INTEGER MSG01(26), MSG02(38), MSG03(44), MSG04(20), MSG05(28) 00170 DATA MSG01 / '1 VOLUME: ???????? DATE ??/??/?? ????', 00180 + ' VINMBR ??' / 00190 DATA MSG02 / ' VIBMS* ????,???? VIFDD* ????,???? VINFDB ' 00200 + ,'????? $???? VINXTB $????' / 0021000 DATA MSG03 / ' MAXIMUM NUMBER OF FILES PERMITTED: ????? ', 00220 + ' CURRENT NUMBER OF EXISTING FILES: ?????' / 00230 DATA MSG04 / ' VIASD* ????,???? VIASDS ????? $???? ' / 00240 DATA MSG05 / ' AVAILABLE SECTORS: ???????? LARGEST BLOCK:', 00250 + ' ???????? ' / 00260 INTEGER MSG06(63) 00270 DATA MSG06 / ' ???????? ?,???? ???????? ?,???? ???????? ?,?' 0028000 + ,'??? ???????? ?,???? ???????? ?,???? ????????' 00290 + ,' ?,???? ???????? ?,???? ' / 003001 00310 INTEGER VDC 003202 00330 LEFT(1)=4 00340+ ; BASIC CHARACTER MOVE SIZES 0035000 RIGHT(1)=4 003601 00370C LINE 1 003801 00390 CALL CCSMVA(VIT(2),1,8,MSG01(6),1,8) 00400+ ; VOLUME NAME 00410 CALL DATTIM(TEMP) 0042000+ ; TIME & DATE INFORMATION 00430 MSG01(14)=TEMP(2) 00440 MSG01(15)=OR($2F00,ISHIFT(AND(TEMP(3),$FF00),8)) 00450 MSG01(16)=OR(ISHIFT(AND(TEMP(3),$00FF),8),$002F) 00460 MSG01(17)=TEMP(1) 00470 TEMP(1)=TEMP(11) 00480 CALL VLTOI(TEMP) 0049000 CALL CHO2LR(TEMP(3),MSG01(19),LEFT) 00500 IF ( NOPORT.NE.00 ) GOTO 100 00510+ ; IF NOT RUNNING MASTER CONSOLE 00520 MSG01(26)=VDC(VIT(6)) 00530+ ; VINMBR 00540 ISTAT=MPFACE(PRNTLU,MSG01,52) 00550 ISTAT=MPFACE(PRNTLU,2H ,2) 00560001 00570C LINE 1.B 005801 00590 TEMP(1)=VIT(7) 00600+ ; VIBMSM 00610 CALL FRHX(TEMP) 00620 CALL CHO2LR(TEMP(2),MSG02(6),LEFT) 0063000 TEMP(1)=VIT(8) 00640+ ; VIBMSL 00650 CALL FRHX(TEMP) 00660 CALL CHO2LR(TEMP(2),MSG02(8),RIGHT) 00670 TEMP(1)=VIT(15) 00680+ ; VIFDDM 00690 CALL FRHX(TEMP) 0070000 CALL CHO2LR(TEMP(2),MSG02(16),LEFT) 00710 TEMP(1)=VIT(16) 00720+ ; VIFDDL 00730 CALL FRHX(TEMP) 00740 CALL CHO2LR(TEMP(2),MSG02(18),RIGHT) 00750 TEMP(1)=VIT(19) 00760+ ; VINFDB 0077000 CALL VLTOI(TEMP) 00780 LEFT(1)=5 00790 CALL CHO2LR(TEMP(2),MSG02(26),LEFT) 00800 LEFT(1)=4 00810 CALL FRHX(TEMP) 00820 CALL CHO2LR(TEMP(2),MSG02(29),RIGHT) 00830 TEMP(1)=VIT(20) 0084000+ ; VINXTB 00850 CALL FRHX(TEMP) 00860 CALL CHO2LR(TEMP(2),MSG02(37),LEFT) 00870 ISTAT=MPFACE(PRNTLU,MSG02,76) 00880 GOTO 120 008901 00900 100 ISTAT=MPFACE(PRNTLU,MSG01,40) 0091000 120 ISTAT=MPFACE(PRNTLU,2H ,2) 009201 00930C LINE 2 009401 00950 LEFT(1)=5 00960 RIGHT(1)=5 00970 TEMP(1)=VIT(17) 0098000+ ; VIMAXF 00990 CALL VLTOI(TEMP) 01000 CALL CHO2LR(TEMP(2),MSG03(19),RIGHT) 01010 TEMP(1)=VIT(18) 01020+ ; VICURF 01030 CALL VLTOI(TEMP) 01040 CALL CHO2LR(TEMP(2),MSG03(42),RIGHT) 0105000 ISTAT=MPFACE(PRNTLU,MSG03,88) 01060 ISTAT=MPFACE(PRNTLU,2H ,2) 01070 RIGHT(1)=4 01080 LEFT(1)=4 01090 IF ( NOPORT.NE.00 ) GOTO 180 01100+ ; IF NOT RUNNING MASTER CONSOLE 011101 0112000C LINE 2.B 011301 01140 TEMP(1)=VIT(9) 01150+ ; VIASDM 01160 CALL FRHX(TEMP) 01170 CALL CHO2LR(TEMP(2),MSG04(5),RIGHT) 01180 TEMP(1)=VIT(10) 0119000+ ; VIASDL 01200 CALL FRHX(TEMP) 01210 CALL CHO2LR(TEMP(2),MSG04(8),LEFT) 01220 TEMP(1)=VIT(11) 01230+ ; VIASDS 01240 CALL VLTOI(TEMP) 01250 LEFT(1)=5 0126000 CALL CHO2LR(TEMP(2),MSG04(15),LEFT) 01270 LEFT(1)=4 01280 CALL FRHX(TEMP) 01290 CALL CHO2LR(TEMP(2),MSG04(18),RIGHT) 01300 ISTAT=MPFACE(PRNTLU,MSG04,40) 01310 ISTAT=MPFACE(PRNTLU,2H ,2) 013201 0133000C SCAN THE AVAILABLE SPACE DIRECTORY 013401 01350 180 N=2 01360 IF ( NOPORT.EQ.00 ) ISTAT=MPFACE(PRNTLU,$2020,2) 01370 CALL ZERO(TEMP,12) 01380 LENGTH(1)=64*96 01390 LENGTH(2)=VIT(9) 0140000+ ; VIASDM,VIASDL 01410 LENGTH(3)=VIT(10) 01420 200 IFLAG=MMREAD(VIT(1),LENGTH(1),LENGTH(2),DSKBFR) 01430 IF ( NOPORT.EQ.00 ) GOTO 240 01440 DO 220 I=1,6144,4 01450+ ; SUM AVAILABLE HOLE SIZES 01460 IF ( DSKBFR(I).EQ.-1 ) GOTO 300 0147000+ ; IF END OF ASD LIST 01480 CALL FDWADD(TEMP(1),DSKBFR(I),TEMP(1),ISTAT) 01490 220 CONTINUE 01500 GOTO 280 015101 01520 240 DO 260 I=1,6144,4 01530+ ; SUM AVAILABLE HOLE SIZES 0154000 IF ( DSKBFR(I).EQ.-1 ) GOTO 300 01550+ ; IF END OF ASD LIST 01560 CALL FDWADD(TEMP(1),DSKBFR(I),TEMP(1),ISTAT) 01570 IF ( N.LT.63 ) GOTO 250 01580+ ; LIST HOLE SIZE & LOCATION 01590 ISTAT=MPFACE(PRNTLU,MSG06,126) 01600 N=2 0161000 250 CALL CONVER(DSKBFR(I),TEMP(3)) 01620+ ; SIZE OF THE HOLE 01630 CALL CHO2LR(TEMP(3),MSG06(N),LEFT8) 01640 MSG06(N+4)=2H 0+DSKBFR(I+2) 01650+ ; MSB LOCATION OF THE HOLE 01660 TEMP(3)=DSKBFR(I+3) 01670+ ; LSB LOCATION OF THE HOLE 0168000 CALL FRHX(TEMP(3)) 01690 CALL CHO2LR(TEMP(4),MSG06(N+5),RIGHT) 01700 N=N+9 01710 260 CONTINUE 017201 01730C GO GET NEXT 64 SECTORS OF THE AVAILABLE SPACE DIRECTORY 017401 0175000 280 LENGTH(3)=LENGTH(3)+64 01760 VIT(11)=VIT(11)-64 01770+ ; REMAINING SECTORS IN ASD 01780 IF ( VIT(11).GT.0 ) GOTO 200 017901 01800C LINE 3 018101 0182000 300 IF ( N.GT.2 ) ISTAT=MPFACE(PRNTLU,MSG06,2*(N-1)) 01830 IF ( NOPORT.EQ.00 ) ISTAT=MPFACE(PRNTLU,$2020,2) 01840 CALL CONVER(TEMP(1),TEMP(3)) 01850+ ; AVAILABLE SECTORS 01860 RIGHT(1)=8 01870 CALL CHO2LR(TEMP(3),MSG05(11),RIGHT) 01880 CALL CONVER(VIT(12),TEMP(1)) 0189000+ ; LARGEST BLOCK SIZE 01900 CALL CHO2LR(TEMP(1),MSG05(24),RIGHT) 01910 ISTAT=MPFACE(PRNTLU,MSG05,56) 01920 IF ( MODE.EQ.+7 ) GOTO 410 01930 IF ( NOPORT.NE.00 ) RETURN 01940+ ; IF NOT RUNNING MASTER CONSOLE 019501 0196000C INSERT BASIC INFORMATION AGAIN FOR MASTER LISTING 019701 01980 400 ISTAT=MPFACE(PRNTLU,MSG01,40) 01990 ISTAT=MPFACE(PRNTLU,2H ,2) 02000 ISTAT=MPFACE(PRNTLU,MSG03,88) 02010 ISTAT=MPFACE(PRNTLU,2H ,2) 02020 ISTAT=MPFACE(PRNTLU,MSG05,56) 0203000 RETURN 020401 02050 410 MODE=-7 02060 GOTO 400 020701 02080 END 02090_ 00 00 00 00 00 00 __ 0( TTFPRCHEKLIBRARY P999999060381(0 SUBROUTINE PRCHEK 00010 + /MAIN CHECKOUT ROUTINE 000202 00030C PRCHEK - PROVE CHECKOUT ROUTINE 000402 00050 INTEGER NFCB, NFILES, TEMP(2) 00060 INTEGER BIT(16) 0007000 DATA BIT / $8000,$4000,$2000,$1000,$0800,$0400,$0200,$0100, 00080 + $0080,$0040,$0020,$0010,$0008,$0004,$0002,$0001 / 000901 00100 INTEGER TWCMPR 00110$$TXPRVBLK,LIBRARY 00120 I=1 00130 IWF=0 00140001 00150C VERIFY LARGEST HOLE SIZE 001601 00170 80 IF ( ASD(1,I).EQ.-1 ) GOTO 90 00180 IF ( (ASD(1,I).EQ.0) .AND. (ASD(2,I).EQ.0) ) 00190 + WRITE (12,9015) ASD(3,I), ASD(4,I) 00200 IF ( TWCMPR(ASD(1,I),VOL(26)).EQ.+1 ) IWF=1 0021000 I=I+1 00220 GOTO 80 002301 00240 90 IF ( IWF.NE.0 ) WRITE (12,9010) 002501 00260C CHECK VIA FILE DEFINITION DIRECTORY 002701 0028000 CALL CHKFDD 002901 00300C CHECK VIA FILE CONTROL BLOCKS 003101 00320 NFCB=0 00330 NFILES=0 00340 IX=64+1 0035000 100 IF ( IX.LE.64 ) GOTO 120 00360 IF ( NFCB.GE.VLMAXF ) GOTO 200 00370 TC=MMREAD(MMU,64*96,FCBADR,FCBBFR) 00380 IX=1 00390 120 IF ( NFCB.GE.VLMAXF ) GOTO 200 00400 ITEST=0 00410 IF ( FCB(RECLEN,IX).EQ.0 ) GOTO 140 0042000 NFILES=NFILES+1 00430 ITEST=1 00440 CALL FDWADD(FCB(DATBA,IX),FCB(TSFIL,IX),LWAFIL,TC) 00450 CALL FDWSUB(FCB(DATBA,IX),ONE2 ,FWAFIL,TC) 00460 CALL FDWADD(FCB(TSFIL,IX),ONE2 ,SIZFIL,TC) 00470 CALL FDWSUB(LWAFIL ,FWAFIL ,TEMP ,TC) 00480 IF ( TWCMPR(TEMP,SIZFIL).NE.0 ) WRITE (12,9011) NFCB 0049000 IF ( AND(FCB(6,IX),$0001).EQ.0 ) GOTO 130 00500 IF ( TWCMPR(FCB(KEYBA,IX),FWAFIL).LE.0 ) WRITE (12,9000) NFCB 00510 IF ( TWCMPR(FCB(KEYBA,IX),LWAFIL).GE.0 ) WRITE (12,9001) NFCB 00520 130 TC=MMREAD(MMU,96,FWAFIL,HDR) 00530 IF ( AL.NE.2HAL ) WRITE (12,9002) NFCB 00540 IF ( TWCMPR(FWAFIL,FADDR).NE.0 ) WRITE (12,9003) NFCB 00550 IF ( TWCMPR(SIZFIL,FSIZE).NE.0 ) WRITE (12,9004) NFCB 0056000 IWF=0 00570 IF ( FCB(OWNR+0,IX).NE.FOWNR(1) ) IWF=1 00580 IF ( FCB(OWNR+1,IX).NE.FOWNR(2) ) IWF=1 00590 IF ( FCB(OWNR+2,IX).NE.FOWNR(3) ) IWF=1 00600 IF ( FCB(OWNR+3,IX).NE.FOWNR(4) ) IWF=1 00610 IWF2=0 00620 IF ( FOWNR(1).NE.2H$$ ) IWF2=1 0063000 IF ( FOWNR(2).NE.2H ) IWF2=1 00640 IF ( FOWNR(3).NE.2H ) IWF2=1 00650 IF ( FOWNR(4).NE.2H ) IWF2=1 00660 IF ( (IWF.NE.0) .AND. ( (IWF2.NE.0).OR.(FCB(87,IX).EQ.0) ) ) 00670 + WRITE (12,9005) NFCB 00680+ ; CONFLICT AND NOT EDITOR FILE 00690 IF ( TWCMPR(FCB(DATBA,IX),VLLBA).GE.0 ) 0070000 + CALL REMOVE(NFCB) 00710+ ; ONLY IN MANAGABLE SPACE 00720 140 NP=1 + (NFCB)/$10 00730 NB=1 + AND(NFCB,$000F) 00740 IF ( ITEST.NE.0 ) ITEST=BIT(NB) 00750 IF ( AND(FIAT(NP),BIT(NB)).NE.ITEST ) WRITE (12,9006) NFCB, ITEST 00760 IF ( ITEST.NE.0 ) FIAT(NP)=AND(FIAT(NP),NOT(BIT(NB))) 0077000 IF ( AND(FDDBIT(NP),BIT(NB)).NE.ITEST ) WRITE (12,9012) NFCB,ITEST 00780 IF ( ITEST.NE.0 ) FDDBIT(NP)=AND(FDDBIT(NP),NOT(BIT(NB))) 00790 IX=IX+1 00800 NFCB=NFCB+1 00810 CALL FDWADD(FCBADR,ONE2,FCBADR,TC) 00820 GOTO 100 008301 0084000 200 IF ( NFILES.NE.VLCURF ) WRITE (12,9007) NFILES, VLCURF 00850 N=(VLMAXF+15)/16 00860 DO 220 I=1,N 00870 IF ( (AND(FIAT(I),1).EQ.0).AND.(FIAT(I).EQ.0) ) GOTO 220 00880 WRITE (12,9008) I, FIAT(I), I 00890 220 CONTINUE 00900 DO 230 I=1,288 0091000 IF ( (AND(FDDBIT(I),1).NE.0).OR.(FDDBIT(I).NE.0) ) 00920 + WRITE (12,9013) I, FDDBIT(I) 00930 230 CONTINUE 00940 WRITE (12,9014) 00950 I=1 00960 240 IF ( ASD(1,I).EQ.-1 ) RETURN 00970 WRITE (12,9009) ASD(1,I), ASD(2,I), ASD(3,I), ASD(4,I) 0098000 I=I+1 00990 GOTO 240 010001 01010 9000 FORMAT(' NFCB = $',Z4,' KEYBA TOO SMALL') 01020 9001 FORMAT(' NFCB = $',Z4,' KEYBA TOO LARGE') 01030 9002 FORMAT(' NFCB = $',Z4,' NO *AL* IN HEADER') 01040 9003 FORMAT(' NFCB = $',Z4,' HEADER ADDRESS ERROR, FCB') 0105000 9004 FORMAT(' NFCB = $',Z4,' HEADER SIZE ERROR, FCB') 01060 9005 FORMAT(' NFCB = $',Z4,' HEADER OWNER ERROR, FCB') 01070 9006 FORMAT(' NFCB = $',Z4,' FIAT DISAGREEMENT, MASK = $',Z4) 01080 9007 FORMAT(' FILE COUNTS CONFLICT: NFILES = ',I5,', VLCURF = ',I5) 01090 9008 FORMAT(' FIAT LEFTOVER, FIAT(',I5,') = $',Z4,' FCB IS $',Z3,'0', 01100 + '+ BIT POSITION ( F - 0 )') 01110 9009 FORMAT(' ASD:',4(' $',Z4)) 0112000 9010 FORMAT(' VLLBL DISAGREES WITH ASD - LARGEST HOLE AVAILABLE' ) 01130 9011 FORMAT(' NFCB = $',Z4,' FILE SIZE ERROR') 01140 9012 FORMAT(' NFCB = $',Z4,' FDB DISAGREEMENT, MASK = $',Z4) 01150 9013 FORMAT(' FDB LEFTOVER, FDBX(',I5,') = $',Z4) 01160 9014 FORMAT(//' "ASD" WITH ALL FILES REMOVED IS: '//) 01170 9015 FORMAT(' ZERO LENGTH HOLE: $',Z4,',',Z4) 011801 0119000 END 01200_ 00 00 00 00 00 00 00 00 00 00 00 __ 0( % TTFPRINITLIBRARY PP999999060381(0 SUBROUTINE PRINIT 00010 + /INITIALIZE PROVE 000202 00030C PRINIT - PROVE INITIALIZE 000401 00050C DETERMINE THE VOLUME PHYSICAL UNIT 000602 0007000 INTEGER MMADDR(2), VNR(2), DATM(12) 00080 INTEGER MSG1(23), MSG2(9), MSG3(7), MSG4(11), MSG9(8) 00090 DATA MSG1 / ' P R O V E - VALIDATE FILE MANAGER STRUCTURE' / 00100 DATA MSG2 / 'NOT MASTER CONSOLE' / 00110 DATA MSG3 / 'ENTER MMUNIT: ' / 00120 DATA MSG4 / 'INVALID MMUNIT NUMBER ' / 00130 DATA MSG9 / 'VLWPS IS NOT 96 ' / 00140001 00150 INTEGER VPC 00160$$TXPRVBLK,LIBRARY 00170 DATBA=4 00180 FTYPE=6 00190 KEYBA=13 00200 TSFIL=23 0021000 OWNR=29 00220 RECLEN=1 00230 CALL CLRSCR 002401 00250C VERIFY MASTER CONSOLE 002601 00270 CALL QUIET(IND) 0028000 CALL LMARGN(20) 00290 CALL DISPLA(MSG1,46) 00300 CALL LMARGN(0) 00310 CALL DISPLA(2H ,2) 00320 IF ( AND(IND,$0002).EQ.0 ) GOTO 120 00330 CALL DISPLA(MSG2,18) 00340 CALL PGMOUT 00350001 00360C SELECT MM UNIT ( LOGICAL UNIT NUMBER ) 003701 00380 120 VNR(1)=2H 00390 CALL PROMPT(MSG3,14,VNR,1,14) 00400 VNR(1)=ISHIFT(AND(VNR(1),$FF00),8)-$0030 00410 TC=MEMORY(MEMORY($00E9)+29) 0042000 IF ( (VNR(1).GE.0) .AND. (VNR(1).LT.MEMORY(TC)) ) GOTO 140 00430 CALL ERROR(MSG4,22,18) 00440 GOTO 120 004501 00460 140 IVIT=MEMORY(TC+1+VNR(1)) 00470 MMU=MEMORY(IVIT) 004801 0049000C READ VOLUME LABEL SECTOR 00500C DETERMINE FCB AREA SECTOR ADDRESS 00510C READ THE AVAILABLE SPACE DIRECTORY & LOCATE THE END MARKER 005201 00530 160 MMU=AND(MMU,$7FFF) 00540 MMADDR(1)=MEMORY(IVIT+21) 00550 MMADDR(2)=MEMORY(IVIT+22) 0056000 TC=MMREAD(MMU,96,MMADDR,VOL) 00570 IF ( VOL(28).NE.96 ) GOTO 200 00580 CALL DATTIM(DATM) 00590 DATM(4)=VPC(VOL(3)) 00600 DATM(5)=VPC(VOL(4)) 00610 DATM(6)=VPC(VOL(5)) 00620 DATM(7)=VPC(VOL(6)) 0063000 WRITE (12,9000) DATM(3), DATM(2), DATM(1), DATM(11), 00640 + (DATM(I), I=4,7) 00650 MMADDR(1)=0 00660 MMADDR(2)=VLNFDB 00670 CALL FDWADD(MMADDR,VLFDD,FCBADR,TC) 00680 MMADDR(2)=VLMAXF 00690 CALL FDWADD(MMADDR,FCBADR,MMADDR,TC) 0070000 TC=MMREAD(MMU,3*96,MMADDR,FIAT) 00710 TC=MMREAD(MMU,VLASDS*96,VLASD,ASDBFR) 00720 LASD=1 00730 180 IF ( ASD(1,LASD).EQ.-1 ) RETURN 00740 LASD=LASD+1 00750 GOTO 180 007601 0077000 200 CALL DISPLA(MSG9,16) 00780 CALL PGMOUT 007901 00800 9000 FORMAT('1 PROVE RUN ',A2,'/',A2,'/',A2,4X,I6,//, 00810 + ' VOLUME LABEL ',4A2,///) 008201 00830 END 0084000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(d z d*TFPROMPTLIBRARY PR999999060381(0 SUBROUTINE PROMPT(OUT,OSIZE,IN,ISIZE) 00010 + /CCS 2.0 $$USERID MANAGER DECK10 SUMMARY-*** 000202 00030C PROMPT - NORMAL SCREEN HANDLING ROUTINE. 00040C FUNCTIONS : 00050C 1. CLEAR SCREEN 00060C 2. ISSUE MESSAGES TO SCREEN AT NEXT LINE 0007000C 3. ISSUE INPUT PROMPTS AT NEXT LINE AND GET RESPONSE 00080C 4. PAUSE WHEN SCREEN IS FULL 000902 00100C ENTRY - 'OUT', OUTPUT MESSAGE ADDRESS 00110C 'OSIZE', NUMBER OF CHARACTERS IN OUTPUT MESSAGE 00120C 'IN', INPUT RESPONSE ADDRESS 00130C 'INSIZE', NUMBER OF CHARACTERS EXPECTED IN RESPONSE 00140002 00150C *NOTES* 00160C 'OSIZE' =0, CLEAR SCREEN AND RETURN WITHOUT FURTHER 00170C PROCESSING OF ARGUMENTS ( UNLESS 'ISIZE'<0 ) 00180C 'OSIZE' <0, CLEAR SCREEN AND PROCESS ARGUMENTS USING 00190C ABS(OSIZE) FOR THE NUMBER OF CHARACTERS IN 00200C THE OUTPUT MESSAGE 0021000C 'ISIZE' =0, 'OUT' IS JUST AN INFORMATIVE MESSAGE, 00220C DO NOT ACCEPT A RESPONSE 00230C 'ISIZE' <0, IF 'OSIZE'=0, THEN DISPLAY A PAUSE MESSAGE 00240C AND WAIT FOR A RESPONSE (IGNORED). 00250C - IF 'ISIZE' > 0, THEN 'IN' IS BLANK FILLED BEFORE THE 00260C PROMPT IS ISSUED. 00270C - THE VARIABLE 'QP' IS USED TO KEEP TRACK OF THE CURRENT 0028000C LINE POSITION ( Y-COORDINATE ) ON THE SCREEN. 00290C - 'IN' MUST BE AT LEAST 'ISIZE'/2+1 WORDS LONG DUE TO 00300C 'WTREAD' CONVENTIONS ( APPLIES ONLY IF 'ISIZE' > 0 ). 003102 00320 INTEGER OUT(1), OSIZE, IN(1), ISIZE 003301 00340 INTEGER AP, OS, IS, QP, PAUSE(3), TC, N, DUMIE(2) 00350001 00360 DATA PAUSE / 'PAUSE ' / 00370 DATA TC / 0 / 00380 DATA QP / -1 / 00390$$WSUSRBLK 00400 OS=OSIZE 00410 IS=ISIZE 0042000 IF ( OS.LE.0 ) GOTO 100 00430 QP=QP+1 00440 IF ( QP.LT.$0016 ) GOTO 200 00450 IF ( QP.LT.$2700 ) QP=$2800 00460 IF ( QP.LT.$2816 ) GOTO 200 004701 00480C SCREEN IS FULL, ISSUE PAUSE MESSAGE, WAIT FOR ACKNOWLEDGEMENT (CR), 0049000C CLEAR SCREEN, AND CONTINUE. 005001 00510 CALL WTREAD(LU,QP+1,PAUSE,6,QP+$0601,DUMIE,1,TC) 005201 00530C CLEAR SCREEN IF 'OSIZE' IS NEGATIVE 005401 00550 100 IF ( (OS.EQ.0) .AND. (IS.LT.0) ) GOTO 300 0056000 CALL WTREAD(LU,-1,$2018,2,-1,0,0,TC) 00570 QP=-1 00580 IF ( OS.EQ.0 ) RETURN 00590 QP=0 00600 IF ( OS.LT.0 ) OS=-OS 006101 00620C PREPARE TO ISSUE THE PROMPT 00630001 00640 200 IF ( IS.LT.0 ) IS=0 00650 AP=(OS+1)*$0100+QP 00660 IF ( IS.EQ.0 ) GOTO 260 00670 N=(IS+1)/2 00680+ ; NUMBER OF WORDS IN 'IN' 00690 220 DO 240 I=1,N 0070000+ ; BLANK OUT 'IN' 00710 IN(I)=2H 00720 240 CONTINUE 007301 00740 260 CALL WTREAD(LU,QP,$1600,1,-1,0,0,TC) 00750 CALL WTREAD(LU,QP,OUT,OS,AP,IN,IS,TC) 00760 IF ( TC.EQ.4 ) GOTO 220 0077000+ ; IGNORE RUBOUT LINES 00780 RETURN 007901 00800C PAUSE FOR OPERATOR RESPONSE 008101 00820 300 CALL WTREAD(LU,QP+2,PAUSE,6,QP+$0602,DUMIE,1,TC) 00830 RETURN 00840001 00850 END 00860_ 00 00 __ 0(2 2TFPROVE LIBRARY P999999060381(0 PROGRAM PROVE 00010 + /CHECK FILE MANAGER DATA STRUCTURES 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 04/23/80 (CGODSO) 000402 00050C PROVE - CHECK FILE MANAGER DATA STRUCTURES 000601 0007000C VERIFY CONSISTENCY OF: 00080C 00090C 1. AVAILABLE SPACE DIRECTORY 00100C 2. FILE DEFINITION DIRECTORY 00110C 3. FILE CONTROL BLOCKS 00120C 4. FCB INDEX ALLOCATION TABLE 00130C 5. FILE HEADER SECTORS 0014000C 6. FILE SPACE / AVAILABLE SPACE OVERLAP 00150C 7. VOLUME LABEL SECTOR VALUES 001602 00170 CALL PRINIT 00180 CALL PRCHEK 00190 CALL PGMOUT 002001 0021000 END 00220_ 00 00 00 00 __ 0(2 2TFPROVRMLIBRARY P"999999060381(0 SUBROUTINE PROVRM 00010 + /REMOUNT DISMOUNTED VOLUME 000202 00030C REMOUN - REMOUNT DISMOUNTED VOLUME 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 000601 0007000C IF PRINIT DISMOUNTED THE VOLUME, THEN REMOUNT IT AND NOTIFY THE 00080C OPERATOR. 000902 00100 INTEGER MSG1(9), MSG2(13), REQBUF(24) 00110 DATA MSG1 / '???????? REMOUNTED' / 00120 DATA MSG2 / 'ERROR VOLUSE $???? REMOUNT' / 00130 DATA REQBUF / 24*0 / 0014000$$TXPRVBLK,LIBRARY 00150 IF ( IDSMT.LT.0 ) RETURN 00160 CALL VOLUSE(REQBUF,VOL(3),IDSMT+1,ISTAT) 00170 CALL DISPLA(2H ,2 ) 00180 IF ( ISTAT.LT.0 ) GOTO 100 00190 CALL MOVECH(VOL(3),1,MSG1,1,8) 00200 CALL DISPLA(MSG1,18) 0021000 RETURN 002201 00230 100 CALL HEXASC(ISTAT,MSG2(8)) 00240 CALL DISPLA(MSG2,26) 00250 CALL DISPLA(2H ,2) 00260 CALL PGMOUT 002701 0028000 END 00290_ 00 00 00 __ 0(d d*TFQUIET LIBRARY P999999060381(0 SUBROUTINE QUIET(IND) 00010 + /INDICATORS FOR ENVIRONMENT 000202 00030C QUIET - INDICATORS FOR ENVIRONMENT 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 08/19/80 (CGODSO) 000601 0007000C BIT SETTINGS FOR IND: 00080C 00090C 1 - OFF IF OWNER ID IS $$ $0001 00100C 2 - OFF IF MASTER CONSOLE $0002 00110C 3 - OFF IF ITOS DISABLED $0004 00120C 4 - OFF IF SPOOLER INACTIVE $0008 00130C 5 - OFF IF AUTO BATCH DISABLED $0010 0014000C 6 > 15 - OFF IF COMM18 PROCESSOR DISABLED $0020 > $8000 001502 00160 INTEGER IND 001701 00180 INTEGER USER(4), LU, MODE, NOPORT, IADR, IFLAG, N, I, COMM18 00190 INTEGER TSNABL(3), EXECST(3), AUTON(3), QMNTBS(3) 00200 DATA TSNABL / 'TSNABL' / 0021000 DATA EXECST / 'EXECST' / 00220 DATA AUTON / 'AUTON ' / 00230 DATA QMNTBS / 'QMNTBS' / 00240 INTEGER QMNTPA(3) 00250 DATA QMNTPA / 'QMNTPA' / 002602 00270 IND=0 0028000+ ; ASSUME EVERYTHING OFF 002901 00300 CALL PGMIN(USER,LU,MODE,NOPORT) 00310+ ; CHECK FOR OWNER ID $$ 00320 IF ( USER(1).NE.2H$$ ) IND=$0001 00330 IF ( USER(2).NE.2H ) IND=$0001 00340 IF ( USER(3).NE.2H ) IND=$0001 0035000 IF ( USER(4).NE.2H ) IND=$0001 003601 00370 IF ( NOPORT.NE.00 ) IND=OR(IND,$0002) 00380+ ; CHECK MASTER CONSOLE 003901 00400 CALL GETADD(TSNABL,IADR,IFLAG) 00410+ ; CHECK ITOS 0042000 IF ( MEMORY(IADR).NE.0 ) IND=OR(IND,$0004) 004301 00440 CALL GETADD(EXECST,IADR,IFLAG) 00450+ ; CHECK SPOOLER 00460 IF ( MEMORY(IADR).EQ.0 ) IND=OR(IND,$0008) 004701 00480 CALL GETADD(AUTON,IADR,IFLAG) 0049000+ ; CHECK BATCH 00500 IF ( MEMORY(IADR).NE.0 ) IND=OR(IND,$0010) 005101 00520 CALL GETADD(QMNTBS,N,IFLAG) 00530+ ; CHECK COMM18 00540 IF ( IFLAG.LT.0 ) RETURN 00550 IF ( N.LE.0 ) RETURN 0056000 CALL GETADD(QMNTPA,IADR,IFLAG) 00570 IF ( IFLAG.LT.0 ) RETURN 00580 COMM18=$0020 00590 DO 100 I=1,N 00600 IF ( MEMORY(IADR+I-1).NE.0 ) IND=OR(IND,COMM18) 00610 COMM18=ISHIFT(COMM18,1) 00620 100 CONTINUE 0063000 RETURN 006401 00650 END 00660_ 00 00 00 00 00 __ 0( ?TFREMOVELIBRARY P999999060381(0 SUBROUTINE REMOVE(NFCB) 00010 + /SIMULATE FILE SPACE DELETE 000202 00030C REMOVE - SIMULATE FILE SPACE DELETION. 000401 00050C IN THE AVAILABLE SPACE DIRECTORY COPY, INSERT A HOLE CORRESPONDING 00060C TO THE CURRENT FCB AND COALESCE THE SPACE. 0007000C 00080C *NOTE* *LASD* MUST TRACK THE END OF LIST MARKER 000902 00100 INTEGER NFCB 001101 00120 INTEGER NEW(2) 001301 0014000 INTEGER TWCMPR 00150$$TXPRVBLK,LIBRARY 00160 IF ( ASD(1,1).EQ.-1 ) GOTO 400 00170+ ; IF NO HOLES 00180 IF ( TWCMPR(FWAFIL,ASD(3,1)).LT.0 ) GOTO 500 00190+ ; BEFORE FIRST HOLE 00200 IF ( TWCMPR(FWAFIL,ASD(3,LASD-1)).GE.0 ) GOTO 600 0021000+ ; AFTER LAST HOLE 002201 00230 I=2 002401 00250C LOCATE THE FILE'S POSITION IN THE ASD 002601 00270 100 IF ( ASD(1,I).EQ.-1 ) GOTO 600 0028000 IF ( TWCMPR(FWAFIL,ASD(3,I)).LE.0 ) GOTO 120 00290 I=I+1 00300 GOTO 100 003101 00320 120 K=LASD+1 00330 DO 140 J=I,LASD 00340+ ; MOVE UP 0035000 ASD(1,K)=ASD(1,K-1) 00360 ASD(2,K)=ASD(2,K-1) 00370 ASD(3,K)=ASD(3,K-1) 00380 ASD(4,K)=ASD(4,K-1) 00390 K=K-1 00400 140 CONTINUE 00410 LASD=LASD+1 0042000 ASD(1,I)=SIZFIL(1) 00430+ ; INSERT 00440 ASD(2,I)=SIZFIL(2) 00450 ASD(3,I)=FWAFIL(1) 00460 ASD(4,I)=FWAFIL(2) 004701 00480 N=TWCMPR(LWAFIL,ASD(3,I+1)) 0049000 IF ( N.LT.0 ) GOTO 200 00500+ ; IF CAN'T MERGE UPWARD 00510 LASD=LASD-1 00520 IF ( N.GT.0 ) WRITE (12,9000) NFCB 00530 CALL FDWADD(ASD(1,I+1),ASD(3,I+1),NEW,TC) 00540 CALL FDWSUB(NEW,FWAFIL,ASD(1,I),TC) 00550+ ; ENLARGE HOLE 0056000 K=I+1 00570 DO 160 J=K,LASD 00580+ ; MOVE DOWN 00590 ASD(1,J)=ASD(1,J+1) 00600 ASD(2,J)=ASD(2,J+1) 00610 ASD(3,J)=ASD(3,J+1) 00620 ASD(4,J)=ASD(4,J+1) 0063000 160 CONTINUE 006401 00650 200 CALL FDWADD(ASD(1,I-1),ASD(3,I-1),NEW,TC) 00660 N=TWCMPR(NEW,FWAFIL) 00670 IF ( N.LT.0 ) RETURN 00680+ ; IF CAN'T MERGE DOWNWARD 00690 LASD=LASD-1 0070000 IF ( N.GT.0 ) WRITE (12,9001) NFCB 00710 CALL FDWADD(ASD(1,I),ASD(3,I),NEW,TC) 00720 CALL FDWSUB(NEW,ASD(3,I-1),ASD(1,I-1),TC) 00730 DO 220 J=I,LASD 00740 ASD(1,J)=ASD(1,J+1) 00750 ASD(2,J)=ASD(2,J+1) 00760 ASD(3,J)=ASD(3,J+1) 0077000 ASD(4,J)=ASD(4,J+1) 00780 220 CONTINUE 00790 RETURN 008001 00810C IF NO EXISTING HOLES 008201 00830 400 LASD=2 0084000 ASD(1,1)=SIZFIL(1) 00850 ASD(2,1)=SIZFIL(2) 00860 ASD(3,1)=FWAFIL(1) 00870 ASD(4,1)=FWAFIL(2) 00880 ASD(1,LASD)=-1 00890 RETURN 009001 0091000C FILE IS BEFORE THE FIRST HOLE 009201 00930 500 LASD=LASD+1 00940 K=LASD 00950 DO 520 J=1,LASD 00960+ ; MOVE UP 00970 ASD(1,K)=ASD(1,K-1) 0098000 ASD(2,K)=ASD(2,K-1) 00990 ASD(3,K)=ASD(3,K-1) 01000 ASD(4,K)=ASD(4,K-1) 01010 K=K-1 01020 520 CONTINUE 01030 ASD(1,1)=SIZFIL(1) 01040+ ; INSERT 0105000 ASD(2,1)=SIZFIL(2) 01060 ASD(3,1)=FWAFIL(1) 01070 ASD(4,1)=FWAFIL(2) 01080 N=TWCMPR(LWAFIL,ASD(3,2)) 01090 IF ( N.LT.0 ) RETURN 01100+ ; IF CAN'T MERGE 01110 LASD=LASD-1 0112000 IF ( N.GT.0 ) WRITE (12,9000) NFCB 01130 CALL FDWADD(ASD(1,2),ASD(3,2),NEW,TC) 01140 CALL FDWSUB(NEW,FWAFIL,ASD(1,1),TC) 01150+ ; ENLARGE HOLE 01160 DO 540 J=2,LASD 01170+ ; MOVE DOWN 01180 ASD(1,J)=ASD(1,J+1) 0119000 ASD(2,J)=ASD(2,J+1) 01200 ASD(3,J)=ASD(3,J+1) 01210 ASD(4,J)=ASD(4,J+1) 01220 540 CONTINUE 01230 RETURN 012401 01250C FILE IS AFTER THE LAST HOLE 01260001 01270 600 ASD(1,LASD)=SIZFIL(1) 01280+ ; INSERT 01290 ASD(2,LASD)=SIZFIL(2) 01300 ASD(3,LASD)=FWAFIL(1) 01310 ASD(4,LASD)=FWAFIL(2) 01320 LASD=LASD+1 0133000 ASD(1,LASD)=-1 01340 CALL FDWADD(ASD(1,LASD-2),ASD(3,LASD-2),NEW,TC) 01350 N=TWCMPR(NEW,FWAFIL) 01360 IF ( N.LT.0 ) RETURN 01370+ ; IF CAN'T MERGE 01380 LASD=LASD-1 01390 IF ( N.GT.0 ) WRITE (12,9001) NFCB 0140000 CALL FDWSUB(LWAFIL,ASD(3,LASD-1),ASD(1,LASD-1),TC) 01410+ ; ENLARGE HOLE 01420 ASD(1,LASD)=-1 01430 RETURN 014401 01450 9000 FORMAT(' FCB $',Z4,' OVERLAPS FILE SPACE WITH LARGER ADDRESS') 01460 9001 FORMAT(' FCB $',Z4,' OVERLAPS FILE SPACE WITH SMALLER ADDRESS') 01470001 01480 END 01490_ __ RETURN 014401 01450 9000 FORMAT(' FCB $',Z4,' OVERLAPS FILE SPACE WITH LARGER ADDRESS') 01460 9001 FORMAT(' FCB $',Z4,' OVERLAPS FILE SPACE WITH SMALLER ADDRESS') 014700( <  TFREPL LIBRARY P999999060381(0 SUBROUTINE REPL(WHAT,WHERE,HOWFAR) 00010 + /REPLICATE ( INITIALIZE ) ARRAY TO CONSTANT 000202 00030C REPL - REPEAT A SINGLE VALUE INTO AN ARRAY. 000401 00050C WHAT - THE INITIALIZING VALUE 00060C WHERE - ARRAY TO BE INITIALIZED 0007000C HOWFAR - NUMBER OF ENTRIES IN THE ARRAY TO INITIALIZE 000802 00090 INTEGER WHAT, WHERE(1), HOWFAR 001001 00110 IF ( HOWFAR.LE.0 ) RETURN 00120+ ; BEWARE 00130 DO 100 I=1,HOWFAR 0014000 WHERE(I)=WHAT 00150 100 CONTINUE 00160 RETURN 001701 00180 END 00190_ __ DO 100 I=1,HOWFAR 001400(2 F 2TFRETSFLLIBRARY P999999060381(0 SUBROUTINE RETSFL 00010 + /DESTROY SORT FILE 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C RETSFL - RETURN SORT INTERMEDIATE FILE. 000601 0007000C CLOSE AND DELETE THE INDEXED FILE USED BY SSP. 000802 00090$$TXSSPBLK 00100 CALL CLOSFL(REQBUF,ISTAT) 00110 CALL ZERO(REQBUF,24) 00120 CALL DELETE(REQBUF,IDATA,ISTAT) 00130 RETURN 00140001 00150 END 00160_ 00 00 00 00 00 __ 0(d \ d*TFRIPSSPLIBRARY P999999060381(0*JOB 00010*K,I13,P2,L12 00020*FTN 00030 OPT XLC 00040 PROGRAM RIPSSP 000502 00060C RIPSSP GENERATE A LISTING FROM SSP FILE 00070001 00080 INTEGER LINE(80), FCB(96) 00090 INTEGER IREQ(24), OREQ(24) 00100 DATA IREQ / 24*0 / 00110 DATA OREQ / 24*0 / 00120 INTEGER IDATA(15), ODATA(24) 00130 DATA IDATA / '@SSP? ','????????',' ',1,1,0 / 0014000 DATA ODATA / 'RIP ','????????','SYSVOL ',80,11*0 / 00150 INTEGER FIFTY(2), KEYVAL(8) 00160 DATA FIFTY / 0,50 / 00170 DATA KEYVAL / 8*0 / 00180 INTEGER STAT, NOPORT 001901 00200 CALL PGMIN(IDATA(5),IDUMMY,IDUMMY,NOPORT) 0021000 CALL CCSPUT(NOPORT+1R@,5,IDATA) 00220 CALL OPENFL(IREQ,IDATA,STAT) 00230 IF ( STAT.LT.0 ) CALL FMERR(IDATA,3,STAT) 00240 CALL CCSMVA(IDATA(5),1,8,ODATA(5),1,8) 00250 CALL DELETE(OREQ,ODATA,STAT) 00260 CALL GETFCB(IREQ,0,0,FCB,STAT) 00270 IF ( STAT.LT.0 ) CALL FMERR(IDATA,7,STAT) 0028000 CALL FDWADD(FCB(7),FIFTY,ODATA(14),IOVF) 00290 CALL ZERO(OREQ,24) 00300 CALL CREATE(OREQ,ODATA,STAT) 00310 IF ( STAT.LT.0 ) CALL FMERR(ODATA,0,STAT) 00320 CALL ZERO(OREQ,24) 00330 ODATA(13)=0 00340 ODATA(14)=1 0035000 ODATA(15)=0 00360 CALL OPENFL(OREQ,ODATA,STAT) 00370 IF ( STAT.LT.0 ) CALL FMERR(ODATA,3,STAT) 003801 00390 100 CALL GETS(IREQ,LINE,KEYVAL,STAT) 00400 IF ( AND(STAT,$0100).EQ.$0100 ) GOTO 200 00410 IF ( STAT.LT.0 ) CALL FMERR(IDATA,14,STAT) 0042000 CALL CCSBLK(LINE,16) 00430 CALL CCSBLK(LINE(18),60) 00440 CALL PUTS(OREQ,LINE(8),1,STAT) 00450 IF ( STAT.LT.0 ) CALL FMERR(ODATA,11,STAT) 00460 GOTO 100 004701 00480 200 CALL CLOSFL(IREQ,STAT) 0049000 CALL CLOSFL(OREQ,STAT) 00500 CALL PGMOUT 005101 00520 END 00530 SUBROUTINE FMERR(NAME,NUMBER,ISTAT) 005401 00550 CALL FILERR(NAME,NUMBER,ISTAT,5) 0056000 CALL PGMOUT 005701 00580 END 00590 MON 00600*LIBEDT 00610*K,I8,P8 00620*P,F,3 0063000*J,RIPSSP,$$ 00640*Z 00650*Z 00660_ 00 00 00 00 00 __ 0(  TFSCAN LIBRARY P999999060381(0 INTEGER FUNCTION SCAN( LINE, IC, IP, L ) 00010 + /SCAN - SCAN STRING TO SEPERATOR 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 08/06/80 (CGODSO) 000401 00050 INTEGER RAO 00060 IF( IP .LE. L ) GO TO 10 0007000 IP = 0 00080 GO TO 100 00090C10 IF( CHAR(LINE,RAO(IP)) .EQ. IC ) GO TO 100 00100 10 CALL CCSGET(LINE,RAO(IP),ICH) 00110 IF ( ICH.EQ.IC ) GOTO 100 00120 IF( IP .LT. L ) GO TO 10 00130 IP = L+1 0014000100 SCAN = IP 00150 RETURN 00160 END 00170_ __ IP = L+1 001400(d d*TFSETKEYLIBRARY P999999060381(0 SUBROUTINE SETKEY 00010 + /SET PRIMARY SORT KEY 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C SETKEY - SET PRIMARY KEY INTO RECORD. 000601 0007000C SETKEY SELECTS A PRIMARY KEY FOR THE RECORD SO THAT THE FILE 00080C MAY BE SCANNED IN THE (PROPER) SORTED ORDER. 00090C 00100C THE SELECTION IS DETERMINED BY THE FOLLOWING TABLE: 00110C 00120C TYPE(3) SUBSRT(3) KEY 00130C 0014000C +1 +1 OWNER NAME [8 BYTES], SECTOR ADDR [8 BYTES] 00150C +1 -1 SECTOR ADDR [16 BYTES] 00160C (EACH BYTE PAIR IS A SPACE AND A DIGIT) 00170C -1 +1 OWNER NAME [8 BYTES], FILE NAME [8 BYTES] 00180C -1 -1 FILE NAME [8 BYTES], SEQ. NUMBER [8 BYTES] 00190$$TXSSPBLK 00200 IF ( TYPE(3).EQ.1 ) GOTO 300 0021000+ ; IF BY SECTOR ADDRESS 00220 IF ( SUBSRT(3).EQ.1 ) GOTO 200 00230+ ; IF BY OWNER NAME ALSO 002401 00250C SELECTED FILE NAME AND NO OWNER SORT 002601 00270 REC(4)=NFCB 0028000 CALL FRHX(REC(4)) 00290+ ; SEQ. NUMBER TO REC(5;8) 00300 CALL CCSMVA(FCBBFR(25),1,8,REC(1),1,8) 00310+ ; FILE NAME TO REC(1;4) 00320 RETURN 003301 00340C SELECTED FILE NAME AND OWNER SORT 00350001 00360 200 CALL CCSMVA(FCBBFR(29),1,8,REC(1),1,8) 00370+ ; OWNER NAME TO REC(1;4) 00380 CALL CCSMVA(FCBBFR(25),1,8,REC(5),1,8) 00390+ ; FILE NAME TO REC(5;8) 00400 RETURN 004101 0042000 300 IF ( SUBSRT(3).EQ.1 ) GOTO 400 00430+ ; IF BY OWNER NAME ALSO 004401 00450C SELECTED STARTING SECTOR ADDRESS AND NO OWNER SORT 004601 00470 REC(4)=FCBBFR(5) 00480 CALL FRHX(REC(4)) 0049000+ ; L.S. SECTOR ADDR TO REC(5;8) 00500 REC0=FCBBFR(4) 00510 CALL FRHX(REC0) 00520+ ; M.S. SECTOR ADDR. TO REC(1;4) 00530 DO 320 I=1,8 00540+ ; SPACE FILL REC(1;8) 00550 REC(I)=OR($2000,REC(I)) 0056000 320 CONTINUE 00570 RETURN 005801 00590C SELECTED STARTING SECTOR ADDRESS AND OWNER NAME SORT 006001 00610 400 REC(4)=FCBBFR(5) 00620+ ; SECTOR ADDR. INTO REC(5;8) 0063000 CALL FRHX(REC(4)) 00640 REC0=FCBBFR(4) 00650 CALL FRHX(REC0) 00660 REC(8)=OR(ISHIFT(REC(7),8),REC(8)) 00670 REC(7)=OR(ISHIFT(REC(5),8),REC(6)) 00680 REC(6)=OR(ISHIFT(REC(3),8),REC(4)) 00690 REC(5)=OR(ISHIFT(REC(1),8),REC(2)) 0070000 CALL CCSMVA(FCBBFR(29),1,8,REC(1),1,8) 00710+ ; OWNER NAME TO REC(1;4) 00720 RETURN 007301 00740 END 00750_ 00 00 00 00 __ 0(, ,}TFSNARF LIBRARY P999999060381(0 PROGRAM SNARF E 00010 DIMENSION ID(4) E 00020 INTEGER BUFFER(45),IRQBF(32 ),ORQBF(32),NAMEIN(15),NAMOUT(15) E 00030 DATA NAMEIN/12*0,0,10,-1/ E 00040 DATA NAMOUT/12*0,0,10,-1/ E 00050 DATA ICLR /$1820 / E 00060 CALL PGMIN(ID,LU,MM,NOP) E 0007000 CALL MOVE (ID,NAMEIN(5),4) E 00080 CALL MOVE (ID, NAMOUT(5), 4 ) E 00090 WRITE(5,5000)ICLR E 001005000 FORMAT(A1,' S N A R F VERSION 1.1') E 00110 CALL GETNAM(NAMEIN,NAMOUT) E 00120 CALL OPEN(NAMEIN,IRQBF ) E 00130 CALL OPEN(NAMOUT,ORQBF) E 0014000 CALL GETLNO(IFRST,ILAST) 001501 CALL REED(BUFFER,IRQBF ,IEOF) E 00160 IF( IEOF .NE. 0 ) GO TO 900 E 0017020 LINE = LINUM( BUFFER ) 00180 IF( LINE .LT. IFRST ) GO TO 1 00190 IF( LINE .GT. ILAST ) GO TO 900 00200 CALL WRIT(BUFFER,ORQBF) E 0021000 GO TO 1 E 00220900 CALL WRIT($5F00,ORQBF) 00225 CALL CLOSFL(ORQBF,ISTAT) E 00230 CALL CLOSFL(IRQBF,ISTAT) 00240 WRITE(5,1000)(NAMOUT(K9P),K9P=1,4) E 002501000 FORMAT('DONE--REMEMBER TO SEQUENCE ',4A2,' BEFORE EDITING') E 00260 CALL PGMOUT E 0027000 END E 00280 SUBROUTINE OPEN( NAME, IBUF) E 00290 DIMENSION NAME(15),IBUF(32),IT(5) E 00300 DATA LVL / 0 / E 00310 LVL = LVL + 1 E 00320 CALL ZERO(IBUF,32) E 00330 IBUF(30) = LVL E 0034000 CALL OPENFL(IBUF,NAME,ISTAT) E 00350 IF(ISTAT.GE.0) RETURN E 00360 CALL MOVE(NAME,IT,4) E 00370 IT(5)=ISTAT E 00380 CALL SYSMSG( 331,IT) E 00390 CALL PGMOUT E 00400 END E 0041000 SUBROUTINE GETNAM(N,M) E 00420 DIMENSION N(1),M(1) E 00430 CALL BLANK( N, 4) 00431 CALL BLANK ( M, 4 ) 00432 WRITE(5,1000) E 00440 IS = N(5) 00445 CALL WTREAD(5,-1,0,0,-1,N,8,ITC) E 0045000 N(5) = IS 00455 IS = M(5) 00456 WRITE(5,1001) E 00460 CALL WTREAD(5,-1,0,0,-1,M,8,ITC) E 00470 M(5) = IS 00471 RETURN E 004801000 FORMAT('ENTER FIRST SOURCE FILE NAME ') E 00490001001 FORMAT('ENTER OUTPUT FILE NAME ') E 005002000 FORMAT(4A2) E 00510 END E 00520 SUBROUTINE WRIT( IBUF,IRBUF) E 00530 DIMENSION IBUF(45),IRBUF(29) E 00540 INTEGER BUFFER(405) E 00550 DATA NL / 0 / E 0056000 IF( IBUF(1) .EQ. $5F00 ) GO TO 100 E 00570 NL = NL + 1 E 00580 IP = NL*40 - 39 E 00590 CALL MOVE ( IBUF, BUFFER(IP), 40 ) E 00600 IF ( NL .LT. 10 ) RETURN E 00610 CALL PUTS ( IRBUF, BUFFER, 10, ISTAT) E 00620 GO TO 200 E 00630002 E 00640 100 IF( NL .EQ. 0 ) RETURN E 00650 CALL PUTS ( IRBUF, BUFFER, NL, ISTAT ) E 006602 E 00670 200 NL = 0 E 00680 IF(ISTAT .GE. 0) RETURN E 00690 WRITE(5,1000)ISTAT E 00700001000 FORMAT('ERROR IN WRITING FILE - ISTAT=$',Z4) E 00710 CALL PGMOUT E 00720 END E 00730 SUBROUTINE REED( IBUF,IRBUF,IEOF) E 00740 INTEGER BUFFER(405),RECPTR E 00750 DIMENSION IBUF(40),IRBUF(32) E 00760 EQUIVALENCE (NOF, IRBUF(30)),(RECPTR, IRBUF(31)),(IREC, IRBUF(32))E 0077000 DATA NOFOLD / 0 / E 00780 IEOF = 0 E 00790C E 00800 IF( NOF .GT. NOFOLD ) GO TO 100 E 00810+ NEW FILE E 00820 IF( NOF .EQ. NOFOLD ) GO TO 200 E 00830+ CURRENT FILE E 0084000 IF( NOF .LT. NOFOLD ) GO TO 300 E 00850+ OLD FILE E 008602 E 00870 100 RECPTR = 1 E 00880 IREC = 0 E 00890 GO TO 400 E 009002 E 0091000 200 IF( IREC .LT. NREC ) GO TO 500 E 00920 IF( NREC .LT. 10 ) GO TO 900 E 00930 RECPTR = RECPTR + 10 E 00940 IREC = 0 E 00950 GO TO 400 E 009602 E 00970 300 NREC = IRBUF(15) E 0098000 IF( IREC .LT. NREC ) GO TO 400 E 00990 RECPTR = RECPTR + 10 E 01000 IREC = 0 E 010102 E 01020 400 CALL GETRCS (IRBUF, BUFFER, RECPTR, NREC, IEOF ) E 01030 IF( IEOF .NE. 0 ) GO TO 950 E 010402 E 0105000 500 CALL SHPREC( BUFFER, IREC, IBUF, IEOF ) E 01060 GO TO 950 E 010702 E 01080 900 IEOF = 1 E 010901 E 01100 950 NOFOLD = NOF E 01110 RETURN E 01120002 E 01130 END E 01140 SUBROUTINE GETRCS( IRBUF, BUFFER, RECPTR, NREC, IEOF ) E 01150 DIMENSION IRBUF(32) E 01160 INTEGER BUFFER(405), RECAD(2),RECPTR E 01170 DATA RECAD / 0, 0 / E 011802 E 0119000 RECAD(2) = RECPTR E 01200 CALL READR( IRBUF, BUFFER, RECAD, ISTAT ) E 01210 IF( ISTAT .GE. 0 ) GO TO 10 E 01220 IF(AND(ISTAT,$100) .EQ. 0 ) GO TO 100 E 01230 IEOF = 1 E 01240 RETURN E 012502 E 0126000 10 NREC = IRBUF( 15 ) E 01270 RETURN E 012802 E 01290 100 WRITE(5,1000) ISTAT E 01300 1000 FORMAT( 'ERROR IN READING FILE -- ISTAT = $',Z4) E 01310 CALL PGMOUT E 013202 E 0133000 END E 01340 SUBROUTINE SHPREC ( BUFFER, IREC, IBUF, IEOF ) E 01350 INTEGER BUFFER( 405 ) E 01360 DIMENSION IBUF(40) E 01370 DATA JEOF / $5F00 / E 013802 E 01390 IREC = IREC + 1 E 0140000 IP = 40 * IREC - 39 E 01410 IF( AND( $FF00, BUFFER(IP)) .EQ. JEOF ) GO TO 900 E 01420 CALL MOVE( BUFFER(IP), IBUF, 40 ) E 01430 RETURN E 014402 E 01450 900 IEOF = 1 E 01460 RETURN E 01470002 E 01480 END E 01490 SUBROUTINE MOVE(I,J,K) E 01500 DIMENSION I(1),J(1) E 01510 DO 10 IJ=1,K E 0152010 J(IJ) = I(IJ) E 01530 RETURN E 0154000 END E 01550 SUBROUTINE SET(I,J,K) E 01560 DIMENSION J(1) E 01570 DO 10 IJ=1,K E 0158010 J(IJ) = I E 01590 RETURN E 01600 END E 0161000 SUBROUTINE ZERO(J,K) E 01620 CALL SET( 0, J, K ) E 01630 RETURN E 01640 END E 01650 SUBROUTINE BLANK( J,K) E 01660 CALL SET( $2020,J,K) E 01670 RETURN E 0168000 END E 01690 SUBROUTINE GETLNO( IF,IL) 017001 WRITE(5,1000) 017101000 FORMAT('ENTER FIRST LINE NUMBER ( 5 DIGITS )') 01720 CALL GETNUM( IF ) 01730 IF( IF .LT. 0 ) GO TO 1 017402 WRITE(5,1001) 01750001001 FORMAT('ENTER LAST LINE NUMBER ( 5 DIGITS )') 01760 CALL GETNUM( IL ) 017702000 FORMAT(I5) 01780 IF( IL .LE. 0 ) GO TO 2 01790 IF( IL .GE. IF ) RETURN 01800 WRITE(5,3000) 018103000 FORMAT(' FIRST GREATER THAN LAST -- RE-ENTER') 0182000 GO TO 1 01830 END 01840 FUNCTION LINUM( IB ) 01850 DIMENSION IB(40) 01860 DATA LINCNT,IFP / 0, 0 / 01870 IF(IFP .NE. 0 ) GO TO 10 01880 IFP = 1 0189000 ASSIGN 1000 TO IFM 01900 IF( DECODE ( IB,IFM,1,L) .LT. 0 ) GO TO 5 01910 IF( L .GT. 0 ) GO TO 100 019205 LINCNT = 1 01930 L = 1 01940 WRITE(5,2000) 019502000 FORMAT('INPUT FILE APPEARS UN-SEQUENCED, LINE COUNT WILL BE USED') 0196000 GO TO 100 0197010 IF( LINCNT .EQ. 0) GO TO 20 01980 LINCNT = LINCNT + 1 01990 L = LINCNT 02000 GO TO 100 0201020 ASSIGN 1000 TO IFM 02020 IF( DECODE( IB,IFM,1,L) .LT. 0) GO TO 50 0203000 IF( L .LT. 0 ) GO TO 50 02040 GO TO 100 0205050 L = LAST + 10 02060100 LAST = L 02070 LINUM = L 02080 RETURN 020901000 FORMAT(75X,I5) 0210000 END 02110 SUBROUTINE GETNUM( N) 02120 INTEGER BUFFER (20) 02130 INTEGER CHAR 02140 CALL BLANK(BUFFER, 20) 02150 CALL WTREAD(5,-1,0,0,-1,BUFFER,5,ITC) 02160 N=0 0217000 DO 10 I=1,5 02180 ICH = CHAR( BUFFER, I ) 02190 IF( ICH .LT. $30 .OR. ICH .GT.$39 ) RETURN 02200 N=N*10+ICH-$30 0221010 CONTINUE 02230 RETURN 02240 END 0225000_ 00 00 00 00 00 00 00 00 00 __ 0( : TTFSQINITLIBRARY P@999999060381(0 SUBROUTINE SQINIT 00010 + /INITIALIZE SQUISH 000202 00030C SQINIT - INITIALIZE FOR DISK SQUISH. 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 000601 0007000C SQINIT PREPARES TO SQUEEZE HOLES OUT OF THE FILE MANAGER AVAILABLE 00080C SPACE ON A 50MB SMD. 00090C 00100C 1. VERIFY RUNNING FROM MASTER CONSOLE 00110C 2. VERIFY ITOS DISABLED 00120C 3. PROMPT FOR MASS MEMORY LOGICAL UNIT NUMBER 00130C 4. VERIFY VALID MMLU FOR THIS SYSTEM 0014000C 5. VERIFY THAT THE VOLUME IS DISMOUNTED 00150C 6. ESTABLISH THE MASS MEMORY PHYSICAL UNIT NUMBER 00160C 7. VERIFY THE SELECTION BY VOLUME NAME ( AS IN THE LABEL SECTOR ) 00170C 8. VERIFY 96 WORDS PER SECTOR 00180C VERIFY AT MOST 86 SECTORS FOR THE AVAILABLE SPACE DIRECTORY 001902 00200 INTEGER MSG1(14), MSG2(10), MSG3(11), MSG4(11), MSG5(18) 0021000 DATA MSG1 / '50MB SMD HOLE COMPRESSOR ' / 00220 DATA MSG2 / 'ENTER MMUNIT NUMBER:' / 00230 DATA MSG3 / 'I T O S NOT DISABLED' / 00240 DATA MSG4 / 'INVALID MMUNIT NUMBER ' / 00250 DATA MSG5 / '???????? DISMOUNT PERMISSION (OK): ' / 00260 INTEGER MSG6(11), MSG7(9), MSG8(18), MSG9(9), MSG10(6) 00270 DATA MSG6 / '???????? VERIFY (OK):' / 0028000 DATA MSG7 / 'NOT MASTER CONSOLE' / 00290 DATA MSG8 / 'TOO MANY FILES FOR PROGRAM STRUCTURE' / 00300 DATA MSG9 / 'ERROR VOLUSE $????' / 00310 DATA MSG10 / 'NON-NUMERIC ' / 00320 INTEGER MSG11(9), MSG12(9), MSG13(8), MSG14(9) 00330 DATA MSG11 / ' VOLUME DISMOUNTED' / 00340 DATA MSG12 / 'SPOOLER IS ENABLED' / 0035000 DATA MSG13 / 'BATCH IS ENABLED' / 00360 DATA MSG14 / 'COMM18 IS ENABLED ' / 00370 INTEGER VITADR, LENSEC, REQBUF(24) 003801 00390 INTEGER MMUNIT 00400 BYTE (MMUNIT,TEMP(3)(14=0)) 004101 0042000 INTEGER VPC 00430$$TXSQUBLK,LIBRARY 00440C QUICK PRESET 004501 00460 LENSEC=96 00470+ ; WORDS PER SECTOR ( EXPECTED ) 00480 LENDSK=86*LENSEC 0049000+ ; SIZE OF MAIN DISK BUFFER 005001 00510C VERIFY RUNNING FROM MASTER CONSOLE 005201 00530 CALL CLRSCR 00540 CALL QUIET(IND) 00550 CALL LMARGN(20) 0056000 CALL DISPLA(MSG1,28) 00570 CALL LMARGN(0) 00580 CALL DISPLA(2H ,2) 00590 CALL DISPLA(2H ,2) 00600 IF ( AND(IND,$0002).EQ.0 ) GOTO 100 00610+ ; IF AT MASTER CONSOLE 00620 CALL DISPLA(MSG7,18) 0063000 CALL DISPLA(2H ,2) 00640 CALL PGMOUT 006501 00660C VERIFY ITOS DISABLED 006701 00680 100 IF ( AND(IND,$0004).EQ.0 ) GOTO 120 00690+ ; IF ITOS DISABLED 0070000 CALL DISPLA(MSG3,22) 00710 CALL DISPLA(2H ,2) 00720 CALL PGMOUT 007301 00740 120 IF ( AND(IND,$0008).EQ.0 ) GOTO 140 00750+ ; IF SPOOLER DISABLED 00760 CALL DISPLA(MSG12,18) 0077000 CALL DISPLA(2H ,2) 00780 CALL PGMOUT 007901 00800 140 IF ( AND(IND,$0010).EQ.0 ) GOTO 160 00810+ ; IF BATCH DISABLED 00820 CALL DISPLA(MSG13,16) 00830 CALL DISPLA(2H ,2) 0084000 CALL PGMOUT 008501 00860 160 IF ( AND(IND,$FFE0).EQ.0 ) GOTO 200 00870+ ; IF COMM18 DISABLED 00880 CALL DISPLA(MSG14,18) 00890 CALL DISPLA(2H ,2) 00900 CALL PGMOUT 00910001 00920C ESTABLISH MASS MEMORY LOGICAL UNIT NUMBER 009301 00940 200 TEMP(1)=2H 00950 CALL PROMPT(MSG2,20,TEMP(1),2,21) 00960 IPFWD=0 00970 TEMP(1)=ICNVRT(TEMP(1),IPFWD,2,IFLAG) 0098000 IF ( IFLAG.LT.0 ) CALL ERROR(MSG10,12,24) 00990 IF ( IFLAG.LT.0 ) GOTO 200 01000 TEMP(2)=MEMORY(MEMORY($00E9)+29) 01010+ ; MMLU TABLE ADDRESS 01020 IF ( (TEMP(1).GE.0) 01030 + .AND.(TEMP(1).LT.MEMORY(TEMP(2))) ) GOTO 300 01040+ ; IF VALID MLU 0105000 CALL ERROR(MSG4,22,24) 01060 GOTO 200 01070+ ; TRY AGAIN 010801 01090C VERIFY VOLUME NOT MOUNTED 011001 01110 300 VITADR=MEMORY(TEMP(2)+TEMP(1)+1) 0112000 TEMP(3)=MEMORY(VITADR) 01130 IDSMT=-1 01140+ ; NO DISMOUNT ATTEMPTED 01150 IF ( TEMP(3).LT.0 ) GOTO 400 01160+ ; IF DISMOUNTED 01170 DO 320 I=1,4 01180+ ; COPY MOUNTED VOLUME NAME 0119000 MSG5(I)=VPC(MEMORY(VITADR+I)) 01200 320 CONTINUE 01210 IANS=2HNO 01220 CALL PROMPT(MSG5,36,IANS,2,36) 01230 CALL DISPLA(2H ,2) 01240 IF ( IANS.NE.2HOK ) CALL PGMOUT 01250 CALL ZERO(REQBUF,24) 0126000 IDSMT=TEMP(1) 01270+ ; INDICATE DISMOUNT ATTEMPTED 01280 CALL VOLUSE(REQBUF,0,IDSMT+1,ISTAT) 01290 IF ( ISTAT.GE.0 ) GOTO 399 01300 CALL HEXASC(ISTAT,MSG9(8)) 01310 CALL DISPLA(MSG9,18) 01320 CALL DISPLA(2H ,2) 0133000 CALL PGMOUT 013401 01350C VERIFY VOLUME SELECTION 013601 01370 399 CALL DISPLA(MSG11,18) 01380 400 MLU=MMUNIT 01390 TEMP(1)=MEMORY(VITADR+21) 0140000+ ; VOLUME LABEL SECTOR ADDRESS 01410 TEMP(2)=MEMORY(VITADR+22) 01420 IFLAG=MMREAD(MLU,LENSEC,TEMP(1),VOLBFR) 01430+ ; VOLUME LABEL SECTOR 01440 DO 420 I=1,4 01450+ ; COPY UP VOLUME NAME 01460 MSG6(I)=VPC(VLNAME(I)) 0147000 420 CONTINUE 01480 440 TEMP(1)=2HNO 01490 CALL PROMPT(MSG6,22,TEMP(1),2,23) 01500 CALL DISPLA(2H ,2) 01510 IF ( TEMP(1).NE.2HOK ) CALL PGMOUT 01520+ ; NOT DESIRABLE 01530 IF ( (VLASDS.LE.86) .AND. (VLWPS.EQ.LENSEC) ) RETURN 0154000 CALL DISPLA(MSG8,36) 01550+ ; SIZE PROBLEMS 01560 CALL DISPLA(2H ,2) 01570 CALL PGMOUT 015801 01590 END 01600_ 00 00 00 00 00 00 __ 0(2 2TFSQUIRMLIBRARY P"999999060381(0 SUBROUTINE SQUIRM 00010 + /REMOUNT DISMOUNTED VOLUME 000202 00030C REMOUN - REMOUNT DISMOUNTED VOLUME 000401 00050C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 000601 0007000C IF SQINIT DISMOUNTED THE VOLUME, THEN REMOUNT IT AND NOTIFY THE 00080C OPERATOR. 000902 00100 INTEGER MSG1(9), MSG2(13), REQBUF(24) 00110 DATA MSG1 / '???????? REMOUNTED' / 00120 DATA MSG2 / 'ERROR VOLUSE $???? REMOUNT' / 00130 DATA REQBUF / 24*0 / 0014000$$TXSQUBLK,LIBRARY 00150 IF ( IDSMT.LT.0 ) RETURN 00160 CALL VOLUSE(REQBUF,VLNAME,IDSMT+1,ISTAT) 00170 CALL DISPLA(2H ,2 ) 00180 IF ( ISTAT.LT.0 ) GOTO 100 00190 CALL MOVECH(VLNAME,1,MSG1,1,8) 00200 CALL DISPLA(MSG1,18) 0021000 RETURN 002201 00230 100 CALL HEXASC(ISTAT,MSG2(8)) 00240 CALL DISPLA(MSG2,26) 00250 CALL DISPLA(2H ,2) 00260 CALL PGMOUT 002701 0028000 END 00290_ 00 00 00 __ 0(2 2TFSQUISHLIBRARY P999999060381(0 PROGRAM SQUISH 00010 + /COMPRESS 50MB SMD FILE MANAGER AREA 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 01/21/80 (CGODSO) 000402 00050C SQUISH - SQUEEZE OUT HOLES. 000601 0007000C SQUISH REMOVES THE HOLES IN THE FILE MANAGER SPACE ON A 50MB SMD. 000801 00090 INTEGER PROVE(4) 00100 DATA PROVE / 'PROVE ' / 001102 00120 CALL SQINIT 00130+ ; VERIFY USABLE MMUNIT & PRESET 0014000 CALL MRKHDR 00150+ ; MARK AFFECTED FILE HEADERS 00160 CALL DHOLE 00170+ ; SQUEEZE OUT INTERNAL HOLES 00180 CALL SQUIRM 00190+ ; REMOUNT VOLUME 00200 CALL CHAIN(PROVE) 00210001 00220 END 00230_ 00 00 00 00 __ 0( TTFSSINITLIBRARY P0999999060381(0 SUBROUTINE SSINIT 00010 + /INITIALIZE WSP 000201 00030C COPYRIGHT CONTROL DATA CORPORATIOION 03/20/80 (CGODSO) 000402 00050C SSINIT - INITIALIZE ROUTINE FOR SSP. 000601 0007000C DETERMINE THE PROCESSING RESTRICTIONS: 00080C 00090C 1. VOLUME TO BE USED 00100C 2. SORT BY 00110C - FILE NAME [ TYPE(3)=-1 ] 00120C - STARTING SECTOR ADDRESS [ TYPE(3)=+1 ] 00130C 3. GROUPED BY OWNER NAME 0014000C - YES [ SUBSRT(3)=+1 ] 00150C - NO [ SUBSRT(3)=-1 ] 00160C 4. RESTRICTED TO A SINGLE OWNER NAME 00170C - YES [ ONEID(3)=+1 ] 00180C *NOTE* THE OWNER NAME IS IN 'USERID'. IF NOT AT THE MASTER 00190C TERMINAL, THEN THE LOGIN USER-ID IS USED. IF AT THE 00200C MASTER TERMINAL, THE THE USER IS PROMPTED FOR THE 0021000C OWNER NAME. 00220C - NO [ ONEID(3)=-1 ] 00230C 00240C THE USER IS PROMPTED TO VERIFY THE RESTRICTIONS BEFORE PROCEDING 00250C TO PRODUCE THE REPORT. 00260$$TXSSPBLK 00270 INTEGER MSG01(13), MSG02(20), MSG03(28), MSG04(17), MSG05(22) 0028000 DATA MSG01 / 'SELECTED FILE STATUS ' / 00290 DATA MSG02 / 'ENTER SELECTED VOLUME NAME : [ ] ' / 00300 DATA MSG03 / 'SORT BY SECTOR ADDRESS OR FILE NAME (ADDR/NAME) ', 00310 + ': [ ]' / 00320 DATA MSG04 / 'GROUPED BY OWNER (YES/NO) : [ ] ' / 00330 DATA MSG05 / 'RESTRICT TO A SINGLE OWNER (YES/NO) : [ ] ' / 00340 INTEGER MSG06(14), MSG07(16), MSG08(21), MSG09(10), MSG10(12) 0035000 DATA MSG06 / ' VOLUME ???????? NOT MOUNTED' / 00360 DATA MSG07 / 'YOU HAVE SELECTED THE FOLLOWING:' / 00370 DATA MSG08 / 'INFORMATION FROM VOLUME ????????, MMUNIT??' / 00380 DATA MSG09 / 'SORTED BY FILE NAME ' / 00390 DATA MSG10 / 'SORTED BY SECTOR ADDRESS' / 00400 INTEGER MSG11(12), MSG12(11), MSG13(5), MSG14(6), MSG15(12) 00410 DATA MSG11 / ' WITHIN OWNER NAME' / 0042000 DATA MSG12 / 'BUT, ONLY FOR ????????' / 00430 DATA MSG13 / ' SELECTION' / 00440 DATA MSG14 / '(CR) => VIEW' / 00450 DATA MSG15 / ' (RESET) => TRY IT AGAIN' / 00460 INTEGER MSG16(17), MSG17(10), FOOL(11), MSG18(16) 00470 DATA MSG16 / 'ENTER SELECTED OWNER : [ ] ' / 00480 DATA MSG17 / '(LINE FEED) => PRINT' / 0049000 DATA FOOL / '???? IS NOT AN OPTION ' / 00500 DATA MSG18 / 'ERROR - ???????? VIWPS IS NOT 96' / 00510 INTEGER MSG19(17) 00520 DATA MSG19 / 'ENTER FILE NAME PATERN [ ] ' / 005301 00540 INTEGER ADDR(2), NAME(2), YES(2), NO(2), DEFVOL(4), DEFPAT(4) 00550 DATA ADDR / 'ADDR' / 0056000 DATA NAME / 'NAME' / 00570 DATA YES / 'YES ' / 00580 DATA NO / 'NO ' / 00590 DATA DEFVOL / 'DEMOFILE' / 00600 DATA DEFPAT / '????????' / 006101 00620 INTEGER PROMPT 00630002 00640C DEFINE SHARED CONSTANTS 006501 00660 PRNTLU=12 00670 FNDD=0 00680 LEFT(1)=4 00690 LEFT(2)=0 0070000 RIGHT(1)=4 00710 RIGHT(2)=1 00720 BUFSIZ=64*96 00730+ ; 1 SMD TRACK 007401 00750 CALL PGMIN(USER,LU,MODE,NOPORT) 00760 CALL CCSMVA(USER,1,8,USERID,1,8) 00770001 00780C ESTABLISH NAME OF VOLUME TO BE USED 007901 00800 100 CALL CLRSCR 00810 CALL LMARGN(12) 00820 CALL DISPLA(MSG01,26) 00830 CALL LMARGN(0) 0084000 CALL DISPLA(2H ,2) 00850 120 CALL CCSMVA(DEFVOL,1,8,VOLUME,1,8) 00860 TC=PROMPT(MSG02,40,VOLUME,8,30) 00870 CALL SEKVIT(VOLUME,VITADR,VOLUME(5)) 00880 IF ( VITADR.NE.0 ) GOTO 140 00890 CALL CCSMVA(VOLUME,1,8,MSG06(5),1,8) 00900 CALL ERROR(MSG06,28,40) 0091000 GOTO 120 009201 00930 140 CALL GETVIT(VOLUME(5),VIT) 00940 IF ( VIT(14).EQ.96 ) GOTO 160 00950 CALL CCSMVA(VOLUME,1,8,MSG18,9,8) 00960 CALL DISPLA(2H ,2) 00970 CALL DISPLA(MSG18,32) 0098000 CALL DISPLA(2H ,2) 00990 CALL PGMOUT 010001 01010C ESTABLISH SORT TYPE ( FILE NAME / STARTING SECTOR ADDRESS ) 010201 01030 160 CALL CCSMVA(NAME,1,4,TYPE,1,4) 01040 TC=PROMPT(MSG03,56,TYPE,4,51) 0105000 IF ( CKSTR(TYPE,ADDR,NAME).NE.0 ) GOTO 200 01060 CALL CCSMVA(TYPE,1,4,FOOL,1,4) 01070 CALL ERROR(FOOL,22,57) 01080 GOTO 160 010901 01100C ESTABLISH OWNER-ID GROUPING 011101 0112000 200 CALL CCSMVA(YES,1,4,SUBSRT,1,4) 01130 IF ( TYPE(3).EQ.+1 ) CALL CCSMVA(NO,1,4,SUBSRT,1,4) 01140 TC=PROMPT(MSG04,34,SUBSRT,3,29) 01150 IF ( CKSTR(SUBSRT,YES,NO).NE.0 ) GOTO 240 01160 CALL CCSMVA(SUBSRT,1,4,FOOL,1,4) 01170 CALL ERROR(FOOL,22,34) 01180 GOTO 200 01190001 01200C ESTABLISH SINGLE OWNER NAME RESTRICTION 012101 01220 240 CALL CCSMVA(YES,1,4,ONEID,1,4) 01230 IF ( TYPE(3).EQ.+1 ) CALL CCSMVA(NO,1,4,ONEID,1,4) 01240 TC=PROMPT(MSG05,44,ONEID,3,39) 01250 IF ( CKSTR(ONEID,YES,NO).NE.0 ) GOTO 260 0126000 CALL CCSMVA(ONEID,1,4,FOOL,1,4) 01270 CALL ERROR(FOOL,22,44) 01280 GOTO 240 012901 01300 260 IF ( NOPORT.NE.00 ) GOTO 300 01310 IF ( ONEID(3).NE.1 ) GOTO 300 013201 0133000 280 CALL CCSMVA(USER,1,8,USERID,1,8) 01340+ ; MASTER TERMINAL GETS TO PICK 01350 TC=PROMPT(MSG16,34,USERID,8,24) 013601 01370 300 USERID(5)=ONEID(3) 01380 310 CALL CCSMVA(DEFPAT,1,8,PATERN,1,8) 01390 TC=PROMPT(MSG19,33,PATERN,8,24) 01400001 01410C DISPLAY THE SELECTIONS TO THE USER AND AWAIT A RESPONSE TO EITHER 01420C ACCEPT THEM AS THEY STAND OR REENTER ALL INFORMATION 014301 01440 CALL DISPLA(2H ,2) 01450 CALL DISPLA(MSG07,32) 01460 CALL CCSMVA(VOLUME,1,8,MSG08(13),1,8) 0147000 MSG08(21)=2H 0+VOLUME(5)-1 01480 CALL DISPLA(2H ,2) 01490 CALL LMARGN(2) 01500 CALL DISPLA(MSG08,42) 01510 IF ( TYPE(3).EQ.1 ) CALL DISPLA(MSG10,24) 01520 IF ( TYPE(3).EQ.-1 ) CALL DISPLA(MSG09,19) 01530 IF ( SUBSRT(3).EQ.1 ) CALL DISPLA(MSG11,24) 0154000 CALL CCSMVA(USERID,1,8,MSG12(8),1,8) 01550 IF ( ONEID(3).EQ.1 ) CALL DISPLA(MSG12,22) 01560 CALL DISPLA(2H ,2) 01570 CALL LMARGN(27) 01580 CALL DISPLA(MSG15,24) 01590 CALL LMARGN(31) 01600 CALL DISPLA(MSG14,12) 0161000 CALL LMARGN(24) 01620 CALL DISPLA(MSG17,20) 01630 MODE=0 01640 FOOL(1)=2H 01650 340 CALL LMARGN(0) 01660 CALL DISPLA(2H ,2) 01670 TC=PROMPT(MSG13,10,FOOL,2,11) 0168000 IF ( TC.EQ.1 ) GOTO 100 01690+ ; RESET => START OVER FROM TOP 01700 IF ( TC.EQ.3 ) GOTO 400 01710+ ; LINE FEED => ACCEPT TO PRINT 01720 IF ( TC.EQ.2 ) GOTO 399 01730+ ; CARRIAGE RETURN => ACCEPT VIEW 01740 GOTO 340 0175000+ ; BUMBLE FINGERS 017601 01770 399 MODE=+7 01780 CALL CLRSCR 01790 RETURN 018001 01810 400 RETURN 01820001 01830 END 01840_ 00 00 __ 0(d d*TFSSP LIBRARY P,999999060381(0 PROGRAM SSP 00010 + /SORTED STATUS PROCESSOR 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 03/20/80 (CGODSO) 000402 00050C SSP - SORTED STATUS PROCESSOR 000601 0007000C GENERATE A STATUS REPORT WITH ENTRIES SORTED BY: 00080C FILENAME/SECTOR ADDRESS 00090C OWNERNAME 00100C ALLOW RESTRICTION TO A SINGLE OWNER NAME. 001102 00120 ASSIGN 9999 TO I 00130 CALL PGMINT(I,0) 0014000+ ; ENABLE CTL-D PROCESSING 001501 00160 CALL SSINIT 00170+ ; GET CONDITIONS FOR PROCESSING 00180 CALL DEFSFL 00190+ ; DEFINE INTERMEDIATE FILE 00200 CALL GTDATA 0021000+ ; LOAD DATA TO FILE 00220 CALL GENRPT 00230+ ; GENERATE THE STATUS REPORT 00240 9999 CALL RETSFL 00250+ ; DELETE THE INTERMEDIATE FILE 002601 00270 CALL PGMOUT 00280001 00290 END 00300_ 00 00 00 00 00 00 00 00 00 00 __ 0(J TFSTAT LIBRARY P999999060381(0 PROGRAM STAT 00010 + /STATUS FILE 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 08/06/80 (CGODSO) 000402 00050C STAT - DISPLAY THE STATUS OF A FILE 000601 0007000C ITOS REQUEST : 00080C 00090C STAT,[,[],[]] 001002 00110$$TXFCBTTL,LIBRARY 00120 INTEGER LINE0(11), MSG01(11), MSG02(17), BLS(12) 00130 DATA LINE0 / $0D0A, 'VOLUME ???????? ', 2*$0D0A / 0014000 DATA MSG01 / $0D0A, '???????? NOT FOUND', $0D0A / 00150 DATA MSG02 / $0D0A, '???????? / ???????? NOT FOUND ', $0D0A / 00160 DATA BLS / 2*$0D0A, 10*$2020 / 00170 INTEGER COMMA, COMMAS(2), SSP(4), FNAME(4), OWNER(4), VOLUME(4) 00180 DATA SSP / 'SSP ' / 00190 DATA FNAME / ' ' / 00200 DATA OWNER / ' ' / 0021000 DATA VOLUME / ' ' / 00220 DATA COMMAS / ',,,,' / 00230 DATA COMMA / $2C / 002401 00250 INTEGER VIT(23), FCBBFR(96) 00260 INTEGER LINE(40), REC(67), ALLVOL 00270 DATA REC(1) / $0D0A / 00280001 00290 INTEGER SCAN, HASH 003002 00310 CALL WTREAD(5,-1,$2018,2,-1,0,0,ITC) 00320 NFND=0 00330+ ; NO FILES FOUND AT THIS TIME 00340 CALL NFETCH( LINE, N ) 0035000 CALL CCSMVA(COMMAS,1,4 ,LINE ,N+1 ,4 ) 00360 N=N+4 003701 00380 I0=1 00390 I1=SCAN( LINE ,COMMA ,I0 ,N ) 00400+ ; SCAN THE PROGRAM NAME 00410 I2=SCAN( LINE ,COMMA ,I1 ,N ) 0042000+ ; SCAN THE FILE NAME 00430 I3=SCAN( LINE ,COMMA ,I2 ,N ) 00440+ ; SCAN THE OWNER NAME 00450 I4=SCAN( LINE ,COMMA ,I3 ,N ) 00460+ ; SCAN THE VOLUME NAME 00470 M=I1-I0-1 00480 IF ( M.GT.8 ) M=8 0049000 IF ( M.LE.0 ) CALL CHAIN( SSP ) 00500+ ; NO FILE NAME SPECIFIED 00510 CALL CCSMVA(LINE,I0+1,M ,FNAME(1) ,1 ,8 ) 00520 M=I2-I1-1 00530 IF ( M.GT.8 ) M=8 00540 IF ( M.GT.0 ) CALL CCSMVA(LINE,I1+1,M ,OWNER(1) ,1 ,8 ) 00550 IF ( M.LE.0 ) CALL PGMIN( OWNER, IDUM, IDUM, IDUM ) 0056000 M=I3-I2-1 00570 IF ( M.GT.8 ) M=8 00580 ALLVOL=0 00590 IF ( M.LE.0 ) GOTO 100 00600 ALLVOL=-1 00610 CALL CCSMVA(LINE,I2+1,M ,VOLUME ,1 ,8 ) 00620 100 CALL GETVOL( ALLVOL, VOLUME, VIT ) 0063000 IF ( VOLUME(1).EQ.0 ) GOTO 200 00640 NFCB=HASH( FNAME, OWNER, VIT , XDUMMY ) 00650 IF ( NFCB.LT.0 ) GOTO 200 00660+ ; FCB NOT FOUND 00670 NFND=1 00680+ ; FOUND A FILE 00690 CALL FETFCB( NFCB, VIT, FCBBFR ) 0070000 IF ( FCBBFR(1).EQ.0 ) GOTO 200 00710 CALL FMTFCB( NFCB, FCBBFR, REC(2) ) 00720 CALL CCSMVA(VOLUME,1,8 ,LINE0 ,10,8 ) 00730 CALL WTREAD(5,-1,LINE0,22,-1,0,0,ITC) 00740 CALL WTREAD(5,-1,LINE1,78,-1,0,0,ITC) 00750 CALL WTREAD(5,-1,$0D0A,2,-1,0,0,ITC) 00760 CALL WTREAD(5,-1,LINE2,78,-1,0,0,ITC) 0077000 CALL WTREAD(5,-1,REC,80,-1,0,0,ITC) 00780 CALL WTREAD(5,-1,BLS,24, -1,0,0,ITC) 00790 CALL WTREAD(5,-1,LINE1(40),54,-1,0,0,ITC) 00800 CALL WTREAD(5,-1,BLS(2),22,-1,0,0,ITC) 00810 CALL WTREAD(5,-1,LINE2(40),54,-1,0,0,ITC) 00820 CALL WTREAD(5,-1,BLS(2),22,-1,0,0,ITC) 00830 CALL WTREAD(5,-1,REC(41),54,-1,0,0,ITC) 0084000 CALL WTREAD(5,-1,BLS,4,-1,0,0,ITC) 008501 00860 200 IF ( ALLVOL.LT.0 ) GOTO 220 00870+ ; CHECKING JUST ONE VOLUME 00880 IF ( ALLVOL.LT.8 ) GOTO 100 00890+ ; LOOK FOR MORE VOLUMES 00900 IF ( NFND.GT.0 ) CALL PGMOUT 0091000 CALL CCSMVA(FNAME,1,8, MSG01, 3, 8 ) 00920 CALL WTREAD(5,-1,MSG01,22,-1,0,0,ITC) 00930 CALL PGMOUT 009401 00950 220 IF ( NFND.GT.0 ) CALL PGMOUT 00960 CALL CCSMVA(FNAME,1,8, MSG02, 3, 8 ) 00970 CALL CCSMVA(OWNER,1,8, MSG02, 14, 8 ) 0098000 CALL WTREAD(5,-1,MSG02,34,-1,0,0,ITC) 00990 CALL PGMOUT 010001 01010 END 01020_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(; TFSUBRCMLIBRARY P999999060381(0 SUBROUTINE SUBRCM(BUFR,RQTYPE,BLEN,RCODE,MASK,DTYPE) 00010 * /DECK-ID A50 ITOS 1.2 SUMMARY-126 00020C ITOS TERMINAL MANAGER 00030C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 00040C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION 1977 00060C 00070003 00080 INTEGER BUFR(1),RQTYPE,BLEN,RCODE,MASK,DTYPE 00090 INTEGER GETCHR 00100 INTEGER ERRBAS 00110* 122*4879 00120 INTEGER CLRLEN,CLEN,RBUF(2) 00130 DATA CLRLEN/0/ 0014000 EXTERNAL DATFMT 00150 INTEGER DLOC(3),MLOC(3) 00160 DATA DLOC/2,1,3/ 00170 DATA MLOC/1,2,2/ 00180* 122*4879 00190 DATA ERRBAS/90/ 00200 INTEGER OLEN 0021000 INTEGER TERMLU 00220 DATA TERMLU/0/ 00230* 122*4879 00240 INTEGER RTYPEC(9),RTYPE 00250 DATA NTYPES/9/ 00260 DATA RTYPEC/1RS,1RT,1RA,1RR,1RP,1RC,1RF,1RN,1RB/ 00270* 122*4879 0028000 INTEGER CPOS,XPOS,YPOS 00290 DATA CPOS/0/ 00300 BYTE(XPOS,CPOS(15=8)),(YPOS,CPOS(7=0)) 00310 INTEGER TC,TCODE(5) 00320 DATA TCODE/1HO,1HN,1HC,1HL,1HR/ 00330 INTEGER RESPCD(3) 00340 DATA RESPCD/1HC,1HE,1HR/ 0035000 INTEGER UCHR(1),LCHR(1) 00360 BYTE(UCHR,BUFR(15=8)),(LCHR,BUFR(7=0)) 00370. 00380* FIND REQUEST TYPE 003901 00400 DO 10 RTYPE=1,NTYPES 00410 IF(EOR(RQTYPE/$100,RTYPEC(RTYPE)).EQ.0) GO TO 20 0042000 10 CONTINUE 004302 00440* ILLEGAL REQUEST TYPE 004501 00460 IERR=1 00470 GO TO 9900 004802 0049000* FOUND THE REQUEST TYPE, VECTOR TO PROCESSOR 005001 00510* 122*4879 00520* S T A R P C F N B 00530 20 GO TO (100,100,300,400,500,600,9990,300,700),RTYPE 00540* 122*4879 00550. 0056000* REQUEST TYPE 'S' - OUTPUT BUFFER. CURSOR AT END +1 00570* REQUEST TYPE 'T' - OUTPUT BUFFER. CURSOR TO X(0) OF NEXT LINE 005801 00590 100 CONTINUE 00600 IF(BLEN.LT.1.OR.BLEN.GT.80) GO TO 9200 00610 CALL WTREAD(TERMLU,CPOS,BUFR,BLEN,0,0,0,0) 00620 XPOS=XPOS+BLEN 0063000 IF(XPOS.LT.80) GO TO 110 00640 XPOS=XPOS-80 00650 YPOS=YPOS+1 00660 IF(YPOS.GE.24) YPOS=0 00670 110 IF(RTYPE.NE.2) RETURN 00680 XPOS=0 00690 YPOS=YPOS+1 0070000 IF(YPOS.GE.24) YPOS=0 00710 RETURN 00720. 00730* REQUEST TYPE 'A' - INPUT BUFFER FROM TERMINAL 007401 00750 300 CONTINUE 00760 IF(BLEN.LT.1.OR.BLEN.GT.80) GO TO 9200 0077000 IFLAG=1 00780 ILEN=BLEN 00790 IF(XPOS+BLEN.LE.80) GO TO 305 00800 IFLAG=2 00810 ILEN=80-XPOS 00820 305 LLOC=((ILEN+1)/2)+1 00830 LSAVE=BUFR(LLOC) 0084000* 122*4879 00850 IF(RTYPE.NE.8) GO TO 308 00860 OLEN=2 00870 ISTART=$8007 00880* 122*4879 00890 GO TO 310 00900 308 OLEN=1 0091000 ISTART=$0700 00920 310 CALL WTREAD(TERMLU,-1,ISTART,OLEN,CPOS,BUFR,ILEN,TC) 00930 JLEN=BUFR(LLOC) 00940 BUFR(LLOC)=LSAVE 00950* 122*4879 00960 IDTYPE=DTYPE+1 00970* DTYPE = 0 1 2 3 0098000 GO TO (328,312,315,320),IDTYPE 00990* ONLY 0 TO 9 ALLOWED 01000 312 DO 313 I=1,JLEN 01010 ICHR=GETCHR(BUFR,I) 01020 IF(ICHR.LT.1R0.OR.ICHR.GT.1R9) GO TO 305 01030 313 CONTINUE 01040 GO TO 328 0105000* FIELD MUST BE NON BLANK 01060 315 DO 316 I=1,JLEN 01070 ICHR=GETCHR(BUFR,I) 01080 IF(ICHR.NE.1R ) GO TO 328 01090 316 CONTINUE 01100 GO TO 305 01110* FIELD MUST BE A VALID DATE 0112000 320 IF(JLEN.NE.6) GO TO 305 01130 DO 321 I=1,6 01140 ICHR=GETCHR(BUFR,I) 01150 IF(ICHR.LT.1R0.OR.ICHR.GT.1R9) GO TO 305 01160 321 CONTINUE 011701 01180 ASSEM $E0E9,$E222,$C206,$6400,+IFMT 0119000C GET DATE FORMAT FROM LOW CORE TABLES ( ENTRY 6 IN GETADD TABLE) 012001 01210 ILOC=MLOC(IFMT+1) 01220 IF(BUFR(ILOC).LT.2H01.OR.BUFR(ILOC).GT.2H12) GO TO 305 01230 ILOC=DLOC(IFMT+1) 01240 IF(BUFR(ILOC).LT.2H01.OR.BUFR(ILOC).GT.2H31) GO TO 305 01250* 122*4879 0126000328 CONTINUE 01270 RCODE = TCODE( 3 ) 01280 IF( TC .EQ. 3 ) RCODE = TCODE( 4 ) 01290 IF( TC .EQ. 4 ) RCODE = TCODE( 5 ) 01300 IF( RCODE .NE. TCODE( 3 ) ) GO TO 340 01310 IF( TC .NE. 8 .OR. DTYPE .NE. 1 ) GO TO 330 01320 IF( JLEN .LE. 0 .OR. JLEN .GT. ILEN ) GO TO 330 0133000 ICHR = GETCHR( BUFR, JLEN ) + $19 01340 IF( ICHR .EQ. $49 ) ICHR = $7D 01350 CALL PUTCHR( ICHR, BUFR, JLEN ) 01360330 IF( ILEN .EQ. JLEN ) RCODE = TCODE( IFLAG ) 01370340 IF( RCODE .EQ. TCODE( 3 ) ) XPOS = 80 - JLEN 01380 XPOS = XPOS + JLEN 01390 IF( XPOS .LT. 80 ) GO TO 350 0140000 XPOS = XPOS - 80 01410 YPOS = YPOS + 1 01420 IF( YPOS .GE. 24 ) YPOS = 0 01430350 CLEN = CLRLEN 01440 IF( CLEN .EQ. 0 ) CLEN = BLEN 01450 IF( JLEN .GE. CLEN ) GO TO 356 01460 ISTART = JLEN + 1 0147000 DO 355 I = ISTART, CLEN 01480 CALL PUTCHR( $20, BUFR, I ) 01490355 CONTINUE 01500356 RETURN 01510. 01520* REQUEST TYPE 'R' - OUTPUT ERROR MESSAGE AND INPUT RESPONSE 015301 0154000 400 CALL WTREAD(TERMLU,CPOS,BUFR,50,-1,RBUF ,1,TC) 01550 RCODE = RBUF( 1 ) 01560 IF( RBUF( 2 ) .LT. 1 ) RCODE = $2000 01570 XPOS=XPOS+50 01580 IF(XPOS.LT.80) GO TO 405 01590 XPOS=XPOS-80 01600 YPOS=YPOS+1 0161000 IF(YPOS.GE.24) YPOS=0 01620405 IF( AND( MASK, $3 ) .EQ. 0 ) GO TO 440 01630410 J = 1 01640 DO 420 I = 1, 3 01650 IF( AND( EOR( RCODE, RESPCD(I) ), $FF00 ) .NE. 0 ) GO TO 420 01660 IF( AND( MASK, J ) .NE. 0 ) GO TO 430 01670420 J = J * 2 0168000 CALL WTREAD( TERMLU, -1, $0708, 2, CPOS, RBUF , 1, TC ) 01690 RCODE = RBUF( 1 ) 01700 IF( RBUF( 2 ) .LE. 0 ) RCODE = $2000 01710 GO TO 410 01720430 IF( I .EQ. 1 ) GO TO 9990 01730440 XPOS = XPOS + 1 01740 IF( XPOS .LT. 80 ) RETURN 0175000 XPOS = XPOS - 80 01760 YPOS = YPOS + 1 01770 IF( YPOS .GE. 24 ) YPOS = 0 01780 RETURN 017902 01800* REQUEST TYPE 'P' - POSITION CURSOR 018101 0182000 500 XPOS=(UCHR(1)-$30)*10+(LCHR(1)-$30) 01830 IF(XPOS.LT.0.OR.XPOS.GT.79) GO TO 9100 01840 YPOS=(UCHR(2)-$30)*10+(LCHR(2)-$30) 01850 IF(YPOS.LT.0.OR.YPOS.GT.23) GO TO 9100 01860 RETURN 018702 01880* REQUEST TYPE 'C' - CLEAR SCREEN 01890001 01900 600 CALL WTREAD(TERMLU,-1,$1800,1,-1,0,0,TC) 01910 CPOS=0 01920 RETURN 01930* 122*4879 019402 01950* REQUEST TYPE 'B' - SET BUFFER CLEAR LENGTH 01960001 01970 700 IF(BLEN.LT.0.OR.BLEN.GT.80) GO TO 9200 01980 CLRLEN=BLEN 01990 RETURN 02000* 122*4879 02010. 02020* ERROR HANDLING SECTION 02030002 02040* INVALID CURSOR POSITION 020501 02060 9100 CONTINUE 02070 IF(XPOS.LT.0) IERR=2 02080 IF(XPOS.GT.79) IERR=3 02090 IF(YPOS.LT.0) IERR=4 0210000 IF(YPOS.GT.23) IERR=5 02110 GO TO 9900 021202 02130* INVALID BUFFER LENGTH 021401 02150 9200 CONTINUE 02160 IERR=6 0217000 IF(BLEN.GT.80) IERR=7 02180 GO TO 9900 021902 02200* OUTPUT ERROR MESSAGE AND TERMINATE 022101 02220 9900 CONTINUE 02230 IERR=IERR+ERRBAS 0224000 CALL SYSMSG(IERR,0) 02250 9990 CALL PGMOUT 02260 END 02270_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( TFTAPEUTLIBRARY P999999060381(0 PROGRAM TAPEUT 00010 INTEGER COMMAN(2),LU,REP,ID(4),L,M,NP,ACTION 00020 INTEGER MSG(8),LMSG 00030 DATA MSG,LMSG/'FUNCTION UNKNOWN', 16/ 00040 INTEGER FUNC(2,8), CODE(8) 00050 DATA FUNC/'ADF ','ADR ','BSF ','BSR ','WEF ','REW ','UNL ','DEN '/ 00060 DATA CODE/ 5, 7, 6, 1, 2, 3, 4, 0 / 00070002 00080 CALL PGMIN( ID, L, M, NP ) 00090 IF( NP .NE. 0 ) CALL PGMOUT 00100 CALL GETCOM( COMMAN, LU, REP ) 00110 DO 10 I = 1,8 00120 IF( MATCH( COMMAN, FUNC(1,I), 2 ) .EQ. 0 ) GO TO 20 00130 10 CONTINUE 0014000 CALL WTREAD(L,-1,MSG,LMSG,-1,0,0,ITC) 00150 CALL PGMOUT 001601 00170 20 IF( CODE( I ) .EQ. 0 ) GO TO 50 001802 00190 ACTION = CODE( I ) * $1000 + REP 00200 ACTION = OR( ACTION, $8000 ) 0021000 CALL MPMOTN( LU, ACTION ) 00220 CALL PGMOUT 002301 00240 50 CALL MPMOTN( LU, REP ) 00250 CALL PGMOUT 002602 00270 END 0028000 SUBROUTINE FETCH( IBUF ) 00290 INTEGER IBUF(40) 00300 LEN = (MEMORY($8000+333)+1)/2 00310 IF( LEN .GT. 40 ) LEN = 40 00320 DO 10 I= 1, LEN 00330 IBUF(I) = MEMORY( I+$8124) 00340 10 CONTINUE 0035000 RETURN 00360 END 00370 SUBROUTINE GETCOM( ICOM, LU, NREP ) 00380 INTEGER BUFFER(40),ICOM(2), TYPE, CLASS, STATE, ACTION 00390 DATA LCOM, LNAME / 4, 8 / 00400 INTEGER ACTTAB(4,5),STATAB(4,5),NAME(4),ID(4),CRT,CHRC,CHAR 00410 DATA ACTTAB / 2,2,1,7, 3,4,1,7, 6,4,1,7, 3,3,1,7, 6,5,6,7 / 0042000 DATA STATAB / 1,1,2,0, 4,3,5,0, 1,3,5,0, 4,4,5,0, 2,5,3,0 / 00430 INTEGER EMSG(20,3),LMSG(3) 00440 DATA EMSG/ 00450 . 'E1 LOGICAL UNIT NUMERIC ONLY ', 00460 . 'E2 REPITITION NUMERIC ONLY ', 00470 . 'E3 TOO MANY COMMAS ' 00480 . / 0049000 DATA LMSG / 30, 28, 20 / 00500 INTEGER BADLU(20),LBADLU 00510 DATA LBADLU,BADLU/ 40, 'INVALID SYSTEM PERIPHERAL NAME '/ 00520 INTEGER LBADCH, BADCH(20) 00530 DATA LBADCH,BADCH/ 40, 'BAD CHARACTER IN INPUT '/ 005403 00550 CALL PGMIN( ID, CRT, MODE, NOPORT ) 0056000 CALL BLANK( BUFFER, 40 ) 00570 CALL FETCH( BUFFER ) 00580 CALL BLANK( ICOM, 2 ) 00590 CALL BLANK( NAME, 4 ) 00600 LU = 0 00610 NREP = 0 00620 NCOM = 0 0063000 NNAME = 0 00640 STATE = 1 00650 IPTR = 0 00660. 00670 1 IPTR = IPTR + 1 00680 CHRC = CHAR( BUFFER, IPTR ) 00690 TYPE = CLASS( CHRC ) 0070000 IF( TYPE .LT.1 .OR. TYPE .GT. 4 ) GO TO 300 00710 ACTION = ACTTAB( TYPE, STATE ) 00720 NXST = STATAB( TYPE, STATE ) 007302 00740 GO TO ( 10, 20, 30, 40, 50, 60, 70 ), ACTION 007502 00760C NULL 0077000 10 GO TO 100 007802 00790C STORE COMMAND CHARACTER 00800 20 IF( NCOM .GE. LCOM ) GO TO 100 00810 NCOM = NCOM + 1 00820 CALL PUTC( CHRC, ICOM, NCOM ) 00830 GO TO 100 00840002 00850C STORE PERIPHERAL NAME CHARACTER 00860 30 IF( NNAME .GE. LNAME ) GO TO 100 00870 NNAME = NNAME + 1 00880 CALL PUTC( CHRC, NAME, NNAME ) 00890 GO TO 100 009002 0091000C CONVERT LU 00920 40 LU = 10 * LU + ( CHRC - $30 ) 00930 GO TO 100 009402 00950C CONVERT REP COUNT 00960 50 NREP = 10 * NREP + ( CHRC - $30 ) 00970 GO TO 100 00980002 00990C PROCESS ERROR -- ERROR CODE IS IN NXST 01000 60 NERR = NXST 01010 CALL WTREAD( CRT, -1, EMSG( 1, NERR ), LMSG( NERR ), -1,0,0,ITC) 01020 CALL ABRT( MODE ) 010302 01040C END 0105000 70 GO TO 200 010602 01070C ESTABLISH SUCCESSOR STATE 01080 100 STATE = NXST 01090 GO TO 1 01100. 01110C TERMINATION CODE 01120002 01130 200 IF( NREP .EQ. 0 ) NREP = 1 01140 IF( NNAME .EQ. 0 ) GO TO 210 01150 CALL LUNEQ( NAME, LU ) 01160 IF( LU .GT. 0 ) GO TO 210 01170 CALL WTREAD( CRT, -1, BADLU, LBADLU, -1,0,0, ITC) 01180 CALL ABRT( MODE ) 01190002 01200 210 IF( LU .EQ. 0 ) LU = 6 01210 RETURN 012202 01230 300 CALL WTREAD( CRT, -1, BADCH, LBADCH, -1,0,0, ITC ) 01240 CALL ABRT( MODE ) 012503 0126000 END 01270 INTEGER FUNCTION CLASS( IC ) 01280 INTEGER COMMA, BLANK 01290 DATA COMMA, BLANK /$2C, $20 / 01300 INTEGER ZERO, NINE, A, Z 01310 DATA ZERO, NINE, A, Z / $30, $39, $41, $5A / 01320 INTEGER ALPHA,DIGIT,SEP,END,OTHER 0133000 DATA ALPHA, DIGIT, SEP, END, OTHER / 1, 2, 3, 4, 5 / 01340 CLASS = OTHER 01350 IF( IC .GE. ZERO .AND. IC .LE. NINE ) CLASS = DIGIT 01360 IF( IC .GE. A .AND. IC .LE. Z ) CLASS = ALPHA 01370 IF( IC .EQ. COMMA ) CLASS = SEP 01380 IF( IC .EQ. BLANK ) CLASS = END 01390 RETURN 0140000 END 01410 SUBROUTINE ABRT( M ) 01420 IF( M .EQ. 0 ) GO TO 10 014302 01440C IF IN PROCEDURE MODE ABORT THE PROCEDURE 01450 ASSEM $E400,+M 01460+ LDQ+ M 0147000 ASSEM $0A01 01480+ ENA 1 01490 ASSEM $6622 01500+ STA- ($2),Q 015102 01520 10 CALL PGMOUT 01530 END 0154000 SUBROUTINE BLANK( IA, N ) 01550 DIMENSION IA(1) 01560 DO 10 I= 1, N 01570 10 IA(I) = $2020 01580 RETURN 01590 END 01600 FUNCTION MATCH( IA, IB, N ) 0161000 DIMENSION IA(1),IB(1) 01620 DO 10 I= 1,N 01630 IF( IA(I)-IB(I) ) 20, 10, 30 01640 10 CONTINUE 01650 MATCH = 0 01660 RETURN 016702 0168000 20 MATCH = -1 01690 RETURN 017002 01710 30 MATCH = 1 01720 RETURN 017302 01740 END 0175000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(, ,}TFTRM LIBRARY P 2999999060381(0 SUBROUTINE TRM 00010 + /CCS 2.0 $$USERID MANAGER DECK12 SUMMARY-*** 000202 00030C TRM - TERMINAL PORT CODE MANAGER. 00040C TRM HAS TWO FUNCTIONS: TRM IS ENTERED ONCE AT INITIALIZATION 00050C TIME TO ACCESS THE FILE $$PORTID AND DEFINE THE VALID 00060C TERMINAL PORT CODES IN THE LIST 'TCODE'; TRM MAY ALSO BE 0007000C ENTERED BECAUSE OF A MENU SELECTION ( 'T' ) TO DISPLAY THE 00080C CURRENTLY VALID TERMINAL PORT CODES AND ALLOW ADDITIONS 00090C AND/OR DELETIONS. 00100C THE INTERNAL FLAG 'ONECAL' IS USED TO DETERMINE WHICH TYPE 00110C OF CALL HAS BEEN MADE. 00120C 00130C THE FILE $$PORTID IS SEQUENTIAL AND CONSISTS OF A SINGLE 0014000C 80 COLUMN ASCII RECORD ( I.E. THE TEXT EDITOR MAY CREATE 00150C AND/OR MODIFY $$PORTID ). THE RECORD IS A CHARACTER MATRIX 00160C IN WHICH A '1' ($31) INDICATES A VALID TERMINAL PORT CODE 00170C AND ANY OTHER CHARACTER ( E.G. A SPACE ) INDICATES AN 00180C INVALID TERMINAL PORT CODE. 00190C SINCE THE TERMINAL PORT CODE '00' IS ALWAYS VALID ( THE 00200C MASTER CONSOLE ), IT IS NOT ENCODED ON THE FILE ( I.E '00' 0021000C CANNOT BE INVALIDATED ). THE COLUMN POSITIONS 01 THROUGH 74 00220C MAP DIRECTLY TO THE TERMINAL PORT CODES 01 THROUGH 74. 002302 00240 INTEGER ONECAL, NEXT, CNVTBF(3), NADDS, NDELS, NRECD 00250 INTEGER TCREQ(24), TCDATA(15), LOOP, LINE(15), TCBUF(40) 00260 INTEGER PMT1(13), PMT2(9), PMT3(5), PMT4(12), PMT5(5), PMT6(9) 00270 INTEGER PMT7(10), PMT8(12), PMT9(12), PMT10(13), PMT11(17) 0028000 INTEGER ADDMSG(9), DELMSG(9), RECMSG(12) 002901 00300 DATA TCREQ / 24*0 / 00310 DATA TCDATA / '$$PORTID', '$$ ', ' ', 0, 1, -1 / 00320 DATA PMT1 / ' CURRENT TERMINAL CODES' / 00330 DATA PMT2 / 'CHANGE PORT CODES?' / 00340 DATA PMT3 / 'TERMINAL: ' / 0035000 DATA PMT4 / ' ENTER ADDITIONS 01-74' / 00360 DATA PMT5 / 'PORT CODE:' / 00370 DATA PMT6 / ' *DIGIT EXPECTED* ' / 00380 DATA PMT7 / ' *00' / 00330 DATA MENU3 / 'C - CHANGE FORCED REQUEST ' / 00340 DATA MENU4 / 'D - DELETE ' / 0035000 DATA MENU5 / 'L - LIST ' / 00360 DATA MENU6 / 'T - MANAGE TERMINAL CODES ' / 00370 DATA MENU7 / 'Z - EXIT' / 00380 DATA MENU8 / ' (*) INDICATES POSSIBLY ALL' / 003901 00400C INITIALIZATION 004101 0042000 ASSIGN 100 TO CNTLD 00430 CALL PGMINT(CNTLD,0) 00440 CALL INIT(LU,LINE1,LINE2) 004501 00460C DISPLAY HEADING AND SELECTION MENU 004701 00480 100 CALL PROMPT(LINE1,-34,0,0) 0049000 CALL PROMPT(LINE2,24,0,0) 00500 CALL PROMPT(2H ,2,0,0) 00510 CALL PROMPT(MENU1,24,0,0) 00520 CALL PROMPT(2H ,2,0,0) 00530 CALL PROMPT(MENU2,28,0,0) 00540 CALL PROMPT(MENU3,44,0,0) 00550 CALL PROMPT(MENU4,23,0,0) 0056000 CALL PROMPT(MENU5,16,0,0) 00570 CALL PROMPT(MENU6,26,0,0) 00580 CALL PROMPT(MENU7,8,0,0) 00590 CALL PROMPT(2H ,2,0,0) 00600 CALL PROMPT(MENU8,30,0,0) 00610 200 CMD(1)=2H 00620 CALL WTREAD(LU,$000F,$1600,1,-1,0,0,TC) 0063000 CALL WTREAD(LU,$010F,PMT,10,$0C0F,CMD,1,TC) 00640 IF ( TC.EQ.4 ) GOTO 200 00650+ ; IGNORE RUBOUT LINES 006601 00670C CHECK FOR VALID REQUESTS TO BE PROCESSED 006801 00690 IF ( CMD(1).EQ.1HA ) GOTO 1000 0070000+ ; ADD 00710 IF ( CMD(1).EQ.1HC ) GOTO 2000 00720+ ; CHANGE FORCED REQUEST 00730 IF ( CMD(1).EQ.1HD ) GOTO 3000 00740+ ; DELETE 00750 IF ( CMD(1).EQ.1HL ) GOTO 4000 00760+ ; LIST USERS 0077000 IF ( CMD(1).EQ.1HT ) GOTO 5000 00780+ ; MANAGE TERMINAL PORT CODES 00790 IF ( CMD(1).EQ.1HZ ) GOTO 6000 00800+ ; EXIT 00810 IF ( CMD(1).EQ.1H? ) GOTO 100 00820 GOTO 200 008301 0084000C PROCESS 'A' SELECTION 008501 00860 1000 CALL ADD 00870 GOTO 100 008801 00890C PROCESS 'C' SELECTION 009001 0091000 2000 CALL CHG 00920 GOTO 100 009301 00940C PROCESS 'D' SELECTION 009501 00960 3000 CALL DEL 00970 GOTO 100 00980001 00990C PROCESS 'L' SELECTION 010001 01010 4000 CALL LST 01020 GOTO 100 010301 01040C PROCESS 'T' SELECTION 01050001 01060 5000 CALL TRM 01070 GOTO 100 010801 01090C PROCESS 'Z' SELECTION 011001 01110 6000 CALL CDS 0112000 CALL PGMOUT 011301 01140 END 01150_ 00 00 00 00 00 __ 0(d d*TFUSRSQULIBRARY Pb999999060381(0 SUBROUTINE SQUISH(FULL) 00010 + /CCS 2.0 $$USERID MANAGER DECK11 SUMMARY-*** 00020C 00030C SQUISH - COMPRESS $$USERID. 00040C 00050C EXIT - 'FULL' IS THE COMPRESSION SUCCESS FLAG: 00060C =0, IF MARKED DELETED SPACE WAS RETURNED; 0007000C =1, IF NO RECORD SPACE WAS GAINED. 00080C 00090C PROCESS FLOW: 00100C - CLOSE $$USERID FILE 00110C - REOPEN $$USERID FILE FOR COMPRESSION ONLY, LOCAL FCB USED 00120C - LOOP ON 'COMFIL' CALLS TO PERFORM COMPRESSION 00130C - CLOSE $$USERID 0014000C - REOPEN $$USERID FOR NORMAL PROCESSING 00150C 00160 INTEGER FULL 00170C 00180 INTEGER FCBBFR(101) 00190$$WSUSRBLK 00200 CALL CLOSFL(REQBLK,ISTAT) 0021000 IF ( ISTAT.LT.0 ) CALL MSG(2) 00220 DO 100 I=1,24 00230 REQBLK(I)=0 00240 100 CONTINUE 00250 IDATA(13)=-1 00260+ ; WILL REOPEN FOR COMPRESSION 00270 IDATA(15)=0 0028000 ASSEM $C000,+FCBBFR 00290+ ; LOCAL FCB PATCHES 00300 ASSEM $6400,+REQBLK(10) 00310 REQBLK(13)=96 00320 CALL OPENFL(REQBLK,IDATA,ISTAT) 00330 IF ( ISTAT.LT.0 ) CALL MSG(1) 00340C 0035000C COMPRESSION LOOP 00360C 00370 200 CALL COMFIL(REQBLK,USER,ISTAT) 00380 IF ( ISTAT.GE.0 ) GOTO 200 00390C 00400 IF ( AND(ISTAT,EOFLAG).NE.EOFLAG ) CALL MSG(8) 00410 FULL=1 0042000+ ; ASSUME STILL FULL 00430 IF ( FCBBFR(7).NE.FCBBFR(12) ) FULL=0 00440 IF ( FCBBFR(8).NE.FCBBFR(13) ) FULL=0 00450 CALL CLOSFL(REQBLK,ISTAT) 00460 IF ( ISTAT.LT.0 ) CALL MSG(2) 00470C 00480C COMPRESSION COMPLETE 0049000C 00500 IDATA(13)=1 00510+ ; WILL REOPEN, NORMAL PROCESSING 00520 IDATA(15)=+1 00530 DO 220 I=1,24 00540 REQBLK(I)=0 00550 220 CONTINUE 0056000 CALL OPENFL(REQBLK,IDATA,ISTAT) 00570 IF ( ISTAT.LT.0 ) CALL MSG(1) 00580 RETURN 00590C 00600 END 00610_ 00 00 00 00 00 00 __ 0(2"P 2TFVALTIDLIBRARY PT999999060381(0 INTEGER FUNCTION VALTID(ID) 00010 + /CCS 2.0 $$USERID MANAGER DECK13 SUMMARY-*** 000202 00030C VALTID - VALIDATE TERMINAL PORT IDENTIFIER. 00040C THE VALID TERMINAL PORT CODES HAVE BEEN STORED IN THE 00050C ARRAY 'TCODE' BY THE ROUTINE 'TRM'. THIS LIST IS 00060C SEARCHED FOR A MATCH TO THE CODE 'ID'. 0007000C 00080C ENTRY - 'ID' THE 2 CHARACTER PORT CODE TO BE VALIDATED 00090C RETURN - =0, IF INVALID 00100C =1, IF VALID 001102 00120 INTEGER ID 001301 0014000 INTEGER MSGVTX(13) 001501 00160 DATA MSGVTX / ' * UNKNOWN TERMINAL CODE *' / 00170$$WSUSRBLK 00180 VALTID=1 00190+ ; ASSUME VALID ID 002001 0021000C SEARCH 'TCODE' FOR A MATCH ON PORT CODE 'ID' 002201 00230 I=1 00240 100 IF ( TCODE(I).EQ.ID ) RETURN 00250 I=I+1 00260 IF ( TCODE(I).NE.0 ) GOTO 100 002701 0028000C TERMINAL PORT CODE WAS NOT FOUND - ISSUE MESSAGE, RETURN INVALID 002901 00300 CALL PROMPT(MSGVTX,26,0,0) 00310 VALTID=0 00320 RETURN 003301 00340 END 0035000_ 00 00 __ 0(d d*TFWATZITLIBRARY P6999999060381(0 PROGRAM WATZIT 00010 INTEGER X(2),C(2),VPC,CLRSCR, FMT(17) 00020 DATA FMT/'(22H AS FLOATING POINT , F9.0 )'/ 00030 DATA CLRSCR/ $2018 / 00040 EQUIVALENCE (X(1),FX) 00050 WRITE(5,1001) CLRSCR 00060 1001 FORMAT( A2,' ENTER IN HEX FORMAT:') 0007000 CALL ZINPUT( X, 2 ) 00080 C(1) = VPC( X(1)) 00090 C(2) = VPC( X(2)) 00100 WRITE(5,1000) X,C,X 00110 AX = FX 00120 IF( AX .LT. 0.0 ) AX = - AX 00130 IF( AX.GT.100000.0 .OR. AX .LT. 0.001 ) GO TO 10 0014000 ND = 1 00150 IF( AX .LT. 10000.00 ) ND = 2 00160 IF( AX .LT. 1000.000 ) ND = 3 00170 IF( AX .LT. 100.0000 ) ND = 4 00180 IF( AX .LT. 10.00000 ) ND = 5 00190 IF( AX .LT. 1.000000 ) ND = 6 00200 FMT(16) = FMT(16)+ND 0021000 WRITE(5,FMT) FX 00220 CALL PGMOUT 00230 10 WRITE(5,1003) FX 00240 CALL PGMOUT 00250 1000 FORMAT(/// ' IN HEX $',Z4,', $',Z4, 00260 . / ' IN ALPHA -',A2,A2,'-', 00270 . / ' AS DECIMAL INTEGERS ',I7,',',I7) 0028000 1002 FORMAT( ' AS FLOATING POINT ',F16.7) 00290 1003 FORMAT( ' AS FLOATING POINT ',E14.7) 00300 END 00310_ 00 00 00 00 00 00 00 00 00 00 __ 0(2 2TFWCMTCHLIBRARY P999999060381(0 INTEGER FUNCTION WCMTCH(PATERN,STRING,LENGTH,WILD) 00010 + /WILD CARD MATCHING 000202 00030C WILD CARD MATCH OF STRING 00040C 00050C PATERN - PATERN TO BE MATCHED INCLUDING MATCH CHARACTERS 00060C STRING - STRING TO BE CHECKED 0007000C LENGTH - NUMBER OF CHARACTERS 00080C WILD - THE UNIVERSAL CHARACTER 000901 00100 INTEGER PATERN, STRING, LENGTH, WILD 001101 00120 WCMTCH=1 00130 IF ( LENGTH.LE.0 ) RETURN 0014000+ ; ALWAYS MATCH FOOLS 00150 WCMTCH=0 00160 DO 100 I=1,LENGTH 00170 CALL CCSGET(PATERN,I,ICH) 00180 IF ( ICH.EQ.WILD ) GOTO 100 00190 CALL CCSGET(STRING,I,JCH) 00200 IF ( ICH.NE.JCH ) RETURN 0021000 100 CONTINUE 00220 WCMTCH=1 00230 RETURN 002401 00250 END 00260_ 00 00 00 00 __ 0(T TFWEAVE LIBRARY P999999060381(0 PROGRAM WEAVE 00010 INTEGER COMLIN(40),NAMOUT(4),COMMA,SPFLAG,TYPE,PNAME(4),PROCNM(4) 00020 INTEGER SCAN,HOST(2) 00030 DATA COMMA/$2C/,PROCNM,COMLIN,PNAME,SPFLAG,HOST/51*$2020/ 00040 IBATCH=0 00050 CALL FETCH(COMLIN) 00060 IBP=0 0007000 LC=SCAN(COMLIN,COMMA,IBP,80) 00080 IF(IBP.GT.80)GOTO 10 00090 IBATCH=1 00100 CALL BUST(COMLIN,HOST,SPFLAG,TYPE,PNAME,MODE) 0011010 CALL WEAVES(IBATCH,NAMOUT) 00120 IF(IBATCH.EQ.0)GOTO 900 00130 CALL BATCH(PROCNM,NAMOUT,HOST,SPFLAG,TYPE,PNAME,MODE) 0014000 CALL CHAIN(PROCNM) 00150900 CALL PGMOUT 00160 END 00170 SUBROUTINE WEAVES(IBATCH,NAM) 00180$$COPYRITE,LIBRARY,CDC,J T MORAN 00190 DIMENSION ID(4), INI(2,10) 00200 INTEGER BUFFER(45),IRQBF(133,10),ORQBF(133),NAMEIN(15),NAMOUT(15) 0021000 INTEGER POUND ,CHAR,REP(5,10),TITLE(24), FLAG80 00220 DATA TITLE /$1820,' W E A V E VERSION &.&& ##/##/## '#& 00230 1 / 00240 DATA POUND / $23 / 00250 DATA NAMEIN/12*0,0,100,-1/ 00260 DATA NAMOUT/12*0,0,100,-1/ 00270 DATA ICLR /$1820 /, FLAG80/'80'/ 0028000 CALL PGMIN(ID,LU,MM,NOP) 00290 CALL WTREAD( 5, -1, TITLE, 48, -1, 0, 0, ITC ) 00300 CALL GETNAM( NAMEIN, NAMOUT, INI(1,1), REP(1,1), IBATCH) 00310 CALL MOVE( ID, NAMOUT(5), 4 ) 00320 CALL OPEN(NAMEIN,IRQBF(1,1)) 00330 CALL OPEN(NAMOUT,ORQBF) 00340 IPTR = 1 0035000 IF(IBATCH.EQ.0)GOTO 1 00360 CALL CLEAR(ORQBF,ISTAT) 003701 CALL REED(BUFFER,IRQBF(1,IPTR),IEOF) 00380 IF( IEOF .EQ. 0 ) GO TO 10 00390 CALL CLOSFL(IRQBF(1,IPTR),ISTAT) 00400 IPTR = IPTR -1 00410 IF( IPTR .LT. 1) GO TO 900 0042000 GO TO 1 0043010 IF( INI( 1, IPTR ) .EQ. FLAG80) GO TO 11 00440 IF( CHAR( BUFFER, 73 ) .EQ. POUND ) 00450 1 CALL DODATE( BUFFER ) 00460 IF( CHAR( BUFFER, 74 ) .NE. $20 .AND. CHAR(REP(1,IPTR),1).NE.$20) 00470 1 CALL DOREPL( BUFFER, CHAR( BUFFER, 74 ), REP( 1, IPTR )) 00480 IF(BUFFER(1) .NE. 2H$$) GO TO 20 0049000 IPTR = IPTR + 1 00500 IF( IPTR .GT. 10 ) GO TO 950 00510 CALL PARSE( BUFFER(2), NAMEIN,INI(1,IPTR),REP(1,IPTR)) 00520 IF(INI(1,IPTR) .EQ. $2020) 00530 1 CALL MOVE ( INI( 1, IPTR-1 ),INI(1, IPTR), 2 ) 00540 CALL VALID( NAMEIN, ID ) 00550 CALL ZERO(NAMEIN(9),4) 0056000 CALL OPEN( NAMEIN,IRQBF(1,IPTR)) 00570 GO TO 1 0058020 IF( INI( 1, IPTR ) .NE. FLAG80 ) 00590 1 CALL MOVECH( INI(1,IPTR),1,BUFFER,73,3) 0060011 CALL WRIT(BUFFER,ORQBF) 00610 GO TO 1 00620900 CALL WRIT( $5F00, ORQBF ) 0063000 CALL CLOSFL(ORQBF,ISTAT) 00640 IF(IBATCH.NE.0)GOTO 910 00650 WRITE(5,1000)(NAMOUT(K9P),K9P=1,4) 006601000 FORMAT('DONE--REMEMBER TO SEQUENCE ',4A2,' BEFORE EDITING') 00670910 CALL MOVECH(NAMOUT,1,NAM,1,8) 00680 RETURN 00690950 WRITE(5,1001)(BUFFER(K9P),K9P=2,5) 00700001001 FORMAT('FILE PYRAMID TO DEEP -- ',4A2) 00710 CALL CLOSFL(ORQBF,ISTAT) 00720 DO 960 I=1,10 00730960 CALL CLOSFL(IRQBF(1,I),ISTAT) 00740 CALL PGMOUT 00750 END 00760 SUBROUTINE OPEN( NAME, IBUF) 0077000 DIMENSION NAME(15),IBUF(133),IT(5) 00780 DATA LVL / 0 / 00790 LVL = LVL + 1 00800 CALL ZERO(IBUF,133) 00810 IBUF(30) = LVL 00820 IBUF(10)=ILOCF(IBUF(33)) 00830 IBUF(13)=96 0084000 CALL OPENFL(IBUF,NAME,ISTAT) 00850 IF(ISTAT.GE.0) GOTO 900 00860 CALL MOVE(NAME,IT,4) 00870 IT(5)=ISTAT 00880 CALL SYSMSG( 331,IT) 00890 CALL PGMOUT 009001 0091000900 RETURN 009201 00930 END 00940 SUBROUTINE GETNAM( N, M, INI, REP , IBATCH) 00950 DIMENSION N(1),M(1),MSG1(6),MSG2(7), INI(2) 00960 DATA MSG1 /'INPUT FILE: '/ 00970 DATA MSG2 /'OUTPUT FILE: '/ 0098000 INTEGER INBUF(40),REP(5),CHAR 00990 CALL BLANK( M, 4 ) 01000 CALL BLANK( N, 4 ) 01010 CALL BLANK( INBUF, 40 ) 0102010 CALL WTREAD( 5, 3, MSG1, 12, -1, INBUF, 68, ITC ) 01030 IF( ITC .EQ. 4 ) GO TO 10 01040 IF( ITC .EQ. 6 ) CALL PGMOUT 010500020 CALL WTREAD( 5, 5, MSG2, 13, -1, M, 8, ITC ) 01060 IF( ITC .EQ. 4 ) GO TO 20 01070 IF((CHAR(M,1) .EQ. $2A)) CALL OUTFIL(M) 01080 IF( ITC .EQ. 6 ) GO TO 20 01090 CALL PARSE( INBUF, N, INI, REP ) 01100 RETURN 01110 END 0112000 SUBROUTINE WRIT( IBUF,IRBUF) 01130 DIMENSION IBUF(45),IRBUF(32) 01140 INTEGER BUFFER(4005) 01150 DATA NL / 0 / 01160 IF( IBUF(1) .EQ. $5F00 ) GO TO 100 01170 NL = NL + 1 01180 IP = NL*40 - 39 0119000 CALL MOVE ( IBUF, BUFFER(IP), 40 ) 01200 IF ( NL .LT. 100 ) RETURN 01210 CALL PUTS ( IRBUF, BUFFER, 100, ISTAT) 01220 GO TO 200 012302 01240 100 IF( NL .EQ. 0 ) RETURN 01250 CALL PUTS ( IRBUF, BUFFER, NL, ISTAT ) 01260002 01270 200 NL = 0 01280 IF(ISTAT .GE. 0) RETURN 01290 WRITE(5,1000)ISTAT 013001000 FORMAT('ERROR IN WRITING FILE - ISTAT=$',Z4) 01310 CALL PGMOUT 01320 END 0133000 SUBROUTINE REED( IBUF,IRBUF,IEOF) 01340 INTEGER BUFFER(4605),RECPTR 01350 DIMENSION IBUF(40),IRBUF(133) 01360 EQUIVALENCE (NOF, IRBUF(30)),(RECPTR, IRBUF(31)),(IREC, IRBUF(32)) 01370 DATA NOFOLD / 0 / 01380 IEOF = 0 01390C 0140000 IF( NOF .GT. NOFOLD ) GO TO 100 01410+ NEW FILE 01420 IF( NOF .EQ. NOFOLD ) GO TO 200 01430+ CURRENT FILE 01440 IF( NOF .LT. NOFOLD ) GO TO 300 01450+ OLD FILE 014602 0147000 100 RECPTR = 1 01480 IREC = 0 01490 GO TO 400 015002 01510 200 IF( IREC .LT. NREC ) GO TO 500 01520 IF( NREC .LT. 100 ) GO TO 900 01530 RECPTR = RECPTR + 100 0154000 IREC = 0 01550 GO TO 400 015602 01570 300 NREC = IRBUF(15) 01580 IF( IREC .LT. NREC ) GO TO 400 01590 RECPTR = RECPTR + 100 01600 IREC = 0 01610002 01620 400 CALL GETRCS (IRBUF, BUFFER, RECPTR, NREC, IEOF ) 01630 IF( IEOF .NE. 0 ) GO TO 950 016402 01650 500 CALL SHPREC( BUFFER, IREC, IBUF, IEOF , IRBUF ) 01660 GO TO 950 016702 0168000 900 IEOF = 1 016901 01700 950 NOFOLD = NOF 01710 RETURN 017202 01730 END 01740 SUBROUTINE GETRCS( IRBUF, BUFFER, RECPTR, NREC, IEOF ) 0175000 DIMENSION IRBUF(133) 01760 INTEGER BUFFER(4005), RECAD(2),RECPTR 01770 DATA RECAD / 0, 0 / 017802 01790 RECAD(2) = RECPTR 01800 CALL READR( IRBUF, BUFFER, RECAD, ISTAT ) 01810 IF( ISTAT .GE. 0 ) GO TO 10 0182000 IF(AND(ISTAT,$100) .EQ. 0 ) GO TO 100 01830 IEOF = 1 01840 RETURN 018502 01860 10 NREC = IRBUF( 15 ) 01870 RETURN 018802 0189000 100 WRITE(5,1000) ISTAT 01900 1000 FORMAT( 'ERROR IN READING FILE -- ISTAT = $',Z4) 01910 CALL PGMOUT 019202 01930 END 01940 SUBROUTINE SHPREC ( BUFFER, IREC, IBUF, IEOF , IRBUF ) 01950 INTEGER BUFFER( 4605 ) 0196000 DIMENSION IBUF(40) , IRBUF(133) 01970 INTEGER REP1(10),REP2(10) 01980 DATA JEOF / $5F00 / 019902 02000 IREC = IREC + 1 02010 IP = IRBUF(38) * IREC - IRBUF(38) + 1 02020 IF( AND( $FF00, BUFFER(IP)) .EQ. JEOF ) GO TO 900 0203000 CALL MOVE( BUFFER(IP), IBUF, 40 ) 02040 RETURN 020502 02060 900 IEOF = 1 02070 RETURN 020802 02090 END 0210000 SUBROUTINE MOVE(I,J,K) 02110 DIMENSION I(1),J(1) 02120 DO 10 IJ=1,K 0213010 J(IJ) = I(IJ) 02140 RETURN 02150 END 02160 SUBROUTINE SET(I,J,K) 0217000 DIMENSION J(1) 02180 DO 10 IJ=1,K 0219010 J(IJ) = I 02200 RETURN 02210 END 02220 SUBROUTINE ZERO(J,K) 02230 CALL SET( 0, J, K ) 0224000 RETURN 02250 END 02260 SUBROUTINE BLANK( J,K) 02270 CALL SET( $2020,J,K) 02280 RETURN 02290 END 02300 SUBROUTINE PARSE( PBUF, NAME, INI, REP ) 0231000 INTEGER PBUF(34), NAME(8), REP(5), RAO, CHAR, INI(2), SCAN 02320 INTEGER COMMA, BLNK 02330 DATA COMMA, BLNK / $2C, $20 / 02340 CALL BLANK( NAME, 4 ) 02350 CALL PGMIN( NAME(5), LU, MM, NOP ) 02360 CALL BLANK ( REP, 5 ) 02370 CALL BLANK( INI, 2 ) 0238000 JP = 0 02390 LC = 0 02400 NC = SCAN( PBUF, COMMA, JP, 68 ) 02410 CALL MOVECH(PBUF, LC+1, NAME, 1, MIN0( NC-LC-1, 8)) 02420 LC = NC 02430 NC = SCAN( PBUF, COMMA, JP, 68 ) 02440 IF( NC .EQ. 0) RETURN 0245000 IF( NC .EQ. LC+1) GO TO 10 02460 CALL BLANK( NAME(5), 4 ) 02470 CALL MOVECH( PBUF, LC+1, NAME, 9, MIN0( NC-LC-1, 8 )) 0248010 LC = NC 02490 NC = SCAN( PBUF, COMMA, JP, 68 ) 02500 IF( NC .EQ. 0) RETURN 02510 CALL MOVECH( PBUF, LC+1, INI, 1, MIN0( NC-LC-1, 3 )) 0252000 IF( LC .GE. 68 ) RETURN 02530 CALL MOVECH( PBUF, NC+1, REP, 1, MIN0( 68-LC, 10 )) 02540 RETURN 02550 END 02560 SUBROUTINE DODATE( BUFFER ) 02570 INTEGER BUFFER( 40 ), ADATE(5), POUND, CHAR 02580 DATA POUND / $23 / 0259000 CALL BLANK( ADATE, 5 ) 02600 CALL DATE ( ADATE ) 02610 CALL DOREPL ( BUFFER, POUND, ADATE ) 02620 RETURN 02630 END 02640 SUBROUTINE DOREPL( I,J,K ) 02650 INTEGER I(36),K(5), CHAR 0266000 INTEGER RAO 02670 INTEGER ATS, BLANK 02680 DATA ATS, BLANK / $40, $20 / 02690 IF( J .NE. ATS ) GO TO 11 02700 DO 10 LEN = 10,1,-1 02710 IF(CHAR(K, LEN).NE.BLANK) GO TO 12 02720 10 CONTINUE 0273000 11 LEN = 10 02740 12 CONTINUE 02750 IP = 0 02760 MP = 0 02770 DO 20 JP=1,72 02780 ICH = CHAR( I, JP ) 02790 IF( ICH .EQ. J ) GO TO 15 0280000 IF( MP .GE. LEN ) MP = 0 02810 GO TO 19 02820 15 IF( MP .GE. LEN ) GO TO 20 02830 ICH = CHAR(K,RAO(MP)) 02840 19 CALL PUTCH( ICH, I, RAO(IP)) 02850 20 CONTINUE 02860 21 IF( IP .GE. 72 ) RETURN 0287000 CALL PUTCH(BLANK,I,RAO(IP)) 02880 GO TO 21 02890 END 02900 SUBROUTINE DATE( D ) 02910 INTEGER D(3) 02920 D(1) = MEMORY(MEMORY(MEMORY($E9)+13)) 02930 D(2) = MEMORY(MEMORY(MEMORY($E9)+14)) 0294000 D(3) = MEMORY(MEMORY(MEMORY($E9)+12)) 02950 RETURN 02960 END 02970 SUBROUTINE VALID( NAME, ID ) 02980 DIMENSION NAME (15 ) , ID(4) 02990 RETURN 03000 END 0301000 INTEGER FUNCTION SCAN( LINE, IC, IP, L ) 03020 INTEGER CHAR, RAO 03030 IF( IP .LE. L ) GO TO 10 03040 IP = 0 03050 GO TO 100 0306010 IF( CHAR(LINE,RAO(IP)) .EQ. IC ) GO TO 100 03070 IF( IP .LT. L ) GO TO 10 0308000 IP = L+1 03090100 SCAN = IP 03100 RETURN 03110 END 03120 FUNCTION MIN0 ( I, J ) 03130 MIN0 = I 03140 IF( J.LT. I ) MIN0 = J 0315000 RETURN 03160 END 03170 SUBROUTINE BATCH(PROC,NAMOUT,HOST,SPFLAG,TYPE,PNAME,MODE) 03180 INTEGER LIN1(42),LIN2(42),LIN3(42),LIN4(42),RQPROC(24),LIN5(42) 03190 INTEGER BLPROC(24),PNAME,PROC,SPFLAG,TYPE,CHAR,HOST(1) 03200 DATA LIN1/'INPUT=@PROC ',35*$2020/, 03210 * LIN2/'UTIL',40*$2020/, 0322000 * LIN3/'BATCH,FN= ,HO= ,AP= ,TY= ,PN= ,M= ', 03230 * 17*$2020 /, LIN4/'EX',41*$2020/, 03240 * BLPROC/'@PROC ','$$ ','SYSVOL ',0,1,-1,9*0/, 03250 * RQPROC/24*0/ 03260 DATA LIN5/'DELETE,FN=',37*$2020/ 03270 CALL PGMIN(BLPROC(5),LU,IMODE,NOPORT) 03280 CALL PUTCH(NOPORT+$40,BLPROC,6) 03290001 CALL OPENFL(RQPROC,BLPROC,ISTAT) 03300 IF(ISTAT.GE.0)GOTO 10 03310 CALL ZERO(RQPROC,24) 03320 BLPROC(13)=80 03330 BLPROC(14)=0 03340 BLPROC(15)=5 03350 CALL CREATE(RQPROC,BLPROC,ISTAT) 0336000 IF(ISTAT.LT.0)GOTO 1000 03370 CALL ZERO(RQPROC,24) 03380 BLPROC(13)=0 03390 BLPROC(14)=1 03400 BLPROC(15)=-1 03410 GOTO 1 0342010 CALL CLEAR(RQPROC,ISTAT) 0343000 CALL PUTCH(NOPORT+$40,LIN1,12) 03440 CALL PUTS(RQPROC,LIN1,1,ISTAT) 03450 CALL PUTS(RQPROC,LIN2,1,ISTAT) 03460 CALL MOVECH(NAMOUT,1,LIN3,10,8) 03470 CALL MOVECH(HOST ,1,LIN3,22,4) 03480 CALL MOVECH(SPFLAG,1,LIN3,30,2) 03490 CALL MOVECH(TYPE ,1,LIN3,36,1) 0350000 CALL MOVECH(PNAME ,1,LIN3,41,6) 03510 CALL MOVECH(MODE ,1,LIN3,50,1) 03520 NUM=80 03530 IF((CHAR(TYPE,1).EQ.$4E).OR.(CHAR(TYPE,1).EQ.$52))NUM=36 03540 CALL MOVECH(LIN3,1,LIN2,1,NUM) 03550 CALL PUTS(RQPROC,LIN2,1,ISTAT) 03560 CALL MOVECH(NAMOUT,1,LIN5,11,8) 0357000 CALL PUTS(RQPROC,LIN5,1,ISTAT) 03580 CALL PUTS(RQPROC,LIN4,1,ISTAT) 03590 CALL CLOSFL(RQPROC,ISTAT) 03600 CALL MOVECH(BLPROC,1,PROC,1,8) 03610 RETURN 036201000 CALL SYSMSG(60,ISTAT) 03630 CALL PGMOUT 0364000 END 03650 SUBROUTINE BUST(COMLIN,HOST,SPFLAG,TYPE,PNAME,MODE) 036601 03670C SURPRISE .. DOCUMENTATION!!!!! 03680C 03690C WEAVE EXECUTION COMMAND TAKES THE FORM OF: 03700C REQUEST=WEAVE **** NON BATCH MODE ***** 0371000C OR REQUEST=WEAVE,HOST,AUTOPRINT,TYPE,PROGNAME,MODE 03720C OR REQUEST=WEAVE,AUTOPRINT,TYPE,PROGNAME,MODE 03730C 03740C ANY OPTIONS MAY BE DEFAULTED -- BY NOT SPECIFYING THEM (,,) 03750C 03760C WHEN USING THE THIRD FORM OF THE WEAVE PROGRAM -- 03770C AUTO PRINT MAY NOT BE DEFAULTED 0378000C 03790C OPTION DEFAULT 03800C HOST LOCL 03810C AUTOPRINT Y1 03820C TYPE N 03830C PROGNAME BLANKS 03840C MODE A 0385000C 03860C WHEN A HOST OTHER THAN LOCL IS USED, ONLY HOST, AUTOPRINT, AND 03870C TYPE ARE USED ON THE BATCH COMMAND. ALL OTHERS ARE LEFT OFF 038803 03890 INTEGER COMMA,PNAME,SPFLAG,TYPE,SCAN,COMLIN,HOST(2),NHOST,Y1HOST 03900 INTEGER LOCL(2),CHAR 03910 DATA COMMA/$2C/,NHOST/'N '/,Y1HOST/'Y1'/ 0392000 DATA LOCL/'LOCL'/ 039303 03940C SET UP DEFAULTS 039501 03960 CALL MOVECH (LOCL,1, HOST,1, 4) 03970 SPFLAG = 2HY1 03980 TYPE=1HN 0399000 CALL BLANK(PNAME,4) 04000 MODE = 1HA 040101 04020 IBP=0 04030 LC=SCAN(COMLIN,COMMA,IBP,80) 040401 04050 NC=SCAN(COMLIN,COMMA,IBP,80) 0406000 IF( NC .EQ. LC+1 ) GOTO 100 04070 IF( CHAR(COMLIN,LC+1) .EQ. $20 ) GOTO 900 04080 CALL CCSMVA(COMLIN,LC+1,MIN0(NC-LC-1,4),HOST,1,4) 04090 IF( (HOST(1) .NE. Y1HOST) .AND. (HOST(1) .NE. NHOST) ) GOTO 90 04100 CALL MOVECH(LOCL,1,HOST,1,4) 04110 GOTO 110 0412090 IF( NC .GT. 80 ) GOTO 900 04130001 04140100 LC=NC 04150 NC=SCAN(COMLIN,COMMA,IBP,80) 04160 IF( NC .EQ. LC+1 ) GOTO 200 04170110 CALL CCSMVA(COMLIN,LC+1,MIN0(NC-LC-1,2),SPFLAG,1,2) 04180 IF( NC .GT. 80 ) GOTO 900 041901 0420000200 LC=NC 04210 NC=SCAN(COMLIN,COMMA,IBP,80) 04220 IF( NC .EQ. LC+1 ) GOTO 300 04230 CALL MOVECH(COMLIN,LC+1,TYPE,1,1) 04240 IF( NC .GT. 80 ) GOTO 900 042501 04260300 LC=NC 0427000 NC=SCAN(COMLIN,COMMA,IBP,80) 04280 IF( NC .EQ. LC+1 ) GOTO 400 04290 CALL MOVECH(COMLIN,LC+1,PNAME,1,MIN0(NC-LC-1,6)) 04300 IF( NC .GT. 80 ) GOTO 900 043101 04320400 LC=NC 04330 NC=SCAN(COMLIN,COMMA,IBP,80) 0434000 IF( NC .EQ. LC+1 ) GOTO 900 04350 CALL MOVECH(COMLIN,LC+1,MODE,1,1) 043602 04370C EXIT 04380900 RETURN 04390 END 04400 SUBROUTINE FETCH(IBUF) 0441000 DIMENSION IBUF(1) 04420 EXTERNAL CHAR 04430 LEN= MEMORY($8000+333) 04440 J=1 04450 DO 10 I=1,LEN 04460 ASSEM $5400,+CHAR,$8125,+I,$6400,+ICH 04470+ ICH=CHAR($8125,I) 0448000 IF( ICH .EQ. $20 ) GOTO 10 04490 CALL PUTCH(ICH,IBUF,J) 04500 J=J+1 0451010 CONTINUE 04520 RETURN 04530 END 04540 SUBROUTINE OUTFIL(NAMOUT) 0455000 INTEGER IBLK(24),RQBUF(24),VOL(4),CHAR 04560 MM = 0 04570 CALL MOVE(NAMOUT,IBLK(1),4) 04580 CALL PGMIN(IBLK(5),IDUM,IDUM,IDUM) 04590 1 CALL GETVOL( IBLK(9),MM) 04600 IF( IBLK(9) .EQ. 0 ) GO TO 800 04610 IBLK(13)=80 0462000 IBLK(14)=0 04630 IBLK(15)=(CHAR(NAMOUT,2)-$30)*1000 04640 CALL DELETE(RQBUF,IBLK,ISTAT) 04650 DO 10 I=16,24 0466010 IBLK(I)=0 04670 CALL CREATE(RQBUF,IBLK,ISTAT) 04680 IF(ISTAT.GE.0)GOTO 900 0469000 IF( ISTAT .EQ. $9000) GO TO 1 04700 800 CALL SYSMSG(343,ISTAT) 04710 CALL PGMOUT 04720900 RETURN 04730 END 04740 SUBROUTINE GETVOL( IBLK, MM ) 04750 INTEGER VIT(25), IBLK(1) 0476000 1 MM = MM +1 04770 CALL GETVIT( MM, VIT ) 04780 IF( VIT(1) .NE. 0 ) GO TO 10 04790 IBLK(1) = 0 04800 RETURN 04810 10 IF(VIT(1) .LT. 0 ) GO TO 1 04820 CALL MOVE( VIT(2) ,IBLK , 4 ) 0483000 RETURN 04840 END 04850_ 00 00 __ 0(d& d*TFZCNVRTLIBRARY P999999060381(0 INTEGER FUNCTION ZCNVRT( ISTR, IPT, MPT, FLAG ) 00010 INTEGER X, L3, R3, R1 00020 BYTE(L3,X(15=4)),(R3,X(11=0)),(R1,X(3=0)) 00030 INTEGER ISTR( 1 ), NXST( 7, 3 ), ACTION( 7, 3 ), TYPE 00040 INTEGER FLAG, ZERO, NINE, BLANK, COMMA, PERIOD, PLSIGN, MNSIGN 00050 INTEGER OTHER, DIGIT, DECPT, PLUS, MINUS, SPACE, TERM, A, F, ADIG 000601 0007000C DATA TABLES 000801 00090 DATA ZERO,NINE,BLANK,COMMA,PERIOD,PLSIGN,MNSIGN, A, F 00100 * / $30, $39, $20, $2C , $2E, $2B, $2D, $41, $46/ 001101 00120 DATA OTHER, DIGIT, ADIG, PLUS, MINUS, SPACE, TERM 00130 * / 7, 2, 5, 3, 4, 1, 6 / 00140001 00150C SPACE DIGIT PLUS MINUS ATOF COMMA OTHER 00160 DATA NXST 00170 * / 1, 2, 2, -2, 2, 0, -1, 00180 * 0, 2, -2, -2, 2, 0, -1, 00190 * 0, 2, -2, -2, 2, 0, -1 / 002001 0021000 DATA ACTION 00220 * / 1, 2, 1, 5, 4, 6, 5, 00230 * 6, 2, 5, 5, 4, 6, 5, 00240 * 6, 2, 5, 5, 4, 6, 5 / 002503 00260C INITIALIZE 00270 FLAG = 0 0028000 X = 0 00290 NEG = 0 00300 CONTINUE 00310 ISTATE = 1 00320 IF( IPT .NE. MPT ) GO TO 1 00330+ CHECK FOR FINAL COMMA 00340 CALL CCSGET(ISTR,IPT,ICH) 0035000 IF( ICH .NE. COMMA ) GO TO 1 00360 IPT = IPT +1 00370 GO TO 200 003802 00390C GET CHARACTER 004001 00410 1 IPT = IPT + 1 0042000 IF( IPT .GT. MPT ) GO TO 200 00430 CALL CCSGET( ISTR, IPT , ICHAR ) 004401 00450C DETERMINE TYPE OF CHARACTER 004601 00470 TYPE = OTHER 00480 IF( ICHAR .GE. ZERO .AND. ICHAR .LE. NINE ) TYPE = DIGIT 0049000 IF( ICHAR .GE. A .AND. ICHAR .LE. F ) TYPE = ADIG 00500 IF( ICHAR .EQ. PLSIGN ) TYPE = PLUS 00510 IF( ICHAR .EQ. MNSIGN ) TYPE = MINUS 00520 IF( ICHAR .EQ. BLANK ) TYPE = SPACE 00530 IF( ICHAR .EQ. COMMA ) TYPE = TERM 005402 00550C GET NEXT STATE, ACTION 00560001 00570 NSTATE = NXST( TYPE, ISTATE ) 00580 IACT = ACTION( TYPE, ISTATE ) 005901 00600 GO TO ( 10,20,30,40,50,60),IACT 006101 00620 10 GO TO 100 0063000+ NULL ACTION 006401 00650 20 L3 = R3 00660 R1 = ICHAR - ZERO 00670+ INTEGER PART 00680 GO TO 100 006901 0070000 30 NEG = 1 00710+ MINUS SIGN 00720 GO TO 100 007301 00740 40 CONTINUE 00750+ CHAR A TO F 00760 L3 = R3 0077000 R1 = ICHAR -A +10 00780 GO TO 100 007901 00800 50 FLAG = NSTATE 00810+ ERROR TERMINATION 00820 GO TO 200 008301 0084000 60 GO TO 200 00850+ NORMAL TERMINATION 008602 00870C SET UP NEXT STATE 00880 100 ISTATE = NSTATE 00890 GO TO 1 009002 0091000 200 IF( NEG .NE. 0 ) X = -X 00920 ZCNVRT = X 00930 RETURN 00940 END 00950_ 00 __ RETURN 00940 END 00950_ 0(  TFZERO LIBRARY P060381(0 SUBROUTINE ZERO(STR,N) 00010 + /ZERO WORDS 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 08/08/80 (CGODSO) 000401 00050 INTEGER STR(1) 000601 0007000C ZERO THE STRING STR FOR THE EXTENT OF N WORDS 000801 00090 IF ( N.LE.0 ) RETURN 00100 DO 100 I=1,N 00110 STR(I)=0 00120 100 CONTINUE 00130 RETURN 00140001 00150 END 00160_ __ RETURN 001400(dQ d*TFZINPUTLIBRARY P999999060381(0 SUBROUTINE ZINPUT ( IX, N ) 00010 DIMENSION IX( 1 ) 00020 INTEGER FLAG, BUFFER(41), MSG1( 26 ), ZCNVRT 00030 DATA MSG1 / $0D0A, 00040 1 'ILLEGAL CHARACTER IN INPUT, RE-TYPE LINE PLEASE ', 00050 2 $0D0A / 00060 DATA LMSG1 / 52 / 00070003 00080 I = 1 00090 1 CALL WTREAD ( 5 , -1, 0, 0, -1, BUFFER, 80, ITC ) 00100 2 IF ( ITC .NE. 4 ) GO TO 10 001101 00120C PROCESS RUBOUT S 001301 0014000 CALL WTREAD ( 5, -1, $0D18, 2, -1, BUFFER, 80, ITC ) 00150 GO TO 2 001602 00170 10 II = I 00180+ ESTABLISH TEMP POINTER 00190 IPT = 0 00200+ SETUP SCAN POINTER 0021000 MPT = BUFFER(41) 00220+ SETUP SCAN LIMIT 002302 00240 20 IX( II ) = ZCNVRT ( BUFFER, IPT, MPT, FLAG ) 00250 IF( FLAG .GE. 0 ) GO TO 25 002601 00270C PROCESS INPUT ERROR 0028000 CALL WTREAD ( 5, -1, MSG1, LMSG1, -1, 0, 0, ITC ) 00290 GO TO 1 003002 00310 25 IF( II .GE. N ) RETURN 00320+ IF DONE, RETURN 003302 00340 II = II + 1 0035000+ BUMP TEMP POINTER 00360 IF( IPT .LE. MPT ) GO TO 20 00370+ CHARACTERS LEFT IN THIS LINE? 003801 00390C NO, GET NEXT LINE 00400 I = II 00410+ UPDATE PERMANENT POINTER 0042000 CALL WTREAD( 5, -1, $0D0A, 2, -1, 0, 0, ITC ) 00430 GO TO 1 004402 00450 END 00460_ 00 00 00 00 00 00 00 00 __ 0(2| 2TMFMUCOMLIBRARY P999999060381(0 MACRO FMUCOM 00010C DECK-ID C01 ITOS 1.2 SUMMARY-126 00020C COMMON MACRO FOR UTILITY FORTRAN PROGRAMS 00030C ************************************************************* 122*4875 00040C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 00050C ************************************************************* 122*4875 00060C THIS IS THE LABELED COMMON AREA FOR THE FILE-MANAGER UTILITY PROGRAMS 0007000C 00080 INTEGER COMCOD,PARNAM,PPHELP,PPINIT,PPDEFI 00090 INTEGER PPSTAT,PPRELO,PPDUMP,PPCOPY,PPDELE 00100 INTEGER PPCLEA,PPLIST,PPRENA,PPCOMM,PPEXIT 00110 INTEGER PPMOUN,PPDISM,PPSAVE,PPBATC,PPLOAD 00120 INTEGER PPPURG,PPINPU,PPOUTP,PPCOMP,DUMMY 00130 INTEGER CODE,SWORD,SBYTE,PARLST,PIND,REQBUF 0014000 INTEGER PARDEF 00150 INTEGER PPHOST,PPSET,PPBATS,PPDISC 00160 INTEGER PPDISP,PPFLUS,PPPRIN 00170 INTEGER FCBHDR,FCBBUF 00180C 00190C ************************************************************* 122*4875 00200 COMMON /AA/COMCOD(133),PARNAM(124) 0021000C ************************************************************* 122*4875 00220 COMMON /AA/PPHELP(2),PPINIT(4),PPDEFI(16) 00230C ************************************************************* 122*4875 00240 COMMON /AA/PPSTAT(4),PPRELO(5),PPDUMP(5) 00250C ************************************************************* 122*4875 00260 COMMON /AA/PPCOPY(6),PPDELE(3),PPCLEA(3) 00270C ************************************************************* 122*4875 0028000 COMMON /AA/PPLIST(6),PPRENA(5),PPCOMM(2) 00290C ************************************************************* 122*4875 00300 COMMON /AA/PPEXIT(1),PPMOUN(3),PPDISM(2) 00310C ************************************************************* 122*4875 00320 COMMON /AA/PPSAVE(3),PPBATC(8),PPLOAD(5) 00330C ************************************************************* 122*4875 00340 COMMON /AA/PPPURG(3),PPINPU(2),PPOUTP(2) 0035000 COMMON /AA/PPCOMP(3) 00360 COMMON /AA/PPHOST(4),PPSET(3),PPBATS(4),PPDISC(2) 00370 COMMON /AA/PPDISP(7),PPFLUS(3),PPPRIN(3) 00380 COMMON /AA/DUMMY(6) 00390 COMMON /AA/INBUF(41),CODE(20) 00400 COMMON /AA/LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST 00410 COMMON /AA/NOCOD,PIND,REQBUF(24) 0042000 COMMON /AA/PARDEF(24) 00430 COMMON /AA/FCBHDR(5),FCBBUF(96) 00440 END 00450_ 00 __ COMMON /AA/FCBHDR(5),FCBBUF(96) 00440 END 00450_ 0(  TPUTMAC LIBRARY P999999060381(0DELETE,FN=XXX,VL=SYSVOL X 00010DEFINE,FN=XXX,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=XX,SA=N X 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=XXX,OW=JTM,V2=SYSVOL X 00030_ 00 00 00 00 __ 0(, }TPUTPROCLIBRARY P999999060381(0 * INSTALL TAPE UTILITIES 00010INPUT=TPUTPROC 00020UTIL 00030DELETE,FN=BSR,VL=SYSVOL 00010DEFINE,FN=BSR,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=BSR,OW=JTM,V2=SYSVOL 00030DELETE,FN=WEF,VL=SYSVOL 0001000DEFINE,FN=WEF,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=WEF,OW=JTM,V2=SYSVOL 00030DELETE,FN=REW,VL=SYSVOL 00010DEFINE,FN=REW,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=REW,OW=JTM,V2=SYSVOL 00030DELETE,FN=UNL,VL=SYSVOL 00010DEFINE,FN=UNL,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 0002000COPY,FN=TAPEUT,VL=SYSVOL,F2=UNL,OW=JTM,V2=SYSVOL 00030DELETE,FN=ADF,VL=SYSVOL 00010DEFINE,FN=ADF,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=ADF,OW=JTM,V2=SYSVOL 00030DELETE,FN=BSF,VL=SYSVOL 00010DEFINE,FN=BSF,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=BSF,OW=JTM,V2=SYSVOL 0003000DELETE,FN=ADR,VL=SYSVOL 00010DEFINE,FN=ADR,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=ADR,OW=JTM,V2=SYSVOL 00030DELETE,FN=DEN,VL=SYSVOL 00010DEFINE,FN=DEN,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=DEN,OW=JTM,V2=SYSVOL 00030EXIT 0012000 * TAPE UTILITIES INSTALLED 00130__NE,FN=ADR,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=ADR,OW=JTM,V2=SYSVOL 00030DELETE,FN=DEN,VL=SYSVOL 00010DEFINE,FN=DEN,VL=SYSVOL,ED=999999,TY=B,LR=192,NR=19,SA=N 00020COPY,FN=TAPEUT,VL=SYSVOL,F2=DEN,OW=JTM,V2=SYSVOL 00030EXIT 001200( xm TXBIN LIBRARY PZ999999060381(0*K,L2 ?????? (TXBIN - LIBRARY) ? 00010*OPEN,FN=BN??????,OW=LIBRARY,R,LU=19 ? 00020*LIBEDT 00030*T,19,B,11,B,,1 00040*Z 00050*CLOSE 00060*BSR,11,1 0007000*K,L12 00080_ __9,B,11,B,,1 00040*Z 00050*CLOSE 00060*BSR,11,1 000700( iTXDMPFCBLIBRARY P999999060381(02 00010 INTEGER LINE01(40), LINE02(40), LINE03(40), LINE04(40) 00020 DATA 00030 + LINE01 / 'RECLEN - RECORD LENGTH IN WORDS ' , 00040 + ' ????? $???? ( 1) '/, 00050 + LINE02 / 'TDATR* - MAXIMUM NUMBER OF RECORDS ' , 00060 + ' ???????? $????,???? ( 2, 3) '/ 0007000 DATA 00080 + LINE03 / 'DATBA* - SECTOR ADDRESS OF FIRST RECORD ' , 00090 + ' $????,???? ( 4, 5) '/, 00100 + LINE04 / 'FCBIND - FCB INDICATORS ( JUNK' , 00110 + ' $???? ) $???? ( 6) '/ 00120 INTEGER LINE05(40), LINE06(40), LINE07(40), LINE08(40) 00130 DATA 0014000 + LINE05 / ' BIT 15 RECORD ALIGNMENT INDICA' , 00150 + 'TOR ? > ??? '/, 00160 + LINE06 / ' BIT 14 STORAGE MODE FOR INDEXE', 00170 + 'D FILE ? > ??????? '/ 00180 DATA 00190 + LINE07 / ' BIT 13 OPEN/CLOSED INDICATOR ' , 00200 + ' ? > ?????? '/, 0021000 + LINE08 / ' BIT 12 FILE COMPRESSION INDICA' , 00220 + 'TOR ? > ??? '/ 00230 INTEGER LINE09(40), LINE10(40), LINE11(40), LINE12(40) 00240 DATA 00250 + LINE09 / ' BIT 11 SPECIAL PROCESSING INDI' , 00260 + 'CATOR ? > ??? '/, 00270 + LINE10 / ' BIT 8 BINARY DATA INDICATOR ' , 0028000 + ' ? > ?????? '/ 00290 DATA 00300 + LINE11 / ' BIT 0 FILE TYPE ' , 00310 + ' ? > ?????????? '/, 00320 + LINE12 / 'NEDAT* - # EXISTING RECORDS ' , 00330 + ' ???????? $????,???? ( 7, 8) '/ 00340 INTEGER LINE13(40), LINE14(40), LINE15(40), LINE16(40) 0035000 DATA 00360 + LINE13 / 'LINKF* - NEXT FREE INDEX BLOCK ' , 00370 + ' ???????? $????,???? ( 9, 10) '/, 00380 + LINE14 / 'TNKEY* - TOTAL # KEY INDEX BLOCKS ' , 00390 + ' ???????? $????,???? (11, 12) '/ 00400 DATA 00410 + LINE15 / 'KEYBA* - KEY INDEX SECTOR ADDRESS ' , 0042000 + ' $??,???? (13, 14) '/, 00430 + LINE16 / ' LENKYI ????? ?????' , 00440 + ' ????? ????? (15, 17, 19, 21)'/ 00450 INTEGER LINE17(40), LINE18(40), LINE19(40), LINE20(40) 00460 DATA 00470 + LINE17 / ' POSKYI ????? ?????' , 00480 + ' ????? ????? (16, 18, 20, 22)'/, 0049000 + LINE18 / 'TSFIL* - TOTAL SECTORS ALLOCATED ' , 00500 + ' ???????? $????,???? (23, 24) '/ 00510 DATA 00520 + LINE19 / 'NAMEXX - FILE NAME ????????' , 00530 + ' ???? ???? ???? ???? (25, 26, 27, 28)'/, 00540 + LINE20 / 'OWNRXX - OWNER NAME ????????' , 00550 + ' ???? ???? ???? ???? (29, 30, 31, 32)'/ 0056000 INTEGER LINE21(40), LINE22(40), LINE23(40), LINE24(40) 00570 DATA 00580 + LINE21 / 'BYTLEN - RECORD LENGTH IN BYTES ' , 00590 + ' ????? $???? (33) '/, 00600 + LINE22 / 'PRSRN* - REL. RECORD # LAST PROCESSED ' , 00610 + ' ???????? $????,???? (34, 35) '/ 00620 DATA 0063000 + LINE23 / 'NEWRN* - REL. RECORD # LAST COMPRESSED ' , 00640 + ' ???????? $????,???? (36, 37) '/, 00650 + LINE24 / ' PAUSE ' , 00660 + ' '/ 00670 INTEGER LINE25(40), LINE26(40), LINE27(40), LINE28(40) 00680 DATA 00690 + LINE25 / 'UNUSED ' , 0070000 + ' '/, 00710 + LINE26 / '???? ???? ???? ???? ???? ???? ???? ???? ' , 00720 + ' ???????????????? (?? > ??) '/ 00730 DATA 00740 + LINE27 / ' FIRST RECORD OF RPG ARRAY DATA ' , 00750 + ' ????? $???? (86) '/, 00760 + LINE28 / ' TEXT EDITOR FILE TYPE ' , 0077000 + ' ????? $???? (87) '/ 00780 INTEGER LINE29(40), LINE30(40), LINE31(40), LINE32(40) 00790 DATA 00800 + LINE29 / ' MAX. RECORD COUNT OF DIRECT FIL' , 00810 + 'E ????? $???? (88) '/, 00820 + LINE30 / ' EXPIRATION DATE ?' , 00830 + '????? ???? ???? ???? (89, 90, 91) '/ 0084000 DATA 00850 + LINE31 / ' CREATION DATE ?' , 00860 + '????? ???? ???? ???? (92, 93, 94) '/, 00870 + LINE32 / ' FILE USAGE ????? ' , 00880 + '$???? ?????????????? (95) '/ 00890 INTEGER LINE33(40), LINE34(40) 00900 DATA 0091000 + LINE33 / ' FILE TO BE SORTED FLAG ????? ' , 00920 + '$???? ??? (96) '/, 00930 + LINE34 / ' 1 2' , 00940 + ' 3 4 '/ 009502 00960_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(  TXFCBTTLLIBRARY P999999060381(0 INTEGER LINE1(66), LINE2(66) 00010 DATA LINE1 / 'FILENAME OWNER FILE RECORD RECORD MAX. S', 00020 + 'TAT FCB START SECTOR FCBIND CREATE EXP', 00030 + 'IRE K1 K2 K3 K4 ' / 00040 DATA LINE2 / ' TYPE LENGTH COUNT RECORD A', 00050 + 'LGN INDEX SECTOR COUNT DATE DA', 00060 + 'TE LEN POS LEN POS LEN POS LEN POS ' / 0007000_ __ + 'IRE K1 K2 K3 K4 ' / 00040 DATA LINE2 / ' TYPE LENGTH COUNT RECORD A', 00050 + 'LGN INDEX SECTOR COUNT DATE DA', 00060 + 'TE LEN POS LEN POS LEN POS LEN POS ' / 000700(  TXFTNJOBLIBRARY P2999999060381(0*JOB,,, 00010*K,I13,P11,L12 00020*REW,11 00030*FTN 00040 OPT P?????????? ? 00050_ 00 00 __ 0(  TXINSTALLIBRARY PP999999060381(0*K,I13,P2,L9 (TXINSTAL - LIBRARY ) ?????????? ? 00010*REW,11 00020*LIBEDT 00030*K,I11,P8 00040*P,F,3 00050*K,I8 00060*J,?????????? ? 0007000*Z 00080_ __11,P8 00040*P,F,3 00050*K,I8 00060*J,?????????? ? 000700(  TXJOB LIBRARY P999999060381(0*JOB,,,?????????? ? 00010*K,I13,P11,L12 00020*REW,11 00030_ 00 __ 0(  TXLSTBLKLIBRARY P(999999060381(01 00010 INTEGER BUFFER(1100), FCB(96), ILN 00020 COMMON / LSTBLK / BUFFER, FCB, ILN 000301 00040_ 00 __ 00040_ 0(2 2TXPRVBLKLIBRARY P|999999060381(02 00010 INTEGER FIAT(288), VOL(96), HDR(96) 00020 INTEGER ASDBFR(8256), ASD(4,2064), LASD 00030 EQUIVALENCE (ASD ,ASDBFR) 00040 INTEGER FCBBFR(6144), FCB(96,64) 00050 EQUIVALENCE (FCB ,FCBBFR) 000601 0007000 INTEGER VLASD(2), VLASDS, VLLBA(2), VLWPS 00080 EQUIVALENCE (VLASD ,VOL(23)) 00090 EQUIVALENCE (VLASDS,VOL(25)) 00100 EQUIVALENCE (VLLBA ,VOL(21)) 00110 EQUIVALENCE (VLWPS ,VOL(28)) 00120 INTEGER VLFDD(2), VLMAXF, VLCURF, VLNFDB 00130 EQUIVALENCE (VLFDD ,VOL(29)) 0014000 EQUIVALENCE (VLMAXF,VOL(31)) 00150 EQUIVALENCE (VLCURF,VOL(32)) 00160 EQUIVALENCE (VLNFDB,VOL(33)) 001701 00180 INTEGER DATBA, FTYPE, KEYBA, TSFIL, OWNR, RECLEN 001901 00200 INTEGER AL, FSIZE(2), FADDR(2), FOWNR(4) 0021000 EQUIVALENCE (AL ,HDR(1)) 00220 EQUIVALENCE (FSIZE ,HDR(2)) 00230 EQUIVALENCE (FADDR ,HDR(4)) 00240 EQUIVALENCE (FOWNR ,HDR(10)) 002501 00260 INTEGER LU, TC, MMU, FCBADR(2), FWAFIL(2), LWAFIL(2), SIZFIL(2) 00270 INTEGER ONE2(2) 0028000 DATA ONE2 / 0,1 / 002901 00300 INTEGER NFDB, FDDBIT(288), ALCFDV(256) 003102 00320 COMMON / PRVBLK / FIAT, VOL, HDR, ASDBFR, LASD, FCBBFR 00330 COMMON / PRVBLK / LU, TC, MMU, FCBADR, FWAFIL, LWAFIL, SIZFIL 00340 COMMON / PRVBLK / ONE2, NFDB, FDDBIT 0035000 COMMON / PRVBLK / DATBA, FTYPE, KEYBA, TSFIL, OWNR, RECLEN 00360 COMMON / PRVBLK / ALCFDV 003702 00380_ 00 00 __ 0(2 2TXSQUBLKLIBRARY P999999060381(02 00010 INTEGER CNT, IFLAG, LENDSK, MLU, TC, TEMP(8), IDSMT 00020 INTEGER FCBBFR(96), HDRBFR(96), VOLBFR(96), DSKBFR(8256) 00030+ ; 86*96 000401 00050 COMMON / SQUBLK / CNT, IFLAG, LENDSK, MLU, TC, TEMP, IDSMT 00060 COMMON / SQUBLK / FCBBFR, HDRBFR, VOLBFR, DSKBFR 00070002 00080 INTEGER VLNAME(4), VLASD(2), VLASDS, VLWPS 00090 INTEGER VLFDD(2), VLMAXF, VLNFDB 001001 00110 EQUIVALENCE (VLNAME,VOLBFR(3)) 00120+ ; VOLUME NAME 00130 EQUIVALENCE (VLASD ,VOLBFR(23)) 0014000+ ; SECTOR ADDRESS OF ASD 00150 EQUIVALENCE (VLASDS,VOLBFR(25)) 00160+ ; NUMBER OF SECTORS IN ASD 00170 EQUIVALENCE (VLWPS ,VOLBFR(28)) 00180+ ; NUMBER OF WORD PER SECTOR 00190 EQUIVALENCE (VLFDD ,VOLBFR(29)) 00200+ ; SECTOR ADDRESS OF FDD 0021000 EQUIVALENCE (VLMAXF,VOLBFR(31)) 00220+ ; MAXIMUM NUMBER OF FILES PERMIT 00230 EQUIVALENCE (VLNFDB,VOLBFR(33)) 00240+ ; NUMBER OF BLOCKS IN FDD 002501 00260 INTEGER FCBLOC(2), FCBINX 00270 EQUIVALENCE (FCBLOC,HDRBFR(14)) 0028000+ ; MARKER - FCB SECTOR ADDRESS 00290 EQUIVALENCE (FCBINX,HDRBFR(16)) 00300+ ; MARKER - FCB INDEX 003101 00320 INTEGER RECLEN, KEYBA(2), FCBTSF(2), FCBNAM(4), FCBOWN(4) 00330 EQUIVALENCE (RECLEN,FCBBFR(1)) 00340+ ; RECORD LENGTH IN WORDS 0035000 EQUIVALENCE (KEYBA ,FCBBFR(13)) 00360+ ; KEY INDEX SECTOR ADDRESS 00370 EQUIVALENCE (FCBTSF,FCBBFR(23)) 00380+ ; TOTAL SECTORS ALLOCATED 00390 EQUIVALENCE (FCBNAM,FCBBFR(25)) 00400+ ; FILE NAME 00410 EQUIVALENCE (FCBOWN,FCBBFR(29)) 0042000+ ; OWNER NAME 004302 00440_ 00 __ 00440_ 0(2 2TXSSPBLKLIBRARY P999999060381(02 00010 INTEGER USER(4), VOLUME(5), TYPE(3), SUBSRT(3), ONEID(3) 00020 INTEGER USERID(5), VIT(23), VITADR, PATERN(4) 00030 INTEGER LU, TC, MODE, NOPORT, PRNTLU, LEFT(2), RIGHT(2) 00040 INTEGER REQBUF(24), IDATA(24), ISTAT, MAXFIL, FILCNT 00050 INTEGER FCBBFR(96), REC0, REC(76), REC99(2), FNDD 00060 INTEGER LENGTH(3), CMPLT, IFLAG, BUFSIZ, DSKBFR(6144), NFCB 00070001 00080 COMMON / SSPBLK / USER, VOLUME, TYPE, SUBSRT, ONEID 00090 COMMON / SSPBLK / USERID, VIT, VITADR, PATERN 00100 COMMON / SSPBLK / LU, TC, MODE, NOPORT, PRNTLU, LEFT, RIGHT 00110 COMMON / SSPBLK / REQBUF, IDATA, ISTAT, MAXFIL, FILCNT 00120 COMMON / SSPBLK / FCBBFR, REC0, REC, REC99, FNDD 00130 COMMON / SSPBLK / LENGTH, CMPLT, IFLAG, BUFSIZ, DSKBFR, NFCB 00140001 00150 INTEGER CKSTR, CKVIT 001602 00170_ 00 00 00 00 00 __ 0(  WABIN LIBRARY Pd999999060381(0*JOB,,,WABIN 00010*K,I13,P19,L12 00020*OPEN,FN=BN??????,OW=LIBRARY,W,LU=19 ? 00030*ASSEM 00040 OPT PCL 00050$$TA?????????? ? 00060 MON 0007000*EOF 00080*CLOSE,19 00090*Z 00100_ 00 __ 0(  WASKEL LIBRARY PF999999060381(0*JOB,,,WASKEL 00010*K,I13,L12,P2 00020*ASSEM 00030 OPT XLC 00040$$TA?????????? ? 00050 MON 00060*Z 0007000_ __ XLC 00040$$TA?????????? ? 00050 MON 00060*Z 000700(  WFBIN LIBRARY Pn999999060381(0*JOB,,,WFBIN 00010*K,I13,P19,L12 00020*OPEN,FN=BN??????,OW=LIBRARY,W,LU=19 ? 00030*FTN 00040 OPT PCL 00050$$TF?????????? ? 00060 MON 0007000*EOF 00080*CLOSE 00090*Z 00100_ 00 __ 0(  WFSKEL LIBRARY PF999999060381(0*JOB,,,WFSKEL 00010*K,I13,L12,P2 00020*FTN 00030 OPT LC 00040$$TF?????????? ? 00050 MON 00060*Z 0007000_ __ LC 00040$$TF?????????? ? 00050 MON 00060*Z 000700(  WSBATS LIBRARY PP999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFBATS,LIBRARY 00020 MON 00030$$TXBIN,LIBRARY,,HEXDEC 00040$$TXBIN,LIBRARY,,LASTCH 00050$$TXINSTAL,LIBRARY,,BATS,$$ 00060*Z 0007000_ 00 __ 0(  WSBATSUMLIBRARY P2999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFBATSUM,LIBRARY 00020 MON 00030$$TXINSTAL,LIBRARY,,BATSUM,$$ 00040*Z 00050_ 00 00 __ 0(2 2WSCATAPELIBRARY P999999060381(0*JOB,LIBRARY,,CATAPE 00010*K,I13,P11,L12 00020*REW,11 00030*FTN 00040 OPT P???? ? 00050$$TFCATAPE,LIBRARY 00060$$TFFMTFCB,LIBRARY 0007000 MON 00080$$TXBIN,LIBRARY,,CHO2LR 00090$$TXBIN,LIBRARY,,CNV2W 00100$$TXBIN,LIBRARY,,CONVER 00110$$TXBIN,LIBRARY,,FDWMTH 00120$$TXBIN,LIBRARY,,FRHX 00130$$TXBIN,LIBRARY,,HEXDEC 0014000$$TXBIN,LIBRARY,,NDWMTH 00150$$TXBIN,LIBRARY,,REPL 00160$$TXBIN,LIBRARY,,VLTOI 00170$$TXBIN,LIBRARY,,VPC 00180$$TXBIN,LIBRARY,,WTRD 00190$$TXINSTAL,LIBRARY,,CATAPE,$$ 00200*Z 0021000_ 00 00 00 00 __ 0(2. 2WSCHEAT LIBRARY P999999060381(0*JOB,LIBRARY,,WSCHEAT 00010*K,I13,P11,L12 00020*REW,11 00030*FTN 00040 OPT P???????? ? 00050$$TFCHEAT,LIBRARY 00060 MON 0007000$$TXBIN,LIBRARY,,CNVSTR 00080$$TXBIN,LIBRARY,,ASCII 00090$$TXBIN,LIBRARY,,BLANK 00100$$TXBIN,LIBRARY,,HEXASC 00110$$TXBIN,LIBRARY,,MMREAD 00120$$TXBIN,LIBRARY,,FDWMTH 00130$$TXBIN,LIBRARY,,NDWMTH 0014000$$TXBIN,LIBRARY,,VDC 00150$$TXINSTAL,LIBRARY,,CHEAT,$$ 00160*Z 00170_ 00 00 00 00 00 __ 0(D  WSDEFILELIBRARY PF999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFDEFILE,LIBRARY 00020$$TFFILLIT,LIBRARY 00030 MON 00040$$TXBIN,LIBRARY,,GTPARM 00050$$TXBIN,LIBRARY,,HEXASC 00060$$TXINSTAL,LIBRARY,,DEFILE,$$ 0007000*Z 00080_ 00 __ 0(N  WSDELFILLIBRARY P<999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFDELFIL,LIBRARY 00020 MON 00030$$TXBIN,LIBRARY,,GTPARM 00040$$TXBIN,LIBRARY,,HEXASC 00050$$TXINSTAL,LIBRARY,,DELFIL,$$ 00060*Z 0007000_ 00 __ 0(2X 2WSDMPFCBLIBRARY P999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFDMPFCB,LIBRARY 00020$$TFDFINIT,LIBRARY 00030 MON 00040$$TXBIN,LIBRARY,,BLKSIO 00050$$TXBIN,LIBRARY,,CHO2LR 00060$$TXBIN,LIBRARY,,CNV2W 0007000$$TXBIN,LIBRARY,,CONVER 00080$$TXBIN,LIBRARY,,HASH 00090$$TXBIN,LIBRARY,,HEXASC 00100$$TXBIN,LIBRARY,,HEXDEC 00110$$TXBIN,LIBRARY,,LASTCH 00120$$TXBIN,LIBRARY,,SEKVIT 00130$$TXINSTAL,LIBRARY,,DMPFCB,$$ 0014000*Z 00150_ 00 00 00 00 00 __ 0(n  WSEXTENDLIBRARY PZ999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFEXTEND,LIBRARY 00020$$TFFILLIT,LIBRARY 00030$$TMFMUCOM,LIBRARY 00040$$TFCOPY,LIBRARY 00050 MON 00060$$TXBIN,LIBRARY,,GTPARM 0007000$$TXBIN,LIBRARY,,HEXASC 00080$$TXINSTAL,LIBRARY,,EXTEND,$$ 00090*Z 00100_ 00 __ 0(x  WSFCBADRLIBRARY P999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFFCBADR,LIBRARY 00020$$TFGETVOL,LIBRARY 00030 MON 00040$$TXBIN,LIBRARY,,FRHX 00050$$TXBIN,LIBRARY,,HASH 00060$$TXBIN,LIBRARY,,HEXASC 0007000$$TXBIN,LIBRARY,,SEKVIT 00080$$TXINSTAL,LIBRARY,,FCBADR,$$ 00090*Z 00100_ 00 __ 0(( (WSLIST LIBRARY P999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFLIST ,LIBRARY 00020$$TFLSTBIN,LIBRARY 00030$$TFLSTBAS,LIBRARY 00040$$TFLSTMIO,LIBRARY 00050$$TFLSTSIO,LIBRARY 00060$$TFLSTAPE,LIBRARY 0007000$$TFLUREAD,LIBRARY 00080$$TFMTBLEN,LIBRARY 00090 MON 00100$$TXBIN,LIBRARY,,BLKSIO 00110$$TXBIN,LIBRARY,,LASTCH 00120$$TXBIN,LIBRARY,,HASH 00130$$TXBIN,LIBRARY,,HEXASC 0014000$$TXBIN,LIBRARY,,HEXDEC 00150$$TXBIN,LIBRARY,,SEKVIT 00160$$TXINSTAL,LIBRARY,,LIST,$$ 00170*Z 00180_ 00 00 00 __ 0(2 2WSPROVE LIBRARY P999999060381(0*JOB,LIBRARY,,WSPROVE 00010*K,I13,P11,L12 00020*REW,11 00030*FTN 00040 OPT P???? ? 00050$$TFPROVE,LIBRARY 00060$$TFPRINIT,LIBRARY 0007000$$TFPRCHEK,LIBRARY 00080$$TFREMOVE,LIBRARY 00090$$TFTWCMPR,LIBRARY 00100$$TFCHKFDD,LIBRARY 00110$$TFCHKFDB,LIBRARY 00120$$TFCHKDEF,LIBRARY 00130 MON 0014000$$TXBIN,LIBRARY,,DATTIM 00150$$TXBIN,LIBRARY,,FDWMTH 00160$$TXBIN,LIBRARY,,MMREAD 00170$$TXBIN,LIBRARY,,NDWMTH 00180$$TXBIN,LIBRARY,,QUIET 00190$$TXBIN,LIBRARY,,VPC 00200$$TXBIN,LIBRARY,,WTRD 0021000$$TXINSTAL,LIBRARY,,PROVE,$$ 00220*Z 00230_ 00 00 00 00 __ 0(2 2WSSQUISHLIBRARY P999999060381(0*JOB,,,WSSQUISH 00010*K,I13,P11,L12 00020*REW,11 00030*FTN 00040 OPT P???????? ? 00050$$TFSQUISH,LIBRARY 00060$$TFSQINIT,LIBRARY 0007000$$TFMRKHDR,LIBRARY 00080$$TFDHOLE ,LIBRARY 00090$$TFCHKHDR,LIBRARY 00100$$TFSQUIRM,LIBRARY 00110 MON 00120$$TXBIN,LIBRARY,,FDWMTH 00130$$TXBIN,LIBRARY,,HEXASC 0014000$$TXBIN,LIBRARY,,IINPUT 00150$$TXBIN,LIBRARY,,MMREAD 00160$$TXBIN,LIBRARY,,MMWRIT 00170$$TXBIN,LIBRARY,,NDWMTH 00180$$TXBIN,LIBRARY,,QUIET 00190$$TXBIN,LIBRARY,,VPC 00200$$TXBIN,LIBRARY,,WTRD 0021000$$TXINSTAL,LIBRARY,,SQUISH,$$ 00220*Z 00230_ 00 00 00 00 __ 0(2 2WSSSP LIBRARY P,999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFSSP,LIBRARY 00020$$TFSSINIT,LIBRARY 00030$$TFDEFSFL,LIBRARY 00040$$TFGTDATA,LIBRARY 00050$$TFGENRPT,LIBRARY 00060$$TFRETSFL,LIBRARY 0007000$$TFCKSTR,LIBRARY 00080$$TFDSKERR,LIBRARY 00090$$TFFMTFCB,LIBRARY 00100$$TFGENREC,LIBRARY 00110$$TFLHOLES,LIBRARY 00120$$TFMPFACE,LIBRARY 00130$$TFNXTFCB,LIBRARY 0014000$$TFOWNER,LIBRARY 00150$$TFPAGE1,LIBRARY 00160$$TFSETKEY,LIBRARY 00170$$TFWCMTCH,LIBRARY 00180 MON 00190$$TXBIN,LIBRARY,,CHO2LR 00200$$TXBIN,LIBRARY,,CNV2W 0021000$$TXBIN,LIBRARY,,CONVER 00220$$TXBIN,LIBRARY,,DATTIM 00230$$TXBIN,LIBRARY,,FRHX 00240$$TXBIN,LIBRARY,,SEKVIT 00250$$TXBIN,LIBRARY,,VLTOI 00260$$TXBIN,LIBRARY,,WTRD 00270$$TXINSTAL,LIBRARY,,SSP,$$ 0028000*Z 00290_ 00 00 00 __ 0(  WSSTAT LIBRARY P999999060381(0$$TXFTNJOB,LIBRARY,,??????????? ? 00010$$TFSTAT,LIBRARY 00020$$TFFETFCB,LIBRARY 00030$$TFFMTFCB,LIBRARY 00040$$TFGETVOL,LIBRARY 00050 MON 00060$$TXBIN,LIBRARY,,CHO2LR 0007000$$TXBIN,LIBRARY,,CNV2W 00080$$TXBIN,LIBRARY,,CONVER 00090$$TXBIN,LIBRARY,,FRHX 00100$$TXBIN,LIBRARY,,HASH 00110$$TXBIN,LIBRARY,,SEKVIT 00120$$TXBIN,LIBRARY,,VLTOI 00130$$TXINSTAL,LIBRARY,,STAT,$$ 0014000*Z 00150_ 00 00 __ 0(  WSTPUTPRLIBRARY P999999060381(0 * INSTALL TAPE UTILITIES 00010INPUT=TPUTPROC 00020UTIL 00030$$TPUTMAC,LIBRARY,,BSR!! 00040$$TPUTMAC,LIBRARY,,WEF!! 00050$$TPUTMAC,LIBRARY,,REW!! 00060$$TPUTMAC,LIBRARY,,UNL!! 0007000$$TPUTMAC,LIBRARY,,ADF!! 00080$$TPUTMAC,LIBRARY,,BSF!! 00090$$TPUTMAC,LIBRARY,,ADR!! 00100$$TPUTMAC,LIBRARY,,DEN!! 00110EXIT 00120 * TAPE UTILITIES INSTALLED 00130_ 00 00 00 __ 0(2 2WSUSERIDLIBRARY P999999060381(0$$TXFTNJOB,LIBRARY,,?????????? ? 00010$$TFUSERID 00020$$TFADD 00030$$TFCDS 00040$$TFCHG 00050$$TFDEL 00060$$TFINIT 0007000$$TFLST 00080$$TFMSG 00090$$TFPROMPT 00100$$TFTRM 00110$$TFUSRSQU 00120$$TFVALTID 00130 MON 0014000$$TXBIN,LIBRARY,,DATTIM 00150$$TXBIN,LIBRARY,,HEXASC 00160$$TXBIN,LIBRARY,,HEXDEC 00170$$TXINSTAL,LIBRARY,,USERID,$$ 00180*Z 00190_ 00 00 00 00 00 __ 0(  WSUSRBLKLIBRARY PP999999060381(02 00010 INTEGER REQBLK(24), IDATA(15), ISTAT, TCODE(76) 00020 INTEGER USER(14), CURID(5), UID(5), TX(2), LU, EOFLAG 00030 INTEGER VALTID 000401 00050 COMMON / USRBLK / REQBLK, IDATA, ISTAT, TCODE, USER, CURID, UID, 00060 + TX, LU, EOFLAG 00070002 00080_ __ INTEGER VALTID 000401 00050 COMMON / USRBLK / REQBLK, IDATA, ISTAT, TCODE, USER, CURID, UID, 00060 + TX, LU, EOFLAG 000700(  WSUSRDATLIBRARY P(999999060381(0 DATA REQBLK / 24*0 / 00010 DATA IDATA / '$$USRID2', '$$ ', ' ', 1, 1, +1 / 00020 DATA EOFLAG / $0100 / 000302 00040_ 00 __ 00040_ 0(  WSWATZITLIBRARY Pn999999060381(0*JOB,,,WATZIT 00010*K,I13,L12,P11 00020*REW,11 00030*FTN 00040 OPT LPC 00050$$TFWATZIT 00060 MON 0007000$$TXBIN,LIBRARY,,VPC 00080$$TXBIN,LIBRARY,,ZINPUT 00090$$TXINSTAL,LIBRARY,,WATZIT,$$ 00100*Z 00110_ 00 __ 0(  WSWEAVE LIBRARY Pn999999060381(0*JOB,LIBRARY,,WSWEAVE 00010*K,I13,L12,P2 00020*FTN 00030 OPT LCX 00040$$TFWEAVE,LIBRARY 00050 MON 00060*LIBEDT 0007000*K,I8,P8 00080*P,F,3 00085*J,WEAVE,$$ 00090*Z 00100*Z 00110_ 00 __ 0(4( 4TACCSBLKCCS30 P999999060381(0 NAM CCSBLK A03 A CCS CCS 3.0 SL-149 00010* 00020* 00030* CYBERCREDIT SYSTEM VERSION 3 00040* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050* COPYRIGHT CONTROL DATA CORPORATION, 1979 00060* 0007000* BLANK FILL ARRAY FOR SPECIFIED NUMBER OF BYTES. 00080* 00090* ROUTINE TO BLANK FILL (ASCII,$2020) ARRAY 'BUF' WITH 'BYTLEN' 00100* BLANKS, WHERE 'BYTLEN' IS THE NUMBER OF BYTES IN 'BUF' TO BE 00110* BLANKED. 00120* CALLING SEQUENCE: 00130* CALL CCSBLK(BUF,BYTLEN) 0014000* WHERE: 00150* BUF - THE BUFFER TO BE BLANK FILLED. 00160* BYTLEN - THE NUMBER OF BYTES IN BUF TO BE BLANKED. 00170* 00180 SPC 2 00190 ENT CCSBLK 00200 SPC 2 0021000* COMMUNICATIONS REGION USED. 00220 EQU ZERO($22) 00230 SPC 2 00240* THE BLANKING OPERATION IS DONE VIA THE MOVE STRING REQUEST. IF TH 00250* LENGTH OF STRING 1 (A REG.) IS SET TO ZERO, STRING 2 IS ENTIRELY 00260* FILLED WITH BLANKS. 00270 SPC 2 0028000CCSBLK 0 0 00290 SPC 1 00300 STQ* SAVEQ SAVE Q REGISTER. 00310 SPC 1 00320 LDQ* CCSBLK PICK UP ADDRESS OF BUFFER TO BE BLANKED. 00330 TRQ A 00340 INA 2 0035000 STA* CCSBLK RETURN VALUE. 00360 LDA- (ZERO),Q 00370 XFA 2 R2 CONTAINS THE DESTINATION STRING ADDRESS, IN 00380* THIS CASE, THE BUFFER TO BE BLANKED. 00390 INQ 1 INCREMENT TO GET NEXT PARAMETER, BYTLEN. 00400 LDQ- (ZERO),Q PICK UP ADDRESS OF NEXT PARAMETER, BYTLEN. 00410 LDQ- (ZERO),Q PICK UP VALUE OF PARAMETER. 0042000 ENA 0 SET LENGTH OF STRING 1 TO ZERO. 00430 MOV PERFORM THE BLANKING OPERATION. 00440 LDQ* SAVEQ RESTORE Q REGISTER. 00450 JMP* (CCSBLK) EXIT RETURN. 00460 SPC 1 00470SAVEQ NUM 0 00480 END 0049000_ __ JMP* (CCSBLK) EXIT RETURN. 00460 SPC 1 00470SAVEQ NUM 0 00480 END 004900(|? |4TACCSCSTCCS30 P999999060381(0 NAM CCSCST A04 A CCS CCS 3.0 SL-149 00010* 00020* 00030* CYBERCREDIT SYSTEM VERSION 3 00040* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050* COPYRIGHT CONTROL DATA CORPORATION, 1979 00060* 0007000* COMPARE STRING REQUEST FOR LESS THAN, EQUALITY, AND GREATER THAN. 00080* 00090* ROUTINE TO COMPARE TWO STRINGS OF BYTES OF SPECIFIED LENGTHS AND 00100* DETERMINE WHETHER STRING 1 IS LESS THAN, EQUAL TO, OR GREATER THA 00110* STRING 2. 00120* CALLING SEQUENCE: 00130* CALL CCSCST(STR1,POS1,LEN1,STR2,POS2,LEN2,COMPIN) 0014000* WHERE THE PARMATERS HAVE THE FOLLOWING DEFINTION: 00150* STR1 = ARRAY STRING 1 IS FROM. 00160* POS1 = STARTING CHARATER POSITION IN ARRAY FOR STRING 1. 00170* LEN1 = LENGTH IN BYTES OF STRING 1. 00180* STR2 = ARRAY STRING 2 IS FROM. 00190* POS2 = STARTING CHARACTER POSITION IN ARRAY FOR STRING 2. 00200* LEN2 = LENGTH IN BYTES OF STRING 2. 0021000* COMPIN = COMPARISON INDICATOR FOR RETURN. RETURNED VALUES ARE: 00220* < 0 STRING 1 LESS THAN STRING 2 00230* = 0 STRING 1 EQUALS STRING 2 00240* AND > 0 STRING 1 GREATER THAN STRING 2 . 00250* 00260* THESE VALUES FOR COMPIN ALLOW ANY LOGICAL COMPARISON OF THE TWO 00270* STRINGS: 0028000* STRING COMPARISON COMPIN VALUE 00290* EQ EQ 0 00300* NE NE 0 00310* LE LE 0 00320* LT LT 0 00330* GE GE 0 00340* GT GT 0 0035000* 00360 SPC 2 00370 ENT CCSCST 00380 SPC 1 00390* COMMUNICATIONS REGION USED. 00400 EQU ONE($3) 00410 EQU ZERO($22) 0042000 EJT 00430CCSCST 0 0 00440 SPC 1 00450* SAVE REGISTERS. 00460 STQ* SAVEQ 00470 LDA- I 00480 STA* SAVEI 0049000 SPC 1 00500 LDQ* CCSCST PICK UP ADDRESS OF CALLER. 00510 INQ 7 MOVE RETURN ADDRESS TO NEXT EXECUTABLE INSTRUCT 00520 STQ* CCSCST SAVE RETURN ADDRESS. 00530 RTJ* PARGET PICK UP ADDRESS OF PARAMETERS FROM CALLER. 00540 ENA -1 INITIALIZE RETURN VALUE OF COMPIN. 00550 STA* (COMPIN) 0056000 ENA 1 INITIALIZE FLAG FOR WHICH COMPARISON TO 00570 XFA 4 PERFORM. 00580COM100 LDQ* (POS1) PICK UP START CHARACTER POSITION IN STRING 1. 00590 INQ -1 DECREMENT TO GET BYTE COUNT. 00600 ENA 0 ZERO A FOR LONG LEFT SHIFT. 00610 LLS 15 Q = BYTE OFFSET, A = START WORD INDEX. 00620 XFQ 3 SAVE BYTE OFFSET. 0063000 ADD* STR1 ADD BASE ADDRESS TO GET WORD ADDRESS OF STRING 00640 XFA 1 SAVE ADDRESS IN R1. 00650 LDQ* (POS2) PICK UP START CHARACTER POSITION IN STRING 2. 00660 INQ -1 DECREMENT TO GET BYTE COUNT. 00670 ENA 0 ZERO A FOR LONG LEFT SHIFT 00680 LLS 15 Q = BYTE OFFSET, A = START WORD INDEX. 00690 ADD* STR2 ADD BASE ADDRESS TO GET WORD ADDRESS OF STRING 0070000 XFA 2 SAVE ADDRESS IN R2. 00710 ADQ* (LEN2) ADD LENGTH OF STRING 2 TO BYTE OFFSET OF STRING 00720 XF3 A RECALL BYTE OFFSET OF STRING 1. 00730 ADD* (LEN1) ADD LENGTH OF STRING 1 TO BYTE OFFSET OF STRING 00740 S4Z COM200-*-1 SKIP IF GREATER THAN COMPARISON TO BE DONE. 00750 SLT SKIP IF STRING 1 LESS THAN STRING 2. 00760 JMP* COM300 STRING NOT LESS THAN, BUMP COMPIN AND CHECK GT. 0077000 JMP* COM500 STRING LESS THAN. RETURN. 00780COM200 SGT SKIP IF STRING 1 LESS THAN STRING 2. 00790 JMP* COM500 STRING NOT GREATER THAN, MUST BE EQUAL. RETURN. 00800 JMP* COM400 STRING GREATER THAN, BUMP COMPIN AND RETURN. 00810COM300 RAO* (COMPIN) BUMP COMPARE INDICATOR. 00820 SB4- ONE SET FLAG FOR WHICH COMPARISON FUNCTION TO GT. 00830 JMP* COM100 NOT LESS THAN, CHECK FOR GREATER THAN. 0084000COM400 RAO* (COMPIN) BUMP COMPARE INDICATOR FOR GRETAER THAN CONDITI 00850 SPC 1 00860* RESTORE REGISTERS. 00870COM500 STA- I 00880 LDQ* SAVEQ 00890 LDA* SAVEI 00900 STA- I 0091000 JMP* (CCSCST) RETURN. 00920 EJT 00930* PARAMETER STORAGE. 00940* 00950STR1 NUM 0 ABSOLUTE ADDRESS OF ARRAY STRING 1 IS FROM. 00960POS1 NUM 0 ABSOLUTE ADDRESS OF CHAR POS STRING 1 BEGINS IN 00970LEN1 NUM 0 ABSOLUTE ADDRESS OF LENGTH OF STRING 1. 0098000STR2 NUM 0 ABSOLUTE ADDRESS OF ARRAY STRING 2 IS FROM. 00990POS2 NUM 0 ABSLOUTE ADDRESS OF CHAR POS STRING 2 BEGINS IN 01000LEN2 NUM 0 ABSOLUTE ADDRESS OF LENGTH OF STRING 2. 01010COMPIN NUM 0 ABSOLUTE ADDRESS OF COMPARE INDICATOR. 01020SAVEQ NUM 0 01030SAVEI NUM 0 01040 SPC 4 0105000* ROUTINE TO PICK PARAMETER ADDRESSES. 01060PARGET 0 0 01070 LDQ* CCSCST PICK UP ADDRESS OF CALLER + 7. 01080 INQ -1 MOVE TO END OF PARAMETER LIST. 01090 ENA 6 INTIALIZE INDEX INTO PARAMETER STORAGE. 01100 STA- I 01110PAR100 LDA- (ZERO),Q PICK UP ABSOLUTE ADDRESS OF NEXT PARAMETER. 0112000 STA* STR1,I STORE ADDRESS IN PARAMETER STORAGE. 01130 INQ -1 DECREMENT INDEX IN PARAMETER LIST. 01140 DIP *-PAR100 SKIP IF ALL PARAMETER ADDRESSES RETRIEVED. 01150 JMP* (PARGET) RETURN. 01160 SPC 2 01170 END 01180_ 00 __ END 01180_ 0(Bt BTACCSGETCCS30 P999999060381(0 NAM CCSGET A06 A CCS CCS 3.0 SL-149 00010* 00020* 00030* CYBERCREDIT SYSTEM VERSION 3 00040* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050* COPYRIGHT CONTROL DATA CORPORATION, 1979 00060* 0007000* GET CHARACTER FROM ARRAY. 00080* 00090* ROUTINE TO RETRIEVE A SPECIFIED CHARACTER FROM A BUFFER ACCORDING 00100* TO CHARACTER POSITION. 00110* CALLING SEQUENCE: 00120* CALL CCSGET(BUF,CHRPOS,CHAR) 00130* WHERE: 0014000* BUF = THE ARRAY TO RETRIEVE THE CHARACTER FROM. 00150* CHRPOS = THE CHARACTER POSITION OF THE CHARACTER TO RETRIEVE 00160* CHAR = VARIABLE TO RECEIVE THE RETRIEVED CHARACTER. 00170* 00180 SPC 2 00190 ENT CCSGET 00200 SPC 1 0021000* COMMUNICATIONS REGION USED. 00220 EQU ZERO($22) 00230 SPC 2 00240CCSGET 0 0 00250 SPC 1 00260* SAVE REGISTERS 00270 STQ* SAVEQ 0028000 LDA- I 00290 STA* SAVEI 00300 SPC 1 00310 LDQ* CCSGET PICK UP ADDRESS OF CALLER. 00320 INQ 3 MOVE TO NEXT EXECUTABLE INSTRUCTION. 00330 STQ* CCSGET SAVE RETURN VALUE. 00340 RTJ* PARGET PICK UP PARAMETER ADDRESSES. 0035000 LDQ* (CHRPOS) PICK UP POSITION OF CHARACTER TO GET. 00360 INQ -1 BIAS TO GET BYTE INDEX. 00370 LCA* (BUF),Q PICK UP THE DESIRED CHARACTER. 00380 STA* (CHAR) SAVE CHARACTER FOR RETURN. 00390 SPC 1 00400* RESTORE REGISTERS. 00410 LDA* SAVEI 0042000 STA- I 00430 LDQ* SAVEQ 00440 SPC 1 00450 JMP* (CCSGET) RETURN. 00460 SPC 2 00470* PARAMETER ADDRESS STORAGE. 00480BUF NUM 0 ABSOLUTE ADDRESS OF ARRAY TO RETRIEVE FROM. 0049000CHRPOS NUM 0 ABSOLUTE ADDRESS OF CHARACTER POSITION TO GET. 00500CHAR NUM 0 ABSOLUTE ADDRESS OF RETURNED CHARACTER. 00510SAVEQ NUM 0 00520SAVEI NUM 0 00530 SPC 2 00540PARGET 0 0 ROUTINE TO PICK UP ADDRESSES OF PARAMETERS. 00550 LDQ* CCSGET PICK UP ADDRESS OF CALLER+3. 0056000 INQ -1 MOVE TO END OF PARAMETER LIST. 00570 ENA 2 SET UP INDEX INTO PARAMETER STORAGE. 00580 STA- I 00590PAR100 LDA- (ZERO),Q PICK UP ABSOLUTE ADDRESS OF NEXT PARAMETER. 00600 STA* BUF,I SAVE IN PARAMETER STORAGE. 00610 INQ -1 DECREMENT INDEX INTO PARAMETER LIST. 00620 DIP *-PAR100 SKIP IF ALL PARAMETER ADDRESSES RETRIEVED. 0063000 JMP* (PARGET) RETURN. 00640 SPC 2 00650 END 00660__00 LDA- (ZERO),Q PICK UP ABSOLUTE ADDRESS OF NEXT PARAMETER. 00600 STA* BUF,I SAVE IN PARAMETER STORAGE. 00610 INQ -1 DECREMENT INDEX INTO PARAMETER LIST. 00620 DIP *-PAR100 SKIP IF ALL PARAMETER ADDRESSES RETRIEVED. 006300(t t1TACCSMVACCS30 P999999060381(0 NAM CCSMVA A08 A CCS CCS 3.0 SL-149 00010* 00020* 00030* CYBERCREDIT SYSTEM VERSION 3 00040* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050* COPYRIGHT CONTROL DATA CORPORATION, 1979 00060* 0007000* MOVE STRING REQUEST. 00080* 00090* ROUTINE TO MOVE ONE STRING OF BTYES FROM ONE LOCATION TO ANOTHER. 00100* MOVE IS ACCOMPLISHED WITH THE 'MOV' REQUEST. THE MOVE REQUEST HAS 00110* THE FOLLOWING PARAMETER ASSIGNMENTS: 00120* R1 = ADDRESS OF THE SOURCE STRING. 00130* R2 = ADDRESS OF THE DESTINATION STRING. 0014000* A = B + LENGTH OF SOURCE STRING IN BYTES. 00150* Q = B + LENGTH OF DESTINATION STRING IN BYTES. 00160* WHERE B IS THE BYTE OFFSET: 00170* B = 0 FOR WORD BOUNDARY. 00180* = $8000 FOR BYTE BOUNDARY. 00190* 00200* CALLING SEQUENCE: 0021000* CALL CCSMVA(SOURCE,SPOS,SLEN,DESTIN,DPOS,DLEN) 00220* WHERE THE PARAMETERS HAVE THE FOLLOWING DEFINITIONS: 00230* SOURCE = NAME OF ARRAY SOURCE STRING IS FROM. 00240* SPOS = BYTE NUMBER WHERE THE STRING BEGINS IN THE SOURCE 00250* ARRAY. 00260* SLEN = LENGTH OF SORUCE STRING IN BYTES. 00270* DESTIN = NAME OF ARRAY DESTINATION STRING IS IN. 0028000* DPOS = BYTE NUMBER WHERE THE DESTINATION STRING BEGINS IN 00290* DESTINATION ARRAY. 00300* DLEN = LENGTH OF DESTINATION STRING IN BYTES. 00310* 00320* NOTES: THE FOLLOWING OPERATION OCCCURS IF THE STRING LENGTHS ARE 00330* NOT EQUAL: 00340* 1. LENGTH OF DESTINATION STRING = 0. 0035000* 'MOV' INSTRUCTION IS A NOP. 00360* 2. LENGTH OF SOURCE STRING < LENGTH OF DESTINATION STRING. 00370* REMAINDER OF DESTINATION STRING IS BLANK FILLED. 00380* 3. LENGTH OF SOURCE STRING > LENGTH OF DESTINATION STRING. 00390* ONLY THE SPECIFIED NUMBER OF BYTES OF DESTINATION STRI 00400* FILLED WITH SOURCE STRING. 00410* 4. LENGTH OF SOURCE STRING = 0. 0042000* BLANK FILLS (ASCII,$2020) DESTINATION STRING. 00430* 00440 SPC 2 00450 ENT CCSMVA 00460 SPC 1 00470* COMMUNICATIONS REGION USED. 00480 EQU ZERO($22) 0049000 EJT 00500CCSMVA 0 0 00510 SPC 1 00520* SAVE REGISTERS. 00530 STQ* SAVEQ 00540 LDA- I 00550 STA* SAVEI 0056000 SPC 1 00570 LDQ* CCSMVA PICK UP ADDRESS OF CALLER. 00580 INQ 6 MOVE TO NEXT EXECUTABLE INSTRUCTION. 00590 STQ* CCSMVA SAVE RETURN ADDRESS. 00600 RTJ* PARGET PICK ADDRESS OF PARAMETERS. 00610 LDQ* (SPOS) PICK UP STARTING CHARACTER POSITION IN SOURCE. 00620 INQ -1 DECREMENT TO GET BYTE INDEX. 0063000 ENA 0 ZERO A FOR LONG LEFT SHIFT. 00640 LLS 15 Q = BYTE OFFSET, A = WORD INDEX INTO SOURCE. 00650 ADD* SOURCE ADD ADDRESS OF SOURCE TO GET SOURCE STRING ADD 00660 XFA 1 ADDRESS. SAVE IN R1. 00670 STQ- I SAVE BYTE OFFSET OF SOURCE STRING. 00680 LDQ* (DPOS) PICK UP START CHARACTER POSITION IN DESTINAT. 00690 INQ -1 DECREMENT TO GET BYTE INDEX. 0070000 ENA 0 ZERO A FOR LONG LEFT SHIFT. 00710 LLS 15 Q = BYTE OFFSET, A = WORD INDEX INTO DESTINAT. 00720 ADD* DESTIN ADD ADDRESS OF DESTINATION ARRAY TO DESTINATIO 00730 XFA 2 STRING ADDRESS. SAVE IN R2 00740 LDA- I SET BYTE OFFSET OF SOURCE STRING IN A. 00750 ADD* (SLEN) SET LENGTH OF SOURCE STRING IN A. 00760 ADQ* (DLEN) SET LENGTH OF DESTINATION STRING IN Q. 0077000 MOV PERFORM THE MOVE. 00780 SPC 1 00790* RESTORE REGISTERS. 00800 LDA* SAVEI 00810 STA- I 00820 LDQ* SAVEQ 00830 SPC 1 0084000 JMP* (CCSMVA) RETURN. 00850 EJT 00860* VARIABLES USED. 00870* 00880SOURCE NUM 0 ADDRESS OF SOURCE ARRAY. 00890SPOS NUM 0 ADDRESS OF STARTING BYTE POSITION FOR SOURCE 00900* STRING. 0091000SLEN NUM 0 ADDRESS OF LENGTH OF SOURCE STRING. 00920DESTIN NUM 0 ADDRESS OF DESTINATION ARRAY. 00930DPOS NUM 0 ADDRESS OF STARTING BYTE POSITION FOR DESTI- 00940* NATION STRING. 00950DLEN NUM 0 ADDRESS OF LENGTH OF DESTINATION STRING. 00960SAVEQ NUM 0 00970SAVEI NUM 0 0098000 SPC 4 00990* ROUTINE TO PICK UP PARAMETER ADDRESSES. 01000* 01010PARGET 0 0 01020 LDQ* CCSMVA PICK UP LOCATION OF CALLER + 6. 01030 INQ -1 MOVE TO END OF PARAMETER LIST 01040 ENA 5 SET UP INDEX INTO PARAMETER STORAGE. 0105000 STA- I 01060PAR100 LDA- (ZERO),Q PICK UP ABSOLUTE ADDRESS OF PARAMETER. 01070 STA* SOURCE,I STORE IN PARAMETER LIST 01080 INQ -1 DECREMENT INDEX INTO PARAMETER LIST. 01090 DIP *-PAR100 SKIP IF ALL PARAMETER ADDRESS RETRIEVED. 01100 JMP* (PARGET) RETURN. 01110 SPC 2 0112000 END 01130_ __ DIP *-PAR100 SKIP IF ALL PARAMETER ADDRESS RETRIEVED. 01100 JMP* (PARGET) RETURN. 01110 SPC 2 011200(B BTACCSPUTCCS30 P999999060381(0 NAM CCSPUT A09 A CCS CCS 3.0 SL-149 00010* 00020* 00030* CYBERCREDIT SYSTEM VERSION 3 00040* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050* COPYRIGHT CONTROL DATA CORPORATION, 1979 00060* 0007000* PUT CHARACTER INTO SPECIFIED POSITION IN AN ARRAY. 00080* 00090* ROUTINE TO PLACE A CHARACTER INTO A SPECIFIED POSITION IN AN ARRA 00100* CALLING SEQUENCE: 00110* CALL CCSPUT(CHAR,CHRPOS,BUF) 00120* WHERE: 00130* CHAR = CHARACTER TO BE PLACED IN THE ARRAY. 0014000* CHRPOS = CHARACTER POSITION THE CHARACTER IS TO BE PUT INTO. 00150* BUF = ARRAY TO RECEIVE THE CHARACTER. 00160* 00170 SPC 2 00180 ENT CCSPUT 00190 SPC 1 00200* COMMUNICATIONS REGION USED. 0021000 EQU ZERO($22) 00220 SPC 2 00230CCSPUT 0 0 00240 SPC 1 00250* SAVE REGISTERS 00260 STQ* SAVEQ 00270 LDA- I 0028000 STA* SAVEI 00290 SPC 1 00300 LDQ* CCSPUT PICK UP ADDRESS OF CALLER. 00310 INQ 3 MOVE TO NEXT EXECUTABLE INSTRUCTION. 00320 STQ* CCSPUT SAVE RETURN ADDRESS. 00330 RTJ* PARGET PICK UP ADDRESSES OF PARAMETERS. 00340 LDQ* (CHRPOS) PICK UP CHARACTER POSITION TO BE STORED INTO. 0035000 INQ -1 BIAS TO GET BYTE INDEX. 00360 LDA* (CHAR) PICK UP CHARACTER TO BE STORED. 00370 SCA* (BUF),Q STORE CHARACTER INTO BUFFER. 00380 SPC 1 00390* RESTORE REGISTERS. 00400 LDA* SAVEI 00410 STA- I 0042000 LDQ* SAVEQ 00430 SPC 1 00440 JMP* (CCSPUT) RETURN. 00450 SPC 2 00460* PARAMETER STORAGE. 00470* 00480CHAR NUM 0 ABSOLUTE ADDRESS OF CHARACTER TO STORE. 0049000CHRPOS NUM 0 ABSOLUTE ADDRESS OF CHARACTER POSITION TO PUT. 00500BUF NUM 0 ABSOLUTE ADDRESS OF ARRAY TO RECEIVE CHARACTER 00510SAVEQ NUM 0 00520SAVEI NUM 0 00530 SPC 2 00540PARGET 0 0 ROUTINE TO PICK UP PARAMETER ADDRESSES. 00550 LDQ* CCSPUT PICK UP ADDRESS OF CALLER+3. 0056000 INQ -1 MOVE TO END OF PARAMETER LIST. 00570 ENA 2 INITIALIZE INDEX INTO PARAMETER STORAGE. 00580 STA- I 00590PAR100 LDA- (ZERO),Q PICK UP ABSOLUTE ADDRESS OF NEXT PARAMETER. 00600 STA* CHAR,I STORE INTO PARAMETER STORAGE. 00610 INQ -1 DECREMENT INDEX INTO PARAMETER LIST. 00620 DIP *-PAR100 SKIP IF ALL PARAMETERS HAVE BEEN RETRIEVED. 0063000 JMP* (PARGET) RETURN. 00640 SPC 2 00650 END 00660__00 LDA- (ZERO),Q PICK UP ABSOLUTE ADDRESS OF NEXT PARAMETER. 00600 STA* CHAR,I STORE INTO PARAMETER STORAGE. 00610 INQ -1 DECREMENT INDEX INTO PARAMETER LIST. 00620 DIP *-PAR100 SKIP IF ALL PARAMETERS HAVE BEEN RETRIEVED. 006300(O O!TFFILERRCCS30 P999999060381(0 SUBROUTINE FILERR(FILNAM,REQUES,ISTAT,LU) 00010 1 /B52 F CCS CCS 3.0 SL-149 00020C 00030C CYBERCREDIT SYSTEM VERSION 3 00040C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION, 1979 00060C 0007000C 00080C PROCESS FILE ERROR OUTPUTTING MESSAGES TO TERMINAL AND CONSOLE. 00090C 00100C ROUTINE TO REPORT FILE ERRORS TO THE TERMINAL AND THE MASTER CONSO 00110C UPON COMPLETION, CONTROL IS RETURNED TO THE REQUESTING PROGRAM. TH 00120C ATTRACTIVE FEATURE OF THIS ROUTINE IS STANDARDIZATION OF ERROR 00130C REPORTING. 0014000C CALLING SEQUENCE: 00150C CALL FILERR(FILNAM,REQUES,ISTAT,LU) 00160C WHERE THE PARAMETERS HAVE THE FOLLOWING DEFINTIONS: 00170C FILNAM - FOUR WORD ARRAY CONTAINING THE FILE NAME OF THE FILE THE 00180C ERROR OCCURRED IN. THIS CAN TYPICALLY BE FROM THE IDATA BUFF 00190C USED TO OPEN THE FILE. 00200C REQUES - A NUMERIC CODE TO INDICATE THE REQUEST CAUSING THE FILE 0021000C ERROR. NUMERIC VALUES USED ARE: 00220C 0 = CREATE 9 = RENAME 00230C 1 = CLEAR 10 = VOLUSE 00240C 2 = DELETE 11 = PUTS 00250C 3 = OPENFL 12 = WRITER 00260C 4 = CLOSFL 13 = READR 00270C 5 = LOKFIL 14 = GETS 0028000C 6 = UNLFIL 15 = UPDREC 00290C 7 = GETFCB 16 = DELREC 00300C 8 = UPDFCB 17 = COMFIL 00310C ANY OTHER VALUE WILL OMIT THE REQUEST CAUSING THE ERROR FROM 00320C THE ERROR MESSAGE OUTPUT. 00330C ISTAT - THE FILE MANAGER STATUS WORD INDICATING THE ERROR. 00340C LU - TERMINAL LOGICAL UNIT FROM LOGIN. IF TERMINAL IS THE MAST 0035000C CONSOLE, ONLY ONE MESSAGE IS OUTPUT. 00360C 00370C THE ERROR MESSAGE OUTPUT IS: 00380C FILE MANAGER ERROR: FILE NAME = XXXXXXXX, REQUEST = XXXXXX, ISTAT = 99 00390C OR, OMITTING THE REQUEST: 00400C FILE MANAGER ERROR: FILE NAME = XXXXXXXX, ISTAT = 9999. 00410C 0042000 INTEGER FILNAM(1),REQUES,ISTAT,LU,ONE,EIGHT,ERRMSG(38),FNPOS 00430 INTEGER FILREQ(54),SIX,FRPOS,LENGTH,LEFTST,LEFTDS,LEFTLN,CONSOL 00440 INTEGER XYN,ZERO 004501 00460 DATA ONE/1/,EIGHT/8/,FNPOS/35/,SIX/6/,FRPOS/55/,LEFTST/63/, 00470 1 LEFTDS/45/,LEFTLN/13/,CONSOL/4/,XYN/-1/,ZERO/0/ 00480 DATA ERRMSG/$D0A,'FILE MANAGER ERROR: FILE NAME = , REQUES 0049000 1T = , ISTAT = . '/ 00500 DATA FILREQ/'CREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFC 00510 1BRENAMEVOLUSEPUTS WRITERREADR GETS UPDRECDELRECCOMFIL'/ 005202 00530C 00540C MOVE FILE NAME INTO ERROR MESSAGE. 00550 CALL CCSMVA(FILNAM,ONE,EIGHT,ERRMSG,FNPOS,EIGHT) 0056000C CONVERT THE FILE MANAGER STATUS WORD AND STORE IN ERROR MESSAGE. 00570 CALL CCSHXA(ISTAT,ERRMSG(36)) 00580C SKIP IF REQUEST TO BE OMITTED FROM ERROR MESSAGE. 00590 IF(REQUES.LT.0.OR.REQUES.GT.17) GO TO 10 00600C MOVE REQUEST INTO ERROR MESSAGE. 00610 J = 6*REQUES + 1 00620 CALL CCSMVA(FILREQ,J,SIX,ERRMSG,FRPOS,SIX) 0063000 LENGTH = 75 00640C PROCEED TO OUTPUT SECTION. 00650 GO TO 20 006601 00670C REQUEST TO BE OMMITTED FROM ERROR MESSAGE. MOVE STATUS WORD OUTPUT 00680C NEXT TO FILE NAME OUTPUT IN ERROR MESSAGE. 00690 10 CALL CCSMVA(ERRMSG,LEFTST,LEFTLN,ERRMSG,LEFTDS,LEFTLN) 0070000 LENGTH = 57 007102 00720C OUTPUT ERROR MESSAGE TO TERMINAL AND MASTER CONSOLE. 00730 20 CALL WTREAD(LU,XYN,ERRMSG,LENGTH,ZERO,ZERO,ZERO,J) 00740CTEMP CALL WTREAD(CONSOL,XYN,ERRMSG,LENGTH,ZERO,ZERO,ZERO,J) 007502 00760C OUTPUT COMPLETE. RETURN. 0077000 30 RETURN 00780 END 00790__ OUTPUT ERROR MESSAGE TO TERMINAL AND MASTER CONSOLE. 00730 20 CALL WTREAD(LU,XYN,ERRMSG,LENGTH,ZERO,ZERO,ZERO,J) 00740CTEMP CALL WTREAD(CONSOL,XYN,ERRMSG,LENGTH,ZERO,ZERO,ZERO,J) 007502 00760C OUTPUT COMPLETE. RETURN. 007700( TFMOVE DRG P&999999060381(0 PROGRAM MOVFIL C0 00010 INTEGER ID(4),VOL1(5),VOL2(5),IBLK1(24),IBLK2(24),FCBBFR(96) C0 00020 INTEGER MSG1(24),MSG2(24),MSG3(20),MSG4(3),MSG5(12),REQBUF(24) C0 00030 INTEGER DOLLAR,FLAG,COMPAR,CPFCB(96),CPREQ(24),TEMP(3),OPNPAR(3) C0 00040 INTEGER MSG6(18),FNAME(5),SYSVOL(4),DID(5),MSG7(25),CTLD,RUBOUT 00050 INTEGER MSG8(10),RETURN,MSG9(23),IANS(3),FLAG1,IVIT(24) 000602 C0 0007000 DATA INDX/0/,ICLR/$2018/,DOLLAR/'$$'/,OPNPAR/0,1,0/ C0 00080 DATA MSG1/'ENTER FROM VOLUME: (DEFAULT IS SYSVOL)'/, C0 00090 * MSG2/'ENTER TO VOLUME: (DEFAULT IS SYSVOL)'/, C0 00100 * MSG3/' FILE AAAAAAAA/ BBBBBBBB CANNOT BE MOVED'/, C0 00110 * MSG4/'PAUSE'/,RUBOUT/4/,CTLD/6/,RETURN/2/, C0 00120 * MSG5/'AAAAAAAA/ BBBBBBBB MOVED'/ C0 00130 DATA MSG6/'FILE TO BE MOVED (CR FOR ALL FILES)'/, 0014000 * MSG8/$2016,'AAAAAAAA/ BBBBBBBB'/, 00150 * MSG9/'OK TO MOVE, ALL FOR MOVE WITH NO VERIFICATION'/, 00160 * SYSVOL/'SYSVOL '/, 00170 * MSG7/'ENTER TO ID: (DEFAULT IS LOGON ID)'/ 001803 C0 00190 CALL PGMIN(ID,LU,MODE,NOPORT) C0 00200 CALL MOVE(ID,IBLK1(5),4) C0 0021000 CALL WTREAD(LU,-1,ICLR,2,0,0,0,0) C0 0022010 CALL BLANK(VOL1,4) C0 00230 VOL1(5)=0 00240 CALL WTREAD(LU,$0000,MSG1,48,19*$100,VOL1,8,ITC) 00250 IF(ITC.EQ.RUBOUT)GOTO 10 00260 IF(ITC.EQ.CTLD)GOTO 900 00270 IF(VOL1(5).EQ.0)CALL MOVE(SYSVOL,VOL1,4) 0028000 CALL MOVE(VOL1,IBLK1(9),4) C0 0029020 CALL BLANK(VOL2,4) C0 00300 VOL2(5)=0 00310 CALL WTREAD(LU,$0002,MSG2,48,19*$100+2,VOL2,8,ITC) 00320 IF(ITC.EQ.RUBOUT)GOTO 20 00330 IF(ITC.EQ.CTLD)GOTO 900 00340 CALL MOVE(VOL2,IBLK2(9),4) C0 0035000 IF(VOL2(5).EQ.0)CALL MOVE(SYSVOL,IBLK2(9),4) 00360 FLAG=0 C0 00370 FLAG1=0 00380 IF((ID(1).EQ.DOLLAR).AND.(NOPORT.EQ.0))FLAG=1 C0 0039025 CALL BLANK(DID,4) 00400 DID(5)=0 00410 CALL WTREAD(LU,$0004,MSG7,50,19*$100+4,DID,8,ITC) 0042000 IF(ITC.EQ.RUBOUT)GOTO 25 00430 IF(ITC.EQ.CTLD)GOTO 900 00440 IF(DID(5).EQ.0)CALL MOVE(ID,DID,4) 00450 CALL WTREAD(LU,-1,ICLR,2,0,0,0,0) 00460 IF(FLAG.EQ.1)GOTO 30 C0 00470 CALL BLANK(MSG3(9),4) C0 00480 CALL BLANK(MSG5(6),4) C0 004900030 LINE=0 C0 00500 ASSIGN 900 TO INTLOC C0 00510 CALL PGMINT(INTLOC,IDUM1) C0 00520 ASSIGN 40 TO IRETN 0053040 IF(LINE.GT.20)GOTO 200 0054050 CALL BLANK(FNAME,4) 00550 FNAME(5)=0 0056000 CALL WTREAD(LU,LINE,MSG6,36,37*$100+LINE,FNAME,8,ITC) 00570 IF(ITC.EQ.RUBOUT)GOTO 50 00580 IF(ITC.EQ.CTLD)GOTO 900 00590 LINE=LINE+1 00600 IF(FNAME(5).NE.0)GOTO 300 00610 ASSIGN 100 TO IRETN 00620 INDX=0 0063000 IVOL=1 0064055 CALL GETVIT(IVOL,IVIT) 00650 IF(COMPAR(VOL1,IVIT(2),4).NE.0)GOTO 60 00660 IF(IVIT(1).EQ.0)GOTO 102 00670 IVOL=IVOL+1 00680 GOTO 55 0069060 NUMFIL=0 0070000 MAXFIL=IVIT(18) 00710. C0 00720100 INDX=INDX+1 C0 00730 CALL GETVIT(IVOL,IVIT) 00740 IF(IVIT(18).GT.MAXFIL)MAXFIL=IVIT(18) 00750 IF(NUMFIL.GE.MAXFIL)GOTO 900 00760 CALL ZERO(REQBUF,24) C0 0077000 CALL GETFCB(REQBUF,VOL1,INDX,FCBBFR,ISTAT) C0 00780 IF(AND(ISTAT,$1000).NE.0)GOTO 900 00790 IF(AND(ISTAT,$6FFF).EQ.0)GOTO 101 C0 00800102 CALL SYSMSG(36,IDUM) C0 00810 GOTO 900 00820101 IF(FCBBFR(25).EQ.0)GOTO 100 C0 00830 NUMFIL=NUMFIL+1 0084000110 IF(FLAG.EQ.1)GOTO 115 C0 00850 IF(COMPAR(ID,FCBBFR(29),4).EQ.0)GOTO 100 C0 00860115 IF(FLAG1.EQ.1)GOTO 117 00870 CALL MOVE(FCBBFR(25),MSG8(2),4) 00880 CALL MOVE(FCBBFR(29),MSG8(7),4) 00890116 CALL BLANK(IANS,2) 00900 CALL WTREAD(LU,LINE+1,MSG9,46,0,0,0,0) 0091000 CALL WTREAD(LU,LINE,MSG8,20,20*$100+LINE,IANS,3,ITC) 00920 IF(ITC.EQ.RUBOUT)GOTO 116 00930 IF(ITC.NE.RETURN)GOTO 900 00940 IF(LINE.LE.20)GOTO 1165 00950 ASSIGN 1168 TO IRETN 00960 GOTO 200 009701165 LINE=LINE+1 00980001168 ASSIGN 100 TO IRETN 00990 IF((IANS(1).EQ.$4F4B).AND.(IANS(3).EQ.2))GOTO 117 01000 IF((IANS(1).EQ.$414C).AND.(IANS(2).EQ.$4C20))FLAG1=1 01010 IF(FLAG1.NE.1)GOTO 100 01020117 CALL MOVE(FCBBFR(2),IBLK2(14),2) C0 01030 IBLK2(13)=FCBBFR(33) 01040 IBLK2(16)=FCBBFR(6) C0 0105000 CALL MOVE(FCBBFR(25),IBLK1(1),8) C0 01060 CALL MOVE(FCBBFR(25),IBLK2(1),8) C0 01070 IF(FLAG.NE.1 .OR. DID(5).EQ.0)CALL MOVE(DID,IBLK2(5),4) 01080 CALL MOVE(FCBBFR(15),IBLK2(17),8) C0 01090 CALL ZERO(REQBUF,24) C0 01100 CALL CREATE(REQBUF,IBLK2,ISTAT) C0 01110 IF(ISTAT.GE.0)GOTO 120 C0 0112000 IJMP=AND($7FFF,ISTAT)/$400 C0 01130 GOTO (130,140,180,150,180,180,180,160),IJMP C0 011401 C0 01150120 CALL ZERO(CPREQ,24) 01160 CALL MOVE(IBLK2(13),TEMP,3) 01170 CALL MOVE(OPNPAR,IBLK2(13),3) 01180 CALL OPENFL(CPREQ,IBLK2,ISTAT) 0119000 CALL GETFCB(CPREQ,0,IDUM,CPFCB,ISTAT) 01200 CALL MOVE(FCBBFR(38),CPFCB(38),58) 01210 CALL UPDFCB(CPREQ,0,IDUM,CPFCB,ISTAT) 01220 CALL CLOSFL(CPREQ,ISTAT) 01230 CALL MOVE(TEMP,IBLK2(13),3) 01240 CALL COPY(IBLK1,IBLK2) C0 01250 ASSIGN 900 TO INTLOC C0 0126000 CALL PGMINT(INTLOC,IDUM1) C0 01270 CALL MOVE(IBLK1,MSG5,4) C0 01280 IF(FLAG.EQ.1)CALL MOVE(IBLK1(5),MSG5(6),4) C0 01290 CALL WTREAD(LU,LINE,MSG5,24,0,0,0,0) C0 01300 IF(LINE.GT.20)GOTO 200 C0 01310 LINE=LINE+1 C0 01320 GOTO IRETN C0133000. C0 01340130 IF(FLAG.EQ.1)CALL MOVE(IBLK1(5),MSG3(9),4) C0 01350 CALL MOVE(IBLK1(1),MSG3(4),4) C0 01360 CALL WTREAD(LU,LINE,MSG3,40,0,0,0,0) C0 01370 IF(LINE.GT.20)GOTO 200 C0 01380 LINE=LINE+1 C0 01390 GOTO IRETN C01400002 C0 01410140 CALL SYSMSG(56,IDUM) C0 01420 GOTO 900 C0 014302 C0 01440150 CALL SYSMSG(55,IDUM) C0 01450 GOTO 900 C0 014602 C0 0147000160 CALL SYSMSG(36,IDUM) C0 01480 GOTO 900 C0 014902 C0 01500180 CALL SYSMSG(70,IDUM) C0 01510 GOTO 900 C0 015202 C0 01530200 CALL WTREAD(LU,$0017,MSG4,6,-1,REQBUF,1,ITC) C0 0154000 CALL WTREAD(LU,-1,ICLR,2,0,0,0,0) C0 01550 LINE=0 C0 01560 GOTO IRETN C015702 01580300 CALL MOVE(FNAME ,IBLK1(1),4) 01590 CALL MOVE(ID ,IBLK1(5),4) 01600 CALL MOVE(OPNPAR,IBLK1(13),3) 0161000 CALL ZERO(REQBUF,24) 01620 CALL OPENFL(REQBUF,IBLK1,ISTAT) 01630 IF(ISTAT.LT.0)GOTO 400 01640 CALL GETFCB(REQBUF,0,0,FCBBFR,ISTAT) 01650 CALL CLOSFL(REQBUF,ISTAT) C0 01660 GOTO 117 01670400 IF(AND(ISTAT,$0002).NE.0)CALL SYSMSG(34,IDUM) 0168000 IF(AND(ISTAT,$0004).NE.0)CALL SYSMSG(42,IDUM) 01690 IF(AND(ISTAT,$0200).NE.0)CALL SYSMSG(72,IDUM) 01700 IF(AND(ISTAT,$1000).NE.0)CALL SYSMSG(45,IDUM) 01710 IF(AND(ISTAT,$2000).NE.0)GOTO 160 01720 IF(AND(ISTAT,$4DF9).NE.0)GOTO 180 01730 LINE=LINE+1 01740 GOTO 40 01750002 01760900 CALL PGMOUT C0 01770 END C0 01780 SUBROUTINE MOVE(IA,IB,N) C0 01790 DIMENSION IA(1),IB(1) C0 01800 DO 10 I=1,N C0 0181010 IB(I)=IA(I) C0 0182000 RETURN C0 01830 END C0 01840 SUBROUTINE ZERO(IA,N) C0 01850 DIMENSION IA(1) C0 01860 DO 10 I=1,N C0 0187010 IA(I)=0 C0 01880 RETURN C0 0189000 END C0 01900 SUBROUTINE BLANK(IA,N) C0 01910 DIMENSION IA(1) C0 01920 DO 10 I=1,N C0 0193010 IA(I)=$2020 C0 01940 RETURN C0 01950 END C0 0196000 INTEGER FUNCTION COMPAR(IA,IB,N) C0 01970 DIMENSION IA(1),IB(1) C0 01980 COMPAR=1 C0 01990 DO 10 I=1,N C0 02000 IF(IA(I).NE.IB(I))COMPAR=0 C0 0201010 CONTINUE C0 02020 RETURN C0 0203000 END C0 02040 MACRO FMUCOM C0102050C DECK-ID C01 ITOS 1.2 SUMMARY-126C0102060C COMMON MACRO FOR UTILITY FORTRAN PROGRAMS C0102070C ************************************************************* 122*4875C0102080C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C0102090C ************************************************************* 122*4875C010210000C THIS IS THE LABELED COMMON AREA FOR THE FILE-MANAGER UTILITY PROGRAMSC0102110C C0102120 INTEGER COMCOD,PARNAM,PPHELP,PPINIT,PPDEFI C0102130 INTEGER PPSTAT,PPRELO,PPDUMP,PPCOPY,PPDELE C0102140 INTEGER PPCLEA,PPLIST,PPRENA,PPCOMM,PPEXIT C0102150 INTEGER PPMOUN,PPDISM,PPSAVE,PPBATC,PPLOAD C0102160 INTEGER PPPURG,PPINPU,PPOUTP,PPCOMP,DUMMY C010217000 INTEGER CODE,SWORD,SBYTE,PARLST,PIND,REQBUF C0102180 INTEGER PARDEF C0102190 INTEGER PPHOST,PPSET,PPBATS,PPDISC C0102200 INTEGER PPDISP,PPFLUS,PPPRIN C0102210 INTEGER FCBHDR,FCBBUF C0102220C C0102230C ************************************************************* 122*4875C010224000 COMMON /AA/COMCOD(133),PARNAM(124) C0102250C ************************************************************* 122*4875C0102260 COMMON /AA/PPHELP(2),PPINIT(4),PPDEFI(16) C0102270C ************************************************************* 122*4875C0102280 COMMON /AA/PPSTAT(4),PPRELO(5),PPDUMP(5) C0102290C ************************************************************* 122*4875C0102300 COMMON /AA/PPCOPY(6),PPDELE(3),PPCLEA(3) C010231000C ************************************************************* 122*4875C0102320 COMMON /AA/PPLIST(6),PPRENA(5),PPCOMM(2) C0102330C ************************************************************* 122*4875C0102340 COMMON /AA/PPEXIT(1),PPMOUN(3),PPDISM(2) C0102350C ************************************************************* 122*4875C0102360 COMMON /AA/PPSAVE(3),PPBATC(8),PPLOAD(5) C0102370C ************************************************************* 122*4875C010238000 COMMON /AA/PPPURG(3),PPINPU(2),PPOUTP(2) C0102390 COMMON /AA/PPCOMP(3) C0102400 COMMON /AA/PPHOST(4),PPSET(3),PPBATS(4),PPDISC(2) C0102410 COMMON /AA/PPDISP(7),PPFLUS(3),PPPRIN(3) C0102420 COMMON /AA/DUMMY(6) C0102430 COMMON /AA/INBUF(41),CODE(20) C0102440 COMMON /AA/LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST C010245000 COMMON /AA/NOCOD,PIND,REQBUF(24) C0102460 COMMON /AA/PARDEF(24) C0102470 COMMON /AA/FCBHDR(5),FCBBUF(96) C0102480 END C0102490 SUBROUTINE COPY (CPDAT,IDATA) C0202500 * /DECK-ID CUSTOM COPY SUBROUTINE SUMMARY-***C0202510C COMMAND PROCESSOR FOR COPY C020252000C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C0202530C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0202540C COPYRIGHT CONTROL DATA CORPORATION 1977 C0202550C*** C0202560C ************************************************************* 122*4868C0202570C C0202580C C020259000C FUNCTION C0202600C C0202610C THIS PROCESSOR WILL COPY AN EXCISTING FILE INTO ANOTHER C0202620C EXCISTINF FILE WITH DELETION OF THE RECORDS MARKED AS SUCH C0202630C C0202640C ************************************************************* 122*4868C0202650C MAX RECORD SIZE IS 8000 BYTES C020266000C *********************'*******************************'******* 122*4868C0202670C C0202680C GENERAL DESCRIPTION C0202690C C0202700C C0202710C ************************************************************* 122*4868C0202720C AFTER ALL PARAMETERS HAVE BEEN READ,A CHECK FOR VALIDITY C020273000C IS DONE C0202740C BOTH FILES WILL BE OPENED WITH LOCK AND THE FCB OF BOTH FILES C0202750C IS OBTAINED C0202760C A CHECK IS DONE TO ENSURE THAT BOTH FILES HAVE THE SAME C0202770C RECORD-LENGTH AND THE FYLE-TYPE SHOULD ALSO BE EQUAL C0202780C IF NOT,AN APPROPRIATE ERROR MESSAGE(65,66) IS DISPLAYED C0202790C THE FILE SPECIFIED BY F2 IS CLEARED PRIOR TO THE COPY PROCESS C020280000C IF THE FILE IS AN INDEXED FILE,OR THE SECTOR ALIGNMENT IS C0202810C NOT EQUAL,THE COPY IS DONE ON A RECORD BASES C0202820C IF THE FILE IS SEQUENTIAL AND THE SECTOR ALIGNMENT OF BOTH C0202830C FILES IS EQUAL,THE COPY IS BLOCKED DEPENDING UPON RECORD-SIZE C0202840C RECORDS ARE OBTAINED USING THE GETS FILE-MANAGER REQUEST C0202850C IN CASE OF AN SEQUENTIAL FILE,THE COPY IS DONE USING PUTS REQUEST C0202860C ELSE THE PRIMARY KEY-VALUE IS EXTRACTED FROM THE RECORDBUFFER(RECBC020287000C AND STORED INTO THE VARIABLE KEYVAL C0202880C NEXT A WRITER REQUEST IS PERFORMED C0202890C COPY STOPS AT DETECTION OF AN EOF AND BOTH FILES ARE CLOSED C0202900C *****************************************************'******* 122*4868C0202910C C0202920C COMMAND FORMAT C0202930C C020294000C COPY,FN=AAAAAAAA,VL=AAAAAAAA,F2=AAAAAAAA,OW=BBBBBBBB,V2=BBBBBBBC0202950C C0202960C COPY,AAAAAAAA,VVVVVVVV,BBBBBBBB,OOOOOOOO,BBBBBBBB C0202970C C0202980M FMUCOM C0202990. C0203000C C020301000 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C0203020 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C0203030 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C0203040 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C0203050 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C0203060 INTEGER OPN,WVL C0203070 INTEGER RECBUF C020308000 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C0203090 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1,IDATA(24) C0203100C ************************************************************* 122*4868C0203110 INTEGER BUFSIZ,SECLEN,FMRDEL C0203120C ************************************************************* 122*4868C0203130C C0203140 DIMENSION IPNAM(17) C020315000 DIMENSION IREQ(17) C0203160 DIMENSION IFND(17) C0203170 DIMENSION NAME(30) C0203180 DIMENSION NAME12(4) C0203190 DIMENSION OWNR12(4) C0203200 DIMENSION KEYVAL(15) C0203210C ************************************************************* 122*4868C020322000 DIMENSION RECBUF(4002) C0203230C ************************************************************* 122*4868C0203240C C0203250 EQUIVALENCE (PPCOPY,PPTAB) C0203260 EQUIVALENCE (CPRECL,CPFCB(1)) C0203270 EQUIVALENCE (CPFIND,CPFCB(6)) C0203280 EQUIVALENCE (CPLEN1,CPFCB(15)) C020329000 EQUIVALENCE (CPPOS1,CPFCB(16)) C0203300 BYTE (IDEL,ISTAT(4=4)) C0203310. C0203320C C0203330C FILE CONTROL BLOCK C0203340C C0203350 EQUIVALENCE (RECLEN,FCBBUF(1)) C020336000 EQUIVALENCE (TDATRM,FCBBUF(2)) C0203370 EQUIVALENCE (TDATRL,FCBBUF(3)) C0203380 EQUIVALENCE (DATBAM,FCBBUF(4)) C0203390 EQUIVALENCE (DATBAL,FCBBUF(5)) C0203400 EQUIVALENCE (FCBIND,FCBBUF(6)) C0203410 EQUIVALENCE (NEDATM,FCBBUF(7)) C0203420 EQUIVALENCE (NEDATL,FCBBUF(8)) C020343000 EQUIVALENCE (NEXTBM,FCBBUF(9)) C0203440 EQUIVALENCE (NEXTBL,FCBBUF(10)) C0203450 EQUIVALENCE (TNKEYM,FCBBUF(11)) C0203460 EQUIVALENCE (TNKEYL,FCBBUF(12)) C0203470 EQUIVALENCE (KEYBAM,FCBBUF(13)) C0203480 EQUIVALENCE (KEYBAL,FCBBUF(14)) C0203490 EQUIVALENCE (LENKY1,FCBBUF(15)) C020350000 EQUIVALENCE (POSKY1,FCBBUF(16)) C0203510 EQUIVALENCE (LENKY2,FCBBUF(17)) C0203520 EQUIVALENCE (LENKY3,FCBBUF(19)) C0203530 EQUIVALENCE (LENKY4,FCBBUF(21)) C0203540 EQUIVALENCE (TSFILM,FCBBUF(23)) C0203550 EQUIVALENCE (TSFILL,FCBBUF(24)) C0203560 EQUIVALENCE (NAME12,FCBBUF(25)) C020357000 EQUIVALENCE (OWNR12,FCBBUF(29)) C0203580 EQUIVALENCE (EXPDAT,FCBBUF(89)) C0203590 EQUIVALENCE (CRTDAT,FCBBUF(92)) C0203600 EQUIVALENCE (FTYPE,FCBBUF(95)) C0203610C C0203620C EXTERNALS C0203630C C020364000 EXTERNAL WTREAD C0203650 EXTERNAL SYSMSG C0203660 EXTERNAL OPENFL C0203670 EXTERNAL GETFCB C0203680C C0203690C C0203700 BYTE (IFND,PPTEMP(15=15)) C020371000 BYTE (IREQ,PPTEMP(12=12)) C0203720 BYTE (IPNAM,PPTEMP(7=0)) C0203730C C0203740 BYTE (OPN,ISTAT(0=0)) C0203750 BYTE (NFD,ISTAT(1=1)) C0203760 BYTE (LOK,ISTAT(2=2)) C0203770 BYTE (IRLOK,ISTAT(3=3)) C020378000 BYTE (INUNK,ISTAT(4=4)) C0203790 BYTE (MME,ISTAT(5=5)) C0203800 BYTE (IEOF,ISTAT(8=8)) C0203810 BYTE (IWKY,ISTAT(9=9)) C0203820 BYTE (IFE,ISTAT(10=10)) C0203830 BYTE (MFOS,ISTAT(11=11)) C0203840 BYTE (MFO,ISTAT(12=12)) C020385000 BYTE (IOUT,ISTAT(12=12)) C0203860 BYTE (WVL,ISTAT(13=13)) C0203870 BYTE (ILR,ISTAT(14=14)) C0203880C C0203890 DATA NAME/'FILE-NAME 1=VOLUME-NAME=FILE-NAME 2=OWNER-NAME =VOLUME-C0203900 *NAME='/ C0203910 DATA NOCUR/-1/,ZRO/0/ C020392000 DATA BUFLEN/40/ C0203930 DATA BLANK/$2020/ C0203940 DATA QUEST/'? '/ C0203950C ************************************************************* 122*4868C0203960 DATA BUFSIZ/4000/ C0203970 DATA SECLEN/96/ C0203980 DIMENSION ISAVB1(10),ISAVB2(10) C020399000 INTEGER ONE(2) C0204000 DATA ONE/0,1/ C0204010C*** C0204020C ************************************************************* 122*4868C0204030. C0204040C C0204050C INITIALISATION C020406000C C0204070 IFTSW=0 C0204080 11 INDEX=0 C0204090+ ERROR MSG NO. C0204100 ERBUF=0 C0204110+ ERROR MSG BUF C0204120 ISTAT=0 C020413000+ STATUS OF FM-REQUEST C0204140 LNGO=0 C0204150+ LENGTH OF FIELD TO MOVE C0204160 MORPAR=0 C0204170+ INDICATOR IF MORE PARAMETERS NEEDED C0204180 MORLIN=0 C0204190+ INDICATOR IF MORE LINES NEED TO BE READ C020420000 PARNUM=0 C0204210+ COUNT OF REQ.AND NOT FOUND PARAMETERS C0204220 PARID=0 C0204230 IFLAG=0 C0204240 IP=1 C0204250C ************************************************************* 122*4868C0204260 ASSEM $E0E9,$E21F,$C20D,$6800,IFMDEL C0 0427000C *********************'*************************************** 122*4868C0204280C C0204290 ASSIGN 9998 TO INTLOC C0204300 CALL PGMINT(INTLOC,IFLAG) C0204310C C0204320C C0204330C C020434000 20 DO 30 I=1,24 C0204350 REQBUF(I)=0 C0204360 CPREQ(I)=0 C0204370C C0204380 30 CONTINUE C0204390C C0204400C C020441000C SET UP DEFAULT VALUE FOR NO. OF RECORD TO BE PROCESSED C0204420C C0204430C C0204440C C0204450C SET UP OPEN FILE CONDITION ACCORDINGLY C0204460C C0204470 ASSEM $C000,+FCBHDR C020448000 ASSEM $6400,+REQBUF(10) C0204490 ASSEM $C000,+CPHDR C0204500 ASSEM $6800,CPREQ(10) C0204510 REQBUF(13) = 96 C0204520 CPREQ (13) = 96 C0204530 IDATA (13) = 0 C0204540 CPDAT (13) = 0 C020455000 IDATA (14) = 1 C0204560 CPDAT (14) = 1 C0204570 IDATA (15) = -2 C0204580 CPDAT (15) = -2 C0204590C C0204600 CALL OPENFL(REQBUF,IDATA,ISTAT) 04610C C020462000 CALL OPENFL(CPREQ,CPDAT,ISTAT) 04630 450 CPVOL=CPDAT(9) C0204640 IVOL=IDATA(9) C0204650 IDATA(9)=0 C0204660 CPDAT(9)=0 C0204670C C0204680 CALL GETFCB (CPREQ,CPDAT(9),INDEX,CPFCB,ISTAT) C020469000 IF (IOUT-1) 460,8000,8000 C0204700 460 IF(ISTAT) 8010,470,470 C0204710C C0204720 470 CALL GETFCB (REQBUF,IDATA(9),INDEX,FCBBUF,ISTAT) C0204730 IF ( (IOUT .EQ. 1) .OR. (ISTAT .LT. 0) ) GO TO 8000 C0204740 CALL CLOSFL (REQBUF,ISTAT) C0204750 IF (ISTAT) 8000,500,500 C020476000C C0204770 500 CALL CLOSFL (CPREQ,ISTAT) C0204780 IF(ISTAT) 8010,510,510 C0204790C C0204800 510 IDATA(9)=IVOL C0204810 CPDAT(9)=CPVOL C0204820C ************************************************************* 122*4864C020483000C IF NO USER ID PARAMETER WAS ENTERED, MAKE THE ID COMMON C0204840C C0204850C ************************************************************* 122*4864C0204860C C0204870C CHECK IF BOTH FILE-TYPES ARE EQUAL C0204880C C0204890 IF (RECLEN .NE. CPRECL) GO TO 8220 C020490000C **************************************************************122*4868C0204910 IF(RECLEN .GT. BUFSIZ) GO TO 8240 C0204920C *********************'*******************************'******* 122*4868C0204930C C0204940 IPWIND=AND(FCBIND,$1) C0204950 CPWIND=AND(CPFIND,$1) C0204960C C020497000 IF (CPWIND .NE. IPWIND) GO TO 8230 C0204980 IF(FTYPE .NE. CPFCB(95)) GO TO 8230 C0204990C C0205000C ASSURE FILE'S SECTOR ALIGNMENTS ARE IDENTICAL C0205010C C0205020 IF (AND(FCBIND,$8000) .NE. AND(CPFIND,$8000)) GO TO 8230 C0205030C C020504000C ASSURE KEY DEFINITIONS ARE IDENTICAL C0205050C C0205060 DO 512 I = 15,22 C0205070 IF (FCBBUF(I).NE.CPFCB(I)) GO TO 8230 C0205080 512 CONTINUE C0205090 IF (FCBBUF(6).NE.CPFCB(6)) GO TO 8230 C0205100C C020511000C C0205120 ASSEM $C000,+FCBHDR C0205130 ASSEM $6400,+REQBUF(10) C0205140 ASSEM $C000,+CPHDR C0205150 ASSEM $6800,CPREQ(10) C0205160 REQBUF(13) = 96 C0205170 CPREQ (13) = 96 C020518000 CALL OPENFL( REQBUF(1), IDATA(1), ISTAT) C0205190 IF (ISTAT .LT. 0) GO TO 8000 C0205200 CALL OPENFL(CPREQ(1), CPDAT(1), ISTAT) C0205210 IF (ISTAT .LT. 0) GO TO 8010 C0205220C C0205230C TRANSFER THE FILE'S RECORD SPACE FIRST C0205240C C020525000C SAVE FIRST 10 WORDS OF EACH FILE'S FCB C0205260C C0205270 515 CONTINUE C0205280 DO 520 I = 1,10 C0205290 ISAVB1(I) = FCBBUF(I) C0205300 520 ISAVB2(I) = CPFCB(I) C0205310C C020532000C SET NUMBER OF RECORDS FOR READ C0205330C C0205340 NUMREC = BUFSIZ / RECLEN C0205350C C0205360C** CALCULATE SECTOR ALIGNED BLOCKING IF NEEDED C0205370C C0205380 IF (AND(FCBIND ,$8000) .EQ. 0) GO TO 521 C020539000 NUMSEC = RECLEN / SECLEN C0205400 IF ( (NUMSEC * SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C0205410 NUMREC = BUFSIZ / (SECLEN * NUMSEC) C0205420 521 CONTINUE C0205430 CPREQ(13) = NUMREC C0205440C C0205450C REDEFINE BOTH FILES AS SEQUENTIAL - IF INDEXED C020546000C C0205470 FCBBUF(6) = AND($FFFE,FCBBUF(6)) C0205480 CPFCB(6) = AND($FFFE,CPFCB(6)) C0205490C C0205500C TRANSFER RECORDS TILL EOF REACHED C0205510C C0205520 IDONE = 0 C020553000 525 CALL GETS(CPREQ,RECBUF,KEYVAL,ISTAT) C0205540 NUMOUT = CPREQ(15) C0205550 IF (IEOF .NE. 0) GO TO 540 C0205560 IF (ISTAT)8010,530,530 C0205570C C0205580 530 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C0205590 IF (ISTAT) 8000,535,535 C020560000 535 IF (IOUT .NE. 1) GO TO 525 C0205610 537 CONTINUE C0205620 INDEX = 55 C0205630 GO TO 9999 C0205640C C0205650C EOF FOUND C0205660C C020567000 540 IF (ISTAT.LT. 0) GO TO 550 C0205680 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C0205690 IF (ISTAT) 8000,545,545 C0205700 545 CONTINUE C0205710 IF (IOUT .EQ. 1) GO TO 537 C0205720C C0205730C CHECK IF FILES ARE INDEXED, IF YES, COPY INDEX SPACE C020574000C C0205750 550 IF (IPWIND.EQ.0) GO TO 9998 C0205760C C0205770C REDEFINE FCBS TO HAVE 3 SECTOR LONG RECORDS, RECORD SPACE STARTINGC0205780C AT INDEX SPACE, TOTAL NUMBER OF RECORDS EQUAL TO TOTAL NUMBER C0205790C OF KIBS AND EXISTING NUMBER OF RECORDS IN INPUT FILE TO NUMBER OF C0205800C KIBS USED. C020581000C C0205820 FCBBUF(1) = 288 C0205830 FCBBUF(2) = FCBBUF(11) C0205840 FCBBUF(3) = FCBBUF(12) C0205850 FCBBUF(4) = FCBBUF(13) C0205860 FCBBUF(5) = FCBBUF(14) C0205870 FCBBUF(7) = 0 C020588000 FCBBUF(8) = 0 C0205890 CPFCB(1) = 288 C0205900 CPFCB(2) = CPFCB(11) C0205910 CPFCB(3) = CPFCB(12) C0205920 CPFCB(4) = CPFCB(13) C0205930 CPFCB(5) = CPFCB(14) C0205940 CALL FDWSUB (CPFCB(09),ONE,CPFCB(7),ISTAT) C020595000C C0205960C SET NUMBER OF RECORDS FOR I/O C0205970C C0205980 NUMREC = BUFSIZ / 288 C0205990 CPREQ(13) = NUMREC C0206000C C0206010C INITIALIZE CPREQ FOR NEW GETS CALLS C020602000C C0206030 DO 555 I = 15,20 C0206040 555 CPREQ(I) = 0 C0206050C C0206060C TRANSFER KIBS TILL EOF REACHED C0206070C C0206080 560 CALL GETS (CPREQ,RECBUF,KEYVAL,ISTAT) C020609000 NUMOUT = CPREQ(15) C0206100 IF (IEOF .NE. 0) GO TO 575 C0206110 IF (ISTAT) 700,565,565 C0206120C C0206130 565 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C0206140 IF (ISTAT) 705,570,570 C0206150 570 IF (IOUT .NE. 1) GO TO 560 C020616000 GO TO 590 C0206170C C0206180C EOF FOUND C0206190C C0206200 575 IF (ISTAT.LT.0) GO TO 710 C0206210 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C0206220 IF (ISTAT) 705,580,580 C020623000 580 IF (IOUT .NE. 1) GO TO 710 C0206240 590 CONTINUE C0206250 INDEX = 55 C0206260 IDONE = 3 C0206270 GO TO 710 C0206280C C0206290C C020630000C ERROR NOTED ON FM CALL - INPUT FILE C0206310C C0206320 700 IDONE = 1 C0206330 GO TO 710 C0206340C C0206350C ERROR NOTED ON FM CALL - OUTPUT FILE C0206360C C020637000 705 IDONE = 2 C0206380C C0206390C RESTORE INPUT FILE C0206400C C0206410 710 DO 715 I = 1,10 C0206420 715 CPFCB(I) = ISAVB2(I) C0206430C C020644000C RESTORE FIRST PART OF OUTPUT FILE FCB C0206450C C0206460 DO 720 I = 1,8 C0206470 720 FCBBUF(I) = ISAVB1(I) C0206480C C0206490C PROCESS ERROR IF REQUIRED C0206500C C020651000 GO TO ( 725,8010,8000,9999),IDONE + 1 C0206520C C0206530C SET UP OUTPUT FILE'S FCB C0206540C C0206550 725 CONTINUE C0206560 DO 730 I = 7,10 C0206570 730 FCBBUF(I) = CPFCB(I) C020658000 GO TO 9998 C0206590C C0206600C C0206610C FM-REQUEST TERMINATED WITH AN ERROR C0206620C C0206630C C0206640C********** CLOSE FILE AND NO ERROR CHECK , DUE TO ERROR C020665000C C0206660 8000 CONTINUE C0206670 CALL CLOSFL( REQBUF(1), IP) C0206680 GO TO 9993 C0206690C C0206700 8220 INDEX=65 C0206710+ 65 RECORD LENGTH NOT EQUAL C020672000 GO TO 9999 C0206730 8230 INDEX=66 C0206740+ 66 FILE TYPE NOT EQUAL C0206750 GO TO 9999 C0206760C C0206770C ************************************************************* 122*4868C0206780 8240 INDEX=64 C020679000+ 64 RECORD LENGTH TOO LARGE C0206800 GO TO 9999 C0206810C C0206820C ************************************************************* 122*4868C0206830 8010 CONTINUE C0206840 CALL CLOSFL( CPREQ(1), IP) C0206850 GO TO 9993 C020686000C C0206870C ERROR ROUTINE C0206880C C0206890 9999 CALL SYSMSG (INDEX,ERBUF) C0206900C C0206910 9993 IF (PIND) 9994,9994,11 C0206920 9994 IF (MODE) 9995,9998,9995 C020693000 9995 ASSEM $E400,+MODE C0206940 ASSEM $D622 C0206950C C0206960 9998 CALL CLOSFL(REQBUF,ISTAT) C0206970 9996 CALL CLOSFL (CPREQ,ISTAT) C0206980 9997 RETURN C0206990 END C020700000 MON 07010*ASSEM 07020 NAM FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122F3607030* FORTRAN INTERFACE TO DOUBLE WORD ADD/SUBTRACT/MULTIPLY F3607040* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 F3607050* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3607060* COPYRIGHT CONTROL DATA CORPORATION 1977 F360707000* F3607080**** F3607090* F3607100* THIS ROUTINE PROVIDES A FORTRAN INTERFACE TO THE FILE MANAGER F3607110* DOUBLE WORD MATH ROUTINES. F3607120* F3607130* CALLING SEQUENCES: F360714000* CALL FDWADD (OP1, OP2, RESULT, OV) F3607150* CALL FDWSUB (OP1, OP2, RESULT, OV) F3607160* CALL FDWMUI (OP1, OP3, RESULT, OV) F3607170* F3607180* PARAMETERS: F3607190* OP1 - FIRST OPERAND (MSB/LSB) F3607200* OP2 - SECOND OPERAND (MSB/LSB) (SUBTRAHEND) F360721000* OP3 - SINGLE WORD OPERAND F3607220* RESULT - COMPUTATION RESULT (MSB/LSB) F3607230* OV - OVERFLOW INDICATOR: F3607240* =0 IF NONE OCCURRED F3607250* =1 IF ONE DID OCCUR F3607260* F3607270* ENTRY POINTS F360728000* F3607290 ENT FDWADD FORTRAN INTERFACE FOR DOUBLE WORD ADD F3607300 ENT FDWSUB FORTRAN INTERFACE FOR DOUBLE WORD SUBTRACT F3607310 ENT FDWMUI FORTRAN INTERFACE FOR DOUBLE WORD MULTIPLY F3607320* F3607330* EXTERNALS F3607340* F360735000 EXT Q8PREP PREPARE TO PICKUP PARAMETERS F3607360 EXT Q8PKUP PICKUP ABSOLUTIZED PARAMETER ADDRESS F3607370 EXT DWADD DOUBLE WORD ADD ROUTINE F3607380 EXT DWSUB DOUBLE WORD SUBTRACT ROUTINE F3607390 EXT DWMUL DOUBLE WORD MULTIPLY ROUTINE F3607400**** F3607410* F360742000* EQUIVALENCES F3607430* F3607440 EQU ZERO(2) SYSTEM ZERO F3607450 EJT F3607460FDWADD ADC 0 ENTRY FOR ADD F3607470 LDA* FDWADD F3607480 STA* FDWMUI TRANSFER PARAMETER ADDRESS F360749000 ENA 0 F3607500 STA* OPTYPE SET OPERATOR CODE TO ADD F3607510 JMP* CONTIN F3607520* F3607530FDWSUB ADC 0 ENTRY FOR SUBTRACT F3607540 LDA* FDWSUB F3607550 STA* FDWMUI TRANSFER PARAMETER ADDRESS F360756000 ENA 3 F3607570 STA* OPTYPE SET OPERATOR CODE TO SUBTRACT F3607580 JMP* CONTIN F3607590* F3607600FDWMUI ADC 0 ENTRY FOR MULTIPLY F3607610 ENA 6 F3607620 STA* OPTYPE SET OPERATOR CODE TO MULTIPLY F360763000 EJT F3607640CONTIN STQ* QSAVE SAVE Q-REG F3607650 LDA- I SAVE I-REG F3607660 STA* ISAVE F3607670* F3607680 RTJ Q8PREP ABSOLUTIZE PARAMETERS FOR F.M. ROUTINES F3607690 ADC* FDWMUI F360770000ADR RTJ Q8PKUP F3607710 TRA Q F3607720 LDA- (ZERO),Q F3607730 STA* PLIST OP1 MSB F3607740 LDA- 1,Q F3607750 STA* PLIST+1 OP1 LSB F3607760 RTJ* (ADR+1) F360777000 TRA Q F3607780 LDA- (ZERO),Q F3607790 STA* PLIST+2 OP2 (MSB) OR OP3 F3607800 LDA* OPTYPE LIST FORMAT DIFFERS FOR ADD/SUB AND MUI F3607810 INA -6 F3607820 SAM ADDSUB F3607830 RTJ* (ADR+1) F360784000 STA* RESULT ADDRESS OF RESULT F3607850 RTJ* (ADR+1) F3607860 STA* OVADR OVERFLOW STATUS ADDRESS F3607870 JMP* COMPUT F3607880* F3607890ADDSUB LDA- 1,Q F3607900 STA* PLIST+3 OP2 (LSB) F360791000 RTJ* (ADR+1) F3607920 STA* RESULT ADDRESS OF RESULT F3607930 RTJ* (ADR+1) F3607940 STA* OVADR OVERFLOW STATUS ADDRESS F3607950 EJT F3607960COMPUT LDQ =XPLIST GO CALL APPROPRIATE ROUTINE F3607970 LDA* OPTYPE F360798000 STA- I F3607990 NUM $1901 F3608000* F3608010 RTJ DWADD ADD F3608020 JMP* RET F3608030 RTJ DWSUB SUBTRACT F3608040 JMP* RET F360805000 RTJ DWMUL MULTIPLY F3608060 EJT F3608070RET LDQ* RESULT RETURN RESULT TO CALLER F3608080 LDA* OPTYPE F3608090 INA -6 F3608100 SAM AS F3608110 LDA* PLIST+3 F360812000 STA- (ZERO),Q F3608130 LDA* PLIST+4 F3608140 STA- 1,Q F3608150 LDA* PLIST+5 F3608160 JMP* EXIT F3608170* F3608180AS LDA* PLIST+4 F360819000 STA- (ZERO),Q F3608200 LDA* PLIST+5 F3608210 STA- 1,Q F3608220 LDA* PLIST+6 F3608230 SPC 3 F3608240EXIT STA* (OVADR) RETURN OVERFLOW STATUS F3608250 LDQ* QSAVE RESTORE Q AND I REGISTERS F360826000 LDA* ISAVE F3608270 STA- I F3608280 JMP* (FDWMUI) RETURN TO CALLER F3608290 SPC 3 F3608300PLIST BZS PLIST(7) F3608310QSAVE NUM 0 F3608320ISAVE NUM 0 F360833000RESULT NUM 0 F3608340OVADR NUM 0 OVERFLOW STATUS ADDRESS F3608350OPTYPE NUM 0 F3608360 END F3608370 NAM NDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122A3608380* DOUBLE-WORD MATH SUBROUTINES - NONREETRANT VERSION A3608390* CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 A360840000* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3608410* COPYRIGHT CONTROL DATA CORPORATION 1977 A3608420* A3608430* A3608440* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM A3608450* THREE DOUBLE WORD ARITHMETIC OPERATIONS. A3608460* THE DOUBLE WORD FORMAT IS THE SAME AS THE A360847000* MSB/LSB FORMAT USED FOR SECTOR AND WORD A3608480* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE A3608490* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN A3608500* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS A3608510* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). A3608520* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO A3608530* 'DOUBLE WORD VALUE'. A360854000* A3608550* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: A3608560* ADD A DWV TO A 2ND DWV A3608570* SUBTRACT A DWV FROM ANOTHER DWV A3608580* MULTIPLE A DWV BY A SINGLE WORD VALUE A3608590* A3608600* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER A360861000* STORES THE VALUES TO BE OPERATED ON IN AN A3608620* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF A3608630* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- A3608640* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE A3608650* SAVED AND RESTORED PRIOR TO RETURN TO THE A3608660* CALLER. THE COMPLETION STATUS WILL BE 0 IF A3608670* GOOD, ELSE IT WILL BE NON-ZERO. A360868000* A3608690* THE ENTRY POINT NAMES ARE AS FOLLOWS: A3608700 ENT DWADD DOUBLE WORD ADD A3608710 ENT DWSUB DOUBLE WORD SUBTRACT A3608720 ENT DWMUL DOUBLE WORD MULTIPLY A3608730* A3608740 EQU ZERO($22) A360875000 EQU ONEMSK(3) A3608760 EQU ONEBIT($23) A3608770 EJT A3608780* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: A3608790* FOR DWADD A3608800* WORD DESCRIPTION A3608810* 1 MSB OF 1ST DWV A360882000* 2 LSB OF 1ST DMV A3608830* 3 MSB OF 2ND DMV A3608840* 4 LSB OF 2ND DMV A3608850* 5 MSB OF RESULT DMV A3608860* 6 LSB OF RESULT DMV A3608870* 7 COMPLETION STATUS A3608880* A360889000* FOR DWSUB A3608900* WORD DESCRIPTION A3608910* 1 MSB OF MINUEND A3608920* 2 LSB OF MINUEND A3608930* 3 MSB OF SUBTRAHEND A3608940* 4 LSB OF SUBTRAHEND A3608950* 5 MSB OF RESULT A360896000* 6 LSB OF RESULT A3608970* 7 COMPLETION STATUS A3608980* FOR DWMUL A3608990* WORD DESCRIPTION A3609000* 1 MSB OF DWV A3609010* 2 LSB OF DMV A3609020* 3 SINGLE WORD VALUE A360903000* 4 MSB OF RESULT A3609040* 5 LSB OF RESULT A3609050* 6 COMPLETION STATUS A3609060* A3609070 EJT A3609080DWADD 000 000 DOUBLE WORD ADD ROUTINE A3609090A1 LDA- I SAVE I-REG CONTENTS A360910000 STA* ISAVE A3609110 STQ- I SET I TO ARRAY ADDRESS A3609120 LDA- 1,I SET A TO LSB A3609130 ENQ 0 CLEAR Q FOR USE AS MSB OFFSET A3609140 SOV 0 CLEAR OVERFLOW STATUS A3609150 ADD- 3,I ADD LSB A3609160 SNO A2 SKIP TO A3 IF NO OVERFLOW A360917000 AND- ONEMSK+14 MASK OUT BIT 15 A3609180 INQ 1 BUMP Q TO PUT OVERFLOW IN MSB A3609190A2 SAP A3 SKIP IF RESULT POSITIVE A3609200 INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET A3609210 ADD- ONEBIT+15 MAKE LSW POSITIVE A3609220A3 STA- 5,I STORE LSB A3609230 TRQ A TRANSFER MSB OFFSET TO A A360924000 SOV 0 CLEAR OVERFLOW A3609250 ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET A3609260 ADD- 2,I A3609270 STA- 4,I STORE MSB A3609280 ENQ 0 CLEAR Q FOR COMPLETION STATUS A3609290 SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEGA3609300 SAP A5 A360931000A4 ENQ 1 A3609320A5 STQ- 6,I A3609330 LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US A3609340 SAP A6 SKIP IF NOT COMPLEMENTED A3609350 TCA A A3609360 STA- 2,I A3609370 LDA- 3,I A360938000 TCA A A3609390 STA- 3,I A3609400A6 LDA* ISAVE RESTORE I-REG A3609410 STA- I A3609420 JMP* (DWADD) A3609430 SPC 4 A3609440ISAVE NUM 0 A360945000 EJT A3609460DWSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE A3609470 LDA* DWSUB A3609480 STA* DWADD STORE RETURN ADDRESS IN DWADD'S ENTRY POINT A3609490 LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DWADD TO ADD A3609500 TCA A A3609510 STA- 2,Q A360952000 LDA- 3,Q A3609530 TCA A A3609540 STA- 3,Q A3609550 JMP* A1 A3609560 EJT A3609570DWMUL 000 000 DOUBLE WORD MULTIPLY A3609580 LDA- I A360959000 STA* ISAVE SAVE I-REG A3609600 STQ- I SET I TO ARRAY ADDRESS A3609610 LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE A3609620 MUI- 2,I MULTIPLY BY SINGLE WORD VALUE A3609630 LLS 1 A3609640 ALS 15 CONVERT TO DOUBLE PRECISION FORMAT A3609650 STQ* SAVE SAVE MSB A360966000 STA- 4,I STORE LSB IN RESULT A3609670 LDA- (ZERO),I A3609680 MUI- 2,I MULTIPLY MSB BY SINGLE WORD A3609690 LLS 1 A3609700 ALS 15 DOUBLE PRECISION FORMAT A3609710 SOV 0 CLEAR OVERFLOW A3609720 INQ 0 CHECK FOR OVERFLOW A360973000 SQZ 2 A3609740 LDQ- $11 SET OVERFLOW IND A3609750 INQ 1 A3609760 LDQ* SAVE ADD MSB THAT WAS SAVED A3609770 AAQ Q ADD IN RESULT FROM MSB MULTIPLY A3609780 STQ- 3,I STORE IN RESULT A3609790 CLR A A360980000 SOV M0 SKIP IF OVERFLOW A3609810 SQP M1 A3609820M0 INA 1 A3609830M1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD A3609840 LDA* ISAVE RESTORE I-REG A3609850 STA- I A3609860 JMP* (DWMUL) RETURN TO CALLER A360987000 SPC 2 A3609880SAVE NUM 0 A3609890 END A3609900_ 00 __ 0( TFMOVEIDDRG P&999999060381(0 PROGRAM MOVEID C0 00010 INTEGER ID(4),VOL1(5),VOL2(5),IBLK1(24),IBLK2(24),FCBBFR(96) 00020 INTEGER MSG1(24),MSG2(24),MSG3(20),MSG4(3),MSG5(12),REQBUF(24) 00030 INTEGER DOLLAR,FLAG,COMPAR,CPFCB(96),CPREQ(24),TEMP(3),OPNPAR(3) 00040 INTEGER MSG6(18),FNAME(5),SYSVOL(4),DID(5),MSG7(25),CTLD,RUBOUT 00050 INTEGER MSG8(10),RETURN,MSG9(23),IANS(3),FLAG1,IVIT(24) 000602 C0 0007000 DATA INDX/0/,ICLR/$2018/,DOLLAR/'$$'/,OPNPAR/0,1,0/ C0 00080 DATA MSG1/'ENTER FROM VOLUME: (DEFAULT IS SYSVOL)'/, 00090 * MSG2/'ENTER VOLUME : (DEFAULT IS SYSVOL)'/, 00100 * MSG3/' FILE AAAAAAAA/ BBBBBBBB CANNOT BE MOVED'/, C0 00110 * MSG4/'PAUSE'/,RUBOUT/4/,CTLD/6/,RETURN/2/, C0 00120 * MSG5/'AAAAAAAA/ BBBBBBBB MOVED'/ C0 00130 DATA MSG6/'FILE TO BE MOVED (CR FOR ALL FILES)'/, 0014000 * MSG8/$2016,'AAAAAAAA/ BBBBBBBB'/, 00150 * MSG9/'OK TO MOVE, ALL FOR MOVE WITH NO VERIFICATION'/, 00160 * SYSVOL/'SYSVOL '/, 00170 * MSG7/'ENTER TO ID: (DEFAULT IS LOGON ID)'/ 001803 C0 00190 CALL PGMIN(ID,LU,MODE,NOPORT) 00200 CALL MOVE(ID,IBLK1(5),4) 0021000 CALL WTREAD(LU,-1,ICLR,2,0,0,0,0) 0022010 CALL BLANK(VOL1,4) 00230 VOL1(5)=0 00240 CALL WTREAD(LU,$0000,MSG2,48,19*$100,VOL1,8,ITC) 00250 IF(ITC.EQ.RUBOUT)GOTO 10 00260 IF(ITC.EQ.CTLD)GOTO 900 00270 IF(VOL1(5).EQ.0)CALL MOVE(SYSVOL,VOL1,4) 0028000 CALL MOVE(VOL1,IBLK1(9),4) 00290 CALL MOVE(VOL1,IBLK2(9),4) 00300 FLAG=0 C0 00310 FLAG1=0 00320 IF((ID(1).EQ.DOLLAR).AND.(NOPORT.EQ.0))FLAG=1 0033025 CALL BLANK(DID,4) 00340 DID(5)=0 0035000 CALL WTREAD(LU,$0004,MSG7,50,19*$100+4,DID,8,ITC) 00360 IF(ITC.EQ.RUBOUT)GOTO 25 00370 IF(ITC.EQ.CTLD)GOTO 900 00380 IF(DID(5).EQ.0)CALL MOVE(ID,DID,4) 00390 CALL WTREAD(LU,-1,ICLR,2,0,0,0,0) 00400 IF(FLAG.EQ.1)GOTO 30 C0 00410 CALL BLANK(MSG3(9),4) C0 0042000 CALL BLANK(MSG5(6),4) C0 0043030 LINE=0 C0 00440 ASSIGN 900 TO INTLOC C0 00450 CALL PGMINT(INTLOC,IDUM1) C0 00460 ASSIGN 40 TO IRETN 0047040 IF(LINE.GT.20)GOTO 200 0048050 CALL BLANK(FNAME,4) 0049000 FNAME(5)=0 00500 CALL WTREAD(LU,LINE,MSG6,36,37*$100+LINE,FNAME,8,ITC) 00510 IF(ITC.EQ.RUBOUT)GOTO 50 00520 IF(ITC.EQ.CTLD)GOTO 900 00530 LINE=LINE+1 00540 IF(FNAME(5).NE.0)GOTO 300 00550 ASSIGN 100 TO IRETN 0056000 INDX=0 00570 IVOL=1 0058055 CALL GETVIT(IVOL,IVIT) 00590 IF(COMPAR(VOL1,IVIT(2),4).NE.0)GOTO 60 00600 IF(IVIT(1).EQ.0)GOTO 102 00610 IVOL=IVOL+1 00620 GOTO 55 006300060 NUMFIL=0 00640 MAXFIL=IVIT(18) 00650. C0 00660100 INDX=INDX+1 C0 00670 CALL GETVIT(IVOL,IVIT) 00680 IF(IVIT(18).GT.MAXFIL)MAXFIL=IVIT(18) 00690 IF(NUMFIL.GE.MAXFIL)GOTO 900 0070000 CALL ZERO(REQBUF,24) C0 00710 CALL GETFCB(REQBUF,VOL1,INDX,FCBBFR,ISTAT) C0 00720 IF(AND(ISTAT,$1000).NE.0)GOTO 900 00730 IF(AND(ISTAT,$6FFF).EQ.0)GOTO 101 C0 00740102 CALL SYSMSG(36,IDUM) C0 00750 GOTO 900 00760101 IF(FCBBFR(25).EQ.0)GOTO 100 C0 0077000 NUMFIL=NUMFIL+1 00780110 IF(FLAG.EQ.1)GOTO 115 C0 00790 IF(COMPAR(ID,FCBBFR(29),4).EQ.0)GOTO 100 C0 00800115 IF(FLAG1.EQ.1)GOTO 117 00810 CALL MOVE(FCBBFR(25),MSG8(2),4) 00820 CALL MOVE(FCBBFR(29),MSG8(7),4) 00830116 CALL BLANK(IANS,2) 0084000 CALL WTREAD(LU,LINE+1,MSG9,46,0,0,0,0) 00850 CALL WTREAD(LU,LINE,MSG8,20,20*$100+LINE,IANS,3,ITC) 00860 IF(ITC.EQ.RUBOUT)GOTO 116 00870 IF(ITC.NE.RETURN)GOTO 900 00880 IF(LINE.LE.20)GOTO 1165 00890 ASSIGN 1168 TO IRETN 00900 GOTO 200 00910001165 LINE=LINE+1 009201168 ASSIGN 100 TO IRETN 00930 IF((IANS(1).EQ.$4F4B).AND.(IANS(3).EQ.2))GOTO 117 00940 IF((IANS(1).EQ.$414C).AND.(IANS(2).EQ.$4C20))FLAG1=1 00950 IF(FLAG1.NE.1)GOTO 100 00960117 CONTINUE C0 00970 CALL MOVE(FCBBFR(25),IBLK1(1),8) 0098000 CALL MOVE(VOL1,IBLK1(9),4) 00990 CALL MOVE(FCBBFR(25),IBLK2(1),8) C0 01000 IF( (FLAG.NE.1) .OR. (DID(5).NE.0) ) CALL MOVE(DID,IBLK2(5),4) 010101 C0 01020120 CALL ZERO(CPREQ,24) 01030 CALL RENAME(CPREQ,IBLK1,IBLK2,ISTAT) C0 01040 ASSIGN 900 TO INTLOC C0 0105000 CALL PGMINT(INTLOC,IDUM1) C0 01060 CALL MOVE(IBLK1,MSG5,4) C0 01070 IF(FLAG.EQ.1)CALL MOVE(IBLK1(5),MSG5(6),4) C0 01080 CALL WTREAD(LU,LINE,MSG5,24,0,0,0,0) C0 01090 IF(LINE.GT.20)GOTO 200 C0 01100 LINE=LINE+1 C0 01110 GOTO IRETN C0112000. C0 01130130 IF(FLAG.EQ.1)CALL MOVE(IBLK1(5),MSG3(9),4) C0 01140 CALL MOVE(IBLK1(1),MSG3(4),4) C0 01150 CALL WTREAD(LU,LINE,MSG3,40,0,0,0,0) C0 01160 IF(LINE.GT.20)GOTO 200 C0 01170 LINE=LINE+1 C0 01180 GOTO IRETN C01190002 C0 01200140 CALL SYSMSG(56,IDUM) C0 01210 GOTO 900 C0 012202 C0 01230150 CALL SYSMSG(55,IDUM) C0 01240 GOTO 900 C0 012502 C0 0126000160 CALL SYSMSG(36,IDUM) C0 01270 GOTO 900 C0 012802 C0 01290180 CALL SYSMSG(70,IDUM) C0 01300 GOTO 900 C0 013102 C0 01320200 CALL WTREAD(LU,$0017,MSG4,6,-1,REQBUF,1,ITC) C0 0133000 CALL WTREAD(LU,-1,ICLR,2,0,0,0,0) C0 01340 LINE=0 C0 01350 GOTO IRETN C013602 01370300 CALL MOVE(FNAME ,IBLK1(1),4) 01380 CALL MOVE(ID ,IBLK1(5),4) 01390 CALL MOVE(OPNPAR,IBLK1(13),3) 0140000 CALL ZERO(REQBUF,24) 01410 CALL OPENFL(REQBUF,IBLK1,ISTAT) 01420 IF(ISTAT.LT.0)GOTO 400 01430 CALL GETFCB(REQBUF,0,0,FCBBFR,ISTAT) 01440 CALL CLOSFL(REQBUF,ISTAT) C0 01450 GOTO 117 01460400 IF(AND(ISTAT,$0002).NE.0)CALL SYSMSG(34,IDUM) 0147000 IF(AND(ISTAT,$0004).NE.0)CALL SYSMSG(42,IDUM) 01480 IF(AND(ISTAT,$0200).NE.0)CALL SYSMSG(72,IDUM) 01490 IF(AND(ISTAT,$1000).NE.0)CALL SYSMSG(45,IDUM) 01500 IF(AND(ISTAT,$2000).NE.0)GOTO 160 01510 IF(AND(ISTAT,$4DF9).NE.0)GOTO 180 01520 LINE=LINE+1 01530 GOTO 40 01540002 01550900 CALL PGMOUT C0 01560 END C0 01570 SUBROUTINE MOVE(IA,IB,N) C0 01580 DIMENSION IA(1),IB(1) C0 01590 DO 10 I=1,N C0 0160010 IB(I)=IA(I) C0 0161000 RETURN C0 01620 END C0 01630 SUBROUTINE ZERO(IA,N) C0 01640 DIMENSION IA(1) C0 01650 DO 10 I=1,N C0 0166010 IA(I)=0 C0 01670 RETURN C0 0168000 END C0 01690 SUBROUTINE BLANK(IA,N) C0 01700 DIMENSION IA(1) C0 01710 DO 10 I=1,N C0 0172010 IA(I)=$2020 C0 01730 RETURN C0 01740 END C0 0175000 INTEGER FUNCTION COMPAR(IA,IB,N) C0 01760 DIMENSION IA(1),IB(1) C0 01770 COMPAR=1 C0 01780 DO 10 I=1,N C0 01790 IF(IA(I).NE.IB(I))COMPAR=0 C0 0180010 CONTINUE C0 01810 RETURN C0 0182000 END C0 01830_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2F 2TFRANF DRG P999999060381(0 REAL FUNCTION RANF(I) 00010C 00020C STANDARD FORTRAN FUNCTION *RANF* 00030C 00040C IF: 00050C I < 0 => CURRENT SEED RETURNED IN RANF 00060C I = 0 => GENERATE NEXT RANDOM NUMBER IN SEQUENCE 0007000C I > 0 => SET SEED EQUAL TO I 00080C 00090 DATA ISEED/32765/ 00100 IF(I)5,1,4 001101 ISEED=ISEED*131 00120 IF(ISEED)2,2,3 001302 ISEED=ISEED+32767 00140003 RANF=ISEED/32767. 00150900 RETURN 001604 ISEED=I 00170 GOTO 900 001805 RANF=ISEED 00190 GOTO 900 00200 END 0021000_ 00 00 00 00 __ 0P{J {NgQUINN01 JMS 999999052881P100 'BEGIN (BASIC program begins at line 220) was written by 110 'John Venable, Tuck '74. Updated by John Thomas, Tuck '80. 120 ' 130 'Description-- Part of Tuck's Business Game Package. Replaces STRAT-BX. 140 ' Saves (if necessary) and builds NAME file. Checks for the existence of, 150 ' and initializes the SCRn, REPn, and OUTn files (where n is the team 160 ' number). Uses one subprogram: BASICLIB***:OPEN 170 ' 180 ' Instructions-- Type RUN and respond to questions 190 ' 192 'Files-- NAME - names of companies 193 ' SCRn 194 ' REPn 195 ' OUTn 196 ' 200 '* * * * * * * * * * * * * * * * * * * * * 210 ' 220 LIBRARY "BASICLIB***:FILESUBS" 230 LET B1 = 0 240 DIM Z(4),Z$(10),A(36),E$(50) 250 PRINT 260 PRINT "INPUT WORLD #, NUMBER OF TEAMS"; 270 INPUT X1,X2 280 FOR I = 1 TO X2 * 3 + 2 290 LET E$(I) = "SAVED" 300 NEXT I 310 PRINT 320 PRINT "INPUT THE "; X2 ; " TEAM NAMES"; 330 MAT INPUT Z$(X2) 335 ' 340 FOR I = 1 TO X2 'For each team 350 LET N$ = Z$(I) 360 CALL "UCASE" : N$ 'Convert name to upper case 370 IF LEN(N$) = 3 THEN 400 'Is length 3 letters? 380 PRINT "LENGTH OF NAMES MUST BE 3 LETTERS" 'No; error 390 GO TO 320 400 LET Z$(I) = N$ 'Replace upper case version 410 NEXT I 415 ' 420 CALL "OPEN":#1,"NAME","","","NPRINT",N$ 430 IF N$="" THEN 480 440 CALL "OPEN":#1,"NAME","","","SAVE",N$ 450 IF N$="SAVED" THEN 480 451 IF N$="" THEN 480 455 PRINT N$ 460 PRINT "SAVE A FILE CALLED 'NAME' AND RERUN THIS PROGRAM" 'No; error 470 STOP 475 ' 480 SCRATCH #1 'Name file now open 490 MAT WRITE #1: Z$ 'Write team names into name file 500 FILE #1 : "*" 'Close name 505 ' 510 PRINT 520 PRINT "TEAM NUMBER","CODE NAME" 530 PRINT 540 LET X = 1 545 ' 550 FOR I = 1 TO X2 'For each team 555 560 PRINT I,Z$(I) 'Print team #'s and names 565 570 LET Z2$ = "SCR" & STR$(I) & ",S" & STR$(I) 580 LET Z3$ = "REP" & STR$(I) & ",R" & STR$(I) 590 LET Z4$ = "OUT" & STR$(I) & ",O" & STR$(I) 595 600 CALL "OPEN":#1,Z2$,"","","NPRINT",N$ 610 IF N$="" THEN 650 620 LET B1 = 1 'No; b1 = 1 if not all files saved properly 630 LET E$(X) = "UNSAVED" 'Flag error 640 GO TO 680 'Continue 650 IF B1 = 1 THEN 680 'If error, skip initialization 655 ' 660 WRITE #1: X1,I,0,5E5,35E4,0,0,0,0,0,2,0,0,0,5,0,0,0,0,0,15E4,0,0 'Initialize scr file 670 MAT WRITE #1:A 675 ' 680 CALL "OPEN":#1,Z3$,"","","NPRINT",N$ 690 IF N$=""THEN 850 700 LET B1 = 1 'No; error 710 LET E$(X+1) = "UNSAVED" 'Flag error 845 ' 850 CALL "OPEN":#1,Z4$,"","","NPRINT",N$ 860 IF N$="" THEN 890 870 LET B1 = 1 'No; error 880 LET E$(X+2) = "UNSAVED" 'Flag error 890 LET X = X + 3 900 NEXT I 905 ' 910 IF B1 = 1 THEN 950 'If errors occured, print report 920 PRINT 930 PRINT "THE GAME FILES ARE NOW INITIALIZED" 'Start-up is successful 940 GO TO 1160 'Exit 941 ' 942 ' ********************** 943 ' * Print Error Report * 944 ' ********************** 945 ' 950 PRINT 960 PRINT "ERROR IN INITIALIZATION..." 970 PRINT "BELOW ARE THE FILES YOU SHOULD HAVE SAVED. THOSE MARKED" 980 PRINT "'UNSAVED' ARE EITHER NOT SAVED OR ARE SAVED BUT WITH THE INCORRECT" 990 PRINT "PASSWORD. PLEASE CORRECT AND RERUN THIS PROGRAM" 1000 PRINT 1010 LET X = 1 1020 PRINT "FILE NAME","PASSWORD","CURRENT STATUS" 1030 FOR I = 1 TO X2 1040 PRINT "SCR" & STR$(I) , "S" & STR$(I) , E$(X) 1050 PRINT "REP" & STR$(I) , "R" & STR$(I) , E$(X+1) 1060 PRINT "OUT" & STR$(I) , "O" & STR$(I) , E$(X+2) 1061 PRINT "SUM" & STR$(I) 1062 PRINT "CO" & STR$(I) 1063 PRINT "DAT" & STR$(I) 1064 PRINT "MAS" & STR$(I) 1070 PRINT 1080 LET X = X + 3 1090 NEXT I 1100 PRINT "NAME","NO PASSWORD",E$(3*X2+1) 1110 CALL "OPEN":#1,"CONTROL","","","SAVE",N$ 1120 IF N$="" THEN 1140 1121 IF N$="SAVED" THEN 1140 1130 LET E$(3*X2+2) = "UNSAVED" 1140 PRINT "CONTROL","NO PASSWORD",E$(3*X2+2) 1150 PRINT 1160 END __ PRINT "CONTROL","NO PASSWORD",E$(3*X2+2) 1150 PRINT 1160 END PK5 KQUINN02 JMS 999999052881P100 ' INPUT (BASIC program begins in line 230) was written by 110 ' Jaffe, Tuck '72. Revised by Thomas, Tuck '80. 120 ' 130 ' Description--Part of the Business Game Package. Accepts and verifies 140 ' team's decision data, generates product improvements, calculates 150 ' sales probabilities, performs salesmen's calls, and stores data 160 ' to be used in STRATSUM and STRATREP (2 final summary programs). 170 ' This program replaces STRAT-IN. 180 ' 190 ' Instructions-- See Administrator's Manual 200 ' 201 'Files-- NAME - ticker symbols for teams 202 ' SCRn - input and output 203 ' REPn - Probabilities of selling + pricing and advertising data 204 ' SUMn - for STRATREP and STRATSUM 205 ' DATn - cumulative SCRn in terminal format, for recovery and rerumming 206 ' 210 ' * * * * * * * * * * * * * * * * * * * * * * 220 ' 230 RANDOMIZE 240 library "BASICLIB***:TEXTSUB" 'Contains the subroutine ucase 250 DIM X(18) 'Stores data to write in sum 260 MAT X=ZER 270 DEF FNP$(X) 280 FOR Y=1 TO X 285 LET B(Y*2-1)=ASC(CR) 290 LET B(Y*2)=ASC(LF) 300 NEXT Y 310 LET B(0)=Y*2 320 CHANGE B TO FNP$ 330 FNEND 340 PRINT"WHO ARE YOU"; 350 INPUT X8,X9$ 355 CALL "UCASE": X9$ ' Convert ticker symbol to upper case 360 FILE #1: "NAME" 'Read name file for verification 370 FOR I=1 TO LOF(#1) 380 READ #1: A$ 382 CALL "UCASE": A$ ' Change to upper case 390 IF A$<> X9$ THEN 410 400 GOTO 470 410 NEXT I 420 PRINT 430 PRINT "YOUR NAME DOES NOT MATCH. PLEASE RE-ENTER IT." 440 PRINT 450 GO TO 340 460 ' 470 LET X9=I 480 FILE #1: "SCR"&STR$(X9)&",S"&STR$(X9) 'Open scr file 490 ' ***************************** 500 ' * Ensure New Qtr Data Entry * 510 ' ***************************** 520 READ #1:X6,X7,R9 'Read first 3, checking r9 530 RESET #1:0 540 PRINT "PERIOD ";R9;"'S DATA HAS BEEN ENTERED. DO YOU WANT" 550 PRINT "TO CONTINUE WITH DATA ENTRY FOR THE NEXT PERIOD"; 555 LET Q5$ = "NON-SPECIFIC" 560 CALL "YES-NO": Q5$ ' Get yes or no response 565 CALL "UCASE": Q5$ ' Convert response to upper case 570 IF Q5$<>"YES" THEN 9420 580 FILE #2: "REP"&STR$(X9)&",R"&STR$(X9) 'Open rep file 590 SCRATCH #2 'Initialize rep file 600 FILE #10:"SUM"&STR$(X9) 'Open sum file 602 ' This initialisation of REPn seems superfluous!! 610 WRITE #2: X8,X9 'Write world #, team # 620 FOR X=1 TO 4 630 FOR Y=1 TO 6 640 WRITE #2: X,Y,0 'Data to be used later by allocate 650 NEXT Y 660 NEXT X 670 FOR X=1 TO 18 680 WRITE #2: 0 690 NEXT X 700 FILE #2: "*" 'Close rep file 710 ' 720 FOR X=1 TO 4 730 FOR Y=1 TO 6 740 READ L(X,Y) 'For cust. y, city x, l(x,y) = 1 if retail; = 2 if wholesale 750 NEXT Y 760 NEXT X 770 ' 780 DATA 1,1,1,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2 790 ' 800 MAT READ S$(4) 'Read labels 810 DATA " FOR PLAINSVILLE"," FOR MADISON "," FOR RIVERSIDE " 820 DATA " FOR SPRINGFIELD" 830 ' 840 ' * * * Security Checks * * * 850 ' 860 READ #1: X6,X7 870 IF X6=X8 THEN 900 'Right scr file? 880 PRINT "INCORRECT WORLD NUMBER" 890 STOP 900 IF X7=X9 THEN 980 910 PRINT "TEAM NUMBER FROM FILE DOES NOT MATCH ENTRY IN SCR FILE" 920 STOP 930 ' 940 ' ***************** 950 ' * Read SCR Data * 960 ' ***************** 970 ' 980 READ #1:R9,K0,K1,I2,I4,S(1,1),S(1,2),S(1,3),S(1,4),S(1,5),A2,A3 990 READ #1:C3,B1,B2,D3,R2,R3,P9,J4,Q8 1000 LET X(1)=S(1,5) 'Experienced salesmen 1010 LET X(2)=S(1,1)+S(1,2)+S(1,3)+S(1,4) 'Inexperienced salesmen 1020 FOR X=1 TO 4 1030 READ #1: A(X,1),A(X,2) 'Read pages advertised t-1; t-2 1040 NEXT X 1050 ' 1060 FOR X=1 TO 4 'For city x 1070 FOR Y=1 TO 6 'And customer y 1080 READ #1: M(X,Y) 'M(x,y) = 0 if not called on; 1 if called on; 2 if interest; 3 if full delivery 1090 NEXT Y 1100 NEXT X 1110 ' 1120 FOR X=1 TO 4 'For city x 1130 READ #1: Z(X) 'Z(x) = 1 if <50% delivered last period, 0 otherwise 1140 NEXT X 1150 ' 1160 FILE #1:"*" 'Close scr file 1170 LET R9=R9+1 'Bump period up one 1180 PRINT FNP$(1);"PERIOD";R9;FNP$(3) 1190 LET F1=I5=T5=E1=B3=B4=B5=R1=C2=P2=P4=0 'Initialize working variables 1200 LET K=K1 1210 ' 1220 FOR X=1 TO 5 'For each training stage 1230 LET S(2,X)=0 'S(2,x) will contain # salesmen fired in the xth stage 1240 NEXT X 1250 ' 1260 FOR X=1 TO 4 'For each city 1270 LET P(0,X)=0 'P(0,x) will contain # pages advertising in city x 1280 NEXT X 1290 ' 1300 MAT F=ZER(4,6) 1310 MAT O=ZER(5,6) 1320 ' 1330 ' ********************** 1340 ' * Factor Receivables * 1350 ' ********************** 1360 ' 1370 IF A2=0 THEN 1910 'If no accounts receivable, can't factor 1380 PRINT"INPUT DOLLARS TO BE FACTORED"; 1390 INPUT F1 'F1 = dollars factored 1400 ' ***** 1410 IF F1=-9876543 THEN 1590 'Triggers administrative compensation 1420 ' ***** 1430 IF F1>=0 THEN 1460 'No negative factoring 1440 PRINT "NO NEGATIVE AMOUNTS PLEASE." 1450 GO TO 1380 1460 IF INT(F1)<> F1 THEN 1480 1470 GOTO 1870 'No fractional factoring 1480 PRINT "INTEGER AMOUNTS ONLY" 1490 GO TO 1380 1500 ' 1510 ' ******************************* 1520 ' * Administrative Compensation * 1530 ' ******************************* 1540 ' 1550 ' To trigger: 1560 ' 1. Enter -9876543 for Dollars to be Factored 1570 ' 2. Enter -1 for Salesmen Fired in 1st Stage 1580 ' 1590 PRINT 1600 PRINT"****************** ADMINISTRATIVE COMPENSATION ******************" 1610 ' 1620 PRINT "PASSWORD"; 1630 INPUT Q7$ 1640 REM PASSWORD IS 'BUK' IN CONTROL (NON-PRINT) CHARACTERS 1660 ' 1670 IF Q7$= Q6$ THEN 1690 1680 GOTO 1370 'Check for correct password 1690 IF R2=0 THEN 1780 'One way to give out cash is to sell prod. imp.; not possible when none 1700 PRINT R2;"PRODUCT IMPROVEMENTS. SELL"; 1710 INPUT R4,R5 'Input # of improvements to sell and proceeds 1720 LET R2=R2-R4 'Subtract sold improvements 1730 LET A3=A3+R5 'Add cash to sales 1740 LET K=K+R5 'Add new cash to working cash 1750 LET K1=K1+R5 1760 LET J4=J4+R5 'Add cash to earned surplus 1770 GOTO1830 1780 print"NO PRODUCT IMPROVEMENTS TO SELL. INCREASE ORIG INVEST. BY"; 'Alternate injection method 1790 INPUT K3 'Increase equity 1800 LET K=K+K3 'Add new equity investment to working cash 1810 LET K1=K1+K3 1820 LET K0=K0+K3 'Increase total capital 1830 PRINT"*****************************************************************" 1840 PRINT 1850 ' 1860 GO TO 1370 1870 IF F1<=A2 THEN 1900 'Check factored amt. versus receivables 1880 PRINT"YOUR SALES WERE ONLY $";A2 'Can't factor more than sold last period 1890 GOTO 1380 1900 LET K=K+F1 'Increase working cash by factored amount 1910 IF R9=1 THEN 2320 'If it's 1st period, no need to input salesmen data 1920 ' 1930 ' ***************** 1940 ' * Fire Salesmen * 1950 ' ***************** 1960 ' 1970 PRINT 1980 PRINT "INPUT SALESMEN FIRED WHILE IN TRAINING (4 STAGES) AND IN" 1990 PRINT "THE FIELD"; 2000 INPUT S(2,1),S(2,2),S(2,3),S(2,4),S(2,5) 2010 ' ***** 2020 IF S(2,1)<> -1 THEN 2040 2030 GOTO 1590 'Triggers admin. comp.; used when no receivables to factor 2040 ' ***** 2050 FOR X=1 TO 5 2060 IF S(2,X)>=0 THEN 2090 'No negative firing 2070 PRINT "PLEASE DO NOT TRY TO FIRE NEGATIVE SALESMEN." 2080 GO TO 1970 2090 IF S(2,X)=INT(S(2,X)) THEN 2120 'No fractional firing 2100 PRINT "SALESMEN ONLY COME IN ONE PIECE" 2110 GO TO 1970 2120 NEXT X 2130 ' 2140 FOR X=1 TO 5 'For each stage 2150 IF S(2,X)<=S(1,X) THEN 2250 'Can't fire more than you have in xth stage 2160 IF S(1,X)=0 THEN 2190 2170 PRINT "THERE ARE ONLY";S(1,X);"SALESMEN IN"; 2180 GO TO 2200 2190 PRINT "THERE ARE NO SALESMEN IN"; 2200 IF X=5 THEN 2230 2210 PRINT "TRAINING STAGE";X 2220 GO TO 1970 2230 PRINT "THE FIELD" 2240 GO TO 1970 2250 NEXT X 2260 ' 2270 ' ***************** 2280 ' * Hire Salesmen * 2290 ' ***************** 2300 ' 2310 LET X(3)=S(2,1)+S(2,2)+S(2,3)+S(2,4)+S(2,5) 'Salesmen fired 2320 PRINT 2330 PRINT "INPUT INEXPERIENCED,EXPERIENCED SALESMEN HIRED"; 2340 INPUT S(1,1),E1 'Input # salesmen for stage 1; experienced salesmen 2350 IF S(1,1)>=0 THEN 2380 'No negative hiring 2360 PRINT "YOU CANNOT HIRE ANTI-MATTER SALESMEN." 2370 GO TO 2320 2380 IF E1>= 0 THEN 2400 2390 GOTO 2360 'No negative hiring 2400 IF INT(S(1,1))=S(1,1) THEN 2430 'No fractional hiring 2410 PRINT "SALESMEN ONLY COME IN ONE PIECE" 2420 GO TO 2320 2430 IF INT(E1)= E1 THEN 2450 2440 GOTO 2410 'No fractional experienced salesmen 2450 ' 2460 GOSUB 4860 '1st check to see if team has spent more than it has 2470 ' 2480 PRINT 2490 ' 2500 ' **************** 2510 ' * Build Plants * 2520 ' **************** 2530 ' 2540 PRINT "INPUT IN LOTS:PLANT DES.,SITE CLEAR.,UNDER CONST.,"; 2550 INPUT B3,B4,B5 'Input # lots designed, cleared, and under construction 2560 LET X(6)=B3 'Plant design 2570 LET X(7)=B4 'Site cleared 2580 LET X(8)=B5 'Under construction 2590 IF B3>=0 THEN 2620 'No negative lots 2600 PRINT "WHAT!!! NEGATIVE PLANTS??" 2610 GO TO 2480 2620 IF B4>= 0 THEN 2640 2630 GOTO 2600 'No negative lots 2640 IF B5>= 0 THEN 2660 2650 GOTO 2600 2660 IF B3/5<>INT(B3/5) THEN 2700 'Lots must be built in multiples of 5 2670 IF B4/5<>INT(B4/5) THEN 2700 2680 IF B5/5<>INT(B5/5) THEN 2700 2690 GO TO 2720 2700 PRINT" INPUTS MUST BE IN MULTIPLES OF FIVE" 2710 GO TO 2480 2720 IF B4<=B1 THEN 2750 'Must have designed plant before clearing site 2730 PRINT"YOU ARE TRYING TO CLEAR SITES FOR MORE PLANTS THAN YOU HAVE DESIGNED" 2740 GO TO 2480 2750 IF B5<=B2 THEN 2780 'Must have cleared site last per. before building 2760 PRINT"YOU ARE TRYING TO BUILD MORE PLANTS THAN YOU HAVE CLEARED SITES FOR" 2770 GO TO 2480 2780 PRINT 2790 ' 2800 GOSUB 4860 '2nd check for bankruptcy 2810 ' 2820 ' **************************** 2830 ' * R & D, Consulting Inputs * 2840 ' **************************** 2850 ' 2860 PRINT "INPUT R&D,CONSULTING"; 2870 INPUT R1,C2 'R1 = r & d; c2 = consulting 2880 IF INT(R1)=R1 THEN 2910 'Integers only 2890 PRINT "INTEGER AMOUNTS PLEASE" 2900 GO TO 2780 2910 IF INT(C2)= C2 THEN 2930 2920 GOTO 2890 'Integers only 2930 IF C2>=0 THEN 2960 'No negative consulting expense 2940 PRINT" YOU CHEAT." 2950 GO TO 2780 2960 IF R1=0 THEN 3030 2970 IF R1>0 THEN 3000 'No negative r & d expense 2980 PRINT "R&D CANNOT BE NEGATIVE" 2990 GO TO 2780 3000 IF R1>=1E4 THEN 3030 'R & d must be 0 or > $10,000 3010 PRINT "R&D MUST BE 0 OR >10000" 3020 GO TO 2780 3030 PRINT 3040 ' 3050 GOSUB 4860 '3rd check for bankruptcy 3060 ' 3070 ' ***************************** 3080 ' * Manufacture/Purchase Lots * 3090 ' ***************************** 3100 ' 3110 PRINT "INPUT LOTS SCHEDULED, LOTS TO WIP, LOTS PURCHASED"; 3120 INPUT P1,P2,P4 3130 LET X(10)=P1 'Lots scheduled 3140 LET X(11)=P2 'Lots to wip 3150 LET X(12)=P4 'Lots purchased 3160 IF P1>=0 THEN 3190 'No negative scheduling 3170 PRINT "PLEASE DO NOT TRY TO GET MONEY WITH NEGATIVE LOTS" 3180 GO TO 3030 3190 IF P2>= 0 THEN 3210 3200 GOTO 3170 'No negative wip 3210 IF P4>= 0 THEN 3230 3220 GOTO 3170 'No negative purchasing 3230 IF P1=INT(P1) THEN 3260 'Integer lots only 3240 PRINT "FRACTIONAL LOTS ARE ILLEGAL" 3250 GO TO 3030 3260 IF INT(P2)= P2 THEN 3280 3270 GOTO 3240 'Integer lots only 3280 IF INT(P4)= P4 THEN 3300 3290 GOTO 3240 'Integer lots only 3300 IF P2<=C3 THEN 3330 'Can't overflow capacity 3310 PRINT"YOU ARE TRYING TO PRODUCE MORE THAN YOUR PLANT CAPACITY ALLOWS" 3320 GO TO 3030 3330 IF P2<=D3 THEN 3360 'Can't produce more than scheduled 3340 PRINT"YOU ARE TRYING TO PRODUCE MORE THAN YOU HAVE SCHEDULED" 3350 GO TO 3030 3360 PRINT 3370 ' 3380 GOSUB 4860 '4th check for bankruptcy 3390 ' 3400 ' ************* 3410 ' * Advertise * 3420 ' ************* 3430 ' 3440 PRINT "INPUT PAGES ADV,MFG PRICE,WHSL PRICE";S$(1); 3450 INPUT P(0,1),P(2,1),P(1,1) 3460 LET X(14)=P(2,1) 'Mfg price for plainsville 3470 LET X(15)=P(1,1) 'Whsl price for plainsville 3480 PRINT "INPUT PAGES ADV, WHSL PRICE ";S$(2); 3490 INPUT P(0,2),P(1,2) 3500 LET X(16)=P(1,2) 'Whsl price for madison 3510 PRINT "INPUT PAGES ADV, WHSL PRICE ";S$(3); 3520 INPUT P(0,3),P(1,3) 3530 LET X(17)=P(1,3) 'Whsl price for riverside 3540 PRINT "INPUT PAGES ADV, MFG PRICE ";S$(4); 3550 INPUT P(0,4),P(2,4) 3560 LET X(18)=P(2,4) 'Mfg price for springfield 3570 ' 3580 FOR X=1 TO 4 'For each city 3590 IF P(0,X)>=0 THEN 3620 'No negative pages 3600 PRINT "NO ANTI-MATTER ADVERTISING." 3610 GO TO 3360 3620 IF P(1,X)>=0 THEN 3650 'No negative pricing 3630 PRINT "NO NEGATIVE PRICING" 3640 GO TO 3360 3650 IF P(2,X)>= 0 THEN 3670 3660 GOTO 3630 'No negative pricing 3670 IF P(1,X)=INT(P(1,X)) THEN 3700 'Integer prices only 3680 PRINT "NO FRACTIONAL PRICES" 3690 GO TO 3360 3700 IF P(2,X)= INT(P(2,X)) THEN 3720 3710 GOTO 3680 'Integer prices only 3720 IF P(0,X)=INT(P(0,X)) THEN 3750 'Integer pages only 3730 PRINT "FRACTIONAL PAGES ARE ILLEGAL" 3740 GO TO 3360 3750 IF P(0,X)<=8 THEN 3780 'No more than 8 pages in any one city 3760 PRINT"THERE IS A EIGHT PAGE LIMIT ON ADVERTISING" 3770 GO TO 3360 3780 NEXT X 3790 ' 3800 GOSUB 4860 '5th check for bankruptcy 3810 ' 3820 ' ********************* 3830 ' * Send Out Salesmen * 3840 ' ********************* 3850 ' 3860 IF S(1,5)=0 THEN 3940 'If no salesmen in field, skip this section 3870 LET D9=0 3880 FOR X=1 TO 4 3890 IF P(2,X)<= 0 THEN 3910 3900 GOTO 3960 'If non-zero prices given for any city, ask for calling 3910 IF P(1,X)<= 0 THEN 3930 3920 GOTO 3960 3930 NEXT X 3940 LET D9=1 'D9 = 1 if no salesmen in field or no prices given 3950 GO TO 5010 3960 PRINT 3970 PRINT "INPUT SALESMEN, CUSTOMERS IN ORDER OF CALLING" 3980 FOR X=1 TO 4 'For each city 3990 IF P(1,X)+P(2,X)>0 THEN 4010 'Skip this city if zero prices are entered 4000 GO TO 4430 4010 PRINT S$(X); 'Print city name, ask for input 4020 INPUT O(1,X),W(X,1),W(X,2),W(X,3),W(X,4),W(X,5),W(X,6) 4030 IF O(1,X)>=0 THEN 4070 'No negative salesmen sent 4040 PRINT "NO ANTIMATTER SALESMEN PLEASE" 4050 GO TO 4010 4060 ' 4070 FOR Y=1 TO 6 4080 IF W(X,Y)=INT(W(X,Y)) THEN 4110 'No fractional customers 4090 PRINT "CUSTOMERS ONLY COME IN WHOLE PIECES" 4100 GO TO 4010 4110 NEXT Y 4120 ' 4130 IF INT(O(1,X))=O(1,X) THEN 4170 'No fractional salesmen 4140 PRINT "SALESMEN DO NOT COME IN PARTS" 4150 GO TO 4010 4160 ' 4170 FOR Y=1 TO 6 4180 LET O(4,Y)=0 'Initialize o(4,y) 4190 NEXT Y 4200 ' 4210 FOR Y=1 TO 6 4220 IF W(X,Y)<= 6 THEN 4240 4230 GOTO 4370 'No customer #'s are greater than 6 4240 IF W(X,Y)>= 1 THEN 4260 4250 GOTO 4370 'Or less than 1 4260 IF INT(W(X,Y))= W(X,Y) THEN 4280 4270 GOTO 4370 'No fractional customer numbers 4280 LET O(4,W(X,Y))=1 'O(4,w(x,y)) = 1 when cust. w(x,y) is to be called on 4290 NEXT Y 4300 ' 4310 FOR Y=1 TO 6 4320 IF O(4,Y)<> 0 THEN 4340 4330 GOTO 4370 'Must input all customer #'s (1 through 6) 4340 NEXT Y 4350 ' 4360 GO TO 4390 4370 PRINT"CUSTOMER ORDER ERROR" 4380 GO TO 4010 4390 IF S(1,5)>=O(1,1)+O(1,2)+O(1,3)+O(1,4) THEN 4430 'Can't send more salesmen than are in field 4400 PRINT "YOU ONLY HAVE";S(1,5);"SALESMEN IN THE FIELD" 4410 MAT O=ZER(5,6) 'Start over if error 4420 GO TO 3980 4430 NEXT X 4440 ' 4450 ' ***************** 4460 ' * Call Sequence * 4470 ' ***************** 4480 ' 4490 IF R9>2 THEN 4580 'If this isn't 1st or 2nd per., suppress call sequence instructions 4500 ' 4510 PRINT FNP$(2);"IN EACH CITY FOUR (4) CALL SEQUENCES ARE AVAILABLE" 4520 PRINT FNP$(1);" CALL SEQ.";TAB(20);"GROUP 1";TAB(40);"GROUP 2" 4530 PRINT TAB(1);"1";TAB(20);"ROTATION";TAB(40);"ROTATION" 4540 PRINT TAB(1);"2";TAB(20);"ROTATION";TAB(40);"REPEAT" 4550 PRINT TAB(1);"3";TAB(20);"REPEAT";TAB(40);"ROTATION" 4560 PRINT TAB(1);"4";TAB(20);"REPEAT";TAB(40);"REPEAT" 4570 ' 4580 PRINT FNP$(1);"INPUT CALL SEQUENCE, NUMBER OF CUSTOMERS IN FIRST "; 4590 PRINT "GROUPING" 4600 ' 4610 FOR X=1 TO 4 'For each city 4620 IF P(1,X)+P(2,X)=0 THEN 4790 'If no prices given for this city, skip 4630 PRINT S$(X); 'Print city name 4640 INPUT O(2,X),O(3,X) 'Input call sequence, # cust's in 1st grouping 4650 IF INT(O(2,X))=O(2,X) THEN 4680 'No fractional sequences 4660 PRINT "CALLING PROCEDURE ERROR" 4670 GO TO 4630 4680 IF O(2,X)> 0 THEN 4700 4690 GOTO 4660 'No negative sequences 4700 IF O(2,X)< 5 THEN 4720 4710 GOTO 4660 'Only 5 sequences available 4720 IF INT(O(3,X))=O(3,X) THEN 4750 'No fractional groupings 4730 PRINT "GROUPING ERROR" 4740 GO TO 4630 4750 IF O(3,X)<= 6 THEN 4770 4760 GOTO 4730 'Can't have more than 6 in a group 4770 IF O(3,X)>= 1 THEN 4790 4780 GOTO 4730 'Or less than 1 4790 NEXT X 4800 ' 4810 ' ********************************* 4820 ' * GOSUB to Check for Bankruptcy * 4830 ' ********************************* 4840 ' 4850 GO TO 5010 4860 LET T1=15E3*E1+3E3*P2+1E4+8E3*P4+C2+R1+2E3*(B3+B4+B5) 'Add for production costs 4870 LET T1=T1+2E3*(S(1,1)+S(1,2)+S(1,3)+S(1,4)+E1+S(1,5)) 'Add salesmen's salaries 4880 LET T1=T1-2E3*(S(2,1)+S(2,2)+S(2,3)+S(2,4)+S(2,5)) 'Subtract salaries for salesmen fired 4890 LET T1=T1+2E3*(P(0,1)+P(0,2)+P(0,3)+P(0,4))+.2*F1 'Add advertising and factoring expense 4900 LET T1=T1+200*P1+.05*(I4-Q8) 'Add overhead expense 4910 IF P2>0 THEN 4930 4920 LET T1=T1-1E4 'Subtract $10,000 if no wip costs 4930 IF T1<=K THEN 4970 'Compare cash spent with cash available 4940 PRINT 4950 PRINT" YOU HAVE GONE BANKRUPT. YOU ARE IN THE HOLE $";T1-K 4960 GOTO 1190 'Start over from the top 4970 RETURN 4980 ' 4990 ' * * * End of Inputs * * * 5000 ' 5010 PRINT FNP$(1);"ANY MISTAKES"; 'Last chance to correct mistakes 5015 LET C$ = "NON-SPECIFIC" 5020 CALL "YES-NO": C$ 5030 CALL "UCASE":C$ 'Converts to uppercase 5040 IF C$<> "YES" THEN 5060 5050 GOTO 1190 'Start over 5060 IF C$= "NO" THEN 5080 5070 GOTO 5010 'Yes or no answer only 5080 LET X(2)=S(1,1)+E1+X(2) 'Inexperience salesmen recalculated 5090 LET K=K-T1 'Subtract cash spent this period 5100 LET A2=A2-F1 'Subtract dollars factored from sales previous period 5110 LET B1=B1+B3-B4 'B1 = # designed plants last per. + this per. - sites cleared this per. 5120 LET B2=B2+B4-B5 'B2 = # cleared sites last + this per. - sites under const. this per. 5130 LET W1=D1=0 5140 ' 5150 IF P2=0 THEN 5190 'If no wip then skip 5160 LET W1=3E3*P2+1E4 'W1 = cost of wip ($3,000/lot + $10,000 start-up costs) 5170 LET D1=3E3+1E4/P2 'D1 = average wip cost = $3,000 + $10,000/wip lots 5180 ' 5190 LET D3=P1 'D3 = lots scheduled this period 5200 LET P8=2E3*(B3+B4+B5) 'P8 = plant costs = $2,000 * (plants des. + site clear + site under const.) 5210 LET R3=R3+R1 'R3 = new cumulative r & d expenditures 5220 LET Q8=.05*(I4-Q8) 'Q8 = overhead costs = 5% of inventory 5230 LET S(1,4)=S(1,4)+E1 'Add experienced salesmen hired this period 5240 ' 5250 FOR X=1 TO 5 'For each stage of training 5260 LET S(1,X)=S(1,X)-S(2,X) 'Subtract salesmen fired 5270 NEXT X 5280 ' 5290 ' ********************************************* 5300 ' * Calculate Product Improvement Probability * 5310 ' ********************************************* 5320 ' 5330 ' Calculates probability of product improvement as follows: 5340 ' 5350 ' If cum. R & D is Probability is 5360 ' in the range in the range 5370 ' $0-20,000 0 - .1 5380 ' $20,000 - 30,000 .1 - .25 5390 ' $30,000 - 40,000 .25 - .5 5400 ' $40,000 - 50,000 .5 - .9 5410 ' > $50,000 .9 5420 ' 5430 IF R1 >=1E4 THEN 5460 'If r & d < $10,000 lose all cumulative r & d effect 5440 LET R3=X=0 5450 GOTO 5660 'Skip probability section 5460 IF R3>=2E4 THEN 5490 5470 LET X=(R3-1E4)/1E5 5480 GO TO 5590 5490 IF R3>=3E4 THEN 5520 5500 LET X=.1+((R3-2E4)/1E5)*1.5 5510 GO TO 5590 5520 IF R3>=4E4 THEN 5550 5530 LET X=.25+((R3-3E4)/1E5)*2.5 5540 GO TO 5590 5550 IF R3>=5E4 THEN 5580 5560 LET X=.5+((R3-4E4)/1E5)*4 5570 GOTO 5590 5580 LET X=.9 5590 IF RND>X THEN 5660 'Generate random #, compare with p(prod. imp.) 5600 LET R2=R2+1 'Prod. imp. acheived; add to previous prod. imps. 5610 LET R4=1 'R4 = # prod. imp. this period 5620 LET R3=0 'Set cumulative r & d expenditures to zero 5630 PRINT FNP$(2);"YOU HAVE ACHIEVED A PRODUCT IMPROVEMENT !";FNP$(1) 5640 PRINT 5650 GO TO 5670 5660 PRINT FNP$(2);"YOU HAVE NOT ACHIEVED A PRODUCT IMPROVEMENT";FNP$(1) 5670 PRINT 5680 ' 5690 ' * * * End of probability Section * * * 5700 ' 5710 ' ****************************** 5720 ' * Generate Sales Probability * 5730 ' ****************************** 5740 ' 5750 ' The probability of making a sale to customer Y, city X is 5760 ' based on 0 to 100 points and is calculated as follows: 5770 ' I. Starting probability is 20 points 5780 ' II. Advertising 5790 ' - Add 1.4 points / page this period 5800 ' - Add .4 points/page last period 5810 ' - Add .2 points/page two periods ago 5820 ' III. Product Improvements 5830 ' - Add 10 points for each product improvement 5840 ' IV. Pricing 5850 ' - For each $1,000 below (above) list, add (subtract) 4.5 points 5860 ' - Maximum addition (subtraction) for pricing is 18 points 5870 ' V. Customer Service 5880 ' - If less than 50% of the orders placed in city X were delivered 5890 ' last period, cut total points in half 5900 ' - If otherwise, no effect on points 5910 ' VI. Previous Calls 5920 ' - Add 18 points if full delivery on order was made last period 5930 ' - Add 12 points if interest was shown last period 5940 ' - Add 6 points if customer Y was colled on last period 5950 ' 5960 ' Final probability points for customer Y, city X are held in N(X,Y), are 5970 ' rounded to the nearest point, and must fall between 0 and 99. 5980 ' 5990 FOR X = 1 TO 4 6000 IF D9 = 1 THEN 6400 6010 LET A0 = 2 * (.7 * P(0,X) + .2 * A(X,1) + .1 * A(X,2) ) 6020 IF O(1,X)=0 THEN 6400 6030 ' 6040 FOR Y=1 TO 6 6050 LET N(X,Y)=10*R2+20+A0 'Add prod. imp. and advertising effects 6060 ' 6070 ' * * * calculate pricing effects * * * 6080 ' 6090 LET P6=(P(L(X,Y),X)) 6100 IF P6+2E3*(L(X,Y)-1)>=10E3 THEN 6120 6110 LET P6=8E3+2E3*(2-L(X,Y)) 6120 LET S9=P6-14E3 + 2E3*(L(X,Y)-1) 6130 IF S9=0 THEN 6180 6140 LET N(X,Y)=N(X,Y)-SGN(S9)*(ABS(S9)/1E3)*4.5 6150 ' 6160 ' * * * calculate delivery effects : * * 6170 ' 6180 IF Z(X)=0 THEN 6200 6190 LET N(X,Y)=N(X,Y)/2 6200 LET N(X,Y)=N(X,Y)+6*M(X,Y) 6210 ' 6220 IF N(X,Y)<100 THEN 6240 'Prob. can't be > 100 6230 LET N(X,Y)=99 6240 IF N(X,Y)>=0 THEN 6260 6250 LET N(X,Y)=0 'Prob. can't be < 0 6260 LET N(X,Y)=INT(N(X,Y)+.5) 'Round off 6270 NEXT Y 6280 ' 6290 ' * * * End of Sales probability Section * * * 6300 ' 6310 ' ************************** 6320 ' * Perform Call Sequences * 6330 ' ************************** 6340 ' 6350 LET O(5,X)=O(1,X) 'O(5,x) = # salesmen in this city 6360 LET X3=1 6370 LET X4=O(3,X) 'X4 = # of customers in 1st grouping for this city 6380 LET X6=0 6390 ' 6400 FOR X7=1 TO 6 6410 LET M(X,X7)=0 'Zero out m matrix 6420 NEXT X7 6430 ' 6440 IF D9=1 THEN 7440 'If zero price for all cities skip this section 6450 IF O(1,X)=0 THEN 7440 'If no salesmen in city x, then skip 6460 ON O(2,X) GO TO 6490,6670,6880,7090 'Branch to procedures for call sequences 6470 ' 6480 ' * * * Procedure 1 -- Rotation Rotation (see manual) 6490 ' 6500 FOR X1=X3 TO X4 'Loop thru 1st grouping of customers 6510 LET Y=W(X,X1) 'Y = customer # (1,2,3,4,5 or 6) 6520 IF F(X,Y)=2 THEN 6540 'If customer has already shown interest, don't call on him again 6530 GOSUB 7320 'Customer call routine 6540 NEXT X1 6550 ' 6560 FOR X1=X3 TO X4 'Rotate through second grouping 6570 IF F(X,W(X,X1))= 2 THEN 6590 6580 GOTO 6500 'If not all of the cust.'s in 1st grouping have shown interest, try them again 6590 NEXT X1 6600 ' 6610 IF X6=6 THEN 7440 'If all 6 customers have shown interest, quit this city 6620 LET X3=X4+1 'Reset indices to rotate thru 2nd group 6630 LET X4=6 6640 GO TO 6500 'Start over with 2nd group 6650 ' 6660 ' * * * Procedure 2 -- Rotation Repeat (see manual) 6670 ' 6680 FOR X1=X3 TO X4 'Loop through 1st grouping 6690 LET Y=W(X,X1) 'Y = customer # to call on 6700 IF F(X,Y)=2 THEN 6720 'Has he shown interest yet? 6710 GOSUB 7320 'No, call on him again 6720 NEXT X1 6730 ' 6740 FOR X1=X3 TO X4 'Loop through 1st group again 6750 IF F(X,W(X,X1))= 2 THEN 6770 6760 GOTO 6680 'Have all shown interest 6770 NEXT X1 'If not, rotate through 1st group again 6780 IF X6=6 THEN 7440 'All customers shown interest, quit this city 6790 FOR X1=X4+1 TO 6 'Loop through 2nd group (all in 1st group have shown interest) 6800 LET Y=W(X,X1) 'Y - customer # 6810 GOSUB 7320 'Call on him 6820 IF F(X,Y)= 2 THEN 6840 6830 GOTO 6810 'If no interest shown, call him again 6840 NEXT X1 'Repeat through 2nd group 6850 GO TO 7440 'Quit this call sequence 6860 ' 6870 ' * * * Procedure 3 -- Repeat Rotation (see manual) * * * 6880 ' 6890 FOR X1=X3 TO X4 'Loop through 1st group 6900 LET Y=W(X,X1) 'Y = customer # 6910 GOSUB 7320 'Call on him 6920 IF F(X,Y)>= 2 THEN 6940 6930 GOTO 6910 'If no interest shown, call on him again 6940 NEXT X1 6950 ' 6960 IF X6=6 THEN 7440 'If 6 "interests", quit this city 6970 FOR X1=X4+1 TO 6 'Loop through 2nd group 6980 LET Y=W(X,X1) 'Y = customer # 6990 GOSUB 7320 'Call on customer y 7000 NEXT X1 7010 ' 7020 FOR X1=X4+1 TO 6 'Loop through 2nd group again 7030 IF F(X,W(X,X1))>= 2 THEN 7050 7040 GOTO 6970 'If not all in 2nd group have shown interest, call on those who have'nt again 7050 NEXT X1 7060 GO TO 7440 'Quit this call sequence 7070 ' 7080 ' * * * Procedure 4 -- Repeat Repeat (see manual) * * * 7090 ' 7100 FOR X1=1 TO 6 'Loop through all customers in order specified 7110 LET Y=W(X,X1) 'Y = customer to call on 7120 GOSUB 7320 'Call on him 7130 IF F(X,Y)>= 2 THEN 7150 7140 GOTO 7120 'If no interest shown, call on him again 7150 NEXT X1 7160 GO TO 7440 'Quit this call sequence 7170 ' 7180 ' ************************************************ 7190 ' * GOSUB -- Salesmen and Interest Check Routine * 7200 ' ************************************************ 7210 ' 7220 ' I. Keeps track of number of calls made and exits city if all calls 7230 ' are exhausted. One salesmen can make 2 calls on a wholesaler 7240 ' or 1 call on a manufacturer. 7250 ' 7260 ' II. A random number is generated (0-100). If it is less than or equal to 7270 ' the probability points for this customer then interest is said to be shown 7280 ' and the routine is exited. If otherwise, a "call" is recorded and 7290 ' 6 points are added to the probability, increasing the chance of "interest" 7300 ' on the next call. Points are checked to be between 0 and 99. 7310 ' 7320 LET O(5,X)=O(5,X)-1/L(X,Y) 'Record call 7330 IF O(5,X)<0 THEN 7440 'If all calls exhausted for this city, exit 7340 IF RND*100>N(X,Y) THEN 7380 'Was "interest" shown? 7350 LET F(X,Y)=M(X,Y)=2 'Yes; set to 2 indicating interest 7360 LET X6=X6+1 'Bump interest count by 1 7370 GO TO 7430 'End of call 7380 IF F(X,Y)=1 THEN 7430 'No interest shown; has this customer been called on already? 7390 LET F(X,Y)=M(X,Y)=1 'No; set to 1 indicating "called on" 7400 LET N(X,Y)=N(X,Y)+6 'Increase prob. points by 6; increased only on this 1st call 7410 IF N(X,Y)<100 THEN 7430 'Prob. can't be . 100 7420 LET N(X,Y)=99 7430 RETURN 7440 NEXT X 7450 ' 7460 ' * * * End of Salesmen and Interest Check Routine * * * 7470 ' 7480 ' *********************************** 7490 ' * Write Industry Data to REP File * 7500 ' *********************************** 7510 ' 7520 ' The following data will be written into the REP file: 7530 ' 7540 ' ITEM # of Items Description 7550 ' ---- ---------- ----------- 7560 ' 7570 ' X8 1 World # 7580 ' X9 1 Team # 7590 ' X,Y,Z9 72 24 Sets of 3 Numbers: 7600 ' City #, Cust. #, Prob. of Sale to That Cust. 7610 ' (prob. = zero unless interest has been shown) 7620 ' R4 1 # Product Improvements This Period 7630 ' C3 1 Current Plant Capacity 7640 ' O(1,X),P(0,X),Y1,Y2 16 For each City X: 7650 ' O(1,X) = # Salesmen 7660 ' P(0,X) = Pages Advertising 7670 ' Y1,Y2 = Pricing for Mfg, Whlsl: 7680 ' = 0 if No Price Given 7690 ' = 1 if Above List 7700 ' = 2 if at List 7710 ' = 3 if Below List 7720 ' 7730 ' * * * * * * * * * * * * * * * * * * * * * * 7740 FILE #2: "REP" & STR$(X9) & ",R" & STR$(X9) 7750 SCRATCH #2 7760 WRITE #2: X8,X9 7770 FOR X=1 TO 4 7780 FOR Y=1 TO 6 7790 IF F(X,Y)=2 THEN 7830 7800 LET Z9=0 7810 WRITE #2: X,Y,Z9 7820 GO TO 7840 7830 WRITE #2: X,Y,INT(N(X,Y)) 7840 NEXT Y 7850 NEXT X 7860 WRITE #2: R4,C3 7870 FOR X=1 TO 4 7880 LET Y1=Y2=0 7890 WRITE #2: O(1,X),P(0,X) 7900 FOR Y=1 TO 6 7910 IF L(X,Y)=1 THEN 8060 7920 IF P(2,X)=0 THEN 8040 7930 IF 12E3>P(2,X) THEN 7980 7940 IF 12E3<> P(2,X) THEN 7960 7950 GOTO 8000 7960 IF 12E3>= P(2,X) THEN 7980 7970 GOTO 8020 7980 LET Y2=1 7990 GO TO 8170 8000 LET Y2=2 8010 GO TO 8170 8020 LET Y2=3 8030 GO TO 8170 8040 LET Y2=0 8050 GO TO 8170 8060 IF P(1,X)>0 THEN 8090 8070 LET Y1=0 8080 GO TO 8170 8090 IF 14E3 P(1,X) THEN 8120 8110 GOTO 8160 8120 LET Y1=1 8130 GO TO 8170 8140 LET Y1=3 8150 GO TO 8170 8160 LET Y1=2 8170 NEXT Y 8180 WRITE #2: Y1,Y2 8190 NEXT X 8200 LET X(9)=C3 'Plant capacity 8210 FOR I9=1 TO 17 8220 PRINT #10:STR$(X(I9))&","; 'Store matrix x in sum to be used in stratsum 8230 NEXT I9 8240 PRINT #10:STR$(X(18)) 8250 ' close REP file 8251 FILE #2: "*" 8260 ' 8270 ' ******************************* 8280 ' * Write Team Data to SCR File * 8290 ' ******************************* 8300 ' 8310 ' The following data will be written into the SCR file: 8320 ' 8330 ' Item # of Items Description 8340 ' ---- ---------- ----------- 8350 ' 8360 ' X8 1 World # 8370 ' X9 1 Team # 8380 ' R9 1 Period # 8390 ' D9 1 Boolean; = 1 when <>0 price given for any city 8400 ' I2 1 Inventory (in Units) 8410 ' P4 1 # Lots Purchased 8420 ' I4 1 Inventory Value (in Dollars) 8430 ' A2 1 Accounts Receivable 8440 ' A3 1 Sales 8450 ' W1 1 Work in Process (in Dollars) 8460 ' T1 1 Cash Spant This Period 8470 ' P1 1 # Lots Scheduled 8480 ' K 1 Cash 8490 ' F1 1 Dollars Factored 8500 ' P8 1 Plant Construction Costs 8510 ' K1 1 Cash 8520 ' J4 1 Earned Surplus 8530 ' P9 1 Total Plant Value 8540 ' C3 1 Plant Capacity 8550 ' B5 1 # Plant Lots Under Construction 8560 ' K0 1 Capital Stock 8570 ' B1 1 # Plant Lots in Design 8580 ' B2 1 # Plant Lots with Cleared Sites 8590 ' R2 1 Cumulative # of Product Improvements 8600 ' R3 1 Cumulative R & D Expenditures 8610 ' P2 1 # Lots to Work in Process 8620 ' D3 1 # Lots Scheduled 8630 ' R1 1 R & D Expense This Period 8640 ' C2 1 Consulting Expense This Period 8650 ' E1 1 # Experienced Salesmen Hired 8660 ' Q8 1 Overhead Expense 8670 ' F(I,J) 24 For City I, Customer J: 8680 ' = 0 if Not Called On 8690 ' = 1 if Called On 8700 ' = 2 if Interest Shown 8710 ' A(I,1),P(0,I), 8720 ' P(1,I),P(2,I) 16 For City I: 8730 ' A(I,1) = Pages Advertising Per. T-1 8740 ' P(0,I) = Pages Advertising Per. T 8750 ' P(1,I) = Price for Wholesalers 8760 ' P(2,I) = Price for Manufacturers 8770 ' S(1,I) 5 # Salesmen in Ith Stage of Training 8780 ' Z(X) 4 For City X: 8790 ' = 1 if < 50% Orders Were Delivered Last Per. 8800 ' = 0 Otherwise 8810 ' 8820 ' * * * * * * * * * * * * * * * * * * * * * * 8830 ' 8850 FILE #1: "SCR" & STR$(X9) & ",S" & STR$(X9) 8860 SCRATCH #1 8870 WRITE #1: X8,X9 8880 WRITE #1: R9,D9,I2,P4,I4,A2,A3,W1,T1,P1,K,F1,P8,K1,J4,P9,C3 8890 WRITE #1: B5,K0,B1,B2,R2,R3,P2,D3 8900 WRITE #1: R1,C2,E1,Q8 8910 FOR I=1 TO 4 8920 FOR J=1 TO 6 8930 WRITE #1: F(I,J) 8940 NEXT J 8950 NEXT I 8960 FOR I=1 TO 4 8970 WRITE #1: A(I,1),P(0,I),P(1,I),P(2,I) 8980 NEXT I 8990 FOR I=1 TO 5 9000 WRITE #1: S(1,I) 9010 NEXT I 9020 FOR X=1 TO 4 9030 WRITE #1: Z(X) 9040 NEXT X 9050 FILE #1: "*" 'Close scr file 9060 ' 9070 ' ************************** 9080 ' * Write Data to DAT file * 9090 ' ************************** 9100 ' 9110 ' This section originally printed the data to the terminal 9120 ' but now the data is printed to that company's DAT file. 9130 ' This is used in case something goes wrong and you have to 9140 ' rerun PRINT. Reload the SCR file with this data(use RELOAD). 9150 ' 9160 PRINT "WORLD";X8 9170 PRINT "COMPANY ";X9$ 9180 PRINT "QUARTER";R9 9190 FILE #30:"DAT"&STR$(X9) 9200 PRINT #30:"QUARTER",R9 9210 PRINT #30:"After running INPUT:" 9220 PRINT "DONE" 9230 PRINT #30:FNP$(2);"DATA:";FNP$(2) 9240 PRINT #30:X8;X9; 9250 PRINT #30:R9;D9;I2;P4;I4;A2;A3;W1;T1;P1;K;F1;P8;K1;J4;P9;C3; 9260 PRINT #30:B5;K0;B1;B2;R2;R3;P2;D3; 9270 PRINT #30:R1;C2;E1;Q8; 9280 FOR X=1 TO 4 9290 FOR Y=1 TO 6 9300 PRINT #30:F(X,Y); 9310 NEXT Y 9320 NEXT X 9330 FOR X=1 TO 4 9340 PRINT #30:A(X,1);P(0,X);P(1,X);P(2,X); 9350 NEXT X 9360 FOR X=1 TO 5 9370 PRINT #30:S(1,X); 9380 NEXT X 9390 FOR X=1 TO 4 9400 PRINT #30:Z(X); 9410 NEXT X 9420 END __ PRINT #30:Z(X); 9410 NEXT X 9420 END PNJ KxQUINN03 JMS 999999052881P100 ' INPUT (BASIC program begins in line 230) was written by 110 ' Jaffe, Tuck '72. Revised by Thomas, Tuck '80. 120 ' 130 ' Description--Part of the Business Game Package. Accepts and verifies 140 ' team's decision data, generates product improvements, calculates 150 ' sales probabilities, performs salesmen's calls, and stores data 160 ' to be used in STRATSUM and STRATREP (2 final summary programs). 170 ' This program replaces STRAT-IN. 180 ' 190 ' Instructions-- See Administrator's Manual 200 ' 201 'Files-- NAME - ticker symbols for teams 202 ' SCRn - input and output 203 ' REPn - Probabilities of selling + pricing and advertising data 204 ' SUMn - for STRATREP and STRATSUM 205 ' DATn - cumulative SCRn in terminal format, for recovery and rerumming 206 ' 210 ' * * * * * * * * * * * * * * * * * * * * * * 220 ' 230 RANDOMIZE 240 library "BASICLIB***:TEXTSUB" 'Contains the subroutine ucase 250 DIM X(18) 'Stores data to write in sum 260 MAT X=ZER 270 DEF FNP$(X) 280 FOR Y=1 TO X 285 LET B(Y*2-1)=ASC(CR) 290 LET B(Y*2)=ASC(LF) 300 NEXT Y 310 LET B(0)=Y*2 320 CHANGE B TO FNP$ 330 FNEND 340 PRINT"WHO ARE YOU"; 350 INPUT X8,X9$ 355 CALL "UCASE": X9$ ' Convert ticker symbol to upper case 360 FILE #1: "NAME" 'Read name file for verification 370 FOR I=1 TO LOF(#1) 380 READ #1: A$ 382 CALL "UCASE": A$ ' Change to upper case 390 IF A$<> X9$ THEN 410 400 GOTO 470 410 NEXT I 420 PRINT 430 PRINT "YOUR NAME DOES NOT MATCH. PLEASE RE-ENTER IT." 440 PRINT 450 GO TO 340 460 ' 470 LET X9=I 480 FILE #1: "SCR"&STR$(X9)&",S"&STR$(X9) 'Open scr file 490 ' ***************************** 500 ' * Ensure New Qtr Data Entry * 510 ' ***************************** 520 READ #1:X6,X7,R9 'Read first 3, checking r9 530 RESET #1:0 540 PRINT "PERIOD ";R9;"'S DATA HAS BEEN ENTERED. DO YOU WANT" 550 PRINT "TO CONTINUE WITH DATA ENTRY FOR THE NEXT PERIOD"; 555 LET Q5$ = "NON-SPECIFIC" 560 CALL "YES-NO": Q5$ ' Get yes or no response 565 CALL "UCASE": Q5$ ' Convert response to upper case 570 IF Q5$<>"YES" THEN 9420 580 FILE #2: "REP"&STR$(X9)&",R"&STR$(X9) 'Open rep file 590 SCRATCH #2 'Initialize rep file 602 ' This initialisation of REPn seems superfluous!! 610 WRITE #2: X8,X9 'Write world #, team # 620 FOR X=1 TO 4 630 FOR Y=1 TO 6 640 WRITE #2: X,Y,0 'Data to be used later by allocate 650 NEXT Y 660 NEXT X 670 FOR X=1 TO 18 680 WRITE #2: 0 690 NEXT X 700 FILE #2: "*" 'Close rep file 770 ' 780 DATA 1,1,1,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2 790 ' 800 MAT READ S$(4) 'Read labels 810 DATA " FOR PLAINSVILLE"," FOR MADISON "," FOR RIVERSIDE " 820 DATA " FOR SPRINGFIELD" 830 ' 840 ' * * * Security Checks * * * 850 ' 860 READ #1: X6,X7 870 IF X6=X8 THEN 900 'Right scr file? 880 PRINT "INCORRECT WORLD NUMBER" 890 STOP 900 IF X7=X9 THEN 980 910 PRINT "TEAM NUMBER FROM FILE DOES NOT MATCH ENTRY IN SCR FILE" 920 STOP 930 ' 940 ' ***************** 950 ' * Read SCR Data * 960 ' ***************** 970 ' 980 READ #1:R9,K0,K1,I2,I4,S(1,1),S(1,2),S(1,3),S(1,4),S(1,5),A2,A3 990 READ #1:C3,B1,B2,D3,R2,R3,P9,J4,Q8 1000 LET X(1)=S(1,5) 'Experienced salesmen 1010 LET X(2)=S(1,1)+S(1,2)+S(1,3)+S(1,4) 'Inexperienced salesmen 1020 FOR X=1 TO 4 1030 READ #1: A(X,1),A(X,2) 'Read pages advertised t-1; t-2 1040 NEXT X 1050 ' 1060 FOR X=1 TO 4 'For city x 1070 FOR Y=1 TO 6 'And customer y 1080 READ #1: M(X,Y) 'M(x,y) = 0 if not called on; 1 if called on; 2 if interest; 3 if full delivery 1090 NEXT Y 1100 NEXT X 1110 ' 1120 FOR X=1 TO 4 'For city x 1130 READ #1: Z(X) 'Z(x) = 1 if <50% delivered last period, 0 otherwise 1140 NEXT X 1150 ' 1160 FILE #1:"*" 'Close scr file 1170 LET R9=R9+1 'Bump period up one 1180 PRINT FNP$(1);"PERIOD";R9;FNP$(3) 1190 LET F1=I5=T5=E1=B3=B4=B5=R1=C2=P2=P4=0 'Initialize working variables 1200 LET K=K1 1210 ' 1220 FOR X=1 TO 5 'For each training stage 1230 LET S(2,X)=0 'S(2,x) will contain # salesmen fired in the xth stage 1240 NEXT X 1250 ' 1260 FOR X=1 TO 4 'For each city 1270 LET P(0,X)=0 'P(0,x) will contain # pages advertising in city x 1280 NEXT X 1290 ' 1300 MAT F=ZER(4,6) 1310 MAT O=ZER(5,6) 1320 ' 1330 ' ********************** 1340 ' * Factor Receivables * 1350 ' ********************** 1360 ' 1370 IF A2=0 THEN 1910 'If no accounts receivable, can't factor 1380 PRINT"INPUT DOLLARS TO BE FACTORED"; 1390 INPUT F1 'F1 = dollars factored 1400 ' ***** 1410 IF F1=-9876543 THEN 1590 'Triggers administrative compensation 1420 ' ***** 1430 IF F1>=0 THEN 1460 'No negative factoring 1440 PRINT "NO NEGATIVE AMOUNTS PLEASE." 1450 GO TO 1380 1460 IF INT(F1)<> F1 THEN 1480 1470 GOTO 1870 'No fractional factoring 1480 PRINT "INTEGER AMOUNTS ONLY" 1490 GO TO 1380 1500 ' 1510 ' ******************************* 1520 ' * Administrative Compensation * 1530 ' ******************************* 1540 ' 1550 ' To trigger: 1560 ' 1. Enter -9876543 for Dollars to be Factored 1570 ' 2. Enter -1 for Salesmen Fired in 1st Stage 1580 ' 1590 PRINT 1600 PRINT"****************** ADMINISTRATIVE COMPENSATION ******************" 1610 ' 1620 PRINT "PASSWORD"; 1630 INPUT Q7$ 1640 REM PASSWORD IS 'BUK' IN CONTROL (NON-PRINT) CHARACTERS 1660 ' 1670 IF Q7$= Q6$ THEN 1690 1680 GOTO 1370 'Check for correct password 1690 IF R2=0 THEN 1780 'One way to give out cash is to sell prod. imp.; not possible when none 1700 PRINT R2;"PRODUCT IMPROVEMENTS. SELL"; 1710 INPUT R4,R5 'Input # of improvements to sell and proceeds 1720 LET R2=R2-R4 'Subtract sold improvements 1730 LET A3=A3+R5 'Add cash to sales 1740 LET K=K+R5 'Add new cash to working cash 1750 LET K1=K1+R5 1760 LET J4=J4+R5 'Add cash to earned surplus 1770 GOTO1830 1780 print"NO PRODUCT IMPROVEMENTS TO SELL. INCREASE ORIG INVEST. BY"; 'Alternate injection method 1790 INPUT K3 'Increase equity 1800 LET K=K+K3 'Add new equity investment to working cash 1810 LET K1=K1+K3 1820 LET K0=K0+K3 'Increase total capital 1830 PRINT"*****************************************************************" 1840 PRINT 1850 ' 1860 GO TO 1370 1870 IF F1<=A2 THEN 1900 'Check factored amt. versus receivables 1880 PRINT"YOUR SALES WERE ONLY $";A2 'Can't factor more than sold last period 1890 GOTO 1380 1900 LET K=K+F1 'Increase working cash by factored amount 1910 IF R9=1 THEN 2320 'If it's 1st period, no need to input salesmen data 1920 ' 1930 ' ***************** 1940 ' * Fire Salesmen * 1950 ' ***************** 1960 ' 1970 PRINT 1980 PRINT "INPUT SALESMEN FIRED WHILE IN TRAINING (4 STAGES) AND IN" 1990 PRINT "THE FIELD"; 2000 INPUT S(2,1),S(2,2),S(2,3),S(2,4),S(2,5) 2010 ' ***** 2020 IF S(2,1)<> -1 THEN 2040 2030 GOTO 1590 'Triggers admin. comp.; used when no receivables to factor 2040 ' ***** 2050 FOR X=1 TO 5 2060 IF S(2,X)>=0 THEN 2090 'No negative firing 2070 PRINT "PLEASE DO NOT TRY TO FIRE NEGATIVE SALESMEN." 2080 GO TO 1970 2090 IF S(2,X)=INT(S(2,X)) THEN 2120 'No fractional firing 2100 PRINT "SALESMEN ONLY COME IN ONE PIECE" 2110 GO TO 1970 2120 NEXT X 2130 ' 2140 FOR X=1 TO 5 'For each stage 2150 IF S(2,X)<=S(1,X) THEN 2250 'Can't fire more than you have in xth stage 2160 IF S(1,X)=0 THEN 2190 2170 PRINT "THERE ARE ONLY";S(1,X);"SALESMEN IN"; 2180 GO TO 2200 2190 PRINT "THERE ARE NO SALESMEN IN"; 2200 IF X=5 THEN 2230 2210 PRINT "TRAINING STAGE";X 2220 GO TO 1970 2230 PRINT "THE FIELD" 2240 GO TO 1970 2250 NEXT X 2260 ' 2270 ' ***************** 2280 ' * Hire Salesmen * 2290 ' ***************** 2300 ' 2310 LET X(3)=S(2,1)+S(2,2)+S(2,3)+S(2,4)+S(2,5) 'Salesmen fired 2320 PRINT 2330 PRINT "INPUT INEXPERIENCED,EXPERIENCED SALESMEN HIRED"; 2340 INPUT S(1,1),E1 'Input # salesmen for stage 1; experienced salesmen 2350 IF S(1,1)>=0 THEN 2380 'No negative hiring 2360 PRINT "YOU CANNOT HIRE ANTI-MATTER SALESMEN." 2370 GO TO 2320 2380 IF E1>= 0 THEN 2400 2390 GOTO 2360 'No negative hiring 2400 IF INT(S(1,1))=S(1,1) THEN 2430 'No fractional hiring 2410 PRINT "SALESMEN ONLY COME IN ONE PIECE" 2420 GO TO 2320 2430 IF INT(E1)= E1 THEN 2450 2440 GOTO 2410 'No fractional experienced salesmen 2450 ' 2460 GOSUB 4860 '1st check to see if team has spent more than it has 2470 ' 2480 PRINT 2490 ' 2500 ' **************** 2510 ' * Build Plants * 2520 ' **************** 2530 ' 2540 PRINT "INPUT IN LOTS:PLANT DES.,SITE CLEAR.,UNDER CONST.,"; 2550 INPUT B3,B4,B5 'Input # lots designed, cleared, and under construction 2560 LET X(6)=B3 'Plant design 2570 LET X(7)=B4 'Site cleared 2580 LET X(8)=B5 'Under construction 2590 IF B3>=0 THEN 2620 'No negative lots 2600 PRINT "WHAT!!! NEGATIVE PLANTS??" 2610 GO TO 2480 2620 IF B4>= 0 THEN 2640 2630 GOTO 2600 'No negative lots 2640 IF B5>= 0 THEN 2660 2650 GOTO 2600 2660 IF B3/5<>INT(B3/5) THEN 2700 'Lots must be built in multiples of 5 2670 IF B4/5<>INT(B4/5) THEN 2700 2680 IF B5/5<>INT(B5/5) THEN 2700 2690 GO TO 2720 2700 PRINT" INPUTS MUST BE IN MULTIPLES OF FIVE" 2710 GO TO 2480 2720 IF B4<=B1 THEN 2750 'Must have designed plant before clearing site 2730 PRINT"YOU ARE TRYING TO CLEAR SITES FOR MORE PLANTS THAN YOU HAVE DESIGNED" 2740 GO TO 2480 2750 IF B5<=B2 THEN 2780 'Must have cleared site last per. before building 2760 PRINT"YOU ARE TRYING TO BUILD MORE PLANTS THAN YOU HAVE CLEARED SITES FOR" 2770 GO TO 2480 2780 PRINT 2790 ' 2800 GOSUB 4860 '2nd check for bankruptcy 2810 ' 2820 ' **************************** 2830 ' * R & D, Consulting Inputs * 2840 ' **************************** 2850 ' 2860 PRINT "INPUT R&D,CONSULTING"; 2870 INPUT R1,C2 'R1 = r & d; c2 = consulting 2880 IF INT(R1)=R1 THEN 2910 'Integers only 2890 PRINT "INTEGER AMOUNTS PLEASE" 2900 GO TO 2780 2910 IF INT(C2)= C2 THEN 2930 2920 GOTO 2890 'Integers only 2930 IF C2>=0 THEN 2960 'No negative consulting expense 2940 PRINT" YOU CHEAT." 2950 GO TO 2780 2960 IF R1=0 THEN 3030 2970 IF R1>0 THEN 3000 'No negative r & d expense 2980 PRINT "R&D CANNOT BE NEGATIVE" 2990 GO TO 2780 3000 IF R1>=1E4 THEN 3030 'R & d must be 0 or > $10,000 3010 PRINT "R&D MUST BE 0 OR >10000" 3020 GO TO 2780 3030 PRINT 3040 ' 3050 GOSUB 4860 '3rd check for bankruptcy 3060 ' 3070 ' ***************************** 3080 ' * Manufacture/Purchase Lots * 3090 ' ***************************** 3100 ' 3110 PRINT "INPUT LOTS SCHEDULED, LOTS TO WIP, LOTS PURCHASED"; 3120 INPUT P1,P2,P4 3130 LET X(10)=P1 'Lots scheduled 3140 LET X(11)=P2 'Lots to wip 3150 LET X(12)=P4 'Lots purchased 3160 IF P1>=0 THEN 3190 'No negative scheduling 3170 PRINT "PLEASE DO NOT TRY TO GET MONEY WITH NEGATIVE LOTS" 3180 GO TO 3030 3190 IF P2>= 0 THEN 3210 3200 GOTO 3170 'No negative wip 3210 IF P4>= 0 THEN 3230 3220 GOTO 3170 'No negative purchasing 3230 IF P1=INT(P1) THEN 3260 'Integer lots only 3240 PRINT "FRACTIONAL LOTS ARE ILLEGAL" 3250 GO TO 3030 3260 IF INT(P2)= P2 THEN 3280 3270 GOTO 3240 'Integer lots only 3280 IF INT(P4)= P4 THEN 3300 3290 GOTO 3240 'Integer lots only