xþ÷ b ÄÐzþ÷ T zþ÷ T xþ÷ : zþ÷ 0 zþ÷ 2 Ã-\ý öüÄe w ÌÿÁ þÿ°üï ÿÿ¨üë ûÿrüÐ úÿhüË ùÿ`üÇ øÿXüà ÷ÿPü¿ öÿHü· õÿ<üµ ôÿ4ü± óÿ,ü­ òÿ$ü© íÿüû ìÿôû ëÿìû êÿäû éÿÜû èÿÔû çÿÌû­ æÿÄû© åÿ¼û¥ äÿ´û¡ ãÿ¬û âÿ¤û ûÉ]üú8 áÿ¨ú àÿ¦ùw Æe ÿµ ¦ÿ¨ÿua¨ÿu ¨ÿ¤ÿõ ÔÿÊÿuaÊÿ5 a÷ ò u a÷ Ü u a÷ Æ u a÷ ° u ÀÿÁ% aGl> ß%üÿ ÊÿÎÿu ÎÿÒÿ ìÿÀe æÿÂe ÀEýÿ" Îÿ3" aÁe4 æÿÀe Èÿ÷ ÆÿÀe u-ÆÿÈÿ( ìÿÀe ÈÿÁe ÌÿJ" ìÿÃe Èÿ÷ ìÿÀe @mìÿ5 ÄÿNa÷ ¾ °ÿÔÿ5 ÔÿÎÿuaÎÿ1 °ÿWp aÁe¾ÿu Äÿîÿ! ôÿ5, pí¾ÿ ¾ÿ@-îÿ ÄÿNaf ðÿ÷ Ô  ÿH-¼ÿ H-¶ÿ ¬ÿu-¼ÿ¶ÿ pm¼ÿ Hí¼ÿ ®ÿ×t CmèÿÃe ®ÿWt `Áe Cmêÿõ A]²ÿu ¬ÿ ÿp AmêÿÁe ¦ÿàÿ °ÿW-°ÿ7 °ÿÀeÝÿ ¨ÿÁg( ¦ÿèÿC `Áe ®ÿWt `Áe túÿÀE ®ÿ×t ÀEÀÿ ðEüÿ ìÿðU ¸ÿ×t túÿÀE ¸ÿWt ¸ÿ×t Æeþÿ aÃe4 Æeîÿ@ WtøÿÁE ðÿB`µ bA-ðÿ Hmîÿ5 p-òÿ Hmîÿ5 Æeþÿ@ øÿ÷ ÿÿÿÿÿÿ ÿÿÿÿÿÿ TT00 DK DIRT LOAD ÀÀ  MOTH Ð%â%ø% &$&V&\&d&l&t&x& ÷ ìÿß ÿ x¿& ÿ t¿ ú üÿ½ `Áå0 àø òÿ ø òÿ° ÷ nÿ W,òÿf" ÷ êý îÿÁ% ÷ jÿÅå TTPL2T3T ÁEøÿ ÆeÚÿµ Üÿ5aÜÿõ Úÿ5aÚÿõ aÁe^ a÷ . îÿõE ÿîÿõ ÿA-îÿ aGl4 aGlB ðý4-D îÿt-èÿF ÿÿèÿf t-èÿF ÿÿèÿ4 $ýÁe tóÿÀEøÿ5 ÜÿÁe a÷ º Æeþÿõ% Æeþÿô%( Æeþÿæ Æeþÿ Æeôÿ àÿøÿ5 Þÿöÿ0 a÷ X öÿWtóÿÁEøÿu öÿÀE ÚÿÀe ÿÿúÿW-úÿP Æeþÿ& øÿ÷ bÂ<À ÀbÂÿÿÿÿÿÿ p¿þÿÿÿ Æeäÿµ Æeöÿõ öÿNa Æeþÿf ÀE?à túÿÀE ü4`l ÀEÿóÀ Æeþÿ4 Æeþÿ4 ÁEÀÿ@` èÿæÿuaæÿæ Ù ×7x ðÿNa Ù W=öÿ àöÿô ñÿÀE öÿ@àÀ äÿ5aäÿ= äÿW/äÿ ðÿNa øÿ÷ B Àÿÿÿÿÿÿ ÆeÂÿµ Æeôÿ öÿ÷ÿõ% üÿu öÿNa Æeúÿõ aÁen aÁen Æeîÿ@ ôÿÀe @-üÿ4 ÿÿúÿW-úÿ2 lÔÿu Æeúÿ WtùÿÁE Æeüÿ5 a5,` ÞÿNa ßÿÖÿu Þÿ×ÿu âÿÚÿ5 tóÿÀEøÿ5 ßÿÁE âÿÀE îÿô% îÿØÿæ ÖÿNa äÿðÿÁ% àðÿf ÒÿI-êÿ ÿÿîÿ îÿ¼ ÒÿI-êÿ ÿÿîÿ ap-ðÿL p-ðÿV ÂÿNa7 ìÿîÿ@ ÌÿÀe îÿw äÿðÿÁ% àðÿf ÿÿîÿ@ tóÿÀEøÿ5 æÿ@-ôÿm äÿÁE ÌÿH¢^ ÂÿNa7 ÂÿNa7 ÊÿÀe ÊÿÀe ÌÿðÅ ÌÿðÕ ÿÿîÿ ÿÂ`µ øÿ÷ ( °ÈBÀ À°Èÿÿÿÿÿÿ XX@@@ ´ÿ²ÿua²ÿu ²ÿ°ÿ ìÿNa ìÿÀE ÿ@-èÿ îÿÌÿ4 ÿÿÆÿ7 ÿÿæÿW-æÿ :àô¥. ;àô¥. ÿÀå0 :àÀE ÿÿæÿW-æÿ Öÿõ¥0 ¸ÿ<àã æÿNa÷ t a÷ p æÿNa÷ & ÿÿæÿW-æÿ àÿNa÷ ö æÿ@möÿp èÿÚÿ@ öÿÁe öÿÀe Êÿõå ÿÿÞÿW-Þÿ BmöÿÂe ÜÿNa÷ , âÿõ% æÿNa÷ âÿõ% Àÿõ% äÿõå ÞÿWt äÿõå @aÁE?Àp túÿÂE Þÿ÷ Úÿõå @môÿ5 ÞÿW-Þÿ  ÿæÿ+ þÿæÿu-æÿ æÿÀU ´ÿu-ÌÿÖÿ æÿNa÷ < æÿNa÷ 0 WtóÿÁEøÿu ÎÿÀE u-ÂÿÎÿd  ÿÃU Òÿu-ÞÿÆÿ ÞÿÆÿ@ u-Òÿ´ÿ ÚÿNa÷ ·ÿÁE âÿW=´ÿÿ ÚÿNa÷ > @ ·ÿÀE ÿ@mÚÿ5 ÚÿNa÷ °þõ% ÀæÿB ÷ ( u Øÿîÿæ ìÿNa a÷ \ À%þÿ a÷ J a÷ 2 (ùõ% íÿÀE òÿ¾ÿõ% íÿÀE tóÿÀEøÿ5 íÿÁE ðÿÀE Äÿ÷ ÖÿÌÿõ a÷ 6 ÈÿÎe0 Æeúÿæ üÿNa÷ È úÿNa÷ ¾ ·ÿÁE ÿAmüÿAmúÿp üÿÃE Æeüÿõ 2àüÿß üÿÀe Æeþÿõ%ÿÿ Æeöÿõ èÿ÷ÿõ úÿ5aúÿA öÿNa Æeþÿ@ Æeøÿõ úÿüÿuaüÿæ úÿøÿB Æeüÿ÷ 2 õeýÿüÿf üÿ÷ Ê ÁEøÿÁe0 Æeøÿõ øÿúÿuaúÿæ Æeìÿõ îÿðÿuaðÿ@ øÿu-øÿìÿ7 ÿÿöÿW-öÿ öÿ@mîÿ öÿ@müÿ òÿÁ% Æeüÿõ ÿÿüÿW-üÿ üÿ@m Æeæÿ aW¬> 0,ÌÿÖÿ üÿúÿuaúÿC ÿÿöÿW-öÿ üÿÁeÌ îÿðe Öÿõ% aÁe? a÷ * aGl0 ðÿu-ðÿæÿ# ^ý÷ ª øÿÀe ÿÿöÿW-öÿ @mêÿ& ý÷ T ÿÿöÿW-öÿ @møÿÀe ¸ü÷ øÿðÕ a÷ æ ÿÂå0 ÿÂ`Âå0 øÿðÅ ìÿîÿæ ìÿN` øÿðÕ øÿð¥" øÿ÷ àÈ Î ÷ "ÿ `Á>À À`Áÿÿÿÿÿÿ LOADUP *no stopped F A U L T term req. fault LOGON TASKS REGSS SEGSS PURGE KILLE FREEE HOLDE INTDE KICKE ABORT TASK? purged Æeàÿµ îÿìÿuaìÿæ ðÿNa Ù õ¥ ñÿÀE õ¥üÿðÿ a÷ J ôÿàÿu öÿâÿæ ÿÿèÿW-èÿ èÿ@mêÿ aÁe4 aGl¬ Æeüÿõ õeýÿüÿf üÿ÷ * ÁEøÿÁe0 øÿ÷ àÈ Î ÌÀ<À ÀÌÀÿÿÿÿÿÿ NOT READY! BAD SEGMENT ADDRESS ERROR ILLEGAL INSTR BPT TRAPINSTR ILLEGAL SVCTR BAD SER SVCTR TIME FAULTCTR À À'À* ÆeÔÿ Æeþÿ@ ÿÿöÿW-öÿ öÿWt ÖÿØÿuaØÿõ öÿW-öÿ7 túÿÀE `WtúÿÁE `ðÿu ðÿäÿõ öÿW-öÿÞ¾ öÿ÷ p-äÿ ØÿÁeF ÖÿüÿC túÿÂE `WtúÿÁE `×túÿÃE üÿÂe0 òÿAíòÿÁ üÿÀeP âÿWt ìÿ@íæÿÀ ìÿBíæÿ W-îÿ! W-îÿ" ÞÿÀeX âÿWt túÿÀE ÜÿÁå@ umÜÿðÿµ æÿWt Øüõe öÿêôÀ öÿÚÿ_ túÿÂE Úÿ@íöÿ ÿÿöÿW-öÿ1 ÔÿÁe âÿöÿõ öÿW-öÿO öÿWt öÿW-öÿ Æeþÿ_ vÿ×7tÿ Æeþÿ@ F » 0E Ï T è DIR ¬ BOTRXSÄ bBOTXRS 2COPRXSð 2RXINTSó BIMPSRC "VERSCS 2DBUG5S= "READS f FILLS h DPAL6Si BSP6Y $DVRUBY£ 4BVTXS ² TDVRUB I DLOAD6Yi 4MOTH6Y $SBLD3S $PERM1YÁ 4SUP28 © FSLSIYÆ 4BTT6Y ì 4RXO21Sü BTT6S ( FSLSISõ LOAD6SÔ MOTH6Sz RXO22S SUP30 4FRMATSà 4FILES PULLS ¸ PUSHS ¹ BVT1S ê SUPDE0 SUPDE1é DIRS ¢ BDUT3S ALISTSí DQS12E GATE4S 127 %THEN PRINTSYMBOL('#') %ELSE SPACE %CYCLE X=0,1,5 PRINTSYMBOL(DIRECT(IND)_NAME(X)) %REPEAT SPACES(2) %END %INTEGERFN NFILE %INTEGER X,Y Y=0 %CYCLE X=0,1,50 %IF DIRECT(X)_FIRST#0 %THEN Y=Y+1 %REPEAT %RESULT=Y %END %INTEGERFN PNFILE %INTEGER X X=NFILE WRITE(X,2) PRINTSTRING(' FILES') NEWLINES(2) %RESULT=X %END %ROUTINE CURLOG %INTEGER X NEWLINE PRINTSTRING('FSYS=') WRITE(UNIT,1); PRINTSYMBOL('.') X=CURFSYS//8 PRINTSYMBOL(X+'0') PRINTSYMBOL(CURFSYS-(X*8)+'0') SPACES(3) %END !***************************************************************** !******************************************************************* !CODE STARTS HERE INSTR1==STRP1_ST %IF INSTR1==NULL %START CURFSYS=DF; UNIT=0 %ELSE CURFSYS=INSTR1_FSYS UNIT=INSTR1_UNIT %FINISH GETDIR CURLOG %IF PNFILE#0 %START REP=-1 QUEST=0 %CYCLE %CYCLE I=0,1,5 SNAME(I)=255 %REPEAT %CYCLE J=0,1,50 %IF DIRECT(J)_FIRST#0 %START %CYCLE I=0,1,5 %EXIT %IF DIRECT(J)_NAME(I)>SNAME(I) %IF DIRECT(J)_NAME(I) þýÇB ÿÿìý øþÿF JC÷ z øÿ÷ p àÈ ÷ àÈ ÷ àÈ Î àÈ Î ÀhÀ<À ÀhÀÿÿÿÿÿÿ DIRECTORY BLOCK READ ERROR FILES FSYS= !************** !* BVTXS * !*FOR 2ND TT * !*DA:22.APR.80* !************** %CONTROL K'100001'; ! 'SYSTEM' PROGRAM (FAST ROUTINE ENTRY/EXIT) %PERMROUTINESPEC SVC(%INTEGER EP, P1, P2) %BEGIN %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEGS) %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %C %INTEGER A1, A2, A3) %RECORDFORMAT TTF(%INTEGER KBS, KBD, TTS, TTD) %RECORDFORMAT BUFF(%INTEGER PT, LAST, %BYTEINTEGERARRAYNAME B) %RECORDFORMAT BUFFX(%INTEGER PT, LAST, ARRAYPT) %CONSTRECORD (BUFFX) %NAME NULL = 0 %CONSTINTEGER RUBOUT=K'177' %CONSTINTEGER CAN=24 %CONSTINTEGER CR=13 %CONSTINTEGER BELL=7 %CONSTINTEGER ESC=K'33' %CONSTINTEGER SI=K'17'; ! SHIFT INTO LOWER MODE (CTRL O) %CONSTINTEGER SO=K'16'; ! SHIFT OUT (CTRL N) %CONSTINTEGER DLE=K'20'; ! (CTRL P) %CONSTINTEGER EOT = K'04'; ! EOF (CTRL D) %CONSTINTEGER DC1=K'21'; ! CANCEL OUTPUT (CTRL Q) %CONSTINTEGER TAB = 9; ! TAB (IMPLEMENTED AS 3 SPACES) %OWNRECORD (TTF) %NAME TT=K'136520' %OWNINTEGER KBINT=-11 %OWNINTEGER TTINT=-12 %OWNINTEGER TTSER=19; ! ??? %OWNINTEGER CLIID=20 %OWNINTEGER TT STATUS=0, UPPER=32, TT IDLE=0, E PT=0, EFPT=0 %RECORD (PF) P2 %OWNRECORD (PF) %NAME P %CONSTINTEGER NO OF SPECS = 6 %OWNBYTEINTEGERARRAY SPECS(0:NO OF SPECS) = RUBOUT, CAN, ESC, CR, SI, SO, TAB %INTEGER CHAR, I, IN MODE, E LAST %INTEGER OUTID, SEG, CLI FLAG, CID, CADR %OWNRECORD (BUFF) OUT, INH %RECORD (BUFFX) %NAME BUFX, INX %RECORDFORMAT HF(%RECORD (HF) %NAME H, %RECORD (PF) P) %RECORDFORMAT QF(%RECORD (HF) %NAME H) %OWNRECORD (HF) %ARRAY HA(0:15) %OWNRECORD (HF) %NAME H %OWNRECORD (QF) HI, HO %OWNRECORD (QF) FREE %OWNINTEGER FIRST, LAST, CURR %OWNBYTEINTEGERARRAY BUFFER(0:255) %OWNBYTEINTEGERARRAY ECHOB(1:40) %SWITCH INS(0:NO OF SPECS), STATE(0:7) %ROUTINESPEC DRIVE TT(%INTEGER CHAR) %ROUTINESPEC ECHO(%INTEGER X) %ROUTINESPEC ECHO BELL %ROUTINESPEC TRANSFER INPUT %ROUTINESPEC OUTPUT REPLY %ROUTINESPEC PLANT(%INTEGER N) !! %CONSTBYTEINTEGERARRAY CANM(0:3)= 3, '#', CR, NL !! %CONSTBYTEINTEGERARRAY CLIM(0:3)= 3, '<', 8, '>' %CONSTINTEGER MYSEG=4, MSA=K'100000' %CONSTINTEGER MYISEG=3, MISA=K'060000' MAPHWR(5); ! MAP REGS TO SEG 5 LINKIN(TTSER); LINKIN(KBINT); LINKIN(TTINT) TT_KBS=K'100' BUFX==OUT INX==INH %CYCLE I = 15, -1, 0 PUSH(FREE, HA(I)) %REPEAT %CYCLE %IF OUTID=0 %AND %NOT HO_H == NULL %START H == POP(HO); PUSH(FREE, H) P == H_P %ELSE P == P2 P_SERVICE = 0 POFF(P) %FINISH %IF P_SERVICE=KBINT&X'FF' %START CHAR=TT_KBD&127; ! STRIP PARITY BIT %CYCLE I=NO OF SPECS, -1, 0 ->INS(I) %IF CHAR=SPECS(I) %REPEAT !! NORMAL CHAR %IF CHAR>='A'+K'40' %AND CHAR<='Z'+K'40' %THENC CHAR=CHAR-UPPER; ! TURN TO UPPER PLANT(CHAR) %CONTINUE INS(0): ! RUBOUT %IF LAST#CURR %START LAST = (LAST-1)&255 ECHO(8); ECHO(' '); ECHO(8) %ELSE ECHO BELL %CONTINUE INS(1): ! CANCEL %IF LAST#CURR %START LAST = CURR ECHO('#'); ECHO(CR); ECHO(NL); E LAST=E PT %ELSE ECHO BELL %CONTINUE INS(2): ! ESCAPE - GO TO CLI CLI FLAG = 1 LAST = 0; CURR = 0; FIRST = 0 INS2: ECHO('$'); ECHO BELL %CONTINUE INS(4): ! SHIFT IN UPPER = 0; %CONTINUE INS(5): ! SHIFT OUT UPPER = 32; %CONTINUE INS(6): ! TAB PLANT(' '); PLANT(' '); PLANT(' '); %CONTINUE INS(3): ! CR PLANT(NL); CURR = LAST TRANSFER INPUT E LAST=E PT; ! ALLOW IT TO DO OUTPUT NOW %ELSE %IF P_SERVICE=TT INT&X'FF' %START ->STATE(TT STATUS) DO OUT: STATE(5): ! GOING IDLE TT STATUS=0 %IF E PT>0 %THEN TT STATUS=2 %ELSESTART %IF OUT_LAST#0 %THEN TT STATUS=1 %FINISH ->STATE(TT STATUS) STATE(1): ! NORMAL OP CHAR=OUT_B(OUT_PT); OUT_PT=OUT_PT+1 %IF OUT_PT>=OUT_LAST %THEN TT STATUS=5 %AND OUTPUT REPLY DRIVE TT(CHAR) STATE(0): %CONTINUE STATE(2): ! ECHO OP %IF EFPTDO OUT %FINISH %FINISH %IF EFPT=E PT %THEN E PT=0 %AND EFPT=0 %CONTINUE STATE(3): ! NORMAL CR STATE(4): ! ECHO CR STATE(7): ! END OF LINE - NEWLINE TT STATUS=5 DRIVE TT(NL+128) %CONTINUE STATE(6): ! IN ECHO LINE %CYCLE; %REPEAT %ELSE %IF P_SERVICE=TT SER %START; ! USER REQUEST %IF P_A1=1 %START; ! OUTPUT REQUEST %IF OUTID#0 %START H == POP(FREE) %IF H == NULL %START REJ: P_SERVICE= P_REPLY; P_REPLY = TT SER P_A1 = 1; PON(P) %CONTINUE %FINISH H_P = P; ! COPY P INTO SAFE PLACE PUSH(HO, H); ! AND QUEUE IT %CONTINUE %FINISH OUTID=P_REPLY SEG=P_A2>>13; ! SEG NO OF BUFFER MAP VIRT(OUTID, SEG, MY SEG) BUFX_ARRAYPT=MSA+(P_A2&K'17777') OUT_PT=0; OUT_LAST=P_A3; ! LENGTH %IF OUT_LAST=0 %THEN OUTPUT REPLY %ELSESTART ->DO OUT %IF TT STATUS=0; ! TT IDLE %FINISH %ELSE !! INPUT REQUEST %IF P_A1 # 0 %START CID = P_REPLY; CADR = P_A2 %CONTINUE %IF P_A3 # 0; ! JUST READ FROM CLI %FINISH H == POP(FREE) -> REJ %IF H == NULL H_P = P; ! COPY P INTO A SAFE PLACE PUSH(HI, H); ! AND Q IT %IF P_A1#0 %AND FIRST=LAST %THEN -> INS2 %IF FIRST#CURR %START; ! NON EMPTY LINE TRANSFER INPUT %FINISH %FINISH %FINISH %REPEAT %ROUTINE DRIVE TT(%INTEGER CHAR) %IF CHAR=NL %START TT STATUS=TT STATUS+2 CHAR=CR %FINISH TT_TTD=CHAR TT_TTS=TT_TTS!K'100'; ! INTS ON %END %ROUTINE ECHO(%INTEGER X) %RETURN %IF E PT>40 E PT=E PT+1; ECHOB(E PT)=X %IF TT STATUS=0 %OR TT STATUS=6 %START TT STATUS=2 DRIVE TT(X) EFPT=1 %FINISH %END %ROUTINE ECHO BELL ECHO(BELL); E LAST=E PT %END %ROUTINE PLANT(%INTEGER CHAR) BUFFER(LAST) = CHAR LAST = (LAST+1)&255 ECHO(CHAR) %END %ROUTINE TRANSFER INPUT %INTEGER SEG, I, ID, ADR, N %IF CLI FLAG # 0 %START; ! PREEMPTED BY CLI ID = CID; ADR = C ADR; CLI FLAG = 0 %ELSE %IF HI_H == NULL %THEN %RETURN H == POP(HI); PUSH(FREE, H) ID = H_P_REPLY; ADR = H_P_A2 %FINISH %IF ID#0 %START SEG=ADR>>13 MAP VIRT(ID, SEG, MYISEG) INX_ARRAY PT=MISA+(ADR&K'17777') %CYCLE I = 0, 1, 80 N = BUFFER(FIRST) INH_B(I) = N FIRST = (FIRST+1)&255 %EXIT %IF N = NL %REPEAT P_SERVICE=ID; P_REPLY=TTSER P_A1=I+1 PON(P) MAP VIRT(0, -1, MYISEG) %FINISH %END %ROUTINE OUTPUT REPLY MAP VIRT(0, -1, MYSEG) P_SERVICE=OUTID; P_REPLY=TTSER P_A1=0 PON(P) OUTID=0; OUT_LAST = 0 %END %ENDOFPROGRAM ! FORMAT.......FORMATS RXO2 ON UNIT 1 %CONTROL K'101011' %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG) %BEGIN %RECORDFORMAT RXF(%INTEGER CONTROL,DBREG) %CONSTRECORD(RXF)%NAME RX=K'117170' %INTEGER I MAPHWR(4) PRINTSTRING('FORMATS RXO2 ON UNIT 1.........') NEWLINE PROMPT('PLEASE CONFIRM:') READSYMBOL(I) %IF I='Y' %START %WHILE RX_CONTROL&K'40'=0 %CYCLE; %REPEAT RX_CONTROL=K'431' %WHILE RX_CONTROL&K'200'=0 %CYCLE; %REPEAT RX_DBREG='I' %WHILE RX_CONTROL&K'40'=0 %CYCLE; %REPEAT %IF RX_CONTR %BEGIN %CONSTBYTEINTEGERNAME ID = K'160030' %CONSTINTEGERNAME NULLI=0 %CONSTINTEGER DREAD=0, DWRITE=1 %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, %C %INTEGERNAME A2, %INTEGER A3) %INTEGER I, J, K, L, M, DRIVE %RECORD (PF)P %INTEGERARRAY BUFF(0:256) PROMPT('Copies Floppy Bootstrap Block Unit 0 to Unit 1 PLEASE CONFIRM?') READSYMBOL(I) DRIVE=K'020000'; ! UNIT ONE %IF I#'Y' %THEN %STOP P_SERVICE=3; P_REPLY = ID P_A1=0; P_A2==NULLI PONOFF(P) %IF P_A1#9 %START PRINTSTRING('DISC TURN OFF CHECK ERROR '); WRITE(P_A1, 1); NEWLINE %STOP %FINISH P_SERVICE=3; P_REPLY=ID P_A1=0; P_A2==NULLI P_A3=K'020000' PONOFF(P) %IF P_A1#9 %START PRINTSTRING("UPPER CHECK FAILS %STOP %FINISH %CYCLE I = 0, 1, 13 P_SERVICE=3; P_REPLY=ID P_A1=DREAD; ! READ ONE BLOCK P_A2==BUFF(0) P_A3=I; ! BLOCK PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC ERROR %STOP %FINISH P_A2==BUFF(0) P_A1=DWRITE P_A3=I!DRIVE P_SERVICE=3; P_REPLY=ID PONOFF(P) %IF P_A1#0 %START PRINTSTRI FSYSnÉ ÆeÂÿµ ÆeôÿÆ öÿ÷ÿ& B@õ% üÿñ `@Àe úÿè¤ öÿNa Æeúÿ- aÁen À@ -j aÁen æ@ô% þþ9î Æeîÿ® 6AÀe üÿ!( ôÿÀe @-üÿ4 ÔÿÐ, ÿÿúÿW-úÿ2 lÔÿu îÿb8 üÿ*B ªþ²F ÆeúÿàZ WtùÿÁE üÿR^ Æeüÿ a5,` Ù >¬ öÿY® Ù Ö° ÞÿW¸ ÞÿNa Ù >º Ù ¶Æ Öÿ?È òÿpÌ CÁen þümÒ ßÿÖÿÓâ Þÿ×ÿÍä âÿÚÿ@æ îÿ\î tóÿÀEøÿ5 ßÿÁE Ù Âö âÿÀE Êÿ$ø  Cô% îÿÏ Tüm& îÿØÿ ÖÿNa Ù 7. äÿðÿZR øCÁ% àðÿ½T ÒÿÑV îÿ«X ÒÿÓ\ (DI-êÿ ÿÿîÿ 6Dô% ÒÿÑ¢ DI-êÿ ÿÿîÿ ap-ðÿL p-ðÿV ðÿc° Öþ:º ìÿÒà ÃÿÞä ÂÿNa7 ìÿîÿ ÌÿÀe êÿªú ÒÿÓþ ¶Eô% äÿðÿt. ÜEÁ% àðÿ×0 ÒÿÒ2 êÿL4 îÿe6 êÿS< ÒÿÑB 8Fô% ÿÿîÿfn tóÿÀEøÿ5 æÿhp hF@-ôÿm äÿÁE Êÿ3t ÌÿH¢^ ÃÿEz ÂÿM| ÂÿNa7 ÂÿNa7 ÊÿÀe ÊÿÀe îÿ>® èÿnÔ ÌÿðÅ êüõÚ ÌÿðÕ ÿÿîÿ ~GÉÅ ÿÂ`µ øÿ÷ ( À°ÈBÀ À°Èÿÿÿÿÿÿ XX@@@ !************** !* LOAD16S * !* 27.NOV.79 * !* READS FROM PR !************** %PERMINTEGERFNSPEC SVC(%INTEGER EP, %INTEGER P1, %INTEGER P2) %PERMINTEGERMAPSPEC INTEGER(%INTEGER X) %PERMBYTEINTEGERMAPSPEC BYTEINTEGER(%INTEGER X) %PERMINTEGERFNSPEC ADDR(%INTEGERNAME X) %CONSTINTEGERNAME DUMMY = 0 %SYSTEMINTEGERFNSPEC GETID %CONTROL K'101011'; ! TRUSTED %RECORDFORMAT DUMREC(%INTEGER X) %CONSTRECORD (DUMREC) %NAME NULL = 0 !*********************************** !* * !* LOADER FAULTS * !* * !* 1 - NO CORE * !* 2 - INIT BLOCK TOO LONG * !* 3 - INIT BLOCK SHORT * !* 4 - CHECKSUM WRONG * !* 5 - OUT OF RANGE * !* 6 - END OF FILE/ NO FILE * !* 7 - MAX NO OF TASKS REACHED * !************************************ %BEGIN %CONSTINTEGER DELETE = 5 %CONSTINTEGER GET CORE = 6 %CONSTINTEGER SCHEDULE = 9 %CONSTINTEGER MAP PSECT = 16 %CONSTINTEGER TASK LOW LIMIT = 30 ! SEE SUPERVISOR FOR UPDATES %OWNINTEGER TASK LIMIT = 48 %CONSTINTEGER T POFF = 2 %CONSTINTEGER LOAD SER = 5; ! MAIN LOADER SERVICE %RECORDFORMAT UREGSF(%INTEGER R0, R1, R2, R3, R4, R5, PC, PS, SP) %RECORDFORMAT SEGF(%INTEGER PAR, PDR, DADD, USE) %RECORDFORMAT PSECTF(%INTEGER Q, %C %BYTEINTEGER ID, STATE, %BYTEINTEGERARRAY %C NAME(0:3), %BYTEINTEGER PRIO, %INTEGER POFFQ, %RECORD (UREGSF %C )URS, %INTEGER TRAPV, %RECORD (SEGF) %ARRAY SEG(0:7)) %RECORDFORMAT PSTF(%RECORD (PSECTF) %NAME P) %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A, B, C) %RECORDFORMAT STRDF(%INTEGER RDS, NXY, GETB, %BYTEINTEGER SER, %C REPLY, UNIT, FSYS, %BYTEINTEGERARRAY NAME(0:5), %INTEGER BL, %C N, PT, MAX, %BYTEINTEGERARRAY BUFF(0:255)) %RECORDFORMAT STRD2F(%INTEGER RDS, NXY, GETB, %BYTEINTEGER SER, %C REPLY, UNIT, %STRING (6)NAME) %RECORDFORMAT GLASF(%INTEGERARRAY FIXED(1:12), %BYTEINTEGER ID, %C CALLID, %INTEGERARRAY STRPTS(0:7), %INTEGER TOP, %BYTEINTEGER %C UNIT, FSYS, %INTEGER GLA, INTCHR, SPARE, %INTEGERARRAY GROT %C (1:11), %BYTEINTEGERARRAY INPUT(0:70)) %CONSTRECORD (GLASF) %NAME GLAS = K'100000' ! MAPPED TO MY SEG 4 %RECORDFORMAT D1F(%INTEGER X) %RECORDFORMAT D2F(%BYTEINTEGERNAME B) %RECORDFORMAT D3F(%INTEGERNAME Z) %RECORDFORMAT D4F(%RECORD (PSECTF) %NAME PST) %RECORD (PSECTF) %NAME NEWPSECT, SPST %RECORD (PF)P %RECORD (SEGF) %NAME S %INTEGER ID, I, LEN, BC, J, SEGS, ENTRY, N, NEWID, INPT %INTEGER MAX, MAX2, LOAD ACT, LOAD PT, NCHAR, STK, FAULT, OSEG %INTEGER PT, GLA DISP, OLD, TFLAG, TTFLAG, LTYPE %BYTEINTEGER CHAR, CKSM %OWNINTEGER READ FLAG = 0, UNIT = 0, FSYS = 0, PROG = 1 %OWNINTEGER REPLY TO HERE = LOAD SER %CONSTRECORD (STRDF) %NAME INSTR1 = K'160062' %OWNBYTEINTEGERARRAY STORE(0:70) = 0, 'L', 'O', 'A', 'D', 'U', 'P', NL, 0(0) %CONSTBYTEINTEGERARRAY MODETR(1:6) = 2, 6, 0(2), 2, 6 %CONSTBYTEINTEGERARRAY DISC SER(0:4) = 3, 3, 8, 14, 28 %INTEGERFNSPEC WORD %ROUTINESPEC PRINT NAME %ROUTINESPEC RELEASE(%INTEGER SEG) %ROUTINESPEC PUT READ ON(%INTEGER TYPE) %ROUTINESPEC MAP SHARED SEG(%INTEGER ID, SEG, SHARED NO) %RECORD (PSECTF) %MAPSPEC INSERT %ROUTINESPEC OCTAL(%INTEGER N) %RECORD (PSECTF) %MAP %SPEC GET PSECT(%INTEGER ID) %RECORD (PSECTF) %MAP %SPEC GET NAME(%BYTEINTEGERNAME ST) %ROUTINESPEC PNAME(%BYTEINTEGERARRAYNAME NAME) %INTEGERFNSPEC CLI %INTEGER DUMMY %RECORD (D1F)D1 %RECORD (D2F) %NAME D2 %RECORD (D3F) %NAME D3 %INTEGERARRAY LSEGM(0:7); ! HOLDS EXTENT OF USER SEG %SWITCH SW(0:7) D2 == D1; D3 == D2 ID = GETID -> FROM OUT; ! INITIAL SPECS LOAD %CYCLE GLA DISP = 0 PUT READ ON(0) %IF READ FLAG = 0 P_SERVICE = 0 POFF(P) !* VALID SERVICES ARE:- P_SERVICE = ID - REPLY FROM KEYBOARD !* P_SERVICE = LOADID - LOADER REQUEST REPLY TO HERE = LOAD SER; ! LOADER 'OWNES' UNLESS CHANGED TFLAG = 0; ! TYPE OF CALL %IF P_SERVICE = ID %START; ! REPLY FROM KEYBOARD NCHAR = P_A; ! GET NO OF CHARS READ FLAG = 0 %IF STORE(1) = NL %THENCONTINUE PROG = PROG+1; ! COUNT LOADED PROGS TTFLAG = 0; ! LOADED BY LOADER FROM OUT: ! ENTRY FOR EXTERNAL CALLS OSEG = -1 %IF CLI = 0 %THEN PROG = PROG-1 %AND %CONTINUE INSTR1_NAME(I) = ' ' %FOR I = 0, 1, 5 INPT = 1; OLD = 0; INSTR1_UNIT = 0 %IF STORE(1) = '.' %START; ! PR INSTR1_NXY = 0; ! TYPE = CHAR INSTR1_FSYS = 0 INPT = 3; INSTR1_SER = 13 -> INP %FINISH INSTR1_FSYS = 1; ! TYPE = FILE %IF STORE(2) = '.' %START; ! UNIT SPEC INSTR1_UNIT = STORE(1)-'0'; INPT = 3 %FINISH INSTR1_SER = DISC SER(INSTR1_UNIT) %CYCLE I = 0, 1, 6 CHAR = STORE(INPT); INPT = INPT+1 %EXITIF CHAR < '0' %OR CHAR > 'Z' INSTR1_NAME(I) = CHAR %REPEAT %IF CHAR > ' ' %START PRINTSYMBOL('?') ->STEP DOWN %FINISH INSTR1_FSYS = FSYS INP: SELECT INPUT(1); ! CONSIDER EFFECTS OF NO FILE? READSYMBOL(I) %UNTIL I < 0 %OR I = 1 %IF I < 0 %START EOF: CLOSE INPUT %IF INSTR1_FSYS # 0 %THEN INSTR1_FSYS = 0 %AND -> INP PRINTSTRING('*no ') PRINT NAME STEP DOWN: NEWLINE PROG = PROG-1 %CONTINUE %FINISH NEWPSECT == INSERT; ! ALLOCATE THE NEW PSECT %IF NEWPSECT == NULL %START FAULT = 7; -> ERROR %FINISH READSYMBOL(I); ! SKIP THE '0' !! READ THE FIRST BLOCK ( TASK DESCRIPTOR BLOCK) BC = WORD-10; ! BYTE COUNT I = WORD; ! SKIP LOAD ADDRESS %CYCLE I = 0, 1, 3 READSYMBOL(J) NEWPSECT_NAME(I) = J; ! FILL IN THE NAME %REPEAT N = ID %IF TFLAG > 0 %START SPST == GET NAME(NEWPSECT_NAME(0)) %IF SPST == NULL %THEN TFLAG = 0 %ELSESTART N = SPST_ID NEWPSECT_NAME(3) = NEWPSECT_NAME(3)+1 %C %UNTIL GETNAME(NEWPSECT_NAME(0)) == NULL !! THIS CHANGES THE NAME UNTIL IT IS UNIQUE %FINISH %FINISH SPST == GET PSECT(N) STK = WORD; ! PICKUP INITIAL VALUE OF SP BC = BC-2; ! AND STEP DOWN BC %CYCLE SEGS = 0, 1, 7 LSEGM(SEGS) = 0 %IF BC <= 0 %THEN FAULT = 3 %AND -> ERROR S == NEWPSECT_SEG(SEGS) READSYMBOL(ENTRY); BC = BC-1 %IF ENTRY > 3 %START; ! NEW FORMAT READSYMBOL(I); ! THROW AWAY SPARE BYTE BC = BC-1; ! -3 EVENTUALLY %FINISH %IF ENTRY = 3 %THEN PRINTSYMBOL('*') %AND OLD = OLD+1 -> SW(ENTRY) %UNLESS ENTRY > 7 SW(4): ! NO SEGMENT (NEW FORMAT) LEN = WORD; ! THROW DUMMY LEN AWAY BC = BC-2 SW(0): ! NO SEGMENT S = 0 %CONTINUE SW(6): ! READ/WRITE (NEW FORMAT) SW(2): ! READ/WRITE %IF GLA DISP = 0 %THEN GLA DISP = SEGS << 13 SW(5): ! READ ONLY (NEW FORMAT) SW(1): ! NORMAL, 1=READ ONLY %IF TFLAG <= 0 %OR GLA DISP #0 %START LEN = WORD+K'77' BC = BC-2 LSEGM(SEGS) = LEN&K'37700' LEN = LEN >> 6 N = SVC(GET CORE, LEN, SEGS) FAULT = 1 %AND -> ERROR %IF N = 0 %ELSE SW(7): ! SHARED SEG (NEW FORMAT) SW(3): ! SHARED SEG N = WORD BC = BC-2 N = SPST_SEG(SEGS)_DADD MAP SHARED SEG(NEWID, SEGS, N) %FINISH %REPEAT !! ALL SPACE ALLOCATED %IF BC # 0 %THEN FAULT = 2 %AND -> ERROR !! PLACE REST OF INPUT LINE IN VIRTUAL SPACE (SEG 6) %CYCLE SEGS = 1, 1, 7 I = LSEGM(SEGS) %IF I > 0 %START MAP VIRT(NEWID, SEGS, 4) ! TO LOADER SEG 4 %CYCLE I = 0, 2, I-2 D1_X = K'100000'!I; D3_Z = 0 %REPEAT RELEASE(0) %UNLESS SEGS = 7 %FINISH %REPEAT GLAS_TOP = I; ! LIMIT OF AREA %IF I > K'200' %THEN LTYPE = 0 %ELSE LTYPE = 2 D1_X = K'100112'; ! IN STREAM IN(0) BUFFER AREA %WHILE INPT <= NCHAR %CYCLE D2_B = STORE(INPT) INPT = INPT+1; D1_X = D1_X+1 %REPEAT D2_B = NL; ! FOR SAFETY AND NO PARAMS RELEASE(0) !! NOW LOAD IT %CYCLE READSYMBOL(I) %UNTIL I = 1; READSYMBOL(I) CKSM = 1 BC = WORD-6; LOADPT = WORD %IF BC = 0 %THENEXIT; ! START BLOCK SEGS = LOADPT >> 13; ! GET SEG NO NEWSG: D1_X = LOADPT&K'17777'!K'100000' %IF TFLAG <= 0 %OR LOADPT <= GLA DISP %START !! 'GLA DISP' IS USUALLY NEGATIVE ! MAX2 = K'100000'!LSEGM(SEGS) %IF OSEG # SEGS %START; ! NEW SEGMENT RELEASE(OSEG); ! RELEASE IF ALLOCATED MAP VIRT(NEWID, SEGS, 4) ! MAP TO ME K'100000'-K'117776' OSEG = SEGS %FINISH %WHILE BC > 0 %CYCLE %IF D1_X > MAX2 %THEN FAULT = 5 %AND -> ERROR READSYMBOL(N) -> EOF %IF N < 0; ! END OF FILE CKSM = CKSM+N D2_B = N D1_X = D1_X+1; BC = BC-1 %IF D1_X&K'17777' = 0 %START SEGS = SEGS+1; LOADPT = 0; -> NEWSG %FINISH %REPEAT READSYMBOL(N); CKSM = CKSM+N %IF CKSM # 0 %AND OLD = 0 %START FAULT = 4; -> ERROR %FINISH %ELSE !* READ ONLY SEG OF SHARED PROG READSYMBOL(N) %AND BC=BC-1 %WHILE BC>=0 %FINISH %REPEAT %IF TFLAG = K'101010' %THEN I = K'140020' %ELSE I = K'140000' NEWPSECT_PRIO = 1; ! ONE IS STD PRIO FOR TASKS NEWPSECT_URS_PC = K'20010' NEWPSECT_URS_PS = I NEWPSECT_URS_SP = STK NEWPSECT_URS_R1 = GLA DISP NEWPSECT_URS_R0 = K'160112' ! MAP TO STREAM DEFINITIONS NEWPSECT_URS_R2 = LTYPE; ! NORMAL LOAD NEWPSECT_URS_R3 = UNIT!FSYS << 8 NEWPSECT_URS_R4 = REPLY TO HERE NEWPSECT_URS_R5 = GLA DISP RELEASE(OSEG) N = SVC(SCHEDULE, NEWID, 0) %IF TTFLAG # 0 %START; ! REPLY NOW TO CALLER P_SERVICE = TTFLAG; P_REPLY = 5 P_A = NEWID; ! PASS ID UP PON(P) %FINISH %ELSE %IF P_A = 2 %START; ! PROG STOPPING %IF P_C = 0 %START %IF PROG # 1 %THEN PRINTSTRING('st BTTY à ÆeÚÿµ Ù q¤ Ù |¦ Üÿ5aÜÿɪ Úÿ5aÚÿ½¬ aÁe^ a÷ . Ù WÆ îÿõE ìÿqÎ ÿA-îÿ aGl4 &Aõ%a îÿ/Ö FA4- lA4- èÿ§ò ÜþÅö âÿ$ü aGlB lB4-T ôýÅ@ B4-D îÿ*J ¨Bt-èÿF ÿÿèÿêL ÊBt-èÿF ÿÿèÿ4 âB4-D výÄn VCÁe tóÿÀEøÿ5 ÜÿÁe a÷ ¾ >D4- 0üÄÄ Æeþÿ¶È `Dõ% hDôe ~DðU@ Æeþÿ'Ú Dô%( Æeþÿßð èÿTò Æeþÿ¹ø bÿaþ Æeôÿ àÿøÿ5 Þÿöÿ0 a÷ \ öÿWtóÿÁEøÿu öÿÀE ÚÿÀe ÿÿúÿW-úÿP úÿ8 Ù 30 Ù ,2 ¶þJ6 Æeþÿu: Ù < Ù åB nþJF øÿ÷ ÀbÂ<À ÀbÂÿÿÿÿÿÿ p¿þÿÿÿ !****************************** !* FILE SYSTEM HANDLER * !* FSYS1S/FSYS1Y * !* DATE: 28.JUN.79 * !****************************** !*W.S.C. 25TH AUGUST 1976 !*B.G. 27.MAR.78 !*THIS HANDLER IS THE FILE SYSTEM UTILITY TO REPLACE THE !*EXISTING ONE IN DEIMOS TO PERMIT A FILE SYSTEM TO BE !*CREATED ON THE AMPEX 9500 DISC AS WELL AS THE RK05'S. !*IT IS A CONCEPTUAL COPY OF THE RK05 FILE SYSTEM HANDLER !*EXCEPT THAT A BUFFER POOL IS USED FOR BLOCK DESCRIPTORS !*AND DIRECTORY BLOCKS. !*THE CODE IS SHARED BY 3 SYSTEM SLOTS,4 FOR THE RK05'S, !*AND 9,15 FOR THE AMPEX DISC.THE AMPEX DISC IS LOGICALLY !*DIVIDED INTO TWO,UNITS 2&3. !* A FURTHER DISC IS CATERED FOR IN SLOT 28 !*THE CLOCK IS USED TO WRITE BLOCKS BACK EVERY 10SECS !*(BLOCK DESCRIPTOR BLOCKS).DIRECTORY BLOCKS ARE ALWAYS !*WRITTEN BACK AS SOON AS POSSIBLE AFTER A CHANGE. !*TUNEABLE PARAMETERS !* NBUF=NUMBER OF BUFFERS IN POOL-1(MUST BE>0) !* SECS::LENGTH OF TIME BETWEEN INSPECTING BUFFER !* POOL FOR WRITING BACK TO DISC. !*THE FOLLOWING FACILITIES ARE OFFERED !* EXAMINE A FILE !* GET NEXT BLOCK OF A FILE !* DESTROY A FILE !* CREATE A FILE !* APPEND A BLOCK TO A FILE !* RENAME A FILE !* RENAME A TEMPORARY FILE !*STACK=300 STREAMS=0 !********************************************************** !********************************************************** %CONTROL K'101011'; !SYSTEM+FAST ROUTINE ENTRY %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %SYSTEMINTEGERFNSPEC GETID %PERMROUTINESPEC SVC(%INTEGER EP, R0, R1) %PERMINTEGERMAPSPEC INTEGER(%INTEGER N) %PERMBYTEINTEGERMAPSPEC BYTEINTEGER(%INTEGER N) %PERMINTEGERFNSPEC ADDR(%BYTEINTEGERNAME N) %PERMINTEGERFNSPEC ACC %RECORDFORMAT DD(%INTEGER X) %PERMRECORD (DD) %MAPSPEC RECORD(%INTEGER X) %CONSTRECORD (DD) %NAME NULL = 0 %BEGIN !********************************************************* !************* DATA AREAS &DECLARATIONS ********** !********************************************************* !*SYSTEM SLOTS/DISC %CONSTINTEGER MAX DRIVES = 4 %CONSTBYTEINTEGERARRAY SERV(0:MAX DRIVES) = 3, 3, 8, 14, 28 !*DIRECTORY BLOCK AREAS/DISC %CONSTINTEGERARRAY DIRBLK(0:MAX DRIVES) = 97(2), K'1100'(2) %C , K'220' !*BLOCK DESCRIPTOR BASE/DISC %CONSTBYTEINTEGERARRAY BLKLST(0:MAX DRIVES) = 88(2), K'100' %C (2), K'100' !*FREE BLOCK START/DISC %CONSTINTEGERARRAY FBLOCK(0:MAX DRIVES) = 161(2), K'1500'(2) %C , K'400' %OWNINTEGERARRAY FIRST FREE(0:MAX DRIVES) = 161(2), K'1500' %C (2), K'400' ! INITIALLY IS IDENTICAL TO ! FBLOCK !*TOP OF DISC %CONSTINTEGERARRAY LASTBL(0:MAX DRIVES) = 1000(2), K'175000'(2) %C , 9200 !*REQUEST TYPES %CONSTINTEGER EXAMINE = 0 %CONSTINTEGER GET NEXT = 1 %CONSTINTEGER DESTROY = 2 %CONSTINTEGER CREATE = 3 %CONSTINTEGER APPEND = 4 %CONSTINTEGER RENAME = 5 %CONSTINTEGER RENAME TEMP = 6 %CONSTINTEGER RENAME FSYS = 7 %CONSTINTEGER DIR BLK NO = 8 !*SYSTEM CONSTANTS %CONSTINTEGER DREAD = 0, DWRITE = 1 !MODES %CONSTINTEGER CLOCK INT = 0 %CONSTINTEGER MY SEG = 4, MSA = K'100000' !*SYSTEM SLOTS %CONSTINTEGER RKSER = 4 %CONSTINTEGER AMP1SER = 9 %CONSTINTEGER AMP2SER = 15 %CONSTINTEGER RKBSER = 29 %SWITCH REQUEST(0:DIR BLK NO) %INTEGFILE 'SYS_RX021S' ! RX02 FLOPPY DISC HANDLER ! THIS IS THE UNIT 2&3 VERSION ! %% LAST UPDATED 14TH MARCH 1980 FILE=RX021S ! USES SYSTEM SLOTS 8 AND 14. INT SLOT -8. ! CALLING PARAMETERS ARE AS FOLLOWS ! P_A1=MODE (0=READ,1=WRITE) ! P_A2=ADDRESS OF BUFFER IN MEMORY ! P_A3=BLOCK NUMBER ON DISC ! SINCE DEIMOS DEALS IN 512 BYTE BLOCKS ALL TRANSFERS ARE 2*256 !BYTE SECTORS. THE FIRST 77 BLOCKS ARE RESERVED FOR THE SYSTEM. !WITHIN EACH TRACK OF 26 SECTORS THE SECTORS ARE INTERLEAVED. ! ON EXIT P_A1=FAULT NO. (0=OK) ! ANY ERROR WILL RESULT IN UP TO 10 RETRIES. ! STACK=300 STREAMS=0 %CONTROL K'101010' %SYSTEMROUTINESPEC LINKIN(%INTEGER SERVICE) %SYSTEMROUTINESPEC MAP ABS(%INTEGER VAD,LEN,ID) %PERMROUTINESPEC SVC(%INTEGER EP,P1,P2) %BEGIN %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,A2,A3) %RECORDFORMAT P2F(%INTEGER D) %RECORDFORMAT RXF(%INTEGER CONTROL,DBREG) %CONSTRECORD(RXF)%NAME RX=K'177170'; !DEVICE ADDR ! SYSTEM CONSTANTS %CONSTBYTEINTEGERNAME KID=K'160030' %CONSTINTEGER SYS1=8; !UNIT 2 %CONSTINTEGER SYS2=14; !UNIT 3 %CONSTINTEGER DINT=-8; !INT SLOT ! RX02 PARAMETERS %CONSTINTEGER TRBIT=K'400'; !READY BIT %CONSTINTEGERARRAY RXTOP(1:2)=K'1751',K'1751'; !TOP OF DISC %OWNINTEGERARRAY RXBOT(1:2)=K'77',K'77'; !BOTTOM OF DISC %CONSTINTEGER RETC=10; !RETRY COUNT %CONSTINTEGER READ=0; !INPUT PARAMS %CONSTINTEGER WRITE=1 %CONSTINTEGER READFN=K'107'; !RX02 FUNCTIONS %CONSTINTEGER WRITEFN=K'105' %CONSTINTEGER EMPTYFN=K'103' %CONSTINTEGER FILLFN=K'101' %CONSTINTEGER TRDONE = 1; !????????????????????????????????????????????? %CONSTBYTEINTEGERARRAY SECMAP(1:26)= %C 1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26 ! GENERAL VARIABLS %RECORD (PF) P,PX %RECORD (P2F) %NAME P2 %OWNINTEGER SYS,FAULT,ID,CONT,SECTOR,TRACK,RETRIES,MAPIND,I,VADDR,PAR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ROUTINES START HERE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! REPORT FAULT SEND A MESSAGE TO MOTHER %ROUTINE REPORT FAULT PX_SERVICE=7; PX_REPLY=KID PX_A1=SECTOR; PX_A2=TRACK; PX_A3=RX_DBREG PONOFF(P) %END ! MAPADDR MAPS BUS ADDRESS %INTEGERFN MAPADDR(%INTEGER VADDR) PAR=MAP ABS(VADDR,512,ID) %RESULT=1 %IF PAR=0 PAR=PAR+(VADDR&K'17777')>>6 %IF PAR>=K'2000' %START; !SET 17TH&18TH BITS CONT=CONT!(PAR&K'6000')<<2 PAR=PAR&K'1777' %FINISH %RESULT=0 %END ! SEEK DOES READ/WRITE %ROUTINE SEEK(%INTEGER FN) RETRIES=0 RD: RX_CONTROL=CONT!FN; !GO+INT ENABLE %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=SECTOR %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=TRACK P2_D=(-8)&X'FF' POFF(P2); !WAIT FOR INT %IF RX_CONTROL<0 %START; !ERROR RETRIES=RETRIES+1 %IF RETRIES#RETC %THEN ->RD; !TRY AGAIN REPORT FAULT %STOP; !IS THIS WISE????? %FINISH %END ! BUFFER DOES FILL/EMPTY %ROUTINE BUFFER(%INTEGER FN) RETRIES=0 WD: RX_CONTROL=CONT!FN; !GO+INT ENABLE %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=128; !WORD COUNT %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=PAR<<6+VADDR&K'77'; !BUS ADDRESS P2_D=(-8)&X'FF' POFF(P); !WAIT FOR INT %IF RX_CONTROL<0 %START; !ERROR RETRIES=RETRIES+1 %IF RETRIES#RETC %THEN ->WD REPORT FAULT %STOP %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !***** CODE STARTS HERE LINKIN(DINT) P2==PX SVC(15,4,0); !MAP TO DICS REGS LINKIN(SYS1); LINKIN(SYS2) ! MAIN LOOP-WAIT FOR DISC REQUEST %CYCLE P_SERVICE=0 POFF(P) %IF P_SERVICE=SYS2 %START CONT=K'420'; !UNIT 3 SYS=2 %FINISHELSESTART CONT=K'400' SYS=1 %FINISH FAULT=0; ID=P_REPLY VADDR=P_A2 ! ! CHECK IF ACCESS TO RESEVED AREA ! %IF VADDR=0 %START RXBOT(SYS)=0; FAULT=9 %ELSESTART %IF P_A3RXTOP(SYS) %C %THEN FAULT=4 %AND ->FIN FAULT=MAPADDR(VADDR) ->FIN %IF FAULT#0 ! ! COMPUTE TRACK&SECTOR ! TRACK=P_A3//13 MAPIND=(P_A3_(TRACK*13))*2+1 ! ! DO DOUBLE TRANSFER ! %CYCLE I=0,1,1 SECTOR=SECMAP(MAPIND) %IF P_A1=READ %START; !READ SEQUENCE SEEK(READFN) BUFFER(EMPTYFN) %ELSEIF P_A1=WRITE %START; !WRITE SEQUENCE BUFFER(FILLFN) SEEK(WRITEFN) %FINISH MAPIND=MAPIND+1; !NEXT SECTOR VADDR=VADDR+256; !NEXT ADDRESS %IF VADDR&K'17777'<256. %START PAR=MAP ABS(VADDR,0,10); !NEW SEG-RELEASE OLD ONE FAULT=MAPADDR(VADDR) %FINISH %EXITIF FAULT#0 %REPEAT PAR=MAP ABS(VADDR,0,10); !RELEASE USER SEG %FINISH ! !RETURN MESSAGE TO USER ! P_A1=FAULT P_SERVICE=ID %IF SYS=1 %THEN P_REPLY=SYS1 %ELSE P_REPLY=SYS2 PON(P) %REPEAT %ENDOFPROGRAM !********** !* SBLD13S * !* NB: NOT SAME AS BPL SBLD1S !!!! !* DATE: 17.MAR.80 * !* SUPERVISOR BUILD PROGRAM * !************************************* %PERMROUTINESPEC SVC(%INTEGER EP, %INTEGERNAME P1, %INTEGER P2) %PERMINTEGERMAPSPEC INTEGER(%INTEGER X) %PERMBYTEINTEGERMAPSPEC BYTEINTEGER(%INTEGER X) %PERMINTEGERFNSPEC ADDR(%INTEGERNAME X) %PERMINTEGERFNSPEC ACC %CONSTINTEGERNAME DUMMY = 0 %CONSTINTEGERNAME NULLI = 0 %BEGIN !* STK = 76000, STRM = 3 %ROUTINESPEC WRITE OUT FILE %ROUTINESPEC FILL INTS %ROUTINESPEC PRINT REST OF LINE %ROUTINESPEC MOVE 400 AND PLANT DKF %INTEGERFNSPEC ROCTAL %ROUTINESPEC OCTAL(%INTEGER X) %INTEGERFNSPEC WORD %RECORDFORMAT STRDF(%INTEGER A, B, C, %BYTEINTEGER D, E, UNIT, %C FSYS, %BYTEINTEGERARRAY NAME(0:5)) %RECORDFORMAT STRPF(%RECORD (STRDF) %NAME ST) %RECORDFORMAT COREF(%INTEGERARRAY CORE(0:K'34400')) %RECORDFORMAT CORE2F(%BYTEINTEGERARRAY CORE(0:K'71000')) %RECORD (COREF) %NAME CI %RECORD (CORE2F)CB %CONSTRECORD (STRPF) %NAME STRP2 = K'160036' %CONSTBYTEINTEGERNAME ID = K'160030' %RECORD (STRDF) %NAME STRD %OWNINTEGER SUPER CODE BASE %CONSTINTEGER INT6BASE = K'40' %INTEGER I, N, POS, DEDLOC, BC, LOADPT, BLOCK, FNO, GLAF, LBL %INTEGER TOP, CODE B, STK L, X, SUP TOP, START TOP %CONSTBYTEINTEGERARRAY SERA(0:4) = 3, 3, 0, 0, 28; ! SER NOS FOR DISC UNITS %OWNINTEGER SER = 3; ! NORMALLY UNIT 0 OR 1 %OWNINTEGER STR = 2, LAST = 0, ELEVEN45 = 0 %CONSTINTEGERARRAY DKF(0:8) = K'000005', K'000240', K'012706', %C K'001300', K'013701', K'060004', K'016101', K'000002', K'004731' %INTEGERARRAY BUFF(0:255) FNO = 0; ! FILE BEING READ IN CI == CB CB = 0 X = 0; SUP TOP = 0 STRD == STRP2_ST; ! MAP TO STREAM(2) DESCRIPTOR SELECT INPUT(1) SELECT OUTPUT(1) %UNTIL I=NL %CYCLE; READSYMBOL(I); PRINTSYMBOL(I); %REPEAT PROMPT("SUPER CODE BASE?") SUPER CODE BASE = ROCTAL OCTAL(SUPER CODE BASE); NEWLINE %CYCLE PROMPT('FILE:') SKIPSYMBOL %WHILE NEXTSYMBOL < 'A' %OR NEXTSYMBOL > 'Z' STRD_NAME(I) = ' ' %FOR I = 0, 1, 5 %CYCLE I = 0, 1, 5 READSYMBOL(N) %IF N = NL %OR N = ' ' %THENEXIT STRD_NAME(I) = N %REPEAT %IF I = 3 %AND STRD_NAME(0) = 'E' %AND STRD_NAME(1) = 'N' %C %AND STRD_NAME(2) = 'D' %START FILL INTS %CYCLE PROMPT('PATCH?') I = ROCTAL %IF NEXTSYMBOL = 'S' %START PRINTSTRING(" SUPERVISOR LOADS FROM 000000 TO ") OCTAL(LOAD PT) PRINTSTRING(" AND 60000 TO ") OCTAL(START TOP) PRINTSTRING(" TOP OF STORE IS DETERMINED AT RUN TIME MOVE 400 AND PLANT DKF WRITE OUT FILE %STOP %FINISH BC = I >> 1 OCTAL(I); PRINTSYMBOL(':'); OCTAL(CI_CORE(BC)) %IF NEXTSYMBOL = '=' %START SKIPSYMBOL N = ROCTAL PRINTSTRING('->'); OCTAL(N) CI_CORE(BC) = N %FINISH PRINT REST OF LINE %REPEAT %FINISH POS = LAST !! DEFAULTED TO END OF LAST FILE %IF NEXTSYMBOL = NL %THEN PROMPT('DED LOC?') DEDLOC = ROCTAL STK L = ROCTAL; ! GET THE STACK LEN %IF NEXTSYMBOL = 'N' %THEN DEDLOC = 0 SKIPSYMBOL CI_CORE(DEDLOC >> 1) = POS %IF DEDLOC # 0 ! NOW READ IN THE FILE BLOCK = 0 SELECT INPUT(STR) GLAF = 0; LBL = 0 %IF F NO = 1 %START CODE B = SUPER CODE BASE; ! LOADS AT REAL ADDRESS POS = SUPER CODE BASE; ! MUST AGREE WITH PARAM AT LINK T %ELSE CODE B = K'40000' %CYCLE READSYMBOL(I) %UNTIL I = 1; SKIPSYMBOL BC = WORD-6 %EXITIF BC = 0; ! FINISHED LOAD PT = WORD %IF LOAD PT = K'61000' %THEN SUPTOP = TOP !! START CODE IS AT 61000, RETAIN CURRENT TOP FOR LATER %IF FNO = 0 %OR FNO = 2 %START; ! BRUN & PERM %IF FNO=2 %AND LOAD PT >= K'20000' %C %THEN LOADPT=LOADPT-K'020000' !! PERM 'PERM11S' ONWARSS IS AT 20000 (VIRTUAL) LOAD PT = LOADPT+POS %ELSE X=LOAD PT %IF FNO = 1 %IF LBL = 0 %START; ! TASK DESCRIPTOR LBL = 1 SKIPSYMBOL %AND BC = BC-1 %UNTIL BC = 0 %CONTINUE %FINISH %IF LOADPT&K'100000' # 0 %START %IF SUP TOP# 0 %START START TOP = TOP; TOP = SUP TOP; SUP TOP = 0 %FINISH %IF GLAF = 0 %THEN GLAF = (TOP+K'77')&K'177700' LOADPT = LOADPT-K'140000'+GLAF %ELSE LOADPT = LOADPT-CODE B+POS %FINISH %FINISH %CYCLE BC = BC, -1, 0 READSYMBOL(I) CB_CORE(LOAD PT) = I; LOAD PT = LOAD PT+1 %REPEAT BLOCK = BLOCK+1 !! BLOCK READ TOP = LOAD PT %REPEAT PRINTSYMBOL(STRD_NAME(I)) %FOR I = 0, 1, 5 SPACES(2) OCTAL(POS); SPACES(3); OCTAL(GLAF) SPACES(3); OCTAL(LOAD PT) SPACES(5); OCTAL(DEDLOC) NEWLINE LAST = (LOAD PT+STK L+K'77')&K'177700' !! INCLUDE THE SPACE FOR 'STACK' ! TO NEXT BLOCK %IF DEDLOC # 0 %START CI_CORE(DEDLOC >> 1+1) = GLAF CI_CORE(DEDLOC >> 1+2) = LAST %FINISH CLOSE INPUT SELECT INPUT(1) FNO = FNO+1 %REPEAT %ROUTINE FILL INTS %INTEGER INT, AD, BASE, X BASE = CI_CORE(INT6BASE>>1); ! FIND ADDRESS OF INT -6 PRINTSTRING(" RESETTING OF INTERRUPT NUMBERS AND VECTORS %CYCLE PROMPT("INT:") READ(INT); %RETURN %IF INT=0 AD = ROCTAL; ! FIND ITS VECTOR ADDRESS WRITE(INT, 2); PRINTSTRING(" VECTOR:") OCTAL(AD) %IF INT > -6 %START PRINTSTRING("ERROR - INTS FROM 0 TO -5 ARE FIXED IN FILE BRUN %CONTINUE %FINISH X = (-6-INT)*8; ! INDEX FROM NO -6 %IF INT < -10 %THEN X = X+4; ! INT -10 (BPTINT IS LENGTH 12 CI_CORE(AD>>1) = BASE+X CI_CORE(AD>>1+1) = K'340' PRINTSYMBOL('('); OCTAL(X+BASE); PRINTSYMBOL(')') PRINT REST OF LINE %REPEAT %END %ROUTINE PRINT REST OF LINE %INTEGER I SPACES(3) %CYCLE READSYMBOL(I); PRINTSYMBOL(I) %RETURN %IF I = NL %REPEAT %END %ROUTINE MOVE 400 AND PLANT DKF !! THE AREA AT 400 IS MOVED TO K'060120' ONWARDS !! AND THE INITIALISER IN 'DKF' IS MOVED INTO 400 !! IT IS ASSUMED THAT SUPERVIROR INITIALISER MOVES IT BACK %INTEGER I, N %CYCLE I = 0, 1, 20; ! MOVE 20 WORDS CI_CORE((K'060120'>>1)+I) = CI_CORE((K'000400'>>1)+I) %REPEAT !! NOW MOVE IN DKF %CYCLE I = 0, 1, 8 CI_CORE((K'400'>>1)+I) = DKF(I) %REPEAT %END %ROUTINE WRITE OUT FILE %INTEGER I, FLAG, N, BLOCK %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, %C %INTEGERNAME A2, %INTEGER A3) %RECORD (PF)P PROMPT('DISC?') READSYMBOL(FLAG) %UNTIL FLAG = '0' %OR FLAG = '1' PRINTSTRING(' PUT ON UNIT ') %IF FLAG = '1' %START BLOCK = 14!K'020000' PRINTSTRING('1 %ELSE %IF FLAG = 'T' %START PRINTSTRING("0 ON SITE # 2 BLOCK = 4600 %ELSE %IF FLAG = '4' %START SER = SERA(4); BLOCK = 1 PRINTSTRING("4 ON BOTTOM SITE %ELSE BLOCK = 14; ! WAS 4600 PRINTSTRING('0 %FINISH %FINISH %FINISH CI_CORE(K'60000'//2) = LAST P_SERVICE = SER; P_REPLY = ID P_A1 = 0; P_A2 == NULLI; P_A3 = 0 PONOFF(P); ! TURN DK TEST OFF %IF P_A1 # 9 %START SELECT OUTPUT(0) PRINTSTRING(" *** FAILED TO TURN DISC WRITE CHECK OFF %STOP %FINISH %CYCLE I = 0, 1, K'71'-1 %CYCLE N = 0, 1, 255 BUFF(N) = CI_CORE(I*256+N) %REPEAT P_SERVICE = SER; P_REPLY = ID P_A1 = 1; ! WRITE P_A3 = BLOCK+I P_A2 == BUFF(0) PONOFF(P) %IF P_A1 # 0 %START SELECT OUTPUT(0) PRINTSTRING(" *** FAILED TO WRITE BLOCK TO DISC %STOP %FINISH %REPEAT PRINTSTRING('CORE IMAGE WRITTEN SELECT OUTPUT(0) PRINTSTRING("NOW IPL %END %INTEGERFN WORD %INTEGER N, M READSYMBOL(N); READSYMBOL(M) %RESULT = M << 8!N %END %ROUTINE OCTAL(%INTEGER X) %INTEGER I %CYCLE I = 15, -3, 0 PRINTSYMBOL((X >> I)&7+'0') %REPEAT %END %INTEGERFN ROCTAL %INTEGER I, N, SUM SUM = 0 SKIPSYMBOL %WHILE NEXTSYMBOL = ' ' %OR NEXTSYMBOL = NL %CYCLE N = NEXTSYMBOL %RESULT = SUM %IF N < '0' %OR N > '7' SUM = (SUM << 3)!(N-'0') SKIPSYMBOL %REPEAT %END %ENDOFPROGRAM !****************************** !* EMAS-2900 BUFFER MANAGER * !* FILE: BUFX4S (INFO) * !* MODIFIED 20/8/80 TO OUTPUT STATS TO STREAM 1 (.LP) !* DATE: 06.MAR.80 * !****************************** !! STK = SIZE+200 %CONSTINTEGER SIZE = K'16400'; ! WAS 35000, BUT NEEDS LINK6S %CONTROL K'100001' %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %RECORDFORMAT D(%INTEGER I) %CONSTRECORD (D) %NAME NULL = 0 %BEGIN %RECORDFORMAT BF(%RECORD (BF) %NAME L, %BYTEINTEGER LEN, MODE, %C %BYTEINTEGERARRAY A(0:99)) %RECORDFORMAT QF(%RECORD (BF) %NAME L) %RECORDFORMAT R1F(%INTEGER X) %RECORDFORMAT R3F(%BYTEINTEGERNAME X) %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, FN, PORT, %C %RECORD (BF) %NAME MES, %BYTEINTEGER LEN, S1) %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, %INTEGER A, B, C) %CONSTBYTEINTEGERNAME OWN ID = K'160030' %CONSTINTEGER REQUEST BUFFER = 0 %CONSTINTEGER RELEASE BUFFER = 1 %CONSTBYTEINTEGERNAME INT = K'160060' %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310' %CONSTINTEGER T3 SER = 21 %CONSTINTEGER SER NO = 17 %OWNRECORD (QF) %NAME FREE BIG %OWNRECORD (QF) %NAME FREE SMALL %CONSTINTEGER NO OF BIG = 18, BIG L = 256 %CONSTINTEGER NO OF SMALL = 42, SMALL L = 64 !* NOTE: FOR ONE SEGMENT (ELSE CHANGE ABOVE) !! 4*SMALL = BIG TOTAL = (N SMALL+1)*4+N BIG = 32 %CONSTINTEGER QL = 127; ! SIZE OF 'REQUEST' QUEUE %OWNINTEGER QUEUED = 0 %OWNINTEGER NB = 0, NS = 0, QQ = 0, LB = 999, LS = 999 ! NB -> K'100112' (IN OTHER VMS) %OWNINTEGER BR = 0, SR = 0 %OWNINTEGER DELAY = 10; ! 10 MINS %OWNINTEGER DCOU %OWNINTEGERARRAY MONIT(0:20) %OWNRECORD (PE) %ARRAY PA(0:QL) %INTEGER I, ADD, PT, LEN, TOP, BOT %OWNRECORD (PE)P %OWNRECORD (P2F) %NAME P2 %OWNRECORD (BF) %NAME B %OWNRECORD (R1F)R1 %OWNRECORD (QF) %NAME R2 %OWNRECORD (R3F) %NAME R3 %BYTEINTEGERARRAY BUFF(0:SIZE) %ROUTINESPEC QUEUE(%RECORD (PE) %NAME P) %INTEGERFNSPEC UNQUEUE(%INTEGER LEN) LINKIN(SER NO) CHANGE OUT ZERO = T3 SER; ! POINT OUTPUT(0) TO COMMON OUT ALARM(60*50); ! ONE MINUTE P2 == P R2 == R1; R3 == R1 R3_X == BUFF(0) TOP = R1_X R3_X == BUFF(SIZE) BOT = R1_X ! OCTAL(TOP); ! OCTAL(BOT); ! NEWLINE PT = (TOP&K'17700')+K'100' PT = PT!(TOP&K'160000') ! OCTAL(PT) %CYCLE I = 1, 1, NO OF SMALL R1_X = PT; PT = PT+SMALL L B == R2_L B_L == FREE SMALL FREE SMALL == B B_MODE = 64 NS = NS+1 %REPEAT %CYCLE I = 1, 1, NO OF BIG R1_X = PT; PT = PT+BIG L B == R2_L B_L == FREE BIG FREE BIG == B B_MODE = 0 NB = NB+1 %REPEAT ! OCTAL(PT); ! NEWLINE %CYCLE P_SER = 0; POFF(P2) %IF P_REPLY = 0 %START; ! CLOCK TICK %IF '0'<=INT<='9' %THEN DELAY =INT-'0' %AND %C INT = 'P' %AND DCOU = 0 ALARM(50*60) %IF NB = 0 %START PRINTSTRING("BUFF: NO BIG BUFFERS ****** %FINISH %IF NS = 0 %THEN PRINTSTRING("BUFF: NO SMALL BUFFERS ****** DCOU = DCOU+1 %IF DCOU = DELAY %START DCOU = 0 SELECT OUTPUT(1) WRITE(2,1) WRITE(NB, 1); WRITE(NS, 1) WRITE(LB, 1); WRITE(LS, 1) WRITE(BR, 3); WRITE(SR, 1) WRITE(QUEUED, 3); WRITE(QQ, 1); NEWLINE QQ = 0; LB = 999; LS = 999; BR = 0; SR = 0 SELECT OUTPUT(0) %FINISH %CONTINUE %FINISH %IF P_FN = REQUEST BUFFER %START AGAIN: ! COMES HERE IF IT WAS A ! QUEUED REQUEST %IF P_LEN = 0 %START; ! BIG BUFFER %UNLESS FREE BIG == NULL %START P_MES == FREE BIG; FREE BIG == P_MES_L NB = NB-1; %IF NB < LB %THEN LB = NB BR = BR+1 -> REPLY %FINISH QUEUE(P2) %ELSE !! SMALL BLOCK REQUEST %UNLESS FREE SMALL == NULL %START P_MES == FREE SMALL; FREE SMALL == P_MES_L NS = NS-1; %IF NS < LS %THEN LS = NS SR = SR+1 REPLY: P_SER = P_REPLY; P_REPLY = SER NO P_MES_L == NULL P_MES_A(1) = P_SER; ! PUT WHO TO IN IT P2_B = P2_B-K'20000' !! PUT BLOCK ADDRESS IN SEG 4/5 PON(P2) %ELSE QUEUE(P2) %FINISH %FINISH %CONTINUE %FINISH !! SHOULD BE RELEASE BUFFER %IF P_FN = RELEASE BUFFER %START P2_B = P2_B+K'20000'; ! BLOCK ADDRESS IN SEG 5/6 %IF P_MES_MODE = 0 %START P_MES_L == FREE BIG FREE BIG == P_MES NB = NB+1 LEN = 0; ! BIG BLOCK %ELSE P_MES_L == FREE SMALL FREE SMALL == P_MES LEN = 1; ! SMALL BLOCK NS = NS+1 %FINISH !! CHECK FOR A QUEUED REQUEST %IF QUEUED > 0 %START %IF UN QUEUE(LEN) # 0 %THEN -> AGAIN !! # 0 -> FOUND A REQUEST, WHICH IS COPIED TO "P" %FINISH %FINISH %REPEAT %ROUTINE QUEUE(%RECORD (PE) %NAME P) %INTEGER I %RECORD (PE) %NAME P2 %CYCLE I = 0, 1, QL P2 == PA(I) %IF P2_SER = 0 %START; ! QUEUE SLOT NOT ALLOCATED P2 = P; ! COPY P INTO PA QUEUED = QUEUED+1; QQ = QQ+1 %RETURN %FINISH %REPEAT PRINTSTRING("FULL! ") %END %INTEGERFN UN QUEUE(%INTEGER LEN) !************** !* BTT6S * !*DA:24.MAR.80* !************** %CONTROL K'100001'; ! 'SYSTEM' PROGRAM (FAST ROUTINE ENTRY/EXIT) %PERMROUTINESPEC SVC(%INTEGER EP, P1, P2) %BEGIN %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEGS) %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %C %INTEGER A1, A2, A3) %RECORDFORMAT TTF(%INTEGER KBS, KBD, TTS, TTD) %RECORDFORMAT BUFF(%INTEGER PT, LAST, %BYTEINTEGERARRAYNAME B) %RECORDFORMAT BUFFX(%INTEGER PT, LAST, ARRAYPT) %CONSTRECORD (BUFFX) %NAME NULL = 0 %CONSTINTEGER RUBOUT=K'177' %CONSTINTEGER CAN=24 %CONSTINTEGER CR=13 %CONSTINTEGER BELL=7 %CONSTINTEGER ESC=K'33' %CONSTINTEGER SI=K'17'; ! SHIFT INTO LOWER MODE (CTRL O) %CONSTINTEGER SO=K'16'; ! SHIFT OUT (CTRL N) %CONSTINTEGER DLE=K'20'; ! (CTRL P) %CONSTINTEGER EOT = K'04'; ! EOF (CTRL D) %CONSTINTEGER DC1=K'21'; ! CANCEL OUTPUT (CTRL Q) %CONSTINTEGER TAB = 9; ! TAB (IMPLEMENTED AS 3 SPACES) %OWNRECORD (TTF) %NAME TT=K'137560' %OWNINTEGER KBINT=-2 %OWNINTEGER TTINT=-1 %OWNINTEGER TTSER=1; ! ??? %OWNINTEGER CLIID=2 %OWNINTEGER TT STATUS=0, UPPER=32, TT IDLE=0, E PT=0, EFPT=0 %RECORD (PF) P2 %OWNRECORD (PF) %NAME P %CONSTINTEGER NO OF SPECS = 6 %OWNBYTEINTEGERARRAY SPECS(0:NO OF SPECS) = RUBOUT, CAN, ESC, CR, SI, SO, TAB %INTEGER CHAR, I, IN MODE, E LAST %INTEGER OUTID, SEG, CLI FLAG, CID, CADR %OWNRECORD (BUFF) OUT, INH %RECORD (BUFFX) %NAME BUFX, INX %RECORDFORMAT HF(%RECORD (HF) %NAME H, %RECORD (PF) P) %RECORDFORMAT QF(%RECORD (HF) %NAME H) %OWNRECORD (HF) %ARRAY HA(0:15) %OWNRECORD (HF) %NAME H %OWNRECORD (QF) HI, HO %OWNRECORD (QF) FREE %OWNINTEGER FIRST, LAST, CURR %OWNBYTEINTEGERARRAY BUFFER(0:255) %OWNBYTEINTEGERARRAY ECHOB(1:40) %SWITCH INS(0:NO OF SPECS), STATE(0:7) %ROUTINESPEC DRIVE TT(%INTEGER CHAR) %ROUTINESPEC ECHO(%INTEGER X) %ROUTINESPEC ECHO BELL %ROUTINESPEC TRANSFER INPUT %ROUTINESPEC OUTPUT REPLY %ROUTINESPEC PLANT(%INTEGER N) !! %CONSTBYTEINTEGERARRAY CANM(0:3)= 3, '#', CR, NL !! %CONSTBYTEINTEGERARRAY CLIM(0:3)= 3, '<', 8, '>' %CONSTINTEGER MYSEG=4, MSA=K'100000' %CONSTINTEGER MYISEG=3, MISA=K'060000' MAPHWR(5); ! MAP REGS TO SEG 5 LINKIN(TTSER); LINKIN(KBINT); LINKIN(TTINT) TT_KBS=K'100' BUFX==OUT INX==INH %CYCLE I = 15, -1, 0 PUSH(FREE, HA(I)) %REPEAT %CYCLE %IF OUTID=0 %AND %NOT HO_H == NULL %START H == POP(HO); PUSH(FREE, H) P == H_P %ELSE P == P2 P_SERVICE = 0 POFF(P) %FINISH %IF P_SERVICE=KBINT&X'FF' %START CHAR=TT_KBD&127; ! STRIP PARITY BIT %CYCLE I=NO OF SPECS, -1, 0 ->INS(I) %IF CHAR=SPECS(I) %REPEAT !! NORMAL CHAR %IF CHAR>='A'+K'40' %AND CHAR<='Z'+K'40' %THENC CHAR=CHAR-UPPER; ! TURN TO UPPER PLANT(CHAR) %CONTINUE INS(0): ! RUBOUT %IF LAST#CURR %START LAST = (LAST-1)&255 ECHO('\') %ELSE ECHO BELL %CONTINUE INS(1): ! CANCEL %IF LAST#CURR %START LAST = CURR ECHO('#'); ECHO(CR); ECHO(NL); E LAST=E PT %ELSE ECHO BELL %CONTINUE INS(2): ! ESCAPE - GO TO CLI CLI FLAG = 1 LAST = 0; CURR = 0; FIRST = 0 INS2: ECHO('<'); ECHO(13); ECHO('>') %CONTINUE INS(4): ! SHIFT IN UPPER = 0; %CONTINUE INS(5): ! SHIFT OUT UPPER = 32; %CONTINUE INS(6): ! TAB PLANT(' '); PLANT(' '); PLANT(' '); %CONTINUE INS(3): ! CR PLANT(NL); CURR = LAST TRANSFER INPUT E LAST=E PT; ! ALLOW IT TO DO OUTPUT NOW %ELSE %IF P_SERVICE=TT INT&X'FF' %START ->STATE(TT STATUS) DO OUT: STATE(5): ! GOING IDLE TT STATUS=0 %IF E PT>0 %THEN TT STATUS=2 %ELSESTART %IF OUT_LAST#0 %THEN TT STATUS=1 %FINISH ->STATE(TT STATUS) STATE(1): ! NORMAL OP CHAR=OUT_B(OUT_PT); OUT_PT=OUT_PT+1 %IF OUT_PT>=OUT_LAST %THEN TT STATUS=5 %AND OUTPUT REPLY DRIVE TT(CHAR) STATE(0): %CONTINUE STATE(2): ! ECHO OP %IF EFPTDO OUT %FINISH %FINISH %IF EFPT=E PT %THEN E PT=0 %AND EFPT=0 %CONTINUE STATE(3): ! NORMAL CR STATE(4): ! ECHO CR STATE(7): ! END OF LINE - NEWLINE TT STATUS=5 DRIVE TT(NL+128) %CONTINUE STATE(6): ! IN ECHO LINE %CYCLE; %REPEAT %ELSE %IF P_SERVICE=TT SER %START; ! USER REQUEST %IF P_A1=1 %START; ! OUTPUT REQUEST %IF OUTID#0 %START H == POP(FREE) %IF H == NULL %START REJ: P_SERVICE= P_REPLY; P_REPLY = TT SER P_A1 = 1; PON(P) %CONTINUE %FINISH H_P = P; ! COPY P INTO SAFE PLACE PUSH(HO, H); ! AND QUEUE IT %CONTINUE %FINISH OUTID=P_REPLY SEG=P_A2>>13; ! SEG NO OF BUFFER MAP VIRT(OUTID, SEG, MY SEG) BUFX_ARRAYPT=MSA+(P_A2&K'17777') OUT_PT=0; OUT_LAST=P_A3; ! LENGTH %IF OUT_LAST=0 %THEN OUTPUT REPLY %ELSESTART ->DO OUT %IF TT STATUS=0; ! TT IDLE %FINISH %ELSE !! INPUT REQUEST %IF P_A1 # 0 %START CID = P_REPLY; CADR = P_A2 %CONTINUE %IF P_A3 # 0; ! JUST READ FROM CLI %FINISH H == POP(FREE) -> REJ %IF H == NULL H_P = P; ! COPY P INTO A SAFE PLACE PUSH(HI, H); ! AND Q IT %IF P_A1#0 %AND FIRST=LAST %THEN -> INS2 %IF FIRST#CURR %START; ! NON EMPTY LINE TRANSFER INPUT %FINISH %FINISH %FINISH %REPEAT %ROUTINE DRIVE TT(%INTEGER CHAR) %IF CHAR=NL %START TT STATUS=TT STATUS+2 CHAR=CR %FINISH TT_TTD=CHAR TT_TTS=TT_TTS!K'100'; ! INTS ON %END %ROUTINE ECHO(%INTEGER X) %RETURN %IF E PT>40 E PT=E PT+1; ECHOB(E PT)=X %IF TT STATUS=0 %OR TT STATUS=6 %START TT STATUS=2 DRIVE TT(X) EFPT=1 %FINISH %END %ROUTINE ECHO BELL ECHO(BELL); E LAST=E PT %END %ROUTINE PLANT(%INTEGER CHAR) BUFFER(LAST) = CHAR LAST = (LAST+1)&255 ECHO(CHAR) %END %ROUTINE TRANSFER INPUT %INTEGER SEG, I, ID, ADR, N %IF CLI FLAG # 0 %START; ! PREEMPTED BY CLI ID = CID; ADR = C ADR; CLI FLAG = 0 %ELSE %IF HI_H == NULL %THEN %RETURN H == POP(HI); PUSH(FREE, H) ID = H_P_REPLY; ADR = H_P_A2 %FINISH %IF ID#0 %START SEG=ADR>>13 MAP VIRT(ID, SEG, MYISEG) INX_ARRAY PT=MISA+(ADR&K'17777') %CYCLE I = 0, 1, 80 N = BUFFER(FIRST) INH_B(I) = N FIRST = (FIRST+1)&255 %EXIT %IF N = NL %REPEAT P_SERVICE=ID; P_REPLY=TTSER P_A1=I+1 PON(P) MAP VIRT(0, -1, MYISEG) %FINISH %END %ROUTINE OUTPUT REPLY MAP VIRT(0, -1, MYSEG) P_SERVICE=OUTID; P_REPLY=TTSER P_A1=0 PON(P) OUTID=0; OUT_LAST = 0 %END %ENDOFPROGRAM ER ID, SEG, I, BK, NO, NOSAVE, PR, EXIT, SEG2 %OWNINTEGER DRIVE, FNO !*MESSAGE FORMATS %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, A2, A3) %RECORDFORMAT P2F(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, %C %INTEGERNAME A2, %INTEGER A3) %RECORD (PF)P, PX !*DISC BUFFER POOL %CONSTINTEGER SECS = 5; !BUFFER WRITE BACK TIME %CONSTINTEGER NBUF = 3; !NUMBER OF BUFFERS-1(MUST BE>0) %RECORDFORMAT XF(%INTEGER X) %RECORDFORMAT BF(%INTEGER DRIVE, BLOCK, WRM, %RECORD (XF) %C %ARRAY BLK(0:255)) !*WRM IS A WRITE MARKER TO SAY THAT BLOCK HAS BEEN !*ALTERED AND MUST BE WRITTEN BACK TO DISC. %OWNRECORD (BF) %ARRAY B(0:NBUF) %OWNINTEGER BLAST = 0; !LAST BUFFER USED IN POOL %OWNRECORD (BF) %NAME BX; !POINTS TO CURRENT BUFFER RECORD !*FORMATS FOR BLOCK DESCRIPTORS AND DIRECTORY BLOCKS %RECORDFORMAT BLKF(%INTEGER PR, NEXT) !BLOCK DESCRIPTOR %RECORDFORMAT N1F(%BYTEINTEGERARRAY NAME(0:5)) %RECORDFORMAT N2F(%INTEGER A, B, C) ! TWO FORMS OF THE FILE NAME %RECORDFORMAT INFF(%BYTEINTEGER UNIT, FSYS, %RECORD (N1F)N) ! FILE DESCRIPTOR %RECORDFORMAT INF2F(%BYTEINTEGER UNIT, FSYS, %RECORD (N2F)N) %RECORDFORMAT FILEF(%RECORD (N1F)N, %INTEGER FIRST, PR) !DIRECTORY ENTRY %RECORDFORMAT FILE2F(%RECORD (N2F)N, %INTEGER FIRST, PR) %OWNRECORD (BLKF) %ARRAYNAME BLKA %RECORD (FILEF) %ARRAYNAME FA %OWNRECORD (FILEF) %NAME F %RECORD (BLKF) %NAME BLK %RECORD (BLKF)SAVE BLK %RECORD (INFF) %NAME INF, INF2 %RECORD (INFF)G !*********************************************** !* E V E N T S !! %ON %EVENT 15 %START; ! DISC I/O FAIL !! %IF PX_SERVICE = 0 %THEN -> RESTART; ! IN TIMER SECTION !! -> REPLY !! %FINISH !********************************************** !**************************************************************** !****************************************************************** !*ROUTINE DA !*CALLS DISC HANDLER TO READ IN A BLOCK !* NB: THIS ROUTINE ASSUMES THAT BX POINTS TO THE BLOCK DESCRIPTOR %ROUTINE DA(%INTEGER MODE) %RECORD (P2F)P %INTEGER DRIVE DRIVE = BX_DRIVE P_A3 = BX_BLOCK; ! COMPILER ERROR FORCES THIS P_SERVICE = SERV(DRIVE) P_REPLY = ID %IF DRIVE = 1 %THEN P_A3 = P_A3!K'020000' P_A1 = MODE %IF MODE # D READ %THEN BX_WRM = 0 ! CLEAR THE WRITE MARKER P_A2 == BX_BLK(0) PONOFF(P) %IF P_A1 # 0 %THENSIGNAL 15, 15 %END !******************************************************* !*RECORD MAP LOAD !*LOADS REQUESTED BLOCK INTO CORE IF IT IS NOT ALREADY THERE !*AND RETURNS A POINTER TO THE START OF THE RECORD BX !*WHICH IS SET UP TO CURRENT ENTRY IN THE BUFFER POOL !*DRIVE IS ASSUMED TO BE SET UP. ******** !* THE ROUTINE ALSO SETS UP GLOBAL BX AS A SIDE EFFECT %RECORD (BF) %MAP LOAD(%INTEGER BLOCK) %INTEGER I, TEMP !*CHECK IF BLOCK ALREADY IN POOL %CYCLE I = NBUF, -1, 0 BX == B(I) %IF BX_DRIVE = DRIVE %AND BX_BLOCK = BLOCK %START %RESULT == BX %FINISH %REPEAT !*BLOCK NOT IN POOL BX == B(BLAST) BLAST = BLAST+1 %IF BLAST > NBUF %THEN BLAST = 0 %IF BX_WRM # 0 %START; !WRITE BACK OLD BLOCK DA(DWRITE) %FINISH BX_DRIVE = DRIVE BX_BLOCK = BLOCK DA(DREAD); !READ IN NEW BLOCK %RESULT == BX %END !************************************************************ !*RECORD MAP EXAM !*TO READ IN CORRECT DIRECTORY BLOCK !*AND FIND REQUIRED ENTRY %RECORD (FILEF) %MAP EXAM(%RECORD (INFF) %NAME INF) %INTEGER N, J, K, HIT, T %RECORD (N2F) %NAME FILE %RECORD (N2F) %NAME INFO %RECORD (FILE2F) %NAME F !*SET UP DRIVE NUMBER,0,1 RK05 !2,3 AMPEX DRIVE = INF_UNIT INFO == INF_N; ! POINT TO NAME PART !*SET UP DIRECTORY BLOCK FOR SCAN T = DIRBLK(DRIVE) N = T+INF_FSYS; ! MAP TO USERS DIRECTORY %UNTIL N > T+4 %CYCLE; ! SYSTEM OCCUPIES 3 BLOCKS FA == LOAD(N)_BLK !*LOOK FOR MATCH %CYCLE J = 0, 1, 50 FNO = J; ! GLOBAL FOR CREATE F == FA(J); ! POINT TO TARGET ENTRY FILE == F_N; ! MOST CONVENIENT FORMATR %IF FILE_A = INFO_A %AND FILE_B = INFO_B %AND FILE_C = %C INFO_C %THENRESULT == F %REPEAT N = N+1 %REPEAT %RESULT == NULL %END !****************************************************************** !*RECORD MAP GET BLOCK !*RETURNS POINTER TO CORRECT BLOCK DESCRIPTOR !*AFTER CALLING LOAD TO READ IT INTO CORE %RECORD (BLKF) %MAP GET BLOCK(%INTEGER BLOCK NO) %INTEGER POS, PT POS = BLOCK NO >> 7+BLKLST(DRIVE) !BLOCK DESC BLOCK BLKA == LOAD(POS)_BLK %RESULT == BLKA(BLOCK NO&K'177') ! OFFSET INTO BLOCK %END !********************************************************** !*INTEGER FUNCTION APPENDB !*RETURNS NEXT FREE BLOCK NUMBER %INTEGERFN APPENDB(%INTEGER LAST) %INTEGER WRAP WRAP = 0 %CYCLE LAST = LAST+1 %IF LAST = LASTBL(DRIVE) %START %IF WRAP = 0 %THENRESULT = 0 WRAP = WRAP+1 LAST = FBLOCK(DRIVE) %FINISH BLK == GET BLOCK(LAST) %IF BLK_PR = 0 %THENRESULT = LAST %REPEAT %END !***************************************************************** !************************************************************* !************************************************************* !*MAIN CONTROL LOOP !*LINK TO SYSTEM SLOTS LINKIN(RKSER); LINKIN(AMP1SER); LINKIN(AMP2SER); LINKIN(RKBSER) ID = GETID ALARM(SECS*50); !SET CLOCK FOR SECS SECONDS RESTART: %CYCLE P_SERVICE = 0 POFF(P) !*IF CLOCK TICK CHECK IF BUFFER POOL NEEDS WRITING %IF P_REPLY = CLOCK INT %START ALARM(SECS*50) PX_SERVICE = 0; ! FOR EVENT 15 HANDLING %CYCLE I = NBUF, -1, 0 %IF B(I)_WRM # 0 %START BX == B(I) DA(DWRITE) %FINISH %REPEAT %CONTINUE %FINISH !*NOT A CLOCK TICK--REQUEST FOR SERVICE PX_SERVICE = P_REPLY PX_REPLY = P_SERVICE PX_A2 = P_A2 !*GET CALLERS BLOCK NO = 0 SEG = P_A2 >> 13 %IF SEG = 0 %THENSIGNAL 36, 36 MAP VIRT(P_REPLY, SEG, MY SEG) INF == RECORD(MSA+(P_A2&K'17777')); INF2 == INF -> REQUEST(P_A1) !* !** !***** EXAMINE FILE !** !* REQUEST(EXAMINE): !*P_A2 HAS ADDRESS OF DESCRIPTOR !*EXAMINE FINDS THE FILE ENTRY IN THE DIRECTORY BLOCK !*AND RETURNS THE FIRST BLOCK'S NUMBER IN THE FILE !*TO THE CALLER. NO = 0 F == EXAM(INF) %UNLESS F == NULL %THEN NO = F_FIRST %IF DRIVE = 1 %AND NO # 0 %THEN NO = NO!K'020000' -> REPLY WRITE DIR: DA(DWRITE); !PUT DIRECTORY BLOCK BACK REPLY: MAP VIRT(0, -1, MYSEG); !RELEASE SEGMENT PX_A1 = NO PON(PX) %CONTINUE !* !** !***** GET NEXT !** !* REQUEST(GET NEXT): !*P_A2=FILE DESCRIPTOR,P_A3=LAST BLOCK !*GET NEXT IS GIVEN A BLOCK OF A FILE AND RETURNS !*THE NEXT BLOCK IN THE FILE BY LOOKING AT THE LINK IN !*THE BLOCK DESCRIPTOR.IT ALSO READS THE BLOCK DECRIPTOR !*ENTRY FOR THE NEXT BLOCK TO CHECK THE PROTECT CODE. DRIVE = INF_UNIT BK = P_A3 %IF DRIVE = 1 %THEN BK = BK&K'17777' BLK == GET BLOCK(BK); !GET PREVIOUS BLOCK PR = BLK_PR; NO = BLK_NEXT %IF NO # 0 %START BLK == GET BLOCK(NO) %IF BLK_PR # PR %THEN NO =- 1 %ELSESTART !! NO = -1 IS A PROTECT CODE ERROR %IF DRIVE = 1 %THEN NO = NO!K'020000' %FINISH %FINISH -> REPLY !* !** !***** DESTROY !** !* REQUEST(DESTROY): !*DESTROY REMOVES THE FILE'S NAME FROM THE DIRECTORY !*BLOCK AND GOES DOWN THE BLOCK DESCRIPTOR ENTRIES FOR !*THAT FILE SETTING ALL THE LINKS AND PROTECT CODES TO !*ZERO(CHECKING THE PROTECT CODES AS IT GOES.) EXIT = 0; !TAKE NORMAL EXIT DESTF: NO = 1; ! FILE DOES NOT EXIST F == EXAM(INF) %UNLESS F == NULL %START NO = 0 BK = F_FIRST; PR = F_PR F = 0; ! DELETE NAME ETC F_PR = PR; ! RESTORE "PR" DA(DWRITE); !WRITE BLOCK BACK IMMEDIATELY %UNTIL BK = 0 %CYCLE !DELETE ALL LINKS AND PR BLK == GET BLOCK(BK) %IF BLK_PR # PR %START NO =- 1; !CORRUPT FILE!!! %EXIT %FINISH %IF FBLOCK(DRIVE) <= BK < FIRST FREE(DRIVE) %THEN %C FIRST FREE(DRIVE) = BK BK = BLK_NEXT BLK = 0; ! ZERO PR AND NEXT BX_WRM = BX_WRM+1 %REPEAT %FINISH -> REPLY %IF EXIT = 0 -> REN TMP; !BACK TO RENAME TEMP !* !** !***** CREATE FILE !** !* REQUEST(CREATE): !*A FILE IS CREATED BY FINDING AN EMPTY SLOT IN THE DIRECTORY !*BLOCK AND COPYING THE NAME INTO IT.A FREE BLOCK IS THEN FOUND !*AND IS DEEMED TO BE THE FIRST BLOCK OF THE FILE.A LINK TO !*THIS BLOCK IS SET UP AND THE PROTECT CODE CALCULATED AND !*INSERTED INTO THE BLOCK DESCRIPTOR. DRIVE = INF_UNIT NOSAVE = 0 NOSAVE = APPENDB(FIRST FREE(DRIVE)) %IF NOSAVE # 0 %START G_FSYS = INF_FSYS G_UNIT = INF_UNIT F == EXAM(G); !FIND EMPTY SLOT %UNLESS F == NULL %START NO = NOSAVE F_N = INF_N; ! COPY NAME BX_WRM = BX_WRM+1 F_PR = ((F_PR+K'010000')&K'170000')!INF_FSYS << 6!FNO F_PR = K'010000' %IF F_PR = 0 ! IN CASE OF ZERO PR F_FIRST = NO PR = F_PR DA(D WRITE); !PUT DIRECTORY BLOCK BACK BLK == GET BLOCK(NO); !GET BLOCK DESCRIPTOR BACK BLK_PR = PR BX_WRM = BX_WRM+1 FIRST FREE(DRIVE) = NO %IF DRIVE = 1 %THEN NO = NO!K'020000' %FINISH %FINISH -> REPLY !* !** !***** APPEND BLOCK !** !* REQUEST(APPEND): !*TO APPEND A BLOCK TO A FILE THE CURRENT LAST BLOCK !*DESCRIPTOR ENTRY IS INSPECTED FOR THE PROTECT CODE. !*THE NEXT FREE BLOCK'S DESCRIPTOR IS THEN !*UPDATED WITH THIS CODE AND A LINK TO THIS BLOCK !*IS INSERTED IN THE LAST DESCRIPTOR ENTRY. DRIVE = INF_UNIT BK = P_A3; !GET LAST BLOCK %IF DRIVE = 1 %THEN BK = BK&K'17777' BLK == GET BLOCK(BK); !GET LAST BLOCK PR = BLK_PR NO = APPENDB(BK); !GET NEW LAST BLOCK %IF NO # 0 %START BLK_NEXT = 0 BLK_PR = PR BX_WRM = BX_WRM+1 FIRST FREE(DRIVE) = NO BLK == GET BLOCK(BK); !GET PREVIUOS LAST BLOCK TO ! INSERT LINK BLK_NEXT = NO %IF DRIVE = 1 %THEN NO = NO!K'020000' BX_WRM = BX_WRM+1 %FINISH -> REPLY !* !** !***** RENAME FILE !** !* REQUEST(RENAME): REQUEST(RENAME FSYS): ! FILES IN DIFFERENT FSYS !*P_A2HAS EXISTING,P_A3 HAS NEW FILE DESCRIPTOR !*IF THE NEW FILE DOES NOT ALREADY EXIST THEN THE OLD !*FILE NAME IN THE DIRECTORY BLOCK IS REPLACED BY !*THE NEW. NO =- 1 SEG2 = P_A3 >> 13 %IF SEG2 = SEG %START INF2 == RECORD(MSA+(P_A3&K'17777')) %IF INF_UNIT = INF2_UNIT %START %IF P_A1 = RENAME FSYS %START G_FSYS = INF2_FSYS G_UNIT = INF2_UNIT F == EXAM(G) %UNLESS F == NULL %START F == EXAM(INF); ! GET EXISTING FILE %UNLESS F == NULL %START; ! DOESN'T EXIST BK = F_FIRST; PR = F_PR F = 0; ! ZERO NAME RECORD BX_WRM = BX_WRM+1 DA(D WRITE) F == EXAM(G); ! GET EMPTY SLOT AGAIN F_N = INF2_N; ! COPY NAME F_FIRST = BK; F_PR = PR !! BX_WRM = BX_WRM+1 (WRITE DIR WRITES BACK) NO = 0 %FINISH %FINISH %ELSE F == EXAM(INF2); !CHECK NEW FILE DOES NOT EXIST %IF F == NULL %START F == EXAM(INF) %IF F == NULL %THEN NO = 1 %ELSESTART F_N = INF2_N; ! COPY NAME !! BX_WRM = BX_WRM+1 (WRITE DIR WRITES BACK) NO = 0 %FINISH %FINISH %FINISH %FINISH %FINISH -> WRITE DIR !* !** !***** RENAME TEMPORARY FILE !** !* REQUEST(RENAME TEMP): !*THIS RENAMES A TEMPORARY FILE IN THE SENSE THAT IT REMOVES !*THE TEMP FILE MARKER AND DESTROYS THE FILE. EXIT = 1; !SPECIAL EXIT FORM DIRECTORY INF_N_NAME(0) = INF_N_NAME(0)&X'FF7F' !REMOVE TEMP MARKER -> DESTF REN TMP: INF_N_NAME(0) = INF_N_NAME(0)!X'0080' !PUT BACK MARKER F == EXAM(INF) %IF F == NULL %THEN NO =- 1 %ELSESTART F_N_NAME(0) = F_N_NAME(0)&X'FF7F' !NOT TEMP NOW !! BX_WRM = BX_WRM+1 (WRITE DIR WRITES BACK) NO = 0 %FINISH -> WRITE DIR REQUEST(DIR BLK NO): ! GIVE BLOCK NO OF DIRECTORY NO = DIRBLK(INF_UNIT)+INF_FSYS -> REPLY %REPEAT %ENDOFPROGRAM opped %ELSE %IF P_C #- 2 %START PRINTSTRING('F A U L T '); WRITE(P_C, 1) %ELSE PRINTSTRING('term req.') %FINISH NEWLINE %FINISH PROG = PROG-1 %IF PROG <= 0 %THEN PROG = 0 %AND PUT READ ON(1) %CONTINUE %FINISH %IF P_A = 1 %START; ! REQUEST TO LOAD ! P_A = 1 - REQUEST TO LOAD ! P_B = ADDRESS OF LOAD ! P_C = CALL FLAG !! TFLAG (CALL FLAG) !! = 0 - NORMAL LOAD !! = 1 - SHARED LOAD (IF POSSIBLE) !! = 3 - SHARED LOAD (LOADER OWNES) !! = 4 - SHARED LOAD - REPLIES WHEN LOADED !! = K'101010' - SET T BIT %IF P_C < 3 %THEN REPLY TO HERE = P_REPLY %ELSE %C PROG = PROG+1 !* WITH TFLAG=3 OR 4, LOADER OWNES, SO MUST COUNT UP TFLAG = P_C %IF TFLAG = 4 %THEN TTFLAG = P_REPLY %ELSE TTFLAG = 0 SEGS = P_B >> 13 MAP VIRT(P_REPLY, SEGS, 4) PT = K'100000'!(P_B&K'17777') INPT = 1 %UNTIL I = NL %OR INPT > 40 %CYCLE I = BYTEINTEGER(PT); STORE(INPT) = I PT = PT+1; INPT = INPT+1 %REPEAT NCHAR = INPT-1 RELEASE(0) -> FROM OUT %FINISH %CYCLE; %REPEAT %FINISH CLOSE INPUT %CONTINUE ERROR: PRINT NAME PRINTSTRING(' fault ') PRINTSYMBOL(FAULT+'0'); NEWLINE ERROR2: CLOSE INPUT RELEASE(OSEG) N = SVC(DELETE, NEWID, 0) PROG = PROG-1 %REPEAT %INTEGERFN WORD %INTEGER S, T READSYMBOL(S); READSYMBOL(T) CKSM = CKSM+S+T %RESULT = T << 8+(S&X'FF') %END %ROUTINE PRINT NAME %RECORD (STRD2F) %NAME IN2 IN2 == INSTR1 INSTR1_FSYS = 6; ! 'LENGTH OF STRING' PRINTSTRING(IN2_NAME) %END %ROUTINE RELEASE(%INTEGER SEG) %IF SEG #- 1 %START MAP VIRT(0, -1, 4); ! ALWAYS RELEASE LOADER SEG 4 %FINISH %END %ROUTINE PUT READ ON(%INTEGER TYPE) %RECORDFORMAT P3F(%BYTEINTEGER SERVICE, REPLY, %INTEGER A, %C %BYTEINTEGERNAME B, %INTEGER C) %RECORD (P3F)P3 P3_SERVICE = 1; P3_REPLY = ID P3_B == STORE(1) %IF TYPE = 0 %THEN P3_A = 2 %ELSE P3_A = 5 %IF PROG < 0 %THEN PROG = 0 P3_C = PROG; ! SYSTEM IDLE FLAG READ FLAG = 1; ! WAITING FOR REPLY PON(P3) %END %ROUTINE MAP SHARED SEG(%INTEGER ID, SEG, SHARED NO) !! NOTE: CHANGES TO DISPS MADE ON 5:OCT:76 FOR 'IMPS' *K'016500'; *8; ! MOV ID, R0 *K'016501'; *6; ! MOV SEG, R1 *K'016502'; *4; ! MOV SHARED NO, R3 *K'104016'; ! EMT MAP SHARED (14) %END %RECORD (PSECTF) %MAP INSERT %CONSTINTEGER INSERTC = 4; ! SVC INSERT %RECORDFORMAT XF(%INTEGER X) %RECORD (XF) %NAME X %RECORD (D4F)X2 %RECORD (PSECTF) %NAME PS X == X2 X_X = SVC(INSERTC, 3, 3); ! INSERT AND MAP TO LOAD SEG 3 %RESULT == NULL %IF X_X = 0 PS == X2_PST; ! MAP PSECT TO IT NEWID = PS_ID %IF TASK LIMIT < NEWID %THEN TASK LIMIT = NEWID PS = 0; ! ZERO THE PSECT PS_ID = NEWID; ! REPLACE THE ID %RESULT == PS %END %ROUTINE OCTAL(%INTEGER N) %INTEGER I SPACE PRINTSYMBOL(N >> I&7+'0') %FOR I = 15, -3, 0 %END %RECORD (PSECTF) %MAP GET PSECT(%INTEGER ID) %INTEGER N %RECORD (D4F) %NAME D4; %RECORD (D1F)D1 D4 == D1 N = SVC(MAP PSECT, ID, 5); ! MAP TO MY K'100000' D1_X = N %RESULT == D4_PST %END %RECORD (PSECTF) %MAP GET NAME(%BYTEINTEGERNAME ST) %RECORD (PSECTF) %NAME PST %INTEGER PT, ID, J, CHAR, MATCH %RECORDFORMAT D5F(%BYTEINTEGERARRAYNAME STR) %RECORD (D2F) %NAME D2; %RECORD (D5F) D5 D2 == D5 D2_B == ST %CYCLE ID = TASK LOW LIMIT, 1, TASK LIMIT PST == GET PSECT(ID) %UNLESS PST == NULL %START %CYCLE J = 0, 1, 3 CHAR = D5_STR(J); MATCH = PST_NAME(J) %EXITIF CHAR <= ' ' >= MATCH -> NO %IF CHAR # MATCH %REPEAT %RESULT == PST %UNLESS PST_STATE = 0 %FINISH NO: %REPEAT %RESULT == NULL %END %ROUTINE PNAME(%BYTEINTEGERARRAYNAME NAME) %INTEGER I PRINTSYMBOL(NAME(I)) %FOR I = 0, 1, 3 %END %INTEGERFN CLI %RECORDFORMAT D1F(%STRINGNAME S) %RECORDFORMAT D2F(%BYTEINTEGERNAME N) %RECORD (D1F)D1 %RECORD (D2F) %NAME D2 %RECORD (PSECTF) %NAME PST %INTEGER I, J, K, ID, CHAR, TYPE %CONSTINTEGER COM LIMIT = 10 %CONSTSTRING (5) %ARRAY COMMS(0:COM LIMIT) = 'LOGON', %C 'TASKS', 'REGS', 'SEGS', 'PURGE', 'KILL', 'FREE', 'HOLD', 'INT', 'KICK', 'ABORT' %SWITCH COMSW(0:COM LIMIT) %RECORDFORMAT REGF(%INTEGERARRAY R(0:8)) %RECORD (REGF) %NAME REG %CONSTSTRING (2) %ARRAY REGS(0:8) = 'R0', 'R1', 'R2', 'R3', %C 'R4', 'R5', 'PC', 'PS', 'SP' %RECORD (SEGF) %NAME SEG INPT = 1 INPT = INPT+1 %WHILE 'A' <= STORE(INPT) <= 'Z' %AND INPT <= %C NCHAR STORE(0) = INPT-1 D2 == D1 D2_N == STORE(0) %CYCLE I = 0, 1, COM LIMIT %IF COMMS(I) = D1_S %START %IF I = 8 %START CHAR = STORE(INPT+1); INPT = INPT+2 %FINISH %IF I >= 2 %START PST == GET NAME(STORE(INPT+1)) %IF PST == NULL %START PRINTSTRING('TASK? %RESULT = 0 %FINISH %FINISH -> COMSW(I) %FINISH %REPEAT %RESULT = 1 COMSW(1): ! TASKS %CYCLE ID = TASK LOW LIMIT, 1, TASK LIMIT PST == GET PSECT(ID) %UNLESS PST == NULL %START PNAME(PST_NAME) OCTAL(PST_ID); OCTAL(PST_STATE) NEWLINE %FINISH %REPEAT -> OK COMSW(2): ! REGS OF NOMINATED TASK REG == PST_URS %CYCLE I = 0, 1, 8 PRINTSTRING(REGS(I)); OCTAL(REG_R(I)); SPACE NEWLINE %IF I = 4 %REPEAT NEWLINE -> OK COMSW(3): ! SEGS %CYCLE I = 0, 1, 7 SEG == PST_SEG(I) OCTAL(SEG_PAR); OCTAL(SEG_PDR) OCTAL(SEG_DADD); NEWLINE %REPEAT OK: %RESULT = 0 COMSW(4): ! PURGE PROG = PROG-1 PST_STATE = PST_STATE!K'200' PNAME(PST_NAME) PRINTSTRING(' purged I = SVC(DELETE, PST_ID, 0) -> OK COMSW(5): ! KILL PST_URS_PC = K'020000' %IF PST_STATE&(T POFF!K'200') # 0 %OR PST_STATE = 0 %START PST_STATE = PST_STATE&K'177' DO SCH: I = SVC(SCHEDULE, PST_ID, 0) %FINISH -> OK COMSW(0): ! LOG FSYS = (STORE(INPT+1)-'0') << 3+STORE(INPT+2)-'0' NEWLINE -> OK COMSW(6): ! FREE TASK (PUT ON CPUQ COMSW(9): ! KICK TASK TYPE = 0 KICK IT: PST_STATE = PST_STATE&(K'177') %IF PST_STATE # T POFF %THEN ->DO SCH P_SERVICE = PST_ID; P_REPLY = 7; P_A = TYPE; PON(P) -> OK COMSW(10): ! ABORT TASK TYPE = 1 -> KICK IT COMSW(7): ! WAIT PROCESS PST_STATE = PST_STATE!K'200' -> OK COMSW(8): ! INT 'CHAR' 'TASK' %IF PST_ID > K'42' %START; ! NOT SYSTEM TASKS MAP VIRT(PST_ID, 7, 4) GLAS_INTCHR = CHAR RELEASE(0); ! RELEASE THE SEG %FINISH -> OK %END %ENDOFPROGRAM LOAD øÿÝF ´ÿ²ÿua²ÿu ²ÿ°ÿ´ü ìÿNa ìÿÀE ÿ@-èÿ îÿÌÿ p@ô¥ ¼ÿ?$ ÿÿÆÿf* ÿÿæÿW-æÿ :àX2 À@ô¥. 4à°6 ;à%8 8àb: ;àE@ ä@ô¥. ÿÀå0 ÖÿWF :àÀE 8àqJ ÿÿæÿW-æÿ æÿxL 4Aõ¥0 ¸ÿ<àFR RAõ¥ ;à?b æÿNa÷ t a÷ p ®A÷ \ öÿ¤~ æÿNa÷ & ÿÿæÿW-æÿ àÿNa÷ ö æÿ@möÿp èÿÚÿG öÿÁe Úÿm¢ öÿÀe |Bõå âÿx² ÿÿÞÿW-Þÿ Þÿz´ BmöÿÂe ÜÿNa÷ , âÿD¼ ÖBõ% æÿNa÷ âÿë ìBõ% ÀÿÎÆ äÿèÎ âÿ×Ð ÞÿWt ÂÿõÞ ZCõå @aÁE?Àp  ÿ{ê túÿÂE äÿEì Þÿ÷ Úÿóú ¨Cõå âÿKü @môÿ5 Úÿ@þ ÞÿW-Þÿ  ÿæÿ8 þÿæÿu-æÿ æÿÀU LDõ% bDõ% ºÿø& ´ÿ²( |Du-ÌÿÖÿ æÿNa÷ < æÿNa÷ 0 ·ÿ > Îÿe@ òDWtóÿÁEøÿu ÎÿÀE u-ÂÿÎÿd  ÿÃU Òÿ+L 0Eu-ÞÿÆÿ ÞÿÆÿ(V ^Eu-Òÿ´ÿ ÚÿNa÷ ·ÿÁE ·ÿmb âÿÀf ¢EW=´ÿÿ ÚÿNa÷ > @ ·ÿÀE ÿ@mÚÿ5 ÚÿNa÷ þEõ% ÀæÿÇ ÷ ( u ØÿîÿÏ¢ ìÿNa Ù d¤ ¬Fô% a÷ \ ÀFÀ%þÿ a÷ J a÷ 2 èF÷ " íÿÀE òÿ¾ÿHä *Gõ% íÿÀE ¼ÿÀæ tóÿÀEøÿ5 Þÿwè íÿÁE Ù ¨ê ðÿÀE Äÿjì ÖÿRî Äÿ÷ Öÿæô ÖÿÌÿõ Ìÿôø ´øÃü ÎG÷ Ä a÷ 6 ÈÿÎe0 ôG÷ Æeúÿú" üÿNa÷ È úÿNa÷ ¾ ·ÿÁE ÿAmüÿAmúÿp ·ÿê( üÿÃE ÆeüÿA2 2àüÿ üÿÀe Æeþÿ ªHõ%ÿÿ Ù ¡F ÆeöÿíP èÿ÷ÿ úÿ5aúÿîZ øÿ6\ öÿNa Ù Éd Æeþÿ Æeøÿf| úÿüÿuaüÿy úÿøÿ¢ ¬þÑ¢ Æeüÿôª ÌI÷ 2 õeýÿüÿf üÿ÷ Ê ÁEøÿÁe0 Àþy² Æeøÿ³¶ øÿúÿuaúÿ̼ üÿø¾ Æeìÿ îÿðÿuaðÿ°Ò øÿu-øÿìÿ7 øÿ:Ö üÿqØ ÿÿöÿW-öÿ öÿÍÜ öÿ@mîÿ öÿ@müÿ òÿ¡Þ ºJÁ% Þýnì ÆeüÿÍô ÿÿüÿW-üÿ üÿ@m ¤ýxú Æeæÿ¨ aW¬> 0,ÌÿÖÿ üÿúÿuaúÿs< ÿÿöÿW-öÿ öÿ®@ üÿÁeÌ ¤Kõ% îÿðe ÆKõ% aÁe? øÿsL a÷ * tüÆT aGl0 ^üù` ðÿu-ðÿæÿ# ðÿÀf øÿ}h 2LÁe ¨þìl ^ý*n `L÷ ª øÿÀe ÿÿöÿW-öÿ öÿÕ| @mêÿ& ý÷ T ®Lõ% ¼L÷ N ÿÿöÿW-öÿ @møÿÀe ¸ü÷ øÿðÕ MÀe a÷ æ öÿò¤ jMðÅ öÿî² ÿÂå0 ÿÂ`Âå0 ¸M÷ R ìÿÀÈ øÿðÅ ÌMð¥ ìÿîÿæ ìÿN` Ù WÐ ìÿºØ øÿðÕ øÿð¥" Ù <ê bú¦î Îþ*ò øÿ÷ àÈ Î ÷ "ÿ À`Á>À À`Áÿÿÿÿÿÿ LOADUP *no stopped F A U L T term req. fault LOGON TASKS REGSS SEGSS PURGE KILLE FREEE HOLDE INTDE KICKE ABORT TASK? purged !************ !* MOTH6S * !* 27.NOV.79* !************ %CONTROL K'101011' %PERMINTEGERFNSPEC SVC(%INTEGER EP, R0, R1) %BEGIN %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %SYSTEMROUTINESPEC MAP HWR(%INTEGER TOSEG) %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, A2, A3) %RECORD (PF)P %CONSTINTEGER MAP PSECT = 16; ! SUPERVISOR CALL %CONSTINTEGERNAME SR0 = K'117572' ! INDEXED INTO SEG 4 %CONSTINTEGERNAME SR2 = K'117576' %ROUTINESPEC OCTAL(%INTEGER N) %RECORDFORMAT PSECTF(%INTEGER Q, %C %BYTEINTEGER STATE, ID, %BYTEINTEGERARRAY %C NAME(0:4)) %CONSTINTEGER MESS LIM = 7 %CONSTSTRING (13) %ARRAY FLTS(0:MESS LIM) = 'NOT READY!', 'BAD SEGMENT', 'ADDRESS ERROR', 'ILLEGAL INSTR', 'BPT TRAP', 'ILLEGAL SVC', 'BAD SER', 'TIME FAULT' %SWITCH SW(0:MESS LIM) %RECORDFORMAT D1F(%INTEGER X) %RECORDFORMAT D2F(%RECORD (PSECTF) %NAME X) %RECORD (D1F)D1 %RECORD (D2F) %NAME D2 %RECORD (PSECTF) %NAME PST %INTEGER I, J, K, FAULT, ID D2 == D1 LINKIN(-4); ! ADDRESS ERROR MAP HWR(4); ! TO SEGMENT 4 %CYCLE P_SERVICE = 0 POFF(P) %IF P_SERVICE = 7 %START ID = P_REPLY; FAULT = 0 %ELSE %IF P_SERVICE # (-4)&X'FF' %START PRINTSTRING('?? %CONTINUE %FINISH ID = P_A2; FAULT = P_A3 %FINISH D1_X = SVC(MAP PSECT, ID, 3) PST == D2_X PRINTSTRING("***") PRINTSYMBOL(PST_NAME(I)) %FOR I = 0, 1, 3; PRINTSYMBOL(':') PRINTSTRING(FLTS(FAULT)) -> SW(FAULT) SW(2):SW(3):SW(4):SW(5):SW(7): NEWLINE %CONTINUE SW(0): ! NOT READY SW(6): ! BAD SER SPACE OCTAL(P_A1); NEWLINE %CONTINUE SW(1): ! SEGMENTATION TRAP SPACE OCTAL(SR0); OCTAL(SR2); SR0 = 1; NEWLINE; %CONTINUE %REPEAT %ROUTINE OCTAL(%INTEGER N) %INTEGER I PRINTSYMBOL((N >> I)&7+'0') %FOR I = 15, -3, 0 SPACE %END %ENDOFPROGRAM MOTH Æeàÿµ îÿìÿuaìÿþ\ Ù q^ Ù \` ðÿÛd ðÿNa Ù Âf <@õ¥ ñÿÀE âÿPj V@õ¥üÿðÿ a÷ J ôÿàÿu öÿâÿwx êÿ¯~ ÿÿèÿW-èÿ èÿ@mêÿ aÁe4 aGl¬ î@÷ ´ ô@÷ ¢ Æeüÿj¬ õeýÿüÿf üÿ÷ * ÁEøÿÁe0 fA÷ 0 øÿ÷ àÈ Î ÀÌÀ<À ÀÌÀÿÿÿÿÿÿ NOT READY! BAD SEGMENT ADDRESS ERROR ILLEGAL INSTR BPT TRAPINSTR ILLEGAL SVCTR BAD SER SVCTR TIME FAULTCTR ! FILE 'RX022S' ! RX02 FLOPPY DISC HANDLER ! THIS IS THE UNIT 0&1 VERSION ! %% LAST UPDATED 2ND APRIL 1980 FILE=RX022S ! USES SYSTEM SLOTS 8 AND 14. INT SLOT -8. ! CALLING PARAMETERS ARE AS FOLLOWS ! P_A1=MODE (0=READ,1=WRITE) ! P_A2=ADDRESS OF BUFFER IN MEMORY ! P_A3=BLOCK NUMBER ON DISC ! SINCE DEIMOS DEALS IN 512 BYTE BLOCKS ALL TRANSFERS ARE 2*256 !BYTE SECTORS. THE FIRST 77 BLOCKS ARE RESERVED FOR THE SYSTEM. !WITHIN EACH TRACK OF 26 SECTORS THE SECTORS ARE INTERLEAVED. ! ON EXIT P_A1=FAULT NO. (0=OK) ! ANY ERROR WILL RESULT IN UP TO 10 RETRIES. ! STACK=300 STREAMS=0 %CONTROL K'101011' %SYSTEMROUTINESPEC LINKIN(%INTEGER SERVICE) %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG) %SYSTEMINTEGERFNSPEC MAP ABS(%INTEGER VAD,LEN,ID) %SYSTEMINTEGERFNSPEC GET ID %PERMROUTINESPEC SVC(%INTEGER EP,P1,P2) %BEGIN %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,A2,A3) %RECORDFORMAT P2F(%INTEGER D) %RECORDFORMAT RXF(%INTEGER CONTROL,DBREG) %CONSTRECORD(RXF)%NAME RX=K'117170'; !DEVICE ADDR ! VECTOR = 264 ! SYSTEM CONSTANTS %OWNINTEGER KID %CONSTINTEGER SYS1=3; !UNIT 2 %CONSTINTEGER SYS2=14; !UNIT 3 %CONSTINTEGER DINT=-3; !INT SLOT ! RX02 PARAMETERS %CONSTINTEGER TRBIT=K'400'; !READY BIT %OWNINTEGER TOP=1000 %OWNINTEGER BOT=88 %CONSTINTEGER RETC=10; !RETRY COUNT %CONSTINTEGER READ=0; !INPUT PARAMS %CONSTINTEGER WRITE=1 %CONSTINTEGER READFN=K'107'; !RX02 FUNCTIONS %CONSTINTEGER WRITEFN=K'105' %CONSTINTEGER EMPTYFN=K'103' %CONSTINTEGER FILLFN=K'101' %CONSTINTEGER TRDONE = K'200' %CONSTBYTEINTEGERARRAY SECMAP(1:26)= %C 1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26 ! GENERAL VARIABLS %RECORD (PF) P,PX %RECORD (P2F) %NAME P2 %OWNINTEGER SYS,FAULT,ID,CONT,SECTOR,TRACK,RETRIES,MAPIND,I,VADDR,PAR,FN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! INTEGERFNS START HERE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! REPORT FAULT SEND A MESSAGE TO MOTHER %INTEGERFN REPORT FAULT %RECORD (PF) PX PX_SERVICE=7; PX_REPLY=KID PX_A1=SECTOR; PX_A2=TRACK; PX_A3=RX_DBREG PONOFF(PX) %RESULT = PX_A1 %END ! MAPADDR MAPS BUS ADDRESS %INTEGERFN MAPADDR(%INTEGER VADDR) PAR=MAP ABS(VADDR,256,ID) %RESULT=1 %IF PAR=0 PAR=PAR+(VADDR&K'17700')>>6 %IF PAR>=K'2000' %START; !SET 17TH&18TH BITS CONT=CONT!(PAR&K'6000')<<2 PAR=PAR&K'1777' %FINISH %RESULT=0 %END ! SEEK DOES READ/WRITE %ROUTINE SEEK(%INTEGER FN) RETRIES=0 RD: RX_CONTROL=CONT!FN; !GO+INT ENABLE %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=SECTOR %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=TRACK P2_D=(DINT)&X'FF' POFF(P2); !WAIT FOR INT %IF RX_CONTROL<0 %START; !ERROR RETRIES=RETRIES+1 %IF RETRIES#RETC %THEN ->RD; !TRY AGAIN FAULT = REPORT FAULT %IF FAULT = 0 %THEN RETRIES=0 %AND -> RD %FINISH %END ! BUFFER DOES FILL/EMPTY %ROUTINE BUFFER(%INTEGER FN) RETRIES=0 WD: RX_CONTROL=CONT!FN; !GO+INT ENABLE %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=128; !WORD COUNT %WHILE RX_CONTROL&TRDONE=0 %CYCLE; %REPEAT RX_DBREG=PAR<<6+VADDR&K'77'; !BUS ADDRESS P2_D=(DINT)&X'FF' POFF(P2); !WAIT FOR INT %IF RX_CONTROL<0 %START; !ERROR RETRIES=RETRIES+1 %IF RETRIES#RETC %THEN ->WD FAULT = REPORT FAULT %IF FAULT = 0 %THEN RETRIES = 0 %AND ->WD %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !***** CODE STARTS HERE LINKIN(DINT) P2==PX MAPHWR(4); !MAP TO DICS REGS KID=GET ID LINKIN(SYS1); LINKIN(SYS2) %WHILE RX_CONTROL&K'40' = 0 %CYCLE; %REPEAT ! MAIN LOOP-WAIT FOR DISC REQUEST %CYCLE P_SERVICE=0 POFF(P) %IF P_A3&K'020000'#0 %START P_A3 = P_A3&K'017777' CONT=K'420'; !UNIT 3 SYS=2 %FINISHELSESTART CONT=K'400' SYS=1 %FINISH FAULT=0; ID=P_REPLY FN = P_A1 VADDR=P_A2 ! ! CHECK IF ACCESS TO RESEVED AREA ! %IF VADDR=0 %START BOT=0; FAULT=9 %ELSESTART %IF P_A3TOP %C %THEN FAULT=4 %AND ->FIN FAULT=MAPADDR(VADDR) ->FIN %IF FAULT#0 ! ! COMPUTE TRACK&SECTOR ! TRACK=P_A3//13 MAPIND=(P_A3-(TRACK*13))*2+1 ! ! DO DOUBLE TRANSFER ! %CYCLE I=1, 1, 2 SECTOR=SECMAP(MAPIND) %IF FN=READ %START; !READ SEQUENCE SEEK(READFN) BUFFER(EMPTYFN) %IF FAULT = 0 %ELSEIF FN=WRITE %START; !WRITE SEQUENCE BUFFER(FILLFN) SEEK(WRITEFN) %FINISH %EXIT %IF FAULT # 0 MAPIND=MAPIND+1; !NEXT SECTOR VADDR=VADDR+256; !NEXT ADDRESS ! PAR = PAR+4; ! THIS REALLY SHIFTS IT ! ALLWAYS DO NEXT BIT FOR NOW, 2 PROBLEMS, NEW SEG & > 32K ! %IF VADDR&K'17777'<512 %START PAR=MAP ABS(VADDR,0,10); !NEW SEG-RELEASE OLD ONE FAULT=MAPADDR(VADDR) ! %FINISH %EXITIF FAULT#0 %REPEAT PAR=MAP ABS(VADDR,0,10); !RELEASE USER SEG %FINISH ! !RETURN MESSAGE TO USER ! FIN: P_A1=FAULT P_SERVICE=ID P_REPLY = SYS1 PON(P) %REPEAT %ENDOFPROGRAM %INTEGER I, OLD %RECORD (PE) %NAME P2 %OWNINTEGER IN TURN OLD = IN TURN %CYCLE P2 == PA(IN TURN); IN TURN = (IN TURN+1)&QL %IF P2_SER # 0 %AND P2_LEN = LEN %START P = P2; ! COPY PA INTO P P2_SER = 0; ! SLOT NOW FREE QUEUED = QUEUED-1 %RESULT = 1 %FINISH %IF IN TURN = OLD %THENEXIT %REPEAT %RESULT = 0 %END %ENDOFPROGRAM %INTEGER I, OLD ø¨¨¨ ø((Ð ø((Ð ø¨¨P ¨¨¨@ p¨¨@ ø¨¨¨ ø((Ð ø((Ð P¨¨P ; RXO2 DEIMOS SYSTEM DUMPER ; DUMPS ALL OF STORE (64K WORDS) TO UNIT 1 ; STARTING AT SECTOR 1 OF TRACK 0. SECTORS INTERLEAVED. .ABSOLUTE .=1000 SECMAP: .BYTE 1,3,5,7,9.,11.,13.,15.,17.,19.,21.,23.,25. .BYTE 2,4,6,8.,10.,12.,14.,16.,18.,20.,22.,24.,26. CONTW: .WORD 421 ; R0 POINTS AT DEVICE ; R1 TRACK ; R2 SECTOR ; R3 STORE ADDR ; R4 ALSO USED. START: MOV #177170,R0 ;DEV ADDR CLR R1 CLR R2 CLR R3 ;TRACK,SECTOR+STORE ; LOOP STARTS HERE LOOP: BIT #40,(R0) ;READY? BEQ LOOP MOV CONTW,R4 MOV R4,(R0) ;UNIT+ADDR EXT+FILL BUFFER L1: TSTB (R0) ;WAIT FOR TRDONE BPL L1 MOV #128.,2(R0) ;WORD COUNT L2: TSTB (R0) ;WAIT FOR TRDONE BPL L2 MOV R3,2(R0) ;STORE ADDRESS L3: BIT #40,(R0) ;WAIT FOR DONE BEQ L3 ; NOW DO WRITE MOV CONTW,R4 BIS #4,R4 ;WRITE COMMAND MOV R4,(R0) L4: TSTB (R0) BPL L4 MOVB SECMAP(R2),2(R0) ;SECTOR L5: TSTB (R0) BPL L5 MOV R1,2(R0) ;TRACK L6: BIT #40,(R0) ;WAIT FOR DONE BEQ L6 ; UPDATE SECTOR,TRACK AND ADDRESS INC R2 ;SECTOR CMP R2,#26. ;END OF TRACK? BNE L7 CLR R2 ;YES INC R1 L7: ADD #256.,R3 BCS L8 ;END OF 32K JMP LOOP L8: BIT #10000,CONTW ;FINISHED? BEQ L9 HALT L9: CLR R3 BIS #10000,CONTW JMP LNG('DISC WRITE ERROR %STOP %FINISH %REPEAT %ENDOFPROGRAM ! FILE 'FEP_DQS12E' !************** !* DQS11E * !*DA:01.APR.80* !************** %CONTROL K'100001'; ! 'SYSTEM' PROGRAM AND ! TRUSTED PROG %RECORDFORMAT PARF(%INTEGER TYPE, ADDRESS, LEN) %EXTERNALROUTINE DQS11E(%RECORD (PARF) %NAME P) %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG) %SYSTEMINTEGERFNSPEC GETID %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %SYSTEMINTEGERFNSPEC MAP ABS(%INTEGER ADR, LEN, REQ ID) %RECORDFORMAT PF(%BYTEOL<0 %START PRINTSTRING('**** FORMAT ERROR **** %ELSE %START PRINTSTRING(' FORMAT COMPLETED. %FINISH %FINISH %ENDOFPROGRAM ! DISC UTILITY AND TEST PROGRAM !W.S.C. 16TH AUGUST 1976 !LAST UPDATED 31/8/76 10:40 !THE FOLLOWING TEST STATES CAN BE SELECTED ! 1-READ N BLOCKS AND LIST THEM ! 2-WRITE N BLOCKS WITH A GIVEN PATTERN ! 3-COMPARE N BLOCKS WITH A GIVEN PATTERN ! 4-BLOCK PATCHING FACILITY ! 5-FORMAT STATUS ALTERATION !THE PROGRAM REQUESTS THE TEST NUMBER THEN ASKS FOR !DATA AS REQUIRED.AT THE END OF EACH TEST THE USER CAN SELECT !ANOTHER TEST.TEST 0 TERMINATES THE PROGRAM. %CONTROL K'101011' %PERMROUTINESPEC SVC(%INTEGER EP,P1,P2) %BEGIN %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C %INTEGERARRAYNAME A2,%INTEGER A3) %RECORD(PF) P %CONSTBYTEINTEGERNAME ID=K'160030' %CONSTBYTEINTEGERARRAY DKID(0:3)=3,3,8,14 %INTEGER LOOP,TEST,STBLK,NBLKS,REP,I,UNIT,J,PATT,ERRCT,RECERR %SWITCH SW(0:5) %INTEGERARRAY DBLK1(0:255) %INTEGERARRAY DBLK2(0:255); !FOR FORMAT %ROUTINE OCTRD(%INTEGERNAME Z) %INTEGER Y Z=0 %WHILE NEXTSYMBOL=' ' %THEN SKIPSYMBOL LOOP:READSYMBOL(Y) Y=Y-'0' %IF 0>Y %OR Y>7 %THEN Y=0 Z=(Z<<3)!Y %IF NEXTSYMBOL#NL %THEN ->LOOP SKIPSYMBOL %END %ROUTINE DISCGO(%INTEGER BLOCK,DISC,%INTEGERARRAYNAME ADD,%C %INTEGER MODE) RECERR=0 %IF MODE&1=0 %START; !READS %CYCLE J=0,1,255 ADD(J)=0 %REPEAT %FINISH P_SERVICE=DKID(DISC) P_REPLY=ID P_A3=BLOCK %IF DISC=1 %THEN P_A3=P_A3!K'020000'; !RK05 UNIT 1 P_A2==ADD P_A1=MODE PONOFF(P) %WHILE P_A1#0 %CYCLE; !ERROR %IF P_A1>=10 %START RECERR=1; !RECOVERABLE ERROR(BAD SECTOR) %EXIT %FINISH PRINTSTRING('HANDLER ERROR ') WRITE(P_A1,2) NEWLINE;%CYCLE ;%REPEAT %REPEAT %END %ROUTINE BLK PROMPT('DISC=') READ(UNIT) PROMPT('START BLOCK(OCTAL)=') OCTRD(STBLK) PROMPT('NUMBER OF BLOCKS(OCTAL)=') OCTRD(NBLKS) PROMPT('LOOP?') %WHILE NEXTSYMBOL<'A' %OR NEXTSYMBOL>'Z' %THEN SKIPSYMBOL READSYMBOL(LOOP);SKIPSYMBOL %END %ROUTINE CHARP(%INTEGER X) %IF XK'176' %THEN PRINTSYMBOL('*') %C %ELSE PRINTSYMBOL(X) %END %ROUTINE OCTWRT(%INTEGER X) %INTEGER Y %CYCLE Y=15,-3,0 PRINTSYMBOL((X>>Y)&7+'0') %REPEAT %END %ROUTINE BYTWRT(%INTEGER X,B) %INTEGER Y,Z,S,F %IF B=0 %START Z=X&K'377';S=6;F=0 %FINISHELSESTART Z=X&K'177400' S=15;F=9 %FINISH %CYCLE Y=S,-3,F PRINTSYMBOL((Z>>Y)&7+'0') %REPEAT %END %ROUTINE PRBLK(%INTEGERARRAYNAME DBLK,%INTEGER N) %INTEGER K,J SELECT OUTPUT(1) PRINTSYMBOL(12) NEWLINES(2) PRINTSTRING('UNIT ') WRITE(UNIT,1) PRINTSTRING(' BLOCK ') OCTWRT(STBLK+I) NEWLINES(2) %CYCLE K=0,1,(N/ !F---FILE SYSTEM INTERROGATOR !W.S.CURRIE 4TH DEC 1976 !AMENDED TO HANDLE # FILES - GJB ! V006 !LAST UPDATED 15TH MAY 1977 18:50 ! THIS IS TO REPLACE THE EXISTING F.IT HAS THE !FOLLOWING FACILITIES:- ! A : LISTS ALL FILES IN THE CURRENT DIRECTORY ALONG ! WITH THE START BLOCK,PROTECT CODE AND NUMBER ! OF BLOCKS IN THE FILE. ! B FILENAME : GIVES DATA FOR SPECIFIC FILE AS IN A. ! C : GET CURRENT L VALUES ! D FILENAME : DELETE FILE,D ? LISTS ALL FILES AND ! REQUESTS Y TO DELETE ,N TO KEEP,UNLESS ANSWER ! TO AUTOMATIC REQUEST IS 'Y'. ! F : LISTS FILENAMES IN CURRENT DIRECTORY ! G FILENAME :SEARCH ALL DIRECTORIES FOR FILE ! L X.YY : ALTER CURRENT DIRECTORY TO DISC X, ! AND FILE SYSTEM YY(OCTAL).L CR RETURNS TO ! CURRENT LOGON. ! O : LISTS FILES IN CURRENT DIRECTORY IN ALPHABETICAL ORDER ! R : RENAME FILE,PROMPTS FOR OLD & NEW FILENAMES. ! S :STOP ! T FILENAME : TRANSFER FILE.PROMPTS FOR DESTINATION ! DISC.FSYS OR .TT OR .LP OR .LK ! U : LISTS ALL FILES FOR ALL USERS ! THE PROGRAM ASSUMES THE CURRENT LOGON FILE SYSTEM !ON DISC 0 ON ENTRY. A ? IN A FILE NAME MEANS DO THE COMMAND !TO ALL FILES STARTING WITH LETTERS UP TO THE ?. ! UNWANTED OUTPUT CAN BE INTERRUPTED BY SENDING A TO ! TASK 'FILE' USING THE INT MECHANISM. ! STACK=6000 STREAMS=0 %CONTROL K'101011' %BEGIN ! DATA AREAS %CONSTINTEGER NCMDS=12; !NO OF COMMANDS %CONSTINTEGERARRAY SERV(0:3)=3,3,8,14 %CONSTINTEGERARRAY FSERV(0:3)=4,4,9,15 %CONSTINTEGERARRAY DIRBLK(0:3)=97(2),K'1100'(2) %CONSTINTEGERARRAY COMMAND(1:NCMDS)=%C 'A','B','D','F','L','R','S','G','C','T','U','O' %CONSTINTEGER EXAMINE=0 %CONSTINTEGER GET NEXT=1 %CONSTINTEGER DESTROY=2 %CONSTINTEGER CREATE=3 %CONSTINTEGER APPEND=4 %CONSTINTEGER RENAME=5 %CONSTINTEGER LP SER=12 %CONSTINTEGER DREAD=0 %CONSTINTEGER DWRITE=1 %CONSTBYTEINTEGERNAME DF=K'160055' %CONSTBYTEINTEGERNAME INT=K'160060' %CONSTBYTEINTEGERNAME ID=K'160030' %RECORDFORMAT FILEF(%BYTEINTEGERARRAY NAME(0:5),%C %INTEGER FIRST,PR) %RECORD(FILEF)%ARRAY DIRECT(0:50) %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C %RECORD(FILEF)%NAME A2,%INTEGER A3) %RECORD(PF) P %RECORDFORMAT FILEA(%BYTEINTEGER UNIT,FSYS,%C %BYTEINTEGERARRAY NAME(0:5)) %RECORD(FILEA) PZ,PY %RECORDFORMAT P3F(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C %RECORD(FILEA)%NAME A2,A3) %RECORD(P3F) PQ %INTEGER DESTDISC,DESTFSYS,SBLK,DBLK %INTEGER OUTST,CURDISC,CURFSYS,COMM,I,J,K,BLKS,REP,QUEST %BYTEINTEGERARRAY SNAME,FNAME,F2NAME(0:5) %BYTEINTEGERARRAY DBUF(0:511) %SWITCH CMD(1:NCMDS) !******************************************************************* !******************************************************************** %ROUTINE OCTWRT(%INTEGER X) %INTEGER Y %CYCLE Y=15,-3,0 PRINTSYMBOL((X>>Y)&7+'0') %REPEAT SPACES(2) %END %ROUTINE GETFILE(%BYTEINTEGERARRAYNAME FILE,%INTEGER ST) %INTEGER I,J FILE(I)=' ' %FOR I=ST,1,5 %IF ST=0 %START SKIP SYMBOL %WHILE NEXT SYMBOL=' ' %IF NEXT SYMBOL='#' %THEN SKIP SYMBOL %AND J=1 %ELSE J=0 %FINISH %ELSE J=0 %CYCLE I=ST,1,5 %EXIT %IF NEXTSYMBOL=NL READSYMBOL(REP) FILE(I)=REP %IF REP='?' %THEN QUEST=1 %AND %EXIT %REPEAT SKIPSYMBOL FILE(0)=FILE(0)!K'200' %IF J=1 %END %INTEGERFN GETDISC(%INTEGERNAME DISC,FSYS) %INTEGER I,J,K READSYMBOL(I) I=I-'0' READSYMBOL(REP) READSYMBOL(J) READSYMBOL(K) SKIPSYMBOL J=((J-'0')*8)+K-'0' %IF I<0 %OR I>3 %OR REP#'.' %OR J<0 %OR J>63 %THEN %RESULT=-1 DISC=I FSYS=J %RESULT=0 %END %ROUTINE GETDIR %INTEGER BLOCK P_SERVICE=SERV(CURDISC) P_REPLY=ID P_A1=0; !READ ONLY P_A2==DIRECT(0) P_A3=DIRBLK(CURDISC)+CURFSYS %IF CURDISC=1 %THEN P_A3=P_A3!K'020000' PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DIRECTORY BLOCK READ ERROR') NEWLINE %STOP %FINISH %END %INTEGERFN DA(%INTEGER BLOCK,%BYTEINTEGERARRAYNAME BL,%C %INTEGER MODE,DRIVE) %RECORDFORMAT P6F(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C %BYTEINTEGERNAME A2,%INTEGER A3) %RECORD(P6F) %NAME PT PT==P PT_SERVICE=SERV(DRIVE) PT_REPLY=ID PT_A1=MODE PT_A2==BL(0) PT_A3=BLOCK %IF DRIVE=1 %THEN PT_A3=PT_A3!K'020000' PONOFF(PT) %RESULT=PT_A1 %END %INTEGERFN FSREQ(%INTEGER IND,REQ,OLD) %RECORDFORMAT P2F(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C %RECORD(FILEA) %NAME A2,%INTEGER A3) %RECORD(P2F) PX %INTEGER K PX_SERVICE=FSERV(CURDISC) PX_REPLY=ID PZ_UNIT=CURDISC PZ_FSYS=CURFSYS %CYCLE K=0,1,5 PZ_NAME(K)=DIRECT(IND)_NAME(K) %REPEAT PX_A1=REQ PX_A2==PZ PX_A3=OLD PONOFF(PX) %RESULT=PX_A1 %END %INTEGERFN DEST(%INTEGER IND,REQ,OLD) %INTEGER S1,S2,RES S1=CURDISC S2=CURFSYS CURFSYS=DESTFSYS CURDISC=DESTDISC RES=FSREQ(IND,REQ,OLD) CURDISC=S1 CURFSYS=S2 %RESULT=RES %END %ROUTINE PRINTFILE(%INTEGER IND) %INTEGER X SPACES(2) %IF DIRECT(IND)_NAME(0)>127 %THEN PRINTSYMBOL('#') %ELSE SPACE %CYCLE X=0,1,5 PRINTSYMBOL(DIRECT(IND)_NAME(X)) %REPEAT SPACES(2) %END %INTEGERFN NFILE %INTEGER X,Y Y=0 %CYCLE X=0,1,50 %IF DIRECT(X)_FIRST#0 %THEN Y=Y+1 %REPEAT %RESULT=Y %END %INTEGERFN PNFILE %INTEGER X X=NFILE WRITE(X,2) PRINTSTRING(' FILES') NEWLINE %RESULT=X %END %ROUTINE CURLOG %INTEGER X WRITE(CURDISC,2) PRINTSYMBOL('.') X=CURFSYS//8 PRINTSYMBOL(X+'0') PRINTSYMBOL(CURFSYS-(X*8)+'0') NEWLINE %END %INTEGERFN BLOKS(%INTEGER IND) %INTEGER LAST BLKS=1 LAST=DIRECT(IND)_FIRST %CYCLE LAST=FSREQ(IND,GET NEXT,LAST) %IF LAST=0 %THEN %EXIT %IF LAST=-1 %THEN PRINTSTRING(' CORRUPT') %AND %EXIT BLKS=BLKS+1 %REPEAT %RESULT=BLKS %END %INTEGERFN SEARCH(%INTEGER IND) %INTEGER I,J %RESULT=-1 %IF IND=51 %CYCLE I=IND,1,50 %IF DIRECT(I)_FIRST#0 %START %CYCLE J=0,1,5 %EXIT %IF FNAME(J)#DIRECT(I)_NAME(J) %REPEAT %IF FNAME(J)='?' %THEN %RESULT=I %RESULT=I %IF FNAME(J)='?'!K'200' %AND DIRECT(I)_NAME(J)&K'200'#0 %IF J=5 %START %IF FNAME(J)=DIRECT(I)_NAME(J) %THEN %RESULT=I %FINISH %FINISH %REPEAT %RESULT=-1; !NOT FOUND %END %ROUTINE BUFSEND %INTEGER X %RECORDFORMAT LP(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C %BYTEINTEGERNAME A2,%INTEGER A3) %RECORD(LP)%NAME PL PL==P PL_SERVICE=LP SER PL_REPLY=ID PL_A1=1 PL_A2==DBUF(0) %IF OUTST=2 %START %CYCLE X=0,1,511 %IF DBUF(X)=4 %START DBUF(X)=12; !CHANGE EOT TO NEWPAGE %EXIT %FINISH %REPEAT %FINISH %ELSE X=511 PL_A3=X+1 PONOFF(PL) %END %ROUTINE FILESOUT %INTEGER I,J,K NEWLINE K=0 %CYCLE J=0,1,11 %CYCLE I=0,1,4 REP=J*5+I %IF REP>50 %THEN %RETURN %IF DIRECT(REP)_FIRST#0 %AND INT#'A' %START PRINTFILE(REP) K=K+1 %IF K=5 %THEN NEWLINE %AND K=0 %FINISH %REPEAT %REPEAT %END !***************************************************************** !******************************************************************* !CODE STARTS HERE INIT: CURDISC=0 CURFSYS=DF GETDIR CMD(9): CURLOG COM: INT=0 QUEST=0 NEWLINE PROMPT('>') %WHILE NEXTSYMBOL=' ' %THEN SKIPSYMBOL READSYMBOL(COMM) %IF COMM=NL %THEN ->COM %ELSE READSYMBOL(REP) %IF 'A'<=REP<='Z' %OR '0'<=REP<='9' %OR REP='?' %START ! !IMPLIED FILE SEARCH ! %IF COMM='#' %START FNAME(0)=REP!K'200' GET FILE(FNAME,1) QUEST=1 %IF REP='?' %ELSE FNAME(0)=COMM FNAME(1)=REP %IF REP='?' %OR COMM='?' %THEN QUEST=1 GETFILE(FNAME,2) %FINISH J=SEARCH(0) %IF J<0 %THEN PRINTSTRING('NO FILE') %ELSE %START %WHILE J>=0 %CYCLE PRINTFILE(J) %EXIT %IF QUEST=0 NEWLINE J=SEARCH(J+1) %REPEAT %FINISH NEWLINE ->COM %FINISH !CHECK IF VALID COMMAND %CYCLE J=NCMDS,-1,1 %IF COMM=COMMAND(J) %THEN ->CMD(J) %REPEAT ERR: PRINTSTRING('?') NEWLINE ->COM !*** A :- PRINT ALL DATA IN CURRENT DIRECTORY CMD(1): ->COM %IF PNFILE=0 NEWLINES(2) PRINTSTRING(' NAME START CODE BLOCKS') NEWLINES(2) %CYCLE J=50,-1,0 %IF DIRECT(J)_FIRST#0 %AND INT#'A' %START PRINTFILE(J) OCTWRT(DIRECT(J)_FIRST) OCTWRT(DIRECT(J)_PR) OCTWRT(BLOKS(J)) NEWLINE %FINISH %REPEAT NEWLINE ->COM !*** B :- PRINT BLOCKS IN FILE CMD(2): PROMPT(' FILE? ') %IF REP=NL GETFILE(FNAME,0) J=SEARCH(0) %IF J<0 %THEN ->ERR %WHILE J>=0 %AND INT#'A' %CYCLE PRINTFILE(J) OCTWRT(BLOKS(J)) NEWLINE %EXIT %IF QUEST=0 J=SEARCH(J+1) %REPEAT ->COM !*** D :- DELETE FILE OR ALL FILES SELECTED CMD(3): PROMPT(' FILE? ')%IF REP=NL GETFILE(FNAME,0) J=SEARCH(0) %IF J<0 %THEN PRINTSTRING(' NO FILE') %AND ->COM %IF QUEST#0 %START PROMPT('AUTOMATIC?') %WHILE NEXTSYMBOL=' ' %THEN SKIPSYMBOL K=0 READ SYMBOL(I) %IF I='Y' %START READ SYMBOL(I) %IF I='E' %START READ SYMBOL(I) K=1 %IF I='S' %FINISH %FINISH READ SYMBOL(I) %WHILE I#NL ! !PRINT ALL FILES AND REQUEST DELETE OR NOT !Y=DELETE N=KEEP !UNLESS PROMPTING TURNED OFF. ! %WHILE J>=0 %AND INT#'A' %CYCLE PRINTFILE(J) %IF K=0 %START PROMPT(':') READSYMBOL(REP) SKIPSYMBOL %FINISH %ELSE REP='Y' %AND NEWLINE %IF REP='Y' %START %IF FSREQ(J,DESTROY,0)=-1 %START PRINTSTRING('FILE CORRUPT') NEWLINE %FINISH %FINISH J=SEARCH(J+1) %REPEAT %FINISH %ELSE %START PRINTFILE(J) %IF FSREQ(J,DESTROY,0)=-1 %START PRINTSTRING(' CORRUPT') %FINISH NEWLINE %FINISH GETDIR ->COM !*** F :- LIST FILE NAMES CMD(4): FILESOUT %IF PNFILE#0 ->COM !*** L :- ALTER CURRENT DISC AND FILE SYSTEM CMD(5): %->INIT %IF REP=NL ->ERR %IF GETDISC(CURDISC,CURFSYS)#0 GETDIR CURLOG ->COM !*** R :- RENAME,ASK FOR OLD & NEW FILES CMD(6): PROMPT('OLD FILE:') GETFILE(FNAME,0) PROMPT('NEW FILE:') GETFILE(F2NAME,0) PZ_UNIT=CURDISC PZ_FSYS=CURFSYS PY_UNIT=CURDISC PY_FSYS=CURFSYS %CYCLE I=0,1,5 PZ_NAME(I)=FNAME(I) PY_NAME(I)=F2NAME(I) %REPEAT PQ_SERVICE=FSERV(CURDISC) PQ_REPLY=ID PQ_A1=RENAME PQ_A2==PZ PQ_A3==PY PONOFF(PQ) %IF PQ_A1#0 %START NEWLINE PRINTSTRING('RENAME FAILS') NEWLINE %FINISH GETDIR ->COM !*** S :- STOP CMD(7): %STOP !*** G :- SEARCH ALL DIRECTORIES FOR FILE CMD(8): K=CURFSYS PROMPT(' FILE? ') %IF REP=NL GETFILE(FNAME,0) %CYCLE I=0,1,K'77' CURFSYS=I GETDIR J=SEARCH(0) %WHILE J>=0 %CYCLE PRINTFILE(J) PRINTSTRING(' IN ') OCTWRT(I) NEWLINE ->OUT %IF QUEST=0 %OR INT='A' J=SEARCH(J+1) %REPEAT %REPEAT OUT: NEWLINE CURFSYS=K GETDIR ->COM !*** T :TRANSFER A FILE CMD(10): PROMPT(' FILE? ') %IF REP=NL GETFILE(FNAME,0) K=SEARCH(0) %IF K<0 %THEN PRINTSTRING('NO FILE') %AND ->COM PROMPT('TO:') %IF NEXTSYMBOL='.' %START OUTST=-1 SKIPSYMBOL READSYMBOL(I) READSYMBOL(J) SKIPSYMBOL %IF I=J='T' %THEN OUTST=1 %ELSE %START %IF I='L' %AND J='K' %THEN OUTST=3 %IF I='L' %AND J='P' %THEN OUTST=2 %IF OUTST=-1 %THEN ->ERR %FINISH %FINISH %ELSE %START ->ERR %IF GETDISC(DESTDISC,DESTFSYS)#0 OUTST=0 %FINISH %WHILE K>=0 %CYCLE SBLK=DIRECT(K)_FIRST %IF OUTST =0 %START DBLK=DEST(K,DESTROY,0) DBLK=DEST(K,CREATE,0) ->TERR %IF DBLK=-1 %FINISH %CYCLE ->COM %IF INT='A' %AND OUTST#0 ->TERR %IF DA(SBLK,DBUF,DREAD,CURDISC)#0 %IF OUTST=0 %AND DA(DBLK,DBUF,DWRITE,DESTDISC)#0 %THEN ->TERR %IF OUTST=1 %START %CYCLE J=0,1,511 %EXIT %IF (DBUF(J)=4 %AND OUTST#3) %OR INT='A' PRINTSYMBOL(DBUF(J)) %REPEAT %FINISH %IF OUTST>=2 %THEN BUFSEND SBLK=FSREQ(K,GET NEXT,SBLK) %EXIT %IF SBLK=0 DBLK=DEST(K,APPEND,DBLK) %IF OUTST=0 %REPEAT R1: PRINTFILE(K) NEWLINE %EXIT %IF QUEST=0 K=SEARCH(K+1) %CONTINUE TERR: PRINTSTRING(' T FAILS ON ') ->R1 %REPEAT ->COM !*** U :- LIST ALL FILES OF ALL USERS CMD(11): K=CURFSYS %CYCLE I=0,1,K'77' %EXIT %IF INT='A' CURFSYS=I GETDIR J=NFILE %CONTINUE %IF J=0 NEWLINES(2) PRINTSTRING('USER ') PRINT SYMBOL(I>>3&7+'0'); PRINT SYMBOL(I&7+'0') PRINTSYMBOL(':') WRITE(J,2) PRINTSTRING(' FILES') NEWLINE FILESOUT %REPEAT ->COM !*** O :- LIST FILES IN ALPHABETICAL ORDER CMD(12): %IF PNFILE#0 %START REP=-1 QUEST=0 %CYCLE %CYCLE I=0,1,5 SNAME(I)=255 %REPEAT %CYCLE J=0,1,50 %IF DIRECT(J)_FIRST#0 %AND INT#'A' %START %CYCLE I=0,1,5 %EXIT %IF DIRECT(J)_NAME(I)>SNAME(I) %IF DIRECT(J)_NAME(I)COM %ENDOFPROGRAM %BEGIN %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG) %INTEGER I,J,K %RECORDFORMAT DL11F(%INTEGER RSR,RDR,TSR,TDR) %CONSTRECORD(DL11F)%NAME D=K'076500'; !SEG 3 MAPHWR(3) I=D_RDR PROMPT('SOURCE FILE?') READSYMBOL(K) SELECT OUTPUT(1) %CYCLE %WHILE D_RSR&K'200'=0 %CYCLE;%REPEAT I=D_RDR&X'FF' PRINTSYMBOL(I) D_TDR=I %STOP %IF I=4 %AND K='Y' %REPEAT %ENDOFPROGRAM ! FILE 'PUSHS' %CONTROL K'10000' %BEGIN %INTEGER I,J,K %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG) %PERMROUTINESPEC SVC(%INTEGER EP, R0, R1) %RECORDFORMAT DL11F(%INTEGER RSR, RDR, TSR, TDR) %CONSTRECORD (DL11F) %NAME D = K'076500'; ! SEG 3 MAPHWR(3) SVC(18, 0, 0); ! SET PRIO=0 SELECT INPUT(1) K=NEXTSYMBOL %CYCLE %WHILE D_TSR&K'200'=0 %CYCLE; %REPEAT READSYMBOL(I) D_TDR = I %STOP %IF I<0 %WHILE D_RSR&K'200'=0 %CYCLE; %REPEAT J = D_RDR&X'FF' %IF I # J %START PRINTSTRING("CHAR MISMATCH, EXP & ACT =") WRITE(I, 1); WRITE(J, 1); NEWLINE %FINISH %IF I&X'FF'=4 %AND K#0 %THEN %STOP %REPEAT %ENDOFPROGRAM F |Í Æe¬ûµ øÿÓn Æeüÿ õeýÿüÿ³Þ üÿ÷ ´ ÁEøÿÁe0 Æeúÿ]ì üÿW-üÿ üÿ@m @÷ Æ ¨@÷ ¶ úÿ5ö úÿ¶ø üÿW-üÿ üÿòú Þ@÷ `÷ j üÿ@m Añ%? A÷ : Æeøÿ üÿNa÷ JAõå0 úÿNa÷ ø øÿNa÷ î pA÷ Þ úÿÀå0 @møÿÀå0 úÿ¼ Æeüÿü2 àóýg8 ôý§: úýöý0`öýV< lÌý° øý2> üAð% øýn@ Ù %B (B÷ ,B÷ ø Æeüÿ òýüÿ 5`üÿÌ` ~Bõ% Ù In Æeôÿ à÷ÿs Îýêýi Ìýëýd ÿÿôÿW-ôÿ ôÿÂ`° úýìýò êýúÿ 5`úÿ öÿNa Æeøÿ Îýüÿ<ª ÌýúÿM¬ ÖýÌýr® ØýÎýh° øÿ·² üÿÎýÒ´ úÿÌý㶠Æeüÿ2À ÿÿüÿW-üÿ üÿB` úýÃE XüíÐ Æeúÿ¼Ø úÿmÜ ÿÿüÿW-üÿ2 ðý¸ä Æeüÿuî üÿõò a÷ X lD÷ H ºý¶ú Æeüÿ? ÌýWtýÿu ªDÁe0 àÂe0 ÎD÷ æ Æeüÿá üÿN" EÁ%ÿÿ a÷ ¢ Âýþ( ûý, Æeúÿ DEõ%3 üÿW-üÿ2 üÿø: ÿÿúÿW-úÿ úÿÖ> úÿB`C `³¬úý²ýð@ @`ð¥? ÆEð¥¿ÿ²ý úÿÂ` hú(F îEõ% úÿÂ`°¬úý²ý Æeúÿ òýúÿ 5`úÿæd XFð% ÿÿüÿW-üÿÿ üÿóp @`𥠬ûót Æeøÿ ¼F÷ ø ÿÿúÿW-úÿ ÿÿüÿW-üÿ Amüÿp úFÁ%2 $Gõ% Îýhº -àÀE Ìýð¼ nú»¾ $ýþÆ 0à¡Î ¾ý\Ð \G÷ X a÷ Æ gÔ jG÷ ô Á% ÷ Ú ø ÊýNa÷ Ú ÚØ ÀýNa÷ È GW-ÀýA W-ÀýZ W-Àý0 W-Àý9 ¾Gõ%# ÀýÀU ²ý½æ ²ýNaæ àGõ%? ¾ýãê Êý²ý4î Àý³ý7ð üGõ%? ²ýNaæ @øÄô ÆýÃø Bû»þ JH÷ j ð ^H÷ V ð ÆýW-Æý a5,F a÷ $ È"  H÷ ¬þè&  þH> a÷ þ ÆýÀF âöÇP 0I÷ 6I÷ ~ >Iõ% a÷ à ²ýNa& ÆýÄv I÷ * ¨Iõ% a÷ v ²ýNa& ÆýĤ a÷ è a÷ @ ðI÷ n Äý«® ÈýNa÷ P Jõ%Y ÈýNa÷ > Jõ%E ÈýNa÷ , 2Jõ%S Äýlº @Jõ% ÈýNa÷ a÷ ¸ ÀýNa÷ Ü J÷ Ì Àý÷ & Jõ%Y þ÷Á%ÿÿ ¸J÷ ü °ø¬ì Â÷Á%ÿÿ a÷ Ð ôJ÷ À Âö¼ø Tüèú ÎýNaæ ÌýNa7 bý°. <ùþ2 a÷ æ ²ýNa& a÷ Ð ¬ýNa& ÎýêýxT ÌýëýsV ÎýâýtX ÌýãýoZ ÿÿÈýW-Èý Èýj\ Èý@a0 ²ýìýå^ ¬ýäý°` ÚýÁd êýÞýuaÞýcj âýàýuaàý]l ÚýNa Ù %n êK÷ Ê a÷ Ì øK÷ ¼ ¾õ¼z Pûç| L÷ ÌýÄý ²ýNa& ÿÿÈýW-Èý? Èýc² ÈýÌýG´ tõ»¶ Æýĸ &÷»¼ a÷ Z  ó!À rL÷ B ÄýÌýïÒ ªúèÖ ªLõ% a÷ t ²ýNa& ÄýÆò a÷ æ rú@ô a÷ D ìL÷ r ÿÿÐýÜú üL÷ R ÈýNa÷ T ÆýNa÷ J M÷ : Mu-ÆýÈý W-ÆýT 0Mõ%L FMõ%L \Mõ%ÿÿÐý ØýNaæ ÖýNa7 þÔý} Òýt ÆMÁ%ÿÿ{ ÌMߥA vùÝ* ¬ûNa& ¬ûNaæ ÿÿÆýW-Æýÿ ÆýÊ2 Æý@a𥠬ûÁE `Nõ% ´÷d< Ôýä> àô®H ¦N÷ Äþ°P a÷ ø ´þ°X ~øèZ ÌýÄý³t ÿÿÈýW-Èý? Èý v îNߥA ÈýÌý ¾ò¼| Æý-~ a÷ ¨ týÿÀEøÿÀe0 ÈýÀEøÿÀe0 a÷ b bO÷ R ÿÿÀýc® ¾ý*° ÿÿÈýW-Èý Èýg´ Èý@að ÿÿÆýW-Æý2 ÆýÞº ÿÿÈýW-Èý Èýñ¾ Èý@aA ÆýWp ÈýB`2¬¸ýúý$ ÈýC`3¬¸ýúý ÿÿÄýW-Äý ÄýâÄ Äý@aA ÆýWp ÄýB`° úý¸ý`Æ ÆýÀýSÊ JPõ%ÿÿÀý ,ó±Ø ZPõ% ÿÿÀý`à úþ®ä .ñ»æ P÷ $ ¼öèì øÿ÷ àÈ Î àÈ ÷ àÈ 1ð àÈ Î àÈ Î ÷ ²þ À~Á<À À~Áÿÿÿÿÿÿ DIRECTORY BLOCK READ ERROR FILES CORRUPT > ¨ NO FILE ?! NAME START CODE BLOCKS FILE? FILE? NO FILE AUTOMATIC? FILE CORRUPT CORRUPT OLD FILE: NEW FILE: RENAME FAILS FILE? IN FILE? NO FILE T FAILS ON USER FILES8 EDIT²Ä Æeȱµ ÆeþÿRÌ N`÷ b Æeþÿ=ä ¢@ð% ª@ð%` îÿ´ú Î@ô% îÿÂåX ,îÿ0 ,îÿ9 lîÿt äþï$ ÆeþÿH( ô%ÿÿ: ÄþÂ2 ¤Að%( ¤þp6 Æeþÿ ÆeüÿÞF êA4-B @`ð¥ 4B4-8 ') %CYCLE J=0,1,7 OCTWRT(DBLK((K*8)+J)) SPACE %REPEAT SPACE %CYCLE J=0,1,7 CHARP(DBLK((K*8)+J)&K'377') CHARP((DBLK((K*8)+J)&K'177400')>>8) %REPEAT NEWLINE %REPEAT SELECT OUTPUT(0) %END !********************************************************* SVC(13,24,0) PRMPT: PROMPT('TEST NUMBER=') READ(TEST) ->SW(TEST) !************************************************************* SW(0): !END OF PROGRAM REQUEST %STOP !************************************************************** SW(1): !READ N BLOCKS AND LIST THEM. PROMPT('LIST?') %WHILE NEXTSYMBOL<'A' %OR NEXTSYMBOL>'Z' %THEN SKIPSYMBOL READSYMBOL(REP) SKIPSYMBOL L1:%CYCLE I=0,1,NBLKS-1 DISCGO(STBLK+I,UNIT,DBLK1,0) %IF RECERR=0 %START %IF REP='Y' %THEN PRBLK(DBLK1,256) %FINISH %REPEAT %IF LOOP='Y' %THEN ->L1 OKOUT: NEWLINE PRINTSTRING('TEST COMPLETED') NEWLINE ->PRMPT !************************************************************* SW(2): !WRITE N BLOCKS WITH PATTERN. PROMPT('OCTAL PATTERN=') OCTRD(PATT) %CYCLE I=0,1,255 DBLK1(I)=PATT %REPEAT L2:%CYCLE I=0,1,NBLKS-1 DISCGO(STBLK+I,UNIT,DBLK1,1) %REPEAT %IF LOOP='Y' %THEN ->L2 ->OKOUT !************************************************************ SW(3): !COMPARE N BLOCKS WITH PATTERN. ERRCT=0 PROMPT('OCTAL PATTERN=') OCTRD(PATT) L3:%CYCLE I=0,1,NBLKS-1 DISCGO(STBLK+I,UNIT,DBLK1,0) %IF RECERR=0 %START %CYCLE J=0,1,255 %IF DBLK1(J)#PATT %START ERRCT=ERRCT+1 PRINTSTRING('COMPARE ERROR ') PRINTSTRING('BLK ') OCTWRT(STBLK+I);SPACE OCTWRT(PATT) PRINTSTRING(' IS ') OCTWRT(DBLK1(J)) PRINTSTRING(' AT ') OCTWRT(J) NEWLINE %IF ERRCT=3 %START; !INLY 3 ERRORS PER BLOCK REPORTED ERRCT=0 %EXIT %FINISH %FINISH %REPEAT %FINISH %REPEAT %IF LOOP='Y' %THEN ->L3 ->OKOUT !************************************************************** SW(4): !PATCH DISC BLOCK. DISCGO(STBLK,UNIT,DBLK1,0) %IF RECERR#0 %START PRINTSTRING('BAD SECTOR-CANNOT PATCH') NEWLINE ->OKOUT %FINISH WDOFF:PROMPT('WORD OFFSET=') OCTRD(NBLKS) %IF NBLKS>255 %THEN ->CHECK OCTWRT(DBLK1(NBLKS)); !PRINT OLD NEWLINE OCTRD(DBLK1(NBLKS)); !GET NEW ->WDOFF CHECK:PROMPT('NEW BLOCK LIST?') %WHILE NEXTSYMBOL<'A' %OR NEXTSYMBOL>'Z' %THEN SKIPSYMBOL READSYMBOL(REP);SKIPSYMBOL %IF REP='Y' %THEN PRBLK(DBLK1,256) PROMPT('ARE YOU SURE??') %WHILE NEXTSYMBOL<'A' %OR NEXTSYMBOL>'Z' %THEN SKIPSYMBOL READSYMBOL(REP);SKIPSYMBOL %IF REP ='Y' %START DISC T ¾À Æeðÿµ öÿNa÷ 0@õ% öÿÀE ðÿc" öÿ÷ P øÿ÷ * À@À<À À@Àÿÿÿÿÿÿ !************** !* BVT1S * !*DA:09.APR.80* !************** %CONTROL K'100001'; ! 'SYSTEM' PROGRAM (FAST ROUTINE ENTRY/EXIT) %PERMROUTINESPEC SVC(%INTEGER EP, P1, P2) %BEGIN %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEGS) %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %C %INTEGER A1, A2, A3) %RECORDFORMAT TTF(%INTEGER KBS, KBD, TTS, TTD) %RECORDFORMAT BUFF(%INTEGER PT, LAST, %BYTEINTEGERARRAYNAME B) %RECORDFORMAT BUFFX(%INTEGER PT, LAST, ARRAYPT) %CONSTRECORD (BUFFX) %NAME NULL = 0 %CONSTINTEGER RUBOUT=K'177' %CONSTINTEGER CAN=24 %CONSTINTEGER CR=13 %CONSTINTEGER BELL=7 %CONSTINTEGER ESC=K'33' %CONSTINTEGER SI=K'17'; ! SHIFT INTO LOWER MODE (CTRL O) %CONSTINTEGER SO=K'16'; ! SHIFT OUT (CTRL N) %CONSTINTEGER DLE=K'20'; ! (CTRL P) %CONSTINTEGER EOT = K'04'; ! EOF (CTRL D) %CONSTINTEGER DC1=K'21'; ! CANCEL OUTPUT (CTRL Q) %CONSTINTEGER TAB = 9; ! TAB (IMPLEMENTED AS 3 SPACES) %OWNRECORD (TTF) %NAME TT=K'137560' %OWNINTEGER KBINT=-2 %OWNINTEGER TTINT=-1 %OWNINTEGER TTSER=1; ! ??? %OWNINTEGER CLIID=2 %OWNINTEGER TT STATUS=0, UPPER=32, TT IDLE=0, E PT=0, EFPT=0 %RECORD (PF) P2 %OWNRECORD (PF) %NAME P %CONSTINTEGER NO OF SPECS = 6 %OWNBYTEINTEGERARRAY SPECS(0:NO OF SPECS) = RUBOUT, CAN, ESC, CR, SI, SO, TAB %INTEGER CHAR, I, IN MODE, E LAST %INTEGER OUTID, SEG, CLI FLAG, CID, CADR %OWNRECORD (BUFF) OUT, INH %RECORD (BUFFX) %NAME BUFX, INX %RECORDFORMAT HF(%RECORD (HF) %NAME H, %RECORD (PF) P) %RECORDFORMAT QF(%RECORD (HF) %NAME H) %OWNRECORD (HF) %ARRAY HA(0:15) %OWNRECORD (HF) %NAME H %OWNRECORD (QF) HI, HO %OWNRECORD (QF) FREE %OWNINTEGER FIRST, LAST, CURR %OWNBYTEINTEGERARRAY BUFFER(0:255) %OWNBYTEINTEGERARRAY ECHOB(1:40) %SWITCH INS(0:NO OF SPECS), STATE(0:7) %ROUTINESPEC DRIVE TT(%INTEGER CHAR) %ROUTINESPEC ECHO(%INTEGER X) %ROUTINESPEC ECHO BELL %ROUTINESPEC TRANSFER INPUT %ROUTINESPEC OUTPUT REPLY %ROUTINESPEC PLANT(%INTEGER N) !! %CONSTBYTEINTEGERARRAY CANM(0:3)= 3, '#', CR, NL !! %CONSTBYTEINTEGERARRAY CLIM(0:3)= 3, '<', 8, '>' %CONSTINTEGER MYSEG=4, MSA=K'100000' %CONSTINTEGER MYISEG=3, MISA=K'060000' MAPHWR(5); ! MAP REGS TO SEG 5 LINKIN(TTSER); LINKIN(KBINT); LINKIN(TTINT) TT_KBS=K'100' BUFX==OUT INX==INH %CYCLE I = 15, -1, 0 PUSH(FREE, HA(I)) %REPEAT %CYCLE %IF OUTID=0 %AND %NOT HO_H == NULL %START H == POP(HO); PUSH(FREE, H) P == H_P %ELSE P == P2 P_SERVICE = 0 POFF(P) %FINISH %IF P_SERVICE=KBINT&X'FF' %START CHAR=TT_KBD&127; ! STRIP PARITY BIT %CYCLE I=NO OF SPECS, -1, 0 ->INS(I) %IF CHAR=SPECS(I) %REPEAT !! NORMAL CHAR %IF CHAR>='A'+K'40' %AND CHAR<='Z'+K'40' %THENC CHAR=CHAR-UPPER; ! TURN TO UPPER PLANT(CHAR) %CONTINUE INS(0): ! RUBOUT %IF LAST#CURR %START LAST = (LAST-1)&255 ECHO(8); ECHO(' '); ECHO(8) %ELSE ECHO BELL %CONTINUE INS(1): ! CANCEL %IF LAST#CURR %START LAST = CURR ECHO('#'); ECHO(CR); ECHO(NL); E LAST=E PT %ELSE ECHO BELL %CONTINUE INS(2): ! ESCAPE - GO TO CLI CLI FLAG = 1 LAST = 0; CURR = 0; FIRST = 0 INS2: ECHO('$'); ECHO BELL %CONTINUE INS(4): ! SHIFT IN UPPER = 0; %CONTINUE INS(5): ! SHIFT OUT UPPER = 32; %CONTINUE INS(6): ! TAB PLANT(' '); PLANT(' '); PLANT(' '); %CONTINUE INS(3): ! CR PLANT(NL); CURR = LAST TRANSFER INPUT E LAST=E PT; ! ALLOW IT TO DO OUTPUT NOW %ELSE %IF P_SERVICE=TT INT&X'FF' %START ->STATE(TT STATUS) DO OUT: STATE(5): ! GOING IDLE TT STATUS=0 %IF E PT>0 %THEN TT STATUS=2 %ELSESTART %IF OUT_LAST#0 %THEN TT STATUS=1 %FINISH ->STATE(TT STATUS) STATE(1): ! NORMAL OP CHAR=OUT_B(OUT_PT); OUT_PT=OUT_PT+1 %IF OUT_PT>=OUT_LAST %THEN TT STATUS=5 %AND OUTPUT REPLY DRIVE TT(CHAR) STATE(0): %CONTINUE STATE(2): ! ECHO OP %IF EFPTDO OUT %FINISH %FINISH %IF EFPT=E PT %THEN E PT=0 %AND EFPT=0 %CONTINUE STATE(3): ! NORMAL CR STATE(4): ! ECHO CR STATE(7): ! END OF LINE - NEWLINE TT STATUS=5 DRIVE TT(NL+128) %CONTINUE STATE(6): ! IN ECHO LINE %CYCLE; %REPEAT %ELSE %IF P_SERVICE=TT SER %START; ! USER REQUEST %IF P_A1=1 %START; ! OUTPUT REQUEST %IF OUTID#0 %START H == POP(FREE) %IF H == NULL %START REJ: P_SERVICE= P_REPLY; P_REPLY = TT SER P_A1 = 1; PON(P) %CONTINUE %FINISH H_P = P; ! COPY P INTO SAFE PLACE PUSH(HO, H); ! AND QUEUE IT %CONTINUE %FINISH OUTID=P_REPLY SEG=P_A2>>13; ! SEG NO OF BUFFER MAP VIRT(OUTID, SEG, MY SEG) BUFX_ARRAYPT=MSA+(P_A2&K'17777') OUT_PT=0; OUT_LAST=P_A3; ! LENGTH %IF OUT_LAST=0 %THEN OUTPUT REPLY %ELSESTART ->DO OUT %IF TT STATUS=0; ! TT IDLE %FINISH %ELSE !! INPUT REQUEST %IF P_A1 # 0 %START CID = P_REPLY; CADR = P_A2 %CONTINUE %IF P_A3 # 0; ! JUST READ FROM CLI %FINISH H == POP(FREE) -> REJ %IF H == NULL H_P = P; ! COPY P INTO A SAFE PLACE PUSH(HI, H); ! AND Q IT %IF P_A1#0 %AND FIRST=LAST %THEN -> INS2 %IF FIRST#CURR %START; ! NON EMPTY LINE TRANSFER INPUT %FINISH %FINISH %FINISH %REPEAT %ROUTINE DRIVE TT(%INTEGER CHAR) %IF CHAR=NL %START TT STATUS=TT STATUS+2 CHAR=CR %FINISH TT_TTD=CHAR TT_TTS=TT_TTS!K'100'; ! INTS ON %END %ROUTINE ECHO(%INTEGER X) %RETURN %IF E PT>40 E PT=E PT+1; ECHOB(E PT)=X %IF TT STATUS=0 %OR TT STATUS=6 %START TT STATUS=2 DRIVE TT(X) EFPT=1 %FINISH %END %ROUTINE ECHO BELL ECHO(BELL); E LAST=E PT %END %ROUTINE PLANT(%INTEGER CHAR) BUFFER(LAST) = CHAR LAST = (LAST+1)&255 ECHO(CHAR) %END %ROUTINE TRANSFER INPUT %INTEGER SEG, I, ID, ADR, N %IF CLI FLAG # 0 %START; ! PREEMPTED BY CLI ID = CID; ADR = C ADR; CLI FLAG = 0 %ELSE %IF HI_H == NULL %THEN %RETURN H == POP(HI); PUSH(FREE, H) ID = H_P_REPLY; ADR = H_P_A2 %FINISH %IF ID#0 %START SEG=ADR>>13 MAP VIRT(ID, SEG, MYISEG) INX_ARRAY PT=MISA+(ADR&K'17777') %CYCLE I = 0, 1, 80 N = BUFFER(FIRST) INH_B(I) = N FIRST = (FIRST+1)&255 %EXIT %IF N = NL %REPEAT P_SERVICE=ID; P_REPLY=TTSER P_A1=I+1 PON(P) MAP VIRT(0, -1, MYISEG) %FINISH %END %ROUTINE OUTPUT REPLY MAP VIRT(0, -1, MYSEG) P_SERVICE=OUTID; P_REPLY=TTSER P_A1=0 PON(P) OUTID=0; OUT_LAST = 0 %END %ENDOFPROGRAM .END @`Pø@ BSPS VSN006a.§ !********************** !* NSIWS/NSIWY * !* DATE: 11.APR.80 * !********************* %CONSTSTRING (7) VSN = "VSN001C" !! STACK = 400, STREAMS = 3 !! NOTE: FOR VERSIONS THAT ARE RUN OUT OF A 2900 FEP SYSTEM, !! MESSAGES FROM THE NETWORK SHOULD BE ENABLED - SEE !! THE COMMENT AT 'MESSAGES ENABLED' %CONTROL K'100001' !STACK=400, STREAMS=3 %RECORDFORMAT XF(%BYTEINTEGER UNIT,FSYS,%BYTEINTEGERARRAY FNAME(0:5)) %EXTERNALPREDICATESPEC READ FNAME(%RECORD(XF)%NAME FILE) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %BEGIN %%RECORDFORMAT ITPF(%BYTEINTEGER CNSL,HB1,HB2,LEN, %C %BYTEINTEGERARRAY DATA(0:127)) %RECORDFORMAT RJEF(%BYTEINTEGERARRAY DATA(0:239)) %RECORDFORMAT NSI1F(%BYTEINTEGER FN,SUFL,ST,SS,FLAG,UFLAG, %C %RECORD(ITPF) ITP) %RECORDFORMAT NSI2F(%BYTEINTEGER FN,SUFL,ST,SS,FLAG,UFLAG, %C %RECORD(RJEF) RJE) %RECORDFORMAT MEF(%RECORD(MEF)%NAME LINK,%BYTEINTEGER LEN,TYPE, %C %RECORD(NSI1F) NSL) %RECORDFORMAT ME2F(%RECORD(ME2F)%NAME LINK,%BYTEINTEGER LEN,TYPE, %C %RECORD(NSI2F) NSL) %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,FN,PORT, %C %RECORD(MEF)%NAME MES,%BYTEINTEGER LEN,S1) %RECORDFORMAT P2F(%BYTEINTEGER SERVICE,REPLY,FN,PORT,%RECORD(ME2F)%NAME MES, %C %BYTEINTEGER LEN,S1) %RECORDFORMAT P3F(%BYTEINTEGER SERVICE,REPLY,FN,PORT,FACILITY,FLAG,NODE,TERM) %RECORD(PF) P; %RECORD(P2F)%NAME P2; %RECORD(P3F)%NAME P3 %RECORD(RJEF)%NAME BLOCK %RECORD(ITPF)%NAME FRAME %CONSTRECORD(MEF)%NAME NULL=0 %CONSTINTEGER TT=0,LO=1,CR=2,LP=3,PP=6,BT=7 %OWNINTEGER NODE, TERM, STRM %RECORDFORMAT HOSTF(%INTEGER NUMBER, %C %INTEGERARRAY PORT(CR:LP),STATUS(LO:LP), %C %INTEGER CR COUNT,CR K,LP COUNT,LP K, NODE) %RECORDFORMAT STRDF(%INTEGER A,B,C,D,%RECORD(XF) FILE,%INTEGER E,F,G,H) %RECORDFORMAT STRPF(%RECORD(STRDF)%NAME STRD) %RECORD(STRDF)%NAME STRD %RECORDFORMAT D1F(%INTEGER X); %RECORD(D1F) D1 %RECORDFORMAT D2F(%RECORD(STRPF)%NAME X); %RECORD(D2F)%NAME D2 %RECORD(XF)%NAME FILE %RECORD(XF) LP BASE FILE, CR FILE %OWNINTEGER MAX HOST=2 %RECORD(HOSTF) HOST %CONSTBYTEINTEGERARRAY SPOOL BASE(0:5)='V','L','P','0','0','0' %CONSTBYTEINTEGERARRAY KILL(0:4)=4,'K','I','L','L' %CONSTBYTEINTEGERARRAY STATUS(0:6)=6,'S','T','A','T','U','S' %CONSTBYTEINTEGERARRAY INT(0:3)=3,'I','N','T' %CONSTBYTEINTEGERARRAY FILEN(0:4)=4,'F','I','L','E' %CONSTBYTEINTEGERARRAY PRINTER(0:2)=2,'L','P' %CONSTBYTEINTEGERARRAY FEP(0:2) = 2, 'F', 'E' %CONSTBYTEINTEGERARRAY EMAS NAME(0:5)=4,'E','M','A','S',0 %CONSTBYTEINTEGERARRAY DO ENABLE(0:6) = 6, 'E', 'N', 'A','B','L','E' %CONSTBYTEINTEGERARRAY E2970 NAME(0:5)=4,'2','9','7','2',0 %CONSTBYTEINTEGERARRAY INFO NAME(0:5) = 4, 'I','N','F','O',0 %CONSTBYTEINTEGERARRAY E2980 NAME(0:5) = 4,'2','9','8','0', 0 %CONSTINTEGER EMAS NUMBER=34, E2970 NUMBER=72, INFO NUMBER=156 %CONSTINTEGER E2980T = 80 %BYTEINTEGERARRAYNAME BUFF %CONSTBYTEINTEGERNAME ID=K'160030', GATE INT=K'100060' %OWNINTEGER SETBFLAG, BINFLAG %CONSTINTEGER SET PR = 13; ! PAPER TAPE READER STREAM %CONSTINTEGER MAX COM = 5 %SWITCH SW(0:MAX COM) %CONSTSTRING (3) %ARRAY COMS(0:MAX COM) = ' ', 'TT', 'OP', 'CR', 'LP', 'SM' %OWNSTRING (3) NEW = ' ' %OWNBYTEINTEGERARRAY LINE(0:119) %OWNINTEGER TT PORT=-1 %OWNINTEGER LPTR,GOOD TEXT,GAH CT,TT HOST,TT STATE,LINE LENGTH,I,J %OWNINTEGER NO OF FILES,GARBAGE,CR TIMER,OP STRM %CONSTINTEGER GATE SER=16, BUFFER MANAGER=17, TT SER=19 %CONSTINTEGER RD=0, ECHO OFF=10 %CONSTINTEGER REQUEST BUFFER=0, RELEASE BUFFER=1 %CONSTINTEGER ENABLE FACILITY=1, DISABLE FACILITY=2, CALL REPLY=3 %CONSTINTEGER ENABLE INPUT=4, PUT OUTDEIMOS VSN 8.5F 24.MAR.80 (LSI 11 23 VERSION (DUV11)) 3400 DVRUBY N 0 SUP28 60002 0 PERM1Y 60006 0 BVT1Y 60012 150 RXO22Y 60016 300 FSLSIY 60022 300 LOAD6Y 60026 300 MOTH6Y 60032 50 SUPRþß Æe ÿµ ¦ÿ¨ÿua¨ÿu ¨ÿ¤ÿõ ÔÿÊÿuaÊÿ5 Õÿ1¤ a÷ ò u a÷ Ü u a÷ Æ u a÷ ° u Àÿ²Ô INTEGER SER, REPLY, %INTEGER A1, A2, A3) %RECORDFORMAT DQS11F(%INTEGER MCSR, TCSR, RSR, RCR, TWCR, TCAR, %C RWCR, RCAR) %OWNRECORD (DQS11F) %NAME DQS = 1; ! SET UP BY PROT ON INITIALISE %RECORDFORMAT PAR2F(%INTEGER TYPE, %RECORD (DQS11F) %NAME ADDRESS,LEN) %RECORD (PAR2F) %NAME P2 %CONSTINTEGER INITIALISE = 0 %CONSTINTEGER LINE INPUT = 1 %CONSTINTEGER LINE OUTPUT = 2 %CONSTINTEGER INPUT HERE = 3 %CONSTINTEGER OUTPUT DONE = 4 %CONSTINTEGER MODEM STATUS = 5 %CONSTINTEGER TXGO = K'111' %CONSTINTEGER RXGO = K'111' %OWNINTEGER TX REPLY, RX REPLY %ROUTINESPEC OCTAL(%INTEGER N) %SWITCH TYPESW(INITIALISE:MODEM STATUS) %OWNINTEGER TYPE, F, CAD, OSEG, I, EXT BITS %OWNINTEGER PAR, MID, PAD %OWNINTEGERARRAY RADDR(0:7) -> TYPE SW(P_TYPE) TYPE SW(INITIALISE): MID = GET ID MAPHWR(3) P2 == P DQS == P2_ADDRESS DQS_MCSR = K'40003'; ! DON'T TRANSFER THE CRC DQS_RCR = K'10'; ! ENABLE RECEIVER DQS_TCSR = K'10'; ! ENABLE TRANSMITTER %CYCLE I = 1, 1, 7; ! FIND ABSOLUTE ADDRESSES RADDR(I) = MAP ABS(I<<13, 256, MID); ! MY ADDRESSES F = MAP ABS(I<<13, 0, MID); ! AND OFF AGAIN %REPEAT RX REPLY = 0; TX REPLY = 0 %RETURN TYPE SW(OUTPUT DONE): ! TRANSMITTER TYPE = LINE OUTPUT %IF DQS_TCSR < 0 %OR TXREPLY = 0 %START !! TRANSMITTER ERROR PRINTSTRING('TX ERROR P_LEN = 1 %ELSE P_LEN = 0 %FINISH P_TYPE = LINE OUTPUT TXREPLY = 0 %RETURN TYPE SW(INPUT HERE): !! RECEIVER INTERRUPT %IF DQS_RSR&K'34067' # 0 %OR RX REPLY = 0 %START F = -2; ! FRAME ERROR %IF DQS_RSR&K'20' # 0 %THEN F = -3; ! SILO FULL FLT: DQS_RCR = 0; ! CLEAR DOWN DQS_RCR = K'10'; ! AND UP AGAIN %ELSE %IF DQS_RSR&K'1000' # 0 %THEN F = -1 %AND -> FLT ! WC OVERFLOW F = DQS_RCAR-CAD-2 ! NUMBER OF BYTES TRANS %IF DQS_RSR&K'074000' # 0 %THEN F = F-1 %IF F> 252 %START PRINTSTRING("DQS NASTY:") OCTAL(DQS_RCAR); SPACE; OCTAL(CAD); SPACE; OCTAL(F);NEWLINE %FINISH %FINISH P_TYPE = LINE INPUT P_ADDRESS = PAD; ! PASS BLOCK ADDRESS BACK P_LEN = F RX REPLY = 0 %RETURN TYPE SW(LINE INPUT): !! USER CALL !! READ REQUEST %IF RX REPLY # 0 %THEN -> ABORT RXREPLY = MID PAD = P_ADDRESS ! PAR = MAP ABS(PAD, P_LEN, RXREPLY) PAR = RADDR(PAD>>13) %IF PAR = 0 %THEN -> ABORT PAR = PAR+(PAD&K'17700')>>6; ! ENSURE ACTUAL BLOCK EXT BITS = (PAR&K'176000')>>6 CAD = PAR << 6+PAD&K'77' DQS_RCAR = CAD DQS_RWCR =- (P_LEN >> 1) DQS_RCR = RXGO!EXT BITS %RETURN TYPE SW(LINE OUTPUT): !! OUTPUT REQUEST %IF TX REPLY # 0 %THEN -> ABORT TX REPLY = MID OSEG = P_ADDRESS ! PAR = MAP ABS(OSEG, P_LEN, TX REPLY) PAR = RADDR(OSEG>>13) %IF PAR = 0 %THEN -> ABORT PAR = PAR+(OSEG&K'17700')>>6; ! ENSURE ACTUAL BLOCK EXT BITS = (PAR&K'176000')>>6 DQS_TCAR = PAR << 6+P_ADDRESS&K'77' F = 0 DQS_TWCR =- ((P_LEN+1) >> 1) %IF P_LEN&1 # 0 %START F = K'040000'; ! 8 IN REMAINING BIT FIELD %FINISH DQS_TCSR = TX GO!F!EXT BITS %RETURN TYPE SW(MODEM STATUS): P_TYPE = 0; ! FOR NOW %RETURN ABORT: PRINTSTRING('DQS FAIL %CYCLE; %REPEAT %ROUTINE OCTAL(%INTEGER N) %INTEGER I PRINTSYMBOL((N >> I)&7+'0') %FOR I = 15, -3, 0 %END %END %ENDOFFILE %CONSTSTRING (7) VSN = "VSN0060" !**************************** !* EMAS-2900 FEP GATE * !* FILE: GATE4S * !* DATE: 31.JUL80 * !**************************** !! STACK SIZE = 300.....STREAMS=1 %RECORDFORMAT DMF(%INTEGER I) %SYSTEMROUTINESPEC LINKIN(%INTEGER SERVICE) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %CONSTRECORD (DMF) %NAME NULL = 0 %CONSTINTEGER OWN TERM = 157; ! NETWORK ADDRESS %CONSTINTEGER MAX WRITES = 5; ! WRITE-AHEADS TO PROTOCOL HAND. %CONSTINTEGER KENT = 0; ! KENT=1 - NO NODE IN NET %CONTROL K'100001' %BEGIN %RECORDFORMAT NSI1F(%BYTEINTEGER FN, SUFL, ST, SS, SN, DN, DT, %C DS, FLAG, UFL, LEN1, DATA, %BYTEINTEGERARRAY A(2:238)) %RECORDFORMAT NSI2F(%BYTEINTEGER FN, SUFL, ST, SS, FLAG, UFLAG %C , FLEN, FDATA, FD2, FD3, FD4) %RECORDFORMAT NSI3F(%BYTEINTEGERARRAY A(0:100)) %RECORDFORMAT MEF(%RECORD (MEF) %NAME LINK, %C %BYTEINTEGER LEN, TYPE, %RECORD (NSI1F)NSL) %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, %C FN, PORT, %RECORD (MEF) %NAME MES, %BYTEINTEGER LEN, S1) %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, FN, PORT, %C FACILITY, FLAG, NODE, TERM) %RECORDFORMAT QF(%RECORD (MEF) %NAME E) %RECORDFORMAT LINE STATEF(%INTEGER NODE STATE, ATT FLAG, %C LINE NO, SER NO, NODE NUMBER) %RECORDFORMAT PORTF(%BYTEINTEGER STATE, OWNER PORT, %C NODE, TERM, FL, RL, %INTEGER NO, %C OWNER, MAX FL, %RECORD (QF) OUT Q, %RECORD (LINE STATEF) %NAME LN) !********************************************** !* NSI FUNCTIONS FRON NODE * !********************************************** %CONSTINTEGER ATTACH = 1; ! NSI FN VALUES %CONSTINTEGER SEND MESS = 2 %CONSTINTEGER CONNECT = 3 %CONSTINTEGER SEND BLOCK = 4 %CONSTINTEGER STATUS = 5 %CONSTINTEGER NIF = 6 %CONSTINTEGER REMOVE = 7 %CONSTINTEGER REPLY = 128; ! ADDED TO ABOVE FOR REPLY %CONSTINTEGER ATTACH R = 8; ! 'REAL' VALUE IS ATTACH+128 %CONSTINTEGER SEND MESS R = 9 %CONSTINTEGER CONNECT R = 10 %CONSTINTEGER SEND BLOCK R = 11 %CONSTINTEGER STATUS R = 12 %CONSTINTEGER NIF R = 13 %CONSTINTEGER REMOVE R = 14 !************************************************************ !* UPPER LEVEL (ITP&RJE) HANDLER MESSAGES TO GATE !************************************************************ %CONSTINTEGER ENABLE FACILITY = 1; ! ENABLE THE FACILITY %CONSTINTEGER DISABLE FACILITY = 2; ! THE REVERSE %CONSTINTEGER CALL REPLY = 3; ! REPLY TO A 'CALL CONNECT' %CONSTINTEGER ENABLE INPUT = 4; ! ALLOW A BLOCK TO BE READ %CONSTINTEGER PUT OUTPUT = 5; ! SEND A BLOCK OF OUTPUT %CONSTINTEGER CLOSE CALL = 6; ! TERMINATE A CALL %CONSTINTEGER ABORT CALL = 7; ! ABORT THE CALL %CONSTINTEGER OPEN CALL = 8; ! OPEN A VIRTUAL CIRCUIT %CONSTINTEGER OPEN MESSAGE = 9; ! SEND A MESSAGE !******** FROM BUFFER MANAGER ****** %CONSTINTEGER BUFFER HERE = 0 !********************************************************** !* MESSAGES FROM GATE TO UPPER LEVEL PROTOCOLS !********************************************************** %CONSTINTEGER OPEN CALL REPLY = 1 %CONSTINTEGER INCOMING CALL = 2 %CONSTINTEGER INPUT RECD = 3; ! BLOCK ARRIVED FROM NODE %CONSTINTEGER OUTPUT TRANSMITTED = 4; ! PREPARED TO ACCEPT MORE %CONSTINTEGER CALL CLOSED = 5; ! EITHER END HAS CLOSED DOWN %CONSTINTEGER CALL ABORTED = 6; ! OTHER END HAS ABORTED %CONSTINTEGER OPEN REPLY A = 7 %CONSTINTEGER OPEN REPLY B = 8 %CONSTINTEGER MESSAGE = 9 %CONSTINTEGER MESSAGE REPLY = 10 !********** TO BUFFER MANAGER *********** %CONSTINTEGER REQUEST BUFFER = 0 %CONSTINTEGER RELEASE BUFFER = 1 !************************************************************** !******* CALLS ON LINE (OR PROTOCOL) HANDLER ********* !************************************************************ %CONSTINTEGER LINE INPUT = 1 %CONSTINTEGER LINE OUTPUT = 2 %CONSTINTEGER HELLO = 2; ! IN P_LEN !************************************************************ !********** VARIOUS SERVICE NUMBERS ************* %CONSTBYTEINTEGERNAME OWN ID = K'160030' %CONSTINTEGER GATE SER = 16 %CONSTINTEGER FROM PROT = 10 %CONSTINTEGER BUFFER MANAGER = 17 %CONSTINTEGERNAME PKT = K'100010' %CONSTINTEGERNAME SBR = K'100006' %CONSTINTEGERNAME BYT = K'100004' %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310' %CONSTINTEGER T3 SER = 21 !********************************************** !* PORT STATES * !********************************************** %CONSTINTEGER DOWN = 0 %CONSTINTEGER CONNECTING = 1 %CONSTINTEGER CONNECTED = 2 %CONSTINTEGER DISCONNECTING = 3 %CONSTINTEGER DISCON 2 = 4 %CONSTINTEGER ABORTING = 5 %CONSTINTEGER CLEARING = 6; ! LINE HAS GONE DOWN !**** REST ARE SUB STATES OF 'AWAITING BUFFER' %CONSTINTEGER PUT READ ON RB = 3 %CONSTINTEGER PUT READ ON LINE 1 RB = 4 %CONSTINTEGER ATTACH RB = 5 %CONSTINTEGER STATUS REPLY RB = 7 %CONSTINTEGER SEND STATUS RB = 8 %CONSTINTEGER SEND BL REPLY RB = 6 %CONSTINTEGER SEND BL REPLY DRB = 9; ! ALSO SET DISCONNECT %CONSTINTEGER SEND BL DRB = 10; ! SEND A BLOCK WITH DISCONNECT %CONSTINTEGER SEND MESSAGE = 11; ! SEND AN NSI MESSAGE %CONSTINTEGER SEND CONNECT = 12; ! SEND AN "NSI" CONNECT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! GENERAL VARIABLES !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! %RECORD (PE) P %RECORD (P2F) %NAME P2 !! %CONSTINTEGERNAME INT = K'160060' %OWNINTEGER MON = 0; ! MONITORING OFF %OWNINTEGER SBRF = 1; ! REMOVE SBR FLAG %CONSTINTEGER MAXT = 25 %OWNRECORD (PORTF) %NAME PORT %OWNRECORD (PORTF) %ARRAY PORTA(0:MAXT) %OWNRECORD (QF) NODE Q %OWNINTEGER FORCE DOWN = 0; ! '1' WHEN IN DOWN STATE %RECORD (LINE STATEF) %NAME LN, L0, L1 %RECORD (LINE STATEF) %ARRAY LNA(0:1) !******************************************************** !* FACILITY: CONTAINES EITHER - ZERO - NOT ALLOCATED * !* OR - SER NO OF OWNER PROC * !******************************************************** %CONSTINTEGER FAC MAX = 25 %OWNBYTEINTEGERARRAY FACILITY(0:FAC MAX) = 0(0) !! %PERMROUTINESPEC PUSH(%RECORD (QF) %NAME Q, %RECORD (MEF) %NAME M) !! %PERMRECORD (MEF) %MAPSPEC POP(%RECORD (QF) %NAME Q) %ROUTINESPEC FROM HIGHER LEVEL %ROUTINESPEC DO ATT REM(%INTEGER TYPE, %RECORD (MEF) %NAME MES) %ROUTINESPEC FAULT(%INTEGER TYPE, PORT N) %ROUTINESPEC TO UPPER(%INTEGER CALL, %RECORD (MEF) %NAME MES) %ROUTINESPEC TO NODE(%RECORD (MEF) %NAME MES) %ROUTINESPEC ASK FOR BLOCK(%INTEGER REASON, PORT NO) %RECORD (MEF) %MAPSPEC NODE %ROUTINESPEC BUFFER ARRIVED %ROUTINESPEC TIDY PORTS %ROUTINESPEC FREE BUFFER(%RECORD (MEF) %NAME MES) %ROUTINESPEC NODE MONITOR(%RECORD (NSI3F) %NAME NSA) %RECORDFORMAT R1F(%INTEGER X) %RECORDFORMAT R2F(%RECORD (MEF) %NAME MES) %RECORD (R1F)R1; %RECORD (R2F) %NAME R2 %INTEGER I %RECORD (MEF) %NAME MES %OWNINTEGER TSL, IB, IC, OB, OC CHANGE OUT ZERO = T3 SER; ! SET 'SELECT OUTPUT(0)' TO COMMON R2 == R1 P2 == P MAP VIRT(BUFFER MANAGER, 5, 4) MAP VIRT(BUFFER MANAGER, 6, 5) ! MAP BUF MAN SEG 6 TO SEG 4 PORT == PORTA(1) LINKIN(GATE SER); LINKIN(FROM PROT) ALARM(100) %CYCLE I = 1, 1, MAXT PORT == PORTA(I) PORT_NO = I %REPEAT L0 == LNA(0) L1 == LNA(1) %CYCLE P_SER = 0; POFF(P) %IF 'M' <= INT <='O' %START MON = INT-'O'; INT = 0 %FINISH %IF INT = 'D' %START; ! FORCE DOWN FORCE DOWN = 1 %IF KENT = 0 %START; ! PROPER NODE ASK FOR BLOCK(ATTACH RB, 0) %ELSE PRINTSTRING("GATE CLOSEDOWN TIDY PORTS %FINISH LN_ATT FLAG = 0 INT = 0 %FINISH !********************************* !* 1) MESSAGE FROM UPPER LEVEL * !* 2) MESSAGE FROM NODE * !********************************* %IF P_SER = GATE SER %THEN FROM HIGHER LEVEL %IF P_REPLY = BUFFER MANAGER %START BUFFER ARRIVED %ELSE %IF P_SER = OWN ID %START %IF P_REPLY = 0 %START; ! CLOCK TICK ALARM(100); ! 2 SECS %IF INT = 'S' %START SBRF = SBRF!!1; ! CHANGE SBR FLAG INT = 0 %FINISH %IF INT = '?' %START PRINTSTRING("SBRF:"); WRITE(SBRF, 1); NEWLINE %CYCLE I = 0, 1, 1 %IF I = 0 %THEN %C PRINTSTRING("LN0 ") %ELSE PRINTSTRING("LN1 ") LN == LNA(I) %IF LN_ATT FLAG = 0 %THEN PRINTSTRING("DOWN") %C %ELSE PRINTSTRING("ATT ") PRINTSTRING(" TO NODE") WRITE(LN_NODE NUMBER, 1); NEWLINE %REPEAT %CYCLE I = 1, 1, MAXT PORT == PORTA(I) %IF PORT_STATE # DOWN %START WRITE(I, 2); WRITE(PORT_STATE, 2) WRITE(PORT_TERM, 3) %IF PORT_LN == L0 %THEN PRINTSTRING(" LN0") %C %ELSE PRINTSTRING(" LN1") WRITE(PORT_MAX FL, 3); WRITE(PORT_RL, 1) NEWLINE %FINISH %REPEAT INT = 0 %FINISH TSL = TSL+1 %IF TSL = 15 %START; ! 30 SECS TSL = 0 %IF INT = 'P' %START PRINTSTRING("GATE: I,O") WRITE(IB, 3); WRITE(IC, 4) WRITE(OB, 4); WRITE(OC, 4); NEWLINE IB=0; IC=0; OB=0; OC=0 %FINISH %FINISH %CONTINUE %FINISH %ELSE %IF P_SER = FROM PROT %START; ! MESSAGE FROM PROT HAN LN == LNA(P_PORT) %IF P_FN = LINE INPUT MES == NODE %IF MES == NULL %THEN ASK FOR BLOCK(PUT READ ON RB, 0) %C %ELSESTART P_SER = LN_SER NO; P_REPLY = OWN ID P_FN = LINE INPUT; P_MES == MES PON(P) %FINISH %ELSE !! LINE OUTPUT %IF P_LEN = HELLO %START LN == LNA(P_PORT); ! ITS LINE NUMBER LN_LINE NO = P_PORT LN_SER NO = P_REPLY I = PUT READ ON RB+LN_LINE NO ASK FOR BLOCK(I, 0) ASK FOR BLOCK(I, 0) ASK FOR BLOCK(I, 0) ASK FOR BLOCK(I, 0) %CONTINUE %FINISH %IF P_LEN = 1 %START; ! NODE DOWN PRINTSTRING("LINE ") PRINTSYMBOL(LN_LINE NO+'0'); PRINTSTRING(" DOWN LN_NODE STATE = 0; LN_ATT FLAG = 0 TIDY PORTS %ELSE !! UP MESSAGE OR WRITE ACK %IF LN_NODE STATE = 0 %START PRINTSTRING("LINE ") PRINTSYMBOL(LN_LINE NO+'0'); PRINTSTRING(" UP FORCE DOWN = 0 ASK FOR BLOCK(ATTACH RB, 0) %IF KENT = 0 LN_NODE NUMBER = P_S1 LN_NODE STATE = MAX WRITES; ! %FINISH %FINISH %FINISH %FINISH %REPEAT %ROUTINE TO NODE(%RECORD (MEF) %NAME MES) %IF LN_NODE STATE = 0 %START FREE BUFFER(MES); ! NODE IS DOWN %RETURN %FINISH %IF MON # 0 %START SELECT OUTPUT(1) PRINTSTRING('O '); WRITE(MES_LEN, 2); NODE MONITOR(MES_NSL) SELECT OUTPUT(0) %FINISH P_MES == MES; P_LEN = MES_LEN PKT = PKT+1; BYT = BYT+(P_LEN>>2) OB = OB+1; OC = OC+P_LEN !************************************************* !* MESSAGE TO NODE: P_MES POINTS TO HDLC SPACE * !************************************************* P_SER = LN_SER NO; P_REPLY = OWN ID P_FN = LINE OUTPUT PON(P) %END %ROUTINE ASK FOR BLOCK(%INTEGER REASON, PORT NO) %RECORD (PE) P P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = REQUEST BUFFER; P_S1 = REASON; P_PORT = PORT NO P_LEN = 0; ! ASK FOR LONG BLOCK PON(P) %END %RECORD (MEF) %MAP NODE %INTEGER FN, I, TERM, PORT N, DISCON, FAC NO, TYPE %RECORD (NSI1F) %NAME NSL %RECORD (NSI2F) %NAME NSS %RECORD (MEF) %NAME MES %CONSTBYTEINTEGERARRAY VALID(ATTACH:REMOVE R) = 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0 !! A "1" IN VALID SPECIFIES THAT NSS_SS = PORTN %SWITCH SW(0:15) !**************************************************** !* ALL MESSAGES FROM NODE COME TO HERE * !* P_A1 POINTS NO THE NSI HEADER * !* P_A2 IS THE LENGTH OF THE NSI PCKET * !**************************************************** MES == P_MES NSL == MES_NSL; NSS == NSL FN = NSL_FN %IF MON # 0 %START SELECT OUTPUT(1) PRINTSTRING('I '); WRITE(MES_LEN, 2); NODE MONITOR(NSL) SELECT OUTPUT(0) %FINISH IB = IB+1; IC = IC+MES_LEN %IF FN&128 # 0 %THEN FN = FN&127+7 PORT N = NSL_SS; ! PICK UP STREAM AS INDEX PORT == PORTA(PORT N); ! FOR THOSE WHO NEED IT %UNLESS 1<= FN <= 15 %START RUBBISH: FAULT(1, PORT N); NODE MONITOR(NSL) ->FREE %FINISH !! COMPILER FAULT WITH COMPLEX CONDITIO %IF FN = 7 %THEN -> RUBBISH %IF MES_LEN <= 5 %THEN -> RUBBISH %UNLESS 0<=PORT N<=MAXT %OR VALID(FN) = 0 %THEN -> RUBBISH -> SW(FN) SW(ATTACH): -> FAIL %IF KENT = 0 PRINTSTRING("TCP ATTACHED LN_ATT FLAG = 1 -> REPLY SW(SEND MESS): TYPE = MESSAGE -> GET SW(CONNECT): TYPE = INCOMING CALL GET: MES_NSL_FN = MES_NSL_FN!128; ! SET THE REPLY BIT FAC NO = MES_NSL_DS; ! GET THE FACILITY NUMBER %IF FAC NO <= FAC MAX %AND FACILITY(FAC NO) # 0 %START; ! ENABLED OK %CYCLE I = 1, 1, MAXT PORT == PORTA(I) %IF PORT_STATE = DOWN %START PORT_STATE = CONNECTING PORT_OWNER = FACILITY(FAC NO) P_LEN = MES_NSL_FLAG; ! PASS FORWARD/REV BUFF LIM P_S1 = MES_NSL_ST; ! PASS TERMINAL NO PORT_TERM = P_S1; ! COPY TO PORT TO UPPER(TYPE, MES) PORT_OUT Q_E == MES; ! RETAIN CONNECT MESSAGE PORT_LN == LN; ! REMEMBER WHICH LINE %RESULT == NULL %FINISH %REPEAT %FINISH !! EITHER FACILITY NOT ENABLED OR NO FREE PORTS MES_NSL_SUFL = 128+8; MES_NSL_LEN1 = 2 MES_NSL_DATA = 'N'; MES_NSL_A(2) = 'O' MES_LEN = 13; ! +2 ????? TO NODE(MES) %RESULT == NULL SW(SEND BLOCK): -> FAIL %UNLESS PORT_STATE > DOWN !! DEAL WITH INCOMING BUFFER ACK %IF NSS_FLAG&X'70'#0 %START I = NSS_FLAG>>4 %IF PORT_RL = 0 %THEN TO UPPER(OUTPUT TRANSMITTED, NULL) PORT_RL = PORT_RL+I !! DISCON 2 STATE ???? %FINISH DISCON = NSS_FLAG&128 TO UPPER(INPUT RECD, MES) %IF DISCON # 0 %START PORT_STATE = DISCONNECTING TO UPPER(CALL CLOSED, NULL) %FINISH %RESULT == NULL SW(STATUS): -> FAIL %UNLESS PORT_STATE > DOWN %IF NSS_FLAG&128 # 0 %START ! DISCONNECT SET DO STATUS: TO UPPER(CALL ABORTED, NULL) %IF PORT_STATE >= DISCONNECTING %THEN %C PORT_STATE = DOWN %ELSE %C PORT_STATE = ABORTING ->FREE %FINISH -> REPLY SW(NIF): PRINTSTRING('GATE> NIF') WRITE(NSL_SS, 2) WRITE(NSL_SUFL, 4); WRITE(NSL_FLAG, 2); WRITE(NSL_UFL, 2); NEWLINE %IF NSL_FLAG&128 # 0 %THEN -> DO STATUS !! WITHOUT DISCONNECT ->FREE SW(ATTACHR): %IF NSL_SUFL # 0 %START ! FAILED DO ATT REM(REMOVE, MES) %RESULT == NULL %FINISH LN_ATT FLAG = 1 PRINTSTRING("ATTACHED OK -> FREE SW(SEND MESSR): SW(CONNECT R): %IF PORT_STATE # CONNECTING %THEN -> FAIL P_S1 = NSL_SUFL %IF FN = SEND MESS R %START P_LEN = PORT_OWNER PORT; ! RETURN USERS INDEX NO TO UPPER(MESSAGE REPLY, MES) !! NB: UPPER MUST FREE 'MES' PORT_STATE = DOWN %RESULT == NULL %FINISH TO UPPER(OPEN REPLY B, NULL) %IF NSL_SUFL # 0 %C %THEN PORT_STATE = DOWN %ELSE PORT_STATE = CONNECTED PORT_RL = NSL_FLAG>>4; ! TECHNICALLY IS FLAG NOT RL(SEE PUT OUTPUT) PORT_MAX FL = (NSL_FLAG>>1)&7; ! SBR REMOVAL CODE PORT_FL = 0; ! PORT_FL CONTAINS THE NO OF UNACK BLOCKS -> FREE SW(SEND BLOCK R): %IF PORT_RL = 0 %THEN TO UPPER(OUTPUT TRANSMITTED, NULL) I = NSS_FLAG>>4 %IF I = 0 %THEN I = 1 PORT_RL = PORT_RL+I %IF PORT_STATE = DISCONNECTING %AND NSS_FLAG&128 # 0 %START TO UPPER(CALL CLOSED, NULL) PORT_STATE = DOWN %FINISH %IF PORT_STATE = DISCON 2 %START; ! WAITING TO SEND DISCONNECT PORT_STATE = DISCONNECTING NSS_FN = 4; NSS_FLAG = 128; MES_LEN = 6 -> SEND TO NODE %FINISH ->FREE SW(STATUS R): -> FAIL %UNLESS PORT_STATE = ABORTING TO UPPER(CALL ABORTED, NULL); ! CONFIRMATION OF ABORT PORT_STATE = DOWN -> FREE SW(NIF R):-> FAIL SW(REMOVE): -> FAIL %IF KENT = 0 FORCE DOWN = 1; ! GET IT TO TIDY PORTS SW(REMOVE R): %IF FORCE DOWN # 0 %START PRINTSTRING("GATE: REMOVED OK TIDY PORTS -> FREE %FINISH DO ATT REM(ATTACH, MES) %RESULT == NULL REPLY: NSL_FN = NSL_FN!128 SEND TO NODE: TO NODE(MES) %RESULT == NULL FREE: %RESULT == MES; ! BLOCK IS PASSED BACK FOR ! NEXT READ FAIL: FAULT(100+FN, PORT N) PRINTSTRING("STATE ="); WRITE(PORT_STATE, 1); NEWLINE NODE MONITOR(NSL) %RESULT == MES %END !! %ROUTINE FROM HIGHER LEVEL %RECORD (MEF) %NAME MES %RECORD (NSI2F) %NAME NSS %INTEGER FN, PORT N, FLAG, REASON %SWITCH FUNCTION(ENABLE FACILITY:OPEN MESSAGE) PORT N = P_PORT FN = P_FN %IF PORT N > MAXT %AND FN <= ABORT CALL %THEN %C FAULT(2, PORT N) %AND %RETURN PORT == PORTA(PORT N) LN == PORT_LN; ! PICK UP OUTPUT LINE MES == P_MES; NSS == MES_NSL ->FUNCTION(FN) FUNCTION(ENABLE FACILITY): FACILITY(P_S1) = P_REPLY %RETURN FUNCTION(DISABLE FACILITY): FACILITY(P_S1) = 0 %RETURN FUNCTION(CALL REPLY): ! REPLY TO A 'CONNECT' FLAG = P_S1; ! 0 - REJECT, OTHERWISE NSL_FLAG MES == PORT_OUT Q_E; ! RECOVER CONNECT MESS %IF FLAG&127 = 0 %START; ! FAILED %IF FLAG = 0 %THEN FLAG = 128+8 %ELSE FLAG = 0 MES_NSL_SUFL = FLAG PORT_STATE = DOWN %ELSE MES_NSL_SUFL = 0 MES_NSL_DS = PORT_NO MES_NSL_FLAG = FLAG PORT_RL = FLAG>>1&7 PORT_FL = 0; PORT_MAX FL =FLAG>>4 PORT_STATE = CONNECTED %FINISH TO NODE (MES) %RETURN FUNCTION(ENABLE INPUT): ! ALLOW A BLOCK TO BE READ PORT_FL = PORT_FL+1 !! SBR REMOVAL CODE %IF SBRF#0 %AND PORT_MAX FL>=2 %AND PORT_FL=1 %C %THEN %RETURN REASON = SEND BL REPLY RB; ! REQUEST BUFFER SBR = SBR+1 -> DO REQUEST BUFFER FUNCTION(PUT OUTPUT): ! P_MES TO BE SENT %IF PORT_RL > 0 %START; ! ALLOWED TO SEND ONE PORT_RL = PORT_RL-1 NSS_FN = 4; NSS_SUFL = 0 NSS_ST = OWN TERM; NSS_SS = PORT_NO !! SBR REMOVAL CODE %IF SBRF#0 %AND PORT_MAX FL >=2 %AND PORT_FL#0 %START NSS_FLAG = PORT_FL<<4; PORT_FL = 0 %ELSE NSS_FLAG = 0 TO NODE(MES) %IF PORT_RL > 0 %THEN TO UPPER(OUTPUT TRANSMITTED, NULL) %ELSE !! REVERSE BUFFER LIMIT IS ZERO ???? FAULT(3, PORT N); FREE BUFFER(MES) %FINISH %RETURN FUNCTION(CLOSE CALL): ! CLOSE IT DOWN %IF PORT_STATE = CONNECTED %START %IF PORT_RL = 0 %START; ! UNABLE TO SEND JUST NOW PORT_STATE = DISCON 2; ! HOLD IT %RETURN %FINISH REASON = SEND BL DRB; ! SEND IT NOW %ELSE REASON = SEND BL REPLY DRB; ! REPLY TO A DISCONNECT PORT_STATE = DISCONNECTING ->DO REQUEST BUFFER FUNCTION(ABORT CALL): %IF PORT_STATE = CLEARING %THEN PORT_STATE = DOWN %AND %RETURN ! CAUSED BY LINE DOWN, SO NO STATUS %IF PORT_STATE = CONNECTED %THEN %C REASON = SEND STATUS RB %ELSE %C REASON = STATUS REPLY RB PORT_STATE = ABORTING -> DO REQUEST BUFFER FUNCTION(OPEN MESSAGE): FUNCTION(OPEN CALL): PORT N = 0 %IF L0_ATT FLAG#0 %OR L1_ATT FLAG # 0 %C %START; ! ATTACHED OK %CYCLE PORT N = MAXT, -1, 0 PORT == PORTA(PORT N) %IF PORT_STATE = DOWN %THEN %EXIT %REPEAT %IF PORT N = 0 %START !! FULL UP !! FAULT(4, 0) %ELSE PORT_OWNER = P_REPLY; PORT_OWNER PORT=P_PORT; !FOR SM PORT_TERM = P2_TERM; PORT_NODE = P2_NODE PORT_FL = P2_FLAG; PORT_RL = P2_FACILITY %FINISH %FINISH P_SER = P_REPLY; P_REPLY = GATE SER P_S1 = PORT N; ! PASS THE GATE "PORT NO" P_FN = OPEN REPLY A PON(P) %UNLESS FN = OPEN MESSAGE %IF PORT N = 0 %START %IF FN=OPEN MESSAGE %START FLAG=P_PORT; FN=P_SER; !TEMP SAVE THESE FREE BUFFER(P_MES) P_MES==NULL; P_LEN=FLAG; !OWNERS PORT NO. P_FN=MESSAGE REPLY; P_SER=FN; P_REPLY=GATE SER PON(P) %FINISH %RETURN %FINISH PORT_STATE = CONNECTING REASON = SEND CONNECT %IF FN = OPEN MESSAGE %START REASON = SEND MESSAGE PORT_RL = P_MES_NSL_DS; PORT_FL = 0 %FINISH DO REQUEST BUFFER: P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = REQUEST BUFFER P_PORT = PORT_NO; P_S1 = REASON P_LEN = 0; ! REQUEST A BIG BUFFER %IF FN = OPEN MESSAGE %THEN BUFFER ARRIVED %ELSE %C PON(P) %END %ROUTINE TO UPPER(%INTEGER CALL, %RECORD (MEF) %NAME MES) P_SER = PORT_OWNER; P_REPLY = GATE SER P_FN = CALL; P_MES == MES; P_PORT = PORT_NO PON(P) %END %ROUTINE BUFFER ARRIVED %SWITCH SUB STATE(PUT READ ON RB:SEND CONNECT) %RECORD (MEF) %NAME MES %RECORD (NSI2F) %NAME NSS %RECORD (NSI1F) %NAME NSL MES == P_MES NSS == MES_NSL; NSL == NSS PORT == PORTA(P_PORT); ! MAY BE ZERO NSS_SUFL = 0; NSS_ST = OWN TERM; NSS_SS = PORT_NO NSS_FLAG = 0 NSS_FN = SEND BLOCK+REPLY %IF P_S1 > ATTACH RB %THEN LN == PORT_LN ->SUB STATE(P_S1) SUB STATE(PUT READ ON RB): SUB STATE(PUT READ ON LINE 1 RB): P_MES == MES P_SER = LNA(P_S1-PUT READ ON RB)_SER NO; P_REPLY = OWN ID P_FN = LINE INPUT PON(P) %RETURN SUB STATE(ATTACH RB): %IF FORCE DOWN = 0 %START DO ATT REM(ATTACH , MES) %ELSE DO ATT REM(REMOVE, MES) %FINISH %RETURN SUB STATE(STATUS REPLY RB): NSS_FN = 128+5; ! STATUS REPLY PORT_STATE = DOWN; ! FINISHED NOW -> SET DISC BIT; ! SET DISCONNECT AND SEND IT SUB STATE(SEND STATUS RB): !* ABORT THE CONNECTION NSS_FN = 5; ! STATUS -> SET DISC BIT; ! SET DISCONNECT AND SEND IT SUB STATE(SEND BL REPLY DRB): ! DISCONNECT REPLY NSS_FN = 4+128; ! SEND BLOCK REPLY PORT_STATE = DOWN; ! FINISHED NOW SET DISC BIT: NSS_FLAG = 128; ! SET THE NSI DISCONNECT BIT ->ONW SUB STATE(SEND BL REPLY RB): ! NORMAL REPLY NSS_FN = 128+4 ! SBR REMOVAL CODE %IF PORT_FL = 0 %START; ! ALREADY SENT ! FREE BUFFER(MES); %RETURN %FINISH %IF SBRF = 0 %START; ! NO SBR REMOVAL NSS_FLAG = X'10'; PORT_FL = PORT_FL-1 %ELSE NSS_FLAG = PORT_FL<<4; PORT_FL = 0 %FINISH ONW: NSS_FLEN = 0 MES_LEN = 6 ->SEND IT SUB STATE(SEND BL DRB): ! BLOCK WITH DISCONNECT NSS_FN = 4; ! SEND BLOCK -> SET DISC BIT; ! SET NSI DISCONNECT AND SEND IT SUB STATE(SEND MESSAGE): SUB STATE(SEND CONNECT): NSL_FN = P_S1-SEND CONNECT+3 NSL_SN = 0; NSL_DN = PORT_NODE NSL_DT = PORT_TERM; NSL_DS = PORT_RL; ! TERM+FACILITY NSL_FLAG = PORT_FL MES_LEN = 10 %UNLESS P_S1 = SEND MESSAGE PORT_FL = NSL_FN; ! REMEMBER TYPE %IF (L1_ATT FLAG # 0 %AND NSL_DN = L1_NODE NUMBER) %OR %C L0_ATT FLAG = 0 %THEN LN == L1 %ELSE LN == L0 PORT_LN == LN; ! NEEDED FOR REPLY ETC SEND IT: TO NODE(MES) %END %ROUTINE TIDY PORTS %INTEGER I %CYCLE I = 1, 1, MAXT PORT == PORTA(I) %IF PORT_STATE # DOWN %AND PORT_LN == LN %START %IF PORT_STATE = CONNECTING %START %IF PORT_FL = SEND CONNECT %START; ! CONNECT P_S1 = 125; ! LINE DOWN TO UPPER(OPEN REPLY B, NULL) %ELSE; ! SEND MESSAGE P_LEN=PORT_OWNER PORT TO UPPER(MESSAGE REPLY,NULL) %FINISH PORT_STATE = DOWN; ! SHOULD REPLY %ELSE TO UPPER(CALL ABORTED, NULL) %IF DISCONNECTING <= PORT_STATE <= ABORTING %C %OR PORT_STATE = CONNECTING %THEN %C PORT_STATE = DOWN %ELSE %C PORT_STATE = CLEARING %FINISH %FINISH %REPEAT %END %ROUTINE FREE BUFFER(%RECORD (MEF) %NAME MES) P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = RELEASE BUFFER; P_MES == MES PON(P) %END %ROUTINE FAULT(%INTEGER N, PORT N) PRINTSTRING('GATE> FAULT'); WRITE(N, 1) PRINTSTRING(' STRM:'); WRITE(PORT N, 1) %IF LN == L0 %THEN PRINTSTRING(" LN0 ") %C %ELSE PRINTSTRING(" LN1 %END %ROUTINE DO ATT REM(%INTEGER TYPE, %RECORD (MEF) %NAME MES) MES_NSL_FN = TYPE MES_NSL_SUFL = 0 MES_NSL_ST = OWN TERM; MES_NSL_SS = 0 %IF OWN TERM = 49 %START; ! SHORT ATTACH - 70 ONLY MES_NSL_SN = OWN TERM; MES_NSL_DN = 255 MES_LEN = 8 %ELSE MES_NSL_SN = OWN TERM; MES_NSL_DN = OWN TERM MES_NSL_DT = OWN TERM; MES_NSL_DS = 255 MES_NSL_FLAG = 0 MES_LEN = 12 %FINISH TO NODE(MES) %END %ROUTINE NODE MONITOR(%RECORD (NSI3F) %NAME NSA) %INTEGER I, N, J, K, P P = 11 SPACES(2) !! %IF NSI1_SUFL&X'80'#0 %THEN P=20 %CYCLE I = 0, 1, P N = NSA_A(I) %CYCLE J = 4, -4, 0 K = (N >> J)&15 ;************************************** ;* DVRUB * ;* INTERFACE BETWEEN HARDWARE AND IMP* ;* DATE: 14.APR.80 * ;************************************** PS=177776; PROCESSOR STATUS WORD IDLEST=-1; SUPERVISOR IDLE FLAG INTVAL=40; DEDICATED LOCATION FOR INTERRUPT NUMBER ALARMF=44; DITTO - FOR CLOCK PSECT=46; DITTO - CURRENT PSECT LASTPS = 54 INTINF=56 UPAR=177640 UPDR=177600 UPAR0=40; INDEC INTO PSECT UPDR0=UPAR0+2; DITTO UR0=14 UR4=UR0+10; ALL DITTO UP! FILE 'FEP_PRT9NS' !********************* !* PRT9S/PRT9Y * !* DATE: 11.APR.80 * !*VERSION FOR NODE * !*HISTORY UNCERTAIN * !!!!!!!!!!!!!!!!!!!!!! !STACK = 140 %CONTROL X'100001'; ! TRUSTED PROGRAM AND QUICK ! ROUTINE ENTRY AND EIS %CONSTINTEGER KERNEL SER = 10 %OWNINTEGER SECONDARY = 1; !PRIM = 0, SEC = 1 %OWNINTEGER SECAD = 0; !SECONDARY ADDRESS %CONSTSTRING (7) VSN = 'VSN009E' %BEGIN %RECORDFORMAT XXF(%INTEGER DUMMY) %CONSTRECORD (XXF) %NAME NULL = 0 %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %RECORDFORMAT PARF(%INTEGER TYPE, %RECORD (XXF) %NAME B, %C %INTEGER LEN) %EXTERNALROUTINESPEC DQS11E(%RECORD (PARF) %NAME L) %EXTERNALROUTINESPEC DUP11E(%RECORD (PARF) %NAME B) %CONSTBYTEINTEGERNAME ID = K'160030' %OWNINTEGER LINE TYPE = 0; ! 0=DQS11, 1=DUP11E %OWNINTEGER LINE = 0; !LOGICAL LINE %OWNRECORD (XXF) %NAME HANDLER ADDRESS = 1; ! SET BY INITIATING PROG %CONSTINTEGER SFMASK = 31 %CONSTINTEGERNAME NO OF BUFF = K'100112'; ! NO OF BUFFERS (BUFF3) %CONSTINTEGER BIG LIMIT = 5; ! TRY AT 5 FOR NOW %CONSTINTEGER CRITICAL = 3; ! NO TO START ASKING AT %CONSTINTEGER MAX READS = 4; ! MAX IT IS ALLOWED TO HOLD %CONSTINTEGER INITIALISE = 0; ! CALLS & REPLIES TO LINE HANDLER ROUTINES %CONSTINTEGER LINE INPUT = 1 %CONSTINTEGER LINE OUTPUT = 2 %CONSTINTEGER INPUT HERE = 3 %CONSTINTEGER OUTPUT DONE = 4 %CONSTINTEGER INPUT REQ = 1; ! INTERFACE TO HIGHER LEVEL %CONSTINTEGER OUTPUT REQ = 2 %CONSTINTEGER BOUNCE = 3 %CONSTINTEGER PUT DOWN = 4 %CONSTINTEGER PUT UP = 5 %CONSTINTEGER MONIT = 6 %CONSTINTEGER BUFFER MANAGER = 17 %OWNINTEGER RX INT = -7, TX INT = -6 %RECORDFORMAT MEF(%BYTEINTEGER HLEN, HTYPE, LEN, TYPE, %C %BYTEINTEGERARRAY A(0:240)) %RECORDFORMAT HDLCF(%BYTEINTEGER ADD, TYPE) %RECORDFORMAT MEF2(%BYTEINTEGER HLEN, HTYPE, %RECORD (HDLCF) HDLC) %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, %INTEGER A1, A2, A3) %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, FN, LINE, %C %RECORD (MEF) %NAME M, %BYTEINTEGER LEN, S1) %OWNRECORD (PARF) PAR %OWNRECORD (PE)P %OWNRECORD (P2F) %NAME P2 %OWNINTEGER RSTATE, TSTATE %INTEGER I %OWNINTEGER ISTATE=2, ACTIVE=0 %OWNINTEGER AAA, EEE, FFF, TTT !A..LAST MESSAGE ACKNOWLEDGED ! BY OTHER END !E..NUMBER OF NEXT MESSAGE ! EXPECTED !F..LAST OUTPUT MESSAGE HELD+1 !T..LAST MESSAGE SENT %OWNINTEGER DATA MISSED, ABORT REQ %OWNINTEGER WPEND; !WRITES PENDING %CONSTINTEGER WMAX = 24; !MAX WRITES ALLOWED %OWNINTEGER INPUT EXP; !BLOCKS OF INPUT EXPECTED %OWNINTEGER CLOCK0, CLOCK1, CLOCK2, CLOCK3, CLOCK4 !CLOCK1. CLEARED WHEN ACK ! RECEIVED, AND WHEN RETRY STARTS ! TIMED WHEN ACK ! OUTSTANDING !CLOCK2. TIME SINCE VALID ! MESSAGE FROM OTHER END !CLOCK3. NO OF TRANSMIT ! RETRIES. CLEARED WHEN ACK ! RECEIVED !CLOCK. TIME SINCE RR OR SARM %OWNINTEGER IRD, RR RD, RNR RD, REJ RD, I TR, RR TR, REJ TR %OWNINTEGER BAD ACK, BAD FR, DM, SILO FULL, RNR TR, I RE TR %OWNINTEGER DCOU, DSYM %RECORDFORMAT WDSE(%RECORD (MEF2) %NAME M, %INTEGER LEN) %RECORDFORMAT BPF(%RECORD (MEF2) %NAME M) %OWNRECORD (WDSE) %NAME WDESC %OWNRECORD (WDSE) %ARRAY WSPACE(0:31) %OWNRECORD (WDSE) %NAME IDESC %OWNRECORD (WDSE) ICURR %OWNRECORD (WDSE) %NAME IPOOL %OWNRECORD (WDSE) OM %OWNRECORD (BPF) %NAME IM %OWNRECORD (BPF) %NAME ME2 %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310' %CONSTINTEGER T3 SER = 21 %CONSTBYTEINTEGERNAME INT = K'160060' %CONSTBYTEINTEGERARRAY INIT(0:1) = 4, 2; ! INITIAL STATE OF ISTATE %RECORDFORMAT M1F(%INTEGER A, B, C, D, E, F) %RECORD (M1F) M1, M2 %SWITCH SW(INPUT REQ: MONIT) %ROUTINE START INPUT PAR_TYPE = LINE INPUT; PAR_B == ICURR_M_HDLC; PAR_LEN = ICURR_LEN %IF LINE TYPE = 0 %START DQS11E(PAR) %ELSE %IF LINE TYPE = 1 %START DUP11E(PAR) %FINISH %END %ROUTINE WREPLY(%INTEGER FLAG, BLOCK) P_SER = KERNEL SER; P_REPLY = ID P2_FN = OUTPUT REQ; P_A2 = BLOCK; P_A3 = FLAG P2_LINE = LINE !! MONITOR(P) PON(P) %END %ROUTINE RETURN BUFF %RECORD (WDSE) %NAME ME2 P_SER=BUFFER MANAGER; P_REPLY=ID P_A1=1; P2_M == WDESC_M P2_M_TYPE = WDESC_M_HTYPE %IF P2_M_TYPE # 0 %OR INPUT EXP > MAX READS %OR NO OF BUFF %C < CRITICAL %START PON(P) %ELSE ME2 == P2_M ME2_M == IPOOL IPOOL == ME2 INPUT EXP = INPUT EXP+1 %FINISH %END %ROUTINE ASK FOR BUFFER P_SER = BUFFER MANAGER; P_REPLY = ID P_A1 = 0; P_A3 = 0; ! ASK FOR BIG BUFFER PON(P) %END %ROUTINE TELL PRINTSTRING("PROT"); WRITE(LINE, 1); PRINTSYMBOL(':') %END %ROUTINE DELETE READS %WHILE %NOT IPOOL == NULL %CYCLE INPUT EXP = INPUT EXP-1 ME2 == IPOOL; IPOOL == ME2_M P2_M == ME2 P_SER = BUFFER MANAGER; P_REPLY = ID; P_A1 = 1 PON(P) %REPEAT INPUT EXP = 0 %END %ROUTINE ABORT(%INTEGER TYPE) ! REASONS FOR ABORT: !1..NOTHING VALID RECEIVED IN ! 40 TICKS !2..10 RETRIES TO RE-TRANSMIT !3..DEVICE HANDLER FAULT !4..RESET FROM BRIAN !6..SARM RECEIVED FROM PRIMARY !7..NO READS ONFOR 24 TRIES !8..TOO MANY WRITES (IE FULL UP) %RETURNIF ISTATE # 0; !ALREADY DOWN %IF ABORTREQ = 0 %START TELL; PRINTSTRING("DEAD ") PRINTSYMBOL(TYPE+'0') WRITE(DATA MISSED, 3); DATA MISSED = 0 NEWLINE WREPLY(1, 0); !TELL GATE DOWN !SET RESTRICTIVE CONDITION %FINISH %IF ACTIVE = 2 %START ABORTREQ = 1 %ELSE ABORTREQ = 0 !TIDY UP REQUESTS %WHILE AAA # FFF %CYCLE; !TIDY UP REQUESTS WDESC == WSPACE(AAA) RETURN BUFF WDESC_M == NULL AAA = (AAA+1)&SFMASK %REPEAT ISTATE = INIT(SECONDARY) DELETE READS %FINISH %END %ROUTINE HANDLE OUTPUT %RECORD (HDLCF) %NAME HDLC %RECORD (MEF2) %NAME M %INTEGER TYPE, LEN %RETURNIF ACTIVE # 0; !ABORT IF TRANSMITTER BUSY %IF ABORT REQ # 0 %THEN ABORT(0) %IF ISTATE # 0 %START; ! IN INITIAL SEQUENCE %IF ISTATE = 4 %START; ! SEND SARM ISTATE = 3; ! GOES BACK TO 4 AFTER CLOCK TICK TYPE = X'0F'; !SARM -> SEND1 %FINISH %IF ISTATE = 1 %START; ! READY TO SEND UA ISTATE = 0 TYPE = X'63'; !UA -> SEND1 %FINISH %RETURN; ! ISTATE#ABOVE VALUES %FINISH %IF RSTATE = 3 %START RSTATE = 2 REJ TR = REJ TR+1 TYPE = 9; !REJ -> SEND %FINISH %IF RSTATE = 6 %START; ! SEND RNR TYPE = 5 RNR TR = RNR TR+1 RSTATE = 5; ! GET IT TO SEND RR IF POSSIBLE -> SEND %FINISH %IF TTT # FFF %AND TSTATE = 0 %C %AND (TTT-AAA)&7#6 %START WDESC == WSPACE(TTT) M == WDESC_M; HDLC == M_HDLC LEN = WDESC_LEN TYPE = EEE << 5+(TTT&7) << 1 TTT = (TTT+1)&SFMASK ACTIVE = 2; !BIG BLOCK BEING TRANSMITTED CLOCK1 = 0; !SET TIMER I RE TR = I RE TR+1; ! TOTAL NO OF I FRAMES TR -> PUT %FINISH %IF RSTATE = 1 %OR (RSTATE = 2 %AND CLOCK0 >= 5) %START RSTATE = 0 %IF RSTATE = 1 TYPE = 1; !RR RR TR = RR TR+1 %ELSE %RETURN !! SEND: TYPE = EEE << 5+TYPE SEND1: HDLC == OM_M LEN = 2 ACTIVE = 1; !SHORT BLOCK BEING TRANSMITTED PUT: CLOCK0 = 0 HDLC_ADD = SECAD; HDLC_TYPE = TYPE PAR_TYPE = LINE OUTPUT; PAR_B == HDLC; PAR_LEN = LEN %IF LINE TYPE = 0 %START DQS11E(PAR) %ELSE %IF LINE TYPE = 1 %START DUP11E(PAR) %FINISH %END !! %ROUTINE HANDLE INPUT %RECORD (HDLCF) %NAME HDLC %RECORD (WDSE) %NAME IMESS %RECORD (MEF2) %NAME M %INTEGER R, S, X, TYPE M == ICURR_M HDLC == PAR_B; ! NB: HDLC AND M ARE PICKED UP SEPERATELY !!!!!! %UNLESS HDLC == M_HDLC %START PRINTSTRING("PROT:BAD ADDRESS %CYCLE;%REPEAT %FINISH ! PAR_LEN<0 BUFFER TOO SMALL %IF PAR_LEN < 0 %START %IF PAR_LEN = -1 %START DM = DM+1 CLOCK4 = CLOCK4+1 %IF CLOCK4>50 %THEN ABORT(7) %ELSE %IF PAR_LEN = -2 %START BAD FR = BAD FR+1 %ELSE %IF PAR_LEN = -3 %START SILO FULL = SILO FULL+1 %FINISH -> NOISE %FINISH TYPE = HDLC_TYPE&X'EF'; ! IGNORE POLL -> NOISE %IF ABORT REQ # 0 %IF ISTATE # 0 %START -> NOISE %IF ISTATE = 10 ! KEEP DOWN IF NO READS OR LINE MEANT TO BE DOWN DCOU = DCOU+1; DSYM = TYPE; ! RETAIN FOR MONITORING %IF TYPE = X'0F' %START; ! SARM SEEN %IF SECONDARY = 1 %OR SECAD > HDLC_ADD %START ISTATE = 1; ! SEND UA %ELSE -> NOISE; ! IGNORE IT %ELSE -> NOISE %UNLESS SECONDARY = 0 %AND TYPE = X'63' ISTATE = 0; ! ALL DONE %FINISH RSTATE = 1; ! SEND RR TSTATE = 0 AAA = 0; EEE = 0; FFF = 0; TTT = 0 CLOCK1 = 0; CLOCK2 = 0; !RESET CLOCKS CLOCK3 = 0 WREPLY(0!(HDLC_ADD<<8), 0); !TELL NOEL UP WPEND = 0 -> END3 %FINISH %IF TYPE = X'0F' %START %IF CLOCK2 >= 15 %START !SARM RECEIVED & THIS IS ! SECONDARY ABORT(6); !SARM RECEIVED %FINISH -> NOISE %FINISH R = (TYPE >> 5)&7 TYPE = TYPE&15 %IF TYPE&1 = 0 %START; !INFORMATION BLOCK S = TYPE >> 1 %IF S # EEE %START RSTATE = 3 %UNLESS RSTATE = 2 !REJECT IF NOT ALREADY SET -> END1 %FINISH !PASS MESSAGE UP P_SER = KERNEL SER; P_REPLY = ID P2_FN = INPUT REQ; P2_LINE = LINE P2_M == M P2_M_TYPE = M_HTYPE P2_M_LEN = PAR_LEN-2 %IF 0 # P2_M_TYPE # 64 %START PRINTSTRING("PROT: GROTTED %FINISH PON(P) I RD = I RD+1 HDLC == NULL; !NO CURRENT BUFFER EEE = (EEE+1)&7 %IF RSTATE = 5 %THEN RSTATE = 1 %ELSE RSTATE = 5 !! SEND RR IF 2 OUTSTANDING, ELSE WAIT AND SEE %IF NO OF BUFF < BIG LIMIT %THEN RSTATE = 6; ! SEND RNR %ELSE %IF TYPE = 1 %START; !RR TSTATE = 0 RR RD = RR RD+1 %ELSE %IF TYPE = 5 %START; !RNR TSTATE = 1 RNR RD = RNR RD+1 %ELSE %IF TYPE = 9 %START ! 9=REJ REJ RD = REJ RD+1 %ELSE TELL; PRINTSTRING("NOISE"); WRITE(TYPE, 1); WRITE(R, 1) NEWLINE -> NOISE %FINISH; %FINISH; %FINISH %FINISH !! END1: !CHECK ACKNOWLEDGEMENT X = AAA %WHILE X&7 # R %CYCLE %IF X = TTT %START; !NO ACK EXPECTED BAD ACK = BAD ACK+1 -> END3 %FINISH X = (X+1)&SFMASK %REPEAT %UNLESS ACTIVE = 2 %AND X = TTT %START !IGNORE ACK FOR BLOCK !CURRENTLY BEING TRANSMITTED !UPDATE A COUNTER %WHILE AAA # X %CYCLE WDESC == WSPACE(AAA) RETURN BUFF I TR = I TR+1 WDESC_M == NULL WPEND = WPEND-1; !COUNT DOWN TRANSMIT REQUESTS AAA = (AAA+1)&SFMASK CLOCK1 = 0; CLOCK3 = 0 %REPEAT %IF TYPE = 9 %THEN TTT = AAA; !REJ..RESET TRANSMIT COUNT %FINISH END3: !VALID MESSAGE CLOCK2 = 0; !RESET VALIDITY TIMER NOISE: %IF %NOT HDLC == NULL %AND %NOT ICURR_M==IM %START %IF ISTATE = 10 %START WDESC == ICURR; ! MAP TO IT FOR RETURN BUFF RETURN BUFF %RETURN %FINISH !! USE THE SAME ONE AGAIN %ELSE %RETURN %IF ISTATE = 10; ! HOLD IT DOWN %IF INPUT EXP > 0 %START ICURR_M == IPOOL IPOOL == IPOOL_M; INPUT EXP = INPUT EXP-1 ICURR_M_HTYPE = ICURR_M_HDLC_TYPE %IF ICURR_M_HTYPE=0 %THEN ICURR_LEN =252 %C %ELSE ICURR_LEN = 60 %ELSE ICURR_M == IM; ICURR_LEN = 6 %FINISH %FINISH %IF INPUT EXP<2 %THEN ASK FOR BUFFER START INPUT HANDLE OUTPUT %END %ROUTINE CLOCK INT %INTEGER FLAG ALARM(25); !RESTART CLOCK CLOCK0 = CLOCK0+1 %IF ISTATE # 0 %START %RETURN %IF CLOCK0 < 5 %OR ISTATE = 10 ISTATE = INIT(SECONDARY); !SEND ANOTHER SARM %ELSE CLOCK4 = 0 %IF INPUT EXP > 0 CLOCK2 = CLOCK2+1 %IF CLOCK2 >= 80 %START !NOTHING FROM OTHER END IN 80 ! TICKS %IF CLOCK4>10 %THEN FLAG = 7 %ELSE FLAG = 1 -> LABORT %FINISH %IF AAA # TTT %THEN CLOCK1 = CLOCK1+1 %IF CLOCK1 >= 2 %AND AAA # TTT %AND TSTATE = 0 %START CLOCK3 = CLOCK3+1; !COUNT RETRIES %IF CLOCK3 > 30 %START FLAG = 2 -> LABORT %FINISH CLOCK1 = 0 TTT = AAA; !RESET TRANSMIT COUNT %ELSE %IF CLOCK0 >= 2 %START; !SEND ANOTHER RR RSTATE = 6 %IF NO OF BUFF < BIG LIMIT RSTATE = 1 %IF RSTATE = 0 %OR RSTATE = 5 %ELSE %RETURN !! LABORT: ABORT(FLAG); !1..NOTHING VALID IN 40 ! TICKS..2..10 RETRIES TO ! RETRANSMIT %FINISH; %FINISH; %FINISH HANDLE OUTPUT %END !! %ROUTINE REINITIALISE !! GRABS THE INTERRUPT SERVICE NOS AND SETS/RESETS THE DEVICE LINKIN(RXINT); LINKIN(TXINT) PAR_TYPE = INITIALISE PAR_B ==HANDLER ADDRESS %IF LINE TYPE = 0 %START DQS11E(PAR) %ELSE %IF LINE TYPE = 1 %START DUP11E(PAR) %FINISH ICURR_M == IM; ICURR_LEN = 6 START INPUT %END !! MAP VIRT(BUFFER MANAGER,5,4) MAP VIRT(BUFFER MANAGER, 6, 5) IM == M1; OM_M == M2 CHANGE OUT ZERO = T3 SER P2 == P P2_SER = 0; POFF(P2); ! WAIT FOR INSTRUCTIONS LINE = P2_FN; LINE TYPE = P2_LINE&7 HANDLER ADDRESS == P2_M RXINT = P2_LEN!X'FF00'; TXINT = P2_S1!X'FF00' %IF P2_LINE&K'70' # 0 %THEN %C ISTATE = 10 %ELSE ISTATE = INIT(SECONDARY) !! IF ANY OF BITS 3-5 IS SET, LINE IS HELD DOWN REINITIALISE; ! GRAB INTERRUPTS AND RESET DEVICE WREPLY(2, 0); ! HERE I AM (HELLO TO KERNEL) ALARM(25) HANDLE OUTPUT ASK FOR BUFFER %CYCLE P_SER = 0 POFF(P) %IF P_SER&X'80' # 0 %START; ! INTERRUPT %IF P_SER = TX INT&X'FF' %THEN I = OUTPUT DONE %ELSE %C I = INPUT HERE PAR_TYPE = I %IF LINE TYPE = 0 %START DQS11E(PAR) %ELSE %IF LINE TYPE = 1 %START DUP11E(PAR) %FINISH %IF PAR_TYPE = LINE OUTPUT %START ACTIVE = 0; HANDLE OUTPUT %ELSE HANDLE INPUT %FINISH %CONTINUE %FINISH %IF P_REPLY = 0 %START CLOCK INT; ! CLOCK INTERRUPT %IF INT = '?' %START INT = 0 TELL; WRITE(ISTATE, 4); WRITE(RSTATE, 4) WRITE(INPUT EXP, 5); WRITE(W PEND, 4) WRITE(DCOU, 4); WRITE(DSYM, 4) NEWLINE TELL; WRITE(IRD, 4);WRITE(RRRD, 4);WRITE(RNRRD, 4);WRITE(REJRD, 4) WRITE(ITR,6);WRITE(RRTR, 4); WRITE(RNR TR, 4) WRITE(REJTR, 4); NEWLINE TELL; WRITE(BADACK, 4);WRITE(BADFR, 4);WRITE(SILOFULL, 4);WRITE(DM, 4) WRITE(I RE TR-ITR, 5) NEWLINE %FINISH %IF INT = 'A' %START; ! ABORT THE LINE INT = 0 ABORT(4); ! REQUEST TO PUT DOWN %FINISH %CONTINUE %FINISH %IF P_REPLY = BUFFER MANAGER %START; ! BUFFER HAS ARRIVED ME2 == P2_M ME2_M == IPOOL IPOOL == ME2 INPUT EXP = INPUT EXP+1 %CONTINUE %FINISH !! USER REQUEST -> SW(P2_FN) SW(OUTPUT REQ): !WRITE REQ %IF ISTATE = 0 %START WPEND = WPEND+1; ! COUNT PENDING WRITES %IF WPEND = WMAX %START TELL; PRINTSTRING("FULL!") ABORT(8); ! FULL UP %CONTINUE %FINISH WDESC == WSPACE(FFF) WDESC_M == P2_M WDESC_M_HTYPE = P2_M_TYPE WDESC_LEN = P2_LEN+2 FFF = (FFF+1)&SFMASK HANDLE OUTPUT; !KICK TRANSMIT %ELSE; ! NOT UP, SO DISCARD SW(INPUT REQ): ! BEING PHASED OUT P_SER = BUFFER MANAGER; P_REPLY = ID P_A1 = 1 PON(P) %FINISH %CONTINUE SW(BOUNCE): ! FORCE LINE BOUNCE ABORT(4) %CONTINUE SW(PUT DOWN): ! FORCE AND HOLD DOWN !************** !* DUP11E * !*DA:10.APR.80* !* FOR DU11 * !************** %CONTROL K'100001'; ! 'SYSTEM' PROGRAM AND ! TRUSTED PROG %RECORDFORMAT PARF(%INTEGER TYPE, ADDRESS, LEN) %EXTERNALROUTINE DUP11E(%RECORD (PARF) %NAME P) %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG) %SYSTEMINTEGERFNSPEC GETID %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %SYSTEMINTEGERFNSPEC MAP ABS(%INTEGER ADR, LEN, REQ ID) %PERMINTEGERFNSPEC SVC(%INTEGER EP, P0, P1) %RECORDFORMAT PF(%BYTEINTEGER SER, REPLY, %INTEGER A1, A2, A3) %RECORDFORMAT DUP11F(%INTEGER RCS, RDB, TCS, TDB) %OWNRECORD (DUP11F) %NAME DUP = 1; ! SET UP BY PROT ON INITIALISE %RECORDFORMAT DESF(%INTEGER PT, %BYTEINTEGER STATE, S1, %C %INTEGER MAX LEN, P1, FLAG, SEG, SA, VEC) %RECORDFORMAT DES2F(%RECORD (DESF) RX, TX) %RECORDFORMAT PAR2F(%INTEGER TYPE, %RECORD (DUP11F) %NAME ADDRESS,LEN) %RECORDFORMAT R1F(%INTEGER N) %RECORDFORMAT R2F(%RECORD (DES2F) %NAME DES) %RECORD (PAR2F) %NAME P2 %OWNRECORD (DES2F) %NAME DES %RECORD (R1F) R1; %RECORD (R2F) %NAME R2 %CONSTINTEGER INITIALISE = 0 %CONSTINTEGER LINE INPUT = 1 %CONSTINTEGER LINE OUTPUT = 2 %CONSTINTEGER INPUT HERE = 3 %CONSTINTEGER OUTPUT DONE = 4 %CONSTINTEGER MARK = K'377' %CONSTINTEGER RSET=K'100',DSR=K'1000',DTR=2,RTS=4,CTS=K'20000' %CONSTINTEGER DCD=K'10000',RXEN=K'20',TXEN=K'20',DLEN=K'40' %CONSTINTEGER PARM = K'036062'; ! MODE=BYTE, NO CRC %CONSTINTEGER TSOM = K'400', TEOM = K'1000' %OWNINTEGER TX REPLY, RX REPLY %ROUTINESPEC OCTAL(%INTEGER N) %SWITCH TYPESW(INITIALISE:OUTPUT DONE) %OWNINTEGER TYPE, F, CAD, OSEG, I, X %OWNINTEGER PAR, MID, PAD %OWNINTEGERARRAY RADDR(0:7) -> TYPE SW(P_TYPE) TYPE SW(INITIALISE): MID = GET ID MAPHWR(3) P2 == P DUP == P2_ADDRESS %CYCLE I = 1, 1, 7; ! FIND ABSOLUTE ADDRESSES RADDR(I) = MAP ABS(I<<13, 256, MID); ! MY ADDRESSES F = MAP ABS(I<<13, 0, MID); ! AND OFF AGAIN %REPEAT X = SVC(22, 0, 0); ! MAP TO DUP DESCRIPTOR AREA R2 == R1 R1_N = X&K'77'; ! JUST THE PAGE DISPLACEMENT DES == R2_DES DES_RX_VEC = K'160000'!(P_ADDRESS&K'17777') DES_TX_VEC = DES_RX_VEC DUP_RCS = RSET DUP_RDB = PARM DUP_RCS = DUP_RCS!DTR %WHILE DUP_RCS&DSR = 0 %CYCLE; %REPEAT DUP_RCS = DUP_RCS!RTS %WHILE DUP_RCS&CTS = 0 %CYCLE; %REPEAT %WHILE DUP_RCS&DCD = 0 %CYCLE; %REPEAT DUP_RCS = DUP_RCS!RXEN!K'100' %RETURN TYPE SW(OUTPUT DONE): ! TRANSMITTER TYPE = LINE OUTPUT %IF DES_TX_FLAG < 0 %OR TXREPLY = 0 %START !! TRANSMITTER ERROR PRINTSTRING('TX ERROR P_LEN = 1 %ELSE P_LEN = 0 %FINISH P_TYPE = LINE OUTPUT TXREPLY = 0 %RETURN TYPE SW(INPUT HERE): !! RECEIVER INTERRUPT X = DES_RX_FLAG %IF X < 0 %OR RX REPLY = 0 %START F = X; ! LOWER LEVEL INFORMS TYPE %ELSE F = DES_RX_PT-CAD ! NUMBER OF BYTES TRANS %IF F> 2000 %START PRINTSTRING("DUP NASTY:") OCTAL(DUP_RCS); SPACE; OCTAL(CAD); SPACE; OCTAL(F);NEWLINE %FINISH %FINISH P_TYPE = LINE INPUT P_ADDRESS = PAD; ! PASS BLOCK ADDRESS BACK P_LEN = F RX REPLY = 0 %RETURN TYPE SW(LINE INPUT): !! USER CALL !! READ REQUEST %IF RX REPLY # 0 %THEN -> ABORT RXREPLY = MID PAD = P_ADDRESS ! PAR = MAP ABS(PAD, P_LEN, RXREPLY) PAR = RADDR(PAD>>13) %IF PAR = 0 %THEN -> ABORT CAD = PAD&K'17777'!K'140000'; ! IN SEG NO 6 DES_RX_MAX LEN = P_LEN DES_RX_SEG = PAR DES_RX_PT = CAD %RETURN TYPE SW(LINE OUTPUT): !! OUTPUT REQUEST %IF TX REPLY # 0 %THEN -> ABORT TX REPLY = MID OSEG = P_ADDRESS ! PAR = MAP ABS(OSEG, P_LEN, TX REPLY) PAR = RADDR(OSEG>>13) %IF PAR = 0 %THEN -> ABORT DES_TX_SEG = PAR DES_TX_PT = P_ADDRESS&K'17777'!K'140000'; ! IN SEG NO 6 DES_TX_SA = P_LEN; ! LENGHT IN CHARS DES_TX_STATE = 1; ! TELL IT TO EXPECT INTS DUP_TCS = DUP_TCS!TXEN DES_TX_P1 = 7; ! STUFF PAD COUNTER DUP_TDB = MARK+TSOM; ! PLANT CHAR DUP_TCS = DUP_TCS!K'100'; ! NOW ALLOW INTS %RETURN ABORT: PRINTSTRING('DUP FAIL %CYCLE; %REPEAT %ROUTINE OCTAL(%INTEGER N) %INTEGER I PRINTSYMBOL((N >> I)&7+'0') %FOR I = 15, -3, 0 %END %END %ENDOFFILE !********************** !* NSIWS/NSIWY * !* DATE: 11.APR.80 * !********************* %CONSTSTRING (7) VSN = "VSN001C" !! STACK = 400, STREAMS = 3 !! NOTE: FOR VERSIONS THAT ARE RUN OUT OF A 2900 FEP SYSTEM, !! MESSAGES FROM THE NETWORK SHOULD BE ENABLED - SEE !! THE COMMENT AT 'MESSAGES ENABLED' %CONTROL K'100001' !STACK=400, STREAMS=3 %RECORDFORMAT XF(%BYTEINTEGER UNIT,FSYS,%BYTEINTEGERARRAY FNAME(0:5)) %EXTERNALPREDICATESPEC READ FNAME(%RECORD(XF)%NAME FILE) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %BEGIN %%RECORDFORMAT ITPF(%BYTEINTEGER CNSL,HB1,HB2,LEN, %C %BYTEINTEGERARRAY DATA(0:127)) %RECORDFORMAT RJEF(%BYTEINTEGERARRAY DATA(0:239)) %RECORDFORMAT NSI1F(%BYTEINTEGER FN,SUFL,ST,SS,FLAG,UFLAG, %C %RECORD(ITPF) ITP) %RECORDFORMAT NSI2F(%BYTEINTEGER FN,SUFL,ST,SS,FLAG,UFLAG, %C %RECORD(RJEF) RJE) %RECORDFORMAT MEF(%RECORD(MEF)%NAME LINK,%BYTEINTEGER LEN,TYPE, %C %RECORD(NSI1F) NSL) %RECORDFORMAT ME2F(%RECORD(ME2F)%NAME LINK,%BYTEINTEGER LEN,TYPE, %C %RECORD(NSI2F) NSL) %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,FN,PORT, %C %RECORD(MEF)%NAME MES,%BYTEINTEGER LEN,S1) %RECORDFORMAT P2F(%BYTEINTEGER SERVICE,REPLY,FN,PORT,%RECORD(ME2F)%NAME MES, %C %BYTEINTEGER LEN,S1) %RECORDFORMAT P3F(%BYTEINTEGER SERVICE,REPLY,FN,PORT,FACILITY,FLAG,NODE,TERM) %RECORD(PF) P; %RECORD(P2F)%NAME P2; %RECORD(P3F)%NAME P3 %RECORD(RJEF)%NAME BLOCK %RECORD(ITPF)%NAME FRAME %CONSTRECORD(MEF)%NAME NULL=0 %CONSTINTEGER TT=0,LO=1,CR=2,LP=3,PP=6,BT=7 %OWNINTEGER NODE, TERM, STRM %RECORDFORMAT HOSTF(%INTEGER NUMBER, %C %INTEGERARRAY PORT(CR:LP),STATUS(LO:LP), %C %INTEGER CR COUNT,CR K,LP COUNT,LP K, NODE) %RECORDFORMAT STRDF(%INTEGER A,B,C,D,%RECORD(XF) FILE,%INTEGER E,F,G,H) %RECORDFORMAT STRPF(%RECORD(STRDF)%NAME STRD) %RECORD(STRDF)%NAME STRD %RECORDFORMAT D1F(%INTEGER X); %RECORD(D1F) D1 %RECORDFORMAT D2F(%RECORD(STRPF)%NAME X); %RECORD(D2F)%NAME D2 %RECORD(XF)%NAME FILE %RECORD(XF) LP BASE FILE, CR FILE %OWNINTEGER MAX HOST=2 %RECORD(HOSTF) HOST %CONSTBYTEINTEGERARRAY SPOOL BASE(0:5)='V','L','P','0','0','0' %CONSTBYTEINTEGERARRAY KILL(0:4)=4,'K','I','L','L' %CONSTBYTEINTEGERARRAY STATUS(0:6)=6,'S','T','A','T','U','S' %CONSTBYTEINTEGERARRAY INT(0:3)=3,'I','N','T' %CONSTBYTEINTEGERARRAY FILEN(0:4)=4,'F','I','L','E' %CONSTBYTEINTEGERARRAY PRINTER(0:2)=2,'L','P' %CONSTBYTEINTEGERARRAY FEP(0:2) = 2, 'F', 'E' %CONSTBYTEINTEGERARRAY EMAS NAME(0:5)=4,'E','M','A','S',0 %CONSTBYTEINTEGERARRAY DO ENABLE(0:6) = 6, 'E', 'N', 'A','B','L','E' %CONSTBYTEINTEGERARRAY E2970 NAME(0:5)=4,'2','9','7','0',0 %CONSTBYTEINTEGERARRAY INFO NAME(0:5) = 4, 'I','N','F','O',0 %CONSTBYTEINTEGERARRAY E2980 NAME(0:5) = 4,'2','9','8','0', 0 %CONSTINTEGER EMAS NUMBER=34, E2970 NUMBER=49, INFO NUMBER=156 %CONSTINTEGER E2980T = 80 %BYTEINTEGERARRAYNAME BUFF %CONSTBYTEINTEGERNAME ID=K'160030', GATE INT=K'100060' %OWNINTEGER SETBFLAG, BINFLAG %CONSTINTEGER SET PR = 13; ! PAPER TAPE READER STREAM %CONSTINTEGER MAX COM = 5 %SWITCH SW(0:MAX COM) %CONSTSTRING (3) %ARRAY COMS(0:MAX COM) = ' ', 'TT', 'OP', 'CR', 'LP', 'SM' %OWNSTRING (3) NEW = ' ' %OWNBYTEINTEGERARRAY LINE(0:119) %OWNINTEGER TT PORT=-1 %OWNINTEGER LPTR,GOOD TEXT,GAH CT,TT HOST,TT STATE,LINE LENGTH,I,J %OWNINTEGER NO OF FILES,GARBAGE,CR TIMER,OP STRM %CONSTINTEGER TT SER=1, GATE SER=16, BUFFER MANAGER=17 %CONSTINTEGER RD=0, ECHO OFF=10 %CONSTINTEGER REQUEST BUFFER=0, RELEASE BUFFER=1 %CONSTINTEGER ENABLE FACILITY=1, DISABLE FACILITY=2, CALL REPLY=3 %CONSTINTEGER ENABLE INPUT=4, PUT OUTPUT=5, CLOSE CALL=6 %CONSTINTEGER ABORT CALL=7, OPEN CALL=8, OPEN MESSAGE=9 %CONSTINTEGER OPEN CALL REPLY=1, INCOMING CALL=2, INPUT RECD=3 %CONSTINTEGER OUTPUT TRANSMITTED=4, CALL CLOSED=5, CALL ABORTED=6 %CONSTINTEGER OPEN REPLY A=7, OPEN REPLY B=8, MESSAGE IN=9, MESSAGE REPLY=10 %CONSTINTEGER ITP HELLO=1, ITP GAH=2, ITP MESS=3, ITP INT=4, RJE LOGON=5 %CONSTINTEGER RJE LOGOFF=6, CR DATA=7, SOCIAL CALL=8 %CONSTINTEGER ACCEPT=X'22', REJECT=0 %CONSTINTEGER IDLE=0, STARTING=1, RUNNING=2, OPENED=3, STOPPING=4, STOPPING2=5 %CONSTINTEGER CLOSED=6 %CONSTSTRING(9)%ARRAY STAT(0:6)='IDLE','STARTING', 'RUNNING', 'ENABLED', 'STOPPING'(2), 'RUNNING' %CONSTINTEGER BUFFER SIZE=230 %OWNBYTEINTEGERARRAY BUFFER(0:230) %OWNINTEGER CR STRM %OWNINTEGER CR GET %OWNINTEGER CR PUT %OWNINTEGER CR END %OWNINTEGER CR LEN POSN %OWNINTEGER PEND GAH = 0 %OWNINTEGER TARGET NODE = 1; ! CHANGED IF NOT ON NODE 1 (EMAS ACCESS) %PREDICATESPEC MATCH(%BYTEINTEGERARRAYNAME MASTER) %INTEGERFNSPEC EXIST(%INTEGER STREAM, %RECORD (XF) %NAME FILE) %ROUTINE TO TT(%INTEGER FN) %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%BYTEINTEGERARRAYNAME %C A2,%INTEGER A3) %RECORD(PF) P P_SERVICE=TT SER; P_REPLY=ID P_A1=FN; P_A2==LINE; P_A3=120 PON(P) %END %ROUTINE MESSAGE(%INTEGER DEV,%STRING(23) MES) %INTEGER I %CONSTSTRING(2)%ARRAY DEVS(TT:BT)='TT','LO','CR','LP','LP','??','PP','BT' PRINT STRING(DEVS(DEV)); PRINT SYMBOL(':') PRINT STRING(MES) %END %INTEGERFN READ ADDRESS !! USES GLOBALS NODE, TERM AND STRM %INTEGER K %INTEGERFN SIG LPTR = LPTR+1 %WHILE LINE(LPTR)=' ' %RESULT = LINE(LPTR) %END %INTEGERFN R NUM %INTEGER J, N N=0 %CYCLE J=LINE(LPTR) %UNLESS '0' <= J <= '9' %THEN %RESULT = N LPTR = LPTR+1 N = N*10+J-'0' %REPEAT %END NODE = TARGET NODE; ! USUALLY ZERO %IF MATCH(EMAS NAME) %START TERM = EMAS NUMBER ADD NODE: NODE = TERM %RESULT = 1 %FINISH %IF MATCH(E2970NAME) %THEN TERM=E2970NUMBER %AND ->ADD NODE %IF MATCH(INFO NAME) %THEN TERM=INFO NUMBER %AND ->ADD NODE %IF MATCH(E2980 NAME) %START TERM = E2980T; ->ADD NODE %FINISH NODE = 0; ! DEPENDS ON USER SPECIFING K = SIG; LPTR = LPTR+1 %IF K = 'N' %START; ! SPECIFY NODE NUMBER NODE = RNUM K = LINE(LPTR); LPTR = LPTR+1 %FINISH %RESULT = 0 %UNLESS K='T' TERM = RNUM; K=LINE(LPTR); LPTR=LPTR+1 %IF K='S' %START STRM = RNUM; K=LINE(LPTR); LPTR=LPTR+1 %FINISH %RESULT = 0 %UNLESS K = ' ' LPTR = LPTR-1 %RESULT = 1 %END %PREDICATE MATCH(%BYTEINTEGERARRAYNAME MASTER) %INTEGER I LPTR=LPTR+1 %WHILE LINE(LPTR)=' ' %CYCLE I=1,1,MASTER(0) %FALSE %IF LINE(LPTR+I-1)#MASTER(I) %REPEAT LPTR=LPTR+I %TRUE %END %ROUTINE SET STREAM(%INTEGER STREAM,%RECORD(XF)%NAME FILE) %CONSTINTEGERARRAY DISC(0:3)=3,3,8,14 %OWNRECORD (STRDF) %NAME STRD5 D1_X=K'160032'+STREAM<<1 %IF D2_X_STRD == NULL %THEN D2_X_STRD == STRD5 STRD == D2_X_STRD %IF FILE_UNIT=255 %START; ! DUMMY STRD5 == STRD; ! REMEBER ITS ADDRESS D2_X_STRD == NULL; ! NULL STREAM %RETURN %FINISH STRD_A=0; STRD_B=2; STRD_C=0; STRD_D=ID<<8!DISC(FILE_UNIT) STRD_FILE=FILE; STRD_E=0; STRD_F=0; STRD_G=0; STRD_H=K'172' %END %ROUTINE PRINT COUNT(%INTEGER K,UNITS) PRINT SYMBOL(',') WRITE(K,0) %AND PRINT STRING('K +') %IF K>0 WRITE(UNITS,0); PRINT STRING(' CHARS') %END %ROUTINE PRINT FILE(%INTEGER STREAM) %INTEGER I,J %RECORD(XF)%NAME FILE D1_X=K'160032'+STREAM<<1 %IF D2_X_STRD == NULL %THEN PRINTSTRING(".NULL ") %AND %RETURN FILE==D2_X_STRD_FILE PRINT SYMBOL(FILE_UNIT+'0'); PRINT SYMBOL('.') %CYCLE I=0,1,5 J=FILE_FNAME(I); %EXIT %IF J=' ' PRINT SYMBOL(J) %REPEAT PRINT SYMBOL('('); PRINT SYMBOL(FILE_FSYS>>3+'0') PRINT SYMBOL(FILE_FSYS&7+'0'); PRINT SYMBOL(')') %END %ROUTINE SET CR FILE %CYCLE PROMPT("CR FILE:") SKIPSYMBOL %IF NEXTSYMBOL=NL %IF NEXTSYMBOL='.' %START SKIPSYMBOL %IF NEXTSYMBOL='T' %START SKIPSYMBOL; SKIPSYMBOL; SKIPSYMBOL CR FILE_UNIT = 255 SET B FLAG = 0; ! ALLWAYS IN ISO %RETURN %FINISH %FINISH %IF EXIST(1, CR FILE) = 1 %THEN %EXIT %REPEAT SET STREAM(1, CR FILE) %END %ROUTINE READ BUFFER %INTEGER GET,PUT,LIMIT,NL POSN,CHAR,LEN POSN,I,F %ROUTINE BUMP I=I+1 PUT=PUT+1 PUT=0 %IF PUT = BUFFER SIZE %END PUT=CR PUT; GET=CR GET NL POSN=-1; F=0 LEN POSN=CR LEN POSN I=BUFFER(LEN POSN) SELECT INPUT(1) %UNLESS CR FILE_UNIT = 255 %CYCLE READSYMBOL(CHAR) %IF (SET B FLAG=0 %AND CHAR=4) %OR CHAR<0 %START NO OF FILES = NO OF FILES-1 %IF NO OF FILES > 0 %START; ! MORE TO GO MESSAGE(CR, 'FILE DONE SELECT INPUT(0) SET BFLAG = BIN FLAG SET CR FILE SELECT INPUT(1) %UNLESS CR FILE_UNIT=255 %CONTINUE; ! GET NEXT SYMBOL %FINISH HOST_STATUS(CR)=STOPPING %IF F=0 PUT=-1 %EXIT %FINISH F = 1; ! CHARACTER PLANTED THIS TIME ROUND BUFFER(PUT)=CHAR NL POSN=PUT %IF CHAR=NL %OR CHAR=12 %OR CHAR=13 BUMP %IF CHAR=10 %OR CHAR=12 %OR CHAR=13 %START INSERT: BUFFER(LEN POSN)=I I=I+HOST_CR COUNT I=I-1024 %AND HOST_CR K=HOST_CR K+1 %IF %C I>=1024 HOST_CR COUNT=I BUFFER(PUT)=X'80'; BUMP LEN POSN=PUT; BUMP I=0 %FINISH %EXIT %IF PUT<=GET %AND PUT+5>GET %EXIT %IF PUT>GET %AND PUT+5-BUFFER SIZE>GET %REPEAT %IF NL POSN = -1 %START %IF PUT = 0 %THEN NL POSN = BUFFER SIZE-1 %ELSE %C NL POSN = PUT-1 -> INSERT %FINISH CR END=NL POSN; CR PUT=PUT CR LEN POSN=LEN POSN; BUFFER(LEN POSN)=I SELECT INPUT(0) %END %ROUTINE FILL BUFFER %INTEGER GET,END,LIMIT,I,J GET=CR GET; END=CR END HOST_STATUS(CR)=STOPPING %IF CR PUT=-1 %CYCLE I=0,1,BUFFER SIZE-1 BLOCK_DATA(I)=BUFFER(GET) J=GET; GET=GET+1 GET=0 %IF GET = BUFFER SIZE %EXIT %IF J=END %REPEAT P_MES_LEN=I+7 CR GET=GET %END %INTEGERFN EXIST(%INTEGER STREAM,%RECORD(XF)%NAME FILE) %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1, %C %RECORD(XF)%NAME A2,%INTEGER A3) %RECORD(PF) P %CONSTINTEGERARRAY DIRT(0:3)=4,4,9,15 %IF READ FNAME(FILE) %START P_SERVICE=DIRT(FILE_UNIT); P_REPLY=ID P_A1=0; P_A2==FILE; P_A3=0 PONOFF(P) %RESULT=1 %IF P_A1#0 %FINISH MESSAGE(CR,'NO FILE'); NEWLINE %RESULT=0 %END %ROUTINE GET BUFFER(%INTEGER REASON) P_SERVICE=BUFFER MANAGER; P_REPLY=ID P_FN=REQUEST BUFFER; P_LEN=0; P_S1=REASON PON(P) %END %ROUTINE FREE BUFFER(%RECORD(MEF)%NAME MES) P_SERVICE=BUFFER MANAGER; P_REPLY=ID P_FN=RELEASE BUFFER; P_MES==MES PON(P) %END %ROUTINE CONNECT(%INTEGER HOST NO,FACILITY) P3_SERVICE=GATE SER; P3_REPLY=ID P3_FN=OPEN CALL; P3_PORT=1; P3_FACILITY=FACILITY P3_FLAG=X'48'; P3_NODE=NODE; P3_TERM=HOST NO P3_TERM=48 %IF P3_TERM=34 %AND P3_FACILITY=18 PON(P) %END %ROUTINE TO GATE(%INTEGER FN,%RECORD(MEF)%NAME MES,%INTEGER FLAG) P_SERVICE=GATE SER; P_REPLY=ID P_FN=FN; P_MES==MES; P_S1=FLAG PON(P) %END %ROUTINE DO ITP %INTEGER I %RETURN %IF TT STATE=STOPPING FRAME==P_MES_NSL_ITP GAH CT=GAH CT+1 %IF FRAME_HB1&2#0 TT STATE=STOPPING %AND TO GATE(ABORT CALL,P_MES,0) %IF FRAME_HB1&4#0 %IF FRAME_HB1&1=1 %START ! %IF FRAME_HB2&2#0 %AND FRAME_LEN=1 %AND FRAME_DATA(0)=0 %THEN %C ! TO TT(ECHO OFF) %IF FRAME_HB2&4#0 %THEN GOOD TEXT=8 %IF FRAME_HB2&8#0 %THEN GARBAGE=1 %RETURN %FINISH GARBAGE=0 %IF GARBAGE=1 %AND FRAME_HB2&8#0 %IF GARBAGE=0 %START PRINT SYMBOL(FRAME_DATA(I)) %FOR I=0,1,FRAME_LEN-1 %IF FRAME_HB2&4=0 %THEN GET BUFFER(ITP GAH) %C %ELSE PROMPT('') %AND TT STATE=OPENED %ELSE %IF FRAME_HB2&4=0 %STARPUT=5, CLOSE CALL=6 %CONSTINTEGER ABORT CALL=7, OPEN CALL=8, OPEN MESSAGE=9 %CONSTINTEGER OPEN CALL REPLY=1, INCOMING CALL=2, INPUT RECD=3 %CONSTINTEGER OUTPUT TRANSMITTED=4, CALL CLOSED=5, CALL ABORTED=6 %CONSTINTEGER OPEN REPLY A=7, OPEN REPLY B=8, MESSAGE IN=9, MESSAGE REPLY=10 %CONSTINTEGER ITP HELLO=1, ITP GAH=2, ITP MESS=3, ITP INT=4, RJE LOGON=5 %CONSTINTEGER RJE LOGOFF=6, CR DATA=7, SOCIAL CALL=8 %CONSTINTEGER ACCEPT=X'22', REJECT=0 %CONSTINTEGER IDLE=0, STARTING=1, RUNNING=2, OPENED=3, STOPPING=4, T GET BUFFER(ITP GAH) %FINISH %END %ROUTINE FROM GATE %INTEGER I,J,K,L %SWITCH SW(OPEN CALL REPLY:MESSAGE REPLY) ->SW(P_FN) SW(OPEN CALL REPLY):%RETURN SW(INCOMING CALL): %IF HOST_STATUS(LP)=OPENED %START HOST_PORT(LP)=P_PORT MESSAGE(P3_FACILITY,'STARTING ') P_LEN=16 %IF P_LEN=0 TO GATE(CALL REPLY,NULL,P_LEN) HOST_STATUS(LP)=RUNNING SET STREAM(5,LP BASE FILE) J=LP BASE FILE_FNAME(5)+1 %IF J>'9' %START K=LP BASE FSTOPPING2=5 %CONSTINTEGER CLOSED=6 %CONSTSTRING(9)%ARRAY STAT(0:6)='IDLE','STARTING', 'RUNNING', 'ENABLED', 'STOPPING'(2), 'RUNNING' %CONSTINTEGER BUFFER SIZE=230 %OWNBYTEINTEGERARRAY BUFFER(0:230) %OWNINTEGER CR STRM %OWNINTEGER CR GET %OWNINTEGER CR PUT %OWNINTEGER CR END %OWNINTEGER CR LEN POSN %OWNINTEGER PEND GAH = 0 %OWNINTEGER TARGET NODE = 1; ! CHANGED IF NOT ON NODE 1 (EMAS ACCESS) %PREDICATESPEC MATCH(%BYTEINTEGERARRAYNAME MASTER) %INTEGERFNSPEC EXIST(%INTEGER STREAM, %RECORD (XF) %NILE_FNAME(4)+1 %IF K>'4' %START LP BASE FILE_FSYS=LP BASE FILE_FSYS+1 K='0' %FINISH LP BASE FILE_FNAME(4)=K J='0' %FINISH LP BASE FILE_FNAME(5)=J HOST_LP COUNT=0; HOST_LP K=0 PRINT FILE(5); NEWLINE %RETURN %FINISH TO GATE(CALL REPLY,NULL,REJECT) %RETURN SW(INPUT RECD): TO GATE(ENABLE INPUT,P_MES,0) %UNLESS P_MES_NSL_FLAG&128#0 %IF P_PORT=TT PORT %THEN DO ITP %ELSE %START I=1 %IF P_PORT=HOST_PORT(LP) %START SELECT OUTPUT(1) K=0; BUFF==P2_MES_NSL_RJE_DATA L=P2_MES_NSL_UFLAG %UNTIL K+6>=P_MES_LEN %CYCLE %IF BUFF(K)>127 %THEN K=K+1 J=BUFF(K) %CYCLE K=K+1,1,K+J PRINT SYMBOL(BUFF(K)) %REPEAT J=J+HOST_LP COUNT J=J-1024 %AND HOST_LP K=HOST_LP K+1 %IF %C J>=1024 HOST_LP COUNT=J K=K+1 %REPEAT SELECT OUTPUT(0) %FINISH %FINISH FREE BUFFER(P_MES) %RETURN SW(OUTPUT TRANSMITTED): %IF P_PORT=HOST_PORT(CR) %START %IF HOST_STATUS(CR)=STOPPING %START TO GATE(CLOSE CALL,NULL,0) HOST_STATUS(CR)=STOPPING2 %ELSE P_PORT=1 GET BUFFER(CR DATA) %FINISH %RETURN %FINISH %IF P_PORT = TT PORT %AND PEND GAH#0 %START !! SEND A GO AHEAD GET BUFFER(ITP GAH) PEND GAH = PEND GAH-1 %FINISH %RETURN SW(CALL CLOSED): %IF P_PORT=TT PORT %START TO GATE(CLOSE CALL,NULL,0) %UNLESS TT STATE=STOPPING MESSAGE(TT,'CLOSED'); NEWLINE TT STATE=IDLE; TT PORT=-1 %RETURN %FINISH %IF P_PORT=HOST_PORT(LP) %START TO GATE(CLOSE CALL,NULL,0) MESSAGE(LP,'FINISHED') PRINT COUNT(HOST_LP K,HOST_LP COUNT) NEWLINE %IF HOST_STATUS(LP)=CLOSED %THEN HOST_STATUS(LP)=IDLE %C %ELSE HOST_STATUS(LP)=OPENED; HOST_PORT(LP)=-1 SELECT OUTPUT(1); CLOSE OUTPUT SET STREAM(1+4,LP BASE FILE); ! FRIG TO GET ROUND PERM FAULT %RETURN %FINISH %IF P_PORT=HOST_PORT(CR) %AND HOST_STATUS(CR)=STOPPING2 %START MESSAGE(CR,'FINISHED') PRINT COUNT(HOST_CR K,HOST_CR COUNT) NEWLINE HOST_STATUS(CR)=IDLE; HOST_PORT(CR)=-1 %RETURN %FINISH %RETURN SW(CALL ABORTED): %IF P_PORT=TT PORT %START TO GATE(ABORT CALL,NULL,0) %UNLESS TT STATE=STOPPING MESSAGE(TT,'ABORTED'); NEWLINE TT STATE=IDLE; TT PORT=-1 %RETURN %FINISH %CYCLE J=CR,1,LP %IF P_PORT=HOST_PORT(J) %START TO GATE(ABORT CALL,NULL,0) MESSAGE(J,'ABORTED'); NEWLINE HOST_STATUS(J)=IDLE; HOST_PORT(J)=-1 SELECT OUTPUT(1) %AND CLOSE OUTPUT %IF J=LP %RETURN %FINISH %REPEAT %RETURN SW(OPEN REPLY A): %IF P3_FACILITY=18 %THEN TT PORT=P_S1 %ELSE HOST_PORT(CR)=P_S1 %RETURN SW(OPEN REPLY B): %IF P_PORT=TT PORT %START %IF P_S1#0 %START MESSAGE(TT,'CONNECT FAILS'); WRITE(P_S1,0); NEWLINE TT STATE=IDLE; TT PORT=-1 TO TT(RD) %ELSE MESSAGE(TT,'CONNECTED'); NEWLINE TT STATE=RUNNING GET BUFFER(ITP HELLO) PEND GAH = 3 %FINISH %RETURN %FINISH %IF P_PORT=HOST_PORT(CR) %START %IF P_S1#0 %START ALARM(100) %AND %RETURN %IF CR TIMER=1 MESSAGE(CR,'CONNECT FAILS'); WRITE(P_S1,0); NEWLINE %IF CR TIMER=0 %AND CR STRM#SET PR %START MESSAGE(CR,'WILL KEEP TRYING'); NEWLINE ALARM(100); CR TIMER=1 %ELSE HOST_STATUS(CR)=IDLE; HOST_PORT(CR)=-1 %FINISH %ELSE MESSAGE(CR,'CONNECTED'); NEWLINE HOST_CR COUNT=0; HOST_CR K=0 P_PORT=1 SET B FLAG = BIN FLAG %BEGIN %CONSTBYTEINTEGERNAME ID = K'160030' %CONSTINTEGERNAME NULLI=0 %CONSTINTEGER DREAD=0, DWRITE=1 %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, %C %INTEGERNAME A2, %INTEGER A3) %INTEGER I, J, K, L, M, DRIVE %RECORD (PF)P %INTEGERARRAY BUFF(0:256) PROMPT('Copies Floppy Bootstrap Block Unit 0 to Unit 1 PLEASE CONFIRM?') READSYMBOL(I) DRIVE=K'020000'; ! UNIT ONE %IF I#'Y' %THEN %STOP P_SERVICE=3; P_REPLY = ID P_A1=0; P_A2==NULLI PONOFF(P) %IF P_A1#9 %START PRINTSTRING('DISC TURN OFF CHECK ERROR '); WRITE(P_A1, 1); NEWLINE %STOP %FINISH P_SERVICE=3; P_REPLY=ID P_A1=0; P_A2==NULLI P_A3=K'020000' PONOFF(P) %IF P_A1#9 %START PRINTSTRING("UPPER CHECK FAILS %STOP %FINISH %CYCLE I = 0, 1, 13 P_SERVICE=3; P_REPLY=ID P_A1=DREAD; ! READ ONE BLOCK P_A2==BUFF(0) P_A3=I; ! BLOCK PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC ERROR %STOP %FINISH P_A2==BUFF(0) P_A1=DWRITE P_A3=I!DRIVE P_SERVICE=3; P_REPLY=ID PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC WRITE ERROR %STOP %FINISH %REPEAT %ENDOFPROGRAM SET CR FILE J=0 CR GET=0 BUFFER(0)=X'80'; BUFFER(1) = 0 CR LEN POSN=1; CR PUT=2 GET BUFFER(CR DATA) READ BUFFER HOST_STATUS(CR)=RUNNING CR TIMER=0 %FINISH TO TT(RD) %RETURN %FINISH %RETURN SW(MESSAGE IN): BUFF==P2_MES_NSL_RJE_DATA I=P2_MES_NSL_ST WRITE(I,1) PRINT SYMBOL(':') K=BUFF(3) I=4 %UNTIL I+6>=P_MES_LEN %CYCLE SPACES(3) %UNLESS I=4 %IF BUFF(I)>127 %THEN I=I+1; J=BUFF(I) %CYCLE I=I+1,1,I+J L=BUFF(I) PRINT SYMBOL(L) %REPEAT NEWLINE %UNLESS L=NL; I=I+1 %REPEAT TO GATE(CALL REPLY,P_MES,128) %RETURN SW(MESSAGE REPLY): ! GATE VSN 3 ONWARDS PRINTSTRING("SM:"); WRITE(P2_MES_NSL_SUFL, 3); NEWLINE FREE BUFFER(P2_MES) %END %ROUTINE FROM BUFFER MANAGER %INTEGER I,J %RECORD (ME2F) %NAME MES %SWITCH SW(ITP HELLO:SOCIAL CALL) MES == P_MES FRAME==P_MES_NSL_ITP; FRAME_CNSL=0 BLOCK==MES_NSL_RJE ->SW(P_S1) SW(ITP HELLO): FRAME_HB1=8; FRAME_HB2=0; FRAME_LEN=LINE LENGTH-3 FRAME_DATA(I)=LINE(I+3) %FOR I=0,1,FRAME_LEN-1 P_MES_LEN=10+FRAME_LEN TO TT(RD) ->END SW(ITP GAH): FREE BUFFER(P_MES) %AND %RETURN %IF TT STATE=IDLE %ORC TT STATE=STOPPING FRAME_HB1=3; FRAME_HB2=0; FRAME_LEN=0; P_MES_LEN=10 ->END SW(ITP MESS): %IF GAH CT>0 %THEN GAH CT=GAH CT-1 %ELSE %START MESSAGE(TT,'NO GAH'); NEWLINE FREE BUFFER(P_MES) TO TT(RD) %RETURN %FINISH FRAME_HB1=0; FRAME_HB2=2+GOOD TEXT; FRAME_LEN=LINE LENGTH+1 GOOD TEXT=0 FRAME_DATA(I)=LINE(I) %FOR I=0,1,LINE LENGTH-2 FRAME_DATA(I+1)=13; FRAME_DATA(I+2)=10 P_MES_LEN=10+FRAME_LEN TT STATE=RUNNING P_PORT=TT PORT TO TT(RD) ->END SW(ITP INT): FRAME_HB1=1; FRAME_HB2=1 LPTR=LPTR+1 %WHILE LINE(LPTR)=' ' FRAME_LEN=LINE LENGTH-LPTR-1 FRAME_DATA(I)=LINE(LPTR+I) %FOR I=0,1,FRAME_LEN-1 P_MES_LEN=I+11 P_PORT=TT PORT TO TT(RD) ->END SW(SOCIAL CALL): BLOCK_DATA(I+4)=LINE(LPTR+I) %FOR I=1,1,LINE LENGTH-LPTR-1 BLOCK_DATA(3)=5; BLOCK_DATA(4)=LINE LENGTH-LPTR-1 I=P_PORT; P_PORT=0; P3_NODE=NODE BLOCK_DATA(1) = STRM MES_LEN=10+LINE LENGTH-LPTR TO GATE(OPEN MESSAGE,P_MES,I) TO TT(RD) %RETURN SW(CR DATA): FILL BUFFER %IF SETBFLAG=0 %THEN P2_MES_NSL_UFLAG=5 %ELSE %C P2_MES_NSL_UFLAG = 1 P_PORT=HOST_PORT(CR) TO GATE(PUT OUTPUT,P_MES,0) READ BUFFER %RETURN END: TO GATE(PUT OUTPUT,P_MES,0) %END %INTEGERFN DO TT %INTEGER I %IF MATCH(STATUS) %START MESSAGE(TT,STAT(TT STATE)); NEWLINE %RESULT=1 %FINISH %IF TT STATE=IDLE %START I=1 %IF READ ADDRESS#0 %START TT HOST = TERM CONNECT(TT HOST,18) TT STATE=STARTING %RESULT=2 %FINISH %ELSE %IF TT STATE#STARTING %START %IF MATCH(INT) %START GET BUFFER(ITP INT) %RESULT=2 %FINISH %IF MATCH(KILL) %START P_PORT=TT PORT TO GATE(ABORT CALL,NULL,0) %UNLESS TT STATE=STOPPING TT STATE=STOPPING %RESULT=1 %FINISH %FINISH %RESULT=0 %END %INTEGERFN DO OP(%INTEGER STREAM) %INTEGER I STRM = STREAM %IF MATCH(DO ENABLE) %START; ! ENABLE MESSAGES FROM GATE TO GATE(ENABLE FACILITY, NULL, 1) TO GATE(ENABLE FACILITY, NULL, 2) TO GATE(ENABLE FACILITY, NULL, 4) %RESULT = 1 %FINISH %IF READ ADDRESS # 0 %START P_PORT=TERM GET BUFFER(SOCIAL CALL) %RESULT=2 %FINISH %RESULT=0 %END %INTEGERFN DO CR %INTEGER I %CONSTBYTEINTEGERARRAY FILESX(0:6) = 5, 'F','I','L','E','S',0 %CONSTBYTEINTEGERARRAY BINX(0:7) = 6, 'B','I','N','A','R','Y',0 %IF MATCH(STATUS) %START MESSAGE(CR,STAT(HOST_STATUS(CR))) %IF HOST_STATUS(CR)=RUNNING %START PRINT COUNT(HOST_CR K,HOST_CR COUNT) PRINT STRING(', FROM '); PRINT FILE(1) %FINISH NEWLINE %RESULT=1 %FINISH %IF HOST_STATUS(CR)=IDLE %START %RESULT = 0 %IF READ ADDRESS=0 HOST_NUMBER = TERM; HOST_NODE = NODE BIN FLAG = 0 %IF MATCH(BINX) %THEN BIN FLAG = 1 %IF MATCH(PRINTER) %THEN CR STRM=4 %ELSE %START %IF MATCH(FEP) %THEN CR STRM = 9 %ELSE %START CR STRM=SET PR %FINISH %FINISH %IF MATCH(FILESX) %START NO OF FILES = LINE(LPTR+1)-'0' %ELSE NO OF FILES = 1 CONNECT(TERM,CR STRM) HOST_STATUS(CR)=STARTING %RESULT=2 %FINISH %RESULT=0 %END %INTEGERFN DO LP %INTEGER I,J %CONSTBYTEINTEGERARRAY NULLA(0:5) = 4, 'N','U','L','L',0 %IF MATCH(STATUS) %START I=1 MESSAGE(LP,STAT(HOST_STATUS(LP))) %UNLESS CLOSED#HOST_STATUS(LP)#RUNNING %START PRINT COUNT(HOST_LP K,HOST_LP COUNT) PRINT STRING(', TO '); PRINT FILE(I+4) %FINISH NEWLINE %RESULT=1 %FINISH %IF MATCH(NULLA) %START LP BASE FILE_UNIT = 255 %RESULT = 1 %FINISH %IF MATCH(FILEN) %START PROMPT('LP BASE FILE:') %UNTIL READ FNAME(LP BASE FILE) LP BASE FILE_FNAME(4)='0'; LP BASE FILE_FNAME(5)='0' %RESULT=1 %FINISH I=1 %IF MATCH(DO ENABLE) %START J=HOST_STATUS(LP) %IF J=IDLE %OR J=CLOSED %START MESSAGE(LP,'ENABLED') %IF J=IDLE %THEN J=OPENED %ELSE J=RUNNING %ELSE MESSAGE(LP,'DISABLED') %IF J=RUNNING %THEN J=CLOSED %ELSE J=IDLE %FINISH HOST_STATUS(LP)=J NEWLINE %RESULT=1 %FINISH %RESULT=0 %END P2==P; P3==P D2==D1 LP BASE FILE_UNIT=0; LP BASE FILE_FSYS=K'16' LP BASE FILE_FNAME(I)=SPOOL BASE(I) %FOR I=0,1,5 %CYCLE J=CR,1,LP HOST_PORT(J)=-1; HOST_STATUS(J)=IDLE %REPEAT MAP VIRT(BUFFER MANAGER,5,4) MAP VIRT(BUFFER MANAGER,6,5) TO GATE(ENABLE FACILITY,NULL,9) TO GATE(ENABLE FACILITY, NULL, 6); ! PP TO GATE(ENABLE FACILITY, NULL, 7); ! BT ! TO TT(11); ! ONLY WITH GJB TT HANDLER TO TT(RD) PRINTSTRING(" LP:ENABLED SM:DISABLED HOST_STATUS(LP) = OPENED %CYCLE P_SERVICE=0; POFF(P) %IF P_REPLY=GATE SER %START FROM GATE %ELSE %IF P_REPLY =BUFFER MANAGER %START FROM BUFFER MANAGER %ELSE %IF P_REPLY=TT SER %START LINE LENGTH=0 LINE LENGTH=LINE LENGTH+1 %WHILE LINE(LINE LENGTH)#NL LINE LENGTH=LINE LENGTH+1 LPTR=3 %IF LINE(2)='/' %START I=0 CHARNO(NEW, 1) = LINE(0); CHARNO(NEW, 2) = LINE(1) %CYCLE J = 1, 1, MAX COM ->SW(J) %IF COMS(J) = NEW %REPEAT ->BOT SW(1): ! TT I=DO TT ->BOT SW(2): ! OP I = DO OP(11) ->BOT SW(3): ! CR I = DO CR; -> BOT SW(4): ! LP I = DO LP; -> BOT SW(5): ! SM (SEND MESSAGE) I = DO OP(2); ->BOT BOT: TO TT(RD) %IF I=1 %CONTINUE %IF I>0 %FINISH %IF TT STATE=OPENED %THEN GET BUFFER(ITP MESS) %ELSE %START MESSAGE(TT,'INVALID'); NEWLINE TO TT(RD) %FINISH %ELSE CONNECT(HOST_NUMBER,CR STRM) %FINISH %REPEAT !MAP VIRT(GATE SER,7,4) !GATE INT='D' !TO TT(12) %ENDOFPROGRAM MESSAGE(TT,'INVALID'); NEWLINE %EXTERNALROUTINE READX(%INTEGERNAME X) %INTEGER SIGN SKIP SYMBOL %WHILE NEXT SYMBOL=' ' %OR NEXT SYMBOL=NL %IF NEXT SYMBOL='-' %THEN SIGN=-1 %AND SKIP SYMBOL %ELSE SIGN=1 PRINT STRING('F A U L T -73') %AND NEWLINE %AND %C %STOP %UNLESS '0'<=NEXT SYMBOL<='9' X=0 %UNTIL NEXT SYMBOL<'0' %OR NEXT SYMBOL>'9' %CYCLE X=10*X+NEXT SYMBOL-'0' SKIP SYMBOL %REPEAT X=SIGN*X %END %RECORDFORMAT XF(%BYTEINTEGER UNIT,FSYS,%BYTEINTEGERARRAY FNAME(0:5), %C %BYTEINTEGER SCR) %EXTERNALPREDICATE READ FNAME(%RECORD(XF)%NAME FILE) %INTEGER UNIT,FSYS,I %INTEGERARRAY FNAME(0:5) %CONSTBYTEINTEGERNAME DF=K'160055' SKIP SYMBOL %WHILE NEXT SYMBOL=' ' %IF '0'<=NEXT SYMBOL<='3' %START UNIT=NEXT SYMBOL-'0'; SKIP SYMBOL ->FALSE %UNLESS NEXT SYMBOL='.' SKIP SYMBOL %FINISH %ELSE UNIT=0 ->FALSE %UNLESS 'A'<=NEXT SYMBOL<='Z' FNAME(I)=' ' %FOR I=0,1,5 %WHILE 'A'<=NEXT SYMBOL<='Z' %OR '0'<=NEXT SYMBOL<='9' %CYCLE FNAME(I)=NEXT SYMBOL %IF I<6; SKIP SYMBOL I=I+1 %REPEAT %IF NEXT SYMBOL='(' %START SKIP SYMBOL ->FALSE %UNLESS '0'<=NEXT SYMBOL<='9' FSYS=NEXT SYMBOL-'0'; SKIP SYMBOL FSYS=8*FSYS+NEXT SYMBOL-'0' %AND SKIP SYMBOL %IF '0'<=NEXT SYMBOL<='9' ->FALSE %IF NEXT SYMBOL#')'; SKIP SYMBOL %FINISH %ELSE FSYS=DF SKIP SYMBOL %WHILE NEXT SYMBOL=' ' ->FALSE %UNLESS NEXT SYMBOL=NL SKIP SYMBOL FILE_UNIT=UNIT; FILE_FSYS=FSYS FILE_FNAME(I)=FNAME(I) %FOR I=0,1,5 %TRUE FALSE:SKIP SYMBOL %UNTIL NEXT SYMBOL=NL SKIP SYMBOL %FALSE %END %ENDOFFILE ABORT(4); ISTATE = 10 %CONTINUE SW(PUT UP): ! ALLOW IT UP AGAIN %IF INPUT EXP = 0 %THEN ASK FOR BUFFER ISTATE = INIT(SECONDARY) REINITIALISE; ! GRAB INTERRUPTS AND RESET DEVICE ! MAY HAVE BEEN DOWN LINE LOADED %CONTINUE SW(MONIT): INT = '?' %REPEAT %ENDOFPROGRAM C=UR0+14 UPS=UR0+16 USP=UR0+20 UTRP=UR0+22 ADDERR, 340 .+2,0 BPTINT,340 .+2,0; 20,22 .+2,0; 24,26; POWER SVC,340; EMT HANDLER .+2,0 .+2,0 .+2,0 .+2,0; 50,52 .+2,0; 54,56 .=40 INT6BA; FOR USE IN SBLD ONLY .=60 KBINT,340,TTINT,340 .=70; PR AND PP INT PRINT,340 LPINT,340 .=100 TIMINT,340 TIMINT,340; ALLOW FOR BOTH CLOCKS .=120; GRAPH PLOTTER INT GPINT, 340 .=140; DUMP ADDRESS JMP DUMP .=200; LP (REAL) INT LPINT,340 .=220; DISC INT DKINT, 340 .=224; TU16 INT TU16IT,340 .=230; CR INT CRINT,340 .=250; SEGMENTATION TRAP SEGTRP, 340 .=264; FLOPPY DISC INT DKINT, 340; REPLACES RK05 .=270; BIG DISC INT RP4INT, 340 .=300; PL11 #1 (TELETYPE), VEC=175610 KB2INT,340 TT2INT,340 ; PL11 #2 (TEXTTRONIC), VEC = 175620 KB3INT,340 TT3INT,340 ; NB: THIS IS PART OF THE DUP CODE *************** .=360 UBRIS, 340 UBTIS, 340 ; ********* END .=60100; CODE TO TRAP TOP OF REAL STORE CLR @#60110 .PAGE .=1300; LEAVING ROOM FOR SUP STACK RUN: MOV PSECT, R3; GET CURRENT PSECT BEQ IDLE; GO INTO IDLE LOOP MOV R3, R0; PSECT POINTER TO R0 ADD #USP, R0; POINT R0 AT USER SP CMP LASTPS,R3; SAME AS LAST TIME? BEQ NOSER; YES, SO DONT RESTORE SEG REGS MOV R3,LASTPS; MAKE IT TRUE NOW MOV #UPAR,R1; POINT R1 AT USER SEG REGISTER PAR 0 MOV #UPDR,R2; R2 AT PDR 0 MOV #8.,R5; 8 REGISTERS ADD #UPAR0,R3; POINT R3 AT REGS IN PSECT LOOP: MOV (R3)+,(R1)+; SHIFT PAR(N) MOV (R3),(R2)+; PDR(N) ADD #10-2,R3; POINT AT NEXT BLOCK 077505; SOB R5,LOOP; BRACH BACK TILL FINISHED MOV #030340,PS; SET PREVIOUS MODE=USER MOV (R0),-(SP); PLANT ON STACK .WORD 6606; MTPI R6 - SET R16 NOSER: MOV -(R0), -(SP); PLANT PS ON STACK MOV -(R0), -(SP); AND PC MOV -(R0), R5 MOV -(R0),R4 MOV -(R0),R3 MOV -(R0), R2 MOV -(R0), R1 MOV -(R0),R0; RESTORE ALL HIS REGISTERS .WORD 6; RTT; AND EXIT TO HIM IDLE:; IDLE LOOP CLR PS WAIT BR IDLE DPTAB: DPR1TB; NORMAL BRUN = 0 SAVER4: 0 SAVER5: 0; MAIN SUPERVISOR PLANTS VALUES HERE SVC: JSR R5,SAVE; SAVE THE REGS MOV UPC-UTRP(R4), R4; PUT HIS PC ON THE STACK .WORD 6544; MFPI -(R4); GET THE WORD BEFORE THE PC (EMT CODE) MOVB (SP)+,R1; GET THE CODE (BYTE) INTO R1 EXIT: MOV SAVER4, R4 MOV SAVER5, R5; AND RESTORE R5 EXIT2: RTS PC SAVE: MOV R4,-(SP) MOV LASTPS,R4; PSECT ADDR ADD #UR0,R4; POINT AT USER REGS MOV R0,(R4)+ MOV R1,(R4)+ MOV R2,(R4)+ MOV R3,(R4)+ MOV (SP)+,(R4)+; R4 MOV (SP)+,(R4)+; R5 MOV (SP)+,(R4)+; PC MOV (SP)+,(R4)+; PS .WORD 6506; MFPI R6 - GET USER R6 MOV (SP)+,(R4)+; AND SAVE MOV R5,PC; AND RETURN INT: TST PSECT; IS THERE AN ACTIVE TASK? BNE NORMAL; YES, SO SAVE ITS REGISTERS ADD #4, SP; DUMP PC&PS MOV #-1,R1; SET INT CODE=-1 BR EXIT2; AND EXIT NORMAL: JSR R5,SAVE; SAVE THE CONTEXT MOV #-1,R1; SET SERVICE=INTERRUPT BR EXIT; AND RETURN ; ********************************************************* ; DEVICE INTERRUPTS KBINT: MOV #-2,INTVAL BR INT TTINT: MOV #-1,INTVAL BR INT TIMINT: CLR INTVAL; INT VALUE=0 BR INT DKINT: MOV #-3, INTVAL BR INT SEGTRP: MOV #1, @#52 ERR2: BIT #030000,PS; PREVIOUS = USER? BNE ERR3; YES, SO LET THE ERROR THROUGH HALT; NO, SO WERE IN SUPER STATE (KERNEL HAD IT) ERR3: MOV #-4,INTVAL BR INT ADDERR: MOV #2, @#52 BR ERR2 TU16IT: MOV #-5, INTVAL BR INT INT2: BR INT; IN CASE ITS NEEDED LATER INT6BA: ; NB: ALL INTS BENEATH MAY BE OVERWRITTEN BY SBLD ************* TXINT: MOV #-6, INTVAL BR INT RXINT: MOV #-7, INTVAL BR INT RP4INT: MOV #-10, INTVAL BR INT LPINT: MOV #-11, INTVAL BR INT BPTINT: MOV #-12,INTVAL MOV @SP, INTINF; PASS PC THROUGH BR INT KB2INT: MOV #-13,INTVAL BR INT TT2INT: MOV #-14, INTVAL BR INT KB3INT: MOV #-15, INTVAL BR INT TT3INT: MOV #-16, INTVAL BR INT MOV #-17, INTVAL BR INT CRINT: MOV #-20,INTVAL BR INT PRINT: MOV #-21,INTVAL BR INT GPINT: MOV #-22, INTVAL; GRAPH PLOTTER BR INT DTINT: MOV #-23, INTVAL BR INT X1INT: MOV #-24, INTVAL BR INT X2INT: MOV #-25, INTVAL BR INT MOV #-26,INTVAL BR INT MOV #-27,INTVAL BR INT MOV #-30,INTVAL BR INT MOV #-31,INTVAL BR INT2 MOV #-32,INTVAL BR INT2 MOV #-33,INTVAL BR INT2 MOV #-34,INTVAL BR INT2 MOV #-35,INTVAL BR INT2 MOV #-36,INTVAL BR INT2 DUMP: MOV #177412, R1; DUMPER FOR AN RK05 MOV #14124, (R1); DISC ADDRESS CLR -(R1); CORE ADDRESS=0 MOV #1000002, -(R1); WC = MAX MOV #3, -(R1); WRITE+GO DLOOP: TSTB (R1) BPL DLOOP MOV #3,(R1); WRITE+GO AGAIN DLOOP2: TSTB (R1) BPL DLOOP2 BIT #20000,@#777402 BNE DUMP; NO, SO GO AGAIN MOV #7, @#777566; BELL ON TT HALT ; FILE 'DVRUB' .PAGE ;********************* DUP11/BISYNC HANDLER ************************** ; ELEMENT DVRUB IN NSILIB ;REG DEFS UBRCS=0 UBRDB=2 UBPSR=2 UBTCS=4 UBTDB=6 ;BIT DEFS UBRSET=400 ;RESET FLAGS IN TCS UBDSR=1000 UBDTR=2 UBRTS=4 UBCTS=20000 UBDCD=10000 UBRXEN=20 UBTXEN=20 UBDLEN=40 ;DATA LATE INT ENB IN UBTCS UBPARM=101062 ;MODE:BYTE MODE, NO CRC UBTSOM=400 UBTEOM=1000 ;USEFUL CHARS UBSYN=62 UBDLE=20 UBSTX=2 UBETB=46 UBMARK=377 COUNT=5000 ; BLOCK SPEC ; PT = 0 STATE =2 S1 = 3 MAXLN = 4 P1 = 6 MODE = 10 SEG = 12 COU= 14 VEC = 16 ; USEFUL ADDRESSES INTENB = 100 KPAR6 = 772354 KPDR6 = 772314 DPRNO = -31.; ?????????????????? DPTNO = DPRNO-1; = -32. ; TABLES DPR1TB: 0,0,0,0,0,0,0, 0 DPT1TB: 0,0,0,0,0,0,0, 0 ;** INIT SEQ. ** ;UBINIT: BIS #UBRSET,UBTCS(R0) ;RESET DVEICE ; MOV #UBPARM,UBPSR(R0) ;SET OP. MODE ;;CONNECT TO MODEM ; MOV #COUNT,R1 ; MOV #DSRM,R2 ; BIS #UBDTR,(R0) ;SET DTR ;UBIN01: BIT #UBDSR,(R0) ;WAIT FOR MODEM ; BNE UBIN04 ; DEC R1 ; BNE UBIN01 ; JMP RPERR ;UBIN04: MOV #COUNT,R1 ; MOV #CTSM,R2 ;;SET UP MODEM TX ; BIS #UBRTS,(R0) ;SET RTS ;UBIN02: BIT #UBCTS,(R0) ;WAIT FOR CTS ; BNE UBIN05 ; DEC R1 ; BNE UBIN02 ; JMP RPERR ;UBIN05: MOV #COUNT,R1 ; MOV #CARM,R2 ;;SET UP MODEM RX ;UBIN03: BIT #UBDCD,(R0) ;CARRIER? ; BNE UBIN06 ; DEC R1 ; BNE UBIN03 ; JMP RPERR ;;ENABLE RX TO SYNC ;UBIN06: BIS #100+UBRXEN,(R0) ;RX ENABLE + INTS ;;LEAVE THE TX IDLE ; RTS PC ;** RX START SEQ. ** ;UBRSS: BIC #UBRXEN,(R1) ;DISABLE & RE-ENABLE RX ; BIS #UBRXEN,(R1) ; CLRB STATE(R0) ;RESET STATE ; JMP DSPNXT ;** RX INT SEQ. ** UBRIS: MOV R0, -(SP) MOV R1, -(SP) MOV R2, -(SP) MOV #DPR1TB, R0 MOV VEC(R0), R1; GET INTERFACE ADDRESS RXCOMM: MOV UBRDB(R1),-(SP) ;SAVE I/P CHAR BMI UBRWRR ;ERROR BIC #177400,(SP) MOVB STATE(R0),R2 ;RWITCH ON STATE ASL R2 MOV UBRWIT(R2),R2 RTS R2 UBRWIT: .WORD UBRW10 ;LOOKING FOR DLE .WORD UBRW20 ; " " STX .WORD UBRW30 ; " " DATA .WORD UBRW40 ; " " DLE OR ETB .WORD UBRW50 ; " " 1ST CRC BYTE .WORD UBRW60 ; " " 2ND " " ;SYN SEEN UBRW10: CMP #UBDLE,R2 ;DLE? BEQ UBRWXX ;YES, EXPECT STX CMP #UBSYN,R2 ;ANOTHER SYN? BEQ UBRWEX ;WAIT FOR DLE UBRW12: CLRB STATE(R0) ;ELSE IDLE AGAIN BIC #UBRXEN,(R1) BIS #UBRXEN,(R1) BR UBRWEX ;SYN-DLE SEEN UBRW20: CMP #UBSTX,R2 ;STX BNE UBRW12 ;NO, ERROR TST SEG(R0); BUFFER PRESENT? BEQ UBRW12 ;NO BUFFER, IGNORE FRAME CLR P1(R0) ;CLEAR CRC ACC CLR MODE(R0) ;CLEAR COUNTER FOR UBSTC BR UBRWXX ;EXPECT DATA ;SYN-DLE-STX SEEN UBRW30: CMP #UBDLE,R2 ;STUFFED DLE? BEQ UBRWXX ;YES, EXPECT DLE OR ETB UBRW32: JSR PC,UBSTC ;SAVE THE CHAR JSR PC,UBCRC ;ACCUMULATE CRC BR UBRWEX ;EXPECT MORE DATA ;DLE SEEN IN DATA UBRW40: CMP #UBDLE,R2 ;STUFFED DLE? BNE UBRW41 ;NO DECB STATE(R0) ;BACK TO NORMAL DATA MODE BR UBRW32 ;PUT IN BUFFER UBRW41: CMP #UBETB,R2 ;ETB? BNE UBRW12 ;NO, ERROR JSR PC,UBCRC BR UBRWXX ;EXPECT CRC ;DLE-ETB SEEN UBRW50: CMPB R2,P1(R0) ;LSB CRC OK? BNE UBRWER ;NO, ERROR BR UBRWXX ;EXPECT 2ND BYTE ;1ST CRC BYTE SEEN UBRW60: CMPB R2,P1+1(R0) ;2ND CRC BYTE OK? BNE UBRWER ;NO, ERROR CLR MODE(R0) ;FLAG TRANSFER OK UBRW61: MOV (R1),P1(R0) ;SAVE DEVICE STATUS CLR SEG(R0); CLEAR OUT ADDRESS CLRB STATE(R0) ;RESET STATE MOV #DPRNO, INTVAL DOINT: MOV (SP)+, R2 MOV (SP)+, R1 MOV (SP)+, R0 JMP INT; CALCULATE BYTE COUNT? ;RWITCH EXIT UBRWXX: INCB STATE(R0) ;NEXT STATE UBRWEX: JMP DSPNXT ;ERROR EXIT UBRWRR: TST (SP)+ ;ENTRY WITH CHAR ON STACK TST (R0) ;MAY BE ON FRAME START (WAS BUFPTR(R0)) BEQ UBRWEX ;SO IGNORE IT UBRWER: MOV #177777,MODE(R0) ;SET ERROR FLAG BR UBRW61 ;AND EXIT UBSTC: MOV SEG(R0), KPAR6; SET UP KERNEL SEG 6 MOV #77406, KPDR6; ????????????????????? MOVB R2, @0(R0); PLANT CHAR INC (R0); BUMP POINTER DEC MAXLN(R0); OVER LENGTH? BNE UBSTC1; NO, SO OK TST (SP)+; YES, SO ERROR MOV #-2,MODE(R0) BR UBRW61 UBSTC1: RTS PC ;** TX START SEQ. ** UBSYNS=10. ;NUMBER OF LEADING SYNS UBPADS=10 ;NUMBER OF LEADING PADS ;UBTSS: MOVB #1,STATE(R0) ;EXPECT INT ; BIS #UBTXEN+INTENB,UBTCS(R1) ; MOV #UBMARK+UBTSOM,R2 ; MOV #UBPADS-1,P1(R0) ;PAD COUNTER ; JMP UBTWEX ;** TX INT. SEQ. ** ; DATA LATE IGNORED AS PROTOCOL WILL RECOVER. UBTIS: MOV R0, -(SP) MOV R1, -(SP) MOV R2, -(SP) MOV #DPT1TB, R0 TXCOMM: MOV VEC(R0), R1; GET VECTOR ADDRESS MOVB STATE(R0),R2 ASL R2 JMP @UBTSW(R2) UBTSW: .WORD DSPNXT ;UNWANTED INT .WORD UBTWX0 ;START OF FRAME PADS .WORD UBTW00 ;START OF FRAME SYNS .WORD UBTW10 ;LEADING DLE .WORD UBTW20 ;STX .WORD UBTW30 ;DATA .WORD UBTW40 ;STUFF DLE .WORD UBTW50 ;ETB .WORD UBTW60 ;CRC1 .WORD UBTW70 ;CRC2 .WORD UBTW90 ;TO IDLE STATE ;LEADING MARK UBTWX0: MOV #UBMARK+UBTSOM,R2 DEC P1(R0) BNE UBTWEX ;STAY WITH PADS MOV #UBSYNS,P1(R0) ;ON TO SYNS BR UBTWXX ;LEADING SYNS UBTW00: MOV #UBSYN+UBTSOM,R2 DEC P1(R0) BEQ UBTWXX ;GO TO SEND DLE BR UBTWEX ;LEADING DLE UBTW10: MOV #UBDLE,R2 CLR P1(R0) ;CLEAR CRC ACC BR UBTWXX ;STX UBTW20: MOV #UBSTX,R2 BR UBTWXX ;DATA UBTW30: JSR PC,LDC BLT UBTW31; NB: NOT SAME AS SCOTT JSR PC,UBCRC CMP #UBDLE,R2 ;IF DLE STUFF ANOTHER BNE UBTWEX BR UBTWXX UBTW31: MOV #UBDLE,R2 ;TRAILING DLE INCB STATE(R0) BR UBTWXX ;STUFF DLE UBTW40: MOV #UBDLE,R2 DECB STATE(R0) BR UBTWEX ;ETB UBTW50: MOV #UBETB,R2 JSR PC,UBCRC BR UBTWXX ;CRC1 UBTW60: MOVB P1(R0),R2 BIC #177400,R2 BR UBTWXX ;CRC2 UBTW70: MOVB P1+1(R0),R2 BIC #177400,R2 BR UBTWXX ;TO IDLE UBTW90: MOV (R1),P1(R0) ;SAVE STATUS MOV #UBTEOM,UBTDB(R1) ;SET EOM AND CLEAR SOM BIC #UBTXEN+INTENB,UBTCS(R1) CLRB STATE(R0) CLR MODE(R0) ;FLAG NO ERRORS MOV #DPTNO, INTVAL JMP DOINT ;NEXT STATE EXIT UBTWXX: INCB STATE(R0) UBTWEX: MOV R2,UBTDB(R1) BR DSPNXT ; LOAD CHAR ROUTINE LDC: MOV SEG(R0), KPAR6 MOV #77406, KPDR6; FULL SEG FOR NOW MOV (R0), R2; GET CHAR AND BUMP POINTER MOVB (R2), R2 BIC #177400, R2 INC (R0); BUMP POINTERT DEC COU(R0); SENDS '=' ON EXIT WHEN FINISHED RTS PC; LAST CHAR?? ;** CRC ROUTINE ** UBCRC: MOV R1,-(SP) MOV R2,-(SP) MOV P1(R0),R1 ;GET CRC BIC R1,R2 BICB (SP),R1 BISB R2,R1 MOV #120001,R2 MOV #10,-(SP) UBCRC1: DEC (SP) BLT UBCRC2 CLC ROR R1 BCC UBCRC1 MOV R2,-(SP) BIC R1,(SP) BIC R2,R1 BIS (SP)+,R1 BR UBCRC1 UBCRC2: MOV R1,P1(R0) TST (SP)+ MOV (SP)+,R2 MOV (SP)+,R1 RTS PC ; COMMON RETURN SEQUENCE DSPNXT: MOV (SP)+, R2 MOV (SP)+, R1 MOV (SP)+, R0 .WORD 6; RTT - RETURN TO LAST ACTIVITY ; ERROR REPORTING TO TTY ;RPERR: MOVB (R2)+,R1 ;GET CHARACTER ; BNE RPERR1 ; HALT ;END OF MESSAGE ; JMP START ;RESTART ;RPERR1: TSTB 177564 ;TTY READY ; BEQ RPERR1 ; MOVB R1,177566 ;PRINT CHAR ; BR RPERR ;DSRM: .ASCII /MODEM: DSR NOT UP/ ; .BYTE 15,12,0 ; .EVEN ;CTSM: .ASCII /MODEM: CTS NOT UP/ ; .BYTE 15,12,0 ; .EVEN ;CARM: .ASCII/MODEM: CARRIER NOT UP/ ; .BYTE 15,12,0 ; .EVEN .END aGl> ß%üÿ Úÿïæ Øÿ±ê Úÿßì °ÿ¡ò ÔÿTô ÊÿÎÿu ÎÿÒÿoö ìÿÀe æÿÂe Ðÿ^" ÀEýÿ" Îÿ3" aÁe4 Èÿ¼< æÿÀe Èÿ÷ Æÿh` > Àe ÌÿQb u-ÆÿÈÿ( ìÿÀe Èÿ°f f Áe Îÿ®h ÌÿJ" ìÿÃe Èÿ÷ ìÿÀe @mìÿ5 àÿ!¤ ÖüB¸ ÄÿNa÷ ¾ ðÿÈÊ °ÿÔÿ5 Õÿ Ö ÔÿÎÿuaÎÿ1 |üBâ aÁe¾ÿu ¾ÿ÷ì ØüTî Äÿîÿ­ð ôÿ`ô òÿ ø ôÿ5, pí¾ÿ @-îÿ ÄÿNaf ðÿ÷ Ô ¼ÿ4. ºÿv4  ÿù6 H-¼ÿ H-¶ÿ ¶ÿs8 ªûÞ@ ¬ÿøB u-¼ÿ¶ÿ pm¼ÿ Hí¼ÿóH ÜÿzL ²ÿøV ªÿ¦X ®ÿ½\ ®ÿ×t CmèÿÃe äÿ]^ ®ÿWt `Áe Cmêÿõ àÿØ¢ A]²ÿu ¬ÿ ÿÓ¼ &úßÀ þùàÐ êÿ Ö AmêÿÁe ¦ÿàÿöÞ °ÿW-°ÿ7 °ÿ.ê °ÿÀeÝÿ ¨ÿÁg( ¦ÿèÿ `Áe ®ÿWt `Áe túÿÀE ®ÿ×t ÀEÀÿ ¸ÿY& ðEüÿ ìÿðU `øß> HøßH ºÿ3P ¸ÿ×t túÿÀE ¸ÿWt ¸ÿ×t â÷àZ Æeþÿpd aÃe4 Æeîÿün WtøÿÁE îÿ5x ðÿB`µ úÿÕz üÿÔ~ bA-ðÿ HmîÿÙ p-òÿ Hmîÿ3 øÿx¬ îÿò² ÆeþÿýÀ øÿ÷ ÆeÔÿu® ÆeþÿÙ Úÿ@` ÿÿöÿW-öÿ öÿðb öÿWt ÀôFd îô®h þÿ6l fÿhn ÖÿØÿuaØÿ öÿW-öÿ7 öÿL~ túÿÀE `WtúÿÁE `ðÿu ðÿäÿà öÿW-öÿÞ¾ öÿ÷ :cõe p-äÿ ØÿÁeF Öÿ!  Öÿüÿ¶¢ cõe0 túÿÂE òÿ½¨ `WtúÿÁE æÿ9ª `×túÿÃE üÿÂe0 òÿAíòÿÁ üÿÀeP âÿWt ìÿ@íæÿÀ âÿË´ ìÿBíæÿ xdW-îÿ! W-îÿ" dõ%! ÞÿCÆ ªdÀeX âÿWt túÿÀE ÜÿÁå@ âdumÜÿðÿµ âÿ]Î æÿWt ÞÿÔÒ Øü>Ü OKOUT %FINISH PROMPT('MORE CHANGES?') READSYMBOL(REP);SKIPSYMBOL %IF REP='Y' %THEN ->WDOFF %ELSE ->OKOUT !************************************************************** SW(5): !READ AND ALTER FORMAT STATUS OF BLOCK PRINTSTRING('ENSURE FORMAT ENABLE SWITCH IS ON') NEWLINE PRINTSTRING('ENSURE WRITE PROTECT OVERRIDE SWICH IS ON') NEWLINE DISCGO(STBLK,UNIT,DBLK2,2) OCTWRT(DBLK2(0));SPACE; !ADDR/STAT 1 OCTWRT(DBLK2(1));SPACE; !ADDR/STAT 2 NEWLINE ALT: PROMPT('ALTER STATUS?') %WHILE NEXTSYMBOL<'A' %OR NEXTSYMBOL>'Z' %THEN SKIPSYMBOL READSYMBOL(REP);SKIPSYMBOL %IF REP='N' %THEN ->OKOUT PROMPT('NEW STATUS(OCTAL)=') OCTRD(PATT) %IF PATT&K'1777'#DBLK2(0)&K'1777' %START PRINTSTRING('STATUS ERROR!') NEWLINE ->ALT %FINISH PROMPT('ARE YOU SURE?') %WHILE NEXTSYMBOL<'A' %OR NEXTSYMBOL>'Z' %THEN SKIPSYMBOL READSYMBOL(REP);SKIPSYMBOL %IF REP#'Y' %THEN ->ALT %CYCLE I=0,1,NBLKS-1 DISCGO(STBLK+I,UNIT,DBLK1,0); !SAVE DATA DISCGO(STBLK+I,UNIT,DBLK2,2); !GET FORMAT STATUS DBLK2(0)=(DBLK2(0)&K'1777')!(PATT&K'1777') DISCGO(STBLK,UNIT,DBLK2,3) %IF DBLK2(0)&K'40000'=0 %THEN DISCGO(STBLK,UNIT,DBLK1,1); !RESTORE DATA %REPEAT ->OKOUT %ENDOFPROGRAM %CONTROL K'100001' %BEGIN %INTEGER LINE, ADDR %ROUTINE POCT(%INTEGER N) %INTEGER J SPACE PRINTSYMBOL(N>>J&7+'0') %FOR J = 15,-3,0 SPACE %END %ROUTINE GET(%INTEGERNAME N) %INTEGER S READSYMBOL(N); READSYMBOL(S) N = N+S<<8 %END %ROUTINE NEXT LINE %INTEGER S, N SELECTINPUT(2) %CYCLE READSYMBOL(S) %UNTIL S = 1; SKIPSYMBOL GET(N); GET(ADDR) N = (N-6)//2 %STOP %IF N <= 0 GET(S) %FOR N = 1, 1, N SKIPSYMBOL READSYMBOL(S); READSYMBOL(N) LINE = S>>1+N<<6 %RETURN %IF ADDR >= 0 %REPEAT %END %ROUTINE GET SOURCE %OWNINTEGER HERE = 0 %INTEGER J, S SELECTINPUT(1) %WHILE LINE # HERE %CYCLE HERE = HERE+1; WRITE(HERE, 4) %IF HERE = LINE %THEN POCT(ADDR) %ELSE SPACES(8) READSYMBOL(S) %AND PRINTSYMBOL(S) %UNTIL S < ' ' NEWLINE %AND %STOP %IF S<0 %OR S=4 %REPEAT %END LINE = 0; ADDR = 0 SELECTOUTPUT(1) PRINTSYMBOL(12); NEWLINE %CYCLE NEXT LINE %UNTIL LINE > 0 GET SOURCE %REPEAT %ENDOFPROGRAM %BEGIN %CONSTBYTEINTEGERNAME ID = K'160030' %CONSTINTEGERNAME NULLI=0 %CONSTINTEGER DREAD=0, DWRITE=1 %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, %C %INTEGERNAME A2, %INTEGER A3) %INTEGER I, J, K, L, M, DRIVE %RECORD (PF)P %INTEGERARRAY BUFF(0:256) PROMPT('Copies Floppy Unit 0 to Unit 1 PLEASE CONFIRM?') READSYMBOL(I) DRIVE=K'020000'; ! UNIT ONE %IF I#'Y' %THEN %STOP P_SERVICE=3; P_REPLY = ID P_A1=0; P_A2==NULLI PONOFF(P) %IF P_A1#9 %START PRINTSTRING('DISC TURN OFF CHECK ERROR '); WRITE(P_A1, 1); NEWLINE %STOP %FINISH P_SERVICE=3; P_REPLY=ID P_A1=0; P_A2==NULLI P_A3=K'020000' PONOFF(P) %IF P_A1#9 %START PRINTSTRING("UPPER CHECK FAILS %STOP %FINISH %CYCLE I = 0, 1, 1000 P_SERVICE=3; P_REPLY=ID P_A1=DREAD; ! READ ONE BLOCK P_A2==BUFF(0) P_A3=I; ! BLOCK PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC ERROR %STOP %FINISH P_A2==BUFF(0) P_A1=DWRITE P_A3=I!DRIVE P_SERVICE=3; P_REPLY=ID PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC WRITE ERROR %STOP %FINISH %REPEAT %ENDOFPROGRAM !!!!!!!!!!!! DISC INITIALISER (RXO2) !!!!!!!!!!!!!!!! ! COPIES THE SYSTEM (0-87) FROM UNIT 0 TO UNIT 1 ! AND ZEROS THE BLKLST AND DIRECTORIES ON UNIT 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %BEGIN %CONSTBYTEINTEGERNAME ID = K'160030' %CONSTINTEGERNAME NULLI=0 %CONSTINTEGER DREAD=0, DWRITE=1 %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, %C %INTEGERNAME A2, %INTEGER A3) %INTEGER I, J, K, L, M, DRIVE %RECORD %IF K > 9 %THEN PRINTSYMBOL(K+'A'-10) %ELSE %C PRINTSYMBOL(K+'0') %REPEAT SPACE %REPEAT NEWLINE %END %ENDOFPROGRAM %CYCLE I = 0, 1, P ! FILE 'FEP_GATE5' %CONSTSTRING (7) VSN = "VSN005D" !**************************** !* EMAS-2900 FEP GATE * !* FILE: GATE5 * !* DATE: 12.SEP.80 * !**************************** !! STACK SIZE = 300 %RECORDFORMAT DMF(%INTEGER I) %SYSTEMROUTINESPEC LINKIN(%INTEGER SERVICE) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %CONSTRECORD (DMF) %NAME NULL = 0 %OWNINTEGER OWN TERM = 72; ! NETWORK ADDRESS %OWNINTEGER SUBATTACH FLAG = 74 %CONSTINTEGER KENT = 0; ! KENT=1 - NO NODE IN NET %CONTROL K'100001' %BEGIN %RECORDFORMAT NSI1F(%BYTEINTEGER FN, SUFL, ST, SS, SN, DN, DT, %C DS, FLAG, UFL, LEN1, DATA, %BYTEINTEGERARRAY A(2:238)) %RECORDFORMAT NSI2F(%BYTEINTEGER FN, SUFL, ST, SS, FLAG, UFLAG %C , FLEN, FDATA, FD2, FD3, FD4) %RECORDFORMAT NSI3F(%BYTEINTEGERARRAY A(0:100)) %RECORDFORMAT MEF(%RECORD (MEF) %NAME LINK, %C %BYTEINTEGER LEN, TYPE, %RECORD (NSI1F)NSL) %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, %C FN, PORT, %RECORD (MEF) %NAME MES, %BYTEINTEGER LEN, S1) %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, FN, PORT, %C FACILITY, FLAG, NODE, TERM) %RECORDFORMAT QF(%RECORD (MEF) %NAME E) %RECORDFORMAT LINE STATEF(%INTEGER NODE STATE, ATT FLAG, %C LINE NO, SER NO, NODE NUMBER) %RECORDFORMAT PORTF(%BYTEINTEGER STATE, OWNER PORT, %C NO, MT, NODE, TERM, FL, RL, %INTEGER %C OWNER, MAX FL, %RECORD (QF) OUT Q, %RECORD (LINE STATEF) %NAME LN) !********************************************** !* NSI FUNCTIONS FRON NODE * !********************************************** %CONSTINTEGER ATTACH = 1; ! NSI FN VALUES %CONSTINTEGER SEND MESS = 2 %CONSTINTEGER CONNECT = 3 %CONSTINTEGER SEND BLOCK = 4 %CONSTINTEGER STATUS = 5 %CONSTINTEGER NIF = 6 %CONSTINTEGER REMOVE = 7 %CONSTINTEGER SUBATTACH = 255 %CONSTINTEGER REPLY = 128; ! ADDED TO ABOVE FOR REPLY %CONSTINTEGER ATTACH R = 8; ! 'REAL' VALUE IS ATTACH+128 %CONSTINTEGER SEND MESS R = 9 %CONSTINTEGER CONNECT R = 10 %CONSTINTEGER SEND BLOCK R = 11 %CONSTINTEGER STATUS R = 12 %CONSTINTEGER NIF R = 13 %CONSTINTEGER REMOVE R = 14 !************************************************************ !* UPPER LEVEL (ITP&RJE) HANDLER MESSAGES TO GATE !************************************************************ %CONSTINTEGER ENABLE FACILITY = 1; ! ENABLE THE FACILITY %CONSTINTEGER DISABLE FACILITY = 2; ! THE REVERSE %CONSTINTEGER CALL REPLY = 3; ! REPLY TO A 'CALL CONNECT' %CONSTINTEGER ENABLE INPUT = 4; ! ALLOW A BLOCK TO BE READ %CONSTINTEGER PUT OUTPUT = 5; ! SEND A BLOCK OF OUTPUT %CONSTINTEGER CLOSE CALL = 6; ! TERMINATE A CALL %CONSTINTEGER ABORT CALL = 7; ! ABORT THE CALL %CONSTINTEGER OPEN CALL = 8; ! OPEN A VIRTUAL CIRCUIT %CONSTINTEGER OPEN MESSAGE = 9; ! SEND A MESSAGE !******** FROM BUFFER MANAGER ****** ! %CONSTINTEGER BUFFER HERE = 0 !********************************************************** !* MESSAGES FROM GATE TO UPPER LEVEL PROTOCOLS !********************************************************** %CONSTINTEGER OPEN CALL REPLY = 1 %CONSTINTEGER INCOMING CALL = 2 %CONSTINTEGER INPUT RECD = 3; ! BLOCK ARRIVED FROM NODE %CONSTINTEGER OUTPUT TRANSMITTED = 4; ! PREPARED TO ACCEPT MORE %CONSTINTEGER CALL CLOSED = 5; ! EITHER END HAS CLOSED DOWN %CONSTINTEGER CALL ABORTED = 6; ! OTHER END HAS ABORTED %CONSTINTEGER OPEN REPLY A = 7 %CONSTINTEGER OPEN REPLY B = 8 %CONSTINTEGER MESSAGE = 9 %CONSTINTEGER MESSAGE REPLY = 10 !********** TO BUFFER MANAGER *********** %CONSTINTEGER REQUEST BUFFER = 0 %CONSTINTEGER RELEASE BUFFER = 1 !************************************************************** !******* CALLS ON LINE (OR PROTOCOL) HANDLER ********* !************************************************************ %CONSTINTEGER LINE INPUT = 1 %CONSTINTEGER LINE OUTPUT = 2 %CONSTINTEGER HELLO = 2; ! IN P_LEN !************************************************************ !********** VARIOUS SERVICE NUMBERS ************* %CONSTBYTEINTEGERNAME OWN ID = K'160030' %CONSTINTEGER GATE SER = 16 %CONSTINTEGER FROM PROT = 10 %CONSTINTEGER BUFFER MANAGER = 17 %CONSTINTEGERNAME PKT = K'100010' %CONSTINTEGERNAME SBR = K'100006' %CONSTINTEGERNAME BYT = K'100004' %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310' %CONSTINTEGER T3 SER = 21 !********************************************** !* PORT STATES * !********************************************** %CONSTINTEGER DOWN = 0 %CONSTINTEGER CONNECTING = 1 %CONSTINTEGER CONNECTED = 2 %CONSTINTEGER DISCONNECTING = 3 %CONSTINTEGER DISCON 2 = 4 %CONSTINTEGER ABORTING = 5 %CONSTINTEGER CLEARING = 6; ! LINE HAS GONE DOWN !**** REST ARE SUB STATES OF 'AWAITING BUFFER' %CONSTINTEGER ATTACH RB = 5 %CONSTINTEGER STATUS REPLY RB = 7 %CONSTINTEGER SEND STATUS RB = 8 %CONSTINTEGER SEND BL REPLY RB = 6 %CONSTINTEGER SEND BL REPLY DRB = 9; ! ALSO SET DISCONNECT %CONSTINTEGER SEND BL DRB = 10; ! SEND A BLOCK WITH DISCONNECT %CONSTINTEGER SEND MESSAGE = 11; ! SEND AN NSI MESSAGE %CONSTINTEGER SEND CONNECT = 12; ! SEND AN "NSI" CONNECT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! GENERAL VARIABLES !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! %RECORD (PE) P %RECORD (P2F) %NAME P2 !! %CONSTBYTEINTEGERNAME INT = K'160060' %OWNINTEGER MON = 0; ! MONITORING OFF %OWNINTEGER SBRF = 1; ! REMOVE SBR FLAG %CONSTINTEGER MAXT = 50 %OWNRECORD (PORTF) %NAME PORT %OWNRECORD (PORTF) %ARRAY PORTA(0:MAXT) %OWNINTEGER FORCE DOWN = 0; ! '1' WHEN IN DOWN STATE %RECORD (LINE STATEF) %NAME LN, L0, L1 %RECORD (LINE STATEF) %ARRAY LNA(0:1) !******************************************************** !* FACILITY: CONTAINES EITHER - ZERO - NOT ALLOCATED * !* OR - SER NO OF OWNER PROC * !******************************************************** %CONSTINTEGER FAC MAX = 25 %OWNBYTEINTEGERARRAY FACILITY(0:FAC MAX) = 0(0) !! %PERMROUTINESPEC PUSH(%RECORD (QF) %NAME Q, %RECORD (MEF) %NAME M) !! %PERMRECORD (MEF) %MAPSPEC POP(%RECORD (QF) %NAME Q) %ROUTINESPEC FROM HIGHER LEVEL %ROUTINESPEC DO ATT REM(%INTEGER TYPE, %RECORD (MEF) %NAME MES) %ROUTINESPEC FAULT(%INTEGER TYPE, PORT N) %ROUTINESPEC TO UPPER(%INTEGER CALL, %RECORD (MEF) %NAME MES) %ROUTINESPEC TO NODE(%RECORD (MEF) %NAME MES) %ROUTINESPEC ASK FOR BLOCK(%INTEGER REASON, PORT NO) %RECORD (MEF) %MAPSPEC NODE %ROUTINESPEC BUFFER ARRIVED %ROUTINESPEC TIDY PORTS %ROUTINESPEC FREE BUFFER(%RECORD (MEF) %NAME MES) %ROUTINESPEC NODE MONITOR(%RECORD (NSI3F) %NAME NSA) %RECORDFORMAT R1F(%INTEGER X) %RECORDFORMAT R2F(%RECORD (MEF) %NAME MES) %RECORD (R1F)R1; %RECORD (R2F) %NAME R2 %INTEGER I %RECORD (MEF) %NAME MES %OWNINTEGER TSL, IB, IC, OB, OC CHANGE OUT ZERO = T3 SER; ! SET 'SELECT OUTPUT(0)' TO COMMON R2 == R1 P2 == P MAP VIRT(BUFFER MANAGER, 5, 4) MAP VIRT(BUFFER MANAGER, 6, 5) ! MAP BUF MAN SEG 6 TO SEG 4 PORT == PORTA(1) LINKIN(GATE SER); LINKIN(FROM PROT) P_SER = 0; POFF(P); ! WAIT FOR INSTRUCTIONS OWN TERM = P_FN; SUB ATTACH FLAG = P_PORT ALARM(100) %CYCLE I = 1, 1, MAXT PORT == PORTA(I) PORT_NO = I %REPEAT L0 == LNA(0) L1 == LNA(1) %CYCLE P_SER = 0; POFF(P) %IF 'M' <= INT <(PF)P %INTEGERARRAY BUFF(0:256) PRINTSTRING('INITIALISES FLOPPY ON UNIT 1 FOR DEIMOS PROMPT('Copies Floppy Unit 0 to Unit 1 PLEASE CONFIRM?') READSYMBOL(I); SKIPSYMBOL DRIVE=K'020000'; ! UNIT ONE %IF I#'Y' %THEN %STOP P_SERVICE=3; P_REPLY = ID P_A1=0; P_A2==NULLI PONOFF(P) %IF P_A1#9 %START PRINTSTRING('DISC TURN OFF CHECK ERROR '); WRITE(P_A1, 1); NEWLINE %STOP %FINISH %CYCLE I = 0, 1, 74 P_SERVICE=3; P_REPLY=ID P_A1=DREAD; ! READ ONE BLOCK P_A2==BUFF(0) P_A3=I; ! BLOCK PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC ERROR %STOP %FINISH P_A2==BUFF(0) P_A1=DWRITE P_A3=I!DRIVE P_SERVICE=3; P_REPLY=ID PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC WRITE ERROR %STOP %FINISH %REPEAT SELECT OUTPUT(0) PRINTSTRING('SYSTEM COPIED..... %CYCLE I=0,1,256 BUFF(I)=0 %REPEAT %CYCLE I=88,1,160 P_A2==BUFF(0) P_A1=DWRITE; P_A3=I!DRIVE P_SERVICE=3; P_REPLY=ID PONOFF(P) %IF P_A1#0 %START PRINTSTRING('DISC WRITE ERROR %STOP %FINISH %REPEAT PRINTSTRING('UNIT 1 INITIALISED %ENDOFPROGRAM ='O' %START MON = INT-'O'; INT = 0 %FINISH %IF INT = 'D' %START; ! FORCE DOWN FORCE DOWN = 1 %IF KENT = 0 %START; ! PROPER NODE ASK FOR BLOCK(ATTACH RB, 0) %ELSE PRINTSTRING("GATE CLOSEDOWN TIDY PORTS %FINISH LN_ATT FLAG = 0 INT = 0 %FINISH !********************************* !* 1) MESSAGE FROM UPPER LEVEL * !* 2) MESSAGE FROM NODE * !********************************* %IF P_SER = GATE SER %THEN FROM HIGHER LEVEL %IF P_REPLY = BUFFER MANAGER %START BUFFER ARRIVED %ELSE %IF P_SER = OWN ID %START %IF P_REPLY = 0 %START; ! CLOCK TICK ALARM(100); ! 2 SECS %IF INT = 'S' %START SBRF = SBRF!!1; ! CHANGE SBR FLAG INT = 0 %FINISH %IF INT = '?' %START PRINTSTRING("SBRF:"); WRITE(SBRF, 1); NEWLINE %CYCLE I = 0, 1, 1 %IF I = 0 %THEN %C PRINTSTRING("LN0 ") %ELSE PRINTSTRING("LN1 ") LN == LNA(I) %IF LN_ATT FLAG = 0 %THEN PRINTSTRING("DOWN") %C %ELSE PRINTSTRING("ATT ") PRINTSTRING(" to Node") WRITE(LN_NODE NUMBER, 1); NEWLINE %REPEAT PRINTSTRING("Strm State T Line F/B Buff %CYCLE I = 1, 1, MAXT PORT == PORTA(I) %IF PORT_STATE # DOWN %START WRITE(I, 2); WRITE(PORT_STATE, 4) WRITE(PORT_TERM, 3) %IF PORT_LN == L0 %THEN PRINTSTRING(" LN0") %C %ELSE PRINTSTRING(" LN1") WRITE(PORT_MAX FL, 3); WRITE(PORT_RL, 1) NEWLINE %FINISH %REPEAT INT = 0 %FINISH TSL = TSL+1 %IF TSL = 15 %START; ! 30 SECS TSL = 0 %IF INT = 'P' %START PRINTSTRING("GATE: I,O") WRITE(IB, 3); WRITE(IC, 4) WRITE(OB, 4); WRITE(OC, 4); NEWLINE IB=0; IC=0; OB=0; OC=0 %FINISH %FINISH %CONTINUE %FINISH %ELSE %IF P_SER = FROM PROT %START; ! MESSAGE FROM PROT HAN LN == LNA(P_PORT) %IF P_FN = LINE INPUT MES == NODE %UNLESS MES == NULL %THEN FREE BUFFER(MES) %ELSE !! LINE OUTPUT %IF P_LEN = HELLO %START LN == LNA(P_PORT); ! ITS LINE NUMBER LN_LINE NO = P_PORT LN_SER NO = P_REPLY %CONTINUE %FINISH %IF P_LEN = 1 %START; ! NODE DOWN PRINTSTRING("LINE ") PRINTSYMBOL(LN_LINE NO+'0'); PRINTSTRING(" DOWN LN_NODE STATE = 0; LN_ATT FLAG = 0 TIDY PORTS %ELSE !! UP MESSAGE OR WRITE ACK %IF LN_NODE STATE = 0 %START PRINTSTRING("LINE ") PRINTSYMBOL(LN_LINE NO+'0'); PRINTSTRING(" UP FORCE DOWN = 0 ASK FOR BLOCK(ATTACH RB, LN_LINE NO) %IF KENT = 0 LN_NODE NUMBER = P_S1 LN_NODE STATE = 1 %FINISH %FINISH %FINISH %FINISH %REPEAT %ROUTINE TO NODE(%RECORD (MEF) %NAME MES) %IF LN_NODE STATE = 0 %START FREE BUFFER(MES); ! NODE IS DOWN %RETURN %FINISH %IF MON # 0 %START SELECT OUTPUT(1) PRINTSTRING('O '); WRITE(MES_LEN, 2); NODE MONITOR(MES_NSL) SELECT OUTPUT(0) %FINISH P_MES == MES; P_LEN = MES_LEN PKT = PKT+1; BYT = BYT+(P_LEN>>2) OB = OB+1; OC = OC+P_LEN !************************************************* !* MESSAGE TO NODE: P_MES POINTS TO HDLC SPACE * !************************************************* P_SER = LN_SER NO; P_REPLY = OWN ID P_FN = LINE OUTPUT PON(P) %END %ROUTINE ASK FOR BLOCK(%INTEGER REASON, PORT NO) %RECORD (PE) P P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = REQUEST BUFFER; P_S1 = REASON; P_PORT = PORT NO P_LEN = 0; ! ASK FOR LONG BLOCK PON(P) %END %RECORD (MEF) %MAP NODE %INTEGER FN, I, TERM, PORT N, DISCON, FAC NO, TYPE %RECORD (NSI1F) %NAME NSL %RECORD (NSI2F) %NAME NSS %RECORD (MEF) %NAME MES %CONSTBYTEINTEGERARRAY VALID(ATTACH:REMOVE R) = 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0 !! A "1" IN VALID SPECIFIES THAT NSS_SS = PORTN %SWITCH SW(0:15) !**************************************************** !* ALL MESSAGES FROM NODE COME TO HERE * !* P_A1 POINTS NO THE NSI HEADER * !* P_A2 IS THE LENGTH OF THE NSI PCKET * !**************************************************** MES == P_MES NSL == MES_NSL; NSS == NSL FN = NSL_FN %IF MON # 0 %START SELECT OUTPUT(1) PRINTSTRING('I '); WRITE(MES_LEN, 2); NODE MONITOR(NSL) SELECT OUTPUT(0) %FINISH IB = IB+1; IC = IC+MES_LEN %IF FN&128 # 0 %THEN FN = FN&127+7 PORT N = NSL_SS; ! PICK UP STREAM AS INDEX PORT == PORTA(PORT N); ! FOR THOSE WHO NEED IT %UNLESS 1<= FN <= 15 %START RUBBISH: FAULT(1, PORT N); NODE MONITOR(NSL) ->FREE %FINISH !! COMPILER FAULT WITH COMPLEX CONDITIO %IF FN = 7 %THEN -> RUBBISH %IF MES_LEN <= 5 %THEN -> RUBBISH %UNLESS 0<=PORT N<=MAXT %OR VALID(FN) = 0 %THEN -> RUBBISH -> SW(FN) SW(ATTACH): -> FAIL %IF KENT = 0 PRINTSTRING("TCP ATTACHED LN_ATT FLAG = 1 -> REPLY SW(SEND MESS): TYPE = MESSAGE -> GET SW(CONNECT): TYPE = INCOMING CALL GET: MES_NSL_FN = MES_NSL_FN!128; ! SET THE REPLY BIT FAC NO = MES_NSL_DS; ! GET THE FACILITY NUMBER %IF FAC NO <= FAC MAX %AND FACILITY(FAC NO) # 0 %START; ! ENABLED OK %CYCLE I = 1, 1, MAXT PORT == PORTA(I) %IF PORT_STATE = DOWN %START PORT_STATE = CONNECTING PORT_OWNER = FACILITY(FAC NO) P_LEN = MES_NSL_FLAG; ! PASS FORWARD/REV BUFF LIM P_S1 = MES_NSL_ST; ! PASS TERMINAL NO PORT_TERM = P_S1; ! COPY TO PORT TO UPPER(TYPE, MES) PORT_OUT Q_E == MES; ! RETAIN CONNECT MESSAGE PORT_LN == LN; ! REMEMBER WHICH LINE PORT_MT = MES_NSL_DT; ! COULD BE ON SUB-ATTACH TERM %RESULT == NULL %FINISH %REPEAT %FINISH !! EITHER FACILITY NOT ENABLED OR NO FREE PORTS MES_NSL_SUFL = 128+8; MES_NSL_LEN1 = 2 MES_NSL_DATA = 'N'; MES_NSL_A(2) = 'O' MES_LEN = 13; ! +2 ????? TO NODE(MES) %RESULT == NULL SW(SEND BLOCK): -> FAIL %UNLESS PORT_STATE > DOWN !! DEAL WITH INCOMING BUFFER ACK %IF NSS_FLAG&X'70'#0 %START I = NSS_FLAG>>4 %IF PORT_RL = 0 %THEN TO UPPER(OUTPUT TRANSMITTED, NULL) PORT_RL = PORT_RL+I !! DISCON 2 STATE ???? %FINISH DISCON = NSS_FLAG&128 TO UPPER(INPUT RECD, MES) %IF DISCON # 0 %START PORT_STATE = DISCONNECTING TO UPPER(CALL CLOSED, NULL) %FINISH %RESULT == NULL SW(STATUS): -> FAIL %UNLESS PORT_STATE > DOWN %IF NSS_FLAG&128 # 0 %START ! DISCONNECT SET DO STATUS: TO UPPER(CALL ABORTED, NULL) %IF PORT_STATE >= DISCONNECTING %THEN %C PORT_STATE = DOWN %ELSE %C PORT_STATE = ABORTING ->FREE %FINISH -> REPLY SW(NIF): PRINTSTRING('GATE> NIF') NODE MONITOR(NSL) %IF NSL_FLAG&128 # 0 %THEN -> DO STATUS !! WITHOUT DISCONNECT ->FREE SW(ATTACHR): -> FREE %IF NSL_ST = SUB ATTACH FLAG %IF NSL_SUFL # 0 %START ! FAILED DO ATT REM(REMOVE, MES) %RESULT == NULL %FINISH LN_ATT FLAG = 1 PRINTSTRING("ATTACHED OK %IF SUBATTACH FLAG#0 %AND LN == L0 %START DO ATT REM(SUBATTACH, MES) %RESULT == NULL %FINISH -> FREE SW(SEND MESSR): SW(CONNECT R): %IF PORT_STATE # CONNECTING %THEN -> FAIL P_S1 = NSL_SUFL %IF FN = SEND MESS R %START P_LEN = PORT_OWNER PORT; ! RETURN USERS INDEX NO TO UPPER(MESSAGE REPLY, MES) !! NB: UPPER MUST FREE 'MES' PORT_STATE = DOWN %RESULT == NULL %FINISH TO UPPER(OPEN REPLY B, NULL) %IF NSL_SUFL # 0 %C %THEN PORT_STATE = DOWN %ELSE PORT_STATE = CONNECTED PORT_RL = NSL_FLAG>>4; ! TECHNICALLY IS FLAG NOT RL(SEE PUT OUTPUT) PORT_MAX FL = (NSL_FLAG>>1)&7; ! SBR REMOVAL CODE PORT_FL = 0; ! PORT_FL CONTAINS THE NO OF UNACK BLOCKS -> FREE SW(SEND BLOCK R): %IF PORT_RL = 0 %THEN TO UPPER(OUTPUT TRANSMITTED, NULL) I = NSS_FLAG>>4 %IF I = 0 %THEN I = 1 PORT_RL = PORT_RL+I %IF PORT_STATE = DISCONNECTING %AND NSS_FLAG&128 # 0 %START TO UPPER(CALL CLOSED, NULL) PORT_STATE = DOWN %FINISH %IF PORT_STATE = DISCON 2 %START; ! WAITING TO SEND DISCONNECT PORT_STATE = DISCONNECTING NSS_FN = 4; NSS_FLAG = 128; MES_LEN = 6 -> SEND TO NODE %FINISH ->FREE SW(STATUS R): -> FAIL %UNLESS PORT_STATE = ABORTING TO UPPER(CALL ABORTED, NULL); ! CONFIRMATION OF ABORT PORT_STATE = DOWN -> FREE SW(NIF R):-> FAIL SW(REMOVE): -> FAIL %IF KENT = 0 FORCE DOWN = 1; ! GET IT TO TIDY PORTS SW(REMOVE R): %IF FORCE DOWN # 0 %START PRINTSTRING("GATE: REMOVED OK TIDY PORTS -> FREE %FINISH DO ATT REM(ATTACH, MES) %RESULT == NULL REPLY: NSL_FN = NSL_FN!128 SEND TO NODE: TO NODE(MES) %RESULT == NULL FREE: %RESULT == MES; ! BLOCK IS PASSED BACK FOR ! NEXT READ FAIL: FAULT(100+FN, PORT N) PRINTSTRING("STATE ="); WRITE(PORT_STATE, 1); NEWLINE NODE MONITOR(NSL) %RESULT == MES %END !! %ROUTINE FROM HIGHER LEVEL %RECORD (MEF) %NAME MES %RECORD (NSI2F) %NAME NSS %INTEGER FN, PORT N, FLAG, REASON %SWITCH FUNCTION(ENABLE FACILITY:OPEN MESSAGE) PORT N = P_PORT FN = P_FN %IF PORT N > MAXT %AND FN <= ABORT CALL %THEN %C FAULT(2, PORT N) %AND %RETURN PORT == PORTA(PORT N) LN == PORT_LN; ! PICK UP OUTPUT LINE MES == P_MES; NSS == MES_NSL ->FUNCTION(FN) FUNCTION(ENABLE FACILITY): FACILITY(P_S1) = P_REPLY %RETURN FUNCTION(DISABLE FACILITY): FACILITY(P_S1) = 0 %RETURN FUNCTION(CALL REPLY): ! REPLY TO A 'CONNECT' FLAG = P_S1; ! 0 - REJECT, OTHERWISE NSL_FLAG MES == PORT_OUT Q_E; ! RECOVER CONNECT MESS %IF FLAG&127 = 0 %START; ! FAILED %IF FLAG = 0 %THEN FLAG = 128+8 %ELSE FLAG = 0 MES_NSL_SUFL = FLAG PORT_STATE = DOWN %ELSE MES_NSL_SUFL = 0 MES_NSL_DS = PORT_NO MES_NSL_FLAG = FLAG PORT_RL = FLAG>>1&7 PORT_FL = 0; PORT_MAX FL =FLAG>>4 PORT_STATE = CONNECTED %FINISH TO NODE (MES) %RETURN FUNCTION(ENABLE INPUT): ! ALLOW A BLOCK TO BE READ PORT_FL = PORT_FL+1 !! SBR REMOVAL CODE %IF SBRF#0 %AND PORT_MAX FL>=2 %AND PORT_FL=1 %C %THEN %RETURN REASON = SEND BL REPLY RB; ! REQUEST BUFFER SBR = SBR+1 -> DO REQUEST BUFFER FUNCTION(PUT OUTPUT): ! P_MES TO BE SENT %IF PORT_RL > 0 %START; ! ALLOWED TO SEND ONE PORT_RL = PORT_RL-1 NSS_FN = 4; NSS_SUFL = 0 NSS_ST = PORT_MT; NSS_SS = PORT_NO !! SBR REMOVAL CODE %IF SBRF#0 %AND PORT_MAX FL >=2 %AND PORT_FL#0 %START NSS_FLAG = PORT_FL<<4; PORT_FL = 0 %ELSE NSS_FLAG = 0 TO NODE(MES) %IF PORT_RL > 0 %THEN TO UPPER(OUTPUT TRANSMITTED, NULL) %ELSE !! REVERSE BUFFER LIMIT IS ZERO ???? FAULT(3, PORT N); FREE BUFFER(MES) %FINISH %RETURN FUNCTION(CLOSE CALL): ! CLOSE IT DOWN %IF PORT_STATE = CONNECTED %START %IF PORT_RL = 0 %START; ! UNABLE TO SEND JUST NOW PORT_STATE = DISCON 2; ! HOLD IT %RETURN %FINISH REASON = SEND BL DRB; ! SEND IT NOW %ELSE REASON = SEND BL REPLY DRB; ! REPLY TO A DISCONNECT PORT_STATE = DISCONNECTING ->DO REQUEST BUFFER FUNCTION(ABORT CALL): %IF PORT_STATE = CLEARING %THEN PORT_STATE = DOWN %AND %RETURN ! CAUSED BY LINE DOWN, SO NO STATUS %IF PORT_STATE = CONNECTED %THEN %C REASON = SEND STATUS RB %ELSE %C REASON = STATUS REPLY RB PORT_STATE = ABORTING -> DO REQUEST BUFFER FUNCTION(OPEN MESSAGE): FUNCTION(OPEN CALL): PORT N = 0 %IF L0_ATT FLAG#0 %OR L1_ATT FLAG # 0 %C %START; ! ATTACHED OK %CYCLE PORT N = MAXT, -1, 0 PORT == PORTA(PORT N) %IF PORT_STATE = DOWN %THEN %EXIT %REPEAT %IF PORT N = 0 %START !! FULL UP !! PRINTSTRING("Gate: Ports full %ELSE PORT_OWNER = P_REPLY; PORT_OWNER PORT = P_PORT PORT_TERM = P2_TERM; PORT_NODE = P2_NODE PORT_FL = P2_FLAG; PORT_RL = P2_FACILITY PORT_MT = OWN TERM; ! FOR NOW AT LEAST, ALWAYS MAIN ADDRESS %FINISH %FINISH P_SER = P_REPLY; P_REPLY = GATE SER P_S1 = PORT N; ! FILE 'DBUG5S' !***************************** !* DBUG4S * !*DATE: 04.DEC.79 * !***************************** !! STK = 300, STR = 1 %CONTROL K'100001' %PERMROUTINESPEC SVC(%INTEGER EP, R0, R1) %PERMINTEGERMAPSPEC INTEGER %PERMBYTEINTEGERMAPSPEC BYTEINTEGER %PERMINTEGERFNSPEC ADDR %PERMINTEGERFNSPEC ACC %SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG) %BEGIN %CONSTINTEGER MAP PSECT = 16; ! SUPERVISOR CALL TO MAP TO PSECT %CONSTBYTEINTEGERNAME ID = K'160030' %CONSTINTEGER VIR DISP=K'22'; ! DISP TO 1ST VERSION NO %CONSTBYTEINTEGERNAME INT = K'160060' %ROUTINESPEC PSECT %ROUTINESPEC DREG %ROUTINESPEC DSTACK %ROUTINESPEC OCTAL(%INTEGER N) %INTEGERFNSPEC ROCTAL %ROUTINESPEC DUMP(%INTEGER LOW, QUANT) %ROUTINESPEC REGISTERS %ROUTINESPEC BREAK POINT %ROUTINESPEC CLEAR(%INTEGER P) %ROUTINESPEC WAIT %ROUTINESPEC CORE(%INTEGER TYPE) %INTEGERMAPSPEC CONT(%INTEGER ADR) %BYTEINTEGERFNSPEC BYTECONT(%INTEGER ADR) %ROUTINESPEC RELEASE USER SEG %RECORDFORMAT SEGF(%INTEGER PAR, PDR, PT, X) %RECORDFORMAT PSECTF(%BYTEINTEGER X, Y, ID, STATE, %BYTEINTEGERARRAY %C NAME(0:3), %BYTEINTEGER PRIO, %INTEGER POFFQ, %C %INTEGERARRAY R(0:8), %C %INTEGER TRPV, %RECORD (SEGF) %ARRAY SEG(0:7)) ! NB: R(0-8) ARE R0, R1, R2, R3, R4, R5, PC, PS, SP %RECORD (PSECTF) %NAME P %OWNINTEGERARRAY MAX(0:7) %RECORDFORMAT D1F(%INTEGER X) %RECORDFORMAT D2F(%INTEGERNAME N) %RECORDFORMAT D3F(%RECORD (PSECTF) %NAME P) %RECORD (D2F) %NAME D2 %RECORD (D1F)D1 %RECORD (D3F) %NAME D3 %INTEGER I, J, K, TASK, STRM, PST, STACK, N %INTEGER PROG, ISTACK, S, IST, S2, TFLAG %OWNINTEGER HW REGS = -1 %OWNINTEGERARRAY BP(1:20) = 0(20) %OWNINTEGERARRAY REGC(0:8) %INTEGERARRAY CONT BP(1:20) %OWNINTEGER LAST SEG =- 1; ! LAST USER SEG ACCESSED %OWNINTEGER HEX FLAG = 0; ! PRINT IN OCTAL (0) OR HEX (1) %CONSTINTEGER COM LIM = 18 %OWNBYTEINTEGERARRAY COMM(0:COM LIM) = %C 'E', 'I', 'R', 'P', 'W', 'B', 'C', 'A', 'D', '?', 'N', 'O', 'T', 'F', 'L', 'S', '+', '-', 'H' %SWITCH SW(0:COM LIM) !! D2 == D1; D3 == D2 TASK = ID STRM = 0 PST = 0; PROG = 0 MAP HWR(5) MAX(7) = K'17777' !! LOOP2: NEWLINES(2) %IF STRM # 0 TFLAG = 0 SELECT OUTPUT(0) PROMPT(' Debug?') SKIPSYMBOL %IF NEXTSYMBOL = NL %IF NEXTSYMBOL >= '0' %AND NEXTSYMBOL <= '7' %START CORE(0) -> LOOP2 %FINISHELSESTART READSYMBOL(S); READSYMBOL(S2) I = 0 %WHILE I <= COM LIM %CYCLE %IF S = COMM(I) %START %IF I <= 3 %AND PST = 0 %START PRINTSTRING('T NOT SET -> SKP %FINISH INT = 0 -> SW(I) %FINISH I = I+1 %REPEAT PRINTSTRING(' S,A,I,R,P,W,N,O,B OR C PLEASE! SKP: SKIPSYMBOL %WHILE NEXTSYMBOL # NL %AND S2 # NL -> LOOP2 %FINISH !! SW(12): ! T - TASK NUMBER LOOP: PROMPT(' Task ID?') ->LOOP2 %IF NEXTSYMBOL='?' HW REGS = -1 TASK = ROCTAL; SKIPSYMBOL SVC(MAP PSECT, TASK, 5) PST = ACC %IF PST = 0 %START PRINTSTRING('ID ? -> LOOP %FINISH D1_X = PST P == D3_P PRINTSYMBOL(P_NAME(I)) %FOR I = 0, 1, 3 NEWLINE RELEASE USER SEG LAST SEG = -1 %CYCLE I = 0, 1, 7 HW REGS = I %IF P_SEG(I)_PAR = K'007600'; ! H/W REGS N = P_SEG(I)_PDR %IF N&7 = 0 %THEN N = 0 %ELSE %C N = (N+K'400') >> 2&K'177700' MAX(I) = N %REPEAT REGC(I) = P_R(I) %FOR I = 0, 1, 8 PROG = K'40000' IST = K'140000'; ! HAVE TO BE BETTER LATER!! -> LOOP2 !! SW(15): ! STOP RELEASE USER SEG CLEAR('A') %STOP !! SW(1): ! IMP STACK SELECT OUTPUT(STRM) DSTACK; -> LOOP2 !! SW(18): ! HEX TOGGLE HEX FLAG = HEX FLAG!!1 -> LOOP2 !! SW(2): ! REGISTERS SELECT OUTPUT(STRM) DREG; -> LOOP2 !! SW(3): ! PSECT SELECT OUTPUT(STRM) PSECT; -> LOOP2 !! SW(4): ! WAIT WAIT; -> LOOP2 SW(5): ! BREAK POINT BREAK POINT; -> LOOP2 !! SW(6): ! CLEAR BREAK POINT CLEAR(0); -> LOOP2 SW(9): ! ? -> LOOP2 !! SW(10): ! N(EW) PROGRAM CODE PRINTSTRING(' NEW PROGRAM CODE?'); PRINTSYMBOL(0) PROG = ROCTAL -> LOOP2 !! SW(11): ! O(UTPUT) STREAM %IF S2 # ' ' %THEN PROMPT('STREAM?') STRM = ROCTAL -> LOOP2 !! SW(7): ! ALL SELECT OUTPUT(STRM) PSECT TFLAG = 0; ! LOOK AT TASK VIRTUAL MEMORY %CYCLE I = K'40000', K'20000', K'160000' NEWLINES(5) DUMP(I, K'20000') %REPEAT -> LOOP2 !! SW(8): ! DUMP CORE PROMPT('DUMP FROM?') %IF S2 = NL I = ROCTAL PROMPT('LENGTH?') %IF NEXTSYMBOL = NL SELECT OUTPUT(STRM) DUMP(I, ROCTAL) -> LOOP2 !! SW(16): ! '+' IMPLIED COMM SW(17): ! '-' - IMPLIED COMM CORE(I) SW(13): ! F - FILE BACK TO DISC SW(14): ! L - LOAD FILE SW(0): ! E - EXTERNALS -> LOOP2 !! %ROUTINE PSECT %INTEGER I %RECORD (SEGF) %NAME SEG TFLAG = 1 PRINTSYMBOL(P_NAME(I)) %FOR I = 0, 1, 3 PRINTSTRING(' STATE = '); OCTAL(P_STATE) PRINTSTRING(' POFFQ: '); OCTAL(P_POFFQ) DREG %RETURN %IF INT#0 PRINTSTRING('SEGMENTS NO ADDR LEN %CYCLE I = 0, 1, 7 %RETURN %IF INT # 0 %IF MAX(I) > 0 %START SEG == P_SEG(I) WRITE(I, 1); SPACE; OCTAL(SEG_PAR) SPACE; OCTAL(MAX(I)) SPACES(2) %IF SEG_PDR&7 = 2 %THEN PRINTSYMBOL('R') %ELSE %C PRINTSYMBOL('W') NEWLINE %FINISH %REPEAT %END %ROUTINE DREG REGISTERS %RETURN %IF INT#0 PRINTSTRING('STACK='); OCTAL(REGC(8)) NEWLINE %END %ROUTINE DSTACK NEWLINES(2) DUMP(IST, MAX(6)-2) %END !! %ROUTINE REGISTERS %OWNBYTEINTEGERARRAY REGS(0:15) = %C 'R', '0', 'R', '1', 'R', '2', 'R', '3', 'R', '4', 'R', '5', 'P', 'C', 'P', 'S' %INTEGER I, J NEWLINE J = 0 %CYCLE I = 0, 1, 7 %RETURN %IF INT # 0 PRINTSYMBOL(REGS(J)); PRINTSYMBOL(REGS(J+1)) PRINTSTRING(' = ') OCTAL(REGC(I)) SPACES(3) %IF I = 3 %THEN NEWLINE J = J+2 %REPEAT NEWLINE %END !! %INTEGERFN ROCTAL %INTEGER N, I, J, SIGN N = 0; SIGN = 1 %WHILE NEXTSYMBOL < '0' %OR NEXTSYMBOL > '7' %CYCLE %STOPIF NEXTSYMBOL = 'S' %IF NEXTSYMBOL = '-' %THEN SIGN =- 1 SKIPSYMBOL %REPEAT %CYCLE I = 1, 1, 6 J = NEXTSYMBOL-'0' %IF J < 0 %OR J > 7 %THENRESULT = N*SIGN N = N << 3+J SKIPSYMBOL %REPEAT %RESULT = N %END %ROUTINE DUMP(%INTEGER LOW, QUANT) %INTEGER I, J, N, N1, CHAR, NE, ZFLAG, INITF, SEGNO ZFLAG = 0; ! SET TO PRINT MESSAGE IF ALL ! ZEROES INITF = 0; ! TO SUPPRESS N> 13 %IF SEGNO = HW REGS %START PRINTSTRING(" Cannot Dump - Points to Hardware Registers %RETURN %FINISH %WHILE QUANT >= 0 %CYCLE %IF INT # 0 %THEN %RETURN %IF N&K'17777' >= MAX(SEGNO) %THENEXIT N1 = N; NE = 8; J = 0 %WHILE NE # 0 %CYCLE J = J!CONT(N) N = N+2; NE = NE-1 %REPEAT %IF J = 0 %START; ! ALL ZEROES %IF ZFLAG = 0 %START PRINTSTRING(' ZEROES ZFLAG = ZFLAG+1 %FINISH %FINISHELSESTART ZFLAG = 0; N = N1; ! ENSURE ZFLAG IS OK OCTAL(N); PRINTSYMBOL('>') NE = 8 %WHILE NE # 0 %CYCLE %IF N >= LOW %OR INITF # 0 %THEN OCTAL(CONT(N)) %C %ELSE SPACES(6) SPACE N = N+2; NE = NE-1 %REPEAT PRINTSTRING('*') NE = 16 %WHILE NE # 0 %CYCLE CHAR = BYTECONT(N1)&127 %IF CHAR < 32 %OR CHAR > 126 %THEN CHAR = ' ' PRINTSYMBOL(CHAR) N1 = N1+1; NE = NE-1 %REPEAT NEWLINE %FINISH QUANT = QUANT-16 INITF = INITF+1 %REPEAT %END %ROUTINE OCTAL(%INTEGER N) %INTEGER I %CONSTBYTEINTEGERARRAY CHAR(0:15) = '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' %IF HEX FLAG = 0 %START %CYCLE I = 15, -3, 0 PRINTSYMBOL((N >> I)&7+'0') %REPEAT %ELSE; ! PRINT IN HEX %CYCLE I = 12, -4, 0 PRINTSYMBOL(CHAR((N>>I)&15)) %REPEAT %FINISH %END %ROUTINE BREAK POINT %INTEGER A, I, P %IF S2 # ' ' %START PROMPT('ADDR?') %FINISH A = ROCTAL+PROG %CYCLE I = 1, 1, 20 %IF BP(I) = 0 %START; ! FREE SLOT BP(I) = A P = CONT(A) CONT BP(I) = P CONT(A) = K'777' PRINTSTRING('BP: '); OCTAL(I) PRINTSTRING(' ADDR='); OCTAL(A) PRINTSTRING(' CONT='); OCTAL(CONT BP(I)); NEWLINE %RETURN %FINISH %REPEAT PRINTSTRING(' BP TABLE FULL! %END !! %ROUTINE CLEAR BP(%INTEGER N) %INTEGERNAME P P == CONT(BP(N)) P = CONT BP(N) BP(N) = 0 %END !! %ROUTINE CLEAR(%INTEGER P) %INTEGER I, N %IF S2 # ' ' %AND P # 'A' %START PROMPT('NO?') %FINISH %IF P = 0 %THEN P = NEXTSYMBOL; N =- 1 %IF P # 'A' %THEN N = ROCTAL %IF N < 0 %START %CYCLE I = 1, 1, 20 CLEAR BP(N) %IF BP(I) # 0 %REPEAT %FINISHELSESTART %IF N <= 0 %OR N > 20 %OR BP(N) = 0 %START PRINTSTRING('? %FINISHELSE CLEAR BP(N) %FINISH %END !! %ROUTINE WAIT *K'104001'; ! EMT WAITC %END !! %ROUTINE CORE(%INTEGER TYPE) %OWNINTEGER LAST %INTEGER I, J, N, S, C, STACK, REPT !! !! FORMAT :- !! : PRINTS VALUE !! +C : PRINTS VALUE ! N+CODE BASE !! +RN : PRINTS VALUE ! N+REGISTER N !! DITTO = : PLANTS OCTAL !! REPT = 1 %IF TYPE = 0 %START N = ROCTAL READSYMBOL(S) %IF S = '+' %START READSYMBOL(C) %IF C = 'C' %THEN N = N+PROG %ELSESTART %IF C = 'G' %THEN N = N+ISTACK+K'20' %ELSESTART %IF C # 'R' %START REJ: PRINTSTRING(' ? %RETURN %FINISH READSYMBOL(C) C = C-'0' -> REJ %IF C < 0 %OR C > 5 N = N+REGC(C) %FINISH; %FINISH READSYMBOL(S) %FINISH %ELSE %IF TYPE = 16 %THEN N = LAST+2 %ELSE N = LAST-2 S = S2 %FINISH %UNTIL REPT = 0 %CYCLE LAST = N OCTAL(N); PRINTSTRING(' : ') %IF N&1 # 0 %THEN PRINTSTRING(' ODD!') %ELSESTART %IF N&K'17777' >= MAX(N >> 13) %THEN PRINTSTRING( %C ' SEGMENT?') %ELSESTART OCTAL(CONT(N)) %IF S = '=' %START C = ROCTAL CONT(N) = C PRINTSTRING(' -> '); OCTAL(C) %FINISH %IF S = '*' %START REPT = ROCTAL; S = 0 %FINISH %FINISH %FINISH NEWLINE REPT = REP ! PASS THE GATE "PORT NO" P_FN = OPEN REPLY A PON(P) %UNLESS FN = OPEN MESSAGE %IF PORT N = 0 %START %IF FN = OPEN MESSAGE %START FLAG = P_PORT; FN = P_SER; ! HOLD FOR 'FREE' FREE BUFFER(MES) P_LEN = FLAG; P_SER = FN P_MES == NULL P_FN = MESSAGE REPLY PON(P) %FINISH %RETURN %FINISH PORT_STATE = CONNECTING; PORT_LN == NULL REASON = SEND CONNECT %IF FN = OPEN MESSAGE %START REASON = SEND MESSAGE PORT_RL = P_MES_NSL_DS; PORT_FL = 0 %FINISH DO REQUEST BUFFER: P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = REQUEST BUFFER P_PORT = PORT_NO; P_S1 = REASON P_LEN = 0; ! REQUEST A BIG BUFFER %IF FN = OPEN MESSAGE %THEN BUFFER ARRIVED %ELSE %C PON(P) %END %ROUTINE TO UPPER(%INTEGER CALL, %RECORD (MEF) %NAME MES) P_SER = PORT_OWNER; P_REPLY = GATE SER P_FN = CALL; P_MES == MES; P_PORT = PORT_NO PON(P) %END %ROUTINE BUFFER ARRIVED %SWITCH SUB STATE(ATTACH RB:SEND CONNECT) %RECORD (MEF) %NAME MES %RECORD (NSI2F) %NAME NSS %RECORD (NSI1F) %NAME NSL MES == P_MES NSS == MES_NSL; NSL == NSS PORT == PORTA(P_PORT); ! MAY BE ZERO NSS_SUFL = 0; NSS_ST = PORT_MT; NSS_SS = PORT_NO NSS_FLAG = 0 NSS_FN = SEND BLOCK+REPLY %IF P_S1 > ATTACH RB %THEN LN == PORT_LN ->SUB STATE(P_S1) SUB STATE(ATTACH RB): LN == LNA(P_PORT) %IF FORCE DOWN = 0 %START DO ATT REM(ATTACH , MES) %ELSE DO ATT REM(REMOVE, MES) %FINISH %RETURN SUB STATE(STATUS REPLY RB): NSS_FN = 128+5; ! STATUS REPLY PORT_STATE = DOWN; ! FINISHED NOW -> SET DISC BIT; ! SET DISCONNECT AND SEND IT SUB STATE(SEND STATUS RB): !* ABORT THE CONNECTION NSS_FN = 5; ! STATUS -> SET DISC BIT; ! SET DISCONNECT AND SEND IT SUB STATE(SEND BL REPLY DRB): ! DISCONNECT REPLY NSS_FN = 4+128; ! SEND BLOCK REPLY PORT_STATE = DOWN; ! FINISHED NOW SET DISC BIT: NSS_FLAG = 128; ! SET THE NSI DISCONNECT BIT ->ONW SUB STATE(SEND BL REPLY RB): ! NORMAL REPLY NSS_FN = 128+4 ! SBR REMOVAL CODE %IF PORT_FL = 0 %START; ! ALREADY SENT ! FREE BUFFER(MES); %RETURN %FINISH %IF SBRF = 0 %START; ! NO SBR REMOVAL NSS_FLAG = X'10'; PORT_FL = PORT_FL-1 %ELSE NSS_FLAG = PORT_FL<<4; PORT_FL = 0 %FINISH ONW: NSS_FLEN = 0 MES_LEN = 6 ->SEND IT SUB STATE(SEND BL DRB): ! BLOCK WITH DISCONNECT NSS_FN = 4; ! SEND BLOCK -> SET DISC BIT; ! SET NSI DISCONNECT AND SEND IT SUB STATE(SEND MESSAGE): SUB STATE(SEND CONNECT): NSL_FN = P_S1-SEND CONNECT+3 NSL_SN = 0; NSL_DN = PORT_NODE NSL_DT = PORT_TERM; NSL_DS = PORT_RL; ! TERM+FACILITY NSL_FLAG = PORT_FL MES_LEN = 10 %UNLESS P_S1 = SEND MESSAGE PORT_FL = NSL_FN; ! REMEMBER TYPE %IF (L1_ATT FLAG # 0 %AND NSL_DN = L1_NODE NUMBER) %OR %C L0_ATT FLAG = 0 %THEN LN == L1 %ELSE LN == L0 PORT_LN == LN; ! NEEDED FOR REPLY ETC %IF L0_ATT FLAG=0 %AND L1_ATT FLAG=0 %START PORT_STATE = DOWN NSL_SUFL = X'81' TO UPPER(OPEN REPLY B, MES) %RETURN %FINISH SEND IT: TO NODE(MES) %END %ROUTINE TIDY PORTS %INTEGER I %CYCLE I = 1, 1, MAXT PORT == PORTA(I) %IF PORT_STATE # DOWN %AND PORT_LN == LN %START %IF PORT_STATE = CONNECTING %START %IF PORT_FL = SEND CONNECT %START; ! CONNECT P_S1 = 125; ! LINE DOWN TO UPPER(OPEN REPLY B, NULL) %ELSE; ! SEND MESSAGE P_LEN = PORT_OWNER PORT TO UPPER(MESSAGE REPLY, NULL) %FINISH PORT_STATE = DOWN; ! SHOULD REPLY %ELSE TO UPPER(CALL ABORTED, NULL) %IF DISCONNECTING <= PORT_STATE <= ABORTING %C %OR PORT_STATE = CONNECTING %THEN %C PORT_STATE = DOWN %ELSE %C PORT_STATE = CLEARING %FINISH %FINISH %REPEAT %END %ROUTINE FREE BUFFER(%RECORD (MEF) %NAME MES) P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = RELEASE BUFFER; P_MES == MES PON(P) %END %ROUTINE FAULT(%INTEGER N, PORT N) PRINTSTRING('GATE> FAULT'); WRITE(N, 1) PRINTSTRING(' STRM:'); WRITE(PORT N, 1) %IF LN == NULL %START PRINTSTRING(" LNX %ELSE %START %IF LN == L0 %THEN PRINTSTRING(" LN0 ") %C %ELSE PRINTSTRING(" LN1 %FINISH %END %ROUTINE DO ATT REM(%INTEGER TYPE, %RECORD (MEF) %NAME MES) %INTEGER TERM, NODE %IF TYPE = SUBATTACH %START TYPE = ATTACH; NODE=0; TERM = SUB ATTACH FLAG %ELSE NODE = OWN TERM; TERM = OWN TERM %FINISH MES_NSL_FN = TYPE MES_NSL_SUFL = 0 MES_NSL_ST = TERM; MES_NSL_SS = 0 MES_NSL_SN = NODE; MES_NSL_DN = NODE MES_NSL_DT = TERM; MES_NSL_DS = 255 MES_NSL_FLAG = 0 MES_LEN = 12 TO NODE(MES) %END %ROUTINE NODE MONITOR(%RECORD (NSI3F) %NAME NSA) %INTEGER I, N, J, K, P P = 11 SPACES(2) !! %IF NSI1_SUFL&X'80'#0 %THEN P=20 %CYCLE I = 0, 1, P N = NSA_A(I) %CYCLE J = 4, -4, 0 K = (N >> J)&15 %IF K > 9 %THEN PRINTSYMBOL(K+'A'-10) %ELSE %C PRINTSYMBOL(K+'0') %REPEAT SPACE %REPEAT NEWLINE %END %ENDOFPROGRAM %CYCLE I = 0, 1, P N = N+2 %REPEAT %END %INTEGERMAP CONT(%INTEGER ADR) %OWNINTEGER DUMMY = 0 %INTEGER SEG %IF PST = 0 %AND ADR&K'160000'#0 %START D1_X = ADR&K'137777' -> RES %FINISH %IF TFLAG = 0 %START SEG = ADR >> 13 %IF ADR&K'17777' >= MAX(SEG) %THEN %RESULT == DUMMY %IF SEG = HWREGS %THEN %RESULT == DUMMY %IF SEG # LAST SEG %START RELEASE USER SEG MAP VIRT(TASK, SEG, 4) LAST SEG = SEG %FINISH D1_X = K'100000'+(ADR&K'17777') %ELSE D1_X = ADR %FINISH RES: %RESULT == D2_N %END %BYTEINTEGERFN BYTECONT(%INTEGER ADR) %INTEGER X X = CONT(ADR&K'177776') %IF ADR&1 # 0 %THEN X = X >> 8 %ELSE X = X&X'FF' %RESULT = X %END %ROUTINE RELEASE USER SEG %IF LAST SEG #- 1 %THEN MAP VIRT(0, -1, 4) %END %ENDOFPROGRAM %CONTROL K'100001' %BEGIN %INTEGER I,J,K,X,Y,Z,BLOCK %RECORDFORMAT PF(%BYTEINTEGER SER, REPLY, %INTEGER A, %C %BYTEINTEGERARRAYNAME B, %INTEGER C) %RECORD (PF) P %OWNBYTEINTEGERARRAY ARR(0:512) %CONSTBYTEINTEGERNAME ID = K'160030' %CONSTBYTEINTEGERNAME INT = K'160060' PROMPT("GO?"); READ(X) BLOCK=0 %CYCLE I = 1, 1, 30000 P_SER=3; P_REPLY = ID %IF BLOCK>1000 %THEN BLOCK=BLOCK-1000 %IF BLOCK<200 %THEN BLOCK = BLOCK+200 P_A = 0; P_B == ARR; P_C=BLOCK PON(P); P_SER=0 POFF(P) BLOCK = BLOCK+X %EXIT %IF INT#0 %REPEAT PRINTSTRING("COUNT ="); WRITE(I, 1); NEWLINE %ENDOFPROGRAM ! FILE 'SYS_DPAL6S' !************ !* DPAL6S * !*14.SEP.79* !************ %PERMROUTINESPEC SVC(%INTEGER EP, %INTEGERNAME P1, %INTEGER P2) %PERMINTEGERMAPSPEC INTEGER(%INTEGER X) %PERMBYTEINTEGERMAPSPEC BYTEINTEGER(%INTEGER X) %PERMINTEGERFNSPEC ADDR(%INTEGERNAME X) %PERMINTEGERFNSPEC ACC %CONSTINTEGERNAME DUMMY = 0 %BEGIN %RECORDFORMAT SEGF(%INTEGER PAR, PDR, PT, X) %RECORDFORMAT PSECTF(%INTEGER Q, %BYTEINTEGER ID, STATE, %C %BYTEINTEGERARRAY NAME(0:3), %C %BYTEINTEGER PRIO, %INTEGER POFFQ, R0, R1, R2, R3, %C R4, R5, PC, PS, SP, TRPV, %RECORD (SEGF) %ARRAY SEG(0:7)) %RECORDFORMAT PSECT2F(%INTEGERARRAY A(0:47)) %RECORD (PSECTF) P %RECORD (PSECT2F) %NAME P2 %CONSTBYTEINTEGERNAME INT CH = K'160060' %OWNINTEGERARRAY MAX(0:7) %OWNINTEGER PERM PRINTED=0 %OWNINTEGER EXT BITS = 0 %OWNINTEGER PPT = 0 %OWNINTEGERARRAY PRIN(0:100) %INTEGER N %RECORDFORMAT D1F(%INTEGERNAME X) %RECORDFORMAT D3F(%RECORD (PSECTF) %NAME P) %RECORD (D1F)D1 %RECORD (D3F) %NAME D3 %ROUTINE DA(%INTEGER BLOCK, %INTEGERNAME ADD, %INTEGER COMM) %CONSTBYTEINTEGERNAME ID = K'160030' %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, %INTEGER A1, %C %INTEGERNAME A2, %INTEGER A3) %RECORD (P2F)P2 P2_SER = 3; P2_REPLY = ID P2_A1 = 0 P2_A2 == ADD P2_A3 = BLOCK PONOFF(P2) %IF P2_A1 # 0 %THEN PRINTSTRING('DISC ERROR ') %ANDSTOP %END %INTEGERMAP CONT(%INTEGER J) %CONSTINTEGER READ = 0 %OWNINTEGERARRAY BUF(0:255) %OWNINTEGER CURR =- 1 %INTEGER BNUM, SECTOR, K, L L = J >> 6 BNUM = (L+EXT BITS)>>3+520+K'020000'; ! + 4672 %IF CURR # BNUM %START CURR = BNUM DA(BNUM, BUF(0), READ) %FINISH %RESULT == BUF((J&511) >> 1) %END %ROUTINESPEC PSECT %ROUTINESPEC DREG %ROUTINESPEC DSTACK %ROUTINESPEC REGISTERS %INTEGERFNSPEC ROCTAL %ROUTINESPEC DUMP(%INTEGER LOW, QUANT, DISP) %ROUTINESPEC OCTAL(%INTEGER I) %BYTEINTEGERFNSPEC BYTECONT(%INTEGER ADR) %ROUTINESPEC VIRT MEMORY %ROUTINESPEC PRINT MESSAGES %ROUTINESPEC GET PSECT(%INTEGER B) %CONSTINTEGER PSECT BASE PT = K'130' %CONSTINTEGER LAST32BASE = K'132' %CONSTINTEGER CPUQ BASE = K'124' %CONSTINTEGER TASK LOW LIMIT = 30 %CONSTINTEGER TASK LIMIT = 55 %INTEGER A, B, C, I, TFLAG, PST, IST, STACK D3 == D1 P2 == P PROMPT("Title?") SELECT OUTPUT(1) %CYCLE READSYMBOL(I); PRINTSYMBOL(I) %EXIT %IF I = NL %REPEAT PRINTSYMBOL(12); NEWLINE %CYCLE SELECT OUTPUT(0) EXT BITS = 0 PROMPT('DPAL:') SELECT OUTPUT(1) A = NEXTSYMBOL %IF A = 'T' %OR A = 'F' %START ! DUMP PSECTS PRINT MESSAGES %IF A = 'F' B = CONT(PSECT BASE PT) N = TASK LOW LIMIT %CYCLE %EXITIF N > TASK LIMIT C = CONT(B) -> BOT %IF C = 0 PRINTSYMBOL(BYTECONT(C+I)) %FOR I = 4, 1, 7 SPACE; OCTAL(C); SPACE; OCTAL(CONT(C)) SPACE; OCTAL(CONT(C+2)) PRINTSTRING(' PC = '); OCTAL(CONT(C+K'30')) NEWLINE %IF A = 'F' %START GET PSECT(N) PSECT VIRT MEMORY PRINTSYMBOL(12) %FINISH BOT: B = B+2; N = N+1 %IF INT CH#0 %THEN INT CH=0 %AND %EXIT %REPEAT SKIPSYMBOL; SKIPSYMBOL %IF A = 'F' %START PRINTSTRING('KERNAL DATA AREAS DUMP(0, K'1000', 0) DUMP(K'65', K'5000', 0) %FINISH %CONTINUE %FINISH %IF A = 'P' %OR A = 'Q' %START; ! DUMP A PSECT READSYMBOL(I); %IF I = NL %THEN PROMPT('PSECT?') B = ROCTAL; SKIPSYMBOL GET PSECT(B) PRINTSYMBOL(12); ! NEWPAGE NEWLINE PSECT %IF A = 'Q' %THEN VIRT MEMORY %CONTINUE %FINISH %IF A = 'M' %START PRINT MESSAGES SKIPSYMBOL; SKIPSYMBOL %CONTINUE %FINISH A = ROCTAL; %STOPIF A = 1 %OR A = 'S' READSYMBOL(B); %IF B = NL %THEN PROMPT('LEN?:') B = ROCTAL; SKIPSYMBOL DUMP(A, B, 0) NEWLINE %REPEAT %ROUTINE DREG STACK = PST+K'14' TFLAG = 1 REGISTERS PRINTSTRING('STACK='); OCTAL(CONT(PST+K'34')) NEWLINE %END %ROUTINE DSTACK NEWLINES(2) DUMP(IST, K'13776', 0) %END !! %ROUTINE REGISTERS %OWNBYTEINTEGERARRAY REGS(0:15) = %C 'R', '0', 'R', '1', 'R', '2', 'R', '3', 'R', '4', 'R', '5', 'P', 'C', 'P', 'S' %INTEGER I NEWLINE %CYCLE I = 0, 2, 14 PRINTSYMBOL(REGS(I)); PRINTSYMBOL(REGS(I+1)) PRINTSTRING(' = ') OCTAL(CONT(STACK+I)) SPACES(3) %IF I = 6 %THEN NEWLINE %REPEAT NEWLINE %END !! %INTEGERFN ROCTAL %INTEGER N, I, J N = 0 %WHILE NEXTSYMBOL < '0' %OR NEXTSYMBOL > '7' %CYCLE %STOPIF NEXTSYMBOL = 'S' SKIPSYMBOL %REPEAT %CYCLE I = 1, 1, 6 J = NEXTSYMBOL-'0' %IF J < 0 %OR J > 7 %THENRESULT = N N = N << 3+J SKIPSYMBOL %REPEAT %RESULT = N %END %ROUTINE DUMP(%INTEGER LOW, QUANT, DISP) %INTEGER I, J, N, N1, CHAR, NE, ZFLAG, INITF EXT BITS = LOW&K'6000'; ! LOW IS IN PAGES LOW = LOW<<6; ! NOW DUMP TOP BITS ZFLAG = 0; ! SET TO PRINT MESSAGE IF ALL ! ZEROES INITF = 0; ! TO SUPPRESS N= 0 %CYCLE %IF INT CH#0 %THEN EXT BITS=0 %AND %RETURN %IF INT CH # 0 %START INT CH = 0; %RETURN %FINISH N1 = N; NE = 8; J = 0 %WHILE NE # 0 %CYCLE J = J!CONT(N) N = N+2; NE = NE-1 %REPEAT %IF J = 0 %START; ! ALL ZEROES %IF ZFLAG = 0 %START PRINTSTRING(' ZEROES ZFLAG = ZFLAG+1 %FINISH %FINISHELSESTART ZFLAG = 0; N = N1; ! ENSURE ZFLAG IS OK OCTAL(N+DISP); PRINTSYMBOL('>') NE = 8 %WHILE NE # 0 %CYCLE %IF N >= LOW %OR INITF # 0 %THEN OCTAL(CONT(N)) %C %ELSE SPACES(6) SPACE N = N+2; NE = NE-1 %REPEAT PRINTSTRING('*') NE = 16 %WHILE NE # 0 %CYCLE CHAR = BYTECONT(N1)&127 %IF CHAR < 32 %OR CHAR > 126 %THEN CHAR = ' ' PRINTSYMBOL(CHAR) N1 = N1+1; NE = NE-1 %REPEAT NEWLINE %FINISH QUANT = QUANT-16 INITF = INITF+1 %IF N = 0 %START; ! OVER 32K BDRY EXT BITS = EXT BITS+K'2000' %FINISH %REPEAT EXT BITS = 0 %END %ROUTINE OCTAL(%INTEGER N) %INTEGER I %CYCLE I = 15, -3, 0 PRINTSYMBOL((N >> I)&7+'0') %REPEAT %END %BYTEINTEGERFN BYTECONT(%INTEGER ADR) %INTEGER X X = CONT(ADR&K'177776') %IF ADR&1 # 0 %THEN X = X >> 8 %ELSE X = X&X'FF' %RESULT = X %END %ROUTINE PSECT %INTEGER I %RECORD (SEGF) %NAME SEG TFLAG = 1 PRINTSYMBOL(BYTECONT(PST+I)) %FOR I=4, 1, 7 PRINTSTRING(' STATE = '); OCTAL(BYTECONT(PST+3)) PRINTSTRING(' POFFQ: '); OCTAL(CONT(PST+10)) %IF CONT(PST)#0 %START PRINTSTRING(" ON CPU Q, LINK =") OCTAL(CONT(PST)) %FINISH DREG PRINTSTRING('SEGMENTS NO ADDR LEN %CYCLE I = 0, 1, 7 %IF MAX(I) > 0 %START SEG == P_SEG(I) WRITE(I, 1); SPACE; OCTAL(SEG_PAR) SPACE; OCTAL(MAX(I)) SPACES(2) %IF SEG_PDR&7 = 2 %THEN PRINTSYMBOL('R') %ELSE %C PRINTSYMBOL('W') NEWLINE %FINISH %REPEAT %END %ROUTINE VIRT MEMORY %INTEGER I, ADD, K %CYCLE I = 0, 1, 7 %IF MAX(I) # 0 %START %IF I = 1 %START %CONTINUE %IF PERM PRINTED # 0 PERM PRINTED = PERM PRINTED+1 %FINISH NEWLINES(5) ADD = P_SEG(I)_PAR %IF ADD = K'7600' %THEN %CONTINUE %IF PPT # 0 %START %CYCLE K = 0, 1, PPT-1 %IF ADD = PRIN(K) %START PRINTSTRING(" ALREADY PRINTED ->SKIP %FINISH %REPEAT %FINISH PRIN(PPT) = ADD; PPT = PPT+1 DUMP(ADD, MAX(I), (I << 13)-(ADD<<6)) %FINISH SKIP: %REPEAT %END %ROUTINE PRINT MESSAGES %INTEGER A A = CONT(LAST32BASE) %CYCLE I = A, K'10', A+128 %IF CONT(I) # 0 %OR CONT(I+2) # 0 %START WRITE(BYTECONT(I), 3); WRITE(BYTECONT(I+1), 3) %CYCLE B = I+2, 2, I+6 SPACE; OCTAL(CONT(B)) %REPEAT NEWLINE %IF INT CH#0 %THEN INT CH=0 %AND %RETURN %FINISH %REPEAT %END %ROUTINE GET PSECT(%INTEGER B) %INTEGER I, N PST = CONT(CONT(PSECT BASE PT)+(B-TASK LOW LIMIT)*2) %CYCLE I = 0, 1, 47 P2_A(I) = CONT(PST+I*2) %REPEAT %CYCLE I = 0, 1, 7 N = P_SEG(I)_PDR %IF N&7 = 0 %THEN N = 0 %ELSE N = (N+K'400') >> 2&K'177700' MAX(I) = N %REPEAT %END %ENDOFPROGRAM AME FILE) %ROUTINE TO TT(%INTEGER FN) %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%BYTEINTEGERARRAYNAME %C A2,%INTEGER A3) %RECORD(PF) P P_SERVICE=TT SER; P_REPLY=ID P_A1=FN; P_A2==LINE; P_A3=120 PON(P) %END %ROUTINE MESSAGE(%INTEGER DEV,%STRING(23) MES) %INTEGER I %CONSTSTRING(2)%ARRAY DEVS(TT:BT)='TT','LO','CR','LP','LP','??','PP','BT' PRINT STRING(DEVS(DEV)); PRINT SYMBOL(':') PRINT STRING(MES) %END %INTEGERFN READ ADDRESS !! USES GLOBALS NODE, TERM AND STRM %INTEGER K %INTEGERFN SIG LPTR = LPTR+1 %WHILE LINE(LPTR)=' ' %RESULT = LINE(LPTR) %END %INTEGERFN R NUM %INTEGER J, N N=0 %CYCLE J=LINE(LPTR) %UNLESS '0' <= J <= '9' %THEN %RESULT = N LPTR = LPTR+1 N = N*10+J-'0' %REPEAT %END NODE = TARGET NODE; ! USUALLY ZERO %IF MATCH(EMAS NAME) %START TERM = EMAS NUMBER ADD NODE: NODE = TERM %RESULT = 1 %FINISH %IF MATCH(E2970NAME) %THEN TERM=E2970NUMBER %AND ->ADD NODE %IF MATCH(INFO NAME) %THEN TERM=INFO NUMBER %AND ->ADD NODE %IF MATCH(E2980 NAME) %START TERM = E2980T; ->ADD NODE %FINISH NODE = 0; ! DEPENDS ON USER SPECIFING K = SIG; LPTR = LPTR+1 %IF K = 'N' %START; ! SPECIFY NODE NUMBER NODE = RNUM K = LINE(LPTR); LPTR = LPTR+1 %FINISH %RESULT = 0 %UNLESS K='T' TERM = RNUM; K=LINE(LPTR); LPTR=LPTR+1 %IF K='S' %START STRM = RNUM; K=LINE(LPTR); LPTR=LPTR+1 %FINISH %RESULT = 0 %UNLESS K = ' ' LPTR = LPTR-1 %RESULT = 1 %END %PREDICATE MATCH(%BYTEINTEGERARRAYNAME MASTER) %INTEGER I LPTR=LPTR+1 %WHILE LINE(LPTR)=' ' %CYCLE I=1,1,MASTER(0) %FALSE %IF LINE(LPTR+I-1)#MASTER(I) %REPEAT LPTR=LPTR+I %TRUE %END %ROUTINE SET STREAM(%INTEGER STREAM,%RECORD(XF)%NAME FILE) %CONSTINTEGERARRAY DISC(0:3)=3,3,8,14 %OWNRECORD (STRDF) %NAME STRD5 D1_X=K'160032'+STREAM<<1 %IF D2_X_STRD == NULL %THEN D2_X_STRD == STRD5 STRD == D2_X_STRD %IF FILE_UNIT=255 %START; ! DUMMY STRD5 == STRD; ! REMEBER ITS ADDRESS D2_X_STRD == NULL; ! NULL STREAM %RETURN %FINISH STRD_A=0; STRD_B=2; STRD_C=0; STRD_D=ID<<8!DISC(FILE_UNIT) STRD_FILE=FILE; STRD_E=0; STRD_F=0; STRD_G=0; STRD_H=K'172' %END %ROUTINE PRINT COUNT(%INTEGER K,UNITS) PRINT SYMBOL(',') WRITE(K,0) %AND PRINT STRING('K +') %IF K>0 WRITE(UNITS,0); PRINT STRING(' CHARS') %END %ROUTINE PRINT FILE(%INTEGER STREAM) %INTEGER I,J %RECORD(XF)%NAME FILE D1_X=K'160032'+STREAM<<1 %IF D2_X_STRD == NULL %THEN PRINTSTRING(".NULL ") %AND %RETURN FILE==D2_X_STRD_FILE PRINT SYMBOL(FILE_UNIT+'0'); PRINT SYMBOL('.') %CYCLE I=0,1,5 J=FILE_FNAME(I); %EXIT %IF J=' ' PRINT SYMBOL(J) %REPEAT PRINT SYMBOL('('); PRINT SYMBOL(FILE_FSYS>>3+'0') PRINT SYMBOL(FILE_FSYS&7+'0'); PRINT SYMBOL(')') %END %ROUTINE SET CR FILE %CYCLE PROMPT("CR FILE:") SKIPSYMBOL %IF NEXTSYMBOL=NL %IF NEXTSYMBOL='.' %START SKIPSYMBOL %IF NEXTSYMBOL='T' %START SKIPSYMBOL; SKIPSYMBOL; SKIPSYMBOL CR FILE_UNIT = 255 SET B FLAG = 0; ! ALLWAYS IN ISO %RETURN %FINISH %FINISH %IF EXIST(1, CR FILE) = 1 %THEN %EXIT %REPEAT SET STREAM(1, CR FILE) %END %ROUTINE READ BUFFER %INTEGER GET,PUT,LIMIT,NL POSN,CHAR,LEN POSN,I,F %ROUTINE BUMP I=I+1 PUT=PUT+1 PUT=0 %IF PUT = BUFFER SIZE %END PUT=CR PUT; GET=CR GET NL POSN=-1; F=0 LEN POSN=CR LEN POSN I=BUFFER(LEN POSN) SELECT INPUT(1) %UNLESS CR FILE_UNIT = 255 %CYCLE READSYMBOL(CHAR) %IF (SET B FLAG=0 %AND CHAR=4) %OR CHAR<0 %START NO OF FILES = NO OF FILES-1 %IF NO OF FILES > 0 %START; ! MORE TO GO MESSAGE(CR, 'FILE DONE SELECT INPUT(0) SET BFLAG = BIN FLAG SET CR FILE SELECT INPUT(1) %UNLESS CR FILE_UNIT=255 %CONTINUE; ! GET NEXT SYMBOL %FINISH HOST_STATUS(CR)=STOPPING %IF F=0 PUT=-1 %EXIT %FINISH F = 1; ! CHARACTER PLANTED THIS TIME ROUND BUFFER(PUT)=CHAR NL POSN=PUT %IF CHAR=NL %OR CHAR=12 %OR CHAR=13 BUMP %IF CHAR=10 %OR CHAR=12 %OR CHAR=13 %START INSERT: BUFFER(LEN POSN)=I I=I+HOST_CR COUNT I=I-1024 %AND HOST_CR K=HOST_CR K+1 %IF %C I>=1024 HOST_CR COUNT=I BUFFER(PUT)=X'80'; BUMP LEN POSN=PUT; BUMP I=0 %FINISH %EXIT %IF PUT<=GET %AND PUT+5>GET %EXIT %IF PUT>GET %AND PUT+5-BUFFER SIZE>GET %REPEAT %IF NL POSN = -1 %START %IF PUT = 0 %THEN NL POSN = BUFFER SIZE-1 %ELSE %C NL POSN = PUT-1 -> INSERT %FINISH CR END=NL POSN; CR PUT=PUT CR LEN POSN=LEN POSN; BUFFER(LEN POSN)=I SELECT INPUT(0) %END %ROUTINE FILL BUFFER %INTEGER GET,END,LIMIT,I,J GET=CR GET; END=CR END HOST_STATUS(CR)=STOPPING %IF CR PUT=-1 %CYCLE I=0,1,BUFFER SIZE-1 BLOCK_DATA(I)=BUFFER(GET) J=GET; GET=GET+1 GET=0 %IF GET = BUFFER SIZE %EXIT %IF J=END %REPEAT P_MES_LEN=I+7 CR GET=GET %END %INTEGERFN EXIST(%INTEGER STREAM,%RECORD(XF)%NAME FILE) %RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1, %C %RECORD(XF)%NAME A2,%INTEGER A3) %RECORD(PF) P %CONSTINTEGERARRAY DIRT(0:3)=4,4,9,15 %IF READ FNAME(FILE) %START P_SERVICE=DIRT(FILE_UNIT); P_REPLY=ID P_A1=0; P_A2==FILE; P_A3=0 PONOFF(P) %RESULT=1 %IF P_A1#0 %FINISH MESSAGE(CR,'NO FILE'); NEWLINE %RESULT=0 %END %ROUTINE GET BUFFER(%INTEGER REASON) P_SERVICE=BUFFER MANAGER; P_REPLY=ID P_FN=REQUEST BUFFER; P_LEN=0; P_S1=REASON PON(P) %END %ROUTINE FREE BUFFER(%RECORD(MEF)%NAME MES) P_SERVICE=BUFFER MANAGER; P_REPLY=ID P_FN=RELEASE BUFFER; P_MES==MES PON(P) %END %ROUTINE CONNECT(%INTEGER HOST NO,FACILITY) P3_SERVICE=GATE SER; P3_REPLY=ID P3_FN=OPEN CALL; P3_PORT=1; P3_FACILITY=FACILITY P3_FLAG=X'48'; P3_NODE=NODE; P3_TERM=HOST NO P3_TERM=48 %IF P3_TERM=34 %AND P3_FACILITY=18 PON(P) %END %ROUTINE TO GATE(%INTEGER FN,%RECORD(MEF)%NAME MES,%INTEGER FLAG) P_SERVICE=GATE SER; P_REPLY=ID P_FN=FN; P_MES==MES; P_S1=FLAG PON(P) %END %ROUTINE DO ITP %INTEGER I %RETURN %IF TT STATE=STOPPING FRAME==P_MES_NSL_ITP GAH CT=GAH CT+1 %IF FRAME_HB1&2#0 TT STATE=STOPPING %AND TO GATE(ABORT CALL,P_MES,0) %IF FRAME_HB1&4#0 %IF FRAME_HB1&1=1 %START ! %IF FRAME_HB2&2#0 %AND FRAME_LEN=1 %AND FRAME_DATA(0)=0 %THEN %C ! TO TT(ECHO OFF) %IF FRAME_HB2&4#0 %THEN GOOD TEXT=8 %IF FRAME_HB2&8#0 %THEN GARBAGE=1 %RETURN %FINISH GARBAGE=0 %IF GARBAGE=1 %AND FRAME_HB2&8#0 %IF GARBAGE=0 %START PRINT SYMBOL(FRAME_DATA(I)) %FOR I=0,1,FRAME_LEN-1 %IF FRAME_HB2&4=0 %THEN GET BUFFER(ITP GAH) %C %ELSE PROMPT('') %AND TT STATE=OPENED %ELSE %IF FRAME_HB2&4=0 %START GET BUFFER(ITP GAH) %FINISH %END %ROUTINE FROM GATE %INTEGER I,J,K,L %SWITCH SW(OPEN CALL REPLY:MESSAGE REPLY) ->SW(P_FN) SW(OPEN CALL REPLY):%RETURN SW(INCOMING CALL): %IF HOST_STATUS(LP)=OPENED %START HOST_PORT(LP)=P_PORT MESSAGE(P3_FACILITY,'STARTING ') P_LEN=16 %IF P_LEN=0 TO GATE(CALL REPLY,NULL,P_LEN) HOST_STATUS(LP)=RUNNING SET STREAM(5,LP BASE FILE) J=LP BASE FILE_FNAME(5)+1 %IF J>'9' %START K=LP BASE FILE_FNAME(4)+1 %IF K>'4' %START LP BASE FILE_FSYS=LP BASE FILE_FSYS+1 K='0' %FINISH LP BASE FILE_FNAME(4)=K J='0' %FINISH LP BASE FILE_FNAME(5)=J HOST_LP COUNT=0; HOST_LP K=0 PRINT FILE(5); NEWLINE %RETURN %FINISH TO GATE(CALL REPLY,NULL,REJECT) %RETURN SW(INPUT RECD): TO GATE(ENABLE INPUT,P_MES,0) %UNLESS P_MES_NSL_FLAG&128#0 %IF P_PORT=TT PORT %THEN DO ITP %ELSE %START I=1 %IF P_PORT=HOST_PORT(LP) %START SELECT OUTPUT(1) K=0; BUFF==P2_MES_NSL_RJE_DATA L=P2_MES_NSL_UFLAG %UNTIL K+6>=P_MES_LEN %CYCLE %IF BUFF(K)>127 %THEN K=K+1 J=BUFF(K) %CYCLE K=K+1,1,K+J PRINT SYMBOL(BUFF(K)) %REPEAT J=J+HOST_LP COUNT J=J-1024 %AND HOST_LP K=HOST_LP K+1 %IF %C J>=1024 HOST_LP COUNT=J K=K+1 %REPEAT SELECT OUTPUT(0) %FINISH %FINISH FREE BUFFER(P_MES) %RETURN SW(OUTPUT TRANSMITTED): %IF P_PORT=HOST_PORT(CR) %START %IF HOST_STATUS(CR)=STOPPING %START TO GATE(CLOSE CALL,NULL,0) HOST_STATUS(CR)=STOPPING2 %ELSE P_PORT=1 GET BUFFER(CR DATA) %FINISH %RETURN %FINISH %IF P_PORT = TT PORT %AND PEND GAH#0 %START !! SEND A GO AHEAD GET BUFFER(ITP GAH) PEND GAH = PEND GAH-1 %FINISH %RETURN SW(CALL CLOSED): %IF P_PORT=TT PORT %START TO GATE(CLOSE CALL,NULL,0) %UNLESS TT STATE=STOPPING MESSAGE(TT,'CLOSED'); NEWLINE TT STATE=IDLE; TT PORT=-1 %RETURN %FINISH %IF P_PORT=HOST_PORT(LP) %START TO GATE(CLOSE CALL,NULL,0) MESSAGE(LP,'FINISHED') PRINT COUNT(HOST_LP K,HOST_LP COUNT) NEWLINE %IF HOST_STATUS(LP)=CLOSED %THEN HOST_STATUS(LP)=IDLE %C %ELSE HOST_STATUS(LP)=OPENED; HOST_PORT(LP)=-1 SELECT OUTPUT(1); CLOSE OUTPUT SET STREAM(1+4,LP BASE FILE); ! FRIG TO GET ROUND PERM FAULT %RETURN %FINISH %IF P_PORT=HOST_PORT(CR) %AND HOST_STATUS(CR)=STOPPING2 %START MESSAGE(CR,'FINISHED') PRINT COUNT(HOST_CR K,HOST_CR COUNT) NEWLINE HOST_STATUS(CR)=IDLE; HOST_PORT(CR)=-1 %RETURN %FINISH %RETURN SW(CALL ABORTED): %IF P_PORT=TT PORT %START TO GATE(ABORT CALL,NULL,0) %UNLESS TT STATE=STOPPING MESSAGE(TT,'ABORTED'); NEWLINE TT STATE=IDLE; TT PORT=-1 %RETURN %FINISH %CYCLE J=CR,1,LP %IF P_PORT=HOST_PORT(J) %START TO GATE(ABORT CALL,NULL,0) MESSAGE(J,'ABORTED'); NEWLINE HOST_STATUS(J)=IDLE; HOST_PORT(J)=-1 SELECT OUTPUT(1) %AND CLOSE OUTPUT %IF J=LP %RETURN %FINISH %REPEAT %RETURN SW(OPEN REPLY A): %IF P3_FACILITY=18 %THEN TT PORT=P_S1 %ELSE HOST_PORT(CR)=P_S1 %RETURN SW(OPEN REPLY B): %IF P_PORT=TT PORT %START %IF P_S1#0 %START MESSAGE(TT,'CONNECT FAILS'); WRITE(P_S1,0); NEWLINE TT STATE=IDLE; TT PORT=-1 TO TT(RD) %ELSE MESSAGE(TT,'CONNECTED'); NEWLINE TT STATE=RUNNING GET BUFFER(ITP HELLO) PEND GAH = 3 %FINISH %RETURN %FINISH %IF P_PORT=HOST_PORT(CR) %START %IF P_S1#0 %START ALARM(100) %AND %RETURN %IF CR TIMER=1 MESSAGE(CR,'CONNECT FAILS'); WRITE(P_S1,0); NEWLINE %IF CR TIMER=0 %AND CR STRM#SET PR %START MESSAGE(CR,'WILL KEEP TRYING'); NEWLINE ALARM(100); CR TIMER=1 %ELSE HOST_STATUS(CR)=IDLE; HOST_PORT(CR)=-1 %FINISH %ELSE MESSAGE(CR,'CONNECTED'); NEWLINE HOST_CR COUNT=0; HOST_CR K=0 P_PORT=1 SET B FLAG = BIN FLAG SET CR FILE J=0 CR GET=0 BUFFER(0)=X'80'; BUFFER(1) = 0 CR LEN POSN=1; CR PUT=2 GET BUFFER(CR DATA) READ BUFFER HOST_STATUS(CR)=RUNNING CR TIMER=0 %FINISH TO TT(RD) %RETURN %FINISH %RETURN SW(MESSAGE IN): BUFF==P2_MES_NSL_RJE_DATA I=P2_MES_NSL_ST WRITE(I,1) PRINT SYMBOL(':') K=BUFF(3) I=4 %UNTIL I+6>=P_MES_LEN %CYCLE SPACES(3) %UNLESS I=4 %IF BUFF(I)>127 %THEN I=I+1; J=BUFF(I) %CYCLE I=I+1,1,I+J L=BUFF(I) PRINT SYMBOL(L) %REPEAT NEWLINE %UNLESS L=NL; I=I+1 %REPEAT TO GATE(CALL REPLY,P_MES,128) %RETURN SW(MESSAGE REPLY): ! GATE VSN 3 ONWARDS PRINTSTRING("SM:"); WRITE(P2_MES_NSL_SUFL, 3); NEWLINE FREE BUFFER(P2_MES) %END %ROUTINE FROM BUFFER MANAGER %INTEGER I,J %RECORD (ME2F) %NAME MES %SWITCH SW(ITP HELLO:SOCIAL CALL) MES == P_MES FRAME==P_MES_NSL_ITP; FRAME_CNSL=0 BLOCK==MES_NSL_RJE ->SW(P_S1) SW(ITP HELLO): FRAME_HB1=8; FRAME_HB2=0; FRAME_LEN=LINE LENGTH-3 FRAME_DATA(I)=LINE(I+3) %FOR I=0,1,FRAME_LEN-1 P_MES_LEN=10+FRAME_LEN TO TT(RD) ->END SW(ITP GAH): FREE BUFFER(P_MES) %AND %RETURN %IF TT STATE=IDLE %ORC TT STATE=STOPPING FRAME_HB1=3; FRAME_HB2=0; FRAME_LEN=0; P_MES_LEN=10 ->END SW(ITP MESS): %IF GAH CT>0 %THEN GAH CT=GAH CT-1 %ELSE %START MESSAGE(TT,'NO GAH'); NEWLINE FREE BUFFER(P_MES) TO TT(RD) %RETURN %FINISH FRAME_HB1=0; FRAME_HB2=2+GOOD TEXT; FRAME_LEN=LINE LENGTH+1 GOOD TEXT=0 FRAME_DATA(I)=LINE(I) %FOR I=0,1,LINE LENGTH-2 FRAME_DATA(I+1)=13; FRAME_DATA(I+2)=10 P_MES_LEN=10+FRAME_LEN TT STATE=RUNNING P_PORT=TT PORT TO TT(RD) ->END SW(ITP INT): FRAME_HB1=1; FRAME_HB2=1 LPTR=LPTR+1 %WHILE LINE(LPTR)=' ' FRAME_LEN=LINE LENGTH-LPTR-1 FRAME_DATA(I)=LINE(LPTR+I) %FOR I=0,1,FRAME_LEN-1 P_MES_LEN=I+11 P_PORT=TT PORT TO TT(RD) ->END SW(SOCIAL CALL): BLOCK_DATA(I+4)=LINE(LPTR+I) %FOR I=1,1,LINE LENGTH-LPTR-1 BLOCK_DATA(3)=5; BLOCK_DATA(4)=LINE LENGTH-LPTR-1 I=P_PORT; P_PORT=0; P3_NODE=NODE BLOCK_DATA(1) = STRM MES_LEN=10+LINE LENGTH-LPTR TO GATE(OPEN MESSAGE,P_MES,I) TO TT(RD) %RETURN SW(CR DATA): FILL BUFFER %IF SETBFLAG=0 %THEN P2_MES_NSL_UFLAG=5 %ELSE %C P2_MES_NSL_UFLAG = 1 P_PORT=HOST_PORT(CR) TO GATE(PUT OUTPUT,P_MES,0) READ BUFFER %RETURN END: TO GATE(PUT OUTPUT,P_MES,0) %END %INTEGERFN DO TT %INTEGER I %IF MATCH(STATUS) %START MESSAGE(TT,STAT(TT STATE)); NEWLINE %RESULT=1 %FINISH %IF TT STATE=IDLE %START I=1 %IF READ ADDRESS#0 %START TT HOST = TERM CONNECT(TT HOST,18) TT STATE=STARTING %RESULT=2 %FINISH %ELSE %IF TT STATE#STARTING %START %IF MATCH(INT) %START GET BUFFER(ITP INT) %RESULT=2 %FINISH %IF MATCH(KILL) %START P_PORT=TT PORT TO GATE(ABORT CALL,NULL,0) %UNLESS TT STATE=STOPPING TT STATE=STOPPING %RESULT=1 %FINISH %FINISH %RESULT=0 %END %INTEGERFN DO OP(%INTEGER STREAM) %INTEGER I STRM = STREAM %IF MATCH(DO ENABLE) %START; ! ENABLE MESSAGES FROM GATE TO GATE(ENABLE FACILITY, NULL, 1) TO GATE(ENABLE FACILITY, NULL, 2) %RESULT = 1 %FINISH %IF READ ADDRESS # 0 %START P_PORT=TERM GET BUFFER(SOCIAL CALL) %RESULT=2 %FINISH %RESULT=0 %END %INTEGERFN DO CR %INTEGER I %CONSTBYTEINTEGERARRAY FILESX(0:6) = 5, 'F','I','L','E','S',0 %CONSTBYTEINTEGERARRAY BINX(0:7) = 6, 'B','I','N','A','R','Y',0 %IF MATCH(STATUS) %START MESSAGE(CR,STAT(HOST_STATUS(CR))) %IF HOST_STATUS(CR)=RUNNING %START PRINT COUNT(HOST_CR K,HOST_CR COUNT) PRINT STRING(', FROM '); PRINT FILE(1) %FINISH NEWLINE %RESULT=1 %FINISH %IF HOST_STATUS(CR)=IDLE %START %RESULT = 0 %IF READ ADDRESS=0 HOST_NUMBER = TERM; HOST_NODE = NODE BIN FLAG = 0 %IF MATCH(BINX) %THEN BIN FLAG = 1 %IF MATCH(PRINTER) %THEN CR STRM=4 %ELSE %START %IF MATCH(FEP) %THEN CR STRM = 9 %ELSE %START CR STRM=SET PR %FINISH %FINISH %IF MATCH(FILESX) %START NO OF FILES = LINE(LPTR+1)-'0' %ELSE NO OF FILES = 1 CONNECT(TERM,CR STRM) HOST_STATUS(CR)=STARTING %RESULT=2 %FINISH %RESULT=0 %END %INTEGERFN DO LP %INTEGER I,J %CONSTBYTEINTEGERARRAY NULLA(0:5) = 4, 'N','U','L','L',0 %IF MATCH(STATUS) %START I=1 MESSAGE(LP,STAT(HOST_STATUS(LP))) %UNLESS CLOSED#HOST_STATUS(LP)#RUNNING %START PRINT COUNT(HOST_LP K,HOST_LP COUNT) PRINT STRING(', TO '); PRINT FILE(I+4) %FINISH NEWLINE %RESULT=1 %FINISH %IF MATCH(NULLA) %START LP BASE FILE_UNIT = 255 %RESULT = 1 %FINISH %IF MATCH(FILEN) %START PROMPT('LP BASE FILE:') %UNTIL READ FNAME(LP BASE FILE) LP BASE FILE_FNAME(4)='0'; LP BASE FILE_FNAME(5)='0' %RESULT=1 %FINISH I=1 %IF MATCH(DO ENABLE) %START J=HOST_STATUS(LP) %IF J=IDLE %OR J=CLOSED %START TO GATE(ENABLE FACILITY,NULL,9) TO GATE(ENABLE FACILITY,NULL,4) MESSAGE(LP,'ENABLED') %IF J=IDLE %THEN J=OPENED %ELSE J=RUNNING %ELSE TO GATE(DISABLE FACILITY,NULL,9) TO GATE(DISABLE FACILITY,NULL,4) MESSAGE(LP,'DISABLED') %IF J=RUNNING %THEN J=CLOSED %ELSE J=IDLE %FINISH HOST_STATUS(LP)=J NEWLINE %RESULT=1 %FINISH %RESULT=0 %END P2==P; P3==P D2==D1 LP BASE FILE_UNIT=0; LP BASE FILE_FSYS=K'16' LP BASE FILE_FNAME(I)=SPOOL BASE(I) %FOR I=0,1,5 %CYCLE J=CR,1,LP HOST_PORT(J)=-1; HOST_STATUS(J)=IDLE %REPEAT MAP VIRT(BUFFER MANAGER,5,4) MAP VIRT(BUFFER MANAGER,6,5) TO GATE(ENABLE FACILITY,NULL,1) TO GATE(ENABLE FACILITY,NULL,2) TO GATE(ENABLE FACILITY, NULL, 6); ! PP TO GATE(ENABLE FACILITY, NULL, 7); ! BT ! TO TT(11); ! ONLY WITH GJB TT HANDLER TO TT(RD) PRINTSTRING(" LP:DISABLED SM:ENABLED HOST_STATUS(LP) = OPENED %CYCLE P_SERVICE=0; POFF(P) %IF P_REPLY=GATE SER %START FROM GATE %ELSE %IF P_REPLY =BUFFER MANAGER %START FROM BUFFER MANAGER %ELSE %IF P_REPLY=TT SER %START LINE LENGTH=0 LINE LENGTH=LINE LENGTH+1 %WHILE LINE(LINE LENGTH)#NL LINE LENGTH=LINE LENGTH+1 LPTR=3 %IF LINE(0)='Q' %AND LINE LENGTH<3 %THEN %STOP %IF LINE(2)='/' %START I=0 CHARNO(NEW, 1) = LINE(0); CHARNO(NEW, 2) = LINE(1) %CYCLE J = 1, 1, MAX COM ->SW(J) %IF COMS(J) = NEW %REPEAT ->BOT SW(1): ! TT I=DO TT ->BOT SW(2): ! OP I = DO OP(11) ->BOT SW(3): ! CR I = DO CR; -> BOT SW(4): ! LP I = DO LP; -> BOT SW(5): ! SM (SEND MESSAGE) I = DO OP(2); ->BOT BOT: TO TT(RD) %IF I=1 %CONTINUE %IF I>0 %FINISH %IF TT STATE=OPENED %THEN GET BUFFER(ITP MESS) %ELSE %START MESSAGE(TT,'INVALID'); NEWLINE TO TT(RD) %FINISH %ELSE CONNECT(HOST_NUMBER,CR STRM) %FINISH %REPEAT !MAP VIRT(GATE SER,7,4) !GATE INT='D' !TO TT(12) %ENDOFPROGRAM MESSAGE(TT,'INVALID'); NEWLINE ß ¨[t ß ¨[t ß ¼[÷ ß ÐQ ß ´[4 ß ´[· Ôm÷¥M Ãe±ÿ÷ ÜVÃ% Àeþ¿ß Àß $P ß ÐE ß (@ Är@ù Är@÷ Ķ@± ò¬hÄ Ã`×p Ãeþ¿ò ß ß%üÿ Úÿïæ Øÿ±ê Úÿßì °ÿ¡ò ÔÿTô ÊÿÎÿu ÎÿÒÿoö ìÿÀe æÿÂe Ðÿ^" ÀEýÿ" Îÿ3" aÁe4 Èÿ¼< æÿÀe Èÿ÷ Æÿh` > Àe ÌÿQb u-ÆÿÈÿ( ìÿÀe Èÿ°f f Áe Îÿ®h ÌÿJ" ìÿÃe Èÿ÷ ìÿÀe @mìÿ5 àÿ!¤ ÖüB¸ ÄÿNa÷ ¾ ðÿÈÊ °ÿÔÿ5 Õÿ Ö ÔÿÎÿuaÎÿ1 |üBâ aÁe¾ÿu ¾ÿ÷ì ØüTî Äÿîÿ­ð ôÿ`ô òÿ ø ôÿ5, pí¾ÿ @-îÿ ÄÿNaf ðÿ÷ Ô ¼ÿ4. ºÿv4  ÿù6 H-¼ÿ H-¶ÿ ¶ÿs8 ªûÞ@ ¬ÿøB u-¼ÿ¶ÿ pm¼ÿ Hí¼ÿóH ÜÿzL ²ÿøV ªÿ¦X ®ÿ½\ ®ÿ×t CmèÿÃe äÿ]^ ®ÿWt `Áe Cmêÿõ àÿØ¢ A]²ÿu ¬ÿ ÿÓ¼ &úßÀ þùàÐ êÿ Ö AmêÿÁe ¦ÿàÿöÞ °ÿW-°ÿ7 °ÿ.ê °ÿÀeÝÿ ¨ÿÁg( ¦ÿèÿ `Áe ®ÿWt `Áe túÿÀE ®ÿ×t ÀEÀÿ ¸ÿY& ðEüÿ ìÿðU `øß> HøßH ºÿ3P ¸ÿ×t túÿÀE ¸ÿWt ¸ÿ×t â÷àZ Æeþÿpd aÃe4 Æeîÿün WtøÿÁE îÿ5x ðÿB`µ úÿÕz üÿÔ~ bA-ðÿ HmîÿÙ p-òÿ Hmîÿ3 øÿx¬ îÿò² ÆeþÿýÀ øÿ÷ ÆeÔÿu® ÆeþÿÙ Úÿ@` ÿÿöÿW-öÿ öÿðb öÿWt ÀôFd îô®h þÿ6l fÿhn ÖÿØÿuaØÿ öÿW-öÿ7 öÿL~ túÿÀE `WtúÿÁE `ðÿu ðÿäÿà öÿW-öÿÞ¾ öÿ÷ :cõe p-äÿ ØÿÁeF Öÿ!  Öÿüÿ¶¢ cõe0 túÿÂE òÿ½¨ `WtúÿÁE æÿ9ª `×túÿÃE üÿÂe0 òÿAíòÿÁ üÿÀeP âÿWt ìÿ@íæÿÀ âÿË´ ìÿBíæÿ xdW-îÿ! W-îÿ" dõ%! ÞÿCÆ ªdÀeX âÿWt túÿÀE ÜÿÁå@ âdumÜÿðÿµ âÿ]Î æÿWt ÞÿÔÒ Øü>Ü