00,00x0E0 x0 0,&0x@@ B~0 0 0,L0e0~ xx  0,r0@@T~ ~ 0e0P'0%,0x0 xx,0@00ߋ 00$@ @8P@.j ,@xvrtp02468:<>},&@m,L@ H ``% %,r@`Q ULX,@ZM``%x_@B,@_fC_E_F_>G_G,@_I_lK 7 -, A7 7 7  Up,0AwvX 8%kU%7&,VA.X %k%7U>X 0,|Arw @A._5^6:>  ewE @ 7 RPVVff 6 NERROR 1 AT LINE D>|8Br<dr:4Z V^d   0  9 A Zft rt b-^H& R Tɋ4= & %\\ \ 7   p7  BʋE/¥  90dTo8q,  P DF40",&2@p` F777,L7 *  ĥ 7d,r ?  7GLRFNCDAMSPEXY,dVJFxEw^,7iVHE ^H: 6 xG,A  :xEE2BP>, w |85xww DONE ?,@. 5( w  ,f0 5$5x  R$ ;UPDATE: 27-APR-73 MTDIAG.S06 [FROM .S04] S06 ;18-MAY-72 ;24-NOV-71 ; MAG TAPE DIAGNOSTIC EXERCISER .ENABL CDR ;S06 .NLIST TOC S06 .TITLE MTDIAG ;01-10-73 .SBTTL MAG TAPE DIAGNOSTIC EXERCIZER ;01-10-73 ; THIS PROGRAM PROVIDES CAPABILITY T %lfw w WX ,A%Lw Dw @]<h`X %k,,A%7$oX E %x,A>:*X h%@,BX R%% Uw ,:BEpX *%k%7U@O,`BX %k%7|U X$,B %kd%7\U5pz5b,BrWh7 7  ,w jjV,BWW5BBw,B,C 7 p¥¥`%¥  ȇ\U@F•^•U@.& (7 fd wEF@^P0,B¥ W:W  7  7 J J@JJJJJJ&De! w C E%@e F!f&   ee  R`EE &  $XBaNCBBE SW BE &f :8r , D D   ," P5`5X d5 J0,5@x <EU7,w  5;"U,8 AEw \7d o,$5@bo5bj55ba@],Jp5 5  _f_,p`@E bd 65l,5bbx=hr&2,5@b0 5@bY@Ec,Ew, 3, e0 w hw |0 E O EXERCISE ONE SELECTED TAPE DRIVE S06 ; IN ALL ITS POSSIBLE FUNCTIONS. BOTH SINGLE COMMAND AND CONTINUOUS S06 ; AUTOMATIC TESTING ARE PROVIDED. DATA PATTERNS CAN BE SET UP BY THE S06 ; THE PROGRAM, OR CHOSEN BY THE OPERATOR. COMMUNICATION IS VIA BOTH S06 ; THE TELETYPE AND THE CONSOLE SWITCHES. PLEASE SEE THE OPERATING S06 ; INSTRUCTIONS FOR DETAILS. S06 R0 = %0 ;REGISTER DEFS R1 = ,DC,jCxX7 7 7 w ,C. Unh bV,CV w  \U82,C ,,\ XT>w 7 8,D7 2B"@$U p,(D  w Nte,NDX7@C~UX,tD  ,Dw pw jVWW@ B~,D7 tr`X E :8P:  :8  &:%, &  wxj 7 h7 p7 ZwD`8 ^W, >:&^ E f& eX`     66e & e ::P6F!NF0 2D >”`` $$  J @ w&<E ˂C!<E łBDE wvNF &@,.ERR w dRw w ,T?: 7 7e ,ze7 7ĝ 7a, 7wt7yT ,l7LZ "db,`f*  & 0 $ "  ĕ = >, N%W%Bw@Zw@w@lwPX,8LwPwP^7 ĥ:ĥ ĥ %,^w r&   , !w  D 0 ^M,E E   T!%1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 ;STACK POINTER PC = %7 ;PROGRAM COUNTER PS = 177776 ;CPU STATUS SWR = 177570 ;CONSOLE SWITCHES TKS = 177560 ;TTY KB STATUS TKB = 177562 ;TTY KB BUFFER TKI = 60 ;TTY KB VECTOR TPS = 177564 ;TTY STATUS TPB = 177566 ;TTY BUFFER MTN = 167540 ;MAG TAPE WORD COUNT MTS = 167542 ;MAG TAP^@P0 * ,DLVNw %?8 2wn, E5wN7 x7 7 S,2EXX %h,XEU w ",~Ee %7 7 7 ,Eh@vUVP J l,E>tw hLWt@$ ~ ,E7PwN8w  $%@5,F7 x7 w UX@,%1N< >  ¥:P¥  % w E L  7< 7 7 7 7 t~7 v7 h867 l@: \W C פ Ш $$$C  $ ` z we`Dђפ c5 m:T:H:E:N: D8 :W"W:W   W"W 3 C\:8 N\C  <>ND`E B`DB \ wp!LIST$LET$READ$REM$RUN$RESTORE$RE,ކ& D  D D D ,e0 * ,׭( ,  bߋtvrŀ],BH5xw7,h7ĝ!   & G, 7@fA | ,@fA A  ,  - /0!,7  aWX,&  5& m,L:   w  E STATUS MTC = 167544 ;MAG TAPE COMMAND MTA = 167546 ;MAG TAPE ADDRESS MTI = 104 ;MAG TAPE VECTOR BELL = 7 CR = 15 SPCE = 40 WRITBF = 6000 BUFLTH = 5000 ;BYTE LENGTH OF EACH BUFFER READBF = WRITBF+BUFLTH ;READ BUFFER .ASECT S06 ; NOTE: [X] PRINTS UNFLIPPED CRC PU?LU?HU?D,Fe? 2 0 . ,7 7 |x,F7 v7 UPhl^> 8,F  Z,bw -L! DP!,FH 4w %,5?$ 7 !, GU?e?5w7  @,FGx7 7 XU,lGD@  w ,GEteEB`  ~,Gw % b%?\7 V PLe,G _x5U xw 8w :,H@7 ?TURN$DATA$DIM$DELETE$PRINT$GOSUB$GOTO$IF$FOR$NEXT$INPUT$SAVE$STOP$END$DEF$OLD$RANDOMIZE$$< l l  d  0JJ@ :(READY ^67 RwSTOP AT LINE N7 :8 G,wv U J<wr7 G&  \L  A P < d-&: (T&:,TP: )fJJR D `: , w#`!NF:8U`J: (V J ): =@JH JDq: + -,r Ì C E t, C X BD < B,a  .  ԕ0 ,dd w  @@BQCRq, CC =  0  S06 ; [Y] PRINTS FLIPPED CRC S06 .PAGE .=1000 MTEXER: ;BEGIN OF EXERCISER MOV #.,SP ;SET STACK POINTER CLR R0 ;PREPARE FOR SETTING VECTORS CLR R1 INITV: TST (R1)+ ;BUMP TO POINT TO STATUS WORD MOV R1,(R0)+ ;ALL VECTORS POINT TO .+2 CLR (R1)+ ;PUT HALT IN VECTOR+2 TST (R0)+@XUU~,*HX w " D,PH7  w g,vH ?hx r ,Hfw @h%UU~ ,HpwzUUvw @%UU~ ,HLUUVwPw w5U,Ixw (w X*~,4IX7 ? ,ZIw @7 ?h,I xw @h%,I*~ *ww     : (& b& f :w  q  /fw @ Uw v Ue)w r ex  bf Bf e  )      )+-*/^d7f:8 .9 F;CXX:8,+C`XX:8$#E` $ j: (f^bf e O#: NG:8DC\G U`L; \L: (&^fJ Jhf^%)+ ;KEEP UP WITH R1 TSTB R0 ;LOW BYTE WILL CLEAR AT 400 BNE INITV MOV #MINT,@#MTI ;INIT MAG TAPE INTERRUPT MOV #300,@#MTI+2;INIT VECTOR STATUS:LVL #6 MOV #TTYINT,@#TKI ;INIT TTY KBD INTERRUPT MOV #200,@#TKI+2;TTY LEVEL #4 .PAGE HALT: RESET ;FORCES STOP OF TAPE ON DEMAND ; ; DIALOG = . ;BEGIN OF DIALOGUE WITH OPERATOR MOV #100,@#TKS;ENABLE TTY KBD INTERRUPT MOV #MTEXER,SP;RE ;KEEP UP WITH R1 TSTB R0 ;LOW BYTE WILL CLEAR AT 400 BNE INITV MOV #MINT,@#MTI ;INIT MAG TAPE INTERRUPT MOV #300,@#MTI+2;INIT VECTOR STATUS:LVL #6 MOV #TTYINT,@#TKI ;INIT TTY KBD INTERRUPT MOV #200,@#TKI+2;TTY LEVEL #4 .PAGE HALT: RESET ;FORCES STOP OF TAPE ON DEMAND ; ; DIALOG = . ;BEGIN OF DIALOGUE WITH OPERATOR MOV #100,@#TKS;ENABLE TTY KBD INTERRUPT MOV #MTEXER,SP;RESE ^w ,In@RhT7 L( ")DILw t ,>J@h%*~ *ww , ,dJw57 7 Jx/,Jw 2w vx5@XC5Rl,JhH5 `Xd2G5,J(>56*h:E(,Jw 8 E55,"Kw 0w E %53,HK  w\e%$7 j,nKE6LzXw ,KJE* / $&: (^@!&^م dw   e >k/]:a n4NV \ L #  W( &Z df&: =^w^b` > =  ! eR e ^fQ$b~><=<<=>>=    eeB w ee`!HT `!NE: 8 ww!OG`!OT& DF:,;*"+:3 0 " ^f t6eL  8 SET STACK POINTER MOV #140,@#PS ;RELEASE LOCKOUT JSR PC,CRLF ;BEGIN OF DIALOG W/OPR CLRB CHRFG CLRB MINTFG ;INIT TAPE INTERRUPT FLAG CLRB PPOS ;INIT FORMAT FLAG MOV #BELL,R4 INAGN1:CLRB MCODE ;INIT MNEMONIC SAVE LOC JSR PC,OCH MOV #'*,R4 JSR PC,OCH ;PRINT "*":REQUEST INPUT INAGN2:JSR PC,ICH ;GET MNEMONIC CHAR CMPB #CR,R4 ;RETURN? BEQ DOACT ;YES:GO DO F!T STACK POINTER MOV #140,@#PS ;RELEASE LOCKOUT JSR PC,CRLF ;BEGIN OF DIALOG W/OPR CLRB CHRFG CLRB MINTFG ;INIT TAPE INTERRUPT FLAG CLRB PPOS ;INIT FORMAT FLAG MOV #BELL,R4 INAGN1:CLRB MCODE ;INIT MNEMONIC SAVE LOC JSR PC,OCH MOV #'*,R4 JSR PC,OCH ;PRINT "*":REQUEST INPUT INAGN2:JSR PC,ICH ;GET MNEMONIC CHAR CMPB #CR,R4 ;RETURN? BEQ DOACT ;YES:GO DO FUN"$  EzE 5,K    `ZvXw XRU ,K*C5, G5-,Lhw $E5,,Lw (w 5Ew *@aWw ,RL(@mWw &@WUWmWaWW 5n,xLw7 7 5E-,LexXElwff&N,L`EtVE@` NB  ,LwVEPLE rU>,M,E&w  D@mWWE4,6M % # t e• BW W"    w:& %& f?@ *   ɕ w%  &W,W:W   df&D :,: & '& f2 & W  d w    w>  \ѥgC )+V =N &\Lf$& \U@L&fPJ@J^`!OT)^hWS `!TS `!PE^h @fA f  $UNCTION MOVB R4,MCODE ;SAVE CHAR BR INAGN2 DOACT: MOV #LSIZE-1,R1 ;INIT INDEX TSTB MCODE ;WAS CR FIRST CHAR? BNE DCMP ;NO ILEGAL:MOV #'?,R4 ;ILLEGAL CHAR BR INAGN1 ;GO BACK AND TRY AGAIN DCMP: CMPB MCODE,MNETAB(R1);IS THIS CHAR IN TABLE? BEQ FOUND ;YES: GO TO RTNE DEC R1 ;MORE? BGE DCMP ;KEEP LOOKING BR ILEGAL ;CHAR NOT IN TABLE FOUND: ASL %CTION MOVB R4,MCODE ;SAVE CHAR BR INAGN2 DOACT: MOV #LSIZE-1,R1 ;INIT INDEX TSTB MCODE ;WAS CR FIRST CHAR? BNE DCMP ;NO ILEGAL:MOV #'?,R4 ;ILLEGAL CHAR BR INAGN1 ;GO BACK AND TRY AGAIN DCMP: CMPB MCODE,MNETAB(R1);IS THIS CHAR IN TABLE? BEQ FOUND ;YES: GO TO RTNE DEC R1 ;MORE? BGE DCMP ;KEEP LOOKING BR ILEGAL ;CHAR NOT IN TABLE FOUND: ASL R&Ew D@WW,\M w D@aWmWaWw D@#,MuWuW5@|~Ew D@,MWFWWUR5<t 9,M>5(5U5 g,M 55E/,NE7PWtmtO,@NB`  U@5@e5,fN7  eEw5@w ,N*@aWw F@mW8WmWaWE@v7 z7 ,Nt5Fh^zX%"8O,N hPN' @` %w-  \WoC /V!  V&\L&U@\L f$e$&  HD &$1e$%&E7GUwf&   & & & :¥E<¥-J¥+D¥.;8U0f5V5 eU4   @2e51UE5 )UEU55 5U5U@53 U 5UUe%f5( R1 ;*2 TO INDEX WORDS CLRB CRSWCH ;INIT SWITCH FOR UNFLIPPED CRC S06 MOV RTNETB(R1),PC;GO TO PROPER ROUTINE MNETAB: .ASCII "LRFNCDAMSPEXY" ;LIST OF MNEMONICS ;01-10-73 ENDTAB:.EVEN LSIZE = ENDTAB-MNETAB ;SIZE OF MNEMONIC TABLE RTNETB:.WORD LOC,RECNT,FILECT,WORDCT,COMMND,DATAIN .WORD AUTO,MANUAL,STATUS,PARAMS,ERRSET .WORD CRCPRT,CRCFLP ;01-10-73 )1 ;*2 TO INDEX WORDS CLRB CRSWCH ;INIT SWITCH FOR UNFLIPPED CRC S06 MOV RTNETB(R1),PC;GO TO PROPER ROUTINE MNETAB: .ASCII "LRFNCDAMSPEXY" ;LIST OF MNEMONICS ;01-10-73 ENDTAB:.EVEN LSIZE = ENDTAB-MNETAB ;SIZE OF MNEMONIC TABLE RTNETB:.WORD LOC,RECNT,FILECT,WORDCT,COMMND,DATAIN .WORD AUTO,MANUAL,STATUS,PARAMS,ERRSET .WORD CRCPRT,CRCFLP ;01-10-73 .* D B m8D ,Nm4B e/D B eOB e`D 7 1,$O7  HF8qUU,JOBgP07 Xh/,pO -eeU,Om5 @,OdE]|vw fD@aWw \F@mW,OPZw LD@WBJw <D@W,P:E4w &D@WWWmWaWWW5f,.PXh ~D eh,TP!x U7w jVW,,zP7w jV+@L56 Um    e5P@z@KL@ & b 0 f-     e& eȥ   ee 0e %(%$C me ԕ. ԕ eԕ.ԕ0   ԕ. ԕEee &&  -ԕ  ԕ  r 0 `, .PAGE AUTO: MOV @#SWR,R1 ;AUTOMATIC WRITE AND READ CHECK BIC #146777,R1;GET UNIT # & INT. ABLE BITS MOV R1,UNITNO ;SAVE IT CLRB WRTCTR ;INIT COUNTER REWIND:MOV UNITNO,EXCOM INCB EXCOM+1 ;FORM REWIND COMMAND JSR PC,EXEC ;DO IT MOV UNITNO,EXCOM INC EXCOM ;FORM READ COMMAND TST @#SWR ;IS READ-ONLY BIT SET? BPL EXECAL ;YES DECB WRTCTR ;NO BITB #1,WRTCTR ;IS THIS-PAGE AUTO: MOV @#SWR,R1 ;AUTOMATIC WRITE AND READ CHECK BIC #146777,R1;GET UNIT # & INT. ABLE BITS MOV R1,UNITNO ;SAVE IT CLRB WRTCTR ;INIT COUNTER REWIND:MOV UNITNO,EXCOM INCB EXCOM+1 ;FORM REWIND COMMAND JSR PC,EXEC ;DO IT MOV UNITNO,EXCOM INC EXCOM ;FORM READ COMMAND TST @#SWR ;IS READ-ONLY BIT SET? BPL EXECAL ;YES DECB WRTCTR ;NO BITB #1,WRTCTR ;IS THIS A.W,WWW,,PUfVPNJ&v r,P%&le `$7 " ,PJXD@:7 62"Q07 ,Q7  &Xw XC5,8QG5 ,^QQ7 U ,Q  lEfXwp8,Q02R4 RN_6EM,Q_80:7 p5P5P$*QRXVTR,"S U7 7 *S/ `58! && fv   eP ef&& CB      4fPP     @ Е  Е-Е e0 ȕ efE  2  !    Aa@ a   &f6  c@ m%& C B A @  m@ N mAa@ N aN   Aa@ aC eef&fff C  eB A   `E E`  P@ewfE`0 A WRITE CYCLE BEQ EXECAL ;NO INC EXCOM ;SET TO WRITE EXECAL:JSR PC,EXEC ;GO READ OR WRITE BR REWIND ;NOW REWIND .PAGE MANUAL:MOV @#SWR,R1 ;DO ONE COMMAND SEQUENCE BIC #146777,R1;GET UNIT # & INT. ABLE BITS MOV COMAND,R2 ;GET COMMAND BITS BIC #31000,R2 ;MASK OUT UNIT & INT ENABLE BITS BIS R1,R2 ;PUT IN UNIT # MOV R2,EXCOM ;LOAD EXEC COMMAND WORD JSR PC,EXEC ;EXE1 WRITE CYCLE BEQ EXECAL ;NO INC EXCOM ;SET TO WRITE EXECAL:JSR PC,EXEC ;GO READ OR WRITE BR REWIND ;NOW REWIND .PAGE MANUAL:MOV @#SWR,R1 ;DO ONE COMMAND SEQUENCE BIC #146777,R1;GET UNIT # & INT. ABLE BITS MOV COMAND,R2 ;GET COMMAND BITS BIC #31000,R2 ;MASK OUT UNIT & INT ENABLE BITS BIS R1,R2 ;PUT IN UNIT # MOV R2,EXCOM ;LOAD EXEC COMMAND WORD JSR PC,EXEC ;EXECU2SЬD,HS̬C5 UD,nS7 7 hSG5|r c,SwUjSlSd],S w `7 X7 RSdTV,S2.G5& *,TUTT  z,,TU 7 7 ,RTw fX.TC5V,xTG5|r X4,T\hTbL\DV<,TPN*0X,3 $e BC  P f&& ED ?  s  A b A ,ef    4  @ Aa@ aeB     % (w%f&EDA& /  '  b A ef2 B A @    A @     S    P (DBC    B      Bf,e e&&&CBDa(!4CUTE COMMAND JSR R5,ONCH ;GOOD EXIT: PRINT "DONE" ;NO RETURN IF ERROR .WORD DONE .WORD 6 DMPSTA:BIT #1,@#SWR ;TEST STATUS DUMP OPTION BNE 2$ S06 JMP DIALOG S06 2$: JMP STATUS ;GO DUMP STATUS FIRST S06 ; DONE: .ASCII / DONE / .PAGE EXEC = . ;THIS 5TE COMMAND JSR R5,ONCH ;GOOD EXIT: PRINT "DONE" ;NO RETURN IF ERROR .WORD DONE .WORD 6 DMPSTA:BIT #1,@#SWR ;TEST STATUS DUMP OPTION BNE 2$ S06 JMP DIALOG S06 2$: JMP STATUS ;GO DUMP STATUS FIRST S06 ; DONE: .ASCII / DONE / .PAGE EXEC = . ;THIS IS6",T5U @<8Eh,U27 .7 *7 &7 "7 ,6Uw w w EhU,,\U-w D@Ww 6@HWp,UFWHWWw D@Ww F@Ww ,U6@HWFWHWWW%.e,U7L@F%<"4 53,U@    ,Ve7 %w,A,@VB`"Ee0E7 7 7  3,fV @|7 p7߆  ,@ w   BCD! !  IM NOT READY VERSION 008A *O <  hl<f&  e . e W$@ W$   e&e,(*Bee yZ XJ M PflUU.,<&B,,H GIS THE EXECUTIVE SUBROUTINE MOVB NFILES,XFILES ;INIT FILE CTR MOV #WRITAD,XADDR;SET FOR WRITE BUFFER BIT #1,EXCOM ;READ? BEQ NEWFILE ;NO: WRITE MOV #READAD,XADDR;NOW POINT TO READ NEWFIL:MOV NRECS,XRECS ;INIT RECORDS CTR CALDRV:JSR R5,MDRIVE ;CALL DRIVER BR EXEC02 .WORD EXCOM ;COMMAND SET UP PRIOR XADDR: .WORD 0 ;WRITE OR READ BUFR .WORD XCOUNT ;HOLDS #WDS/RECORD EXEC02:BIG THE EXECUTIVE SUBROUTINE MOVB NFILES,XFILES ;INIT FILE CTR MOV #WRITAD,XADDR;SET FOR WRITE BUFFER BIT #1,EXCOM ;READ? BEQ NEWFILE ;NO: WRITE MOV #READAD,XADDR;NOW POINT TO READ NEWFIL:MOV NRECS,XRECS ;INIT RECORDS CTR CALDRV:JSR R5,MDRIVE ;CALL DRIVER BR EXEC02 .WORD EXCOM ;COMMAND SET UP PRIOR XADDR: .WORD 0 ;WRITE OR READ BUFR .WORD XCOUNT ;HOLDS #WDS/RECORD EXEC02:BIT E,Vxtt%j WEL7 H7 D7 ,V@%J=2@W4pEP,Vjw w w mTEt,Ve @ C~%DATA ERR @%STAT],$WUS ERR @%EXTRA BKS @%DK ADDR ERR @%@ A,JW ERR CNT @%RANEX ERR @ DAR @ !,pWDAE @ DCS @ HRD ERR@ W,WRD CNT@ WRD ADDR.@ GD DATA,W @ BD DATA @?@/@ WRD1 @ ,W WRD2 @%UNIT NO.@ @ READ @%CPU BK,XGRND TIMED OUT@%OK!@%DATA TEST ONLY? @FTN,e@e e mwDU\ X>uCƴ x-.x &e     e& f&,f&&,&&aaG"&e @ e&E ez(* $R:BJ|QNSKQu QNd& $ X  ,DDDDDDD @D """"""ADDB CKQ.K E 8 RcTơKcT 8$Ďa ͋,L  B8w&B ` % & }&*C$$Βe E%>k  aʋaՀ$ & * P$ ΋Ί   ΋   d Ί  ( 1'u  Q$f $5@ U C΋ Cb M΋U@ U &  B" .&0 M &0 & M 0 &,.X%MULTI DK MODE?@%# OF DKS 1 TO 10 OCTAO,TXL?@%EX. DK?@%OPT WRD CNT? @%LENGTH (1 ,zXTO 1000)?@%WRD ADDR?@%OPT. DATA PAT. #,X?@%WRITE?@%WRITE CHECK?@%READ?@%END@*x*P@iJebn& & & z,,t t e(*e  e|QDnHC 2aϏnaf $ . 6 $e v &,:4000me . e , eyZjBnKR b)%Iw\j¥L¥D¥E¥H¥ C8 7:¥ 9¥,: r p j K #1,EXCOM ;WAS IT READ? BEQ MORECS ;NO: NO TEST BIT #4,@#SWR ;BYPASS PRINTOUT? BNE MORECS ;YES MOV WRITAD,R1 ;YES: COMPARE BUFFERS MOV READAD,R2 MOV XCOUNT,R5 ;# OF WORDS IN RECORD TO COMPAR .PAGE XLOOP1:DEC R5 ;REACHED END? BMI MORECS ;YES CMP (R1)+,(R2)+ ;COMPARE LIST ENTRY BEQ XLOOP1 ;AGREE JSR PC,CRLF ;BEGIN NEW LINE FOR PL. GYND 37 C VLENG GYND 40 C VECTOR DIRECTION OF NEEDLES. GYND 43 C INDICES N,NJ,NI,NEED NUMBER OF NEEDLES ANGLES LENGTHS(RADII), GYND 46 C NUMBER OF NEEDLE FOR THIS CALCULATION. GYND 49 GYND 52 FUNCTION GYNDOS(POINT, RHO,TCF, D, NJ,NI,NEED)M)J DNEE 280 9880 FORMAT(I6,' IS NOT AN ACCEPTABLE SELECTION'/' RE-ENTER'/) DNEE 283 GO TO 100 DNEE 286 DNEE 289 C IMPROPER RESPONSE, NO PLANE YET DEFINED DNEE 292 95 CONTINUE DNEE 295 IF(ICTL(10) .NE. 1) WRITE(IUOUT,9591Nh7 Z7 X7 V7 kT7 RjDj: <j&j"6@7 m pthl  E  FwZ@ 7 f7 d7 b7 f  7 R7 P^ "  |tw w:wTC`N @7 wՕ 7 w>6@: Y N &,@, &&e  ee@(J_ DO YOU REQUIRE EXP OORINTOUT MOV R1,R4 ;CURRENT ADDRESS + 2 SUB WRITAD,R4 ;GET OFFSET + 2 TST -(R4) ;GET CURRENT OFFSET JSR PC,PRINT MOV -2(R1),R4 ;GET CONTENTS OF WRITE BUFFER JSR PC,PRINT MOV -2(R2),R4 ;GET CONTENTS OF READ BUFFER JSR PC,PRINT BR XLOOP1 ; PRINT: JSR PC,PRTNUM JSR PC,FORMAT RTS PC .PAGE MORECS = . ;HERE AFTER COMPLETION OF COMMAND BITP GYND 55 DIMENSION POINT(3),D(13,11), RHO(13),TCF(13,11) GYND 58 COMMON /NEEDLE/ END(3,2,20), CENTER(3,20), ALENG(20), GYND 61 1 VLENG(3,20), TLENG(20), ACTIVE(20), FILT(20), NONDL, FMAG GYND 64 CALL TRCOF GYND 67 C*************************************************** GYND 70 C WRITE(5,9550)RHO,NJ,NI,NEED Q) DNEE 298 IF(ICTL(10) .EQ.1) WRITE(IUOUT,9592) DNEE 301 GO TO 100 DNEE 304 DNEE 307 9591 FORMAT('0I CANNOT DO THAT UNTIL I HAVE NEEDLE INFORMATION'/ DNEE 310 1 ' INSUFFICIENT DATA HEH, HEH.'//) DNEE 313 9592 FORMAT('0 A PLANE MUST BE CALCULATED FIRST'//) RR LOG (FLOATING ^)?xDO YOU NEED THE EXTENDED FUNCTIONS?HIGH-SPEED READER/PUNCH?SET UP THE EXTERNAL FUNCTION?MEMORY? <@S #4,EXCOM ;CHECK FOR FILE MARK COMMAND BNE FILMRK ;YES: ALREADY DID IT BIT #313,EXCOM;CHECK FOR PER-RECORD COMMAND BEQ MOREFILES;NOT A PER-RECORD COMMAND DEC XRECS ;ANY MORE RECORDS? BNE CALDRV ;YES: GO DO THEM BIT #12,EXCOM ;WAS LAST COMMAND WRITE? BEQ MOREFILES ;NO:DON'T WRITE E-O-F BIT #40000,@#SWR;IS E-O-F OPTION SELECTED ? BEQ MOREFILES ;NO:NO WRITE E-O-F MOV EXCOM,R0TGYND 73 C9550 FORMAT(' RHO '/7F10.3/10X,6F10.3/' NJ,NI,NEED' GYND 76 C 1 3I6) GYND 79 C WRITE(5,9551)TCF,D GYND 82 C9551 FORMAT(' TCF'/11(7F10.3/10X,6F10.3/)' D'/ GYND 85 C 1 11(7F10.3,/10X,6F10.3/)) GYND 88 AL=ALENG(NEED) GYND 91 SAU DNEE 316 DNEE 319 C TERMINATION REQUESTED DNEE 322 99 ENDFILE 4 DNEE 325 CALL DELTF('COMMON','TMP') DNEE 328 CALL EXIT DNEE 331 DNEE 3W ;CURRENT COMMAND BIC #146777,R0 ;LEAVE INTRT ABLE & UNIT SELECT BIS #4,R0 ;SET WRITE FILE MARK MOV R0,EOFCOM ;CREATE CORRECT E-O-F COMMAND WRTEOF:JSR R5,MDRIVE ;WRITE FILE MARK BR MOREFILES .WORD EOFCOM ; MOREFI = . ;CHECK FOR MORE NON-SPACE ;RECORD OR FILE COMMANDS BIT #73,EXCOM BEQ EXRTN ;NOT RECORD OR FILE COMMAND FILMRK: ;DONE WXL=SQRT(AL*AL*AL) GYND 94 C*********************************************** GYND 97 C CALCULATE DISTANCE FROM CENTER OF NEEDLE TO POINT. GYND 100 VL=1.E-6 GYND 103 C WRITE(5,9552)(CENTER(J,NEED),VLENG(J,NEED),J=1,3) , GYND 106 C 1 POINT GYND 109 C9552 FORMAT(' CENTER'4X34 END DNEE 337 Z ALTE 205 IF(I .NE. K) GO TO 50 ALTE 208 45 CONTINUE ALTE 211 HOURS(K) = HOURS(K) * RFAC ALTE 214 50 CONTINUE ALTE 217 WRITE(IUOUT,9030) ALTE 220 READ(IUIN,9040)I [RITING FILE MARK DECB XFILES ;MORE FILES? BNE NEWFILE ;YES EXRTN: RTS PC ;EXIT EXEC ROUTINE .PAGE ; MAG TAPE DRIVER ; ; CALLING SEQUENCE ; JSR R5,MDRIVE ; BR NEXT ; .WORD A(COMMAND) ; .WORD A(MEM ADDR) ; .WORD A(COUNT) ; ;THIS IS THE MAG TAPE DRIVER ROUTINE MDRIVE:CLR R3 ;RESET ERROR NUMBER MOV @2(R5),R1 ;COMMAND BIC #147777,R1 ;UNIT # CMP R1,CURUNT \' VLENG'/ 3(2F10.3/) , GYND 112 C 1 / ' POINT'3X,3F10.3) GYND 115 DOT=0. GYND 118 DO 10 J=1,3 GYND 121 R=CENTER(J,NEED)-POINT(J) GYND 124 VL = VL + R * R GYND 127 10 DOT = DOT + VLENG(J,NEED) * R SUBROUTINE CCNTUR(IMAT,IX,IY,LEVEL,DOSE,DELG,DSTEP) CCNT 1 CALL EXPLOR(IMAT,24,IX,IY,LEVEL,DOSE,DELG,DSTEP) CCNT 4 RETURN CCNT 7 END CCNT 10 ^ ALTE 223 IF(I .NE. '0') GO TO 1 ALTE 226 90 WRITE(LIST,9100)(IBLK,I,HOURS(I),I=1,NONDL) ALTE 229 CALL LINK('DK1:DNEEDL') ALTE 232 9030 FORMAT( 2X,'=0 FOR EXIT.') ALTE 235 9040 FORMAT(A1) ALTE 238 END _ ;SAME AS PREVIOUS? BNE MDRV02 ;NO MDRV01:CLRB EXSWCH ;NORM EXIT SWITCH MOV CURUNT,@#MTC;SELECT UNIT IN CASE RESET JSR PC,DELAY ;MUST WAIT BEFORE STATUS CHECK BIT #100,@#MTS ;CTRLR BUSY? BNE ERR2 ;YES BIT #200,@#MTS ;READY? BEQ ERR3 ;NO BIT #16,@2(R5) ;WRITE REQUEST? BEQ MDRV06 ;NO: NO FPT CHECK BIT #1,@#MTS ;WRITE PROTECT? BNE ERR4 ;YES ` GYND 130 VL=SQRT(VL) GYND 133 CALL ROUT(VL) GYND 136 CALL ROUT(DOT) GYND 139 GYND 142 C SET ANGLE INFO. GYND 145 RCOS = ABS( DOT / (VL * TLENG(NEED)) ) aC * * * L C N T U R * * * LCNT 1 C LCNT 4 C****** VERSION OF NOV 16 1972 LCNT 7 C LABELS CONTOURS LCNT 10 C LCNT 13 SUBROUTINE LCNTUR(IMAT,NX,NY,IX,IY,DELX,DELY,LEVEL LCNT 16 *,NUMLEV,DOSL ALTE 241 c.PAGE MDRV06: MOV #100,@#TKS ;RESET CONTROLLER (CLEAR STAT & COMMAND) BIT #13,@2(R5) ;IS IT EITHER READ OR WRITE? BEQ MDRV03 ;NO: NOT BUFFER COMMAND BIT #1,@2(R5) ;IS IT READ? BEQ MDRV07 ;NO: SKIP BUFFER CLEAR MOV READAD,R0 ;CURRENT READ BUFFER BEGIN MDRV08: CLR (R0)+ ;CLEAR READ BUFFER CMP R0,#READBF+BUFLTH-2 ;REACHED BUFFER LIMIT? BLOS MDRV08 d GYND 148 SANG = RCOS * RCOS GYND 151 SANG = SQRT(ABS(1. - SANG)) GYND 154 CANG=FLOAT(NJ)- SANG*(FLOAT(NJ)-1.) GYND 157 MA=CANG GYND 160 C***************************** GYND 163 C CALL ROUT( RCOS) GYND 166eEV) LCNT 19 C LCNT 22 C - - - DRAWS CONTOURS OF IMAT=LEVEL AS A FUNCTION OF X AND Y LCNT 25 C IMAT IS AN NX BY NY ARRAY LCNT 28 C DELX AND DELY ARE THE SPATIAL INTERVALS CORRESPONDING LCNT 31 C TO AN INCREMENT IN X OR IN Y RESPECTIVELY LCNT 34 C NUMLEV IS INDEX ON CONTOUfC . . . I N T E R . . . INTE 1 SUBROUTINE INTER( IMAT,NX,NY, IX, IY, P, Q, T, MODE) INTE 4 C INTE 7 C LJ LIDOFSKY 23 JUNE 1972 INTE 10 C - - - INTERPOLATES WITHIN THE IX,IY CELL OF INTE 13 C THE NX BY NY MATRIX IMAT INTE 16 C P AND Qg ;NOT YET MDRV07: ;CONTINUE MOV @4(R5),@#MTA ;LOAD MEM ADDR REG MOV @6(R5),@#MTN ;LOAD COUNTER REG MDRV03:MOV @2(R5),R0 ;FETCH COMMAND WORD FROM LIST MDRV3A:MOV R0,R2 ;TEMPORARY SWAB R2 BIC #177775,R2;GET INT ABLE BIT MOVB R2,MINTFG ;SAVE (EITHER 10 OR 0) CLR @#MTS ;STATUS REG RESET ;****************************************************** MOV R0,@#MTC ;LOAD COMMAND REGISTER: ;INITh C CALL ROUT(SANG) GYND 169 C CALL ROUT(CANG) GYND 172 C CALL ROUT(RVL) GYND 175 GYND 178 C TRAP OUT POINTS NEAR CENTER OF NEEDLE GYND 181 C AND FORCE TO MINIMUM RHO. GYND 184 RVL=VL/AL iR BEING DRAWN LCNT 37 C - - - DOSLEV IS NUMERIC VALUE OF DOSE ON CONTOUR LCNT 40 LOGICAL LSKIP,LOW LCNT 43 DIMENSION IMAT(NX,NY), ISYM(10) LCNT 46 DATA AX,AY/ .04, .04/ LCNT 49 DATA JUMLEV,XLAB,YLAB/-12345, 8.1, 10./ LCNT 52 DATA ISYM(1),ISYM(2),ISYM(3),ISYM(4),ISYM(5),ISYj ARE THE FRACTIONAL INCREMENT WITHIN THE CELL INTE 19 C IN THE IX AND IY DIRECTION RESPECTIVELY INTE 22 C T IS THE VALUE OF IMAT AT THE INTERPOLATED POINT INTE 25 C IF MODE = 1 T AND P ARE GIVEN, Q IS RETURNED INTE 28 C IF MODE = 2 T AND P ARE GIVEN, Q IS RETURNED INTE 31 C IF MODE = 3 Q AND P ARE GIVEN, T IS RETURNED INTE 34 C IF MODE = 4 Q AND P ARE kIATES TAPE OPERATION ;****************************************************** JSR PC,DELAY ;MUST WAIT BEFORE CHECKING STATUS .PAGE MDRV05: BIT #1000,@2(R5) ;INTRPT ABLED? BEQ BUSYCK ;NO: CHECK BUSY LOADCK: ;LOAD-POINT CHECK BIT #2,@#MTS ;AT LOAD POINT? BNE BUSYCK ;YES: WAIT FOR BUSY TO CLEAR TSTB MINTFG ;INTRPT ABLED: WATCH FLAG BNE LOADCK l GYND 187 IF (RVL .LT. RHO(1)) GO TO 25 GYND 190 C SET RADIUS INDEX GYND 193 DO 20 L=2,NI GYND 196 IF(RVL .LT. RHO(L)) GO TO 30 GYND 199 20 CONTINUE GYND 202 L=NI mM(6),ISYM(7), LCNT 55 *ISYM(8),ISYM(9),ISYM(10) / 2HA=, 2HB=, 2HC=, 2HD=, 2HE=, 2HF=, 2HGLCNT 58 * 2HH=, 2HI=, 2HJ=/ LCNT 61 C - - - IDENTIFY CROSSINGS LCNT 64 C CHECK FOR CLEAR ALPHA POSITION TRIGGER. LCNT 67 IF(IX .NE. -1) GO TO 3 LCNT 70 C INITIALIZE FOR NEW PLOT nGIVEN, DQ/DP IS RETURNED AS T INTE 37 C NOTE IF IX AND IY HAVE NOT CHANGED, INTE 40 C - - - CERTAIN CONSTANTS NEED NOT BE RECALCULATED INTE 43 INTEGER A,B,C,D,T INTE 46 DIMENSION IMAT(NX,NY) INTE 49 CALL SSWTCH(0,JISW) INTE 52 IF(IX.EQ.IXOLD .AND. IY.EQ.IYOLD) GO TO 10 o ;NO INTRPT YET: CHECK LOAD POINT AGAIN EXIT: TSTB EXSWCH ;EXIT OR RETURN? BNE MDRV01 ;BACK AFTER NEW UNIT SELECT MOV @#MTS,STAT;SAVE STATUS BIT ERRPAT,STAT;SEE IF ANY ACTIVE ERRORS BNE ERR5 ;YES:OPERATOR MUST DUMP STATUS RTS R5 ;EXIT DRIVER ; BUSYCK:BIT #100,@#MTS;CHECK "BUSY" BIT BNE BUSYCK ;STILL BUSY BR EXIT ;BUSY BIT IS CLEARED ; DELAY: MOV #60,R0 ;WAIT A SHp GYND 205 GO TO 30 GYND 208 C RVL IS LESS THAN MINIMUM GYND 211 25 L = 2 GYND 214 C LM1 AND MAP1 ARE ALTERED INDICES FOR INTERPOLATION. GYND 217 30 LM1=L - 1 GYND 220 MAP1 = MA + 1 qLCNT 73 NUMLEV = 0 LCNT 76 DOSOLD = 0. LCNT 79 YLAB = 10. LCNT 82 RETURN LCNT 85 LCNT 88 3 IF(DOSOLD .EQ. DOSLEV) GO TO 4 LCNT 91 C r INTE 55 IXOLD=IX INTE 58 IYOLD=IY INTE 61 IT = IMAT(IX,IY) INTE 64 A=IT INTE 67 B=IMAT(IX+1,IY) - IT INTE 70 IT= IMAT(IX,IY+1) - IT sORT TIME BEFORE CHECKING STATUS DEC R0 ;MAKING FIRST CHECK ON STATUS BNE .-2 RTS PC ; MDRV02:BIT #100,@#MTS;TEST CTRLR STATUS "BUSY" FLAG BNE ERR1 ;OLD UNIT STILL BUSY INCB EXSWCH ;SET SWITCH TO RE-ENTER ROUTINE MOV @2(R5),R0 ;AFTER NEW SELECT BIC #146777,R0 ;GET NEW UNIT # & INT ABLE MOV R0,R1 BIC #147777,R1 MOV R1,CURUNT ;SAVE NEW UNIT # BR MDRV3A ;NOW SELEt GYND 223 DL1=D(LM1,MA) GYND 226 DL2=D(LM1,MAP1) GYND 229 TL1=TCF(LM1,MA) GYND 232 TL2=TCF(LM1,MAP1) GYND 235 R1=RHO(LM1) GYND 238 R2=RHO(L) u NEW ISODOSE LEVEL CONTOUR LCNT 94 DOSOLD = DOSLEV LCNT 97 NUMLEV = NUMLEV +1 LCNT 100 4 KV = 0 LCNT 103 IF(IMAT(IX ,IY ).LT.LEVEL ) KV = KV + 1 LCNT 106 IF(IMAT(IX+1,IY ).LT.LEVEL ) KV = KV + 2 LCNT 109 IF(IMAT(IX+1,IY+1).LvINTE 73 C = IT INTE 76 D = IMAT(IX+1,IY+1)-IMAT(IX+1,IY) - IT INTE 79 10 IF ( MODE.EQ.4) GO TO 50 INTE 82 GO TO ( 20, 30, 40), MODE INTE 85 20 IF (B.EQ.0 .AND.D.EQ.0) GO TO 25 INTE 88 P=(T-A-Q*C)/(B+Q*D) INTE 91 IFwCT UNIT .WORD ,,,,,,,,,, ;PATCH SPACE ; ; ERR5: INC R3 ;MASKED ERROR(S) FOUND AT COMPLETIOM ERR4: INC R3 ;FILE PROTECT VIOLATION ERR3: INC R3 ;CONTOLLER NOT READY ERR2: INC R3 ;CONTROLLER BUSY ERR1: INC R3 ;OLD UNIT BUSY ON NEW SELECT ADD #60,R3 ;FORM ERROR NUMBER IN ASCII JSR PC,PRTERR ;GO PRINT ERROR MESSAGE JMP DMPSTA ;SEE IF STATUS DUMP BEFORE EXIT ; ; PRTERR:JSR PC,CRLF ;PRINT ERROx GYND 241 D1=(DL1+(D(L, MA)- DL1)*(RVL-R1)/(R2-R1))/(RVL*RVL) GYND 244 T1=(TL1+(TCF(L,MA)-TL1)*(RVL-R1)/(R2-R1))*(RVL*.01) GYND 247 IF (MA .LT. NJ ) GO TO 40 GYND 250 D2=D1 GYND 253 GO TO 50 GYND 256 40 D2=(DL2+(D(L,MAP1)-DL2)*(RVL-R1)/(R2-R1))/(RVL*RVL) GYND 259 50 yT.LEVEL ) KV = KV + 4 LCNT 112 IF(IMAT(IX ,IY+1).LT.LEVEL ) KV = KV + 8 LCNT 115 IF ( KV.GT.7 ) KV=15 - KV LCNT 118 C - - - KV = 0 MEANS NO CROSSING LCNT 121 IF ( KV.EQ.0 ) RETURN LCNT 124 IF (NUMLEV .EQ. JUMLEV) GO TO 5 LCNT 127 C z(JISW .EQ. 1) INTE 94 1WRITE(5 ,1000) IX,IY,P,Q,T,MODE INTE 97 RETURN INTE 100 25 P=0.5 INTE 103 IF(JISW .EQ. 1) INTE 106 1WRITE(5 ,1000) IX,IY,P,Q,T,MODE INTE 109 RETURN {R MESSAGE JSR R5,ONCH .WORD ERRBUF .WORD 4 MOV R3,R4 JSR PC,OCH ; GO PRINT ERROR NUMBER RTS PC ERRBUF:.ASCII /ERR / .EVEN ; ; OUTIN: JSR PC,PRTNUM ;PRINT CURRENT VALUE OF PARAME JSR R5,ONCH .WORD REQBUF .WORD 4 JSR R5,INN ;REQUEST A NEW VALUE IFLAG: .BYTE 0 ;ERROR FLAG IDIGS: .BYTE 0 ;# DIGITS TSTB IDIGS ;ANY DATA? BNE RTN ;YES | T2=(TL2+(TCF(L,MAP1)-TL2)*(RVL-R1)/(R2-R1))*(RVL*.01) GYND 262 TP=T1+(T2-T1)*(CANG-MA) GYND 265 TF=1.-SAL*TP GYND 268 C******************************* GYND 271 C FORCE TCF TO ONE FOR CHECKING. GYND 274 TF = 1. GYND 277 GYNDOS = TF*(D1+(D} LCNT 130 C - - - IF NUMLEV HAS CHANGED, IT IS A NEW CONTOUR LCNT 133 JUMLEV= NUMLEV LCNT 136 X= XLAB LCNT 139 YLAB= YLAB - .5 LCNT 142 C LCNT 145 C - - - ENTER ID IN TABLE ~ INTE 112 30 Q= (T-A-P*B)/(C+P*D) INTE 115 IF(JISW .EQ. 1) INTE 118 1WRITE(5 ,1000) IX,IY,P,Q,T,MODE INTE 121 1000 FORMAT(2I4,2F10.3,2I10) INTE 124 RETURN INTE 127 40 T=A+P*B+Q*(C+P*D)  JMP DIALOG ;NO: HE WAS JUST LOOKING RTN: RTS PC ;NEW DATA IN R4 REQBUF:.ASCII / ?:/ ERRSET:MOV ERRPAT,R4 ;CURRENT MASK FOR STATUS WORD JSR PC,OUTIN ;PRINT AND ASK MOV R4,ERRPAT ;STORE NEW ONE BR ERRSET ;VERIFY LOC: MOV OFFSET,R4 ;MEMORY BUFFER LOCATION JSR PC,OUTIN ;PRINT & ASK MOV R4,OFFSET ;STORE NEW VALUE MOV R4,R3 ;OFFSET ADD #WRITBF,R3 ;CALC ACTUAL MEMORY LOC'N M2-D1)*(CANG -MA))*ACTIVE(NEED)/(AL*AL) GYND 280 RETURN GYND 283 END GYND 286 LCNT 148 CALL SYMBOL( X, YLAB, .24, ISYM(NUMLEV), 0., 2) LCNT 151 CALL NUMBER(X+.5,YLAB, .24, DOSLEV,0.,2) LCNT 154 C LCNT 157 5 CONTINUE LCNT 160 DP = AX/DELX LCNT 163 DQ = AY/DELY LCNT 166 INTE 130 IF(JISW .EQ. 1) INTE 133 1WRITE(5 ,1000) IX,IY,P,Q,T,MODE INTE 136 RETURN INTE 139 C - - - NOTE THAT T MEANS DQ/DP IN THE NEXT STATEMENT INTE 142 50 T= -(B+Q*D)/(C+P*D) INTE 145 RETURN OV R3,WRITAD ;LOAD IT ADD #READBF,R4 ;CALC BEGIN OF READ BUFFER MOV R4,READAD BR LOC ;PRINT AGAIN FOR CHECK ; RECNT: MOV NRECS,R4 ;# OF RECORDS PER FILE JSR PC,OUTIN MOV R4,NRECS BR RECNT FILECT:MOVB NFILES,R4 ;# OF FILES PER TEST JSR PC,OUTIN MOVB R4,NFILES BR FILECT ; WORDCT:MOV XCOUNT,R4 ;#WORDS/RECORD JSR PC,OUTIN MOV R4,XCOUNT BR WORDCT ; SUBROUTINE CROSS3(A,B,C) CROS 1 DIMENSION A(3),B(3),C(3) CROS 4 C(1)=A(2)*B(3) - B(2) * A(3) CROS 7 C(2) = A(3)*B(1) - A(1) * B(3) CROS 10 C(3)= A(1)*B(2) - A(2)*B(1) CROS 13 RETURN CROS 16 END XZ = (IX-1)*DELX LCNT 169 YZ = (IY-1)*DELY LCNT 172 LSKIP = .FALSE. LCNT 175 GO TO ( 10, 10, 55, 65,150, 10, 65), KV LCNT 178 C LCNT 181 C - - - LOWER BASE HAS BEEN CROSSED LCNT 184 10 KSW = KV INTE 148 END INTE 151 ; MINT = . ;THIS IS THE MAG TAPE INTERRUPT RTNE TSTB MINTFG ;IS MAG TAPE INTERRUPT EXPECTED? BNE .+10 ;YES HALT ;;NO: ERROR JMP DIALOG ;MAY "CONTINUE" AFTER HALT CLRB MINTFG ;SHOW THAT INTERRUPT HAS COME I RTI ; COMMND:MOV COMAND,R4 ;COMMAND FORMAT (MANUAL) JSR PC,OUTIN MOV R4,COMAND BR COMMND ; PARAMS:MOV #PLIST,R2 ;LIST INPUT PARAMETERS BR STAT1 ;USE CROS 19 LCNT 187 LOW=.TRUE. LCNT 190 IF (KSW.EQ.6) KSW = 3 LCNT 193 M=3 LCNT 196 Q=0. LCNT 199 DELQ=DQ LCNT 202 MODE = 1 SUBROUTINE NORM3(A,R) NORM 1 DIMENSION A(3) NORM 4 R=0. NORM 7 DO 10 J=1,3 NORM 10 10 R=R + A(J) * A(J) NORM 13 IF(R .EQ. 0.) RETURN NORM 16 R= 1. / SQRT PRINT STATUS ROUTINE ; STATUS:MOV #SLIST ,R2 ;PRINT STATUS WORDS STAT1: MOV (R2)+,R4 ;GET NEXT REGISTER ADDRESS BEQ DLGRTN ;LAST ENTRY IS ZERO MOV (R4),R4 ;GET CURRENT REGISTER CONTENTS JSR PC,PRTNUM JSR PC,FORMAT BR STAT1 ; SLIST: .WORD MTC,MTS,MTN,MTA,STAT,0 ; PLIST: .WORD COMAND,OFFSET,XCOUNT,NRECS,NFILES .WORD ERRPAT,0 ; ; DATAIN = . ;THIS IS THE ALL-PURPOSE DATA RTNE MOVB #SPCE,R4 JSR C * * * V E C T 2 P * * * VECT 1 VECT 4 C VECT2P VECT 7 C PARAMATERS . . . VECT 10 C A A THREE VECTOR VECT 13 C B A THREE VECTOR VECT 16 C IUOU LCNT 205 15 CALL INTER( IMAT, NX, NY, IX, IY, P,Q, LEVEL, MODE) LCNT 208 C FIX FOR KV=6 LCNT 211 GO TO ( 20, 45, 18) ,KSW LCNT 214 18 IF (P.LT.0.) P=0. LCNT 217 IF (P.GT.1.) P=1. LCNT 220 GO TO 25 (R) NORM 19 DO 20 J=1,3 NORM 22 20 A(J) = A(J)*R NORM 25 RETURN NORM 28 END NORM 31 PC,OCH MOV #'=,R4 JSR PC,OCH ;REQUEST 'B' OR "W" JSR PC,ICH ;FIRST CHR MOV #100000,R1 ;READY FOR BYTE SET/CLEAR CMP #'W,R4 ;"W"? BEQ DWORD ;YES:FORM LIST BY WORDS CMP #'B,R4 ;"B"? BEQ BWORD ;YES:FORM BY BYTES BR DATAIN ;TRY AGAIN DWORD: BIC R1,MOVINS ;SET FOR WORD REFERENCES BIC R1,DMOVE BIC R1,PRTDAT BR GETCHR BWORD: BIS R1,MOVINS ;ST USER OUTPUT DEVICE LOGICAL NUMBER VECT 19 C IUIN USER DEVICE INPUT LOGICAL NUMBER VECT 22 C VECT 25 C A,B ARE RETURNED AS ORTHO-NORMAL VECTORS IN THREE SPACE VECT 28 VECT 31 SUBROUTINE VECT2P(A,B,IUOUT,IUIN) VECT 34 LCNT 223 C - - - CROSSING IS FROM LOWER BASE TO LEFT EDGE LCNT 226 C FIX FOR KV=1 LCNT 229 20 IF (P) 30, 22, 21 LCNT 232 21 IF ( P .GE. 1.) GO TO 30 LCNT 235 GO TO 25 LCNT 238 22 LSKIP = .TRUE. C . . . T P L O T . . . TPLO 1 C TPLO 4 C COMMON PLANE HAS THE SPECIFICS OF A PARTICULAR PLANE AND TPLO 7 C ITS DOSES. TPLO 10 COMMON /PLANES/IDOSE(24,24), FACT, SCALE, DOSMAX, DOSMIN , TPLO 13 1 NEEINT(30), XYINT(2,30), STEPHO(3), STEPVE(3), CORNER(3), TPLO 16 2 RLEVEL(10ET FOR BYTE REFERENCES BIS R1,DMOVE BIS R1,PRTDAT GETCHR:CLRB $COLON CLR R3 ;WORD IN LIST COUNTER JSR PC,ICH ;2ND CHR:SPACE,COLON,OR RETURN CMPB #':,R4 BEQ COLON ;COLON-REQUEST A NEW LIST CMPB #SPCE,R4 BEQ GETNUM ;PRINT REQUEST W/SPEC'D ADDR CMPB #CR,R4 BEQ DODATA ;RETURN: GO EXECUTE BR DATAIN ;NONE OF ABOVE: TRY AGAIN GETNUM:JSR R5,INN ;INPUT A NUM VECT 37 DIMENSION A(3),B(3),C(3) VECT 40 INTEGER VTITLE(5,2) VECT 43 VECT 46 DATA VTITLE/'HO','RI','ZO','NT','AL',' V','ER','TI','CA','L '/ VECT 49 VECT 52 10 I=1 LCNT 241 25 Y = YZ + Q*DELY LCNT 244 X = XZ + P*DELX LCNT 247 CALL PLOT(X,Y,M) LCNT 250 IF ( LSKIP ) GO TO 300 LCNT 253 M=2 LCNT 256 Q = Q + DELQ LCNT 259 ) , NUMLEV TPLO 19 TPLO 22 COMMON /SETIO/NER,LINF(10) TPLO 25 TPLO 28 COMMON /NEEDLE/ END(3,2,20), CENTER(3,20), ALENG(20), VLENG(3,20)TPLO 31 1 , TLENG(20), ACTIVE(20), FILT(20), NONDL, FMAG, HOURS(20) TPLO 34 BER DFLG: .BYTE 0 DDIG: .BYTE 0 TSTB DDIG ;ANY DATA ENTERED BEQ DODATA ;NO:GO EXECUTE MOV R4,-(SP) ;PUT DATUM IN STACK TST (R3)+ ;COUNT WORDS OF DATA BR GETNUM COLON: INCB $COLON ;SHOW THAT THIS IS A LOAD BR GETCHR+4 DODATA:TSTB $COLON ;EXECUTE DATA LIAT LOAD BEQ DDUMP ;NO COLON,SO DUMP MOV #WRITBF,R4 ;INIT BUFFER POINTER TST R3 ;ANY DATA ENTERED? BNE VECT 55 WRITE(IUOUT,9100)(VTITLE(J,I),J=1,5) VECT 58 READ(IUIN,9200) A VECT 61 IF(A(1).EQ.0..AND.A(2).EQ.0..AND.A(3).EQ.0.) GO TO 60 VECT 64 20 I=2 VECT 67 WRITE(IUOUT,9100)(VTITLE(J,I),J=1,5) VECT 70 READ(IUIN,9200) B IF ( LOW ) GO TO 28 LCNT 262 IF ( Q.GE.0. ) GO TO 70 LCNT 265 Q = 0. LCNT 268 GO TO 40 LCNT 271 28 IF (Q.LE.1.) GO TO 15 LCNT 274 Q = 1. LCNT 277 LSKIP = .TRUE. TPLO 37 DIMENSION XYSAV(2,30) TPLO 40 DATA DELX,DELY/2*.34783/ TPLO 43 DATA LIST,IUOUT, IUIN/5, 7, 6/ TPLO 46 C START AT TOP TPLO 49 C PLACE INTERSECTIONS IN COMMON THEN PLOT THEM(611) TPLO 52 DO 9898 KK=1,30 DLIST ;YES: GO LOAD IT ;FILL LIST WITH INTEGER SEQUENCE: 1,2,3....N MOVINS:MOV R3,(R4)+ ;LOAD WORD (OR BYTE) INC R3 ;EACH ONE INCREMENTING CMP R4,#WRITBF+BUFLTH ;REACHED END? BLO MOVINS ;NOT YET DLGRTN:JMP DIALOG ;COMMON EXIT TO BEGIN DIALOGUE DDUMP: TST R3 ;ANY ADDRESS? BNE ADRSPC ;YES MOV #WRITBF,R1 ;NO:USE WRITE BUFFER MOV #WRITBF+BUFLTH-2,R5 ;SET BUFFER END POINTERVECT 73 IF(B(1).EQ.0..AND.B(2).EQ.0..AND.B(3).EQ.0.) GO TO 60 VECT 76 COS=0. VECT 79 R =0. VECT 82 S =0. VECT 85 DO 30 I=1,3 VECT 88 R=R+A(I)*A(I) VECT 91 S= LCNT 280 GO TO 15 LCNT 283 30 P = 0. LCNT 286 35 MODE = 2 LCNT 289 40 LSKIP = .TRUE. LCNT 292 GO TO 60 LCNT 295 C - - - CROSSING IS FROM LOWER BASE TO TPLO 55 DO 9898 KL = 1,2 TPLO 58 XYSAV(KL,KK) = XYINT(KL,KK) TPLO 61 XYINT(KL,KK) = XYINT(KL,KK) * .34783 / .3937 TPLO 64 9898 CONTINUE TPLO 67 200 CONTINUE TPLO 70 CALL PLOT(0.,0.,0) PRTDAT:MOV (R1)+,R4 ;FETCH WORD (BYTE) JSR PC,PRTNUM ;PRINT IT JSR PC,FORMAT ;,CAN BE STOPPED BY "HALT" CMP R1,R5 ;REACHED END OF BUFFE? BLOS PRTDAT ;KEEP GOING BR DLGRTN ;YES ADRSPC:MOV (SP)+,R1 ;SET LOW ADDR (IF ONLY ONE LIMIT MOV R1,R5 ;SET HIGH ADDR LIMIT SETHI: TST -(R3) TST R3 ;ONLY ONE DATUM? BEQ PRTDAT ;YES MOV (SP)+,R1 ;SET LOW LIMIT S+B(I)*B(I) VECT 94 30 COS = COS + A(I) * B(I) VECT 97 COS = COS /SQRT(R) /SQRT(S) VECT 100 C COS .866 FOR 30 DEGREE INTERIOR ANGLE VECT 103 IF (COS .GT. .9) GO TO 70 VECT 106 CALL CROSS3( A,B,C) VECT 109 CALL CROSS3( C,A,B)RIGHT EDGE LCNT 298 C - - - EITHER CROSSING IS FROM LOWER BASE TO UPPER LCNT 301 C - - - BASE, OR SIDE HAS NOT BEEN CROSSED LCNT 304 C FIX FOR KV=2 LCNT 307 45 IF ( P-1.) 46, 22, 50 LCNT 310 46 IF ( P .LE. 0.) GO TO 50 LCNT 313 GO TO 25 TPLO 73 C CLEAR POSITION OF LVL ALPHAS IN LCNTUR. TPLO 76 NUMLEV =0 TPLO 79 IDUM =1 TPLO 82 CALL CCNTUR(IDUM,-1,IDUM,IDUM,DUM,DUM,DUM) TPLO 85 DDHO = DELX * SCALE TPLO 88 DDVE = DELY * SCALE TPLO 91 NS BR SETHI ;GO CHECK FOR EMPTY STACK DLIST: MOV SP,DNDEX ;INIT INDEX TO POINT AT STACK DLIST1:MOV R3,R5 ;INIT STACK INDEXER TST -(R5) ;LESS ONE SINCE 1ST WD INDEX=0 TST R5 BLT DLIST1 ;LIST DEPLETED:BEGIN AGAIN DMOVE: MOV 0(R5),(R4)+;TRANSFER WORD (OR BYTE) TO BUFF DNDEX = .-2;LABEL FOR INDEX IN "DMOVE":REF'D @ DLIST CMP R4,#WRITBF+BUFLTH BHIS DLGRTN ;BUFFER FULL: EXIT BR DLIST1+2 ;CONTINUE FI VECT 112 CALL NORM3( A,R) VECT 115 CALL NORM3( B,R) VECT 118 RETURN VECT 121 CNEWPAGE VECT 124 60 WRITE(IUOUT,9160) VECT 127 GO TO (10,20),I LCNT 316 50 P = 1. LCNT 319 GO TO 35 LCNT 322 C LCNT 325 C - - - CROSSING IS FROM SIDE TO SIDE LCNT 328 55 P=0. LCNT 331 M=3 LCNT 3TEPH = (8. / DDHO) -.01 TPLO 94 NSTEPV = (8. / DDVE) -.01 TPLO 97 DO 210 JH = 1, NSTEPH TPLO 100 RHOR = JH * DDHO TPLO 103 DO 210 JV = 1,NSTEPV TPLO 106 RVER = JV * DDVE TPLO 109 210 CALL SYMBOL (RHOR,RVLLING BUFFER ; ; PRTNUM = . ;PRINT NUMBER SUBROUTINE MOV R0,-(SP) ;SAVE USED REGISTERS MOV R3,-(SP) MOV #6,R0 ;DIGIT COUNT FOR "PRINT A NUMBER" MOV R4,R3 ;# TO PRINT CLR R4 ;1ST DIG ASL R3 ROL R4 BR PRT020 PRT010:CLR R4 ;NEXT 5 DIGS ASL R3 ROL R4 ASL R3 ROL R4 ASL R3 ROL R4 PRT020:ADD #60,R4 ;MAKE TTY CHR VECT 130 VECT 133 70 WRITE(IUOUT,9170) VECT 136 GO TO 20 VECT 139 VECT 142 9100 FORMAT( ' ENTER '5A2' VECTOR,F4.1'/) VECT 145 9200 FORMAT( 3F4.1) 34 MODE = 2 LCNT 337 60 CALL INTER(IMAT, NX, NY, IX, IY, P, Q, LEVEL, MODE) LCNT 340 C FIX FOR KV=3 LCNT 343 IF ( Q .GT.1.) Q = 1. LCNT 346 IF ( Q .LE.0.) Q = 0. LCNT 349 X = XZ + P*DELX LCNT 352 Y = YZ +ER,.06, '+' , 0., -1) TPLO 112 TPLO 115 C BORDER ON AREA. TPLO 118 CALL PLOT(0.,0.,3) TPLO 121 CALL PLOT( 0.,8.,2) TPLO 124 CALL PLOT( 8.,8.,2) TPLO 127 CALL PLOT( 8.,0.,2) JSR PC,OCH ;PRINT CHAR DEC R0 ;DONE? BGT PRT010 ;NO MOV (SP)+,R3 ;RESTORE REGISTERS MOV (SP)+,R0 RTS PC ;RETURN ; ; FORMAT:INCB PPOS ;POSITION POINTER CMPB PPOS,#10 ;8 POS PRINTED? BGE FOR020 ;YES:NEW LINE MOV #40,R4 ;NO:OUTPUT 2 SPACES JSR PC,OCH JSR PC,OCH RTS PC FOR020:JSR PC,CRLF ;DO RETURN &LF RTS PC ; ; ; VECT 148 9160 FORMAT( ' ZERO VECTOR NOT ALLOWED.'/) VECT 151 9170 FORMAT( ' VERTICAL VECTOR TOO PARALLEL TO HORIZONTAL.'/) VECT 154 VECT 157 END VECT 160 Q*DELY LCNT 355 CALL PLOT(X,Y,M) LCNT 358 IF ( LSKIP ) GO TO 300 LCNT 361 M = 2 LCNT 364 P = P + DP LCNT 367 IF ( P.LE.1. ) GO TO 60 LCNT 370 P = 1. TPLO 130 CALL PLOT( 0.,0.,2) TPLO 133 CALL INT611 TPLO 136 CNEWPAGE TPLO 139 C PLOT A CURVE TPLO 142 TPLO 145 C GET A LEVEL OUTPUT A CHARACTER ; OCH: TSTB @#TPS ;TTY READY? BPL OCH ;NO MOVB R4,@#TPB ;YES:OUTPUT CHAR RTS PC ; ; TTYINT:MOVB @#TKB,TTYTMP ;TTY KB INTERRUPT BICB #600,TTYTMP;CLEAR CHANNEL EIGHT CMPB #'H,TTYTMP ;IS CHAR HALT CHAR "H"? BNE FLGTST ;NO BIT #2,@#SWR ;CHECK FOR "RESET" OPTION BEQ DLGRTN ;NOT SELECTED: NO RESET JMP HALT ;YES:GO STOP UNITS FIRST FLGTST:TSTB REQFLG C . . . I N T P L T . . . INTP 1 INTP 4 C INTPLT PLOTS NEEDLE NUMBERS AT INTERSECTIONS WITH THE INTP 7 C PLANE BEING PLOTTED INTP 10 INTP 13 C PARAMETERS INTP 16 LCNT 373 GO TO 35 LCNT 376 C LCNT 379 C - - - CROSSES UPPER BASE LCNT 382 65 KSW=KV/5+1 LCNT 385 LOW = .FALSE. LCNT 388 M=3 TPLO 148 WRITE(IUOUT,9903)SCALE,CORNER,STEPHO,STEPVE,DOSMIN,DOSMAX TPLO 151 9903 FORMAT('0SCALE='F5.2' TO 1', TPLO 154 1 T45' X Y Z'/ TPLO 157 2 T25'ORIGIN'T45,3F7.2/ T25'HORIZONTAL STEP'T45,3F7.2/ TPLO 160 3 T25'VERTICAL STEP' T45,3F7.2/' DOSE MINIMUM 'F7.2, TPLO 163 4' MAXIMUM 'F7.2) TPLO 166 ;REQUEST PENDING? BEQ TYEXIT ;NO CLRB REQFLG INCB CHRFG ;INDICATE CHAR READY TYEXIT:RTI ; ; ICH: INCB REQFLG ;INPUT A CHARACTER & ECHO IT TSTCH: TSTB CHRFG ;IS ONE AVAILABLE BEQ TSTCH ;NO CLRB CHRFG ;CLEAR READY FOR NEXT TIME MOVB TTYTMP,R4 ;YES CMP R4,#CR ;IS THIS A CARRIAGE RETURN? BNE ECHO ;NO: GO ECHO IT JSR PC,CRLF ;YES: OUTPUT LF, TOO RTS P INTP 19 SUBROUTINE INTPLT INTP 22 DIMENSION RHIT(3), STEP(2) INTP 25 INTP 28 COMMON/NEEDLE/END(3,2,20),CENTER(3,20), ALENG(20), VLENG(3,20) , INTP 31 1 TLENG(20), ACTIVE(20), FILT(20),NONDL,FMAG INTP 34 2 , HOURS(20) LCNT 391 Q=1. LCNT 394 DELQ=-DQ LCNT 397 MODE=1 LCNT 400 70 CALL INTER(IMAT, NX, NY, IX, IY, P, Q, LEVEL, MODE) LCNT 403 GO TO (75, 85),KSW LCNT 406 C FIX FOR KV=4 75 WRITE(IUOUT,9680) TPLO 169 9680 FORMAT(6X'=LEVEL') TPLO 172 9601 FORMAT(F5.2) TPLO 175 READ(IUIN,9601)RLEVL TPLO 178 C CHECK FOR END TPLO 181 IF(RLEVL .EQ. -1.) GO TO 999 TPLO 184 IF(RLEVL .C ; ECHO: JSR PC,OCH ;ECHO ON TTY RTS PC ;CHAR IS IN R4 ; ; CRLF: MOV R4,-(SP) ;SAVE MOV #5015,R4 ;CR & LF JSR PC,OCH ;PRINT LOW BYTE SWAB R4 JSR PC,OCH CLRB PPOS ;RESET FOR POSSIBLE FORMAT MOV (SP)+,R4 ;RESTORE RTS PC ; ; ; OUTPUT N CHARS ; CALLING SEQUENCE: ; JSR R5,ONCH ; .WORD BUFADR ADDRESS OF FIRST (LOW) CHARACTER ; .WORD NCHAR # O INTP 37 INTP 40 COMMON /PLANES/IDOSE(24,24), FACT, SCALE, DOSMAX, DOSMIN , INTP 43 1 NEEINT(30), XYINT(2,30), STEPHO(3), STEPVE(3), CORNER(3), INTP 46 2 RLEVEL(10) , NUMLEV INTP 49 INTP 52 DATA LIST/5/ ,IUOUT/7/ LCNT 409 75 IF (P - 1.) 76, 22, 80 LCNT 412 76 IF (P .LE. 0.) GO TO 80 LCNT 415 GO TO 25 LCNT 418 80 P=1. LCNT 421 GO TO 35 LCNT 424 C FIX FOR KV=7 LCNT 427 8EQ. -2.) GO TO 200 TPLO 187 IF(RLEVL .GT. DOSMIN .AND. RLEVL .LT. DOSMAX) GO TO 80 TPLO 190 TPLO 193 C ERROR IN DOSE LINE REQUEST TPLO 196 WRITE(IUOUT,9840) TPLO 199 9860 FORMAT(' MAXIMUM DOSE= 'E11.4/' MINIMUM DOSE = 'E11.4/) TPLO 202 WRITE(IUOUT,9860)DOSMAX,DOF CHARS ; ONCH: MOV (R5)+,R0 ;BUF ADR MOV R1,-(SP) ;SAVE IT MOV (R5)+,R1 ;# CHARS ONC010:MOVB (R0)+,R4 ;OUTPUT CHAR JSR PC,OCH DEC R1 ;DONE? BGT ONC010 ;NO MOV (SP)+,R1 ;RESTORE RTS R5 ; INPUT CHARS FROM TTY UNTIL CR ; CALLING SEQUENCE -- ; JSR R5,INCH ; .WORD BUFADR LOW BUF ADR ; .BYTE MAXCH MAX # CHARS ; .BYTE # CHARS READ INCH: MOV (R5)+,R0 INTP 55 INTP 58 C CLEAR INTERSECT POINTS INTP 61 DO 1 J=1,30 INTP 64 DO 1 K=1,2 INTP 67 NEEINT(J) =0 INTP 70 1 XYINT(K,J)=0. 5 IF (P) 90, 22, 86 LCNT 430 86 IF (P .GT. 1.) GO TO 90 LCNT 433 GO TO 25 LCNT 436 90 P = 0. LCNT 439 GO TO 35 LCNT 442 150 CONTINUE LCNT 445 200 CONTINUE SMIN TPLO 205 GO TO 75 TPLO 208 9840 FORMAT (' LEVEL IS OUTSIDE ACCEPTABLE RANGE.') TPLO 211 TPLO 214 80 LEVEL = RLEVL * FACT TPLO 217 NUMLEV = NUMLEV +1 TPLO 220 IF(NUMLEV .GT. 15) GO TO 200 ;GET BUF ADR MOV R1,-(SP) ;SAVE IT MOVB (R5)+,R1 ;GET MAX CHAR CNT CLRB (R5) ;INIT COUNT INC010:JSR PC,ICH ;GET A CHAR CMPB R4,#215 ;CR? BEQ INC020 ;YES INCB (R5) ;CHR CNT CMPB (R5),R1 ;TOO MANY? BGT INC010 ;YES: IGNORE UNTIL CR MOVB R4,(R0)+ ;PUT IN BUF BR INC010 ;NEXT INC020:INC R5 ;BUMP TO RETURN MOV (SP)+,R1 ;RESTORE RTS INTP 73 KNOW =1 INTP 76 INTP 79 CALL TRCOF INTP 82 DO 100 J = 1,NONDL INTP 85 C FIND INTERSCTIONS. INTP 88 CALL INTSCT(CORNER, STEPHO, STEPVE, END(1,1,J), END(1,2,J) , INTP 91 1 LCNT 448 C LCNT 451 C - - - CHECK IF CURVE SHOULD BE LABELED LCNT 454 300 LM= MOD(IX,2)+MOD(IY,2)+MOD(NUMLEV,2) LCNT 457 IF (LM .EQ. 3 .OR. LM .EQ. 0) LCNT 460 * CALL SYMBOL(X, Y, .18, ISYM(NUMLEV), 0.,-1) LCNT 463 RETURN TPLO 223 RLEVEL(NUMLEV) = RLEVL TPLO 226 CALL SSWTCH(0,ISW) TPLO 229 IF(ISW .EQ. 1) WRITE(LIST,9902) LEVEL TPLO 232 9902 FORMAT('0LEVEL='I6) TPLO 235 TPLO 238 DSTEP = DELX / 8. R5 ;EXIT ; INPUT A POSITIVE OR NEGATIVE OCTAL NUMBER FROM TTY; ; A CR IS EXPECTED AS A DELIMITER AFTER THE LAST DIGIT ; ; CALLING SEQUENCE -- ; ; JSR R5,INN ; .BYTE 0 -1,0,1 ON RETURN IF NEG, ERROR, POS ; .BYTE 0 NO OF DIGITS READ ; NUMBER RETURNED IN R4, 2'S COMP IF NEG ; INN: CLR (R5)+ MOV R3,-(SP) CLR R3 INN010: JSR PC,ICH ;GET A CHAR TO R4 RHIT, ISW) INTP 94 INTP 97 C CHECK FOR NO HIT OR CO-PLANAR. INTP 100 IF(ISW .EQ. 0) GO TO 100 INTP 103 IF(ISW .EQ. 2) GO TO 50 INTP 106 INTP 109 C ELSE ONLY ON LCNT 466 END LCNT 469 TPLO 241 DO 100 IX=1,23 TPLO 244 DO 100 IY = 1,23 TPLO 247 100 CALL CCNTUR(IDOSE,IX,IY, LEVEL, RLEVL, DELX, DSTEP) TPLO 250 GO TO 75 TPLO 253 999 CONTINUE TPLO 256 DO 9899 KK = 1,30 TPLO 259 CMPB R4,#' ;IGNORE BLANKS BEQ INN010 CMPB R4,#'- ;IS IT A MINUS SIGN '(*) BEQ INN020 ;YES CMPB R4,#CR ;NO, IS IT A CR BEQ INN030 ;YES CMPB R4,#'/ BEQ INN030 ;SLASH COUNTS SAME AS RETURN CMPB R4,#60 ;IS IT A VALID OCTAL DIGIT BLT INN060 ;NO CMPB R4,#67 ;MAYBE BGT INN060 ;NO ASL R3 ;YES, MOVE DIGIT INTE HIT INTP 112 R1=0. INTP 115 R2=0. INTP 118 DO 10 K=1,3 INTP 121 R1 = R1 + STEPHO(K) *(RHIT(K) - CORNER(K)) * SCALE INTP 124 10 R2 = R2 + STEPVE(K)* (RHIT(K) - CORNER(K)) * SCALE INTP 127 XYINT(1,KNOW) = R1 DO 9899 KL = 1,2 TPLO 262 XYINT(KL,KK) = XYSAV(KL,KK) TPLO 265 9899 CONTINUE TPLO 268 CALL LINK('DK1:DNEEDL') TPLO 271 TPLO 274 END TPLO 277 O NUMBER ASL R3 BCS INN060 ;GT 177777? ASL R3 BCS INN060 ;GT 177777? BICB #370,R4 ADD R4,R3 INCB -1(R5) ;INCREMENT DIGIT CNT BR INN010 ;GET NEXT DIGIT INN020: MOVB #-1,-2(R5) ;SET FLAG TO NEG NUMBER BR INN010 ;GET NEXT DIGIT INN030: CMPB -1(R5),#6 ;EXCEED 6 DIGITS? BGT INN060 ;YES, ERROR MOV R3,R4 ;NO TSTB INTP 130 XYINT(2,KNOW) = R2 INTP 133 NEEINT(KNOW) = J INTP 136 KNOW = KNOW +1 INTP 139 IF(KNOW .GE. 31) GO TO 200 INTP 142 GO TO 100 INTP 145 CNEWPAGE -2(R5) ;IS NUMBER NEG. BEQ INN050 ;NOT NEG NEG R4 ;YES, TWO'S COMP NUMBER INN040: MOV (SP)+,R3 ;RESTORE R3 RTS R5 ;EXIT W/RESULT IN R4 INN050: MOVB #1,-2(R5) ;SET FLAG TO POS NUMBER BR INN040 INN060: CLRB -2(R5) ;SET FLAG TO ERROR BR INN040 .PAGE ;******* SYSTEM SUBPROGRAM TO PRINT WRITE AND READ CRCC'S********* CRCFLP: INCB CRSWCH ;SET SWITCH FOR "FLIPPED" DATA INTP 148 C THE NEEDLE LIES ON THE PLANE INTP 151 INTP 154 C CALCULATE CM. LOCATIONS OF ENDPOINTS ON PLANE INTP 157 50 IF(KNOW+1 .GE.31) GO TO 200 INTP 160 KEND = 0 INTP 163 KL = KNOW +1 INTP 166 S06 CRCPRT: JSR PC,CRLF MOV WRITAD,R0 JSR PC,CRCCHK JSR PC,FORMAT MOV READAD,R0 JSR PC,CRCCHK JMP DIALOG ;********** ROUTINE TO CALCULATE CRCC FROM WRITE AND READ BUFFERS... ; ...AND PRINT EACH OUT IN BINARY: [7 6 5 4 3 2 1 0 P] CRCCHK: MOV XCOUNT,R1 ;WORDS ASL R1 ;BYTES CLR R2 ;CRCC CRC100: MOVB (R0)+,R3 DO 60 KI = KNOW, KL INTP 169 XYINT(1,KI) = 0. INTP 172 XYINT(2,KI) = 0. INTP 175 KEND = KEND +1 INTP 178 DO 60 K=1,3 INTP 181 XYINT(1,KI) = XYINT(1,KI) + (END(K,KEND,J)-CORNER(K))*STEPHO(K) INTP 184 1 * ;WORK REG CRSWCH: BR .+2 ;SWITCH FOR BYPASSING FLIPPING DATA BYTES ;01-10-73 BR 4$ ;01-10-73 CLR R5 ;WILL RECEIVE FLIPPED BYTE ;01-10-73 MOV #8.,R4 ;01-10-73 2$: ASLB R3 ;SHIFT NEXT BIT INTO CARRY ;01-10-73 RORB R5 ;...AND THEN INTO NEW (REVERSED) BYTE ;01-10-73 SCALE INTP 187 60 XYINT(2,KI) = XYINT(2,KI) +(END(K,KEND,J)-CORNER(K))*STEPVE(K) INTP 190 1 * SCALE INTP 193 NEEINT(KNOW) = J INTP 196 NEEINT(KNOW+1) = J INTP 199 KNOW = KNOW +2 INTP 202 C ESTABLISH STEPPED PO DEC R4 ;01-10-73 BNE 2$ ;01-10-73 MOV R5,R3 ;01-10-73 4$: ;01-10-73 MOV R3,-(SP) ;ALSO WORK MOV #8.,R4 CLR R5 ;PARITY CRC110: ASR (SP) ;SHIFT OFF NTH BIT ADC R5INTS INTP 205 DO 65 K=1,2 INTP 208 65 STEP(K) = XYINT(K,KNOW-2) - XYINT(K,KNOW-1) INTP 211 C GET TOTAL STEP LENGTH INTP 214 STEPL = STEP(1)*STEP(1)+STEP(2)*STEP(2) INTP 217 STEPL = SQRT(STEPL) INTP 220 NSTEP = SCALE*STEPL*.5 -.5 ;ACCUM SET BIT COUNT DEC R4 BNE CRC110 SWAB R3 CLRB R3 TST (SP)+ INC R5 ;MAKE PARITY ODD ASR R5 ;SHIFT PARITY TO CARRY ADCB R3 SWAB R3 ;PARITY BIT NOW IN BIT #8 JSR PC,EOR ;EOR NEW DATA WORD INTO CRC CLR R4 MOV R2,R3 ;NEW CRCC SWAB R3 ASRB R3 ;P INTP 223 IF(NSTEP .LE. 0) GO TO 100 INTP 226 KSAV = NSTEP -1 INTP 229 DO 80 JSTEP = 1,KSAV INTP 232 DO 70 K=1,2 INTP 235 70 XYINT(K,KNOW) = XYINT(K,KNOW-1) + STEP(K) / NSTEP INTP 238 KNOW = KNOW +1 TO C FOR FOLLOWING SHIFT TO BIT #0 ROLB R2 ;THIS IS THE CRC SHIFT (P TO 0, ETC.) ADC R4 ;SAVE NEW PARITY BIT BEQ CRC120 ;NOT SET: BYPASS SELECTIVE INVERSIONS MOV #74,R3 JSR PC,EOR ;INVERT BITS 2,3,4 & 5 IN NEW CRCC CRC120: SWAB R2 ;PRESERVE LOW 8 BITS CLRB R2 ;PREPARE FOR PARITY BIT ADD R4,R2 ;PUT 0 OR 1 FOR PARITY SWAB INTP 241 IF(KNOW .GE. 31) GO TO 200 INTP 244 80 CONTINUE INTP 247 INTP 250 100 CONTINUE INTP 253 RETURN INTP 256 200 WRITE(IUOUT,9500) INTP 259 R2 ;***NEW CRCC WITH PARITY AND INVERSIONS* DEC R1 ;ANY MORE DATA BYTES? BNE CRC100 ;YES MOV #753,R3 ;NO: PREPARE TO DO FINAL INVERSION JSR PC,EOR ;INVERT ALL FINAL BITS BUT #2 & 4 ;******* NOW PRINT THE COMPUTED CRCC IN BINARY***** MOV #9.,R5 MOV #CRCBUF,R4 CRC130: MOVB #60,(R4)+ ;INIT PRINT BUFFER TO ALL ZEROS DEC R5 BNE CRC130 WRITE(LIST,9500) INTP 262 9500 FORMAT(' TOO MANY INTERSECTIONS TO BE PLOTTED.'/) INTP 265 RETURN INTP 268 END INTP 271 SWAB R2 ;PARITY FIRST ASRB R2 ADCB -(R4) SWAB R2 MOV #8.,R5 CRC150: ASRB R2 ADCB -(R4) DEC R5 BNE CRC150 JSR R5,ONCH ;PRINT THE NINE BITS .WORD CRCMSG .WORD CRBFLN RTS PC EOR: ;SUBROUTINE TO EOR R3 INTO R2 MOV R3,R5 BIC R2,R5 BIC R3,R2 BIS R5,R2 RTS PC CRCMSG: .ASCII "CRCC = " CRCBUF: .BYTE 0,0,0,0,0,0,0,0,0 CRBFLN = .-CRCMSG .PAGE COMAND:.WORD 0 CURUNT:.WORD 0 EOFCOM:.WORD 4 ;END-OF-FILE BIT ERRPAT:.WORD 0 EXCOM: .WORD 0 NFILES:.WORD 0 NRECS: .WORD 0 OFFSET:.WORD 0 READAD: .WORD READBF ;CURRENT READ BUFFER BEGIN ADDR STAT: .WORD 0 UNITNO:.WORD 0 WRITAD: .WORD WRITBF ;CURRENT WRITE BUFFER BEGIN XCOUNT:.WORD 0 XRECS: .WORD 0 CHRFG: .BYTE 0 EXSWCH:.BYTE 0 MCODE: .BYTE 0 MINTFG:.BYTE 0 PPOS: .BYTE 0 REQFLG:.BYTE 0 TTYTMP:.BYTE 0 WRTCTR:.BYTE 0 XFILES:.BYTE 0 $COLON:.BYTE 0 .END